Compare commits
17 Commits
medley-230
...
medley-230
| Author | SHA1 | Date | |
|---|---|---|---|
|
8bb283e0c4 | ||
|
|
6fae5c14e9 | ||
|
|
c58ef4ee56 | ||
|
|
730fc5b678 | ||
|
|
8d54603329 | ||
|
21ceff5ad9 | ||
|
|
5a07e6c266 | ||
|
|
4a09d3a027 | ||
|
|
691563024b | ||
|
|
0f49e248d3 | ||
|
|
54782f5b21 | ||
|
d34522d769 | ||
|
|
c501dc82fb | ||
|
c256a8f411 | ||
|
69dbe43d87 | ||
|
|
989ec5b0b5 | ||
|
|
12b5e90727 |
@@ -105,8 +105,7 @@ dump of your system located in your home directory named
|
||||
specify a specific image to run, Medley restores that image so that
|
||||
you can continue right where you left off.
|
||||
|
||||
* [Using Medley Interlisp](https://github.com/Interlisp/medley/wiki/Using-Medley-Interlisp)
|
||||
|
||||
* [Using Medley Interlisp](https://interlisp.org/doc/info/Using.html)
|
||||
|
||||
## Naming conventions and directory structure
|
||||
|
||||
|
||||
@@ -1,11 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "22-Nov-2022 20:59:24" {DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;6 2860
|
||||
(FILECREATED "13-Apr-2023 09:44:06" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;6 2925
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
|
||||
|
||||
:PREVIOUS-DATE "22-Nov-2022 20:42:43"
|
||||
{DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;5)
|
||||
:PREVIOUS-DATE "10-Apr-2023 11:58:07" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;5
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
|
||||
@@ -22,18 +24,19 @@
|
||||
|
||||
(DWIMWAIT 180)
|
||||
(HELPDEPTH 4)
|
||||
(HELPTIME 10)
|
||||
(HELPTIME 1)
|
||||
(FILING.ENUMERATION.DEPTH 1)
|
||||
[LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
[USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT"]
|
||||
(COPYRIGHTFLG 'NEVER)
|
||||
(COPYRIGHTSRESERVED NIL)
|
||||
(AUTOBACKTRACEFLG 'ALWAYS)
|
||||
(MAXLEVEL 30000)
|
||||
(MAXLOOP 30000))
|
||||
(FNS INTERLISPMODE)
|
||||
(ALISTS (FONTDEFS LARGER))))
|
||||
(ALISTS (FONTDEFS))))
|
||||
|
||||
(LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
@@ -49,7 +52,7 @@
|
||||
|
||||
(RPAQQ HELPDEPTH 4)
|
||||
|
||||
(RPAQQ HELPTIME 10)
|
||||
(RPAQQ HELPTIME 1)
|
||||
|
||||
(RPAQQ FILING.ENUMERATION.DEPTH 1)
|
||||
|
||||
@@ -59,6 +62,8 @@
|
||||
(RPAQ USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT")))
|
||||
|
||||
(RPAQQ COPYRIGHTFLG NEVER)
|
||||
|
||||
(RPAQQ COPYRIGHTSRESERVED NIL)
|
||||
|
||||
(RPAQQ AUTOBACKTRACEFLG ALWAYS)
|
||||
@@ -84,5 +89,5 @@
|
||||
|
||||
(ADDTOVAR FONTDEFS )
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1986 2811 (INTERLISPMODE 1996 . 2809)))))
|
||||
(FILEMAP (NIL (2051 2876 (INTERLISPMODE 2061 . 2874)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
2
internal/MAINTAIN.TXT
Normal file
2
internal/MAINTAIN.TXT
Normal 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
280
library/PRESS
@@ -1,18 +1,21 @@
|
||||
(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)
|
||||
|
||||
(RPAQQ PRESSCOMS
|
||||
(RPAQQ PRESSCOMS
|
||||
[
|
||||
|
||||
(* ;;; "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")
|
||||
|
||||
(FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW WINDOW.BITMAP
|
||||
(FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW
|
||||
\WRITEPRESSBITMAP)
|
||||
|
||||
(* ;; "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)))
|
||||
((FULLPRESS RAVEN)
|
||||
(* ;
|
||||
"same as PRESS but can scale bitmaps")
|
||||
"same as PRESS but can scale bitmaps")
|
||||
(CANPRINT (PRESS))
|
||||
(STATUS TRUE)
|
||||
(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)
|
||||
(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
|
||||
[LAMBDA (BITMAP XPOS YPOS SCALEFACTOR CLIPPINGREGION PRSTREAM)
|
||||
(* ; "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)
|
||||
|
||||
(RPAQ SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch)
|
||||
ScansPerIn)))
|
||||
ScansPerIn)))
|
||||
|
||||
(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%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop
|
||||
each page.)
|
||||
PRHEADINGFONT (* Font to print the heading in)
|
||||
PRXPOS (* Current X position)
|
||||
PRYPOS (* Current Y position)
|
||||
PRFONT (* Current font)
|
||||
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
|
||||
PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
|
||||
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop each
|
||||
page.)
|
||||
PRHEADINGFONT (* Font to print the heading in)
|
||||
PRXPOS (* Current X position)
|
||||
PRYPOS (* Current Y position)
|
||||
PRFONT (* Current font)
|
||||
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
|
||||
PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
|
||||
(* Page left margin)
|
||||
(PRBOTTOM WORD) (* Page bottom margin)
|
||||
(PRRIGHT WORD) (* Page right margin)
|
||||
(PRTOP WORD) (* Page top margin)
|
||||
(PRPAGENUM WORD) (* Current Page number)
|
||||
(PRNEXTFONT# BYTE)
|
||||
(PRMAXFONTSET BYTE)
|
||||
(PRPARTSTART INTEGER)
|
||||
(DLSTARTBYTE INTEGER)
|
||||
(ELSTARTBYTE INTEGER)
|
||||
(STARTCHARBYTE INTEGER)
|
||||
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with
|
||||
vector fonts, are we moving to the
|
||||
right?)
|
||||
(VECWASDISPLAYING FLAG)
|
||||
(PRBOTTOM WORD) (* Page bottom margin)
|
||||
(PRRIGHT WORD) (* Page right margin)
|
||||
(PRTOP WORD) (* Page top margin)
|
||||
(PRPAGENUM WORD) (* Current Page number)
|
||||
(PRNEXTFONT# BYTE)
|
||||
(PRMAXFONTSET BYTE)
|
||||
(PRPARTSTART INTEGER)
|
||||
(DLSTARTBYTE INTEGER)
|
||||
(ELSTARTBYTE INTEGER)
|
||||
(STARTCHARBYTE INTEGER)
|
||||
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with
|
||||
vector fonts, are we moving to the
|
||||
right?)
|
||||
(VECWASDISPLAYING FLAG)
|
||||
|
||||
(* Used during curve/line clipping to remember whether we were on-screen or
|
||||
not, so we know when to force a SETXY.)
|
||||
(* Used during curve/line clipping to remember whether we were on-screen or not,
|
||||
so we know when to force a SETXY.)
|
||||
|
||||
VECSEGCHARS (* Cache for vector characters while
|
||||
we're moving to the left.)
|
||||
VECCURX (* Current X position within vector
|
||||
code, in Dover spots)
|
||||
VECCURY (* Current Y position with vector
|
||||
code, in Dover spots)
|
||||
PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
|
||||
(* Says whether we have been
|
||||
printing characters inside the
|
||||
clipping region)
|
||||
PRClippingRegion
|
||||
VECSEGCHARS (* Cache for vector characters while
|
||||
we're moving to the left.)
|
||||
VECCURX (* Current X position within vector
|
||||
code, in Dover spots)
|
||||
VECCURY (* Current Y position with vector
|
||||
code, in Dover spots)
|
||||
PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
|
||||
(* Says whether we have been printing
|
||||
characters inside the clipping region)
|
||||
PRClippingRegion
|
||||
|
||||
(* 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
|
||||
(* We assume that the origin is
|
||||
translated to the bottom-left of the
|
||||
page region)
|
||||
PRClippingRegion _ (create REGION
|
||||
LEFT _ SPRUCEPAPERLEFTMICAS
|
||||
BOTTOM _ SPRUCEPAPERBOTTOMMICAS
|
||||
WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS
|
||||
SPRUCEPAPERLEFTMICAS)
|
||||
HEIGHT _ 29210)
|
||||
[ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of
|
||||
DATUM)
|
||||
(fetch (PRESSDATA PRLEFT) of DATUM)))
|
||||
(PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
|
||||
(fetch (PRESSDATA PRBOTTOM) of DATUM)))
|
||||
(PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
|
||||
(PROGN (replace (PRESSDATA XPRPAGEREGION) of
|
||||
DATUM
|
||||
with NEWVALUE)
|
||||
(replace (PRESSDATA PRLEFT) of DATUM
|
||||
with (fetch (REGION LEFT) of
|
||||
NEWVALUE
|
||||
))
|
||||
(replace (PRESSDATA PRBOTTOM) of DATUM
|
||||
with (fetch (REGION BOTTOM) 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])
|
||||
)
|
||||
PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 (* We assume that the origin is
|
||||
translated to the bottom-left of the
|
||||
page region)
|
||||
PRClippingRegion _ (create REGION
|
||||
LEFT _ SPRUCEPAPERLEFTMICAS
|
||||
BOTTOM _ SPRUCEPAPERBOTTOMMICAS
|
||||
WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS
|
||||
SPRUCEPAPERLEFTMICAS)
|
||||
HEIGHT _ 29210)
|
||||
[ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of DATUM)
|
||||
(fetch (PRESSDATA PRLEFT) of DATUM)))
|
||||
(PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
|
||||
(fetch (PRESSDATA PRBOTTOM) of DATUM)))
|
||||
(PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
|
||||
(PROGN (replace (PRESSDATA XPRPAGEREGION) of DATUM
|
||||
with NEWVALUE)
|
||||
(replace (PRESSDATA PRLEFT) of DATUM
|
||||
with (fetch (REGION LEFT) of NEWVALUE))
|
||||
(replace (PRESSDATA PRBOTTOM) of DATUM
|
||||
with (fetch (REGION BOTTOM) 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#))
|
||||
)
|
||||
@@ -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? PRESSBITMAPREGION (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch))
|
||||
(TIMES 10 \MicasPerInch)))
|
||||
(TIMES 10 \MicasPerInch)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(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
|
||||
ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode
|
||||
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)
|
||||
(FONTCREATE \CREATEPRESSFONT)
|
||||
(CREATECHARSET \CREATECHARSET.PRESS)
|
||||
(FONTSAVAILABLE \SEARCHPRESSFONTS)))
|
||||
(FONTCREATE \CREATEPRESSFONT)
|
||||
(CREATECHARSET \CREATECHARSET.PRESS)
|
||||
(FONTSAVAILABLE \SEARCHPRESSFONTS)))
|
||||
|
||||
(ADDTOVAR PRINTERTYPES
|
||||
((PRESS SPRUCE PENGUIN DOVER)
|
||||
(CANPRINT (PRESS))
|
||||
(STATUS PUP.PRINTER.STATUS)
|
||||
(PROPERTIES PUP.PRINTER.PROPERTIES)
|
||||
(SEND EFTP)
|
||||
(BITMAPSCALE NIL)
|
||||
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
|
||||
((FULLPRESS RAVEN)
|
||||
(ADDTOVAR PRINTERTYPES ((PRESS SPRUCE PENGUIN DOVER)
|
||||
(CANPRINT (PRESS))
|
||||
(STATUS PUP.PRINTER.STATUS)
|
||||
(PROPERTIES PUP.PRINTER.PROPERTIES)
|
||||
(SEND EFTP)
|
||||
(BITMAPSCALE NIL)
|
||||
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
|
||||
((FULLPRESS RAVEN)
|
||||
(* ;
|
||||
"same as PRESS but can scale bitmaps")
|
||||
(CANPRINT (PRESS))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND EFTP)
|
||||
(BITMAPSCALE PRESS.BITMAPSCALE)
|
||||
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
|
||||
"same as PRESS but can scale bitmaps")
|
||||
(CANPRINT (PRESS))
|
||||
(STATUS TRUE)
|
||||
(PROPERTIES NILL)
|
||||
(SEND EFTP)
|
||||
(BITMAPSCALE PRESS.BITMAPSCALE)
|
||||
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES
|
||||
[PRESS (TEST PRESSFILEP)
|
||||
(EXTENSION (PRESS))
|
||||
(CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING)
|
||||
(SETQ FILE (OPENTEXTSTREAM FILE))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
|
||||
NIL 'PRESS)
|
||||
(CLOSEF? FILE)
|
||||
PFILE])
|
||||
(ADDTOVAR PRINTFILETYPES [PRESS (TEST PRESSFILEP)
|
||||
(EXTENSION (PRESS))
|
||||
(CONVERSION (TEXT MAKEPRESS TEDIT
|
||||
(LAMBDA (FILE PFILE FONTS HEADING)
|
||||
(SETQ FILE (OPENTEXTSTREAM FILE))
|
||||
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
|
||||
NIL 'PRESS)
|
||||
(CLOSEF? FILE)
|
||||
PFILE])
|
||||
(PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q
|
||||
3711Q 3745Q))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (16032Q 73011Q (\SEARCHPRESSFONTS 16044Q . 20001Q) (\GETPRESSFONTNAMES 20003Q . 26641Q)
|
||||
(\PRESSFAMILYCODELST 26643Q . 30565Q) (\DECODEPRESSFACEBYTE 30567Q . 33356Q) (\CREATEPRESSFONT 33360Q
|
||||
. 35625Q) (\CREATECHARSET.PRESS 35627Q . 73007Q)) (73446Q 130434Q (PRESSBITMAP 73460Q . 103062Q) (
|
||||
FULLPRESSBITMAP 103064Q . 111076Q) (SHOWREGION 111100Q . 112442Q) (SHOWPRESSBITMAPREGION 112444Q .
|
||||
113106Q) (PRESSWINDOW 113110Q . 117247Q) (WINDOW.BITMAP 117251Q . 120432Q) (\WRITEPRESSBITMAP 120434Q
|
||||
. 130432Q)) (130532Q 160405Q (\BCPLSOUT.PRESS 130544Q . 131521Q) (\PAGEPAD.PRESS 131523Q . 132760Q) (
|
||||
\ENTITYEND.PRESS 132762Q . 140256Q) (\PARTEND.PRESS 140260Q . 142645Q) (\ENTITYSTART.PRESS 142647Q .
|
||||
146260Q) (SETX.PRESS 146262Q . 150115Q) (SETXY.PRESS 150117Q . 153121Q) (SETY.PRESS 153123Q . 154523Q)
|
||||
(SHOW.PRESS 154525Q . 160403Q)) (160467Q 275304Q (OPENPRSTREAM 160501Q . 165630Q) (\BITBLT.PRESS
|
||||
165632Q . 170244Q) (\BLTSHADE.PRESS 170246Q . 171701Q) (\SCALEDBITBLT.PRESS 171703Q . 174327Q) (
|
||||
\BITMAPSIZE.PRESS 174331Q . 175271Q) (\CHARWIDTH.PRESS 175273Q . 177342Q) (\CLOSEF.PRESS 177344Q .
|
||||
207333Q) (\DRAWLINE.PRESS 207335Q . 210673Q) (\ENDPAGE.PRESS 210675Q . 212145Q) (NEWLINE.PRESS 212147Q
|
||||
. 213560Q) (NEWPAGE.PRESS 213562Q . 214054Q) (SETUPFONTS.PRESS 214056Q . 217607Q) (\DEFINEFONT.PRESS
|
||||
217611Q . 221733Q) (\DSPBOTTOMMARGIN.PRESS 221735Q . 222531Q) (\DSPCLIPPINGREGION.PRESS 222533Q .
|
||||
224125Q) (\DSPFONT.PRESS 224127Q . 231121Q) (\DSPLEFTMARGIN.PRESS 231123Q . 232003Q) (
|
||||
\DSPLINEFEED.PRESS 232005Q . 233315Q) (\DSPRIGHTMARGIN.PRESS 233317Q . 234202Q) (\DSPSPACEFACTOR.PRESS
|
||||
234204Q . 235610Q) (\DSPTOPMARGIN.PRESS 235612Q . 236375Q) (\DSPXPOSITION.PRESS 236377Q . 237115Q) (
|
||||
\DSPYPOSITION.PRESS 237117Q . 237635Q) (\FIXLINELENGTH.PRESS 237637Q . 241734Q) (\OUTCHARFN.PRESS
|
||||
241736Q . 250772Q) (\SETSPACE.PRESS 250774Q . 252270Q) (\STARTPAGE.PRESS 252272Q . 256633Q) (
|
||||
\STRINGWIDTH.PRESS 256635Q . 272213Q) (SHOWRECTANGLE.PRESS 272215Q . 272736Q) (
|
||||
\PRESS.CONVERT.NSCHARACTER 272740Q . 275302Q)) (275344Q 406406Q (\ENDVECRUN 275356Q . 305174Q) (
|
||||
\VECENCODE 305176Q . 306225Q) (\VECPUT 306227Q . 315655Q) (\VECSKIP 315657Q . 316412Q) (\VECFONTINIT
|
||||
316414Q . 323537Q) (\DRAWCIRCLE.PRESS 323541Q . 326044Q) (\DRAWARC.PRESS 326046Q . 326637Q) (
|
||||
\DRAWCURVE.PRESS 326641Q . 334577Q) (\DRAWCURVE.PRESS.LINE 334601Q . 343446Q) (\DRAWELLIPSE.PRESS
|
||||
343450Q . 347227Q) (\GETBRUSHFONT.PRESS 347231Q . 351133Q) (\PRESSCURVE2 351135Q . 406404Q)) (412244Q
|
||||
417070Q (\PRESSINIT 412256Q . 417066Q)) (446754Q 452043Q (MAKEPRESS 446766Q . 447272Q) (PRESSFILEP
|
||||
447274Q . 451051Q) (PRESS.BITMAPSCALE 451053Q . 452041Q)))))
|
||||
(FILEMAP (NIL (15752Q 72731Q (\SEARCHPRESSFONTS 15764Q . 17721Q) (\GETPRESSFONTNAMES 17723Q . 26561Q)
|
||||
(\PRESSFAMILYCODELST 26563Q . 30505Q) (\DECODEPRESSFACEBYTE 30507Q . 33276Q) (\CREATEPRESSFONT 33300Q
|
||||
. 35545Q) (\CREATECHARSET.PRESS 35547Q . 72727Q)) (73366Q 127171Q (PRESSBITMAP 73400Q . 103002Q) (
|
||||
FULLPRESSBITMAP 103004Q . 111016Q) (SHOWREGION 111020Q . 112362Q) (SHOWPRESSBITMAPREGION 112364Q .
|
||||
113026Q) (PRESSWINDOW 113030Q . 117167Q) (\WRITEPRESSBITMAP 117171Q . 127167Q)) (127267Q 157142Q (
|
||||
\BCPLSOUT.PRESS 127301Q . 130256Q) (\PAGEPAD.PRESS 130260Q . 131515Q) (\ENTITYEND.PRESS 131517Q .
|
||||
137013Q) (\PARTEND.PRESS 137015Q . 141402Q) (\ENTITYSTART.PRESS 141404Q . 145015Q) (SETX.PRESS 145017Q
|
||||
. 146652Q) (SETXY.PRESS 146654Q . 151656Q) (SETY.PRESS 151660Q . 153260Q) (SHOW.PRESS 153262Q .
|
||||
157140Q)) (157224Q 274041Q (OPENPRSTREAM 157236Q . 164365Q) (\BITBLT.PRESS 164367Q . 167001Q) (
|
||||
\BLTSHADE.PRESS 167003Q . 170436Q) (\SCALEDBITBLT.PRESS 170440Q . 173064Q) (\BITMAPSIZE.PRESS 173066Q
|
||||
. 174026Q) (\CHARWIDTH.PRESS 174030Q . 176077Q) (\CLOSEF.PRESS 176101Q . 206070Q) (\DRAWLINE.PRESS
|
||||
206072Q . 207430Q) (\ENDPAGE.PRESS 207432Q . 210702Q) (NEWLINE.PRESS 210704Q . 212315Q) (NEWPAGE.PRESS
|
||||
212317Q . 212611Q) (SETUPFONTS.PRESS 212613Q . 216344Q) (\DEFINEFONT.PRESS 216346Q . 220470Q) (
|
||||
\DSPBOTTOMMARGIN.PRESS 220472Q . 221266Q) (\DSPCLIPPINGREGION.PRESS 221270Q . 222662Q) (\DSPFONT.PRESS
|
||||
222664Q . 227656Q) (\DSPLEFTMARGIN.PRESS 227660Q . 230540Q) (\DSPLINEFEED.PRESS 230542Q . 232052Q) (
|
||||
\DSPRIGHTMARGIN.PRESS 232054Q . 232737Q) (\DSPSPACEFACTOR.PRESS 232741Q . 234345Q) (
|
||||
\DSPTOPMARGIN.PRESS 234347Q . 235132Q) (\DSPXPOSITION.PRESS 235134Q . 235652Q) (\DSPYPOSITION.PRESS
|
||||
235654Q . 236372Q) (\FIXLINELENGTH.PRESS 236374Q . 240471Q) (\OUTCHARFN.PRESS 240473Q . 247527Q) (
|
||||
\SETSPACE.PRESS 247531Q . 251025Q) (\STARTPAGE.PRESS 251027Q . 255370Q) (\STRINGWIDTH.PRESS 255372Q .
|
||||
270750Q) (SHOWRECTANGLE.PRESS 270752Q . 271473Q) (\PRESS.CONVERT.NSCHARACTER 271475Q . 274037Q)) (
|
||||
274101Q 405143Q (\ENDVECRUN 274113Q . 303731Q) (\VECENCODE 303733Q . 304762Q) (\VECPUT 304764Q .
|
||||
314412Q) (\VECSKIP 314414Q . 315147Q) (\VECFONTINIT 315151Q . 322274Q) (\DRAWCIRCLE.PRESS 322276Q .
|
||||
324601Q) (\DRAWARC.PRESS 324603Q . 325374Q) (\DRAWCURVE.PRESS 325376Q . 333334Q) (
|
||||
\DRAWCURVE.PRESS.LINE 333336Q . 342203Q) (\DRAWELLIPSE.PRESS 342205Q . 345764Q) (\GETBRUSHFONT.PRESS
|
||||
345766Q . 347670Q) (\PRESSCURVE2 347672Q . 405141Q)) (410775Q 415621Q (\PRESSINIT 411007Q . 415617Q))
|
||||
(443570Q 446657Q (MAKEPRESS 443602Q . 444106Q) (PRESSFILEP 444110Q . 445665Q) (PRESS.BITMAPSCALE
|
||||
445667Q . 446655Q)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,16 +1,14 @@
|
||||
(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)
|
||||
|
||||
: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)
|
||||
|
||||
(RPAQQ SYSEDITCOMS
|
||||
@@ -22,7 +20,7 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
(CLISPIFTRANFLG T)
|
||||
(CROSSCOMPILING 'ASK)
|
||||
(*REPLACE-OLD-EDIT-DATES* NIL)
|
||||
(COPYRIGHTFLG 'PRESERVE))
|
||||
(COPYRIGHTFLG 'NEVER))
|
||||
(P (RESETVARS ((CROSSCOMPILING T))
|
||||
(FILESLOAD (SOURCE)
|
||||
EXPORTS.ALL])
|
||||
@@ -43,12 +41,11 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ *REPLACE-OLD-EDIT-DATES* NIL)
|
||||
|
||||
(RPAQQ COPYRIGHTFLG PRESERVE)
|
||||
(RPAQQ COPYRIGHTFLG NEVER)
|
||||
|
||||
(RESETVARS ((CROSSCOMPILING T))
|
||||
(FILESLOAD (SOURCE)
|
||||
EXPORTS.ALL))
|
||||
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
272
lispusers/GITFNS
272
lispusers/GITFNS
@@ -1,12 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Oct-2022 10:55:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;454 118392
|
||||
(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}<lispusers>GITFNS.;469 119763
|
||||
|
||||
:CHANGES-TO (COMMANDS cdg cdw)
|
||||
:CHANGES-TO (FNS GIT-MAKE-PROJECT)
|
||||
|
||||
:PREVIOUS-DATE " 1-Oct-2022 12:14:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;453)
|
||||
:PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}<lispusers>GITFNS.;468)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -23,18 +21,20 @@
|
||||
|
||||
(* ;; "GIT projects")
|
||||
|
||||
(COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH
|
||||
FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?)
|
||||
(COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD
|
||||
GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH
|
||||
GIT-MAINBRANCH?)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT PULLREQUEST))
|
||||
(INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
[GIT-DEFAULT-PROJECTS '((MEDLEY T T
|
||||
[GIT-DEFAULT-PROJECTS '((MEDLEY NIL NIL
|
||||
(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/
|
||||
tmp/ fontsold/ clos/ cltl2/)
|
||||
(greetfiles scripts sources library lispusers
|
||||
internal doctools rooms))
|
||||
(NOTECARDS T T)
|
||||
(LOOPS T T)
|
||||
(TEST T T]
|
||||
(NOTECARDS)
|
||||
(LOOPS)
|
||||
(TEST)
|
||||
(MAIKO]
|
||||
(GIT-PROJECTS NIL)))
|
||||
(P (GIT-INIT))
|
||||
(ADDVARS (AROUNDEXITFNS GIT-INIT))
|
||||
@@ -151,71 +151,82 @@
|
||||
ELSE (ERROR "NOT A GIT CLONE" HOST/DIR])
|
||||
|
||||
(GIT-INIT
|
||||
[LAMBDA (EVENT) (* ; "Edited 1-Oct-2022 12:13 by FGH")
|
||||
[LAMBDA (EVENT) (* ; "Edited 1-Feb-2023 16:22 by rmk")
|
||||
(* ; "Edited 1-Oct-2022 12:13 by FGH")
|
||||
(* ; "Edited 8-Aug-2022 21:52 by lmm")
|
||||
(SELECTQ EVENT
|
||||
((NIL AFTERMAKESYS AFTERSYSOUT)
|
||||
(SETQ GIT-PROJECTS NIL)
|
||||
(for X in GIT-DEFAULT-PROJECTS do (APPLY (FUNCTION GIT-MAKE-PROJECT)
|
||||
X))
|
||||
(MKLIST X)))
|
||||
NIL)
|
||||
NIL])
|
||||
|
||||
(GIT-MAKE-PROJECT
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
|
||||
(* ; "Edited 30-Mar-2023 09:06 by rmk")
|
||||
(* ; "Edited 5-Feb-2023 12:43 by rmk")
|
||||
(* ; "Edited 1-Feb-2023 16:55 by rmk")
|
||||
(* ; "Edited 11-Aug-2022 17:54 by rmk")
|
||||
(* ; "Edited 13-Jul-2022 13:47 by rmk")
|
||||
(* ; "Edited 6-Jul-2022 19:34 by rmk")
|
||||
(* ; "Edited 17-May-2022 17:08 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 12-May-2022 00:26 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:20 by rmk")
|
||||
|
||||
(* ;; "PROJECTPATH must resolve to a git clone.")
|
||||
(* ;; "CLONEPATH must resolve to a git clone.")
|
||||
|
||||
(* ;; "Search sequence for PROJECTPATH, if T or NIL")
|
||||
(* ;; " (UNIX-GETENV PROJECTNAME) Unix variable ROOMS is the full path name.")
|
||||
|
||||
(* ;; " (UNIX-GETENV PROJECTNAME)")
|
||||
(* ;; " (MEDLEYDIR PROJECTNAME) e.g. {dsk}/Users/kaplan/medley3.5/loops/")
|
||||
|
||||
(* ;; " (UNIX-GETENV (CONCAT PROJECTNAME DIR)")
|
||||
(* ;;
|
||||
" (MEDLEYDIR (CONCAT %"git-%" PROJECTNAME) e.g. {dsk}/Users/kaplan/medley3.5/git-medley/")
|
||||
|
||||
(* ;; " git-PROJECTNAME sister of MEDLEYDIR ")
|
||||
(* ;;
|
||||
" (MEDLEYDIR (CONCAT PROJECTNAME %"DIR%") e.g. {dsk}/Users/kaplan/medley3.5/notecardsdir/")
|
||||
|
||||
(* ;; "If not found, error if NIL, return NIL if T ")
|
||||
(* ;; " (MEDLEYDIR (CONCAT %"git-%" PROJECTNAME) ")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "The clone pseudohost is PROJECTNAME e.g. {NOTECARDS}")
|
||||
|
||||
(* ;; "If there is a >working-PROJECTNAME> parallel to clonepath, its pseudhost is WPROJECTNAME, e.g. WNOTECARDS")
|
||||
|
||||
(* ;; "Error if clone is not found.")
|
||||
|
||||
(* ;; "WORKINGPATH T or NIL means try to find a parallel to the projectpath, T means don't cause an error if not found. ")
|
||||
|
||||
(SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME)))
|
||||
(CL:WHEN (MEMB PROJECTPATH '(NIL T))
|
||||
[SETQ PROJECTPATH (OR (GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME)
|
||||
NIL NIL T)
|
||||
T)
|
||||
(GIT-CLONEP (UNIX-GETENV PROJECTNAME)
|
||||
T)
|
||||
(GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME 'DIR))
|
||||
T)
|
||||
(GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE
|
||||
PROJECTNAME
|
||||
)
|
||||
"/"))
|
||||
T)
|
||||
(AND (NULL PROJECTPATH)
|
||||
(ERROR (CONCAT "Can't a find clone directory for " PROJECTNAME])
|
||||
(CL:WHEN PROJECTPATH
|
||||
(LET (CLONEPATH GITIGNORE PROJECT GITPATH WP)
|
||||
(SETQ PROJECTPATH (SLASHIT (PACKFILENAME 'HOST 'UNIX 'DIRECTORY (UNPACKFILENAME.STRING
|
||||
(TRUEFILENAME
|
||||
PROJECTPATH)
|
||||
'DIRECTORY
|
||||
'RETURN))
|
||||
T))
|
||||
(SETQ CLONEPATH (if (GIT-CLONEP PROJECTPATH T T)
|
||||
elseif (SETQ GITPATH (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH))
|
||||
then (SETQ PROJECTPATH GITPATH)
|
||||
(GIT-CLONEP PROJECTPATH NIL T)
|
||||
else (ERROR "Can't find GIT clone for" PROJECTPATH)))
|
||||
[SETQ CLONEPATH (if (MEMB CLONEPATH '(NIL T))
|
||||
then
|
||||
(* ;; "The %"DIR%" handles MEDLEY -> MEDLEYDIR or LOOPS -> LOOPSDIR.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME)
|
||||
T)
|
||||
(GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME "DIR"))
|
||||
T)
|
||||
(GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME)
|
||||
NIL NIL T)
|
||||
T)
|
||||
(GIT-CLONEP (MEDLEYDIR (CONCAT "../" PROJECTNAME)
|
||||
NIL NIL T)
|
||||
T)
|
||||
(GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE
|
||||
PROJECTNAME)
|
||||
"/"))
|
||||
T)
|
||||
(CL:IF CLONEPATH
|
||||
(ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME))
|
||||
(PRINTOUT T "Note: Can't find a clone directory for "
|
||||
PROJECTNAME T)))
|
||||
elseif (GIT-CLONEP (SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY
|
||||
(UNPACKFILENAME.STRING (TRUEFILENAME
|
||||
CLONEPATH)
|
||||
'DIRECTORY
|
||||
'RETURN))
|
||||
T)
|
||||
T T)
|
||||
else (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for "
|
||||
PROJECTNAME]
|
||||
(CL:WHEN CLONEPATH
|
||||
(LET (GITIGNORE PROJECT WP)
|
||||
(CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY
|
||||
CLONEPATH)))
|
||||
(SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE)
|
||||
@@ -231,58 +242,39 @@
|
||||
:TEST
|
||||
(FUNCTION STRING.EQUAL)))
|
||||
|
||||
(* ;; "The %"my-%" case is for backward compatibility, eventually deprecated.")
|
||||
(* ;; "We now have the clonepath and the extra parameters for the project. Do we have a separate working environment?")
|
||||
|
||||
(SETQ WP
|
||||
(SELECTQ WORKINGPATH
|
||||
((T NIL)
|
||||
(OR (DIRECTORYNAME (PACKFILENAME.STRING
|
||||
'HOST
|
||||
'DSK
|
||||
'BODY
|
||||
(CONCAT (SUBSTRING CLONEPATH 1
|
||||
(STRPOS "/" CLONEPATH -2 NIL NIL NIL
|
||||
FILEDIRCASEARRAY T))
|
||||
"working-"
|
||||
(OR (SUBSTRING PROJECTPATH
|
||||
(OR (STRPOS CLONEPATH PROJECTPATH 1 NIL
|
||||
NIL T FILEDIRCASEARRAY)
|
||||
-2))
|
||||
(L-CASE PROJECTNAME))
|
||||
">"))
|
||||
T)
|
||||
(DIRECTORYNAME (PACKFILENAME.STRING
|
||||
'HOST
|
||||
'DSK
|
||||
'BODY
|
||||
(CONCAT (SUBSTRING CLONEPATH 1
|
||||
(STRPOS "/" CLONEPATH -2 NIL NIL NIL
|
||||
FILEDIRCASEARRAY T))
|
||||
"my-"
|
||||
(OR (SUBSTRING PROJECTPATH
|
||||
(OR (STRPOS CLONEPATH PROJECTPATH 1 NIL
|
||||
NIL T FILEDIRCASEARRAY)
|
||||
-2))
|
||||
(L-CASE PROJECTNAME))
|
||||
">"))
|
||||
T)))
|
||||
(DIRECTORYNAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY
|
||||
(CONCAT (SUBSTRING CLONEPATH 1
|
||||
(STRPOS "/" CLONEPATH -2 NIL NIL NIL
|
||||
FILEDIRCASEARRAY T))
|
||||
"working-"
|
||||
(OR (SUBSTRING CLONEPATH
|
||||
(OR (STRPOS CLONEPATH CLONEPATH 1 NIL
|
||||
NIL T FILEDIRCASEARRAY)
|
||||
-2))
|
||||
(L-CASE PROJECTNAME))
|
||||
">"))
|
||||
T))
|
||||
(DIRECTORYNAME (TRUEFILENAME WORKINGPATH)
|
||||
T)))
|
||||
[SETQ WORKINGPATH (if WP
|
||||
then (UNSLASHIT WP T)
|
||||
elseif (EQ WORKINGPATH T)
|
||||
then NIL
|
||||
else (ERROR (CONCAT "Can't find the working directory "
|
||||
(OR WORKINGPATH "")
|
||||
" for " PROJECTNAME]
|
||||
elseif WORKINGPATH
|
||||
then (ERROR (CONCAT "Can't find the working directory "
|
||||
(AND (EQ WORKINGPATH T)
|
||||
"")
|
||||
" for " PROJECTNAME]
|
||||
(SETQ PROJECT (create GIT-PROJECT
|
||||
PROJECTNAME _ PROJECTNAME
|
||||
GITHOST _ (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
|
||||
PROJECTPATH)
|
||||
GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
|
||||
"}")
|
||||
WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
|
||||
PROJECTNAME)
|
||||
WP)
|
||||
WORKINGPATH)
|
||||
"}"))
|
||||
EXCLUSIONS _ EXCLUSIONS
|
||||
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
|
||||
@@ -321,6 +313,34 @@
|
||||
])
|
||||
PROJECT))])
|
||||
|
||||
(GIT-PUT-PROJECT-FIELD
|
||||
[LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 11:25 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 9-May-2022 20:02 by rmk")
|
||||
(* ; "Edited 8-May-2022 11:38 by rmk")
|
||||
|
||||
(* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings")
|
||||
|
||||
(CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT)
|
||||
THEN PROJECT
|
||||
ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT)
|
||||
GIT-DEFAULT-PROJECT)
|
||||
GIT-PROJECTS))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "NOT A GIT-PROJECT" PROJECT)))
|
||||
(SELECTQ FIELD
|
||||
(PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE))
|
||||
(WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE))
|
||||
(GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE))
|
||||
(EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE))
|
||||
(DEFAULTSUBDIRS
|
||||
(REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE))
|
||||
(CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE))
|
||||
(MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE))
|
||||
PROJECT))])
|
||||
|
||||
(GIT-PROJECT-PATH
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk")
|
||||
|
||||
@@ -391,11 +411,12 @@
|
||||
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
|
||||
|
||||
(RPAQ? GIT-DEFAULT-PROJECTS
|
||||
'((MEDLEY T T (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
|
||||
'((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
|
||||
(greetfiles scripts sources library lispusers internal doctools rooms))
|
||||
(NOTECARDS T T)
|
||||
(LOOPS T T)
|
||||
(TEST T T)))
|
||||
(NOTECARDS)
|
||||
(LOOPS)
|
||||
(TEST)
|
||||
(MAIKO)))
|
||||
|
||||
(RPAQ? GIT-PROJECTS NIL)
|
||||
|
||||
@@ -2213,31 +2234,32 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3970 19443 (GIT-CLONEP 3980 . 5243) (GIT-INIT 5245 . 5757) (GIT-MAKE-PROJECT 5759 .
|
||||
14144) (GIT-GET-PROJECT 14146 . 16071) (GIT-PROJECT-PATH 16073 . 17117) (FIND-ANCESTOR-DIRECTORY 17119
|
||||
. 17468) (GIT-FIND-CLONE 17470 . 18551) (GIT-MAINBRANCH 18553 . 18948) (GIT-MAINBRANCH? 18950 . 19441
|
||||
)) (25861 28649 (ALLSUBDIRS 25871 . 27157) (MEDLEYSUBDIRS 27159 . 27852) (GITSUBDIRS 27854 . 28647)) (
|
||||
28650 33440 (TOGIT 28660 . 30066) (FROMGIT 30068 . 31049) (GIT-DELETE-FILE 31051 . 31897) (
|
||||
MYMEDLEY-DELETE-FILES 31899 . 33438)) (33441 36444 (MYMEDLEYSUBDIR 33451 . 33907) (GITSUBDIR 33909 .
|
||||
34352) (STRIPDIR 34354 . 34725) (STRIPHOST 34727 . 34967) (STRIPNAME 34969 . 35722) (STRIPWHERE 35724
|
||||
. 36442)) (36445 38347 (GFILE4MFILE 36455 . 36818) (MFILE4GFILE 36820 . 37389) (GIT-REPO-FILENAME
|
||||
37391 . 38345)) (38396 48218 (GIT-COMMIT 38406 . 39232) (GIT-PUSH 39234 . 39878) (GIT-PULL 39880 .
|
||||
40492) (GIT-APPROVAL 40494 . 40843) (GIT-GET-FILE 40845 . 42810) (GIT-FILE-EXISTS? 42812 . 43086) (
|
||||
GIT-REMOTE-UPDATE 43088 . 43812) (GIT-REMOTE-ADD 43814 . 44121) (GIT-FILE-DATE 44123 . 45054) (
|
||||
GIT-FILE-HISTORY 45056 . 46990) (GIT-PRINT-FILE-HISTORY 46992 . 48042) (GIT-FETCH 48044 . 48216)) (
|
||||
48248 58841 (GIT-BRANCH-DIFF 48258 . 54598) (GIT-COMMIT-DIFFS 54600 . 55153) (GIT-BRANCH-RELATIONS
|
||||
55155 . 58839)) (58886 71118 (GIT-BRANCH-NUM 58896 . 59469) (GIT-CHECKOUT 59471 . 60530) (
|
||||
GIT-WHICH-BRANCH 60532 . 60830) (GIT-MAKE-BRANCH 60832 . 63045) (GIT-BRANCHES 63047 . 65315) (
|
||||
GIT-BRANCH-EXISTS? 65317 . 66021) (GIT-PICK-BRANCH 66023 . 66351) (GIT-PRC-MENU 66353 . 68356) (
|
||||
GIT-PULL-REQUESTS 68358 . 70504) (GIT-SHORT-BRANCH-NAME 70506 . 70797) (GIT-LONG-NAME 70799 . 71116))
|
||||
(71148 74483 (GIT-MY-CURRENT-BRANCH 71158 . 71528) (GIT-MY-BRANCHP 71530 . 72035) (GIT-MY-NEXT-BRANCH
|
||||
72037 . 72531) (GIT-MY-BRANCHES 72533 . 74481)) (74529 78481 (GIT-ADD-WORKTREE 74539 . 76023) (
|
||||
GIT-REMOVE-WORKTREE 76025 . 76955) (GIT-LIST-WORKTREES 76957 . 77761) (WORKTREEDIR 77763 . 78479)) (
|
||||
78529 109738 (GIT-GET-DIFFERENT-FILES 78539 . 84963) (GIT-BRANCHES-COMPARE-DIRECTORIES 84965 . 91122)
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES 91124 . 95950) (GIT-COMPARE-WORKTREE 95952 . 99930) (GITCDOBJBUTTONFN
|
||||
99932 . 104422) (GIT-CD-LABELFN 104424 . 105506) (GIT-CD-MENUFN 105508 . 107948) (
|
||||
GIT-WORKING-COMPARE-FILES 107950 . 108570) (GIT-BRANCHES-COMPARE-FILES 108572 . 109736)) (109808
|
||||
118325 (CDGITDIR 109818 . 110378) (GIT-COMMAND 110380 . 111938) (GITORIGIN 111940 . 112637) (
|
||||
GIT-INITIALS 112639 . 112943) (GIT-COMMAND-TO-FILE 112945 . 116434) (PROCESS-COMMAND 116436 . 117049)
|
||||
(GIT-RESULT-TO-LINES 117051 . 117658) (STRIPLOCAL 117660 . 118323)))))
|
||||
(FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 .
|
||||
13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435
|
||||
. 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915
|
||||
. 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS
|
||||
28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420)
|
||||
(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR
|
||||
34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME
|
||||
36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE
|
||||
38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH
|
||||
40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) (
|
||||
GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) (
|
||||
GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) (
|
||||
GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524
|
||||
) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT
|
||||
60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 .
|
||||
66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727)
|
||||
(GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487)
|
||||
) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) (
|
||||
GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE
|
||||
75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR
|
||||
79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) (
|
||||
GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 .
|
||||
106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) (
|
||||
GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND
|
||||
111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE
|
||||
114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL
|
||||
119031 . 119694)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,95 +1,148 @@
|
||||
Medley GITFNS2
|
||||
Medley GITFNS
2
|
||||
4
|
||||
1
|
||||
GITFNS
1
|
||||
4
|
||||
By Ron Kaplan
This document was last edited in May 2022.
GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository. This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file. This may be particularly helpful in evaluating the changes in a pull request.
|
||||
Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions. GITFNS allows for intelligent comparisons between Lisp source files,Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
|
||||
By Ron Kaplan
This document was last edited in February 2023.
GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository. This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file. This may be particularly helpful in evaluating the changes in a pull request.
|
||||
Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions. GITFNS allows for intelligent comparisons between Lisp source files, Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
|
||||
|
||||
Git projects: Connecting git clones to GITFNS capabilities
|
||||
The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk. The path to a clone can be used to create a "git project" for that clone:
|
||||
(GIT-MAKE-PROJECT PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS
|
||||
DEFAULTSUBDIRS) [function]
|
||||
The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk. The path to a clone can be used to create a GITFNS "project" for that clone:
|
||||
(GIT-MAKE-PROJECT PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS
|
||||
DEFAULTSUBDIRS) [Function]
|
||||
where
|
||||
PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...)
|
||||
PROJECTPATH is the local path to the clone
|
||||
(e.g. {dsk}<users>...>git-medley)
|
||||
PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...)
|
||||
CLONEPATH specifies the local path to the clone
|
||||
e.g. {dsk}<users>...>git-medley
|
||||
WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}<users>...>working-medley>)
|
||||
When the project has a WORKINGPATH:
|
||||
EXCLUSIONS is a list of files and directories to be excluded from comparisons (beyond what its .GITIGNORE specifies)
|
||||
When the project has a working path:
|
||||
EXCLUSIONS is a list of files and directories to be excluded from comparisons (including what its .gitignore specifies)
|
||||
DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified.
|
||||
|
||||
For convenience, if PROJECTPATH is NIL or T (and not a path), then a squence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
|
||||
(UNIX-GETENV PROJECTNAME)
|
||||
(UNIX-GETENV (CONCAT PROJECTNAME 'DIR)
|
||||
(CONCAT MEDLEYDIR "../git-" PROJECTNAME)
|
||||
For convenience, if CLONEPATH is NIL or T (and not a path), then a sequence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
|
||||
(UNIX-GETENV PROJECTNAME) e.g. (UNIX-GETENV 'LOOPS)
|
||||
(UNIX-GETENV (CONCAT PROJECTNAME "DIR") e.g.{UNIX-GETENV 'LOOPSDIR)
|
||||
(MEDLEYDIR PROJECTNAME)) a subdirectory of MEDLEYDIR
|
||||
(MEDLEYDIR (CONCAT "../" PROJECTNAME)) a sister of MEDLEYDIR
|
||||
(MEDLEYDIR (CONCAT "../git-" PROJECTNAME)
|
||||
(a sister of MEDLEYDIR named git-PROJECTNAME, e.g. git-notecards)
|
||||
Thus:
|
||||
If MEDLEYDIR is defined,
|
||||
(GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project
|
||||
(GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project
|
||||
If NOTECARDS is defined
|
||||
(GIT-MAKE-PROJECT 'NOTECARDS) will make the NOTECARDS project
|
||||
If NOTECARDS is not defined but the clone >git-notecards> is a sister of MEDLEYDIR, then the NOTECARDS project will still be created.
|
||||
If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME. Otherwise, NIL will be returned if PROJECTPATH is T (= no-error), and PROJECTPATH=NIL will result in an error.
|
||||
If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME. Otherwise, NIL will be returned if CLONEPATH is T (= no-error), and CLONEPATH=NIL will result in an error.
|
||||
When they are created, git projects are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
|
||||
The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional PROJECTNAME argument is not provided.
|
||||
GIT-MAKE-PROJECT creates a pseudohost {projectname} whose path prefix is the path that resolved to the clone. The file GITFNS in the clone LISPUSERS directory, for example, can be referenced as {MEDLEY}<LISPUSERS>GITFNS.
|
||||
GIT-MAKE-PROJECT will also create a pseudohost {Wprojectname} for the user's working environment for the project. If WORKINGPATH is provided, that will be the prefix for that pseudohost. If WORKINGPATH is NIL and a directory named working-projectname> is a sister to the clone directory, the pseudohost will point to that.
|
||||
|
||||
When GITFNS is loaded, GIT-MAKE-PROJECT is called for MEDLEY, NOTECARDS, and LOOPS, with PROJECTPATH=T. Thus, those projects will be created automatically, if MEDLEYDIR is defined and the relevant directories exist in their expected relative positions.
|
||||
When they are created, GIT-PROJECTS are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
|
||||
The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional projectname argument is not provided.
|
||||
GIT-MAKE-PROJECT also creates a pseudohost {Gprojectname} whose path prefix is the prefix for the project's clone. If WORKINGPATH is provided, then a second pseudohost {Wprojectname} points to the working files for the project.
|
||||
GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
|
||||
cdg (projectname) (subdir) [command]
|
||||
cdw (projectname) (subdir) [command
|
||||
For example, cdg notecards library connects to {GNOTECARDS}/library/.
|
||||
(GIT-INIT EVENT) [Function]
|
||||
GIT-INIT creates the default set of projects when GITFNS is loaded, as specified in the variable GIT-DEFAULT-PROJECTS, initially containing MEDLEY NOTECARDS LOOPS TEST. GIT-INIT is added to AROUNDEXITFNS so that new pseudohost bindings for the default projects will be created if the sysout or makesys is started on a new machine.
|
||||
|
||||
GIT-DEFAULT-PROJECTS [Variable]
|
||||
Determines the projects that are created (or recreated) by GIT-INIT. This is initialized for the MEDLEY NOTECARDS LOOPS TEST projects, with CLONEPATH=NIL
GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
|
||||
cdg (projectname) (subdir) [Command]
|
||||
cdw (projectname) (subdir) [Command]
|
||||
For example, cdg notecards library connects to {NOTECARDS}/library/.
|
||||
|
||||
Comparing directories and files in different git branches
|
||||
In its simplest application, GITFNS is just an off-to-the-side add-on to whatever work practices the user has developed with respect to a locally installed git project. Its only advantage is to allow for more interpretable git-branch comparisons, especially for pull-request approval. These comparisons are provided by the prc ("pull request compare") Medley executive command:
|
||||
prc (branch) (DRAFT) (projectname) [command]
|
||||
This compares the files in branch against the files in the main branch of the project (origin/master or origin/main). Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project. Then
|
||||
prc rmk15
|
||||
prc (branch) (DRAFT) (projectname) [Command]
This compares the files in branch against the files in the main branch of the project (origin/master or origin/main). Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project. Then
prc rmk15
|
||||
brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser.
|
||||
If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided. If gh is not available, the menu will offer all known branches. If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones.
|
||||
If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by
|
||||
rmk15 > rmk14
|
||||
Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
|
||||
|
||||
prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
|
||||
bbc branch1 branch2 (project) [command]
|
||||
This compares the files in branch1 and branch2, for example
|
||||
Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
prc is the special case of the more general bbc command ("branch-branch compare") for comparing the files in any two branches:
|
||||
bbc branch1 branch2 (project) [Command]
This compares the files in branch1 and branch2, for example
|
||||
bbc rmk15 lmm12 (local)
|
||||
This will compare the files in origin/rmk15 and origin/lmm12 in the GIT-DEFAULT project. branch1 defaults to the origin files of the currently checked out branch, the second defaults to origin/master. If local is non-NIL, then a branch that has neither local/ or origin/ prepended will default to local (e.g. local/rmk15) instead of origin/. Local refers to the files that are currently in the clone directory, which may not be the same as the origin files, depending on the push/pull status.
|
||||
Either of the branches can be specified with an atom LOCAL, REMOTE, or ORIGIN, in which case bbc will offer menus listing the currently existing branches of that type.
|
||||
NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare. A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally.
|
||||
|
||||
The command cob ("check out branch") checks out a specified branch:
|
||||
cob branch (nexttitlestring) (project) [command]
|
||||
NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare. A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally.
The command cob ("check out branch") checks out a specified branch:
|
||||
cob branch (next-title-string) (project) [Command]
|
||||
This checks out branch of project and then executes git pull. The branch parameter may also be a local branch, T (= the current working branch), or NEW/NEXT (= the next working branch). The current working branch is the branch named <initials>nnn, e.g. rmk15. The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials.
|
||||
If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. If nexttitlestring is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens. Spaces in nexttitlestring will also be replaced by hyphens, according to git conventions.
|
||||
If branch is not provided, a menu of locally available branches pops up.
|
||||
|
||||
The currently checked out branch is obtained by the b? command:
|
||||
b? (project) [command]
|
||||
|
||||
If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. If next-title-string is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens. Spaces in next-title-string will also be replaced by hyphens, according to git conventions.
|
||||
If branch is not provided, a menu of locally available branches pops up.
The currently checked out branch is obtained by the b? command:
|
||||
b? (project) [Command]
|
||||
Correlating git source control with separate Medley development
|
||||
It is generally unsafe to do Medley development by operating with files in a local clone repository. Medley provides a residential development environment that integrates tightly with the local file system. It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from. This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes.
|
||||
GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory. The location of the Medley development source tree for a project is given by the WORKINGPATH argument to GIT-MAKE-PROJECT. If WORKINGPATH is T or NIL and there exists a directory >working-projectname> as a sister to the clone, then that is taken to be the WORKINGPATH and thus the prefix for a pseudohost {Wprojectname}.
|
||||
When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR (or {WMEDLEY}) as a prefix. In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR.
|
||||
Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions. Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention.
|
||||
The files in Medley working tree and the git clone of a project can be compared with the gwc ("git-working-compare") command:
|
||||
gwc subdirectories (project) [command]
|
||||
This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
|
||||
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}.
|
||||
gwc subdirectories (project) [Command]
|
||||
This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
|
||||
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {projectname} to {Wprojectname} and deleting files from {Wprojectname}.
|
||||
If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.
|
||||
Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
|
||||
GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
|
||||
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))
. È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD TERMINAL
|
||||
Note that the menu item for deleting Medley files will cause all versions to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deleted> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
|
||||
GITFNS does not (yet?) include functions for commits, pushes, or merge for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
|
||||
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) . È . È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD TERMINAL
|
||||
MODERN
|
||||
TIMESROMAN $ TERMINAL MODERN
|
||||
MODERN MODERN
|
||||
MODERN
|
||||
HRULE.GETFN HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN HRULE.GETFN MODERN
|
||||
, R Í è ; â B 1 L - . Š $ w a <00>
/ 2 7 # h ð ß n ƒ Ç ƒ ( ' G ! = c 5
3 $
|
||||
Ç , I À ) 1 < ’ ö 5 H - & 0 % 9 " ?
M
s I " " ¶ ¾
w 6 D l B Z D
|
||||
Ù D
- .
( ‡ 2 D
‡ U f
|
||||
< D
õ z D
œ .D‚zº
|
||||
HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN
|
||||
HRULE.GETFN MODERN
HRULE.GETFN MODERN
|
||||
1
|
||||
|
||||
R
|
||||
Í é
|
||||
|
||||
;
|
||||
¹ @ ,
|
||||
|
||||
" & \
|
||||
X
|
||||
p 6 ,
|
||||
|
||||
)
|
||||
|
||||
)
|
||||
+
5
|
||||
@ &
|
||||
I 7
|
||||
o
|
||||
E .
|
||||
8 > I
|
||||
|
||||
|
||||
Y
€
|
||||
|
||||
$
|
||||
;
|
||||
}
|
||||
(
|
||||
)
9
|
||||
!
|
||||
0
|
||||
4
c
|
||||
|
||||
5
v B
|
||||
1 O L J
|
||||
' '
|
||||
|
||||
œ
|
||||
) 2
|
||||
+
|
||||
|
||||
|
||||
Z
!
œ
|
||||
5 H
|
||||
|
||||
5
|
||||
5
|
||||
> $ N
!
M
|
||||
§ ‹ A
|
||||
@
|
||||
4
|
||||
|
||||
@ Ô
|
||||
â
k 6 . R < 9
|
||||
'
|
||||
Y " ( ? “ F
|
||||
<00>
|
||||
|
||||
ì Ë
|
||||
ò 1Sýzº
|
||||
@@ -1,13 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "26-Mar-2021 11:01:59" {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;4 74359
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
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)
|
||||
@@ -184,7 +187,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
|
||||
(FUNCTIONS INVERT-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)
|
||||
|
||||
|
||||
@@ -567,11 +570,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
|
||||
"Cached name of the current logged in user")
|
||||
|
||||
(CL:DEFPARAMETER *WHO-LINE-USER-ENTRY* '("User" (WHO-LINE-USERNAME)
|
||||
10 WHO-LINE-CHANGE-USER (SETQ
|
||||
*WHO-LINE-CURRENT-USER*
|
||||
NIL)
|
||||
"Name of the currently logged in user")
|
||||
|
||||
10 WHO-LINE-CHANGE-USER (SETQ *WHO-LINE-CURRENT-USER*
|
||||
NIL)
|
||||
"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
|
||||
|
||||
@@ -591,18 +593,35 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(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))))
|
||||
)
|
||||
(WHO-LINE-HOST-NAME
|
||||
[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
|
||||
"Cached name of the current machine, for the Who-Line")
|
||||
|
||||
(CL:DEFPARAMETER *WHO-LINE-HOST-NAME-ENTRY* '("on" (WHO-LINE-HOST-NAME)
|
||||
10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL)
|
||||
"Name of the currently running machine")
|
||||
|
||||
10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL)
|
||||
"Name of the currently running machine")
|
||||
|
||||
"Who-Line entry for displaying the name of the current machine")
|
||||
(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*)))))
|
||||
|
||||
(SET-PACKAGE-INTERACTIVELY
|
||||
(LAMBDA NIL (* ; "Edited 18-Mar-87 13:13 by smL")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Let the user interactivly change the current package")
|
||||
|
||||
(* ;; "")
|
||||
(SET-PACKAGE-INTERACTIVELY
|
||||
[LAMBDA NIL (* ; "Edited 12-Apr-2023 17:44 by lmm")
|
||||
(* ; "Edited 18-Mar-87 13:13 by smL")
|
||||
|
||||
(LET ((PACKAGE
|
||||
(MENU (create MENU
|
||||
TITLE _ "Select 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)
|
||||
":") ',PACKAGE-NAME
|
||||
,(CONCAT "Set the current package to "
|
||||
PACKAGE-NAME ":")))
|
||||
(FUNCTION (LAMBDA (X Y)
|
||||
(ALPHORDER (CAR X)
|
||||
(CAR Y)))))
|
||||
CENTERFLG _ T))))
|
||||
(if PACKAGE
|
||||
then (if (SHIFTDOWNP 'SHIFT)
|
||||
then (WHO-LINE-COPY-INSERT (CONCAT PACKAGE ":"))
|
||||
else (CL:IN-PACKAGE PACKAGE))))))
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Let the user interactivly change the current package")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(LET* [PKG (MAIN (FOR PN IN '("INTERLISP" "XCL-USER" "USER") WHEN (SETQ PKG (CL:FIND-PACKAGE
|
||||
PN))
|
||||
COLLECT (LIST PKG PN)))
|
||||
(SYSPKG (FOR PN
|
||||
IN '("LISP" "XEROX-COMMON-LISP" "D-ASSEM" "FASL" "KEYWORD" "CASH-FILE"
|
||||
"SEDIT" "SYSTEM" "COMPILER" "HASH-FILE" "CONDITIONS" "DEBUGGER")
|
||||
WHEN (SETQ PKG (CL:FIND-PACKAGE PN)) COLLECT (LIST PKG PN)))
|
||||
(BOTH (APPEND MAIN SYSPKG))
|
||||
[UNSORTED (FOR PKG IN (CL:LIST-ALL-PACKAGES) WHEN (NOT (ASSOC PKG BOTH))
|
||||
COLLECT (LIST PKG (OR (CAR (CL:PACKAGE-NICKNAMES PKG))
|
||||
(CL:PACKAGE-NAME PKG]
|
||||
[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
|
||||
(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)
|
||||
|
||||
|
||||
"An AList used to cache package names, together with their terminating ':'s")
|
||||
|
||||
(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*
|
||||
(LIST NIL))
|
||||
"Package of the current TTY process")
|
||||
|
||||
(LIST NIL))
|
||||
"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)
|
||||
10 SET-TTY-READTABLE-INTERACTIVELY NIL
|
||||
"Readtable of the current TTY process")
|
||||
|
||||
10 SET-TTY-READTABLE-INTERACTIVELY NIL
|
||||
"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)
|
||||
15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL
|
||||
"The current TTY process")
|
||||
|
||||
15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL
|
||||
"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*))
|
||||
)
|
||||
|
||||
(SET-CONNECTED-DIRECTORY-INTERACTIVELY
|
||||
(LAMBDA NIL (* ; "Edited 9-Jun-87 08:57 by smL")
|
||||
(SET-CONNECTED-DIRECTORY-INTERACTIVELY
|
||||
[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*))
|
||||
|
||||
(* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it")
|
||||
(DECLARE (GLOBALVARS *WHO-LINE-DIRECTORIES*))
|
||||
|
||||
(if (SHIFTDOWNP 'SHIFT)
|
||||
then (LET ((NEW-DIRECTORY (MENU (create MENU
|
||||
(* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it")
|
||||
|
||||
(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:"
|
||||
ITEMS _ *WHO-LINE-DIRECTORIES*))))
|
||||
(if NEW-DIRECTORY
|
||||
then (WHO-LINE-COPY-INSERT NEW-DIRECTORY)))
|
||||
else (LET ((NEW-DIRECTORY (MENU (create MENU
|
||||
ITEMS _ *WHO-LINE-DIRECTORIES*]
|
||||
(IF NEW-DIRECTORY
|
||||
THEN (WHO-LINE-COPY-INSERT NEW-DIRECTORY)))
|
||||
ELSE (LET [(NEW-DIRECTORY (MENU (create MENU
|
||||
TITLE _ "Connect to:"
|
||||
ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*)))))
|
||||
(if NEW-DIRECTORY
|
||||
then (if (STRING-EQUAL NEW-DIRECTORY "* Other *")
|
||||
then (CLEARW PROMPTWINDOW)
|
||||
ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*]
|
||||
(if NEW-DIRECTORY
|
||||
then (if (STRING-EQUAL NEW-DIRECTORY "* Other *")
|
||||
then (CLEARW PROMPTWINDOW)
|
||||
(SETQ NEW-DIRECTORY (PROMPTFORWORD "Connect to directory "
|
||||
(CL:NAMESTRING (PROCESS.EVALV
|
||||
(TTY.PROCESS)
|
||||
|
||||
'
|
||||
*DEFAULT-PATHNAME-DEFAULTS*
|
||||
))
|
||||
NIL PROMPTWINDOW NIL 'TTY NIL)))
|
||||
(if NEW-DIRECTORY
|
||||
then (ALLOW.BUTTON.EVENTS) (* ;
|
||||
"Should do this in the current TTY process, in case the conntected directory is a per-process var")
|
||||
|
||||
(CNDIR NEW-DIRECTORY)))))))
|
||||
(if NEW-DIRECTORY
|
||||
then (ALLOW.BUTTON.EVENTS) (* ;
|
||||
"Should do this in the current TTY process, in case the conntected directory is a per-process var")
|
||||
(CNDIR NEW-DIRECTORY])
|
||||
)
|
||||
|
||||
(DEFGLOBALVAR *WHO-LINE-DIRECTORIES* `(,LOGINHOST/DIR)
|
||||
|
||||
|
||||
"Cached list of known directories for the Who-Line Directory entry")
|
||||
|
||||
(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY* (LET ((NAMESTRING (CL:NAMESTRING
|
||||
*DEFAULT-PATHNAME-DEFAULTS*)))
|
||||
(CONS (PATHNAME NAMESTRING)
|
||||
(MKSTRING NAMESTRING)))
|
||||
|
||||
(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY* (LET ((NAMESTRING (CL:NAMESTRING *DEFAULT-PATHNAME-DEFAULTS*)
|
||||
))
|
||||
(CONS (PATHNAME NAMESTRING)
|
||||
(MKSTRING NAMESTRING)))
|
||||
|
||||
"Cached name of the current connected directory for the Who-Line Directory entry")
|
||||
|
||||
(CL:DEFPARAMETER *WHO-LINE-DIRECTORY-ENTRY* '("Dir" (WHO-LINE-CURRENT-DIRECTORY)
|
||||
30 SET-CONNECTED-DIRECTORY-INTERACTIVELY
|
||||
(SETQ *WHO-LINE-LAST-DIRECTORY*
|
||||
(CONS NIL NIL))
|
||||
"The currently connected directory")
|
||||
|
||||
30 SET-CONNECTED-DIRECTORY-INTERACTIVELY
|
||||
(SETQ *WHO-LINE-LAST-DIRECTORY* (CONS NIL NIL))
|
||||
"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)
|
||||
|
||||
|
||||
"Cached value for storing the last VMem information for the Who-Line VMem entry")
|
||||
|
||||
(CL:DEFPARAMETER *WHO-LINE-VMEM-ENTRY* '("VMem" (WHO-LINE-VMEM)
|
||||
5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM*
|
||||
(LIST 0 NIL NIL))
|
||||
"Percentage of VMem currently in use")
|
||||
|
||||
"Who-Line entry for displaying the current VMem utilization")
|
||||
5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM*
|
||||
(LIST 0 NIL NIL))
|
||||
"Percentage of VMem currently in use")
|
||||
"Who-Line entry for displaying the current VMem utilization")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
@@ -938,15 +965,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
|
||||
(CL:THIRD *WHO-LINE-SYMBOL-SPACE*)))
|
||||
|
||||
(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)
|
||||
4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE*
|
||||
(LIST NIL NIL NIL))
|
||||
|
||||
"Percentage of symbol space currently in use"
|
||||
)
|
||||
|
||||
4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE*
|
||||
(LIST NIL NIL NIL))
|
||||
"Percentage of symbol space currently 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)
|
||||
60))
|
||||
NIL
|
||||
'SECONDS)
|
||||
"Timer for controlling updates of the Who-Line Time entry")
|
||||
60))
|
||||
NIL
|
||||
'SECONDS)
|
||||
"Timer for controlling updates of the Who-Line Time entry")
|
||||
|
||||
(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*
|
||||
'("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")
|
||||
|
||||
(DEFGLOBALVAR *WHO-LINE-ACTIVE-TIMER* (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL 'MILLISECONDS)
|
||||
|
||||
"Timer for controlling updating of the Who-Line activity entry")
|
||||
|
||||
(CL:DEFPARAMETER *WHO-LINE-SHOW-ACTIVE-ENTRY* '("" (WHO-LINE-SHOW-ACTIVE)
|
||||
2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER*
|
||||
(SETUPTIMER *WHO-LINE-ACTIVE-PERIOD*
|
||||
NIL 'MILLISECONDS))
|
||||
"Indication of machine activity")
|
||||
|
||||
2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER*
|
||||
(SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL
|
||||
'MILLISECONDS))
|
||||
"Indication of machine activity")
|
||||
|
||||
"Who-Line entry for displaying the activity of the machine")
|
||||
(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)
|
||||
10 SET-TTY-PROFILE-INTERACTIVELY NIL
|
||||
10 SET-TTY-PROFILE-INTERACTIVELY NIL
|
||||
"The read/write profile of the current TTY process"
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
"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")
|
||||
|
||||
(DEFGLOBALVAR *WHO-LINE-STATE-UNINTERESTING-FNS* '(BLOCK ERRORSET OBTAIN.MONITORLOCK
|
||||
MONITOR.AWAIT.EVENT AWAIT.EVENT
|
||||
SI::*UNWIND-PROTECT*)
|
||||
|
||||
MONITOR.AWAIT.EVENT AWAIT.EVENT
|
||||
SI::*UNWIND-PROTECT*)
|
||||
|
||||
"Uninteresting fns to skip over in the Who-Line State entry")
|
||||
|
||||
(CL:DEFPARAMETER *WHO-LINE-TTY-STATE-ENTRY* '("State" (WHO-LINE-TTY-STATE)
|
||||
15 NIL (SETQ *WHO-LINE-STATE* NIL)
|
||||
"Running state of the current TTY process")
|
||||
|
||||
15 NIL (SETQ *WHO-LINE-STATE* NIL)
|
||||
"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")
|
||||
@@ -1222,9 +1246,8 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
|
||||
|
||||
|
||||
(DEFGLOBALVAR *WHO-LINE-ENTRIES*
|
||||
`(,*WHO-LINE-USER-ENTRY* ,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY*
|
||||
,*WHO-LINE-TTY-PROC-ENTRY* ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY*
|
||||
,*WHO-LINE-TIME-ENTRY*)
|
||||
`(,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* ,*WHO-LINE-TTY-PROC-ENTRY*
|
||||
,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* ,*WHO-LINE-TIME-ENTRY*)
|
||||
"List of all the entries to show in the Who-Line")
|
||||
|
||||
(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.")
|
||||
|
||||
(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))
|
||||
"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))
|
||||
"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
|
||||
"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)
|
||||
`(WITH WHO-LINE-ENTRY ,ENTRY (BLTSHADE BLACKSHADE ,WINDOW NAME-START 0 (DIFFERENCE VALUE-END
|
||||
NAME-START)
|
||||
NIL
|
||||
'INVERT)
|
||||
(CHANGE INVERTED? (NOT INVERTED?))))
|
||||
NAME-START)
|
||||
NIL
|
||||
'INVERT)
|
||||
(CHANGE INVERTED? (NOT INVERTED?))))
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(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)
|
||||
T)))
|
||||
(CL:UNWIND-PROTECT (* ;
|
||||
"Only eval the forms if we got the lock")
|
||||
"Only eval the forms if we got the lock")
|
||||
(COND
|
||||
(,LOCK ,@FORMS))
|
||||
|
||||
@@ -1614,13 +1637,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
|
||||
|
||||
[COND
|
||||
((EQ ,LOCK T) (* ;
|
||||
"Had the lock before, so no need to release it")
|
||||
"Had the lock before, so no need to release it")
|
||||
NIL)
|
||||
((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)
|
||||
(T (* ;
|
||||
"We got the lock, and need to release it")
|
||||
"We got the lock, and need to release it")
|
||||
(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 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
|
||||
(FILEMAP (NIL (7778 23157 (INSTALL-WHO-LINE-OPTIONS 7788 . 23155)) (23433 24602 (WHO-LINE-USERNAME
|
||||
23443 . 24090) (WHO-LINE-CHANGE-USER 24092 . 24398) (WHO-LINE-USER-AFTER-LOGIN 24400 . 24600)) (25504
|
||||
25983 (WHO-LINE-HOST-NAME 25514 . 25981)) (26695 29324 (CURRENT-TTY-PACKAGE 26705 . 27657) (
|
||||
SET-PACKAGE-INTERACTIVELY 27659 . 29078) (SET-TTY-PACKAGE-INTERACTIVELY 29080 . 29322)) (30244 31296 (
|
||||
CURRENT-TTY-READTABLE-NAME 30254 . 30508) (SET-READTABLE-INTERACTIVELY 30510 . 31044) (
|
||||
SET-TTY-READTABLE-INTERACTIVELY 31046 . 31294)) (31811 32383 (WHO-LINE-TTY-PROCESS 31821 . 31999) (
|
||||
CHANGE-TTY-PROCESS-INTERACTIVELY 32001 . 32381)) (32884 36355 (WHO-LINE-CURRENT-DIRECTORY 32894 .
|
||||
34301) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 34303 . 36353)) (37720 40173 (WHO-LINE-VMEM 37730 .
|
||||
39920) (WHO-LINE-SAVE-VMEM 39922 . 40171)) (41097 42239 (WHO-LINE-SYMBOL-SPACE 41097 . 42239)) (43107
|
||||
44545 (WHO-LINE-TIME 43117 . 43859) (WHO-LINE-SET-TIME 43861 . 44543)) (46079 48712 (
|
||||
WHO-LINE-SHOW-ACTIVE 46089 . 46867) (\UPDATE-WHO-LINE-ACTIVE-FLAG 46869 . 47837) (
|
||||
\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 47839 . 48710)) (49873 50798 (CURRENT-PROFILE 49883 . 50128) (
|
||||
SET-PROFILE-INTERACTIVELY 50130 . 50533) (SET-TTY-PROFILE-INTERACTIVELY 50535 . 50796)) (51360 53343 (
|
||||
WHO-LINE-TTY-STATE 51370 . 52531) (WHO-LINE-WHAT-IS-RUNNING 52533 . 53341)) (56897 70023 (
|
||||
REDISPLAY-WHO-LINE 56907 . 59467) (PERIODICALLY-UPDATE-WHO-LINE 59469 . 60607) (SETUP-WHOLINE-TIMER
|
||||
60609 . 60827) (UPDATE-WHO-LINE 60829 . 63897) (WHEN-WHO-LINE-SELECTED-FN 63899 . 67166) (
|
||||
WHO-LINE-CONTROL-SELECT 67168 . 69627) (WHO-LINE-COPY-INSERT 69629 . 70021)) (70024 71158 (
|
||||
WHO-LINE-REDISPLAY-INTERRUPT 70034 . 71156)))))
|
||||
(FILEMAP (NIL (7838 23217 (INSTALL-WHO-LINE-OPTIONS 7848 . 23215)) (23493 24662 (WHO-LINE-USERNAME
|
||||
23503 . 24150) (WHO-LINE-CHANGE-USER 24152 . 24458) (WHO-LINE-USER-AFTER-LOGIN 24460 . 24660)) (25470
|
||||
26206 (WHO-LINE-HOST-NAME 25480 . 26204)) (26906 30232 (CURRENT-TTY-PACKAGE 26916 . 27868) (
|
||||
SET-PACKAGE-INTERACTIVELY 27870 . 29986) (SET-TTY-PACKAGE-INTERACTIVELY 29988 . 30230)) (31132 32184 (
|
||||
CURRENT-TTY-READTABLE-NAME 31142 . 31396) (SET-READTABLE-INTERACTIVELY 31398 . 31932) (
|
||||
SET-TTY-READTABLE-INTERACTIVELY 31934 . 32182)) (32687 33259 (WHO-LINE-TTY-PROCESS 32697 . 32875) (
|
||||
CHANGE-TTY-PROCESS-INTERACTIVELY 32877 . 33257)) (33748 37557 (WHO-LINE-CURRENT-DIRECTORY 33758 .
|
||||
35165) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 35167 . 37555)) (38817 41270 (WHO-LINE-VMEM 38827 .
|
||||
41017) (WHO-LINE-SAVE-VMEM 41019 . 41268)) (42132 43274 (WHO-LINE-SYMBOL-SPACE 42132 . 43274)) (44005
|
||||
45443 (WHO-LINE-TIME 44015 . 44757) (WHO-LINE-SET-TIME 44759 . 45441)) (46957 49590 (
|
||||
WHO-LINE-SHOW-ACTIVE 46967 . 47745) (\UPDATE-WHO-LINE-ACTIVE-FLAG 47747 . 48715) (
|
||||
\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 48717 . 49588)) (50687 51612 (CURRENT-PROFILE 50697 . 50942) (
|
||||
SET-PROFILE-INTERACTIVELY 50944 . 51347) (SET-TTY-PROFILE-INTERACTIVELY 51349 . 51610)) (52162 54145 (
|
||||
WHO-LINE-TTY-STATE 52172 . 53333) (WHO-LINE-WHAT-IS-RUNNING 53335 . 54143)) (57628 70754 (
|
||||
REDISPLAY-WHO-LINE 57638 . 60198) (PERIODICALLY-UPDATE-WHO-LINE 60200 . 61338) (SETUP-WHOLINE-TIMER
|
||||
61340 . 61558) (UPDATE-WHO-LINE 61560 . 64628) (WHEN-WHO-LINE-SELECTED-FN 64630 . 67897) (
|
||||
WHO-LINE-CONTROL-SELECT 67899 . 70358) (WHO-LINE-COPY-INSERT 70360 . 70752)) (70755 71889 (
|
||||
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
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,12 @@
|
||||
(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"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;1)
|
||||
:CHANGES-TO (FNS RINGBELLS)
|
||||
|
||||
: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
|
||||
|
||||
(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))
|
||||
(OR (FIXP N)
|
||||
(SETQ N 1))
|
||||
(SELECTC \MACHINETYPE
|
||||
((LIST \DAYBREAK \DANDELION \MAIKO)
|
||||
(to N do (PLAYTUNE RINGBELLS.L1)
|
||||
(FLASHWINDOW NIL NIL 100)
|
||||
(PLAYTUNE RINGBELLS.L2)))
|
||||
(FLASHWINDOW NIL N])
|
||||
(to N do (PLAYTUNE RINGBELLS.L1)
|
||||
(FLASHWINDOW NIL NIL 100)
|
||||
(PLAYTUNE RINGBELLS.L2])
|
||||
|
||||
(FLASHWINDOW
|
||||
[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)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4747 5450 (BACKSPACEDEL 4757 . 5448)) (5545 5978 (PERIODICALLYRECLAIM 5555 . 5976)) (
|
||||
6208 7899 (\DIRTYBACKGROUND 6218 . 6640) (\SAVEVMBACKGROUND 6642 . 7426) (COPYVM 7428 . 7897)) (8320
|
||||
9519 (SETTIME 8330 . 9517)) (9520 13551 (RINGBELLS 9530 . 10023) (FLASHWINDOW 10025 . 11953) (PLAYTUNE
|
||||
11955 . 13549)) (13813 19345 (DISPLAYDOWN 13823 . 14211) (SETDISPLAYHEIGHT 14213 . 17013) (VIDEORATE
|
||||
17015 . 19343)) (19769 20490 (DOAROUNDEXITFORMS 19779 . 20488)) (20693 22408 (REALMEMORYSIZE 20703 .
|
||||
20861) (LISPVERSION 20863 . 21016) (MICROCODEVERSION 21018 . 21176) (BCPLVERSION 21178 . 21331) (
|
||||
REQUIREVERSION 21333 . 22406)) (22445 27023 (APROPOS 22455 . 26471) (APROPRINT 26473 . 27021)) (27049
|
||||
30957 (READPRINTERPORT 27059 . 27200) (WRITEPRINTERPORT 27202 . 27357) (\READPRINTERPORT.UFN 27359 .
|
||||
27548) (\WRITEPRINTERPORT.UFN 27550 . 27748) (\MISC1.UFN 27750 . 27903) (\MISC2.UFN 27905 . 28143) (
|
||||
\MISC3.UFN 28145 . 28878) (\MISC4.UFN 28880 . 29430) (\MISC5.UFN 29432 . 29585) (\MISC6.UFN 29587 .
|
||||
29837) (\MISC7.UFN 29839 . 30324) (\MISC8.UFN 30326 . 30627) (\MISC10.UFN 30629 . 30955)) (31011 38460
|
||||
(\BLKFDIFF.UFN 31021 . 31586) (\BLKFPLUS.UFN 31588 . 32160) (\BLKFTIMES.UFN 32162 . 32737) (
|
||||
\BLKSEP.UFN 32739 . 33870) (\BLKPERM.UFN 33872 . 34341) (\BLKEXPONENT.UFN 34343 . 34753) (
|
||||
\BLKFLOATP2COMP.UFN 34755 . 35339) (\BLKSMALLP2FLOAT.UFN 35341 . 35700) (\BLKMAG.UFN 35702 . 36353) (
|
||||
\FLOATTOBYTE.UFN 36355 . 36934) (\BLKFMAX.UFN 36936 . 37328) (\BLKFMIN.UFN 37330 . 37719) (
|
||||
\BLKFABSMAX.UFN 37721 . 38090) (\BLKFABSMIN.UFN 38092 . 38458)) (38500 40318 (\P-MISC2.UFN 38510 .
|
||||
38751) (\LINES-EQUAL-P 38753 . 39137) (\GET-NEXT-RUN 39139 . 40316)) (40319 44498 (IBLT1 40329 . 42331
|
||||
) (IBLT2 42333 . 44496)))))
|
||||
(FILEMAP (NIL (4732 5435 (BACKSPACEDEL 4742 . 5433)) (5530 5963 (PERIODICALLYRECLAIM 5540 . 5961)) (
|
||||
6193 7884 (\DIRTYBACKGROUND 6203 . 6625) (\SAVEVMBACKGROUND 6627 . 7411) (COPYVM 7413 . 7882)) (8305
|
||||
9504 (SETTIME 8315 . 9502)) (9505 13503 (RINGBELLS 9515 . 9975) (FLASHWINDOW 9977 . 11905) (PLAYTUNE
|
||||
11907 . 13501)) (13765 19297 (DISPLAYDOWN 13775 . 14163) (SETDISPLAYHEIGHT 14165 . 16965) (VIDEORATE
|
||||
16967 . 19295)) (19721 20442 (DOAROUNDEXITFORMS 19731 . 20440)) (20645 22360 (REALMEMORYSIZE 20655 .
|
||||
20813) (LISPVERSION 20815 . 20968) (MICROCODEVERSION 20970 . 21128) (BCPLVERSION 21130 . 21283) (
|
||||
REQUIREVERSION 21285 . 22358)) (22397 26975 (APROPOS 22407 . 26423) (APROPRINT 26425 . 26973)) (27001
|
||||
30909 (READPRINTERPORT 27011 . 27152) (WRITEPRINTERPORT 27154 . 27309) (\READPRINTERPORT.UFN 27311 .
|
||||
27500) (\WRITEPRINTERPORT.UFN 27502 . 27700) (\MISC1.UFN 27702 . 27855) (\MISC2.UFN 27857 . 28095) (
|
||||
\MISC3.UFN 28097 . 28830) (\MISC4.UFN 28832 . 29382) (\MISC5.UFN 29384 . 29537) (\MISC6.UFN 29539 .
|
||||
29789) (\MISC7.UFN 29791 . 30276) (\MISC8.UFN 30278 . 30579) (\MISC10.UFN 30581 . 30907)) (30963 38412
|
||||
(\BLKFDIFF.UFN 30973 . 31538) (\BLKFPLUS.UFN 31540 . 32112) (\BLKFTIMES.UFN 32114 . 32689) (
|
||||
\BLKSEP.UFN 32691 . 33822) (\BLKPERM.UFN 33824 . 34293) (\BLKEXPONENT.UFN 34295 . 34705) (
|
||||
\BLKFLOATP2COMP.UFN 34707 . 35291) (\BLKSMALLP2FLOAT.UFN 35293 . 35652) (\BLKMAG.UFN 35654 . 36305) (
|
||||
\FLOATTOBYTE.UFN 36307 . 36886) (\BLKFMAX.UFN 36888 . 37280) (\BLKFMIN.UFN 37282 . 37671) (
|
||||
\BLKFABSMAX.UFN 37673 . 38042) (\BLKFABSMIN.UFN 38044 . 38410)) (38452 40270 (\P-MISC2.UFN 38462 .
|
||||
38703) (\LINES-EQUAL-P 38705 . 39089) (\GET-NEXT-RUN 39091 . 40268)) (40271 44450 (IBLT1 40281 . 42283
|
||||
) (IBLT2 42285 . 44448)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,16 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-Sep-2021 19:11:32"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;4 30288
|
||||
|
||||
changes to%: (ALISTS (FONTDEFS BIGGERNS))
|
||||
(FILECREATED "13-Apr-2023 08:40:30" {DSK}<home>larry>il>medley>sources>FONTPROFILE.;2 35652
|
||||
|
||||
previous date%: " 6-Sep-2021 15:52:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FONTPROFILE.;2)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (ALISTS (FONTDEFS HUGE)
|
||||
(FONTDEFS BIG)
|
||||
(FONTDEFS MEDIUM)
|
||||
(FONTDEFS STANDARD)
|
||||
(FONTDEFS BIGGER)
|
||||
(FONTDEFS NS)
|
||||
(FONTDEFS BIGGERNS))
|
||||
(VARS FONTPROFILECOMS)
|
||||
|
||||
:PREVIOUS-DATE " 6-Sep-2021 19:11:32" {DSK}<home>larry>il>medley>sources>FONTPROFILE.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FONTPROFILECOMS)
|
||||
|
||||
@@ -18,7 +22,7 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(
|
||||
(* ;; "FONT")
|
||||
|
||||
(ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER NS BIGGERNS))
|
||||
(ALISTS (FONTDEFS HUGE BIG MEDIUM STANDARD BIGGER NS BIGGERNS LARGER))
|
||||
(ADDVARS (CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu))
|
||||
[VARS (FONTVARS '(
|
||||
(* ;; "standard size fonts. Assumes only DEFAULTFONT set")
|
||||
@@ -76,7 +80,7 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -118,110 +122,150 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR FONTDEFS
|
||||
[HUGE (FONTPROFILE (DEFAULTFONT 1 (MODERN 24)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(BOLDFONT 2 (MODERN 24 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (MODERN 18 MRR)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BIGFONT 4 (MODERN 36 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(TEXTFONT 5 (CLASSIC 24)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(CLASSIC 10)
|
||||
(POSTSCRIPT (CLASSIC 10)))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 24 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
(CLASSIC 10 BRR)
|
||||
(POSTSCRIPT (CLASSIC 10 BRR]
|
||||
[BIG (FONTPROFILE (DEFAULTFONT 1 (MODERN 18)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(TEXTFONT 5 (CLASSIC 18)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(CLASSIC 10)
|
||||
(POSTSCRIPT (CLASSIC 10)))
|
||||
(BOLDFONT 2 (MODERN 18 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (MODERN 12 MRR)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BIGFONT 4 (MODERN 24 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 18 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
(CLASSIC 10 BRR)
|
||||
(POSTSCRIPT (CLASSIC 10 BRR]
|
||||
[MEDIUM (FONTPROFILE (DEFAULTFONT 1 (MODERN 14)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(BOLDFONT 2 (MODERN 14 BRR)
|
||||
NIL
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (MODERN 10)
|
||||
NIL
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BIGFONT 4 (MODERN 18)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(TEXTFONT 5 (CLASSIC 14)
|
||||
NIL
|
||||
(CLASSIC 10))
|
||||
(CLASSIC 10)
|
||||
(POSTSCRIPT (CLASSIC 10)))
|
||||
(TEXTBOLDFONT 7 (CLASSIC 14 BRR)
|
||||
NIL
|
||||
(CLASSIC 10 BRR]
|
||||
(CLASSIC 10 BRR)
|
||||
(POSTSCRIPT (CLASSIC 10 BRR]
|
||||
[STANDARD (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (GACHA 10)
|
||||
(GACHA 8)
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(ITALICFONT 1 (HELVETICA 10 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BOLDFONT 2 (HELVETICA 10 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (HELVETICA 8)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(TINYFONT 6 (GACHA 8)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6))
|
||||
(TERMINAL 6)
|
||||
(POSTSCRIPT (TERMINAL 6)))
|
||||
(BIGFONT 4 (HELVETICA 12 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (HELVETICA 10))
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(MENUFONT 5 (HELVETICA 10)
|
||||
(HELVETICA 10)
|
||||
(HELVETICA 10)
|
||||
(POSTSCRIPT (HELVETICA 10)))
|
||||
(COMMENTFONT 6 (HELVETICA 10)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8))
|
||||
(MODERN 8)
|
||||
(POSTSCRIPT (MODERN 8)))
|
||||
(TEXTFONT 7 (TIMESROMAN 10)
|
||||
NIL
|
||||
(CLASSIC 10]
|
||||
(TIMESROMAN 10)
|
||||
(CLASSIC 10)
|
||||
(POSTSCRIPT (CLASSIC 10]
|
||||
[BIGGER (FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
|
||||
NIL
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(ITALICFONT 1 (HELVETICA 12 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BOLDFONT 2 (HELVETICA 12 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (HELVETICA 10)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(TINYFONT 6 (GACHA 10)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6))
|
||||
(TERMINAL 6)
|
||||
(POSTSCRIPT (TERMINAL 6)))
|
||||
(BIGFONT 4 (HELVETICA 14 BRR)
|
||||
NIL
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (HELVETICA 12))
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(MENUFONT 5 (HELVETICA 12)
|
||||
(HELVETICA 12)
|
||||
(HELVETICA 12)
|
||||
(POSTSCRIPT (HELVETICA 12)))
|
||||
(COMMENTFONT 6 (HELVETICA 12)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8))
|
||||
(MODERN 8)
|
||||
(POSTSCRIPT (MODERN 8)))
|
||||
(TEXTFONT 7 (TIMESROMAN 12)
|
||||
NIL
|
||||
(CLASSIC 10]
|
||||
(TIMESROMAN 12)
|
||||
(CLASSIC 10)
|
||||
(POSTSCRIPT (CLASSIC 10]
|
||||
[NS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
@@ -230,23 +274,32 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(FONTESCAPECHAR . %)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (TERMINAL 10)
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(ITALICFONT 1 (MODERN 10 BIR)
|
||||
(MODERN 8 BIR)
|
||||
(MODERN 8 BIR))
|
||||
(MODERN 8 BIR)
|
||||
(POSTSCRIPT (MODERN 8 BIR)))
|
||||
(BOLDFONT 2 (MODERN 10 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (MODERN 8)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BIGFONT 4 (MODERN 12 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (MODERN 10))
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(MENUFONT 5 (MODERN 10)
|
||||
(MODERN 10)
|
||||
(MODERN 10)
|
||||
(POSTSCRIPT (MODERN 10)))
|
||||
(COMMENTFONT 6 (MODERN 8)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR]
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR]
|
||||
[BIGGERNS (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(COMMENTLINELENGTH 116 . 126)
|
||||
@@ -255,23 +308,70 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(FONTESCAPECHAR . %)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (TERMINAL 12)
|
||||
(TERMINAL 8)
|
||||
(TERMINAL 8))
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(ITALICFONT 1 (MODERN 12 BIR)
|
||||
(MODERN 8 BIR)
|
||||
(MODERN 8 BIR))
|
||||
(MODERN 8 BIR)
|
||||
(POSTSCRIPT (MODERN 8 BIR)))
|
||||
(BOLDFONT 2 (MODERN 12 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(MODERN 8 BRR))
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (MODERN 10)
|
||||
(MODERN 6 MIR)
|
||||
(MODERN 8 MIR))
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BIGFONT 4 (MODERN 14 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(MODERN 10 BRR))
|
||||
(MENUFONT 5 (MODERN 12))
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(MENUFONT 5 (MODERN 12)
|
||||
(MODERN 12)
|
||||
(MODERN 12)
|
||||
(POSTSCRIPT (MODERN 12)))
|
||||
(COMMENTFONT 6 (MODERN 10)
|
||||
(MODERN 8 MIR)
|
||||
(MODERN 10 MIR])
|
||||
(MODERN 10 MIR)
|
||||
(POSTSCRIPT (MODERN 10 MIR]
|
||||
[LARGER (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
|
||||
(GACHA 8)
|
||||
(TERMINAL 8)
|
||||
(POSTSCRIPT (TERMINAL 8)))
|
||||
(ITALICFONT 1 (HELVETICA 14 MIR)
|
||||
(GACHA 8 MIR)
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(BOLDFONT 2 (HELVETICA 14 BRR)
|
||||
(HELVETICA 8 BRR)
|
||||
(MODERN 8 BRR)
|
||||
(POSTSCRIPT (MODERN 8 BRR)))
|
||||
(LITTLEFONT 3 (HELVETICA 12)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 8 MIR)
|
||||
(POSTSCRIPT (MODERN 8 MIR)))
|
||||
(TINYFONT 6 (GACHA 10)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6)
|
||||
(POSTSCRIPT (TERMINAL 6)))
|
||||
(BIGFONT 4 (HELVETICA 16 BRR)
|
||||
(HELVETICA 12 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (MODERN 10 BRR)))
|
||||
(MENUFONT 5 (HELVETICA 12)
|
||||
(HELVETICA 12)
|
||||
(HELVETICA 12)
|
||||
(POSTSCRIPT (HELVETICA 12)))
|
||||
(COMMENTFONT 6 (HELVETICA 10)
|
||||
(HELVETICA 8)
|
||||
(MODERN 8)
|
||||
(POSTSCRIPT (MODERN 8)))
|
||||
(TEXTFONT 7 (TIMESROMAN 12)
|
||||
(TIMESROMAN 10)
|
||||
(CLASSIC 10)
|
||||
(POSTSCRIPT (CLASSIC 10])
|
||||
|
||||
(ADDTOVAR CACHEDMENUS BreakMenu WindowMenu BackgroundMenu IconWindowMenu)
|
||||
|
||||
@@ -332,7 +432,7 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
(TTYINBOLDFONT (CONS DEFAULTFONT BOLDFONT))
|
||||
(VALUEFONT DEFAULTFONT)
|
||||
(* ;
|
||||
" for printing out values returned in Exec")
|
||||
" for printing out values returned in Exec")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -599,8 +699,7 @@ Copyright (c) 1986, 1988, 1990-1991, 1999, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
|
||||
1 FILERDTBL)
|
||||
(PUTPROPS FONTPROFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1988 1990 1991 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (16323 27907 (FONTSET 16333 . 22674) (FONTPROFILE 22676 . 25025) (FONTPROFILE.ADDDEVICE
|
||||
25027 . 27905)) (28143 30042 (FONTMAPARRAY 28153 . 30040)))))
|
||||
(FILEMAP (NIL (21780 33364 (FONTSET 21790 . 28131) (FONTPROFILE 28133 . 30482) (FONTPROFILE.ADDDEVICE
|
||||
30484 . 33362)) (33600 35499 (FONTMAPARRAY 33610 . 35497)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
222
sources/LOGOW
222
sources/LOGOW
File diff suppressed because one or more lines are too long
BIN
sources/LOGOW.DFASL
Normal file
BIN
sources/LOGOW.DFASL
Normal file
Binary file not shown.
Binary file not shown.
@@ -1,15 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2022 20:35:18" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRETTY.;23 65357
|
||||
(FILECREATED " 8-Feb-2023 16:21:26" {DSK}<home>larry>il>medley>sources>PRETTY.;3 65500
|
||||
|
||||
:CHANGES-TO (FNS PRINTDEF1)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "30-Nov-2021 22:18:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRETTY.;21)
|
||||
:CHANGES-TO (FNS PRINTDATE1)
|
||||
|
||||
:PREVIOUS-DATE "19-Jan-2022 20:35:18" {DSK}<home>larry>il>medley>sources>PRETTY.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984-1990, 1999, 2018 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1984-1990, 1999, 2018, 2023 by Venue & Xerox Corporation.
|
||||
The following program was created in 1984 but has not been published
|
||||
within the meaning of the copyright law, is furnished under license,
|
||||
and may not be used, copied and/or disclosed except in accordance
|
||||
@@ -327,9 +328,9 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
)
|
||||
|
||||
(PRINTDATE1
|
||||
[LAMBDA (OUTSTREAM CHANGES DAT PREVDATE PREVERS TERMINATING.STRING)
|
||||
(* ;
|
||||
"Edited 30-Nov-2021 21:31 by larry")
|
||||
[LAMBDA (OUTSTREAM CHANGES DAT PREVDATE PREVERS TERMINATING.STRING)
|
||||
(* ; "Edited 8-Feb-2023 16:21 by lmm")
|
||||
(* ; "Edited 30-Nov-2021 21:31 by larry")
|
||||
(* bvm%: "18-Sep-86 19:08")
|
||||
|
||||
(* ;;; "does the printing for PRINTDATE")
|
||||
@@ -342,17 +343,19 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
|
||||
(if (AND BUILDMAPFLG (NOT (DISPLAYP OUTSTREAM)))
|
||||
then (push MAPADR (ADD1 (GETFILEPTR OUTSTREAM)))
|
||||
(PRIN3 " " OUTSTREAM)
|
||||
(PRIN3 " " OUTSTREAM)
|
||||
|
||||
(* ;; "The address of where the map begins will be stored in this slot. 8 spaces left because when radix is 8, can overflow seven spaces by a file of 300000 characters (Alice did it). The push is because of a feature no longer used where there could be two FILECREATED expressions at the head of a file font")
|
||||
(* ;; "The address of where the map begins will be stored in this slot. 8 spaces left because when radix is 8, can overflow seven spaces by a file of 300000 characters (Alice did it). The push is because of a feature no longer used where there could be two FILECREATED expressions at the head of a file font")
|
||||
)
|
||||
[if FILEPKGFLG
|
||||
then (if CHANGES
|
||||
then (printout OUTSTREAM T T 6 .P2 :CHANGES-TO %, .PPVTL CHANGES))
|
||||
(if PREVDATE
|
||||
then (printout OUTSTREAM T T 6 .P2 :PREVIOUS-DATE %, .P2 PREVDATE)
|
||||
(if PREVERS
|
||||
then (printout OUTSTREAM %, .P2 PREVERS]
|
||||
then (if INITIALS
|
||||
then (printout OUTSTREAM T T 6 .P2 :EDIT-BY %, .P2 INITIALS))
|
||||
(if CHANGES
|
||||
then (printout OUTSTREAM T T 6 .P2 :CHANGES-TO %, .PPVTL CHANGES))
|
||||
(if PREVDATE
|
||||
then (printout OUTSTREAM T T 6 .P2 :PREVIOUS-DATE %, .P2 PREVDATE)
|
||||
(if PREVERS
|
||||
then (printout OUTSTREAM %, .P2 PREVERS]
|
||||
(PRIN1 (OR TERMINATING.STRING ")
|
||||
|
||||
|
||||
@@ -727,16 +730,16 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS PRETTY COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 1999 2018
|
||||
))
|
||||
2023))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5927 48431 (PRETTYDEF 5937 . 21610) (PRETTYDEFCOMS 21612 . 22294) (PRETTYDEF0 22296 .
|
||||
22487) (PRETTYDEF1 22489 . 24252) (PRINTDATE 24254 . 25490) (PRINTDATE1 25492 . 27122) (PRINTFNS 27124
|
||||
. 27693) (PRETTYCOM 27695 . 34036) (PRETTYVAR 34038 . 35076) (PRETTYVAR1 35078 . 37296) (PRETTYCOM1
|
||||
37298 . 38002) (ENDFILE 38004 . 38100) (MAKEDEFLIST 38102 . 38506) (PP 38508 . 38784) (PP* 38786 .
|
||||
39099) (PPT 39101 . 39420) (PRETTYPRINT 39422 . 42574) (PRETTYPRINT1 42576 . 44462) (PRETTYPRINT2
|
||||
44464 . 45780) (PRETTYPRINT3 45782 . 46737) (PRINTDEF1 46739 . 47675) (SUPERPRINTEQ 47677 . 47771) (
|
||||
SUPERPRINTGETPROP 47773 . 47917) (CHANGEFONT 47919 . 48429)) (48432 53778 (READARRAY 48442 . 49368) (
|
||||
PRINTARRAY 49370 . 51110) (READARRAY-FROM-LIST 51112 . 52217) (PRINTARRAY-TO-LIST 52219 . 53776)) (
|
||||
53905 61423 (PRINTCOPYRIGHT 53915 . 57992) (PRINTCOPYRIGHT1 57994 . 61118) (SAVECOPYRIGHT 61120 .
|
||||
61421)))))
|
||||
(FILEMAP (NIL (5917 48569 (PRETTYDEF 5927 . 21600) (PRETTYDEFCOMS 21602 . 22284) (PRETTYDEF0 22286 .
|
||||
22477) (PRETTYDEF1 22479 . 24242) (PRINTDATE 24244 . 25480) (PRINTDATE1 25482 . 27260) (PRINTFNS 27262
|
||||
. 27831) (PRETTYCOM 27833 . 34174) (PRETTYVAR 34176 . 35214) (PRETTYVAR1 35216 . 37434) (PRETTYCOM1
|
||||
37436 . 38140) (ENDFILE 38142 . 38238) (MAKEDEFLIST 38240 . 38644) (PP 38646 . 38922) (PP* 38924 .
|
||||
39237) (PPT 39239 . 39558) (PRETTYPRINT 39560 . 42712) (PRETTYPRINT1 42714 . 44600) (PRETTYPRINT2
|
||||
44602 . 45918) (PRETTYPRINT3 45920 . 46875) (PRINTDEF1 46877 . 47813) (SUPERPRINTEQ 47815 . 47909) (
|
||||
SUPERPRINTGETPROP 47911 . 48055) (CHANGEFONT 48057 . 48567)) (48570 53916 (READARRAY 48580 . 49506) (
|
||||
PRINTARRAY 49508 . 51248) (READARRAY-FROM-LIST 51250 . 52355) (PRINTARRAY-TO-LIST 52357 . 53914)) (
|
||||
54043 61561 (PRINTCOPYRIGHT 54053 . 58130) (PRINTCOPYRIGHT1 58132 . 61256) (SAVECOPYRIGHT 61258 .
|
||||
61559)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
193
sources/WINDOW
193
sources/WINDOW
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Jul-2022 11:10:09"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>WINDOW.;19 221116
|
||||
(FILECREATED "10-Apr-2023 07:05:18" {DSK}<home>larry>il>medley>sources>WINDOW.;2 222381
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS WINDOWCOMS)
|
||||
(FNS \MEDW.DSPCREATE \GENERIC.DSPCREATE \GENERIC.DSPCREATE.DESTINATION.BITMAP?)
|
||||
|
||||
:PREVIOUS-DATE " 8-Jul-2022 23:54:16"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>WINDOW.;15)
|
||||
:PREVIOUS-DATE " 9-Jul-2022 11:10:09" {DSK}<home>larry>il>medley>sources>WINDOW.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -16,7 +15,7 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
|
||||
|
||||
(PRETTYCOMPRINT WINDOWCOMS)
|
||||
|
||||
(RPAQQ WINDOWCOMS
|
||||
(RPAQQ WINDOWCOMS
|
||||
[(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE
|
||||
\TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN \CREATE.TTYDISPLAYSTREAM
|
||||
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)
|
||||
(OPTIMIZERS WINDOWPROP)
|
||||
(FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH))
|
||||
(FNS WINDOW.BITMAP)
|
||||
(* ; "lmm 4/23")
|
||||
(COMS (FNS OPENWP TOPWP RESHAPEBYREPAINTFN \INBETWEENP DECODE/WINDOW/OR/DISPLAYSTREAM
|
||||
GROW/REGION CLRPROMPT PROMPTPRINT OPENWINDOWS \INSUREWINDOW)
|
||||
(* ;
|
||||
@@ -1389,23 +1390,23 @@ Middle button down moves closest corner.")
|
||||
)
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
|
||||
[PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP 'LSHIFT)
|
||||
(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))
|
||||
(OTHERARGS (CDDR ARGS)))
|
||||
`(SPREADAPPLY* (fetch (WSOPS ,METHOD) of (fetch (FDEV WINDOWOPS)
|
||||
of ,DISPLAY))
|
||||
,DISPLAY
|
||||
,@OTHERARGS])
|
||||
,@OTHERARGS]
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
|
||||
(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS))
|
||||
(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT))
|
||||
@@ -1868,15 +1869,15 @@ Middle button down moves closest corner.")
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \COERCETODS MACRO [OPENLAMBDA (X)
|
||||
[PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X)
|
||||
(COND
|
||||
((type? WINDOW 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
|
||||
(\INTERNALTOTOPW FIRST) . REST)))
|
||||
(\INTERNALTOTOPW FIRST) . REST)]
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -2042,7 +2043,7 @@ Middle button down moves closest corner.")
|
||||
(* ; "Compiled WINDOWPROP")
|
||||
|
||||
|
||||
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
|
||||
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
|
||||
|
||||
(DEFOPTIMIZER WINDOWPROP (&REST ARGS)
|
||||
(CWINDOWPROP ARGS))
|
||||
@@ -2172,6 +2173,26 @@ Middle button down moves closest corner.")
|
||||
)
|
||||
(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
|
||||
[LAMBDA (WINDOW) (* rrb "26-OCT-83 15:01")
|
||||
|
||||
@@ -3491,7 +3512,7 @@ Middle button down moves closest corner.")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(* "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))
|
||||
(TAIL (CDDR ARGS)))
|
||||
(COND
|
||||
@@ -3502,7 +3523,7 @@ Middle button down moves closest corner.")
|
||||
of ,METHOD-DEVICE)
|
||||
,METHOD-DEVICE
|
||||
,@TAIL]
|
||||
(T (ERROR "OPNAME not quoted: " OPNAME])
|
||||
(T (ERROR "OPNAME not quoted: " OPNAME]
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -3917,40 +3938,42 @@ Middle button down moves closest corner.")
|
||||
|
||||
(FILESLOAD PAINTW)
|
||||
|
||||
(ADDTOVAR WindowMenuCommands
|
||||
(Close '\INTERACTIVE.CLOSEW "Closes a window")
|
||||
(Snap 'SNAPW "Saves a snapshot of a region of the screen.")
|
||||
(Paint 'PAINTW
|
||||
(ADDTOVAR WindowMenuCommands (Close '\INTERACTIVE.CLOSEW "Closes a window")
|
||||
(Snap 'SNAPW "Saves a snapshot of a region of the screen.")
|
||||
(Paint 'PAINTW
|
||||
"Starts a painting mode in which the mouse can be
|
||||
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
|
||||
"Puts image on a file; prompts for filename and format")
|
||||
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
|
||||
"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.
|
||||
(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
|
||||
"Puts image on a file; prompts for filename and format"
|
||||
)
|
||||
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
|
||||
"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.
|
||||
Left button down marks fixed corner; sweep to other 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
|
||||
(SaveVM '(SAVEVM)
|
||||
"Updates the virtual memory.")
|
||||
(Snap '(SNAPW)
|
||||
"Saves a snapshot of a region of the screen.")
|
||||
(Hardcopy '(HARDCOPYW)
|
||||
"Send hardcopy of screen region to printer."
|
||||
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
|
||||
|
||||
(ADDTOVAR BackgroundMenuCommands (SaveVM '(SAVEVM)
|
||||
"Updates the virtual memory.")
|
||||
(Snap '(SNAPW)
|
||||
"Saves a snapshot of a region of the screen.")
|
||||
(Hardcopy '(HARDCOPYW)
|
||||
"Send hardcopy of screen region to printer."
|
||||
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
|
||||
|
||||
"Writes a region of screen to a file; prompts for filename and format"
|
||||
)
|
||||
("To a printer" '(HARDCOPYREGION.TOPRINTER)
|
||||
"Sends a region of screen to a printer of your choosing"))))
|
||||
)
|
||||
("To a printer" '(HARDCOPYREGION.TOPRINTER)
|
||||
|
||||
"Sends a region of screen to a printer of your choosing"
|
||||
))))
|
||||
|
||||
(ADDTOVAR WINDOWUSERFORMS )
|
||||
|
||||
@@ -3975,7 +3998,7 @@ Middle button down moves closest corner.")
|
||||
(* ;; "Arrange for the proper compiler")
|
||||
|
||||
|
||||
(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE)
|
||||
(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(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
|
||||
1992 1993 1994 1999 2000 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (11550 26190 (WINDOWWORLD 11560 . 15313) (WINDOWWORLDP 15315 . 15615) (CHANGEBACKGROUND
|
||||
15617 . 16654) (CHANGEBACKGROUNDBORDER 16656 . 17207) (TILE 17209 . 17801) (
|
||||
\TTY.CREATING.DISPLAYSTREAM 17803 . 18350) (\CREATE.TTY.OUTCHARFN 18352 . 18652) (
|
||||
\CREATE.TTYDISPLAYSTREAM 18654 . 21693) (HASTTYWINDOWP 21695 . 21975) (TTYINFOSTREAM 21977 . 22501) (
|
||||
CREATESCREEN 22503 . 25446) (\INSURESCREEN 25448 . 25697) (\BITMAPTOSCREEN 25699 . 26060) (MAINSCREEN
|
||||
26062 . 26188)) (26837 44120 (WINDOW.MOUSE.HANDLER 26847 . 39642) (\PROTECTED.APPLY 39644 . 39892) (
|
||||
DOWINDOWCOM 39894 . 41914) (DOBACKGROUNDCOM 41916 . 43074) (DEFAULT.BACKGROUND.COPYFN 43076 . 44118))
|
||||
(44201 76084 (BURYW 44211 . 44499) (CLEARW 44501 . 44891) (CLOSEW 44893 . 45667) (\CLOSEW1 45669 .
|
||||
46022) (\OKTOCLOSEW 46024 . 46383) (\INTERACTIVE.CLOSEW 46385 . 47208) (OPENW 47210 . 48265) (
|
||||
DOUSERFNS 48267 . 49428) (DOUSERFNS2 49430 . 49926) (\USERFNISDON'T 49928 . 50199) (\OPENW1 50201 .
|
||||
50551) (CREATEW 50553 . 51817) (CREATEW1 51819 . 54097) (\CREATEW1 54099 . 55318) (OPENDISPLAYSTREAM
|
||||
55320 . 55643) (MOVEW 55645 . 55860) (PPROMPT3 55862 . 56190) (\ONSCREENCLIPPINGREGION 56192 . 56743)
|
||||
(RELMOVEW 56745 . 57043) (SHAPEW 57045 . 61964) (SHAPEW1 61966 . 64668) (\SHAPEW2 64670 . 67356) (
|
||||
RESHOWBORDER 67358 . 67869) (\RESHOWBORDER1 67871 . 72797) (TRACKW 72799 . 73914) (SNAPW 73916 . 75589
|
||||
) (WINDOWREGION 75591 . 76082)) (76085 76781 (MINIMUMWINDOWSIZE 76095 . 76779)) (78428 101693 (
|
||||
ADVISEWDS 78438 . 86381) (SHOWWFRAME 86383 . 88135) (SHOWWTITLE 88137 . 92171) (\STRINGWIDTHGUESS
|
||||
92173 . 92532) (RESHOWTITLE 92534 . 97175) (TOTOPW 97177 . 97416) (\INTERNALTOTOPW 97418 . 98508) (
|
||||
\TTW1 98510 . 101110) (WHICHW 101112 . 101691)) (101822 104660 (WFROMDS 101832 . 103830) (NU\TOTOPWDS
|
||||
103832 . 104268) (\COERCETODS 104270 . 104658)) (105303 112103 (WINDOWP 105313 . 105459) (
|
||||
INSURE.WINDOW 105461 . 105800) (WINDOWPROP 105802 . 106234) (WINDOWADDPROP 106236 . 107970) (
|
||||
WINDOWDELPROP 107972 . 108398) (GETWINDOWPROP 108400 . 108950) (GETWINDOWUSERPROP 108952 . 109379) (
|
||||
PUTWINDOWPROP 109381 . 109846) (REMWINDOWPROP 109848 . 110903) (WINDOWADDFNPROP 110905 . 112101)) (
|
||||
112307 119871 (CWINDOWPROP 112317 . 113322) (CGETWINDOWPROP 113324 . 118542) (\GETWINDOWHEIGHT 118544
|
||||
. 119452) (\GETWINDOWWIDTH 119454 . 119869)) (119872 135320 (OPENWP 119882 . 120160) (TOPWP 120162 .
|
||||
120445) (RESHAPEBYREPAINTFN 120447 . 130699) (\INBETWEENP 130701 . 130917) (
|
||||
DECODE/WINDOW/OR/DISPLAYSTREAM 130919 . 132959) (GROW/REGION 132961 . 133524) (CLRPROMPT 133526 .
|
||||
133930) (PROMPTPRINT 133932 . 134196) (OPENWINDOWS 134198 . 134982) (\INSUREWINDOW 134984 . 135318)) (
|
||||
135451 138700 (OVERLAPPINGWINDOWS 135461 . 137743) (WOVERLAPP 137745 . 138000) (ORDERFROMBOTTOMTOTOP
|
||||
138002 . 138698)) (138749 143532 (\ONSCREENW 138759 . 139465) (\PUTONSCREENW 139467 . 140294) (
|
||||
\UPDATECACHEDFIELDS 140296 . 140560) (\WWCHANGESCREENSIZE 140562 . 141951) (CREATEWFROMIMAGE 141953 .
|
||||
142916) (UPDATEWFROMIMAGE 142918 . 143530)) (144089 196691 (\MEDW.CREATEW 144099 . 148773) (
|
||||
\MEDW.OPENW 148775 . 151133) (\MEDW.CLOSEW 151135 . 152501) (\MEDW.MOVEW 152503 . 163115) (
|
||||
\MEDW.RELMOVEW 163117 . 163496) (\MEDW.SHRINKW 163498 . 171682) (\MEDW.EXPANDW 171684 . 173951) (
|
||||
\MEDW.SHAPEW 173953 . 178559) (\MEDW.REDISPLAYW 178561 . 180516) (\MEDW.BURYW 180518 . 181800) (
|
||||
\MEDW.TOTOPW 181802 . 183150) (\MEDW.DSPCREATE 183152 . 183953) (\GENERIC.DSPCREATE 183955 . 185672) (
|
||||
\GENERIC.DSPCREATE.DESTINATION.BITMAP? 185674 . 185860) (\MEDW.GETWINDOWPROP 185862 . 188100) (
|
||||
\MEDW.PUTWINDOWPROP 188102 . 194887) (\MEDW.CURSOR 194889 . 196689)) (196692 197312 (\GENERIC.CURSOR
|
||||
196702 . 197310)))))
|
||||
(FILEMAP (NIL (11535 26175 (WINDOWWORLD 11545 . 15298) (WINDOWWORLDP 15300 . 15600) (CHANGEBACKGROUND
|
||||
15602 . 16639) (CHANGEBACKGROUNDBORDER 16641 . 17192) (TILE 17194 . 17786) (
|
||||
\TTY.CREATING.DISPLAYSTREAM 17788 . 18335) (\CREATE.TTY.OUTCHARFN 18337 . 18637) (
|
||||
\CREATE.TTYDISPLAYSTREAM 18639 . 21678) (HASTTYWINDOWP 21680 . 21960) (TTYINFOSTREAM 21962 . 22486) (
|
||||
CREATESCREEN 22488 . 25431) (\INSURESCREEN 25433 . 25682) (\BITMAPTOSCREEN 25684 . 26045) (MAINSCREEN
|
||||
26047 . 26173)) (26822 44105 (WINDOW.MOUSE.HANDLER 26832 . 39627) (\PROTECTED.APPLY 39629 . 39877) (
|
||||
DOWINDOWCOM 39879 . 41899) (DOBACKGROUNDCOM 41901 . 43059) (DEFAULT.BACKGROUND.COPYFN 43061 . 44103))
|
||||
(44186 76069 (BURYW 44196 . 44484) (CLEARW 44486 . 44876) (CLOSEW 44878 . 45652) (\CLOSEW1 45654 .
|
||||
46007) (\OKTOCLOSEW 46009 . 46368) (\INTERACTIVE.CLOSEW 46370 . 47193) (OPENW 47195 . 48250) (
|
||||
DOUSERFNS 48252 . 49413) (DOUSERFNS2 49415 . 49911) (\USERFNISDON'T 49913 . 50184) (\OPENW1 50186 .
|
||||
50536) (CREATEW 50538 . 51802) (CREATEW1 51804 . 54082) (\CREATEW1 54084 . 55303) (OPENDISPLAYSTREAM
|
||||
55305 . 55628) (MOVEW 55630 . 55845) (PPROMPT3 55847 . 56175) (\ONSCREENCLIPPINGREGION 56177 . 56728)
|
||||
(RELMOVEW 56730 . 57028) (SHAPEW 57030 . 61949) (SHAPEW1 61951 . 64653) (\SHAPEW2 64655 . 67341) (
|
||||
RESHOWBORDER 67343 . 67854) (\RESHOWBORDER1 67856 . 72782) (TRACKW 72784 . 73899) (SNAPW 73901 . 75574
|
||||
) (WINDOWREGION 75576 . 76067)) (76070 76766 (MINIMUMWINDOWSIZE 76080 . 76764)) (78391 101656 (
|
||||
ADVISEWDS 78401 . 86344) (SHOWWFRAME 86346 . 88098) (SHOWWTITLE 88100 . 92134) (\STRINGWIDTHGUESS
|
||||
92136 . 92495) (RESHOWTITLE 92497 . 97138) (TOTOPW 97140 . 97379) (\INTERNALTOTOPW 97381 . 98471) (
|
||||
\TTW1 98473 . 101073) (WHICHW 101075 . 101654)) (101785 104623 (WFROMDS 101795 . 103793) (NU\TOTOPWDS
|
||||
103795 . 104231) (\COERCETODS 104233 . 104621)) (105248 112048 (WINDOWP 105258 . 105404) (
|
||||
INSURE.WINDOW 105406 . 105745) (WINDOWPROP 105747 . 106179) (WINDOWADDPROP 106181 . 107915) (
|
||||
WINDOWDELPROP 107917 . 108343) (GETWINDOWPROP 108345 . 108895) (GETWINDOWUSERPROP 108897 . 109324) (
|
||||
PUTWINDOWPROP 109326 . 109791) (REMWINDOWPROP 109793 . 110848) (WINDOWADDFNPROP 110850 . 112046)) (
|
||||
112248 119812 (CWINDOWPROP 112258 . 113263) (CGETWINDOWPROP 113265 . 118483) (\GETWINDOWHEIGHT 118485
|
||||
. 119393) (\GETWINDOWWIDTH 119395 . 119810)) (119813 120472 (WINDOW.BITMAP 119823 . 120470)) (120498
|
||||
135946 (OPENWP 120508 . 120786) (TOPWP 120788 . 121071) (RESHAPEBYREPAINTFN 121073 . 131325) (
|
||||
\INBETWEENP 131327 . 131543) (DECODE/WINDOW/OR/DISPLAYSTREAM 131545 . 133585) (GROW/REGION 133587 .
|
||||
134150) (CLRPROMPT 134152 . 134556) (PROMPTPRINT 134558 . 134822) (OPENWINDOWS 134824 . 135608) (
|
||||
\INSUREWINDOW 135610 . 135944)) (136077 139326 (OVERLAPPINGWINDOWS 136087 . 138369) (WOVERLAPP 138371
|
||||
. 138626) (ORDERFROMBOTTOMTOTOP 138628 . 139324)) (139375 144158 (\ONSCREENW 139385 . 140091) (
|
||||
\PUTONSCREENW 140093 . 140920) (\UPDATECACHEDFIELDS 140922 . 141186) (\WWCHANGESCREENSIZE 141188 .
|
||||
142577) (CREATEWFROMIMAGE 142579 . 143542) (UPDATEWFROMIMAGE 143544 . 144156)) (144715 197317 (
|
||||
\MEDW.CREATEW 144725 . 149399) (\MEDW.OPENW 149401 . 151759) (\MEDW.CLOSEW 151761 . 153127) (
|
||||
\MEDW.MOVEW 153129 . 163741) (\MEDW.RELMOVEW 163743 . 164122) (\MEDW.SHRINKW 164124 . 172308) (
|
||||
\MEDW.EXPANDW 172310 . 174577) (\MEDW.SHAPEW 174579 . 179185) (\MEDW.REDISPLAYW 179187 . 181142) (
|
||||
\MEDW.BURYW 181144 . 182426) (\MEDW.TOTOPW 182428 . 183776) (\MEDW.DSPCREATE 183778 . 184579) (
|
||||
\GENERIC.DSPCREATE 184581 . 186298) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186300 . 186486) (
|
||||
\MEDW.GETWINDOWPROP 186488 . 188726) (\MEDW.PUTWINDOWPROP 188728 . 195513) (\MEDW.CURSOR 195515 .
|
||||
197315)) (197318 197938 (\GENERIC.CURSOR 197328 . 197936)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user