From 53d6387e93e03fcce409c60275d4e179db2f779f Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 2 Feb 2026 11:56:50 -0800 Subject: [PATCH] Update to new imagefile architetecture (#2467) * Update HPGL to new imagefile architetecture * {LPT} improvements, TEXT imagetype centralized in HARDCOPY * \EXTERNALFORMAT respects explicit fields in create stream expressions, doesn't override non-NIL fields --- lispusers/HPGL | 275 +++++++++++++++++------------------- lispusers/HPGL.LCOM | Bin 34978 -> 34242 bytes sources/EXTERNALFORMAT | 52 ++++--- sources/EXTERNALFORMAT.LCOM | Bin 11028 -> 11068 bytes sources/HARDCOPY | 187 +++++++++++++----------- sources/HARDCOPY.LCOM | Bin 42799 -> 43300 bytes sources/IMAGEIO | 203 +++++++++++++------------- sources/IMAGEIO.LCOM | Bin 44853 -> 44769 bytes 8 files changed, 368 insertions(+), 349 deletions(-) diff --git a/lispusers/HPGL b/lispusers/HPGL index c384b476..d7179619 100644 --- a/lispusers/HPGL +++ b/lispusers/HPGL @@ -1,20 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Jul-88 17:47:02" |{MCS:MCS:STANFORD}HPGL.;24| 45342 - changes to%: (FNS \DRAWLINE.HPGL \FONT.HPGL \INIT.HPGL HARDCOPYW.HPGL) +(FILECREATED "29-Jan-2026 21:10:52" {WMEDLEY}HPGL.;9 43562 - previous date%: "20-Jul-88 17:34:42" |{MCS:MCS:STANFORD}HPGL.;23|) + :EDIT-BY rmk + :CHANGES-TO (FNS OPENHPGLSTREAM) + + :PREVIOUS-DATE "29-Jan-2026 11:02:32" {WMEDLEY}HPGL.;7) -(* " -Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserved. -") (PRETTYCOMPRINT HPGLCOMS) -(RPAQQ HPGLCOMS +(RPAQQ HPGLCOMS ((* * User Functions) - (FNS MAKEHPGL OPENHPGLSTREAM HARDCOPYW.HPGL) + (FNS OPENHPGLSTREAM HARDCOPYW.HPGL) (* * ImageOp Functions) (FNS \BITBLT.HPGL \BLTSHADE.HPGL \CLOSEFN.HPGL \COLOR.HPGL \DRAWARC.HPGL \DRAWCIRCLE.HPGL \DRAWCURVE.HPGL \DRAWLINE.HPGL \DRAWPOLYGON.HPGL \FILLCIRCLE.HPGL \FONT.HPGL @@ -36,20 +35,11 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES UTILISOPRS) (ALISTS (PRINTOUTMACROS !, !; !!;)) (RECORDS PLOTTERDATA)) + (ALISTS (PRINTFILETYPES HPGL)) [ADDVARS (PRINTERTYPES ((PLOTTER HPGL) (CANPRINT (HPGL)) (STATUS TRUE) - (BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE)) (PROPERTIES NILL))) - [PRINTFILETYPES (HPGL (EXTENSION (HPGL PLOT)) - (CONVERSION (TEXT MAKEHPGL TEDIT - (LAMBDA (FILE PFILE) - (SETQ FILE (OPENTEXTSTREAM FILE)) - (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL - NIL NIL 'HPGL) - (CLOSEF? FILE) - PFILE] (IMAGESTREAMTYPES (HPGL (OPENSTREAM OPENHPGLSTREAM) (FONTCREATE \FONTCREATE.HPGL) (FONTSAVAILABLE \SEARCH.HPGL.FONTS) @@ -64,39 +54,36 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (DEFINEQ -(MAKEHPGL - [LAMBDA (FILE PFILE FONTS HEADING TABS) (* cdl "12-Jun-85 11:22") - (TEXTTOIMAGEFILE FILE PFILE 'HPGL FONTS HEADING TABS]) - (OPENHPGLSTREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 8-Sep-87 08:50 by cdl") + [LAMBDA (FILE OPTIONS) (* ; "Edited 29-Jan-2026 21:10 by rmk") + (* ; "Edited 28-Jan-2026 01:00 by rmk") + (* ; "Edited 8-Sep-87 08:50 by cdl") (* DECLARATIONS%: (RECORD PAIR - (KEY VALUE))) + (KEY VALUE))) (LET (HPGLSTREAM POSITION (STREAM (OPENSTREAM FILE 'OUTPUT)) (SCALE (create POSITION XCOORD _ SCREENWIDTH YCOORD _ SCREENHEIGHT))) (if (AND (SETQ POSITION (LISTGET OPTIONS 'SCALE)) - (POSITIONP POSITION)) + (POSITIONP POSITION)) then (SETQ SCALE POSITION)) (SETQ HPGLSTREAM (create STREAM IMAGEOPS _ \HPGLIMAGEOPS IMAGEDATA _ (create PLOTTERDATA PD.STREAM _ STREAM PD.SCALE _ SCALE - PD.RIGHTMARGIN _ (with POSITION SCALE XCOORD) - ) + PD.RIGHTMARGIN _ (with POSITION SCALE XCOORD)) OUTCHARFN _ (FUNCTION \OUTCHAR.HPGL) CBUFPTR _ NIL CBUFSIZE _ 0 DEVICE _ \NULLFDEV using STREAM)) (with STREAM STREAM (SETQ LINELENGTH MAX.SMALLP)) (with POSITION SCALE - (printout STREAM "DF" !; "SC" "0" !, XCOORD !, "0" !, YCOORD !; "DT" !!; !;)) + (printout STREAM "DF" !; "SC" "0" !, XCOORD !, "0" !, YCOORD !; "DT" !!; !;)) [bind ENTRY for PAIR on OPTIONS by (CDDR PAIR) do (with PAIR PAIR (if (SETQ ENTRY (ASSOC KEY HPGL.OPTIONS)) - then (printout STREAM (CDR ENTRY) - VALUE !;] + then (printout STREAM (CDR ENTRY) + VALUE !;] (DSPFONT DEFAULTFONT HPGLSTREAM) (DSPRESET HPGLSTREAM) HPGLSTREAM]) @@ -513,37 +500,38 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve T]) (\FONTCREATE.HPGL - [LAMBDA (FAMILY SIZE FACE ROTATION) (* ; "Edited 4-Sep-87 15:13 by cdl") - (if (ASSOC FAMILY HPGL.FONTS) - then (LET ((WIDTHSBLOCK (\CREATECSINFOELEMENT)) - (FONTDESCRIPTOR (create FONTDESCRIPTOR - FONTDEVICE _ 'HPGL - FONTFAMILY _ FAMILY - FONTSIZE _ SIZE - FONTFACE _ FACE - ROTATION _ ROTATION - \SFHeight _ SIZE - \SFAscent _ SIZE - \SFDescent _ 0))) - (bind (WIDTH _ (FIX (QUOTIENT (TIMES 3 SIZE) - 4))) for N from 0 to 254 - do (\FSETWIDTH WIDTHSBLOCK N WIDTH)) - (with FONTDESCRIPTOR FONTDESCRIPTOR - (\SETCHARSETINFO FONTCHARSETVECTOR 0 - (create CHARSETINFO - WIDTHS _ WIDTHSBLOCK - IMAGEWIDTHS _ WIDTHSBLOCK - CHARSETASCENT _ SIZE - CHARSETDESCENT _ 0))) - FONTDESCRIPTOR) - else (FONTCREATE (CAAR HPGL.FONTS) - SIZE FACE ROTATION 'HPGL]) + [LAMBDA (FONTSPEC) (* ; "Edited 28-Jan-2026 00:58 by rmk") + (* ; "Edited 4-Sep-87 15:13 by cdl") + (if (ASSOC (fetch (FONTSPEC FSFAMILY) of FONTSPEC) + HPGL.FONTS) + then (LET* ((SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC)) + (WIDTHSBLOCK (\CREATECSINFOELEMENT)) + (FONTDESCRIPTOR (create FONTDESCRIPTOR + FONTDEVICE _ 'HPGL + FONTFAMILY _ (fetch (FONTSPEC FSFAMILY) of FONTSPEC) + FONTSIZE _ SIZE + FONTFACE _ (fetch (FONTSPEC FSFACE) of FONTSPEC) + ROTATION _ (fetch (FONTSPEC FSROTATION) of FONTSPEC) + \SFHeight _ SIZE + \SFAscent _ SIZE + \SFDescent _ 0))) + (for N (WIDTH _ (FIX (QUOTIENT (TIMES 3 SIZE) + 4))) from 0 to \MAXTHINCHAR + do (\FSETWIDTH WIDTHSBLOCK N WIDTH)) + (\SETCHARSETINFO FONTDESCRIPTOR 0 + (create CHARSETINFO + WIDTHS _ WIDTHSBLOCK + IMAGEWIDTHS _ WIDTHSBLOCK + CHARSETASCENT _ SIZE + CHARSETDESCENT _ 0)) + FONTDESCRIPTOR) + else (FONTCREATE (create FONTSPEC using FONTSPEC FSFAMILY _ (CAAR HPGL.FONTS]) (\INIT.HPGL - [LAMBDA NIL (* ; "Edited 20-Jul-88 17:04 by cdl") + [LAMBDA NIL (* ; "Edited 20-Jul-88 17:04 by cdl") (* DECLARATIONS%: (RECORD CLASS - (FONTCLASSNAME PRETTYFONT# DISPLAYFD - PRESSFD INTERPRESSFD . OTHERFDS))) + (FONTCLASSNAME PRETTYFONT# DISPLAYFD + PRESSFD INTERPRESSFD . OTHERFDS))) (DECLARE (GLOBALVARS FONTDEFS FONTNAME)) (SETQ \NULLFDEV (create FDEV CLOSEFILE _ (FUNCTION NILL))) @@ -579,16 +567,14 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve IMROTATE _ (FUNCTION \ROTATE.HPGL))) (for FONTSET in FONTDEFS do [for CLASS in (CDR (ASSOC 'FONTPROFILE (CDR FONTSET))) - unless (with CLASS CLASS (OR (NULL DISPLAYFD) - (NULL INTERPRESSFD) - (ASSOC 'HPGL OTHERFDS))) - do (with CLASS CLASS (push - OTHERFDS - (LIST 'HPGL (CONS 'STANDARD - (CDR (if (LISTP DISPLAYFD) - then DISPLAYFD - else (FONTUNPARSE - DISPLAYFD] + unless (with CLASS CLASS (OR (NULL DISPLAYFD) + (NULL INTERPRESSFD) + (ASSOC 'HPGL OTHERFDS))) + do (with CLASS CLASS (push OTHERFDS (LIST 'HPGL (CONS 'STANDARD + (CDR (if (LISTP DISPLAYFD) + then DISPLAYFD + else (FONTUNPARSE DISPLAYFD + ] finally (FONTSET FONTNAME]) (\OUTCHAR.HPGL @@ -603,10 +589,13 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (push PD.TEXT CHARCODE]) (\SEARCH.HPGL.FONTS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* cdl " 1-May-85 09:34") - (if (EQ DEVICE 'HPGL) - then (if (FASSOC FAMILY HPGL.FONTS) - then (LIST (LIST FAMILY SIZE FACE ROTATION DEVICE]) + [LAMBDA (FONTSPEC) (* ; "Edited 28-Jan-2026 00:53 by rmk") + (* cdl " 1-May-85 09:34") + (CL:WHEN (AND (EQ (fetch (FONTSPEC FSDEVICE) of FONTSPEC) + 'HPGL) + (FASSOC (fetch (FONTSPEC FSFAMILY) of FONTSPEC) + HPGL.FONTS)) (* ; "Make a copy?") + (create FONTSPEC using FONTSPEC))]) (\FILL.HPGL [LAMBDA (STREAM TEXTURE) (* ; "Edited 8-Dec-87 16:56 by cdl") @@ -679,41 +668,43 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (* * etc.) -(RPAQQ HPGL.FONTS ((STANDARD . 0) - (9825 . 1) - (FRENCH . 2) - (SCANDINAVIAN . 3) - (SPANISH . 4) - (JISASCII . 6) - (ROMAN . 7) - (KATAKANA . 8) - (IRV . 9) - (SWEDISH . 30) - (SWEDISH2 . 31) - (NORWAY . 32) - (GERMAN . 33) - (FRENCH2 . 34) - (BRITISH . 35) - (ITALIAN . 36) - (SPANISH2 . 37) - (PORTUGUESE . 38) - (NORWAY2 . 39))) +(RPAQQ HPGL.FONTS + ((STANDARD . 0) + (9825 . 1) + (FRENCH . 2) + (SCANDINAVIAN . 3) + (SPANISH . 4) + (JISASCII . 6) + (ROMAN . 7) + (KATAKANA . 8) + (IRV . 9) + (SWEDISH . 30) + (SWEDISH2 . 31) + (NORWAY . 32) + (GERMAN . 33) + (FRENCH2 . 34) + (BRITISH . 35) + (ITALIAN . 36) + (SPANISH2 . 37) + (PORTUGUESE . 38) + (NORWAY2 . 39))) (RPAQQ HPGL.OPTIONS ((ROTATE . "RO") - (VELOCITY . "VS") - (PAPER . "PS") - (TERMINATOR . "DT"))) + (VELOCITY . "VS") + (PAPER . "PS") + (TERMINATOR . "DT"))) (RPAQQ HPGL.FONT.EXPANSIONS ((REGULAR . 200.0) - (COMPRESSED . 100.0) - (EXPANDED . 400.0))) + (COMPRESSED . 100.0) + (EXPANDED . 400.0))) -(RPAQQ HPGL.DASHING ((1 1 49) - (2 25) - (3 35 15) - (4 39 5 1 5) - (5 35 5 5 5) - (6 25 5 5 5 5 5))) +(RPAQQ HPGL.DASHING + ((1 1 49) + (2 25) + (3 35 15) + (4 39 5 1 5) + (5 35 5 5 5) + (6 25 5 5 5 5 5))) (RPAQQ SKETCHINCOLORFLG T) @@ -742,63 +733,55 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (FILESLOAD UTILISOPRS) -(ADDTOVAR PRINTOUTMACROS [!, (LAMBDA (COMS) - (CONS '(PRIN1 HPGL.SEPARATOR NIL) - (CDR COMS] - [!; (LAMBDA (COMS) - (CONS '(PRIN1 HPGL.TERMINATOR NIL) - (CDR COMS] - [!!; (LAMBDA (COMS) - (CONS '(PRIN1 HPGL.TEXT.TERMINATOR NIL) - (CDR COMS]) +(ADDTOVAR PRINTOUTMACROS + [!, (LAMBDA (COMS) + (CONS '(PRIN1 HPGL.SEPARATOR NIL) + (CDR COMS] + [!; (LAMBDA (COMS) + (CONS '(PRIN1 HPGL.TERMINATOR NIL) + (CDR COMS] + [!!; (LAMBDA (COMS) + (CONS '(PRIN1 HPGL.TEXT.TERMINATOR NIL) + (CDR COMS]) (DECLARE%: EVAL@COMPILE (RECORD PLOTTERDATA (PD.STREAM PD.POSITION PD.FONT PD.TEXT PD.COLOR PD.SCALE PD.LEFTMARGIN - PD.RIGHTMARGIN PD.DASHING PD.ROTATION) - PD.POSITION _ (create POSITION) - PD.COLOR _ 0 PD.LEFTMARGIN _ 0 PD.ROTATION _ 0) + PD.RIGHTMARGIN PD.DASHING PD.ROTATION) + PD.POSITION _ (create POSITION) + PD.COLOR _ 0 PD.LEFTMARGIN _ 0 PD.ROTATION _ 0) ) ) +(ADDTOVAR PRINTFILETYPES (HPGL (EXTENSION (HPGL PLOT)) + (BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE)))) + (ADDTOVAR PRINTERTYPES ((PLOTTER HPGL) - (CANPRINT (HPGL)) - (STATUS TRUE) - (BITMAPFILE (HARDCOPYW.HPGL FILE BITMAP SCALEFACTOR REGION ROTATION TITLE - )) - (PROPERTIES NILL))) - -(ADDTOVAR PRINTFILETYPES [HPGL (EXTENSION (HPGL PLOT)) - (CONVERSION (TEXT MAKEHPGL TEDIT - (LAMBDA (FILE PFILE) - (SETQ FILE (OPENTEXTSTREAM FILE)) - (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL - NIL NIL 'HPGL) - (CLOSEF? FILE) - PFILE]) + (CANPRINT (HPGL)) + (STATUS TRUE) + (PROPERTIES NILL))) (ADDTOVAR IMAGESTREAMTYPES (HPGL (OPENSTREAM OPENHPGLSTREAM) - (FONTCREATE \FONTCREATE.HPGL) - (FONTSAVAILABLE \SEARCH.HPGL.FONTS) - (CREATECHARSET NILL))) + (FONTCREATE \FONTCREATE.HPGL) + (FONTSAVAILABLE \SEARCH.HPGL.FONTS) + (CREATECHARSET NILL))) [if (FGETD (FUNCTION SK.DASHING.LABEL)) - then (for ENTRY in HPGL.DASHING do (push SK.DASHING.PATTERNS - (LIST (SK.DASHING.LABEL (CDR ENTRY)) - (CDR ENTRY] + then (for ENTRY in HPGL.DASHING do (push SK.DASHING.PATTERNS (LIST (SK.DASHING.LABEL (CDR ENTRY)) + (CDR ENTRY] (\INIT.HPGL) -(PUTPROPS HPGL COPYRIGHT ("Stanford University" 1985 1986 1987 1988)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3583 6000 (MAKEHPGL 3593 . 3756) (OPENHPGLSTREAM 3758 . 5715) (HARDCOPYW.HPGL 5717 . -5998)) (6031 29802 (\BITBLT.HPGL 6041 . 8018) (\BLTSHADE.HPGL 8020 . 9173) (\CLOSEFN.HPGL 9175 . 9503) - (\COLOR.HPGL 9505 . 11429) (\DRAWARC.HPGL 11431 . 12940) (\DRAWCIRCLE.HPGL 12942 . 14285) ( -\DRAWCURVE.HPGL 14287 . 15076) (\DRAWLINE.HPGL 15078 . 17236) (\DRAWPOLYGON.HPGL 17238 . 18904) ( -\FILLCIRCLE.HPGL 18906 . 19622) (\FONT.HPGL 19624 . 23275) (\LEFTMARGIN.HPGL 23277 . 23578) ( -\LINEFEED.HPGL 23580 . 23823) (\MOVETO.HPGL 23825 . 24303) (\RESET.HPGL 24305 . 24674) ( -\RIGHTMARGIN.HPGL 24676 . 24980) (\ROTATE.HPGL 24982 . 25356) (\SCALEDBITBLT.HPGL 25358 . 27641) ( -\STRINGWIDTH.HPGL 27643 . 27826) (\CLIPPINGREGION.HPGL 27828 . 28133) (\TERPRI.HPGL 28135 . 28492) ( -\XPOSITION.HPGL 28494 . 29156) (\YPOSITION.HPGL 29158 . 29800)) (29834 40881 (\DUMPSTRING.HPGL 29844 - . 30316) (\FONTCREATE.HPGL 30318 . 31926) (\INIT.HPGL 31928 . 35493) (\OUTCHAR.HPGL 35495 . 36108) ( -\SEARCH.HPGL.FONTS 36110 . 36383) (\FILL.HPGL 36385 . 39041) (\DASHING.HPGL 39043 . 40879))))) + (FILEMAP (NIL (2696 5094 (OPENHPGLSTREAM 2706 . 4809) (HARDCOPYW.HPGL 4811 . 5092)) (5125 28896 ( +\BITBLT.HPGL 5135 . 7112) (\BLTSHADE.HPGL 7114 . 8267) (\CLOSEFN.HPGL 8269 . 8597) (\COLOR.HPGL 8599 + . 10523) (\DRAWARC.HPGL 10525 . 12034) (\DRAWCIRCLE.HPGL 12036 . 13379) (\DRAWCURVE.HPGL 13381 . +14170) (\DRAWLINE.HPGL 14172 . 16330) (\DRAWPOLYGON.HPGL 16332 . 17998) (\FILLCIRCLE.HPGL 18000 . +18716) (\FONT.HPGL 18718 . 22369) (\LEFTMARGIN.HPGL 22371 . 22672) (\LINEFEED.HPGL 22674 . 22917) ( +\MOVETO.HPGL 22919 . 23397) (\RESET.HPGL 23399 . 23768) (\RIGHTMARGIN.HPGL 23770 . 24074) ( +\ROTATE.HPGL 24076 . 24450) (\SCALEDBITBLT.HPGL 24452 . 26735) (\STRINGWIDTH.HPGL 26737 . 26920) ( +\CLIPPINGREGION.HPGL 26922 . 27227) (\TERPRI.HPGL 27229 . 27586) (\XPOSITION.HPGL 27588 . 28250) ( +\YPOSITION.HPGL 28252 . 28894)) (28928 40323 (\DUMPSTRING.HPGL 28938 . 29410) (\FONTCREATE.HPGL 29412 + . 31221) (\INIT.HPGL 31223 . 34674) (\OUTCHAR.HPGL 34676 . 35289) (\SEARCH.HPGL.FONTS 35291 . 35825) +(\FILL.HPGL 35827 . 38483) (\DASHING.HPGL 38485 . 40321))))) STOP diff --git a/lispusers/HPGL.LCOM b/lispusers/HPGL.LCOM index 4a18ee4d0c04b1ae68a74af89fa2cd7c06bc8983..057beefeab5c7e96297f7d6b5300adcfa08e3d8d 100644 GIT binary patch delta 4552 zcmai1eQXrR75AR)Gb{o8aoE^EGByG3g70$sbzhM9)^~fp#e2KQ?%Kx90U;bA24lMz zQj*{tCJ;~}^+WRqQlqL$Dzyqx8{k6JeD&HUtr}G{L~0Y7sFf0_e?)1eL{+3jP3yjy z-LriLwfD!|%$qmw{pP(l@4bEQd!AoE?fLFNiDms6RZ~)?BHKzD_3-iFj(rnBKFmiD z&m}l65svjBf6xBOBU5AJ2a0HN0`;KBMsiA8Q$}aDkB?1H9iKjMbo$QWUp5(O#3qlA)H?O^{XI(p1Z+d%$|ZXvc7Z2%?m zrZTJ=Lsl>i=Bu?HF&&=}Zmri<8|?}#ktv76;TTG!V=SHxM#~pGTNsALmHMY)9BlBz z__^2DP~FFGHW(?^&vS@c-&V|=s>`-vfi?2Mt?0mOt^rp}W*SO-6r4EN6uT`m2MGTqp6-_`olm+O9kKWrTA z+Fg8`^%ADHAG+E^x5rkHWhI9KM!%jN4qw<{l53_=WSQn5S7DN$$ge3g(wvFY?R=>lO#4q-~3x{Td4b?->hJHZA^l?9> z%B3U@3V$MsrR}&+e54A2-Go0#ug2dOJH3)?Jn7}?CS2?p(YJuFd?E5l15vZB$5GRV zFZOho8}6B;I;d58@cF*g_^(N?^Qs-sNI-0JY}|>j@AZ~n?>pq!HH!E2Uj=={<$L;@ zu$j74)y_)zNV;`?MSynCugKm?Z?tN8@fKx2OqmimymMxOX<7OD&ehIEqgb~gV+|dyjY$cAZFSM3gyFUM z8DS-QtGEB!TC)(F&j8N93`Yn~-|lG`&+i_G@r&JW!bp&QwdZvgMEUyOrmCeo_Ei=^ z`_WhXsLkoq*n)@mZzh}1hC0g^_Q#nLi5AFwBWl{tLPm@u9mXgkDKM>ADO1fuRwb#@ zVX^u(BQ*%?FueV5C`g3~;kEKg3R30@$ahTA&1KJBu6sY}VOn-Jj?azP-#C2ZuabaJs#%O;trpe%sk9%#ldSUVCNc3hGmuF zp=--4pb92|4D>X3RDCPi>ug+N2tQ)P@4d1o8iqU%bk9%7$Jx@h33|x+Y zr7+3hOg)}1@}qZchSVJqsfC-*|MI7(u5*$ zxHYLvk!W=y2ozD?G)R|;B3zuVbvXx%aMe*63l=;oki%+D9#D+Dg`~KMz{I5mCxFGI zn1sOm8j_&uIuoEe6Dj6SM0mZFM-00YD631oB|&v{xH!R`ghgi}!lmez2(3lQnMGYK zV#L)Vg2xMKQy$41s&0n{6kRdZ6cQzfTWF3)Lj4-`8xloOPAR*LOoq5d6yUCuGFqiT zUs5m)8=6R`wu@kODqW76DVG$67h|PlO-c8wHb{5KLLAy32ZuH~VCXJ2hEE;oXcMCF zsA#w2k|S~a%OgG}f-6VXlq3L_GBm?oa>lS? z8!l5AfB-BjE2rIC@NtOW#bEgu;DJccQmUC^wJKW_@19s!;vs72O~~f_9<*`}amXC5 z@=IVpa%D}`t0WO1lVwIx(heS80MI6RgE`q8P+i0DJiykJOf8WE=q2*>-J=khh0$u; z=+L-0K;N~57K0c_X@;d_T=87YjeIUDkX%!Z=4x(&=qc#%eM9;>#6{fr4;a(EIp?*j=@EQRReL;)RxS1BB_ZC705r1c@osnQ%gWsK6+fEato4OnW z(#~{l>LO&v+G<%Bhbl;`hlim(|7S04t=7($x|9FAyfoJVP$&+L*+Xt^a8^#vCE-R9 zkd_|W>w4$gN-9qt9biZg01a;Wo#}7V?%??I&{EJQI8*CBbgdRDzQw!OtQ;N$f-~lnQ&uLbf@izzV8D zUNLPIm`SwZ-<^ts-jQ>+V>FwE*{kOYP4u%4F0kQz5Pvn>3{>`X5yr{W55oA~>Af&U zp17}x^_zKl=T1B^*p7ep1o_hV^ojd6x>R%vvp8FQ2;Vak0B(FH4C7m8A~62z%z7Bt zp1mVlWva0Q0Slo;^z|)z&5Nj*dEDo9*l_sC7`}dX-Aek5As6Q4Jecjvvm5IJ0qA7U kX4{sS0UX5Q&T|ETfM$t7E}bJ+?Km&Avi^lE?DPZw1#U3MJOBUy delta 5103 zcmb^#ZEO_R@y=fu@Pf}@!RG7vAmNU{ar<#!#$c~+_w2RrcGr7r8;2u&oe4G8L`Ev?!}iBv^VqpC`Owhf*4-mbww ze?+P!zneF2-pst2c{B6&t*0w4U95Pfx5NcfT3St7s%)zY@}tD|?AX-ygoJp$LrQc= zq8|nPhl`I-jTgr9s5l8EXO!%~Y-eG7dg^fT_}Fd&oSYszKE1oo>`jMu@yTnVX1M!?tkl5q9zl>nIM;u2UIG#Ly2<%4N1tBd$LGFBI;9RMbmo$77$U3 zV0mN`&jA!h1PCHegU92k?v@{eA5TwG;c5s_?+Ne`WUG5@+t4y{uS$uzKok*S>%pu+ z&M;M-%(6DbK}HUT!*N8kz%N;`a&yHNub0ESDxZe&-O51geaI7wdQ|MmK zlqz7NI8t@n8bv0GAyd{Y03!HcR}=oYDp?am-ZjfTSgvlZ7pmA{w(PxHId{eLGM=a& zz`w3Wct_vbPG5VizJFEa)y<6u$T|C0&~Z5(>*>#>E4M}l-neqh@*W`Ami_gwhN*G- zFy9+^*jQCjart>qK#0arR_o}n)U0X`=_8u1AR#KCTxK|}Wo;xxV%WQ^F_J)n7(>R8 zZ4Lo497U#))ojhsO~fY>NXeR%1589RA&x>kZa>tBOWpOjVp(%ZjJn&UDAL)b6A&Lp z!~x9s;13}p+^dhsyITc;r>+YbCJ~-Rd_0B}H6;(FZ6-6q-?N_=K}bDQofpE03Bx~K zcIW}(rln!coSCS72ORm5wF~cBJ_(SlJc2jWZLASpU+=<4SG=-FGF}s53yf|vEcn)S z;MuypUatJdx~tWcGKSx2_yiD_8yhMdivKj{04ff);Hj3+9ipkW<@l8cNwW+ulTwejtZ$~cwdFnQyDDMBvj`I^*np?n5Wd#A9DmLKDW&;3UbVUP zj=d{3H{k=FRct@rv)(8-Klty8l^jHROKIoQS}w7f-iW zYOZEh^{s;wMn9>l-~#ya))D;N&R;sL;FRTSonK-qUc_40YW!k%O%=Vr)JlpE_jfe_ zb#V}tXS*gGd*Y2fR~;4`dzRtG2^Zk_`s#X+8#<_e%)k6zEVQ6d?) z+64cS^+VS{w@I37qOM&?jHU5q+s79sNnsoFG=DXD7V_Oq6$^Q}scIqL(^RvNPu^Gw(;F+uP`i+y zxUqbpaO>F3aher<72dwQ*0f=v!Pih#_q*LUM<1#0X;{#L1SWi_R`a!Fbckm|HCUE1)cjPMs?s*|d(+wKPecw<&-C zjz#WW`LiQcBw#?fK2_`Ovmsn);M~O%cEkj_17a&oQVyhUQqY}RfILlJkH_21oD=YQ zJ>7-6LPg)IdJmNzaS4|y!Z->hv=GU(oXtX1@~m%A?I5bGBTk`?a>J>9fyEX6@zK5b zCld`TBnQzXl)d9GdcA%4*@=%zQD)L1-6YmV(HNV9;o)2{Ndj$TU4ae>#lTXumx=KX z5RJ3e#k36CwnU?Gs*)~efKw#uI4hNf36FAQGwoIk6EG6QgQl09CX87vDoO~9kVa7< z;s88cN{R``7!XOs9Uz`?fiPipn-h2}662jkDEgE^BqBNh9ExEec>D|!94Qgrl>*%o zU6K;`Vxi@c1c=C}%1EduZIi%6QXEc1F?)zE`jyVX4bW*dDX_tz}D<{{ML}-oZQJ1WRK}lkms58t z(vl%dCHIA1ARb&oqmJZK27vt;K)Or1ml*r@URj~x$PBJP;f%#0@T&xEh0&D4t_%A0qoR(xmT|J&V$vR%r_oVQeQ!UV->^N0~-WR`k z`r%sl8HwLLy}h1Got!*;V!Svx9i*>ZT=V3xkG*v7xIOssC-r*nuFHad_2fV!cW;g$ zNe1se)9JgLH^NV!(OWrsmzlM5ik$6(yhCUBvokuV*geyNM`lbPN1Q@Dg&y1%41#v} z!?_*!s@9 zw$J;jIoldi@o(q1;?L(dJ%9pGhD_D6H8o2^k7xjm^>^n(rKF(`t5%luYXS0VMy^5O z4XtQ43Z&&sk0OIP$?KcG!9jZtLUoY7!%=`d=EzP~#M$EF*LssMt!~&-jak(*Bu!RP7~zt+4+s|tdbSQ zHijXm;AhT01a4UqfI^Uw+35qWN!X_q#8LY)0z|yld_S*o_=WlS7xWqDI_>}EGuk!W z>oX1o?&~uMHV&80lUMJb&nIAPxj>vTdqLd81#TBrNEPs*fdp!n6%g{>iB>Q8B9}dJ laPmm;cpeQ+j-P^WZ{sIU`=K|EN5~K*LyQb@5CtCK{tNRLP)z^; diff --git a/sources/EXTERNALFORMAT b/sources/EXTERNALFORMAT index 1b188919..d5c22103 100644 --- a/sources/EXTERNALFORMAT +++ b/sources/EXTERNALFORMAT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Apr-2025 08:43:01" {WMEDLEY}EXTERNALFORMAT.;91 38905 +(FILECREATED "29-Jan-2026 21:09:02" {WMEDLEY}EXTERNALFORMAT.;92 39722 :EDIT-BY rmk - :CHANGES-TO (VARS EXTERNALFORMATCOMS) + :CHANGES-TO (FNS \EXTERNALFORMAT) - :PREVIOUS-DATE "19-Mar-2024 18:24:39" {WMEDLEY}EXTERNALFORMAT.;90) + :PREVIOUS-DATE "24-Apr-2025 08:43:01" {WMEDLEY}EXTERNALFORMAT.;91) (PRETTYCOMPRINT EXTERNALFORMATCOMS) @@ -131,7 +131,11 @@ (DEFINEQ (\EXTERNALFORMAT - [LAMBDA (STREAM NEWFORMAT/NAME) + [LAMBDA (STREAM NEWFORMAT/NAME CREATING) (* ; "Edited 29-Jan-2026 21:05 by rmk") + + (* ;; "CREATING is T from STREAM declaration, tries to not override the fields that are specified in the create expression") + + (* ;; "Edited 29-Jan-2026 21:01 by rmk") (* ;; "Edited 2-Jul-2022 19:17 by rmk: Fast case: NEWFORMAT/NAME is an external format") @@ -177,14 +181,20 @@ (CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT) (freplace (STREAM EOLCONVENTION) of STREAM with (ffetch (EXTERNALFORMAT EOL) of EXTFORMAT))) - (freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT OUTCHARFN) - of EXTFORMAT)) - (freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT INCCODEFN) - of EXTFORMAT)) - (freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT PEEKCCODEFN) - of EXTFORMAT)) - (freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT BACKCCODEFN) - of EXTFORMAT)))]) + (CL:UNLESS (AND CREATING (ffetch (STREAM OUTCHARFN) of STREAM)) + (freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT OUTCHARFN) + of EXTFORMAT))) + (CL:UNLESS (AND CREATING (ffetch (STREAM INCCODEFN) of STREAM)) + (freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT INCCODEFN) + of EXTFORMAT))) + (CL:UNLESS (AND CREATING (ffetch (STREAM PEEKCCODEFN) of STREAM)) + (freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT + PEEKCCODEFN) + of EXTFORMAT))) + (CL:UNLESS (AND CREATING (ffetch (STREAM BACKCCODEFN) of STREAM)) + (freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT + BACKCCODEFN) + of EXTFORMAT))))]) (ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM]) (MAKE-EXTERNALFORMAT @@ -737,13 +747,13 @@ (\CREATE.THROUGH.EXTERNALFORMAT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6710 13543 (\EXTERNALFORMAT 6720 . 10498) (MAKE-EXTERNALFORMAT 10500 . 13070) ( -\EXTERNALFORMAT.DEFPRINT 13072 . 13541)) (13544 16585 (\INSTALL.EXTERNALFORMAT 13554 . 15003) ( -\REMOVE.EXTERNALFORMAT 15005 . 15836) (FIND-FORMAT 15838 . 16583)) (16586 16998 (SYSTEM-EXTERNALFORMAT - 16596 . 16996)) (17347 33324 (\OUTCHAR 17357 . 18574) (\INCCODE 18576 . 19729) (\BACKCCODE 19731 . -21410) (\BACKCCODE.EOLC 21412 . 23602) (\PEEKCCODE 23604 . 23929) (\PEEKCCODE.EOLC 23931 . 24310) ( -\INCCODE.EOLC 24312 . 26111) (\FORMATBYTESTREAM 26113 . 28557) (\FORMATBYTESTRING 28559 . 30259) ( -\CHECKEOLC.CRLF 30261 . 33322)) (34606 36842 (\NULLDEVICE 34616 . 36518) (\NULL.OPENFILE 36520 . 36840 -)) (36982 38809 (\CREATE.THROUGH.EXTERNALFORMAT 36992 . 37778) (\THROUGHIN 37780 . 38200) ( -\THROUGHBACKCCODE 38202 . 38469) (\THROUGHOUTCHARFN 38471 . 38807))))) + (FILEMAP (NIL (6706 14360 (\EXTERNALFORMAT 6716 . 11315) (MAKE-EXTERNALFORMAT 11317 . 13887) ( +\EXTERNALFORMAT.DEFPRINT 13889 . 14358)) (14361 17402 (\INSTALL.EXTERNALFORMAT 14371 . 15820) ( +\REMOVE.EXTERNALFORMAT 15822 . 16653) (FIND-FORMAT 16655 . 17400)) (17403 17815 (SYSTEM-EXTERNALFORMAT + 17413 . 17813)) (18164 34141 (\OUTCHAR 18174 . 19391) (\INCCODE 19393 . 20546) (\BACKCCODE 20548 . +22227) (\BACKCCODE.EOLC 22229 . 24419) (\PEEKCCODE 24421 . 24746) (\PEEKCCODE.EOLC 24748 . 25127) ( +\INCCODE.EOLC 25129 . 26928) (\FORMATBYTESTREAM 26930 . 29374) (\FORMATBYTESTRING 29376 . 31076) ( +\CHECKEOLC.CRLF 31078 . 34139)) (35423 37659 (\NULLDEVICE 35433 . 37335) (\NULL.OPENFILE 37337 . 37657 +)) (37799 39626 (\CREATE.THROUGH.EXTERNALFORMAT 37809 . 38595) (\THROUGHIN 38597 . 39017) ( +\THROUGHBACKCCODE 39019 . 39286) (\THROUGHOUTCHARFN 39288 . 39624))))) STOP diff --git a/sources/EXTERNALFORMAT.LCOM b/sources/EXTERNALFORMAT.LCOM index 3b4777b2c97ebd05b591ceb416df3b64e7246d5d..1a705304e4c25e7e17ab049d5959c05266186be8 100644 GIT binary patch delta 337 zcmbOdwkK>tgs`QqS7M&7k%5t!f{~$>fu)s!@x*M?dLvB*E+r!*Nkc;`V*@J_10{u| zqSWO4+=9%U)D(r(ih`nIRV#%U*N70;AU{VRH~%1C#}I|gJOw4UP#+%!WFz$S^pq4* z5=(&ku$pbDq{*e>=IP_=93<`P7~<-pfZ_tE^Nc1|tFjv@7+abf8BI=Llu>r`3r4qJ zQ^6`A$TiH3xLd9p3j z3QMQS4ktC1Ie4686VccY;#hz<3?dd_junW*Bw_{T*nl`JA~ySlg*X1!-ptC(uK@rH C30?XC delta 343 zcmdlJHYIFAgs_ROV?mLwk%5t^f`NsViLsS|;lymydP7YGE+r#lgrt$Nm8pf5k-3sW zQc-Gher`c#PHKumazw_}dHT3I2e~?ixVk8aD;Z&Nn3BTeeT*vc3dRfuD#{Vvxb(#4!00S^vJ^%m! diff --git a/sources/HARDCOPY b/sources/HARDCOPY index 9e7e0de2..906fb3c4 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,14 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jan-2026 17:17:23" {WMEDLEY}HARDCOPY.;155 147674 +(FILECREATED "29-Jan-2026 10:45:17" {WMEDLEY}HARDCOPY.;160 149481 :EDIT-BY rmk - :CHANGES-TO (VARS HARDCOPYCOMS) - (FNS TEXT.TO.IMAGEFILE TEXTTOIMAGEFILE VIEWERPRINT PRINTERDEVICE.OPENFN - SEND.FILE.TO.PRINTER) + :CHANGES-TO (FNS PRINTERNAME FIND.PRINTER.FOR.IMAGETYPE PRINTERDEVICE.OPENFN PRINTERTYPE) - :PREVIOUS-DATE "18-Jan-2026 15:20:21" {WMEDLEY}HARDCOPY.;149) + :PREVIOUS-DATE "27-Jan-2026 23:11:17" {WMEDLEY}HARDCOPY.;157) (PRETTYCOMPRINT HARDCOPYCOMS) @@ -52,11 +50,14 @@ (FNS SCALEREGION) [COMS (* ;  "Converting text files to imagestreams") + (GLOBALVARS TEXTDEFAULTPAGEREGION) [INITVARS (TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75] - (GLOBALVARS TEXTDEFAULTPAGEREGION) + (ALISTS (IMAGESTREAMTYPES TEXT) + (PRINTFILETYPES TEXT)) (FNS TEXT.TO.IMAGEFILE COPY.TEXT.TO.IMAGE TEXTTOIMAGEFILE) - (P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE] + (P (FONTPROFILE.ADDDEVICE 'TEXT) + (DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE] (COMS (* ;  "hack for printers that can't really BLTSHADE") (FNS \BLTSHADE.GENERICPRINTER)) @@ -369,7 +370,8 @@ (AND STATUSFN (APPLY* STATUSFN PRINTER]) (PRINTERTYPE - [LAMBDA (HOST PREFERRED NODEFAULT) (* ; "Edited 18-Jan-2026 14:47 by rmk") + [LAMBDA (HOST PREFERRED NODEFAULT) (* ; "Edited 28-Jan-2026 23:55 by rmk") + (* ; "Edited 18-Jan-2026 14:47 by rmk") (* ; "Edited 16-Jan-2026 07:35 by rmk") (* ; "Edited 17-Dec-2025 00:52 by rmk") (* ; "Edited 14-Dec-2025 17:53 by rmk") @@ -378,11 +380,6 @@ (* ; "Edited 19-Sep-2025 10:18 by rmk") (* ; "Edited 27-Apr-98 16:16 by rmk:") (* ; "Edited 15-Feb-91 14:14 by gadener") - - (* ;; - "We uppercase before we look at the printer HOSTNAMEP functions--they can handle the casing") - - (SETQ HOST (MKATOM HOST)) (COND ((NULL HOST) DEFAULTPRINTERTYPE) @@ -424,7 +421,8 @@ DEFAULTPRINTERTYPE]) (PRINTERNAME - [LAMBDA (PRINTER) (* ; "Edited 5-Dec-2025 09:35 by rmk") + [LAMBDA (PRINTER) (* ; "Edited 29-Jan-2026 10:44 by rmk") + (* ; "Edited 5-Dec-2025 09:35 by rmk") (* ; "Edited 19-Sep-2025 09:59 by rmk") (* ;; @@ -432,17 +430,20 @@ (* ;; "Takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.") - (CL:WHEN (LISTP PRINTER) - (SETQ PRINTER (CADR PRINTER))) - (CL:WHEN (PRINTERDEVICEP PRINTER) - [LET (FDEV) - (if (AND (STREAMP PRINTER) - (STREAMPROP PRINTER 'PRINTERNAME)) - else (SETQ FDEV (TRUEDEVICE PRINTER)) - (if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV)) - then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER 'NAME] - PRINTER) - else (fetch (FDEV DEVICENAME) of FDEV])]) + (if (LISTP PRINTER) + then (CADR PRINTER) + elseif (LITATOM PRINTER) + then PRINTER + elseif (PRINTERDEVICEP PRINTER) + then (LET (FDEV) + (if (AND (STREAMP PRINTER) + (STREAMPROP PRINTER 'PRINTERNAME)) + else (SETQ FDEV (TRUEDEVICE PRINTER)) + (if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV)) + then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER + 'NAME] + PRINTER) + else (fetch (FDEV DEVICENAME) of FDEV]) (PRINTFILETYPE [LAMBDA (FILE DONTOPEN) (* ; "Edited 24-Dec-2025 20:39 by rmk") @@ -542,7 +543,8 @@ IMAGESOURCE)))])]) (FIND.PRINTER.FOR.IMAGETYPE - [LAMBDA (IMAGETYPE HOST) (* ; "Edited 12-Jan-2026 23:49 by rmk") + [LAMBDA (IMAGETYPE HOST) (* ; "Edited 29-Jan-2026 10:29 by rmk") + (* ; "Edited 12-Jan-2026 23:49 by rmk") (* ; "Edited 28-Dec-2025 18:02 by rmk") (* ; "Edited 23-Dec-2025 10:13 by rmk") (* ; "Edited 17-Dec-2025 00:59 by rmk") @@ -559,22 +561,19 @@ (CL:WHEN (SETQ TARGETTYPE (CAN.PRINT.SOMEHOW HOST IMAGETYPE)) (LIST (PRINTERTYPE HOST) - HOST TARGETTYPE)) + (PRINTERNAME 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) + (PRINTERNAME 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) + (PRINTERNAME PRINTER) TARGETTYPE]) (CAN.PRINT.SOMEHOW @@ -626,7 +625,8 @@ LPTNAME]) (PRINTERDEVICE.OPENFN - [LAMBDA (LPTNAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 19-Jan-2026 12:19 by rmk") + [LAMBDA (LPTNAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 29-Jan-2026 00:13 by rmk") + (* ; "Edited 19-Jan-2026 12:19 by rmk") (* ; "Edited 16-Jan-2026 23:09 by rmk") (* ; "Edited 28-Dec-2025 17:44 by rmk") (* ; "Edited 11-Sep-2025 17:03 by rmk") @@ -656,14 +656,25 @@  "The case of foo.local as a printer name with no type") (SETQ PRINTERNAME PN) (SETQ IMAGEFILETYPE NIL)) - (CL:UNLESS PRINTERNAME (SETQ PRINTERNAME :DEFAULTPRINTER)) (* ;; "Filename is now decoded") - [if IMAGEFILETYPE + [if (AND IMAGEFILETYPE PRINTERNAME) then (CL:UNLESS (CAN.PRINT.SOMEHOW PRINTERNAME IMAGEFILETYPE) + (* ; "{LPT}P.T") (ERROR PRINTERNAME (CONCAT "cannot print files of type " IMAGEFILETYPE))) - else (SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME) + elseif PRINTERNAME + then (* ; "{LPT}P") + [SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME) + 'CANPRINT] + elseif IMAGEFILETYPE + then (* ; "{LPT}.T") + (CL:UNLESS (SETQ PRINTERNAME (FIND.PRINTER.FOR.IMAGETYPE IMAGEFILETYPE)) + (ERROR "No printers for " IMAGEFILETYPE " files" (CONCAT + "cannot print files of type " + IMAGEFILETYPE))) + else (SETQ PRINTERNAME :DEFAULTPRINTER) (* ; "Just {LPT}") + (SETQ IMAGEFILETYPE (CAR (PRINTERPROP (PRINTERTYPE PRINTERNAME) 'CANPRINT] (* ;; "Open as a regular Unix tmp stream... with a funky closefn") @@ -723,7 +734,8 @@ (fetch (FDEV DEVICENAME) of FDEV))))]) (PRINTERNAME - [LAMBDA (PRINTER) (* ; "Edited 5-Dec-2025 09:35 by rmk") + [LAMBDA (PRINTER) (* ; "Edited 29-Jan-2026 10:44 by rmk") + (* ; "Edited 5-Dec-2025 09:35 by rmk") (* ; "Edited 19-Sep-2025 09:59 by rmk") (* ;; @@ -731,17 +743,20 @@ (* ;; "Takes a printer-spec (in form (type printer-name) or just printer-name) and returns printer-name. returns nil for null arg.") - (CL:WHEN (LISTP PRINTER) - (SETQ PRINTER (CADR PRINTER))) - (CL:WHEN (PRINTERDEVICEP PRINTER) - [LET (FDEV) - (if (AND (STREAMP PRINTER) - (STREAMPROP PRINTER 'PRINTERNAME)) - else (SETQ FDEV (TRUEDEVICE PRINTER)) - (if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV)) - then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER 'NAME] - PRINTER) - else (fetch (FDEV DEVICENAME) of FDEV])]) + (if (LISTP PRINTER) + then (CADR PRINTER) + elseif (LITATOM PRINTER) + then PRINTER + elseif (PRINTERDEVICEP PRINTER) + then (LET (FDEV) + (if (AND (STREAMP PRINTER) + (STREAMPROP PRINTER 'PRINTERNAME)) + else (SETQ FDEV (TRUEDEVICE PRINTER)) + (if (EQ 'LPT (fetch (FDEV DEVICENAME) of FDEV)) + then (CL:UNLESS [EQ '%. (SETQ PRINTER (FILENAMEFIELD PRINTER + 'NAME] + PRINTER) + else (fetch (FDEV DEVICENAME) of FDEV]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -839,12 +854,18 @@ (* ; "Converting text files to imagestreams") - -(RPAQ? TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEXTDEFAULTPAGEREGION) ) + +(RPAQ? TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75))) + +(ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT) + (CREATECHARSET \CREATECHARSET.DISPLAY))) + +(ADDTOVAR PRINTFILETYPES (TEXT (TEST LISPSOURCEFILEP) + (EXTENSION (TXT TEXT)))) (DEFINEQ (TEXT.TO.IMAGEFILE @@ -970,6 +991,8 @@ (TEDIT.TO.IMAGEFILE FILE IMAGEFILE IMAGETYPE OPTIONS]) ) +(FONTPROFILE.ADDDEVICE 'TEXT) + (DEFAULT.IMAGETYPE.CONVERSIONS '(TEXT TEXT.TO.IMAGEFILE)) @@ -2330,35 +2353,35 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6606 19331 (MakeMenuOfPrinters 6616 . 8105) (PRINTERS.WHENSELECTEDFN 8107 . 10038) ( -MakeMenuOfImageTypes 10040 . 10859) (GetNewPrinterFromUser 10861 . 11417) (PopUpWindowAndGetAtom 11419 - . 12870) (PopUpWindowAndGetList 12872 . 14442) (NewPrinter 14444 . 16058) (GetPrinterName 16060 . -16348) (GetImageFile 16350 . 19329)) (19386 37306 (HARDCOPYW 19396 . 20869) (LISTFILES1 20871 . 21048) - (PRINTERPROP 21050 . 21300) (PRINTERSTATUS 21302 . 21577) (PRINTERTYPE 21579 . 24855) (PRINTERNAME -24857 . 25943) (PRINTFILETYPE 25945 . 26318) (PRINTERTYPEP 26320 . 26545) (SEND.FILE.TO.PRINTER 26547 - . 32796) (FIND.PRINTER.FOR.IMAGETYPE 32798 . 35503) (CAN.PRINT.SOMEHOW 35505 . 36877) ( -CAN.PRINT.DIRECTLY 36879 . 37304)) (37307 45651 (PRINTERDEVICE 37317 . 38926) (PRINTERDEVICE.OPENFN -38928 . 41914) (PRINTERDEVICE.CLOSEFN 41916 . 43635) (PRINTERDEVICEP 43637 . 44561) (PRINTERNAME 44563 - . 45649)) (45713 48137 (DEFAULTPRINTERS 45723 . 48135)) (48536 49833 (VIEWERPRINT 48546 . 49831)) ( -49951 50509 (SCALEREGION 49961 . 50507)) (50733 58555 (TEXT.TO.IMAGEFILE 50743 . 51956) ( -COPY.TEXT.TO.IMAGE 51958 . 58306) (TEXTTOIMAGEFILE 58308 . 58553)) (58676 60419 ( -\BLTSHADE.GENERICPRINTER 58686 . 60417)) (60486 97652 (MAKEHARDCOPYSTREAM 60496 . 62212) ( -UNMAKEHARDCOPYSTREAM 62214 . 63144) (HARDCOPYSTREAMTYPE 63146 . 63553) (\CHARWIDTH.HDCPYDISPLAY 63555 - . 64375) (\DSPFONT.HDCPYDISPLAY 64377 . 67172) (\DSPRIGHTMARGIN.HDCPYDISPLAY 67174 . 68029) ( -\DSPXPOSITION.HDCPYDISPLAY 68031 . 68406) (\DSPYPOSITION.HDCPYDISPLAY 68408 . 68783) ( -\STRINGWIDTH.HDCPYDISPLAY 68785 . 69740) (\STRINGWIDTH.HCPYDISPLAYAUX 69742 . 75082) (\HDCPYBLTCHAR -75084 . 79981) (\HDCPYDISPLAY.FIX.XPOS 79983 . 80740) (\HDCPYDISPLAY.FIX.YPOS 80742 . 81483) ( -\HDCPYDISPLAYINIT 81485 . 83175) (\HDCPYDSPPRINTCHAR 83177 . 89090) (\SLOWHDCPYBLTCHAR 89092 . 95708) -(\CHANGECHARSET.HDCPYDISPLAY 95710 . 97650)) (97967 147518 (MAKEHARDCOPYMODESTREAM 97977 . 100698) ( -UNMAKEHARDCOPYMODESTREAM 100700 . 102290) (\HCPYDISPLAYIMAGEOPS 102292 . 105112) (\BLTSHADE.HCPYMODE -105114 . 105780) (\BITBLT.HCPYMODE 105782 . 106530) (\BRUSHCONVERT.HCPYMODE 106532 . 107081) ( -\CHANGECHARSET.HCPYMODE 107083 . 110345) (\DASHINGCONVERT.HCPYMODE 110347 . 110688) ( -\CHARWIDTH.HCPYMODE 110690 . 111127) (\DRAWLINE.HCPYMODE 111129 . 111658) (\DRAWCURVE.HCPYMODE 111660 - . 112247) (\DRAWCIRCLE.HCPYMODE 112249 . 112734) (\DRAWELLIPSE.HCPYMODE 112736 . 113420) ( -\DSPFONT.HCPYMODE 113422 . 116106) (\DSPLEFTMARGIN.HCPYMODE 116108 . 116850) (\DSPLINEFEED.HCPYMODE -116852 . 117485) (\DSPRIGHTMARGIN.HCPYMODE 117487 . 118555) (\DSPSPACEFACTOR.HCPYMODE 118557 . 119332) - (\DSPXPOSITION.HCPYMODE 119334 . 120352) (\DSPYPOSITION.HCPYMODE 120354 . 121004) (\MOVETO.HCPYMODE -121006 . 121220) (\FONTCREATE.HCPYMODE 121222 . 123179) (\CREATECHARSET.HCPYMODE 123181 . 124904) ( -\STRINGWIDTH.HCPYMODE 124906 . 125701) (\HCPYMODEBLTCHAR 125703 . 131453) (\HCPYMODEDSPPRINTCHAR -131455 . 137389) (\SLOWHCPYMODEBLTCHAR 137391 . 144020) (\SFFixY.HCPYMODE 144022 . 147516))))) + (FILEMAP (NIL (6665 19390 (MakeMenuOfPrinters 6675 . 8164) (PRINTERS.WHENSELECTEDFN 8166 . 10097) ( +MakeMenuOfImageTypes 10099 . 10918) (GetNewPrinterFromUser 10920 . 11476) (PopUpWindowAndGetAtom 11478 + . 12929) (PopUpWindowAndGetList 12931 . 14501) (NewPrinter 14503 . 16117) (GetPrinterName 16119 . +16407) (GetImageFile 16409 . 19388)) (19445 37555 (HARDCOPYW 19455 . 20928) (LISTFILES1 20930 . 21107) + (PRINTERPROP 21109 . 21359) (PRINTERSTATUS 21361 . 21636) (PRINTERTYPE 21638 . 24874) (PRINTERNAME +24876 . 26243) (PRINTFILETYPE 26245 . 26618) (PRINTERTYPEP 26620 . 26845) (SEND.FILE.TO.PRINTER 26847 + . 33096) (FIND.PRINTER.FOR.IMAGETYPE 33098 . 35752) (CAN.PRINT.SOMEHOW 35754 . 37126) ( +CAN.PRINT.DIRECTLY 37128 . 37553)) (37556 47168 (PRINTERDEVICE 37566 . 39175) (PRINTERDEVICE.OPENFN +39177 . 43150) (PRINTERDEVICE.CLOSEFN 43152 . 44871) (PRINTERDEVICEP 44873 . 45797) (PRINTERNAME 45799 + . 47166)) (47230 49654 (DEFAULTPRINTERS 47240 . 49652)) (50053 51350 (VIEWERPRINT 50063 . 51348)) ( +51468 52026 (SCALEREGION 51478 . 52024)) (52509 60331 (TEXT.TO.IMAGEFILE 52519 . 53732) ( +COPY.TEXT.TO.IMAGE 53734 . 60082) (TEXTTOIMAGEFILE 60084 . 60329)) (60483 62226 ( +\BLTSHADE.GENERICPRINTER 60493 . 62224)) (62293 99459 (MAKEHARDCOPYSTREAM 62303 . 64019) ( +UNMAKEHARDCOPYSTREAM 64021 . 64951) (HARDCOPYSTREAMTYPE 64953 . 65360) (\CHARWIDTH.HDCPYDISPLAY 65362 + . 66182) (\DSPFONT.HDCPYDISPLAY 66184 . 68979) (\DSPRIGHTMARGIN.HDCPYDISPLAY 68981 . 69836) ( +\DSPXPOSITION.HDCPYDISPLAY 69838 . 70213) (\DSPYPOSITION.HDCPYDISPLAY 70215 . 70590) ( +\STRINGWIDTH.HDCPYDISPLAY 70592 . 71547) (\STRINGWIDTH.HCPYDISPLAYAUX 71549 . 76889) (\HDCPYBLTCHAR +76891 . 81788) (\HDCPYDISPLAY.FIX.XPOS 81790 . 82547) (\HDCPYDISPLAY.FIX.YPOS 82549 . 83290) ( +\HDCPYDISPLAYINIT 83292 . 84982) (\HDCPYDSPPRINTCHAR 84984 . 90897) (\SLOWHDCPYBLTCHAR 90899 . 97515) +(\CHANGECHARSET.HDCPYDISPLAY 97517 . 99457)) (99774 149325 (MAKEHARDCOPYMODESTREAM 99784 . 102505) ( +UNMAKEHARDCOPYMODESTREAM 102507 . 104097) (\HCPYDISPLAYIMAGEOPS 104099 . 106919) (\BLTSHADE.HCPYMODE +106921 . 107587) (\BITBLT.HCPYMODE 107589 . 108337) (\BRUSHCONVERT.HCPYMODE 108339 . 108888) ( +\CHANGECHARSET.HCPYMODE 108890 . 112152) (\DASHINGCONVERT.HCPYMODE 112154 . 112495) ( +\CHARWIDTH.HCPYMODE 112497 . 112934) (\DRAWLINE.HCPYMODE 112936 . 113465) (\DRAWCURVE.HCPYMODE 113467 + . 114054) (\DRAWCIRCLE.HCPYMODE 114056 . 114541) (\DRAWELLIPSE.HCPYMODE 114543 . 115227) ( +\DSPFONT.HCPYMODE 115229 . 117913) (\DSPLEFTMARGIN.HCPYMODE 117915 . 118657) (\DSPLINEFEED.HCPYMODE +118659 . 119292) (\DSPRIGHTMARGIN.HCPYMODE 119294 . 120362) (\DSPSPACEFACTOR.HCPYMODE 120364 . 121139) + (\DSPXPOSITION.HCPYMODE 121141 . 122159) (\DSPYPOSITION.HCPYMODE 122161 . 122811) (\MOVETO.HCPYMODE +122813 . 123027) (\FONTCREATE.HCPYMODE 123029 . 124986) (\CREATECHARSET.HCPYMODE 124988 . 126711) ( +\STRINGWIDTH.HCPYMODE 126713 . 127508) (\HCPYMODEBLTCHAR 127510 . 133260) (\HCPYMODEDSPPRINTCHAR +133262 . 139196) (\SLOWHCPYMODEBLTCHAR 139198 . 145827) (\SFFixY.HCPYMODE 145829 . 149323))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index 25e412bc7498e308f2812b0b348c7c830e22f48d..bbb0f6d0aa5d8cac3a44b0092767bc8711a0b81f 100644 GIT binary patch delta 2142 zcmd5-Pi)&{6nBzpe?kQ*?Ix`oBNZip*UWchvX_x}Cfd!KiH ziGTT9{L^bwyqdjoYc0!jd>#lXa6*Ad58i*Ho99?argZ1T>Wsi08ZVoJiTsdHT}qYdkxZ+hG|07T`rePL-W>VtC@tS<75h=oMw}m ziec)dx~_S88Bx((xq>Jai0r=-fBAHt10t%TLi|qbLaJi9N5cEx%$)asjh*2K`FTr@ z&O*Vd>kEe6aIX0bPiGzHTd>)3`IzS}l zSa^y9!U@#wP1lD;i|H>sVbFX6MgGCe(=id`?Zp9{2mXRZX=@EK@#zcu1ZyI&zDbg(yt$}XZK zm=uNhOom{+19F2(2rmxhusKAcGm#50IoGb~Rr?yK(hw9FDMuO)3ik|?=W&c8f%=bM zmB&u75Stle{7bApalN|#g0Y{t*JE}90v7$B+3Ms?TI1PxpR2Bf_4Z%$x7mx`&))ui zW$9z%QSYEr#mAkh5tQ1$SM5-XPzsKE2WtU8iw}DTtxy>}Be-#D(mSXy8D7Z`W|>zA zlx(Y{dB95|&W}|NIne95itYa}Gv4LJ5m-C~^T7@s_gyAsK(Ign=a8f7nf>ptGbSpeVk@&mP)Jy7UKZ1c)Mk4j;KfYuwkl{wr zwFp;^h%y*8Z5}ryJOUydX&7D}m~*fvxUqRyUEc&1Z!FCUx(W*Kug<9nUY7iwxr?}y zG6!i`#%uj<8W&WAwAF$2jrQ7RYvV2~cQ#PV3jz345(v&r`lJ3&bN#XZ?;1DB&G-D- zEr=!kAHSIKzutaJVIh;$OvCkD$OQC-427I}`l5$`fS)0)E(E9kR_vVr&emihNkz{d zQBU!Zsn{01lBrQnE0+fsRpx5L#&1jDfCc~0?brKzTWYe42+v;7>R|(;8DuCnbQga1 z;KtzdXSj~3Ezvj_F+3|(wYsZ&L&!kPl|yKfW%2qOg^Cn)gI?K#NS^L`fP6Tv-Kdv> cVRA44W`SdB*cRe2p|Aq#?>`Im|Jbhn1NVw3-2eap delta 1608 zcmd5+O>Ep$5VpO6HbzJZ+C+Zgdo$juU?afam1PvRpp{0pR z4_vCfbAjqzdPol-Kovr2vL;e{h&*(iNn7(X&8WX%d~W|&7Z-mP8fmfgte+4Y*hVbB*A>W z75xXGs~%p%VGw$)nB3)O-x4F-s>uukD=^jLP=az0;#JRYM@uyd>3!7z5b5#Rs}XkKt) zze#(JEFD}wid#;T8jxv{gTl;tgt8AJu#Kz?X6cBin^}PkS%F&vP7K>EwvO zZ*pYo^hOT>YcNYz_i&>Ix(0FB#x>gFDhADfD5eBxrd6uiNCKpeG7LNen#5M1P9?BP za83r(1Qrzx3mQQT#?YuKqle5YCGVX1;zaNB9LEXMQ=D@MC)t#yrv)!}sC8dC+{wtx z-Kme5^>Om2QxVy}^&fpF9joJZ3x&cIf3dRtQflbWtfYpOPVT0_r`G+%6E^n0r#^$X z{rt$~;@D@3x!mIB5wb@x*?<5c1*%SKKteh4o7nZ&prjvhvW(+C$sey<6LV09p(|@P zi%7SE`)7hDGZMBW_uI6tdtN_sy%b#Xp1Z^97)YsV--~C3dx+KpxP0@#Rw{58Ut*R5#MLFIhqAs**s;a~IW~EuxXBGf;7*FtB`Q^4PlE3fNo&v+LnXdo< diff --git a/sources/IMAGEIO b/sources/IMAGEIO index a131fb5c..1da2799c 100644 --- a/sources/IMAGEIO +++ b/sources/IMAGEIO @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jan-2026 14:08:55" {WMEDLEY}IMAGEIO.;51 99943 +(FILECREATED "29-Jan-2026 08:48:22" {WMEDLEY}IMAGEIO.;60 100411 :EDIT-BY rmk - :CHANGES-TO (FNS IMAGESTREAMTYPE) + :CHANGES-TO (VARS IMAGEIOCOMS) - :PREVIOUS-DATE "18-Jan-2026 15:04:58" {WMEDLEY}IMAGEIO.;50) + :PREVIOUS-DATE "29-Jan-2026 00:29:52" {WMEDLEY}IMAGEIO.;57) (PRETTYCOMPRINT IMAGEIOCOMS) @@ -19,17 +19,18 @@ (FNS CONVERT.TO.IMAGEFILE) (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 (ADDVARS (PRINTFILETYPES (DEFAULT))) + (COMS (* ; "PRINTFILETYPES") + (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 TEXT))) - (COMS (* ; "Until HTML streams") - (ALISTS (PRINTFILETYPES HTML)) - (FNS HTMLFILEP)) + (ALISTS (PRINTFILETYPES BITMAP WINDOW SCREENREGION BITMAPFILE)) + (COMS (* ; "Until HTML streams") + (ALISTS (PRINTFILETYPES HTML)) + (FNS HTMLFILEP))) (INITVARS (IMAGESTREAMTYPES NIL)) (FNS \GOOD.DASHLST) (FNS DRAWDASHEDLINE) @@ -220,6 +221,7 @@ (CONVERT.TO.IMAGEFILE [LAMBDA (IMAGESOURCE IMAGEFILE IMAGEFILETYPE OPTIONS NOERROR) + (* ; "Edited 27-Jan-2026 17:45 by rmk") (* ; "Edited 17-Jan-2026 12:41 by rmk") (* ; "Edited 12-Jan-2026 23:49 by rmk") (* ; "Edited 11-Jan-2026 13:21 by rmk") @@ -254,40 +256,43 @@ (SETQ IMAGEFILETYPE (IMAGESOURCETYPE IMAGEFILE))) (CL:WHEN (MEMB IMAGEFILETYPE '(PDF POSTSCRIPT)) (* ; "POSTSCRIPT SCREWS UP") (push OPTIONS 'HEADING NIL)) - (LET - ((SOURCETYPE (IMAGESOURCETYPE IMAGESOURCE)) - CONVERTED CFN) + (LET ((SOURCETYPE (IMAGESOURCETYPE IMAGESOURCE)) + CONVERTED CFN) - (* ;; "The conversion function may abandon the IMAGEFILE we provide and create its own.") + (* ;; "The conversion function may abandon the IMAGEFILE we provide and create its own.") - (if (EQ IMAGEFILETYPE SOURCETYPE) - then - (* ;; "Already have what we want") + (if (EQ IMAGEFILETYPE SOURCETYPE) + then + (* ;; "Already have what we want") - IMAGESOURCE - else (if [AND (SETQ CFN (OR (LISTGET (IMAGEFILEPROP IMAGEFILETYPE 'CONVERSION) - SOURCETYPE) - (LISTGET (IMAGEFILEPROP 'DEFAULT 'CONVERSION) - SOURCETYPE))) - (SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN IMAGESOURCE - [OR (STREAMP IMAGEFILE) - (AND IMAGEFILE - (PACKFILENAME 'BODY IMAGEFILE - 'EXTENSION - (CAR ( + IMAGESOURCE + elseif [AND (SETQ CFN (OR (LISTGET (IMAGEFILEPROP IMAGEFILETYPE 'CONVERSION) + SOURCETYPE) + (LISTGET (IMAGEFILEPROP 'DEFAULT 'CONVERSION) + SOURCETYPE))) + (SETQ CONVERTED (CAR (NLSETQ (APPLY* CFN IMAGESOURCE + [OR (STREAMP IMAGEFILE) + [AND IMAGEFILE + (PACKFILENAME 'BODY IMAGEFILE + 'EXTENSION + (CAR (  EXTENSIONS.FOR.IMAGEFILETYPE - IMAGEFILETYPE] - 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) - (CL:IF (STREAMP IMAGESOURCE) - (FULLNAME IMAGESOURCE) - IMAGESOURCE)]) + IMAGEFILETYPE] + (UNIX-TMP-FILE-NAME + (L-CASE SOURCETYPE) + (CAR (EXTENSIONS.FOR.IMAGEFILETYPE + IMAGEFILETYPE] + 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) + (CL:IF (STREAMP IMAGESOURCE) + (FULLNAME IMAGESOURCE) + IMAGESOURCE)]) ) (DEFINEQ @@ -479,7 +484,12 @@ (T (BITMAPCOPY (WINDOWPROP WINDOW 'IMAGECOVERED]) ) -(ADDTOVAR PRINTFILETYPES (DEFAULT)) + + +(* ; "PRINTFILETYPES") + + +(RPAQ? PRINTFILETYPES NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS PRINTFILETYPES) @@ -487,33 +497,27 @@ (DEFINEQ (DEFAULT.IMAGETYPE.CONVERSIONS - [LAMBDA (CONVERSIONS) (* ; "Edited 18-Jan-2026 00:18 by rmk") - - (* ;; "Adds CONVERSIONS to the DEFAULT PRINTFILETYPE") - (* ; "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 (for CTAIL (CURRENT _ (OR (CAR (GETMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION)) - (LIST (CAR CONVERSIONS) - NIL))) on CONVERSIONS by (CDDR CTAIL) - do (LISTPUT CURRENT (CAR CTAIL) - (CADR CTAIL)) finally (RETURN CURRENT]) + [LAMBDA (CONVERSIONS) (* ; "Edited 27-Jan-2026 23:24 by rmk") + (* ; "Edited 18-Jan-2026 00:18 by rmk") + (* ; "Edited 24-Dec-2025 22:42 by rmk") + (CL:WHEN CONVERSIONS + [PUTMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION + (CONS (for CTAIL (CURRENT _ (OR (CAR (GETMULTI PRINTFILETYPES 'DEFAULT 'CONVERSION)) + (LIST (CAR CONVERSIONS) + NIL))) on CONVERSIONS by (CDDR CTAIL) + do (LISTPUT CURRENT (CAR CTAIL) + (CADR CTAIL)) finally (RETURN CURRENT])]) ) (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))) - (TEXT (TEST LISPSOURCEFILEP) - (EXTENSION (TXT TEXT)))) +(ADDTOVAR PRINTFILETYPES (BITMAP (TEST BITMAPP)) + (WINDOW (TEST WINDOWP)) + (SCREENREGION (TEST REGIONP)) + (BITMAPFILE (TEST BITMAPFILEP) + (EXTENSION (BM BITMAP)) + (CONVERSION (BITMAP BITMAP.TO.BITMAPFILE)))) @@ -1834,23 +1838,22 @@ ) (ADDTOVAR IMAGESTREAMTYPES - (DISPLAY (OPENSTREAM OPENDISPLAYSTREAM) - (FONTCREATE \CREATEDISPLAYFONT) + (DISPLAY (FONTCREATE \CREATEDISPLAYFONT) + (OPENSTREAM OPENDISPLAYSTREAM) (FONTSAVAILABLE \SEARCHFONTFILES) (CREATECHARSET \CREATECHARSET.DISPLAY) (FONTEXISTS? \FONTEXISTS?.DISPLAY)) - (4DISPLAY (OPENSTREAM OPENDISPLAYSTREAM) + (4DISPLAY (FONTCREATE \CREATEDISPLAYFONT) + (OPENSTREAM OPENDISPLAYSTREAM) + (FONTSAVAILABLE \SEARCHFONTFILES) + (FONTEXISTS? \FONTEXISTS?.DISPLAY)) + (8DISPLAY (FONTCREATE \CREATEDISPLAYFONT) + (OPENSTREAM OPENDISPLAYSTREAM) (FONTCREATE \CREATEDISPLAYFONT) (FONTSAVAILABLE \SEARCHFONTFILES) - (CREATECHARSET \CREATECHARSET.DISPLAY) (FONTEXISTS? \FONTEXISTS?.DISPLAY)) - (8DISPLAY (OPENSTREAM OPENDISPLAYSTREAM) - (FONTCREATE \CREATEDISPLAYFONT) - (FONTSAVAILABLE \SEARCHFONTFILES) - (CREATECHARSET \CREATECHARSET.DISPLAY) - (FONTEXISTS? \FONTEXISTS?.DISPLAY)) - (24DISPLAY (OPENSTREAM OPENDISPLAYSTREAM) - (FONTCREATE \CREATEDISPLAYFONT) + (24DISPLAY (FONTCREATE \CREATEDISPLAYFONT) + (OPENSTREAM OPENDISPLAYSTREAM) (FONTSAVAILABLE \SEARCHFONTFILES) (CREATECHARSET \CREATECHARSET.DISPLAY) (FONTEXISTS? \FONTEXISTS?.DISPLAY))) @@ -1877,32 +1880,32 @@ (ADDTOVAR LAMA IMAGESTREAMP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4337 6241 (OPENIMAGESTREAM 4347 . 6239)) (6242 11483 (IMAGESTREAMP 6252 . 7084) ( -IMAGESTREAMTYPE 7086 . 7602) (IMAGESTREAMTYPEP 7604 . 8239) (IMAGEFILEPROP 8241 . 8779) ( -IMAGESOURCEFILEP 8781 . 9058) (IMAGESOURCETYPE 9060 . 11481)) (11484 12775 ( -EXTENSIONS.FOR.IMAGEFILETYPE 11494 . 12136) (IMAGEFILETYPE.FROM.EXTENSION 12138 . 12773)) (12776 17758 - (CONVERT.TO.IMAGEFILE 12786 . 17756)) (17759 21850 (BITMAPFILEP 17769 . 19270) (BITMAP.TO.BITMAPFILE -19272 . 20949) (BITMAPFILE.TO.BITMAP 20951 . 21605) (BITMAPFILE.TO.IMAGEFILE 21607 . 21848)) (21851 -28176 (BITMAP.TO.IMAGEFILE 21861 . 23418) (WINDOW.TO.IMAGEFILE 23420 . 26249) ( -SCREENREGION.TO.IMAGEFILE 26251 . 27155) (COPY.WINDOW.TO.BITMAP 27157 . 28174)) (28284 29190 ( -DEFAULT.IMAGETYPE.CONVERSIONS 28294 . 29188)) (29904 30130 (HTMLFILEP 29914 . 30128)) (30165 32280 ( -\GOOD.DASHLST 30175 . 32278)) (32281 34578 (DRAWDASHEDLINE 32291 . 34576)) (34579 41919 (DSPBACKCOLOR -34589 . 34961) (DSPBOTTOMMARGIN 34963 . 35348) (DSPCOLOR 35350 . 35714) (DSPCLIPPINGREGION 35716 . -36421) (DSPRESET 36423 . 36703) (DSPFONT 36705 . 37069) (DSPLEFTMARGIN 37071 . 37452) (DSPLINEFEED -37454 . 37754) (DSPOPERATION 37756 . 38133) (DSPRIGHTMARGIN 38135 . 38518) (DSPTOPMARGIN 38520 . 38899 -) (DSPSCALE 38901 . 39268) (DSPSPACEFACTOR 39270 . 39663) (DSPXPOSITION 39665 . 39970) (DSPYPOSITION -39972 . 40277) (DSPROTATE 40279 . 40574) (DSPPUSHSTATE 40576 . 40822) (DSPPOPSTATE 40824 . 41067) ( -DSPDEFAULTSTATE 41069 . 41321) (DSPSCALE2 41323 . 41614) (DSPTRANSLATE 41616 . 41917)) (41920 50721 ( -DSPNEWPAGE 41930 . 42622) (DRAWBETWEEN 42624 . 43326) (DRAWCIRCLE 43328 . 43824) (DRAWARC 43826 . -44343) (DRAWCURVE 44345 . 45022) (DRAWELLIPSE 45024 . 45810) (DRAWLINE 45812 . 46202) (DRAWPOLYGON -46204 . 46659) (DRAWPOINT 46661 . 47080) (FILLPOLYGON 47082 . 47648) (DRAWTO 47650 . 48068) ( -FILLCIRCLE 48070 . 48293) (MOVETO 48295 . 48659) (RELDRAWTO 48661 . 49578) (BITMAPIMAGESIZE 49580 . -49751) (SCALEDBITBLT 49753 . 50719)) (50722 57761 (\DRAWPOINT.GENERIC 50732 . 51079) ( -\DRAWPOLYGON.GENERIC 51081 . 53389) (\DRAWCIRCLE.GENERIC 53391 . 55049) (\DRAWELLIPSE.GENERIC 55051 . -57759)) (57762 62706 (\IMAGEIOINIT 57772 . 61052) (\NOIMAGE.DSPFONT 61054 . 62540) (\UNIMPIMAGEOP -62542 . 62704)) (62829 65953 (INSURE.BRUSH 62839 . 64213) (BRUSHP 64215 . 65005) (\POSSIBLECOLOR 65007 - . 65558) (NEGSHADE 65560 . 65951)) (66509 67193 (DASHINGP 66519 . 66849) (INSURE.DASHING 66851 . -67191)) (77931 98477 (\DisplayEventFn 77941 . 78451) (\DISPLAYINIT 78453 . 84036) (\4DISPLAYINIT 84038 - . 88739) (\8DISPLAYINIT 88741 . 93444) (\24DISPLAYINIT 93446 . 98218) (\DISPLAYSTREAMTYPEBPP 98220 . -98475))))) + (FILEMAP (NIL (4424 6328 (OPENIMAGESTREAM 4434 . 6326)) (6329 11570 (IMAGESTREAMP 6339 . 7171) ( +IMAGESTREAMTYPE 7173 . 7689) (IMAGESTREAMTYPEP 7691 . 8326) (IMAGEFILEPROP 8328 . 8866) ( +IMAGESOURCEFILEP 8868 . 9145) (IMAGESOURCETYPE 9147 . 11568)) (11571 12862 ( +EXTENSIONS.FOR.IMAGEFILETYPE 11581 . 12223) (IMAGEFILETYPE.FROM.EXTENSION 12225 . 12860)) (12863 18321 + (CONVERT.TO.IMAGEFILE 12873 . 18319)) (18322 22413 (BITMAPFILEP 18332 . 19833) (BITMAP.TO.BITMAPFILE +19835 . 21512) (BITMAPFILE.TO.BITMAP 21514 . 22168) (BITMAPFILE.TO.IMAGEFILE 22170 . 22411)) (22414 +28739 (BITMAP.TO.IMAGEFILE 22424 . 23981) (WINDOW.TO.IMAGEFILE 23983 . 26812) ( +SCREENREGION.TO.IMAGEFILE 26814 . 27718) (COPY.WINDOW.TO.BITMAP 27720 . 28737)) (28869 29735 ( +DEFAULT.IMAGETYPE.CONVERSIONS 28879 . 29733)) (30435 30661 (HTMLFILEP 30445 . 30659)) (30696 32811 ( +\GOOD.DASHLST 30706 . 32809)) (32812 35109 (DRAWDASHEDLINE 32822 . 35107)) (35110 42450 (DSPBACKCOLOR +35120 . 35492) (DSPBOTTOMMARGIN 35494 . 35879) (DSPCOLOR 35881 . 36245) (DSPCLIPPINGREGION 36247 . +36952) (DSPRESET 36954 . 37234) (DSPFONT 37236 . 37600) (DSPLEFTMARGIN 37602 . 37983) (DSPLINEFEED +37985 . 38285) (DSPOPERATION 38287 . 38664) (DSPRIGHTMARGIN 38666 . 39049) (DSPTOPMARGIN 39051 . 39430 +) (DSPSCALE 39432 . 39799) (DSPSPACEFACTOR 39801 . 40194) (DSPXPOSITION 40196 . 40501) (DSPYPOSITION +40503 . 40808) (DSPROTATE 40810 . 41105) (DSPPUSHSTATE 41107 . 41353) (DSPPOPSTATE 41355 . 41598) ( +DSPDEFAULTSTATE 41600 . 41852) (DSPSCALE2 41854 . 42145) (DSPTRANSLATE 42147 . 42448)) (42451 51252 ( +DSPNEWPAGE 42461 . 43153) (DRAWBETWEEN 43155 . 43857) (DRAWCIRCLE 43859 . 44355) (DRAWARC 44357 . +44874) (DRAWCURVE 44876 . 45553) (DRAWELLIPSE 45555 . 46341) (DRAWLINE 46343 . 46733) (DRAWPOLYGON +46735 . 47190) (DRAWPOINT 47192 . 47611) (FILLPOLYGON 47613 . 48179) (DRAWTO 48181 . 48599) ( +FILLCIRCLE 48601 . 48824) (MOVETO 48826 . 49190) (RELDRAWTO 49192 . 50109) (BITMAPIMAGESIZE 50111 . +50282) (SCALEDBITBLT 50284 . 51250)) (51253 58292 (\DRAWPOINT.GENERIC 51263 . 51610) ( +\DRAWPOLYGON.GENERIC 51612 . 53920) (\DRAWCIRCLE.GENERIC 53922 . 55580) (\DRAWELLIPSE.GENERIC 55582 . +58290)) (58293 63237 (\IMAGEIOINIT 58303 . 61583) (\NOIMAGE.DSPFONT 61585 . 63071) (\UNIMPIMAGEOP +63073 . 63235)) (63360 66484 (INSURE.BRUSH 63370 . 64744) (BRUSHP 64746 . 65536) (\POSSIBLECOLOR 65538 + . 66089) (NEGSHADE 66091 . 66482)) (67040 67724 (DASHINGP 67050 . 67380) (INSURE.DASHING 67382 . +67722)) (78462 99008 (\DisplayEventFn 78472 . 78982) (\DISPLAYINIT 78984 . 84567) (\4DISPLAYINIT 84569 + . 89270) (\8DISPLAYINIT 89272 . 93975) (\24DISPLAYINIT 93977 . 98749) (\DISPLAYSTREAMTYPEBPP 98751 . +99006))))) STOP diff --git a/sources/IMAGEIO.LCOM b/sources/IMAGEIO.LCOM index 1af83af10c5af6f9277d1577e72249bbfed0215a..5b4e7999928f214abbb4eb4ffab43b8ac88a6a0d 100644 GIT binary patch delta 1076 zcmZuwO;6N77~XDFWRwp-qbTrFV%!?L=`Oq5rAB4wPGPj$)=qbUK#YJyR|OPJG|`Ch z7icDi1uy8$1UBmG&FICWi8l`#P5cF1Jvv=T5Tt3^XP)rJbajhYhOwE6@#)E%r5h8MVdCD+ncK$< zn3}$GwKR1FN>d1&yL*wzd43|gm2>-1#Q@X66m_==3`UD3g2lDe&;O0>3^Y zp7)yn_Q;hG`L!>rvC{6EZGW-0TH{d2v4O@L+XkAO8n3pDqgq6BB$n=mfdVJ?x{Lt{qa`NM zALQ+@E>8*F*Y)_bG7;|I%dPxR*%Ii?{82tUPg_uqd0v6_vmiVG;llM+G5 z0T~ptWoLoEUOL1dEu;33T)i}aM%Hf6YHVmxIIiI45HVcD)W*G{IK(@a_ia>zN~g%6 WgSRYo@{3DmlSpCHZU^~F#rg}sekU6M delta 975 zcmZuw&rj1}7~U3tKv4wL!(_;t8nit?+HQrlhDcq%j!L)I_S=9X!lJ{m&9Ov`iTn%V zX961+!qF&~!BwMo6Hl6$X!KxWylCP-;MXB>OnUh8ywCf-&-*L=`YE*cIrMn?tf&m% zm@5uTf;0+ZOcmm)ytX*9DvLZYtQc=`%Bm!&@)!%ZD!KX6QaNA9EkJIiTv;Ac!AxmM z zkTB9b1g?fogaY}A-cS&`odNpoMcm!+Z6CSK*K4xDQ$FKm3&*Cr&vf6pFwZodJpqpV zI6WScM;mHc! z@g&`gC;Nu)kNky1DNQg#+$ z8(d`Rt~N~(L!Q>B$d~##(vvz*IyT1}#%Ad_Np6Qb4#sG_-MSx)(oy_gfy49<@NejN zcE(Mh{a%5iK9p|Wg~K$=k8Nn%yPc$G=Mwq-Vt~lcS6Xn9iR)Cu(q@5crMslqQG9`H H?ihan%yAHS