github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-17 00:52:40 +00:00
Code Issues Projects Releases Wiki Activity

WINDOW: fix menus for new hardcopy architecture

Browse Source
This commit is contained in:
rmkaplan 2025-12-28 21:34:47 -08:00
parent 1632df7d2b
commit 1d2b8bf264
2 changed files with 109 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

193
sources/WINDOW
View File

@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Sep-2025 10:51:13" {WMEDLEY}<sources>WINDOW.;22 221778
(FILECREATED "24-Dec-2025 00:03:15" {WMEDLEY}<sources>WINDOW.;24 223729
:EDIT-BY rmk
:CHANGES-TO (FNS WFROMDS)
:CHANGES-TO (VARS WINDOWCOMS)
(FNS DOWINDOWCOM)
:PREVIOUS-DATE "29-Jun-2024 00:18:05" {WMEDLEY}<sources>WINDOW.;21)
:PREVIOUS-DATE "19-Sep-2025 10:51:13" {WMEDLEY}<sources>WINDOW.;22)
(PRETTYCOMPRINT WINDOWCOMS)
@ -146,11 +147,15 @@ used to draw pictures or make notes on windows.")
(Clear 'CLEARW "Clears a window to its gray.")
(Bury 'BURYW "Puts a window on the bottom.")
(Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.")
(Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE
(Hardcopy '(SEND.FILE.TO.PRINTER WINDOW :DEFAULTPRINTER)
"Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE WINDOW (GetImageFile)
NIL
'(NOERROR T))
"Puts image on a file; prompts for filename and format"
)
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
("To a printer" '(SEND.FILE.TO.PRINTER WINDOW (GetPrinterName))
"Sends image to a printer of your choosing")))
(Move 'MOVEW "Moves a window by a corner.")
(Shape 'SHAPEW "Gets a new region for a window.
@ -163,13 +168,19 @@ Middle button down moves closest corner.")
"Updates the virtual memory.")
(Snap '(SNAPW)
"Saves a snapshot of a region of the screen.")
(Hardcopy '(HARDCOPYW)
(Hardcopy '(SEND.FILE.TO.PRINTER (GETREGION)
:DEFAULTPRINTER)
"Send hardcopy of screen region to printer."
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
(SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE (GETREGION)
(GetImageFile)
NIL
'(NOERROR T))
"Writes a region of screen to a file; prompts for filename and format"
)
("To a printer" '(HARDCOPYREGION.TOPRINTER)
("To a printer" '(SEND.FILE.TO.PRINTER (GETREGION)
(GetPrinterName)
`(NOERROR T))
"Sends a region of screen to a printer of your choosing"]
(ADDVARS (WINDOWUSERFORMS)
(ENDOFWINDOWUSERFORMS))
@ -675,41 +686,46 @@ Middle button down moves closest corner.")
(ERSETQ (APPLY* FN WINDOW])
(DOWINDOWCOM
[LAMBDA ARGS (* ; "Edited 25-Nov-86 17:30 by hdj")
[LAMBDA ARGS (* ; "Edited 23-Dec-2025 22:26 by rmk")
(* ; "Edited 25-Nov-86 17:30 by hdj")
(* ;; "the button handler for the window system. if no arg, just return.")
(if (NEQ ARGS 0)
then
(LET ((WINDOW (ARG ARGS 1)))
(COND
[(type? WINDOW WINDOW)
(PROG ($$VAR)
(COND
((SETQ $$VAR (WINDOWPROP WINDOW 'DOWINDOWCOMFN))
(RETURN (APPLY* $$VAR WINDOW)))
(T (\CHECKCARET WINDOW)
(TOTOPW WINDOW)
(RETURN (COND
([SETQ $$VAR
(MENU (COND
((type? MENU WindowMenu)
WindowMenu)
(T (SETQ WindowMenu
(create MENU
ITEMS _ WindowMenuCommands
CHANGEOFFSETFLG _ 'Y
MENUOFFSET _
(create POSITION
XCOORD _ -1
YCOORD _ 0)
WHENHELDFN _ (FUNCTION PPROMPT3)
WHENUNHELDFN _ (FUNCTION CLRPROMPT)
CENTERFLG _ T]
(APPLY* $$VAR WINDOW)
T]
((NULL WINDOW)
(DOBACKGROUNDCOM])
then (LET ((WINDOW (ARG ARGS 1)))
(DECLARE (SPECVARS WINDOW))
(COND
[(type? WINDOW WINDOW)
(PROG ($$VAR)
(COND
((SETQ $$VAR (WINDOWPROP WINDOW 'DOWINDOWCOMFN))
(RETURN (APPLY* $$VAR WINDOW)))
(T (\CHECKCARET WINDOW)
(TOTOPW WINDOW)
(RETURN (COND
([SETQ $$VAR
(MENU (COND
((type? MENU WindowMenu)
WindowMenu)
(T (SETQ WindowMenu
(create MENU
ITEMS _ WindowMenuCommands
CHANGEOFFSETFLG _ 'Y
MENUOFFSET _
(create POSITION
XCOORD _ -1
YCOORD _ 0)
WHENHELDFN _
(FUNCTION PPROMPT3)
WHENUNHELDFN _
(FUNCTION CLRPROMPT)
CENTERFLG _ T]
(CL:IF (LISTP $$VAR)
(EVAL $$VAR)
(APPLY* $$VAR WINDOW))
T]
((NULL WINDOW)
(DOBACKGROUNDCOM])
(DOBACKGROUNDCOM
[LAMBDA NIL (* ; "Edited 10-Mar-92 15:48 by jds")
@ -3945,10 +3961,13 @@ used to draw pictures or make notes on windows.")
(Clear 'CLEARW "Clears a window to its gray.")
(Bury 'BURYW "Puts a window on the bottom.")
(Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.")
(Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE
(Hardcopy '(SEND.FILE.TO.PRINTER WINDOW :DEFAULTPRINTER)
"Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE WINDOW (GetImageFile)
NIL
'(NOERROR T))
"Puts image on a file; prompts for filename and format")
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
("To a printer" '(SEND.FILE.TO.PRINTER WINDOW (GetPrinterName))
"Sends image to a printer of your choosing")))
(Move 'MOVEW "Moves a window by a corner.")
(Shape 'SHAPEW "Gets a new region for a window.
@ -3962,13 +3981,19 @@ Middle button down moves closest corner.")
"Updates the virtual memory.")
(Snap '(SNAPW)
"Saves a snapshot of a region of the screen.")
(Hardcopy '(HARDCOPYW)
(Hardcopy '(SEND.FILE.TO.PRINTER (GETREGION)
:DEFAULTPRINTER)
"Send hardcopy of screen region to printer."
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
(SUBITEMS ("To a file" '(CONVERT.TO.IMAGEFILE (GETREGION)
(GetImageFile)
NIL
'(NOERROR T))
"Writes a region of screen to a file; prompts for filename and format"
)
("To a printer" '(HARDCOPYREGION.TOPRINTER)
("To a printer" '(SEND.FILE.TO.PRINTER (GETREGION)
(GetPrinterName)
`(NOERROR T))
"Sends a region of screen to a printer of your choosing"))))
(ADDTOVAR WINDOWUSERFORMS )
@ -4004,42 +4029,42 @@ Middle button down moves closest corner.")
(ADDTOVAR LAMA PROMPTPRINT WINDOWPROP DOWINDOWCOM)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11403 26043 (WINDOWWORLD 11413 . 15166) (WINDOWWORLDP 15168 . 15468) (CHANGEBACKGROUND
15470 . 16507) (CHANGEBACKGROUNDBORDER 16509 . 17060) (TILE 17062 . 17654) (
\TTY.CREATING.DISPLAYSTREAM 17656 . 18203) (\CREATE.TTY.OUTCHARFN 18205 . 18505) (
\CREATE.TTYDISPLAYSTREAM 18507 . 21546) (HASTTYWINDOWP 21548 . 21828) (TTYINFOSTREAM 21830 . 22354) (
CREATESCREEN 22356 . 25299) (\INSURESCREEN 25301 . 25550) (\BITMAPTOSCREEN 25552 . 25913) (MAINSCREEN
25915 . 26041)) (26690 43973 (WINDOW.MOUSE.HANDLER 26700 . 39495) (\PROTECTED.APPLY 39497 . 39745) (
DOWINDOWCOM 39747 . 41767) (DOBACKGROUNDCOM 41769 . 42927) (DEFAULT.BACKGROUND.COPYFN 42929 . 43971))
(44054 75937 (BURYW 44064 . 44352) (CLEARW 44354 . 44744) (CLOSEW 44746 . 45520) (\CLOSEW1 45522 .
45875) (\OKTOCLOSEW 45877 . 46236) (\INTERACTIVE.CLOSEW 46238 . 47061) (OPENW 47063 . 48118) (
DOUSERFNS 48120 . 49281) (DOUSERFNS2 49283 . 49779) (\USERFNISDON'T 49781 . 50052) (\OPENW1 50054 .
50404) (CREATEW 50406 . 51670) (CREATEW1 51672 . 53950) (\CREATEW1 53952 . 55171) (OPENDISPLAYSTREAM
55173 . 55496) (MOVEW 55498 . 55713) (PPROMPT3 55715 . 56043) (\ONSCREENCLIPPINGREGION 56045 . 56596)
(RELMOVEW 56598 . 56896) (SHAPEW 56898 . 61817) (SHAPEW1 61819 . 64521) (\SHAPEW2 64523 . 67209) (
RESHOWBORDER 67211 . 67722) (\RESHOWBORDER1 67724 . 72650) (TRACKW 72652 . 73767) (SNAPW 73769 . 75442
) (WINDOWREGION 75444 . 75935)) (75938 76634 (MINIMUMWINDOWSIZE 75948 . 76632)) (78281 101546 (
ADVISEWDS 78291 . 86234) (SHOWWFRAME 86236 . 87988) (SHOWWTITLE 87990 . 92024) (\STRINGWIDTHGUESS
92026 . 92385) (RESHOWTITLE 92387 . 97028) (TOTOPW 97030 . 97269) (\INTERNALTOTOPW 97271 . 98361) (
\TTW1 98363 . 100963) (WHICHW 100965 . 101544)) (101675 104771 (WFROMDS 101685 . 103941) (NU\TOTOPWDS
103943 . 104379) (\COERCETODS 104381 . 104769)) (105414 112214 (WINDOWP 105424 . 105570) (
INSURE.WINDOW 105572 . 105911) (WINDOWPROP 105913 . 106345) (WINDOWADDPROP 106347 . 108081) (
WINDOWDELPROP 108083 . 108509) (GETWINDOWPROP 108511 . 109061) (GETWINDOWUSERPROP 109063 . 109490) (
PUTWINDOWPROP 109492 . 109957) (REMWINDOWPROP 109959 . 111014) (WINDOWADDFNPROP 111016 . 112212)) (
112418 119982 (CWINDOWPROP 112428 . 113433) (CGETWINDOWPROP 113435 . 118653) (\GETWINDOWHEIGHT 118655
. 119563) (\GETWINDOWWIDTH 119565 . 119980)) (119983 120642 (WINDOW.BITMAP 119993 . 120640)) (120668
136116 (OPENWP 120678 . 120956) (TOPWP 120958 . 121241) (RESHAPEBYREPAINTFN 121243 . 131495) (
\INBETWEENP 131497 . 131713) (DECODE/WINDOW/OR/DISPLAYSTREAM 131715 . 133755) (GROW/REGION 133757 .
134320) (CLRPROMPT 134322 . 134726) (PROMPTPRINT 134728 . 134992) (OPENWINDOWS 134994 . 135778) (
\INSUREWINDOW 135780 . 136114)) (136247 139496 (OVERLAPPINGWINDOWS 136257 . 138539) (WOVERLAPP 138541
. 138796) (ORDERFROMBOTTOMTOTOP 138798 . 139494)) (139545 144328 (\ONSCREENW 139555 . 140261) (
\PUTONSCREENW 140263 . 141090) (\UPDATECACHEDFIELDS 141092 . 141356) (\WWCHANGESCREENSIZE 141358 .
142747) (CREATEWFROMIMAGE 142749 . 143712) (UPDATEWFROMIMAGE 143714 . 144326)) (144885 197487 (
\MEDW.CREATEW 144895 . 149569) (\MEDW.OPENW 149571 . 151929) (\MEDW.CLOSEW 151931 . 153297) (
\MEDW.MOVEW 153299 . 163911) (\MEDW.RELMOVEW 163913 . 164292) (\MEDW.SHRINKW 164294 . 172478) (
\MEDW.EXPANDW 172480 . 174747) (\MEDW.SHAPEW 174749 . 179355) (\MEDW.REDISPLAYW 179357 . 181312) (
\MEDW.BURYW 181314 . 182596) (\MEDW.TOTOPW 182598 . 183946) (\MEDW.DSPCREATE 183948 . 184749) (
\GENERIC.DSPCREATE 184751 . 186468) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186470 . 186656) (
\MEDW.GETWINDOWPROP 186658 . 188896) (\MEDW.PUTWINDOWPROP 188898 . 195683) (\MEDW.CURSOR 195685 .
197485)) (197488 198108 (\GENERIC.CURSOR 197498 . 198106)))))
(FILEMAP (NIL (12198 26838 (WINDOWWORLD 12208 . 15961) (WINDOWWORLDP 15963 . 16263) (CHANGEBACKGROUND
16265 . 17302) (CHANGEBACKGROUNDBORDER 17304 . 17855) (TILE 17857 . 18449) (
\TTY.CREATING.DISPLAYSTREAM 18451 . 18998) (\CREATE.TTY.OUTCHARFN 19000 . 19300) (
\CREATE.TTYDISPLAYSTREAM 19302 . 22341) (HASTTYWINDOWP 22343 . 22623) (TTYINFOSTREAM 22625 . 23149) (
CREATESCREEN 23151 . 26094) (\INSURESCREEN 26096 . 26345) (\BITMAPTOSCREEN 26347 . 26708) (MAINSCREEN
26710 . 26836)) (27485 45332 (WINDOW.MOUSE.HANDLER 27495 . 40290) (\PROTECTED.APPLY 40292 . 40540) (
DOWINDOWCOM 40542 . 43126) (DOBACKGROUNDCOM 43128 . 44286) (DEFAULT.BACKGROUND.COPYFN 44288 . 45330))
(45413 77296 (BURYW 45423 . 45711) (CLEARW 45713 . 46103) (CLOSEW 46105 . 46879) (\CLOSEW1 46881 .
47234) (\OKTOCLOSEW 47236 . 47595) (\INTERACTIVE.CLOSEW 47597 . 48420) (OPENW 48422 . 49477) (
DOUSERFNS 49479 . 50640) (DOUSERFNS2 50642 . 51138) (\USERFNISDON'T 51140 . 51411) (\OPENW1 51413 .
51763) (CREATEW 51765 . 53029) (CREATEW1 53031 . 55309) (\CREATEW1 55311 . 56530) (OPENDISPLAYSTREAM
56532 . 56855) (MOVEW 56857 . 57072) (PPROMPT3 57074 . 57402) (\ONSCREENCLIPPINGREGION 57404 . 57955)
(RELMOVEW 57957 . 58255) (SHAPEW 58257 . 63176) (SHAPEW1 63178 . 65880) (\SHAPEW2 65882 . 68568) (
RESHOWBORDER 68570 . 69081) (\RESHOWBORDER1 69083 . 74009) (TRACKW 74011 . 75126) (SNAPW 75128 . 76801
) (WINDOWREGION 76803 . 77294)) (77297 77993 (MINIMUMWINDOWSIZE 77307 . 77991)) (79640 102905 (
ADVISEWDS 79650 . 87593) (SHOWWFRAME 87595 . 89347) (SHOWWTITLE 89349 . 93383) (\STRINGWIDTHGUESS
93385 . 93744) (RESHOWTITLE 93746 . 98387) (TOTOPW 98389 . 98628) (\INTERNALTOTOPW 98630 . 99720) (
\TTW1 99722 . 102322) (WHICHW 102324 . 102903)) (103034 106130 (WFROMDS 103044 . 105300) (NU\TOTOPWDS
105302 . 105738) (\COERCETODS 105740 . 106128)) (106773 113573 (WINDOWP 106783 . 106929) (
INSURE.WINDOW 106931 . 107270) (WINDOWPROP 107272 . 107704) (WINDOWADDPROP 107706 . 109440) (
WINDOWDELPROP 109442 . 109868) (GETWINDOWPROP 109870 . 110420) (GETWINDOWUSERPROP 110422 . 110849) (
PUTWINDOWPROP 110851 . 111316) (REMWINDOWPROP 111318 . 112373) (WINDOWADDFNPROP 112375 . 113571)) (
113777 121341 (CWINDOWPROP 113787 . 114792) (CGETWINDOWPROP 114794 . 120012) (\GETWINDOWHEIGHT 120014
. 120922) (\GETWINDOWWIDTH 120924 . 121339)) (121342 122001 (WINDOW.BITMAP 121352 . 121999)) (122027
137475 (OPENWP 122037 . 122315) (TOPWP 122317 . 122600) (RESHAPEBYREPAINTFN 122602 . 132854) (
\INBETWEENP 132856 . 133072) (DECODE/WINDOW/OR/DISPLAYSTREAM 133074 . 135114) (GROW/REGION 135116 .
135679) (CLRPROMPT 135681 . 136085) (PROMPTPRINT 136087 . 136351) (OPENWINDOWS 136353 . 137137) (
\INSUREWINDOW 137139 . 137473)) (137606 140855 (OVERLAPPINGWINDOWS 137616 . 139898) (WOVERLAPP 139900
. 140155) (ORDERFROMBOTTOMTOTOP 140157 . 140853)) (140904 145687 (\ONSCREENW 140914 . 141620) (
\PUTONSCREENW 141622 . 142449) (\UPDATECACHEDFIELDS 142451 . 142715) (\WWCHANGESCREENSIZE 142717 .
144106) (CREATEWFROMIMAGE 144108 . 145071) (UPDATEWFROMIMAGE 145073 . 145685)) (146244 198846 (
\MEDW.CREATEW 146254 . 150928) (\MEDW.OPENW 150930 . 153288) (\MEDW.CLOSEW 153290 . 154656) (
\MEDW.MOVEW 154658 . 165270) (\MEDW.RELMOVEW 165272 . 165651) (\MEDW.SHRINKW 165653 . 173837) (
\MEDW.EXPANDW 173839 . 176106) (\MEDW.SHAPEW 176108 . 180714) (\MEDW.REDISPLAYW 180716 . 182671) (
\MEDW.BURYW 182673 . 183955) (\MEDW.TOTOPW 183957 . 185305) (\MEDW.DSPCREATE 185307 . 186108) (
\GENERIC.DSPCREATE 186110 . 187827) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 187829 . 188015) (
\MEDW.GETWINDOWPROP 188017 . 190255) (\MEDW.PUTWINDOWPROP 190257 . 197042) (\MEDW.CURSOR 197044 .
198844)) (198847 199467 (\GENERIC.CURSOR 198857 . 199465)))))
STOP

BIN
sources/WINDOW.LCOM
View File

Binary file not shown.