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

.gitattributes

@@ -0,0 +1,9 @@
+# Denote all files that are truly binary and should not be modified.
+*.tedit binary
+*.lcom binary
+*.sketch binary
+*.dfasl binary
+*.TEDIT binary
+*.LCOM binary
+*.SKETCH binary
+*.DFASL binary

.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

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

.github/workflows/buildLoadup.yml

@@ -1,4 +1,4 @@
-#re*******************************************************************************
+#*******************************************************************************
 # buidLoadup.yml
 #
 # Interlisp workflow to build Medley release and push it to github. This workflow
@@ -10,7 +10,7 @@
 #
 # 2022-01-17 Frank Halasz based on an earlier version of buildLoadup for Medley.
 #
-# Copyright 2022 by Interlisp.org
+# Copyright 2022-2023 by Interlisp.org
 #
 # ******************************************************************************
 
@@ -20,6 +20,12 @@ name: Build/Push Medley Release
 on:
   workflow_dispatch:
     inputs:
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
       force:
         description: "Force build even if build already successfully completed for this commit"
         type: choice
@@ -33,11 +39,19 @@ on:
         description: "'True' if medley build completed successully"
         value: ${{ jobs.complete.outputs.build_successful }}
     inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
       force:
         description: "Force build even if build already successfully completed for this commit"
         required: false
         type: string
         default: 'false'
+    secrets:
+      OIO_SSH_KEY:
+        required: true
 
 defaults:
   run:
@@ -54,13 +68,20 @@ jobs:
   inputs:
     runs-on: ubuntu-latest
     outputs:
-      force: ${{ steps.force.outputs.force }}
+      draft: ${{ steps.one.outputs.draft }}
+      force: ${{ steps.one.outputs.force }}
     steps:
-      - id: force
+      - id: one
         run: >
           if [ '${{ toJSON(inputs) }}' = 'null'  ];
-          then echo ::set-output name=force::'${{ github.event.inputs.force }}'; echo "workflow_dispatch";
-          else echo ::set-output name=force::'${{ inputs.force }}'; echo "workflow_call";
+          then
+              echo "workflow_dispatch";
+              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
+          else
+              echo "workflow_call";
+              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
+              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
           fi
         
 
@@ -79,7 +100,7 @@ jobs:
     steps: 
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -95,6 +116,8 @@ jobs:
 
 ######################################################################################
 
+
+  #
   # Do the loadup
   # 
 
@@ -102,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'
@@ -110,7 +139,7 @@ jobs:
     steps:
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -118,75 +147,111 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
 
       # Setup release tag
       - name: Setup Release Tag
         id: tag
         uses: ./../actions/release-tag-action
 
-      # Setup environment variables
-      - name: Setup Environment Variables
-        id: setup_env
-        run: |
-          echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
-
       # Get Maiko release information, retrieves the name of the latest
       # release.  Used to download the correct Maiko release
       - name: Get Maiko Release Information
-        id: latest_version
-        uses: abatilo/release-info-action@v1.3.0
+        id: maiko
+        uses: abatilo/release-info-action@v1.3.2
         with:
           owner: ${{ github.repository_owner }}
           repo: maiko
           
+      # 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.2
+        uses: robinraju/release-downloader@v1.6
         with:
           repository: ${{ github.repository_owner }}/maiko
           token: ${{ secrets.GITHUB_TOKEN }}
           latest: true
-          fileName: "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz" 
+          out-file-path: ${{ env.TARBALL_DIR }}
+          fileName: "${{ env.MAIKO_RELEASE_TAG }}-linux.*.tgz" 
 
-      - name: Untar Maiko Release
+      - name: Untar Maiko Release for use in loadup
         run: |
-          tar -xvzf "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
+          tar -xzf "${TARBALL_DIR}/${{ env.MAIKO_RELEASE_TAG }}-linux.x86_64.tgz"
 
+      # Checkout Notecards and tar it in the tarballsdir
+      - name: Checkout Notecards
+        uses: actions/checkout@v3
+        with:
+          repository: ${{ github.repository_owner }}/notecards
+          path: ./notecards
+      - run: mv ./notecards ../notecards
+      - name: Tar notecards into tarball dir
+        run: |
+          cd ..
+          tar cfz medley/${TARBALL_DIR}/notecards.tgz notecards
+
+      # Install vnc
       - name: Install vnc
         run: sudo apt-get update && sudo apt-get install -y tightvncserver
 
-      - name: Build Loadout
+      - name: Build Loadup sysouts and databases
         run: |
           Xvnc -geometry 1280x720 :0 &
           export DISPLAY=":0"
           PATH="$PWD/maiko:$PATH" 
-          scripts/loadup-all.sh
-
+          scripts/loadup-all.sh -apps
+      
       - name: Build loadups release tar
         run: |
-          cp -p tmp/full.sysout tmp/lisp.sysout tmp/whereis.hash loadups/
-          cp -p tmp/exports.all library/
           cd ..
-          tar cfz medley/tmp/${release_tag}-loadups.tgz        \
+          mkdir -p medley/${TARBALL_DIR}
+          tar cfz medley/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-loadups.tgz        \
             medley/loadups/lisp.sysout               \
             medley/loadups/full.sysout               \
+            medley/loadups/apps.sysout               \
             medley/loadups/whereis.hash              \
             medley/library/exports.all
-
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
       
       - name: Build runtime release tar
         run: |
           cd ..
-          tar cfz medley/tmp/${release_tag}-runtime.tgz          \
+          mkdir -p medley/${TARBALL_DIR}
+          tar cfz medley/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-runtime.tgz          \
                      --exclude "*~" --exclude "*#*"              \
                      --exclude exports.all                       \
+                     medley/clos                                 \
                      medley/docs/dinfo                           \
+                     medley/docs/man-page/medley.1.gz            \
                      medley/doctools                             \
                      medley/greetfiles                           \
                      medley/rooms                                \
+                     medley/medley                               \
                      medley/run-medley                           \
                      medley/scripts                              \
                      medley/fonts/displayfonts                   \
@@ -197,39 +262,148 @@ jobs:
                      medley/lispusers                            \
                      medley/sources                              \
                      medley/internal
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
 
 
-      - name: "Create release"
-        uses: "actions/github-script@v5"
+      # Build the deb files as well as the tgz files
+      - name: Build .deb files for 3 architectures
+        id: debs
+        run: |
+          cd installers/deb
+          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:
-          github-token: "${{ secrets.GITHUB_TOKEN }}"
-          script: |
-            try {
-              await github.rest.repos.createRelease({
-                draft: false,
-                generate_release_notes: true,
-                name: process.env.release_tag,
-                owner: context.repo.owner,
-                prerelease: false,
-                repo: context.repo.repo,
-                tag_name: process.env.release_tag,
-              });
-            } catch (error) {
-              core.setFailed(error.message);
-            }
-        env:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
+            tag: ${{ env.MEDLEY_RELEASE_TAG }} 
+        continue-on-error: true
 
-      - name: "Upload release assets"
-        uses: AButler/upload-release-assets@v2.0
-        with:
-          files: 'tmp/${{ env.release_tag }}-loadups.tgz;tmp/${{ env.release_tag }}-runtime.tgz'
-          repo-token: ${{ secrets.GITHUB_TOKEN }}
-          release-tag: ${{ env.release_tag }}
+      - name: Push the release
+        id: push_release
+        uses: ncipollo/release-action@v1
+        with: 
+          allowUpdates: true
+          artifacts:
+            ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-loadups.tgz,
+            ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-runtime.tgz,
+            ${{ env.DEBS_DIR }}/*.deb,
+            ${{ env.TARS_DIR }}/*.tgz
+          tag: ${{ env.MEDLEY_RELEASE_TAG }}
+          draft: ${{ needs.inputs.outputs.draft }}
+          prerelease: false
+          generateReleaseNotes: true
+          token: ${{ secrets.GITHUB_TOKEN }}
+
+
+  #
+  # 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: |
+          $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/@@@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}"
+            # 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:
-          release_tag: ${{ steps.tag.outputs.release_tag }}
+            SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
+      
 
 
 ######################################################################################
@@ -244,12 +418,12 @@ 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
       - name: Checkout Actions
-        uses: actions/checkout@v2
+        uses: actions/checkout@v3
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -265,6 +439,24 @@ jobs:
       - name: Output
         id: output
         run: |
-          echo ::set-output name=build_successful::'true'
+          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,19 +18,98 @@ name: "Build/Push Release & Docker"
 
 # Run this workflow on ...
 on:
+  schedule:
+    - cron: '0 9 * * 1'
+
   workflow_dispatch:
-  
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
+      force:
+        description: "Force build even if build already successfully completed for this commit"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
+
+  workflow_call:
+    outputs:
+      successful:
+        description: "'True' if medley build completed successully"
+        value: ${{ jobs.complete.outputs.build_successful }}
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
+      force:
+        description: "Force build even if build already successfully completed for this commit"
+        required: false
+        type: string
+        default: 'false'
+
+defaults:
+  run:
+    shell: bash
+
 
 # Jobs that compose this workflow
 jobs:
+
+
+######################################################################################
+
+  # Regularize the inputs so they can be referenced the same way whether they are
+  # the result of a workflow_dispatch or a workflow_call
+
+  inputs:
+    runs-on: ubuntu-latest
+    outputs:
+      draft: ${{ steps.one.outputs.draft }}
+      force: ${{ steps.one.outputs.force }}
+    steps:
+      - id: one
+        run: >
+          if [ '${{ toJSON(inputs) }}' != 'null'  ];
+          then
+            echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
+            echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
+          else
+            echo "draft=false" >> $GITHUB_OUTPUT;
+            echo "force=false" >> $GITHUB_OUTPUT;
+          fi
+
+######################################################################################
+
+
   # Build Loadup
   do_release:
+    needs: inputs
     uses: ./.github/workflows/buildLoadup.yml
-    
+    with:
+        draft: ${{ needs.inputs.outputs.draft }}
+        force: ${{ needs.inputs.outputs.force }}
+    secrets:
+        OIO_SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
+
+
+######################################################################################
+
   # Build Docker Image
   do_docker:
-    needs: do_release
+    needs: [inputs, do_release]
     uses: ./.github/workflows/buildDocker.yml
+    with:
+        draft: ${{ needs.inputs.outputs.draft }}
+        force: ${{ needs.inputs.outputs.force }}
     secrets:
-      DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
-      DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
+        DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
+        DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
+
+######################################################################################
+

.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 }}
-
-

.gitignore

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

Dockerfile

@@ -1,54 +0,0 @@
-#*******************************************************************************
-# 
-# Dockerfile to build Medley image from latest Maiko image 
-# plus latest release tars from github
-#
-# Copyright 2022 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 INSTALL_LOCATION=/usr/local/interlisp
-ENV INSTALL_LOCATION=${INSTALL_LOCATION}
-
-ARG DOCKER_NAMESPACE=interlisp
-ENV DOCKER_NAMESPACE=${DOCKER_NAMESPACE}
-
-# Copy over the release tars
-RUN mkdir -p ${INSTALL_LOCATION}
-ADD ./*.tgz ${INSTALL_LOCATION}
-
-# Create a run_medley script in /usr/local/bin
-RUN mkdir -p /usr/local/bin                                     && \
-    echo "#!/bin/bash"                    > /usr/local/bin/run-medley && \
-    echo "cd ${INSTALL_LOCATION}/medley"  >> /usr/local/bin/run-medley && \
-    echo './run-medley "$@"'              >> /usr/local/bin/run-medley && \
-    chmod ugo+x /usr/local/bin/run-medley
-    
-# "Finalize" image
-EXPOSE 5900
-RUN adduser --disabled-password --gecos "" medley
-USER medley
-WORKDIR /home/medley
-ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 ${INSTALL_LOCATION}/medley/run-medley -full -g 1280x720 -sc 1280x720

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/man2html.sh

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

docs/man-page/man_medley.html

@@ -0,0 +1,107 @@
+<h1>NAME</h1>
+<p><strong>medley</strong> — starts up Medley Interlisp</p>
+<h1>SYNOPSIS</h1>
+<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ -- <em>PASS_ON_ARGS</em> ]</p>
+<h1>DESCRIPTION</h1>
+<p>Starts Medley Interlisp in a window.</p>
+<h1>OPTIONS</h1>
+<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley and used by many of the options described below. MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of medley.</p>
+<h2>Flags</h2>
+
+<dl>
+<dt><strong>-h, --help</strong></dt>
+<dd><p>Prints out a brief summary of the flags and arguments to medley.</p>
+</dd>
+<dt><strong>-z, --man</strong></dt>
+<dd><p>Show the man page for medley</p>
+</dd>
+<dt><strong>-f, --full</strong></dt>
+<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+</dd>
+<dt><strong>-l, --lisp</strong></dt>
+<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+</dd>
+<dt><strong>-a, --apps</strong></dt>
+<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
+</dd>
+<dt><strong>-e, --interlisp (relevent only when --apps is specified)</strong></dt>
+<dd><p>Make the initial Exec window within Medley be an Interlisp Exec. Default is to start in an XCL Exec.</p>
+</dd>
+<dt><strong>-n, --noscroll</strong></dt>
+<dd><p>Ordinarily Medley displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window. Specifying --noscroll turns off the scroll bars. Note: If --noscroll is specified and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
+</dd>
+<dt><strong>-g <em>WxH</em>, --geometry <em>WxH</em></strong></dt>
+<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported). If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set.</p>
+</dd>
+<dt><strong>-s <em>WxH</em>, --screensize <em>WxH</em></strong></dt>
+<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. The Medley window is an unscaled viewport onto this virtual display. If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900.</p>
+</dd>
+<dt><strong>-t <em>STRING</em>, --title <em>STRING</em></strong></dt>
+<dd><p>Use STRING as title of Medley window. 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>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 ** <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 <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. 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. 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>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). 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>
+</dd>
+</dl>
+<h1>FILES</h1>
+<dl>
+<dt><strong>$HOME/il</strong></dt>
+<dd><p>Default Medley LOGINDIR</p>
+</dd>
+<dt><strong>$HOME/il/vmem/lisp.virtualmem</strong></dt>
+<dd><p>Default virtual memory file</p>
+</dd>
+<dt><strong>$HOME/il/INIT(.LCOM)</strong></dt>
+<dd><p>Default personal init file</p>
+</dd>
+<dt><strong>$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)</strong></dt>
+<dd><p>Default Medley greetfile</p>
+</dd>
+</dl>
+<h1>BUGS</h1>
+<p>See GitHub Issues: &lt;https://github.com/Interlisp/medley/issues&gt;</p>
+<h1>COPYRIGHT</h1>
+<p>Copyright(c) 2023 by Interlisp.org</p>

docs/man-page/md2man.sh

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

docs/man-page/medley.1

@@ -0,0 +1,220 @@
+.\" Automatically generated by Pandoc 2.5
+.\"
+.ad l
+.TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
+.nh \" Turn off hyphenation by default.
+.SH NAME
+.PP
+\f[B]medley\f[R] \[em] starts up Medley Interlisp
+.SH SYNOPSIS
+.PP
+\f[B]medley\f[R] [ flags \&... ] [ \f[I]SYSOUT_FILE\f[R] ] [ \-\-
+\f[I]PASS_ON_ARGS\f[R] ]
+.SH DESCRIPTION
+.PP
+Starts Medley Interlisp in a window.
+.SH OPTIONS
+.PP
+\f[B]MEDLEYDIR\f[R] is an environment variable set by Medley and used by
+many of the options described below.
+MEDLEYDIR is the top level directory of the Medley installation that
+contains the specific medley script that is invoked after all symbolic
+links are resolved.
+In the standard global installation this will be
+/usr/local/interlisp/medley.
+But Medley can be installed in multiple places on any given machine and
+hence MEDLEYDIR is computed on each invocation of medley.
+.SS Flags
+.PP
+\ 
+.TP
+.B \-h, \-\-help
+Prints out a brief summary of the flags and arguments to medley.
+.TP
+.B \-z, \-\-man
+Show the man page for medley
+.TP
+.B \-f, \-\-full
+Start Medley from the standard \[lq]full\[rq] sysout.
+full.sysout includes a complete Interlisp and CommonLisp environment
+with a standard set of development tools.
+It does not include any of the applications built using Medley.
+(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
+sysouts.)
+.TP
+.B \-l, \-\-lisp
+Start Medley from the standard \[lq]lisp\[rq] sysout.
+lisp.sysout only includes the basic Interlisp and CommonLisp
+environment.
+(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
+sysouts.)
+.TP
+.B \-a, \-\-apps
+Start Medley from the standard \[lq]apps\[rq] sysout.
+apps.sysout includes everything in full.sysout plus Medley applications
+including Notecards, Rooms and CLOS.
+It also includes pre\-installed links to key Medley documentation.
+(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
+sysouts.)
+.TP
+.B \-e, \-\-interlisp (relevent only when \-\-apps is specified)
+Make the initial Exec window within Medley be an Interlisp Exec.
+Default is to start in an XCL Exec.
+.TP
+.B \-n, \-\-noscroll
+Ordinarily Medley displays scroll bars to enable the user to pan the
+Medley virtual display within the Medley window.
+This is true even when the entire virtual display fits within the
+window.
+Specifying \-\-noscroll turns off the scroll bars.
+Note: If \-\-noscroll is specified and the virtual screen is larger than
+the window, there will be no way to pan to the non\-visible parts of the
+virtual display.
+.TP
+.B \-g \f[I]WxH\f[R], \-\-geometry \f[I]WxH\f[R]
+Sets the size of the X Window (or VNC window) that Medley runs in to be
+Width x Height.
+(Full X Windows geomtery specification with +X+Y is not currently
+supported).
+If \-\-geometry is not specified but \-\-screensize is, then the window
+size will be determined based on the \-\-screensize values and the
+\-\-noscroll flag.
+If neither \-\-geometry nor \-\-screensize is provided, then the window
+size is set to 1440x900 if \-\-noscroll is set and 1462x922 if
+\-\-noscroll is not set.
+.TP
+.B \-s \f[I]WxH\f[R], \-\-screensize \f[I]WxH\f[R]
+Sets the size of the virtual display as seen from Medley\[cq]s point of
+view.
+The Medley window is an unscaled viewport onto this virtual display.
+If \-\-screensize is not specified but \-\-geometry is, then the virtual
+display size will be set so that the entire virtual display fits into
+the given window geometry.
+If neither \-\-screensize nor \-\-geometry is provided, then the screen
+size is set to 1440x900.
+.TP
+.B \-t \f[I]STRING\f[R], \-\-title \f[I]STRING\f[R]
+Use STRING as title of Medley window.
+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]\ \ \ \ ** \f[B]Not applicable to Windows (Docker) installations\f[R] **
+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.
+.TP
+.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
+\[lq]\-\[rq] or \[lq]\-\-\[rq].
+If ID_STRING is \[lq]\-\[rq], then use the basename of $MEDLEYDIR as the
+id.
+If ID_STRING is \[lq]\-\-\[rq], then use the basename of the parent
+directory of $MEDLEYDIR as the id.
+Only one instance of Medley with a given id can run at a time.
+The id is used to distinguish the virtual memory stores so that multiple
+instances of Medley can run simultaneously.
+Default id is \[lq]default\[rq].
+.TP
+.B \-m \f[I]N\f[R], \-\-mem \f[I]N\f[R]
+Set Medley to run in \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]
+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, \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
+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] | \-]\ \ \ \ ** \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
+\ 
+.TP
+.B \f[I]SYSOUT_FILE\f[R]
+The pathname of the file to use as a sysout for Medley to start from.
+If SYSOUT_FILE is not provided and none of the flags (\-\-apps,
+\-\-full, \-\-lisp) is used, then Medley will start from the saved
+virtual memory file from the previous session with the same ID_STRING as
+this run.
+If no such virtual memory file exists, then Medley will start from the
+standard full.sysout (equivalent to specifying the \-\-full flag).
+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
+via run\-medley.
+.SH FILES
+.TP
+.B $HOME/il
+Default Medley LOGINDIR
+.TP
+.B $HOME/il/vmem/lisp.virtualmem
+Default virtual memory file
+.TP
+.B $HOME/il/INIT(.LCOM)
+Default personal init file
+.TP
+.B $MEDLEYDIR/greetfiles/MEDLEYDIR\-INIT(.LCOM)
+Default Medley greetfile
+.SH BUGS
+.PP
+See GitHub Issues: <https://github.com/Interlisp/medley/issues>
+.SH COPYRIGHT
+.PP
+Copyright(c) 2023 by Interlisp.org

docs/man-page/medley.1.md

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

docs/man-page/publish.sh

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

docs/man-page/showmd.sh

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

greetfiles/APPS-INIT

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

+       [(FILES (SYSLOAD)
+               MEDLEYDIR-INIT)
+        (GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
+        (INITVARS (Apps.NotecardsActivated NIL)
+               (Apps.RoomsActivated NIL))
+        (FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS 
+             Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
+        (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
+
+(FILESLOAD (SYSLOAD)
+       MEDLEYDIR-INIT)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
+)
+
+(RPAQ? Apps.NotecardsActivated
 NIL)
+
+(RPAQ? Apps.RoomsActivated
 NIL)
+(DEFINEQ
+
+(Apps.InitNotecards

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

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


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


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


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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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


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


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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

greetfiles/MEDLEYDIR-INIT

@@ -1,10 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 9-Mar-2022 11:50:44" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2
 4690   
+
(FILECREATED "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 "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
+      :PREVIOUS-DATE "10-Apr-2023 11:58:07" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;5
+)
 
 
 (PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
@@ -13,7 +16,7 @@
        ([P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
                               "")
                          "/sources/MEDLEYDIR.LCOM"))
-           (MEDLEY-INIT-VARS)
+           (MEDLEY-INIT-VARS 'GREET)
            (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
         (FILES BACKGROUND-YIELD)
         (VARS 
@@ -21,24 +24,25 @@
 
               (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")
                    "")
               "/sources/MEDLEYDIR.LCOM"))
 
-(MEDLEY-INIT-VARS)
+(MEDLEY-INIT-VARS 'GREET)
 
 (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
 
@@ -48,7 +52,7 @@
 
 (RPAQQ HELPDEPTH
 4)
 
-(RPAQQ HELPTIME
 10)
+(RPAQQ HELPTIME
 1)
 
 (RPAQQ FILING.ENUMERATION.DEPTH
 1)
 
@@ -58,6 +62,8 @@
 (RPAQ USERGREETFILES
 `((,LOGINDIR "INIT" COM)
                        (,LOGINDIR "INIT")))
 
+(RPAQQ COPYRIGHTFLG
 NEVER)
+
 (RPAQQ COPYRIGHTSRESERVED
 NIL)
 
 (RPAQQ AUTOBACKTRACEFLG
 ALWAYS)
@@ -81,44 +87,7 @@
                                                :PACKAGE "INTERLISP"])
 )
 
-(ADDTOVAR FONTDEFS

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

installers/deb/.gitignore

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

installers/deb/build

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

installers/deb/build_deb.sh

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

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

installers/deb/control-wsl

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

installers/deb/debian_wsl.txt

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

installers/deb/postinst

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

installers/deb/postrm

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

installers/downloads_page/md2html.sh

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

installers/downloads_page/medley_downloads.html

@@ -0,0 +1,45 @@
+<ul>
+<li><h1>MEDLEY DOWNLOADS</h1>
+
+<ul>
+<li><h2>LINUX (including Windows System for Linux)</h2>
+
+<ul>
+<li><h3>Standard Installations (for Debian-based distros)</h3>
+
+<ul>
+<li><h4>Standard Linux</h4>
+
+<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="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
+
+<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="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
+
+<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

@@ -0,0 +1,45 @@
+*    # MEDLEY DOWNLOADS
+ 
+     *    ## LINUX (including Windows System for Linux)
+
+         *    ### Standard Installations (for Debian-based distros)
+
+             * #### Standard Linux
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86\_64.deb)
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.deb)
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.deb)
+
+             * #### Windows System for Linux
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86\_64.deb)
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.deb)
+
+         *    ### Local Installations (for any Linux distro)
+
+             * #### Standard Linux
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86\_64.tgz)
+
+             [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-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/CONDITIONGRAPH.TXT

@@ -0,0 +1,10 @@
+                     CONDITIONGRAPH
+
+
+Currently in internal rather than lispusers, this package shows a graph of "conditions" (Common Lisp error system).
+
+(FILESLOAD CONDITIONGRAPH) to load it.
+
+(GRAPH-CONDITIONS) will display a graph of conditions and their inheritance.
+
+Other possible operations might be determinable by reading the source.

internal/DTEST.TEDIT

@@ -1 +0,0 @@
-Running DSKTEST
The Disk-file-system test utility

1.	Load the file DSKTEST.DCOM from whichever directory & server it is stored on.
2.	Type
	(DSKTEST '{DSK}<LISPFILES> 

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,29 +1,24 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;9|
 15959  
+
(FILECREATED "23-May-2023 07:10:58" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;12|
 10354  
 
-      :CHANGES-TO (FNS HCFILES)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;8|)
+      :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)
 
-(RPAQQ MEDLEY-UTILSCOMS

-       ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK)
-        (VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
-        (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
-        
-        (* |;;| "hardcopy files")

-
-        (FNS HCFILES BADFILE)
-        (INITVARS (HCFILES)
-               (BADFILES))
-        (COMMANDS "pick")))
+(RPAQQ MEDLEY-UTILSCOMS
 ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
+                         (VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
+                         (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
 (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)))
@@ -55,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)
@@ -130,24 +125,6 @@
 (MEDLEY-FIX-DATES

   (LAMBDA (DIRS)
                                          (* \; "Edited 28-Jan-2021 12:15 by larry")

     (|for|
 X |in|
 (OR DIRS MEDLEY-FIX-DIRS) |join|
 (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T))))))
-
-(PICK

-  (LAMBDA (TYPE CHOICES)
                                  (* \; "Edited 25-Jun-2022 16:58 by larry")

-    (SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
-        (NIL (PICK
 (PICK
 'ONEOF '(FILE ISSUE PROJECT))))
-        (ISSUE (LET ((ISSUE (PICK
 'ONEOF (OR CHOICES (GIT-COMMAND 
-                            "gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'"
-                                                            ))))
-                     (STR (OPENTEXTSTREAM)))
-                    (|for|
 S |in|
 (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE))
-                       |do|
 (CL:FORMAT STR "~a~&" S)
-                       |finally|
 (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a" 
-                                                                               ISSUE))))))
-        (DIR (PICK
 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
-        (FILE (PICK
 'ONEOF (DIRECTORY (MEDLEYDIR (PICK
 'DIR)))))
-        (PROJECT (PICK
 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS)))
-        (ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES)))))
-        (HELP TYPE "Unknown type"))))
 )
 
 (RPAQQ MEDLEY-FIX-DIRS
 ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
@@ -195,104 +172,8 @@
          (RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T))
          (DRIBBLE))))
 )
-
-
-
-(* |;;| "hardcopy files")

-
-(DEFINEQ
-
-(HCFILES

-  (LAMBDA (TFILE DEST REDOFLG TOPDIRLEN)
                  (* \; "Edited 17-Jul-2022 12:44 by larry")


-                                                          (* \; "Edited 21-Jun-2022 22:59 by larry")


-                                                          (* \; "Edited 31-May-2022 09:31 by larry")


-                                                          (* \; "Edited 20-Feb-2022 12:16 by larry")


-                                                          (* \; "Edited 21-Aug-2021 20:56 by larry")

-    (DECLARE
 (SPECVARS TFILE))
-    (|if|
 (NULL TFILE)
-        |then|
 (SETQ TFILE MEDLEYDIR))
-    (COND
-       ((DIRECTORYNAMEP TFILE)
-
-        (* |;;| "canonicalize")

-
-        (SETQ TFILE (DIRECTORYNAME TFILE))
-        (OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY))))
-        (CL:UNLESS DEST
-            (|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
-                                   "/tmp/psfiles/"))
-            (SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
-
-        (* |;;| "first deal with files in this directory")

-
-        (FOR
 EXT IN
 '("TED*" "SKETCH" "T*XT")
-           DO
 (|for|
 X |in|
 (DIRECTORY (CONCAT TFILE "*." EXT ";*"))
-                 |do|
 (HCFILES
 X DEST REDOFLG TOPDIRLEN)))
-
-        (* |;;| " then deal with subdirs ")

-
-        (|for|
 X |in|
 (DIRECTORY (CONCAT TFILE "*"))
-           |when|
 (|for|
 SKIP |in|
 '(">." ">dinfo>") |always|
 (NOT (STRPOS SKIP (L-CASE X))))
-           |when|
 (DIRECTORYNAMEP X) |do|
 (HCFILES
 X DEST REDOFLG TOPDIRLEN)))
-       ((SETQ TFILE (INFILEP TFILE))
-        (LET* ((TF (UNPACKFILENAME.STRING TFILE))
-               (NAME (LISTGET TF 'NAME))
-               (DIR (LISTGET TF 'DIRECTORY))
-               (PSFILE (PACKFILENAME.STRING
-                        'EXTENSION
-                        (|if|
 (EQ REDOFLG 'IP)
-                            |then|
 "IP"
-                          |else|
 "PS")
-                        'NAME
-                        (|if|
 (EQ DEST T)
-                            |then|
                           (* \; "with the tedit file")

-                                  NAME
-                          |else|
 (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN
-                                                                                          )
-                                                                           -1))))
-                                        "-" NAME))
-                        'HOST
-                        (LISTGET TF 'HOST)
-                        'DIRECTORY
-                        (|if|
 (EQ DEST T)
-                            |then|
 DIR
-                          |else|
 DEST)))
-               (TEXTSTREAM))
-              (|if|
 (AND (NOT REDOFLG)
-                         (INFILEP PSFILE))
-                  |then|
                                     (* \; " do nothing")

-                        (PRINTOUT T PSFILE " already there" T)
-                |elseif|
 (EQ REDOFLG 'TEST)
-                  |then|
 (PRINTOUT T TFILE "-> " PSFILE T)
-                        (CLOSEF (OPENTEXTSTREAM TFILE))
-                ELSEIF
 (MEMBER TFILE BADFILES)
-                  THEN
 (PRINTOUT T "Skipping " TFILE " on BADFILES")
-                |else|
 (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
-                      (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
-                             PSFILE T NIL NIL NIL (|if|
 (EQ REDOFLG 'IP)
-                                                      |then|
 'INTERPRESS
-                                                    |else|
 'POSTSCRIPT))
-                      (|printout| T " DONE" T)
-                      (CLOSEF? TEXTSTREAM))))
-       (T (PRINTOUT T "no such file " T)))))
-
-(BADFILE

-  (LAMBDA NIL
                                             (* \; "Edited 22-Jun-2022 09:40 by larry")

-    (PUSHNEW
 BADFILES TFILE)
-    (LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
-         (SETFILEPTR STR -1)
-         (PRINT TFILE STR)
-         (CLOSEF STR))
-    (RETFROM 'HCFILES)))
-)
-
-(RPAQ? HCFILES
 )
-
-(RPAQ? BADFILES
 )
-
-(DEFCOMMAND "pick" (FIRST
 . REST) (PICK
 FIRST REST))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (727 8702 (GATHER-INFO 737 . 6147) (MAKE-FULLER-DB 6149 . 6839) (MEDLEY-FIX-LINKS 6841
- . 7238) (MEDLEY-FIX-DATES 7240 . 7482) (PICK 7484 . 8700)) (9741 11534 (MAKE-EXPORTS-ALL 9751 . 10710
-) (MAKE-WHEREIS-HASH 10712 . 11532)) (11569 15829 (HCFILES 11579 . 15514) (BADFILE 15516 . 15827)))))
+  (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

internal/envos/FLOPPYTESTER

@@ -1,105 +0,0 @@
-
(FILECREATED "24-Mar-86 15:18:14" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;9
 4308   
-
-      changes to:  (FNS STARTTEST STOPTEST KILLTEST)
-		   (VARS FLOPPYTESTERCOMS)
-
-      previous date: "20-Mar-86 21:06:46" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;5)
-
-
-(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
-
-(PRETTYCOMPRINT FLOPPYTESTERCOMS)
-
-(RPAQQ FLOPPYTESTERCOMS
 ((* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
-			   (P (LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM)))
-			   (INITVARS (ALLOCATIONSW NIL))
-			   (FNS STARTTEST STOPTEST KILLTEST BLTALLOCS BLTALLOC)))
-(* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)

-
-(LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM))
-
-(RPAQ? ALLOCATIONSW
 NIL)
-(DEFINEQ
-
-(STARTTEST

-  (LAMBDA (N)                                                (* kbr: "24-Mar-86 15:15")

-    (
SETQ
 STARTTIME (
GDATE
))
-    (
CNDIR
 (
QUOTE
 {FLOPPY}))
-    (
FLOPPY.FORMAT
 (
QUOTE
 TEST))
-    (
DIRECTORY
 (
QUOTE
 {FLOPPY}*))
-    (BLTALLOCS
)
-    (for
 I from
 1 to
 N do
 (
DOFILEBANGER
 (
PACK*
 (
QUOTE
 {FLOPPY})
-							   (
QUOTE
 TESTFILE)
-							   I)
-						  (
RAND
 10 30)))))
-
-(STOPTEST

-  (LAMBDA NIL                                                (* kbr: "24-Mar-86 15:16")

-    (
SETQ
 STOPTIME (
GDATE
))
-    (for
 P in
 FILEBANGERS when
 (
NOT
 (
EQ
 P (
THIS.PROCESS
))) do
 (
SUSPEND.PROCESS
 P))))
-
-(KILLTEST

-  (LAMBDA NIL                                                (* kbr: "22-Mar-86 17:18")

-    (for
 P in
 FILEBANGERS do
 (
DEL.PROCESS
 P))
-    (
SETQ
 FILEBANGERS NIL)))
-
-(BLTALLOCS

-  [LAMBDA NIL                                                (* kbr: "18-Nov-85 12:32")

-                                                             (* Debugging fn. Puts up a window representation of 

-							     allocations on floppy. *)

-    (
PROG
 (PIXELS XLENGTH YLENGTH)
-	    (
SETQ
 PIXELS 5)
-	    (
SETQ
 XLENGTH (
ITIMES
 \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
-	    (
SETQ
 YLENGTH \FLOPPY.CYLINDERS)
-	    [
COND

-	      ((
NULL
 ALLOCATIONSW)
-		(
SETQ
 ALLOCATIONSW (
CREATEW
 (
GETBOXREGION
 (
WIDTHIFWINDOW
 (
ITIMES
 PIXELS 
-											  XLENGTH))
-								(
HEIGHTIFWINDOW
 (
ITIMES
 PIXELS 
-											  YLENGTH)
-										  T)
-								NIL NIL NIL 
-							     "Position FLOPPY ALLOCATIONS window")
-						"FLOPPY ALLOCATIONS"))
-		(
UNADVISE
 (
QUOTE
 \PFLOPPY.ALLOCATE))
-		(
ADVISE
 (
QUOTE
 \PFLOPPY.ALLOCATE)
-			  (
QUOTE
 AFTER)
-			  (
QUOTE
 (
COND
 (!VALUE (BLTALLOC
 !VALUE]
-	    (
BITBLT
 NIL NIL NIL ALLOCATIONSW NIL NIL NIL NIL (
QUOTE
 TEXTURE)
-		      (
QUOTE
 REPLACE)
-		      WHITESHADE)
-	    (for
 Y from
 0 to
 (
SUB1
 YLENGTH) do
 (for
 X from
 0 to
 (
SUB1
 XLENGTH)
-							    do
 (
BITMAPBIT
 ALLOCATIONSW
-									      (
ITIMES
 PIXELS X)
-									      (
ITIMES
 PIXELS Y)
-									      1)))
-	    (for
 PFALLOC in
 (fetch
 (PFLOPPYFDEV PFALLOCS) of
 \FLOPPYFDEV)
-	       when
 [
NOT
 (
EQUAL
 (fetch
 (PFALLOC FILENAME) of
 PFALLOC)
-				      (
QUOTE
 (FREE]
-	       do
 (BLTALLOC
 PFALLOC])
-
-(BLTALLOC

-  [LAMBDA (PFALLOC)                                          (* kbr: "18-Nov-85 12:21")

-    (
PROG
 (SHADE OPSHADE LEFT BOTTOM PIXELS XLENGTH)
-	    (
SETQ
 PIXELS 5)
-	    (
SETQ
 XLENGTH (
ITIMES
 \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
-	    (
SETQ
 SHADE (
COND

-		((
EQUAL
 (fetch
 (PFALLOC FILENAME) of
 PFALLOC)
-			  (
QUOTE
 (FREE)))
-		  WHITESHADE)
-		(T BLACKSHADE)))
-	    (
SETQ
 OPSHADE (
IDIFFERENCE
 BLACKSHADE SHADE))
-	    (for
 I from
 (fetch
 (PFALLOC START) of
 PFALLOC) to
 (fetch
 (PFALLOC END)
-									   of
 PFALLOC)
-	       do
 (
SETQ
 LEFT (
ITIMES
 PIXELS (
IREMAINDER
 (
SUB1
 I)
-								XLENGTH)))
-		    (
SETQ
 BOTTOM (
ITIMES
 PIXELS (
IQUOTIENT
 (
SUB1
 I)
-								 XLENGTH)))
-		    (
BLTSHADE
 SHADE ALLOCATIONSW LEFT BOTTOM PIXELS PIXELS (
QUOTE
 REPLACE))
-		    (
BLTSHADE
 OPSHADE ALLOCATIONSW LEFT BOTTOM 1 1 (
QUOTE
 REPLACE])
-)
-(PUTPROPS FLOPPYTESTER COPYRIGHT ("Xerox Corporation" 1985 1986))
-(DECLARE: DONTCOPY
-  (FILEMAP (NIL (745 4220 (STARTTEST 755 . 1203) (STOPTEST 1205 . 1463) (KILLTEST 1465 . 1665) (
-BLTALLOCS 1667 . 3253) (BLTALLOC 3255 . 4218)))))
-STOP

internal/envos/RS232TEST

@@ -1,242 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "26-Jun-90 19:15:35" |{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;2|
 9419   
-
-      |changes| |to:|  (VARS RS232TESTCOMS)
-
-      |previous| |date:| "20-Feb-87 00:10:14" 
-|{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;1|)
-
-
-; Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT RS232TESTCOMS)
-
-(RPAQQ RS232TESTCOMS

-       ((FNS RSTEST TESTCLEANUP XMITTEST)
-        
-        (* |;;| 
-
      "Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")

-
-        (FNS RS232.TEST RS232.MICROTEST RS232.QUICKTEST RS232.MENU RS232TMENU.SELFN)
-        (VARS RS232.TEST.MENU.ITEMS)
-        
-        (* |;;| 
-
   "Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")

-
-        (FNS TTY.TEST TTY.MICROTEST TTY.QUICKTEST TTY.MENU TTYTMENU.SELFN)))
-(DEFINEQ
-
-(rstest

-  (lambda nil
                                                (* \; "Edited 14-Jan-87 16:00 by jds")

-    (let (oo)
-         (resetlst (resetsave (setq oo (openstream '{rs232} 'output))
-                          'closef?)
-                (|for|
 i |from|
 1 |do|
 (printout oo "Line " i 
-                                              ":  1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
-\
-")
-                                       (printout t "Line " i t))))))
-
-(testcleanup

-  (lambda nil
                                                (* \; "Edited 16-Jan-87 09:51 by jds")

-          
-          (* |;;| "Close the streams used by the rs232 test.")

-
-    (and (boundp 'out)
-         out
-         (closef? out))
-    (and (boundp in)
-         in
-         (closef? in))))
-
-(XMITTEST

-  (LAMBDA (BAUDRATE XONXOFF?)
                                (* \; "Edited 19-Feb-87 20:59 by jds")

-          
-          (* |;;| "Set up the rs232 port at BAUDRATE with XOn-XOff flow control if XONXOFF? is T.  Then print forever, lines of text.  Show an indication on the screen for each line, so the user can tell if flow control has shut things off.")

-
-    (RS232C.INIT BAUDRATE 8 'NONE 1 (COND
-                                       (XONXOFF? 'XONXOFF)
-                                       (T 'NONE)))
-    (SETQ OUT (OPENSTREAM '{RS232} 'OUTPUT))
-    (SETQ IN (OPENSTREAM '{RS232} 'INPUT))
-    (ERSETQ (FOR
 I FROM
 1 DO
 (PRINTOUT OUT "Line " I ":  0 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
-\
-")
-                             (|printout| T "Line " I T)))
-    (CLOSEF? OUT)
-    (CLOSEF? IN)))
-)
-
-
-
-(* |;;| "Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")

-
-(DEFINEQ
-
-(rs232.test

-  (lambda nil
                                                (* \; "Edited 19-Feb-87 22:43 by jds")

-          
-          (* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")

-
-    (printout t t t "Starting RS-232 port test." t 
-           "Make sure the line monitor is attached to the RS-232 port, " 
-           "and its cable goes to the DCE socket on the monitor." t)
-    (mouseconfirm)
-    (printout t "Set the line monitor for: " t)
-    (|for|
 bits |in|
 '(5 6 7 8) |do|
 (|for|
 parity |in|
 '(none odd even)
-                                        |do|
 (|for|
 stopbits |in|
 '(1 1.5 2)
-                                                |do|
 (rs232.microtest
 9600 bits parity stopbits))))))
-
-(rs232.microtest

-  (lambda (speed bits parity stopbits)
                       (* \; "Edited 19-Feb-87 22:37 by jds")

-          
-          (* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")

-
-    (printout t bits "bits, " (cond
-                                 ((eq parity 'none)
-                                  "NO")
-                                 (t parity))
-           " parity, " stopbits " stop bits..." t)
-    (mouseconfirm)
-    (rs232.quicktest
 speed bits parity stopbits)))
-
-(rs232.quicktest

-  (lambda (speed bits parity stopbits)
                       (* \; "Edited 19-Feb-87 22:38 by jds")

-          
-          (* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")

-
-    (rs232c.init speed bits parity stopbits 'none)
-    (let ((out (openstream '{rs232} 'output)))
-         (prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
-                out)
-         (closef out))))
-
-(rs232.menu

-  (lambda nil
                                                (* \; "Edited 19-Feb-87 22:45 by jds")

-    (let ((ww (addmenu (|create|
 menu
-                              menucolumns _ 4
-                              items _ rs232.test.menu.items
-                              whenselectedfn _ (function rs232tmenu.selfn)))))
-         (windowprop ww 'title "RS-232 Tests"))))
-
-(rs232tmenu.selfn

-  (lambda (item menu key)
                                    (* \; "Edited 19-Feb-87 22:57 by jds")

-          
-          (* |;;| "Called from the RS-232 test menu")

-
-    (let* ((info (cadr item))
-           (bits (car info))
-           (parity (cadr info))
-           (stopbits (caddr info)))
-          (rs232.quicktest
 9600 bits parity stopbits))))
-)
-
-(RPAQQ RS232.TEST.MENU.ITEMS

-       ((|5/N/1| (5 NONE 1))
-        (|6/N/1| (6 NONE 1))
-        (|7/N/1| (7 NONE 1))
-        (|8/N/1| (8 NONE 1))
-        (|5/N/1.5| (5 NONE 1.5))
-        (|6/N/1.5| (6 NONE 1.5))
-        (|7/N/1.5| (7 NONE 1.5))
-        (|8/N/1.5| (8 NONE 1.5))
-        (|5/N/2| (5 NONE 2))
-        (|6/N/2| (6 NONE 2))
-        (|7/N/2| (7 NONE 2))
-        (|8/N/2| (8 NONE 2))
-        (|5/O/1| (5 ODD 1))
-        (|6/O/1| (6 ODD 1))
-        (|7/O/1| (7 ODD 1))
-        (|8/O/1| (8 ODD 1))
-        (|5/O/1.5| (5 ODD 1.5))
-        (|6/O/1.5| (6 ODD 1.5))
-        (|7/O/1.5| (7 ODD 1.5))
-        (|8/O/1.5| (8 ODD 1.5))
-        (|5/O/2| (5 ODD 2))
-        (|6/O/2| (6 ODD 2))
-        (|7/O/2| (7 ODD 2))
-        (|8/O/2| (8 ODD 2))
-        (|5/E/1| (5 EVEN 1))
-        (|6/E/1| (6 EVEN 1))
-        (|7/E/1| (7 EVEN 1))
-        (|8/E/1| (8 EVEN 1))
-        (|5/E/1.5| (5 EVEN 1.5))
-        (|6/E/1.5| (6 EVEN 1.5))
-        (|7/E/1.5| (7 EVEN 1.5))
-        (|8/E/1.5| (8 EVEN 1.5))
-        (|5/E/2| (5 EVEN 2))
-        (|6/E/2| (6 EVEN 2))
-        (|7/E/2| (7 EVEN 2))
-        (|8/E/2| (8 EVEN 2))))
-
-
-
-(* |;;| 
-"Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")

-
-(DEFINEQ
-
-(tty.test

-  (lambda nil
                                                (* \; "Edited 19-Feb-87 22:42 by jds")

-          
-          (* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")

-
-    (printout t t t "Starting TTY port test." t 
-           "Make sure the line monitor is attached to the TTY port, " 
-           "and its cable goes to the DTE socket on the monitor." t)
-    (mouseconfirm)
-    (printout t "Set the line monitor for: " t)
-    (|for|
 bits |in|
 '(5 6 7 8) |do|
 (|for|
 parity |in|
 '(none odd even)
-                                        |do|
 (|for|
 stopbits |in|
 '(1 1.5 2)
-                                                |do|
 (tty.microtest
 9600 bits parity stopbits))))))
-
-(tty.microtest

-  (lambda (speed bits parity stopbits)
                       (* \; "Edited 19-Feb-87 22:41 by jds")

-          
-          (* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")

-
-    (printout t bits "bits, " (cond
-                                 ((eq parity 'none)
-                                  "NO")
-                                 (t parity))
-           " parity, " stopbits " stop bits..." t)
-    (mouseconfirm)
-    (tty.init speed bits parity stopbits)))
-
-(tty.quicktest

-  (lambda (speed bits parity stopbits)
                       (* \; "Edited 19-Feb-87 22:40 by jds")

-          
-          (* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")

-
-    (tty.init speed bits parity stopbits 'none)
-    (let ((out (openstream '{tty} 'output)))
-         (prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
-                out)
-         (closef out))))
-
-(tty.menu

-  (lambda nil
                                                (* \; "Edited 19-Feb-87 22:57 by jds")

-    (let ((ww (addmenu (|create|
 menu
-                              menucolumns _ 4
-                              items _ rs232.test.menu.items
-                              whenselectedfn _ (function ttytmenu.selfn)))))
-         (windowprop ww 'title "TTY Tests"))))
-
-(ttytmenu.selfn

-  (lambda (item menu key)
                                    (* \; "Edited 19-Feb-87 22:59 by jds")

-          
-          (* |;;| "Called from the RS-232 test menu")

-
-    (let* ((info (cadr item))
-           (bits (car info))
-           (parity (cadr info))
-           (stopbits (caddr info)))
-          (tty.quicktest
 9600 bits parity stopbits))))
-)
-(PUTPROPS RS232TEST COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (979 2623 (RSTEST 989 . 1466) (TESTCLEANUP 1468 . 1789) (XMITTEST 1791 . 2621)) (2732 
-5433 (RS232.TEST 2742 . 3570) (RS232.MICROTEST 3572 . 4151) (RS232.QUICKTEST 4153 . 4640) (RS232.MENU 
-4642 . 5042) (RS232TMENU.SELFN 5044 . 5431)) (6665 9325 (TTY.TEST 6675 . 7493) (TTY.MICROTEST 7495 . 
-8061) (TTY.QUICKTEST 8063 . 8543) (TTY.MENU 8545 . 8938) (TTYTMENU.SELFN 8940 . 9323)))))
-STOP

internal/test/filepos/FIVE

@@ -1 +0,0 @@
-12345

internal/test/filepos/GREEK.UTF8

@@ -1 +0,0 @@
-aδσγδφβc

internal/test/filepos/SHORT.XCCS

@@ -1 +0,0 @@
-012345X1245

internal/test/filepos/TFP

@@ -1,495 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-
(FILECREATED " 3-Jul-2022 14:07:11" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;31
 27425  
-
-      :CHANGES-TO (FNS TFP TFP1)
-
-      :PREVIOUS-DATE " 3-Jul-2022 13:32:16" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;27)
-
-
-(PRETTYCOMPRINT TFPCOMS)
-
-(RPAQQ TFPCOMS

-       ((FNS TFP TFP1 FPC FPCS)
-        (FNS OLDFILEPOS OLDFFILEPOS)
-        (FILES FPTESTS)
-        (ADDVARS (DIRECTORIES {WMEDLEY}<internal>test>filepos>))
-        
-        (* ;; "Compiling also requires EXPORTS.ALL")

-
-        (DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
-                                                  IOCHAR))))
-(DEFINEQ
-
-(TFP

-  [LAMBDA (TESTNAMES TAGS FN)
                                (* ; "Edited  3-Jul-2022 14:06 by rmk")

-    (CL:UNLESS TESTNAMES (SETQ TESTNAMES ALLTESTS))
-    (LET [(TESTS (FOR
 TN INSIDE
 TESTNAMES FIRST
 (PRINTOUT T "Testing")
-                    JOIN
 (PRINTOUT T " " TN)
-                         (CONS (MKSTRING TN)
-                               (COPY (EVALV TN))) FINALLY
 (TERPRI T]
-         (CL:WHEN TAGS
-             (SETQ TESTS (FOR
 TEST IN
 TESTS WHEN
 (THEREIS
 TAG INSIDE
 TAGS
-                                                    SUCHTHAT
 (MEMB TAG TEST)) COLLECT
 TEST)))
-         (PRINTOUT T (LENGTH TESTS)
-                " tests" T)
-         (FOR
 TEST VAL COMMENT PRINTED IN
 TESTS EACHTIME
 (CL:WHEN (STRINGP TEST)
-                                                             (SETQ COMMENT TEST)
-                                                             (SETQ PRINTED NIL))
-            WHEN
 [AND (LISTP TEST)
-                      (NOT (AND FN (CADDR TEST] UNLESS
 (EQUAL (CAR TEST)
-                                                              (SETQ VAL (TFP1
 (CADR TEST)
-                                                                              FN)))
-            COLLECT
 (CL:WHEN COMMENT
-                        (CL:UNLESS PRINTED (PRINTOUT T COMMENT T)))
-                  (PRINTOUT T 5 VAL " <- " .P2 TEST T)
-                  (CONS VAL TEST])
-
-(TFP1

-  [LAMBDA (FPARGS FN)
                                        (* ; "Edited  3-Jul-2022 14:04 by rmk")

-
-    (* ;; "FN is the search function to apply: NIL = FILEPOS, OLDFILEPOS, FFILEPOS. OLDFFILEPOS")

-
-    (* ;; "For convenience: NIL -> FILEPOS, OF -> OLDFILEPOS, FF -> FFILEPOS, OFF -> OLDFFILEPOS.")

-
-    (* ;; "OLDFILEPOS and OLDFFILEPOS do only a byte searches.")

-
-    (* ;; 
-
 "FPARGS is a list of  FILEPOS args. CASEARRAY=T means Transparent case array, pushes to FFILEPOS.  ")

-
-    (* ;; "The file extension gives the format, defaulting to *DEFAULT-EXTERNALFORMAT* = :XCCS")

-
-    (SETQ FN (SELECTQ FN
-                 ((NIL FILEPOS) 
-                      'FILEPOS)
-                 ((FF FFILEPOS) 
-                      'FFILEPOS)
-                 ((OF OLDFILEPOS) 
-                      'OLDFILEPOS)
-                 ((OFF OLDFFILEPOS) 
-                      'OLDFFILEPOS)
-                 (HELP "BAD FN" FN)))
-    (CL:WHEN (OR (FIXP (CAR FPARGS))
-                 (NULL (CAR FPARGS))
-                 (AND (LISTP (CAR FPARGS))
-                      (FIXP (CAAR FPARGS))
-                      (FIXP (CDAR FPARGS)))
-                 (LISTP (CADR FPARGS)))
-        (SETQ FPARGS (CADR FPARGS)))
-    (LET (STREAM VAL PATTERN FILE START END SKIP TAIL CASEARRAY EXT (FORMAT *DEFAULT-EXTERNALFORMAT*)
-                )
-         (SETQ PATTERN (EVAL (POP
 FPARGS)))                  (* ; 
-
                                                            "So we can do substrings, CHARACTER etc.")

-         (SETQ FILE (POP
 FPARGS))
-         (SETQ START (POP
 FPARGS))
-         (SETQ END (POP
 FPARGS))
-         (SETQ SKIP (POP
 FPARGS))
-         (SETQ TAIL (POP
 FPARGS))
-         (SETQ CASEARRAY (POP
 FPARGS))
-         (SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
-         (CL:WHEN EXT
-             (CL:WHEN (STRPOS "UTF8" EXT)
-                    (SETQ EXT "UTF-8"))
-             [SETQ FORMAT (FIND-FORMAT (CL:INTERN EXT 'KEYWORD])
-         [SETQ STREAM (OPENSTREAM (OR (FINDFILE FILE T)
-                                      FILE)
-                             'INPUT NIL `((FORMAT ,FORMAT]
-         (SETQ CASEARRAY (IF
 (EQ CASEARRAY T)
-                             THEN
 (CASEARRAY)
-                           ELSE
 (EVAL CASEARRAY)))
-         (SETQ VAL (APPLY* FN PATTERN STREAM START END SKIP TAIL CASEARRAY))
-         (CLOSEF? STREAM)
-         VAL])
-
-(FPC

-  [LAMBDA (STR FILE START END SKIP TAIL CASEARRAY)
           (* ; "Edited 29-Jun-2022 21:22 by rmk")

-
-    (* ;; "Compare old and new filepos")

-
-    (LET (OLD
 NEW EXT FORMAT)
-         (CL:UNLESS (STREAMP FILE)
-             (SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
-             (SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
-             (CL:UNLESS (FIND-FORMAT FORMAT T)
-                    (SETQ FORMAT :XCCS))
-             (STREAMPROP FILE 'FORMAT FORMAT))
-         (SETQ OLD (OLDFILEPOS
 STR FILE START END SKIP TAIL CASEARRAY))
-         (SETQ NEW (FILEPOS STR FILE START END SKIP TAIL CASEARRAY))
-         (CLOSEF FILE)
-         (CL:UNLESS (EQUAL OLD (IF
 (EQ TAIL 'BOTH)
-                                   THEN
 (CDR NEW)
-                                 ELSE
 NEW))
-             (HELP (CONCAT "OLD=" (OR OLD "NIL")
-                          "  NEW="
-                          (OR NEW "NIL"))))
-         (LIST OLD NEW])
-
-(FPCS

-  [LAMBDA (STR FILE START END SKIP TAIL)
                     (* ; "Edited 29-Jun-2022 23:56 by rmk")


-                                                             (* ; "Edited 28-Jun-2022 22:21 by rmk")

-
-    (* ;; "Compare old and new slow filepos")

-
-    (LET (FAST SLOW EXT FORMAT)
-         (CL:UNLESS (STREAMP FILE)
-             (SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
-             (SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
-             (CL:UNLESS (FIND-FORMAT FORMAT T)
-                    (SETQ FORMAT :XCCS))
-             (STREAMPROP FILE 'FORMAT FORMAT))
-         (SETQ FAST (FILEPOS STR FILE START END SKIP TAIL))
-         (SETQ SLOW (FILEPOS STR FILE START END SKIP TAIL (CASEARRAY)))
-         (CLOSEF FILE)
-         (CL:UNLESS (EQUAL FAST SLOW)
-             (HELP (CONCAT "FAST=" (OR FAST "NIL")
-                          "  SLOW="
-                          (OR SLOW "NIL"))))
-         (LIST FAST SLOW])
-)
-(DEFINEQ
-
-(OLDFILEPOS

-  [LAMBDA (STR FILE START END SKIP TAIL CASEARRAY)
           (* ; "Edited 27-Jun-2022 23:35 by rmk")


-                                                            (* ; "Edited 10-Aug-2020 21:44 by rmk:")

-                                                             (* Pavel "12-Oct-86 15:13")

-
-    (* ;; "RMK:  Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")

-
-    (* ;; "NB: this function now works on non-PAGEMAPPED files.  It must use only IO functions that respect that.")

-
-    (PROG ((SKIPCHAR (AND SKIP (CHCON1 SKIP)))
-           [CA (fetch
 (ARRAYP BASE) of
 (COND
-                                          [CASEARRAY (COND
-                                                        ((AND (ARRAYP CASEARRAY)
-                                                              (EQ (fetch
 (ARRAYP TYP) of
 CASEARRAY)
-                                                                  \ST.BYTE))
-                                                         CASEARRAY)
-                                                        (T (CASEARRAY CASEARRAY]
-                                          (T \TRANSPARENT]
-           (STREAM (\GETSTREAM FILE 'INPUT))
-           CHAR FIRSTCHAR STRBASE STRINDEX PATLEN PATINDEX ORGFILEPTR LASTINDEX STARTBYTE ENDBYTE 
-           BIGENDBYTE STARTSEG ENDSEG)
-          (CL:WHEN (EQ :UTF-8 (\EXTERNALFORMAT STREAM))
-              (SETQ STR (XTOUSTRING STR)))
-          [COND
-             ((LITATOM STR)
-              (SETQ STRBASE (fetch
 (LITATOM PNAMEBASE) of
 STR))
-              (SETQ STRINDEX 1)
-              (SETQ PATLEN (fetch
 (LITATOM PNAMELENGTH) of
 STR)))
-             (T (OR (STRINGP STR)
-                    (SETQ STR (MKSTRING STR)))
-                (SETQ STRBASE (fetch
 (STRINGP BASE) of
 STR))
-                (SETQ STRINDEX (fetch
 (STRINGP OFFST) of
 STR))
-                (SETQ PATLEN (fetch
 (STRINGP LENGTH) of
 STR] (* ; 
-
                                                             "calculate start addr and set file ptr.")

-          [SETQ STARTBYTE (COND
-                             (START (COND
-                                       ((NOT (AND (FIXP START)
-                                                  (IGEQ START 0)))
-                                        (LISPERROR "ILLEGAL ARG" START)))
-                                    (SETQ ORGFILEPTR (\GETFILEPTR STREAM))
-                                    (\SETFILEPTR STREAM START)
-                                    START)
-                             (T (SETQ ORGFILEPTR (\GETFILEPTR STREAM]
-                                                             (* ; 
-
                    "calculate the character address of the character after the last possible match.")

-          [SETQ ENDBYTE (ADD1 (COND
-                                 ((NULL END)                 (* ; "Default is end of file")

-                                  (IDIFFERENCE (\GETEOFPTR STREAM)
-                                         PATLEN))
-                                 ((IGEQ END 0)               (* ; "Absolute byte pointer given")

-                                  (IMIN END (IDIFFERENCE (\GETEOFPTR STREAM)
-                                                   PATLEN)))
-                                 ((IGREATERP PATLEN (IMINUS END))
-                                                             (* ; 
-
                                                             "END is too far, use eof less length")

-                                  (IDIFFERENCE (\GETEOFPTR STREAM)
-                                         PATLEN))
-                                 (T (IDIFFERENCE (IPLUS (\GETEOFPTR STREAM)
-                                                        END 1)
-                                           PATLEN]
-
-     (* ;; "use STARTBYTE and ENDBYTE instead of START and END because vm functions shouldn't change their arguments.")

-
-          (COND
-             ((IGEQ STARTBYTE ENDBYTE)                       (* ; "nothing to search")

-              (GO FAILED)))
-          (SETQ LASTINDEX PATLEN)
-      SKIPLP
-                                                             (* ; 
-
                                      "set the first character to FIRSTCHAR, handling leading skips.")

-          (COND
-             ((EQ LASTINDEX 0)                               (* ; "null case")

-              (GO FOUNDIT))
-             ((EQ (SETQ FIRSTCHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE STRINDEX)))
-                  SKIPCHAR)                                  (* ; 
-
                                                             "first character in pattern is skip.")

-              (SETQ LASTINDEX (SUB1 LASTINDEX))
-              (\BIN STREAM)                                  (* ; "Move forward a character.")

-              (add
 STRINDEX 1)
-              (add
 STARTBYTE 1)
-              (GO SKIPLP)))
-          (SETQ LASTINDEX (IPLUS LASTINDEX STRINDEX))        (* ; 
-
                                     "Used for end of pattern check, comparing against current INDEX")

-          [COND
-             ((SMALLP ENDBYTE)
-              (SETQ STARTSEG (SETQ ENDSEG 0)))
-             (T 
-                (* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts.  The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary (can get around that here by decrementing everyone, but can't in FFILEPOS).  Note that STARTBYTE and ENDBYTE are never actually used as file ptrs, just for counting.")

-
-                (SETQ ENDSEG (FOLDLO ENDBYTE FILEPOS.SEGMENT.SIZE))
-                (SETQ BIGENDBYTE (IMOD ENDBYTE FILEPOS.SEGMENT.SIZE))
-                (SETQ STARTSEG (FOLDLO STARTBYTE FILEPOS.SEGMENT.SIZE))
-                (SETQ STARTBYTE (IMOD STARTBYTE FILEPOS.SEGMENT.SIZE))
-                (SETQ ENDBYTE (COND
-                                 ((EQ STARTSEG ENDSEG)
-                                  BIGENDBYTE)
-                                 (T 
-
-                                   (* ;; "In different segments, so we'll have to search all the way to the end of this seg;  hence, `end' is currently as big as it gets")

-
-                                    FILEPOS.SEGMENT.SIZE]
-      FIRSTCHARLP
-          
-
-     (* ;; "STARTBYTE is the possible beginning of a match.  the file ptr of the file is always at STARTBYTE position when the FIRSTCHAR loop is passed.")

-
-          (COND
-             ((EQ STARTBYTE ENDBYTE)                         (* ; "end of this part of search")

-              (COND
-                 ((EQ STARTSEG ENDSEG)                       (* ; "failed")

-                  (GO FAILED)))                              (* ; 
-
                                                      "Finished this segment, roll over into new one")

-              (SETQ STARTBYTE 0)                             (* ; "= STARTBYTE-FILEPOS.SEGMENT.SIZE")

-              [COND
-                 ((EQ (add
 STARTSEG 1)
-                      ENDSEG)                                (* ; 
-
                        "Entering final segment, so set ENDBYTE to actual end instead of segment end")

-                  (COND
-                     ((EQ (SETQ ENDBYTE BIGENDBYTE)
-                          0)
-                      (GO FAILED]
-              (GO FIRSTCHARLP))
-             ((NEQ FIRSTCHAR (\GETBASEBYTE CA (\BIN STREAM)))
-              (add
 STARTBYTE 1)
-              (GO FIRSTCHARLP)))
-          (SETQ PATINDEX STRINDEX)
-      MATCHLP
-                                                             (* ; 
-
                                                 "At this point, STR is matched thru offset PATINDEX")

-          (COND
-             ((EQ (SETQ PATINDEX (ADD1 PATINDEX))
-                  LASTINDEX)                                 (* ; "matched for entire length")

-              (GO FOUNDIT))
-             ((OR (EQ (SETQ CHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE PATINDEX)))
-                      (\GETBASEBYTE CA (\BIN STREAM)))
-                  (EQ CHAR SKIPCHAR))                        (* ; 
-
                                                             "Char from file matches char from STR")

-              (GO MATCHLP))
-             (T                                              (* ; 
-
                                            "Match failed, so we have to start again with first char")

-                (\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
-                                           (IDIFFERENCE PATINDEX STRINDEX)))
-
-                (* ;; "Back up over the chars we have just read in trying to match, less one.  I.e.  go back to one past the previous starting point")

-
-                (add
 STARTBYTE 1)
-                (GO FIRSTCHARLP)))
-      FOUNDIT
-                                                             (* ; 
-
                                   "set fileptr, adjust for beginning skips and return proper value.")

-          [COND
-             ((NOT TAIL)                                     (* ; 
-
                                                             "Fileptr wants to be at start of string")

-              (\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
-                                         PATLEN]
-          (RETURN (\GETFILEPTR STREAM))
-      FAILED
-                                                             (* ; 
-
                                                        "return the fileptr to its initial position.")

-          (\SETFILEPTR STREAM ORGFILEPTR)
-          (RETURN NIL])
-
-(OLDFFILEPOS

-  [LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
      (* ; "Edited 10-Aug-2020 21:44 by rmk:")

-
-    (* ;; "RMK:  Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")

-                                                             (* Pavel "12-Oct-86 15:20")

-    (PROG ([STREAM (\GETSTREAM (OR FILE (INPUT]
-           PATBASE PATOFFSET PATLEN ORGFILEPTR STARTOFFSET ENDOFFSET BIGENDOFFSET STARTSEG ENDSEG EOF
-           )
-          (COND
-             (SKIP                                           (* ; "Slow case--use FILEPOS")

-                   (GO TRYFILEPOS))
-             ((NOT (fetch
 PAGEMAPPED of
 (fetch
 (STREAM DEVICE) of
 STREAM)))
-                                                             (* ; 
-
                                            "This is a non-page-oriented file.  Use FILEPOS instead.")

-              (GO TRYFILEPOS)))                              (* ; 
-
                                                             "calculate start addr and set file ptr.")

-          (CL:WHEN (EQ :UTF8 (\EXTERNALFORMAT STREAM))
-              (SETQ PATTERN (XTOUSTRING PATTERN)))
-          [COND
-             ((LITATOM PATTERN)
-              (SETQ PATBASE (fetch
 (LITATOM PNAMEBASE) of
 PATTERN))
-              (SETQ PATOFFSET 1)
-              (SETQ PATLEN (fetch
 (LITATOM PNAMELENGTH) of
 PATTERN)))
-             (T (OR (STRINGP PATTERN)
-                    (SETQ PATTERN (MKSTRING PATTERN)))
-                (SETQ PATBASE (fetch
 (STRINGP BASE) of
 PATTERN))
-                (SETQ PATOFFSET (fetch
 (STRINGP OFFST) of
 PATTERN))
-                (SETQ PATLEN (fetch
 (STRINGP LENGTH) of
 PATTERN]
-          (COND
-             ((OR (IGREATERP PATLEN \MAX.PATTERN.SIZE)
-                  (ILESSP PATLEN \MIN.PATTERN.SIZE))
-              (GO TRYFILEPOS)))
-          (SETQ ORGFILEPTR (\GETFILEPTR STREAM))
-          (SETQ STARTOFFSET (IPLUS (COND
-                                      (START (COND
-                                                ((NOT (AND (FIXP START)
-                                                           (IGEQ START 0)))
-                                                 (LISPERROR "ILLEGAL ARG" START)))
-                                             START)
-                                      (T ORGFILEPTR))
-                                   (SUB1 PATLEN)))           (* ; 
-
        "STARTOFFSET is the address of the character corresponding to the last character of PATTERN.")

-          (SETQ EOF (\GETEOFPTR STREAM))                     (* ; 
-
                    "calculate the character address of the character after the last possible match.")

-          [SETQ ENDOFFSET (COND
-                             ((NULL END)                     (* ; "Default is end of file")

-                              EOF)
-                             (T (IMIN (IPLUS (COND
-                                                ((ILESSP END 0)
-                                                 (IPLUS EOF END 1))
-                                                (T END))
-                                             PATLEN)
-                                      EOF]
-
-     (* ;; "use STARTOFFSET and ENDOFFSET instead of START and END because vm functions shouldn't change their arguments.")

-
-          (COND
-             ((IGEQ STARTOFFSET ENDOFFSET)                   (* ; "nothing to search")

-              (RETURN))
-             ((ILESSP (IDIFFERENCE ENDOFFSET STARTOFFSET)
-                     \MIN.SEARCH.LENGTH)                     (* ; 
-
                                                             "too small to make FFILEPOS worthwhile")

-              (GO TRYFILEPOS)))
-          (\SETFILEPTR STREAM STARTOFFSET)
-          [RETURN (GLOBALRESOURCE
-                   (\FFDELTA1 \FFDELTA2 \FFPATCHAR)
-                   (PROG ((CASE (fetch
 (ARRAYP BASE)
-                                   of
 (COND
-                                         [CASEARRAY (COND
-                                                       ((AND (ARRAYP CASEARRAY)
-                                                             (EQ (fetch
 (ARRAYP TYP) of
 CASEARRAY)
-                                                                 \ST.BYTE))
-                                                        CASEARRAY)
-                                                       (T (CASEARRAY CASEARRAY]
-                                         (T \TRANSPARENT))))
-                          (DELTA1 (fetch
 (ARRAYP BASE) of
 \FFDELTA1))
-                          (DELTA2 (fetch
 (ARRAYP BASE) of
 \FFDELTA2))
-                          (PATCHAR (fetch
 (ARRAYP BASE) of
 \FFPATCHAR))
-                          (MAXPATINDEX (SUB1 PATLEN))
-                          CHAR CURPATINDEX LASTCHAR INC)
-
-                    (* ;; "Use Boyer-Moore string search algorithm.  Use two auxiliary tables, DELTA1 and DELTA2, to tell how far ahead to move in the file when a partial match fails.  DELTA1 contains, for each character code, the distance of that character from the right end of the pattern, or PATLEN if the character does not occur in the pattern.  DELTA2 contains, for each character position in the pattern, how far ahead to move such that the partial substring discovered to the right of the position now matches some other substring (to the left) in the pattern.  PATCHAR is just PATTERN translated thru CASEARRAY")

-
-                         (\SETUP.FFILEPOS PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2 CASE)
-                         [COND
-                            ((SMALLP ENDOFFSET)
-                             (SETQ STARTSEG (SETQ ENDSEG 0)))
-                            (T 
-                               (* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts.  The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary.  Note that STARTOFFSET and ENDOFFSET are never actually used as file ptrs, just for counting.")

-
-                               (SETQ ENDSEG (FOLDLO ENDOFFSET FILEPOS.SEGMENT.SIZE))
-                               (SETQ BIGENDOFFSET (MOD ENDOFFSET FILEPOS.SEGMENT.SIZE))
-                               (SETQ STARTSEG (FOLDLO STARTOFFSET FILEPOS.SEGMENT.SIZE))
-                               (SETQ STARTOFFSET (MOD STARTOFFSET FILEPOS.SEGMENT.SIZE))
-                               (SETQ ENDOFFSET (COND
-                                                  ((EQ STARTSEG ENDSEG)
-                                                   BIGENDOFFSET)
-                                                  (T 
-
-                                   (* ;; "In different segments, so we'll have to search all the way to the end of this seg;  hence, `end' is currently as big as it gets")

-
-                                                     FILEPOS.SEGMENT.SIZE]
-                         (SETQ LASTCHAR (GETBASEBYTE PATCHAR MAXPATINDEX))
-                     FIRSTCHARLP
-                         (COND
-                            [(IGEQ STARTOFFSET ENDOFFSET)    (* ; "End of this chunk")

-                             (COND
-                                ((EQ STARTSEG ENDSEG)        (* ; "failed")

-                                 (GO FAILED))
-                                (T                           (* ; 
-
                                                      "Finished this segment, roll over into new one")

-                                   (add
 STARTSEG 1)
-                                   (SETQ STARTOFFSET (IDIFFERENCE STARTOFFSET FILEPOS.SEGMENT.SIZE))
-                                   (COND
-                                      ((EQ STARTSEG ENDSEG)
-                                       (SETQ ENDOFFSET BIGENDOFFSET)))
-                                   (GO FIRSTCHARLP]
-                            ((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
-                                  LASTCHAR)
-                             (add
 STARTOFFSET (SETQ INC (GETBASEBYTE DELTA1 CHAR)))
-                             (OR (EQ INC 1)
-                                 (\INCFILEPTR STREAM (SUB1 INC)))
-                                                             (* ; 
-
                                    "advance file pointer accordingly (\BIN already advanced it one)")

-                             (GO FIRSTCHARLP)))
-                         (SETQ CURPATINDEX (SUB1 MAXPATINDEX))
-                     MATCHLP
-                         (COND
-                            ((ILESSP CURPATINDEX 0)
-                             (GO FOUNDIT)))
-                         (\DECFILEPTR STREAM 2)              (* ; "back up to read previous char")

-                         (COND
-                            ((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
-                                  (GETBASEBYTE PATCHAR CURPATINDEX))
-                                                             (* ; 
-
                                                  "Mismatch, advance by greater of delta1 and delta2")

-                             (add
 STARTOFFSET (IDIFFERENCE (SETQ INC (IMAX (GETBASEBYTE DELTA1 CHAR)
-                                                                           (GETBASEBYTE DELTA2 
-                                                                                  CURPATINDEX)))
-                                                     (IDIFFERENCE MAXPATINDEX CURPATINDEX)))
-                             (OR (EQ INC 1)
-                                 (\INCFILEPTR STREAM (SUB1 INC)))
-                             (GO FIRSTCHARLP)))
-                         (SETQ CURPATINDEX (SUB1 CURPATINDEX))
-                         (GO MATCHLP)
-                     FOUNDIT
-                                                             (* ; 
-
                                   "set fileptr, adjust for beginning skips and return proper value.")

-                         (\INCFILEPTR STREAM (COND
-                                                (TAIL        (* ; "Put fileptr at end of string")

-                                                      (SUB1 PATLEN))
-                                                (T           (* ; 
-
                            "back up over the last char we looked at, i.e.  the first char of string")

-                                                   -1)))
-                         (RETURN (\GETFILEPTR STREAM))
-                     FAILED
-                                                             (* ; 
-
                                                        "return the fileptr to its initial position.")

-                         (\SETFILEPTR STREAM ORGFILEPTR)
-                         (RETURN NIL]
-      TRYFILEPOS
-          (RETURN (FILEPOS PATTERN STREAM START END SKIP TAIL CASEARRAY])
-)
-
-(FILESLOAD FPTESTS)
-
-(ADDTOVAR DIRECTORIES
 {WMEDLEY}<internal>test>filepos>)
-
-
-
-(* ;; "Compiling also requires EXPORTS.ALL")

-
-(DECLARE%: DOEVAL@COMPILE DONTCOPY 
-
-(FILESLOAD (LOADCOMP)
-       IOCHAR)
-)
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (759 6571 (TFP 769 . 2219) (TFP1 2221 . 4656) (FPC 4658 . 5619) (FPCS 5621 . 6569)) (
-6572 27191 (OLDFILEPOS 6582 . 16284) (OLDFFILEPOS 16286 . 27189)))))
-STOP

internal/test/filepos/ZEROONETWO.XCCS

@@ -1 +0,0 @@
-012

internal/test/printing/BADFILES.TEST

@@ -1 +0,0 @@
-(HCFILES "{DSK}<home>larry>ilisp>envos>" "{DSK}<home>larry>medley>tmp>psfiles>")

internal/test/printing/BADFILES.TXT

@@ -1,66 +0,0 @@
-{DSK}<home>larry>ilisp>envos>xd0e>DOC>PUBS>admin>doc-dirs>ERIS-DOC-WO-LOOPS.TEDIT;2
-{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley1.2>RS6000>keybaord-layout.tedit;3
-{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley2.0>final>ug>APP-D-DIFFERENCES.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>DOC>printers>recommendation.tedit;3
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>1982BUGS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>BRIEFINGBLURB-DRAFT.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>CHAT-GENERIC.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>HELLO.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>IDDESCRIPTION.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>LISPARFIELDS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>NSCHARACTERS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>SOURCEFILES.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>COLOROBJ.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>DSKTEST.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>BOONE-V-COE.TED;1
-{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>NCPLOTCARD.TED;1
-{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>GC>HAND-AUX>ADVDICT-N-Z.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>Library>TEdit>Hand-Aux>AR10063.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>i>o>Hardcopy>Hand>testfiles>04PARA.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEDELTA.TED;1
-{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEIMPL.TED;1
-{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>Manual>LAFITEMANUAL-INDEXINTERNAL.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>lispusers>2.0>src>EQUATIONEXAMPLES.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>03-SOFTWARE-INSTALLATION.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>05-NOTECARDS-BASICS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>11-SYSTEM-CARDS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>2.0>src>library>BOONE-V-COE.TED;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDEMO.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>DDLCOLORHAX.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>LUCASFILMFORMAT.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>basics>INVOICE.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV-CHOICE.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDEMO.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>ADVERTS>Cherry-RidgeWFH.TEdit;5
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Adv-Committee>Defns>ADVDEFNS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Board>CALLERLAB-BYLAWCHANGE.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1-NEW-DEFNS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1DEFNS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C2DEFNS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>NUMBERART.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-A-M.TEDIT;13
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-N-Z.TEDIT;9
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-I-R.TEDIT;9
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-S.TEDIT;7
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-T-Z.TEDIT;9
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-A-E.TEDIT;11
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-F-O.TEDIT;5
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-P-S.TEDIT;6
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-T-Z.TEDIT;6
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>DICT-PREFACE.TEDIT;14
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>leftover-calls.tedit;3
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>FRA>ARRANGEMENTS.TEDIT;28
-{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>venue>ads>aaai>top-rapid-dev.TEdit;4
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>24-STREAMS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>25-IO.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>27-GRAPHICS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>28-WINDOWS.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>29-HARDCOPY.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-ETHERNET.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-TERMINAL.TEDIT;1
-{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>31-ETHERNET.TEDIT;1
-{DSK}<home>larry>medley>lispusers>ACE>ACE-MAINTAINERS-NOTES.TEDIT;1
-{DSK}<home>larry>medley>lispusers>EQUATIONEXAMPLES.TEDIT;1

internal/test/unpackfilename/TESTUPF

@@ -1,546 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-
(FILECREATED "23-May-2022 12:30:29" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TESTUPF.;1
 32843  )
-
-
-(PRETTYCOMPRINT TESTUPFCOMS)
-
-(RPAQQ TESTUPFCOMS

-       ((COMS                                                (* ; "Original code")

-              (FNS OLD-UNPACKFILENAME.STRING \UPF.NEXTPOS \UPF.TEMPFILEP)
-              (DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY UNPACKFILE1)))
-        
-        (* ;; "Debugging")

-
-        
-        (* ;; "DOTTEDNAMES:  mismatch intended")

-
-        
-        (* ;; "RETURNFAILS:  mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped.  But original doesn't agree with its own complete analaysis.")

-
-        (VARS DOTTEDNAMES TESTS RETURNFAILS)
-        (FNS TRY TRYALL DT)))
-
-
-
-(* ; "Original code")

-
-(DEFINEQ
-
-(OLD-UNPACKFILENAME.STRING

-  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)
     (* ; "Edited 25-Jan-2022 17:16 by rmk")


-                                                             (* ; "Edited  5-Jan-2022 11:03 by rmk")


-                                                             (* ; "Edited 30-Mar-90 22:37 by nm")

-
-(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")

-
-(* ;;; "rmk: devices must come before directories.")

-
-    (PROG ((POS 1)
-           (LEN (NCHARS FILE))
-           TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
-          (COND
-             ((NULL FILE)
-              (RETURN NIL))
-             ((OR (LITATOM FILE)
-                  (STRINGP FILE)
-                  (NUMBERP FILE)))
-             ((TYPEP FILE 'PATHNAME)
-              (RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
-             [(STREAMP FILE)                                 (* ; 
-
                                                 "For streams, use full name.  If anonymous, fake it")

-              (SETQ FILE (OR (ffetch
 FULLFILENAME of
 FILE)
-                             (RETURN (COND
-                                        (ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
-                                                          FILE))
-                                        (T (LIST 'NAME FILE]
-             (T (\ILLEGAL.ARG FILE)))
-          (COND
-             ((SELCHARQ (NTHCHARCODE FILE 1)
-                   ({                                        (* ; "normal use in Interlisp-D")

-                      (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS
 (CHARCODE })
-                                                 FILE 2)
-                                          0))))
-                   (%[                                       (* ; 
-
                                                    "some Xerox and Arpanet systems use '[' for host")

-                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS
 (CHARCODE "]")
-                                                  FILE 2)
-                                           0))))
-                   (%(                                       (* ; 
-
                                                  "this is the 'proposed standard' for Xerox servers")

-                       (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS
 (CHARCODE ")")
-                                                  FILE 2)
-                                           0))))
-                   NIL)
-              (UNPACKFILE1 'HOST 2 TEM)
-              [COND
-                 ((EQ TEM -1)                                (* ; 
-
      "Started with the host field delimiter, but there was no corresponding terminating delimiter .")

-                                                             (* ; 
-
                                             "I'm not sure why the name is dealt with the host name.")

-                  (RETURN (DREVERSE VAL]
-              (SETQ POS (IPLUS TEM 2))
-              [if
 (EQ OSTYPE T)
-                  then
                                       (* ; 
-
                                                             "Use actual host to determine os type")

-                       (SETQ OSTYPE (GETHOSTINFO (CAR VAL)
-                                           'OSTYPE]
-              (SETQ HOSTP T)))
-
-     (* ;; "rmk:  if there is a colon before the next < or /, then we must be looking at a device.  A device appears to end after the last colon, i.e., a device name can have a colon inside it.")

-
-          (COND
-             ((AND (SETQ TEM (\UPF.NEXTPOS
 (CHARCODE (%: < /))
-                                    FILE POS))
-                   (EQ (CHARCODE %:)
-                       (NTHCHARCODE FILE TEM)))              (* ; 
-
                                   "all device returned have DEVICE.END on it so that NIL: will work")

-              (UNPACKFILE1 'DEVICE POS (if
 CLFLG
-                                           then
 (SUB1 TEM)
-                                         else
 TEM))
-              (SETQ POS (ADD1 TEM))
-              (SETQ HOSTP T)))
-          (COND
-             ((EQ DIRFLG 'RETURN)                            (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter.  If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention.  In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")

-              (LET ((TYPE 'DIRECTORY)
-                    (START (SELCHARQ (NTHCHARCODE FILE POS)
-                                (NIL                         (* ; "just host, return")

-                                     (RETURN (DREVERSE VAL)))
-                                ((/ <)                       (* ; 
-
                                                      "Started with the initial directory delimiter.")

-                                     (ADD1 POS))
-                                POS))
-                    END)
-                   (SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
-                                  ((/ >) 
-                                       [COND
-                                          ((EQ START POS)    (* ; 
-
                                                           "Didn't start with a directory delimiter,")

-                                           (COND
-                                              ((NOT HOSTP)   (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")

-                                               (SETQ TYPE 'SUBDIRECTORY))
-                                              (T             (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")

-                                                 (SETQ TYPE 'RELATIVEDIRECTORY]
-                                       (COND
-                                          ((EQ LEN POS)      (* ; 
-
                                         "Only the initial directory is specified (i.e. %"{DSK}/%").")

-                                           (SETQ START POS)
-                                           -1)
-                                          (T -2)))
-                                  (PROGN [COND
-                                            [(EQ START POS)  (* ; 
-
                                              "Both of the initial and trail delimiters are omitted.")

-                                             (COND
-                                                ((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")

-                                                 (SETQ TYPE 'SUBDIRECTORY))
-                                                (T           (* ; "True %"relative pathname%".  The way to deal with it is dependent on the device on which HOST is implemented.")

-                                                   (SETQ TYPE 'RELATIVEDIRECTORY]
-                                            (T (COND
-                                                  ((EQ LEN POS)
-                                                             (* ; 
-
                                         "Only the initial directory is specified (i.e. %"{DSK}<%").")

-                                                   (SETQ START POS]
-                                         -1)))
-                   (UNPACKFILE1.DIRECTORY TYPE START END))
-              (RETURN (DREVERSE VAL)))
-             ((SELCHARQ (NTHCHARCODE FILE POS)
-                   (/                                        (* ; 
-
                                                  "unix and the 'xerox standard' use / for delimiter")

-                                                             (* ; 
-
                         "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")

-                      (SETQ TEM (LASTCHPOS (CHARCODE (/ >))
-                                       FILE
-                                       (ADD1 POS)))
-                      T)
-                   ((< >)                                    (* ; 
-
               "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>.  Jericho uses >>")

-                                                             (* ; 
-
                         "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")

-                        (SETQ TEM (LASTCHPOS (CHARCODE (> /))
-                                         FILE
-                                         (ADD1 POS)))
-                        T)
-                   NIL)
-
-              (* ;; "allow {DSK}/etc   to be a directory specification.")

-
-              (if
 TEM
-                  then
 (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
-                              (SUB1 TEM))
-                       (SETQ POS (ADD1 TEM))
-                else
 
-                     (* ;; "{DSK}/foo: the directory is /, the name is foo")

-
-                     (UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
-                     (SETQ POS (ADD1 POS)))
-              (SETQ HOSTP T))
-             ((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
-                               FILE POS))                    (* ; " {eris}abc>  relative")

-
-              (* ;; 
-
          " This is the true %"relative pathname%".  Returns RELATIVEDIRECTORY instead of DIRECTORY.")

-
-              [COND
-                 ((NOT HOSTP)                                (* ; "%"Incomplete file names%" case.")

-                  (UNPACKFILE1.DIRECTORY (if
 (EQ DIRFLG 'FIELD)
-                                             then
 'DIRECTORY
-                                           else
 'SUBDIRECTORY)
-                         POS
-                         (SUB1 TEM)))
-                 (T                                          (* ; "True %"relative pathname%".")

-                    (UNPACKFILE1.DIRECTORY (if
 (EQ DIRFLG 'FIELD)
-                                               then
 'DIRECTORY
-                                             else
 'RELATIVEDIRECTORY)
-                           POS
-                           (SUB1 TEM]
-              (SETQ POS (ADD1 TEM))
-              (SETQ HOSTP T)))
-          (OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
-              (RETURN (DREVERSE VAL)))
-          (if
 (EQ OSTYPE T)
-              then
                                           (* ; 
-
                                          "There wasn't a host field in the name, so we have no clue")

-                   (SETQ OSTYPE NIL))
-      NAMELP
-          
-
-     (* ;; "At this point, CODE is the TEM'th char of file name.  POS is the first character of the field we are currently working on.")

-
-          (SELCHARQ CODE
-               (%.                                           (* ; 
-
                            "Note position for later--we only want to deal with the last set of dots")

-                   (if
 BEYONDNAME
-                       then
                                  (* ; 
-
                                                   "no longer of interest (probably a bad name, too)")

-                     elseif
 FIRSTDOT
-                       then
                                  (* ; "We're recording the second dot")

-                            (if
 SECONDDOT
-                                then
                         (* ; 
-
                                                             "Note only the two most recent dots")

-                                     (SETQ FIRSTDOT SECONDDOT))
-                            (SETQ SECONDDOT TEM)
-                     else
 (SETQ FIRSTDOT TEM)))
-               ((! ; NIL)                                    (* ; 
-
                               "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")

-                    (if
 (SELCHARQ CODE
-                             (!                              (* ; 
-
                 "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")

-                                (AND OSTYPE (NEQ OSTYPE 'IFS)))
-                             (;                              (* ; "If we've already parsed the extension, then we have a semi in the middle of the version.  Skip it unless it's ;T or ;S")

-                                [AND BEYONDEXT (NOT (\UPF.TEMPFILEP
 FILE (ADD1 TEM])
-                             NIL)
-                        then
 (GO NEXTCHAR))
-                    (if
 FIRSTDOT
-                        then
                                 (* ; 
-
                                                          "Have a name and/or extension to parse now")

-                        (if

-                         [AND SECONDDOT
-                              (NOT (if
 OSTYPE
-                                       then
                  (* ; 
-
                                        "Known OS type must be Tops20 for second dot to mean version")

-                                            (EQ OSTYPE 'TOPS20)
-                                     else
                    (* ; 
-
                                  "Unknown OS type, so check that %"version%" is numeric or wildcard")

-                                          (AND [for
 I from
 (ADD1 SECONDDOT) to
 (SUB1 TEM)
-                                                  bind
 CH
-                                                  always
 (OR (DIGITCHARP (SETQ CH (NTHCHARCODE FILE I
-                                                                                         )))
-                                                             (EQ CH (CHARCODE *
]
-                                               (SELCHARQ CODE
-                                                    (NIL     (* ; "end of file name, ok")

-                                                         T)
-                                                    (;       (* ; 
-
                                                "This semi-colon better not be introducing a version")

-                                                       (\UPF.TEMPFILEP
 FILE (ADD1 TEM)))
-                                                    NIL]
-                            then
                             (* ; 
-
                                                             "Second dot is not intoducing a version")

-                                 (SETQ FIRSTDOT SECONDDOT)
-                                 (SETQ SECONDDOT NIL))
-                        (UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
-                        (SETQ POS (ADD1 (if
 SECONDDOT
-                                            then
 (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
-                                                        (SUB1 SECONDDOT))
-                                                 (SETQ BEYONDEXT T)
-                                                 SECONDDOT
-                                          else
 FIRSTDOT)))
-                        (SETQ BEYONDNAME T)
-                        (SETQ FIRSTDOT NIL))
-                    (UNPACKFILE1 (COND
-                                    ((NOT BEYONDNAME)
-                                     (SETQQ BEYONDNAME NAME))
-                                    ((NOT BEYONDEXT)
-                                     'EXTENSION)
-                                    ((AND (EQ BEYONDEXT (CHARCODE ";"))
-                                          (\UPF.TEMPFILEP
 FILE POS)))
-                                    (T                       (* ; 
-
                                                             "Everything after the semi was version")

-                                       'VERSION))
-                           POS
-                           (SUB1 TEM))
-                    (if
 (NULL CODE)
-                        then
                                 (* ; "End of string")

-                             (RETURN (DREVERSE VAL)))
-                    (SETQ BEYONDEXT CODE)                    (* ; 
-
                                                    "Note the character that terminated the name/ext")

-                    (SETQ POS (ADD1 TEM)))
-               (%'                                           (* ; "Quoter")

-                   (add
 TEM 1))
-               NIL)
-      NEXTCHAR
-          (SETQ CODE (NTHCHARCODE FILE (add
 TEM 1)))
-          (GO NAMELP])
-
-(\UPF.NEXTPOS

-  [LAMBDA (CHAR STRING POS)                                  (* lmm " 5-Oct-84 18:41")

-    (bind
 NCH while
 (SETQ NCH (NTHCHARCODE STRING POS)) do
 (COND
-                                                              ((EQMEMB NCH CHAR)
-                                                               (RETURN POS))
-                                                              ((EQ NCH (CHARCODE %'))
-                                                               (add
 POS 1)))
-                                                           (add
 POS 1])
-
-(\UPF.TEMPFILEP

-  [LAMBDA (FILENAME START)
                                   (* ; "Edited  6-Jan-88 13:12 by bvm:")

-
-    (* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START.  Returns the appropriate field name if so.  Not sure we should parse this junk any more, but this at least localizes it.")

-
-    (SELCHARQ (NTHCHARCODE FILENAME START)
-         ((T S)                                              (* ; "Funny temp stuff")

-              (AND (EQ START (NCHARS FILENAME))
-                   'TEMPORARY))
-         NIL])
-)
-(DECLARE%: DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS CANONICAL.DIRECTORY
 MACRO

-          [OPENLAMBDA (SRCSTRING)
-            (AND
-             SRCSTRING
-             (LET
-              ((LEN (NCHARS SRCSTRING)))
-              (COND
-                 ((EQ LEN 1)
-                  (if
 (STREQUAL SRCSTRING "/")
-                      then
 "<"
-                    else
 SRCSTRING))
-                 (T
-                  (LET*
-                   ((FATP (ffetch
 (STRINGP FATSTRINGP) of
 SRCSTRING))
-                    (DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
-                    (DSTBASE (ffetch
 (STRINGP BASE) of
 DSTSTRING))
-                    (DSTPOS 0)
-                    (NEXTPOS -1))
-                   (if
 (NOT FATP)
-                       then
 [for
 SRCPOS from
 1 to
 LEN bind
 CODE
-                               first
 (while
 (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
-                                                   (CHARCODE (< / >))) do
 (add
 SRCPOS 1))
-                                     (if
 (> SRCPOS LEN)
-                                         then
 (RETURN "<"))
-                               do
 (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
-                                       ((> /) 
-                                            (if
 (> DSTPOS NEXTPOS)
-                                                then
 (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
-                                                     (SETQ NEXTPOS (add
 DSTPOS 1))))
-                                       (%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
-                                           (add
 DSTPOS 1)
-                                           (if
 (NEQ SRCPOS LEN)
-                                               then
 (\PUTBASETHIN DSTBASE DSTPOS
-                                                           (NTHCHARCODE SRCSTRING (add
 SRCPOS 1)))
-                                                    (add
 DSTPOS 1)))
-                                       (PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
-                                              (add
 DSTPOS 1)))
-                               finally
 (RETURN (if
 (EQ DSTPOS LEN)
-                                                   then
 (if
 (EQMEMB (NTHCHARCODE DSTSTRING -1)
-                                                                   (CHARCODE (> /)))
-                                                            then
 (SUBSTRING DSTSTRING 1 -2)
-                                                          else
 DSTSTRING)
-                                                 elseif
 (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
-                                                               (CHARCODE (> /)))
-                                                   then
 (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
-                                                 else
 (SUBSTRING DSTSTRING 1 DSTPOS]
-                     else
 (for
 SRCPOS from
 1 to
 LEN bind
 CODE
-                             first
 (while
 (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
-                                                 (CHARCODE (< / >))) do
 (add
 SRCPOS 1))
-                             do
 (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
-                                     ((> /) 
-                                          (if
 (> DSTPOS NEXTPOS)
-                                              then
 (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
-                                                   (SETQ NEXTPOS (add
 DSTPOS 1))))
-                                     (%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
-                                         (add
 DSTPOS 1)
-                                         (if
 (NEQ SRCPOS LEN)
-                                             then
 (\PUTBASEFAT DSTBASE DSTPOS (NTHCHARCODE
-                                                                               SRCSTRING
-                                                                               (add
 SRCPOS 1)))
-                                                  (add
 DSTPOS 1)))
-                                     (PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
-                                            (add
 DSTPOS 1)))
-                             finally
 (RETURN (if
 (EQ DSTPOS LEN)
-                                                 then
 (if
 (EQMEMB (NTHCHARCODE DSTSTRING -1)
-                                                                 (CHARCODE (> /)))
-                                                          then
 (SUBSTRING DSTSTRING 1 -2)
-                                                        else
 DSTSTRING)
-                                               elseif
 (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
-                                                             (CHARCODE (> /)))
-                                                 then
 (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
-                                               else
 (SUBSTRING DSTSTRING 1 DSTPOS])
-
-(PUTPROPS UNPACKFILE1.DIRECTORY
 MACRO
 [OPENLAMBDA (NAM ST END)
-                                        (LET* ((OLDDIR (SUBSTRING FILE ST END))
-                                               (NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
-                                              (COND
-                                                 [(NOT ONEFIELDFLG)
-                                                  (SETQ VAL (CONS (COND
-                                                                     (PACKFLG (AND NEWDIR
-                                                                                   (MKATOM NEWDIR)))
-                                                                     (T (OR NEWDIR "")))
-                                                                  (CONS NAM VAL]
-                                                 ((EQMEMB NAM ONEFIELDFLG)
-                                                  (RETURN (COND
-                                                             (PACKFLG (AND NEWDIR (MKATOM NEWDIR)))
-                                                             (T (OR NEWDIR ""])
-
-(PUTPROPS UNPACKFILE1
 MACRO
 [OPENLAMBDA (NAM ST END)         (* lmm "22-APR-81 22:21")

-                              (COND
-                                 [(NOT ONEFIELDFLG)
-                                  (SETQ VAL (CONS (COND
-                                                     (PACKFLG (SUBATOM FILE ST END))
-                                                     (T (OR (SUBSTRING FILE ST END)
-                                                            "")))
-                                                  (CONS NAM VAL]
-                                 ((EQMEMB NAM ONEFIELDFLG)
-                                  (RETURN (COND
-                                             (PACKFLG (SUBATOM FILE ST END))
-                                             (T (OR (SUBSTRING FILE ST END)
-                                                    ""])
-)
-)
-
-
-
-(* ;; "Debugging")

-
-
-
-
-(* ;; "DOTTEDNAMES:  mismatch intended")

-
-
-
-
-(* ;; 
-"RETURNFAILS:  mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped.  But original doesn't agree with its own complete analaysis."
-)

-
-
-(RPAQQ DOTTEDNAMES
 (".x" ">.git" "x.y.100"))
-
-(RPAQQ TESTS

-       ("*,;" "*.*;*" "*.;" "*.;*" "///abc/x" "/abc.x" "<" "<<<abc" "<<<abc>" "<<<abc>>" "<<<abc>x" 
-              "<<abc" "<<xyz>>>zz" "<<xyz>>>zzz/" "<<xyz>>zz" "<<xyz>zz" "<ABC>" "<XYZ>aa" "<a.b>" 
-              "<a;b>" "<ab;c" "<ab>" "<abc" "<abc*." "<abc.x" "<abc.x;1" "<abc;x" "<abc<<<x" 
-              "<abc<xyz<foo" "<abc<xyz>qrs" "<abc>" "<abc>;1" "<abc>xyz" "<abc>xyz>foo" "<xxx" 
-              "<xy>>zz" "<xyz>>>zzz/" ">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" 
-              "A.B.C" "XXX<yyy" "a;b" "a;b/d" "a;b;c" "a;b;c;d" "aa" "aa;" "aa;NEWEST" "aa;newest" 
-              "aaa" "aaa/bbb" "aaa/bbb/" "aaa/xyz;x;m" "aaa<bbb" "aaa<bbb/" "aaa<xyz>" "aaa>bbb>" 
-              "aaa>xyz.e;m;n" "aaa>xyz>qrs" "abc" "abc...c" "abc///XYZ//" "abc/d" "abc/xyz" 
-              "abc/xyz.qrs" "abc/xyz.qrs;2" "abc:x<qrs>z" "abc<<<XYZ//" "abc<x" "abc<xyz" 
-              "abc<xyz>qq" "abc<xyzqq" "abc>;1" "abc>qr.x" "abc>xy" "abc>xyz" "abc>xyz;2" 
-              "dev:aaa>xyz>qrs" "foo:" "foo:aaa<xyz" "foo:aaa<xyz>" "foo:x<qrs>z" "foo<a:B>" "s;n;b"
-              "x.y.z;w" "x.y;z" "x;y" "x<abc<xyz>qrs" "x<abc<z" "x<abc>z" "xxx<yyy" "xxx<yyy>" 
-              "xxx<yyy>zzz" "xxx>yyy" "xxx>yyy>" "{ABC}" "{ABC}XXX:" "{DSK}" "{DSK}*.;*" "{DSK}...<a"
-              "{DSK}<a" "{DSK}xxx<a" "{DSK}xxx<xxx>yyy" "{DSK}xxx>xxx" "{DSK}xxx>yyy" 
-              "{HOST}foo:x<qrs>z" "{HOST}x<qrs>z" "{abc}" "{dsk}foo:aaa>b>.c.e.g;f" 
-              "{dsk}foo:aaa>b>.c.e;f" "{dsk}foo:aaa>b>c.e;f" "{eris}abc>" "{host}abc/xyz;2" 
-              "{host}abc>xyz;2" "{x}abc<xyz>qq" "{x}abc<xyzqq" "<abc<xyz>abc" "<abc<xyz>qrs" 
-              "<abc<xyz>"))
-
-(RPAQQ RETURNFAILS
 (">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" ">" ">>>abc/x" 
-                        ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"))
-(DEFINEQ
-
-(TRY

-  [LAMBDA (FILE ONEFIELDFLG DIRFLG)
                          (* ; "Edited 23-May-2022 12:09 by rmk")


-                                                             (* ; "Edited 25-Apr-2022 14:15 by rmk")


-                                                             (* ; "Edited 24-Apr-2022 08:45 by rmk")


-                                                             (* ; "Edited 21-Apr-2022 15:36 by rmk")

-    (CL:WHEN (LISTP (CAR (LISTP FILE)))
-        (SETQ FILE (CAR FILE)))
-    (LET (ORIG NEW)
-         (CL:WHEN (LISTP FILE)
-             (SETQ ONEFIELDFLG (CADR FILE))
-             (SETQ DIRFLG (CADDR FILE))
-             (SETQ FILE (CAR FILE)))
-         (SETQ ORIG (OLD-UNPACKFILENAME.STRING
 FILE ONEFIELDFLG DIRFLG))
-         (SETQ NEW (UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
-         (LIST (LIST FILE ONEFIELDFLG DIRFLG)
-               (AND (EQUAL ORIG NEW)
-                    '=)
-               ORIG NEW])
-
-(TRYALL

-  [LAMBDA (FILES ALLFLAG ONEFIELDFLG DIRFLG)
                 (* ; "Edited 21-Apr-2022 17:56 by rmk")


-                                                             (* ; "Edited  2-Apr-2022 23:50 by rmk")


-                                                             (* ; "Edited 31-Mar-2022 22:57 by rmk")

-    (CL:WHEN (LISTP FILES)
-        (SETQ FILES (FOR
 F IN
 FILES COLLECT
 (CL:IF (LISTP (CAR (LISTP F)))
-                                                (CAR F)
-                                                F))))
-    (FOR
 FILE INFO (SAME _ 0)
-         (DIFF _ 0) IN
 FILES EACHTIME
 (SETQ INFO (TRY
 FILE ONEFIELDFLG DIRFLG))
-                                   (CL:IF (CADR INFO)
-                                       (ADD
 SAME 1)
-                                       (ADD
 DIFF 1)) UNLESS
 (AND (CADR INFO)
-                                                                 (NOT ALLFLAG))
-       COLLECT
 (PRINTOUT T .P2 (CAAR INFO)
-                      31)
-             (IF
 (CADR INFO)
-                 THEN
 (PRINTOUT T "  = " .P2 (CADDR INFO))
-                      (CL:WHEN (OR (CADAR INFO)
-                                   (CADDAR INFO))
-                          (PRINTOUT T 60 (CADAR INFO)
-                                 %,,
-                                 (CADDAR INFO))
-                          (TERPRI T))
-               ELSE
 (PRINTOUT T " ~= " -2 "old: " .P2 (CADDR INFO))
-                    (CL:WHEN (OR (CADAR INFO)
-                                 (CADDAR INFO))
-                        (PRINTOUT T 60 (CADAR INFO)
-                               %,,
-                               (CADDAR INFO))
-                        (TERPRI T))
-                    (PRINTOUT T 37 "new: " .P2 (CADDDR INFO)
-                           T))
-             INFO FINALLY
 (PRINTOUT T SAME " matches, " DIFF " mismatches" T])
-
-(DT

-  [LAMBDA (STRINGS ALLFLAG)
                                  (* ; "Edited 21-Apr-2022 17:53 by rmk")


-                                                             (* ; "Edited 19-Apr-2022 20:55 by rmk")

-
-    (* ;; "Tests the DIRFLG options on STRINGS.  If an element of STRINGS is a list, it is assumed to be a (STRING ONEFIELD DIRFLG), STRING is extracted.")

-
-    (SETQ STRINGS (FOR
 S INSIDE
 STRINGS COLLECT
 (CL:IF (LISTP S)
-                                                    (CAR S)
-                                                    S)))
-    [AND NIL (FOR
 ONEFIELD IN
 '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
-                JOIN
 (FOR
 DIR ORIG NEW SAME IN
 '(FIELD RETURN)
-                        JOIN
 (PRINTOUT T T "ONEFIELDFLG = " ONEFIELD -3 "DIRFLG = " DIR T T)
-                             (TRYALL
 STRINGS ALLFLAG ONEFIELD DIR))
-                FINALLY
 (FOR
 INFO SAME (DIFF _ 0) IN
 $$VAL DO
 (CL:IF (CADR INFO)
-                                                                  (ADD
 SAME 1)
-                                                                  (ADD
 DIFF 1))
-                           FINALLY
 (SETQ SAME (IDIFFERENCE (LENGTH STRINGS)
-                                                     DIFF))
-                                 (PRINTOUT T T "Overall:  " SAME " matched, " DIFF " mismatched" T]
-    (TRYALL
 (FOR
 S IN
 STRINGS JOIN
 (FOR
 ONEFIELD IN
 '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
-                                      JOIN
 (FOR
 DIR IN
 '(FIELD RETURN)
-                                              COLLECT
 (LIST S ONEFIELD DIR])
-)
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (893 18981 (OLD-UNPACKFILENAME.STRING 903 . 17808) (\UPF.NEXTPOS 17810 . 18396) (
-\UPF.TEMPFILEP 18398 . 18979)) (28216 32820 (TRY 28226 . 29192) (TRYALL 29194 . 31111) (DT 31113 . 
-32818)))))
-STOP

internal/test/unpackfilename/TESTUPF.TXT

@@ -1,23 +0,0 @@
-TESTUPF contains functions for testing the new implementation of UNPACKFILENAME.STRING (now in ADIR) and the original definition.
-
-The original definition is also provided here, under the name OLD-UNPACKFILENAME.STRING
-
-TESTUPF also includes some test functions, and some of the strings that I have been testing with.
-
-(TRY FILE ONEDIRFLG DIRFLG)
-
-returns a comparison of the behavior of the original version and the new version in a list of the form 
-
-(FILE ONEDIRFLG DIRFLG) MATCH ORIG NEW)
-
-where MATCH is = if ORIG and NEW are EQUAL, otherwise NIL. (For convenience, a list of this form can also be passed in as an argument.)
-
-(TRYALL FILES ALLFLG ONDIRFLG DIRFLG)
-
-applies TRY to each file-string in FILES, prints and reports what it discovers. If ALLFLG, it prints the result on every file, otherwise just the mismatches. Value is a list of TRY values that it printed.
-
-(DT FILES) sets up a call to TRYALL for DIRFLG testing (setting DIRFLG NIL, FIELD, RETURN for each file in FILES).
-
-The variable TESTS has the strings that I have tested against, the variable DOTTEDNAMES has the strings that I intend to be different (.cshrc as NAME, not EXTENSION).  The new behavior avoids the bug that (PACKFILENAME.STRING 'EXTENSION "txt "BODY ".bashrc") produces  ".txt" instead of ".bashrc.txt".
-
-The variable RETURNFAILS is a list of strings with DIRFLG=RETURN that also don¹t match, in that the DIRECTORY and SUBDIRECTORY classifications are inverted between old and new for strings beginning with ª>". But the old code is inconsistent  for these inputs:  it returns different classifications of those substrings with or without the RETURN. (I think RETURN is for the case "/Users/kaplan" where the caller knows that the whole thing is a directory, doesn¹t want ªkaplanº to be parsed as a name. Just wants it to be normalized, with host and device stripped off.)

library/MSCOMMON

@@ -1,22 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4|
 24053  
+
(FILECREATED " 2-Nov-2022 10:13:59" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;3|
 23999  
 
-      :CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
-                         CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
-                         )
-                  (FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
-                  (VARS MSCOMMONCOMS)
+      :CHANGES-TO (VARS MSCOMMONCOMS)
+                  (TEMPLATES CL:UNLESS CL:WHEN)
 
-      :PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
+      :PREVIOUS-DATE "15-Jan-2022 20:17:21" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;1|)
 
 
-; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
+; Copyright (c) 1988, 1990, 1992, 2022 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT MSCOMMONCOMS)
 
 (RPAQQ MSCOMMONCOMS

        ((PROP FILETYPE MSCOMMON)
+        (DECLARE\: EVAL@COMPILE (GLOBALVARS USERTEMPLATES MSTEMPLATES))
         (FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
         
         (* |;;| "Templates for CL stuff that need them.")

@@ -89,6 +87,12 @@
            (CLRHASH USERTEMPLATES))))
 
 (PUTPROPS MSCOMMON
 FILETYPE
 :COMPILE-FILE)
+(DECLARE\: EVAL@COMPILE 
+(DECLARE\: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS USERTEMPLATES MSTEMPLATES)
+)
+)
 (DEFINEQ
 
 (FUNCTIONSMSGETDEF

@@ -470,13 +474,13 @@
 
 (SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
 
-(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
+(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFFECT RETURN))
 
 (SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
 
 (SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
 
-(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
+(SETTEMPLATE 'CL:WHEN '(TEST |..| EFFECT RETURN))
 
 (SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
                            :GENSYM :ARRAY))
@@ -552,8 +556,8 @@
                            (PUTHASH KEY VAL MSTEMPLATES)))
 
 (CLRHASH USERTEMPLATES)
-(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
+(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992 2022))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
-VARIABLESMSGETDEF 6733 . 7289)))))
+  (FILEMAP (NIL (5219 7230 (FUNCTIONSMSGETDEF 5229 . 6197) (FUNCTIONSMSMC 6199 . 6670) (
+VARIABLESMSGETDEF 6672 . 7228)))))
 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/SAMEDIR

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

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


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


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


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

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

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

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

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

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


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


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


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

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

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

library/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/UNIXCOMM

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Jul-2022 10:42:46" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;6
 20326  
+
(FILECREATED "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11
 14599  
 
-      :CHANGES-TO (FNS INITIALIZE-NEW-SHELL-DEVICE)
+      :CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
+                  (VARS UNIXCOMMCOMS)
 
-      :PREVIOUS-DATE " 3-Jul-2022 16:16:31" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;5)
+      :PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
 
 
 (* ; "
@@ -26,10 +25,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
               (FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM 
                    CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
         [COMS                                                (* ; "Operations on the shell device")

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

+  [LAMBDA (EVENT)
                                            (* ; "Edited 25-Oct-2022 21:20 by lmm")


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


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

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

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

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

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


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


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

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

+  [LAMBDA NIL
                                                (* ; "Edited 18-Dec-2022 11:53 by rmk")


+                                                             (* ; "Edited 25-Oct-2022 21:54 by lmm")

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

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


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

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

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

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

+(UNIX-BACKFILEPTR

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

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

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

+(UNIX-STREAM-EOFP

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

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

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

 
     (COND
        ((AND (ffetch
 (STREAM CBUFPTR) of
 (\DTEST STREAM 'STREAM))
@@ -279,11 +254,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS *NEW-SHELL-DEVICE*)
+(GLOBALVARS *SHELL-DEVICE*)
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(INITIALIZE-NEW-SHELL-DEVICE
)
+(INITIALIZE-SHELL-DEVICE
)
 
 
 (ADDTOVAR AROUNDEXITFNS
 UNIXCOMM-AROUNDEXITFN)
@@ -296,25 +271,23 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (CREATE-UNIX-SOCKET-STREAM

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

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


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

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

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

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

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


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

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

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

-
-(DEFINEQ
-
-(UNIX-BACKFILEPTR

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

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

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

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

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

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


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

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

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

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

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

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

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

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

-    (OR (UNIX-PEEKEDCHAR STREAM)
-        (CL:SETF (UNIX-PEEKEDCHAR STREAM)
-               (UNIX-READ
 STREAM NO-ERROR])
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS *SHELL-DEVICE*)
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS UNIX-PEEKEDCHAR
 MACRO
 ((STR)
-                                 (FETCH
 (STREAM F2) OF
 STR)))
-
-(PUTPROPS UNIX-LASTCHAR
 MACRO
 ((STR)
-                               (FETCH
 (STREAM F3) OF
 STR)))
-)
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(INITIALIZE-SHELL-DEVICE
)
-)
-
-(PUTPROPS UNIXCOMM
 FILETYPE
 FAKE-COMPILE-FILE)
+(PUTPROPS UNIXCOMM
 FILETYPE
 COMPILE-FILE)
 (PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2492 8463 (FORK-SHELL 2502 . 3699) (FORK-UNIX 3701 . 3877) (UNIX-KILL 3879 . 4068) (
-UNIX-WRITE 4070 . 4781) (CREATE-SHELL-STREAM 4783 . 6099) (CREATE-PROCESS-STREAM 6101 . 7560) (
-UNIXCOMM-AROUNDEXITFN 7562 . 8461)) (8511 13805 (INITIALIZE-NEW-SHELL-DEVICE 8521 . 9920) (
-UNIX-GET-NEXT-BUFFER 9922 . 12122) (UNIX-BACKFILEPTR-NEW 12124 . 12603) (UNIX-STREAM-EOFP-NEW 12605 . 
-13151) (UNIX-STREAM-OUT 13153 . 13409) (UNIX-STREAM-CLOSE 13411 . 13803)) (14061 15926 (
-CREATE-UNIX-SOCKET-STREAM 14071 . 14932) (ACCEPT-UNIX-SOCKET-STREAM 14934 . 15924)) (16275 19735 (
-UNIX-BACKFILEPTR 16285 . 16783) (UNIX-READ 16785 . 17307) (INITIALIZE-SHELL-DEVICE 17309 . 18329) (
-UNIX-STREAM-IN 18331 . 18707) (UNIX-STREAM-EOFP 18709 . 19483) (UNIX-STREAM-PEEK 19485 . 19733)))))
+  (FILEMAP (NIL (1963 7028 (FORK-SHELL 1973 . 3170) (FORK-UNIX 3172 . 3348) (UNIX-KILL 3350 . 3539) (
+UNIX-WRITE 3541 . 4252) (CREATE-SHELL-STREAM 4254 . 5138) (CREATE-PROCESS-STREAM 5140 . 5979) (
+UNIXCOMM-AROUNDEXITFN 5981 . 7026)) (7076 12267 (INITIALIZE-SHELL-DEVICE 7086 . 8514) (
+UNIX-GET-NEXT-BUFFER 8516 . 10716) (UNIX-BACKFILEPTR 10718 . 11130) (UNIX-STREAM-EOFP 11132 . 11613) (
+UNIX-STREAM-OUT 11615 . 11871) (UNIX-STREAM-CLOSE 11873 . 12265)) (12515 14221 (
+CREATE-UNIX-SOCKET-STREAM 12525 . 13331) (ACCEPT-UNIX-SOCKET-STREAM 13333 . 14219)))))
 STOP

library/UNIXPRINT

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

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

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

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

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

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

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

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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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


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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

library/UNIXUTILS

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

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

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

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

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

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

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

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

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

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

+
+                                                    "true"])
+
+(ShellBrowse

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

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

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

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

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

library/lafite/LAFITESEND

@@ -1,18 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Feb-2022 12:04:09" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;2
 100778 
+
(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2
 100794 
 
-      :CHANGES-TO (FILES LAFITEDECLS)
-                  (FNS \SENDMESSAGE.RESTARTABLE \SENDMESSAGE LAFITE.SENDMESSAGE MAKEXXXSUPPORTFORM 
-                       MAKENEWMESSAGEFORM MAKEANSWERFORM LAFITE.FILL.IN.ANSWER.FORM MAKEFORWARDFORM)
+      :CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
 
-      :PREVIOUS-DATE "30-Sep-2021 22:58:58" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;1)
+      :PREVIOUS-DATE " 7-Feb-2022 12:04:09" 
+{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
 
 
 (* ; "
-Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
+Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT LAFITESENDCOMS)
@@ -529,7 +526,8 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
           (RETURN (\SENDMESSAGE.RESTARTABLE
 FORM TEDITPROPS NIL FORMNAME])
 
 (\SENDMESSAGE.RESTARTABLE

-  [LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME)
            (* ; "Edited  7-Feb-2022 11:50 by rmk")


+  [LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME)
         (* ; "Edited 16-Oct-2022 09:59 by briggs")


+                                                             (* ; "Edited  7-Feb-2022 11:50 by rmk")


                                                              (* ; "Edited  3-Nov-89 15:06 by bvm")

     (bind
 (CURRENTMESSAGE _ FORM)
           (FIRSTTIME _ T)
@@ -558,7 +556,9 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
                                              EDITORWINDOW))
                     (push
 LAFITECURRENTEDITORWINDOWS EDITORWINDOW)
                     (SETQ FIRSTTIME)))
-          [SETQ EDITORRESULT (TEDIT (OPENSTRINGSTREAM FORM)
+          [SETQ EDITORRESULT (TEDIT (CL:IF (STRINGP FORM)
+                                        (OPENSTRINGSTREAM FORM)
+                                        FORM)
                                     EDITORWINDOW T (APPEND TEDITPROPS (LIST 'FONT LAFITEEDITORFONT]
           (COND
              ((TTY.PROCESSP)                                 (* ; "give back the keyboard")

@@ -1764,31 +1764,31 @@ cc: ~A
 )
 )
 (PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000 
-2021))
+2021 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5539 28516 (DOLAFITESENDINGCOMMAND 5549 . 6039) (\SENDMESSAGE.INITIATE 6041 . 7980) (
-\SENDMSG.DELIVER 7982 . 8590) (\SENDMSG.EXIT.TEDIT 8592 . 8963) (\SENDMSG.SAVE.FORM 8965 . 10952) (
-\LAFITE.HEADER.EOF 10954 . 11247) (\LAFITE.INSERT.REPLYTO 11249 . 11857) (\SENDMSG.REPLYTO 11859 . 
-12418) (\SENDMSG.CHANGE.MODE 12420 . 17996) (\SENDMSG.FIND.FIELD 17998 . 18508) (\SENDMESSAGE.PARSE 
-18510 . 19306) (\LAFITE.PREPARE.SEND 19308 . 22141) (\LAFITE.PREPARE.ERROR 22143 . 23325) (
-\LAFITE.CHOOSE.MSG.FORMAT 23327 . 25968) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25970 . 26895) (
-\SENDMESSAGE.MENUPROMPT 26897 . 27760) (\SENDMESSAGE.PROMPT 27762 . 28298) (\SENDMESSAGEFAIL 28300 . 
-28514)) (28517 52962 (\SENDMESSAGE 28527 . 29879) (\SENDMESSAGE.RESTARTABLE 29881 . 34865) (
-\SENDMESSAGE.CLEANUP 34867 . 35083) (\SENDMESSAGE.MAKEWINDOW 35085 . 41258) (MAKELAFITEDELIVERMENU 
-41260 . 41567) (\LAFITE.CLOSEMSG? 41569 . 42519) (\LAFITE.AFTER.DELIVER 42521 . 45840) (
-\LAFITE.UNSENT.ICON 45842 . 46152) (\LAFITE.FETCH.SUBJECT 46154 . 46954) (LAFITE.SENDMESSAGE 46956 . 
-47849) (\SENDMESSAGE0 47851 . 50715) (LA.ASSURE.PROMPT.WINDOW 50717 . 51614) (\LAFITE.SEND.FAIL 51616
- . 52087) (\LAFITE.INVALID.RECIPIENTS 52089 . 52547) (\SENDMESSAGE.ABORT 52549 . 52960)) (52994 62907 
-(\OUTBOX.CREATE 53004 . 54467) (\OUTBOX.RESET 54469 . 54962) (\OUTBOX.CLOSEFN 54964 . 55104) (
-\OUTBOX.REPAINTFN 55106 . 55769) (\OUTBOX.RESHAPEFN 55771 . 57054) (\OUTBOX.SHADEITEM 57056 . 57729) (
-\OUTBOX.BUTTONFN 57731 . 60579) (\OUTBOX.DISPLAYLINE 60581 . 61075) (\OUTBOX.ADD.ITEM 61077 . 62905)) 
-(63203 79611 (\LAFITE.MESSAGEFORM 63213 . 67556) (MAKELAFITESUPPORTFORM 67558 . 67747) (
-MAKELISPSUPPORTFORM 67749 . 67915) (MAKEXXXSUPPORTFORM 67917 . 71966) (MAKENEWMESSAGEFORM 71968 . 
-72924) (MAKELAFITEPRIVATEFORMSITEMS 72926 . 73354) (\LAFITE.UNCACHE.MESSAGEFORM 73356 . 73809) (
-\LAFITE.DELETE.MESSAGEFORM 73811 . 74412) (\LAFITE.SELECT.FORM 74414 . 74769) (
-\LAFITE.DELETE.FORM.INTERNAL 74771 . 75915) (\LAFITE.READ.FORM 75917 . 78654) (\LAFITE.FIND.TEMPLATE 
-78656 . 79609)) (79635 87366 (\LAFITE.ANSWER 79645 . 80050) (\LAFITE.ANSWER.PROC 80052 . 81946) (
-MAKEANSWERFORM 81948 . 84478) (LA.PRINT.COMMA.LIST 84480 . 84966) (LAFITE.FILL.IN.ANSWER.FORM 84968 . 
-87364)) (87391 93587 (\LAFITE.FORWARD 87401 . 87809) (\LAFITE.FORWARD.PROC 87811 . 89800) (
-MAKEFORWARDFORM 89802 . 93585)))))
+  (FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
+\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
+\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 . 
+12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE 
+18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
+\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
+\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 . 
+28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
+\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU 
+41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
+\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 . 
+47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
+ . 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918 
+(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
+\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
+\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916)) 
+(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
+MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 . 
+72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
+\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
+\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE 
+78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
+MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 . 
+87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
+MAKEFORWARDFORM 89813 . 93596)))))
 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.