github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-25 20:06:44 +00:00
Code Issues Projects Releases Wiki Activity

Rmk51 end game of external format integration (#814)

Browse Source 
* Compile device-creation functions for new default interface

* UNICODE:  minor bug

* LLINTERP: MOVD? APPLY* to SPREADAPPLY*

* External format interface: a few more adjustments

* CLSTREAMS: Recompile, no source change

* PRETTYFILEINDEX: suppress when printing gitmaps to a non-display stream

* UNIXCOMM: Default format comes from device

Also, I seemed to have reverted back to LCOM with FAKE-COMPILE-FILE
This commit is contained in:
rmkaplan
2022-07-03 18:49:04 -07:00
committed by GitHub
parent f86be45834
commit d7ca40ebeb
28 changed files with 1037 additions and 802 deletions
Download Patch File Download Diff File Expand all files Collapse all files

179
lispusers/PRETTYFILEINDEX
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-May-2022 23:33:03" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PRETTYFILEINDEX.;10 96446
(FILECREATED " 3-Jul-2022 15:28:08" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;11 100587
:CHANGES-TO (FNS PFI.PRINT.COMMENTS PFI.MAYBE.NEW.PAGE PFI.MAYBE.PP.DEFINITION
PFI.PRINT.FILECREATED PFI.MAYBE.SEE.PRETTY PRETTYFILEINDEX PFI.PRINT.TO.TAB)
:CHANGES-TO (FNS PFI.PRINT.BITMAP)
:PREVIOUS-DATE "30-Nov-2021 22:12:37"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PRETTYFILEINDEX.;6)
:PREVIOUS-DATE " 5-May-2022 23:33:03"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;10)
(* ; "
@@ -887,8 +886,124 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
(DEFINEQ
(PFI.PRINT.BITMAP
(LAMBDA (BM STREAM) (* ; "Edited 14-Apr-88 12:44 by bvm") (* ;; "DEFPRINT function for bitmaps that displays the actual bitmap when going to an image stream.") (if (OR (NULL *PRINT-ARRAY*) (NULL *PRINT-PRETTY-BITMAPS*)) then (* ; "do the clunky way") (NON.PFI.PRINT.BITMAP BM STREAM) elseif (IMAGESTREAMP STREAM) then (PROG ((CURX (DSPXPOSITION NIL STREAM)) (CURY (DSPYPOSITION NIL STREAM)) (UNITS (DSPSCALE NIL STREAM)) (LINEHEIGHT (DSPLINEFEED NIL STREAM)) HEIGHT WIDTH MINX NLINESDOWN BOTTOM BMARG BELOWBASELINE SCALE RATIO) (if (NOT (AND CURX CURY UNITS LINEHEIGHT)) then (* ; "Stream doesn't really support it") (RETURN (NON.PFI.PRINT.BITMAP BM STREAM))) (SETQ HEIGHT (TIMES UNITS (BITMAPHEIGHT BM))) (SETQ WIDTH (TIMES UNITS (BITMAPWIDTH BM))) (SETQ BMARG (DSPBOTTOMMARGIN NIL STREAM)) (if (AND (NOT (DISPLAYSTREAMP STREAM)) (< (SETQ RATIO (MIN (FQUOTIENT (- (DSPRIGHTMARGIN NIL STREAM) (DSPLEFTMARGIN NIL STREAM)) (TIMES WIDTH 1.5)) (FQUOTIENT (- (DSPTOPMARGIN NIL STREAM) BMARG) (TIMES HEIGHT 1.5)))) 1.0)) then (* ; "It takes up more than 2/3 the page in some dimension. This code is tuned for Interpress.") (SETQ SCALE (if (> RATIO 0.75) then 0.75 elseif (> RATIO 0.5) then 0.5 elseif (> RATIO 0.25) then 0.25 else RATIO)) (SETQ HEIGHT (FIXR (TIMES SCALE HEIGHT))) (SETQ WIDTH (FIXR (TIMES SCALE WIDTH)))) (if (> CURX (SETQ MINX (- (DSPRIGHTMARGIN NIL STREAM) WIDTH))) then (* ; "Won't fit between here and margin, so start nwe line") (TERPRI STREAM) (SETQ CURX (MAX MINX 0)) (SETQ CURY (DSPYPOSITION NIL STREAM))) (SETQ BELOWBASELINE (MAX 0 (- HEIGHT (FONTPROP STREAM (QUOTE ASCENT))))) (if BMARG then (* ; "We know stream's bottom margin, so can be reasonable") (if (< (- CURY BELOWBASELINE) BMARG) then (* ; "Won't fit on page") (DSPNEWPAGE STREAM) (SETQ CURY (DSPYPOSITION NIL STREAM)) (SETQ *PFI-BITMAP-BASELINE* NIL)) else (* ; "Have to use silly terpri method") (SETQ NLINESDOWN (IQUOTIENT HEIGHT (SETQ LINEHEIGHT (- LINEHEIGHT)))) (to NLINESDOWN do (* ; "Do enough cr's so that we have space for bitmap. This might cause scrolling, for example") (TERPRI STREAM) finally (* ; "If this was display, terpri may have scrolled, and Y changed out from under us") (SETQ CURY (+ (DSPYPOSITION NIL STREAM) (TIMES NLINESDOWN LINEHEIGHT))))) (SETQ BOTTOM (- CURY BELOWBASELINE)) (* ; "BOTTOM computed so that bitmap top lines up with font top") (SCALEDBITBLT BM 0 0 STREAM CURX BOTTOM WIDTH HEIGHT (QUOTE INPUT) (QUOTE REPLACE) NIL NIL SCALE) (MOVETO (+ CURX WIDTH) (if (AND (< BOTTOM CURY) (EQ *PRINT-PRETTY-BITMAPS* (QUOTE PRETTYFILEINDEX)) *PFI-FUNNY-CHARS*) then (* ; "Don't move the baseline down, just remember it for when we hit end of line") (if (OR (NULL *PFI-BITMAP-BASELINE*) (< BOTTOM *PFI-BITMAP-BASELINE*)) then (* ; "Lower than before, or first time") (SETQ *PFI-BITMAP-BASELINE* BOTTOM) (if (NEQ (fetch (STREAM OUTCHARFN) of STREAM) (FUNCTION PFI.OUTCHARFN)) then (* ; "Also have to %"advise%" the outcharfn to notice terpri") (replace (STREAM OUTCHARFN) of STREAM with (FUNCTION PFI.OUTCHARFN)))) CURY else (* ; "Move baseline down to bitmap baseline") BOTTOM) STREAM) (RETURN T)) else (LET ((POS (AND (EQ *PRINT-PRETTY-BITMAPS* (QUOTE PRETTYFILEINDEX)) (PNAMESTREAMP STREAM) (STKPOS (QUOTE STRINGWIDTH)))) IMSTREAM) (if (AND POS (IMAGESTREAMP (SETQ IMSTREAM (STKEVAL POS (QUOTE *STANDARD-OUTPUT*) T)))) then (* ;; "Big kludge: This is somebody in the prettyprinter trying to figure out the width of the bitmap--fake them out by printing something about the width of the bitmap. IMSTREAM is the stream to which the real output will go. To be conservative, only do this under PRETTYFILEINDEX.") (RPTQ (CL:CEILING (TIMES (DSPSCALE NIL IMSTREAM) (BITMAPWIDTH BM)) (CHARWIDTH (CHARCODE X) IMSTREAM)) (\OUTCHAR STREAM (CHARCODE X))) T else (NON.PFI.PRINT.BITMAP BM STREAM)))))
)
[LAMBDA (BM STREAM)
(* ;;
 "Edited 3-Jul-2022 15:28 by rmk: Use vertical size in RATIO only if bottom and top margins exists")
(* ;; "Edited 3-Jul-2022 15:24 by rmk")
(* ;; "Edited 14-Apr-88 12:44 by bvm")
(* ;;
 "DEFPRINT function for bitmaps that displays the actual bitmap when going to an image stream.")
(if (OR (NULL *PRINT-ARRAY*)
(NULL *PRINT-PRETTY-BITMAPS*))
then (* ; "do the clunky way")
(NON.PFI.PRINT.BITMAP BM STREAM)
elseif (IMAGESTREAMP STREAM)
then (PROG ((CURX (DSPXPOSITION NIL STREAM))
(CURY (DSPYPOSITION NIL STREAM))
(UNITS (DSPSCALE NIL STREAM))
(LINEHEIGHT (DSPLINEFEED NIL STREAM))
HEIGHT WIDTH MINX NLINESDOWN BOTTOM BMARG BELOWBASELINE SCALE RATIO)
(if (NOT (AND CURX CURY UNITS LINEHEIGHT))
then (* ; "Stream doesn't really support it")
(RETURN (NON.PFI.PRINT.BITMAP BM STREAM)))
(SETQ HEIGHT (TIMES UNITS (BITMAPHEIGHT BM)))
(SETQ WIDTH (TIMES UNITS (BITMAPWIDTH BM)))
(SETQ BMARG (DSPBOTTOMMARGIN NIL STREAM))
[if (AND (NOT (DISPLAYSTREAMP STREAM))
(< (SETQ RATIO (MIN (FQUOTIENT (- (DSPRIGHTMARGIN NIL STREAM)
(DSPLEFTMARGIN NIL STREAM))
(TIMES WIDTH 1.5))
(CL:IF (AND BMARG (DSPTOPMARGIN NIL STREAM))
(FQUOTIENT (- (DSPTOPMARGIN NIL STREAM)
BMARG)
(TIMES HEIGHT 1.5))
MAX.SMALLP)))
1.0))
then (* ;
 "It takes up more than 2/3 the page in some dimension. This code is tuned for Interpress.")
(SETQ SCALE (if (> RATIO 0.75)
then 0.75
elseif (> RATIO 0.5)
then 0.5
elseif (> RATIO 0.25)
then 0.25
else RATIO))
(SETQ HEIGHT (FIXR (TIMES SCALE HEIGHT)))
(SETQ WIDTH (FIXR (TIMES SCALE WIDTH]
(if (> CURX (SETQ MINX (- (DSPRIGHTMARGIN NIL STREAM)
WIDTH)))
then (* ;
 "Won't fit between here and margin, so start nwe line")
(TERPRI STREAM)
(SETQ CURX (MAX MINX 0))
(SETQ CURY (DSPYPOSITION NIL STREAM)))
[SETQ BELOWBASELINE (MAX 0 (- HEIGHT (FONTPROP STREAM 'ASCENT]
[if BMARG
then (* ;
 "We know stream's bottom margin, so can be reasonable")
(if (< (- CURY BELOWBASELINE)
BMARG)
then (* ; "Won't fit on page")
(DSPNEWPAGE STREAM)
(SETQ CURY (DSPYPOSITION NIL STREAM))
(SETQ *PFI-BITMAP-BASELINE* NIL))
else (* ; "Have to use silly terpri method")
[SETQ NLINESDOWN (IQUOTIENT HEIGHT (SETQ LINEHEIGHT (- LINEHEIGHT]
(to NLINESDOWN do (* ;
 "Do enough cr's so that we have space for bitmap. This might cause scrolling, for example")
(TERPRI STREAM) finally
(* ;
 "If this was display, terpri may have scrolled, and Y changed out from under us")
(SETQ CURY (+ (DSPYPOSITION NIL
STREAM)
(TIMES NLINESDOWN
LINEHEIGHT]
(SETQ BOTTOM (- CURY BELOWBASELINE)) (* ;
 "BOTTOM computed so that bitmap top lines up with font top")
(SCALEDBITBLT BM 0 0 STREAM CURX BOTTOM WIDTH HEIGHT 'INPUT 'REPLACE NIL NIL SCALE
)
(MOVETO (+ CURX WIDTH)
(if (AND (< BOTTOM CURY)
(EQ *PRINT-PRETTY-BITMAPS* 'PRETTYFILEINDEX)
*PFI-FUNNY-CHARS*)
then (* ;
 "Don't move the baseline down, just remember it for when we hit end of line")
[if (OR (NULL *PFI-BITMAP-BASELINE*)
(< BOTTOM *PFI-BITMAP-BASELINE*))
then (* ; "Lower than before, or first time")
(SETQ *PFI-BITMAP-BASELINE* BOTTOM)
(if (NEQ (fetch (STREAM OUTCHARFN) of STREAM)
(FUNCTION PFI.OUTCHARFN))
then (* ;
 "Also have to %"advise%" the outcharfn to notice terpri")
(replace (STREAM OUTCHARFN) of STREAM
with (FUNCTION PFI.OUTCHARFN]
CURY
else (* ;
 "Move baseline down to bitmap baseline")
BOTTOM)
STREAM)
(RETURN T))
else (LET ([POS (AND (EQ *PRINT-PRETTY-BITMAPS* 'PRETTYFILEINDEX)
(PNAMESTREAMP STREAM)
(STKPOS 'STRINGWIDTH]
IMSTREAM)
(if [AND POS (IMAGESTREAMP (SETQ IMSTREAM (STKEVAL POS '*STANDARD-OUTPUT* T]
then
(* ;; "Big kludge: This is somebody in the prettyprinter trying to figure out the width of the bitmap--fake them out by printing something about the width of the bitmap. IMSTREAM is the stream to which the real output will go. To be conservative, only do this under PRETTYFILEINDEX.")
(RPTQ (CL:CEILING (TIMES (DSPSCALE NIL IMSTREAM)
(BITMAPWIDTH BM))
(CHARWIDTH (CHARCODE X)
IMSTREAM))
(\OUTCHAR STREAM (CHARCODE X)))
T
else (NON.PFI.PRINT.BITMAP BM STREAM])
)
(RPAQ? *PRINT-PRETTY-BITMAPS* T)
@@ -1071,28 +1186,28 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
)
(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10203 12438 (PFI.NEW.LISTFILES1 10213 . 10707) (PFI.ENQUEUE 10709 . 11333) (
\PFI.DO.HARDCOPY 11335 . 11921) (MAYBE.PRETTYFILEINDEX 11923 . 12436)) (12439 34954 (PRETTYFILEINDEX
12449 . 26482) (PFI.MAKE.LPT.STREAM 26484 . 29535) (PFI.SETUP.TRANSLATIONS 29537 . 31051) (
PFI.OUTCHARFN 31053 . 33027) (PFI.COLLECT.DEFINERS 33029 . 33841) (PFI.AFTER.NEW.PAGE 33843 . 34952))
(34955 40868 (PFI.PRINT.FILECREATED 34965 . 39055) (PFI.PRINT.TO.TAB 39057 . 39502) (
PFI.PRINT.ENVIRONMENT 39504 . 40866)) (40869 48384 (PFI.PROCESS.FILE 40879 . 42109) (PFI.PASS.COMMENT
42111 . 43081) (PFI.HANDLE.EXPR 43083 . 43750) (PFI.DEFAULT.HANDLER 43752 . 45805) (PFI.PRETTYPRINT
45807 . 46142) (PFI.LINES.REMAINING 46144 . 46471) (PFI.MAYBE.NEW.PAGE 46473 . 47307) (
PFI.ESTIMATE.SIZE 47309 . 47840) (PFI.ESTIMATE.SIZE1 47842 . 48382)) (48421 58630 (PFI.HANDLE.RPAQQ
48431 . 49839) (PFI.HANDLE.DECLARE 49841 . 50780) (PFI.HANDLE.EVAL-WHEN 50782 . 51265) (
PFI.HANDLE.DEFDEFINER 51267 . 52557) (PFI.HANDLE.DEFINEQ 52559 . 52803) (PFI.PRINT.LAMBDA 52805 .
53143) (PFI.PRINT.LAMBDA.BODY 53145 . 53480) (PFI.HANDLE.PUTDEF 53482 . 53979) (PFI.HANDLE.PUTPROPS
53981 . 54596) (PFI.HANDLE./DECLAREDATATYPE 54598 . 55145) (PFI.HANDLE.* 55147 . 56409) (
PFI.PRINT.COMMENTS 56411 . 58033) (PFI.HANDLE.FILEMAP 58035 . 58323) (PFI.HANDLE.PACKAGE 58325 . 58628
)) (58658 59650 (PFI.PREVIEW.DECLARE 58668 . 59330) (PFI.PREVIEW.DEFINEQ 59332 . 59648)) (59686 70674
(PFI.PRINT.INDEX 59696 . 60547) (PFI.CONDENSE.INDEX 60549 . 62356) (PFI.SORT.INDICES 62358 . 63497) (
PFI.COMPUTE.INDEX.SHAPE 63499 . 64963) (PFI.PRINT.INDICES 64965 . 69507) (PFI.CENTER.PRINT 69509 .
70079) (PFI.INDEX.BREAK 70081 . 70539) (PFI.LOOKUP.NAME 70541 . 70672)) (70675 71906 (PFI.ADD.TO.INDEX
70685 . 71195) (PFI.VARNAME 71197 . 71607) (PFI.CONSTANTNAMES 71609 . 71904)) (71941 80254 (
MULTIFILEINDEX 71951 . 72747) (MULTIFILEINDEX1 72749 . 74205) (PFI.PRINT.MULTI.INDEX 74207 . 79310) (
PFI.CHOOSE.BEST 79312 . 79539) (PFI.MERGE.INDICES 79541 . 80252)) (80311 83380 (PFI.MAYBE.SEE.PRETTY
80321 . 82104) (PFI.MAYBE.PP.DEFINITION 82106 . 83378)) (83450 87285 (PFI.PRINT.BITMAP 83460 . 87283))
(90054 93168 (PUTPROPS.PRETTYPRINT 90064 . 91475) (RPAQX.PRETTYPRINT 91477 . 92202) (
COURIERPROGRAM.PRETTYPRINT 92204 . 92904) (MAYBE.PRETTYPRINT.BOLD 92906 . 93166)))))
(FILEMAP (NIL (10069 12304 (PFI.NEW.LISTFILES1 10079 . 10573) (PFI.ENQUEUE 10575 . 11199) (
\PFI.DO.HARDCOPY 11201 . 11787) (MAYBE.PRETTYFILEINDEX 11789 . 12302)) (12305 34820 (PRETTYFILEINDEX
12315 . 26348) (PFI.MAKE.LPT.STREAM 26350 . 29401) (PFI.SETUP.TRANSLATIONS 29403 . 30917) (
PFI.OUTCHARFN 30919 . 32893) (PFI.COLLECT.DEFINERS 32895 . 33707) (PFI.AFTER.NEW.PAGE 33709 . 34818))
(34821 40734 (PFI.PRINT.FILECREATED 34831 . 38921) (PFI.PRINT.TO.TAB 38923 . 39368) (
PFI.PRINT.ENVIRONMENT 39370 . 40732)) (40735 48250 (PFI.PROCESS.FILE 40745 . 41975) (PFI.PASS.COMMENT
41977 . 42947) (PFI.HANDLE.EXPR 42949 . 43616) (PFI.DEFAULT.HANDLER 43618 . 45671) (PFI.PRETTYPRINT
45673 . 46008) (PFI.LINES.REMAINING 46010 . 46337) (PFI.MAYBE.NEW.PAGE 46339 . 47173) (
PFI.ESTIMATE.SIZE 47175 . 47706) (PFI.ESTIMATE.SIZE1 47708 . 48248)) (48287 58496 (PFI.HANDLE.RPAQQ
48297 . 49705) (PFI.HANDLE.DECLARE 49707 . 50646) (PFI.HANDLE.EVAL-WHEN 50648 . 51131) (
PFI.HANDLE.DEFDEFINER 51133 . 52423) (PFI.HANDLE.DEFINEQ 52425 . 52669) (PFI.PRINT.LAMBDA 52671 .
53009) (PFI.PRINT.LAMBDA.BODY 53011 . 53346) (PFI.HANDLE.PUTDEF 53348 . 53845) (PFI.HANDLE.PUTPROPS
53847 . 54462) (PFI.HANDLE./DECLAREDATATYPE 54464 . 55011) (PFI.HANDLE.* 55013 . 56275) (
PFI.PRINT.COMMENTS 56277 . 57899) (PFI.HANDLE.FILEMAP 57901 . 58189) (PFI.HANDLE.PACKAGE 58191 . 58494
)) (58524 59516 (PFI.PREVIEW.DECLARE 58534 . 59196) (PFI.PREVIEW.DEFINEQ 59198 . 59514)) (59552 70540
(PFI.PRINT.INDEX 59562 . 60413) (PFI.CONDENSE.INDEX 60415 . 62222) (PFI.SORT.INDICES 62224 . 63363) (
PFI.COMPUTE.INDEX.SHAPE 63365 . 64829) (PFI.PRINT.INDICES 64831 . 69373) (PFI.CENTER.PRINT 69375 .
69945) (PFI.INDEX.BREAK 69947 . 70405) (PFI.LOOKUP.NAME 70407 . 70538)) (70541 71772 (PFI.ADD.TO.INDEX
70551 . 71061) (PFI.VARNAME 71063 . 71473) (PFI.CONSTANTNAMES 71475 . 71770)) (71807 80120 (
MULTIFILEINDEX 71817 . 72613) (MULTIFILEINDEX1 72615 . 74071) (PFI.PRINT.MULTI.INDEX 74073 . 79176) (
PFI.CHOOSE.BEST 79178 . 79405) (PFI.MERGE.INDICES 79407 . 80118)) (80177 83246 (PFI.MAYBE.SEE.PRETTY
80187 . 81970) (PFI.MAYBE.PP.DEFINITION 81972 . 83244)) (83316 91426 (PFI.PRINT.BITMAP 83326 . 91424))
(94195 97309 (PUTPROPS.PRETTYPRINT 94205 . 95616) (RPAQX.PRETTYPRINT 95618 . 96343) (
COURIERPROGRAM.PRETTYPRINT 96345 . 97045) (MAYBE.PRETTYPRINT.BOLD 97047 . 97307)))))
STOP

BIN
lispusers/PRETTYFILEINDEX.LCOM
View File

Binary file not shown.