Start of a DEMO facility to run demos from inside Medley (#1118)

* Start of a DEMO facility to run demos and part of automatied testing from inside Medley

Originally done for the BALISP 2023 talk. Possibly of use for building tests as well as demos.

lispusers/DEMO

@@ -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

lispusers/DEMO.TEDIT

@@ -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).
+
+
+
+