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

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