Lmm cleanup new shell device (#1006)

* reset defaultexternalformat when returning

* Replace so *SHELL-DEVICE* is default

.github/workflows/buildLoadup.yml

@@ -1,4 +1,4 @@
-#re*******************************************************************************
+#*******************************************************************************
 # buidLoadup.yml
 #
 # Interlisp workflow to build Medley release and push it to github. This workflow
@@ -59,8 +59,8 @@ jobs:
       - id: force
         run: >
           if [ '${{ toJSON(inputs) }}' = 'null'  ];
-          then echo ::set-output name=force::'${{ github.event.inputs.force }}'; echo "workflow_dispatch";
-          else echo ::set-output name=force::'${{ inputs.force }}'; echo "workflow_call";
+          then echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT; echo "workflow_dispatch";
+          else echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT; echo "workflow_call";
           fi
         
 
@@ -79,7 +79,7 @@ jobs:
     steps: 
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -110,7 +110,7 @@ jobs:
     steps:
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -118,7 +118,7 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
 
       # Setup release tag
       - name: Setup Release Tag
@@ -129,20 +129,20 @@ jobs:
       - name: Setup Environment Variables
         id: setup_env
         run: |
-          echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
+          echo "build_time=$(date -u +'%Y-%m-%dT%H:%M:%SZ')" >> $GITHUB_OUTPUT
 
       # Get Maiko release information, retrieves the name of the latest
       # release.  Used to download the correct Maiko release
       - name: Get Maiko Release Information
         id: latest_version
-        uses: abatilo/release-info-action@v1.3.0
+        uses: abatilo/release-info-action@v1.3.2
         with:
           owner: ${{ github.repository_owner }}
           repo: maiko
           
       # Download Maiko Release Assets
       - name: Download Release Assets
-        uses: robinraju/release-downloader@v1.2
+        uses: robinraju/release-downloader@v1.6
         with:
           repository: ${{ github.repository_owner }}/maiko
           token: ${{ secrets.GITHUB_TOKEN }}
@@ -165,24 +165,20 @@ jobs:
 
       - name: Build loadups release tar
         run: |
-          cp -p tmp/full.sysout tmp/lisp.sysout tmp/whereis.hash loadups/
-          cp -p tmp/exports.all library/
           cd ..
-          tar cfz medley/tmp/${release_tag}-loadups.tgz        \
+          tar cfz medley/tmp/${RELEASE_TAG}-loadups.tgz        \
             medley/loadups/lisp.sysout               \
             medley/loadups/full.sysout               \
             medley/loadups/whereis.hash              \
             medley/library/exports.all
-
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
       
       - name: Build runtime release tar
         run: |
           cd ..
-          tar cfz medley/tmp/${release_tag}-runtime.tgz          \
+          tar cfz medley/tmp/${RELEASE_TAG}-runtime.tgz          \
                      --exclude "*~" --exclude "*#*"              \
                      --exclude exports.all                       \
+                     medley/clos                                 \
                      medley/docs/dinfo                           \
                      medley/doctools                             \
                      medley/greetfiles                           \
@@ -197,40 +193,25 @@ jobs:
                      medley/lispusers                            \
                      medley/sources                              \
                      medley/internal
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
 
-
-      - name: "Create release"
-        uses: "actions/github-script@v5"
+      - name: Delete existing release with same tag (if any)
+        uses: cb80/delrel@latest
         with:
-          github-token: "${{ secrets.GITHUB_TOKEN }}"
-          script: |
-            try {
-              await github.rest.repos.createRelease({
-                draft: false,
-                generate_release_notes: true,
-                name: process.env.release_tag,
-                owner: context.repo.owner,
-                prerelease: false,
-                repo: context.repo.repo,
-                tag_name: process.env.release_tag,
-              });
-            } catch (error) {
-              core.setFailed(error.message);
-            }
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
-
-      - name: "Upload release assets"
-        uses: AButler/upload-release-assets@v2.0
-        with:
-          files: 'tmp/${{ env.release_tag }}-loadups.tgz;tmp/${{ env.release_tag }}-runtime.tgz'
-          repo-token: ${{ secrets.GITHUB_TOKEN }}
-          release-tag: ${{ env.release_tag }}
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
+            tag: ${{ env.RELEASE_TAG }} 
+        continue-on-error: true
 
+      - name: Push the release
+        uses: ncipollo/release-action@v1
+        with: 
+          allowUpdates: true
+          artifacts:
+            tmp/${{ env.RELEASE_TAG }}-loadups.tgz,
+            tmp/${{ env.RELEASE_TAG }}-runtime.tgz
+          tag: ${{ env.RELEASE_TAG }}
+          draft: false
+          prerelease: false
+          generateReleaseNotes: true
+          token: ${{ secrets.GITHUB_TOKEN }}
 
 ######################################################################################
 
@@ -249,7 +230,7 @@ jobs:
     steps: 
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -265,6 +246,6 @@ jobs:
       - name: Output
         id: output
         run: |
-          echo ::set-output name=build_successful::'true'
+          echo "build_successful='true'" >> $GITHUB_OUTPUT
           
 ######################################################################################

greetfiles/MEDLEYDIR-INIT

@@ -1,10 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 9-Mar-2022 11:50:44" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2
 4690   
+
(FILECREATED "22-Nov-2022 20:59:24" {DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;6
 2860   
 
       :CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
 
-      :PREVIOUS-DATE "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
+      :PREVIOUS-DATE "22-Nov-2022 20:42:43" 
+{DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;5)
 
 
 (PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
@@ -13,7 +14,7 @@
        ([P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
                               "")
                          "/sources/MEDLEYDIR.LCOM"))
-           (MEDLEY-INIT-VARS)
+           (MEDLEY-INIT-VARS 'GREET)
            (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
         (FILES BACKGROUND-YIELD)
         (VARS 
@@ -38,7 +39,7 @@
                    "")
               "/sources/MEDLEYDIR.LCOM"))
 
-(MEDLEY-INIT-VARS)
+(MEDLEY-INIT-VARS 'GREET)
 
 (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
 
@@ -81,44 +82,7 @@
                                                :PACKAGE "INTERLISP"])
 )
 
-(ADDTOVAR FONTDEFS

-          [LARGER (FONTCHANGEFLG . ALL)
-                 (FILELINELENGTH . 102)
-                 (FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
-                                     (GACHA 10)
-                                     (TERMINAL 10)
-                                     (POSTSCRIPT (TERMINAL 10)))
-                        (ITALICFONT 1 (HELVETICA 12 MIR)
-                               (GACHA 10 MIR)
-                               (MODERN 10 MIR)
-                               (POSTSCRIPT (MODERN 10 MIR)))
-                        (BOLDFONT 2 (HELVETICA 12 BRR)
-                               (HELVETICA 10 BRR)
-                               (MODERN 10 BRR)
-                               (POSTSCRIPT (HELVETICA 12 BRR)))
-                        (LITTLEFONT 3 (HELVETICA 10)
-                               (HELVETICA 6 MIR)
-                               (MODERN 10 MIR)
-                               (POSTSCRIPT (MODERN 10 MIR)))
-                        (TINYFONT 6 (GACHA 10)
-                               (GACHA 6)
-                               (TERMINAL 6)
-                               (POSTSCRIPT (TERMINAL 6)))
-                        (BIGFONT 4 (HELVETICA 12 BRR)
-                               NIL
-                               (MODERN 12 BRR)
-                               (POSTSCRIPT (MODERN 12 BRR)))
-                        (MENUFONT 5 (HELVETICA 12)
-                               (HELVETICA 12)
-                               (POSTSCRIPT (HELVETICA 12)))
-                        (COMMENTFONT 6 (HELVETICA 12)
-                               (HELVETICA 10)
-                               (MODERN 10)
-                               (POSTSCRIPT (MODERN 10)))
-                        (TEXTFONT 7 (TIMESROMAN 12)
-                               NIL
-                               (CLASSIC 12)
-                               (POSTSCRIPT (CLASSIC 12])
+(ADDTOVAR FONTDEFS
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1949 2774 (INTERLISPMODE 1959 . 2772)))))
+  (FILEMAP (NIL (1986 2811 (INTERLISPMODE 1996 . 2809)))))
 STOP

library/UNIXCOMM

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Oct-2022 16:06:36" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;2
 20352  
+
(FILECREATED "11-Oct-2022 10:18:47" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;4
 14580  
 
-      :CHANGES-TO (FNS CREATE-PROCESS-STREAM)
+      :CHANGES-TO (FNS CREATE-SHELL-STREAM CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN 
+                       CREATE-UNIX-SOCKET-STREAM ACCEPT-UNIX-SOCKET-STREAM INITIALIZE-SHELL-DEVICE)
+                  (VARS UNIXCOMMCOMS)
 
-      :PREVIOUS-DATE " 7-Jul-2022 10:42:46" 
+      :PREVIOUS-DATE " 8-Oct-2022 16:06:36" 
 {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
 
 
@@ -25,10 +27,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
               (FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM 
                    CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
         [COMS                                                (* ; "Operations on the shell device")

-              (FNS INITIALIZE-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW 
+              (FNS INITIALIZE-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW 
                    UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
-              (GLOBALVARS *NEW-SHELL-DEVICE*)
-              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
+              (GLOBALVARS *SHELL-DEVICE*)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE))
                      (ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
         (COMS                                                (* ; 
 
                                                      "Stuff for direct manipulation of Unix sockets")

@@ -36,14 +38,6 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
         (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-CHANNEL)
                (P (CHECKIMPORTS '(FILEIO LLSUBRS)
                          T)))
-        [COMS 
-              (* ;; "Obsolete stuff.  This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device")

-
-              (FNS UNIX-BACKFILEPTR UNIX-READ INITIALIZE-SHELL-DEVICE UNIX-STREAM-IN UNIX-STREAM-EOFP
-                   UNIX-STREAM-PEEK)
-              (GLOBALVARS *SHELL-DEVICE*)
-              (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-PEEKEDCHAR UNIX-LASTCHAR))
-              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE]
         (PROP FILETYPE UNIXCOMM)))
 
 
@@ -107,24 +101,17 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
           (RETURN LENGTH-WRITTEN])
 
 (CREATE-SHELL-STREAM

-  [LAMBDA (TERMTYPE COMMAND)                                 (* ; "Edited 21-May-90 15:39 by jrb:")

-    (LET ((CHAN (FORK-SHELL
 TERMTYPE COMMAND))
-          (SHELL-DEV (if
 (SUBRCALL UNIX-HANDLECOMM 8)
-                         then
                            (* ; 
-
                                                           "SUBRCALL tests that this is supported")

-                               *NEW-SHELL-DEVICE*
-                       else
 *SHELL-DEVICE*)))
+  [LAMBDA (TERMTYPE COMMAND)
                                 (* ; "Edited 11-Oct-2022 09:56 by lmm")


+                                                             (* ; "Edited 21-May-90 15:39 by jrb:")

+    (LET ((CHAN (FORK-SHELL
 TERMTYPE COMMAND)))
          (COND
             (CHAN (LET ((STR (create
 STREAM
                                     ACCESS _ 'BOTH
-                                    DEVICE _ SHELL-DEV)))
+                                    DEVICE _ *SHELL-DEVICE*)))
                        (CL:SETF (UNIX-CHANNEL STR)
                               CHAN)
-
-                       (* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether.  Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")

-
                        (push
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
-                              STR)
+                             STR)
                        (STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
                        (STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
                        STR])
@@ -132,49 +119,40 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 (CREATE-PROCESS-STREAM

   [LAMBDA (COMM)
 
+    (* ;; "Edited 11-Oct-2022 10:05 by lmm")

+
     (* ;; "Edited  8-Oct-2022 16:04 by lmm")

 
     (* ;; "Edited  3-Jul-2022 16:04 by rmk: Removed external format here, the device has the environmental defaultg")

 
-    (* ;; "Edited 26-Jun-2022 13:52 by larry")

-
-    (* ;; "Edited 26-Jun-2022 13:31 by lmm - set external format of shell stream to utf-8 ??")

-
     (* ;; "Edited 21-May-90 15:39 by jrb:")

 
-    (LET* ((SHELL-DEV (if
 (AND (BOUNDP '*NEW-SHELL-DEVICE*)
-                               (SUBRCALL UNIX-HANDLECOMM 8))
-                          then
                               (* ; 
-
                                                             "SUBRCALL tests that this is supported")

-                               *NEW-SHELL-DEVICE*
-                        else
 *SHELL-DEVICE*))
-           (STR (create
 STREAM
-                       ACCESS _ 'BOTH
-                       DEVICE _ SHELL-DEV
-                       EOLCONVENTION _ LF.EOLC))
-           (CHAN (FORK-UNIX
 COMM)))
-          (if
 CHAN
-              then
 (CL:SETF (UNIX-CHANNEL STR)
-                          CHAN) 
-
-                   (* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether.  Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")

-
-                   (push
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
-                         STR)
-                   STR
-            else
 NIL])
+    (LET ((CHAN (FORK-UNIX
 COMM)))
+         (if
 CHAN
+             then
 (LET ((STR (create
 STREAM
+                                    ACCESS _ 'BOTH
+                                    DEVICE _ *SHELL-DEVICE*
+                                    EOLCONVENTION _ LF.EOLC)))
+                       (CL:SETF (UNIX-CHANNEL STR)
+                              CHAN)
+                       (push
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
+                             STR)
+                       STR])
 
 (UNIXCOMM-AROUNDEXITFN

-  [LAMBDA (EVENT)                                            (* ; "Edited  2-Jul-90 16:35 by jrb:")

+  [LAMBDA (EVENT)
                                            (* ; "Edited 11-Oct-2022 10:07 by lmm")

+
+    (* ;; 
+
    "only using *NEW-SHELL-DEVICE* for creation; *SHELL-DEVICE* --  will cleanup in another pass")

+
                                                             (* ; "Edited  2-Jul-90 16:35 by jrb:")

     (CASE EVENT
-        ((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT) (for
 STREAM
-                                                               in
 (fetch
 (FDEV OPENFILELST)
-                                                                         of
 *SHELL-DEVICE*)
-                                                               do
 (CLOSEF STREAM)))
+        ((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT) 
+           (for
 STREAM in
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*) do
 (CLOSEF STREAM))
+           (REPLACE
 (FDEV DEFAULTEXTERNALFORMAT) OF
 *SHELL-DEVICE* WITH
 (SYSTEM-EXTERNALFORMAT)))
         ((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT) 
 
-           (* ;; 
-
      "Make sure any Unix sockets get closed here, so their file system handles get closed as well")

+           (* ;; 
+
        "Make sure any Unix sockets get closed here, so their file system handles get closed as well")

 
            (for
 STREAM in
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
               when
 (EQ -3 (SUBRCALL UNIX-HANDLECOMM 14 (UNIX-CHANNEL STREAM)))
@@ -187,25 +165,24 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 
 (DEFINEQ
 
-(INITIALIZE-NEW-SHELL-DEVICE

-  [LAMBDA NIL
                                                (* ; "Edited  7-Jul-2022 10:41 by rmk")


-                                                             (* ; "Edited  3-Jul-2022 16:04 by rmk")


-                                                             (* ; "Edited 12-Feb-90 17:00 by bvm")

-    (SETQ *NEW-SHELL-DEVICE* (create
 FDEV
-                                    FDBINABLE _ T
-                                    NODIRECTORIES _ T
-                                    DEVICENAME _ (FUNCTION UNIX-PTY-NEW)
-                                    BIN _ (FUNCTION \BUFFERED.BIN)
-                                    BOUT _ (FUNCTION UNIX-STREAM-OUT)
-                                    PEEKBIN _ (FUNCTION \BUFFERED.PEEKBIN)
-                                    CLOSEFILE _ (FUNCTION UNIX-STREAM-CLOSE)
-                                    GETFILEINFO _ (FUNCTION NILL)
-                                    SETFILEINFO _ (FUNCTION NILL)
-                                    EOFP _ (FUNCTION UNIX-STREAM-EOFP-NEW)
-                                    BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR-NEW)
-                                    GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
-                                    BLOCKIN _ (FUNCTION \BUFFERED.BINS)
-                                    DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
+(INITIALIZE-SHELL-DEVICE

+  [LAMBDA NIL
                                                (* ; "Edited 11-Oct-2022 09:35 by lmm")

+
+    (* ;; "only using for holding open list")

+
                                                             (* ; "Edited  3-Jul-2022 16:15 by rmk")


+                                                             (* ; "Edited 14-Dec-88 10:45 by bane")

+    (SETQ *SHELL-DEVICE* (create
 FDEV
+                                NODIRECTORIES _ T
+                                DEVICENAME _ 'UNIX-PTY
+                                BIN _ 'UNIX-STREAM-IN
+                                BOUT _ 'UNIX-STREAM-OUT
+                                PEEKBIN _ 'UNIX-STREAM-PEEK
+                                CLOSEFILE _ 'UNIX-STREAM-CLOSE
+                                GETFILEINFO _ 'NILL
+                                SETFILEINFO _ 'NILL
+                                EOFP _ 'UNIX-STREAM-EOFP
+                                BACKFILEPTR _ 'UNIX-BACKFILEPTR
+                                DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
 
 (UNIX-GET-NEXT-BUFFER

   [LAMBDA (STREAM WHATFOR NOERRORFLG)                        (* ; 
@@ -280,11 +257,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS *NEW-SHELL-DEVICE*)
+(GLOBALVARS *SHELL-DEVICE*)
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(INITIALIZE-NEW-SHELL-DEVICE
)
+(INITIALIZE-SHELL-DEVICE
)
 
 
 (ADDTOVAR AROUNDEXITFNS
 UNIXCOMM-AROUNDEXITFN)
@@ -297,25 +274,23 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (CREATE-UNIX-SOCKET-STREAM

-  [LAMBDA (PATHNAME)                                         (* ; "Edited 29-May-90 16:23 by jrb:")

-    (LET [(STR (create
 STREAM
-                      ACCESS _ 'BOTH
-                      DEVICE _ *NEW-SHELL-DEVICE*
-                      EOLCONVENTION _ LF.EOLC))
-          (CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
+  [LAMBDA (PATHNAME)
                                         (* ; "Edited 11-Oct-2022 10:11 by lmm")


+                                                             (* ; "Edited 29-May-90 16:23 by jrb:")

+    (LET [(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
          (if
 CHAN
-             then
 (CL:SETF (UNIX-CHANNEL STR)
-                             CHAN) 
-
-                   (* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether.  Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")

-
-                   (push
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
-                          STR)
-                   STR
-           else
 NIL])
+             then
 (LET ((STR (create
 STREAM
+                                    ACCESS _ 'BOTH
+                                    DEVICE _ *SHELL-DEVICE*
+                                    EOLCONVENTION _ LF.EOLC)))
+                       (CL:SETF (UNIX-CHANNEL STR)
+                              CHAN)
+                       (push
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
+                             STR)
+                       STR])
 
 (ACCEPT-UNIX-SOCKET-STREAM

-  [LAMBDA (SOCKSTREAM)                                       (* ; "Edited 29-May-90 16:31 by jrb:")

+  [LAMBDA (SOCKSTREAM)
                                       (* ; "Edited 11-Oct-2022 10:12 by lmm")


+                                                             (* ; "Edited 29-May-90 16:31 by jrb:")

     (LET ((CHAN (UNIX-CHANNEL SOCKSTREAM))
           NEWCHAN)
          (SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN))
@@ -323,15 +298,12 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
                   NEWCHAN)
              (LET ((NEWSTREAM (create
 STREAM
                                      ACCESS _ 'BOTH
-                                     DEVICE _ *NEW-SHELL-DEVICE*
+                                     DEVICE _ *SHELL-DEVICE*
                                      EOLCONVENTION _ LF.EOLC)))
                   (CL:SETF (UNIX-CHANNEL NEWSTREAM)
                          NEWCHAN)
-
-                  (* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether.  Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")

-
                   (push
 (fetch
 (FDEV OPENFILELST) of
 *SHELL-DEVICE*)
-                         NEWSTREAM)
+                        NEWSTREAM)
                   NEWSTREAM])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
@@ -346,122 +318,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
        T)
 )
 
-
-
-(* ;; 
-"Obsolete stuff.  This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device"
-)

-
-(DEFINEQ
-
-(UNIX-BACKFILEPTR

-  [LAMBDA (STREAM)
                                       (* ; "Edited 14-Dec-88 09:52 by bane")

-
-    (* ;; "The trick here is to use the existing mechanisms for UNIX-PEEKCHAR")

-
-    (COND
-       ((UNIX-PEEKEDCHAR STREAM)
-        (ERROR "Can only back up one character" STREAM))
-       ((NOT (UNIX-LASTCHAR STREAM))
-        (ERROR "Can't back up past beginning of stream" STREAM))
-       (T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
-                 (UNIX-LASTCHAR STREAM])
-
-(UNIX-READ

-  [LAMBDA (STREAM NO-ERROR)
                              (* ; "Edited 14-Dec-88 09:18 by bane")

-    (LET* [(CONN (UNIX-CHANNEL STREAM))
-           (CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
-                                0]
-          (COND
-             ((EQ CH T)
-              NIL)
-             [(EQ CH NIL)
-              (COND
-                 (NO-ERROR NIL)
-                 (T (\EOF.ACTION STREAM]
-             (T (CL:SETF (UNIX-LASTCHAR STREAM)
-                       CH])
-
-(INITIALIZE-SHELL-DEVICE

-  [LAMBDA NIL
                                                (* ; "Edited  3-Jul-2022 16:15 by rmk")


-                                                             (* ; "Edited 14-Dec-88 10:45 by bane")

-    (SETQ *SHELL-DEVICE* (create
 FDEV
-                                NODIRECTORIES _ T
-                                DEVICENAME _ 'UNIX-PTY
-                                BIN _ 'UNIX-STREAM-IN
-                                BOUT _ 'UNIX-STREAM-OUT
-                                PEEKBIN _ 'UNIX-STREAM-PEEK
-                                CLOSEFILE _ 'UNIX-STREAM-CLOSE
-                                GETFILEINFO _ 'NILL
-                                SETFILEINFO _ 'NILL
-                                EOFP _ 'UNIX-STREAM-EOFP
-                                BACKFILEPTR _ 'UNIX-BACKFILEPTR
-                                DEFAULTEXTERNALFORMAT _ (AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
-                                                             :UTF-8])
-
-(UNIX-STREAM-IN

-  [LAMBDA (STREAM)
                                       (* ; "Edited  9-May-88 15:05 by ")

-    (LET (CH)
-         (if
 (SETQ CH (UNIX-PEEKEDCHAR STREAM))
-             then
 (CL:SETF (UNIX-PEEKEDCHAR STREAM)
-                             NIL)
-           else
 (while
 (NOT (SETQ CH (UNIX-READ
 STREAM))) do
 (BLOCK)))
-         CH])
-
-(UNIX-STREAM-EOFP

-  [LAMBDA (STREAM)
                                       (* ; "Edited  2-Apr-90 11:51 by jds")

-
-    (* ;; "EOFP method for unix-shell streams.  Notices when there are chars yet to read and doesn't set EOFP.")

-
-    (AND (NOT (UNIX-PEEKEDCHAR STREAM))
-         (LET* [(CONN (UNIX-CHANNEL STREAM))
-                (CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
-                                     0]
-               (COND
-                  ((EQ CH T)
-                   NIL)
-                  ((EQ CH NIL)
-                   T)
-                  (T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
-                            CH)
-                     (CL:SETF (UNIX-LASTCHAR STREAM)
-                            CH)
-                     NIL])
-
-(UNIX-STREAM-PEEK

-  [LAMBDA (STREAM NO-ERROR)
                              (* ; "Edited 24-Jun-88 15:07 by drc:")

-    (OR (UNIX-PEEKEDCHAR STREAM)
-        (CL:SETF (UNIX-PEEKEDCHAR STREAM)
-               (UNIX-READ
 STREAM NO-ERROR])
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS *SHELL-DEVICE*)
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS UNIX-PEEKEDCHAR
 MACRO
 ((STR)
-                                 (FETCH
 (STREAM F2) OF
 STR)))
-
-(PUTPROPS UNIX-LASTCHAR
 MACRO
 ((STR)
-                               (FETCH
 (STREAM F3) OF
 STR)))
-)
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(INITIALIZE-SHELL-DEVICE
)
-)
-
-(PUTPROPS UNIXCOMM
 FILETYPE
 FAKE-COMPILE-FILE)
+(PUTPROPS UNIXCOMM
 FILETYPE
 COMPILE-FILE)
 (PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2467 8489 (FORK-SHELL 2477 . 3674) (FORK-UNIX 3676 . 3852) (UNIX-KILL 3854 . 4043) (
-UNIX-WRITE 4045 . 4756) (CREATE-SHELL-STREAM 4758 . 6074) (CREATE-PROCESS-STREAM 6076 . 7586) (
-UNIXCOMM-AROUNDEXITFN 7588 . 8487)) (8537 13831 (INITIALIZE-NEW-SHELL-DEVICE 8547 . 9946) (
-UNIX-GET-NEXT-BUFFER 9948 . 12148) (UNIX-BACKFILEPTR-NEW 12150 . 12629) (UNIX-STREAM-EOFP-NEW 12631 . 
-13177) (UNIX-STREAM-OUT 13179 . 13435) (UNIX-STREAM-CLOSE 13437 . 13829)) (14087 15952 (
-CREATE-UNIX-SOCKET-STREAM 14097 . 14958) (ACCEPT-UNIX-SOCKET-STREAM 14960 . 15950)) (16301 19761 (
-UNIX-BACKFILEPTR 16311 . 16809) (UNIX-READ 16811 . 17333) (INITIALIZE-SHELL-DEVICE 17335 . 18355) (
-UNIX-STREAM-IN 18357 . 18733) (UNIX-STREAM-EOFP 18735 . 19509) (UNIX-STREAM-PEEK 19511 . 19759)))))
+  (FILEMAP (NIL (2139 7214 (FORK-SHELL 2149 . 3346) (FORK-UNIX 3348 . 3524) (UNIX-KILL 3526 . 3715) (
+UNIX-WRITE 3717 . 4428) (CREATE-SHELL-STREAM 4430 . 5314) (CREATE-PROCESS-STREAM 5316 . 6155) (
+UNIXCOMM-AROUNDEXITFN 6157 . 7212)) (7262 12248 (INITIALIZE-SHELL-DEVICE 7272 . 8363) (
+UNIX-GET-NEXT-BUFFER 8365 . 10565) (UNIX-BACKFILEPTR-NEW 10567 . 11046) (UNIX-STREAM-EOFP-NEW 11048 . 
+11594) (UNIX-STREAM-OUT 11596 . 11852) (UNIX-STREAM-CLOSE 11854 . 12246)) (12496 14202 (
+CREATE-UNIX-SOCKET-STREAM 12506 . 13312) (ACCEPT-UNIX-SOCKET-STREAM 13314 . 14200)))))
 STOP

release_trigger

@@ -0,0 +1 @@
+release trigger

run-medley

@@ -41,6 +41,7 @@ pass=""
 mem="-m 256"
 scroll=22
 noscroll=""
+title="Medley Interlisp"
 
 if [ -z "$LDEDESTSYSOUT" ] ; then
     if [ -z "$LOGINDIR" ] ; then
@@ -112,6 +113,10 @@ while [ "$#" -ne 0 ]; do
 	    mem="-m $2 "
 	    shift
 	    ;;
+	-title)
+	    title="$2"
+	    shift
+	    ;;
         -vmem | --vmem | -vmfile)
             export LDEDESTSYSOUT="$2"
             shift
@@ -192,10 +197,10 @@ if ! command -v "$prog" > /dev/null 2>&1; then
     fi
 fi
 
-echo "running: $prog $noscroll $geometry $screensize $mem $pass $LDESRCESYSOUT"
+echo "running: $prog $noscroll $geometry $screensize -title \"$title\" $mem $pass $LDESRCESYSOUT"
 echo "greet: $LDEINIT"
 
 export INMEDLEY=1
 
-"$prog" $noscroll $geometry $screensize $mem -title "Medley Interlisp" $pass "$LDESRCESYSOUT"
+"$prog" $noscroll $geometry $screensize $mem -title "$title" $pass "$LDESRCESYSOUT"
 

sources/MEDLEYDIR

@@ -1,10 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Oct-2022 12:19:14" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;11
 9572   
+
(FILECREATED "22-Nov-2022 20:50:20" {DSK}<home>frank>il>medley>wmedley>sources>MEDLEYDIR.;10
 10271  
 
       :CHANGES-TO (FNS MEDLEY-INIT-VARS)
 
-      :PREVIOUS-DATE "24-Oct-2022 22:35:01" {DSK}<home>larry>ilisp>medley>sources>MEDLEYDIR.;10)
+      :PREVIOUS-DATE "21-Nov-2022 17:31:30" {DSK}<home>frank>il>medley>wmedley>sources>MEDLEYDIR.;9
+)
 
 
 (PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -33,7 +34,11 @@
 (DEFINEQ
 
 (MEDLEY-INIT-VARS

-  [LAMBDA (EVENT)
                                            (* ; "Edited 25-Oct-2022 12:18 by lmm")


+  [LAMBDA (EVENT)
                                            (* ; "Edited 22-Nov-2022 20:38 by FGH")


+                                                             (* ; "Edited 21-Nov-2022 17:31 by FGH")


+                                                           (* ; "Edited 21-Nov-2022 15:39 by frank")


+                                                             (* ; "Edited 21-Nov-2022 14:33 by FGH")


+                                                             (* ; "Edited 25-Oct-2022 12:18 by lmm")


                                                              (* ; "Edited 18-Oct-2022 18:08 by lmm")

 
     (* ;; "Called on events including before & after loadup")

@@ -52,9 +57,8 @@
              [SETQ \SAVE.MEDLEYDIR (CONS MEDLEYDIR (FOR
 X IN
 MEDLEY-INIT-VARS
                                                       COLLECT
 (CONS (CAR X)
                                                                     (GETTOPVAL (CAR X])
-        ((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM RESTART INIT NIL) 
-
-                                                                      (* ;; 
+        ((AFTERSYSOUT AFTERLOGOUT AFTERSAVEVM RESTART INIT NIL) 
+                                                                (* ;; 
 
                                       "Any old values, restore them, substituting the new MEDLEYDIR")

 
              (PROG (OLDMD NEWMD SAME TMP)
@@ -81,6 +85,12 @@
                                   ELSE
 (MEDLEYSUBSTDIR
 OLDMD NEWMD (CDR TMP]
                    (SETQ \SAVE.MEDLEYDIR T)                  (* ; "only use once")

                ))
+        ((GREET) 
+             (SETQ MEDLEYDIR)
+             (SETQ MEDLEYDIR (MEDLEYDIR
))
+             [for
 X in
 MEDLEY-INIT-VARS do
 (/SETTOPVAL (CAR X)
+                                                  (EVAL (CADR X]
+             (SETQ \SAVE.MEDLEYDIR T))
         (PROGN                                               (* ; "no changes")

                NIL])
 
@@ -191,6 +201,6 @@
 (ADDTOVAR GLOBALVARS
 MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1459 7197 (MEDLEY-INIT-VARS 1469 . 4258) (MEDLEYDIR 4260 . 6215) (MEDLEYSUBSTDIR 6217
- . 7195)))))
+  (FILEMAP (NIL (1469 7896 (MEDLEY-INIT-VARS 1479 . 4957) (MEDLEYDIR 4959 . 6914) (MEDLEYSUBSTDIR 6916
+ . 7894)))))
 STOP