Rmk3 (#587)

* TEDITMENU:  menus don't grow vertically on reshaping

* CLSTREAMS, EDITINTERFACE:  Update filemap for FUNCTIONS

Needs to be done for most CL-function containing files.

.github/workflows/buildDocker.yml

@@ -1,13 +1,11 @@
 #  based on https://blog.oddbit.com/post/2020-09-25-building-multi-architecture-im/
 ---
 # Interlisp workflow to build Docker Image that support multiple architectures
-name: 'Build Medley Docker image'
+name: Build Medley Docker image
 
-# Run this workflow on push to master
+# Run this workflow on demand
 on:
-  push:
-    branches:
-      - master
+  workflow_dispatch:
 
 # Jobs that compose this workflow
 jobs:
@@ -19,31 +17,57 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v2
 
+      # Get the Medley Release Information
+      - name: Get Medley Release Information
+        id: medley_version
+        uses: abatilo/release-info-action@v1.3.0
+        with:
+          owner: Interlisp
+          repo: medley
+
+      # Get the Maiko Release Information
+      - name: Get Maiko Release Information
+        id: maiko_version
+        uses: abatilo/release-info-action@v1.3.0
+        with:
+          owner: Interlisp
+          repo: maiko
+
       # Setup needed environment variables
       - name: Prepare
         id: prep
         run: |
-          DOCKER_IMAGE=interlisp/${GITHUB_REPOSITORY#*/}
+          DOCKERHUB_ACCOUNT=interlisp
+          DOCKER_IMAGE=${DOCKERHUB_ACCOUNT}/${GITHUB_REPOSITORY#*/}
           VERSION=latest
-          SHORTREF=${GITHUB_SHA::8}
-
-          # If this is git tag, use the tag name as a docker tag
-          if [[ $GITHUB_REF == refs/tags/* ]]; then
-            VERSION=${GITHUB_REF#refs/tags/v}
-          fi
-          TAGS="${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${SHORTREF}"
-
-          # If the VERSION looks like a version number, assume that
-          # this is the most recent version of the image and also
-          # tag it 'latest'.
-          if [[ $VERSION =~ ^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$ ]]; then
-            TAGS="$TAGS,${DOCKER_IMAGE}:latest"
-          fi
+          MAIKO_RELEASE=${{ steps.maiko_version.outputs.latest_tag }}
+          MEDLEY_RELEASE=${{ steps.medley_version.outputs.latest_tag }}
 
+          TAGS="${DOCKER_IMAGE}:${MEDLEY_RELEASE},${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${MAIKO_RELEASE}"
+          
           # Set output parameters.
           echo ::set-output name=tags::${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=version::${VERSION}
+
+      # Download Medley Release Assets
+      - name: Download Release Assets
+        uses: robinraju/release-downloader@v1.2
+        with:
+          repository: Interlisp/medley
+          token: ${{ secrets.GITHUB_TOKEN }}
+          latest: true
+          fileName: "*"
+
+      # Download Maiko Release Assets
+      - name: Download Release Assets
+        uses: robinraju/release-downloader@v1.2
+        with:
+          repository: Interlisp/maiko
+          token: ${{ secrets.GITHUB_TOKEN }}
+          latest: true
+          fileName: "*"
 
       # Setup Docker Machine Emulation environment
       - name: Set up QEMU

.github/workflows/buildLoadup.yml

@@ -0,0 +1,106 @@
+# Interlisp workflow to build Medley release
+name: Build Medley Release
+
+# Run this workflow on push to master
+on:
+  workflow_dispatch:
+    inputs:
+      tag:
+        description:  'Release Tag'
+
+# Jobs that compose this workflow
+jobs:
+  # Build Loadup
+  loadup:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Set release tag if currently undefined
+        if: ${{ github.event.inputs.tag == null }}
+        run:  |
+          echo "tag=medley-`date +%y%m%d`" >> $GITHUB_ENV
+
+      - name: Set release tag to input value
+        if: ${{ github.event.inputs.tag != null }}
+        run: |
+          echo "tag=${{ github.event.inputs.tag }}" >> $GITHUB_ENV
+
+      - name: Checkout Medley
+        uses: actions/checkout@v2
+
+      # 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
+        with:
+          owner: Interlisp
+          repo: maiko
+          
+      # Download Maiko Release Assets
+      - name: Download Release Assets
+        uses: robinraju/release-downloader@v1.2
+        with:
+          repository: Interlisp/maiko
+          token: ${{ secrets.GITHUB_TOKEN }}
+          latest: true
+          fileName: "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz" 
+
+      - name: Untar Maiko Release
+        run: |
+          tar -xvzf "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
+
+      - name: install vnc
+        run: sudo apt-get update && sudo apt-get install -y tightvncserver
+
+      - name: Build Loadout
+        run: |
+          Xvnc -geometry 1280x720 :0 &
+          export DISPLAY=":0"
+          PATH="$PWD/maiko:$PATH" 
+          scripts/loadup-all.sh
+
+      - name: Build release tar get libs
+        run: |
+          cp -p tmp/full.sysout tmp/lisp.sysout tmp/*.dribble tmp/whereis.hash loadups/
+          cp -p tmp/exports.all tmp/RDSYS tmp/RDSYS.LCOM library/
+          cd ..
+          tar cfz medley/tmp/$tag-loadups.tgz        \
+            medley/loadups/lisp.sysout               \
+            medley/loadups/full.sysout               \
+            medley/loadups/whereis.hash              \
+            medley/library/exports.all               \
+            medley/library/RDSYS/                    \
+            medley/library/RDSYS.LCOM   
+      
+      - name: tar part 2
+        run: |
+          cd ..
+          tar cfz medley/tmp/$tag-runtime.tgz                    \
+                     --exclude "*~" --exclude "*#*"              \
+                     medley/docs/dinfo                           \
+                     medley/docs/Documentation\ Tools            \
+                     medley/greetfiles                           \
+                     medley/run-medley                           \
+                     medley/scripts                              \
+                     medley/fonts/displayfonts                   \
+                     medley/fonts/altofonts                      \
+                     medley/fonts/postscriptfonts                \
+                     medley/library/                             \
+                     medley/lispusers/                           \
+                     medley/fonts/big                            \
+                     medley/fonts/other                          \
+                     medley/sources/                             \
+                     medley/internal/library      
+
+      - name: Release notes
+        run: |
+          sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md
+      
+      - name: push the release
+        uses: ncipollo/release-action@v1.8.10
+        with: 
+          artifacts: tmp/${{ env.tag }}-loadups.tgz,tmp/${{ env.tag }}-runtime.tgz
+          tag: ${{ env.tag }}
+          draft: true
+          bodyfile: tmp/release-notes.md
+          token: ${{ secrets.GITHUB_TOKEN }}

BUILDING.md

@@ -0,0 +1,34 @@
+# How to build a medley release
+
+Originally done only with shell scripts:
+```
+./scripts/loadup-all.sh 
+```
+to make the loadups
+```
+./scripts/loadup-and-release.sh
+```
+to go on to make the tgz files and release them
+
+# Using github actions
+
+In the github medley repository (Interlisp/medley) go to the Actions tab. 
+
+It will list the available github actions, select: **Build Medley Release**. 
+
+In the middle of the screen there's a box labeled workflow runs.
+There should be a row in it that states 'This workflow has a workflow_dispatch event trigger' with a drop down menu (it really looks more like a button) on the right side labeled 'Run workflow'.  Select that and you'll get a form allowing you to select the branch (I've only used Master) and enter the release name.  Enter a name or leave it empty and press the green 'Run workflow' button. The workflow should queue up and run.  
+
+# How to create a Docker image for the latest Medley release
+
+In the github medley repository (Interlisp/medley) go to the Actions tab. 
+
+It will list the available github actions, select: **Build Medley Docker image**. 
+
+A table is presented which lists the previous runs of the workflow.  If the workflow has never been run, it will be empty.  A the top of the list is a row labeled, 'This workflow has a workflow_dispatch event trigger.' with a drop down menu labeled 'Run workflow'.  Select it.
+
+A box will be presented asking, 'Use workflow from' with a drop down menu of all available branches.  The default branch is **master**.  Leave it selected and push the green 'Run workflow' button.
+
+The workflow will be queued to run and start running.
+
+The workflow pulls the latest Maiko image from Docker Hub and the Release Assets from the latest Medley release, generally defined as medley-YYMMDD.  The Medley Docker image adds in Tight VNC Server and retrieves the two tarballs associated with a release, one containing the sysouts and the other the other needed files source, fonts, etc.  The contents are uncompressed and loaded into the Medley directory structure.

Dockerfile

@@ -1,6 +1,7 @@
-FROM interlisp/maiko:latest
+FROM ubuntu:focal
 ARG BUILD_DATE
 LABEL name="Medley"
+# LABEL tags=${tags}
 LABEL description="The Medley Interlisp environment"
 LABEL url="https://github.com/Interlisp/medley"
 LABEL build-time=$BUILD_DATE
@@ -9,8 +10,8 @@ RUN apt-get update && apt-get install -y tightvncserver
 
 EXPOSE 5900
 
-# Need to refine this down to only needed directories.
-COPY . /app/medley
+# Copy and uncompress loadup and required source files.
+ADD *.tgz /app
 
 WORKDIR /app/medley
 

README.md

@@ -1,26 +1,72 @@
 # Medley 
 
-
-
-
 This repository is for the Lisp environment of [Medley Interlisp](https://Interlisp.org).
 
-We've made great process in sorting out what we have (some dusty corners notwithstanding), but there's quite a bit more work to do. Please report problems!
+See the [Medley Interlisp Wiki](https://github.com/Interlisp/medley/wiki/) for an overview and pointers to available documentation.
 
-See [Medley Interlisp Wiki](https://github.com/Interlisp/medley/wiki/) for an overview, and other pointers.
+A sub-project is [Interlisp/maiko](https://github.com/Interlisp/maiko), which is the implementation (in C) of the Medley virtual machine.
 
-A sub-project is [Interlisp/maiko](https://github.com/Interlisp/maiko), which is the implementation (in C) of the Medley virtual machine. 
+## Using releases
+
+There currently are separate releases of medley and maiko; get the latest version of each.
+There (soon) will also be Docker containers with the latest, and a way to try out Medley in the cloud (without installing).
 
 
-## Instructions for Building and Running
+### Getting releases
+
+Get the Maiko release [here](https://github.com/Interlisp/maiko/releases). You'll need the one corresponding to your operating system and processor (for Windows with WSL or Intel linux, use `linux.x86_64`; for Macs use `darwin.x86_64` for Intel and `darwin.aarch64` for M1.)
+
+Or, build your own maiko (the binaries `lde` `ldex` and `ldeinit`.) We can build for other OS arch pairs depending on what is available for GitHub actions.
+
+The medley release comes in two parts, found [here](https://github.com/Interlisp/medley/releases)
+1. The "loadups" (download `medley-`YYMMDD`-loadups.tgz`)
+2. The "runtime" (download `medley-`YYMMDD`-runtime.tgz`)
+
+You don't need the "runtime" if you've cloned this (medley) repo.
+If you happen to have the 'gh' GitHub command line installed you can download both using
+```
+   gh release download -R Interlisp/medley -p "*"
+```
+but otherwise just click on the link(s) to the parts you need.
+
+### Unpacking releases
+
+From a shell/terminal window:
+
+1. Choose where you want to install medley and maiko.
+Unpack the medley loadups file
+
+*  `cd ` ~parent~
+*  `tar -xvfz medley-`YYMMDD`-loadups.tgz`
+
+2. Unpack the medley runtime OR clone the Medley repo
+   (the "medley runtime" is just a subset of the whole repo)
+   
+* `tar -xvfz medley-`YYMMDD`-runtime.tgz` 
+
+   OR
+   ```
+   git clone https://github.com/Interlisp/medley
+   ```
+   
+3. Unpack the maiko file for your operating system and CPU type, e.g.,
+
+   ```
+   tar -xvfz maiko-210823.linux.x86_64.tgz
+   ```
+
+3. This should leave you with two directories, `medley` and `maiko`.
 
 ### Setting up X
 
-Medley Interlisp needs an X-Server to manage its display. Most Linux desktops have one. There are a number of free open source X-servers for windows. Mac users should head over to [XQuartz.org](https://xquartz.org/releases) -- be sure to pick a version if you have a newer Mac.
+Medley Interlisp currently needs an X-Server to manage its display. Most Linux desktops have one. Windows 11 with WSL includes an X-Server. For Windows 10 with WSL2, there are a number of open-source X servers; for example vcxsrv.
+
+Mac users should get [XQuartz from XQuartz.org](https://xquartz.org/releases).
+
+Medley manages the display entirely, doesn't use X fonts and manages it's own window system.
 
 If you have a high-resolution display, note that much of the graphics was designed for a low-resolution display, so an X-server that does "pixel doublilng" is best. (E.g., Raspberry Pi does pixel doubling on 4K displays.) It also presumes you have a 3-button mouse; the scroll-wheel on some mice act as one with some difficulty.) XQuartz Preferences/Input has "Emulate three button mouse" option.
 
-
 ### Running Medley Interlisp
 
 The `run-medley` script in this repo sets up some convenient defaults. Running Medley can be done by typing:
@@ -35,9 +81,6 @@ Or, if you wish to start Medley up with a different SYSOUT:
 $ cd medley
 $ ./run-medley <SYSOUT-file-name>
 ```
-
-Once the system comes up, give it a few seconds to initialize.
-
 The first time the system is run it loads the system image that comes
 with the system.  When you exit the system (or "do a `SaveVM`" menu
 option) the state of your machine is saved in a file named
@@ -73,23 +116,34 @@ files. A .TEDIT or .TXT file is probably documentation
 for the package of same name, at least in the library,
 internal/library, lispusers.
 
+
+
+
+
 The current repo has both Lisp sources and compiled .LCOM and .DFASL
-files, because some files don't compile in a vanilla lisp.sysout .
+files.
 
 Each directory should have a README.md, but briefly
 
-- docs -- Documentation files (either PDFs or online help)
-- fonts -- raster fonts (or font widths) in various resolutions for display, postscript, interpress, press formats
-- greetfiles -- various configuration setups
-- internal -- These _were_ internal to Venue; now internal/library and internal/test
-- library  -- packages that were supported (30 years ago)
-- lispusers -- packages that were only half supported (ditto)
-- loadups   -- has sysouts and other builds
-- patches -- for cases where reloading doesn't wor
-- scripts  -- some scripts for fixing up things
-- sunloadup --  support information for making a new lisp.sysout from scratch
-- sources   -- sources for Interlisp and Common Lisp implementations
-- unicode  -- data files for support of XCCS to and from Unicode mappings
+* BUILDING.md -- instructions on how to make your own loadups
+* clos -- early implementation of Common Lisp Object System
+* CLTL2 -- files submitted to bring Medley up to the conformance to "Common Lisp, the Language" 2nd edition. Not enough to conform to the ANSII standard lisp.
+* Dockerfile -- used when building Docker containers with Medley
+* docs -- Documentation files (either PDFs or online help; see medley/wiki)
+* fonts -- raster fonts (or font widths) in various resolutions for display, postscript, interpress, press formats
+* greetfiles -- various configuration setups
+* internal -- These _were_ internal to Venue; now internal/library and internal/test
+* library  -- packages that were supported (30 years ago)
+* lispusers -- User contributed packages that were only half supported (ditto)
+* loadups   -- has sysouts and other builds plus a few remnants
+* obsolete  -- files we should remove from the repo
+* rooms -- implementation of ROOMS window / desktop manager
+* run-medley -- script to enhance the options of running medley
+* scripts  -- some scripts for fixing up things
+* sources   -- sources for Interlisp and Common Lisp implementations
+* unicode  -- data files for support of XCCS to and from Unicode mappings
 
 plus
    Dockerfile, and scripts for building and running medley
+   tmp directory for use during build processes
+

docs/README.md

@@ -0,0 +1,11 @@
+This directory has:
+
+* dinfo  -- files for HelpSys man command Interlisp Reference Manual
+* Documentation Tools -- should be moved into Library
+
+ * Various conversions of Medley legacy documentation
+ 
+ Needs to be cleaned up. Putting PDF files in the repo doesn't seem right; 
+ we can make PS and PDF files as part of building a loadup
+ 
+ 

fonts/README.md

@@ -0,0 +1,16 @@
+# Fonts
+
+These are a not-very-well curated directories of fonts.
+
+"adobe" -- display versions of Postscript's fonts
+ palatino 8 9 10 12 14 18
+ "altofonts" -- random remnants of fonts used with Alto
+ "big" -- supposedly bigger fonts but turned out not (see #482)
+ "displayfonts" -- separated into directories by charset
+ "ipfonts" -- fonts (or font width information for Xeorx Interpress file format.
+ "other" -- random fonts associated with lispusers packages and not available elsewhere.
+ "postscriptfonts" -- fonts for postscript
+ "press" -- fonts for the older-than-interpress "press" format.
+ 
+ "xeroxprivate" -- ?? Seems like junk
+ 

greetfiles/MEDLEYDIR-INIT

@@ -0,0 +1,60 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "14-Nov-2021 22:34:49" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2
 2303   
+
+      changes to%:  (VARS MEDLEYDIR-INITCOMS)
+
+      previous date%: "14-Nov-2021 22:10:37" {DSK}<home>larry>medley>greetfiles>medleydir-INIT.;1)
+
+
+(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
+
+(RPAQQ MEDLEYDIR-INITCOMS

+       ((P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
+                              "")
+                         "/sources/MEDLEYDIR.LCOM")))
+        (FILES BACKGROUND-YIELD)
+        (VARS (FILING.ENUMERATION.DEPTH 1)
+              [LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
+                                           (UNIX-GETENV "HOME"]
+              [USERGREETFILES `((,LOGINDIR "INIT" COM)
+                                (,LOGINDIR "INIT"]
+              (COPYRIGHTSRESERVED NIL))
+        [P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
+        (FNS INTERLISPMODE)))
+
+(LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
+                   "")
+              "/sources/MEDLEYDIR.LCOM"))
+
+(FILESLOAD BACKGROUND-YIELD)
+
+(RPAQQ FILING.ENUMERATION.DEPTH
 1)
+
+(RPAQ LOGINDIR
 (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
+                                      (UNIX-GETENV "HOME"))))
+
+(RPAQ USERGREETFILES
 `((,LOGINDIR "INIT" COM)
+                           (,LOGINDIR "INIT")))
+
+(RPAQQ COPYRIGHTSRESERVED
 NIL)
+
+(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
+(DEFINEQ
+
+(INTERLISPMODE

+  [LAMBDA (OLD?)                                             (* N.H.Briggs " 2-Feb-88 14:26")

+    (PROCESSPROP 'EXEC 'PROFILE (XCL:COPY-PROFILE (if
 OLD?
+                                                      then
 "OLD-INTERLISP-T"
+                                                    else
 "INTERLISP")))
+    (XCL:SET-DEFAULT-EXEC-TYPE (if
 OLD?
+                                   then
 "OLD-INTERLISP-T"
+                                 else
 "INTERLISP"))
+    (SETQ *DEFAULT-MAKEFILE-ENVIRONMENT* (LIST :READTABLE (if
 OLD?
+                                                              then
 "OLD-INTERLISP-FILE"
+                                                            else
 "INTERLISP")
+                                               :PACKAGE "INTERLISP"])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (1455 2280 (INTERLISPMODE 1465 . 2278)))))
+STOP

greetfiles/README.md

@@ -0,0 +1,10 @@
+# medley/greetfiles
+
+This directory is somewhat vestigal -- it originally was used to hold 'initialization' files for everyone. Medley repo has only two:
+
+NOGREET   -- file to set as "system init" when doing loadups that don't want any personalization.
+
+SIMPLE-INIT -- system init for git-directory relative directory structure.
+      Contains INTERLISPMODE.
+
+

greetfiles/initcommands.txt

@@ -1,4 +0,0 @@
-lldb ../../maiko/darwin.386/ldeinit
-
-break set -n error
-run ./INIT.DLINIT -INIT -NF

internal/library/MAKE-PS

@@ -1,10 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 1-Sep-2021 21:13:57" {DSK}<home>larry>medley>internal>library>MAKE-PS.;6
 5503   
 
-      changes to%:  (VARS MAKE-PSCOMS)
-                    (FNS MAKE-PS-INIT)
+
(FILECREATED "17-Oct-2021 16:06:41" {DSK}<home>larry>medley>internal>library>MAKE-PS.;2
 5515   
 
-      previous date%: "31-Aug-2021 22:30:13" {DSK}<home>larry>medley>internal>library>MAKE-PS.;4)
+      changes to%:  (FILES DOC-OBJECTS)
+                    (VARS MAKE-PSCOMS)
+
+      previous date%: " 1-Sep-2021 21:13:57" {DSK}<home>larry>medley>internal>library>MAKE-PS.;1)
 
 
 (PRETTYCOMPRINT MAKE-PSCOMS)
@@ -14,7 +15,7 @@
         
         (* ;; " Load known used image object types")

 
-        (FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH)
+        (FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
         (ADVISE TEDIT.PROMPTPRINT)
         (INITVARS (BADFILESFILE)
                (BADFS)
@@ -113,7 +114,7 @@
 (* ;; " Load known used image object types")

 
 
-(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH)
+(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
 
 [XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T]
 
@@ -129,5 +130,5 @@
 (MAKE-PS-INIT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (786 5110 (MAKE-PS 796 . 4293) (MAKE-PS-INIT 4295 . 4731) (BADFILE 4733 . 5108)))))
+  (FILEMAP (NIL (793 5117 (MAKE-PS 803 . 4300) (MAKE-PS-INIT 4302 . 4738) (BADFILE 4740 . 5115)))))
 STOP

internal/library/MEDLEY-UTILS

@@ -1,28 +1,124 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
-
(FILECREATED "28-Mar-2021 10:17:29" 
-|{DSK}<home>larry>ilisp>medley>internal>library>MEDLEY-UTILS.;4|
 3190   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
+
+
(FILECREATED "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;14|
 9472   
 
       |changes| |to:|  (VARS MEDLEY-UTILSCOMS)
+                       (FNS GATHER-INFO)
 
-      |previous| |date:| "24-Mar-2021 15:45:15" 
-|{DSK}<home>larry>ilisp>medley>internal>library>MEDLEY-UTILS.;3|)
+      |previous| |date:| "23-Oct-2021 14:53:16" 
+|{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2|)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
 
-(RPAQQ MEDLEY-UTILSCOMS
 ((FNS MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
+(RPAQQ MEDLEY-UTILSCOMS
 ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
                              (VARS MEDLEY-FIX-DIRS)
                              (FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
 (DEFINEQ
 
+(GATHER-INFO

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

+    (SELECTQ PHASE
+        (ALL (SETQ SYSFILES (UNION SYSFILES FILELST))
+             (SETQ FILELST NIL)
+             (FILESLOAD (SOURCE)
+                    SYSEDIT)
+             (|for|
 I |from|
 1 |to|
 4 |do|
 (GATHER-INFO
 I)))
+        (1 (SETQ LOADEDFILES (|for|
 X |in|
 LOADEDFILELST |collect|
 (FILENAMEFIELD
+                                                                                X
+                                                                                'NAME)))
+           (FILESLOAD FILESETS)
+           (SETQ ALLFILESETSFILES (|for|
 X |in|
 FILESETS |join|
 (APPEND (EVAL X))))
+           (SETQ SOURCES (|for|
 X |in|
 (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
+                            |when|
 (NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
+                                                  '(LCOM DFASL TEDIT TXT)))
+                            |collect|
 (FILENAMEFIELD X 'NAME))))
+        (-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
+                   (|for|
 X |in|
 LOADEDFILES |when|
 (NOT (OR (FMEMB X SYSFILES)
+                                                                         (FMEMB X FILELST)))
+                      |collect|
 X)
+                   T)
+            (PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES 
+                                                                                 LOADEDFILES))
+                   T)
+            (PRINTOUT T "Files in FILESETS not loaded " (CL:SET-DIFFERENCE ALLFILESETSFILES 
+                                                               LOADEDFILES)
+                   T))
+        (2 (SETQ DEFINEDFNS (LET ((DEFD NIL))
+                                 (MAPATOMS (FUNCTION (CL:LAMBDA (X)
+                                                            (CL:WHEN (GETD X)
+                                                                (CL:SETQ DEFD (CONS X DEFD))))))
+                                 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)
+                               |as|
 VAL |in|
 Y
+                               |do|
 (|for|
 S |in|
 VAL
+                                           |do|
 (PUTPROP S REV (CONS X (GETPROP S REV)))))))
+           (SETQ CALLEDFNS NIL)
+           (MAPATOMS (FUNCTION (LAMBDA (X)
+                                 (|if|
 (AND (NOT (GETD X))
+                                                (GETPROP X 'CALLED-BY))
+                                     |then|
 (CL:PUSH X CALLEDFNS))))))
+        (-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
+        (3 (|for|
 X |in|
 SYSFILES
+              |do|

+              (LOAD X 'PROP)
+              (PUTPROP X 'CONTENT (READFILE X))
+              (|for|
 EXR |in|
 (GETPROP X 'CONTENT)
+                 |do|
 (SELECTQ (CAR EXR)
+                              (DEFINEQ (|for|
 DFN |in|
 (CDR EXR)
+                                          |do|
 (|if|
 (EQUAL (CADR DFN)
+                                                                    (GETPROP (CAR DFN)
+                                                                           'EXPR))
+                                                       |then|
 (PRINTOUT T (CAR DFN)
+                                                                         " ")
+                                                             (PUTPROP (CAR DFN)
+                                                                    'EXPR
+                                                                    (CADR DFN))
+                                                     |else|
 (PRINTOUT T (CAR DFN)
+                                                                       "* "))))
+                              NIL)))
+           (SETQ ALLCONTENT (|for|
 X |in|
 SYSFILES |collect|
 (CONS X (GETPROP
+                                                                                  X
+                                                                                  'CONTENT))))
+                                                             (* \; " don't edit with SEDIT")

+           (LET (DUPS)
+                (|for|
 X |in|
 SYSFILES
+                   |do|
 (|for|
 FN |in|
 (FILEFNSLST X)
+                               |do|
 (|if|
 (GETPROP FN 'WHEREIS)
+                                            |then|
 (NCONC1 (GETPROP FN 'WHEREIS)
+                                                              X)
+                                                  (OR (FMEMB FN DUPS)
+                                                      (SETQ DUPS (CONS FN DUPS)))
+                                          |else|
 (PUTPROP FN 'WHEREIS (LIST X)))))
+                (SETQ DUPFNS DUPS))
+           (SETQ NO-SOURCE (|for|
 X |in|
 DEFINEDFNS |when|
 (NOT (GETPROP X 'EXPR))
+                              |collect|
 X)))
+        (-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
+            (PRINTOUT T "Functions on more than one file: " DUPFNS T))
+        (4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
+                  T)
+           (FILESLOAD (SOURCE)
+                  SYSEDIT)
+           (|for|
 X |in|
 SYSFILES |do|
 (MSNOTICEFILE X))
+           (|for|
 X |in|
 SYSFILES |do|
 (PRINTOUT T T "Analyzing " X T)
+                                                (MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
+        (-4 "No queries yet")
+        (HELP))))
+
 (MEDLEY-FIX-LINKS

-  (LAMBDA (UNIXPATH)
                                  (* \; "Edited 18-Jan-2021 12:01 by larry")

+  (LAMBDA (UNIXPATH)                                         (* \; 
+
                                                           "Edited 18-Jan-2021 12:01 by larry")

     (OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
-        (ERROR "No Directory"))
                       (* \; "Edited 18-Jan-2021 11:45 by larry")

+        (ERROR "No Directory"))                              (* \; 
+
                                                           "Edited 18-Jan-2021 11:45 by larry")

     (|ShellCommand| (CONCAT "cd " UNIXPATH " && /bin/sh scripts/fixlinks && /bin/sh /tmp/doit"))))
 
 (MEDLEY-FIX-DATES

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

+  (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))))))
 )
@@ -32,7 +128,8 @@
 (DEFINEQ
 
 (MAKE-EXPORTS-ALL

-  (LAMBDA NIL
                                         (* \; "Edited  9-Mar-2021 16:11 by larry")

+  (LAMBDA NIL                                                (* \; 
+
                                                           "Edited  9-Mar-2021 16:11 by larry")

                                                              (* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/.  Don't know why it does the CORE/RENAME")

                                                              (* 
 
        "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")

@@ -45,7 +142,8 @@
     (GATHEREXPORTS EXPORTFILES (MEDLEYDIR "tmp" "exports.all" T))))
 
 (MAKE-WHEREIS-HASH

-  (LAMBDA NIL
                                         (* \; "Edited 24-Mar-2021 13:26 by larry")

+  (LAMBDA NIL                                                (* \; 
+
                                                           "Edited 24-Mar-2021 13:26 by larry")

     (LET ((FILING.ENUMERATION.DEPTH 1)
           HASHFILE)
          (DRIBBLE (MEDLEYDIR "tmp" "whereis.dribble" T))
@@ -59,6 +157,6 @@
          (DRIBBLE))))
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (567 1272 (MEDLEY-FIX-LINKS 577 . 966) (MEDLEY-FIX-DATES 968 . 1270)) (1430 3167 (
-MAKE-EXPORTS-ALL 1440 . 2389) (MAKE-WHEREIS-HASH 2391 . 3165)))))
+  (FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049
+ . 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447)))))
 STOP

library/BIGBITMAPS

@@ -1,15 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "13-Jun-2021 14:02:38" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;5|
 113115 
 
-      |changes| |to:|  (FNS \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH BIGBITMAPP)
+
(FILECREATED "26-Oct-2021 14:51:38" |{DSK}<home>larry>medley>library>BIGBITMAPS.;7|
 110451 
+
+      |changes| |to:|  (FNS UNCOLORIZEBITMAP COLORIZEBITMAP \\BWTOCOLORBLT)
                        (VARS BIGBITMAPSCOMS)
+                       (MACROS |\\SFInvert|)
 
-      |previous| |date:| "10-May-2021 15:37:51" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;1|)
+      |previous| |date:| "13-Jun-2021 14:02:38" |{DSK}<home>larry>medley>library>BIGBITMAPS.;5|)
 
 
-; Copyright (c) 1991, 1993-1994, 2021 by Venue.
+; Copyright (c) 1991, 1993-1994 by Venue.
 
 (PRETTYCOMPRINT BIGBITMAPSCOMS)
 
@@ -69,11 +69,7 @@
 
 (PUTPROPS |\\SFInvert|
 MACRO
 ((|BitMap| \y)
 
-         (* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| |are| |stored| |with| 
-
       0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower| 
-
       |left.| |The| |correction| |is| |actually| |off| |by| |one|
-
       (|greater|) |because| \a |majority| |of| |the| |places| |that| |it| |is| 
-
       |called| |actually| |need| |one| |more| |than| |corrected| Y |value.|)

+                                 (* |;;| "corrects for the fact that alto bitmaps are stored with 0,0 as upper left while lisp bitmaps have 0,0 as lower left.  The correction is actually off by one (greater) because a majority of the places that it is called actually need one more than corrected Y value.")

 
                                       (IDIFFERENCE (|fetch|
 (BITMAP BITMAPHEIGHT) |of|
 
                                                                                             |BitMap|)
@@ -1478,11 +1474,12 @@
 (DEFINEQ
 
 (COLORIZEBITMAP

-  (LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL)
         (* \; "Edited 13-Jul-90 14:42 by matsuda")

+  (LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL)                (* \; 
+
                                                           "Edited 26-Oct-2021 14:23 by larry")

+                                                             (* \; 
+
                                                           "Edited 13-Jul-90 14:42 by matsuda")

 
-         (* |creates| \a |copy| |of| BITMAP |that| |is| |in| |color| |form| |allowing| 
-
       BITSPERPIXEL |per| |pixel.| 0COLOR |and| 1COLOR |are| |the| |color| |numbers| 
-
       |that| |get| |translated| |from| 0 |and| 1 |respectively.|)

+    (* |;;| "creates a copy of BITMAP that is in color form allowing BITSPERPIXEL per pixel.  0COLOR and 1COLOR are the color numbers that get translated from 0 and 1 respectively.")

 
     (PROG (COLORBITMAP)
           (SETQ COLORBITMAP (BITMAPCREATE
 (|fetch|
 (BITMAP BITMAPWIDTH) |of|
 BITMAP)
@@ -1516,14 +1513,20 @@
           (RETURN COLORBITMAP))))
 
 (\\BWTOCOLORBLT

-  (LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)

-                                                           (* \; "Edited  8-May-2021 22:31 by rmk:")

+  (LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
+                                                             (* \; 
+
                                                           "Edited 26-Oct-2021 14:36 by larry")

+                                                             (* \; 
+
                                                           "Edited 26-Oct-2021 14:32 by larry")

+                                                             (* \; 
+
                                                           "Edited 26-Oct-2021 14:26 by larry")

+                                                             (* \; 
+
                                                           "Edited  8-May-2021 22:31 by rmk:")

+
+    (* |;;| "blits from a black and white bitmap into a color bitmap which has DESTNBITS bits per pixel.  DESTCOLORBM is a pointer to the color bitmap.")

+
+    (* |;;| "assumes all datatypes and bounds have been checked")

 
-         (* |blits| |from| \a |black| |and| |white| |bitmap| |into| \a |color| |bitmap| 
-
       |which| |has| DESTNBITS |bits| |per| |pixel.|
-
       DESTCOLORBM |is| \a |pointer| |to| |the| |color| |bitmap.|)

-                                                             (* |assumes| |all| |datatypes| |and| 
-
                                                           |bounds| |have| |been| |checked|)

     (SELECTQ DESTNBITS
         (4 (PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW DESWRD DESOFF
                       NBITS DESALIGNLEFT SCR)
@@ -1538,24 +1541,24 @@
                  (SETQ DESRW (|fetch|
 (BITMAP BITMAPRASTERWIDTH) |of|
 DESTCOLORBM))
                  (SETQ DESWRD (FOLDLO DLEFT 4))
                  (SETQ DESOFF (MOD DLEFT 4))
-                 (SETQ NBITS 4)                              (* DESTCOLORBM |is| |used| |to| 
-
                                                           |allow| |one| |bit| |per| |pixel| 
-
                                                           |bitblt| |operations| |on| |the| 
-
                                                           |bitmap.|)

+                 (SETQ NBITS 4)
+
+            (* |;;| 
+
          "DESTCOLORBM is used to allow one bit per pixel bitblt operations on the bitmap.")

+
                  (COND
-                    ((NOT (EQ 0 DESOFF))                     (* |save| |the| |left| |bits| |of| 
-
                                                           |the| |destination| |bitmap| |so| 
-
                                                           |it| |can| |be| |word| |aligned.|)

+                    ((NOT (EQ 0 DESOFF))
+
+                     (* |;;| 
+
                   "save the left bits of the destination bitmap so it can be word aligned.")

+
                      (SETQ SCR (BITMAPCREATE
 4 HEIGHT 4))
                      (BITBLT
 DESTCOLORBM (SETQ DESALIGNLEFT (LLSH DESWRD 2))
                             DBOTTOM SCR 0 0 DESOFF HEIGHT 'INPUT 'REPLACE)))
                  (|for|
 LINECOUNTER |from|
 1 |to|
 HEIGHT
                     |do|
 
 
-         (* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are| 
-
       |stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is| 
-
       |necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for| 
-
       |height| |difference.|)

+                          (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.")

 
                           (\\4BITLINEBLT (\\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT
                                                                                   (IPLUS LINECOUNTER
@@ -1570,9 +1573,11 @@
                                                            DESWRD))
                                  WIDTH MAP 0COLOR 1COLOR))
                  (COND
-                    (DESALIGNLEFT                            (* |move| |the| |color| |bits| |to| 
-
                                                           |the| |right| |and| |restore| |the| 
-
                                                           |saved| |color| |bits.|)

+                    (DESALIGNLEFT 
+
+                           (* |;;| 
+
                         "move the color bits to the right and restore the saved color bits.")

+
                            (BITBLT
 DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM (IPLUS 
                                                                                          DESALIGNLEFT
                                                                                            DESOFF)
@@ -1580,32 +1585,8 @@
                            (BITBLT
 SCR 0 0 DESTCOLORBM DESALIGNLEFT DBOTTOM DESOFF HEIGHT
                                   'INPUT
                                   'REPLACE)))))
-        (8 
-
-         (* PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW 
-
       DESWRD DESOFF) (SETQ MAP (|fetch| (ARRAYP BASE) |of|
-
       (\\MAP8 0COLOR 1COLOR))) (SETQ SRCBASE (|fetch|
-
       (BITMAP BITMAPBASE) |of| SOURCEBWBM)) (SETQ SRCHEIGHT
-
       (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM))
-
       (SETQ SRCRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| SOURCEBWBM))
-
       (SETQ SRCWRD (FOLDLO SLEFT BITSPERWORD))
-
       (SETQ SRCOFFSET (MOD SLEFT BITSPERWORD))
-
       (SETQ DESBASE (|fetch| (BITMAP BITMAPBASE) |of| DESTCOLORBM))
-
       (SETQ DESHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| DESTCOLORBM))
-
       (SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM))
-
       (SETQ DESWRD (FOLDLO DLEFT 2)) (SETQ DESOFF
-
       (MOD DLEFT 2)) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do|
-
       (* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are| 
-
       |stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is| 
-
       |necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for| 
-
       |height| |difference.|) (\\8BITLINEBLT (\\ADDBASE SRCBASE
-
       (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER SBOTTOM)) SRCRW) 
-
       SRCWRD)) SRCOFFSET (\\ADDBASE DESBASE (IPLUS
-
       (ITIMES (IDIFFERENCE DESHEIGHT (IPLUS LINECOUNTER DBOTTOM)) DESRW) DESWRD)) 
-
       DESOFF WIDTH MAP 0COLOR 1COLOR)) *)

-
-           ((OPCODES SUBRCALL 142 11)
-            SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS))
+        (8 (SUBRCALL COLORIZE-BITMAP SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT
+                  0COLOR 1COLOR DESTNBITS))
         (24 (PROG (SRCBASE SRCHEIGHT SRCRW DESBASE DESHEIGHT DESRW)
                   (SETQ SRCBASE (|fetch|
 (BITMAP BITMAPBASE) |of|
 SOURCEBWBM))
                   (SETQ SRCHEIGHT (|fetch|
 (BITMAP BITMAPHEIGHT) |of|
 SOURCEBWBM))
@@ -1616,10 +1597,7 @@
                   (|for|
 LINECOUNTER |from|
 1 |to|
 HEIGHT
                      |do|
 
 
-         (* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are| 
-
       |stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is| 
-
       |necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for| 
-
       |height| |difference.|)

+                           (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.")

 
                            (\\24BITLINEBLT (\\ADDBASE SRCBASE (ITIMES (IDIFFERENCE SRCHEIGHT
                                                                              (IPLUS LINECOUNTER 
@@ -1634,7 +1612,14 @@
         (SHOULDNT))))
 
 (UNCOLORIZEBITMAP

-  (LAMBDA (BITMAP COLORMAP)
                           (* \; "Edited 13-Jul-90 16:54 by matsuda")

+  (LAMBDA (BITMAP COLORMAP)                                  (* \; 
+
                                                           "Edited 26-Oct-2021 14:51 by larry")

+                                                             (* \; 
+
                                                           "Edited 26-Oct-2021 14:44 by larry")

+                                                             (* \; 
+
                                                           "Edited 26-Oct-2021 14:44 by larry")

+                                                             (* \; 
+
                                                           "Edited 13-Jul-90 16:54 by matsuda")

     (PROG (BITSPERPIXEL
 MAXCOLOR MAXX MAXY BWBITMAP TABLE RGB R G B BIT BASE BWBASE RASTERWIDTH 
                  BWRASTERWIDTH WORD)
           (SETQ MAXX (SUB1 (BITMAPWIDTH
 BITMAP)))
@@ -1685,8 +1670,7 @@
                               (SETQ BWBASE (\\ADDBASE BWBASE BWRASTERWIDTH))))))
               (8 (COND
                     ((NOT (|type?|
 BIGBM BITMAP))
-                     ((OPCODES SUBRCALL 141 3)
-                      BITMAP BWBITMAP TABLE))
+                     (SUBRCALL UNCOLORIZE-BITMAP BITMAP BWBITMAP TABLE))
                     (T (PROG ((SRCBIGBMLIST (|fetch|
 (BIGBM BIGBMLIST) |of|
 BITMAP))
                               SRCBITMAP
                               (WIDTH (ADD1 MAXX))
@@ -1705,8 +1689,8 @@
                                                                                      |of|
 
                                                                                            SRCBITMAP)
                                                                       )))
-                                                          ((OPCODES SUBRCALL 141 3)
-                                                           SRCBITMAP TEMPBM TABLE)
+                                                          (SUBRCALL UNCOLORIZE-BITMAP SRCBITMAP 
+                                                                 TEMPBM TABLE)
                                                           (BITBLT
 TEMPBM 0 (IDIFFERENCE
                                                                                 (ADD1 MAXY)
                                                                                 HEIGHT)
@@ -1714,25 +1698,7 @@
                                                                  'INPUT
                                                                  'REPLACE)
                                                           (SETQ SRCBITMAP (|GetNewFragment| 
-                                                                                 SRCBIGBMLIST))))))
-                                                             (* |for| Y |from| 0 |to| MAXY |do|
-
                                                           (SETQ WORD 0) (|for| X |from| 0 |to| 
-
                                                           MAXX |do| (SETQ WORD
-
                                                           (LOGOR (LLSH WORD 1)
-
                                                           (\\GETBASE TABLE (\\GETBASEBYTE BASE 
-
                                                           X)))) (COND ((EQ (LOGAND X 15) 15)
-
                                                           (\\PUTBASE BWBASE (FOLDLO X 16) WORD)
-
                                                           (SETQ WORD 0)))) (COND
-
                                                           ((NOT (EQ (LOGAND MAXX 15) 15))
-
                                                           (SETQ WORD (LLSH WORD
-
                                                           (IDIFFERENCE 15 (LOGAND MAXX 15))))
-
                                                           (\\PUTBASE BWBASE (FOLDLO MAXX 16) 
-
                                                           WORD))) (COND ((NOT
-
                                                           (EQ Y MAXY)) (SETQ BASE
-
                                                           (\\ADDBASE BASE RASTERWIDTH))
-
                                                           (SETQ BWBASE (\\ADDBASE BWBASE 
-
                                                           BWRASTERWIDTH)))) *)

-                 )
+                                                                                 SRCBIGBMLIST)))))))
               NIL)
           (RETURN BWBITMAP))))
 )
@@ -1746,17 +1712,17 @@
 
 (MOVD 'BITBLT 'BKBITBLT)
 )
-(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994 2021))
+(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (3337 48035 (BIGBITMAPP 3347 . 3493) (BITBLT.BIGBM 3495 . 14318) (BITMAPCREATE.BIGBM 
-14320 . 15662) (BITMAPCREATE 15664 . 17266) (BITMAPCOPY 17268 . 17803) (BLTSHADE.BIGBM 17805 . 20941) 
-(BITBLT 20943 . 22591) (\\ORG.BITBLT 22593 . 34162) (\\BLTSHADE.DISPLAY 34164 . 43402) (
-\\RESHOWBORDER1 43404 . 48033)) (48036 71314 (\\DRAWCIRCLE.BIGBM 48046 . 51409) (\\FILLCIRCLE.BIGBM 
-51411 . 55457) (\\DRAWELLIPSE.BIGBM 55459 . 59979) (\\DRAWCURVE.BIGBM 59981 . 63831) (
-\\DRAWLINE.BIGBM.DASH 63833 . 68192) (\\DRAWLINE.BIGBM.NODASH 68194 . 71312)) (71315 86890 (DSPCREATE 
-71325 . 73755) (DSPDESTINATION 73757 . 77655) (|\\SFFixY| 77657 . 83379) (|\\SFFixDestination| 83381
- . 84564) (|\\SFFixClippingRegion| 84566 . 86888)) (86891 94977 (\\SW2BM 86901 . 91925) (BITMAPHEIGHT 
-91927 . 92425) (BITMAPWIDTH 92427 . 92919) (|\\SFFixFont| 92921 . 93893) (BITSPERPIXEL 93895 . 94975))
- (94978 112868 (COLORIZEBITMAP 94988 . 97625) (\\BWTOCOLORBLT 97627 . 105909) (UNCOLORIZEBITMAP 105911
- . 112866)))))
+  (FILEMAP (NIL (3215 47913 (BIGBITMAPP 3225 . 3371) (BITBLT.BIGBM 3373 . 14196) (BITMAPCREATE.BIGBM 
+14198 . 15540) (BITMAPCREATE 15542 . 17144) (BITMAPCOPY 17146 . 17681) (BLTSHADE.BIGBM 17683 . 20819) 
+(BITBLT 20821 . 22469) (\\ORG.BITBLT 22471 . 34040) (\\BLTSHADE.DISPLAY 34042 . 43280) (
+\\RESHOWBORDER1 43282 . 47911)) (47914 71192 (\\DRAWCIRCLE.BIGBM 47924 . 51287) (\\FILLCIRCLE.BIGBM 
+51289 . 55335) (\\DRAWELLIPSE.BIGBM 55337 . 59857) (\\DRAWCURVE.BIGBM 59859 . 63709) (
+\\DRAWLINE.BIGBM.DASH 63711 . 68070) (\\DRAWLINE.BIGBM.NODASH 68072 . 71190)) (71193 86768 (DSPCREATE 
+71203 . 73633) (DSPDESTINATION 73635 . 77533) (|\\SFFixY| 77535 . 83257) (|\\SFFixDestination| 83259
+ . 84442) (|\\SFFixClippingRegion| 84444 . 86766)) (86769 94855 (\\SW2BM 86779 . 91803) (BITMAPHEIGHT 
+91805 . 92303) (BITMAPWIDTH 92305 . 92797) (|\\SFFixFont| 92799 . 93771) (BITSPERPIXEL 93773 . 94853))
+ (94856 110209 (COLORIZEBITMAP 94866 . 97676) (\\BWTOCOLORBLT 97678 . 104271) (UNCOLORIZEBITMAP 104273
+ . 110207)))))
 STOP

library/DATABASEFNS

@@ -1,19 +1,22 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 3-May-93 18:44:36" "{DSK}<project>lfg>parser>DATABASEFNS.;4"
 17283  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7
 16051  
 
       changes to%:  (FNS DUMPDB)
 
-      previous date%: " 7-Jul-92 09:57:14" "{DSK}<project>lfg>parser>DATABASEFNS.;3")
+      previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
 
 
 (* ; "
-Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.
+Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DATABASEFNSCOMS)
 
 (RPAQQ DATABASEFNSCOMS

-       [(* Does automatic Masterscope database maintenance)
+       [
+        (* ;; "Does automatic Masterscope database maintenance")

+
         [DECLARE%: FIRST (P (VIRGINFN 'LOAD T)
                             (MOVD? 'LOAD 'OLDLOAD)
                             (VIRGINFN 'LOADFROM T)
@@ -28,16 +31,15 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
         (INITVARS (LOADDBFLG 'ASK)
                (SAVEDBFLG 'ASK))
         (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
-        (* To permit MSHASH interface)
-        (INITVARS (MSHASHFILENAME)
-               (MSFILETABLE))
+        (INITVARS (MSFILETABLE))
+                                                             (* ; "To permit MSHASH interface")

         (LOCALVARS . T)
         (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
         (DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T])
 
 
 
-(* Does automatic Masterscope database maintenance)

+(* ;; "Does automatic Masterscope database maintenance")

 
 (DECLARE%: FIRST 
 
@@ -56,78 +58,81 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
 (DEFINEQ
 
 (DBFILE

-  [LAMBDA (FILE ASKFLAG)
                                     (* lmm "29-APR-81 20:27")

-          
-          (* Finds a database file that corresponds to the contents of FILE.
-
          Looks in directory of FILE, and also in the directory that file originally came 
-
          from, if it was copied. Returns NIL if no database file is found, else
-
          (fulldbfilename . filedates)%, where filedates identifies the name under which 
-
          the file that the database corresponds to is currently known.
-
          -
-
          If FILE doesn't have a version, tries to get database for version in core, or 
-
          most recent version if it hasn't been loaded)

+  [LAMBDA (FILE ASKFLAG)
                                (* ; "Edited 24-Oct-2021 16:50 by rmk:")


+                                                             (* lmm "29-APR-81 20:27")

+
+    (* ;; "Finds a database file that corresponds to the contents of FILE.  Looks in directory of FILE, and also in the directory that file originally came from, if it was copied.  Returns NIL if no database file is found, else (fulldbfilename  . filedates), where filedates identifies the name under which the file that the database corresponds to is currently known.")

+
+    (* ;; "If FILE doesn't have a version, tries to get database for version in core, or most recent version if it hasn't been loaded")

 
     (DECLARE
 (GLOBALVARS COMPILE.EXT FILERDTBL))
     [COND
        ((NULL FILE)
         (SETQ FILE (INPUT)))
-       ((EQ (FILENAMEFIELD FILE 'EXTENSION)
-            COMPILE.EXT)                                     (* Map compiled file into symbolic 
-
                                                             name)

+       ((MEMB (FILENAMEFIELD FILE 'EXTENSION)
+              *COMPILED-EXTENSIONS*)                         (* ; 
+
                                                           "Map compiled file into symbolic name")

         (SETQ FILE (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY FILE]
-    (PROG [(FILEDATES (COND
-                         [(AND (NULL (FILENAMEFIELD FILE 'VERSION))
-                               (CAR (GETPROP (NAMEFIELD FILE)
-                                           'FILEDATES]
-                         ([SETQ FILE (COND
-                                        (ASKFLAG (INFILEP FILE))
-                                        (T (FINDFILE FILE]
-                          (CONS (FILEDATE FILE)
-                                FILE]
-          (AND FILEDATES (RETURN (DBFILE1
 FILE FILEDATES])
+    (LET [(FILEDATES (COND
+                        [(AND (NULL (FILENAMEFIELD FILE 'VERSION))
+                              (CAR (GETPROP (NAMEFIELD FILE)
+                                          'FILEDATES]
+                        ([SETQ FILE (COND
+                                       (ASKFLAG (INFILEP FILE))
+                                       (T (FINDFILE FILE]
+                         (CONS (FILEDATE FILE)
+                               FILE]
+         (AND FILEDATES (DBFILE1
 FILE FILEDATES])
 
 (DBFILE1

-  [LAMBDA (F FILEDATES)
                                      (* jds "25-Sep-86 20:04")

-          
-          (* Searches databases based on F to find one that matches FILEDATES.
-
          Returns (dbfilename . filedates) if successful.
-
          For efficiency, checks the most likely highest version first, before doing the 
-
          directory enumeration)

+  [LAMBDA (F FILEDATES)
                                 (* ; "Edited 24-Oct-2021 15:43 by rmk:")


+                                                             (* jds "25-Sep-86 20:04")

 
-    (PROG ((HIGHEST (INFILEP (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION 'NIL 'BODY F)))
-           DBF)
-          (RETURN (COND
-                     ((NULL HIGHEST)                         (* ; 
-
                                                         "No file matches the name we gave, so punt.")

-                      NIL)
-                     ((SETQ DBF (DBFILE2
 HIGHEST FILEDATES)) (* ; "The most recent one matches.")

-                      (CONS DBF FILEDATES))
-                     (T                                      (* ; 
-
                                           "Hunt back thru back versions looking for a matching one.")

-                        (for
 DBF in
 (REMOVE HIGHEST (FILDIR (PACKFILENAME 'EXTENSION 'DATABASE
-                                                                   'VERSION
-                                                                   '*
-                                                                   'BODY F)))
-                           when
 (SETQ DBF (DBFILE2
 DBF FILEDATES))
-                           do
 (RETURN (CONS DBF FILEDATES])
+    (* ;; "Searches databases based on F to find one that matches FILEDATES.  Returns (dbfilename  . filedates) if successful.  For efficiency, checks the most likely highest version first, before doing the directory enumeration")

+
+    (LET ((HIGHEST (INFILEP (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION 'NIL 'BODY F)))
+          DBF)
+         (COND
+            ((NULL HIGHEST)                                  (* ; 
+
                                                       "No file matches the name we gave, so punt.")

+             NIL)
+            ((SETQ DBF (DBFILE2
 HIGHEST FILEDATES))      (* ; "The most recent one matches.")

+             (CONS DBF FILEDATES))
+            (T                                               (* ; 
+
                                         "Hunt back thru back versions looking for a matching one.")

+               (for
 DBF in
 (REMOVE HIGHEST (FILDIR (PACKFILENAME 'EXTENSION 'DATABASE
+                                                                  'VERSION
+                                                                  '*
+                                                                  'BODY F)))
+                  when
 (SETQ DBF (DBFILE2
 DBF FILEDATES))
+                  do
 (RETURN (CONS DBF FILEDATES])
 
 (DBFILE2

-  [LAMBDA (DBF FILEDATES)
                                (* ; "Edited 28-Nov-90 12:42 by rmk:")

-                                                             (* T if DBF is the name of the 
-
                                                           database file matching FILEDATES)

+  [LAMBDA (DBF FILEDATES)                                    (* ; 
+
                                                           "Edited 24-Oct-2021 20:18 by rmk:")

+                                                             (* ; "Edited 28-Nov-90 12:42 by rmk:")

+
+    (* ;; "Returns an open stream for DBF if it's the name of the database file matching FILEDATES.  DBF is positioned after all the header material, and the reader environment is set up for it.")

+
     [RESETSAVE (SETQ DBF (OPENSTREAM DBF 'INPUT))
            '(PROGN (CLOSEF? OLDVALUE]
+    (SET-READER-ENVIRONMENT (READ-READER-ENVIRONMENT DBF (MAKE-READER-ENVIRONMENT 
+                                                                *NEW-INTERLISP-MAKEFILE-ENVIRONMENT*)
+                                   )
+           DBF)
 
-         (* The close is done in the LOADDB RESETLST, except when a candidate file isn't 
-
       correct)

+    (* ;; "Skip the header stuff")

 
-    (SKREAD DBF)                                             (* Skip LOAD error message)

-    (COND
-       ([STREQUAL (CAR FILEDATES)
-               (CAR (READ DBF (FIND-READTABLE "INTERLISP"]
-        DBF)
-       (T (CLOSEF DBF)
-          NIL])
+    (CL:WHEN [OR (EQ 0 (GETFILEPTR DBF))
+                 (AND [EQ 'FILECREATED (CAR (LISTP (READ DBF]
+                      (EQ 'PRETTYCOMPRINT (CAR (LISTP (READ DBF]
+        [EQ 'PROGN (CAR (LISTP (READ DBF]
+        (COND
+           ((STREQUAL (CAR FILEDATES)
+                   (CAR (READ DBF)))
+            DBF)
+           (T (CLOSEF DBF)
+              NIL)))])
 
 (LOAD

   [LAMBDA (FILE LDFLG PRINTFLG)
                              (* lmm "29-APR-81 20:27")

@@ -156,88 +161,62 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
 (DEFINEQ
 
 (DUMPDB

-  [LAMBDA (FILE PROPFLG)
                                 (* ; "Edited  3-May-93 18:44 by rmk:")

+  [LAMBDA (FILE PROPFLG)                                     (* ; 
+
                                                           "Edited 27-Oct-2021 10:51 by larry")

+                                                             (* ; 
+
                                                           "Edited 24-Oct-2021 16:24 by rmk:")

 
-         (* Dumps a Masterscope database for functions in FILE.
-
       Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice 
-
       calls it. A user-level call would default PROPFLG to NIL.)

+    (* ;; "Dumps a Masterscope database for functions in FILE.  Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it.  A user-level call would default PROPFLG to NIL.")

 
-         (* The FILE check is because MAKEFILE returns a list when it doesn't understand 
-
       the options)

+    (* ;; 
+
  "The FILE check is because MAKEFILE returns a list when it doesn't understand the options")

 
-    (DECLARE
 (GLOBALVARS MSHASHFILENAME MSFILETABLE SAVEDBFLG))
-    (AND FILE (OR (LITATOM FILE)
-                  (STRINGP FILE))
-         (PROG (DBFILE
 (FL (NAMEFIELD FILE))
-                      FNS
-                      (FFNS (FILEFNSLST FILE)))
-               (COND
-                  (FFNS)
-                  ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
-                                                             (* Always dump if this is a known 
-
                                                           file)

-                   (SETQ PROPFLG NIL))
-                  (T (COND
-                        (PROPFLG (/REMPROP FL 'DATABASE))
-                        (T (printout T T FILE " has no functions." T)))
-                     (RETURN)))
-               (SETQ FNS FFNS)
-               (COND
-                  ([OR (NULL PROPFLG)
-                       (EQ (GETPROP FL 'DATABASE)
-                           'YES)
-                       (EQ SAVEDBFLG 'YES)
-                       (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
-                                                             (* If MSHASH is loaded, only dump 
-
                                                           functions in the local database)

-                   [COND
-                      (MSHASHFILENAME (SETQ FNS (for
 FN in
 FNS
-                                                   when
 (PROGN (UPDATEFN FN)
-                                                                   (LOCALFNP FN)) collect
 FN]
-                   (RESETLST
-                       [RESETSAVE (SETQ DBFILE (OPENSTREAM (PACKFILENAME 'EXTENSION 'DATABASE
-                                                                  'VERSION NIL 'BODY FILE)
-                                                      'OUTPUT
-                                                      'NEW))
-                              '(PROGN (CLOSEF? OLDVALUE)
-                                      (AND RESETSTATE (DELFILE OLDVALUE]
-                       (RESETSAVE (OUTPUT DBFILE))
-                       (RESETSAVE (SETREADTABLE (FIND-READTABLE "INTERLISP")))
-                       (RESETSAVE (CL:IN-PACKAGE "INTERLISP")
-                              (LIST 'CL:IN-PACKAGE (CL:PACKAGE-NAME *PACKAGE*)))
-                       (PRIN1 "(PROGN (PRIN1 %"Use LOADDB to load database files!%
-%" T) (ERROR!))%
-"
-                              )
-                       [AND MSFILETABLE (STORETABLE FL MSFILETABLE (PRINT (CAR (GETPROP FL
-                                                                                      'FILEDATES]
-                       (COND
-                          (MSHASHFILENAME (UPDATECONTAINS FL FFNS T)))
-                                                             (* T flag means that the function 
-
                                                           won't be erased--it might still be 
-
                                                           interesting)

-                       (printout NIL "FNS " .P2 FFNS T)      (* So the database file knows which 
-
                                                           functions are on the file)

-                       (COND
-                          (FNS (DUMPDATABASE FNS))
-                          (T (printout NIL "STOP" T))))
-                   [COND
-                      (PROPFLG (PRINT (FULLNAME DBFILE)
-                                      T))
-                      (T (/PUT FL 'DATABASEFILENAME DBFILE)  (* Remember that we have this file 
-
                                                           valid already.)

-                         (/PUT FL 'DATABASE 'YES]            (* Take future note of the databae 
-
                                                           on a user call)

-                   (RETURN (FULLNAME DBFILE])
+    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG))
+    (CL:WHEN (AND FILE (OR (LITATOM FILE)
+                           (STRINGP FILE)))
+        (PROG (DBFILE
 (FL (NAMEFIELD FILE))
+                     (FNS (FILEFNSLST FILE)))
+              (COND
+                 (FNS)
+                 ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
+                                                             (* ; 
+
                                                           "Always dump if this is a known file")

+                  (SETQ PROPFLG NIL))
+                 (T (COND
+                       (PROPFLG (/REMPROP FL 'DATABASE))
+                       (T (printout T T FILE " has no functions." T)))
+                    (RETURN)))
+              (CL:WHEN [OR (NULL PROPFLG)
+                           (EQ (GETPROP FL 'DATABASE)
+                               'YES)
+                           (EQ SAVEDBFLG 'YES)
+                           (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
+                  (CL:WHEN MSFILETABLE
+                      [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
+                  [SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
+                                                     'BODY FILE)
+                                      `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
+                                                  (ERROR!)))
+                                        (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
+                                           (DUMPDATABASE ',FNS]
+                  [COND
+                     (PROPFLG (PRINT (FULLNAME DBFILE)
+                                     T))
+                     (T (/PUT FL 'DATABASEFILENAME DBFILE)   (* ; 
+
                                                   "Remember that we have this file valid already.")

+                        (/PUT FL 'DATABASE 'YES]             (* ; 
+
                                                   "Take future note of the databae on a user call")

+                  (RETURN DBFILE))))])
 
 (LOADDB

-  [LAMBDA (FILE ASKFLAG)
                                 (* ; "Edited  7-Jul-92 09:57 by rmk:")

+  [LAMBDA (FILE ASKFLAG)
                                (* ; "Edited 24-Oct-2021 17:44 by rmk:")


+                                                             (* ; "Edited  7-Jul-92 09:57 by rmk:")

 
-    (* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls.  Before asking, it looks around first to see whether a database file of the appropriate name really exists.")

+    (* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls.  Before asking, it looks around first to see whether a database file of the appropriate name really exists.")

 
-    (DECLARE
 (GLOBALVARS MSHASHFILENAME MSFILETABLE MSARGTABLE DWIMWAIT LOADDBFLG))
+    (DECLARE
 (GLOBALVARS MSFILETABLE MSARGTABLE DWIMWAIT LOADDBFLG))
     (RESETLST
-        [PROG* [TEM NEWFNS FORFILE (*READTABLE* (FIND-READTABLE "INTERLISP"))
+        [PROG* [TEM FORFILE (*READTABLE* (FIND-READTABLE "INTERLISP"))
                     (*PACKAGE* (CL:FIND-PACKAGE "INTERLISP"))
                     (NF (NAMEFIELD FILE))
                     (DBSTREAM (DBFILE
 FILE ASKFLAG))
@@ -253,8 +232,8 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
                   ([COND
                       [ASKFLAG (COND
                                   ((EQ (GETPROP NF 'DATABASEFILENAME)
-                                       DBFILE)               (* ; 
-
         "If the database for this very file has already been loaded, don't bother doing it again.")

+                                       DBFILE)               (* ; 
+
         "If the database for this very file has already been loaded, don't bother doing it again.")

                                    (PRINTOUT T "Database " DBFILE " already loaded." T)
                                    NIL)
                                   (T (SELECTQ (GETPROP NF 'DATABASE)
@@ -275,42 +254,37 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
                                                        NIL]
                       (T (/PUT NF 'DATABASE 'YES]
                    (LISPXPRINT (FULLNAME DBFILE)
-                          T)                                 (* ; "DBSTREAM was opened in DBFILE")

+                          T)                                 (* ; "DBSTREAM was opened in DBFILE")

                    (RESETSAVE (INPUT DBSTREAM))
                    [COND
                       ((EQ (SETQ TEM (READ))
                            'FNS)
-                       (SETQ NEWFNS (READ))
+                       (READ)                                (* ; "Old format:  thrown away")

                        (COND
                           ((EQ (SETQ TEM (READ))
                                'ARGS)
-                           [COND
-                              [MSHASHFILENAME (BIND
 F WHILE
 (SETQ F (READ))
-                                                 DO
 (STORETABLE F MSARGTABLE (READ]
-                              (T (WHILE
 (READ]
+                           (WHILE
 (READ))
                            (SETQ TEM (READ]
                    (COND
                       ((OR (EQ (CAR (LISTP TEM))
                                'READATABASE)
                            (EQ TEM 'STOP))
                        (COND
-                          ((NEQ TEM 'STOP)                   (* ; "It must be (READATABASE)")

+                          ((NEQ TEM 'STOP)                   (* ; "It must be (READATABASE)")

                            (READATABASE)))
-                       (COND
-                          (MSHASHFILENAME (UPDATECONTAINS NF NEWFNS)))
                        (AND MSFILETABLE (STORETABLE NF MSFILETABLE FORFILE))
-                                                             (* ; 
-
                                                 "This is done whether or not there is a hashfile.")

-                       (UPDATEFILES)                         (* ; 
-
                                                 "Mark any edited fns as needing to be reanalyzed.")

+                                                             (* ; 
+
                                                 "This is done whether or not there is a hashfile.")

+                       (UPDATEFILES)                         (* ; 
+
                                                 "Mark any edited fns as needing to be reanalyzed.")

                        (FOR
 FN IN
 (CDR (GETP NF 'FILE))
                           WHEN
 (OR (EXPRP FN)
                                        (GETP FN 'EXPR)) DO
 (MSMARKCHANGED FN)))
                       (T (PRINTOUT T T DBFILE " is not a database file!" T)
-                                                             (* ; "So that value of LOADDB is NIL")

+                                                             (* ; "So that value of LOADDB is NIL")

                          (SETQ DBFILE NIL)))
-                   (/PUT NF 'DATABASEFILENAME DBFILE)        (* ; 
-
                                                "Remember the name of the database we just loaded.")

+                   (/PUT NF 'DATABASEFILENAME DBFILE)        (* ; 
+
                                                "Remember the name of the database we just loaded.")

                    (RETURN (FULLNAME DBFILE])])
 
 (MAKEDB

@@ -345,14 +319,12 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
 
 (ADDTOVAR MAKEFILEFORMS
 (MAKEDB FILE))
 
-
-
-(* To permit MSHASH interface)

-
-
-(RPAQ? MSHASHFILENAME
 )
-
 (RPAQ? MSFILETABLE
 )
+
+
+
+(* ; "To permit MSHASH interface")

+
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
@@ -367,7 +339,7 @@ Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights res
 )
 (PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1637 6218 (DBFILE 1647 . 3295) (DBFILE1 3297 . 4820) (DBFILE2 4822 . 5584) (LOAD 5586
- . 5816) (LOADFROM 5818 . 6006) (MAKEFILE 6008 . 6216)) (6274 16706 (DUMPDB 6284 . 10572) (LOADDB 
-10574 . 15618) (MAKEDB 15620 . 16704)))))
+  (FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072
+ . 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536
+ . 14411) (MAKEDB 14413 . 15497)))))
 STOP

library/FILEBROWSER

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "19-Sep-2021 18:08:05" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9|
 260675 
 
-      |changes| |to:|  (FNS FB.EDITCOMMAND.ONEFILE)
+
(FILECREATED "23-Nov-2021 12:17:08" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>FILEBROWSER.;21|
 261024 
 
-      |previous| |date:| "21-Aug-2021 23:33:58" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
+      |changes| |to:|  (FNS FB.FIX-DIRECTORY-DATES)
+
+      |previous| |date:| "29-Oct-2021 21:19:42" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>FILEBROWSER.;20|)
 
 
 ; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
@@ -178,8 +179,7 @@ You specify how many versions to keep.")))
                                                              (* \; "Setup")

               (FNS FB.STARTUP FB.MAKERIGIDWINDOW)
               (FNS FB.PRINTFN FB.COPYFN))
-        (COMS                                                (* \; 
-
                                                           "commands and major subfunctions")

+        (COMS                                                (* \; "commands and major subfunctions")

               (FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY 
                    FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON)
               (FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES 
@@ -205,6 +205,7 @@ You specify how many versions to keep.")))
                    FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN 
                    FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
         (COMS                                                (* \; "window functions")

+              (FNS FB.GETWINDOW)
               (FNS FB.INFOMENU.SHADEINITIALSELECTIONS FB.INFO.ITEM.NAMED)
               (FNS FB.MAKECOUNTERWINDOW FB.COUNTERW.REDISPLAYFN FB.UPDATE.COUNTERS 
                    FB.DISPLAY.COUNTERS FB.COUNTER.STRING)
@@ -290,9 +291,9 @@ You specify how many versions to keep.")))
 (RPAQ? FB.DEFAULT.INFO
 '(SIZE CREATIONDATE AUTHOR))
 
 (APPENDTOVAR FONTVARS
 (FB.ICONFONT LITTLEFONT)
-                          (FB.BROWSERFONT DEFAULTFONT)
-                          (FB.PROMPTFONT LITTLEFONT)
-                          (FB.BROWSER.DIRECTORY.FONT BOLDFONT))
+                      (FB.BROWSERFONT DEFAULTFONT)
+                      (FB.PROMPTFONT LITTLEFONT)
+                      (FB.BROWSER.DIRECTORY.FONT BOLDFONT))
 
 
 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

@@ -393,27 +394,25 @@ You specify how many versions to keep.")))
          ))
 
 (RPAQQ FB.VERSION.MENU.ITEMS
 (("1" 1 "Keep only one version of the files")
-                                  ("2" 2 "Keep two versions of the files")
-                                  ("3" 3 "Keep three versions of the files")
-                                  ("4" 4 "Keep four versions of the files")
-                                  ("Other" :NUMBER "Select number of versions to keep")))
+                              ("2" 2 "Keep two versions of the files")
+                              ("3" 3 "Keep three versions of the files")
+                              ("4" 4 "Keep four versions of the files")
+                              ("Other" :NUMBER "Select number of versions to keep")))
 
 (RPAQQ FB.CLOSE.MENU.ITEMS
 (("Expunge deleted files" 'EXPUNGE 
-                                       "Erases all files still marked 'deleted'")
-                                ("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
+                                   "Erases all files still marked 'deleted'")
+                            ("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
 Your deletions are thus ignored.")))
 
 (RPAQQ FB.DEPTH.MENU.ITEMS
 (("Global default" :GLOBAL 
-                                      "Set depth using the global default (FILING.ENUMERATION.DEPTH)"
-                                       )
-                                ("Infinite" T 
-                                     "Set depth to infinity, i.e., enumerate all levels of directory"
-                                       )
-                                ("1" 1 
+                                   "Set depth using the global default (FILING.ENUMERATION.DEPTH)")
+                            ("Infinite" T 
+                                   "Set depth to infinity, i.e., enumerate all levels of directory")
+                            ("1" 1 
                                 "Set depth to 1, i.e., enumerate just the top level of the directory"
-                                     )
-                                ("2" 2 "Set depth to 2")
-                                ("Other" :NUMBER "Set depth to some other finite depth")))
+                                 )
+                            ("2" 2 "Set depth to 2")
+                            ("Other" :NUMBER "Set depth to some other finite depth")))
 
 (RPAQQ FB.INFO.MENU.ITEMS

        ((|Length| LENGTH "Toggles Length display")
@@ -455,20 +454,21 @@ Your deletions are thus ignored.")))
 (DEFINEQ
 
 (FB

-  (NLAMBDA PATTERN                                           (* \; "Edited 26-Feb-88 13:50 by bvm")

+  (NLAMBDA PATTERN
                                     (* \; "Edited 29-Oct-2021 21:18 by rmk:")


+                                                             (* \; "Edited 26-Feb-88 13:50 by bvm")

 
-(* |;;;| "FILEBROWSER entry from top-level exec: FB PATTERN ...  PROPS ...")

+(* |;;;| "FILEBROWSER entry from top-level exec: FB PATTERN ...  PROPS ...")

 
     (DESTRUCTURING-BIND (PAT . PROPS)
            (NLAMBDA.ARGS PATTERN)
            (LET (OPTIONS)
                 (|for|
 TAIL |on|
 PROPS |when|
 (AND (CL:KEYWORDP (CAR TAIL))
                                                                (CDR TAIL))
-                   |do|
                                  (* \; 
-
                                                 "Interpret keyword tail of attributes as OPTIONS.")

+                   |do|
                                  (* \; 
+
                                                 "Interpret keyword tail of attributes as OPTIONS.")

                          (RETURN (SETQ PROPS (LDIFF PROPS (SETQ OPTIONS TAIL)))))
                 (ADD.PROCESS `(,(FUNCTION FILEBROWSER)
-                               ',PAT
+                               ',(OR PAT '*)
                                ',PROPS
                                ',OPTIONS)
                        'NAME
@@ -2058,13 +2058,18 @@ Your deletions are thus ignored.")))
         (FB.UPDATEBROWSERITEMS
 BROWSER)))))
 
 (FB.FIX-DIRECTORY-DATES

-  (LAMBDA (BROWSER)
                                    (* \; "Edited 21-Aug-2021 23:33 by rmk:")

+  (LAMBDA (BROWSER)
                                        (* \; "Edited 23-Nov-2021 12:15 by rmk:")


+                                                           (* \; "Edited 21-Aug-2021 23:33 by rmk:")

+
+    (* |;;| 
+
 "FILEDATE returns the source-file date of a compiled file.  We have to call with CFLG T to be sure.")

+
     (FOR
 F FD CHANGE IN
 (FILDIR (FETCH
 (FILEBROWSER
 PATTERN) OF
 BROWSER))
-       WHEN
 (SETQ FD (FILEDATE F)) UNLESS
 (IEQP (SETQ FD (IDATE FD))
-                                                        (GETFILEINFO F 'ICREATIONDATE))
+       WHEN
 (SETQ FD (OR (FILEDATE F T)
+                         (FILEDATE F))) UNLESS
 (IEQP (SETQ FD (IDATE FD))
+                                                     (GETFILEINFO F 'ICREATIONDATE))
        DO
 (SETQ CHANGE T)
-             (SETFILEINFO F 'ICREATIONDATE FD) FINALLY
 (CL:WHEN CHANGE (FB.UPDATECOMMAND

-                                                                            BROWSER)))))
+          (SETFILEINFO F 'ICREATIONDATE FD) FINALLY
 (CL:WHEN CHANGE (FB.UPDATECOMMAND
 BROWSER)))))
 
 (FB.MAYBE.EXPUNGE

   (LAMBDA (BROWSER COMMAND)
                            (* \; "Edited 22-Feb-2021 12:33 by rmk:")

@@ -2253,21 +2258,15 @@ Do you want to expunge them first?")
               (FB.DISPLAY.COUNTERS
 BROWSER)))))
 
 (FB.DATE

-  (LAMBDA NIL                                                (* \; "Edited 21-Jan-88 18:40 by bvm")

-    (LET ((DT (DATE (DATEFORMAT DAY.OF.WEEK DAY.SHORT NO.SECONDS))))
+  (LAMBDA NIL
                                          (* \; "Edited 16-Oct-2021 14:06 by rmk:")

 
-         (* |;;| 
-
       "DT is in the form \"dd-mon-yy hh:mm (day)\".  Turn it into \"hh:mm day dd-mon-yy\".")

+    (* |;;| "RMK:  Tried to decode and rearrange with Y2K error.  Now just pass it through.  It used to include the short day of week, that seems silly.  It is today's date...or at least the date of the last recompute")

 
-         (CONCAT (SUBSTRING DT 11 16)
-                (SUBSTRING DT 18 20)
-                " "
-                (SUBSTRING DT (|if|
 (EQ (CHCON1 DT)
-                                            (CHARCODE SPACE))
-                                  |then|
                 (* \; "Trim leading space from date")

-                                        2
-                                |else|
 1)
-                       9)))))
+    (* |;;| "(DATEFORMAT NO.LEADING.SPACES NO.SECONDS DAY.OF.WEEK DAY.SHORT)")

+
+    (* |;;| "I think this only goes in the title bar, which is perhaps odd in itself.")

+
+    (DATE (DATEFORMAT NO.LEADING.SPACES NO.SECONDS))))
 
 (FB.ADJUST.DATE.WIDTH

   (LAMBDA (BROWSER INFOWANTED)                               (* \; "Edited 30-Aug-94 19:40 by jds")

@@ -2307,9 +2306,11 @@ Do you want to expunge them first?")
        |finally|
 (RETURN RESULT))))
 
 (FB.SET.BROWSER.TITLE

-  (LAMBDA (BROWSER TIME)                                     (* \; "Edited 21-Jan-88 18:37 by bvm")

+  (LAMBDA (BROWSER TIME)
                               (* \; "Edited 16-Oct-2021 14:10 by rmk:")

 
-    (* |;;| "(Re)display the title on BROWSER's window.  If Time is supplied, it is the time at which the enumeration happened, and we include it in the title.  Title is not changed if user supplied own title.")

+    (* |;;| "(Re)display the title on BROWSER's window.  If Time is supplied, it is the time at which the enumeration happened, and we include it in the title.  Title is not changed if user supplied own title.")

+
+    (* |;;| "RMK: Move the date over a bit, so that path stands out")

 
     (COND
        ((NOT (|fetch|
 (FILEBROWSER
 FIXEDTITLE) |of|
 BROWSER))
@@ -2317,7 +2318,7 @@ Do you want to expunge them first?")
                'TITLE
                (|if|
 TIME
                    |then|
 (CONCAT (|fetch|
 (FILEBROWSER
 PATTERN) |of|
 BROWSER)
-                                     " at " TIME)
+                                     "    at " TIME)
                  |else|
 (CONCAT (|fetch|
 (FILEBROWSER
 PATTERN) |of|
 BROWSER)
                                    " browser")))))))
 
@@ -3294,6 +3295,25 @@ then click Recompute"))))
 
 (DEFINEQ
 
+(FB.GETWINDOW

+  (LAMBDA (WINDOW WHICH)
                               (* \; "Edited 16-Oct-2021 15:02 by rmk:")

+
+    (* |;;| "Closed function to get at filebrowser attached windows by type, without need record declarations at runtime. Helps MODERNIZE get the right regions.")

+
+    (LET* ((FBWINDOW (CENTRALWINDOW WINDOW))
+           (FILEBROWSER
 (WINDOWPROP FBWINDOW 'FILEBROWSER)))
+          (CL:WHEN FILEBROWSER
+              (SELECTQ WHICH
+                  (HEADING (FETCH
 (FILEBROWSER
 HEADINGWINDOW) OF
 FILEBROWSER))
+                  (COUNTER (FETCH
 (FILEBROWSER
 COUNTERWINDOW) OF
 FILEBROWSER))
+                  (BROWSER FBWINDOW)
+                  (PROMPT (FETCH
 (FILEBROWSER
 PROMPTWINDOW) OF
 FILEBROWSER))
+                  (COMMAND (FIND
 W IN
 (WINDOWPROP FBWINDOW 'ATTACHEDWINDOWS)
+                              SUCHTHAT
 (EQ 'MENUBUTTONFN (WINDOWPROP W 'BUTTONEVENTFN))))
+                  NIL)))))
+)
+(DEFINEQ
+
 (FB.INFOMENU.SHADEINITIALSELECTIONS

   (LAMBDA (MENUWINDOW INITIALSELECTIONS)                     (* \; "Edited 21-Jan-88 18:36 by bvm")

     (LET* ((MENU (CAR (WINDOWPROP MENUWINDOW 'MENU)))
@@ -3803,120 +3823,117 @@ then click Recompute"))))
 
 (RECORD INFOFIELD
 (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
 
-(DATATYPE FBFILEDATA
 ((FILENAME POINTER)                 (* \; "Full name of this file")

-                          (FILEINFO POINTER)                 (* \; "Plist of attributes")

-                          (VERSIONLESSNAME POINTER)          (* \; "FILENAME sans version")

-                          (DIRECTORYP FLAG)                  (* \; "True if it's a directory line")

-                          (HASDIRPREFIX FLAG)                (* \; 
-
                         "True if it has a directory prefix beyond that in common to all the files")

-                          (DIRECTORYFILEP FLAG)              (* \; 
-
                                     "True if the \"file\" in this item is actually a subdirectory")

-                          (SIZE POINTER)                     (* \; "Size of file, for stats")

-                          (FILEDEPTH BYTE)                   (* \; 
-
          "Number of levels of subdirectory beneath the main pattern--zero for files at that level")

-                          (SORTVALUE POINTER)                (* \; 
-
                                                    "Cached value by which we are sorting the dir.")

-                          (SUBDIREND WORD)                   (* \; 
-
                             "Index of last char in subdirectory, or zero if HASDIRPREFIX is false")

-                          (STARTOFPNAME WORD)                (* \; 
-
            "Start of name for printing purposes.  Same as STARTOFNAME when browser sorted by name")

-                          (VERSION WORD)                     (* \; "Version, or zero if none")

-                          (STARTOFNAME WORD)                 (* \; 
-
                                                           "Index beyond all directory fields")

-                          DUMMY)
-                         (ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH
 (FBFILEDATA FILENAME
-                                                                                        )
-                                                                         OF
 DATUM)
-                                                                  (FETCH
 (FBFILEDATA STARTOFPNAME
-                                                                                    ) OF
 DATUM)))
-                                                (SUBDIRECTORY (SUBSTRING (FETCH
 (FBFILEDATA
-                                                                                     FILENAME)
-                                                                            OF
 DATUM)
-                                                                     1
-                                                                     (FETCH
 (FBFILEDATA SUBDIREND
-                                                                                       ) OF

-                                                                                         DATUM))))))
+(DATATYPE FBFILEDATA
 ((FILENAME POINTER)                     (* \; "Full name of this file")

+                      (FILEINFO POINTER)                     (* \; "Plist of attributes")

+                      (VERSIONLESSNAME POINTER)              (* \; "FILENAME sans version")

+                      (DIRECTORYP FLAG)                      (* \; "True if it's a directory line")

+                      (HASDIRPREFIX FLAG)                    (* \; 
+
                           "True if it has a directory prefix beyond that in common to all the files")

+                      (DIRECTORYFILEP FLAG)                  (* \; 
+
                                       "True if the \"file\" in this item is actually a subdirectory")

+                      (SIZE POINTER)                         (* \; "Size of file, for stats")

+                      (FILEDEPTH BYTE)                       (* \; 
+
            "Number of levels of subdirectory beneath the main pattern--zero for files at that level")

+                      (SORTVALUE POINTER)                    (* \; 
+
                                                      "Cached value by which we are sorting the dir.")

+                      (SUBDIREND WORD)                       (* \; 
+
                               "Index of last char in subdirectory, or zero if HASDIRPREFIX is false")

+                      (STARTOFPNAME WORD)                    (* \; 
+
              "Start of name for printing purposes.  Same as STARTOFNAME when browser sorted by name")

+                      (VERSION WORD)                         (* \; "Version, or zero if none")

+                      (STARTOFNAME WORD)                     (* \; 
+
                                                             "Index beyond all directory fields")

+                      DUMMY)
+                     (ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH
 (FBFILEDATA FILENAME)
+                                                                     OF
 DATUM)
+                                                              (FETCH
 (FBFILEDATA STARTOFPNAME)
+                                                                 OF
 DATUM)))
+                                            (SUBDIRECTORY (SUBSTRING (FETCH
 (FBFILEDATA FILENAME)
+                                                                        OF
 DATUM)
+                                                                 1
+                                                                 (FETCH
 (FBFILEDATA SUBDIREND)
+                                                                    OF
 DATUM))))))
 
-(DATATYPE FILEBROWSER
 ((NOSUBDIRECTORIES FLAG)           (* \; 
-
               "True if we don't want separate subdirectory lines -- subdirs then included in name")

-                           (NSPATTERN? FLAG)                 (* \; "True if host is an ns host")

-                           (SHOWUNDELETED? FLAG)             (* \; 
-
                        "True if counter window should show `Undeleted' rather than `Total' counts")

-                           (PATTERNPARSED? FLAG)             (* \; 
-
                                     "True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")

-                           (SORTBYDATE FLAG)                 (* \; 
-
                                              "True if SORTATTRIBUTE is one of the date attributes")

-                           (FBREADY FLAG)                    (* \; "False while FB is enumerating.")

-                           (ABORTING FLAG)                   (* \; 
-
                                                           "True if enumeration is being aborted")

-                           (FIXEDTITLE FLAG)                 (* \; "True if caller supplied title")

-                           (FBCOMPUTEDDEPTH BYTE)            (* \; 
-
                                    "Depth at the time we enumerated directory (zero for infinite)")

-                           (FBDISPLAYEDDEPTH BYTE)           (* \; 
-
                                            "Depth we are currently displaying (zero for infinite)")

-                           (TABLEBROWSER POINTER)            (* \; 
-
                                           "Pointer to TABLEBROWSER object controlling the browser")

-                           (BROWSERWINDOW POINTER)           (* \; "Main window")

-                           (COUNTERWINDOW POINTER)           (* \; 
-
                                                       "Window that counts files, pages, deletions")

-                           (HEADINGWINDOW POINTER)           (* \; 
-
                                                         "Window with headings for browser columns")

-                           (INFOMENUW POINTER)               (* \; 
-
                           "Window containing choices for info to be displayed, or NIL if none yet")

-                           (PROMPTWINDOW POINTER)            (* \; "GETPROMPTWINDOW BROWSERWINDOW")

-                           (INFODISPLAYED POINTER)           (* \; 
-
                                                          "List of attribute specs to be displayed")

-                           (PATTERN POINTER)                 (* \; 
-
                                                           "Directory pattern being enumerated")

-                           (PREPAREDPATTERN POINTER)         (* \; "DIRECTORY.MATCH.SETUP of same")

-                           (SEEWINDOW POINTER)               (* \; 
-
                                                          "Primary window used by FAST SEE command")

-                           (BROWSERFONT POINTER)             (* \; "Font of BROWSERWINDOW")

-                           (SORTBY POINTER)                  (* \; 
-
                                                         "Sorting function or NIL for default sort")

-                           (NAMESTART WORD)                  (* \; 
-
                     "Index of first character in file name beyond the common prefix shared by all")

-                           (DIRECTORYSTART WORD)             (* \; 
-
                                              "Index of first character of directory in file names")

-                           (INFOSTART WORD)                  (* \; 
-
                                       "X position in browser where first col of info is displayed")

-                           (NAMEOVERHEAD WORD)               (* \; 
-
                              "This plus width of name gives is how much to allow before INFOSTART")

-                           (OVERFLOWSPACING WORD)            (* \; 
-
                                                 "Increment between sizes considered for INFOSTART")

-                           (DIGITWIDTH WORD)
-                           (TOTALFILES WORD)                 (* \; 
-
                         "Total number of files, deleted files, pages, deleted pages at the moment")

-                           (DELETEDFILES WORD)
-                           (TOTALPAGES POINTER)
-                           (DELETEDPAGES POINTER)
-                           (PAGECOUNT? POINTER)              (* \; 
-
                          "True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")

-                           (COUNTERPOSITIONS POINTER)        (* \; 
-
     "List of pairs (left right) describing regions where the values of the counters are displayed")

-                           (COUNTERPAGESTRING POINTER)       (* \; 
-
                                                           "String to print after file/page count")

-                           (OVERFLOWWIDTHS POINTER)          (* \; 
-
                 "List of (xpos occurrences) describing files whose names exceed default INFOSTART")

-                           (INFOMENUCHOICES POINTER)         (* \; 
-
            "Selections user has made in Info window, not necessarily the info currently displayed")

-                           (UPDATEPROC POINTER)              (* \; 
-
                                                           "Process doing an Update (Recompute)")

-                           (DEFAULTDIR POINTER)              (* \; 
-
                                                 "Default directory for destination of Copy/Rename")

-                           (SORTATTRIBUTE POINTER)           (* \; 
-
                                                     "Attribute being sorted on, or NIL if by name")

-                           (SORTMENU POINTER)
-                           (FBLOCK POINTER)                  (* \; 
-
                                                          "Lock acquired by filebrowser operations")

-                           (SORTINDEX WORD)                  (* \; 
-
                                            "Index (zero-based) in file info of the sort attribute")

-                           (SIZEINDEX WORD)                  (* \; "Index of size attribute")

-                           (FBDEPTH POINTER)                 (* \; 
-
                                                           "Enumeration depth, or NIL for default")

-                           (ABORTWINDOW POINTER)             (* \; 
-
                            "Dotted pair of (abortwindow . menuw) for this browser's abort window.")

-                           DUMMY))
+(DATATYPE FILEBROWSER
 ((NOSUBDIRECTORIES FLAG)               (* \; 
+
                 "True if we don't want separate subdirectory lines -- subdirs then included in name")

+                       (NSPATTERN? FLAG)                     (* \; "True if host is an ns host")

+                       (SHOWUNDELETED? FLAG)                 (* \; 
+
                          "True if counter window should show `Undeleted' rather than `Total' counts")

+                       (PATTERNPARSED? FLAG)                 (* \; 
+
                                       "True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")

+                       (SORTBYDATE FLAG)                     (* \; 
+
                                                "True if SORTATTRIBUTE is one of the date attributes")

+                       (FBREADY FLAG)                        (* \; "False while FB is enumerating.")

+                       (ABORTING FLAG)                       (* \; 
+
                                                             "True if enumeration is being aborted")

+                       (FIXEDTITLE FLAG)                     (* \; "True if caller supplied title")

+                       (FBCOMPUTEDDEPTH BYTE)                (* \; 
+
                                      "Depth at the time we enumerated directory (zero for infinite)")

+                       (FBDISPLAYEDDEPTH BYTE)               (* \; 
+
                                              "Depth we are currently displaying (zero for infinite)")

+                       (TABLEBROWSER POINTER)                (* \; 
+
                                             "Pointer to TABLEBROWSER object controlling the browser")

+                       (BROWSERWINDOW POINTER)               (* \; "Main window")

+                       (COUNTERWINDOW POINTER)               (* \; 
+
                                                         "Window that counts files, pages, deletions")

+                       (HEADINGWINDOW POINTER)               (* \; 
+
                                                           "Window with headings for browser columns")

+                       (INFOMENUW POINTER)                   (* \; 
+
                             "Window containing choices for info to be displayed, or NIL if none yet")

+                       (PROMPTWINDOW POINTER)                (* \; "GETPROMPTWINDOW BROWSERWINDOW")

+                       (INFODISPLAYED POINTER)               (* \; 
+
                                                            "List of attribute specs to be displayed")

+                       (PATTERN POINTER)                     (* \; 
+
                                                             "Directory pattern being enumerated")

+                       (PREPAREDPATTERN POINTER)             (* \; "DIRECTORY.MATCH.SETUP of same")

+                       (SEEWINDOW POINTER)                   (* \; 
+
                                                            "Primary window used by FAST SEE command")

+                       (BROWSERFONT POINTER)                 (* \; "Font of BROWSERWINDOW")

+                       (SORTBY POINTER)                      (* \; 
+
                                                           "Sorting function or NIL for default sort")

+                       (NAMESTART WORD)                      (* \; 
+
                       "Index of first character in file name beyond the common prefix shared by all")

+                       (DIRECTORYSTART WORD)                 (* \; 
+
                                                "Index of first character of directory in file names")

+                       (INFOSTART WORD)                      (* \; 
+
                                         "X position in browser where first col of info is displayed")

+                       (NAMEOVERHEAD WORD)                   (* \; 
+
                                "This plus width of name gives is how much to allow before INFOSTART")

+                       (OVERFLOWSPACING WORD)                (* \; 
+
                                                   "Increment between sizes considered for INFOSTART")

+                       (DIGITWIDTH WORD)
+                       (TOTALFILES WORD)                     (* \; 
+
                           "Total number of files, deleted files, pages, deleted pages at the moment")

+                       (DELETEDFILES WORD)
+                       (TOTALPAGES POINTER)
+                       (DELETEDPAGES POINTER)
+                       (PAGECOUNT? POINTER)                  (* \; 
+
                            "True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")

+                       (COUNTERPOSITIONS POINTER)            (* \; 
+
       "List of pairs (left right) describing regions where the values of the counters are displayed")

+                       (COUNTERPAGESTRING POINTER)           (* \; 
+
                                                             "String to print after file/page count")

+                       (OVERFLOWWIDTHS POINTER)              (* \; 
+
                   "List of (xpos occurrences) describing files whose names exceed default INFOSTART")

+                       (INFOMENUCHOICES POINTER)             (* \; 
+
              "Selections user has made in Info window, not necessarily the info currently displayed")

+                       (UPDATEPROC POINTER)                  (* \; 
+
                                                             "Process doing an Update (Recompute)")

+                       (DEFAULTDIR POINTER)                  (* \; 
+
                                                   "Default directory for destination of Copy/Rename")

+                       (SORTATTRIBUTE POINTER)               (* \; 
+
                                                       "Attribute being sorted on, or NIL if by name")

+                       (SORTMENU POINTER)
+                       (FBLOCK POINTER)                      (* \; 
+
                                                            "Lock acquired by filebrowser operations")

+                       (SORTINDEX WORD)                      (* \; 
+
                                              "Index (zero-based) in file info of the sort attribute")

+                       (SIZEINDEX WORD)                      (* \; "Index of size attribute")

+                       (FBDEPTH POINTER)                     (* \; 
+
                                                             "Enumeration depth, or NIL for default")

+                       (ABORTWINDOW POINTER)                 (* \; 
+
                              "Dotted pair of (abortwindow . menuw) for this browser's abort window.")

+                       DUMMY))
 )
 
 (/DECLAREDATATYPE 'FBFILEDATA
@@ -4004,25 +4021,24 @@ then click Recompute"))))
 (DECLARE\: EVAL@COMPILE 
 
 (PUTPROPS NULL.VERSIONP
 MACRO
 ((V)
-                                       (EQ V 0)))
+                               (EQ V 0)))
 
 (PUTPROPS NULL.DIRECTORYP
 MACRO
 ((FILEDATA)
-                                         (EQ (FETCH
 (FBFILEDATA SUBDIREND) OF
 FILEDATA)
-                                             0)))
+                                 (EQ (FETCH
 (FBFILEDATA SUBDIREND) OF
 FILEDATA)
+                                     0)))
 
 (PUTPROPS EQ.DIRECTORYP
 MACRO
 (OPENLAMBDA (FD1 FD2)
-                                        (STRING-EQUAL (|fetch|
 (FBFILEDATA FILENAME) |of|

-                                                                                         FD1)
-                                               (|fetch|
 (FBFILEDATA FILENAME) |of|
 FD2)
-                                               :END1
-                                               (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD1)
-                                               :END2
-                                               (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD2))))
+                                (STRING-EQUAL (|fetch|
 (FBFILEDATA FILENAME) |of|
 FD1)
+                                       (|fetch|
 (FBFILEDATA FILENAME) |of|
 FD2)
+                                       :END1
+                                       (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD1)
+                                       :END2
+                                       (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD2))))
 
 (PUTPROPS NULL.FIELDP
 MACRO
 (OPENLAMBDA (STR)
-                                      (OR (NULL STR)
-                                          (EQ (NCHARS STR)
-                                              0))))
+                              (OR (NULL STR)
+                                  (EQ (NCHARS STR)
+                                      0))))
 )
 
 (DECLARE\: DOEVAL@COMPILE DONTCOPY
@@ -4115,67 +4131,67 @@ then click Recompute"))))
 (ADDTOVAR SYSTEMRECLST
 
 (DATATYPE FILEBROWSER
 ((NOSUBDIRECTORIES FLAG)
-                           (NSPATTERN? FLAG)
-                           (SHOWUNDELETED? FLAG)
-                           (PATTERNPARSED? FLAG)
-                           (SORTBYDATE FLAG)
-                           (FBREADY FLAG)
-                           (ABORTING FLAG)
-                           (FIXEDTITLE FLAG)
-                           (FBCOMPUTEDDEPTH BYTE)
-                           (FBDISPLAYEDDEPTH BYTE)
-                           (TABLEBROWSER POINTER)
-                           (BROWSERWINDOW POINTER)
-                           (COUNTERWINDOW POINTER)
-                           (HEADINGWINDOW POINTER)
-                           (INFOMENUW POINTER)
-                           (PROMPTWINDOW POINTER)
-                           (INFODISPLAYED POINTER)
-                           (PATTERN POINTER)
-                           (PREPAREDPATTERN POINTER)
-                           (SEEWINDOW POINTER)
-                           (BROWSERFONT POINTER)
-                           (SORTBY POINTER)
-                           (NAMESTART WORD)
-                           (DIRECTORYSTART WORD)
-                           (INFOSTART WORD)
-                           (NAMEOVERHEAD WORD)
-                           (OVERFLOWSPACING WORD)
-                           (DIGITWIDTH WORD)
-                           (TOTALFILES WORD)
-                           (DELETEDFILES WORD)
-                           (TOTALPAGES POINTER)
-                           (DELETEDPAGES POINTER)
-                           (PAGECOUNT? POINTER)
-                           (COUNTERPOSITIONS POINTER)
-                           (COUNTERPAGESTRING POINTER)
-                           (OVERFLOWWIDTHS POINTER)
-                           (INFOMENUCHOICES POINTER)
-                           (UPDATEPROC POINTER)
-                           (DEFAULTDIR POINTER)
-                           (SORTATTRIBUTE POINTER)
-                           (SORTMENU POINTER)
-                           (FBLOCK POINTER)
-                           (SORTINDEX WORD)
-                           (SIZEINDEX WORD)
-                           (FBDEPTH POINTER)
-                           (ABORTWINDOW POINTER)
-                           DUMMY))
+                       (NSPATTERN? FLAG)
+                       (SHOWUNDELETED? FLAG)
+                       (PATTERNPARSED? FLAG)
+                       (SORTBYDATE FLAG)
+                       (FBREADY FLAG)
+                       (ABORTING FLAG)
+                       (FIXEDTITLE FLAG)
+                       (FBCOMPUTEDDEPTH BYTE)
+                       (FBDISPLAYEDDEPTH BYTE)
+                       (TABLEBROWSER POINTER)
+                       (BROWSERWINDOW POINTER)
+                       (COUNTERWINDOW POINTER)
+                       (HEADINGWINDOW POINTER)
+                       (INFOMENUW POINTER)
+                       (PROMPTWINDOW POINTER)
+                       (INFODISPLAYED POINTER)
+                       (PATTERN POINTER)
+                       (PREPAREDPATTERN POINTER)
+                       (SEEWINDOW POINTER)
+                       (BROWSERFONT POINTER)
+                       (SORTBY POINTER)
+                       (NAMESTART WORD)
+                       (DIRECTORYSTART WORD)
+                       (INFOSTART WORD)
+                       (NAMEOVERHEAD WORD)
+                       (OVERFLOWSPACING WORD)
+                       (DIGITWIDTH WORD)
+                       (TOTALFILES WORD)
+                       (DELETEDFILES WORD)
+                       (TOTALPAGES POINTER)
+                       (DELETEDPAGES POINTER)
+                       (PAGECOUNT? POINTER)
+                       (COUNTERPOSITIONS POINTER)
+                       (COUNTERPAGESTRING POINTER)
+                       (OVERFLOWWIDTHS POINTER)
+                       (INFOMENUCHOICES POINTER)
+                       (UPDATEPROC POINTER)
+                       (DEFAULTDIR POINTER)
+                       (SORTATTRIBUTE POINTER)
+                       (SORTMENU POINTER)
+                       (FBLOCK POINTER)
+                       (SORTINDEX WORD)
+                       (SIZEINDEX WORD)
+                       (FBDEPTH POINTER)
+                       (ABORTWINDOW POINTER)
+                       DUMMY))
 
 (DATATYPE FBFILEDATA
 ((FILENAME POINTER)
-                          (FILEINFO POINTER)
-                          (VERSIONLESSNAME POINTER)
-                          (DIRECTORYP FLAG)
-                          (HASDIRPREFIX FLAG)
-                          (DIRECTORYFILEP FLAG)
-                          (SIZE POINTER)
-                          (FILEDEPTH BYTE)
-                          (SORTVALUE POINTER)
-                          (SUBDIREND WORD)
-                          (STARTOFPNAME WORD)
-                          (VERSION WORD)
-                          (STARTOFNAME WORD)
-                          DUMMY))
+                      (FILEINFO POINTER)
+                      (VERSIONLESSNAME POINTER)
+                      (DIRECTORYP FLAG)
+                      (HASDIRPREFIX FLAG)
+                      (DIRECTORYFILEP FLAG)
+                      (SIZE POINTER)
+                      (FILEDEPTH BYTE)
+                      (SORTVALUE POINTER)
+                      (SUBDIREND WORD)
+                      (STARTOFPNAME WORD)
+                      (VERSION WORD)
+                      (STARTOFNAME WORD)
+                      DUMMY))
 )
 (DECLARE\: DONTEVAL@LOAD DOCOPY 
 
@@ -4183,10 +4199,10 @@ then click Recompute"))))
 
 
 (ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS*
 (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
-                                                 (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
+                                             (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
 
 (ADDTOVAR |BackgroundMenuCommands|
 ("FileBrowser" '(FILEBROWSER)
-                                              "Opens a filebrowser window; prompts for pattern"))
+                                          "Opens a filebrowser window; prompts for pattern"))
 
 
 (RPAQQ |BackgroundMenu|
 NIL)
@@ -4202,51 +4218,51 @@ then click Recompute"))))
 (PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
 1991 1993 1994 1999 2000 2001 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (28618 51254 (FB 28628 . 29584) (FB.COPYBINARYCOMMAND 29586 . 29932) (FB.COPYTEXTCOMMAND
- 29934 . 30276) (FILEBROWSER 30278 . 43384) (FB.TABLEBROWSER 43386 . 43603) (FB.SELECTEDFILES 43605 . 
-44242) (FB.FETCHFILENAME 44244 . 44636) (FB.DIRECTORYP 44638 . 44966) (FB.PROMPTWPRINT 44968 . 46014) 
-(FB.PROMPTW.FORMAT 46016 . 46753) (FB.PROMPTFORINPUT 46755 . 49007) (FB.YES-OR-NO-P 49009 . 50043) (
-FB.ALLOW.ABORT 50045 . 50899) (\\FB.HARDCOPY.TOFILE.EXTENSION 50901 . 51252)) (51278 52231 (FB.STARTUP
- 51288 . 51803) (FB.MAKERIGIDWINDOW 51805 . 52229)) (52232 57604 (FB.PRINTFN 52242 . 57395) (FB.COPYFN
- 57397 . 57602)) (57654 63696 (FB.MENU.WHENSELECTEDFN 57664 . 58022) (FB.COMMANDSELECTEDFN 58024 . 
-59563) (FB.SUBITEMP 59565 . 60000) (FB.MAKE.BROWSER.BUSY 60002 . 60740) (FB.FINISH.COMMAND 60742 . 
-62707) (FB.HANDLE.ABORT.BUTTON 62709 . 63694)) (63697 69213 (FB.DELETECOMMAND 63707 . 63988) (
-FB.DELVERCOMMAND 63990 . 67183) (FB.IS.NOT.SUBDIRECTORY.ITEM 67185 . 67366) (FB.DELVER.FILES 67368 . 
-68457) (FB.DELETE.FILE 68459 . 69211)) (69214 70539 (FB.UNDELETECOMMAND 69224 . 69509) (
-FB.UNDELETEALLCOMMAND 69511 . 69790) (FB.UNDELETE.FILE 69792 . 70537)) (70540 94721 (FB.COPYCOMMAND 
-70550 . 70819) (FB.RENAMECOMMAND 70821 . 71096) (FB.COPY/RENAME.COMMAND 71098 . 72021) (
-FB.COPY/RENAME.ONE 72023 . 74345) (FB.COPY/RENAME.MANY 74347 . 80567) (FB.MERGE.DIRECTORIES 80569 . 
-80987) (FB.GREATEST.PREFIX 80989 . 82345) (FB.MAYBE.INSERT.FILE 82347 . 89787) (FB.GET.NEW.FILE.SPEC 
-89789 . 93620) (FB.CANONICAL.DIRECTORY 93622 . 94719)) (94722 102506 (FB.HARDCOPYCOMMAND 94732 . 95862
-) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 112384 (FB.EDITCOMMAND 102517 . 103318) (
-FB.EDITCOMMAND.ONEFILE 103320 . 106600) (FB.EDITLISPFILE 106602 . 107641) (FB.BROWSECOMMAND 107643 . 
-112382)) (112385 124178 (FB.FASTSEECOMMAND 112395 . 115845) (FB.FASTSEE.ONEFILE 115847 . 118876) (
-FB.SEEFULLFN 118878 . 123009) (FB.SEEBUTTONFN 123011 . 124176)) (124179 125925 (FB.LOADCOMMAND 124189
- . 124696) (FB.COMPILECOMMAND 124698 . 125236) (FB.OPERATE.ON.FILES 125238 . 125923)) (125926 173584 (
-FB.UPDATECOMMAND 125936 . 126161) (FB.FIX-DIRECTORY-DATES 126163 . 126770) (FB.MAYBE.EXPUNGE 126772 . 
-127767) (FB.UPDATEBROWSERITEMS 127769 . 140984) (FB.DATE 140986 . 141727) (FB.ADJUST.DATE.WIDTH 141729
- . 144697) (FB.SET.BROWSER.TITLE 144699 . 145556) (FB.MAYBE.WIDEN.NAMES 145558 . 147677) (
-FB.SET.DEFAULT.NAME.WIDTH 147679 . 149043) (FB.CREATE.FILEBUCKET 149045 . 156265) (
-FB.CHECK.NAME.LENGTH 156267 . 158688) (FB.ADD.FILEGROUP 158690 . 160217) (FB.INSERT.DIRECTORY 160219
- . 160457) (FB.MAKE.SUBDIRECTORY.ITEM 160459 . 161868) (FB.ADD.FILE 161870 . 162483) (FB.INSERT.FILE 
-162485 . 165897) (FB.ANALYZE.PATTERN 165899 . 171163) (FB.CANONICALIZE.PATTERN 171165 . 172477) (
-FB.GETALLFILEINFO 172479 . 173582)) (173585 181744 (FB.SORT.VERSIONS 173595 . 176366) (
-FB.DECREASING.VERSION 176368 . 177037) (FB.INCREASING.VERSION 177039 . 177660) (
-FB.NAMES.DECREASING.VERSION 177662 . 178697) (FB.NAMES.INCREASING.VERSION 178699 . 179696) (
-FB.DECREASING.NUMERIC.ATTR 179698 . 180378) (FB.INCREASING.NUMERIC.ATTR 180380 . 181054) (
-FB.ALPHABETIC.ATTR 181056 . 181742)) (181745 191587 (FB.SORTCOMMAND 181755 . 188585) (
-FB.INSERT.SUBDIRECTORIES 188587 . 189384) (FB.GET.SORT.MENU 189386 . 191585)) (191588 207677 (
-FB.EXPUNGECOMMAND 191598 . 194117) (FB.NEWPATTERNCOMMAND 194119 . 194517) (FB.NEWINFOCOMMAND 194519 . 
-197285) (FB.DEPTHCOMMAND 197287 . 199062) (FB.SHAPECOMMAND 199064 . 202406) (FB.REMOVE.FILE 202408 . 
-204229) (FB.COUNT.FILE.CHANGE 204231 . 205676) (FB.SETNEWPATTERN 205678 . 206848) (FB.GET.NEWPATTERN 
-206850 . 207434) (FB.OPTIONSCOMMAND 207436 . 207675)) (207712 208724 (
-FB.INFOMENU.SHADEINITIALSELECTIONS 207722 . 208369) (FB.INFO.ITEM.NAMED 208371 . 208722)) (208725 
-218191 (FB.MAKECOUNTERWINDOW 208735 . 210197) (FB.COUNTERW.REDISPLAYFN 210199 . 210786) (
-FB.UPDATE.COUNTERS 210788 . 212860) (FB.DISPLAY.COUNTERS 212862 . 217922) (FB.COUNTER.STRING 217924 . 
-218189)) (218192 222835 (FB.MAKEHEADINGWINDOW 218202 . 219750) (FB.HEADINGW.REDISPLAYFN 219752 . 
-220018) (FB.HEADINGW.RESHAPEFN 220020 . 220396) (FB.HEADINGW.DISPLAY 220398 . 222833)) (222836 227019 
-(FB.ICONFN 222846 . 223193) (FB.INFOMENU.WHENSELECTEDFN 223195 . 223925) (FB.CLOSEFN 223927 . 225130) 
-(FB.EXPUNGE?.MENU 225132 . 225544) (FB.AFTERCLOSEFN 225546 . 225907) (FB.CLOSE&EXPUNGE 225909 . 227017
-)) (227020 239078 (FB.HARDCOPY.DIRECTORY 227030 . 237387) (FB.HARDCOPY.PRINT.TITLE 237389 . 237715) (
-FB.HARDCOPY.MAXWIDTH 237717 . 239076)))))
+  (FILEMAP (NIL (28447 51200 (FB 28457 . 29530) (FB.COPYBINARYCOMMAND 29532 . 29878) (FB.COPYTEXTCOMMAND
+ 29880 . 30222) (FILEBROWSER 30224 . 43330) (FB.TABLEBROWSER 43332 . 43549) (FB.SELECTEDFILES 43551 . 
+44188) (FB.FETCHFILENAME 44190 . 44582) (FB.DIRECTORYP 44584 . 44912) (FB.PROMPTWPRINT 44914 . 45960) 
+(FB.PROMPTW.FORMAT 45962 . 46699) (FB.PROMPTFORINPUT 46701 . 48953) (FB.YES-OR-NO-P 48955 . 49989) (
+FB.ALLOW.ABORT 49991 . 50845) (\\FB.HARDCOPY.TOFILE.EXTENSION 50847 . 51198)) (51224 52177 (FB.STARTUP
+ 51234 . 51749) (FB.MAKERIGIDWINDOW 51751 . 52175)) (52178 57550 (FB.PRINTFN 52188 . 57341) (FB.COPYFN
+ 57343 . 57548)) (57600 63642 (FB.MENU.WHENSELECTEDFN 57610 . 57968) (FB.COMMANDSELECTEDFN 57970 . 
+59509) (FB.SUBITEMP 59511 . 59946) (FB.MAKE.BROWSER.BUSY 59948 . 60686) (FB.FINISH.COMMAND 60688 . 
+62653) (FB.HANDLE.ABORT.BUTTON 62655 . 63640)) (63643 69159 (FB.DELETECOMMAND 63653 . 63934) (
+FB.DELVERCOMMAND 63936 . 67129) (FB.IS.NOT.SUBDIRECTORY.ITEM 67131 . 67312) (FB.DELVER.FILES 67314 . 
+68403) (FB.DELETE.FILE 68405 . 69157)) (69160 70485 (FB.UNDELETECOMMAND 69170 . 69455) (
+FB.UNDELETEALLCOMMAND 69457 . 69736) (FB.UNDELETE.FILE 69738 . 70483)) (70486 94667 (FB.COPYCOMMAND 
+70496 . 70765) (FB.RENAMECOMMAND 70767 . 71042) (FB.COPY/RENAME.COMMAND 71044 . 71967) (
+FB.COPY/RENAME.ONE 71969 . 74291) (FB.COPY/RENAME.MANY 74293 . 80513) (FB.MERGE.DIRECTORIES 80515 . 
+80933) (FB.GREATEST.PREFIX 80935 . 82291) (FB.MAYBE.INSERT.FILE 82293 . 89733) (FB.GET.NEW.FILE.SPEC 
+89735 . 93566) (FB.CANONICAL.DIRECTORY 93568 . 94665)) (94668 102452 (FB.HARDCOPYCOMMAND 94678 . 95808
+) (FB.HARDCOPY.TOFILE 95810 . 102450)) (102453 112330 (FB.EDITCOMMAND 102463 . 103264) (
+FB.EDITCOMMAND.ONEFILE 103266 . 106546) (FB.EDITLISPFILE 106548 . 107587) (FB.BROWSECOMMAND 107589 . 
+112328)) (112331 124124 (FB.FASTSEECOMMAND 112341 . 115791) (FB.FASTSEE.ONEFILE 115793 . 118822) (
+FB.SEEFULLFN 118824 . 122955) (FB.SEEBUTTONFN 122957 . 124122)) (124125 125871 (FB.LOADCOMMAND 124135
+ . 124642) (FB.COMPILECOMMAND 124644 . 125182) (FB.OPERATE.ON.FILES 125184 . 125869)) (125872 173645 (
+FB.UPDATECOMMAND 125882 . 126107) (FB.FIX-DIRECTORY-DATES 126109 . 126918) (FB.MAYBE.EXPUNGE 126920 . 
+127915) (FB.UPDATEBROWSERITEMS 127917 . 141132) (FB.DATE 141134 . 141709) (FB.ADJUST.DATE.WIDTH 141711
+ . 144679) (FB.SET.BROWSER.TITLE 144681 . 145617) (FB.MAYBE.WIDEN.NAMES 145619 . 147738) (
+FB.SET.DEFAULT.NAME.WIDTH 147740 . 149104) (FB.CREATE.FILEBUCKET 149106 . 156326) (
+FB.CHECK.NAME.LENGTH 156328 . 158749) (FB.ADD.FILEGROUP 158751 . 160278) (FB.INSERT.DIRECTORY 160280
+ . 160518) (FB.MAKE.SUBDIRECTORY.ITEM 160520 . 161929) (FB.ADD.FILE 161931 . 162544) (FB.INSERT.FILE 
+162546 . 165958) (FB.ANALYZE.PATTERN 165960 . 171224) (FB.CANONICALIZE.PATTERN 171226 . 172538) (
+FB.GETALLFILEINFO 172540 . 173643)) (173646 181805 (FB.SORT.VERSIONS 173656 . 176427) (
+FB.DECREASING.VERSION 176429 . 177098) (FB.INCREASING.VERSION 177100 . 177721) (
+FB.NAMES.DECREASING.VERSION 177723 . 178758) (FB.NAMES.INCREASING.VERSION 178760 . 179757) (
+FB.DECREASING.NUMERIC.ATTR 179759 . 180439) (FB.INCREASING.NUMERIC.ATTR 180441 . 181115) (
+FB.ALPHABETIC.ATTR 181117 . 181803)) (181806 191648 (FB.SORTCOMMAND 181816 . 188646) (
+FB.INSERT.SUBDIRECTORIES 188648 . 189445) (FB.GET.SORT.MENU 189447 . 191646)) (191649 207738 (
+FB.EXPUNGECOMMAND 191659 . 194178) (FB.NEWPATTERNCOMMAND 194180 . 194578) (FB.NEWINFOCOMMAND 194580 . 
+197346) (FB.DEPTHCOMMAND 197348 . 199123) (FB.SHAPECOMMAND 199125 . 202467) (FB.REMOVE.FILE 202469 . 
+204290) (FB.COUNT.FILE.CHANGE 204292 . 205737) (FB.SETNEWPATTERN 205739 . 206909) (FB.GET.NEWPATTERN 
+206911 . 207495) (FB.OPTIONSCOMMAND 207497 . 207736)) (207773 208760 (FB.GETWINDOW 207783 . 208758)) (
+208761 209773 (FB.INFOMENU.SHADEINITIALSELECTIONS 208771 . 209418) (FB.INFO.ITEM.NAMED 209420 . 209771
+)) (209774 219240 (FB.MAKECOUNTERWINDOW 209784 . 211246) (FB.COUNTERW.REDISPLAYFN 211248 . 211835) (
+FB.UPDATE.COUNTERS 211837 . 213909) (FB.DISPLAY.COUNTERS 213911 . 218971) (FB.COUNTER.STRING 218973 . 
+219238)) (219241 223884 (FB.MAKEHEADINGWINDOW 219251 . 220799) (FB.HEADINGW.REDISPLAYFN 220801 . 
+221067) (FB.HEADINGW.RESHAPEFN 221069 . 221445) (FB.HEADINGW.DISPLAY 221447 . 223882)) (223885 228068 
+(FB.ICONFN 223895 . 224242) (FB.INFOMENU.WHENSELECTEDFN 224244 . 224974) (FB.CLOSEFN 224976 . 226179) 
+(FB.EXPUNGE?.MENU 226181 . 226593) (FB.AFTERCLOSEFN 226595 . 226956) (FB.CLOSE&EXPUNGE 226958 . 228066
+)) (228069 240127 (FB.HARDCOPY.DIRECTORY 228079 . 238436) (FB.HARDCOPY.PRINT.TITLE 238438 . 238764) (
+FB.HARDCOPY.MAXWIDTH 238766 . 240125)))))
 STOP

library/LLCOLOR

@@ -1,15 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "10-Jul-92 14:57:14" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>LLCOLOR.;6|
 137483 
 
-      changes to%:  (VARS LLCOLORCOMS)
-                    (MACROS .DRAW4BPPLINEX. .DRAW8BPPLINEX .DRAW24BPPLINEX .DRAW4BPPLINEY. 
-                           .DRAW8BPPLINEY .DRAW24BPPLINEY)
+
(FILECREATED "26-Oct-2021 10:53:47" {DSK}<home>larry>medley>library>LLCOLOR.;2
 137753 
 
-      previous date%: "21-Aug-91 12:27:17" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>LLCOLOR.;5|)
+      changes to%:  (FNS \COLORDISPLAYBITS \DRAW8BPPCOLORLINE)
+
+      previous date%: "10-Jul-92 14:57:14" {DSK}<home>larry>medley>library>LLCOLOR.;1)
 
 
 (* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
+Copyright (c) 1982-1992 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT LLCOLORCOMS)
@@ -51,7 +50,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
         (FNS PSEUDOCOLOR \PSEUDOCOLOR.BITMAP \PSEUDOCOLOR.UFN)
         (GLOBALVARS \COLORDISPLAYFDEV \COLORDISPLAYBITS ColorScreenBitMap \4COLORMAP \8COLORMAP)
         (P 
-           (* ;; "NOTE: This is very bad.  I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file.  The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way.  If I don't undo this kludge by someone else, then color menus come out wrong.  *")

+           (* ;; "NOTE: This is very bad.  I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file.  The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way.  If I don't undo this kludge by someone else, then color menus come out wrong.  *")

 
            (SETFONTDESCRIPTOR 'HELVETICA 10 'MRR 0 'DISPLAY NIL)
            (SETQ MENUFONT (FONTCREATE 'HELVETICA 10)))
@@ -290,7 +289,10 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
     ColorScreenBitMap])
 
 (\COLORDISPLAYBITS

-  [LAMBDA (WIDTH HEIGHT BITSPERPIXEL)
                  (* ; "Edited 31-Oct-89 10:25 by takeshi")

+  [LAMBDA (WIDTH HEIGHT BITSPERPIXEL)                        (* ; 
+
                                                           "Edited 26-Oct-2021 10:24 by larry")

+                                                             (* ; 
+
                                                           "Edited 31-Oct-89 10:25 by takeshi")

                                                              (* returns a pointer to the bits 
 
                                                           that the color board needs.)

     (DECLARE
 (GLOBALVARS \COLORDISPLAYBITS))
@@ -300,8 +302,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
              (OR (\MAIKO.CGSIXP)
                  (\MAIKO.CGTHREEP)
                  (\MAIKO.CGFOURP)))
-        (PROG [(DUMMY (\ALLOCPAGEBLOCK 1))
-               (ADDROFFSET ((OPCODES SUBRCALL 139 0]
+        (PROG ((DUMMY (\ALLOCPAGEBLOCK 1))
+               (ADDROFFSET (SUBRCALL COLOR-BASE)))
               (WHILE
 (NEQ (LOGAND \MAIKO.COLORBUF.ALIGN (IPLUS (\LOLOC DUMMY)
                                                                    ADDROFFSET))
                               0) DO
 (SETQ DUMMY (\ALLOCPAGEBLOCK 1)))
@@ -663,10 +665,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                 (.DRAW4BPPLINEY. MODE])
 
 (\DRAW8BPPCOLORLINE

-  [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)

-                                                           (* ; "Edited 19-Mar-91 12:46 by matsuda")

-    ((OPCODES SUBRCALL 143 12)
-     X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR])
+  [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)
+                                                             (* ; 
+
                                                           "Edited 26-Oct-2021 10:25 by larry")

+                                                             (* ; 
+
                                                           "Edited 19-Mar-91 12:46 by matsuda")

+    (SUBRCALL COLOR-8BPPDRAWLINE X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR
+           ])
 
 (\DRAW24BPPCOLORLINE

   [LAMBDA (X0 Y0 XLIMIT YLIMIT DX DY CDL YINC MODE BITMAPBASE RASTERWIDTH COLOR)

@@ -705,7 +710,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
           [(MODE)
            (PROG (INSIDEBITS OUTSIDEBITS)
                  (until
 (IGREATERP X0 XLIMIT)
-                    do
                                   (* main loop)

+                    do
                                   (* main loop)

                           (SETQ INSIDEBITS (LOGAND MASK (fetch
 (BITMAPWORD BITS) of
 MAPPTR)))
                           (SETQ OUTSIDEBITS (LOGAND (LOGNOT MASK)
                                                    (fetch
 (BITMAPWORD BITS) of
 MAPPTR)))
@@ -717,9 +722,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                          OUTSIDEBITS))
                                           (PAINT (LOGOR (LOGOR COLORMASK INSIDEBITS)
                                                         OUTSIDEBITS))
-                                          (PROGN             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                          (PROGN             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                  (LOGOR COLORMASK OUTSIDEBITS]
                           [COND
                              ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
@@ -732,7 +737,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                         YINC]
                           [COND
                              [(ZEROP (SETQ MASK (LRSH MASK 4)))
-                                                             (* crossed word boundary)

+                                                             (* crossed word boundary)

                               [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET (ADD1 WORDOFFSET]
                               (SETQ COLORMASK COLORMASKORG)
                               (SETQ MASK (CONSTANT (\4BITMASK 0]
@@ -744,7 +749,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                               (COND
                                                  ((EQ STARTBYTE 1)
                                                   (GO 1LP)))
-                                          0LP                (* main loop)

+                                          0LP                (* main loop)

                                               (\PUTBASEBYTE MAPPTR 0
                                                      (SELECTQ MODE
                                                          (ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0)
@@ -753,9 +758,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                       )))
                                                          (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0)))
                                                          (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                 COLOR)))
                                               [COND
                                                  ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
@@ -779,9 +784,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                       )))
                                                          (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1)))
                                                          (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                 COLOR)))
                                               [COND
                                                  ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
@@ -802,7 +807,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                               (GO 0LP))))
 
 (PUTPROPS .DRAW24BPPLINEX
 MACRO
 ((MODE)
-                                         (PROG NIL           (* main loop)

+                                         (PROG NIL           (* main loop)

                                            LP  (\PUTBASE24
 MAPPTR 0
                                                       (SELECTQ MODE
                                                           (ERASE (LOGAND COLOR (\GETBASE24
 MAPPTR
@@ -812,9 +817,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                           (PAINT (LOGOR COLOR (\GETBASE24
 MAPPTR
                                                                                      0)))
                                                           (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                  COLOR)))
                                                [COND
                                                   ([NOT (IGREATERP DX (SETQ CDL (IPLUS CDL DY]
@@ -838,7 +843,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
           [(MODE)
            (PROG (INSIDEBITS OUTSIDEBITS)
                  (until
 (IGREATERP Y0 YLIMIT)
-                    do
                                   (* main loop)

+                    do
                                   (* main loop)

                           (SETQ INSIDEBITS (LOGAND MASK (fetch
 (BITMAPWORD BITS) of
 MAPPTR)))
                           (SETQ OUTSIDEBITS (LOGAND (LOGNOT MASK)
                                                    (fetch
 (BITMAPWORD BITS) of
 MAPPTR)))
@@ -850,9 +855,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                          OUTSIDEBITS))
                                           (PAINT (LOGOR (LOGOR COLORMASK INSIDEBITS)
                                                         OUTSIDEBITS))
-                                          (PROGN             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                          (PROGN             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                  (LOGOR COLORMASK OUTSIDEBITS]
                           [COND
                              ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
@@ -863,7 +868,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                               (SETQ CDL (IDIFFERENCE CDL DY))
                               (COND
                                  [(ZEROP (SETQ MASK (LRSH MASK 4)))
-                                                             (* crossed word boundary)

+                                                             (* crossed word boundary)

                                   [SETQ MAPPTR (\ADDBASE BITMAPBASE (SETQ WORDOFFSET (ADD1 WORDOFFSET
                                                                                            ]
                                   (SETQ COLORMASK COLORMASKORG)
@@ -877,7 +882,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                               (COND
                                                  ((EQ STARTBYTE 1)
                                                   (GO 1LP)))
-                                          0LP                (* main loop)

+                                          0LP                (* main loop)

                                               (\PUTBASEBYTE MAPPTR 0
                                                      (SELECTQ MODE
                                                          (ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0)
@@ -886,9 +891,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                       )))
                                                          (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0)))
                                                          (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                 COLOR)))
                                               (COND
                                                  ((IGREATERP (SETQ Y0 (ADD1 Y0))
@@ -899,8 +904,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                         YINC]
                                               (COND
                                                  ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
-                                                             (* moved enough in Y to move a point 
-
                                                           in X)

+                                                             (* moved enough in Y to move a point 
+
                                                           in X)

                                                   (COND
                                                      ((IGREATERP (SETQ X0 (ADD1 X0))
                                                              XLIMIT)
@@ -916,9 +921,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                       )))
                                                          (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1)))
                                                          (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                 COLOR)))
                                               (COND
                                                  ((IGREATERP (SETQ Y0 (ADD1 Y0))
@@ -929,8 +934,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                         YINC]
                                               (COND
                                                  ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
-                                                             (* moved enough in Y to move a point 
-
                                                           in X)

+                                                             (* moved enough in Y to move a point 
+
                                                           in X)

                                                   (COND
                                                      ((IGREATERP (SETQ X0 (ADD1 X0))
                                                              XLIMIT)
@@ -947,7 +952,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                (COND
                                                   ((EQ STARTBYTE 1)
                                                    (GO 1LP)))
-                                           0LP               (* main loop)

+                                           0LP               (* main loop)

                                                (\PUTBASEBYTE MAPPTR 0
                                                       (SELECTQ MODE
                                                           (ERASE (LOGAND COLOR (\GETBASEBYTE MAPPTR 0
@@ -957,9 +962,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                           (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 0)
                                                                         ))
                                                           (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                  COLOR)))
                                                (COND
                                                   ((IGREATERP (SETQ Y0 (ADD1 Y0))
@@ -970,8 +975,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                          YINC]
                                                (COND
                                                   ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
-                                                             (* moved enough in Y to move a point 
-
                                                           in X)

+                                                             (* moved enough in Y to move a point 
+
                                                           in X)

                                                    (COND
                                                       ((IGREATERP (SETQ X0 (ADD1 X0))
                                                               XLIMIT)
@@ -988,9 +993,9 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                           (PAINT (LOGOR COLOR (\GETBASEBYTE MAPPTR 1)
                                                                         ))
                                                           (PROGN 
-                                                             (* case is REPLACE.
-
                                                           Legality of OPERATION has been 
-
                                                           checked by \CLIPANDDRAWLINE1)

+                                                             (* case is REPLACE.
+
                                                           Legality of OPERATION has been 
+
                                                           checked by \CLIPANDDRAWLINE1)

                                                                  COLOR)))
                                                (COND
                                                   ((IGREATERP (SETQ Y0 (ADD1 Y0))
@@ -1001,8 +1006,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
                                                                                          YINC]
                                                (COND
                                                   ([NOT (IGREATERP DY (SETQ CDL (IPLUS CDL DX]
-                                                             (* moved enough in Y to move a point 
-
                                                           in X)

+                                                             (* moved enough in Y to move a point 
+
                                                           in X)

                                                    (COND
                                                       ((IGREATERP (SETQ X0 (ADD1 X0))
                                                               XLIMIT)
@@ -2211,7 +2216,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
 )
 
 
-(* ;; "NOTE: This is very bad.  I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file.  The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way.  If I don't undo this kludge by someone else, then color menus come out wrong.  *")

+(* ;; "NOTE: This is very bad.  I shouldn't have to and don't really want to do the following, but since about March 86, someone did something really nonstandard wrt Helvetica fonts so that the in core versions are not equal to what is stored on file.  The SETFONTDESCRIPTOR and friends undoes this kludge which has never been explained to LISPCORE^ by the person who brain damaged Helvetica this way.  If I don't undo this kludge by someone else, then color menus come out wrong.  *")

 
 
 (SETFONTDESCRIPTOR 'HELVETICA 10 'MRR 0 'DISPLAY NIL)
@@ -2228,22 +2233,22 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992 b
 (PUTPROPS LLCOLOR COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 
 1992))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3539 21062 (COLORDISPLAY 3549 . 6952) (COLORMAPBITS 6954 . 7111) (
-\CreateColorScreenBitMap 7113 . 8484) (\CREATECOLORDISPLAYFDEV 8486 . 9444) (COLORMAP 9446 . 10860) (
-COLORMAPCOPY 10862 . 11382) (SCREENCOLORMAP 11384 . 11578) (SCREENCOLORMAPENTRY 11580 . 11807) (
-ROTATECOLORMAP 11809 . 12701) (RGBCOLORMAP 12703 . 14841) (CMYCOLORMAP 14843 . 15333) (GRAYCOLORMAP 
-15335 . 16293) (COLORSCREENBITMAP 16295 . 16533) (\COLORDISPLAYBITS 16535 . 19180) (COLORSCREEN 19182
- . 19310) (SHOWCOLORTESTPATTERN 19312 . 21060)) (21101 21732 (\STARTCOLOR 21111 . 21249) (\STOPCOLOR 
-21251 . 21387) (\SENDCOLORMAPENTRY 21389 . 21730)) (21733 27692 (COLORMAPCREATE 21743 . 22729) (
-COLORLEVEL 22731 . 23712) (COLORNUMBERP 23714 . 25298) (COLORFROMRGB 25300 . 26482) (
-INTENSITIESFROMCOLORMAP 26484 . 26869) (SETCOLORINTENSITY 26871 . 27690)) (27693 33530 (\FAST8BIT 
-27703 . 31402) (\MAP4 31404 . 32283) (\MAP8 32285 . 33528)) (33531 34438 (\GETCOLORBRUSH 33541 . 34436
-)) (34439 38686 (\DRAWCOLORLINE1 34449 . 35191) (\DRAW4BPPCOLORLINE 35193 . 36838) (\DRAW8BPPCOLORLINE
- 36840 . 37160) (\DRAW24BPPCOLORLINE 37162 . 38684)) (62183 120797 (\BWTOCOLORBLT 62193 . 70344) (
-\4BITLINEBLT 70346 . 104918) (\8BITLINEBLT 104920 . 113861) (\24BITLINEBLT 113863 . 114646) (
-\GETBASE24 114648 . 116106) (\PUTBASE24 116108 . 117716) (COLORTEXTUREFROMCOLOR# 117718 . 120341) (
-\BITMAPWORD 120343 . 120795)) (120798 126101 (COLORIZEBITMAP 120808 . 121783) (UNCOLORIZEBITMAP 121785
- . 126099)) (126189 129506 (COLORMENU 126199 . 129118) (CURSORCOLOR 129120 . 129504)) (132029 136501 (
-PSEUDOCOLOR 132039 . 134952) (\PSEUDOCOLOR.BITMAP 134954 . 135183) (\PSEUDOCOLOR.UFN 135185 . 136499))
+  (FILEMAP (NIL (3332 21090 (COLORDISPLAY 3342 . 6745) (COLORMAPBITS 6747 . 6904) (
+\CreateColorScreenBitMap 6906 . 8277) (\CREATECOLORDISPLAYFDEV 8279 . 9237) (COLORMAP 9239 . 10653) (
+COLORMAPCOPY 10655 . 11175) (SCREENCOLORMAP 11177 . 11371) (SCREENCOLORMAPENTRY 11373 . 11600) (
+ROTATECOLORMAP 11602 . 12494) (RGBCOLORMAP 12496 . 14634) (CMYCOLORMAP 14636 . 15126) (GRAYCOLORMAP 
+15128 . 16086) (COLORSCREENBITMAP 16088 . 16326) (\COLORDISPLAYBITS 16328 . 19208) (COLORSCREEN 19210
+ . 19338) (SHOWCOLORTESTPATTERN 19340 . 21088)) (21129 21760 (\STARTCOLOR 21139 . 21277) (\STOPCOLOR 
+21279 . 21415) (\SENDCOLORMAPENTRY 21417 . 21758)) (21761 27720 (COLORMAPCREATE 21771 . 22757) (
+COLORLEVEL 22759 . 23740) (COLORNUMBERP 23742 . 25326) (COLORFROMRGB 25328 . 26510) (
+INTENSITIESFROMCOLORMAP 26512 . 26897) (SETCOLORINTENSITY 26899 . 27718)) (27721 33558 (\FAST8BIT 
+27731 . 31430) (\MAP4 31432 . 32311) (\MAP8 32313 . 33556)) (33559 34466 (\GETCOLORBRUSH 33569 . 34464
+)) (34467 38956 (\DRAWCOLORLINE1 34477 . 35219) (\DRAW4BPPCOLORLINE 35221 . 36866) (\DRAW8BPPCOLORLINE
+ 36868 . 37430) (\DRAW24BPPCOLORLINE 37432 . 38954)) (62453 121067 (\BWTOCOLORBLT 62463 . 70614) (
+\4BITLINEBLT 70616 . 105188) (\8BITLINEBLT 105190 . 114131) (\24BITLINEBLT 114133 . 114916) (
+\GETBASE24 114918 . 116376) (\PUTBASE24 116378 . 117986) (COLORTEXTUREFROMCOLOR# 117988 . 120611) (
+\BITMAPWORD 120613 . 121065)) (121068 126371 (COLORIZEBITMAP 121078 . 122053) (UNCOLORIZEBITMAP 122055
+ . 126369)) (126459 129776 (COLORMENU 126469 . 129388) (CURSORCOLOR 129390 . 129774)) (132299 136771 (
+PSEUDOCOLOR 132309 . 135222) (\PSEUDOCOLOR.BITMAP 135224 . 135453) (\PSEUDOCOLOR.UFN 135455 . 136769))
 )))
 STOP

library/MAIKOCOLOR

@@ -1,14 +1,20 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "23-Oct-91 14:43:35" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MAIKOCOLOR.;6|
 57582  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "26-Oct-2021 10:53:57" {DSK}<home>larry>medley>library>MAIKOCOLOR.;2
 60141  
 
       changes to%:  (VARS MAIKOCOLORCOMS)
-                    (FNS \MAIKOCOLOR.EVENTFN)
+                    (MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP)
+                    (FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN 
+                         \MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN 
+                         WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR 
+                         \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR
+                         \MAIKO.BLTCHAR)
 
-      previous date%: "22-Aug-91 17:11:25" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MAIKOCOLOR.;3|)
+      previous date%: "23-Oct-91 14:43:35" {DSK}<home>larry>medley>library>MAIKOCOLOR.;1)
 
 
 (* ; "
-Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserved.
+Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
 ")
 
 (PRETTYCOMPRINT MAIKOCOLORCOMS)
@@ -63,8 +69,9 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 
 (\MAIKO.COLORINIT

   [LAMBDA NIL
-    (DECLARE
 (GLOBALVARS \MAIKOCOLORWSOPS \MAIKOCOLORINFO))

-                                                       (* ; "Edited 28-Apr-89 16:51 by tshimizu.fx")

+    (DECLARE
 (GLOBALVARS \MAIKOCOLORWSOPS \MAIKOCOLORINFO))
+                                                             (* ; 
+
                                                           "Edited 28-Apr-89 16:51 by tshimizu.fx")

     (SETQ \MAIKOCOLORWSOPS (create
 WSOPS
                                   STARTBOARD _ (FUNCTION NILL)
                                   STARTCOLOR _ (FUNCTION \MAIKO.STARTCOLOR)
@@ -82,7 +89,10 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
     (\DEFINEDISPLAYINFO \MAIKOCOLORINFO])
 
 (\MAIKO.STARTCOLOR

-  [LAMBDA (FDEV)
                                       (* ; "Edited  2-Nov-88 11:13 by shimizu")

+  [LAMBDA (FDEV)                                             (* ; 
+
                                                           "Edited 26-Oct-2021 10:17 by larry")

+                                                             (* ; 
+
                                                           "Edited  2-Nov-88 11:13 by shimizu")

     (PROG (DISPLAYSTATE)
           (SETQ DISPLAYSTATE (fetch
 (FDEV DEVICEINFO) of
 FDEV))
           (replace
 (DISPLAYSTATE ONOFF) of
 DISPLAYSTATE with
 'STARTCOLOR)
@@ -90,19 +100,19 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 
      (* ;; " MMAP colorbuffer")

 
-          ((OPCODES SUBRCALL 136 1)
-           (FETCH
 (BITMAP BITMAPBASE) OF
 ColorScreenBitMap))
+          (SUBRCALL COLOR-INIT (FETCH
 (BITMAP BITMAPBASE) OF
 ColorScreenBitMap))
           (replace
 (DISPLAYSTATE ONOFF) of
 DISPLAYSTATE with
 'ON])
 
 (\MAIKO.STOPCOLOR

-  [LAMBDA (FDEV)
                                   (* ; "Edited 28-Apr-89 16:51 by tshimizu.fx")

+  [LAMBDA (FDEV)                                             (* ; 
+
                                                           "Edited 28-Apr-89 16:51 by tshimizu.fx")

                                                              (* ; "By Take")

     (PROG (DISPLAYSTATE)
           (SETQ DISPLAYSTATE (fetch
 (FDEV DEVICEINFO) of
 FDEV))
           (replace
 (DISPLAYSTATE ONOFF) of
 DISPLAYSTATE with
 'OFF])
 
 (\MAIKOCOLOR.EVENTFN

-  [LAMBDA (FDEV EVENT)
                                   (* ; "Edited 23-Oct-91 14:18 by jds")

+  [LAMBDA (FDEV EVENT)                                       (* ; "Edited 23-Oct-91 14:18 by jds")

     (COND
        ((EQ (fetch
 (DISPLAYSTATE ONOFF) of
 (fetch
 (FDEV DEVICEINFO) of
 FDEV))
             'ON)
@@ -117,22 +127,26 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
             NIL])
 
 (\MAIKO.SENDCOLORMAPENTRY

-  [LAMBDA (FDEV COLOR# RGB)
                            (* ; "Edited  1-Dec-88 18:16 by shimizu")

-    ((OPCODES SUBRCALL 138 4)
-     COLOR#
-     (CAR RGB)
-     (CADR RGB)
-     (CADDR RGB])
+  [LAMBDA (FDEV COLOR# RGB)                                  (* ; 
+
                                                           "Edited 26-Oct-2021 10:17 by larry")

+                                                             (* ; 
+
                                                           "Edited  1-Dec-88 18:16 by shimizu")

+    (SUBRCALL COLOR-MAP COLOR# (CAR RGB)
+           (CADR RGB)
+           (CADDR RGB])
 
 (\MAIKO.CHANGESCREEN

-  [LAMBDA (TOSCREEN)
                                   (* ; "Edited  1-Dec-88 18:32 by shimizu")

-    ((OPCODES SUBRCALL 137 1)
-     TOSCREEN])
+  [LAMBDA (TOSCREEN)                                         (* ; 
+
                                                           "Edited 26-Oct-2021 10:18 by larry")

+                                                             (* ; 
+
                                                           "Edited  1-Dec-88 18:32 by shimizu")

+    (SUBRCALL COLOR-SCREENMODE TOSCREEN])
 )
 (DEFINEQ
 
 (CURSOREXIT

-  [LAMBDA NIL
                                          (* ; "Edited 11-Aug-89 13:16 by takeshi")

+  [LAMBDA NIL                                                (* ; 
+
                                                           "Edited 11-Aug-89 13:16 by takeshi")

 
          (* * called when cursor moves off the screen edge)

 
@@ -160,7 +174,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
           (CURSORSCREEN
 SCREEN2 XCOORD2 YCOORD2])
 
 (CURSORSCREEN

-  [LAMBDA (SCREEN XCOORD YCOORD)
                       (* ; "Edited 19-Jun-90 16:33 by matsuda")

+  [LAMBDA (SCREEN XCOORD YCOORD)                             (* ; 
+
                                                           "Edited 19-Jun-90 16:33 by matsuda")

 
          (* * sets up SCREEN to be the current screen, XCOORD %, YCOORD is initial pos 
 
       of cursor on SCREEN)

@@ -201,7 +216,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
                                                 (CLEARW W))])
 
 (WARPCURSOR

-  [LAMBDA (ENABLE)
                                     (* ; "Edited 20-Jul-90 19:02 by matsuda")

+  [LAMBDA (ENABLE)                                           (* ; 
+
                                                           "Edited 20-Jul-90 19:02 by matsuda")

     (COND
        (ENABLE (MOVD 'SAVE.CURSOREXIT 'CURSOREXIT)
               T)
@@ -209,12 +225,15 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
           NIL])
 
 (\SLOWBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM)
                     (* ; "Edited  7-Jun-90 14:06 by matsuda")

-    ((OPCODES SUBRCALL 140 2)
-     CHARCODE DISPLAYSTREAM])
+  [LAMBDA (CHARCODE DISPLAYSTREAM)                           (* ; 
+
                                                           "Edited 26-Oct-2021 10:19 by larry")

+                                                             (* ; 
+
                                                           "Edited  7-Jun-90 14:06 by matsuda")

+    (SUBRCALL C-SlowBltChar CHARCODE DISPLAYSTREAM])
 
 (\SOFTCURSORUP

-  [LAMBDA (NEWCURSOR)
                                  (* ; "Edited 16-Jan-89 15:44 by shimizu")

+  [LAMBDA (NEWCURSOR)                                        (* ; 
+
                                                           "Edited 16-Jan-89 15:44 by shimizu")

                                                              (* Put soft NEWCURSOR up, assuming 
 
                                                           soft cursor is down.
 
                                                           *)

@@ -290,7 +309,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 (\BITBLT.DISPLAY

   [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTSTRM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
                  HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
-                 CLIPPEDSOURCEBOTTOM)
                  (* ; "Edited 24-Jan-91 11:57 by matsuda")

+                 CLIPPEDSOURCEBOTTOM)                        (* ; 
+
                                                           "Edited 24-Jan-91 11:57 by matsuda")

     (DECLARE
 (LOCALVARS . T))
     (DECLARE
 (GLOBALVARS \SYSPILOTBBT \SCREENBITMAPS \BBSCRATCHTEXTURE \SOFTCURSORP 
                         \SOFTCURSORUPP \CURSORDESTINATION))
@@ -454,7 +474,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 (DEFINEQ
 
 (\PUNT.SLOWBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM)
                     (* ; "Edited  2-Jul-90 14:23 by matsuda")

+  [LAMBDA (CHARCODE DISPLAYSTREAM)                           (* ; 
+
                                                           "Edited  2-Jul-90 14:23 by matsuda")

 
     (* ;; "case of BLTCHAR where either font is rotated or destination is a color bitmap.  DISPLAYSTREAM is known to be a display stream, and its cache fields have been updated for CHARCODE's charset")

 
@@ -535,7 +556,10 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
                          (T (ERROR "Not implemented to rotate by other than 0, 90 or 270"])
 
 (\MAIKO.PUNTBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
         (* ; "Edited  1-Nov-89 15:26 by takeshi")

+  [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)               (* ; 
+
                                                           "Edited 26-Oct-2021 10:21 by larry")

+                                                             (* ; 
+
                                                           "Edited  1-Nov-89 15:26 by takeshi")

 
     (* ;; "puts a character on a display stream. This function will be called when \maiko.bltchar failed. Punt from subr call")

 
@@ -598,20 +622,23 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
                                                                                          DDPILOTBBT)
                                                                                of
 DISPLAYDATA)))
                                     0)))
-                      (.WHILE.TOP.DS. DISPLAYSTREAM ((OPCODES SUBRCALL 70 6)
-                                                     LOCAL1 DISPLAYDATA CHAR8CODE CURX LEFT RIGHT))
+                      (.WHILE.TOP.DS. DISPLAYSTREAM (SUBRCALL BLTCHAR LOCAL1 DISPLAYDATA CHAR8CODE 
+                                                           CURX LEFT RIGHT))
                       T])
 
 (\MAIKO.BLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
         (* ; "Edited  6-Jul-90 10:14 by matsuda")

-    ((OPCODES SUBRCALL 135 3)
-     CHARCODE DISPLAYSTREAM DISPLAYDATA])
+  [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)               (* ; 
+
                                                           "Edited 26-Oct-2021 10:22 by larry")

+                                                             (* ; 
+
                                                           "Edited  6-Jul-90 10:14 by matsuda")

+    (SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA])
 )
 (DEFINEQ
 
 (\PUNT.BLTSHADE.BITMAP

   [LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION 
-                 CLIPPINGREGION)
                       (* ; "Edited  5-Jun-90 12:12 by Takeshi")

+                 CLIPPINGREGION)                             (* ; 
+
                                                           "Edited  5-Jun-90 12:12 by Takeshi")

 
     (* ;; "This FNS is for a punt case of \BLTSHADE.BITMAP which is implemeted in C ")

                                                              (* ; 
@@ -718,7 +745,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 (\PUNT.BITBLT.BITMAP

   [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
                  HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
-                 CLIPPEDSOURCEBOTTOM)
                  (* ; "Edited  5-Jun-90 11:59 by Takeshi")

+                 CLIPPEDSOURCEBOTTOM)                        (* ; 
+
                                                           "Edited  5-Jun-90 11:59 by Takeshi")

 
     (* ;; " This FNS is for a punt case of \BITBLT.BITMAP which is implemeted in C")

 
@@ -858,7 +886,8 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 (DEFINEQ
 
 (BITMAPOBJ.SNAPW

-  [LAMBDA NIL
                                          (* ; "Edited 12-Apr-90 09:09 by matsuda")

+  [LAMBDA NIL                                                (* ; 
+
                                                           "Edited 12-Apr-90 09:09 by matsuda")

 
          (* * makes an image object of a prompted for region of the screen.)

 
@@ -962,11 +991,11 @@ Copyright (c) 1988, 1989, 1990, 1991 by Fuji Xerox Co., Ltd..  All rights reserv
 )
 (PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2782 5984 (\MAIKO.COLORINIT 2792 . 3962) (\MAIKO.STARTCOLOR 3964 . 4559) (
-\MAIKO.STOPCOLOR 4561 . 4945) (\MAIKOCOLOR.EVENTFN 4947 . 5578) (\MAIKO.SENDCOLORMAPENTRY 5580 . 5805)
- (\MAIKO.CHANGESCREEN 5807 . 5982)) (5985 26414 (CURSOREXIT 5995 . 7433) (CURSORSCREEN 7435 . 9475) (
-WARPCURSOR 9477 . 9726) (\SLOWBLTCHAR 9728 . 9910) (\SOFTCURSORUP 9912 . 15707) (\BITBLT.DISPLAY 15709
- . 26412)) (26485 37922 (\PUNT.SLOWBLTCHAR 26495 . 33267) (\MAIKO.PUNTBLTCHAR 33269 . 37722) (
-\MAIKO.BLTCHAR 37724 . 37920)) (37923 54124 (\PUNT.BLTSHADE.BITMAP 37933 . 44959) (\PUNT.BITBLT.BITMAP
- 44961 . 54122)) (54125 54867 (BITMAPOBJ.SNAPW 54135 . 54865)))))
+  (FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) (
+\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842)
+ (\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) (
+WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY 
+17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) (
+\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP
+ 47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424)))))
 STOP

library/TEDIT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Sep-2021 22:16:28" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;11
 142247 
+
(FILECREATED "13-Oct-2021 10:00:40" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;19
 142287 
 
       changes to%:  (FNS TEDIT-SEE)
 
-      previous date%: "19-Sep-2021 17:08:56" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;5)
+      previous date%: "11-Oct-2021 14:03:12" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;18)
 
 
 (* ; "
@@ -330,7 +330,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
                 (RETURN PROC])
 
 (TEDIT-SEE

-  [LAMBDA (FILE WINDOW FORMAT)
                          (* ; "Edited 29-Sep-2021 22:16 by rmk:")


+  [LAMBDA (FILE WINDOW FORMAT)
                          (* ; "Edited 13-Oct-2021 10:00 by rmk:")


                                                             (* ; "Edited 27-Feb-2021 20:07 by rmk:")


                                                              (* ; "Edited  1-Feb-88 19:00 by bvm:")

 
@@ -340,18 +340,18 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 
     (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
            (LET ((SEESTREAM STREAM)
-                 ENV TSTREAM)
+                 TSTREAM)
 
                 (* ;; "No need to fiddle with a TEDIT file")

 
                 (IF
 (\TEDIT.FORMATTEDP1 STREAM)
-                  ELSEIF
 (SETQ ENV (LISPSOURCEFILEP STREAM))
+                  ELSEIF
 (LISPSOURCEFILEP STREAM)
                     THEN
 
 
                           (* ;; "Lisp source file")

 
-                          (SETFILEINFO STREAM 'FORMAT ENV)
                           (SETQ SEESTREAM (OPENTEXTSTREAM))
+                          (DSPFONT DEFAULTFONT SEESTREAM)
                           (COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
                   ELSE
 
 
@@ -360,11 +360,12 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
                         (* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).")

 
                         (SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8)
-                                                        *DEFAULT-EXTERNALFORMAT*))
+                                                        :DEFAULT))
                         (CL:UNLESS (RANDACCESSP STREAM)
                             (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
                             (COPYCHARS STREAM SEESTREAM)))
-                [SETQ TSTREAM (TEXTSTREAM
 (TEDIT
 SEESTREAM WINDOW NIL '(READONLY T]
+                [SETQ TSTREAM (TEXTSTREAM
 (TEDIT
 SEESTREAM WINDOW NIL
+                                                     `(READONLY T FONT ,DEFAULTFONT]
                 (WINDOWPROP (WFROMDS TSTREAM)
                        'TITLE
                        (CONCAT "SEE window for " (FULLNAME STREAM)))
@@ -2235,7 +2236,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (* ; "TEDIT Support information")

 
 
-(RPAQQ TEDITSYSTEMDATE
 "29-Sep-2021 22:16:28")
+(RPAQQ TEDITSYSTEMDATE
 "13-Oct-2021 10:00:40")
 
 (RPAQ TEDITSUPPORT
 "TEditSupport.PA")
 (DEFINEQ
@@ -2261,19 +2262,19 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
 1992 1993 1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4329 117413 (\TEDIT2 4339 . 7090) (COERCETEXTOBJ 7092 . 15868) (TEDIT 15870 . 20839) (
-TEDIT-SEE 20841 . 23089) (TEDIT.CHARWIDTH 23091 . 25115) (TEDIT.COPY 25117 . 33553) (TEDIT.DELETE 
-33555 . 34245) (TEDIT.DO.BLUEPENDINGDELETE 34247 . 37314) (TEDIT.INSERT 37316 . 42846) (TEDIT.KILL 
-42848 . 44405) (TEDIT.MAPLINES 44407 . 45806) (TEDIT.MAPPIECES 45808 . 46764) (TEDIT.MOVE 46766 . 
-56550) (TEDIT.QUIT 56552 . 58552) (TEDIT.STRINGWIDTH 58554 . 59225) (TEDIT.\INSERT 59227 . 61252) (
-TEXTOBJ 61254 . 62379) (TEXTSTREAM 62381 . 63996) (\TEDIT.INCLUDE 63998 . 67898) (\TEDIT.INSERT.PIECES
- 67900 . 77815) (\TEDIT.MOVE.PIECEMAPFN 77817 . 79896) (\TEDIT.OBJECT.SHOWSEL 79898 . 83527) (
-\TEDIT.RESTARTFN 83529 . 85524) (\TEDIT.CHARDELETE 85526 . 89488) (\TEDIT.COPY.PIECEMAPFN 89490 . 
-92715) (\TEDIT.DELETE 92717 . 100235) (\TEDIT.DIFFUSE.PARALOOKS 100237 . 103001) (\TEDIT.FOREIGN.COPY?
- 103003 . 106730) (\TEDIT.QUIT 106732 . 109878) (\TEDIT.WORDDELETE 109880 . 114713) (\TEDIT1 114715 . 
-117411)) (117527 117643 (\CREATE.TEDIT.RESTART.MENU 117537 . 117641)) (117742 121431 (PLCHAIN 117752
- . 118026) (PRINTLINE 118028 . 120792) (SEEFILE 120794 . 121429)) (121472 141115 (TEDIT.INSERT.OBJECT 
-121482 . 130559) (TEDIT.EDIT.OBJECT 130561 . 132817) (TEDIT.FIND.OBJECT 132819 . 133712) (
-TEDIT.FIND.OBJECT.SUBTREE 133714 . 134520) (TEDIT.PUT.OBJECT 134522 . 136181) (TEDIT.GET.OBJECT 136183
- . 139382) (TEDIT.OBJECT.CHANGED 139384 . 141113)) (141393 141756 (MAKETEDITFORM 141403 . 141754)))))
+  (FILEMAP (NIL (4330 117453 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) (
+TEDIT-SEE 20842 . 23129) (TEDIT.CHARWIDTH 23131 . 25155) (TEDIT.COPY 25157 . 33593) (TEDIT.DELETE 
+33595 . 34285) (TEDIT.DO.BLUEPENDINGDELETE 34287 . 37354) (TEDIT.INSERT 37356 . 42886) (TEDIT.KILL 
+42888 . 44445) (TEDIT.MAPLINES 44447 . 45846) (TEDIT.MAPPIECES 45848 . 46804) (TEDIT.MOVE 46806 . 
+56590) (TEDIT.QUIT 56592 . 58592) (TEDIT.STRINGWIDTH 58594 . 59265) (TEDIT.\INSERT 59267 . 61292) (
+TEXTOBJ 61294 . 62419) (TEXTSTREAM 62421 . 64036) (\TEDIT.INCLUDE 64038 . 67938) (\TEDIT.INSERT.PIECES
+ 67940 . 77855) (\TEDIT.MOVE.PIECEMAPFN 77857 . 79936) (\TEDIT.OBJECT.SHOWSEL 79938 . 83567) (
+\TEDIT.RESTARTFN 83569 . 85564) (\TEDIT.CHARDELETE 85566 . 89528) (\TEDIT.COPY.PIECEMAPFN 89530 . 
+92755) (\TEDIT.DELETE 92757 . 100275) (\TEDIT.DIFFUSE.PARALOOKS 100277 . 103041) (\TEDIT.FOREIGN.COPY?
+ 103043 . 106770) (\TEDIT.QUIT 106772 . 109918) (\TEDIT.WORDDELETE 109920 . 114753) (\TEDIT1 114755 . 
+117451)) (117567 117683 (\CREATE.TEDIT.RESTART.MENU 117577 . 117681)) (117782 121471 (PLCHAIN 117792
+ . 118066) (PRINTLINE 118068 . 120832) (SEEFILE 120834 . 121469)) (121512 141155 (TEDIT.INSERT.OBJECT 
+121522 . 130599) (TEDIT.EDIT.OBJECT 130601 . 132857) (TEDIT.FIND.OBJECT 132859 . 133752) (
+TEDIT.FIND.OBJECT.SUBTREE 133754 . 134560) (TEDIT.PUT.OBJECT 134562 . 136221) (TEDIT.GET.OBJECT 136223
+ . 139422) (TEDIT.OBJECT.CHANGED 139424 . 141153)) (141433 141796 (MAKETEDITFORM 141443 . 141794)))))
 STOP

library/TEDITMENU

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "29-Apr-2021 22:44:22" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;5
 275764 
 
-      changes to%:  (FNS \TEDIT.MENU.INIT)
+
(FILECREATED "26-Oct-2021 08:44:02" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;3
 276285 
 
-      previous date%: "29-Apr-2021 22:40:33" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;4)
+      changes to%:  (FNS \TEXTMENU.START)
+
+      previous date%: "29-Apr-2021 22:44:22" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;1)
 
 
 (* ; "
@@ -19,7 +20,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
         (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
                (FILES (LOADCOMP)
                       TEDITDCL))
-        [COMS                                                (* ; "Simple Menu Button support")

+        [COMS                                                (* ; "Simple Menu Button support")

               (FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN 
                    MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME 
                    MBUTTON.FIND.BUTTON MBUTTON.FIND.NEXT.BUTTON MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT
@@ -31,13 +32,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT))
                      (ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN]
         [COMS 
-              (* ;; 
-
            "Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")

+              (* ;; 
+
            "Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")

 
               (FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN 
                    MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT]
-        [COMS                                                (* ; "One-of-N Menu button sets")

+        [COMS                                                (* ; "One-of-N Menu button sets")

               (FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN 
                    MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS 
                    MB.NWAYBUTTON.ADDITEM)
@@ -45,7 +46,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT))
                      (ADDVARS (IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN]
         [COMS 
-              (* ;; "Two-state, toggling menu buttons.")

+              (* ;; "Two-state, toggling menu buttons.")

 
               (FNS \TEXTMENU.TOGGLE.CREATE \TEXTMENU.TOGGLE.DISPLAY \TEXTMENU.TOGGLE.SHOWSELFN 
                    \TEXTMENU.TOGGLE.WHENOPERATEDFN \TEXTMENU.TOGGLEFN \TEXTMENU.TOGGLE.INIT 
@@ -54,7 +55,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTMENU.TOGGLE.INIT))
                      (ADDVARS (IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN]
         [COMS 
-              (* ;; "Margin Setting and display")

+              (* ;; "Margin Setting and display")

 
               (FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN
                    MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK
@@ -66,11 +67,11 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT))
                      (ADDVARS (IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN]
         (COMS 
-              (* ;; "Text menu creation and support")

+              (* ;; "Text menu creation and support")

 
               (FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN)
               (BITMAPS TEXTMENUICON TEXTMENUICONMASK))
-        [COMS                                                (* ; "TEdit-specific support")

+        [COMS                                                (* ; "TEdit-specific support")

               (FNS \TEDITMENU.CREATE \TEDIT.EXPANDED.MENU MB.DEFAULTBUTTON.FN 
                    \TEDITMENU.RECORD.UNFORMATTED MB.DEFAULTBUTTON.ACTIONFN)
               (FNS \TEDIT.CHARLOOKSMENU.CREATE \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.APPLY.BOLDNESS 
@@ -82,7 +83,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
                    \TEDIT.SHOW.PARALOOKS \TEDIT.NEUTRALIZE.PARALOOKS.MENU \TEDIT.RECORD.TABLEADERS)
               (FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING 
                    TEDIT.UNPARSE.PAGEFORMAT)
-              (COMS                                          (* ; "Initialization Code")

+              (COMS                                          (* ; "Initialization Code")

                     (GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU 
                            TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC 
                            TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC TEDIT.EXPANDED.PAGEMENU)
@@ -2067,11 +2068,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (\TEXTMENU.START

-  [LAMBDA (MENU MAINWINDOW TITLE HEIGHT)
      (* ; 
+  [LAMBDA (MENU MAINWINDOW TITLE HEIGHT)
                (* ; "Edited 26-Oct-2021 08:43 by rmk:")


+                                                  (* ; 
 
                                                "Edited  4-Jun-93 11:59 by sybalsky:mv:envos")

 
     (* ;; "Create a TEdit-based menu for a given main window.")

 
+    (* ;; "RMK: Add MAX/MINSIZE so menus don't grow vertically when the main window is reshaped.  Not sure why HEIGHT is passed in or defaults to 133, but either way, the original window height should persist")

+
     (PROG ([WREG (COND
                     (MAINWINDOW (WINDOWPROP MAINWINDOW 'REGION))
                     (T (GETREGION]
@@ -2104,6 +2108,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
                                                              (* ; 
 
                                                           "Mark this as a TEDIT MENU window")

           (ATTACHWINDOW MENUW MAINWINDOW 'TOP 'JUSTIFY 'LOCALCLOSE)
+          [SETQ HEIGHT (FETCH
 (REGION HEIGHT) OF
 (WINDOWPROP MENUW 'REGION]
+          (WINDOWPROP MENUW 'MAXSIZE (CONS 64000 HEIGHT))
+          (WINDOWPROP MENUW 'MINSIZE (CONS 0 HEIGHT))
           (SETQ MENUTEXT MENU)
           (replace
 (TEXTOBJ MENUFLG) of
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 MENUTEXT)
              with
 T)
@@ -4524,20 +4531,20 @@ MB.CREATE.NWAYBUTTON 43946 . 47914) (MB.NB.DISPLAYFN 47916 . 50188) (MB.NB.WHENO
 85254 . 88164) (MB.MARGINBAR.SELFN 88166 . 100760) (MB.MARGINBAR.SIZEFN 100762 . 101124) (
 MB.MARGINBAR.DISPLAYFN 101126 . 103811) (MDESCALE 103813 . 104252) (MSCALE 104254 . 104588) (
 MB.MARGINBAR.SHOWTAB 104590 . 106761) (MB.MARGINBAR.TABTRACK 106763 . 108098) (\TEDIT.TABTYPE.SET 
-108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130317 (\TEXTMENU.START 112725 . 115917) (
-\TEXTMENU.DOC.CREATE 115919 . 127443) (TEXTMENU.CLOSEFN 127445 . 130315)) (130627 150691 (
-\TEDITMENU.CREATE 130637 . 130937) (\TEDIT.EXPANDED.MENU 130939 . 131643) (MB.DEFAULTBUTTON.FN 131645
- . 134517) (\TEDITMENU.RECORD.UNFORMATTED 134519 . 134857) (MB.DEFAULTBUTTON.ACTIONFN 134859 . 150689)
-) (150692 178075 (\TEDIT.CHARLOOKSMENU.CREATE 150702 . 152842) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152844
- . 153218) (\TEDIT.APPLY.BOLDNESS 153220 . 153505) (\TEDIT.APPLY.CHARLOOKS 153507 . 155438) (
-\TEDIT.APPLY.OLINE 155440 . 155721) (\TEDIT.SHOW.CHARLOOKS 155723 . 157636) (
-\TEDIT.NEUTRALIZE.CHARLOOKS 157638 . 158564) (\TEDIT.FILL.IN.CHARLOOKS.MENU 158566 . 166219) (
-\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166221 . 169104) (\TEDIT.PARSE.CHARLOOKS.MENU 169106 . 177214) (
-\TEDIT.APPLY.SLOPE 177216 . 177499) (\TEDIT.APPLY.STRIKEOUT 177501 . 177788) (\TEDIT.APPLY.ULINE 
-177790 . 178073)) (178076 210142 (\TEDITPARAMENU.CREATE 178086 . 178466) (\TEDIT.EXPANDEDPARA.MENU 
-178468 . 178788) (\TEDIT.APPLY.PARALOOKS 178790 . 191020) (\TEDIT.SHOW.PARALOOKS 191022 . 202549) (
-\TEDIT.NEUTRALIZE.PARALOOKS.MENU 202551 . 208622) (\TEDIT.RECORD.TABLEADERS 208624 . 210140)) (210143 
-248145 (\TEDIT.SHOW.PAGEFORMATTING 210153 . 226693) (\TEDITPAGEMENU.CREATE 226695 . 227738) (
-\TEDIT.APPLY.PAGEFORMATTING 227740 . 240111) (TEDIT.UNPARSE.PAGEFORMAT 240113 . 248143)) (248450 
-275299 (\TEDIT.MENU.INIT 248460 . 275297)))))
+108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130838 (\TEXTMENU.START 112725 . 116438) (
+\TEXTMENU.DOC.CREATE 116440 . 127964) (TEXTMENU.CLOSEFN 127966 . 130836)) (131148 151212 (
+\TEDITMENU.CREATE 131158 . 131458) (\TEDIT.EXPANDED.MENU 131460 . 132164) (MB.DEFAULTBUTTON.FN 132166
+ . 135038) (\TEDITMENU.RECORD.UNFORMATTED 135040 . 135378) (MB.DEFAULTBUTTON.ACTIONFN 135380 . 151210)
+) (151213 178596 (\TEDIT.CHARLOOKSMENU.CREATE 151223 . 153363) (\TEDIT.EXPANDEDCHARLOOKS.MENU 153365
+ . 153739) (\TEDIT.APPLY.BOLDNESS 153741 . 154026) (\TEDIT.APPLY.CHARLOOKS 154028 . 155959) (
+\TEDIT.APPLY.OLINE 155961 . 156242) (\TEDIT.SHOW.CHARLOOKS 156244 . 158157) (
+\TEDIT.NEUTRALIZE.CHARLOOKS 158159 . 159085) (\TEDIT.FILL.IN.CHARLOOKS.MENU 159087 . 166740) (
+\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166742 . 169625) (\TEDIT.PARSE.CHARLOOKS.MENU 169627 . 177735) (
+\TEDIT.APPLY.SLOPE 177737 . 178020) (\TEDIT.APPLY.STRIKEOUT 178022 . 178309) (\TEDIT.APPLY.ULINE 
+178311 . 178594)) (178597 210663 (\TEDITPARAMENU.CREATE 178607 . 178987) (\TEDIT.EXPANDEDPARA.MENU 
+178989 . 179309) (\TEDIT.APPLY.PARALOOKS 179311 . 191541) (\TEDIT.SHOW.PARALOOKS 191543 . 203070) (
+\TEDIT.NEUTRALIZE.PARALOOKS.MENU 203072 . 209143) (\TEDIT.RECORD.TABLEADERS 209145 . 210661)) (210664 
+248666 (\TEDIT.SHOW.PAGEFORMATTING 210674 . 227214) (\TEDITPAGEMENU.CREATE 227216 . 228259) (
+\TEDIT.APPLY.PAGEFORMATTING 228261 . 240632) (TEDIT.UNPARSE.PAGEFORMAT 240634 . 248664)) (248971 
+275820 (\TEDIT.MENU.INIT 248981 . 275818)))))
 STOP

library/TEDITWINDOW

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "19-Sep-2021 23:11:04" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;10
 186372 
 
-      changes to%:  (FNS \TEDIT.SCROLLFN)
+
(FILECREATED "16-Oct-2021 18:52:11" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18
 187780 
 
-      previous date%: "19-Sep-2021 22:58:18" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;9)
+      changes to%:  (FNS TEDIT.DEACTIVATE.WINDOW)
+
+      previous date%: "12-Oct-2021 15:10:06" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;17)
 
 
 (* ; "
@@ -25,6 +26,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
              \TEDIT.WINDOW.OPS \TEDIT.EXPANDFN \TEDIT.MAINW \TEDIT.PRIMARYW \TEDIT.COPYINSERTFN 
              \TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN 
              \TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.WINDOW.SETUP \SAFE.FIRST)
+        (INITVARS (\TEDIT.OP.WIDTH 12)
+               (\TEDIT.OP.BOTTOM 12))
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM))
         (CURSORS BXCARET BXHICARET TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR 
                \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR)
         (INITVARS (TEDIT.DEFAULT.WINDOW NIL))
@@ -156,7 +160,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
     TEDIT.DEFAULT.WINDOW])
 
 (TEDIT.CURSORMOVEDFN

-  [LAMBDA (W)
                                            (* ; "Edited 30-May-91 23:39 by jds")

+  [LAMBDA (W)
                                           (* ; "Edited 12-Oct-2021 13:14 by rmk:")

 
          (* Watch the mouse and change the cursor to reflect the region of the window 
 
       it's in (line select, window split eventually?))

@@ -187,13 +191,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                                                           of
 LINE]
                 (SELECTQ (fetch
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ)
                     (TEXT [COND
-                             ((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
-                                                                 of
 TEXTOBJ)
-                                                        8)))
+                             ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
+                                                                      of
 TEXTOBJ)
+                                                             \TEDIT.OP.WIDTH)))
+                                   (IGEQ Y (IPLUS (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ)
+                                                  \TEDIT.OP.BOTTOM)))
+
+                              (* ;; "The region to the right of text, for splitting operations.")

+
                               (CURSOR \TEDIT.SPLITCURSOR)
                               (replace
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ with
 'WINDOW)
                               (replace
 LEFT of
 CURSORREG with
 LEFT)
-                              (replace
 WIDTH of
 CURSORREG with
 8))
+                              (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                              ([ILESSP X (SETQ LEFT
                                          (OR [AND LINE (COND
                                                           ((fetch
 (FMTSPEC FMTHARDCOPY)
@@ -221,13 +230,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                                                                     of
 TEXTOBJ)
                                                                            (IPLUS LEFT 8])
                     (LINE (COND
-                             ((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
-                                                                 of
 TEXTOBJ)
-                                                        8)))
+                             ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
+                                                                      of
 TEXTOBJ)
+                                                             \TEDIT.OP.WIDTH)))
+                                   (IGEQ Y (IPLUS (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ)
+                                                  \TEDIT.OP.BOTTOM)))
                               (CURSOR \TEDIT.SPLITCURSOR)
                               (replace
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ with
 'WINDOW)
                               (replace
 LEFT of
 CURSORREG with
 LEFT)
-                              (replace
 WIDTH of
 CURSORREG with
 8))
+                              (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                              [[IGEQ X (SETQ LEFT (OR [AND LINE (COND
                                                                   ((fetch
 (FMTSPEC FMTHARDCOPY)
                                                                       of
 (fetch
 (
@@ -256,13 +267,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                              (T (replace
 LEFT of
 CURSORREG with
 0)
                                 (replace
 WIDTH of
 CURSORREG with
 LEFT))))
                     (WINDOW (COND
-                               ((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
-                                                                   of
 TEXTOBJ)
-                                                          8)))
+                               ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT)
+                                                                        of
 TEXTOBJ)
+                                                               \TEDIT.OP.WIDTH)))
+                                     (IGEQ Y (IPLUS (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ)
+                                                    \TEDIT.OP.BOTTOM)))
                                 (replace
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ with

                                                                                   'WINDOW)
                                 (replace
 LEFT of
 CURSORREG with
 LEFT)
-                                (replace
 WIDTH of
 CURSORREG with
 8))
+                                (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                                ([IGEQ X (SETQ LEFT
                                          (OR [AND LINE (COND
                                                           ((fetch
 (FMTSPEC FMTHARDCOPY)
@@ -795,17 +808,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                               'SELECTED OSEL (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ])])
 
 (\TEDIT.WINDOW.OPS

-  [LAMBDA (TEXTOBJ WINDOWTOSPLIT)
                        (* ; "Edited 30-May-91 23:33 by jds")

+  [LAMBDA (TEXTOBJ WINDOWTOSPLIT)
                       (* ; "Edited 12-Oct-2021 15:01 by rmk:")

 
 (* ;;; "Do window operations for TEdit, e.g., splitting a window, moving the split location, or unsplitting.")

 
     (PROG ([WINDOWOPREGION (create
 REGION
                                   LEFT _ (DIFFERENCE (fetch
 (TEXTOBJ WRIGHT) of
 TEXTOBJ)
-                                                8)
-                                  BOTTOM _ 0
-                                  WIDTH _ 8
-                                  HEIGHT _ (fetch
 HEIGHT of
 (WINDOWPROP WINDOWTOSPLIT
-                                                                           'REGION]
+                                                \TEDIT.OP.WIDTH)
+                                  BOTTOM _ \TEDIT.OP.BOTTOM
+                                  WIDTH _ \TEDIT.OP.WIDTH
+                                  HEIGHT _ (fetch
 (REGION HEIGHT) of
 (WINDOWPROP 
+                                                                                    WINDOWTOSPLIT
+                                                                                    'REGION]
            Y OPERATION)
           [while
 [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
                           (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT)
@@ -845,7 +859,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                            (\TEDIT.UNSPLITW
 WINDOWTOSPLIT))
                   (MOVE                                      (* ; 
 
                                                           "Moving the divider between two panes.")

-                        (TEDIT.PROMPTPRINT
 TEXTOBJ "Can't move the split point yet." T))
+                        (TEDIT.PROMPTPRINT
 TEXTOBJ "Split-point moving is not yet implemented" T))
                   (SHOULDNT)))
              (T (CURSOR T])
 
@@ -1366,6 +1380,16 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
         (CAR LIST.OR.ATOM))
        (T LIST.OR.ATOM])
 )
+
+(RPAQ? \TEDIT.OP.WIDTH
 12)
+
+(RPAQ? \TEDIT.OP.BOTTOM
 12)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM)
+)
+)
 (RPAQ BXCARET (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@CH@@CH@@FL@@FL@@LF@@
 ) (QUOTE NIL) 3 4))
 (RPAQ BXHICARET (CURSORCREATE (QUOTE #*(16 16)A@@@A@@@A@@@A@@@A@@@A@@@A@@@A@@@CH@@GL@@FL@@LF@@HB@@@@@@@@@@@@@@
@@ -1679,12 +1703,13 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
 (DEFINEQ
 
 (TEDIT.DEACTIVATE.WINDOW

-  [LAMBDA (W FORCEFLG DISCONNECTONLYFLG)
                 (* ; "Edited 30-May-91 23:34 by jds")

+  [LAMBDA (W FORCEFLG DISCONNECTONLYFLG)
                (* ; "Edited 16-Oct-2021 18:51 by rmk:")

 
     (* ;; "Deactivate the various button fns for this window")

 
     (PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ]                  (* ; 
 
                           "Can't be a call to TEXTOBJ, since window may NOT have a textobj on it.")

+          (replace
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ with
 T)
           [COND
              ((AND TEXTOBJ (fetch
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ))
 
@@ -1705,6 +1730,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                     (RETURN 'DON'T]
           (COND
              ([AND TEXTOBJ (OR FORCEFLG (fetch
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ)
+                               (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)
                                (NOT (PROCESSP (WINDOWPROP W 'PROCESS]
                                                              (* ; 
 
                                   "Only do this if it's a TEdit window, and has been QUIT out of.")

@@ -2830,25 +2856,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
 (PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 
 1989 1990 1991 1993 1994 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7117 93041 (TEDIT.CREATEW 7127 . 8263) (\TEDIT.CREATEW.FROM.REGION 8265 . 9249) (
-TEDIT.CURSORMOVEDFN 9251 . 19903) (TEDIT.CURSOROUTFN 19905 . 20440) (TEDIT.WINDOW.SETUP 20442 . 22251)
- (TEDIT.MINIMAL.WINDOW.SETUP 22253 . 30042) (\TEDIT.ACTIVE.WINDOWP 30044 . 31025) (
-\TEDIT.BUTTONEVENTFN 31027 . 56017) (\TEDIT.WINDOW.OPS 56019 . 59822) (\TEDIT.EXPANDFN 59824 . 60227) 
-(\TEDIT.MAINW 60229 . 61518) (\TEDIT.PRIMARYW 61520 . 62732) (\TEDIT.COPYINSERTFN 62734 . 63705) (
-\TEDIT.NEWREGIONFN 63707 . 66174) (\TEDIT.SET.WINDOW.EXTENT 66176 . 72278) (\TEDIT.SHRINK.ICONCREATE 
-72280 . 74552) (\TEDIT.SHRINKFN 74554 . 75129) (\TEDIT.SPLITW 75131 . 81232) (\TEDIT.UNSPLITW 81234 . 
-86928) (\TEDIT.WINDOW.SETUP 86930 . 92650) (\SAFE.FIRST 92652 . 93039)) (94187 95094 (TEDITWINDOWP 
-94197 . 95092)) (95131 97627 (TEDIT.GETINPUT 95141 . 97124) (\TEDIT.MAKEFILENAME 97126 . 97625)) (
-97676 104127 (TEDIT.PROMPTPRINT 97686 . 100590) (TEDIT.PROMPTFLASH 100592 . 102547) (
-\TEDIT.PROMPT.PAGEFULLFN 102549 . 104125)) (104362 108424 (TEXTSTREAM.TITLE 104372 . 104993) (
-\TEDIT.ORIGINAL.WINDOW.TITLE 104995 . 107040) (\TEDIT.WINDOW.TITLE 107042 . 107712) (
-\TEXTSTREAM.FILENAME 107714 . 108422)) (108467 153208 (TEDIT.DEACTIVATE.WINDOW 108477 . 115626) (
-\TEDIT.REPAINTFN 115628 . 118485) (\TEDIT.RESHAPEFN 118487 . 124107) (\TEDIT.SCROLLFN 124109 . 153206)
-) (153250 155299 (\TEDIT.PROCIDLEFN 153260 . 154609) (\TEDIT.PROCENTRYFN 154611 . 154904) (
-\TEDIT.PROCEXITFN 154906 . 155297)) (155378 166378 (\EDIT.DOWNCARET 155388 . 156069) (\EDIT.FLIPCARET 
-156071 . 157606) (TEDIT.FLASHCARET 157608 . 158722) (\EDIT.UPCARET 158724 . 159177) (
-TEDIT.NORMALIZECARET 159179 . 165130) (\SETCARET 165132 . 166052) (\TEDIT.CARET 166054 . 166376)) (
-166412 180167 (TEDIT.ADD.MENUITEM 166422 . 168337) (TEDIT.DEFAULT.MENUFN 168339 . 177606) (
-TEDIT.REMOVE.MENUITEM 177608 . 178609) (\TEDIT.CREATEMENU 178611 . 179064) (\TEDIT.MENU.WHENHELDFN 
-179066 . 179836) (\TEDIT.MENU.WHENSELECTEDFN 179838 . 180165)))))
+  (FILEMAP (NIL (7291 94107 (TEDIT.CREATEW 7301 . 8437) (\TEDIT.CREATEW.FROM.REGION 8439 . 9423) (
+TEDIT.CURSORMOVEDFN 9425 . 20811) (TEDIT.CURSOROUTFN 20813 . 21348) (TEDIT.WINDOW.SETUP 21350 . 23159)
+ (TEDIT.MINIMAL.WINDOW.SETUP 23161 . 30950) (\TEDIT.ACTIVE.WINDOWP 30952 . 31933) (
+\TEDIT.BUTTONEVENTFN 31935 . 56925) (\TEDIT.WINDOW.OPS 56927 . 60888) (\TEDIT.EXPANDFN 60890 . 61293) 
+(\TEDIT.MAINW 61295 . 62584) (\TEDIT.PRIMARYW 62586 . 63798) (\TEDIT.COPYINSERTFN 63800 . 64771) (
+\TEDIT.NEWREGIONFN 64773 . 67240) (\TEDIT.SET.WINDOW.EXTENT 67242 . 73344) (\TEDIT.SHRINK.ICONCREATE 
+73346 . 75618) (\TEDIT.SHRINKFN 75620 . 76195) (\TEDIT.SPLITW 76197 . 82298) (\TEDIT.UNSPLITW 82300 . 
+87994) (\TEDIT.WINDOW.SETUP 87996 . 93716) (\SAFE.FIRST 93718 . 94105)) (95437 96344 (TEDITWINDOWP 
+95447 . 96342)) (96381 98877 (TEDIT.GETINPUT 96391 . 98374) (\TEDIT.MAKEFILENAME 98376 . 98875)) (
+98926 105377 (TEDIT.PROMPTPRINT 98936 . 101840) (TEDIT.PROMPTFLASH 101842 . 103797) (
+\TEDIT.PROMPT.PAGEFULLFN 103799 . 105375)) (105612 109674 (TEXTSTREAM.TITLE 105622 . 106243) (
+\TEDIT.ORIGINAL.WINDOW.TITLE 106245 . 108290) (\TEDIT.WINDOW.TITLE 108292 . 108962) (
+\TEXTSTREAM.FILENAME 108964 . 109672)) (109717 154616 (TEDIT.DEACTIVATE.WINDOW 109727 . 117034) (
+\TEDIT.REPAINTFN 117036 . 119893) (\TEDIT.RESHAPEFN 119895 . 125515) (\TEDIT.SCROLLFN 125517 . 154614)
+) (154658 156707 (\TEDIT.PROCIDLEFN 154668 . 156017) (\TEDIT.PROCENTRYFN 156019 . 156312) (
+\TEDIT.PROCEXITFN 156314 . 156705)) (156786 167786 (\EDIT.DOWNCARET 156796 . 157477) (\EDIT.FLIPCARET 
+157479 . 159014) (TEDIT.FLASHCARET 159016 . 160130) (\EDIT.UPCARET 160132 . 160585) (
+TEDIT.NORMALIZECARET 160587 . 166538) (\SETCARET 166540 . 167460) (\TEDIT.CARET 167462 . 167784)) (
+167820 181575 (TEDIT.ADD.MENUITEM 167830 . 169745) (TEDIT.DEFAULT.MENUFN 169747 . 179014) (
+TEDIT.REMOVE.MENUITEM 179016 . 180017) (\TEDIT.CREATEMENU 180019 . 180472) (\TEDIT.MENU.WHENHELDFN 
+180474 . 181244) (\TEDIT.MENU.WHENSELECTEDFN 181246 . 181573)))))
 STOP

library/TEXTOFD

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 6-May-2021 10:18:06" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;4
 176139 
 
-      changes to%:  (FNS \TEXTINIT)
+
(FILECREATED "12-Oct-2021 15:38:41" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;4
 176302 
 
-      previous date%: "11-Feb-2001 12:06:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;2)
+      changes to%:  (FNS \TEDITOUTCCODEFN)
+
+      previous date%: " 7-Oct-2021 08:41:13" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;3)
 
 
 (* ; "
@@ -25,24 +26,24 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
         (FNS \INSERTCH \INSERTCR)
         (COMS 
 
-(* ;;; "Functions to manipulate the Piece Table (PCTB)")

+(* ;;; "Functions to manipulate the Piece Table (PCTB)")

 
               (FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE 
                    \INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE))
-        (COMS                                                (* ; 
-
                                                           "Generic-IO type operations support")

+        (COMS                                                (* ; 
+
                                                           "Generic-IO type operations support")

               (FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR 
                    \TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR 
-                   \TEXTBOUT \TEDITOUTCHARFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION 
+                   \TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION 
                    \TEXTDSPYPOSITION \TEXTLEFTMARGIN \TEXTRIGHTMARGIN \TEXTDSPCHARWIDTH 
                    \TEXTDSPSTRINGWIDTH \TEXTDSPLINEFEED)
               (FNS \TEXTBIN \TEDIT.TEXTBIN.STRINGSETUP \TEDIT.TEXTBIN.FILESETUP 
                    \TEDIT.TEXTBIN.NEW.PAGE)
               (FNS \TEXTPEEKBIN \TEDIT.PEEKBIN.NEW.PAGE))
-        (COMS                                                (* ; "Support for TEXTPROP")

+        (COMS                                                (* ; "Support for TEXTPROP")

               (FNS CGETTEXTPROP CTEXTPROP GETTEXTPROP PUTTEXTPROP TEXTPROP))
         [COMS 
-              (* ;; "Support for error handling:  The old error handler for the stream-not-open error.  This is here, because you only want to do this ONCE, even if you load TEXTOFD multiple times (as, e.g., in development)")

+              (* ;; "Support for error handling:  The old error handler for the stream-not-open error.  This is here, because you only want to do this ONCE, even if you load TEXTOFD multiple times (as, e.g., in development)")

 
               (INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN]
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT)))
@@ -676,29 +677,29 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
           (RETURN PC])
 
 (\TEXTINIT

-  [LAMBDA NIL
                                           (* ; "Edited  6-May-2021 10:17 by rmk:")

-                                                             (* ; 
-
                                          "Create the FDEV and STREAM prototypes for TEXT streams.")

+  [LAMBDA NIL
                                           (* ; "Edited  7-Oct-2021 08:40 by rmk:")

+                                                             (* ; 
+
                                          "Create the FDEV and STREAM prototypes for TEXT streams.")

 
-    (* ;; "TEXT streams make use of the following STREAM fields:")

+    (* ;; "TEXT streams make use of the following STREAM fields:")

 
-    (* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")

+    (* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")

 
-    (* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")

+    (* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")

 
-    (* ;; "F2 (* # chars left in piece at end of underlying file's page)")

+    (* ;; "F2 (* # chars left in piece at end of underlying file's page)")

 
-    (* ;; "F3 (* The TEXTOBJ for this stream)")

+    (* ;; "F3 (* The TEXTOBJ for this stream)")

 
-    (* ;; "F4")

+    (* ;; "F4")

 
-    (* ;; "F5 (* The PIECE we're currently inside)")

+    (* ;; "F5 (* The PIECE we're currently inside)")

 
-    (* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")

+    (* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")

 
-    (* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")

+    (* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")

 
-    (* ;; "(FW8 WORD)")

+    (* ;; "(FW8 WORD)")

 
     (SETQ \TEXTIMAGEOPS (create
 IMAGEOPS
                                IMAGETYPE _ 'TEXT
@@ -745,6 +746,9 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                            FDEXTENDABLE _ NIL
                            TRUNCATEFILE _ (FUNCTION NILL)
                            WRITEPAGES _ (FUNCTION NILL)))
+
+    (* ;; "The prototypical Text stream")

+
     (SETQ \TEXTOFD
      (create
 STREAM
             BINABLE _ T
@@ -761,10 +765,16 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
             FW7 _ 0
             MAXBUFFERS _ 10
             IMAGEOPS _ \TEXTIMAGEOPS
-            IMAGEDATA _ (create
 TEXTIMAGEDATA)
-            OUTCHARFN _ (FUNCTION \TEDITOUTCHARFN)))         (* ; "The prototypical Text stream")

+            IMAGEDATA _ (create
 TEXTIMAGEDATA)))
 
-    (* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")

+    (* ;; "Maybe more functions later?")

+
+    (MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN)
+           NIL
+           'CR)
+    (\EXTERNALFORMAT \TEXTOFD :TEDIT)
+
+    (* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")

 
     (CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
            (FUNCTION (LAMBDA (CONDITION)
@@ -772,8 +782,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                             (COND
                                [(AND (BOUNDP 'ERRORPOS)
                                      (TEXTSTREAMP
 STREAM))
-                                                             (* ; 
-
           "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")

+                                                             (* ; 
+
           "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")

                                 (LET ((XCL::RESULT (REOPENTEXTSTREAM
 STREAM)))
                                      (CL:WHEN XCL::RESULT
                                          (ENVAPPLY (STKNAME ERRORPOS)
@@ -781,8 +791,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
                                                 (STKNTH -1 ERRORPOS ERRORPOS)
                                                 ERRORPOS T T))]
                                (*TEDIT-OLD-STREAM-ERROR-HANDLER* 
-                                                             (* ; 
-
                         "Some other kind of stream, so punt to the old handler (if there is one):")

+                                                             (* ; 
+
                         "Some other kind of stream, so punt to the old handler (if there is one):")

                                       (APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
 
 (\TEXTMARK

@@ -1782,10 +1792,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
           (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
           (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 NIL])
 
-(\TEDITOUTCHARFN

-  [LAMBDA (STREAM CHARCODE)
                              (* ; "Edited 31-May-91 14:19 by jds")

+(\TEDITOUTCCODEFN

+  [LAMBDA (STREAM CHARCODE)
                             (* ; "Edited 12-Oct-2021 15:38 by rmk:")

 
-    (* ;; "OUTCHARFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes. BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.")

+    (* ;; "OUTCCODEFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes (via \TEXTBOUT). BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.")

 
     (COND
        ((EQ CHARCODE (CHARCODE EOL))
@@ -2657,25 +2667,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
 (PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 
 1990 1991 1993 1994 1995 1999 2000 2001 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2982 52971 (COPYTEXTSTREAM 2992 . 6114) (OPENTEXTSTREAM 6116 . 20993) (REOPENTEXTSTREAM
- 20995 . 21417) (TEDIT.STREAMCHANGEDP 21419 . 21717) (TEXTSTREAMP 21719 . 22033) (TXTFILE 22035 . 
-22480) (\DELETECH 22482 . 33738) (\SETUPGETCH 33740 . 41019) (\TEDIT.REOPEN.STREAM 41021 . 42871) (
-\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42873 . 45311) (\TEXTINIT 45313 . 50864) (\TEXTMARK 50866 . 51614) (
-\TEXTTTYBOUT 51616 . 52969)) (52972 78404 (\INSERTCH 52982 . 76708) (\INSERTCR 76710 . 78402)) (78470 
-98786 (\CHTOPC 78480 . 79669) (\CHTOPCNO 79671 . 80933) (\CLEARPCTB 80935 . 81731) (
-\CREATEPIECEORSTREAM 81733 . 84707) (\DELETEPIECE 84709 . 85622) (\FINDPIECE 85624 . 85990) (
-\INSERTPIECE 85992 . 89002) (\MAKEPCTB 89004 . 90919) (\SPLITPIECE 90921 . 97880) (\INSERT.FIRST.PIECE
- 97882 . 98784)) (98838 123056 (\TEXTCLOSEF 98848 . 100075) (\TEXTCLOSEF-SUBTREE 100077 . 100783) (
-\TEXTDSPFONT 100785 . 101777) (\TEXTEOFP 101779 . 103138) (\TEXTGETEOFPTR 103140 . 103350) (
-\TEXTGETFILEPTR 103352 . 105415) (\TEXTOPENF 105417 . 106247) (\TEXTOPENF-SUBTREE 106249 . 107050) (
-\TEXTOUTCHARFN 107052 . 107400) (\TEXTBACKFILEPTR 107402 . 113303) (\TEXTBOUT 113305 . 116653) (
-\TEDITOUTCHARFN 116655 . 117901) (\TEXTSETEOF 117903 . 118412) (\TEXTSETFILEPTR 118414 . 119639) (
-\TEXTDSPXPOSITION 119641 . 120498) (\TEXTDSPYPOSITION 120500 . 121045) (\TEXTLEFTMARGIN 121047 . 
-121530) (\TEXTRIGHTMARGIN 121532 . 122468) (\TEXTDSPCHARWIDTH 122470 . 122708) (\TEXTDSPSTRINGWIDTH 
-122710 . 122950) (\TEXTDSPLINEFEED 122952 . 123054)) (123057 156801 (\TEXTBIN 123067 . 139853) (
-\TEDIT.TEXTBIN.STRINGSETUP 139855 . 145568) (\TEDIT.TEXTBIN.FILESETUP 145570 . 151956) (
-\TEDIT.TEXTBIN.NEW.PAGE 151958 . 156799)) (156802 170210 (\TEXTPEEKBIN 156812 . 165951) (
-\TEDIT.PEEKBIN.NEW.PAGE 165953 . 170208)) (170248 175466 (CGETTEXTPROP 170258 . 170734) (CTEXTPROP 
-170736 . 173080) (GETTEXTPROP 173082 . 173677) (PUTTEXTPROP 173679 . 175004) (TEXTPROP 175006 . 175464
+  (FILEMAP (NIL (2989 53114 (COPYTEXTSTREAM 2999 . 6121) (OPENTEXTSTREAM 6123 . 21000) (REOPENTEXTSTREAM
+ 21002 . 21424) (TEDIT.STREAMCHANGEDP 21426 . 21724) (TEXTSTREAMP 21726 . 22040) (TXTFILE 22042 . 
+22487) (\DELETECH 22489 . 33745) (\SETUPGETCH 33747 . 41026) (\TEDIT.REOPEN.STREAM 41028 . 42878) (
+\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42880 . 45318) (\TEXTINIT 45320 . 51007) (\TEXTMARK 51009 . 51757) (
+\TEXTTTYBOUT 51759 . 53112)) (53115 78547 (\INSERTCH 53125 . 76851) (\INSERTCR 76853 . 78545)) (78613 
+98929 (\CHTOPC 78623 . 79812) (\CHTOPCNO 79814 . 81076) (\CLEARPCTB 81078 . 81874) (
+\CREATEPIECEORSTREAM 81876 . 84850) (\DELETEPIECE 84852 . 85765) (\FINDPIECE 85767 . 86133) (
+\INSERTPIECE 86135 . 89145) (\MAKEPCTB 89147 . 91062) (\SPLITPIECE 91064 . 98023) (\INSERT.FIRST.PIECE
+ 98025 . 98927)) (98981 123219 (\TEXTCLOSEF 98991 . 100218) (\TEXTCLOSEF-SUBTREE 100220 . 100926) (
+\TEXTDSPFONT 100928 . 101920) (\TEXTEOFP 101922 . 103281) (\TEXTGETEOFPTR 103283 . 103493) (
+\TEXTGETFILEPTR 103495 . 105558) (\TEXTOPENF 105560 . 106390) (\TEXTOPENF-SUBTREE 106392 . 107193) (
+\TEXTOUTCHARFN 107195 . 107543) (\TEXTBACKFILEPTR 107545 . 113446) (\TEXTBOUT 113448 . 116796) (
+\TEDITOUTCCODEFN 116798 . 118064) (\TEXTSETEOF 118066 . 118575) (\TEXTSETFILEPTR 118577 . 119802) (
+\TEXTDSPXPOSITION 119804 . 120661) (\TEXTDSPYPOSITION 120663 . 121208) (\TEXTLEFTMARGIN 121210 . 
+121693) (\TEXTRIGHTMARGIN 121695 . 122631) (\TEXTDSPCHARWIDTH 122633 . 122871) (\TEXTDSPSTRINGWIDTH 
+122873 . 123113) (\TEXTDSPLINEFEED 123115 . 123217)) (123220 156964 (\TEXTBIN 123230 . 140016) (
+\TEDIT.TEXTBIN.STRINGSETUP 140018 . 145731) (\TEDIT.TEXTBIN.FILESETUP 145733 . 152119) (
+\TEDIT.TEXTBIN.NEW.PAGE 152121 . 156962)) (156965 170373 (\TEXTPEEKBIN 156975 . 166114) (
+\TEDIT.PEEKBIN.NEW.PAGE 166116 . 170371)) (170411 175629 (CGETTEXTPROP 170421 . 170897) (CTEXTPROP 
+170899 . 173243) (GETTEXTPROP 173245 . 173840) (PUTTEXTPROP 173842 . 175167) (TEXTPROP 175169 . 175627
 )))))
 STOP

lispusers/BACKGROUND-YIELD

@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;3
 1644   
 
-      changes to%:  (FNS BACKGROUND-YIELD)
-                    (VARS BACKGROUND-YIELDCOMS)
+
(FILECREATED "14-Nov-2021 22:05:58" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;2
 1597   
 
-      previous date%: "19-Sep-2021 13:37:10" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
+      changes to%:  (VARS BACKGROUND-YIELD)
+
+      previous date%: "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
 
 
 (PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
@@ -44,7 +44,7 @@
 (INIT-YIELD
 T)
 )
 
-(RPAQQ BACKGROUND-YIELD
 8333330)
+(RPAQQ BACKGROUND-YIELD
 833333)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (879 1528 (BACKGROUND-YIELD 889 . 1144) (INIT-YIELD 1146 . 1526)))))
+  (FILEMAP (NIL (833 1482 (BACKGROUND-YIELD 843 . 1098) (INIT-YIELD 1100 . 1480)))))
 STOP

lispusers/DATE

@@ -1,531 +0,0 @@
-
(FILECREATED "18-Feb-87 15:42:27" {SUMEX-AIM}PS:<TMAX.SOURCES>DATE.;4
 19668  
-
-      previous date: "17-Feb-87 14:29:37" {SUMEX-AIM}<GILMURRAY.LISP>DATE.;7)
-
-
-(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
-
-(PRETTYCOMPRINT DATECOMS)
-
-(RPAQQ DATECOMS
 ((* Developed under support from NIH grant RR-00785.)
-	(* Written by Frank Gilmurray and Sami Shaio.)
-	(FNS DATEOBJ DATEOBJP DATE.DISPLAYFN DATE.IMAGEBOXFN CURRENT.DISPLAY.FONT DATE.PUTFN 
-	     DATE.GETFN DATE.BUTTONEVENTINFN DATES.TEMPLATE AMPM DATES.MENU.APPLY 
-	     DATES.MENU.WHENSELECTEDFN DATES.SET FINDDAY FINDHOUR FINDMONTH FINDTIME FINDYEAR NUMP 
-	     WHICHDATE)
-	(RECORDS DATEOBJ STREAM FONTCLASS)))
-
-
-
-(* Developed under support from NIH grant RR-00785.)

-
-
-
-
-(* Written by Frank Gilmurray and Sami Shaio.)

-
-(DEFINEQ
-
-(DATEOBJ

-  (LAMBDA (TEMPLATE)                                         (* fsg "23-Jul-86 09:53")

-                                                             (* Create an instance of a date imageobj.

-							     A dateobj is also defined as a record with a 

-							     datestring field. *)

-    (LET* ((TEMPLATE.TYPE (
OR
 TEMPLATE '(M D Y F)))
-	   (DATEANDTIME (
MKSTRING
 (
DATE
)))
-	   (DISPLAYDATE (
MKSTRING
 (DATES.TEMPLATE
 DATEANDTIME TEMPLATE.TYPE)))
-	   (NEWOBJ (
IMAGEOBJCREATE
 (create
 DATEOBJ
-					       DATESTRING _ DATEANDTIME
-					       DISPLAY.DATE _ DISPLAYDATE
-					       TEMPLATE.DATE _ TEMPLATE.TYPE)
-				     (
IMAGEFNSCREATE
 (
FUNCTION
 DATE.DISPLAYFN)
-						       (
FUNCTION
 DATE.IMAGEBOXFN)
-						       (
FUNCTION
 DATE.PUTFN)
-						       (
FUNCTION
 DATE.GETFN)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 DATE.BUTTONEVENTINFN)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 NILL)
-						       (
FUNCTION
 NILL)))))
-                                                             (* By convention, every image object will have a type 

-							     property associated with it that will facilitate 

-							     imageobj mapping in a TEdit file.)

-          (
IMAGEOBJPROP
 NEWOBJ 'TYPE
-			  'DATEOBJ)
-      NEWOBJ)))
-
-(DATEOBJP

-  (LAMBDA (IMOBJ)                                            (* ss: "24-Jun-85 16:33")

-
-          (* Tests an imageobj to see if it is a date imageobject. By convention, testing functions for an imageobject will 

-	  be named (CONCAT <type of imageobj> "P"))

-
-
-    (
AND
 IMOBJ (
EQ
 (
IMAGEOBJPROP
 IMOBJ 'TYPE)
-		       'DATEOBJ))))
-
-(DATE.DISPLAYFN

-  (LAMBDA (OBJ STREAM STREAMTYPE HOSTSTREAM)                 (* fsg "17-Feb-87 09:28")

-
-          (* * Display function for date imageobjs.)

-
-
-    (
PRIN1
 (fetch
 DISPLAY.DATE of
 (fetch
 OBJECTDATUM of
 OBJ))
-	     STREAM)))
-
-(DATE.IMAGEBOXFN

-  (LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN)                  (* fsg "15-Feb-87 14:05")

-
-          (* * Return the ImageBox for the date string. The size is determined by the stream's current font.)

-
-
-    (
DSPFONT
 (CURRENT.DISPLAY.FONT
 STREAM)
-	       STREAM)
-    (create
 IMAGEBOX
-	      XSIZE _(
STRINGWIDTH
 (fetch
 DISPLAY.DATE of
 (fetch
 OBJECTDATUM of
 OBJ))
-				    STREAM)
-	      YSIZE _(
FONTPROP
 STREAM 'HEIGHT)
-	      YDESC _(
FONTPROP
 STREAM 'DESCENT)
-	      XKERN _ 0)))
-
-(CURRENT.DISPLAY.FONT

-  (LAMBDA (STREAM)                                           (* fsg "17-Feb-87 10:19")

-
-          (* * Return the current font. This function is here instead of TMAX because the DATE code is also used in the 

-	  LetterHead code.)

-
-
-    (LET ((CURRENT.FONT (fetch
 CLFONT of
 (with
 TEXTSTREAM
-						     (
TEXTSTREAM
 (
CAR
 (fetch
 \WINDOW
-									     of
 TEXTOBJ)))
-						     CURRENTLOOKS))))
-         (
COND

-	   ((
TYPENAMEP
 CURRENT.FONT 'FONTDESCRIPTOR)
-	     CURRENT.FONT)
-	   ((
TYPENAMEP
 CURRENT.FONT 'FONTCLASS)
-	     (fetch
 DISPLAYFD of
 CURRENT.FONT))
-	   (T (
SHOULDNT
 "Can't get current font"))))))
-
-(DATE.PUTFN

-  (LAMBDA (DATEOBJ
 STREAM)                                 (* fsg " 4-Feb-87 09:40")

-    (
PRIN2
 (
LIST
 'Date
-		     (fetch
 (DATEOBJ
 TEMPLATE.DATE) of
 (fetch
 OBJECTDATUM of
 DATEOBJ)))
-	     STREAM)))
-
-(DATE.GETFN

-  (LAMBDA (STREAM)                                           (* fsg " 4-Feb-87 09:42")

-    (
OR
 (
WINDOWPROP
 (
PROCESSPROP
 (
THIS.PROCESS
)
-				       'WINDOW)
-			'IMAGEOBJ.MENUW)
-	  (
AND
 (
FGETD
 'TSP.FMMENU)
-		 (
TSP.FMMENU
 (
TEXTSTREAM
 (
PROCESSPROP
 (
THIS.PROCESS
)
-							    'WINDOW)))))
-    (
APPLY
 'DATEOBJ
-	     (
CDR
 (
READ
 STREAM)))))
-
-(DATE.BUTTONEVENTINFN

-  (LAMBDA (DATEOBJ
 WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
-                                                             (* fsg "26-Jan-87 10:06")

-    (
AND
 (MOUSESTATE MIDDLE)
-	   (LET ((DATE.MENU (create
 MENU
-				      TITLE _ "Date Menu"
-				      ITEMS _ '((Month% Day,% Year (DATES.TEMPLATE DATE
-										   '(M D Y F))
-								   
-						       "Insert current date as %"March 8, 1952%"")
-						(Month/Day/Year (DATES.TEMPLATE DATE '(M D Y A))
-								"Insert current date as %"3/8/52%"")
-						(Day% Month,% Year (DATES.TEMPLATE DATE
-										   '(D M Y F))
-								   
-						       "Insert current date as %"8 March, 1952%"")
-						(Day/Month/Year (DATES.TEMPLATE DATE '(D M Y A))
-								"Insert current date as %"8/3/52%"")
-						(Time (DATES.TEMPLATE DATE '(T F))
-						      "Insert current time as %"four thirty p.m.%"")
-						(Numbered% Time (DATES.TEMPLATE DATE '(T A))
-								
-							   "Insert current time as %"4:30 p.m.%"")
-						(Military% Time (DATES.TEMPLATE DATE '(T E))
-								"Insert current time as %"16:30%""))
-				      WHENSELECTEDFN _(
FUNCTION
 DATES.MENU.WHENSELECTEDFN))))
-	        (
PUTMENUPROP
 DATE.MENU 'IMAGEOBJ
-			       DATEOBJ)
-	        (
MENU
 DATE.MENU)
-	        'CHANGED))))
-
-(DATES.TEMPLATE

-  (LAMBDA (
DATE
 TEMPLATE)                                  (* fsg "24-Jul-86 14:43")

-
-          (* * comment)

-
-
-    (
COND

-      (TEMPLATE (LET ((VERSION (if
 (
EQUAL
 (
LAST
 TEMPLATE)
-					      '(A))
-				   then
 'ABBREV
-				 else
 (if
 (
EQUAL
 (
LAST
 TEMPLATE)
-						       '(F))
-					    then
 'FULL
-					  else
 'EURO)))
-		      (FUNCLST '((D FINDDAY)
-				 (M FINDMONTH)
-				 (Y FINDYEAR))))
-		     (
COND

-		       ((
EQ
 (
CAR
 TEMPLATE)
-			      T)
-			 (FINDTIME
 DATE VERSION))
-		       (T (LET ((CH (if
 (
EQ
 VERSION 'ABBREV)
-					then
 "/"
-				      else
 " ")))
-			       (
CONCAT
 (
APPLY
 (
CADR
 (
ASSOC
 (
CAR
 TEMPLATE)
-								   FUNCLST))
-						  (
LIST
 DATE VERSION))
-					 CH
-					 (
APPLY
 (
CADR
 (
ASSOC
 (
CADR
 TEMPLATE)
-								   FUNCLST))
-						  (
LIST
 DATE VERSION))
-					 (if
 (
EQUAL
 CH " ")
-					     then
 ", "
-					   else
 CH)
-					 (
APPLY
 (
CADR
 (
ASSOC
 (
CADDR
 TEMPLATE)
-								   FUNCLST))
-						  (
LIST
 DATE VERSION))))))))
-      (
DATE
))))
-
-(AMPM

-  (LAMBDA (HOUR)
-    (if
 (
OR
 (
LESSP
 (
MKATOM
 HOUR)
-			 12)
-		(
EQUAL
 (
MKATOM
 HOUR)
-			 24))
-	then
 "a.m."
-      else
 "p.m.")))
-
-(DATES.MENU.APPLY

-  (LAMBDA (ITEM MENU)                                        (* fsg "31-Jul-86 10:18")

-
-          (* This function serves the purpose of calculating the stream and the editing window from information stored on the

-	  window containing the menu. It then applies the appropiate function for each ITEM in the menu*)

-
-
-    (
SETQ
 ITEM (
COND

-	((
ATOM
 ITEM)
-	  ITEM)
-	(T (
CAR
 ITEM))))
-    (LET* ((DATE.RECORD (fetch
 OBJECTDATUM of
 (
GETMENUPROP
 MENU 'IMAGEOBJ)))
-	   (
DATE
 (fetch
 DATESTRING of
 DATE.RECORD)))
-          (
COND

-	    ((fetch
 ITEMS of
 MENU)
-	      (LET ((FUNCALL (
CADR
 (
ASSOC
 ITEM (fetch
 ITEMS of
 MENU)))))
-	           (replace
 DISPLAY.DATE of
 DATE.RECORD with
 (
EVAL
 FUNCALL))
-	           (replace
 TEMPLATE.DATE of
 DATE.RECORD with
 (
CADAR
 (
LAST
 FUNCALL)))))))))
-
-(DATES.MENU.WHENSELECTEDFN

-  (LAMBDA (ITEM MENU MB)                                     (* fsg "28-Jul-86 14:57")

-    (
COND

-      ((
OR
 (
EQ
 MB 'LEFT)
-	     (
EQ
 MB 'MIDDLE))
-	(DATES.MENU.APPLY
 ITEM MENU)))))
-
-(DATES.SET

-  (LAMBDA (PROPERTY VALUE)
-    (
WINDOWPROP
 (
CREATEW
)
-		  PROPERTY VALUE)
-    VALUE))
-
-(FINDDAY

-  (LAMBDA (OLDDATE VERSION)                                  (* shw: " 1-Jul-85 11:28")

-    (
MKATOM
 (if
 (NUMP
 (
SUBSTRING
 OLDDATE 1 2))
-		  then
 (
SUBSTRING
 OLDDATE 1 2)
-		else
 (
SUBSTRING
 OLDDATE 2 2)))))
-
-(FINDHOUR

-  (LAMBDA (HOUR)                                             (* ss: " 8-Feb-86 17:49")

-    (
COND

-      ((
LESSP
 (
MKATOM
 HOUR)
-		13)
-	(
COND

-	  ((
LESSP
 (
MKATOM
 HOUR)
-		    10)
-	    (
MKSTRING
 (
CADR
 (
UNPACK
 HOUR))))
-	  (T HOUR)))
-      (T (
MKSTRING
 (
SELECTQ
 (
MKATOM
 HOUR)
-				(13 1)
-				(14 2)
-				(15 3)
-				(16 4)
-				(17 5)
-				(18 6)
-				(19 7)
-				(20 8)
-				(21 9)
-				(22 10)
-				(23 11)
-				(24 12)
-				NIL))))))
-
-(FINDMONTH

-  (LAMBDA (OLDDATE VERSION)                                  (* shw: " 1-Jul-85 11:38")

-    (
PROG
 ((DATES '((Jan 1 January)
-		      (Feb 2 February)
-		      (Mar 3 March)
-		      (Apr 4 April)
-		      (May 5 May)
-		      (Jun 6 June)
-		      (Jul 7 July)
-		      (Aug 8 August)
-		      (Sep 9 September)
-		      (Oct 10 October)
-		      (Nov 11 November)
-		      (Dec 12 December)))
-	     (
OUTPUT
 NIL))
-	    (if
 (
EQ
 VERSION 'ABBREV)
-		then
 (
SETQ
 OUTPUT (
CAR
 (
CDR
 (
ASSOC
 (
MKATOM
 (
SUBSTRING
 OLDDATE 4 6))
-							     DATES))))
-	      else
 (
SETQ
 OUTPUT (
CAR
 (
CDDR
 (
ASSOC
 (
MKATOM
 (
SUBSTRING
 OLDDATE 4 6))
-							    DATES)))))
-	    (
RETURN
 OUTPUT))))
-
-(FINDTIME

-  (LAMBDA (OLDDATE VERSION)                                  (* shw: "24-Jul-85 15:39")

-    (LET ((HOUR (
SUBSTRING
 OLDDATE 11 12))
-	  (MINUTES (
SUBSTRING
 OLDDATE 14 15)))
-         (if
 (
EQUAL
 VERSION 'ABBREV)
-	     then
 (
CONCAT
 (FINDHOUR
 HOUR)
-			      ":" MINUTES " " (AMPM
 HOUR))
-	   else
 (if
 (
EQUAL
 VERSION 'EURO)
-		      then
 (
SUBSTRING
 OLDDATE 11 15)
-		    else
 (
CONCAT
 (
SELECTQ
 (if
 (
LESSP
 (
MKATOM
 MINUTES)
-							       46)
-						    then
 (
MKATOM
 (FINDHOUR
 HOUR))
-						  else
 (
PLUS
 1 (
MKATOM
 (FINDHOUR
 HOUR))))
-						(1 "one")
-						(2 "two")
-						(3 "three")
-						(4 "four")
-						(5 "five")
-						(6 "six")
-						(7 "seven")
-						(8 "eight")
-						(9 "nine")
-						(10 "ten")
-						(11 "eleven")
-						(12 "twelve")
-						NIL)
-				     " "
-				     (if
 (
AND
 (
GREATERP
 (
MKATOM
 MINUTES)
-							      15)
-						  (
LESSP
 (
MKATOM
 MINUTES)
-							   45))
-					 then
 "thirty"
-				       else
 "o'clock")
-				     " "
-				     (if
 (
AND
 (
GREATERP
 (
MKATOM
 MINUTES)
-							      44)
-						  (
EQUAL
 (FINDHOUR
 HOUR)
-							   "11"))
-					 then
 (if
 (
EQUAL
 (AMPM
 HOUR)
-							       "a.m.")
-						    then
 "p.m."
-						  else
 "a.m.")
-				       else
 (AMPM
 HOUR))))))))
-
-(FINDYEAR

-  (LAMBDA (OLDDATE VERSION)                                  (* shw: " 1-Jul-85 11:31")

-    (if
 (
EQ
 VERSION 'ABBREV)
-	then
 (
MKATOM
 (
SUBSTRING
 OLDDATE 8 9))
-      else
 (
MKATOM
 (
CONCAT
 "19" (
SUBSTRING
 OLDDATE 8 9))))))
-
-(NUMP

-  (LAMBDA (N)                                                (* edited: " 4-Apr-86 17:55")

-                                                             (* changed)

-    (
NOT
 (
NULL
 (
NUMBERP
 (
MKATOM
 N))))))
-
-(WHICHDATE

-  (LAMBDA (VAR1 VAR2 YEAR OLDDATE VERSION)                   (* edited " 1-Jan-00 00:00")

-
-          (* * comment)

-
-
-    (
PROG
 (DIVIDER)
-	    (
SETQ
 DIVIDER (if
 (
EQ
 VERSION 'ABBREV)
-				then
 "/"
-			      else
 " "))
-	    (
RETURN
 (
MKATOM
 (
CONCAT
 (
APPLY
 VAR1 (
LIST
 OLDDATE VERSION))
-					  DIVIDER
-					  (
APPLY
 VAR2 (
LIST
 OLDDATE VERSION))
-					  DIVIDER
-					  (
APPLY
 YEAR (
LIST
 OLDDATE VERSION))))))))
-)
-[DECLARE: EVAL@COMPILE 
-
-(RECORD DATEOBJ
 (DATESTRING DISPLAY.DATE TEMPLATE.DATE))
-
-(DATATYPE STREAM
 (                                         (* First 4 words are fixed for BIN, BOUT opcodes.

-							     Length of whole datatype is multiple of 4, so 

-							     quad-aligned)

-		    (COFFSET WORD)                           (* Offset in CPPTR of next bin or bout)

-		    (CBUFSIZE WORD)                          (* Offset past last byte in that buffer)

-		    (BINABLE FLAG)                           (* BIN punts unless this bit on)

-		    (BOUTABLE FLAG)                          (* BOUT punts unless this bit on)

-		    (EXTENDABLE FLAG)                        (* BOUT punts when COFFSET ge CBUFFSIZE unless this 

-							     bit set and COFFSET lt 512)

-		    (NIL BITS 5)
-		    (CBUFPTR POINTER)                        (* Pointer to current buffer)

-		    (NONDEFAULTDATEFLG FLAG)
-		    (REVALIDATEFLG FLAG)
-		    (MULTIBUFFERHINT FLAG)                   (* True if stream likes to read and write more than 

-							     one buffer at a time)

-		    (USERCLOSEABLE FLAG)                     (* Can be closed by CLOSEF;

-							     NIL for terminal, dribble...)

-		    (USERVISIBLE FLAG)                       (* Listed by OPENP; NIL for terminal, dribble ...)

-		    (ACCESSBITS BITS 3)                      (* What kind of access file is open for 

-							     (read, write, append))

-		    (FULLFILENAME POINTER)                   (* Name by which file is known to user)

-		    (DEVICE POINTER)                         (* FDEV of this guy)

-		    (VALIDATION POINTER)                     (* A number somehow identifying file, used to 

-							     determine if file has changed in our absence)

-		    (EPAGE WORD)
-		    (EOFFSET WORD)                           (* Page, byte offset of eof)

-                                                             (* Following are device-specific fields)

-		    (F1 POINTER)
-		    (F2 POINTER)
-		    (F3 POINTER)
-		    (F4 POINTER)
-		    (F5 POINTER)
-		    (FW6 WORD)
-		    (FW7 WORD)                               (* Following only filled in for open streams)

-		    (BYTESIZE BYTE)
-		    (BUFFS POINTER)
-		    (CPAGE WORD)
-		    (FW8 WORD)
-		    (MAXBUFFERS WORD)
-		    (CHARPOSITION WORD)                      (* Used by POSITION etc.)

-		    (DIRTYBITS WORD)
-		    (
LINELENGTH
 WORD)
-		    (EOLCONVENTION BITS 2)                   (* End-of-line convention)

-		    (CBUFDIRTY FLAG)
-		    (NIL BITS 5)
-		    (OUTCHARFN POINTER)
-		    (ENDOFSTREAMOP POINTER)                  (* For use of applications programs, not devices)

-		    (OTHERPROPS POINTER)
-		    (IMAGEOPS POINTER)                       (* Image operations vector)

-		    (IMAGEDATA POINTER)                      (* Image instance variables--format depends on 

-							     IMAGEOPS value)

-		    (EXTRASTREAMOP POINTER)
-		    (STRMBINFN POINTER)                      (* Either the BIN fn from the FDEV, or a trap)

-		    (STRMBOUTFN POINTER)                     (* Either the BIN fn from the FDEV, or a trap)

-		    (CBUFMAXSIZE WORD)
-		    (FW9 WORD)
-		    (F10 POINTER)                            (* the current character set for this stream.

-							     gbn 4-2-85)

-		    (
CHARSET
 BYTE))
-		   (
BLOCKRECORD
 STREAM ((NIL 2 WORD)
-				   (UCODEFLAGS BYTE)
-				   (NIL POINTER)))
-		   (
ACCESSFNS
 STREAM ((ACCESS \GETACCESS \SETACCESS)
-				 (
FULLNAME
 (
OR
 (fetch
 (STREAM FULLFILENAME) of
 DATUM)
-						   DATUM))
-				 (NAMEDP (
AND
 (fetch
 (STREAM FULLFILENAME) of
 DATUM)
-						T))))
-		   (
SYNONYM
 CBUFPTR (CPPTR))
-		   USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ NoBits BUFFS _ NIL BYTESIZE _ 8 
-		   CBUFPTR _ NIL MAXBUFFERS _(
PROGN
 (DECLARE
 (
GLOBALVARS
 
-								       \STREAM.DEFAULT.MAXBUFFERS))
-						      \STREAM.DEFAULT.MAXBUFFERS)
-		   CHARPOSITION _ 0 LINELENGTH _(
PROGN
 (DECLARE
 (
GLOBALVARS
 FILELINELENGTH))
-							 FILELINELENGTH)
-		   OUTCHARFN _(
FUNCTION
 \FILEOUTCHARFN)
-		   ENDOFSTREAMOP _(
FUNCTION
 \EOSERROR)
-		   IMAGEOPS _ \NOIMAGEOPS EOLCONVENTION _(
SELECTQ
 (
SYSTEMTYPE
)
-								    (D CR.EOLC)
-								    (VAX LF.EOLC)
-								    (JERICHO CRLF.EOLC)
-								    CR.EOLC)
-		   STRMBINFN _(
FUNCTION
 \STREAM.NOT.OPEN)
-		   STRMBOUTFN _(
FUNCTION
 \STREAM.NOT.OPEN))
-
-(DATATYPE FONTCLASS
 ((PRETTYFONT# BYTE)
-		       DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
-]
-(/DECLAREDATATYPE 'STREAM
-		  '(WORD WORD FLAG FLAG FLAG (BITS 5)
-			 POINTER FLAG FLAG FLAG FLAG FLAG (BITS 3)
-			 POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER 
-			 WORD WORD BYTE POINTER WORD WORD WORD WORD WORD WORD (BITS 2)
-			 FLAG
-			 (BITS 5)
-			 POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD 
-			 POINTER BYTE)
-		  '((STREAM 0 (BITS . 15))
-		    (STREAM 1 (BITS . 15))
-		    (STREAM 2 (FLAGBITS . 0))
-		    (STREAM 2 (FLAGBITS . 16))
-		    (STREAM 2 (FLAGBITS . 32))
-		    (STREAM 2 (BITS . 52))
-		    (STREAM 2 POINTER)
-		    (STREAM 4 (FLAGBITS . 0))
-		    (STREAM 4 (FLAGBITS . 16))
-		    (STREAM 4 (FLAGBITS . 32))
-		    (STREAM 4 (FLAGBITS . 48))
-		    (STREAM 4 (FLAGBITS . 64))
-		    (STREAM 4 (BITS . 82))
-		    (STREAM 4 POINTER)
-		    (STREAM 6 POINTER)
-		    (STREAM 8 POINTER)
-		    (STREAM 10 (BITS . 15))
-		    (STREAM 11 (BITS . 15))
-		    (STREAM 12 POINTER)
-		    (STREAM 14 POINTER)
-		    (STREAM 16 POINTER)
-		    (STREAM 18 POINTER)
-		    (STREAM 20 POINTER)
-		    (STREAM 22 (BITS . 15))
-		    (STREAM 23 (BITS . 15))
-		    (STREAM 20 (BITS . 7))
-		    (STREAM 24 POINTER)
-		    (STREAM 26 (BITS . 15))
-		    (STREAM 27 (BITS . 15))
-		    (STREAM 28 (BITS . 15))
-		    (STREAM 29 (BITS . 15))
-		    (STREAM 30 (BITS . 15))
-		    (STREAM 31 (BITS . 15))
-		    (STREAM 24 (BITS . 1))
-		    (STREAM 24 (FLAGBITS . 32))
-		    (STREAM 24 (BITS . 52))
-		    (STREAM 32 POINTER)
-		    (STREAM 34 POINTER)
-		    (STREAM 36 POINTER)
-		    (STREAM 38 POINTER)
-		    (STREAM 40 POINTER)
-		    (STREAM 42 POINTER)
-		    (STREAM 44 POINTER)
-		    (STREAM 46 POINTER)
-		    (STREAM 48 (BITS . 15))
-		    (STREAM 49 (BITS . 15))
-		    (STREAM 50 POINTER)
-		    (STREAM 50 (BITS . 7)))
-		  '52)
-(/DECLAREDATATYPE 'FONTCLASS
-		  '(BYTE POINTER POINTER POINTER POINTER POINTER)
-		  '((FONTCLASS 0 (BITS . 7))
-		    (FONTCLASS 0 POINTER)
-		    (FONTCLASS 2 POINTER)
-		    (FONTCLASS 4 POINTER)
-		    (FONTCLASS 6 POINTER)
-		    (FONTCLASS 8 POINTER))
-		  '10)
-(PUTPROPS DATE COPYRIGHT ("Leland Stanford Junior University" 1987))
-(DECLARE: DONTCOPY
-  (FILEMAP (NIL (850 12872 (DATEOBJ 862 . 2359) (DATEOBJP 2363 . 2736) (DATE.DISPLAYFN 2740 . 3015) (
-DATE.IMAGEBOXFN 3019 . 3575) (CURRENT.DISPLAY.FONT 3579 . 4284) (DATE.PUTFN 4288 . 4541) (DATE.GETFN 
-4545 . 4956) (DATE.BUTTONEVENTINFN 4960 . 6275) (DATES.TEMPLATE 6279 . 7439) (AMPM 7443 . 7615) (
-DATES.MENU.APPLY 7619 . 8538) (DATES.MENU.WHENSELECTEDFN 8542 . 8780) (DATES.SET 8784 . 8895) (FINDDAY
- 8899 . 9154) (FINDHOUR 9158 . 9662) (FINDMONTH 9666 . 10427) (FINDTIME 10431 . 11846) (FINDYEAR 11850
- . 12124) (NUMP 12128 . 12368) (WHICHDATE 12372 . 12869)))))
-STOP

lispusers/DINFO

@@ -1,15 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "14-Feb-2021 23:11:36" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;5
 64800  
 
-      changes to%:  (VARS DINFOCOMS)
+
(FILECREATED "25-Oct-2021 23:24:46" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;2
 65213  
 
-      previous date%: "14-Feb-2021 14:55:19" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;4)
+      changes to%:  (FNS DINFO.CREATE.FMENU)
+
+      previous date%: "14-Feb-2021 23:11:36" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;1)
 
 
 (* ; "
-Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
+Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DINFOCOMS)
@@ -19,24 +20,24 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS DINFOGRAPH DINFONODE)
                (FUNCTIONS DINFOGRAPHPROP))
         (INITRECORDS DINFOGRAPH)
-        (FNS                                                 (* ; "Primary functions")

+        (FNS                                                 (* ; "Primary functions")

              DINFO DINFO.UPDATE DINFOGRAPH DINFO.SPECIAL.UPDATE DINFO.READ.GRAPH DINFO.WRITE.GRAPH 
              DINFO.SELECT.GRAPH DINFO.DEFAULT.MENU DINFO.FIND DINFO.LOOKUP)
-        (FNS                                                 (* ; "Koto compatability")

+        (FNS                                                 (* ; "Koto compatability")

              DINFO.READ.KOTO.GRAPH)
-        (FNS                                                 (* ; "Window functions")

+        (FNS                                                 (* ; "Window functions")

              DINFO.SETUP.WINDOW DINFO.CLOSEFN DINFO.SHRINKFN DINFO.EXPANDFN DINFO.ICONFN)
-        (FNS                                                 (* ; "FreeMenu functions")

+        (FNS                                                 (* ; "FreeMenu functions")

              DINFO.ADD.FMENU DINFO.CREATE.FMENU DINFO.FMW.CLOSEFN DINFO.FMENU.HANDLER 
              DINFO.UPDATE.FMENU DINFO.TOGGLE.MENU DINFO.TOGGLE.GRAPH DINFO.TOGGLE.HISTORY 
              DINFO.TOGGLE.TEXT)
-        (FNS                                                 (* ; "Other menu functions")

+        (FNS                                                 (* ; "Other menu functions")

              DINFO.UPDATE.MENU.DISPLAY DINFO.UPDATE.FROM.MENU DINFO.UPDATE.HISTORY 
              DINFO.HISTORIC.UPDATE)
-        (FNS                                                 (* ; "Interface to GRAPHER")

+        (FNS                                                 (* ; "Interface to GRAPHER")

              DINFO.UPDATE.GRAPH.DISPLAY DINFO.UPDATE.FROM.GRAPH DINFO.GET.GRAPH.WINDOW 
              DINFO.CREATE.GRAPH.WINDOW DINFO.SHOWGRAPH DINFO.INVERT.NODE DINFO.LAYOUTGRAPH)
-        (FNS                                                 (* ; "Interface to TEdit")

+        (FNS                                                 (* ; "Interface to TEdit")

              DINFO.UPDATE.TEXT.DISPLAY DINFO.TITLEMENUFN DINFO.OPENTEXTSTREAM DINFO.SHOWSEL 
              DINFO.GET.FILENAME)
         (ADDVARS (BackgroundMenuCommands (DInfo (DINFO.SELECT.GRAPH)
@@ -539,14 +540,17 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
                 (DINFO.UPDATE.FMENU
 GRAPH])
 
 (DINFO.CREATE.FMENU

-  [LAMBDA (GRAPH)
                                            (* jow "15-Jul-86 17:39")

-          
-          (* * Makes a DInfo FreeMenu for GRAPH)

+  [LAMBDA (GRAPH)
                                       (* ; "Edited 25-Oct-2021 23:23 by rmk:")


+                                                             (* jow "15-Jul-86 17:39")

+
+(* ;;; "Makes a DInfo FreeMenu for GRAPH")

+
+    (* ;; "RMK:  Added MINSIZE and MAXSIZE so that the menu doesn't get distorted during reshaping")

 
     (LET* [(ADD.ITEMS (fetch
 (DINFOGRAPH
 FREEMENUITEMS) of
 GRAPH))
            (FONT (OR (FONTP (fetch
 (DINFOGRAPH
 MENUFONT) of
 GRAPH))
                      MENUFONT))
-           (FM (FREEMENU `((PROPS FONT %, FONT)
+           [FM (FREEMENU `((PROPS FONT %, FONT)
                            ((LABEL Node%: TYPE DISPLAY FONT (HELVETICA 10))
                             (ID NODE LABEL "" TYPE DISPLAY))
                            ((LABEL Top! SELECTEDFN DINFO.FMENU.HANDLER FONT (HELVETICA 10 BOLD)
@@ -585,8 +589,12 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
                                             (HELVETICA 10 BOLD)
                                             MESSAGE 
                             "Lookup a term in this graph.  LEFT for new term, MIDDLE to repeat last."
-                                            )) ADD.ITEMS]
+                                            ))
+                                  ADD.ITEMS]
+           (HEIGHT (FETCH
 (REGION HEIGHT) OF
 (WINDOWPROP FM 'REGION]
           (WINDOWPROP FM 'FM.DONTRESHAPE T)
+          (WINDOWPROP FM 'MINSIZE (CONS 0 HEIGHT))
+          (WINDOWPROP FM 'MAXSIZE (CONS 64000 HEIGHT))
           FM])
 
 (DINFO.FMW.CLOSEFN

@@ -1110,20 +1118,20 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
 )
 (PUTPROPS DINFO COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7732 24558 (DINFO 7742 . 9356) (DINFO.UPDATE 9358 . 12222) (DINFOGRAPH 12224 . 12642) (
-DINFO.SPECIAL.UPDATE 12644 . 14342) (DINFO.READ.GRAPH 14344 . 16199) (DINFO.WRITE.GRAPH 16201 . 17291)
- (DINFO.SELECT.GRAPH 17293 . 18200) (DINFO.DEFAULT.MENU 18202 . 20726) (DINFO.FIND 20728 . 23112) (
-DINFO.LOOKUP 23114 . 24556)) (24559 27253 (DINFO.READ.KOTO.GRAPH 24569 . 27251)) (27254 29568 (
-DINFO.SETUP.WINDOW 27264 . 27945) (DINFO.CLOSEFN 27947 . 28380) (DINFO.SHRINKFN 28382 . 28578) (
-DINFO.EXPANDFN 28580 . 29137) (DINFO.ICONFN 29139 . 29566)) (29569 40417 (DINFO.ADD.FMENU 29579 . 
-30674) (DINFO.CREATE.FMENU 30676 . 34213) (DINFO.FMW.CLOSEFN 34215 . 35060) (DINFO.FMENU.HANDLER 35062
- . 35701) (DINFO.UPDATE.FMENU 35703 . 37908) (DINFO.TOGGLE.MENU 37910 . 38500) (DINFO.TOGGLE.GRAPH 
-38502 . 39001) (DINFO.TOGGLE.HISTORY 39003 . 39547) (DINFO.TOGGLE.TEXT 39549 . 40415)) (40418 48116 (
-DINFO.UPDATE.MENU.DISPLAY 40428 . 44448) (DINFO.UPDATE.FROM.MENU 44450 . 44749) (DINFO.UPDATE.HISTORY 
-44751 . 47285) (DINFO.HISTORIC.UPDATE 47287 . 48114)) (48117 58283 (DINFO.UPDATE.GRAPH.DISPLAY 48127
- . 49445) (DINFO.UPDATE.FROM.GRAPH 49447 . 49890) (DINFO.GET.GRAPH.WINDOW 49892 . 50477) (
-DINFO.CREATE.GRAPH.WINDOW 50479 . 51596) (DINFO.SHOWGRAPH 51598 . 53323) (DINFO.INVERT.NODE 53325 . 
-54713) (DINFO.LAYOUTGRAPH 54715 . 58281)) (58284 64140 (DINFO.UPDATE.TEXT.DISPLAY 58294 . 60155) (
-DINFO.TITLEMENUFN 60157 . 61282) (DINFO.OPENTEXTSTREAM 61284 . 62500) (DINFO.SHOWSEL 62502 . 63235) (
-DINFO.GET.FILENAME 63237 . 64138)))))
+  (FILEMAP (NIL (7733 24559 (DINFO 7743 . 9357) (DINFO.UPDATE 9359 . 12223) (DINFOGRAPH 12225 . 12643) (
+DINFO.SPECIAL.UPDATE 12645 . 14343) (DINFO.READ.GRAPH 14345 . 16200) (DINFO.WRITE.GRAPH 16202 . 17292)
+ (DINFO.SELECT.GRAPH 17294 . 18201) (DINFO.DEFAULT.MENU 18203 . 20727) (DINFO.FIND 20729 . 23113) (
+DINFO.LOOKUP 23115 . 24557)) (24560 27254 (DINFO.READ.KOTO.GRAPH 24570 . 27252)) (27255 29569 (
+DINFO.SETUP.WINDOW 27265 . 27946) (DINFO.CLOSEFN 27948 . 28381) (DINFO.SHRINKFN 28383 . 28579) (
+DINFO.EXPANDFN 28581 . 29138) (DINFO.ICONFN 29140 . 29567)) (29570 40830 (DINFO.ADD.FMENU 29580 . 
+30675) (DINFO.CREATE.FMENU 30677 . 34626) (DINFO.FMW.CLOSEFN 34628 . 35473) (DINFO.FMENU.HANDLER 35475
+ . 36114) (DINFO.UPDATE.FMENU 36116 . 38321) (DINFO.TOGGLE.MENU 38323 . 38913) (DINFO.TOGGLE.GRAPH 
+38915 . 39414) (DINFO.TOGGLE.HISTORY 39416 . 39960) (DINFO.TOGGLE.TEXT 39962 . 40828)) (40831 48529 (
+DINFO.UPDATE.MENU.DISPLAY 40841 . 44861) (DINFO.UPDATE.FROM.MENU 44863 . 45162) (DINFO.UPDATE.HISTORY 
+45164 . 47698) (DINFO.HISTORIC.UPDATE 47700 . 48527)) (48530 58696 (DINFO.UPDATE.GRAPH.DISPLAY 48540
+ . 49858) (DINFO.UPDATE.FROM.GRAPH 49860 . 50303) (DINFO.GET.GRAPH.WINDOW 50305 . 50890) (
+DINFO.CREATE.GRAPH.WINDOW 50892 . 52009) (DINFO.SHOWGRAPH 52011 . 53736) (DINFO.INVERT.NODE 53738 . 
+55126) (DINFO.LAYOUTGRAPH 55128 . 58694)) (58697 64553 (DINFO.UPDATE.TEXT.DISPLAY 58707 . 60568) (
+DINFO.TITLEMENUFN 60570 . 61695) (DINFO.OPENTEXTSTREAM 61697 . 62913) (DINFO.SHOWSEL 62915 . 63648) (
+DINFO.GET.FILENAME 63650 . 64551)))))
 STOP

lispusers/MODERNIZE

@@ -1,92 +1,95 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED " 8-Jul-2021 23:33:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;16
 23978  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS MODERNWINDOW)
+
(FILECREATED "16-Oct-2021 15:42:11" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41
 30305  
 
-      previous date%: " 3-Jul-2021 10:32:03" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;15)
+      changes to%:  (FNS MODERNIZED.TB.BUTTONEVENTFN)
+
+      previous date%: "16-Oct-2021 15:29:38" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
 
 (RPAQQ MODERNIZECOMS

        [
-        (* ;; "Externals")

+        (* ;; "Externals")

 
-        (COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP)
+        (COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP 
+                   \MODERNIZED.FREEMENU.BUTTONEVENTFN)
               (INITVARS (MODERN-WINDOW-MARGIN 25)))
         
-        (* ;; "Internals")

+        (* ;; "Internals")

 
         [COMS (FNS MODERNWINDOW.BUTTONEVENTFN NEARTOP NEARESTCORNER INCORNER.REGION)
               
-              (* ;; "Behavior for some known window creators")

+              (* ;; "Behavior for some known window creators")

 
               (FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN)
+              (FNS \MODERNIZED.FREEMENU.BUTTONEVENTFN MODERNIZED.TB.BUTTONEVENTFN)
               
-              (* ;; "Add some Meta commands")

+              (* ;; "Add some Meta commands")

 
-              (FNS TEDIT.MODERNIZE TEDIT.SELECTALL)
+              (FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN TEDIT.SELECTALL)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P 
-                                                 (* ;; "Tedit")

+                                                 (* ;; "Tedit")

 
-                                                 (MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
                                                  (TEDIT.MODERNIZE)
                                                  
-                                                 (* ;; "Inspector")

+                                                 (* ;; "Inspector")

 
                                                  (MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
                                                  
 
-                                 (* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

+                                 (* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

 
                                                  (* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
                                                  (MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
                                                  
-                                                 (* ;; "Freemenu")

+                                                 (* ;; "File browser")

 
-                                                 (MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN)
+                                                 (MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN 
+                                                        '\MODERNIZED.FREEMENU.BUTTONEVENTFN)
                                                  
-                                                 (* ;; "SEDIT")

+                                                 (* ;; "SEDIT")

 
                                                  (MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
                                                  
-                                                 (* ;; "Debugger")

+                                                 (* ;; "Debugger")

 
                                                  (MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
                                                  
-                                                 (* ;; "Snap")

+                                                 (* ;; "Snap")

 
                                                  (MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW)
                                                  
-                                                 (* ;; "New execs")

+                                                 (* ;; "New execs")

 
                                                  (MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC)
                                                  
-                                                 (* ;; "Existing exec of the load")

+                                                 (* ;; "Existing exec of the load")

 
                                                  (MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
                                                                       'WINDOW))
                                                  
-                                                 (* ;; "Table browser (for filebrowser)")

+                                                 (* ;; "Table browser  and filebrowser)")

 
-                                                 (MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN)
+                                                 (MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN 
+                                                        'MODERNIZED.TB.BUTTONEVENTFN)
                                                  
-                                                 (* ;; "Grapher")

+                                                 (* ;; "Grapher")

 
                                                  (MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE)
                                                  
-                                                 (* ;; "Sketch")

+                                                 (* ;; "Sketch")

 
                                                  (MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)
                                                  
-                                                 (* ;; "Promptwindow")

+                                                 (* ;; "Promptwindow")

 
                                                  (MODERNWINDOW PROMPTWINDOW T)
                                                  
-                                                 (* ;; 
-
                                               "Menus:  Move only and only with title clicks")

+                                                 (* ;; "Menus:  Move only with title clicks")

 
                                                  (MODERNWINDOW.SETUP 'MENUBUTTONFN 
                                                         'MODERN-MENUBUTTONFN]
@@ -191,6 +194,17 @@
                                   PKGNAME))
          (CL:WHEN (GETD RENAMEDORIG)
                 (MOVD RENAMEDORIG ORIGFN])
+
+(\MODERNIZED.FREEMENU.BUTTONEVENTFN

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 13-Oct-2021 15:15 by rmk:")

+
+    (* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping.  In fact, if the menu window has a main window, use the main window's  region as the cornerregion")

+
+    (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
+           NIL NIL (WINDOWPROP (CENTRALWINDOW W)
+                          'REGION)
+           (WINDOWPROP (CENTRALWINDOW W)
+                  'TITLE])
 )
 
 (RPAQ? MODERN-WINDOW-MARGIN
 25)
@@ -202,39 +216,67 @@
 (DEFINEQ
 
 (MODERNWINDOW.BUTTONEVENTFN

-  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION)
(* ; "Edited 24-Jun-2021 14:49 by rmk:")

-    (IF
 (AND (MOUSESTATE (ONLY LEFT))
-                 (EQ LASTKEYBOARD 0))
-        THEN
 (TOTOPW WINDOW)
-              (LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION))
-                          (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW]
+  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)

+                                                            (* ; "Edited 16-Oct-2021 15:25 by rmk:")

 
-                   (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window.  The TOPMARGIN should be 0 in that case.")

+    (* ;; "WINDOW is the window  that received the click and that should be passed through to the original function, if we don't pick it off here.")

 
-                   (* ;; "This is particularly the case of FILEBROWSER windows, where the the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")

+    (* ;; "However, that window may be an auxiliary window (an attached menu? or a lower split-pane in Tedit) whose region and title intuitively should not be used to control shaping and moving behavior.  That behavior is determined by the CORNERREGION and TITLED parameters.")

 
-                   (SETQ TOPMARGIN (IF
 (WINDOWPROP WINDOW 'TOPMARGIN)
-                                     ELSEIF
 (WINDOWPROP WINDOW 'TITLE)
-                                       THEN
 (FONTPROP WindowTitleDisplayStream 'HEIGHT)
-                                     ELSE
 MODERN-WINDOW-MARGIN))
-                   (SETQ CORNER (INCORNER.REGION
 MAINREGION TOPMARGIN))
-                   (IF
 CORNER
-                       THEN
 
+    (* ;; "If CORNERREGION is given, we know that there are two windows in play.  In that case also  TOPMARGIN  tells us the hotband at the top of the cornerregion where the move/shaping click is recognized, T to mean that it has an ordinary title bar. .")

 
-                             (* ;; 
-
       "The upper corners may be in the title bar, near the side, so test corners before titlebar.")

+    (* ;; "For windows without a top margin, the shape/move region is MODERN-WINDOW-MARGIN points below the top, in the clipping region of the window. ")

 
-                             (* ;; "We are in the corner of the main window, so we are reshaping.  But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")

+    (* ;; "Not sure about using MODERN-WINDOW-MARGIN for the top region of an untitle window.  Maybe it should be 2 times the border width in that case, and the MODERN-WINDOW-MARGIN separately defines the rectangle that constitutes a corner.")

 
-                             (* ;; "WINDOWREGION includes the attached windows")

+    (LET (CORNER ATTACHEDREGION)
+         (IF
 CORNERREGION
+             THEN
 
 
-                             (LET ((LEFT (FETCH
 LEFT OF
 ATTACHEDREGION))
-                                   (RIGHT (FETCH
 RIGHT OF
 ATTACHEDREGION))
-                                   (TOP (FETCH
 TOP OF
 ATTACHEDREGION))
-                                   (BOTTOM (FETCH
 BOTTOM OF
 ATTACHEDREGION))
+                   (* ;; "Caller tells us whether the corner window has a title.")

+
+                   (CL:UNLESS (FIXP TOPMARGIN)
+                       (SETQ TOPMARGIN (if
 TOPMARGIN
+                                           then
 (FONTPROP WindowTitleDisplayStream 'HEIGHT)
+                                         else
 MODERN-WINDOW-MARGIN)))
+           ELSE
 (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION)) 
+                                                             (* ; "WINDOW is the corner window")

+                 (SETQ TOPMARGIN (if
 (WINDOWPROP WINDOW 'TOPMARGIN)
+                                   elseif
 (WINDOWPROP WINDOW 'TITLE)
+                                     then
 (FONTPROP WindowTitleDisplayStream 'HEIGHT)
+                                   else
 MODERN-WINDOW-MARGIN)))
+         (if
 (AND (MOUSESTATE (ONLY LEFT))
+                      (EQ LASTKEYBOARD 0)
+                      (INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY))
+             then
 
+
+                   (* ;; "INSIDE? check because we may be called by a click in WINDOW that is outside the corner region, we just pass it through.")

+
+                   (TOTOPW WINDOW)
+                   (SETQ ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW))) 
+
+                   (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window.  The TOPMARGIN should be 0 in that case.")

+
+                   (* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")

+
+                   (SETQ CORNER (INCORNER.REGION
 CORNERREGION TOPMARGIN))
+                   (if
 CORNER
+                       then
 
+
+                             (* ;; 
+
       "The upper corners may be in the title bar, near the side, so test corners before titlebar.")

+
+                             (* ;; "We are in the corner of the main window, so we are reshaping.  But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")

+
+                             (* ;; "WINDOWREGION includes the attached windows")

+
+                             (LET ((LEFT (fetch
 (REGION LEFT) of
 ATTACHEDREGION))
+                                   (RIGHT (fetch
 (REGION RIGHT) of
 ATTACHEDREGION))
+                                   (TOP (fetch
 (REGION TOP) of
 ATTACHEDREGION))
+                                   (BOTTOM (fetch
 (REGION BOTTOM) of
 ATTACHEDREGION))
                                    STARTINGREGION)
 
-                                 (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")

+                                 (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")

 
                                   (CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
                                       [SETQ STARTINGREGION
@@ -253,35 +295,32 @@
                                                            (GETMOUSESTATE)
                                                            (LIST RIGHT BOTTOM LEFT TOP))
                                                   (SHOULDNT])
-                                  (SHAPEW (CL:IF (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
-                                              (WINDOWPROP WINDOW 'MAINWINDOW)
-                                              WINDOW)
+                                  (SHAPEW (CENTRALWINDOW WINDOW)
                                          STARTINGREGION))
                              T
-                     ELSEIF
 (OR ANYWHERE (NEARTOP
 MAINREGION TOPMARGIN TITLEPROPORTION))
-                       THEN
 (NEARESTCORNER
 ATTACHEDREGION)
-                             (MOVEW (CL:IF (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
-                                        (WINDOWPROP WINDOW 'MAINWINDOW)
-                                        WINDOW))
+                     elseif
 (OR ANYWHERE (NEARTOP
 CORNERREGION TOPMARGIN TITLEPROPORTION))
+                       then
 (NEARESTCORNER
 ATTACHEDREGION)
+                             (MOVEW (CENTRALWINDOW WINDOW))
                              T
-                     ELSEIF
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 
+                     elseif
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 
                                                                            'PREMODERN-BUTTONEVENTFN]
-                       THEN
 (APPLY* ORIGFUNCTION WINDOW)))
-      ELSEIF
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
-        THEN
 (APPLY* ORIGFUNCTION WINDOW])
+                       then
 (APPLY* ORIGFUNCTION WINDOW))
+           elseif
 [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 
+                                                                 'PREMODERN-BUTTONEVENTFN]
+             then
 (APPLY* ORIGFUNCTION WINDOW])
 
 (NEARTOP

-  [LAMBDA (MAINREGION TOPMARGIN TITLEPROPORTION)
        (* ; "Edited 24-Jun-2021 14:51 by rmk:")

+  [LAMBDA (CORNERREGION TOPMARGIN TITLEPROPORTION)
      (* ; "Edited 13-Oct-2021 21:28 by rmk:")

 
-    (* ;; "True if the MOUSEY is near the top of MAINREGION.  That means in the title bar for titled windows, otherwise a short distance below the top of the window.  (Could be in the border?)")

+    (* ;; "True if the MOUSEY is near the top of CORNERREGION.  That means in the title bar for titled windows, otherwise a short distance below the top of the window.  (Could be in the border?)")

 
-    (* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")

+    (* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")

 
-    (AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH
 TOP OF
 MAINREGION)
+    (AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH
 TOP OF
 CORNERREGION)
                                       TOPMARGIN))
          (OR (NOT TITLEPROPORTION)
-             (LET ((WIDTH (FETCH
 WIDTH of
 MAINREGION))
-                   (LEFT (FETCH
 LEFT OF
 MAINREGION)))
+             (LET ((WIDTH (FETCH
 WIDTH of
 CORNERREGION))
+                   (LEFT (FETCH
 LEFT OF
 CORNERREGION)))
                   (OR (ILESSP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH TITLEPROPORTION)))
                       (IGREATERP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH (DIFFERENCE 1 TITLEPROPORTION])
 
@@ -303,25 +342,25 @@
                (FETCH
 TOP OF
 REGION))])
 
 (INCORNER.REGION

-  [LAMBDA (MAINREGION TOPMARGIN)
                        (* ; "Edited 22-Feb-2021 16:27 by rmk:")

+  [LAMBDA (CORNERREGION TOPMARGIN)
                      (* ; "Edited 13-Oct-2021 15:04 by rmk:")

 
-    (* ;; "MAINREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")

+    (* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")

 
-    (* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")

+    (* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")

 
-    (IF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 LEFT OF
 MAINREGION)))
+    (IF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 LEFT OF
 CORNERREGION)))
                   MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 MAINREGION TOPMARGIN)
+        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
                      THEN
 'LEFTTOP
                    ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 MAINREGION)))
+                                                                              OF
 CORNERREGION)))
                      THEN
 'LEFTBOTTOM)
-      ELSEIF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 RIGHT OF
 MAINREGION)))
+      ELSEIF
 (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH
 RIGHT OF
 CORNERREGION)))
                        MODERN-WINDOW-MARGIN)
-        THEN
 (IF
 (NEARTOP
 MAINREGION TOPMARGIN)
+        THEN
 (IF
 (NEARTOP
 CORNERREGION TOPMARGIN)
                      THEN
 'RIGHTTOP
                    ELSEIF
 (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH
 BOTTOM
-                                                                              OF
 MAINREGION)))
+                                                                              OF
 CORNERREGION)))
                      THEN
 'RIGHTBOTTOM])
 )
 
@@ -383,6 +422,44 @@
              THEN
 (MOVEW WINDOW)
            ELSE
 (MODERN-ORIG-MENUBUTTONFN WINDOW])
 )
+(DEFINEQ
+
+(\MODERNIZED.FREEMENU.BUTTONEVENTFN

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 13-Oct-2021 15:15 by rmk:")

+
+    (* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping.  In fact, if the menu window has a main window, use the main window's  region as the cornerregion")

+
+    (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
+           NIL NIL (WINDOWPROP (CENTRALWINDOW W)
+                          'REGION)
+           (WINDOWPROP (CENTRALWINDOW W)
+                  'TITLE])
+
+(MODERNIZED.TB.BUTTONEVENTFN

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 16-Oct-2021 15:40 by rmk:")

+
+    (* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping.  In fact, if the menu window has a main window, use the main window's  region as the cornerregion")

+
+    (LET ((CW (CENTRALWINDOW W))
+          CORNERREG TOPMARGIN)
+         (CL:WHEN (WINDOWPROP CW 'FILEBROWSER)
+             [SETQ CORNERREG (UNIONREGIONS (WINDOWPROP (FB.GETWINDOW CW 'HEADING)
+                                                  'REGION)
+                                    (WINDOWPROP (FB.GETWINDOW CW 'COUNTER)
+                                           'REGION)
+                                    (WINDOWPROP (FB.GETWINDOW CW 'BROWSER)
+                                           'REGION]
+             [SETQ TOPMARGIN (IPLUS (FETCH
 (REGION HEIGHT) OF
 (WINDOWPROP (FB.GETWINDOW
+                                                                                   CW
+                                                                                   'HEADING)
+                                                                             'REGION))
+                                    (FETCH
 (REGION HEIGHT) OF
 (WINDOWPROP (FB.GETWINDOW
+                                                                                   CW
+                                                                                   'COUNTER)
+                                                                             'REGION])
+         (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-TB.BUTTONEVENTFN)
+                NIL NIL CORNERREG TOPMARGIN])
+)
 
 
 
@@ -391,10 +468,12 @@
 (DEFINEQ
 
 (TEDIT.MODERNIZE

-  [LAMBDA NIL
                                           (* ; "Edited 24-Jun-2021 20:54 by rmk:")

+  [LAMBDA NIL
                                           (* ; "Edited 11-Oct-2021 15:02 by rmk:")

+    (MODERNWINDOW.SETUP
 (FUNCTION \TEDIT.BUTTONEVENTFN)
+           (FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN))
     (CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN)
 
-        (* ;; "All")

+        (* ;; "All")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,a")
                (FUNCTION TEDIT.SELECTALL)
@@ -403,7 +482,7 @@
                (FUNCTION TEDIT.SELECTALL)
                TEDIT.READTABLE)
 
-        (* ;; "Quit")

+        (* ;; "Quit")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,q")
                (FUNCTION TEDIT.QUIT)
@@ -412,6 +491,21 @@
                (FUNCTION TEDIT.QUIT)
                TEDIT.READTABLE))])
 
+(\MODERNIZED.TEDIT.BUTTONEVENTFN

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 13-Oct-2021 21:43 by rmk:")

+
+    (* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window.  Clicks near the split lines must be ignored.  Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")

+
+    (* ;; "We pass the pain that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")

+
+    (MODERNWINDOW.BUTTONEVENTFN
 W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
+           NIL NIL [APPLY (FUNCTION UNIONREGIONS)
+                          (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE
+                                                                                'REGION)
+                             repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
+           (WINDOWPROP (CENTRALWINDOW W)
+                  'TITLE])
+
 (TEDIT.SELECTALL

   [LAMBDA (STREAM TEXTOBJ SEL)
                          (* ; "Edited  3-May-2020 17:29 by rmk:")

     (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
@@ -422,91 +516,89 @@
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 
-(* ;; "Tedit")

+(* ;; "Tedit")

 
 
-(MODERNWINDOW.SETUP
 '\TEDIT.BUTTONEVENTFN)
-
 (TEDIT.MODERNIZE
)
 
 
-(* ;; "Inspector")

+(* ;; "Inspector")

 
 
 (MODERNWINDOW.SETUP
 '\ITEM.WINDOW.BUTTON.HANDLER)
 
 
-(* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

+(* ;; "Commonlisp array inspector.  If you move the main window, the little attached window doesn't move.  But if you move the attached window, it all works.  Needs a special definition.  Shaping doesn't work either")

 
 
-                                                             (* (MODERNWINDOW.SETUP
-
                                                           (QUOTE ONEDINSPECT.BUTTONEVENTFN)))

+                                                             (* (MODERNWINDOW.SETUP
+
                                                           (QUOTE ONEDINSPECT.BUTTONEVENTFN)))

 
 (MODERNWINDOW.SETUP
 'ICMLARRAY.TITLECOMMANDFN)
 
 
-(* ;; "Freemenu")

+(* ;; "File browser")

 
 
-(MODERNWINDOW.SETUP
 '\FM.BUTTONEVENTFN)
+(MODERNWINDOW.SETUP
 '\FM.BUTTONEVENTFN '\MODERNIZED.FREEMENU.BUTTONEVENTFN)
 
 
-(* ;; "SEDIT")

+(* ;; "SEDIT")

 
 
 (MODERNWINDOW.SETUP
 'SEDIT::BUTTONEVENTFN)
 
 
-(* ;; "Debugger")

+(* ;; "Debugger")

 
 
 (MODERNWINDOW.SETUP
 'DBG::DEBUGGER-BUTTON-EVENT)
 
 
-(* ;; "Snap")

+(* ;; "Snap")

 
 
 (MODERNWINDOW.SETUP
 'SNAPW 'MODERN-SNAPW)
 
 
-(* ;; "New execs")

+(* ;; "New execs")

 
 
 (MODERNWINDOW.SETUP
 'ADD-EXEC 'MODERN-ADD-EXEC)
 
 
-(* ;; "Existing exec of the load")

+(* ;; "Existing exec of the load")

 
 
 (MODERNWINDOW
 (PROCESSPROP (TTY.PROCESS)
                          'WINDOW))
 
 
-(* ;; "Table browser (for filebrowser)")

+(* ;; "Table browser  and filebrowser)")

 
 
-(MODERNWINDOW.SETUP
 'TB.BUTTONEVENTFN)
+(MODERNWINDOW.SETUP
 'TB.BUTTONEVENTFN 'MODERNIZED.TB.BUTTONEVENTFN)
 
 
-(* ;; "Grapher")

+(* ;; "Grapher")

 
 
 (MODERNWINDOW.SETUP
 'APPLYTOSELECTEDNODE)
 
 
-(* ;; "Sketch")

+(* ;; "Sketch")

 
 
 (MODERNWINDOW.SETUP
 'WB.BUTTON.HANDLER)
 
 
-(* ;; "Promptwindow")

+(* ;; "Promptwindow")

 
 
 (MODERNWINDOW
 PROMPTWINDOW T)
 
 
-(* ;; "Menus:  Move only and only with title clicks")

+(* ;; "Menus:  Move only with title clicks")

 
 
 (MODERNWINDOW.SETUP
 'MENUBUTTONFN 'MODERN-MENUBUTTONFN)
@@ -520,10 +612,12 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4933 10561 (MODERNWINDOW 4943 . 6398) (MODERNWINDOW.SETUP 6400 . 9349) (UNMODERNWINDOW 
-9351 . 9745) (MODERNWINDOW.UNSETUP 9747 . 10559)) (10626 18766 (MODERNWINDOW.BUTTONEVENTFN 10636 . 
-15663) (NEARTOP 15665 . 16585) (NEARESTCORNER 16587 . 17466) (INCORNER.REGION 17468 . 18764)) (18824 
-21146 (MODERN-ADD-EXEC 18834 . 19265) (MODERN-SNAPW 19267 . 19810) (TOTOPW.MODERNIZE 19812 . 20240) (
-MODERN-MENUBUTTONFN 20242 . 21144)) (21187 22227 (TEDIT.MODERNIZE 21197 . 21896) (TEDIT.SELECTALL 
-21898 . 22225)))))
+  (FILEMAP (NIL (5135 11412 (MODERNWINDOW 5145 . 6600) (MODERNWINDOW.SETUP 6602 . 9551) (UNMODERNWINDOW 
+9553 . 9947) (MODERNWINDOW.UNSETUP 9949 . 10761) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10763 . 11410)) (
+11477 21412 (MODERNWINDOW.BUTTONEVENTFN 11487 . 18287) (NEARTOP 18289 . 19217) (NEARESTCORNER 19219 . 
+20098) (INCORNER.REGION 20100 . 21410)) (21470 23792 (MODERN-ADD-EXEC 21480 . 21911) (MODERN-SNAPW 
+21913 . 22456) (TOTOPW.MODERNIZE 22458 . 22886) (MODERN-MENUBUTTONFN 22888 . 23790)) (23793 26222 (
+\MODERNIZED.FREEMENU.BUTTONEVENTFN 23803 . 24450) (MODERNIZED.TB.BUTTONEVENTFN 24452 . 26220)) (26263 
+28542 (TEDIT.MODERNIZE 26273 . 27087) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27089 . 28211) (TEDIT.SELECTALL
+ 28213 . 28540)))))
 STOP

lispusers/MODERNIZE.TXT

@@ -30,7 +30,7 @@ When the package is loaded, this behavior is installed for the following kinds o
 
 The function MODERNWINDOW.SETUP establishes the new behavior for classes of windows:
 
-(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE)
+(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE TITLEPROPORTION)
 
 ORIGFN is either the name of the BUTTONEVENTFN for a class of windows (e.g. \TEDIT.BUTTONEVENTFN for Tedit windows) or it is a function that creates windows of a particulate kind (e.g. SNAPW or ADD-EXEC).
 
@@ -60,7 +60,7 @@ Provided these capabilities are already loaded, the following window classes are
 
 If it is not known or it is inconvenient to systematically upgrade a button function or a window-creation function, the new behavior can be provided after a particular window has been created, by invoking
 
-(MODERNWINDOW WINDOW ANYWHERE)
+(MODERNWINDOW WINDOW ANYWHERE TITLEPROPORTION)
 
 This saves the windows existing BUTTONEVENTFN as a window property PREMODERN-BUTTONEVENTFN, and installs a simple stub function in its place.
 
@@ -70,7 +70,9 @@ If things go awry:
 
 (UNMODERNWINDOW WINDOW) restores a modernized window (via MACWINDOW) to its original state.
 
-Known issue:  Clicking at the bottom-right corner of Tedit windows sometimes doesn't catch the new behavior--there seems to be a conflict with Tedit's window-splitting conventions. Clicking a little further into the window seems more reliable.
+Known issues:  
+
+Clicking at the bottom of an EXEC window running TTYIN is effective only when the input line is empty.
 
 
 

lispusers/PLAINTEXTSTREAM

@@ -1,282 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "15-Jan-98 09:49:00" {DSK}<project>medley2.0>lispusers>PLAINTEXTSTREAM.;48
 16624  
-
-      changes to%:  (FNS WRITEPLAINTEXTPAGE PLAINTEXTOUTCHARFN OPENPLAINTEXTSTREAM CLEARPLAINTEXTPAGE
-                         MAKEPLAINTEXTPAGE)
-                    (MACROS PLAINTEXTPARAM)
-                    (VARS PLAINTEXTSTREAMCOMS)
-                    (RECORDS PLAINTEXTIMAGEDATA)
-
-      previous date%: "11-Jan-98 23:04:10" {DSK}<project>medley2.0>lispusers>PLAINTEXTSTREAM.;29)
-
-
-(* ; "
-Copyright (c) 1998 by Xerox Corporation.  All rights reserved.
-")
-
-(PRETTYCOMPRINT PLAINTEXTSTREAMCOMS)
-
-(RPAQQ PLAINTEXTSTREAMCOMS

-       [(ADDVARS (DEFAULTFILETYPELIST (PLAINTEXT . TEXT)
-                        (PT . TEXT)))
-        (FNS OPENPLAINTEXTSTREAM PLAINTEXTOUTCHARFN PLAINTEXT.TEDIT PLAINTEXT.TEXT)
-        (FNS WRITEPLAINTEXTPAGE)
-        (MACROS PLAINTEXTPARAM)
-        (RECORDS PLAINTEXTIMAGEDATA)
-        [ADDVARS [PRINTFILETYPES (PLAINTEXT (EXTENSION (PT PLAINTEXT]
-               (IMAGESTREAMTYPES (PLAINTEXT (OPENSTREAM OPENPLAINTEXTSTREAM)
-                                        (FONTCREATE \CREATEDISPLAYFONT)
-                                        (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
-                                        (CREATECHARSET \CREATECHARSET.DISPLAY]
-        (DECLARE%: EVAL@COMPILE DONTCOPY (P [OR (RECLOOK 'STREAM)
-                                                (EVAL (SYSRECLOOK1 'STREAM]
-                                            (OR (RECLOOK 'IMAGEOPS)
-                                                (EVAL (SYSRECLOOK1 'IMAGEOPS])
-
-(ADDTOVAR DEFAULTFILETYPELIST
 (PLAINTEXT . TEXT)
-                                  (PT . TEXT))
-(DEFINEQ
-
-(OPENPLAINTEXTSTREAM

-  [LAMBDA (FILE OPTIONS)
                                 (* ; "Edited 15-Jan-98 00:04 by rmk:")

-
-    (* ;; "Assert that scale is one, so that display fonts etc. can be used.")

-
-    (LET [(STREAM (OPENSTREAM FILE 'OUTPUT NIL '((SEQUENTIAL T]
-         (REPLACE
 (STREAM OUTCHARFN) OF
 STREAM WITH
 (FUNCTION PLAINTEXTOUTCHARFN))
-         [REPLACE
 (STREAM IMAGEDATA) OF
 STREAM
-            WITH
 (CREATE
 PLAINTEXTIMAGEDATA
-                            PTPAGE _ (CL:MAKE-ARRAY (ADD1 (TIMES 72 11))
-                                            :INITIAL-ELEMENT NIL)
-                            PTXPOSITION _ 0
-                            PTYPOSITION _ (TIMES 72 11)
-                            PTRIGHTMARGIN _ (FIX (TIMES 8.5 72))
-                            PTLEFTMARGIN _ 0
-                            PTCLIPPINGREGION _ (CREATE
 REGION
-                                                      LEFT _ 0
-                                                      BOTTOM _ 0
-                                                      WIDTH _ (FIX (TIMES 8.5 72))
-                                                      HEIGHT _ (TIMES 72 11]
-         [REPLACE
 (STREAM IMAGEOPS) OF
 STREAM
-            WITH
 (CREATE
 IMAGEOPS USING
 (FETCH
 (STREAM IMAGEOPS) OF
 STREAM)
-                                                IMAGETYPE _ 'PLAINTEXT IMFONT _
-                                                [FUNCTION (LAMBDA (STREAM FONT)
-                                                            (CL:WHEN FONT
-                                                                [PLAINTEXTPARAM
-                                                                 PTLINEFEED
-                                                                 (IMINUS (FONTPROP FONT 'HEIGHT])
-                                                            (PLAINTEXTPARAM PTFONT FONT]
-                                                IMCLIPPINGREGION _
-                                                [FUNCTION (LAMBDA (STREAM REGION)
-                                                            (CL:WHEN (AND REGION
-                                                                          (NOT (TYPE?
 REGION 
-                                                                                      REGION)))
-                                                                   (\ILLEGAL.ARG REGION))
-                                                            (PLAINTEXTPARAM PTCLIPPINGREGION REGION]
-                                                IMXPOSITION _ [FUNCTION (LAMBDA (STREAM POS)
-                                                                          (PLAINTEXTPARAM PTXPOSITION
-                                                                                 POS T]
-                                                IMYPOSITION _ [FUNCTION (LAMBDA (STREAM POS)
-                                                                          (PLAINTEXTPARAM PTYPOSITION
-                                                                                 POS T]
-                                                IMMOVETO _ [FUNCTION (LAMBDA (STREAM X Y)
-                                                                       (PLAINTEXTPARAM PTXPOSITION X
-                                                                              T)
-                                                                       (PLAINTEXTPARAM PTYPOSITION Y
-                                                                              T]
-                                                IMLEFTMARGIN _ [FUNCTION (LAMBDA (STREAM M)
-                                                                           (PLAINTEXTPARAM 
-                                                                                  PTLEFTMARGIN M T]
-                                                IMRIGHTMARGIN _ [FUNCTION (LAMBDA (STREAM M)
-                                                                            (PLAINTEXTPARAM 
-                                                                                   PTRIGHTMARGIN M T]
-                                                IMLINEFEED _ [FUNCTION (LAMBDA (STREAM DY)
-                                                                         (PLAINTEXTPARAM PTLINEFEED 
-                                                                                DY T]
-                                                IMSPACEFACTOR _ [FUNCTION (LAMBDA NIL 1]
-                                                IMFONTCREATE _ 'DISPLAY IMSTRINGWIDTH _
-                                                [FUNCTION (LAMBDA (STREAM STR RDTBL)
-                                                            (STRINGWIDTH STR
-                                                                   (FETCH
 PTFONT
-                                                                      OF
 (FETCH
 (STREAM
-                                                                                         IMAGEDATA)
-                                                                                OF
 STREAM))
-                                                                   RDTBL RDTBL]
-                                                IMCHARWIDTH _ [FUNCTION (LAMBDA (STREAM CHARCODE)
-                                                                          (CHARWIDTH
-                                                                           CHARCODE
-                                                                           (FETCH
 PTFONT
-                                                                              OF

-                                                                              (FETCH
 (STREAM
-                                                                                          IMAGEDATA)
-                                                                                 OF
 STREAM]
-                                                IMCLOSEFN _ (FUNCTION WRITEPLAINTEXTPAGE)
-                                                IMCHARSET _ [FUNCTION (LAMBDA (STREAM CHARSET)
-
-                                 (* ;; "If we had another illegal character set value, then we could simply fix it so that the character set didn't match anything, which would cause the character set shift to be put out on the next character")

-
-                                                                        (COND
-                                                                           ((\IOMODEP STREAM
-                                                                                   'OUTPUT T)
-                                                                            (\BOUT STREAM 
-                                                                                   NSCHARSETSHIFT)
-                                                                            (COND
-                                                                               ((EQ CHARSET T)
-                                                                                (\BOUT STREAM 
-                                                                                       NSCHARSETSHIFT
-                                                                                       )
-                                                                                (\BOUT STREAM 0))
-                                                                               (T (\BOUT STREAM 
-                                                                                         CHARSET]
-                                                IMDRAWPOLYGON _ (FUNCTION NILL)
-                                                IMDRAWPOINT _ (FUNCTION NILL)
-                                                IMSCALE _ (FUNCTION (LAMBDA NIL 1]
-         (DSPFONT '(GACHA 10)
-                STREAM)
-         STREAM])
-
-(PLAINTEXTOUTCHARFN

-  [LAMBDA (STREAM CHARCODE)
                              (* ; "Edited 15-Jan-98 00:06 by rmk:")

-
-    (* ;; "Put character data in PAGE entry indexed by current yposition")

-
-    (LET ((IMDATA (FETCH
 IMAGEDATA OF
 STREAM)))
-         (SELCHARQ CHARCODE
-              (CR 
-                  (* ;; "Set parameters but don't output--that means we can do lots of moving around, up and down, and still come out OK.")

-
-                  (REPLACE
 PTXPOSITION OF
 IMDATA WITH
 0)
-                  (ADD
 (FETCH
 PTYPOSITION OF
 IMDATA)
-                         (FETCH
 PTLINEFEED OF
 IMDATA)))
-              (FORM (WRITEPLAINTEXTPAGE
 STREAM)
-                    (BOUT STREAM (CHARCODE FORM))
-                    (REPLACE
 PTXPOSITION OF
 IMDATA WITH
 0)
-                    (REPLACE
 PTYPOSITION OF
 IMDATA WITH
 (TIMES 72 11)))
-              (LF (ADD
 (FETCH
 PTYPOSITION OF
 IMDATA)
-                         (FETCH
 PTLINEFEED OF
 IMDATA)))
-              (CL:PUSH [LIST (FETCH
 PTXPOSITION OF
 IMDATA)
-                             CHARCODE
-                             (ADD
 (FETCH
 PTXPOSITION OF
 IMDATA)
-                                    (CHARWIDTH CHARCODE (FETCH
 PTFONT OF
 IMDATA]
-                     (CL:SVREF (FETCH
 PTPAGE OF
 IMDATA)
-                            (FETCH
 PTYPOSITION OF
 IMDATA])
-
-(PLAINTEXT.TEDIT

-  [LAMBDA (FILE PTFILE)
                                  (* ; "Edited  8-Jan-98 06:17 by rmk:")

-                                                             (* ; "Edited 18-Sep-91 18:16 by jds")

-
-    (* ;; "Make a plaintext file from a TEdit document.  If FILE is a string, make it into a symbol for the file-name.  If it's a STREAM, use that stream.")

-
-    [COND
-       ((STRINGP FILE)
-        (SETQ FILE (MKATOM FILE]
-    (SETQ FILE (OPENTEXTSTREAM FILE))
-    (TEDIT.FORMAT.HARDCOPY FILE PTFILE T NIL NIL NIL 'PLAINTEXT)
-    PTFILE])
-
-(PLAINTEXT.TEXT

-  [LAMBDA (FILE PTFILE FONTS HEADING TABS)
               (* ; "Edited  8-Jan-98 06:20 by rmk:")

-
-    (* ;; 
-
"The effect of this should be to throw away font change characters and coerce characters to ISO8859")

-
-    (TEXTTOIMAGEFILE FILE PTFILE 'PLAINTEXT FONTS HEADING TABS])
-)
-(DEFINEQ
-
-(WRITEPLAINTEXTPAGE

-  [LAMBDA (STREAM)
                                       (* ; "Edited 15-Jan-98 09:48 by rmk:")

-    (LET [(PAGE (FETCH
 PTPAGE OF
 (FETCH
 IMAGEDATA OF
 STREAM]
-
-         (* ;; 
-
   "Have to run through y-positions indexed backwards, since have to print higher positions first.")

-
-         (FOR
 YPOS LINE LASTYPOS DIFF (DLF _ (FONTPROP DEFAULTFONT 'HEIGHT))
-                (DSP _ (CHARWIDTH (CHARCODE SPACE)
-                              DEFAULTFONT)) FROM
 (SUB1 (CL:ARRAY-DIMENSION PAGE 0)) TO
 0
-            BY
 -1 FIRST
 (SETQ LASTYPOS YPOS) WHEN
 (SETQ LINE (CL:SVREF PAGE YPOS))
-            DO
 (SETQ DIFF (- LASTYPOS YPOS))
-                  (CL:WHEN (IGREATERP DIFF DLF)              (* ; "Distance is more than a line")

-
-                      (* ;; 
-
                    "Start at 2 because one was already put out at the end of the previous line")

-
-                      (FOR
 I FROM
 2 TO
 (IQUOTIENT DIFF DLF)
-                         DO
 (BOUT STREAM (CHARCODE CR))))
-                  (SORT LINE T)                              (* ; "To print from left to right")

-                  (FOR
 C (LASTX _ 0) IN
 LINE
-                     DO
 (SETQ DIFF (- (POP
 C)
-                                          LASTX))
-                           (CL:WHEN (IGREATERP DIFF DSP)     (* ; "Distance is more than a space")

-                               (FOR
 I FROM
 1 TO
 (IQUOTIENT DIFF DLF)
-                                  DO
 (BOUT STREAM (CHARCODE SPACE))))
-                           [IF
 (ILEQ (CAR C)
-                                         127)
-                               THEN
 (BOUT STREAM (CAR C))
-                             ELSE
 
-
-                                   (* ;; "Should coerce to ISO8859.  If get something below 256, use it.  Otherwise, try to print charactername")

-
-                                   (LET (STRING)
-                                        (SETQ STRING (SELCHARQ (CAR C)
-                                                          (phi "phi")
-                                                          (MEMBEROF "memb")
-                                                          (UC-SIGMA "Sigma")
-                                                          (46,123 "Pi")
-                                                          (357,147 "o")
-                                                          NIL))
-                                        (IF
 STRING
-                                            THEN
 (BOUT STREAM (CHARCODE \))
-                                                  (FOR
 I C FROM
 1
-                                                     WHILE
 (SETQ C (NTHCHARCODE STRING I))
-                                                     DO
 (BOUT STREAM C))
-                                                  (BOUT STREAM (CHARCODE \))
-                                          ELSE
 (BOUT STREAM (CHARCODE ~]
-                           (SETQ LASTX (CADR C)))
-                  (\FILEOUTCHARFN STREAM (CHARCODE CR))
-                  (SETQ LASTYPOS YPOS) 
-
-                  (* ;; "Now clear the entry")

-
-                  (CL:SETF (CL:SVREF PAGE YPOS)
-                         NIL])
-)
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS PLAINTEXTPARAM  MACRO

-   [(PNAME PVAL NUMBERPFLAG)
-    (PROG1 (FETCH
 PNAME OF
 (FETCH
 (STREAM IMAGEDATA) OF
 STREAM))
-        [LET ((PV PVAL))
-             (CL:WHEN PV
-                 (REPLACE
 PNAME OF
 (FETCH
 (STREAM IMAGEDATA) OF
 STREAM)
-                    WITH
 (COND
-                                ('NUMBERPFLAG (OR (NUMBERP PV)
-                                                  (\ILLEGAL.ARG PV)))
-                                (T PV))))])])
-)
-(DECLARE%: EVAL@COMPILE
-
-(RECORD PLAINTEXTIMAGEDATA
 (PTPAGE PTXPOSITION PTYPOSITION PTFONT PTLINEFEED PTRIGHTMARGIN 
-                                      PTLEFTMARGIN PTCLIPPINGREGION))
-)
-
-(ADDTOVAR PRINTFILETYPES
 (PLAINTEXT (EXTENSION (PT PLAINTEXT))))
-
-(ADDTOVAR IMAGESTREAMTYPES
 (PLAINTEXT (OPENSTREAM OPENPLAINTEXTSTREAM)
-                                      (FONTCREATE \CREATEDISPLAYFONT)
-                                      (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
-                                      (CREATECHARSET \CREATECHARSET.DISPLAY)))
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-
-[OR (RECLOOK 'STREAM)
-    (EVAL (SYSRECLOOK1 'STREAM]
-
-[OR (RECLOOK 'IMAGEOPS)
-    (EVAL (SYSRECLOOK1 'IMAGEOPS]
-)
-(PUTPROPS PLAINTEXTSTREAM COPYRIGHT ("Xerox Corporation" 1998))
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1746 11976 (OPENPLAINTEXTSTREAM 1756 . 9644) (PLAINTEXTOUTCHARFN 9646 . 11087) (
-PLAINTEXT.TEDIT 11089 . 11661) (PLAINTEXT.TEXT 11663 . 11974)) (11977 15294 (WRITEPLAINTEXTPAGE 11987
- . 15292)))))
-STOP

lispusers/TEDIT-PF-SEE

@@ -0,0 +1,152 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "16-Oct-2021 19:23:40" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;32
 7178   
+
+      changes to%:  (FNS CLOSE-TYPED-WINDOW)
+
+      previous date%: "12-Oct-2021 22:31:01" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;31)
+
+
+(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
+
+(RPAQQ TEDIT-PF-SEECOMS

+       [(FNS SEE-TEDIT PF-TEDIT)
+        (COMS (FNS GET-TYPED-WINDOW CLOSE-TYPED-WINDOW)
+              (INITVARS (TYPED-WINDOWS)))
+        (COMMANDS ts tpf)
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
+                                                                             (NLAML)
+                                                                             (LAMA])
+(DEFINEQ
+
+(SEE-TEDIT

+  [LAMBDA (FILE WINDOW FORMAT)
                          (* ; "Edited 11-Oct-2021 08:51 by rmk:")

+    (SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
+                   (ERROR "FILE NOT FOUND" FILE)))
+    (TEDIT-SEE FILE (GET-TYPED-WINDOW
 (OR WINDOW 'SEE-TEDIT)
+                           (CONCAT "SEE window for " FILE))
+           FORMAT)
+    FILE])
+
+(PF-TEDIT

+  [LAMBDA (FN IFILES)
                                   (* ; "Edited 12-Oct-2021 15:22 by rmk:")

+
+    (* ;; "PF* to a read-only TEDIT window.  First argument is the function name, second if given is the input file.")

+
+    (CL:WHEN (LISTP FN)
+        (SETQ FN (CAR FN)))
+    (IF
 FN
+        THEN
                                             (* ; "FN name specified; use it.")

+              (SETQ LASTWORD FN)
+      ELSE
                                               (* ; "Not specified, use LASTWORD")

+            (SETQ FN LASTWORD))
+    (IF
 [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
+                                           (WHEREIS FN 'FUNCTIONS T]
+        THEN
                                             (* ; "skip compiled files")

+              (FOR
 IFILE LOC TSTREAM ENV INSIDE
 IFILES
+                 UNLESS
 (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
+                                  *COMPILED-EXTENSIONS*)
+                 DO
 (SETQ LOC (FINDFNDEF FN IFILE))
+                       (IF
 (LISTP LOC)
+                           THEN
 [CL:WITH-OPEN-FILE (ISTREAM (POP
 LOC)
+                                                              :DIRECTION :INPUT)
+                                           (SETQ ENV (LISPSOURCEFILEP ISTREAM))
+                                           (SETFILEINFO ISTREAM 'FORMAT ENV)
+                                           (SETQ TSTREAM (OPENTEXTSTREAM))
+                                           (DSPFONT DEFAULTFONT TSTREAM)
+                                           (PRINT-READER-ENVIRONMENT ENV TSTREAM)
+                                           (PFCOPYBYTES ISTREAM TSTREAM (POP
 LOC)
+                                                  (POP
 LOC))
+                                           (TERPRI TSTREAM)
+                                           (SETQ TSTREAM (TEDIT TSTREAM (GET-TYPED-WINDOW

+                                                                         'PF-TEDIT
+                                                                         (CONCAT FN "  from "
+                                                                                (FULLNAME ISTREAM)))
+                                                                NIL
+                                                                '(READONLY T]
+                         ELSEIF
 (EQ LOC 'FILE.NOT.FOUND)
+                           THEN
 (printout T "file " IFILE " not found." T)
+                         ELSE
 (printout T FN " not found on " LOC "." T)))
+      ELSE
 (PRINTOUT T FN " has no function definition" T])
+)
+(DEFINEQ
+
+(GET-TYPED-WINDOW

+  [LAMBDA (WINDOWTYPE TITLE NOOPENFLG)
                  (* ; "Edited 11-Oct-2021 10:06 by rmk:")

+
+    (* ;; "WINDOWTYPE=T means always create a new window.  If a WINDOW, then reuse it.")

+
+    (* ;; "Otherwise, create a window of type WINDOWTYPE, using a previously specified region if one is available.")

+
+    (LET (WINDOW REGION WLIST)
+         [IF
 (OR (EQ WINDOWTYPE T)
+                     (SETQ WINDOW (WINDOWP WINDOWTYPE)))
+             THEN
 (SETQ WINDOWTYPE NIL)
+           ELSE
 [SETQ WLIST (OR (ASSOC WINDOWTYPE TYPED-WINDOWS)
+                                    (CAR (PUSH
 TYPED-WINDOWS (CONS WINDOWTYPE]
+                 (SETQ REGION (FIND
 X IN
 (CDR WLIST) SUCHTHAT
 (TYPE?
 REGION X]
+         (CL:UNLESS WINDOW
+
+             (* ;; "Make sure we have a titlebar and promptwindow")

+
+             (SETQ WINDOW (CREATEW REGION "" NIL NOOPENFLG))
+             (GETPROMPTWINDOW WINDOW)
+
+             (* ;; 
+
        "Replace the region on WLIST with the window, so we can maintan a likely preference order.")

+
+             (IF
 REGION
+                 THEN
 (DSUBST WINDOW REGION WLIST)
+               ELSE
 (NCONC1 WLIST WINDOW)))
+         (CL:WHEN TITLE
+             (WINDOWPROP WINDOW 'TITLE TITLE))
+         (CL:WHEN WINDOWTYPE
+             (WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE)
+             (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CLOSE-TYPED-WINDOW)))
+         WINDOW])
+
+(CLOSE-TYPED-WINDOW

+  [LAMBDA (WINDOW ALL)
                                  (* ; "Edited 16-Oct-2021 19:23 by rmk:")

+
+    (* ;; "Puts the region of WINDOW back on the region list for its type, for later reuse.  If ALL, closes all windows of the type of WINDOW (and recursively puts their regions also on the list).")

+
+    (CL:WHEN (OPENWP WINDOW)
+        [LET [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE]
+             (CL:WHEN WINDOWTYPE
+                 (IF
 ALL
+                     THEN
 (FOR
 W IN
 (OPENWINDOWS) WHEN
 (EQ WINDOWTYPE
+                                                                           (WINDOWPROP W 'WINDOWTYPE)
+                                                                           )
+                                 UNLESS
 (EQ W WINDOW) DO
 (CLOSEW W))
+                   ELSE
 
+
+                         (* ;; "This may no longer be needed, now that TEDIT removes the process for READONLY windows just as for ordinary edit windows.")

+
+                         (AND NIL (CL:WHEN (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS))
+                                                             (* ; 
+
                                            "Otherwise, the window pops up if you don't click away")

+                                      (TTY.PROCESS T)))
+                         (DSUBST (WINDOWPROP WINDOW 'REGION)
+                                WINDOW TYPED-WINDOWS)))])
+    WINDOW])
+)
+
+(RPAQ? TYPED-WINDOWS
 )
+
+(DEFCOMMAND ts (FILE WINDOW FORMAT) (SEE-TEDIT
 FILE WINDOW FORMAT))
+
+(DEFCOMMAND tpf (FN IFILES) (PF-TEDIT
 FN IFILES))
+(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
+
+(ADDTOVAR NLAMA
 )
+
+(ADDTOVAR NLAML
 )
+
+(ADDTOVAR LAMA
 )
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (843 3913 (SEE-TEDIT 853 . 1263) (PF-TEDIT 1265 . 3911)) (3914 6866 (GET-TYPED-WINDOW 
+3924 . 5397) (CLOSE-TYPED-WINDOW 5399 . 6864)))))
+STOP

lispusers/THINFILES

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "18-Aug-2021 20:46:55" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;5
 8653   
 
-      changes to%:  (FNS FB.THINCOMMAND)
+
(FILECREATED " 9-Oct-2021 00:35:17" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;11
 8621   
 
-      previous date%: " 8-Aug-2021 15:05:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;4)
+      changes to%:  (FNS FB.THINP)
+
+      previous date%: " 7-Oct-2021 12:40:24" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;8)
 
 
 (* ; "
@@ -14,16 +15,16 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
 
 (PRETTYCOMPRINT THINFILESCOMS)
 
-(RPAQQ THINFILESCOMS
 [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
-                                                                  FILEBROWSER))
-                          (FNS FB.THINCOMMAND FB.THINP)
-                          (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
-                                                           '(SYSOUT DCOM DATABASE LCOM DFASL MCOM 
-                                                                   MFASL DRIBBLE]
-                                 (THINNAMES NIL))
-                          (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND 
+(RPAQQ THINFILESCOMS

+       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
+                                                FILEBROWSER))
+        (FNS FB.THINCOMMAND FB.THINP)
+        (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
+                                         '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE]
+               (THINNAMES NIL))
+        (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND 
                      "Delvers non-source files and removes all but the last source file of each day."
-                                                           ])
+                                         ])
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (LOADCOMP)
@@ -116,29 +117,33 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
          (FB.PROMPTWPRINT FBROWSER T "Done, " NDELETED " files marked for deletion."])
 
 (FB.THINP

-  [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)

-                                                            (* ; "Edited  8-Aug-2021 15:05 by rmk:")

+  [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)

+                                                            (* ; "Edited  9-Oct-2021 00:35 by rmk:")

+    (SETQ FILENAME (U-CASE FILENAME))
     (COND
-       ((FMEMB (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION))
-               THINEXTENSIONS)                               (* ; 
-
                                   "always delver files that can be reconstructed from the source.")

-        T)
-       ((AND THINNAMES (EQMEMB (U-CASE (FILENAMEFIELD FILENAME 'NAME))
-                              THINNAMES))
-        T)
-       (OLDESTVERSION?                                       (* ; 
-
                                                 "don't delete the oldest version of source files.")

+       [(OR (EQMEMB (FILENAMEFIELD FILENAME 'EXTENSION)
+                   THINEXTENSIONS)
+            (FIND
 TN (FN _ (FILENAMEFIELD FILENAME 'NAME))
+                   (FE _ (FILENAMEFIELD FILENAME 'EXTENSION)) INSIDE
 THINNAMES
+               SUCHTHAT
 
+
+                     (* ;; "Separate extractions because period for null extension is confusing")

+
+                     (AND (EQ FN (FILENAMEFIELD TN 'NAME))
+                          (EQ FE (FILENAMEFIELD TN 'EXTENSION]
+       (OLDESTVERSION?                                       (* ; 
+
                                                 "don't delete the oldest version of source files.")

               NIL)
-       ((ILESSP AGE ONEDAY)                                  (* ; 
-
                                                   "don't delete anything written within 24 hours.")

+       ((ILESSP AGE ONEDAY)                                  (* ; 
+
                                                   "don't delete anything written within 24 hours.")

         NIL)
        ((ILESSP (ITIMES DELTATIMESTAMP 3)
-               ONEDAY)                                       (* ; 
-
         "delete anything that occurs on the same day as something else (except for the first day)")

+               ONEDAY)                                       (* ; 
+
         "delete anything that occurs on the same day as something else (except for the first day)")

         T)
        ((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30))
 
-        (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")

+        (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")

 
         T])
 )
@@ -153,5 +158,5 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
                                      ))
 (PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1297 8184 (FB.THINCOMMAND 1307 . 6808) (FB.THINP 6810 . 8182)))))
+  (FILEMAP (NIL (1106 8152 (FB.THINCOMMAND 1116 . 6617) (FB.THINP 6619 . 8150)))))
 STOP

lispusers/TMAX

@@ -1,22 +1,26 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "19-May-99 08:41:45" {DSK}<project>medley3.5>lispusers>TMAX.;5
 28668  
 
-      changes to%:  (MACROS MAKE.XREFOBJ.IMAGEFNS)
+
(FILECREATED "24-Oct-2021 23:45:20" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;4
 31402  
 
-      previous date%: "18-May-99 22:44:24" {DSK}<project>medley3.5>lispusers>TMAX.;3)
+      changes to%:  (VARS TMAXCOMS)
+                    (FNS GET.TSP.FONT.FAMILY)
+
+      previous date%: "24-Oct-2021 22:06:32" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX.;2)
 
 
 (* ; "
-Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
+Copyright (c) 1987, 1997, 1999 by Stanford University.
 ")
 
 (PRETTYCOMPRINT TMAXCOMS)
 
 (RPAQQ TMAXCOMS

-       (                                                     (* ; 
-
                                                 "Developed under support from NIH grant RR-00785.")

-                                                             (* ; 
-
                                                       "Written by Frank Gilmurray and Sami Shaio.")

+       (                                                     (* ; 
+
                                                 "Developed under support from NIH grant RR-00785.")

+                                                             (* ; 
+
                                                       "Written by Frank Gilmurray and Sami Shaio.")

         (FILES (COMPILED SYSLOAD)
                TEDIT FREEMENU)
         (VARS TMAX.FILE.LIST)
@@ -27,38 +31,38 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
         (P (DOFILESLOAD TMAX.FILE.LIST))
         
 
-(* ;;; "Free Menu data structures")

+(* ;;; "Free Menu data structures")

 
         (VARS TSP.FM.DESC IMAGEOBJ.MENU.ITEMS)
         
 
-(* ;;; "Free Menu functions")

+(* ;;; "Free Menu functions")

 
         (FNS TSP.DISPLAY.FMMENU TSP.SETUP.FILENAMES TSP.SETUP.FMMENU TSP.FMMENU TSP.FM.APPLY 
              UPDATE.ALL DOWNDATE.ALL TSP.FUNCTION.HOOKS TSP.GETFN TSP.PUTFN)
         
 
-(* ;;; "Free Menu toggle functions")

+(* ;;; "Free Menu toggle functions")

 
         (FNS AutoUpdate.TOGGLE UPDATE? NGROUP.Menu.TOGGLE NGROUPMENU.ENABLED? 
              NGROUP.Text-Before.TOGGLE TEXTBEFORE.ENABLED? NGROUP.Text-After.TOGGLE 
              TEXTAFTER.ENABLED? Manual.Index.TOGGLE MANUALINDEX.ENABLED?)
         
 
-(* ;;; "TSP font stuff")

+(* ;;; "TSP font stuff")

 
         (FNS GET.TSP.FONT GET.TSP.FONT.FAMILY GET.TSP.FONT.SIZE GET.TSP.FONT.FACE ABBREVIATE.FONT 
              TMAX.SHADEOBJ)
         
 
-(* ;;; "Collect ImageObjects")

+(* ;;; "Collect ImageObjects")

 
         (FNS TSP.LIST.OF.OBJECTS)
         (GLOBALVARS GP.DefaultFont GP.DefaultShade)
         (MACROS MAKE.DATEOBJ.IMAGEFNS MAKE.NUMBEROBJ.IMAGEFNS MAKE.REGMARKOBJ.IMAGEFNS 
                MAKE.XREFOBJ.IMAGEFNS)
-        (VARS (GP.DefaultFont (FONTCREATE 'GACHA 10))
-              (GP.DefaultShade 10260)
+        (VARS (GP.DefaultFont (FONTCREATE 'TERMINAL 10))
+              (GP.DefaultShade 1024)
               (\NUMBEROBJ.IMAGEFNS (MAKE.NUMBEROBJ.IMAGEFNS))
               (\DATEOBJ.IMAGEFNS (MAKE.DATEOBJ.IMAGEFNS))
               (\REGMARKOBJ.IMAGEFNS (MAKE.REGMARKOBJ.IMAGEFNS))
@@ -134,7 +138,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
          (LABEL "Known References" ID KNOWNREF SELECTEDFN TSP.FM.APPLY)
          (LABEL "Reference By" TYPE STATE MENUITEMS (Ask Value Page)
                 INITSTATE Value LINKS (DISPLAY DEFAULTREF))
-         (LABEL "" TYPE DISPLAY ID DEFAULTREF FONT (GACHA 10 MRR)))
+         (LABEL "" TYPE DISPLAY ID DEFAULTREF FONT (TERMINAL 10 MRR)))
         ((LABEL "Endnotes:" TYPE DISPLAY FONT (NIL NIL MRR))
          (LABEL "Endnote" ID ENDNOTE SELECTEDFN TSP.FM.APPLY)
          (LABEL "Insert Endnotes" ID INSERTNOTE SELECTEDFN TSP.FM.APPLY)
@@ -150,7 +154,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
          (LABEL "Create TOC" ID CREATETOC SELECTEDFN TSP.FM.APPLY)
          (LABEL "View TOC" ID VIEWTOC SELECTEDFN TSP.FM.APPLY)
          (LABEL "TOC Filename:" TYPE EDITSTART LINKS (EDIT TOC.FILE))
-         (LABEL "" TYPE EDIT ID TOC.FILE FONT (GACHA 10 MRR)))
+         (LABEL "" TYPE EDIT ID TOC.FILE FONT (TERMINAL 10 MRR)))
         ((LABEL "Indices:" TYPE DISPLAY FONT (NIL NIL MRR))
          (LABEL "Index" ID INDEX SELECTEDFN TSP.FM.APPLY)
          (LABEL "Extended Index" ID XTNDINDEX SELECTEDFN TSP.FM.APPLY)
@@ -160,7 +164,7 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
          (LABEL "Create Index" ID CREATEINDEX SELECTEDFN TSP.FM.APPLY)
          (LABEL "View Index" ID VIEWINDEX SELECTEDFN TSP.FM.APPLY)
          (LABEL "Index Filename:" TYPE EDITSTART LINKS (EDIT INDEX.FILE))
-         (LABEL "" TYPE EDIT ID INDEX.FILE FONT (GACHA 10 MRR])
+         (LABEL "" TYPE EDIT ID INDEX.FILE FONT (TERMINAL 10 MRR])
 
 (RPAQQ IMAGEOBJ.MENU.ITEMS

        ((UPDATE (UPDATE.ALL TSTREAM TWINDOW))
@@ -430,14 +434,17 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
               (LIST FAMILY SIZE (FONTPROP NEWENTRY.FONT 'FACE])
 
 (GET.TSP.FONT.FAMILY

-  [LAMBDA (DEFAULT.FONT)
                                     (* fsg " 8-Jul-87 15:44")

-          (* * Get the font family from the menu or DEFAULT.FONT if the menu returns NIL.)

+  [LAMBDA (DEFAULT.FONT)
                                (* ; "Edited 24-Oct-2021 23:39 by rmk:")


+                                                             (* fsg " 8-Jul-87 15:44")

+
+         (* * Get the font family from the menu or DEFAULT.FONT if the menu returns NIL.)

 
     (OR [MKATOM (MENU (create
 MENU
                              TITLE _ "Font Family"
                              CENTERFLG _ T
                              ITEMS _ '((Classic 'CLASSIC)
                                        (Gacha 'GACHA)
+                                       (Terminal 'TERMINAL)
                                        (Helvetica 'HELVETICA)
                                        (Modern 'MODERN)
                                        (TimesRoman 'TIMESROMAN]
@@ -468,10 +475,12 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
         (FONTPROP DEFAULT.FONT 'FACE])
 
 (ABBREVIATE.FONT

-  [LAMBDA (FONT)
                                             (* fsg " 8-Jul-87 15:57")

-          (* * Returns an abbreviated font description.
-
          For example, if the font is (TIMESROMAN 12
-
          (BOLD REGULAR REGULAR)) then the list (TimesRoman 12 Bold) is returned.)

+  [LAMBDA (FONT)
                                        (* ; "Edited 24-Oct-2021 22:05 by rmk:")


+                                                             (* fsg " 8-Jul-87 15:57")

+
+         (* * Returns an abbreviated font description.
+
       For example, if the font is (TIMESROMAN 12
+
       (BOLD REGULAR REGULAR)) then the list (TimesRoman 12 Bold) is returned.)

 
     (LET [(FONT.LIST (COND
                         [(FONTP FONT)
@@ -482,13 +491,15 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
          (LIST (LET ((FONT.FAMILY (CAR FONT.LIST)))
                     (SELECTQ FONT.FAMILY
                         (CLASSIC 'Classic)
+                        (TERMINAL 'Terminal)
                         (GACHA 'Gacha)
                         (HELVETICA 'Helvetica)
                         (MODERN 'Modern)
                         (TIMESROMAN 'TimesRoman)
                         FONT.FAMILY))
                (CADR FONT.LIST)
-               (LET [(FONT.FACE (CONCATLIST (for
 FIELD in
 (CADDR FONT.LIST) collect
 (GNC FIELD]
+               (LET [(FONT.FACE (CONCATLIST (for
 FIELD in
 (CADDR FONT.LIST)
+                                               collect
 (GNC FIELD]
                     (SELECTQ (MKATOM FONT.FACE)
                         (MRR 'Standard)
                         (MIR 'Italic)
@@ -497,10 +508,10 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
                         FONT.FACE])
 
 (TMAX.SHADEOBJ

-  [LAMBDA (OBJ STREAM SHADE)
                             (* ; "Edited 26-Jan-97 14:07 by rmk:")

-                                                             (* fsg "17-Sep-87 11:25")

+  [LAMBDA (OBJ STREAM SHADE)
                             (* ; "Edited 26-Jan-97 14:07 by rmk:")


+                                                             (* fsg "17-Sep-87 11:25")

 
-    (* ;; "Shade the ImageObject to distinguish it from normal text.")

+    (* ;; "Shade the ImageObject to distinguish it from normal text.")

 
     (AND (IMAGESTREAMTYPEP STREAM 'DISPLAY)
          (LET [(BOUNDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
@@ -543,74 +554,70 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS MAKE.DATEOBJ.IMAGEFNS  MACRO

-   [LAMBDA NIL
-     (IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
-            (FUNCTION DATE.IMAGEBOXFN)
-            (FUNCTION DATE.PUTFN)
-            (FUNCTION DATE.GETFN)
-            (FUNCTION DATE.COPYFN)
-            (FUNCTION DATE.BUTTONEVENTINFN)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL])
+(PUTPROPS MAKE.DATEOBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
+                                                (IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
+                                                       (FUNCTION DATE.IMAGEBOXFN)
+                                                       (FUNCTION DATE.PUTFN)
+                                                       (FUNCTION DATE.GETFN)
+                                                       (FUNCTION DATE.COPYFN)
+                                                       (FUNCTION DATE.BUTTONEVENTINFN)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL])
 
-(PUTPROPS MAKE.NUMBEROBJ.IMAGEFNS  MACRO

-   [LAMBDA NIL
-     (IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
-            (FUNCTION NUMBER.IMAGEBOXFN)
-            (FUNCTION NUMBER.PUTFN)
-            (FUNCTION NUMBER.GETFN)
-            (FUNCTION NUMBER.COPYFN)
-            (FUNCTION NUMBER.BUTTONEVENTINFN)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION XREF.WHENDELETEDFN)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NUMBER.PREPRINTFN])
+(PUTPROPS MAKE.NUMBEROBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
+                                                  (IMAGEFNSCREATE (FUNCTION NUMBER.DISPLAYFN)
+                                                         (FUNCTION NUMBER.IMAGEBOXFN)
+                                                         (FUNCTION NUMBER.PUTFN)
+                                                         (FUNCTION NUMBER.GETFN)
+                                                         (FUNCTION NUMBER.COPYFN)
+                                                         (FUNCTION NUMBER.BUTTONEVENTINFN)
+                                                         (FUNCTION NILL)
+                                                         (FUNCTION NILL)
+                                                         (FUNCTION NILL)
+                                                         (FUNCTION XREF.WHENDELETEDFN)
+                                                         (FUNCTION NILL)
+                                                         (FUNCTION NILL)
+                                                         (FUNCTION NUMBER.PREPRINTFN])
 
-(PUTPROPS MAKE.REGMARKOBJ.IMAGEFNS  MACRO

-   [LAMBDA NIL
-     (IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
-            (FUNCTION REGMARK.IMAGEBOXFN)
-            (FUNCTION REGMARK.PUTFN)
-            (FUNCTION REGMARK.GETFN)
-            (FUNCTION REGMARK.COPYFN)
-            (FUNCTION REGMARK.BUTTONEVENTINFN)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL])
+(PUTPROPS MAKE.REGMARKOBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
+                                                   (IMAGEFNSCREATE (FUNCTION REGMARK.DISPLAYFN)
+                                                          (FUNCTION REGMARK.IMAGEBOXFN)
+                                                          (FUNCTION REGMARK.PUTFN)
+                                                          (FUNCTION REGMARK.GETFN)
+                                                          (FUNCTION REGMARK.COPYFN)
+                                                          (FUNCTION REGMARK.BUTTONEVENTINFN)
+                                                          (FUNCTION NILL)
+                                                          (FUNCTION NILL)
+                                                          (FUNCTION NILL)
+                                                          (FUNCTION NILL)
+                                                          (FUNCTION NILL)
+                                                          (FUNCTION NILL)
+                                                          (FUNCTION NILL])
 
-(PUTPROPS MAKE.XREFOBJ.IMAGEFNS  MACRO

-   [LAMBDA NIL
-     (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
-            (FUNCTION XREF.IMAGEBOXFN)
-            (FUNCTION XREF.PUTFN)
-            (FUNCTION XREF.GETFN)
-            (FUNCTION XREF.COPYFN)
-            (FUNCTION XREF.BUTTONEVENTINFN)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION NILL)
-            (FUNCTION XREF.GET.DISPLAY.TEXT])
+(PUTPROPS MAKE.XREFOBJ.IMAGEFNS
 MACRO
 [LAMBDA NIL
+                                                (IMAGEFNSCREATE (FUNCTION XREF.DISPLAYFN)
+                                                       (FUNCTION XREF.IMAGEBOXFN)
+                                                       (FUNCTION XREF.PUTFN)
+                                                       (FUNCTION XREF.GETFN)
+                                                       (FUNCTION XREF.COPYFN)
+                                                       (FUNCTION XREF.BUTTONEVENTINFN)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION NILL)
+                                                       (FUNCTION XREF.GET.DISPLAY.TEXT])
 )
 
-(RPAQ GP.DefaultFont
 (FONTCREATE 'GACHA 10))
+(RPAQ GP.DefaultFont
 (FONTCREATE 'TERMINAL 10))
 
-(RPAQQ GP.DefaultShade
 10260)
+(RPAQQ GP.DefaultShade
 1024)
 
 (RPAQ \NUMBEROBJ.IMAGEFNS
 (MAKE.NUMBEROBJ.IMAGEFNS))
 
@@ -643,14 +650,14 @@ Copyright (c) 1987, 1997, 1999 by Stanford University.  All rights reserved.
 (TSP.FUNCTION.HOOKS
)
 (PUTPROPS TMAX COPYRIGHT ("Stanford University" 1987 1997 1999))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8744 15959 (TSP.DISPLAY.FMMENU 8754 . 9319) (TSP.SETUP.FILENAMES 9321 . 10572) (
-TSP.SETUP.FMMENU 10574 . 11034) (TSP.FMMENU 11036 . 12222) (TSP.FM.APPLY 12224 . 12543) (UPDATE.ALL 
-12545 . 13217) (DOWNDATE.ALL 13219 . 13589) (TSP.FUNCTION.HOOKS 13591 . 15021) (TSP.GETFN 15023 . 
-15583) (TSP.PUTFN 15585 . 15957)) (16005 18254 (AutoUpdate.TOGGLE 16015 . 16251) (UPDATE? 16253 . 
-16398) (NGROUP.Menu.TOGGLE 16400 . 16782) (NGROUPMENU.ENABLED? 16784 . 17020) (
-NGROUP.Text-Before.TOGGLE 17022 . 17272) (TEXTBEFORE.ENABLED? 17274 . 17437) (NGROUP.Text-After.TOGGLE
- 17439 . 17687) (TEXTAFTER.ENABLED? 17689 . 17850) (Manual.Index.TOGGLE 17852 . 18091) (
-MANUALINDEX.ENABLED? 18093 . 18252)) (18288 23401 (GET.TSP.FONT 18298 . 19462) (GET.TSP.FONT.FAMILY 
-19464 . 20147) (GET.TSP.FONT.SIZE 20149 . 20637) (GET.TSP.FONT.FACE 20639 . 21338) (ABBREVIATE.FONT 
-21340 . 22649) (TMAX.SHADEOBJ 22651 . 23399)) (23441 24657 (TSP.LIST.OF.OBJECTS 23451 . 24655)))))
+  (FILEMAP (NIL (8815 16030 (TSP.DISPLAY.FMMENU 8825 . 9390) (TSP.SETUP.FILENAMES 9392 . 10643) (
+TSP.SETUP.FMMENU 10645 . 11105) (TSP.FMMENU 11107 . 12293) (TSP.FM.APPLY 12295 . 12614) (UPDATE.ALL 
+12616 . 13288) (DOWNDATE.ALL 13290 . 13660) (TSP.FUNCTION.HOOKS 13662 . 15092) (TSP.GETFN 15094 . 
+15654) (TSP.PUTFN 15656 . 16028)) (16076 18325 (AutoUpdate.TOGGLE 16086 . 16322) (UPDATE? 16324 . 
+16469) (NGROUP.Menu.TOGGLE 16471 . 16853) (NGROUPMENU.ENABLED? 16855 . 17091) (
+NGROUP.Text-Before.TOGGLE 17093 . 17343) (TEXTBEFORE.ENABLED? 17345 . 17508) (NGROUP.Text-After.TOGGLE
+ 17510 . 17758) (TEXTAFTER.ENABLED? 17760 . 17921) (Manual.Index.TOGGLE 17923 . 18162) (
+MANUALINDEX.ENABLED? 18164 . 18323)) (18359 23832 (GET.TSP.FONT 18369 . 19533) (GET.TSP.FONT.FAMILY 
+19535 . 20383) (GET.TSP.FONT.SIZE 20385 . 20873) (GET.TSP.FONT.FACE 20875 . 21574) (ABBREVIATE.FONT 
+21576 . 23076) (TMAX.SHADEOBJ 23078 . 23830)) (23872 25088 (TSP.LIST.OF.OBJECTS 23882 . 25086)))))
 STOP

lispusers/TMAX-DATE

@@ -1,39 +1,54 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(filecreated "12-Mar-88 15:42:46" {erinyes}<lispusers>lyric>tmax-date.\;2
 15254  
 
-      |changes| |to:|  (fns current.display.font)
+
(FILECREATED "24-Oct-2021 13:52:22" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX-DATE.;4|
 14231  
 
-      |previous| |date:| "30-Dec-87 11:39:18" {erinyes}<lispusers>lyric>tmax-date.\;1)
+      |changes| |to:|  (FNS FINDMONTH FINDTIME FINDHOUR AMPM CHANGE.DATE.FORMAT FINDYEAR)
+                       (VARS TMAX-DATECOMS)
+
+      |previous| |date:| "12-Mar-88 15:42:46" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TMAX-DATE.;1|)
 
 
-; Copyright (c) 1987, 1988 by Xerox Corporation.  All rights reserved.
+; Copyright (c) 1987-1988 by Xerox Corporation.
 
-(prettycomprint tmax-datecoms)
+(PRETTYCOMPRINT TMAX-DATECOMS)
 
-(rpaqq tmax-datecoms
 ((* |Developed| |under| |support| |from| nih |grant| rr-00785.)
-                          (* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)
-                          (* * tmax-datenil |ImageObject| |functions|)
-                          (fns dateobj dateobjp date.displayfn date.imageboxfn date.putfn date.getfn 
-                               date.copyfn date.buttoneventinfn)
-                          (* * |Date| |support| |functions|)
-                          (fns current.display.font change.date.format)
-                          (* * |Functions| |to| |change| |date| |format|)
-                          (fns findtime findhour ampm findday nump findmonth findyear)
-                          (vars date.format.items)
-                          (records daterecord)))
+(RPAQQ TMAX-DATECOMS

+       (
+        (* |;;| "Developed under support from NIH grant RR-00785. Written by Frank Gilmurray and Sami Shaio. Updated by Ron Kaplan (2021)")

+
+        
+
+(* |;;;| "TMAX-DATE ImageObject functions")

+
+        (FNS DATEOBJ DATEOBJP DATE.DISPLAYFN DATE.IMAGEBOXFN DATE.PUTFN DATE.GETFN DATE.COPYFN 
+             DATE.BUTTONEVENTINFN)
+        
+
+(* |;;;| "Date support functions")

+
+        (FNS CURRENT.DISPLAY.FONT CHANGE.DATE.FORMAT)
+        
+
+(* |;;;| "Functions to change date format")

+
+        (FNS FINDTIME FINDHOUR AMPM FINDDAY NUMP FINDMONTH FINDYEAR)
+        (VARS DATE.FORMAT.ITEMS)
+        (DECLARE\: DOEVAL@COMPILE DONTCOPY (RECORDS DATERECORD))))
 
 
 
-(* |Developed| |under| |support| |from| nih |grant| rr-00785.)

+(* |;;| 
+"Developed under support from NIH grant RR-00785. Written by Frank Gilmurray and Sami Shaio. Updated by Ron Kaplan (2021)"
+)

 
 
 
 
-(* |Written| |by| |Frank| |Gilmurray| |and| |Sami| |Shaio.|)

+(* |;;;| "TMAX-DATE ImageObject functions")

 
-(* * tmax-datenil |ImageObject| |functions|)

-
-(defineq
+(DEFINEQ
 
 (dateobj

   (lambda (date/time date.string template)
                   (* |fsg| "13-Jul-87 11:51")

@@ -126,9 +141,12 @@
                                                                                 template.date)))))
                           'changed))))))
 )
-(* * |Date| |support| |functions|)

 
-(defineq
+
+
+(* |;;;| "Date support functions")

+
+(DEFINEQ
 
 (current.display.font

   (lambda (stream)
                                       (* \; "Edited 12-Mar-88 15:28 by drc:")

@@ -144,123 +162,103 @@
              (|fetch|
 displayfd |of|
 current.font))
             (t (shouldnt "Can't get current font"))))))
 
-(change.date.format

-  (lambda (date template)
                                    (* |ss:| "27-Jun-87 15:36")

-          (* * |Convert| |the| |string| date |to| |the| |format| |specified| |by| 
-
          template.)

+(CHANGE.DATE.FORMAT

+  (LAMBDA (DATE TEMPLATE)                                    (* \; 
+
                                                           "Edited 24-Oct-2021 13:47 by rmk:")

+                                                             (* |ss:| "27-Jun-87 15:36")

 
-    (cond
-       (template (let ((version (|if|
 (equal (last template)
-                                             '(a))
-                                    |then|
 'abbrev
-                                  |else|
 (|if|
 (equal (last template)
-                                                      '(f))
-                                             |then|
 'full
-                                           |else|
 'euro)))
-                       (funclst '((d findday)
-                                  (m findmonth)
-                                  (y findyear))))
-                      (cond
-                         ((eq (car template)
-                              t)
-                          (findtime
 date version))
-                         (t (let ((ch (|if|
 (eq version 'abbrev)
+(* |;;;| "Convert the string DATE to the format specified by TEMPLATE.")

+
+    (COND
+       (TEMPLATE (LET ((VERSION (SELECTQ (CAR (LAST TEMPLATE))
+                                    (A 'ABBREV)
+                                    (F 'FULL)
+                                    'EURO))
+                       (FUNCLST '((D FINDDAY)
+                                  (M FINDMONTH)
+                                  (Y FINDYEAR))))
+                      (COND
+                         ((EQ T (CAR TEMPLATE))
+                          (FINDTIME
 DATE VERSION))
+                         (T (LET ((CH (|if|
 (EQ VERSION 'ABBREV)
                                           |then|
 "/"
                                         |else|
 " ")))
-                                 (concat (apply (cadr (assoc (car template)
-                                                             funclst))
-                                                (list date version))
-                                        ch
-                                        (apply (cadr (assoc (cadr template)
-                                                            funclst))
-                                               (list date version))
-                                        (|if|
 (equal ch " ")
+                                 (CONCAT (APPLY (CADR (ASSOC (CAR TEMPLATE)
+                                                             FUNCLST))
+                                                (LIST DATE VERSION))
+                                        CH
+                                        (APPLY (CADR (ASSOC (CADR TEMPLATE)
+                                                            FUNCLST))
+                                               (LIST DATE VERSION))
+                                        (|if|
 (EQUAL CH " ")
                                             |then|
 ", "
-                                          |else|
 ch)
-                                        (apply (cadr (assoc (caddr template)
-                                                            funclst))
-                                               (list date version))))))))
-       (t (date)))))
+                                          |else|
 CH)
+                                        (APPLY (CADR (ASSOC (CADDR TEMPLATE)
+                                                            FUNCLST))
+                                               (LIST DATE VERSION))))))))
+       (T (DATE)))))
 )
-(* * |Functions| |to| |change| |date| |format|)

 
-(defineq
 
-(findtime

-  (lambda (olddate version)
                                  (* |ss:| "27-Jun-87 15:40")

-    (let ((hour (substring olddate 11 12))
-          (minutes (substring olddate 14 15)))
-         (|if|
 (equal version 'abbrev)
-             |then|
 (concat (findhour
 hour)
-                           ":" minutes " " (ampm
 hour))
-           |else|
 (|if|
 (equal version 'euro)
-                      |then|
 (substring olddate 11 15)
-                    |else|
 (concat (selectq (|if|
 (lessp (mkatom minutes)
-                                                         46)
-                                                |then|
 (mkatom (findhour
 hour))
-                                              |else|
 (plus 1 (mkatom (findhour
 hour))))
-                                       (1 "one")
-                                       (2 "two")
-                                       (3 "three")
-                                       (4 "four")
-                                       (5 "five")
-                                       (6 "six")
-                                       (7 "seven")
-                                       (8 "eight")
-                                       (9 "nine")
-                                       (10 "ten")
-                                       (11 "eleven")
-                                       (12 "twelve")
-                                       nil)
-                                  " "
-                                  (|if|
 (and (greaterp (mkatom minutes)
-                                                    15)
-                                             (lessp (mkatom minutes)
-                                                    45))
-                                      |then|
 "thirty"
-                                    |else|
 "o'clock")
-                                  " "
-                                  (|if|
 (and (greaterp (mkatom minutes)
-                                                    44)
-                                             (equal (findhour
 hour)
-                                                    "11"))
-                                      |then|
 (|if|
 (equal (ampm
 hour)
-                                                          "a.m.")
-                                                 |then|
 "p.m."
-                                               |else|
 "a.m.")
-                                    |else|
 (ampm
 hour))))))))
 
-(findhour

-  (lambda (hour)
                                             (* |ss:| " 8-Feb-86 17:49")

-    (cond
-       ((lessp (mkatom hour)
-               13)
-        (cond
-           ((lessp (mkatom hour)
-                   10)
-            (mkstring (cadr (unpack hour))))
-           (t hour)))
-       (t (mkstring (selectq (mkatom hour)
-                        (13 1)
-                        (14 2)
-                        (15 3)
-                        (16 4)
-                        (17 5)
-                        (18 6)
-                        (19 7)
-                        (20 8)
-                        (21 9)
-                        (22 10)
-                        (23 11)
-                        (24 12)
-                        nil))))))
+(* |;;;| "Functions to change date format")

 
-(ampm

-  (lambda (hour)
-    (|if|
 (or (lessp (mkatom hour)
-                     12)
-              (equal (mkatom hour)
-                     24))
+(DEFINEQ
+
+(FINDTIME

+  (LAMBDA (OLDDATE VERSION)                                  (* \; 
+
                                                           "Edited 24-Oct-2021 13:28 by rmk:")

+
+    (* |;;| 
+
  "RMK: The spell-out default is very strange:  it rounds the minutes to the nearest half hour.")

+
+    (* |;;| "RMK:  Correct for Y2K: Substrings then work.  Still, terrible code.")

+                                                             (* |ss:| "27-Jun-87 15:40")

+    (LET* ((UDATE (\\UNPACKDATE (IDATE OLDDATE)))
+           (HOUR (CAR (NTH UDATE 4)))
+           (MINUTES (CAR (NTH UDATE 5))))
+          (SELECTQ VERSION
+              (ABBREV (CONCAT (FINDHOUR
 HOUR)
+                             ":" MINUTES " " (AMPM
 HOUR)))
+              (EURO (SUBSTRING OLDDATE 13 17))
+              (CONCAT (SELECTQ (|if|
 (LESSP MINUTES 46)
+                                   |then|
 (FINDHOUR
 HOUR)
+                                 |else|
 (PLUS 1 (FINDHOUR
 HOUR)))
+                          (1 "one")
+                          (2 "two")
+                          (3 "three")
+                          (4 "four")
+                          (5 "five")
+                          (6 "six")
+                          (7 "seven")
+                          (8 "eight")
+                          (9 "nine")
+                          (10 "ten")
+                          (11 "eleven")
+                          (12 "twelve")
+                          NIL)
+                     " "
+                     (|if|
 (AND (GREATERP MINUTES 15)
+                                    (LESSP MINUTES 45))
+                         |then|
 "thirty"
+                       |else|
 "o'clock")
+                     " "
+                     (AMPM
 HOUR))))))
+
+(FINDHOUR

+  (LAMBDA (HOUR)                                             (* \; 
+
                                                           "Edited 24-Oct-2021 13:35 by rmk:")

+                                                             (* |ss:| " 8-Feb-86 17:49")

+    (COND
+       ((LESSP HOUR 13)
+        HOUR)
+       (T (IDIFFERENCE HOUR 12)))))
+
+(AMPM

+  (LAMBDA (HOUR)                                             (* \; 
+
                                                           "Edited 24-Oct-2021 13:37 by rmk:")

+    (|if|
 (OR (LESSP HOUR 12)
+                  (EQ HOUR 24))
         |then|
 "a.m."
       |else|
 "p.m.")))
 
@@ -275,55 +273,66 @@
                                                              (* |changed|)

     (not (null (numberp (mkatom n))))))
 
-(findmonth

-  (lambda (olddate version)
                                  (* |ss:| "27-Jun-87 15:40")

-    (prog ((dates '((|Jan| 1 |January|)
-                    (|Feb| 2 |February|)
-                    (|Mar| 3 |March|)
-                    (|Apr| 4 |April|)
-                    (|May| 5 |May|)
-                    (|Jun| 6 |June|)
-                    (|Jul| 7 |July|)
-                    (|Aug| 8 |August|)
-                    (|Sep| 9 |September|)
-                    (|Oct| 10 |October|)
-                    (|Nov| 11 |November|)
-                    (|Dec| 12 |December|)))
-           (output nil))
-          (|if|
 (eq version 'abbrev)
-              |then|
 (setq output (car (cdr (assoc (mkatom (substring olddate 4 6))
-                                                   dates))))
-            |else|
 (setq output (car (cddr (assoc (mkatom (substring olddate 4 6))
-                                                  dates)))))
-          (return output))))
+(FINDMONTH

+  (LAMBDA (OLDDATE VERSION)                                  (* \; 
+
                                                           "Edited 24-Oct-2021 13:52 by rmk:")

+                                                             (* |ss:| "27-Jun-87 15:40")

 
-(findyear

-  (lambda (olddate version)
                                  (* |ss:| "27-Jun-87 15:41")

-    (|if|
 (eq version 'abbrev)
-        |then|
 (mkatom (substring olddate 8 9))
-      |else|
 (mkatom (concat "19" (substring olddate 8 9))))))
+    (* |;;| "\\UNPACKDATE uses 0 origin for months")

+
+    (LET ((MONTH (ASSOC (ADD1 (CAR (NTH (\\UNPACKDATE (IDATE OLDDATE))
+                                        2)))
+                        '((1 |Jan| |January|)
+                          (2 |Feb| |February|)
+                          (3 |Mar| |March|)
+                          (4 |Apr| |April|)
+                          (5 |May| |May|)
+                          (6 |Jun| |June|)
+                          (7 |Jul| |July|)
+                          (8 |Aug| |August|)
+                          (9 |Sep| |September|)
+                          (10 |Oct| |October|)
+                          (11 |Nov| |November|)
+                          (12 |DecDecember|)))))
+         (|if|
 (EQ VERSION 'ABBREV)
+             |then|
 (CADR MONTH)
+           |else|
 (CADDR MONTH)))))
+
+(FINDYEAR

+  (LAMBDA (OLDDATE VERSION)                                  (* \; 
+
                                                           "Edited 24-Oct-2021 13:48 by rmk:")

+                                                             (* |ss:| "27-Jun-87 15:41")

+    (CAR (\\UNPACKDATE (IDATE OLDDATE)))))
 )
 
-(rpaqq date.format.items
 ((|Month Day, Year| '(m d y f) 
-                                     "Insert current date as \"March 8, 1952\"")
-                              (|Month/Day/Year| '(m d y a) "Insert current date as \"3/8/52\"")
-                              (|Day Month, Year| '(d m y f) 
-                                     "Insert current date as \"8 March, 1952\"")
-                              (|Day/Month/Year| '(d m y a) "Insert current date as \"8/3/52\"")
-                              (|Time| '(t f) "Insert current time as \"four thirty p.m.\"")
-                              (|Numbered Time| '(t a) "Insert current time as \"4:30 p.m.\"")
-                              (|Military Time| '(t e) "Insert current time as \"16:30\"")
-                              (|Update| t "Convert to current date/time")))
-(declare\: eval@compile
+(RPAQQ DATE.FORMAT.ITEMS

+       ((|Month Day, Year| '(M D Y F)
+               "Insert current date as \"March 8, 1952\"")
+        (|Month/Day/Year| '(M D Y A)
+               "Insert current date as \"3/8/52\"")
+        (|Day Month, Year| '(D M Y F)
+               "Insert current date as \"8 March, 1952\"")
+        (|Day/Month/Year| '(D M Y A)
+               "Insert current date as \"8/3/52\"")
+        (|Time| '(T F)
+               "Insert current time as \"four thirty p.m.\"")
+        (|Numbered Time| '(T A)
+               "Insert current time as \"4:30 p.m.\"")
+        (|Military Time| '(T E)
+               "Insert current time as \"16:30\"")
+        (|Update| T "Convert to current date/time")))
+(DECLARE\: DOEVAL@COMPILE DONTCOPY 
+(DECLARE\: EVAL@COMPILE
 
-(record daterecord
 (datestring display.date template.date))
+(RECORD DATERECORD
 (DATESTRING DISPLAY.DATE TEMPLATE.DATE))
 )
-(putprops tmax-date copyright ("Xerox Corporation" 1987 1988))
-(declare\: dontcopy
-  (filemap (nil (1398 6132 (dateobj 1408 . 2175) (dateobjp 2177 . 2611) (date.displayfn 2613 . 2935) (
-date.imageboxfn 2937 . 3564) (date.putfn 3566 . 3764) (date.getfn 3766 . 4060) (date.copyfn 4062 . 
-4594) (date.buttoneventinfn 4596 . 6130)) (6174 8957 (current.display.font 6184 . 6890) (
-change.date.format 6892 . 8955)) (9012 14248 (findtime 9022 . 11531) (findhour 11533 . 12290) (ampm 
-12292 . 12496) (findday 12498 . 12769) (nump 12771 . 13000) (findmonth 13002 . 13980) (findyear 13982
- . 14246)))))
-stop
+)
+(PUTPROPS TMAX-DATE COPYRIGHT ("Xerox Corporation" 1987 1988))
+(DECLARE\: DONTCOPY
+  (FILEMAP (NIL (1422 6156 (DATEOBJ 1432 . 2199) (DATEOBJP 2201 . 2635) (DATE.DISPLAYFN 2637 . 2959) (
+DATE.IMAGEBOXFN 2961 . 3588) (DATE.PUTFN 3590 . 3788) (DATE.GETFN 3790 . 4084) (DATE.COPYFN 4086 . 
+4618) (DATE.BUTTONEVENTINFN 4620 . 6154)) (6200 8853 (CURRENT.DISPLAY.FONT 6210 . 6916) (
+CHANGE.DATE.FORMAT 6918 . 8851)) (8906 13305 (FINDTIME 8916 . 10695) (FINDHOUR 10697 . 11058) (AMPM 
+11060 . 11359) (FINDDAY 11361 . 11632) (NUMP 11634 . 11863) (FINDMONTH 11865 . 12981) (FINDYEAR 12983
+ . 13303)))))
+STOP

lispusers/WHEELSCROLL

@@ -1,11 +1,11 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "11-Jun-2021 12:50:16" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;18
 10803  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS ENABLEWHEELSCROLL)
+
(FILECREATED "23-Oct-2021 16:33:29" {DSK}<home>larry>medley>lispusers>WHEELSCROLL.;2
 11221  
 
-      previous date%: "11-Jun-2021 11:11:10" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;14)
+      changes to%:  (VARS WHEELSCROLLCOMS)
+                    (FNS ENABLEWHEELSCROLL WHEELSCROLL)
+
+      previous date%: "11-Jun-2021 12:50:16" {DSK}<home>larry>medley>lispusers>WHEELSCROLL.;1)
 
 
 (PRETTYCOMPRINT WHEELSCROLLCOMS)
@@ -14,15 +14,15 @@
        [(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL 
              LISPINTERRUPTS.WHEELSCROLL)
         
-        (* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")

+        (* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")

 
-        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (UP 156)
-                                                (DOWN 157)
-                                                (LEFT 158)
-                                                (RIGHT 159)))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\WSUP 156)
+                                                (\WSDOWN 157)
+                                                (\WSLEFT 158)
+                                                (\WSRIGHT 159)))
         (GLOBALVARS WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS)
         
-        (* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized")

+        (* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized")

 
         [ADDVARS (AFTERSYSOUTFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T)))
                (AFTERMAKESYSFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T]
@@ -35,65 +35,69 @@
 (DEFINEQ
 
 (ENABLEWHEELSCROLL

-  [LAMBDA (ON
 EXCLUDEHORIZONTAL)
                    (* ; "Edited 11-Jun-2021 12:50 by rmk:")


-                                                            (* ; "Edited 28-May-2021 11:46 by rmk:")

+  [LAMBDA (ON
 EXCLUDEHORIZONTAL)                         (* ; 
+
                                                           "Edited 23-Oct-2021 16:31 by larry")

+                                                             (* ; 
+
                                                           "Edited 11-Jun-2021 12:50 by rmk:")

+                                                             (* ; 
+
                                                           "Edited 28-May-2021 11:46 by rmk:")

 
-    (* ;; "So we can toggle this scrolling.")

+    (* ;; "So we can toggle this scrolling.")

 
-    (IF
 ON
-        THEN
 (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
+    (if
 ON
+        then
 (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
                                  (GETD 'LISPINTERRUPTS.WHEELSCROLL))
                      (CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL)
-                                                             (* ; "In case of LOADFROM?")

+                                                             (* ; "In case of LOADFROM?")

                          (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
                          (MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))) 
 
-              (* ;; "In some situations these other keyactions seem to be installed, hit them all.")

+              (* ;; "In some situations these other keyactions seem to be installed, hit them all.")

 
-              [FOR
 KAT IN
 (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
-                 DO
 ((FOR
 K IN
 [IF
 EXCLUDEHORIZONTAL
-                                               THEN
 `((PAD1 ,UP)
-                                                          (PAD2 ,DOWN)
-                                                          (PAD4 IGNORE)
-                                                          (PAD5 IGNORE))
-                                             ELSE
 `((PAD1 ,UP)
-                                                        (PAD2 ,DOWN)
-                                                        (PAD4 ,LEFT)
-                                                        (PAD5 ,RIGHT]
-                            DO
 (KEYACTION (CAR K)
-                                          (CONS (CL:IF (EQ (CADR K)
-                                                           'IGNORE)
-                                                    'IGNORE
-                                                    `(,(CADR K)
-                                                      ,(CADR K)))
-                                                `IGNORE)
-                                          KAT]
-              (FOR
 I IN
 WHEELSCROLLINTERRUPTS
-                 DO
 (INTERRUPTCHAR (CAR I)
+              (for
 KAT in
 (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
+                 do
 (for
 K in
 [if
 EXCLUDEHORIZONTAL
+                                              then
 `((PAD1 ,\WSUP)
+                                                         (PAD2 ,\WSDOWN)
+                                                         (PAD4 IGNORE)
+                                                         (PAD5 IGNORE))
+                                            else
 `((PAD1 ,\WSUP)
+                                                       (PAD2 ,\WSDOWN)
+                                                       (PAD4 ,\WSLEFT)
+                                                       (PAD5 ,\WSRIGHT]
+                           do
 (KEYACTION (CAR K)
+                                         (CONS (CL:IF (EQ (CADR K)
+                                                          'IGNORE)
+                                                   'IGNORE
+                                                   `(,(CADR K)
+                                                     ,(CADR K)))
+                                               `IGNORE)
+                                         KAT)))
+              (for
 I in
 WHEELSCROLLINTERRUPTS
+                 do
 (INTERRUPTCHAR (CAR I)
                                (CADR I)
                                (CADDR I))
                        (CL:WHEN (BOUNDP 'TEDIT.READTABLE)
 
-                           (* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")

+                           (* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")

 
                            (TEDIT.SETFUNCTION (CAR I)
                                   `[LAMBDA NIL
                                      ,(CADR I]
                                   TEDIT.READTABLE)))
               (SETQ WHEELSCROLLENABLED T)
-      ELSE
 (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
+      else
 (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
                              (GETD 'LISPINTERRUPTS))
                    (MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS))
-            (FOR
 I IN
 WHEELSCROLLINTERRUPTS DO
 (INTERRUPTCHAR (CAR I)
+            (for
 I in
 WHEELSCROLLINTERRUPTS do
 (INTERRUPTCHAR (CAR I)
                                                                   NIL)
                                                           (CL:WHEN (BOUNDP 'TEDIT.READTABLE)
 
-                                                (* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")

+                                                (* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")

 
                                                               (TEDIT.SETFUNCTION (CAR I)
                                                                      NIL TEDIT.READTABLE)))
-            (FOR
 KAT IN
 (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
-               DO
 (KEYACTION 'PAD1 '(IGNORE . IGNORE)
+            (for
 KAT in
 (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
+               do
 (KEYACTION 'PAD1 '(IGNORE . IGNORE)
                              KAT)
                      (KEYACTION 'PAD2 '(IGNORE . IGNORE)
                             KAT)
@@ -104,41 +108,42 @@
             (SETQ WHEELSCROLLENABLED NIL])
 
 (WHEELSCROLL

-  [LAMBDA (DIRECTION DELTA)
                             (* ; "Edited 21-Feb-2021 09:38 by rmk:")

+  [LAMBDA (DIRECTION DELTA)                                  (* ; 
+
                                                           "Edited 21-Feb-2021 09:38 by rmk:")

 
-    (* ;; "The wheel may accidentally turn (giving the interrupt) when the users intention is simply to push the middle button.  And there may be another accidental turn (also giving an interrupt) when the user is releasing the middle button.  We don't yet have a good solution to this problem.  (This is not an issue with a trackpad)")

+    (* ;; "The wheel may accidentally turn (giving the interrupt) when the users intention is simply to push the middle button.  And there may be another accidental turn (also giving an interrupt) when the user is releasing the middle button.  We don't yet have a good solution to this problem.  (This is not an issue with a trackpad)")

 
-    (* ;; "")

+    (* ;; "")

 
-    (CL:WHEN (MOUSESTATE UP)                                 (* ; 
-
                                                           "Ignore interrupt if a button is down")

+    (CL:WHEN (MOUSESTATE UP)                                 (* ; 
+
                                                           "Ignore interrupt if a button is down")

         [LET ((W (WHICHW)))
 
-         (* Unsuccessful a ttempt to suppress scroll if middlebutton comes down within 
-
       the setetle time (NOT (UNTILMOUSESTATE (ONLY MIDDLE) WHEELSCROLLSETTLETIME)))

+         (* Unsuccessful a ttempt to suppress scroll if middlebutton comes down within 
+
       the setetle time (NOT (UNTILMOUSESTATE (ONLY MIDDLE) WHEELSCROLLSETTLETIME)))

 
              (CL:WHEN W
 
-                 (* ;; "We scroll only if the window has a scrollfn.  Our behavior is thus different from a direct call to SCROLLW, which defaults to SCROLLBYREPAINTFN in that case, but conforms to what happens with IN/SCROLL/BAR? and SCROLL.HANDLER in WINDOWSCROLL.  Menus and scrollbars typically do not have scrollfns, so this suppresses otherwise funky behavior. ")

+                 (* ;; "We scroll only if the window has a scrollfn.  Our behavior is thus different from a direct call to SCROLLW, which defaults to SCROLLBYREPAINTFN in that case, but conforms to what happens with IN/SCROLL/BAR? and SCROLL.HANDLER in WINDOWSCROLL.  Menus and scrollbars typically do not have scrollfns, so this suppresses otherwise funky behavior. ")

 
-                 (IF
 (WINDOWPROP W 'SCROLLFN)
-                     THEN
 [PROCESS.EVAL (FIND.PROCESS 'MOUSE)
+                 (if
 (WINDOWPROP W 'SCROLLFN)
+                     then
 [PROCESS.EVAL (FIND.PROCESS 'MOUSE)
                                      (CL:IF (EQ DIRECTION 'VERTICAL)
                                          `(WHEELSCROLL.DOIT
 ,(KWOTE W)
                                                  0
                                                  ,DELTA)
                                          `(WHEELSCROLL.DOIT
 ,(KWOTE W)
                                                  ,DELTA 0))]
-                   ELSEIF
 (EQ DIRECTION 'VERTICAL)
-                     THEN
 
+                   elseif
 (EQ DIRECTION 'VERTICAL)
+                     then
 
 
-                           (* ;; "We are in a pop-up scrollbar.  This moves the cursor there, the user has to click to scroll the main window.")

+                           (* ;; "We are in a pop-up scrollbar.  This moves the cursor there, the user has to click to scroll the main window.")

 
                            (CL:WHEN (WINDOWPROP W 'VERTICALSCROLLBARFOR)
                                (\CURSORPOSITION LASTMOUSEX (IPLUS LASTMOUSEY DELTA))
                                (GETMOUSESTATE))
-                   ELSEIF
 (EQ DIRECTION 'HORIZONTAL)
-                     THEN
 (CL:WHEN (WINDOWPROP W 'HORIZONTALSCROLLBARFOR)
+                   elseif
 (EQ DIRECTION 'HORIZONTAL)
+                     then
 (CL:WHEN (WINDOWPROP W 'HORIZONTALSCROLLBARFOR)
                                   (\CURSORPOSITION (IPLUS DELTA LASTMOUSEX)
                                          LASTMOUSEY)
                                   (GETMOUSESTATE))))])])
@@ -186,19 +191,19 @@
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
-(RPAQQ UP
 156)
+(RPAQQ \WSUP
 156)
 
-(RPAQQ DOWN
 157)
+(RPAQQ \WSDOWN
 157)
 
-(RPAQQ LEFT
 158)
+(RPAQQ \WSLEFT
 158)
 
-(RPAQQ RIGHT
 159)
+(RPAQQ \WSRIGHT
 159)
 
 
-(CONSTANTS (UP 156)
-       (DOWN 157)
-       (LEFT 158)
-       (RIGHT 159))
+(CONSTANTS (\WSUP 156)
+       (\WSDOWN 157)
+       (\WSLEFT 158)
+       (\WSRIGHT 159))
 )
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -229,6 +234,6 @@
 (ENABLEWHEELSCROLL
 T)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1575 9814 (ENABLEWHEELSCROLL 1585 . 5542) (WHEELSCROLL 5544 . 8080) (WHEELSCROLL.DOIT 
-8082 . 8718) (INSTALL-WHEELSCROLL 8720 . 9535) (LISPINTERRUPTS.WHEELSCROLL 9537 . 9812)))))
+  (FILEMAP (NIL (1604 10208 (ENABLEWHEELSCROLL 1614 . 5871) (WHEELSCROLL 5873 . 8474) (WHEELSCROLL.DOIT 
+8476 . 9112) (INSTALL-WHEELSCROLL 9114 . 9929) (LISPINTERRUPTS.WHEELSCROLL 9931 . 10206)))))
 STOP

lispusers/WHEELSCROLL.TXT

@@ -2,7 +2,7 @@ lispusers/WHEELSCROLL
 
 Written by Ron Kaplan,  February 2021.
 
-This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving fingers on a track pad.
+This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving (2?) fingers on a track pad.
 
 The capability is enabled when WHEELSCROLL.LCOM is loaded.
 
@@ -13,11 +13,13 @@ It is toggled on and off by
 The scrolling speed is controlled by the variable
 
 WHEELSCROLLDELTA (initially 20)
-	The number of points to scroll for each click of the wheel.  Higher values give faster scrolling.  A negative value reverses the scrolling direction.
+	The number of points to scroll for each click of the wheel.  Higher values give faster scrolling.  A negative value reverses the scrolling direction.  
 
 Implementation:
 
-Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down.  (ENABLEWHEELSCROLL T) modifies the keyaction table that maps these to characters 520 and 521, and those characters are defined as interrupts that invoke the scrolling action.  (ENABLEWHEELSCROLL NIL) causes PAD1 and PAD2 to be ignored.
+Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down.  (ENABLEWHEELSCROLL T) modifies the keyaction table so that it maps these transitions to characters 156 and 157. Those characters are defined as interrupts that invoke the vertical scrolling action.  For horizontal scrolling sideways pushes of a wheel (if it has that) produce transitions on PAD4 and PAD5, which map to interrupt-characters 158 and 159. (156-159 are the highest  right-panel characters of character-set 0 that correspond to left-panel control characters, so typically have no other conflicting meaning.)
+
+(ENABLEWHEELSCROLL NIL) causes PAD1, PAD2, PAD4, and PAD5 to be ignored.
 
 Current negative features:
 
@@ -25,4 +27,4 @@ Current negative features:
 
 We need to develop a strategy, either in Lisp, Maiko, or X, to discriminate intended middle-button pushes from intended scrolling.  This is not an issue for track-pad scrolling.
 
-2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the Tedit window may scroll.
+2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the partially obscured Tedit window may scroll.

loadups/README.md

@@ -0,0 +1,15 @@
+# medley/loadups
+
+This directory is for holding the sysouts from a release
+* lisp.sysout    (the system in the IRM + Common Lisp)
+* full.sysout    (lisp + modernizations + TEdit and others)
+   
+* starter.sysout you have to have a running Medley to make a new one(!)
+  this file is just a stable place to stand.
+
+* whereis.hash  A "hash file" directory index of everything
+
+* lisp.venuesysout full.venuesysout -- vintage sysouts for comparision
+
+Plus, if you make your own loadups (from BUILDING.md) you'll see some .dribble files which are the logs of the build proccess.
+

release-notes.md

@@ -1,41 +1,6 @@
-There are separate releases of medley and maiko.
-Just get the latest version of each.
-
-Alternatively, you can pick up the medley release, and build your own maiko.
-
-Get the Maiko release [here](https://github.com/Interlisp/maiko/releases).
-
-The medley release comes in two parts:
-1. The "loadups" (download `$tag-loadups.tgz` below)
-2. The "runtime" (download `$tag-runtime.tgz` below)
-
-You won't need the "runtime" if you clone medley; it's just a subset. 
-   
-To download both using 'gh' GitHub command line:
-```
-   gh release download -R Interlisp/medley -p "*"
-```
-
-To use (from a shell/terminal window):
-
-1. Unpack the medley tar file(s)
-```
-  tar -xvfz $tag-loadups.tgz
-  tar -xvfz $tag-runtime.tgz
-```
-
-2. Unpack the maiko file for your operating system and CPU type, e.g.,
-
-   ```
-     tar -xvfz maiko-210823.linux.x86_64.tgz
-   ```
-
-3. This should leave you with two directories, `medley` and `maiko`.
-  Then you can 
-   ```
-   cd medley
-   ./run-medley -full
-   ```
+See the [Medley README](https://github.com/Interlisp/medley#readme)for 
+information on how to set up to use Medley.
 
+DELETE THIS PARAGRAPH and replace it with a description of what changed since the last release (using the GitHub web ui).
 
 

run-medley

@@ -51,7 +51,7 @@ if [ -z "$LDEDESTSYSOUT" ] ; then
 fi
 
 if [ -z "$LDEINIT" ] ; then
-    export LDEINIT="$MEDLEYDIR/greetfiles/SIMPLE-INIT"
+    export LDEINIT="$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT"
 fi
 
 export LDEKBDTYPE=x
@@ -195,4 +195,3 @@ export INMEDLEY=1
 
 "$prog" $noscroll $geometry $screensize $mem -t "Medley Interlisp" $passthrough_args "$LDESRCESYSOUT"
 
-

scripts/release-medley.sh

@@ -29,7 +29,7 @@ tar cfz medley/tmp/$tag-runtime.tgz                       \
     --exclude "*~" --exclude "*#*"                        \
     medley/docs/dinfo                                     \
     medley/docs/Documentation\ Tools                      \
-    medley/greetfiles/SIMPLE-INIT                         \
+    medley/greetfiles                                     \
     medley/run-medley                                     \
     medley/scripts                                        \
     medley/fonts/displayfonts  medley/fonts/altofonts     \

sources/ATBL

@@ -1,10 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "21-Aug-2021 08:06:49" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;22
 91541  
 
-      changes to%:  (FNS \ORIGTERMTABLE)
+
(FILECREATED "24-Oct-2021 21:53:59" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;28
 92451  
 
-      previous date%: "19-Aug-2021 14:45:21" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;21)
+      changes to%:  (FNS MAKE-READER-ENVIRONMENT)
+
+      previous date%: "24-Oct-2021 20:14:01" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;27)
 
 
 (* ; "
@@ -14,15 +15,15 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 (PRETTYCOMPRINT ATBLCOMS)
 
 (RPAQQ ATBLCOMS

-       [(COMS                                                (* ; 
-
                                                      "Common features of read and terminal tables")

+       [(COMS                                                (* ; 
+
                                                      "Common features of read and terminal tables")

               (DECLARE%: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE)
                                          (RECORDS CHARTABLE))
                      (CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW)
                      (MACROS \CREATENSCHARHASH))
               (FNS GETSYNTAX SETSYNTAX SYNTAXP \COPYSYNTAX \GETCHARCODE \SETFATSYNCODE \MAPCHARTABLE)
               )
-        (COMS                                                (* ; "terminal tables")

+        (COMS                                                (* ; "terminal tables")

               (FNS CONTROL COPYTERMTABLE DELETECONTROL GETDELETECONTROL ECHOCHAR ECHOCONTROL ECHOMODE
                    GETECHOMODE GETCONTROL GETTERMTABLE RAISE GETRAISE RESETTERMTABLE SETTERMTABLE 
                    TERMTABLEP \GETTERMSYNTAX \GTTERMTABLE \ORIGTERMTABLE \SETTERMSYNTAX 
@@ -31,16 +32,16 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
                                          (CONSTANTS * TERMCLASSES)
                                          (RECORDS TERMCODE TERMTABLEP)))
               (INITRECORDS TERMTABLEP))
-        (COMS                                                (* ; "read tables")

+        (COMS                                                (* ; "read tables")

               (FNS COPYREADTABLE FIND-READTABLE IN-READTABLE ESCAPE GETBRK GETREADTABLE GETSEPR 
                    READMACROS READTABLEP READTABLEPROP RESETREADTABLE SETBRK SETREADTABLE SETSEPR 
                    \GETREADSYNTAX \GTREADTABLE \GTREADTABLE1 \ORIGREADTABLE \READCLASSTOCODE 
                    \SETMACROSYNTAX \SETREADSYNTAX \READTABLEP.DEFPRINT)
               (PROP ARGNAMES READTABLEPROP)
-              (DECLARE%: EVAL@COMPILE DONTCOPY               (* ; 
-
                             "READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's")

-                                                             (* ; 
-
                                                    "OTHER must be zero because of initialization.")

+              (DECLARE%: EVAL@COMPILE DONTCOPY               (* ; 
+
                             "READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's")

+                                                             (* ; 
+
                                                    "OTHER must be zero because of initialization.")

                      [VARS READCLASSTOKENS (READCLASSES (MAPCAR READCLASSTOKENS
                                                                (FUNCTION (LAMBDA
                                                                           (PAIR)
@@ -48,8 +49,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
                                                                                        ".RC")
                                                                                 (CADR PAIR]
                      (MACROS \COMPUTED.FORM)
-                                                             (* ; 
-
                                                          "This macro ought to be official somehow")

+                                                             (* ; 
+
                                                          "This macro ought to be official somehow")

                      (RECORDS CONTEXTS ESCAPES WAKEUPS)
                      (EXPORT (MACROS \GETREADMACRODEF \GTREADTABLE \GTREADTABLE1)
                             (CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
@@ -64,8 +65,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
         [COMS (INITVARS (\READTABLEHASH))
               (FNS \ATBLSET)
               (INITRECORDS READER-ENVIRONMENT)
-                                                             (* ; 
-
            "Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*")

+                                                             (* ; 
+
            "Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*")

               (FNS MAKE-READER-ENVIRONMENT EQUAL-READER-ENVIRONMENT SET-READER-ENVIRONMENT)
               (INITVARS (*LISP-PACKAGE*)
                      (*INTERLISP-PACKAGE*)
@@ -85,8 +86,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 
 (PUTPROPS \SYNCODE
 DMACRO
 [OPENLAMBDA (TABLE CHAR)
                                     (CHECK (type?
 CHARTABLE TABLE))
-                                                             (* ; 
-
                                                       "0 is either NONE.TC, REAL.CCE, or OTHER.RC")

+                                                             (* ; 
+
                                                       "0 is either NONE.TC, REAL.CCE, or OTHER.RC")

                                     (COND
                                        ((IGREATERP CHAR \MAXTHINCHAR)
                                         (OR (AND (fetch
 (CHARTABLE NSCHARHASH) of
 TABLE)
@@ -97,8 +98,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 
 (PUTPROPS \SETSYNCODE
 DMACRO
 [LAMBDA (TABLE CHAR CODE)
                                        (CHECK (type?
 CHARTABLE TABLE))
-                                                             (* ; 
-
                                                           "0 is REAL.CCE, NONE.TC, OTHER.RC")

+                                                             (* ; 
+
                                                           "0 is REAL.CCE, NONE.TC, OTHER.RC")

                                        (COND
                                           ((ILEQ CHAR \MAXTHINCHAR)
                                            (\PUTBASEBYTE TABLE CHAR CODE))
@@ -401,8 +402,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \CREATENSCHARHASH
 MACRO
 (ARGS              (* ; 
-
                        "added size argument for creation of \ORIGTERMTABLE during initialization.")

+(PUTPROPS \CREATENSCHARHASH
 MACRO
 (ARGS              (* ; 
+
                        "added size argument for creation of \ORIGTERMTABLE during initialization.")

                                                 (LIST 'HASHARRAY (OR (CAR ARGS)
                                                                      '\NSCHARHASHKEYS)
                                                       '\NSCHARHASHOVERFLOW)))
@@ -949,8 +950,8 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 (DECLARE%: EVAL@COMPILE
 
 (ACCESSFNS TERMCODE
 ((CCECHO (LOGAND DATUM 24))
-                         (TERMCLASS (LOGAND DATUM 7)))       (* ; 
-
                                                  "We assume that values are appropriately shifted")

+                         (TERMCLASS (LOGAND DATUM 7)))       (* ; 
+
                                                  "We assume that values are appropriately shifted")

                         (CREATE
 (LOGOR CCECHO TERMCLASS)))
 
 (DATATYPE TERMTABLEP
 (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL 
@@ -1640,34 +1641,34 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 
 (RECORD READMACRODEF
 (MACROTYPE . MACROFN))
 
-(DATATYPE READTABLEP
 ((READSA POINTER)                   (* ; 
-
                                                         "A CHARTABLE defining syntax of each char")

-                          (READMACRODEFS POINTER)            (* ; 
-
                                      "A hash table associating macro chars with macro definitions")

-                          (READMACROFLG FLAG)                (* ; 
-
           "True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)")

-                          (ESCAPEFLG FLAG)                   (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)")

-                          (COMMONLISP FLAG)                  (* ; 
-
           "True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules")

-                          (NUMBERBASE BITS 5)                (* ; "Not used")

-                          (CASEINSENSITIVE FLAG)             (* ; 
-
                         "If true, unescaped lowercase chars are converted to uppercase in symbols")

-                          (COMMONNUMSYNTAX FLAG)             (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers")

-                          (USESILPACKAGE FLAG)               (* ; 
-
                                   "If true, IL:READ ignores *PACKAGE* and reads in the IL package")

+(DATATYPE READTABLEP
 ((READSA POINTER)                   (* ; 
+
                                                         "A CHARTABLE defining syntax of each char")

+                          (READMACRODEFS POINTER)            (* ; 
+
                                      "A hash table associating macro chars with macro definitions")

+                          (READMACROFLG FLAG)                (* ; 
+
           "True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)")

+                          (ESCAPEFLG FLAG)                   (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)")

+                          (COMMONLISP FLAG)                  (* ; 
+
           "True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules")

+                          (NUMBERBASE BITS 5)                (* ; "Not used")

+                          (CASEINSENSITIVE FLAG)             (* ; 
+
                         "If true, unescaped lowercase chars are converted to uppercase in symbols")

+                          (COMMONNUMSYNTAX FLAG)             (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers")

+                          (USESILPACKAGE FLAG)               (* ; 
+
                                   "If true, IL:READ ignores *PACKAGE* and reads in the IL package")

                           (NIL 5 FLAG)
-                          (DISPATCHMACRODEFS POINTER)        (* ; 
-
                                 "An a-list of dispatching macro char and its dispatch definitions")

-                          (HASHMACROCHAR BYTE)               (* ; 
-
                              "The character code used in this read table for the # dispatch macro")

-                          (ESCAPECHAR BYTE)                  (* ; 
-
                                     "The character code used in this read table for single escape")

-                          (MULTESCAPECHAR BYTE)              (* ; 
-
                                   "The character code used in this read table for multiple escape")

-                          (PACKAGECHAR BYTE)                 (* ; 
-
                                 "The character code used in this read table for package delimiter")

-                          (READTBLNAME POINTER)              (* ; 
-
                                                          "The canonical 'name' of this read table")

+                          (DISPATCHMACRODEFS POINTER)        (* ; 
+
                                 "An a-list of dispatching macro char and its dispatch definitions")

+                          (HASHMACROCHAR BYTE)               (* ; 
+
                              "The character code used in this read table for the # dispatch macro")

+                          (ESCAPECHAR BYTE)                  (* ; 
+
                                     "The character code used in this read table for single escape")

+                          (MULTESCAPECHAR BYTE)              (* ; 
+
                                   "The character code used in this read table for multiple escape")

+                          (PACKAGECHAR BYTE)                 (* ; 
+
                                 "The character code used in this read table for package delimiter")

+                          (READTBLNAME POINTER)              (* ; 
+
                                                          "The canonical 'name' of this read table")

                           )
                          READSA _ (create
 CHARTABLE))
 )
@@ -1833,14 +1834,33 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (MAKE-READER-ENVIRONMENT

-  [LAMBDA (PACKAGE READTABLE BASE FORMAT PACKAGEFORM READTABLEFORM)

-                                                            (* ; "Edited 16-Aug-2021 23:44 by rmk:")

+  [LAMBDA (PACKAGE READTABLE BASE FORMAT PACKAGEFORM READTABLEFORM)
+                                                             (* ; 
+
                                                           "Edited 24-Oct-2021 21:53 by rmk:")

+                                                             (* ; 
+
                                                           "Edited 16-Aug-2021 23:44 by rmk:")

+
+    (* ;; "PACKAGE can be a prop list of keyword-values")

+
+    (CL:WHEN (LISTP PACKAGE)
+        (CL:UNLESS READTABLE
+            (SETQ READTABLE (LISTGET PACKAGE :READTABLE)))
+        (CL:UNLESS BASE
+            (SETQ BASE (LISTGET PACKAGE :BASE)))
+        (CL:UNLESS FORMAT
+            (SETQ FORMAT (LISTGET PACKAGE :FORMAT)))
+        (SETQ PACKAGE (LISTGET PACKAGE :PACKAGE)))
     (create
 READER-ENVIRONMENT
            REPACKAGE _ (COND
-                          (PACKAGE (\DTEST PACKAGE 'PACKAGE))
+                          ((CL:PACKAGEP PACKAGE)
+                           PACKAGE)
+                          [PACKAGE (OR (CL:FIND-PACKAGE PACKAGE)
+                                       (\DEST PACKAGE 'PACKAGE]
                           (T *PACKAGE*))
            REREADTABLE _ (COND
-                            (READTABLE (\DTEST READTABLE 'READTABLEP))
+                            ((READTABLEP
 READTABLE))
+                            [READTABLE (OR (FIND-READTABLE
 READTABLE)
+                                           (\DEST READTABLE 'READTABLEP]
                             (T *READTABLE*))
            REBASE _ (COND
                        (BASE (\CHECKRADIX BASE))
@@ -1904,22 +1924,22 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
 (PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018 
 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (18036 29188 (GETSYNTAX 18046 . 22877) (SETSYNTAX 22879 . 23952) (SYNTAXP 23954 . 26451)
- (\COPYSYNTAX 26453 . 27170) (\GETCHARCODE 27172 . 27460) (\SETFATSYNCODE 27462 . 28753) (
-\MAPCHARTABLE 28755 . 29186)) (29221 44187 (CONTROL 29231 . 29483) (COPYTERMTABLE 29485 . 29852) (
-DELETECONTROL 29854 . 32495) (GETDELETECONTROL 32497 . 33459) (ECHOCHAR 33461 . 34902) (ECHOCONTROL 
-34904 . 35361) (ECHOMODE 35363 . 35609) (GETECHOMODE 35611 . 35775) (GETCONTROL 35777 . 35943) (
-GETTERMTABLE 35945 . 36012) (RAISE 36014 . 36440) (GETRAISE 36442 . 36604) (RESETTERMTABLE 36606 . 
-37690) (SETTERMTABLE 37692 . 37926) (TERMTABLEP 37928 . 38089) (\GETTERMSYNTAX 38091 . 38362) (
-\GTTERMTABLE 38364 . 38700) (\ORIGTERMTABLE 38702 . 42312) (\SETTERMSYNTAX 42314 . 42949) (
-\TERMCLASSTOCODE 42951 . 43380) (\TERMCODETOCLASS 43382 . 43769) (\LITCHECK 43771 . 44185)) (46717 
-70541 (COPYREADTABLE 46727 . 46925) (FIND-READTABLE 46927 . 47074) (IN-READTABLE 47076 . 47236) (
-ESCAPE 47238 . 47491) (GETBRK 47493 . 47631) (GETREADTABLE 47633 . 47769) (GETSEPR 47771 . 47909) (
-READMACROS 47911 . 48174) (READTABLEP 48176 . 48339) (READTABLEPROP 48341 . 53499) (RESETREADTABLE 
-53501 . 57748) (SETBRK 57750 . 59360) (SETREADTABLE 59362 . 59550) (SETSEPR 59552 . 61094) (
-\GETREADSYNTAX 61096 . 63786) (\GTREADTABLE 63788 . 64013) (\GTREADTABLE1 64015 . 64271) (
-\ORIGREADTABLE 64273 . 66181) (\READCLASSTOCODE 66183 . 66634) (\SETMACROSYNTAX 66636 . 68431) (
-\SETREADSYNTAX 68433 . 69494) (\READTABLEP.DEFPRINT 69496 . 70539)) (83633 88086 (\ATBLSET 83643 . 
-88084)) (88533 91065 (MAKE-READER-ENVIRONMENT 88543 . 89321) (EQUAL-READER-ENVIRONMENT 89323 . 90467) 
-(SET-READER-ENVIRONMENT 90469 . 91063)))))
+  (FILEMAP (NIL (18046 29198 (GETSYNTAX 18056 . 22887) (SETSYNTAX 22889 . 23962) (SYNTAXP 23964 . 26461)
+ (\COPYSYNTAX 26463 . 27180) (\GETCHARCODE 27182 . 27470) (\SETFATSYNCODE 27472 . 28763) (
+\MAPCHARTABLE 28765 . 29196)) (29231 44197 (CONTROL 29241 . 29493) (COPYTERMTABLE 29495 . 29862) (
+DELETECONTROL 29864 . 32505) (GETDELETECONTROL 32507 . 33469) (ECHOCHAR 33471 . 34912) (ECHOCONTROL 
+34914 . 35371) (ECHOMODE 35373 . 35619) (GETECHOMODE 35621 . 35785) (GETCONTROL 35787 . 35953) (
+GETTERMTABLE 35955 . 36022) (RAISE 36024 . 36450) (GETRAISE 36452 . 36614) (RESETTERMTABLE 36616 . 
+37700) (SETTERMTABLE 37702 . 37936) (TERMTABLEP 37938 . 38099) (\GETTERMSYNTAX 38101 . 38372) (
+\GTTERMTABLE 38374 . 38710) (\ORIGTERMTABLE 38712 . 42322) (\SETTERMSYNTAX 42324 . 42959) (
+\TERMCLASSTOCODE 42961 . 43390) (\TERMCODETOCLASS 43392 . 43779) (\LITCHECK 43781 . 44195)) (46727 
+70551 (COPYREADTABLE 46737 . 46935) (FIND-READTABLE 46937 . 47084) (IN-READTABLE 47086 . 47246) (
+ESCAPE 47248 . 47501) (GETBRK 47503 . 47641) (GETREADTABLE 47643 . 47779) (GETSEPR 47781 . 47919) (
+READMACROS 47921 . 48184) (READTABLEP 48186 . 48349) (READTABLEPROP 48351 . 53509) (RESETREADTABLE 
+53511 . 57758) (SETBRK 57760 . 59370) (SETREADTABLE 59372 . 59560) (SETSEPR 59562 . 61104) (
+\GETREADSYNTAX 61106 . 63796) (\GTREADTABLE 63798 . 64023) (\GTREADTABLE1 64025 . 64281) (
+\ORIGREADTABLE 64283 . 66191) (\READCLASSTOCODE 66193 . 66644) (\SETMACROSYNTAX 66646 . 68441) (
+\SETREADSYNTAX 68443 . 69504) (\READTABLEP.DEFPRINT 69506 . 70549)) (83643 88096 (\ATBLSET 83653 . 
+88094)) (88543 91975 (MAKE-READER-ENVIRONMENT 88553 . 90231) (EQUAL-READER-ENVIRONMENT 90233 . 91377) 
+(SET-READER-ENVIRONMENT 91379 . 91973)))))
 STOP

sources/CLSTREAMS

@@ -1,104 +1,94 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 3-Apr-91 15:11:53" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CLSTREAMS.;4|
 54013  
 
-      |changes| |to:|  (FUNCTIONS CL:WITH-INPUT-FROM-STRING)
+
(FILECREATED "27-Nov-2021 13:30:46" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CLSTREAMS.;3|
 53235  
 
-      |previous| |date:| "27-Feb-91 20:05:55" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>CLSTREAMS.;3|)
+      |previous| |date:| " 3-Apr-91 15:11:53" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CLSTREAMS.;2|)
 
 
-; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1985-1988, 1990-1991 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT CLSTREAMSCOMS)
 
-(RPAQQ CLSTREAMSCOMS
 (
+(RPAQQ CLSTREAMSCOMS

+       (
 
 (* |;;;| "Implements a number of stream functions from CommonLisp.  See CLtL chapter 21")

 
-                          (COMS 
-                                (* |;;| "documented functions and macros")

+        (COMS 
+              (* |;;| "documented functions and macros")

 
-                                (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT)
-                                (FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P 
-                                       CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P)
-                                (COMS (FUNCTIONS FILE-STREAM-POSITION)
-                                      (SETFS FILE-STREAM-POSITION))
-                                (FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P 
-                                       XCL:SYNONYM-STREAM-SYMBOL XCL:FOLLOW-SYNONYM-STREAMS)
-                                (FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P 
-                                       XCL:BROADCAST-STREAM-STREAMS)
-                                (FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P 
-                                       XCL:CONCATENATED-STREAM-STREAMS)
-                                (FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P 
-                                       XCL:TWO-WAY-STREAM-OUTPUT-STREAM 
-                                       XCL:TWO-WAY-STREAM-INPUT-STREAM)
-                                (FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P 
-                                       XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM)
-                                (FUNCTIONS CL:MAKE-STRING-INPUT-STREAM 
-                                       MAKE-CONCATENATED-STRING-INPUT-STREAM)
-                                (FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS)
-                                (FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING 
-                                       CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE)
-                                (FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM 
-                                       MAKE-FILL-POINTER-OUTPUT-STREAM CL:GET-OUTPUT-STREAM-STRING 
-                                       \\STRING-STREAM-OUTCHARFN \\ADJUSTABLE-STRING-STREAM-OUTCHARFN
-                                       ))
-                          (COMS 
-                                (* |;;| "helpers")

+              (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT)
+              (FUNCTIONS CL:STREAM-ELEMENT-TYPE CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P 
+                     XCL:OPEN-STREAM-P)
+              (COMS (FUNCTIONS FILE-STREAM-POSITION)
+                    (SETFS FILE-STREAM-POSITION))
+              (FUNCTIONS CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL 
+                     XCL:FOLLOW-SYNONYM-STREAMS)
+              (FUNCTIONS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P XCL:BROADCAST-STREAM-STREAMS
+                     )
+              (FUNCTIONS CL:MAKE-CONCATENATED-STREAM XCL:CONCATENATED-STREAM-P 
+                     XCL:CONCATENATED-STREAM-STREAMS)
+              (FUNCTIONS CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM
+                     XCL:TWO-WAY-STREAM-INPUT-STREAM)
+              (FUNCTIONS CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P XCL:ECHO-STREAM-INPUT-STREAM 
+                     XCL:ECHO-STREAM-OUTPUT-STREAM)
+              (FUNCTIONS CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM)
+              (FUNCTIONS %MAKE-INITIAL-STRING-STREAM-CONTENTS)
+              (FUNCTIONS CL:WITH-OPEN-STREAM CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING 
+                     CL:WITH-OPEN-FILE)
+              (FUNCTIONS CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM 
+                     CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN 
+                     \\ADJUSTABLE-STRING-STREAM-OUTCHARFN))
+        (COMS 
+              (* |;;| "helpers")

 
-                                (FUNCTIONS %NEW-FILE PREDICT-NAME)
-                                (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS)))
-                          (COMS 
-                                (* |;;| "methods for the special devices")

+              (FUNCTIONS %NEW-FILE PREDICT-NAME)
+              (DECLARE\: EVAL@COMPILE DONTCOPY (FUNCTIONS INTERLISP-ACCESS)))
+        (COMS 
+              (* |;;| "methods for the special devices")

 
-                                (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN
-                                     %BROADCAST-STREAM-DEVICE-CLOSEFILE 
-                                     %BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
-                                (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN)
-                                (FNS %CONCATENATED-STREAM-DEVICE-BIN 
-                                     %CONCATENATED-STREAM-DEVICE-CLOSEFILE 
-                                     %CONCATENATED-STREAM-DEVICE-EOFP 
-                                     %CONCATENATED-STREAM-DEVICE-PEEKBIN 
-                                     %CONCATENATED-STREAM-DEVICE-BACKFILEPTR)
-                                (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)
-                                (FNS %ECHO-STREAM-DEVICE-BIN)
-                                (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
-                                (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT 
-                                     %SYNONYM-STREAM-DEVICE-OUTCHARFN 
-                                     %SYNONYM-STREAM-DEVICE-CLOSEFILE %SYNONYM-STREAM-DEVICE-EOFP 
-                                     %SYNONYM-STREAM-DEVICE-FORCEOUTPUT 
-                                     %SYNONYM-STREAM-DEVICE-GETFILEINFO 
-                                     %SYNONYM-STREAM-DEVICE-PEEKBIN %SYNONYM-STREAM-DEVICE-READP 
-                                     %SYNONYM-STREAM-DEVICE-BACKFILEPTR 
-                                     %SYNONYM-STREAM-DEVICE-SETFILEINFO 
-                                     %SYNONYM-STREAM-DEVICE-CHARSETFN)
-                                (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM 
-                                     %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM
-                                     %TWO-WAY-STREAM-DEVICE-OUTCHARFN 
-                                     %TWO-WAY-STREAM-DEVICE-CLOSEFILE %TWO-WAY-STREAM-DEVICE-EOFP 
-                                     %TWO-WAY-STREAM-DEVICE-READP %TWO-WAY-STREAM-DEVICE-BACKFILEPTR
-                                     %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 
-                                     %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)
-                                (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE 
-                                       %FILL-POINTER-STREAM-DEVICE-GETFILEPTR)
-                                (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE 
-                                       %CONCATENATED-STREAM-DEVICE %TWO-WAY-STREAM-DEVICE 
-                                       %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE))
-                          (COMS 
-                                (* |;;| "helper stuff")

+              (FNS %BROADCAST-STREAM-DEVICE-BOUT %BROADCAST-STREAM-DEVICE-OUTCHARFN 
+                   %BROADCAST-STREAM-DEVICE-CLOSEFILE %BROADCAST-STREAM-DEVICE-FORCEOUTPUT)
+              (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN)
+              (FNS %CONCATENATED-STREAM-DEVICE-BIN %CONCATENATED-STREAM-DEVICE-CLOSEFILE 
+                   %CONCATENATED-STREAM-DEVICE-EOFP %CONCATENATED-STREAM-DEVICE-PEEKBIN 
+                   %CONCATENATED-STREAM-DEVICE-BACKFILEPTR)
+              (FUNCTIONS %CONCATENATED-STREAM-DEVICE-CHARSETFN)
+              (FNS %ECHO-STREAM-DEVICE-BIN)
+              (FUNCTIONS %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM)
+              (FNS %SYNONYM-STREAM-DEVICE-BIN %SYNONYM-STREAM-DEVICE-BOUT 
+                   %SYNONYM-STREAM-DEVICE-OUTCHARFN %SYNONYM-STREAM-DEVICE-CLOSEFILE 
+                   %SYNONYM-STREAM-DEVICE-EOFP %SYNONYM-STREAM-DEVICE-FORCEOUTPUT 
+                   %SYNONYM-STREAM-DEVICE-GETFILEINFO %SYNONYM-STREAM-DEVICE-PEEKBIN 
+                   %SYNONYM-STREAM-DEVICE-READP %SYNONYM-STREAM-DEVICE-BACKFILEPTR 
+                   %SYNONYM-STREAM-DEVICE-SETFILEINFO %SYNONYM-STREAM-DEVICE-CHARSETFN)
+              (FNS %TWO-WAY-STREAM-DEVICE-BIN %TWO-WAY-STREAM-DEVICE-INPUTSTREAM 
+                   %TWO-WAY-STREAM-DEVICE-BOUT %TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 
+                   %TWO-WAY-STREAM-DEVICE-OUTCHARFN %TWO-WAY-STREAM-DEVICE-CLOSEFILE 
+                   %TWO-WAY-STREAM-DEVICE-EOFP %TWO-WAY-STREAM-DEVICE-READP 
+                   %TWO-WAY-STREAM-DEVICE-BACKFILEPTR %TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 
+                   %TWO-WAY-STREAM-DEVICE-PEEKBIN %TWO-WAY-STREAM-DEVICE-CHARSETFN)
+              (FUNCTIONS %FILL-POINTER-STREAM-DEVICE-CLOSEFILE %FILL-POINTER-STREAM-DEVICE-GETFILEPTR
+                     )
+              (GLOBALVARS %SYNONYM-STREAM-DEVICE %BROADCAST-STREAM-DEVICE %CONCATENATED-STREAM-DEVICE
+                     %TWO-WAY-STREAM-DEVICE %ECHO-STREAM-DEVICE \\FILL-POINTER-STREAM-DEVICE))
+        (COMS 
+              (* |;;| "helper stuff")

 
-                                (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM))
-                          (COMS 
-                                (* |;;| "module initialization")

+              (FNS %SYNONYM-STREAM-DEVICE-GET-STREAM))
+        (COMS 
+              (* |;;| "module initialization")

 
-                                (VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* 
-                                       *STANDARD-OUTPUT* *STANDARD-INPUT*)
-                                (FUNCTIONS %INITIALIZE-STANDARD-STREAMS)
-                                (FNS %INITIALIZE-CLSTREAM-TYPES)
-                                (DECLARE\: DONTEVAL@LOAD DOCOPY 
-                                                             (* \; "initialization")

-                                       (P (%INITIALIZE-CLSTREAM-TYPES)
-                                          (%INITIALIZE-STANDARD-STREAMS))))
-                          (PROP FILETYPE CLSTREAMS)))
+              (VARIABLES *DEBUG-IO* *QUERY-IO* *TERMINAL-IO* *ERROR-OUTPUT* *STANDARD-OUTPUT* 
+                     *STANDARD-INPUT*)
+              (FUNCTIONS %INITIALIZE-STANDARD-STREAMS)
+              (FNS %INITIALIZE-CLSTREAM-TYPES)
+              (DECLARE\: DONTEVAL@LOAD DOCOPY                (* \; "initialization")

+                     (P (%INITIALIZE-CLSTREAM-TYPES)
+                        (%INITIALIZE-STANDARD-STREAMS))))
+        (PROP FILETYPE CLSTREAMS)))
 
 
 
@@ -111,10 +101,10 @@
 
 
 (CL:DEFUN OPEN
 (FILENAME &KEY (DIRECTION :INPUT)
-                          (ELEMENT-TYPE 'CL:STRING-CHAR)
-                          (IF-EXISTS NIL EXISTS-P)
-                          (IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P)
-                          (EXTERNAL-FORMAT :DEFAULT))
+                      (ELEMENT-TYPE 'CL:STRING-CHAR)
+                      (IF-EXISTS NIL EXISTS-P)
+                      (IF-DOES-NOT-EXIST NIL DOES-NOT-EXIST-P)
+                      (EXTERNAL-FORMAT :DEFAULT))
 
 (* |;;;| "Return a stream which reads from or writes to Filename.  Defined keywords: :direction (one of :input, :output or :probe :element-type), Type of object to read or write, default String-Char, :if-exists (one of :error, :new-version, :overwrite, :append or nil), :if-does-not-exist (one of :error, :create or nil). :external-format (one of :DEFAULT, :EUC, :JIS, :W-MS, :MS or :XCCS).  The specification of :external-format is based on the JEIDA proposal.  See the manual for details.")

 
@@ -134,10 +124,10 @@
      (FOR-OUTPUT (MEMQ DIRECTION '(:IO :OUTPUT)))
      (ACCESS (INTERLISP-ACCESS
 DIRECTION))
      (FILE-TYPE (IF
 (CL:MEMBER ELEMENT-TYPE '(CL:UNSIGNED-BYTE CL:SIGNED-BYTE (CL:UNSIGNED-BYTE
-                                                                                   8)
-                                                        (CL:SIGNED-BYTE 8))
-                               :TEST
-                               'CL:EQUAL)
+                                                                               8)
+                                                    (CL:SIGNED-BYTE 8))
+                           :TEST
+                           'CL:EQUAL)
                     THEN
 'BINARY
                   ELSE
 'TEXT))
      (STREAM NIL))
@@ -149,7 +139,7 @@
                                    :NEWEST)
                             :NEW-VERSION
                             :ERROR)))                        (* \; 
-
                            "If the file does not exist, it is OK to have :if-exists :overwrite.  ")

+
                              "If the file does not exist, it is OK to have :if-exists :overwrite.  ")

     (CL:UNLESS DOES-NOT-EXIST-P
         (SETQ IF-DOES-NOT-EXIST (COND
                                    ((OR (EQ IF-EXISTS :APPEND)
@@ -159,101 +149,98 @@
                                     NIL)
                                    (T :CREATE))))
     (CL:LOOP                                                 (* \; 
-
                                      "See if the file exists and handle the existential keywords.")

+
                                        "See if the file exists and handle the existential keywords.")

      (LET* ((NAME (PREDICT-NAME
 PATHNAME))
             (CL:NAMESTRING (MKSTRING NAME)))
            (IF
 NAME
-               THEN
                                      (* \; "file exists")

-                     (IF
 FOR-OUTPUT
-                         THEN
 
+               THEN
                                          (* \; "file exists")

+                    (IF
 FOR-OUTPUT
+                        THEN
 
+                             (* |;;| "open for output/both")

 
-                               (* |;;| "open for output/both")

+                             (CASE IF-EXISTS
+                                 (:ERROR 
+                                    (CL:CERROR "write it anyway." "File ~A already exists." 
+                                           CL:NAMESTRING)
+                                    (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS NIL
+                                                        `((TYPE ,FILE-TYPE)
+                                                          (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
+                                    (RETURN NIL))
+                                 ((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE) 
+                                    (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW
+                                                        `((TYPE ,FILE-TYPE)
+                                                          (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
+                                    (RETURN NIL))
+                                 (:OVERWRITE 
+                                    (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD
+                                                        `((TYPE ,FILE-TYPE)
+                                                          (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
+                                    (RETURN NIL))
+                                 (:APPEND 
+                                    (IF
 (EQ DIRECTION :OUTPUT)
+                                        THEN
                 (* \; 
+
                                      "if the direction is output it is the same as interlisp append")

+                                             (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'APPEND
+                                                                 'OLD
+                                                                 `((TYPE ,FILE-TYPE)
+                                                                   (EXTERNALFORMAT ,EXTERNAL-FORMAT))
+                                                                 ))
+                                      ELSE
                   (* \; 
+
                      "if direction is io it opens the file for both and goes to the end of the file")

+                                           (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH 'OLD
+                                                               `((TYPE ,FILE-TYPE)
+                                                                 (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
+                                           (SETFILEPTR STREAM -1))
+                                    (RETURN NIL))
+                                 ((NIL) (CL:RETURN-FROM OPEN NIL))
+                                 (T (CL:ERROR "~S is not a valid value for :if-exists." IF-EXISTS)))
+                      |elseif|
 FOR-INPUT
+                        |then|
 
 
-                               (CASE IF-EXISTS
-                                   (:ERROR 
-                                      (CL:CERROR "write it anyway." "File ~A already exists." 
-                                             CL:NAMESTRING)
-                                      (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS NIL
-                                                          `((TYPE ,FILE-TYPE)
-                                                            (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
-                                      (RETURN NIL))
-                                   ((:NEW-VERSION :SUPERSEDE :RENAME :RENAME-AND-DELETE) 
-                                      (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW
-                                                          `((TYPE ,FILE-TYPE)
-                                                            (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
-                                      (RETURN NIL))
-                                   (:OVERWRITE 
-                                      (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD
-                                                          `((TYPE ,FILE-TYPE)
-                                                            (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
-                                      (RETURN NIL))
-                                   (:APPEND 
-                                      (IF
 (EQ DIRECTION :OUTPUT)
-                                          THEN
           (* \; 
-
                                    "if the direction is output it is the same as interlisp append")

-                                                (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'APPEND
-                                                                    'OLD
-                                                                    `((TYPE ,FILE-TYPE)
-                                                                      (EXTERNALFORMAT 
-                                                                             ,EXTERNAL-FORMAT))))
-                                        ELSE
             (* \; 
-
                    "if direction is io it opens the file for both and goes to the end of the file")

-                                              (SETQ STREAM (OPENSTREAM CL:NAMESTRING 'BOTH
-                                                                  'OLD
-                                                                  `((TYPE ,FILE-TYPE)
-                                                                    (EXTERNALFORMAT ,EXTERNAL-FORMAT)
-                                                                    )))
-                                              (SETFILEPTR STREAM -1))
-                                      (RETURN NIL))
-                                   ((NIL) (CL:RETURN-FROM OPEN NIL))
-                                   (T (CL:ERROR "~S is not a valid value for :if-exists." IF-EXISTS)))
-                       |elseif|
 FOR-INPUT
-                         |then|
 
+                              (* |;;| "open for input/both")

 
-                               (* |;;| "open for input/both")

+                              (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD
+                                                  `((TYPE ,FILE-TYPE)
+                                                    (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
+                              (RETURN NIL)
+                      |else|
 
 
-                               (SETQ STREAM (OPENSTREAM CL:NAMESTRING ACCESS 'OLD
-                                                   `((TYPE ,FILE-TYPE)
-                                                     (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
-                               (RETURN NIL)
-                       |else|
 
+                            (* |;;| "open for probe")

 
-                             (* |;;| "open for probe")

-
-                             (SETQ STREAM (|create|
 STREAM
-                                                 FULLFILENAME _ (FULLNAME CL:NAMESTRING)))
-                             (RETURN NIL))
+                            (SETQ STREAM (|create|
 STREAM
+                                                FULLFILENAME _ (FULLNAME CL:NAMESTRING)))
+                            (RETURN NIL))
              |else|
 
 
                    (* |;;| "file does not exist")

 
                    (|if|
 FOR-OUTPUT
                        |then|
 (CASE IF-DOES-NOT-EXIST
-                                      (:ERROR 
-                                         (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND 
-                                                :PATHNAME PATHNAME)
-                                         (CL:FORMAT *QUERY-IO* "~&New file name: ")
-                                         (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*))))
-                                      (:CREATE 
-                                         (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW
-                                                             `((TYPE ,FILE-TYPE)
-                                                               (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
-                                         (RETURN NIL))
-                                      ((NIL) (CL:RETURN-FROM OPEN NIL))
-                                      (T (CL:ERROR "~S is not a valid value for :if-does-not-exist."
-                                                IF-DOES-NOT-EXIST)))
+                                  (:ERROR 
+                                     (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND 
+                                            :PATHNAME PATHNAME)
+                                     (CL:FORMAT *QUERY-IO* "~&New file name: ")
+                                     (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*))))
+                                  (:CREATE 
+                                     (SETQ STREAM (OPENSTREAM PATHNAME ACCESS 'NEW
+                                                         `((TYPE ,FILE-TYPE)
+                                                           (EXTERNALFORMAT ,EXTERNAL-FORMAT))))
+                                     (RETURN NIL))
+                                  ((NIL) (CL:RETURN-FROM OPEN NIL))
+                                  (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." 
+                                            IF-DOES-NOT-EXIST)))
                      |elseif|
 FOR-INPUT
                        |then|
 (CASE IF-DOES-NOT-EXIST
-                                      (:ERROR 
-                                         (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND 
-                                                :PATHNAME PATHNAME)
-                                         (CL:FORMAT *QUERY-IO* "~&New file name: ")
-                                         (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*))))
-                                      (:CREATE (%NEW-FILE
 PATHNAME))
-                                      ((NIL) (CL:RETURN-FROM OPEN NIL))
-                                      (T (CL:ERROR "~S is not a valid value for :if-does-not-exist."
-                                                IF-DOES-NOT-EXIST)))
-                     |else|
                              (* \; "Open for probe.")

+                                  (:ERROR 
+                                     (CL:CERROR "prompt for a new name." 'XCL:FILE-NOT-FOUND 
+                                            :PATHNAME PATHNAME)
+                                     (CL:FORMAT *QUERY-IO* "~&New file name: ")
+                                     (SETQ PATHNAME (PATHNAME (CL:READ-LINE *QUERY-IO*))))
+                                  (:CREATE (%NEW-FILE
 PATHNAME))
+                                  ((NIL) (CL:RETURN-FROM OPEN NIL))
+                                  (T (CL:ERROR "~S is not a valid value for :if-does-not-exist." 
+                                            IF-DOES-NOT-EXIST)))
+                     |else|
                                  (* \; "Open for probe.")

                            (RETURN NIL)))))
     (STREAMPROP STREAM :FILE-STREAM-P T)
     STREAM))
@@ -264,18 +251,18 @@
 
    (|if|
 (STREAMP STREAM)
        |then|
 (|if|
 (OPENP STREAM)
-                      |then|
 
+                  |then|
 
 
-                            (* |;;| 
-
               "determine 'deletability' of stream's file before closing, as that trashes the info")

+                        (* |;;| 
+
                 "determine 'deletability' of stream's file before closing, as that trashes the info")

 
-                            (LET ((ABORTABLE (AND (DIRTYABLE STREAM)
-                                                  (NOT (APPENDONLY STREAM)))))
-                                 (CLOSEF STREAM)
-                                 (|if|
 (AND ABORT ABORTABLE)
-                                     |then|
              (* \; 
-
     "eventually we will change device CLOSEF methods to take an ABORT arg.  For now, simulate it.")

-                                           (DELFILE (CL:NAMESTRING STREAM)))))
+                        (LET ((ABORTABLE (AND (DIRTYABLE STREAM)
+                                              (NOT (APPENDONLY STREAM)))))
+                             (CLOSEF STREAM)
+                             (|if|
 (AND ABORT ABORTABLE)
+                                 |then|
                      (* \; 
+
       "eventually we will change device CLOSEF methods to take an ABORT arg.  For now, simulate it.")

+                                       (DELFILE (CL:NAMESTRING STREAM)))))
      |else|
 (ERROR "Closing a non-stream" STREAM))
    T)
 
@@ -323,15 +310,19 @@
                         DEVICE _ %SYNONYM-STREAM-DEVICE
                         ACCESS _ 'BOTH
                         F1 _ CL:SYMBOL
-                        LINELENGTH _ (|fetch|
 (STREAM LINELENGTH) |of|
 (CL:SYMBOL-VALUE
-                                                                                CL:SYMBOL))
+                        LINELENGTH _ (|fetch|
 (STREAM LINELENGTH) |of|
 (CL:SYMBOL-VALUE CL:SYMBOL))
                         OUTCHARFN _ (FUNCTION %SYNONYM-STREAM-DEVICE-OUTCHARFN))))
         (STREAMPROP STREAM 'XCL:SYNONYM-STREAM-P T)
 
         (* |;;| "save the synonym stream in the OPENFILELST field of %SYNONYM-STREAM-DEVICE")

 
-        (|replace|
 (FDEV OPENFILELST) |of|
 %SYNONYM-STREAM-DEVICE
-           |with|
 (CONS STREAM (|fetch|
 (FDEV OPENFILELST) |of|
 %SYNONYM-STREAM-DEVICE)))
+        (|replace|
 (FDEV OPENFILELST) |of|
 %SYNONYM-STREAM-DEVICE |with|
 (CONS STREAM
+                                                                               (|fetch|
 (FDEV 
+                                                                                          OPENFILELST
+                                                                                              )
+                                                                                  |of|
 
+                                                                               %SYNONYM-STREAM-DEVICE
+                                                                                      )))
         STREAM))
 
 (CL:DEFUN XCL:SYNONYM-STREAM-P
 (STREAM)
@@ -355,14 +346,14 @@
 
    (IF
 (FOR
 STREAM? IN
 STREAMS ALWAYS
 (STREAMP STREAM?))
        THEN
 (LET ((STREAM (|create|
 STREAM
-                                     DEVICE _ %BROADCAST-STREAM-DEVICE
-                                     ACCESS _ 'OUTPUT
-                                     F1 _ STREAMS
-                                     OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN))))
-                     (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T)
-                     STREAM)
+                                 DEVICE _ %BROADCAST-STREAM-DEVICE
+                                 ACCESS _ 'OUTPUT
+                                 F1 _ STREAMS
+                                 OUTCHARFN _ (FUNCTION %BROADCAST-STREAM-DEVICE-OUTCHARFN))))
+                 (STREAMPROP STREAM 'XCL:BROADCAST-STREAM-P T)
+                 STREAM)
      ELSE
 (\\ILLEGAL.ARG (FOR
 STREAM? IN
 STREAMS WHEN
 (NOT (STREAMP STREAM?))
-                                DO
 (RETURN STREAM?)))))
+                            DO
 (RETURN STREAM?)))))
 
 (CL:DEFUN XCL:BROADCAST-STREAM-P
 (STREAM)
 
@@ -383,13 +374,13 @@
 
    (IF
 (FOR
 STREAM? IN
 STREAMS ALWAYS
 (STREAMP STREAM?))
        THEN
 (LET ((STREAM (|create|
 STREAM
-                                     DEVICE _ %CONCATENATED-STREAM-DEVICE
-                                     ACCESS _ 'INPUT
-                                     F1 _ STREAMS)))
-                     (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T)
-                     STREAM)
+                                 DEVICE _ %CONCATENATED-STREAM-DEVICE
+                                 ACCESS _ 'INPUT
+                                 F1 _ STREAMS)))
+                 (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P T)
+                 STREAM)
      ELSE
 (\\ILLEGAL.ARG (FOR
 STREAM? IN
 STREAMS WHEN
 (NOT (STREAMP STREAM?))
-                                DO
 (RETURN STREAM?)))))
+                            DO
 (RETURN STREAM?)))))
 
 (CL:DEFUN XCL:CONCATENATED-STREAM-P
 (STREAM)
    (STREAMPROP STREAM 'XCL:CONCATENATED-STREAM-P))
@@ -420,8 +411,13 @@
 
         (* |;;| "save STREAM  in the OPENFILELST field of %TWO-WAY-STREAM-DEVICE")

 
-        (|replace|
 (FDEV OPENFILELST) |of|
 %TWO-WAY-STREAM-DEVICE
-           |with|
 (CONS STREAM (|fetch|
 (FDEV OPENFILELST) |of|
 %TWO-WAY-STREAM-DEVICE)))
+        (|replace|
 (FDEV OPENFILELST) |of|
 %TWO-WAY-STREAM-DEVICE |with|
 (CONS STREAM
+                                                                               (|fetch|
 (FDEV 
+                                                                                          OPENFILELST
+                                                                                              )
+                                                                                  |of|
 
+                                                                               %TWO-WAY-STREAM-DEVICE
+                                                                                      )))
         STREAM))
 
 (CL:DEFUN XCL:TWO-WAY-STREAM-P
 (STREAM)
@@ -457,8 +453,13 @@
 
         (* |;;| "save STREAM  in the OPENFILELST field of %ECHO-STREAM-DEVICE")

 
-        (|replace|
 (FDEV OPENFILELST) |of|
 %ECHO-STREAM-DEVICE
-           |with|
 (CONS STREAM (|fetch|
 (FDEV OPENFILELST) |of|
 %ECHO-STREAM-DEVICE)))
+        (|replace|
 (FDEV OPENFILELST) |of|
 %ECHO-STREAM-DEVICE |with|
 (CONS STREAM
+                                                                            (|fetch|
 (FDEV 
+                                                                                          OPENFILELST
+                                                                                           )
+                                                                               |of|
 
+                                                                                  %ECHO-STREAM-DEVICE
+                                                                                   )))
         STREAM))
 
 (CL:DEFUN XCL:ECHO-STREAM-P
 (STREAM)
@@ -476,12 +477,12 @@
         (FETCH
 (STREAM F2) OF
 STREAM)))
 
 (CL:DEFUN CL:MAKE-STRING-INPUT-STREAM
 (STRING &OPTIONAL (CL::START 0)
-                                                 (CL::END NIL))
+                                             (CL::END NIL))
 
 (* |;;;| "A CommonLisp function for producing a stream from a string.  See CLtL p.  330")

 
    (OPENSTRINGSTREAM (|if|
 (OR (NOT (CL:ZEROP CL::START))
-                                   (NOT (NULL CL::END)))
+                               (NOT (NULL CL::END)))
                          |then|
 
 
                                (* |;;| "A displaced array is ok here because the stream's uses GETBASEBYTE directly and doesn't go through the array code at all. ")

@@ -497,9 +498,9 @@
        NIL)
       ((NULL (CL:REST STRINGS))
        (CL:MAKE-STRING-INPUT-STREAM
 (CL:FIRST STRINGS)))
-      (T (CL:APPLY 'CL:MAKE-CONCATENATED-STREAM (FOR
 STRING IN
 STRINGS
-                                                   COLLECT
 (CL:MAKE-STRING-INPUT-STREAM

-                                                                STRING))))))
+      (T (CL:APPLY 'CL:MAKE-CONCATENATED-STREAM (FOR
 STRING IN
 STRINGS COLLECT
 (
+
                                                                          CL:MAKE-STRING-INPUT-STREAM

+                                                                                STRING))))))
 
 (CL:DEFUN %MAKE-INITIAL-STRING-STREAM-CONTENTS
 ()
    (CL:MAKE-ARRAY '(256)
@@ -507,8 +508,8 @@
           'CL:STRING-CHAR :EXTENDABLE T :FILL-POINTER 0))
 
 (DEFMACRO CL:WITH-OPEN-STREAM
 ((VAR STREAM)
-                                   &BODY
-                                   (BODY DECLS))
+                               &BODY
+                               (BODY DECLS))
    (LET ((ABORTP (GENSYM)))
         `(LET ((,VAR ,STREAM)
                (,ABORTP T))
@@ -519,15 +520,15 @@
                   (CL:CLOSE
 ,VAR :ABORT ,ABORTP)))))
 
 (DEFMACRO CL:WITH-INPUT-FROM-STRING
 ((CL::VAR STRING &KEY (CL::INDEX NIL CL::INDEXP)
-                                                (CL::START 0 CL::STARTP)
-                                                (CL::END NIL CL:ENDP))
-                                         &BODY
-                                         (CL::BODY CL::DECLS))
+                                            (CL::START 0 CL::STARTP)
+                                            (CL::END NIL CL:ENDP))
+                                     &BODY
+                                     (CL::BODY CL::DECLS))
    `(LET* ((CL::$STRING$ ,STRING)
            (CL::$START$ ,CL::START))
           (DECLARE
 (LOCALVARS CL::$STRING$ CL::$START$))
-          (CL:WITH-OPEN-STREAM
 (,CL::VAR (CL:MAKE-STRING-INPUT-STREAM
 CL::$STRING$ 
-                                                    CL::$START$ ,CL::END))
+          (CL:WITH-OPEN-STREAM
 (,CL::VAR (CL:MAKE-STRING-INPUT-STREAM
 CL::$STRING$ CL::$START$
+                                                ,CL::END))
                  ,@CL::DECLS
                  ,@(CL:IF CL::INDEXP
 
@@ -541,8 +542,8 @@
                        CL::BODY))))
 
 (DEFMACRO CL:WITH-OUTPUT-TO-STRING
 ((VAR &OPTIONAL (STRING NIL ST-P))
-                                        &BODY
-                                        (FORMS DECLS))
+                                    &BODY
+                                    (FORMS DECLS))
    (COND
       (ST-P `(CL:WITH-OPEN-STREAM
 (,VAR (MAKE-FILL-POINTER-OUTPUT-STREAM
 ,STRING))
                     ,@DECLS
@@ -552,8 +553,8 @@
                  (PROGN ,@FORMS (CL:GET-OUTPUT-STREAM-STRING
 ,VAR))))))
 
 (DEFMACRO CL:WITH-OPEN-FILE
 ((VAR &REST OPEN-ARGS)
-                                 &BODY
-                                 (FORMS DECLS))
+                             &BODY
+                             (FORMS DECLS))
 
 (* |;;;| "The file whose name is File-Name is opened using the OPEN-ARGS and bound to the variable VAR. The Forms are executed, and when they terminate, normally or otherwise, the file is closed.")

 
@@ -572,26 +573,26 @@
 
    (MAKE-FILL-POINTER-OUTPUT-STREAM
))
 
-(CL:DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM
 (&OPTIONAL (STRING (
-
                                                               %MAKE-INITIAL-STRING-STREAM-CONTENTS

-                                                                  )))
+(CL:DEFUN MAKE-FILL-POINTER-OUTPUT-STREAM
 (&OPTIONAL (STRING (%MAKE-INITIAL-STRING-STREAM-CONTENTS
)))
    (DECLARE
 (GLOBALVARS \\FILL-POINTER-STREAM-DEVICE))
    (|if|
 (NOT (CL:ARRAY-HAS-FILL-POINTER-P STRING))
        |then|
 (\\ILLEGAL.ARG STRING)
      |else|
 (LET ((STREAM (|create|
 STREAM
-                                     DEVICE _ \\FILL-POINTER-STREAM-DEVICE
-                                     F1 _ STRING
-                                     ACCESS _ 'OUTPUT
-                                     OTHERPROPS _ '(STRING-OUTPUT-STREAM T))))
+                                 DEVICE _ \\FILL-POINTER-STREAM-DEVICE
+                                 F1 _ STRING
+                                 ACCESS _ 'OUTPUT
+                                 OTHERPROPS _ '(STRING-OUTPUT-STREAM T))))
                                                              (* \; 
-
                                             "give it a canned property list to save some consing.")

-                     (|replace|
 (STREAM OUTCHARFN) |of|
 STREAM
-                        |with|
 (|if|
 (EXTENDABLE-ARRAY-P STRING)
-                                       |then|
 (FUNCTION \\ADJUSTABLE-STRING-STREAM-OUTCHARFN)
-                                     |else|
 (FUNCTION \\STRING-STREAM-OUTCHARFN)))
-                     (|replace|
 (STREAM STRMBOUTFN) |of|
 STREAM |with|

-                                                                        (FUNCTION \\OUTCHAR))
-                     STREAM)))
+
                                               "give it a canned property list to save some consing.")

+                 (|replace|
 (STREAM OUTCHARFN) |of|
 STREAM |with|
 (|if|
 (EXTENDABLE-ARRAY-P STRING)
+                                                                      |then|
 (FUNCTION 
+                                                                 \\ADJUSTABLE-STRING-STREAM-OUTCHARFN
+                                                                              )
+                                                                    |else|
 (FUNCTION 
+                                                                            \\STRING-STREAM-OUTCHARFN
+                                                                            )))
+                 (|replace|
 (STREAM STRMBOUTFN) |of|
 STREAM |with|
 (FUNCTION \\OUTCHAR))
+                 STREAM)))
 
 (CL:DEFUN CL:GET-OUTPUT-STREAM-STRING
 (STRING-OUTPUT-STREAM)
 
@@ -600,17 +601,17 @@
    (|if|
 (NOT (STREAMPROP STRING-OUTPUT-STREAM 'STRING-OUTPUT-STREAM))
        |then|
 (ERROR "Stream not a string-output-stream" STRING-OUTPUT-STREAM)
      |else|
 (PROG1 (|fetch|
 (STREAM F1) |of|
 STRING-OUTPUT-STREAM)
-                    (|replace|
 (STREAM F1) |of|
 STRING-OUTPUT-STREAM |with|
 (
-
                                                               %MAKE-INITIAL-STRING-STREAM-CONTENTS

-                                                                                         )))))
+                (|replace|
 (STREAM F1) |of|
 STRING-OUTPUT-STREAM |with|
 (
+
                                                                 %MAKE-INITIAL-STRING-STREAM-CONTENTS

+                                                                         )))))
 
 (CL:DEFUN \\STRING-STREAM-OUTCHARFN
 (STREAM CHAR)
    (IF
 (OR (IEQP (FETCH
 (STREAM CHARPOSITION) OF
 STREAM)
-                     (FETCH
 (STREAM LINELENGTH) OF
 STREAM))
-               (EQ CHAR (CHARCODE EOL)))
+                 (FETCH
 (STREAM LINELENGTH) OF
 STREAM))
+           (EQ CHAR (CHARCODE EOL)))
        THEN
 (REPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
      ELSE
 (ADD
 (FETCH
 (STREAM CHARPOSITION) OF
 STREAM)
-                     1))
+               1))
    (CL:VECTOR-PUSH (CL:CHARACTER CHAR)
           (FETCH
 (STREAM F1) OF
 STREAM)))
 
@@ -618,11 +619,11 @@
    (LET ((STRING (FETCH
 (STREAM F1) OF
 STREAM))
          (CH (CL:CHARACTER CHAR)))
         (IF
 (OR (IEQP (FETCH
 (STREAM CHARPOSITION) OF
 STREAM)
-                          (FETCH
 (STREAM LINELENGTH) OF
 STREAM))
-                    (EQ CHAR (CHARCODE EOL)))
+                      (FETCH
 (STREAM LINELENGTH) OF
 STREAM))
+                (EQ CHAR (CHARCODE EOL)))
             THEN
 (REPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
           ELSE
 (ADD
 (FETCH
 (STREAM CHARPOSITION) OF
 STREAM)
-                          1))
+                    1))
 
         (* |;;| "Do the equivalent of VECTOR-PUSH-EXTEND inline to save the significant! overhead of calculating the new length at each character.")

 
@@ -630,17 +631,16 @@
             (LET ((CURRENT-LENGTH (CL:ARRAY-TOTAL-SIZE STRING)))
                  (IF
 (>= CURRENT-LENGTH (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT))
                      THEN
 (PROCEED-CASE (CL:ERROR 'END-OF-FILE :STREAM STREAM)
-                                     (SI::RETRY-OUTCHAR NIL :REPORT 
-                                            "VECTOR-PUSH the character anyway" :CONDITION END-OF-FILE
-                                            (CL:VECTOR-PUSH CH (FETCH
 (STREAM F1) OF
 STREAM))
-                                            ))
+                                 (SI::RETRY-OUTCHAR NIL :REPORT "VECTOR-PUSH the character anyway" 
+                                        :CONDITION END-OF-FILE (CL:VECTOR-PUSH CH (FETCH
 (STREAM
+                                                                                          F1)
+                                                                                     OF
 STREAM))))
                    ELSE
 (CL:ADJUST-ARRAY STRING (MIN (CL:1- CL:ARRAY-TOTAL-SIZE-LIMIT)
-                                                         (+ CURRENT-LENGTH (MAX (LRSH CURRENT-LENGTH
-                                                                                      1)
-                                                                                
+                                                     (+ CURRENT-LENGTH (MAX (LRSH CURRENT-LENGTH 1)
+                                                                            
                                                                         *DEFAULT-PUSH-EXTENSION-SIZE*
-                                                                                ))))
-                         (CL:VECTOR-PUSH CH STRING))))))
+                                                                            ))))
+                        (CL:VECTOR-PUSH CH STRING))))))
 
 
 
@@ -691,8 +691,7 @@
 
    (* |;;| "charset function for broadcast streams.  Not clear what the value should be, so we arbitrarily return the value of the last stream.")

 
-   (FOR
 S IN
 (FETCH
 (STREAM F1) OF
 STREAM) DO
 (SETQ $$VAL (ACCESS-CHARSET S 
-                                                                                     NEWVALUE))))
+   (FOR
 S IN
 (FETCH
 (STREAM F1) OF
 STREAM) DO
 (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE))))
 (DEFINEQ
 
 (%concatenated-stream-device-bin

@@ -723,7 +722,7 @@
    (LET ((STREAMS (FETCH
 (STREAM F1) OF
 STREAM)))
         (IF
 STREAMS
             THEN
 (ACCESS-CHARSET (CAR STREAMS)
-                            NEWVALUE)
+                        NEWVALUE)
           ELSE
 0)))
 (DEFINEQ
 
@@ -933,7 +932,7 @@
 (CL:DEFUN %INITIALIZE-STANDARD-STREAMS
 ()
 
    (* |;;| 
-
 "Called when CLSTREAMS is loaded.  Almost everything is same as *TERMINAL-IO* to start with.")

+
   "Called when CLSTREAMS is loaded.  Almost everything is same as *TERMINAL-IO* to start with.")

 
    (CL:SETQ *QUERY-IO* (CL:MAKE-TWO-WAY-STREAM
 (CL:MAKE-SYNONYM-STREAM
 '\\LINEBUF.OFD)
                               (CL:MAKE-SYNONYM-STREAM
 '\\TERM.OFD)))
@@ -953,27 +952,51 @@
 (%INITIALIZE-STANDARD-STREAMS
)
 )
 
-(PUTPROPS CLSTREAMS FILETYPE
 CL:COMPILE-FILE)
+(PUTPROPS CLSTREAMS
 FILETYPE
 CL:COMPILE-FILE)
 (PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (34128 35316 (%BROADCAST-STREAM-DEVICE-BOUT 34138 . 34361) (
-%BROADCAST-STREAM-DEVICE-OUTCHARFN 34363 . 34814) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34816 . 35055) (
-%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 35057 . 35314)) (35732 37791 (%CONCATENATED-STREAM-DEVICE-BIN 
-35742 . 36147) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36149 . 36462) (%CONCATENATED-STREAM-DEVICE-EOFP
- 36464 . 36828) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36830 . 37305) (
-%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 37307 . 37789)) (38129 38348 (%ECHO-STREAM-DEVICE-BIN 38139 . 
-38346)) (38576 41921 (%SYNONYM-STREAM-DEVICE-BIN 38586 . 38774) (%SYNONYM-STREAM-DEVICE-BOUT 38776 . 
-38977) (%SYNONYM-STREAM-DEVICE-OUTCHARFN 38979 . 39686) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 39688 . 
-40272) (%SYNONYM-STREAM-DEVICE-EOFP 40274 . 40465) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 40467 . 40705) 
-(%SYNONYM-STREAM-DEVICE-GETFILEINFO 40707 . 40944) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40946 . 41169) (
-%SYNONYM-STREAM-DEVICE-READP 41171 . 41282) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 41284 . 41430) (
-%SYNONYM-STREAM-DEVICE-SETFILEINFO 41432 . 41681) (%SYNONYM-STREAM-DEVICE-CHARSETFN 41683 . 41919)) (
-41922 46247 (%TWO-WAY-STREAM-DEVICE-BIN 41932 . 42105) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 42107 . 
-42298) (%TWO-WAY-STREAM-DEVICE-BOUT 42300 . 42472) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 42474 . 42664)
- (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 42666 . 43528) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 43530 . 44953) (
-%TWO-WAY-STREAM-DEVICE-EOFP 44955 . 45131) (%TWO-WAY-STREAM-DEVICE-READP 45133 . 45326) (
-%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 45328 . 45464) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 45466 . 45695) (
-%TWO-WAY-STREAM-DEVICE-PEEKBIN 45697 . 45910) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45912 . 46245)) (46835
- 47074 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46845 . 47072)) (47780 53743 (%INITIALIZE-CLSTREAM-TYPES 
-47790 . 53741)))))
+  (FILEMAP (NIL (5167 14142 (OPEN 5167 . 14142)) (14144 15070 (CL:CLOSE 14144 . 15070)) (15072 15150 (
+CL:STREAM-EXTERNAL-FORMAT 15072 . 15150)) (15152 15219 (CL:STREAM-ELEMENT-TYPE 15152 . 15219)) (15221 
+15455 (CL:INPUT-STREAM-P 15221 . 15455)) (15457 15693 (CL:OUTPUT-STREAM-P 15457 . 15693)) (15695 15832
+ (XCL:OPEN-STREAM-P 15695 . 15832)) (15834 15901 (FILE-STREAM-POSITION 15834 . 15901)) (15953 17296 (
+CL:MAKE-SYNONYM-STREAM 15953 . 17296)) (17298 17387 (XCL:SYNONYM-STREAM-P 17298 . 17387)) (17389 17527
+ (XCL:SYNONYM-STREAM-SYMBOL 17389 . 17527)) (17529 17807 (XCL:FOLLOW-SYNONYM-STREAMS 17529 . 17807)) (
+17809 18568 (CL:MAKE-BROADCAST-STREAM 17809 . 18568)) (18570 18713 (XCL:BROADCAST-STREAM-P 18570 . 
+18713)) (18715 18930 (XCL:BROADCAST-STREAM-STREAMS 18715 . 18930)) (18932 19617 (
+CL:MAKE-CONCATENATED-STREAM 18932 . 19617)) (19619 19718 (XCL:CONCATENATED-STREAM-P 19619 . 19718)) (
+19720 19933 (XCL:CONCATENATED-STREAM-STREAMS 19720 . 19933)) (19935 21519 (CL:MAKE-TWO-WAY-STREAM 
+19935 . 21519)) (21521 21658 (XCL:TWO-WAY-STREAM-P 21521 . 21658)) (21660 21805 (
+XCL:TWO-WAY-STREAM-OUTPUT-STREAM 21660 . 21805)) (21807 21951 (XCL:TWO-WAY-STREAM-INPUT-STREAM 21807
+ . 21951)) (21953 23503 (CL:MAKE-ECHO-STREAM 21953 . 23503)) (23505 23634 (XCL:ECHO-STREAM-P 23505 . 
+23634)) (23636 23774 (XCL:ECHO-STREAM-INPUT-STREAM 23636 . 23774)) (23776 23915 (
+XCL:ECHO-STREAM-OUTPUT-STREAM 23776 . 23915)) (23917 24644 (CL:MAKE-STRING-INPUT-STREAM 23917 . 24644)
+) (24646 25139 (MAKE-CONCATENATED-STRING-INPUT-STREAM 24646 . 25139)) (25141 25301 (
+%MAKE-INITIAL-STRING-STREAM-CONTENTS 25141 . 25301)) (28348 29874 (MAKE-FILL-POINTER-OUTPUT-STREAM 
+28348 . 29874)) (29876 30597 (CL:GET-OUTPUT-STREAM-STRING 29876 . 30597)) (30599 31078 (
+\\STRING-STREAM-OUTCHARFN 30599 . 31078)) (31080 32935 (\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 31080 . 
+32935)) (32964 33046 (%NEW-FILE 32964 . 33046)) (33048 33193 (PREDICT-NAME 33048 . 33193)) (33434 
+34622 (%BROADCAST-STREAM-DEVICE-BOUT 33444 . 33667) (%BROADCAST-STREAM-DEVICE-OUTCHARFN 33669 . 34120)
+ (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34122 . 34361) (%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34363 . 
+34620)) (34624 34951 (%BROADCAST-STREAM-DEVICE-CHARSETFN 34624 . 34951)) (34952 37011 (
+%CONCATENATED-STREAM-DEVICE-BIN 34962 . 35367) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 35369 . 35682) (
+%CONCATENATED-STREAM-DEVICE-EOFP 35684 . 36048) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 36050 . 36525) (
+%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 36527 . 37009)) (37013 37344 (
+%CONCATENATED-STREAM-DEVICE-CHARSETFN 37013 . 37344)) (37345 37564 (%ECHO-STREAM-DEVICE-BIN 37355 . 
+37562)) (37566 37791 (%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 37566 . 37791)) (37792 41137 (
+%SYNONYM-STREAM-DEVICE-BIN 37802 . 37990) (%SYNONYM-STREAM-DEVICE-BOUT 37992 . 38193) (
+%SYNONYM-STREAM-DEVICE-OUTCHARFN 38195 . 38902) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 38904 . 39488) (
+%SYNONYM-STREAM-DEVICE-EOFP 39490 . 39681) (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 39683 . 39921) (
+%SYNONYM-STREAM-DEVICE-GETFILEINFO 39923 . 40160) (%SYNONYM-STREAM-DEVICE-PEEKBIN 40162 . 40385) (
+%SYNONYM-STREAM-DEVICE-READP 40387 . 40498) (%SYNONYM-STREAM-DEVICE-BACKFILEPTR 40500 . 40646) (
+%SYNONYM-STREAM-DEVICE-SETFILEINFO 40648 . 40897) (%SYNONYM-STREAM-DEVICE-CHARSETFN 40899 . 41135)) (
+41138 45463 (%TWO-WAY-STREAM-DEVICE-BIN 41148 . 41321) (%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 41323 . 
+41514) (%TWO-WAY-STREAM-DEVICE-BOUT 41516 . 41688) (%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 41690 . 41880)
+ (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 41882 . 42744) (%TWO-WAY-STREAM-DEVICE-CLOSEFILE 42746 . 44169) (
+%TWO-WAY-STREAM-DEVICE-EOFP 44171 . 44347) (%TWO-WAY-STREAM-DEVICE-READP 44349 . 44542) (
+%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 44544 . 44680) (%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 44682 . 44911) (
+%TWO-WAY-STREAM-DEVICE-PEEKBIN 44913 . 45126) (%TWO-WAY-STREAM-DEVICE-CHARSETFN 45128 . 45461)) (45465
+ 45690 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE 45465 . 45690)) (45692 45811 (
+%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 45692 . 45811)) (46051 46290 (%SYNONYM-STREAM-DEVICE-GET-STREAM
+ 46061 . 46288)) (46521 46997 (%INITIALIZE-STANDARD-STREAMS 46521 . 46997)) (46998 52961 (
+%INITIALIZE-CLSTREAM-TYPES 47008 . 52959)))))
 STOP

sources/CMLEXEC

@@ -1,13 +1,14 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "21-Jan-93 11:16:01" {DSK}<python>lde>lispcore>sources>CMLEXEC.;2
 92477  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FUNCTIONS ADD-EXEC)
+
(FILECREATED " 8-Oct-2021 10:51:35" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLEXEC.;2
 92464  
 
-      previous date%: "25-Jun-91 12:22:29" {DSK}<python>lde>lispcore>sources>CMLEXEC.;1)
+      previous date%: "21-Jan-93 11:16:01" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLEXEC.;1)
 
 
 (* ; "
-Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991, 1993 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT CMLEXECCOMS)
@@ -1748,13 +1749,24 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991, 1993 by Venue & Xerox Corporat
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993))
+(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (33304 34258 (COPY-CIRCLE 33314 . 34256)) (34336 37641 (EXEC-READ 34346 . 37507) (DIR 
-37509 . 37639)) (39903 67037 (DO-APPLY-EVENT 39913 . 40475) (DO-HISTORY-SEARCH 40477 . 41934) (
-EVAL-INPUT 41936 . 47365) (EVENTS-INPUT 47367 . 48745) (EXEC-PRIN1 48747 . 48923) (EXEC-VALUE-OF 48925
- . 49264) (GET-NEXT-HISTORY-EVENT 49266 . 50761) (HISTORY-ADD-TO-SPELLING-LISTS 50763 . 51751) (
-HISTORY-NTH 51753 . 52503) (PRINT-HISTORY 52505 . 53126) (FIND-HISTORY-EVENTS 53128 . 58189) (
-PRINT-EVENT 58191 . 62412) (PRINT-EVENT-PROMPT 62414 . 63618) (PROCESS-EXEC-ID 63620 . 64565) (
-SEARCH-FOR-EVENT-NUMBER 64567 . 65195) (\PICK.EVALQT 65197 . 65708) (LISPXREPRINT 65710 . 67035)))))
+  (FILEMAP (NIL (3978 4383 (XCL::EXEC-CLOSEFN 3978 . 4383)) (4385 4721 (XCL::EXEC-SHRINKFN 4385 . 4721))
+ (4723 4963 (XCL::SETUP-EXEC-WINDOW 4723 . 4963)) (4965 5211 (XCL::EXEC-TITLE-FUNCTION 4965 . 5211)) (
+5213 8519 (FIX-FORM 5213 . 8519)) (8521 8641 (XCL::GET-PROCESS-PROFILE 8521 . 8641)) (8643 8924 (
+XCL::SAVE-CURRENT-EXEC-PROFILE 8643 . 8924)) (8926 9216 (XCL::SETF-GET-PROCESS-PROFILE 8926 . 9216)) (
+9218 9785 (XCL:SET-EXEC-TYPE 9218 . 9785)) (9787 9869 (XCL:SET-DEFAULT-EXEC-TYPE 9787 . 9869)) (9871 
+10282 (XCL::ENTER-EXEC-FUNCTION 9871 . 10282)) (10357 16750 (DO-EVENT 10357 . 16750)) (16752 23543 (
+EXEC 16752 . 23543)) (23545 24886 (EXEC-EVAL 23545 . 24886)) (24888 25619 (PRINT-ALL-DOCUMENTATION 
+24888 . 25619)) (25621 26063 (PRINT-DOCUMENTATION 25621 . 26063)) (26146 27230 (ADD-EXEC 26146 . 27230
+)) (27232 30828 (EXEC-READ-LINE 27232 . 30828)) (30899 31385 (FIND-EXEC-COMMAND 30899 . 31385)) (31387
+ 33285 (CIRCLAR-COPYER 31387 . 33285)) (33286 34240 (COPY-CIRCLE 33296 . 34238)) (34318 37623 (
+EXEC-READ 34328 . 37489) (DIR 37491 . 37621)) (39885 67019 (DO-APPLY-EVENT 39895 . 40457) (
+DO-HISTORY-SEARCH 40459 . 41916) (EVAL-INPUT 41918 . 47347) (EVENTS-INPUT 47349 . 48727) (EXEC-PRIN1 
+48729 . 48905) (EXEC-VALUE-OF 48907 . 49246) (GET-NEXT-HISTORY-EVENT 49248 . 50743) (
+HISTORY-ADD-TO-SPELLING-LISTS 50745 . 51733) (HISTORY-NTH 51735 . 52485) (PRINT-HISTORY 52487 . 53108)
+ (FIND-HISTORY-EVENTS 53110 . 58171) (PRINT-EVENT 58173 . 62394) (PRINT-EVENT-PROMPT 62396 . 63600) (
+PROCESS-EXEC-ID 63602 . 64547) (SEARCH-FOR-EVENT-NUMBER 64549 . 65177) (\PICK.EVALQT 65179 . 65690) (
+LISPXREPRINT 65692 . 67017)) (68199 68298 (EXEC-PRINT 68199 . 68298)) (68300 68565 (EXEC-FORMAT 68300
+ . 68565)))))
 STOP

sources/COMPARE

@@ -1,13 +1,15 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "16-May-90 14:59:25" {DSK}<usr>local>lde>lispcore>sources>COMPARE.;2
 12260  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS COMPARECOMS)
+
(FILECREATED " 5-Nov-2021 20:53:09" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>COMPARE.;2
 12484  
 
-      previous date%: "20-Jan-87 12:44:37" {DSK}<usr>local>lde>lispcore>sources>COMPARE.;1)
+      changes to%:  (FNS COMPAREPRINTN)
+
+      previous date%: "16-May-90 14:59:25" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>COMPARE.;1)
 
 
 (* ; "
-Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1987, 1990 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT COMPARECOMS)
@@ -214,7 +216,11 @@ Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
           (TERPRI STREAM])
 
 (COMPAREPRINTN

-  [LAMBDA (N SPACE FLG STREAM)                               (* ; "Edited 29-Dec-86 11:56 by jds")
+  [LAMBDA (N SPACE FLG STREAM)
                              (* ; "Edited  5-Nov-2021 20:53 by rmk:")


+                                                             (* ; "Edited 29-Dec-86 11:56 by jds")

+
+    (* ;; "RMK:  Added STREAM to POSITION and LINELENGTH")

+
     [COND
        ((NEQ N 0)
         (COND
@@ -223,9 +229,9 @@ Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
         (SELECTQ N
             (1 (PRIN1 '& STREAM))
             (PROGN (COND
-                      ((NOT (ILESSP (IPLUS (POSITION)
+                      ((NOT (ILESSP (IPLUS (POSITION STREAM)
                                            7)
-                                   (LINELENGTH)))
+                                   (LINELENGTH NIL STREAM)))
                        (TERPRI STREAM)))
                    (PRIN1 '- STREAM)
                    (PRIN2 N STREAM)
@@ -299,7 +305,7 @@ Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
 )
 (PUTPROPS COMPARE COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (823 11885 (COMPARELST 833 . 1095) (COMPARE1 1097 . 2506) (COMPAREPRINT 2508 . 3465) (
-COMPAREPRINT1 3467 . 7731) (COMPARELISTS 7733 . 9020) (COMPAREPRINTN 9022 . 9666) (COMPARENCHARS 9668
- . 10226) (COMPAREFAIL 10228 . 11355) (COMPAREMAX 11357 . 11594) (COUNTDOWN 11596 . 11883)))))
+  (FILEMAP (NIL (847 12109 (COMPARELST 857 . 1119) (COMPARE1 1121 . 2530) (COMPAREPRINT 2532 . 3489) (
+COMPAREPRINT1 3491 . 7755) (COMPARELISTS 7757 . 9044) (COMPAREPRINTN 9046 . 9890) (COMPARENCHARS 9892
+ . 10450) (COMPAREFAIL 10452 . 11579) (COMPAREMAX 11581 . 11818) (COUNTDOWN 11820 . 12107)))))
 STOP

sources/COREIO

@@ -1,14 +1,15 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 4-Oct-2018 14:13:06" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.;4
 55097  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS \CORE.GETFILEINFO)
+
(FILECREATED "22-Nov-2021 09:25:42" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>COREIO.;3
 55023  
 
-      previous date%: "28-Jun-99 16:15:28" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.;3)
+      changes to%:  (FNS \CORE.SETFILEINFO)
+
+      previous date%: " 4-Oct-2018 14:13:06" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>COREIO.;2)
 
 
 (* ; "
-Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT COREIOCOMS)
@@ -16,7 +17,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999,
 (RPAQQ COREIOCOMS

        (
 
-(* ;;; "Implementation of Core resident `files'")

+(* ;;; "Implementation of Core resident `files'")

 
         (FNS \CORE.CLOSEFILE \CORE.DELETEFILE \CORE.DIRECTORYNAMEP \CORE.FINDPAGE \CORE.GENERATEFILES
              \CORE.NEXTFILEFN \CORE.FILEINFOFN \CORE.GETFILEHANDLE \CORE.GETFILEINFO 
@@ -611,7 +612,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999,
     STREAM])
 
 (\CORE.SETFILEINFO

-  [LAMBDA (STREAM ATTRIBUTE VALUE DEV)
                   (* bvm%: "15-Jan-85 17:40")

+  [LAMBDA (STREAM ATTRIBUTE VALUE DEV)                       (* ; "Edited 22-Nov-2021 09:25 by rmk:")

+                                                             (* bvm%: "15-Jan-85 17:40")

     (PROG ((INFOBLOCK (\CORE.GETINFOBLOCK
 STREAM 'OLD DEV)))
           (SELECTQ ATTRIBUTE
               (CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
@@ -624,10 +626,20 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999,
                                           (replace
 IOFIBType of
 INFOBLOCK with
 VALUE))
                                      (EOL (replace
 COREEOLC of
 INFOBLOCK
                                              with
 (SELECTQ VALUE
-                                                          (CR CR.EOLC)
-                                                          (LF LF.EOLC)
-                                                          (CRLF CRLF.EOLC)
-                                                          (LISPERROR "ILLEGAL ARG" VALUE))))
+                                                      (CR CR.EOLC)
+                                                      (LF LF.EOLC)
+                                                      (CRLF CRLF.EOLC)
+                                                      (LISPERROR "ILLEGAL ARG" VALUE))))
+                                     (CREATIONDATE (replace
 IOFIBCreationTime of
 INFOBLOCK
+                                                      with
 (IDATE VALUE)))
+                                     (READDATE (replace
 IOFIBReadTime of
 INFOBLOCK
+                                                  with
 (IDATE VALUE)))
+                                     (WRITEDATE (replace
 IOFIBWriteTime of
 INFOBLOCK
+                                                   with
 (IDATE VALUE)))
+                                     (ICREATIONDATE (replace
 IOFIBCreationTime of
 INFOBLOCK
+                                                       with
 VALUE))
+                                     (IREADDATE (replace
 IOFIBReadTime of
 INFOBLOCK with
 VALUE))
+                                     (IWRITEDATE (replace
 IOFIBWriteTime of
 INFOBLOCK with
 VALUE))
                                      NIL])
 
 (\CORE.GETNEXTBUFFER

@@ -851,60 +863,48 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999,
 (RECORD CORE.PAGEENTRY
 (PAGENUMBER . PAGEPOINTER))
 
 (DATATYPE COREFILEINFOBLK
 ((IOFIBCreationTime FIXP)
-                               (IOFIBReadTime FIXP)
-                               (IOFIBWriteTime FIXP)
-                               (IOFIBType POINTER)
-                               (IOFILEPAGES POINTER)
-                               (IOFILEFULLNAME POINTER)
-                               (IOEPAGE WORD)
-                               (IOEOFFSET WORD)
-                               (COREEOLC BITS 2)
-                               (IOFIBFileType WORD))
-                              IOFIBCreationTime _ (IDATE)
-                              IOFILEPAGES _ (LIST (create
 CORE.PAGEENTRY
-                                                         PAGENUMBER _ 0))
-                              COREEOLC _ CR.EOLC)
+                           (IOFIBReadTime FIXP)
+                           (IOFIBWriteTime FIXP)
+                           (IOFIBType POINTER)
+                           (IOFILEPAGES POINTER)
+                           (IOFILEFULLNAME POINTER)
+                           (IOEPAGE WORD)
+                           (IOEOFFSET WORD)
+                           (COREEOLC BITS 2)
+                           (IOFIBFileType WORD))
+                          IOFIBCreationTime _ (IDATE)
+                          IOFILEPAGES _ (LIST (create
 CORE.PAGEENTRY
+                                                     PAGENUMBER _ 0))
+                          COREEOLC _ CR.EOLC)
 
 (RECORD CORESTREAM
 STREAM (SUBRECORD STREAM)
-                             [ACCESSFNS CORESTREAM ((INFOBLK (fetch
 F1 of
 DATUM)
-                                                           (replace
 F1 of
 DATUM with

-                                                                                        NEWVALUE))
-                                                    (COREPAGECACHE (fetch
 F10 of
 DATUM)
-                                                           (replace
 F10 of
 DATUM with

-                                                                                         NEWVALUE))
-                                                    (BEINGPRINTED (fetch
 IOBEINGPRINTED
-                                                                     of
 (fetch
 INFOBLK
-                                                                               of
 DATUM))
-                                                           (replace
 IOBEINGPRINTED
-                                                              of
 (fetch
 INFOBLK of
 DATUM)
-                                                              with
 NEWVALUE))
-                                                    (FILEPAGES (fetch
 IOFILEPAGES
-                                                                  of
 (fetch
 INFOBLK
-                                                                            of
 DATUM))
-                                                           (replace
 IOFILEPAGES
-                                                              of
 (fetch
 INFOBLK of
 DATUM)
-                                                              with
 NEWVALUE))
-                                                    (CreationTime (fetch
 IOFIBCreationTime
-                                                                     of
 (fetch
 INFOBLK
-                                                                               of
 DATUM))
-                                                           (replace
 IOFIBCreationTime
-                                                              of
 (fetch
 INFOBLK of
 DATUM)
-                                                              with
 NEWVALUE))
-                                                    (ReadTime (fetch
 IOFIBReadTime
-                                                                 of
 (fetch
 INFOBLK
-                                                                           of
 DATUM))
-                                                           (replace
 IOFIBReadTime
-                                                              of
 (fetch
 INFOBLK of
 DATUM)
-                                                              with
 NEWVALUE))
-                                                    (WriteTime (fetch
 IOFIBWriteTime
-                                                                  of
 (fetch
 INFOBLK
-                                                                            of
 DATUM))
-                                                           (replace
 IOFIBWriteTime
-                                                              of
 (fetch
 INFOBLK of
 DATUM)
-                                                              with
 NEWVALUE])
+                         [ACCESSFNS CORESTREAM ((INFOBLK (fetch
 F1 of
 DATUM)
+                                                       (replace
 F1 of
 DATUM with
 NEWVALUE))
+                                                (COREPAGECACHE (fetch
 F10 of
 DATUM)
+                                                       (replace
 F10 of
 DATUM with
 NEWVALUE))
+                                                (BEINGPRINTED (fetch
 IOBEINGPRINTED
+                                                                 of
 (fetch
 INFOBLK of
 DATUM))
+                                                       (replace
 IOBEINGPRINTED
+                                                          of
 (fetch
 INFOBLK of
 DATUM) with
 NEWVALUE))
+                                                (FILEPAGES (fetch
 IOFILEPAGES
+                                                              of
 (fetch
 INFOBLK of
 DATUM))
+                                                       (replace
 IOFILEPAGES
+                                                          of
 (fetch
 INFOBLK of
 DATUM) with
 NEWVALUE))
+                                                (CreationTime (fetch
 IOFIBCreationTime
+                                                                 of
 (fetch
 INFOBLK of
 DATUM))
+                                                       (replace
 IOFIBCreationTime
+                                                          of
 (fetch
 INFOBLK of
 DATUM) with
 NEWVALUE))
+                                                (ReadTime (fetch
 IOFIBReadTime
+                                                             of
 (fetch
 INFOBLK of
 DATUM))
+                                                       (replace
 IOFIBReadTime
+                                                          of
 (fetch
 INFOBLK of
 DATUM) with
 NEWVALUE))
+                                                (WriteTime (fetch
 IOFIBWriteTime
+                                                              of
 (fetch
 INFOBLK of
 DATUM))
+                                                       (replace
 IOFIBWriteTime
+                                                          of
 (fetch
 INFOBLK of
 DATUM) with
 NEWVALUE])
 
 (ACCESSFNS COREDEVICE
 ((COREDIRECTORY (FETCH
 DEVICEINFO OF
 DATUM)
-                                  (REPLACE
 DEVICEINFO OF
 DATUM WITH
 NEWVALUE))))
+                              (REPLACE
 DEVICEINFO OF
 DATUM WITH
 NEWVALUE))))
 
 (RECORD COREGENFILESTATE
 (COREFILELST))
 )
@@ -954,16 +954,16 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999,
 (PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
 1993 1999 2018))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1755 43279 (\CORE.CLOSEFILE 1765 . 2538) (\CORE.DELETEFILE 2540 . 4526) (
-\CORE.DIRECTORYNAMEP 4528 . 4789) (\CORE.FINDPAGE 4791 . 8020) (\CORE.GENERATEFILES 8022 . 10609) (
-\CORE.NEXTFILEFN 10611 . 11110) (\CORE.FILEINFOFN 11112 . 11341) (\CORE.GETFILEHANDLE 11343 . 13497) (
-\CORE.GETFILEINFO 13499 . 14462) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14464 . 16001) (\CORE.GETFILENAME 
-16003 . 18292) (\CORE.GETINFOBLOCK 18294 . 20917) (\CORE.NAMESCAN 20919 . 22686) (\CORE.NAMESEGMENT 
-22688 . 23125) (\CORE.OPENFILE 23127 . 26246) (\COREFILE.SETPARAMETERS 26248 . 28429) (
-\CORE.PACKFILENAME 28431 . 28826) (\CORE.RELEASEPAGES 28828 . 29429) (\CORE.SETFILEPTR 29431 . 30530) 
-(\CORE.UPDATEOF 30532 . 32161) (\CORE.BACKFILEPTR 32163 . 34371) (\CORE.SETEOFPTR 34373 . 36242) (
-\CORE.SETACCESSTIME 36244 . 36869) (\CORE.SETFILEINFO 36871 . 38062) (\CORE.GETNEXTBUFFER 38064 . 
-42020) (\CORE.UNPACKFILENAME 42022 . 43277)) (43280 46913 (COREDEVICE 43290 . 43461) (
-\CREATECOREDEVICE 43463 . 46911)) (46914 49215 (\NODIRCOREFDEV 46924 . 47521) (\NODIRCORE.OPENFILE 
-47523 . 49213)))))
+  (FILEMAP (NIL (1710 44229 (\CORE.CLOSEFILE 1720 . 2493) (\CORE.DELETEFILE 2495 . 4481) (
+\CORE.DIRECTORYNAMEP 4483 . 4744) (\CORE.FINDPAGE 4746 . 7975) (\CORE.GENERATEFILES 7977 . 10564) (
+\CORE.NEXTFILEFN 10566 . 11065) (\CORE.FILEINFOFN 11067 . 11296) (\CORE.GETFILEHANDLE 11298 . 13452) (
+\CORE.GETFILEINFO 13454 . 14417) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14419 . 15956) (\CORE.GETFILENAME 
+15958 . 18247) (\CORE.GETINFOBLOCK 18249 . 20872) (\CORE.NAMESCAN 20874 . 22641) (\CORE.NAMESEGMENT 
+22643 . 23080) (\CORE.OPENFILE 23082 . 26201) (\COREFILE.SETPARAMETERS 26203 . 28384) (
+\CORE.PACKFILENAME 28386 . 28781) (\CORE.RELEASEPAGES 28783 . 29384) (\CORE.SETFILEPTR 29386 . 30485) 
+(\CORE.UPDATEOF 30487 . 32116) (\CORE.BACKFILEPTR 32118 . 34326) (\CORE.SETEOFPTR 34328 . 36197) (
+\CORE.SETACCESSTIME 36199 . 36824) (\CORE.SETFILEINFO 36826 . 39012) (\CORE.GETNEXTBUFFER 39014 . 
+42970) (\CORE.UNPACKFILENAME 42972 . 44227)) (44230 47863 (COREDEVICE 44240 . 44411) (
+\CREATECOREDEVICE 44413 . 47861)) (47864 50165 (\NODIRCOREFDEV 47874 . 48471) (\NODIRCORE.OPENFILE 
+48473 . 50163)))))
 STOP

sources/DEXEC

@@ -1,14 +1,15 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "13-Aug-2020 12:36:18" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.;10
 5477   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS DEXECCOMS)
+
(FILECREATED " 7-Oct-2021 14:29:56" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>DEXEC.;4
 5554   
 
-      previous date%: "13-Aug-2020 12:31:18" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.;9)
+      changes to%:  (FNS SEE* COPYALLBYTES)
+
+      previous date%: "13-Aug-2020 12:36:18" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>DEXEC.;1)
 
 
 (* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1990, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1982-1986, 1990, 2018, 2020-2021 by Venue & Xerox Corporation.
 The following program was created in 1982 but has not been published
 within the meaning of the copyright law, is furnished under license,
 and may not be used, copied and/or disclosed except in accordance
@@ -20,7 +21,7 @@ with the terms of said license.
 (RPAQQ DEXECCOMS

        [
 
-(* ;;; "Has to come after ADISPLAY and CMLEXEC.")

+(* ;;; "Has to come after ADISPLAY and CMLEXEC.")

 
         (COMMANDS "see" "see*" "ty" "type")
         (INITVARS (/LAST.CONNECTED.DIRECTORY LOGINHOST/DIR))
@@ -74,22 +75,24 @@ with the terms of said license.
     (CNDIR HOST/DIR])
 
 (COPYALLBYTES

-  [LAMBDA (FROMFILE TOFILE BYTESIZE EXTERNALFORMAT)
     (* ; "Edited 11-Aug-2020 20:35 by rmk:")

-                                                             (* bvm%: "29-Jan-86 19:50")

+  [LAMBDA (FROMFILE TOFILE BYTESIZE FORMAT)
             (* ; "Edited  7-Oct-2021 13:15 by rmk:")


+                                                             (* bvm%: "29-Jan-86 19:50")

+
+    (* ;; "RMK: Removed PFDEFAULT arg to PFCOPYBYTES.  Probably should remove BYTESIZE test")

+
     (RESETLST
         [PROG (INF OUTF PTR)
               [COND
                  (FROMFILE [RESETSAVE NIL (LIST 'CLOSEF (SETQ INF (OPENSTREAM
                                                                    FROMFILE
                                                                    'INPUT NIL
-                                                                   `((EXTERNALFORMAT ,EXTERNALFORMAT)
-                                                                     )
+                                                                   `((EXTERNALFORMAT ,FORMAT))
                                                                    BYTESIZE]
                         (OR (EQ (GETFILEPTR INF)
                                 0)
                             (SETFILEPTR INF 0)))
-                 (T (SETQ INF (INPUT]                        (* close the files only if I opened 
-
                                                           them)

+                 (T (SETQ INF (INPUT]                        (* close the files only if I opened 
+
                                                           them)

               [COND
                  ((NULL TOFILE)
                   (SETQ OUTF (OUTPUT)))
@@ -98,7 +101,7 @@ with the terms of said license.
               (COND
                  ((AND (NULL BYTESIZE)
                        (DISPLAYP OUTF))
-                  (PFCOPYBYTES INF OUTF NIL NIL PFDEFAULT))
+                  (PFCOPYBYTES INF OUTF))
                  (T (COPYBYTES INF OUTF])])
 
 (SEE

@@ -110,11 +113,14 @@ with the terms of said license.
            (CADDR LINE))))
 
 (SEE*

-  [NLAMBDA LINE
                                         (* ; "Edited  1-May-2018 10:22 by rmk:")

+  [NLAMBDA LINE
                                         (* ; "Edited  7-Oct-2021 14:29 by rmk:")

+
+    (* ;; "RMK: RESETVARS because **COMMENT**FLG is global")

+
     (SETQ LINE (NLAMBDA.ARGS LINE))
-    (LET ((**COMMENT**FLG NIL))
-         (APPLY (FUNCTION SEE)
-                LINE])
+    (RESETVARS (**COMMENT**FLG)
+               (APPLY (FUNCTION SEE)
+                      LINE])
 )
 (RPAQ SAVINGCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@FDJ@HJJ@LJJ@BNJLJJD@LJD@@@@@@JDN@KEB@KE@@JMF@JMB@JEL@@@@@@@@
 ) (QUOTE NIL) 0 15))
@@ -136,8 +142,9 @@ with the terms of said license.
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS DEXEC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990 2018 2020))
+(PUTPROPS DEXEC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990 2018 2020 2021)
+)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2246 4697 (/CNDIR 2256 . 2693) (COPYALLBYTES 2695 . 4211) (SEE 4213 . 4457) (SEE* 4459
- . 4695)))))
+  (FILEMAP (NIL (2230 4768 (/CNDIR 2240 . 2677) (COPYALLBYTES 2679 . 4203) (SEE 4205 . 4449) (SEE* 4451
+ . 4766)))))
 STOP

sources/EDITINTERFACE

@@ -1,13 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 7-Nov-91 18:15:13" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>EDITINTERFACE.;6|
 38377  
 
-      changes to%:  (FUNCTIONS ED)
+
(FILECREATED "27-Nov-2021 13:28:18" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;2
 37858  
 
-      previous date%: " 5-Feb-91 11:44:57" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>EDITINTERFACE.;5|)
+      previous date%: " 7-Nov-91 18:15:13" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;1)
 
 
 (* ; "
-Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT EDITINTERFACECOMS)
@@ -93,8 +94,8 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
 )

 
 
-(RPAQQ DUMMY-EDIT-FUNCTION-BODY
 [LAMBDA (ARGS ...)
-                                           BODY])
+(RPAQQ DUMMY-EDIT-FUNCTION-BODY
 [LAMBDA (ARGS |...|)
+                                       BODY])
 
 (CL:DEFVAR *ED-OFFERS-PROPERTY-LIST*
 T
    "Controls whether ED offers property list as an editable aspect")
@@ -102,7 +103,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
 (DEFGLOBALVAR XCL::ED-LAST-INFO
 NIL
    "used in ED to stash last call info so (ED NIL) will restart last edit")
 
-(CL:DEFUN ED
 (CL::NAME CL::OPTIONS)
                  (* ; "Edited  5-Jul-88 16:03 by woz")

+(CL:DEFUN ED
 (CL::NAME CL::OPTIONS)
                          (* ; "Edited  5-Jul-88 16:03 by woz")

 
 (* ;;; "Standard Common Lisp editor entry.  CLtL say's ED does something reasonable when passed a pathname.  We coerce name into something that might be the name of something with an IL:FILES definition, & try to edit  that.  Then save call info in ED-LAST-INFO, so (ED) will start last edit over again.")

 
@@ -124,8 +125,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
                                 (CL:MEMBER :DISPLAY CL::OPTIONS)
                                 (CL:MEMBER 'DISPLAY CL::OPTIONS)))
           (CL::GIVEN-TYPES (for
 X inside
 CL::OPTIONS when
 (NEQ X T) bind
 TYPE
-                              when
 (CL:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T CL::NAME))
-                              collect
 TYPE))
+                              when
 (CL:SETQ TYPE (GETFILEPKGTYPE X 'TYPES T CL::NAME)) collect
 TYPE))
           [CL::TYPES-WITH-DEFNS (TYPESOF CL::NAME CL::GIVEN-TYPES NIL
                                        (CL:IF (OR (CL:MEMBER :CURRENT CL::OPTIONS)
                                                   (CL:MEMBER 'CURRENT CL::OPTIONS))
@@ -138,9 +138,9 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
                                  ([AND (NULL CL::GIVEN-TYPES)
                                        (CL:SYMBOLP CL::NAME)
                                        (NOT (NULL *ED-OFFERS-PROPERTY-LIST*))
-                                       (find
 X on
 (GETPROPLIST CL::NAME)
-                                          by
 (CDDR X) suchthat
 (NULL (GET (CAR X)
-                                                                                  'PROPTYPE]
+                                       (find
 X on
 (GETPROPLIST CL::NAME) by
 (CDDR X)
+                                          suchthat
 (NULL (GET (CAR X)
+                                                              'PROPTYPE]
 
                                  (* ;; "if we're supposed to offer PROPERTY-LIST as an edit type, and this name has a property list with other than system properties on it, then add IL:PROPERTY-LIST to the possible types.")

 
@@ -150,60 +150,55 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
          (CL:WHEN (CL:MEMBER 'PROPERTY-LIST CL::OPTIONS)
 
              (* ;; 
-
        "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)")

+
          "this will allow PROPERTY-LIST to be specified as a fake filepkg type by the user (caller)")

 
              (CL:SETQ CL::POSSIBLE-TYPES '(PROPERTY-LIST)))
          [CL:SETQ TYPE (if
 (CL:MEMBER :NEW CL::OPTIONS)
                            then
 
+                                (* ;; "if :NEW then install a blank definition first")

 
-                                 (* ;; "if :NEW then install a blank definition first")

-
-                                 (OR (INSTALL-PROTOTYPE-DEFN
 CL::NAME (OR CL::TYPES-WITH-DEFNS 
-                                                                              CL::GIVEN-TYPES)
-                                            :NEW)
-                                     (CL:RETURN-FROM ED NIL))
+                                (OR (INSTALL-PROTOTYPE-DEFN
 CL::NAME (OR CL::TYPES-WITH-DEFNS 
+                                                                         CL::GIVEN-TYPES)
+                                           :NEW)
+                                    (CL:RETURN-FROM ED NIL))
                          elseif
 (CDR CL::POSSIBLE-TYPES)
                            then
 
+                                (* ;; "Many types were found/given.  Ask the user which to use.")

 
-                                 (* ;; "Many types were found/given.  Ask the user which to use.")

-
-                                 (if
 CL::FROM-DISPLAY
-                                     then
 (OR (MENU (create
 MENU
-                                                               ITEMS _ CL::POSSIBLE-TYPES
-                                                               TITLE _ (CL:FORMAT NIL 
+                                (if
 CL::FROM-DISPLAY
+                                    then
 (OR (MENU (create
 MENU
+                                                          ITEMS _ CL::POSSIBLE-TYPES
+                                                          TITLE _ (CL:FORMAT NIL 
                                                                       "Edit which definition of ~S ?"
-                                                                              CL::NAME)))
-                                                  (CL:RETURN-FROM ED NIL))
-                                   else
 (ASKUSER NIL (CAR CL::POSSIBLE-TYPES)
-                                                   (CL:FORMAT NIL "Edit which ~A definition of ~S ? "
-                                                          CL::POSSIBLE-TYPES CL::NAME)
-                                                   CL::POSSIBLE-TYPES))
+                                                                         CL::NAME)))
+                                             (CL:RETURN-FROM ED NIL))
+                                  else
 (ASKUSER NIL (CAR CL::POSSIBLE-TYPES)
+                                              (CL:FORMAT NIL "Edit which ~A definition of ~S ? " 
+                                                     CL::POSSIBLE-TYPES CL::NAME)
+                                              CL::POSSIBLE-TYPES))
                          elseif
 (NOT (NULL CL::POSSIBLE-TYPES))
                            then
 
+                                (* ;; "Exactly one type was found.")

 
-                                 (* ;; "Exactly one type was found.")

-
-                                 (if
 CL::FROM-DISPLAY
-                                     then
                (* ; "prepare the prompt window")

-                                           (TERPRI PROMPTWINDOW))
-                                 (CL:FORMAT (if
 CL::FROM-DISPLAY
-                                                then
 PROMPTWINDOW
-                                              else
 T)
-                                        "Editing ~A ~A ~S.~%%"
-                                        (CAR CL::POSSIBLE-TYPES)
-                                        (CL:IF (EQ (CAR CL::POSSIBLE-TYPES)
-                                                   'PROPERTY-LIST)
-                                            "of"
-                                            "definition of")
-                                        CL::NAME)
-                                 (CAR CL::POSSIBLE-TYPES)
+                                (if
 CL::FROM-DISPLAY
+                                    then
                     (* ; "prepare the prompt window")

+                                         (TERPRI PROMPTWINDOW))
+                                (CL:FORMAT (if
 CL::FROM-DISPLAY
+                                               then
 PROMPTWINDOW
+                                             else
 T)
+                                       "Editing ~A ~A ~S.~%%"
+                                       (CAR CL::POSSIBLE-TYPES)
+                                       (CL:IF (EQ (CAR CL::POSSIBLE-TYPES)
+                                                  'PROPERTY-LIST)
+                                           "of"
+                                           "definition of")
+                                       CL::NAME)
+                                (CAR CL::POSSIBLE-TYPES)
                          else
 
+                              (* ;; "No types were found.  Use the DefDefiner prototyping machinery.")

 
-                               (* ;; 
-
                             "No types were found.  Use the DefDefiner prototyping machinery.")

-
-                               (OR (INSTALL-PROTOTYPE-DEFN
 CL::NAME CL::GIVEN-TYPES)
-                                   (CL:RETURN-FROM ED NIL]
+                              (OR (INSTALL-PROTOTYPE-DEFN
 CL::NAME CL::GIVEN-TYPES)
+                                  (CL:RETURN-FROM ED NIL]
          (CL:IF (EQ TYPE 'PROPERTY-LIST)
              (EDITE
 (GETPROPLIST CL::NAME)
                     NIL CL::NAME 'PROPLST NIL CL::OPTIONS)
@@ -232,17 +227,16 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
       PROTOTYPE-TYPE)
      (IF
 (AND NEW-DEFN-FLG TYPES-WITH-PROTOTYPES)
          THEN
 (IF
 (CDR TYPES-WITH-PROTOTYPES)
-                      THEN
 (CL:FORMAT T "Installing new definition for ~S~%%" NAME)
-                    ELSE
 (CL:FORMAT T "Installing new ~S definition for ~S~%%" (CAR 
-                                                                                TYPES-WITH-PROTOTYPES
-                                                                                        )
-                                    NAME))
+                  THEN
 (CL:FORMAT T "Installing new definition for ~S~%%" NAME)
+                ELSE
 (CL:FORMAT T "Installing new ~S definition for ~S~%%" (CAR TYPES-WITH-PROTOTYPES
+                                                                                )
+                            NAME))
        ELSEIF
 (NULL REQUESTED-TYPES)
          THEN
 (CL:FORMAT T "~S has no definitions.~%%" NAME)
        ELSEIF
 (NULL (CDR REQUESTED-TYPES))
          THEN
 (CL:FORMAT T "~S has no ~A definition.~%%" NAME (CAR REQUESTED-TYPES))
-       ELSE
 (CL:FORMAT T "~S has no definition of any of these types:~%%  ~A~%%" NAME 
-                       REQUESTED-TYPES))
+       ELSE
 (CL:FORMAT T "~S has no definition of any of these types:~%%  ~A~%%" NAME REQUESTED-TYPES
+                   ))
      [IF
 (NULL TYPES-WITH-PROTOTYPES)
          THEN
 (CL:RETURN-FROM INSTALL-PROTOTYPE-DEFN NIL)
        ELSEIF
 (NULL (CDR TYPES-WITH-PROTOTYPES))
@@ -258,13 +252,10 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
            (APPEND
             [FOR
 TYPE IN
 TYPES-WITH-PROTOTYPES
                COLLECT
 `(,TYPE '(:TYPE ,TYPE)
-                                   "Displays a menu of definers for this type."
-                                   (SUBITEMS ,@(FOR
 DEFINER IN
 (
-                                                                     XCL::PROTOTYPE-DEFINERS-FOR-TYPE
-                                                                        TYPE)
-                                                  COLLECT
 `(,DEFINER '(:DEFINER ,TYPE
-                                                                                 ,DEFINER)
-                                                                      ,DEFINER-HELP-STRING]
+                               "Displays a menu of definers for this type."
+                               (SUBITEMS ,@(FOR
 DEFINER IN
 (XCL::PROTOTYPE-DEFINERS-FOR-TYPE TYPE)
+                                              COLLECT
 `(,DEFINER '(:DEFINER ,TYPE ,DEFINER)
+                                                              ,DEFINER-HELP-STRING]
             (LIST '("Don't make a dummy defn" NIL]
          (RESULT (MENU MENU)))
         (CL:ECASE (CL:FIRST RESULT)
@@ -281,7 +272,7 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
                                                 (LIST '("Don't make a dummy defn" NIL]
           (IF
 DEFINER
               THEN
 (MAKE-AND-INSTALL PROTOTYPE-TYPE DEFINER)
-                    PROTOTYPE-TYPE
+                   PROTOTYPE-TYPE
             ELSE
 NIL])
 (DEFINEQ
 
@@ -745,10 +736,11 @@ Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation.  All ri
 )
 (PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (14507 31290 (EDITDEF.FNS 14517 . 15853) (EDITF 15855 . 16735) (EDITFB 16737 . 17585) (
-EDITFNS 17587 . 18907) (EDITLOADFNS? 18909 . 22709) (EDITMODE 22711 . 24721) (EDITP 24723 . 25234) (
-EDITV 25236 . 25875) (DC 25877 . 26558) (DF 26560 . 27602) (DP 27604 . 28688) (DV 28690 . 29262) (
-EDITPROP 29264 . 29483) (EF 29485 . 29814) (EP 29816 . 29999) (EV 30001 . 30180) (EDITE 30182 . 31060)
- (EDITL 31062 . 31288)) (31640 37712 (NEW/EDITDATE 31650 . 31872) (FIXEDITDATE 31874 . 33716) (
-EDITDATE? 33718 . 34896) (EDITDATE 34898 . 35715) (SETINITIALS 35717 . 37710)))))
+  (FILEMAP (NIL (3710 10009 (ED 3710 . 10009)) (10011 13987 (INSTALL-PROTOTYPE-DEFN 10011 . 13987)) (
+13988 30771 (EDITDEF.FNS 13998 . 15334) (EDITF 15336 . 16216) (EDITFB 16218 . 17066) (EDITFNS 17068 . 
+18388) (EDITLOADFNS? 18390 . 22190) (EDITMODE 22192 . 24202) (EDITP 24204 . 24715) (EDITV 24717 . 
+25356) (DC 25358 . 26039) (DF 26041 . 27083) (DP 27085 . 28169) (DV 28171 . 28743) (EDITPROP 28745 . 
+28964) (EF 28966 . 29295) (EP 29297 . 29480) (EV 29482 . 29661) (EDITE 29663 . 30541) (EDITL 30543 . 
+30769)) (31121 37193 (NEW/EDITDATE 31131 . 31353) (FIXEDITDATE 31355 . 33197) (EDITDATE? 33199 . 34377
+) (EDITDATE 34379 . 35196) (SETINITIALS 35198 . 37191)))))
 STOP

sources/FASLOAD

@@ -1,11 +1,12 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "FASL")
-
(IL:FILECREATED "10-Jun-2021 18:26:43" 
-IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;8|
 35584  
+(DEFINE-FILE-INFO PACKAGE "FASL" READTABLE "XCL" BASE 10)
 
-      IL:|changes| IL:|to:|  (IL:FUNCTIONS READ-TEXT)
+
(IL:FILECREATED "23-Nov-2021 12:29:28" 
+IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FASLOAD.;5|
 34723  
 
-      IL:|previous| IL:|date:| "17-Apr-2018 07:55:20" 
-IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
+      IL:|changes| IL:|to:|  (IL:FNS CONVERT-FASL-DATE)
+
+      IL:|previous| IL:|date:| "23-Nov-2021 09:44:12" 
+IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FASLOAD.;2|)
 
 
 ; Copyright (c) 1986-1992, 2018, 2021 by Venue & Xerox Corporation.
@@ -14,14 +15,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (IL:RPAQQ IL:FASLOADCOMS

           (
-           (IL:* IL:|;;| "FASL file loader.")

+           (IL:* IL:|;;| "FASL file loader.")

 
            
-           (IL:* IL:|;;| "THIS FILE IS DUPLICATED as ...<Lispcore>Sources> for the large-symbol version, and <Lispcore>Sources>2-byte> for the older 2-byte atom version.  IF YOU CHANGE THIS COPY, CHANGE THE OTHER, AS WELL!")

+           (IL:* IL:|;;| "THIS FILE IS DUPLICATED as ...<Lispcore>Sources> for the large-symbol version, and <Lispcore>Sources>2-byte> for the older 2-byte atom version.  IF YOU CHANGE THIS COPY, CHANGE THE OTHER, AS WELL!")

 
            (IL:COMS 
 
-                  (IL:* IL:|;;| "Common definitions.")

+                  (IL:* IL:|;;| "Common definitions.")

 
                   (IL:DECLARE\: IL:EVAL@COMPILE IL:EVAL@LOAD IL:DONTCOPY (IL:FILES (NIL IL:SOURCE)
                                                                                 IL:FASL-SUPPORT))
@@ -33,26 +34,26 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
                   (IL:FUNCTIONS TABLE-STATS))
            (IL:COMS 
 
-                  (IL:* IL:|;;| "Reader.")

+                  (IL:* IL:|;;| "Reader.")

 
-                  (IL:COMS                                   (IL:* IL:\; "Setting up the table")

+                  (IL:COMS                                   (IL:* IL:\; "Setting up the table")

                          (IL:STRUCTURES OPTABLE)
                          (IL:FUNCTIONS MAKE-OPTABLE DEFINE-OPCODE-RANGE DEFINE-SINGLE-OPCODE 
                                 ADD-OP-TRANSLATION OPCODE-SEQUENCE)
-                                                             (IL:* IL:\; "Opcode definers")

+                                                             (IL:* IL:\; "Opcode definers")

                          (IL:FUNCTIONS DEFOP DEFRANGE))
                   (IL:FUNCTIONS FASL-END-OF-BLOCK FASL-EXTENDED SETESCAPE UNIMPLEMENTED-OPCODE)
                   (IL:VARIABLES *DEFAULT-OPTABLE* *CURRENT-OPTABLE* INITIAL-VALUE-TABLE-SIZE 
                          VALUE-TABLE-INCREMENT *VALUE-TABLE* *BLOCK-LEVEL* DEBUG-READER DEBUG-STREAM)
                   
-                  (IL:* IL:|;;| "The main reader functions:")

+                  (IL:* IL:|;;| "The main reader functions:")

 
                   (IL:FUNCTIONS PROCESS-FILE PROCESS-SEGMENT)
                   (IL:FUNCTIONS WITH-OPTABLE CHECK-VERSION READ-TEXT PROCESS-BLOCK SKIP-TEXT 
                          NEXT-VALUE DO-OP NEW-VALUE-TABLE CLEAR-TABLE STORE-VALUE FETCH-VALUE 
                          COLLECT-LIST)
                   
-                  (IL:* IL:|;;| "FASL Opcode processors:")

+                  (IL:* IL:|;;| "FASL Opcode processors:")

 
                   (FASL-OPS FASL-SHORT-INTEGER FASL-NIL FASL-T FASL-INTEGER FASL-LARGE-INTEGER 
                          FASL-RATIO FASL-COMPLEX FASL-VECTOR FASL-CREATE-ARRAY FASL-INITIALIZE-ARRAY
@@ -64,18 +65,18 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
                          FASL-FUNCALL FASL-BITMAP16 FASL-STRUCTURE))
            (XCL:OPTIMIZERS FIXUP-NTOFFSET)
            
-           (IL:* IL:|;;| "make sure there's some print function around so that you can load early.")

+           (IL:* IL:|;;| "make sure there's some print function around so that you can load early.")

 
            (IL:P (IL:MOVD? 'IL:PRIN1 'PRINC)
                  (IL:MOVD? 'IL:TERPRI 'TERPRI))
            (IL:COMS 
 
-                  (IL:* IL:|;;| 
-
             "ADDITION TO FILEDATE so it will handle FASL files as well as LCOMs and source files.")

+                  (IL:* IL:|;;| 
+
               "ADDITION TO FILEDATE so it will handle FASL files as well as LCOMs and source files.")

 
                   (IL:FNS IL:FASL-FILEDATE CONVERT-FASL-DATE))
            
-           (IL:* IL:|;;| "Arrange for the correct compiler and makefile environment")

+           (IL:* IL:|;;| "Arrange for the correct compiler and makefile environment")

 
            (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
                   IL:FASLOAD)))
@@ -143,7 +144,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
    "End-of-data marker: if first byte of a segment, terminate processing")
 
 (DEFCONSTANT VERSION-RANGE
 '(8 . 8)
-                               "Handles (car version-range) <= version <= (cdr version-range)")
+                           "Handles (car version-range) <= version <= (cdr version-range)")
 
 (DEFCONSTANT CURRENT-VERSION
 8)
 
@@ -183,13 +184,13 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFUN DEFINE-OPCODE-RANGE
 (NAME FIRST-OPCODE RANGE OFFSET TABLE)
 
-   (IL:* IL:|;;| 
-
"For implementation of DEFRANGE definer--define a range of opcodes having the same implementation.")

+   (IL:* IL:|;;| 
+
  "For implementation of DEFRANGE definer--define a range of opcodes having the same implementation.")

 
    (LET ((PACKAGE (SYMBOL-PACKAGE NAME))
          (PNAME (SYMBOL-NAME NAME)))
-        (DOTIMES (I RANGE)                                   (IL:* IL:\; 
-
                                                  "Using IL:CONCAT here to minimize bootstrap woes")

+        (DOTIMES (I RANGE)                                   (IL:* IL:\; 
+
                                                    "Using IL:CONCAT here to minimize bootstrap woes")

             (DEFINE-SINGLE-OPCODE
 NAME (+ I FIRST-OPCODE)
                    TABLE
                    (INTERN (IL:CONCAT PNAME (+ I OFFSET))
@@ -197,7 +198,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFUN DEFINE-SINGLE-OPCODE
 (NAME OPCODE TABLE TRANS-NAME)
 
-   (IL:* IL:|;;| "For implementation of DEFOP definer -- define NAME to be a fasl op numbered OPCODE in TABLE.  NAME is the name of both the opcode as a FASL::FASL-OPS and the function implementing the opcode.  TRANS-NAME is a name to associate with the opcode in the OPNAMES slot of the table (it is a generated name when we are called from DEFRANGE).")

+   (IL:* IL:|;;| "For implementation of DEFOP definer -- define NAME to be a fasl op numbered OPCODE in TABLE.  NAME is the name of both the opcode as a FASL::FASL-OPS and the function implementing the opcode.  TRANS-NAME is a name to associate with the opcode in the OPNAMES slot of the table (it is a generated name when we are called from DEFRANGE).")

 
    (SETF (ELT (OPTABLE-VECTOR TABLE)
               OPCODE)
@@ -213,7 +214,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
                   (OPTABLE-OPNAMES TABLE)))))
 
 (DEFUN OPCODE-SEQUENCE
 (OPNAME &OPTIONAL (TABLE *DEFAULT-OPTABLE*)
-                                  &AUX ENTRY)
+                              &AUX ENTRY)
    (COND
       ((NULL TABLE)
        NIL)
@@ -229,8 +230,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 
 (XCL:DEFDEFINER DEFOP
 FASL-OPS (IL:NAME (OPCODE &KEY (INDIRECT 0)
-                                                   (TABLE '*DEFAULT-OPTABLE*))
-                                          &BODY BODY)
+                                               (TABLE '*DEFAULT-OPTABLE*))
+                                      &BODY BODY)
    (IF (ZEROP INDIRECT)
        `(PROGN (DEFUN ,IL:NAME (STREAM OPCODE)
                   ,@BODY)
@@ -245,8 +246,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
                   ,@BODY))))
 
 (XCL:DEFDEFINER DEFRANGE
 FASL-OPS (IL:NAME (FIRST-OPCODE &KEY (INDIRECT 0)
-                                                      (TABLE '*DEFAULT-OPTABLE*))
-                                             RANGE OFFSET &BODY BODY)
+                                                  (TABLE '*DEFAULT-OPTABLE*))
+                                         RANGE OFFSET &BODY BODY)
    (IF (ZEROP INDIRECT)
        `(PROGN (DEFUN ,IL:NAME (STREAM OPCODE)
                   ,@BODY)
@@ -298,11 +299,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 
 (DEFUN PROCESS-FILE
 (STREAM &KEY (TEXT-FN (AND *LOAD-VERBOSE* #'(LAMBDA (TEXT)
-                                                                           (PRINC TEXT)
-                                                                           (TERPRI))))
-                               (ITEM-FN NIL))
+                                                                       (PRINC TEXT)
+                                                                       (TERPRI))))
+                           (ITEM-FN NIL))
 
-(IL:* IL:|;;;| "Calls FASL:PROCESS-SEGMENT with the approriate arguments for each segment in the file. The stream should be positioned at the beginning.")

+(IL:* IL:|;;;| "Calls FASL:PROCESS-SEGMENT with the approriate arguments for each segment in the file. The stream should be positioned at the beginning.")

 
    (UNLESS (EQL (IL:BIN STREAM)
                 SIGNATURE)
@@ -310,8 +311,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
    (LET ((IL:FILEPKGFLG NIL)
          (IL:DFNFLG T)
          (IL:LISPXHIST NIL)
-         (IL:ADDSPELLFLG NIL))                               (IL:* IL:\; 
-
                                  "Bind these so that LOADing a FASL file is like LOADing SYSLOAD.")

+         (IL:ADDSPELLFLG NIL))                               (IL:* IL:\; 
+
                                    "Bind these so that LOADing a FASL file is like LOADing SYSLOAD.")

         (DECLARE
 (SPECIAL IL:FILEPKGFLG IL:DFNFLG IL:LISPXHIST IL:ADDSPELLFLG))
         (IF (< (CHECK-VERSION
 STREAM)
                5)
@@ -346,9 +347,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFUN READ-TEXT
 (STREAM)
 
-   (IL:* IL:|;;| "RMK:  This really should be doing READCCODE to read the bytes, but that fails because this string is not delimited by quotes, rather it has 255 as the end marker.  255 is the XCCS characterset shift, will presumably do something else in Unicode.")

+   (IL:* IL:|;;| "RMK:  This really should be doing READCCODE to read the bytes, but that fails because this string is not delimited by quotes, rather it has 255 as the end marker.  255 is the XCCS characterset shift, will presumably do something else in Unicode.")

 
-   (IL:* IL:|;;| "Any reason not to print the string as a string?")

+   (IL:* IL:|;;| "Any reason not to print the string as a string?")

 
    (DO ((RESULT (MAKE-ARRAY 512 :ELEMENT-TYPE 'CHARACTER :ADJUSTABLE T :FILL-POINTER 0))
         (BYTE (IL:BIN STREAM)
@@ -362,10 +363,10 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
    (IL:WITH-READER-ENVIRONMENT IL:*COMMON-LISP-READ-ENVIRONMENT*
        (CATCH 'FASL-BLOCK-FINISHED
            (WITH-OPTABLE
 OPTABLE (DO ((*VALUE-TABLE* (NEW-VALUE-TABLE
))
-                                          VAL)
-                                         ()
-                                       (SETF VAL (DO-OP
 STREAM 0))
-                                       (WHEN ITEM-FN (FUNCALL ITEM-FN VAL)))))))
+                                      VAL)
+                                     ()
+                                   (SETF VAL (DO-OP
 STREAM 0))
+                                   (WHEN ITEM-FN (FUNCALL ITEM-FN VAL)))))))
 
 (DEFUN SKIP-TEXT
 (STREAM)
    (DO ((BYTE (IL:BIN STREAM)
@@ -400,8 +401,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFUN STORE-VALUE
 (OBJ &OPTIONAL (TABLE *VALUE-TABLE*))
 
-   (IL:* IL:|;;| 
-
"This may want to change to another representation if we can't make VECTOR-PUSH-EXTEND fast enough.")

+   (IL:* IL:|;;| 
+
 "This may want to change to another representation if we can't make VECTOR-PUSH-EXTEND fast enough.")

 
    (VECTOR-PUSH-EXTEND OBJ TABLE VALUE-TABLE-INCREMENT)
    OBJ)
@@ -416,7 +417,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
    (WHEN DOTTED (DECF NELTS))
    (LET ((RESULT (IL:|to|
 NELTS IL:|collect|
 (DO-OP
 STREAM))))
 
-        (IL:* IL:|;;| "Assume dotted and other than a simple cons is rare.")

+        (IL:* IL:|;;| "Assume dotted and other than a simple cons is rare.")

 
         (WHEN DOTTED
             (SETF (CDR (LAST RESULT))
@@ -518,17 +519,17 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFOP FASL-FAT-STRING
 (141)
 
-   (IL:* IL:|;;| "Read a string of specified length that has been encoded in standard NS format.")

+   (IL:* IL:|;;| "Read a string of specified length that has been encoded in standard NS format.")

 
    (LET* ((NCHARS (NEXT-VALUE
))
           (STRING (IL:ALLOCSTRING NCHARS)))
-         (IL:ACCESS-CHARSET STREAM 0)                        (IL:* IL:\; 
-
                                                           "Make sure we're in charset zero")

+         (IL:ACCESS-CHARSET STREAM 0)                        (IL:* IL:\; 
+
                                                             "Make sure we're in charset zero")

          (UNWIND-PROTECT
              (DOTIMES (I NCHARS STRING)
                  (SETF (SVREF STRING I)
-                       (CODE-CHAR (IL:READCCODE STREAM))))   (IL:* IL:\; 
-
                                                       "Restore charset zero, in case anyone cares")

+                       (CODE-CHAR (IL:READCCODE STREAM))))   (IL:* IL:\; 
+
                                                         "Restore charset zero, in case anyone cares")

              (IL:ACCESS-CHARSET STREAM 0))))
 
 (DEFOP FASL-CHARACTER
 (142)
@@ -571,7 +572,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFOP FASL-DCODE
 (150)
 
-(IL:* IL:|;;;| "DIRE WARNING!!! Be sure you have your pointy hat with lots of stars on if you're going to muck around with this code. Due to unfortunately unavoidable performance requirements, this code duplicates D-ASSEM:INTERN-DCODE. If you make a change here, you should probably change the corresponding code there.")

+(IL:* IL:|;;;| "DIRE WARNING!!! Be sure you have your pointy hat with lots of stars on if you're going to muck around with this code. Due to unfortunately unavoidable performance requirements, this code duplicates D-ASSEM:INTERN-DCODE. If you make a change here, you should probably change the corresponding code there.")

 
    (LET ((OVERHEADBYTES (* (IL:FETCH
 (IL:FNHEADER IL:OVERHEADWORDS) IL:OF
 T)
                            IL:BYTESPERWORD))
@@ -583,24 +584,21 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
              (IL:\\BINS STREAM RAW-CODE START-PC CODE-LEN)
              (IL:REPLACE
 (IL:FNHEADER IL:STARTPC) IL:OF
 RAW-CODE IL:WITH
 START-PC))
 
-        (IL:* IL:|;;| "Set up the free variable lookup name table.")

+        (IL:* IL:|;;| "Set up the free variable lookup name table.")

 
         (DO* ((I 0 (1+ I))
               (INDEX OVERHEADBYTES (+ INDEX (IL:CONSTANT (IL:BYTESPERNAMEENTRY))))
 
-              (IL:* IL:|;;| 
-
            "NTSIZE and NTBYTESIZE the sizes of half the table in words and bytes resp.")

+              (IL:* IL:|;;| 
+
              "NTSIZE and NTBYTESIZE the sizes of half the table in words and bytes resp.")

 
               (NTSIZE (IL:CEIL (1+ (IL:UNFOLD NT-COUNT (IL:CONSTANT (IL:WORDSPERNAMEENTRY))))
                              IL:WORDSPERQUAD))
               (NTBYTESIZE (* NTSIZE IL:BYTESPERWORD))
               PFI OFFSET NAME FVAROFFSET)
              ((>= I NT-COUNT)
-              (IL:REPLACE
 (IL:FNHEADER IL:FVAROFFSET) IL:OF
 RAW-CODE IL:WITH
 (OR 
-                                                                                           FVAROFFSET
-                                                                                             0))
-              (IL:REPLACE
 (IL:FNHEADER IL:NTSIZE) IL:OF
 RAW-CODE IL:WITH

-                                                                         (IF (ZEROP NT-COUNT)
+              (IL:REPLACE
 (IL:FNHEADER IL:FVAROFFSET) IL:OF
 RAW-CODE IL:WITH
 (OR FVAROFFSET 0))
+              (IL:REPLACE
 (IL:FNHEADER IL:NTSIZE) IL:OF
 RAW-CODE IL:WITH
 (IF (ZEROP NT-COUNT)
                                                                              0
                                                                              NTSIZE)))
            (SETF PFI (IL:BIN STREAM))
@@ -614,32 +612,30 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
                       (= PFI D-ASSEM:+FVAR-CODE+))
                (SETF FVAROFFSET (FLOOR INDEX IL:BYTESPERWORD))))
 
-        (IL:* IL:|;;| "Fill in the fixed-size fields at the front of the block.")

+        (IL:* IL:|;;| "Fill in the fixed-size fields at the front of the block.")

 
         (LET ((FRAME-NAME (NEXT-VALUE
)))
              (IL:UNINTERRUPTABLY
                  (IL:\\ADDREF FRAME-NAME)
-                 (IL:REPLACE
 (IL:FNHEADER IL:\#FRAMENAME) IL:OF
 RAW-CODE IL:WITH
 
-                                                                                       FRAME-NAME)))
+                 (IL:REPLACE
 (IL:FNHEADER IL:\#FRAMENAME) IL:OF
 RAW-CODE IL:WITH
 FRAME-NAME)))
         (LET ((NLOCALS (IL:BIN STREAM))
               (NFREEVARS (IL:BIN STREAM)))
              (IL:REPLACE
 (IL:FNHEADER IL:NLOCALS) IL:OF
 RAW-CODE IL:WITH
 NLOCALS)
-             (IL:REPLACE
 (IL:FNHEADER IL:PV) IL:OF
 RAW-CODE
-                IL:WITH
 (1- (CEILING (+ NLOCALS NFREEVARS)
-                                       IL:CELLSPERQUAD))))
+             (IL:REPLACE
 (IL:FNHEADER IL:PV) IL:OF
 RAW-CODE IL:WITH
 (1- (CEILING (+ NLOCALS NFREEVARS
+                                                                                    )
+                                                                               IL:CELLSPERQUAD))))
         (IL:REPLACE
 (IL:FNHEADER IL:ARGTYPE) IL:OF
 RAW-CODE IL:WITH
 (IL:BIN STREAM))
         (IL:REPLACE
 (IL:FNHEADER IL:NA) IL:OF
 RAW-CODE IL:WITH
 (NEXT-VALUE
))
         (SETF CLOSURE-INFO (NEXT-VALUE
))
-        (IL:REPLACE
 (IL:FNHEADER IL:CLOSUREP) IL:OF
 RAW-CODE IL:WITH
 (EQ CLOSURE-INFO 
-                                                                                     :CLOSURE))
+        (IL:REPLACE
 (IL:FNHEADER IL:CLOSUREP) IL:OF
 RAW-CODE IL:WITH
 (EQ CLOSURE-INFO :CLOSURE))
         (IL:REPLACE
 (IL:FNHEADER IL:FIXED) IL:OF
 RAW-CODE IL:WITH
 T)
 
-        (IL:* IL:|;;| "Fill in debugging info. It goes into the spare cell just before the code: it's -3 instead of -bytespercell to right-justify the pointer in the cell. Aren't you glad I told you this?")

+        (IL:* IL:|;;| "Fill in debugging info. It goes into the spare cell just before the code: it's -3 instead of -bytespercell to right-justify the pointer in the cell. Aren't you glad I told you this?")

 
         (D-ASSEM:FIXUP-PTR RAW-CODE (- START-PC (IL:BIG-VMEM-CODE 4 3))
                (NEXT-VALUE
))
 
-        (IL:* IL:|;;| "Do fixups")

+        (IL:* IL:|;;| "Do fixups")

 
         (DO ((FN-FIXUP-COUNT (NEXT-VALUE
))
              (I 0 (1+ I))
@@ -674,15 +670,15 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
           (D-ASSEM:FIXUP-WORD RAW-CODE (+ START-PC OFFSET)
                  (IL:\\RESOLVE.TYPENUMBER VALUE)))
 
-        (IL:* IL:|;;| "Finally, wrap this up in a closure-object if requested.")

+        (IL:* IL:|;;| "Finally, wrap this up in a closure-object if requested.")

 
         (IF (EQ CLOSURE-INFO :FUNCTION)
             (IL:MAKE-COMPILED-CLOSURE RAW-CODE NIL)
             RAW-CODE)))
 
 (DEFOP FASL-LOCAL-FN-FIXUPS
 (151)
-   (LET ((PASS-THROUGH (NEXT-VALUE
)))                    (IL:* IL:\; 
-
            "This will typically correspond to the DCODE that had the fixups, but can be anything.")

+   (LET ((PASS-THROUGH (NEXT-VALUE
)))                        (IL:* IL:\; 
+
              "This will typically correspond to the DCODE that had the fixups, but can be anything.")

         (DO ((FIXUP-COUNT (NEXT-VALUE
))
              (I 0 (IL:ADD1 I))
              CODE-TO-FIX OFFSET VALUE)
@@ -701,8 +697,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
                                         ,THING))))
                  (IF (EQ CODE-TO-FIX VALUE)
                      (LET ((CODE (GET-CODE CODE-TO-FIX)))
-                          (D-ASSEM:FIXUP-PTR-NO-REF CODE (IL:IPLUS (IL:FETCH
 (IL:FNHEADER 
-                                                                                        IL:STARTPC)
+                          (D-ASSEM:FIXUP-PTR-NO-REF CODE (IL:IPLUS (IL:FETCH
 (IL:FNHEADER IL:STARTPC)
                                                                       IL:OF
 CODE)
                                                                 OFFSET)
                                  VALUE))
@@ -740,7 +735,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFOP FASL-BITMAP16
 (158)
 
-(IL:* IL:|;;;| "Load an Interlisp BITMAP.")

+(IL:* IL:|;;;| "Load an Interlisp BITMAP.")

 
    (LET* ((WIDTH (NEXT-VALUE
))
           (HEIGHT (NEXT-VALUE
))
@@ -753,32 +748,29 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 (DEFOP FASL-STRUCTURE
 (159)
 
-(IL:* IL:|;;;| "Load a DEFSTRUCT-defined structure instance.")

+(IL:* IL:|;;;| "Load a DEFSTRUCT-defined structure instance.")

 
    (IL:CREATE-STRUCTURE (CONS (NEXT-VALUE
)
                               (NEXT-VALUE
))))
 
 (XCL:DEFOPTIMIZER FIXUP-NTOFFSET
 (RAW-CODE OFFSET TYPE VALUE &ENVIRONMENT IL:ENV)
 
-                                 (IL:* IL:|;;| "Do the fixups for a name-table offset entry, given a code block, the NTOffset's offset within the codeblock, and the variable type and FVAR offset.")

+                                 (IL:* IL:|;;| "Do the fixups for a name-table offset entry, given a code block, the NTOffset's offset within the codeblock, and the variable type and FVAR offset.")

 
-                                     (COND
-                                        ((IL:FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE IL:ENV)
-                                                )
+                                 (COND
+                                    ((IL:FMEMB :3-BYTE (COMPILER::ENV-TARGET-ARCHITECTURE IL:ENV))
 
-                                         (IL:* IL:|;;| 
-
                                       "3-byte case; the nametable entry is a full cell.")

+                                     (IL:* IL:|;;| "3-byte case; the nametable entry is a full cell.")

 
-                                         `(PROGN (D-ASSEM:FIXUP-WORD ,RAW-CODE ,OFFSET ,TYPE)
-                                                 (D-ASSEM:FIXUP-WORD ,RAW-CODE (+ ,OFFSET 
-                                                                                  IL:BYTESPERWORD)
-                                                        ,VALUE)))
-                                        (T 
-                                           (IL:* IL:|;;| "Old nametable case, it's just a word.")

+                                     `(PROGN (D-ASSEM:FIXUP-WORD ,RAW-CODE ,OFFSET ,TYPE)
+                                             (D-ASSEM:FIXUP-WORD ,RAW-CODE (+ ,OFFSET IL:BYTESPERWORD
+                                                                              )
+                                                    ,VALUE)))
+                                    (T 
+                                       (IL:* IL:|;;| "Old nametable case, it's just a word.")

 
-                                           `(D-ASSEM:FIXUP-WORD ,RAW-CODE ,OFFSET (IL:IPLUS
-                                                                                   ,TYPE
-                                                                                   ,VALUE)))))
+                                       `(D-ASSEM:FIXUP-WORD ,RAW-CODE ,OFFSET (IL:IPLUS ,TYPE
+                                                                                     ,VALUE)))))
 
 
 
@@ -791,18 +783,20 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 
 
 
-(IL:* IL:|;;| "ADDITION TO FILEDATE so it will handle FASL files as well as LCOMs and source files."
-)

+(IL:* IL:|;;| "ADDITION TO FILEDATE so it will handle FASL files as well as LCOMs and source files.")

 
 (IL:DEFINEQ
 
 (IL:FASL-FILEDATE

-  (IL:LAMBDA (STREAM IL:CFLG)
                       (IL:* IL:\; "Edited 17-Feb-89 11:25 by jds")

+  (IL:LAMBDA (STREAM IL:CFLG)                                (IL:* IL:\; 
+
                                                             "Edited 23-Nov-2021 08:26 by rmk:")

                                                              (IL:* IL:\; 
-
                                                           "CFLG IS T FOR COMPILED FILES")

+
                                                             "Edited 17-Feb-89 11:25 by jds")

+                                                             (IL:* IL:\; 
+
                                                             "CFLG IS T FOR COMPILED FILES")

 
     (IL:* IL:|;;| 
-
  "If STREAM is open on a FASL file, returns the FILEDATE for that file.  Otherwise, returns NIL.")

+
    "If STREAM is open on a FASL file, returns the FILEDATE for that file.  Otherwise, returns NIL.")

 
     (IL:* IL:|;;| "Used in FILEDATE; kept a separate function because FILEDATE is defined before the FASL package is loaded.")

 
@@ -810,36 +804,39 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
        ((EQL (IL:BIN STREAM)
              SIGNATURE)                                      (IL:* IL:\; " \"Aha, a Dfasl file\"")

         (IL:SETFILEPTR STREAM 0)
-        (IL:SETQ IL:VALUE (CONVERT-FASL-DATE
 (PROCESS-FILE STREAM :TEXT-FN
-                                                        #'(IL:LAMBDA (IL:X)
-                                                            (IL:RETFROM 'PROCESS-FILE IL:X))
-                                                        :ITEM-FN
-                                                        'IL:NILL)
-                                 IL:CFLG))))))
+        (CONVERT-FASL-DATE
 (PROCESS-FILE
 STREAM :TEXT-FN #'(IL:LAMBDA (IL:X)
+                                                             (IL:RETFROM 'PROCESS-FILE IL:X))
+                                  :ITEM-FN
+                                  'IL:NILL)
+               IL:CFLG)))))
 
 (CONVERT-FASL-DATE

-  (IL:LAMBDA (IL:DATESTRING IL:CFLG)
             (IL:* IL:\; "Edited 17-Apr-2018 07:55 by rmk:")

-                                                             (IL:* IL:\; 
-
                                                           "Edited 23-Jan-89 13:55 by gadener")

+  (IL:LAMBDA (IL:DATESTRING IL:CFLG)
                 (IL:* IL:\; "Edited 23-Nov-2021 12:29 by rmk:")


+                                                     (IL:* IL:\; "Edited 17-Apr-2018 07:55 by rmk:")


+                                                    (IL:* IL:\; "Edited 23-Jan-89 13:55 by gadener")

 
-    (IL:* IL:|;;| "CONVERT-FASL-DATE takes the file text info from a DFASL file describing creation dates for source and compiled code and returns either one of these dates,  depending on the value of CLFG, in da-mon-yr hr:mn:sc format.")

+    (IL:* IL:|;;| "CONVERT-FASL-DATE takes the file text info from a DFASL file describing creation dates for source and compiled code and returns either one of these dates,  depending on the value of CLFG, in da-mon-yr hr:mn:sc format.")

 
-    (IL:* IL:|;;| "")

+    (IL:* IL:|;;| "")

 
-    (IL:* IL:|;;| "RMK: The SHORT-DATE-STRING has all of the information in the right order, most likely with 4-digit years too.  But it seems to have spaces between the day and month and month and year, whereas (DATE) with the default format produces strings with hyphens.  It also has comma-space after the year while (DATE) has just space.  The month is also spelled out (April instead of Apr).  But those differences don't seem to matter to IDATE, which is where comparisons should be done. I commented out all the junky code.")

+    (IL:* IL:|;;| "RMK: 23-Nov-2021.  Some DFASL files have a different date format, without the day before a comma and without a period at the end of the lines.  It seems that the easiest thing is just to isolate the full date strings, stripping off the period at the end and then canonicalize the return date with (GDATE (IDATE )). IDATE in particular seems to recognize all the formats.")

 
-    (LET* ((IL:DATE-POS (IF IL:CFLG
-                            (IL:STRPOS "Source file created" IL:DATESTRING)
-                            (IL:STRPOS "FASL file created" IL:DATESTRING)))
-           (IL:BEGIN-POS (IL:STRPOS "," IL:DATESTRING IL:DATE-POS))
-           (IL:END-POS (IL:STRPOS "." IL:DATESTRING IL:DATE-POS))
-           (IL:SHORT-DATE-STRING (IL:SUBSTRING IL:DATESTRING (+ IL:BEGIN-POS 2)
-                                        (IL:SUB1 IL:END-POS)))
-           IL:TEMP-DATE IL:DATE-RESULT)
+    (IL:* IL:|;;| "")

 
-          (IL:* IL:|;;| "(SETQ TEMP-DATE (CONCAT (GNC SHORT-DATE-STRING) (GNC SHORT-DATE-STRING))) (if (EQUAL \" \" (SUBSTRING TEMP-DATE 2)) then (SETQ TEMP-DATE (CONCAT \" \" (GNC TEMP-DATE))) else (GNC SHORT-DATE-STRING)) (SETQ DATE-RESULT (CONCAT TEMP-DATE \"-\" (GNC SHORT-DATE-STRING) (GNC SHORT-DATE-STRING) (GNC SHORT-DATE-STRING) \"-\")) (SETQ TEMP-DATE (SUBSTRING SHORT-DATE-STRING (PLUS 3 (STRPOS \" \" SHORT-DATE-STRING)))) (SETQ DATE-RESULT (CONCAT DATE-RESULT (GNC TEMP-DATE) (GNC TEMP-DATE) \" \")) (GNC TEMP-DATE) (GNC TEMP-DATE) (if (LESSP (STRPOS \":\" TEMP-DATE) 3) then (CONCAT DATE-RESULT \"0\" TEMP-DATE) else (CONCAT DATE-RESULT TEMP-DATE))")

-                                                             (IL:* IL:\; "")

-          IL:SHORT-DATE-STRING)))
+    (IL:* IL:|;;| 
+
    "END-POS is the end of the line that contains the key substring, last char could be period")

+
+    (LET* ((IL:DATE-SUFFIX (IL:SUBSTRING IL:DATESTRING (IL:STRPOS (IF IL:CFLG
+                                                                      "FASL file created "
+                                                                      "Source file created ")
+                                                              IL:DATESTRING 1 NIL NIL T)))
+           (IL:END-POS (OR (IL:STRPOS (IL:CHARACTER (IL:CHARCODE EOL))
+                                  IL:DATE-SUFFIX)
+                           (IL:SUB1 (IL:NCHARS IL:DATE-SUFFIX)))))
+          (IL:GDATE (IL:IDATE (IL:SUBSTRING IL:DATE-SUFFIX 1 (IF (EQ (IL:CHARCODE \.)
+                                                                     (IL:NTHCHARCODE IL:END-POS -1))
+                                                                 (IL:SUB1 IL:END-POS 1)
+                                                                 IL:END-POS)))))))
 )
 
 
@@ -853,15 +850,15 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FASLOAD.;3|)
 (IL:PUTPROPS IL:FASLOAD IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1989 1990 1991 1992 
 2018 2021))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (6461 6877 (TABLE-STATS 6461 . 6877)) (7039 7318 (MAKE-OPTABLE 7039 . 7318)) (7320 
-7963 (DEFINE-OPCODE-RANGE 7320 . 7963)) (7965 8515 (DEFINE-SINGLE-OPCODE 7965 . 8515)) (8517 8775 (
-ADD-OP-TRANSLATION 8517 . 8775)) (8777 9141 (OPCODE-SEQUENCE 8777 . 9141)) (10735 10901 (
-FASL-END-OF-BLOCK 10735 . 10901)) (10903 11024 (FASL-EXTENDED 10903 . 11024)) (11026 11151 (SETESCAPE 
-11026 . 11151)) (11153 11249 (UNIMPLEMENTED-OPCODE 11153 . 11249)) (11610 12960 (PROCESS-FILE 11610 . 
-12960)) (12962 13192 (PROCESS-SEGMENT 12962 . 13192)) (13297 13609 (CHECK-VERSION 13297 . 13609)) (
-13611 14272 (READ-TEXT 13611 . 14272)) (14274 14776 (PROCESS-BLOCK 14274 . 14776)) (14778 14917 (
-SKIP-TEXT 14778 . 14917)) (14972 15579 (DO-OP 14972 . 15579)) (15581 15682 (NEW-VALUE-TABLE 15581 . 
-15682)) (15684 15783 (CLEAR-TABLE 15684 . 15783)) (15785 16039 (STORE-VALUE 15785 . 16039)) (16041 
-16126 (FETCH-VALUE 16041 . 16126)) (16128 16656 (COLLECT-LIST 16128 . 16656)) (31623 35206 (
-IL:FASL-FILEDATE 31636 . 32797) (CONVERT-FASL-DATE 32799 . 35204)))))
+  (IL:FILEMAP (NIL (6469 6885 (TABLE-STATS 6469 . 6885)) (7047 7326 (MAKE-OPTABLE 7047 . 7326)) (7328 
+7975 (DEFINE-OPCODE-RANGE 7328 . 7975)) (7977 8527 (DEFINE-SINGLE-OPCODE 7977 . 8527)) (8529 8787 (
+ADD-OP-TRANSLATION 8529 . 8787)) (8789 9149 (OPCODE-SEQUENCE 8789 . 9149)) (10727 10893 (
+FASL-END-OF-BLOCK 10727 . 10893)) (10895 11016 (FASL-EXTENDED 10895 . 11016)) (11018 11143 (SETESCAPE 
+11018 . 11143)) (11145 11241 (UNIMPLEMENTED-OPCODE 11145 . 11241)) (11602 12942 (PROCESS-FILE 11602 . 
+12942)) (12944 13174 (PROCESS-SEGMENT 12944 . 13174)) (13279 13591 (CHECK-VERSION 13279 . 13591)) (
+13593 14254 (READ-TEXT 13593 . 14254)) (14256 14742 (PROCESS-BLOCK 14256 . 14742)) (14744 14883 (
+SKIP-TEXT 14744 . 14883)) (14938 15545 (DO-OP 14938 . 15545)) (15547 15648 (NEW-VALUE-TABLE 15547 . 
+15648)) (15650 15749 (CLEAR-TABLE 15650 . 15749)) (15751 16006 (STORE-VALUE 15751 . 16006)) (16008 
+16093 (FETCH-VALUE 16008 . 16093)) (16095 16623 (COLLECT-LIST 16095 . 16623)) (30975 34345 (
+IL:FASL-FILEDATE 30988 . 32271) (CONVERT-FASL-DATE 32273 . 34343)))))
 IL:STOP

sources/FILEPKG

@@ -1,11 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "23-Aug-2021 16:42:18" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;6
 284495 
 
-      changes to%:  (FNS GATHEREXPORTS)
+
(FILECREATED " 8-Nov-2021 10:52:49" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;15
 284792 
 
-      previous date%: " 3-Jul-2021 11:08:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;5)
+      changes to%:  (FNS COMPAREDEFS)
+
+      previous date%: "30-Oct-2021 20:03:07" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;14)
 
 
 (* ; "
@@ -19,15 +19,15 @@ with the terms of said license.
 (PRETTYCOMPRINT FILEPKGCOMS)
 
 (RPAQQ FILEPKGCOMS

-       [(COMS                                                (* ; 
-
            "standard records for accessing file  package type/command parts.  Exported for PRETTY")

+       [(COMS                                                (* ; 
+
              "standard records for accessing file  package type/command parts.  Exported for PRETTY")

               (VARS FILEPKGTYPEPROPS)
               (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS)))
               (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS)
               (INITRECORDS * FILEPKGRECORDS))
         [DECLARE%: EVAL@COMPILE DOCOPY 
 
-               (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")

+               (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")

 
                (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES 
                                        PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS
@@ -36,7 +36,7 @@ with the terms of said license.
                                        NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS]
         (INITVARS (MSDATABASELST))
         [COMS 
-              (* ;; "making, adding, listing, compiling files")

+              (* ;; "making, adding, listing, compiling files")

 
               (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES 
                    FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE
@@ -58,14 +58,14 @@ with the terms of said license.
               (INITVARS (MAKEFILEREMAKEFLG T)
                      (CLEANUPOPTIONS '(RC]
         (COMS 
-              (* ;; "scanning file coms")

+              (* ;; "scanning file coms")

 
               (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS 
                    FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM
                    INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN 
                    IFCDECLARE INFILEPAIRS INFILECOMSMACRO))
         (COMS 
-              (* ;; "adding to a file")

+              (* ;; "adding to a file")

 
               (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM 
                    ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM)
@@ -73,28 +73,28 @@ with the terms of said license.
               (ADDVARS (MARKASCHANGEDFNS))
               (FNS MERGEINSERT MERGEINSERT1)
               
-              (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")

+              (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")

 
               (FNS ADDTOFILEKEYLST)
               (INITVARS (ADDTOFILEKEYLST (ADDTOFILEKEYLST))
                      (LASTFILE)))
         (COMS 
-              (* ;; "deleting an item from a file")

+              (* ;; "deleting an item from a file")

 
               (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE)
               (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)
                  (MOVD? 'MOVETOFILE 'MOVEITEM NIL T))
               (ADDVARS (SYSPROPS PROPTYPE VARTYPE)))
-        [COMS                                                (* ; 
-
                      "functions for doing things and marking them changed and auxiliary functions")

+        [COMS                                                (* ; 
+
                        "functions for doing things and marking them changed and auxiliary functions")

               (FNS SAVEPUT)
               [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
                                                      (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT]
               (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS)
               (ADDVARS (LISPXFNS (PUT . SAVEPUT)
                               (PUTPROP . SAVEPUT]
-        (COMS                                                (* ; 
-
                                                  "sub-functions for file package commands & types")

+        (COMS                                                (* ; 
+
                                                    "sub-functions for file package commands & types")

               (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED 
                    MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS 
                    PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS 
@@ -107,24 +107,24 @@ with the terms of said license.
               (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS 
                     LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS 
                     PRETTYPRINTYPEMACROS USERMACROS))
-        (COMS                                                (* ; 
-
                    "Define the commands below AFTER the various properties have been established.")

+        (COMS                                                (* ; 
+
                      "Define the commands below AFTER the various properties have been established.")

               (USERMACROS M))
-        (COMS                                                (* ; "GETDEF methods")

+        (COMS                                                (* ; "GETDEF methods")

               (FNS RENAME CHANGECALLERS)
               (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE
                    GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF 
                    DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
               (INITVARS (WHEREIS.HASH)))
-                                                             (* ; "Must come after PUTDEF")

+                                                             (* ; "Must come after PUTDEF")

         (FNS FIXEDITDATE EDITDATE?)
-                                                             (* ; 
-
                                  "Edit date support for all kinds of definers (from PARC 6/10/92)")

+                                                             (* ; 
+
                                    "Edit date support for all kinds of definers (from PARC 6/10/92)")

         [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
               (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
         (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
         (COMS 
-              (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")

+              (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")

 
               (FNS FILEPKGCOM FILEPKGTYPE)
               (PROP ARGNAMES FILEPKGCOM)
@@ -137,24 +137,24 @@ with the terms of said license.
         (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS)
                         (VARIABLES VARS CONSTANTS)))
         (INITVARS (SAVEDDEFS))
-        (COMS                                                (* ; "EDITCALLERS")

+        (COMS                                                (* ; "EDITCALLERS")

               (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN)
               (FNS SEPRCASE)
               [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL]
               (INITVARS (SEPRCASEARRAYS)
                      (CLISPCASEARRAYS))
               (P (MOVD? 'INFILEP 'FINDFILE)
-                                                             (* ; "or else from SPELLFILE")
)
+                                                             (* ; "or else from SPELLFILE")
)
               (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
                              (NOLINKFNS LOADFROM)))
               (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS))
-        (COMS                                                (* ; "EXPORT")

+        (COMS                                                (* ; "EXPORT")

               (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS)
               (FILEPKGCOMS EXPORT)
               [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")
                      (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"]
               (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM))
-        (COMS                                                (* ; "for GAINSPACE")

+        (COMS                                                (* ; "for GAINSPACE")

               (FNS CLEARFILEPKG)
               [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
                                               ((Y "es")
@@ -210,99 +210,91 @@ with the terms of said license.
 (* ; "standard records for accessing file  package type/command parts.  Exported for PRETTY")

 
 
-(RPAQQ FILEPKGTYPEPROPS
 (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
-                                   HASDEF EDITDEF CANFILEDEF FILEGETDEF))
+(RPAQQ FILEPKGTYPEPROPS
 (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF
+                               EDITDEF CANFILEDEF FILEGETDEF))
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (RPAQQ FILEPKGRECORDS
 (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
 (DECLARE%: EVAL@COMPILE
 
 (ACCESSFNS FILEPKGCOM
 [[ADD
 (GETPROP DATUM 'ADDTOPRETTYCOM)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE))
-                                               (T (/REMPROP DATUM 'ADDTOPRETTYCOM]
-                           [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE))
-                                               (T (/REMPROP DATUM 'DELFROMPRETTYCOM]
-                           [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE))
-                                               (T (/REMPROP DATUM 'PRETTYTYPE]
-                           [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS)
-                                  (UNDOABLE (COND
-                                               (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE))
-                                               (T (/REMPROP DATUM 'FILEPKGCONTENTS]
-                           (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS]
-                                  (STANDARD [COND
-                                               [NEWVALUE (PUTASSOC DATUM NEWVALUE
-                                                                (OR (LISTP (GETTOPVAL 
+                            (UNDOABLE (COND
+                                         (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE))
+                                         (T (/REMPROP DATUM 'ADDTOPRETTYCOM]
+                       [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM)
+                              (UNDOABLE (COND
+                                           (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE))
+                                           (T (/REMPROP DATUM 'DELFROMPRETTYCOM]
+                       [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE)
+                              (UNDOABLE (COND
+                                           (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE))
+                                           (T (/REMPROP DATUM 'PRETTYTYPE]
+                       [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS)
+                              (UNDOABLE (COND
+                                           (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE))
+                                           (T (/REMPROP DATUM 'FILEPKGCONTENTS]
+                       (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS]
+                              (STANDARD [COND
+                                           [NEWVALUE (PUTASSOC DATUM NEWVALUE
+                                                            (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
+                                                                (SETTOPVAL 'PRETTYDEFMACROS
+                                                                       (LIST (LIST DATUM]
+                                           (T (SETTOPVAL 'PRETTYDEFMACROS
+                                                     (REMOVE (FASSOC DATUM (GETTOPVAL 
                                                                                   'PRETTYDEFMACROS))
-                                                                    (SETTOPVAL 'PRETTYDEFMACROS
-                                                                           (LIST (LIST DATUM]
-                                               (T (SETTOPVAL 'PRETTYDEFMACROS
-                                                         (REMOVE (FASSOC DATUM (GETTOPVAL
-                                                                                'PRETTYDEFMACROS))
-                                                                (GETTOPVAL 'PRETTYDEFMACROS]
-                                         UNDOABLE
-                                         (COND
-                                            [NEWVALUE (/PUTASSOC DATUM NEWVALUE
-                                                             (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
-                                                                 (/SETTOPVAL 'PRETTYDEFMACROS
-                                                                        (LIST (LIST DATUM]
-                                            (T (/SETTOPVAL 'PRETTYDEFMACROS
-                                                      (REMOVE (FASSOC DATUM (GETTOPVAL 
-                                                                                   'PRETTYDEFMACROS))
-                                                             (GETTOPVAL 'PRETTYDEFMACROS]
-                                                             (* Not an atom record cause want 
-
                                                           REMPROP on NILs.)

-                                                             (* NOTE%: PRETTCOM on PRETTY has 
-
                                                           open-coded access to the MACRO 
-
                                                           property.)

-                          (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
-                                       FILEPKGCONTENTS)))
+                                                            (GETTOPVAL 'PRETTYDEFMACROS]
+                                     UNDOABLE
+                                     (COND
+                                        [NEWVALUE (/PUTASSOC DATUM NEWVALUE
+                                                         (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
+                                                             (/SETTOPVAL 'PRETTYDEFMACROS
+                                                                    (LIST (LIST DATUM]
+                                        (T (/SETTOPVAL 'PRETTYDEFMACROS
+                                                  (REMOVE (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS))
+                                                         (GETTOPVAL 'PRETTYDEFMACROS]
+                                                             (* Not an atom record cause want 
+
                                                             REMPROP on NILs.)

+                                                             (* NOTE%: PRETTCOM on PRETTY has 
+
                                                             open-coded access to the MACRO 
+
                                                             property.)

+                      (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
+                                   FILEPKGCONTENTS)))
 
-(ATOMRECORD FILEPKGTYPE
 (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
-                                   HASDEF EDITDEF FILEGETDEF CANFILEDEF)
-                            (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM))
-                                                           (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE))
-                                                           )
-                                                    (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST
-                                                                              DATUM)))
-                                                           (STANDARD (SETTOPVAL (CAR (
-                                                                                  SEARCHPRETTYTYPELST
-                                                                                      DATUM NEWVALUE)
-                                                                                     )
-                                                                            NEWVALUE)
-                                                                  UNDOABLE
-                                                                  (/SETTOPVAL (CAR (
-                                                                                  SEARCHPRETTYTYPELST
-                                                                                    DATUM NEWVALUE))
-                                                                         NEWVALUE)))
-                                                    (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST
-                                                                             DATUM)))
-                                                           (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST
-                                                                               DATUM NEWVALUE))
-                                                                       NEWVALUE)))
-                                                    (ALLFIELDS NIL (/SETTOPVAL
-                                                                    'PRETTYTYPELST
-                                                                    (REMOVE (SEARCHPRETTYTYPELST
-                                                                             DATUM)
-                                                                           (GETTOPVAL 'PRETTYTYPELST]
-                                                             (* NOTE%: PRETTYCOM on PRETTY has 
-
                                                           open-coded access to GETDEF property)

-                                   (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
-                                                (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
-                                                                                   (PUT X
-                                                                                        'PROPTYPE
-                                                                                        'FILEPKGCOMS]
-                                         (ADDTOVAR PRETTYTYPELST
 ))))
+(ATOMRECORD FILEPKGTYPE
 (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED HASDEF
+                               EDITDEF FILEGETDEF CANFILEDEF)
+                        (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM))
+                                                       (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE)))
+                                                (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST DATUM))
+                                                                )
+                                                       (STANDARD (SETTOPVAL (CAR (SEARCHPRETTYTYPELST
+                                                                                  DATUM NEWVALUE))
+                                                                        NEWVALUE)
+                                                              UNDOABLE
+                                                              (/SETTOPVAL (CAR (SEARCHPRETTYTYPELST
+                                                                                DATUM NEWVALUE))
+                                                                     NEWVALUE)))
+                                                (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST DATUM)))
+                                                       (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST DATUM
+                                                                                 NEWVALUE))
+                                                                   NEWVALUE)))
+                                                (ALLFIELDS NIL (/SETTOPVAL 'PRETTYTYPELST
+                                                                      (REMOVE (SEARCHPRETTYTYPELST
+                                                                               DATUM)
+                                                                             (GETTOPVAL 
+                                                                                    'PRETTYTYPELST]
+                                                             (* NOTE%: PRETTYCOM on PRETTY has 
+
                                                             open-coded access to GETDEF property)

+                               (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
+                                            (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
+                                                                               (PUT X 'PROPTYPE
+                                                                                    'FILEPKGCOMS]
+                                     (ADDTOVAR PRETTYTYPELST
 ))))
 
 (ATOMRECORD FILE
 (FILECHANGES FILEDATES FILEMAP)
-                     [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE)
-                                             (STANDARD (PUTPROP DATUM 'FILE NEWVALUE)
-                                                    UNDOABLE
-                                                    (/PUTPROP DATUM 'FILE NEWVALUE])
+                 [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE)
+                                         (STANDARD (PUTPROP DATUM 'FILE NEWVALUE)
+                                                UNDOABLE
+                                                (/PUTPROP DATUM 'FILE NEWVALUE])
 
 (RECORD FILEDATEPAIR
 (FILEDATE . DATEFILENAME))
 
@@ -455,31 +447,35 @@ with the terms of said license.
           (RETURN FILE])
 
 (MAKEFILE

-  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)
          (* ; "Edited  3-Jul-2021 11:03 by rmk:")


-                                                            (* ; "Edited 29-Jun-2021 17:24 by rmk:")

+  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)
          (* ; "Edited 10-Oct-2021 20:36 by rmk:")


+                                                            (* ; "Edited 29-Jun-2021 17:24 by rmk:")

 
-    (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL;  LIST means list the FILE;  RC means RECOMPILE, C means COMPILEL;  --- for C AND RC assume ST unless next option is F.")

+    (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL;  LIST means list the FILE;  RC means RECOMPILE, C means COMPILEL;  --- for C AND RC assume ST unless next option is F.")

 
+    (* ;; "RMK:  OPTIONS can specify external format, either as a pair like (FORMAT :UTF-8) or just :UTF-8 where (FIND-FORMAT :UTF-8) is non NIL.")

+
+    [SETQ OPTIONS (FOR
 OPT INSIDE
 OPTIONS COLLECT
 (CL:IF (FIND-FORMAT OPT T)
+                                                                  (LIST 'FORMAT OPT))]
     (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS]
                            PRETTYFLG))
            (*PRINT-BASE* (if
 (EQ *PRINT-BASE* 8)
                              then
 8
-                           else
                          (* ; "make sure radix is either 8 or 10, because all others don't read in like they print.  Maybe obsolete now with makefile environments")

+                           else
                          (* ; "make sure radix is either 8 or 10, because all others don't read in like they print.  Maybe obsolete now with makefile environments")

                                  10))
            FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE
 FILE)))
           (DECLARE
 (CL:SPECIAL PRETTYFLG))
-          (SETQ FILE (CAR Z))                                (* ; 
-
                                               "Necessary because FILE might have been misspelled.")

-          (SETQ ROOTNAME (CADR Z))                           (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")

+          (SETQ FILE (CAR Z))                                (* ; 
+
                                               "Necessary because FILE might have been misspelled.")

+          (SETQ ROOTNAME (CADR Z))                           (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")

           (SETQ FILEPROP (CDDR Z))
-          (UPDATEFILES
)                                  (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")

+          (UPDATEFILES
)                                  (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")

           (SETQ CHANGES (fetch
 TOBEDUMPED of
 FILEPROP))
           (SETQ FILEDATES (LISTP (fetch
 FILEDATES of
 ROOTNAME)))
           (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE))
       LP0 (if
 (AND (NULL (fetch
 LOADTYPE of
 FILEPROP))
                        (NULL FILEDATES))
-              then
                                       (* ; 
-
                   "File has never been loaded and never dumped i.e. user just set up COMS in core")

+              then
                                       (* ; 
+
                   "File has never been loaded and never dumped i.e. user just set up COMS in core")

             elseif
 [OR (EQMEMB 'NEW OPTIONS)
                            (AND (NULL MAKEFILEREMAKEFLG)
                                 (NOT (MEMB 'REMAKE OPTIONS]
@@ -500,14 +496,14 @@ with the terms of said license.
                                   T)
                            (COND
                               ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ")
-                                    'Y)                      (* ; 
-
            "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")

+                                    'Y)                      (* ; 
+
            "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")

                                (GO OUT)))
                            (/replace
 LOADTYPE of
 FILEPROP with
 NIL)))
                     (SETQ SOURCEFILE NIL)
                     (SETQ REPRINTFNS NIL)
             elseif
 SOURCEFILE
-              then
                                       (* ; "source file given")

+              then
                                       (* ; "source file given")

             elseif
 [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T))
                                                (EQUAL (FILEDATE SOURCEFILE)
                                                       (fetch
 FILEDATE of
 (CAR FILEDATES]
@@ -527,7 +523,7 @@ with the terms of said license.
                                    (fetch
 FILEDATE of
 (CADR FILEDATES]
               then
 
 
-                    (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")

+                    (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")

 
                     (SETQ CHANGES (FILEPKG.MERGECHANGES
 (fetch
 TOBEDUMPED of
 FILEPROP)
                                          (fetch
 FILECHANGES of
 ROOTNAME)))
@@ -545,8 +541,8 @@ with the terms of said license.
                   (GO LP0))
           (COND
              ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch
 LOADTYPE of
 FILEPROP)
-                                          (LOADCOMP          (* ; 
-
                                                   "only loaded via LOADCOMP.  Need to do LOADFROM")

+                                          (LOADCOMP          (* ; 
+
                                                   "only loaded via LOADCOMP.  Need to do LOADFROM")

                                                     (LIST 'N SOURCEFILE "was loaded with LOADCOMP"
                                                           '- "LOADFROM it to obtain VARS/COMS"))
                                           (Compiled (AND (INFILECOMS?
 'DONTCOPY 'DECLARE%:
@@ -569,23 +565,23 @@ with the terms of said license.
                                 (A "bort MAKEFILE
 "]
                   (Y (SELECTQ (fetch
 LOADTYPE of
 FILEPROP)
-                         (LOADCOMP                           (* ; 
-
                               "file was never actually loaded, just loadcomped.  thus no filecoms")

+                         (LOADCOMP                           (* ; 
+
                               "file was never actually loaded, just loadcomped.  thus no filecoms")

                                    (LOADFROM SOURCEFILE))
                          (Compiled 
 
-                                 (* ;; "This is going to be a remake.  If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")

+                                 (* ;; "This is going to be a remake.  If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")

 
                                    (LOADVARS 'DONTCOPY SOURCEFILE)
                                    (/replace
 LOADTYPE of
 FILEPROP with
 'COMPILED)
-                                                             (* ; "So wont have to be done again.")

+                                                             (* ; "So wont have to be done again.")

 
-                                 (* ;; "These are the only DECLARE:'s that are not also on the compiled file.  Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE:  Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")

+                                 (* ;; "These are the only DECLARE:'s that are not also on the compiled file.  Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE:  Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")

 
                                    )
                          ((loadfns compiled) 
 
-                                 (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")

+                                 (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")

 
                               (LOADVARS T SOURCEFILE))
                          NIL))
@@ -951,12 +947,12 @@ compiling " T)
 (RPAQ? NILCOMS
 )
 
 (ADDTOVAR MAKEFILEOPTIONS
 RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP%  F ST STF 
-                                 FORMAT (REC . RC)
-                                 (BREC . RC)
-                                 (TC . C)
-                                 (BC . C)
-                                 (TCOMPL . C)
-                                 (BCOMPL . C))
+                             FORMAT (REC . RC)
+                             (BREC . RC)
+                             (TC . C)
+                             (BC . C)
+                             (TCOMPL . C)
+                             (BCOMPL . C))
 
 (RPAQ? MAKEFILEREMAKEFLG
 T)
 
@@ -2700,7 +2696,7 @@ compiling " T)
 )
 
 (ADDTOVAR LISPXFNS
 (PUT . SAVEPUT)
-                       (PUTPROP . SAVEPUT))
+                   (PUTPROP . SAVEPUT))
 
 
 
@@ -3114,14 +3110,14 @@ compiling " T)
 
 
 (ADDTOVAR USERMACROS

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

           (M (X . Y)
@@ -3267,11 +3263,15 @@ compiling " T)
 (DEFINEQ
 
 (SHOWDEF

-  [LAMBDA (NAME TYPE FILE)
                              (* ; "Edited 16-Apr-2018 21:35 by rmk:")

-                                                             (* ; 
-
                                                 "prettyprint NAME as it would be dumped as a TYPE")

+  [LAMBDA (NAME TYPE FILE)
                              (* ; "Edited 26-Oct-2021 09:21 by rmk:")


+                                                            (* ; "Edited 16-Apr-2018 21:35 by rmk:")

+                                                             (* ; 
+
             "prettyprint NAME as it would be dumped as a TYPE (in the current reader environment)")

     (RESETLST
-        (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP)
+        (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP (SOURCEFILENV (MAKE-READER-ENVIRONMENT
+                                                                         
+                                                                       *DEFAULT-MAKEFILE-ENVIRONMENT*
+                                                                         )))
               (DECLARE
 (SPECVARS . T))
               [AND FILE (NEQ FILE (OUTPUT))
                    (if
 (SETQ FL (OPENP FILE 'OUTPUT))
@@ -3950,7 +3950,9 @@ compiling " T)
               (RETURN TYPE])
 
 (COMPAREDEFS

-  [LAMBDA (NAME TYPE SOURCES)
                            (* lmm " 4-Jul-85 14:37")

+  [LAMBDA (NAME TYPE SOURCES)
                               (* ; "Edited  8-Nov-2021 10:52 by rmk:")


+                                                            (* ; "Edited 30-Oct-2021 20:01 by rmk:")


+                                                             (* lmm " 4-Jul-85 14:37")

     (COND
        ((AND (LISTP TYPE)
              (GETFILEPKGTYPE
 SOURCES NIL T))
@@ -3964,41 +3966,45 @@ compiling " T)
                                               (MEMBER NAME (CDR (ASSOC TYPE
                                                                        (fetch
 TOBEDUMPED
                                                                           of
 (fetch
 FILEPROP
-                                                                                    of
 FILE]
+                                                                                of
 FILE]
                    (push
 SRCS 'CURRENT]
-          (SETQ SRCS (for
 SRC in
 SRCS
-                        when
 (COND
-                                    ((NEQ [SETQ DEF (GETDEF
 NAME TYPE SRC '(NOERROR NOCOPY]
-                                          (fetch
 NULLDEF of
 TYPE))
-                                     (OR [SOME DEFS (FUNCTION (LAMBDA (DP)
-                                                                (COMPARELST DEF (CDR DP]
-                                         (push
 DEFS (CONS SRC DEF)))
-                                     T)
-                                    (T (PRINTOUT T "No " SRC " definition found for " NAME T)
-                                       NIL)) collect
 SRC))
+          (SETQ SRCS (for
 SRC in
 SRCS when
 (COND
+                                              ((NEQ [SETQ DEF (GETDEF
 NAME TYPE SRC
+                                                                     '(NOERROR NOCOPY]
+                                                    (fetch
 NULLDEF of
 TYPE))
+                                               (OR [SOME DEFS (FUNCTION (LAMBDA (DP)
+                                                                          (COMPARELST DEF
+                                                                                 (CDR DP]
+                                                   (push
 DEFS (CONS SRC DEF)))
+                                               T)
+                                              (T (PRINTOUT T "No " SRC " definition found for " NAME
+                                                        T)
+                                                 NIL)) collect
 SRC))
           (RETURN (COND
                      ((NULL SRCS)
                       '(no definitions found))
                      ((NULL (CDR SRCS))
                       '(only one definition found))
                      ((CDR DEFS)
-                      [for
 S1 on
 (DREVERSE DEFS)
+                      [for
 S1 [FILECOL _ (IPLUS (NCHARS NAME)
+                                                (CONSTANT (NCHARS " from "] on
 (DREVERSE DEFS)
                          do
 (for
 S2 on
 (CDR S1) do
 (PRIN2 NAME T T)
-                                                                  (AND (CAAR S1)
-                                                                       (PRIN1 " from " T)
-                                                                       (PRIN2 (CAAR S1)
-                                                                              T T))
-                                                                  (PRIN1 " and " T)
-                                                                  (PRIN2 NAME T T)
-                                                                  (COND
-                                                                     ((CAAR S2)
-                                                                      (PRIN1 " from " T)
-                                                                      (PRIN2 (CAAR S2)
-                                                                             T T)))
-                                                                  (PRIN1 " differ:" T)
-                                                                  (TERPRI T)
-                                                                  (COMPARELISTS (CDAR S1)
-                                                                         (CDAR S2]
+                                                   (AND (CAAR S1)
+                                                        (PRIN1 " from " T)
+                                                        (PRIN2 (CAAR S1)
+                                                               T T))
+                                                   (TAB (IDIFFERENCE FILECOL (CONSTANT (NCHARS 
+                                                                                              " and "
+                                                                                              )))
+                                                        NIL T)
+                                                   (PRIN1 " and " T)
+                                                   (COND
+                                                      ((CAAR S2)
+                                                       (PRIN2 (CAAR S2)
+                                                              T T)))
+                                                   (TERPRI T)
+                                                   (COMPARELISTS (CDAR S1)
+                                                          (CDAR S2]
                       'DIFFERENT)
                      (T 'SAME])
 
@@ -4503,7 +4509,7 @@ compiling " T)
                                                                      (P (CONSTANTS . X])
 
 (ADDTOVAR SHADOW-TYPES
 (FUNCTIONS FNS)
-                           (VARIABLES VARS CONSTANTS))
+                       (VARIABLES VARS CONSTANTS))
 
 (RPAQ? SAVEDDEFS
 )
 
@@ -4789,7 +4795,7 @@ compiling " T)
 
 (MOVD? 'INFILEP 'FINDFILE)
 
-                                                             (* ; "or else from SPELLFILE")

+                                                             (* ; "or else from SPELLFILE")

 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
 
 (BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
@@ -4966,10 +4972,10 @@ compiling " T)
 )
 
 (ADDTOVAR GAINSPACEFORMS
 (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
-                                    ((Y "es")
-                                     (N "o")
-                                     (E . "verything")
-                                     (F "ilemaps only
+                                ((Y "es")
+                                 (N "o")
+                                 (E . "verything")
+                                 (F "ilemaps only
 "))))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -5026,8 +5032,7 @@ compiling " T)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS 
-                          MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS 
-                          PRETTYDEFMACROS)
+                      MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS PRETTYDEFMACROS)
 
 (ADDTOVAR NLAML
 )
 
@@ -5036,46 +5041,46 @@ compiling " T)
 (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 
 1990 1991 1992 1993 1995 2018 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (20621 22326 (SEARCHPRETTYTYPELST 20631 . 21610) (PRETTYDEFMACROS 21612 . 22070) (
-FILEPKGCOMPROPS 22072 . 22324)) (23128 57617 (CLEANUP 23138 . 24526) (COMPILEFILES 24528 . 24804) (
-COMPILEFILES0 24806 . 25526) (CONTINUEDIT 25528 . 26948) (MAKEFILE 26950 . 38958) (FILECHANGES 38960
- . 41295) (FILEPKG.MERGECHANGES 41297 . 42120) (FILEPKG.CHANGEDFNS 42122 . 42434) (MAKEFILE1 42436 . 
-46663) (COMPILE-FILE? 46665 . 48222) (MAKEFILES 48224 . 49917) (ADDFILE 49919 . 52440) (ADDFILE0 52442
- . 56578) (LISTFILES 56580 . 57615)) (58313 93553 (FILEPKGCHANGES 58323 . 59673) (GETFILEPKGTYPE 59675
- . 62748) (MARKASCHANGED 62750 . 64387) (FILECOMS 64389 . 64773) (WHEREIS 64775 . 66195) (
-SMASHFILECOMS 66197 . 66432) (FILEFNSLST 66434 . 66596) (FILECOMSLST 66598 . 67082) (UPDATEFILES 67084
- . 72384) (INFILECOMS? 72386 . 74289) (INFILECOMTAIL 74291 . 75431) (INFILECOMS 75433 . 75594) (
-INFILECOM 75596 . 85805) (INFILECOMSVALS 85807 . 86134) (INFILECOMSVAL 86136 . 87138) (INFILECOMSPROP 
-87140 . 87969) (IFCPROPS 87971 . 89232) (IFCEXPRTYPE 89234 . 89745) (IFCPROPSCAN 89747 . 90800) (
-IFCDECLARE 90802 . 92113) (INFILEPAIRS 92115 . 92447) (INFILECOMSMACRO 92449 . 93551)) (93588 125008 (
-FILES? 93598 . 95791) (FILES?1 95793 . 96491) (FILES?PRINTLST 96493 . 97275) (ADDTOFILES? 97277 . 
-108323) (ADDTOFILE 108325 . 109241) (WHATIS 109243 . 111219) (ADDTOCOMS 111221 . 112865) (ADDTOCOM 
-112867 . 119414) (ADDTOCOM1 119416 . 120587) (ADDNEWCOM 120589 . 121639) (MAKENEWCOM 121641 . 123484) 
-(DEFAULTMAKENEWCOM 123486 . 125006)) (125078 127895 (MERGEINSERT 125088 . 127431) (MERGEINSERT1 127433
- . 127893)) (128049 129406 (ADDTOFILEKEYLST 128059 . 129404)) (129523 140435 (DELFROMFILES 129533 . 
-130383) (DELFROMCOMS 130385 . 132064) (DELFROMCOM 132066 . 137934) (DELFROMCOM1 137936 . 138733) (
-REMOVEITEM 138735 . 139609) (MOVETOFILE 139611 . 140433)) (140649 143018 (SAVEPUT 140659 . 143016)) (
-143143 151467 (UNMARKASCHANGED 143153 . 144861) (PREEDITFN 144863 . 147374) (POSTEDITPROPS 147376 . 
-149877) (POSTEDITALISTS 149879 . 151465)) (151616 172170 (ALISTS.GETDEF 151626 . 152005) (
-ALISTS.WHENCHANGED 152007 . 152651) (CLEARCLISPARRAY 152653 . 153827) (EXPRESSIONS.WHENCHANGED 153829
- . 154203) (MAKEALISTCOMS 154205 . 155278) (MAKEFILESCOMS 155280 . 156717) (MAKELISPXMACROSCOMS 156719
- . 158737) (MAKEPROPSCOMS 158739 . 159437) (MAKEUSERMACROSCOMS 159439 . 161239) (PROPS.WHENCHANGED 
-161241 . 161862) (FILEGETDEF.LISPXMACROS 161864 . 163306) (FILEGETDEF.ALISTS 163308 . 163927) (
-FILEGETDEF.RECORDS 163929 . 164860) (FILEGETDEF.PROPS 164862 . 165654) (FILEGETDEF.MACROS 165656 . 
-166716) (FILEGETDEF.VARS 166718 . 167134) (FILEGETDEF.FNS 167136 . 168500) (FILEPKGCOMS.PUTDEF 168502
- . 170942) (FILES.PUTDEF 170944 . 171901) (VARS.PUTDEF 171903 . 172046) (FILES.WHENCHANGED 172048 . 
-172168)) (174192 181625 (RENAME 174202 . 175603) (CHANGECALLERS 175605 . 181623)) (181626 229574 (
-SHOWDEF 181636 . 182429) (COPYDEF 182431 . 184905) (GETDEF 184907 . 187183) (GETDEFCOM 187185 . 188151
-) (GETDEFCOM0 188153 . 189499) (GETDEFCURRENT 189501 . 195921) (GETDEFERR 195923 . 197224) (
-GETDEFFROMFILE 197226 . 201506) (GETDEFSAVED 201508 . 202612) (PUTDEF 202614 . 203317) (EDITDEF 203319
- . 204296) (DEFAULT.EDITDEF 204298 . 207134) (EDITDEF.FILES 207136 . 207337) (LOADDEF 207339 . 207515)
- (DWIMDEF 207517 . 208371) (DELDEF 208373 . 211387) (DELFROMLIST 211389 . 211893) (HASDEF 211895 . 
-218217) (GETFILEDEF 218219 . 218741) (SAVEDEF 218743 . 220402) (UNSAVEDEF 220404 . 221300) (
-COMPAREDEFS 221302 . 224604) (COMPARE 224606 . 225310) (TYPESOF 225312 . 229572)) (229641 234684 (
-FIXEDITDATE 229651 . 233154) (EDITDATE? 233156 . 234682)) (235103 243874 (FILEPKGCOM 235113 . 240046) 
-(FILEPKGTYPE 240048 . 243872)) (255911 270843 (FINDCALLERS 255921 . 256436) (EDITCALLERS 256438 . 
-264348) (EDITFROMFILE 264350 . 270158) (FINDATS 270160 . 270432) (LOOKIN 270434 . 270841)) (270844 
-272571 (SEPRCASE 270854 . 272569)) (273088 278645 (IMPORTFILE 273098 . 274072) (IMPORTEVAL 274074 . 
-274954) (IMPORTFILESCAN 274956 . 275377) (CHECKIMPORTS 275379 . 276715) (GATHEREXPORTS 276717 . 278055
-) (\DUMPEXPORTS 278057 . 278643)) (278983 281191 (CLEARFILEPKG 278993 . 281189)))))
+  (FILEMAP (NIL (19760 21465 (SEARCHPRETTYTYPELST 19770 . 20749) (PRETTYDEFMACROS 20751 . 21209) (
+FILEPKGCOMPROPS 21211 . 21463)) (22267 57085 (CLEANUP 22277 . 23665) (COMPILEFILES 23667 . 23943) (
+COMPILEFILES0 23945 . 24665) (CONTINUEDIT 24667 . 26087) (MAKEFILE 26089 . 38426) (FILECHANGES 38428
+ . 40763) (FILEPKG.MERGECHANGES 40765 . 41588) (FILEPKG.CHANGEDFNS 41590 . 41902) (MAKEFILE1 41904 . 
+46131) (COMPILE-FILE? 46133 . 47690) (MAKEFILES 47692 . 49385) (ADDFILE 49387 . 51908) (ADDFILE0 51910
+ . 56046) (LISTFILES 56048 . 57083)) (57757 92997 (FILEPKGCHANGES 57767 . 59117) (GETFILEPKGTYPE 59119
+ . 62192) (MARKASCHANGED 62194 . 63831) (FILECOMS 63833 . 64217) (WHEREIS 64219 . 65639) (
+SMASHFILECOMS 65641 . 65876) (FILEFNSLST 65878 . 66040) (FILECOMSLST 66042 . 66526) (UPDATEFILES 66528
+ . 71828) (INFILECOMS? 71830 . 73733) (INFILECOMTAIL 73735 . 74875) (INFILECOMS 74877 . 75038) (
+INFILECOM 75040 . 85249) (INFILECOMSVALS 85251 . 85578) (INFILECOMSVAL 85580 . 86582) (INFILECOMSPROP 
+86584 . 87413) (IFCPROPS 87415 . 88676) (IFCEXPRTYPE 88678 . 89189) (IFCPROPSCAN 89191 . 90244) (
+IFCDECLARE 90246 . 91557) (INFILEPAIRS 91559 . 91891) (INFILECOMSMACRO 91893 . 92995)) (93032 124452 (
+FILES? 93042 . 95235) (FILES?1 95237 . 95935) (FILES?PRINTLST 95937 . 96719) (ADDTOFILES? 96721 . 
+107767) (ADDTOFILE 107769 . 108685) (WHATIS 108687 . 110663) (ADDTOCOMS 110665 . 112309) (ADDTOCOM 
+112311 . 118858) (ADDTOCOM1 118860 . 120031) (ADDNEWCOM 120033 . 121083) (MAKENEWCOM 121085 . 122928) 
+(DEFAULTMAKENEWCOM 122930 . 124450)) (124522 127339 (MERGEINSERT 124532 . 126875) (MERGEINSERT1 126877
+ . 127337)) (127493 128850 (ADDTOFILEKEYLST 127503 . 128848)) (128967 139879 (DELFROMFILES 128977 . 
+129827) (DELFROMCOMS 129829 . 131508) (DELFROMCOM 131510 . 137378) (DELFROMCOM1 137380 . 138177) (
+REMOVEITEM 138179 . 139053) (MOVETOFILE 139055 . 139877)) (140093 142462 (SAVEPUT 140103 . 142460)) (
+142587 150911 (UNMARKASCHANGED 142597 . 144305) (PREEDITFN 144307 . 146818) (POSTEDITPROPS 146820 . 
+149321) (POSTEDITALISTS 149323 . 150909)) (151056 171610 (ALISTS.GETDEF 151066 . 151445) (
+ALISTS.WHENCHANGED 151447 . 152091) (CLEARCLISPARRAY 152093 . 153267) (EXPRESSIONS.WHENCHANGED 153269
+ . 153643) (MAKEALISTCOMS 153645 . 154718) (MAKEFILESCOMS 154720 . 156157) (MAKELISPXMACROSCOMS 156159
+ . 158177) (MAKEPROPSCOMS 158179 . 158877) (MAKEUSERMACROSCOMS 158879 . 160679) (PROPS.WHENCHANGED 
+160681 . 161302) (FILEGETDEF.LISPXMACROS 161304 . 162746) (FILEGETDEF.ALISTS 162748 . 163367) (
+FILEGETDEF.RECORDS 163369 . 164300) (FILEGETDEF.PROPS 164302 . 165094) (FILEGETDEF.MACROS 165096 . 
+166156) (FILEGETDEF.VARS 166158 . 166574) (FILEGETDEF.FNS 166576 . 167940) (FILEPKGCOMS.PUTDEF 167942
+ . 170382) (FILES.PUTDEF 170384 . 171341) (VARS.PUTDEF 171343 . 171486) (FILES.WHENCHANGED 171488 . 
+171608)) (173632 181065 (RENAME 173642 . 175043) (CHANGECALLERS 175045 . 181063)) (181066 229922 (
+SHOWDEF 181076 . 182269) (COPYDEF 182271 . 184745) (GETDEF 184747 . 187023) (GETDEFCOM 187025 . 187991
+) (GETDEFCOM0 187993 . 189339) (GETDEFCURRENT 189341 . 195761) (GETDEFERR 195763 . 197064) (
+GETDEFFROMFILE 197066 . 201346) (GETDEFSAVED 201348 . 202452) (PUTDEF 202454 . 203157) (EDITDEF 203159
+ . 204136) (DEFAULT.EDITDEF 204138 . 206974) (EDITDEF.FILES 206976 . 207177) (LOADDEF 207179 . 207355)
+ (DWIMDEF 207357 . 208211) (DELDEF 208213 . 211227) (DELFROMLIST 211229 . 211733) (HASDEF 211735 . 
+218057) (GETFILEDEF 218059 . 218581) (SAVEDEF 218583 . 220242) (UNSAVEDEF 220244 . 221140) (
+COMPAREDEFS 221142 . 224952) (COMPARE 224954 . 225658) (TYPESOF 225660 . 229920)) (229989 235032 (
+FIXEDITDATE 229999 . 233502) (EDITDATE? 233504 . 235030)) (235451 244222 (FILEPKGCOM 235461 . 240394) 
+(FILEPKGTYPE 240396 . 244220)) (256255 271187 (FINDCALLERS 256265 . 256780) (EDITCALLERS 256782 . 
+264692) (EDITFROMFILE 264694 . 270502) (FINDATS 270504 . 270776) (LOOKIN 270778 . 271185)) (271188 
+272915 (SEPRCASE 271198 . 272913)) (273432 278989 (IMPORTFILE 273442 . 274416) (IMPORTEVAL 274418 . 
+275298) (IMPORTFILESCAN 275300 . 275721) (CHECKIMPORTS 275723 . 277059) (GATHEREXPORTS 277061 . 278399
+) (\DUMPEXPORTS 278401 . 278987)) (279327 281535 (CLEARFILEPKG 279337 . 281533)))))
 STOP

sources/FILESETS

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "11-Sep-2021 00:01:52" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;10
 6469   
 
-      changes to%:  (VARS MAKEINITTYPES 0LISPSET EXPORTFILES)
+
(FILECREATED "17-Oct-2021 16:06:59" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;17
 6482   
 
-      previous date%: "10-Sep-2021 19:53:14" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;8)
+      changes to%:  (VARS EXPORTFILES)
+
+      previous date%: "17-Oct-2021 13:52:47" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;16)
 
 
 (* ; "
@@ -71,7 +72,8 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
        (MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR
               LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY 
               ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER 
-              IMAGEIO PROC XCCS LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS))
+              IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS 
+              DTDECLARE))
 
 (RPAQQ MAKEINITFILES
 (MAKEINIT MEM I-NEW))
 

sources/HARDCOPY

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-Sep-2021 10:59:58" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;2
 103730 
 
-      changes to%:  (VARS HARDCOPYCOMS)
+
(FILECREATED " 8-Oct-2021 22:23:49" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;13
 103499 
 
-      previous date%: " 5-May-2021 19:41:55" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;1)
+      changes to%:  (FNS COPY.TEXT.TO.IMAGE)
+
+      previous date%: " 7-Oct-2021 10:43:32" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;12)
 
 
 (* ; "
@@ -722,105 +723,100 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
                             (CLOSEF IMAGESTREAM])])
 
 (COPY.TEXT.TO.IMAGE

-  [LAMBDA (INFILE IMAGESTREAM FONTS TABS)
               (* ; "Edited  5-May-2021 19:41 by rmk:")


-                                                             (* ; "Edited 10-Apr-95 21:23 by rmk:")

+  [LAMBDA (INFILE IMAGESTREAM FONTS TABS)
               (* ; "Edited  8-Oct-2021 22:23 by rmk:")


+                                                             (* ; "Edited 10-Apr-95 21:23 by rmk:")

 
-    (* ;; "Copy text to an image stream, obeying PSPOOL control characters")

+    (* ;; "Copy text to an image stream, obeying PSPOOL control characters")

 
     (LET*
-     ((IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
+     [(IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
       (RIGHTMAR (DSPRIGHTMARGIN NIL IMAGESTREAM))
       (FONTARRAY (FONTMAPARRAY FONTS))
       (MAXFONT (ARRAYSIZE FONTARRAY))
       (INSTRM (GETSTREAM INFILE 'INPUT))
-      DEFAULTTAB C FC)
-     (replace
 (STREAM ENDOFSTREAMOP) of
 INSTRM with
 (FUNCTION ZERO))
-     (do

-      (COND
-         ((AND [EQ 0 (LOGAND 255 (SETQ C (\INCCODE INSTRM]
-               (EOFP INSTRM))
-          (RETURN))
-         ((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
-                           RIGHTMAR))                        (* ; 
-
                                                      "Not to walk off the right edge of the paper")

-          (TERPRI IMAGESTREAM)))
-      (COND
-         ([> C (CONSTANT (APPLY (FUNCTION MAX)
-                                (CHARCODE (^F CR LF ^L TAB NULL]
-          (\OUTCHAR IMAGESTREAM C))
-         (T
-          (SELCHARQ C
-               (^F                                           (* ; "Font shift")

+      DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
 
-                   (* ;; 
-
                 "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")

+     (* ;; 
+
"RMK:  EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")

 
-                   (DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
-                                        1)
-                          IMAGESTREAM)
-                   [SELCHARQ (SETQ FC (\INCCODE INSTRM))
-                        (^T                                  (* ; "tab to absolute pos.")

-                            (COND
-                               ((EQ 0 (SETQ FC (\INCCODE INSTRM)))
-                                (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
-                                (\OUTCHAR IMAGESTREAM (CHARCODE ^T))
-                                (AND (\EOFP INSTRM)
-                                     (RETURN))
-                                (\OUTCHAR IMAGESTREAM FC))
-                               (T 
+     (SETFILEINFO INSTRM 'ENDOFSTREAMOP (FUNCTION NILL))
+     [while
 (SETQ C (\INCCODE INSTRM))
+        do

+        (COND
+           ((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
+                             RIGHTMAR))                      (* ; 
+
                                                      "Not to walk off the right edge of the paper")

+            (TERPRI IMAGESTREAM)))
+        (COND
+           ([> C (CONSTANT (APPLY (FUNCTION MAX)
+                                  (CHARCODE (^F CR LF ^L TAB]
+            (\OUTCHAR IMAGESTREAM C))
+           (T
+            (SELCHARQ C
+                 (^F                                         (* ; "Font shift")

 
-                                 (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream.  Should really be a property of the stream or imagetype, or defined in terms of standard scale")

+                     (* ;; 
+
                   "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")

 
-                                  [SETQ FC
-                                   (IF
 TABS
-                                       THEN
 (OR (CAR (NTH TABS FC))
-                                                    (ERROR "Undefined absolute tab number" FC))
-                                     ELSE
 (TIMES FC
-                                                     (OR DEFAULTTAB
-                                                         (SETQ DEFAULTTAB
-                                                          (TIMES 8 (CHARWIDTH (CHARCODE SPACE)
-                                                                          (FONTCREATE (ELT FONTARRAY
-                                                                                           1)
-                                                                                 NIL NIL NIL 
-                                                                                 IMAGESTREAM]
-                                  (DSPXPOSITION FC IMAGESTREAM))))
-                        (NULL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
-                              (AND (\EOFP INSTRM)
-                                   (RETURN))
-                              (\OUTCHAR IMAGESTREAM FC)      (* ; "EOS after ^F")

-                              )
-                        (COND
-                           ((AND (>= MAXFONT FC)
-                                 (NEQ FC 0))
-                            (DSPFONT (ELT FONTARRAY FC)
-                                   IMAGESTREAM))
-                           (T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
-                              (\OUTCHAR IMAGESTREAM C])
-               (CR 
-                   (* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text.  Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file as a carriage-return.  But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously.  Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, which is to treat all instances of CR, CRLF, and LF as end-of-line.")

+                     (DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
+                                          1)
+                            IMAGESTREAM)
+                     [SELCHARQ (SETQ FC (\INCCODE INSTRM))
+                          (^T                                (* ; "tab to absolute pos.")

+                              (CL:UNLESS (SETQ FC (\INCCODE INSTRM))
+                                  (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
+                                  (\OUTCHAR IMAGESTREAM (CHARCODE ^T))
+                                  (RETURN))
 
-                   (TERPRI IMAGESTREAM)
-                   (COND
-                      ((EQ (CHARCODE LF)
-                           (\PEEKBIN INSTRM T))
-                       (BIN INSTRM))))
-               (TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
-                               (TAB.WIDTH (TIMES (CHARWIDTH (CHARCODE SPACE)
-                                                        IMAGESTREAM)
-                                                 8))
-                               (CURRENT.X (- (DSPXPOSITION NIL IMAGESTREAM)
-                                             LEFTMARGIN))
-                               (CURRENT.STOP (- CURRENT.X (REMAINDER CURRENT.X TAB.WIDTH]
-                              (NLSETQ (RELMOVETO (- (+ CURRENT.STOP TAB.WIDTH)
-                                                    CURRENT.X)
-                                             0 IMAGESTREAM)))
-                        (\OUTCHAR IMAGESTREAM C)))
-               (LF                                           (* ; "See comment at CR")

-                   (TERPRI IMAGESTREAM))
-               (NULL (AND (EOFP INSTRM)
-                          (RETURN))
-                     (\OUTCHAR IMAGESTREAM C))
-               (\OUTCHAR IMAGESTREAM C])
+                              (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream.  Should really be a property of the stream or imagetype, or defined in terms of standard scale")

+
+                              [SETQ FC
+                               (IF
 TABS
+                                   THEN
 (OR (CAR (NTH TABS FC))
+                                                (ERROR "Undefined absolute tab number" FC))
+                                 ELSE
 (TIMES FC (OR DEFAULTTAB
+                                                        (SETQ DEFAULTTAB
+                                                         (TIMES 8 (CHARWIDTH (CHARCODE SPACE)
+                                                                         (FONTCREATE (ELT FONTARRAY 1
+                                                                                          )
+                                                                                NIL NIL NIL 
+                                                                                IMAGESTREAM]
+                              (DSPXPOSITION FC IMAGESTREAM))
+                          (NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
+                                                             (* ; "EOS after ^F")

+                               (RETURN))
+                          (COND
+                             ((AND (>= MAXFONT FC)
+                                   (NEQ FC 0))
+                              (DSPFONT (ELT FONTARRAY FC)
+                                     IMAGESTREAM))
+                             (T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
+                                (\OUTCHAR IMAGESTREAM FC])
+                 (CR 
+                     (* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text.  Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file 
+as a carriage-return.  But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously.  Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, wh
+ich is to treat all instances of CR, CRLF, and LF as end-of-line.")

+
+                     (COND
+                        ((EQ (CHARCODE LF)
+                             (\PEEKCCODE.NOEOLC INSTRM T))
+                         (\INCCODE INSTRM)))
+                     (TERPRI IMAGESTREAM))
+                 (LF                                         (* ; "Isolatedx LF, see comment at CR")

+                     (TERPRI IMAGESTREAM))
+                 (TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
+                                 (TAB.WIDTH (TIMES (CHARWIDTH (CHARCODE SPACE)
+                                                          IMAGESTREAM)
+                                                   8))
+                                 (CURRENT.X (- (DSPXPOSITION NIL IMAGESTREAM)
+                                               LEFTMARGIN))
+                                 (CURRENT.STOP (- CURRENT.X (REMAINDER CURRENT.X TAB.WIDTH]
+                                (NLSETQ (RELMOVETO (- (+ CURRENT.STOP TAB.WIDTH)
+                                                      CURRENT.X)
+                                               0 IMAGESTREAM)))
+                          (\OUTCHAR IMAGESTREAM C)))
+                 (\OUTCHAR IMAGESTREAM C]
+     (SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP])
 )
 (DEFINEQ
 
@@ -1088,39 +1084,39 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
  1993 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6176 10360 (HARDCOPY.SOMEHOW 6186 . 7544) (HARDCOPYIMAGEW 7546 . 7698) (
-HARDCOPYIMAGEW.TOFILE 7700 . 8008) (HARDCOPYIMAGEW.TOPRINTER 8010 . 8675) (HARDCOPYREGION.TOFILE 8677
- . 8975) (HARDCOPYREGION.TOPRINTER 8977 . 9599) (COPY.WINDOW.TO.BITMAP 9601 . 10358)) (10432 20982 (
-MakeMenuOfPrinters 10442 . 11667) (PRINTERS.WHENSELECTEDFN 11669 . 13411) (MakeMenuOfImageTypes 13413
- . 13931) (GetNewPrinterFromUser 13933 . 14361) (PopUpWindowAndGetAtom 14363 . 15748) (
-PopUpWindowAndGetList 15750 . 17316) (NewPrinter 17318 . 18266) (GetPrinterName 18268 . 18548) (
-GetImageFile 18550 . 20837) (FetchDefaultPrinter 20839 . 20980)) (21017 21555 (
-ExtensionForPrintFileType 21027 . 21220) (PRINTFILETYPE.FROM.EXTENSION 21222 . 21553)) (21610 37994 (
-DEFAULTPRINTER 21620 . 21780) (CAN.PRINT.DIRECTLY 21782 . 21938) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
-21940 . 22984) (EMPRESS 22986 . 23299) (HARDCOPYW 23301 . 26261) (LISTFILES1 26263 . 26436) (
-PRINTER.BITMAPFILE 26438 . 26685) (PRINTER.BITMAPSCALE 26687 . 26952) (PRINTER.SCRATCH.FILE 26954 . 
-27077) (PRINTERPROP 27079 . 27262) (PRINTERSTATUS 27264 . 27453) (PRINTERTYPE 27455 . 29764) (
-PRINTERNAME 29766 . 30068) (PRINTFILEPROP 30070 . 30261) (PRINTFILETYPE 30263 . 32207) (
-\EXPECTED.FILE.TYPE 32209 . 32991) (SEND.FILE.TO.PRINTER 32993 . 37992)) (37995 42977 (PRINTERDEVICE 
-38005 . 42975)) (43792 51993 (TEXTTOIMAGEFILE 43802 . 45992) (COPY.TEXT.TO.IMAGE 45994 . 51991)) (
-51994 53129 (\BLTSHADE.GENERICPRINTER 52004 . 53127)) (53257 72009 (MAKEHARDCOPYSTREAM 53267 . 54271) 
-(UNMAKEHARDCOPYSTREAM 54273 . 54957) (HARDCOPYSTREAMTYPE 54959 . 55238) (\CHARWIDTH.HDCPYDISPLAY 55240
- . 55671) (\DSPFONT.HDCPYDISPLAY 55673 . 57078) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57080 . 57657) (
-\DSPXPOSITION.HDCPYDISPLAY 57659 . 57920) (\DSPYPOSITION.HDCPYDISPLAY 57922 . 58183) (
-\STRINGWIDTH.HDCPYDISPLAY 58185 . 58692) (\STRINGWIDTH.HCPYDISPLAYAUX 58694 . 61026) (\HDCPYBLTCHAR 
-61028 . 63563) (\HDCPYDISPLAY.FIX.XPOS 63565 . 63985) (\HDCPYDISPLAY.FIX.YPOS 63987 . 64407) (
-\HDCPYDISPLAYINIT 64409 . 65186) (\HDCPYDSPPRINTCHAR 65188 . 67348) (\SLOWHDCPYBLTCHAR 67350 . 70853) 
-(\CHANGECHARSET.HDCPYDISPLAY 70855 . 72007)) (72731 103028 (MAKEHARDCOPYMODESTREAM 72741 . 74650) (
-UNMAKEHARDCOPYMODESTREAM 74652 . 75730) (\BLTSHADE.HCPYMODE 75732 . 76179) (\BITBLT.HCPYMODE 76181 . 
-76803) (\BRUSHCONVERT.HCPYMODE 76805 . 77042) (\CHANGECHARSET.HCPYMODE 77044 . 78811) (
-\DASHINGCONVERT.HCPYMODE 78813 . 79076) (\CHARWIDTH.HCPYMODE 79078 . 79365) (\DRAWLINE.HCPYMODE 79367
- . 79679) (\DRAWCURVE.HCPYMODE 79681 . 80110) (\DRAWCIRCLE.HCPYMODE 80112 . 80507) (
-\DRAWELLIPSE.HCPYMODE 80509 . 81021) (\DSPFONT.HCPYMODE 81023 . 82179) (\DSPLEFTMARGIN.HCPYMODE 82181
- . 82765) (\DSPLINEFEED.HCPYMODE 82767 . 83177) (\DSPRIGHTMARGIN.HCPYMODE 83179 . 83808) (
-\DSPSPACEFACTOR.HCPYMODE 83810 . 84331) (\DSPXPOSITION.HCPYMODE 84333 . 84914) (\DSPYPOSITION.HCPYMODE
- 84916 . 85321) (\MOVETO.HCPYMODE 85323 . 85475) (\FONTCREATE.HCPYMODE.PRESS 85477 . 86489) (
-\CREATECHARSET.HCPYMODE.PRESS 86491 . 87462) (\FONTCREATE.HCPYMODE.INTERPRESS 87464 . 88498) (
-\CREATECHARSET.HCPYMODE.INTERPRESS 88500 . 89488) (\STRINGWIDTH.HCPYMODE 89490 . 89924) (
-\HCPYMODEBLTCHAR 89926 . 92895) (\HCPYMODEDISPLAYINIT 92897 . 95828) (\HCPYMODEDSPPRINTCHAR 95830 . 
-98011) (\SLOWHCPYMODEBLTCHAR 98013 . 101527) (\SFFixY.HCPYMODE 101529 . 103026)))))
+  (FILEMAP (NIL (6184 10368 (HARDCOPY.SOMEHOW 6194 . 7552) (HARDCOPYIMAGEW 7554 . 7706) (
+HARDCOPYIMAGEW.TOFILE 7708 . 8016) (HARDCOPYIMAGEW.TOPRINTER 8018 . 8683) (HARDCOPYREGION.TOFILE 8685
+ . 8983) (HARDCOPYREGION.TOPRINTER 8985 . 9607) (COPY.WINDOW.TO.BITMAP 9609 . 10366)) (10440 20990 (
+MakeMenuOfPrinters 10450 . 11675) (PRINTERS.WHENSELECTEDFN 11677 . 13419) (MakeMenuOfImageTypes 13421
+ . 13939) (GetNewPrinterFromUser 13941 . 14369) (PopUpWindowAndGetAtom 14371 . 15756) (
+PopUpWindowAndGetList 15758 . 17324) (NewPrinter 17326 . 18274) (GetPrinterName 18276 . 18556) (
+GetImageFile 18558 . 20845) (FetchDefaultPrinter 20847 . 20988)) (21025 21563 (
+ExtensionForPrintFileType 21035 . 21228) (PRINTFILETYPE.FROM.EXTENSION 21230 . 21561)) (21618 38002 (
+DEFAULTPRINTER 21628 . 21788) (CAN.PRINT.DIRECTLY 21790 . 21946) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
+21948 . 22992) (EMPRESS 22994 . 23307) (HARDCOPYW 23309 . 26269) (LISTFILES1 26271 . 26444) (
+PRINTER.BITMAPFILE 26446 . 26693) (PRINTER.BITMAPSCALE 26695 . 26960) (PRINTER.SCRATCH.FILE 26962 . 
+27085) (PRINTERPROP 27087 . 27270) (PRINTERSTATUS 27272 . 27461) (PRINTERTYPE 27463 . 29772) (
+PRINTERNAME 29774 . 30076) (PRINTFILEPROP 30078 . 30269) (PRINTFILETYPE 30271 . 32215) (
+\EXPECTED.FILE.TYPE 32217 . 32999) (SEND.FILE.TO.PRINTER 33001 . 38000)) (38003 42985 (PRINTERDEVICE 
+38013 . 42983)) (43800 51762 (TEXTTOIMAGEFILE 43810 . 46000) (COPY.TEXT.TO.IMAGE 46002 . 51760)) (
+51763 52898 (\BLTSHADE.GENERICPRINTER 51773 . 52896)) (53026 71778 (MAKEHARDCOPYSTREAM 53036 . 54040) 
+(UNMAKEHARDCOPYSTREAM 54042 . 54726) (HARDCOPYSTREAMTYPE 54728 . 55007) (\CHARWIDTH.HDCPYDISPLAY 55009
+ . 55440) (\DSPFONT.HDCPYDISPLAY 55442 . 56847) (\DSPRIGHTMARGIN.HDCPYDISPLAY 56849 . 57426) (
+\DSPXPOSITION.HDCPYDISPLAY 57428 . 57689) (\DSPYPOSITION.HDCPYDISPLAY 57691 . 57952) (
+\STRINGWIDTH.HDCPYDISPLAY 57954 . 58461) (\STRINGWIDTH.HCPYDISPLAYAUX 58463 . 60795) (\HDCPYBLTCHAR 
+60797 . 63332) (\HDCPYDISPLAY.FIX.XPOS 63334 . 63754) (\HDCPYDISPLAY.FIX.YPOS 63756 . 64176) (
+\HDCPYDISPLAYINIT 64178 . 64955) (\HDCPYDSPPRINTCHAR 64957 . 67117) (\SLOWHDCPYBLTCHAR 67119 . 70622) 
+(\CHANGECHARSET.HDCPYDISPLAY 70624 . 71776)) (72500 102797 (MAKEHARDCOPYMODESTREAM 72510 . 74419) (
+UNMAKEHARDCOPYMODESTREAM 74421 . 75499) (\BLTSHADE.HCPYMODE 75501 . 75948) (\BITBLT.HCPYMODE 75950 . 
+76572) (\BRUSHCONVERT.HCPYMODE 76574 . 76811) (\CHANGECHARSET.HCPYMODE 76813 . 78580) (
+\DASHINGCONVERT.HCPYMODE 78582 . 78845) (\CHARWIDTH.HCPYMODE 78847 . 79134) (\DRAWLINE.HCPYMODE 79136
+ . 79448) (\DRAWCURVE.HCPYMODE 79450 . 79879) (\DRAWCIRCLE.HCPYMODE 79881 . 80276) (
+\DRAWELLIPSE.HCPYMODE 80278 . 80790) (\DSPFONT.HCPYMODE 80792 . 81948) (\DSPLEFTMARGIN.HCPYMODE 81950
+ . 82534) (\DSPLINEFEED.HCPYMODE 82536 . 82946) (\DSPRIGHTMARGIN.HCPYMODE 82948 . 83577) (
+\DSPSPACEFACTOR.HCPYMODE 83579 . 84100) (\DSPXPOSITION.HCPYMODE 84102 . 84683) (\DSPYPOSITION.HCPYMODE
+ 84685 . 85090) (\MOVETO.HCPYMODE 85092 . 85244) (\FONTCREATE.HCPYMODE.PRESS 85246 . 86258) (
+\CREATECHARSET.HCPYMODE.PRESS 86260 . 87231) (\FONTCREATE.HCPYMODE.INTERPRESS 87233 . 88267) (
+\CREATECHARSET.HCPYMODE.INTERPRESS 88269 . 89257) (\STRINGWIDTH.HCPYMODE 89259 . 89693) (
+\HCPYMODEBLTCHAR 89695 . 92664) (\HCPYMODEDISPLAYINIT 92666 . 95597) (\HCPYMODEDSPPRINTCHAR 95599 . 
+97780) (\SLOWHCPYMODEBLTCHAR 97782 . 101296) (\SFFixY.HCPYMODE 101298 . 102795)))))
 STOP

sources/HPRINT

@@ -1,13 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "26-Apr-2021 14:45:00" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HPRINT.;2
 57689  
 
-      previous date%: " 9-Oct-94 13:07:03" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HPRINT.;1)
+
(FILECREATED "17-Oct-2021 13:54:11" {DSK}<home>larry>medley>sources>HPRINT.;2
 59850  
+
+      changes to%:  (VARS HPRINTCOMS)
+                    (FNS MAKEHVPRETTYCOMS READVARS HPRINT0 READVAR-FROM-STRING READVARS-FROM-STRING 
+                         HPRINT-TO-STRING HPRINT-TO-STRINGS HPRINT HPRINT1 HPRINTEND RPTPRINT RPTEND
+                         RPTPUT HPRINTSP HPERR HVFWDCDREAD HVBAKREAD HVREADCHECKGETFN HVREADEND 
+                         HVRPTREAD HVFWDREAD HREAD HPINITRDTBL HVREADERR HPRINSP COPYALL 
+                         \COPYDATATYPE HCOPYALL HCOPYALL1 EQUALALL EQUALHASH)
+                    (FILEPKGCOMS HORRIBLEVARS UGLYVARS)
+
+      previous date%: "28-Sep-2021 10:44:11" {DSK}<home>larry>medley>sources>HPRINT.;1)
 
 
 (* ; "
-Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation.
+Copyright (c) 1982-1988, 1990-1991, 1993-1994 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT HPRINTCOMS)
@@ -66,16 +73,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 (DEFINEQ
 
 (MAKEHVPRETTYCOMS

-  [NLAMBDA (VARS NO-CIRCLE-FLAG)
                         (* ; "Edited  9-Sep-87 16:52 by amd")

-                                                             (* "The old code" (HPINITRDTBL)
-
                                                           (for X in VARS do (OR
-
                                                           (LITATOM X) (ERROR X 
-
                                                           "invalid in HORRIBLEVARS" T)))
-
                                                           (LIST (LIST (QUOTE P)
-
                                                           (CONS (FUNCTION READVARS) VARS))
-
                                                           (LIST (QUOTE E) (CONS
-
                                                           (QUOTE HPRINT0) (if NO-CIRCLE-FLAG 
-
                                                           then (CONS 0 VARS) else VARS)))))

+  [NLAMBDA (VARS NO-CIRCLE-FLAG)                             (* ; "Edited  9-Sep-87 16:52 by amd")

+                                                             (* "The old code" (HPINITRDTBL)
+
                                                           (for X in VARS do (OR
+
                                                           (LITATOM X) (ERROR X 
+
                                                           "invalid in HORRIBLEVARS" T)))
+
                                                           (LIST (LIST (QUOTE P)
+
                                                           (CONS (FUNCTION READVARS) VARS))
+
                                                           (LIST (QUOTE E) (CONS
+
                                                           (QUOTE HPRINT0) (if NO-CIRCLE-FLAG 
+
                                                           then (CONS 0 VARS) else VARS)))))

     (HPINITRDTBL
)
     (for
 X in
 VARS do
 (if
 (NOT (LITATOM X))
                                       then
 (ERROR X "not a symbol in HORRIBLEVARS" T)))
@@ -83,7 +90,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                                     NO-CIRCLE-FLAG])
 
 (READVARS

-  [NLAMBDA VARS
                                          (* lmm%: " 4-JAN-77 23:32:43")

+  [NLAMBDA VARS                                              (* lmm%: " 4-JAN-77 23:32:43")

     (HPINITRDTBL
)
     (PROG (BACKREFS (BACKREFCNT 0)
                  DATATYPESEEN)
@@ -97,7 +104,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
               (HVREADERR
])
 
 (HPRINT0

-  [NLAMBDA VARS                                              (* lmm%: 30-JAN-76 7 36)

+  [NLAMBDA VARS                                              (* lmm%: 30-JAN-76 7 36)

     (HPRINT
 (for
 X in
 (COND
                                      ((EQ (CAR VARS)
                                           0)
@@ -131,10 +138,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 (DEFINEQ
 
 (READVAR-FROM-STRING

-  [LAMBDA (SYMBOL HPRINT-STRING)
                         (* ; "Edited 10-Feb-87 16:39 by Pavel")

+  [LAMBDA (SYMBOL HPRINT-STRING)                             (* ; "Edited 10-Feb-87 16:39 by Pavel")

     (CL:WITH-INPUT-FROM-STRING (STREAM HPRINT-STRING)
 
-           (* ;; "")

+           (* ;; "")

 
            (HPINITRDTBL
)
            (PROG (BACKREFS (BACKREFCNT 0)
@@ -143,17 +150,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                         T])
 
 (READVARS-FROM-STRING

-  [LAMBDA (SYMBOLS HPRINT-STRING)
                        (* ; "Edited  9-Sep-87 18:22 by amd")

+  [LAMBDA (SYMBOLS HPRINT-STRING)                            (* ; "Edited  9-Sep-87 18:22 by amd")

     (CL:WITH-INPUT-FROM-STRING (STREAM HPRINT-STRING)
            (READVARS-FROM-STREAM
 SYMBOLS STREAM])
 
 (HPRINT-TO-STRING

-  [LAMBDA (VALUE NO-CIRCLE-FLAG)
                         (* ; "Edited  9-Sep-87 16:21 by amd")

+  [LAMBDA (VALUE NO-CIRCLE-FLAG)                             (* ; "Edited  9-Sep-87 16:21 by amd")

     (CL:WITH-OUTPUT-TO-STRING (S)
            (HPRINT
 VALUE S NO-CIRCLE-FLAG])
 
 (HPRINT-TO-STRINGS

-  [LAMBDA (VALUE NO-CIRCLE-FLAG)
                         (* ; "Edited  5-Feb-88 14:42 by amd")

+  [LAMBDA (VALUE NO-CIRCLE-FLAG)                             (* ; "Edited  5-Feb-88 14:42 by amd")

     (XCL:WITH-COLLECTION
      (XCL:COLLECT (CL:WITH-OUTPUT-TO-STRING
                    (S)
@@ -181,14 +188,32 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 (DEFINEQ
 
 (HPRINT

-  [LAMBDA (EXPR FILE UNCIRCULAR DATATYPESEEN)
            (* ; "Edited 10-Feb-87 15:52 by Pavel")

+  [LAMBDA (EXPR FILE UNCIRCULAR DATATYPESEEN)
+    (DECLARE
 (SPECVARS DATATYPESEEN UNCIRCULAR))         (* ; 
+
                                                           "Edited 17-Oct-2021 13:06 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 13:02 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 12:52 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 12:46 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 12:42 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 12:42 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 12:41 by larry")

+                                                             (* ; 
+
                                                           "Edited 17-Oct-2021 12:39 by larry")

+                                                             (* ; "Edited 10-Feb-87 15:52 by Pavel")

     (RESETLST
         (PROG (BACKREFS (CELLCOUNT 0)
                      SIZE
                      (U UNCIRCULAR))
+              (DECLARE
 (SPECVARS BACKREFS CELLCOUNT U))
               (RESETSAVE (RADIX 10))
               [COND
-                 (UNCIRCULAR                                 (* ; "Won't need the hash array")
)
+                 (UNCIRCULAR                                 (* ; "Won't need the hash array")
)
                  ([OR (HARRAYP HPRINTHASHARRAY)
                       (HARRAYP (CAR (LISTP HPRINTHASHARRAY]
                   (CLRHASH HPRINTHASHARRAY))
@@ -201,28 +226,29 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                  ((RANDACCESSP (OUTPUT))
                   (HPRINT1
 EXPR)
                   (HPRINTEND
))
-                 (T                                          (* ; 
-
                "If the byte pointer cannot be reset, want to output to temp file and copy it back")

-                    (LET* ((STREAM (OPENSTREAM "{NoDirCore}" 'OUTPUT))
-                           (*STANDARD-OUTPUT* STREAM))
-                          (CL:UNWIND-PROTECT
-                              (PROGN (HPRINT1
 EXPR)
-                                     (HPRINTEND
)
-                                     (CL:CLOSE STREAM)
-                                     (OPENSTREAM STREAM 'INPUT)
-                                     (COPYBYTES STREAM FILE))
-                              (CL:CLOSE STREAM))]
+                 (T                                          (* ; 
+
                "If the byte pointer cannot be reset, want to output to temp file and copy it back")

+                    (LET [(NDC (OPENSTREAM "{NODIRCORE}" 'BOTH 'NEW
+                                      `((FORMAT ,(STREAMPROP *STANDARD-OUTPUT* 'FORMAT]
+                         (CL:UNWIND-PROTECT
+                             [LET ((OS *STANDARD-OUTPUT*)
+                                   (*STANDARD-OUTPUT* NDC))
+                                  (HPRINT1
 EXPR)
+                                  (HPRINTEND
)
+                                  (COPYCHARS NDC OS 0 (PROG1 (GETFILEPTR NDC)
+                                                             (SETFILEPTR NDC 0]
+                             (CL:CLOSE NDC))]
               (TERPRI)))])
 
 (HPRINT1

-  [LAMBDA (X CDRFLG NOMACROSFLG NOSPFLG)
                 (* ; "Edited 26-Apr-91 13:39 by jds")

+  [LAMBDA (X CDRFLG NOMACROSFLG NOSPFLG)                     (* ; "Edited 26-Apr-91 13:39 by jds")

 
-    (* ;; "Print the potentially self-referential structure EXPR;  if CDRFLG then this is the CDR part of a list")

+    (* ;; "Print the potentially self-referential structure EXPR;  if CDRFLG then this is the CDR part of a list")

 
     (PROG (LASTSEEN HERE TYPE SIZE)
           (SELECTQ (SETQ TYPE (TYPENAME X))
-              ((SMALLP LITATOM NEW-ATOM)                     (* ; 
-
                                                    "Atom, small number, are just directly printed")

+              ((SMALLP LITATOM NEW-ATOM)                     (* ; 
+
                                                    "Atom, small number, are just directly printed")

                    [RETURN (COND
                               [CDRFLG (COND
                                          (X (PRIN1 " . ")
@@ -234,7 +260,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
               [(SETQ LASTSEEN (AND (NOT U)
                                    (GETHASH X HPRINTHASHARRAY)))
 
-               (* ;; "Seen before --- Hash value is either byte position of first place seen (negative if CDR pointer) or (bytepos-of-expression  . byte-positions-of-backrefs)")

+               (* ;; "Seen before --- Hash value is either byte position of first place seen (negative if CDR pointer) or (bytepos-of-expression  . byte-positions-of-backrefs)")

 
                (AND CDRFLG (PRIN1 " . "))
                (PRIN1 (CONSTANT HPFILLSTRING))
@@ -242,17 +268,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                [PROG ((CN CELLCOUNT))
                      (while
 (IGREATERP CN 0) do
 (PRIN3 (FCHARACTER (CONSTANT HPFILLCHAR))) 
 
-                                                (* ;; "HPFILLCHAR is 0;  there is still a problem in the system of dumping and reading back in (CHARACTER 0)")

+                                                (* ;; "HPFILLCHAR is 0;  there is still a problem in the system of dumping and reading back in (CHARACTER 0)")

 
                                                        (SETQ CN (IQUOTIENT CN 10]
                (COND
-                  ((NLISTP LASTSEEN)                         (* ; "Seen only once before")

+                  ((NLISTP LASTSEEN)                         (* ; "Seen only once before")

                    (PUTHASH X (CAR (SETQ BACKREFS (CONS (LIST LASTSEEN HERE)
                                                         BACKREFS)))
                           HPRINTHASHARRAY)
                    NIL)
-                  (T                                         (* ; 
-
                                         "Seen at least once before --- Add this place to the list")

+                  (T                                         (* ; 
+
                                         "Seen at least once before --- Add this place to the list")

                      (FRPLACD LASTSEEN (CONS HERE (CDR LASTSEEN]
               (T
                (AND CDRFLG (NLISTP X)
@@ -267,8 +293,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                           HPRINTHASHARRAY)
                    (SETN CELLCOUNT (ADD1 CELLCOUNT)))
                   ((NOT NOSPFLG)
-                   (SPACES 1)))                              (* ; 
-
                    "Now, finally get around to  printing the thing --- leave space for macro char")

+                   (SPACES 1)))                              (* ; 
+
                    "Now, finally get around to  printing the thing --- leave space for macro char")

                (COND
                   [(LISTP X)
                    (COND
@@ -291,8 +317,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                (HPRINTENDSTR]
                   (T
                    (SELECTQ TYPE
-                       ((STRINGP FLOATP FIXP)                (* ; 
-
                                                           "string, floating point or number")

+                       ((STRINGP FLOATP FIXP)                (* ; 
+
                                                           "string, floating point or number")

                             (PRIN2 X))
                        (ARRAYP (PROG ((SIZE (ARRAYSIZE X))
                                       (RPTCNT 0)
@@ -322,7 +348,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                       [PRIN2 (LIST SIZ (HARRAYPROP X 'OVERFLOW]
                                       (SPACES 1)
                                       (SELECTQ (SYSTEMTYPE)
-                                          ((TENEX TOPS20)    (* ; "bug in Interlisp-10 MAPHASH")

+                                          ((TENEX TOPS20)    (* ; "bug in Interlisp-10 MAPHASH")

                                                [COND
                                                   ((ILESSP (GCTRP)
                                                           SIZ)
@@ -339,8 +365,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                                             (HPRINTSP
 (CAR VALS))
                                                             (SETQ VALS (CDR VALS)))
                                       (HPRINTENDSTR)))
-                       (READTABLEP                           (* ; 
-
 "should dump the READMACROS flag too --- doesn't now and won't until READMACROS takes a RDTBL arg")

+                       (READTABLEP                           (* ; 
+
 "should dump the READMACROS flag too --- doesn't now and won't until READMACROS takes a RDTBL arg")

                                    (PROG ((RPTCNT 0)
                                           (RPTLAST (CONS)))
                                          (HPRINTSTRING D)
@@ -384,7 +410,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                                              (SETQ TYPE (DELETECONTROL PR NIL X]
                                                  (HPRINSP
 PR)
                                                  (HPRINSP
 TYPE]
-                                   (PRIN2)                   (* ; "end with a NIL")

+                                   (PRIN2)                   (* ; "end with a NIL")

                                    (HPRINTENDSTR))
                        (VAG (HPRINTSTRING %#)
                             (PRIN2 (LOC X))
@@ -415,7 +441,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                           (T (HPERR
 "cannot print this item" X])
 
 (HPRINTEND

-  [LAMBDA NIL
                                            (* lmm%: "29-NOV-76 16:11:02")

+  [LAMBDA NIL                                                (* lmm%: "29-NOV-76 16:11:02")

     (PROG [(HERE (GETFILEPTR (OUTPUT]
           [SORT BACKREFS (FUNCTION (LAMBDA (X Y)
                                      (ILESSP (ABS (CAR X))
@@ -445,12 +471,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
           (SETQ RPTCNT 1])
 
 (RPTEND

-  [LAMBDA NIL
                                            (* lmm%: "29-NOV-76 16:11:40")

+  [LAMBDA NIL                                                (* lmm%: "29-NOV-76 16:11:40")

     (RPTPUT
 RPTCNT RPTLAST)
     (HPRINTENDSTR])
 
 (RPTPUT

-  [LAMBDA (CNT ITEM FLAG)
                                (* lmm "11-SEP-78 03:22")

+  [LAMBDA (CNT ITEM FLAG)                                    (* lmm "11-SEP-78 03:22")

     (COND
        [(AND (ILESSP CNT 4)
              (OR FLAG (LITATOM ITEM)
@@ -481,8 +507,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 (HVFWDCDREAD

   [LAMBDA (FILE RDTBL TCONCPTR)
 
-         (* Do setq so that if the READ adds things to the BACKREF list, it will still 
-
       be correct)

+         (* Do setq so that if the READ adds things to the BACKREF list, it will still 
+
       be correct)

 
     (TCONC TCONCPTR NIL)
     (SETQ BACKREFCNT (ADD1 BACKREFCNT))
@@ -493,20 +519,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
     TCONCPTR])
 
 (HVBAKREAD

-  [LAMBDA (FILE RDTBL BKRF)
                              (* rrb "18-Mar-86 15:40")

+  [LAMBDA (FILE RDTBL BKRF)                                  (* rrb "18-Mar-86 15:40")

     (PROG (HV HV1 HV2 HV3 (RPTCNT 0)
               RPTVAL READVAL)
       READLP
           (SKIPSEPRS FILE RDTBL)
           (SELECTQ (SETQ HV (READC FILE))
-              (}                                             (* ; 
-
           "Empty printout from false start for HPRINTMACRO.  Next char should be { and be default")

+              (}                                             (* ; 
+
           "Empty printout from false start for HPRINTMACRO.  Next char should be { and be default")

                  (SKIPSEPRS FILE RDTBL)
                  (COND
                     ((EQ '{ (READC FILE))
                      (GO READLP))
                     (T (HVREADERR
))))
-              (H                                             (* ; "Hash array")

+              (H                                             (* ; "Hash array")

                  [SETQ READVAL (COND
                                   ((EQ (SKIPSEPRS FILE RDTBL)
                                        '%()
@@ -519,7 +545,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                (PUTHASH (READ FILE RDTBL)
                                       HV READVAL)))
                  (HVREADEND
 FILE RDTBL))
-              ((A Y)                                         (* ; "array")

+              ((A Y)                                         (* ; "array")

                    [SETQ READVAL (ARRAY (SETQ HV1 (READ FILE RDTBL))
                                         (SETQ HV2 (READ FILE RDTBL))
                                         NIL
@@ -537,11 +563,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                         (for
 I from
 (ADD1 HV2) to
 HV1
                            do
 (SETD READVAL I (HVRPTREAD
 FILE RDTBL]
                    (HVREADEND
 FILE RDTBL))
-              (($ ~)                                         (* ; "DATATYPE")

+              (($ ~)                                         (* ; "DATATYPE")

                    (SETQ HV1 (RATOM FILE RDTBL))
                    [COND
-                      ((EQ HV '~)                            (* ; 
-
                                 "This should be a previously known datatype not specified in file")

+                      ((EQ HV '~)                            (* ; 
+
                                 "This should be a previously known datatype not specified in file")

                        (SETQ HV2 (GETDESCRIPTORS HV1)))
                       ([NOT (SETQ HV2 (CDR (FASSOC HV1 DATATYPESEEN]
                        (SETQ HV2 (READ FILE RDTBL))
@@ -556,21 +582,21 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                    (AND BKRF (FRPLACA BKRF READVAL))
                    (for
 X in
 HV2 do
 (REPLACEFIELD X READVAL (HVRPTREAD
 FILE RDTBL)))
                    (HVREADEND
 FILE RDTBL))
-              (R                                             (* ; "repeat")

+              (R                                             (* ; "repeat")

                  (AND BKRF (HVREADERR
))
                  (RETURN HPRPTSTRING))
-              (%#                                            (* ; "Kludge for (VAG smallnumber)")

+              (%#                                            (* ; "Kludge for (VAG smallnumber)")

                   (RETURN (PROG1 (VAG (RATOM FILE RDTBL))
                                  (HVREADEND
 FILE RDTBL))))
-              (!                                             (* ; "! --- value cell")

+              (!                                             (* ; "! --- value cell")

                  (RETURN (AT2VC (RATOM FILE RDTBL))))
-              (D                                             (* ; "READTABLEP")

+              (D                                             (* ; "READTABLEP")

                  (SETQ READVAL (COPYREADTABLE 'ORIG))
                  (AND BKRF (FRPLACA BKRF READVAL))
                  (for
 I in
 (READ FILE RDTBL) do
 (SETSYNTAX I (HVRPTREAD
 FILE RDTBL)
                                                                    READVAL))
                  (HVREADEND
 FILE RDTBL))
-              (T                                             (* ; "TERMTABLEP")

+              (T                                             (* ; "TERMTABLEP")

                  (SETQ READVAL (COPYTERMTABLE 'ORIG))
                  (AND BKRF (FRPLACA BKRF READVAL))
                  (while
 (SETQ HV (RATOM FILE RDTBL))
@@ -592,10 +618,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                (NOECHO (DELETECONTROL 'NOECHO NIL READVAL))
                                (HVREADERR
)))
                  (HVREADEND
 FILE RDTBL))
-              ((0 1 2 3 4 5 6 7 8 9)                         (* ; 
-
                                                           "immediately followed by a number")

-                   (AND BKRF (HVREADERR
))                (* ; 
-
                                        "BACK REFERENCE --- shouldn't be forward reference as well")

+              ((0 1 2 3 4 5 6 7 8 9)                         (* ; 
+
                                                           "immediately followed by a number")

+                   (AND BKRF (HVREADERR
))                (* ; 
+
                                        "BACK REFERENCE --- shouldn't be forward reference as well")

                    (SETQ HV2 HV)
                    (while
 (SMALLP (SETQ HV (READC FILE))) do
 (SETQ HV2
                                                                       (IPLUS (ITIMES HV2 10)
@@ -603,20 +629,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                    (RETURN (OR [CAR (FNTH BACKREFS (ADD1 (IDIFFERENCE BACKREFCNT HV2]
                                (HVREADERR
))))
               (%( 
-                  (* ;; "form that should be evaluated with its first argument replaced with the file being read.  This is the case that handle IMAGEOBJs.")

+                  (* ;; "form that should be evaluated with its first argument replaced with the file being read.  This is the case that handle IMAGEOBJs.")

 
                   (SETQ READVAL
                    (PROG1 [APPLY (HVREADCHECKGETFN
 (READ FILE RDTBL))
                                  (CONS FILE (PROGN 
 
-                                                (* ;; "dump the first argument which is a dummy so that the call that is on the file looks like a realy call.")

+                                                (* ;; "dump the first argument which is a dummy so that the call that is on the file looks like a realy call.")

 
                                                    (CDR (until
 (PROGN (SKIPSEPRS FILE RDTBL)
                                                                           (EQ (PEEKC FILE)
                                                                               '%)))
                                                            collect
 (EVAL (READ FILE RDTBL))
                                                            finally
 
-                                                             (* ; "read the closing (QUOTE ))")

+                                                             (* ; "read the closing (QUOTE ))")

                                                                  (RATOM FILE RDTBL]
                           (HVREADEND
 FILE RDTBL)))
                   (AND BKRF (FRPLACA BKRF READVAL))
@@ -627,26 +653,26 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
           (RETURN READVAL])
 
 (HVREADCHECKGETFN

-  [LAMBDA (FN)
                                           (* ; "Edited 27-Jan-87 19:41 by rrb")

+  [LAMBDA (FN)                                               (* ; "Edited 27-Jan-87 19:41 by rrb")

 
-    (* ;; 
-
  "if in the context of reading an image object, make sure the get function is a known one.")

+    (* ;; 
+
  "if in the context of reading an image object, make sure the get function is a known one.")

 
     (COND
-       ((EQ FN 'READIMAGEOBJ)                                (* ; "common case")

+       ((EQ FN 'READIMAGEOBJ)                                (* ; "common case")

         FN)
        [(AND (BOUNDP UNDERREADIMAGEOBJ)
-             (EQ UNDERREADIMAGEOBJ T))                       (* ; 
-
                      "This is an HREAD that came from an Image object and hence needs to be safe.")

+             (EQ UNDERREADIMAGEOBJ T))                       (* ; 
+
                      "This is an HREAD that came from an Image object and hence needs to be safe.")

         (PROG NIL
           LP  (COND
                  ((OR (MEMB FN HPRINTREADFNS)
                       (ASSOC FN IMAGEOBJGETFNS))
                   (RETURN FN))
-                 ((NOT (GETD FN))                            (* ; 
-
                                                    "headed for an undefined function error anyway")

-                  (\LISPERROR FN 46 T)                       (* ; 
-
                                                 "user may have loaded a package during the break.")

+                 ((NOT (GETD FN))                            (* ; 
+
                                                    "headed for an undefined function error anyway")

+                  (\LISPERROR FN 46 T)                       (* ; 
+
                                                 "user may have loaded a package during the break.")

                   (GO LP))
                  ((MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " FN ".  " FN 
                                        " is NOT registered.  Should I use it anyway?")
@@ -656,13 +682,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
        (T FN])
 
 (HVREADEND

-  [LAMBDA (FILE RDTBL)
                                   (* lmm "21-APR-82 11:25")

+  [LAMBDA (FILE RDTBL)                                       (* lmm "21-APR-82 11:25")

     (bind
 CHAR until
 (EQ (SETQ CHAR (CHCON1 (READC FILE)))
                                  (CONSTANT HPFINALCHAR)) do
 (OR (SYNTAXP CHAR 'SEPR RDTBL)
                                                                     (HVREADERR
])
 
 (HVRPTREAD

-  [LAMBDA (FILE RDTBL)
                                   (* lmm " 2-APR-82 23:26")

+  [LAMBDA (FILE RDTBL)                                       (* lmm " 2-APR-82 23:26")

     (PROG NIL
       LOOP
           (COND
@@ -678,7 +704,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
              (T (RETURN RPTVAL])
 
 (HVFWDREAD

-  [LAMBDA (FILE RDTBL)
                                   (* lmm%: "29-NOV-76 15:56:19")

+  [LAMBDA (FILE RDTBL)                                       (* lmm%: "29-NOV-76 15:56:19")

     (PROG (CH VAL)
           (SETQ BACKREFCNT (ADD1 BACKREFCNT))
           (SETQ BACKREFS (CONS NIL BACKREFS))
@@ -700,7 +726,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                  (T (RETURN (CAR (FRPLACA BACKREFS (READ FILE RDTBL])
 
 (HREAD

-  [LAMBDA (FILE)                                             (* lmm%: 19 MAY 75 315)

+  [LAMBDA (FILE)                                             (* lmm%: 19 MAY 75 315)

     (PROG [BACKREFS (BACKREFCNT 0)
                  DATATYPESEEN
                  (FILE (INPUT (INPUT FILE]
@@ -709,7 +735,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
           (RETURN (READ FILE HPRINTRDTBL])
 
 (HPINITRDTBL

-  [LAMBDA NIL
                                            (* lmm " 5-JAN-78 23:23")

+  [LAMBDA NIL                                                (* lmm " 5-JAN-78 23:23")

     (COND
        ([NOT (READTABLEP (GETATOMVAL 'HPRINTRDTBL]
         (PROG [(RDTBL (COPYREADTABLE 'ORIG]
@@ -735,14 +761,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
            (OR M2 '(in
 HREAD])
 
 (HPRINSP

-  [LAMBDA (X)
                                            (* lmm%: "29-NOV-76 17:41:47")

+  [LAMBDA (X)                                                (* lmm%: "29-NOV-76 17:41:47")

     (PRIN2 X)
     (SPACES 1])
 )
 (DEFINEQ
 
 (COPYALL

-  [LAMBDA (X)
                                            (* ; "Edited  9-Oct-94 13:06 by jds")

+  [LAMBDA (X)                                                (* ; "Edited  9-Oct-94 13:06 by jds")

     (COND
        ((LISTP X)
         (PROG [TAIL (VAL (LIST (COPYALL
 (CAR X]
@@ -767,7 +793,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                          (STRINGP (CONCAT X))
                          (FLOATP (FPLUS X))
                          (FIXP (IPLUS X))
-                         (HARRAYP                            (* ; "Hash array")

+                         (HARRAYP                            (* ; "Hash array")

                                   (PROG [(NH (HASHARRAY (HARRAYSIZE X)
                                                     (HARRAYPROP X 'OVERFLOW]
                                         (DECLARE
 (SPECVARS NH))
@@ -788,7 +814,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                                           (add
 ORIG 1)))])
                          (BITMAP (BITMAPCOPY X))
                          (CURSOR 
-                                 (* ;; "For cursors, must preserve EQ-ness of MASK & IMAGE, to avoid trouble with SOFTCURSOR code being missing.(COPY")

+                                 (* ;; "For cursors, must preserve EQ-ness of MASK & IMAGE, to avoid trouble with SOFTCURSOR code being missing.(COPY")

 
                                  (LET* [(IM (BITMAPCOPY (FETCH
 (CURSOR CUIMAGE) OF
 X)))
                                         (NEW (CURSORCREATE IM [COND
@@ -810,7 +836,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                          (\COPYDATATYPE
 X])
 
 (\COPYDATATYPE

-  [LAMBDA (X)
                                            (* lmm "21-Apr-85 15:29")

+  [LAMBDA (X)                                                (* lmm "21-Apr-85 15:29")

     (LET* ((NTYP (NTYPX X))
            (DTD (\GETDTD NTYP))
            (PTRS (fetch
 DTDPTRS of
 DTD))
@@ -824,7 +850,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                 else
 (\BLT NEW X (fetch
 DTDSIZE of
 DTD))))])
 
 (HCOPYALL

-  [LAMBDA (X)
                                            (* rmk%: " 3-Jan-84 13:16")

+  [LAMBDA (X)                                                (* rmk%: " 3-Jan-84 13:16")

     [COND
        ([OR (HARRAYP HPRINTHASHARRAY)
             (HARRAYP (CAR (LISTP HPRINTHASHARRAY]
@@ -833,7 +859,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
     (HCOPYALL1
 X])
 
 (HCOPYALL1

-  [LAMBDA (X)
                                            (* bvm%: " 7-Feb-85 21:25")

+  [LAMBDA (X)                                                (* bvm%: " 7-Feb-85 21:25")

     (COND
        ((OR (LITATOM X)
             (SMALLP X))
@@ -859,7 +885,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                       (ARRAYP (PROG ((SIZE (ARRAYSIZE X))
                                                      (TYP (ARRAYTYP X))
                                                      (ORIG (ARRAYORIG X)))
-                                                             (* ; "Regular array")

+                                                             (* ; "Regular array")

                                                     (PUTHASH X (SETQ NEW (ARRAY SIZE TYP NIL ORIG))
                                                            HPRINTHASHARRAY)
                                                     (FRPTQ SIZE (SETA NEW ORIG
@@ -895,13 +921,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 (DEFINEQ
 
 (EQUALALL

-  [LAMBDA (X Y)
                                         (* ; "Edited 26-Apr-2021 14:34 by rmk:")

+  [LAMBDA (X Y)                                              (* ; 
+
                                                           "Edited 26-Apr-2021 14:34 by rmk:")

     (OR (EQ X Y)
         (PROG ((TY (TYPENAME Y))
                TEM)
               (RETURN (AND (EQ TY (TYPENAME X))
                            (SELECTQ TY
-                               ((LITATOM NEW-ATOM SMALLP)    (* ; "not eq, so not equal")

+                               ((LITATOM NEW-ATOM SMALLP)    (* ; "not eq, so not equal")

                                     NIL)
                                (FIXP (IEQP X Y))
                                (FLOATP (EQP X Y))
@@ -920,7 +947,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
                                                always
 (EQUALALL
 (ELT X I)
                                                                  (ELT Y I])
                                ((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY) 
-                                                             (* ; "RMK:  Added CL arrays")

+                                                             (* ; "RMK:  Added CL arrays")

                                     [AND (EQUAL (CL:ARRAY-DIMENSIONS X)
                                                 (CL:ARRAY-DIMENSIONS Y))
                                          (EQUAL (CL:ARRAY-ELEMENT-TYPE X)
@@ -973,9 +1000,9 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 
 (EQUALHASH

   [LAMBDA (AR1 AR2)
-    (DECLARE
 (SPECVARS AR1 AR2))
                     (* rmk%: "26-Dec-83 13:33")

-                                                             (* ; 
-
                                               "What does it mean for two hash arrays to be EQUAL?")

+    (DECLARE
 (SPECVARS AR1 AR2))                         (* rmk%: "26-Dec-83 13:33")

+                                                             (* ; 
+
                                               "What does it mean for two hash arrays to be EQUAL?")

     [PROG (UNMATCHED)
           (OR (EQUAL (HARRAYPROP AR1 'OVERFLOW)
                      (HARRAYPROP AR2 'OVERFLOW))
@@ -1109,16 +1136,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
 (ADDTOVAR LAMA
 )
 )
 (PUTPROPS HPRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 
-1993 1994 2021))
+1993 1994))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3661 6199 (MAKEHVPRETTYCOMS 3671 . 4958) (READVARS 4960 . 5526) (HPRINT0 5528 . 6197)) 
-(6201 6534 (READVARS-FROM-STRINGS 6201 . 6534)) (6536 6923 (READVARS-FROM-STREAM 6536 . 6923)) (6924 
-8852 (READVAR-FROM-STRING 6934 . 7340) (READVARS-FROM-STRING 7342 . 7578) (HPRINT-TO-STRING 7580 . 
-7786) (HPRINT-TO-STRINGS 7788 . 8850)) (9663 37895 (HPRINT 9673 . 11303) (HPRINT1 11305 . 22807) (
-HPRINTEND 22809 . 23845) (RPTPRINT 23847 . 24085) (RPTEND 24087 . 24246) (RPTPUT 24248 . 24746) (
-HPRINTSP 24748 . 24812) (HPERR 24814 . 24911) (HVFWDCDREAD 24913 . 25292) (HVBAKREAD 25294 . 33339) (
-HVREADCHECKGETFN 33341 . 34740) (HVREADEND 34742 . 35094) (HVRPTREAD 35096 . 35622) (HVFWDREAD 35624
- . 36478) (HREAD 36480 . 36802) (HPINITRDTBL 36804 . 37638) (HVREADERR 37640 . 37753) (HPRINSP 37755
- . 37893)) (37896 46778 (COPYALL 37906 . 41809) (\COPYDATATYPE 41811 . 42500) (HCOPYALL 42502 . 42812)
- (HCOPYALL1 42814 . 46776)) (46779 54061 (EQUALALL 46789 . 52382) (EQUALHASH 52384 . 54059)))))
+  (FILEMAP (NIL (4174 6712 (MAKEHVPRETTYCOMS 4184 . 5471) (READVARS 5473 . 6039) (HPRINT0 6041 . 6710)) 
+(6714 7047 (READVARS-FROM-STRINGS 6714 . 7047)) (7049 7436 (READVARS-FROM-STREAM 7049 . 7436)) (7437 
+9365 (READVAR-FROM-STRING 7447 . 7853) (READVARS-FROM-STRING 7855 . 8091) (HPRINT-TO-STRING 8093 . 
+8299) (HPRINT-TO-STRINGS 8301 . 9363)) (10176 39996 (HPRINT 10186 . 13404) (HPRINT1 13406 . 24908) (
+HPRINTEND 24910 . 25946) (RPTPRINT 25948 . 26186) (RPTEND 26188 . 26347) (RPTPUT 26349 . 26847) (
+HPRINTSP 26849 . 26913) (HPERR 26915 . 27012) (HVFWDCDREAD 27014 . 27393) (HVBAKREAD 27395 . 35440) (
+HVREADCHECKGETFN 35442 . 36841) (HVREADEND 36843 . 37195) (HVRPTREAD 37197 . 37723) (HVFWDREAD 37725
+ . 38579) (HREAD 38581 . 38903) (HPINITRDTBL 38905 . 39739) (HVREADERR 39741 . 39854) (HPRINSP 39856
+ . 39994)) (39997 48879 (COPYALL 40007 . 43910) (\COPYDATATYPE 43912 . 44601) (HCOPYALL 44603 . 44913)
+ (HCOPYALL1 44915 . 48877)) (48880 56227 (EQUALALL 48890 . 54548) (EQUALHASH 54550 . 56225)))))
 STOP

sources/IMAGEIO

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "25-Sep-2021 20:58:07" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;4
 79783  
 
-      changes to%:  (VARS IMAGEIOCOMS)
-                    (FNS \DISPLAYINIT \4DISPLAYINIT \8DISPLAYINIT \24DISPLAYINIT)
+
(FILECREATED "30-Oct-2021 19:09:48" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>IMAGEIO.;7
 80279  
 
-      previous date%: " 2-Aug-2021 19:41:35" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;2)
+      changes to%:  (FNS \NOIMAGE.DSPFONT)
+
+      previous date%: "25-Sep-2021 20:58:07" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>IMAGEIO.;5)
 
 
 (* ; "
@@ -756,16 +755,20 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
                              IMDRAWPOINT _ (FUNCTION NILL])
 
 (\NOIMAGE.DSPFONT

-  [LAMBDA (STREAM FONT)
                                  (* ; "Edited 28-Oct-87 20:10 by jds")

+  [LAMBDA (STREAM FONT)
                                     (* ; "Edited 30-Oct-2021 19:09 by rmk:")


+                                                             (* ; "Edited 28-Oct-87 20:10 by jds")

 
     (* ;; "DSPFONT method for non-image streams:  Put out font-change characters.")

 
-    (LET ((OLDFONT (ffetch
 IMAGEDATA of
 STREAM)))
+    (* ;; "RMK: Save and restore CHARPOSITION")

+
+    (LET ((OLDFONT (ffetch
 (STREAM IMAGEDATA) of
 STREAM)))
          (PROG1 OLDFONT
              [AND (NEQ OLDFONT 0)
-                  (LET [(FONTN (OR (SMALLP FONT)
+                  (LET ([FONTN (OR (SMALLP FONT)
                                    (AND (type?
 FONTCLASS FONT)
                                         (fetch
 (FONTCLASS PRETTYFONT#) of
 FONT]
+                        CHARPOS)
                        (COND
                           ((AND FONTN (NEQ FONTN OLDFONT))
 
@@ -773,9 +776,11 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
 
                            (COND
                               ((NEQ FONTN 0)
+                               (SETQ CHARPOS (FFETCH
 (STREAM CHARPOSITION) OF
 STREAM))
                                (\OUTCHAR STREAM (CONSTANT (CHCON1 FONTESCAPECHAR)))
-                               (\OUTCHAR STREAM FONTN)))
-                           (freplace
 IMAGEDATA of
 STREAM with
 FONTN])])
+                               (\OUTCHAR STREAM FONTN)
+                               (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 CHARPOS)))
+                           (freplace
 (STREAM IMAGEDATA) of
 STREAM with
 FONTN])])
 
 (\UNIMPIMAGEOP

   [LAMBDA (STREAM OP)
                                    (* rmk%: "26-Jun-84 13:28")

@@ -904,7 +909,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
 (RECORD BRUSH
 (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR)
-                  BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1)
+              BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1)
 )
 
 (* "END EXPORTED DEFINITIONS")
@@ -922,17 +927,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
 (DECLARE%: DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS IMAGEOP
 MACRO
 [ARGS (CONS 'SPREADAPPLY*
-                                            (CONS (COND
-                                                     [(EQ (CAR (LISTP (CAR ARGS)))
-                                                          'QUOTE)
-                                                      (LIST 'fetch (LIST 'IMAGEOPS (CADAR ARGS))
-                                                            'of
-                                                            (LIST 'fetch '(STREAM IMAGEOPS)
+(PUTPROPS IMAGEOP
 MACRO
 [ARGS (CONS 'SPREADAPPLY* (CONS (COND
+                                                           [(EQ (CAR (LISTP (CAR ARGS)))
+                                                                'QUOTE)
+                                                            (LIST 'fetch (LIST 'IMAGEOPS (CADAR
+                                                                                          ARGS))
                                                                   'of
-                                                                  (CADR ARGS]
-                                                     (T (HELP "IMAGEOP - OPNAME not quoted:" ARGS)))
-                                                  (CDDR ARGS])
+                                                                  (LIST 'fetch '(STREAM IMAGEOPS)
+                                                                        'of
+                                                                        (CADR ARGS]
+                                                           (T (HELP "IMAGEOP - OPNAME not quoted:" 
+                                                                    ARGS)))
+                                                        (CDDR ARGS])
 )
 (DECLARE%: EVAL@COMPILE
 
@@ -1513,24 +1519,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
 (PUTPROPS IMAGEIO COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
 1993 1994 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3423 12180 (IMAGESTREAMP 3433 . 4265) (IMAGESTREAMTYPE 4267 . 4480) (IMAGESTREAMTYPEP 
-4482 . 5117) (OPENIMAGESTREAM 5119 . 10073) (\GOOD.DASHLST 10075 . 12178)) (12215 14512 (
-DRAWDASHEDLINE 12225 . 14510)) (14513 21853 (DSPBACKCOLOR 14523 . 14895) (DSPBOTTOMMARGIN 14897 . 
-15282) (DSPCOLOR 15284 . 15648) (DSPCLIPPINGREGION 15650 . 16355) (DSPRESET 16357 . 16637) (DSPFONT 
-16639 . 17003) (DSPLEFTMARGIN 17005 . 17386) (DSPLINEFEED 17388 . 17688) (DSPOPERATION 17690 . 18067) 
-(DSPRIGHTMARGIN 18069 . 18452) (DSPTOPMARGIN 18454 . 18833) (DSPSCALE 18835 . 19202) (DSPSPACEFACTOR 
-19204 . 19597) (DSPXPOSITION 19599 . 19904) (DSPYPOSITION 19906 . 20211) (DSPROTATE 20213 . 20508) (
-DSPPUSHSTATE 20510 . 20756) (DSPPOPSTATE 20758 . 21001) (DSPDEFAULTSTATE 21003 . 21255) (DSPSCALE2 
-21257 . 21548) (DSPTRANSLATE 21550 . 21851)) (21854 30655 (DSPNEWPAGE 21864 . 22556) (DRAWBETWEEN 
-22558 . 23260) (DRAWCIRCLE 23262 . 23758) (DRAWARC 23760 . 24277) (DRAWCURVE 24279 . 24956) (
-DRAWELLIPSE 24958 . 25744) (DRAWLINE 25746 . 26136) (DRAWPOLYGON 26138 . 26593) (DRAWPOINT 26595 . 
-27014) (FILLPOLYGON 27016 . 27582) (DRAWTO 27584 . 28002) (FILLCIRCLE 28004 . 28227) (MOVETO 28229 . 
-28593) (RELDRAWTO 28595 . 29512) (BITMAPIMAGESIZE 29514 . 29685) (SCALEDBITBLT 29687 . 30653)) (30656 
-37695 (\DRAWPOINT.GENERIC 30666 . 31013) (\DRAWPOLYGON.GENERIC 31015 . 33323) (\DRAWCIRCLE.GENERIC 
-33325 . 34983) (\DRAWELLIPSE.GENERIC 34985 . 37693)) (37696 43082 (\IMAGEIOINIT 37706 . 41839) (
-\NOIMAGE.DSPFONT 41841 . 42916) (\UNIMPIMAGEOP 42918 . 43080)) (43205 46329 (INSURE.BRUSH 43215 . 
-44589) (BRUSHP 44591 . 45381) (\POSSIBLECOLOR 45383 . 45934) (NEGSHADE 45936 . 46327)) (46885 47569 (
-DASHINGP 46895 . 47225) (INSURE.DASHING 47227 . 47567)) (58050 78596 (\DisplayEventFn 58060 . 58570) (
-\DISPLAYINIT 58572 . 64155) (\4DISPLAYINIT 64157 . 68858) (\8DISPLAYINIT 68860 . 73563) (
-\24DISPLAYINIT 73565 . 78337) (\DISPLAYSTREAMTYPEBPP 78339 . 78594)))))
+  (FILEMAP (NIL (3343 12100 (IMAGESTREAMP 3353 . 4185) (IMAGESTREAMTYPE 4187 . 4400) (IMAGESTREAMTYPEP 
+4402 . 5037) (OPENIMAGESTREAM 5039 . 9993) (\GOOD.DASHLST 9995 . 12098)) (12135 14432 (DRAWDASHEDLINE 
+12145 . 14430)) (14433 21773 (DSPBACKCOLOR 14443 . 14815) (DSPBOTTOMMARGIN 14817 . 15202) (DSPCOLOR 
+15204 . 15568) (DSPCLIPPINGREGION 15570 . 16275) (DSPRESET 16277 . 16557) (DSPFONT 16559 . 16923) (
+DSPLEFTMARGIN 16925 . 17306) (DSPLINEFEED 17308 . 17608) (DSPOPERATION 17610 . 17987) (DSPRIGHTMARGIN 
+17989 . 18372) (DSPTOPMARGIN 18374 . 18753) (DSPSCALE 18755 . 19122) (DSPSPACEFACTOR 19124 . 19517) (
+DSPXPOSITION 19519 . 19824) (DSPYPOSITION 19826 . 20131) (DSPROTATE 20133 . 20428) (DSPPUSHSTATE 20430
+ . 20676) (DSPPOPSTATE 20678 . 20921) (DSPDEFAULTSTATE 20923 . 21175) (DSPSCALE2 21177 . 21468) (
+DSPTRANSLATE 21470 . 21771)) (21774 30575 (DSPNEWPAGE 21784 . 22476) (DRAWBETWEEN 22478 . 23180) (
+DRAWCIRCLE 23182 . 23678) (DRAWARC 23680 . 24197) (DRAWCURVE 24199 . 24876) (DRAWELLIPSE 24878 . 25664
+) (DRAWLINE 25666 . 26056) (DRAWPOLYGON 26058 . 26513) (DRAWPOINT 26515 . 26934) (FILLPOLYGON 26936 . 
+27502) (DRAWTO 27504 . 27922) (FILLCIRCLE 27924 . 28147) (MOVETO 28149 . 28513) (RELDRAWTO 28515 . 
+29432) (BITMAPIMAGESIZE 29434 . 29605) (SCALEDBITBLT 29607 . 30573)) (30576 37615 (\DRAWPOINT.GENERIC 
+30586 . 30933) (\DRAWPOLYGON.GENERIC 30935 . 33243) (\DRAWCIRCLE.GENERIC 33245 . 34903) (
+\DRAWELLIPSE.GENERIC 34905 . 37613)) (37616 43413 (\IMAGEIOINIT 37626 . 41759) (\NOIMAGE.DSPFONT 41761
+ . 43247) (\UNIMPIMAGEOP 43249 . 43411)) (43536 46660 (INSURE.BRUSH 43546 . 44920) (BRUSHP 44922 . 
+45712) (\POSSIBLECOLOR 45714 . 46265) (NEGSHADE 46267 . 46658)) (47216 47900 (DASHINGP 47226 . 47556) 
+(INSURE.DASHING 47558 . 47898)) (58546 79092 (\DisplayEventFn 58556 . 59066) (\DISPLAYINIT 59068 . 
+64651) (\4DISPLAYINIT 64653 . 69354) (\8DISPLAYINIT 69356 . 74059) (\24DISPLAYINIT 74061 . 78833) (
+\DISPLAYSTREAMTYPEBPP 78835 . 79090)))))
 STOP

sources/INSPECT

@@ -1,11 +1,12 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED "10-Jul-2021 20:31:23" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;10
 119111 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS RDTBL\NONOTHERCODES)
+
(FILECREATED "11-Oct-2021 14:04:22" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;11
 119118 
 
-      previous date%: "10-Jul-2021 20:20:35" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;9)
+      changes to%:  (FNS \TEDIT.INSPECTCODE)
+
+      previous date%: "10-Jul-2021 20:31:23" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;10)
 
 
 (* ; "
@@ -16,7 +17,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
 
 (RPAQQ INSPECTCOMS

        [(COMS 
-              (* ;; "functions to implement an item window.  An ITEM window is a window that contains SELECTABLEITEMS.  An item from the window is selected using the left button.  The middle button will then bring up a menu of commands that can be applyed to the selected item.  An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum.  It is used by the inspector.")

+              (* ;; "functions to implement an item window.  An ITEM window is a window that contains SELECTABLEITEMS.  An item from the window is selected using the left button.  The middle button will then bring up a menu of commands that can be applyed to the selected item.  An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum.  It is used by the inspector.")

 
               (FNS INSPECTW.CREATE INSPECTW.REPAINTFN INSPECTW.REDISPLAY \INSPECTW.VALUE.MARGIN 
                    INSPECTW.REPLACE INSPECTW.SELECTITEM \INSPECTW.REDISPLAYPROP INSPECTW.FETCH 
@@ -33,7 +34,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                     (MAXINSPECTCDRLEVEL 50)
                     MinSpaceBetweenProperyAndValue MaxInspectorPropertyValueWidth MaxValueLeftMargin
                     PropertyLeftMargin))
-        (COMS                                                (* ; "functions for the inspector")

+        (COMS                                                (* ; "functions for the inspector")

               (FNS INSPECT \APPLYINSPECTMACRO INSPECT/BITMAP INSPECT/DATATYPE INSPECTABLEFIELDNAMES 
                    REMOVEDUPS INSPECT/ARRAY INSPECT/TOP/LEVEL/LIST INSPECT/PROPLIST NONSYSPROPNAMES 
                    INSPECT/LISTP ALISTP PROPLISTP INSPECT/ALIST ASSOCGET /ASSOCPUT INSPECT/PLIST 
@@ -51,16 +52,16 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                      (MaxInspectorWindowHeight 606))
               (VARS INSPECTPRINTLEVEL)
               
-              (* ;; "To deal with profiles in spawned processes")

+              (* ;; "To deal with profiles in spawned processes")

 
               (MACROS EVAL.AS.PROCESS.WITH.PROFILE WITH-INSPECTOR-ENV))
-        (COMS                                                (* ; "Atom inspector")

+        (COMS                                                (* ; "Atom inspector")

               (FNS INSPECT/ATOM SELECT.ATOM.ASPECT INSPECT/AS/FUNCTION SELECT.FNS.EDITOR))
-        (COMS                                                (* ; "Compiled code inspector")

+        (COMS                                                (* ; "Compiled code inspector")

               (FNS INSPECTCODE \TEDIT.INSPECTCODE \INSPECT/CODE/RESHAPEFN \INSPECT/CODE/REPAINTFN))
-        (COMS                                                (* ; "Hash table inspector")

+        (COMS                                                (* ; "Hash table inspector")

               (FNS INSPECT/HARRAYP HARRAYKEYS INSPECTW.GETHASH INSPECTW.PUTHASH))
-        [COMS                                                (* ; "Readtable, termtable inspectors")

+        [COMS                                                (* ; "Readtable, termtable inspectors")

               (FNS RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP GETTTBLPROP SETTTBLPROP)
               (ADDVARS (INSPECTMACROS (READTABLEP RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP)
                               (TERMTABLEP (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL RAISE 
@@ -69,7 +70,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                                                  11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 
                                                  28 29 30 31)
                                      GETTTBLPROP SETTTBLPROP]
-        (COMS                                                (* ; "Hunk inspector")

+        (COMS                                                (* ; "Hunk inspector")

               (FNS INSPECT/AS/BLOCKRECORD INSPECT/TYPELESS LIST-ALL-BLOCKRECORDS INSPECT/HUNK 
                    \INSPECT.DATATYPE.RAW.FETCH \INSPECT.FETCH.8 \INSPECT.FETCH.32 \INSPECT.FETCH.CHAR
                    \INSPECT.FETCH.FATCHAR \INSPECT.FETCH.PTR \INSPECT.STORE.8 \INSPECT.STORE.16 
@@ -1720,7 +1721,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                (\INSPECT/CODE/RESHAPEFN
 WINDOW])
 
 (\TEDIT.INSPECTCODE

-  [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER)
          (* ; "Edited  3-Feb-87 16:56 by jop")

+  [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER)
         (* ; "Edited 11-Oct-2021 14:04 by rmk:")

     (PROG ((STREAM (OPENSTREAM '{NODIRCORE} 'BOTH))
            WINDOW SEL)
           (APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE))
@@ -1737,7 +1738,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                                                                          (fetch
 (COMPILED-CLOSURE
                                                                                      FRAMENAME)
                                                                             of
 FN]
-                              NIL NIL '(READONLY T PROMPTWINDOW DON'T]
+                              NIL NIL `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT]
           (COND
              ((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1)))
                                                              (* ; "Highlight location of PC")

@@ -2146,40 +2147,40 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
 (PUTPROPS INSPECT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991 1993 
 1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6999 42727 (INSPECTW.CREATE 7009 . 11764) (INSPECTW.REPAINTFN 11766 . 17302) (
-INSPECTW.REDISPLAY 17304 . 26176) (\INSPECTW.VALUE.MARGIN 26178 . 26581) (INSPECTW.REPLACE 26583 . 
-27291) (INSPECTW.SELECTITEM 27293 . 28283) (\INSPECTW.REDISPLAYPROP 28285 . 30715) (INSPECTW.FETCH 
-30717 . 31140) (INSPECTW.PROPERTIES 31142 . 31783) (DECODE.WINDOW.ARG 31785 . 33513) (
-DEFAULT.INSPECTW.PROPCOMMANDFN 33515 . 35533) (DEFAULT.INSPECTW.VALUECOMMANDFN 35535 . 36793) (
-DEFAULT.INSPECTW.TITLECOMMANDFN 36795 . 38485) (\SELITEM.FROM.PROPERTY 38487 . 38929) (
-\INSPECT.COMPUTE.TITLE 38931 . 40057) (LEVELEDFORM 40059 . 40778) (MAKEWITHINREGION 40780 . 42725)) (
-42728 60029 (ITEMW.REPAINTFN 42738 . 43958) (\ITEM.WINDOW.BUTTON.HANDLER 43960 . 44375) (
-\ITEM.WINDOW.SELECTION.HANDLER 44377 . 47044) (\INSPECTW.COMMAND.HANDLER 47046 . 51047) (
-ITEM.WINDOW.SET.STACK.ARG 51049 . 53253) (REPLACESTKARG 53255 . 54354) (IN/ITEM? 54356 . 55238) (
-\ITEMW.DESELECTITEM 55240 . 55504) (\ITEMW.SELECTITEM 55506 . 55768) (\ITEMW.CLEARSELECTION 55770 . 
-56125) (\ITEMW.FLIPITEM 56127 . 56600) (PRINTANDBOX 56602 . 59111) (PRINTATBOX 59113 . 59630) (
-ITEMOFPROPERTYVALUE 59632 . 60027)) (60030 63635 (\ITEM.WINDOW.COPY.HANDLER 60040 . 61761) (
-\ITEMW.FLIPCOPY 61763 . 62222) (BKSYSBUF.GENERAL 62224 . 63633)) (64027 86502 (INSPECT 64037 . 68300) 
-(\APPLYINSPECTMACRO 68302 . 69284) (INSPECT/BITMAP 69286 . 70321) (INSPECT/DATATYPE 70323 . 73566) (
-INSPECTABLEFIELDNAMES 73568 . 74089) (REMOVEDUPS 74091 . 74296) (INSPECT/ARRAY 74298 . 75335) (
-INSPECT/TOP/LEVEL/LIST 75337 . 76296) (INSPECT/PROPLIST 76298 . 77273) (NONSYSPROPNAMES 77275 . 77571)
- (INSPECT/LISTP 77573 . 77895) (ALISTP 77897 . 78106) (PROPLISTP 78108 . 78748) (INSPECT/ALIST 78750
- . 79105) (ASSOCGET 79107 . 79318) (/ASSOCPUT 79320 . 79585) (INSPECT/PLIST 79587 . 79950) (
-INSPECT/TYPERECORD 79952 . 80192) (INSPECT/AS/RECORD 80194 . 81318) (SELECT.LIST.INSPECTOR 81320 . 
-83365) (STANDARDEDITE 83367 . 83650) (NTHTOPLEVELELT 83652 . 83968) (SETNTHTOPLEVELELT 83970 . 84730) 
-(DEDITE 84732 . 84939) (FINDRECDECL 84941 . 85524) (FINDSYSRECDECL 85526 . 85927) (
-MAKE-INSPECTOR-PROFILE 85929 . 86314) (CONFIRM-SET 86316 . 86500)) (88396 96485 (INSPECT/ATOM 88406 . 
-92386) (SELECT.ATOM.ASPECT 92388 . 93532) (INSPECT/AS/FUNCTION 93534 . 95820) (SELECT.FNS.EDITOR 95822
- . 96483)) (96526 101925 (INSPECTCODE 96536 . 97682) (\TEDIT.INSPECTCODE 97684 . 99642) (
-\INSPECT/CODE/RESHAPEFN 99644 . 101183) (\INSPECT/CODE/REPAINTFN 101185 . 101923)) (101963 103448 (
-INSPECT/HARRAYP 101973 . 102600) (HARRAYKEYS 102602 . 102981) (INSPECTW.GETHASH 102983 . 103210) (
-INSPECTW.PUTHASH 103212 . 103446)) (103497 109706 (RDTBL\NONOTHERCODES 103507 . 104527) (GETSYNTAXPROP
- 104529 . 106027) (SETSYNTAXPROP 106029 . 107756) (GETTTBLPROP 107758 . 108676) (SETTTBLPROP 108678 . 
-109704)) (110185 118568 (INSPECT/AS/BLOCKRECORD 110195 . 111078) (INSPECT/TYPELESS 111080 . 112326) (
-LIST-ALL-BLOCKRECORDS 112328 . 112603) (INSPECT/HUNK 112605 . 115211) (\INSPECT.DATATYPE.RAW.FETCH 
-115213 . 115539) (\INSPECT.FETCH.8 115541 . 115690) (\INSPECT.FETCH.32 115692 . 115863) (
-\INSPECT.FETCH.CHAR 115865 . 116028) (\INSPECT.FETCH.FATCHAR 116030 . 116192) (\INSPECT.FETCH.PTR 
-116194 . 116365) (\INSPECT.STORE.8 116367 . 116673) (\INSPECT.STORE.16 116675 . 116975) (
-\INSPECT.STORE.32 116977 . 117412) (\INSPECT.STORE.CHAR 117414 . 117740) (\INSPECT.STORE.FATCHAR 
-117742 . 118064) (\INSPECT.STORE.PTR 118066 . 118413) (INSPECT/MAKE/CCODEP 118415 . 118566)))))
+  (FILEMAP (NIL (6986 42714 (INSPECTW.CREATE 6996 . 11751) (INSPECTW.REPAINTFN 11753 . 17289) (
+INSPECTW.REDISPLAY 17291 . 26163) (\INSPECTW.VALUE.MARGIN 26165 . 26568) (INSPECTW.REPLACE 26570 . 
+27278) (INSPECTW.SELECTITEM 27280 . 28270) (\INSPECTW.REDISPLAYPROP 28272 . 30702) (INSPECTW.FETCH 
+30704 . 31127) (INSPECTW.PROPERTIES 31129 . 31770) (DECODE.WINDOW.ARG 31772 . 33500) (
+DEFAULT.INSPECTW.PROPCOMMANDFN 33502 . 35520) (DEFAULT.INSPECTW.VALUECOMMANDFN 35522 . 36780) (
+DEFAULT.INSPECTW.TITLECOMMANDFN 36782 . 38472) (\SELITEM.FROM.PROPERTY 38474 . 38916) (
+\INSPECT.COMPUTE.TITLE 38918 . 40044) (LEVELEDFORM 40046 . 40765) (MAKEWITHINREGION 40767 . 42712)) (
+42715 60016 (ITEMW.REPAINTFN 42725 . 43945) (\ITEM.WINDOW.BUTTON.HANDLER 43947 . 44362) (
+\ITEM.WINDOW.SELECTION.HANDLER 44364 . 47031) (\INSPECTW.COMMAND.HANDLER 47033 . 51034) (
+ITEM.WINDOW.SET.STACK.ARG 51036 . 53240) (REPLACESTKARG 53242 . 54341) (IN/ITEM? 54343 . 55225) (
+\ITEMW.DESELECTITEM 55227 . 55491) (\ITEMW.SELECTITEM 55493 . 55755) (\ITEMW.CLEARSELECTION 55757 . 
+56112) (\ITEMW.FLIPITEM 56114 . 56587) (PRINTANDBOX 56589 . 59098) (PRINTATBOX 59100 . 59617) (
+ITEMOFPROPERTYVALUE 59619 . 60014)) (60017 63622 (\ITEM.WINDOW.COPY.HANDLER 60027 . 61748) (
+\ITEMW.FLIPCOPY 61750 . 62209) (BKSYSBUF.GENERAL 62211 . 63620)) (64014 86489 (INSPECT 64024 . 68287) 
+(\APPLYINSPECTMACRO 68289 . 69271) (INSPECT/BITMAP 69273 . 70308) (INSPECT/DATATYPE 70310 . 73553) (
+INSPECTABLEFIELDNAMES 73555 . 74076) (REMOVEDUPS 74078 . 74283) (INSPECT/ARRAY 74285 . 75322) (
+INSPECT/TOP/LEVEL/LIST 75324 . 76283) (INSPECT/PROPLIST 76285 . 77260) (NONSYSPROPNAMES 77262 . 77558)
+ (INSPECT/LISTP 77560 . 77882) (ALISTP 77884 . 78093) (PROPLISTP 78095 . 78735) (INSPECT/ALIST 78737
+ . 79092) (ASSOCGET 79094 . 79305) (/ASSOCPUT 79307 . 79572) (INSPECT/PLIST 79574 . 79937) (
+INSPECT/TYPERECORD 79939 . 80179) (INSPECT/AS/RECORD 80181 . 81305) (SELECT.LIST.INSPECTOR 81307 . 
+83352) (STANDARDEDITE 83354 . 83637) (NTHTOPLEVELELT 83639 . 83955) (SETNTHTOPLEVELELT 83957 . 84717) 
+(DEDITE 84719 . 84926) (FINDRECDECL 84928 . 85511) (FINDSYSRECDECL 85513 . 85914) (
+MAKE-INSPECTOR-PROFILE 85916 . 86301) (CONFIRM-SET 86303 . 86487)) (88383 96472 (INSPECT/ATOM 88393 . 
+92373) (SELECT.ATOM.ASPECT 92375 . 93519) (INSPECT/AS/FUNCTION 93521 . 95807) (SELECT.FNS.EDITOR 95809
+ . 96470)) (96513 101932 (INSPECTCODE 96523 . 97669) (\TEDIT.INSPECTCODE 97671 . 99649) (
+\INSPECT/CODE/RESHAPEFN 99651 . 101190) (\INSPECT/CODE/REPAINTFN 101192 . 101930)) (101970 103455 (
+INSPECT/HARRAYP 101980 . 102607) (HARRAYKEYS 102609 . 102988) (INSPECTW.GETHASH 102990 . 103217) (
+INSPECTW.PUTHASH 103219 . 103453)) (103504 109713 (RDTBL\NONOTHERCODES 103514 . 104534) (GETSYNTAXPROP
+ 104536 . 106034) (SETSYNTAXPROP 106036 . 107763) (GETTTBLPROP 107765 . 108683) (SETTTBLPROP 108685 . 
+109711)) (110192 118575 (INSPECT/AS/BLOCKRECORD 110202 . 111085) (INSPECT/TYPELESS 111087 . 112333) (
+LIST-ALL-BLOCKRECORDS 112335 . 112610) (INSPECT/HUNK 112612 . 115218) (\INSPECT.DATATYPE.RAW.FETCH 
+115220 . 115546) (\INSPECT.FETCH.8 115548 . 115697) (\INSPECT.FETCH.32 115699 . 115870) (
+\INSPECT.FETCH.CHAR 115872 . 116035) (\INSPECT.FETCH.FATCHAR 116037 . 116199) (\INSPECT.FETCH.PTR 
+116201 . 116372) (\INSPECT.STORE.8 116374 . 116680) (\INSPECT.STORE.16 116682 . 116982) (
+\INSPECT.STORE.32 116984 . 117419) (\INSPECT.STORE.CHAR 117421 . 117747) (\INSPECT.STORE.FATCHAR 
+117749 . 118071) (\INSPECT.STORE.PTR 118073 . 118420) (INSPECT/MAKE/CCODEP 118422 . 118573)))))
 STOP