github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-13 22:19:30 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into mth2--GITFNS-for-personal-repo

Browse Source
This commit is contained in:
Matt Heffron
2024-02-26 16:33:14 -08:00
parent e478213883 76a6e26faa
commit 50ddb40acc
10 changed files with 266 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
greetfiles/APPS-INIT
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Jun-2023 17:20:09" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;11 21130
(FILECREATED "25-Feb-2024 13:56:23" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;17 23321
:CHANGES-TO (FNS Apps.DoInit)
:CHANGES-TO (VARS APPS-INITCOMS)
(FNS Apps.DoInit Apps.AroundExitFn)
:PREVIOUS-DATE "19-Jan-2023 12:44:20"
{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;10)
:PREVIOUS-DATE "25-Feb-2024 13:14:02"
{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;16)
(PRETTYCOMPRINT APPS-INITCOMS)
@@ -16,8 +17,9 @@
(GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
(INITVARS (Apps.NotecardsActivated NIL)
(Apps.RoomsActivated NIL))
(FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS
Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP)
(FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons
Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc
XCL-USER::EXEC_INTERLISP Apps.AroundExitFn)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
@@ -90,6 +92,33 @@
(if (NOT DoNotRefreshButtons)
then (Apps.CreateButtons])
(Apps.SetUpNOTECARDSDIRECTORIES
[LAMBDA NIL
(* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")
(* ;; " This is needed to make sure that lazy loading of Notecard types works.")
(LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
(LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
(LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
(NCDIR (for LOC in (LIST LOC1 LOC2 LOC3) thereis (OR (INFILEP (CONCAT LOC
"system>NOTECARDS"))
(INFILEP (CONCAT LOC
"system>NOTECARDS.LCOM"
]
(if NCDIR
then [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
(INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
(SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
1)))
(NC.SetUpNOTECARDSDIRECTORIES NCDIR)
T
else (PRIN1 "Warning: Notecards directory could not be found." T)
(PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
(PRIN1 "and Notecards will not work properly." T)
NIL])
(Apps.DoInit
[LAMBDA NIL
@@ -173,7 +202,16 @@
(* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")
(SETTOPVAL '\NC.SourceAccessFlg NIL])
(SETTOPVAL '\NC.SourceAccessFlg NIL)
(* ;; "Setup NOTECARDSDIRECTORIES.")
(Apps.SetUpNOTECARDSDIRECTORIES)
(* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")
(SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
'MEDLEY-INIT-VARS AROUNDEXITFNS])
(Apps.CreateButtons
[LAMBDA (DoDocsToo) (* ; "Edited 13-Dec-2022 12:51 by frank")
@@ -366,6 +404,11 @@
YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
(XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
(XCL:SET-EXEC-TYPE 'INTERLISP])
(Apps.AroundExitFn
[LAMBDA (EVENT)
(if (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
then (Apps.SetUpNOTECARDSDIRECTORIES])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@@ -376,8 +419,8 @@
(BKSYSBUF " ")
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) (
Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) (
Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994
)))))
(FILEMAP (NIL (1229 23187 (Apps.InitNotecards 1239 . 5101) (Apps.SetUpNOTECARDSDIRECTORIES 5103 . 6658
) (Apps.DoInit 6660 . 10257) (Apps.CreateButtons 10259 . 19083) (Apps.CreateLabel 19085 . 19895) (
Apps.ActivateCLOS 19897 . 21246) (Apps.ActivateRooms 21248 . 22099) (Apps.ShowDoc 22101 . 22250) (
XCL-USER::EXEC_INTERLISP 22252 . 23024) (Apps.AroundExitFn 23026 . 23185)))))
STOP

BIN
greetfiles/APPS-INIT.LCOM
View File

Binary file not shown.

113
library/lafite/UNIXMAIL
View File

@@ -1,20 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "30-Sep-2021 16:06:26" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNIXMAIL.;2| 82866
|changes| |to:| (VARS UNIXMAILCOMS)
(FNS UNIX.POLLNEWMAIL UNIX.NEXTMESSAGE UNIXMAILER.OPENMAILBOX
UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX UNIXSPOOL.OPENMAILBOX
UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX UNIX.FLUSH.STREAM
UNIX.RETRIEVE.LINE \\UNIXMAIL.SEND \\UNIXMAIL.SEND.WRAPLINES \\SMTP-DUMP
\\UNIXMAIL.SEND.PARSE \\UNIXMAIL.CHECK.ABORT \\UNIXMAIL.MUNG.RECIPIENTS
\\UNIXMAIL.SMTP \\UNIXMAIL.SMTP.FLUSH \\UNIXMAIL.CHANGE.MODE
\\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.LOGIN \\UNIXMAIL.PARSENAMES
\\UNIXMAIL.MAKEANSWERFORM \\UNIXMAIL.MESSAGE.FROM.SELF.P
\\UNIXMAIL.MESSAGE.P \\UNIXMAIL.REALADDRESS \\UNIXMAIL.FQNAME
\\UNIXMAIL.FIXMICROSOFT)
(FILECREATED "24-Feb-2024 10:26:07" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;3| 81776
|previous| |date:| "10-Feb-2000 12:03:28" |{DSK}<project>medley3.5>library>unixmail.;42|)
:EDIT-BY "lmm"
:CHANGES-TO (VARS UNIXMAILCOMS)
:PREVIOUS-DATE "30-Sep-2021 16:06:26" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;1|
)
; Copyright (c) 1989-1992, 1997, 1999, 1920, 2021 by ENVOS Corporation.
@@ -22,7 +15,11 @@
(PRETTYCOMPRINT UNIXMAILCOMS)
(RPAQQ UNIXMAILCOMS
((DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
(
(* |;;| " LMM 2/24/24 need LAFITE to load")
(FILES LAFITE)
(DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS NSMAIL)
(RECORDS UNIXMAILBOX UNIXMAILFILEINFO UNIXMAILPARSE))
(ALISTS (LAFITEMODELST UNIX))
@@ -90,6 +87,13 @@
'(CHANGE \\SENDMSG.CHANGE.MODE TO
\\UNIXMAIL.CHANGE.MODE)))))
(PROP FILETYPE UNIXMAIL)))
(* |;;| " LMM 2/24/24 need LAFITE to load")
(FILESLOAD LAFITE)
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
@@ -106,8 +110,8 @@
)
(ADDTOVAR LAFITEMODELST (UNIX 3 \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.SEND \\UNIXMAIL.MAKEANSWERFORM
\\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P
\\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
\\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P
\\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
@@ -133,9 +137,9 @@
(RPAQQ UNIXMAIL.MSOPS.LIST ((MAILER UNIX.POLLNEWMAIL UNIXMAILER.OPENMAILBOX UNIX.NEXTMESSAGE
UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
(SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE
UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
(SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE
UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
@@ -979,13 +983,13 @@
(* |;;| "This returns multiple-values, so it's a CL:LAMBDA (what the heck).")
(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS () (* \; "Edited 27-Feb-99 13:55 by rmk:")
(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS () (* \; "Edited 27-Feb-99 13:55 by rmk:")
(* |;;| "Opens two streams representing the input and output streams of an SMTP TCP connection. On failure return NIL and a string describing the failure.")
(SELECTQ UNIXMAIL.SEND.MODE
(PROCESS (|if| (EQ (MACHINETYPE)
'MAIKO)
'MAIKO)
|then|
(* |;;| "UNIXMAIL.SEND.PROCESS can be a list of possibilities because the process may be in different places in different operating systems (e.g. solaris vs. sunos). If the first one doesn't exist at this time, we search the remaining ones and move the first one we find to the beginning of the list for next time. This could be done as an AFTERSYSOUTFORMS, but easy enough just to do it here.")
@@ -993,36 +997,32 @@
(LET ((S (CREATE-PROCESS-STREAM
(CONCAT (IF (NLISTP UNIXMAIL.SEND.PROCESS)
THEN UNIXMAIL.SEND.PROCESS
ELSEIF (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY
(CAR UNIXMAIL.SEND.PROCESS)))
ELSEIF (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY (CAR
UNIXMAIL.SEND.PROCESS
)))
THEN (CAR UNIXMAIL.SEND.PROCESS)
ELSE (FOR P IN (CDR UNIXMAIL.SEND.PROCESS)
WHEN (INFILEP (PACKFILENAME 'HOST
'DSK
'BODY P))
DO (SETQ UNIXMAIL.SEND.PROCESS
(CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)
))
(RETURN P)))
WHEN (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY P))
DO (SETQ UNIXMAIL.SEND.PROCESS
(CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)))
(RETURN P)))
(IF UNIXMAIL.SEND.HOST
THEN (CONCAT " " UNIXMAIL.SEND.HOST)
ELSE "")))))
(CL:VALUES S S))
|else| (CL:VALUES NIL
"this MACHINETYPE can't do Unix process-streams; change UNIXMAIL.SEND.MODE"
)))
)))
(SOCKET (|if| (EQ (MACHINETYPE)
'MAIKO)
|then| (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"
))
25)))
(CL:VALUES S S))
'MAIKO)
|then| (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"))
25)))
(CL:VALUES S S))
|else| (LET ((S (TCP.OPEN UNIXMAIL.SEND.HOST 25 NIL 'ACTIVE 'INPUT T)))
(|if| S
|then| (CL:VALUES S (TCP.OTHER.STREAM S))
|else| (CL:VALUES NIL
"TCP.OPEN failed; check your Lisp TCP configuration"
)))))
(|if| S
|then| (CL:VALUES S (TCP.OTHER.STREAM S))
|else| (CL:VALUES NIL
"TCP.OPEN failed; check your Lisp TCP configuration")))))
(ERROR "Unrecognized UNIXMAIL.SEND.MODE:" UNIXMAIL.SEND.MODE)))
@@ -1368,23 +1368,22 @@
(SETQ LAFITESENDINGMENUITEMS (EDITE (CONS (CAR LAFITESENDINGMENUITEMS)
(CDR LAFITESENDINGMENUITEMS))
'(CHANGE \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE)
)))
'(CHANGE \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE))))
(PUTPROPS UNIXMAIL FILETYPE :COMPILE-FILE)
(PUTPROPS UNIXMAIL COPYRIGHT ("ENVOS Corporation" 1989 1990 1991 1992 1997 1999 1920 2021))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (7835 26260 (UNIX.POLLNEWMAIL 7845 . 9795) (UNIX.NEXTMESSAGE 9797 . 9973) (
UNIXMAILER.OPENMAILBOX 9975 . 14371) (UNIXMAILER.RETRIEVEMESSAGE 14373 . 15580) (
UNIXMAILER.CLOSEMAILBOX 15582 . 16607) (UNIXSPOOL.OPENMAILBOX 16609 . 22826) (
UNIXSPOOL.RETRIEVEMESSAGE 22828 . 24909) (UNIXSPOOL.CLOSEMAILBOX 24911 . 26258)) (26308 56798 (
UNIX.FLUSH.STREAM 26318 . 26899) (UNIX.RETRIEVE.LINE 26901 . 28090) (\\UNIXMAIL.SEND 28092 . 38386) (
\\UNIXMAIL.SEND.WRAPLINES 38388 . 42018) (\\SMTP-DUMP 42020 . 43290) (\\UNIXMAIL.SEND.PARSE 43292 .
46536) (\\UNIXMAIL.CHECK.ABORT 46538 . 47366) (\\UNIXMAIL.MUNG.RECIPIENTS 47368 . 52236) (
\\UNIXMAIL.SMTP 52238 . 52843) (\\UNIXMAIL.SMTP.FLUSH 52845 . 55322) (\\UNIXMAIL.CHANGE.MODE 55324 .
56796)) (56886 60196 (\\UNIXMAIL.SMTP.TCP.STREAMS 56886 . 60196)) (60275 81847 (
\\UNIXMAIL.AUTHENTICATE 60285 . 61976) (\\UNIXMAIL.LOGIN 61978 . 62323) (\\UNIXMAIL.PARSENAMES 62325
. 64643) (\\UNIXMAIL.MAKEANSWERFORM 64645 . 69527) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 69529 . 70658) (
\\UNIXMAIL.MESSAGE.P 70660 . 70979) (\\UNIXMAIL.REALADDRESS 70981 . 75025) (\\UNIXMAIL.FQNAME 75027 .
75632) (\\UNIXMAIL.FIXMICROSOFT 75634 . 81845)))))
(FILEMAP (NIL (7090 25515 (UNIX.POLLNEWMAIL 7100 . 9050) (UNIX.NEXTMESSAGE 9052 . 9228) (
UNIXMAILER.OPENMAILBOX 9230 . 13626) (UNIXMAILER.RETRIEVEMESSAGE 13628 . 14835) (
UNIXMAILER.CLOSEMAILBOX 14837 . 15862) (UNIXSPOOL.OPENMAILBOX 15864 . 22081) (
UNIXSPOOL.RETRIEVEMESSAGE 22083 . 24164) (UNIXSPOOL.CLOSEMAILBOX 24166 . 25513)) (25563 56053 (
UNIX.FLUSH.STREAM 25573 . 26154) (UNIX.RETRIEVE.LINE 26156 . 27345) (\\UNIXMAIL.SEND 27347 . 37641) (
\\UNIXMAIL.SEND.WRAPLINES 37643 . 41273) (\\SMTP-DUMP 41275 . 42545) (\\UNIXMAIL.SEND.PARSE 42547 .
45791) (\\UNIXMAIL.CHECK.ABORT 45793 . 46621) (\\UNIXMAIL.MUNG.RECIPIENTS 46623 . 51491) (
\\UNIXMAIL.SMTP 51493 . 52098) (\\UNIXMAIL.SMTP.FLUSH 52100 . 54577) (\\UNIXMAIL.CHANGE.MODE 54579 .
56051)) (56141 59147 (\\UNIXMAIL.SMTP.TCP.STREAMS 56141 . 59147)) (59226 80798 (
\\UNIXMAIL.AUTHENTICATE 59236 . 60927) (\\UNIXMAIL.LOGIN 60929 . 61274) (\\UNIXMAIL.PARSENAMES 61276
. 63594) (\\UNIXMAIL.MAKEANSWERFORM 63596 . 68478) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68480 . 69609) (
\\UNIXMAIL.MESSAGE.P 69611 . 69930) (\\UNIXMAIL.REALADDRESS 69932 . 73976) (\\UNIXMAIL.FQNAME 73978 .
74583) (\\UNIXMAIL.FIXMICROSOFT 74585 . 80796)))))
STOP

BIN
library/lafite/UNIXMAIL.DFASL
View File

Binary file not shown.

127
lispusers/DEMO Normal file
View File

@@ -0,0 +1,127 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Mar-2023 11:59:58" {DSK}<home>larry>il>medley>lispusers>DEMO.;3 5662
:EDIT-BY "lmm"
:CHANGES-TO (VARS DEMOCOMS)
:PREVIOUS-DATE "24-Mar-2023 07:29:15" {DSK}<home>larry>il>medley>lispusers>DEMO.;2)
(PRETTYCOMPRINT DEMOCOMS)
(RPAQQ DEMOCOMS ((VARS (HELPTIME 1)
(AUTOBACKTRACEFLG 'ALWAYS))
(COMS * BKSYSOBJCOMS)
(FNS MEDLEY-CONTRIB OPEN-URL)))
(RPAQQ HELPTIME 1)
(RPAQQ AUTOBACKTRACEFLG ALWAYS)
(RPAQQ BKSYSOBJCOMS [(FNS BKSYSOBJ BKSYSOBJ.BUTTONEVENTINFN BKSYSOBJ.COPYBUTTONEVENTINFN
BKSYSOBJ.DISPLAYFN BKSYSOBJ.FINDEXEC BKSYSOBJ.IMAGEBOXFN)
(INITVARS (BKSYSOBJFNS (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN
NIL NIL NIL 'BKSYSOBJ.BUTTONEVENTINFN
'BKSYSOBJ.COPYBUTTONEVENTINFN])
(DEFINEQ
(BKSYSOBJ
[LAMBDA (STRING) (* ; "Edited 18-Mar-2023 12:52 by rmk")
(IMAGEOBJCREATE STRING BKSYSOBJFNS])
(BKSYSOBJ.BUTTONEVENTINFN
[LAMBDA (OBJ WINDOW) (* ; "Edited 18-Mar-2023 13:51 by rmk")
(LET [(EXECW (BKSYSOBJ.FINDEXEC))
(STR (IMAGEOBJPROP OBJ 'OBJECTDATUM]
(CL:WHEN (MEMB (NTHCHARCODE STR -1)
(CHARCODE (%) %])))
(SETQ STR (SUBSTRING STR 1 -2)))
(CL:WHEN EXECW
(GIVE.TTY.PROCESS EXECW)
(BKSYSBUF STR))])
(BKSYSOBJ.COPYBUTTONEVENTINFN
[LAMBDA (OBJ WINDOW REGION) (* ; "Edited 3-Jan-2022 08:36 by rmk")
(CL:WHEN (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA))
[COPYINSERT (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA])])
(BKSYSOBJ.DISPLAYFN
[LAMBDA (OBJ WINDOW) (* ; "Edited 18-Mar-2023 13:04 by rmk")
(DSPFONT DEFAULTFONT WINDOW)
(FOR I C (FONTARRAY _ (FONTMAPARRAY))
(STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) FROM 1
DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
(EOL (TERPRI WINDOW))
(NIL (RETURN))
(IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
THEN (DSPFONT (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1)))
WINDOW)
ELSE (PRINTCCODE C WINDOW])
(BKSYSOBJ.FINDEXEC
[LAMBDA NIL (* ; "Edited 18-Mar-2023 13:45 by rmk")
(* ;; "Finds the first exec with an Interlisp read table.")
(find W P in (OPENWINDOWS) suchthat (SETQ P (WINDOWPROP W 'PROCESS))
(AND (STRPOS "EXEC" (PROCESSPROP P 'NAME)
1 NIL T)
(STREQUAL "INTERLISP" (READTABLEPROP
(LISTGET (PROCESSPROP P 'PROFILE)
'*READTABLE*)
'NAME])
(BKSYSOBJ.IMAGEBOXFN
[LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 18-Mar-2023 13:04 by rmk")
(* ;; "Calculate the height of each line, and the width of the widest line.")
(* ;;
 "Probably ought to compute the max height per line, at every font change, add it at each EOL.")
(SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
(FOR I C (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
(FONT _ (FONTCREATE DEFAULTFONT NIL NIL NIL IMAGESTREAM))
(HEIGHT _ 0)
(LINELENGTH _ 0)
(MAXLINELENGTH _ 0)
(FONTARRAY _ (FONTMAPARRAY)) FROM 1
DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
(EOL (ADD HEIGHT (FONTPROP FONT 'HEIGHT))
(CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
(SETQ MAXLINELENGTH LINELENGTH))
(SETQ LINELENGTH 0))
(NIL (* ; "end of string")
(CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
(SETQ MAXLINELENGTH LINELENGTH))
(RETURN (CREATE IMAGEBOX
XSIZE _ MAXLINELENGTH
YSIZE _ HEIGHT
YDESC _ (DIFFERENCE HEIGHT (FONTPROP FONT 'HEIGHT))
XKERN _ 0)))
(IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
THEN (SETQ FONT (FONTCREATE (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1)))
NIL NIL NIL IMAGESTREAM))
ELSE (ADD LINELENGTH (CHARWIDTH C FONT])
)
(RPAQ? BKSYSOBJFNS (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN NIL NIL NIL
'BKSYSOBJ.BUTTONEVENTINFN 'BKSYSOBJ.COPYBUTTONEVENTINFN))
(DEFINEQ
(MEDLEY-CONTRIB
[LAMBDA (REPO) (* ; "Edited 15-Mar-2023 08:05 by lmm")
(OPEN-URL (CONCAT "https://github.com/Interlisp/" REPO "/graphs/contributors"])
(OPEN-URL
[LAMBDA (URL) (* ; "Edited 24-Mar-2023 06:31 by lmm")
(ShellBrowse URL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1038 5085 (BKSYSOBJ 1048 . 1211) (BKSYSOBJ.BUTTONEVENTINFN 1213 . 1668) (
BKSYSOBJ.COPYBUTTONEVENTINFN 1670 . 1923) (BKSYSOBJ.DISPLAYFN 1925 . 2572) (BKSYSOBJ.FINDEXEC 2574 .
3334) (BKSYSOBJ.IMAGEBOXFN 3336 . 5083)) (5264 5639 (MEDLEY-CONTRIB 5274 . 5490) (OPEN-URL 5492 . 5637
)))))
STOP

BIN
lispusers/DEMO-FEATURES.TEDIT Normal file
View File

Binary file not shown.

BIN
lispusers/DEMO-OVERVIEW.TEDIT Normal file
View File

Binary file not shown.

BIN
lispusers/DEMO-PROJECT.TEDIT Normal file
View File

Binary file not shown.

BIN
lispusers/DEMO.LCOM Normal file
View File

Binary file not shown.

29
lispusers/DEMO.TEDIT Normal file
View File

@@ -0,0 +1,29 @@
DEMO -- utilities for running demos / tutorials in Medley
includes
OPEN-URL (URL)
(rename of ShellBrowse)
MEDLEY-CONTRIB(REPO)
shows GitHub contributors to given repo
uses ShellBrowse
BKSYSOBJ(string)
DEMO-*.TEDIT
contains scripts / TEDIT file talks
add your own
BKSYSOBJ is the start of a facility
(TEDIT.INSERT.OBJ (BKSYSOBJ ª(CONS NILº) (TEXTSTREAM(WHICHW)]
You should see (CONS NIL) in the TEDIT stream, clicking should shove (CONS NIL into an Interlisp exec, waiting for ) or ]. (probably the image objectg should be shaded, may also have to set the RDTBL flag on BKSYSBUF for strings, but this is a start).