Rmk3 (#587)

* TEDITMENU:  menus don't grow vertically on reshaping

* CLSTREAMS, EDITINTERFACE:  Update filemap for FUNCTIONS

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

.github/workflows/buildDocker.yml

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

.github/workflows/buildLoadup.yml

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

.gitignore

@@ -11,6 +11,10 @@ loadups/full.sysout
 loadups/*.dribble
 loadups/whereis.hash
 
+# manual cross-reference files
+
+*.IMPTR
+
 #compiled code -- leave in for now
 
 # *.lcom

BUILDING.md

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

Dockerfile

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

README.md

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

docs/README.md

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

fonts/README.md

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

greetfiles/MEDLEYDIR-INIT

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

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

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

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

greetfiles/NOGREET

@@ -0,0 +1,19 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "10-Sep-2021 21:25:42" {DSK}<home>larry>medley>greetfiles>NOGREET.;1
 537    )
+
+
+(PRETTYCOMPRINT NOGREETCOMS)
+
+(RPAQQ NOGREETCOMS
 [(P (COND ((STKPOS 'GREET)
+                                  (SETQ USERGREETFILES NIL)
+                                  (CLOSEF? (INPUT))
+                                  (RETFROM 'GREET])
+
+[COND
+   ((STKPOS 'GREET)
+    (SETQ USERGREETFILES NIL)
+    (CLOSEF? (INPUT))
+    (RETFROM 'GREET]
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

greetfiles/README.md

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

greetfiles/initcommands.txt

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

internal/library/MAKE-PS

@@ -0,0 +1,134 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "17-Oct-2021 16:06:41" {DSK}<home>larry>medley>internal>library>MAKE-PS.;2
 5515   
+
+      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)
+
+(RPAQQ MAKE-PSCOMS

+       [(FNS MAKE-PS MAKE-PS-INIT BADFILE)
+        
+        (* ;; " Load known used image object types")

+
+        (FILES DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
+        (ADVISE TEDIT.PROMPTPRINT)
+        (INITVARS (BADFILESFILE)
+               (BADFS)
+               (BADFILES))
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-PS-INIT])
+(DEFINEQ
+
+(MAKE-PS

+  [LAMBDA (TFILE PREFIX DEST REDOFLG TOPDIRLEN)
        (* ; "Edited 21-Aug-2021 20:56 by larry")

+    (DECLARE
 (SPECVARS TFILE))
+    (COND
+       ((DIRECTORYNAMEP TFILE)
+        (SETQ TFILE (DIRECTORYNAME TFILE))
+        [OR TOPDIRLEN (SETQ TOPDIRLEN (IPLUS 1 (CL:LENGTH (MKSTRING (FILENAMEFIELD TFILE 'DIRECTORY]
+        [OR DEST (PROGN (ShellCommand (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
+                                             "/tmp/psfiles"))
+                        (SETQ DEST (MEDLEYDIR "tmp/psfiles"]
+
+        (* ;; "first deal with files in this directory")

+
+        (for
 X in
 (IF
 (EQ REDOFLG 'REV)
+                              THEN
 (REVERSE (DIRECTORY (CONCAT TFILE "*.TED*;")))
+                            ELSE
 (DIRECTORY (CONCAT TFILE "*.TED*;")))
+           when
 (NOT (MEMB X BADFILES)) do
 (MAKE-PS
 X PREFIX DEST REDOFLG TOPDIRLEN))
+
+        (* ;; " then deal with subdirs ")

+
+        (for
 X in
 (IF
 (EQ REDOFLG 'REV)
+                              THEN
 (REVERSE (DIRECTORY (CONCAT TFILE "*")))
+                            ELSE
 (DIRECTORY (CONCAT TFILE "*")))
+           when
 [for
 SKIP in
 '(">." ">internal>test" ">dinfo>")
+                       always
 (NOT (STRPOS SKIP (L-CASE X] when
 (DIRECTORYNAMEP X)
+           do
 (MAKE-PS
 X PREFIX DEST REDOFLG TOPDIRLEN)))
+       [(SETQ TFILE (INFILEP TFILE))
+        (PROG ((PSFILE (PACKFILENAME.STRING 'EXTENSION (if
 (EQ REDOFLG 'IP)
+                                                           then
 'IP
+                                                         else
 "PS")
+                              'NAME
+                              (CONCAT (OR PREFIX "")
+                                     (if
 PREFIX
+                                         then
 "-"
+                                       else
 "")
+                                     [PACK (SUBST '- '> (UNPACK (SUBSTRING (FILENAMEFIELD
+                                                                            TFILE
+                                                                            'DIRECTORY)
+                                                                       (IPLUS 1 TOPDIRLEN)
+                                                                       -1]
+                                     "-"
+                                     (FILENAMEFIELD TFILE 'NAME))
+                              'DIRECTORY DEST))
+               (TEXTSTREAM))
+              (if
 (MEMB TFILE BADFILES)
+                  then
 (RETURN))
+              (if
 (AND (NOT REDOFLG)
+                           (INFILEP PSFILE))
+                  then
                                   (* ; " do nothing")

+                        (PRINTOUT T PSFILE " already there" T)
+                elseif
 (EQ REDOFLG 'TEST)
+                  then
 (PRINTOUT T "TESTING " TFILE)
+                        (CLOSEF (OPENTEXTSTREAM TFILE))
+                else
 (PRINTOUT T "Converting " TFILE "...")
+                      (TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
+                             PSFILE T NIL NIL NIL (if
 (EQ REDOFLG 'IP)
+                                                      then
 'INTERPRESS
+                                                    else
 'POSTSCRIPT))
+                      (printout T " DONE" T)
+                      (CLOSEF? TEXTSTREAM]
+       (T (PRINTOUT T "no such file " T])
+
+(MAKE-PS-INIT

+  [LAMBDA NIL
                                          (* ; "Edited  1-Sep-2021 16:27 by larry")

+                                                             (* ; " initialize")

+    (SETQ BADFILESFILE (MEDLEYDIR "tmp" "badfiles.txt" T))
+    (SETQ BADFS (OPENSTREAM BADFILESFILE 'APPEND))
+    (POSTSCRIPT.INIT)
+    (SETQ BADFILES (SUBSET (READFILE BADFILESFILE)
+                          (FUNCTION INFILEP])
+
+(BADFILE

+  [LAMBDA (X)
                                          (* ; "Edited 16-Aug-2021 13:14 by larry")

+    ([LAMBDA ($$1)
+       (COND
+          ((FMEMB $$1 BADFILES)
+           BADFILES)
+          (T (NCONC1 BADFILES $$1]
+     (OR X TFILE))
+    (PRINT (OR X TFILE)
+           BADFS)
+    (FLUSHOUTPUT BADFS)
+    (CLOSEF? TEXTSTREAM)
+    (RETFROM 'MAKE-PS NIL])
+)
+
+
+
+(* ;; " Load known used image object types")

+
+
+(FILESLOAD DOC-OBJECTS EQUATIONS IMINDEX IMNAME IMTEDIT IMTOOLS IMTRAN MATHTONS SKETCH TMAX)
+
+[XCL:REINSTALL-ADVICE 'TEDIT.PROMPTPRINT :BEFORE '((:LAST (PRIN1 MSG T]
+
+(READVISE TEDIT.PROMPTPRINT)
+
+(RPAQ? BADFILESFILE
 )
+
+(RPAQ? BADFS
 )
+
+(RPAQ? BADFILES
 )
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(MAKE-PS-INIT
)
+)
+(DECLARE%: DONTCOPY
+  (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

internal/library/MULTI-COMPILE

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "16-Nov-94 16:28:04" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;4|
 37236  
+
(FILECREATED "25-Sep-2021 21:28:08" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>internal>library>MULTI-COMPILE.;2|
 37172  
 
-      |changes| |to:|  (VARS MULTI-COMPILECOMS)
-                       (FNS FIND-UNCOMPILED-FILES)
-
-      |previous| |date:| " 9-Sep-94 13:03:19" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;3|)
+      |previous| |date:| "16-Nov-94 16:28:04" 
+|{DSK}<Users>kaplan>Local>medley3.5>git-medley>internal>library>MULTI-COMPILE.;1|)
 
 
-; Copyright (c) 1988, 1990, 1991, 1992, 1993, 1994 by Venue & Xerox Corporation.  All rights reserved.
+; Copyright (c) 1988, 1990-1994, 2021 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT MULTI-COMPILECOMS)
 
@@ -601,12 +600,12 @@
 
 (ADDTOVAR LAMA
 FIX-FILES)
 )
-(PUTPROPS MULTI-COMPILE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1991 1992 1993 1994))
+(PUTPROPS MULTI-COMPILE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1991 1992 1993 1994 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (7131 8389 (FIND-UNCOMPILED-FILES 7141 . 8387)) (8461 19787 (NEWERDCOMS? 8471 . 12445) (
-NEWERSOURCES? 12447 . 16359) (SETUP-FOR-RECOMPILE 16361 . 18749) (SMASH-OPCODES 18751 . 19269) (
-GET-DIRECTORY-LISTING 19271 . 19568) (GET-OPEN-FILES 19570 . 19785)) (31690 36610 (FIX-FILES 31700 . 
-34497) (FIX-FILE 34499 . 35090) (FIX-COPYRIGHT 35092 . 35319) (FIX-FILE-COPYRIGHT 35321 . 35481) (
-QUALIFY-FIELDS 35483 . 36022) (FIX-TEDIT 36024 . 36330) (FIX-DOCS 36332 . 36608)) (36735 36917 (CLFIX 
-36745 . 36915)))))
+  (FILEMAP (NIL (2676 6156 (BIGCOMP 2676 . 6156)) (6289 7061 (FIND-ALL-SOURCE-FILES 6289 . 7061)) (7062 
+8320 (FIND-UNCOMPILED-FILES 7072 . 8318)) (8392 19718 (NEWERDCOMS? 8402 . 12376) (NEWERSOURCES? 12378
+ . 16290) (SETUP-FOR-RECOMPILE 16292 . 18680) (SMASH-OPCODES 18682 . 19200) (GET-DIRECTORY-LISTING 
+19202 . 19499) (GET-OPEN-FILES 19501 . 19716)) (31621 36541 (FIX-FILES 31631 . 34428) (FIX-FILE 34430
+ . 35021) (FIX-COPYRIGHT 35023 . 35250) (FIX-FILE-COPYRIGHT 35252 . 35412) (QUALIFY-FIELDS 35414 . 
+35953) (FIX-TEDIT 35955 . 36261) (FIX-DOCS 36263 . 36539)) (36666 36848 (CLFIX 36676 . 36846)))))
 STOP

library/BIGBITMAPS

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

library/DATABASEFNS

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

                    (RETURN (FULLNAME DBFILE])])
 
 (MAKEDB

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

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

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

library/FILEBROWSER

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "21-Aug-2021 23:33:58" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9|
 263236 
+
+
(FILECREATED "23-Nov-2021 12:17:08" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>FILEBROWSER.;21|
 261024 
 
       |changes| |to:|  (FNS FB.FIX-DIRECTORY-DATES)
 
-      |previous| |date:| "21-Aug-2021 23:08:34" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
+      |previous| |date:| "29-Oct-2021 21:19:42" 
+|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>FILEBROWSER.;20|)
 
 
 ; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
@@ -22,11 +23,11 @@
                                                       (TERPRI T))))
               (FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
               (P 
-                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

+                 (* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

 
                  (MOVD? 'NILL 'TOTOPW.MODERNIZE))
               
-              (* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")

+              (* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")

 
               (INITVARS (FB.EXPUNGE?MENU)
                      (FB.BROWSERFONT DEFAULTFONT)
@@ -45,7 +46,7 @@
                                  (FB.PROMPTFONT LITTLEFONT)
                                  (FB.BROWSER.DIRECTORY.FONT BOLDFONT)))
               (P 
-                 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

+                 (* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

 
                  (FONTSET (FONTSET)))
               (ADDVARS (CACHEDMENUS FB.EXPUNGE?MENU))
@@ -170,16 +171,15 @@ You specify how many versions to keep.")))
               (VARS FB.VERSION.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS
                     FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE 
                     FB.ITEMSELECTEDSHADE))
-        (COMS                                                (* \; "Entries")

+        (COMS                                                (* \; "Entries")

               (COMMANDS "fb")
               (FNS FB FB.COPYBINARYCOMMAND FB.COPYTEXTCOMMAND FILEBROWSER FB.TABLEBROWSER 
                    FB.SELECTEDFILES FB.FETCHFILENAME FB.DIRECTORYP FB.PROMPTWPRINT FB.PROMPTW.FORMAT
                    FB.PROMPTFORINPUT FB.YES-OR-NO-P FB.ALLOW.ABORT \\FB.HARDCOPY.TOFILE.EXTENSION)
-                                                             (* \; "Setup")

+                                                             (* \; "Setup")

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

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

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

+        (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)
@@ -253,7 +254,7 @@ You specify how many versions to keep.")))
 (FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)
 
 
-(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

+(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")

 
 
 (MOVD? 'NILL 'TOTOPW.MODERNIZE)
@@ -290,12 +291,12 @@ You specify how many versions to keep.")))
 (RPAQ? FB.DEFAULT.INFO
 '(SIZE CREATIONDATE AUTHOR))
 
 (APPENDTOVAR FONTVARS
 (FB.ICONFONT LITTLEFONT)
-                          (FB.BROWSERFONT DEFAULTFONT)
-                          (FB.PROMPTFONT LITTLEFONT)
-                          (FB.BROWSER.DIRECTORY.FONT BOLDFONT))
+                      (FB.BROWSERFONT DEFAULTFONT)
+                      (FB.PROMPTFONT LITTLEFONT)
+                      (FB.BROWSER.DIRECTORY.FONT BOLDFONT))
 
 
-(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

+(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")

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

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

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

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


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

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

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

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

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

                          (RETURN (SETQ PROPS (LDIFF PROPS (SETQ OPTIONS TAIL)))))
                 (ADD.PROCESS `(,(FUNCTION FILEBROWSER)
-                               ',PAT
+                               ',(OR PAT '*)
                                ',PROPS
                                ',OPTIONS)
                        'NAME
@@ -1684,84 +1684,49 @@ Your deletions are thus ignored.")))
                ELSE
 (FB.FASTSEECOMMAND
 BROWSER KEY ITEM MENU)))))
 
 (FB.EDITCOMMAND.ONEFILE

-  (LAMBDA (BROWSER FILE OPTION ITEM MENU)
              (* \; "Edited  8-Aug-2021 11:16 by rmk:")


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


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

+  (LAMBDA (BROWSER FILE OPTION ITEM MENU)
              (* \; "Edited 19-Sep-2021 18:07 by rmk:")


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


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

 
-    (* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists.  If OPTION is READONLY, we don't want to edit, just view.  If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE.")

+    (* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists.  If OPTION is READONLY, we don't want to edit, just view.  .")

 
-    (* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region.  We don't factor it to the top because we want to do whatever heavy lifting (copying files) before.  Don't factor to the end because then it is too late--the TEDIT window was up and then buried.  (If TEDIT had a don'topen option, we could set things up, then change the shade, then open.  We could also do the manufactured title on the window before it shows.")

+    (* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region.   Don't factor to the end because then it is too late--the TEDIT window was up and then buried.  (If TEDIT had a don'topen option, we could set things up, then change the shade, then open.  We could also do the manufactured title on the window before it shows.")

 
-    (CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))
-    (CL:MULTIPLE-VALUE-BIND
-     (IGNORE CONDITION)
-     (IGNORE-ERRORS
-      (LET ((ENV (LISPSOURCEFILEP FILE)))
-           (IF
 ENV
-               THEN
 (SELECTQ OPTION
-                            ((LISP NIL TEDIT) 
-                                              (* |;;| 
-
"Asks to load prop and edits the coms.  We really don't want to use a text editor on a source file.")

+    (CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))       (* \; "Default editor is TEDIT. ")

 
-                                 
-                                 (* |;;| "The FUNCALL at the bottom is concerning.")

+    (* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that.  That way, the FB window won't pop up on top.")

 
-                                 (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                                 (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
-                                 (FB.EDITLISPFILE
 FILE BROWSER))
-                            (READONLY                        (* \; "READONLY on call from SEE")

-                                      (CL:WITH-OPEN-FILE
-                                       (STREAM FILE :DIRECTION :INPUT)
-                                       (LET ((NSTR (OPENTEXTSTREAM)))
-                                            (\\EXTERNALFORMAT STREAM ENV)
-                                            (COPY.TEXT.TO.IMAGE STREAM NSTR)
+    (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
+    (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
 
-                                 (* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that.  That way, the FB window won't pop up on top.")

+    (* |;;| "The particular item may be a subitem of the EDIT or SEE menu item, in which case we want to unshade that too.  Seems a little bruteforce")

 
-                                            (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                                            (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM 
+    (CL:UNLESS (MEMBER ITEM (FETCH
 (MENU ITEMS) OF
 MENU))
+        (FOR
 I IN
 (FETCH
 (MENU ITEMS) OF
 MENU)
+           WHEN
 (MEMBER ITEM (CDR (SASSOC 'SUBITEMS I))) DO
 (SHADEITEM I MENU 
+                                                                           FB.ITEMUNSELECTEDSHADE)
+                                                                   (PUTMENUPROP MENU 'ITEMSHADE
+                                                                          (CONS I 
                                                                                FB.ITEMUNSELECTEDSHADE
-                                                                               ))
-                                            (WINDOWPROP (WFROMDS (TEXTSTREAM
-                                                                  (TEDIT NSTR NIL NIL
-                                                                         '(READONLY T))))
-                                                   'TITLE
-                                                   (CONCAT "SEE window for " (FULLNAME STREAM))))))
-                            (CL:FUNCALL OPTION (MKATOM FILE)))
-             ELSE
 (SELECTQ OPTION
-                          (READONLY 
+                                                                                ))))
+    (CL:MULTIPLE-VALUE-BIND (IGNORE CONDITION)
+           (IGNORE-ERRORS (SELECTQ OPTION
+                              (READONLY (TEDIT-SEE FILE))
+                              (LISP                          (* \; 
+
"Original code allowed OPTION=NIL in thie branch, but NIL should have been coerced to TEDIT above.")

 
-                                 (* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access.  So in that case we do a secret NODIRCORE copy and look at that.")

+                                    (* |;;| "Asks to load prop and edits the coms, presumably with SEDIT.  We really don't want to use a text editor on a source file.")

 
-                                    (CL:WITH-OPEN-FILE
-                                     (STREAM FILE :DIRECTION :INPUT)
-                                     (LET ((NSTR))
-                                          (CL:UNLESS (RANDACCESSP STREAM)
-                                              (SETQ NSTR (OPENSTREAM
-                                                          '{NODIRCORE}
-                                                          'BOTH
-                                                          'NEW NIL (LIST (LIST 'TYPE
-                                                                               (GETFILEINFO
-                                                                                STREAM
-                                                                                'TYPE)))))
-                                              (COPYBYTES STREAM NSTR))
-                                          (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                                          (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM 
-                                                                             FB.ITEMUNSELECTEDSHADE))
-                                          (WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
-                                                                                  NIL NIL
-                                                                                  '(READONLY T))))
-                                                 'TITLE
-                                                 (CONCAT "SEE window for " (FULLNAME STREAM))))))
-                          ((TEDIT NIL) 
-                               (SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
-                               (PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
-                               (TEDIT (MKATOM FILE)))
-                          (LISP (FB.PROMPTW.FORMAT
 BROWSER 
-                                       "Failed because not a Lisp source file"))
-                          (CL:FUNCALL OPTION (MKATOM FILE))))))
-     (|if|
 CONDITION
-         |then|
 (FB.PROMPTW.FORMAT
 BROWSER "Failed because ~A" CONDITION)))))
+                                    (IF
 (LISPSOURCEFILEP FILE)
+                                        THEN
 (FB.EDITLISPFILE
 FILE BROWSER)
+                                      ELSE
 (FB.PROMPTW.FORMAT
 BROWSER 
+                                                      "Failed because not a Lisp source file")))
+                              (PROGN 
+                                     (* |;;| "Might just be a call to TEDIT (if OPTION = TEDIT)")

+
+                                     (CL:FUNCALL OPTION (MKATOM FILE)))))
+           (|if|
 CONDITION
+               |then|
 (FB.PROMPTW.FORMAT
 BROWSER "Failed because ~A" CONDITION)))))
 
 (FB.EDITLISPFILE

   (LAMBDA (FILE BROWSER)
                               (* \; "Edited 21-Feb-2021 17:29 by rmk:")

@@ -2093,13 +2058,18 @@ Your deletions are thus ignored.")))
         (FB.UPDATEBROWSERITEMS
 BROWSER)))))
 
 (FB.FIX-DIRECTORY-DATES

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-                                                                                         FD1)
-                                               (|fetch|
 (FBFILEDATA FILENAME) |of|
 FD2)
-                                               :END1
-                                               (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD1)
-                                               :END2
-                                               (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD2))))
+                                (STRING-EQUAL (|fetch|
 (FBFILEDATA FILENAME) |of|
 FD1)
+                                       (|fetch|
 (FBFILEDATA FILENAME) |of|
 FD2)
+                                       :END1
+                                       (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD1)
+                                       :END2
+                                       (|fetch|
 (FBFILEDATA SUBDIREND) |of|
 FD2))))
 
 (PUTPROPS NULL.FIELDP
 MACRO
 (OPENLAMBDA (STR)
-                                      (OR (NULL STR)
-                                          (EQ (NCHARS STR)
-                                              0))))
+                              (OR (NULL STR)
+                                  (EQ (NCHARS STR)
+                                      0))))
 )
 
 (DECLARE\: DOEVAL@COMPILE DONTCOPY
@@ -4150,67 +4131,67 @@ then click Recompute"))))
 (ADDTOVAR SYSTEMRECLST
 
 (DATATYPE FILEBROWSER
 ((NOSUBDIRECTORIES FLAG)
-                           (NSPATTERN? FLAG)
-                           (SHOWUNDELETED? FLAG)
-                           (PATTERNPARSED? FLAG)
-                           (SORTBYDATE FLAG)
-                           (FBREADY FLAG)
-                           (ABORTING FLAG)
-                           (FIXEDTITLE FLAG)
-                           (FBCOMPUTEDDEPTH BYTE)
-                           (FBDISPLAYEDDEPTH BYTE)
-                           (TABLEBROWSER POINTER)
-                           (BROWSERWINDOW POINTER)
-                           (COUNTERWINDOW POINTER)
-                           (HEADINGWINDOW POINTER)
-                           (INFOMENUW POINTER)
-                           (PROMPTWINDOW POINTER)
-                           (INFODISPLAYED POINTER)
-                           (PATTERN POINTER)
-                           (PREPAREDPATTERN POINTER)
-                           (SEEWINDOW POINTER)
-                           (BROWSERFONT POINTER)
-                           (SORTBY POINTER)
-                           (NAMESTART WORD)
-                           (DIRECTORYSTART WORD)
-                           (INFOSTART WORD)
-                           (NAMEOVERHEAD WORD)
-                           (OVERFLOWSPACING WORD)
-                           (DIGITWIDTH WORD)
-                           (TOTALFILES WORD)
-                           (DELETEDFILES WORD)
-                           (TOTALPAGES POINTER)
-                           (DELETEDPAGES POINTER)
-                           (PAGECOUNT? POINTER)
-                           (COUNTERPOSITIONS POINTER)
-                           (COUNTERPAGESTRING POINTER)
-                           (OVERFLOWWIDTHS POINTER)
-                           (INFOMENUCHOICES POINTER)
-                           (UPDATEPROC POINTER)
-                           (DEFAULTDIR POINTER)
-                           (SORTATTRIBUTE POINTER)
-                           (SORTMENU POINTER)
-                           (FBLOCK POINTER)
-                           (SORTINDEX WORD)
-                           (SIZEINDEX WORD)
-                           (FBDEPTH POINTER)
-                           (ABORTWINDOW POINTER)
-                           DUMMY))
+                       (NSPATTERN? FLAG)
+                       (SHOWUNDELETED? FLAG)
+                       (PATTERNPARSED? FLAG)
+                       (SORTBYDATE FLAG)
+                       (FBREADY FLAG)
+                       (ABORTING FLAG)
+                       (FIXEDTITLE FLAG)
+                       (FBCOMPUTEDDEPTH BYTE)
+                       (FBDISPLAYEDDEPTH BYTE)
+                       (TABLEBROWSER POINTER)
+                       (BROWSERWINDOW POINTER)
+                       (COUNTERWINDOW POINTER)
+                       (HEADINGWINDOW POINTER)
+                       (INFOMENUW POINTER)
+                       (PROMPTWINDOW POINTER)
+                       (INFODISPLAYED POINTER)
+                       (PATTERN POINTER)
+                       (PREPAREDPATTERN POINTER)
+                       (SEEWINDOW POINTER)
+                       (BROWSERFONT POINTER)
+                       (SORTBY POINTER)
+                       (NAMESTART WORD)
+                       (DIRECTORYSTART WORD)
+                       (INFOSTART WORD)
+                       (NAMEOVERHEAD WORD)
+                       (OVERFLOWSPACING WORD)
+                       (DIGITWIDTH WORD)
+                       (TOTALFILES WORD)
+                       (DELETEDFILES WORD)
+                       (TOTALPAGES POINTER)
+                       (DELETEDPAGES POINTER)
+                       (PAGECOUNT? POINTER)
+                       (COUNTERPOSITIONS POINTER)
+                       (COUNTERPAGESTRING POINTER)
+                       (OVERFLOWWIDTHS POINTER)
+                       (INFOMENUCHOICES POINTER)
+                       (UPDATEPROC POINTER)
+                       (DEFAULTDIR POINTER)
+                       (SORTATTRIBUTE POINTER)
+                       (SORTMENU POINTER)
+                       (FBLOCK POINTER)
+                       (SORTINDEX WORD)
+                       (SIZEINDEX WORD)
+                       (FBDEPTH POINTER)
+                       (ABORTWINDOW POINTER)
+                       DUMMY))
 
 (DATATYPE FBFILEDATA
 ((FILENAME POINTER)
-                          (FILEINFO POINTER)
-                          (VERSIONLESSNAME POINTER)
-                          (DIRECTORYP FLAG)
-                          (HASDIRPREFIX FLAG)
-                          (DIRECTORYFILEP FLAG)
-                          (SIZE POINTER)
-                          (FILEDEPTH BYTE)
-                          (SORTVALUE POINTER)
-                          (SUBDIREND WORD)
-                          (STARTOFPNAME WORD)
-                          (VERSION WORD)
-                          (STARTOFNAME WORD)
-                          DUMMY))
+                      (FILEINFO POINTER)
+                      (VERSIONLESSNAME POINTER)
+                      (DIRECTORYP FLAG)
+                      (HASDIRPREFIX FLAG)
+                      (DIRECTORYFILEP FLAG)
+                      (SIZE POINTER)
+                      (FILEDEPTH BYTE)
+                      (SORTVALUE POINTER)
+                      (SUBDIREND WORD)
+                      (STARTOFPNAME WORD)
+                      (VERSION WORD)
+                      (STARTOFNAME WORD)
+                      DUMMY))
 )
 (DECLARE\: DONTEVAL@LOAD DOCOPY 
 
@@ -4218,10 +4199,10 @@ then click Recompute"))))
 
 
 (ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS*
 (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
-                                                 (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
+                                             (HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
 
 (ADDTOVAR |BackgroundMenuCommands|
 ("FileBrowser" '(FILEBROWSER)
-                                              "Opens a filebrowser window; prompts for pattern"))
+                                          "Opens a filebrowser window; prompts for pattern"))
 
 
 (RPAQQ |BackgroundMenu|
 NIL)
@@ -4237,51 +4218,51 @@ then click Recompute"))))
 (PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
 1991 1993 1994 1999 2000 2001 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (28618 51254 (FB 28628 . 29584) (FB.COPYBINARYCOMMAND 29586 . 29932) (FB.COPYTEXTCOMMAND
- 29934 . 30276) (FILEBROWSER 30278 . 43384) (FB.TABLEBROWSER 43386 . 43603) (FB.SELECTEDFILES 43605 . 
-44242) (FB.FETCHFILENAME 44244 . 44636) (FB.DIRECTORYP 44638 . 44966) (FB.PROMPTWPRINT 44968 . 46014) 
-(FB.PROMPTW.FORMAT 46016 . 46753) (FB.PROMPTFORINPUT 46755 . 49007) (FB.YES-OR-NO-P 49009 . 50043) (
-FB.ALLOW.ABORT 50045 . 50899) (\\FB.HARDCOPY.TOFILE.EXTENSION 50901 . 51252)) (51278 52231 (FB.STARTUP
- 51288 . 51803) (FB.MAKERIGIDWINDOW 51805 . 52229)) (52232 57604 (FB.PRINTFN 52242 . 57395) (FB.COPYFN
- 57397 . 57602)) (57654 63696 (FB.MENU.WHENSELECTEDFN 57664 . 58022) (FB.COMMANDSELECTEDFN 58024 . 
-59563) (FB.SUBITEMP 59565 . 60000) (FB.MAKE.BROWSER.BUSY 60002 . 60740) (FB.FINISH.COMMAND 60742 . 
-62707) (FB.HANDLE.ABORT.BUTTON 62709 . 63694)) (63697 69213 (FB.DELETECOMMAND 63707 . 63988) (
-FB.DELVERCOMMAND 63990 . 67183) (FB.IS.NOT.SUBDIRECTORY.ITEM 67185 . 67366) (FB.DELVER.FILES 67368 . 
-68457) (FB.DELETE.FILE 68459 . 69211)) (69214 70539 (FB.UNDELETECOMMAND 69224 . 69509) (
-FB.UNDELETEALLCOMMAND 69511 . 69790) (FB.UNDELETE.FILE 69792 . 70537)) (70540 94721 (FB.COPYCOMMAND 
-70550 . 70819) (FB.RENAMECOMMAND 70821 . 71096) (FB.COPY/RENAME.COMMAND 71098 . 72021) (
-FB.COPY/RENAME.ONE 72023 . 74345) (FB.COPY/RENAME.MANY 74347 . 80567) (FB.MERGE.DIRECTORIES 80569 . 
-80987) (FB.GREATEST.PREFIX 80989 . 82345) (FB.MAYBE.INSERT.FILE 82347 . 89787) (FB.GET.NEW.FILE.SPEC 
-89789 . 93620) (FB.CANONICAL.DIRECTORY 93622 . 94719)) (94722 102506 (FB.HARDCOPYCOMMAND 94732 . 95862
-) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 114945 (FB.EDITCOMMAND 102517 . 103318) (
-FB.EDITCOMMAND.ONEFILE 103320 . 109161) (FB.EDITLISPFILE 109163 . 110202) (FB.BROWSECOMMAND 110204 . 
-114943)) (114946 126739 (FB.FASTSEECOMMAND 114956 . 118406) (FB.FASTSEE.ONEFILE 118408 . 121437) (
-FB.SEEFULLFN 121439 . 125570) (FB.SEEBUTTONFN 125572 . 126737)) (126740 128486 (FB.LOADCOMMAND 126750
- . 127257) (FB.COMPILECOMMAND 127259 . 127797) (FB.OPERATE.ON.FILES 127799 . 128484)) (128487 176145 (
-FB.UPDATECOMMAND 128497 . 128722) (FB.FIX-DIRECTORY-DATES 128724 . 129331) (FB.MAYBE.EXPUNGE 129333 . 
-130328) (FB.UPDATEBROWSERITEMS 130330 . 143545) (FB.DATE 143547 . 144288) (FB.ADJUST.DATE.WIDTH 144290
- . 147258) (FB.SET.BROWSER.TITLE 147260 . 148117) (FB.MAYBE.WIDEN.NAMES 148119 . 150238) (
-FB.SET.DEFAULT.NAME.WIDTH 150240 . 151604) (FB.CREATE.FILEBUCKET 151606 . 158826) (
-FB.CHECK.NAME.LENGTH 158828 . 161249) (FB.ADD.FILEGROUP 161251 . 162778) (FB.INSERT.DIRECTORY 162780
- . 163018) (FB.MAKE.SUBDIRECTORY.ITEM 163020 . 164429) (FB.ADD.FILE 164431 . 165044) (FB.INSERT.FILE 
-165046 . 168458) (FB.ANALYZE.PATTERN 168460 . 173724) (FB.CANONICALIZE.PATTERN 173726 . 175038) (
-FB.GETALLFILEINFO 175040 . 176143)) (176146 184305 (FB.SORT.VERSIONS 176156 . 178927) (
-FB.DECREASING.VERSION 178929 . 179598) (FB.INCREASING.VERSION 179600 . 180221) (
-FB.NAMES.DECREASING.VERSION 180223 . 181258) (FB.NAMES.INCREASING.VERSION 181260 . 182257) (
-FB.DECREASING.NUMERIC.ATTR 182259 . 182939) (FB.INCREASING.NUMERIC.ATTR 182941 . 183615) (
-FB.ALPHABETIC.ATTR 183617 . 184303)) (184306 194148 (FB.SORTCOMMAND 184316 . 191146) (
-FB.INSERT.SUBDIRECTORIES 191148 . 191945) (FB.GET.SORT.MENU 191947 . 194146)) (194149 210238 (
-FB.EXPUNGECOMMAND 194159 . 196678) (FB.NEWPATTERNCOMMAND 196680 . 197078) (FB.NEWINFOCOMMAND 197080 . 
-199846) (FB.DEPTHCOMMAND 199848 . 201623) (FB.SHAPECOMMAND 201625 . 204967) (FB.REMOVE.FILE 204969 . 
-206790) (FB.COUNT.FILE.CHANGE 206792 . 208237) (FB.SETNEWPATTERN 208239 . 209409) (FB.GET.NEWPATTERN 
-209411 . 209995) (FB.OPTIONSCOMMAND 209997 . 210236)) (210273 211285 (
-FB.INFOMENU.SHADEINITIALSELECTIONS 210283 . 210930) (FB.INFO.ITEM.NAMED 210932 . 211283)) (211286 
-220752 (FB.MAKECOUNTERWINDOW 211296 . 212758) (FB.COUNTERW.REDISPLAYFN 212760 . 213347) (
-FB.UPDATE.COUNTERS 213349 . 215421) (FB.DISPLAY.COUNTERS 215423 . 220483) (FB.COUNTER.STRING 220485 . 
-220750)) (220753 225396 (FB.MAKEHEADINGWINDOW 220763 . 222311) (FB.HEADINGW.REDISPLAYFN 222313 . 
-222579) (FB.HEADINGW.RESHAPEFN 222581 . 222957) (FB.HEADINGW.DISPLAY 222959 . 225394)) (225397 229580 
-(FB.ICONFN 225407 . 225754) (FB.INFOMENU.WHENSELECTEDFN 225756 . 226486) (FB.CLOSEFN 226488 . 227691) 
-(FB.EXPUNGE?.MENU 227693 . 228105) (FB.AFTERCLOSEFN 228107 . 228468) (FB.CLOSE&EXPUNGE 228470 . 229578
-)) (229581 241639 (FB.HARDCOPY.DIRECTORY 229591 . 239948) (FB.HARDCOPY.PRINT.TITLE 239950 . 240276) (
-FB.HARDCOPY.MAXWIDTH 240278 . 241637)))))
+  (FILEMAP (NIL (28447 51200 (FB 28457 . 29530) (FB.COPYBINARYCOMMAND 29532 . 29878) (FB.COPYTEXTCOMMAND
+ 29880 . 30222) (FILEBROWSER 30224 . 43330) (FB.TABLEBROWSER 43332 . 43549) (FB.SELECTEDFILES 43551 . 
+44188) (FB.FETCHFILENAME 44190 . 44582) (FB.DIRECTORYP 44584 . 44912) (FB.PROMPTWPRINT 44914 . 45960) 
+(FB.PROMPTW.FORMAT 45962 . 46699) (FB.PROMPTFORINPUT 46701 . 48953) (FB.YES-OR-NO-P 48955 . 49989) (
+FB.ALLOW.ABORT 49991 . 50845) (\\FB.HARDCOPY.TOFILE.EXTENSION 50847 . 51198)) (51224 52177 (FB.STARTUP
+ 51234 . 51749) (FB.MAKERIGIDWINDOW 51751 . 52175)) (52178 57550 (FB.PRINTFN 52188 . 57341) (FB.COPYFN
+ 57343 . 57548)) (57600 63642 (FB.MENU.WHENSELECTEDFN 57610 . 57968) (FB.COMMANDSELECTEDFN 57970 . 
+59509) (FB.SUBITEMP 59511 . 59946) (FB.MAKE.BROWSER.BUSY 59948 . 60686) (FB.FINISH.COMMAND 60688 . 
+62653) (FB.HANDLE.ABORT.BUTTON 62655 . 63640)) (63643 69159 (FB.DELETECOMMAND 63653 . 63934) (
+FB.DELVERCOMMAND 63936 . 67129) (FB.IS.NOT.SUBDIRECTORY.ITEM 67131 . 67312) (FB.DELVER.FILES 67314 . 
+68403) (FB.DELETE.FILE 68405 . 69157)) (69160 70485 (FB.UNDELETECOMMAND 69170 . 69455) (
+FB.UNDELETEALLCOMMAND 69457 . 69736) (FB.UNDELETE.FILE 69738 . 70483)) (70486 94667 (FB.COPYCOMMAND 
+70496 . 70765) (FB.RENAMECOMMAND 70767 . 71042) (FB.COPY/RENAME.COMMAND 71044 . 71967) (
+FB.COPY/RENAME.ONE 71969 . 74291) (FB.COPY/RENAME.MANY 74293 . 80513) (FB.MERGE.DIRECTORIES 80515 . 
+80933) (FB.GREATEST.PREFIX 80935 . 82291) (FB.MAYBE.INSERT.FILE 82293 . 89733) (FB.GET.NEW.FILE.SPEC 
+89735 . 93566) (FB.CANONICAL.DIRECTORY 93568 . 94665)) (94668 102452 (FB.HARDCOPYCOMMAND 94678 . 95808
+) (FB.HARDCOPY.TOFILE 95810 . 102450)) (102453 112330 (FB.EDITCOMMAND 102463 . 103264) (
+FB.EDITCOMMAND.ONEFILE 103266 . 106546) (FB.EDITLISPFILE 106548 . 107587) (FB.BROWSECOMMAND 107589 . 
+112328)) (112331 124124 (FB.FASTSEECOMMAND 112341 . 115791) (FB.FASTSEE.ONEFILE 115793 . 118822) (
+FB.SEEFULLFN 118824 . 122955) (FB.SEEBUTTONFN 122957 . 124122)) (124125 125871 (FB.LOADCOMMAND 124135
+ . 124642) (FB.COMPILECOMMAND 124644 . 125182) (FB.OPERATE.ON.FILES 125184 . 125869)) (125872 173645 (
+FB.UPDATECOMMAND 125882 . 126107) (FB.FIX-DIRECTORY-DATES 126109 . 126918) (FB.MAYBE.EXPUNGE 126920 . 
+127915) (FB.UPDATEBROWSERITEMS 127917 . 141132) (FB.DATE 141134 . 141709) (FB.ADJUST.DATE.WIDTH 141711
+ . 144679) (FB.SET.BROWSER.TITLE 144681 . 145617) (FB.MAYBE.WIDEN.NAMES 145619 . 147738) (
+FB.SET.DEFAULT.NAME.WIDTH 147740 . 149104) (FB.CREATE.FILEBUCKET 149106 . 156326) (
+FB.CHECK.NAME.LENGTH 156328 . 158749) (FB.ADD.FILEGROUP 158751 . 160278) (FB.INSERT.DIRECTORY 160280
+ . 160518) (FB.MAKE.SUBDIRECTORY.ITEM 160520 . 161929) (FB.ADD.FILE 161931 . 162544) (FB.INSERT.FILE 
+162546 . 165958) (FB.ANALYZE.PATTERN 165960 . 171224) (FB.CANONICALIZE.PATTERN 171226 . 172538) (
+FB.GETALLFILEINFO 172540 . 173643)) (173646 181805 (FB.SORT.VERSIONS 173656 . 176427) (
+FB.DECREASING.VERSION 176429 . 177098) (FB.INCREASING.VERSION 177100 . 177721) (
+FB.NAMES.DECREASING.VERSION 177723 . 178758) (FB.NAMES.INCREASING.VERSION 178760 . 179757) (
+FB.DECREASING.NUMERIC.ATTR 179759 . 180439) (FB.INCREASING.NUMERIC.ATTR 180441 . 181115) (
+FB.ALPHABETIC.ATTR 181117 . 181803)) (181806 191648 (FB.SORTCOMMAND 181816 . 188646) (
+FB.INSERT.SUBDIRECTORIES 188648 . 189445) (FB.GET.SORT.MENU 189447 . 191646)) (191649 207738 (
+FB.EXPUNGECOMMAND 191659 . 194178) (FB.NEWPATTERNCOMMAND 194180 . 194578) (FB.NEWINFOCOMMAND 194580 . 
+197346) (FB.DEPTHCOMMAND 197348 . 199123) (FB.SHAPECOMMAND 199125 . 202467) (FB.REMOVE.FILE 202469 . 
+204290) (FB.COUNT.FILE.CHANGE 204292 . 205737) (FB.SETNEWPATTERN 205739 . 206909) (FB.GET.NEWPATTERN 
+206911 . 207495) (FB.OPTIONSCOMMAND 207497 . 207736)) (207773 208760 (FB.GETWINDOW 207783 . 208758)) (
+208761 209773 (FB.INFOMENU.SHADEINITIALSELECTIONS 208771 . 209418) (FB.INFO.ITEM.NAMED 209420 . 209771
+)) (209774 219240 (FB.MAKECOUNTERWINDOW 209784 . 211246) (FB.COUNTERW.REDISPLAYFN 211248 . 211835) (
+FB.UPDATE.COUNTERS 211837 . 213909) (FB.DISPLAY.COUNTERS 213911 . 218971) (FB.COUNTER.STRING 218973 . 
+219238)) (219241 223884 (FB.MAKEHEADINGWINDOW 219251 . 220799) (FB.HEADINGW.REDISPLAYFN 220801 . 
+221067) (FB.HEADINGW.RESHAPEFN 221069 . 221445) (FB.HEADINGW.DISPLAY 221447 . 223882)) (223885 228068 
+(FB.ICONFN 223895 . 224242) (FB.INFOMENU.WHENSELECTEDFN 224244 . 224974) (FB.CLOSEFN 224976 . 226179) 
+(FB.EXPUNGE?.MENU 226181 . 226593) (FB.AFTERCLOSEFN 226595 . 226956) (FB.CLOSE&EXPUNGE 226958 . 228066
+)) (228069 240127 (FB.HARDCOPY.DIRECTORY 228079 . 238436) (FB.HARDCOPY.PRINT.TITLE 238438 . 238764) (
+FB.HARDCOPY.MAXWIDTH 238766 . 240125)))))
 STOP

library/LLCOLOR

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

+                    do
                                   (* main loop)

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

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

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

+                                                             (* crossed word boundary)

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

+                                          0LP                (* main loop)

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

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

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

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

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

+                                         (PROG NIL           (* main loop)

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

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

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

+                    do
                                   (* main loop)

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

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

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

+                                                             (* crossed word boundary)

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

+                                          0LP                (* main loop)

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

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

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

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

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

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

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

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

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

+                                           0LP               (* main loop)

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

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

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

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

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

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

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

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

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

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

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

library/MAIKOCOLOR

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

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

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

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

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

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

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

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

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

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

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

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

                                                              (* ; "By Take")

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

library/SYSEDIT

@@ -1,9 +1,9 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-
(FILECREATED " 6-Aug-2021 07:35:16" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;2
 1183   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "28-Sep-2021 10:16:44" {DSK}<home>larry>medley>library>SYSEDIT.;3
 1307   
 
       changes to%:  (VARS SYSEDITCOMS)
 
-      previous date%: " 6-May-2021 16:22:01" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;1)
+      previous date%: "24-Sep-2021 20:52:26" {DSK}<home>larry>medley>library>SYSEDIT.;2)
 
 
 (* ; "
@@ -14,19 +14,19 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ SYSEDITCOMS

        [(VARS (CLISPIFYPRETTYFLG)
-              (MSRECORDTRANFLG T)
               (RECOMPILEDEFAULT 'CHANGES)
               (CLEANUPOPTIONS '(RC F))
               (GLOBALVARFLG T)
               (CLISPIFTRANFLG T)
-              (CROSSCOMPILING 'ASK))
+              (CROSSCOMPILING 'ASK)
+              (DFNFLG 'PROP)
+              (*REPLACE-OLD-EDIT-DATES* NIL)
+              (COPYRIGHTFLG 'PRESERVE))
         (P (RESETVARS ((CROSSCOMPILING T))
                   (LOAD? 'EXPORTS.ALL])
 
 (RPAQQ CLISPIFYPRETTYFLG
 NIL)
 
-(RPAQQ MSRECORDTRANFLG
 T)
-
 (RPAQQ RECOMPILEDEFAULT
 CHANGES)
 
 (RPAQQ CLEANUPOPTIONS
 (RC F))
@@ -37,6 +37,12 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ CROSSCOMPILING
 ASK)
 
+(RPAQQ DFNFLG
 PROP)
+
+(RPAQQ *REPLACE-OLD-EDIT-DATES*
 NIL)
+
+(RPAQQ COPYRIGHTFLG
 PRESERVE)
+
 (RESETVARS ((CROSSCOMPILING T))
            (LOAD? 'EXPORTS.ALL))
 (PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))

library/SYSEDIT.LCOM

@@ -1,20 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
-(FILECREATED " 6-Aug-2021 07:36:12" ("compiled on " {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;2) 
-" 6-Aug-2021 07:14:33" bcompl'd in "FULL  5-Aug-2021 ..." dated " 5-Aug-2021 22:24:43")
-(FILECREATED " 6-Aug-2021 07:35:16" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;2 1183 changes to%:
- (VARS SYSEDITCOMS) previous date%: " 6-May-2021 16:22:01" 
-{DSK}<home>larry>ilisp>medley>library>SYSEDIT.;1)
-(PRETTYCOMPRINT SYSEDITCOMS)
-(RPAQQ SYSEDITCOMS ((VARS (CLISPIFYPRETTYFLG) (MSRECORDTRANFLG T) (RECOMPILEDEFAULT (QUOTE CHANGES)) (
-CLEANUPOPTIONS (QUOTE (RC F))) (GLOBALVARFLG T) (CLISPIFTRANFLG T) (CROSSCOMPILING (QUOTE ASK))) (P (
-RESETVARS ((CROSSCOMPILING T)) (LOAD? (QUOTE EXPORTS.ALL))))))
-(RPAQQ CLISPIFYPRETTYFLG NIL)
-(RPAQQ MSRECORDTRANFLG T)
-(RPAQQ RECOMPILEDEFAULT CHANGES)
-(RPAQQ CLEANUPOPTIONS (RC F))
-(RPAQQ GLOBALVARFLG T)
-(RPAQQ CLISPIFTRANFLG T)
-(RPAQQ CROSSCOMPILING ASK)
-(RESETVARS ((CROSSCOMPILING T)) (LOAD? (QUOTE EXPORTS.ALL)))
-(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
-NIL

library/TEDIT

@@ -1,14 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "19-Apr-2018 12:22:03" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;2
 140045 
 
-      changes to%:  (VARS TEDITCOMS)
+
(FILECREATED "13-Oct-2021 10:00:40" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;19
 142287 
 
-      previous date%: "21-Jun-99 20:00:16" 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;1)
+      changes to%:  (FNS TEDIT-SEE)
+
+      previous date%: "11-Oct-2021 14:03:12" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;18)
 
 
 (* ; "
-Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 1999, 2018 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT TEDITCOMS)
@@ -24,40 +26,40 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
               (TEDIT.DEFAULT.PROPS NIL)
               (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP))
               (TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU))
-                                                             (* ; 
-
                                            "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")

-                                                             (* ; 
-
                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

+                                                             (* ; 
+
                                            "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")

+                                                             (* ; 
+
                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

               )
         (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
-        (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE 
+        (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE 
              TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES TEDIT.MAPPIECES 
              TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM \TEDIT.INCLUDE
              \TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL \TEDIT.RESTARTFN 
              \TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS 
              \TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
         (P (MOVD? 'NILL 'OBJECTOUTOFTEDIT))
-                                                             (* ; 
-
                                  "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")

+                                                             (* ; 
+
                                  "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")

         (COMS (FNS \CREATE.TEDIT.RESTART.MENU))
-                                                             (* ; 
-
                                                    "Added by yabu.fx, for SUNLOADUP without DWIM.")

-        (COMS                                                (* ; "Debugging functions")

+                                                             (* ; 
+
                                                    "Added by yabu.fx, for SUNLOADUP without DWIM.")

+        (COMS                                                (* ; "Debugging functions")

               (FNS PLCHAIN PRINTLINE SEEFILE))
-        (COMS                                                (* ; "Object-oriented editing")

+        (COMS                                                (* ; "Object-oriented editing")

               (FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.SUBTREE
                    TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED))
         (FILES TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY
                TEDITPAGE TEDITMENU TEDITFNKEYS)
-        (COMS                                                (* ; "TEDIT Support information")

+        (COMS                                                (* ; "TEDIT Support information")

               (E (SETQ TEDITSYSTEMDATE (DATE)))
               (VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA"))
               (FNS MAKETEDITFORM)
               (P (ADDTOVAR LAFITESPECIALFORMS
 ("TEdit Report" 'MAKETEDITFORM 
                                                          "Report a problem with TEdit"))
                  (SETQ LAFITEFORMSMENU NIL)))
-        (COMS                                                (* ; 
-
                         "LISTFILES Interface, so the system can decide if a file is a TEdit file.")

+        (COMS                                                (* ; 
+
                         "LISTFILES Interface, so the system can decide if a file is a TEdit file.")

               (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
                                               (EXTENSION (TEDIT])
 
@@ -327,6 +329,48 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
                     (TTY.PROCESS PROC)))
                 (RETURN PROC])
 
+(TEDIT-SEE

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


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


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

+
+    (* ;; "See FILE in a scrollable READONLY TEDIT window.  If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.")

+
+    (* ;; "FORMAT for text files defaults to :UTF-8 if present, otherwise *DEFAULT-EXTERNALFORMAT*")

+
+    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
+           (LET ((SEESTREAM STREAM)
+                 TSTREAM)
+
+                (* ;; "No need to fiddle with a TEDIT file")

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

+
+                          (SETQ SEESTREAM (OPENTEXTSTREAM))
+                          (DSPFONT DEFAULTFONT SEESTREAM)
+                          (COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
+                  ELSE
 
+
+                        (* ;; "Not a Lisp source file and not a Tedit file.  If it is not random access, we copy it so we can scroll around.")

+
+                        (* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).")

+
+                        (SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8)
+                                                        :DEFAULT))
+                        (CL:UNLESS (RANDACCESSP STREAM)
+                            (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
+                            (COPYCHARS STREAM SEESTREAM)))
+                [SETQ TSTREAM (TEXTSTREAM
 (TEDIT
 SEESTREAM WINDOW NIL
+                                                     `(READONLY T FONT ,DEFAULTFONT]
+                (WINDOWPROP (WFROMDS TSTREAM)
+                       'TITLE
+                       (CONCAT "SEE window for " (FULLNAME STREAM)))
+                (FULLNAME STREAM])
+
 (TEDIT.CHARWIDTH

   [LAMBDA (CH FONT TERMSA)
                                   (* jds "22-OCT-83 19:32")

           
@@ -2192,7 +2236,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
 (* ; "TEDIT Support information")

 
 
-(RPAQQ TEDITSYSTEMDATE
 "19-Apr-2018 12:22:04")
+(RPAQQ TEDITSYSTEMDATE
 "13-Oct-2021 10:00:40")
 
 (RPAQ TEDITSUPPORT
 "TEditSupport.PA")
 (DEFINEQ
@@ -2216,21 +2260,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
 (ADDTOVAR PRINTFILETYPES
 (TEDIT (TEST \TEDIT.FORMATTEDP1)
                                     (EXTENSION (TEDIT))))
 (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 
-1992 1993 1995 1999 2018))
+1992 1993 1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4382 115216 (\TEDIT2 4392 . 7143) (COERCETEXTOBJ 7145 . 15921) (TEDIT 15923 . 20892) (
-TEDIT.CHARWIDTH 20894 . 22918) (TEDIT.COPY 22920 . 31356) (TEDIT.DELETE 31358 . 32048) (
-TEDIT.DO.BLUEPENDINGDELETE 32050 . 35117) (TEDIT.INSERT 35119 . 40649) (TEDIT.KILL 40651 . 42208) (
-TEDIT.MAPLINES 42210 . 43609) (TEDIT.MAPPIECES 43611 . 44567) (TEDIT.MOVE 44569 . 54353) (TEDIT.QUIT 
-54355 . 56355) (TEDIT.STRINGWIDTH 56357 . 57028) (TEDIT.\INSERT 57030 . 59055) (TEXTOBJ 59057 . 60182)
- (TEXTSTREAM 60184 . 61799) (\TEDIT.INCLUDE 61801 . 65701) (\TEDIT.INSERT.PIECES 65703 . 75618) (
-\TEDIT.MOVE.PIECEMAPFN 75620 . 77699) (\TEDIT.OBJECT.SHOWSEL 77701 . 81330) (\TEDIT.RESTARTFN 81332 . 
-83327) (\TEDIT.CHARDELETE 83329 . 87291) (\TEDIT.COPY.PIECEMAPFN 87293 . 90518) (\TEDIT.DELETE 90520
- . 98038) (\TEDIT.DIFFUSE.PARALOOKS 98040 . 100804) (\TEDIT.FOREIGN.COPY? 100806 . 104533) (
-\TEDIT.QUIT 104535 . 107681) (\TEDIT.WORDDELETE 107683 . 112516) (\TEDIT1 112518 . 115214)) (115330 
-115446 (\CREATE.TEDIT.RESTART.MENU 115340 . 115444)) (115545 119234 (PLCHAIN 115555 . 115829) (
-PRINTLINE 115831 . 118595) (SEEFILE 118597 . 119232)) (119275 138918 (TEDIT.INSERT.OBJECT 119285 . 
-128362) (TEDIT.EDIT.OBJECT 128364 . 130620) (TEDIT.FIND.OBJECT 130622 . 131515) (
-TEDIT.FIND.OBJECT.SUBTREE 131517 . 132323) (TEDIT.PUT.OBJECT 132325 . 133984) (TEDIT.GET.OBJECT 133986
- . 137185) (TEDIT.OBJECT.CHANGED 137187 . 138916)) (139196 139559 (MAKETEDITFORM 139206 . 139557)))))
+  (FILEMAP (NIL (4330 117453 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) (
+TEDIT-SEE 20842 . 23129) (TEDIT.CHARWIDTH 23131 . 25155) (TEDIT.COPY 25157 . 33593) (TEDIT.DELETE 
+33595 . 34285) (TEDIT.DO.BLUEPENDINGDELETE 34287 . 37354) (TEDIT.INSERT 37356 . 42886) (TEDIT.KILL 
+42888 . 44445) (TEDIT.MAPLINES 44447 . 45846) (TEDIT.MAPPIECES 45848 . 46804) (TEDIT.MOVE 46806 . 
+56590) (TEDIT.QUIT 56592 . 58592) (TEDIT.STRINGWIDTH 58594 . 59265) (TEDIT.\INSERT 59267 . 61292) (
+TEXTOBJ 61294 . 62419) (TEXTSTREAM 62421 . 64036) (\TEDIT.INCLUDE 64038 . 67938) (\TEDIT.INSERT.PIECES
+ 67940 . 77855) (\TEDIT.MOVE.PIECEMAPFN 77857 . 79936) (\TEDIT.OBJECT.SHOWSEL 79938 . 83567) (
+\TEDIT.RESTARTFN 83569 . 85564) (\TEDIT.CHARDELETE 85566 . 89528) (\TEDIT.COPY.PIECEMAPFN 89530 . 
+92755) (\TEDIT.DELETE 92757 . 100275) (\TEDIT.DIFFUSE.PARALOOKS 100277 . 103041) (\TEDIT.FOREIGN.COPY?
+ 103043 . 106770) (\TEDIT.QUIT 106772 . 109918) (\TEDIT.WORDDELETE 109920 . 114753) (\TEDIT1 114755 . 
+117451)) (117567 117683 (\CREATE.TEDIT.RESTART.MENU 117577 . 117681)) (117782 121471 (PLCHAIN 117792
+ . 118066) (PRINTLINE 118068 . 120832) (SEEFILE 120834 . 121469)) (121512 141155 (TEDIT.INSERT.OBJECT 
+121522 . 130599) (TEDIT.EDIT.OBJECT 130601 . 132857) (TEDIT.FIND.OBJECT 132859 . 133752) (
+TEDIT.FIND.OBJECT.SUBTREE 133754 . 134560) (TEDIT.PUT.OBJECT 134562 . 136221) (TEDIT.GET.OBJECT 136223
+ . 139422) (TEDIT.OBJECT.CHANGED 139424 . 141153)) (141433 141796 (MAKETEDITFORM 141443 . 141794)))))
 STOP

library/TEDITDCL.LCOM

@@ -1,9 +1,9 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED "30-Apr-2021 17:26:58" ("compiled on " 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "29-Apr-2021 09:48:40" brecompiled 
-exprs%: nothing in "Medley  Full Sysout 30-Apr-2021 ..." dated "30-Apr-2021 14:49:58")
-(FILECREATED "30-Apr-2021 17:26:17" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2 
-86155 previous date%: "25-Aug-94 10:53:00" 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+(FILECREATED "21-Sep-2021 12:53:57" ("compiled on " 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "20-Sep-2021 11:14:12" brecompiled 
+exprs%: nothing in "FULL 20-Sep-2021 ..." dated "20-Sep-2021 11:14:18")
+(FILECREATED "21-Sep-2021 12:53:57" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2 
+86549 changes to%: (VARS TEDITDCLCOMS) previous date%: "30-Apr-2021 17:26:17" 
 {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;1)
 (PRETTYCOMPRINT TEDITDCLCOMS)
 (RPAQQ TEDITDCLCOMS ((* ;;; 
@@ -38,7 +38,9 @@ WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (REDO.TTC 5) (UNDO.TTC 6)
 8) (EXPAND.TTC 9) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))) (DECLARE%: EVAL@COMPILE DONTCOPY 
 (CONSTANTS (MSPACE 153) (NSPACE 152) (THINSPACE 159) (FIGSPACE 154))) (* ;; "FROM TEDITWINDOW") (
 DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITCARET)) (INITRECORDS TEDITCARET) (* ;; 
-"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;;; "THE END") (COMS (* ;; 
+"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;; "FROM TEDITHCPY and TEDITSCREEN") (DECLARE%: 
+EVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) (* ;;; "THE END") (
+COMS (* ;; 
 "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character "
 ) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NOTBEFORE.LB 1) (* ; 
 "Must not break before this character (e.g. Japanese right-paren)") (NOTAFTER.LB 2) (* ; 

library/TEDITHCPY

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "28-Jun-2021 12:35:45" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;2
 105754 
+
(FILECREATED "21-Sep-2021 15:33:24" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;10
 106458 
 
-      changes to%:  (FNS \TEDIT.HARDCOPY.FORMATLINE)
+      changes to%:  (FNS TEDIT.HARDCOPYFN)
+                    (VARS TEDITHCPYCOMS)
 
-      previous date%: "25-Aug-94 10:54:07" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;1)
+      previous date%: "21-Sep-2021 12:54:04" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;7)
 
 
 (* ; "
@@ -20,43 +21,48 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
                (FILES (LOADCOMP)
                       TEDITDCL))
         (COMS 
-              (* ;; "Generic interface functions and common code")

+              (* ;; "Generic interface functions and common code")

 
               (FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE 
                    \TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS 
                    \TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX))
         (COMS 
-              (* ;; "Functions for scaling distances and regions as needed during hardcopy.")

+              (* ;; "Functions for scaling distances and regions as needed during hardcopy.")

 
               (FNS \TEDIT.SCALE \TEDIT.SCALEREGION))
         (COMS 
-              (* ;; "PRESS-specific code")

+              (* ;; "PRESS-specific code")

 
               (VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
-                                                             (* ; 
-
                                                           "0.75 inches from bottom, 1 from top")

+                                                             (* ; 
+
                                                           "0.75 inches from bottom, 1 from top")

               )
         [COMS 
-              (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")

+              (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")

 
               (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
               (P (LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
                         'TEDIT
                         (FUNCTION \TEDIT.HARDCOPY)))
               (P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
-                      (COND (PRESSVALUES                     (* ; 
-
                                                  "Only install PRESS printing if PRESS is loaded.")

+                      (COND (PRESSVALUES                     (* ; 
+
                                                  "Only install PRESS printing if PRESS is loaded.")

                                    (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
-        (COMS 
-              (* ;; "vars for Japanese Line Break")

+        [COMS 
+              (* ;; "vars for Japanese Line Break")

 
-              [VARS (TEDIT.DONT.BREAK.CHARS '(8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251
-                                                   9253 9255 9257 9283 9315 9317 9319 9326 9505 9507
-                                                   9509 9511 9513 9539 9571 9573 9575 9582))
-                    (TEDIT.DONT.LAST.CHARS '(8524 8538 8536 8534]
-              (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))
+              (INITVARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" 
+                                                                 "41,115" "41,133" "41,131" "41,127"
+                                                                 "Hira,41" "Hira,43" "Hira,45" 
+                                                                 "Hira,47" "Hira,51" "Hira,103" 
+                                                                 "Hira,143" "Hira,145" "Hira,147" 
+                                                                 "Hira,156" "Kata,41" "Kata,43" 
+                                                                 "Kata,45" "Kata,47" "Kata,51" 
+                                                                 "Kata,103" "Kata,143" "Kata,145" 
+                                                                 "Kata,147" "Kata,156")))
+                     (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126"]
         (COMS 
-              (* ;; "Support for hardcopying several files as one document")

+              (* ;; "Support for hardcopying several files as one document")

 
               (FNS TEDIT-BOOK))))
 
@@ -1512,22 +1518,22 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 (DEFINEQ
 
 (TEDIT.HARDCOPYFN

-  [LAMBDA (WINDOW IMAGESTREAM)
                          (* ; "Edited 12-Jun-90 18:35 by mitani")

+  [LAMBDA (WINDOW IMAGESTREAM)
                          (* ; "Edited 21-Sep-2021 15:33 by rmk:")

 
-    (* ;; 
-
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")

+    (* ;; 
+
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")

 
     (PROG ((TEXTOBJ (TEXTOBJ WINDOW))
            (TEXTSTREAM (TEXTSTREAM WINDOW)))
 
-     (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it.  Please don't remove this binding!")

+     (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it.  Please don't remove this binding!")

 
           (RESETLST
               [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
                      '(AND (\TEDIT.MARKINACTIVE OLDVALUE]
               (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 'Hardcopy)
-              (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM)))  (* ; "Build the hardcopy")

-    ])
+                                                             (* ; "Build the hardcopy")

+              (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))])
 
 (\TEDIT.HARDCOPY

   [LAMBDA (FILE PFILE)
                                  (* ; "Edited 12-Jun-90 18:35 by mitani")

@@ -1568,8 +1574,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 
 [LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
      (COND
-        (PRESSVALUES                                         (* ; 
-
                                                  "Only install PRESS printing if PRESS is loaded.")

+        (PRESSVALUES                                         (* ; 
+
                                                  "Only install PRESS printing if PRESS is loaded.")

                (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
 
 
@@ -1577,15 +1583,13 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 (* ;; "vars for Japanese Line Break")

 
 
-(RPAQQ TEDIT.DONT.BREAK.CHARS
 (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 
-                                        9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539 
-                                        9571 9573 9575 9582))
+(RPAQ? TEDIT.DONT.BREAK.CHARS

+       (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133" "41,131" "41,127" 
+                        "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143" 
+                        "Hira,145" "Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" 
+                        "Kata,51" "Kata,103" "Kata,143" "Kata,145" "Kata,147" "Kata,156")))
 
-(RPAQQ TEDIT.DONT.LAST.CHARS
 (8524 8538 8536 8534))
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
-)
+(RPAQ? TEDIT.DONT.LAST.CHARS
 (CHARCODE ("41,114" "41,132" "41,130" "41,126")))
 
 
 
@@ -1612,11 +1616,11 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
 (PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
 1991 1992 1993 1994 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3088 99806 (TEDIT.HARDCOPY 3098 . 4349) (TEDIT.HCPYFILE 4351 . 6425) (
-\TEDIT.HARDCOPY.DISPLAYLINE 6427 . 20572) (\TEDIT.HARDCOPY.FORMATLINE 20574 . 67896) (
-\DOFORMATTING.HARDCOPY 67898 . 81191) (\TEDIT.HARDCOPY.MODIFYLOOKS 81193 . 83600) (
-\TEDIT.HCPYLOOKS.UPDATE 83602 . 94210) (\TEDIT.HCPYFMTSPEC 94212 . 99232) (\TEDIT.INTEGER.IMAGEBOX 
-99234 . 99804)) (99895 100979 (\TEDIT.SCALE 99905 . 100199) (\TEDIT.SCALEREGION 100201 . 100977)) (
-101222 103719 (TEDIT.HARDCOPYFN 101232 . 102083) (\TEDIT.HARDCOPY 102085 . 102994) (
-\TEDIT.PRESS.HARDCOPY 102996 . 103717)) (104701 105604 (TEDIT-BOOK 104711 . 105602)))))
+  (FILEMAP (NIL (3655 100373 (TEDIT.HARDCOPY 3665 . 4916) (TEDIT.HCPYFILE 4918 . 6992) (
+\TEDIT.HARDCOPY.DISPLAYLINE 6994 . 21139) (\TEDIT.HARDCOPY.FORMATLINE 21141 . 68463) (
+\DOFORMATTING.HARDCOPY 68465 . 81758) (\TEDIT.HARDCOPY.MODIFYLOOKS 81760 . 84167) (
+\TEDIT.HCPYLOOKS.UPDATE 84169 . 94777) (\TEDIT.HCPYFMTSPEC 94779 . 99799) (\TEDIT.INTEGER.IMAGEBOX 
+99801 . 100371)) (100462 101546 (\TEDIT.SCALE 100472 . 100766) (\TEDIT.SCALEREGION 100768 . 101544)) (
+101789 104340 (TEDIT.HARDCOPYFN 101799 . 102704) (\TEDIT.HARDCOPY 102706 . 103615) (
+\TEDIT.PRESS.HARDCOPY 103617 . 104338)) (105405 106308 (TEDIT-BOOK 105415 . 106306)))))
 STOP

library/TEDITMENU

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

+              (COMS                                          (* ; "Initialization Code")

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

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


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

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

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

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

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

library/TEDITWINDOW

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "24-Aug-2021 23:30:39" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;3
 185251 
 
-      changes to%:  (FNS \TEDIT.BUTTONEVENTFN TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE)
+
(FILECREATED "16-Oct-2021 18:52:11" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18
 187780 
 
-      previous date%: "21-Jun-99 20:00:42" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;1)
+      changes to%:  (FNS TEDIT.DEACTIVATE.WINDOW)
+
+      previous date%: "12-Oct-2021 15:10:06" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;17)
 
 
 (* ; "
@@ -25,33 +26,36 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
              \TEDIT.WINDOW.OPS \TEDIT.EXPANDFN \TEDIT.MAINW \TEDIT.PRIMARYW \TEDIT.COPYINSERTFN 
              \TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN 
              \TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.WINDOW.SETUP \SAFE.FIRST)
+        (INITVARS (\TEDIT.OP.WIDTH 12)
+               (\TEDIT.OP.BOTTOM 12))
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM))
         (CURSORS BXCARET BXHICARET TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR 
                \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR)
         (INITVARS (TEDIT.DEFAULT.WINDOW NIL))
         (GLOBALVARS TEDIT.DEFAULT.WINDOW)
-        (COMS                                                (* ; 
-
                                                 "User-level %"is this a TEdit window?%" function.")

+        (COMS                                                (* ; 
+
                                                 "User-level %"is this a TEdit window?%" function.")

               (FNS TEDITWINDOWP))
-        (COMS                                                (* ; "User-typein support")

+        (COMS                                                (* ; "User-typein support")

               (FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME))
-        (COMS                                                (* ; "Attached Prompt window support.")

+        (COMS                                                (* ; "Attached Prompt window support.")

               (FNS TEDIT.PROMPTPRINT TEDIT.PROMPTFLASH \TEDIT.PROMPT.PAGEFULLFN)
               (INITVARS (TEDIT.PROMPT.FONT (FONTCREATE 'GACHA 10))
                      (TEDIT.PROMPTWINDOW.HEIGHT NIL))
               (GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT))
-        (COMS                                                (* ; "Title creation and update")

+        (COMS                                                (* ; "Title creation and update")

               (FNS TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE \TEDIT.WINDOW.TITLE 
                    \TEXTSTREAM.FILENAME))
-        (COMS                                                (* ; "Screen updating utilities")

+        (COMS                                                (* ; "Screen updating utilities")

               (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.REPAINTFN \TEDIT.RESHAPEFN \TEDIT.SCROLLFN))
-        (COMS                                                (* ; "Process-world interfaces")

+        (COMS                                                (* ; "Process-world interfaces")

               (FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN))
         (COMS (INITVARS (\CARETRATE 333))
-                                                             (* ; 
-
                                                           "Caret handler;  stolen from CHAT.")

+                                                             (* ; 
+
                                                           "Caret handler;  stolen from CHAT.")

               (FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET 
                    TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET))
-        [COMS                                                (* ; "Menu interfacing")

+        [COMS                                                (* ; "Menu interfacing")

               (FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU 
                    \TEDIT.MENU.WHENHELDFN \TEDIT.MENU.WHENSELECTEDFN)
               (GLOBALVARS TEDIT.DEFAULT.MENU)
@@ -79,21 +83,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                                             '(TEdit '(TEDIT)
                                                                     "Opens a TEdit window for use."]
                                                  (SETQ BackgroundMenu NIL]
-        (COMS                                                (* ; "titled icon info")

+        (COMS                                                (* ; "titled icon info")

               (FILES ICONW)
               (BITMAPS TEDITICON TEDITMASK)
               (INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD))
                      [TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]
-                                                             (* ; 
-
                        "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")

-                                                             (* ; 
-
                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

+                                                             (* ; 
+
                        "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")

+                                                             (* ; 
+
                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

                      [TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS 
                                                                               TEDIT.ICON.TITLE.REGION
                                                                                        NIL]
-                                                             (* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")

-                                                             (* ; 
-
                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

+                                                             (* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")

+                                                             (* ; 
+
                                                  "Changed by yabu.fx, for SUNLOADUP without DWIM.")

                      ])
 
 (FILESLOAD TEDITDCL)
@@ -156,7 +160,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
     TEDIT.DEFAULT.WINDOW])
 
 (TEDIT.CURSORMOVEDFN

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

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

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

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

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

                                                                                   'WINDOW)
                                 (replace
 LEFT of
 CURSORREG with
 LEFT)
-                                (replace
 WIDTH of
 CURSORREG with
 8))
+                                (replace
 WIDTH of
 CURSORREG with
 \TEDIT.OP.WIDTH))
                                ([IGEQ X (SETQ LEFT
                                          (OR [AND LINE (COND
                                                           ((fetch
 (FMTSPEC FMTHARDCOPY)
@@ -454,355 +467,359 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
                                    (PROCESSP (WINDOWPROP W 'PROCESS])
 
 (\TEDIT.BUTTONEVENTFN

-  [LAMBDA (W STREAM)
                                    (* ; "Edited 24-Aug-2021 23:30 by rmk:")

+  [LAMBDA (W STREAM)
                                    (* ; "Edited 19-Sep-2021 22:58 by rmk:")

 
-    (* ;; "Handle button events for a TEdit window")

+    (* ;; "Handle button events for a TEdit window.  If no button is down, we got control on button-up transition, so ignore it.")

 
-    (AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
-    (PROG* ((OSEL NIL)
-            (SEL NIL)
-            [TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
-            (DS (WINDOWPROP W 'DSP))
-            USERFN
-            (GLOBALSEL TEDIT.SELECTION)
-            (X (LASTMOUSEX W))
-            (Y (LASTMOUSEY W))
-            (CLIPREGION (DSPCLIPPINGREGION NIL W))
-            (SELOPERATION 'NORMAL)
-            (SELFN (TEXTPROP TEXTOBJ 'SELFN))
-            (EXTENDFLG NIL)
-            (OLDX -32000)
-            (OLDY -32000)
-            SELFINALFN PROC NOSEL)
-           (COND
-              ((NOT (MOUSESTATE (OR LEFT MIDDLE RIGHT)))     (* ; 
-
                       "No button is down -- we got control on button-up transition, so ignore it.")

-               (RETURN))
-              (TEDIT.SELPENDING                              (* ; 
-
                     "There is already a selection in progress.  Don't allow another to interfere.")

-                     (RETURN)))
-           (replace
 (SELECTION CH#) of
 TEDIT.SCRATCHSELECTION with
 0)
-                                                             (* ; 
-
                     "Mark the user-visible scratch selection fresh, so changes can be detected...")

-           (COND
-              [[OR (NOT TEXTOBJ)
-                   (fetch
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ)
-                   (AND (NOT (WINDOWPROP W 'PROCESS))
-                        (NOT (TEXTPROP TEXTOBJ 'READONLY))
-                        (NOT (SHIFTDOWNP 'SHIFT))
-                        (NOT (SHIFTDOWNP 'CTRL))
-                        (NOT (SHIFTDOWNP 'META))
-                        (NOT (KEYDOWNP 'MOVE))
-                        (NOT (KEYDOWNP 'COPY]                (* ; "There's no edit session behind this window.  You can only do window ops, or re-establish a session.")

-               (TOTOPW W)
-               (COND
-                  ((\TEDIT.MOUSESTATE RIGHT)                 (* ; 
-
                                                        "Right button gets the window command menu")

-                   (DOWINDOWCOM W))
-                  ((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
-                        (NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
-                        [NOT (PROCESSP (WINDOWPROP W 'PROCESS]
-                        (\TEDIT.MOUSESTATE MIDDLE))          (* ; 
-
                                "Middle button on a dead window gives a menu for re-starting TEDIT")

-                   (COND
-                      ((EQ (MENU TEDIT.RESTART.MENU)
-                           'NewEditProcess)
-                       (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 NIL)
-                       (TEDIT (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                              W]
-              [(IGREATERP Y (fetch
 TOP of
 CLIPREGION))
-                                                             (* ; 
-
                                     "It's not inside the window's REAL region, so call on a menu.")

-               (TOTOPW W)
+    (TOTOPW W)
 
-               (* ;; "RMK:  This comment was originally just after the DON'T below, which generated a value-of-comment used message.")

+    (* ;; "RMK: 2021/9 TOTOPW was in (almost) all the conditional branches, I moved it up so that it always happens, even if the click is perhaps in a menu.  There were cases where a second click in the window was needed to bring it above an overlapping window that it was under.  I think perhaps it was because the mouse button may not have been seen as down on the first click, so it would return before it raised the window.  But that was really bizarre--maybe the click was to see what was obscured by the overlapping window.")

 
-               (* ;; "HAD BEEN:  (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it;  go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")

+    (CL:WHEN (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
+                  (NOT TEDIT.SELPENDING))
 
-               (COND
-                  ((\TEDIT.MOUSESTATE RIGHT)
-                   (DOWINDOWCOM W))
-                  ((MOUSESTATE (OR LEFT MIDDLE))
-                   (AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
-                        (NEQ USERFN 'DON'T)
-                        (ADD.PROCESS (LIST USERFN (KWOTE W]
-              ((AND TEXTOBJ (EQ (fetch
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ)
-                                'WINDOW))                    (* ; 
-
                    "We're in the window-ops region of the window.  Do a window split or something")

-               (\TEDIT.WINDOW.OPS
 TEXTOBJ W))
-              ((AND TEXTOBJ (NOT (fetch
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ)))
-                                                             (* ; 
-
           "Usual case -- he's really selecting something.  And there's nothing else going on now.")

-               (TOTOPW W)                                    (* ; 
-
                          "Move the editing window to the top, so he can select wherever he wants.")

-               (\CARET.DOWN)                                 (* ; 
-
                                                       "Make sure the caret isn't being displayed.")

-               (RESETLST
-                   (RESETSAVE TEDIT.SELPENDING TEXTOBJ)
+        (* ;; "(RMK:  old comment): Bail out if the mouse isn't down or there is a pending selection--don't want another selection to interfere.")

 
-                   (* ;; "Tell all TEdits not to run, since there is a selection in progress.  This is reset to NIL on return from here, to re-enable TEdit runs.")

+        (AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
+        [LET* ((OSEL NIL)
+               (SEL NIL)
+               [TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
+               (DS (WINDOWPROP W 'DSP))
+               USERFN
+               (GLOBALSEL TEDIT.SELECTION)
+               (X (LASTMOUSEX W))
+               (Y (LASTMOUSEY W))
+               (CLIPREGION (DSPCLIPPINGREGION NIL W))
+               (SELOPERATION 'NORMAL)
+               (SELFN (TEXTPROP TEXTOBJ 'SELFN))
+               (EXTENDFLG NIL)
+               (OLDX -32000)
+               (OLDY -32000)
+               SELFINALFN PROC NOSEL)
+              (replace
 (SELECTION CH#) of
 TEDIT.SCRATCHSELECTION with
 0)
+                                                             (* ; 
+
                     "Mark the user-visible scratch selection fresh, so changes can be detected...")

+              (COND
+                 [[OR (NOT TEXTOBJ)
+                      (fetch
 (TEXTOBJ EDITFINISHEDFLG) of
 TEXTOBJ)
+                      (AND (NOT (WINDOWPROP W 'PROCESS))
+                           (NOT (TEXTPROP TEXTOBJ 'READONLY))
+                           (NOT (SHIFTDOWNP 'SHIFT))
+                           (NOT (SHIFTDOWNP 'CTRL))
+                           (NOT (SHIFTDOWNP 'META))
+                           (NOT (KEYDOWNP 'MOVE))
+                           (NOT (KEYDOWNP 'COPY]             (* ; "There's no edit session behind this window.  You can only do window ops, or re-establish a session.")

+                  (COND
+                     ((\TEDIT.MOUSESTATE RIGHT)              (* ; 
+
                                                        "Right button gets the window command menu")

+                      (DOWINDOWCOM W))
+                     ((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
+                           (NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
+                           [NOT (PROCESSP (WINDOWPROP W 'PROCESS]
+                           (\TEDIT.MOUSESTATE MIDDLE))       (* ; 
+
                                "Middle button on a dead window gives a menu for re-starting TEDIT")

+                      (COND
+                         ((EQ (MENU TEDIT.RESTART.MENU)
+                              'NewEditProcess)
+                          (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 NIL)
+                          (TEDIT (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
+                                 W]
+                 [(IGREATERP Y (fetch
 TOP of
 CLIPREGION))
+                                                             (* ; 
+
                                     "It's not inside the window's REAL region, so call on a menu.")

 
-                   (RESETSAVE (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
-                                 do
 (replace
 TCCARET of
 CARET with
 (\CARET.CREATE
-                                                                                    BXHICARET)))
-                          (LIST '\TEDIT.CARET (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)))
-                                                             (* ; 
-
                                   "Then make the caret be the special, tall one so he can see it.")

-                   (COND
-                      ((KEYDOWNP 'COPY)                      (* ; 
-
                                                      "In a read-only document, you can only copy.")

-                       (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
-                       (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'COPY))
-                      ((AND (KEYDOWNP 'MOVE)
-                            (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
-                                                             (* ; 
-
                                                          "The MOVE key is down, so set MOVE mode.")

-                       (SETQ GLOBALSEL TEDIT.MOVESELECTION)
-                       (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'MOVE))
-                      [(SHIFTDOWNP 'SHIFT)                   (* ; 
-
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

-                       (COND
-                          ((AND (SHIFTDOWNP 'CTRL)
-                                (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
-                                                             (* ; "CTRL-SHIFT select means MOVE.")

-                           (SETQ GLOBALSEL TEDIT.MOVESELECTION)
-                           (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
-                           (SETQ SELOPERATION 'MOVE))
-                          (T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
-                             (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
-                             (SETQ SELOPERATION 'COPY]
-                      ((SHIFTDOWNP 'META)                    (* ; 
-
                                        "He's holding the meta key down , do a copylooks selection")

-                       (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
-                       (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'COPYLOOKS))
-                      ((AND (SHIFTDOWNP 'CTRL)
-                            (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
-                                                             (* ; 
-
                                               "He's holding the control key down;  note the fact.")

-                       (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                              NIL NIL)
-                       (SETQ GLOBALSEL TEDIT.DELETESELECTION)
-                       [COND
-                          ((fetch
 (SELECTION SET) of
 (fetch
 (TEXTOBJ DELETESEL)
-                                                                of
 TEXTOBJ))
-                                                             (* ; 
-
         "There's a pending delete selection.  Use it, and turn off the existing normal selection.")

-                           )
-                          (T                                 (* ; 
-
                     "No existing delete selection.  Use the normal selection as a starting point.")

-                             (\COPYSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                                    (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ]
-                       (replace
 (SELECTION SET) of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                          with
 NIL)
+                  (* ;; "RMK:  This comment was originally just after the DON'T below, which generated a value-of-comment used message.")

 
-                       (* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")

+                  (* ;; "HAD BEEN:  (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it;  go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")

 
-                       (SETQ OSEL (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
-                       (SETQ SELOPERATION 'DELETE)
-                       (TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
-                       (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL))
-                      (T (SETQ OSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-                         (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL)
-                                                             (* ; "Reset the pending-delete flag.")

-                         ))
-                   (\COPYSEL OSEL GLOBALSEL)
-                   (bind
 (OSELOP _ SELOPERATION)
-                      while
 [OR (SHIFTDOWNP 'SHIFT)
-                                    (SHIFTDOWNP 'CTRL)
-                                    (SHIFTDOWNP 'META)
-                                    (KEYDOWNP 'MOVE)
-                                    (KEYDOWNP 'COPY)
-                                    (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
-                      do
                                 (* ; 
-
                                                   "Poll the selection & display its current state")

-                            [COND
-                               ((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
-                                                             (* ; 
-
                                                  "No mouse buttons are down;  don't try anything.")

-                                (SETQ OLDX -32000)           (* ; 
-
       "However, remember that pushing a mouse button is a change of status that we should notice.")

-                                )
-                               ((KEYDOWNP 'MOVE)             (* ; 
-
                                             "the MOVE key is down;  mark this selection for MOVE.")

-                                (SETQ SELOPERATION 'MOVE))
-                               [(OR (SHIFTDOWNP 'SHIFT)
-                                    (KEYDOWNP 'COPY))        (* ; 
-
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

-                                (COND
-                                   ((SHIFTDOWNP 'CTRL)       (* ; 
-
                                              "He's holding down both ctrl and shift -- do a move.")

-                                    (SETQ SELOPERATION 'MOVE))
-                                   (T                        (* ; 
-
                                                           "Just the SHIFT key.  It's a COPY")

-                                      (SETQ SELOPERATION 'COPY]
-                               ((SHIFTDOWNP 'META)           (* ; 
-
                                                  "He's holding the meta key down;  note the fact.")

-                                (SETQ SELOPERATION 'COPYLOOKS))
-                               ((SHIFTDOWNP 'CTRL)           (* ; 
-
                               "He's holding only the CTRL key -- mark the selection for deletion.")

-                                (SETQ SELOPERATION 'DELETE))
-                               (T                            (* ; 
-
                                             "No key being held down;  revert to normal selection.")

-                                  (SETQ SELOPERATION 'NORMAL]
-                            (COND
-                               [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
-                                         [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
-                                         (NEQ OSELOP SELOPERATION))
-                                     (INSIDEP CLIPREGION X Y))
+                  (COND
+                     ((\TEDIT.MOUSESTATE RIGHT)
+                      (DOWINDOWCOM W))
+                     ((MOUSESTATE (OR LEFT MIDDLE))
+                      (AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
+                           (NEQ USERFN 'DON'T)
+                           (ADD.PROCESS (LIST USERFN (KWOTE W]
+                 ((AND TEXTOBJ (EQ (fetch
 (TEXTOBJ MOUSEREGION) of
 TEXTOBJ)
+                                   'WINDOW))                 (* ; 
+
                    "We're in the window-ops region of the window.  Do a window split or something")

+                  (\TEDIT.WINDOW.OPS
 TEXTOBJ W))
+                 ((AND TEXTOBJ (NOT (fetch
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ)))
+                                                             (* ; 
+
           "Usual case -- he's really selecting something.  And there's nothing else going on now.")

+                  (\CARET.DOWN)                              (* ; 
+
                                                       "Make sure the caret isn't being displayed.")

+                  (RESETLST
+                      (RESETSAVE TEDIT.SELPENDING TEXTOBJ)
 
-                                (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")

+                      (* ;; "Tell all TEdits not to run, since there is a selection in progress.  This is reset to NIL on return from here, to re-enable TEdit runs.")

 
-                                (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")

+                      (RESETSAVE (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
+                                    do
 (replace
 TCCARET of
 CARET with
 (\CARET.CREATE
+                                                                                       BXHICARET)))
+                             (LIST '\TEDIT.CARET (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)))
+                                                             (* ; 
+
                                   "Then make the caret be the special, tall one so he can see it.")

+                      (COND
+                         ((KEYDOWNP 'COPY)                   (* ; 
+
                                                      "In a read-only document, you can only copy.")

+                          (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
+                          (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'COPY))
+                         ((AND (KEYDOWNP 'MOVE)
+                               (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
+                                                             (* ; 
+
                                                          "The MOVE key is down, so set MOVE mode.")

+                          (SETQ GLOBALSEL TEDIT.MOVESELECTION)
+                          (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'MOVE))
+                         [(SHIFTDOWNP 'SHIFT)                (* ; 
+
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

+                          (COND
+                             ((AND (SHIFTDOWNP 'CTRL)
+                                   (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
+                                                             (* ; "CTRL-SHIFT select means MOVE.")

+                              (SETQ GLOBALSEL TEDIT.MOVESELECTION)
+                              (SETQ OSEL (fetch
 (TEXTOBJ MOVESEL) of
 TEXTOBJ))
+                              (SETQ SELOPERATION 'MOVE))
+                             (T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
+                                (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
+                                (SETQ SELOPERATION 'COPY]
+                         ((SHIFTDOWNP 'META)                 (* ; 
+
                                        "He's holding the meta key down , do a copylooks selection")

+                          (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
+                          (SETQ OSEL (fetch
 (TEXTOBJ SHIFTEDSEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'COPYLOOKS))
+                         ((AND (SHIFTDOWNP 'CTRL)
+                               (NOT (fetch
 (TEXTOBJ TXTREADONLY) of
 TEXTOBJ)))
+                                                             (* ; 
+
                                               "He's holding the control key down;  note the fact.")

+                          (\SHOWSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+                                 NIL NIL)
+                          (SETQ GLOBALSEL TEDIT.DELETESELECTION)
+                          [COND
+                             ((fetch
 (SELECTION SET) of
 (fetch
 (TEXTOBJ DELETESEL)
+                                                                   of
 TEXTOBJ))
+                                                             (* ; 
+
         "There's a pending delete selection.  Use it, and turn off the existing normal selection.")

+                              )
+                             (T                              (* ; 
+
                     "No existing delete selection.  Use the normal selection as a starting point.")

+                                (\COPYSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+                                       (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ]
+                          (replace
 (SELECTION SET) of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ
+                                                                     ) with
 NIL)
 
-                                (SETQ OLDX X)
-                                (SETQ OLDY Y)
-                                [COND
-                                   ((\TEDIT.MOUSESTATE LEFT) (* ; 
-
                                                           "Left button is character selection")

-                                    (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
-                                                                                          MOUSEREGION
-                                                                                          )
-                                                                           of
 TEXTOBJ)
-                                                     NIL SELOPERATION W))
-                                    (SETQ EXTENDFLG NIL))
-                                   ((\TEDIT.MOUSESTATE MIDDLE)
-                                                             (* ; "Middle button is word selection")

-                                    (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
-                                                                                          MOUSEREGION
-                                                                                          )
-                                                                           of
 TEXTOBJ)
-                                                     T SELOPERATION W))
-                                    (SETQ EXTENDFLG NIL))
-                                   [(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections")

-                                    (COND
-                                       ((NEQ SELOPERATION OSELOP)
+                          (* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")

 
-                                 (* ;; "Things changed since the last selection.  Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")

-
-                                        (\COPYSEL OSEL GLOBALSEL)))
-                                    (COND
-                                       ((fetch
 (SELECTION SET) of
 GLOBALSEL)
-                                        (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
-                                                                             'NORMAL)
-                                             (SETQ SELOPERATION 'PENDINGDEL)
-                                             (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ
-                                                with
 T)) (* ; 
-
       "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")

-                                        (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ 
-                                                         SELOPERATION W))
-                                        (SETQ EXTENDFLG T]
-                                   (T                        (* ; 
-
                        "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")

-                                      (\COPYSEL OSEL GLOBALSEL)
-                                                             (* ; 
-
                       "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")

-                                      (AND SEL (replace
 (SELECTION SET) of
 SEL with

-                                                                                       NIL]
-                                [COND
-                                   ((AND SEL (fetch
 (SELECTION SET) of
 SEL)
-                                         SELFN)              (* ; 
-
                               "The selection was set, but there's a SELFN that has veto authority")

-                                    (COND
-                                       ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
-                                            'DON'T)          (* ; 
-
                                              "The selfn vetoed this selection, so mark it un-set.")

-                                        (replace
 (SELECTION SET) of
 SEL with
 NIL]
-                                (COND
-                                   ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
-                                                             (* ; 
-
             "Something interesting about the selection changed.  We have to re-display its image.")

-                                    (COND
-                                       ((OR (EQ SELOPERATION 'NORMAL)
-                                            (EQ SELOPERATION 'PENDINGDEL))
-                                                             (* ; 
-
                        "For a normal selection, set the 'window last selected in' for the TEXTOBJ")

-                                        (replace
 (TEXTOBJ SELWINDOW) of
 TEXTOBJ with

-                                                                                        W)))
-                                    (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP 
-                                                      SELOPERATION EXTENDFLG))
-                                    (SETQ OSELOP SELOPERATION))
-                                   ([AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
-                                         (EQ (fetch
 (SELECTION SELKIND) of
 OSEL)
-                                             'VOLATILE)
-                                         (OR (NOT SEL)
-                                             (NOT (fetch
 (SELECTION SET) of
 SEL]
-
-                                 (* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it.  Turn it off.")

-
-                                    (\SHOWSEL OSEL NIL NIL)
-                                    (replace
 (SELECTION SET) of
 OSEL with
 NIL]
-                               ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
-                                                             (* ; 
-
                                    "If he moves to the scroll bar, let him scroll without trouble")

-                                (SCROLL.HANDLER W)))
-                            (BLOCK)                          (* ; "Give other processes a chance")

-                            (GETMOUSESTATE)                  (* ; "And get the new mouse info")

-                            (TEDIT.CURSORMOVEDFN
 W))
-                   (\COPYSEL OSEL GLOBALSEL)
-                   (COND
-                      ((fetch
 (SELECTION SET) of
 OSEL)
-                                                             (* ; 
-
                                        "Only if a selection REALLY got made should we do this....")

-                       (SELECTQ SELOPERATION
-                           (COPY                             (* ; 
-
           "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")

-                                 (SETQ TEDIT.COPY.PENDING T)
-                                 (replace
 (SELECTION SET) of
 OSEL with
 NIL)
-                                                             (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

-                                 (\TEDIT.FOREIGN.COPY? GLOBALSEL)
-                                                             (* ; 
-
                               "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")

-                                 )
-                           (COPYLOOKS                        (* ; "A COPYLOOKS selection")

-                                      (SETQ TEDIT.COPYLOOKS.PENDING T)
-                                                             (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

-                                      (replace
 (SELECTION SET) of
 OSEL with
 NIL))
-                           (MOVE                             (* ; 
-
                               "A MOVE selection -- set the flag to signal the TEdit command loop,")

-                                 (SETQ TEDIT.MOVE.PENDING T) (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

-                                 (replace
 (SELECTION SET) of
 OSEL with
 NIL))
-                           (DELETE (SETQ TEDIT.DEL.PENDING T)
-                                   (replace
 (SELECTION SET) of
 OSEL with
 NIL)
-                                                             (* ; 
-
                                                "And turn off OSEL, to avoid spurious highlighting")

+                          (SETQ OSEL (fetch
 (TEXTOBJ DELETESEL) of
 TEXTOBJ))
+                          (SETQ SELOPERATION 'DELETE)
+                          (TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
+                          (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL))
+                         (T (SETQ OSEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+                            (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 NIL)
+                                                             (* ; "Reset the pending-delete flag.")

+                            ))
+                      (\COPYSEL OSEL GLOBALSEL)
+                      (bind
 (OSELOP _ SELOPERATION)
+                         while
 [OR (SHIFTDOWNP 'SHIFT)
+                                       (SHIFTDOWNP 'CTRL)
+                                       (SHIFTDOWNP 'META)
+                                       (KEYDOWNP 'MOVE)
+                                       (KEYDOWNP 'COPY)
+                                       (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
+                         do
                              (* ; 
+
                                                   "Poll the selection & display its current state")

+                               [COND
+                                  ((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
+                                                             (* ; 
+
                                                  "No mouse buttons are down;  don't try anything.")

+                                   (SETQ OLDX -32000)        (* ; 
+
       "However, remember that pushing a mouse button is a change of status that we should notice.")

                                    )
-                           (NORMAL                           (* ; 
-
                                                 "This is a normal selection;  set the caret looks")

-                                   (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ
-                                      with
 (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
-                           NIL)))
-                   (AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
-                                                             (* ; 
-
                             "Give a user exit routine control, perhaps for logging of selections.")

-                   (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
-                      do
 (OR (fetch
 TCUP of
 CARET)
-                                 (\EDIT.FLIPCARET
 CARET T))))
-               (AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
-                    (fetch
 (SELECTION SELOBJ) of
 OSEL)
-                    (SETQ SELFINALFN (IMAGEOBJPROP (fetch
 (SELECTION SELOBJ) of
 OSEL)
-                                            'WHENOPERATEDONFN))
-                    (APPLY* SELFINALFN (fetch
 (SELECTION SELOBJ) of
 OSEL)
-                           (WINDOWPROP W 'DSP)
-                           'SELECTED OSEL (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ])
+                                  ((KEYDOWNP 'MOVE)          (* ; 
+
                                             "the MOVE key is down;  mark this selection for MOVE.")

+                                   (SETQ SELOPERATION 'MOVE))
+                                  [(OR (SHIFTDOWNP 'SHIFT)
+                                       (KEYDOWNP 'COPY))     (* ; 
+
                                    "the SHIFT key is down;  mark this selection for COPY or MOVE.")

+                                   (COND
+                                      ((SHIFTDOWNP 'CTRL)    (* ; 
+
                                              "He's holding down both ctrl and shift -- do a move.")

+                                       (SETQ SELOPERATION 'MOVE))
+                                      (T                     (* ; 
+
                                                           "Just the SHIFT key.  It's a COPY")

+                                         (SETQ SELOPERATION 'COPY]
+                                  ((SHIFTDOWNP 'META)        (* ; 
+
                                                  "He's holding the meta key down;  note the fact.")

+                                   (SETQ SELOPERATION 'COPYLOOKS))
+                                  ((SHIFTDOWNP 'CTRL)        (* ; 
+
                               "He's holding only the CTRL key -- mark the selection for deletion.")

+                                   (SETQ SELOPERATION 'DELETE))
+                                  (T                         (* ; 
+
                                             "No key being held down;  revert to normal selection.")

+                                     (SETQ SELOPERATION 'NORMAL]
+                               (COND
+                                  [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
+                                            [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
+                                            (NEQ OSELOP SELOPERATION))
+                                        (INSIDEP CLIPREGION X Y))
+
+                                  (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")

+
+                                 (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")

+
+                                   (SETQ OLDX X)
+                                   (SETQ OLDY Y)
+                                   [COND
+                                      ((\TEDIT.MOUSESTATE LEFT)
+                                                             (* ; 
+
                                                           "Left button is character selection")

+                                       (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
+                                                                                          MOUSEREGION
+                                                                                             )
+                                                                              of
 TEXTOBJ)
+                                                        NIL SELOPERATION W))
+                                       (SETQ EXTENDFLG NIL))
+                                      ((\TEDIT.MOUSESTATE MIDDLE)
+                                                             (* ; "Middle button is word selection")

+                                       (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch
 (TEXTOBJ 
+                                                                                          MOUSEREGION
+                                                                                             )
+                                                                              of
 TEXTOBJ)
+                                                        T SELOPERATION W))
+                                       (SETQ EXTENDFLG NIL))
+                                      [(\TEDIT.MOUSESTATE RIGHT)
+                                                             (* ; "RIght button extends selections")

+                                       (COND
+                                          ((NEQ SELOPERATION OSELOP)
+
+                                 (* ;; "Things changed since the last selection.  Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")

+
+                                           (\COPYSEL OSEL GLOBALSEL)))
+                                       (COND
+                                          ((fetch
 (SELECTION SET) of
 GLOBALSEL)
+                                           (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
+                                                                                'NORMAL)
+                                                (SETQ SELOPERATION 'PENDINGDEL)
+                                                (replace
 (TEXTOBJ BLUEPENDINGDELETE) of

+                                                                                         TEXTOBJ
+                                                   with
 T))
+                                                             (* ; 
+
       "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")

+                                           (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ 
+                                                            SELOPERATION W))
+                                           (SETQ EXTENDFLG T]
+                                      (T                     (* ; 
+
                        "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")

+                                         (\COPYSEL OSEL GLOBALSEL)
+                                                             (* ; 
+
                       "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")

+                                         (AND SEL (replace
 (SELECTION SET) of
 SEL
+                                                     with
 NIL]
+                                   [COND
+                                      ((AND SEL (fetch
 (SELECTION SET) of
 SEL)
+                                            SELFN)           (* ; 
+
                               "The selection was set, but there's a SELFN that has veto authority")

+                                       (COND
+                                          ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
+                                               'DON'T)       (* ; 
+
                                              "The selfn vetoed this selection, so mark it un-set.")

+                                           (replace
 (SELECTION SET) of
 SEL with
 NIL]
+                                   (COND
+                                      ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
+                                                             (* ; 
+
             "Something interesting about the selection changed.  We have to re-display its image.")

+                                       (COND
+                                          ((OR (EQ SELOPERATION 'NORMAL)
+                                               (EQ SELOPERATION 'PENDINGDEL))
+                                                             (* ; 
+
                        "For a normal selection, set the 'window last selected in' for the TEXTOBJ")

+                                           (replace
 (TEXTOBJ SELWINDOW) of
 TEXTOBJ
+                                              with
 W)))
+                                       (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP 
+                                                         SELOPERATION EXTENDFLG))
+                                       (SETQ OSELOP SELOPERATION))
+                                      ([AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
+                                            (EQ (fetch
 (SELECTION SELKIND) of
 OSEL)
+                                                'VOLATILE)
+                                            (OR (NOT SEL)
+                                                (NOT (fetch
 (SELECTION SET) of
 SEL]
+
+                                 (* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it.  Turn it off.")

+
+                                       (\SHOWSEL OSEL NIL NIL)
+                                       (replace
 (SELECTION SET) of
 OSEL with
 NIL]
+                                  ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
+                                                             (* ; 
+
                                    "If he moves to the scroll bar, let him scroll without trouble")

+                                   (SCROLL.HANDLER W)))
+                               (BLOCK)                       (* ; "Give other processes a chance")

+                               (GETMOUSESTATE)               (* ; "And get the new mouse info")

+                               (TEDIT.CURSORMOVEDFN
 W))
+                      (\COPYSEL OSEL GLOBALSEL)
+                      (COND
+                         ((fetch
 (SELECTION SET) of
 OSEL)
+                                                             (* ; 
+
                                        "Only if a selection REALLY got made should we do this....")

+                          (SELECTQ SELOPERATION
+                              (COPY                          (* ; 
+
           "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")

+                                    (SETQ TEDIT.COPY.PENDING T)
+                                    (replace
 (SELECTION SET) of
 OSEL with
 NIL)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                    (\TEDIT.FOREIGN.COPY? GLOBALSEL)
+                                                             (* ; 
+
                               "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")

+                                    )
+                              (COPYLOOKS                     (* ; "A COPYLOOKS selection")

+                                         (SETQ TEDIT.COPYLOOKS.PENDING T)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                         (replace
 (SELECTION SET) of
 OSEL with
 NIL))
+                              (MOVE                          (* ; 
+
                               "A MOVE selection -- set the flag to signal the TEdit command loop,")

+                                    (SETQ TEDIT.MOVE.PENDING T)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                    (replace
 (SELECTION SET) of
 OSEL with
 NIL))
+                              (DELETE (SETQ TEDIT.DEL.PENDING T)
+                                      (replace
 (SELECTION SET) of
 OSEL with
 NIL)
+                                                             (* ; 
+
                                                "And turn off OSEL, to avoid spurious highlighting")

+                                      )
+                              (NORMAL                        (* ; 
+
                                                 "This is a normal selection;  set the caret looks")

+                                      (replace
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ
+                                         with
 (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
+                              NIL)))
+                      (AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
+                                                             (* ; 
+
                             "Give a user exit routine control, perhaps for logging of selections.")

+                      (for
 CARET inside
 (fetch
 (TEXTOBJ CARET) of
 TEXTOBJ)
+                         do
 (OR (fetch
 TCUP of
 CARET)
+                                    (\EDIT.FLIPCARET
 CARET T))))
+                  (AND OSEL (fetch
 (SELECTION SET) of
 OSEL)
+                       (fetch
 (SELECTION SELOBJ) of
 OSEL)
+                       (SETQ SELFINALFN (IMAGEOBJPROP (fetch
 (SELECTION SELOBJ) of
 OSEL)
+                                               'WHENOPERATEDONFN))
+                       (APPLY* SELFINALFN (fetch
 (SELECTION SELOBJ) of
 OSEL)
+                              (WINDOWPROP W 'DSP)
+                              'SELECTED OSEL (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ])])
 
 (\TEDIT.WINDOW.OPS

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

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

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

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

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

@@ -1922,9 +1951,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
       ])
 
 (\TEDIT.SCROLLFN

-  [LAMBDA (W DX DY)
                                      (* ; "Edited 31-May-91 13:32 by jds")

+  [LAMBDA (W DX DY)
                                     (* ; "Edited 19-Sep-2021 23:10 by rmk:")

                                                              (* Handle scrolling of the edit 
 
                                                           window)

+    (TOTOPW W)
     (PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
                   (PRIORCR 0)
                   SELWASON SHIFTEDSELWASON MOVESELWASON DELETESELWASON (WREG (DSPCLIPPINGREGION
@@ -2826,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 (7165 91937 (TEDIT.CREATEW 7175 . 8311) (\TEDIT.CREATEW.FROM.REGION 8313 . 9297) (
-TEDIT.CURSORMOVEDFN 9299 . 19951) (TEDIT.CURSOROUTFN 19953 . 20488) (TEDIT.WINDOW.SETUP 20490 . 22299)
- (TEDIT.MINIMAL.WINDOW.SETUP 22301 . 30090) (\TEDIT.ACTIVE.WINDOWP 30092 . 31073) (
-\TEDIT.BUTTONEVENTFN 31075 . 54913) (\TEDIT.WINDOW.OPS 54915 . 58718) (\TEDIT.EXPANDFN 58720 . 59123) 
-(\TEDIT.MAINW 59125 . 60414) (\TEDIT.PRIMARYW 60416 . 61628) (\TEDIT.COPYINSERTFN 61630 . 62601) (
-\TEDIT.NEWREGIONFN 62603 . 65070) (\TEDIT.SET.WINDOW.EXTENT 65072 . 71174) (\TEDIT.SHRINK.ICONCREATE 
-71176 . 73448) (\TEDIT.SHRINKFN 73450 . 74025) (\TEDIT.SPLITW 74027 . 80128) (\TEDIT.UNSPLITW 80130 . 
-85824) (\TEDIT.WINDOW.SETUP 85826 . 91546) (\SAFE.FIRST 91548 . 91935)) (93083 93990 (TEDITWINDOWP 
-93093 . 93988)) (94027 96523 (TEDIT.GETINPUT 94037 . 96020) (\TEDIT.MAKEFILENAME 96022 . 96521)) (
-96572 103023 (TEDIT.PROMPTPRINT 96582 . 99486) (TEDIT.PROMPTFLASH 99488 . 101443) (
-\TEDIT.PROMPT.PAGEFULLFN 101445 . 103021)) (103258 107320 (TEXTSTREAM.TITLE 103268 . 103889) (
-\TEDIT.ORIGINAL.WINDOW.TITLE 103891 . 105936) (\TEDIT.WINDOW.TITLE 105938 . 106608) (
-\TEXTSTREAM.FILENAME 106610 . 107318)) (107363 152087 (TEDIT.DEACTIVATE.WINDOW 107373 . 114522) (
-\TEDIT.REPAINTFN 114524 . 117381) (\TEDIT.RESHAPEFN 117383 . 123003) (\TEDIT.SCROLLFN 123005 . 152085)
-) (152129 154178 (\TEDIT.PROCIDLEFN 152139 . 153488) (\TEDIT.PROCENTRYFN 153490 . 153783) (
-\TEDIT.PROCEXITFN 153785 . 154176)) (154257 165257 (\EDIT.DOWNCARET 154267 . 154948) (\EDIT.FLIPCARET 
-154950 . 156485) (TEDIT.FLASHCARET 156487 . 157601) (\EDIT.UPCARET 157603 . 158056) (
-TEDIT.NORMALIZECARET 158058 . 164009) (\SETCARET 164011 . 164931) (\TEDIT.CARET 164933 . 165255)) (
-165291 179046 (TEDIT.ADD.MENUITEM 165301 . 167216) (TEDIT.DEFAULT.MENUFN 167218 . 176485) (
-TEDIT.REMOVE.MENUITEM 176487 . 177488) (\TEDIT.CREATEMENU 177490 . 177943) (\TEDIT.MENU.WHENHELDFN 
-177945 . 178715) (\TEDIT.MENU.WHENSELECTEDFN 178717 . 179044)))))
+  (FILEMAP (NIL (7291 94107 (TEDIT.CREATEW 7301 . 8437) (\TEDIT.CREATEW.FROM.REGION 8439 . 9423) (
+TEDIT.CURSORMOVEDFN 9425 . 20811) (TEDIT.CURSOROUTFN 20813 . 21348) (TEDIT.WINDOW.SETUP 21350 . 23159)
+ (TEDIT.MINIMAL.WINDOW.SETUP 23161 . 30950) (\TEDIT.ACTIVE.WINDOWP 30952 . 31933) (
+\TEDIT.BUTTONEVENTFN 31935 . 56925) (\TEDIT.WINDOW.OPS 56927 . 60888) (\TEDIT.EXPANDFN 60890 . 61293) 
+(\TEDIT.MAINW 61295 . 62584) (\TEDIT.PRIMARYW 62586 . 63798) (\TEDIT.COPYINSERTFN 63800 . 64771) (
+\TEDIT.NEWREGIONFN 64773 . 67240) (\TEDIT.SET.WINDOW.EXTENT 67242 . 73344) (\TEDIT.SHRINK.ICONCREATE 
+73346 . 75618) (\TEDIT.SHRINKFN 75620 . 76195) (\TEDIT.SPLITW 76197 . 82298) (\TEDIT.UNSPLITW 82300 . 
+87994) (\TEDIT.WINDOW.SETUP 87996 . 93716) (\SAFE.FIRST 93718 . 94105)) (95437 96344 (TEDITWINDOWP 
+95447 . 96342)) (96381 98877 (TEDIT.GETINPUT 96391 . 98374) (\TEDIT.MAKEFILENAME 98376 . 98875)) (
+98926 105377 (TEDIT.PROMPTPRINT 98936 . 101840) (TEDIT.PROMPTFLASH 101842 . 103797) (
+\TEDIT.PROMPT.PAGEFULLFN 103799 . 105375)) (105612 109674 (TEXTSTREAM.TITLE 105622 . 106243) (
+\TEDIT.ORIGINAL.WINDOW.TITLE 106245 . 108290) (\TEDIT.WINDOW.TITLE 108292 . 108962) (
+\TEXTSTREAM.FILENAME 108964 . 109672)) (109717 154616 (TEDIT.DEACTIVATE.WINDOW 109727 . 117034) (
+\TEDIT.REPAINTFN 117036 . 119893) (\TEDIT.RESHAPEFN 119895 . 125515) (\TEDIT.SCROLLFN 125517 . 154614)
+) (154658 156707 (\TEDIT.PROCIDLEFN 154668 . 156017) (\TEDIT.PROCENTRYFN 156019 . 156312) (
+\TEDIT.PROCEXITFN 156314 . 156705)) (156786 167786 (\EDIT.DOWNCARET 156796 . 157477) (\EDIT.FLIPCARET 
+157479 . 159014) (TEDIT.FLASHCARET 159016 . 160130) (\EDIT.UPCARET 160132 . 160585) (
+TEDIT.NORMALIZECARET 160587 . 166538) (\SETCARET 166540 . 167460) (\TEDIT.CARET 167462 . 167784)) (
+167820 181575 (TEDIT.ADD.MENUITEM 167830 . 169745) (TEDIT.DEFAULT.MENUFN 169747 . 179014) (
+TEDIT.REMOVE.MENUITEM 179016 . 180017) (\TEDIT.CREATEMENU 180019 . 180472) (\TEDIT.MENU.WHENHELDFN 
+180474 . 181244) (\TEDIT.MENU.WHENSELECTEDFN 181246 . 181573)))))
 STOP

library/TEXTOFD

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 
-    (* ;; "F4")

+    (* ;; "F4")

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

+(\TEDITOUTCCODEFN

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

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

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

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

library/UNICODE

@@ -1,18 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "21-Aug-2021 13:13:04" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193
 64903  
+
(FILECREATED "30-Sep-2021 16:03:18" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;194
 64783  
 
-      changes to%:  (FNS MAKE-UNICODE-TRANSLATION-TABLES)
-
-      previous date%: " 8-Aug-2021 13:10:17" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;192)
+      previous date%: "21-Aug-2021 13:13:04" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
 
 (RPAQQ UNICODECOMS

        [(COMS 
-              (* ;; "External formats")

+              (* ;; "External formats")

 
               (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
               (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
@@ -25,14 +23,14 @@
               (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE))
               (FNS XTOUCODE UTOXCODE))
         [COMS 
-              (* ;; "Unicode mapping files")

+              (* ;; "Unicode mapping files")

 
               (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING 
                    WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER WRITE-UNICODE-MAPPING-FILENAME
                    )
               (VARS XCCS-SET-NAMES)
               
-              (* ;; "Automate dumping of a documentation prefix")

+              (* ;; "Automate dumping of a documentation prefix")

 
               [DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE" 
                                                                               :RADIX 16))
@@ -43,7 +41,7 @@
               (P (PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR")
                                                     '/unicode/xerox/]
         (COMS 
-              (* ;; "Set up translation tables for UTF8 and UTFBE external formats")

+              (* ;; "Set up translation tables for UTF8 and UTFBE external formats")

 
               (FNS MAKE-UNICODE-TRANSLATION-TABLES)
               [INITVARS (DEFAULT-XCCS-CHARSETS '(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS 
@@ -63,7 +61,7 @@
                                                  "NOTE: UNICODE requires EXPORTS.ALL for compilation"
                                                        T)))
                
-               (* ;; "These control the layout of the translation tables.  Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")

+               (* ;; "These control the layout of the translation tables.  Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")

 
                (CONSTANTS (TRANSLATION-SEGMENT-SIZE 128)
                       (MAX-ALIST-LENGTH 10)
@@ -78,13 +76,13 @@
 (DEFINEQ
 
 (UTF8.OUTCHARFN

-  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  8-Aug-2021 13:02 by rmk:")


-                                                            (* ; "Edited 17-Aug-2020 08:45 by rmk:")


-                                                            (* ; "Edited 30-Jan-2020 23:08 by rmk:")

+  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  8-Aug-2021 13:02 by rmk:")


+                                                            (* ; "Edited 17-Aug-2020 08:45 by rmk:")


+                                                            (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
-    (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")

+    (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")

 
-    (* ;; "Print UTF8 sequence for CHARCODE.  Do not do XCCS to Unicode translation if RAW.")

+    (* ;; "Print UTF8 sequence for CHARCODE.  Do not do XCCS to Unicode translation if RAW.")

 
     (IF
 (EQ CHARCODE (CHARCODE EOL))
         THEN
 (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
@@ -97,13 +95,13 @@
                DO
 (IF
 (ILESSP C 128)
                           THEN
 (\BOUT STREAM C)
                         ELSEIF
 (ILESSP C 2048)
-                          THEN
                           (* ; "x800")

+                          THEN
                           (* ; "x800")

                                 (\BOUT STREAM (LOGOR (LLSH 3 6)
                                                      (LRSH C 6)))
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
                                                      (LOADBYTE C 0 6)))
                         ELSEIF
 (ILESSP C 65536)
-                          THEN
                           (* ; "x10000")

+                          THEN
                           (* ; "x10000")

                                 (\BOUT STREAM (LOGOR (LLSH 7 5)
                                                      (LRSH C 12)))
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
@@ -111,7 +109,7 @@
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
                                                      (LOADBYTE C 0 6)))
                         ELSEIF
 (ILESSP C 2097152)
-                          THEN
                           (* ; "x200000")

+                          THEN
                           (* ; "x200000")

                                 (\BOUT STREAM (LOGOR (LLSH 15 4)
                                                      (LRSH C 18)))
                                 (\BOUT STREAM (LOGOR (LLSH 2 6)
@@ -123,29 +121,29 @@
                         ELSE
 (ERROR "CHARCODE too big for UTF8" C])
 
 (UTF8.INCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                           (* ; "Edited  6-Aug-2021 16:02 by rmk:")


-                                                            (* ; "Edited  6-Aug-2020 17:13 by rmk:")

+  [LAMBDA (STREAM COUNTP RAW)
                           (* ; "Edited  6-Aug-2021 16:02 by rmk:")


+                                                            (* ; "Edited  6-Aug-2020 17:13 by rmk:")

 
-    (* ;; "Do not do UNICODE to XCSS translation if RAW.")

+    (* ;; "Do not do UNICODE to XCSS translation if RAW.")

 
-    (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")

+    (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (LET (BYTE1 BYTE2 BYTE3 BYTE4 CODE (COUNT
 1))
          (SETQ BYTE1 (\BIN STREAM))
 
-         (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1")

+         (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1")

 
          (CL:WHEN (SMALLP BYTE1)
              [SETQ CODE (IF
 (ILESSP BYTE1 128)
                             THEN
 
 
-                                  (* ;; 
-
                         "Test first:  Ascii is the common case.  EOL requires its own translation")

+                                  (* ;; 
+
                         "Test first:  Ascii is the common case.  EOL requires its own translation")

 
                                   (SELCHARQ BYTE1
                                        (CR (SELECTC (FETCH
 (STREAM EOLCONVENTION) OF
 STREAM)
-                                               (CR.EOLC      (* ; "Also eq BYTE1")

+                                               (CR.EOLC      (* ; "Also eq BYTE1")

                                                         (CHARCODE EOL))
                                                (CRLF.EOLC (IF
 (EQ (CHARCODE LF)
                                                                       (\PEEKBIN STREAM T))
@@ -160,7 +158,7 @@
                                                BYTE1))
                                        BYTE1)
                           ELSEIF
 (IGEQ BYTE1 (LLSH 15 4))
-                            THEN
                         (* ; "4 bytes")

+                            THEN
                         (* ; "4 bytes")

                                   (SETQ BYTE2 (\BIN STREAM))
                                   (CL:WHEN (OR (NOT (SMALLP BYTE2))
                                                (ILESSP BYTE2 128))
@@ -182,7 +180,7 @@
                                                6)
                                          (LOADBYTE BYTE4 0 6))
                           ELSEIF
 (IGEQ BYTE1 (LLSH 7 5))
-                            THEN
                         (* ; "3 bytes")

+                            THEN
                         (* ; "3 bytes")

                                   (SETQ BYTE2 (\BIN STREAM))
                                   (CL:WHEN (OR (NOT (SMALLP BYTE2))
                                                (ILESSP BYTE2 128))
@@ -197,7 +195,7 @@
                                          (LLSH (LOADBYTE BYTE2 0 6)
                                                6)
                                          (LOADBYTE BYTE3 0 6))
-                          ELSE
                           (* ; "Must be 2 bytes")

+                          ELSE
                           (* ; "Must be 2 bytes")

                                 (SETQ COUNT 2)
                                 (SETQ BYTE2 (\BIN STREAM))
                                 (CL:WHEN (OR (NOT (SMALLP BYTE2))
@@ -211,12 +209,97 @@
          (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
          CODE])
 
-(UTF8.PEEKCCODEFN

+(UTF8.PEEKCCODEFN

+  [LAMBDA (STREAM NOERROR RAW)
                          (* ; "Edited 14-Jun-2021 22:53 by rmk:")

+
+    (* ;; "Modeled this after \EUCPEEK on LLREAD.  In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0.  Returns NIL if NOERROR and either invalid UTF8 or end of file.")

+
+    (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

+
+    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+
+    (PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE)
+          (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
+
+     (* ;; "Distinguish on header bytex")

+
+          (CL:UNLESS BYTE1 (RETURN NIL))
+          [IF
 (ILESSP BYTE1 128)
+              THEN
 
+
+                    (* ;; 
+
                  "Test first:  Ascii is the common case.  No need to back up, since we peeked.")

+
+                    (SETQ CODE BYTE1)
+            ELSEIF
 (IGEQ BYTE1 (LLSH 15 4))
+              THEN
                                       (* ; "4 bytes")

+                    (\BIN STREAM)
+                    (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                                    (IGEQ BYTE2 128))
+                        (\BACKFILEPTR STREAM)
+                        (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
+                        (RETURN CODE))
+                    (\BIN STREAM)
+                    (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR))
+                                    (IGEQ BYTE3 128))
+                        (\BACKFILEPTR STREAM)
+                        (\BACKFILEPTR STREAM)
+                        (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
+                        (RETURN CODE))
+                    (\BIN STREAM)
+                    (SETQ BYTE4 (\PEEKBIN STREAM NOERROR))   (* ; 
+
                                                           "PEEK the last, no need to back it up")

+                    (\BACKFILEPTR STREAM)
+                    (\BACKFILEPTR STREAM)
+                    (\BACKFILEPTR STREAM)
+                    (IF
 (AND BYTE4 (IGEQ BYTE4 128))
+                        THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3)
+                                                         18)
+                                                   (LLSH (LOADBYTE BYTE2 0 6)
+                                                         12)
+                                                   (LLSH (LOADBYTE BYTE3 0 6)
+                                                         6)
+                                                   (LOADBYTE BYTE4 0 6)))
+                      ELSEIF
 NOERROR
+                      ELSE
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4)))
+            ELSEIF
 (IGEQ BYTE1 (LLSH 7 5))
+              THEN
                                       (* ; "3 bytes")

+                    (\BIN STREAM)
+                    (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                                    (IGEQ BYTE2 128))
+                        (\BACKFILEPTR STREAM)
+                        (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
+                        (RETURN CODE))
+                    (\BIN STREAM)
+                    (SETQ BYTE3 (\PEEKBIN STREAM NOERROR))
+                    (\BACKFILEPTR STREAM)
+                    (\BACKFILEPTR STREAM)
+                    (IF
 (AND BYTE3 (IGEQ BYTE3 128))
+                        THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4)
+                                                         12)
+                                                   (LLSH (LOADBYTE BYTE2 0 6)
+                                                         6)
+                                                   (LOADBYTE BYTE3 0 6)))
+                      ELSEIF
 NOERROR
+                      ELSE
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
+            ELSE
                                         (* ; "Must be 2 bytes")

+                  (\BIN STREAM)
+                  (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                  (\BACKFILEPTR STREAM)
+                  (IF
 (AND BYTE2 (IGEQ BYTE2 128))
+                      THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
+                                                       6)
+                                                 (LOADBYTE BYTE2 0 6)))
+                    ELSEIF
 NOERROR
+                    ELSE
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2]
+          (CL:WHEN (AND CODE (NOT RAW))
+              (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
+          (RETURN CODE])
 
 (\UTF8.BACKCCODEFN

-    (* ;; "Modeled this after \EUCPEEK on LLREAD.  In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0.  Returns NIL if NOERROR and either invalid UTF8 or end of file.")

+  [LAMBDA (STREAM COUNTP)
                               (* ; "Edited  6-Aug-2021 16:04 by rmk:")

 
-    (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

+    (* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (BIND
 (C _ 0) WHILE
 (CL:WHEN (\BACKFILEPTR STREAM)
@@ -228,12 +311,12 @@
 (DEFINEQ
 
 (UTF16BE.OUTCHARFN

-
-                    (* ;; 
+  [LAMBDA (STREAM CHARCODE RAW)
                         (* ; "Edited  8-Aug-2021 13:09 by rmk:")


+                                                            (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
-
+    (* ;; "PRINT UTF16 sequence for CHARCODE.  Do not do XCCS to UNICODE translation if RAW.")

 
-            ELSEIF
 (IGEQ BYTE1 (LLSH 15 4))
+    (* ;; "Not sure about EOL conversion if truly %"raw%"")

 
     (IF
 (EQ CHARCODE (CHARCODE EOL))
         THEN
 (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
@@ -245,10 +328,10 @@
        DO
 (\WOUT STREAM C])
 
 (UTF16BE.INCCODEFN

-                        (\BACKFILEPTR STREAM)
+  [LAMBDA (STREAM COUNTP RAW)
                           (* ; "Edited  6-Aug-2021 16:05 by rmk:")

 
-                        (RETURN CODE))
-                    (\BIN STREAM)
+    (* ;; 
+
  "Do not do UNICODE to XCCS translation if RAW.  Test for SMALLPin case of funky EOF behavior")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (LET (CODE BYTE1 BYTE2 COUNT)
@@ -264,14 +347,37 @@
                    CODE
            ELSE
 (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
 
-            ELSEIF
 (IGEQ BYTE1 (LLSH 7 5))
+(UTF16BE.PEEKCCODEFN

+  [LAMBDA (STREAM NOERROR RAW)
                          (* ; "Edited 14-Jun-2021 22:58 by rmk:")

+
+    (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

+
+    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+
+    (LET (BYTE1 BYTE2 CODE)
+         (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
+         (IF
 BYTE1
+             THEN
 (\BIN STREAM)
+                   (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+                   (\BACKFILEPTR STREAM)
+                   (IF
 BYTE2
+                       THEN
 (SETQ CODE (LOGOR (LLSH BYTE1 8)
+                                                  BYTE2))
+                             (CL:IF RAW
+                                 CODE
+                                 (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
+                     ELSEIF
 NOERROR
+                       THEN
 NIL)
+           ELSEIF
 NOERROR
+             THEN
 NIL
+           ELSE
 (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
 
 (\UTF16.BACKCCODEFN

-                    (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
+  [LAMBDA (STREAM COUNTP)
                               (* ; "Edited  6-Aug-2021 16:07 by rmk:")

 
-                        (\BACKFILEPTR STREAM)
+    (* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")

 
-                        (RETURN CODE))
+    (* ;; "Common for big-ending and little-ending")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (CL:WHEN (\BACKFILEPTR STREAM)
@@ -285,11 +391,11 @@
 (DEFINEQ
 
 (MAKE-UNICODE-FORMATS

-                  (\BIN STREAM)
+  [LAMBDA (EXTERNALEOL)
                                 (* ; "Edited  6-Aug-2021 16:08 by rmk:")

 
-                  (\BACKFILEPTR STREAM)
+    (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")

 
-                      THEN
 (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
+    (* ;; "The EXTERNALEOL specifies the EOLCONVENTION of the stream, particularly to produce output files with the desired convention.  On input the macro \CHECKEOLC (LLREAD) coerces only that coding to the internal EOL, which is a mistake.")

 
     (MAKE-EXTERNALFORMAT :UTF-8 (FUNCTION UTF8.INCCODEFN)
            (FUNCTION UTF8.PEEKCCODEFN)
@@ -325,11 +431,11 @@
 (DEFINEQ
 
 (UNICODE.UNMAPPED

-                              CHARCODE
+  [LAMBDA (CODE TRANSLATION-TABLE)
                      (* ; "Edited 11-Aug-2020 20:23 by rmk:")

 
-       DO
 (\WOUT STREAM C])
+    (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODED has no fast mapping in TRANSLATION-TABLE.")

 
-(UTF16BE.INCCODEFN

+    (* ;; "We return an existing entry in the hash array of the table.  If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.")

 
     (LET ((FORWARD (CL:SVREF TRANSLATION-TABLE N-TRANSLATION-SEGMENTS))
           INVERSE NEXTCODE)
@@ -349,9 +455,9 @@
 (DEFINEQ
 
 (XCCS-UTF8-AFTER-OPEN

-(UTF16BE.PEEKCCODEFN

+  [LAMBDA (STREAM ACCESS PARAMETERS)
                    (* ; "Edited 13-Aug-2020 11:54 by rmk:")

 
-
+    (* ;; "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF8.")

 
     (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
                   [EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM)
@@ -379,11 +485,11 @@
 (DEFINEQ
 
 (XTOUCODE

-    (* ;; "Common for big-ending and little-ending")

+  [LAMBDA (XCCSCODE)
                                    (* ; "Edited  9-Aug-2020 09:04 by rmk:")

     (UNICODE.TRANSLATE XCCSCODE *XCCSTOUNICODE*])
 
 (UTOXCODE

-        (IF
 (\BACKFILEPTR STREAM)
+  [LAMBDA (UNICODE)
                                     (* ; "Edited  9-Aug-2020 09:04 by rmk:")

     (UNICODE.TRANSLATE UNICODE *UNICODETOXCCS*])
 )
 
@@ -394,9 +500,8 @@
 (DEFINEQ
 
 (READ-UNICODE-MAPPING-FILENAMES

-
-    (* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")

-
+  [LAMBDA (FILESPEC)
                                  (* ; "Edited  5-Aug-2020 15:59 by kaplan")


+                                                            (* ; "Edited  4-Aug-2020 17:31 by rmk:")

     (FOR
 F X CSI INSIDE
 FILESPEC
        COLLECT
 (IF
 (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT)
                                   T UNICODEDIRECTORIES)
@@ -412,24 +517,24 @@
                      ELSE
 F])
 
 (READ-UNICODE-MAPPING

-    (MAKE-EXTERNALFORMAT :UTF-16BE (FUNCTION UTF16BE.INCCODEFN)
+  [LAMBDA (FILESPEC NOPRINT NOERROR)
                    (* ; "Edited  3-Jul-2021 13:37 by rmk:")

 
-           (FUNCTION \UTF16.BACKCCODEFN)
+    (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format.  Comments prefixed by # and")

 
-           NIL EXTERNALEOL)
+    (* ;; "               Column 1:  Input hex code in the format 0xXXXX")

 
-                                                   (UTF16BE.INCCODEFN
 STREAM COUNTP T]
+    (* ;; "               Column 2:  Corresponding Unicode code-sequence in the format")

 
-                       (UTF16BE.PEEKCCODEFN
 STREAM NOERROR T]
+    (* ;; "                                            0xXXXX  ... 0xYYYY")

 
-           [FUNCTION (LAMBDA (STREAM CHARCODE)
-                       (UTF16BE.OUTCHARFN
 STREAM CHARCODE T]
+    (* ;; 
+
  "               Column 3:  (after #) Character name in some mapping files, utf-8 character")

 
-)
+    (* ;; "                                     for XCCS mapping files")

 
-(MAKE-UNICODE-FORMATS
 EXTERNALEOL)
+    (* ;; "")

 
-(ADDTOVAR *DEFAULT-EXTERNALFORMATS*
 (UNIX :UTF-8))
+    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")

 
     (FOR
 FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] IN
 (
 
                                                                     READ-UNICODE-MAPPING-FILENAMES

@@ -461,18 +566,18 @@
                                                                    (NTHCHARCODE LINE START])
 
 (WRITE-UNICODE-MAPPING

-    (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
+  [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK)
        (* ; "Edited 16-Aug-2020 16:56 by rmk:")

 
-                                          'EXTENSION]
+    (* ;; "Writes a symbol unicode mapping file.  Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.")

 
-        (STREAMPROP STREAM 'EXTERNALFORMAT :UTF8))])
+    (* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.")

 
-(DECLARE%: EVAL@COMPILE DONTCOPY 
+    (* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab>#  Unicode-char")

 
-
-(PUTPROPS UNICODE.TRANSLATE
 MACRO
 [OPENLAMBDA (CODE TRANSLATION-TABLE)
+    (* ;; 
+
  "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.")

 
-                                                                                    TRANSLATION-SHIFT
+    (* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.")

 
     (IF
 (AND (EQ INCLUDECHARSETS T)
                  (NULL FILE))
@@ -513,15 +618,15 @@
                                      "	#  "
                                      (SELECTC FIRSTRIGHTC
                                          (UNDEFINEDCODE 
-                                                                     (CADR CSI))
+                                                        (* ;; "FFFF")

 
                                                         "UNDEFINED")
                                          (MISSINGCODE 
-                     ELSE
 F])
+                                                      (* ;; "FFFE")

 
                                                       "MISSING")
                                          (IF
 (ILESSP FIRSTRIGHTC 32)
-
+                                             THEN
        (* ; "Control chars")

                                                    [CONCAT "^" (CHARACTER (IPLUS FIRSTRIGHTC
                                                                                  (CHARCODE @]
                                            ELSE
 (CHARACTER FIRSTRIGHTC)))
@@ -535,13 +640,13 @@
                  NIL])
 
 (WRITE-UNICODE-INCLUDED

-    (* ;; "")

+  [LAMBDA (MAPPING INCLUDECHARSETS)
                     (* ; "Edited  4-Aug-2020 17:47 by rmk:")

 
-    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")

+    (* ;; "CSETINFO is a list of (num string name) for each included character set.")

 
     (LET (CHARSETS CSETINFO RANGES ICSETS IMAPPING)
 
-                                                                             FILESPEC)
+         (* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings")

 
          [SETQ ICSETS (FOR
 C POS KNOWN INSIDE
 (OR INCLUDECHARSETS (FOR
 CSI IN
 
                                                                                        XCCS-SET-NAMES
@@ -569,13 +674,13 @@
                                                                                 ICSETS))
                            COLLECT
 
 
-  [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK)
        (* ; "Edited 16-Aug-2020 16:56 by rmk:")

+                                 (* ;; "The attested subset of INCLUDED")

 
                                  (CL:UNLESS (MEMB CSI CSETINFO)
                                         (PUSH
 CSETINFO CSI))
                                  M))
 
-    (* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab>#  Unicode-char")

+         (* ;; "Sort as numbers, not octal strings, then group into consecutive ranges")

 
          (SETQ CSETINFO (SORT CSETINFO T))
          [SETQ RANGES (FOR
 CTAIL C START END ON
 (FOR
 CSI IN
 CSETINFO
@@ -587,7 +692,7 @@
                                               COLLECT
 (SETQ CTAIL (CDR CTAIL))
                                                     (SETQ END (CAR CTAIL]
 
-                                                                              MAPPING
+         (* ;; "Split out groups of less than 3.  But if a range exhaustively covers a known subset (like JIS), replace by the name")

 
          [SETQ RANGES (FOR
 R STR KNOWN LAST IN
 RANGES
                          JOIN
 (SETQ LAST (CAR (LAST R)))
@@ -607,9 +712,9 @@
          (CL:VALUES IMAPPING CSETINFO RANGES])
 
 (WRITE-UNICODE-MAPPING-HEADER

-                              (CL:UNLESS (EQ CSET (LRSH LEFTC 8))
+  [LAMBDA (STREAM CSETINFO RANGES)
                      (* ; "Edited  4-Aug-2020 17:38 by rmk:")

 
-                                  (SETQ CSI (ASSOC CSET CSETINFO))
+    (* ;; "Writes the standard per-file header information")

 
     (FOR
 LINE IN
 UNICODE-MAPPING-HEADER
        DO
 (PRINTOUT STREAM "#" 2)
@@ -620,7 +725,7 @@
                           THEN
 (PRINTOUT STREAM "s:" -4)
                                 (FOR
 R IN
 RANGES DO
 (PRINTOUT STREAM R " "))
                                 (TERPRI STREAM)
-                                         (UNDEFINEDCODE 
+                        ELSE
                             (* ; "Singleton")

                               (PRINTOUT STREAM ": " -4 (CADAR CSETINFO)
                                      " "
                                      (CADDAR CSETINFO)))
@@ -632,7 +737,7 @@
     (TERPRI STREAM])
 
 (WRITE-UNICODE-MAPPING-FILENAME

-                                           ELSE
 (CHARACTER FIRSTRIGHTC)))
+  [LAMBDA (FILE CSETINFO RANGES)
                        (* ; "Edited  4-Aug-2020 19:34 by rmk:")

     (PACKFILENAME 'BODY [OR FILE (CONCATLIST
                                   (CONS 'XCCS- (IF
 (CDR CSETINFO)
                                                    THEN
 (FOR
 RTAIL R ON
 RANGES
@@ -736,53 +841,53 @@
 (DEFINEQ
 
 (MAKE-UNICODE-TRANSLATION-TABLES

-                 (PRINTOUT STREAM LINE T)))
-    (TERPRI STREAM])
+  [LAMBDA (MAPPING LTORVAR RTOLVAR)
                     (* ; "Edited 21-Aug-2021 13:12 by rmk:")


+                                                            (* ; "Edited 17-Aug-2020 08:46 by rmk:")

 
-(WRITE-UNICODE-MAPPING-FILENAME

+    (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.")

 
-    (PACKFILENAME 'BODY [OR FILE (CONCATLIST
+    (* ;; "This produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).")

 
-                                                   THEN
 (FOR
 RTAIL R ON
 RANGES
+    (* ;; "")

 
-                                                                     (SETQ R
+    (* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme.  But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.")

 
-                                                                          (LIST (CAR R)
+    (* ;; " ")

 
-                                                                                (CDR R))
+    (* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code.  An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes).  The latter is used to save space for sparsely populated character sets.")

 
-                                                                     (CL:IF (CDR RTAIL)
+    (* ;; "")

 
-                                                                     R)
+    (* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping.  Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.")

 
-                                                                "="
+    (* ;; "")

 
-           'DIRECTORY
+    (* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).")

 
-           'EXTENSION
+    (* ;; "")

 
-)
-
+    (* ;; 
+
  "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")

 
-       (("0" LATIN)
+    (* ;; "")

 
-        ("42" SYMBOLS2)
+    (* ;; "For the convenience of not having to deal with the multiple values, if LTORVAR or RTOLVAR are given, they are set to the constructed arrays before return.")

 
-        ("44" HIRAGANA)
+    (* ;; "")

 
     (LET ((LTORARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS)
                             :INITIAL-ELEMENT NIL))
           (RTOLARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS)
                             :INITIAL-ELEMENT NIL)))
 
-        ("341" HEBREW)
+         (* ;; "The left-to-right direction (into Unicode).    We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte).  The second loop converts long alists into arrays.")

 
          [FOR
 M LEFTC RBASE RCODES IN
 MAPPING EACHTIME
 (SETQ RCODES (CDR M))
                                                             (SETQ RBASE (CAR RCODES))
             UNLESS
 (IGEQ RBASE MISSINGCODE) DO
 (SETQ LEFTC (CAR M)) 
 
-        ("360" LIGATURES)
-        ("361" ACCENTED-LATIN)
+                                                      (* ;; 
+
                                                    "(CDR RCODES) contains combiners on the base")

 
                                                       (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
                                                                      (CL:IF (CDR RCODES)
@@ -796,7 +901,7 @@
                             MAX-ALIST-LENGTH)
             DO
 
 
-
+                  (* ;; "Leave it alone if the alist is short")

 
                   (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
                   (FOR
 P IN
 (CL:SVREF LTORARRAY I)
@@ -806,17 +911,17 @@
                   (CL:SETF (CL:SVREF LTORARRAY I)
                          CSA))
 
-           DATE "        Author:           Ron Kaplan <Ron.Kaplan@post.harvard.edu>" "" 
+         (* ;; "")

 
-           "XC1-3-3-0, 1987) into Unicode 3.0. standard codes.  That is the version of" 
+         (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.")

 
          (FOR
 M LEFTC RBASE RCOMBINERS PREV IN
 MAPPING EACHTIME
 (SETQ RBASE (CADR M))
                                                                      (SETQ RCOMBINERS (CDDR M))
             UNLESS
 (OR (IGEQ RBASE MISSINGCODE)
                            RCOMBINERS) DO
 
 
-           "        Unicode character itself (since the Unicode character names" 
-           "        are not available)" 
+                                             (* ;; 
+
                                     "Have we already seen an explicit mapping from right to left?")

 
                                              (SETQ LEFTC (CAR M))
                                              [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
@@ -838,7 +943,7 @@
                             MAX-ALIST-LENGTH)
             DO
 
 
-
+                  (* ;; "Long list, make an array")

 
                   (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
                   (FOR
 P IN
 (CL:SVREF RTOLARRAY I)
@@ -848,9 +953,9 @@
                   (CL:SETF (CL:SVREF RTOLARRAY I)
                          CSA))
 
-
+         (* ;; "")

 
-
+         (* ;; "Allocate the hash arrays for future out-of-map codes.  We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.")

 
          (CL:SETF (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)
                 (LIST (HASHARRAY 10)
@@ -863,14 +968,14 @@
                       (CHARCODE.DECODE "U+F8FF")
                       (CHARCODE.DECODE "U+E000")))
 
-    (* ;; "")

+         (* ;; "Now put in the inverse unmapped hash arrays")

 
          (CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS))
                 (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
          (CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS))
                 (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS))
 
-
  "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")

+         (* ;; "")

 
          (CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY))
          (CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY))
@@ -892,11 +997,11 @@
 (DEFINEQ
 
 (HEXSTRING

-                                                      (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
-                                                                     (CL:IF (CDR RCODES)
+  [LAMBDA (N WIDTH)
                                     (* ; "Edited 23-Jul-2020 08:28 by rmk:")


+                                                             (* ; "Edited 20-Dec-93 17:51 by rmk:")

 
-                                                                         RBASE))
-                                                             (CL:SVREF LTORARRAY (LRSH LEFTC 
+    (* ;; 
+
  "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")

 
     (CL:UNLESS (FIXP N)
         (SETQ N (CHARCODE.DECODE N)))
@@ -915,21 +1020,21 @@
          STR])
 
 (UTF8HEXSTRING

-
+  [LAMBDA (CHARCODE)
                                    (* ; "Edited 10-Aug-2020 08:33 by rmk:")

 
-
+    (* ;; "Utility to produces the UTF8 hexstring representing CODE")

 
     (HEXSTRING
 (IF
 (ILESSP CHARCODE 128)
                        THEN
 CHARCODE
                      ELSEIF
 (ILESSP CHARCODE 2048)
-
+                       THEN
                              (* ; "x800")

                              (LOGOR (LLSH (LOGOR (LLSH 3 6)
                                                  (LRSH CHARCODE 6))
                                           8)
                                     (LOGOR (LLSH 2 6)
                                            (LOADBYTE CHARCODE 0 6)))
                      ELSEIF
 (ILESSP CHARCODE 65536)
-                                                                                    TRANSLATION-SHIFT
+                       THEN
                              (* ; "x10000")

                              (LOGOR (LLSH (LOGOR (LLSH 7 5)
                                                  (LRSH CHARCODE 12))
                                           16)
@@ -939,7 +1044,7 @@
                                     (LOGOR (LLSH 2 6)
                                            (LOADBYTE CHARCODE 0 6)))
                      ELSEIF
 (ILESSP CHARCODE 2097152)
-                                                                 LEFTC)
+                       THEN
                              (* ; "x200000")

                              (LOGOR (LLSH (LOGOR (LLSH 15 4)
                                                  (LRSH CHARCODE 18))
                                           24)
@@ -954,27 +1059,27 @@
                      ELSE
 (ERROR "CHARCODE too big for UTF8" CHARCODE])
 
 (NUTF8CODEBYTES

-                         CSA))
+  [LAMBDA (N)
                                           (* ; "Edited 10-Aug-2020 12:35 by rmk:")

 
-         (* ;; "")

+    (* ;; "Returns the number of bytes needed to encode N in UTF8, ")

 
     (IF
 (ILESSP N 128)
         THEN
 1
       ELSEIF
 (ILESSP N 2048)
-                (LIST (HASHARRAY 10)
+        THEN
                                             (* ; "x800")

               4
       ELSEIF
 (ILESSP N 65536)
-                      (CHARCODE.DECODE "5,0")))
+        THEN
                                             (* ; "x10000")

               3
       ELSEIF
 (ILESSP N 2097152)
-                      (CHARCODE.DECODE "U+E000")
+        THEN
                                             (* ; "x200000")

               2
       ELSE
 (SHOULDNT])
 
 (NUTF8STRINGBYTES

-
+  [LAMBDA (STRING RAWFLG)
                               (* ; "Edited 10-Aug-2020 09:06 by rmk:")

 
-                (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
+    (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ")

 
     (FOR
 I C FROM
 1 WHILE
 (SETQ C (NTHCHARCODE STRING I))
        SUM
 (NUTF8CODEBYTES
 (CL:IF RAWFLG
@@ -982,11 +1087,11 @@
                                        (XTOUCODE
 C))])
 
 (XTOUSTRING

-         (LIST LTORARRAY RTOLARRAY])
+  [LAMBDA (XCCSSTRING
 RAWFLG)
                       (* ; "Edited 10-Aug-2020 21:42 by rmk:")

 
-
+    (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING.  Applies the XCCSTOUNICODE translation unless RAWFLG.  ")

 
-                                         ACCENTED-LATIN GREEK))
+    (* ;; "The resulting string will not be readable inside Medley.")

 
     (LET [(USTR (ALLOCSTRING (NUTF8STRINGBYTES
 XCCSSTRING RAWFLG]
          (FOR
 I CHARCODE (SINDEX _ 0) FROM
 1 WHILE
 (SETQ CHARCODE (NTHCHARCODE XCCSSTRING
@@ -997,7 +1102,7 @@
                       THEN
 (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                       CHARCODE)
                     ELSEIF
 (ILESSP CHARCODE 2048)
-(DEFINEQ
+                      THEN
                               (* ; "x800")

                             (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                    (LOGOR (LLSH 3 6)
                                           (LRSH CHARCODE 6)))
@@ -1005,7 +1110,7 @@
                                    (LOGOR (LLSH 2 6)
                                           (LOADBYTE CHARCODE 0 6)))
                     ELSEIF
 (ILESSP CHARCODE 65536)
-
+                      THEN
                               (* ; "x10000")

                             (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                    (LOGOR (LLSH 7 5)
                                           (LRSH CHARCODE 12)))
@@ -1016,7 +1121,7 @@
                                    (LOGOR (LLSH 2 6)
                                           (LOADBYTE CHARCODE 0 6)))
                     ELSEIF
 (ILESSP CHARCODE 2097152)
-                                         THEN
 (+ CHAR (CHARCODE 0))
+                      THEN
                               (* ; "x200000")

                             (RPLCHARCODE USTR (ADD
 SINDEX 1)
                                    (LOGOR (LLSH 15 4)
                                           (LRSH CHARCODE 18)))
@@ -1033,9 +1138,9 @@
          USTR])
 
 (XCCSSTRING

-                                          8)
+  [LAMBDA (CODE)
                                        (* ; "Edited 13-Aug-2020 12:16 by rmk:")

 
-                                           (LOADBYTE CHARCODE 0 6)))
+    (* ;; "Returns XCCS character representation of string %"cset,char%"")

 
     (CL:UNLESS (FIXP CODE)
         (SETQ CODE (CHCON1 CODE)))
@@ -1046,14 +1151,14 @@
 (DEFINEQ
 
 (SHOWCHARS

-                     ELSEIF
 (ILESSP CHARCODE 2097152)
+  [LAMBDA (FROMCHAR TOCHAR FONT)
                        (* ; "Edited  1-Aug-2020 09:27 by rmk:")

     (RESETFORM (DSPFONT (OR FONT '(CLASSIC 12))
                       T)
            (CL:WHEN (AND (SMALLP FROMCHAR)
                          (NOT TOCHAR))
 
-                                                 (LOADBYTE CHARCODE 12 6))
-                                          16)
+               (* ;; 
+
    "If a small number, assume it's an octal (in decimal) character set, no need for string quotes")

 
                (SETQ TOCHAR (CONCAT FROMCHAR "," 376))
                (SETQ FROMCHAR (CONCAT FROMCHAR "," 41)))
@@ -1100,15 +1205,15 @@
 )
 )
 (DECLARE%: DONTCOPY
-                       (SETQ CHARCODE (XTOUCODE
 CHARCODE)))
-                  (IF
 (ILESSP CHARCODE 128)
-                      THEN
 (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                                      CHARCODE)
-                    ELSEIF
 (ILESSP CHARCODE 2048)
-                      THEN
                               (* ; "x800")

-                            (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                                   (LOGOR (LLSH 3 6)
-                                          (LRSH CHARCODE 6)))
-                            (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                                   (LOGOR (LLSH 2 6)
+  (FILEMAP (NIL (4046 17726 (UTF8.OUTCHARFN 4056 . 6887) (UTF8.INCCODEFN 6889 . 12379) (UTF8.PEEKCCODEFN
+ 12381 . 17155) (\UTF8.BACKCCODEFN 17157 . 17724)) (17727 21053 (UTF16BE.OUTCHARFN 17737 . 18561) (
+UTF16BE.INCCODEFN 18563 . 19462) (UTF16BE.PEEKCCODEFN 19464 . 20535) (\UTF16.BACKCCODEFN 20537 . 21051
+)) (21083 22891 (MAKE-UNICODE-FORMATS 21093 . 22889)) (22988 24294 (UNICODE.UNMAPPED 22998 . 24292)) (
+24295 24831 (XCCS-UTF8-AFTER-OPEN 24305 . 24829)) (25901 26250 (XTOUCODE 25911 . 26079) (UTOXCODE 
+26081 . 26248)) (26290 42412 (READ-UNICODE-MAPPING-FILENAMES 26300 . 27401) (READ-UNICODE-MAPPING 
+27403 . 30701) (WRITE-UNICODE-MAPPING 30703 . 34920) (WRITE-UNICODE-INCLUDED 34922 . 39644) (
+WRITE-UNICODE-MAPPING-HEADER 39646 . 40878) (WRITE-UNICODE-MAPPING-FILENAME 40880 . 42410)) (45749 
+54228 (MAKE-UNICODE-TRANSLATION-TABLES 45759 . 54226)) (54649 62553 (HEXSTRING 54659 . 55820) (
+UTF8HEXSTRING 55822 . 58027) (NUTF8CODEBYTES 58029 . 58692) (NUTF8STRINGBYTES 58694 . 59175) (
+XTOUSTRING 59177 . 62188) (XCCSSTRING 62190 . 62551)) (62554 64023 (SHOWCHARS 62564 . 64021)))))
 STOP

library/UNIXTELNET

@@ -1,18 +1,27 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "16-Feb-90 17:00:31" "{piglet/n}<piglet>vanmelle>lispusers>UNIXTELNET;11"
 3551   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "30-Sep-2021 19:23:57" {DSK}<Users>briggs>Projects>medley>library>UNIXTELNET.;2
 3970   
 
-      changes to%:  (VARS UNIXTELNETCOMS) (FNS UNIX-TCPCHAT.INIT UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.GET.LOGIN)
+      changes to%:  (FNS UNIX-TCPCHAT.OPEN)
 
-      previous date%: "30-Jan-90 17:47:34" "{piglet/n}<piglet>vanmelle>lispusers>UNIXTELNET;7")
+      previous date%: "16-Feb-90 17:00:31" {DSK}<Users>briggs>Projects>medley>library>UNIXTELNET.;1
+)
 
 
-(* "
-Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
+(* ; "
+Copyright (c) 1989-1990 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT UNIXTELNETCOMS)
 
-(RPAQQ UNIXTELNETCOMS ((FNS UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.GET.LOGIN UNIX-TCPCHAT.INIT) (INITVARS (CHAT.LOGINS) (CHAT.LOGINS.MENU)) (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCHAT) (ADDVARS (AROUNDEXITFNS UNIX-TCPCHAT.INIT)) (P (UNIX-TCPCHAT.INIT)))))
+(RPAQQ UNIXTELNETCOMS

+       [(FNS UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.GET.LOGIN UNIX-TCPCHAT.INIT)
+        (INITVARS (CHAT.LOGINS)
+               (CHAT.LOGINS.MENU))
+        (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
+                                               UNIXCHAT)
+               (ADDVARS (AROUNDEXITFNS UNIX-TCPCHAT.INIT))
+               (P (UNIX-TCPCHAT.INIT])
 (DEFINEQ
 
 (UNIX-TCPCHAT.HOST.FILTER

@@ -20,8 +29,20 @@ Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
 )
 
 (UNIX-TCPCHAT.OPEN

-(LAMBDA (HOST TERMTYPE LOGOPTION) (* ; "Edited 14-Feb-90 18:36 by bvm") (* ;; "For use on Maiko: chat to HOST by using rlogin in a shell window.") (LET (NAME STR) (if (AND (OR (NEQ LOGOPTION (QUOTE NONE)) (SETQ NAME (UNIX-TCPCHAT.GET.LOGIN HOST))) (SETQ STR (CREATE-SHELL-STREAM TERMTYPE (CL:FORMAT NIL "exec rlogin ~@[-l ~A ~]~A" NAME HOST)))) then (STREAMPROP STR (QUOTE SENDSCREENPARAMS) (FUNCTION UNIX.SENDSCREENPARAMS)) (STREAMPROP STR (QUOTE SETDISPLAYTYPE) (FUNCTION UNIX.SETDISPLAYTYPE)) (LIST STR STR (QUOTE LOGOPTION) (QUOTE NONE)))))
-)
+  [LAMBDA (HOST TERMTYPE LOGOPTION)                          (* ; 
+
                                                           "Edited 30-Sep-2021 19:23 by briggs")

+                                                             (* ; "Edited 14-Feb-90 18:36 by bvm")

+
+    (* ;; "For use on Maiko: chat to HOST by using ssh in a shell window.")

+
+    (LET (NAME STR)
+         (if
 [AND (OR (NEQ LOGOPTION 'NONE)
+                          (SETQ NAME (UNIX-TCPCHAT.GET.LOGIN
 HOST)))
+                      (SETQ STR (CREATE-SHELL-STREAM TERMTYPE (CL:FORMAT NIL "exec ssh ~@[-l ~A ~]~A"
+                                                                     NAME HOST]
+             then
 (STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
+                   (STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
+                   (LIST STR STR 'LOGOPTION 'NONE])
 
 (UNIX-TCPCHAT.GET.LOGIN

 (LAMBDA (HOST) (* ; "Edited 15-Feb-90 11:28 by bvm") (LET (NAME) (if (OR (NULL CHAT.LOGINS) (EQ (SETQ NAME (MENU (OR CHAT.LOGINS.MENU (SETQ CHAT.LOGINS.MENU (create MENU ITEMS _ (APPEND CHAT.LOGINS (QUOTE (("**other**" T "Prompts for a name to login as")))) CENTERFLG _ T TITLE _ "Log in as:"))))) T)) then (* ; "Prompt for a name") (if (SETQ NAME (CHAT.PROMPT.FOR.INPUT (CL:FORMAT NIL "Log in to ~A as user: " HOST) NIL 16)) then (SETQ CHAT.LOGINS (SORT (CONS NAME CHAT.LOGINS) (FUNCTION UALPHORDER))) (SETQ CHAT.LOGINS.MENU NIL))) NAME))
@@ -32,25 +53,26 @@ Copyright (c) 1989, 1990 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(RPAQ? CHAT.LOGINS)
+(RPAQ? CHAT.LOGINS
 )
 
-(RPAQ? CHAT.LOGINS.MENU)
+(RPAQ? CHAT.LOGINS.MENU
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU)
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(FILESLOAD (SYSLOAD) UNIXCHAT)
+(FILESLOAD (SYSLOAD)
+       UNIXCHAT)
 
 
-(ADDTOVAR AROUNDEXITFNS UNIX-TCPCHAT.INIT)
+(ADDTOVAR AROUNDEXITFNS
 UNIX-TCPCHAT.INIT)
 
 
-(UNIX-TCPCHAT.INIT)
+(UNIX-TCPCHAT.INIT
)
 )
 (PUTPROPS UNIXTELNET COPYRIGHT ("Xerox Corporation" 1989 1990))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (836 3203 (UNIX-TCPCHAT.HOST.FILTER 846 . 1353) (UNIX-TCPCHAT.OPEN 1355 . 1924) (
-UNIX-TCPCHAT.GET.LOGIN 1926 . 2495) (UNIX-TCPCHAT.INIT 2497 . 3201)))))
+  (FILEMAP (NIL (872 3597 (UNIX-TCPCHAT.HOST.FILTER 882 . 1389) (UNIX-TCPCHAT.OPEN 1391 . 2318) (
+UNIX-TCPCHAT.GET.LOGIN 2320 . 2889) (UNIX-TCPCHAT.INIT 2891 . 3595)))))
 STOP

library/VTCHAT

@@ -1,40 +1,37 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-Jan-93 15:06:01" {DSK}<python>lde>lispcore>library>VTCHAT.;2
 21782  
+
(FILECREATED "30-Sep-2021 17:41:51" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;4
 21924  
 
-      changes to%:  (RECORDS VT100SAVE VT100.STATE)
+      changes to%:  (FNS VTCHAT.STATUS)
 
-      previous date%: "13-Jun-90 01:22:35" {DSK}<python>lde>lispcore>library>VTCHAT.;1)
+      previous date%: "20-Jan-93 15:06:01" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;3)
 
 
 (* ; "
-Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1983-1988, 1990, 1993 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT VTCHATCOMS)
 
-(RPAQQ VTCHATCOMS
 [
-                       (* ;; "VT100 emulator")

+(RPAQQ VTCHATCOMS

+       [
+        (* ;; "VT100 emulator")

 
-                       (FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
-                       (FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT 
-                            VTCHAT.CLEARMODES VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE 
-                            VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
-                       (INITVARS (VTCHAT.DEBUGGING.FLG)
-                              (VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
-                       (GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT 
-                              VTCHAT.TERM.IDENTITY.STRING)
-                       (ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
-                       (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
-                              (FILES (LOADCOMP)
-                                     CHATDECLS)
-                              (RECORDS VT100SAVE VT100.STATE))
-                       (INITRECORDS VT100.STATE)
-                       (SYSRECORDS VT100.STATE)
-                       (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
-                                                              VT100KP)
-                              (ADDVARS (CHAT.DISPLAYTYPES (
-                                                       "Replace this string with NIL to prefer vt100"
-                                                           NIL VT100])
+        (FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
+        (FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT VTCHAT.CLEARMODES
+             VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
+        (INITVARS (VTCHAT.DEBUGGING.FLG)
+               (VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
+        (GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT VTCHAT.TERM.IDENTITY.STRING)
+        (ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
+               (FILES (LOADCOMP)
+                      CHATDECLS)
+               (RECORDS VT100SAVE VT100.STATE))
+        (INITRECORDS VT100.STATE)
+        (SYSRECORDS VT100.STATE)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
+                                               VT100KP)
+               (ADDVARS (CHAT.DISPLAYTYPES ("Replace this string with NIL to prefer vt100" NIL VT100])
 
 
 
@@ -101,8 +98,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
 )
 
 (VTCHAT.STATUS

-(LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ; "Edited 18-Dec-86 15:16 by amd") (* ;; "Returns VT100 status info") (LET ((OUTSTREAM (ffetch (CHAT.STATE OUTSTREAM) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE))))) (SELECTQ TYPE (5 (* ; "Host wants device status") (PRIN1 "" OUTSTREAM)) (6 (* ; "Host wants cursor coords") (BOUT OUTSTREAM (CHARCODE ESC)) (BOUT OUTSTREAM (CHARCODE %[)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE YPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE ;)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE XPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE R))) NIL) (FORCEOUTPUT OUTSTREAM)))
-)
+  [LAMBDA (CHAT.STATE VT100.STATE TYPE)                      (* ; 
+
                                                           "Edited 30-Sep-2021 17:30 by briggs")

+                                                             (* ; "Edited 18-Dec-86 15:16 by amd")

+
+    (* ;; "Returns VT100 status info")

+
+    (LET [(OUTSTREAM (ffetch
 (CHAT.STATE OUTSTREAM) of
 (\DTEST CHAT.STATE 'CHAT.STATE]
+         (SELECTQ TYPE
+             (5                                              (* ; "Host wants device status")

+                (PRIN1 "" OUTSTREAM))
+             (6                                              (* ; "Host wants cursor coords")

+                (BOUT OUTSTREAM (CHARCODE ESC))
+                (BOUT OUTSTREAM (CHARCODE %[))
+                (PRIN1 (ADD1 (IQUOTIENT (ffetch
 (CHAT.STATE YPOS) of
 CHAT.STATE)
+                                    (ffetch
 (CHAT.STATE FONTHEIGHT) of
 CHAT.STATE)))
+                       OUTSTREAM)
+                (BOUT OUTSTREAM (CHARCODE ;))
+                (PRIN1 (ADD1 (IQUOTIENT (ffetch
 (CHAT.STATE XPOS) of
 CHAT.STATE)
+                                    (ffetch
 (CHAT.STATE FONTWIDTH) of
 CHAT.STATE)))
+                       OUTSTREAM)
+                (BOUT OUTSTREAM (CHARCODE R)))
+             NIL)
+         (FORCEOUTPUT OUTSTREAM])
 )
 
 (RPAQ? VTCHAT.DEBUGGING.FLG
 )
@@ -236,10 +254,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
 )
 (PUTPROPS VTCHAT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1995 10061 (VTCHAT.STATE 2005 . 2515) (VTCHAT.HANDLECHARACTER 2517 . 5091) (
-VTCHAT.SEQUENCE 5093 . 6636) (VTCHAT.DOCOMMAND 6638 . 10059)) (10062 16968 (VTCHAT.ADDRESS 10072 . 
-10590) (VTCHAT.REVERSE.INDEX 10592 . 11161) (VTCHAT.ATTRIBUTES 11163 . 11549) (VTCHAT.DECLFONT 11551
- . 11820) (VTCHAT.CLEARMODES 11822 . 12325) (VTCHAT.SAVE 12327 . 13066) (VTCHAT.RESTORE 13068 . 13775)
- (VTCHAT.SETMODE 13777 . 14849) (VTCHAT.SETMARGINS 14851 . 15442) (VTCHAT.REPORT 15444 . 16204) (
-VTCHAT.STATUS 16206 . 16966)))))
+  (FILEMAP (NIL (1532 9598 (VTCHAT.STATE 1542 . 2052) (VTCHAT.HANDLECHARACTER 2054 . 4628) (
+VTCHAT.SEQUENCE 4630 . 6173) (VTCHAT.DOCOMMAND 6175 . 9596)) (9599 17110 (VTCHAT.ADDRESS 9609 . 10127)
+ (VTCHAT.REVERSE.INDEX 10129 . 10698) (VTCHAT.ATTRIBUTES 10700 . 11086) (VTCHAT.DECLFONT 11088 . 11357
+) (VTCHAT.CLEARMODES 11359 . 11862) (VTCHAT.SAVE 11864 . 12603) (VTCHAT.RESTORE 12605 . 13312) (
+VTCHAT.SETMODE 13314 . 14386) (VTCHAT.SETMARGINS 14388 . 14979) (VTCHAT.REPORT 14981 . 15741) (
+VTCHAT.STATUS 15743 . 17108)))))
 STOP

library/lafite/LAFITE

@@ -1,12 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "24-Jun-2021 19:17:01" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4
 71992  
+
(FILECREATED "30-Sep-2021 22:59:08" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;5
 71956  
 
-      changes to%:  (FNS \LAFITE.EOF)
-                    (FILES LAFITEDECLS)
+      changes to%:  (FILES LAFITEDECLS)
 
-      previous date%: "22-Aug-94 13:00:22" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;2)
+      previous date%: "24-Jun-2021 19:17:01" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4)
 
 
 (* ; "
@@ -75,19 +74,19 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
                      (LAFITE.PERSONAL.VARS LAFITEDEFAULTHOST&DIR LAFITE.SIGNATURE))
               (FNS LAFITE.AROUNDEXIT \LAFITE.MARK.FOLDERS.OBSOLETE \LAFITE.CHECK.FOLDERS 
                    \LAFITE.ASSURE.FOLDER.READY \LAFITE.AFTERLOGIN))
-        (COMS                                                (* ; "misc utilities")

+        (COMS                                                (* ; "misc utilities")

               (FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY 
                    \LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT \LAFITEMSG.DEFPRINT 
                    LA.POSITION.FROM.REGION MAILFOLDERBUSY)
               (CURSORS LA.CROSSCURSOR)
-                                                             (* ; "Low level file functions")

+                                                             (* ; "Low level file functions")

               (FNS TOCFILENAME DELETEMAILFOLDER \LAFITE.OPEN.FOLDER \LAFITE.REPORT.FILE.WONT.OPEN 
                    \LAFITE.FOLDER.CHANGED \LAFITE.REBROWSE.FOLDER \LAFITE.FOLDER.CHANGED.MENU 
                    \LAFITE.SET.FOLDER.STREAM \LAFITE.OPENSTREAM \LAFITE.CREATE.MENU \LAFITE.EOF 
                    \LAFITE.CLOSE.FOLDER)
               (FNS \LAFITE.DESCRIBE.FOLDER))
-        (COMS                                                (* ; 
-
                                                      "Make is easy to load new versions of Lafite")

+        (COMS                                                (* ; 
+
                                                      "Make is easy to load new versions of Lafite")

               (FNS LOAD-LAFITE)
               (VARS LAFITEFILES))
         [DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
@@ -102,14 +101,14 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
                      (FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL 
                             LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
                      (P * (PROGN LAFITE.PROCLAMATIONS))
-                                                             (* ; 
-
                                      "Proclaim user interface variables.  Value is on LAFITEDECLS")

+                                                             (* ; 
+
                                      "Proclaim user interface variables.  Value is on LAFITEDECLS")

                      (P (\LAFITE.GLOBAL.INIT)
                         (COND ((EQ MAKESYSNAME :LYRIC)
                                (FILESLOAD (SYSLOAD)
                                       NSCHARPATCH)
-                                                             (* ; 
-
                                                           "Patch to horrid Lyric NS chars bug")

+                                                             (* ; 
+
                                                           "Patch to horrid Lyric NS chars bug")

                                (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
         (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                            (NLAML)
@@ -117,7 +116,7 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
 
 (RPAQQ LAFITEVERSION#
 10)
 
-(RPAQQ LAFITESYSTEMDATE
 "24-Jun-2021 19:17:01")
+(RPAQQ LAFITESYSTEMDATE
 "30-Sep-2021 22:59:08")
 (DEFINEQ
 
 (LAFITE

@@ -277,8 +276,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                                                 DEFAULTFONT)
                                          (CHARWIDTH (CHARCODE "W")
                                                 DEFAULTFONT))
-                                                             (* ; 
-
                                       "Yes, user has not changed default to a variable width font")

+                                                             (* ; 
+
                                       "Yes, user has not changed default to a variable width font")

                                      DEFAULTFONT)
                                     (T (FONTCREATE '(GACHA 10]
         (LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
@@ -317,8 +316,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                          DEFAULTFONT)
                   (CHARWIDTH (CHARCODE "W")
                          DEFAULTFONT))
-                                                             (* ; 
-
                                       "Yes, user has not changed default to a variable width font")

+                                                             (* ; 
+
                                       "Yes, user has not changed default to a variable width font")

               DEFAULTFONT)
              (T (FONTCREATE '(GACHA 10])
 
@@ -864,8 +863,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (COND
    ((EQ MAKESYSNAME :LYRIC)
     (FILESLOAD (SYSLOAD)
-           NSCHARPATCH)                                      (* ; 
-
                                                           "Patch to horrid Lyric NS chars bug")

+           NSCHARPATCH)                                      (* ; 
+
                                                           "Patch to horrid Lyric NS chars bug")

     (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)))
 )
 (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
@@ -879,28 +878,28 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985 
 1986 1987 1988 1989 1993 1994 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7140 22186 (LAFITE 7150 . 8461) (LAFITE.ON.FROM.BACKGROUND 8463 . 8834) (\LAFITE.OFF 
-8836 . 9220) (\LAFITE.START.PROC 9222 . 10998) (LAFITE.COMPUTE.CACHED.VARS 11000 . 13702) (
-\LAFITE.PROCESS 13704 . 14070) (\LAFITE.START.ABORT 14072 . 14264) (\LAFITE.QUIT 14266 . 14508) (
-\LAFITE.RESTART 14510 . 14643) (\LAFITE.SUBQUIT 14645 . 15943) (\LAFITE.QUIT.PROC 15945 . 18681) (
-\LAFITEDEFAULTHOST&DIR 18683 . 19493) (LAFITEDEFAULTHOST&DIR 19495 . 19665) (MAKELAFITECOMMANDWINDOW 
-19667 . 21306) (EXTRACTMENUCOMMAND 21308 . 21556) (DOMAINLAFITECOMMAND 21558 . 21707) (
-LAFITE.TOGGLE.SERVER.TRACE 21709 . 22184)) (22261 25229 (LAFITEMODE 22271 . 22751) (\LAFITE.INFER.MODE
- 22753 . 23106) (\LAFITE.SHOW.MODE 23108 . 23345) (\LAFITE.MODE.TITLE 23347 . 23632) (
-LAFITE.SHOW.MODE.P 23634 . 23875) (LAFITE.ALL.MODES.P 23877 . 24220) (SET.LAFITE.MODE.INTERACTIVELY 
-24222 . 24804) (\LAFITE.COMPUTE.MODE.COMMANDS 24806 . 25227)) (26079 27835 (\LAFITE.LOGIN 26089 . 
-26471) (\LAFITE.LOGIN.NORESTART 26473 . 26579) (LAFITE.PROMPT.FOR.LOGIN 26581 . 27600) (
-\LAFITE.REAUTHENTICATE 27602 . 27833)) (35346 38788 (LAFITE.AROUNDEXIT 35356 . 35894) (
-\LAFITE.MARK.FOLDERS.OBSOLETE 35896 . 36812) (\LAFITE.CHECK.FOLDERS 36814 . 37213) (
-\LAFITE.ASSURE.FOLDER.READY 37215 . 37625) (\LAFITE.AFTERLOGIN 37627 . 38786)) (38820 41758 (
-LA.RESETSHADE 38830 . 39208) (LA.MENU.ITEM 39210 . 39628) (NTHMESSAGE 39630 . 39713) (
-\LAFITE.MAKE.MSGARRAY 39715 . 40145) (\LAFITE.ADDMESSAGES.TO.ARRAY 40147 . 40728) (
-\MAILFOLDER.DEFPRINT 40730 . 40977) (\LAFITEMSG.DEFPRINT 40979 . 41141) (LA.POSITION.FROM.REGION 41143
- . 41620) (MAILFOLDERBUSY 41622 . 41756)) (41936 58324 (TOCFILENAME 41946 . 42377) (DELETEMAILFOLDER 
-42379 . 42899) (\LAFITE.OPEN.FOLDER 42901 . 47516) (\LAFITE.REPORT.FILE.WONT.OPEN 47518 . 48242) (
-\LAFITE.FOLDER.CHANGED 48244 . 50648) (\LAFITE.REBROWSE.FOLDER 50650 . 53615) (
-\LAFITE.FOLDER.CHANGED.MENU 53617 . 54540) (\LAFITE.SET.FOLDER.STREAM 54542 . 55236) (
-\LAFITE.OPENSTREAM 55238 . 55777) (\LAFITE.CREATE.MENU 55779 . 56132) (\LAFITE.EOF 56134 . 57476) (
-\LAFITE.CLOSE.FOLDER 57478 . 58322)) (58325 58909 (\LAFITE.DESCRIBE.FOLDER 58335 . 58907)) (58970 
-60076 (LOAD-LAFITE 58980 . 60074)) (67787 69064 (\LAFITE.GLOBAL.INIT 67797 . 69062)))))
+  (FILEMAP (NIL (7104 22150 (LAFITE 7114 . 8425) (LAFITE.ON.FROM.BACKGROUND 8427 . 8798) (\LAFITE.OFF 
+8800 . 9184) (\LAFITE.START.PROC 9186 . 10962) (LAFITE.COMPUTE.CACHED.VARS 10964 . 13666) (
+\LAFITE.PROCESS 13668 . 14034) (\LAFITE.START.ABORT 14036 . 14228) (\LAFITE.QUIT 14230 . 14472) (
+\LAFITE.RESTART 14474 . 14607) (\LAFITE.SUBQUIT 14609 . 15907) (\LAFITE.QUIT.PROC 15909 . 18645) (
+\LAFITEDEFAULTHOST&DIR 18647 . 19457) (LAFITEDEFAULTHOST&DIR 19459 . 19629) (MAKELAFITECOMMANDWINDOW 
+19631 . 21270) (EXTRACTMENUCOMMAND 21272 . 21520) (DOMAINLAFITECOMMAND 21522 . 21671) (
+LAFITE.TOGGLE.SERVER.TRACE 21673 . 22148)) (22225 25193 (LAFITEMODE 22235 . 22715) (\LAFITE.INFER.MODE
+ 22717 . 23070) (\LAFITE.SHOW.MODE 23072 . 23309) (\LAFITE.MODE.TITLE 23311 . 23596) (
+LAFITE.SHOW.MODE.P 23598 . 23839) (LAFITE.ALL.MODES.P 23841 . 24184) (SET.LAFITE.MODE.INTERACTIVELY 
+24186 . 24768) (\LAFITE.COMPUTE.MODE.COMMANDS 24770 . 25191)) (26043 27799 (\LAFITE.LOGIN 26053 . 
+26435) (\LAFITE.LOGIN.NORESTART 26437 . 26543) (LAFITE.PROMPT.FOR.LOGIN 26545 . 27564) (
+\LAFITE.REAUTHENTICATE 27566 . 27797)) (35310 38752 (LAFITE.AROUNDEXIT 35320 . 35858) (
+\LAFITE.MARK.FOLDERS.OBSOLETE 35860 . 36776) (\LAFITE.CHECK.FOLDERS 36778 . 37177) (
+\LAFITE.ASSURE.FOLDER.READY 37179 . 37589) (\LAFITE.AFTERLOGIN 37591 . 38750)) (38784 41722 (
+LA.RESETSHADE 38794 . 39172) (LA.MENU.ITEM 39174 . 39592) (NTHMESSAGE 39594 . 39677) (
+\LAFITE.MAKE.MSGARRAY 39679 . 40109) (\LAFITE.ADDMESSAGES.TO.ARRAY 40111 . 40692) (
+\MAILFOLDER.DEFPRINT 40694 . 40941) (\LAFITEMSG.DEFPRINT 40943 . 41105) (LA.POSITION.FROM.REGION 41107
+ . 41584) (MAILFOLDERBUSY 41586 . 41720)) (41900 58288 (TOCFILENAME 41910 . 42341) (DELETEMAILFOLDER 
+42343 . 42863) (\LAFITE.OPEN.FOLDER 42865 . 47480) (\LAFITE.REPORT.FILE.WONT.OPEN 47482 . 48206) (
+\LAFITE.FOLDER.CHANGED 48208 . 50612) (\LAFITE.REBROWSE.FOLDER 50614 . 53579) (
+\LAFITE.FOLDER.CHANGED.MENU 53581 . 54504) (\LAFITE.SET.FOLDER.STREAM 54506 . 55200) (
+\LAFITE.OPENSTREAM 55202 . 55741) (\LAFITE.CREATE.MENU 55743 . 56096) (\LAFITE.EOF 56098 . 57440) (
+\LAFITE.CLOSE.FOLDER 57442 . 58286)) (58289 58873 (\LAFITE.DESCRIBE.FOLDER 58299 . 58871)) (58934 
+60040 (LOAD-LAFITE 58944 . 60038)) (67751 69028 (\LAFITE.GLOBAL.INIT 67761 . 69026)))))
 STOP

library/lafite/LAFITEFIND

@@ -1,47 +1,45 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 3-Jun-92 10:10:41" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;2
 15951  
+
(FILECREATED "30-Sep-2021 23:01:05" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;2
 14882  
 
-      previous date%: "15-Jun-90 16:06:40" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;1)
+      changes to%:  (FILES LAFITEDECLS)
+
+      previous date%: " 3-Jun-92 10:10:41" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;1)
 
 
 (* ; "
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation.  All rights reserved.
+Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT LAFITEFINDCOMS)
 
-(RPAQQ LAFITEFINDCOMS
 ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD 
-                                \LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST 
-                                \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND 
-                                \LAFITE.FIND.START)
-                           (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
-                                  (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS 
-                                         LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU 
-                                         LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
-                                  (FILES (SOURCE)
-                                         LAFITEDECLS)
-                                  (LOCALVARS . T))
-                           (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
-                           (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
-                           (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND 
-                                                                 "Search mail for something")
-                                           ["Find Related" '\LAFITE.FIND.RELATED 
-                                            "Find all messages from here on in reply to this message"
-                                                  (SUBITEMS ("Find Related Forward" 
-                                                                   '\LAFITE.FIND.RELATED)
-                                                         ("Find Related Backward" 
-                                                                '\LAFITE.FIND.RELATED.BACKWARD]
-                                           ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search"
-                                                  )
-                                           ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
-                                                 "Scroll to and select a specific message by number."
-                                                  (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
-                                                                "Scroll to and select first message."
-                                                                   )
-                                                         ("Go to Last" '\LAFITE.GO.TO.LAST 
-                                                                "Scroll to and select last message."]
-                                  (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
-                           (VARS (\LAFITE.LAST.SEARCH))))
+(RPAQQ LAFITEFINDCOMS

+       ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST 
+             \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT 
+             \LAFITE.DO.FIND \LAFITE.FIND.START)
+        (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
+               (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU 
+                      LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
+               (FILES (SOURCE)
+                      LAFITEDECLS)
+               (LOCALVARS . T))
+        (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
+        (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
+        (ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND "Search mail for something")
+                        ["Find Related" '\LAFITE.FIND.RELATED 
+                               "Find all messages from here on in reply to this message"
+                               (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
+                                      ("Find Related Backward" '\LAFITE.FIND.RELATED.BACKWARD]
+                        ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
+                        ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
+                               "Scroll to and select a specific message by number."
+                               (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
+                                                "Scroll to and select first message.")
+                                      ("Go to Last" '\LAFITE.GO.TO.LAST 
+                                             "Scroll to and select last message."]
+               (LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
+        (VARS (\LAFITE.LAST.SEARCH))))
 (DEFINEQ
 
 (\LAFITE.FIND

@@ -147,45 +145,47 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporat
 
 (RPAQ? LAFITEFINDAREAMENU
 NIL)
 
-(RPAQQ LAFITEFINDAREAMENUITEMS
 ((From 'From "Search From: field for string (or To: if from self)"
-                                          )
-                                    (Subject 'Subject "Search Subject: field for string")
-                                    (Body 'Body "Search message bodies for string")
-                                    (Mark 'Mark "Search for messages with specified mark character")
-                                    (Related 'Related 
-                                           "Search for a message with same Subject, modulo Re:")))
+(RPAQQ LAFITEFINDAREAMENUITEMS

+       ((From 'From "Search From: field for string (or To: if from self)")
+        (Subject 'Subject "Search Subject: field for string")
+        (Body 'Body "Search message bodies for string")
+        (Mark 'Mark "Search for messages with specified mark character")
+        (Related 'Related "Search for a message with same Subject, modulo Re:")))
 
-(RPAQQ LAFITEFINDTYPEMENUITEMS
 (("Find Next One" '(FORWARD ONE)
-                                           "Search forward from selected message")
-                                    ("Find Next All" '(FORWARD ALL)
-                                           "Search forward from selected message")
-                                    ("Find Previous One" '(BACKWARD ONE)
-                                           "Search backward from selected message")
-                                    ("Find Previous All" '(BACKWARD ALL)
-                                           "Search backward from selected message")))
+(RPAQQ LAFITEFINDTYPEMENUITEMS

+       (("Find Next One" '(FORWARD ONE)
+               "Search forward from selected message")
+        ("Find Next All" '(FORWARD ALL)
+               "Search forward from selected message")
+        ("Find Previous One" '(BACKWARD ONE)
+               "Search backward from selected message")
+        ("Find Previous All" '(BACKWARD ALL)
+               "Search backward from selected message")))
 
-(ADDTOVAR LAFITEEXTRAMENUITEMS
 ("Find" '\LAFITE.FIND "Search mail for something")
-                                   ["Find Related" '\LAFITE.FIND.RELATED 
-                                          "Find all messages from here on in reply to this message"
-                                          (SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
-                                                 ("Find Related Backward" 
-                                                        '\LAFITE.FIND.RELATED.BACKWARD]
-                                   ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
-                                   ("Go to #" '\LAFITE.GO.TO.INTERACTIVE 
-                                          "Scroll to and select a specific message by number."
-                                          (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST 
-                                                           "Scroll to and select first message.")
-                                                 ("Go to Last" '\LAFITE.GO.TO.LAST 
-                                                        "Scroll to and select last message."))))
+(ADDTOVAR LAFITEEXTRAMENUITEMS

+          ("Find" '\LAFITE.FIND "Search mail for something")
+          ["Find Related" '\LAFITE.FIND.RELATED 
+                 "Find all messages from here on in reply to this message" (SUBITEMS
+                                                                            ("Find Related Forward"
+                                                                             '\LAFITE.FIND.RELATED)
+                                                                            ("Find Related Backward"
+                                                                             
+                                                                             '
+                                                                        \LAFITE.FIND.RELATED.BACKWARD
+                                                                             ]
+          ("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
+          ("Go to #" '\LAFITE.GO.TO.INTERACTIVE "Scroll to and select a specific message by number."
+                 (SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST "Scroll to and select first message.")
+                        ("Go to Last" '\LAFITE.GO.TO.LAST "Scroll to and select last message."))))
 
 (ADDTOVAR LAFITEMENUVARS
 LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
 
 (RPAQQ \LAFITE.LAST.SEARCH
 NIL)
-(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992))
+(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3089 12861 (\LAFITE.FIND 3099 . 4131) (\LAFITE.FIND.RELATED 4133 . 4798) (
-\LAFITE.FIND.RELATED.BACKWARD 4800 . 4936) (\LAFITE.GO.TO.FIRST 4938 . 5105) (
-\LAFITE.GO.TO.INTERACTIVE 5107 . 5719) (\LAFITE.GO.TO.LAST 5721 . 5929) (\LAFITE.FIND.AGAIN 5931 . 
-6513) (\LAFITE.FIND.PROMPT 6515 . 8637) (\LAFITE.DO.FIND 8639 . 11790) (\LAFITE.FIND.START 11792 . 
-12859)))))
+  (FILEMAP (NIL (2309 12081 (\LAFITE.FIND 2319 . 3351) (\LAFITE.FIND.RELATED 3353 . 4018) (
+\LAFITE.FIND.RELATED.BACKWARD 4020 . 4156) (\LAFITE.GO.TO.FIRST 4158 . 4325) (
+\LAFITE.GO.TO.INTERACTIVE 4327 . 4939) (\LAFITE.GO.TO.LAST 4941 . 5149) (\LAFITE.FIND.AGAIN 5151 . 
+5733) (\LAFITE.FIND.PROMPT 5735 . 7857) (\LAFITE.DO.FIND 7859 . 11010) (\LAFITE.FIND.START 11012 . 
+12079)))))
 STOP

library/lafite/LAFITESORT

@@ -1,19 +1,334 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 7-Feb-95 13:10:22" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;2
 12117  
-
-      changes to%:  (VARS LAFITESORTCOMS)
-
-      previous date%: " 7-Oct-89 14:07:49" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;1)
-
-
-(* ; "
-Copyright (c) 1989, 1995 by Xerox Corporation.  All rights reserved.
-")
-
-(PRETTYCOMPRINT LAFITESORTCOMS)
-
-(RPAQQ LAFITESORTCOMS

-       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                LAFITEDECLS))
-        (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY 
-             LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
(FILECREATED "30-Sep-2021 22:58:58" 
+{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1
 19675  
+
+      previous date%: " 7-Feb-95 13:10:22" 
+{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1)
+
+
+(* ; "
+Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
+")
+
+(PRETTYCOMPRINT LAFITESORTCOMS)
+
+(RPAQQ LAFITESORTCOMS

+       [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
+                                                LAFITEDECLS))
+        (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY 
+             LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER 
+             \LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION)
+        [APPENDVARS (LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                                 (SUBITEMS ("Sort Entire Folder" 
+                                                                  '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                                                  )
+                                                        ("Sort Selected Range" 
+                                                               '\LAFITE.SORT.BY.DATE.REGION 
+                               "Sort only the messages between the first and last selected messages."
+                                                               ]
+        (COMS                                                (* ; "Date hax")

+              (FNS GDATE1-6)
+              (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS \4YearsDays)
+                     (GLOBALVARS \TimeZoneComp \DayLightSavings])
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE)
+       LAFITEDECLS)
+)
+(DEFINEQ
+
+(LAFITE.ASSURE.DATE.FIELDS

+  [LAMBDA (FOLDER FIRST# LAST#)
                          (* ; "Edited  5-May-89 15:46 by bvm")

+
+    (* ;; "Assure that messages FIRST# thru LAST# have IDATE fields.  FIRST# & LAST# default.")

+
+    (for
 I from
 (OR FIRST# 1) to
 (OR LAST# (fetch
 (MAILFOLDER %#OFMESSAGES)
+                                                          of
 FOLDER))
+       bind
 (STREAM _ (\LAFITE.OPEN.FOLDER FOLDER 'INPUT :ABORT))
+             (MESSAGES _ (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS) of
 FOLDER))
+             (FAILURECNT _ 0)
+             (MISSING _ 0)
+             MSG ID PREV DATEFAILURE DATEFETCHED BABBLED
+       do
 [if
 (fetch
 (LAFITEMSG DATEFETCHED?) of
 (SETQ MSG (NTHMESSAGE MESSAGES I)))
+                  then
                                   (* ; "Ok")

+                        (if
 (NOT (fetch
 (LAFITEMSG DATEKNOWN?) of
 MSG))
+                            then
 (add
 FAILURECNT 1))
+                else
 (if
 (NOT BABBLED)
+                             then
                        (* ; "Tell user what's taking so long")

+                                   (LAB.PROMPTPRINT FOLDER "Collecting dates... ")
+                                   (SETQ BABBLED T))
+                      (if
 (FIXP (SETQ ID (LAFITE.PARSE.HEADER STREAM \LAPARSE.DATEFIELD
+                                                    (fetch
 (LAFITEMSG START) of
 MSG)
+                                                    (fetch
 (LAFITEMSG END) of
 MSG)
+                                                    T)))
+                          then
 (replace
 (LAFITEMSG IDATE) of
 MSG with
 ID)
+                                (replace
 (LAFITEMSG DATEKNOWN?) of
 MSG with
 T)
+                                (replace
 (LAFITEMSG DATEFETCHED?) of
 MSG with
 T)
+                                (replace
 (LAFITEMSG DATE) of
 MSG with
 NIL) 
+                                                             (* ; 
+
                                                      "So it will be regenerated in canonical form")

+                                (OR DATEFETCHED (SETQ DATEFETCHED I))
+                        else
 (replace
 (LAFITEMSG DATEKNOWN?) of
 MSG with
 NIL)
+                              (if
 LAFITEDEBUGFLG
+                                  then
 (LAB.FORMAT FOLDER 
+                                           " ~:[Date missing for~;Could not parse date of~] msg ~D. "
+                                                  ID I))
+                              (add
 FAILURECNT 1)
+                              (if
 (NULL ID)
+                                  then
 (add
 MISSING 1))
+                              (if
 [AND (> I 1)
+                                           (fetch
 (LAFITEMSG DATEFETCHED?)
+                                              of
 (SETQ PREV (NTHMESSAGE MESSAGES (SUB1 I]
+                                  then
                   (* ; 
+
                                                     "Guess that message i has date just after i-1")

+                                        (replace
 (LAFITEMSG IDATE) of
 MSG
+                                           with
 (ADD1 (fetch
 (LAFITEMSG IDATE) of
 PREV)))
+                                        (replace
 (LAFITEMSG DATEFETCHED?) of
 MSG with

+                                                                                         T)
+                                else
 (SETQ DATEFAILURE I]
+       finally
 (if
 (AND DATEFETCHED (< DATEFETCHED (fetch
 (MAILFOLDER TOCLASTMESSAGE#)
+                                                              of
 FOLDER)))
+                       then
                              (* ; 
+
          "Assure that the toc will be rewritten at least this far back so that we save the dates.")

+                             (replace
 (MAILFOLDER TOCLASTMESSAGE#) of
 FOLDER with
 
+                                                                                          DATEFETCHED
+                                    ))
+             (COND
+                ([AND DATEFAILURE (NOT (for
 I from
 (ADD1 (OR FIRST# 1))
+                                          to
 (fetch
 (MAILFOLDER %#OFMESSAGES) of
 FOLDER)
+                                          when
 (fetch
 (LAFITEMSG DATEFETCHED?)
+                                                      of
 (SETQ MSG (NTHMESSAGE MESSAGES I)))
+                                          do
             (* ; "Got a date later on")

+                                                (SETQ ID (fetch
 (LAFITEMSG IDATE) of
 MSG))
+                                                (for
 J from
 DATEFAILURE
+                                                   to
 (OR FIRST# 1) by
 -1
+                                                   do
    (* ; 
+
                                                           "Store guess dates for first message(s)")

+                                                         (replace
 (LAFITEMSG IDATE)
+                                                            of
 (SETQ MSG (NTHMESSAGE MESSAGES J))
+                                                            with
 (add
 ID -1))
+                                                         (replace
 (LAFITEMSG DATEFETCHED?)
+                                                            of
 MSG with
 T))
+                                                (RETURN T]
+                 (LAB.PROMPTPRINT FOLDER "Could not parse dates of ANY messages in this file."))
+                ((> FAILURECNT 0)
+                 (LAB.FORMAT FOLDER (if
 (< MISSING FAILURECNT)
+                                        then
 
+                                         " Note: Could not parse date field of ~D of these messages."
+                                      else
 " Note: Missing date field for ~D of these messages.")
+                        FAILURECNT])
+
+(LAFITE.PARSE.DATE.FIELD

+  [LAMBDA (STREAM)
                                       (* ; "Edited  5-May-89 12:52 by bvm")

+    (LET* ((DATESTR (LAFITE.READ.TO.EOL STREAM))
+           (ID (IDATE DATESTR)))
+          (if
 [AND ID (> ID (CONSTANT (IDATE "1-jan-70 1200"]
+              then
                                       (* ; "Plausible date.  Test is for those silly senders who didn't get the date set and have messages reading %"31-dec-00 ...%"")

+                    ID
+            else
 (CONCAT (OR (SUBSTRING DATESTR 1 6 DATESTR)
+                                 DATESTR)
+                            "?"])
+
+(LAFITE.PARSE.DATE.FIELD.ONLY

+  [LAMBDA (STREAM)
+    (DECLARE
 (USEDFREE PARSERESULT))
                 (* ; "Edited 26-Apr-89 14:35 by bvm")

+    (SETQ PARSERESULT (LAFITE.PARSE.DATE.FIELD
 STREAM])
+
+(LAFITE.SORT.BY.DATE

+  [LAMBDA (FOLDER FIRST# LAST#)
                          (* ; "Edited 26-Apr-89 15:32 by bvm")

+    (WITH.MONITOR (fetch
 (MAILFOLDER FOLDERLOCK) of
 FOLDER)
+        (LAFITE.ASSURE.DATE.FIELDS
 FOLDER FIRST# LAST#)
+        (LAFITE.SORT.MESSAGES
 FOLDER (FUNCTION LAFITEMSG.DATE.ORDER)
+               FIRST# LAST#))])
+
+(LAFITE.SORT.MESSAGES

+  [LAMBDA (FOLDER COMPAREFN FIRST# LAST#)
                (* ; "Edited  7-Oct-89 14:03 by bvm")

+    (WITH.MONITOR (fetch
 (MAILFOLDER FOLDERLOCK) of
 FOLDER)
+        (OR FIRST# (SETQ FIRST# 1))
+        (OR LAST# (SETQ LAST# (fetch
 (MAILFOLDER %#OFMESSAGES) of
 FOLDER)))
+        (LAB.PROMPTPRINT FOLDER "Sorting... ")
+        (LET* ((MESSAGES (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS) of
 FOLDER))
+               (SORTED (CL:STABLE-SORT (for
 I from
 FIRST# to
 LAST#
+                                          collect
 (NTHMESSAGE MESSAGES I))
+                              COMPAREFN)))
+              (while
 (AND SORTED (EQ (fetch
 (LAFITEMSG %#) of
 (CAR SORTED))
+                                         FIRST#)) do
     (* ; 
+
                                                "Skip over the initial prefix of in-order messages")

+                                                        (add
 FIRST# 1)
+                                                        (SETQ SORTED (CDR SORTED)))
+              (if
 (NULL SORTED)
+                  then
 (LAB.PROMPTPRINT FOLDER "already in order")
+                else
 (replace
 (MAILFOLDER FOLDEROUTOFORDER) of
 FOLDER with
 T)
+                      (if
 (< FIRST# (fetch
 (MAILFOLDER FIRSTCHANGEDMESSAGE) of
 FOLDER))
+                          then
 (replace
 (MAILFOLDER FIRSTCHANGEDMESSAGE) of
 FOLDER
+                                      with
 FIRST#))
+                      (UNINTERRUPTABLY
+                          (for
 MSG in
 SORTED as
 I from
 FIRST#
+                             do
 (replace
 (LAFITEMSG %#) of
 MSG with
 I)
+                                   (SETA MESSAGES I MSG)))
+                      [LET ((FIRSTSEL (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE) of
 FOLDER))
+                            (LASTSEL (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE) of
 FOLDER)))
+                           (if
 (>= LASTSEL FIRSTSEL)
+                               then
 (if
 (AND (>= FIRSTSEL FIRST#)
+                                                     (<= FIRSTSEL LAST#))
+                                            then
         (* ; 
+
                                 "Start of selection was inside here, have to recompute its number")

+                                                  (replace
 (MAILFOLDER FIRSTSELECTEDMESSAGE)
+                                                     of
 FOLDER with
 (LAB.FIND.SELECTED.MSG
+                                                                             FOLDER FIRST# LAST#)))
+                                     (if
 (AND (>= LASTSEL FIRST#)
+                                                  (<= LASTSEL LAST#))
+                                         then
            (* ; 
+
                                   "End of selection was inside here, have to recompute its number")

+                                               (replace
 (MAILFOLDER LASTSELECTEDMESSAGE)
+                                                  of
 FOLDER with
 (LAB.REV.FIND.SELECTED.MSG
+                                                                          FOLDER FIRST# LAST#]
+                      (LAB.DISPLAYLINES FOLDER FIRST# LAST# NIL T)
+                      (LAB.PROMPTPRINT FOLDER "done"))))])
+
+(LAFITEMSG.DATE.ORDER

+  [LAMBDA (X Y)
                                          (* ; "Edited 26-Apr-89 14:53 by bvm")

+
+    (* ;; "True if msg X has older date than msg Y.  Since date field is stored as an unboxed 32-bit integer, we open code %"<%" here to avoid boxing.")

+
+    (LET [(HIDIFF (- (LOGXOR (fetch
 (LAFITEMSG IDATEHI) of
 X)
+                            32768)
+                     (LOGXOR (fetch
 (LAFITEMSG IDATEHI) of
 Y)
+                            32768]
+
+         (* ;; "HIDIFF is unsigned difference of high words")

+
+         (OR (< HIDIFF 0)
+             (AND (EQ HIDIFF 0)
+                  (< (fetch
 (LAFITEMSG IDATELO) of
 X)
+                     (fetch
 (LAFITEMSG IDATELO) of
 Y])
+
+(\LAFITE.SORT.BY.DATE.INTERACTIVE

+  [LAMBDA (FOLDER FIRST# LAST#)
                          (* ; "Edited  3-May-89 18:38 by bvm")

+    (if
 (LAB.MOUSECONFIRM FOLDER "Click LEFT to confirm sorting ~D messages by date"
+                   (if
 LAST#
+                       then
 (ADD1 (- LAST# FIRST#))
+                     else
 (fetch
 (MAILFOLDER %#OFMESSAGES) of
 FOLDER)))
+        then
 (\LAFITE.PROCESS `(,(FUNCTION LAFITE.SORT.BY.DATE)
+                                    ',FOLDER
+                                    ',FIRST#
+                                    ',LAST#)
+                        "LafiteSort"])
+
+(\LAFITE.SORT.BY.DATE.REGION

+  [LAMBDA (FOLDER)
                                       (* ; "Edited 28-Apr-89 16:23 by bvm")

+    (LET ((FIRST# (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE) of
 FOLDER))
+          (LAST# (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE) of
 FOLDER)))
+         (if
 (> LAST# FIRST#)
+             then
 (\LAFITE.SORT.BY.DATE.INTERACTIVE
 FOLDER FIRST# LAST#)
+           else
 (LAB.FORMAT FOLDER "There is ~:[no~;only one~] message selected."
+                           (EQ LAST# FIRST#])
+)
+
+(APPENDTOVAR LAFITEEXTRAMENUITEMS
 ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                             (SUBITEMS ("Sort Entire Folder" 
+                                                              '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                        "Sort all the messages in this folder by their Date: fields."
+                                                              )
+                                                    ("Sort Selected Range" 
+                                                           '\LAFITE.SORT.BY.DATE.REGION 
+                               "Sort only the messages between the first and last selected messages."
+                                                           ))))
+
+
+
+(* ; "Date hax")

+
+(DEFINEQ
+
+(GDATE1-6

+  [LAMBDA (D)
                                            (* ; "Edited 26-Apr-89 15:24 by bvm")

+
+    (* ;; "Return a string containing the day and month given in internal date D.")

+
+    (* ;; "This is an optimization by source code simplification of (SUBSTRING (GDATE IDT) 1 6)")

+
+    (PROG ((CHECKDLS \DayLightSavings)
+           [DQ (IQUOTIENT (LRSH (LISP.TO.ALTO.DATE D)
+                                1)
+                      (CONSTANT (IQUOTIENT (TIMES 60 60)
+                                       2]
+           HR DAY4 YDAY WDAY YEAR4 TOTALDAYS DLS)            (* ; 
+
                         "DQ is number of hours since day 0, getting us past the sign bit problem.")

+
+     (* ;; "Now we can adjust to the current time zone.  Since this might cause DQ to go negative, first add in 4 years worth of hours, making the base date be Jan 1, 1897")

+
+          (SETQ HR (IREMAINDER (SETQ DQ (- (+ DQ (CONSTANT (ITIMES 24 \4YearsDays)))
+                                           \TimeZoneComp))
+                          24))
+          (SETQ TOTALDAYS (IQUOTIENT DQ 24))
+      DTLOOP
+          (SETQ DAY4 (IREMAINDER TOTALDAYS \4YearsDays))     (* ; 
+
                                                 "DAY4 = number of days since last leap year day 0")

+          [SETQ DAY4 (+ DAY4 (CDR (\DTSCAN DAY4 '((789 . 3)
+                                                  (424 . 2)
+                                                  (59 . 1)
+                                                  (0 . 0]    (* ; 
+
                              "pretend every year is a leap year, adding one for days after Feb 28")

+          (SETQ YEAR4 (IQUOTIENT TOTALDAYS \4YearsDays))     (* ; 
+
                                              "YEAR4 = number of years til that last leap year / 4")

+          (SETQ YDAY (IREMAINDER DAY4 366))                  (* ; 
+
                                               "YDAY is the ordinal day in the year (jan 1 = zero)")

+          (SETQ WDAY (IREMAINDER (+ TOTALDAYS 3)
+                            7))
+          [COND
+             ((AND CHECKDLS (SETQ DLS (\ISDST? YDAY HR WDAY)))
+
+              (* ;; "This date is during daylight savings, so add 1 hour.  Third arg is day of the week, which we determine by taking days mod 7 plus offset.  Monday = zero in this scheme.  Jan 1 1897 was actually a Friday (not Thursday=3), but we're cheating--1900 was not a leap year")

+
+              (COND
+                 ((> (SETQ HR (ADD1 HR))
+                     23)
+
+                  (* ;; "overflowed into the next day.  This case is too hard (we might have overflowed the month, for example), so just go back and recompute")

+
+                  (SETQ TOTALDAYS (ADD1 TOTALDAYS))
+                  (SETQ HR 0)
+                  (SETQ CHECKDLS NIL)
+                  (GO DTLOOP]
+          (RETURN (LET* [[MONTH (\DTSCAN YDAY '((335 . "Dec")
+                                                (305 . "Nov")
+                                                (274 . "Oct")
+                                                (244 . "Sep")
+                                                (213 . "Aug")
+                                                (182 . "Jul")
+                                                (152 . "Jun")
+                                                (121 . "May")
+                                                (91 . "Apr")
+                                                (60 . "Mar")
+                                                (31 . "Feb")
+                                                (0 . "Jan"]
+                         [DAY (ADD1 (- YDAY (CAR MONTH]
+                         (RESULT (CONCAT "   " (CDR MONTH]
+                        (\RPLRIGHT RESULT 2 DAY 1)
+                        RESULT])
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \4YearsDays
 1461)
+
+
+(CONSTANTS \4YearsDays)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS \TimeZoneComp \DayLightSavings)
+)
+)
+(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989 1995 2021))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2020 14676 (LAFITE.ASSURE.DATE.FIELDS 2030 . 8127) (LAFITE.PARSE.DATE.FIELD 8129 . 8766
+) (LAFITE.PARSE.DATE.FIELD.ONLY 8768 . 8983) (LAFITE.SORT.BY.DATE 8985 . 9345) (LAFITE.SORT.MESSAGES 
+9347 . 12737) (LAFITEMSG.DATE.ORDER 12739 . 13487) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13489 . 14133) (
+\LAFITE.SORT.BY.DATE.REGION 14135 . 14674)) (15566 19381 (GDATE1-6 15576 . 19379)))))
+STOP

library/lafite/LAFITETEDIT

@@ -1,14 +1,18 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-May-92 11:28:47" {DSK}<project>medley2.0>library>lafitetedit.;7
 12308  
+
(FILECREATED "30-Sep-2021 23:07:55" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITETEDIT.;3
 12516  
 
-      changes to%:  (FNS TEDIT.ASSURE.NO.BACKING.FILE)
-                    (VARS LAFITETEDITCOMS)
+      changes to%:  (VARS LAFITETEDITCOMS)
+                    (FNS LA.ADJUST.FORMATTING LA.SKIP.LOOKS.LIST LA.DETACH.TEDIT LA.TEDIT.INCLUDE 
+                         LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
+                    (FILES LAFITEDECLS)
 
-      previous date%: "29-Apr-92 13:30:23" {DSK}<project>medley2.0>library>lafitetedit.;5)
+      previous date%: "30-Sep-2021 22:59:28" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITETEDIT.;2)
 
 
 (* ; "
-Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
+Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT LAFITETEDITCOMS)
@@ -21,10 +25,10 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
              LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
         (DECLARE%: EVAL@COMPILE DONTCOPY 
 
-               (* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING.  Can't just do (FILES (SOURCE) TEDITDECLS), because there is a compiled version that is already loaded that isn't enough.")

+               (* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING.  Can't just do (FILES (SOURCE) TEDITDCL), because there is a compiled version that is already loaded that isn't enough.")

 
-               (P (CL:UNLESS (GET 'TEDITDECLS 'FILE)
-                         (FILESLOAD TEDITDECLS)))
+               (P (CL:UNLESS (GET 'TEDITDCL 'FILE)
+                         (FILESLOAD TEDITDCL)))
                (FILES (SOURCE)
                       LAFITEDECLS)
                (GLOBALVARS *TEDIT-FILE-READTABLE*)
@@ -181,8 +185,8 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
-(CL:UNLESS (GET 'TEDITDECLS 'FILE)
-       (FILESLOAD TEDITDECLS))
+(CL:UNLESS (GET 'TEDITDCL 'FILE)
+       (FILESLOAD TEDITDCL))
 
 
 (FILESLOAD (SOURCE)
@@ -198,9 +202,9 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation.  All rights reserved.
 (LOCALVARS . T)
 )
 )
-(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992))
+(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1342 11940 (LA.ADJUST.FORMATTING 1352 . 7488) (LA.SKIP.LOOKS.LIST 7490 . 8064) (
-LA.DETACH.TEDIT 8066 . 8431) (LA.TEDIT.INCLUDE 8433 . 8922) (LA.WINDOW.FROM.TEXTSTREAM 8924 . 9370) (
-TEDIT.ASSURE.NO.BACKING.FILE 9372 . 11938)))))
+  (FILEMAP (NIL (1549 12147 (LA.ADJUST.FORMATTING 1559 . 7695) (LA.SKIP.LOOKS.LIST 7697 . 8271) (
+LA.DETACH.TEDIT 8273 . 8638) (LA.TEDIT.INCLUDE 8640 . 9129) (LA.WINDOW.FROM.TEXTSTREAM 9131 . 9577) (
+TEDIT.ASSURE.NO.BACKING.FILE 9579 . 12145)))))
 STOP

lispusers/BACKGROUND-YIELD

@@ -0,0 +1,50 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "14-Nov-2021 22:05:58" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;2
 1597   
+
+      changes to%:  (VARS BACKGROUND-YIELD)
+
+      previous date%: "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
+
+
+(PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
+
+(RPAQQ BACKGROUND-YIELDCOMS
 (
+                                 (* ;; 
+
                               " Add a call to BACKGROUNDFNS to yield when not otherwise busy")

+
+                                 (FNS BACKGROUND-YIELD INIT-YIELD)
+                                 (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT-YIELD T)))
+                                 (VARS BACKGROUND-YIELD)))
+
+
+
+(* ;; " Add a call to BACKGROUNDFNS to yield when not otherwise busy")

+
+(DEFINEQ
+
+(BACKGROUND-YIELD

+  [LAMBDA NIL
                                          (* ; "Edited 20-Sep-2021 11:37 by larry")

+    (IF
 (FIXP BACKGROUND-YIELD)
+        THEN
 (SUBRCALL YIELD BACKGROUND-YIELD)
+              (SUBRCALL CAUSE-INTERRUPT])
+
+(INIT-YIELD

+  [LAMBDA (ONP)
                                        (* ; "Edited 19-Sep-2021 13:32 by larry")

+    (SETQ BACKGROUNDFNS (REMOVE 'BACKGROUND-YIELD BACKGROUNDFNS))
+    (if
 [AND ONP (CCODEP (GETD 'BACKGROUND-YIELD]
+        then
 
+
+              (* ;; " add to end")

+
+              (SETQ BACKGROUNDFNS (APPEND BACKGROUNDFNS '(BACKGROUND-YIELD
])
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(INIT-YIELD
 T)
+)
+
+(RPAQQ BACKGROUND-YIELD
 833333)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (833 1482 (BACKGROUND-YIELD 843 . 1098) (INIT-YIELD 1100 . 1480)))))
+STOP

lispusers/DATE

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

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

-
-(DEFINEQ
-
-(DATEOBJ

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

-                                                             (* Create an instance of a date imageobj.

-							     A dateobj is also defined as a record with a 

-							     datestring field. *)

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

-							     property associated with it that will facilitate 

-							     imageobj mapping in a TEdit file.)

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

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

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

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

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

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

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

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

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

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

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

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

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

-	  LetterHead code.)

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

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

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

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

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

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

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

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

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

-
-          (* * comment)

-
-
-    (
COND

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

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

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

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

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

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

-
-
-    (
SETQ
 ITEM (
COND

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

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

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

-    (
COND

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

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

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

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

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

-    (
COND

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

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

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

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

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

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

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

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

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

-                                                             (* changed)

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

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

-
-          (* * comment)

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

-							     Length of whole datatype is multiple of 4, so 

-							     quad-aligned)

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

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

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

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

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

-							     bit set and COFFSET lt 512)

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

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

-							     one buffer at a time)

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

-							     NIL for terminal, dribble...)

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

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

-							     (read, write, append))

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

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

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

-							     determine if file has changed in our absence)

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

-                                                             (* Following are device-specific fields)

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

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

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

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

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

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

-							     IMAGEOPS value)

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

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

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

-							     gbn 4-2-85)

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

lispusers/DICOLOR

@@ -1,446 +0,0 @@
-
(FILECREATED "15-Aug-85 19:44:58" {ERIS}<LISPCORE>LIBRARY>DICOLOR.;2
 15766  
-
-      changes to:  (VARS DICOLORCOMS)
-
-      previous date: " 9-Aug-85 05:58:26" {ERIS}<LISPCORE>LIBRARY>DICOLOR.;1)
-
-
-(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
-
-(PRETTYCOMPRINT DICOLORCOMS)
-
-(RPAQQ DICOLORCOMS
 ((FNS CNSMENUINIT CNSTOCSL CNSTORGB CSLTOCNS DICOLOR.FROM.USER GETCNS HLSTOCSL 
-			 CSLTOHLS RGBTOCNS)
-		    (VARS DICOLOR.hueMapping DICOLOR.lightnessMapping DICOLOR.saturationMapping 
-			  NEWCOLORITEM)
-		    (INITVARS (COLORNAMEMENU))
-		    (FNS DICOLOR.hueN DICOLOR.hueNvalue DICOLOR.hueNname DICOLOR.lightnessN 
-			 DICOLOR.lightnessNvalue DICOLOR.lightnessNname DICOLOR.saturationN 
-			 DICOLOR.saturationNvalue DICOLOR.saturationNname)
-		    (DECLARE: DONTCOPY (*)
-			      (RECORDS hueRecord lightnessRecord saturationRecord)
-			      (CONSTANTS * DICOLOR.hueConstants)
-			      (CONSTANTS * DICOLOR.saturationConstants)
-			      (CONSTANTS * DICOLOR.lightnessConstants))))
-(DEFINEQ
-
-(CNSMENUINIT

-  [LAMBDA NIL                                                (* gbn " 9-Aug-85 03:11")

-    [
SETQ
 CNSHUEMENU (create
 MENU
-			     ITEMS _(for
 I in
 DICOLOR.hueMapping collect
 (
CAR
 I]
-    [
SETQ
 CNSSATURATIONMENU (create
 MENU
-				    ITEMS _(for
 I in
 DICOLOR.saturationMapping collect
 (
CAR
 I]
-    (
SETQ
 CNSLIGHTNESSMENU (create
 MENU
-				   ITEMS _(for
 I in
 DICOLOR.lightnessMapping collect
 (
CAR
 I])
-
-(CNSTOCSL

-  [LAMBDA (hue saturation lightness)                         (* hdj "12-Apr-85 19:01")

-    (
PROG
 ((hueAtom (
MKATOM
 hue))
-	   (saturationAtom (
MKATOM
 saturation))
-	   (lightnessAtom (
MKATOM
 lightness))
-	   c s l)
-          (if
 [
NOT
 (
SETQ
 c (fetch
 (hueRecord ordering) of
 (
ASSOC
 hueAtom DICOLOR.hueMapping]
-	      then
 (
SETQ
 c DICOLOR.achromatic))
-          (if
 (
EQ
 c DICOLOR.achromatic)
-	      then
 (
SETQ
 s DICOLOR.noSaturation)
-	    else
 (if
 [
NOT
 (
SETQ
 s (fetch
 (saturationRecord ordering) of
 (
ASSOC
 saturationAtom 
-									DICOLOR.saturationMapping]
-		     then
 (
SETQ
 s DICOLOR.vivid)))
-          (
SELECTQ
 hueAtom
-		   (Black (
SETQ
 l DICOLOR.black))
-		   (White (
SETQ
 l DICOLOR.white))
-		   (if
 [
NOT
 (
SETQ
 l (fetch
 (lightnessRecord ordering) of
 (
ASSOC
 lightnessAtom 
-									 DICOLOR.lightnessMapping]
-		       then
 (
SETQ
 l DICOLOR.medium)))
-          (
RETURN
 (
LIST
 c s l])
-
-(CNSTORGB

-  [LAMBDA (saturation lightness hue)                         (* hdj "15-Jul-85 12:33")

-    (LET ((CSL (CNSTOCSL
 hue saturation lightness)))
-         (
HLSTORGB
 (
APPLY
 (
FUNCTION
 CSLTOHLS)
-			  CSL])
-
-(CSLTOCNS

-  [LAMBDA (c s l)                                            (* hdj "15-Jul-85 12:37")

-    (
PROG
 (hue saturation lightness)
-          [if
 (
EQ
 c DICOLOR.achromatic)
-	      then
 (
SETQ
 saturation "")
-		   [
SELECTC
 l
-			    (DICOLOR.black (
SETQ
 hue "Black")
-					   (
SETQ
 lightness ""))
-			    (DICOLOR.white (
SETQ
 hue "White")
-					   (
SETQ
 lightness ""))
-			    (
PROGN
 (
SETQ
 hue "Gray")
-				   (
SETQ
 lightness (
MKSTRING
 (fetch
 (lightnessRecord name)
-								of
 (DICOLOR.lightnessN
 l]
-	    else
 (
SETQ
 hue (fetch
 (hueRecord name) of
 (DICOLOR.hueN
 c)))
-		 (
SETQ
 saturation (fetch
 (saturationRecord name) of
 (DICOLOR.saturationN
 s)))
-		 (
SETQ
 lightness (fetch
 (lightnessRecord name) of
 (DICOLOR.lightnessN
 l]
-          (
RETURN
 (
LIST
 saturation lightness hue])
-
-(DICOLOR.FROM.USER

-  [LAMBDA (NAMES?)                                           (* gbn " 9-Aug-85 04:51")

-
-          (* * returns an RGB triple. If NAMES? prompts the user first with the global color name menu.

-	  She can then choose NEWCOLOR which can be specified as RGB or CNS)

-
-
-    (
PROG
 (NAME RGB)
-          (if
 NAMES?
-	      then
                                           (* first try to get a color name)

-		   [
SETQ
 NAME (
MENU
 (
OR
 COLORNAMEMENU (
SETQ
 COLORNAMEMENU
-					  (CREATE
 MENU
-						  ITEMS _(
CONS
 NEWCOLORITEM
-							       (FOR
 ENTRY IN
 COLORNAMES
-								  COLLECT
 (
CAR
 ENTRY]
-		   (if
 (
NOT
 NAME)
-		       then
                                  (* the user clicked outside the menu)

-			    (
RETURN
))
-		   [
SETQ
 RGB (
SELECTQ
 NAME
-				      (RGB (
READCOLOR1
 "specify new color"))
-				      (CNS (
APPLY
 (
FUNCTION
 CNSTORGB)
-						  (GETCNS
)))
-				      (
RETURN
 (
CDR
 (
ASSOC
 NAME COLORNAMES]
-		   (if
 (
NOT
 (
SETQ
 NAME (
TTYIN
 "New color name? ")))
-		       then
                                  (* user must have decided that she didn't want to keep 

-							     (name) the color)

-			    (
RETURN
))
-		   (push
 COLORNAMES (
CONS
 (
CAR
 NAME)
-					  RGB))
-		   (
SETQ
 COLORNAMEMENU NIL)                  (* invalidate the menu)

-		   (
RETURN
 RGB])
-
-(GETCNS

-  [LAMBDA NIL                                                (* gbn " 9-Aug-85 03:13")

-    (
LIST
 (
MENU
 CNSLIGHTNESSMENU)
-	  (
MENU
 CNSSATURATIONMENU)
-	  (
MENU
 CNSHUEMENU])
-
-(HLSTOCSL

-  [LAMBDA (hue lightness saturation)                         (* hdj "15-Jul-85 12:14")

-    (LET ((ISLHue (
FQUOTIENT
 (MOD (
PLUS
 hue 240)
-				  360)
-			     360)))
-         (
PROG
 (c s l)
-	       (for
 old
 s from
 DICOLOR.noSaturation to
 DICOLOR.vivid
-		  do
 (if
 (
EQ
 s DICOLOR.vivid)
-			 then
 (
RETURN
))
-		     (if
 (
LEQ
 saturation (
PLUS
 (DICOLOR.saturationNvalue
 s)
-					       (
QUOTIENT
 (
DIFFERENCE
 (DICOLOR.saturationNvalue

-								       (
ADD1
 s))
-								     (DICOLOR.saturationNvalue
 s))
-							 2)))
-			 then
 (
RETURN
)))
-	       [if
 (
EQ
 s DICOLOR.noSaturation)
-		   then
 (
SETQ
 c DICOLOR.achromatic)
-			(for
 old
 l from
 DICOLOR.black to
 DICOLOR.white
-			   do
 (if
 (
EQ
 l DICOLOR.white)
-				  then
 (
RETURN
))
-			      (if
 (
LEQ
 lightness (
PLUS
 (DICOLOR.lightnessNvalue
 l)
-						       (
QUOTIENT
 (
DIFFERENCE
 (DICOLOR.lightnessNvalue

-									       (
ADD1
 l))
-									     (DICOLOR.lightnessNvalue

-									       l))
-								 2)))
-				  then
 (
RETURN
)))
-		 else
 (for
 old
 c from
 DICOLOR.red to
 DICOLOR.purplishRed
-			 do
                                  (* (HELP c))

-			    (if
 (
EQ
 c DICOLOR.purplishRed)
-				then
 (if
 (
GREATERP
 ISLHue (
PLUS
 (DICOLOR.hueNvalue
 c)
-								(
QUOTIENT
 (
DIFFERENCE
 1 (

-										DICOLOR.hueNvalue

-											c))
-									  2)))
-					 then
 (
SETQ
 c DICOLOR.red))
-				     (
RETURN
))
-			    (if
 (
LEQ
 ISLHue (
PLUS
 (DICOLOR.hueNvalue
 c)
-						  (
QUOTIENT
 (
DIFFERENCE
 (DICOLOR.hueNvalue

-									  (
ADD1
 c))
-									(DICOLOR.hueNvalue
 c))
-							    2)))
-				then
 (
RETURN
)))
-		      (for
 old
 l from
 DICOLOR.veryDark to
 DICOLOR.veryLight
-			 do
 (if
 (
EQ
 l DICOLOR.veryLight)
-				then
 (
RETURN
))
-			    (if
 (
LEQ
 lightness (
PLUS
 (DICOLOR.lightnessNvalue
 l)
-						     (
QUOTIENT
 (
DIFFERENCE
 (DICOLOR.lightnessNvalue

-									     (
ADD1
 l))
-									   (DICOLOR.lightnessNvalue

-									     l))
-							       2)))
-				then
 (
RETURN
]
-	       (
RETURN
 (
LIST
 c s l])
-
-(CSLTOHLS

-  [LAMBDA (c s l)                                            (* hdj "15-Jul-85 12:23")

-    (
PROG
 (hue saturation lightness)
-          (if
 (
EQ
 c DICOLOR.achromatic)
-	      then
 (
SETQ
 hue 0.0)
-		   (
SETQ
 saturation 0.0)
-		   (
SETQ
 lightness (DICOLOR.lightnessNvalue
 l))
-	    else
 (
SETQ
 hue (DICOLOR.hueNvalue
 c))
-		 (
SETQ
 saturation (DICOLOR.saturationNvalue
 s))
-		 (
SETQ
 lightness (DICOLOR.lightnessNvalue
 l)))
-          (
RETURN
 (
LIST
 (MOD (
FPLUS
 120 (
FTIMES
 hue 360))
-			     360)
-			lightness saturation])
-
-(RGBTOCNS

-  [LAMBDA (Red Green Blue)                                   (* hdj "15-Jul-85 12:36")

-    (
APPLY
 (
FUNCTION
 CSLTOCNS)
-	   (
APPLY
 (
FUNCTION
 HLSTOCSL)
-		  (
RGBTOHLS
 Red Green Blue])
-)
-
-(RPAQQ DICOLOR.hueMapping
 ((Achromatic 0.0 -1)
-			   (Red 0.0 0)
-			   (OrangishRed .01 1)
-			   (RedOrange .02 2)
-			   (ReddishOrange .03 3)
-			   (Orange .04 4)
-			   (YellowishOrange .07 5)
-			   (OrangeYellow .1 6)
-			   (OrangishYellow .13 7)
-			   (Yellow .1673 8)
-			   (GreenishYellow .2073 9)
-			   (YellowGreen .2473 10)
-			   (YellowishGreen .2873 11)
-			   (Green .3333 12)
-			   (BluishGreen .4133 13)
-			   (GreenBlue .4933 14)
-			   (GreenishBlue .5733 15)
-			   (Blue .6666 16)
-			   (PurplishBlue .6816 17)
-			   (BluePurple .6966 18)
-			   (BluishPurple .7116 19)
-			   (Purple .73 20)
-			   (ReddishPurple .8 21)
-			   (PurpleRed .87 22)
-			   (PurplishRed .94 23)
-			   (BrownishRed .01 24)
-			   (RedBrown .02 25)
-			   (ReddishBrown .03 26)
-			   (Brown .04 27)
-			   (YellowishBrown .07 28)
-			   (BrownYellow .1 29)
-			   (BrownishYellow .13 30)))
-
-(RPAQQ DICOLOR.lightnessMapping
 ((Black 0.0 0)
-				 (VeryDark .1666 1)
-				 (Dark .3333 2)
-				 (Medium .5 3)
-				 (Light .6666 4)
-				 (VeryLight .8333 5)
-				 (White 1.0 6)))
-
-(RPAQQ DICOLOR.saturationMapping
 ((NoSaturation 0.0 0)
-				  (Grayish .25 1)
-				  (Moderate .5 2)
-				  (Strong .75 3)
-				  (Vivid 1.0 4)))
-
-(RPAQQ NEWCOLORITEM
 (New% Color (QUOTE CNS)
-				"Allows specification of a new color"
-				(SUBITEMS (RGB (QUOTE RGB)
-					       "Specify a new color using Red, Green, Blue sliders")
-					  (CNS (QUOTE CNS)
-					       "Specify a new color using English"))))
-
-(RPAQ? COLORNAMEMENU
 )
-(DEFINEQ
-
-(DICOLOR.hueN

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:38")

-    (DECLARE
 (
GLOBALVARS
 DICOLOR.hueMapping))
-    (for
 ELT in
 DICOLOR.hueMapping suchthat
 (
EQ
 (fetch
 (hueRecord ordering) of
 ELT)
-						N])
-
-(DICOLOR.hueNvalue

-  [LAMBDA (N)                                                (* hdj "18-Apr-85 09:58")

-    (fetch
 (hueRecord value) of
 (DICOLOR.hueN
 N])
-
-(DICOLOR.hueNname

-  [LAMBDA (N)                                                (* hdj "18-Apr-85 10:07")

-    (fetch
 (hueRecord name) of
 (DICOLOR.hueN
 N])
-
-(DICOLOR.lightnessN

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:40")

-    (DECLARE
 (
GLOBALVARS
 DICOLOR.lightnessMapping))
-    (for
 ELT in
 DICOLOR.lightnessMapping suchthat
 (
EQ
 (fetch
 (lightnessRecord ordering) of
 ELT)
-						      N])
-
-(DICOLOR.lightnessNvalue

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:36")

-    (fetch
 (lightnessRecord value) of
 (DICOLOR.lightnessN
 N])
-
-(DICOLOR.lightnessNname

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 14:02")

-    (fetch
 (lightnessRecord name) of
 (DICOLOR.lightnessN
 N])
-
-(DICOLOR.saturationN

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:39")

-    (DECLARE
 (
GLOBALVARS
 DICOLOR.saturationMapping))
-    (for
 ELT in
 DICOLOR.saturationMapping suchthat
 (
EQ
 (fetch
 (saturationRecord ordering)
-							  of
 ELT)
-						       N])
-
-(DICOLOR.saturationNvalue

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 13:36")

-    (fetch
 (saturationRecord value) of
 (DICOLOR.saturationN
 N])
-
-(DICOLOR.saturationNname

-  [LAMBDA (N)                                                (* hdj "17-Apr-85 14:02")

-    (fetch
 (saturationRecord name) of
 (DICOLOR.saturationN
 N])
-)
-(DECLARE: DONTCOPY 
-[DECLARE: EVAL@COMPILE 
-
-(RECORD hueRecord
 (name value ordering))
-
-(RECORD lightnessRecord
 (name value ordering))
-
-(RECORD saturationRecord
 (name value ordering))
-]
-
-
-(RPAQQ DICOLOR.hueConstants
 (DICOLOR.achromatic DICOLOR.blue DICOLOR.bluePurple DICOLOR.bluishGreen 
-						DICOLOR.bluishPurple DICOLOR.brown 
-						DICOLOR.brownYellow DICOLOR.brownishRed 
-						DICOLOR.brownishYellow DICOLOR.green 
-						DICOLOR.greenBlue DICOLOR.greenishBlue 
-						DICOLOR.greenishYellow DICOLOR.orange 
-						DICOLOR.orangeYellow DICOLOR.orangishRed 
-						DICOLOR.orangishYellow DICOLOR.purple 
-						DICOLOR.purpleRed DICOLOR.purplishBlue 
-						DICOLOR.purplishRed DICOLOR.red DICOLOR.redBrown 
-						DICOLOR.redOrange DICOLOR.reddishBrown 
-						DICOLOR.reddishOrange DICOLOR.reddishPurple 
-						DICOLOR.yellow DICOLOR.yellowGreen 
-						DICOLOR.yellowishBrown DICOLOR.yellowishGreen 
-						DICOLOR.yellowishOrange))
-(DECLARE: EVAL@COMPILE 
-
-(RPAQQ DICOLOR.achromatic
 -1)
-
-(RPAQQ DICOLOR.blue
 16)
-
-(RPAQQ DICOLOR.bluePurple
 18)
-
-(RPAQQ DICOLOR.bluishGreen
 13)
-
-(RPAQQ DICOLOR.bluishPurple
 19)
-
-(RPAQQ DICOLOR.brown
 27)
-
-(RPAQQ DICOLOR.brownYellow
 29)
-
-(RPAQQ DICOLOR.brownishRed
 24)
-
-(RPAQQ DICOLOR.brownishYellow
 30)
-
-(RPAQQ DICOLOR.green
 12)
-
-(RPAQQ DICOLOR.greenBlue
 14)
-
-(RPAQQ DICOLOR.greenishBlue
 15)
-
-(RPAQQ DICOLOR.greenishYellow
 9)
-
-(RPAQQ DICOLOR.orange
 4)
-
-(RPAQQ DICOLOR.orangeYellow
 6)
-
-(RPAQQ DICOLOR.orangishRed
 1)
-
-(RPAQQ DICOLOR.orangishYellow
 7)
-
-(RPAQQ DICOLOR.purple
 20)
-
-(RPAQQ DICOLOR.purpleRed
 22)
-
-(RPAQQ DICOLOR.purplishBlue
 17)
-
-(RPAQQ DICOLOR.purplishRed
 23)
-
-(RPAQQ DICOLOR.red
 0)
-
-(RPAQQ DICOLOR.redBrown
 25)
-
-(RPAQQ DICOLOR.redOrange
 2)
-
-(RPAQQ DICOLOR.reddishBrown
 26)
-
-(RPAQQ DICOLOR.reddishOrange
 3)
-
-(RPAQQ DICOLOR.reddishPurple
 21)
-
-(RPAQQ DICOLOR.yellow
 8)
-
-(RPAQQ DICOLOR.yellowGreen
 10)
-
-(RPAQQ DICOLOR.yellowishBrown
 28)
-
-(RPAQQ DICOLOR.yellowishGreen
 11)
-
-(RPAQQ DICOLOR.yellowishOrange
 5)
-
-(CONSTANTS DICOLOR.achromatic DICOLOR.blue DICOLOR.bluePurple DICOLOR.bluishGreen 
-	   DICOLOR.bluishPurple DICOLOR.brown DICOLOR.brownYellow DICOLOR.brownishRed 
-	   DICOLOR.brownishYellow DICOLOR.green DICOLOR.greenBlue DICOLOR.greenishBlue 
-	   DICOLOR.greenishYellow DICOLOR.orange DICOLOR.orangeYellow DICOLOR.orangishRed 
-	   DICOLOR.orangishYellow DICOLOR.purple DICOLOR.purpleRed DICOLOR.purplishBlue 
-	   DICOLOR.purplishRed DICOLOR.red DICOLOR.redBrown DICOLOR.redOrange DICOLOR.reddishBrown 
-	   DICOLOR.reddishOrange DICOLOR.reddishPurple DICOLOR.yellow DICOLOR.yellowGreen 
-	   DICOLOR.yellowishBrown DICOLOR.yellowishGreen DICOLOR.yellowishOrange)
-)
-
-
-(RPAQQ DICOLOR.saturationConstants
 (DICOLOR.noSaturation DICOLOR.grayish DICOLOR.moderate 
-							 DICOLOR.strong DICOLOR.vivid))
-(DECLARE: EVAL@COMPILE 
-
-(RPAQQ DICOLOR.noSaturation
 0)
-
-(RPAQQ DICOLOR.grayish
 1)
-
-(RPAQQ DICOLOR.moderate
 2)
-
-(RPAQQ DICOLOR.strong
 3)
-
-(RPAQQ DICOLOR.vivid
 4)
-
-(CONSTANTS DICOLOR.noSaturation DICOLOR.grayish DICOLOR.moderate DICOLOR.strong DICOLOR.vivid)
-)
-
-
-(RPAQQ DICOLOR.lightnessConstants
 (DICOLOR.black DICOLOR.veryDark DICOLOR.dark DICOLOR.medium 
-						 DICOLOR.light DICOLOR.veryLight DICOLOR.white))
-(DECLARE: EVAL@COMPILE 
-
-(RPAQQ DICOLOR.black
 0)
-
-(RPAQQ DICOLOR.veryDark
 1)
-
-(RPAQQ DICOLOR.dark
 2)
-
-(RPAQQ DICOLOR.medium
 3)
-
-(RPAQQ DICOLOR.light
 4)
-
-(RPAQQ DICOLOR.veryLight
 5)
-
-(RPAQQ DICOLOR.white
 6)
-
-(CONSTANTS DICOLOR.black DICOLOR.veryDark DICOLOR.dark DICOLOR.medium DICOLOR.light DICOLOR.veryLight 
-	   DICOLOR.white)
-)
-)
-(PUTPROPS DICOLOR COPYRIGHT ("Xerox Corporation" 1985))
-(DECLARE: DONTCOPY
-  (FILEMAP (NIL (1005 8438 (CNSMENUINIT 1015 . 1502) (CNSTOCSL 1504 . 2550) (CNSTORGB 2552 . 2782) (
-CSLTOCNS 2784 . 3683) (DICOLOR.FROM.USER 3685 . 5118) (GETCNS 5120 . 5322) (HLSTOCSL 5324 . 7615) (
-CSLTOHLS 7617 . 8217) (RGBTOCNS 8219 . 8436)) (9938 12002 (DICOLOR.hueN 9948 . 10228) (
-DICOLOR.hueNvalue 10230 . 10405) (DICOLOR.hueNname 10407 . 10580) (DICOLOR.lightnessN 10582 . 10892) (
-DICOLOR.lightnessNvalue 10894 . 11087) (DICOLOR.lightnessNname 11089 . 11280) (DICOLOR.saturationN 
-11282 . 11606) (DICOLOR.saturationNvalue 11608 . 11804) (DICOLOR.saturationNname 11806 . 12000)))))
-STOP

lispusers/DINFO

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

+        (FNS                                                 (* ; "Primary functions")

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

+        (FNS                                                 (* ; "Koto compatability")

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

+        (FNS                                                 (* ; "Window functions")

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

+        (FNS                                                 (* ; "FreeMenu functions")

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

lispusers/MODERNIZE

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

        [
-        (* ;; "Externals")

+        (* ;; "Externals")

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

+        (* ;; "Internals")

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

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

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

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

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

+                                                 (* ;; "Tedit")

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

+                                                 (* ;; "Inspector")

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

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

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

+                                                 (* ;; "File browser")

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

+                                                 (* ;; "SEDIT")

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

+                                                 (* ;; "Debugger")

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

+                                                 (* ;; "Snap")

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

+                                                 (* ;; "New execs")

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

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

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

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

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

+                                                 (* ;; "Grapher")

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

+                                                 (* ;; "Sketch")

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

+                                                 (* ;; "Promptwindow")

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

+        (* ;; "All")

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

+        (* ;; "Quit")

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

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

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

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

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

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

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

+(* ;; "Tedit")

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

+(* ;; "Inspector")

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

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

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

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

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

+(* ;; "File browser")

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

+(* ;; "SEDIT")

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

+(* ;; "Debugger")

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

+(* ;; "Snap")

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

+(* ;; "New execs")

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

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

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

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

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

+(* ;; "Grapher")

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

+(* ;; "Sketch")

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

+(* ;; "Promptwindow")

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

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

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

lispusers/MODERNIZE.TXT

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

lispusers/PLAINTEXTSTREAM

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

lispusers/POSTSCRIPT/PS-RS232

@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

lispusers/POSTSCRIPT/PS-TTY

@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")