fix GATHER-INFO for compiled code -- globalvars vs.bounc (#1219)

* Add an On:schedule to the build release and docker workflow to build a new release every Monday at 1am

* Add an On:schedule to the build release and docker workflow to build a new release every Monday at 9am UTC (1am or 2am Pacfic time, depending on daylight savings

.github/workflows/Dockerfile_medley

@@ -0,0 +1,78 @@
+#*******************************************************************************
+# 
+# Dockerfile to build Medley image from latest Maiko image 
+# plus latest release tars from github
+#
+# Copyright 2022-2023 by Interlisp.org
+#
+# ******************************************************************************
+
+FROM ubuntu:22.10
+ARG TARGETPLATFORM
+
+#  Handle ARGs, ENV variables, and LABELs
+ARG BUILD_DATE=unknown
+ARG MEDLEY_RELEASE=unknown
+ARG MAIKO_RELEASE=unknown
+ARG REPO_OWNER=Interlisp
+LABEL name="Medley"
+LABEL description="The Medley Interlisp environment"
+LABEL url="https://github.com/${REPO_OWNER}/medley"
+LABEL build-date=$BUILD_DATE
+LABEL medley_release=$MEDLEY_RELEASE
+LABEL maiko_release=$MAIKO_RELEASE
+
+ENV MEDLEY_DOCKER_BUILD_DATE=$BUILD_DATE
+ENV MEDLEY_RELEASE=$MEDLEY_RELEASE
+ENV MAIKO_RELEASE=$MAIKO_RELEASE
+
+ENV LANG=C.UTF-8
+
+# Copy over the release deb files
+ADD ./*.deb /tmp
+
+# Install Medley/Maiko and add tightvnc server and xclip to the image
+RUN apt-get update                                               \
+    && apt-get install -y apt-utils                              \ 
+    && apt-get install -y tigervnc-standalone-server             \
+    && apt-get install -y xclip                                  \
+    && apt-get install -y man-db                                 \
+    && apt-get install -y nano                                   \
+    && apt-get install -y sudo                                   \
+    && p=$(echo "${TARGETPLATFORM}" | sed -e "s#linux/##")       \
+    && p=$(                                                      \
+           if [ "$p" = "amd64" ];                                \
+               then echo "x86_64";                               \
+           elif [ "$p" = "arm64" ];                              \
+               then echo "aarch64";                              \
+           elif [ "$p" = "arm/v7" ];                             \
+               then echo "armv7l";                               \
+           else                                                  \
+               echo "x86_64";                                    \
+           fi                                                    \
+          )                                                      \
+    && deb="medley-full-${MEDLEY_RELEASE#medley-}"               \
+    && deb=${deb}_${MAIKO_RELEASE#maiko-}-linux-${p}.deb         \
+    && apt-get install -y /tmp/${deb}                            \
+    && chown --recursive root:root /usr/local/interlisp          \
+    && (if [ -n "$(which unminimize)" ]; then (yes | unminimize); fi)
+
+# "Finalize" image
+EXPOSE 5900
+RUN    adduser --gecos "" medley                                 \
+    && adduser --gecos "" ubuntu                                 \
+    && adduser medley sudo                                       \
+    && adduser ubuntu sudo                                       \
+    && (echo 'medley:yeldem' | chpasswd )                        \
+    && (echo 'ubuntu:utnubu' | chpasswd )                        \
+    && echo "medley     ALL=(ALL) NOPASSWD:ALL" >>/etc/sudoers   \
+    && echo "ubuntu     ALL=(ALL) NOPASSWD:ALL" >>/etc/sudoers   \  
+    && mkdir -p /home/medley/il                                  \
+    && chown medley:medley /home/medley/il
+
+ENV TERM=xterm
+USER medley
+WORKDIR /home/medley
+#ENTRYPOINT USER=medley Xvnc -SecurityTypes none -geometry 1280x720 :0 & DISPLAY=:0 medley --full -g 1280x720
+ENTRYPOINT /bin/bash
+

.github/workflows/buildDocker.yml

@@ -136,60 +136,60 @@ jobs:
       # Checkout latest commit
       - name: Checkout Medley
         uses: actions/checkout@v3
+  
+      # Find latest release (draft or normal)
+      # and download its assets
+      - name: Download linux debs from latest (draft) release
+        run: |
+          tag=""
+          if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
+          then
+            tag=$(gh release list | grep Draft | head -n 1 | awk '{ print $3 }')
+          fi
+          if [ -z "${tag}" ];
+          then
+            tag=$(gh release list | grep Latest | head -n 1 | awk '{ print $3 }')
+          fi
+          mkdir -p release_debs
+          gh release download ${tag} -D release_debs -p '*-linux-*.deb'
+        env:
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+
+      # Get Maiko and Medley release information from name of deb files
+      # just downloaded from the Medley latest release
+      - name: Get info about Miako and Medley releases
+        id: release_info
+        run: |
+          regex="^[^0-9]*\([^_]*\)_\([^-]*-[^-]*\)-\([^-]*\)-\([^.]*\).*\$"
+          ls -1 release_debs | head -n 1 > debname.tmp
+          medley_release="medley-$(sed -e "s/${regex}/\1/" debname.tmp)"
+          maiko_release="maiko-$(sed -e "s/${regex}/\2/" debname.tmp)"
+          rm -f debname.tmp
+          echo "MEDLEY_RELEASE=${medley_release}"     >> ${GITHUB_ENV}
+          echo "MAIKO_RELEASE=${maiko_release}"       >> ${GITHUB_ENV}
 
       # Set repo env variables
       - name: Set repo/docker env variables
         id: repo_env
         run: |
-          REPO_NAME=${GITHUB_REPOSITORY#*/}
-          echo "REPO_NAME=${REPO_NAME}" >> ${GITHUB_ENV}
-          echo "repo_name=${REPO_NAME}" >> ${GITHUB_OUTPUT}
-          DOCKER_NAMESPACE=$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')
-          echo "DOCKER_NAMESPACE=${DOCKER_NAMESPACE}" >> ${GITHUB_ENV}
-          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.2
-        with:
-          owner: ${{ github.repository_owner }}
-          repo: medley
-          
-      # Get asset tars from latest Medley release
-      - name: Download Release Assets
-        uses: robinraju/release-downloader@v1.7
-        with:
-          repository: ${{ github.repository_owner }}/medley
-          token: ${{ secrets.GITHUB_TOKEN }}
-          latest: true
-          fileName: "*"
-          out-file-path: "release_tars"
-
-      # Get Maiko release information about latest Maiko Docker Image
-      - name: Get info from latest Maiko image
-        id: maiko_setup
-        run: |
-          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 "maiko_release=${MAIKO_RELEASE}" >> ${GITHUB_OUTPUT}
-
-      # Setup environment variables
-      - name: Setup Environment Variables
-        id: setup_env
-        run: |
-          RELEASE_TAG=${{ steps.release_info.outputs.latest_tag }}
-          DOCKER_IMAGE=${DOCKER_NAMESPACE}/${REPO_NAME}
+          repo_name="${GITHUB_REPOSITORY#*/}"
+          docker_namespace="$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')"
+          docker_image="${docker_namespace}/${repo_name}"
           if [ "${{ needs.inputs.outputs.draft }}" = "false" ];
-              then DOCKER_TAGS="${DOCKER_IMAGE}:latest,${DOCKER_IMAGE}:${RELEASE_TAG#*-}_${MAIKO_RELEASE#*-}"
-              else DOCKER_TAGS="${DOCKER_IMAGE}:draft"
+          then 
+              docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
+              platforms="linux/amd64,linux/arm64"
+          else 
+              docker_tags="${docker_image}:draft"
+              platforms="linux/amd64"
           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}
+          echo "REPO_NAME=${repo_name}"                       >> ${GITHUB_ENV}
+          echo "DOCKER_NAMESPACE=${docker_namespace}"         >> ${GITHUB_ENV}
+          echo "DOCKER_IMAGE=${docker_image}"                 >> ${GITHUB_ENV}
+          echo "DOCKER_TAGS=${docker_tags}"                   >> ${GITHUB_ENV}
+          echo "BUILD_DATE=$(date -u +'%Y-%m-%dT%H:%M:%SZ')"  >> ${GITHUB_ENV}
+          echo "PLATFORMS=${platforms}"                       >> ${GITHUB_ENV}
+          #linux/amd64,linux/arm64,linux/arm/v7
 
       # Setup the Docker Machine Emulation environment.  
       - name: Set up QEMU
@@ -217,17 +217,16 @@ jobs:
         with:
           builder: ${{ steps.buildx.outputs.name }}
           build-args: |
-            BUILD_DATE=${{ steps.setup_env.outputs.build_time }}
-            RELEASE_TAG=${{ steps.setup_env.outputs.release_tag }}
-            MAIKO_RELEASE=${{ steps.setup_env.outputs.maiko_release }}
-            DOCKER_NAMESPACE=${{ steps.repo_env.outputs.docker_namespace }}
+            BUILD_DATE=${{ env.BUILD_DATE }}
+            MEDLEY_RELEASE=${{ env.MEDLEY_RELEASE }}
+            MAIKO_RELEASE=${{ env.MAIKO_RELEASE }}
             REPO_OWNER=${{ github.repository_owner }}
-          context: ./release_tars
-          file: ./Dockerfile
-          platforms: linux/amd64,linux/arm64,linux/arm/v7
+          context: ./release_debs
+          file: ./.github/workflows/Dockerfile_medley
+          platforms: ${{ env.PLATFORMS }}
           # Push the result to DockerHub
           push: true
-          tags: ${{ steps.setup_env.outputs.docker_tags }}
+          tags: ${{ env.DOCKER_TAGS }}
 
 ######################################################################################
 

.github/workflows/buildLoadup.yml

@@ -49,6 +49,9 @@ on:
         required: false
         type: string
         default: 'false'
+    secrets:
+      OIO_SSH_KEY:
+        required: true
 
 defaults:
   run:
@@ -113,6 +116,8 @@ jobs:
 
 ######################################################################################
 
+
+  #
   # Do the loadup
   # 
 
@@ -120,6 +125,12 @@ jobs:
 
     runs-on: ubuntu-latest
 
+    outputs:
+      combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
+      medley_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_RELEASE_TAG }}
+      medley_short_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_SHORT_RELEASE_TAG }}
+      debs_filename_base: ${{ steps.debs.outputs.DEBS_FILENAME_BASE }}
+
     needs: [inputs, sentry]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
@@ -143,20 +154,6 @@ jobs:
         id: tag
         uses: ./../actions/release-tag-action
 
-      # Setup environment variables
-      - name: Setup Environment Variables
-        id: setup_env
-        run: |
-          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
@@ -166,6 +163,33 @@ jobs:
           owner: ${{ github.repository_owner }}
           repo: maiko
           
+      # Setup environment variables & establish job outputs
+      - name: Setup Environment Variables
+        run: |
+          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}
+          echo "MAIKO_RELEASE_TAG=${{ steps.maiko.outputs.latest_tag }}" >>${GITHUB_ENV}
+      - name: More Environment Variables
+        run: |
+          echo "MEDLEY_SHORT_RELEASE_TAG=${MEDLEY_RELEASE_TAG#medley-}" >>${GITHUB_ENV}
+          echo "MAIKO_SHORT_RELEASE_TAG=${MAIKO_RELEASE_TAG#maiko-}" >>${GITHUB_ENV}
+      - name: Even More Environment Variables
+        run: |
+          echo "COMBINED_RELEASE_TAG=${MEDLEY_SHORT_RELEASE_TAG}_${MAIKO_SHORT_RELEASE_TAG}" >>${GITHUB_ENV}
+      - name: Establish job outputs
+        id: job_outputs
+        run: |
+          echo "COMBINED_RELEASE_TAG=${COMBINED_RELEASE_TAG}" >> $GITHUB_OUTPUT;
+          echo "MEDLEY_RELEASE_TAG=${MEDLEY_RELEASE_TAG}" >> $GITHUB_OUTPUT;
+          echo "MEDLEY_SHORT_RELEASE_TAG=${MEDLEY_SHORT_RELEASE_TAG}" >> $GITHUB_OUTPUT;
+
+      # Setup some needed dirs in workspace
+      - name: Create work dirs
+        run: mkdir -p ${TARBALL_DIR}
+
       # Download Maiko Release Assets
       - name: Download Release Assets
         uses: robinraju/release-downloader@v1.6
@@ -174,11 +198,11 @@ jobs:
           token: ${{ secrets.GITHUB_TOKEN }}
           latest: true
           out-file-path: ${{ env.TARBALL_DIR }}
-          fileName: "${{ steps.maiko.outputs.latest_tag }}-linux.*.tgz" 
+          fileName: "${{ env.MAIKO_RELEASE_TAG }}-linux.*.tgz" 
 
       - name: Untar Maiko Release for use in loadup
         run: |
-          tar -xzf "${TARBALL_DIR}/${{ steps.maiko.outputs.latest_tag }}-linux.x86_64.tgz"
+          tar -xzf "${TARBALL_DIR}/${{ env.MAIKO_RELEASE_TAG }}-linux.x86_64.tgz"
 
       # Checkout Notecards and tar it in the tarballsdir
       - name: Checkout Notecards
@@ -192,7 +216,7 @@ jobs:
           cd ..
           tar cfz medley/${TARBALL_DIR}/notecards.tgz notecards
 
-      #
+      # Install vnc
       - name: Install vnc
         run: sudo apt-get update && sudo apt-get install -y tightvncserver
 
@@ -202,10 +226,11 @@ jobs:
           export DISPLAY=":0"
           PATH="$PWD/maiko:$PATH" 
           scripts/loadup-all.sh -apps
-
+      
       - name: Build loadups release tar
         run: |
           cd ..
+          mkdir -p medley/${TARBALL_DIR}
           tar cfz medley/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-loadups.tgz        \
             medley/loadups/lisp.sysout               \
             medley/loadups/full.sysout               \
@@ -216,6 +241,7 @@ jobs:
       - name: Build runtime release tar
         run: |
           cd ..
+          mkdir -p medley/${TARBALL_DIR}
           tar cfz medley/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-runtime.tgz          \
                      --exclude "*~" --exclude "*#*"              \
                      --exclude exports.all                       \
@@ -238,11 +264,16 @@ jobs:
                      medley/internal
 
 
+      # Build the deb files as well as the tgz files
       - name: Build .deb files for 3 architectures
+        id: debs
         run: |
           cd installers/deb
-          ./build_deb.sh
+          debs_filename_base=$(./build_deb.sh)
+          echo "DEBS_FILENAME_BASE=${debs_filename_base}" >> $GITHUB_ENV;
+          echo "DEBS_FILENAME_BASE=${debs_filename_base}" >> $GITHUB_OUTPUT;
 
+      # Push the release up to github releases
       - name: Delete existing release with same tag (if any)
         uses: cb80/delrel@latest
         with:
@@ -265,41 +296,114 @@ jobs:
           generateReleaseNotes: true
           token: ${{ secrets.GITHUB_TOKEN }}
 
-      - name: Update the downloads page and the man page to the OIO satic page host
+
+  #
+  # Create the Windows installer, push it up to the release on github and
+  # update the downloads page on OIO
+  #
+  windows_installer:
+
+    runs-on: windows-latest
+
+    needs: [inputs, sentry, loadup]
+    if: |
+      needs.sentry.outputs.release_not_built == 'true'
+      || needs.inputs.outputs.force == 'true'
+
+    steps:
+      # Checkout latest commit
+      - name: Checkout Medley
+        uses: actions/checkout@v3
+
+      # Store the values output from loadup job as environment variables
+      - name: Environment Variables
+        shell: powershell
         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" )"
-            #
+          $crt="${{ needs.loadup.outputs.combined_release_tag }}"
+          echo "COMBINED_RELEASE_TAG=$crt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
+          $mrt="${{ needs.loadup.outputs.medley_release_tag }}"
+          echo "MEDLEY_RELEASE_TAG=$mrt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
+          $msrt="${{ needs.loadup.outputs.medley_short_release_tag }}"
+          echo "MEDLEY_SHORT_RELEASE_TAG=$msrt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
+          $debs="${{ needs.loadup.outputs.debs_filename_base }}"
+          echo "DEBS_FILENAME_BASE=$debs" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
+
+      # Download vnc viewer
+      - name: Download vncviewer
+        shell: powershell
+        run: |
+          $url = "https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe"
+          $output = "installers\win\vncviewer64-1.12.0.exe"
+          (New-Object System.Net.WebClient).DownloadFile($url, $output)
+ 
+      # Run iscc.exe to compile the installer
+      - name: Compile medley.iss
+        shell: powershell
+        run: |
+           iscc installers\win\medley.iss
+           $filename="medley-install_${env:COMBINED_RELEASE_TAG}_x64.exe"
+           echo "INSTALLER_FILENAME=$filename" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
+
+      # Upload windows installer to release
+      - name: Upload windows installer to release
+        id: push
+        uses: ncipollo/release-action@v1
+        with: 
+          allowUpdates: true
+          artifacts: installers/win/${{ env.INSTALLER_FILENAME }}
+          tag: ${{ env.MEDLEY_RELEASE_TAG }}
+          token: ${{ secrets.GITHUB_TOKEN }}
+          omitBodyDuringUpdate: true
+          omitDraftDuringUpdate: true
+          omitNameDuringUpdate: true
+          omitPrereleaseDuringUpdate: true
+
+      # Install the OpenSSH Client
+      - name: Install the OpenSSH Client
+        shell: powershell
+        run: |
+          Add-WindowsCapability -Online -Name OpenSSH.Client~~~~0.0.1.0
+
+      # Update the downloads page and the man page on OIO
+      - name: Update the downloads page and the man page to the OIO static page host
+        shell: bash
+        run: |
+            # Figure out filenames
+            download_url="${{ steps.push.outputs.html_url }}"
+            download_url="${download_url/\/tag\//\/download\/}"
             local_template="installers/downloads_page/medley_downloads.html"
             local_filename="medley_downloads.html"
+            local_manpath="docs/man-page/man_medley.html"
             if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
             then
                 remote_filename="draft_downloads"
+                remote_manname="man_draft.html"
             else
                 remote_filename="${local_filename%.html}"
+                remote_manname="man_medley.html"
             fi            
             remote_filepath="/srv/oio/static/${remote_filename}"
+            remote_manpath="/srv/oio/static/${remote_manname}"
+            # Fill in downloads page template
             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" \
+               -e "s/@@@MEDLEY.SHORT.RELEASE.TAG@@@/${MEDLEY_SHORT_RELEASE_TAG}/g" \
+               -e "s~@@@DOWNLOAD_URL@@@~${download_url}~g" \
+               -e "s/@@@DEBS.FILENAME.BASE@@@/${DEBS_FILENAME_BASE}/g" \
+               -e "s/@@@WINDOWS.INSTALLER.FILENAME@@@/${INSTALLER_FILENAME}/g" \
                < "${local_template}" > "${local_filename}"
-            local_manpath="docs/man-page/man_medley.html"
-            remote_manpath="/srv/oio/static/man_medley.html"
+            # Create sftp instruction file
             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
+            # Do the sftp
             eval $(ssh-agent)
             ssh-add - <<< "${SSH_KEY}"
             sftp -o StrictHostKeyChecking=no -b batch ubuntu@online.interlisp.org
         env:
             SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
+      
 
 
 ######################################################################################
@@ -314,7 +418,7 @@ jobs:
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}
 
-    needs: [inputs, sentry, loadup]
+    needs: [inputs, sentry, loadup, windows_installer]
 
     steps: 
       # Checkout the actions for this repo owner
@@ -338,3 +442,21 @@ jobs:
           echo "build_successful='true'" >> $GITHUB_OUTPUT
           
 ######################################################################################
+
+
+
+#      - name: Download the Windows installer created in windows job
+#        uses: actions/download-artifact@v3
+#        with:
+#           name: windows_installer
+#           path: installers/win
+
+#     - name: Rename the Windows installer w/ version tag
+#        run: |
+#          maiko_release_tag="${{ steps.maiko.outputs.latest_tag }}"
+#          combined_release_tag="${MEDLEY_RELEASE_TAG#medley-}_${maiko_release_tag#maiko-}"
+#          windows_installer_filename="medley_install_${combined_release_tag}_x64.exe"
+#          cd installers/win
+#          mv medley_install_vXXXVERSIONXXX_x64.exe "${windows_installer_filename}"  
+#          echo "WINDOWS_INSTALLER_FILENAME=${windows_installer_filename}" >>${GITHUB_ENV}
+

.github/workflows/buildReleaseInclDocker.yml

@@ -18,6 +18,9 @@ name: "Build/Push Release & Docker"
 
 # Run this workflow on ...
 on:
+  schedule:
+    - cron: '0 9 * * 1'
+
   workflow_dispatch:
     inputs:
       draft:
@@ -53,7 +56,7 @@ on:
 defaults:
   run:
     shell: bash
-    
+
 
 # Jobs that compose this workflow
 jobs:
@@ -72,17 +75,14 @@ jobs:
     steps:
       - id: one
         run: >
-          if [ '${{ toJSON(inputs) }}' = 'null'  ];
+          if [ '${{ toJSON(inputs) }}' != 'null'  ];
           then
-              echo "workflow_dispatch";
-              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
-              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
+            echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
+            echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
           else
-              echo "workflow_call";
-              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
-              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
+            echo "draft=false" >> $GITHUB_OUTPUT;
+            echo "force=false" >> $GITHUB_OUTPUT;
           fi
-        
 
 ######################################################################################
 
@@ -94,7 +94,9 @@ jobs:
     with:
         draft: ${{ needs.inputs.outputs.draft }}
         force: ${{ needs.inputs.outputs.force }}
-    
+    secrets:
+        OIO_SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
+
 
 ######################################################################################
 
@@ -109,6 +111,5 @@ jobs:
         DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
         DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
 
-
 ######################################################################################
 

.github/workflows/testLogin.yml

@@ -1,23 +0,0 @@
-name: 'Test Docker Login'
-
-# Run this workflow on ...
-on:
-  workflow_dispatch:
-
-defaults:
-  run:
-    shell: bash
-    
-
-jobs:
-
-  login_test:
-    runs-on: ubuntu-latest
-    steps:
-      - id: only_step
-        uses: docker/login-action@v1
-        with:
-          username: ${{ secrets.DOCKER_USERNAME }}
-          password: ${{ secrets.DOCKER_PASSWORD }}
-
-

Dockerfile

@@ -1,55 +0,0 @@
-#*******************************************************************************
-# 
-# Dockerfile to build Medley image from latest Maiko image 
-# plus latest release tars from github
-#
-# Copyright 2022-2023 by Interlisp.org
-#
-# ******************************************************************************
-
-ARG DOCKER_NAMESPACE=interlisp
-
-FROM ${DOCKER_NAMESPACE}/maiko:latest
-
-# Add tightvnc server and xclip to the image
-RUN apt-get update && apt-get install -y tightvncserver && apt-get install -y xclip
-
-#  Handle ARGs, ENV variables, and LABELs
-ARG BUILD_DATE=unknown
-ARG RELEASE_TAG=unknown
-ARG MAIKO_RELEASE=unknown
-ARG REPO_OWNER=Interlisp
-LABEL name="Medley"
-LABEL description="The Medley Interlisp environment"
-LABEL url="https://github.com/${REPO_OWNER}/medley"
-LABEL build-time=$BUILD_DATE
-LABEL release_tag=$RELEASE_TAG
-LABEL maiko_release=$MAIKO_RELEASE
-
-ENV MEDLEY_BUILD_DATE=$BUILD_DATE
-ENV MEDLEY_RELEASE=$RELEASE_TAG
-
-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}
-
-ENV LANG=C.UTF-8
-
-# 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 ${MEDELY_INSTALLDIR}/run-medley -full -g 1280x720 -sc 1280x720

README.md

@@ -105,8 +105,7 @@ dump of your system located in your home directory named
 specify a specific image to run, Medley restores that image so that
 you can continue right where you left off.
 
-* [Using Medley Interlisp](https://github.com/Interlisp/medley/wiki/Using-Medley-Interlisp)
-
+* [Using Medley Interlisp](https://interlisp.org/doc/info/Using.html)
 
 ## Naming conventions and directory structure
 

docs/man-page/man_medley.html

@@ -37,35 +37,50 @@
 <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><p>Use STRING as title of Medley window. Ignored when when the --vnc flag is set or when running on Windows (Docker) installations.</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>
+<dt><strong>-d <em>:N</em>, --display <em>:N</em> ** <strong>Not</strong> applicable to Windows (Docker) installations **</strong></dt>
+<dd><p>Use X display :N. Defaults to the value of $DISPLAY. This flag is ignored when the --vnc flag is set as well as on Windows (Docker) installations.</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>
+<dt><strong>-v, --vnc ** <strong>Applicable</strong> only to WSL 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. This flag is always set for WSL1 installations.</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><p>Set Medley to run in <em>N</em> 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><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. On Windows (Docker) installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</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><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. On Windows (Docker) installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</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>
+<dt><strong>-x [<em>DIR</em> | -], --logindir [<em>DIR</em> | -] ** <strong>On</strong> Linux and WSL installations **</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>
+<dt><strong>-x [<em>DIR</em> | -], --logindir [<em>DIR</em> | -] ** <strong>On</strong> Windows (Docker) installations **</strong></dt>
+<dd><p>Map DIR in the Windows host file system to /home/medley/il in the Medley file system (in the Docker container). LOGINDIR is always /home/medley/il from Medley’s standpoint. The “-” value is not valid in this case.</p>
+</dd>
+<dt><strong>-u, --update ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
+<dd><p>Before running Medley, do a pull to retrieve the latest interlisp/medley docker image from Docker Hub.</p>
+</dd>
+<dt><strong>-b, --background ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
+<dd><p>Run Medley in background rather than foreground.</p>
+</dd>
+<dt><strong>-p <em>PORT</em>, --port <em>PORT</em> ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
+<dd><p>Use <em>PORT</em> as the port that VNC viewer uses to contact the VNC server within the Docker container. Default is 5900.</p>
+</dd>
+<dt><strong>-w [<em>DISTRO</em> | -], --wsl [<em>DISTRO</em> | -] ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
+<dd><p>Run Medley in the context of the named WSL <em>DISTRO</em> instead of within Docker. If <em>DISTRO</em> is “-”, used the default WSL distro. Equivalent to typing “wsl -d <em>DISTRO</em> medley ...” into a Command or Powershell window.</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><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). On Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the Medley file system, not the host Windows file system.</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>

docs/man-page/medley.1

@@ -95,18 +95,21 @@ 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.
+Ignored when when the \-\-vnc flag is set or when running on Windows
+(Docker) installations.
 .TP
-.B \-d \f[I]:N\f[R], \-\-display \f[I]:N\f[R]
+.B \-d \f[I]:N\f[R], \-\-display \f[I]:N\f[R]\ \ \ \ ** \f[B]Not applicable to Windows (Docker) installations\f[R] **
 Use X display :N.
 Defaults to the value of $DISPLAY.
-Not relevant when the \-\-vnc flag is set.
+This flag is ignored when the \-\-vnc flag is set as well as on Windows
+(Docker) installations.
 .TP
-.B \-v, \-\-vnc (Applicable only to Windows System for Linux installations)
+.B \-v, \-\-vnc\ \ \ \ ** \f[B]Applicable only to WSL installations\f[R] **
 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.
+This flag is always set for WSL1 installations.
 .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
@@ -121,7 +124,7 @@ 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.
+Set Medley to run in \f[I]N\f[R] MB of virtual memory.
 Defaults to 256MB.
 .TP
 .B \-p \f[I]FILE\f[R], \-\-vmem \f[I]FILE\f[R]
@@ -134,6 +137,8 @@ The \-\-id flag will not protect against vmem collisions when the
 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.
+On Windows (Docker) installations, \f[I]FILE\f[R] is specified in the
+Medley file system, not the host Windows file system.
 .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
@@ -141,14 +146,41 @@ 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.
+On Windows (Docker) installations, \f[I]FILE\f[R] is specified in the
+Medley file system, not the host Windows file system.
 .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
+.B \-x [\f[I]DIR\f[R] | \-], \-\-logindir [\f[I]DIR\f[R] | \-]\ \ \ \ ** \f[B]On Linux and WSL installations\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.
+.TP
+.B \-x [\f[I]DIR\f[R] | \-], \-\-logindir [\f[I]DIR\f[R] | \-]\ \ \ \ ** \f[B]On Windows (Docker) installations\f[R] **
+Map DIR in the Windows host file system to /home/medley/il in the Medley
+file system (in the Docker container).
+LOGINDIR is always /home/medley/il from Medley\[cq]s standpoint.
+The \[lq]\-\[rq] value is not valid in this case.
+.TP
+.B \-u, \-\-update\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
+Before running Medley, do a pull to retrieve the latest interlisp/medley
+docker image from Docker Hub.
+.TP
+.B \-b, \-\-background\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
+Run Medley in background rather than foreground.
+.TP
+.B \-p \f[I]PORT\f[R], \-\-port \f[I]PORT\f[R]\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
+Use \f[I]PORT\f[R] as the port that VNC viewer uses to contact the VNC
+server within the Docker container.
+Default is 5900.
+.TP
+.B \-w [\f[I]DISTRO\f[R] | \-], \-\-wsl [\f[I]DISTRO\f[R] | \-]\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
+Run Medley in the context of the named WSL \f[I]DISTRO\f[R] instead of
+within Docker.
+If \f[I]DISTRO\f[R] is \[lq]\-\[rq], used the default WSL distro.
+Equivalent to typing \[lq]wsl \-d \f[I]DISTRO\f[R] medley \&...\[rq]
+into a Command or Powershell window.
 .SS Other Options
 .PP
 \ 
@@ -161,6 +193,8 @@ 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).
+On Windows (Docker) installations, \f[I]SYSOUT_FILE\f[R] is specified in
+the Medley file system, not the host Windows file system.
 .TP
 .B \f[I]PASS_ON_ARGS\f[R]
 All arguments after the \[lq]\-\-\[rq] flag, are passed unaltered to lde

docs/man-page/medley.1.md

@@ -41,7 +41,7 @@ Flags
 -z, \-\-man
 : Show the man page for medley
 
--f, \-\-full                
+-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.)
@@ -80,17 +80,18 @@ The Medley window is an unscaled viewport onto this virtual display. If \-\-scre
 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.
+: Use STRING as title of Medley window.  Ignored when when the \-\-vnc flag is set or when running on Windows (Docker)
+installations.
 
--d *:N*, \-\-display *:N*
-: Use X display :N.  Defaults to the value of $DISPLAY.  Not relevant when
-the \-\-vnc flag is set.
+-d *:N*, \-\-display *:N*    \*\* **Not applicable to Windows (Docker) installations** \*\*
+~ Use X display :N.  Defaults to the value of $DISPLAY.  This flag is ignored when the \-\-vnc flag is set as
+well as on Windows (Docker) installations.
 
--v, \-\-vnc  (Applicable only to Windows System for Linux installations)
+-v, \-\-vnc    \*\* **Applicable only to WSL 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.
+do not scale well.  This flag is always set for WSL1 installations.
 
 -i [*ID_STRING* | - | \-\-], \-\-id [*ID_STRING* | - | \-\-]
 : Use ID_STRING as the id for this run of Medley, iunless ID_STRING is "-" or "\-\-". 
@@ -101,27 +102,45 @@ 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.
+: 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.
+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. On Windows (Docker) installations, *FILE* is specified in the Medley file system, not the host Windows file system.
 
 -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.
+in which case it is $MEDLEYDIR/greetfiles/APPS-INIT. On Windows (Docker) installations, *FILE* is
+specified in the Medley file system, not the host Windows file system.
 
--x \[*DIR* | -], \-\-logindir \[*DIR* | -]
-: use DIR as LOGINDIR in Medley, unless DIR is "-", in which case use
+-x \[*DIR* | -], \-\-logindir \[*DIR* | -]    \*\* **On Linux and WSL installations** \*\*
+: 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.
 
+-x \[*DIR* | -], \-\-logindir \[*DIR* | -]    \*\* **On Windows (Docker) installations** \*\*
+: Map DIR in the Windows host file system to /home/medley/il in the Medley
+file system (in the Docker container).  LOGINDIR is always /home/medley/il from Medley's standpoint.  The "-" value is not valid in this case.
+
+-u, \-\-update    \*\* **Windows (Docker) installations only** \*\*
+: Before running Medley, do a pull to retrieve the latest interlisp/medley docker image from Docker Hub.
+
+-b, \-\-background    \*\* **Windows (Docker) installations only** \*\*
+: Run Medley in background rather than foreground.
+
+-p *PORT*, \-\-port *PORT*    \*\* **Windows (Docker) installations only** \*\*
+: Use *PORT* as the port that VNC viewer uses to contact the VNC server within the Docker container.  Default is 5900.
+
+-w \[*DISTRO* | -], \-\-wsl \[*DISTRO* | -]    \*\* **Windows (Docker) installations only** \*\*
+: Run Medley in the context of the named WSL *DISTRO* instead of within Docker.  If *DISTRO* is "-", used the default WSL distro.  Equivalent to typing "wsl -d *DISTRO* medley ..." into a Command or Powershell window.
+
+
 Other Options
 -------------
  
@@ -130,8 +149,9 @@ Other Options
 : 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).
+If no such virtual memory file exists, then Medley will start from the standard full.sysout
+(equivalent to specifying the \-\-full flag).  On Windows (Docker) installations, *SYSOUT_FILE* is
+specified in the Medley file system, not the host Windows file system.
 
 *PASS_ON_ARGS*
 : All arguments after the "\-\-" flag, are passed unaltered to lde via run-medley.

greetfiles/MEDLEYDIR-INIT

@@ -1,11 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "22-Nov-2022 20:59:24" {DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;6
 2860   
+
(FILECREATED "13-Apr-2023 09:44:06" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;6
 2925   
+
+      :EDIT-BY "lmm"
 
       :CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
 
-      :PREVIOUS-DATE "22-Nov-2022 20:42:43" 
-{DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;5)
+      :PREVIOUS-DATE "10-Apr-2023 11:58:07" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;5
+)
 
 
 (PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
@@ -22,18 +24,19 @@
 
               (DWIMWAIT 180)
               (HELPDEPTH 4)
-              (HELPTIME 10)
+              (HELPTIME 1)
               (FILING.ENUMERATION.DEPTH 1)
               [LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
                                            (UNIX-GETENV "HOME"]
               [USERGREETFILES `((,LOGINDIR "INIT" COM)
                                 (,LOGINDIR "INIT"]
+              (COPYRIGHTFLG 'NEVER)
               (COPYRIGHTSRESERVED NIL)
               (AUTOBACKTRACEFLG 'ALWAYS)
               (MAXLEVEL 30000)
               (MAXLOOP 30000))
         (FNS INTERLISPMODE)
-        (ALISTS (FONTDEFS LARGER))))
+        (ALISTS (FONTDEFS))))
 
 (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
                    "")
@@ -49,7 +52,7 @@
 
 (RPAQQ HELPDEPTH
 4)
 
-(RPAQQ HELPTIME
 10)
+(RPAQQ HELPTIME
 1)
 
 (RPAQQ FILING.ENUMERATION.DEPTH
 1)
 
@@ -59,6 +62,8 @@
 (RPAQ USERGREETFILES
 `((,LOGINDIR "INIT" COM)
                        (,LOGINDIR "INIT")))
 
+(RPAQQ COPYRIGHTFLG
 NEVER)
+
 (RPAQQ COPYRIGHTSRESERVED
 NIL)
 
 (RPAQQ AUTOBACKTRACEFLG
 ALWAYS)
@@ -84,5 +89,5 @@
 
 (ADDTOVAR FONTDEFS
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1986 2811 (INTERLISPMODE 1996 . 2809)))))
+  (FILEMAP (NIL (2051 2876 (INTERLISPMODE 2061 . 2874)))))
 STOP

installers/deb/build_deb.sh

@@ -11,6 +11,15 @@
 ###############################################################################
 # set -x
 
+# mess with file desscriptors so we get only one line on stdout
+# so we can communicate only what we want back to any githib runner
+# stash fd 1 in fd 3
+exec 3>&1
+# make fd 1 (stdout) be the same as stdout
+# so none of the std output from this file will be captured by
+# $() but it will still be written out to the tty (via stderr)
+exec 1>&2
+
 tarball_dir=tmp/tarballs
 
 #  Make sure we are in the right directory
@@ -60,6 +69,7 @@ fi
 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/")
+debs_filename_base="medley-full-${medley_release}_${maiko_release}"
 popd >/dev/null 2>/dev/null
 
 
@@ -120,9 +130,13 @@ do
       cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
     fi
     #
+    #  Make sure all files are owned by root
+    #
+    sudo su <<< "chown --recursive root:root ${il_dir}"
+    #
     #  Create tar file for this arch
     #
-    filename="medley-full-${medley_release}_${maiko_release}-${wslp}-${arch}"
+    filename="${debs_filename_base}-${wslp}-${arch}"
     mkdir -p tars
     echo "Creating tar file tars/${filename}.tgz"
     tar -C ${il_dir} -czf tars/${filename}.tgz .
@@ -137,3 +151,8 @@ do
   done
 done
 
+# send just one line back to github $() construct
+# do this by restoring fd 1 to what it was orginally
+exec 1>&3
+echo "${debs_filename_base}"
+

installers/deb/control-linux

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

installers/downloads_page/medley_downloads.html

@@ -2,37 +2,44 @@
 <li><h1>MEDLEY DOWNLOADS</h1>
 
 <ul>
-<li><h2>Standard Installations (for Debian-based distros)</h2>
+<li><h2>LINUX (including Windows System for Linux)</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>
+<li><h3>Standard Installations (for Debian-based distros)</h3>
 
 <ul>
-<li><h3>Standard Linux</h3>
+<li><h4>Standard Linux</h4>
 
-<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="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-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.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-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.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
-<li><h3>Windows System for Linux</h3>
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
+<li><h4>Windows System for Linux</h4>
 
-<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="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-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.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
 </ul></li>
+<li><h3>Local Installations (for any Linux distro)</h3>
+
+<ul>
+<li><h4>Standard Linux</h4>
+
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
+
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
+
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
+<li><h4>Windows System for Linux</h4>
+
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
+
+<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
+</ul></li>
+</ul></li>
+<li><h2>WINDOWS 10/11 (Medley runs in a Docker container)</h2>
+
+<p><a href="@@@DOWNLOAD_URL@@@/@@@WINDOWS.INSTALLER.FILENAME@@@">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines</a></p></li>
 </ul></li>
 </ul>

installers/downloads_page/medley_downloads.md

@@ -1,38 +1,42 @@
 *    # MEDLEY DOWNLOADS
  
-     *    ## Standard Installations (for Debian-based distros)
+     *    ## LINUX (including Windows System for Linux)
 
-         * ### Standard Linux
+         *    ### Standard Installations (for Debian-based distros)
 
-         [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)
+             * #### Standard Linux
 
-         [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 x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86\_64.deb)
 
-         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.deb)
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.deb)
 
-         * ### Windows System for Linux
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.deb)
 
-         [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)
+             * #### Windows System for Linux
 
-         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.deb)
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86\_64.deb)
 
-     *    ## Local Installations (for any Linux distro)
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.deb)
 
-         * ### Standard Linux
+         *    ### Local Installations (for any Linux distro)
 
-         [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)
+             * #### Standard Linux
 
-         [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 x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86\_64.tgz)
 
-         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.tgz)
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.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)
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.tgz)
 
+             * #### Windows System for Linux
 
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86\_64.tgz)
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.tgz)
+
+     *    ## WINDOWS 10/11 (Medley runs in a Docker container)
+
+         [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines](@@@DOWNLOAD_URL@@@/@@@WINDOWS.INSTALLER.FILENAME@@@)
 
 
 

installers/win/.gitignore

@@ -0,0 +1,3 @@
+medley-install_*.exe
+vncviewer*.exe
+

installers/win/editpath/EditPath.iss

@@ -0,0 +1,165 @@
+; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com)
+;
+; This program is free software; you can redistribute it and/or modify it under
+; the terms of the GNU Lesser General Public License as published by the Free
+; Software Foundation; either version 3 of the License, or (at your option) any
+; later version.
+;
+; This program is distributed in the hope that it will be useful, but WITHOUT
+; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more
+; details.
+;
+; You should have received a copy of the GNU Lesser General Public License
+; along with this program. If not, see https://www.gnu.org/licenses/.
+
+; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script
+; demonstrating use of PathMgr.dll.
+;
+; This script uses PathMgr.dll in the following ways:
+; * Copies PathMgr.dll to the target machine (required for uninstall)
+; * Defines a task in [Tasks] that should modify the Path
+; * Imports the AddDirToPath() DLL function at setup time
+; * Imports the RemoveDirFromPath() DLL function at uninstall time
+; * Stores task state as custom setting using RegisterPreviousData()
+; * Retrieves task state custom setting during setup and uninstall initialize
+; * At post install, adds app dir to Path if task selected
+; * At uninstall, removes dir from Path if custom setting present
+; * Unloads and deletes DLL and removes app dir at uninstall deinitialize
+
+#if Ver < EncodeVer(6,0,0,0)
+  #error This script requires Inno Setup 6 or later
+#endif
+
+[Setup]
+AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842}
+AppName=EditPath
+AppVersion=4.0.4.0
+UsePreviousAppDir=false
+DefaultDirName={autopf}\EditPath
+Uninstallable=true
+OutputDir=.
+OutputBaseFilename=EditPath_Setup
+ArchitecturesInstallIn64BitMode=x64
+PrivilegesRequired=none
+PrivilegesRequiredOverridesAllowed=dialog
+
+[Files]
+; Install PathMgr.dll for use with both setup and uninstall; use
+; uninsneveruninstall flag because DeinitializeSetup() will delete after
+; unloading the DLL; install the 32-bit version of PathMgr.dll because both
+; setup and uninstall executables are 32-bit
+Source: "i386\PathMgr.dll";  DestDir: "{app}"; Flags: uninsneveruninstall
+
+; Other files to install on target system
+Source: "i386\EditPath.exe";   DestDir: "{app}"; Check: not Is64BitInstallMode()
+Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode()
+Source: "EditPath.md";         DestDir: "{app}"
+
+[Tasks]
+Name: modifypath; Description: "&Add to Path"
+
+[Code]
+const
+  MODIFY_PATH_TASK_NAME = 'modifypath';  // Specify name of task
+
+var
+  PathIsModified: Boolean;          // Cache task selection from previous installs
+  ApplicationUninstalled: Boolean;  // Has application been uninstalled?
+
+// Import AddDirToPath() at setup time ('files:' prefix)
+function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD;
+  external 'AddDirToPath@files:PathMgr.dll stdcall setuponly';
+
+// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix)
+function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD;
+  external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly';
+
+// Wrapper for AddDirToPath() DLL function
+function AddDirToPath(const DirName: string): DWORD;
+var
+  PathType, AddType: DWORD;
+begin
+  // PathType = 0 - use system Path
+  // PathType = 1 - use user Path
+  // AddType = 0 - add to end of Path
+  // AddType = 1 - add to beginning of Path
+  if IsAdminInstallMode() then
+    PathType := 0
+  else
+    PathType := 1;
+  AddType := 0;
+  result := DLLAddDirToPath(DirName, PathType, AddType);
+end;
+
+// Wrapper for RemoveDirFromPath() DLL function
+function RemoveDirFromPath(const DirName: string): DWORD;
+var
+  PathType: DWORD;
+begin
+  // PathType = 0 - use system Path
+  // PathType = 1 - use user Path
+  if IsAdminInstallMode() then
+    PathType := 0
+  else
+    PathType := 1;
+  result := DLLRemoveDirFromPath(DirName, PathType);
+end;
+
+procedure RegisterPreviousData(PreviousDataKey: Integer);
+begin
+  // Store previous or current task selection as custom user setting
+  if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
+    SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true');
+end;
+
+function InitializeSetup(): Boolean;
+begin
+  result := true;
+  // Was task selected during a previous install?
+  PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
+end;
+
+function InitializeUninstall(): Boolean;
+begin
+  result := true;
+  // Was task selected during a previous install?
+  PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
+  ApplicationUninstalled := false;
+end;
+
+procedure CurStepChanged(CurStep: TSetupStep);
+begin
+  if CurStep = ssPostInstall then
+  begin
+    // Add app directory to Path at post-install step if task selected
+    if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
+      AddDirToPath(ExpandConstant('{app}'));
+  end;
+end;
+
+procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
+begin
+  if CurUninstallStep = usUninstall then
+  begin
+    // Remove app directory from path during uninstall if task was selected;
+    // use variable because we can't use WizardIsTaskSelected() at uninstall
+    if PathIsModified then
+      RemoveDirFromPath(ExpandConstant('{app}'));
+  end
+  else if CurUninstallStep = usPostUninstall then
+  begin
+    ApplicationUninstalled := true;
+  end;
+end;
+
+procedure DeinitializeUninstall();
+begin
+  if ApplicationUninstalled then
+  begin
+    // Unload and delete PathMgr.dll and remove app dir when uninstalling
+    UnloadDLL(ExpandConstant('{app}\PathMgr.dll'));
+    DeleteFile(ExpandConstant('{app}\PathMgr.dll'));
+    RemoveDir(ExpandConstant('{app}'));
+  end;
+end;

installers/win/editpath/EditPath.md

@@ -0,0 +1,118 @@
+# EditPath
+
+EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path.
+
+# Author
+
+Bill Stewart - bstewart at iname dot com
+
+# License
+
+EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details.
+
+# Download
+
+https://github.com/Bill-Stewart/PathMgr/releases/
+
+# Background
+
+The system Path is found in the following location in the Windows registry:
+
+Root: `HKEY_LOCAL_MACHINE`  
+Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment`  
+Value name: `Path`
+
+The current user Path is found in the following location in the registry:
+
+Root: `HKEY_CURRENT_USER`  
+Subkey: `Environment`  
+Value name: `Path`
+
+In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.)
+
+The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes.
+
+EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`).
+
+# Usage
+
+The following describes the command-line usage for the program. Parameters are case-sensitive.
+
+**EditPath** [_options_] _type_ _action_
+
+You must specify only one of the following _type_ parameters:
+
+| _type_       | Abbreviation | Description
+| -------      | ------------ | -----------
+| **--system** | **-s**       | Specifies the system Path
+| **--user**   | **-u**       | Specifies the user Path
+
+You must specify only one of the following _action_ parameters:
+
+| _action_                     | Abbreviation           | Description
+| --------                     | ------------           | -----------
+| **--list**                   | **-l**                 | Lists directories in Path
+| **--test "**_dirname_**"**   | **-t "**_dirname_**"** | Tests if directory exists in Path
+| **--add "**_dirname_**"**    | **-a "**_dirname_**"** | Adds directory to Path
+| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path
+
+The following parameters are optional:
+
+| _options_       | Abbreviation | Description
+| ---------       | ------------ | -----------
+| **--quiet**     | **-q**       | Suppresses result messages
+| **--expand**    | **-x**       | Expands environment variables (**--list** only)
+| **--beginning** | **-b**       | Adds to beginning of Path (**--add** only)
+
+# Exit Codes
+
+The following table lists typical exit codes when not using **--test** (**-t**).
+
+| Exit Code | Description
+| --------- | -----------
+| 0         | No errors
+| 2         | The Path value is not present in the registry
+| 3         | The specified directory does not exist in the Path
+| 5         | Access is denied
+| 87        | Incorrect parameter(s)
+| 183       | The specified directory already exists in the Path
+
+The following table lists typical exit codes when using **--test** (**-t**).
+
+| Exit Code | Description
+| --------- | -----------
+| 1         | The specified directory exists in the unexpanded Path
+| 2         | The specified directory exists in the expanded Path
+| 3         | The specified directory does not exist in the Path
+
+# Remarks
+
+* Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line.
+
+* Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded.
+
+* The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`.
+
+* The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead.
+
+* The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc.
+
+* The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account).
+
+# Examples
+
+1.  `EditPath --expand --system --list`
+
+    This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`.
+
+2.  `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"`
+
+    Adds the specified directory name to the user Path.
+
+3.  `EditPath -s -r "C:\Program Files\MyApp\bin"`
+
+    Removes the specified directory from the system Path.
+
+4.  `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"`
+
+    Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path.

installers/win/editpath/README.TXT

@@ -0,0 +1,3 @@
+Editpath installed here is extracted from Release 1.04 from https://github.com/Bill-Stewart/PathMgr.
+
+

installers/win/makeflix.iss

@@ -0,0 +1,128 @@
+; -- makeflix.iss --
+; fgh 2016-08-19
+
+#define x86_or_x64 "x86"
+#define version "1.0.1"
+
+#if x86_or_x64 == "x86" 
+#define exe_dir "Win32"
+#else
+#define exe_dir "x64"
+#endif
+
+[Setup]
+ArchitecturesAllowed={#x86_or_x64}
+AppName=Makeflix
+AppVersion={#version}
+AppPublisher=Lellan, Inc.
+AppPublisherURL=http://www.lellan.com/
+AppCopyright=Copyright (C) 2012-2017 Lellan, Inc.
+DefaultDirName={pf}\Lellan\Makeflix
+DefaultGroupName=Lellan
+UninstallDisplayIcon={app}\makeflix.exe
+Compression=lzma2
+SolidCompression=yes
+; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
+; done in "64-bit mode" on x64, meaning it should use the native
+; 64-bit Program Files directory and the 64-bit view of the registry.
+ArchitecturesInstallIn64BitMode=x64
+; Source Dir is lellan/toolchain/makeflix/windows
+SourceDir="..\"
+OutputDir="deploy"
+OutputBaseFilename="makeflix_v{#version}_{#x86_or_x64}"
+SetupIconFile="..\images\Lellan_Logo_20130221.ico"
+LicenseFile="..\deploy\EULA.rtf"
+DisableWelcomePage=no
+
+[Files]
+Source: "makeflix\{#exe_dir}\Release\makeflix.exe"; DestDir: "{app}"; DestName: "makeflix.exe"; Flags: ignoreversion
+Source: "deploy\DLLs\{#x86_or_x64}\Qt5Core.dll"; DestDir: "{app}"; Flags: ignoreversion
+Source: "deploy\DLLs\{#x86_or_x64}\Qt5Gui.dll"; DestDir: "{app}"; Flags: ignoreversion
+Source: "deploy\DLLs\{#x86_or_x64}\Qt5Widgets.dll"; DestDir: "{app}"; Flags: ignoreversion
+Source: "deploy\DLLs\{#x86_or_x64}\Qt5Network.dll"; DestDir: "{app}"; Flags: ignoreversion
+Source: "deploy\DLLs\{#x86_or_x64}\platforms\qwindows.dll"; DestDir: "{app}\platforms"; Flags: ignoreversion
+Source: "deploy\gstreamer\{#x86_or_x64}\*"; DestDir: "{app}\gstreamer"; Flags: recursesubdirs ignoreversion
+Source: "deploy\vc_redist\vc_redist.{#x86_or_x64}.exe"; DestDir: "{tmp}"; Flags: deleteafterinstall 
+Source: "deploy\bonjour\Bonjour.{#x86_or_x64}.msi"; DestDir: "{tmp}" ; Flags: deleteafterinstall
+
+Source: "..\deploy\Makeflix_Open_Source_Libraries.pdf"; DestDir: "{app}"
+
+[Icons]
+Name: "{group}\Makeflix"; Filename: "{app}\makeflix.exe"
+Name: "{group}\Uninstall Makeflix"; Filename: "{uninstallexe}"
+
+
+[Run]
+#define VCmsg "Installing Microsoft Visual C++ Redistributable ..."
+Filename: "{tmp}\vc_redist{#x86_or_x64}.exe"; StatusMsg: "{#VCmsg}"; Check: not VCinstalled
+#define BonjourMsg "Installing Apple Bonjour support ..."
+Filename: "msiexec"; Parameters: "/i {tmp}\Bonjour.{#x86_or_x64}.msi"; StatusMsg: "{#BonjourMsg}"; Check: not BonjourInstalled
+
+[Registry]
+Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "(Default)"; ValueData: "{app}\makeflix.exe"; Flags: uninsdeletekey
+Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "Path"; ValueData: "{app}\gstreamer\bin"; Flags: uninsdeletekey
+
+[Code]
+function VCinstalled: Boolean;
+ // By Michael Weiner <mailto:spam@cogit.net>
+ // Function for Inno Setup Compiler
+ // 13 November 2015
+ // Modified by Frank G Halasz to handle WOW case
+ // 23 August 2016
+ // Returns True if Microsoft Visual C++ Redistributable is installed, otherwise False.
+ // The programmer may set the year of redistributable to find; see below.
+ var
+  names: TArrayOfString;
+  i: Integer;
+  dName, key, year, platfm: String;
+ begin
+  // Year of redistributable to find; leave null to find installation for any year.
+  year := '2015';
+  Result := False;
+  if Is64BitInstallMode then
+    begin
+      platfm := 'x64'; 
+      key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
+    end
+  else if not IsWin64 then
+    begin
+      platfm := 'x86';
+      key := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
+    end
+  else
+    begin
+      platfm := 'x86';
+      key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
+    end;
+  // Get an array of all of the uninstall subkey names.
+  if RegGetSubkeyNames(HKEY_LOCAL_MACHINE, key, names) then
+   // Uninstall subkey names were found.
+   begin
+    i := 0
+    while ((i < GetArrayLength(names)) and (Result = False)) do
+     // The loop will end as soon as one instance of a Visual C++ redistributable is found.
+     begin
+      // For each uninstall subkey, look for a DisplayName value.
+      // If not found, then the subkey name will be used instead.
+      if not RegQueryStringValue(HKEY_LOCAL_MACHINE, key + '\' + names[i], 'DisplayName', dName) then
+       dName := names[i];
+      // See if the value contains both of the strings below.
+      Result := (Pos(Trim('Visual C++ ' + year),dName) * Pos('Redistributable',dName) * Pos(platfm, dName) <> 0)
+      i := i + 1;
+     end;
+   end;
+ end;
+
+ function BonjourInstalled: Boolean;
+ // Returns True if Apple Bonjour is installed, otherwise False.
+ // Ignores date/version of Bonjour.
+ begin
+  Result := False;
+  // If this key exists, then
+  // bonjour services must already be installed
+  if RegKeyExists(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Services\Bonjour Service') then
+   // Uninstall subkey names were found.
+   begin
+     Result := True;
+   end;
+ end;

installers/win/medley.iss

@@ -0,0 +1,65 @@
+;###############################################################################
+;#
+;#    medley.iss - Inno Setup compiler script for creating a Windows
+;#                 installer for the medley.ps1 powrshell script for
+;#                 running Medley within a docker container on Windows
+;#
+;#   2023-02-12 Frank Halasz
+;#
+;#   Copyright 2023 Interlisp.org
+;#
+;###############################################################################
+
+#define x86_or_x64 "x64"
+#if GetEnv('COMBINED_RELEASE_TAG') != ""
+#define VERSION=GetEnv('COMBINED_RELEASE_TAG')
+#else
+#define VERSION="local"
+#endif
+
+[Setup]
+PrivilegesRequired=lowest
+ArchitecturesAllowed={#x86_or_x64}
+AppName=Medley
+AppVersion={#version}
+AppPublisher=Interlisp.org
+AppPublisherURL=https://interlisp.org/
+AppCopyright=Copyright (C) 2023 Interlisp.org
+DefaultDirName={localappdata}\Medley\Scripts
+DefaultGroupName=Medley
+Compression=lzma2
+SolidCompression=yes
+; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
+; done in "64-bit mode" on x64, meaning it should use the native
+; 64-bit Program Files directory and the 64-bit view of the registry.
+ArchitecturesInstallIn64BitMode=x64
+OutputDir="."
+OutputBaseFilename="medley-install_{#version}_{#x86_or_x64}"
+SetupIconFile="Medley.ico"
+DisableWelcomePage=no
+MissingRunOnceIdsWarning=no
+DisableProgramGroupPage=yes
+WizardImageFile=medley_logo.bmp
+WizardSmallImageFile=medley_logo_small.bmp
+WizardImageStretch=no
+UninstallDisplayIcon="{app}\Medley.ico"
+
+
+
+[Files]
+Source: "..\..\scripts\medley\medley.ps1"; DestDir: "{app}"; DestName: "medley.ps1"; Flags: ignoreversion
+Source: "..\..\scripts\medley\medley.cmd"; DestDir: "{app}"; DestName: "medley.cmd"; Flags: ignoreversion
+Source: "editpath\x86_64\EditPath.exe"; DestDir: "{app}"; DestName: "EditPath.exe"; Flags: ignoreversion
+Source: "Medley.ico"; DestDir: "{app}"; DestName: "Medley.ico"; Flags: ignoreversion
+Source: "vncviewer64-1.12.0.exe"; DestDir: "{app}"; DestName: "vncviewer64-1.12.0.exe"; Flags: ignoreversion
+[Icons]
+Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
+Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
+
+
+[Run]
+Filename: "{app}\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden
+
+[UninstallRun]
+Filename: "{app}\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden 
+

internal/MAINTAIN.TXT

@@ -0,0 +1,2 @@
+MAINTAIN -- Network access to the PUP "Grapevine" server, which did
+            email, distribution lists. Written ~1985 mainly by Bill van Melle.

internal/MEDLEY-UTILS

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2|
 10212  
+
(FILECREATED "23-May-2023 07:10:58" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;12|
 10354  
 
-      :CHANGES-TO (VARS MEDLEY-UTILSCOMS)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
+      :CHANGES-TO (FNS GATHER-INFO)
+
+      :PREVIOUS-DATE "22-May-2023 22:57:21" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;11|)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -15,7 +17,8 @@
 (DEFINEQ
 
 (GATHER-INFO

-  (LAMBDA (PHASE)
                                         (* \; "Edited 26-Dec-2021 18:56 by larry")


+  (LAMBDA (PHASE)
                                           (* \; "Edited 22-May-2023 23:59 by lmm")


+                                                          (* \; "Edited 26-Dec-2021 18:56 by larry")


                                                           (* \; "Edited 24-Oct-2021 09:43 by larry")

     (SELECTQ PHASE
         (ALL (|for|
 I |from|
 0 |to|
 4 |do|
 (GATHER-INFO
 I)))
@@ -47,7 +50,7 @@
                                  DEFD))
            (|for|
 X |in|
 DEFINEDFNS |when|
 (CCODEP X)
               |do|
 (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
-                        (|for|
 REV |in|
 '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
+                        (|for|
 REV |in|
 '(BLOCK-CALLED-BY CALLED-BY BOUND-BY SPECIAL-BY GLOBAL-BY)
                            |as|
 VAL |in|
 Y |do|
 (|for|
 S |in|
 VAL
                                                    |do|
 (PUTPROP S REV (CONS X (GETPROP S REV)))))))
            (SETQ CALLEDFNS NIL)
@@ -170,7 +173,7 @@
          (DRIBBLE))))
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
- . 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
- 9367 . 10187)))))
+  (FILEMAP (NIL (624 7499 (GATHER-INFO 634 . 6162) (MAKE-FULLER-DB 6164 . 6854) (MEDLEY-FIX-LINKS 6856
+ . 7253) (MEDLEY-FIX-DATES 7255 . 7497)) (8538 10331 (MAKE-EXPORTS-ALL 8548 . 9507) (MAKE-WHEREIS-HASH
+ 9509 . 10329)))))
 STOP

library/PRESS

@@ -1,18 +1,21 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 5-Feb-2021 22:18:06" {DSK}<home>larry>ilisp>medley>library>PRESS.;2
 455434Q
 
-      changes to%:  (VARS PRESSCOMS)
+
(FILECREATED "10-Apr-2023 07:15:37" {DSK}<home>larry>il>medley>library>PRESS.;2
 452576Q
 
-      previous date%: "20-Jan-93 14:25:20" {DSK}<home>larry>ilisp>medley>library>PRESS.;1)
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (VARS PRESSCOMS)
+
+      :PREVIOUS-DATE " 5-Feb-2021 22:18:06" {DSK}<home>larry>il>medley>library>PRESS.;1)
 
 
 (* ; "
-Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT PRESSCOMS)
 
-(RPAQQ PRESSCOMS

+(RPAQQ PRESSCOMS
 
        [
 
 (* ;;; "PRESS printing support module")

@@ -28,7 +31,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
         
         (* ;; "Bitmap printing support")

 
-        (FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW WINDOW.BITMAP 
+        (FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW 
              \WRITEPRESSBITMAP)
         
         (* ;; "Basic PRESS data structure output functions")

@@ -101,7 +104,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
                                                          ROTATION TITLE)))
                               ((FULLPRESS RAVEN)
                                                              (* ; 
-
                                                           "same as PRESS but can scale bitmaps")

+
                                                             "same as PRESS but can scale bitmaps")

                                (CANPRINT (PRESS))
                                (STATUS TRUE)
                                (PROPERTIES NILL)
@@ -718,19 +721,6 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
           (\WRITEPRESSBITMAP
 BITMAP NIL NIL PRSTREAM)
           (RETURN (CLOSEF PRSTREAM])
 
-(WINDOW.BITMAP

-  [LAMBDA (W)
                                           (* ; "Edited 12-Jun-90 10:38 by mitani")

-                                                             (* Returns all of the bitmap of the 
-
                                                           window)

-    (PROG [BM (REGION (WINDOWPROP W 'REGION]
-          (CLOSEW W)
-          (SETQ BM (BITMAPCREATE (fetch
 (REGION WIDTH) of
 REGION)
-                          (fetch
 (REGION HEIGHT) of
 REGION)))
-          (BITBLT (WINDOWPROP W 'IMAGECOVERED)
-                 NIL NIL BM)
-          (OPENW W)
-          (RETURN BM])
-
 (\WRITEPRESSBITMAP

   [LAMBDA (BITMAP XPOS YPOS SCALEFACTOR CLIPPINGREGION PRSTREAM)

                                                             (* ; "Edited 12-Jun-90 10:39 by mitani")

@@ -2344,7 +2334,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
 (RPAQQ SPRUCEPAPERTOPSCANS
 4096)
 
 (RPAQ SPRUCEPAPERTOPMICAS
 (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch)
-                                          ScansPerIn)))
+                                      ScansPerIn)))
 
 (RPAQ SPRUCEPAPERRIGHTMICAS
 (FIX (FTIMES 8.5 \MicasPerInch)))
 
@@ -2427,85 +2417,74 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(DATATYPE PRESSDATA
 (PRHEADING                           (* The string to be printed atop 
-
                                                           each page.)

-                               PRHEADINGFONT                 (* Font to print the heading in)

-                               PRXPOS                        (* Current X position)

-                               PRYPOS                        (* Current Y position)

-                               PRFONT                        (* Current font)

-                               PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE 
-                               PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
+(DATATYPE PRESSDATA
 (PRHEADING                               (* The string to be printed atop each 
+
                                                             page.)

+                           PRHEADINGFONT                     (* Font to print the heading in)

+                           PRXPOS                            (* Current X position)

+                           PRYPOS                            (* Current Y position)

+                           PRFONT                            (* Current font)

+                           PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE 
+                           PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
                                                              (* Page left margin)

-                               (PRBOTTOM WORD)               (* Page bottom margin)

-                               (PRRIGHT WORD)                (* Page right margin)

-                               (PRTOP WORD)                  (* Page top margin)

-                               (PRPAGENUM WORD)              (* Current Page number)

-                               (PRNEXTFONT# BYTE)
-                               (PRMAXFONTSET BYTE)
-                               (PRPARTSTART INTEGER)
-                               (DLSTARTBYTE INTEGER)
-                               (ELSTARTBYTE INTEGER)
-                               (STARTCHARBYTE INTEGER)
-                               (VECMOVINGRIGHT FLAG)         (* If we're drawing a curve with 
-
                                                           vector fonts, are we moving to the 
-
                                                           right?)

-                               (VECWASDISPLAYING FLAG)
+                           (PRBOTTOM WORD)                   (* Page bottom margin)

+                           (PRRIGHT WORD)                    (* Page right margin)

+                           (PRTOP WORD)                      (* Page top margin)

+                           (PRPAGENUM WORD)                  (* Current Page number)

+                           (PRNEXTFONT# BYTE)
+                           (PRMAXFONTSET BYTE)
+                           (PRPARTSTART INTEGER)
+                           (DLSTARTBYTE INTEGER)
+                           (ELSTARTBYTE INTEGER)
+                           (STARTCHARBYTE INTEGER)
+                           (VECMOVINGRIGHT FLAG)             (* If we're drawing a curve with 
+
                                                             vector fonts, are we moving to the 
+
                                                             right?)

+                           (VECWASDISPLAYING FLAG)
 
-         (* Used during curve/line clipping to remember whether we were on-screen or 
-
       not, so we know when to force a SETXY.)

+         (* Used during curve/line clipping to remember whether we were on-screen or not, 
+
         so we know when to force a SETXY.)

 
-                               VECSEGCHARS                   (* Cache for vector characters while 
-
                                                           we're moving to the left.)

-                               VECCURX                       (* Current X position within vector 
-
                                                           code, in Dover spots)

-                               VECCURY                       (* Current Y position with vector 
-
                                                           code, in Dover spots)

-                               PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
-                                                             (* Says whether we have been 
-
                                                           printing characters inside the 
-
                                                           clipping region)

-                               PRClippingRegion
+                           VECSEGCHARS                       (* Cache for vector characters while 
+
                                                             we're moving to the left.)

+                           VECCURX                           (* Current X position within vector 
+
                                                             code, in Dover spots)

+                           VECCURY                           (* Current Y position with vector 
+
                                                             code, in Dover spots)

+                           PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
+                                                             (* Says whether we have been printing 
+
                                                             characters inside the clipping region)

+                           PRClippingRegion
 
          (* The edges of the paper, as far as PRESS is concerned.
-
       Used to protect SPRUCE users who get killed when the image goes off-paper)

+
         Used to protect SPRUCE users who get killed when the image goes off-paper)

 
-                               )
-                        PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 
-                                                             (* We assume that the origin is 
-
                                                           translated to the bottom-left of the 
-
                                                           page region)

-                        PRClippingRegion _ (create
 REGION
-                                                  LEFT _ SPRUCEPAPERLEFTMICAS
-                                                  BOTTOM _ SPRUCEPAPERBOTTOMMICAS
-                                                  WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS 
-                                                                 SPRUCEPAPERLEFTMICAS)
-                                                  HEIGHT _ 29210)
-                        [ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch
 (PRESSDATA PRRIGHT) of

-                                                                                         DATUM)
-                                                    (fetch
 (PRESSDATA PRLEFT) of
 DATUM)))
-                                    (PRHEIGHT (IDIFFERENCE (fetch
 (PRESSDATA PRTOP) of
 DATUM)
-                                                     (fetch
 (PRESSDATA PRBOTTOM) of
 DATUM)))
-                                    (PRPAGEREGION (fetch
 (PRESSDATA XPRPAGEREGION) of
 DATUM)
-                                           (PROGN (replace
 (PRESSDATA XPRPAGEREGION) of

-                                                                                         DATUM
-                                                     with
 NEWVALUE)
-                                                  (replace
 (PRESSDATA PRLEFT) of
 DATUM
-                                                     with
 (fetch
 (REGION LEFT) of
 
-                                                                                             NEWVALUE
-                                                                     ))
-                                                  (replace
 (PRESSDATA PRBOTTOM) of
 DATUM
-                                                     with
 (fetch
 (REGION BOTTOM) of

-                                                                                         NEWVALUE))
-                                                  (replace
 (PRESSDATA PRRIGHT) of
 DATUM
-                                                     with
 (IPLUS (fetch
 (REGION LEFT)
-                                                                        of
 NEWVALUE)
-                                                                     (fetch
 (REGION WIDTH)
-                                                                        of
 NEWVALUE)))
-                                                  (replace
 (PRESSDATA PRTOP) of
 DATUM
-                                                     with
 (IPLUS (fetch
 (REGION BOTTOM)
-                                                                        of
 NEWVALUE)
-                                                                     (fetch
 (REGION HEIGHT)
-                                                                        of
 NEWVALUE])
+                           )
+                    PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0  (* We assume that the origin is 
+
                                                             translated to the bottom-left of the 
+
                                                             page region)

+                    PRClippingRegion _ (create
 REGION
+                                              LEFT _ SPRUCEPAPERLEFTMICAS
+                                              BOTTOM _ SPRUCEPAPERBOTTOMMICAS
+                                              WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS 
+                                                             SPRUCEPAPERLEFTMICAS)
+                                              HEIGHT _ 29210)
+                    [ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch
 (PRESSDATA PRRIGHT) of
 DATUM)
+                                                (fetch
 (PRESSDATA PRLEFT) of
 DATUM)))
+                                (PRHEIGHT (IDIFFERENCE (fetch
 (PRESSDATA PRTOP) of
 DATUM)
+                                                 (fetch
 (PRESSDATA PRBOTTOM) of
 DATUM)))
+                                (PRPAGEREGION (fetch
 (PRESSDATA XPRPAGEREGION) of
 DATUM)
+                                       (PROGN (replace
 (PRESSDATA XPRPAGEREGION) of
 DATUM
+                                                 with
 NEWVALUE)
+                                              (replace
 (PRESSDATA PRLEFT) of
 DATUM
+                                                 with
 (fetch
 (REGION LEFT) of
 NEWVALUE))
+                                              (replace
 (PRESSDATA PRBOTTOM) of
 DATUM
+                                                 with
 (fetch
 (REGION BOTTOM) of
 NEWVALUE))
+                                              (replace
 (PRESSDATA PRRIGHT) of
 DATUM
+                                                 with
 (IPLUS (fetch
 (REGION LEFT) of
 NEWVALUE)
+                                                             (fetch
 (REGION WIDTH) of
 NEWVALUE)))
+                                              (replace
 (PRESSDATA PRTOP) of
 DATUM
+                                                 with
 (IPLUS (fetch
 (REGION BOTTOM) of
 NEWVALUE)
+                                                             (fetch
 (REGION HEIGHT) of
 NEWVALUE])
 
 (RECORD FONTDIRENTRY
 (DESCR FONT# FONTSET#))
 )
@@ -2596,7 +2575,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
 (RPAQ? DEFAULTPAGEREGION
 (CREATEREGION 2794 1905 16256 24765))
 
 (RPAQ? PRESSBITMAPREGION
 (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch))
-                                    (TIMES 10 \MicasPerInch)))
+                                (TIMES 10 \MicasPerInch)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS DEFAULTPAGEREGION)
@@ -2618,7 +2597,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
 
 
 
-(RPAQQ PRESSOPS

+(RPAQQ PRESSOPS
 
        (SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode 
              ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode 
              SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode 
@@ -2739,65 +2718,64 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
 )
 
 (ADDTOVAR IMAGESTREAMTYPES
 (PRESS (OPENSTREAM OPENPRSTREAM)
-                                      (FONTCREATE \CREATEPRESSFONT)
-                                      (CREATECHARSET \CREATECHARSET.PRESS)
-                                      (FONTSAVAILABLE \SEARCHPRESSFONTS)))
+                                  (FONTCREATE \CREATEPRESSFONT)
+                                  (CREATECHARSET \CREATECHARSET.PRESS)
+                                  (FONTSAVAILABLE \SEARCHPRESSFONTS)))
 
-(ADDTOVAR PRINTERTYPES

-          ((PRESS SPRUCE PENGUIN DOVER)
-           (CANPRINT (PRESS))
-           (STATUS PUP.PRINTER.STATUS)
-           (PROPERTIES PUP.PRINTER.PROPERTIES)
-           (SEND EFTP)
-           (BITMAPSCALE NIL)
-           (BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
-          ((FULLPRESS RAVEN)
+(ADDTOVAR PRINTERTYPES
 ((PRESS SPRUCE PENGUIN DOVER)
+                        (CANPRINT (PRESS))
+                        (STATUS PUP.PRINTER.STATUS)
+                        (PROPERTIES PUP.PRINTER.PROPERTIES)
+                        (SEND EFTP)
+                        (BITMAPSCALE NIL)
+                        (BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
+                       ((FULLPRESS RAVEN)
                                                              (* ; 
-
                                                           "same as PRESS but can scale bitmaps")

-           (CANPRINT (PRESS))
-           (STATUS TRUE)
-           (PROPERTIES NILL)
-           (SEND EFTP)
-           (BITMAPSCALE PRESS.BITMAPSCALE)
-           (BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
+
                                                             "same as PRESS but can scale bitmaps")

+                        (CANPRINT (PRESS))
+                        (STATUS TRUE)
+                        (PROPERTIES NILL)
+                        (SEND EFTP)
+                        (BITMAPSCALE PRESS.BITMAPSCALE)
+                        (BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
 
-(ADDTOVAR PRINTFILETYPES

-          [PRESS (TEST PRESSFILEP)
-                 (EXTENSION (PRESS))
-                 (CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING)
-                                                          (SETQ FILE (OPENTEXTSTREAM FILE))
-                                                          (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
-                                                                 NIL 'PRESS)
-                                                          (CLOSEF? FILE)
-                                                          PFILE])
+(ADDTOVAR PRINTFILETYPES
 [PRESS (TEST PRESSFILEP)
+                                (EXTENSION (PRESS))
+                                (CONVERSION (TEXT MAKEPRESS TEDIT
+                                                  (LAMBDA (FILE PFILE FONTS HEADING)
+                                                         (SETQ FILE (OPENTEXTSTREAM FILE))
+                                                         (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
+                                                                NIL 'PRESS)
+                                                         (CLOSEF? FILE)
+                                                         PFILE])
 (PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q
  3711Q 3745Q))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (16032Q 73011Q (\SEARCHPRESSFONTS 16044Q . 20001Q) (\GETPRESSFONTNAMES 20003Q . 26641Q) 
-(\PRESSFAMILYCODELST 26643Q . 30565Q) (\DECODEPRESSFACEBYTE 30567Q . 33356Q) (\CREATEPRESSFONT 33360Q
- . 35625Q) (\CREATECHARSET.PRESS 35627Q . 73007Q)) (73446Q 130434Q (PRESSBITMAP 73460Q . 103062Q) (
-FULLPRESSBITMAP 103064Q . 111076Q) (SHOWREGION 111100Q . 112442Q) (SHOWPRESSBITMAPREGION 112444Q . 
-113106Q) (PRESSWINDOW 113110Q . 117247Q) (WINDOW.BITMAP 117251Q . 120432Q) (\WRITEPRESSBITMAP 120434Q
- . 130432Q)) (130532Q 160405Q (\BCPLSOUT.PRESS 130544Q . 131521Q) (\PAGEPAD.PRESS 131523Q . 132760Q) (
-\ENTITYEND.PRESS 132762Q . 140256Q) (\PARTEND.PRESS 140260Q . 142645Q) (\ENTITYSTART.PRESS 142647Q . 
-146260Q) (SETX.PRESS 146262Q . 150115Q) (SETXY.PRESS 150117Q . 153121Q) (SETY.PRESS 153123Q . 154523Q)
- (SHOW.PRESS 154525Q . 160403Q)) (160467Q 275304Q (OPENPRSTREAM 160501Q . 165630Q) (\BITBLT.PRESS 
-165632Q . 170244Q) (\BLTSHADE.PRESS 170246Q . 171701Q) (\SCALEDBITBLT.PRESS 171703Q . 174327Q) (
-\BITMAPSIZE.PRESS 174331Q . 175271Q) (\CHARWIDTH.PRESS 175273Q . 177342Q) (\CLOSEF.PRESS 177344Q . 
-207333Q) (\DRAWLINE.PRESS 207335Q . 210673Q) (\ENDPAGE.PRESS 210675Q . 212145Q) (NEWLINE.PRESS 212147Q
- . 213560Q) (NEWPAGE.PRESS 213562Q . 214054Q) (SETUPFONTS.PRESS 214056Q . 217607Q) (\DEFINEFONT.PRESS 
-217611Q . 221733Q) (\DSPBOTTOMMARGIN.PRESS 221735Q . 222531Q) (\DSPCLIPPINGREGION.PRESS 222533Q . 
-224125Q) (\DSPFONT.PRESS 224127Q . 231121Q) (\DSPLEFTMARGIN.PRESS 231123Q . 232003Q) (
-\DSPLINEFEED.PRESS 232005Q . 233315Q) (\DSPRIGHTMARGIN.PRESS 233317Q . 234202Q) (\DSPSPACEFACTOR.PRESS
- 234204Q . 235610Q) (\DSPTOPMARGIN.PRESS 235612Q . 236375Q) (\DSPXPOSITION.PRESS 236377Q . 237115Q) (
-\DSPYPOSITION.PRESS 237117Q . 237635Q) (\FIXLINELENGTH.PRESS 237637Q . 241734Q) (\OUTCHARFN.PRESS 
-241736Q . 250772Q) (\SETSPACE.PRESS 250774Q . 252270Q) (\STARTPAGE.PRESS 252272Q . 256633Q) (
-\STRINGWIDTH.PRESS 256635Q . 272213Q) (SHOWRECTANGLE.PRESS 272215Q . 272736Q) (
-\PRESS.CONVERT.NSCHARACTER 272740Q . 275302Q)) (275344Q 406406Q (\ENDVECRUN 275356Q . 305174Q) (
-\VECENCODE 305176Q . 306225Q) (\VECPUT 306227Q . 315655Q) (\VECSKIP 315657Q . 316412Q) (\VECFONTINIT 
-316414Q . 323537Q) (\DRAWCIRCLE.PRESS 323541Q . 326044Q) (\DRAWARC.PRESS 326046Q . 326637Q) (
-\DRAWCURVE.PRESS 326641Q . 334577Q) (\DRAWCURVE.PRESS.LINE 334601Q . 343446Q) (\DRAWELLIPSE.PRESS 
-343450Q . 347227Q) (\GETBRUSHFONT.PRESS 347231Q . 351133Q) (\PRESSCURVE2 351135Q . 406404Q)) (412244Q 
-417070Q (\PRESSINIT 412256Q . 417066Q)) (446754Q 452043Q (MAKEPRESS 446766Q . 447272Q) (PRESSFILEP 
-447274Q . 451051Q) (PRESS.BITMAPSCALE 451053Q . 452041Q)))))
+  (FILEMAP (NIL (15752Q 72731Q (\SEARCHPRESSFONTS 15764Q . 17721Q) (\GETPRESSFONTNAMES 17723Q . 26561Q) 
+(\PRESSFAMILYCODELST 26563Q . 30505Q) (\DECODEPRESSFACEBYTE 30507Q . 33276Q) (\CREATEPRESSFONT 33300Q
+ . 35545Q) (\CREATECHARSET.PRESS 35547Q . 72727Q)) (73366Q 127171Q (PRESSBITMAP 73400Q . 103002Q) (
+FULLPRESSBITMAP 103004Q . 111016Q) (SHOWREGION 111020Q . 112362Q) (SHOWPRESSBITMAPREGION 112364Q . 
+113026Q) (PRESSWINDOW 113030Q . 117167Q) (\WRITEPRESSBITMAP 117171Q . 127167Q)) (127267Q 157142Q (
+\BCPLSOUT.PRESS 127301Q . 130256Q) (\PAGEPAD.PRESS 130260Q . 131515Q) (\ENTITYEND.PRESS 131517Q . 
+137013Q) (\PARTEND.PRESS 137015Q . 141402Q) (\ENTITYSTART.PRESS 141404Q . 145015Q) (SETX.PRESS 145017Q
+ . 146652Q) (SETXY.PRESS 146654Q . 151656Q) (SETY.PRESS 151660Q . 153260Q) (SHOW.PRESS 153262Q . 
+157140Q)) (157224Q 274041Q (OPENPRSTREAM 157236Q . 164365Q) (\BITBLT.PRESS 164367Q . 167001Q) (
+\BLTSHADE.PRESS 167003Q . 170436Q) (\SCALEDBITBLT.PRESS 170440Q . 173064Q) (\BITMAPSIZE.PRESS 173066Q
+ . 174026Q) (\CHARWIDTH.PRESS 174030Q . 176077Q) (\CLOSEF.PRESS 176101Q . 206070Q) (\DRAWLINE.PRESS 
+206072Q . 207430Q) (\ENDPAGE.PRESS 207432Q . 210702Q) (NEWLINE.PRESS 210704Q . 212315Q) (NEWPAGE.PRESS
+ 212317Q . 212611Q) (SETUPFONTS.PRESS 212613Q . 216344Q) (\DEFINEFONT.PRESS 216346Q . 220470Q) (
+\DSPBOTTOMMARGIN.PRESS 220472Q . 221266Q) (\DSPCLIPPINGREGION.PRESS 221270Q . 222662Q) (\DSPFONT.PRESS
+ 222664Q . 227656Q) (\DSPLEFTMARGIN.PRESS 227660Q . 230540Q) (\DSPLINEFEED.PRESS 230542Q . 232052Q) (
+\DSPRIGHTMARGIN.PRESS 232054Q . 232737Q) (\DSPSPACEFACTOR.PRESS 232741Q . 234345Q) (
+\DSPTOPMARGIN.PRESS 234347Q . 235132Q) (\DSPXPOSITION.PRESS 235134Q . 235652Q) (\DSPYPOSITION.PRESS 
+235654Q . 236372Q) (\FIXLINELENGTH.PRESS 236374Q . 240471Q) (\OUTCHARFN.PRESS 240473Q . 247527Q) (
+\SETSPACE.PRESS 247531Q . 251025Q) (\STARTPAGE.PRESS 251027Q . 255370Q) (\STRINGWIDTH.PRESS 255372Q . 
+270750Q) (SHOWRECTANGLE.PRESS 270752Q . 271473Q) (\PRESS.CONVERT.NSCHARACTER 271475Q . 274037Q)) (
+274101Q 405143Q (\ENDVECRUN 274113Q . 303731Q) (\VECENCODE 303733Q . 304762Q) (\VECPUT 304764Q . 
+314412Q) (\VECSKIP 314414Q . 315147Q) (\VECFONTINIT 315151Q . 322274Q) (\DRAWCIRCLE.PRESS 322276Q . 
+324601Q) (\DRAWARC.PRESS 324603Q . 325374Q) (\DRAWCURVE.PRESS 325376Q . 333334Q) (
+\DRAWCURVE.PRESS.LINE 333336Q . 342203Q) (\DRAWELLIPSE.PRESS 342205Q . 345764Q) (\GETBRUSHFONT.PRESS 
+345766Q . 347670Q) (\PRESSCURVE2 347672Q . 405141Q)) (410775Q 415621Q (\PRESSINIT 411007Q . 415617Q)) 
+(443570Q 446657Q (MAKEPRESS 443602Q . 444106Q) (PRESSFILEP 444110Q . 445665Q) (PRESS.BITMAPSCALE 
+445667Q . 446655Q)))))
 STOP

library/SYSEDIT

@@ -1,16 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Jun-2022 18:22:01" {DSK}<home>larry>medley>library>SYSEDIT.;2
 1373   
+
(FILECREATED "17-Apr-2023 14:19:03" {DSK}<home>larry>il>medley>library>SYSEDIT.;2
 1238   
+
+      :EDIT-BY "lmm"
 
       :CHANGES-TO (VARS SYSEDITCOMS)
 
-      :PREVIOUS-DATE "28-Sep-2021 10:16:44" {DSK}<home>larry>medley>library>SYSEDIT.;1)
+      :PREVIOUS-DATE "25-Jun-2022 18:22:01" {DSK}<home>larry>il>medley>library>SYSEDIT.;1)
 
 
-(* ; "
-Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
-")
-
 (PRETTYCOMPRINT SYSEDITCOMS)
 
 (RPAQQ SYSEDITCOMS

@@ -22,7 +20,7 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
               (CLISPIFTRANFLG T)
               (CROSSCOMPILING 'ASK)
               (*REPLACE-OLD-EDIT-DATES* NIL)
-              (COPYRIGHTFLG 'PRESERVE))
+              (COPYRIGHTFLG 'NEVER))
         (P (RESETVARS ((CROSSCOMPILING T))
                   (FILESLOAD (SOURCE)
                          EXPORTS.ALL])
@@ -43,12 +41,11 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ *REPLACE-OLD-EDIT-DATES*
 NIL)
 
-(RPAQQ COPYRIGHTFLG
 PRESERVE)
+(RPAQQ COPYRIGHTFLG
 NEVER)
 
 (RESETVARS ((CROSSCOMPILING T))
            (FILESLOAD (SOURCE)
                   EXPORTS.ALL))
-(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP

library/lafite/docs/README

@@ -0,0 +1,10 @@
+Lafite README
+
+the end-user documentation for Lafite in a PDF is on Google Drive
+
+https://drive.google.com/drive/folders/1Zb2IudbnlzfEK5YzTcEr7k2liclFUquE?usp=sharing
+
+Here (in the GitHub Interlisp/medley repo) 
+you will find the .TEdit sources that can be used to produce the documentation using ths utility HCFILES on the file MEDLEY-UTILS in the "internal" folder.
+
+For Lafite there are two folders, one with the (latest) documentation and one with release notes.

lispusers/GITFNS

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Oct-2022 10:55:40" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;454
 118392 
+
(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}<lispusers>GITFNS.;469
 119763 
 
-      :CHANGES-TO (COMMANDS cdg cdw)
+      :CHANGES-TO (FNS GIT-MAKE-PROJECT)
 
-      :PREVIOUS-DATE " 1-Oct-2022 12:14:04" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;453)
+      :PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}<lispusers>GITFNS.;468)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -23,18 +21,20 @@
         
         (* ;; "GIT projects")

 
-        (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PROJECT-PATH 
-                   FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?)
+        (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD 
+                   GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH 
+                   GIT-MAINBRANCH?)
               (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT PULLREQUEST))
               (INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY)
-                     [GIT-DEFAULT-PROJECTS '((MEDLEY T T
+                     [GIT-DEFAULT-PROJECTS '((MEDLEY NIL NIL
                                                     (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ 
                                                            tmp/ fontsold/ clos/ cltl2/)
                                                     (greetfiles scripts sources library lispusers 
                                                            internal doctools rooms))
-                                             (NOTECARDS T T)
-                                             (LOOPS T T)
-                                             (TEST T T]
+                                             (NOTECARDS)
+                                             (LOOPS)
+                                             (TEST)
+                                             (MAIKO]
                      (GIT-PROJECTS NIL)))
         (P (GIT-INIT))
         (ADDVARS (AROUNDEXITFNS GIT-INIT))
@@ -151,71 +151,82 @@
       ELSE
 (ERROR "NOT A GIT CLONE" HOST/DIR])
 
 (GIT-INIT

-  [LAMBDA (EVENT)
                                            (* ; "Edited  1-Oct-2022 12:13 by FGH")


+  [LAMBDA (EVENT)
                                            (* ; "Edited  1-Feb-2023 16:22 by rmk")


+                                                             (* ; "Edited  1-Oct-2022 12:13 by FGH")


                                                              (* ; "Edited  8-Aug-2022 21:52 by lmm")

     (SELECTQ EVENT
         ((NIL AFTERMAKESYS AFTERSYSOUT) 
              (SETQ GIT-PROJECTS NIL)
              (for
 X in
 GIT-DEFAULT-PROJECTS do
 (APPLY (FUNCTION GIT-MAKE-PROJECT)
-                                                      X))
+                                                      (MKLIST X)))
              NIL)
         NIL])
 
 (GIT-MAKE-PROJECT

-  [LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)

+  [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)

+                                                             (* ; "Edited 30-Mar-2023 09:06 by rmk")


+                                                             (* ; "Edited  5-Feb-2023 12:43 by rmk")


+                                                             (* ; "Edited  1-Feb-2023 16:55 by rmk")


                                                              (* ; "Edited 11-Aug-2022 17:54 by rmk")


-                                                             (* ; "Edited 13-Jul-2022 13:47 by rmk")


-                                                             (* ; "Edited  6-Jul-2022 19:34 by rmk")


-                                                             (* ; "Edited 17-May-2022 17:08 by rmk")


-                                                             (* ; "Edited 13-May-2022 10:40 by rmk")


-                                                             (* ; "Edited 12-May-2022 00:26 by rmk")


                                                              (* ; "Edited  9-May-2022 16:20 by rmk")

 
-    (* ;; "PROJECTPATH must resolve to a git clone.")

+    (* ;; "CLONEPATH must resolve to a git clone.")

 
-    (* ;; "Search sequence for PROJECTPATH, if T or NIL")

+    (* ;; "    (UNIX-GETENV PROJECTNAME)     Unix variable ROOMS is the full path name.")

 
-    (* ;; "    (UNIX-GETENV PROJECTNAME)")

+    (* ;; "    (MEDLEYDIR PROJECTNAME)         e.g. {dsk}/Users/kaplan/medley3.5/loops/")

 
-    (* ;; "    (UNIX-GETENV (CONCAT PROJECTNAME DIR)")

+    (* ;; 
+
    "    (MEDLEYDIR (CONCAT %"git-%"  PROJECTNAME)     e.g. {dsk}/Users/kaplan/medley3.5/git-medley/")

 
-    (* ;; "    git-PROJECTNAME sister of MEDLEYDIR ")

+    (* ;; 
+
    "    (MEDLEYDIR (CONCAT PROJECTNAME %"DIR%")     e.g. {dsk}/Users/kaplan/medley3.5/notecardsdir/")

 
-    (* ;; "If not found, error if NIL, return NIL if T  ")

+    (* ;; "    (MEDLEYDIR (CONCAT %"git-%"  PROJECTNAME)    ")

 
-    (* ;; "")

+    (* ;; "The clone pseudohost is PROJECTNAME  e.g. {NOTECARDS}")

+
+    (* ;; "If there is a >working-PROJECTNAME> parallel to clonepath, its pseudhost is WPROJECTNAME, e.g. WNOTECARDS")

+
+    (* ;; "Error if clone is not found.")

 
     (* ;; "WORKINGPATH T or NIL means try to find a parallel to the projectpath, T means don't cause an error if not found. ")

 
-    (SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME)))
-    (CL:WHEN (MEMB PROJECTPATH '(NIL T))
-        [SETQ PROJECTPATH (OR (GIT-CLONEP
 (MEDLEYDIR (L-CASE PROJECTNAME)
-                                                 NIL NIL T)
-                                     T)
-                              (GIT-CLONEP
 (UNIX-GETENV PROJECTNAME)
-                                     T)
-                              (GIT-CLONEP
 (UNIX-GETENV (PACK* PROJECTNAME 'DIR))
-                                     T)
-                              (GIT-CLONEP
 (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE 
-                                                                                          PROJECTNAME
-                                                                                            )
-                                                                "/"))
-                                     T)
-                              (AND (NULL PROJECTPATH)
-                                   (ERROR (CONCAT "Can't a find clone directory for " PROJECTNAME])
-    (CL:WHEN PROJECTPATH
-        (LET (CLONEPATH GITIGNORE PROJECT GITPATH WP)
-             (SETQ PROJECTPATH (SLASHIT (PACKFILENAME 'HOST 'UNIX 'DIRECTORY (UNPACKFILENAME.STRING
-                                                                              (TRUEFILENAME 
-                                                                                     PROJECTPATH)
-                                                                              'DIRECTORY
-                                                                              'RETURN))
-                                      T))
-             (SETQ CLONEPATH (if
 (GIT-CLONEP
 PROJECTPATH T T)
-                               elseif
 (SETQ GITPATH (GIT-PROJECT-PATH
 PROJECTNAME PROJECTPATH))
-                                 then
 (SETQ PROJECTPATH GITPATH)
-                                      (GIT-CLONEP
 PROJECTPATH NIL T)
-                               else
 (ERROR "Can't find GIT clone for" PROJECTPATH)))
+    [SETQ CLONEPATH (if
 (MEMB CLONEPATH '(NIL T))
+                        then
 
+                             (* ;; "The %"DIR%" handles MEDLEY -> MEDLEYDIR or LOOPS -> LOOPSDIR.")

+
+                             (* ;; "")

+
+                             (OR (GIT-CLONEP
 (UNIX-GETENV PROJECTNAME)
+                                        T)
+                                 (GIT-CLONEP
 (UNIX-GETENV (PACK* PROJECTNAME "DIR"))
+                                        T)
+                                 (GIT-CLONEP
 (MEDLEYDIR (L-CASE PROJECTNAME)
+                                                    NIL NIL T)
+                                        T)
+                                 (GIT-CLONEP
 (MEDLEYDIR (CONCAT "../" PROJECTNAME)
+                                                    NIL NIL T)
+                                        T)
+                                 (GIT-CLONEP
 (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE
+                                                                                         PROJECTNAME)
+                                                                   "/"))
+                                        T)
+                                 (CL:IF CLONEPATH
+                                     (ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME))
+                                     (PRINTOUT T "Note: Can't find a clone directory for " 
+                                            PROJECTNAME T)))
+                      elseif
 (GIT-CLONEP
 (SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY
+                                                         (UNPACKFILENAME.STRING (TRUEFILENAME 
+                                                                                       CLONEPATH)
+                                                                'DIRECTORY
+                                                                'RETURN))
+                                                T)
+                                    T T)
+                      else
 (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for " 
+                                         PROJECTNAME]
+    (CL:WHEN CLONEPATH
+        (LET (GITIGNORE PROJECT WP)
              (CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY 
                                                       CLONEPATH)))
                  (SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE)
@@ -231,58 +242,39 @@
                                      :TEST
                                      (FUNCTION STRING.EQUAL)))
 
-             (* ;; "The %"my-%" case is for backward compatibility, eventually deprecated.")

+             (* ;; "We now have the clonepath and the extra parameters for the project.  Do we have a separate working environment?")

 
              (SETQ WP
               (SELECTQ WORKINGPATH
                   ((T NIL) 
-                       (OR (DIRECTORYNAME (PACKFILENAME.STRING
-                                           'HOST
-                                           'DSK
-                                           'BODY
-                                           (CONCAT (SUBSTRING CLONEPATH 1
-                                                          (STRPOS "/" CLONEPATH -2 NIL NIL NIL 
-                                                                 FILEDIRCASEARRAY T))
-                                                  "working-"
-                                                  (OR (SUBSTRING PROJECTPATH
-                                                             (OR (STRPOS CLONEPATH PROJECTPATH 1 NIL
-                                                                        NIL T FILEDIRCASEARRAY)
-                                                                 -2))
-                                                      (L-CASE PROJECTNAME))
-                                                  ">"))
-                                  T)
-                           (DIRECTORYNAME (PACKFILENAME.STRING
-                                           'HOST
-                                           'DSK
-                                           'BODY
-                                           (CONCAT (SUBSTRING CLONEPATH 1
-                                                          (STRPOS "/" CLONEPATH -2 NIL NIL NIL 
-                                                                 FILEDIRCASEARRAY T))
-                                                  "my-"
-                                                  (OR (SUBSTRING PROJECTPATH
-                                                             (OR (STRPOS CLONEPATH PROJECTPATH 1 NIL
-                                                                        NIL T FILEDIRCASEARRAY)
-                                                                 -2))
-                                                      (L-CASE PROJECTNAME))
-                                                  ">"))
-                                  T)))
+                       (DIRECTORYNAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY
+                                             (CONCAT (SUBSTRING CLONEPATH 1
+                                                            (STRPOS "/" CLONEPATH -2 NIL NIL NIL 
+                                                                   FILEDIRCASEARRAY T))
+                                                    "working-"
+                                                    (OR (SUBSTRING CLONEPATH
+                                                               (OR (STRPOS CLONEPATH CLONEPATH 1 NIL
+                                                                          NIL T FILEDIRCASEARRAY)
+                                                                   -2))
+                                                        (L-CASE PROJECTNAME))
+                                                    ">"))
+                              T))
                   (DIRECTORYNAME (TRUEFILENAME WORKINGPATH)
                          T)))
              [SETQ WORKINGPATH (if
 WP
                                    then
 (UNSLASHIT WP T)
-                                 elseif
 (EQ WORKINGPATH T)
-                                   then
 NIL
-                                 else
 (ERROR (CONCAT "Can't find the working directory "
-                                                    (OR WORKINGPATH "")
-                                                    " for " PROJECTNAME]
+                                 elseif
 WORKINGPATH
+                                   then
 (ERROR (CONCAT "Can't find the working directory "
+                                                      (AND (EQ WORKINGPATH T)
+                                                           "")
+                                                      " for " PROJECTNAME]
              (SETQ PROJECT (create
 GIT-PROJECT
                                   PROJECTNAME _ PROJECTNAME
-                                  GITHOST _ (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
-                                                              PROJECTPATH)
+                                  GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
                                                    "}")
                                   WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" 
                                                                                          PROJECTNAME)
-                                                                             WP)
+                                                                             WORKINGPATH)
                                                                   "}"))
                                   EXCLUSIONS _ EXCLUSIONS
                                   DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
@@ -321,6 +313,34 @@
                                                                            ])
             PROJECT))])
 
+(GIT-PUT-PROJECT-FIELD

+  [LAMBDA (PROJECT FIELD NEWVALUE)
                           (* ; "Edited 11-Mar-2023 23:00 by rmk")


+                                                             (* ; "Edited  7-Jul-2022 11:25 by rmk")


+                                                             (* ; "Edited 13-May-2022 10:40 by rmk")


+                                                             (* ; "Edited  9-May-2022 20:02 by rmk")


+                                                             (* ; "Edited  8-May-2022 11:38 by rmk")

+
+    (* ;; "Replaces the value of a project field with NEWVALUE.  The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface.  One use:  augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings")

+
+    (CL:WHEN (SETQ PROJECT (IF
 (TYPE?
 GIT-PROJECT PROJECT)
+                               THEN
 PROJECT
+                             ELSEIF
 (CDR (ASSOC (OR (U-CASE PROJECT)
+                                                    GIT-DEFAULT-PROJECT)
+                                                GIT-PROJECTS))
+                             ELSEIF
 NOERROR
+                               THEN
 NIL
+                             ELSE
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
+        (SELECTQ FIELD
+            (PROJECTNAME (REPLACE
 PROJECTNAME OF
 PROJECT WITH
 NEWVALUE))
+            (WHOST (REPLACE
 WHOST OF
 PROJECT WITH
 NEWVALUE))
+            (GITHOST (REPLACE
 GITHOST OF
 PROJECT WITH
 NEWVALUE))
+            (EXCLUSIONS (REPLACE
 EXCLUSIONS OF
 PROJECT WITH
 NEWVALUE))
+            (DEFAULTSUBDIRS 
+                 (REPLACE
 DEFAULTSUBDIRS OF
 PROJECT WITH
 NEWVALUE))
+            (CLONEPATH (REPLACE
 CLONEPATH OF
 PROJECT WITH
 NEWVALUE))
+            (MAINBRANCH (REPLACE
 MAINBRANCH OF
 PROJECT WITH
 NEWVALUE))
+            PROJECT))])
+
 (GIT-PROJECT-PATH

   [LAMBDA (PROJECTNAME PROJECTPATH)
                          (* ; "Edited  8-May-2022 15:10 by rmk")

 
@@ -391,11 +411,12 @@
 (RPAQ? GIT-DEFAULT-PROJECT
 'MEDLEY)
 
 (RPAQ? GIT-DEFAULT-PROJECTS

-       '((MEDLEY T T (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
+       '((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
                 (greetfiles scripts sources library lispusers internal doctools rooms))
-         (NOTECARDS T T)
-         (LOOPS T T)
-         (TEST T T)))
+         (NOTECARDS)
+         (LOOPS)
+         (TEST)
+         (MAIKO)))
 
 (RPAQ? GIT-PROJECTS
 NIL)
 
@@ -2213,31 +2234,32 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (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)))))
+  (FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . 
+13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435
+ . 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915
+ . 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS 
+28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) 
+(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR 
+34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME
+ 36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE 
+38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH 
+40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) (
+GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) (
+GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) (
+GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524
+) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT 
+60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . 
+66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727)
+ (GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487)
+) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) (
+GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE 
+75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR 
+79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) (
+GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . 
+106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) (
+GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND 
+111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE 
+114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL 
+119031 . 119694)))))
 STOP

lispusers/GITFNS.TEDIT

@@ -1,95 +1,148 @@
-Medley	GITFNS2
+Medley	GITFNS
2
 
4
 
1
 
GITFNS
1
 
4
-
By Ron Kaplan
This document was last edited in May  2022.

GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository.  This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file.  This may be particularly helpful in evaluating the changes in a pull request.
-Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions.  GITFNS allows for intelligent comparisons between Lisp source files,Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
+
By Ron Kaplan
This document was last edited in February  2023.

GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository.  This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file.  This may be particularly helpful in evaluating the changes in a pull request.
+Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions.  GITFNS allows for intelligent comparisons between Lisp source files, Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
 
 Git projects:  Connecting git clones to GITFNS capabilities 
-The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk.  The path to a clone can be used to create a "git project" for  that clone:
-(GIT-MAKE-PROJECT PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS 
-                  DEFAULTSUBDIRS)     [function]
+The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk.  The path to a clone can be used to create a GITFNS "project" for  that clone:
+(GIT-MAKE-PROJECT PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS 
+                  DEFAULTSUBDIRS)	[Function]
 where
-	PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...) 
-  PROJECTPATH is the local path to the clone
-            (e.g. {dsk}<users>...>git-medley)
+  PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...) 
+  CLONEPATH specifies the local path to the clone
+            e.g. {dsk}<users>...>git-medley
   WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}<users>...>working-medley>)
-When the project has a WORKINGPATH:
-  EXCLUSIONS is a list of files and directories to be excluded from comparisons (beyond what its .GITIGNORE specifies)
+When the project has a working path:
+  EXCLUSIONS is a list of files and directories to be excluded from comparisons (including what its .gitignore specifies)
   DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified.
-
-For convenience, if PROJECTPATH is NIL or T (and not a path), then a squence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
-    (UNIX-GETENV PROJECTNAME)
-    (UNIX-GETENV (CONCAT PROJECTNAME 'DIR)
-    (CONCAT MEDLEYDIR "../git-" PROJECTNAME)  
+For convenience, if CLONEPATH is NIL or T (and not a path), then a sequence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
+  (UNIX-GETENV PROJECTNAME)    e.g. (UNIX-GETENV 'LOOPS)
+  (UNIX-GETENV (CONCAT PROJECTNAME "DIR") e.g.{UNIX-GETENV 'LOOPSDIR)
+  (MEDLEYDIR PROJECTNAME))    a subdirectory of MEDLEYDIR 
+  (MEDLEYDIR  (CONCAT "../" PROJECTNAME))  a sister of MEDLEYDIR
+  (MEDLEYDIR (CONCAT "../git-" PROJECTNAME)  
         (a sister of MEDLEYDIR named git-PROJECTNAME, e.g. git-notecards)
 Thus:
 If MEDLEYDIR is defined,
-   (GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY  project
+   (GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project
 If NOTECARDS is defined
    (GIT-MAKE-PROJECT 'NOTECARDS) will make the NOTECARDS project
 If NOTECARDS is not defined but the clone >git-notecards> is a sister of MEDLEYDIR, then the NOTECARDS project will still be created.
-If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME.  Otherwise,  NIL will be returned if PROJECTPATH is T (= no-error), and PROJECTPATH=NIL will result in an error.
+If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME.  Otherwise, NIL will be returned if CLONEPATH is T (= no-error), and CLONEPATH=NIL will result in an error.
+When they are created, git projects are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
+The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional PROJECTNAME argument is not provided.
+GIT-MAKE-PROJECT creates a pseudohost {projectname} whose path prefix is the path that resolved to the clone.  The file GITFNS in the clone LISPUSERS directory, for example, can be referenced as {MEDLEY}<LISPUSERS>GITFNS.
+GIT-MAKE-PROJECT will also create a pseudohost {Wprojectname} for the user's working environment for the project. If WORKINGPATH is provided, that will be the prefix for that pseudohost. If WORKINGPATH is NIL and a directory named working-projectname> is a sister to the clone directory, the pseudohost will point to that. 
 
-When GITFNS is loaded, GIT-MAKE-PROJECT is called for MEDLEY, NOTECARDS, and LOOPS, with PROJECTPATH=T. Thus, those projects will be created automatically, if MEDLEYDIR is defined and the relevant directories exist in their expected relative positions.
-When they are created, GIT-PROJECTS are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
-The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional projectname argument is not provided.
-GIT-MAKE-PROJECT also creates a pseudohost {Gprojectname} whose path prefix is the prefix for the project's clone.  If WORKINGPATH is provided, then a second pseudohost {Wprojectname} points to the working files for the project.
-GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
-cdg (projectname) (subdir)    [command]
-cdw (projectname) (subdir)    [command
-For example, cdg notecards library  connects to {GNOTECARDS}/library/.
+(GIT-INIT EVENT)     	[Function]
+GIT-INIT creates the default set of projects when GITFNS is loaded, as specified in the variable GIT-DEFAULT-PROJECTS, initially containing MEDLEY NOTECARDS LOOPS TEST. GIT-INIT is added to AROUNDEXITFNS so that new pseudohost bindings for the default projects will be created if the sysout or makesys is started on a new machine.
+
+GIT-DEFAULT-PROJECTS     	[Variable]
+Determines the projects that are created (or recreated) by GIT-INIT. This is initialized for the MEDLEY NOTECARDS LOOPS TEST projects, with CLONEPATH=NIL
GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
+cdg (projectname) (subdir)    	[Command]
+cdw (projectname) (subdir)    	[Command]
+For example, cdg notecards library  connects to {NOTECARDS}/library/.
 
 Comparing directories and files in different git branches
 In its simplest application, GITFNS is just an off-to-the-side add-on to whatever work practices the user has developed with respect to a locally installed git project.  Its only advantage is to allow for more interpretable git-branch comparisons, especially for pull-request approval. These comparisons are provided by the prc ("pull request compare") Medley executive command:
-prc  (branch)   (DRAFT)  (projectname)   [command]
-This compares the files in branch against the files in the main branch of the project (origin/master or origin/main).  Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project.  Then
-    prc rmk15 
+prc  (branch)   (DRAFT)  (projectname)	[Command]
This compares the files in branch against the files in the main branch of the project (origin/master or origin/main).  Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project.  Then
   prc rmk15 
 brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser.
 If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided.  If gh is not available, the menu will offer all known branches.  If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones.
 If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by
      rmk15 > rmk14
-Note that the prc comparison is  read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
-
-prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
-bbc  branch1   branch2  (project)     [command]
-This compares the files in branch1 and branch2, for example
+Note that the prc comparison is  read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
prc is the special case of the more general bbc command ("branch-branch compare") for comparing the files in any two branches:
+bbc  branch1   branch2  (project)	[Command]
This compares the files in branch1 and branch2, for example
      bbc rmk15 lmm12   (local)
 This will compare the files in origin/rmk15 and origin/lmm12 in the GIT-DEFAULT project.  branch1 defaults to the origin files of the currently checked out branch, the second defaults to origin/master.  If local is non-NIL, then a branch that has neither local/ or origin/ prepended will default to local (e.g. local/rmk15) instead of origin/.  Local refers to the files that are currently in the clone directory, which may not be the same as the origin files, depending on the push/pull status.  
 Either of the branches can be specified with an atom LOCAL, REMOTE, or ORIGIN, in which case bbc will offer menus listing the currently existing branches of that type.
-NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare.  A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally.
-
-The command cob ("check out branch") checks out a specified branch:
-cob  branch  (nexttitlestring) (project)      [command]
+NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare.  A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally.
The command cob ("check out branch") checks out a specified branch:
+cob  branch  (next-title-string) (project)	[Command]
 This checks out branch of project and then executes git pull.  The branch parameter may also be a local branch, T (= the current working branch), or NEW/NEXT (= the next working branch).  The current working branch is the branch named <initials>nnn, e.g. rmk15.  The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials.
-If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch.  Its number  is one greater than the largest number of previous initialed branches. If nexttitlestring is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens.  Spaces in nexttitlestring will also be replaced by hyphens, according to git conventions.
-If branch is not provided, a menu of locally available branches pops up.
-
-The currently checked out branch is obtained by the b? command:
-b?  (project)    [command]
-
+If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch.  Its number  is one greater than the largest number of previous initialed branches. If next-title-string is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens.  Spaces in next-title-string will also be replaced by hyphens, according to git conventions.
+If branch is not provided, a menu of locally available branches pops up.
The currently checked out branch is obtained by the b? command:
+b?  (project)	[Command]
 Correlating git source control with separate Medley development
 It is generally unsafe to do Medley development by operating with files in a local clone repository.  Medley provides a residential development environment that integrates tightly with the local file system.  It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from.  This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes.
 GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory.  The location of the Medley development source tree for a project is given by the WORKINGPATH argument to GIT-MAKE-PROJECT.  If WORKINGPATH is T or NIL and there exists a directory >working-projectname> as a sister to the clone, then that is taken to be the WORKINGPATH and thus the prefix for a pseudohost {Wprojectname}.
 When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR (or {WMEDLEY}) as a prefix.  In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR.
 Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions.  Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention.
 The files in Medley working tree and the git clone of a project can be compared with the gwc ("git-working-compare") command:
-gwc  subdirectories (project)       [command]
-This produces a browser for all the files in the corresponding WORKINGPATH  subdirectories that differ from the files in the currently checked out branch of the git clone.  If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
-In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}. 
+gwc  subdirectories (project)	[Command]
+This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone.  If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
+In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {projectname} to {Wprojectname} and deleting files from {Wprojectname}. 
 If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers.  If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.  
-Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
-GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
-(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))
.
È
4
È


È
4
È



È
4
È



È
4
È



È
4
È




È
4
È



È
4
È


È
4
È


È
.
È.ŠŠ
8.ŠŠ
8J
È

È
PAGEHEADINGRUNNINGHEADTERMINAL
+Note that the menu item for deleting Medley files will cause all versions to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deleted> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
+GITFNS does not (yet?) include functions for commits, pushes, or merge for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
+(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))).
È
.
È
4
È


È
4
È



È
4
È



È
4
È



È
4
È




È
4
È



È
4
È


È
4
È


È
.
È.ŠŠ
8.ŠŠ
8J
È

È
PAGEHEADINGRUNNINGHEADTERMINAL
 MODERN
 TIMESROMAN$TERMINALMODERN
 MODERNMODERN
 MODERN
-

HRULE.GETFN

HRULE.GETFN
MODERN
-

HRULE.GETFN
MODERN
-

HRULE.GETFN
MODERN

HRULE.GETFN
MODERN

-	,	
	
R	Íè	
	;	âB1	L-.Š$w a		<00>			
		/	27#h	ð	
	ß		n		ƒ		Ç	ƒ	(	'
G





		
!				=c				5
3 $	
	
-	Ç,		I			À	
	)1							
		<’ö	5
H	
-	
	&	0			%9"?

M	

s		I	
	"




"		¶		¾
w6	D	l		B
Z	D	
-Ù	D	
-.
(	
	‡2	D	
	‡	Uf
-
<	D	
	õz	D	
	œ.D
‚zº
+
HRULE.GETFN
MODERN
+


HRULE.GETFN
MODERN
+


HRULE.GETFN
MODERN
+

HRULE.GETFN
MODERN


HRULE.GETFN
MODERN

+1
+

+

R
+
Í
é
+

+;
+
¹
@
,


+

+
"
	

	
&



\




+
X
+


p
		



6
,



+
	


+)

+
	

+)
	


++

	





	




5
	

	

	
	


+@

&	





+I
7
+


o
+


E
	
.

+

8
>

I
+

+ 


+
Y





€
+

+$


+;









+
}
+(


+)





9

+

!

+0


+
4



c

+
	

+

5


v
B
	

+1
O
L
J
+
'
'
+

+
œ
+
)
2
++


+





+

+



Z



!





œ
+5



H
+

+
5
+5

+
>

$
N


!


M
+


§
‹
A
+
@
+4

+
+

@Ô
+â





k
6
.
	
R


	
	
<
9

	

+
'
+Y
"	(
	?
“


F
+<00>



+
+ì
Ë
+ò1S
ýzº

lispusers/PRETTYFILEINDEX

@@ -1,17 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 3-Jul-2022 15:28:08" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;11
 100587 
+
(FILECREATED "10-May-2023 09:12:17" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;12
 101009 
 
-      :CHANGES-TO (FNS PFI.PRINT.BITMAP)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE " 5-May-2022 23:33:03" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;10)
+      :CHANGES-TO (FNS PFI.PRINT.FILECREATED)
 
+      :PREVIOUS-DATE " 3-Jul-2022 15:28:08" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;11
+)
 
-(* ; "
-Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT PRETTYFILEINDEXCOMS)
 
@@ -453,7 +450,8 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 (DEFINEQ
 
 (PFI.PRINT.FILECREATED

-  [LAMBDA (EXPR ENV)
                                         (* ; "Edited  5-May-2022 21:53 by rmk")


+  [LAMBDA (EXPR ENV)
                                         (* ; "Edited 10-May-2023 08:43 by lmm")


+                                                             (* ; "Edited  5-May-2022 21:53 by rmk")


                                                            (* ; "Edited 30-Nov-2021 22:08 by larry")


                                                            (* ; "Edited 30-Nov-2021 21:40 by larry")


                                                             (* ; "Edited  9-Jul-2021 07:59 by rmk:")

@@ -465,77 +463,88 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
 
     (pop
 EXPR)
     (CHANGEFONT ITALICFONT)
-    (LET* [(STRINGS '("File created:  " "changes to:  " "previous date:  " "Read Table:  " 
-                            "Package:  " "Base:  " "Format:  "))
-           (FONT (DSPFONT))
-           (STRWIDTHS (for
 STR in
 STRINGS collect
 (STRINGWIDTH STR FONT)))
-           (TABSTOP (+ (DSPLEFTMARGIN)
-                       (APPLY (FUNCTION MAX)
-                              STRWIDTHS]
-          (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                 (pop
 STRWIDTHS)
-                 TABSTOP)                                    (* ; "File created:")

-          (PRINTOUT NIL (pop
 EXPR)
-                 "  " .FONT LAMBDAFONT (pop
 EXPR)
-                 T T)                                        (* ; "date and file name")

-          (if
 (OR (NULL (CAR EXPR))
-                  (FIXP (CAR EXPR)))
-              then
                                           (* ; "Skip over filemaploc")

-                   (pop
 EXPR))
-          (if
 (SELECTQ (CAR EXPR)
-                  (changes (SETQ EXPR (CDR EXPR))
-                           T)
-                  (:CHANGES-TO T)
-                  NIL)
-              then
                                           (* ; "handle %"Changes to:%"")

-                   (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                          (pop
 STRWIDTHS)
-                          TABSTOP)
-                   (SETQ EXPR (CDR EXPR))
-                   (PRINTDEF (while
 (LISTP (CAR EXPR)) collect
 (pop
 EXPR))
-                          T NIL T)
-                   (TERPRI)
-                   (TERPRI)
-            else
 (pop
 STRINGS)
-                 (pop
 STRWIDTHS))
-          (if
 (SELECTQ (CAR EXPR)
-                  (previous (SETQ EXPR (CDR EXPR))
+    (PROG* [(STRINGS '("File created:  " "edit by: " "changes to:  " "previous date:  " 
+                             "Read Table:  " "Package:  " "Base:  " "Format:  "))
+            (FONT (DSPFONT))
+            (STRWIDTHS (for
 STR in
 STRINGS collect
 (STRINGWIDTH STR FONT)))
+            (TABSTOP (+ (DSPLEFTMARGIN)
+                        (APPLY (FUNCTION MAX)
+                               STRWIDTHS]
+           (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                  (pop
 STRWIDTHS)
+                  TABSTOP)                                   (* ; "File created:")

+           (PRINTOUT NIL (pop
 EXPR)
+                  "  " .FONT LAMBDAFONT (pop
 EXPR)
+                  T T)                                       (* ; "date and file name")

+           (if
 (OR (NULL (CAR EXPR))
+                   (FIXP (CAR EXPR)))
+               then
                                          (* ; "Skip over filemaploc")

+                    (pop
 EXPR))
+           (IF
 (EQ (CAR EXPR)
+                   :EDIT-BY)
+               THEN
 (PFI.PRINT.TO.TAB
 (POP
 STRINGS)
+                           (POP
 STRWIDTHS)
+                           TABSTOP)
+                    (POP
 EXPR)
+                    (PRIN1 (POP
 EXPR))
+                    (TERPRI)
+                    (TERPRI)
+             ELSE
 (POP
 STRINGS)
+                  (POP
 STRWIDTHS))
+           (if
 (SELECTQ (CAR EXPR)
+                   (changes (SETQ EXPR (CDR EXPR))
                             T)
-                  (:PREVIOUS-DATE 
-                       T)
-                  NIL)
-              then
                                           (* ; "Handle %"Previous date:%"")

-                   (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                          (pop
 STRWIDTHS)
-                          TABSTOP)
-                   (SETQ EXPR (CDR EXPR))
-                   (PRINTOUT NIL (pop
 EXPR)
-                          "  "
-                          (pop
 EXPR)
-                          T T)
-            else
 (pop
 STRINGS)
-                 (pop
 STRWIDTHS))
+                   (:CHANGES-TO T)
+                   NIL)
+               then
                                          (* ; "handle %"Changes to:%"")

+                    (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                           (pop
 STRWIDTHS)
+                           TABSTOP)
+                    (SETQ EXPR (CDR EXPR))
+                    (PRINTDEF (while
 (LISTP (CAR EXPR)) collect
 (pop
 EXPR))
+                           T NIL T)
+                    (TERPRI)
+                    (TERPRI)
+             else
 (pop
 STRINGS)
+                  (pop
 STRWIDTHS))
+           (if
 (SELECTQ (CAR EXPR)
+                   (previous (SETQ EXPR (CDR EXPR))
+                             T)
+                   (:PREVIOUS-DATE 
+                        T)
+                   NIL)
+               then
                                          (* ; "Handle %"Previous date:%"")

+                    (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                           (pop
 STRWIDTHS)
+                           TABSTOP)
+                    (SETQ EXPR (CDR EXPR))
+                    (PRINTOUT NIL (pop
 EXPR)
+                           "  "
+                           (pop
 EXPR)
+                           T T)
+             else
 (pop
 STRINGS)
+                  (pop
 STRWIDTHS))
 
-          (* ;; "Show environment")

+     (* ;; "Show environment")

 
-          (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                 (pop
 STRWIDTHS)
-                 TABSTOP)                                    (* ; "Read table")

-          (PFI.PRINT.ENVIRONMENT
 ENV :READTABLE)
-          (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                 (pop
 STRWIDTHS)
-                 TABSTOP)                                    (* ; "Package")

-          (PFI.PRINT.ENVIRONMENT
 ENV :PACKAGE)
-          (if
 (NEQ *PRINT-BASE* 10)
-              then
 (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                          (pop
 STRWIDTHS)
-                          TABSTOP)
-                   (PFI.PRINT.ENVIRONMENT
 ENV :BASE)
-            else
 (pop
 STRINGS))
-          (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
-                 (pop
 STRWIDTHS)
-                 TABSTOP)                                    (* ; "Format")

-          (PFI.PRINT.ENVIRONMENT
 ENV :FORMAT])
+           (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                  (pop
 STRWIDTHS)
+                  TABSTOP)                                   (* ; "Read table")

+           (PFI.PRINT.ENVIRONMENT
 ENV :READTABLE)
+           (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                  (pop
 STRWIDTHS)
+                  TABSTOP)                                   (* ; "Package")

+           (PFI.PRINT.ENVIRONMENT
 ENV :PACKAGE)
+           (if
 (NEQ *PRINT-BASE* 10)
+               then
 (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                           (pop
 STRWIDTHS)
+                           TABSTOP)
+                    (PFI.PRINT.ENVIRONMENT
 ENV :BASE)
+             else
 (pop
 STRINGS))
+           (PFI.PRINT.TO.TAB
 (pop
 STRINGS)
+                  (pop
 STRWIDTHS)
+                  TABSTOP)                                   (* ; "Format")

+           (PFI.PRINT.ENVIRONMENT
 ENV :FORMAT])
 
 (PFI.PRINT.TO.TAB

   [LAMBDA (STR WIDTH TABSTOP)
                                (* ; "Edited 29-Mar-88 12:44 by bvm")

@@ -1184,30 +1193,29 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
            'NILL)
        'NON.PFI.PRINT.BITMAP NIL T)
 )
-(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10069 12304 (PFI.NEW.LISTFILES1 10079 . 10573) (PFI.ENQUEUE 10575 . 11199) (
-\PFI.DO.HARDCOPY 11201 . 11787) (MAYBE.PRETTYFILEINDEX 11789 . 12302)) (12305 34820 (PRETTYFILEINDEX 
-12315 . 26348) (PFI.MAKE.LPT.STREAM 26350 . 29401) (PFI.SETUP.TRANSLATIONS 29403 . 30917) (
-PFI.OUTCHARFN 30919 . 32893) (PFI.COLLECT.DEFINERS 32895 . 33707) (PFI.AFTER.NEW.PAGE 33709 . 34818)) 
-(34821 40734 (PFI.PRINT.FILECREATED 34831 . 38921) (PFI.PRINT.TO.TAB 38923 . 39368) (
-PFI.PRINT.ENVIRONMENT 39370 . 40732)) (40735 48250 (PFI.PROCESS.FILE 40745 . 41975) (PFI.PASS.COMMENT 
-41977 . 42947) (PFI.HANDLE.EXPR 42949 . 43616) (PFI.DEFAULT.HANDLER 43618 . 45671) (PFI.PRETTYPRINT 
-45673 . 46008) (PFI.LINES.REMAINING 46010 . 46337) (PFI.MAYBE.NEW.PAGE 46339 . 47173) (
-PFI.ESTIMATE.SIZE 47175 . 47706) (PFI.ESTIMATE.SIZE1 47708 . 48248)) (48287 58496 (PFI.HANDLE.RPAQQ 
-48297 . 49705) (PFI.HANDLE.DECLARE 49707 . 50646) (PFI.HANDLE.EVAL-WHEN 50648 . 51131) (
-PFI.HANDLE.DEFDEFINER 51133 . 52423) (PFI.HANDLE.DEFINEQ 52425 . 52669) (PFI.PRINT.LAMBDA 52671 . 
-53009) (PFI.PRINT.LAMBDA.BODY 53011 . 53346) (PFI.HANDLE.PUTDEF 53348 . 53845) (PFI.HANDLE.PUTPROPS 
-53847 . 54462) (PFI.HANDLE./DECLAREDATATYPE 54464 . 55011) (PFI.HANDLE.* 55013 . 56275) (
-PFI.PRINT.COMMENTS 56277 . 57899) (PFI.HANDLE.FILEMAP 57901 . 58189) (PFI.HANDLE.PACKAGE 58191 . 58494
-)) (58524 59516 (PFI.PREVIEW.DECLARE 58534 . 59196) (PFI.PREVIEW.DEFINEQ 59198 . 59514)) (59552 70540 
-(PFI.PRINT.INDEX 59562 . 60413) (PFI.CONDENSE.INDEX 60415 . 62222) (PFI.SORT.INDICES 62224 . 63363) (
-PFI.COMPUTE.INDEX.SHAPE 63365 . 64829) (PFI.PRINT.INDICES 64831 . 69373) (PFI.CENTER.PRINT 69375 . 
-69945) (PFI.INDEX.BREAK 69947 . 70405) (PFI.LOOKUP.NAME 70407 . 70538)) (70541 71772 (PFI.ADD.TO.INDEX
- 70551 . 71061) (PFI.VARNAME 71063 . 71473) (PFI.CONSTANTNAMES 71475 . 71770)) (71807 80120 (
-MULTIFILEINDEX 71817 . 72613) (MULTIFILEINDEX1 72615 . 74071) (PFI.PRINT.MULTI.INDEX 74073 . 79176) (
-PFI.CHOOSE.BEST 79178 . 79405) (PFI.MERGE.INDICES 79407 . 80118)) (80177 83246 (PFI.MAYBE.SEE.PRETTY 
-80187 . 81970) (PFI.MAYBE.PP.DEFINITION 81972 . 83244)) (83316 91426 (PFI.PRINT.BITMAP 83326 . 91424))
- (94195 97309 (PUTPROPS.PRETTYPRINT 94205 . 95616) (RPAQX.PRETTYPRINT 95618 . 96343) (
-COURIERPROGRAM.PRETTYPRINT 96345 . 97045) (MAYBE.PRETTYPRINT.BOLD 97047 . 97307)))))
+  (FILEMAP (NIL (9974 12209 (PFI.NEW.LISTFILES1 9984 . 10478) (PFI.ENQUEUE 10480 . 11104) (
+\PFI.DO.HARDCOPY 11106 . 11692) (MAYBE.PRETTYFILEINDEX 11694 . 12207)) (12210 34725 (PRETTYFILEINDEX 
+12220 . 26253) (PFI.MAKE.LPT.STREAM 26255 . 29306) (PFI.SETUP.TRANSLATIONS 29308 . 30822) (
+PFI.OUTCHARFN 30824 . 32798) (PFI.COLLECT.DEFINERS 32800 . 33612) (PFI.AFTER.NEW.PAGE 33614 . 34723)) 
+(34726 41240 (PFI.PRINT.FILECREATED 34736 . 39427) (PFI.PRINT.TO.TAB 39429 . 39874) (
+PFI.PRINT.ENVIRONMENT 39876 . 41238)) (41241 48756 (PFI.PROCESS.FILE 41251 . 42481) (PFI.PASS.COMMENT 
+42483 . 43453) (PFI.HANDLE.EXPR 43455 . 44122) (PFI.DEFAULT.HANDLER 44124 . 46177) (PFI.PRETTYPRINT 
+46179 . 46514) (PFI.LINES.REMAINING 46516 . 46843) (PFI.MAYBE.NEW.PAGE 46845 . 47679) (
+PFI.ESTIMATE.SIZE 47681 . 48212) (PFI.ESTIMATE.SIZE1 48214 . 48754)) (48793 59002 (PFI.HANDLE.RPAQQ 
+48803 . 50211) (PFI.HANDLE.DECLARE 50213 . 51152) (PFI.HANDLE.EVAL-WHEN 51154 . 51637) (
+PFI.HANDLE.DEFDEFINER 51639 . 52929) (PFI.HANDLE.DEFINEQ 52931 . 53175) (PFI.PRINT.LAMBDA 53177 . 
+53515) (PFI.PRINT.LAMBDA.BODY 53517 . 53852) (PFI.HANDLE.PUTDEF 53854 . 54351) (PFI.HANDLE.PUTPROPS 
+54353 . 54968) (PFI.HANDLE./DECLAREDATATYPE 54970 . 55517) (PFI.HANDLE.* 55519 . 56781) (
+PFI.PRINT.COMMENTS 56783 . 58405) (PFI.HANDLE.FILEMAP 58407 . 58695) (PFI.HANDLE.PACKAGE 58697 . 59000
+)) (59030 60022 (PFI.PREVIEW.DECLARE 59040 . 59702) (PFI.PREVIEW.DEFINEQ 59704 . 60020)) (60058 71046 
+(PFI.PRINT.INDEX 60068 . 60919) (PFI.CONDENSE.INDEX 60921 . 62728) (PFI.SORT.INDICES 62730 . 63869) (
+PFI.COMPUTE.INDEX.SHAPE 63871 . 65335) (PFI.PRINT.INDICES 65337 . 69879) (PFI.CENTER.PRINT 69881 . 
+70451) (PFI.INDEX.BREAK 70453 . 70911) (PFI.LOOKUP.NAME 70913 . 71044)) (71047 72278 (PFI.ADD.TO.INDEX
+ 71057 . 71567) (PFI.VARNAME 71569 . 71979) (PFI.CONSTANTNAMES 71981 . 72276)) (72313 80626 (
+MULTIFILEINDEX 72323 . 73119) (MULTIFILEINDEX1 73121 . 74577) (PFI.PRINT.MULTI.INDEX 74579 . 79682) (
+PFI.CHOOSE.BEST 79684 . 79911) (PFI.MERGE.INDICES 79913 . 80624)) (80683 83752 (PFI.MAYBE.SEE.PRETTY 
+80693 . 82476) (PFI.MAYBE.PP.DEFINITION 82478 . 83750)) (83822 91932 (PFI.PRINT.BITMAP 83832 . 91930))
+ (94701 97815 (PUTPROPS.PRETTYPRINT 94711 . 96122) (RPAQX.PRETTYPRINT 96124 . 96849) (
+COURIERPROGRAM.PRETTYPRINT 96851 . 97551) (MAYBE.PRETTYPRINT.BOLD 97553 . 97813)))))
 STOP

lispusers/WHO-LINE

@@ -1,13 +1,16 @@
-(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "26-Mar-2021 11:01:59" {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;4
 74359  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS WHO-LINECOMS)
+
(FILECREATED "12-Apr-2023 22:10:58" {DSK}<home>larry>il>medley>lispusers>WHO-LINE.;5
 75086  
 
-      previous date%: "26-Mar-2021 10:48:40" {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;3)
+      :EDIT-BY "lmm"
+
+      :CHANGES-TO (FNS WHO-LINE-HOST-NAME SET-PACKAGE-INTERACTIVELY)
+
+      :PREVIOUS-DATE "12-Apr-2023 17:45:36" {DSK}<home>larry>il>medley>lispusers>WHO-LINE.;4)
 
 
 (* ; "
-Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
+Copyright (c) 1986-1989, 1994, 1998, 2001, 2021, 2023 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT WHO-LINECOMS)
@@ -184,7 +187,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
         (FUNCTIONS INVERT-WHO-LINE-ENTRY)
         (DECLARE%: DONTCOPY (RECORDS WHO-LINE-ENTRY))
                                                              (* ; 
-
                          "Macros that lets us lock down the Who-Line while we evaluate some forms")

+
                            "Macros that lets us lock down the Who-Line while we evaluate some forms")

         (FUNCTIONS WITH-WHO-LINE WITH-AVAILABLE-WHO-LINE)
         
 
@@ -567,11 +570,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
    "Cached name of the current logged in user")
 
 (CL:DEFPARAMETER *WHO-LINE-USER-ENTRY*
 '("User" (WHO-LINE-USERNAME
)
-                                                   10 WHO-LINE-CHANGE-USER (SETQ 
-                                                                            *WHO-LINE-CURRENT-USER* 
-                                                                            NIL)
-                                                   "Name of the currently logged in user")
-                                           
+                                               10 WHO-LINE-CHANGE-USER (SETQ *WHO-LINE-CURRENT-USER*
+                                                                        NIL)
+                                               "Name of the currently logged in user")
+                                       
                              "Who-Line entry for displaying the name of the currently logged in user")
 (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE 
 
@@ -591,18 +593,35 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 
 (DEFINEQ
 
-(WHO-LINE-HOST-NAME
-(LAMBDA NIL (* ; "Edited 14-Jan-87 12:46 by smL") (* ;;; "") (* ;;; "Return the name of the curren workstation.  Avoid consing up a new string if possible.") (* ;;; "") (* ;; "") (* ;; "The cached value in *WHO-LINE-HOST-NAME* gets invalidated by an entry on the list of \SYSTEMCACHEVARS") (* ;; "") (DECLARE (GLOBALVARS *WHO-LINE-HOST-NAME*)) (if *WHO-LINE-HOST-NAME* then *WHO-LINE-HOST-NAME* else (SETQ *WHO-LINE-HOST-NAME* (ETHERHOSTNAME))))
-)
+(WHO-LINE-HOST-NAME

+  [LAMBDA NIL
                                                (* ; "Edited 12-Apr-2023 22:09 by lmm")


+                                                             (* ; "Edited 14-Jan-87 12:46 by smL")

+
+(* ;;; "")

+
+(* ;;; "Return the name of the curren workstation.  Avoid consing up a new string if possible.")

+
+(* ;;; "")

+
+    (* ;; "")

+
+    (* ;; "The cached value in *WHO-LINE-HOST-NAME* gets invalidated by an entry on the list of \SYSTEMCACHEVARS")

+
+    (* ;; "")

+
+    (DECLARE
 (GLOBALVARS *WHO-LINE-HOST-NAME*))
+    (IF
 *WHO-LINE-HOST-NAME*
+        THEN
 *WHO-LINE-HOST-NAME*
+      ELSE
 (SETQ *WHO-LINE-HOST-NAME* (UNIX-GETPARM "HOSTNAME"])
 )
 
 (DEFGLOBALVAR *WHO-LINE-HOST-NAME*
 NIL
    "Cached name of the current machine, for the Who-Line")
 
 (CL:DEFPARAMETER *WHO-LINE-HOST-NAME-ENTRY*
 '("on" (WHO-LINE-HOST-NAME
)
-                                                       10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL)
-                                                       "Name of the currently running machine")
-                                                
+                                                   10 NIL (SETQ *WHO-LINE-HOST-NAME* NIL)
+                                                   "Name of the currently running machine")
+                                            
                                       "Who-Line entry for displaying the name of the current machine")
 (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE 
 
@@ -647,33 +666,41 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
                                       ":")
                     *WHO-LINE-PACKAGE-NAME-CACHE*)))))
 
-(SET-PACKAGE-INTERACTIVELY
-  (LAMBDA NIL                                                (* ; "Edited 18-Mar-87 13:13 by smL")
-          
-          (* ;; "")
-          
-          (* ;; "Let the user interactivly change the current package")
-          
-          (* ;; "")
+(SET-PACKAGE-INTERACTIVELY

+  [LAMBDA NIL
                                                (* ; "Edited 12-Apr-2023 17:44 by lmm")


+                                                             (* ; "Edited 18-Mar-87 13:13 by smL")

 
-    (LET ((PACKAGE
-           (MENU (create MENU
-                        TITLE _ "Select package"
-                        ITEMS _ (SORT (for PACKAGE in (CL:LIST-ALL-PACKAGES) bind PACKAGE-NAME
-                                         collect (SETQ PACKAGE-NAME (CL:PACKAGE-NAME PACKAGE))
-                                               `(,(CONCAT (OR (CAR (CL:PACKAGE-NICKNAMES PACKAGE))
-                                                              PACKAGE-NAME)
-                                                         ":") ',PACKAGE-NAME
-                                                       ,(CONCAT "Set the current package to " 
-                                                               PACKAGE-NAME ":")))
-                                      (FUNCTION (LAMBDA (X Y)
-                                                  (ALPHORDER (CAR X)
-                                                         (CAR Y)))))
-                        CENTERFLG _ T))))
-         (if PACKAGE
-             then (if (SHIFTDOWNP 'SHIFT)
-                      then (WHO-LINE-COPY-INSERT (CONCAT PACKAGE ":"))
-                    else (CL:IN-PACKAGE PACKAGE))))))
+    (* ;; "")

+
+    (* ;; "Let the user interactivly change the current package")

+
+    (* ;; "")

+
+    (LET* [PKG (MAIN (FOR
 PN IN
 '("INTERLISP" "XCL-USER" "USER") WHEN
 (SETQ PKG (CL:FIND-PACKAGE
+                                                                                 PN))
+                        COLLECT
 (LIST PKG PN)))
+               (SYSPKG (FOR
 PN
+                          IN
 '("LISP" "XEROX-COMMON-LISP" "D-ASSEM" "FASL" "KEYWORD" "CASH-FILE" 
+                                     "SEDIT" "SYSTEM" "COMPILER" "HASH-FILE" "CONDITIONS" "DEBUGGER")
+                          WHEN
 (SETQ PKG (CL:FIND-PACKAGE PN)) COLLECT
 (LIST PKG PN)))
+               (BOTH (APPEND MAIN SYSPKG))
+               [UNSORTED (FOR
 PKG IN
 (CL:LIST-ALL-PACKAGES) WHEN
 (NOT (ASSOC PKG BOTH))
+                            COLLECT
 (LIST PKG (OR (CAR (CL:PACKAGE-NICKNAMES PKG))
+                                                  (CL:PACKAGE-NAME PKG]
+               [USERS (SORT UNSORTED (FUNCTION (LAMBDA (X Y)
+                                                 (ALPHORDER (CADR X)
+                                                        (CADR Y]
+               [ITEMS (FOR
 X IN
 (APPEND MAIN USERS SYSPKG) COLLECT
 (LIST (CADR X)
+                                                                         (CAR X]
+               (SELECTION (MENU (create
 MENU
+                                       TITLE _ "Select package"
+                                       ITEMS _ ITEMS
+                                       CENTERFLG _ T]
+          (IF
 SELECTION
+              THEN
 (IF
 (SHIFTDOWNP 'SHIFT)
+                       THEN
 (WHO-LINE-COPY-INSERT
 (CONCAT (CADR SELECTION)
+                                                         ":"))
+                     ELSE
 (CL:IN-PACKAGE (CAR SELECTION])
 
 (SET-TTY-PACKAGE-INTERACTIVELY
 (LAMBDA NIL (* smL "28-Oct-86 09:49") (* ;;; "") (* ;;; "Interactivly let the user change the package of the current TTY process") (* ;;; "") (PROCESS.EVAL (TTY.PROCESS) (QUOTE (SET-PACKAGE-INTERACTIVELY)) T))
@@ -681,15 +708,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 )
 
 (DEFGLOBALVAR *WHO-LINE-PACKAGE-NAME-CACHE*
 (LIST NIL)
-                                                
+                                            
                          "An AList used to cache package names, together with their terminating ':'s")
 
 (CL:DEFPARAMETER *WHO-LINE-PACKAGE-ENTRY*
 '("Pkg" (CURRENT-TTY-PACKAGE
)
-                                                      10 SET-TTY-PACKAGE-INTERACTIVELY (SETQ 
+                                                  10 SET-TTY-PACKAGE-INTERACTIVELY (SETQ 
                                                                         *WHO-LINE-PACKAGE-NAME-CACHE*
-                                                                                        (LIST NIL))
-                                                      "Package of the current TTY process")
-                                              
+                                                                                    (LIST NIL))
+                                                  "Package of the current TTY process")
+                                          
                                "Who-Line entry for displaying the package of the current TTY process")
 
 
@@ -717,9 +744,9 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 )
 
 (CL:DEFPARAMETER *WHO-LINE-READTABLE-ENTRY*
 '("Rdtbl" (CURRENT-TTY-READTABLE-NAME
)
-                                                        10 SET-TTY-READTABLE-INTERACTIVELY NIL 
-                                                        "Readtable of the current TTY process")
-                                                
+                                                    10 SET-TTY-READTABLE-INTERACTIVELY NIL 
+                                                    "Readtable of the current TTY process")
+                                            
                  "Who-Line entry for displaying the name of the ReadTable of the current TTY process")
 
 
@@ -743,9 +770,9 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 )
 
 (CL:DEFPARAMETER *WHO-LINE-TTY-PROC-ENTRY*
 '("Tty" (WHO-LINE-TTY-PROCESS
)
-                                                       15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL 
-                                                       "The current TTY process")
-                                               
+                                                   15 CHANGE-TTY-PROCESS-INTERACTIVELY NIL 
+                                                   "The current TTY process")
+                                           
                                   "Who-Line entry for displaying the name of the current TTY process")
 
 
@@ -763,58 +790,59 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 (LAMBDA NIL (* ; "Edited  3-Feb-89 14:52 by smL") (* ;;; "Get the currently connected directory") (* ;; "First, update the cached directory / namestring pair to reflect the current TTY proc") (DECLARE (GLOBALVARS *WHO-LINE-LAST-DIRECTORY*)) (* ;; "The connected directory is looked up in the TTY process, in case one day it becomes a per-process var") (LET ((CONNECTED-DIRECTORY (PROCESS.EVALV (TTY.PROCESS) (QUOTE *DEFAULT-PATHNAME-DEFAULTS*)))) (* ; "The CAR contains the path, the CDR contains a string version of the path") (if (NEQ CONNECTED-DIRECTORY (CAR *WHO-LINE-LAST-DIRECTORY*)) then (* ; "The connected directory has changed") (change (CAR *WHO-LINE-LAST-DIRECTORY*) CONNECTED-DIRECTORY) (* ; "Put the host name last, since that is least important") (change (CDR *WHO-LINE-LAST-DIRECTORY*) (if (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) then (CONCAT (CL:PATHNAME-DIRECTORY CONNECTED-DIRECTORY) " on {" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}") else (CONCAT "{" (CL:PATHNAME-HOST CONNECTED-DIRECTORY) "}"))) (* ; "Update the list of known directories") (LET ((DIR-NAME (CL:NAMESTRING CONNECTED-DIRECTORY))) (if (NOT (CL:MEMBER DIR-NAME *WHO-LINE-DIRECTORIES* :TEST (CL:FUNCTION STRING-EQUAL))) then (MERGEINSERT DIR-NAME (SORT *WHO-LINE-DIRECTORIES* (CL:FUNCTION UALPHORDER))))))) (* ;; "Return the namestring of the current dir") (CDR *WHO-LINE-LAST-DIRECTORY*))
 )
 
-(SET-CONNECTED-DIRECTORY-INTERACTIVELY
-  (LAMBDA NIL                                                (* ; "Edited  9-Jun-87 08:57 by smL")
+(SET-CONNECTED-DIRECTORY-INTERACTIVELY

+  [LAMBDA NIL
                                                (* ; "Edited 12-Apr-2023 08:00 by lmm")


+                                                             (* ; "Edited  9-Jun-87 08:57 by smL")

 
-(* ;;; "Let the user interactivly change the current connected directory")
+(* ;;; "Let the user interactivly change the current connected directory")

 
-    (DECLARE (GLOBALVARS *WHO-LINE-DIRECTORIES*))
-          
-          (* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it")
+    (DECLARE
 (GLOBALVARS *WHO-LINE-DIRECTORIES*))
 
-    (if (SHIFTDOWNP 'SHIFT)
-        then (LET ((NEW-DIRECTORY (MENU (create MENU
+    (* ;; "If the user selects an item while holding down a shift key, copy-insert the name of the directory instead of connecting to it")

+
+    (SETQ *WHO-LINE-DIRECTORIES* (SUBSET *WHO-LINE-DIRECTORIES* (FUNCTION DIRECTORYNAMEP)))
+    (IF
 (SHIFTDOWNP 'SHIFT)
+        THEN
 (LET [(NEW-DIRECTORY (MENU (create
 MENU
                                                TITLE _ "Type in directory name:"
-                                               ITEMS _ *WHO-LINE-DIRECTORIES*))))
-                  (if NEW-DIRECTORY
-                      then (WHO-LINE-COPY-INSERT NEW-DIRECTORY)))
-      else (LET ((NEW-DIRECTORY (MENU (create MENU
+                                               ITEMS _ *WHO-LINE-DIRECTORIES*]
+                  (IF
 NEW-DIRECTORY
+                      THEN
 (WHO-LINE-COPY-INSERT
 NEW-DIRECTORY)))
+      ELSE
 (LET [(NEW-DIRECTORY (MENU (create
 MENU
                                              TITLE _ "Connect to:"
-                                             ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*)))))
-                (if NEW-DIRECTORY
-                    then (if (STRING-EQUAL NEW-DIRECTORY "* Other *")
-                             then (CLEARW PROMPTWINDOW)
+                                             ITEMS _ (CONS "* Other *" *WHO-LINE-DIRECTORIES*]
+                (if
 NEW-DIRECTORY
+                    then
 (if
 (STRING-EQUAL NEW-DIRECTORY "* Other *")
+                             then
 (CLEARW PROMPTWINDOW)
                                   (SETQ NEW-DIRECTORY (PROMPTFORWORD "Connect to directory "
                                                              (CL:NAMESTRING (PROCESS.EVALV
                                                                              (TTY.PROCESS)
+                                                                             
                                                                              '
                                                                           *DEFAULT-PATHNAME-DEFAULTS*
                                                                              ))
                                                              NIL PROMPTWINDOW NIL 'TTY NIL)))
-                         (if NEW-DIRECTORY
-                             then (ALLOW.BUTTON.EVENTS)      (* ; 
-   "Should do this in the current TTY process, in case the conntected directory is a per-process var")
-
-                                  (CNDIR NEW-DIRECTORY)))))))
+                         (if
 NEW-DIRECTORY
+                             then
 (ALLOW.BUTTON.EVENTS)      (* ; 
+
   "Should do this in the current TTY process, in case the conntected directory is a per-process var")

+                                  (CNDIR NEW-DIRECTORY])
 )
 
 (DEFGLOBALVAR *WHO-LINE-DIRECTORIES*
 `(,LOGINHOST/DIR)
-                                         
+                                     
                                   "Cached list of known directories for the Who-Line Directory entry")
 
-(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY*
 (LET ((NAMESTRING (CL:NAMESTRING 
-                                                                     *DEFAULT-PATHNAME-DEFAULTS*)))
-                                                 (CONS (PATHNAME NAMESTRING)
-                                                       (MKSTRING NAMESTRING)))
-                                            
+(DEFGLOBALVAR *WHO-LINE-LAST-DIRECTORY*
 (LET ((NAMESTRING (CL:NAMESTRING *DEFAULT-PATHNAME-DEFAULTS*)
+                                                     ))
+                                             (CONS (PATHNAME NAMESTRING)
+                                                   (MKSTRING NAMESTRING)))
+                                        
                     "Cached name of the current connected directory for the Who-Line Directory entry")
 
 (CL:DEFPARAMETER *WHO-LINE-DIRECTORY-ENTRY*
 '("Dir" (WHO-LINE-CURRENT-DIRECTORY
)
-                                                        30 SET-CONNECTED-DIRECTORY-INTERACTIVELY
-                                                        (SETQ *WHO-LINE-LAST-DIRECTORY*
-                                                         (CONS NIL NIL))
-                                                        "The currently connected directory")
-                                                
+                                                    30 SET-CONNECTED-DIRECTORY-INTERACTIVELY
+                                                    (SETQ *WHO-LINE-LAST-DIRECTORY* (CONS NIL NIL))
+                                                    "The currently connected directory")
+                                            
                         "Who-Line entry for displaying the name of the currently connected directory")
 
 
@@ -887,15 +915,14 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 )
 
 (DEFGLOBALVAR *WHO-LINE-LAST-VMEM*
 (LIST 0 NIL NIL)
-                                       
+                                   
                      "Cached value for storing the last VMem information for the Who-Line VMem entry")
 
 (CL:DEFPARAMETER *WHO-LINE-VMEM-ENTRY*
 '("VMem" (WHO-LINE-VMEM
)
-                                                   5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM*
-                                                                         (LIST 0 NIL NIL))
-                                                   "Percentage of VMem currently in use")
-                                           
-                                         "Who-Line entry for displaying the current VMem utilization")
+                                               5 WHO-LINE-SAVE-VMEM (SETQ *WHO-LINE-LAST-VMEM*
+                                                                     (LIST 0 NIL NIL))
+                                               "Percentage of VMem currently in use")
+                                       "Who-Line entry for displaying the current VMem utilization")
 (DECLARE%: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD 
 
 (FILESLOAD (LOADCOMP)
@@ -938,15 +965,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
         (CL:THIRD *WHO-LINE-SYMBOL-SPACE*)))
 
 (DEFGLOBALVAR *WHO-LINE-SYMBOL-SPACE*
 (LIST NIL NIL NIL 
-                                                "Remembers the previous who-line symbol space"))
+                                            "Remembers the previous who-line symbol space"))
 
 (CL:DEFPARAMETER *WHO-LINE-SYMBOL-SPACE-ENTRY*
 '("Syms" (WHO-LINE-SYMBOL-SPACE
)
-                                                           4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE*
-                                                                  (LIST NIL NIL NIL))
-                                                           
-                                                        "Percentage of symbol space currently in use"
-                                                           )
-                                                   
+                                                       4 NIL (SETQ *WHO-LINE-SYMBOL-SPACE*
+                                                              (LIST NIL NIL NIL))
+                                                       "Percentage of symbol space currently in use")
+                                               
                                        "Who-line entry for displaying percent of symbol space in use")
 
 
@@ -991,13 +1016,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 )
 
 (DEFGLOBALVAR *WHO-LINE-TIMER*
 (SETUPTIMER (DIFFERENCE 60 (REMAINDER (IDATE)
-                                                                     60))
-                                          NIL
-                                          'SECONDS)
-                                   "Timer for controlling updates of the Who-Line Time entry")
+                                                                 60))
+                                      NIL
+                                      'SECONDS)
+                               "Timer for controlling updates of the Who-Line Time entry")
 
 (DEFGLOBALVAR *WHO-LINE-OLD-TIME*
 (DATE (DATEFORMAT NO.SECONDS))
-                                      "Cached value for the Who-Line Time entry")
+                                  "Cached value for the Who-Line Time entry")
 
 (CL:DEFPARAMETER *WHO-LINE-TIME-ENTRY*

    '("Time" (WHO-LINE-TIME
)
@@ -1082,15 +1107,14 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
    "Interval between updating the Who-Line activity entry")
 
 (DEFGLOBALVAR *WHO-LINE-ACTIVE-TIMER*
 (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL 'MILLISECONDS)
-                                          
                                       "Timer for controlling updating of the Who-Line activity entry")
 
 (CL:DEFPARAMETER *WHO-LINE-SHOW-ACTIVE-ENTRY*
 '("" (WHO-LINE-SHOW-ACTIVE
)
-                                                       2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER*
-                                                              (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* 
-                                                                     NIL 'MILLISECONDS))
-                                                       "Indication of machine activity")
-                                                  
+                                                   2 NIL (SETQ *WHO-LINE-ACTIVE-TIMER*
+                                                          (SETUPTIMER *WHO-LINE-ACTIVE-PERIOD* NIL
+                                                                 'MILLISECONDS))
+                                                   "Indication of machine activity")
+                                              
                                           "Who-Line entry for displaying the activity of the machine")
 (DECLARE%: DONTEVAL@LOAD DONTEVAL@COMPILE 
 
@@ -1122,10 +1146,10 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 )
 
 (CL:DEFPARAMETER *WHO-LINE-PROFILE-ENTRY*
 '("Profile" (CURRENT-PROFILE
)
-                                                      10 SET-TTY-PROFILE-INTERACTIVELY NIL 
+                                                  10 SET-TTY-PROFILE-INTERACTIVELY NIL 
                                                   "The read/write profile of the current TTY process"
-                                                      )
-                                              
+                                                  )
+                                          
                                        "Who-Line entry for displaying the current read/write profile")
 
 
@@ -1176,15 +1200,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
    "Cached state shown in the Who-Line State entry")
 
 (DEFGLOBALVAR *WHO-LINE-STATE-UNINTERESTING-FNS*
 '(BLOCK ERRORSET OBTAIN.MONITORLOCK 
-                                                             MONITOR.AWAIT.EVENT AWAIT.EVENT 
-                                                             SI::*UNWIND-PROTECT*)
-                                                     
+                                                         MONITOR.AWAIT.EVENT AWAIT.EVENT 
+                                                         SI::*UNWIND-PROTECT*)
+                                                 
                                          "Uninteresting fns to skip over in the Who-Line State entry")
 
 (CL:DEFPARAMETER *WHO-LINE-TTY-STATE-ENTRY*
 '("State" (WHO-LINE-TTY-STATE
)
-                                                        15 NIL (SETQ *WHO-LINE-STATE* NIL)
-                                                        "Running state of the current TTY process")
-                                                
+                                                    15 NIL (SETQ *WHO-LINE-STATE* NIL)
+                                                    "Running state of the current TTY process")
+                                            
                             "Who-Line entry for showing the running state of the current TTY process")
 
 (PUTPROPS AWAIT.EVENT
 WHO-LINE-STATE
 "Block")
@@ -1222,9 +1246,8 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 
 
 (DEFGLOBALVAR *WHO-LINE-ENTRIES*

-   `(,*WHO-LINE-USER-ENTRY* ,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* 
-           ,*WHO-LINE-TTY-PROC-ENTRY* ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* 
-           ,*WHO-LINE-TIME-ENTRY*)
+   `(,*WHO-LINE-PACKAGE-ENTRY* ,*WHO-LINE-READTABLE-ENTRY* ,*WHO-LINE-TTY-PROC-ENTRY* 
+           ,*WHO-LINE-DIRECTORY-ENTRY* ,*WHO-LINE-VMEM-ENTRY* ,*WHO-LINE-TIME-ENTRY*)
    "List of all the entries to show in the Who-Line")
 
 (DEFGLOBALVAR *WHO-LINE-ENTRY-REGISTRY*

@@ -1235,13 +1258,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
    "List of all known Who-Line entries.")
 
 (DEFGLOBALVAR *WHO-LINE-ANCHOR*
 '(:CENTER :TOP)
-                                    "Location to place the Who-Line")
+                                "Location to place the Who-Line")
 
 (DEFGLOBALVAR *WHO-LINE-NAME-FONT*
 (FONTCREATE '(HELVETICA 8 BOLD))
-                                       "Font to use to show entry labels in the Who-Line")
+                                   "Font to use to show entry labels in the Who-Line")
 
 (DEFGLOBALVAR *WHO-LINE-VALUE-FONT*
 (FONTCREATE '(GACHA 8))
-                                        "Font to use to show the entry values in the Who-Line")
+                                    "Font to use to show the entry values in the Who-Line")
 
 (DEFGLOBALVAR *WHO-LINE-DISPLAY-NAMES?*
 T
    "Flag for enabling or disabling the display of entry names in the Who-Line")
@@ -1578,15 +1601,15 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 
 (DEFMACRO INVERT-WHO-LINE-ENTRY
 (ENTRY WINDOW)
    `(WITH
 WHO-LINE-ENTRY ,ENTRY (BLTSHADE BLACKSHADE ,WINDOW NAME-START 0 (DIFFERENCE VALUE-END 
-                                                                                     NAME-START)
-                                           NIL
-                                           'INVERT)
-           (CHANGE
 INVERTED? (NOT INVERTED?))))
+                                                                                 NAME-START)
+                                       NIL
+                                       'INVERT)
+          (CHANGE
 INVERTED? (NOT INVERTED?))))
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
 (RECORD WHO-LINE-ENTRY
 (NAME FORM NAME-START VALUE-START VALUE-END PREV-VALUE WHEN-SELECTED-FN 
-                                 INVERTED? RESET-FORM DESCRIPTION))
+                             INVERTED? RESET-FORM DESCRIPTION))
 )
 )
 
@@ -1606,7 +1629,7 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
         `(LET ((,LOCK (OBTAIN.MONITORLOCK (WINDOWPROP ,WHO-LINE 'LOCK)
                              T)))
               (CL:UNWIND-PROTECT                             (* ; 
-
                                                           "Only eval the forms if we got the lock")

+
                                                             "Only eval the forms if we got the lock")

                   (COND
                      (,LOCK ,@FORMS))
 
@@ -1614,13 +1637,13 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 
                   [COND
                      ((EQ ,LOCK T)                           (* ; 
-
                                                    "Had the lock before, so no need to release it")

+
                                                      "Had the lock before, so no need to release it")

                       NIL)
                      ((NULL ,LOCK)                           (* ; 
-
                                                  "Couldn't get the lock, so no need to release it")

+
                                                    "Couldn't get the lock, so no need to release it")

                       NIL)
                      (T                                      (* ; 
-
                                                          "We got the lock, and need to release it")

+
                                                            "We got the lock, and need to release it")

                         (RELEASE.MONITORLOCK ,LOCK])])
 
 
@@ -1656,24 +1679,25 @@ Copyright (c) 1986-1989, 1994, 1998, 2001, 2021 by Xerox Corporation.
 
 (PUTPROPS WHO-LINE
 FILETYPE
 :COMPILE-FILE)
 )
-(PUTPROPS WHO-LINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1994 1998 2001 2021))
+(PUTPROPS WHO-LINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1994 1998 2001 2021 2023))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7778 23157 (INSTALL-WHO-LINE-OPTIONS 7788 . 23155)) (23433 24602 (WHO-LINE-USERNAME 
-23443 . 24090) (WHO-LINE-CHANGE-USER 24092 . 24398) (WHO-LINE-USER-AFTER-LOGIN 24400 . 24600)) (25504 
-25983 (WHO-LINE-HOST-NAME 25514 . 25981)) (26695 29324 (CURRENT-TTY-PACKAGE 26705 . 27657) (
-SET-PACKAGE-INTERACTIVELY 27659 . 29078) (SET-TTY-PACKAGE-INTERACTIVELY 29080 . 29322)) (30244 31296 (
-CURRENT-TTY-READTABLE-NAME 30254 . 30508) (SET-READTABLE-INTERACTIVELY 30510 . 31044) (
-SET-TTY-READTABLE-INTERACTIVELY 31046 . 31294)) (31811 32383 (WHO-LINE-TTY-PROCESS 31821 . 31999) (
-CHANGE-TTY-PROCESS-INTERACTIVELY 32001 . 32381)) (32884 36355 (WHO-LINE-CURRENT-DIRECTORY 32894 . 
-34301) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 34303 . 36353)) (37720 40173 (WHO-LINE-VMEM 37730 . 
-39920) (WHO-LINE-SAVE-VMEM 39922 . 40171)) (41097 42239 (WHO-LINE-SYMBOL-SPACE 41097 . 42239)) (43107 
-44545 (WHO-LINE-TIME 43117 . 43859) (WHO-LINE-SET-TIME 43861 . 44543)) (46079 48712 (
-WHO-LINE-SHOW-ACTIVE 46089 . 46867) (\UPDATE-WHO-LINE-ACTIVE-FLAG 46869 . 47837) (
-\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 47839 . 48710)) (49873 50798 (CURRENT-PROFILE 49883 . 50128) (
-SET-PROFILE-INTERACTIVELY 50130 . 50533) (SET-TTY-PROFILE-INTERACTIVELY 50535 . 50796)) (51360 53343 (
-WHO-LINE-TTY-STATE 51370 . 52531) (WHO-LINE-WHAT-IS-RUNNING 52533 . 53341)) (56897 70023 (
-REDISPLAY-WHO-LINE 56907 . 59467) (PERIODICALLY-UPDATE-WHO-LINE 59469 . 60607) (SETUP-WHOLINE-TIMER 
-60609 . 60827) (UPDATE-WHO-LINE 60829 . 63897) (WHEN-WHO-LINE-SELECTED-FN 63899 . 67166) (
-WHO-LINE-CONTROL-SELECT 67168 . 69627) (WHO-LINE-COPY-INSERT 69629 . 70021)) (70024 71158 (
-WHO-LINE-REDISPLAY-INTERRUPT 70034 . 71156)))))
+  (FILEMAP (NIL (7838 23217 (INSTALL-WHO-LINE-OPTIONS 7848 . 23215)) (23493 24662 (WHO-LINE-USERNAME 
+23503 . 24150) (WHO-LINE-CHANGE-USER 24152 . 24458) (WHO-LINE-USER-AFTER-LOGIN 24460 . 24660)) (25470 
+26206 (WHO-LINE-HOST-NAME 25480 . 26204)) (26906 30232 (CURRENT-TTY-PACKAGE 26916 . 27868) (
+SET-PACKAGE-INTERACTIVELY 27870 . 29986) (SET-TTY-PACKAGE-INTERACTIVELY 29988 . 30230)) (31132 32184 (
+CURRENT-TTY-READTABLE-NAME 31142 . 31396) (SET-READTABLE-INTERACTIVELY 31398 . 31932) (
+SET-TTY-READTABLE-INTERACTIVELY 31934 . 32182)) (32687 33259 (WHO-LINE-TTY-PROCESS 32697 . 32875) (
+CHANGE-TTY-PROCESS-INTERACTIVELY 32877 . 33257)) (33748 37557 (WHO-LINE-CURRENT-DIRECTORY 33758 . 
+35165) (SET-CONNECTED-DIRECTORY-INTERACTIVELY 35167 . 37555)) (38817 41270 (WHO-LINE-VMEM 38827 . 
+41017) (WHO-LINE-SAVE-VMEM 41019 . 41268)) (42132 43274 (WHO-LINE-SYMBOL-SPACE 42132 . 43274)) (44005 
+45443 (WHO-LINE-TIME 44015 . 44757) (WHO-LINE-SET-TIME 44759 . 45441)) (46957 49590 (
+WHO-LINE-SHOW-ACTIVE 46967 . 47745) (\UPDATE-WHO-LINE-ACTIVE-FLAG 47747 . 48715) (
+\PERIODICALLY-WHO-LINE-SHOW-ACTIVE 48717 . 49588)) (50687 51612 (CURRENT-PROFILE 50697 . 50942) (
+SET-PROFILE-INTERACTIVELY 50944 . 51347) (SET-TTY-PROFILE-INTERACTIVELY 51349 . 51610)) (52162 54145 (
+WHO-LINE-TTY-STATE 52172 . 53333) (WHO-LINE-WHAT-IS-RUNNING 53335 . 54143)) (57628 70754 (
+REDISPLAY-WHO-LINE 57638 . 60198) (PERIODICALLY-UPDATE-WHO-LINE 60200 . 61338) (SETUP-WHOLINE-TIMER 
+61340 . 61558) (UPDATE-WHO-LINE 61560 . 64628) (WHEN-WHO-LINE-SELECTED-FN 64630 . 67897) (
+WHO-LINE-CONTROL-SELECT 67899 . 70358) (WHO-LINE-COPY-INSERT 70360 . 70752)) (70755 71889 (
+WHO-LINE-REDISPLAY-INTERRUPT 70765 . 71887)) (72291 72677 (INVERT-WHO-LINE-ENTRY 72291 . 72677)) (
+72981 73153 (WITH-WHO-LINE 72981 . 73153)) (73155 74399 (WITH-AVAILABLE-WHO-LINE 73155 . 74399)))))
 STOP

run-medley

@@ -41,6 +41,7 @@ pass=""
 mem="-m 256"
 scroll=22
 noscroll=""
+display=""
 title="Medley Interlisp"
 
 if [ -z "$LDEDESTSYSOUT" ] ; then
@@ -55,8 +56,6 @@ if [ -z "$LDEINIT" ] ; then
     export LDEINIT="$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT"
 fi
 
-export LDEKBDTYPE=x
-
 while [ "$#" -ne 0 ]; do
     case "$1" in
         -loadup)
@@ -102,7 +101,7 @@ while [ "$#" -ne 0 ]; do
             shift
             ;;
         --display | -d)
-            export DISPLAY="$2"
+	    display="-display $2"
             shift
             ;;
 	-prog)
@@ -197,10 +196,10 @@ if ! command -v "$prog" > /dev/null 2>&1; then
     fi
 fi
 
-echo "running: $prog $noscroll $geometry $screensize -title \"$title\" $mem $pass $LDESRCESYSOUT"
+echo "running: $prog $display $noscroll $geometry $screensize -title \"$title\" $mem $pass $LDESRCESYSOUT"
 echo "greet: $LDEINIT"
 
 export INMEDLEY=1
 
-"$prog" $noscroll $geometry $screensize $mem -title "$title" $pass "$LDESRCESYSOUT"
+"$prog" $display $noscroll $geometry $screensize $mem -title "$title" $pass "$LDESRCESYSOUT"
 

scripts/medley/medley.cmd

@@ -0,0 +1,3 @@
+@echo off
+powershell medley.ps1 %*
+

scripts/medley/medley.ps1

@@ -0,0 +1,410 @@
+###############################################################################
+#
+#    medley.ps1 - PowerShell script for running Medley Interlisp in a Docker
+#                 container on Windows. This script will pull the
+#                 interlisp/medley docker container, run the container
+#                 using the Linux medley script as the entrypoint
+#                 passing on the flags as given to this script, and
+#                 then start a vncviewer onto medley running in the 
+#                 container.
+#
+#                 This script can also be used to start medley in a WSL
+#                 distro, although the same can easily be accomplished
+#                 using the wsl command.
+#
+#   2023-02-10 Frank Halasz
+#
+#   Copyright 2023 Interlisp.org
+#
+###############################################################################
+
+
+#
+#  Various useful functions
+#
+
+# Function to check if docker is installed on this system
+function Test-DockerInstalled {
+    $ErrorActionPreference = "SilentlyContinue" 
+    if (Get-Command "docker" -Syntax)
+        { return $true }
+    else
+        { return $false }
+}
+
+# Function to check if docker is running on this system
+function Test-DockerRunning {
+    $ErrorActionPreference = "SilentlyContinue"
+    docker info 2>&1 >$null 
+    if ( $LastExitCode -eq 0 )
+      { return $true }
+    else
+      { return $false }
+}
+
+# Function to test if WSL is installed on this machine
+function Test-WSLInstalled {
+    #$ErrorActionPreference = "SilentlyContinue" 
+    if ((Get-Command "wsl" -Syntax) -and 
+        (((wsl --list --verbose) -replace "`0" | Measure-Object -Line | Select -ExpandProperty Lines) -gt 1))
+        { return $true }
+    else
+        { return $false }
+
+}
+
+# Function to test if a named WSL distro is actually present
+function Test-WSLDistro {
+    param($distro="unknown")
+    $paddedDistro= " " + $distro + " "
+    if ( (wsl --list --verbose) -replace "`0" | Select-String -Pattern $paddedDistro )
+        { return $true }
+    else
+        { return $false }
+}
+
+# Function to test if medley is installed (using standard installation)
+# in the wsl distro whose name is the first and only arg. Defaults
+# to the default wsl distro
+function Test-MedleyInstalled {
+  param($distro)
+  if($distro -and (-not (Test-WSLDistro $distro)))
+    { 
+      return $false
+    }
+  if ($distro)
+    {
+      $is_installed = wsl -d $distro bash -c "test -e /usr/local/interlisp; echo \`$?"
+    }
+  else
+    {
+      $is_installed = wsl bash -c "test -e /usr/local/interlisp; echo \`$?"
+    }
+  if ($is_installed -eq 0)
+    {
+      return $true
+    }
+  else 
+    {
+      return $false
+    }
+}
+
+# Function to find an unused port between 5900 and 5999
+function Find-OpenPort {
+  $min_port=5900
+  $max_port=5999
+  $udp_openPorts = Get-NetUDPEndpoint | Where-Object { ($_.LocalPort -ge $min_port) -and ($_.LocalPort -le $max_port) }
+  $tcp_openPorts = Get-NetTCPConnection | Where-Object { ($_.LocalPort -ge $min_port) -and ($_.LocalPort -le $max_port) }
+  $openPorts = ($udp_openPorts + $tcp_openPorts) | Select-Object -Property LocalPort | Sort-Object -Property LocalPort -Unique
+  $expected=$min_port;
+  foreach ($port in $openPorts)
+    {
+      if ( $port.LocalPort -ne $expected )
+        {
+          break;
+        }
+      else
+        {
+          ${expected}++
+        }
+    }
+  if ($expected -gt $max_port)
+    {
+      Write-Output "Error: No available ports between 5900 and 5999."
+      Write-Output "Exiting."
+      exit 34
+    }
+  else
+    {
+      return $expected
+    }
+}
+
+
+#
+#  Function that processes all the arguments to this script
+#
+function Process-Args {
+
+  # Default values for script-scoped varaibles
+  $script:bg = $false
+  $script:draft = "latest"
+  $script:logindir = "${env:USERPROFILE}\AppData\Local\Medley\il"
+  $script:medleyArgs = @()
+  $script:noviewer = $false
+  $script:port = $false
+  $script:update = $false
+  $script:wsl = $false
+  $displayFlag = $false
+  $display = ""
+
+  # Variables local this function
+  $passRest = $false
+  $vncRequested = $false
+
+  # Loop thru args
+  for ( $idx = 0; $idx -lt $args.count; $idx++ ) {
+    $arg = $args[$idx]
+    if ($passRest)
+      {
+        $script:medleyArgs += $args
+        continue
+      }
+    switch($arg) {
+      { @("-b", "--background") -contains $_ }
+        {
+          $script:bg= $true
+        }
+      { @("-d", "--display") -contains $_ }
+        {
+         $displayFlag = $true
+         $display = $args[$idx+1]
+         if ( ($idx + 1 -gt $args.count) -or ($display -match "^-") )
+            {
+              Write-Output "Error: the `"--display`" flag is missing its value" "Exiting"
+              exit 33
+            }
+          if ( $display -notmatch ":[0-9]+" )
+            {
+              Write-Output "Error: the `"--display`" value is not of the form `":N`, where N is number between 0 and 63: $display" "Exiting"
+              exit 33
+            }
+        }
+      {  @("-h", "--help", "-z", "--man") -contains $_ }
+        {
+          $script:noviewer = $true
+          $script:medleyArgs += $_
+        }
+      { @("-p", "--port") -contains $_ }
+        {
+          if ( ($idx + 1 -gt $args.count) -or ($args[$idx+1] -match "^-") )
+            {
+              Write-Output "Error: the `"-p / --port`" flag is missing its value" "Exiting"
+              exit 33
+            }
+          $script:port = $args[$idx+1]
+          if (( $script:port -notmatch "^[0-9]*`$" ) -or ( $script:port -le 1024) -or ( $script:port -gt 65535 ))
+            {
+              Write-Output "Error: the value of `"-p / --port`" flag is not an integer between 1025 and 65535: $script:port " "Exiting"
+              exit 33
+            }
+          $idx++
+        }
+      { @("-u", "--update") -contains $_ }
+        {
+          $script:update = $true
+        }
+      {  @("-v", "--vnc") -contains $_ }
+        {
+          $vncRequested = $true
+        }
+      { @("-w", "--wsl") -contains $_ }
+        { 
+          if (-not (Test-WSLInstalled))
+            {
+              Write-Output "Error: The `"-w / --wsl`" flag was used, But WSL is not installed." "Exiting"
+              exit 33
+            }
+          if ( ($idx + 1 -gt $args.count) -or ($args[$idx+1] -match "^-") )
+            {
+              Write-Output "Error: the `"--wsl`" flag is missing its value" "Exiting"
+              exit 33
+            }
+          $script:wsl = $true
+          $script:wslDistro = $args[$idx + 1]
+          if (($script:wslDistro -ne "-") -and (-not (Test-WSLDistro $script:wslDistro)))
+            {  
+              Write-Output "Error: value of `"--wsl`" flag is not an installed WsL distro: $script:wslDistro." "Exiting"
+              exit 33
+            }
+          if (-not (Test-MedleyInstalled $script:wslDistro))
+            {
+              Write-Output "Error: value of `"--wsl`" flag is an installed WsL distro, but Medley is not installed in standard location: $script:wslDistro." "Exiting"
+              exit 33
+            }
+          $idx++
+        }
+      { @("-x", "--logindir") -contains $_ }
+        {
+          $script:logindir=$args[$idx+1]
+          $idx++
+        }
+      { @("-y", "--draft") -contains $_ }
+        {
+          $script:draft="draft"
+        }
+      { $_ -eq "--" }
+        {
+          $passRest=$true
+          $script:medleyArgs += $_
+        }
+      default
+        { 
+          $script:medleyArgs += $_
+        }
+      }
+    }
+  if ($script:logindir)
+    {
+      if ($script:wsl)
+        {
+          $script:medleyArgs = @( "--logindir", $script:logindir) + $script:medleyArgs
+        }
+    }
+  if ($script:update -and $script:wsl) 
+    {
+       Write-Output "Warning: Both the -u or --update flag and the -w or --wsl flags were given. "
+       Write-Output "The -u or --update flag is not relevant for wsl." 
+       Write-Output "Ignoring the -u or --update flag."
+    }
+  if ($vncRequested)
+    {
+      if (-not $script:wsl) 
+        {
+          Write-Output "Warning: The -v or --vnc flag is not relevant when running under docker"
+          Write-Output "Ignoring the -v or --vnc flag."
+        }
+      else
+        {
+          $script:medleyArgs = @( "--vnc") + $script:medleyArg
+        }
+    }
+  if ($script:wsl -and $displayFlag)
+    {
+      $script:medleyArgs = @( "--display", "$display") + $script:medleyArg
+    }
+}
+
+ 
+
+###############################################################################
+
+#
+#  Main script
+#
+
+#
+#  Process the arguments
+#
+Process-Args @args
+
+#
+# If we're not calling wsl, check if docker is installed and running,
+# check if logindir is a legitamte directory, do the pull if required.
+#
+if (-not $wsl)
+  {
+    # Make sure docker is installed
+    if (-not (Test-DockerInstalled) )
+      {
+        Write-Output "Error: Docker is not installed on this system."
+        Write-Output "This medley app requires Docker unless the --wsl flag is used"
+        Write-Output "Exiting."
+        exit 34
+      }
+    # Make sure docker is running
+    if (-not (Test-DockerRunning) )
+      {
+        Write-Output "Error: The Docker engine is installed but not currently running on this system."
+        Write-Output "This medley app requires the Docker Engine running unless the --wsl flag is used"
+        Write-Output "Exiting."
+        exit 33
+      }
+     # Check/create logindir
+     if (-not (Test-Path -Path $logindir -PathType Container))
+       {
+         try 
+           {
+             $null = New-Item -ItemType Directory -Path ${logindir} -Force -ErrorAction Stop
+           }
+         catch 
+           {
+             Write-Output "Error: The specified logindir does not exist and cannot be created: ${logindir}"
+             Write-Output "Exiting."
+             exit 35
+           }
+       }
+    # Do a pull if required
+    if ($update -or (-not (docker image ls interlisp/medley:${draft} | Select-String medley)))
+      {
+        docker pull interlisp/medley:${draft}
+      }
+  } 
+
+#
+#  Call wsl or run docker
+#
+if ($wsl)
+  {
+    #
+    # Call wsl
+    #
+    if ( $wslDistro -eq "-" )
+      {
+        $distro = @()
+      }
+    else
+
+      { 
+        $distro = @( "-d", $wslDistro )
+      }
+    wsl @distro medley @medleyArgs
+  }
+else
+  
+  {
+   #
+   # Run docker and vncviewer
+   #
+
+   # Find an open port to use for vnc
+   if (-not $port) { $port=Find-OpenPort }
+   Write-Output "Using VNC_PORT=$port"
+   
+   
+   # Unless $noviewer is set (i.e., if --help and --man flag are set),
+   # start the vncviwer in the background.
+   # But wait for the docker container to actually come up
+   # before starting it
+   if (-not $noviewer)
+     {
+       Start-Job -InputObject "$port" -ScriptBlock { 
+         $port = $input.Clone()
+         $stopTime = (Get-Date).AddSeconds(10)
+         $hit=$false
+         while ((-not $hit) -and ((Get-Date) -lt $stopTime))
+           {
+             docker container ls | Select-String 'medley' | Select-String "${port}->5900" | Set-Variable "hit"
+             if (-not $hit) { Start-Sleep -Milliseconds 250 }
+           }
+         if ($hit) 
+           {
+             Write-Host $hit
+             vncviewer64-1.12.0.exe -geometry '+50+50' -ReconnectOnError=off −AlertOnFatalError=off localhost:${port}
+           }
+       } >$null
+     }
+
+   #
+   # Run the docker container using medley as the entrypoint and passing on the args
+   # Run in the foreground unless requested to run in the background by the -b flag.
+   #
+
+   if (-not $bg) 
+     {
+       docker run -it --rm -p ${port}:5900 -v ${logindir}:/home/medley/il --entrypoint medley --env TERM=xterm interlisp/medley:${draft} --windows @medleyArgs
+     }
+   else
+     {
+       $dockerArgs=@("run", "--rm", "-p", "${port}:5900", "-v", "${logindir}:/home/medley/il", "--entrypoint", "medley", "interlisp/medley:${draft}", "--windows") + $medleyArgs
+       Start-Process -NoNewWindow -FilePath "docker" -ArgumentList $dockerArgs
+     }
+  }
+
+###############################################################################
+#
+#  Done
+#
+###############################################################################
+

scripts/medley/medley.sh

@@ -56,13 +56,39 @@ 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 ];
+# Are we running under Docker or if not under WSL?
+if [ -n "${MEDLEY_DOCKER_BUILD_DATE}" ];
 then
-  wsl='true'
-else
+  docker='true'
   wsl='false'
+else
+  docker='false'
+  wsl_ver=0
+  # WSL2
+  grep --ignore-case --quiet wsl /proc/sys/kernel/osrelease
+  if [ $? -eq 0 ];
+  then
+    wsl='true'
+    wsl_ver=2
+  else
+    # WSL1
+    grep --ignore-case --quiet microsoft /proc/sys/kernel/osrelease
+    if [ $? -eq 0 ];
+    then
+      if [ $(uname -m) = x86_64 ];
+      then
+        wsl='true'
+        wsl_ver=1
+      else
+        echo "ERROR: Running Medley on WSL1 requires an x86_64-based PC."
+        echo "This is not an x86_64-based PC."
+        echo "Exiting"
+        exit 23
+      fi
+    else
+      wsl='false'
+    fi
+  fi
 fi
 
 # process args
@@ -79,7 +105,7 @@ then
   exit 3
 fi
 
-# Set the LDEDESTSYSOUT env variable based on id
+# Set LDEDESTSYSOUT env variable based on id
 if [ -z ${LDEDESTSYSOUT} ];
 then
   if [ "${run_id}" = "default" ];
@@ -104,12 +130,12 @@ fi
 mkdir -p ${LOGINDIR}/vmem
 
 # Call run-medley with or without vnc
-if [[ ${wsl} = false || ${use_vnc} = false ]];
+if [[ ( ${wsl} = false || ${use_vnc} = false ) && ${docker} = false ]];
 then
   # If not using vnc, just call run-medley
-  ${MEDLEYDIR}/run-medley -id "${run_id}" ${geometry} ${screensize} "${run_args[@]}"
+  ${MEDLEYDIR}/run-medley -id "${run_id}" ${geometry} ${screensize} ${run_args[@]}
 else
-  # do the vnc thing on wsl
+  # do the vnc thing on wsl or docker
   source ${SCRIPTDIR}/medley_vnc.sh
 fi
 

scripts/medley/medley_args.sh

@@ -14,27 +14,53 @@
 # load usage function
 source ${SCRIPTDIR}/medley_usage.sh
 
-# Process args
+# Defaults
+apps_flag=false
+err_msg=""
+full_flag=false
+geometry=""
+greet_specified=false
+lisp_flag=false
+noscroll=false
+pass_args=false
 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'
+use_vnc=false
+windows=false
 
+# Loop thru args and process
 while [ "$#" -ne 0 ];
 do
   if [ ${pass_args} = false ];
   then
     case "$1" in
+      -a | --apps)
+        sysout_arg="apps"
+        apps_flag=true
+        ;;
+      -d | --display)
+        check_for_dash_or_end "$1" "$2"
+        run_args+=(-d $2)
+        shift
+        ;;
+      -e | --interlisp)
+        export MEDLEY_EXEC="inter"
+        ;;
+      -f | --full)
+        sysout_arg="-full"
+        full_flag=true
+        ;;
+      -g | --geometry)
+        check_for_dash_or_end "$1" "$2"
+        geometry="$2"
+        shift
+        ;;
+      -h | --help)
+        usage
+        ;;
       -i | --id)
         if [ "$2" = "-" ];
         then
@@ -48,6 +74,47 @@ do
         fi
         shift
         ;;
+      -k | --vmem)
+        check_for_dash_or_end "$1" "$2"
+        check_file_writeable_or_creatable "$1" "$2"
+        export LDEDESTSYSOUT="$2"
+        shift
+        ;;
+      -l | --lisp)
+        sysout_arg="-lisp"
+        lisp_flag=true
+        ;;
+      -m | --mem)
+        check_for_dash_or_end "$1" "$2"
+        run_args+=(-m $2)
+        shift
+        ;;
+      -n | --noscroll)
+        noscroll=true
+        run_args+=("-noscroll")
+        ;;
+      -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
+        ;;
+      -s | --screensize)
+        check_for_dash_or_end "$1" "$2"
+        screensize="$2"
+        shift
+        ;;
+      -t | --title)
+        check_for_dash_or_end "$1" "$2"
+        run_args+=(-title $2)
+        shift
+        ;;
       -v | --vnc)
         if [[ ${wsl} = true && $(uname -m) = x86_64 ]];
         then
@@ -60,68 +127,6 @@ do
           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
@@ -134,13 +139,14 @@ do
         fi
         shift
         ;;
-      -h | --help)
-        usage
-        ;;
       -z | --man)
         /usr/bin/man -l "${MEDLEYDIR}/docs/man-page/medley.1.gz"
         exit 0
         ;;
+      --windows)
+        # internal:  called from Windows medley.ps1 (via docker)
+        windows=true
+        ;;
       --)
         pass_args=true
         ;;
@@ -190,15 +196,23 @@ then
 fi
 if [ "${sysout_arg}" = "apps" ];
 then
-  export LDESRCESYSOUT="$MEDLEYDIR/loadups/apps.sysout"
+  export LDESRCESYSOUT="${MEDLEYDIR}/loadups/apps.sysout"
   if [ "${greet_specified}" = "false" ];
   then
-    export LDEINIT="$MEDLEYDIR/greetfiles/APPS-INIT.LCOM"
+    export LDEINIT="${MEDLEYDIR}/greetfiles/APPS-INIT.LCOM"
   fi
 else
   # pass on to run-medley
-  export LDESRCESYSOUT=""
-  run_args+=("${sysout_arg}")
+  unset LDESRCESYSOUT
+  if [ -n "${sysout_arg}" ];
+  then
+    run_args+=("${sysout_arg}")
+  fi
 fi
 
+# if running on WSL1, force use_vnc
+if [[ ${wsl} = true && ${wsl_ver} -eq 1 ]];
+then
+  use_vnc=true
+fi
 

scripts/medley/medley_usage.sh

@@ -17,6 +17,34 @@ usage() {
    local err_msg
    local msg_path=/tmp/msg-$$
    local lines=("$@")
+
+   if [ ${wsl} = true ];
+   then
+     wsl_incl="+w"
+     wsl_excl="-w"
+   else
+     wsl_incl="-w"
+     wsl_excl="+w"
+   fi
+
+   if [ ${docker} = true ];
+   then
+     docker_incl="+d"
+     docker_excl="-d"
+   else
+     docker_incl="-d"
+     docker_excl="+d"
+   fi
+
+   if [ ${windows} = true ];
+   then
+     windows_incl="+W"
+     windows_excl="-W"
+   else
+     windows_incl="-W"
+     windows_excl="+W"
+   fi
+
    if [ $# -ne 0 ];
    then
      echo > ${msg_path}
@@ -26,7 +54,12 @@ usage() {
    else
      touch ${msg_path}
    fi
-   cat ${msg_path} - <<EOF | ${PAGER}
+
+   cat ${msg_path} - <<EOF \
+       | sed -e "/^${docker_excl}/d" -e "s/^${docker_incl}/  /" \
+       | sed -e "/^${wsl_excl}/d" -e "s/^${wsl_incl}/  /" \
+       | sed -e "/^${windows_excl}/d" -e "s/^${windows_incl}/  /" \
+       | ${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
@@ -56,8 +89,8 @@ flags:
     -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
++w
++w  -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)
 
@@ -67,20 +100,33 @@ flags:
 
     -m N | --mem N             : set Medley memory size to N
 
-    -p FILE | --vmem FILE      : use FILE as the Medley virtual memory store
+    -k FILE | --vmem FILE      : use FILE as the Medley virtual memory store.
++d                               FILE must be a file in the Medley file system under LOGINDIR (/home/medley/il).
 
-    -r FILE | --greet FILE     : use FILE as the Medley greetfile
+    -r FILE | --greet FILE     : use FILE as the Medley greetfile.
++d                               FILE must be a file in the Medley file system under LOGINDIR (/home/medley/il).
 
     -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
+-d
+-d  -x DIR | --logindir DIR    : use DIR as LOGINDIR in Medley
+-d
+-d  -x - | --logindir -        : use MEDLEYDIR/logindir as LOGINDIR in Medley
++d
++d  -x DIR | --logindir DIR    : use DIR (on the host) to map to LOGINDIR (/home/medley/il) in Medley
++d
++d  -p N | --port N            : use N as the port for connecting to the Xvnc server inside the Docker container
++d
++d  -u | --update              : first do a pull to get the latest medley Docker image
++W
++W  -w DISTRO | --wsl DISTRO   : run in WSL (on the named DISTRO) instead of in a Docker container
++W
++W  -b | --background          : run as background process
 
 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.
+    The pathname of the file to use as a sysout for Medley to start from.
++d  The pathname must be in the Medley file system under LOGINDIR (/home/medley/il).
+    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 previous run with the sane id as this run.
 
 pass_args:
     All arguments after the "--" flag, are passed unaltered to lde via run-medley.

scripts/medley/medley_vnc.sh

@@ -21,15 +21,23 @@
   find_open_display() {
     local ctr=1
     local result=-1
+    local locked_pid=0
     while [ ${ctr} -lt 64 ];
     do
-      ss -a | grep -q "tmp/.X11-unix/X${ctr}[^0-9]"
-      if [ $? -ne 0 ];
+      if [ ! -e /tmp/.X${ctr}-lock ];
       then
         result=${ctr}
         break
       else
-        (( ctr++ ))
+        locked_pid=$(cat /tmp/.X${ctr}-lock)
+        ps lax | awk '{print $3}' | grep --quiet ${locked_pid} >/dev/null
+        if [ $? -eq 1 ];
+        then
+          result=${ctr}
+          break
+        else
+          (( ctr++ ))
+        fi
       fi
     done
     echo ${result}
@@ -40,8 +48,13 @@
     local result=-1
     while [ ${ctr} -lt 6000 ];
     do
-      ss -a | grep -q "LISTEN.*:${ctr}[^0-9]"
-      if [ $? -ne 0 ];
+      if [[ ${wsl} = true && ${wsl_ver} -eq 1 ]];
+      then
+        netstat.exe -a -n | awk '{ print $2 }' | grep -q ":${ctr}\$"
+      else
+        ss -a | grep -q "LISTEN.*:${ctr}[^0-9]"
+      fi
+      if [ $? -eq 1 ];
       then
         result=${ctr}
         break
@@ -53,102 +66,185 @@
   }
 
   #
-  # Make sure prequisites for vnc support are in place
+  # Make sure prequisites for vnc support in wsl 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 ]];
+  if [ "${use_vnc}" = "true" ];
   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}" ];
+    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
-      # 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' ]];
+      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
-        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
+        # 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
-        pushd "${vnc_dir}" >/dev/null
-        wget https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
-        popd >/dev/null
+        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
   fi
-
   #
-  #  Find an unused display, start Xvnc, run-medley, then start the vnc viewer on the windows side
+  #  Start the log file so we can trace any issues with vnc, etc
   #
-  #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 ];
+  #
+  # If we're running under docker:
+  #    set the VNC_PORT to the value of the --port flag (or its default value)
+  #    set DISPLAY to :0
+  #
+  #set -x
+  if [ "${docker}" = "true" ];
   then
-    echo "Error: cannot find an unused DISPLAY between 1 and 63"
-    echo "Exiting"
-    exit 33
+     export VNC_PORT=5900
+     export DISPLAY=:0
   else
-    echo "Using DISPLAY=${OPEN_DISPLAY}"
+    # are we running in background - used for pretty-fying the echos
+    case $(ps -o stat= -p $$) in
+      *+*) bg=false ;;
+      *) bg=true ;;
+    esac
+    #  For not docker (i.e., for wsl/vnc)
+    #    find an unused display and an available port
+    #
+    #set -x
+    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
+      if [ ${bg} = true ]; then echo; fi
+      echo "Using DISPLAY=:${OPEN_DISPLAY}"
+    fi
+    export DISPLAY=":${OPEN_DISPLAY}"
+    export 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
   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
+  #
+  #  Start the Xvnc server
+  #
   mkdir -p ${LOGINDIR}/logs
-  /usr/bin/Xvnc ":${OPEN_DISPLAY}" \
+  /usr/bin/Xvnc "${DISPLAY}" \
                 -rfbport ${VNC_PORT} \
                 -geometry "${geometry#-g }" \
                 -SecurityTypes None \
                 -NeverShared \
                 -DisconnectClients=0 \
+                --MaxDisconnectionTime=10 \
                 >> ${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
+
+  # Leaving pid wait for all but docker,
+  # which seems to need it.  For all others
+  # it seems like its not needed but we'll have
+  # to see how it runs on slower/faster machines
+  # FGH 2023-02-16
+  if [ ${docker} = true ];
+  then
+    xvnc_pid=""
+    end_time=$(expr $(date +%s) + 10)
+    while [ -z "${xvnc_pid}" ];
+    do
+      if [ $(date +%s) -gt $end_time ];
+      then
+         echo "Xvnc server failed to start."
+         echo "See log file at ${LOG}"
+         echo "Exiting"
+         exit 3
+      fi
+      sleep .125
+      xvnc_pid=$(pgrep -f "Xvnc ${DISPLAY}")
+    done
+    # echo "XVNC_PID is ${xvnc_pid}"
+  fi
+  #
+  # Run Medley in foreground if docker, else in background
+  #
+  tmp_dir=$(if [[ -d /run/shm && ! -h /run/shm ]]; then echo "/run/shm"; else echo "/tmp"; fi)
+  medley_run=$(mktemp --tmpdir=${tmp_dir} medley-XXXXX)
+  cat > ${medley_run} <<..EOF
+    #!/bin/bash
+    ${MEDLEYDIR}/run-medley -id '${run_id}' ${geometry} ${screensize} ${run_args[@]} \
+         2>&1 | tee -a ${LOG} | grep -v "broken (explicit kill"
+    if [ -n "\$(pgrep -f "${vnc_exe}.*:${VNC_PORT}")" ]; then vncconfig -disconnect; fi
+..EOF
+  #cat ${medley_run}
+  chmod +x ${medley_run}
+  if [ "${docker}" = "true" ];
+  then
+    ${medley_run}; rm ${medley_run}
+  else
+    (${medley_run}; rm ${medley_run}) &
+    #
+    #  If not docker (i.e., if wsl/vnc), start the vncviewer on the windows side
+    #
+
+    #  First give medley time to startup
+    #  sleep .25
+    #  SLeep appears not to be needed, but faster/slower machines ????
+    #  FGH 2023-02-08
+
+    #  Then start vnc viewer on Windows side
+    start_time=$(date +%s)
+    ${vnc_dir}/${vnc_exe} \
+                 -geometry "+50+50" \
+                 -ReconnectOnError=off \
+                 −AlertOnFatalError=off \
+                 $(ip_addr):${VNC_PORT} \
+                 >>${LOG} 2>&1 &
+    wait $!
+    if [ $( expr $(date +%s) - ${start_time} ) -lt 5 ];
+    then
+      if [ -z "$(pgrep -f "Xvnc ${DISPLAY}")" ];
+      then
+        echo "Xvnc server failed to start."
+        echo "See log file at ${LOG}"
+        echo "Exiting"
+        exit 3
+      else
+        echo "VNC viewer failed to start.";
+        echo "See log file at ${LOG}";
+        echo "Exiting" ;
+        exit 4;
+      fi
+    fi
+  fi
+  #
+  #  Done, "Go back" to medley.sh
+  #
+  true
+
+#######################################

sources/ADIR

@@ -1,15 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Oct-2022 23:50:03" {WMEDLEY}<sources>ADIR.;19
 66146  
+
(FILECREATED "11-May-2023 21:39:25" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2
 65907  
 
-      :CHANGES-TO (FNS \COPYSYS)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "31-Oct-2022 14:16:39" {WMEDLEY}<sources>ADIR.;18)
+      :CHANGES-TO (FNS OPENFILE)
 
+      :PREVIOUS-DATE "31-Oct-2022 23:50:03" 
+{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1)
 
-(* ; "
-Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT ADIRCOMS)
 
@@ -92,11 +91,9 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
     (OPENFILE
 FILE 'BOTH 'OLD])
 
 (OPENFILE

-  [LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL)
        (* ; "Edited 23-May-91 19:12 by jds")

-    (if
 MULTIPLE.STREAMS.PER.FILE.ALLOWED
-        then
 (OPENSTREAM
 FILE ACCESS RECOG PARAMETERS OPTIONAL)
-      else
 (fetch
 (STREAM FULLNAME) of
 (OPENSTREAM
 FILE ACCESS RECOG PARAMETERS 
-                                                          OPTIONAL])
+  [LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL)
            (* ; "Edited 11-May-2023 21:05 by lmm")


+                                                             (* ; "Edited 23-May-91 19:12 by jds")

+    (FULLNAME
 (OPENSTREAM
 FILE ACCESS RECOG PARAMETERS OPTIONAL])
 
 (OPENSTREAM

   [LAMBDA (FILE ACCESS RECOG PARAMETERS OBSOLETE)
       (* ; "Edited 13-Jun-2021 11:25 by rmk:")

@@ -1231,17 +1228,15 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 
 (ADDTOVAR LAMA
 PACKFILENAME.STRING PACKFILENAME)
 )
-(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 (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)))))
+  (FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP 
+3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944
+) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971)
+ (\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 (
+UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME 
+38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 . 
+40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 (
+FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT 
+59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) (
+\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573)))))
 STOP

sources/AOFD

@@ -1,34 +1,32 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED " 9-Aug-2021 23:30:19" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;5
 38301  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS AOFDCOMS)
-                    (FNS \STRINGSTREAM.INIT)
+
(FILECREATED "11-May-2023 21:39:26" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;2
 36068  
 
-      previous date%: " 8-Aug-2021 00:11:00" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;4)
+      :EDIT-BY "lmm"
 
+      :CHANGES-TO (VARS AOFDCOMS)
+                  (FNS CLOSEF)
+
+      :PREVIOUS-DATE "29-Apr-2023 05:38:34" 
+{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;1)
 
-(* ; "
-Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT AOFDCOMS)
 
 (RPAQQ AOFDCOMS

        [
 
-(* ;;; "streams (= OpenFileDescriptors)")

+(* ;;; "streams (= OpenFileDescriptors)")

 
         (COMS (FNS \ADD-OPEN-STREAM \GENERIC-UNREGISTER-STREAM)
               (INITVARS (*ISSUE-CLOSE-WARNINGS* NIL))
               (FNS CLOSEALL CLOSEF EOFCLOSEF INPUT OPENP OUTPUT POSITION RANDACCESSP \IOMODEP 
                    WHENCLOSE)
               (FNS STREAMADDPROP)
-              (INITVARS (DEFAULTEOFCLOSE 'NILL)
-                     (\OPENFILES))
-              (GLOBALVARS DEFAULTEOFCLOSE \OPENFILES))
+              (INITVARS (DEFAULTEOFCLOSE 'NILL))
+              (GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV))
         (COMS 
-              (* ;; "STREAM interface to Read and Write to random memory")

+              (* ;; "STREAM interface to Read and Write to random memory")

 
               (DECLARE%: DONTCOPY (EXPORT (RECORDS BASEBYTESTREAM)))
               (FNS \BASEBYTES.IO.INIT \MAKEBASEBYTESTREAM \MBS.OUTCHARFN \BASEBYTES.NAME.FROM.STREAM
@@ -39,13 +37,13 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
               (FNS OPENSTRINGSTREAM MAKE-STRING-FORMAT)
               (P (MAKE-STRING-FORMAT)))
         (COMS 
-              (* ;; "STREAM interface for old-style strings.  However (RMK), it appears never to be used, and even commonlisp string-streams are created using the Interlisp OPENSTRINGSTREAM above.  For now, keep the function, but don't execute it")

+              (* ;; "STREAM interface for old-style strings.  However (RMK), it appears never to be used, and even commonlisp string-streams are created using the Interlisp OPENSTRINGSTREAM above.  For now, keep the function, but don't execute it")

 
               (FNS \STRINGSTREAM.INIT)
               
-              (* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))")

+              (* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))")

 )
-        (COMS (FNS GETSTREAM \ADDOFD \CLEAROFD \DELETEOFD \GETSTREAM \SEARCHOPENFILES)
+        (COMS (FNS GETSTREAM \CLEAROFD \GETSTREAM)
               (DECLARE%: DONTCOPY (EXPORT (MACROS \INSTREAMARG \OUTSTREAMARG \STREAMARG)))
               (MACROS GETOFD \GETOFD))
         (LOCALVARS . T)
@@ -60,7 +58,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (\ADD-OPEN-STREAM

-  [LAMBDA (DEVICE STREAM)                                    (* hdj "28-May-86 11:22")
+  [LAMBDA (DEVICE STREAM)                                    (* hdj "28-May-86 11:22")

     (if
 (NOT (STREAMP STREAM))
         then
 (\ILLEGAL.ARG STREAM))
     (pushnew
 (fetch
 (FDEV OPENFILELST) of
 DEVICE)
@@ -68,9 +66,9 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
     STREAM])
 
 (\GENERIC-UNREGISTER-STREAM

-  [LAMBDA (DEVICE STREAM)                                    (* hdj "22-Sep-86 18:30")
+  [LAMBDA (DEVICE STREAM)                                    (* hdj "22-Sep-86 18:30")

 
-(* ;;; "Remove an open stream from the list of streams kept by DEVICE.  Assumes the use of the FDEV's OPENFILELSTto store the streams.  Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")
+(* ;;; "Remove an open stream from the list of streams kept by DEVICE.  Assumes the use of the FDEV's OPENFILELSTto store the streams.  Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")

 
     (DECLARE
 (GLOBALVARS *ISSUE-CLOSE-WARNINGS*))
     (if
 (NOT (STREAMP STREAM))
@@ -86,19 +84,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (CLOSEALL

-  [LAMBDA (ALLFLG)
-    (DECLARE
 (LOCALVARS . T))                                (* hdj "11-Jul-86 10:33")
-    (if
 MULTIPLE.STREAMS.PER.FILE.ALLOWED
-        then
 (ERROR "CLOSEALL no longer supported")
-      else
 (for
 STREAM in
 (PROG1 (APPEND \OPENFILES)         (* ; 
-                                   "Need to APPEND because CLOSEF will remove things from \OPENFILES")
-                                 ) when
 [AND (fetch
 USERVISIBLE of
 STREAM)
-                                             (\IOMODEP
 STREAM NIL T)
-                                             (OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
-              collect
 (CLOSEF
 STREAM])
+  [LAMBDA (ALLFLG)
                                           (* ; "Edited 28-Apr-2023 20:51 by lmm")

+    (for
 STREAM in
 (OPENP
) when
 [AND (fetch
 USERVISIBLE of
 STREAM)
+                                     (fetch
 USERCLOSEABLE of
 STREAM)
+                                     (\IOMODEP
 STREAM NIL T)
+                                     (OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
+       collect
 (CLOSEF
 STREAM])
 
 (CLOSEF

-  [LAMBDA (FILE)
                                        (* ; "Edited 13-Jun-2021 11:26 by rmk:")

+  [LAMBDA (FILE)
                                             (* ; "Edited 11-May-2023 21:18 by lmm")


+                                                            (* ; "Edited 13-Jun-2021 11:26 by rmk:")

     (PROG ((STREAM (\GETSTREAM
 FILE)))
           (COND
              ((OR (\OUTTERMP STREAM)
@@ -114,10 +109,8 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
           (COND
              ((EQ STREAM *STANDARD-OUTPUT*)
               (SETQ *STANDARD-OUTPUT* \TERM.OFD)))
-          (AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
-               (\DELETEOFD
 STREAM))
 
-     (* ;; "Logical close before physical close;  otherwise, we might have a logically open file with no physically open file behind it.  (Device LPT depends on this)")

+     (* ;; "Logical close before physical close;  otherwise, we might have a logically open file with no physically open file behind it.  (Device LPT depends on this)")

 
           (\CLOSEFILE STREAM)
           [MAPC (STREAMPROP STREAM 'AFTERCLOSE)
@@ -126,7 +119,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
           (RETURN (fetch
 (STREAM FULLNAME) of
 STREAM])
 
 (EOFCLOSEF

-  [LAMBDA (FILE)                                             (* bvm%: "15-Jan-85 17:58")
+  [LAMBDA (FILE)                                             (* bvm%: "15-Jan-85 17:58")

     (DECLARE
 (LOCALVARS . T))
     (PROG ((STREAM (GETSTREAM
 FILE)))
           (APPLY* (OR (STREAMPROP STREAM 'EOFCLOSE)
@@ -134,21 +127,21 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                  STREAM])
 
 (INPUT

-  [LAMBDA (FILE)
                                        (* ; "Edited 13-Jun-2021 11:27 by rmk:")

+  [LAMBDA (FILE)
                                            (* ; "Edited 13-Jun-2021 11:27 by rmk:")

     (PROG1 (if
 (EQ *STANDARD-INPUT* \LINEBUF.OFD)
                then
 T
              else
 (if
 MULTIPLE.STREAMS.PER.FILE.ALLOWED
-                          then
 *STANDARD-INPUT*
-                        else
 (fetch
 (STREAM FULLNAME) of
 *STANDARD-INPUT*)))
+                      then
 *STANDARD-INPUT*
+                    else
 (fetch
 (STREAM FULLNAME) of
 *STANDARD-INPUT*)))
         [COND
            (FILE (SETQ *STANDARD-INPUT* (COND
-                                           ((EQ FILE T)      (* ; 
-
                                               "Check explicitly for T to avoid needless creations")

+                                           ((EQ FILE T)      (* ; 
+
                                                 "Check explicitly for T to avoid needless creations")

                                             \LINEBUF.OFD)
                                            (T (\GETSTREAM
 FILE 'INPUT])])
 
 (OPENP

-  [LAMBDA (FILE ACCESS)                                      (* hdj "29-Sep-86 17:41")
+  [LAMBDA (FILE ACCESS)                                      (* hdj "29-Sep-86 17:41")

     (DECLARE
 (GLOBALVARS MULTIPLE.STREAMS.PER.FILE.ALLOWED \FILEDEVICES))
     (if
 (AND FILE (type?
 STREAM FILE))
         then
 (\GETSTREAM
 FILE ACCESS T)
@@ -158,45 +151,44 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                   \FILEDEVICES NIL])
 
 (OUTPUT

-  [LAMBDA (FILE)
                                        (* ; "Edited 13-Jun-2021 11:27 by rmk:")

+  [LAMBDA (FILE)
                                            (* ; "Edited 13-Jun-2021 11:27 by rmk:")

     (PROG1 (if
 (EQ *STANDARD-OUTPUT* \TERM.OFD)
                then
 T
              else
 (if
 MULTIPLE.STREAMS.PER.FILE.ALLOWED
-                          then
 *STANDARD-OUTPUT*
-                        else
 (fetch
 (STREAM FULLNAME) of
 *STANDARD-OUTPUT*)))
+                      then
 *STANDARD-OUTPUT*
+                    else
 (fetch
 (STREAM FULLNAME) of
 *STANDARD-OUTPUT*)))
         [COND
            (FILE (SETQ *STANDARD-OUTPUT* (COND
-                                            ((EQ FILE T)     (* ; 
-
                                "Check for this special so we don't create a tty window needlessly")

+                                            ((EQ FILE T)     (* ; 
+
                                  "Check for this special so we don't create a tty window needlessly")

                                              \TERM.OFD)
                                             (T (\GETSTREAM
 FILE 'OUTPUT])])
 
 (POSITION

-  [LAMBDA (FILE N)                                           (* ; "Edited 17-Jan-87 16:08 by bvm:")
+  [LAMBDA (FILE N)
                                           (* ; "Edited 17-Jan-87 16:08 by bvm:")

     (PROG [(STRM (COND
                     (FILE (\GETSTREAM
 FILE))
                     (T *STANDARD-OUTPUT*]
           (RETURN (PROG1 (fetch
 CHARPOSITION of
 STRM)
-                         (COND
-                            (N (replace
 CHARPOSITION of
 STRM with
 (COND
-                                                                     ((IGREATERP N 0)
-                                                                      N)
-                                                                     (T 
-                                                             (* ; "compatible with PDP-10 version")
-                                                                        0])
+                      [COND
+                         (N (replace
 CHARPOSITION of
 STRM with
 (COND
+                                                                  ((IGREATERP N 0)
+                                                                   N)
+                                                                  (T 
+                                                             (* ; "compatible with PDP-10 version")

+                                                                     0])])
 
 (RANDACCESSP

-  [LAMBDA (FILE)
                                        (* ; "Edited 13-Jun-2021 11:28 by rmk:")

+  [LAMBDA (FILE)
                                            (* ; "Edited 13-Jun-2021 11:28 by rmk:")

     (PROG ((STREAM (\GETSTREAM
 FILE)))
-          (RETURN (AND (fetch
 (FDEV RANDOMACCESSP) of
 (fetch
 (STREAM DEVICE) of

-                                                                                         STREAM))
+          (RETURN (AND (fetch
 (FDEV RANDOMACCESSP) of
 (fetch
 (STREAM DEVICE) of
 STREAM))
                        (NEQ STREAM \LINEBUF.OFD)
                        (fetch
 (STREAM FULLNAME) of
 STREAM])
 
 (\IOMODEP

-  [LAMBDA (STREAM ACCESS NOERROR)                            (* rmk%: "21-OCT-83 11:10")
-          
-          (* ;; "Returns STREAM if it represents a File open with access mode ACCESS")
+  [LAMBDA (STREAM ACCESS NOERROR)                            (* rmk%: "21-OCT-83 11:10")

+
+    (* ;; "Returns STREAM if it represents a File open with access mode ACCESS")

 
     (COND
        ([COND
@@ -213,7 +205,8 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
        (T (\FILE.NOT.OPEN STREAM NOERROR])
 
 (WHENCLOSE

-  [LAMBDA NARGS                                              (* lmm " 2-Sep-84 16:07")
+  [LAMBDA NARGS
                                              (* ; "Edited 28-Apr-2023 21:19 by lmm")

+                                                             (* lmm " 2-Sep-84 16:07")

     (DECLARE
 (LOCALVARS . T))
     (PROG [(STREAM (AND (IGREATERP NARGS 0)
                         (GETSTREAM
 (ARG NARGS 1]
@@ -226,9 +219,9 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                                                                (YES NIL)
                                                                (ERRORX (LIST 27 FN])
                     (BEFORE (COND
-                               (FN (STREAMADDPROP
 STREAM 'BEFORECLOSE FN T))))
+                               (FN (STREAMADDPROP
 STREAM 'BEFORECLOSE FN))))
                     (AFTER (COND
-                              (FN (STREAMADDPROP
 STREAM 'AFTERCLOSE FN T))))
+                              (FN (STREAMADDPROP
 STREAM 'AFTERCLOSE FN))))
                     (STATUS (STREAMPROP STREAM 'STATUSFN FN))
                     (EOF (STREAMPROP STREAM 'EOFCLOSE FN))
                     (ERRORX (LIST 27 (ARG NARGS I]
@@ -242,11 +235,9 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 )
 
 (RPAQ? DEFAULTEOFCLOSE
 'NILL)
-
-(RPAQ? \OPENFILES
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES)
+(GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV)
 )
 
 
@@ -257,15 +248,12 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
 (RECORD BASEBYTESTREAM
 STREAM (SUBRECORD STREAM)
-                                 [ACCESSFNS ((BIASOFFST (fetch
 (STREAM FW6) of
 DATUM)
-                                                    (replace
 (STREAM FW6) of
 DATUM
-                                                       with
 NEWVALUE))
-                                             (BBSNCHARS (fetch
 (STREAM FW7) of
 DATUM)
-                                                    (replace
 (STREAM FW7) of
 DATUM
-                                                       with
 NEWVALUE))
-                                             (WRITEXTENSIONFN (fetch
 (STREAM F1) of
 DATUM)
-                                                    (replace
 (STREAM F1) of
 DATUM
-                                                       with
 NEWVALUE])
+                             [ACCESSFNS ((BIASOFFST (fetch
 (STREAM FW6) of
 DATUM)
+                                                (replace
 (STREAM FW6) of
 DATUM with
 NEWVALUE))
+                                         (BBSNCHARS (fetch
 (STREAM FW7) of
 DATUM)
+                                                (replace
 (STREAM FW7) of
 DATUM with
 NEWVALUE))
+                                         (WRITEXTENSIONFN (fetch
 (STREAM F1) of
 DATUM)
+                                                (replace
 (STREAM F1) of
 DATUM with
 NEWVALUE])
 )
 
 (* "END EXPORTED DEFINITIONS")
@@ -275,7 +263,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 
 (\BASEBYTES.IO.INIT

   [LAMBDA NIL
-    (DECLARE
 (GLOBALVARS \BASECHARDEVICE))
           (* ; "Edited 13-Sep-90 16:27 by jds")

+    (DECLARE
 (GLOBALVARS \BASECHARDEVICE))
                   (* ; "Edited 13-Sep-90 16:27 by jds")

 
     (* ;; "Initialize the FDEV for base-bytes type devices (e.g. string streams).")

 
@@ -319,7 +307,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 
                                       (replace
 BBSNCHARS of
 STREAM
                                          with
 (IDIFFERENCE (fetch
 COFFSET of
 STREAM)
-                                                         (fetch
 BIASOFFST of
 STREAM]
+                                                     (fetch
 BIASOFFST of
 STREAM]
             SETFILEPTR _ (FUNCTION \BASEBYTES.SETFILEPTR)
             GETFILEPTR _ [FUNCTION (LAMBDA (STREAM)
                                      (IDIFFERENCE (fetch
 COFFSET of
 STREAM)
@@ -338,10 +326,9 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
     (\DEFINEDEVICE NIL \BASEBYTESDEVICE])
 
 (\MAKEBASEBYTESTREAM

-  [LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM)

-                                                            (* ; "Edited 13-Jun-2021 11:33 by rmk:")

+  [LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM)
   (* ; "Edited 13-Jun-2021 11:33 by rmk:")

 
-    (* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")

+    (* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")

 
     (OR BASE (EQ LEN 0)
         (SHOULDNT))
@@ -355,53 +342,50 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
         (\ILLEGAL.ARG ACCESS))
     (if
 (type?
 STREAM OSTREAM)
         then
 (if
 (EQ (ffetch
 (STREAM DEVICE) of
 OSTREAM)
-                             \BASEBYTESDEVICE)
-                     then
 (replace
 (STREAM ACCESS) of
 OSTREAM with
 NIL)
-                   else
 (CLOSEF
 OSTREAM)
-                         (SETQ OSTREAM (create
 BASEBYTESTREAM
-                                              DEVICE _ \BASEBYTESDEVICE smashing
 OSTREAM)))
+                     \BASEBYTESDEVICE)
+                 then
 (replace
 (STREAM ACCESS) of
 OSTREAM with
 NIL)
+               else
 (CLOSEF
 OSTREAM)
+                    (SETQ OSTREAM (create
 BASEBYTESTREAM
+                                         DEVICE _ \BASEBYTESDEVICE smashing
 OSTREAM)))
       else
 (SETQ OSTREAM (create
 BASEBYTESTREAM
-                                    DEVICE _ \BASEBYTESDEVICE)))
+                                DEVICE _ \BASEBYTESDEVICE)))
     (UNINTERRUPTABLY
         (freplace
 (STREAM USERCLOSEABLE) of
 OSTREAM with
 NIL)
         (freplace
 (STREAM USERVISIBLE) of
 OSTREAM with
 NIL)
         (freplace
 (STREAM BYTESIZE) of
 OSTREAM with
 BITSPERBYTE)
-        (freplace
 (STREAM CPAGE) of
 OSTREAM with
 (freplace
 (STREAM EPAGE)
-                                                                of
 OSTREAM with
 0))
+        (freplace
 (STREAM CPAGE) of
 OSTREAM with
 (freplace
 (STREAM EPAGE) of
 OSTREAM with
 0))
         (freplace
 (STREAM CBUFPTR) of
 OSTREAM with
 BASE)
-        (freplace
 (STREAM COFFSET) of
 OSTREAM with
 (freplace
 (BASEBYTESTREAM 
-                                                                                    BIASOFFST)
-                                                                  of
 OSTREAM with
 OFFST))
-        (freplace
 (STREAM CBUFSIZE) of
 OSTREAM with
 (freplace
 (STREAM EOFFSET)
-                                                                   of
 OSTREAM with
 LEN))
+        (freplace
 (STREAM COFFSET) of
 OSTREAM with
 (freplace
 (BASEBYTESTREAM BIASOFFST) of
 OSTREAM
+                                                      with
 OFFST))
+        (freplace
 (STREAM CBUFSIZE) of
 OSTREAM with
 (freplace
 (STREAM EOFFSET) of
 OSTREAM
+                                                       with
 LEN))
         (replace
 (STREAM ACCESS) of
 OSTREAM with
 ACCESS)
 
-        (* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")

+        (* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")

 
         (freplace
 (STREAM FULLFILENAME) of
 OSTREAM with
 NIL)
         (freplace
 (STREAM OUTCHARFN) of
 OSTREAM with
 (FUNCTION \MBS.OUTCHARFN))
         (freplace
 (STREAM LINELENGTH) of
 OSTREAM with
 0)
         (freplace
 (STREAM CHARPOSITION) of
 OSTREAM with
 0)
         (freplace
 (BASEBYTESTREAM WRITEXTENSIONFN) of
 OSTREAM with
 (SELECTQ ACCESS
-                                                                                   ((OUTPUT BOTH) 
-                                                                                        
-                                                                                      WRITEXTENSIONFN)
-                                                                                   NIL))
+                                                                       ((OUTPUT BOTH) 
+                                                                            WRITEXTENSIONFN)
+                                                                       NIL))
         (freplace
 (BASEBYTESTREAM BBSNCHARS) of
 OSTREAM with
 0))
     OSTREAM])
 
 (\MBS.OUTCHARFN

-  [LAMBDA (STREAM CHAR)                                      (* JonL " 7-NOV-83 21:54")
+  [LAMBDA (STREAM CHAR)                                      (* JonL " 7-NOV-83 21:54")

     (BOUT (SETQ STREAM (\DTEST STREAM 'STREAM))
-          CHAR)                                              (* ; 
-                "The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")
+          CHAR)                                              (* ; 
+
                "The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")

     (add
 (ffetch
 BBSNCHARS of
 STREAM)
          1])
 
 (\BASEBYTES.NAME.FROM.STREAM

-  [LAMBDA (STREAM)                                           (* ; "Edited 17-Jan-87 16:08 by bvm:")
-          
-          (* ;; "STRING streams have a FULLFILENAME which is just the string itself;  other random basebytes streams have this field null")
+  [LAMBDA (STREAM)
                                           (* ; "Edited 17-Jan-87 16:08 by bvm:")

+
+    (* ;; "STRING streams have a FULLFILENAME which is just the string itself;  other random basebytes streams have this field null")

 
     (OR (fetch
 FULLFILENAME of
 STREAM)
         (LIST (fetch
 CBUFPTR of
 STREAM)
@@ -409,7 +393,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
               (GETEOFPTR STREAM])
 
 (\BASEBYTES.BOUT

-  [LAMBDA (STREAM BYTE)                                      (* ; "Edited 17-Jan-87 16:08 by bvm:")
+  [LAMBDA (STREAM BYTE)
                                      (* ; "Edited 17-Jan-87 16:08 by bvm:")

     (PROG (CO)
       A   (if
 (IGEQ (SETQ CO (fetch
 COFFSET of
 STREAM))
                     (fetch
 EOFFSET of
 STREAM))
@@ -418,11 +402,12 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                             (GO A)
                      else
 (ERROR "Attempt to write past end of bytes block")))
           (RETURN (\PUTBASEBYTE (fetch
 CBUFPTR of
 STREAM)
-                         (PROG1 CO (freplace
 COFFSET of
 STREAM with
 (ADD1 CO)))
+                         (PROG1 CO
+                             (freplace
 COFFSET of
 STREAM with
 (ADD1 CO)))
                          BYTE])
 
 (\BASEBYTES.SETFILEPTR

-  [LAMBDA (STREAM I)
                                     (* ; "Edited 13-Sep-90 16:30 by jds")

+  [LAMBDA (STREAM I)
                                         (* ; "Edited 13-Sep-90 16:30 by jds")

 
     (* ;; "SETFILEPTR for string streams &c.")

 
@@ -431,14 +416,13 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
           (if
 (IGREATERP I' (fetch
 EOFFSET of
 STREAM))
               then
 (ERROR "Beyond end of byte range" I)
             else
 
+                 (* ;; "Fix both FILEPTR and CHARPOSITION to match.")

 
-                  (* ;; "Fix both FILEPTR and CHARPOSITION to match.")

-
-                  (replace
 COFFSET of
 STREAM with
 I')
-                  (replace
 BBSNCHARS of
 STREAM with
 I'])
+                 (replace
 COFFSET of
 STREAM with
 I')
+                 (replace
 BBSNCHARS of
 STREAM with
 I'])
 
 (\BASEBYTES.READP

-  [LAMBDA (STREAM FLG)                                       (* ; "Edited 17-Jan-87 16:08 by bvm:")
+  [LAMBDA (STREAM FLG)
                                       (* ; "Edited 17-Jan-87 16:08 by bvm:")

     (PROG ((CO (fetch
 COFFSET of
 STREAM))
            (%#LEFT (fetch
 EOFFSET of
 STREAM)))
           (add
 %#LEFT (IMINUS CO))
@@ -451,33 +435,33 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                                   (CHARCODE CR])
 
 (\BASEBYTES.BIN

-  [LAMBDA (STREAM)                                           (* JonL " 7-NOV-83 22:49")
-          
-          (* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")
-          
-          (* ;; 
-        "Remember also that the VAX version installs a different STRMBINFN for the stringstream case")
+  [LAMBDA (STREAM)                                           (* JonL " 7-NOV-83 22:49")

+
+    (* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")

+
+    (* ;; 
+
    "Remember also that the VAX version installs a different STRMBINFN for the stringstream case")

 
     (PROG1 (\BASEBYTES.PEEKBIN
 STREAM)
-           (add
 (fetch
 COFFSET of
 STREAM)
-                1])
+        (add
 (fetch
 COFFSET of
 STREAM)
+             1))])
 
 (\BASEBYTES.PEEKBIN

-  [LAMBDA (STREAM NOERRORFLG)
                           (* ; "Edited 13-Jun-2021 11:34 by rmk:")

+  [LAMBDA (STREAM NOERRORFLG)
                               (* ; "Edited 13-Jun-2021 11:34 by rmk:")

     (PROG ((CO (fetch
 (STREAM COFFSET) of
 STREAM)))
           (SELECTQ (SYSTEMTYPE)
               (VAX (if
 (fetch
 (STREAM FULLNAME) of
 STREAM)
-                       then
                              (* ; "Aha, it's a string stream")

-                             (RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
+                       then
                                  (* ; "Aha, it's a string stream")

+                            (RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
               NIL)
           (RETURN (if
 (IGEQ CO (fetch
 (STREAM EOFFSET) of
 STREAM))
                       then
 (if
 (NOT NOERRORFLG)
-                                   then
 (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
+                               then
 (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
                     else
 (\GETBASEBYTE (fetch
 (STREAM CBUFPTR) of
 STREAM)
-                                    CO])
+                                CO])
 
 (\BASEBYTES.TRUNCATEFN

-  [LAMBDA (STREAM I)                                         (* JonL " 7-NOV-83 22:20")
+  [LAMBDA (STREAM I)                                         (* JonL " 7-NOV-83 22:20")

     ([LAMBDA (I' BO EO)
        (add
 I' BO)
        (if
 (ILESSP I 0)
@@ -491,7 +475,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
      (fetch
 EOFFSET of
 STREAM])
 
 (\BASEBYTES.OPENFN

-  [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)                 (* ; "Edited 17-Jan-87 16:08 by bvm:")
+  [LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
                 (* ; "Edited 17-Jan-87 16:08 by bvm:")

     (if
 (fetch
 FULLFILENAME of
 NAME)
         then
 (OPENSTRINGSTREAM
 NAME ACCESS)
       else
 (\MAKEBASEBYTESTREAM
 (fetch
 CBUFPTR of
 NAME)
@@ -502,7 +486,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                   NAME])
 
 (\BASEBYTES.BLOCKIO

-  [LAMBDA (STREAM BASE OFFST N DIRECTION)                    (* ; "Edited 17-Jan-87 16:08 by bvm:")
+  [LAMBDA (STREAM BASE OFFST N DIRECTION)
                    (* ; "Edited 17-Jan-87 16:08 by bvm:")

     (PROG (SBASE CO EO)
       A   (if
 (ILEQ N 0)
               then
 (RETURN))
@@ -512,8 +496,8 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
           (if
 (IGREATERP N (IDIFFERENCE EO (SUB1 CO)))
               then
 (if
 (EQ DIRECTION 'INPUT)
                        then
 (STREAMOP 'ENDOFSTREAMOP STREAM STREAM)
-                     else
                                    (* ; 
-                                      "Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")
+                     else
                                    (* ; 
+
                                      "Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")

                           (BOUT STREAM (\GETBASEBYTE BASE OFFST))
                           (add
 OFFST 1)
                           (add
 N -1)
@@ -535,12 +519,12 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (OPENSTRINGSTREAM

-  [LAMBDA (STR ACCESS)
                                  (* ; "Edited  8-Aug-2021 00:02 by rmk:")


-                                                             (* rmk%: "28-Mar-85 08:40")

+  [LAMBDA (STR ACCESS)
                                      (* ; "Edited  8-Aug-2021 00:02 by rmk:")

+                                                             (* rmk%: "28-Mar-85 08:40")

 
-    (* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")

+    (* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")

 
-    (* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")

+    (* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")

 
     (SELECTQ ACCESS
         ((INPUT OUTPUT BOTH))
@@ -550,21 +534,21 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
            (\ILLEGAL.ARG STR))
     (LET (STREAM)
          (IF
 (AND (EQ ACCESS 'INPUT)
-                      (NOT (ffetch
 (STRINGP FATSTRINGP) of
 STR)))
+                  (NOT (ffetch
 (STRINGP FATSTRINGP) of
 STR)))
              THEN
 (\FATTENSTRING STR)
            ELSE
 (\SMASHABLESTRING STR T))
 
-         (* ;; "String storage is now fat")

+         (* ;; "String storage is now fat")

 
          (SETQ STREAM (\MAKEBASEBYTESTREAM
 (OR (ffetch
 (STRINGP BASE) of
 STR)
-                                                   T)
+                                               T)
                              (UNFOLD (ffetch
 (STRINGP OFFST) of
 STR)
                                     BYTESPERWORD)
                              (UNFOLD (ffetch
 (STRINGP LENGTH) of
 STR)
                                     BYTESPERWORD)
                              ACCESS))
 
-         (* ;; "Differences between a basebytestream and a stringstream")

+         (* ;; "Differences between a basebytestream and a stringstream")

 
          (\EXTERNALFORMAT STREAM :STRING)
          (freplace
 USERCLOSEABLE of
 STREAM with
 T)
@@ -572,9 +556,9 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
          STREAM])
 
 (MAKE-STRING-FORMAT

-  [LAMBDA NIL
                                           (* ; "Edited  8-Aug-2021 00:10 by rmk:")

+  [LAMBDA NIL
                                               (* ; "Edited  8-Aug-2021 00:10 by rmk:")

 
-    (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")

+    (* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")

 
     (MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
                                              (DECLARE
 (USEDFREE *BYTECOUNTER*))
@@ -583,7 +567,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
            [FUNCTION (LAMBDA (STRM NOERROR)
                        (CL:WHEN (\PEEKBIN STRM NOERROR)
 
-                           (* ;; "This guards against the EOF error")

+                           (* ;; "This guards against the EOF error")

 
                            (PROG1 (LOGOR (LLSH (\BIN STRM)
                                                8)
@@ -594,7 +578,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                        (CL:WHEN (\BACKFILEPTR STRM)
                            (IF
 (\BACKFILEPTR STRM)
                                THEN
 (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2))
-                                     T
+                                    T
                              ELSEIF
 COUNTP
                                THEN
 (SETQ *BYTECOUNTER* 1)))]
            [FUNCTION (LAMBDA (STRM CODE)
@@ -615,17 +599,17 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (\STRINGSTREAM.INIT

-  [LAMBDA NIL
                                           (* ; "Edited  9-Aug-2021 23:30 by rmk:")

+  [LAMBDA NIL
                                               (* ; "Edited  9-Aug-2021 23:30 by rmk:")

 
-    (* ;; "RMK: This is described as creating a file device for %"old style%" strings.  But the variable that it sets is never referenced.  The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")

+    (* ;; "RMK: This is described as creating a file device for %"old style%" strings.  But the variable that it sets is never referenced.  The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")

 
-    (* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions.  ")

+    (* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions.  ")

 
-    (* ;; "Finally, this appears to be read only.  No BOUT is provided.")

+    (* ;; "Finally, this appears to be read only.  No BOUT is provided.")

 
-    (* ;; "")

+    (* ;; "")

 
-    (* ;; " In sum:  this is a candidate for removal.")

+    (* ;; " In sum:  this is a candidate for removal.")

 
     (SETQ \STRINGSTREAM.FDEV (create
 FDEV
                                     DEVICENAME _ 'STRING
@@ -648,16 +632,13 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                                     BIN _ [FUNCTION (LAMBDA (STREAM)
                                                       (replace
 F2 of
 STREAM
                                                          with
 (COND
-                                                                     ((fetch
 F1 of
 STREAM)
-                                                                      (PROG1 (fetch
 F1
-                                                                                of
 STREAM)
-                                                                             (replace
 F1
-                                                                                of
 STREAM
-                                                                                with
 NIL)))
-                                                                     ((GNCCODE (fetch
 
-                                                                                      FULLFILENAME
-                                                                                  of
 STREAM)))
-                                                                     (T (\EOF.ACTION STREAM]
+                                                                 ((fetch
 F1 of
 STREAM)
+                                                                  (PROG1 (fetch
 F1 of
 STREAM)
+                                                                         (replace
 F1 of
 STREAM
+                                                                            with
 NIL)))
+                                                                 ((GNCCODE (fetch
 FULLFILENAME
+                                                                              of
 STREAM)))
+                                                                 (T (\EOF.ACTION STREAM]
                                     PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
                                                           (OR (fetch
 F1 of
 STREAM)
                                                               (CHCON1 (fetch
 FULLFILENAME
@@ -668,8 +649,7 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
                                                         (NOT (EOFP STREAM]
                                     BACKFILEPTR _ [FUNCTION (LAMBDA (STREAM)
                                                               (replace
 F1 of
 STREAM
-                                                                 with
 (fetch
 F2 of
 STREAM
-                                                                                 ]
+                                                                 with
 (fetch
 F2 of
 STREAM]
                                     EOFP _ (FUNCTION (LAMBDA (STREAM)
                                                        (AND (NOT (fetch
 F1 of
 STREAM))
                                                             (EQ (NCHARS (fetch
 FULLFILENAME
@@ -684,34 +664,20 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (GETSTREAM

-  [LAMBDA (FILE ACCESS NOERROR)                              (* rrb "31-Oct-85 09:36")
-                                                             (* ; "USER ENTRY")
+  [LAMBDA (FILE ACCESS NOERROR)                              (* rrb "31-Oct-85 09:36")

+                                                             (* ; "USER ENTRY")

     (\GETSTREAM
 FILE ACCESS NOERROR])
 
-(\ADDOFD

-  [LAMBDA (STREAM)                                           (* rmk%: "21-OCT-83 16:32")
-          
-          (* ;; "Returns the STREAM it adds to \OPENFILES")
-
-    (\CLEAROFD
)
-    (AND (fetch
 NAMEDP of
 STREAM)
-         (push
 \OPENFILES STREAM))
-    STREAM])
-
 (\CLEAROFD

-  [LAMBDA NIL                                                (* lmm "30-SEP-80 20:08")
-                                                             (* ; 
-                                                "If GETOFD caches its args, this can clear the cache")
+  [LAMBDA NIL                                                (* lmm "30-SEP-80 20:08")

+                                                             (* ; 
+
                                                "If GETOFD caches its args, this can clear the cache")

     NIL])
 
-(\DELETEOFD

-  [LAMBDA (OFD)                                              (* rmk%: "25-OCT-79 08:20")
-    (SETQ \OPENFILES (DREMOVE OFD \OPENFILES])
-
 (\GETSTREAM

-  [LAMBDA (X ACCESS NOERROR)                                 (* ; "Edited 17-Jan-87 16:08 by bvm:")
-          
-          (* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream.  ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL.  NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")
+  [LAMBDA (X ACCESS NOERROR)
                                 (* ; "Edited 17-Jan-87 16:08 by bvm:")

+
+    (* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream.  ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL.  NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")

 
     (DECLARE
 (GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
     (COND
@@ -755,30 +721,20 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
              (type?
 WINDOW X))
         (fetch
 (WINDOW DSP) of
 X))
        (T (\FILE.NOT.OPEN X NOERROR])
-
-(\SEARCHOPENFILES

-  [LAMBDA (NAME ACCESS)
                                 (* ; "Edited 13-Jun-2021 11:35 by rmk:")

-
-    (* ;; "Returns a stream whose fullname is NAME if it has accessmode ACCESS")

-
-    (for
 STREAM in
 \OPENFILES when
 (EQ NAME (fetch
 (STREAM FULLNAME) of
 STREAM))
-       do
 (RETURN (COND
-                         (ACCESS (\IOMODEP
 STREAM ACCESS T))
-                         (T STREAM])
 )
 (DECLARE%: DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS \INSTREAMARG
 MACRO
 ((STRM NOERRORFLG)
-                                      (\GETSTREAM
 STRM 'INPUT NOERRORFLG)))
+                              (\GETSTREAM
 STRM 'INPUT NOERRORFLG)))
 
 (PUTPROPS \OUTSTREAMARG
 MACRO
 ((STRM NOERRORFLG)
-                                       (\GETSTREAM
 STRM 'OUTPUT NOERRORFLG)))
+                               (\GETSTREAM
 STRM 'OUTPUT NOERRORFLG)))
 
 (PUTPROPS \STREAMARG
 MACRO
 [OPENLAMBDA (STRM NOERRORFLG)
-                                     (COND
-                                        (NOERRORFLG (\GETSTREAM
 STRM NIL T))
-                                        (T (\DTEST STRM 'STREAM])
+                             (COND
+                                (NOERRORFLG (\GETSTREAM
 STRM NIL T))
+                                (T (\DTEST STRM 'STREAM])
 )
 
 (* "END EXPORTED DEFINITIONS")
@@ -802,18 +758,16 @@ Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA
 WHENCLOSE)
 )
-(PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2615 3722 (\ADD-OPEN-STREAM 2625 . 2902) (\GENERIC-UNREGISTER-STREAM 2904 . 3720)) (
-3763 11020 (CLOSEALL 3773 . 4478) (CLOSEF 4480 . 5676) (EOFCLOSEF 5678 . 5974) (INPUT 5976 . 6748) (
-OPENP 6750 . 7149) (OUTPUT 7151 . 7925) (POSITION 7927 . 8739) (RANDACCESSP 8741 . 9216) (\IOMODEP 
-9218 . 9855) (WHENCLOSE 9857 . 11018)) (11021 11143 (STREAMADDPROP 11031 . 11141)) (12307 25188 (
-\BASEBYTES.IO.INIT 12317 . 15513) (\MAKEBASEBYTESTREAM 15515 . 18827) (\MBS.OUTCHARFN 18829 . 19217) (
-\BASEBYTES.NAME.FROM.STREAM 19219 . 19682) (\BASEBYTES.BOUT 19684 . 20401) (\BASEBYTES.SETFILEPTR 
-20403 . 21024) (\BASEBYTES.READP 21026 . 21662) (\BASEBYTES.BIN 21664 . 22195) (\BASEBYTES.PEEKBIN 
-22197 . 23028) (\BASEBYTES.TRUNCATEFN 23030 . 23534) (\BASEBYTES.OPENFN 23536 . 24026) (
-\BASEBYTES.BLOCKIO 24028 . 25186)) (25311 28620 (OPENSTRINGSTREAM 25321 . 27038) (MAKE-STRING-FORMAT 
-27040 . 28618)) (28892 33553 (\STRINGSTREAM.INIT 28902 . 33551)) (33630 37202 (GETSTREAM 33640 . 33863
-) (\ADDOFD 33865 . 34152) (\CLEAROFD 34154 . 34435) (\DELETEOFD 34437 . 34588) (\GETSTREAM 34590 . 
-36754) (\SEARCHOPENFILES 36756 . 37200)))))
+  (FILEMAP (NIL (2464 3583 (\ADD-OPEN-STREAM 2474 . 2755) (\GENERIC-UNREGISTER-STREAM 2757 . 3581)) (
+3624 10688 (CLOSEALL 3634 . 4112) (CLOSEF 4114 . 5328) (EOFCLOSEF 5330 . 5630) (INPUT 5632 . 6402) (
+OPENP 6404 . 6807) (OUTPUT 6809 . 7581) (POSITION 7583 . 8391) (RANDACCESSP 8393 . 8783) (\IOMODEP 
+8785 . 9414) (WHENCLOSE 9416 . 10686)) (10689 10811 (STREAMADDPROP 10699 . 10809)) (11769 24326 (
+\BASEBYTES.IO.INIT 11779 . 14979) (\MAKEBASEBYTESTREAM 14981 . 17909) (\MBS.OUTCHARFN 17911 . 18311) (
+\BASEBYTES.NAME.FROM.STREAM 18313 . 18772) (\BASEBYTES.BOUT 18774 . 19528) (\BASEBYTES.SETFILEPTR 
+19530 . 20151) (\BASEBYTES.READP 20153 . 20797) (\BASEBYTES.BIN 20799 . 21306) (\BASEBYTES.PEEKBIN 
+21308 . 22138) (\BASEBYTES.TRUNCATEFN 22140 . 22648) (\BASEBYTES.OPENFN 22650 . 23148) (
+\BASEBYTES.BLOCKIO 23150 . 24324)) (24449 27753 (OPENSTRINGSTREAM 24459 . 26168) (MAKE-STRING-FORMAT 
+26170 . 27751)) (28025 32333 (\STRINGSTREAM.INIT 28035 . 32331)) (32410 35110 (GETSTREAM 32420 . 32651
+) (\CLEAROFD 32653 . 32946) (\GETSTREAM 32948 . 35108)))))
 STOP

sources/DMISC

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Jan-2022 19:08:15" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;3
 45512  
+
(FILECREATED " 8-Apr-2023 13:56:13" {DSK}<home>larry>il>medley>sources>DMISC.;2
 45464  
 
-      :CHANGES-TO (FNS FLASHWINDOW)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "16-May-90 15:53:57" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DMISC.;1)
+      :CHANGES-TO (FNS RINGBELLS)
+
+      :PREVIOUS-DATE " 6-Jan-2022 19:08:15" {DSK}<home>larry>il>medley>sources>DMISC.;1)
 
 
 (* ; "
@@ -216,16 +217,14 @@ with the terms of said license.
 (DEFINEQ
 
 (RINGBELLS

-  [LAMBDA (N)
                                         (* ; "Edited 10-May-88 23:01 by MASINTER")

+  [LAMBDA (N)
                                                (* ; "Edited  8-Apr-2023 13:30 by lmm")


+                                                          (* ; "Edited 10-May-88 23:01 by MASINTER")

     (DECLARE
 (GLOBALVARS RINGBELLS.L1 RINGBELLS.L2))
     (OR (FIXP N)
         (SETQ N 1))
-    (SELECTC \MACHINETYPE
-        ((LIST \DAYBREAK \DANDELION \MAIKO) 
-             (to
 N do
 (PLAYTUNE
 RINGBELLS.L1)
-                             (FLASHWINDOW
 NIL NIL 100)
-                             (PLAYTUNE
 RINGBELLS.L2)))
-        (FLASHWINDOW
 NIL N])
+    (to
 N do
 (PLAYTUNE
 RINGBELLS.L1)
+             (FLASHWINDOW
 NIL NIL 100)
+             (PLAYTUNE
 RINGBELLS.L2])
 
 (FLASHWINDOW

   [LAMBDA (WIN? N FLASHINTERVAL SHADE)                       (* ; "Edited  6-Jan-2022 19:08 by rmk")

@@ -951,22 +950,22 @@ with the terms of said license.
 (PUTPROPS DMISC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4747 5450 (BACKSPACEDEL 4757 . 5448)) (5545 5978 (PERIODICALLYRECLAIM 5555 . 5976)) (
-6208 7899 (\DIRTYBACKGROUND 6218 . 6640) (\SAVEVMBACKGROUND 6642 . 7426) (COPYVM 7428 . 7897)) (8320 
-9519 (SETTIME 8330 . 9517)) (9520 13551 (RINGBELLS 9530 . 10023) (FLASHWINDOW 10025 . 11953) (PLAYTUNE
- 11955 . 13549)) (13813 19345 (DISPLAYDOWN 13823 . 14211) (SETDISPLAYHEIGHT 14213 . 17013) (VIDEORATE 
-17015 . 19343)) (19769 20490 (DOAROUNDEXITFORMS 19779 . 20488)) (20693 22408 (REALMEMORYSIZE 20703 . 
-20861) (LISPVERSION 20863 . 21016) (MICROCODEVERSION 21018 . 21176) (BCPLVERSION 21178 . 21331) (
-REQUIREVERSION 21333 . 22406)) (22445 27023 (APROPOS 22455 . 26471) (APROPRINT 26473 . 27021)) (27049 
-30957 (READPRINTERPORT 27059 . 27200) (WRITEPRINTERPORT 27202 . 27357) (\READPRINTERPORT.UFN 27359 . 
-27548) (\WRITEPRINTERPORT.UFN 27550 . 27748) (\MISC1.UFN 27750 . 27903) (\MISC2.UFN 27905 . 28143) (
-\MISC3.UFN 28145 . 28878) (\MISC4.UFN 28880 . 29430) (\MISC5.UFN 29432 . 29585) (\MISC6.UFN 29587 . 
-29837) (\MISC7.UFN 29839 . 30324) (\MISC8.UFN 30326 . 30627) (\MISC10.UFN 30629 . 30955)) (31011 38460
- (\BLKFDIFF.UFN 31021 . 31586) (\BLKFPLUS.UFN 31588 . 32160) (\BLKFTIMES.UFN 32162 . 32737) (
-\BLKSEP.UFN 32739 . 33870) (\BLKPERM.UFN 33872 . 34341) (\BLKEXPONENT.UFN 34343 . 34753) (
-\BLKFLOATP2COMP.UFN 34755 . 35339) (\BLKSMALLP2FLOAT.UFN 35341 . 35700) (\BLKMAG.UFN 35702 . 36353) (
-\FLOATTOBYTE.UFN 36355 . 36934) (\BLKFMAX.UFN 36936 . 37328) (\BLKFMIN.UFN 37330 . 37719) (
-\BLKFABSMAX.UFN 37721 . 38090) (\BLKFABSMIN.UFN 38092 . 38458)) (38500 40318 (\P-MISC2.UFN 38510 . 
-38751) (\LINES-EQUAL-P 38753 . 39137) (\GET-NEXT-RUN 39139 . 40316)) (40319 44498 (IBLT1 40329 . 42331
-) (IBLT2 42333 . 44496)))))
+  (FILEMAP (NIL (4732 5435 (BACKSPACEDEL 4742 . 5433)) (5530 5963 (PERIODICALLYRECLAIM 5540 . 5961)) (
+6193 7884 (\DIRTYBACKGROUND 6203 . 6625) (\SAVEVMBACKGROUND 6627 . 7411) (COPYVM 7413 . 7882)) (8305 
+9504 (SETTIME 8315 . 9502)) (9505 13503 (RINGBELLS 9515 . 9975) (FLASHWINDOW 9977 . 11905) (PLAYTUNE 
+11907 . 13501)) (13765 19297 (DISPLAYDOWN 13775 . 14163) (SETDISPLAYHEIGHT 14165 . 16965) (VIDEORATE 
+16967 . 19295)) (19721 20442 (DOAROUNDEXITFORMS 19731 . 20440)) (20645 22360 (REALMEMORYSIZE 20655 . 
+20813) (LISPVERSION 20815 . 20968) (MICROCODEVERSION 20970 . 21128) (BCPLVERSION 21130 . 21283) (
+REQUIREVERSION 21285 . 22358)) (22397 26975 (APROPOS 22407 . 26423) (APROPRINT 26425 . 26973)) (27001 
+30909 (READPRINTERPORT 27011 . 27152) (WRITEPRINTERPORT 27154 . 27309) (\READPRINTERPORT.UFN 27311 . 
+27500) (\WRITEPRINTERPORT.UFN 27502 . 27700) (\MISC1.UFN 27702 . 27855) (\MISC2.UFN 27857 . 28095) (
+\MISC3.UFN 28097 . 28830) (\MISC4.UFN 28832 . 29382) (\MISC5.UFN 29384 . 29537) (\MISC6.UFN 29539 . 
+29789) (\MISC7.UFN 29791 . 30276) (\MISC8.UFN 30278 . 30579) (\MISC10.UFN 30581 . 30907)) (30963 38412
+ (\BLKFDIFF.UFN 30973 . 31538) (\BLKFPLUS.UFN 31540 . 32112) (\BLKFTIMES.UFN 32114 . 32689) (
+\BLKSEP.UFN 32691 . 33822) (\BLKPERM.UFN 33824 . 34293) (\BLKEXPONENT.UFN 34295 . 34705) (
+\BLKFLOATP2COMP.UFN 34707 . 35291) (\BLKSMALLP2FLOAT.UFN 35293 . 35652) (\BLKMAG.UFN 35654 . 36305) (
+\FLOATTOBYTE.UFN 36307 . 36886) (\BLKFMAX.UFN 36888 . 37280) (\BLKFMIN.UFN 37282 . 37671) (
+\BLKFABSMAX.UFN 37673 . 38042) (\BLKFABSMIN.UFN 38044 . 38410)) (38452 40270 (\P-MISC2.UFN 38462 . 
+38703) (\LINES-EQUAL-P 38705 . 39089) (\GET-NEXT-RUN 39091 . 40268)) (40271 44450 (IBLT1 40281 . 42283
+) (IBLT2 42285 . 44448)))))
 STOP