From dd070b177b0dc655c66a3850f629179cad932e76 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 28 Dec 2025 21:27:13 -0800 Subject: [PATCH] HARDCOPY and IMAGEIO: major architectural changes for imagefile types and printing --- sources/HARDCOPY | 840 ++++++++++++++++++------------------------ sources/HARDCOPY.LCOM | Bin 44494 -> 41696 bytes sources/IMAGEIO | 421 +++++++++++++++++---- sources/IMAGEIO.LCOM | Bin 36816 -> 44367 bytes 4 files changed, 698 insertions(+), 563 deletions(-) diff --git a/sources/HARDCOPY b/sources/HARDCOPY index 74b0d8d3..3c109e0b 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Dec-2025 00:00:55" {WMEDLEY}HARDCOPY.;108 150942 +(FILECREATED "28-Dec-2025 18:19:44" {WMEDLEY}HARDCOPY.;130 144997 :EDIT-BY rmk - :CHANGES-TO (FNS HARDCOPYW HARDCOPYREGION.TOFILE PRINTER.BITMAPFILE PRINTER.BITMAPSCALE - PRINTERTYPE) - (VARS HARDCOPYCOMS) + :CHANGES-TO (FNS FIND.PRINTER.FOR.IMAGETYPE WINDOWPRINT PRINTERDEVICE.CLOSEFN + PRINTERDEVICE.OPENFN) - :PREVIOUS-DATE "11-Dec-2025 23:57:14" {WMEDLEY}HARDCOPY.;102) + :PREVIOUS-DATE "28-Dec-2025 16:40:09" {WMEDLEY}HARDCOPY.;126) (PRETTYCOMPRINT HARDCOPYCOMS) @@ -25,27 +24,30 @@ (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") (INITVARS (ChangeDefaultPrinter)) (FNS MakeMenuOfPrinters PRINTERS.WHENSELECTEDFN MakeMenuOfImageTypes GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter - GetPrinterName GetImageFile FetchDefaultPrinter)) + GetPrinterName GetImageFile)) (COMS (* ;  "Interface for PRINTERS and IMAGEFILES") - (FNS DEFAULTPRINTER CONVERT.FILE.TO.TYPE.FOR.PRINTER CAN.PRINT.DIRECTLY EMPRESS - HARDCOPYW LISTFILES1 PRINTER.SCRATCH.FILE PRINTERPROP PRINTERSTATUS PRINTERTYPE - PRINTERNAME PRINTFILETYPE PRINTERTYPEP SEND.FILE.TO.PRINTER) - (FNS PRINTERDEVICE PRINTERDEVICE.OPENFN PRINTERDEVICE.CLOSEFN PRINTERDEVICEP - PRINTERNAME) - [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT] - (FNS PRINTERS) + (FNS HARDCOPYW LISTFILES1 PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME + PRINTFILETYPE PRINTERTYPEP SEND.FILE.TO.PRINTER FIND.PRINTER.FOR.IMAGETYPE + CAN.PRINT.SOMEHOW CAN.PRINT.DIRECTLY) + [COMS (FNS PRINTERDEVICE PRINTERDEVICE.OPENFN PRINTERDEVICE.CLOSEFN PRINTERDEVICEP + PRINTERNAME) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT] + (FNS DEFAULTPRINTERS) (INITVARS (DEFAULTPRINTINGHOST) - (EMPRESS#SIDES T) - (PRINTFILETYPES NIL)) - (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES - PRINTFILETYPES)) + (EMPRESS#SIDES T)) + (COMS (INITVARS (DEFAULTPRINTERTYPE 'WINDOW)) + (ADDVARS (PRINTERTYPES (WINDOW (CANPRINT (PDF HTML)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND WINDOWPRINT))) + (DEFAULTPRINTINGHOST (WINDOW WINDOW) + (UNIX UNIX))) + (FNS WINDOWPRINT)) + (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES)) (FNS SCALEREGION) (COMS (* ;  "Converting text files to imagestreams") @@ -120,160 +122,19 @@ (* ; "exported functionality") -(DEFINEQ - -(HARDCOPY.SOMEHOW - [LAMBDA (WINDOW IMAGEFILE IMAGETYPE) (* ; "Edited 3-Nov-2025 16:10 by rmk") - (* ; "Edited 29-Sep-2025 23:54 by rmk") - (* ; "Edited 19-Sep-2025 17:09 by rmk") - (* ; "Edited 26-Nov-96 15:59 by rmk:") - (* ; "Edited 13-Nov-87 14:16 by Snow") - - (* ;; "Either run window's HARDCOPYFN or run HARDCOPYW. The HARDCOPYFN can be a list of the form (fn heading) where heading=TITLE means use the window's title, otherwise using the non-nil heading.") - - (* ;; - "The information put in IMAGEFILE comes from WINDOW via the HARDCOPYFN, or the bitmap if no fn. ") - - (* ;; "Value is the completed IMAGEFILE.") - - (CL:WHEN IMAGEFILE - (CL:WHEN (AND (LISTP IMAGEFILE) - (NULL IMAGETYPE)) - (SETQ IMAGETYPE (CDR IMAGEFILE)) - (SETQ IMAGEFILE (CAR IMAGEFILE))) - (LET ((HARDCOPYFN (WINDOWPROP WINDOW 'HARDCOPYFN)) - HEADING) - (ALLOW.BUTTON.EVENTS) - (if (NULL HARDCOPYFN) - then (* ; "knows how to default") - (HARDCOPYW WINDOW IMAGEFILE NIL NIL NIL IMAGETYPE) - else (CL:WHEN (AND (LISTP HARDCOPYFN) - (FNTYP (CAR HARDCOPYFN))) - (SETQ HEADING (CADR HARDCOPYFN)) - (CL:WHEN (EQ HEADING 'TITLE) - (SETQ HEADING (WINDOWPROP WINDOW 'TITLE))) - (SETQ HARDCOPYFN (CAR HARDCOPYFN))) - (CL:WITH-OPEN-STREAM [IMAGESTREAM (OPENIMAGESTREAM - IMAGEFILE IMAGETYPE - (CL:WHEN HEADING - `(HEADING ,HEADING))] - (APPLY* HARDCOPYFN WINDOW IMAGESTREAM IMAGETYPE))) - IMAGEFILE))]) - -(HARDCOPYIMAGEW - [LAMBDA (W) (* ; "Edited 19-Sep-2025 15:45 by rmk") - (* ; "Edited 26-Aug-87 14:08 by Snow") - -(* ;;; "hardcopy this window to the DEFAULTPRINTINGHOST. This is called from the Hardcopy item on the Window command menu. Subitems specialize for printer vs file.") - - (HARDCOPYIMAGEW.TOPRINTER W T]) - -(HARDCOPYIMAGEW.TOFILE - [LAMBDA (W) (* ; "Edited 3-Nov-2025 16:23 by rmk") - (* ; "Edited 17-Jan-96 10:33 by rmk") - (HARDCOPY.SOMEHOW W (GetImageFile W]) - -(HARDCOPYIMAGEW.TOPRINTER - [LAMBDA (W DEFAULTPRINTER) (* ; "Edited 6-Dec-2025 10:58 by rmk") - (* ; "Edited 19-Sep-2025 15:54 by rmk") - (* ; "Edited 18-Oct-2022 18:45 by lmm") - (* ; "Edited 22-Apr-98 16:19 by rmk:") - (* ; "Edited 11-Jul-90 13:55 by jds") - (LET ((PRINTERCHOICE (CL:IF DEFAULTPRINTER - :DEFAULT - (GetPrinterName))) - PRINTERTYPE) - (CL:WHEN PRINTERCHOICE - (CL:WHEN (EQ PRINTERCHOICE :DEFAULT) - (SETQ PRINTERCHOICE (DEFAULTPRINTER))) - (if (LISTP PRINTERCHOICE) - then (* ; - "Got back a list, which is (TYPE NAME). Break it apart.") - (SETQ PRINTERTYPE (CAR PRINTERCHOICE)) - (SETQ PRINTERCHOICE (CADR PRINTERCHOICE)) - else (* ; "Got back just a name.") - (SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE))) - - (* ;; "HARDCOPY.SOMEHOW applies the window's HARDCOPYFN, or HARDCOPYW. But maybe the window should just be passed as a file to SEND.FILE.TO.PRINTER, and let its heuristics figure out what to do (CANPRINT, PREFERRED, etc.).") - - (SEND.FILE.TO.PRINTER (HARDCOPY.SOMEHOW W (OPENSTREAM '{NODIRCORE} 'OUTPUT) - PRINTERTYPE) - PRINTERCHOICE))]) - -(HARDCOPYREGION.TOFILE - [LAMBDA NIL (* ; "Edited 12-Dec-2025 23:55 by rmk") - (* ; "Edited 26-Aug-87 14:08 by Snow") - (LET ((FILE&TYPE (GetImageFile))) - (CL:WHEN FILE&TYPE - (SPAWN.MOUSE) - (PROMPTPRINT "Select a bitmap region for " (CAR FILE&TYPE)) - (HARDCOPYW (GETREGION) - FILE&TYPE))]) - -(HARDCOPYREGION.TOPRINTER - [LAMBDA NIL (* ; "Edited 6-Dec-2025 10:24 by rmk") - (* ; "Edited 13-Jul-90 01:57 by jds") - (LET ((PRINTERCHOICE (GetPrinterName)) - PRINTERTYPE) - (CL:WHEN PRINTERCHOICE - (CL:WHEN (EQ PRINTERCHOICE :DEFAULT) - (SETQ PRINTERCHOICE (DEFAULTPRINTER))) - (if (LISTP PRINTERCHOICE) - then (* ; - "Got back a list, which is (TYPE NAME). Break it apart.") - (SETQ PRINTERTYPE (CAR PRINTERCHOICE)) - (SETQ PRINTERCHOICE (CADR PRINTERCHOICE)) - elseif PRINTERCHOICE - then (SETQ PRINTERCHOICE (CAR)) - PRINTERCHOICE (* ; "Got back just a name.") - (SETQ PRINTERTYPE (PRINTERTYPE PRINTERCHOICE))) - (LET (REGION) - (SPAWN.MOUSE) - (PROMPTPRINT "Select a region") - (SETQ REGION (GETREGION)) - (CLRPROMPT) - (HARDCOPYW REGION (PACK* '{LPT} PRINTERCHOICE) - NIL NIL NIL (PRINTERTYPE PRINTERCHOICE))))]) - -(COPY.WINDOW.TO.BITMAP - [LAMBDA (WINDOW) (* ; "Edited 26-Aug-87 14:09 by Snow") - -(* ;;; "copies contents of window (including title and border) into a bitmap") - - (COND - ((OPENWP WINDOW) - (PROG (REGION SCREEN LEFT BOTTOM WIDTH HEIGHT BITMAP) - (SETQ REGION (WINDOWPROP WINDOW 'REGION)) - (SETQ SCREEN (WINDOWPROP WINDOW 'SCREEN)) - (SETQ LEFT (fetch (REGION LEFT) of REGION)) - (SETQ BOTTOM (fetch (REGION BOTTOM) of REGION)) - (SETQ WIDTH (fetch (REGION WIDTH) of REGION)) - (SETQ HEIGHT (fetch (REGION HEIGHT) of REGION)) - (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL WINDOW))) - (.WHILE.TOP.DS. WINDOW (BITBLT (SCREENBITMAP SCREEN) - LEFT BOTTOM BITMAP 0 0 WIDTH HEIGHT)) - (RETURN BITMAP))) - (T (BITMAPCOPY (WINDOWPROP WINDOW 'IMAGECOVERED]) -) - - - -(* ; "user interface jazz") - (RPAQ? ChangeDefaultPrinter ) (DEFINEQ (MakeMenuOfPrinters - [LAMBDA (MENUTITLE) (* ; "Edited 6-Dec-2025 09:52 by rmk") + [LAMBDA (MENUTITLE) (* ; "Edited 17-Dec-2025 00:58 by rmk") + (* ; "Edited 6-Dec-2025 09:52 by rmk") (* ; "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 _ `(("(Default printer)" (KWOTE :DEFAULT)) - ,@(for P in (PRINTERS) unless (OR (NULL P) - (ZEROP (NCHARS P))) + ITEMS _ `(("(Default printer)" (KWOTE :DEFAULTPRINTER)) + ,@(for P in (DEFAULTPRINTERS) when P unless (EQ P :DEFAULTPRINTER) collect (* ; "Skipped the NIL %"%" defaults") (LIST (CL:IF (LISTP P) (CL:IF (CADDR P) @@ -288,7 +149,9 @@ WHENSELECTEDFN _ (FUNCTION PRINTERS.WHENSELECTEDFN]) (PRINTERS.WHENSELECTEDFN - [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 16-Apr-2018 22:14 by rmk:") + [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 28-Dec-2025 00:38 by rmk") + (* ; "Edited 17-Dec-2025 00:46 by rmk") + (* ; "Edited 16-Apr-2018 22:14 by rmk:") (DECLARE (GLOBALVARS ChangeDefaultPrinter)) (* ;; "Fix Menu so that it doesn't ask about changing the default unless you click with middle") @@ -298,7 +161,8 @@ [COND ((EQ PRINTERCHOICE 'OTHER) (SETQ PRINTERCHOICE (GetNewPrinterFromUser] - (CL:WHEN [AND PRINTERCHOICE (NEQ PRINTERCHOICE (SETQ DEFAULTPRINTER (FetchDefaultPrinter] + (CL:WHEN [AND PRINTERCHOICE (NEQ PRINTERCHOICE (SETQ DEFAULTPRINTER (CAR (DEFAULTPRINTERS + NIL T] [NewPrinter PRINTERCHOICE (AND DEFAULTPRINTER (EQ BUTTON 'MIDDLE) (MENU (OR ChangeDefaultPrinter (SETQ ChangeDefaultPrinter @@ -330,13 +194,14 @@ TITLE _ MENUTITLE]) (GetNewPrinterFromUser - [LAMBDA (PROMPTSTRING) (* ; "Edited 7-Jun-93 15:33 by rmk:") + [LAMBDA (PROMPTSTRING) (* ; "Edited 25-Dec-2025 08:22 by rmk") + (* ; "Edited 7-Jun-93 15:33 by rmk:") (* ; "Edited 26-Aug-87 14:10 by Snow") (* ;;  "Changed from PopUpWindowAndGetAtom, so user can enter PRINTERTYPE PRINTERNAME PREFERREDIMAGETYPE.") - (PopUpWindowAndGetList (OR PROMPTSTRING "Printer (CR to abort): "]) + (PopUpWindowAndGetList (OR PROMPTSTRING "Printer name (CR to abort): "]) (PopUpWindowAndGetAtom [LAMBDA (PROMPTSTRING CANDIDATE) (* ; "Edited 6-Mar-2024 13:15 by rmk") @@ -390,14 +255,15 @@ (CAR RESPONSE))])]) (NewPrinter - [LAMBDA (PRINTER NEW-DEFAULT?) (* ; "Edited 6-Dec-2025 10:01 by rmk") + [LAMBDA (PRINTER NEW-DEFAULT?) (* ; "Edited 17-Dec-2025 01:00 by rmk") + (* ; "Edited 6-Dec-2025 10:01 by rmk") (* ; "Edited 11-Jul-90 13:48 by jds") (* ;;; "If Printer is unknown it will be added to DEFAULTPRINTINGHOST. In addition, if NEW-DEFAULT? is true the printer will be pushed to the head of DEFAULTPRINTINGHOST, thus making it the default printer.") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) - (CL:UNLESS (EQ :DEFAULT PRINTER) - [LET* ((PRINTERS (PRINTERS)) + (CL:UNLESS (EQ :DEFAULTPRINTER PRINTER) + [LET* ((PRINTERS (DEFAULTPRINTERS)) (PRINTER-NAME (CL:IF (LISTP PRINTER) (CADR PRINTER) PRINTER)) @@ -452,14 +318,6 @@  "Save full name less version for reuse") (WINDOWPROP FILEORW 'HARDCOPYFILE (PACKFILENAME 'VERSION NIL 'BODY IMAGEFILE))) (CONS IMAGEFILE IMAGEFILETYPE))]) - -(FetchDefaultPrinter - [LAMBDA NIL (* ; "Edited 26-Aug-87 14:11 by Snow") - (LET ((P (DEFAULTPRINTER))) - (COND - ((LISTP P) - (CADR P)) - (T P]) ) @@ -468,140 +326,33 @@ (DEFINEQ -(DEFAULTPRINTER - [LAMBDA NIL (* ; "Edited 5-Dec-2025 12:46 by rmk") - (* ; "Edited 26-Aug-87 14:11 by Snow") - (CAR (PRINTERS]) - -(CONVERT.FILE.TO.TYPE.FOR.PRINTER - [LAMBDA (FILE PRINTERTYPE PRINTOPTIONS) (* ; "Edited 11-Dec-2025 23:52 by rmk") - (* ; "Edited 29-Oct-2025 18:50 by rmk") - (* ; "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 (PDF, Interpress, Press, 4045HQ, etc) appropriate to PRINTERTYPE. FILETYPE is ignored here (old interface), CONVERT.TO.IMAGEFILE figures it out.") - - (* ;; "FILETYPE") - - (for CANPRINT IMAGEFILE in (PRINTERPROP PRINTERTYPE 'CANPRINT) - when (SETQ IMAGEFILE (CONVERT.TO.IMAGEFILE FILE NIL CANPRINT PRINTOPTIONS T)) - do (RETURN IMAGEFILE]) - -(CAN.PRINT.DIRECTLY - [LAMBDA (PRINTERTYPE IMAGEFILETYPE) (* ; "Edited 5-Dec-2025 14:44 by rmk") - (* ; "Edited 3-Nov-2025 15:46 by rmk") - (CL:WHEN IMAGEFILETYPE - [CAR (FMEMB IMAGEFILETYPE (PRINTERPROP (OR PRINTERTYPE (PRINTERTYPE DEFAULTPRINTINGHOST)) - 'CANPRINT])]) - -(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 'HEADING HEADING))) - (COND - (%#COPIES (LIST '%#COPIES %#COPIES))) - (COND - (%#SIDES (LIST '%#SIDES %#SIDES))) - PRINTOPTIONS]) - (HARDCOPYW - [LAMBDA (WINDOW/BITMAP/REGION IMAGEFILE HOST SCALEFACTOR ROTATION PRINTERTYPE HARDCOPYTITLE) - (* ; "Edited 13-Dec-2025 00:00 by rmk") - (* ; "Edited 6-Dec-2025 10:33 by rmk") - (* ; "Edited 27-Sep-2025 07:42 by rmk") - (* ; "Edited 19-Sep-2025 17:59 by rmk") - (* ; "Edited 18-Sep-2025 11:12 by rmk") - (* ; "Edited 31-Aug-89 10:05 by jds") - - (* ;; "Makes a hard copy of a window, bitmap, or region of the screen.") - - (* ;; "") - - (* ;; "WINDOW/BITMAP/REGION can be a WINDOW, a REGION, a BITMAP, or NIL = select region. If IMAGEFILE supplied, output goes there. If HOST supplied, it is printed. If neither FILE nor HOST supplied, default is to print; if HARDCOPYTITLE is supplied it will be used as the document title of the hardcopy file created. If it isn't, 'Window Image' is used.") - - (CL:UNLESS (OR HOST IMAGEFILE) - (SETQ HOST :DEFAULT)) - (PROG (PRINTHOST BITMAP SCREENREGION REGION BITMAPFILE IMAGEFILETYPE) - (CL:WHEN (LISTP IMAGEFILE) - (SETQ IMAGEFILETYPE (CDR IMAGEFILE)) - (SETQ IMAGEFILE (CAR IMAGEFILE))) - (CL:UNLESS HARDCOPYTITLE - (SETQ HARDCOPYTITLE (CL:IF (WINDOWP WINDOW/BITMAP/REGION) - "Window image" - "Screen image"))) - [SETQ BITMAP (if (WINDOWP WINDOW/BITMAP/REGION) - then (COPY.WINDOW.TO.BITMAP WINDOW/BITMAP/REGION) - elseif (BITMAPP WINDOW/BITMAP/REGION) - then (SETQ BITMAP WINDOW/BITMAP/REGION) - elseif (type? REGION WINDOW/BITMAP/REGION) - then (SETQ REGION WINDOW/BITMAP/REGION) - (SCREENBITMAP) - else (SETQ SCREENREGION (GETSCREENREGION)) - (SETQ REGION (fetch (SCREENREGION REGION) of SCREENREGION)) - (SCREENBITMAP (fetch (SCREENREGION SCREEN) of SCREENREGION] - RETRY - (SETQ PRINTHOST HOST) - (if PRINTERTYPE - then (if PRINTHOST - then (CL:UNLESS (EQ PRINTERTYPE (PRINTERTYPE PRINTHOST)) - (ERROR PRINTHOST (CONCAT "is not of printer type " PRINTERTYPE)) - (GO RETRY)) - elseif IMAGEFILE - then - (* ;; - "don't need a PRINTHOST/PRINTERTYPE if you give a file without a host") - - elseif (SETQ PRINTHOST (for P in (PRINTERS) when (EQ PRINTERTYPE (PRINTERTYPE - P)) - do (RETURN P))) - else (ERROR (CONCAT "Can't find a " PRINTERTYPE - " printer in DEFAULTPRINTINGHOST")) - (GO RETRY)) - elseif IMAGEFILE - then (CL:UNLESS [OR IMAGEFILETYPE (SETQ IMAGEFILETYPE (OR (IMAGEFILETYPE.FROM.EXTENSION - IMAGEFILE) - (CAR (NLSETQ (IMAGEFILETYPE - IMAGEFILE] - (ERROR IMAGEFILE "does not designate an image file") - (GO RETRY)) - elseif (SETQ PRINTERTYPE (PRINTERTYPE PRINTHOST)) - else (ERROR "Can't tell where to send a bitmap image") - (GO RETRY)) - (CL:UNLESS IMAGEFILETYPE - [SETQ IMAGEFILETYPE (CAR (PRINTERPROP PRINTERTYPE 'CANPRINT]) - (CL:UNLESS SCALEFACTOR - (SETQ SCALEFACTOR (if REGION - then (IMAGETYPE.BITMAPSCALE (fetch (REGION WIDTH) of REGION) - (fetch (REGION HEIGHT) of REGION) - IMAGEFILETYPE) - else (IMAGETYPE.BITMAPSCALE (fetch (BITMAP BITMAPWIDTH) - of BITMAP) - (fetch (BITMAP BITMAPHEIGHT) of BITMAP) - IMAGEFILETYPE))) - (CL:WHEN (LISTP SCALEFACTOR) - (SETQ ROTATION (CDR SCALEFACTOR)) - (SETQ SCALEFACTOR (CAR SCALEFACTOR)))) - (SETQ BITMAPFILE (IMAGETYPE.BITMAPFILE (OR IMAGEFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT)) - IMAGEFILETYPE BITMAP SCALEFACTOR REGION ROTATION HARDCOPYTITLE)) - (CL:WHEN (OR HOST (NULL IMAGEFILE)) - (SEND.FILE.TO.PRINTER BITMAPFILE PRINTHOST '(DELETE %, (NULL IMAGEFILE) - DOCUMENT.NAME %, HARDCOPYTITLE))) - (RETURN (AND IMAGEFILE BITMAPFILE]) + [LAMBDA (WINDOW/BITMAP/REGION FILE HOST SCALEFACTOR ROTATION PRINTERTYPE HARDCOPYTITLE) + (* ; "Edited 28-Dec-2025 01:06 by rmk") + (if HOST + then (if (NULL PRINTERTYPE) + then (SETQ PRINTERTYPE (PRINTERTYPE HOST)) + elseif (NEQ PRINTERTYPE (PRINTERTYPE HOST)) + then (ERROR HOST (CONCAT "is not of printer type " PRINTERTYPE))) + elseif (NULL FILE) + then (SETQ HOST (OR (CAR (OR (DEFAULTPRINTERS PRINTERTYPE) + (DEFAULTPRINTERS))) + :DEFAULTPRINTER)) + (SETQ PRINTERTYPE (PRINTERTYPE HOST)) + else (SETQ PRINTERTYPE (PRINTERTYPE :DEFAULTPRINTER))) + (LET ([OPTIONS `(SCALEFACTOR ,SCALEFACTOR ROTATION ,ROTATION DOCUMENT.NAME + ,(OR HARDCOPYTITLE "Window Image"] + IMAGEFILE PRINTER) + (SETQ IMAGEFILE (CONVERT.TO.IMAGEFILE WINDOW/BITMAP/REGION FILE (CAR (PRINTERPROP + PRINTERTYPE + 'CANPRINT)) + OPTIONS)) + (CL:WHEN HOST (SEND.FILE.TO.PRINTER IMAGEFILE HOST OPTIONS]) (LISTFILES1 [LAMBDA (FILE PRINTOPTIONS) (* ; "Edited 26-Aug-87 14:17 by Snow") (SEND.FILE.TO.PRINTER FILE NIL PRINTOPTIONS]) -(PRINTER.SCRATCH.FILE - [LAMBDA (PRINTER IMAGETYPE) (* ; "Edited 19-Sep-2025 14:49 by rmk") - (CONCAT "{" (OR (PRINTERDEVICEP PRINTER) - 'LPT) - "}" - (CL:IF IMAGETYPE - (CONCAT "." IMAGETYPE) - "")]) - (PRINTERPROP [LAMBDA (PRINTERTYPE PROP) (* ; "Edited 26-Aug-87 14:20 by Snow") (for X in PRINTERTYPES when (EQMEMB PRINTERTYPE (CAR X)) @@ -614,7 +365,9 @@ (AND STATUSFN (APPLY* STATUSFN PRINTER]) (PRINTERTYPE - [LAMBDA (HOST PREFERRED) (* ; "Edited 12-Dec-2025 22:37 by rmk") + [LAMBDA (HOST PREFERRED) (* ; "Edited 17-Dec-2025 00:52 by rmk") + (* ; "Edited 14-Dec-2025 17:53 by rmk") + (* ; "Edited 12-Dec-2025 22:37 by rmk") (* ; "Edited 5-Dec-2025 12:51 by rmk") (* ; "Edited 19-Sep-2025 10:18 by rmk") (* ; "Edited 27-Apr-98 16:16 by rmk:") @@ -622,20 +375,18 @@ (* ;; "Attempt to deduce the printer type of HOST.") - (SELECTQ HOST - ((NIL LPT :DEFAULT) - (SETQ HOST (DEFAULTPRINTER))) - NIL) + (AND NIL (SELECTQ HOST + ((NIL LPT :DEFAULTPRINTER) + (SETQ HOST (CAR (DEFAULTPRINTERS)))) + NIL)) (COND ((LISTP HOST) (* ;; "A pair (type hostname) or maybe a triple of the form (printertype hostname preferred-imagetype). Check that type is one we know about.") - (LET [(TYPE (OR (AND PREFERRED (CADDR HOST)) - (CAR HOST] - (SETQ HOST (CADR HOST)) + (LET ((TYPE (CAR HOST))) (CL:UNLESS (PRINTERTYPEP TYPE) - (ERROR "Undefined printer-type:" TYPE)) + (ERROR TYPE "is an undefined printer type")) TYPE)) ((NULL HOST) DEFAULTPRINTERTYPE) @@ -647,21 +398,23 @@ [(for TYPE FN in PRINTERTYPES when (AND (SETQ FN (CDR (ASSOC 'HOSTNAMEP TYPE))) (APPLY* (CAR FN) HOST)) do - (* ; - "Try the predicates for each printer type for recognizing their own host names") + + (* ;; "Try the predicates for each printer type for recognizing their own host names. This gets the colon for NS/Interpress printers") + (RETURN (CAAR TYPE] - [(for PRINTER in (PRINTERS) when (AND (LISTP PRINTER) - (STRING-EQUAL (CADR PRINTER) - HOST)) do + [(for PRINTER in (DEFAULTPRINTERS) when (AND (LISTP PRINTER) + (STRING-EQUAL (CADR PRINTER) + HOST)) do (* ;;  "Try looking for literal match before doing canonical hostname, cause that may be expensive.") - (RETURN (CAR PRINTER] - [(for PRINTER in (PRINTERS) when (AND (LISTP PRINTER) - (STRING-EQUAL (OR (CANONICAL.HOSTNAME (CADR PRINTER)) - (CADR PRINTER)) - HOST)) do (RETURN (CAR PRINTER] + (RETURN (CAR PRINTER] + [(for PRINTER in (DEFAULTPRINTERS) when (AND (LISTP PRINTER) + (STRING-EQUAL (OR (CANONICAL.HOSTNAME + (CADR PRINTER)) + (CADR PRINTER)) + HOST)) do (RETURN (CAR PRINTER] (T DEFAULTPRINTERTYPE]) (PRINTERNAME @@ -686,9 +439,10 @@ else (fetch (FDEV DEVICENAME) of FDEV])]) (PRINTFILETYPE - [LAMBDA (FILE DONTOPEN) (* ; "Edited 18-Sep-2025 11:22 by rmk") + [LAMBDA (FILE DONTOPEN) (* ; "Edited 24-Dec-2025 20:39 by rmk") + (* ; "Edited 18-Sep-2025 11:22 by rmk") (* ; "For backward compatibility") - (IMAGEFILETYPE FILE DONTOPEN]) + (IMAGESOURCETYPE FILE DONTOPEN]) (PRINTERTYPEP [LAMBDA (X) (* ; "Edited 5-Dec-2025 12:23 by rmk") @@ -696,7 +450,11 @@ X]) (SEND.FILE.TO.PRINTER - [LAMBDA (FILE HOST PRINTOPTIONS) (* ; "Edited 11-Dec-2025 23:56 by rmk") + [LAMBDA (IMAGESOURCE HOST OPTIONS) (* ; "Edited 27-Dec-2025 23:06 by rmk") + (* ; "Edited 23-Dec-2025 15:33 by rmk") + (* ; "Edited 21-Dec-2025 09:03 by rmk") + (* ; "Edited 14-Dec-2025 15:48 by rmk") + (* ; "Edited 11-Dec-2025 23:56 by rmk") (* ; "Edited 7-Dec-2025 11:08 by rmk") (* ; "Edited 5-Dec-2025 14:41 by rmk") (* ; "Edited 27-Sep-2025 07:43 by rmk") @@ -706,149 +464,229 @@ (* ; "Edited 13-Sep-2025 23:39 by rmk") (* ; "Edited 21-Jan-93 11:34 by jds") - (* ;; "Returns file name if successful, NIL if not. T") + (* ;; "Returns IMAGESOURCE if successful, NIL if not. ") + + (* ;; "The heuristics for finding the right printer with the right kind of imagefile are in FIND.PRINTER.FOR.IMAGETYPE.") + + (CL:WHEN (IMAGESOURCEFILEP IMAGESOURCE) + (SETQ IMAGESOURCE (FINDFILE IMAGESOURCE T))) + + (* ;; " ") + + (CL:UNLESS HOST (* ; + "Not sure whether HOST or props should have priority") + [SETQ HOST (for X on OPTIONS by (CDDR X) when (MEMB (U-CASE (CAR X)) + '(HOST SERVER)) + do (RETURN (CADR X]) + + (* ;; "If HOST is still NIL, then it is clearly unspecified, we have to pick it based on the types. The default here is the first of (PRINTERS) that can print the type, not just the first printer.") - (CL:UNLESS (STREAMP FILE) - (SETQ FILE (FINDFILE FILE T))) (RESETLST - (LET ((IMAGETYPE (LISTGET PRINTOPTIONS 'IMAGETYPE)) - (PRINTERS (PRINTERS)) - PRINTERTYPE SENDFN HEADING PRINTER CONVERTED) + (bind PTYPE/PRINTER/ITYPE IMAGEFILETYPE IMAGEFILE SENDFN (IMAGESOURCETYPE _ (IMAGESOURCETYPE + IMAGESOURCE)) + first (SETQ IMAGEFILETYPE (OR (LISTGET OPTIONS 'IMAGEFILETYPE) + IMAGESOURCETYPE)) + do (* ; "Errors all at this level") + (SETQ IMAGEFILE NIL) + (CL:UNLESS (SETQ PTYPE/PRINTER/ITYPE (FIND.PRINTER.FOR.IMAGETYPE IMAGEFILETYPE HOST)) + (ERROR (CONCAT "Can't find printer for " IMAGEFILETYPE " file"))) + (CL:UNLESS (SETQ SENDFN (PRINTERPROP (PRINTERTYPE PTYPE/PRINTER/ITYPE) + 'SEND)) + (ERROR (CONCAT "Don't know how to send to a " (PRINTERTYPE PTYPE/PRINTER/ITYPE) + " printer"))) + (CL:UNLESS (SETQ IMAGEFILE (CONVERT.TO.IMAGEFILE IMAGESOURCE NIL (CADDR + PTYPE/PRINTER/ITYPE + ) + OPTIONS T)) + (ERROR (CONCAT "Can't convert " IMAGESOURCETYPE " file to " (CADDR + PTYPE/PRINTER/ITYPE + )) + IMAGESOURCE)) - (* ;; "If IMAGETYPE is specified as what should be sent to the printer, we first make sure that FILE is of that type, and then we use that type to find the printer, if it wasn't also clearly specified.") + (* ;; "Go around: maybe the user fixed something in an error break?") + repeatuntil (AND PTYPE/PRINTER/ITYPE SENDFN IMAGEFILE) + finally - (if (AND IMAGETYPE (NEQ IMAGETYPE (IMAGEFILETYPE FILE))) - then (SETQ FILE (CONVERT.TO.IMAGEFILE FILE NIL IMAGETYPE PRINTOPTIONS)) - else (SETQ IMAGETYPE (IMAGEFILETYPE FILE))) + (* ;; "Now have the printer and proper imagefile. Complexity here is because we want to say something meaningful about the image source, which may be a window, bitmap, tedit stream ") - (* ;; "") + [SETQ OPTIONS `(HEADING ,(SELECTQ (LISTGET OPTIONS 'HEADING) + (T NIL) + (NIL (* ; + "If not a file, use the type or window title?") + (CL:WHEN (IMAGESOURCEFILEP IMAGESOURCE) + (CONCAT IMAGESOURCE " " + (GETFILEINFO IMAGESOURCE 'CREATIONDATE) + ))) + (LISTGET OPTIONS 'HEADING)) + ,@OPTIONS %#COPIES 1 DOCUMENT.NAME ,(CL:IF (IMAGESOURCEFILEP + IMAGESOURCE) + IMAGESOURCE + (TYPENAME IMAGESOURCE)) + ] + (CL:WHEN (LISTGET OPTIONS 'DELETE) + [RESETSAVE IMAGEFILE '(PROGN (DELFILE OLDVALUE]) + (CL:WHEN (APPLY* SENDFN (CADR PTYPE/PRINTER/ITYPE) + IMAGEFILE OPTIONS) + (RETURN IMAGESOURCE))))]) - (SETQ PRINTER (if (OR (EQ HOST :DEFAULT) - (NULL HOST) - (EQ 0 (NCHARS HOST))) - then (CAR PRINTERS) - elseif (PRINTERDEVICEP HOST) - elseif (for X on PRINTOPTIONS by (CDDR X) - when (MEMB (U-CASE (CAR X)) - '(HOST SERVER)) do (RETURN (CADR X))) - elseif (for X in PRINTERS when (CAN.PRINT.DIRECTLY (PRINTERTYPE X) - IMAGETYPE) - do - (* ;; "Find returns T for NIL") +(FIND.PRINTER.FOR.IMAGETYPE + [LAMBDA (IMAGETYPE HOST) (* ; "Edited 28-Dec-2025 18:02 by rmk") + (* ; "Edited 23-Dec-2025 10:13 by rmk") + (* ; "Edited 17-Dec-2025 00:59 by rmk") + (* ; "Edited 15-Dec-2025 11:48 by rmk") - (RETURN X)) - elseif (for X in PRINTERS - when (thereis CPT in (PRINTERPROP (PRINTERTYPE X) - 'CANPRINT) - suchthat (LISTGET (CAR (GETMULTI PRINTFILETYPES CPT - 'CONVERSION)) - IMAGETYPE)) do (RETURN X)) - else (ERROR "Can't find printer for " FILE))) - (CL:WHEN (PRINTERDEVICEP PRINTER) - (SETQ PRINTERTYPE (PRINTERTYPE PRINTER))) - (CL:UNLESS (SETQ SENDFN (PRINTERPROP PRINTERTYPE 'SEND)) - (ERROR (CONCAT "Don't know how to send to a " PRINTERTYPE " printer") - PRINTER)) - [SETQ PRINTOPTIONS `(HEADING ,(SELECTQ (LISTGET PRINTOPTIONS 'HEADING) - (T NIL) - (NIL (CONCAT FILE " " (GETFILEINFO FILE - 'CREATIONDATE))) - (LISTGET PRINTOPTIONS 'HEADING)) - ,@PRINTOPTIONS] (* (ADD.PROCESS (BQUOTE - ((\, SENDFN) (QUOTE (\, - (CL:IF (LISTP PRINTHOST) - (CADR PRINTHOST) PRINTHOST))) - (QUOTE (\, BITMAPFILE)))) - (QUOTE NAME) (QUOTE HARDCOPYW))) - (CL:WHEN [APPLY* SENDFN (CL:IF (LISTP PRINTER) - (CADR PRINTER) - PRINTER) - (CL:IF (CAN.PRINT.DIRECTLY PRINTERTYPE IMAGETYPE) - FILE - (SETQ CONVERTED (CONVERT.FILE.TO.TYPE.FOR.PRINTER FILE PRINTERTYPE - PRINTOPTIONS))) - `(,@PRINTOPTIONS %#COPIES 1 DOCUMENT.NAME ,FILE] - (CL:WHEN (AND CONVERTED (LISTGET PRINTOPTIONS 'DELETE)) - (DELFILE CONVERTED)) - FILE)))]) + (* ;; "Returns a (PTYPE PRINTER TARGETTYPE) triple. This is to be compatible with other interfaces where the type is separate (e.g. as for the default), even though here it is computable from the HOST.") + + (* ;; " If HOST is given and not the default, then it must be able to print IMAGETYPE. Otherwise, we first look for something that can print directly (e.g. PDF IMAGETYPE can be printed by a UNIX printer), and if not directly, something that can be converted (TEDIT can be converted to PDF--PDF is in the return) to tell the caller what conversion to pick for this printer.") + + (LET (TARGETTYPE) + (if (AND HOST (NEQ HOST :DEFAULTPRINTER)) + then + (* ;; "Really want to print on HOST, even by conversion") + + (CL:WHEN (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW HOST IMAGETYPE)) + (LIST (PRINTERTYPE HOST) + HOST TARGETTYPE)) + elseif (for PRINTER in (DEFAULTPRINTERS) when (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW PRINTER + IMAGETYPE T)) + do (* ; "Direct?") + (RETURN (LIST (PRINTERTYPE PRINTER) + (CL:IF (LISTP PRINTER) + (CADR PRINTER) + PRINTER) + TARGETTYPE))) + else (for PRINTER in (DEFAULTPRINTERS) when (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW PRINTER + IMAGETYPE)) + do (* ; "Conversion") + (RETURN (LIST (PRINTERTYPE PRINTER) + (CL:IF (LISTP PRINTER) + (CADR PRINTER) + PRINTER) + TARGETTYPE]) + +(CAN.PRINT.SOMEHOW + [LAMBDA (PRINTER IMAGESOURCETYPE DIRECTONLY) (* ; "Edited 23-Dec-2025 11:09 by rmk") + (* ; "Edited 14-Dec-2025 14:28 by rmk") + + (* ;; "Returns the PRINTFILETYPE (e.g. PDF) by which PRINTER can print a source of IMAGESOURCETYPE (e.g. TEDIT or POSTSCRIPT), perhaps by conversion.") + + (if (CAN.PRINT.DIRECTLY (PRINTERTYPE PRINTER) + IMAGESOURCETYPE) + elseif DIRECTONLY + then NIL + else (thereis CPTYPE in (PRINTERPROP (PRINTERTYPE PRINTER) + 'CANPRINT) suchthat (OR (LISTGET (CAR (GETMULTI PRINTFILETYPES + CPTYPE 'CONVERSION) + ) + IMAGESOURCETYPE) + (LISTGET (CAR (GETMULTI PRINTFILETYPES + 'DEFAULT + 'CONVERSION)) + IMAGESOURCETYPE]) + +(CAN.PRINT.DIRECTLY + [LAMBDA (PRINTERTYPE IMAGEFILETYPE) (* ; "Edited 23-Dec-2025 10:37 by rmk") + (* ; "Edited 5-Dec-2025 14:44 by rmk") + (* ; "Edited 3-Nov-2025 15:46 by rmk") + (CAR (FMEMB IMAGEFILETYPE (PRINTERPROP PRINTERTYPE 'CANPRINT]) ) (DEFINEQ (PRINTERDEVICE - [LAMBDA (NAME) (* ; "Edited 11-Sep-2025 12:40 by rmk") + [LAMBDA (NAME) (* ; "Edited 27-Dec-2025 23:08 by rmk") + (* ; "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. PRINTERDEVICE.CLOSEFN calls\CORE.CLOSEFILE explicitly.") - - (LET ((DEV (\CREATECOREDEVICE NAME))) + (CL:UNLESS NAME + (SETQ NAME 'LPT)) + (PSEUDOHOST NAME "{UNIX}") + (LET ((DEV (\GETDEVICEFROMNAME NAME))) (replace (FDEV OPENFILE) of DEV with (FUNCTION PRINTERDEVICE.OPENFN)) (replace (FDEV CLOSEFILE) of DEV with (FUNCTION PRINTERDEVICE.CLOSEFN)) - (\DEFINEDEVICE NAME DEV) + (replace (FDEV DIRECTORYNAMEP) of DEV with (FUNCTION NILL)) + (* ; + "LPT filenames don't have directories") NAME]) (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] + [LAMBDA (LPTNAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 28-Dec-2025 17:44 by rmk") + (* ; "Edited 11-Sep-2025 17:03 by rmk") - (* ;; "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. ") + (* ;; "PRINTOPTIONS might be in PARAMETERS. ") - (STREAMPROP STRM 'PRINTERNAME (CL:UNLESS (EQ PRINTERNAME '%.) - PRINTERNAME)) + (* ;; "LPTNAME is typically the target of a COPYFILE, in which case the source file is merely copied, and when the stream is closed there is an attempt to convert it to the imagetype extension, if provided, before sending to the (possibly also provided) printer.") + + (* ;; "The file can also be the target of an OPENIMAGESTREAM, in which case the file will be created according to the OPENIMAGESTREAM type, and then possibly converted to the LPTNAME's imagetype for printing.") + + (LET ([PRINTERNAME (U-CASE (FILENAMEFIELD LPTNAME 'NAME] + [IMAGETYPE (U-CASE (OR (FILENAMEFIELD LPTNAME 'EXTENSION) + (LISTGET PARAMETERS 'IMAGETYPE] + STRM) + (CL:WHEN (OR (NULL PRINTERNAME) + (EQ PRINTERNAME '%.)) + (SETQ PRINTERNAME :DEFAULTPRINTER)) + (CL:WHEN IMAGETYPE + (CL:UNLESS (CAN.PRINT.SOMEHOW PRINTERNAME IMAGETYPE) + (ERROR PRINTERNAME (CONCAT "cannot print files of type " IMAGETYPE)))) + + (* ;; "Essentially we are rewriting the {LPT}printer.type name to be {LPT}/tmp/xx-printer-type.lpt still in the LPT host. TRUEFILENAME would then map it back to Unix. Note: we may also need to suppress the colon in NS printer names, not just the defaultprinter package colon. (Or not bother to include the printer name?)") + + (SETQ STRM (OPENFILE.PH (UNIX-TMP-FILE-NAME (CL:IF (EQ PRINTERNAME :DEFAULTPRINTER) + 'DEFAULTPRINTER + PRINTERNAME) + 'lpt + 'LPT) + ACCESS RECOG PARAMETERS FDEV OLDSTREAM)) + (STREAMPROP STRM 'PRINTERNAME PRINTERNAME) (* ; + "Make this explicit here, no need to parse the name later. User could change while it's open?") + (STREAMPROP STRM 'IMAGETYPE IMAGETYPE) STRM]) (PRINTERDEVICE.CLOSEFN - [LAMBDA (STREAM) (* ; "Edited 4-Oct-2025 16:37 by rmk") + [LAMBDA (STRM) (* ; "Edited 28-Dec-2025 17:50 by rmk") + (* ; "Edited 4-Oct-2025 16:37 by rmk") (* ; "Edited 28-Sep-2025 14:46 by rmk") (* ; "Edited 20-Sep-2025 13:40 by rmk") (* ; "Edited 19-Sep-2025 11:51 by rmk") (* ; "Edited 11-Sep-2025 12:37 by rmk") - (LET ((SDEV (fetch (STREAM DEVICE) of STREAM)) - (PRINTOPTIONS (STREAMPROP STREAM 'PRINTOPTIONS)) - IMAGETYPE PRINTERNAME) + (LET ((PRINTERNAME (STREAMPROP STRM 'PRINTERNAME NIL)) + (IMAGETYPE (STREAMPROP STRM 'IMAGETYPE)) + (PRINTOPTIONS (STREAMPROP STRM 'PRINTOPTIONS)) + (TRUENAME (TRUEFILENAME STRM)) + IMAGETYPE) - (* ;; - "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away") + (* ;; "Below we work on the true {UNIX} file name, until the delete.") - (* ;; "") + (* ;; "Removed PRINTERNAME property; might prevent a loop through the closing. ") - (* ;; "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") + (* ;; "IMAGETYPE is what was requested in the LPTNAME, may be the target of conversion from the type of STRM.") - (if (AND (NOT RESETSTATE) - (OPENP STREAM 'OUTPUT) - (IGREATERP (GETEOFPTR STREAM) - 0)) - then - (* ;; "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.") + (CLOSEFILE.PH STRM) + (replace (STREAM ACCESS) of STRM with NIL) (* ; + " Hack, because this is usually done later in the generic \CLOSEFILE.") + (CL:WHEN (AND PRINTERNAME (NOT RESETSTATE) + (IGREATERP (GETFILEINFO STRM 'LENGTH) + 0)) - (\CORE.CLOSEFILE STREAM) (* ; - "Closing prevents this function from being called again on this stream.") - (replace (STREAM ACCESS) of STREAM with NIL) - (* ; - "Hack, cause this is usually done later in the generic \CLOSEFILE.") - (change (fetch (FDEV OPENFILELST) of SDEV) - (REMOVE STREAM DATUM)) + (* ;; "Don't send on error or if empty. TRUEFILENAME replaces host LPT with UNIX") - (* ;; "The PRINTERNAME might be marked explicitly on the stream. Otherwise let SEND.FILE.TO.PRINTER choose the host.") + (CL:WHEN (OR IMAGETYPE (SETQ IMAGETYPE (IMAGESOURCETYPE TRUENAME))) - (SETQ PRINTERNAME (PRINTERNAME STREAM)) - [SETQ IMAGETYPE (if (EQ (CHARCODE %.) - (CHCON1 (FULLNAME))) - then (PROG1 (SUBATOM PRINTERNAME 2) - (SETQ PRINTERNAME NIL)) - elseif (FILENAMEFIELD STREAM 'EXTENSION] - (SEND.FILE.TO.PRINTER STREAM PRINTERNAME `(,@PRINTOPTIONS IMAGETYPE ,IMAGETYPE - HEADING T)) - (FDEVOP 'DELETEFILE SDEV STREAM SDEV T) - else - (* ;; "Error while creating the file, if the user had wrapped a RESETLST/CLOSEF around his code. Presumably, he doesn't want the file printed") + (* ;; "A COPYFILE that must have started with a printable/convertible file, or such a file was created along the way") - (\CORE.CLOSEFILE STREAM]) + (SETQ TRUENAME (RENAMEFILE TRUENAME (PACKFILENAME 'EXTENSION (CAR ( + EXTENSIONS.FOR.IMAGEFILETYPE + IMAGETYPE)) + 'BODY TRUENAME)))) + (SEND.FILE.TO.PRINTER TRUENAME PRINTERNAME `(,@PRINTOPTIONS DELETE T HEADING T))) + (DELFILE (FULLNAME STRM]) (PRINTERDEVICEP - [LAMBDA (X) (* ; "Edited 19-Sep-2025 14:47 by rmk") + [LAMBDA (X) (* ; "Edited 17-Dec-2025 00:04 by rmk") + (* ; "Edited 13-Dec-2025 10:12 by rmk") + (* ; "Edited 19-Sep-2025 14:47 by rmk") (if (OR (NULL X) + (EQ X :DEFAULTPRINTER) (STRING.EQUAL X "")) then 'LPT else (CL:WHEN (LISTP X) @@ -888,41 +726,72 @@ ) (DEFINEQ -(PRINTERS - [LAMBDA (NAMESONLY) (* ; "Edited 5-Dec-2025 14:28 by rmk") +(DEFAULTPRINTERS + [LAMBDA (PRINTERTYPE NAMESONLY) (* ; "Edited 28-Dec-2025 00:35 by rmk") + (* ; "Edited 17-Dec-2025 00:44 by rmk") + (* ; "Edited 13-Dec-2025 14:04 by rmk") + (* ; "Edited 5-Dec-2025 14:28 by rmk") - (* ;; "The spec for DEFAULTPRINTINGHOSTS is ambiguous because a list whose CAR is a printertype could be a (PRINTERTYPE PRINTER) singleton. This tries to normalize that case to ((PRINTERTYPE PRINTER)") + (* ;; "The spec for DEFAULTPRINTINGHOSTS is ambiguous because a list whose CAR is a printertype could be a (PRINTERTYPE PRINTER) singleton. This tries to normalize that case to ((PRINTERTYPE PRINTER).") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) - (for P in (if (OR (NULL DEFAULTPRINTINGHOST) - (EQ 0 (NCHARS DEFAULTPRINTINGHOST))) + (for P in (if (EQ 0 (NCHARS DEFAULTPRINTINGHOST)) + then (CONS NIL) elseif (LITATOM DEFAULTPRINTINGHOST) then (CONS DEFAULTPRINTINGHOST) - elseif [AND (LISTP DEFAULTPRINTINGHOST) - (PRINTERTYPEP (CAR DEFAULTPRINTINGHOST)) - (OR (NULL (CDDR DEFAULTPRINTINGHOST)) - (GETMULTI PRINTFILETYPES (CADDR DEFAULTPRINTINGHOST] + elseif (AND (LISTP DEFAULTPRINTINGHOST) + (LITATOM (CAR DEFAULTPRINTINGHOST)) + (LITATOM (CADR DEFAULTPRINTINGHOST))) then (* ;;  "Trying to decode FOO (PDF) and (PDF FOO) as singletons. The spec is ambiguous") - (CONS DEFAULTPRINTINGHOST) - else DEFAULTPRINTINGHOST) eachtime (SETQ P (CL:IF NAMESONLY - (CL:IF (LISTP P) - (CADR P) - P) - P)) unless (MEMB P $$VAL) collect - P]) + (if (PRINTERTYPEP (CAR DEFAULTPRINTINGHOST)) + then (CONS DEFAULTPRINTINGHOST) + elseif (PRINTERTYPEP (CADR DEFAULTPRINTINGHOST)) + then (CONS (LIST* (CADR DEFAULTPRINTINGHOST) + (CAR DEFAULTPRINTINGHOST) + (CDDR DEFAULTPRINTINGHOST))) + elseif (GETMULTI PRINTFILETYPES (CAR DEFAULTPRINTINGHOST)) + then (CONS (LIST* NIL (CADR DEFAULTPRINTINGHOST) + (CAR DEFAULTPRINTINGHOST) + (CDDR DEFAULTPRINTINGHOST))) + else DEFAULTPRINTINGHOST) + else DEFAULTPRINTINGHOST) eachtime (CL:IF (AND NAMESONLY (LISTP P)) + (SETQ P (CADR P))) + when (OR (NULL PRINTERTYPE) + (EQ PRINTERTYPE (PRINTERTYPE P))) unless (MEMBER P $$VAL) collect P]) ) (RPAQ? DEFAULTPRINTINGHOST ) (RPAQ? EMPRESS#SIDES T) -(RPAQ? PRINTFILETYPES NIL) +(RPAQ? DEFAULTPRINTERTYPE 'WINDOW) + +(ADDTOVAR PRINTERTYPES (WINDOW (CANPRINT (PDF HTML)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND WINDOWPRINT))) + +(ADDTOVAR DEFAULTPRINTINGHOST (WINDOW WINDOW) + (UNIX UNIX)) +(DEFINEQ + +(WINDOWPRINT + [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 28-Dec-2025 18:07 by rmk") + (* ; "Edited 25-Dec-2025 08:49 by rmk") + (LET (IMAGETYPE) + (CL:WHEN (STREAMP FILE) + (CL:UNLESS (SETQ IMAGETYPE (STREAMPROP FILE 'IMAGETYPE)) + (ERROR "Not a recognizable imagefile type" FILE)) + (SETQ FILE (PACKFILENAME 'HOST 'UNIX 'BODY (UNIX-FILE-NAME FILE 'INPUT IMAGETYPE + IMAGETYPE)))) + (ShellOpen (TRUEFILENAME FILE]) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES) +(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES) ) (DEFINEQ @@ -2415,38 +2284,35 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6375 14105 (HARDCOPY.SOMEHOW 6385 . 8621) (HARDCOPYIMAGEW 8623 . 9073) ( -HARDCOPYIMAGEW.TOFILE 9075 . 9367) (HARDCOPYIMAGEW.TOPRINTER 9369 . 11198) (HARDCOPYREGION.TOFILE -11200 . 11687) (HARDCOPYREGION.TOPRINTER 11689 . 13084) (COPY.WINDOW.TO.BITMAP 13086 . 14103)) (14177 -26593 (MakeMenuOfPrinters 14187 . 15658) (PRINTERS.WHENSELECTEDFN 15660 . 17283) (MakeMenuOfImageTypes - 17285 . 18104) (GetNewPrinterFromUser 18106 . 18548) (PopUpWindowAndGetAtom 18550 . 20001) ( -PopUpWindowAndGetList 20003 . 21573) (NewPrinter 21575 . 23070) (GetPrinterName 23072 . 23360) ( -GetImageFile 23362 . 26341) (FetchDefaultPrinter 26343 . 26591)) (26648 45224 (DEFAULTPRINTER 26658 . -26919) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 26921 . 27936) (CAN.PRINT.DIRECTLY 27938 . 28371) (EMPRESS -28373 . 28948) (HARDCOPYW 28950 . 34578) (LISTFILES1 34580 . 34757) (PRINTER.SCRATCH.FILE 34759 . -35070) (PRINTERPROP 35072 . 35322) (PRINTERSTATUS 35324 . 35599) (PRINTERTYPE 35601 . 38354) ( -PRINTERNAME 38356 . 39442) (PRINTFILETYPE 39444 . 39706) (PRINTERTYPEP 39708 . 39933) ( -SEND.FILE.TO.PRINTER 39935 . 45222)) (45225 51784 (PRINTERDEVICE 45235 . 46212) (PRINTERDEVICE.OPENFN -46214 . 46934) (PRINTERDEVICE.CLOSEFN 46936 . 50021) (PRINTERDEVICEP 50023 . 50694) (PRINTERNAME 50696 - . 51782)) (51846 53486 (PRINTERS 51856 . 53484)) (53714 54272 (SCALEREGION 53724 . 54270)) (54496 -61882 (TEXTTOIMAGEFILE 54506 . 55688) (COPY.TEXT.TO.IMAGE 55690 . 61880)) (61944 63687 ( -\BLTSHADE.GENERICPRINTER 61954 . 63685)) (63754 100920 (MAKEHARDCOPYSTREAM 63764 . 65480) ( -UNMAKEHARDCOPYSTREAM 65482 . 66412) (HARDCOPYSTREAMTYPE 66414 . 66821) (\CHARWIDTH.HDCPYDISPLAY 66823 - . 67643) (\DSPFONT.HDCPYDISPLAY 67645 . 70440) (\DSPRIGHTMARGIN.HDCPYDISPLAY 70442 . 71297) ( -\DSPXPOSITION.HDCPYDISPLAY 71299 . 71674) (\DSPYPOSITION.HDCPYDISPLAY 71676 . 72051) ( -\STRINGWIDTH.HDCPYDISPLAY 72053 . 73008) (\STRINGWIDTH.HCPYDISPLAYAUX 73010 . 78350) (\HDCPYBLTCHAR -78352 . 83249) (\HDCPYDISPLAY.FIX.XPOS 83251 . 84008) (\HDCPYDISPLAY.FIX.YPOS 84010 . 84751) ( -\HDCPYDISPLAYINIT 84753 . 86443) (\HDCPYDSPPRINTCHAR 86445 . 92358) (\SLOWHDCPYBLTCHAR 92360 . 98976) -(\CHANGECHARSET.HDCPYDISPLAY 98978 . 100918)) (101235 150786 (MAKEHARDCOPYMODESTREAM 101245 . 103966) -(UNMAKEHARDCOPYMODESTREAM 103968 . 105558) (\HCPYDISPLAYIMAGEOPS 105560 . 108380) (\BLTSHADE.HCPYMODE -108382 . 109048) (\BITBLT.HCPYMODE 109050 . 109798) (\BRUSHCONVERT.HCPYMODE 109800 . 110349) ( -\CHANGECHARSET.HCPYMODE 110351 . 113613) (\DASHINGCONVERT.HCPYMODE 113615 . 113956) ( -\CHARWIDTH.HCPYMODE 113958 . 114395) (\DRAWLINE.HCPYMODE 114397 . 114926) (\DRAWCURVE.HCPYMODE 114928 - . 115515) (\DRAWCIRCLE.HCPYMODE 115517 . 116002) (\DRAWELLIPSE.HCPYMODE 116004 . 116688) ( -\DSPFONT.HCPYMODE 116690 . 119374) (\DSPLEFTMARGIN.HCPYMODE 119376 . 120118) (\DSPLINEFEED.HCPYMODE -120120 . 120753) (\DSPRIGHTMARGIN.HCPYMODE 120755 . 121823) (\DSPSPACEFACTOR.HCPYMODE 121825 . 122600) - (\DSPXPOSITION.HCPYMODE 122602 . 123620) (\DSPYPOSITION.HCPYMODE 123622 . 124272) (\MOVETO.HCPYMODE -124274 . 124488) (\FONTCREATE.HCPYMODE 124490 . 126447) (\CREATECHARSET.HCPYMODE 126449 . 128172) ( -\STRINGWIDTH.HCPYMODE 128174 . 128969) (\HCPYMODEBLTCHAR 128971 . 134721) (\HCPYMODEDSPPRINTCHAR -134723 . 140657) (\SLOWHCPYMODEBLTCHAR 140659 . 147288) (\SFFixY.HCPYMODE 147290 . 150784))))) + (FILEMAP (NIL (6471 19196 (MakeMenuOfPrinters 6481 . 7970) (PRINTERS.WHENSELECTEDFN 7972 . 9903) ( +MakeMenuOfImageTypes 9905 . 10724) (GetNewPrinterFromUser 10726 . 11282) (PopUpWindowAndGetAtom 11284 + . 12735) (PopUpWindowAndGetList 12737 . 14307) (NewPrinter 14309 . 15923) (GetPrinterName 15925 . +16213) (GetImageFile 16215 . 19194)) (19251 36337 (HARDCOPYW 19261 . 20655) (LISTFILES1 20657 . 20834) + (PRINTERPROP 20836 . 21086) (PRINTERSTATUS 21088 . 21363) (PRINTERTYPE 21365 . 24426) (PRINTERNAME +24428 . 25514) (PRINTFILETYPE 25516 . 25889) (PRINTERTYPEP 25891 . 26116) (SEND.FILE.TO.PRINTER 26118 + . 31936) (FIND.PRINTER.FOR.IMAGETYPE 31938 . 34534) (CAN.PRINT.SOMEHOW 34536 . 35908) ( +CAN.PRINT.DIRECTLY 35910 . 36335)) (36338 44113 (PRINTERDEVICE 36348 . 37376) (PRINTERDEVICE.OPENFN +37378 . 39686) (PRINTERDEVICE.CLOSEFN 39688 . 42097) (PRINTERDEVICEP 42099 . 43023) (PRINTERNAME 43025 + . 44111)) (44175 46599 (DEFAULTPRINTERS 44185 . 46597)) (46998 47651 (WINDOWPRINT 47008 . 47649)) ( +47769 48327 (SCALEREGION 47779 . 48325)) (48551 55937 (TEXTTOIMAGEFILE 48561 . 49743) ( +COPY.TEXT.TO.IMAGE 49745 . 55935)) (55999 57742 (\BLTSHADE.GENERICPRINTER 56009 . 57740)) (57809 94975 + (MAKEHARDCOPYSTREAM 57819 . 59535) (UNMAKEHARDCOPYSTREAM 59537 . 60467) (HARDCOPYSTREAMTYPE 60469 . +60876) (\CHARWIDTH.HDCPYDISPLAY 60878 . 61698) (\DSPFONT.HDCPYDISPLAY 61700 . 64495) ( +\DSPRIGHTMARGIN.HDCPYDISPLAY 64497 . 65352) (\DSPXPOSITION.HDCPYDISPLAY 65354 . 65729) ( +\DSPYPOSITION.HDCPYDISPLAY 65731 . 66106) (\STRINGWIDTH.HDCPYDISPLAY 66108 . 67063) ( +\STRINGWIDTH.HCPYDISPLAYAUX 67065 . 72405) (\HDCPYBLTCHAR 72407 . 77304) (\HDCPYDISPLAY.FIX.XPOS 77306 + . 78063) (\HDCPYDISPLAY.FIX.YPOS 78065 . 78806) (\HDCPYDISPLAYINIT 78808 . 80498) (\HDCPYDSPPRINTCHAR + 80500 . 86413) (\SLOWHDCPYBLTCHAR 86415 . 93031) (\CHANGECHARSET.HDCPYDISPLAY 93033 . 94973)) (95290 +144841 (MAKEHARDCOPYMODESTREAM 95300 . 98021) (UNMAKEHARDCOPYMODESTREAM 98023 . 99613) ( +\HCPYDISPLAYIMAGEOPS 99615 . 102435) (\BLTSHADE.HCPYMODE 102437 . 103103) (\BITBLT.HCPYMODE 103105 . +103853) (\BRUSHCONVERT.HCPYMODE 103855 . 104404) (\CHANGECHARSET.HCPYMODE 104406 . 107668) ( +\DASHINGCONVERT.HCPYMODE 107670 . 108011) (\CHARWIDTH.HCPYMODE 108013 . 108450) (\DRAWLINE.HCPYMODE +108452 . 108981) (\DRAWCURVE.HCPYMODE 108983 . 109570) (\DRAWCIRCLE.HCPYMODE 109572 . 110057) ( +\DRAWELLIPSE.HCPYMODE 110059 . 110743) (\DSPFONT.HCPYMODE 110745 . 113429) (\DSPLEFTMARGIN.HCPYMODE +113431 . 114173) (\DSPLINEFEED.HCPYMODE 114175 . 114808) (\DSPRIGHTMARGIN.HCPYMODE 114810 . 115878) ( +\DSPSPACEFACTOR.HCPYMODE 115880 . 116655) (\DSPXPOSITION.HCPYMODE 116657 . 117675) ( +\DSPYPOSITION.HCPYMODE 117677 . 118327) (\MOVETO.HCPYMODE 118329 . 118543) (\FONTCREATE.HCPYMODE +118545 . 120502) (\CREATECHARSET.HCPYMODE 120504 . 122227) (\STRINGWIDTH.HCPYMODE 122229 . 123024) ( +\HCPYMODEBLTCHAR 123026 . 128776) (\HCPYMODEDSPPRINTCHAR 128778 . 134712) (\SLOWHCPYMODEBLTCHAR 134714 + . 141343) (\SFFixY.HCPYMODE 141345 . 144839))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index 7200bd74f47d60cacaa3c1cacf9d441afd443bff..d04131ef19be0a8458a71db94aa62df5c030eb40 100644 GIT binary patch delta 6874 zcmb7JU2q#$72cKNgeZw4w~iCLb$X(tjhxnwcJ=SHL~Cgstu1L4?JBm@l*W$L%57?= zX=tGo)Zy=e2Zr>vQ~K1BrX8lh;8+nqZ3olN01tE+`oh4#4DbeThG7_(0m?aNSC(YE z9q`z@d;jk}=R4my=lU1F_59%{p07>ys)^xD<-)KUQlp?GMwR4fBy#o9;}^oAA@Bt{ zTH~Xk5dH>W?sDbA(qoqvE>`BD@~KOgpSW`r#*IQ|q*yWvwq6<;H%lW%UOT1RGesSy zu*sa_Hdt81S;xz{9H@z_zuz~y)e6bLkS{oH!KyChJ@BG5rx5NI%F0Rj2 z2L|x>t%*kWWOd-|%xcy%edB`%Cht1C{C6p+L{vzdg|ucvI0EV1s8+;XWqzyKqLWqBa_MDDI#FnS-pg_LOdxZ z{Zn1>5Crn#0sn#es{gn0w#C`UD)pCc8Tr@__pst;1JUNW>i-(}qc@V(N}04-oS8y_ zBz(alsNkL(il6`^lyHWn5ST^VFbkH*AI^)H4-eLcKzhzANjt_?j_8f9vE`4C?R0c` z-xzCJXJPSUc}S}d=-k}c!3dBWJ6OYW+rG$eZkzM1av{yn3_r&kJ9svP0sZtG@}xAK zS`w0@jO=b&b!P0QZ+Wjh<1So|8*Y8b>B)1lcMv_d4%XNbojMqYSko5qI}VmHI(n?6Te^*2C2t+W z$^;8w2;@}PHc2kCPLXrZutgnhc(ZR--ezE~^|5bxuJfy}w&(#OH zkJGTRd%0?OJo1@^JxKVHbidoz0TQ*anU;B?RpaItayPx7zwyCmC;9axui|bGJ%CuP zE+4BOayEVw$~9iB%)NL9-sYFx0nY1DZgqxSEq}@RVAkLf0|OU!bC07dNBBL@#~a{p zp5EEoRQJGz?p4DhPoBBx&F$^J=`H)ET2M`*pmp0ei)Rq-D%vW7v{{N0bvM0_iX2V4 zWcyab$##7b8zIRm;U-_GXcIUQ)fvNDHFP#qc2RS~X<2kBA+j?PsL3qy4BzZLK}2$O~m~|)qom8xlzP}Y{}7w5?85}8^fomR@lbzqk}Qf_@k|X z=%UYd$&xq4Sbr(y#4mHws`j0+o*p?n<82(N-ZJM|E%zMS#+JYx=^@^Z?lNUAwyfiM zw2S4RqctzTBL(9W@#Mz5Zrd*(?7NQEA%b&rM*bs?{KSzh!sf^75 zv4Z4FB-S>L2pE+cBpydymJsDbL%xrI;1=;q2yCrHR*HaZ$*Z<5Fh&GOU%?p0)8m)4 z1~{>4kH_#f!qr_*iFxl; zkIb#hb;C2W{08=MsC0UzcT*ofb@@8RE*LVj+oPg{D1>lAm=Vj&>sfPZlS!lB-P9-A zIZ>46scoDHJ!xk!Y+*#Pv5J(mRq!$7+q|l)3I)>a;TX0VqoiY0Q^?KKSQTuREg#1y zcF&BMo%2Xd%xWy_#^6}J-vKdefh!5X-p017U;ZIi8t2LJ^m+O`vUarI&vpE0uYbN~ zG`tIb%p;b6Dh0#q@h%ggx?W_=D0qZ*nK~!P&7gU;DF@|(7S9y~W*TNuFzHH^f;fkx zEsF4>NW%vy18ntmI2Pf}9n`qE6DAZtp2MT1T1UNIrkHj;M4`>%$}!p=uPsJmclV!? zF*QjwcJi<}sb#g|6S2b+Sq$?eiQ9U2r*JwV4T*&7!xQNGT_=ozaSM)38bGUb z$rtUI#?$a|15-*$gWV>y=Z+@ShZ1oE4F~BMRni z8

hIA~*Hjr@P-2%({+WDKnJX-#^>xH%T9_;dvd5&?N$Kik6;iq63miu{e0JhVkM? zhDLAP9;hP7&tW{QrPI1)0kK%lv=Dd>s*x2)HS5!2kk@7sNV9Dv+(N5F$P7hiV9d7q?Gux1rZ_T|EjdsLxg?1p;%EVL zGt3-f5%J2={(~6fl6`Hm7h=k|Dt>N&M~T&a_w~uOjn3J1uec_AQaYzajfpF@PRfd!bq#xFKERs`+qg?Ir%Ay01EQ-fK6cFUZui@+8-IYEEf^OHMra zb$8VAjMK%bUAf&YIX#_%hwkr|mA0xr&&ptR>z>&4i`;^#DtUIpFTbtTM9$mTpL!{k z<1?(S4CEXNf8nbh`R(ODxIy$DGtr14^mFAd{y;Xk?0tDxHW9Zk^NqeR6!ux~#)HPt4`h!S(&cr8jplich{P;H;g)5})}0C2%UzVF70_+W0$sa5ytwf6?A*l)EYMvTWpC_10`+%K zzWku*f903r->=-)+q(Ir+=Mo0DdM}|xKR73Ja>y=x8;$W0pbt@(`Md+;CR7m0?&z! zI!o@AI`}%cL+ncI6xOv9Axu&!Pvw6XxWj`!=K`A|D*ADjXkPAq@7f99`r1D6&b7W8 zUJW2dAm|Kpki_G(3?{rK++&+zV9Du$`)^)Y28)?-$lCcFE#{;Av~01?u}IMkE4ANG&OzFcF1Ei~#L>8>c;waMejD9DlLqmB zCMEq8Mbkd<{;QK>@cM1CPb97@;*sl7v3H_heE)j4`04dgaXQy4ZhdW^7<%n)>|wta z?mCyjgj#%Vwog1$zFqw2wE_I=7PWJG_QJVrCS9Bv%h_c5ARc(|fEajvzffO~NAjbkx_B+3nA@65Y$0s%*mq|C3tQQ4F#rGn delta 9298 zcmai4Yiu0Xb>7(}DVdUJlBQM?C0SRiN+M-*vorf7Q@cCdo#l?WJG0z}R+9B1#g&&b zEh!RRw|3mI0o!d-G>JXd!!qK)Mu605+)|_#uxlGc8>F!VI7yqfDAEFH|FuAYGX2pa zKMMD|=g!QMGSd>$?wvdLan8BteCKiZpMT*0@jv>%Q6G?_BiY9J5hbF;StK%sfARP$ zPkh0Oq=s2{NLJc!<N6$n{7gLN^~rq9Fy%yi48=QVQ*@ zt{Yji&T>ph%rD3OiLiR?sWe;ci1ObPwH2iDlN+NF<`Lv1|$gXOVkokOd9crpM>^ z`AU!T^{2M*Prkg&GKH~B!K`RFt~eW0$IUXf`rJ0)k2WZQ6~R;q?19|_9=|25F(o;t4I-9r6(b8wJY zo$Isw0qUZ0^l_A)C+R(xw#wxZYYPPGKI#e|?e?L$D!}C~Gg*!>v!oeok3JP=r*xxI zD{GE!BoY?O8906xk9vZsvuKK`g@RcRkJqYIXt;JvGpZF9jj#!=DyG&dTDepK+g_9rc!3OOC>1kmR01GRdlX6}A8<@XQJ-xAu66Z0B%woLU_x#Kj|}=jbFLl!UjH z7z{&nZ18hB=?x&WB#m(vwV;1|)mf6gyEOFARTGyDmS7W&1^vnC#~V2S(y!mbp~2Nl z*#!nNGOmEmfK1-hGn&P8=x0{TskK7Yo$4}NhGqEG>!c7blHx%D^Rr8j&QjOvjTP!V z9=Ms8-iOw`_i~=tcweY24I-9w(x$x2UUHOGG$R{^G%O8b3%eU9+gi}(J4t%vphw)J zpZEca+(SE%0dgu`ox8NqxN1y42}unl6lT_{rCOE6lk8c;%*W? zo9i@TJ<2-P9%1|>4{;ix7{e0IP{>E}zLqz$Kkoi=lOqi+@nz>_4NvslG(F`QuR3|C)X+si;u233ULMyKMxne0=Bra3kU7k zr^QmNV&G?Wv0 z=_E}2vAo|eox+D-I$bD=mt@>$`q<`r|I$c(;O^FD+J5uJgI4++Kit*jfo7VlpuTg@ z4KZUyr@f9&8W(2^#ciYuD`xMTqCwNlo=<&7ud{mx4d=QrsyMRXLS^#jJc^u15?>Ig zojTiN$?+5$pM?0v3solLtc6q@dCD-wQ&khdUC&nF%u*~{DP<9<=!RP5_9z31xtN^u zK|EuyROH@K3E3rzf;twb1FMv@a-yUk*9zRM*E>EL`>ykZaRRwI`Lks7)t3iSe27aJ zEZ~$@46oM$Es;yitEb-7aP4BRZz z!imApP+>pBa;f{(SMjaUx(g zV;UJ1;#H#TRPLk(w+w%qVnzmL3%4EP!IWA;Fp%Yl=HN>Ow93f@o2r?JGLtdK?Chrl zd4DWv|3%&8V@c%yNx|^UZAI z!t_(~t_QHsb?)^mqqfz#Gv;nl<>T{OA)7PU=sMVlurGH6_*)Ks2fmD`1QUZhp*BT5 zn?=MR$Cz2oYh}>Rk_r1)oppaAxm@o0FKM~Bd1SNwLT`NequzfBSR0T+7LQ<+`L=Sq zAckfGulObCwMUvG9M8SqgGJo^&=NG8KE(94P$?W9=cr>G)5=xuWXZ>Jmclu+>^WP< zl~K4lp;2VQVI!j&w3sbLgO;-_`2vm}eAF=W9f1o7sBQn=x8I)+v^tu-();PAK0ddt zlXG~o^-HMA;=lTa;Nx6!0Du$?(SC>#ogJK54yWO4Pd?bbaqu@Q`>>Q>on6|UZf!ls z*ClmrZ@!01K=IrHUx~@yBPSheDQ(7J)V8V&ShRyyM7C3@2sG9KuSAbo;?`e5Y!qV$ z4^(tO0@?^poH$+w&gRWZm4c^(2Y^L7jqn8Y2*~V8k7t~KI|K7kowka07H#r;Sv+V2 zj_nVEQ?LZ&a-*bmK@vjcQwBFVg~fmoZqw@pUkHm_vcb4VAcAAT0I}|c1xVT+*6#C8 z#XkRVQt_S~`5~|#Gt6>PEzsPyKX$YTGBro`THNtOSVbQjJ7N?nT6HQ{P$!O{ca$B$ z!DKWoJCac=T7~z4KMWM(Mvke48j@IeKkftLB3S=!>i(c{e474i0__*(p}^!K^WzLuVSbupTr@1S#D8ce@5 zD@A*+`va|C&AqVFyqW%hjQMNydD8!ZbyQ??CsxMa)0Qsgm-cHSELwf_j_<=f?X^a6 z7Jsgy|JyXXuWyqPXt8Ghadf>RM$#uK78%dtpGaqWRy0$j)vLDIv-mT^e`fJV>XKeu zenP#^$F;LH($~BB9H+j%b8wE9s1FYI1-6*|v`RloX7z4|+1oFjUXH6Ygc!W@*`y$M zru%!;OB3#V7B7BJYg?}LQD&Jy% zal$?ve@p$df)EF>x1!z+6ngzLn^!W@OxMcdUm{SMw-p)sm>IL}NU3r>Kn(C<=e1mCI%sjw$87Azh9}Mx8fGYE5J- z(q;t-4&T83_x@d$Lg@glNi!8W>du6Fb-ixVTOJ`yBH@gX5tO(i;Q7`9xr}Akhd~Hq zk%M?<Q)IyqQ$G_o!Uiy~Tg>^15| zQivLqU7j;wN-E{z4^t8m`^S&$vXX8n2q0OLxv>~(5<^)H$f2==53?bI*XZcbg!jst znHqe2HEgIw8sUN&6$OTokR@0sGkxjs0$XUz&$FkSjjIi|aG70eT$*KGilxl)Ts+i` zvP6u9W-m9cu}ha1*lgq4+~b!}0A$mb7!6?;kgtb8_NbkGbpQR4C=0PGB0oh9k-MTg zR*^@O?yeW+XrB;*r8o=CiFGeu@Fp$%?v)1C0QiS0=dU&z&ORXq*bmh)`SR0ZXWPG{ zVTEz5YBiImK*05LPDzfmiu-j(J>c49Se2hlRsdLQ6ImYhsBefbGVvFwO`!}AV7w?0 z)fiXr___+IZx$8Bj3%O6hRg{X!BA5QK`cm_P%>2%7J3dmvCy-jmfku4atOB4KA5-G>J5)B=k456*DYY^Iwr)U6Ajs+yq zBZBRXR%xfOFeK+}b|+9&s9lko|}fa zff{$)B(Py7{bEbNC)Ib7+8!1jvD}q!9jph*3B6Yzq*tr&)(3Cb2dVGk>JrnX#mAf> ztIK~^4>t4louu98gDZ=l@`2GT+AP2pj;`)~#iJ*0#6 zAX&?4QQ$*%{hCO(PTukTp>Xjuj0Rmdd%2^+r+@J+>1;32CY0DVdl#*@%pU*Qp2ZvP zE8>G@_Vsm}{ef0@vw!JfjC@HtJFr4;&4F_;XkXAD^h^1}H_U<7FXk5i$?W%^?O*(B zTJFwgRZ)MTg&tepMf4n{Pjab6dV%FQ|E^q-BHAm>#e>Vc>p_RlHZ?Tu_uZig9tO|v zEK;g-RB-cZJ^0mn@MwJ}jXdLwe1cYhq!SnSPP|WeH zF@WNFPZ~p(=cO9l$-A~5g{P+LF2ohMQnEBS_hkERY|TixQXZheSvru*WzT7>po;<; zoN0x}Cko;#NRf!+j?aw%fIh?lpTxaPGyxyV_#gZu3KSuxI%tMx#66+xW$x*pxCE!! z#DCY%<9ix|W$4%trFyt)et9w0HeN#_O&0fapf8r~y9OztCb3ik}R1BV{!96^~`vL_B5 zh^K`arMVHHKm}CS4NV*}Qm0emZjqO`MIV;L+1Nk59_&U?mP04P4Lcp)u_Z=Nct6~2 ztKseT-ou-M9{Q3)=ZfHP#rI(@Fbr9a;! zE6M%m|q<6ljnpd*}*U`?%<>c_ys3Xg@YqnK)C&r z>pLtb3ytwhI0&1UL>;xI;oQY|T7kC?i>~(|9=TL_DC9)?IS7)@t5U@+D42e)Q$mfD zGL=ud*D@Rm)GTCLx7PFl=D#8|;o>iseowU0O@g#Mt&kR9pL9{*fKzULjJy>A+uUN=AZ>YBArrYD7H1w<240vUyj1$n_fsUw}An-3IvoC+#rFQaHJq)Ydjgqpl~ zw_!pg$6;OVq8)-XK7Q>RinCzjPjwNI1-2X1-El?alJ!H*{QCuc$_CU-C))U z#q9A%LsD}22jQUPmgBr~RfMddVj6`L(9o};>L!Z5&DBAmQ8-uDjvg6Q9$0?i+D87OZI7PTN^e1@#b}443 zm7qVGq_K+lLbV33>`#=z=c7C>h(| zeeDrzea!y<$2Hv>1Q%|Z(?9AS(G>ZSf~2*i$#YxSb7k)5P|HqDF0ByIC4w_q^cK?2m7ju;3rOU9snH z^`Q04t=;yGTQXWdycM_q=hh*#4!k~QpLu-Td3rgQ?AKm0C&+0(bfnDh19N&CvV-96YXt7QsmS;G%|y6ykC{b-js Sq~+)vFLm{AK(zJt^#1}MIIE)o diff --git a/sources/IMAGEIO b/sources/IMAGEIO index e53db353..2f7b6f02 100644 --- a/sources/IMAGEIO +++ b/sources/IMAGEIO @@ -1,23 +1,36 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "12-Dec-2025 23:14:50" {WMEDLEY}IMAGEIO.;26 82764 +(FILECREATED "28-Dec-2025 17:57:56" {WMEDLEY}IMAGEIO.;36 97264 :EDIT-BY rmk :CHANGES-TO (VARS IMAGEIOCOMS) - (FNS IMAGETYPE.BITMAPSCALE IMAGETYPE.BITMAPFILE) + (FNS HTMLFILEP) - :PREVIOUS-DATE " 7-Dec-2025 16:27:20" {WMEDLEY}IMAGEIO.;25) + :PREVIOUS-DATE "25-Dec-2025 09:09:03" {WMEDLEY}IMAGEIO.;34) (PRETTYCOMPRINT IMAGEIOCOMS) (RPAQQ IMAGEIOCOMS [(FNS OPENIMAGESTREAM) - (FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP IMAGEFILETYPE IMAGEFILEPROP) + (FNS IMAGESTREAMP IMAGESTREAMTYPE IMAGESTREAMTYPEP IMAGEFILEPROP IMAGESOURCEFILEP + IMAGESOURCETYPE) (FNS EXTENSIONS.FOR.IMAGEFILETYPE IMAGEFILETYPE.FROM.EXTENSION) (FNS CONVERT.TO.IMAGEFILE) - (FNS IMAGETYPE.BITMAPSCALE IMAGETYPE.BITMAPFILE) + (FNS BITMAPFILEP BITMAP.TO.BITMAPFILE BITMAPFILE.TO.BITMAP BITMAPFILE.TO.IMAGEFILE) + (FNS BITMAP.TO.IMAGEFILE WINDOW.TO.IMAGEFILE SCREENREGION.TO.IMAGEFILE COPY.WINDOW.TO.BITMAP) + (COMS (INITVARS (PRINTFILETYPES NIL)) + (GLOBALVARS PRINTFILETYPES) + (FNS DEFAULT.IMAGETYPE.CONVERSIONS) + [P (DEFAULT.IMAGETYPE.CONVERSIONS '(BITMAP BITMAP.TO.IMAGEFILE WINDOW + WINDOW.TO.IMAGEFILE SCREENREGION + SCREENREGION.TO.IMAGEFILE BITMAPFILE + BITMAPFILE.TO.IMAGEFILE] + (ALISTS (PRINTFILETYPES BITMAP WINDOW SCREENREGION BITMAPFILE))) + (COMS (* ; "Until HTML streams") + (ALISTS (PRINTFILETYPES HMTL)) + (FNS HTMLFILEP)) (INITVARS (IMAGESTREAMTYPES NIL)) (FNS \GOOD.DASHLST) (FNS DRAWDASHEDLINE) @@ -128,27 +141,42 @@ of (fetch (STREAM IMAGEOPS) of S]) -(IMAGEFILETYPE - [LAMBDA (FILE) (* ; "Edited 28-Sep-2025 11:35 by rmk") +(IMAGEFILEPROP + [LAMBDA (IMAGEFILETYPE PROP) (* ; "Edited 19-Dec-2025 10:48 by rmk") + (* ; "Edited 29-Oct-2025 13:32 by rmk") + (LET [(VAL (CAR (GETMULTI PRINTFILETYPES IMAGEFILETYPE PROP] + (if (NULL VAL) + then (CAR (GETMULTI PRINTFILETYPES 'DEFAULT PROP)) + elseif (LISTP VAL) + then (APPEND VAL (CAR (GETMULTI PRINTFILETYPES 'DEFAULT PROP))) + else VAL]) + +(IMAGESOURCEFILEP + [LAMBDA (IMAGESOURCE) (* ; "Edited 23-Dec-2025 15:38 by rmk") + (AND IMAGESOURCE (OR (STRINGP IMAGESOURCE) + (LITATOM IMAGESOURCE) + (CL:PATHNAMEP IMAGESOURCE]) + +(IMAGESOURCETYPE + [LAMBDA (X) (* ; "Edited 24-Dec-2025 14:38 by rmk") + (* ; "Edited 20-Dec-2025 14:07 by rmk") + (* ; "Edited 28-Sep-2025 11:35 by rmk") (* ; "Edited 18-Sep-2025 11:13 by rmk") (* ; "Edited 13-Sep-2025 23:36 by rmk") (* ; "Edited 3-Mar-93 14:34 by rmk:") (* ; "Edited 22-Aug-92 14:27 by jds") (* ; "Edited 26-Aug-87 14:22 by Snow") - (if (IMAGESTREAMP FILE) - then (IMAGESTREAMTYPE FILE) - elseif (CAR (find ITYPE TESTFN in PRINTFILETYPES when [SETQ TESTFN (CAR (GETMULTI ITYPE + (if (WINDOWP X) + then (OR (WINDOWPROP X 'IMAGETYPE) + 'WINDOW) + elseif [CAR (find ITYPE TESTFN in PRINTFILETYPES when [SETQ TESTFN (CAR (GETMULTI ITYPE 'TEST] - suchthat (APPLY* TESTFN FILE))) - elseif (LISPSOURCEFILEP FILE) + suchthat (CAR (NLSETQ (APPLY* TESTFN X] + elseif (IMAGESTREAMP X) + then (IMAGESTREAMTYPE X) + elseif (LISPSOURCEFILEP X) then 'TEXT - else (GETFILEINFO FILE 'TYPE]) - -(IMAGEFILEPROP - [LAMBDA (IMAGEFILETYPE PROP) (* ; "Edited 29-Oct-2025 13:32 by rmk") - (* ; "Edited 26-Aug-87 14:22 by Snow") - (for X in PRINTFILETYPES when (EQMEMB IMAGEFILETYPE (CAR X)) - do (RETURN (CADR (ASSOC PROP (CDR X]) + else (GETFILEINFO X 'TYPE]) ) (DEFINEQ @@ -171,7 +199,11 @@ (DEFINEQ (CONVERT.TO.IMAGEFILE - [LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS NOERROR) (* ; "Edited 2-Nov-2025 08:53 by rmk") + [LAMBDA (IMAGESOURCE IMAGEFILE IMAGEFILETYPE OPTIONS NOERROR) + (* ; "Edited 25-Dec-2025 09:08 by rmk") + (* ; "Edited 21-Dec-2025 09:02 by rmk") + (* ; "Edited 13-Dec-2025 11:46 by rmk") + (* ; "Edited 2-Nov-2025 08:53 by rmk") (* ; "Edited 29-Oct-2025 13:33 by rmk") (* ; "Edited 26-Sep-2025 23:46 by rmk") (* ; "Edited 20-Sep-2025 12:57 by rmk") @@ -183,50 +215,283 @@ (* ;; "If this is the result of (COPYFILE 'XXX {LPT}), then XXX (e.g. a Tedit file) has already been copied once, to the LPT device, where it has lost its original identity. PRINTERDEVICE.CLOSEFN calls SEND.FILE.TO.PRINTER, which calls this to apply the (e.g. Tedit) conversion method for the imagetype of this PRINTERTYPE. In that case there is no reason for the conversion function to print the name of its target image stream") - (CL:UNLESS (STREAMP FILE) - (SETQ FILE (FINDFILE FILE T))) + (CL:WHEN (IMAGESOURCEFILEP IMAGESOURCE) + (SETQ IMAGESOURCE (FINDFILE IMAGESOURCE T))) [if NOERROR then (push OPTIONS 'NOERROR T) else (SETQ NOERROR (LISTGET OPTIONS 'NOERROR] - (SETQ IMAGEFILE (if (STREAMP IMAGEFILE) - elseif IMAGEFILE - then (PACKFILENAME 'BODY IMAGEFILE 'EXTENSION IMAGETYPE) - elseif (OR (NULL IMAGEFILE) - (STREAMP (FULLNAME FILE))) - then (OPENSTREAM '{NODIRCORE} 'OUTPUT) - else (PACKFILENAME 'VERSION NIL 'EXTENSION IMAGETYPE 'BODY FILE))) - (LET ((FILETYPE (IMAGEFILETYPE FILE)) + (CL:WHEN (AND (NULL IMAGEFILETYPE) + (LISTP IMAGEFILE)) + (SETQ IMAGEFILETYPE (CDR IMAGEFILE)) + (SETQ IMAGEFILE (CAR IMAGEFILE))) + (CL:UNLESS IMAGEFILETYPE (* ; + "maybe we can get it from the filename") + (SETQ IMAGEFILETYPE (IMAGESOURCETYPE IMAGEFILE))) + (LET ((SOURCETYPE (IMAGESOURCETYPE IMAGESOURCE)) CONVERTED CFN) (* ;; "The conversion function may abandon the IMAGEFILE we provide and create its own.") - (if [AND (SETQ CFN (LISTGET (IMAGEFILEPROP IMAGETYPE 'CONVERSION) - FILETYPE)) - (SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN FILE IMAGEFILE IMAGETYPE OPTIONS] - then (CLOSEF? CONVERTED) - CONVERTED - elseif NOERROR - then NIL - else (ERROR (CONCAT "Can't convert " FILETYPE " file to " IMAGETYPE) - (FULLNAME FILE]) + (if (EQ IMAGEFILETYPE SOURCETYPE) + then + (* ;; "Already have what we want") + + IMAGESOURCE + else + (* ;; "if IMAGEFILE is NIL, we don't necessarily want to construct a name instead of a stream from the IMAGESOURCE. foo.BM would give us foo.PDF instead of NODIRCORE.") + + [SETQ IMAGEFILE (if (STREAMP IMAGEFILE) + elseif IMAGEFILE + then (PACKFILENAME 'BODY IMAGEFILE 'EXTENSION + (OR (CAR (EXTENSIONS.FOR.IMAGEFILETYPE IMAGEFILETYPE) + ) + IMAGEFILETYPE)) + else (OPENSTREAM '{NODIRCORE} 'OUTPUT] + (if [AND (SETQ CFN (OR (LISTGET (IMAGEFILEPROP IMAGEFILETYPE 'CONVERSION) + SOURCETYPE) + (LISTGET (IMAGEFILEPROP 'DEFAULT 'CONVERSION) + SOURCETYPE))) + (SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN IMAGESOURCE IMAGEFILE IMAGEFILETYPE + OPTIONS] + then (CL:WHEN (STREAMP CONVERTED) (* ; "Can't tell from the name") + (STREAMPROP CONVERTED 'IMAGETYPE IMAGEFILETYPE)) + (CLOSEF? CONVERTED) + CONVERTED + elseif NOERROR + then NIL + else (ERROR (CONCAT "Can't convert " SOURCETYPE " file to " IMAGEFILETYPE) + IMAGESOURCE]) ) (DEFINEQ -(IMAGETYPE.BITMAPSCALE - [LAMBDA (WIDTH HEIGHT IMAGETYPE) (* ; "Edited 12-Dec-2025 23:06 by rmk") - (* ; "Edited 26-Aug-87 14:19 by Snow") - (LET [(FN (IMAGEFILEPROP IMAGETYPE 'BITMAPSCALE] - (CL:IF FN - (APPLY* FN WIDTH HEIGHT) - 1)]) +(BITMAPFILEP + [LAMBDA (FILE) (* ; "Edited 23-Dec-2025 15:28 by rmk") + (* ; "Edited 19-Dec-2025 10:56 by rmk") -(IMAGETYPE.BITMAPFILE - [LAMBDA (FILE IMAGETYPE BITMAP SCALEFACTOR REGION ROTATION TITLE) - (* ; "Edited 12-Dec-2025 23:04 by rmk") - (* ; "Edited 26-Aug-87 14:19 by Snow") - (* ; "convert a bitmap into a file") - (DECLARE (SPECVARS . T)) - (EVAL (IMAGEFILEPROP IMAGETYPE 'BITMAPFILE]) + (* ;; "True if FILE is a file containing a single bitmap.") + + (CL:WHEN + [AND FILE + (OR (EQ 'BITMAPFILE (IMAGEFILETYPE.FROM.EXTENSION FILE)) + (EQ 'BITMAP (OR (RESETLST + [LET ((STREAM (GETSTREAM FILE 'INPUT T))) + [if STREAM + then [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE] + else (RESETSAVE (SETQ STREAM (OPENSTREAM (CL:IF + (STREAMP FILE) + (FULLNAME + FILE) + FILE) + 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (CAR (NLSETQ (RATOM FILE (FIND-READTABLE "INTERLISP"])] + 'BITMAPFILE]) + +(BITMAP.TO.BITMAPFILE + [LAMBDA (BITMAP IMAGEFILE REGION) (* ; "Edited 20-Dec-2025 23:29 by rmk") + (* ; "Edited 19-Dec-2025 17:51 by rmk") + (CL:WHEN (WINDOWP BITMAP) + (SETQ BITMAP (COPY.WINDOW.TO.BITMAP BITMAP))) + (CL:UNLESS IMAGEFILE + (SETQ IMAGEFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT))) + (RESETLST + (LET ((STREAM (GETSTREAM IMAGEFILE 'OUTPUT T)) + (*READTABLE* (FIND-READTABLE "INTERLISP")) + SUBBITMAP) + (CL:UNLESS STREAM + [RESETSAVE (SETQ STREAM (OPENSTREAM [PACKFILENAME 'BODY IMAGEFILE 'EXTENSION + (CAR (EXTENSIONS.FOR.IMAGEFILETYPE + 'BITMAPFILE] + 'OUTPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (CL:WHEN REGION + (SETQ SUBBITMAP (BITMAPCREATE (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + (BITSPERPIXEL BITMAP))) + (BITBLT BITMAP (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + SUBBITMAP 0 0 (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION))) + (PRINT 'BITMAP STREAM) + (\PRINTBINARYBITMAP (OR SUBBITMAP BITMAP) + STREAM) + (CLOSEF? STREAM)))]) + +(BITMAPFILE.TO.BITMAP + [LAMBDA (FILE) (* ; "Edited 19-Dec-2025 11:00 by rmk") + (CL:UNLESS (BITMAPFILEP FILE) + (ERROR FILE "is not a bitmap file")) + (RESETLST + (LET ((STREAM (GETSTREAM FILE 'INPUT T)) + (*READTABLE* (FIND-READTABLE "INTERLISP"))) + (CL:UNLESS STREAM + [RESETSAVE (SETQ STREAM (OPENSTREAM (FULLNAME FILE) + 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (RATOM STREAM) + (READCCODE STREAM) + (\READBINARYBITMAP STREAM)))]) + +(BITMAPFILE.TO.IMAGEFILE + [LAMBDA (BMFILE IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 20-Dec-2025 23:18 by rmk") + (BITMAP.TO.IMAGEFILE (BITMAPFILE.TO.BITMAP BMFILE) + IMAGEFILE IMAGETYPE OPTIONS]) +) +(DEFINEQ + +(BITMAP.TO.IMAGEFILE + [LAMBDA (BITMAP IMAGEFILE IMAGEFILETYPE OPTIONS) (* ; "Edited 23-Dec-2025 15:40 by rmk") + (* ; "Edited 18-Dec-2025 23:32 by rmk") + + (* ;; "Render BITMAP in IMAGEFILE of type IMAGETYPE") + + (DECLARE (SPECVARS T)) + (LET [(SCALEFACTOR (LISTGET OPTIONS 'SCALEFACTOR)) + (REGION (LISTGET OPTIONS 'REGION)) + (ROTATION (LISTGET OPTIONS 'ROTATION)) + (TITLE (LISTGET OPTIONS 'TITLE] + (DECLARE (SPECVARS . T)) + (CL:UNLESS SCALEFACTOR + [LET [(FN (IMAGEFILEPROP IMAGEFILETYPE 'BITMAPSCALE] + (SETQ SCALEFACTOR (if (NOT FN) + then 1 + elseif REGION + then (APPLY* FN (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + IMAGEFILETYPE) + else (APPLY* FN (fetch (BITMAP BITMAPWIDTH) of BITMAP) + (fetch (BITMAP BITMAPHEIGHT) of BITMAP) + IMAGEFILETYPE]) + (CL:WHEN (LISTP SCALEFACTOR) + (SETQ ROTATION (CDR SCALEFACTOR)) + (SETQ SCALEFACTOR (CAR SCALEFACTOR))) + (EVAL (IMAGEFILEPROP IMAGEFILETYPE 'BITMAPFILE]) + +(WINDOW.TO.IMAGEFILE + [LAMBDA (WINDOW IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 24-Dec-2025 07:57 by rmk") + (* ; "Edited 19-Dec-2025 18:20 by rmk") + (* ; "Edited 3-Nov-2025 16:10 by rmk") + (* ; "Edited 29-Sep-2025 23:54 by rmk") + (* ; "Edited 19-Sep-2025 17:09 by rmk") + (* ; "Edited 26-Nov-96 15:59 by rmk:") + (* ; "Edited 13-Nov-87 14:16 by Snow") + + (* ;; "Either run window's HARDCOPYFN or produce a bitmap file. The HARDCOPYFN can be a list of the form (fn heading) where heading=TITLE means use the window's title, otherwise using the non-nil heading.") + + (* ;; "If there is a hardcopy") + + (* ;; + "The information put in IMAGEFILE comes from WINDOW via the HARDCOPYFN, or the bitmap if no fn. ") + + (* ;; "Value is the completed IMAGEFILE.") + + (* ;; "Note: if the window has an IMAGETYPE property (e.g. TEDIT), then conversion to IMAGETYPE is handled by the appropriate entry on PRINTFILETYPES.") + + (CL:WHEN IMAGEFILE + (CL:WHEN (AND (LISTP IMAGEFILE) + (NULL IMAGETYPE)) + (SETQ IMAGETYPE (CDR IMAGEFILE)) + (SETQ IMAGEFILE (CAR IMAGEFILE))) + (LET ((HARDCOPYFN (WINDOWPROP WINDOW 'HARDCOPYFN)) + HEADING) + (if (NULL HARDCOPYFN) + then (* ; "knows how to default") + (CL:WHEN (EQ 'TITLE (LISTGET OPTIONS 'HEADING)) + [SETQ OPTIONS `(HEADING ,(WINDOWPROP WINDOW 'TITLE) + ,@OPTIONS]) + (CONVERT.TO.IMAGEFILE (COPY.WINDOW.TO.BITMAP WINDOW) + IMAGEFILE IMAGETYPE OPTIONS) + else (CL:WHEN (AND (LISTP HARDCOPYFN) + (FNTYP (CAR HARDCOPYFN))) + (SETQ HEADING (CADR HARDCOPYFN)) + (CL:WHEN (EQ HEADING 'TITLE) + (SETQ HEADING (WINDOWPROP WINDOW 'TITLE))) + (SETQ HARDCOPYFN (CAR HARDCOPYFN))) + (CL:WHEN HEADING + [SETQ OPTIONS `(HEADING ,HEADING ,@OPTIONS]) + (CL:WITH-OPEN-STREAM (IMAGESTREAM (OPENIMAGESTREAM IMAGEFILE IMAGETYPE OPTIONS)) + (APPLY* HARDCOPYFN WINDOW IMAGESTREAM IMAGETYPE OPTIONS)) + IMAGEFILE)))]) + +(SCREENREGION.TO.IMAGEFILE + [LAMBDA (REGION IMAGEFILE IMAGETYPE OPTIONS) (* ; "Edited 23-Dec-2025 20:13 by rmk") + (* ; "Edited 19-Dec-2025 15:24 by rmk") + (CL:UNLESS REGION + (PROMPTPRINT "Select a region") + (SETQ REGION (GETREGION)) + (CLRPROMPT)) + (LET [(BITMAP (BITMAPCREATE (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + (BITSPERPIXEL (SCREENBITMAP] + (BITBLT (SCREENBITMAP) + (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + BITMAP 0 0 (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION)) + (CONVERT.TO.IMAGEFILE BITMAP IMAGEFILE IMAGETYPE OPTIONS]) + +(COPY.WINDOW.TO.BITMAP + [LAMBDA (WINDOW) (* ; "Edited 26-Aug-87 14:09 by Snow") + +(* ;;; "copies contents of window (including title and border) into a bitmap") + + (COND + ((OPENWP WINDOW) + (PROG (REGION SCREEN LEFT BOTTOM WIDTH HEIGHT BITMAP) + (SETQ REGION (WINDOWPROP WINDOW 'REGION)) + (SETQ SCREEN (WINDOWPROP WINDOW 'SCREEN)) + (SETQ LEFT (fetch (REGION LEFT) of REGION)) + (SETQ BOTTOM (fetch (REGION BOTTOM) of REGION)) + (SETQ WIDTH (fetch (REGION WIDTH) of REGION)) + (SETQ HEIGHT (fetch (REGION HEIGHT) of REGION)) + (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL WINDOW))) + (.WHILE.TOP.DS. WINDOW (BITBLT (SCREENBITMAP SCREEN) + LEFT BOTTOM BITMAP 0 0 WIDTH HEIGHT)) + (RETURN BITMAP))) + (T (BITMAPCOPY (WINDOWPROP WINDOW 'IMAGECOVERED]) +) + +(RPAQ? PRINTFILETYPES NIL) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS PRINTFILETYPES) +) +(DEFINEQ + +(DEFAULT.IMAGETYPE.CONVERSIONS + [LAMBDA (CONVERSIONS) (* ; "Edited 24-Dec-2025 22:42 by rmk") + (CL:UNLESS (EQ 0 (IMOD (LENGTH CONVERSIONS) + 2)) + (ERROR "CONVERSIONS is not a property list")) + (PUTMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION (CONS (APPEND (CAR (GETMULTI PRINTFILETYPES + 'DEFAULT + 'CONVERSION)) + CONVERSIONS]) +) + +(DEFAULT.IMAGETYPE.CONVERSIONS '(BITMAP BITMAP.TO.IMAGEFILE WINDOW WINDOW.TO.IMAGEFILE SCREENREGION + SCREENREGION.TO.IMAGEFILE BITMAPFILE BITMAPFILE.TO.IMAGEFILE)) + +(ADDTOVAR PRINTFILETYPES (BITMAP (TEST BITMAPP)) + (WINDOW (TEST WINDOWP)) + (SCREENREGION (TEST REGIONP)) + (BITMAPFILE (TEST BITMAPFILEP) + (EXTENSION (BM BITMAP)) + (CONVERSION (BITMAP BITMAP.TO.BITMAPFILE)))) + + + +(* ; "Until HTML streams") + + +(ADDTOVAR PRINTFILETYPES ) +(DEFINEQ + +(HTMLFILEP + [LAMBDA (X) (* ; "Edited 28-Dec-2025 17:53 by rmk") + (MEMB (FILENAMEFIELD X 'EXTENSION) + (EXTENSIONS.FOR.IMAGEFILETYPE 'HTML]) ) (RPAQ? IMAGESTREAMTYPES NIL) @@ -1576,27 +1841,31 @@ (ADDTOVAR LAMA IMAGESTREAMP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3486 5127 (OPENIMAGESTREAM 3496 . 5125)) (5128 8304 (IMAGESTREAMP 5138 . 5970) ( -IMAGESTREAMTYPE 5972 . 6185) (IMAGESTREAMTYPEP 6187 . 6822) (IMAGEFILETYPE 6824 . 7935) (IMAGEFILEPROP - 7937 . 8302)) (8305 9310 (EXTENSIONS.FOR.IMAGEFILETYPE 8315 . 8671) (IMAGEFILETYPE.FROM.EXTENSION -8673 . 9308)) (9311 12063 (CONVERT.TO.IMAGEFILE 9321 . 12061)) (12064 12951 (IMAGETYPE.BITMAPSCALE -12074 . 12449) (IMAGETYPE.BITMAPFILE 12451 . 12949)) (12986 15101 (\GOOD.DASHLST 12996 . 15099)) ( -15102 17399 (DRAWDASHEDLINE 15112 . 17397)) (17400 24740 (DSPBACKCOLOR 17410 . 17782) (DSPBOTTOMMARGIN - 17784 . 18169) (DSPCOLOR 18171 . 18535) (DSPCLIPPINGREGION 18537 . 19242) (DSPRESET 19244 . 19524) ( -DSPFONT 19526 . 19890) (DSPLEFTMARGIN 19892 . 20273) (DSPLINEFEED 20275 . 20575) (DSPOPERATION 20577 - . 20954) (DSPRIGHTMARGIN 20956 . 21339) (DSPTOPMARGIN 21341 . 21720) (DSPSCALE 21722 . 22089) ( -DSPSPACEFACTOR 22091 . 22484) (DSPXPOSITION 22486 . 22791) (DSPYPOSITION 22793 . 23098) (DSPROTATE -23100 . 23395) (DSPPUSHSTATE 23397 . 23643) (DSPPOPSTATE 23645 . 23888) (DSPDEFAULTSTATE 23890 . 24142 -) (DSPSCALE2 24144 . 24435) (DSPTRANSLATE 24437 . 24738)) (24741 33542 (DSPNEWPAGE 24751 . 25443) ( -DRAWBETWEEN 25445 . 26147) (DRAWCIRCLE 26149 . 26645) (DRAWARC 26647 . 27164) (DRAWCURVE 27166 . 27843 -) (DRAWELLIPSE 27845 . 28631) (DRAWLINE 28633 . 29023) (DRAWPOLYGON 29025 . 29480) (DRAWPOINT 29482 . -29901) (FILLPOLYGON 29903 . 30469) (DRAWTO 30471 . 30889) (FILLCIRCLE 30891 . 31114) (MOVETO 31116 . -31480) (RELDRAWTO 31482 . 32399) (BITMAPIMAGESIZE 32401 . 32572) (SCALEDBITBLT 32574 . 33540)) (33543 -40582 (\DRAWPOINT.GENERIC 33553 . 33900) (\DRAWPOLYGON.GENERIC 33902 . 36210) (\DRAWCIRCLE.GENERIC -36212 . 37870) (\DRAWELLIPSE.GENERIC 37872 . 40580)) (40583 45527 (\IMAGEIOINIT 40593 . 43873) ( -\NOIMAGE.DSPFONT 43875 . 45361) (\UNIMPIMAGEOP 45363 . 45525)) (45650 48774 (INSURE.BRUSH 45660 . -47034) (BRUSHP 47036 . 47826) (\POSSIBLECOLOR 47828 . 48379) (NEGSHADE 48381 . 48772)) (49330 50014 ( -DASHINGP 49340 . 49670) (INSURE.DASHING 49672 . 50012)) (60752 81298 (\DisplayEventFn 60762 . 61272) ( -\DISPLAYINIT 61274 . 66857) (\4DISPLAYINIT 66859 . 71560) (\8DISPLAYINIT 71562 . 76265) ( -\24DISPLAYINIT 76267 . 81039) (\DISPLAYSTREAMTYPEBPP 81041 . 81296))))) + (FILEMAP (NIL (4358 5999 (OPENIMAGESTREAM 4368 . 5997)) (6000 9946 (IMAGESTREAMP 6010 . 6842) ( +IMAGESTREAMTYPE 6844 . 7057) (IMAGESTREAMTYPEP 7059 . 7694) (IMAGEFILEPROP 7696 . 8234) ( +IMAGESOURCEFILEP 8236 . 8513) (IMAGESOURCETYPE 8515 . 9944)) (9947 10952 (EXTENSIONS.FOR.IMAGEFILETYPE + 9957 . 10313) (IMAGEFILETYPE.FROM.EXTENSION 10315 . 10950)) (10953 15448 (CONVERT.TO.IMAGEFILE 10963 + . 15446)) (15449 19540 (BITMAPFILEP 15459 . 16960) (BITMAP.TO.BITMAPFILE 16962 . 18639) ( +BITMAPFILE.TO.BITMAP 18641 . 19295) (BITMAPFILE.TO.IMAGEFILE 19297 . 19538)) (19541 25866 ( +BITMAP.TO.IMAGEFILE 19551 . 21108) (WINDOW.TO.IMAGEFILE 21110 . 23939) (SCREENREGION.TO.IMAGEFILE +23941 . 24845) (COPY.WINDOW.TO.BITMAP 24847 . 25864)) (25965 26602 (DEFAULT.IMAGETYPE.CONVERSIONS +25975 . 26600)) (27225 27451 (HTMLFILEP 27235 . 27449)) (27486 29601 (\GOOD.DASHLST 27496 . 29599)) ( +29602 31899 (DRAWDASHEDLINE 29612 . 31897)) (31900 39240 (DSPBACKCOLOR 31910 . 32282) (DSPBOTTOMMARGIN + 32284 . 32669) (DSPCOLOR 32671 . 33035) (DSPCLIPPINGREGION 33037 . 33742) (DSPRESET 33744 . 34024) ( +DSPFONT 34026 . 34390) (DSPLEFTMARGIN 34392 . 34773) (DSPLINEFEED 34775 . 35075) (DSPOPERATION 35077 + . 35454) (DSPRIGHTMARGIN 35456 . 35839) (DSPTOPMARGIN 35841 . 36220) (DSPSCALE 36222 . 36589) ( +DSPSPACEFACTOR 36591 . 36984) (DSPXPOSITION 36986 . 37291) (DSPYPOSITION 37293 . 37598) (DSPROTATE +37600 . 37895) (DSPPUSHSTATE 37897 . 38143) (DSPPOPSTATE 38145 . 38388) (DSPDEFAULTSTATE 38390 . 38642 +) (DSPSCALE2 38644 . 38935) (DSPTRANSLATE 38937 . 39238)) (39241 48042 (DSPNEWPAGE 39251 . 39943) ( +DRAWBETWEEN 39945 . 40647) (DRAWCIRCLE 40649 . 41145) (DRAWARC 41147 . 41664) (DRAWCURVE 41666 . 42343 +) (DRAWELLIPSE 42345 . 43131) (DRAWLINE 43133 . 43523) (DRAWPOLYGON 43525 . 43980) (DRAWPOINT 43982 . +44401) (FILLPOLYGON 44403 . 44969) (DRAWTO 44971 . 45389) (FILLCIRCLE 45391 . 45614) (MOVETO 45616 . +45980) (RELDRAWTO 45982 . 46899) (BITMAPIMAGESIZE 46901 . 47072) (SCALEDBITBLT 47074 . 48040)) (48043 +55082 (\DRAWPOINT.GENERIC 48053 . 48400) (\DRAWPOLYGON.GENERIC 48402 . 50710) (\DRAWCIRCLE.GENERIC +50712 . 52370) (\DRAWELLIPSE.GENERIC 52372 . 55080)) (55083 60027 (\IMAGEIOINIT 55093 . 58373) ( +\NOIMAGE.DSPFONT 58375 . 59861) (\UNIMPIMAGEOP 59863 . 60025)) (60150 63274 (INSURE.BRUSH 60160 . +61534) (BRUSHP 61536 . 62326) (\POSSIBLECOLOR 62328 . 62879) (NEGSHADE 62881 . 63272)) (63830 64514 ( +DASHINGP 63840 . 64170) (INSURE.DASHING 64172 . 64512)) (75252 95798 (\DisplayEventFn 75262 . 75772) ( +\DISPLAYINIT 75774 . 81357) (\4DISPLAYINIT 81359 . 86060) (\8DISPLAYINIT 86062 . 90765) ( +\24DISPLAYINIT 90767 . 95539) (\DISPLAYSTREAMTYPEBPP 95541 . 95796))))) STOP diff --git a/sources/IMAGEIO.LCOM b/sources/IMAGEIO.LCOM index 47406c297be65248a02f8725b3ca453540526535..43363c36184c941f911dfc6408c7ca73f70240bb 100644 GIT binary patch delta 8552 zcmbVRU2GfImFAF&Y%`85IXwLpPB?nC#berw;l-#PaV zXGqa$HiA8zxp(f*Ip;gyIrq$OznT2aACmvI{wsv+pUlNsNqyMj3@#D7NYSJKgQLMOK z>x$Fqc}sPS$M9k#L$0zy|ME0EnJ?_mC9h0n+-}DeEA?_Z>x!JXVmAAqKk|{_pR`0G zX|7&R;BPKDm((&^!X7+rzDf<(>B6nEo2k9i-gUU8`L;AXK3u+^*C1 zX`lX8*YZT6AnI1b>@|I8WVAEzgpnWimPR{0%(j?zTIQPNb$Z>J#iC0Y9LNysSrmzR zY(`t%+?zW_+Zvo$-OR5(8XR5y1wCSyW#ReQ*P4r2v8HSKcH2DFvc?y|p8G4u8n-q? zL*#{Td48jf+k)_%m6dkWv-}sApuL`jHBTi|$;8fTCaHB_^G?ic&)+=CiknTeon|_# zm&HoE(`}i}35!^vF-rYEr_c5)>DruH%oVzDNOgjw-01&4U2cE%ND|VqXnUttc@b9s z;D}uCI!T#%E@`I*bK57i!6Wr*R%Gc48v~bP%Gz$mMCom44><>9vx=2s=EzsTY;IM=iiY2b?3v3*CT? z&Dv$^Z<{Sk=(-{Le>!qDr~n@dX{EwAN=31Fs0n~*0E}$4kzQUK5Ha$qnL%mfDnl&l zWn&zS{qG-7_pmU@W_3NM(}pmWA?4|X;z(EC5S^ay_JDC?S-jEi)SYgv)3yEsm@f%n z9}@E%xm^E$kDtpLC0#6te?c4)yLWMCK%j-%D|gQCiko-u{QK7ZT{P+yy{|v@+^MSL zw@jDCVE3ep(O*601QWPTB$FYxv8~zqY-!NkGy?>QU4RImv{vNdfZ)3EL#t;$Aue?;PX_@VwyVL+%V_ZX!H0i)0eD&F4pU*?0WFL!)--)+V}S_fyi! z4}SvJDni|tAy*ZNtBz15MU)9U8rT?~i-g75u$rK^D9-6QLtNvOqw2KH?p39n3V8%5 zP$0f>>^jYXNgy7K#I9mLlR6h5qEQ@*7NiD;r78jl6;u)b2w9i3;{wF00eK1Icp8hnvzM;SLM%* z#DTg03|l?|1u~@fa$xXg>9ETpa)vHTUKnt&9F` z@)T#{&I~{)n*m9&Kp*-w$xlX%W_+KH{Q*4L2&0{ftF+HRg**6b8<~LCW%V9%*Q90- zWMu2IXGKP!faW1pIFKF~zrp~^&^8gyh=af{sI6A()U802KrozJ0Ms#s=gUzj`@22@ z50J4b7KGjd^fAl_hx3%k6dxS)xk%M~ z;{wVKkw=<7#Vd+-ih4NE)yyX96EzoAb)jTn?@wA-aAGUd<864)6 z7InC1s6(JZsSwl_DUjJKqQcNFsHhwd9-rCM;dpW$o>L@>ND!77WXx=Y#$m%yoG@_) z#L*3=4-H7kh;4T3#Lta(04tqNOeZw=#jbyQs&`_BHMtFjLQ*F|s2pdAu)~sYVZ)IA z-@vw6LUjnGJ@PKF(o7pwTvfp8ilE1;YLYQ^2da`K=!(9;V)^e$O117Gl+(Oa|nhS7>HY z9_^jtU+KW_W^42FH>OpUV(8APy#-ri-R^zZPHI=>NRHR=gLkt(1D>6?xYdypU?}To zCzDKZJCEkeC4Rol-DD?|423#Fs7K@|`jGGRVoBj;ghv$Lfh#Xk9Et0Y&QI5zw%6-g zQZ=H2qhA}K66J#E|LxeR00*hb0ltJJZ)7Mk{X>;37*|IzL|PiBWc_g)H2B0H+LKQE zlDb}kOkpbmp=^XGVH?f~k>MFi9#T}RExmI@4`I{_&lvr0rQA5_}&U{5qstSsiF1LeQ zo6VLwd39#LA<@R;Iy1jcv}e^`rx!HdXZh%_DU z#EJ^q3OhQ$bj|Ph9e2I%aizQNxpjO3z$uP12d0b21gKcIsQ^9p)-aMP$ijoMKm=LT zNk)hxAe@f0&>;;>wa(>l5YRQNb#WA8RPe-Bziqo-10BaXvM17Zd?SF1P`hJW&GOLoyH`$VNgUsgkJm1crPT)`5 zU}nF%X(xlZ!Abk)&i4G}woA(1BV4Qu?{6jgY}W=FYG&5p&X zAi5CKl^CYZ_wL`lhq~-%#qFI3yPz7|ud1(lk&-u{+B2l2STtr;unX|X02%=Gx2#r` zgr`#X3s4B{nDVTKV>Rp826jOo4S}a&Az=SYGbe68PsyOlCSu>#WN73DlDq$-&wZ@_ z($Ta1KY#8>Fh<<`HEvO48_1NU`*4n_?xSp-v&>itFY1X63!}l|Nrye0!cGdFA}!f& zQox%?QEvx~biOX7TilVEnO*{PaMek1J$BOf)D;P2@(c*hml_k2ZU zU+kf}EwYM$l%9q{v+`tO5=@jmF1m_?lk^Z7NQ{|+El$fU;!k8vDp?*@2*z_gM&(E& zt44G43{tfhMEVnAp?7C@=e7jkgWdaEue| zzx>8uj|3Aemj3_gTJC$2swZlC1Z5(Kt6+4FNFR>{_#!;htk?Yxureo7+T OJXV_h))&5T{Qm%N1+^~# delta 1552 zcma)6&u<$=6y9CC39M4vX-g;y4X<0#*b+AT!|SzI0=%);@ig}Cvb#>xo?22vLP8RS z2%%J!|AZ0^GzboGLIMe?s+B{V{2FK>RZwYuKF z1O1P;wm*E;2GVur-S|e}mgY#@b%LnjbliVgTLg`(8yLCO>vUi=e5q7Y;LhzGjET=$ zC!msdHC-vldG>uHbe-63GOrV-L*(k--AiM71**D5J<*K*KdJ)QLFg_LzZVso7#|cE z#Za+z%hpu|g_x2i&Nq48Xx zY~Z>SgI0wgBp#2?93u2B$fP@klJn@H9~{x3!4j>G%`Ci@76j=QgEy(AFvau=W>hEQ z4>uS7{AMBb#kGZ(A2>w9>~bujKLn3-HX)b6F-eh!kL8IZ|RR`uS_{yhJ&llqYIp3hyT-J=AxXqp(u0o zM#erf*8F@WN59X!^alUrh;6NAf*Xc@2wDvl#!B{_u8TC4q2YTC2N|oF(CGM)+j0VAz8k_x9Dh4cg0OH_hN4FadJz*6Balr2bZP)`F(%WHBD%p)u6 zqM?uN`C->#?WICQY}@NZZv1vJpx>RJuryU?C>Px@BEAQxx!;R}UJRBAcRjyJ!iFEZ z_n=|`YL8Humub= za*7<7Fh>T*L+G$rpB+z}Hx7nC1!5AjVFf0He(c07V*+Ie-T7o|03T;9rxBy*40kf* zaErZuH2Ls!-0$b!#L6E}DvRUh1;pTD=`1pBPKV7