Installers for Linux: workflow changes and more to support standard Linux installations (#1058)

* Adding LANG environment variable to docker image; adding MAIKO_ and MEDLEY_INSTALLDIR environment variables; Changing /usr/local/bin/run-medley to a symbolic link instead of a shell script

* Added draft input to all workflows, so that can create draft releases as well as regular releases

* Update buildDocker.yml to handle deprecation of set-output and to update versions of actions to handle node 12 to node 16 transition.

* Added scripts and updated github workflows to support creation of deb installers for Linux and WSL

* Fix minor bug in buildLoadup.yml

* First pass implementation of deb installer

* Fixing wget of vncviewer in build_deb.sh

* Fix typo in buildLoadup.yml in call to build_deb.sh

* Multiple small fixes to medley.sh from debugging.  Change postinst script and how its created in build_deb.  Add postrm script in build_deb.

* Reworking vnc portion of Medley.sh - including removing dependency on startx and xinit

* Misc fixes to medley_vnc.sh script; fix creation of postinst and postrm in build_deb.sh

* Cleaning up window geometry amd screen size in medley.sh

* Created apps.sysout loadup with rooms, notecards, clos on top of full.sysout; added plumbing for -apps flag to run-medley to run this syout; created a new init file for this sysout that calls MEDLEYDIR-INIT;  all of this is based on online.sysout

* Create UNIXUTILS file in library with ShellWhich function - linux which command equivalent.  Also move ShellCommand from UNIXPRINT to UNIXUTILS.

* Adding UNIXUTILS to LOADUP-FULL so it gets included in full.sysout

* Change of names from open(er) to browse(r). Refine the browse(r) functions a bit

* Minor bug fixes

* Update Apps.ShowDoc to new ShellBrowsefunction

* Adding apps support into the .github builds;  adding xdg-utils as dependecy in debs

* fixing bug as to where notecards is checked out in BuildLoadup.  Needs to be before loadups so app.sysout can be built

* Added defaulting to Interlisp exec tomedley.sh and APPS-INIT.  Works only in apps.sysout.  Added wlsu package to wsl debs since wlsview is not always installed by defailt.  Fixed Notefiles directories issues in Apps.Init.   Made medley.sh compute medleydir based on where the script is located. Can now work for /usr/lcal/interlisp as well as local directories.

* Added -id - feature to medley.sh so id can be directory mae.  Removed extraneous set -x commands in medley.sh from debugging.  In build_deb.sh changed compression to xz for deb files since debian does not support the zstd compression that ubuntu uses.

* For wsl deb files, make sure wslu package is not 4.0 - which is bad.  Change how we choose an open port and open display in medley_vnc.sh.  Add notecards download to build_deb.sh.  Fix type in medley.sh

* Add (FILES UNIXUTILS) to UNIXPRINTCOMS so that ShellCommand is loaded in case only UNIXPRINT is loaded.  For backward compatibility.

* Moved medley.sh and associates to script/medley dir; fixed up args to medley.sh;  added usage and --help to medley.sh

* Add comprehensive tar files to releases to match deb files for local installs; add --id -- arg to medley.sh

* Remove remaining reference to usr/local/interlisp to ensure local install works

* Fix bug in buildLoadup - couldn't file install tars

* Add medley symbolic linkto loadups, so it comes thru to local install tars

* Fix up error messaging in medley.sh scripts

* Created man page for medley and added it throughout build up, installers, etc.

* Add support for a downloads page on OIO, including creating said page while building a release

* Fix full_release_tag in downloads section of buildLoadup.yml

* Misc fixups on downloads page

* Adding online man page stored on oio static server.

* Fix minor bug in man installation in deb file

.github/workflows/buildDocker.yml

@@ -21,6 +21,12 @@ name: 'Build/Push Docker Image'
 on:
   workflow_dispatch:
     inputs: 
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
       force:
         description: "Force build even if build already successfully completed for this commit"
         type: choice
@@ -34,6 +40,11 @@ on:
         description: "'True' if medley docker build completed successully"
         value: ${{ jobs.complete.outputs.build_successful }}
     inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
       force:
         description: "Force build even if build already successfully completed for this commit"
         required: false
@@ -60,13 +71,20 @@ jobs:
   inputs:
     runs-on: ubuntu-latest
     outputs:
-      force: ${{ steps.force.outputs.force }}
+      draft: ${{ steps.one.outputs.draft }}
+      force: ${{ steps.one.outputs.force }}
     steps:
-      - id: force
+      - id: one
         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 "workflow_dispatch";
+              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
+          else
+              echo "workflow_call";
+              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
           fi
         
 
@@ -85,7 +103,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 }}
@@ -117,7 +135,7 @@ jobs:
     steps:
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
 
       # Set repo env variables
       - name: Set repo/docker env variables
@@ -125,22 +143,22 @@ jobs:
         run: |
           REPO_NAME=${GITHUB_REPOSITORY#*/}
           echo "REPO_NAME=${REPO_NAME}" >> ${GITHUB_ENV}
-          echo ::set-output name=repo_name::${REPO_NAME}
+          echo "repo_name=${REPO_NAME}" >> ${GITHUB_OUTPUT}
           DOCKER_NAMESPACE=$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')
           echo "DOCKER_NAMESPACE=${DOCKER_NAMESPACE}" >> ${GITHUB_ENV}
-          echo ::set-output name=docker_namespace::${DOCKER_NAMESPACE}
+          echo "docker_namespace=${DOCKER_NAMESPACE}" >> ${GITHUB_OUTPUT}
 
       # Get tag of latest Medley release.
       - name: Get Medley Release Information
         id: release_info
-        uses: abatilo/release-info-action@v1.3.0
+        uses: abatilo/release-info-action@v1.3.2
         with:
           owner: ${{ github.repository_owner }}
           repo: medley
           
       # Get asset tars from latest Medley release
       - name: Download Release Assets
-        uses: robinraju/release-downloader@v1.2
+        uses: robinraju/release-downloader@v1.7
         with:
           repository: ${{ github.repository_owner }}/medley
           token: ${{ secrets.GITHUB_TOKEN }}
@@ -155,7 +173,7 @@ jobs:
           docker pull ${DOCKER_NAMESPACE}/maiko:latest
           MAIKO_RELEASE=$(docker run --entrypoint /bin/bash ${DOCKER_NAMESPACE}/maiko:latest -c "echo \${MAIKO_RELEASE}")
           echo "MAIKO_RELEASE=${MAIKO_RELEASE}" >> ${GITHUB_ENV}
-          echo ::set-output name=maiko_release::${MAIKO_RELEASE}
+          echo "maiko_release=${MAIKO_RELEASE}" >> ${GITHUB_OUTPUT}
 
       # Setup environment variables
       - name: Setup Environment Variables
@@ -163,11 +181,14 @@ jobs:
         run: |
           RELEASE_TAG=${{ steps.release_info.outputs.latest_tag }}
           DOCKER_IMAGE=${DOCKER_NAMESPACE}/${REPO_NAME}
-          DOCKER_TAGS="${DOCKER_IMAGE}:latest,${DOCKER_IMAGE}:${RELEASE_TAG#*-}_${MAIKO_RELEASE#*-}"
-          echo ::set-output name=docker_tags::${DOCKER_TAGS}
-          echo ::set-output name=docker_image::${DOCKER_IMAGE}
-          echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
-          echo ::set-output name=release_tag::${RELEASE_TAG}
+          if [ "${{ needs.inputs.outputs.draft }}" = "false" ];
+              then DOCKER_TAGS="${DOCKER_IMAGE}:latest,${DOCKER_IMAGE}:${RELEASE_TAG#*-}_${MAIKO_RELEASE#*-}"
+              else DOCKER_TAGS="${DOCKER_IMAGE}:draft"
+          fi
+          echo "docker_tags=${DOCKER_TAGS}" >> ${GITHUB_OUTPUT}
+          echo "docker_image=${DOCKER_IMAGE}" >> ${GITHUB_OUTPUT}
+          echo "build_time=$(date -u +'%Y-%m-%dT%H:%M:%SZ')" >> ${GITHUB_OUTPUT}
+          echo "release_tag=${RELEASE_TAG}" >> ${GITHUB_OUTPUT}
           echo "release_tag=${RELEASE_TAG}" >> ${GITHUB_ENV}
 
       # Setup the Docker Machine Emulation environment.  
@@ -183,7 +204,7 @@ jobs:
 
       # Login into DockerHub - required to store the created image
       - name: Login to DockerHub
-        uses: docker/login-action@v1
+        uses: docker/login-action@v2
         with:
           username: ${{ secrets.DOCKER_USERNAME }}
           password: ${{ secrets.DOCKER_PASSWORD }}
@@ -192,7 +213,7 @@ jobs:
       # checked out and the release tars just downloaded.
       # Push the result to Docker Hub
       - name: Build Docker Image for Push to Docker Hub
-        uses: docker/build-push-action@v2
+        uses: docker/build-push-action@v3
         with:
           builder: ${{ steps.buildx.outputs.name }}
           build-args: |
@@ -225,7 +246,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 }}
@@ -241,6 +262,6 @@ jobs:
       - name: Output
         id: output
         run: |
-          echo ::set-output name=build_successful::'true'
+          echo "build_successful='true'" >> ${GITHUB_OUTPUT}
           
 ######################################################################################

.github/workflows/buildLoadup.yml

@@ -1,4 +1,4 @@
-#re*******************************************************************************
+#*******************************************************************************
 # buidLoadup.yml
 #
 # Interlisp workflow to build Medley release and push it to github. This workflow
@@ -10,7 +10,7 @@
 #
 # 2022-01-17 Frank Halasz based on an earlier version of buildLoadup for Medley.
 #
-# Copyright 2022 by Interlisp.org
+# Copyright 2022-2023 by Interlisp.org
 #
 # ******************************************************************************
 
@@ -20,6 +20,12 @@ name: Build/Push Medley Release
 on:
   workflow_dispatch:
     inputs:
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
       force:
         description: "Force build even if build already successfully completed for this commit"
         type: choice
@@ -33,6 +39,11 @@ on:
         description: "'True' if medley build completed successully"
         value: ${{ jobs.complete.outputs.build_successful }}
     inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
       force:
         description: "Force build even if build already successfully completed for this commit"
         required: false
@@ -54,13 +65,20 @@ jobs:
   inputs:
     runs-on: ubuntu-latest
     outputs:
-      force: ${{ steps.force.outputs.force }}
+      draft: ${{ steps.one.outputs.draft }}
+      force: ${{ steps.one.outputs.force }}
     steps:
-      - id: force
+      - id: one
         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 "workflow_dispatch";
+              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
+          else
+              echo "workflow_call";
+              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
           fi
         
 
@@ -79,7 +97,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 +128,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 +136,7 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
 
       # Setup release tag
       - name: Setup Release Tag
@@ -129,64 +147,85 @@ 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}
+          echo "TARBALL_DIR=installers/deb/tmp/tarballs" >>${GITHUB_ENV}
+          echo "DEBS_DIR=installers/deb/debs" >>${GITHUB_ENV}
+          echo "TARS_DIR=installers/deb/tars" >>${GITHUB_ENV}
+          echo "MEDLEY_RELEASE_TAG=${RELEASE_TAG}" >>${GITHUB_ENV}
+
+      # Setup some needed dirs in workspace
+      - name: Create work dirs
+        run: mkdir -p ${TARBALL_DIR}
 
       # 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
+        id: maiko
+        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 }}
           latest: true
-          fileName: "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz" 
+          out-file-path: ${{ env.TARBALL_DIR }}
+          fileName: "${{ steps.maiko.outputs.latest_tag }}-linux.*.tgz" 
 
-      - name: Untar Maiko Release
+      - name: Untar Maiko Release for use in loadup
         run: |
-          tar -xvzf "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
+          tar -xzf "${TARBALL_DIR}/${{ steps.maiko.outputs.latest_tag }}-linux.x86_64.tgz"
 
+      # Checkout Notecards and tar it in the tarballsdir
+      - name: Checkout Notecards
+        uses: actions/checkout@v3
+        with:
+          repository: ${{ github.repository_owner }}/notecards
+          path: ./notecards
+      - run: mv ./notecards ../notecards
+      - name: Tar notecards into tarball dir
+        run: |
+          cd ..
+          tar cfz medley/${TARBALL_DIR}/notecards.tgz notecards
+
+      #
       - name: Install vnc
         run: sudo apt-get update && sudo apt-get install -y tightvncserver
 
-      - name: Build Loadout
+      - name: Build Loadup sysouts and databases
         run: |
           Xvnc -geometry 1280x720 :0 &
           export DISPLAY=":0"
           PATH="$PWD/maiko:$PATH" 
-          scripts/loadup-all.sh
+          scripts/loadup-all.sh -apps
 
       - 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/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-loadups.tgz        \
             medley/loadups/lisp.sysout               \
             medley/loadups/full.sysout               \
+            medley/loadups/apps.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/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-runtime.tgz          \
                      --exclude "*~" --exclude "*#*"              \
                      --exclude exports.all                       \
+                     medley/clos                                 \
                      medley/docs/dinfo                           \
+                     medley/docs/man-page/medley.1.gz            \
                      medley/doctools                             \
                      medley/greetfiles                           \
                      medley/rooms                                \
+                     medley/medley                               \
                      medley/run-medley                           \
                      medley/scripts                              \
                      medley/fonts/displayfonts                   \
@@ -197,39 +236,70 @@ jobs:
                      medley/lispusers                            \
                      medley/sources                              \
                      medley/internal
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
 
 
-      - name: "Create release"
-        uses: "actions/github-script@v5"
+      - name: Build .deb files for 3 architectures
+        run: |
+          cd installers/deb
+          ./build_deb.sh
+
+      - 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 }}
+            tag: ${{ env.MEDLEY_RELEASE_TAG }} 
+        continue-on-error: true
 
-      - 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 }}
+      - name: Push the release
+        id: push_release
+        uses: ncipollo/release-action@v1
+        with: 
+          allowUpdates: true
+          artifacts:
+            ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-loadups.tgz,
+            ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-runtime.tgz,
+            ${{ env.DEBS_DIR }}/*.deb,
+            ${{ env.TARS_DIR }}/*.tgz
+          tag: ${{ env.MEDLEY_RELEASE_TAG }}
+          draft: ${{ needs.inputs.outputs.draft }}
+          prerelease: false
+          generateReleaseNotes: true
+          token: ${{ secrets.GITHUB_TOKEN }}
+
+      - name: Update the downloads page and the man page to the OIO satic page host
+        run: |
+            maiko_release_tag="${{ steps.maiko.outputs.latest_tag }}"
+            medley_short_release_tag="${MEDLEY_RELEASE_TAG#medley-}"
+            full_release_filename="${MEDLEY_RELEASE_TAG/medley/medley-full}_${maiko_release_tag#maiko-}"
+            # Need info about where github stores assets because draft releases are not tagged
+            release_url="${{ steps.push_release.outputs.html_url }}"
+            github_subdir="$( echo "${release_url}" | sed -e "s#^.*/\([^/]\+\)\$#\1#g" )"
+            #
+            local_template="installers/downloads_page/medley_downloads.html"
+            local_filename="medley_downloads.html"
+            if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
+            then
+                remote_filename="draft_downloads"
+            else
+                remote_filename="${local_filename%.html}"
+            fi            
+            remote_filepath="/srv/oio/static/${remote_filename}"
+            sed \
+               -e "s/@@@FULL.RELEASE.FILENAME@@@/${full_release_filename}/g" \
+               -e "s/@@@GITHUB.SUBDIR@@@/${github_subdir}/g" \
+               -e "s/@@@MEDLEY.SHORT.RELEASE.TAG@@@/${medley_short_release_tag}/g" \
+               < "${local_template}" > "${local_filename}"
+            local_manpath="docs/man-page/man_medley.html"
+            remote_manpath="/srv/oio/static/man_medley.html"
+            echo "-rm ${remote_filepath}.oldold" > batch
+            echo "-rename ${remote_filepath}.old ${remote_filepath}.oldold" >> batch
+            echo "-rename ${remote_filepath}.html ${remote_filepath}.old" >> batch
+            echo "-put ${local_filename} ${remote_filepath}.html" >> batch
+            echo "-put ${local_manpath} ${remote_manpath}" >> batch
+            eval $(ssh-agent)
+            ssh-add - <<< "${SSH_KEY}"
+            sftp -o StrictHostKeyChecking=no -b batch ubuntu@online.interlisp.org
         env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
+            SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
 
 
 ######################################################################################
@@ -249,7 +319,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 +335,6 @@ jobs:
       - name: Output
         id: output
         run: |
-          echo ::set-output name=build_successful::'true'
+          echo "build_successful='true'" >> $GITHUB_OUTPUT
           
 ######################################################################################

.github/workflows/buildReleaseInclDocker.yml

@@ -19,18 +19,96 @@ name: "Build/Push Release & Docker"
 # Run this workflow on ...
 on:
   workflow_dispatch:
-  
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
+      force:
+        description: "Force build even if build already successfully completed for this commit"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
+
+  workflow_call:
+    outputs:
+      successful:
+        description: "'True' if medley build completed successully"
+        value: ${{ jobs.complete.outputs.build_successful }}
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
+      force:
+        description: "Force build even if build already successfully completed for this commit"
+        required: false
+        type: string
+        default: 'false'
+
+defaults:
+  run:
+    shell: bash
+    
 
 # Jobs that compose this workflow
 jobs:
+
+
+######################################################################################
+
+  # Regularize the inputs so they can be referenced the same way whether they are
+  # the result of a workflow_dispatch or a workflow_call
+
+  inputs:
+    runs-on: ubuntu-latest
+    outputs:
+      draft: ${{ steps.one.outputs.draft }}
+      force: ${{ steps.one.outputs.force }}
+    steps:
+      - id: one
+        run: >
+          if [ '${{ toJSON(inputs) }}' = 'null'  ];
+          then
+              echo "workflow_dispatch";
+              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
+          else
+              echo "workflow_call";
+              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
+          fi
+        
+
+######################################################################################
+
+
   # Build Loadup
   do_release:
+    needs: inputs
     uses: ./.github/workflows/buildLoadup.yml
+    with:
+        draft: ${{ needs.inputs.outputs.draft }}
+        force: ${{ needs.inputs.outputs.force }}
     
+
+######################################################################################
+
   # Build Docker Image
   do_docker:
-    needs: do_release
+    needs: [inputs, do_release]
     uses: ./.github/workflows/buildDocker.yml
+    with:
+        draft: ${{ needs.inputs.outputs.draft }}
+        force: ${{ needs.inputs.outputs.force }}
     secrets:
-      DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
-      DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
+        DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
+        DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
+
+
+######################################################################################
+

.gitignore

@@ -10,6 +10,7 @@ loadups/lisp.sysout
 loadups/full.sysout
 loadups/*.dribble
 loadups/whereis.hash
+loadups/apps.sysout
 
 # manual cross-reference files
 
@@ -37,3 +38,8 @@ core
 # Mac OS detritus
 .DS_Store
 *.PS
+
+# nano detritus
+*.swp
+*.save
+

Dockerfile

@@ -3,7 +3,7 @@
 # Dockerfile to build Medley image from latest Maiko image 
 # plus latest release tars from github
 #
-# Copyright 2022 by Interlisp.org
+# Copyright 2022-2023 by Interlisp.org
 #
 # ******************************************************************************
 
@@ -29,26 +29,27 @@ LABEL maiko_release=$MAIKO_RELEASE
 ENV MEDLEY_BUILD_DATE=$BUILD_DATE
 ENV MEDLEY_RELEASE=$RELEASE_TAG
 
-ARG INSTALL_LOCATION=/usr/local/interlisp
-ENV INSTALL_LOCATION=${INSTALL_LOCATION}
+ARG IL_INSTALLDIR=/usr/local/interlisp
+ENV IL_INSTALLDIR=${IL_INSTALLDIR}
+ENV MAIKO_INSTALLDIR=${IL_INSTALLDIR}/maiko
+ENV MEDLEY_INSTALLDIR=${IL_INSTALLDIR}/medley
 
 ARG DOCKER_NAMESPACE=interlisp
 ENV DOCKER_NAMESPACE=${DOCKER_NAMESPACE}
 
-# Copy over the release tars
-RUN mkdir -p ${INSTALL_LOCATION}
-ADD ./*.tgz ${INSTALL_LOCATION}
+ENV LANG=C.UTF-8
 
-# Create a run_medley script in /usr/local/bin
-RUN mkdir -p /usr/local/bin                                     && \
-    echo "#!/bin/bash"                    > /usr/local/bin/run-medley && \
-    echo "cd ${INSTALL_LOCATION}/medley"  >> /usr/local/bin/run-medley && \
-    echo './run-medley "$@"'              >> /usr/local/bin/run-medley && \
-    chmod ugo+x /usr/local/bin/run-medley
+# Copy over the release tars
+RUN mkdir -p ${IL_INSTALLDIR}
+ADD ./*.tgz ${IL_INSTALLDIR}
+
+# Link run_medley script into /usr/local/bin
+RUN mkdir -p /usr/local/bin && \
+    ln -s ${MEDLEY_INSTALLDIR}/run-medley /usr/local/bin/run-medley
     
 # "Finalize" image
 EXPOSE 5900
 RUN adduser --disabled-password --gecos "" medley
 USER medley
 WORKDIR /home/medley
-ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 ${INSTALL_LOCATION}/medley/run-medley -full -g 1280x720 -sc 1280x720
+ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 ${MEDELY_INSTALLDIR}/run-medley -full -g 1280x720 -sc 1280x720

docs/man-page/man2html.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+pandoc --from man --to html < medley.1 > man_medley.html

docs/man-page/man_medley.html

@@ -0,0 +1,92 @@
+<h1>NAME</h1>
+<p><strong>medley</strong> — starts up Medley Interlisp</p>
+<h1>SYNOPSIS</h1>
+<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ -- <em>PASS_ON_ARGS</em> ]</p>
+<h1>DESCRIPTION</h1>
+<p>Starts Medley Interlisp in a window.</p>
+<h1>OPTIONS</h1>
+<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley and used by many of the options described below. MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of medley.</p>
+<h2>Flags</h2>
+
+<dl>
+<dt><strong>-h, --help</strong></dt>
+<dd><p>Prints out a brief summary of the flags and arguments to medley.</p>
+</dd>
+<dt><strong>-z, --man</strong></dt>
+<dd><p>Show the man page for medley</p>
+</dd>
+<dt><strong>-f, --full</strong></dt>
+<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+</dd>
+<dt><strong>-l, --lisp</strong></dt>
+<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+</dd>
+<dt><strong>-a, --apps</strong></dt>
+<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+</dd>
+<dt><strong>-e, --interlisp (relevent only when --apps is specified)</strong></dt>
+<dd><p>Make the initial Exec window within Medley be an Interlisp Exec. Default is to start in an XCL Exec.</p>
+</dd>
+<dt><strong>-n, --noscroll</strong></dt>
+<dd><p>Ordinarily Medley displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window. Specifying --noscroll turns off the scroll bars. Note: If --noscroll is specified and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
+</dd>
+<dt><strong>-g <em>WxH</em>, --geometry <em>WxH</em></strong></dt>
+<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported). If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set.</p>
+</dd>
+<dt><strong>-s <em>WxH</em>, --screensize <em>WxH</em></strong></dt>
+<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. The Medley window is an unscaled viewport onto this virtual display. If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900.</p>
+</dd>
+<dt><strong>-t <em>STRING</em>, --title <em>STRING</em></strong></dt>
+<dd><p>Use STRING as title of Medley window. Not relevent when the --vnc flag is set.</p>
+</dd>
+<dt><strong>-d <em>:N</em>, --display <em>:N</em></strong></dt>
+<dd><p>Use X display :N. Defaults to the value of $DISPLAY. Not relevant when the --vnc flag is set.</p>
+</dd>
+<dt><strong>-v, --vnc (Applicable only to Windows System for Linux installations)</strong></dt>
+<dd><p>Use a VNC window running on the Windows side instead of an X window. The VNC window will folllow the Windows desktop scaling setting allowing for much more usable Medley on high resolution displays. On WSL, X windows do not scale well.</p>
+</dd>
+<dt><strong>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - | --]</strong></dt>
+<dd><p>Use ID_STRING as the id for this run of Medley, iunless ID_STRING is “-” or “--”. If ID_STRING is “-”, then use the basename of $MEDLEYDIR as the id. If ID_STRING is “--”, then use the basename of the parent directory of $MEDLEYDIR as the id. Only one instance of Medley with a given id can run at a time. The id is used to distinguish the virtual memory stores so that multiple instances of Medley can run simultaneously. Default id is “default”.</p>
+</dd>
+<dt><strong>-m <em>N</em>, --mem <em>N</em></strong></dt>
+<dd><p>Set Medley to run in N MB of virtual memory. Defaults to 256MB.</p>
+</dd>
+<dt><strong>-p <em>FILE</em>, --vmem <em>FILE</em></strong></dt>
+<dd><p>Use FILE as the Medley virtual memory (vmem) store. FILE must be writeable by the current user. Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously. The --id flag will not protect against vmem collisions when the --vmem flag is used. Default is to store the vmem in LOGINDIR/vmem/lisp_XXX.virtualmem, where XXX is the id of this Medley run (see --id flag above). See --logindir below for setting of LOGINDIR.</p>
+</dd>
+<dt><strong>-r [<em>FILE</em> | -], --greet [<em>FILE</em> | -]</strong></dt>
+<dd><p>Use FILE as the Medley greetfile, unless FILE is “-” in which case Medley will start up without using a greetfile. The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.</p>
+</dd>
+<dt><strong>-x [<em>DIR</em> | -], --logindir [<em>DIR</em> | -]</strong></dt>
+<dd><p>use DIR as LOGINDIR in Medley, unless DIR is “-”, in which case use $MEDLEYDIR/logindir. DIR (or $MEDLEYDIR/logindir) must be writeable by the current user. LOGINDIR defaults to $HOME/il. LOGINDIR is used by Medley as the working directory on start-up and where it loads any “personal” initialization file from.</p>
+</dd>
+</dl>
+<h2>Other Options</h2>
+
+<dl>
+<dt><strong><em>SYSOUT_FILE</em></strong></dt>
+<dd><p>The pathname of the file to use as a sysout for Medley to start from. If SYSOUT_FILE is not provided and none of the flags (--apps, --full, --lisp) is used, then Medley will start from the saved virtual memory file from the previous session with the same ID_STRING as this run. If no such virtual memory file exists, then Medley will start from the standard full.sysout (equivalent to specifying the --full flag).</p>
+</dd>
+<dt><strong><em>PASS_ON_ARGS</em></strong></dt>
+<dd><p>All arguments after the “--” flag, are passed unaltered to lde via run-medley.</p>
+</dd>
+</dl>
+<h1>FILES</h1>
+<dl>
+<dt><strong>$HOME/il</strong></dt>
+<dd><p>Default Medley LOGINDIR</p>
+</dd>
+<dt><strong>$HOME/il/vmem/lisp.virtualmem</strong></dt>
+<dd><p>Default virtual memory file</p>
+</dd>
+<dt><strong>$HOME/il/INIT(.LCOM)</strong></dt>
+<dd><p>Default personal init file</p>
+</dd>
+<dt><strong>$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)</strong></dt>
+<dd><p>Default Medley greetfile</p>
+</dd>
+</dl>
+<h1>BUGS</h1>
+<p>See GitHub Issues: &lt;https://github.com/Interlisp/medley/issues&gt;</p>
+<h1>COPYRIGHT</h1>
+<p>Copyright(c) 2023 by Interlisp.org</p>

docs/man-page/md2man.sh

@@ -0,0 +1,3 @@
+#!/bin/bash
+pandoc medley.1.md -s -t man -o medley.1
+gzip --stdout medley.1 >medley.1.gz

docs/man-page/medley.1

@@ -0,0 +1,186 @@
+.\" Automatically generated by Pandoc 2.5
+.\"
+.ad l
+.TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
+.nh \" Turn off hyphenation by default.
+.SH NAME
+.PP
+\f[B]medley\f[R] \[em] starts up Medley Interlisp
+.SH SYNOPSIS
+.PP
+\f[B]medley\f[R] [ flags \&... ] [ \f[I]SYSOUT_FILE\f[R] ] [ \-\-
+\f[I]PASS_ON_ARGS\f[R] ]
+.SH DESCRIPTION
+.PP
+Starts Medley Interlisp in a window.
+.SH OPTIONS
+.PP
+\f[B]MEDLEYDIR\f[R] is an environment variable set by Medley and used by
+many of the options described below.
+MEDLEYDIR is the top level directory of the Medley installation that
+contains the specific medley script that is invoked after all symbolic
+links are resolved.
+In the standard global installation this will be
+/usr/local/interlisp/medley.
+But Medley can be installed in multiple places on any given machine and
+hence MEDLEYDIR is computed on each invocation of medley.
+.SS Flags
+.PP
+\ 
+.TP
+.B \-h, \-\-help
+Prints out a brief summary of the flags and arguments to medley.
+.TP
+.B \-z, \-\-man
+Show the man page for medley
+.TP
+.B \-f, \-\-full
+Start Medley from the standard \[lq]full\[rq] sysout.
+full.sysout includes a complete Interlisp and CommonLisp environment
+with a standard set of development tools.
+It does not include any of the applications built using Medley.
+(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
+sysouts.)
+.TP
+.B \-l, \-\-lisp
+Start Medley from the standard \[lq]lisp\[rq] sysout.
+lisp.sysout only includes the basic Interlisp and CommonLisp
+environment.
+(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
+sysouts.)
+.TP
+.B \-a, \-\-apps
+Start Medley from the standard \[lq]apps\[rq] sysout.
+apps.sysout includes everything in full.sysout plus Medley applications
+including Notecards, Rooms and CLOS.
+It also includes pre\-installed links to key Medley documentation.
+(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
+sysouts.)
+.TP
+.B \-e, \-\-interlisp (relevent only when \-\-apps is specified)
+Make the initial Exec window within Medley be an Interlisp Exec.
+Default is to start in an XCL Exec.
+.TP
+.B \-n, \-\-noscroll
+Ordinarily Medley displays scroll bars to enable the user to pan the
+Medley virtual display within the Medley window.
+This is true even when the entire virtual display fits within the
+window.
+Specifying \-\-noscroll turns off the scroll bars.
+Note: If \-\-noscroll is specified and the virtual screen is larger than
+the window, there will be no way to pan to the non\-visible parts of the
+virtual display.
+.TP
+.B \-g \f[I]WxH\f[R], \-\-geometry \f[I]WxH\f[R]
+Sets the size of the X Window (or VNC window) that Medley runs in to be
+Width x Height.
+(Full X Windows geomtery specification with +X+Y is not currently
+supported).
+If \-\-geometry is not specified but \-\-screensize is, then the window
+size will be determined based on the \-\-screensize values and the
+\-\-noscroll flag.
+If neither \-\-geometry nor \-\-screensize is provided, then the window
+size is set to 1440x900 if \-\-noscroll is set and 1462x922 if
+\-\-noscroll is not set.
+.TP
+.B \-s \f[I]WxH\f[R], \-\-screensize \f[I]WxH\f[R]
+Sets the size of the virtual display as seen from Medley\[cq]s point of
+view.
+The Medley window is an unscaled viewport onto this virtual display.
+If \-\-screensize is not specified but \-\-geometry is, then the virtual
+display size will be set so that the entire virtual display fits into
+the given window geometry.
+If neither \-\-screensize nor \-\-geometry is provided, then the screen
+size is set to 1440x900.
+.TP
+.B \-t \f[I]STRING\f[R], \-\-title \f[I]STRING\f[R]
+Use STRING as title of Medley window.
+Not relevent when the \-\-vnc flag is set.
+.TP
+.B \-d \f[I]:N\f[R], \-\-display \f[I]:N\f[R]
+Use X display :N.
+Defaults to the value of $DISPLAY.
+Not relevant when the \-\-vnc flag is set.
+.TP
+.B \-v, \-\-vnc (Applicable only to Windows System for Linux installations)
+Use a VNC window running on the Windows side instead of an X window.
+The VNC window will folllow the Windows desktop scaling setting allowing
+for much more usable Medley on high resolution displays.
+On WSL, X windows do not scale well.
+.TP
+.B \-i [\f[I]ID_STRING\f[R] | \- | \-\-], \-\-id [\f[I]ID_STRING\f[R] | \- | \-\-]
+Use ID_STRING as the id for this run of Medley, iunless ID_STRING is
+\[lq]\-\[rq] or \[lq]\-\-\[rq].
+If ID_STRING is \[lq]\-\[rq], then use the basename of $MEDLEYDIR as the
+id.
+If ID_STRING is \[lq]\-\-\[rq], then use the basename of the parent
+directory of $MEDLEYDIR as the id.
+Only one instance of Medley with a given id can run at a time.
+The id is used to distinguish the virtual memory stores so that multiple
+instances of Medley can run simultaneously.
+Default id is \[lq]default\[rq].
+.TP
+.B \-m \f[I]N\f[R], \-\-mem \f[I]N\f[R]
+Set Medley to run in N MB of virtual memory.
+Defaults to 256MB.
+.TP
+.B \-p \f[I]FILE\f[R], \-\-vmem \f[I]FILE\f[R]
+Use FILE as the Medley virtual memory (vmem) store.
+FILE must be writeable by the current user.
+Care must be taken not to use the same vmem FILE for two instances of
+Medley running simultaneously.
+The \-\-id flag will not protect against vmem collisions when the
+\-\-vmem flag is used.
+Default is to store the vmem in LOGINDIR/vmem/lisp_XXX.virtualmem, where
+XXX is the id of this Medley run (see \-\-id flag above).
+See \-\-logindir below for setting of LOGINDIR.
+.TP
+.B \-r [\f[I]FILE\f[R] | \-], \-\-greet [\f[I]FILE\f[R] | \-]
+Use FILE as the Medley greetfile, unless FILE is \[lq]\-\[rq] in which
+case Medley will start up without using a greetfile.
+The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR\-INIT,
+except when the \-\-apps flag is used in which case it is
+$MEDLEYDIR/greetfiles/APPS\-INIT.
+.TP
+.B \-x [\f[I]DIR\f[R] | \-], \-\-logindir [\f[I]DIR\f[R] | \-]
+use DIR as LOGINDIR in Medley, unless DIR is \[lq]\-\[rq], in which case
+use $MEDLEYDIR/logindir.
+DIR (or $MEDLEYDIR/logindir) must be writeable by the current user.
+LOGINDIR defaults to $HOME/il.
+LOGINDIR is used by Medley as the working directory on start\-up and
+where it loads any \[lq]personal\[rq] initialization file from.
+.SS Other Options
+.PP
+\ 
+.TP
+.B \f[I]SYSOUT_FILE\f[R]
+The pathname of the file to use as a sysout for Medley to start from.
+If SYSOUT_FILE is not provided and none of the flags (\-\-apps,
+\-\-full, \-\-lisp) is used, then Medley will start from the saved
+virtual memory file from the previous session with the same ID_STRING as
+this run.
+If no such virtual memory file exists, then Medley will start from the
+standard full.sysout (equivalent to specifying the \-\-full flag).
+.TP
+.B \f[I]PASS_ON_ARGS\f[R]
+All arguments after the \[lq]\-\-\[rq] flag, are passed unaltered to lde
+via run\-medley.
+.SH FILES
+.TP
+.B $HOME/il
+Default Medley LOGINDIR
+.TP
+.B $HOME/il/vmem/lisp.virtualmem
+Default virtual memory file
+.TP
+.B $HOME/il/INIT(.LCOM)
+Default personal init file
+.TP
+.B $MEDLEYDIR/greetfiles/MEDLEYDIR\-INIT(.LCOM)
+Default Medley greetfile
+.SH BUGS
+.PP
+See GitHub Issues: <https://github.com/Interlisp/medley/issues>
+.SH COPYRIGHT
+.PP
+Copyright(c) 2023 by Interlisp.org

docs/man-page/medley.1.md

@@ -0,0 +1,164 @@
+% MEDLEY(1) | Start Medley Interlisp
+
+---
+adjusting: l
+hyphenate: false
+---
+
+NAME
+====
+
+**medley** — starts up Medley Interlisp
+
+SYNOPSIS
+========
+
+| **medley** \[ flags ... ] \[ *SYSOUT_FILE* ] \[ \-\- *PASS_ON_ARGS* ]
+
+DESCRIPTION
+===========
+
+Starts Medley Interlisp in a window.
+
+OPTIONS
+=======
+
+**MEDLEYDIR** is an environment variable set by Medley and used by many of the options described below.
+MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that
+is invoked after all symbolic links are resolved.  In the standard global installation this will 
+be /usr/local/interlisp/medley.  But Medley can be installed in multiple places on any given machine and
+hence MEDLEYDIR is computed on each invocation of medley. 
+
+
+Flags
+-----
+
+ 
+
+-h, \-\-help
+: Prints out a brief summary of the flags and arguments to medley.
+
+-z, \-\-man
+: Show the man page for medley
+
+-f, \-\-full                
+: Start Medley from the standard "full" sysout. full.sysout includes a complete Interlisp and CommonLisp environment
+with a standard set of development tools.  It does not include any of the applications built using Medley.
+(See *SYSOUT_FILE* below for more information on starting sysouts.)
+
+-l, \-\-lisp
+: Start Medley from the standard "lisp" sysout.  lisp.sysout only includes the basic Interlisp and
+CommonLisp environment.
+(See *SYSOUT_FILE* below for more information on starting sysouts.)
+
+-a, \-\-apps
+: Start Medley from the standard "apps" sysout.  apps.sysout includes everything in full.sysout plus Medley
+applications including Notecards, Rooms and CLOS.  It also includes pre-installed links to key Medley
+documentation.
+(See *SYSOUT_FILE* below for more information on starting sysouts.)
+
+-e, \-\-interlisp (relevent only when \-\-apps is specified)
+: Make the initial Exec window within Medley be an Interlisp Exec.  Default is to start in an XCL Exec.
+
+-n, \-\-noscroll
+: Ordinarily Medley displays scroll bars to enable the user to pan the Medley virtual display within the
+Medley window.  This is true even when the entire virtual display fits within the window.  Specifying
+\-\-noscroll turns off the scroll bars.  Note: If \-\-noscroll is specified and the virtual screen is larger
+than the window, there will be no way to pan to the non-visible parts of the virtual display.
+
+-g *WxH*, \-\-geometry *WxH*
+: Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows
+geomtery specification with +X+Y is not currently supported).  If \-\-geometry is not specified but \-\-screensize is,
+then the window size will be determined based on the \-\-screensize values and the \-\-noscroll flag.  If neither
+\-\-geometry nor \-\-screensize is provided, then the window size is set to 1440x900 if \-\-noscroll is set and 1462x922
+if \-\-noscroll is not set.
+
+-s *WxH*, \-\-screensize *WxH*
+: Sets the size of the virtual display as seen from Medley's point of view.
+The Medley window is an unscaled viewport onto this virtual display. If \-\-screensize is not specified but
+\-\-geometry is, then the virtual display size will be set so that the entire virtual display fits into the given
+window geometry.  If neither \-\-screensize nor \-\-geometry is provided, then the screen size is set to 1440x900.
+
+-t *STRING*, \-\-title *STRING*
+: Use STRING as title of Medley window.  Not relevent when the \-\-vnc flag is set.
+
+-d *:N*, \-\-display *:N*
+: Use X display :N.  Defaults to the value of $DISPLAY.  Not relevant when
+the \-\-vnc flag is set.
+
+-v, \-\-vnc  (Applicable only to Windows System for Linux installations)
+: Use a VNC window running on the Windows side instead of an X window.
+The VNC window will folllow the Windows desktop scaling setting allowing
+for much more usable Medley on high resolution displays.  On WSL, X windows
+do not scale well.
+
+-i [*ID_STRING* | - | \-\-], \-\-id [*ID_STRING* | - | \-\-]
+: Use ID_STRING as the id for this run of Medley, iunless ID_STRING is "-" or "\-\-". 
+If ID_STRING is "-", then use the basename of $MEDLEYDIR as the id.
+If ID_STRING is "\-\-", then use the basename of the parent directory of $MEDLEYDIR as the id.
+Only one instance of Medley with a given id can run at a time.
+The id is used to distinguish the virtual memory stores so that multiple
+instances of Medley can run simultaneously.  Default id is "default".
+
+-m *N*, \-\-mem *N*
+: Set Medley to run in N MB of virtual memory.  Defaults to 256MB.
+
+-p *FILE*, \-\-vmem *FILE*
+: Use FILE as the Medley virtual memory (vmem) store.  FILE must be writeable by the current user.
+Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously.
+The \-\-id flag will not protect against vmem collisions when the \-\-vmem flag is used.
+Default is to store the vmem in LOGINDIR/vmem/lisp_XXX.virtualmem, where XXX is the id of this 
+Medley run (see \-\-id flag above).  See \-\-logindir below for setting of LOGINDIR.
+
+-r \[*FILE* | -], \-\-greet \[*FILE* | -]
+: Use FILE as the Medley greetfile, unless FILE is "-" in which case
+Medley will start up without using a greetfile. The default Medley greetfile
+is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the \-\-apps flag is used
+in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.
+
+-x \[*DIR* | -], \-\-logindir \[*DIR* | -]
+: use DIR as LOGINDIR in Medley, unless DIR is "-", in which case use
+\$MEDLEYDIR/logindir.  DIR (or \$MEDLEYDIR/logindir) must be writeable by the current user.
+LOGINDIR defaults to \$HOME/il.  LOGINDIR is used by Medley as the working directory on start-up
+and where it loads any "personal" initialization file from.
+
+Other Options
+-------------
+ 
+
+*SYSOUT_FILE*
+: The pathname of the file to use as a sysout for Medley to start from.  If SYSOUT_FILE is not
+provided and none of the flags (\-\-apps, \-\-full, \-\-lisp) is used, then Medley will start from
+the saved virtual memory file from the previous session with the same ID_STRING as this run.
+If no such virtual memory file exists, then Medley will start from the standard full.sysout 
+(equivalent to specifying the \-\-full flag).
+
+*PASS_ON_ARGS*
+: All arguments after the "\-\-" flag, are passed unaltered to lde via run-medley.
+
+
+FILES
+=====
+
+\$HOME/il
+:  Default Medley LOGINDIR
+
+\$HOME/il/vmem/lisp.virtualmem
+: Default virtual memory file
+
+\$HOME/il/INIT(.LCOM)
+: Default personal init file
+
+\$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)
+:   Default Medley greetfile
+
+
+BUGS
+====
+
+See GitHub Issues: <https://github.com/Interlisp/medley/issues>
+
+COPYRIGHT
+=========
+
+Copyright(c) 2023 by Interlisp.org

docs/man-page/publish.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+./md2man.sh
+./man2html.sh
+

docs/man-page/showmd.sh

@@ -0,0 +1,2 @@
+#!/bin/bash
+pandoc medley.1.md -s -t man | /usr/bin/man -l -

greetfiles/APPS-INIT

@@ -0,0 +1,380 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "19-Jan-2023 12:44:20" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;9
 21022  
+
+      :CHANGES-TO (VARS APPS-INITCOMS)
+                  (FNS Apps.DoInit)
+
+      :PREVIOUS-DATE "19-Jan-2023 11:57:40" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;8
+)
+
+
+(PRETTYCOMPRINT APPS-INITCOMS)
+
+(RPAQQ APPS-INITCOMS

+       [(FILES (SYSLOAD)
+               MEDLEYDIR-INIT)
+        (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)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
+        (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
+
+(FILESLOAD (SYSLOAD)
+       MEDLEYDIR-INIT)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
+)
+
+(RPAQ? Apps.NotecardsActivated
 NIL)
+
+(RPAQ? Apps.RoomsActivated
 NIL)
+(DEFINEQ
+
+(Apps.InitNotecards

+  [LAMBDA (DoNotRefreshButtons)
+    (DECLARE
 (GLOBALVARS BackgroundMenuCommands BackgroundMenu))

+                                                             (* ; "Edited 19-Jan-2023 11:57 by FGH")


+                                                             (* ; "Edited  7-Dec-2022 11:14 by FGH")


+                                                             (* ; "Edited 12-Nov-2022 14:41 by FGH")


+                                                             (* ; "Edited 11-Sep-2022 01:09 by fgh")


+                                                             (* ; "Edited  7-Feb-2022 20:22 by tp7")

+    (LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC)
+                       (AND (UNIX-GETENV 'NC_INSTALLDIR)
+                            (CONCAT (UNIX-GETENV 'NC_INSTALLDIR)
+                                   "/notefiles"))
+                       (LET ((SUBDIR "notecards/notefiles"))
+                            (for
 DIR in
 (LIST (CONCAT (MEDLEYDIR)
+                                                     SUBDIR)
+                                              (CONCAT (MEDLEYDIR)
+                                                     "../" SUBDIR)
+                                              (CONCAT (MEDLEYDIR)
+                                                     "../../" SUBDIR)) thereis
 (DIRECTORYNAME DIR]
+           (DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR)
+                        (AND (UNIX-GETENV 'MEDLEY_USERDIR)
+                             (CONCAT (UNIX-GETENV 'MEDLEY_USERDIR)
+                                    "/notefiles"))
+                        (CONCAT LOGINDIR "notefiles"]
+          [if
 (AND (NOT (DIRECTORYNAME DESTDIR))
+                   (DIRECTORYNAME SRCDIR))
+              then
 (for
 NF in
 (DIRECTORY (CONCAT SRCDIR "/*"))
+                      do
 (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
+                                             (FILENAMEFIELD NF 'NAME)
+                                             'EXTENSION
+                                             (FILENAMEFIELD NF 'EXTENSION)
+                                             'VERSION
+                                             (FILENAMEFIELD NF 'VERSION]
+          (LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION))
+                 (LEFT (IPLUS (fetch
 (REGION RIGHT) of
 PW-REGION)
+                              20))
+                 (BOTTOM (fetch
 (REGION BOTTOM) of
 PW-REGION)))
+                (NC.BringUpNoteCardsIcon (create
 POSITION
+                                                XCOORD _ LEFT
+                                                YCOORD _ BOTTOM)))
+          (NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR
+                                                            'NAME "*" 'EXTENSION "notefile")
+                 (CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700)
+                        550 220))
+          (if
 (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
+              then
 (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
+                                                              (LIST '(NoteCards (
+                                                                              NC.BringUpNoteCardsIcon
+                                                                                 )
+                                                                            
+                                                               "Bring up the NoteCards control icon."
+                                                                            ]
+                          (SETQ BackgroundMenu NIL)))
+          (SETQ Apps.NotecardsActivated T)
+          (if
 (NOT DoNotRefreshButtons)
+              then
 (Apps.CreateButtons
])
+
+(Apps.DoInit

+  [LAMBDA NIL
+
+    (* ;; "Edited 19-Jan-2023 12:43 by FGH")

+
+    (* ;; "Edited 17-Jan-2023 23:23 by FGH")

+
+    (* ;; "Edited  7-Dec-2022 11:14 by FGH")

+
+    (* ;; "Edited 12-Nov-2022 13:57 by FGH")

+
+    (* ;; "Edited 12-Oct-2022 20:23 by fgh")

+
+    (* ;; "Edited  6-Sep-2022 17:22 by fgh")

+
+    (* ;; "Edited  4-Sep-2022 16:44 by larry")

+
+    (* ;; "Edited 18-Mar-2022 18:53 by fgh")

+
+    (* ;; "Edited 17-Dec-2021 22:05 by fgh")

+
+    (PROGN 
+           (* ;; " Adjust windows so that the exec window and the prompt window don't overlap")

+
+           [MAPC (OPENWINDOWS)
+                 (FUNCTION (LAMBDA (W)
+                             (COND
+                                ((EQ (WINDOWPROP W 'BUTTONEVENTFN)
+                                     'WHEN-WHO-LINE-SELECTED-FN)
+                                 (MOVEW W (CAR (WINDOWPROP W 'REGION))
+                                        (IDIFFERENCE SCREENHEIGHT 18)))
+                                ((STREQUAL (WINDOWPROP W 'TITLE)
+                                        "Prompt Window")
+                                 (PROGN (MOVEW W (create
 POSITION
+                                                        XCOORD _ 50
+                                                        YCOORD _ (IDIFFERENCE SCREENHEIGHT 120)))
+                                        (CLEARW W)))
+                                ((STREQUAL (WINDOWPROP W 'TITLE)
+                                        "Exec  (XCL)")
+                                 (PROGN (WINDOWPROP W 'TITLE "Exec  (INTERLISP)")
+                                        (MOVEW W (create
 POSITION
+                                                        XCOORD _ 50
+                                                        YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
+
+           (* ;; " Set up INITIALSLST based on information passed in from the Linux environment")

+
+           [SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY_FIRSTNAME)
+                                         (UNIX-GETENV 'MEDLEY_INITIALS]
+           (LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T)
+
+           (* ;; "change to interlisp exec if required")

+
+           (COND
+              ((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY_EXEC)
+                          "inter")
+                   (STRING-EQUAL (UNIX-GETENV 'NCO)
+                          "true"))
+               (BKSYSBUF "(EXEC_INTERLISP)")))
+
+           (* ;; "Always Activate CLOS")

+
+           (Apps.ActivateCLOS
)
+
+           (* ;; " activate Notecards if requested")

+
+           (COND
+              ((STRING-EQUAL (UNIX-GETENV 'RUN_NOTECARDS)
+                      "true")
+               (Apps.InitNotecards
 T)))
+
+           (* ;; " activate Rooms if requested")

+
+           (COND
+              ((STRING-EQUAL (UNIX-GETENV 'RUN_ROOMS)
+                      "true")
+               (Apps.ActivateRooms
 T)))
+
+           (* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")

+
+           (Apps.CreateButtons
 T])
+
+(Apps.CreateButtons

+  [LAMBDA (DoDocsToo)
                                      (* ; "Edited 13-Dec-2022 12:51 by frank")


+                                                             (* ; "Edited  7-Dec-2022 11:28 by FGH")


+                                                             (* ; "Edited  5-Dec-2022 17:31 by FGH")


+                                                             (* ; "Edited 12-Nov-2022 14:52 by FGH")

+
+    (* ;; " Create  buttons for Documentation and to activate Rooms, Notecards ")

+
+    (* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last.  This will make sure that  the NoteCards/Rooms buttons get properl deleted when they are activated.  But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).")

+
+    (LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards
)
+                                 "NOTECARDS")
+                           (LIST Apps.RoomsActivated '(Apps.ActivateRooms
)
+                                 "ROOMS")))
+           (FEATURES-LABELS (for
 FEATURE in
 FEATURES collect
 (CADDR FEATURE)))
+           (DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS")
+                       (LIST "https://interlisp.org/documentation/Medley-Primer.pdf" "PRIMER")
+                       (LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL")
+                       (LIST "https://interlisp.org/documentation/notecards_user_guide_v1.2.pdf" 
+                             "NOTECARDS")
+                       (LIST "https://interlisp.org/documentation/ROOMSTECHDESC.pdf" "ROOMS")))
+           (DOCS-LABELS (for
 DOC in
 DOCS collect
 (CADR DOC)))
+           (RIGHTMARGINISH 140)
+           (SECTION1YPOS 225)
+           (YPOSDELTA 55)
+           (SECTION2YPOS (IPLUS SECTION1YPOS (ITIMES (IPLUS (LENGTH DOCS)
+                                                            1)
+                                                    YPOSDELTA)))
+           (BUTTONY-FEATURES SECTION2YPOS)
+           (BUTTONY-DOCS SECTION1YPOS)
+           (FEATURES-REQUIREDP (OR (NOT Apps.RoomsActivated)
+                                   (NOT Apps.NotecardsActivated)))
+           (IWS NIL)
+           (BUTTONS NIL))
+
+          (* ;; "First remove/re-create feature buttons")

+
+          (for
 W in
 (OPENWINDOWS) when
 (MEMBER (WINDOWPROP W 'ICONLABEL)
+                                              (LIST "ACTIVATE" "FEATURES")) do
 (CLOSEW W))
+          (for
 B in
 *ALL-BUTTONS* when
 (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
+                                                'FEATURE)
+                                            (MEMBER (BUTTON-LABEL B)
+                                                   FEATURES-LABELS)) do
 (DELETE-BUTTON B))
+          [if
 FEATURES-REQUIREDP
+              then
 [SETQ IWS (LIST (Apps.CreateLabel
 "ACTIVATE" (IDIFFERENCE SCREENWIDTH
+                                                                       (IDIFFERENCE RIGHTMARGINISH 50
+                                                                              ))
+                                          (IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20)))
+                                   (Apps.CreateLabel
 "FEATURES" (IDIFFERENCE SCREENWIDTH
+                                                                       (IDIFFERENCE RIGHTMARGINISH 50
+                                                                              ))
+                                          (IDIFFERENCE SCREENHEIGHT SECTION2YPOS]
+                   (SETQ BUTTONS (for
 FEATURE in
 FEATURES
+                                    collect
 (OR (CAR FEATURE)
+                                                (LET (B)
+                                                     (SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES 
+                                                                                   YPOSDELTA))
+                                                     [SETQ B (CREATE-BUTTON (CADR FEATURE)
+                                                                    (CADDR FEATURE)
+                                                                    (create
 POSITION
+                                                                           XCOORD _ (IDIFFERENCE
+                                                                                     SCREENWIDTH 
+                                                                                     RIGHTMARGINISH)
+                                                                           YCOORD _ (IDIFFERENCE
+                                                                                     SCREENHEIGHT 
+                                                                                     BUTTONY-FEATURES
+                                                                                     ]
+                                                     (WINDOWPROP B 'Apps.BUTTON 'FEATURE)
+                                                     B]
+
+          (* ;; "Then if needed, remove/recreate documentation buttons")

+
+          (if
 DoDocsToo
+              then
 (for
 W in
 (OPENWINDOWS) when
 (MEMBER (WINDOWPROP W 'ICONLABEL)
+                                                       (LIST "DOCUMENTATION"))
+                      do
 (CLOSEW W))
+                   (for
 B in
 *ALL-BUTTONS* when
 (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
+                                                         'DOC)
+                                                     (MEMBER (BUTTON-LABEL B)
+                                                            DOCS-LABELS)) do
 (DELETE-BUTTON B))
+                   (SETQ IWS (CONS (Apps.CreateLabel
 "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
+                                                                            (IDIFFERENCE 
+                                                                                   RIGHTMARGINISH 50)
+                                                                            )
+                                          (IDIFFERENCE SCREENHEIGHT SECTION1YPOS))
+                                   IWS))
+                   (SETQ BUTTONS (APPEND (for
 DOC in
 DOCS
+                                            collect
 (LET (B)
+                                                         (SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS 
+                                                                                   YPOSDELTA))
+                                                         [SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc
+                                                                                      (CAR DOC))
+                                                                        (CADR DOC)
+                                                                        (create
 POSITION
+                                                                               XCOORD _
+                                                                               (IDIFFERENCE 
+                                                                                      SCREENWIDTH 
+                                                                                      RIGHTMARGINISH)
+                                                                               YCOORD _
+                                                                               (IDIFFERENCE 
+                                                                                      SCREENHEIGHT 
+                                                                                      BUTTONY-DOCS]
+                                                         (WINDOWPROP B 'Apps.BUTTON 'DOC)
+                                                         B))
+                                        BUTTONS)))
+          [for
 B in
 BUTTONS do
 (COND
+                                  ((WINDOWP B)
+                                   (WINDOWPROP B 'RIGHTBUTTONFN 'NILL)
+                                   (WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON)
+                                                                            (if
 (LASTMOUSESTATE
+                                                                                 (ONLY LEFT))
+                                                                                then
 (EXECUTE-BUTTON
+                                                                                      BUTTON]
+          [for
 IW in
 IWS do
 (COND
+                               ((WINDOWP IW)
+                                (WINDOWPROP IW 'RIGHTBUTTONFN 'NILL]
+          (for
 B in
 BUTTONS when
 (WINDOWP B) collect
 B])
+
+(Apps.CreateLabel

+  [LAMBDA (Text CenterX BottomY)
                             (* ; "Edited  5-Dec-2022 16:49 by FGH")

+    (LET* ((DS (DSPCREATE))
+           (FONT (DSPFONT '(HELVETICA 18 BOLD)
+                        DS))
+           (SR (STRINGREGION Text DS))
+           (BMW (fetch
 (REGION WIDTH) of
 SR))
+           (BMH (IPLUS (fetch
 (REGION HEIGHT) of
 SR)
+                       (fetch
 (REGION BOTTOM) of
 SR)))
+           (BM (BITMAPCREATE BMW BMH))
+           (POS (create
 POSITION
+                       XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2))
+                       YCOORD _ BottomY))
+           IW)
+          (DSPDESTINATION BM DS)
+          (PRIN1 Text DS)
+          (SETQ IW (ICONW BM BM POS))
+          (WINDOWPROP IW 'ICONLABEL Text)
+          IW])
+
+(Apps.ActivateCLOS

+  [LAMBDA NIL
+    (DECLARE
 (GLOBALVARS BackgroundMenuCommands BackgroundMenu))

+                                                             (* ; "Edited 12-Nov-2022 14:41 by FGH")

+    (if
 (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
+        then
 (PROGN [SETQ BackgroundMenuCommands
+                     (APPEND BackgroundMenuCommands
+                            (LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS)
+                                          "Bring up a class browser."
+                                          (SUBITEMS (|all in a package| (CLOS-BROWSER::BROWSE-CLASS
+                                                                         (
+                                                                     CLOS-BROWSER::CLASSES-IN-PACKAGE
+                                                                          (
+                                                                      CLOS-BROWSER::IN-SELECT-PACKAGE
+                                                                           )))
+                                                           
+                               "Select a package and browse all the classes defined in that package."
+                                                           ]
+                    (SETQ BackgroundMenu NIL])
+
+(Apps.ActivateRooms

+  [LAMBDA (DoNotRefreshButtons)
+    (DECLARE
 (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))

+                                                             (* ; "Edited  7-Dec-2022 11:13 by FGH")


+                                                             (* ; "Edited 12-Nov-2022 14:56 by FGH")

+    (if
 (NULL (SASSOC "Rooms" BackgroundMenuCommands))
+        then
 (ROOMS:RESET))
+    (SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLE_USERDIR)
+                                                 "/suites")
+                                          ROOMS:*SUITE-DIRECTORIES*))
+    (SETQ Apps.RoomsActivated T)
+    (PROMPTPRINT "
+  ROOMS functionality is now available via the Background Menu")
+    (if
 (NOT DoNotRefreshButtons)
+        then
 (Apps.CreateButtons
])
+
+(Apps.ShowDoc

+  [LAMBDA (URL)
                                              (* ; "Edited 18-Jan-2023 20:26 by FGH")

+    (ShellBrowse URL])
+
+(XCL-USER::EXEC_INTERLISP

+  [LAMBDA NIL
                                                (* ; "Edited 18-Mar-2022 18:53 by fgh")

+    (PROGN [MAPC (OPENWINDOWS)
+                 (FUNCTION (LAMBDA (W)
+                             (COND
+                                ((STREQUAL (WINDOWPROP W 'TITLE)
+                                        "Exec  (XCL)")
+                                 (PROGN (WINDOWPROP W 'TITLE "Exec  (INTERLISP)")
+                                        (MOVEW W (create
 POSITION
+                                                        XCOORD _ 50
+                                                        YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
+           (XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
+           (XCL:SET-EXEC-TYPE 'INTERLISP])
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(Apps.DoInit
)
+)
+(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY 
+
+(BKSYSBUF " ")
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1146 20888 (Apps.InitNotecards 1156 . 5018) (Apps.DoInit 5020 . 8119) (
+Apps.CreateButtons 8121 . 16945) (Apps.CreateLabel 16947 . 17757) (Apps.ActivateCLOS 17759 . 19108) (
+Apps.ActivateRooms 19110 . 19961) (Apps.ShowDoc 19963 . 20112) (XCL-USER::EXEC_INTERLISP 20114 . 20886
+)))))
+STOP

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

installers/deb/.gitignore

@@ -0,0 +1,7 @@
+/tmp
+*.deb
+*.swp
+*.save
+/tars
+/debs
+

installers/deb/build

@@ -0,0 +1 @@
+build_deb.sh

installers/deb/build_deb.sh

@@ -0,0 +1,139 @@
+#!/bin/bash
+###############################################################################
+#
+#    build_deb.sh: build .deb files for installing Medley Interlisp on Linux
+#                  and WSL
+#
+#    2023-01-10 Frank Halasz
+#
+#    Copyright 2023 by Interlisp.org
+#
+###############################################################################
+# set -x
+
+tarball_dir=tmp/tarballs
+
+#  Make sure we are in the right directory
+if [ ! -f ./control-linux ];
+then
+  echo "Can't find ./control file."
+  echo "Incorrect cwd?"
+  echo "Should be in medley/installers/deb"
+  echo "Exiting"
+  exit 1
+fi
+
+
+#  If running as a github action or -t arg, then skip downloading the tarballs
+if ! [[ -n "${GITHUB_WORKSPACE}" || "$1" = "-t" ]];
+then
+  #  First, make sure gh is available and we are logged in to github
+  if [ -z "$(which gh)" ];
+  then
+    echo "Can't find gh"
+    echo "Exiting."
+    exit 2
+  fi
+  gh auth status 2>&1 | grep --quiet --no-messages "Logged in to github.com"
+  if [ $? -ne 0 ];
+  then
+    echo "Not logged into github."
+    echo "Exiting."
+    exit 3
+  fi
+  # then clear out the ./tmp directory
+  rm -rf ./tmp
+  mkdir ./tmp
+  # then download the maiko and medley tarballs
+  mkdir -p ${tarball_dir}
+  echo "Fetching maiko and medley release tarballs"
+  gh release download --repo interlisp/maiko --dir ${tarball_dir} --pattern "*.tgz"
+  TAG=$(gh release list --repo interlisp/medley | head -n 1 | awk "{print \$1 }")
+  gh release download ${TAG} --repo interlisp/medley --dir ${tarball_dir} --pattern "*.tgz"
+  gh repo clone interlisp/notecards notecards -- --depth 1
+  (cd notecards; git archive --format=tgz --output=../notecards.tgz --prefix=notecards/ main)
+  mv notecards.tgz ${tarball_dir}
+  rm -rf notecards
+fi
+
+# Figure out release tags from tarball names
+pushd ${tarball_dir} >/dev/null 2>/dev/null
+medley_release=$(echo medley-*-loadups.tgz | sed "s/medley-\(.*\)-loadups.tgz/\1/")
+maiko_release=$(echo maiko-*-linux.x86_64.tgz | sed "s/maiko-\(.*\)-linux.x86_64.tgz/\1/")
+popd >/dev/null 2>/dev/null
+
+
+# For linux and wsl create packages for each arch
+for wslp in linux wsl
+do
+  # For each arch create a deb file
+  for arch_base in x86_64^amd64 armv7l^armhf aarch64^arm64
+  do
+    if [[ ${wslp} = wsl && ${arch_base} = armv7l^armhf ]];
+    then
+      continue
+    fi
+    arch=${arch_base%^*}
+    debian_arch=${arch_base#*^}
+    pkg_dir=tmp/pkg/${wslp}-${arch}
+    #
+    # Set up the pkg directories for this arch using the release tarballs
+    #
+    #    Copy in the right control file, modifying as needed
+    rm -rf ${pkg_dir}
+    mkdir -p ${pkg_dir}
+    mkdir -p ${pkg_dir}/DEBIAN
+    sed \
+      -e "s/--ARCH--/${debian_arch}/" \
+      -e "s/--RELEASE--/${medley_release}_${maiko_release}/" \
+      <control-${wslp} >${pkg_dir}/DEBIAN/control
+    #
+    il_dir=${pkg_dir}/usr/local/interlisp
+    MEDLEYDIR=${il_dir#${pkg_dir}}/medley
+    #    Maiko and Medley files to il_dir (/usr/local/interlisp)
+    mkdir -p ${il_dir}
+    tar -x -z -C ${il_dir} \
+              -f "${tarball_dir}/maiko-${maiko_release}-linux.${arch}.tgz"
+    tar -x -z -C ${il_dir} \
+              -f "${tarball_dir}/medley-${medley_release}-runtime.tgz"
+    tar -x -z -C ${il_dir} \
+              -f "${tarball_dir}/medley-${medley_release}-loadups.tgz"
+    tar -x -z -C ${il_dir} \
+              -f "${tarball_dir}/notecards.tgz"
+    # Copy the medley man page into place
+    man_dir="${pkg_dir}/usr/local/man/man1"
+    mkdir -p "${man_dir}"
+    cp -p "${il_dir}/medley/docs/man-page/medley.1.gz" "${man_dir}"
+    #     Configure postinst and postrm scripts and put in place in DEBIAN dir
+    sed -e "s>--MEDLEYDIR-->${MEDLEYDIR}>g" <postinst >${pkg_dir}/DEBIAN/postinst
+    chmod +x ${pkg_dir}/DEBIAN/postinst
+    sed -e "s>--MEDLEYDIR-->${MEDLEYDIR}>g" <postrm >${pkg_dir}/DEBIAN/postrm
+    chmod +x ${pkg_dir}/DEBIAN/postrm
+    #     For wsl scripts, include the vncviewer.exe
+    if [[ ${wslp} = wsl && ${arch} = x86_64 ]];
+    then
+      pushd ./tmp >/dev/null
+      rm -rf vncviewer64-1.12.0.exe
+      wget -q https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
+      popd >/dev/null
+      mkdir -p ${il_dir}/wsl
+      cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
+    fi
+    #
+    #  Create tar file for this arch
+    #
+    filename="medley-full-${medley_release}_${maiko_release}-${wslp}-${arch}"
+    mkdir -p tars
+    echo "Creating tar file tars/${filename}.tgz"
+    tar -C ${il_dir} -czf tars/${filename}.tgz .
+    #
+    # Create the deb file for this arch
+    #
+    mkdir -p debs
+    deb_filepath="debs/${filename}.deb"
+    rm -rf "${deb_filepath}"
+    dpkg-deb --build -Zxz "${pkg_dir}" "${deb_filepath}"
+    #
+  done
+done
+

installers/deb/control-linux

@@ -0,0 +1,9 @@
+Package: medley-interlisp
+Version: 1.0.0
+Release: --RELEASE--
+Maintainer: info@interlisp.org
+Description: Medley Interlisp for Linux
+Homepage: https://github.com/interlisp/medley
+Architecture: --ARCH--
+Depends: xdg-utils
+

installers/deb/control-wsl

@@ -0,0 +1,9 @@
+Package: medley-interlisp
+Version: 1.0.0
+Release: --RELEASE--
+Maintainer: info@interlisp.org
+Description: Medley Interlisp for Linux
+Homepage: https://github.com/interlisp/medley
+Architecture: --ARCH--
+Depends: wslu ( >= 4.1 ) | wslu ( << 4.0 ), tigervnc-standalone-server, tigervnc-xorg-extension 
+

installers/deb/debian_wsl.txt

@@ -0,0 +1,10 @@
+
+#
+sudo sed -i s/bullseye/bookworm/ /etc/apt/sources.list
+sudo apt update
+sudo apt full-upgrade -y
+#
+sudo apt install wget gnupg2 apt-transport-https
+wget -O - https://pkg.wslutiliti.es/public.key | sudo tee -a /etc/apt/trusted.gpg.d/wslu.asc
+echo "deb https://pkg.wslutiliti.es/debian bullseye main" | sudo tee -a /etc/apt/sources.list
+sudo apt update

installers/deb/postinst

@@ -0,0 +1,8 @@
+#!/bin/bash
+# put linkto medley.sh into /usr/local/bin
+if [[ $1 = configure && ! -e /usr/local/bin/medley ]];
+then
+  ln -s --MEDLEYDIR--/scripts/medley/medley.sh /usr/local/bin/medley
+fi
+# update the man database
+mandb

installers/deb/postrm

@@ -0,0 +1,9 @@
+#!/bin/bash
+if [[ $1 = remove || $1 = purge ]];
+then
+  if [ "$(realpath /usr/local/bin/medley)" = "--MEDLEYDIR--/scripts/medley.sh" ];
+  then
+    rm -f /usr/local/bin/medley
+  fi
+fi
+

installers/downloads_page/md2html.sh

@@ -0,0 +1,3 @@
+#!/bin/bash
+markdown medley_downloads.md > medley_downloads.html
+

installers/downloads_page/medley_downloads.html

@@ -0,0 +1,38 @@
+<ul>
+<li><h1>MEDLEY DOWNLOADS</h1>
+
+<ul>
+<li><h2>Standard Installations (for Debian-based distros)</h2>
+
+<ul>
+<li><h3>Standard Linux</h3>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
+<li><h3>Windows System for Linux</h3>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
+</ul></li>
+<li><h2>Local Installations (for any Linux distro)</h2>
+
+<ul>
+<li><h3>Standard Linux</h3>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
+<li><h3>Windows System for Linux</h3>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
+
+<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
+</ul></li>
+</ul></li>
+</ul>

installers/downloads_page/medley_downloads.md

@@ -0,0 +1,41 @@
+*    # MEDLEY DOWNLOADS
+ 
+     *    ## Standard Installations (for Debian-based distros)
+
+         * ### Standard Linux
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86\_64.deb)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.deb)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.deb)
+
+         * ### Windows System for Linux
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86\_64.deb)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.deb)
+
+     *    ## Local Installations (for any Linux distro)
+
+         * ### Standard Linux
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86\_64.tgz)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.tgz)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.tgz)
+
+         * ### Windows System for Linux
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86\_64.tgz)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.tgz)
+
+
+
+
+
+
+
+

library/SAMEDIR

@@ -1,11 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Apr-2022 09:23:16" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SAMEDIR.;3
 5583   
+
(FILECREATED "31-Oct-2022 13:09:14" {WMEDLEY}<library>SAMEDIR.;4
 6221   
 
-      :CHANGES-TO (FNS HOST&DIRECTORYFIELD CHECKSAMEDIR)
+      :CHANGES-TO (FNS CHECKSAMEDIR HOST&DIRECTORYFIELD)
 
-      :PREVIOUS-DATE " 1-Sep-2020 11:40:26" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SAMEDIR.;1)
+      :PREVIOUS-DATE "25-Apr-2022 09:23:16" {WMEDLEY}<library>SAMEDIR.;3)
 
 
 (* ; "
@@ -25,7 +24,8 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (CHECKSAMEDIR

-  [LAMBDA (FILE)
                                             (* ; "Edited 25-Apr-2022 09:16 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 31-Oct-2022 13:08 by rmk")


+                                                             (* ; "Edited 25-Apr-2022 09:16 by rmk")


                                                             (* ; "Edited  1-Sep-2020 11:40 by rmk:")

 
     (* ;; "Check (a) that we are writing FILE to the same directory we last read/wrote it and (b) that a version newer than the current one has not since appeared.")

@@ -44,11 +44,19 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
               (RETURN))                                      (* ; 
 
                     "RMK: Use HOST&DIRECTORYFIELD to canonicalize both file and connected directory")

           [SETQ OKHOST/DIRS (CONS (SETQ HOST/DIR (HOST&DIRECTORYFIELD
 (DIRECTORYNAME T)))
-                                  (MKLIST (CDR (ASSOC HOST/DIR MIGRATIONS :TEST 'STRING-EQUAL]
+                                  (MKLIST (CDR (OR (ASSOC HOST/DIR MIGRATIONS :TEST 'STRING-EQUAL)
+                                                   (ASSOC (TRUEFILENAME HOST/DIR)
+                                                          MIGRATIONS :TEST 'STRING-EQUAL)
+                                                   (ASSOC (PSEUDOFILENAME HOST/DIR)
+                                                          MIGRATIONS :TEST 'STRING-EQUAL]
           (COND
-             ((for
 OLDFILE in
 DATES bind
 HOST DIR never
 (CL:MEMBER (HOST&DIRECTORYFIELD
 (CDR OLDFILE)
-                                                                          )
-                                                               OKHOST/DIRS :TEST 'STRING-EQUAL))
+             ([for
 OLDFILE in
 DATES bind
 HOST DIR
+                 never
 (OR (CL:MEMBER (HOST&DIRECTORYFIELD
 (CDR OLDFILE))
+                                  OKHOST/DIRS :TEST 'STRING-EQUAL)
+                           (CL:MEMBER (TRUEFILENAME (HOST&DIRECTORYFIELD
 (CDR OLDFILE)))
+                                  OKHOST/DIRS :TEST 'STRING-EQUAL)
+                           (CL:MEMBER (PSEUDOFILENAME (HOST&DIRECTORYFIELD
 (CDR OLDFILE)))
+                                  OKHOST/DIRS :TEST 'STRING-EQUAL]
 
               (* ;; "The file is going somewhere it has never been before.  ")

 
@@ -90,11 +98,9 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
                   (SHOULDNT])
 
 (HOST&DIRECTORYFIELD

-  [LAMBDA (FILENAME)
                                         (* ; "Edited 25-Apr-2022 09:22 by rmk")


+  [LAMBDA (FILENAME)
                                         (* ; "Edited 31-Oct-2022 13:03 by rmk")


+                                                             (* ; "Edited 25-Apr-2022 09:22 by rmk")


                                                             (* ; "Edited 15-Apr-2018 19:05 by rmk:")

-
-    (* ;; "Returns the host&dir fields packed together.  HOST and device are upper cased")

-
     (PACKFILENAME.STRING 'DEVICE (U-CASE (FILENAMEFIELD.STRING FILENAME 'DEVICE))
            'HOST
            (U-CASE (FILENAMEFIELD.STRING FILENAME 'HOST))
@@ -116,5 +122,5 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
 )
 (PUTPROPS SAMEDIR COPYRIGHT ("Venue & Xerox Corporation" 1982 1984 1985 1986 1987 1990 2018 2020))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (802 5200 (CHECKSAMEDIR 812 . 4623) (HOST&DIRECTORYFIELD 4625 . 5198)))))
+  (FILEMAP (NIL (731 5838 (CHECKSAMEDIR 741 . 5249) (HOST&DIRECTORYFIELD 5251 . 5836)))))
 STOP

library/UNIXCOMM

@@ -1,11 +1,11 @@
 (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 "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11
 14599  
 
-      :CHANGES-TO (FNS CREATE-PROCESS-STREAM)
+      :CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
+                  (VARS UNIXCOMMCOMS)
 
-      :PREVIOUS-DATE " 7-Jul-2022 10:42:46" 
-{DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
+      :PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
 
 
 (* ; "
@@ -25,10 +25,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 
-                   UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
-              (GLOBALVARS *NEW-SHELL-DEVICE*)
-              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
+              (FNS INITIALIZE-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR UNIX-STREAM-EOFP 
+                   UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
+              (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 +36,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 +99,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 +117,38 @@ 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 25-Oct-2022 21:20 by lmm")


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


+                                                             (* ; "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 +161,27 @@ 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 18-Dec-2022 11:53 by rmk")


+                                                             (* ; "Edited 25-Oct-2022 21:54 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 _ (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)
+                                BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR)
+                                GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
+                                BLOCKIN _ (FUNCTION \BUFFERED.BINS)
+                                DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
 
 (UNIX-GET-NEXT-BUFFER

   [LAMBDA (STREAM WHATFOR NOERRORFLG)                        (* ; 
@@ -240,22 +216,20 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
                                             (\EOF.ACTION STREAM])
         (T (SHOULDNT)))])
 
-(UNIX-BACKFILEPTR-NEW

-  [LAMBDA (STREAM)                                           (* ; 
-
                                                           "Edited 13-Jun-90 01:07 by mitani")

+(UNIX-BACKFILEPTR

+  [LAMBDA (STREAM)
                                          (* ; "Edited 13-Jun-90 01:07 by mitani")

     (COND
        ((AND (fetch
 (STREAM CBUFPTR) of
 STREAM)
              (> (fetch
 (STREAM COFFSET) of
 STREAM)
                 0))
         (add
 (fetch
 (STREAM COFFSET) of
 STREAM)
-               -1))
+             -1))
        (T (ERROR "Can't back up this unix Stream" STREAM])
 
-(UNIX-STREAM-EOFP-NEW

-  [LAMBDA (STREAM)                                           (* ; 
-
                                                           "Edited 13-Jun-90 01:07 by mitani")

+(UNIX-STREAM-EOFP

+  [LAMBDA (STREAM)
                                          (* ; "Edited 13-Jun-90 01:07 by mitani")

 
-(* ;;; "true if bsp STREAM is at end of file, i.e.  is at a mark")

+(* ;;; "true if bsp STREAM is at end of file, i.e.  is at a mark")

 
     (COND
        ((AND (ffetch
 (STREAM CBUFPTR) of
 (\DTEST STREAM 'STREAM))
@@ -280,11 +254,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 +271,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 +295,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 +315,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 (1963 7028 (FORK-SHELL 1973 . 3170) (FORK-UNIX 3172 . 3348) (UNIX-KILL 3350 . 3539) (
+UNIX-WRITE 3541 . 4252) (CREATE-SHELL-STREAM 4254 . 5138) (CREATE-PROCESS-STREAM 5140 . 5979) (
+UNIXCOMM-AROUNDEXITFN 5981 . 7026)) (7076 12267 (INITIALIZE-SHELL-DEVICE 7086 . 8514) (
+UNIX-GET-NEXT-BUFFER 8516 . 10716) (UNIX-BACKFILEPTR 10718 . 11130) (UNIX-STREAM-EOFP 11132 . 11613) (
+UNIX-STREAM-OUT 11615 . 11871) (UNIX-STREAM-CLOSE 11873 . 12265)) (12515 14221 (
+CREATE-UNIX-SOCKET-STREAM 12525 . 13331) (ACCEPT-UNIX-SOCKET-STREAM 13333 . 14219)))))
 STOP

library/UNIXPRINT

@@ -1,27 +1,27 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 4-May-2018 17:18:00" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8
 14600  
 
-      changes to%:  (FNS UnixPrintCommand)
+
(FILECREATED "20-Jan-2023 22:44:05" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;4
 13651  
 
-      previous date%: "16-Apr-2018 17:25:15" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;7)
+      :CHANGES-TO (VARS UNIXPRINTCOMS)
+
+      :PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;3
+)
 
 
 (* ; "
-Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  All rights reserved.
+Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
 ")
 
 (PRETTYCOMPRINT UNIXPRINTCOMS)
 
 (RPAQQ UNIXPRINTCOMS

-       [(FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
-        (FUNCTIONS ShellCommand)
+       [(FILES UNIXUTILS)
+        (FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
         (INITVARS (UnixPrinterName NIL)
                (UNIXPRINTSWITCHES " -r -s "))
         (P 
-           (* ;; 
-
         "(InstallUnixPrinter)  commented out because POSTSCRIPT indirects according to platform")

+           (* ;; 
+
           "(InstallUnixPrinter)  commented out because POSTSCRIPT indirects according to platform")

 
            (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
         (PROP FILETYPE UNIXPRINT)
@@ -31,27 +31,29 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
                                                                              (LAMA])
+
+(FILESLOAD UNIXUTILS)
 (DEFINEQ
 
 (InstallUnixPrinter

-  [LAMBDA (PrinterTypes)
                                 (* ; "Edited  8-Feb-97 11:33 by rmk:")

+  [LAMBDA (PrinterTypes)
                                     (* ; "Edited  8-Feb-97 11:33 by rmk:")

 
-    (* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")

+    (* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")

 
     (DECLARE
 (GLOBALVARS PRINTERTYPES))
     (for
 type inside
 (OR PrinterTypes '(POSTSCRIPT))
        do
 (for
 x in
 PRINTERTYPES when
 (EQMEMB type (CAR x))
-                 do
 (LET ((PRINTERTYPE type))
-                             (PUTASSOC 'SEND (LIST 'UnixPrint)
-                                    (CDR x])
+             do
 (LET ((PRINTERTYPE type))
+                     (PUTASSOC 'SEND (LIST 'UnixPrint)
+                            (CDR x])
 
 (UnixPrint

-  [LAMBDA (HOST FILE PRINTOPTIONS)
                      (* ; "Edited  7-Dec-2001 14:55 by rmk:")


-                                                           (* ; "Edited 20-May-92 14:13 by nilsson")

+  [LAMBDA (HOST FILE PRINTOPTIONS)
                          (* ; "Edited  7-Dec-2001 14:55 by rmk:")


+                                                           (* ; "Edited 20-May-92 14:13 by nilsson")

 
-    (* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")

+    (* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")

 
-    (* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")

+    (* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")

 
     [LET*
      ((PRINTER (OR HOST UnixPrinterName))
@@ -60,9 +62,9 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
       (NSIDES (LISTGET PRINTOPTIONS '%#SIDES))
       (TYPE (PRINTERTYPE PRINTER)))
 
-     (* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")

+     (* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")

 
-     (* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype  for %" PRINTER %" is not Postscript%"))))")

+     (* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype  for %" PRINTER %" is not Postscript%"))))")

 
      [COND
         ((OR (NULL NAME)
@@ -76,109 +78,103 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
                  0)
              (SETQ NAME "Medley Output"]
 
-     (* ;; "Don't break if you have trouble with preexisting files, e.g. because of protection.")

+     (* ;; "Don't break if you have trouble with preexisting files, e.g. because of protection.")

 
-     (FOR
 F IN
 [CAR (NLSETQ (FILDIR (PACKFILENAME 'HOST 'DSK 'EXTENSION '* 'BODY
-                                                   (UnixTempFile
 'medleyprint. T]
+     (FOR
 F IN
 [CAR (NLSETQ (FILDIR (PACKFILENAME 'HOST 'DSK 'EXTENSION '* 'BODY (UnixTempFile

+                                                                                  'medleyprint. T]
         WHEN
 (CAR (NLSETQ (IGREATERP (DIFFERENCE (IDATE)
-                                                (GETFILEINFO F 'ICREATIONDATE))
-                                     120))) DO
 (NLSETQ (DELFILE F)))
+                                            (GETFILEINFO F 'ICREATIONDATE))
+                                 120))) DO
 (NLSETQ (DELFILE F)))
 
-     (* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by.  If we delete immediately, it may happen before lpr has done its thing.  ")

+     (* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by.  If we delete immediately, it may happen before lpr has done its thing.  ")

 
-     (CL:MULTIPLE-VALUE-BIND
-      (tmpstream tmpname)
-      (UnixTempFile
 'medleyprint.)
-      (COND
-         (tmpstream 
+     (CL:MULTIPLE-VALUE-BIND (tmpstream tmpname)
+         (UnixTempFile
 'medleyprint.)
+       (COND
+          (tmpstream 
 
-                (* ;; "First, copy the lisp file to /tmp so lpr can find it.")

+                 (* ;; "First, copy the lisp file to /tmp so lpr can find it.")

 
-                [CL:WITH-OPEN-STREAM
-                 (out tmpstream)
-                 (CL:WITH-OPEN-STREAM
-                  (in
 (OPENSTREAM FILE 'INPUT))
-                  (printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
-                         (COND
-                            (PRINTER (CONCAT " '" PRINTER "'"))
-                            (T ""))
-                         "...")
-                  (IF
 NSIDES
-                      THEN
 
-
-                            (* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")

+                 [CL:WITH-OPEN-STREAM
+                  (out tmpstream)
+                  (CL:WITH-OPEN-STREAM
+                   (in
 (OPENSTREAM FILE 'INPUT))
+                   (printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
+                          (COND
+                             (PRINTER (CONCAT " '" PRINTER "'"))
+                             (T ""))
+                          "...")
+                   (IF
 NSIDES
+                       THEN
 
+                            (* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")

 
                             (BIND
 C SAWCR
                                DO
 (SETQ C (BIN in))
-                                     (IF
 (MEMB C (CHARCODE (CR LF)))
-                                         THEN
 (BOUT out C)
-                                               (SETQ SAWCR T)
-                                       ELSEIF
 SAWCR
-                                         THEN
 
+                                  (IF
 (MEMB C (CHARCODE (CR LF)))
+                                      THEN
 (BOUT out C)
+                                           (SETQ SAWCR T)
+                                    ELSEIF
 SAWCR
+                                      THEN
 
+                                           (* ;; "First char of 2nd line:  nonCR/LF after CR/LF")

 
-                                               (* ;; 
-
                                             "First char of 2nd line:  nonCR/LF after CR/LF")

+                                           (* ;; "Put out simplex header, then print character in C")

 
-                                               (* ;; 
-
                                             "Put out simplex header, then print character in C")

+                                           (PRINTOUT out "%%BeginSetup" T)
+                                           (PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
+                                                  "<< /Duplex " (CL:IF (EQ NSIDES 1)
+                                                                    "false"
+                                                                    "true")
+                                                  " /Tumble false >> setpagedevice" T 
+                                                  "%%%%EndFeature" T "} stopped cleartomark" T)
+                                           (PRINTOUT out "%%EndSetup" T)
+                                           (BOUT out C)
+                                           (COPYCHARS in out (GETFILEPTR in)
+                                                  -1)
+                                           (RETURN)
+                                    ELSE
 (BOUT out C)))
+                     ELSE
 (COPYCHARS in out 0 -1]
 
-                                               (PRINTOUT out "%%BeginSetup" T)
-                                               (PRINTOUT out "[{" T 
-                                                      "%%%%BeginFeature: *Duplex Simplex" T 
-                                                      "<< /Duplex " (CL:IF (EQ NSIDES 1)
-                                                                        "false"
-                                                                        "true")
-                                                      " /Tumble false >> setpagedevice" T 
-                                                      "%%%%EndFeature" T "} stopped cleartomark" T)
-                                               (PRINTOUT out "%%EndSetup" T)
-                                               (BOUT out C)
-                                               (COPYCHARS in out (GETFILEPTR in)
-                                                      -1)
-                                               (RETURN)
-                                       ELSE
 (BOUT out C)))
-                    ELSE
 (COPYCHARS in out 0 -1]
+                 (* ;; "Now make Unix print the /tmp file.")

 
-                (* ;; "Now make Unix print the /tmp file.")

-
-                (ShellCommand
 (UnixPrintCommand
 PRINTER COPIES NAME tmpname)
-                       PROMPTWINDOW)
-                (printout PROMPTWINDOW "done" T))
-         (T (ERROR "Couldn't create unix temp file"]
+                 (ShellCommand (UnixPrintCommand
 PRINTER COPIES NAME tmpname)
+                        PROMPTWINDOW)
+                 (printout PROMPTWINDOW "done" T))
+          (T (ERROR "Couldn't create unix temp file"))))]
     T])
 
 (UnixShellQuote

   [LAMBDA (STRING)
-    (DECLARE
 (LOCALVARS . T))
                        (* ; "Edited 19-Apr-89 21:14 by TAL")

+    (DECLARE
 (LOCALVARS . T))
                                (* ; "Edited 19-Apr-89 21:14 by TAL")

     (LET* ((X (CHCON STRING))
            (CT X)
            C FLG)
           [while
 (LISTP CT) do
 (SETQ C (CAR CT))
-                                      (COND
-                                         ([OR (<= (CHARCODE a)
-                                                  C
-                                                  (CHARCODE z))
-                                              (<= (CHARCODE A)
-                                                  C
-                                                  (CHARCODE Z))
-                                              (<= (CHARCODE 0)
-                                                  C
-                                                  (CHARCODE 9))
-                                              (FMEMB C (CHARCODE (- /]
-                                          (SETQ CT (CDR CT)))
-                                         (T (SETQ FLG T)
-                                            (RPLNODE CT (CHARCODE \)
-                                                   (CONS (COND
-                                                            ((FMEMB C (CHARCODE (CR LF)))
-                                                             (CHARCODE SPACE))
-                                                            (T C))
-                                                         (SETQ CT (CDR CT]
+                               (COND
+                                  ([OR (<= (CHARCODE a)
+                                           C
+                                           (CHARCODE z))
+                                       (<= (CHARCODE A)
+                                           C
+                                           (CHARCODE Z))
+                                       (<= (CHARCODE 0)
+                                           C
+                                           (CHARCODE 9))
+                                       (FMEMB C (CHARCODE (- /]
+                                   (SETQ CT (CDR CT)))
+                                  (T (SETQ FLG T)
+                                     (RPLNODE CT (CHARCODE \)
+                                            (CONS (COND
+                                                     ((FMEMB C (CHARCODE (CR LF)))
+                                                      (CHARCODE SPACE))
+                                                     (T C))
+                                                  (SETQ CT (CDR CT]
           (COND
              (FLG (CONCATCODES X))
              (T STRING])
 
 (UnixTempFile

-  [LAMBDA (Prefix DontOpen)
                              (* ; "Edited 28-Apr-93 13:49 by rmk:")


-                                                             (* ; "Edited 12-Jan-89 19:07 by TAL")

+  [LAMBDA (Prefix DontOpen)
                                  (* ; "Edited 28-Apr-93 13:49 by rmk:")


+                                                             (* ; "Edited 12-Jan-89 19:07 by TAL")

     (LET* ([host (AND (BOUNDP 'FISTempDir)
                       (UNPACKFILENAME.STRING FISTempDir 'HOST]
            (dir (OR [COND
@@ -191,39 +187,35 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
            file unix)
           (COND
              ([for
 i from
 1 to
 100
-                 thereis
 (NOT (INFILEP (SETQ file (CONCAT "{UNIX}"
-                                                             (SETQ unix
-                                                              (CONCAT "/" dir "/" str i]
+                 thereis
 (NOT (INFILEP (SETQ file (CONCAT "{UNIX}" (SETQ unix
+                                                                    (CONCAT "/" dir "/" str i]
               (CL:VALUES [COND
                             (DontOpen file)
                             (T 
-                               (* ;; 
-
                             "Type TEXT seems to be important for Apple LaserWriters at PARC")

+                               (* ;; "Type TEXT seems to be important for Apple LaserWriters at PARC")

 
                                (OPENSTREAM file 'OUTPUT NIL '((TYPE TEXT]
                      unix])
 
 (UnixPrintCommand

-  [LAMBDA (PRINTER COPIES NAME TMPNAME)
                 (* ; "Edited  4-May-2018 17:17 by rmk:")

-                                                             (* ; 
-
                                                           "Edited 20-May-92 14:26 by nilsson")

+  [LAMBDA (PRINTER COPIES NAME TMPNAME)
                     (* ; "Edited  4-May-2018 17:17 by rmk:")


+                                                           (* ; "Edited 20-May-92 14:26 by nilsson")

 
-    (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr  tmpname%". The arguments to this function are:")

+    (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr  tmpname%". The arguments to this function are:")

 
-    (* ;; " PRINTER - the name of the printer. Usually something like lw or  plw.")

+    (* ;; " PRINTER - the name of the printer. Usually something like lw or  plw.")

 
-    (* ;; "COPIES - how many copies of this job to be printed.")

+    (* ;; "COPIES - how many copies of this job to be printed.")

 
-    (* ;; "NAME - the name of this job. This gets printed on the banner of your job.")

+    (* ;; "NAME - the name of this job. This gets printed on the banner of your job.")

 
-    (* ;; 
-
  "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")

+    (* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")

 
-    (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")

+    (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")

 
-    (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")

+    (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")

 
-    (* ;; "Use raw lpr, let system decide where it is located.")

+    (* ;; "Use raw lpr, let system decide where it is located.")

 
     (CONCAT "lpr " (COND
                       ((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
@@ -242,21 +234,12 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
            " " TMPNAME])
 )
 
-(CL:DEFUN ShellCommand
 (Cmd &OPTIONAL (Output T))
-   (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd))
-          (CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
-                                                             (GO OUT]
-                 (CL:LOOP (PRINTCCODE (READCCODE s)
-                                 Output))
-                 OUT))
-   NIL)
-
 (RPAQ? UnixPrinterName
 NIL)
 
 (RPAQ? UNIXPRINTSWITCHES
 " -r -s ")
 
 
-(* ;; "(InstallUnixPrinter)  commented out because POSTSCRIPT indirects according to platform")

+(* ;; "(InstallUnixPrinter)  commented out because POSTSCRIPT indirects according to platform")

 
 
 (PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)
@@ -266,26 +249,24 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
 (DEFINEQ
 
 (UnixPrintCommand

-  [LAMBDA (PRINTER COPIES NAME TMPNAME)
                 (* ; "Edited  4-May-2018 17:17 by rmk:")

-                                                             (* ; 
-
                                                           "Edited 20-May-92 14:26 by nilsson")

+  [LAMBDA (PRINTER COPIES NAME TMPNAME)
                     (* ; "Edited  4-May-2018 17:17 by rmk:")


+                                                           (* ; "Edited 20-May-92 14:26 by nilsson")

 
-    (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr  tmpname%". The arguments to this function are:")

+    (* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr  tmpname%". The arguments to this function are:")

 
-    (* ;; " PRINTER - the name of the printer. Usually something like lw or  plw.")

+    (* ;; " PRINTER - the name of the printer. Usually something like lw or  plw.")

 
-    (* ;; "COPIES - how many copies of this job to be printed.")

+    (* ;; "COPIES - how many copies of this job to be printed.")

 
-    (* ;; "NAME - the name of this job. This gets printed on the banner of your job.")

+    (* ;; "NAME - the name of this job. This gets printed on the banner of your job.")

 
-    (* ;; 
-
  "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")

+    (* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")

 
-    (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")

+    (* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")

 
-    (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")

+    (* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")

 
-    (* ;; "Use raw lpr, let system decide where it is located.")

+    (* ;; "Use raw lpr, let system decide where it is located.")

 
     (CONCAT "lpr " (COND
                       ((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
@@ -322,9 +303,9 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue.  Al
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018))
+(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1423 11730 (InstallUnixPrinter 1433 . 2041) (UnixPrint 2043 . 7114) (UnixShellQuote 
-7116 . 8670) (UnixTempFile 8672 . 9980) (UnixPrintCommand 9982 . 11728)) (11732 12105 (ShellCommand 
-11732 . 12105)) (12439 14197 (UnixPrintCommand 12449 . 14195)))))
+  (FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote 
+6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 (
+UnixPrintCommand 11560 . 13241)))))
 STOP

library/UNIXUTILS

@@ -0,0 +1,113 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "18-Jan-2023 20:36:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;7
 5091   
+
+      :CHANGES-TO (FNS ShellBrowser ShellBrowse ShellOpen)
+                  (VARS UNIXUTILSCOMS)
+                  (FUNCTIONS ShellWhich)
+
+      :PREVIOUS-DATE "18-Jan-2023 13:22:28" {DSK}<home>frank>il>medley>gmedley>greetfiles>UNIXUTILS.;1
+)
+
+
+(PRETTYCOMPRINT UNIXUTILSCOMS)
+
+(RPAQQ UNIXUTILSCOMS
 ((GLOBALVARS ShellBrowser)
+                      (INITVARS (ShellBrowser))
+                      (FUNCTIONS ShellCommand ShellWhich)
+                      (FNS ShellBrowser ShellBrowse)))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS ShellBrowser)
+)
+
+(RPAQ? ShellBrowser
 )
+
+(CL:DEFUN ShellCommand
 (Cmd &OPTIONAL (Output T))
+   (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd))
+          (CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
+                                                             (GO OUT]
+                 (CL:LOOP (PRINTCCODE (READCCODE s)
+                                 Output))
+                 OUT))
+   NIL)
+
+(CL:DEFUN ShellWhich
 (Cmd)
                                   (* ; "Edited 18-Jan-2023 13:19 by FGH")

+   [CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH))
+          (ShellCommand
 (CONCAT "which " Cmd)
+                 S)
+          (COND
+             ((EQ (GETEOFPTR S)
+                  0)
+              NIL)
+             (T (SETFILEPTR S 0)
+                (MKSTRING (READ S])
+(DEFINEQ
+
+(ShellBrowser

+  [LAMBDA NIL
                                                (* ; "Edited 18-Jan-2023 20:30 by FGH")

+    (OR ShellBrowser (SETQ ShellBrowser (LET (CMDPATH)
+                                             (if
 (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE")
+                                                                      (UNIX-GETENV "PATH")))
+                                                 then
 
+                                                      (* ;; " MacOS")

+
+                                                      "open"
+                                               elseif
 (SETQ CMDPATH (ShellWhich
 "wslview"))
+                                                 then
 
+                                                      (* ;; "windows with WSL")

+
+                                                      CMDPATH
+                                               elseif
 (SETQ CMDPATH (ShellWhich
 "xdg-open"))
+                                                 then
 
+                                                      (* ;; "Linux systems with xdg-utils installed ")

+
+                                                      CMDPATH
+                                               elseif
 (SETQ CMDPATH (ShellWhich
 "git"))
+                                                 then
 
+                                                      (* ;; " Systems with git installed")

+
+                                                      (CONCAT CMDPATH " web--browse") 
+                                                             (* ; "")

+                                               elseif
 (SETQ CMDPATH (ShellWhich
 "lynx"))
+                                                 then
 
+                                                      (* ;; " Systems with lynx installed")

+
+                                                      (LET (CMDPATH2)
+                                                           (if
 (SETQ CMDPATH2 (ShellWhich
 "xterm"))
+                                                               then
 (CONCAT CMDPATH2 " -e " CMDPATH)
+                                                             else
 (LIST CMDPATH)))
+                                               else
 
+                                                    (* ;; 
+
                                                    " Out of ideas - just return a dummy function")

+
+                                                    "true"])
+
+(ShellBrowse

+  [LAMBDA (URL)
                                              (* ; "Edited 18-Jan-2023 20:32 by FGH")

+
+    (* ;; " Open the web page specified by URL using an external browser via shell call")

+
+    (* ;; 
+
  " URL must start with http:// or https:// (case ireelevant) or this function will just return NIL.")

+
+    (* ;; " Returns T otherwise.")

+
+    (SETQ URL (MKSTRING URL))
+    (if
 (OR (EQ (STRPOS "http://" (L-CASE URL))
+                1)
+            (EQ (STRPOS "https://" (L-CASE URL))
+                1))
+        then
 (LET ((BROWSER (ShellBrowser
)))
+                  (if
 (LISTP BROWSER)
+                      then
 (CHAT 'SHELL NIL (CONCAT (CAR BROWSER)
+                                                   " '" URL "'"))
+                    else
 (ShellCommand
 (CONCAT BROWSER " '" URL "'" 
+                                              " >>/tmp/ShellBrowser-warnings-$$.txt")))
+                  T)
+      else
 NIL])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (764 1137 (ShellCommand 764 . 1137)) (1139 1538 (ShellWhich 1139 . 1538)) (1539 5068 (
+ShellBrowser 1549 . 4072) (ShellBrowse 4074 . 5066)))))
+STOP

lispusers/GITFNS

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Oct-2022 12:14:04" {WMEDLEY}<lispusers>GITFNS.;5
 118357 
+
(FILECREATED "31-Oct-2022 10:55:40" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;454
 118392 
 
-      :CHANGES-TO (FNS GIT-INIT)
+      :CHANGES-TO (COMMANDS cdg cdw)
 
-      :PREVIOUS-DATE "29-Sep-2022 10:52:34" {DSK}<home>frank>il>medley>wmedley>lispusers>GITFNS.;4)
+      :PREVIOUS-DATE " 1-Oct-2022 12:14:04" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;453)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -517,7 +519,7 @@
    (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
                              (CHARCODE (> /]
        (SETQ SUBDIR (CONCAT SUBDIR "/")))
-   (SLASHIT (/CNDIR (CONCAT (TRUEFILENAME (GIT-GET-PROJECT
 PROJECT 'GITHOST))
+   (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT
 PROJECT 'GITHOST)
                            (OR SUBDIR "")))
           T))
 
@@ -527,7 +529,7 @@
    (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
                              (CHARCODE (> /]
        (SETQ SUBDIR (CONCAT SUBDIR "/")))
-   (SLASHIT (/CNDIR (CONCAT (TRUEFILENAME (GIT-GET-PROJECT
 PROJECT 'WHOST))
+   (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT
 PROJECT 'WHOST)
                            (OR SUBDIR "")))
           T))
 
@@ -2211,31 +2213,31 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3905 19378 (GIT-CLONEP 3915 . 5178) (GIT-INIT 5180 . 5692) (GIT-MAKE-PROJECT 5694 . 
-14079) (GIT-GET-PROJECT 14081 . 16006) (GIT-PROJECT-PATH 16008 . 17052) (FIND-ANCESTOR-DIRECTORY 17054
- . 17403) (GIT-FIND-CLONE 17405 . 18486) (GIT-MAINBRANCH 18488 . 18883) (GIT-MAINBRANCH? 18885 . 19376
-)) (25826 28614 (ALLSUBDIRS 25836 . 27122) (MEDLEYSUBDIRS 27124 . 27817) (GITSUBDIRS 27819 . 28612)) (
-28615 33405 (TOGIT 28625 . 30031) (FROMGIT 30033 . 31014) (GIT-DELETE-FILE 31016 . 31862) (
-MYMEDLEY-DELETE-FILES 31864 . 33403)) (33406 36409 (MYMEDLEYSUBDIR 33416 . 33872) (GITSUBDIR 33874 . 
-34317) (STRIPDIR 34319 . 34690) (STRIPHOST 34692 . 34932) (STRIPNAME 34934 . 35687) (STRIPWHERE 35689
- . 36407)) (36410 38312 (GFILE4MFILE 36420 . 36783) (MFILE4GFILE 36785 . 37354) (GIT-REPO-FILENAME 
-37356 . 38310)) (38361 48183 (GIT-COMMIT 38371 . 39197) (GIT-PUSH 39199 . 39843) (GIT-PULL 39845 . 
-40457) (GIT-APPROVAL 40459 . 40808) (GIT-GET-FILE 40810 . 42775) (GIT-FILE-EXISTS? 42777 . 43051) (
-GIT-REMOTE-UPDATE 43053 . 43777) (GIT-REMOTE-ADD 43779 . 44086) (GIT-FILE-DATE 44088 . 45019) (
-GIT-FILE-HISTORY 45021 . 46955) (GIT-PRINT-FILE-HISTORY 46957 . 48007) (GIT-FETCH 48009 . 48181)) (
-48213 58806 (GIT-BRANCH-DIFF 48223 . 54563) (GIT-COMMIT-DIFFS 54565 . 55118) (GIT-BRANCH-RELATIONS 
-55120 . 58804)) (58851 71083 (GIT-BRANCH-NUM 58861 . 59434) (GIT-CHECKOUT 59436 . 60495) (
-GIT-WHICH-BRANCH 60497 . 60795) (GIT-MAKE-BRANCH 60797 . 63010) (GIT-BRANCHES 63012 . 65280) (
-GIT-BRANCH-EXISTS? 65282 . 65986) (GIT-PICK-BRANCH 65988 . 66316) (GIT-PRC-MENU 66318 . 68321) (
-GIT-PULL-REQUESTS 68323 . 70469) (GIT-SHORT-BRANCH-NAME 70471 . 70762) (GIT-LONG-NAME 70764 . 71081)) 
-(71113 74448 (GIT-MY-CURRENT-BRANCH 71123 . 71493) (GIT-MY-BRANCHP 71495 . 72000) (GIT-MY-NEXT-BRANCH 
-72002 . 72496) (GIT-MY-BRANCHES 72498 . 74446)) (74494 78446 (GIT-ADD-WORKTREE 74504 . 75988) (
-GIT-REMOVE-WORKTREE 75990 . 76920) (GIT-LIST-WORKTREES 76922 . 77726) (WORKTREEDIR 77728 . 78444)) (
-78494 109703 (GIT-GET-DIFFERENT-FILES 78504 . 84928) (GIT-BRANCHES-COMPARE-DIRECTORIES 84930 . 91087) 
-(GIT-WORKING-COMPARE-DIRECTORIES 91089 . 95915) (GIT-COMPARE-WORKTREE 95917 . 99895) (GITCDOBJBUTTONFN
- 99897 . 104387) (GIT-CD-LABELFN 104389 . 105471) (GIT-CD-MENUFN 105473 . 107913) (
-GIT-WORKING-COMPARE-FILES 107915 . 108535) (GIT-BRANCHES-COMPARE-FILES 108537 . 109701)) (109773 
-118290 (CDGITDIR 109783 . 110343) (GIT-COMMAND 110345 . 111903) (GITORIGIN 111905 . 112602) (
-GIT-INITIALS 112604 . 112908) (GIT-COMMAND-TO-FILE 112910 . 116399) (PROCESS-COMMAND 116401 . 117014) 
-(GIT-RESULT-TO-LINES 117016 . 117623) (STRIPLOCAL 117625 . 118288)))))
+  (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)))))
 STOP

lispusers/HELPSYS

@@ -1,15 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "12-Oct-2022 18:33:26" {DSK}<home>frank>il>medley>wmedley>lispusers>HELPSYS.;4
 87708  
+
(FILECREATED "13-Jan-2023 10:46:39" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;2
 87610  
 
-      :CHANGES-TO (FNS CLHS.LOOKUP)
+      :CHANGES-TO (VARS HELPSYSCOMS)
+                  (FNS REPO.LOOKUP)
 
-      :PREVIOUS-DATE "12-Oct-2022 18:24:45" {DSK}<home>frank>il>medley>wmedley>lispusers>HELPSYS.;3
-)
+      :PREVIOUS-DATE "12-Oct-2022 18:33:26" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;1)
 
 
 (* ; "
-Copyright (c) 1985-1987, 2020, 2022 by Xerox Corporation.
+Copyright (c) 1985-1987, 2020, 2022-2023 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT HELPSYSCOMS)
@@ -34,8 +34,8 @@ Copyright (c) 1985-1987, 2020, 2022 by Xerox Corporation.
               [INITVARS (CLHS.ROOT.URL "http://clhs.lisp.se/")
                      (CLHS.INDEX)
                      (CLHS.OPENER)
-                     (REPO.TYPES '(FNS FUNCTIONS VARS VARIABLES]
-              (GLOBALVARS CLHS.INDEX CLHS.OPENER REPO.TYPES CLHS.ROOT.URL))
+                     (HELPSYS.REPO.TYPES '(FNS FUNCTIONS VARS VARIABLES]
+              (GLOBALVARS CLHS.INDEX CLHS.OPENER HELPSYS.REPO.TYPES CLHS.ROOT.URL))
         (COMS 
 
 (* ;;; "Interface to DInfo")

@@ -322,12 +322,11 @@ Copyright (c) 1985-1987, 2020, 2022 by Xerox Corporation.
                       else
 "git web--browse"])
 
 (REPO.LOOKUP

-  [LAMBDA (ENTRY TYPES)
                                    (* ; "Edited 24-Aug-2022 16:54 by larry")


-                                                             (* ; "Edited 21-Aug-2022 15:54 by lmm")


-                                                             (* ; "Edited 19-Aug-2022 20:18 by lmm")


+  [LAMBDA (ENTRY TYPES)
                                      (* ; "Edited 13-Jan-2023 10:46 by lmm")


                                                              (* ; "Edited 16-Aug-2022 16:26 by lmm")

-    (for
 FL in
 (WHEREIS ENTRY (OR TYPES REPO.TYPES)
-                      T) bind
 POS FND
+    (for
 FL in
 (UNION (WHEREIS ENTRY (OR TYPES HELPSYS.REPO.TYPES)
+                             T)
+                      (LIST ENTRY)) bind
 POS FND
        when
 [SETQ FND (OR (FINDFILE-WITH-EXTENSIONS FL NIL '(TEDIT TXT TED))
                           (AND (SETQ POS (STRPOS "-" FL))
                                (FINDFILE-WITH-EXTENSIONS (SUBSTRING FL 1 (CL:1- POS))
@@ -1334,10 +1333,10 @@ Copyright (c) 1985-1987, 2020, 2022 by Xerox Corporation.
 
 (RPAQ? CLHS.OPENER
 )
 
-(RPAQ? REPO.TYPES
 '(FNS FUNCTIONS VARS VARIABLES))
+(RPAQ? HELPSYS.REPO.TYPES
 '(FNS FUNCTIONS VARS VARIABLES))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS CLHS.INDEX CLHS.OPENER REPO.TYPES CLHS.ROOT.URL)
+(GLOBALVARS CLHS.INDEX CLHS.OPENER HELPSYS.REPO.TYPES CLHS.ROOT.URL)
 )
 
 
@@ -1698,15 +1697,15 @@ Copyright (c) 1985-1987, 2020, 2022 by Xerox Corporation.
 (ADDTOVAR AROUNDEXITFNS
 \IRM.AROUND-EXIT)
 
 (PUTPROPS HELPSYS
 FILETYPE
 :FAKE-COMPILE-FILE)
-(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2022))
+(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2022 2023))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4630 10205 (HELPSYS 4640 . 6481) (IRM.LOOKUP 6483 . 8121) (GENERIC.MAN.LOOKUP 8123 . 
-9792) (IRM.RESET 9794 . 10203)) (10462 17569 (CLHS.INDEX 10472 . 13170) (CLHS.LOOKUP 13172 . 15072) (
-CLHS.OPENER 15074 . 16397) (REPO.LOOKUP 16399 . 17567)) (70641 72159 (IRM.GET.DINFOGRAPH 70651 . 71526
-) (IRM.DISPLAY.REF 71528 . 72157)) (72161 72523 (IRM.LOAD-GRAPH 72161 . 72523)) (72848 78352 (
-IRM.DISPLAY.CREF 72858 . 74572) (IRM.CREF.BOX 74574 . 75401) (IRM.PUT.CREF 75403 . 75628) (
-IRM.GET.CREF 75630 . 76001) (IRM.CREF.BUTTONEVENTFN 76003 . 78350)) (78907 87213 (\IRM.GET.REF 78917
- . 80248) (\IRM.SMART.REF 80250 . 82177) (\IRM.CHOOSE.REF 82179 . 83430) (\IRM.WILD.REF 83432 . 84687)
- (\IRM.WILDCARD 84689 . 85055) (\IRM.WILD.MATCH 85057 . 86287) (\IRM.GET.HASHFILE 86289 . 86752) (
-\IRM.GET.KEYWORDS 86754 . 87211)) (87350 87506 (\IRM.AROUND-EXIT 87350 . 87506)))))
+  (FILEMAP (NIL (4671 10246 (HELPSYS 4681 . 6522) (IRM.LOOKUP 6524 . 8162) (GENERIC.MAN.LOOKUP 8164 . 
+9833) (IRM.RESET 9835 . 10244)) (10503 17450 (CLHS.INDEX 10513 . 13211) (CLHS.LOOKUP 13213 . 15113) (
+CLHS.OPENER 15115 . 16438) (REPO.LOOKUP 16440 . 17448)) (70538 72056 (IRM.GET.DINFOGRAPH 70548 . 71423
+) (IRM.DISPLAY.REF 71425 . 72054)) (72058 72420 (IRM.LOAD-GRAPH 72058 . 72420)) (72745 78249 (
+IRM.DISPLAY.CREF 72755 . 74469) (IRM.CREF.BOX 74471 . 75298) (IRM.PUT.CREF 75300 . 75525) (
+IRM.GET.CREF 75527 . 75898) (IRM.CREF.BUTTONEVENTFN 75900 . 78247)) (78804 87110 (\IRM.GET.REF 78814
+ . 80145) (\IRM.SMART.REF 80147 . 82074) (\IRM.CHOOSE.REF 82076 . 83327) (\IRM.WILD.REF 83329 . 84584)
+ (\IRM.WILDCARD 84586 . 84952) (\IRM.WILD.MATCH 84954 . 86184) (\IRM.GET.HASHFILE 86186 . 86649) (
+\IRM.GET.KEYWORDS 86651 . 87108)) (87247 87403 (\IRM.AROUND-EXIT 87247 . 87403)))))
 STOP

lispusers/PSEUDOHOSTS

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2022 17:54:43" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;150
 27644  
+
(FILECREATED "31-Oct-2022 23:32:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;151
 27537  
 
       :CHANGES-TO (FNS OPENFILE.PH)
 
-      :PREVIOUS-DATE "25-Jun-2022 17:24:45" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;149)
+      :PREVIOUS-DATE "14-Jul-2022 17:54:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;150)
 
 
 (PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -314,6 +312,8 @@
 (OPENFILE.PH

   [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
 
+    (* ;; "Edited 31-Oct-2022 23:32 by rmk")

+
     (* ;; "Edited 14-Jul-2022 17:53 by rmk")

 
     (* ;; "Edited 25-Jun-2022 17:06 by rmk:  If the stream was opened through the pseudohost, then it should only be registered on the pseudohost.  We assume that it is safe to remove it from the target hosts list.  The goal is that OPENP should only see it once, as being open on the pseudohost.")

@@ -325,12 +325,11 @@
     (LET ((TARGETDEV (FETCH
 (PHDEVICE TARGETDEV) OF
 FDEV))
           (STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
                          FDEV)))
-         (IF
 STREAM
-             THEN
 (FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM)
-                  (CHANGE
 (FETCH
 (STREAM FULLFILENAME) OF
 STREAM)
-                         (CONTRACT.PH
 DATUM FDEV))
-                  (REPLACE
 (STREAM DEVICE) OF
 STREAM WITH
 FDEV)
-           ELSE
 (ERROR "File not found: " FILE))
+         (CL:WHEN STREAM
+             (FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM)
+             (CHANGE
 (FETCH
 (STREAM FULLFILENAME) OF
 STREAM)
+                    (CONTRACT.PH
 DATUM FDEV))
+             (REPLACE
 (STREAM DEVICE) OF
 STREAM WITH
 FDEV))
          STREAM])
 
 (GETFILENAME.PH

@@ -524,13 +523,13 @@
     (LOAD 'EXPORTS.ALL))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1350 9382 (PSEUDOHOST 1360 . 6919) (PSEUDOHOSTP 6921 . 7434) (PSEUDOHOSTS 7436 . 7793) 
-(TARGETHOST 7795 . 8069) (TRUEFILENAME 8071 . 8758) (PSEUDOFILENAME 8760 . 9380)) (9410 16949 (
-EXPAND.PH 9420 . 10673) (CONTRACT.PH 10675 . 13340) (SLASHIT 13342 . 14910) (UNSLASHIT 14912 . 16658) 
-(GETHOSTINFO.PH 16660 . 16947)) (16950 24979 (OPENFILE.PH 16960 . 18058) (GETFILENAME.PH 18060 . 18349
-) (DIRECTORYNAMEP.PH 18351 . 18975) (CLOSEFILE.PH 18977 . 19444) (REOPENFILE.PH 19446 . 20011) (
-DELETEFILE.PH 20013 . 20297) (OPENP.PH 20299 . 20594) (UNREGISTERFILE.PH 20596 . 21138) (
-REGISTERFILE.PH 21140 . 21674) (GENERATEFILES.PH 21676 . 22716) (GETFILEINFO.PH 22718 . 23020) (
-SETFILEINFO.PH 23022 . 23221) (NEXTFILEFN.PH 23223 . 23765) (FILEINFOFN.PH 23767 . 24038) (
-RENAMEFILE.PH 24040 . 24977)))))
+  (FILEMAP (NIL (1268 9300 (PSEUDOHOST 1278 . 6837) (PSEUDOHOSTP 6839 . 7352) (PSEUDOHOSTS 7354 . 7711) 
+(TARGETHOST 7713 . 7987) (TRUEFILENAME 7989 . 8676) (PSEUDOFILENAME 8678 . 9298)) (9328 16867 (
+EXPAND.PH 9338 . 10591) (CONTRACT.PH 10593 . 13258) (SLASHIT 13260 . 14828) (UNSLASHIT 14830 . 16576) 
+(GETHOSTINFO.PH 16578 . 16865)) (16868 24872 (OPENFILE.PH 16878 . 17951) (GETFILENAME.PH 17953 . 18242
+) (DIRECTORYNAMEP.PH 18244 . 18868) (CLOSEFILE.PH 18870 . 19337) (REOPENFILE.PH 19339 . 19904) (
+DELETEFILE.PH 19906 . 20190) (OPENP.PH 20192 . 20487) (UNREGISTERFILE.PH 20489 . 21031) (
+REGISTERFILE.PH 21033 . 21567) (GENERATEFILES.PH 21569 . 22609) (GETFILEINFO.PH 22611 . 22913) (
+SETFILEINFO.PH 22915 . 23114) (NEXTFILEFN.PH 23116 . 23658) (FILEINFOFN.PH 23660 . 23931) (
+RENAMEFILE.PH 23933 . 24870)))))
 STOP

medley

@@ -0,0 +1 @@
+scripts/medley/medley.sh

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"
 

scripts/copy-all.sh

@@ -16,4 +16,7 @@ fi
 ./scripts/cpv tmp/lisp.sysout loadups
 ./scripts/cpv tmp/whereis.hash loadups
 ./scripts/cpv tmp/exports.all library
+if [ "${1}" = "-apps" ]; then
+    ./scripts/cpv tmp/apps.sysout loadups
+fi
 

scripts/loadup-all.sh

@@ -7,12 +7,19 @@ if [ ! -x run-medley ] ; then
     exit 1
 fi
 
+if [ "$1" = "-apps" ]; then
+    apps="./scripts/loadup-apps-from-full.sh"
+else
+    apps="true"
+fi
+
 ./scripts/loadup-init.sh && \
     ./scripts/loadup-mid-from-init.sh && \
     ./scripts/loadup-lisp-from-mid.sh && \
     ./scripts/loadup-full-from-lisp.sh && \
+    ${apps} && \
     ./scripts/loadup-aux.sh && \
-    ./scripts/copy-all.sh
+    ./scripts/copy-all.sh $1
 
 echo "**** DONE ****"
 

scripts/loadup-apps-from-full.sh

@@ -0,0 +1,73 @@
+#!/bin/bash
+
+#set -x
+
+# function to discover what directory this script is being executed from
+where_am_i() {
+
+    # call this with ${BASH_SOURCE[0]:-$0} as its (only) parameter
+
+    local SCRIPT_PATH="$1";
+
+    pushd . > '/dev/null';
+
+    while [ -h "$SCRIPT_PATH" ];
+    do
+        cd "$( dirname -- "$SCRIPT_PATH"; )";
+        SCRIPT_PATH="$( readlink -f -- "$SCRIPT_PATH"; )";
+    done
+
+    cd "$( dirname -- "$SCRIPT_PATH"; )" > '/dev/null';
+    SCRIPT_PATH="$( pwd; )";
+
+    popd  > '/dev/null';
+
+    echo "${SCRIPT_PATH}"
+}
+
+SCRIPTDIR=$(where_am_i "${BASH_SOURCE[0]:-$0}")
+export MEDLEYDIR=$(cd ${SCRIPTDIR} && cd .. && pwd)
+export ROOMSDIR=${MEDLEYDIR}/rooms
+export CLOSDIR=${MEDLEYDIR}/clos
+
+export NOTECARDSDIR=${MEDLEYDIR}/notecards
+if [ ! -e ${NOTECARDSDIR} ]; then
+    NOTECARDSDIR=$(cd ${MEDLEYDIR}/../ && pwd)/notecards
+    if [ ! -e ${NOTECARDSDIR} ]; then
+        NOTECARDSDIR=$(cd ${MEDLEYDIR}/../../ && pwd)/notecards
+        if [ ! -e ${NOTECARDSDIR} ]; then
+            NOTECARDSDIR=""
+        fi
+    fi
+fi
+
+if [ -z "${SYSOUTDIR}" ]; then
+    export SYSOUTDIR=${MEDLEYDIR}/tmp
+fi
+
+if [ -z "${FULLSYSOUTPATH}" ]; then
+    FULLSYSOUTPATH=${SYSOUTDIR}/full.sysout
+    if [ ! -e ${FULLSYSOUTPATH} ]; then
+       FULLSYSOUTPATH=${MEDLEYDIR}/loadups/full.sysout
+    fi
+fi
+
+cd ${MEDLEYDIR}
+
+scr="-sc 1024x768 -g 1042x790"
+
+mkdir -p ${SYSOUTDIR}
+touch ${SYSOUTDIR}/loadup.timestamp
+
+./run-medley $scr -loadup "${MEDLEYDIR}/sources/LOADUP-APPS.CM" "${FULLSYSOUTPATH}"
+
+if [ ${SYSOUTDIR}/apps.sysout -nt ${SYSOUTDIR}/loadup.timestamp ]; then
+    echo ---- made ----
+    ls -l ${SYSOUTDIR}/apps.*
+    echo --------------
+else
+    echo XXXXX FAILURE XXXXX
+    ls -l ${SYSOUTDIR}/apps.*
+    exit 1
+fi
+

scripts/loadup-db.sh

@@ -12,8 +12,7 @@ touch tmp/db.timestamp
 scr="-sc 1024x768 -g 1042x790"
 
 echo '" (IL:MEDLEY-INIT-VARS)(IL:FILESLOAD MEDLEY-UTILS)(IL:MAKE-FULLER-DB)(IL:LOGOUT T)"' > tmp/db.cm
-./run-medley $scr -loadup "$MEDLEYDIR"/tmp/db.cm -full
-
+./run-medley $scr -loadup "$MEDLEYDIR"/tmp/db.cm -n
 if [ tmp/fuller.database -nt tmp/db.timestamp ]; then
     
     echo ---- made ----

scripts/medley/medley.sh

@@ -0,0 +1,116 @@
+#!/bin/bash
+###############################################################################
+#
+#    medley.sh - script for running Medley Interlisp on Linux/WSL.
+#                On Linux and WSL when using X Windows it just sets
+#                up directories and environment variables and then calls
+#                run-medley.  On WSL, there is an option to run without
+#                or around X Windows by using the XVnc and a VNC viewer
+#                on the Windows side.  This script will start this VNC viewer
+#                on the Windows side.
+#
+#   2023-01-12 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+#set -x
+
+# functions to discover what directory this script is being executed from
+get_abs_filename() {
+  # $1 : relative filename
+  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+}
+get_script_dir() {
+
+    # call this with ${BASH_SOURCE[0]:-$0} as its (only) parameter
+
+    # set -x
+
+    local SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+    pushd . > '/dev/null';
+
+    while [ -h "$SCRIPT_PATH" ];
+    do
+        cd "$( dirname -- "$SCRIPT_PATH"; )";
+        SCRIPT_PATH="$( readlink -f -- "$SCRIPT_PATH"; )";
+    done
+
+    cd "$( dirname -- "$SCRIPT_PATH"; )" > '/dev/null';
+    SCRIPT_PATH="$( pwd; )";
+
+    popd  > '/dev/null';
+
+    # set +x
+
+    echo "${SCRIPT_PATH}"
+}
+
+SCRIPTDIR=$(get_script_dir "${BASH_SOURCE[0]:-$0}")
+#  Define some generally useful functions
+source ${SCRIPTDIR}/medley_utils.sh
+
+export MEDLEYDIR=$(cd ${SCRIPTDIR}; cd ../..; pwd)
+IL_DIR=$(cd ${MEDLEYDIR}; cd ..; pwd)
+export LOGINDIR=${HOME}/il
+
+# Are we running under WSL?
+grep --ignore-case --quiet wsl /proc/sys/kernel/osrelease
+if [ $? -eq 0 ];
+then
+  wsl='true'
+else
+  wsl='false'
+fi
+
+# process args
+source ${SCRIPTDIR}/medley_args.sh
+
+# Make sure that there is not another instance currently running with this same id
+ps ax | grep ldex | grep --quiet "\-id ${run_id}"
+if [ $? -eq 0 ];
+then
+  echo "Another instance of Medley Interlisp is already running with the id \"${run_id}\"."
+  echo "Only a single instance with a given id can be run at the same time."
+  echo "Please retry using the \"--id <name>\" argument to give this new instance a different id."
+  echo "Exiting"
+  exit 3
+fi
+
+# Set the LDEDESTSYSOUT env variable based on id
+if [ -z ${LDEDESTSYSOUT} ];
+then
+  if [ "${run_id}" = "default" ];
+  then
+    export LDEDESTSYSOUT=${LOGINDIR}/vmem/lisp.virtualmem
+  else
+    export LDEDESTSYSOUT=${LOGINDIR}/vmem/lisp_${run_id}.virtualmem
+  fi
+fi
+
+# Create LOGINDIR if necessary
+if [ ! -e ${LOGINDIR} ];
+then
+  mkdir -p ${LOGINDIR}
+elif [ ! -d ${LOGINDIR} ];
+then
+  echo "ERROR: Medley requires a directory named ${LOGINDIR}."
+  echo "But ${LOGINDIR} exists appears not be a directory."
+  echo "Exiting"
+  exit 2
+fi
+mkdir -p ${LOGINDIR}/vmem
+
+# Call run-medley with or without vnc
+if [[ ${wsl} = false || ${use_vnc} = false ]];
+then
+  # If not using vnc, just call run-medley
+  ${MEDLEYDIR}/run-medley -id "${run_id}" ${geometry} ${screensize} "${run_args[@]}"
+else
+  # do the vnc thing on wsl
+  source ${SCRIPTDIR}/medley_vnc.sh
+fi
+
+

scripts/medley/medley_args.sh

@@ -0,0 +1,204 @@
+###############################################################################
+#
+#    medley_args.sh - script for processing the args to medley.sh script.
+#
+#   !!!! This script is meant to be SOURCEd from the scripts/medley.sh script.
+#   !!!! It should not be run as a standlone script.
+#
+#   2023-01-12 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+# load usage function
+source ${SCRIPTDIR}/medley_usage.sh
+
+# Process args
+run_args=()
+run_id="default"
+use_vnc='false'
+geometry=""
+screensize=""
+noscroll='false'
+pass_args=false
+lisp_flag=false
+full_flag=false
+apps_flag=false
+sysout_flag=false
+sysout_arg=""
+err_msg=""
+greet_specified='false'
+
+while [ "$#" -ne 0 ];
+do
+  if [ ${pass_args} = false ];
+  then
+    case "$1" in
+      -i | --id)
+        if [ "$2" = "-" ];
+        then
+          run_id=$( basename ${MEDLEYDIR} )
+        elif [ "$2" = "--" ];
+        then
+          run_id=$(cd ${MEDLEYDIR}; cd ..; basename $(pwd))
+        else
+          check_for_dash_or_end "$1" "$2"
+          run_id=$(echo "$2" | sed s/[^A-Za-z0-9]//g)
+        fi
+        shift
+        ;;
+      -v | --vnc)
+        if [[ ${wsl} = true && $(uname -m) = x86_64 ]];
+        then
+          use_vnc=true
+        else
+          echo "Warning: The -v or --vnc flag was set."
+          echo "But the vnc option is only available when running on "
+          echo "Windows System for Linux (wsl) on x86_64 machines."
+          echo "Ignoring the -v or --vnc flag."
+          use_vnc=false
+        fi
+        ;;
+      -g | --geometry)
+        check_for_dash_or_end "$1" "$2"
+        geometry="$2"
+        shift
+        ;;
+      -s | --screensize)
+        check_for_dash_or_end "$1" "$2"
+        screensize="$2"
+        shift
+        ;;
+      -n | --noscroll)
+        noscroll=true
+        run_args+=("-noscroll")
+        ;;
+      -e | --interlisp)
+        export MEDLEY_EXEC="inter"
+        ;;
+      -a | --apps)
+        sysout_arg="apps"
+        apps_flag=true
+        ;;
+      -f | --full)
+        sysout_arg="-full"
+        full_flag=true
+        ;;
+      -l | --lisp)
+        sysout_arg="-lisp"
+        lisp_flag=true
+        ;;
+      -m | --mem)
+        check_for_dash_or_end "$1" "$2"
+        run_args+=(-m $2)
+        shift
+        ;;
+      -t | --title)
+        check_for_dash_or_end "$1" "$2"
+        run_args+=(-title $2)
+        shift
+        ;;
+      -d | --display)
+        check_for_dash_or_end "$1" "$2"
+        run_args+=(-d $2)
+        shift
+        ;;
+      -r | --greet)
+        if [[ "$2" = "-" || "$2" = "--" ]];
+        then
+          run_args+=("--nogreet")
+        else
+          check_for_dash_or_end "$1" "$2"
+          check_file_readable "$1" "$2"
+          run_args+=("-greet" "$2")
+        fi
+        greet_specified='true'
+        shift
+        ;;
+      -p | --vmem)
+        check_for_dash_or_end "$1" "$2"
+        check_file_writeable_or_creatable "$1" "$2"
+        export LDEDESTSYSOUT="$2"
+        shift
+        ;;
+      -x | --logindir)
+        if [[ "$2" = "-" || "$2" = "--" ]];
+        then
+          check_dir_writeable_or_creatable "$1" "${MEDLEYDIR}/logindir"
+          LOGINDIR="${MEDLEYDIR}/logindir"
+        else
+          check_for_dash_or_end "$1" "$2"
+          check_dir_writeable_or_creatable "$1" "$2"
+          LOGINDIR="$2"
+        fi
+        shift
+        ;;
+      -h | --help)
+        usage
+        ;;
+      -z | --man)
+        /usr/bin/man -l "${MEDLEYDIR}/docs/man-page/medley.1.gz"
+        exit 0
+        ;;
+      --)
+        pass_args=true
+        ;;
+      -*)
+        err_msg=("ERROR: Unknown flag: $1" )
+        usage "${err_msg[@]}"
+        ;;
+      *)
+        if [[ $# -eq 1 || "$2" = "--" ]];
+        then
+          sysout_flag=true
+          sysout_arg="$2"
+        else
+          err_msg=(
+            "ERROR: sysout argument must be last argument"
+            "or last argument before the \"--\" flag"
+          )
+          usage "${err_msg[@]}"
+        fi
+        ;;
+    esac
+  else
+    run_args+=("$1")
+  fi
+  shift
+done
+
+# Figure out screensize and geometry based on arguments
+source ${SCRIPTDIR}/medley_geometry.sh
+
+# Figure out the sysout situation
+ctr=0
+for x in ${lisp_flag} ${full_flag} ${apps_flag} ${sysout_flag};
+do
+  if [ "${x}" = "true" ];
+  then
+    (( ctr++ ))
+  fi
+done
+if [ ${ctr} -gt 1 ];
+then
+  err_msg=(
+    "Error: only one sysout can be specified.  Two or more sysouts were specified"
+    "via the -l (--lisp), -f (--full), -a (--apps) flags and/or a sysout filename"
+  )
+  usage "${err_msg[@]}"
+fi
+if [ "${sysout_arg}" = "apps" ];
+then
+  export LDESRCESYSOUT="$MEDLEYDIR/loadups/apps.sysout"
+  if [ "${greet_specified}" = "false" ];
+  then
+    export LDEINIT="$MEDLEYDIR/greetfiles/APPS-INIT.LCOM"
+  fi
+else
+  # pass on to run-medley
+  export LDESRCESYSOUT=""
+  run_args+=("${sysout_arg}")
+fi
+
+

scripts/medley/medley_geometry.sh

@@ -0,0 +1,79 @@
+###############################################################################
+#
+#    medley_geometry.sh - script for computing the geometry and screensize
+#                         parameters for a medley session
+#
+#   !!!! This script is meant to be SOURCEd from the scripts/medley.sh script.
+#   !!!! It should not be run as a standlone script.
+#
+#   2023-01-17 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+if [ ${noscroll} = false ];
+then
+  scroll=22
+else
+  scroll=0
+fi
+if [[ -n ${geometry} && -n ${screensize} ]];
+then
+  gw=$(expr "${geometry}" : "\([0-9]*\)x[0-9]*$")
+  gh=$(expr "${geometry}" : "[0-9]*x\([0-9]*\)$")
+  if [[ -z "${gw}" || -z "${gh}" ]];
+  then
+    echo "Error: Improperly formed -geometry or -dimension argument: ${geometry}"
+    echo "Exiting"
+    exit 7
+  fi
+  geometry="-g ${geometry}"
+  #
+  sw=$(expr "${screensize}" : "\([0-9]*\)x[0-9]*$")
+  sh=$(expr "${screensize}" : "[0-9]*x\([0-9]*\)$")
+  if [[ -z "${sw}" || -z "${sh}" ]];
+  then
+    echo "Error: Improperly formed -screensize argument: ${screensize}"
+    echo "Exiting"
+    exit 7
+  fi
+  screensize="-sc ${screensize}"
+elif [[ -n ${geometry} ]];
+then
+  gw=$(expr "${geometry}" : "\([0-9]*\)x[0-9]*$")
+  gh=$(expr "${geometry}" : "[0-9]*x\([0-9]*\)$")
+  if [ -n "${gw}" -a -n "${gh}" ] ; then
+    sw=$(( ((31+${gw})/32*32) - ${scroll} ))
+    sh=$(( ${gh} - ${scroll} ))
+    geometry="-g ${gw}x${gh}"
+    screensize="-sc ${sw}x${sh}"
+  else
+    echo "Error: Improperly formed -geometry or -dimension argument: ${geometry}"
+    echo "Exiting"
+    exit 7
+  fi
+elif [[ -n ${screensize} ]];
+then
+  sw=$(expr "${screensize}" : "\([0-9]*\)x[0-9]*$")
+  sh=$(expr "${screensize}" : "[0-9]*x\([0-9]*\)$")
+  if [ -n "${sw}" -a -n "${sh}" ] ; then
+    sw=$(( (31+$sw)/32*32 ))
+    gw=$(( ${scroll}+${sw} ))
+    gh=$(( ${scroll}+${sh} ))
+    geometry="-g ${gw}x${gh}"
+    screensize="-sc ${sw}x${sh}"
+  else
+    echo "Error: Improperly formed -screensize argument: ${screensize}"
+    echo "Exiting"
+    exit 7
+  fi
+else
+  screensize="-sc 1440x900"
+  if [ ${noscroll} = false ];
+  then
+    geometry="-g 1462x922"
+  else
+    geometry="-g 1440x900"
+  fi
+fi

scripts/medley/medley_usage.sh

@@ -0,0 +1,93 @@
+###############################################################################
+#
+#    medley_useage.sh - script defining the "usage" for medley.sh script.
+#
+#   !!!! This script is meant to be SOURCEd from the scripts/medley.sh script.
+#   !!!! It should not be run as a standlone script.
+#
+#   2023-01-21 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+PAGER=$( if [ -n $(which more) ]; then echo "more"; else echo "cat"; fi)
+
+usage() {
+   local err_msg
+   local msg_path=/tmp/msg-$$
+   local lines=("$@")
+   if [ $# -ne 0 ];
+   then
+     echo > ${msg_path}
+     echo "$(output_error_msg "${lines[@]}")" >> ${msg_path}
+     echo >> ${msg_path}
+     echo >> ${msg_path}
+   else
+     touch ${msg_path}
+   fi
+   cat ${msg_path} - <<EOF | ${PAGER}
+Usage: medley [flags] [sysout] [--] [pass_args ...]
+
+Note: MEDLEYDIR is the directory at the top of the code tree where this script is executed from
+      after all symbolic links have been resolved.  For standard installations this will be
+      /usr/local/interlisp/medley.  For "local" installations this will be the "medley" sub-directory
+      under the directory into which the Medley distribution was installed.
+
+flags:
+    -h | --help                : print this usage information
+
+    -z | --man                 : show the man page for medley
+
+    -f | --full                : start Medley from the "full" sysout
+
+    -l | --lisp                : start Medley from the "lisp" sysout
+
+    -a | --apps                : start Medley  from the "apps" sysout
+
+    -e | --interlisp           : (for apps.sysout only) Start in the Interlisp exec
+
+    -n | --noscroll            : do not use scroll bars in Medley window
+
+    -g WxH | --geometry WxH    : set the window geometry to Width x Height.
+
+    -s WxH | --screensize WxH  : set the Medley screen size to be Width x Height
+
+    -t STRING | --title STRING : use STRING as title of window
+
+    -d :N | --display :N       : use X display :N
+
+    -v | --vnc                 : (WSL only) Use a VNC window instead of an X window
+
+    -i STRING | --id STRING    : use STRING as the id for this run of Medley (default: default)
+
+    -i - | --id -              : for id use the basename of MEDLEYDIR
+
+    -i -- | --id --            : for id use the basename of the parent directory of MEDLEYDIR
+
+    -m N | --mem N             : set Medley memory size to N
+
+    -p FILE | --vmem FILE      : use FILE as the Medley virtual memory store
+
+    -r FILE | --greet FILE     : use FILE as the Medley greetfile
+
+    -r - | --greet -           : do not use a greetfile
+
+    -x DIR | --logindir DIR    : use DIR as LOGINDIR in Medley
+
+    -x - | --logindir -        : use MEDLEYDIR/logindir as LOGINDIR in Medley
+
+sysout:
+    The name of the file to use as a sysout for Medley to start from.  If sysout is not
+    provided and none of the flags [-a, -f & -l] is used, then Medley will start from
+    the saved virtual memory file for the id for this run.
+
+pass_args:
+    All arguments after the "--" flag, are passed unaltered to lde via run-medley.
+
+EOF
+
+exit 1
+
+}
+

scripts/medley/medley_utils.sh

@@ -0,0 +1,133 @@
+###############################################################################
+#
+#    medley_utils.sh - script containing various useful functions for medley.sh script.
+#
+#   !!!! This script is meant to be SOURCEd from the scripts/medley.sh script.
+#   !!!! It should not be run as a standlone script.
+#
+#   2023-01-23 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+is_tput=$(which tput)
+output_error_msg() {
+  local lines=("$@")
+  for line in "${lines[@]}"
+  do
+    if [ -n "${is_tput}" ];
+    then
+      echo "$(${is_tput} setab 1)$(${is_tput} setaf 7)${line}$(${is_tput} sgr0)"
+    else
+      echo "${line}"
+    fi
+  done
+}
+
+check_for_dash_or_end() {
+  local err_msg;
+  if [[ -z "$2" || "$2" = "--" ]];
+  then
+    err_msg=(
+      "Error: the flag \"$1\" requires a value."
+      "Value is missing."
+    )
+    usage "${err_msg[@]}"
+  elif [ "${2:0:1}" = "-" ];
+  then
+     err_msg=(
+       "Error: either the value for flag \"${1}\" is missing OR"
+       "the value begins with a \"-\", which is not allowed."
+     )
+     usage "${err_msg[@]}"
+  fi
+}
+
+check_file_writeable_or_creatable() {
+  local msg_core="\"$2\" given as the value of the \"$1\" flag"
+  local err_msg;
+  if [[ -e "$%2" ]];
+  then
+    if [[ ! -f "$2" ]];
+    then
+      err_msg=(
+        "Error: File ${msg_core} is not a regular file."
+        "It is either a directory or a device file of some sort."
+        "Exiting"
+      )
+      output_error_msg "${err_msg[@]}"
+      exit 1
+    elif [[ ! -w "$2" ]];
+    then
+      err_msg=(
+        "Error: File ${msg_core} exists but is not writeable"
+        "Exiting"
+      )
+      output_error_msg "${err_msg[@]}"
+      exit 1
+    fi
+  else
+    if [[ ! -w "$(dirname -- $2)" ]];
+    then
+      err_msg=(
+        "Error: File ${msg_core} cannot be created because"
+        "its directory either doen't exist or is not writeable."
+        "Exiting"
+      )
+      output_error_msg "${err_msg[@]}"
+      exit 1
+    fi
+  fi
+}
+
+check_file_readable() {
+  local msg_core="\"$2\" given as the value of the \"$1\" flag"
+  if [[ ! -r "$2" ]];
+  then
+    err_msg=(
+      "Error: File ${msg_core}"
+      "either doesn't exist or is not readable."
+      "Exiting"
+    )
+    output_error_msg "${err_msg[@]}"
+    exit 1
+  fi
+}
+
+check_dir_writeable_or_creatable() {
+  local msg_core="\"$2\" given as the value of the \"$1\" flag"
+  if [[ -e "$%2" ]];
+  then
+    if [[ ! -d "$2" ]];
+    then
+      err_msg=(
+        "Error: Pathname ${msg_core} exists but is not a directory."
+        "Exiting"
+      )
+      output_error_msg "${err_msg[@]}"
+      exit 1
+    elif [[ ! -w "$2" ]];
+    then
+      err_msg=(
+        "Error: Directory ${msg_core} exists but is not writeable."
+        "Exiting"
+      )
+      output_error_msg "${err_msg[@]}"
+      exit 1
+    fi
+  else
+    if [[ ! -w "$(dirname -- $2)" ]];
+    then
+      err_msg=(
+        "Error: Directory ${msg_core} cannot be created because"
+        "its parent directory either doesn't exist or is not writeable."
+        "Exiting"
+      )
+      output_error_msg "${err_msg[@]}"
+      exit 1
+    fi
+  fi
+}
+
+

scripts/medley/medley_vnc.sh

@@ -0,0 +1,154 @@
+###############################################################################
+#
+#    medley_vnc.sh - script for running Medley Interlisp on WSL using Xvnc
+#                on the Linux side and a vncviewer on the Windows side.
+#                This script run under Linux will start the right apps
+#                on both the Linux and Windows sides.
+#
+#   !!!! This script is meant to be SOURCEd from the scripts/medley.sh script.
+#   !!!! It should not be run as a standlone script.
+#
+#   2023-01-12 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+  ip_addr() {
+    ip -4 -br address show dev eth0 | awk '{print $3}' | sed 's-/.*$--'
+  }
+
+  find_open_display() {
+    local ctr=1
+    local result=-1
+    while [ ${ctr} -lt 64 ];
+    do
+      ss -a | grep -q "tmp/.X11-unix/X${ctr}[^0-9]"
+      if [ $? -ne 0 ];
+      then
+        result=${ctr}
+        break
+      else
+        (( ctr++ ))
+      fi
+    done
+    echo ${result}
+  }
+
+  find_open_port() {
+    local ctr=5900
+    local result=-1
+    while [ ${ctr} -lt 6000 ];
+    do
+      ss -a | grep -q "LISTEN.*:${ctr}[^0-9]"
+      if [ $? -ne 0 ];
+      then
+        result=${ctr}
+        break
+      else
+        (( ctr++ ))
+      fi
+    done
+    echo ${result}
+  }
+
+  #
+  # Make sure prequisites for vnc support are in place
+  #
+  win_userprofile="$(cmd.exe /c "<nul set /p=%UserProfile%" 2>/dev/null)"
+  vnc_dir="$(wslpath ${win_userprofile})/AppData/Local/Interlisp"
+  vnc_exe="vncviewer64-1.12.0.exe"
+  if [[ $(which Xvnc) = "" || $(Xvnc -version |& grep -iq tigervnc; echo $?) -eq 1 ]];
+  then
+    echo "Error: The -v or --vnc flag was set."
+    echo "But it appears that that TigerVNC \(Xvnc\) has not been installed."
+    echo "Please install TigerVNC using \"sudo apt install tigervnc-standalone-server tigervnc-xorg-extension\""
+    echo "Exiting."
+    exit 4
+  elif [ ! -e "${vnc_dir}/${vnc_exe}" ];
+  then
+    if [ -e "${IL_DIR}/wsl/${vnc_exe}" ];
+    then
+      # make sure TigerVNC viewer is in a Windows (not Linux) directory.  If its in a Linux directory
+      # there will be a long delay when it starts up
+      mkdir -p ${vnc_dir}
+      cp -p "${IL_DIR}/wsl/${vnc_exe}" "${vnc_dir}/${vnc_exe}"
+    else
+      echo "TigerVnc viewer is required by the -vnc option but is not installed."
+      echo -n "Ok to download from SourceForge? [y, Y, n or N, default n]  "
+      read resp
+      if [ -z ${resp} ]; then resp=n; else resp=${resp:0:1}; fi
+      if [[ ${resp} = 'n' || ${resp} = 'N' ]];
+      then
+        echo "Ok.  You can download the Tiger VNC viewer \(v1.12.0\) .exe yourself and "
+        echo "place it in ${vnc_dir}/${vnc_exe}.  Then retry."
+        echo "Exiting."
+        exit 5
+      else
+        pushd "${vnc_dir}" >/dev/null
+        wget https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
+        popd >/dev/null
+      fi
+    fi
+  fi
+
+  #
+  #  Find an unused display, start Xvnc, run-medley, then start the vnc viewer on the windows side
+  #
+  #set -x
+  LOG=${LOGINDIR}/logs/medley_${run_id}.log
+  mkdir -p $(dirname -- ${LOG})
+  echo "START" >${LOG}
+  OPEN_DISPLAY=`find_open_display`
+  if [ ${OPEN_DISPLAY} -eq -1 ];
+  then
+    echo "Error: cannot find an unused DISPLAY between 1 and 63"
+    echo "Exiting"
+    exit 33
+  else
+    echo "Using DISPLAY=${OPEN_DISPLAY}"
+  fi
+  VNC_PORT=`find_open_port`
+  if [ ${VNC_PORT} -eq -1 ];
+  then
+    echo "Error: cannot find an unused port between 5900 and 5999"
+    echo "Exiting"
+    exit 33
+  else
+    echo "Using VNC_PORT=${VNC_PORT}"
+  fi
+  export DISPLAY=":${OPEN_DISPLAY}"
+  # start vnc
+  mkdir -p ${LOGINDIR}/logs
+  /usr/bin/Xvnc ":${OPEN_DISPLAY}" \
+                -rfbport ${VNC_PORT} \
+                -geometry "${geometry#-g }" \
+                -SecurityTypes None \
+                -NeverShared \
+                -DisconnectClients=0 \
+                >> ${LOG} 2>&1 &
+  xvnc_pid=""
+  while [ -z ${xvnc_pid} ];
+  do
+    sleep .25
+    xvnc_pid=$(ps h -C Xvnc -o pid,command | grep "Xvnc :${OPEN_DISPLAY}" | awk '{print $1}')
+  done
+  echo "XVNC_PID is ${xvnc_pid}"
+  # run Medley
+  ( ${MEDLEYDIR}/run-medley -id "${run_id}" ${geometry} ${screensize} "${run_args[@]}" 2>>${LOG} \
+    ; \
+    kill -9 ${xvnc_pid} ${xvnc_pid} >>${LOG} 2>&1
+  ) &
+  # Give medley time to startup
+  sleep 2
+  # Start vnc viewer on Windows side
+  pushd ${vnc_dir} >/dev/null
+  ( ./${vnc_exe} -geometry "+50+50" \
+                -ReconnectOnError=off \
+                −AlertOnFatalError=off \
+                $(ip_addr):${VNC_PORT} \
+                >>${LOG} 2>&1 \
+    ; \
+    kill -9 ${xvnc_pid} >>${LOG} 2>&1 \
+  ) &
+  popd >/dev/null

sources/ADIR

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-May-2022 12:02:10" {DSK}<users>kaplan>local>medley3.5>working-medley>sources>ADIR.;14
 65884  
+
(FILECREATED "31-Oct-2022 23:50:03" {WMEDLEY}<sources>ADIR.;19
 66146  
 
-      :CHANGES-TO (FNS UNPACKFILENAME.STRING)
-                  (VARS ADIRCOMS)
+      :CHANGES-TO (FNS \COPYSYS)
 
-      :PREVIOUS-DATE "26-Mar-2022 09:39:50" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>ADIR.;13)
+      :PREVIOUS-DATE "31-Oct-2022 14:16:39" {WMEDLEY}<sources>ADIR.;18)
 
 
 (* ; "
@@ -20,7 +18,10 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
               (FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP 
                    RENAMEFILE SIMPLE.FINDFILE VMEMSIZE \COPYSYS \FLUSHVM \LOGOUT0)
               (CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
-              (P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T))
+              (P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T)
+                 (MOVD? 'EVQ 'TRUEFILENAME)
+                 (MOVD? 'EVQ 'PSEUDOFILENAME)
+                 (MOVD? 'NILL 'PSEUDOHOSTP))
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P 
 
                                        (* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")

@@ -197,26 +198,28 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
     (fetch
 (IFPAGE NActivePages) of
 \InterfacePage])
 
 (\COPYSYS

-  [LAMBDA (FILE SYSNAME DONTSAVE)
                      (* ; "Edited 16-Mar-2021 19:46 by larry")

-    (PROG (FULLNAME
 VAL HOST)
+  [LAMBDA (FILE SYSNAME DONTSAVE)
                            (* ; "Edited 31-Oct-2022 23:49 by rmk")


+                                                           (* ; "Edited 16-Mar-2021 19:46 by larry")

+    (PROG (FULLNAME
 VAL TFILE THOST)
       RETRY
-          (SETQ FILE (PACKFILENAME.STRING
 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY 
-                            \CONNECTED.DIRECTORY))
-          [SELECTQ [SETQ HOST (U-CASE (FILENAMEFIELD
 FILE 'HOST]
-              (DSK [SETQ FULLNAME (PACKFILENAME.STRING
 'HOST HOST 'EXTENSION "tmpsysout"
+          (SETQ FILE (PACKFILENAME.STRING
 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY \CONNECTED.DIRECTORY))
+          (SETQ TFILE (TRUEFILENAME FILE))
+          [SELECTQ [SETQ THOST (U-CASE (FILENAMEFIELD
 TFILE 'HOST]
+              (DSK [SETQ FULLNAME (PACKFILENAME.STRING
 'HOST THOST 'NAME 'tmp 'EXTENSION 'SYSOUT
                                          'BODY
-                                         (\UFS.RECOGNIZE.FILE FILE 'NON (\GETDEVICEFROMNAME HOST]
-                   (SETQ VAL (\FLUSHVM FULLNAME))
+                                         (\UFS.RECOGNIZE.FILE TFILE 'NON (\GETDEVICEFROMNAME THOST]
+                   (SETQ VAL (\FLUSHVM
 FULLNAME))
                    (SETQ FULLNAME (RENAMEFILE
 FULLNAME FILE)))
-              (UNIX [SETQ FULLNAME (CONCAT "{" HOST "}" (\UFS.RECOGNIZE.FILE FILE 'NON (
+              (UNIX [SETQ FULLNAME (CONCAT "{" THOST "}" (\UFS.RECOGNIZE.FILE TFILE 'NON (
                                                                                    \GETDEVICEFROMNAME
-                                                                                        HOST]
+                                                                                          THOST]
                                                              (* ; "\DOFLUSHVM ")

-                    (SETQ VAL (\FLUSHVM FULLNAME)))
-              (PROGN (SETQ VAL (\FLUSHVM))
+                    (SETQ VAL (\FLUSHVM
 FULLNAME))
+                    (SETQ FULLNAME (RENAMEFILE
 FULLNAME FILE)))
+              (PROGN (SETQ VAL (\FLUSHVM
))
                      (LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT")))
                                                              (* ; 
-
                                  "\FLSUVM saves image to  Unix enviroment var  or lisp.virtualmem")

+
                                    "\FLSUVM saves image to  Unix enviroment var  or lisp.virtualmem")

                           (SETQ FULLNAME (COPYFILE (COND
                                                       (UNIXVAR (CONCAT "{DSK}" UNIXVAR))
                                                       (T "{DSK}~/lisp.virtualmem"))
@@ -231,13 +234,12 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
               (RETURN FULLNAME))
              ((AND (SMALLP VAL)
                    (IGREATERP 0 VAL))                        (* ; 
-
                                                           "Error occurred while making sysout.")

+
                                                             "Error occurred while making sysout.")

               (LISPERROR (IMINUS VAL)
                      FULLNAME)
               (GO RETRY))
              (T                                              (* ; "Starting sysout")

-                (\CLEARSYSBUF T)                             (* ; 
-
                                                           "Get rid of any spurious typeahead")

+                (\CLEARSYSBUF T)                             (* ; "Get rid of any spurious typeahead")

                 (\RESETKEYBOARD)                             (* ; "Enable keyhandler")

                 (RETURN (LIST FULLNAME])
 
@@ -280,6 +282,12 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 )
 
 (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T)
+
+(MOVD? 'EVQ 'TRUEFILENAME)
+
+(MOVD? 'EVQ 'PSEUDOFILENAME)
+
+(MOVD? 'NILL 'PSEUDOHOSTP)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 
@@ -1226,14 +1234,14 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 (PUTPROPS ADIR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
 1991 1992 1920 2017 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3179 14304 (DELFILE 3189 . 3350) (FULLNAME 3352 . 3719) (INFILE 3721 . 3869) (INFILEP 
-3871 . 4006) (IOFILE 4008 . 4148) (OPENFILE 4150 . 4550) (OPENSTREAM 4552 . 8892) (OUTFILE 8894 . 9045
-) (OUTFILEP 9047 . 9183) (RENAMEFILE 9185 . 9491) (SIMPLE.FINDFILE 9493 . 9903) (VMEMSIZE 9905 . 10072
-) (\COPYSYS 10074 . 13023) (\FLUSHVM 13025 . 14097) (\LOGOUT0 14099 . 14302)) (14676 36581 (
-UNPACKFILENAME.STRING 14686 . 33960) (\UPF.DIRECTORY 33962 . 36579)) (38109 40781 (UNPACKFILENAME 
-38119 . 38305) (LASTCHPOS 38307 . 39001) (FILENAMEFIELD 39003 . 39488) (FILENAMEFIELD.STRING 39490 . 
-40069) (PACKFILENAME 40071 . 40414) (PACKFILENAME.STRING 40416 . 40779)) (55251 56164 (
-FILEDIRCASEARRAY 55261 . 56162)) (56331 63511 (LOGOUT 56341 . 57258) (MAKESYS 57260 . 58889) (SYSOUT 
-58891 . 60443) (SAVEVM 60445 . 61245) (HERALD 61247 . 61407) (INTERPRET.REM.CM 61409 . 63134) (
-\USEREVENT 63136 . 63509)) (63693 65420 (USERNAME 63703 . 64659) (SETUSERNAME 64661 . 65418)))))
+  (FILEMAP (NIL (3185 14480 (DELFILE 3195 . 3356) (FULLNAME 3358 . 3725) (INFILE 3727 . 3875) (INFILEP 
+3877 . 4012) (IOFILE 4014 . 4154) (OPENFILE 4156 . 4556) (OPENSTREAM 4558 . 8898) (OUTFILE 8900 . 9051
+) (OUTFILEP 9053 . 9189) (RENAMEFILE 9191 . 9497) (SIMPLE.FINDFILE 9499 . 9909) (VMEMSIZE 9911 . 10078
+) (\COPYSYS 10080 . 13199) (\FLUSHVM 13201 . 14273) (\LOGOUT0 14275 . 14478)) (14938 36843 (
+UNPACKFILENAME.STRING 14948 . 34222) (\UPF.DIRECTORY 34224 . 36841)) (38371 41043 (UNPACKFILENAME 
+38381 . 38567) (LASTCHPOS 38569 . 39263) (FILENAMEFIELD 39265 . 39750) (FILENAMEFIELD.STRING 39752 . 
+40331) (PACKFILENAME 40333 . 40676) (PACKFILENAME.STRING 40678 . 41041)) (55513 56426 (
+FILEDIRCASEARRAY 55523 . 56424)) (56593 63773 (LOGOUT 56603 . 57520) (MAKESYS 57522 . 59151) (SYSOUT 
+59153 . 60705) (SAVEVM 60707 . 61507) (HERALD 61509 . 61669) (INTERPRET.REM.CM 61671 . 63396) (
+\USEREVENT 63398 . 63771)) (63955 65682 (USERNAME 63965 . 64921) (SETUSERNAME 64923 . 65680)))))
 STOP

sources/CMLUNDO

@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
 
-
(IL:FILECREATED "18-Oct-2022 16:24:32" IL:|{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;2|
 31891  
+
(IL:FILECREATED " 7-Nov-2022 09:54:34" IL:|{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;2|
 31437  
 
       :CHANGES-TO (IL:FUNCTIONS UNDOABLY)
 
-      :PREVIOUS-DATE "15-Oct-2022 17:21:17" IL:|{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;1|)
+      :PREVIOUS-DATE "18-Oct-2022 16:24:32" IL:|{DSK}<home>larry>ilisp>medley>sources>CMLUNDO.;1|)
 
 
 ; Copyright (c) 1986-1988, 1990, 2022 by Venue & Xerox Corporation.
@@ -69,75 +69,71 @@
 (DEFUN NOHOOK
 (FN ARGS &OPTIONAL ENV &AUX (*EVALHOOK* NIL))
    (APPLY FN ARGS))
 
-(DEFMACRO UNDOABLY
 (&REST FORMS &ENVIRONMENT ENV)
     (IL:* IL:\; "Edited 18-Oct-2022 16:20 by lmm")


-                                                      (IL:* IL:\; "Edited 15-Oct-2022 11:47 by lmm")

-   (IF (NULL IL:LISPXHIST)
-       (IL:MKPROGN FORMS)
-       (WALK-FORM
-        (IL:MKPROGN FORMS)
-        :ENVIRONMENT ENV :WALK-FUNCTION
-        #'(LAMBDA
-           (X CONTEXT)
-           (COND
-              ((NOT (CONSP X))
-               X)
-              ((NOT (SYMBOLP (CAR X)))
-               X)
-              (T
-               (CASE (CAR X)
-                   ((SETQ IL:SETQ SETF) 
-                      (VALUES
-                       (IL:MKPROGN
-                        (WITH-COLLECTION
-                         (DO ((TAIL (CDR X)
-                                    (CDDR TAIL)))
-                             ((NULL TAIL))
-                           (COLLECT
-                            (IF (SYMBOLP (CAR TAIL))
-                                (IF (VARIABLE-LEXICAL-P (CAR TAIL))
-                                    `(,(CAR X)
-                                      ,(CAR TAIL)
-                                      ,(WALK-FORM-INTERNAL (CADR TAIL)))
-                                    (PROGN (COND
-                                              ((NOT (OR (VARIABLE-SPECIAL-P (CAR TAIL))
-                                                        (BOUNDP (CAR TAIL))))
+(DEFMACRO UNDOABLY
 (&REST FORMS &ENVIRONMENT ENV)
     (IL:* IL:\; "Edited  7-Nov-2022 09:52 by lmm")

+   (WALK-FORM
+    (IL:MKPROGN FORMS)
+    :ENVIRONMENT ENV :WALK-FUNCTION
+    #'(LAMBDA
+       (X CONTEXT)
+       (COND
+          ((NOT (CONSP X))
+           X)
+          ((NOT (SYMBOLP (CAR X)))
+           X)
+          (T
+           (CASE (CAR X)
+               ((SETQ IL:SETQ SETF) 
+                  (VALUES
+                   (IL:MKPROGN
+                    (WITH-COLLECTION
+                     (DO ((TAIL (CDR X)
+                                (CDDR TAIL)))
+                         ((NULL TAIL))
+                       (COLLECT
+                        (IF (SYMBOLP (CAR TAIL))
+                            (IF (VARIABLE-LEXICAL-P (CAR TAIL))
+                                `(,(CAR X)
+                                  ,(CAR TAIL)
+                                  ,(WALK-FORM-INTERNAL (CADR TAIL)))
+                                (PROGN (COND
+                                          ((NOT (OR (VARIABLE-SPECIAL-P (CAR TAIL))
+                                                    (BOUNDP (CAR TAIL))))
 
-                                               (IL:* IL:|;;| "should possibly spelling correct? ")

+                                           (IL:* IL:|;;| "should possibly spelling correct? ")

 
-                                               (WHEN NIL
+                                           (WHEN NIL
 
-                                                (IL:* IL:|;;| "this warning just seems uselsss; it doesn't proclaim anything or mark it as changed in FILEPKG or ...")

+                                               (IL:* IL:|;;| "this warning just seems uselsss; it doesn't proclaim anything or mark it as changed in FILEPKG or ...")

 
-                                                   (WARN 
-                                                     "Variable ~S proclaimed SPECIAL UNDOABLY.. SETQ"
-                                                         (CAR TAIL)))))
-                                           `(UNDOABLY-SET-SYMBOL
 ',(CAR TAIL)
-                                                   ,(WALK-FORM-INTERNAL (CADR TAIL)))))
-                                (MULTIPLE-VALUE-BIND
-                                 (FORMALS ACTUALS NEW-VALUE SETTER GETTER)
-                                 (GET-UNDOABLE-SETF-METHOD
 (CAR TAIL))
-                                 `(,'LET* (,@(MAPCAR #'(LAMBDA (X Y)
-                                                              (LIST X (WALK-FORM-INTERNAL Y)))
-                                                    FORMALS ACTUALS)
-                                           (,(WALK-FORM-INTERNAL (CAR NEW-VALUE))
-                                            ,(CADR TAIL)))
-                                         ,SETTER)))))))
-                       T))
-                   (STOP-UNDOABLY (VALUES (IL:MKPROGN (CDR X))
-                                         T))
-                   (T (LET ((UNDONAME (CDR (ASSOC (CAR X)
-                                                  IL:LISPXFNS :TEST #'EQ))))
-                           (IF UNDONAME
-                               (CONS UNDONAME (CDR X))
-                               (IF (AND (OR (GET (CAR X)
-                                                 ':DEFINER-FOR)
-                                            (GET (CAR X)
-                                                 'IL:DEFINER-FOR))
-                                        (NOT *IN-DEFINER*))
-                                   (LET ((*IN-DEFINER* T))
-                                        (VALUES (WALK-FORM-INTERNAL (MACROEXPAND-1 X))
-                                               T))
-                                   X)))))))))))
+                                               (WARN "Variable ~S proclaimed SPECIAL UNDOABLY.. SETQ"
+                                                     (CAR TAIL)))))
+                                       `(UNDOABLY-SET-SYMBOL
 ',(CAR TAIL)
+                                               ,(WALK-FORM-INTERNAL (CADR TAIL)))))
+                            (MULTIPLE-VALUE-BIND
+                             (FORMALS ACTUALS NEW-VALUE SETTER GETTER)
+                             (GET-UNDOABLE-SETF-METHOD
 (CAR TAIL))
+                             `(,'LET* (,@(MAPCAR #'(LAMBDA (X Y)
+                                                          (LIST X (WALK-FORM-INTERNAL Y)))
+                                                FORMALS ACTUALS)
+                                       (,(WALK-FORM-INTERNAL (CAR NEW-VALUE))
+                                        ,(CADR TAIL)))
+                                     ,SETTER)))))))
+                   T))
+               (STOP-UNDOABLY (VALUES (IL:MKPROGN (CDR X))
+                                     T))
+               (T (LET ((UNDONAME (CDR (ASSOC (CAR X)
+                                              IL:LISPXFNS :TEST #'EQ))))
+                       (IF UNDONAME
+                           (CONS UNDONAME (CDR X))
+                           (IF (AND (OR (GET (CAR X)
+                                             ':DEFINER-FOR)
+                                        (GET (CAR X)
+                                             'IL:DEFINER-FOR))
+                                    (NOT *IN-DEFINER*))
+                               (LET ((*IN-DEFINER* T))
+                                    (VALUES (WALK-FORM-INTERNAL (MACROEXPAND-1 X))
+                                           T))
+                               X))))))))))
 
 (DEFUN UNDOABLY-FMAKUNBOUND
 (SYMBOL)
    (IL:/PUTD SYMBOL NIL)
@@ -692,14 +688,14 @@
 )
 (IL:PUTPROPS IL:CMLUNDO IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 2022))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (4227 4310 (NOHOOK 4227 . 4310)) (4312 7992 (UNDOABLY 4312 . 7992)) (7994 8214 (
-UNDOABLY-FMAKUNBOUND 7994 . 8214)) (8216 8792 (UNDOABLY-MAKUNBOUND 8216 . 8792)) (8794 9521 (
-UNDOABLY-SETF 8794 . 9521)) (9523 11417 (UNDOHOOK 9523 . 11417)) (11419 11766 (UNDOABLY-PSETF 11419 . 
-11766)) (11768 12368 (UNDOABLY-POP 11768 . 12368)) (12370 12930 (UNDOABLY-PUSH 12370 . 12930)) (12932 
-13391 (UNDOABLY-PUSHNEW 12932 . 13391)) (13393 14759 (UNDOABLY-REMF 13393 . 14759)) (14761 15907 (
-UNDOABLY-ROTATEF 14761 . 15907)) (15909 17049 (UNDOABLY-SHIFTF 15909 . 17049)) (18845 20667 (
-UNDOABLY-PROCLAIM 18845 . 20667)) (20669 20740 (MAKE-UNDOABLE 20669 . 20740)) (20742 20888 (
-STOP-UNDOABLY 20742 . 20888)) (20890 22570 (UNDOABLY-SETF-SYMBOL-FUNCTION 20890 . 22570)) (22572 23161
- (UNDOABLY-SETF-MACRO-FUNCTION 22572 . 23161)) (24059 27459 (GET-UNDOABLE-SETF-METHOD 24059 . 27459)) 
-(27461 30185 (UNDOABLY-SET-SYMBOL 27461 . 30185)) (30186 30514 (UNDOABLY-SETQ 30199 . 30512)))))
+  (IL:FILEMAP (NIL (4227 4310 (NOHOOK 4227 . 4310)) (4312 7538 (UNDOABLY 4312 . 7538)) (7540 7760 (
+UNDOABLY-FMAKUNBOUND 7540 . 7760)) (7762 8338 (UNDOABLY-MAKUNBOUND 7762 . 8338)) (8340 9067 (
+UNDOABLY-SETF 8340 . 9067)) (9069 10963 (UNDOHOOK 9069 . 10963)) (10965 11312 (UNDOABLY-PSETF 10965 . 
+11312)) (11314 11914 (UNDOABLY-POP 11314 . 11914)) (11916 12476 (UNDOABLY-PUSH 11916 . 12476)) (12478 
+12937 (UNDOABLY-PUSHNEW 12478 . 12937)) (12939 14305 (UNDOABLY-REMF 12939 . 14305)) (14307 15453 (
+UNDOABLY-ROTATEF 14307 . 15453)) (15455 16595 (UNDOABLY-SHIFTF 15455 . 16595)) (18391 20213 (
+UNDOABLY-PROCLAIM 18391 . 20213)) (20215 20286 (MAKE-UNDOABLE 20215 . 20286)) (20288 20434 (
+STOP-UNDOABLY 20288 . 20434)) (20436 22116 (UNDOABLY-SETF-SYMBOL-FUNCTION 20436 . 22116)) (22118 22707
+ (UNDOABLY-SETF-MACRO-FUNCTION 22118 . 22707)) (23605 27005 (GET-UNDOABLE-SETF-METHOD 23605 . 27005)) 
+(27007 29731 (UNDOABLY-SET-SYMBOL 27007 . 29731)) (29732 30060 (UNDOABLY-SETQ 29745 . 30058)))))
 IL:STOP

sources/FILEPKG

@@ -1,8 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "22-Sep-2022 08:46:29" {DSK}<home>larry>medley>sources>FILEPKG.;2
 274247 
+
(FILECREATED "31-Oct-2022 16:05:09" {WMEDLEY}<sources>FILEPKG.;47
 274788 
 
-      :PREVIOUS-DATE "21-Sep-2022 20:51:03" {DSK}<home>larry>medley>sources>FILEPKG.;1)
+      :CHANGES-TO (FNS EDITCALLERS)
+
+      :PREVIOUS-DATE "22-Sep-2022 08:46:29" {WMEDLEY}<sources>FILEPKG.;45)
 
 
 (* ; "
@@ -3036,14 +3038,14 @@ compiling " T)
 
 
 (ADDTOVAR USERMACROS

-          (M NIL (MAKE FILE FILE))
           (M (X . Y)
              (E (MARKASCHANGED (COND ((LISTP 'X)
                                       (CAR 'X))
                                      (T 'X))
                        'USERMACROS)
                 T)
-             (ORIGINAL (M X . Y))))
+             (ORIGINAL (M X . Y)))
+          (M NIL (MAKE FILE FILE)))
 
 (ADDTOVAR EDITMACROS

           (M (X . Y)
@@ -4311,6 +4313,8 @@ compiling " T)
 (EDITCALLERS

   [LAMBDA (ATOMS FILES COMS)
 
+    (* ;; "Edited 31-Oct-2022 16:04 by rmk")

+
     (* ;; "Edited 24-Jul-2022 15:45 by rmk")

 
     (* ;; "Edited 21-Jul-2022 21:51 by rmk")

@@ -4423,9 +4427,14 @@ compiling " T)
 
                             [NLSETQ (SETQ MAP (LOADFNS NIL FILESTREAM NIL 'FILEMAP]
 
-                            (* ;; "LOADFNS may implicitly close the file, so reopen for next hit")

+                            (* ;; "LOADFNS may implicitly close the file, so reopen for next hit.  Depending on the file device, we may not get the exact same stream, so make sure we close this one too.")

 
-                            [OPENSTREAM FILESTREAM 'INPUT 'OLD `((EXTERNALFORMAT ,ENV]
+                            [RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
+                                                 (SETQ FILESTREAM (OPENSTREAM
+                                                                   FILESTREAM
+                                                                   'INPUT
+                                                                   'OLD
+                                                                   `((EXTERNALFORMAT ,ENV]
                             (CL:UNLESS MAP                   (* ; 
 
                                                             "Set to T so only try and print once")

                                 (LISPXPRIN1 " no filemap!" T)
@@ -4857,46 +4866,46 @@ compiling " T)
 (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 
 1991 1992 1993 1995 2018 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (18942 20615 (SEARCHPRETTYTYPELST 18952 . 19921) (PRETTYDEFMACROS 19923 . 20359) (
-FILEPKGCOMPROPS 20361 . 20613)) (21428 55720 (CLEANUP 21438 . 22828) (COMPILEFILES 22830 . 23106) (
-COMPILEFILES0 23108 . 23921) (CONTINUEDIT 23923 . 25300) (MAKEFILE 25302 . 37028) (FILECHANGES 37030
- . 39794) (FILEPKG.MERGECHANGES 39796 . 40431) (FILEPKG.CHANGEDFNS 40433 . 40745) (MAKEFILE1 40747 . 
-44959) (COMPILE-FILE? 44961 . 46548) (MAKEFILES 46550 . 48078) (ADDFILE 48080 . 50623) (ADDFILE0 50625
- . 54749) (LISTFILES 54751 . 55718)) (56392 89978 (FILEPKGCHANGES 56402 . 57581) (GETFILEPKGTYPE 57583
- . 60533) (MARKASCHANGED 60535 . 62166) (FILECOMS 62168 . 62552) (WHEREIS 62554 . 64083) (
-SMASHFILECOMS 64085 . 64313) (FILEFNSLST 64315 . 64481) (FILECOMSLST 64483 . 64969) (UPDATEFILES 64971
- . 69469) (INFILECOMS? 69471 . 71314) (INFILECOMTAIL 71316 . 72434) (INFILECOMS 72436 . 72597) (
-INFILECOM 72599 . 82617) (INFILECOMSVALS 82619 . 82926) (INFILECOMSVAL 82928 . 83936) (INFILECOMSPROP 
-83938 . 84731) (IFCPROPS 84733 . 85813) (IFCEXPRTYPE 85815 . 86431) (IFCPROPSCAN 86433 . 87394) (
-IFCDECLARE 87396 . 88655) (INFILEPAIRS 88657 . 88956) (INFILECOMSMACRO 88958 . 89976)) (90013 120699 (
-FILES? 90023 . 92134) (FILES?1 92136 . 92838) (FILES?PRINTLST 92840 . 93622) (ADDTOFILES? 93624 . 
-104167) (ADDTOFILE 104169 . 105085) (WHATIS 105087 . 107063) (ADDTOCOMS 107065 . 108603) (ADDTOCOM 
-108605 . 115092) (ADDTOCOM1 115094 . 116265) (ADDNEWCOM 116267 . 117317) (MAKENEWCOM 117319 . 119166) 
-(DEFAULTMAKENEWCOM 119168 . 120697)) (120769 123586 (MERGEINSERT 120779 . 123122) (MERGEINSERT1 123124
- . 123584)) (123740 125101 (ADDTOFILEKEYLST 123750 . 125099)) (125218 136019 (DELFROMFILES 125228 . 
-126058) (DELFROMCOMS 126060 . 127739) (DELFROMCOM 127741 . 133506) (DELFROMCOM1 133508 . 134307) (
-REMOVEITEM 134309 . 135185) (MOVETOFILE 135187 . 136017)) (136233 138604 (SAVEPUT 136243 . 138602)) (
-138729 146972 (UNMARKASCHANGED 138739 . 140223) (PREEDITFN 140225 . 142706) (POSTEDITPROPS 142708 . 
-145002) (POSTEDITALISTS 145004 . 146970)) (147117 166587 (ALISTS.GETDEF 147127 . 147506) (
-ALISTS.WHENCHANGED 147508 . 148154) (CLEARCLISPARRAY 148156 . 149334) (EXPRESSIONS.WHENCHANGED 149336
- . 149714) (MAKEALISTCOMS 149716 . 150731) (MAKEFILESCOMS 150733 . 152063) (MAKELISPXMACROSCOMS 152065
- . 154083) (MAKEPROPSCOMS 154085 . 154711) (MAKEUSERMACROSCOMS 154713 . 156530) (PROPS.WHENCHANGED 
-156532 . 157153) (FILEGETDEF.LISPXMACROS 157155 . 158454) (FILEGETDEF.ALISTS 158456 . 159047) (
-FILEGETDEF.RECORDS 159049 . 159976) (FILEGETDEF.PROPS 159978 . 160773) (FILEGETDEF.MACROS 160775 . 
-161657) (FILEGETDEF.VARS 161659 . 162262) (FILEGETDEF.FNS 162264 . 163504) (FILEPKGCOMS.PUTDEF 163506
- . 165448) (FILES.PUTDEF 165450 . 166318) (VARS.PUTDEF 166320 . 166463) (FILES.WHENCHANGED 166465 . 
-166585)) (168609 175840 (RENAME 168619 . 170064) (CHANGECALLERS 170066 . 175838)) (175841 223750 (
-SHOWDEF 175851 . 177048) (COPYDEF 177050 . 179798) (GETDEF 179800 . 182343) (GETDEFCOM 182345 . 183311
-) (GETDEFCOM0 183313 . 184506) (GETDEFCURRENT 184508 . 190820) (GETDEFERR 190822 . 192092) (
-GETDEFFROMFILE 192094 . 196323) (GETDEFSAVED 196325 . 197413) (PUTDEF 197415 . 198122) (EDITDEF 198124
- . 199107) (DEFAULT.EDITDEF 199109 . 201947) (EDITDEF.FILES 201949 . 202154) (LOADDEF 202156 . 202332)
- (DWIMDEF 202334 . 203188) (DELDEF 203190 . 206084) (DELFROMLIST 206086 . 206590) (HASDEF 206592 . 
-212829) (GETFILEDEF 212831 . 213343) (SAVEDEF 213345 . 215033) (UNSAVEDEF 215035 . 215931) (
-COMPAREDEFS 215933 . 219739) (COMPARE 219741 . 220445) (TYPESOF 220447 . 223748)) (223900 232148 (
-FILEPKGCOM 223910 . 228686) (FILEPKGTYPE 228688 . 232146)) (244181 260944 (FINDCALLERS 244191 . 244706
-) (EDITCALLERS 244708 . 254828) (EDITFROMFILE 254830 . 260259) (FINDATS 260261 . 260533) (LOOKIN 
-260535 . 260942)) (260945 262616 (SEPRCASE 260955 . 262614)) (263133 268589 (IMPORTFILE 263143 . 
-264113) (IMPORTEVAL 264115 . 265001) (IMPORTFILESCAN 265003 . 265416) (CHECKIMPORTS 265418 . 266674) (
-GATHEREXPORTS 266676 . 267997) (\DUMPEXPORTS 267999 . 268587)) (268927 270997 (CLEARFILEPKG 268937 . 
-270995)))))
+  (FILEMAP (NIL (18953 20626 (SEARCHPRETTYTYPELST 18963 . 19932) (PRETTYDEFMACROS 19934 . 20370) (
+FILEPKGCOMPROPS 20372 . 20624)) (21439 55731 (CLEANUP 21449 . 22839) (COMPILEFILES 22841 . 23117) (
+COMPILEFILES0 23119 . 23932) (CONTINUEDIT 23934 . 25311) (MAKEFILE 25313 . 37039) (FILECHANGES 37041
+ . 39805) (FILEPKG.MERGECHANGES 39807 . 40442) (FILEPKG.CHANGEDFNS 40444 . 40756) (MAKEFILE1 40758 . 
+44970) (COMPILE-FILE? 44972 . 46559) (MAKEFILES 46561 . 48089) (ADDFILE 48091 . 50634) (ADDFILE0 50636
+ . 54760) (LISTFILES 54762 . 55729)) (56403 89989 (FILEPKGCHANGES 56413 . 57592) (GETFILEPKGTYPE 57594
+ . 60544) (MARKASCHANGED 60546 . 62177) (FILECOMS 62179 . 62563) (WHEREIS 62565 . 64094) (
+SMASHFILECOMS 64096 . 64324) (FILEFNSLST 64326 . 64492) (FILECOMSLST 64494 . 64980) (UPDATEFILES 64982
+ . 69480) (INFILECOMS? 69482 . 71325) (INFILECOMTAIL 71327 . 72445) (INFILECOMS 72447 . 72608) (
+INFILECOM 72610 . 82628) (INFILECOMSVALS 82630 . 82937) (INFILECOMSVAL 82939 . 83947) (INFILECOMSPROP 
+83949 . 84742) (IFCPROPS 84744 . 85824) (IFCEXPRTYPE 85826 . 86442) (IFCPROPSCAN 86444 . 87405) (
+IFCDECLARE 87407 . 88666) (INFILEPAIRS 88668 . 88967) (INFILECOMSMACRO 88969 . 89987)) (90024 120710 (
+FILES? 90034 . 92145) (FILES?1 92147 . 92849) (FILES?PRINTLST 92851 . 93633) (ADDTOFILES? 93635 . 
+104178) (ADDTOFILE 104180 . 105096) (WHATIS 105098 . 107074) (ADDTOCOMS 107076 . 108614) (ADDTOCOM 
+108616 . 115103) (ADDTOCOM1 115105 . 116276) (ADDNEWCOM 116278 . 117328) (MAKENEWCOM 117330 . 119177) 
+(DEFAULTMAKENEWCOM 119179 . 120708)) (120780 123597 (MERGEINSERT 120790 . 123133) (MERGEINSERT1 123135
+ . 123595)) (123751 125112 (ADDTOFILEKEYLST 123761 . 125110)) (125229 136030 (DELFROMFILES 125239 . 
+126069) (DELFROMCOMS 126071 . 127750) (DELFROMCOM 127752 . 133517) (DELFROMCOM1 133519 . 134318) (
+REMOVEITEM 134320 . 135196) (MOVETOFILE 135198 . 136028)) (136244 138615 (SAVEPUT 136254 . 138613)) (
+138740 146983 (UNMARKASCHANGED 138750 . 140234) (PREEDITFN 140236 . 142717) (POSTEDITPROPS 142719 . 
+145013) (POSTEDITALISTS 145015 . 146981)) (147128 166598 (ALISTS.GETDEF 147138 . 147517) (
+ALISTS.WHENCHANGED 147519 . 148165) (CLEARCLISPARRAY 148167 . 149345) (EXPRESSIONS.WHENCHANGED 149347
+ . 149725) (MAKEALISTCOMS 149727 . 150742) (MAKEFILESCOMS 150744 . 152074) (MAKELISPXMACROSCOMS 152076
+ . 154094) (MAKEPROPSCOMS 154096 . 154722) (MAKEUSERMACROSCOMS 154724 . 156541) (PROPS.WHENCHANGED 
+156543 . 157164) (FILEGETDEF.LISPXMACROS 157166 . 158465) (FILEGETDEF.ALISTS 158467 . 159058) (
+FILEGETDEF.RECORDS 159060 . 159987) (FILEGETDEF.PROPS 159989 . 160784) (FILEGETDEF.MACROS 160786 . 
+161668) (FILEGETDEF.VARS 161670 . 162273) (FILEGETDEF.FNS 162275 . 163515) (FILEPKGCOMS.PUTDEF 163517
+ . 165459) (FILES.PUTDEF 165461 . 166329) (VARS.PUTDEF 166331 . 166474) (FILES.WHENCHANGED 166476 . 
+166596)) (168620 175851 (RENAME 168630 . 170075) (CHANGECALLERS 170077 . 175849)) (175852 223761 (
+SHOWDEF 175862 . 177059) (COPYDEF 177061 . 179809) (GETDEF 179811 . 182354) (GETDEFCOM 182356 . 183322
+) (GETDEFCOM0 183324 . 184517) (GETDEFCURRENT 184519 . 190831) (GETDEFERR 190833 . 192103) (
+GETDEFFROMFILE 192105 . 196334) (GETDEFSAVED 196336 . 197424) (PUTDEF 197426 . 198133) (EDITDEF 198135
+ . 199118) (DEFAULT.EDITDEF 199120 . 201958) (EDITDEF.FILES 201960 . 202165) (LOADDEF 202167 . 202343)
+ (DWIMDEF 202345 . 203199) (DELDEF 203201 . 206095) (DELFROMLIST 206097 . 206601) (HASDEF 206603 . 
+212840) (GETFILEDEF 212842 . 213354) (SAVEDEF 213356 . 215044) (UNSAVEDEF 215046 . 215942) (
+COMPAREDEFS 215944 . 219750) (COMPARE 219752 . 220456) (TYPESOF 220458 . 223759)) (223911 232159 (
+FILEPKGCOM 223921 . 228697) (FILEPKGTYPE 228699 . 232157)) (244192 261485 (FINDCALLERS 244202 . 244717
+) (EDITCALLERS 244719 . 255369) (EDITFROMFILE 255371 . 260800) (FINDATS 260802 . 261074) (LOOKIN 
+261076 . 261483)) (261486 263157 (SEPRCASE 261496 . 263155)) (263674 269130 (IMPORTFILE 263684 . 
+264654) (IMPORTEVAL 264656 . 265542) (IMPORTFILESCAN 265544 . 265957) (CHECKIMPORTS 265959 . 267215) (
+GATHEREXPORTS 267217 . 268538) (\DUMPEXPORTS 268540 . 269128)) (269468 271538 (CLEARFILEPKG 269478 . 
+271536)))))
 STOP

sources/IDLER

@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Sep-2022 19:54:40" {DSK}<home>larry>medley>sources>IDLER.;10
 47564  
+
(FILECREATED " 4-Oct-2022 16:42:36" {DSK}<home>larry>medley>sources>IDLER.;2
 47709  
 
-      :CHANGES-TO (FNS IDLE.RANDOM)
+      :CHANGES-TO (FNS \IDLE.OUT)
 
-      :PREVIOUS-DATE "22-Sep-2022 16:50:17" {DSK}<home>larry>medley>sources>IDLER.;1)
+      :PREVIOUS-DATE "28-Sep-2022 19:54:40" {DSK}<home>larry>medley>sources>IDLER.;1)
 
 
 (* ; "
@@ -435,13 +435,15 @@ Copyright (c) 1985-1990, 1992, 2022 by Venue & Xerox Corporation.
                          (T "."])
 
 (\IDLE.OUT

-  [LAMBDA NIL                                                (* bvm%: "16-Sep-85 18:34")

-    (AND (NOT \IDLING)
-         (LET [(TIMEOUT (LISTGET IDLE.PROFILE 'TIMEOUT]
-              (AND (SMALLP TIMEOUT)
-                   (GREATERP TIMEOUT 0)
-                   (\SECONDSCLOCKGREATERP \LASTUSERACTION (TIMES TIMEOUT 60))
-                   (IDLE
 T])
+  [LAMBDA NIL
                                                (* ; "Edited  4-Oct-2022 16:41 by lmm")

+                                                             (* bvm%: "16-Sep-85 18:34")

+    (CL:WHEN (NOT \IDLING)
+        (NOTIFY.EVENT \IDLING.OVER)
+        (LET [(TIMEOUT (LISTGET IDLE.PROFILE 'TIMEOUT]
+             (AND (SMALLP TIMEOUT)
+                  (GREATERP TIMEOUT 0)
+                  (\SECONDSCLOCKGREATERP \LASTUSERACTION (TIMES TIMEOUT 60))
+                  (IDLE
 T))))])
 
 (\IDLE.EXIT?

   [LAMBDA NIL
                                                (* ; "Edited 22-Nov-88 15:25 by drc:")

@@ -910,11 +912,11 @@ Copyright (c) 1985-1990, 1992, 2022 by Venue & Xerox Corporation.
 )
 (PUTPROPS IDLER COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1989 1990 1992 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7318 37338 (IDLE 7328 . 7776) (IDLE.SET.OPTION 7778 . 11077) (IDLE.SHOW.OPTIONS 11079
- . 11643) (IDLE.SHOW.OPTION 11645 . 13169) (\IDLER 13171 . 22573) (\IDLE.WAIT 22575 . 22678) (
-\OK.TO.IDLE? 22680 . 22858) (\IDLE.TIME 22860 . 23642) (\IDLE.OUT 23644 . 24017) (\IDLE.EXIT? 24019 . 
-28005) (\IDLE.PROMPT.WATCHER 28007 . 28653) (\IDLE.EXIT.ABORT 28655 . 28923) (\IDLE.PROMPTING.WINDOW 
-28925 . 29660) (\IDLE.IS.PREVIOUS 29662 . 31521) (\IDLE.ISMEMBER 31523 . 34126) (\IDLE.AUTHENTICATE 
-34128 . 36248) (\IDLERKEYACTION 36250 . 37336)) (42593 47107 (IDLE.BOUNCING.BOX 42603 . 44066) (
-IDLE.BITMAP 44068 . 46171) (IDLE.RANDOM 46173 . 47105)))))
+  (FILEMAP (NIL (7315 37483 (IDLE 7325 . 7773) (IDLE.SET.OPTION 7775 . 11074) (IDLE.SHOW.OPTIONS 11076
+ . 11640) (IDLE.SHOW.OPTION 11642 . 13166) (\IDLER 13168 . 22570) (\IDLE.WAIT 22572 . 22675) (
+\OK.TO.IDLE? 22677 . 22855) (\IDLE.TIME 22857 . 23639) (\IDLE.OUT 23641 . 24162) (\IDLE.EXIT? 24164 . 
+28150) (\IDLE.PROMPT.WATCHER 28152 . 28798) (\IDLE.EXIT.ABORT 28800 . 29068) (\IDLE.PROMPTING.WINDOW 
+29070 . 29805) (\IDLE.IS.PREVIOUS 29807 . 31666) (\IDLE.ISMEMBER 31668 . 34271) (\IDLE.AUTHENTICATE 
+34273 . 36393) (\IDLERKEYACTION 36395 . 37481)) (42738 47252 (IDLE.BOUNCING.BOX 42748 . 44211) (
+IDLE.BITMAP 44213 . 46316) (IDLE.RANDOM 46318 . 47250)))))
 STOP

sources/LOADUP-APPS

@@ -0,0 +1,56 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "17-Jan-2023 20:34:02" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;3
 2095   
+
+      :CHANGES-TO (FNS Apps.RemoveBackgroundMenuItem)
+
+      :PREVIOUS-DATE "17-Jan-2023 20:29:39" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-APPS.;2
+)
+
+
+(PRETTYCOMPRINT LOADUP-APPSCOMS)
+
+(RPAQQ LOADUP-APPSCOMS
 ((GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
+                        (FNS Apps.LOADUP Apps.RemoveBackgroundMenuItem)))
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *ALL-BUTTONS* BackgroundMenuCommands BackgroundMenu)
+)
+(DEFINEQ
+
+(Apps.LOADUP

+  [LAMBDA NIL
                                                (* ; "Edited 12-Nov-2022 14:03 by FGH")

+    (PROGN 
+           (* ;; " Delete button(s) that are created when lispusers/BUTTONS is loaded")

+
+           (for
 B in
 *ALL-BUTTONS* do
 (DELETE-BUTTON B))
+
+           (* ;; " Remove the BUTTONS BackgroundMenu item")

+
+           (Apps.RemoveBackgroundMenuItem
 "Button Control")
+
+           (* ;; " Remove the NoteCards Background Menu Item")

+
+           (Apps.RemoveBackgroundMenuItem
 'NoteCards)
+
+           (* ;; " Remove the CLOS Background Menu Item")

+
+           (Apps.RemoveBackgroundMenuItem
 'BrowseClass)
+           (RPLACA [CAR (LIST '(A B C]
+                  NIL])
+
+(Apps.RemoveBackgroundMenuItem

+  [LAMBDA (ItemStringOrAtom)
+    (DECLARE
 (GLOBALVARS Apps.SBG))
                          (* ; "Edited 17-Jan-2023 20:33 by FGH")


+                                                             (* ; "Edited 12-Nov-2022 14:07 by FGH")

+    (LET (SAVEX)
+         (SETQ BackgroundMenuCommands (REMOVE (SETQ SAVEX (SASSOC ItemStringOrAtom 
+                                                                 BackgroundMenuCommands))
+                                             BackgroundMenuCommands))
+         (SETQ BackgroundMenu NIL)
+         (SETQ Apps.SBG (APPEND (LIST SAVEX)
+                               Apps.SBG])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (647 2072 (Apps.LOADUP 657 . 1400) (Apps.RemoveBackgroundMenuItem 1402 . 2070)))))
+STOP

sources/LOADUP-APPS.CM

@@ -0,0 +1 @@
+"

sources/LOADUP-FULL

@@ -1,11 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "12-Aug-2022 12:30:09" {DSK}<home>larry>medley>sources>LOADUP-FULL.;2
 4535   
+
(FILECREATED "18-Jan-2023 16:23:36" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;2
 4636   
 
       :CHANGES-TO (FNS LOADUP-FULL)
-                  (VARS LOADUP-FULLCOMS)
 
-      :PREVIOUS-DATE "14-Jul-2022 12:33:11" {DSK}<home>larry>medley>sources>LOADUP-FULL.;1)
+      :PREVIOUS-DATE "12-Aug-2022 12:30:09" {DSK}<home>frank>il>medley>gmedley>sources>LOADUP-FULL.;1
+)
 
 
 (PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -39,7 +39,8 @@
                (PRINTOUT T "FULL fonts loaded" T])
 
 (LOADUP-FULL

-  [LAMBDA NIL
                                                (* ; "Edited 12-Aug-2022 11:17 by lmm")


+  [LAMBDA NIL
                                                (* ; "Edited 18-Jan-2023 16:22 by FGH")


+                                                             (* ; "Edited 12-Aug-2022 11:17 by lmm")


                                                              (* ; "Edited 14-Jul-2022 12:32 by rmk")


                                                              (* ; "Edited 12-Jul-2022 21:57 by rmk")


                                                            (* ; "Edited  7-Mar-2022 21:06 by larry")


@@ -72,7 +73,7 @@
     (LOADUP '(CHAT PRESS INTERPRESS TEDIT HRULE TEDIT-CHAT READNUMBER EDITBITMAP FILEBROWSER 
                    THINFILES GRAPHER SPY WHERE-IS COPYFILES MSANALYZE MSPARSE MASTERSCOPE UNIXPRINT 
                    ISO8859IO HELPSYS DINFO CLIPBOARD MODERNIZE WHEELSCROLL PRETTYFILEINDEX WHO-LINE 
-                   UNIXCOMM UNIXCHAT UNIXYCD))
+                   UNIXCOMM UNIXCHAT UNIXYCD UNIXUTILS))
     (COND
        ((WINDOWP *WHO-LINE*)
         (CLOSEW *WHO-LINE*)))
@@ -87,5 +88,5 @@
 
 (FIXMETA
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (485 4497 (LOADFULLFONTS 495 . 1936) (LOADUP-FULL 1938 . 4247) (FIXMETA 4249 . 4495)))))
+  (FILEMAP (NIL (467 4598 (LOADFULLFONTS 477 . 1918) (LOADUP-FULL 1920 . 4348) (FIXMETA 4350 . 4596)))))
 STOP

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