Add GATHER-INFO to internal/library/MEDLEYUTILS (#549)

* Change numeric OPCODES SUBRCALL NN to use the LLSUBRS name

* more opcodes subr# in maikoloadupfns

* even more OPCODES SUBRCALL

* Recover BIGBMAPS definitions dup (but more recent) from LLCOLOR

.github/workflows/buildDocker.yml

@@ -1,13 +1,15 @@
 #  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:
+
+#  push:
+#    branches:
+#      - master
 
 # Jobs that compose this workflow
 jobs:
@@ -29,14 +31,14 @@ jobs:
 
           # 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}
+            VERSION=${GITHUB_REF#refs/tags/}
           fi
           TAGS="${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${SHORTREF}"
 
-          # If the VERSION looks like a version number, assume that
+          # If the VERSION looks like medley followed by a date, 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
+          if [[ $VERSION =~ ^medley-[0-9]{1,6}.$ ]]; then
             TAGS="$TAGS,${DOCKER_IMAGE}:latest"
           fi
 
@@ -44,6 +46,16 @@ jobs:
           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: "*"
 
       # Setup Docker Machine Emulation environment
       - name: Set up QEMU

.github/workflows/buildLoadup.yml

@@ -0,0 +1,93 @@
+# 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
+
+      - name: Get the latest Maiko Release
+        uses: actions/checkout@v2
+        with:
+          repository: interlisp/maiko
+          path: maiko
+
+      - name: install compiler
+        run: sudo apt-get update && sudo apt-get install -y make clang libx11-dev gcc x11vnc xvfb
+
+      - name: install vnc
+        run: sudo apt-get install -y tightvncserver
+
+      - name: Compile Maiko
+        working-directory: maiko/bin
+        run: ./makeright  x && ./makeright init
+
+      - name: Build Loadout
+        run: pwd && Xvnc -once -geometry 1280x720 :0 & DISPLAY=:0 PATH="/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/SIMPLE-INIT               \
+                     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  &&
+          ls tmp && env
+      
+      - 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 }}
+          bodyfile: tmp/release-notes.md
+          token: ${{ secrets.GITHUB_TOKEN }}

BUILDING.md

@@ -0,0 +1,30 @@
+# How to build a medley release
+
+Originally done only with shell scripts:
+
+./scripts/loadup-all.sh 
+./scripts/loadup-and-release.sh
+
+
+# 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
 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,8 +116,12 @@ 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
 
@@ -85,9 +132,7 @@ Each directory should have a README.md, but briefly
 - 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
 

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,13 @@
 (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 "16-Oct-2021 15:04:31" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;13|
 261677 
 
-      |previous| |date:| "21-Aug-2021 23:33:58" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
+      |changes| |to:|  (VARS FILEBROWSERCOMS)
+                       (FNS FB.GETWINDOW FB.SET.BROWSER.TITLE FB.DATE)
+
+      |previous| |date:| "19-Sep-2021 18:08:05" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;10|)
 
 
 ; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
@@ -205,6 +207,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)
@@ -2253,21 +2256,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 +2304,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 +2316,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 +3293,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)))
@@ -4202,51 +4220,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 (28719 51355 (FB 28729 . 29685) (FB.COPYBINARYCOMMAND 29687 . 30033) (FB.COPYTEXTCOMMAND
+ 30035 . 30377) (FILEBROWSER 30379 . 43485) (FB.TABLEBROWSER 43487 . 43704) (FB.SELECTEDFILES 43706 . 
+44343) (FB.FETCHFILENAME 44345 . 44737) (FB.DIRECTORYP 44739 . 45067) (FB.PROMPTWPRINT 45069 . 46115) 
+(FB.PROMPTW.FORMAT 46117 . 46854) (FB.PROMPTFORINPUT 46856 . 49108) (FB.YES-OR-NO-P 49110 . 50144) (
+FB.ALLOW.ABORT 50146 . 51000) (\\FB.HARDCOPY.TOFILE.EXTENSION 51002 . 51353)) (51379 52332 (FB.STARTUP
+ 51389 . 51904) (FB.MAKERIGIDWINDOW 51906 . 52330)) (52333 57705 (FB.PRINTFN 52343 . 57496) (FB.COPYFN
+ 57498 . 57703)) (57755 63797 (FB.MENU.WHENSELECTEDFN 57765 . 58123) (FB.COMMANDSELECTEDFN 58125 . 
+59664) (FB.SUBITEMP 59666 . 60101) (FB.MAKE.BROWSER.BUSY 60103 . 60841) (FB.FINISH.COMMAND 60843 . 
+62808) (FB.HANDLE.ABORT.BUTTON 62810 . 63795)) (63798 69314 (FB.DELETECOMMAND 63808 . 64089) (
+FB.DELVERCOMMAND 64091 . 67284) (FB.IS.NOT.SUBDIRECTORY.ITEM 67286 . 67467) (FB.DELVER.FILES 67469 . 
+68558) (FB.DELETE.FILE 68560 . 69312)) (69315 70640 (FB.UNDELETECOMMAND 69325 . 69610) (
+FB.UNDELETEALLCOMMAND 69612 . 69891) (FB.UNDELETE.FILE 69893 . 70638)) (70641 94822 (FB.COPYCOMMAND 
+70651 . 70920) (FB.RENAMECOMMAND 70922 . 71197) (FB.COPY/RENAME.COMMAND 71199 . 72122) (
+FB.COPY/RENAME.ONE 72124 . 74446) (FB.COPY/RENAME.MANY 74448 . 80668) (FB.MERGE.DIRECTORIES 80670 . 
+81088) (FB.GREATEST.PREFIX 81090 . 82446) (FB.MAYBE.INSERT.FILE 82448 . 89888) (FB.GET.NEW.FILE.SPEC 
+89890 . 93721) (FB.CANONICAL.DIRECTORY 93723 . 94820)) (94823 102607 (FB.HARDCOPYCOMMAND 94833 . 95963
+) (FB.HARDCOPY.TOFILE 95965 . 102605)) (102608 112485 (FB.EDITCOMMAND 102618 . 103419) (
+FB.EDITCOMMAND.ONEFILE 103421 . 106701) (FB.EDITLISPFILE 106703 . 107742) (FB.BROWSECOMMAND 107744 . 
+112483)) (112486 124279 (FB.FASTSEECOMMAND 112496 . 115946) (FB.FASTSEE.ONEFILE 115948 . 118977) (
+FB.SEEFULLFN 118979 . 123110) (FB.SEEBUTTONFN 123112 . 124277)) (124280 126026 (FB.LOADCOMMAND 124290
+ . 124797) (FB.COMPILECOMMAND 124799 . 125337) (FB.OPERATE.ON.FILES 125339 . 126024)) (126027 173598 (
+FB.UPDATECOMMAND 126037 . 126262) (FB.FIX-DIRECTORY-DATES 126264 . 126871) (FB.MAYBE.EXPUNGE 126873 . 
+127868) (FB.UPDATEBROWSERITEMS 127870 . 141085) (FB.DATE 141087 . 141662) (FB.ADJUST.DATE.WIDTH 141664
+ . 144632) (FB.SET.BROWSER.TITLE 144634 . 145570) (FB.MAYBE.WIDEN.NAMES 145572 . 147691) (
+FB.SET.DEFAULT.NAME.WIDTH 147693 . 149057) (FB.CREATE.FILEBUCKET 149059 . 156279) (
+FB.CHECK.NAME.LENGTH 156281 . 158702) (FB.ADD.FILEGROUP 158704 . 160231) (FB.INSERT.DIRECTORY 160233
+ . 160471) (FB.MAKE.SUBDIRECTORY.ITEM 160473 . 161882) (FB.ADD.FILE 161884 . 162497) (FB.INSERT.FILE 
+162499 . 165911) (FB.ANALYZE.PATTERN 165913 . 171177) (FB.CANONICALIZE.PATTERN 171179 . 172491) (
+FB.GETALLFILEINFO 172493 . 173596)) (173599 181758 (FB.SORT.VERSIONS 173609 . 176380) (
+FB.DECREASING.VERSION 176382 . 177051) (FB.INCREASING.VERSION 177053 . 177674) (
+FB.NAMES.DECREASING.VERSION 177676 . 178711) (FB.NAMES.INCREASING.VERSION 178713 . 179710) (
+FB.DECREASING.NUMERIC.ATTR 179712 . 180392) (FB.INCREASING.NUMERIC.ATTR 180394 . 181068) (
+FB.ALPHABETIC.ATTR 181070 . 181756)) (181759 191601 (FB.SORTCOMMAND 181769 . 188599) (
+FB.INSERT.SUBDIRECTORIES 188601 . 189398) (FB.GET.SORT.MENU 189400 . 191599)) (191602 207691 (
+FB.EXPUNGECOMMAND 191612 . 194131) (FB.NEWPATTERNCOMMAND 194133 . 194531) (FB.NEWINFOCOMMAND 194533 . 
+197299) (FB.DEPTHCOMMAND 197301 . 199076) (FB.SHAPECOMMAND 199078 . 202420) (FB.REMOVE.FILE 202422 . 
+204243) (FB.COUNT.FILE.CHANGE 204245 . 205690) (FB.SETNEWPATTERN 205692 . 206862) (FB.GET.NEWPATTERN 
+206864 . 207448) (FB.OPTIONSCOMMAND 207450 . 207689)) (207726 208713 (FB.GETWINDOW 207736 . 208711)) (
+208714 209726 (FB.INFOMENU.SHADEINITIALSELECTIONS 208724 . 209371) (FB.INFO.ITEM.NAMED 209373 . 209724
+)) (209727 219193 (FB.MAKECOUNTERWINDOW 209737 . 211199) (FB.COUNTERW.REDISPLAYFN 211201 . 211788) (
+FB.UPDATE.COUNTERS 211790 . 213862) (FB.DISPLAY.COUNTERS 213864 . 218924) (FB.COUNTER.STRING 218926 . 
+219191)) (219194 223837 (FB.MAKEHEADINGWINDOW 219204 . 220752) (FB.HEADINGW.REDISPLAYFN 220754 . 
+221020) (FB.HEADINGW.RESHAPEFN 221022 . 221398) (FB.HEADINGW.DISPLAY 221400 . 223835)) (223838 228021 
+(FB.ICONFN 223848 . 224195) (FB.INFOMENU.WHENSELECTEDFN 224197 . 224927) (FB.CLOSEFN 224929 . 226132) 
+(FB.EXPUNGE?.MENU 226134 . 226546) (FB.AFTERCLOSEFN 226548 . 226909) (FB.CLOSE&EXPUNGE 226911 . 228019
+)) (228022 240080 (FB.HARDCOPY.DIRECTORY 228032 . 238389) (FB.HARDCOPY.PRINT.TITLE 238391 . 238717) (
+FB.HARDCOPY.MAXWIDTH 238719 . 240078)))))
 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/TEDITWINDOW

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "12-Oct-2021 15:10:06" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;16
 187619 
+
(FILECREATED "16-Oct-2021 18:52:11" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18
 187780 
 
-      changes to%:  (FNS \TEDIT.BUTTONEVENTFN)
+      changes to%:  (FNS TEDIT.DEACTIVATE.WINDOW)
 
-      previous date%: "12-Oct-2021 15:01:30" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;15)
+      previous date%: "12-Oct-2021 15:10:06" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;17)
 
 
 (* ; "
@@ -1703,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))
 
@@ -1729,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.")

@@ -2854,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 (7288 94104 (TEDIT.CREATEW 7298 . 8434) (\TEDIT.CREATEW.FROM.REGION 8436 . 9420) (
-TEDIT.CURSORMOVEDFN 9422 . 20808) (TEDIT.CURSOROUTFN 20810 . 21345) (TEDIT.WINDOW.SETUP 21347 . 23156)
- (TEDIT.MINIMAL.WINDOW.SETUP 23158 . 30947) (\TEDIT.ACTIVE.WINDOWP 30949 . 31930) (
-\TEDIT.BUTTONEVENTFN 31932 . 56922) (\TEDIT.WINDOW.OPS 56924 . 60885) (\TEDIT.EXPANDFN 60887 . 61290) 
-(\TEDIT.MAINW 61292 . 62581) (\TEDIT.PRIMARYW 62583 . 63795) (\TEDIT.COPYINSERTFN 63797 . 64768) (
-\TEDIT.NEWREGIONFN 64770 . 67237) (\TEDIT.SET.WINDOW.EXTENT 67239 . 73341) (\TEDIT.SHRINK.ICONCREATE 
-73343 . 75615) (\TEDIT.SHRINKFN 75617 . 76192) (\TEDIT.SPLITW 76194 . 82295) (\TEDIT.UNSPLITW 82297 . 
-87991) (\TEDIT.WINDOW.SETUP 87993 . 93713) (\SAFE.FIRST 93715 . 94102)) (95434 96341 (TEDITWINDOWP 
-95444 . 96339)) (96378 98874 (TEDIT.GETINPUT 96388 . 98371) (\TEDIT.MAKEFILENAME 98373 . 98872)) (
-98923 105374 (TEDIT.PROMPTPRINT 98933 . 101837) (TEDIT.PROMPTFLASH 101839 . 103794) (
-\TEDIT.PROMPT.PAGEFULLFN 103796 . 105372)) (105609 109671 (TEXTSTREAM.TITLE 105619 . 106240) (
-\TEDIT.ORIGINAL.WINDOW.TITLE 106242 . 108287) (\TEDIT.WINDOW.TITLE 108289 . 108959) (
-\TEXTSTREAM.FILENAME 108961 . 109669)) (109714 154455 (TEDIT.DEACTIVATE.WINDOW 109724 . 116873) (
-\TEDIT.REPAINTFN 116875 . 119732) (\TEDIT.RESHAPEFN 119734 . 125354) (\TEDIT.SCROLLFN 125356 . 154453)
-) (154497 156546 (\TEDIT.PROCIDLEFN 154507 . 155856) (\TEDIT.PROCENTRYFN 155858 . 156151) (
-\TEDIT.PROCEXITFN 156153 . 156544)) (156625 167625 (\EDIT.DOWNCARET 156635 . 157316) (\EDIT.FLIPCARET 
-157318 . 158853) (TEDIT.FLASHCARET 158855 . 159969) (\EDIT.UPCARET 159971 . 160424) (
-TEDIT.NORMALIZECARET 160426 . 166377) (\SETCARET 166379 . 167299) (\TEDIT.CARET 167301 . 167623)) (
-167659 181414 (TEDIT.ADD.MENUITEM 167669 . 169584) (TEDIT.DEFAULT.MENUFN 169586 . 178853) (
-TEDIT.REMOVE.MENUITEM 178855 . 179856) (\TEDIT.CREATEMENU 179858 . 180311) (\TEDIT.MENU.WHENHELDFN 
-180313 . 181083) (\TEDIT.MENU.WHENSELECTEDFN 181085 . 181412)))))
+  (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

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/MODERNIZE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "12-Oct-2021 14:57:29" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;28
 25303  
+
(FILECREATED "16-Oct-2021 15:42:11" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41
 30305  
 
-      changes to%:  (FNS MODERNWINDOW.BUTTONEVENTFN \MODERNIZED.TEDIT.BUTTONEVENTFN)
+      changes to%:  (FNS MODERNIZED.TB.BUTTONEVENTFN)
 
-      previous date%: "12-Oct-2021 08:34:48" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;26)
+      previous date%: "16-Oct-2021 15:29:38" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
@@ -15,7 +15,8 @@
        [
         (* ;; "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")

@@ -25,6 +26,7 @@
               (* ;; "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")

 
@@ -44,9 +46,10 @@
                                                  (* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
                                                  (MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
                                                  
-                                                 (* ;; "Freemenu")

+                                                 (* ;; "File browser")

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

 
@@ -69,9 +72,10 @@
                                                  (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")

 
@@ -190,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)
@@ -201,27 +216,49 @@
 (DEFINEQ
 
 (MODERNWINDOW.BUTTONEVENTFN

-  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION)

-                                                            (* ; "Edited 12-Oct-2021 14:56 by rmk:")

+  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)

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

 
-    (* ;; "CORNERREGION is the region that determines the identification of corner and title clicks, presumably excludes uninteresting menus and other attachments that would also be part of the moving and reshaping region (the ATTACHEDREGION below).")

+    (* ;; "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.")

 
-    (if
 (AND (MOUSESTATE (ONLY LEFT))
-                 (EQ LASTKEYBOARD 0))
-        then
 (TOTOPW WINDOW)
-              (CL:UNLESS CORNERREGION                        (* ; 
-
                                                         "Could cover a bunch of Tedit split-panes")

-                  (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION)))
-              (LET [CORNER TOPMARGIN (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW]
+    (* ;; "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.")

+
+    (* ;; "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. .")

+
+    (* ;; "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. ")

+
+    (* ;; "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.")

+
+    (LET (CORNER ATTACHEDREGION)
+         (IF
 CORNERREGION
+             THEN
 
+
+                   (* ;; "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 TOPMARGIN (if
 (WINDOWPROP WINDOW 'TOPMARGIN)
-                                     elseif
 (WINDOWPROP WINDOW 'TITLE)
-                                       then
 (FONTPROP WindowTitleDisplayStream 'HEIGHT)
-                                     else
 MODERN-WINDOW-MARGIN))
                    (SETQ CORNER (INCORNER.REGION
 CORNERREGION TOPMARGIN))
                    (if
 CORNER
                        then
 
@@ -262,31 +299,28 @@
                                          STARTINGREGION))
                              T
                      elseif
 (OR ANYWHERE (NEARTOP
 CORNERREGION TOPMARGIN TITLEPROPORTION))
-                       then
 
-
-                             (* ;; "")

-
-                             (NEARESTCORNER
 ATTACHEDREGION)
+                       then
 (NEARESTCORNER
 ATTACHEDREGION)
                              (MOVEW (CENTRALWINDOW WINDOW))
                              T
                      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])
 
@@ -308,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])
 )
 
@@ -388,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])
+)
 
 
 
@@ -420,17 +492,19 @@
                TEDIT.READTABLE))])
 
 (\MODERNIZED.TEDIT.BUTTONEVENTFN

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

+  [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)
+           NIL NIL [APPLY (FUNCTION UNIONREGIONS)
                           (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE
                                                                                 'REGION)
-                             repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN])
+                             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:")

@@ -463,10 +537,10 @@
 (MODERNWINDOW.SETUP
 'ICMLARRAY.TITLECOMMANDFN)
 
 
-(* ;; "Freemenu")

+(* ;; "File browser")

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

@@ -500,10 +574,10 @@
                          'WINDOW))
 
 
-(* ;; "Table browser (for filebrowser)")

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

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

@@ -538,10 +612,12 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4845 10473 (MODERNWINDOW 4855 . 6310) (MODERNWINDOW.SETUP 6312 . 9261) (UNMODERNWINDOW 
-9263 . 9657) (MODERNWINDOW.UNSETUP 9659 . 10471)) (10538 18976 (MODERNWINDOW.BUTTONEVENTFN 10548 . 
-15873) (NEARTOP 15875 . 16795) (NEARESTCORNER 16797 . 17676) (INCORNER.REGION 17678 . 18974)) (19034 
-21356 (MODERN-ADD-EXEC 19044 . 19475) (MODERN-SNAPW 19477 . 20020) (TOTOPW.MODERNIZE 20022 . 20450) (
-MODERN-MENUBUTTONFN 20452 . 21354)) (21397 23609 (TEDIT.MODERNIZE 21407 . 22221) (
-\MODERNIZED.TEDIT.BUTTONEVENTFN 22223 . 23278) (TEDIT.SELECTALL 23280 . 23607)))))
+  (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/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

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "12-Oct-2021 22:31:01" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;30
 6975   
+
(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 15:22:43" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;29)
+      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)
@@ -108,7 +108,7 @@
          WINDOW])
 
 (CLOSE-TYPED-WINDOW

-  [LAMBDA (WINDOW ALL)
                                  (* ; "Edited 12-Oct-2021 22:30 by rmk:")

+  [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).")

 
@@ -120,10 +120,14 @@
                                                                            (WINDOWPROP W 'WINDOWTYPE)
                                                                            )
                                  UNLESS
 (EQ W WINDOW) DO
 (CLOSEW W))
-                   ELSE
 (CL:WHEN (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS))
+                   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))
+                                      (TTY.PROCESS T)))
                          (DSUBST (WINDOWPROP WINDOW 'REGION)
                                 WINDOW TYPED-WINDOWS)))])
     WINDOW])
@@ -143,6 +147,6 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (843 3913 (SEE-TEDIT 853 . 1263) (PF-TEDIT 1265 . 3911)) (3914 6663 (GET-TYPED-WINDOW 
-3924 . 5397) (CLOSE-TYPED-WINDOW 5399 . 6661)))))
+  (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/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.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.

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

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/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/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/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 13:52:47" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;15
 6457   
 
-      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 12:43:39" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;14)
 
 
 (* ; "
@@ -71,7 +72,7 @@ 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))
 
 (RPAQQ MAKEINITFILES
 (MAKEINIT MEM I-NEW))
 

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/IOCHAR

@@ -1,14 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "10-Aug-2020 21:44:38" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.;5
 90419  
 
-      changes to%:  (FNS FILEPOS FFILEPOS)
+
(FILECREATED "24-Oct-2021 23:57:27" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IOCHAR.;3
 90360  
 
-      previous date%: "11-Nov-2018 12:12:53" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.;4)
+      changes to%:  (VARS IOCHARCOMS)
+
+      previous date%: "24-Oct-2021 23:53:23" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IOCHAR.;2)
 
 
 (* ; "
-Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT IOCHARCOMS)
@@ -38,17 +40,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018,
                             (\MIN.SEARCH.LENGTH 100)))
               (INITRESOURCES \FFDELTA1 \FFDELTA2 \FFPATCHAR))
         [COMS 
-              (* ;; "DATE Functions")

+              (* ;; "DATE Functions")

 
               (FNS DATE DATEFORMAT GDATE IDATE \IDATESCANTOKEN \IDATE-PARSE-MONTH \OUTDATE 
                    \OUTDATE-STRING \RPLRIGHT \UNPACKDATE \PACKDATE \DTSCAN \ISDST? \CHECKDSTCHANGE)
               (OPTIMIZERS DATEFORMAT)
               
-              (* ;; "Because DST begins the FIRST weekend in April now, \BeginDST changed from 120 to 98 as of 4/3/87 (JDS)  Note: this only affects standalone users--those with time servers automatically get correct local info (bvm)")

+              (* ;; "Because DST begins the FIRST weekend in April now, \BeginDST changed from 120 to 98 as of 4/3/87 (JDS)  Note: this only affects standalone users--those with time servers automatically get correct local info (bvm)")

 
               (INITVARS (\TimeZoneComp 8)
-                     (\BeginDST 98)
-                     (\EndDST 304)
+                     (\BeginDST 74)
+                     (\EndDST 312)
                      (\DayLightSavings T))
               (ADDVARS (TIME.ZONES (8 "PST" "PDT")
                               (7 "MST" "MDT")
@@ -163,14 +165,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018,
 
 (CL:DEFUN XCL:PACK
 (NAMES &OPTIONAL (PACKAGE *PACKAGE*))
 
-(* ;;; "NAMES should be a list of symbols and strings.  A new symbol is created in the given package with a print name equal to the concatenation of the of the NAMES. ")

+(* ;;; "NAMES should be a list of symbols and strings.  A new symbol is created in the given package with a print name equal to the concatenation of the of the NAMES. ")

 
    (CL:INTERN (CONCATLIST NAMES)
           PACKAGE))
 
 (CL:DEFUN XCL:PACK*
 (&REST NAMES)
 
-(* ;;; "NAMES should be a list of symbols and strings.  A new symbol is created in the current package with a print name equal to the concatenation of the of the NAMES. ")

+(* ;;; "NAMES should be a list of symbols and strings.  A new symbol is created in the current package with a print name equal to the concatenation of the of the NAMES. ")

 
    (CL:INTERN (CONCATLIST NAMES)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -182,11 +184,11 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 2018,
 
 (PUTPROPS \CATRANSLATE
 MACRO
 (OPENLAMBDA (CABASE CASIZE CAFAT CHAR)
                                        (COND
-                                          ((ILEQ CHAR CASIZE)(* ; 
-
                                                        "If it's in the table, use the table value")

+                                          ((ILEQ CHAR CASIZE)(* ; 
+
                                                        "If it's in the table, use the table value")

                                            (\GETBASEBYTE CABASE CHAR))
-                                          (T                 (* ; 
-
                                                           "Off the end -- assume it's itself")

+                                          (T                 (* ; 
+
                                                           "Off the end -- assume it's itself")

                                              CHAR))))
 )
 )
@@ -1326,9 +1328,9 @@ DONTCOPY
 
 (RPAQ? \TimeZoneComp
 8)
 
-(RPAQ? \BeginDST
 98)
+(RPAQ? \BeginDST
 74)
 
-(RPAQ? \EndDST
 304)
+(RPAQ? \EndDST
 312)
 
 (RPAQ? \DayLightSavings
 T)
 
@@ -1372,15 +1374,15 @@ DONTCOPY
 (PUTPROPS IOCHAR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
 1991 2018 2020))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3507 7301 (CHCON 3517 . 4367) (UNPACK 4369 . 5263) (DCHCON 5265 . 6532) (DUNPACK 6534
- . 7299)) (7302 18817 (UALPHORDER 7312 . 7408) (ALPHORDER 7410 . 9213) (CONCAT 9215 . 9860) (
-CONCATCODES 9862 . 10048) (PACKC 10050 . 12653) (PACK 12655 . 13234) (PACK* 13236 . 14958) (\PACK.ITEM
- 14960 . 15415) (STRPOS 15417 . 18815)) (18819 19108 (XCL:PACK 18819 . 19108)) (19110 19360 (XCL:PACK*
- 19110 . 19360)) (20078 22469 (STRPOSL 20088 . 21714) (MAKEBITTABLE 21716 . 22467)) (22631 23108 (
-CASEARRAY 22641 . 22831) (UPPERCASEARRAY 22833 . 23106)) (23430 47032 (FILEPOS 23440 . 33352) (
-FFILEPOS 33354 . 44467) (\SETUP.FFILEPOS 44469 . 47030)) (47820 89067 (DATE 47830 . 47916) (DATEFORMAT
- 47918 . 48010) (GDATE 48012 . 48123) (IDATE 48125 . 59796) (\IDATESCANTOKEN 59798 . 61077) (
-\IDATE-PARSE-MONTH 61079 . 64775) (\OUTDATE 64777 . 77525) (\OUTDATE-STRING 77527 . 78142) (\RPLRIGHT 
-78144 . 78382) (\UNPACKDATE 78384 . 84175) (\PACKDATE 84177 . 87497) (\DTSCAN 87499 . 87641) (\ISDST? 
-87643 . 88150) (\CHECKDSTCHANGE 88152 . 89065)))))
+  (FILEMAP (NIL (3448 7242 (CHCON 3458 . 4308) (UNPACK 4310 . 5204) (DCHCON 5206 . 6473) (DUNPACK 6475
+ . 7240)) (7243 18758 (UALPHORDER 7253 . 7349) (ALPHORDER 7351 . 9154) (CONCAT 9156 . 9801) (
+CONCATCODES 9803 . 9989) (PACKC 9991 . 12594) (PACK 12596 . 13175) (PACK* 13177 . 14899) (\PACK.ITEM 
+14901 . 15356) (STRPOS 15358 . 18756)) (18760 19049 (XCL:PACK 18760 . 19049)) (19051 19301 (XCL:PACK* 
+19051 . 19301)) (20019 22410 (STRPOSL 20029 . 21655) (MAKEBITTABLE 21657 . 22408)) (22572 23049 (
+CASEARRAY 22582 . 22772) (UPPERCASEARRAY 22774 . 23047)) (23371 46973 (FILEPOS 23381 . 33293) (
+FFILEPOS 33295 . 44408) (\SETUP.FFILEPOS 44410 . 46971)) (47761 89008 (DATE 47771 . 47857) (DATEFORMAT
+ 47859 . 47951) (GDATE 47953 . 48064) (IDATE 48066 . 59737) (\IDATESCANTOKEN 59739 . 61018) (
+\IDATE-PARSE-MONTH 61020 . 64716) (\OUTDATE 64718 . 77466) (\OUTDATE-STRING 77468 . 78083) (\RPLRIGHT 
+78085 . 78323) (\UNPACKDATE 78325 . 84116) (\PACKDATE 84118 . 87438) (\DTSCAN 87440 . 87582) (\ISDST? 
+87584 . 88091) (\CHECKDSTCHANGE 88093 . 89006)))))
 STOP

sources/JAPANESE

@@ -1,18 +1,19 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED " 8-Aug-2021 13:28:16" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17
 62025  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN)
+
(FILECREATED "17-Oct-2021 13:54:52" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;18
 61702  
 
-      previous date%: " 6-Aug-2021 17:07:29" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;16)
+      changes to%:  (VARS JAPANESECOMS)
+
+      previous date%: " 8-Aug-2021 13:28:16" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17)
 
 
 (PRETTYCOMPRINT JAPANESECOMS)
 
 (RPAQQ JAPANESECOMS

-       [                                                     (* ; "XCCS to JIS converter")

-        [COMS                                                (* ; "JIS to XCCS conversion table.")

+       [                                                     (* ; "XCCS to JIS converter")

+        [COMS                                                (* ; "JIS to XCCS conversion table.")

               (VARS *JIS-TO-XCCS-CONV-NO-FONT-TABLE* *JIS-TO-XCCS-CODE-MAP* 
                     *HANKAKU-TO-ZENKAKU-CODE-MAP*)
               (GLOBALVARS *JIS-TO-XCCS-CONV-NO-FONT-TABLE* *JIS-TO-XCCS-CONV-TABLE-LIST* 
@@ -22,29 +23,28 @@
                      *HANKAKU-TO-ZENKAKU-CONV-TABLE* *ZENKAKU-TO-HANKAKU-CONV-TABLE*)
               (FNS \MAKE.JIS.TO.XCCS.CONV.TABLE)
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAKE.JIS.TO.XCCS.CONV.TABLE]
-        (DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS)))
+        (DECLARE%: DOEVAL@COMPILE DONTCOPY (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS))
         (FNS \JISIN \JISPEEK \BACKJISCCODE \SHIFTJISIN \SHIFTJISPEEK \BACKSHIFTJISCCODE \EUCIN 
              \EUCPEEK \BACKEUCCODE)
         (FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN)
-        [COMS (FNS CONVHANKAKU)
-              (DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.XCCS.TO.JIS 
-                                                                \DO.CONV.XCCS.TO.JIS \ASCIIP 
-                                                                \NOT.EQUIVALENT.TO.JIS 
-                                                                \CONV.HANKAKU.TO.ZENKAKUP 
-                                                                \CONV.ZENKAKU.KANA]
+        (COMS (FNS CONVHANKAKU)
+              (DECLARE%: DOEVAL@COMPILE DONTCOPY (MACROS \CONV.XCCS.TO.JIS \DO.CONV.XCCS.TO.JIS 
+                                                        \ASCIIP \NOT.EQUIVALENT.TO.JIS 
+                                                        \CONV.HANKAKU.TO.ZENKAKUP \CONV.ZENKAKU.KANA)
+                     ))
         (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
-               (* ;; "JIS specific macro")

+               (* ;; "JIS specific macro")

 
                (MACROS \EXTRACT.NO.FONT.CODE \EXTARACT.CONV.TABLE \NOT.EQUIVALENT.TO.XCCS 
                       \EXTRACT.SET \EXTRACT.CODE \CHNAGE.KI.MODE \KIMODEP \HANKAKUP \KANJIP 
                       \NOTGAIJIP \INVALID.TENP \CONV.HANKAKU.KANA \OUTKI \OUTKO)
                
-               (* ;; "Shift-JIS specific macro")

+               (* ;; "Shift-JIS specific macro")

 
                (MACROS \CONV.SJIS.TO.JIS \CONV.JIS.TO.SJIS \SJIS.KANJI.FIRST.BYTEP)
                
-               (* ;; "EUC specific macro")

+               (* ;; "EUC specific macro")

 
                (MACROS \EUC.KANJI.FIRST.BYTEP \GAIJIP \EUC.HANKAKUP))
         (FNS \CREATE.JIS.EXTERNALFORMAT \CREATE.SHIFTJIS.EXTERNALFORMAT \CREATE.EUC.EXTERNALFORMAT)
@@ -449,11 +449,11 @@
 (\MAKE.JIS.TO.XCCS.CONV.TABLE
)
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
-(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
+(DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS \CONV.JIS.TO.XCCS
 MACRO
 [OPENLAMBDA (KU TEN)
 
-(* ;;; "Some character code is not equivalent between JIS and XCCS.  In such case, we have to convert the character to corresponding XCCS.")

+(* ;;; "Some character code is not equivalent between JIS and XCCS.  In such case, we have to convert the character to corresponding XCCS.")

 
                                             (COND
                                                ((\NOT.EQUIVALENT.TO.XCCS KU)
@@ -464,13 +464,13 @@
 (PUTPROPS \DO.CONV.JIS.TO.XCCS
 MACRO

           [(KU TEN)
 
-(* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")

+(* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")

 
            (COND
               ((\INVALID.TENP TEN)
                *DEFAULT-NOT-CONVERTED-FAT-CODE*)
               (T (SELECTQ KU
-                     ((33 34 38)                             (* ; "1, 2 and 6 KU")

+                     ((33 34 38)                             (* ; "1, 2 and 6 KU")

                           [LET* ((CONVTABLE (\EXTARACT.CONV.TABLE KU))
                                  (SET (\EXTRACT.SET TEN CONVTABLE))
                                  (CODE (\EXTRACT.CODE TEN CONVTABLE)))
@@ -479,41 +479,38 @@
                                     (LOGOR (UNFOLD SET 256)
                                            CODE))
                                    (T (COND
-                                         ((EQ CODE 255)      (* ; "Not defined in JIS.")

+                                         ((EQ CODE 255)      (* ; "Not defined in JIS.")

                                           *DEFAULT-NOT-CONVERTED-FAT-CODE*)
-                                         (T                  (* ; 
-
       "Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.")

+                                         (T                  (* ; 
+
       "Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.")

                                             (COND
                                                (*REPLACE-NO-FONT-CODE* 
                                                       *DEFAULT-NOT-CONVERTED-FAT-CODE*)
                                                (T (\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 256)
                                                                                 TEN])
-                     (35                                     (* ; "3 KU")

-                                                             (* ; 
-
                                "Alpha numeric codes are all defined as single byte codes in XCCS.")

+                     (35                                     (* ; "3 KU")

+                                                             (* ; 
+
                                "Alpha numeric codes are all defined as single byte codes in XCCS.")

                          TEN)
-                     (40                                     (* ; "8 KU")

+                     (40                                     (* ; "8 KU")

                          (COND
                             [(< 0 TEN 33)
                              (COND
                                 (*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*)
                                 (T (\EXTRACT.NO.FONT.CODE (LOGOR KU TEN]
                             (T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
-                     (116                                    (* ; "84 KU")

+                     (116                                    (* ; "84 KU")

                           (COND
                              ((< 0 TEN 5)
                               (LOGOR 29952 TEN))
                              (T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
-                     (117                                    (* ; "85 KU")

+                     (117                                    (* ; "85 KU")

                           (COND
                              ((< 0 TEN 28)
                               (LOGOR 29696 TEN))
                              (T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
                      *DEFAULT-NOT-CONVERTED-FAT-CODE*])
 )
-
-(* "END EXPORTED DEFINITIONS")
-
 )
 (DEFINEQ
 
@@ -1055,11 +1052,11 @@
                     (ARG ARGS 2))))])
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
-(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
+(DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS \CONV.XCCS.TO.JIS
 MACRO
 (OPENLAMBDA (OUTSTREAM CC)
 
-(* ;;; "Returns JIS code corresponding to XCCS charcode.  Handle HANKAKU as well as ZENKAKU.  If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so.  Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode.")

+(* ;;; "Returns JIS code corresponding to XCCS charcode.  Handle HANKAKU as well as ZENKAKU.  If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so.  Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode.")

 
                                             (OR (COND
                                                    ((\ASCIIP CC)
@@ -1067,8 +1064,8 @@
                                                    ((\NOT.EQUIVALENT.TO.JIS CC)
                                                     (\DO.CONV.XCCS.TO.JIS CC))
                                                    ((\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM)
-                                                             (* ; 
-
                          "ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.")

+                                                             (* ; 
+
                          "ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.")

                                                     (\CONV.ZENKAKU.KANA CC))
                                                    (T CC))
                                                 CC)))
@@ -1104,9 +1101,6 @@
 (PUTPROPS \CONV.ZENKAKU.KANA
 MACRO
 ((CHAR)
                                             (GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*)))
 )
-
-(* "END EXPORTED DEFINITIONS")
-
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -1120,7 +1114,7 @@
 
 (PUTPROPS \NOT.EQUIVALENT.TO.XCCS
 MACRO
 ((KU)
 
-(* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU.  Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here.")

+(* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU.  Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here.")

 
                                                  (OR (EQ KU 33)
                                                      (EQ KU 34)
@@ -1141,8 +1135,8 @@
 
 (PUTPROPS \CHNAGE.KI.MODE
 MACRO
 [OPENLAMBDA (ST INPUTFLG ENTERP)
 
-(* ;;; 
-
"INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.")

+(* ;;; 
+
"INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.")

 
                                           (COND
                                              [INPUTFLG (COND
@@ -1161,7 +1155,7 @@
 
 (PUTPROPS \KIMODEP
 MACRO
 [OPENLAMBDA (ST INPUTFLG)
 
-(* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.")

+(* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.")

 
                                    (COND
                                       [INPUTFLG (ffetch
 (STREAM IN.KANJIIN)
@@ -1201,7 +1195,7 @@
 
 (PUTPROPS \CONV.SJIS.TO.JIS
 MACRO
 [OPENLAMBDA (HI LO)
 
-(* ;;; "Convert Shift-JIS to JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively.")

+(* ;;; "Convert Shift-JIS to JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively.")

 
                                             [SETQ CH1 (IDIFFERENCE HI (COND
                                                                          ((> HI 159)
@@ -1220,7 +1214,7 @@
 
 (PUTPROPS \CONV.JIS.TO.SJIS
 MACRO
 [OPENLAMBDA (HI LO)
 
-(* ;;; "Convert JIS to Shift-JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively.")

+(* ;;; "Convert JIS to Shift-JIS.  The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively.")

 
                                             [SETQ CH2 (COND
                                                          ((ODDP HI)
@@ -1313,11 +1307,11 @@
 (ADDTOVAR LAMA
 CONVHANKAKU)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10976 16192 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10986 . 16190)) (19836 45193 (\JISIN 19846 . 
-26482) (\JISPEEK 26484 . 33110) (\BACKJISCCODE 33112 . 33652) (\SHIFTJISIN 33654 . 35046) (
-\SHIFTJISPEEK 35048 . 37154) (\BACKSHIFTJISCCODE 37156 . 37742) (\EUCIN 37744 . 39447) (\EUCPEEK 39449
- . 43028) (\BACKEUCCODE 43030 . 45191)) (45194 49042 (\JISOUTCHARFN 45204 . 46614) (\SHIFTJISOUTCHARFN
- 46616 . 47716) (\EUCOUTCHARFN 47718 . 49040)) (49043 49362 (CONVHANKAKU 49053 . 49360)) (60086 61580 
-(\CREATE.JIS.EXTERNALFORMAT 60096 . 60484) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60486 . 61189) (
-\CREATE.EUC.EXTERNALFORMAT 61191 . 61578)))))
+  (FILEMAP (NIL (10791 16007 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10801 . 16005)) (19582 44939 (\JISIN 19592 . 
+26228) (\JISPEEK 26230 . 32856) (\BACKJISCCODE 32858 . 33398) (\SHIFTJISIN 33400 . 34792) (
+\SHIFTJISPEEK 34794 . 36900) (\BACKSHIFTJISCCODE 36902 . 37488) (\EUCIN 37490 . 39193) (\EUCPEEK 39195
+ . 42774) (\BACKEUCCODE 42776 . 44937)) (44940 48788 (\JISOUTCHARFN 44950 . 46360) (\SHIFTJISOUTCHARFN
+ 46362 . 47462) (\EUCOUTCHARFN 47464 . 48786)) (48789 49108 (CONVHANKAKU 48799 . 49106)) (59763 61257 
+(\CREATE.JIS.EXTERNALFORMAT 59773 . 60161) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60163 . 60866) (
+\CREATE.EUC.EXTERNALFORMAT 60868 . 61255)))))
 STOP

sources/LLPACKAGE

@@ -1,13 +1,14 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
-
(IL:FILECREATED "22-Sep-92 11:47:31" "{Pele:mv:envos}<LispCore>Sources>LLPACKAGE.;25"
 82127  
+(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
 
-      IL:|changes| IL:|to:|  (IL:FUNCTIONS IL:ADD-SYMBOL)
+
(IL:FILECREATED "24-Oct-2021 10:20:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;4|
 82444  
 
-      IL:|previous| IL:|date:| "20-May-91 13:07:32" "{Pele:mv:envos}<LispCore>Sources>LLPACKAGE.;24"
+      IL:|changes| IL:|to:|  (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL IL:FIND-SYMBOL*)
+
+      IL:|previous| IL:|date:| "22-Sep-92 11:47:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;1|
 )
 
 
-; Copyright (c) 1986, 1987, 1990, 1991, 1992 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1986-1987, 1990-1992 by Venue & Xerox Corporation.
 
 (IL:PRETTYCOMPRINT IL:LLPACKAGECOMS)
 
@@ -524,9 +525,7 @@
                PACKAGE)))
 (IL:DEFINEQ
 
-(xcl:defpackage

-(il:nlambda il:args (il:* il:\; "Edited  2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package)))
-)
+(xcl:defpackage

 (il:nlambda il:args (il:* il:\; "Edited  2-Dec-87 10:39 by raf") (il:setq il:args (xcl:remove-comments il:args)) (let ((package (find-package (car il:args)))) (cond ((packagep package) (il:* il:\; "If one already exists, test compatability of package definitions") (il:|for| il:option il:|in| (cdr il:args) il:|do| (let* ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:internal-symbols :external-symbols) nil) (:external-only (if (not (%package-external-only package)) (il:error "Package NOT :external-only as asserted by defpackage: " package))) (:prefix-name (setf (%package-namesymbol package) (make-symbol (car values)))) (:use (use-package values package)) (:nicknames (il:enter-new-nicknames package values)) (:export (export (il:for il:symbol il:in values il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import values package)) ((:shadow :shadowing-import) (let ((il:symbols-to-shadow (il:mapconc values (il:function (il:lambda (symbol) (cond ((not (il:memb symbol (%package-shadowing-symbols package))) (list symbol)))))))) (il:selectq il:key (:shadow (shadow il:symbols-to-shadow package)) (:shadowing-import (shadowing-import il:symbols-to-shadow package)) nil))) (il:error "Bad keyword for defpackage " il:key))))) (t (il:* il:\; "Otherwise, make a new package to spec") (let ((il:post-make-forms nil)) (il:setq package (il:apply (quote make-package) (cons (car il:args) (il:|for| il:option il:|in| (cdr il:args) il:|join| (let ((il:key (cond ((keywordp il:option) il:option) ((il:listp il:option) (car il:option)) (t (il:error "Bad option for defpackage " il:option)))) (values (cond ((keywordp il:option) (list t)) ((il:listp il:option) (cdr il:option)) (t (il:error "Bad option for defpackage " il:option))))) (il:selectq il:key ((:use :nicknames) (list il:key (il:|if| (car values) il:|then| values il:|else| (il:* il:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.") nil))) ((:prefix-name :internal-symbols :external-symbols :external-only) (list il:key (car values))) ((:shadow :export :import :shadowing-import) (il:setq il:post-make-forms (cons (cons il:key values) il:post-make-forms)) nil) (il:error "Bad keyword for defpackage " il:key))))))) (il:mapc il:post-make-forms (il:function (il:lambda (il:form) (il:selectq (car il:form) (:shadow (shadow (cdr il:form) package)) (:export (export (il:for il:symbol il:in (cdr il:form) il:collect (il:if (il:litatom il:symbol) il:then il:symbol il:elseif (il:stringp il:symbol) il:then (intern il:symbol package) il:else (il:error "Bad object in :export option of defpackage " il:symbol))) package)) (:import (import (cdr il:form) package)) (:shadowing-import (shadowing-import (cdr il:form) package)) (il:shouldnt "Bogus form on post-make-forms")))))))) (package-name package)))
 )
 )
@@ -1033,7 +1032,7 @@
                       (T (IL:ADD-SYMBOL
 (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
                                 SYMBOL)))
                    (VALUES SYMBOL NIL)))))
-   "Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list."
+
 (DEFUN IL:FIND-SYMBOL*
 (IL:BASE IL:OFFSET IL:LENGTH IL:FATP PACKAGE)
                                                              (IL:* IL:\; "Check internal and external symbols, then scan down the list of hashtables for inherited symbols. When an inherited symbol is found pull that table to the beginning of the list.")

 
@@ -1042,10 +1041,11 @@
    (LET* ((IL:HASH (IL:SYMBOL-HASH
 IL:BASE IL:OFFSET IL:LENGTH IL:FATP))
           (IL:EHASH (IL:ENTRY-HASH
 IL:LENGTH IL:HASH))
           (IL:RESULT (IL:\\CREATECELL IL:\\FIXP))
-             (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
-                                                         IL:BASE IL:OFFSET IL:LENGTH IL:FATP
-                                                         (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
-                                                         IL:RESULT))
+          IL:SYM IL:WHERE (IL:DONE))
+         (UNLESS (%PACKAGE-EXTERNAL-ONLY PACKAGE)
+             (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
+                                                               IL:LENGTH IL:FATP (
+                                                                            %PACKAGE-INTERNAL-SYMBOLS
                                                                                   PACKAGE)
                                                                IL:RESULT))
                                         (COND
@@ -1061,10 +1061,11 @@
 
                             "Was (cl:return-from find-symbol* (cl:values cl:symbol :internal))")

 
                                (IL:SETQ IL:WHERE :INTERNAL)
-             (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
-                                                         IL:BASE IL:OFFSET IL:LENGTH IL:FATP
-                                                         (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
-                                                         IL:RESULT))
+                               (IL:SETQ IL:DONE T)))))
+         (UNLESS IL:DONE
+             (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET
+                                                               IL:LENGTH IL:FATP (
+                                                                            %PACKAGE-EXTERNAL-SYMBOLS
                                                                                   PACKAGE)
                                                                IL:RESULT))
                                         (COND
@@ -1087,10 +1088,10 @@
                   (DO ((IL:PREV IL:HEAD IL:TABLE)
                        (IL:TABLE (CDR IL:HEAD)
                               (CDR IL:TABLE)))
-                    (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
-                                                                IL:BASE IL:OFFSET IL:LENGTH IL:FATP
-                                                                (CAR IL:TABLE)
-                                                                IL:RESULT))
+                      ((OR IL:DONE (NULL IL:TABLE))
+                       (VALUES NIL NIL))
+                    (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE 
+                                                                      IL:OFFSET IL:LENGTH IL:FATP
                                                                       (CAR IL:TABLE)
                                                                       IL:RESULT))
                                                (COND
@@ -1518,11 +1519,11 @@
           (IL:FATP (IL:|ffetch|
 (IL:STRINGP IL:FATSTRINGP) IL:|of|
 STRING))
           (IL:HASH (IL:SYMBOL-HASH
 IL:BASE IL:OFFSET IL:LENGTH IL:FATP))
           (IL:EHASH (IL:ENTRY-HASH
 IL:LENGTH IL:HASH))
-         (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM ((IL:OPCODES IL:SUBRCALL 145 6)
-                                                     IL:BASE IL:OFFSET IL:LENGTH IL:FATP (
+          (IL:RESULT (IL:\\CREATECELL IL:\\FIXP))
+          IL:SYM)
          (IL:NEW-SYMBOL-CODE (PROGN (IL:SETQ IL:SYM (IL:SUBRCALL IL:WITH-SYMBOL IL:BASE IL:OFFSET 
-                                                                                          PACKAGE)
-                                                     IL:RESULT))
+                                                           IL:LENGTH IL:FATP (
+                                                                            %PACKAGE-EXTERNAL-SYMBOLS
                                                                               PACKAGE)
                                                            IL:RESULT))
                                     (VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1))))
@@ -1563,5 +1564,30 @@
 
 (IL:ADDTOVAR IL:LAMA
 )
 )
-  (IL:FILEMAP (NIL (25052 28345 (XCL:DEFPACKAGE 25065 . 28343)))))
+(IL:PUTPROPS IL:LLPACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992))
+(IL:DECLARE\: IL:DONTCOPY
+  (IL:FILEMAP (NIL (9779 10219 (IL:\\UPCASEBASE 9779 . 10219)) (10221 11342 (IL:APROPOS-SEARCH 10221 . 
+11342)) (12882 12964 (PACKAGE-NAME 12882 . 12964)) (12966 13058 (PACKAGE-NICKNAMES 12966 . 13058)) (
+13060 13168 (PACKAGE-SHADOWING-SYMBOLS 13060 . 13168)) (13170 13260 (PACKAGE-USE-LIST 13170 . 13260)) 
+(13262 13360 (PACKAGE-USED-BY-LIST 13262 . 13360)) (13362 14517 (IL:MAKE-PACKAGE-HASHTABLE 13362 . 
+14517)) (14519 14681 (PRINT-PACKAGE 14519 . 14681)) (14683 15074 (PRINT-PACKAGE-HASHTABLE 14683 . 
+15074)) (16142 16923 (MAKE-SYMBOL 16142 . 16923)) (18034 18444 (IL:\\PKG-FIND-FREE-PACKAGE-INDEX 18034
+ . 18444)) (18501 18647 (IL:SETF-SYMBOL-PACKAGE 18501 . 18647)) (18649 18741 (SYMBOL-PACKAGE 18649 . 
+18741)) (21512 21684 (IL:INTERNAL-SYMBOL-COUNT 21512 . 21684)) (21686 21804 (IL:EXTERNAL-SYMBOL-COUNT 
+21686 . 21804)) (21806 22962 (IL:ENTER-NEW-NICKNAMES 21806 . 22962)) (22964 23390 (
+IL:MAKE-PRIME-HASHTABLE-SIZE 22964 . 23390)) (23392 25061 (MAKE-PACKAGE 23392 . 25061)) (25062 28355 (
+XCL:DEFPACKAGE 25075 . 28353)) (28404 28626 (FIND-PACKAGE 28404 . 28626)) (28628 31966 (USE-PACKAGE 
+28628 . 31966)) (31968 32448 (IN-PACKAGE 31968 . 32448)) (32450 32724 (XCL:PKG-GOTO 32450 . 32724)) (
+32726 33826 (RENAME-PACKAGE 32726 . 33826)) (33828 35279 (XCL:DELETE-PACKAGE 33828 . 35279)) (35281 
+38227 (EXPORT 35281 . 38227)) (38229 39472 (UNEXPORT 38229 . 39472)) (39474 41118 (IMPORT 39474 . 
+41118)) (41120 42398 (SHADOWING-IMPORT 41120 . 42398)) (42400 43454 (SHADOW 42400 . 43454)) (43456 
+44111 (UNUSE-PACKAGE 43456 . 44111)) (44175 44481 (LIST-ALL-PACKAGES 44175 . 44481)) (44538 48313 (
+IL:ADD-SYMBOL 44538 . 48313)) (52637 53940 (IL:INTERN* 52637 . 53940)) (53942 59790 (IL:FIND-SYMBOL* 
+53942 . 59790)) (59792 61243 (INTERN 59792 . 61243)) (61245 61823 (FIND-SYMBOL 61245 . 61823)) (61881 
+62781 (IL:NUKE-SYMBOL 61881 . 62781)) (62783 64903 (UNINTERN 62783 . 64903)) (64905 66048 (
+IL:MOBY-UNINTERN 64905 . 66048)) (66107 66179 (IL:\\INDEXATOMPNAME 66107 . 66179)) (66291 66438 (
+IL:MAKE-DO-SYMBOLS-VARS 66291 . 66438)) (66440 67895 (IL:MAKE-DO-SYMBOLS-CODE 66440 . 67895)) (75495 
+76020 (FIND-ALL-SYMBOLS 75495 . 76020)) (76022 76301 (IL:BRIEFLY-DESCRIBE-SYMBOL 76022 . 76301)) (
+76303 77817 (APROPOS 76303 . 77817)) (77819 79476 (APROPOS-LIST 77819 . 79476)) (79580 81153 (
+IL:FIND-EXTERNAL-SYMBOL 79580 . 81153)) (81155 81675 (IL:FIND-EXACT-SYMBOL 81155 . 81675)) (81677 
 81757 (IL:PACKAGE-NAME-AS-SYMBOL 81677 . 81757)) (81759 81908 (IL:\\FIND.PACKAGE.INTERNAL 81759 . 

sources/MAIKOBITBLT

@@ -1,28 +1,31 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "25-Feb-94 16:50:33" |{DSK}<users>nilsson>mnw>MAIKOBITBLT.;1|
 8778   
 
-      |changes| |to:|  (VARS MAIKOBITBLTCOMS)
+
(FILECREATED "26-Oct-2021 10:52:24" |{DSK}<home>larry>medley>sources>MAIKOBITBLT.;2|
 9691   
 
-      |previous| |date:| "14-Jun-90 16:57:27" |{DSK}<king>export>lispcore>sources>MAIKOBITBLT.;1|)
+      |changes| |to:|  (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR 
+                            \\MAIKO.BITBLT.BITMAP \\MAIKO.BLTSHADE.BITMAP)
+
+      |previous| |date:| "24-Oct-2021 10:31:31" |{DSK}<home>larry>medley>sources>MAIKOBITBLT.;1|)
 
 
-; Copyright (c) 1988, 1989, 1990, 1994 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1988-1990, 1994 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT MAIKOBITBLTCOMS)
 
-(RPAQQ MAIKOBITBLTCOMS
 (
-                            (* |;;| "this file has some optimizations for BITBLT on MAIKO; while PILOTBITBLT opcode still works, these functions directly implement some higher level operations")

+(RPAQQ MAIKOBITBLTCOMS

+       (
+        (* |;;| "this file has some optimizations for BITBLT on MAIKO; while PILOTBITBLT opcode still works, these functions directly implement some higher level operations")

 
-                            (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR 
-                                 \\MAIKO.BITBLT.BITMAP \\MAIKO.BLTSHADE.BITMAP)
-                            
-                            (* |;;| "Save the old \\BITBLT.BITMAP, because it handles the OPERATION - MERGE  case, where the C code doesn't.")

+        (FNS \\MAIKO.BITBLTSUB \\MAIKO.BLTCHAR \\MAIKO.PUNTBLTCHAR \\MAIKO.BITBLT.BITMAP 
+             \\MAIKO.BLTSHADE.BITMAP)
+        
+        (* |;;| "Save the old \\BITBLT.BITMAP, because it handles the OPERATION - MERGE  case, where the C code doesn't.")

 
-                            (P (MOVD '\\BITBLT.BITMAP '\\MAIKO.OLDBITBLT.BITMAP))
-                            (ADDVARS (\\MAIKO.MOVDS (\\MAIKO.BLTCHAR \\MEDW.BLTCHAR)
-                                            (\\MAIKO.BITBLTSUB \\BITBLTSUB)
-                                            (\\MAIKO.BITBLT.BITMAP \\BITBLT.BITMAP)
-                                            (\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP)))))
+        (P (MOVD '\\BITBLT.BITMAP '\\MAIKO.OLDBITBLT.BITMAP))
+        (ADDVARS (\\MAIKO.MOVDS (\\MAIKO.BLTCHAR \\MEDW.BLTCHAR)
+                        (\\MAIKO.BITBLTSUB \\BITBLTSUB)
+                        (\\MAIKO.BITBLT.BITMAP \\BITBLT.BITMAP)
+                        (\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP)))))
 
 
 
@@ -34,22 +37,28 @@
 
 (\\MAIKO.BITBLTSUB

   (LAMBDA (PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT |SourceType| 
-                 |Operation| |Texture| |WindowXOffset| |WindowYOffset|)

+                 |Operation| |Texture| |WindowXOffset| |WindowYOffset|)
+                                                             (* \; 
+
                                                           "Edited 26-Oct-2021 10:06 by larry")

                                                              (* \; "Edited 29-Jun-88 16:24 by ")

 
     (* |;;| "replaces \\BITBLTSUB on Maiko")

 
-    ((OPCODES SUBRCALL 69 13)
-     PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT |SourceType| |Operation| 
-     |Texture| |WindowXOffset| |WindowYOffset|)))
+    (SUBRCALL BITBLTSUB PILOTBBT |SourceBitMap| SLX STY |DestinationBitMap| DLX DTY HEIGHT 
+           |SourceType| |Operation| |Texture| |WindowXOffset| |WindowYOffset|)))
 
 (\\MAIKO.BLTCHAR

-  (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
-    ((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)))
 
 (\\MAIKO.PUNTBLTCHAR

-  (LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
           (* \; "Edited 29-Jun-88 16:04 by ")

+  (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")

 
@@ -63,7 +72,12 @@
               (\\CHANGECHARSET.DISPLAY DISPLAYDATA (\\CHARSET CHARCODE))))
           (COND
              ((|ffetch|
 (\\DISPLAYDATA |DDSlowPrintingCase|) |of|
 DISPLAYDATA)
-              (RETURN (\\SLOWBLTCHAR CHARCODE DISPLAYSTREAM))))
+              (RETURN (COND
+                         ((|type?|
 STREAM DISPLAYSTREAM)
+                          (\\SLOWBLTCHAR CHARCODE DISPLAYSTREAM))
+                         ((|type?|
 WINDOW DISPLAYSTREAM)
+                          (\\SLOWBLTCHAR CHARCODE (FETCH
 DSP OF
 DISPLAYSTREAM)))
+                         (T (ERROR "Not Stream or Window" DISPLAYSTREAM))))))
           (SETQ CURX (|ffetch|
 (\\DISPLAYDATA DDXPOSITION) |of|
 DISPLAYDATA))
           (SETQ RIGHT (IPLUS CURX (\\DSPGETCHARIMAGEWIDTH CHAR8CODE DISPLAYDATA)))
           (COND
@@ -107,14 +121,14 @@
                                                                                          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.BITBLT.BITMAP

   (LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM DESTBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH 
                  HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT 
-                 CLIPPEDSOURCEBOTTOM)
                    (* \; "Edited 14-Jun-90 16:47 by TS")

+                 CLIPPEDSOURCEBOTTOM)                        (* \; "Edited 14-Jun-90 16:47 by TS")

 
     (* |;;| "SUN version of \\BITBLT.BITMAP.  For all but the MERGE case, use C code.  For the MERGE case, use the old code.")

 
@@ -132,7 +146,7 @@
 
 (\\MAIKO.BLTSHADE.BITMAP

   (LAMBDA (TEXTURE DESTINATIONBITMAP DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION 
-                 CLIPPINGREGION)
                         (* \; "Edited 14-Jun-90 16:49 by TS")

+                 CLIPPINGREGION)                             (* \; "Edited 14-Jun-90 16:49 by TS")

     (DECLARE
 (LOCALVARS . T))
 
     (* |;;| "C function, bitshade_bitmap , has PUNT case \\PUNT.BLTSHADE.BITMAP(Takeshi)")

@@ -156,7 +170,7 @@
                             (\\MAIKO.BLTSHADE.BITMAP \\BLTSHADE.BITMAP))
 (PUTPROPS MAIKOBITBLT COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1994))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (1600 8233 (\\MAIKO.BITBLTSUB 1610 . 2130) (\\MAIKO.BLTCHAR 2132 . 2272) (
-\\MAIKO.PUNTBLTCHAR 2274 . 6375) (\\MAIKO.BITBLT.BITMAP 6377 . 7729) (\\MAIKO.BLTSHADE.BITMAP 7731 . 
-8231)))))
+  (FILEMAP (NIL (1500 9146 (\\MAIKO.BITBLTSUB 1510 . 2193) (\\MAIKO.BLTCHAR 2195 . 2623) (
+\\MAIKO.PUNTBLTCHAR 2625 . 7288) (\\MAIKO.BITBLT.BITMAP 7290 . 8642) (\\MAIKO.BLTSHADE.BITMAP 8644 . 
+9144)))))
 STOP

sources/MAIKOETHER

@@ -1,13 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "25-Mar-2021 09:50:57" |{DSK}<home>larry>ilisp>medley>sources>MAIKOETHER.;2|
 47411  
 
-      |changes| |to:|  (VARS MAIKOETHERCOMS \\EPT.3TO10)
-                       (FNS \\MAIKO.10MBSENDPACKET \\MAIKO.10MBWATCHER \\MAIKO.ETHERRESUME 
-                            \\MAIKO.ETHERSUSPEND \\MAIKO.INPUT.INTERRUPT \\MAIKO.10MBSTARTDRIVER 
-                            \\MAIKO.10MBTURNONETHER \\MAIKO.10MB.RESTART.ETHER \\MAIKO.CHECKSUM)
+
(FILECREATED "25-Oct-2021 15:12:33" |{DSK}<home>larry>medley>sources>MAIKOETHER.;2|
 28792  
 
-      |previous| |date:| " 4-May-91 15:52:07" |{DSK}<home>larry>ilisp>medley>sources>MAIKOETHER.;1|
-)
+      |changes| |to:|  (FNS \\DISPLAYLINE)
+                       (VARS MAIKOETHERCOMS)
+
+      |previous| |date:| "25-Mar-2021 09:50:57" |{DSK}<home>larry>medley>sources>MAIKOETHER.;1|)
 
 
 ; Copyright (c) 1988-1991, 2021 by Venue & Xerox Corporation.
@@ -16,7 +14,7 @@
 
 (RPAQQ MAIKOETHERCOMS

        ((FNS \\10MB.RESTART.ETHER \\10MB.STARTDRIVER \\10MB.TURNOFFETHER \\10MB.TURNONETHER 
-             \\10MBSENDPACKET \\10MBWATCHER \\DISPLAYLINE \\MAIKO.10MBSENDPACKET \\MAIKO.10MBWATCHER
+             \\10MBSENDPACKET \\10MBWATCHER \\MAIKO.10MBSENDPACKET \\MAIKO.10MBWATCHER 
              \\MAIKO.ETHERRESUME \\MAIKO.ETHERSUSPEND \\MAIKO.INPUT.INTERRUPT \\NS.SETTIME 
              \\PUP.SETTIME \\MAIKO.10MBSTARTDRIVER \\MAIKO.10MBTURNONETHER \\MAIKO.10MB.RESTART.ETHER
              \\MAIKO.CHECKSUM)
@@ -183,256 +181,6 @@
           (SETQ CNTR 0)
           (GO LP))))
 
-(\\DISPLAYLINE

-  (LAMBDA (TEXTOBJ LINE WINDOW)
                          (* \; "Edited  5-Apr-89 16:22 by snow")

-
-    (* |;;| "Display the line of text LINE in the edit window where it belongs.")

-
-    (* |;;| " This Function works on MIAKO")

-
-    (PROG ((CH 0)
-           (CHLIST (|fetch|
 (THISLINE CHARS) |of|
 (|fetch|
 THISLINE |of|
 TEXTOBJ)))
-           (WLIST (|fetch|
 (THISLINE WIDTHS) |of|
 (|ffetch|
 THISLINE |of|
 TEXTOBJ)))
-           (LOOKS (|fetch|
 (THISLINE LOOKS) |of|
 (|ffetch|
 THISLINE |of|
 TEXTOBJ)))
-           (WINDOWDS (WINDOWPROP (OR WINDOW (CAR (|fetch|
 (TEXTOBJ \\WINDOW) |of|
 TEXTOBJ)))
-                            'DSP))
-           (TEXTLEN (|ffetch|
 (TEXTOBJ TEXTLEN) |of|
 TEXTOBJ))
-           (THISLINE (|ffetch|
 (TEXTOBJ THISLINE) |of|
 TEXTOBJ))
-           (TERMSA (|ffetch|
 (TEXTOBJ TXTTERMSA) |of|
 TEXTOBJ))
-           (STREAM (|ffetch|
 (TEXTOBJ STREAMHINT) |of|
 TEXTOBJ))
-           (OLDCACHE (|fetch|
 LCBITMAP |of|
 (|ffetch|
 (TEXTOBJ DISPLAYCACHE) |of|

-                                                                                         TEXTOBJ)))
-           (DS (|ffetch|
 (TEXTOBJ DISPLAYCACHEDS) |of|
 TEXTOBJ))
-           (HCPYDS (|ffetch|
 (TEXTOBJ DISPLAYHCPYDS) |of|
 TEXTOBJ))
-           (HARDCOPYMODE (|fetch|
 (FMTSPEC FMTHARDCOPY) |of|
 (|fetch|
 (LINEDESCRIPTOR
-                                                                                   LFMTSPEC)
-                                                                        |of|
 LINE)))
-           LOOKSTARTX CACHE \\PCHARSLEFT \\PSTRING \\PFILE FONT OFONT OLOOKS XOFFSET CLIPLEFT 
-           CLIPRIGHT DISPLAYDATA DDPILOTBBT DDWIDTHCACHE DDOFFSETCACHE CURY LHEIGHT SCALE)
-          (SETQ LHEIGHT (COND
-                           ((|ffetch|
 (LINEDESCRIPTOR PREVLINE) |of|
 LINE)
-                                                             (* \; 
-
                                  "So if theres a base-to-base measure, we clear everything right.")

-                            (IMAX (IDIFFERENCE (|fetch|
 YBOT |of|
 (|ffetch|
 (
-                                                                                       LINEDESCRIPTOR
-                                                                                         PREVLINE)
-                                                                             |of|
 LINE))
-                                         (|ffetch|
 (LINEDESCRIPTOR YBOT) |of|
 LINE))
-                                  (|ffetch|
 (LINEDESCRIPTOR LHEIGHT) |of|
 LINE)))
-                           (T (|ffetch|
 (LINEDESCRIPTOR LHEIGHT) |of|
 LINE))))
-          (COND
-             (HARDCOPYMODE                                   (* \; 
-
                                                     "This is a hardcopy-mode line.  Scale things.")

-                                                             (* \; "(SETQ DS HCPYDS)")

-                    (SETQ SCALE (DSPSCALE NIL HCPYDS)))
-             (T (SETQ SCALE 1)))
-          (SETQ CACHE (\\TEDIT.LINECACHE (|ffetch|
 (TEXTOBJ DISPLAYCACHE) |of|
 TEXTOBJ)
-                             (COND
-                                (HARDCOPYMODE (FIXR (FQUOTIENT (|fetch|
 RIGHTMARGIN |of|

-                                                                                        LINE)
-                                                           SCALE)))
-                                (T (|fetch|
 RIGHTMARGIN |of|
 LINE)))
-                             LHEIGHT))
-          (COND
-             ((NEQ CACHE OLDCACHE)                           (* \; 
-
               "We changed the bitmaps because this line was bigger--update the displaystream, too")

-              (DSPDESTINATION CACHE DS)
-              (DSPCLIPPINGREGION (|create|
 REGION
-                                        LEFT _ 0
-                                        BOTTOM _ 0
-                                        WIDTH _ (|fetch|
 BITMAPWIDTH |of|
 CACHE)
-                                        HEIGHT _ (|ffetch|
 BITMAPHEIGHT |of|
 CACHE))
-                     DS)))
-          (BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE)
-                                                             (* \; "Clear the line cache")

-          (COND
-             (HARDCOPYMODE                                   (* \; 
-
                                                     "This is a hardcopy-mode line.  Scale things.")

-                                                             (* \; "(SETQ DS HCPYDS)")

-                    (SETQ SCALE (DSPSCALE NIL HCPYDS)))
-             (T (SETQ SCALE 1)))
-          (COND
-             ((AND (NOT (ZEROP (|fetch|
 CHAR1 |of|
 LINE)))
-                   (ILEQ (|ffetch|
 CHAR1 |of|
 LINE)
-                         TEXTLEN)
-                   (IGEQ (|ffetch|
 YBOT |of|
 LINE)
-                         (|ffetch|
 WBOTTOM |of|
 TEXTOBJ)))
-
-              (* |;;| "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.")

-
-              (COND
-                 ((NEQ (|fetch|
 DESC |of|
 THISLINE)
-                       LINE)                                 (* \; 
-
                                                          "No image cache -- re-format and display")

-                  (\\FORMATLINE TEXTOBJ NIL (|ffetch|
 CHAR1 |of|
 LINE)
-                         LINE)))
-              (MOVETO (|ffetch|
 LEFTMARGIN |of|
 LINE)
-                     (|ffetch|
 DESCENT |of|
 LINE)
-                     DS)
-              (SETQ DISPLAYDATA (|fetch|
 IMAGEDATA |of|
 DS))
-              (SETQ DDPILOTBBT (|ffetch|
 DDPILOTBBT |of|
 DISPLAYDATA))
-              (SETQ XOFFSET (|ffetch|
 DDXOFFSET |of|
 DISPLAYDATA))
-
-              (* |;;| "The X position of the left edge of the window, since \\TEDIT.BLTCHAR works on the screen bitmap itself.")

-
-              (SETQ CLIPLEFT (|ffetch|
 |DDClippingLeft| |of|
 DISPLAYDATA))
-                                                             (* \; 
-
                     "The left and right edges of the clipping region for the text display window.")

-              (SETQ CLIPRIGHT (|ffetch|
 |DDClippingRight| |of|
 DISPLAYDATA))
-              (SETQ OFONT (DSPFONT (|fetch|
 CLFONT |of|
 (SETQ OLOOKS (\\EDITELT LOOKS 0)))
-                                 DS))                        (* \; "The starting font")

-              (SETQ DDWIDTHCACHE (|ffetch|
 DDWIDTHSCACHE |of|
 DISPLAYDATA))
-                                                             (* \; 
-
                                                           "Cache the character-image widths")

-              (SETQ DDOFFSETCACHE (|ffetch|
 DDOFFSETSCACHE |of|
 DISPLAYDATA))
-                                                             (* \; 
-
                                                          "And the offset-into-strike-bitmap array")

-              (SETQ LOOKSTARTX (|ffetch|
 LEFTMARGIN |of|
 LINE))
-                                                             (* \; 
-
                                                  "Starting X position for the current-looks text.")

-              (AND (|fetch|
 CLOFFSET |of|
 OLOOKS)
-                   (RELMOVETO 0 (FIXR (FTIMES SCALE (|ffetch|
 CLOFFSET |of|
 OLOOKS)))
-                          DS))                               (* \; 
-
                                                      "Any sub- or superscripting at start of line")

-              (|bind|
 (LOOKNO _ 1)
-                     DX
-                     (TX _ (IPLUS XOFFSET (|ffetch|
 LEFTMARGIN |of|
 LINE))) |for|
 I
-                 |from|
 0 |to|
 (|fetch|
 LEN |of|
 THISLINE)
-                 |do|
 
-
-                       (* |;;| "Display the line character by character")

-
-                       (SETQ CH (\\EDITELT CHLIST I))        (* \; 
-
                                                      "Grab the character (or IMAGEOBJ) to display")

-                       (SETQ DX (\\WORDELT WLIST I))         (* \; "And its width")

-                       (SELECTC CH
-                           (|LMInvisibleRun|                 (* \; 
-
                                        "An INVISIBLE run -- skip it, and skip over the char count")

-                                (|add|
 LOOKNO 1))
-                           (|LMLooksChange|                  (* \; "A LOOKS change")

-                                (|freplace|
 DDXPOSITION |of|
 DISPLAYDATA
-                                   |with|
 (IDIFFERENCE TX XOFFSET))
-                                                             (* \; 
-
                                            "Make the displaystream reflect our current X position")

-                                (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (|ffetch|
 DESCENT
-                                                                                |of|
 LINE))
-                                                             (* \; 
-
                "Make any necessary changes to the preceding characters (underline, strike-out &c)")

-                                (DSPFONT (|fetch|
 CLFONT |of|
 (SETQ OLOOKS (\\EDITELT LOOKS 
-                                                                                          LOOKNO)))
-                                       DS)                   (* \; "Set the new font")

-                                (|add|
 LOOKNO 1)         (* \; 
-
                                                           "Grab the next set of char looks")

-                                (AND (|ffetch|
 CLOFFSET |of|
 OLOOKS)
-                                     (RELMOVETO 0 (|ffetch|
 CLOFFSET |of|
 OLOOKS)
-                                            DS))             (* \; "Account for super/subscripting")

-                                (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))
-                                                             (* \; 
-
                                     "Remember the starting Xpos for possible later underlining &c")

-                                )
-                           ((CHARCODE (TAB \#^I))            (* \; 
-
                                "TAB: use the width from the cache to decide the right formatting.")

-                                (COND
-                                   ((OR (IEQP CH (CHARCODE \#^I))
-                                        (|ffetch|
 CLLEADER |of|
 OLOOKS)
-                                        (EQ (|ffetch|
 CLUSERINFO |of|
 OLOOKS)
-                                            'DOTTEDLEADER))
-                                    (LET* ((LEADERFONT (COND
-                                                          (HARDCOPYMODE (FONTCOPY (|ffetch|

-                                                                                   CLFONT
-                                                                                     |of|
 OLOOKS)
-                                                                               'DEVICE HCPYDS))
-                                                          (T (|ffetch|
 CLFONT |of|
 OLOOKS))))
-                                           (DOTWIDTH (CHARWIDTH (CHARCODE \.)
-                                                            LEADERFONT))
-                                           (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
-                                                                          (IREMAINDER TX DOTWIDTH))))
-                                           )
-                                          (|while|
 (ILEQ TTX (IPLUS TX DX))
-                                             |do|
 (COND
-                                                         (HARDCOPYMODE
-                                                          (SUBRCALL TEDIT.BLTCHAR (CHARCODE \.)
-                                                                 DS
-                                                                 (FIXR (FQUOTIENT (IDIFFERENCE TTX 
-                                                                                         DOTWIDTH)
-                                                                              SCALE))
-                                                                 DISPLAYDATA DDPILOTBBT CLIPRIGHT))
-                                                         ((OR TERMSA HARDCOPYMODE)
-                                                             (* \; 
-
                                                           "Using special instrns from TERMSA")

-                                                          (\\DSPPRINTCHAR DS (CHARCODE \.)))
-                                                         (T  (* \; "Native charcodes")

-                                                            (SUBRCALL TEDIT.BLTCHAR (CHARCODE \.)
-                                                                   DS
-                                                                   (IDIFFERENCE TTX DOTWIDTH)
-                                                                   DISPLAYDATA DDPILOTBBT CLIPRIGHT))
-                                                         )
-                                                   (|add|
 TTX DOTWIDTH))))))
-                           (13                               (* \; "It's a CR")

-                               NIL)
-                           (COND
-                              ((SMALLP CH)                   (* \; 
-
                                                           "Normal character -- just display it.")

-                               (COND
-                                  (HARDCOPYMODE (SUBRCALL TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX 
-                                                                                           SCALE))
-                                                       DISPLAYDATA DDPILOTBBT CLIPRIGHT))
-                                  ((OR TERMSA HARDCOPYMODE)  (* \; 
-
                                                           "Using special instrns from TERMSA")

-                                   (\\DSPPRINTCHAR DS CH))
-                                  (T                         (* \; "Native charcodes")

-                                     (SUBRCALL TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT 
-                                            CLIPRIGHT))))
-                              (T                             (* \; "CH is an object.")

-                                 (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
-                                                XOFFSET)
-                                        (SETQ CURY (DSPYPOSITION NIL DS))
-                                        DS)                  (* \; 
-
                                              "Go to the base line, left edge of the image region.")

-                                 (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN)
-                                        CH DS 'DISPLAY (|ffetch|
 STREAMHINT |of|
 TEXTOBJ))
-                                                             (* \; 
-
                                                           "Tell him to display himself here.")

-                                 (DSPFONT (|ffetch|
 CLFONT |of|
 OLOOKS)
-                                        DS)
-                                 (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
-                                                XOFFSET)
-                                        CURY DS)             (* \; 
-
                                                           "Move to after the object's image")

-                                 )))
-                       (|add|
 TX DX)                     (* \; "Update our X position")

-                 |finally|
 (|freplace|
 DDXPOSITION |of|
 DISPLAYDATA
-                                  |with|
 (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE))
-                                                    XOFFSET)) 
-                                                             (* \; 
-
                                      "Make any necessary looks mods to the last run of characters")

-                       (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (|ffetch|
 DESCENT
-                                                                       |of|
 LINE)))))
-          (BITBLT CACHE 0 0 WINDOWDS 0 (|ffetch|
 YBOT |of|
 LINE)
-                 (|ffetch|
 WRIGHT |of|
 TEXTOBJ)
-                 LHEIGHT
-                 'INPUT
-                 'REPLACE)                                   (* \; 
-
                        "Paint the cached image on the screen (this lessens flicker during update)")

-          (COND
-             ((|fetch|
 (FMTSPEC FMTREVISED) |of|
 (|ffetch|
 (LINEDESCRIPTOR LFMTSPEC)
-                                                            |of|
 LINE))
-                                                             (* \; 
-
                                                     "This paragraph has been revised, so mark it.")

-              (\\TEDIT.MARK.REVISION TEXTOBJ (|ffetch|
 (LINEDESCRIPTOR LFMTSPEC) |of|
 LINE)
-                     WINDOWDS LINE)))
-          (SELECTQ (|ffetch|
 LMARK |of|
 LINE)
-              (GREY                                          (* \; 
-
              "This line has some property that isn't visible to the user.  Tell him to be careful")

-                    (BITBLT NIL 0 0 WINDOWDS 0 (|ffetch|
 YBASE |of|
 LINE)
-                           6 6 'TEXTURE 'PAINT 42405))
-              (SOLID                                         (* \; 
-
              "This line has some property that isn't visible to the user.  Tell him to be careful")

-                     (BITBLT NIL 0 0 WINDOWDS 0 (|ffetch|
 YBASE |of|
 LINE)
-                            6 6 'TEXTURE 'PAINT BLACKSHADE))
-              (BITBLT NIL 0 0 WINDOWDS 0 (|ffetch|
 YBASE |of|
 LINE)
-                     6 6 'TEXTURE 'REPLACE WHITESHADE)))))
-
 (\\MAIKO.10MBSENDPACKET

   (LAMBDA (NDB PACKET)
                                   (* \; "Edited 31-Oct-89 14:10 by bvm")

     (PROG NIL
@@ -781,13 +529,12 @@
 (RPAQQ \\MAIKO.IO-INTERRUPT-VECTOR
 NIL)
 (PUTPROPS MAIKOETHER COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1991 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (2870 40835 (\\10MB.RESTART.ETHER 2880 . 3040) (\\10MB.STARTDRIVER 3042 . 4801) (
-\\10MB.TURNOFFETHER 4803 . 4963) (\\10MB.TURNONETHER 4965 . 7335) (\\10MBSENDPACKET 7337 . 9708) (
-\\10MBWATCHER 9710 . 11049) (\\DISPLAYLINE 11051 . 29389) (\\MAIKO.10MBSENDPACKET 29391 . 31769) (
-\\MAIKO.10MBWATCHER 31771 . 33116) (\\MAIKO.ETHERRESUME 33118 . 33277) (\\MAIKO.ETHERSUSPEND 33279 . 
-33440) (\\MAIKO.INPUT.INTERRUPT 33442 . 35704) (\\NS.SETTIME 35706 . 35986) (\\PUP.SETTIME 35988 . 
-36269) (\\MAIKO.10MBSTARTDRIVER 36271 . 37926) (\\MAIKO.10MBTURNONETHER 37928 . 40303) (
-\\MAIKO.10MB.RESTART.ETHER 40305 . 40658) (\\MAIKO.CHECKSUM 40660 . 40833)) (41890 44955 (
-\\MAIKO.ETHER-INTERRUPT 41900 . 44953)) (45077 46440 (\\MAIKO.CONSOLE-LOG-PRINT 45087 . 46438)) (46486
- 47166 (\\MAIKO.IO-INTERRUPT 46496 . 47164)))))
+  (FILEMAP (NIL (2591 22216 (\\10MB.RESTART.ETHER 2601 . 2761) (\\10MB.STARTDRIVER 2763 . 4522) (
+\\10MB.TURNOFFETHER 4524 . 4684) (\\10MB.TURNONETHER 4686 . 7056) (\\10MBSENDPACKET 7058 . 9429) (
+\\10MBWATCHER 9431 . 10770) (\\MAIKO.10MBSENDPACKET 10772 . 13150) (\\MAIKO.10MBWATCHER 13152 . 14497)
+ (\\MAIKO.ETHERRESUME 14499 . 14658) (\\MAIKO.ETHERSUSPEND 14660 . 14821) (\\MAIKO.INPUT.INTERRUPT 
+14823 . 17085) (\\NS.SETTIME 17087 . 17367) (\\PUP.SETTIME 17369 . 17650) (\\MAIKO.10MBSTARTDRIVER 
+17652 . 19307) (\\MAIKO.10MBTURNONETHER 19309 . 21684) (\\MAIKO.10MB.RESTART.ETHER 21686 . 22039) (
+\\MAIKO.CHECKSUM 22041 . 22214)) (23271 26336 (\\MAIKO.ETHER-INTERRUPT 23281 . 26334)) (26458 27821 (
+\\MAIKO.CONSOLE-LOG-PRINT 26468 . 27819)) (27867 28547 (\\MAIKO.IO-INTERRUPT 27877 . 28545)))))
 STOP

sources/MAIKOLOADUPFNS

@@ -1,9 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 2-Mar-2021 23:12:27" {DSK}<home>larry>ilisp>medley>sources>MAIKOLOADUPFNS.;4
 5921   
 
-      changes to%:  (VARS MAIKOLOADUPFNSCOMS)
+
(FILECREATED "26-Oct-2021 09:55:14" {DSK}<home>larry>medley>sources>MAIKOLOADUPFNS.;2
 5969   
 
-      previous date%: "25-Feb-2021 15:43:43" {DSK}<home>larry>ilisp>save>MAIKOLOADUPFNS.;1)
+      changes to%:  (FNS \BITBLTSUB \BLTCHAR)
+
+      previous date%: " 2-Mar-2021 23:12:27" {DSK}<home>larry>medley>sources>MAIKOLOADUPFNS.;1)
 
 
 (* ; "
@@ -59,18 +60,16 @@ Copyright (c) 1989, 2018, 2021 by ENVOS Corporation.
 
 (\BITBLTSUB

   [LAMBDA (PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation 
-                 Texture WindowXOffset WindowYOffset)
    (* ; "Edited 29-Jun-88 16:24 by ")

+                 Texture WindowXOffset WindowYOffset)
  (* ; "Edited 26-Oct-2021 09:53 by larry")

 
     (* ;; "replaces \BITBLTSUB on Maiko")

 
-    ((OPCODES SUBRCALL 69 13)
-     PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType Operation Texture 
-     WindowXOffset WindowYOffset])
+    (SUBRCALL BITBLTSUB PILOTBBT SourceBitMap SLX STY DestinationBitMap DLX DTY HEIGHT SourceType 
+           Operation Texture WindowXOffset WindowYOffset])
 
 (\BLTCHAR

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

+    (SUBRCALL NEW-BLTCHAR CHARCODE DISPLAYSTREAM DISPLAYDATA])
 
 (\CHECKSUM

   [LAMBDA (BASE NWORDS INITSUM)
                       (* ; "Edited 20-May-88 11:48 by MASINTER")

@@ -164,12 +163,12 @@ Copyright (c) 1989, 2018, 2021 by ENVOS Corporation.
 )
 (PUTPROPS MAIKOLOADUPFNS COPYRIGHT ("ENVOS Corporation" 1989 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1336 5603 (CL::%%COPY-TIME-STATS 1346 . 1542) (CHECKPAGEMAP 1544 . 1676) (CLOCK 1678 . 
-1827) (CLOCK0 1829 . 1979) (DAYTIME 1981 . 2132) (SETTIME 2134 . 2408) (\BITBLTSUB 2410 . 2832) (
-\BLTCHAR 2834 . 2966) (\CHECKSUM 2968 . 3133) (\CLOCK0 3135 . 3286) (\COUNTREALPAGES 3288 . 3421) (
-\DAYTIME0 3423 . 3576) (\DIRTYBACKGROUND 3578 . 3714) (\DOLOCKPAGES 3716 . 3848) (\DONEWPAGE 3850 . 
-3999) (\DORECLAIM 4001 . 4147) (\DOTEMPLOCKPAGES 4149 . 4285) (\LOADVMEMPAGE 4287 . 4420) (
-\LOCKEDPAGEP 4422 . 4538) (\LOCKPAGES 4540 . 4670) (\MOVEVMEMFILEPAGE 4672 . 4793) (\NEWPAGE 4795 . 
-4942) (\PAGEFAULT 4944 . 5056) (\SHOWPAGETABLE 5058 . 5192) (\TEMPUNLOCKPAGES 5194 . 5330) (
-\UNLOCKPAGES 5332 . 5464) (\WRITEDIRTYPAGE 5466 . 5601)))))
+  (FILEMAP (NIL (1335 5651 (CL::%%COPY-TIME-STATS 1345 . 1541) (CHECKPAGEMAP 1543 . 1675) (CLOCK 1677 . 
+1826) (CLOCK0 1828 . 1978) (DAYTIME 1980 . 2131) (SETTIME 2133 . 2407) (\BITBLTSUB 2409 . 2831) (
+\BLTCHAR 2833 . 3014) (\CHECKSUM 3016 . 3181) (\CLOCK0 3183 . 3334) (\COUNTREALPAGES 3336 . 3469) (
+\DAYTIME0 3471 . 3624) (\DIRTYBACKGROUND 3626 . 3762) (\DOLOCKPAGES 3764 . 3896) (\DONEWPAGE 3898 . 
+4047) (\DORECLAIM 4049 . 4195) (\DOTEMPLOCKPAGES 4197 . 4333) (\LOADVMEMPAGE 4335 . 4468) (
+\LOCKEDPAGEP 4470 . 4586) (\LOCKPAGES 4588 . 4718) (\MOVEVMEMFILEPAGE 4720 . 4841) (\NEWPAGE 4843 . 
+4990) (\PAGEFAULT 4992 . 5104) (\SHOWPAGETABLE 5106 . 5240) (\TEMPUNLOCKPAGES 5242 . 5378) (
+\UNLOCKPAGES 5380 . 5512) (\WRITEDIRTYPAGE 5514 . 5649)))))
 STOP

sources/PRINTFN

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Sep-2021 23:52:49" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;24
 13993  
+
(FILECREATED "17-Oct-2021 18:00:43" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;29
 13073  
 
-      changes to%:  (FNS PRINTFNDEF PFCOPYBYTES)
+      changes to%:  (VARS PRINTFNCOMS)
+                    (FNS PRINTFN)
 
-      previous date%: " 8-Aug-2021 15:15:00" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;17)
+      previous date%: " 8-Oct-2021 00:20:48" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;28)
 
 
 (* ; "
@@ -17,12 +18,12 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ PRINTFNCOMS

        [(* * PRINTFN)
-        (FNS PF PF* PMORE PRINTFN PRINTFNDEF FINDFNDEF PFCOPYBYTES DISPLAYP)
-        (INITVARS PFDEFAULT (LASTFNDEF))
+        (FNS PF PF* PRINTFN PRINTFNDEF FINDFNDEF PFCOPYBYTES DISPLAYP)
+        (INITVARS (PFDEFAULT 'PFCOPYBYTES))
         (DECLARE%: DONTCOPY (MACROS PFPRINCHAR PFOUTCHAR))
         (P (MOVD? 'COPYBYTES 'PFCOPYBYTES))
         (USERMACROS PF)
-        (GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
+        (GLOBALVARS **COMMENT**FLG LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PF* PF)
                                                                              (NLAML)
                                                                              (LAMA])
@@ -86,21 +87,11 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
                (APPLY (FUNCTION PF)
                       FN])
 
-(PMORE

-  [LAMBDA NIL
                                            (* lmm " 9-AUG-78 17:21")


-                                                             (* lmm "17-MAY-78 15:38")

-    (PRINTFNDEF
 (CAR LASTFNDEF)
-           T
-           (CADDR LASTFNDEF)
-           -1
-           (CADDDR LASTFNDEF])
-
 (PRINTFN

-  [LAMBDA (FN FROMFILE TOFILE)
                           (* lmm "14-Aug-84 14:16")

+  [LAMBDA (FN FROMFILE TOFILE)
                          (* ; "Edited 17-Oct-2021 18:00 by rmk:")

     (PROG ((LOC (FINDFNDEF
 FN FROMFILE)))
           (COND
              ((LISTP LOC)
-              (SETQ LASTFNDEF LOC)
               (PRINTFNDEF
 (CAR LOC)
                      TOFILE
                      (CADR LOC)
@@ -112,36 +103,29 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
              (T (printout TOFILE FN " not found on " LOC "." T])
 
 (PRINTFNDEF

-  [LAMBDA (SRCFIL DSTFIL START END TYPE)
                (* ; "Edited 28-Sep-2021 23:52 by rmk:")

+  [LAMBDA (SRCFIL DSTFIL START END TYPE)
                (* ; "Edited  7-Oct-2021 20:51 by rmk:")

+
+    (* ;; "RMK:  It wasn't clear what PFDEFAULT was doing, or why.  I've assigned it a meaning here:  the name of the function to call to print a function on a display stream.  Initialized to PFCOPYBYTES")

+
     (RESETLST
-        (PROG (TEM)
-              [COND
-                 ((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T))
-                  (SETQ DSTFIL TEM))
-                 (T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT))
-                           '(PROGN (CLOSEF? OLDVALUE]
-              [COND
-                 ((SETQ TEM (GETSTREAM SRCFIL 'INPUT T))
-                  (RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM)))
-                  (SETQ SRCFIL TEM))
-                 (T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT))
-                           '(PROGN (CLOSEF? OLDVALUE]
-              (PRIN1 "{from " DSTFIL)
-              (PRIN2 (FULLNAME SRCFIL)
-                     DSTFIL T)
-              (PRIN1 "}
-" DSTFIL))
-
-        (* ;; "RMK: Originally the last test was (EQ TYPE 'MAC).  I think this was a typo for MAP, since that argument is set to MAP in FINDFNDEF.  If the typo is fixed, we would end up in the COPYBYTES clause, which we don't generally want.  So changed it also to a NEQ.")

-
-        (* ;; "PFDEFAULT is passed as the TYPE argument on the call from COPYALLBYTES, basically to force COPYBYTES and not do the format and font translations.  It defaults to NIL, not COPYBYTES.  I don't understand what this is trying to control.  Note that the last argument of PFCOPYBYTES (PFDEFAULT here) is ignored.")

-
-        (COND
-           ((OR (NOT (DISPLAYP
 DSTFIL))
-                (EQ PFDEFAULT 'COPYBYTES)
-                (NEQ TYPE 'MAP))
-            (COPYBYTES SRCFIL DSTFIL START END))
-           (T (PFCOPYBYTES
 SRCFIL DSTFIL START END PFDEFAULT)))
+        (LET (TEM)
+             [COND
+                ((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T))
+                 (SETQ DSTFIL TEM))
+                (T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT))
+                          '(PROGN (CLOSEF? OLDVALUE]
+             [COND
+                ((SETQ TEM (GETSTREAM SRCFIL 'INPUT T))
+                 (RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM)))
+                 (SETQ SRCFIL TEM))
+                (T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT))
+                          '(PROGN (CLOSEF? OLDVALUE]
+             (PRINTOUT DSTFIL "{from " .P2 (FULLNAME SRCFIL)
+                    "}" T))
+        (APPLY* (CL:IF (DISPLAYP
 DSTFIL)
+                    PFDEFAULT
+                    (FUNCTION COPYBYTES))
+               SRCFIL DSTFIL START END)
         (TERPRI DSTFIL))])
 
 (FINDFNDEF

@@ -168,11 +152,11 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
             (T FULL])
 
 (PFCOPYBYTES

-  [LAMBDA (SRCFIL DSTFIL START END FLG)
                 (* ; "Edited 28-Sep-2021 23:35 by rmk:")


+  [LAMBDA (SRCFIL DSTFIL START END)
                     (* ; "Edited  8-Oct-2021 00:17 by rmk:")


                                                              (* ; "Edited 24-Mar-93 14:16 by rmk:")


                                                              (* lmm "28-Sep-86 14:38")

 
-    (* ;; "RMK: What does FLG do?  It isn't referenced.  It seems to be passed as the value of PFDEFAULT from PRINTFNDEF, and that variable is initialized to NIL.  Remove both, eventually?")

+    (* ;; "RMK: What does FLG do?  It isn't referenced.  It seems to be passed as the value of PFDEFAULT from PRINTFNDEF, and that variable is initialized to NIL.  I'm removing it.")

 
     (* ;; " copy from SRCFIL to DSTFIL, paying attention to font changes. Other stuff about truncating lines gone away.  Interprets all possible EOL conventions as EOL.  Has to call \INCHAR-\INCCODE macros in order to keep track of character count--READDCODE doesn't do that.")

 
@@ -241,9 +225,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
                        (IMAGESTREAMTYPEP STRM 'TEXT])
 )
 
-(RPAQ? PFDEFAULT
 NIL)
-
-(RPAQ? LASTFNDEF
 )
+(RPAQ? PFDEFAULT
 'PFCOPYBYTES)
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
@@ -283,7 +265,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
 (ADDTOVAR EDITCOMSA
 PF)
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
+(GLOBALVARS **COMMENT**FLG LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
 )
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
@@ -295,7 +277,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
 )
 (PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1134 11871 (PF 1144 . 3839) (PF* 3841 . 4135) (PMORE 4137 . 4456) (PRINTFN 4458 . 5049)
- (PRINTFNDEF 5051 . 6790) (FINDFNDEF 6792 . 7816) (PFCOPYBYTES 7818 . 11621) (DISPLAYP 11623 . 11869))
-)))
+  (FILEMAP (NIL (1145 10976 (PF 1155 . 3850) (PF* 3852 . 4146) (PRINTFN 4148 . 4718) (PRINTFNDEF 4720 . 
+5903) (FINDFNDEF 5905 . 6929) (PFCOPYBYTES 6931 . 10726) (DISPLAYP 10728 . 10974)))))
 STOP