github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-27 12:39:46 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into tweak-init2

Browse Source
This commit is contained in:
Frank Halasz
2023-04-19 17:54:43 -07:00
committed by GitHub
parent 0f49e248d3 c58ef4ee56
commit 6fae5c14e9
13 changed files with 596 additions and 503 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
internal/MAINTAIN.TXT Normal file
View File

@@ -0,0 +1,2 @@
MAINTAIN -- Network access to the PUP "Grapevine" server, which did
email, distribution lists. Written ~1985 mainly by Bill van Melle.

280
library/PRESS
View File

@@ -1,18 +1,21 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Feb-2021 22:18:06" {DSK}<home>larry>ilisp>medley>library>PRESS.;2 455434Q
changes to%: (VARS PRESSCOMS) (FILECREATED "10-Apr-2023 07:15:37" {DSK}<home>larry>il>medley>library>PRESS.;2 452576Q
previous date%: "20-Jan-93 14:25:20" {DSK}<home>larry>ilisp>medley>library>PRESS.;1) :EDIT-BY "lmm"
:CHANGES-TO (VARS PRESSCOMS)
:PREVIOUS-DATE " 5-Feb-2021 22:18:06" {DSK}<home>larry>il>medley>library>PRESS.;1)
(* ; " (* ; "
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venue & Xerox Corporation. All rights reserved. Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
") ")
(PRETTYCOMPRINT PRESSCOMS) (PRETTYCOMPRINT PRESSCOMS)
(RPAQQ PRESSCOMS (RPAQQ PRESSCOMS
[ [
(* ;;; "PRESS printing support module") (* ;;; "PRESS printing support module")
@@ -28,7 +31,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(* ;; "Bitmap printing support") (* ;; "Bitmap printing support")
(FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW WINDOW.BITMAP (FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW
\WRITEPRESSBITMAP) \WRITEPRESSBITMAP)
(* ;; "Basic PRESS data structure output functions") (* ;; "Basic PRESS data structure output functions")
@@ -101,7 +104,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
ROTATION TITLE))) ROTATION TITLE)))
((FULLPRESS RAVEN) ((FULLPRESS RAVEN)
(* ; (* ;
 "same as PRESS but can scale bitmaps")  "same as PRESS but can scale bitmaps")
(CANPRINT (PRESS)) (CANPRINT (PRESS))
(STATUS TRUE) (STATUS TRUE)
(PROPERTIES NILL) (PROPERTIES NILL)
@@ -718,19 +721,6 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(\WRITEPRESSBITMAP BITMAP NIL NIL PRSTREAM) (\WRITEPRESSBITMAP BITMAP NIL NIL PRSTREAM)
(RETURN (CLOSEF PRSTREAM]) (RETURN (CLOSEF PRSTREAM])
(WINDOW.BITMAP
[LAMBDA (W) (* ; "Edited 12-Jun-90 10:38 by mitani")
(* Returns all of the bitmap of the
 window)
(PROG [BM (REGION (WINDOWPROP W 'REGION]
(CLOSEW W)
(SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(BITBLT (WINDOWPROP W 'IMAGECOVERED)
NIL NIL BM)
(OPENW W)
(RETURN BM])
(\WRITEPRESSBITMAP (\WRITEPRESSBITMAP
[LAMBDA (BITMAP XPOS YPOS SCALEFACTOR CLIPPINGREGION PRSTREAM) [LAMBDA (BITMAP XPOS YPOS SCALEFACTOR CLIPPINGREGION PRSTREAM)
(* ; "Edited 12-Jun-90 10:39 by mitani") (* ; "Edited 12-Jun-90 10:39 by mitani")
@@ -2344,7 +2334,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(RPAQQ SPRUCEPAPERTOPSCANS 4096) (RPAQQ SPRUCEPAPERTOPSCANS 4096)
(RPAQ SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch) (RPAQ SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch)
ScansPerIn))) ScansPerIn)))
(RPAQ SPRUCEPAPERRIGHTMICAS (FIX (FTIMES 8.5 \MicasPerInch))) (RPAQ SPRUCEPAPERRIGHTMICAS (FIX (FTIMES 8.5 \MicasPerInch)))
@@ -2427,85 +2417,74 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop (DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop each
 each page.)  page.)
PRHEADINGFONT (* Font to print the heading in) PRHEADINGFONT (* Font to print the heading in)
PRXPOS (* Current X position) PRXPOS (* Current X position)
PRYPOS (* Current Y position) PRYPOS (* Current Y position)
PRFONT (* Current font) PRFONT (* Current font)
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD) PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
(* Page left margin) (* Page left margin)
(PRBOTTOM WORD) (* Page bottom margin) (PRBOTTOM WORD) (* Page bottom margin)
(PRRIGHT WORD) (* Page right margin) (PRRIGHT WORD) (* Page right margin)
(PRTOP WORD) (* Page top margin) (PRTOP WORD) (* Page top margin)
(PRPAGENUM WORD) (* Current Page number) (PRPAGENUM WORD) (* Current Page number)
(PRNEXTFONT# BYTE) (PRNEXTFONT# BYTE)
(PRMAXFONTSET BYTE) (PRMAXFONTSET BYTE)
(PRPARTSTART INTEGER) (PRPARTSTART INTEGER)
(DLSTARTBYTE INTEGER) (DLSTARTBYTE INTEGER)
(ELSTARTBYTE INTEGER) (ELSTARTBYTE INTEGER)
(STARTCHARBYTE INTEGER) (STARTCHARBYTE INTEGER)
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with (VECMOVINGRIGHT FLAG) (* If we're drawing a curve with
 vector fonts, are we moving to the  vector fonts, are we moving to the
 right?)  right?)
(VECWASDISPLAYING FLAG) (VECWASDISPLAYING FLAG)
(* Used during curve/line clipping to remember whether we were on-screen or (* Used during curve/line clipping to remember whether we were on-screen or not,
 not, so we know when to force a SETXY.)  so we know when to force a SETXY.)
VECSEGCHARS (* Cache for vector characters while VECSEGCHARS (* Cache for vector characters while
 we're moving to the left.)  we're moving to the left.)
VECCURX (* Current X position within vector VECCURX (* Current X position within vector
 code, in Dover spots)  code, in Dover spots)
VECCURY (* Current Y position with vector VECCURY (* Current Y position with vector
 code, in Dover spots)  code, in Dover spots)
PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG) PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
(* Says whether we have been (* Says whether we have been printing
 printing characters inside the  characters inside the clipping region)
 clipping region) PRClippingRegion
PRClippingRegion
(* The edges of the paper, as far as PRESS is concerned. (* The edges of the paper, as far as PRESS is concerned.
 Used to protect SPRUCE users who get killed when the image goes off-paper)  Used to protect SPRUCE users who get killed when the image goes off-paper)
) )
PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 (* We assume that the origin is
(* We assume that the origin is  translated to the bottom-left of the
 translated to the bottom-left of the  page region)
 page region) PRClippingRegion _ (create REGION
PRClippingRegion _ (create REGION LEFT _ SPRUCEPAPERLEFTMICAS
LEFT _ SPRUCEPAPERLEFTMICAS BOTTOM _ SPRUCEPAPERBOTTOMMICAS
BOTTOM _ SPRUCEPAPERBOTTOMMICAS WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS
WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS SPRUCEPAPERLEFTMICAS)
SPRUCEPAPERLEFTMICAS) HEIGHT _ 29210)
HEIGHT _ 29210) [ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of DATUM)
[ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of (fetch (PRESSDATA PRLEFT) of DATUM)))
DATUM) (PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
(fetch (PRESSDATA PRLEFT) of DATUM))) (fetch (PRESSDATA PRBOTTOM) of DATUM)))
(PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM) (PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
(fetch (PRESSDATA PRBOTTOM) of DATUM))) (PROGN (replace (PRESSDATA XPRPAGEREGION) of DATUM
(PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM) with NEWVALUE)
(PROGN (replace (PRESSDATA XPRPAGEREGION) of (replace (PRESSDATA PRLEFT) of DATUM
DATUM with (fetch (REGION LEFT) of NEWVALUE))
with NEWVALUE) (replace (PRESSDATA PRBOTTOM) of DATUM
(replace (PRESSDATA PRLEFT) of DATUM with (fetch (REGION BOTTOM) of NEWVALUE))
with (fetch (REGION LEFT) of (replace (PRESSDATA PRRIGHT) of DATUM
NEWVALUE with (IPLUS (fetch (REGION LEFT) of NEWVALUE)
)) (fetch (REGION WIDTH) of NEWVALUE)))
(replace (PRESSDATA PRBOTTOM) of DATUM (replace (PRESSDATA PRTOP) of DATUM
with (fetch (REGION BOTTOM) of with (IPLUS (fetch (REGION BOTTOM) of NEWVALUE)
NEWVALUE)) (fetch (REGION HEIGHT) of NEWVALUE])
(replace (PRESSDATA PRRIGHT) of DATUM
with (IPLUS (fetch (REGION LEFT)
of NEWVALUE)
(fetch (REGION WIDTH)
of NEWVALUE)))
(replace (PRESSDATA PRTOP) of DATUM
with (IPLUS (fetch (REGION BOTTOM)
of NEWVALUE)
(fetch (REGION HEIGHT)
of NEWVALUE])
(RECORD FONTDIRENTRY (DESCR FONT# FONTSET#)) (RECORD FONTDIRENTRY (DESCR FONT# FONTSET#))
) )
@@ -2596,7 +2575,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(RPAQ? DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 24765)) (RPAQ? DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 24765))
(RPAQ? PRESSBITMAPREGION (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch)) (RPAQ? PRESSBITMAPREGION (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch))
(TIMES 10 \MicasPerInch))) (TIMES 10 \MicasPerInch)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTPAGEREGION) (GLOBALVARS DEFAULTPAGEREGION)
@@ -2618,7 +2597,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(RPAQQ PRESSOPS (RPAQQ PRESSOPS
(SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode (SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode
ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode
SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode
@@ -2739,65 +2718,64 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
) )
(ADDTOVAR IMAGESTREAMTYPES (PRESS (OPENSTREAM OPENPRSTREAM) (ADDTOVAR IMAGESTREAMTYPES (PRESS (OPENSTREAM OPENPRSTREAM)
(FONTCREATE \CREATEPRESSFONT) (FONTCREATE \CREATEPRESSFONT)
(CREATECHARSET \CREATECHARSET.PRESS) (CREATECHARSET \CREATECHARSET.PRESS)
(FONTSAVAILABLE \SEARCHPRESSFONTS))) (FONTSAVAILABLE \SEARCHPRESSFONTS)))
(ADDTOVAR PRINTERTYPES (ADDTOVAR PRINTERTYPES ((PRESS SPRUCE PENGUIN DOVER)
((PRESS SPRUCE PENGUIN DOVER) (CANPRINT (PRESS))
(CANPRINT (PRESS)) (STATUS PUP.PRINTER.STATUS)
(STATUS PUP.PRINTER.STATUS) (PROPERTIES PUP.PRINTER.PROPERTIES)
(PROPERTIES PUP.PRINTER.PROPERTIES) (SEND EFTP)
(SEND EFTP) (BITMAPSCALE NIL)
(BITMAPSCALE NIL) (BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))) ((FULLPRESS RAVEN)
((FULLPRESS RAVEN)
(* ; (* ;
 "same as PRESS but can scale bitmaps")  "same as PRESS but can scale bitmaps")
(CANPRINT (PRESS)) (CANPRINT (PRESS))
(STATUS TRUE) (STATUS TRUE)
(PROPERTIES NILL) (PROPERTIES NILL)
(SEND EFTP) (SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE) (BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) (BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(ADDTOVAR PRINTFILETYPES (ADDTOVAR PRINTFILETYPES [PRESS (TEST PRESSFILEP)
[PRESS (TEST PRESSFILEP) (EXTENSION (PRESS))
(EXTENSION (PRESS)) (CONVERSION (TEXT MAKEPRESS TEDIT
(CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING) (LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM FILE)) (SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
NIL 'PRESS) NIL 'PRESS)
(CLOSEF? FILE) (CLOSEF? FILE)
PFILE]) PFILE])
(PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q (PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q
3711Q 3745Q)) 3711Q 3745Q))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (16032Q 73011Q (\SEARCHPRESSFONTS 16044Q . 20001Q) (\GETPRESSFONTNAMES 20003Q . 26641Q) (FILEMAP (NIL (15752Q 72731Q (\SEARCHPRESSFONTS 15764Q . 17721Q) (\GETPRESSFONTNAMES 17723Q . 26561Q)
(\PRESSFAMILYCODELST 26643Q . 30565Q) (\DECODEPRESSFACEBYTE 30567Q . 33356Q) (\CREATEPRESSFONT 33360Q (\PRESSFAMILYCODELST 26563Q . 30505Q) (\DECODEPRESSFACEBYTE 30507Q . 33276Q) (\CREATEPRESSFONT 33300Q
. 35625Q) (\CREATECHARSET.PRESS 35627Q . 73007Q)) (73446Q 130434Q (PRESSBITMAP 73460Q . 103062Q) ( . 35545Q) (\CREATECHARSET.PRESS 35547Q . 72727Q)) (73366Q 127171Q (PRESSBITMAP 73400Q . 103002Q) (
FULLPRESSBITMAP 103064Q . 111076Q) (SHOWREGION 111100Q . 112442Q) (SHOWPRESSBITMAPREGION 112444Q . FULLPRESSBITMAP 103004Q . 111016Q) (SHOWREGION 111020Q . 112362Q) (SHOWPRESSBITMAPREGION 112364Q .
113106Q) (PRESSWINDOW 113110Q . 117247Q) (WINDOW.BITMAP 117251Q . 120432Q) (\WRITEPRESSBITMAP 120434Q 113026Q) (PRESSWINDOW 113030Q . 117167Q) (\WRITEPRESSBITMAP 117171Q . 127167Q)) (127267Q 157142Q (
. 130432Q)) (130532Q 160405Q (\BCPLSOUT.PRESS 130544Q . 131521Q) (\PAGEPAD.PRESS 131523Q . 132760Q) ( \BCPLSOUT.PRESS 127301Q . 130256Q) (\PAGEPAD.PRESS 130260Q . 131515Q) (\ENTITYEND.PRESS 131517Q .
\ENTITYEND.PRESS 132762Q . 140256Q) (\PARTEND.PRESS 140260Q . 142645Q) (\ENTITYSTART.PRESS 142647Q . 137013Q) (\PARTEND.PRESS 137015Q . 141402Q) (\ENTITYSTART.PRESS 141404Q . 145015Q) (SETX.PRESS 145017Q
146260Q) (SETX.PRESS 146262Q . 150115Q) (SETXY.PRESS 150117Q . 153121Q) (SETY.PRESS 153123Q . 154523Q) . 146652Q) (SETXY.PRESS 146654Q . 151656Q) (SETY.PRESS 151660Q . 153260Q) (SHOW.PRESS 153262Q .
(SHOW.PRESS 154525Q . 160403Q)) (160467Q 275304Q (OPENPRSTREAM 160501Q . 165630Q) (\BITBLT.PRESS 157140Q)) (157224Q 274041Q (OPENPRSTREAM 157236Q . 164365Q) (\BITBLT.PRESS 164367Q . 167001Q) (
165632Q . 170244Q) (\BLTSHADE.PRESS 170246Q . 171701Q) (\SCALEDBITBLT.PRESS 171703Q . 174327Q) ( \BLTSHADE.PRESS 167003Q . 170436Q) (\SCALEDBITBLT.PRESS 170440Q . 173064Q) (\BITMAPSIZE.PRESS 173066Q
\BITMAPSIZE.PRESS 174331Q . 175271Q) (\CHARWIDTH.PRESS 175273Q . 177342Q) (\CLOSEF.PRESS 177344Q . . 174026Q) (\CHARWIDTH.PRESS 174030Q . 176077Q) (\CLOSEF.PRESS 176101Q . 206070Q) (\DRAWLINE.PRESS
207333Q) (\DRAWLINE.PRESS 207335Q . 210673Q) (\ENDPAGE.PRESS 210675Q . 212145Q) (NEWLINE.PRESS 212147Q 206072Q . 207430Q) (\ENDPAGE.PRESS 207432Q . 210702Q) (NEWLINE.PRESS 210704Q . 212315Q) (NEWPAGE.PRESS
. 213560Q) (NEWPAGE.PRESS 213562Q . 214054Q) (SETUPFONTS.PRESS 214056Q . 217607Q) (\DEFINEFONT.PRESS 212317Q . 212611Q) (SETUPFONTS.PRESS 212613Q . 216344Q) (\DEFINEFONT.PRESS 216346Q . 220470Q) (
217611Q . 221733Q) (\DSPBOTTOMMARGIN.PRESS 221735Q . 222531Q) (\DSPCLIPPINGREGION.PRESS 222533Q . \DSPBOTTOMMARGIN.PRESS 220472Q . 221266Q) (\DSPCLIPPINGREGION.PRESS 221270Q . 222662Q) (\DSPFONT.PRESS
224125Q) (\DSPFONT.PRESS 224127Q . 231121Q) (\DSPLEFTMARGIN.PRESS 231123Q . 232003Q) ( 222664Q . 227656Q) (\DSPLEFTMARGIN.PRESS 227660Q . 230540Q) (\DSPLINEFEED.PRESS 230542Q . 232052Q) (
\DSPLINEFEED.PRESS 232005Q . 233315Q) (\DSPRIGHTMARGIN.PRESS 233317Q . 234202Q) (\DSPSPACEFACTOR.PRESS \DSPRIGHTMARGIN.PRESS 232054Q . 232737Q) (\DSPSPACEFACTOR.PRESS 232741Q . 234345Q) (
234204Q . 235610Q) (\DSPTOPMARGIN.PRESS 235612Q . 236375Q) (\DSPXPOSITION.PRESS 236377Q . 237115Q) ( \DSPTOPMARGIN.PRESS 234347Q . 235132Q) (\DSPXPOSITION.PRESS 235134Q . 235652Q) (\DSPYPOSITION.PRESS
\DSPYPOSITION.PRESS 237117Q . 237635Q) (\FIXLINELENGTH.PRESS 237637Q . 241734Q) (\OUTCHARFN.PRESS 235654Q . 236372Q) (\FIXLINELENGTH.PRESS 236374Q . 240471Q) (\OUTCHARFN.PRESS 240473Q . 247527Q) (
241736Q . 250772Q) (\SETSPACE.PRESS 250774Q . 252270Q) (\STARTPAGE.PRESS 252272Q . 256633Q) ( \SETSPACE.PRESS 247531Q . 251025Q) (\STARTPAGE.PRESS 251027Q . 255370Q) (\STRINGWIDTH.PRESS 255372Q .
\STRINGWIDTH.PRESS 256635Q . 272213Q) (SHOWRECTANGLE.PRESS 272215Q . 272736Q) ( 270750Q) (SHOWRECTANGLE.PRESS 270752Q . 271473Q) (\PRESS.CONVERT.NSCHARACTER 271475Q . 274037Q)) (
\PRESS.CONVERT.NSCHARACTER 272740Q . 275302Q)) (275344Q 406406Q (\ENDVECRUN 275356Q . 305174Q) ( 274101Q 405143Q (\ENDVECRUN 274113Q . 303731Q) (\VECENCODE 303733Q . 304762Q) (\VECPUT 304764Q .
\VECENCODE 305176Q . 306225Q) (\VECPUT 306227Q . 315655Q) (\VECSKIP 315657Q . 316412Q) (\VECFONTINIT 314412Q) (\VECSKIP 314414Q . 315147Q) (\VECFONTINIT 315151Q . 322274Q) (\DRAWCIRCLE.PRESS 322276Q .
316414Q . 323537Q) (\DRAWCIRCLE.PRESS 323541Q . 326044Q) (\DRAWARC.PRESS 326046Q . 326637Q) ( 324601Q) (\DRAWARC.PRESS 324603Q . 325374Q) (\DRAWCURVE.PRESS 325376Q . 333334Q) (
\DRAWCURVE.PRESS 326641Q . 334577Q) (\DRAWCURVE.PRESS.LINE 334601Q . 343446Q) (\DRAWELLIPSE.PRESS \DRAWCURVE.PRESS.LINE 333336Q . 342203Q) (\DRAWELLIPSE.PRESS 342205Q . 345764Q) (\GETBRUSHFONT.PRESS
343450Q . 347227Q) (\GETBRUSHFONT.PRESS 347231Q . 351133Q) (\PRESSCURVE2 351135Q . 406404Q)) (412244Q 345766Q . 347670Q) (\PRESSCURVE2 347672Q . 405141Q)) (410775Q 415621Q (\PRESSINIT 411007Q . 415617Q))
417070Q (\PRESSINIT 412256Q . 417066Q)) (446754Q 452043Q (MAKEPRESS 446766Q . 447272Q) (PRESSFILEP (443570Q 446657Q (MAKEPRESS 443602Q . 444106Q) (PRESSFILEP 444110Q . 445665Q) (PRESS.BITMAPSCALE
447274Q . 451051Q) (PRESS.BITMAPSCALE 451053Q . 452041Q))))) 445667Q . 446655Q)))))
STOP STOP

BIN
library/PRESS.LCOM
View File

Binary file not shown.

15
library/SYSEDIT
View File

@@ -1,16 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jun-2022 18:22:01" {DSK}<home>larry>medley>library>SYSEDIT.;2 1373 (FILECREATED "17-Apr-2023 14:19:03" {DSK}<home>larry>il>medley>library>SYSEDIT.;2 1238
:EDIT-BY "lmm"
:CHANGES-TO (VARS SYSEDITCOMS) :CHANGES-TO (VARS SYSEDITCOMS)
:PREVIOUS-DATE "28-Sep-2021 10:16:44" {DSK}<home>larry>medley>library>SYSEDIT.;1) :PREVIOUS-DATE "25-Jun-2022 18:22:01" {DSK}<home>larry>il>medley>library>SYSEDIT.;1)
(* ; "
Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT SYSEDITCOMS) (PRETTYCOMPRINT SYSEDITCOMS)
(RPAQQ SYSEDITCOMS (RPAQQ SYSEDITCOMS
@@ -22,7 +20,7 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
(CLISPIFTRANFLG T) (CLISPIFTRANFLG T)
(CROSSCOMPILING 'ASK) (CROSSCOMPILING 'ASK)
(*REPLACE-OLD-EDIT-DATES* NIL) (*REPLACE-OLD-EDIT-DATES* NIL)
(COPYRIGHTFLG 'PRESERVE)) (COPYRIGHTFLG 'NEVER))
(P (RESETVARS ((CROSSCOMPILING T)) (P (RESETVARS ((CROSSCOMPILING T))
(FILESLOAD (SOURCE) (FILESLOAD (SOURCE)
EXPORTS.ALL]) EXPORTS.ALL])
@@ -43,12 +41,11 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
(RPAQQ *REPLACE-OLD-EDIT-DATES* NIL) (RPAQQ *REPLACE-OLD-EDIT-DATES* NIL)
(RPAQQ COPYRIGHTFLG PRESERVE) (RPAQQ COPYRIGHTFLG NEVER)
(RESETVARS ((CROSSCOMPILING T)) (RESETVARS ((CROSSCOMPILING T))
(FILESLOAD (SOURCE) (FILESLOAD (SOURCE)
EXPORTS.ALL)) EXPORTS.ALL))
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL))) (FILEMAP (NIL)))
STOP STOP

330
lispusers/WHO-LINE
View File

@@ -1,13 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Mar-2021 11:01:59" {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;4 74359
changes to%: (VARS WHO-LINECOMS) (FILECREATED "12-Apr-2023 22:10:58" {DSK}<home>larry>il>medley>lispusers>WHO-LINE.;5 75086
previous date%: "26-Mar-2021 10:48:40" {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;3) :EDIT-BY "lmm"
:CHANGES-TO (FNS WHO-LINE-HOST-NAME SET-PACKAGE-INTERACTIVELY)
:PREVIOUS-DATE "12-Apr-2023 17:45:36" {DSK}<home>larry>il>medley>lispusers>WHO-LINE.;4)
(* ; " (* ; "
Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation. Copyright (c) 1986-1989, 1994, 1998, 2001, 2021, 2023 by Xerox Corporation.
") ")
(PRETTYCOMPRINT WHO-LINECOMS) (PRETTYCOMPRINT WHO-LINECOMS)
@@ -184,7 +187,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(FUNCTIONS INVERT-WHO-LINE-ENTRY) (FUNCTIONS INVERT-WHO-LINE-ENTRY)
(DECLARE%: DONTCOPY (RECORDS WHO-LINE-ENTRY)) (DECLARE%: DONTCOPY (RECORDS WHO-LINE-ENTRY))
(* ; (* ;
 "Macros that lets us lock down the Who-Line while we evaluate some forms")  "Macros that lets us lock down the Who-Line while we evaluate some forms")
(FUNCTIONS WITH-WHO-LINE WITH-AVAILABLE-WHO-LINE) (FUNCTIONS WITH-WHO-LINE WITH-AVAILABLE-WHO-LINE)
@@ -567,11 +570,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
"Cached name of the current logged in user") "Cached name of the current logged in user")
(CL:DEFPARAMETER *WHO-LINE-USER-ENTRY* '("User" (WHO-LINE-USERNAME) (CL:DEFPARAMETER *WHO-LINE-USER-ENTRY* '("User" (WHO-LINE-USERNAME)
10 WHO-LINE-CHANGE-USER (SETQ 10 WHO-LINE-CHANGE-USER (SETQ *WHO-LINE-CURRENT-USER*
*WHO-LINE-CURRENT-USER* NIL)
NIL) "Name of the currently logged in user")
"Name of the currently logged in user")
"Who-Line entry for displaying the name of the currently logged in user") "Who-Line entry for displaying the name of the currently logged in user")
(DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE
@@ -591,18 +593,35 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(DEFINEQ (DEFINEQ
(WHO-LINE-HOST-NAME (WHO-LINE-HOST-NAME
(LAMBDA NIL (* ; "Edited 14-Jan-87 12:46 by smL") (* ;;; "") (* ;;; "Return the name of the curren workstation. Avoid consing up a new string if possible.") (* ;;; "") (* ;; "") (* ;; "The cached value in *WHO-LINE-HOST-NAME* gets invalidated by an entry on the list of \SYSTEMCACHEVARS") (* ;; "") (DECLARE (GLOBALVARS *WHO-LINE-HOST-NAME*)) (if *WHO-LINE-HOST-NAME* then *WHO-LINE-HOST-NAME* else (SETQ *WHO-LINE-HOST-NAME* (ETHERHOSTNAME)))) [LAMBDA NIL (* ; "Edited 12-Apr-2023 22:09 by lmm")
) (* ; "Edited 14-Jan-87 12:46 by smL")
(* ;;; "")
(* ;;; "Return the name of the curren workstation. Avoid consing up a new string if possible.")
(* ;;; "")
(* ;; "")
(* ;; "The cached value in *WHO-LINE-HOST-NAME* gets invalidated by an entry on the list of \SYSTEMCACHEVARS")
(* ;; "")
(DECLARE (GLOBALVARS *WHO-LINE-HOST-NAME*))
(IF *WHO-LINE-HOST-NAME*
THEN *WHO-LINE-HOST-NAME*
ELSE (SETQ *WHO-LINE-HOST-NAME* (UNIX-GETPARM "HOSTNAME"])
) )
(DEFGLOBALVAR *WHO-LINE-HOST-NAME* NIL (DEFGLOBALVAR *WHO-LINE-HOST-NAME* NIL
"Cached name of the current machine, for the Who-Line") "Cached name of the current machine, for the Who-Line")
(CL:DEFPARAMETER *WHO-LINE-HOST-NAME-ENTRY* '("on" (WHO-LINE-HOST-NAME) (CL:DEFPARAMETER *WHO-LINE-HOST-NAME-ENTRY* '("on" (WHO-LINE-HOST-NAME)
10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL) 10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL)
"Name of the currently running machine") "Name of the currently running machine")
"Who-Line entry for displaying the name of the current machine") "Who-Line entry for displaying the name of the current machine")
(DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE
@@ -647,33 +666,41 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
":") ":")
*WHO-LINE-PACKAGE-NAME-CACHE*))))) *WHO-LINE-PACKAGE-NAME-CACHE*)))))
(SET-PACKAGE-INTERACTIVELY (SET-PACKAGE-INTERACTIVELY
(LAMBDA NIL (* ; "Edited 18-Mar-87 13:13 by smL") [LAMBDA NIL (* ; "Edited 12-Apr-2023 17:44 by lmm")
(* ; "Edited 18-Mar-87 13:13 by smL")
(* ;; "")
(* ;; "Let the user interactivly change the current package")
(* ;; "")
(LET ((PACKAGE (* ;; "")
(MENU (create MENU
TITLE _ "Select package" (* ;; "Let the user interactivly change the current package")
ITEMS _ (SORT (for PACKAGE in (CL:LIST-ALL-PACKAGES) bind PACKAGE-NAME
collect (SETQ PACKAGE-NAME (CL:PACKAGE-NAME PACKAGE)) (* ;; "")
`(,(CONCAT (OR (CAR (CL:PACKAGE-NICKNAMES PACKAGE))
PACKAGE-NAME) (LET* [PKG (MAIN (FOR PN IN '("INTERLISP" "XCL-USER" "USER") WHEN (SETQ PKG (CL:FIND-PACKAGE
":") ',PACKAGE-NAME PN))
,(CONCAT "Set the current package to " COLLECT (LIST PKG PN)))
PACKAGE-NAME ":"))) (SYSPKG (FOR PN
(FUNCTION (LAMBDA (X Y) IN '("LISP" "XEROX-COMMON-LISP" "D-ASSEM" "FASL" "KEYWORD" "CASH-FILE"
(ALPHORDER (CAR X) "SEDIT" "SYSTEM" "COMPILER" "HASH-FILE" "CONDITIONS" "DEBUGGER")
(CAR Y))))) WHEN (SETQ PKG (CL:FIND-PACKAGE PN)) COLLECT (LIST PKG PN)))
CENTERFLG _ T)))) (BOTH (APPEND MAIN SYSPKG))
(if PACKAGE [UNSORTED (FOR PKG IN (CL:LIST-ALL-PACKAGES) WHEN (NOT (ASSOC PKG BOTH))
then (if (SHIFTDOWNP 'SHIFT) COLLECT (LIST PKG (OR (CAR (CL:PACKAGE-NICKNAMES PKG))
then (WHO-LINE-COPY-INSERT (CONCAT PACKAGE ":")) (CL:PACKAGE-NAME PKG]
else (CL:IN-PACKAGE PACKAGE)))))) [USERS (SORT UNSORTED (FUNCTION (LAMBDA (X Y)
(ALPHORDER (CADR X)
(CADR Y]
[ITEMS (FOR X IN (APPEND MAIN USERS SYSPKG) COLLECT (LIST (CADR X)
(CAR X]
(SELECTION (MENU (create MENU
TITLE _ "Select package"
ITEMS _ ITEMS
CENTERFLG _ T]
(IF SELECTION
THEN (IF (SHIFTDOWNP 'SHIFT)
THEN (WHO-LINE-COPY-INSERT (CONCAT (CADR SELECTION)
":"))
ELSE (CL:IN-PACKAGE (CAR SELECTION])
(SET-TTY-PACKAGE-INTERACTIVELY (SET-TTY-PACKAGE-INTERACTIVELY
(LAMBDA NIL (* smL "28-Oct-86 09:49") (* ;;; "") (* ;;; "Interactivly let the user change the package of the current TTY process") (* ;;; "") (PROCESS.EVAL (TTY.PROCESS) (QUOTE (SET-PACKAGE-INTERACTIVELY)) T)) (LAMBDA NIL (* smL "28-Oct-86 09:49") (* ;;; "") (* ;;; "Interactivly let the user change the package of the current TTY process") (* ;;; "") (PROCESS.EVAL (TTY.PROCESS) (QUOTE (SET-PACKAGE-INTERACTIVELY)) T))
@@ -681,15 +708,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
) )
(DEFGLOBALVAR *WHO-LINE-PACKAGE-NAME-CACHE* (LIST NIL) (DEFGLOBALVAR *WHO-LINE-PACKAGE-NAME-CACHE* (LIST NIL)
"An AList used to cache package names, together with their terminating ':'s") "An AList used to cache package names, together with their terminating ':'s")
(CL:DEFPARAMETER *WHO-LINE-PACKAGE-ENTRY* '("Pkg" (CURRENT-TTY-PACKAGE) (CL:DEFPARAMETER *WHO-LINE-PACKAGE-ENTRY* '("Pkg" (CURRENT-TTY-PACKAGE)
10 SET-TTY-PACKAGE-INTERACTIVELY (SETQ 10 SET-TTY-PACKAGE-INTERACTIVELY (SETQ
*WHO-LINE-PACKAGE-NAME-CACHE* *WHO-LINE-PACKAGE-NAME-CACHE*
(LIST NIL)) (LIST NIL))
"Package of the current TTY process") "Package of the current TTY process")
"Who-Line entry for displaying the package of the current TTY process") "Who-Line entry for displaying the package of the current TTY process")
@@ -717,9 +744,9 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
) )
(CL:DEFPARAMETER *WHO-LINE-READTABLE-ENTRY* '("Rdtbl" (CURRENT-TTY-READTABLE-NAME) (CL:DEFPARAMETER *WHO-LINE-READTABLE-ENTRY* '("Rdtbl" (CURRENT-TTY-READTABLE-NAME)
10 SET-TTY-READTABLE-INTERACTIVELY NIL 10 SET-TTY-READTABLE-INTERACTIVELY NIL
"Readtable of the current TTY process") "Readtable of the current TTY process")
"Who-Line entry for displaying the name of the ReadTable of the current TTY process") "Who-Line entry for displaying the name of the ReadTable of the current TTY process")
@@ -743,9 +770,9 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
) )
(CL:DEFPARAMETER *WHO-LINE-TTY-PROC-ENTRY* '("Tty" (WHO-LINE-TTY-PROCESS) (CL:DEFPARAMETER *WHO-LINE-TTY-PROC-ENTRY* '("Tty" (WHO-LINE-TTY-PROCESS)
15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL 15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL
"The current TTY process") "The current TTY process")
"Who-Line entry for displaying the name of the current TTY process") "Who-Line entry for displaying the name of the current TTY process")
@@ -763,58 +790,59 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(LAMBDA NIL (* ; "Edited 3-Feb-89 14:52 by smL") (* ;;; "Get the currently connected directory") (* ;; "First, update the cached directory / namestring pair to reflect the current TTY proc") (DECLARE (GLOBALVARS *WHO-LINE-LAST-DIRECTORY*)) (* ;; "The connected directory is looked up in the TTY process, in case one day it becomes a per-process var") (LET ((CONNECTED-DIRECTORY (PROCESS.EVALV (TTY.PROCESS) (QUOTE *DEFAULT-PATHNAME-DEFAULTS*)))) (* ; "The CAR contains the path, the CDR contains a string version of the path") (if (NEQ CONNECTED-DIRECTORY (CAR *WHO-LINE-LAST-DIRECTORY*)) then (* ; "The connected directory has changed") (change (CAR *WHO-LINE-LAST-DIRECTORY*) CONNECTED-DIRECTORY) (* ; "Put the host name last, since that is least important") (change (CDR *WHO-LINE-LAST-DIRECTORY*) (if (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) then (CONCAT (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) " on {" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}") else (CONCAT "{" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}"))) (* ; "Update the list of known directories") (LET ((DIR-NAME (CL:NAMESTRING CONNECTED-DIRECTORY))) (if (NOT (CL:MEMBER DIR-NAME *WHO-LINE-DIRECTORIES* :TEST (CL:FUNCTION STRING-EQUAL))) then (MERGEINSERT DIR-NAME (SORT *WHO-LINE-DIRECTORIES* (CL:FUNCTION UALPHORDER))))))) (* ;; "Return the namestring of the current dir") (CDR *WHO-LINE-LAST-DIRECTORY*)) (LAMBDA NIL (* ; "Edited 3-Feb-89 14:52 by smL") (* ;;; "Get the currently connected directory") (* ;; "First, update the cached directory / namestring pair to reflect the current TTY proc") (DECLARE (GLOBALVARS *WHO-LINE-LAST-DIRECTORY*)) (* ;; "The connected directory is looked up in the TTY process, in case one day it becomes a per-process var") (LET ((CONNECTED-DIRECTORY (PROCESS.EVALV (TTY.PROCESS) (QUOTE *DEFAULT-PATHNAME-DEFAULTS*)))) (* ; "The CAR contains the path, the CDR contains a string version of the path") (if (NEQ CONNECTED-DIRECTORY (CAR *WHO-LINE-LAST-DIRECTORY*)) then (* ; "The connected directory has changed") (change (CAR *WHO-LINE-LAST-DIRECTORY*) CONNECTED-DIRECTORY) (* ; "Put the host name last, since that is least important") (change (CDR *WHO-LINE-LAST-DIRECTORY*) (if (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) then (CONCAT (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) " on {" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}") else (CONCAT "{" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}"))) (* ; "Update the list of known directories") (LET ((DIR-NAME (CL:NAMESTRING CONNECTED-DIRECTORY))) (if (NOT (CL:MEMBER DIR-NAME *WHO-LINE-DIRECTORIES* :TEST (CL:FUNCTION STRING-EQUAL))) then (MERGEINSERT DIR-NAME (SORT *WHO-LINE-DIRECTORIES* (CL:FUNCTION UALPHORDER))))))) (* ;; "Return the namestring of the current dir") (CDR *WHO-LINE-LAST-DIRECTORY*))
) )
(SET-CONNECTED-DIRECTORY-INTERACTIVELY (SET-CONNECTED-DIRECTORY-INTERACTIVELY
(LAMBDA NIL (* ; "Edited 9-Jun-87 08:57 by smL") [LAMBDA NIL (* ; "Edited 12-Apr-2023 08:00 by lmm")
(* ; "Edited 9-Jun-87 08:57 by smL")
(* ;;; "Let the user interactivly change the current connected directory") (* ;;; "Let the user interactivly change the current connected directory")
(DECLARE (GLOBALVARS *WHO-LINE-DIRECTORIES*)) (DECLARE (GLOBALVARS *WHO-LINE-DIRECTORIES*))
(* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it")
(if (SHIFTDOWNP 'SHIFT) (* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it")
then (LET ((NEW-DIRECTORY (MENU (create MENU
(SETQ *WHO-LINE-DIRECTORIES* (SUBSET *WHO-LINE-DIRECTORIES* (FUNCTION DIRECTORYNAMEP)))
(IF (SHIFTDOWNP 'SHIFT)
THEN (LET [(NEW-DIRECTORY (MENU (create MENU
TITLE _ "Type in directory name:" TITLE _ "Type in directory name:"
ITEMS _ *WHO-LINE-DIRECTORIES*)))) ITEMS _ *WHO-LINE-DIRECTORIES*]
(if NEW-DIRECTORY (IF NEW-DIRECTORY
then (WHO-LINE-COPY-INSERT NEW-DIRECTORY))) THEN (WHO-LINE-COPY-INSERT NEW-DIRECTORY)))
else (LET ((NEW-DIRECTORY (MENU (create MENU ELSE (LET [(NEW-DIRECTORY (MENU (create MENU
TITLE _ "Connect to:" TITLE _ "Connect to:"
ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*))))) ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*]
(if NEW-DIRECTORY (if NEW-DIRECTORY
then (if (STRING-EQUAL NEW-DIRECTORY "* Other *") then (if (STRING-EQUAL NEW-DIRECTORY "* Other *")
then (CLEARW PROMPTWINDOW) then (CLEARW PROMPTWINDOW)
(SETQ NEW-DIRECTORY (PROMPTFORWORD "Connect to directory " (SETQ NEW-DIRECTORY (PROMPTFORWORD "Connect to directory "
(CL:NAMESTRING (PROCESS.EVALV (CL:NAMESTRING (PROCESS.EVALV
(TTY.PROCESS) (TTY.PROCESS)
' '
*DEFAULT-PATHNAME-DEFAULTS* *DEFAULT-PATHNAME-DEFAULTS*
)) ))
NIL PROMPTWINDOW NIL 'TTY NIL))) NIL PROMPTWINDOW NIL 'TTY NIL)))
(if NEW-DIRECTORY (if NEW-DIRECTORY
then (ALLOW.BUTTON.EVENTS) (* ; then (ALLOW.BUTTON.EVENTS) (* ;
"Should do this in the current TTY process, in case the conntected directory is a per-process var")  "Should do this in the current TTY process, in case the conntected directory is a per-process var")
(CNDIR NEW-DIRECTORY])
(CNDIR NEW-DIRECTORY)))))))
) )
(DEFGLOBALVAR *WHO-LINE-DIRECTORIES* `(,LOGINHOST/DIR) (DEFGLOBALVAR *WHO-LINE-DIRECTORIES* `(,LOGINHOST/DIR)
"Cached list of known directories for the Who-Line Directory entry") "Cached list of known directories for the Who-Line Directory entry")
(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY* (LET ((NAMESTRING (CL:NAMESTRING (DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY* (LET ((NAMESTRING (CL:NAMESTRING *DEFAULT-PATHNAME-DEFAULTS*)
*DEFAULT-PATHNAME-DEFAULTS*))) ))
(CONS (PATHNAME NAMESTRING) (CONS (PATHNAME NAMESTRING)
(MKSTRING NAMESTRING))) (MKSTRING NAMESTRING)))
"Cached name of the current connected directory for the Who-Line Directory entry") "Cached name of the current connected directory for the Who-Line Directory entry")
(CL:DEFPARAMETER *WHO-LINE-DIRECTORY-ENTRY* '("Dir" (WHO-LINE-CURRENT-DIRECTORY) (CL:DEFPARAMETER *WHO-LINE-DIRECTORY-ENTRY* '("Dir" (WHO-LINE-CURRENT-DIRECTORY)
30 SET-CONNECTED-DIRECTORY-INTERACTIVELY 30 SET-CONNECTED-DIRECTORY-INTERACTIVELY
(SETQ *WHO-LINE-LAST-DIRECTORY* (SETQ *WHO-LINE-LAST-DIRECTORY* (CONS NIL NIL))
(CONS NIL NIL)) "The currently connected directory")
"The currently connected directory")
"Who-Line entry for displaying the name of the currently connected directory") "Who-Line entry for displaying the name of the currently connected directory")
@@ -887,15 +915,14 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
) )
(DEFGLOBALVAR *WHO-LINE-LAST-VMEM* (LIST 0 NIL NIL) (DEFGLOBALVAR *WHO-LINE-LAST-VMEM* (LIST 0 NIL NIL)
"Cached value for storing the last VMem information for the Who-Line VMem entry") "Cached value for storing the last VMem information for the Who-Line VMem entry")
(CL:DEFPARAMETER *WHO-LINE-VMEM-ENTRY* '("VMem" (WHO-LINE-VMEM) (CL:DEFPARAMETER *WHO-LINE-VMEM-ENTRY* '("VMem" (WHO-LINE-VMEM)
5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM* 5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM*
(LIST 0 NIL NIL)) (LIST 0 NIL NIL))
"Percentage of VMem currently in use") "Percentage of VMem currently in use")
"Who-Line entry for displaying the current VMem utilization")
"Who-Line entry for displaying the current VMem utilization")
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD
(FILESLOAD (LOADCOMP) (FILESLOAD (LOADCOMP)
@@ -938,15 +965,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(CL:THIRD *WHO-LINE-SYMBOL-SPACE*))) (CL:THIRD *WHO-LINE-SYMBOL-SPACE*)))
(DEFGLOBALVAR *WHO-LINE-SYMBOL-SPACE* (LIST NIL NIL NIL (DEFGLOBALVAR *WHO-LINE-SYMBOL-SPACE* (LIST NIL NIL NIL
"Remembers the previous who-line symbol space")) "Remembers the previous who-line symbol space"))
(CL:DEFPARAMETER *WHO-LINE-SYMBOL-SPACE-ENTRY* '("Syms" (WHO-LINE-SYMBOL-SPACE) (CL:DEFPARAMETER *WHO-LINE-SYMBOL-SPACE-ENTRY* '("Syms" (WHO-LINE-SYMBOL-SPACE)
4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE* 4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE*
(LIST NIL NIL NIL)) (LIST NIL NIL NIL))
"Percentage of symbol space currently in use")
"Percentage of symbol space currently in use"
)
"Who-line entry for displaying percent of symbol space in use") "Who-line entry for displaying percent of symbol space in use")
@@ -991,13 +1016,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
) )
(DEFGLOBALVAR *WHO-LINE-TIMER* (SETUPTIMER (DIFFERENCE 60 (REMAINDER (IDATE) (DEFGLOBALVAR *WHO-LINE-TIMER* (SETUPTIMER (DIFFERENCE 60 (REMAINDER (IDATE)
60)) 60))
NIL NIL
'SECONDS) 'SECONDS)
"Timer for controlling updates of the Who-Line Time entry") "Timer for controlling updates of the Who-Line Time entry")
(DEFGLOBALVAR *WHO-LINE-OLD-TIME* (DATE (DATEFORMAT NO.SECONDS)) (DEFGLOBALVAR *WHO-LINE-OLD-TIME* (DATE (DATEFORMAT NO.SECONDS))
"Cached value for the Who-Line Time entry") "Cached value for the Who-Line Time entry")
(CL:DEFPARAMETER *WHO-LINE-TIME-ENTRY* (CL:DEFPARAMETER *WHO-LINE-TIME-ENTRY*
'("Time" (WHO-LINE-TIME) '("Time" (WHO-LINE-TIME)
@@ -1082,15 +1107,14 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
"Interval between updating the Who-Line activity entry") "Interval between updating the Who-Line activity entry")
(DEFGLOBALVAR *WHO-LINE-ACTIVE-TIMER* (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL 'MILLISECONDS) (DEFGLOBALVAR *WHO-LINE-ACTIVE-TIMER* (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL 'MILLISECONDS)
"Timer for controlling updating of the Who-Line activity entry") "Timer for controlling updating of the Who-Line activity entry")
(CL:DEFPARAMETER *WHO-LINE-SHOW-ACTIVE-ENTRY* '("" (WHO-LINE-SHOW-ACTIVE) (CL:DEFPARAMETER *WHO-LINE-SHOW-ACTIVE-ENTRY* '("" (WHO-LINE-SHOW-ACTIVE)
2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER* 2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER*
(SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL
NIL 'MILLISECONDS)) 'MILLISECONDS))
"Indication of machine activity") "Indication of machine activity")
"Who-Line entry for displaying the activity of the machine") "Who-Line entry for displaying the activity of the machine")
(DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE
@@ -1122,10 +1146,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
) )
(CL:DEFPARAMETER *WHO-LINE-PROFILE-ENTRY* '("Profile" (CURRENT-PROFILE) (CL:DEFPARAMETER *WHO-LINE-PROFILE-ENTRY* '("Profile" (CURRENT-PROFILE)
10 SET-TTY-PROFILE-INTERACTIVELY NIL 10 SET-TTY-PROFILE-INTERACTIVELY NIL
"The read/write profile of the current TTY process" "The read/write profile of the current TTY process"
) )
"Who-Line entry for displaying the current read/write profile") "Who-Line entry for displaying the current read/write profile")
@@ -1176,15 +1200,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
"Cached state shown in the Who-Line State entry") "Cached state shown in the Who-Line State entry")
(DEFGLOBALVAR *WHO-LINE-STATE-UNINTERESTING-FNS* '(BLOCK ERRORSET OBTAIN.MONITORLOCK (DEFGLOBALVAR *WHO-LINE-STATE-UNINTERESTING-FNS* '(BLOCK ERRORSET OBTAIN.MONITORLOCK
MONITOR.AWAIT.EVENT AWAIT.EVENT MONITOR.AWAIT.EVENT AWAIT.EVENT
SI::*UNWIND-PROTECT*) SI::*UNWIND-PROTECT*)
"Uninteresting fns to skip over in the Who-Line State entry") "Uninteresting fns to skip over in the Who-Line State entry")
(CL:DEFPARAMETER *WHO-LINE-TTY-STATE-ENTRY* '("State" (WHO-LINE-TTY-STATE) (CL:DEFPARAMETER *WHO-LINE-TTY-STATE-ENTRY* '("State" (WHO-LINE-TTY-STATE)
15 NIL (SETQ *WHO-LINE-STATE* NIL) 15 NIL (SETQ *WHO-LINE-STATE* NIL)
"Running state of the current TTY process") "Running state of the current TTY process")
"Who-Line entry for showing the running state of the current TTY process") "Who-Line entry for showing the running state of the current TTY process")
(PUTPROPS AWAIT.EVENT WHO-LINE-STATE "Block") (PUTPROPS AWAIT.EVENT WHO-LINE-STATE "Block")
@@ -1222,9 +1246,8 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(DEFGLOBALVAR *WHO-LINE-ENTRIES* (DEFGLOBALVAR *WHO-LINE-ENTRIES*
`(,*WHO-LINE-USER-ENTRY* ,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* `(,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* ,*WHO-LINE-TTY-PROC-ENTRY*
,*WHO-LINE-TTY-PROC-ENTRY* ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* ,*WHO-LINE-TIME-ENTRY*)
,*WHO-LINE-TIME-ENTRY*)
"List of all the entries to show in the Who-Line") "List of all the entries to show in the Who-Line")
(DEFGLOBALVAR *WHO-LINE-ENTRY-REGISTRY* (DEFGLOBALVAR *WHO-LINE-ENTRY-REGISTRY*
@@ -1235,13 +1258,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
"List of all known Who-Line entries.") "List of all known Who-Line entries.")
(DEFGLOBALVAR *WHO-LINE-ANCHOR* '(:CENTER :TOP) (DEFGLOBALVAR *WHO-LINE-ANCHOR* '(:CENTER :TOP)
"Location to place the Who-Line") "Location to place the Who-Line")
(DEFGLOBALVAR *WHO-LINE-NAME-FONT* (FONTCREATE '(HELVETICA 8 BOLD)) (DEFGLOBALVAR *WHO-LINE-NAME-FONT* (FONTCREATE '(HELVETICA 8 BOLD))
"Font to use to show entry labels in the Who-Line") "Font to use to show entry labels in the Who-Line")
(DEFGLOBALVAR *WHO-LINE-VALUE-FONT* (FONTCREATE '(GACHA 8)) (DEFGLOBALVAR *WHO-LINE-VALUE-FONT* (FONTCREATE '(GACHA 8))
"Font to use to show the entry values in the Who-Line") "Font to use to show the entry values in the Who-Line")
(DEFGLOBALVAR *WHO-LINE-DISPLAY-NAMES?* T (DEFGLOBALVAR *WHO-LINE-DISPLAY-NAMES?* T
"Flag for enabling or disabling the display of entry names in the Who-Line") "Flag for enabling or disabling the display of entry names in the Who-Line")
@@ -1578,15 +1601,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(DEFMACRO INVERT-WHO-LINE-ENTRY (ENTRY WINDOW) (DEFMACRO INVERT-WHO-LINE-ENTRY (ENTRY WINDOW)
`(WITH WHO-LINE-ENTRY ,ENTRY (BLTSHADE BLACKSHADE ,WINDOW NAME-START 0 (DIFFERENCE VALUE-END `(WITH WHO-LINE-ENTRY ,ENTRY (BLTSHADE BLACKSHADE ,WINDOW NAME-START 0 (DIFFERENCE VALUE-END
NAME-START) NAME-START)
NIL NIL
'INVERT) 'INVERT)
(CHANGE INVERTED? (NOT INVERTED?)))) (CHANGE INVERTED? (NOT INVERTED?))))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(RECORD WHO-LINE-ENTRY (NAME FORM NAME-START VALUE-START VALUE-END PREV-VALUE WHEN-SELECTED-FN (RECORD WHO-LINE-ENTRY (NAME FORM NAME-START VALUE-START VALUE-END PREV-VALUE WHEN-SELECTED-FN
INVERTED? RESET-FORM DESCRIPTION)) INVERTED? RESET-FORM DESCRIPTION))
) )
) )
@@ -1606,7 +1629,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
`(LET ((,LOCK (OBTAIN.MONITORLOCK (WINDOWPROP ,WHO-LINE 'LOCK) `(LET ((,LOCK (OBTAIN.MONITORLOCK (WINDOWPROP ,WHO-LINE 'LOCK)
T))) T)))
(CL:UNWIND-PROTECT (* ; (CL:UNWIND-PROTECT (* ;
 "Only eval the forms if we got the lock")  "Only eval the forms if we got the lock")
(COND (COND
(,LOCK ,@FORMS)) (,LOCK ,@FORMS))
@@ -1614,13 +1637,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
[COND [COND
((EQ ,LOCK T) (* ; ((EQ ,LOCK T) (* ;
 "Had the lock before, so no need to release it")  "Had the lock before, so no need to release it")
NIL) NIL)
((NULL ,LOCK) (* ; ((NULL ,LOCK) (* ;
 "Couldn't get the lock, so no need to release it")  "Couldn't get the lock, so no need to release it")
NIL) NIL)
(T (* ; (T (* ;
 "We got the lock, and need to release it")  "We got the lock, and need to release it")
(RELEASE.MONITORLOCK ,LOCK])]) (RELEASE.MONITORLOCK ,LOCK])])
@@ -1656,24 +1679,25 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
(PUTPROPS WHO-LINE FILETYPE :COMPILE-FILE) (PUTPROPS WHO-LINE FILETYPE :COMPILE-FILE)
) )
(PUTPROPS WHO-LINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1994 1998 2001 2021)) (PUTPROPS WHO-LINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1994 1998 2001 2021 2023))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (7778 23157 (INSTALL-WHO-LINE-OPTIONS 7788 . 23155)) (23433 24602 (WHO-LINE-USERNAME (FILEMAP (NIL (7838 23217 (INSTALL-WHO-LINE-OPTIONS 7848 . 23215)) (23493 24662 (WHO-LINE-USERNAME
23443 . 24090) (WHO-LINE-CHANGE-USER 24092 . 24398) (WHO-LINE-USER-AFTER-LOGIN 24400 . 24600)) (25504 23503 . 24150) (WHO-LINE-CHANGE-USER 24152 . 24458) (WHO-LINE-USER-AFTER-LOGIN 24460 . 24660)) (25470
25983 (WHO-LINE-HOST-NAME 25514 . 25981)) (26695 29324 (CURRENT-TTY-PACKAGE 26705 . 27657) ( 26206 (WHO-LINE-HOST-NAME 25480 . 26204)) (26906 30232 (CURRENT-TTY-PACKAGE 26916 . 27868) (
SET-PACKAGE-INTERACTIVELY 27659 . 29078) (SET-TTY-PACKAGE-INTERACTIVELY 29080 . 29322)) (30244 31296 ( SET-PACKAGE-INTERACTIVELY 27870 . 29986) (SET-TTY-PACKAGE-INTERACTIVELY 29988 . 30230)) (31132 32184 (
CURRENT-TTY-READTABLE-NAME 30254 . 30508) (SET-READTABLE-INTERACTIVELY 30510 . 31044) ( CURRENT-TTY-READTABLE-NAME 31142 . 31396) (SET-READTABLE-INTERACTIVELY 31398 . 31932) (
SET-TTY-READTABLE-INTERACTIVELY 31046 . 31294)) (31811 32383 (WHO-LINE-TTY-PROCESS 31821 . 31999) ( SET-TTY-READTABLE-INTERACTIVELY 31934 . 32182)) (32687 33259 (WHO-LINE-TTY-PROCESS 32697 . 32875) (
CHANGE-TTY-PROCESS-INTERACTIVELY 32001 . 32381)) (32884 36355 (WHO-LINE-CURRENT-DIRECTORY 32894 . CHANGE-TTY-PROCESS-INTERACTIVELY 32877 . 33257)) (33748 37557 (WHO-LINE-CURRENT-DIRECTORY 33758 .
34301) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 34303 . 36353)) (37720 40173 (WHO-LINE-VMEM 37730 . 35165) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 35167 . 37555)) (38817 41270 (WHO-LINE-VMEM 38827 .
39920) (WHO-LINE-SAVE-VMEM 39922 . 40171)) (41097 42239 (WHO-LINE-SYMBOL-SPACE 41097 . 42239)) (43107 41017) (WHO-LINE-SAVE-VMEM 41019 . 41268)) (42132 43274 (WHO-LINE-SYMBOL-SPACE 42132 . 43274)) (44005
44545 (WHO-LINE-TIME 43117 . 43859) (WHO-LINE-SET-TIME 43861 . 44543)) (46079 48712 ( 45443 (WHO-LINE-TIME 44015 . 44757) (WHO-LINE-SET-TIME 44759 . 45441)) (46957 49590 (
WHO-LINE-SHOW-ACTIVE 46089 . 46867) (\UPDATE-WHO-LINE-ACTIVE-FLAG 46869 . 47837) ( WHO-LINE-SHOW-ACTIVE 46967 . 47745) (\UPDATE-WHO-LINE-ACTIVE-FLAG 47747 . 48715) (
\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 47839 . 48710)) (49873 50798 (CURRENT-PROFILE 49883 . 50128) ( \PERIODICALLY-WHO-LINE-SHOW-ACTIVE 48717 . 49588)) (50687 51612 (CURRENT-PROFILE 50697 . 50942) (
SET-PROFILE-INTERACTIVELY 50130 . 50533) (SET-TTY-PROFILE-INTERACTIVELY 50535 . 50796)) (51360 53343 ( SET-PROFILE-INTERACTIVELY 50944 . 51347) (SET-TTY-PROFILE-INTERACTIVELY 51349 . 51610)) (52162 54145 (
WHO-LINE-TTY-STATE 51370 . 52531) (WHO-LINE-WHAT-IS-RUNNING 52533 . 53341)) (56897 70023 ( WHO-LINE-TTY-STATE 52172 . 53333) (WHO-LINE-WHAT-IS-RUNNING 53335 . 54143)) (57628 70754 (
REDISPLAY-WHO-LINE 56907 . 59467) (PERIODICALLY-UPDATE-WHO-LINE 59469 . 60607) (SETUP-WHOLINE-TIMER REDISPLAY-WHO-LINE 57638 . 60198) (PERIODICALLY-UPDATE-WHO-LINE 60200 . 61338) (SETUP-WHOLINE-TIMER
60609 . 60827) (UPDATE-WHO-LINE 60829 . 63897) (WHEN-WHO-LINE-SELECTED-FN 63899 . 67166) ( 61340 . 61558) (UPDATE-WHO-LINE 61560 . 64628) (WHEN-WHO-LINE-SELECTED-FN 64630 . 67897) (
WHO-LINE-CONTROL-SELECT 67168 . 69627) (WHO-LINE-COPY-INSERT 69629 . 70021)) (70024 71158 ( WHO-LINE-CONTROL-SELECT 67899 . 70358) (WHO-LINE-COPY-INSERT 70360 . 70752)) (70755 71889 (
WHO-LINE-REDISPLAY-INTERRUPT 70034 . 71156))))) WHO-LINE-REDISPLAY-INTERRUPT 70765 . 71887)) (72291 72677 (INVERT-WHO-LINE-ENTRY 72291 . 72677)) (
72981 73153 (WITH-WHO-LINE 72981 . 73153)) (73155 74399 (WITH-AVAILABLE-WHO-LINE 73155 . 74399)))))
STOP STOP

BIN
lispusers/WHO-LINE.DFASL
View File

Binary file not shown.

57
sources/DMISC
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Jan-2022 19:08:15" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;3 45512 (FILECREATED " 8-Apr-2023 13:56:13" {DSK}<home>larry>il>medley>sources>DMISC.;2 45464
:CHANGES-TO (FNS FLASHWINDOW) :EDIT-BY "lmm"
:PREVIOUS-DATE "16-May-90 15:53:57" :CHANGES-TO (FNS RINGBELLS)
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;1)
:PREVIOUS-DATE " 6-Jan-2022 19:08:15" {DSK}<home>larry>il>medley>sources>DMISC.;1)
(* ; " (* ; "
@@ -216,16 +217,14 @@ with the terms of said license.
(DEFINEQ (DEFINEQ
(RINGBELLS (RINGBELLS
[LAMBDA (N) (* ; "Edited 10-May-88 23:01 by MASINTER") [LAMBDA (N) (* ; "Edited 8-Apr-2023 13:30 by lmm")
(* ; "Edited 10-May-88 23:01 by MASINTER")
(DECLARE (GLOBALVARS RINGBELLS.L1 RINGBELLS.L2)) (DECLARE (GLOBALVARS RINGBELLS.L1 RINGBELLS.L2))
(OR (FIXP N) (OR (FIXP N)
(SETQ N 1)) (SETQ N 1))
(SELECTC \MACHINETYPE (to N do (PLAYTUNE RINGBELLS.L1)
((LIST \DAYBREAK \DANDELION \MAIKO) (FLASHWINDOW NIL NIL 100)
(to N do (PLAYTUNE RINGBELLS.L1) (PLAYTUNE RINGBELLS.L2])
(FLASHWINDOW NIL NIL 100)
(PLAYTUNE RINGBELLS.L2)))
(FLASHWINDOW NIL N])
(FLASHWINDOW (FLASHWINDOW
[LAMBDA (WIN? N FLASHINTERVAL SHADE) (* ; "Edited 6-Jan-2022 19:08 by rmk") [LAMBDA (WIN? N FLASHINTERVAL SHADE) (* ; "Edited 6-Jan-2022 19:08 by rmk")
@@ -951,22 +950,22 @@ with the terms of said license.
(PUTPROPS DMISC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990) (PUTPROPS DMISC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990)
) )
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (4747 5450 (BACKSPACEDEL 4757 . 5448)) (5545 5978 (PERIODICALLYRECLAIM 5555 . 5976)) ( (FILEMAP (NIL (4732 5435 (BACKSPACEDEL 4742 . 5433)) (5530 5963 (PERIODICALLYRECLAIM 5540 . 5961)) (
6208 7899 (\DIRTYBACKGROUND 6218 . 6640) (\SAVEVMBACKGROUND 6642 . 7426) (COPYVM 7428 . 7897)) (8320 6193 7884 (\DIRTYBACKGROUND 6203 . 6625) (\SAVEVMBACKGROUND 6627 . 7411) (COPYVM 7413 . 7882)) (8305
9519 (SETTIME 8330 . 9517)) (9520 13551 (RINGBELLS 9530 . 10023) (FLASHWINDOW 10025 . 11953) (PLAYTUNE 9504 (SETTIME 8315 . 9502)) (9505 13503 (RINGBELLS 9515 . 9975) (FLASHWINDOW 9977 . 11905) (PLAYTUNE
11955 . 13549)) (13813 19345 (DISPLAYDOWN 13823 . 14211) (SETDISPLAYHEIGHT 14213 . 17013) (VIDEORATE 11907 . 13501)) (13765 19297 (DISPLAYDOWN 13775 . 14163) (SETDISPLAYHEIGHT 14165 . 16965) (VIDEORATE
17015 . 19343)) (19769 20490 (DOAROUNDEXITFORMS 19779 . 20488)) (20693 22408 (REALMEMORYSIZE 20703 . 16967 . 19295)) (19721 20442 (DOAROUNDEXITFORMS 19731 . 20440)) (20645 22360 (REALMEMORYSIZE 20655 .
20861) (LISPVERSION 20863 . 21016) (MICROCODEVERSION 21018 . 21176) (BCPLVERSION 21178 . 21331) ( 20813) (LISPVERSION 20815 . 20968) (MICROCODEVERSION 20970 . 21128) (BCPLVERSION 21130 . 21283) (
REQUIREVERSION 21333 . 22406)) (22445 27023 (APROPOS 22455 . 26471) (APROPRINT 26473 . 27021)) (27049 REQUIREVERSION 21285 . 22358)) (22397 26975 (APROPOS 22407 . 26423) (APROPRINT 26425 . 26973)) (27001
30957 (READPRINTERPORT 27059 . 27200) (WRITEPRINTERPORT 27202 . 27357) (\READPRINTERPORT.UFN 27359 . 30909 (READPRINTERPORT 27011 . 27152) (WRITEPRINTERPORT 27154 . 27309) (\READPRINTERPORT.UFN 27311 .
27548) (\WRITEPRINTERPORT.UFN 27550 . 27748) (\MISC1.UFN 27750 . 27903) (\MISC2.UFN 27905 . 28143) ( 27500) (\WRITEPRINTERPORT.UFN 27502 . 27700) (\MISC1.UFN 27702 . 27855) (\MISC2.UFN 27857 . 28095) (
\MISC3.UFN 28145 . 28878) (\MISC4.UFN 28880 . 29430) (\MISC5.UFN 29432 . 29585) (\MISC6.UFN 29587 . \MISC3.UFN 28097 . 28830) (\MISC4.UFN 28832 . 29382) (\MISC5.UFN 29384 . 29537) (\MISC6.UFN 29539 .
29837) (\MISC7.UFN 29839 . 30324) (\MISC8.UFN 30326 . 30627) (\MISC10.UFN 30629 . 30955)) (31011 38460 29789) (\MISC7.UFN 29791 . 30276) (\MISC8.UFN 30278 . 30579) (\MISC10.UFN 30581 . 30907)) (30963 38412
(\BLKFDIFF.UFN 31021 . 31586) (\BLKFPLUS.UFN 31588 . 32160) (\BLKFTIMES.UFN 32162 . 32737) ( (\BLKFDIFF.UFN 30973 . 31538) (\BLKFPLUS.UFN 31540 . 32112) (\BLKFTIMES.UFN 32114 . 32689) (
\BLKSEP.UFN 32739 . 33870) (\BLKPERM.UFN 33872 . 34341) (\BLKEXPONENT.UFN 34343 . 34753) ( \BLKSEP.UFN 32691 . 33822) (\BLKPERM.UFN 33824 . 34293) (\BLKEXPONENT.UFN 34295 . 34705) (
\BLKFLOATP2COMP.UFN 34755 . 35339) (\BLKSMALLP2FLOAT.UFN 35341 . 35700) (\BLKMAG.UFN 35702 . 36353) ( \BLKFLOATP2COMP.UFN 34707 . 35291) (\BLKSMALLP2FLOAT.UFN 35293 . 35652) (\BLKMAG.UFN 35654 . 36305) (
\FLOATTOBYTE.UFN 36355 . 36934) (\BLKFMAX.UFN 36936 . 37328) (\BLKFMIN.UFN 37330 . 37719) ( \FLOATTOBYTE.UFN 36307 . 36886) (\BLKFMAX.UFN 36888 . 37280) (\BLKFMIN.UFN 37282 . 37671) (
\BLKFABSMAX.UFN 37721 . 38090) (\BLKFABSMIN.UFN 38092 . 38458)) (38500 40318 (\P-MISC2.UFN 38510 . \BLKFABSMAX.UFN 37673 . 38042) (\BLKFABSMIN.UFN 38044 . 38410)) (38452 40270 (\P-MISC2.UFN 38462 .
38751) (\LINES-EQUAL-P 38753 . 39137) (\GET-NEXT-RUN 39139 . 40316)) (40319 44498 (IBLT1 40329 . 42331 38703) (\LINES-EQUAL-P 38705 . 39089) (\GET-NEXT-RUN 39091 . 40268)) (40271 44450 (IBLT1 40281 . 42283
) (IBLT2 42333 . 44496))))) ) (IBLT2 42285 . 44448)))))
STOP STOP

BIN
sources/DMISC.LCOM
View File

Binary file not shown.

222
sources/LOGOW
View File

File diff suppressed because one or more lines are too long

BIN
sources/LOGOW.DFASL Normal file
View File

Binary file not shown.

BIN
sources/LOGOW.LCOM
View File

Binary file not shown.

193
sources/WINDOW
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Jul-2022 11:10:09"  (FILECREATED "10-Apr-2023 07:05:18" {DSK}<home>larry>il>medley>sources>WINDOW.;2 222381
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>WINDOW.;19 221116
:EDIT-BY "lmm"
:CHANGES-TO (VARS WINDOWCOMS) :CHANGES-TO (VARS WINDOWCOMS)
(FNS \MEDW.DSPCREATE \GENERIC.DSPCREATE \GENERIC.DSPCREATE.DESTINATION.BITMAP?)
:PREVIOUS-DATE " 8-Jul-2022 23:54:16" :PREVIOUS-DATE " 9-Jul-2022 11:10:09" {DSK}<home>larry>il>medley>sources>WINDOW.;1)
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>WINDOW.;15)
(* ; " (* ; "
@@ -16,7 +15,7 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
(PRETTYCOMPRINT WINDOWCOMS) (PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS (RPAQQ WINDOWCOMS
[(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE [(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE
\TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN \CREATE.TTYDISPLAYSTREAM \TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN \CREATE.TTYDISPLAYSTREAM
HASTTYWINDOWP TTYINFOSTREAM CREATESCREEN \INSURESCREEN \BITMAPTOSCREEN MAINSCREEN) HASTTYWINDOWP TTYINFOSTREAM CREATESCREEN \INSURESCREEN \BITMAPTOSCREEN MAINSCREEN)
@@ -73,6 +72,8 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
(PROP ARGNAMES WINDOWPROP) (PROP ARGNAMES WINDOWPROP)
(OPTIMIZERS WINDOWPROP) (OPTIMIZERS WINDOWPROP)
(FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH)) (FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH))
(FNS WINDOW.BITMAP)
(* ; "lmm 4/23")
(COMS (FNS OPENWP TOPWP RESHAPEBYREPAINTFN \INBETWEENP DECODE/WINDOW/OR/DISPLAYSTREAM (COMS (FNS OPENWP TOPWP RESHAPEBYREPAINTFN \INBETWEENP DECODE/WINDOW/OR/DISPLAYSTREAM
GROW/REGION CLRPROMPT PROMPTPRINT OPENWINDOWS \INSUREWINDOW) GROW/REGION CLRPROMPT PROMPTPRINT OPENWINDOWS \INSUREWINDOW)
(* ; (* ;
@@ -1389,23 +1390,23 @@ Middle button down moves closest corner.")
) )
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT) [PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP 'LSHIFT)
(KEYDOWNP 'RSHIFT) (KEYDOWNP 'RSHIFT)
(KEYDOWNP 'COPY]) (KEYDOWNP 'COPY]
(PUTPROPS WSOP MACRO [ARGS (LET ((METHOD (CADR (CAR ARGS))) [PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS)))
(DISPLAY (CADR ARGS)) (DISPLAY (CADR ARGS))
(OTHERARGS (CDDR ARGS))) (OTHERARGS (CDDR ARGS)))
`(SPREADAPPLY* (fetch (WSOPS ,METHOD) of (fetch (FDEV WINDOWOPS) `(SPREADAPPLY* (fetch (WSOPS ,METHOD) of (fetch (FDEV WINDOWOPS)
of ,DISPLAY)) of ,DISPLAY))
,DISPLAY ,DISPLAY
,@OTHERARGS]) ,@OTHERARGS]
) )
(* "END EXPORTED DEFINITIONS") (* "END EXPORTED DEFINITIONS")
(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS)) (PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS))
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT)) (RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT))
@@ -1868,15 +1869,15 @@ Middle button down moves closest corner.")
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \COERCETODS MACRO [OPENLAMBDA (X) [PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X)
(COND (COND
((type? WINDOW X) ((type? WINDOW X)
(fetch (WINDOW DSP) of X)) (fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X]) (T (\ILLEGAL.ARG X]
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST) [PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
(UNINTERRUPTABLY (UNINTERRUPTABLY
(\INTERNALTOTOPW FIRST) . REST))) (\INTERNALTOTOPW FIRST) . REST)]
) )
(* "END EXPORTED DEFINITIONS") (* "END EXPORTED DEFINITIONS")
@@ -2042,7 +2043,7 @@ Middle button down moves closest corner.")
(* ; "Compiled WINDOWPROP") (* ; "Compiled WINDOWPROP")
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U)) (PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(DEFOPTIMIZER WINDOWPROP (&REST ARGS) (DEFOPTIMIZER WINDOWPROP (&REST ARGS)
(CWINDOWPROP ARGS)) (CWINDOWPROP ARGS))
@@ -2172,6 +2173,26 @@ Middle button down moves closest corner.")
) )
(DEFINEQ (DEFINEQ
(WINDOW.BITMAP
[LAMBDA (W) (* ; "Edited 12-Jun-90 10:38 by mitani")
(* Returns all of the bitmap of the
 window)
(PROG [BM (REGION (WINDOWPROP W 'REGION]
(CLOSEW W)
(SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(BITBLT (WINDOWPROP W 'IMAGECOVERED)
NIL NIL BM)
(OPENW W)
(RETURN BM])
)
(* ; "lmm 4/23")
(DEFINEQ
(OPENWP (OPENWP
[LAMBDA (WINDOW) (* rrb "26-OCT-83 15:01") [LAMBDA (WINDOW) (* rrb "26-OCT-83 15:01")
@@ -3491,7 +3512,7 @@ Middle button down moves closest corner.")
(DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS WINDOWOP DMACRO [ARGS (LET ((OPNAME (CAR ARGS)) [PUTPROPS WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS))
(METHOD-DEVICE (CADR ARGS)) (METHOD-DEVICE (CADR ARGS))
(TAIL (CDDR ARGS))) (TAIL (CDDR ARGS)))
(COND (COND
@@ -3502,7 +3523,7 @@ Middle button down moves closest corner.")
of ,METHOD-DEVICE) of ,METHOD-DEVICE)
,METHOD-DEVICE ,METHOD-DEVICE
,@TAIL] ,@TAIL]
(T (ERROR "OPNAME not quoted: " OPNAME]) (T (ERROR "OPNAME not quoted: " OPNAME]
) )
(* "END EXPORTED DEFINITIONS") (* "END EXPORTED DEFINITIONS")
@@ -3917,40 +3938,42 @@ Middle button down moves closest corner.")
(FILESLOAD PAINTW) (FILESLOAD PAINTW)
(ADDTOVAR WindowMenuCommands (ADDTOVAR WindowMenuCommands (Close '\INTERACTIVE.CLOSEW "Closes a window")
(Close '\INTERACTIVE.CLOSEW "Closes a window") (Snap 'SNAPW "Saves a snapshot of a region of the screen.")
(Snap 'SNAPW "Saves a snapshot of a region of the screen.") (Paint 'PAINTW
(Paint 'PAINTW
"Starts a painting mode in which the mouse can be "Starts a painting mode in which the mouse can be
used to draw pictures or make notes on windows.") used to draw pictures or make notes on windows.")
(Clear 'CLEARW "Clears a window to its gray.") (Clear 'CLEARW "Clears a window to its gray.")
(Bury 'BURYW "Puts a window on the bottom.") (Bury 'BURYW "Puts a window on the bottom.")
(Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.") (Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.")
(Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN." (Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE (SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE
"Puts image on a file; prompts for filename and format") "Puts image on a file; prompts for filename and format"
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER )
"Sends image to a printer of your choosing"))) ("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
(Move 'MOVEW "Moves a window by a corner.") "Sends image to a printer of your choosing")))
(Shape 'SHAPEW "Gets a new region for a window. (Move 'MOVEW "Moves a window by a corner.")
(Shape 'SHAPEW "Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner. Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.") Middle button down moves closest corner.")
(Shrink 'SHRINKW "Replaces this window with its icon (or title if it doesn't have an icon." (Shrink 'SHRINKW
)) "Replaces this window with its icon (or title if it doesn't have an icon."
))
(ADDTOVAR BackgroundMenuCommands (ADDTOVAR BackgroundMenuCommands (SaveVM '(SAVEVM)
(SaveVM '(SAVEVM) "Updates the virtual memory.")
"Updates the virtual memory.") (Snap '(SNAPW)
(Snap '(SNAPW) "Saves a snapshot of a region of the screen.")
"Saves a snapshot of a region of the screen.") (Hardcopy '(HARDCOPYW)
(Hardcopy '(HARDCOPYW) "Send hardcopy of screen region to printer."
"Send hardcopy of screen region to printer." (SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
"Writes a region of screen to a file; prompts for filename and format" "Writes a region of screen to a file; prompts for filename and format"
) )
("To a printer" '(HARDCOPYREGION.TOPRINTER) ("To a printer" '(HARDCOPYREGION.TOPRINTER)
"Sends a region of screen to a printer of your choosing"))))
"Sends a region of screen to a printer of your choosing"
))))
(ADDTOVAR WINDOWUSERFORMS ) (ADDTOVAR WINDOWUSERFORMS )
@@ -3975,7 +3998,7 @@ Middle button down moves closest corner.")
(* ;; "Arrange for the proper compiler") (* ;; "Arrange for the proper compiler")
(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE) (PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA ) (ADDTOVAR NLAMA )
@@ -3987,42 +4010,42 @@ Middle button down moves closest corner.")
(PUTPROPS WINDOW COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 (PUTPROPS WINDOW COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1992 1993 1994 1999 2000 2021)) 1992 1993 1994 1999 2000 2021))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (11550 26190 (WINDOWWORLD 11560 . 15313) (WINDOWWORLDP 15315 . 15615) (CHANGEBACKGROUND (FILEMAP (NIL (11535 26175 (WINDOWWORLD 11545 . 15298) (WINDOWWORLDP 15300 . 15600) (CHANGEBACKGROUND
15617 . 16654) (CHANGEBACKGROUNDBORDER 16656 . 17207) (TILE 17209 . 17801) ( 15602 . 16639) (CHANGEBACKGROUNDBORDER 16641 . 17192) (TILE 17194 . 17786) (
\TTY.CREATING.DISPLAYSTREAM 17803 . 18350) (\CREATE.TTY.OUTCHARFN 18352 . 18652) ( \TTY.CREATING.DISPLAYSTREAM 17788 . 18335) (\CREATE.TTY.OUTCHARFN 18337 . 18637) (
\CREATE.TTYDISPLAYSTREAM 18654 . 21693) (HASTTYWINDOWP 21695 . 21975) (TTYINFOSTREAM 21977 . 22501) ( \CREATE.TTYDISPLAYSTREAM 18639 . 21678) (HASTTYWINDOWP 21680 . 21960) (TTYINFOSTREAM 21962 . 22486) (
CREATESCREEN 22503 . 25446) (\INSURESCREEN 25448 . 25697) (\BITMAPTOSCREEN 25699 . 26060) (MAINSCREEN CREATESCREEN 22488 . 25431) (\INSURESCREEN 25433 . 25682) (\BITMAPTOSCREEN 25684 . 26045) (MAINSCREEN
26062 . 26188)) (26837 44120 (WINDOW.MOUSE.HANDLER 26847 . 39642) (\PROTECTED.APPLY 39644 . 39892) ( 26047 . 26173)) (26822 44105 (WINDOW.MOUSE.HANDLER 26832 . 39627) (\PROTECTED.APPLY 39629 . 39877) (
DOWINDOWCOM 39894 . 41914) (DOBACKGROUNDCOM 41916 . 43074) (DEFAULT.BACKGROUND.COPYFN 43076 . 44118)) DOWINDOWCOM 39879 . 41899) (DOBACKGROUNDCOM 41901 . 43059) (DEFAULT.BACKGROUND.COPYFN 43061 . 44103))
(44201 76084 (BURYW 44211 . 44499) (CLEARW 44501 . 44891) (CLOSEW 44893 . 45667) (\CLOSEW1 45669 . (44186 76069 (BURYW 44196 . 44484) (CLEARW 44486 . 44876) (CLOSEW 44878 . 45652) (\CLOSEW1 45654 .
46022) (\OKTOCLOSEW 46024 . 46383) (\INTERACTIVE.CLOSEW 46385 . 47208) (OPENW 47210 . 48265) ( 46007) (\OKTOCLOSEW 46009 . 46368) (\INTERACTIVE.CLOSEW 46370 . 47193) (OPENW 47195 . 48250) (
DOUSERFNS 48267 . 49428) (DOUSERFNS2 49430 . 49926) (\USERFNISDON'T 49928 . 50199) (\OPENW1 50201 . DOUSERFNS 48252 . 49413) (DOUSERFNS2 49415 . 49911) (\USERFNISDON'T 49913 . 50184) (\OPENW1 50186 .
50551) (CREATEW 50553 . 51817) (CREATEW1 51819 . 54097) (\CREATEW1 54099 . 55318) (OPENDISPLAYSTREAM 50536) (CREATEW 50538 . 51802) (CREATEW1 51804 . 54082) (\CREATEW1 54084 . 55303) (OPENDISPLAYSTREAM
55320 . 55643) (MOVEW 55645 . 55860) (PPROMPT3 55862 . 56190) (\ONSCREENCLIPPINGREGION 56192 . 56743) 55305 . 55628) (MOVEW 55630 . 55845) (PPROMPT3 55847 . 56175) (\ONSCREENCLIPPINGREGION 56177 . 56728)
(RELMOVEW 56745 . 57043) (SHAPEW 57045 . 61964) (SHAPEW1 61966 . 64668) (\SHAPEW2 64670 . 67356) ( (RELMOVEW 56730 . 57028) (SHAPEW 57030 . 61949) (SHAPEW1 61951 . 64653) (\SHAPEW2 64655 . 67341) (
RESHOWBORDER 67358 . 67869) (\RESHOWBORDER1 67871 . 72797) (TRACKW 72799 . 73914) (SNAPW 73916 . 75589 RESHOWBORDER 67343 . 67854) (\RESHOWBORDER1 67856 . 72782) (TRACKW 72784 . 73899) (SNAPW 73901 . 75574
) (WINDOWREGION 75591 . 76082)) (76085 76781 (MINIMUMWINDOWSIZE 76095 . 76779)) (78428 101693 ( ) (WINDOWREGION 75576 . 76067)) (76070 76766 (MINIMUMWINDOWSIZE 76080 . 76764)) (78391 101656 (
ADVISEWDS 78438 . 86381) (SHOWWFRAME 86383 . 88135) (SHOWWTITLE 88137 . 92171) (\STRINGWIDTHGUESS ADVISEWDS 78401 . 86344) (SHOWWFRAME 86346 . 88098) (SHOWWTITLE 88100 . 92134) (\STRINGWIDTHGUESS
92173 . 92532) (RESHOWTITLE 92534 . 97175) (TOTOPW 97177 . 97416) (\INTERNALTOTOPW 97418 . 98508) ( 92136 . 92495) (RESHOWTITLE 92497 . 97138) (TOTOPW 97140 . 97379) (\INTERNALTOTOPW 97381 . 98471) (
\TTW1 98510 . 101110) (WHICHW 101112 . 101691)) (101822 104660 (WFROMDS 101832 . 103830) (NU\TOTOPWDS \TTW1 98473 . 101073) (WHICHW 101075 . 101654)) (101785 104623 (WFROMDS 101795 . 103793) (NU\TOTOPWDS
103832 . 104268) (\COERCETODS 104270 . 104658)) (105303 112103 (WINDOWP 105313 . 105459) ( 103795 . 104231) (\COERCETODS 104233 . 104621)) (105248 112048 (WINDOWP 105258 . 105404) (
INSURE.WINDOW 105461 . 105800) (WINDOWPROP 105802 . 106234) (WINDOWADDPROP 106236 . 107970) ( INSURE.WINDOW 105406 . 105745) (WINDOWPROP 105747 . 106179) (WINDOWADDPROP 106181 . 107915) (
WINDOWDELPROP 107972 . 108398) (GETWINDOWPROP 108400 . 108950) (GETWINDOWUSERPROP 108952 . 109379) ( WINDOWDELPROP 107917 . 108343) (GETWINDOWPROP 108345 . 108895) (GETWINDOWUSERPROP 108897 . 109324) (
PUTWINDOWPROP 109381 . 109846) (REMWINDOWPROP 109848 . 110903) (WINDOWADDFNPROP 110905 . 112101)) ( PUTWINDOWPROP 109326 . 109791) (REMWINDOWPROP 109793 . 110848) (WINDOWADDFNPROP 110850 . 112046)) (
112307 119871 (CWINDOWPROP 112317 . 113322) (CGETWINDOWPROP 113324 . 118542) (\GETWINDOWHEIGHT 118544 112248 119812 (CWINDOWPROP 112258 . 113263) (CGETWINDOWPROP 113265 . 118483) (\GETWINDOWHEIGHT 118485
. 119452) (\GETWINDOWWIDTH 119454 . 119869)) (119872 135320 (OPENWP 119882 . 120160) (TOPWP 120162 . . 119393) (\GETWINDOWWIDTH 119395 . 119810)) (119813 120472 (WINDOW.BITMAP 119823 . 120470)) (120498
120445) (RESHAPEBYREPAINTFN 120447 . 130699) (\INBETWEENP 130701 . 130917) ( 135946 (OPENWP 120508 . 120786) (TOPWP 120788 . 121071) (RESHAPEBYREPAINTFN 121073 . 131325) (
DECODE/WINDOW/OR/DISPLAYSTREAM 130919 . 132959) (GROW/REGION 132961 . 133524) (CLRPROMPT 133526 . \INBETWEENP 131327 . 131543) (DECODE/WINDOW/OR/DISPLAYSTREAM 131545 . 133585) (GROW/REGION 133587 .
133930) (PROMPTPRINT 133932 . 134196) (OPENWINDOWS 134198 . 134982) (\INSUREWINDOW 134984 . 135318)) ( 134150) (CLRPROMPT 134152 . 134556) (PROMPTPRINT 134558 . 134822) (OPENWINDOWS 134824 . 135608) (
135451 138700 (OVERLAPPINGWINDOWS 135461 . 137743) (WOVERLAPP 137745 . 138000) (ORDERFROMBOTTOMTOTOP \INSUREWINDOW 135610 . 135944)) (136077 139326 (OVERLAPPINGWINDOWS 136087 . 138369) (WOVERLAPP 138371
138002 . 138698)) (138749 143532 (\ONSCREENW 138759 . 139465) (\PUTONSCREENW 139467 . 140294) ( . 138626) (ORDERFROMBOTTOMTOTOP 138628 . 139324)) (139375 144158 (\ONSCREENW 139385 . 140091) (
\UPDATECACHEDFIELDS 140296 . 140560) (\WWCHANGESCREENSIZE 140562 . 141951) (CREATEWFROMIMAGE 141953 . \PUTONSCREENW 140093 . 140920) (\UPDATECACHEDFIELDS 140922 . 141186) (\WWCHANGESCREENSIZE 141188 .
142916) (UPDATEWFROMIMAGE 142918 . 143530)) (144089 196691 (\MEDW.CREATEW 144099 . 148773) ( 142577) (CREATEWFROMIMAGE 142579 . 143542) (UPDATEWFROMIMAGE 143544 . 144156)) (144715 197317 (
\MEDW.OPENW 148775 . 151133) (\MEDW.CLOSEW 151135 . 152501) (\MEDW.MOVEW 152503 . 163115) ( \MEDW.CREATEW 144725 . 149399) (\MEDW.OPENW 149401 . 151759) (\MEDW.CLOSEW 151761 . 153127) (
\MEDW.RELMOVEW 163117 . 163496) (\MEDW.SHRINKW 163498 . 171682) (\MEDW.EXPANDW 171684 . 173951) ( \MEDW.MOVEW 153129 . 163741) (\MEDW.RELMOVEW 163743 . 164122) (\MEDW.SHRINKW 164124 . 172308) (
\MEDW.SHAPEW 173953 . 178559) (\MEDW.REDISPLAYW 178561 . 180516) (\MEDW.BURYW 180518 . 181800) ( \MEDW.EXPANDW 172310 . 174577) (\MEDW.SHAPEW 174579 . 179185) (\MEDW.REDISPLAYW 179187 . 181142) (
\MEDW.TOTOPW 181802 . 183150) (\MEDW.DSPCREATE 183152 . 183953) (\GENERIC.DSPCREATE 183955 . 185672) ( \MEDW.BURYW 181144 . 182426) (\MEDW.TOTOPW 182428 . 183776) (\MEDW.DSPCREATE 183778 . 184579) (
\GENERIC.DSPCREATE.DESTINATION.BITMAP? 185674 . 185860) (\MEDW.GETWINDOWPROP 185862 . 188100) ( \GENERIC.DSPCREATE 184581 . 186298) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186300 . 186486) (
\MEDW.PUTWINDOWPROP 188102 . 194887) (\MEDW.CURSOR 194889 . 196689)) (196692 197312 (\GENERIC.CURSOR \MEDW.GETWINDOWPROP 186488 . 188726) (\MEDW.PUTWINDOWPROP 188728 . 195513) (\MEDW.CURSOR 195515 .
196702 . 197310))))) 197315)) (197318 197938 (\GENERIC.CURSOR 197328 . 197936)))))
STOP STOP

BIN
sources/WINDOW.LCOM
View File

Binary file not shown.