TEDIT-MENU: Eliminate illegal arg and caret location errors (#1670)

* TEDIT-MENU: Eliminate illegal arg and caret location errors

@nbriggs got an error when (as I remember) parsing the OTHER font in the charlooks menu.  This was because of a missing BOUNDP check when trying to decide if the other font is a fontclass.

Separately, the caret appeared in the wrong place if a field insert was the first interaction with a menu.

* Remove redundant binding

.github/workflows/buildDocker.yml

@@ -63,31 +63,6 @@ defaults:
 
 jobs:
 
-######################################################################################
-
-  # Regularize the inputs so they can be referenced the same way whether they are
-  # the result of a workflow_dispatch or a workflow_call
-
-  inputs:
-    runs-on: ubuntu-latest
-    outputs:
-      draft: ${{ steps.one.outputs.draft }}
-      force: ${{ steps.one.outputs.force }}
-    steps:
-      - id: one
-        run: >
-          if [ '${{ toJSON(inputs) }}' = 'null'  ];
-          then
-              echo "workflow_dispatch";
-              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
-              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
-          else
-              echo "workflow_call";
-              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
-              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
-          fi
-
-
 
 ######################################################################################
 
@@ -95,7 +70,6 @@ jobs:
   # based on the latest commit to the repo
 
   sentry:
-    needs: inputs
     runs-on: ubuntu-latest
     outputs:
       release_not_built: ${{ steps.check.outputs.release_not_built }}
@@ -103,7 +77,7 @@ jobs:
     steps:
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -127,22 +101,22 @@ jobs:
 
     runs-on: ubuntu-latest
 
-    needs: [inputs, sentry]
+    needs: [sentry]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
-      || needs.inputs.outputs.force == 'true'
+      || inputs.force == 'true'
 
     steps:
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
 
       # Find latest release (draft or normal)
       # and download its assets
       - name: Download linux debs from latest (draft) release
         run: |
           tag=""
-          if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
+          if [ "${{ inputs.draft }}" = "true" ];
           then
             tag=$(gh release list | grep Draft | head -n 1 | awk '{ print $3 }')
           fi
@@ -177,7 +151,7 @@ jobs:
           repo_name="${GITHUB_REPOSITORY#*/}"
           docker_namespace="$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')"
           docker_image="${docker_namespace}/${repo_name}"
-          if [ "${{ needs.inputs.outputs.draft }}" = "false" ];
+          if [ "${{ inputs.draft }}" = "false" ];
           then
               docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
               platforms="linux/amd64,linux/arm64"
@@ -195,18 +169,18 @@ jobs:
 
       # Setup the Docker Machine Emulation environment.  
       - name: Set up QEMU
-        uses: docker/setup-qemu-action@master
+        uses: docker/setup-qemu-action@v3
         with:
           platforms: linux/amd64,linux/arm64,linux/arm/v7
 
       # Setup the Docker Buildx funtion
       - name: Set up Docker Buildx
         id: buildx
-        uses: docker/setup-buildx-action@master
+        uses: docker/setup-buildx-action@v3
 
       # Login into DockerHub - required to store the created image
       - name: Login to DockerHub
-        uses: docker/login-action@v2
+        uses: docker/login-action@v3
         with:
           username: ${{ secrets.DOCKER_USERNAME }}
           password: ${{ secrets.DOCKER_PASSWORD }}
@@ -215,7 +189,7 @@ jobs:
       # checked out and the release tars just downloaded.
       # Push the result to Docker Hub
       - name: Build Docker Image for Push to Docker Hub
-        uses: docker/build-push-action@v3
+        uses: docker/build-push-action@v5
         with:
           builder: ${{ steps.buildx.outputs.name }}
           build-args: |
@@ -242,12 +216,12 @@ jobs:
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}
 
-    needs: [inputs, sentry, build_and-push]
+    needs: [sentry, build_and-push]
 
     steps:
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}

.github/workflows/buildLoadup.yml

@@ -60,38 +60,12 @@ defaults:
 
 jobs:
 
-# JOB: inputs #######################################################################
-
-  # Regularize the inputs so they can be referenced the same way whether they are
-  # the result of a workflow_dispatch or a workflow_call
-
-  inputs:
-    runs-on: ubuntu-latest
-    outputs:
-      draft: ${{ steps.one.outputs.draft }}
-      force: ${{ steps.one.outputs.force }}
-    steps:
-      - id: one
-        run: >
-          if [ '${{ toJSON(inputs) }}' = 'null'  ];
-          then
-              echo "workflow_dispatch";
-              echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
-              echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
-          else
-              echo "workflow_call";
-              echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
-              echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
-          fi
-
-
 # JOB: sentry #######################################################################
 
   # Use sentry-action to determine if this release has already been built
   # based on the latest commit to the repo
 
   sentry:
-    needs: inputs
     runs-on: ubuntu-latest
     outputs:
       release_not_built: ${{ steps.check.outputs.release_not_built }}
@@ -99,7 +73,7 @@ jobs:
     steps:
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -133,15 +107,15 @@ jobs:
       artifacts_filename_template: ${{ steps.job_outputs.outputs.ARTIFACTS_FILENAME_TEMPLATE }}
       release_url: ${{ steps.push.outputs.html_url }}
 
-    needs: [inputs, sentry]
+    needs: [sentry]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
-      || needs.inputs.outputs.force == 'true'
+      || inputs.force == 'true'
 
     steps:
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}
@@ -149,7 +123,7 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
 
       # Setup release tag
       - name: Setup Release Tag
@@ -163,7 +137,7 @@ jobs:
         id: maiko
         run: |
           tag=""
-          if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
+          if [ "${{ inputs.draft }}" = "true" ];
           then
             gh release list --repo ${{ github.repository_owner }}/maiko | grep Draft >/tmp/releases-$$
             if [ $? -eq 0 ];
@@ -219,7 +193,7 @@ jobs:
 
       # Checkout Notecards and tar it in the tarballsdir
       - name: Checkout Notecards
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           repository: ${{ github.repository_owner }}/notecards
           path: ./notecards
@@ -262,14 +236,14 @@ jobs:
             ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-loadups.tgz,
             ${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-runtime.tgz
           tag: ${{ env.MEDLEY_RELEASE_TAG }}
-          draft: ${{ needs.inputs.outputs.draft }}
+          draft: ${{ inputs.draft }}
           prerelease: false
           generateReleaseNotes: true
           token: ${{ secrets.GITHUB_TOKEN }}
 
       # Save the tarball directory for subsequent jobs
       - name: Save tarballs
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: tarballs
           path: ${{ env.TARBALL_DIR }}
@@ -285,16 +259,16 @@ jobs:
 
     runs-on: ubuntu-latest
 
-    needs: [inputs, sentry, loadup]
+    needs: [sentry, loadup]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
-      || needs.inputs.outputs.force == 'true'
+      || inputs.force == 'true'
 
     steps:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
 
       # Environment variables
       - name: Environment variables
@@ -311,7 +285,7 @@ jobs:
 
       #  Get the tarballs
       - name: Get tarballs
-        uses: actions/download-artifact@v3
+        uses: actions/download-artifact@v4
         with:
           name: tarballs
           path: ${{ env.TARBALL_DIR }}
@@ -345,7 +319,7 @@ jobs:
             mv  medley-full-linux-x86_64-*.tgz medley.tgz
 
       - name: Save medley tar for use in cygwin installers
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
           name: medley-tar
           path: |
@@ -361,10 +335,10 @@ jobs:
 
     runs-on: macos-12
 
-    needs: [inputs, sentry, loadup]
+    needs: [sentry, loadup]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
-      || needs.inputs.outputs.force == 'true'
+      || inputs.force == 'true'
 #    if: false
 
     defaults:
@@ -375,7 +349,7 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
 
       # Environment variables
       - name: Environment variables
@@ -392,7 +366,7 @@ jobs:
 
       #  Get the tarballs
       - name: Get tarballs
-        uses: actions/download-artifact@v3
+        uses: actions/download-artifact@v4
         with:
           name: tarballs
           path: ${{ env.TARBALL_DIR }}
@@ -432,10 +406,10 @@ jobs:
 
     runs-on: windows-2022
 
-    needs: [inputs, sentry, loadup, linux_installer]
+    needs: [sentry, loadup, linux_installer]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
-      || needs.inputs.outputs.force == 'true'
+      || inputs.force == 'true'
 
     outputs:
       cygwin_installer: ${{ steps.compile_iss.outputs.CYGWIN_INSTALLER }}
@@ -444,7 +418,7 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
 
       # Store the values output from loadup job as environment variables
       - name: Environment Variables
@@ -463,7 +437,7 @@ jobs:
 
       # Retrieve medley tars from artifact store
       - name: Retrieve medley tar
-        uses: actions/download-artifact@v3
+        uses: actions/download-artifact@v4
         with:
           name: medley-tar
           path: installers/cygwin/
@@ -535,10 +509,10 @@ jobs:
 
     runs-on: ubuntu-latest
 
-    needs: [inputs, sentry, loadup, linux_installer, macos_installer, cygwin_installer]
+    needs: [sentry, loadup, linux_installer, macos_installer, cygwin_installer]
     if: |
       needs.sentry.outputs.release_not_built == 'true'
-      || needs.inputs.outputs.force == 'true'
+      || inputs.force == 'true'
 
     steps:
 
@@ -556,7 +530,7 @@ jobs:
 
       # Checkout latest commit
       - name: Checkout Medley
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
 
 
       # Upload a dummy file to release
@@ -587,7 +561,7 @@ jobs:
             local_template="installers/downloads_page/medley_downloads.html"
             local_filename="medley_downloads.html"
             local_manpath="docs/man-page/man_medley.html"
-            if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
+            if [ "${{ inputs.draft }}" = "true" ];
             then
                 remote_filename="draft_downloads"
                 remote_manname="man_draft.html"
@@ -637,19 +611,19 @@ jobs:
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}
 
-    needs: [inputs, sentry, loadup, downloads_page]
+    needs: [sentry, loadup, downloads_page]
 
     steps:
       # Delete the tarballs artifact
       - name: Delete tarballs artifact
-        uses: geekyeggo/delete-artifact@v2
+        uses: geekyeggo/delete-artifact@v5
         with:
           name: tarballs
           failOnError: false
 
       # Checkout the actions for this repo owner
       - name: Checkout Actions
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           repository: ${{ github.repository_owner }}/.github
           path: ./Actions_${{ github.sha }}

.github/workflows/buildReleaseInclDocker.yml

@@ -75,7 +75,7 @@ jobs:
     steps:
       - id: one
         run: >
-          if [ '${{ toJSON(inputs) }}' != 'null'  ];
+          if [ '${{ toJSON(inputs) }}' != '{}'  ];
           then
             echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
             echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;

BUILDING.md

@@ -1,34 +1,126 @@
-# How to build a medley release
+# How to Build Medley and make a 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
+The files in the Medley repository are used for making "loadups" lisp.sysout, full.sysout, apps.sysout. In order to build the Medley images, you need to have a build of "Maiko" (in flavors 'ldeinit' and 'lde' and either (`ldex` or `ldesdl`).  Head over to the `Interlisp/maiko` repository to find out about making those.
 
-# Using github actions
+# Using GitHub actions
 
-In the github medley repository (Interlisp/medley) go to the Actions tab. 
+Note that GitHub actions are used to automate the build process and insure that the system is built using known files, and that the releases are coordinated across platforms.  We try to minimize dependencies on GitHub.
 
-It will list the available github actions, select: **Build Medley Release**. 
+That said, you can manually trigger the automatic making of Medley loadups.
+
+In the GitHub medley repository (Interlisp/medley) go to the Actions tab.
+
+It will list the available GitHub actions.
+Select: **Build/Push Release & Docker**. 
+
+In the middle of the screen there is a box labeled "Workflow Runs".
 
-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.
+Build/Push Release & Docker first builds Maiko and Medley, pushes a Medley release to the Interlisp/medley repo Releases, then makes a Docker image.
 
+The files in .github/workflows/ contain the details.
+<!-- 
 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.
+-->
+
+# Building Medley for yourself
+
+The actual building itself is done with various shell scripts, found in the `scripts` directory in the medley repository. Most of the scripts have a minimal sanity check that they are being run from the medley repository.
+
+Historically, building the medley image (called a "sysout") was called "doing a loadup".  Back in the day, a loadup took the better part of a day, and no one would do the whole thing -- there was no automation.
+
+## Prerequisites
+
+In these instructions, there is an assumption that the loadup scripts can find other repositories. All of the loadup scripts have to find `lde` and `ldex` or `ldisdl` and also `ldeinit`.
+
+Loadups use the run-medley script, which looks for Maiko (actually the lde & ldeinit executables) as follows:
+
+1. lde (ldeinit) on PATH
+2. In the `<osversion>.<machinetype>` subdirectory of the directory specified by the $MAIKODIR environment variable
+3. In the `<osversion>.<machinetype>` subdirectory of the directory specified by $MEDLEYDIR/../maiko/
+4. In the `<osversion>.<machinetype>` subdirectory of the directory specified by $MEDLEYDIR/maiko/
+
+where $MEDLEYDIR is the directory from which you called the loadup script.
+
+## Make everything
+
+The shell command:
+```
+time ./scripts/loadup-all.sh -apps && time ./scripts/loadup-db.sh
+```
+does everything; on a fast machine it takes 4-6 minutes, most of which is spent in the `loadup-db.sh` step. Without the `loadup-db.sh` step, it runs in 22 seconds on a fast system.
+
+## How loadup-all.sh works
+
+You don't need to know this unless you want to change some of the low-level files involved.
+
+The script "loadup-all.sh" itself involes scripts used for different steps in the loadup -- basically loadup-all calls the scripts in this order:
+
+* `loadup-init.sh` 
+* `loadup-mid-from-init.sh`
+* `loadup-lisp-from-mid.sh` 
+* `loadup-full-from-lisp.sh`
+* `loadup-aux.sh`
+* `loadup-apps-from-full.sh`
+* `loadup-db.sh`
+* `copy-all.sh`
+
+Most of these scripts should only be run from the 'medley' repository top level directory.
+
+```
+ your-working-area
+    maiko
+    medley
+    notecards
+```
+
+These are explained in reverse order:
+
+### `copy-all.sh`: copy files from build directory to loadups
+
+Most of the scripts build things in a temporary directory and, if the entire process succeeds, copies the results to the `loadups` directory. The environment variable `LOADUP-OUTDIR`, if set, is used, otherwise a sub-directory of /tmp.
+
+`copy-db.sh` and `copy-full.sh` are provided if you've only done partial loadups.
+
+`cpv` is a script that copies a file from one place to another while maintaining Medley version numbering.
+
+### `loadup.db`: build `fuller.database`
+
+This step was added to make a Masterscope database of "everything". The result is a file `fuller.database`. This was an artifact of an attempt to build some diagnostic tools to help understand what was going on in Medley.  There is a 4 step process in the `GATHER-INFO` function in the file `MEDLEY-UTILS` in the `internal` subdirectory of the medley repository that ends with creating a masterscope database after loading all of the source files for every file that is part of the loadup, plus a few additional LispUsers files listed in variables that are part of `MEDLEY-UTILS`.
+
+There are some problems that `GATHER-INFO` results hint at, but haven't been explored systematically.
+
+Masterscope has some gaps and bugs so `fuller.database` isn't as useful as it could be. For example, Masterscope 'show paths' was written assuming you had only anlayzed the parts you were working on, and so the results of `SHOW PATHS` are too big to be useful.
+
+## `loadup-aux.sh`: rebuild two files used for Medley development
+
+`exports.all` is a collection of external declarations from a set of files in the medley/sources directory that are marked as being exported within those sources. Low level system declarations that aren't needed by most users. The files that need exports.all are generally loaded by loading `SYSEDIT`, which sets up a couple of preferences and then loads `exports.all`. 
+
+`whereis.hash` is an index file mapping function, variable, record declarations and other components to the file name containing that definition. It is the result of scanning the directories in the medley repository, including lispusers and library and internal etc. (but not obsolete?).
+
+### `loadup-apps-from-full.sh:`build `apps.sysout`
+
+`apps.sysout` includes some other components that are part of online.interlisp.org experience. In particular, you need `notecards`, which is in a separate repository (currently).
+
+### `loadup-full-from-lisp.sh`: Build a `full.sysout` and
+
+`full.sysout` Includes what we hope is a useful subset of Interlisp library and lispusers components as well as our modernization components.
+
+
+### Build a `lisp.sysout` in 4 scripts:
+
+### `loadup-lisp-from-mid.sh` build `lisp.sysout`
+
+`lisp.sysout` is what most 1990s customers started with. This step starts with `init-mid.sysout` and runs `sources/LOADUP-LISP`.
+
+### `loadup-mid-from-init.sh` build `mid.sysout`
+
+This step uses a Maiko that has been compiled with the `init` option. It reads the `init.dlinit` and initializes the package system and runs the EXPRESSIONS from the files that were "loaded" by MAKEINIT, and writes out `init-mid.sysout`.
+
+### `loadup-init.sh`: build `mid.sysout`
+
+This step (called `MAKEINIT`) runs a Lisp program (using a `starter` sysout) that reads in Lisp sources for the bootstrap loader, walks through the code renaming the low-level memory management functions to work on a file instead of in memory. These renamed functions are written to a file (called I-NEW), and I-NEW is then compiled and loaded in and run to 'virtually' load the core set of files in an initial memory image (called INIT.SYSOUT). It then does another (theoretically unnecessary) pass of reading in INIT.SYSOUT using a different renaming of variables used originally for remote debugging (called TELERAID) and moving some pages around to make room for Dandelion IO Processor boot code. 
+
+While this step requires an Interlisp implementation, it isn't necessarily a Medley implementation. If  you want to change the instruction set or modify any data structures that are reflected in both the Lisp code and Maiko, you can run this part in an older Interlisp. Theoretically.
+

clos/clos-env.lisp

@@ -1505,7 +1505,7 @@ window"
 (setf (sedit:get-format 'call-next-method)
       '(:indent (1) :args (:keyword nil)))
 
-(setf (sedit:get-format 'symbol-macrolet) 'let)
+(setf (sedit:get-format 'cl:symbol-macrolet) 'let)
 
 (setf (sedit:get-format 'with-accessors)
       '(:indent ((1) 1)

clos/pkg.lisp

@@ -1,16 +1,12 @@
 ;;;-*- Package: CLOS; Syntax: Common-Lisp; Base: 10 -*-
 
-
 ;;; File converted on 26-Mar-91 10:23:29 from source pkg
 ;;;. Original source {dsk}<usr>local>users>welch>lisp>clos>rev4>il-format>pkg.;4 created  1-Mar-91 10:10:26
 
 ;;;. Copyright (c) 1991 by Venue
 
-
 (in-package "CLOS")
 
-
-
 ;;; Some CommonLisps have more symbols in the Lisp package than the ones that are explicitly
 ;;; specified in CLtL.  This causes trouble. Any Lisp that has extra symbols in the Lisp package
 ;;; should shadow those symbols in the CLOS package. 
@@ -31,7 +27,7 @@
                no-applicable-method no-next-method print-object reinitialize-instance remove-method 
                shared-initialize slot-boundp slot-exists-p slot-makunbound slot-missing slot-unbound
                slot-value standard standard-class standard-generic-function standard-method 
-               standard-object structure-class symbol-macrolet update-instance-for-different-class 
+               standard-object structure-class  update-instance-for-different-class 
                update-instance-for-redefined-class with-accessors with-added-methods with-slots))
 
 (import '(xcl:false xcl:destructuring-bind xcl:true) *the-clos-package*)

docs/README.md

@@ -1,5 +1,5 @@
-See [Documentation links](https://github.com/Interlisp/medley/wiki/Documentation)
-a complete list of available documentation. Much of the documentation still
+See [Using Medley](https://interlisp.org/software/using-medley)
+for a list of available documentation. Much of the documentation still
 needs review and updating.
 
 This directory has source (.TEDIT) for some documents that are found elsewhere.

doctools/IMINDEX

@@ -1,21 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "12-Feb-92 12:28:48" {DSK}<users>sybalsky>PUBS>IMINDEX.;2
 37264  
 
-      changes to%:  (FNS IM.CHAP.DISPLAYFN)
+
(FILECREATED " 6-Mar-2024 21:19:25" {WMEDLEY}<doctools>IMINDEX.;2
 36416  
 
-      previous date%: " 8-Dec-91 15:46:22" {DSK}<users>sybalsky>PUBS>IMINDEX.;1)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (VARS IMINDEXCOMS)
+
+      :PREVIOUS-DATE "12-Feb-92 12:28:48" {WMEDLEY}<doctools>IMINDEX.;1)
 
-(* ; "
-Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT IMINDEXCOMS)
 
 (RPAQQ IMINDEXCOMS

        (
         (* ;; 
-
      "this file contains the functions used for creating and manipulating index image objects")

+
        "this file contains the functions used for creating and manipulating index image objects")

 
         (FNS IM.INDEX.CLOSEF IM.INDEX.COPYFN IM.INDEX.CREATEOBJ IM.INDEX.DISPLAY.STRING 
              IM.INDEX.DISPLAYFN IM.INDEX.EDIT IM.INDEX.LIST.FROM.STRING IM.INDEX.SIZEFN 
@@ -32,12 +31,7 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights res
         (COMS                                                (* ; "An image object to set the chapter number, on the TEXTOBJ's proplist, on the INDEXING-CHAPTER property.")

               (FNS IM.CHAP.COPYFN IM.CHAP.CREATEOBJ IM.CHAP.DISPLAYFN IM.CHAP.SIZEFN IM.CHAP.PUTFN 
                    IM.CHAP.GETFN IM.CHAP.BUTTONEVENTFN))
-        (P (ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
-                                                       (RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF
-                                                                                   )
-                                                                            STREAM))
-                                                       *))
-           (IM.INDEX.INIT))))
+        (P (IM.INDEX.INIT))))
 
 
 
@@ -494,9 +488,9 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights res
 (DECLARE%: EVAL@COMPILE
 
 (RECORD IM.INDEX.DATA
 (NAME TYPE SAV INFO SUBSEC PAGE# . PROPLIST)
-                          SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE?
 (AND (LISTP DATUM)
-                                                                           (IGEQ (LENGTH DATUM)
-                                                                                 6))))
+                      SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE?
 (AND (LISTP DATUM)
+                                                                   (IGEQ (LENGTH DATUM)
+                                                                         6))))
 )
 
 (RPAQQ IM.INDEX.OBJ.FREEMENU.SPECS

@@ -638,21 +632,15 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights res
     T])
 )
 
-(ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
-                                            (RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF)
-                                                                 STREAM))
-                                            *))
-
 (IM.INDEX.INIT
)
-(PUTPROPS IMINDEX COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1991 1992))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2160 15212 (IM.INDEX.CLOSEF 2170 . 2785) (IM.INDEX.COPYFN 2787 . 2972) (
-IM.INDEX.CREATEOBJ 2974 . 4320) (IM.INDEX.DISPLAY.STRING 4322 . 4743) (IM.INDEX.DISPLAYFN 4745 . 8588)
- (IM.INDEX.EDIT 8590 . 12058) (IM.INDEX.LIST.FROM.STRING 12060 . 13094) (IM.INDEX.SIZEFN 13096 . 13856
-) (IM.INDEX.STRING.FROM.LIST 13858 . 14103) (IM.INDEX.PUTFN 14105 . 14294) (IM.INDEX.GETFN 14296 . 
-14451) (IM.INDEX.BUTTONEVENTFN 14453 . 15210)) (15213 17283 (IM.INDEX.INIT 15223 . 17281)) (17284 
-29200 (IM.INDEX.MENU 17294 . 18982) (IM.INDEX.MENU.WHENSELECTEDFN 18984 . 25739) (
-IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25741 . 29198)) (31736 36879 (IM.CHAP.COPYFN 31746 . 31926) (
-IM.CHAP.CREATEOBJ 31928 . 33354) (IM.CHAP.DISPLAYFN 33356 . 35316) (IM.CHAP.SIZEFN 35318 . 36320) (
-IM.CHAP.PUTFN 36322 . 36506) (IM.CHAP.GETFN 36508 . 36669) (IM.CHAP.BUTTONEVENTFN 36671 . 36877)))))
+  (FILEMAP (NIL (1673 14725 (IM.INDEX.CLOSEF 1683 . 2298) (IM.INDEX.COPYFN 2300 . 2485) (
+IM.INDEX.CREATEOBJ 2487 . 3833) (IM.INDEX.DISPLAY.STRING 3835 . 4256) (IM.INDEX.DISPLAYFN 4258 . 8101)
+ (IM.INDEX.EDIT 8103 . 11571) (IM.INDEX.LIST.FROM.STRING 11573 . 12607) (IM.INDEX.SIZEFN 12609 . 13369
+) (IM.INDEX.STRING.FROM.LIST 13371 . 13616) (IM.INDEX.PUTFN 13618 . 13807) (IM.INDEX.GETFN 13809 . 
+13964) (IM.INDEX.BUTTONEVENTFN 13966 . 14723)) (14726 16796 (IM.INDEX.INIT 14736 . 16794)) (16797 
+28713 (IM.INDEX.MENU 16807 . 18495) (IM.INDEX.MENU.WHENSELECTEDFN 18497 . 25252) (
+IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25254 . 28711)) (31229 36372 (IM.CHAP.COPYFN 31239 . 31419) (
+IM.CHAP.CREATEOBJ 31421 . 32847) (IM.CHAP.DISPLAYFN 32849 . 34809) (IM.CHAP.SIZEFN 34811 . 35813) (
+IM.CHAP.PUTFN 35815 . 35999) (IM.CHAP.GETFN 36001 . 36162) (IM.CHAP.BUTTONEVENTFN 36164 . 36370)))))
 STOP

doctools/IMTEDIT

@@ -1,17 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Jul-2022 15:10:53" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>doctools>IMTEDIT.;2
 117347 
+
(FILECREATED " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4
 116622 
 
-      :CHANGES-TO (FNS MAKE.IM.DOCUMENT)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 8-Dec-91 15:41:54" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>doctools>IMTEDIT.;1)
+      :CHANGES-TO (FNS TRANSLATE.DUMPOUT MAKE.IM.DOCUMENT)
 
+      :PREVIOUS-DATE "20-Jul-2022 15:10:53" {WMEDLEY}<doctools>IMTEDIT.;2)
 
-(* ; "
-Copyright (c) 1983-1986, 1991 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT IMTEDITCOMS)
 
@@ -493,27 +489,26 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
     (DUMPOUT FONT LISP DUMP.CHARS SAV])
 
 (MAKE.IM.DOCUMENT

-  [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)

-                                                             (* ; "Edited 20-Jul-2022 15:10 by rmk")

+  [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
+
+    (* ;; "Edited  6-Mar-2024 21:17 by rmk: Fixed backquote commas. Also put IM.INDEX.CLOSEF calls in TEXTPROPs so advice in IMINDEX can be eliminated.")

+
+    (* ;; "Edited 20-Jul-2022 15:10 by rmk")

                                                              (* mjs " 4-Aug-86 10:52")

 
-         (* * this function creates an IM output file, in XPS-compatible format.
-
         If sets up all of the special variables needed by DUMP, evaluates FORM, and sets 
-
         all of the para and font looks)

+(* ;;; "this function creates an IM output file, in XPS-compatible format.  If sets up all of the special variables needed by DUMP, evaluates FORM, and sets all of the para and font looks")

 
-         (* * If OUTFILE.FLG is NIL, the output file is just sent to the default printer.
-
         If OUTFILE.FLG is T, the outfile textstream is simply returned.
-
         If OUTFILE.FLG = anything else, it is taken as a file name to put the press file 
-
         which is created <but not printed>.)

+(* ;;; "If OUTFILE.FLG is NIL, the output file is just sent to the default printer.  If OUTFILE.FLG is T, the outfile textstream is simply returned.  If OUTFILE.FLG = anything else, it is taken as a file name to put the press file which is created <but not printed>.")

 
-         (* * if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be used.)

+(* ;;; "if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be used.")

 
-         (* * if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output)

+(* ;;; "if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output")

 
-         (* * PTRFILENAME is the name to be used if an index pointer file is generated 
-
         during hardcopy <by printing index objects>)

+(* ;;; "PTRFILENAME is the name to be used if an index pointer file is generated during hardcopy <by printing index objects>")

 
-    (PROG ((IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'IM.INDEX.PTRFILENAME PTRFILENAME)))
+    (PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME 
+                                                               AFTERHARDCOPYFN (FUNCTION 
+                                                                                IM.INDEX.INIT]
            (FONT.STACK (CONS))
            (IM.TEDIT.LAST.PARA.BEGIN 1)
            (IM.TEDIT.LAST.FONT.BEGIN 1)
@@ -532,7 +527,7 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
           (DUMP.HEADERS.FOOTERS
 "  " "  ")
           (DUMPOUT CR CR START.PARA PARALOOKS
                  `(TYPE PAGEHEADING SUBTYPE DRAFTMESSAGE QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 
-                        RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                        RIGHTMARGIN ,IM.TEXT.RIGHTMARGIN)
                  DUMP.CHARS
                  (COND
                     (IM.DRAFT.FLG (CONCAT "***DRAFT***  " (DATE)
@@ -543,73 +538,65 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
           (COND
              (IM.EVEN.FLG 
 
-         (* if you must quarantee that you have an even number of pages for two-sided 
-
         copying, dump out a blank page no matter what --
-
         it can always be discarded)

+                    (* ;; "if you must quarantee that you have an even number of pages for two-sided copying, dump out a blank page no matter what -- it can always be discarded")

 
                     (DUMPOUT CR CR START.PARA PARALOOKS
-                           `(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN %, 
-                                   IM.TEXT.RIGHTMARGIN SPECIALX %, IM.BLANKPAGE.SPECIALX SPECIALY %,
-                                   IM.BLANKPAGE.SPECIALY)
+                           `(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN
+                                   ,IM.TEXT.RIGHTMARGIN SPECIALX ,IM.BLANKPAGE.SPECIALX SPECIALY
+                                   ,IM.BLANKPAGE.SPECIALY)
                            DUMP.CHARS "[This page intentionally left blank]" CR CR)))
 
-         (* after converting document, make sure that last para is formatted correctly by 
-
         changing font, ending current para, and starting new para)

+     (* ;; "after converting document, make sure that last para is formatted correctly by changing font, ending current para, and starting new para")

 
           (DUMPOUT CR CR FONT NIL)
           (DUMP
 '(START.PARA))
 
-         (* * set page format)

+(* ;;; "set page format")

 
           [TEDIT.PAGEFORMAT IM.OUTFILE
                  (COND
                     (PAGE.LAYOUT)
-                    (T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 
-                                                         IM.PAGE.LEFTMARGIN IM.PAGE.RIGHTMARGIN 
-                                                         IM.PAGE.FIRST.TOPMARGIN IM.PAGE.BOTTOMMARGIN
-                                                         1 NIL NIL
-                                                         `((RECTOFOOT %, IM.PAGE.LEFTMARGIN %, 
-                                                                  IM.FOOTER.Y)
-                                                           (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, 
-                                                                  IM.FOOTER.RULE.Y)
-                                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                    (T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT
+                                                   NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
+                                                   IM.PAGE.RIGHTMARGIN IM.PAGE.FIRST.TOPMARGIN 
+                                                   IM.PAGE.BOTTOMMARGIN 1 NIL NIL
+                                                   `((RECTOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
+                                                     (RECTOFOOTRULE ,IM.PAGE.LEFTMARGIN 
+                                                            ,IM.FOOTER.RULE.Y)
+                                                     (DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X 
+                                                            ,IM.DRAFT.MESSAGE.BOTTOM.Y]
                               [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
                                      IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
-                                     NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.TOP.Y)
-                                           (VERSOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
-                                           (VERSOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
-                                           (VERSOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
-                                           (VERSOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
-                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                                     NIL `((DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X ,IM.DRAFT.MESSAGE.TOP.Y)
+                                           (VERSOHEAD ,IM.PAGE.LEFTMARGIN ,IM.HEADER.Y)
+                                           (VERSOHEADRULE ,IM.PAGE.LEFTMARGIN ,IM.HEADER.RULE.Y)
+                                           (VERSOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
+                                           (VERSOFOOTRULE ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.RULE.Y)
+                                           (DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X 
+                                                  ,IM.DRAFT.MESSAGE.BOTTOM.Y]
                               (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
                                      IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
-                                     NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.TOP.Y)
-                                           (RECTOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
-                                           (RECTOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
-                                           (RECTOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
-                                           (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
-                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                                     NIL `((DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X ,IM.DRAFT.MESSAGE.TOP.Y)
+                                           (RECTOHEAD ,IM.PAGE.LEFTMARGIN ,IM.HEADER.Y)
+                                           (RECTOHEADRULE ,IM.PAGE.LEFTMARGIN ,IM.HEADER.RULE.Y)
+                                           (RECTOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
+                                           (RECTOFOOTRULE ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.RULE.Y)
+                                           (DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X 
+                                                  ,IM.DRAFT.MESSAGE.BOTTOM.Y]
 
-         (* * dump default char and para looks for whole document --
-
         and looks that should be different should be specified in the fns)

+(* ;;; "dump default char and para looks for whole document -- and looks that should be different should be specified in the fns")

 
           (TEDIT.LOOKS IM.OUTFILE IM.TEXT.FONT 1 (GETFILEINFO IM.OUTFILE 'LENGTH))
-          (TEDIT.PARALOOKS IM.OUTFILE
-                 [COND
-                    (DEFAULT.PARALOOKS)
-                    (T `(QUAD JUSTIFIED 1STLEFTMARGIN %, IM.TEXT.LEFTMARGIN LEFTMARGIN %, 
-                              IM.TEXT.LEFTMARGIN RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN LINELEADING 0 
-                              PARALEADING 5 POSTPARALEADING 0]
+          (TEDIT.PARALOOKS IM.OUTFILE [COND
+                                         (DEFAULT.PARALOOKS)
+                                         (T `(QUAD JUSTIFIED 1STLEFTMARGIN ,IM.TEXT.LEFTMARGIN 
+                                                   LEFTMARGIN ,IM.TEXT.LEFTMARGIN RIGHTMARGIN
+                                                   ,IM.TEXT.RIGHTMARGIN LINELEADING 0 PARALEADING 5 
+                                                   POSTPARALEADING 0]
                  1
                  (GETFILEINFO IM.OUTFILE 'LENGTH))
 
-         (* must reverse list because the order of some char and paragraph looks is 
-
         significant << earlier looks are overridden by later ones >>)

+     (* ;; "must reverse list because the order of some char and paragraph looks is significant << earlier looks are overridden by later ones >>")

 
           (SETQ IM.CHARLOOKS (DREVERSE IM.CHARLOOKS))
           (SETQ IM.PARALOOKS (DREVERSE IM.PARALOOKS))
@@ -2309,83 +2296,75 @@ page edge.)

 (DEFINEQ
 
 (TRANSLATE.DUMPOUT

-  [LAMBDA (DUMPOUT.ARGS)
                                 (* mjs "18-Sep-85 16:17")

+  [LAMBDA (DUMPOUT.ARGS)                                     (* mjs "18-Sep-85 16:17")

 
-         (* * this function translates the DUMPOUT macro form into a PROGN form that 
-
       calls a series of functions, such as DUMP.)

+         (* * this function translates the DUMPOUT macro form into a PROGN form that calls 
+
         a series of functions, such as DUMP.)

 
          (* * the indentation code has been commented out ---
-
       will try indenting everything to same, unless specified otherwise with 
-
       PARALOOKS)

+
         will try indenting everything to same, unless specified otherwise with PARALOOKS)

 
     (PROG ((DUMPOUT.FORMS NIL)
            (DUMPOUT.UNDO NIL)
            COMM COMM.ARG)
           [while
 DUMPOUT.ARGS do
 (SELECTQ (SETQ COMM (pop
 DUMPOUT.ARGS))
-                                             (NIL)
-                                             ((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB
-                                                  END.SUPER END.SUB) 
-                                                             (* just pass these atoms as commands 
-
                                                           to DUMP)

-                                                  (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT
-                                                                                (KWOTE COMM))))
-                                             ((FLUSH.ARG TRIVIAL.ARG DUMP.ARG) 
-                                                  (push
 DUMPOUT.FORMS (LIST COMM)))
-                                             (INDENT 
+                                     (NIL)
+                                     ((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB 
+                                          END.SUPER END.SUB) (* just pass these atoms as commands 
+
                                                             to DUMP)

+                                          (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE COMM))))
+                                     ((FLUSH.ARG TRIVIAL.ARG DUMP.ARG) 
+                                          (push
 DUMPOUT.FORMS (LIST COMM)))
+                                     (INDENT 
 
          (* * SELECTQ (SETQ COMM.ARG (pop DUMPOUT.ARGS))
-
       (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-
       (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
-
       (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
-
       (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
-
       (QUOTE INDENT) INITIAL.INDENT)))) (NONE
-
       (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-
       (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
-
       (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
-
       (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
-
       (QUOTE INDENT) (QUOTE NONE))))) (push DUMPOUT.FORMS
-
       (LIST (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
-
       (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
-
       (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
-
       (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))

+
         (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+
         (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
+
         (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
+
         (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT (QUOTE INDENT) INITIAL.INDENT))))
+
         (NONE (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+
         (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
+
         (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
+
         (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT (QUOTE INDENT)
+
         (QUOTE NONE))))) (push DUMPOUT.FORMS (LIST
+
         (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
+
         (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
+
         (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
+
         (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))

 
          (* * push DUMPOUT.UNDO (QUOTE INDENT))

 
-                                                     (SETQ COMM.ARG (pop
 DUMPOUT.ARGS)))
-                                             (WIDTH (push
 DUMPOUT.FORMS
-                                                           (LIST 'PUT.MY.PROP (KWOTE 'WIDTH)
-                                                                 (pop
 DUMPOUT.ARGS))))
-                                             (FONT (SETQ COMM.ARG (pop
 DUMPOUT.ARGS))
-                                                   [push
 DUMPOUT.FORMS
-                                                          (LIST 'DUMP.FORMAT (KWOTE 'FONT)
-                                                                (COND
-                                                                   ((LISTGET IM.TEDIT.FONT.DEFS 
-                                                                           COMM.ARG)
-                                                                    (KWOTE COMM.ARG))
-                                                                   (T COMM.ARG]
-                                                   (push
 DUMPOUT.UNDO 'FONT))
-                                             (PARALOOKS (push
 DUMPOUT.FORMS
-                                                               (LIST 'DUMP.FORMAT (KWOTE 'PARALOOKS)
-                                                                     (pop
 DUMPOUT.ARGS))))
-                                             (DUMP.CHARS (push
 DUMPOUT.FORMS
-                                                                (LIST (FUNCTION IM.DUMP.CHARS)
+                                             (SETQ COMM.ARG (pop
 DUMPOUT.ARGS)))
+                                     (WIDTH (push
 DUMPOUT.FORMS (LIST 'PUT.MY.PROP
+                                                                      (KWOTE 'WIDTH)
                                                                       (pop
 DUMPOUT.ARGS))))
-                                             (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT
-                                                                           (KWOTE 'TEXT)
-                                                                           (LIST 'MAKE.SAVE COMM]
-          [for
 X in
 DUMPOUT.UNDO do
 (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT
-                                                                              (KWOTE 'UNDO)
-                                                                              (KWOTE X]
+                                     (FONT (SETQ COMM.ARG (pop
 DUMPOUT.ARGS))
+                                           [push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'FONT)
+                                                                     (COND
+                                                                        ((LISTGET IM.TEDIT.FONT.DEFS
+                                                                                COMM.ARG)
+                                                                         (KWOTE COMM.ARG))
+                                                                        (T COMM.ARG]
+                                           (push
 DUMPOUT.UNDO 'FONT))
+                                     (PARALOOKS (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT
+                                                                          (KWOTE 'PARALOOKS)
+                                                                          (pop
 DUMPOUT.ARGS))))
+                                     (DUMP.CHARS (push
 DUMPOUT.FORMS (LIST (FUNCTION IM.DUMP.CHARS)
+                                                                           (pop
 DUMPOUT.ARGS))))
+                                     (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'TEXT)
+                                                               (LIST 'MAKE.SAVE COMM]
+          [for
 X in
 DUMPOUT.UNDO do
 (push
 DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'UNDO)
+                                                              (KWOTE X]
 
          (* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-
       (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))

+
         (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))

 
          (* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-
       (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))

+
         (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))

 
          (* * RETURN (APPEND (QUOTE (PROG ((DUMPOUT.SAVE.INDENT
-
       (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
-
       (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))

+
         (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
+
         (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))

 
           (RETURN (CONS 'PROGN (DREVERSE DUMPOUT.FORMS])
 
@@ -2408,25 +2387,24 @@ page edge.)

 
 (PUTPROPS SAVE.DUMPOUT
 MACRO
 (X (TRANSLATE.SAVE.DUMPOUT
 X)))
 )
-(PUTPROPS IMTEDIT COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10773 38278 (IM.TEDIT 10783 . 12464) (DUMP 12466 . 14761) (DUMP.HEADERS.FOOTERS 14763
- . 17129) (DUMP.HRULE 17131 . 18282) (CHANGE.FONT 18284 . 19478) (IM.BOUT.IMAGEOBJ 19480 . 19803) (
-IM.TEDIT.DUMP.COMMANDS 19805 . 23358) (IM.TEDIT.DUMP.FOOTNOTES 23360 . 23801) (IM.TEDIT.DUMP.PARA 
-23803 . 24577) (INDEXX.PARSE.TYPE 24579 . 25874) (FORMAT.DEF 25876 . 28007) (FORMAT.LISPWORD 28009 . 
-28160) (MAKE.IM.DOCUMENT 28162 . 37133) (PRINT.NOTE 37135 . 37349) (SEND.INFO 37351 . 38276)) (38387 
-42405 (IM.VRULE.DISPLAYFN 38397 . 38721) (CREATE.VRULE.OBJECT 38723 . 40503) (PRINT.VRULES.ON.PAGE 
-40505 . 42403)) (42563 47318 (IM.FOLIO.DISPLAYFN 42573 . 43251) (IM.FOLIO.SIZEFN 43253 . 44102) (
-CREATE.FOLIO.OBJECT 44104 . 45650) (GET.FOLIO.STRING 45652 . 47316)) (47450 93690 (ARG#TOPROG 47460 . 
-47599) (BIGLISPCODE#TOPROG 47601 . 48837) (BRACKET#TOPROG 48839 . 49003) (CHAPTER#TOPROG 49005 . 51686
-) (COMMENT#TOPROG 51688 . 52240) (DEF#TOPROG 52242 . 55577) (FIGURE#TOPROG 55579 . 56923) (FN#TOPROG 
-56925 . 57322) (FNDEF#TOPROG 57324 . 61216) (FOOT#TOPROG 61218 . 61759) (INCLUDE#TOPROG 61761 . 62076)
- (INDEX#TOPROG 62078 . 63168) (INDEXX#TOPROG 63170 . 65251) (IT#TOPROG 65253 . 65394) (LBRACKET#TOPROG
- 65396 . 65550) (LISP#TOPROG 65552 . 65693) (LISPCODE#TOPROG 65695 . 66814) (LISPWORD#TOPROG 66816 . 
-67556) (LIST#TOPROG 67558 . 71980) (MACDEF#TOPROG 71982 . 73160) (NOTE#TOPROG 73162 . 73842) (
-PRINT.SPECIAL.CHARS#TOPROG 73844 . 74821) (PROPDEF#TOPROG 74823 . 75100) (RBRACKET#TOPROG 75102 . 
-75256) (REF#TOPROG 75258 . 83097) (RM#TOPROG 83099 . 83237) (SUB#TOPROG 83239 . 83387) (SUBSEC#TOPROG 
-83389 . 87892) (SUPER#TOPROG 87894 . 88048) (TABLE#TOPROG 88050 . 92002) (TAG#TOPROG 92004 . 92271) (
-TERM#TOPROG 92273 . 92586) (VAR#TOPROG 92588 . 92991) (VARDEF#TOPROG 92993 . 93688)) (111336 116764 (
-TRANSLATE.DUMPOUT 111346 . 116363) (TRANSLATE.SAVE.DUMPOUT 116365 . 116762)))))
+  (FILEMAP (NIL (10668 38115 (IM.TEDIT 10678 . 12359) (DUMP 12361 . 14656) (DUMP.HEADERS.FOOTERS 14658
+ . 17024) (DUMP.HRULE 17026 . 18177) (CHANGE.FONT 18179 . 19373) (IM.BOUT.IMAGEOBJ 19375 . 19698) (
+IM.TEDIT.DUMP.COMMANDS 19700 . 23253) (IM.TEDIT.DUMP.FOOTNOTES 23255 . 23696) (IM.TEDIT.DUMP.PARA 
+23698 . 24472) (INDEXX.PARSE.TYPE 24474 . 25769) (FORMAT.DEF 25771 . 27902) (FORMAT.LISPWORD 27904 . 
+28055) (MAKE.IM.DOCUMENT 28057 . 36970) (PRINT.NOTE 36972 . 37186) (SEND.INFO 37188 . 38113)) (38224 
+42242 (IM.VRULE.DISPLAYFN 38234 . 38558) (CREATE.VRULE.OBJECT 38560 . 40340) (PRINT.VRULES.ON.PAGE 
+40342 . 42240)) (42400 47155 (IM.FOLIO.DISPLAYFN 42410 . 43088) (IM.FOLIO.SIZEFN 43090 . 43939) (
+CREATE.FOLIO.OBJECT 43941 . 45487) (GET.FOLIO.STRING 45489 . 47153)) (47287 93527 (ARG#TOPROG 47297 . 
+47436) (BIGLISPCODE#TOPROG 47438 . 48674) (BRACKET#TOPROG 48676 . 48840) (CHAPTER#TOPROG 48842 . 51523
+) (COMMENT#TOPROG 51525 . 52077) (DEF#TOPROG 52079 . 55414) (FIGURE#TOPROG 55416 . 56760) (FN#TOPROG 
+56762 . 57159) (FNDEF#TOPROG 57161 . 61053) (FOOT#TOPROG 61055 . 61596) (INCLUDE#TOPROG 61598 . 61913)
+ (INDEX#TOPROG 61915 . 63005) (INDEXX#TOPROG 63007 . 65088) (IT#TOPROG 65090 . 65231) (LBRACKET#TOPROG
+ 65233 . 65387) (LISP#TOPROG 65389 . 65530) (LISPCODE#TOPROG 65532 . 66651) (LISPWORD#TOPROG 66653 . 
+67393) (LIST#TOPROG 67395 . 71817) (MACDEF#TOPROG 71819 . 72997) (NOTE#TOPROG 72999 . 73679) (
+PRINT.SPECIAL.CHARS#TOPROG 73681 . 74658) (PROPDEF#TOPROG 74660 . 74937) (RBRACKET#TOPROG 74939 . 
+75093) (REF#TOPROG 75095 . 82934) (RM#TOPROG 82936 . 83074) (SUB#TOPROG 83076 . 83224) (SUBSEC#TOPROG 
+83226 . 87729) (SUPER#TOPROG 87731 . 87885) (TABLE#TOPROG 87887 . 91839) (TAG#TOPROG 91841 . 92108) (
+TERM#TOPROG 92110 . 92423) (VAR#TOPROG 92425 . 92828) (VARDEF#TOPROG 92830 . 93525)) (111173 116115 (
+TRANSLATE.DUMPOUT 111183 . 115714) (TRANSLATE.SAVE.DUMPOUT 115716 . 116113)))))
 STOP

greetfiles/APPS-INIT

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Jun-2023 17:20:09" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;11
 21130  
+
(FILECREATED "25-Feb-2024 13:56:23" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;17
 23321  
 
-      :CHANGES-TO (FNS Apps.DoInit)
+      :CHANGES-TO (VARS APPS-INITCOMS)
+                  (FNS Apps.DoInit Apps.AroundExitFn)
 
-      :PREVIOUS-DATE "19-Jan-2023 12:44:20" 
-{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;10)
+      :PREVIOUS-DATE "25-Feb-2024 13:14:02" 
+{DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;16)
 
 
 (PRETTYCOMPRINT APPS-INITCOMS)
@@ -16,8 +17,9 @@
         (GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
         (INITVARS (Apps.NotecardsActivated NIL)
                (Apps.RoomsActivated NIL))
-        (FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS 
-             Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP)
+        (FNS Apps.InitNotecards Apps.SetUpNOTECARDSDIRECTORIES Apps.DoInit Apps.CreateButtons 
+             Apps.CreateLabel Apps.ActivateCLOS Apps.ActivateRooms Apps.ShowDoc 
+             XCL-USER::EXEC_INTERLISP Apps.AroundExitFn)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
         (DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
 
@@ -90,6 +92,33 @@
           (if
 (NOT DoNotRefreshButtons)
               then
 (Apps.CreateButtons
])
 
+(Apps.SetUpNOTECARDSDIRECTORIES

+  [LAMBDA NIL
+
+    (* ;; "Find the location of the Notecards directory and call NC.SetUpNOTECARDSDIRECTORIES.")

+
+    (* ;; " This is needed to make sure that lazy loading of Notecard types works.")

+
+    (LET* [(LOC1 (CONCAT MEDLEYDIR "notecards>"))
+           (LOC2 (CONCAT MEDLEYDIR "..>notecards>"))
+           (LOC3 (CONCAT MEDLEYDIR "..>..>notecards>"))
+           (NCDIR (for
 LOC in
 (LIST LOC1 LOC2 LOC3) thereis
 (OR (INFILEP (CONCAT LOC 
+                                                                                "system>NOTECARDS"))
+                                                                (INFILEP (CONCAT LOC 
+                                                                              "system>NOTECARDS.LCOM"
+                                                                                ]
+          (if
 NCDIR
+              then
 [SETQ NCDIR (OR (INFILEP (CONCAT NCDIR "system>NOTECARDS"))
+                                   (INFILEP (CONCAT NCDIR "system>NOTECARDS.LCOM"]
+                   (SETQ NCDIR (SUBSTRING NCDIR 1 (IDIFFERENCE (STRPOS "system>NOTECARDS" NCDIR)
+                                                         1)))
+                   (NC.SetUpNOTECARDSDIRECTORIES NCDIR)
+                   T
+            else
 (PRIN1 "Warning: Notecards directory could not be found." T)
+                 (PRIN1 "Hence, NOTECARDSDIRECTORIES is probably not set correctly" T)
+                 (PRIN1 "and Notecards will not work properly." T)
+                 NIL])
+
 (Apps.DoInit

   [LAMBDA NIL
 
@@ -173,7 +202,16 @@
 
            (* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet")

 
-           (SETTOPVAL '\NC.SourceAccessFlg NIL])
+           (SETTOPVAL '\NC.SourceAccessFlg NIL)
+
+           (* ;; "Setup NOTECARDSDIRECTORIES.")

+
+           (Apps.SetUpNOTECARDSDIRECTORIES
)
+
+           (* ;; "Add AROUNDEXITFN to ensure NOTECARDSDIRECTORIES get reset after LOGOUT, etc.")

+
+           (SETQ AROUNDEXITFNS (LSUBST '(MEDLEY-INIT-VARS Apps.AroundExitFn)
+                                      'MEDLEY-INIT-VARS AROUNDEXITFNS])
 
 (Apps.CreateButtons

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


@@ -366,6 +404,11 @@
                                                         YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
            (XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
            (XCL:SET-EXEC-TYPE 'INTERLISP])
+
+(Apps.AroundExitFn

+  [LAMBDA (EVENT)
+    (if
 (MEMB EVENT '(AFTERLOGOUT AFTERSYSOUT AFTERSAVEVM))
+        then
 (Apps.SetUpNOTECARDSDIRECTORIES
])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
@@ -376,8 +419,8 @@
 (BKSYSBUF " ")
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) (
-Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) (
-Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994
-)))))
+  (FILEMAP (NIL (1229 23187 (Apps.InitNotecards 1239 . 5101) (Apps.SetUpNOTECARDSDIRECTORIES 5103 . 6658
+) (Apps.DoInit 6660 . 10257) (Apps.CreateButtons 10259 . 19083) (Apps.CreateLabel 19085 . 19895) (
+Apps.ActivateCLOS 19897 . 21246) (Apps.ActivateRooms 21248 . 22099) (Apps.ShowDoc 22101 . 22250) (
+XCL-USER::EXEC_INTERLISP 22252 . 23024) (Apps.AroundExitFn 23026 . 23185)))))
 STOP

internal/loadups/LOADUP-LISP

@@ -1,11 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "31-Jul-2023 18:22:53" |{DSK}<home>frank>il>medley>gmedley>sources>LOADUP-LISP.;2|
 5235   
+
(FILECREATED "21-Mar-2024 10:56:13" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;4|
 5586   
+
+      :EDIT-BY "lmm"
 
       :CHANGES-TO (FNS LOADUP-LISP)
 
-      :PREVIOUS-DATE "27-Feb-2023 17:15:53" 
-|{DSK}<home>frank>il>medley>gmedley>sources>LOADUP-LISP.;1|)
+      :PREVIOUS-DATE "14-Mar-2024 12:16:33" 
+|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;3|)
 
 
 (PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -18,7 +20,9 @@
 (DEFINEQ
 
 (LOADUP-LISP

-  (LAMBDA (DRIBBLEFILE)
                                     (* \; "Edited 26-Feb-2023 12:17 by lmm")


+  (LAMBDA (DRIBBLEFILE)
                                     (* \; "Edited 21-Mar-2024 10:55 by lmm")


+                                                            (* \; "Edited 14-Mar-2024 12:16 by lmm")


+                                                            (* \; "Edited 26-Feb-2023 12:17 by lmm")


                                                             (* \; "Edited 13-Jul-2022 14:09 by rmk")


                                                           (* \; "Edited  4-Mar-2022 19:13 by larry")


                                                            (* \; "Edited 29-Apr-2021 22:30 by rmk:")

@@ -107,6 +111,10 @@
 
     (PACKAGE-ENABLE)
 
+    (* |;;| " Added late, LOAD late to avoid any dependencies")

+
+    (LOADUP '(XCL-LOOP XCL-HASH-LOOP))
+
     (* |;;| " networking code -- should make it optional but too many cross dependencies")

 
     (LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP 
@@ -123,5 +131,5 @@
 (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (649 5029 (LOADUP-LISP 659 . 5027)))))
+  (FILEMAP (NIL (673 5380 (LOADUP-LISP 683 . 5378)))))
 STOP

library/CLIPBOARD

@@ -1,21 +1,21 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Jul-2022 23:53:01" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;7
 9243   
+
(FILECREATED "31-Mar-2024 06:51:14" {DSK}<home>larry>il>medley>library>CLIPBOARD.;2
 8932   
 
-      :CHANGES-TO (VARS CLIPBOARDCOMS)
-                  (FNS CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE " 3-Jul-2021 13:16:26" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;6)
+      :CHANGES-TO (FNS INSTALL-CLIPBOARD)
+                  (VARS CLIPBOARDCOMS)
+
+      :PREVIOUS-DATE "19-Oct-2023 00:20:01" {DSK}<home>larry>il>medley>library>CLIPBOARD.;1)
 
 
 (PRETTYCOMPRINT CLIPBOARDCOMS)
 
 (RPAQQ CLIPBOARDCOMS

        [                                                     (* ; "Enable copy and paste")

-        (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE 
-             CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
+        (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD CLIPBOARD-COPY-STREAM 
+             CLIPBOARD-PASTE-STREAM)
         (FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD)
         (FNS SEDIT.COPYTOCLIPBOARD)
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
@@ -32,19 +32,22 @@
 (DEFINEQ
 
 (INSTALL-CLIPBOARD

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


-                                                            (* ; "Edited 19-Apr-2020 12:15 by rmk:")


-                                                            (* ; "Edited 18-Apr-2018 23:00 by rmk:")

-    (CL:WHEN (GETD 'LISPINTERRUPTS.PASTE)
-        (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG)
-        (MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS))
+  [LAMBDA NIL
                                                (* ; "Edited 30-Mar-2024 22:22 by lmm")


+                                                            (* ; "Edited 24-Jun-2021 21:14 by rmk:")


+                                                            (* ; "Edited 19-Apr-2020 12:15 by rmk:")


+                                                            (* ; "Edited 18-Apr-2018 23:00 by rmk:")

     (INTERRUPTCHAR (CHARCODE "Meta,v")
            '(PASTEFROMCLIPBOARD
))
     (INTERRUPTCHAR (CHARCODE "Meta,V")
            '(PASTEFROMCLIPBOARD
))
-    (CL:WHEN (BOUNDP 'TEDIT.READTABLE)                       (* ; "TEDIT")

+    (/PUTASSOC 'PASTE [LIST (LIST (CHARCODE "1,v")
+                                  '(PASTEFROMCLIPBOARD
))
+                            (LIST (CHARCODE "1,V")
+                                  '(PASTEFROMCLIPBOARD
]
+           LISPINTERRUPTS)
+    (CL:WHEN (BOUNDP 'TEDIT.READTABLE)                       (* ; "TEDIT")

 
-        (* ;; "Paste")

+        (* ;; "Paste")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,v")
                (FUNCTION PASTEFROMCLIPBOARD)
@@ -53,7 +56,7 @@
                (FUNCTION PASTEFROMCLIPBOARD)
                TEDIT.READTABLE)
 
-        (* ;; "Copy")

+        (* ;; "Copy")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,c")
                (FUNCTION TEDIT.COPYTOCLIPBOARD)
@@ -62,7 +65,7 @@
                (FUNCTION TEDIT.COPYTOCLIPBOARD)
                TEDIT.READTABLE)
 
-        (* ;; "Extract")

+        (* ;; "Extract")

 
         (TEDIT.SETFUNCTION (CHARCODE "Meta,X")
                (FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
@@ -70,8 +73,8 @@
         (TEDIT.SETFUNCTION (CHARCODE "Meta,x")
                (FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
                TEDIT.READTABLE))
-    (CL:WHEN (GETP 'SEDIT 'FILEDATES)                        (* ; 
-
                                                           "SEDIT copy: INTERRUPTCHAR does paste")

+    (CL:WHEN (GETP 'SEDIT 'FILEDATES)                        (* ; 
+
                                                             "SEDIT copy: INTERRUPTCHAR does paste")

         (SEDIT:ADD-COMMAND "Meta,c" 'SEDIT.COPYTOCLIPBOARD "M-c" "Copy to clipboard")
         (SEDIT:ADD-COMMAND "Meta,C" 'SEDIT.COPYTOCLIPBOARD)
         (SEDIT:RESET-COMMANDS))])
@@ -105,17 +108,6 @@
              THEN
 (COPYINSERT STR)
            ELSE
 (BIND
 C WHILE
 (SETQ C (GNCCODE STR)) DO
 (BKSYSCHARCODE C])
 
-(LISPINTERRUPTS.PASTE

-  [LAMBDA NIL
                                           (* ; "Edited 18-Apr-2018 22:59 by rmk:")

-
-    (* ;; "So paste interrupts will be installed in every process")

-
-    (APPEND [LIST (LIST (CHARCODE "1,v")
-                        '(PASTEFROMCLIPBOARD
))
-                  (LIST (CHARCODE "1,V")
-                        '(PASTEFROMCLIPBOARD
]
-           (LISPINTERRUPTS.ORIG])
-
 (CLIPBOARD-COPY-STREAM

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


                                                             (* ; "Edited 23-Feb-2021 22:11 by rmk:")

@@ -146,12 +138,12 @@
              THEN
 (PUTCLIPBOARD
 (TEDIT.SEL.AS.STRING TEXTSTREAM])
 
 (TEDIT.EXTRACTTOCLIPBOARD

-  [LAMBDA NIL
                                           (* ; "Edited 19-Apr-2020 12:17 by rmk:")


-                                                            (* ; "Edited 18-Apr-2018 00:02 by rmk:")

-    (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
-         (IF
 TEXTSTREAM
-             THEN
 (PUTCLIPBOARD
 (TEDIT.SEL.AS.STRING TEXTSTREAM))
-                   (TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM])
+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 19-Oct-2023 00:19 by rmk")


+                                                            (* ; "Edited 19-Apr-2020 12:17 by rmk:")


+                                                            (* ; "Edited 18-Apr-2018 00:02 by rmk:")

+    (CL:WHEN TSTREAM
+        (PUTCLIPBOARD
 (TEDIT.SEL.AS.STRING TSTREAM))
+        (TEDIT.DELETE TSTREAM SEL))])
 )
 (DEFINEQ
 
@@ -197,10 +189,9 @@
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS CLIPBOARD COPYRIGHT (NONE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1317 6626 (INSTALL-CLIPBOARD 1327 . 3259) (GETCLIPBOARD 3261 . 3635) (PUTCLIPBOARD 3637
- . 4042) (PASTEFROMCLIPBOARD 4044 . 4962) (LISPINTERRUPTS.PASTE 4964 . 5385) (CLIPBOARD-COPY-STREAM 
-5387 . 5902) (CLIPBOARD-PASTE-STREAM 5904 . 6624)) (6627 7386 (TEDIT.COPYTOCLIPBOARD 6637 . 6918) (
-TEDIT.EXTRACTTOCLIPBOARD 6920 . 7384)) (7387 8926 (SEDIT.COPYTOCLIPBOARD 7397 . 8924)))))
+  (FILEMAP (NIL (1243 6345 (INSTALL-CLIPBOARD 1253 . 3401) (GETCLIPBOARD 3403 . 3777) (PUTCLIPBOARD 3779
+ . 4184) (PASTEFROMCLIPBOARD 4186 . 5104) (CLIPBOARD-COPY-STREAM 5106 . 5621) (CLIPBOARD-PASTE-STREAM 
+5623 . 6343)) (6346 7113 (TEDIT.COPYTOCLIPBOARD 6356 . 6637) (TEDIT.EXTRACTTOCLIPBOARD 6639 . 7111)) (
+7114 8653 (SEDIT.COPYTOCLIPBOARD 7124 . 8651)))))
 STOP

library/CLIPBOARD.TXT

@@ -1,17 +0,0 @@
-library/CLIPBOARD
-
-Written by Ron Kaplan, 2020-2021
-
-A small package that implements copy and paste to the system clipboard.
-
-It arms meta-C for copy to the clipboard from the current selection of an application that has been armed (Tedit, Sedit), and also meta-X for extraction (copy followed by delete).
-
-Meta-V is defined as an interrupt character that pastes the current clipboard contents into whatever process curent has input focus.
-
-The information in the clipboard can be provided from or provided to external (non-Medley) applications (mail, emacs, etc.) in the usual way.  For example, a form cselected in SEDIT can be copied to the clipboard and pasted into an email message.
-
-It assumes that the external format of the clipboard is determined by (SYSTEM-EXTERNALFORMAT, and characters will be converted to and from the Medley internal character encoding.
-
-The name of the clipboard stream may differ from platform to platform.  On the Mac, the paste stream is "pbpaste" and the copy stream is "pbcopy".  Those names are used if "darwin" is a substring of (UNIX-GETENV "ostype").  Otherwise both stream-names default to "xclip".  The functions CLIPBOARD-COPY-STREAM and CLIPBOARD-PASTE-STREAM perform this selection.
-
-

library/DATABASEFNS

@@ -1,14 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Oct-2021 10:55:18" {DSK}<home>larry>medley>library>DATABASEFNS.;7
 16051  
+
(FILECREATED "20-Feb-2024 23:45:56" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4
 18445  
 
-      changes to%:  (FNS DUMPDB)
+      :EDIT-BY "mth"
 
-      previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
+      :CHANGES-TO (FNS DUMPDB)
+
+      :PREVIOUS-DATE "19-Feb-2024 16:29:44" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;1)
 
 
 (* ; "
-Copyright (c) 1986, 1990-1993 by Xerox Corporation.
+Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
 ")
 
 (PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -31,7 +33,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
         (INITVARS (LOADDBFLG 'ASK)
                (SAVEDBFLG 'ASK))
         (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
-        (INITVARS (MSFILETABLE))
+        (INITVARS (MSFILETABLE)
+               (DEFAULTDATABASECOPYRIGHTOWNER 'NEVER))
                                                              (* ; "To permit MSHASH interface")

         (LOCALVARS . T)
         (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
@@ -161,52 +164,85 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 (DEFINEQ
 
 (DUMPDB

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

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

+  [LAMBDA (FILE PROPFLG)
                                     (* ; "Edited 20-Feb-2024 23:45 by mth")


+                                                             (* ; "Edited  7-Feb-2024 18:26 by mth")


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

 
-    (* ;; 
-
  "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 MSFILETABLE SAVEDBFLG))
+    (DECLARE
 (GLOBALVARS MSFILETABLE SAVEDBFLG COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER)
+           (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER))
     (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)))
+        (LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
+              (SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
+             (CL:UNWIND-PROTECT
+                 (PROG (DBFILE
 DBFN DBROOTFN FLCPR (FL (NAMEFIELD FILE))
+                              (FNS (FILEFNSLST FILE)))
+                       (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
+                       (SETQ DBROOTFN (ROOTFILENAME DBFN))
+                       (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
+                                      (NULL DEFAULTDATABASECOPYRIGHTOWNER)
+                                      (GETPROP DBROOTFN 'COPYRIGHT))
+                           (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
+                               ((NONE NEVER) 
+                                             (* ;; 
+
                                          "Set the COPYRIGHT to NONE (I.e., never mention it again.)")

+
+                                    (/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE)))
+                               (SAME 
+                                     (* ;; 
+
                         "Same as the source file. If it doesn't have one, then just normal handling")

+
+                                     (CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
+                                         (/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
+                               (DEFAULT 
+                                        (* ;; "Use the general default for copyright")

+
+                                        (SETQ COPYRIGHTFLG 'DEFAULT))
+                               (PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
+
+                                      (* ;; 
+
                        "Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys")

+
+                                      (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
+                       (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))))])
+
                                                             "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 DBFN
+                                   `((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 database on a user call")

+                           (RETURN DBFILE))))
+             (SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG)
+             (SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))])
 
 (LOADDB

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


@@ -321,6 +357,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RPAQ? MSFILETABLE
 )
 
+(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER
 'NEVER)
+
 
 
 (* ; "To permit MSHASH interface")

@@ -337,9 +375,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
 
 (RESETSAVE DWIMIFYCOMPFLG T)
 )
-(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
+(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024))
 (DECLARE%: DONTCOPY
-  (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)))))
+  (FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161
+ . 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB 
+11875 . 16750) (MAKEDB 16752 . 17836)))))
 STOP

library/SPY

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;4
 64149  
+
(FILECREATED "27-Feb-2024 20:25:02" {DSK}<home>larry>il>medley>SPY.;1
 53724  
 
       :EDIT-BY "lmm"
 
-      :CHANGES-TO (VARS SPYCOMS)
-                  (FNS \SPY.INTERRUPT SPY.BUFFER.ENTRY SPY.ADD.ENTRY)
+      :CHANGES-TO (RECORDS FX)
+                  (VARS SPYOBJCOMS)
 
-      :PREVIOUS-DATE " 4-Jan-2022 14:09:48" {DSK}<home>larry>il>medley>library>SPY.;1)
+      :PREVIOUS-DATE "28-Jul-2023 20:13:45" {DSK}<home>larry>il>medley>library>SPY.;1)
 
 
 (PRETTYCOMPRINT SPYCOMS)
@@ -114,7 +114,7 @@
                                       (FUNCTION SPYOBJ.BUTTON)
                                       (FUNCTION SPYOBJ.COPYIN)
                                       NIL NIL NIL NIL NIL NIL 'SPYNODE]
-        (DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS FX SPYOBJDATA))
+        (DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS SPYOBJDATA))
         (INITRECORDS SPYOBJDATA)))
 (DEFINEQ
 
@@ -189,134 +189,6 @@
 (DECLARE%: DONTCOPY DOEVAL@COMPILE 
 (DECLARE%: EVAL@COMPILE
 
-(ACCESSFNS FX
 ((FXBLOCK (ADDSTACKBASE DATUM)))               (* ; "frame extension index")

-              (BLOCKRECORD FXBLOCK ((FLAGS BITS 3)           (* ; "= \STK.FX")

-                                    (FAST FLAG)
-                                    (NIL FLAG)
-                                    (INCALL FLAG)            (* ; 
-
                                                             "set when fncall microcode has to punt")

-                                    (VALIDNAMETABLE FLAG)    (* ; 
-
                                  "if on, NAMETABLE field is filled in.  If off, is same as FNHEADER")

-                                    (NOPUSH FLAG)            (* ; 
-
                           "when returning to this frame, don't push a value.  Set by interrupt code")

-                                    (USECNT BITS 8)
-                                    (%#ALINK WORD)           (* ; "low bit is SLOWP")

-                                    (FNHEADER FULLXPOINTER)
-                                    (NEXTBLOCK WORD)
-                                    (PC WORD)
-                                    (NAMETABLE# FULLXPOINTER)
-                                    (%#BLINK WORD)
-                                    (%#CLINK WORD)))
-              (BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
-                                    (NIL BYTE)
-                                    (NIL BITS 15)            (* ; "most of the bits of #ALINK")

-                                    (SLOWP FLAG)             (* ; 
-
                           "if on, then BLINK and CLINK fields are valid.  If off, they are implicit")

-                                    (NIL FULLXPOINTER 2)
-                                    (NAMETABHI WORD)
-                                    (NAMETABLO WORD)))
-              (TYPE?
 (IEQ (fetch
 (FX FLAGS) of
 DATUM)
-                          \STK.FX))
-              [ACCESSFNS FX ((NAMETABLE (COND
-                                           ((fetch
 (FX VALIDNAMETABLE) of
 DATUM)
-                                            (fetch
 (FX NAMETABLE#) of
 DATUM))
-                                           (T (fetch
 (FX FNHEADER) of
 DATUM)))
-                                    (PROGN (replace
 (FX FAST) of
 DATUM with
 NIL)
-                                           (replace
 (FX NAMETABLE#) of
 DATUM with
 NEWVALUE)
-                                           (replace
 (FX VALIDNAMETABLE) of
 DATUM with
 T)))
-                             (FRAMENAME (fetch
 (FNHEADER FRAMENAME) of
 (fetch
 (FX NAMETABLE)
-                                                                          of
 DATUM)))
-                             (INVALIDP (EQ DATUM 0))         (* ; 
-
                                     "true when A/CLink points at nobody, i.e. FX is bottom of stack")

-                             [FASTP (NOT (fetch
 (FX SLOWP) of
 DATUM))
-                                    (PROGN (CHECK (NULL NEWVALUE))
-                                           (COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                               (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM))
-                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
-                             [BLINK (COND
-                                       ((fetch
 (FX FASTP) of
 DATUM)
-                                        (fetch
 (FX DUMMYBF) of
 DATUM))
-                                       (T (fetch
 (FX %#BLINK) of
 DATUM)))
-                                    (PROGN (replace
 (FX %#BLINK) of
 DATUM with
 NEWVALUE)
-                                           (COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM))
-                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
-                             [CLINK (IDIFFERENCE (COND
-                                                    ((fetch
 (FX FASTP) of
 DATUM)
-                                                     (fetch
 (FX %#ALINK) of
 DATUM))
-                                                    (T (fetch
 (FX %#CLINK) of
 DATUM)))
-                                           \#ALINK.OFFSET)
-                                    (PROGN (replace
 (FX %#CLINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET)
-                                                  )
-                                           (COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                               (replace
 (FX SLOWP) of
 DATUM with
 T]
-                             [ALINK (IDIFFERENCE (FLOOR (fetch
 (FX %#ALINK) of
 DATUM)
-                                                        WORDSPERCELL)
-                                           \#ALINK.OFFSET)
-                                    (PROGN [COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM))
-                                               (replace
 (FX %#CLINK) of
 DATUM
-                                                  with
 (fetch
 (FX %#ALINK) of
 DATUM]
-                                           (replace
 (FX %#ALINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET
-                                                                                      (SUB1 
-                                                                                         WORDSPERCELL
-                                                                                            ]
-                             [ACLINK (SHOULDNT)
-                                    (PROGN [COND
-                                              ((fetch
 (FX FASTP) of
 DATUM)
-                                               (replace
 (FX %#BLINK) of
 DATUM
-                                                  with
 (fetch
 (FX DUMMYBF) of
 DATUM]
-                                           (replace
 (FX %#CLINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET)
-                                                  )
-                                           (replace
 (FX %#ALINK) of
 DATUM with
 (IPLUS NEWVALUE 
-                                                                                      \#ALINK.OFFSET
-                                                                                      (SUB1 
-                                                                                         WORDSPERCELL
-                                                                                            ]
-                                                             (* ; 
-
                                      "replaces A & C Links at once more efficiently than separately")

-                             (DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
-
-                             (* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot.  This means that when a FX is copied, the cell preceding the FX is copied too.")

-
-                             (IVAR (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF) of
 DATUM)))
-                             [CHECKED (AND (type?
 FX DATUM)
-                                           (OR (IEQ (fetch
 (FX DUMMYBF) of
 DATUM)
-                                                    (fetch
 (FX BLINK) of
 DATUM))
-                                               (AND (fetch
 (BF RESIDUAL) of
 (fetch
 (FX DUMMYBF)
-                                                                               of
 DATUM))
-                                                    (IEQ (fetch
 (BF IVAR) of
 (fetch
 (FX DUMMYBF)
-                                                                                of
 DATUM))
-                                                         (fetch
 (BF IVAR) of
 (fetch
 (FX BLINK)
-                                                                                of
 DATUM]
-                             (FIRSTPVAR (IPLUS DATUM (fetch
 (FX FXSIZE) of
 T)))
-                                                             (* ; "stack offset of PVAR0")

-                             (FXSIZE (PROGN 10))             (* ; 
-
                                                             "fixed overhead from flags thru clink")

-                             (PADDING (PROGN 4))             (* ; 
-
                                                            "doublecell of garbage for microcode use")

-                             (FIRSTTEMP (IPLUS (fetch
 (FX FIRSTPVAR) of
 DATUM)
-                                               (fetch
 (FX NPVARWORDS) of
 DATUM)
-                                               (fetch
 (FX PADDING) of
 DATUM)))
-                                                             (* ; 
-
                                                 "note that NPVARWORDS is obtained from the FNHEADER")

-                             (SIZE (IDIFFERENCE (fetch
 (FX NEXTBLOCK) of
 DATUM)
-                                          DATUM])
-
 (RECORD SPYOBJDATA
 (CACHEDLABEL PERCENT LABEL))
 )
 )
@@ -1053,17 +925,17 @@
 
 (MOVD? 'NILL 'MODERNWINDOW)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4707 7314 (SPYOBJ 4717 . 5006) (SPYOBJ.BUTTON 5008 . 5118) (SPYOBJ.SAVE 5120 . 5239) (
-SPYOBJ.COPY 5241 . 5303) (SPYOBJ.GET 5305 . 5434) (SPYOBJ.IMAGEBOX 5436 . 5960) (SPYOBJ.DISPLAY 5962
- . 6261) (SPYOBJ.LABEL 6263 . 6399) (SPYOBJ.HEIGHT 6401 . 6614) (SPYOBJ.COPYIN 6616 . 6659) (
-SPY.COPYBUTTON 6661 . 6753) (SPY.MERGEINFO 6755 . 7312)) (18156 60387 (SPY.FIND.TREE 18166 . 18575) (
-SPY.TOGGLE 18577 . 18767) (SPY.TREE 18769 . 19881) (SPY.LEGEND 19883 . 20233) (SPY.GRAPH.EDITOR 20235
- . 29800) (SPY.END 29802 . 30044) (SPY.MAKEGRAPHNODES 30046 . 32146) (SPY.MAX 32148 . 33031) (
-SPY.MERGE 33033 . 34464) (SPY.MERGE1 34466 . 40949) (SPY.MERGETREE 40951 . 43881) (SPY.NEXT.TREE 43883
- . 44557) (SPY.SUM 44559 . 45248) (SPY.TITLE 45250 . 45467) (SPY.MAKE.TREE 45469 . 47494) (
-SPY.UPDATE.TITLE 47496 . 50072) (SPY.DELETE 50074 . 50609) (SPY.DRAWBOX 50611 . 51136) (
-SPY.BUFFER.ENTRY 51138 . 51481) (SPY.BUTTON 51483 . 52052) (SPY.END.ENTRY 52054 . 52134) (SPY.START 
-52136 . 52420) (SPY.INIT 52422 . 52657) (\SPY.INTERRUPT 52659 . 54064) (SPY.DUMP.BUFFER 54066 . 55526)
- (SPY.START.ENTRY 55528 . 55656) (SPY.ADD.ENTRY 55658 . 56090) (SPY.ORIGINAL 56092 . 56919) (
-SPY.OVERFLOW 56921 . 57022) (SPY.MERGE.CALLEES 57024 . 60060) (SPY.PRINT 60062 . 60385)))))
+  (FILEMAP (NIL (4660 7267 (SPYOBJ 4670 . 4959) (SPYOBJ.BUTTON 4961 . 5071) (SPYOBJ.SAVE 5073 . 5192) (
+SPYOBJ.COPY 5194 . 5256) (SPYOBJ.GET 5258 . 5387) (SPYOBJ.IMAGEBOX 5389 . 5913) (SPYOBJ.DISPLAY 5915
+ . 6214) (SPYOBJ.LABEL 6216 . 6352) (SPYOBJ.HEIGHT 6354 . 6567) (SPYOBJ.COPYIN 6569 . 6612) (
+SPY.COPYBUTTON 6614 . 6706) (SPY.MERGEINFO 6708 . 7265)) (7731 49962 (SPY.FIND.TREE 7741 . 8150) (
+SPY.TOGGLE 8152 . 8342) (SPY.TREE 8344 . 9456) (SPY.LEGEND 9458 . 9808) (SPY.GRAPH.EDITOR 9810 . 19375
+) (SPY.END 19377 . 19619) (SPY.MAKEGRAPHNODES 19621 . 21721) (SPY.MAX 21723 . 22606) (SPY.MERGE 22608
+ . 24039) (SPY.MERGE1 24041 . 30524) (SPY.MERGETREE 30526 . 33456) (SPY.NEXT.TREE 33458 . 34132) (
+SPY.SUM 34134 . 34823) (SPY.TITLE 34825 . 35042) (SPY.MAKE.TREE 35044 . 37069) (SPY.UPDATE.TITLE 37071
+ . 39647) (SPY.DELETE 39649 . 40184) (SPY.DRAWBOX 40186 . 40711) (SPY.BUFFER.ENTRY 40713 . 41056) (
+SPY.BUTTON 41058 . 41627) (SPY.END.ENTRY 41629 . 41709) (SPY.START 41711 . 41995) (SPY.INIT 41997 . 
+42232) (\SPY.INTERRUPT 42234 . 43639) (SPY.DUMP.BUFFER 43641 . 45101) (SPY.START.ENTRY 45103 . 45231) 
+(SPY.ADD.ENTRY 45233 . 45665) (SPY.ORIGINAL 45667 . 46494) (SPY.OVERFLOW 46496 . 46597) (
+SPY.MERGE.CALLEES 46599 . 49635) (SPY.PRINT 49637 . 49960)))))
 STOP

library/TEXEC

@@ -1,37 +1,35 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "16-Jul-2022 23:42:20" 
-|{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXEC.;3|
 196212 
+
(FILECREATED "28-Mar-2024 00:09:16" |{WMEDLEY}<library>TEXEC.;6|
 185248 
 
-      :CHANGES-TO (VARS TEXECCOMS TEXEC.ICON TEXEC.ICON.MASK TEXEC.TITLED.ICON.TEMPLATE)
+      :EDIT-BY |rmk|
 
-      :PREVIOUS-DATE " 1-Feb-2022 09:24:13" 
-|{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXEC.;2|)
+      :CHANGES-TO (FNS TEXEC.DEFAULT.MENUFN TEXEC.SHRINK.ICONCREATE)
 
+      :PREVIOUS-DATE "18-Jun-2023 09:48:54" |{WMEDLEY}<library>TEXEC.;5|)
 
-; Copyright (c) 1985, 1900, 1986-1991 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT TEXECCOMS)
 
 (RPAQQ TEXECCOMS

        ((COMS                                                (* \; 
 
                                                             "To support development and compilation")

-              (DECLARE\: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
-                                                      ATERM TEDIT-DCL)))
+              (DECLARE\: DONTCOPY EVAL@COMPILE (FILES TEDIT-EXPORTS.ALL (LOADCOMP)
+                                                      ATERM)))
         (COMS 
               (* |;;| "THE FILLBUFFER REPLACEMENT CODE")

 
               (FNS TEXEC.BACKSKREAD TEXEC.OPENTEXTSTREAM TEXEC.DEFAULT.MENUFN TEXEC.DO?CMD 
                    TEXEC.CREATEMENU TEXEC.GET TEXEC.INCLUDE TEXEC.FIND.FORWARD TEXEC.FIND.BACKWARD 
-                   TEDIT.FIND.BACKWARD TEDIT.BASICFIND.BACKWARD TEXEC.MENU.WHENHELDFN 
-                   TEXEC.SHRINK.ICONCREATE TEXEC.FILLBUFFER TEXEC.FILLBUFFER.TCLASS 
-                   TEXEC.CHSELPENDING TEXEC.FILLBUFFER.CHARDELETE TEXEC.FILLBUFFER.WORDDELETE 
-                   TEXEC.FILLBUFFER.LINEDELETE TEXEC.PARENCOUNT TEXEC.PARENMATCH TEXEC.FLASHCARET 
-                   TEXEC.TEXTSTREAM.TO.LINEBUF TEXEC.FIX TEXEC.NTHBUFCHARBACK TEXEC.NTHBACKCHNUM 
-                   TEXEC.EOTP TEXEC.GETKEY TEXEC.INSERTCHAR TEXEC.DELETE TEXEC.\\CHDEL1 TEXEC.?EQUAL
-                   TEDIT.SCROLL? TEXEC.DISPLAYTEXT \\TEXEC.TEXTBOUT \\TEXEC.TEXTBOUT1 
-                   \\TEXEC.TEXTBOUT2 \\TEXEC.TEXTBOUT3 \\TEXEC.TEXTBOUT4 \\TEXEC.SELFN 
-                   TEXEC.PRINTARGS TEXEC.PROCENTRYFN TEXEC.PROCEXITFN))
+                   TEXEC.MENU.WHENHELDFN TEXEC.SHRINK.ICONCREATE TEXEC.FILLBUFFER 
+                   TEXEC.FILLBUFFER.TCLASS TEXEC.CHSELPENDING TEXEC.FILLBUFFER.CHARDELETE 
+                   TEXEC.FILLBUFFER.WORDDELETE TEXEC.FILLBUFFER.LINEDELETE TEXEC.PARENCOUNT 
+                   TEXEC.PARENMATCH TEXEC.FLASHCARET TEXEC.TEXTSTREAM.TO.LINEBUF TEXEC.FIX 
+                   TEXEC.NTHBUFCHARBACK TEXEC.NTHBACKCHNUM TEXEC.EOTP TEXEC.GETKEY TEXEC.INSERTCHAR 
+                   TEXEC.DELETE TEXEC.\\CHDEL1 TEXEC.?EQUAL TEDIT.SCROLL? TEXEC.DISPLAYTEXT 
+                   \\TEXEC.TEXTBOUT \\TEXEC.TEXTBOUT1 \\TEXEC.TEXTBOUT2 \\TEXEC.TEXTBOUT3 
+                   \\TEXEC.TEXTBOUT4 \\TEXEC.SELFN TEXEC.PRINTARGS TEXEC.PROCENTRYFN TEXEC.PROCEXITFN
+                   ))
         (COMS 
               (* |;;| "Code to support a TEXEC lisp 'listener'")

 
@@ -56,8 +54,8 @@
 
 (DECLARE\: DONTCOPY EVAL@COMPILE 
 
-(FILESLOAD (LOADCOMP)
-       ATERM TEDIT-DCL)
+(FILESLOAD TEDIT-EXPORTS.ALL (LOADCOMP)
+       ATERM)
 )
 
 
@@ -186,28 +184,24 @@
           TEXSTREAM)))
 
 (TEXEC.DEFAULT.MENUFN

-  (LAMBDA (W)
                                          (* \; "Edited 13-Jun-90 00:16 by mitani")

+  (LAMBDA (W)
                                               (* \; "Edited 28-Mar-2024 00:06 by rmk")


+                                                           (* \; "Edited 13-Jun-90 00:16 by mitani")

 
-         (* |Default| |User| F\n |for| TEXEC |windows--displays| \a |menu| |of| |items| 
-
       & |acts| |on| |the| |commands| |received.|)

+    (* |;;| 
+
    "Default User Fn for TEXEC windows--displays a menu of items & acts on the commands received.")

 
-    (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
+    (PROG ((TEXTOBJ (TEXTOBJ W))
            (WMENU (WINDOWPROP W 'TEDIT.MENU))
            THISMENU CH OFILE OCURSOR PCTB LINES SEL ITEM)
           (COND
              ((EQ (|fetch|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ)
-                  T)                                         (* |We're| |busy| |doing| 
-
                                                           |something,| |but| |not| |sure| 
-
                                                           |what.| |Give| \a |general| 
-
                                                           "please wait" |msg|)

+                  T)                                         (* \; 
+
                   "We're busy doing something, but not sure what.  Give a general 'please wait' msg")

               (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T)
               (RETURN))
-             ((|fetch|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ)
-                                                             (* W\e |know| |specifically| 
-
                                                           |what's| |happening.|
-
                                                           |Tell| |him|)

-              (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (|fetch|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ
-                                                        )
+             ((|fetch|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ)  (* \; 
+
                                                   "We know specifically what's happening.  Tell him")

+              (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (|fetch|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ)
                                                 " in progress; please wait.")
                      T)
               (RETURN)))
@@ -222,37 +216,31 @@
           (ERSETQ (RESETLST
                       (RESETSAVE (\\TEDIT.MARKACTIVE TEXTOBJ)
                              '(AND (\\TEDIT.MARKINACTIVE OLDVALUE)))
-                      (|replace|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ
-                         |with|
 (OR (CAR ITEM)
-                                        T))                  (* S\o |we| |ca| |ntell| |the| |guy| 
-
                                                           WHAT |op| |is| |active.|)

+                      (|replace|
 (TEXTOBJ EDITOPACTIVE) |of|
 TEXTOBJ |with|
 (OR (CAR ITEM)
+                                                                                T))
+                                                             (* \; 
+
                                                          "So we ca ntell the guy WHAT op is active.")

                       (SELECTQ (CAR ITEM)
                           (|Put| (TEDIT.PUT TEXTOBJ NIL NIL (TEXTPROP TEXTOBJ 'CLEARPUT)))
                           (|Plain-Text| (TEDIT.PUT TEXTOBJ NIL NIL T))
-                          (|Old-Format|                      (* |Write| |out| |the| |file| |in| 
-
                                                           |the| OLD |TEdit| |format.|)

+                          (|Old-Format|                      (* \; 
+
                                                        "Write out the file in the OLD TEdit format.")

                                         (TEDIT.PUT TEXTOBJ NIL NIL NIL T))
-                          (|Get|                             (* |Get| \a |new| |file|
-
                                                           (|overwriting| |the| |one| |being| 
-
                                                           |edited.|))

+                          (|Get|                             (* \; 
+
                                                 "Get a new file (overwriting the one being edited.)")

                                  (TEXEC.GET
 TEXTOBJ NIL (TEXTPROP TEXTOBJ 'CLEARGET)))
                           (|Unformatted Get| 
                                (TEXEC.GET
 TEXTOBJ NIL T))
-                          (|Include|                         (* |Insert| \a |file| |where| |the| 
-
                                                           |caret| |is|)

+                          (|Include|                         (* \; "Insert a file where the caret is")

                                      (TEXEC.INCLUDE
 TEXTOBJ))
-                          (|ForwardFind|                     (* |Normal| |forward| |search| 
-
                                                           |Find|)

+                          (|ForwardFind|                     (* \; "Normal forward search Find")

                                          (TEXEC.FIND.FORWARD
 TEXTOBJ))
-                          (|BackwardFind|                    (* |Backward| |search| |Find|)

+                          (|BackwardFind|                    (* \; "Backward search Find")

                                (TEXEC.FIND.BACKWARD
 TEXTOBJ))
                           (|Limit| (SETQ TEXEC.BUFFERLIMIT (RNUMBER)))
                           (COND
-                             ((CAR ITEM)
-
-         (* |This| |is| \a |user-supplied| |entry.|
-
       |Get| |the| |function,| |and| |apply| |it| |to| |the| TEXTSTREAM |for| |him|)

-
+                             ((CAR ITEM)                     (* \; 
+
           "This is a user-supplied entry.  Get the function, and apply it to the TEXTSTREAM for him")

                               (APPLY* (CAR ITEM)
                                      (|fetch|
 (TEXTOBJ STREAMHINT) |of|
 TEXTOBJ))))))))))
 
@@ -996,155 +984,6 @@
                            (\\SHOWSEL (|fetch|
 (TEXTOBJ SEL) |of|
 TEXTOBJ)
                                   NIL T))))))))
 
-(TEDIT.FIND.BACKWARD

-  (LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?)
  (* \; "Edited 30-May-91 19:17 by jds")

-
-         (* I\f WILDCARDS? |is| NIL |then| TEDIT.FIND.BACKWARD |is| |the| |old| 
-
       TEDIT.FIND. |Else,| |it| |returns| \a |list| |of|
-
       (SEL.START# SEL.END#) |which| |is| |the| |start| |and| |end| |char| |positions| 
-
       |of| |the| |selection|)

-
-    (PROG ((TEDIT.WILDCARD.CHARACTERS '("#" "*")))
-          (AND TARGETSTRING (NOT (STRINGP TARGETSTRING))
-               (SETQ TARGETSTRING (MKSTRING TARGETSTRING)))
-          (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
-          (\\TEDIT.HISTORYADD TEXTOBJ (|create|
 TEDITHISTORYEVENT
-                                             THACTION _ '|Find|
-                                             THAUXINFO _ TARGETSTRING))
-          (|replace|
 (TEXTOBJ \\INSERTPCVALID) |of|
 TEXTOBJ |with|
 NIL)
-                                                             (* |Any| FIND |invalidates| |the| 
-
                                                           |type-in| |cache.|)

-          (RETURN
-           (COND
-              (WILDCARDS?
-
-         (* |will| |return| \a |list| |of| |start| |and| |end| |of| |selection| |or| 
-
       |nil| |if| |not| |found|)

-
-               (PROG (TARGETLIST SEL RESULT RESULT1)
-                     (RETURN (COND
-                                ((OR START# (AND (|fetch|
 (SELECTION SET)
-                                                    |of|
 (SETQ SEL (|fetch|
 (TEXTOBJ SEL)
-                                                                          |of|
 TEXTOBJ)))
-                                                 (LEQ (SETQ START# (SELECTQ (|fetch|
 (SELECTION
-                                                                                          POINT)
-                                                                               |of|
 SEL)
-                                                                       (LEFT (|fetch|

-                                                                              (SELECTION CH#)
-                                                                                |of|
 SEL))
-                                                                       (RIGHT (|fetch|

-                                                                               (SELECTION CHLIM)
-                                                                                 |of|
 SEL))
-                                                                       NIL))
-                                                      (OR END# (SETQ END# 1)))))
-                                                             (* |Backwards| |search|)

-                                 (COND
-                                    ((AND (|for|
 X
-                                             |in|
 (SETQ TARGETLIST
-                                                       (\\TEDIT.PARSE.SEARCHSTRING
-                                                        (|for|
 X |in|
 (UNPACK (MKATOM 
-                                                                                         TARGETSTRING
-                                                                                             ))
-                                                           |collect|
 (MKSTRING X)))) |collect|

-                                                                                         X
-                                             |when|
 (LITATOM X))
-                                          (SETQ RESULT1 (\\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST END# 
-                                                               START#)))
-                                                             (* I\f |there| |are| |atoms,| |they| 
-
                                                           |are| |tedit| |wildcard| |chars|)

-                                     (\\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 START#))
-                                    (T                       (* |no| |wildcards| |but| |bounded| 
-
                                                           |search|)

-                                       (COND
-                                          ((SETQ RESULT (TEDIT.FIND.BACKWARD
 TEXTOBJ (CAR 
-                                                                                           TARGETLIST
-                                                                                              )
-                                                               START# END# NIL))
-                                           (LIST RESULT (SUB1 (IPLUS RESULT (NCHARS (CAR TARGETLIST))
-                                                                     ))))))))))))
-              (T                                             (* |will| |return| |just| |the| 
-
                                                           |number| |of| |the| |start| |char| 
-
                                                           |or| |nil| |if| |not| |found|)

-                 (PROG (RESULT)
-                       (SETQ RESULT (TEDIT.BASICFIND.BACKWARD
 TEXTOBJ TARGETSTRING START# 1))
-                       (RETURN (COND
-                                  ((NULL END#)
-                                   RESULT)
-                                  ((OR (NULL RESULT))
-                                   NIL)
-                                  (T RESULT))))))))))
-
-(TEDIT.BASICFIND.BACKWARD

-  (LAMBDA (TEXTOBJ STRING CH# CHLIM)
                     (* \; "Edited 30-May-91 19:17 by jds")

-
-         (* |Search| |thru| TEXTOBJ\, |starting| |where| |the| |caret| |is,| |for| |the| 
-
       |string| STRING\, |exact| |match| |only| |for| |now.|
-
       (|Optionally,| |start| |the| |search| |at| |character| |ch#.|))

-
-    (PROG ((SEL (|fetch|
 (TEXTOBJ SEL) |of|
 TEXTOBJ))
-           (TEXTLEN (|fetch|
 (TEXTOBJ TEXTLEN) |of|
 TEXTOBJ))
-           (TEXTLIM (OR CHLIM (ADD1 (IDIFFERENCE (|fetch|
 (TEXTOBJ TEXTLEN) |of|
 TEXTOBJ)
-                                           (NCHARS STRING)))))
-           (TEXTSTREAM (|fetch|
 (TEXTOBJ STREAMHINT) |of|
 TEXTOBJ))
-           (FOUND NIL)
-           CH1 CH CH#1 (RSTRING "")
-           (TSTRING (CONCAT STRING))
-           ANCHOR PCH# OANCHOR CH)                           (* |Reverse| |the| |string|)

-          (|while|
 (SETQ CH (GLC TSTRING)) |do|
 (SETQ RSTRING (CONCAT RSTRING (MKSTRING
-                                                                                       CH))))
-          (SETQ CH#1 (NTHCHARCODE RSTRING 1))
-          (|replace|
 (TEXTOBJ \\INSERTPCVALID) |of|
 TEXTOBJ |with|
 NIL)
-
-         (* |2/12/85| JDS\: I |don't| |understand| WHY |this| |is| |here,| |but| |I'll| 
-
       |assume| |it's| |right| |for| |now.|)

-                                                             (* |Prohibit| |future| |insertions| 
-
                                                           |in| |the| |current| |piece.|)

-          (COND
-             ((OR CH# (|fetch|
 (SELECTION SET) |of|
 SEL))
-                                                             (* |There| |must| |be| \a 
-
                                                           |well-defined| |starting| |point.|)

-              (RETURN (PROG NIL
-                            (SETQ CH1 (SUB1 (OR CH# (SELECTQ (|fetch|
 (SELECTION POINT)
-                                                                |of|
 SEL)
-                                                        (LEFT (|fetch|
 (SELECTION CH#)
-                                                                 |of|
 SEL))
-                                                        (RIGHT (|fetch|
 (SELECTION CHLIM)
-                                                                  |of|
 SEL))
-                                                        NIL))))
-                                                             (* |Find| |the| |starting| |point| 
-
                                                           |for| |the| |search|)

-                                                             (* DO THE SEARCH)

-                            (COND
-                               ((ILESSP CH1 2)               (* |Starting| |the| |search| |past| 
-
                                                           |the| |last| |possible| |starting| 
-
                                                           |point.| |Just| |punt.|)

-                                (RETURN NIL)))
-                        RETRY
-                            (SETQ ANCHOR CH1)
-                            (\\SETUPGETCH ANCHOR TEXTOBJ)
-                            (|for|
 |old|
 ANCHOR |from|
 CH1 |by|
 -1 |to|
 2
-                               |do|
 (SETQ CH (\\BACKBIN TEXTSTREAM))
-                                     (COND
-                                        ((EQ CH CH#1)
-                                         (RETURN))))
-                            (COND
-                               ((ILEQ ANCHOR 2)
-                                (RETURN NIL)))               (* N\o |starting| |character| 
-
                                                           |found| |before| |end| |of| |string|)

-                            (SETQ OANCHOR ANCHOR)
-                            (SETQ FOUND T)
-                            (|for|
 |old|
 CH1 |from|
 (SUB1 ANCHOR) |to|
 2 |by|

-                                                                                         -1
-                               |as|
 PCH# |from|
 2 |to|
 (NCHARS STRING)
-                               |do|
 (SETQ CH (\\BACKBIN TEXTSTREAM))
-                                     (COND
-                                        ((NEQ CH (NTHCHARCODE RSTRING PCH#))
-                                         (SETQ FOUND NIL)
-                                         (RETURN))))
-                            (COND
-                               (FOUND (RETURN ANCHOR))
-                               (T (GO RETRY))))))))))
-
 (TEXEC.MENU.WHENHELDFN

   (LAMBDA (ITEM MENU BUTTON)
                                 (* AJB "30-Jan-86 13:09")

     (PROMPTPRINT (SELECTQ (CAR ITEM)
@@ -1158,58 +997,44 @@
                      ""))))
 
 (TEXEC.SHRINK.ICONCREATE

-  (LAMBDA (W ICON ICONW)
                                     (* AJB " 7-Jan-86 16:37")

-                                                             (* |Create| |the| |icon| |that| 
-
                                                             |represents| |this| |window.|)

-    (PROG ((ICON (WINDOWPROP W 'ICON))
-           (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
-           (SHRINKFN (WINDOWPROP W 'SHRINKFN)))
-          (COND
-             ((NOT (WINDOWPROP W 'TEXTOBJ))
-          
-          (* |This| |isn't| |really| \a |TEdit| |window| |any| |more.|
-
          |Don't| |do| |anything|)

-
-              NIL)
-             ((WINDOWPROP W 'TEDITMENU)                      (* |This| |is| \a |text| |menu,| |and| 
-
                                                             |shrinks| |without| |trace.|)

-              NIL)
-             ((OR (IGREATERP (FLENGTH SHRINKFN)
-                         3)
-                  (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
-                       (IGREATERP (FLENGTH SHRINKFN)
-                              2)))
-          
-          (* |There| |are| |other| |functions| |that| |expect| |to| |handle| |this.|
-
          |Don't| |bother.|)

-
-              NIL)
-             ((OR (AND ICONTITLE (EQUAL ICONTITLE (PROCESSPROP (WINDOWPROP W 'PROCESS)
-                                                         'NAME)))
-                  (AND (NOT ICONTITLE)
-                       ICON))
-          
-          (* |we| |built| |this| |and| |the| |title| |is| |the| |same,| |or| |he| |has| 
-
          |already| |put| |an| |icon| |on| |this.|
-
          D\o |nothing|)

-
-              NIL)
-             (ICON 
-          
-          (* |There's| |an| |existing| |icon| |window;|
-
          |change| |the| |title| |in| |it|)

-
+  (LAMBDA (W ICON ICONW)
                                    (* \; "Edited 28-Mar-2024 00:08 by rmk")

+                                                             (* AJB " 7-Jan-86 16:37")

+                                                             (* \; 
+
                                                       "Create the icon that represents this window.")

+    (CL:WHEN (TEXTSTREAM W T)
+        (LET ((ICON (WINDOWPROP W 'ICON))
+              (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
+              (SHRINKFN (WINDOWPROP W 'SHRINKFN)))
+             (COND
+                ((WINDOWPROP W 'TEDITMENU)                   (* \; 
+
                                                    "This is a text menu, and shrinks without trace.")

+                 )
+                ((OR (IGREATERP (FLENGTH SHRINKFN)
+                            3)
+                     (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
+                          (IGREATERP (FLENGTH SHRINKFN)
+                                 2)))                        (* \; 
+
                               "There are other functions that expect to handle this.  Don't bother.")

+                 )
+                ((OR (AND ICONTITLE (EQUAL ICONTITLE (PROCESSPROP (WINDOWPROP W 'PROCESS)
+                                                            'NAME)))
+                     (AND (NOT ICONTITLE)
+                          ICON))                             (* \; 
+
        "we built this and the title is the same, or he has already put an icon on this.  Do nothing")

+                 )
+                (ICON                                        (* \; 
+
                                           "There's an existing icon window;  change the title in it")

+                      (WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (PROCESSPROP
+                                                                       (WINDOWPROP W 'PROCESS)
+                                                                       'NAME)))
+                      (ICONTITLE ICONTITLE NIL NIL ICON))
+                (T                                           (* \; "install a new icon")

                    (WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (PROCESSPROP (WINDOWPROP
                                                                                  W
                                                                                  'PROCESS)
                                                                           'NAME)))
-                   (ICONTITLE ICONTITLE NIL NIL ICON))
-             (T                                              (* |install| \a |new| |icon|)

-                (WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (PROCESSPROP (WINDOWPROP W
-                                                                                    'PROCESS)
-                                                                       'NAME)))
-                (WINDOWPROP W 'ICON (TITLEDICONW TEXEC.TITLED.ICON.TEMPLATE ICONTITLE TEXEC.ICON.FONT 
-                                           NIL T '(BOTTOM LEFT))))))
+                   (WINDOWPROP W 'ICON (TITLEDICONW TEXEC.TITLED.ICON.TEMPLATE ICONTITLE 
+                                              TEXEC.ICON.FONT NIL T '(BOTTOM LEFT)))))))
     (WINDOWPROP W 'ICON)))
 
 (TEXEC.FILLBUFFER

@@ -3158,23 +2983,22 @@
 (RPAQQ |BackgroundMenu|
 NIL)
 
 (RPAQ? TEXEC.BUFFERLIMIT
 10000)
-(PUTPROPS TEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1986 1987 1988 1989 1990 1991))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (3225 181985 (TEXEC.BACKSKREAD 3235 . 7859) (TEXEC.OPENTEXTSTREAM 7861 . 9919) (
-TEXEC.DEFAULT.MENUFN 9921 . 14475) (TEXEC.DO?CMD 14477 . 19795) (TEXEC.CREATEMENU 19797 . 20255) (
-TEXEC.GET 20257 . 29092) (TEXEC.INCLUDE 29094 . 42479) (TEXEC.FIND.FORWARD 42481 . 55369) (
-TEXEC.FIND.BACKWARD 55371 . 68873) (TEDIT.FIND.BACKWARD 68875 . 74352) (TEDIT.BASICFIND.BACKWARD 74354
- . 79008) (TEXEC.MENU.WHENHELDFN 79010 . 79669) (TEXEC.SHRINK.ICONCREATE 79671 . 82474) (
-TEXEC.FILLBUFFER 82476 . 98910) (TEXEC.FILLBUFFER.TCLASS 98912 . 105252) (TEXEC.CHSELPENDING 105254 . 
-113744) (TEXEC.FILLBUFFER.CHARDELETE 113746 . 115801) (TEXEC.FILLBUFFER.WORDDELETE 115803 . 120931) (
-TEXEC.FILLBUFFER.LINEDELETE 120933 . 123815) (TEXEC.PARENCOUNT 123817 . 125206) (TEXEC.PARENMATCH 
-125208 . 126748) (TEXEC.FLASHCARET 126750 . 129409) (TEXEC.TEXTSTREAM.TO.LINEBUF 129411 . 132098) (
-TEXEC.FIX 132100 . 135269) (TEXEC.NTHBUFCHARBACK 135271 . 136334) (TEXEC.NTHBACKCHNUM 136336 . 137621)
- (TEXEC.EOTP 137623 . 138356) (TEXEC.GETKEY 138358 . 141274) (TEXEC.INSERTCHAR 141276 . 143577) (
-TEXEC.DELETE 143579 . 144354) (TEXEC.\\CHDEL1 144356 . 147481) (TEXEC.?EQUAL 147483 . 148532) (
-TEDIT.SCROLL? 148534 . 153497) (TEXEC.DISPLAYTEXT 153499 . 160274) (\\TEXEC.TEXTBOUT 160276 . 163284) 
-(\\TEXEC.TEXTBOUT1 163286 . 168920) (\\TEXEC.TEXTBOUT2 168922 . 171253) (\\TEXEC.TEXTBOUT3 171255 . 
-172645) (\\TEXEC.TEXTBOUT4 172647 . 174690) (\\TEXEC.SELFN 174692 . 176067) (TEXEC.PRINTARGS 176069 . 
-181032) (TEXEC.PROCENTRYFN 181034 . 181575) (TEXEC.PROCEXITFN 181577 . 181983)) (182045 188420 (TEXEC 
-182055 . 186477) (TTEXEC 186479 . 188418)))))
+  (FILEMAP (NIL (3048 171118 (TEXEC.BACKSKREAD 3058 . 7682) (TEXEC.OPENTEXTSTREAM 7684 . 9742) (
+TEXEC.DEFAULT.MENUFN 9744 . 13790) (TEXEC.DO?CMD 13792 . 19110) (TEXEC.CREATEMENU 19112 . 19570) (
+TEXEC.GET 19572 . 28407) (TEXEC.INCLUDE 28409 . 41794) (TEXEC.FIND.FORWARD 41796 . 54684) (
+TEXEC.FIND.BACKWARD 54686 . 68188) (TEXEC.MENU.WHENHELDFN 68190 . 68849) (TEXEC.SHRINK.ICONCREATE 
+68851 . 71607) (TEXEC.FILLBUFFER 71609 . 88043) (TEXEC.FILLBUFFER.TCLASS 88045 . 94385) (
+TEXEC.CHSELPENDING 94387 . 102877) (TEXEC.FILLBUFFER.CHARDELETE 102879 . 104934) (
+TEXEC.FILLBUFFER.WORDDELETE 104936 . 110064) (TEXEC.FILLBUFFER.LINEDELETE 110066 . 112948) (
+TEXEC.PARENCOUNT 112950 . 114339) (TEXEC.PARENMATCH 114341 . 115881) (TEXEC.FLASHCARET 115883 . 118542
+) (TEXEC.TEXTSTREAM.TO.LINEBUF 118544 . 121231) (TEXEC.FIX 121233 . 124402) (TEXEC.NTHBUFCHARBACK 
+124404 . 125467) (TEXEC.NTHBACKCHNUM 125469 . 126754) (TEXEC.EOTP 126756 . 127489) (TEXEC.GETKEY 
+127491 . 130407) (TEXEC.INSERTCHAR 130409 . 132710) (TEXEC.DELETE 132712 . 133487) (TEXEC.\\CHDEL1 
+133489 . 136614) (TEXEC.?EQUAL 136616 . 137665) (TEDIT.SCROLL? 137667 . 142630) (TEXEC.DISPLAYTEXT 
+142632 . 149407) (\\TEXEC.TEXTBOUT 149409 . 152417) (\\TEXEC.TEXTBOUT1 152419 . 158053) (
+\\TEXEC.TEXTBOUT2 158055 . 160386) (\\TEXEC.TEXTBOUT3 160388 . 161778) (\\TEXEC.TEXTBOUT4 161780 . 
+163823) (\\TEXEC.SELFN 163825 . 165200) (TEXEC.PRINTARGS 165202 . 170165) (TEXEC.PROCENTRYFN 170167 . 
+170708) (TEXEC.PROCEXITFN 170710 . 171116)) (171178 177553 (TEXEC 171188 . 175610) (TTEXEC 175612 . 
+177551)))))
 STOP

library/lafite/LAFITE

@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "30-Sep-2021 22:59:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;5
 71956  
 
-      changes to%:  (FILES LAFITEDECLS)
+
(FILECREATED "26-Feb-2024 20:10:22" {WMEDLEY}<library>lafite>LAFITE.;19
 72156  
 
-      previous date%: "24-Jun-2021 19:17:01" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (VARS LAFITECOMS LAFITEFILES)
+
+      :PREVIOUS-DATE "24-Feb-2024 11:56:21" {WMEDLEY}<library>lafite>LAFITE.;18)
 
-(* ; "
-Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek and Newman Inc..
-")
 
 (PRETTYCOMPRINT LAFITECOMS)
 
@@ -86,29 +83,29 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
                    \LAFITE.CLOSE.FOLDER)
               (FNS \LAFITE.DESCRIBE.FOLDER))
         (COMS                                                (* ; 
-
                                                      "Make is easy to load new versions of Lafite")

+
                                                        "Make is easy to load new versions of Lafite")

               (FNS LOAD-LAFITE)
               (VARS LAFITEFILES))
         [DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                  LAFITEDECLS)
+                                                  LAFITE-DECLS)
                (LOCALVARS . T)
                (GLOBALVARS TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*)
                (P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-LOGGING-IN*]
         (INITRECORDS MAILFOLDER LAFITEMSG)
         (SYSRECORDS MAILFOLDER LAFITEMSG)
         [COMS (FNS \LAFITE.GLOBAL.INIT)
-              (DECLARE%: DONTEVAL@LOAD DOCOPY
-                     (FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL 
-                            LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES TEDIT ATTACHEDWINDOW)
+                     (FILES LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-SEND LAFITE-MAIL 
+                            LAFITE-SORT LAFITE-TEDIT LAFITE-FIND LAFITE-MAILSCAVENGE)
                      (P * (PROGN LAFITE.PROCLAMATIONS))
                                                              (* ; 
-
                                      "Proclaim user interface variables.  Value is on LAFITEDECLS")

+
                                       "Proclaim user interface variables.  Value is on LAFITE-DECLS")

                      (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)
@@ -116,7 +113,7 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
 
 (RPAQQ LAFITEVERSION#
 10)
 
-(RPAQQ LAFITESYSTEMDATE
 "30-Sep-2021 22:59:08")
+(RPAQQ LAFITESYSTEMDATE
 "26-Feb-2024 20:10:22")
 (DEFINEQ
 
 (LAFITE

@@ -277,7 +274,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                                          (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,7 +314,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                   (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])
 
@@ -354,9 +351,9 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (RPAQ? LAFITE.USE.ALL.MODES
 T)
 
 (RPAQQ LAFITERANDOMGLOBALS
 ((UNSUPPLIEDFIELDSTR "---")
-                                (LAFITEBUSYWAITTIME 1000)
-                                (LAFITEITEMBUSYSHADE 43605)
-                                (LAFITEEOL "
+                            (LAFITEBUSYWAITTIME 1000)
+                            (LAFITEITEMBUSYSHADE 43605)
+                            (LAFITEEOL "
 ")))
 
 (RPAQ? UNSUPPLIEDFIELDSTR
 "---")
@@ -394,13 +391,13 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 
 (RPAQ HEARDMARK
 (CHARCODE @))
 
-(RPAQQ LAFITECOMMANDMENUITEMS
 (("Browse" '\LAFITE.BROWSE 
-                                          "Browse a mail file; MIDDLE for subcommands")
-                                   ("Send Mail" '\LAFITE.MESSAGEFORM 
+(RPAQQ LAFITECOMMANDMENUITEMS
 (("Browse" '\LAFITE.BROWSE "Browse a mail file; MIDDLE for subcommands"
+                                      )
+                               ("Send Mail" '\LAFITE.MESSAGEFORM 
                                       "Open a message composition window; MIDDLE for choice of forms"
-                                          )
-                                   ("Quit" '\LAFITE.QUIT 
-                                          "Update and close all mail files and stop Lafite")))
+                                      )
+                               ("Quit" '\LAFITE.QUIT 
+                                      "Update and close all mail files and stop Lafite")))
 
 (RPAQQ LAFITEUPDATEMENUITEMS

        (("Do Hardcopy Only" '\LAFITE.HARDCOPYONLY.PROC 
@@ -435,7 +432,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
         ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE "Change setting of *NSMAIL-TRACE-SERVERS*")))
 
 (RPAQQ ANOTHERFOLDERMENUITEM
 ("** Other Folder **" '%##ANOTHERFILE## 
-                                        "You will be asked to specify another mail filename"))
+                                    "You will be asked to specify another mail filename"))
 
 (RPAQ? LAFITESTATUSWINDOW
 )
 
@@ -622,17 +619,40 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (DEFINEQ
 
 (LOAD-LAFITE

-(LAMBDA (DIR SOURCEP) (* ; "Edited  3-May-89 18:39 by bvm") (* ;; "Load Lafite from a specified directory (or the dir where we find the first file).  If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD.  When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).") (SETQ DIR (MKLIST DIR)) (for FILE in (if SOURCEP then LAFITEFILES else (REMOVE (QUOTE LAFITEDECLS) LAFITEFILES)) bind F when (OR SOURCEP (GET FILE (QUOTE FILEDATES))) collect (if (SETQ F (if SOURCEP then (FINDFILE FILE T DIR) else (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*))) then (SETQ F (LOAD F (COND ((NOT SOURCEP) (QUOTE SYSLOAD)) ((EQ F (QUOTE LAFITEDECLS)) T) (T (QUOTE PROP))))) (if (NULL DIR) then (* ; "Fix dir for subsequent loading") (SETQ DIR (LIST (PACKFILENAME.STRING (QUOTE NAME) NIL (QUOTE EXTENSION) NIL (QUOTE VERSION) NIL (QUOTE BODY) F)))) F else (CONCAT FILE " not found"))))
-)
+  [LAMBDA (DIR SOURCEP)
                                      (* ; "Edited 23-Feb-2024 23:02 by rmk")


+                                                             (* ; "Edited  3-May-89 18:39 by bvm")

+
+    (* ;; "Load Lafite from a specified directory (or the dir where we find the first file).  If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD.  When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).")

+
+    (SETQ DIR (MKLIST DIR))
+    (for
 FILE in
 (if
 SOURCEP
+                     then
 LAFITEFILES
+                   else
 (REMOVE 'LAFITE-DECLS LAFITEFILES)) bind
 F
+       when
 (OR SOURCEP (GET FILE 'FILEDATES))
+       collect
 (if
 (SETQ F (if
 SOURCEP
+                               then
 (FINDFILE FILE T DIR)
+                             else
 (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*)))
+                   then
 [SETQ F (LOAD F (COND
+                                           ((NOT SOURCEP)
+                                            'SYSLOAD)
+                                           ((EQ F 'LAFITE-DECLS)
+                                            T)
+                                           (T 'PROP]
+                        [if
 (NULL DIR)
+                            then
                             (* ; "Fix dir for subsequent loading")

+                                 (SETQ DIR (LIST (PACKFILENAME.STRING 'NAME NIL 'EXTENSION NIL
+                                                        'VERSION NIL 'BODY F]
+                        F
+                 else
 (CONCAT FILE " not found"])
 )
 
-(RPAQQ LAFITEFILES
 (LAFITEDECLS LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITEMAIL LAFITESEND 
-                              LAFITESORT LAFITETEDIT NSMAIL OLDNSMAIL NEWNSMAIL LAFITEFIND 
-                              MAILSCAVENGE LAFITE))
+(RPAQQ LAFITEFILES
 (LAFITE-DECLS LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-MAIL LAFITE-SEND
+                          LAFITE-SORT LAFITE-TEDIT LAFITE-NSMAIL OLDNSMAIL LAFITE-NEWNSMAIL 
+                          LAFITE-FIND LAFITE-MAILSCAVENGE LAFITE))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -743,81 +763,81 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (ADDTOVAR SYSTEMRECLST
 
 (DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG)
-                          (BROWSERPROMPTGREW FLAG)
-                          (FOLDERNEEDSUPDATE FLAG)
-                          (FOLDERNEEDSEXPUNGE FLAG)
-                          (FOLDERBEINGUPDATED FLAG)
-                          (BROWSERSTATUS BITS 3)
-                          (FULLFOLDERNAME POINTER)
-                          (FOLDEROKTOSHRINK FLAG)
-                          (FOLDERGETSMAIL FLAG)
-                          (FOLDEROUTOFORDER FLAG)
-                          (NIL 5 FLAG)
-                          (VERSIONLESSFOLDERNAME POINTER)
-                          (SHORTFOLDERNAME POINTER)
-                          (FOLDERSTREAM POINTER)
-                          (MESSAGEDESCRIPTORS POINTER)
-                          (FOLDERLOCK POINTER)
-                          (%#OFMESSAGES WORD)
-                          (TOCLASTMESSAGE# WORD)
-                          (BROWSERFONTHEIGHT WORD)
-                          (BROWSERFONTASCENT WORD)
-                          (BROWSERFONTDESCENT WORD)
-                          (BROWSERMAXXPOS WORD)
-                          (ORDINALXPOS WORD)
-                          (DATEXPOS WORD)
-                          (FROMXPOS WORD)
-                          (FROMMAXXPOS WORD)
-                          (SUBJECTXPOS WORD)
-                          (BROWSERDIGITWIDTH WORD)
-                          (FIRSTSELECTEDMESSAGE WORD)
-                          (LASTSELECTEDMESSAGE WORD)
-                          (FIRSTCHANGEDMESSAGE WORD)
-                          (CURRENTPROMPTLINE WORD)
-                          (CURRENTDISPLAYEDSTREAM POINTER)
-                          (BROWSEREXTENT POINTER)
-                          (BROWSERORIGIN POINTER)
-                          (FOLDERDISPLAYREGION POINTER)
-                          (BROWSERWINDOW POINTER)
-                          (BROWSERMENU POINTER)
-                          (BROWSERMENUWINDOW POINTER)
-                          (BROWSERPROMPTWINDOW POINTER)
-                          (ORIGINALBROWSERTITLE POINTER)
-                          (FOLDERDISPLAYWINDOWS POINTER)
-                          (FOLDEREOFPTR POINTER)
-                          (DEFAULTMOVETOFILE POINTER)
-                          (CURRENTDISPLAYEDMESSAGE POINTER)
-                          (BROWSERUPDATEFROMHERE POINTER)
-                          (BROWSERLAYOUT POINTER)
-                          (FOLDERCREATIONDATE POINTER)
-                          (HARDCOPYMESSAGES POINTER)
-                          (HARDCOPYSTREAM POINTER)))
+                      (BROWSERPROMPTGREW FLAG)
+                      (FOLDERNEEDSUPDATE FLAG)
+                      (FOLDERNEEDSEXPUNGE FLAG)
+                      (FOLDERBEINGUPDATED FLAG)
+                      (BROWSERSTATUS BITS 3)
+                      (FULLFOLDERNAME POINTER)
+                      (FOLDEROKTOSHRINK FLAG)
+                      (FOLDERGETSMAIL FLAG)
+                      (FOLDEROUTOFORDER FLAG)
+                      (NIL 5 FLAG)
+                      (VERSIONLESSFOLDERNAME POINTER)
+                      (SHORTFOLDERNAME POINTER)
+                      (FOLDERSTREAM POINTER)
+                      (MESSAGEDESCRIPTORS POINTER)
+                      (FOLDERLOCK POINTER)
+                      (%#OFMESSAGES WORD)
+                      (TOCLASTMESSAGE# WORD)
+                      (BROWSERFONTHEIGHT WORD)
+                      (BROWSERFONTASCENT WORD)
+                      (BROWSERFONTDESCENT WORD)
+                      (BROWSERMAXXPOS WORD)
+                      (ORDINALXPOS WORD)
+                      (DATEXPOS WORD)
+                      (FROMXPOS WORD)
+                      (FROMMAXXPOS WORD)
+                      (SUBJECTXPOS WORD)
+                      (BROWSERDIGITWIDTH WORD)
+                      (FIRSTSELECTEDMESSAGE WORD)
+                      (LASTSELECTEDMESSAGE WORD)
+                      (FIRSTCHANGEDMESSAGE WORD)
+                      (CURRENTPROMPTLINE WORD)
+                      (CURRENTDISPLAYEDSTREAM POINTER)
+                      (BROWSEREXTENT POINTER)
+                      (BROWSERORIGIN POINTER)
+                      (FOLDERDISPLAYREGION POINTER)
+                      (BROWSERWINDOW POINTER)
+                      (BROWSERMENU POINTER)
+                      (BROWSERMENUWINDOW POINTER)
+                      (BROWSERPROMPTWINDOW POINTER)
+                      (ORIGINALBROWSERTITLE POINTER)
+                      (FOLDERDISPLAYWINDOWS POINTER)
+                      (FOLDEREOFPTR POINTER)
+                      (DEFAULTMOVETOFILE POINTER)
+                      (CURRENTDISPLAYEDMESSAGE POINTER)
+                      (BROWSERUPDATEFROMHERE POINTER)
+                      (BROWSERLAYOUT POINTER)
+                      (FOLDERCREATIONDATE POINTER)
+                      (HARDCOPYMESSAGES POINTER)
+                      (HARDCOPYSTREAM POINTER)))
 
 (DATATYPE LAFITEMSG
 ((PARSED? FLAG)
-                         (DELETED? FLAG)
-                         (SEEN? FLAG)
-                         (DATEKNOWN? FLAG)
-                         (DATEFETCHED? FLAG)
-                         (MODEBITS BITS 3)
-                         (MARKCHAR BYTE)
-                         (%# WORD)
-                         (BEGIN POINTER)
-                         (MESSAGELENGTH POINTER)
-                         (STAMPLENGTH WORD)
-                         (TOCLENGTH WORD)
-                         (MESSAGELENGTHCHANGED? FLAG)
-                         (SELECTED? FLAG)
-                         (MSGFROMMECHECKED? FLAG)
-                         (MSGFROMMETRUTH FLAG)
-                         (DATE POINTER)
-                         (NIL FLAG)
-                         (MARKSCHANGEDINFILE? FLAG)
-                         (MARKSCHANGEDINTOC? FLAG)
-                         (NIL FLAG)
-                         (FROM
 POINTER)
-                         (SUBJECT POINTER)
-                         (TO
 POINTER)
-                         (IDATE FIXP)))
+                     (DELETED? FLAG)
+                     (SEEN? FLAG)
+                     (DATEKNOWN? FLAG)
+                     (DATEFETCHED? FLAG)
+                     (MODEBITS BITS 3)
+                     (MARKCHAR BYTE)
+                     (%# WORD)
+                     (BEGIN POINTER)
+                     (MESSAGELENGTH POINTER)
+                     (STAMPLENGTH WORD)
+                     (TOCLENGTH WORD)
+                     (MESSAGELENGTHCHANGED? FLAG)
+                     (SELECTED? FLAG)
+                     (MSGFROMMECHECKED? FLAG)
+                     (MSGFROMMETRUTH FLAG)
+                     (DATE POINTER)
+                     (NIL FLAG)
+                     (MARKSCHANGEDINFILE? FLAG)
+                     (MARKSCHANGEDINTOC? FLAG)
+                     (NIL FLAG)
+                     (FROM
 POINTER)
+                     (SUBJECT POINTER)
+                     (TO
 POINTER)
+                     (IDATE FIXP)))
 )
 (DEFINEQ
 
@@ -827,8 +847,11 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(FILESLOAD LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL LAFITESORT TEDIT 
-       LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+(FILESLOAD TEDIT ATTACHEDWINDOW)
+
+
+(FILESLOAD LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-SEND LAFITE-MAIL LAFITE-SORT 
+       LAFITE-TEDIT LAFITE-FIND LAFITE-MAILSCAVENGE)
 
 
 (CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
@@ -864,7 +887,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
    ((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 
@@ -875,31 +898,29 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 
 (ADDTOVAR LAMA
 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 (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)))))
+  (FILEMAP (NIL (6983 22029 (LAFITE 6993 . 8304) (LAFITE.ON.FROM.BACKGROUND 8306 . 8677) (\LAFITE.OFF 
+8679 . 9063) (\LAFITE.START.PROC 9065 . 10841) (LAFITE.COMPUTE.CACHED.VARS 10843 . 13545) (
+\LAFITE.PROCESS 13547 . 13913) (\LAFITE.START.ABORT 13915 . 14107) (\LAFITE.QUIT 14109 . 14351) (
+\LAFITE.RESTART 14353 . 14486) (\LAFITE.SUBQUIT 14488 . 15786) (\LAFITE.QUIT.PROC 15788 . 18524) (
+\LAFITEDEFAULTHOST&DIR 18526 . 19336) (LAFITEDEFAULTHOST&DIR 19338 . 19508) (MAKELAFITECOMMANDWINDOW 
+19510 . 21149) (EXTRACTMENUCOMMAND 21151 . 21399) (DOMAINLAFITECOMMAND 21401 . 21550) (
+LAFITE.TOGGLE.SERVER.TRACE 21552 . 22027)) (22104 25072 (LAFITEMODE 22114 . 22594) (\LAFITE.INFER.MODE
+ 22596 . 22949) (\LAFITE.SHOW.MODE 22951 . 23188) (\LAFITE.MODE.TITLE 23190 . 23475) (
+LAFITE.SHOW.MODE.P 23477 . 23718) (LAFITE.ALL.MODES.P 23720 . 24063) (SET.LAFITE.MODE.INTERACTIVELY 
+24065 . 24647) (\LAFITE.COMPUTE.MODE.COMMANDS 24649 . 25070)) (25922 27678 (\LAFITE.LOGIN 25932 . 
+26314) (\LAFITE.LOGIN.NORESTART 26316 . 26422) (LAFITE.PROMPT.FOR.LOGIN 26424 . 27443) (
+\LAFITE.REAUTHENTICATE 27445 . 27676)) (35157 38599 (LAFITE.AROUNDEXIT 35167 . 35705) (
+\LAFITE.MARK.FOLDERS.OBSOLETE 35707 . 36623) (\LAFITE.CHECK.FOLDERS 36625 . 37024) (
+\LAFITE.ASSURE.FOLDER.READY 37026 . 37436) (\LAFITE.AFTERLOGIN 37438 . 38597)) (38631 41569 (
+LA.RESETSHADE 38641 . 39019) (LA.MENU.ITEM 39021 . 39439) (NTHMESSAGE 39441 . 39524) (
+\LAFITE.MAKE.MSGARRAY 39526 . 39956) (\LAFITE.ADDMESSAGES.TO.ARRAY 39958 . 40539) (
+\MAILFOLDER.DEFPRINT 40541 . 40788) (\LAFITEMSG.DEFPRINT 40790 . 40952) (LA.POSITION.FROM.REGION 40954
+ . 41431) (MAILFOLDERBUSY 41433 . 41567)) (41747 58135 (TOCFILENAME 41757 . 42188) (DELETEMAILFOLDER 
+42190 . 42710) (\LAFITE.OPEN.FOLDER 42712 . 47327) (\LAFITE.REPORT.FILE.WONT.OPEN 47329 . 48053) (
+\LAFITE.FOLDER.CHANGED 48055 . 50459) (\LAFITE.REBROWSE.FOLDER 50461 . 53426) (
+\LAFITE.FOLDER.CHANGED.MENU 53428 . 54351) (\LAFITE.SET.FOLDER.STREAM 54353 . 55047) (
+\LAFITE.OPENSTREAM 55049 . 55588) (\LAFITE.CREATE.MENU 55590 . 55943) (\LAFITE.EOF 55945 . 57287) (
+\LAFITE.CLOSE.FOLDER 57289 . 58133)) (58136 58720 (\LAFITE.DESCRIBE.FOLDER 58146 . 58718)) (58781 
+60618 (LOAD-LAFITE 58791 . 60616)) (68059 69336 (\LAFITE.GLOBAL.INIT 68069 . 69334)))))
 STOP

library/lafite/LAFITE-ABBREV

@@ -1,30 +1,47 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "11-Nov-88 19:37:06" |{NEWTON:EUROPARC:RX}<LOVSTRAND>LISP>MEDLEY>LAFITEABBREV.;1|
 5987   
 
-      changes to%:  (VARS LAFITEABBREVCOMS)
+
(FILECREATED "23-Feb-2024 23:14:08" {WMEDLEY}<library>lafite>LAFITE-ABBREV.;1
 6164   
 
-      previous date%: "22-Sep-88 13:06:40" |{NEWTON:EUROPARC:RX}<LOVSTRAND>LISP>LYRIC>LAFITEABBREV.;7|
-)
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "11-Nov-88 19:37:06" {WMEDLEY}<library>lafite>LAFITEABBREV.;1)
 
 
-(* "
-Copyright (c) 1988, 1901 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-ABBREVCOMS)
 
-(PRETTYCOMPRINT LAFITEABBREVCOMS)
+(RPAQQ LAFITE-ABBREVCOMS

+       ((APPENDVARS (LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT)
+                           ("*@*" "%"*%%*%":GV:Xerox" :IN)
+                           ("*@*" "*%%*:GV:Xerox")
+                           ("*@*.*" "*%%*:*:Xerox" :IN)
+                           ("*.pa" "*:PA:Xerox")))
+        (INITVARS (LAFITE.ABBREV.DIRECTIONS :BOTH)
+               (LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
+               (LAFITE.ABBREV.TRACE))
+        (FUNCTIONS SAFEUPPERCHARCODE)
+        (FNS LAFITE.ABBREV LAFITE.ABBREV.MATCH)
+        (ADVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
+               (PARSE.NSNAME :IN \NSMAIL.PARSE1))
+        (GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT 
+               LAFITE.ABBREV.TRACE)))
 
-(RPAQQ LAFITEABBREVCOMS ((APPENDVARS (LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT) ("*@*" "%"*%%*%":GV:Xerox" :IN) ("*@*" "*%%*:GV:Xerox") ("*@*.*" "*%%*:*:Xerox" :IN) ("*.pa" "*:PA:Xerox"))) (INITVARS (LAFITE.ABBREV.DIRECTIONS :BOTH) (LAFITE.ABBREV.MOVE.GAZE.RIGHT T) (LAFITE.ABBREV.TRACE)) (FUNCTIONS SAFEUPPERCHARCODE) (FNS LAFITE.ABBREV LAFITE.ABBREV.MATCH) (ADVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES) (PARSE.NSNAME :IN \NSMAIL.PARSE1)) (GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE)))
+(APPENDTOVAR LAFITE.ABBREVS
 ("*@*:*" "*@*:*" :OUT)
+                            ("*@*" "%"*%%*%":GV:Xerox" :IN)
+                            ("*@*" "*%%*:GV:Xerox")
+                            ("*@*.*" "*%%*:*:Xerox" :IN)
+                            ("*.pa" "*:PA:Xerox"))
 
-(APPENDTOVAR LAFITE.ABBREVS
 ("*@*:*" "*@*:*" :OUT) ("*@*" "%"*%%*%":GV:Xerox" :IN) ("*@*" "*%%*:GV:Xerox")
- ("*@*.*" "*%%*:*:Xerox" :IN) ("*.pa" "*:PA:Xerox"))
+(RPAQ? LAFITE.ABBREV.DIRECTIONS
 :BOTH)
 
-(RPAQ? LAFITE.ABBREV.DIRECTIONS :BOTH)
+(RPAQ? LAFITE.ABBREV.MOVE.GAZE.RIGHT
 T)
 
-(RPAQ? LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
+(RPAQ? LAFITE.ABBREV.TRACE
 )
 
-(RPAQ? LAFITE.ABBREV.TRACE)
-
-(DEFMACRO SAFEUPPERCHARCODE (CODE) (BQUOTE (if (AND (NUMBERP (\, CODE)) (LEQ (\, CODE) 255)) THEN (GETCASEARRAY UPPERCASEARRAY (\, CODE)) ELSE (\, CODE))))
+(DEFMACRO SAFEUPPERCHARCODE
 (CODE)
+   `(if
 (AND (NUMBERP ,CODE)
+             (LEQ ,CODE 255))
+        THEN
 (GETCASEARRAY UPPERCASEARRAY ,CODE)
+      ELSE
 ,CODE))
 (DEFINEQ
 
 (LAFITE.ABBREV

@@ -36,16 +53,22 @@ Copyright (c) 1988, 1901 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(XCL:REINSTALL-ADVICE (QUOTE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)) :AFTER (QUOTE ((:LAST (SETQ !VALUE (LAFITE.ABBREV !VALUE :IN))))))
+[XCL:REINSTALL-ADVICE '(NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
+       :AFTER
+       '((:LAST (SETQ !VALUE (LAFITE.ABBREV
 !VALUE :IN]
 
-(XCL:REINSTALL-ADVICE (QUOTE (PARSE.NSNAME :IN \NSMAIL.PARSE1)) :BEFORE (QUOTE ((:LAST (SETQ NAME (LAFITE.ABBREV NAME :OUT))))))
+[XCL:REINSTALL-ADVICE '(PARSE.NSNAME :IN \NSMAIL.PARSE1)
+       :BEFORE
+       '((:LAST (SETQ NAME (LAFITE.ABBREV
 NAME :OUT]
 
-(READVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES) (PARSE.NSNAME :IN \NSMAIL.PARSE1))
+(READVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
+       (PARSE.NSNAME :IN \NSMAIL.PARSE1))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE)
+(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE
+       )
 )
-(PUTPROPS LAFITEABBREV COPYRIGHT ("Xerox Corporation" 1988 1901))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1425 5397 (LAFITE.ABBREV 1435 . 3321) (LAFITE.ABBREV.MATCH 3323 . 5395)))))
+  (FILEMAP (NIL (1475 1652 (SAFEUPPERCHARCODE 1475 . 1652)) (1653 5625 (LAFITE.ABBREV 1663 . 3549) (
+LAFITE.ABBREV.MATCH 3551 . 5623)))))
 STOP

library/lafite/LAFITE-BROWSE

@@ -1,18 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "30-Sep-2021 22:58:57" 
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITEBROWSE.;1
 141883 
 
-      previous date%: "19-Feb-2001 09:26:50" 
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITEBROWSE.;1)
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-BROWSE.;2
 141738 
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-BROWSECOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 21:54:27" {WMEDLEY}<library>lafite>LAFITE-BROWSE.;1)
 
 
-(* ; "
-Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-BROWSECOMS)
 
-(PRETTYCOMPRINT LAFITEBROWSECOMS)
-
-(RPAQQ LAFITEBROWSECOMS

+(RPAQQ LAFITE-BROWSECOMS

        [(COMS                                                (* ; "BROWSE")

               (FNS \LAFITE.BROWSE \LAFITE.SUBBROWSE \LAFITE.BROWSE.PROC \LAFITE.BROWSE.FORGET 
                    LAFITE.BROWSE.FOLDER \LAFITE.PREPARE.BROWSER \LAFITE.MAYBE.OPEN.FOLDER 
@@ -78,7 +77,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
         (DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * TOCSTATES)
                [P (CL:PROCLAIM '(CL:SPECIAL \CURRENTDISPLAYLINE]
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
@@ -93,12 +92,13 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
 (DEFINEQ
 
 (\LAFITE.BROWSE

-  [LAMBDA (ITEM MENU BUTTON)
                             (* ; "Edited 17-Sep-87 19:13 by bvm:")

+  [LAMBDA (ITEM MENU BUTTON)
                                 (* ; "Edited 23-Feb-2024 21:53 by rmk")


+                                                             (* ; "Edited 17-Sep-87 19:13 by bvm:")

 
 (* ;;; "Function called by the Browse button on main Lafite window.")

 
     (LET [(SUBP (EQ BUTTON 'MIDDLE]                          (* ; 
-
     "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.")

+
       "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.")

          (\LAFITE.PROCESS `[,(COND
                                 (SUBP (FUNCTION \LAFITE.SUBBROWSE))
                                 (T (FUNCTION \LAFITE.BROWSE.PROC)))
@@ -106,7 +106,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
                             ',MENU
                             ,@(AND (NOT SUBP)
                                    '(NIL '(:CONFIRM]
-                'LAFITEBROWSE])
+                'LAFITE-BROWSE])
 
 (\LAFITE.SUBBROWSE

   [LAMBDA (ITEM MENU)
                                    (* ; "Edited  3-Sep-87 18:00 by bvm:")

@@ -633,8 +633,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
          MAINW])
 )
 
-(RPAQQ LAFITE.DUMMY.SHADE
 
-                            #*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
+(RPAQQ LAFITE.DUMMY.SHADE
 #*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
 
 (RPAQQ LAFITE.DUMMY.HALF.SHADE
 
                             #*(16 16)@H@@A@@D@@D@@DB@A@D@@@HDH@DB@@@DDD@A@B@DDHD@@D@@@@D@@H@D@@DJ@@@@)
@@ -2134,8 +2133,8 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
 )
 
 (RPAQQ LAFITE.FOLDER.ICON
 (#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@C@@@@@@@@L@@@@@@@@@@@@@@@@@@F@@@@@@@@F@@@@@@@@@@@@@@@@@@L@DA@@@@@C@@@@@@@@@@@@@@@@@@L@FC@@@@@C@@@@@@@@@@@@@@@@@@L@EE@HGB@C@@@@@@@@@@@@@@@@@@L@EEADBB@C@@@@@@@@@@@@@@@@@@L@DIBBBB@COOOOOOOOOOOOOOL@@@L@DACNBB@COOOOOOOOOOOOOOL@@@L@DABBGCL@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@FL@@@@@@@@@@@@@@@@@@@@@@C@@@CL@@@@@@@@@@@@@@@@@@@@@@C@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
-                               #*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
-                               (8 4 88 51)))
+                           #*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
+                           (8 4 88 51)))
 
 (RPAQ? LAFITEFROMFRACTION
 0.3)
 
@@ -2191,7 +2190,7 @@ and delete the file(s) containing it."
                              "Specify which subgroups should also appear at top level."])
 
 (RPAQQ LAFITEBROWSERICONMENUITEMS
 (("Get Mail" '\LAFITE.GETMAIL.FROM.ICON 
-                                              "Open this window and retrieve new mail into it")))
+                                          "Open this window and retrieve new mail into it")))
 
 (RPAQ? LAFITESUBBROWSEMENU
 )
 
@@ -2206,10 +2205,10 @@ and delete the file(s) containing it."
 (ADDTOVAR LAFITEMENUVARS
 LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU)
 
 (ADDTOVAR LAFITEEXTRAMENUITEMS
 ("Describe Folder" '\LAFITE.DESCRIBE.FOLDER 
-                                          "Display some relevant info about this folder"
-                                          (SUBITEMS ("Inspect Folder" 'INSPECT 
+                                      "Display some relevant info about this folder"
+                                      (SUBITEMS ("Inspect Folder" 'INSPECT 
                                  "Inspect the MAILFOLDER data structure associated with this browser"
-                                                           ))))
+                                                       ))))
 
 (RPAQQ BROWSERMARKXPOSITION
 8)
 
@@ -2224,13 +2223,13 @@ and delete the file(s) containing it."
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
 (RPAQQ TOCSTATES
 ((TS.IDLE 0)
-                      (TS.REPLACING 1)
-                      (TS.ADDING 2)
-                      (TS.REMOVING 3)
-                      (TS.EXTENDING.HI 4)
-                      (TS.EXTENDING.LO 5)
-                      (TS.SHRINKING.HI 6)
-                      (TS.SHRINKING.LO 7)))
+                  (TS.REPLACING 1)
+                  (TS.ADDING 2)
+                  (TS.REMOVING 3)
+                  (TS.EXTENDING.HI 4)
+                  (TS.EXTENDING.LO 5)
+                  (TS.SHRINKING.HI 6)
+                  (TS.SHRINKING.LO 7)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ TS.IDLE
 0)
@@ -2265,7 +2264,7 @@ and delete the file(s) containing it."
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -2280,36 +2279,35 @@ and delete the file(s) containing it."
 
 (ADDTOVAR LAMA
 LAB.MOUSECONFIRM LAB.FORMAT LAB.PROMPTPRINT)
 )
-(PUTPROPS LAFITEBROWSE COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1999 2001 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5768 31473 (\LAFITE.BROWSE 5778 . 6525) (\LAFITE.SUBBROWSE 6527 . 6864) (
-\LAFITE.BROWSE.PROC 6866 . 7959) (\LAFITE.BROWSE.FORGET 7961 . 8507) (LAFITE.BROWSE.FOLDER 8509 . 
-10444) (\LAFITE.PREPARE.BROWSER 10446 . 12612) (\LAFITE.MAYBE.OPEN.FOLDER 12614 . 16056) (
-LAB.LOADFOLDER 16058 . 16553) (LAB.DISPLAYFOLDER 16555 . 18126) (LAB.MAKE.INITIAL.SELECTION 18128 . 
-19364) (LAB.CREATEWINDOW 19366 . 27821) (LAB.TITLE.STRING 27823 . 29588) (LAB.COMMANDFN 29590 . 30120)
- (LAB.DO.COMMAND 30122 . 31099) (LAB.ASSURE.SELECTIONS 31101 . 31471)) (31474 41387 (
-BUILD.LAFITE.LAYOUTS 31484 . 37742) (\LAFITE.LAYOUT.FROM.WINDOW 37744 . 40224) (
-\LAFITE.MAKE.DUMMY.WINDOWS 40226 . 41385)) (41813 67265 (LAB.SETUP 41823 . 48008) (LAB.BUTTONEVENTFN 
-48010 . 48540) (LAB.DO.UNLESS.BUSY 48542 . 49038) (LOADMAILFOLDER 49040 . 50323) (LAFITE.OBTAIN.FOLDER
- 50325 . 59227) (\LAFITE.FIND.EXISTING.FOLDER 59229 . 60076) (\LAFITE.CONFLICTING.OLD.FOLDER 60078 . 
-61249) (LAB.REPAINTFN 61251 . 61876) (LAB.SCROLLFN 61878 . 62466) (LAB.RESHAPEFN 62468 . 63761) (
-LAB.CLOSEFN 63763 . 63932) (LAB.SHRINKFN 63934 . 64098) (LAB.CLOSE/SHRINK 64100 . 65685) (LAB.EXPANDFN
- 65687 . 66931) (LAFITEEXTRABROWSERCOMMANDFN 66933 . 67263)) (67300 85005 (LAB.SELECTMESSAGE 67310 . 
-80668) (LAB.CHANGEMARK 80670 . 82271) (LA.READ.NEW.MARK 82273 . 84056) (YPOS.TO.MESSAGE# 84058 . 84666
-) (MESSAGE#.TO.YPOS 84668 . 85003)) (85006 93673 (LA.CONSIDERRANGE 85016 . 85700) (LA.DECONSIDERRANGE 
-85702 . 86118) (LA.RECONSIDERRANGE 86120 . 86824) (LA.SELECTRANGE 86826 . 88162) (LA.DESELECTRANGE 
-88164 . 90242) (LAB.FIND.SELECTED.MSG 90244 . 90621) (LAB.REV.FIND.SELECTED.MSG 90623 . 91108) (
-LA.UNDOSELECTION 91110 . 91404) (LA.VERIFY.SELECTION 91406 . 93671)) (93674 100537 (
-LAB.COPYBUTTONEVENTFN 93684 . 98889) (LAB.SHOW.COPY.SELECTION 98891 . 100535)) (100744 108238 (
-LAB.PROMPTPRINT 100754 . 100933) (LAB.FORMAT 100935 . 101372) (LAB.MOUSECONFIRM 101374 . 101837) (
-LAB.PRINT.TO.PROMPTWINDOW 101839 . 104988) (LAB.PAGEFULLFN 104990 . 106042) (
-\LAFITE.MAYBE.CLEAR.PROMPT 106044 . 108236)) (108462 129133 (PRINTMESSAGESUMMARY 108472 . 113229) (
-FIRSTVISIBLEMESSAGE 113231 . 114251) (LASTVISIBLEMESSAGE 114253 . 115442) (LAB.DISPLAYLINES 115444 . 
-117686) (LAB.EXPOSEMESSAGE 117688 . 118795) (LAB.SELECTED.MESSAGES 118797 . 119059) (
-UNSELECTALLMESSAGES 119061 . 119547) (SELECTMESSAGE 119549 . 119841) (LAB.GO.TO.MESSAGE 119843 . 
-121152) (MARKMESSAGE 121154 . 122201) (LAB.MARKS.CHANGED 122203 . 123010) (LA.SHOW.MARK 123012 . 
-123657) (LA.INVERT.MARK.BOX 123659 . 124228) (LA.BLT.MARK.BOX 124230 . 124736) (LA.SHOW.DELETION 
-124738 . 125642) (LA.SHOW.SELECTION 125644 . 126208) (SEENMESSAGE 126210 . 126996) (DELETEMESSAGE 
-126998 . 127406) (UNDELETEMESSAGE 127408 . 128287) (LAB.SET.EXPUNGEABILITY 128289 . 129131)) (129370 
-132578 (LAB.ICONFN 129380 . 131073) (LAB.ICON.BUTTONEVENTFN 131075 . 132576)))))
+  (FILEMAP (NIL (5688 31509 (\LAFITE.BROWSE 5698 . 6561) (\LAFITE.SUBBROWSE 6563 . 6900) (
+\LAFITE.BROWSE.PROC 6902 . 7995) (\LAFITE.BROWSE.FORGET 7997 . 8543) (LAFITE.BROWSE.FOLDER 8545 . 
+10480) (\LAFITE.PREPARE.BROWSER 10482 . 12648) (\LAFITE.MAYBE.OPEN.FOLDER 12650 . 16092) (
+LAB.LOADFOLDER 16094 . 16589) (LAB.DISPLAYFOLDER 16591 . 18162) (LAB.MAKE.INITIAL.SELECTION 18164 . 
+19400) (LAB.CREATEWINDOW 19402 . 27857) (LAB.TITLE.STRING 27859 . 29624) (LAB.COMMANDFN 29626 . 30156)
+ (LAB.DO.COMMAND 30158 . 31135) (LAB.ASSURE.SELECTIONS 31137 . 31507)) (31510 41423 (
+BUILD.LAFITE.LAYOUTS 31520 . 37778) (\LAFITE.LAYOUT.FROM.WINDOW 37780 . 40260) (
+\LAFITE.MAKE.DUMMY.WINDOWS 40262 . 41421)) (41820 67272 (LAB.SETUP 41830 . 48015) (LAB.BUTTONEVENTFN 
+48017 . 48547) (LAB.DO.UNLESS.BUSY 48549 . 49045) (LOADMAILFOLDER 49047 . 50330) (LAFITE.OBTAIN.FOLDER
+ 50332 . 59234) (\LAFITE.FIND.EXISTING.FOLDER 59236 . 60083) (\LAFITE.CONFLICTING.OLD.FOLDER 60085 . 
+61256) (LAB.REPAINTFN 61258 . 61883) (LAB.SCROLLFN 61885 . 62473) (LAB.RESHAPEFN 62475 . 63768) (
+LAB.CLOSEFN 63770 . 63939) (LAB.SHRINKFN 63941 . 64105) (LAB.CLOSE/SHRINK 64107 . 65692) (LAB.EXPANDFN
+ 65694 . 66938) (LAFITEEXTRABROWSERCOMMANDFN 66940 . 67270)) (67307 85012 (LAB.SELECTMESSAGE 67317 . 
+80675) (LAB.CHANGEMARK 80677 . 82278) (LA.READ.NEW.MARK 82280 . 84063) (YPOS.TO.MESSAGE# 84065 . 84673
+) (MESSAGE#.TO.YPOS 84675 . 85010)) (85013 93680 (LA.CONSIDERRANGE 85023 . 85707) (LA.DECONSIDERRANGE 
+85709 . 86125) (LA.RECONSIDERRANGE 86127 . 86831) (LA.SELECTRANGE 86833 . 88169) (LA.DESELECTRANGE 
+88171 . 90249) (LAB.FIND.SELECTED.MSG 90251 . 90628) (LAB.REV.FIND.SELECTED.MSG 90630 . 91115) (
+LA.UNDOSELECTION 91117 . 91411) (LA.VERIFY.SELECTION 91413 . 93678)) (93681 100544 (
+LAB.COPYBUTTONEVENTFN 93691 . 98896) (LAB.SHOW.COPY.SELECTION 98898 . 100542)) (100751 108245 (
+LAB.PROMPTPRINT 100761 . 100940) (LAB.FORMAT 100942 . 101379) (LAB.MOUSECONFIRM 101381 . 101844) (
+LAB.PRINT.TO.PROMPTWINDOW 101846 . 104995) (LAB.PAGEFULLFN 104997 . 106049) (
+\LAFITE.MAYBE.CLEAR.PROMPT 106051 . 108243)) (108469 129140 (PRINTMESSAGESUMMARY 108479 . 113236) (
+FIRSTVISIBLEMESSAGE 113238 . 114258) (LASTVISIBLEMESSAGE 114260 . 115449) (LAB.DISPLAYLINES 115451 . 
+117693) (LAB.EXPOSEMESSAGE 117695 . 118802) (LAB.SELECTED.MESSAGES 118804 . 119066) (
+UNSELECTALLMESSAGES 119068 . 119554) (SELECTMESSAGE 119556 . 119848) (LAB.GO.TO.MESSAGE 119850 . 
+121159) (MARKMESSAGE 121161 . 122208) (LAB.MARKS.CHANGED 122210 . 123017) (LA.SHOW.MARK 123019 . 
+123664) (LA.INVERT.MARK.BOX 123666 . 124235) (LA.BLT.MARK.BOX 124237 . 124743) (LA.SHOW.DELETION 
+124745 . 125649) (LA.SHOW.SELECTION 125651 . 126215) (SEENMESSAGE 126217 . 127003) (DELETEMESSAGE 
+127005 . 127413) (UNDELETEMESSAGE 127415 . 128294) (LAB.SET.EXPUNGEABILITY 128296 . 129138)) (129377 
+132585 (LAB.ICONFN 129387 . 131080) (LAB.ICON.BUTTONEVENTFN 131082 . 132583)))))
 STOP

library/lafite/LAFITE-COMMANDS

@@ -1,22 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Feb-2022 12:04:09" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;2
 164626 
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2
 164484 
 
-      :CHANGES-TO (FILES LAFITEDECLS)
-                  (FNS \LAFITE.HARDCOPY.PROC \LAFITE.HARDCOPY.HEADERS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "30-Sep-2021 22:58:57" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;1)
+      :CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
 
 
-(* ; "
-Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
 
-(PRETTYCOMPRINT LAFITECOMMANDSCOMS)
-
-(RPAQQ LAFITECOMMANDSCOMS

+(RPAQQ LAFITE-COMMANDSCOMS

        [
         (* ;; "Handling of the main Lafite browser commands")

 
@@ -107,7 +102,7 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
               (COMS                                          (* ; "Obsolete")

                     (INITVARS (LAFITEDISPLAYREGION (CREATEREGION 375 25 600 335]
         (DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                  LAFITEDECLS)
+                                                  LAFITE-DECLS)
                (LOCALVARS . T))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
@@ -235,7 +230,8 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
                                                  LAST#])
 
 (MESSAGEDISPLAYER

-  [LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG)
       (* ; "Edited 24-Jun-99 15:34 by rmk:")


+  [LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG)
           (* ; "Edited 14-Jan-2024 16:33 by rmk")


+                                                             (* ; "Edited 24-Jun-99 15:34 by rmk:")


                                                              (* ; "Edited 24-Jun-99 15:32 by rmk:")


                                                              (* ; "Edited 24-Jun-99 15:32 by rmk:")


                                                              (* ; "Edited  6-Aug-93 18:48 by bvm")

@@ -251,25 +247,23 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
          (* ;; "WINDOWPROPS for when we finally give TEdit a window: READONLY in order to avoid TEdit's odd temptation to display an ugly caret at the start and prevent mouse actions from yielding %"NewEditProcess%" menu; PROMPTWINDOW to inhibit attaching a prompt window.  Due to a TEdit bug, you can't give the PROMPTWINDOW prop when opening without a window or it will try to make the symbol DON'T be the promptwindow later on.")

 
          (if
 (AND \LAPARSE.DONT.DISPLAY.HEADERS (NEQ EOF 0)
-                      (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTFILE \LAPARSE.DONT.DISPLAY.HEADERS
-                                            0)))
-             then
                                        (* ; 
-
                                  "We will filter some headers out, so put * in title to show this")

-                   (SETQ TITLE (CONCAT "*" TITLE)))
+                  (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTFILE \LAPARSE.DONT.DISPLAY.HEADERS 0)))
+             then
                                            (* ; 
+
                                    "We will filter some headers out, so put * in title to show this")

+                  (SETQ TITLE (CONCAT "*" TITLE)))
          [COND
             ((AND (NOT NEWWINDOWFLG)
                   (SETQ DISPLAYWINDOW (CAR CURRENTWINDOWS)))
              (MAPC (WINDOWPROP DISPLAYWINDOW 'EXTRAWINDOWS NIL)
                    (FUNCTION CLOSEW))                        (* ; 
-
                                                 "Get rid of extra windows produced by attachments")

+
                                                   "Get rid of extra windows produced by attachments")

              (CLEARW DISPLAYWINDOW)
              (WINDOWPROP DISPLAYWINDOW 'TITLE TITLE))
             (T (SETQ DISPLAYWINDOW (CREATEW (COND
                                                [(AND (NOT NEWWINDOWFLG)
                                                      (PROGN  (* ; 
-
                                              "This says where we'd like the primary window to be.")

-                                                            (fetch
 (MAILFOLDER 
-                                                                              FOLDERDISPLAYREGION)
+
                                                "This says where we'd like the primary window to be.")

+                                                            (fetch
 (MAILFOLDER FOLDERDISPLAYREGION)
                                                                of
 MAILFOLDER]
                                                (LAFITE.DISPLAY.SIZE 
                                                              (* ; "Global default")

@@ -283,23 +277,23 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
                   [(NOT CURRENTWINDOWS)
                    (replace
 (MAILFOLDER FOLDERDISPLAYWINDOWS) of
 MAILFOLDER
                       with
 (if
 NEWWINDOWFLG
-                                   then
                  (* ; 
-
                                               "not primary, even though no window previously open")

-                                         (LIST NIL DISPLAYWINDOW)
-                                 else
 (LIST DISPLAYWINDOW]
+                               then
                          (* ; 
+
                                                 "not primary, even though no window previously open")

+                                    (LIST NIL DISPLAYWINDOW)
+                             else
 (LIST DISPLAYWINDOW]
                   [NEWWINDOWFLG (RPLACD CURRENTWINDOWS (CONS DISPLAYWINDOW (CDR CURRENTWINDOWS]
                   (T                                         (* ; 
-
       "DIsplaying the primary window for the first time when there are already secondary windows.")

+
         "DIsplaying the primary window for the first time when there are already secondary windows.")

                      (RPLACA CURRENTWINDOWS DISPLAYWINDOW]   (* ; "Now let TEDIT display it")

          [COND
             ((EQ EOF 0)
              (LAB.PROMPTPRINT MAILFOLDER "Message is empty"))
             (T [LET (WINDOW)
                     (if
 (NOT FILTERED)
-                        then
                             (* ; 
-
                                                           "Go ahead and display it right off. ")

-                              (SETQ PROPS (NCONC PROPS WINDOWPROPS))
-                              (SETQ WINDOW DISPLAYWINDOW))
+                        then
                                 (* ; 
+
                                                             "Go ahead and display it right off. ")

+                             (SETQ PROPS (NCONC PROPS WINDOWPROPS))
+                             (SETQ WINDOW DISPLAYWINDOW))
                     (SETQ TEXTSTREAM (OR (CAR (NLSETQ (OPENTEXTSTREAM TEXTFILE WINDOW NIL NIL PROPS))
                                               )
                                          (PROGN (LAB.PROMPTPRINT MAILFOLDER T 
@@ -309,34 +303,36 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
                                                        (LIST* 'CLEARGET T PROPS]
                (if
 FILTERED
                    then
 (if
 (NOT (= EOF (GETEOFPTR TEXTSTREAM)))
-                                then
                     (* ; 
-
                  "rats, there may have been nschars in the header, so parse it now more carefully")

-                                      (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTSTREAM 
-                                                            \LAPARSE.DONT.DISPLAY.HEADERS 0)))
-                         (\LAFITE.HIDE.HEADERS
 TEXTSTREAM FILTERED) 
+                            then
                             (* ; 
+
                    "rats, there may have been nschars in the header, so parse it now more carefully")

+                                 (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTSTREAM 
+                                                       \LAPARSE.DONT.DISPLAY.HEADERS 0)))
+                        (\LAFITE.HIDE.HEADERS
 TEXTSTREAM FILTERED) 
                                                              (* ; 
-
                                                     "Now we can display it without a major glitch")

-                         (OPENTEXTSTREAM TEXTSTREAM DISPLAYWINDOW NIL NIL WINDOWPROPS)
-                         (TEXTPROP TEXTSTREAM 'FILTERED FILTERED) 
+
                                                       "Now we can display it without a major glitch")

+                        (OPENTEXTSTREAM TEXTSTREAM DISPLAYWINDOW NIL NIL WINDOWPROPS)
+                        (TEXTPROP TEXTSTREAM 'FILTERED FILTERED) 
                                                              (* ; 
-
                                              "Remember what's invisible, so we can easily undo it")

-                      )
+
                                                "Remember what's invisible, so we can easily undo it")

+                   )
                (COND
                   (LAFITEENDOFMESSAGESTR                     (* ; 
-
                   "Add %"End of message%" token.  Have to take away READONLY for a moment here...")

+
                     "Add %"End of message%" token.  Have to take away READONLY for a moment here...")

                          (TEXTPROP TEXTSTREAM 'READONLY NIL)
                          [SETFILEPTR TEXTSTREAM (SUB1 (SETQ EOF (GETEOFPTR TEXTSTREAM]
                          (COND
                             ((NEQ (BIN TEXTSTREAM)
-                                  (CHARCODE CR))             (* ; 
-
                        "Message doesn't end in CR, so add one before inserting end of message str")

+                                  (CHARCODE EOL))            (* ; 
+
                         "Message doesn't end in EOL, so add one before inserting end of message str")

                              (TEDIT.INSERT TEXTSTREAM LAFITEEOL (ADD1 (add
 EOF 1))
                                     NIL T)))
                          (TEDIT.INSERT TEXTSTREAM LAFITEENDOFMESSAGESTR (ADD1 EOF)
                                 LAFITEENDOFMESSAGEFONT T)
                          (TEXTPROP TEXTSTREAM 'READONLY T)
                          (TEDIT.SETSEL TEXTSTREAM 1 0)
-                         (\CARET.DOWN)                       (* ; "Patch around TEdit bug")

+                         (TEXTPROP TEXTSTREAM 'DIRTY NIL)
+                         (AND NIL (\CARET.DOWN))             (* ; 
+
                                                         "Patch around TEdit bug--probably fixed now")

                          ]
          DISPLAYWINDOW])
 
@@ -2534,7 +2530,7 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -2549,39 +2545,38 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation.
 
 (ADDTOVAR LAMA
 LAFITE.HARDCOPY.MESSAGES)
 )
-(PUTPROPS LAFITECOMMANDS COPYRIGHT ("Xerox Corporation" 1988 1989 1992 1993 1999 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7934 27602 (\LAFITE.DISPLAY 7944 . 9649) (\LAFITE.DO.DISPLAY 9651 . 13816) (
-SELECTMESSAGETODISPLAY 13818 . 16186) (MESSAGEDISPLAYER 16188 . 23604) (LA.COPY.MESSAGE.TEXT 23606 . 
-24360) (\LAFITE.CLOSE.DISPLAYWINDOWS 24362 . 25956) (\LAFITE.CLOSE.DISPLAYER 25958 . 27600)) (27603 
-36195 (\LAFITE.UNHIDE.HEADERS 27613 . 28703) (\LAFITE.HIDE.HEADERS 28705 . 29358) (
-\LAFITE.REHIDE.HEADERS 29360 . 30396) (LAFITE.EAT.UNDESIRABLE.FIELD 30398 . 31157) (LAFITE.EAT.GVGV 
-31159 . 32320) (\LAFITE.HARDCOPY.FROM.DISPLAY 32322 . 35841) (LAFITE.HARDCOPY.TAB.WIDTH 35843 . 36193)
-) (36196 44499 (\LAFITE.SET.LOOKS.FROM.MENU 36206 . 36383) (\LAFITE.SET.DEFAULT.LOOKS 36385 . 36576) (
-\LAFITE.SET.FIXED.LOOKS 36578 . 36770) (LAFITE.SET.LOOKS 36772 . 41229) (LAFITE.SET.TAB.LOOKS 41231 . 
-41942) (LAFITE.SET.PARA.SEPARATION 41944 . 42152) (LAFITE.SET.LOWER.CASE 42154 . 43005) (
-LAFITE.SUBSTITUTE.VP.EOL 43007 . 44497)) (46416 54744 (LAFITE.DELETE.MESSAGES 46426 . 47476) (
-\LAFITE.DELETE 47478 . 48665) (DISPLAYAFTERDELETE 48667 . 53393) (\LAFITE.SELECT.NEXT 53395 . 54033) (
-\LAFITE.UNDELETE 54035 . 54742)) (54766 69261 (LAFITE.MOVE.MESSAGES 54776 . 55423) (\COERCE.TO.MSGLST 
-55425 . 56183) (\LAFITE.MOVETO 56185 . 60129) (\LAFITE.COPYTO 60131 . 60547) (\LAFITE.MOVETO.PROC 
-60549 . 61819) (\LAFITE.MOVE.MESSAGES.INTERNAL 61821 . 69259)) (69287 77839 (\LAFITE.ENABLE.MOVE.MENU 
-69297 . 70339) (\LAFITE.ADD.TO.MOVE.MENU 70341 . 71357) (\LAFITE.UPDATE.MOVE.MENU 71359 . 75999) (
-\LAFITE.RESTORE.MOVE.MENU 76001 . 76677) (\LAFITE.HANDLE.AUTO.MOVE 76679 . 77837)) (78695 96179 (
-\LAFITE.UPDATE 78705 . 84338) (\LAFITE.EXPUNGE.PROC 84340 . 85145) (\LAFITE.UPDATE.PROC 85147 . 86230)
- (\LAFITE.HARDCOPYONLY.PROC 86232 . 86674) (LAB.CHOOSE.UPDATE.MENU 86676 . 87457) (
-LAB.CREATE.UPDATE.MENU 87459 . 89358) (LAB.UPDATE.NEEDED? 89360 . 90930) (\LAFITE.START.UPDATE 90932
- . 91964) (LAB.START.COMMAND 91966 . 92816) (\LAFITE.FINISH.UPDATE 92818 . 95071) (
-\LAFITE.CLOSE.OTHER.FOLDERS 95073 . 96177)) (96180 130974 (LAB.FLUSHWINDOW 96190 . 97869) (
-LAB.APPENDMESSAGES 97871 . 101033) (\LAFITE.COMPACT.FOLDER 101035 . 105199) (\LAFITE.COMPACT.FOLDER1 
-105201 . 121240) (\LAFITE.COMPACT.FOLDER2 121242 . 125956) (\LAFITE.COMPACT.EXTRA 125958 . 128273) (
-\LAFITE.INVALIDATE.TOC 128275 . 128968) (\LAFITE.RENAMEFILE 128970 . 129440) (SMART-RENAMEFILEP 129442
- . 130002) (LA.OPENTEMPFILE 130004 . 130972)) (130975 144317 (\LAFITE.UPDATE.FOLDER 130985 . 132962) (
-\LAFITE.UPDATE.CONTENTS 132964 . 133681) (\LAFITE.UPDATE.CONTENTS1 133683 . 138537) (WRITETOCENTRY 
-138539 . 141657) (WRITETOCMARKBYTES 141659 . 141901) (WRITEFOLDERMARKBYTES 141903 . 144315)) (144343 
-163318 (LAFITE.HARDCOPY.MESSAGES 144353 . 144813) (\LAFITE.HARDCOPY 144815 . 145150) (
-\LAFITE.HARDCOPY.PROC 145152 . 148630) (\LAFITE.HARDCOPY.HEADERS 148632 . 153961) (
-\LAFITE.MARK.HARDCOPIED 153963 . 155673) (\LAFITE.TRANSMIT.HARDCOPY 155675 . 157265) (
-\LAFITE.HARDCOPY.BODIES 157267 . 158509) (\LAFITE.APPEND.MESSAGE.BODY 158511 . 160619) (
-\LAFITE.DO.PENDING.HARDCOPY 160621 . 161696) (\LAFITE.CANCEL.HARDCOPY 161698 . 162414) (
-\LAFITE.CLEAR.HARDCOPY.STATE 162416 . 163316)))))
+  (FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) (
+SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 . 
+24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548 
+36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) (
+\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV 
+31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138)
+) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) (
+\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 . 
+41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) (
+LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) (
+\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) (
+\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST 
+55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC 
+60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU 
+69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) (
+\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 (
+\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175)
+ (\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) (
+LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877
+ . 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) (
+\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) (
+LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1 
+105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) (
+\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387
+ . 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) (
+\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY 
+138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288 
+163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) (
+\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) (
+\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) (
+\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) (
+\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) (
+\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261)))))
 STOP

library/lafite/LAFITE-DECLS

@@ -1,260 +1,244 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "22-Aug-94 12:59:34" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;2
 37889  
 
-      changes to%:  (VARS LAFITEDECLSCOMS)
-                    (RECORDS LAFITEMSG)
+
(FILECREATED "26-Feb-2024 20:14:22" {WMEDLEY}<library>lafite>LAFITE-DECLS.;5
 35711  
 
-      previous date%: "21-Jun-89 12:10:42" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;1
-)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE.PROGRAMMER.ENTRIES)
+
+      :PREVIOUS-DATE "24-Feb-2024 12:01:11" {WMEDLEY}<library>lafite>LAFITE-DECLS.;4)
 
 
-(* ; "
-Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-DECLSCOMS)
 
-(PRETTYCOMPRINT LAFITEDECLSCOMS)
-
-(RPAQQ LAFITEDECLSCOMS
 ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP 
-                                   DEFAULTHOST&DIR MAILSERVER MAILSERVEROPS OPENEDMAILBOX OUTBOX 
-                                   PROFILEVAR)
-                            (COMS                            (* ; 
-
                                                      "characteristics of standard Laurel messages")

-                                  (CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
-                                         (LAFITESTAMPLENGTH 24)
-                                         (DELETEDFLAG (CHARCODE D))
-                                         (UNDELETEDFLAG (CHARCODE U))
-                                         (SEENFLAG (CHARCODE S))
-                                         (UNSEENFLAG (CHARCODE U))
-                                         (DUPLICATEMARK 128)))
-                            (COMS                            (* ; "Stuff for table of contents")

-                                  (CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
-                            (COMS                            (* ; 
-
                                         "Browser status values.  %"Ready%" values have low bit 1.")

-                                  (CONSTANTS LAS.READY LAS.LOGGED.OUT)
-                                  (CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
-                            (COMS                            (* ; 
-
                                          "Bits for figuring out which menu to use on Update, etc.")

-                                  (CONSTANTS (\HARDCOPY.MENU.BIT 1)
-                                         (\UPDATE.MENU.BIT 2)
-                                         (\TOC.MENU.BIT 4)
-                                         (\EXPUNGE.MENU.BIT 8)
-                                         (\SORT.MENU.BIT 16)
-                                         (\EXPUNGE&SORT.MENU.BIT 32)
-                                         (\CLOSE.MENU.BIT 64)
-                                         (\SHRINK.MENU.BIT 128)))
-                            (COMS                            (* ; 
-
                                            "For iterating over the selected messages of a browser")

-                                  (I.S.OPRS SELECTEDIN))
-                            (MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. 
-                                   MAYBEVERIFYMSG UNSEENMARKP)
-                            (COMS (GLOBALVARS * LAFITEGLOBALS)
-                                  [P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* 
-                                                          *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
+(RPAQQ LAFITE-DECLSCOMS

+       ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP DEFAULTHOST&DIR MAILSERVER
+               MAILSERVEROPS OPENEDMAILBOX OUTBOX PROFILEVAR)
+        (COMS                                                (* ; 
+
                                                        "characteristics of standard Laurel messages")

+              (CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
+                     (LAFITESTAMPLENGTH 24)
+                     (DELETEDFLAG (CHARCODE D))
+                     (UNDELETEDFLAG (CHARCODE U))
+                     (SEENFLAG (CHARCODE S))
+                     (UNSEENFLAG (CHARCODE U))
+                     (DUPLICATEMARK 128)))
+        (COMS                                                (* ; "Stuff for table of contents")

+              (CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
+        (COMS                                                (* ; 
+
                                           "Browser status values.  %"Ready%" values have low bit 1.")

+              (CONSTANTS LAS.READY LAS.LOGGED.OUT)
+              (CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
+        (COMS                                                (* ; 
+
                                            "Bits for figuring out which menu to use on Update, etc.")

+              (CONSTANTS (\HARDCOPY.MENU.BIT 1)
+                     (\UPDATE.MENU.BIT 2)
+                     (\TOC.MENU.BIT 4)
+                     (\EXPUNGE.MENU.BIT 8)
+                     (\SORT.MENU.BIT 16)
+                     (\EXPUNGE&SORT.MENU.BIT 32)
+                     (\CLOSE.MENU.BIT 64)
+                     (\SHRINK.MENU.BIT 128)))
+        (COMS                                                (* ; 
+
                                              "For iterating over the selected messages of a browser")

+              (I.S.OPRS SELECTEDIN))
+        (MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. MAYBEVERIFYMSG 
+               UNSEENMARKP)
+        (COMS (GLOBALVARS * LAFITEGLOBALS)
+              [P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
                                                              (* ; 
-
     "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")

-                                  (P * LAFITE.PROCLAMATIONS))
-                            (COMS                            (* ; 
-
                                "For debugging with Masterscope, here are fns not called from code")

-                                  (VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
-                                  (COMMANDS WHONOTLAFITE CHECKLAFITE))
-                            (DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP 
-                                                               WINDOWDELPROP PROCESSPROP TEXTPROP))))
+
       "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")

+              (P * LAFITE.PROCLAMATIONS))
+        (COMS                                                (* ; 
+
                                  "For debugging with Masterscope, here are fns not called from code")

+              (VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
+              (COMMANDS WHONOTLAFITE CHECKLAFITE))
+        (DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP WINDOWDELPROP PROCESSPROP 
+                                           TEXTPROP))))
 (DECLARE%: EVAL@COMPILE
 
 (RECORD LAFITEOPS
 (LAFITEMODE MODEINDEX SENDPARSER SENDER ANSWERER AUTHENTICATOR MESSAGEP 
-                             MESSAGE-FROM-SELFP LOGIN))
+                         MESSAGE-FROM-SELFP LOGIN))
 
-(RECORD LAFITEMODEDATA
 (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME 
-                                             FROMFIELD)
-                                  MAILSERVERS))
+(RECORD LAFITEMODEDATA
 (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME FROMFIELD)
+                              MAILSERVERS))
 
-(DATATYPE LAFITEMSG
 ((PARSED? FLAG)                      (* ; 
-
     "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")

-                         (DELETED? FLAG)                     (* ; 
-
                                                           "True if message marked for deletion")

-                         (SEEN? FLAG)                        (* ; "True if message is examined.")

-                         (DATEKNOWN? FLAG)                   (* ; 
-
                        "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")

-                         (DATEFETCHED? FLAG)                 (* ; 
-
                                             "True if IDATE field contains a date (could be guess)")

-                         (MODEBITS BITS 3)                   (* ; 
-
                                                           "Mode in which the message was received")

-                         (MARKCHAR BYTE)                     (* ; "Arbitrary mark byte")

-                         (%# WORD)                           (* ; "Ordinal number of message")

-                         (BEGIN POINTER)                     (* ; "Start of the whole message")

-                         (MESSAGELENGTH POINTER)             (* ; "Lengfth of whole message")

-                         (STAMPLENGTH WORD)                  (* ; 
-
                                                      "Number of bytes in file header (usually 24)")

-                         (TOCLENGTH WORD)                    (* ; 
-
                                                     "Number of bytes this message consumes on toc")

-                         (MESSAGELENGTHCHANGED? FLAG)        (* ; 
-
"True if we have decided that the true length of this message is different from what the file says")

-                         (SELECTED? FLAG)                    (* ; "True if msg currently selected")

-                         (MSGFROMMECHECKED? FLAG)            (* ; 
-
                                         "True if we have tested whether this message is from self")

-                         (MSGFROMMETRUTH FLAG)               (* ; "Is it?")

-                         (DATE POINTER)                      (* ; 
-
                                                           "The fields of the parse (strings)")

-                         (NIL FLAG)
-                         (MARKSCHANGEDINFILE? FLAG)
-                         (MARKSCHANGEDINTOC? FLAG)
-                         (NIL FLAG)
-                         (FROM
 POINTER)
-                         (SUBJECT POINTER)
-                         (TO
 POINTER)
-                         (IDATE FIXP)                        (* ; 
-
                                                           "Integer form of DATE (for sorting)")

-                         )
+(DATATYPE LAFITEMSG
 ((PARSED? FLAG)                          (* ; 
+
       "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")

+                     (DELETED? FLAG)                         (* ; 
+
                                                             "True if message marked for deletion")

+                     (SEEN? FLAG)                            (* ; "True if message is examined.")

+                     (DATEKNOWN? FLAG)                       (* ; 
+
                          "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")

+                     (DATEFETCHED? FLAG)                     (* ; 
+
                                               "True if IDATE field contains a date (could be guess)")

+                     (MODEBITS BITS 3)                       (* ; 
+
                                                             "Mode in which the message was received")

+                     (MARKCHAR BYTE)                         (* ; "Arbitrary mark byte")

+                     (%# WORD)                               (* ; "Ordinal number of message")

+                     (BEGIN POINTER)                         (* ; "Start of the whole message")

+                     (MESSAGELENGTH POINTER)                 (* ; "Lengfth of whole message")

+                     (STAMPLENGTH WORD)                      (* ; 
+
                                                        "Number of bytes in file header (usually 24)")

+                     (TOCLENGTH WORD)                        (* ; 
+
                                                       "Number of bytes this message consumes on toc")

+                     (MESSAGELENGTHCHANGED? FLAG)            (* ; 
+
  "True if we have decided that the true length of this message is different from what the file says")

+                     (SELECTED? FLAG)                        (* ; "True if msg currently selected")

+                     (MSGFROMMECHECKED? FLAG)                (* ; 
+
                                           "True if we have tested whether this message is from self")

+                     (MSGFROMMETRUTH FLAG)                   (* ; "Is it?")

+                     (DATE POINTER)                          (* ; "The fields of the parse (strings)")

+                     (NIL FLAG)
+                     (MARKSCHANGEDINFILE? FLAG)
+                     (MARKSCHANGEDINTOC? FLAG)
+                     (NIL FLAG)
+                     (FROM
 POINTER)
+                     (SUBJECT POINTER)
+                     (TO
 POINTER)
+                     (IDATE FIXP)                            (* ; 
+
                                                             "Integer form of DATE (for sorting)")

+                     )
 
-                        (* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")

+                    (* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")

 
-                        (BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
+                    (BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
                                                              (* ; "For toc version 8")

-                                                (DATEBITS BITS 2)
-                                                             (* ; "For toc version 10")

-                                                (NIL BITS 3)
-                                                (NIL BYTE)
-                                                (NIL WORD)))
-                        (BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
-                                                (NIL BYTE)
-                                                (NIL WORD)
-                                                (NIL BITS 4)
-                                                (NIL POINTER)
-                                                (NIL BITS 4)
-                                                (NIL POINTER)
-                                                (NIL WORD)
-                                                (NIL WORD)
-                                                (NIL BITS 4)
-                                                (NIL POINTER)
-                                                (NIL BITS 1)
-                                                (MARKSCHANGEDBITS BITS 2)
-                                                (NIL BITS 1)
-                                                (NIL 3 POINTER)
-                                                (IDATEHI WORD)
-                                                (IDATELO WORD)))
-                        [ACCESSFNS LAFITEMSG ((END (+ (fetch
 (LAFITEMSG MESSAGELENGTH)
-                                                         of
 DATUM)
-                                                      (fetch
 (LAFITEMSG BEGIN) of
 DATUM)))
-                                              (START (+ (fetch
 (LAFITEMSG BEGIN) of
 DATUM)
-                                                        (fetch
 (LAFITEMSG STAMPLENGTH)
-                                                           of
 DATUM)))
-                                              (MSGFROMMEP (COND
-                                                             ((fetch
 (LAFITEMSG MSGFROMMECHECKED?
-                                                                                ) of
 DATUM)
-                                                              (fetch
 (LAFITEMSG MSGFROMMETRUTH)
-                                                                 of
 DATUM))
-                                                             (T (LA.MSGFROMMEP DATUM)))
-                                                     (PROG1 (replace
 (LAFITEMSG MSGFROMMETRUTH)
-                                                               of
 DATUM with
 NEWVALUE)
-                                                         (replace
 (LAFITEMSG MSGFROMMECHECKED?)
-                                                            of
 DATUM with
 T)))
-                                              (MARKSCHANGED? (NEQ 0 (fetch
 (LAFITEMSG 
-                                                                                     MARKSCHANGEDBITS
-                                                                                      ) of
 DATUM)
-                                                                  )
-                                                     (replace
 (LAFITEMSG MARKSCHANGEDBITS)
-                                                        of
 DATUM with
 3))
-                                              (MODE (CL:NTH (fetch
 (LAFITEMSG MODEBITS)
-                                                               of
 DATUM)
-                                                           *LAFITE-WELL-KNOWN-MODES*)
-                                                    (replace
 (LAFITEMSG MODEBITS) of
 DATUM
-                                                       WITH
 (OR (CL:POSITION NEWVALUE 
-                                                                           *LAFITE-WELL-KNOWN-MODES*)
-                                                                    0])
+                                            (DATEBITS BITS 2)(* ; "For toc version 10")

+                                            (NIL BITS 3)
+                                            (NIL BYTE)
+                                            (NIL WORD)))
+                    (BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
+                                            (NIL BYTE)
+                                            (NIL WORD)
+                                            (NIL BITS 4)
+                                            (NIL POINTER)
+                                            (NIL BITS 4)
+                                            (NIL POINTER)
+                                            (NIL WORD)
+                                            (NIL WORD)
+                                            (NIL BITS 4)
+                                            (NIL POINTER)
+                                            (NIL BITS 1)
+                                            (MARKSCHANGEDBITS BITS 2)
+                                            (NIL BITS 1)
+                                            (NIL 3 POINTER)
+                                            (IDATEHI WORD)
+                                            (IDATELO WORD)))
+                    [ACCESSFNS LAFITEMSG ((END (+ (fetch
 (LAFITEMSG MESSAGELENGTH) of
 DATUM)
+                                                  (fetch
 (LAFITEMSG BEGIN) of
 DATUM)))
+                                          (START (+ (fetch
 (LAFITEMSG BEGIN) of
 DATUM)
+                                                    (fetch
 (LAFITEMSG STAMPLENGTH) of
 DATUM)))
+                                          (MSGFROMMEP (COND
+                                                         ((fetch
 (LAFITEMSG MSGFROMMECHECKED?)
+                                                             of
 DATUM)
+                                                          (fetch
 (LAFITEMSG MSGFROMMETRUTH)
+                                                             of
 DATUM))
+                                                         (T (LA.MSGFROMMEP DATUM)))
+                                                 (PROG1 (replace
 (LAFITEMSG MSGFROMMETRUTH)
+                                                           of
 DATUM with
 NEWVALUE)
+                                                     (replace
 (LAFITEMSG MSGFROMMECHECKED?)
+                                                        of
 DATUM with
 T)))
+                                          (MARKSCHANGED? (NEQ 0 (fetch
 (LAFITEMSG MARKSCHANGEDBITS)
+                                                                   of
 DATUM))
+                                                 (replace
 (LAFITEMSG MARKSCHANGEDBITS) of
 DATUM
+                                                    with
 3))
+                                          (MODE (CL:NTH (fetch
 (LAFITEMSG MODEBITS) of
 DATUM)
+                                                       *LAFITE-WELL-KNOWN-MODES*)
+                                                (replace
 (LAFITEMSG MODEBITS) of
 DATUM
+                                                   WITH
 (OR (CL:POSITION NEWVALUE 
+                                                                   *LAFITE-WELL-KNOWN-MODES*)
+                                                            0])
 
-(DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG)          (* ; 
-
                                                        "Something's been printed in prompt window")

-                          (BROWSERPROMPTGREW FLAG)           (* ; 
-
                                                           "Browser prompt window has expanded")

-                          (FOLDERNEEDSUPDATE FLAG)           (* ; "Something changed")

-                          (FOLDERNEEDSEXPUNGE FLAG)          (* ; "True if deleted msgs")

-                          (FOLDERBEINGUPDATED FLAG)          (* ; "True during Update cmd")

-                          (BROWSERSTATUS BITS 3)             (* ; "Ready, etc.")

-                          (FULLFOLDERNAME POINTER)           (* ; "Full name of actual file")

-                          (FOLDEROKTOSHRINK FLAG)            (* ; 
-
                        "Kludge to allow you to call SHRINKW without invoking the Update? question")

-                          (FOLDERGETSMAIL FLAG)              (* ; "True if GetMail ok")

-                          (FOLDEROUTOFORDER FLAG)            (* ; "True if folder has been sorted")

-                          (NIL 5 FLAG)
-                          (VERSIONLESSFOLDERNAME POINTER)    (* ; "Versionless for conflict check")

-                          (SHORTFOLDERNAME POINTER)          (* ; "Normal name displayed to user")

-                          (FOLDERSTREAM POINTER)             (* ; "Stream open on the file, or NIL")

-                          (MESSAGEDESCRIPTORS POINTER)       (* ; "Array of LAFITEMSG")

-                          (FOLDERLOCK POINTER)               (* ; "Monitor lock for all access")

-                          (%#OFMESSAGES WORD)
-                          (TOCLASTMESSAGE# WORD)             (* ; 
-
                                                           "Last message that is in TOC file")

-                          (BROWSERFONTHEIGHT WORD)           (* ; "Cached info about browser font")

-                          (BROWSERFONTASCENT WORD)
-                          (BROWSERFONTDESCENT WORD)
-                          (BROWSERMAXXPOS WORD)              (* ; "For extent computations")

-                          (ORDINALXPOS WORD)                 (* ; "Where msg # starts")

-                          (DATEXPOS WORD)                    (* ; "Where msg date starts")

-                          (FROMXPOS WORD)                    (* ; "Where msg From starts")

-                          (FROMMAXXPOS WORD)                 (* ; "Beyond here, From is truncated")

-                          (SUBJECTXPOS WORD)                 (* ; "Where msg subject starts")

-                          (BROWSERDIGITWIDTH WORD)
-                          (FIRSTSELECTEDMESSAGE WORD)        (* ; 
-
                                                           "First/last msgs currently selected")

-                          (LASTSELECTEDMESSAGE WORD)
-                          (FIRSTCHANGEDMESSAGE WORD)         (* ; 
-
                                                "First message with any change--not currently used")

-                          (CURRENTPROMPTLINE WORD)           (* ; 
-
                                                  "Value of \currentdisplayline for browser prompt")

-                          (CURRENTDISPLAYEDSTREAM POINTER)   (* ; 
-
                           "The backing core file for the current message (not used interestingly)")

-                          (BROWSEREXTENT POINTER)
-                          (BROWSERORIGIN POINTER)
-                          (FOLDERDISPLAYREGION POINTER)      (* ; 
-
                                             "Region of display window (valid when browser shrunk)")

-                          (BROWSERWINDOW POINTER)            (* ; 
-
                                                         "The browser window and various pieces...")

-                          (BROWSERMENU POINTER)
-                          (BROWSERMENUWINDOW POINTER)
-                          (BROWSERPROMPTWINDOW POINTER)
-                          (ORIGINALBROWSERTITLE POINTER)     (* ; 
-
                                               "Original title before we added %"default move to%"")

-                          (FOLDERDISPLAYWINDOWS POINTER)     (* ; "WIndows currently displaying messages from this folder.  First element is %"primary%" display window, or NIL")

-                          (FOLDEREOFPTR POINTER)             (* ; "Length of file")

-                          (DEFAULTMOVETOFILE POINTER)        (* ; "Folder we last moved to, or NIL")

-                          (CURRENTDISPLAYEDMESSAGE POINTER)  (* ; 
-
                                            "Message descriptor of most recently displayed message")

-                          (BROWSERUPDATEFROMHERE POINTER)    (* ; 
-
        "First potentially changed message, from which redisplay needs to occur when icon expands.")

-                          (BROWSERLAYOUT POINTER)            (* ; 
-
                            "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")

-                          (FOLDERCREATIONDATE POINTER)       (* ; "the ICREATIONDATE of the file")

-                          (HARDCOPYMESSAGES POINTER)         (* ; 
-
                                                         "List of msg descriptors being hardcopied")

-                          (HARDCOPYSTREAM POINTER)           (* ; 
-
                                                           "A Textstream for pending hardcopy")

-                          )
-                         (BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
-                                                  (NIL BITS 2)
-                                                  (BROWSERREADYBIT FLAG)
-                                                             (* ; 
-
                                                           "Low bit of status on means ready")

-                                                  ))
-                         [ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch
 (MAILFOLDER BROWSERREADYBIT)
-                                                                 of
 DATUM)
-                                                       (REPLACE
 (MAILFOLDER BROWSERSTATUS)
-                                                          OF
 DATUM WITH
 (COND
-                                                                                   (NEWVALUE 
-                                                                                          LAS.READY)
-                                                                                   (T LAS.PARSING])
+(DATATYPE MAILFOLDER
 ((BROWSERPROMPTDIRTY FLAG)              (* ; 
+
                                                          "Something's been printed in prompt window")

+                      (BROWSERPROMPTGREW FLAG)               (* ; 
+
                                                             "Browser prompt window has expanded")

+                      (FOLDERNEEDSUPDATE FLAG)               (* ; "Something changed")

+                      (FOLDERNEEDSEXPUNGE FLAG)              (* ; "True if deleted msgs")

+                      (FOLDERBEINGUPDATED FLAG)              (* ; "True during Update cmd")

+                      (BROWSERSTATUS BITS 3)                 (* ; "Ready, etc.")

+                      (FULLFOLDERNAME POINTER)               (* ; "Full name of actual file")

+                      (FOLDEROKTOSHRINK FLAG)                (* ; 
+
                          "Kludge to allow you to call SHRINKW without invoking the Update? question")

+                      (FOLDERGETSMAIL FLAG)                  (* ; "True if GetMail ok")

+                      (FOLDEROUTOFORDER FLAG)                (* ; "True if folder has been sorted")

+                      (NIL 5 FLAG)
+                      (VERSIONLESSFOLDERNAME POINTER)        (* ; "Versionless for conflict check")

+                      (SHORTFOLDERNAME POINTER)              (* ; "Normal name displayed to user")

+                      (FOLDERSTREAM POINTER)                 (* ; "Stream open on the file, or NIL")

+                      (MESSAGEDESCRIPTORS POINTER)           (* ; "Array of LAFITEMSG")

+                      (FOLDERLOCK POINTER)                   (* ; "Monitor lock for all access")

+                      (%#OFMESSAGES WORD)
+                      (TOCLASTMESSAGE# WORD)                 (* ; "Last message that is in TOC file")

+                      (BROWSERFONTHEIGHT WORD)               (* ; "Cached info about browser font")

+                      (BROWSERFONTASCENT WORD)
+                      (BROWSERFONTDESCENT WORD)
+                      (BROWSERMAXXPOS WORD)                  (* ; "For extent computations")

+                      (ORDINALXPOS WORD)                     (* ; "Where msg # starts")

+                      (DATEXPOS WORD)                        (* ; "Where msg date starts")

+                      (FROMXPOS WORD)                        (* ; "Where msg From starts")

+                      (FROMMAXXPOS WORD)                     (* ; "Beyond here, From is truncated")

+                      (SUBJECTXPOS WORD)                     (* ; "Where msg subject starts")

+                      (BROWSERDIGITWIDTH WORD)
+                      (FIRSTSELECTEDMESSAGE WORD)            (* ; 
+
                                                             "First/last msgs currently selected")

+                      (LASTSELECTEDMESSAGE WORD)
+                      (FIRSTCHANGEDMESSAGE WORD)             (* ; 
+
                                                  "First message with any change--not currently used")

+                      (CURRENTPROMPTLINE WORD)               (* ; 
+
                                                    "Value of \currentdisplayline for browser prompt")

+                      (CURRENTDISPLAYEDSTREAM POINTER)       (* ; 
+
                             "The backing core file for the current message (not used interestingly)")

+                      (BROWSEREXTENT POINTER)
+                      (BROWSERORIGIN POINTER)
+                      (FOLDERDISPLAYREGION POINTER)          (* ; 
+
                                               "Region of display window (valid when browser shrunk)")

+                      (BROWSERWINDOW POINTER)                (* ; 
+
                                                           "The browser window and various pieces...")

+                      (BROWSERMENU POINTER)
+                      (BROWSERMENUWINDOW POINTER)
+                      (BROWSERPROMPTWINDOW POINTER)
+                      (ORIGINALBROWSERTITLE POINTER)         (* ; 
+
                                                 "Original title before we added %"default move to%"")

+                      (FOLDERDISPLAYWINDOWS POINTER)         (* ; "WIndows currently displaying messages from this folder.  First element is %"primary%" display window, or NIL")

+                      (FOLDEREOFPTR POINTER)                 (* ; "Length of file")

+                      (DEFAULTMOVETOFILE POINTER)            (* ; "Folder we last moved to, or NIL")

+                      (CURRENTDISPLAYEDMESSAGE POINTER)      (* ; 
+
                                              "Message descriptor of most recently displayed message")

+                      (BROWSERUPDATEFROMHERE POINTER)        (* ; 
+
          "First potentially changed message, from which redisplay needs to occur when icon expands.")

+                      (BROWSERLAYOUT POINTER)                (* ; 
+
                              "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")

+                      (FOLDERCREATIONDATE POINTER)           (* ; "the ICREATIONDATE of the file")

+                      (HARDCOPYMESSAGES POINTER)             (* ; 
+
                                                           "List of msg descriptors being hardcopied")

+                      (HARDCOPYSTREAM POINTER)               (* ; "A Textstream for pending hardcopy")

+                      )
+                     (BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
+                                              (NIL BITS 2)
+                                              (BROWSERREADYBIT FLAG)
+                                                             (* ; "Low bit of status on means ready")

+                                              ))
+                     [ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch
 (MAILFOLDER BROWSERREADYBIT)
+                                                             of
 DATUM)
+                                                   (REPLACE
 (MAILFOLDER BROWSERSTATUS) OF
 DATUM
+                                                      WITH
 (COND
+                                                              (NEWVALUE LAS.READY)
+                                                              (T LAS.PARSING])
 
 (RECORD FOLDERGROUP
 (FGNAME (FGTOPLEVEL . FGSUBGROUPS) . FGFOLDERS))
 
 (RECORD DEFAULTHOST&DIR
 (PACKEDHOST&DIR . UNPACKEDHOST&DIR)
-                            (PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
+                        (PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
 
 (RECORD MAILSERVER
 (MAILSERVEROPS MAILPORT MAILSERVERNAME CONTINUANCE NEWMAILP . MAILSTATE))
 
 (RECORD MAILSERVEROPS
 (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX 
-                                 SERVERPORTFROMNAME))
+                             SERVERPORTFROMNAME))
 
 (RECORD OPENEDMAILBOX
 (MAILBOX . PROPERTIES)
-                          (PROPRECORD PROPERTIES (%#OFMESSAGES)))
+                      (PROPRECORD PROPERTIES (%#OFMESSAGES)))
 
 (RECORD OUTBOX
 (OBWINDOW OBSIZE OBHEIGHT OBDESCENT OBORIGIN OBITEMS))
 
@@ -462,55 +446,51 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 
 (DECLARE%: EVAL@COMPILE 
 
-[I.S.OPR 'SELECTEDIN NIL '(bind
 ($$MESSAGES _ (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS)
-                                                     of
 BODY))
-                                 ($$MSG# _ (SUB1 (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE)
-                                                    of
 BODY)))
-                                 ($$MSGLAST _ (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE)
-                                                 of
 BODY)) until
 (IGREATERP (add
 $$MSG# 1
-                                                                                           )
-                                                                                $$MSGLAST)
-                             when
 (fetch
 (LAFITEMSG SELECTED?) of
 (SETQ I.V.
-                                                                               (NTHMESSAGE $$MESSAGES
-                                                                                      $$MSG#]
+[I.S.OPR 'SELECTEDIN NIL '(bind
 ($$MESSAGES _ (fetch
 (MAILFOLDER MESSAGEDESCRIPTORS) of
 BODY))
+                                ($$MSG# _ (SUB1 (fetch
 (MAILFOLDER FIRSTSELECTEDMESSAGE) of
 BODY)))
+                                ($$MSGLAST _ (fetch
 (MAILFOLDER LASTSELECTEDMESSAGE) of
 BODY))
+                             until
 (IGREATERP (add
 $$MSG# 1)
+                                          $$MSGLAST) when
 (fetch
 (LAFITEMSG SELECTED?)
+                                                             of
 (SETQ I.V. (NTHMESSAGE $$MESSAGES 
+                                                                                  $$MSG#]
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN))
-       (PUTPROPS WORDIN MACRO (= . \WIN)))
+(PROGN (PUTPROPS WORDIN
 DMACRO
 (= . \WIN))
+       (PUTPROPS WORDIN
 MACRO
 (= . \WIN)))
 
-[PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
-                               (\MAKENUMBER (WORDIN STREAM)
-                                      (WORDIN STREAM]
+(PUTPROPS FIXPIN
 DMACRO
 (OPENLAMBDA (STREAM)
+                          (\MAKENUMBER (WORDIN STREAM)
+                                 (WORDIN STREAM))))
 
-(PUTPROPS WORDOUT DMACRO (= . \WOUT))
+(PUTPROPS WORDOUT
 DMACRO
 (= . \WOUT))
 
-[PUTPROPS FIXPOUT DMACRO (OPENLAMBDA (STREAM N)
-                                (PROGN (WORDOUT STREAM (LRSH N 16))
-                                       (WORDOUT STREAM (LOGAND N 65535]
+(PUTPROPS FIXPOUT
 DMACRO
 [OPENLAMBDA (STREAM N)
+                           (PROGN (WORDOUT STREAM (LRSH N 16))
+                                  (WORDOUT STREAM (LOGAND N 65535])
 
-[PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
-                                 (COND
-                                    ((AND (IGEQ CHAR (CHARCODE a))
-                                          (ILEQ CHAR (CHARCODE z)))
-                                     (LOGAND CHAR 95))
-                                    (T CHAR]
+(PUTPROPS UCASECODE
 MACRO
 (OPENLAMBDA (CHAR)
+                            (COND
+                               ((AND (IGEQ CHAR (CHARCODE a))
+                                     (ILEQ CHAR (CHARCODE z)))
+                                (LOGAND CHAR 95))
+                               (T CHAR))))
 
-(PUTPROPS NTHMESSAGE MACRO (= . ELT))
+(PUTPROPS NTHMESSAGE
 MACRO
 (= . ELT))
 
-[PUTPROPS .LAFITEMENU. MACRO ((NAME ITEMS TITLE)
+(PUTPROPS .LAFITEMENU.
 MACRO
 [(NAME ITEMS TITLE)
                               (PROGN (DECLARE
 (GLOBALVARS NAME))
-                                     (OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE]
+                                     (OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE])
 
-[PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
-                                (AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER]
+(PUTPROPS MAYBEVERIFYMSG
 MACRO
 ((MSG MAILFOLDER)
+                                (AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER))))
 
-[PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK)
-                                   (OR (EQ MK UNSEENMARK)
-                                       (EQ MK HEARDMARK]
+(PUTPROPS UNSEENMARKP
 MACRO
 (OPENLAMBDA (MK)
+                              (OR (EQ MK UNSEENMARK)
+                                  (EQ MK HEARDMARK))))
 )
 
-(RPAQQ LAFITEGLOBALS
 
+(RPAQQ LAFITEGLOBALS

        (*LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu 
               BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK 
               LA.CROSSCURSOR LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH 
@@ -551,7 +531,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 (* ; "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")

 
 
-(RPAQQ LAFITE.PROCLAMATIONS
 
+(RPAQQ LAFITE.PROCLAMATIONS

        [(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
                              LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 
                              LAFITE.BACKGROUND.ITEM LAFITE.BROWSER.ICON.PREFERENCE 
@@ -610,7 +590,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 (* ; "For debugging with Masterscope, here are fns not called from code")

 
 
-(RPAQQ LAFITE.CALLED.FROM.LITERALS
 
+(RPAQQ LAFITE.CALLED.FROM.LITERALS

        (GV.CLOSEMAILBOX GV.INIT.MAIL.USER GV.MAKEANSWERFORM GV.NEXTMESSAGE GV.OPENMAILBOX 
               GV.POLLNEWMAIL GV.PORTFROMNAME GV.RETRIEVEMESSAGE LAFITE.COMPUTE.CACHED.VARS 
               LAFITE.GRAB.DATE LAFITE.ON.FROM.BACKGROUND LAFITE.PARSE.DATE.FIELD.ONLY 
@@ -637,11 +617,11 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
               \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MESSAGE.P \NSMAIL.SEND \NSMAIL.SEND.PARSE 
               \SENDMSG.CHANGE.MODE \SENDMSG.DELIVER \SENDMSG.SAVE.FORM))
 
-(RPAQQ LAFITE.PROGRAMMER.ENTRIES
 
-       (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE BUILD.LAFITE.LAYOUTS 
-              LAB.SELECTED.MESSAGES LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES 
-              LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE MS.EXPAND GV.READTOC 
-              GV.WRITETOC GV.DELETEMESSAGE))
+(RPAQQ LAFITE.PROGRAMMER.ENTRIES
 (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE 
+                                        BUILD.LAFITE.LAYOUTS LAB.SELECTED.MESSAGES 
+                                        LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES 
+                                        LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE 
+                                        MS.EXPAND GV.READTOC GV.WRITETOC GV.DELETEMESSAGE))
 
 (DEFCOMMAND (WHONOTLAFITE :HISTORY) NIL 
    '((CL:SET-DIFFERENCE (CL:SET-DIFFERENCE (%. WHO ON ANY IN LAFITEFILES IS NOT CALLED)
@@ -662,7 +642,6 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 
 (SETTEMPLATE 'TEXTPROP '(EVAL PROP EVAL . PPE))
 )
-(PUTPROPS LAFITEDECLS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1994))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP

library/lafite/LAFITE-FIND

@@ -1,20 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "30-Sep-2021 23:01:05" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;2
 14882  
 
-      changes to%:  (FILES LAFITEDECLS)
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FIND.;2
 14652  
 
-      previous date%: " 3-Jun-92 10:10:41" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-FINDCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:11:33" {WMEDLEY}<library>lafite>LAFITE-FIND.;1)
 
 
-(* ; "
-Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-FINDCOMS)
 
-(PRETTYCOMPRINT LAFITEFINDCOMS)
-
-(RPAQQ LAFITEFINDCOMS

+(RPAQQ LAFITE-FINDCOMS

        ((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)
@@ -22,7 +19,7 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
                (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU 
                       LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))
         (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
         (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
@@ -133,7 +130,7 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -181,11 +178,10 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
 (ADDTOVAR LAFITEMENUVARS
 LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
 
 (RPAQQ \LAFITE.LAST.SEARCH
 NIL)
-(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 2021))
 (DECLARE%: DONTCOPY
-  (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)))))
+  (FILEMAP (NIL (2180 11952 (\LAFITE.FIND 2190 . 3222) (\LAFITE.FIND.RELATED 3224 . 3889) (
+\LAFITE.FIND.RELATED.BACKWARD 3891 . 4027) (\LAFITE.GO.TO.FIRST 4029 . 4196) (
+\LAFITE.GO.TO.INTERACTIVE 4198 . 4810) (\LAFITE.GO.TO.LAST 4812 . 5020) (\LAFITE.FIND.AGAIN 5022 . 
+5604) (\LAFITE.FIND.PROMPT 5606 . 7728) (\LAFITE.DO.FIND 7730 . 10881) (\LAFITE.FIND.START 10883 . 
+11950)))))
 STOP

library/lafite/LAFITE-FOLDERS

@@ -1,21 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Feb-2022 12:04:09" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;2
 44421  
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FOLDERS.;2
 44255  
 
-      :CHANGES-TO (FNS \LAFITE.MAKE.RANDOM.DISPLAY)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 2-Nov-89 18:16:37" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;1)
+      :CHANGES-TO (VARS LAFITE-FOLDERSCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:01:00" {WMEDLEY}<library>lafite>LAFITE-FOLDERS.;1)
 
 
-(* ; "
-Copyright (c) 1989 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-FOLDERSCOMS)
 
-(PRETTYCOMPRINT LAFITEFOLDERSCOMS)
-
-(RPAQQ LAFITEFOLDERSCOMS

+(RPAQQ LAFITE-FOLDERSCOMS

        [
         (* ;; "Maintenance of Lafite's folder structures, menus etc.")

 
@@ -53,7 +49,7 @@ Copyright (c) 1989 by Xerox Corporation.
                    UALPHORDERCAR)
               (VARS LAFITE.SPACER.MENU.ITEM LAFITE.GROUP.COMMANDS (LAFITE.GROUP.COMMANDS.MENU)))
         (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                LAFITEDECLS)
+                                                LAFITE-DECLS)
                (LOCALVARS . T)
                (GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS)
                (P (CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*])
@@ -334,7 +330,7 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -349,25 +345,24 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
 
 (CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*))
 )
-(PUTPROPS LAFITEFOLDERS COPYRIGHT ("Xerox Corporation" 1989))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3536 11401 (\LAFITE.READ.PROFILE 3546 . 5750) (\LAFITE.PROCESS.PROFILE 5752 . 6942) (
-\LAFITE.WRITE.PROFILE 6944 . 8778) (\LAFITE.MERGE.NAMELISTS 8780 . 9514) (\LAFITE.READ.OLD.PROFILE 
-9516 . 10115) (\LAFITE.MERGE.FOLDERS 10117 . 10429) (\LAFITE.MERGE.STRUCTURES 10431 . 10631) (
-\LAFITE.REPACK.FOLDERS 10633 . 11399)) (11828 20372 (\LAFITE.PROMPTFORFOLDER 11838 . 12388) (
-PROMPTFORFILENAME 12390 . 13231) (MAKELAFITEMAILFOLDERSMENU 13233 . 13397) (MAKELAFITEFOLDERSMENUITEMS
- 13399 . 14514) (LAFITE.GROUP.ITEM 14516 . 15053) (\LAFITE.ARRANGE.MENU 15055 . 16337) (
-\LAFITE.MAKE.FOLDER.MENU 16339 . 16864) (LAFITE.SELECT.FOLDERS 16866 . 17251) (LAFITE.SELECT.MULTIPLE 
-17253 . 19597) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19599 . 20071) (COLLECT.SHADED.ITEMS 20073 . 20370))
- (20595 29104 (LA.LONGFILENAME 20605 . 22480) (LA.SHORTFILENAME 22482 . 24305) (FORGETMAILFILE 24307
- . 24767) (\LAFITE.FOLDER.NAME.CHANGED 24769 . 25992) (\LAFITE.CHANGE.NAME.IN.LIST 25994 . 26373) (
-\LAFITE.RECOMPUTE.FOLDER.NAMES 26375 . 27796) (\LAFITE.NEW.SHORT.NAME 27798 . 28479) (
-\LAFITE.NOTICE.FILE 28481 . 28662) (\LAFITE.UNCACHE.FOLDER 28664 . 29102)) (29220 43399 (
-\LAFITE.NOTICE.FOLDERS 29230 . 30870) (\LAFITE.GC.FOLDERS 30872 . 31959) (\LAFITE.GC.FOLDERS.CONFIRM 
-31961 . 32771) (\LAFITE.MAKE.RANDOM.DISPLAY 32773 . 34764) (\LAFITE.CHANGE.FOLDER.LIST 34766 . 35519) 
-(\LAFITE.RENAME.FOLDER 35521 . 37251) (\LAFITE.ADD.NEW.GROUP 37253 . 37978) (\LAFITE.CHECK.GROUP.NAME 
-37980 . 38331) (\LAFITE.CHANGE.GROUP.MEMBERS 38333 . 38708) (\LAFITE.SELECT.GROUP.FOLDERS 38710 . 
-39716) (\LAFITE.CHANGE.SUBGROUPS 39718 . 40369) (\LAFITE.CHANGE.TOP.GROUPS 40371 . 41079) (
-\LAFITE.DELETE.GROUP 41081 . 41663) (LAFITE.RENAME.GROUP 41665 . 42521) (\LAFITE.EDIT.HIERARCHY 42523
- . 43082) (LAFITE.FIND.GROUP 43084 . 43280) (UALPHORDERCAR 43282 . 43397)))))
+  (FILEMAP (NIL (3431 11296 (\LAFITE.READ.PROFILE 3441 . 5645) (\LAFITE.PROCESS.PROFILE 5647 . 6837) (
+\LAFITE.WRITE.PROFILE 6839 . 8673) (\LAFITE.MERGE.NAMELISTS 8675 . 9409) (\LAFITE.READ.OLD.PROFILE 
+9411 . 10010) (\LAFITE.MERGE.FOLDERS 10012 . 10324) (\LAFITE.MERGE.STRUCTURES 10326 . 10526) (
+\LAFITE.REPACK.FOLDERS 10528 . 11294)) (11723 20267 (\LAFITE.PROMPTFORFOLDER 11733 . 12283) (
+PROMPTFORFILENAME 12285 . 13126) (MAKELAFITEMAILFOLDERSMENU 13128 . 13292) (MAKELAFITEFOLDERSMENUITEMS
+ 13294 . 14409) (LAFITE.GROUP.ITEM 14411 . 14948) (\LAFITE.ARRANGE.MENU 14950 . 16232) (
+\LAFITE.MAKE.FOLDER.MENU 16234 . 16759) (LAFITE.SELECT.FOLDERS 16761 . 17146) (LAFITE.SELECT.MULTIPLE 
+17148 . 19492) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19494 . 19966) (COLLECT.SHADED.ITEMS 19968 . 20265))
+ (20490 28999 (LA.LONGFILENAME 20500 . 22375) (LA.SHORTFILENAME 22377 . 24200) (FORGETMAILFILE 24202
+ . 24662) (\LAFITE.FOLDER.NAME.CHANGED 24664 . 25887) (\LAFITE.CHANGE.NAME.IN.LIST 25889 . 26268) (
+\LAFITE.RECOMPUTE.FOLDER.NAMES 26270 . 27691) (\LAFITE.NEW.SHORT.NAME 27693 . 28374) (
+\LAFITE.NOTICE.FILE 28376 . 28557) (\LAFITE.UNCACHE.FOLDER 28559 . 28997)) (29115 43294 (
+\LAFITE.NOTICE.FOLDERS 29125 . 30765) (\LAFITE.GC.FOLDERS 30767 . 31854) (\LAFITE.GC.FOLDERS.CONFIRM 
+31856 . 32666) (\LAFITE.MAKE.RANDOM.DISPLAY 32668 . 34659) (\LAFITE.CHANGE.FOLDER.LIST 34661 . 35414) 
+(\LAFITE.RENAME.FOLDER 35416 . 37146) (\LAFITE.ADD.NEW.GROUP 37148 . 37873) (\LAFITE.CHECK.GROUP.NAME 
+37875 . 38226) (\LAFITE.CHANGE.GROUP.MEMBERS 38228 . 38603) (\LAFITE.SELECT.GROUP.FOLDERS 38605 . 
+39611) (\LAFITE.CHANGE.SUBGROUPS 39613 . 40264) (\LAFITE.CHANGE.TOP.GROUPS 40266 . 40974) (
+\LAFITE.DELETE.GROUP 40976 . 41558) (LAFITE.RENAME.GROUP 41560 . 42416) (\LAFITE.EDIT.HIERARCHY 42418
+ . 42977) (LAFITE.FIND.GROUP 42979 . 43175) (UALPHORDERCAR 43177 . 43292)))))
 STOP

library/lafite/LAFITE-HAX

@@ -1,19 +1,30 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "26-Feb-93 14:36:38" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;12"
 9033   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS \NSMAIL.PARSE1 \NSMAIL.NEW.CHECKSERVER LAFITE.TOGGLE.SERVER.TRACE LAFITE.HANDLE.ORIGINAL.FIELD LAFITE.COMPUTE.CACHED.VARS LAFITE.NEW.PARSE.HEADER INIT.NEW.PARSE.HANDLER)
- (VARS LAFITEHAXCOMS)
+
(FILECREATED "23-Feb-2024 23:58:34" {WMEDLEY}<library>lafite>LAFITE-HAX.;1
 9138   
 
-      previous date%: " 3-Jun-92 16:10:47" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;1")
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "26-Feb-93 14:36:38" {WMEDLEY}<library>lafite>LAFITEHAX.;1)
 
 
-(* ; "
-Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-HAXCOMS)
 
-(PRETTYCOMPRINT LAFITEHAXCOMS)
-
-(RPAQQ LAFITEHAXCOMS ((COMS (* ; "New header parser") (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER LAFITE.COMPUTE.CACHED.VARS) (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100) (*LAFITE-PARSE-HEADER-STRING-RESOURCE*)) (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER)))) (COMS (* ; "automatically handle internet addresses") (FNS \NSMAIL.PARSE1)) (COMS (FNS LAFITE.TOGGLE.SERVER.TRACE) (APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*"))) (VARS (LAFITESUBQUITMENU)))))
+(RPAQQ LAFITE-HAXCOMS

+       [[COMS                                                (* ; "New header parser")

+              (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER 
+                   LAFITE.COMPUTE.CACHED.VARS)
+              (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100)
+                     (*LAFITE-PARSE-HEADER-STRING-RESOURCE*))
+              (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER]
+        (COMS                                                (* ; 
+
                                                            "automatically handle internet addresses")

+              (FNS \NSMAIL.PARSE1))
+        (COMS (FNS LAFITE.TOGGLE.SERVER.TRACE)
+              (APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE 
+                                                         "Change setting of *NSMAIL-TRACE-SERVERS*"))
+                     )
+              (VARS (LAFITESUBQUITMENU])
 
 
 
@@ -40,16 +51,16 @@ Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
+(RPAQ? *LAFITE-MAX-FIELD-WIDTH*
 100)
 
-(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
+(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE*
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(INIT.NEW.PARSE.HANDLER)
+(INIT.NEW.PARSE.HANDLER
)
 )
 
 
@@ -69,13 +80,12 @@ Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(APPENDTOVAR LAFITESUBQUITMENUITEMS
 ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*")
-)
+(APPENDTOVAR LAFITESUBQUITMENUITEMS
 ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE 
+                                           "Change setting of *NSMAIL-TRACE-SERVERS*"))
 
-(RPAQQ LAFITESUBQUITMENU NIL)
-(PUTPROPS LAFITEHAX COPYRIGHT ("Xerox Corporation" 1992 1993))
+(RPAQQ LAFITESUBQUITMENU
 NIL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1281 6753 (LAFITE.NEW.PARSE.HEADER 1291 . 3112) (LAFITE.HANDLE.ORIGINAL.FIELD 3114 . 
-3790) (INIT.NEW.PARSE.HANDLER 3792 . 4047) (LAFITE.COMPUTE.CACHED.VARS 4049 . 6751)) (7070 8290 (
-\NSMAIL.PARSE1 7080 . 8288)) (8291 8778 (LAFITE.TOGGLE.SERVER.TRACE 8301 . 8776)))))
+  (FILEMAP (NIL (1396 6868 (LAFITE.NEW.PARSE.HEADER 1406 . 3227) (LAFITE.HANDLE.ORIGINAL.FIELD 3229 . 
+3905) (INIT.NEW.PARSE.HANDLER 3907 . 4162) (LAFITE.COMPUTE.CACHED.VARS 4164 . 6866)) (7198 8418 (
+\NSMAIL.PARSE1 7208 . 8416)) (8419 8906 (LAFITE.TOGGLE.SERVER.TRACE 8429 . 8904)))))
 STOP

library/lafite/LAFITE-MAIL

@@ -1,18 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "30-Sep-2021 23:01:47" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;3
 133718 
 
-      previous date%: "22-Jun-2021 10:19:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;2)
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-MAIL.;2
 133521 
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-MAILCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:05:03" {WMEDLEY}<library>lafite>LAFITE-MAIL.;1)
 
 
-(* ; "
-Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-MAILCOMS)
 
-(PRETTYCOMPRINT LAFITEMAILCOMS)
-
-(RPAQQ LAFITEMAILCOMS

+(RPAQQ LAFITE-MAILCOMS

        ((COMS                                                (* ; "Retrieving mail")

               (FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL
                    \LAFITE.GETNEWMAIL1 \LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES))
@@ -64,7 +63,7 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
                       \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD 
                       LAFITE.AFTER.GETMAIL.FN)
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))))
 
 
@@ -1909,9 +1908,9 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
         ("FORMAT:" LAFITE.READ.FORMAT)))
 
 (RPAQQ LA.TOCFIELDS
 (("DATE:" LAFITE.GRAB.DATE)
-                         ("FROM:" LAFITE.READ.LINE.FOR.TOC From)
-                         ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
-                         ("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
+                     ("FROM:" LAFITE.READ.LINE.FOR.TOC From)
+                     ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
+                     ("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
 
 (RPAQQ LA.TOFIELDONLY
 (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
 
@@ -2110,39 +2109,37 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 )
-(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1991 1992 1993 2021)
-)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4395 22354 (\LAFITE.GETMAIL 4405 . 4776) (\LAFITE.GETMAIL.FROM.ICON 4778 . 5126) (
-\LAFITE.GETMAIL.PROC 5128 . 5575) (\LAFITE.GETNEWMAIL 5577 . 11919) (\LAFITE.GETNEWMAIL1 11921 . 14653
-) (\LAFITE.GETNEWMAIL# 14655 . 15044) (\LAFITE.RETRIEVEMESSAGES 15046 . 22352)) (22401 51381 (
-\LAFITE.GET.USER.DATA 22411 . 25245) (\LAFITE.GUESS.MODE 25247 . 27467) (\LAFITE.REGISTER.MODE 27469
- . 28728) (LAFITECLEARCACHE 28730 . 29484) (FULLUSERNAME 29486 . 30585) (LAFITE.USER.NAME.FROM.LOGIN 
-30587 . 32370) (LAFITEMAILWATCH 32372 . 33702) (\LAFITE.WAKE.WATCHER 33704 . 34293) (POLLNEWMAIL 34295
- . 47918) (\LAFITE.NEW.MAIL.EXISTS 47920 . 48256) (PRINTLAFITESTATUS 48258 . 50624) (
-LAFITE.STATUS.WITH.TIME 50626 . 50930) (\LAFITE.REINITIALIZING 50932 . 51379)) (51417 106191 (
-\LAFITE.PARSE.FOLDER 51427 . 52795) (\LAFITE.PARSE.FOLDER1 52797 . 60252) (\LAFITE.HANDLE.DUPLICATES 
-60254 . 63290) (\LAFITE.CHECK.DUPLICATE 63292 . 64227) (\LAFITE.REPORT.DUPLICATES 64229 . 66114) (
-BADMAILFILE 66116 . 74672) (BADMAILFILE.CLOSEFN 74674 . 75002) (BADMAILFILE.FLAGBYTE 75004 . 75202) (
-VERIFYMAILFOLDER 75204 . 79775) (VERIFYFAILED 79777 . 79965) (\LAFITE.READ.TOC.FILE 79967 . 93470) (
-BADTOCFILE 93472 . 93966) (\LAFITE.TOCEOF 93968 . 94303) (LA.READCOUNT 94305 . 95533) (LA.READSTAMP 
-95535 . 96078) (LA.PRINTHEADER 96080 . 99402) (LA.PRINTCOUNT 99404 . 99637) (LA.PRINTSTAMP 99639 . 
-100063) (LA.READSHORTSTRING 100065 . 100832) (LA.PRINTSHORTSTRING 100834 . 101963) (LA.READSTRING 
-101965 . 102436) (\LAFITE.VERIFYMSG 102438 . 104219) (LA.MSGFROMMEP 104221 . 106189)) (106192 122077 (
-LAFITE.PARSE.MSG.FOR.TOC 106202 . 109562) (LAFITE-EXTRACT-REAL-NAME 109564 . 112693) (
-LAFITE.FETCH.TO.FIELD 112695 . 113970) (LAFITE.PARSE.HEADER 113972 . 117081) (LAFITE.GRAB.DATE 117083
- . 117488) (LAFITE.READ.LINE.FOR.TOC 117490 . 117926) (LAFITE.READ.FORMAT 117928 . 118310) (
-LAFITE.READ.NAME.FIELD 118312 . 119345) (LAFITE.READ.ONE.LINE.FOR.TOC 119347 . 119528) (
-LAFITE.READ.TO.EOL 119530 . 120460) (LA.SKIP.TO.EOL 120462 . 121797) (LAFITE.SKIP.WHITE.SPACE 121799
- . 122075)) (122078 122719 (\LAFITE.PARSE.MESSAGE 122088 . 122717)) (123679 127667 (
-LAFITE.INIT.PARSETABLES 123689 . 124200) (LAFITE.MAKE.PARSE.TABLE 124202 . 125172) (
-LAFITE.MAKE.PARSE.TABLE1 125174 . 127665)) (127702 132269 (LAFITE.NEW.PARSE.HEADER 127712 . 131321) (
-LAFITE.HANDLE.ORIGINAL.FIELD 131323 . 132267)))))
+  (FILEMAP (NIL (4314 22273 (\LAFITE.GETMAIL 4324 . 4695) (\LAFITE.GETMAIL.FROM.ICON 4697 . 5045) (
+\LAFITE.GETMAIL.PROC 5047 . 5494) (\LAFITE.GETNEWMAIL 5496 . 11838) (\LAFITE.GETNEWMAIL1 11840 . 14572
+) (\LAFITE.GETNEWMAIL# 14574 . 14963) (\LAFITE.RETRIEVEMESSAGES 14965 . 22271)) (22320 51300 (
+\LAFITE.GET.USER.DATA 22330 . 25164) (\LAFITE.GUESS.MODE 25166 . 27386) (\LAFITE.REGISTER.MODE 27388
+ . 28647) (LAFITECLEARCACHE 28649 . 29403) (FULLUSERNAME 29405 . 30504) (LAFITE.USER.NAME.FROM.LOGIN 
+30506 . 32289) (LAFITEMAILWATCH 32291 . 33621) (\LAFITE.WAKE.WATCHER 33623 . 34212) (POLLNEWMAIL 34214
+ . 47837) (\LAFITE.NEW.MAIL.EXISTS 47839 . 48175) (PRINTLAFITESTATUS 48177 . 50543) (
+LAFITE.STATUS.WITH.TIME 50545 . 50849) (\LAFITE.REINITIALIZING 50851 . 51298)) (51336 106110 (
+\LAFITE.PARSE.FOLDER 51346 . 52714) (\LAFITE.PARSE.FOLDER1 52716 . 60171) (\LAFITE.HANDLE.DUPLICATES 
+60173 . 63209) (\LAFITE.CHECK.DUPLICATE 63211 . 64146) (\LAFITE.REPORT.DUPLICATES 64148 . 66033) (
+BADMAILFILE 66035 . 74591) (BADMAILFILE.CLOSEFN 74593 . 74921) (BADMAILFILE.FLAGBYTE 74923 . 75121) (
+VERIFYMAILFOLDER 75123 . 79694) (VERIFYFAILED 79696 . 79884) (\LAFITE.READ.TOC.FILE 79886 . 93389) (
+BADTOCFILE 93391 . 93885) (\LAFITE.TOCEOF 93887 . 94222) (LA.READCOUNT 94224 . 95452) (LA.READSTAMP 
+95454 . 95997) (LA.PRINTHEADER 95999 . 99321) (LA.PRINTCOUNT 99323 . 99556) (LA.PRINTSTAMP 99558 . 
+99982) (LA.READSHORTSTRING 99984 . 100751) (LA.PRINTSHORTSTRING 100753 . 101882) (LA.READSTRING 101884
+ . 102355) (\LAFITE.VERIFYMSG 102357 . 104138) (LA.MSGFROMMEP 104140 . 106108)) (106111 121996 (
+LAFITE.PARSE.MSG.FOR.TOC 106121 . 109481) (LAFITE-EXTRACT-REAL-NAME 109483 . 112612) (
+LAFITE.FETCH.TO.FIELD 112614 . 113889) (LAFITE.PARSE.HEADER 113891 . 117000) (LAFITE.GRAB.DATE 117002
+ . 117407) (LAFITE.READ.LINE.FOR.TOC 117409 . 117845) (LAFITE.READ.FORMAT 117847 . 118229) (
+LAFITE.READ.NAME.FIELD 118231 . 119264) (LAFITE.READ.ONE.LINE.FOR.TOC 119266 . 119447) (
+LAFITE.READ.TO.EOL 119449 . 120379) (LA.SKIP.TO.EOL 120381 . 121716) (LAFITE.SKIP.WHITE.SPACE 121718
+ . 121994)) (121997 122638 (\LAFITE.PARSE.MESSAGE 122007 . 122636)) (123586 127574 (
+LAFITE.INIT.PARSETABLES 123596 . 124107) (LAFITE.MAKE.PARSE.TABLE 124109 . 125079) (
+LAFITE.MAKE.PARSE.TABLE1 125081 . 127572)) (127609 132176 (LAFITE.NEW.PARSE.HEADER 127619 . 131228) (
+LAFITE.HANDLE.ORIGINAL.FIELD 131230 . 132174)))))
 STOP

library/lafite/LAFITE-MAILSCAVENGE

@@ -1,25 +1,22 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Feb-2022 12:04:09" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;4
 40080  
+
(FILECREATED "26-Feb-2024 20:13:24" {WMEDLEY}<library>lafite>LAFITE-MAILSCAVENGE.;2
 39927  
 
-      :CHANGES-TO (FNS \MAILSCAVENGE.MAKEWINDOW)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "30-Sep-2021 22:57:39" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;3)
+      :CHANGES-TO (VARS LAFITE-MAILSCAVENGECOMS)
+                  (FNS MAILSCAVENGE)
+
+      :PREVIOUS-DATE "24-Feb-2024 11:28:52" {WMEDLEY}<library>lafite>LAFITE-SCAVENGE.;1)
 
 
-(* ; "
-Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-MAILSCAVENGECOMS)
 
-(PRETTYCOMPRINT MAILSCAVENGECOMS)
-
-(RPAQQ MAILSCAVENGECOMS

-       [(FNS LAFITE.SCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH 
-             \MAILSCAVENGE.LENGTHWIDTH \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP 
-             \MAILSCAVENGE.DUPLICATE? \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW 
-             \MAILSCAVENGE.ASKUSER \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
+(RPAQQ LAFITE-MAILSCAVENGECOMS

+       [(FNS MAILSCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH \MAILSCAVENGE.LENGTHWIDTH
+             \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP \MAILSCAVENGE.DUPLICATE? 
+             \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW \MAILSCAVENGE.ASKUSER 
+             \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
         (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (*START*LENGTH 8))
                (SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
                (LOCALVARS . T))
@@ -30,11 +27,11 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
                                                                                    ])
 (DEFINEQ
 
-(LAFITE.SCAVENGE

-  [LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?)
            (* ; "Edited 18-Apr-89 18:19 by bvm")

+(MAILSCAVENGE

+  [LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?)
                (* ; "Edited 18-Apr-89 18:19 by bvm")

 
     (* ;; 
-
  "User entry to the scavenger.  If FORGET?, we won't add folder to the list of known folders.")

+
    "User entry to the scavenger.  If FORGET?, we won't add folder to the list of known folders.")

 
     (LET [(FOLDER (LAFITE.OBTAIN.FOLDER (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT)
                          'INPUT T (AND FORGET? :FORGET]
@@ -654,12 +651,11 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA
 \MAILSCAVENGE.FORMAT)
 )
-(PUTPROPS MAILSCAVENGE COPYRIGHT ("Venue & Xerox Corporation" 1985 1989 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1459 39559 (LAFITE.SCAVENGE 1469 . 1991) (\MAILSCAVENGE.INTERNAL 1993 . 28504) (
-\MAILSCAVENGE.OPEN.SCRATCH 28506 . 29109) (\MAILSCAVENGE.LENGTHWIDTH 29111 . 29524) (
-\MAILSCAVENGE.LFCOPYBYTES 29526 . 30095) (\MAILSCAVENGE.READSTAMP 30097 . 30844) (
-\MAILSCAVENGE.DUPLICATE? 30846 . 31547) (\MAILSCAVENGE.FORMAT 31549 . 32376) (\MAILSCAVENGE.MAKEWINDOW
- 32378 . 34275) (\MAILSCAVENGE.ASKUSER 34277 . 37407) (\MAILSCAVENGE.FIX.LENGTHS 37409 . 38567) (
-\MAILSCAVENGE.CONFIRM 38569 . 39557)))))
+  (FILEMAP (NIL (1387 39490 (MAILSCAVENGE 1397 . 1922) (\MAILSCAVENGE.INTERNAL 1924 . 28435) (
+\MAILSCAVENGE.OPEN.SCRATCH 28437 . 29040) (\MAILSCAVENGE.LENGTHWIDTH 29042 . 29455) (
+\MAILSCAVENGE.LFCOPYBYTES 29457 . 30026) (\MAILSCAVENGE.READSTAMP 30028 . 30775) (
+\MAILSCAVENGE.DUPLICATE? 30777 . 31478) (\MAILSCAVENGE.FORMAT 31480 . 32307) (\MAILSCAVENGE.MAKEWINDOW
+ 32309 . 34206) (\MAILSCAVENGE.ASKUSER 34208 . 37338) (\MAILSCAVENGE.FIX.LENGTHS 37340 . 38498) (
+\MAILSCAVENGE.CONFIRM 38500 . 39488)))))
 STOP

library/lafite/LAFITE-MAILSHARE

@@ -1,26 +1,26 @@
-(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
-
(FILECREATED "20-Feb-87 08:05:52" {IVY}<BLOOMBERG>LISP>MAILSHARE.;1
 12250  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      previous date%: "15-Dec-86 10:01:06" {INDIGO}<GSLWS>BASICS>MAILSHARE.;3)
+
(FILECREATED "23-Feb-2024 23:24:20" {WMEDLEY}<library>lafite>LAFITE-MAILSHARE.;1
 12072  
+
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "20-Feb-87 08:05:52" {WMEDLEY}<library>lafite>MAILSHARE.;1)
 
 
-(* "
-Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-MAILSHARECOMS)
 
-(PRETTYCOMPRINT MAILSHARECOMS)
-
-(RPAQQ MAILSHARECOMS
 ((* Menu Functions)
-                      (FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent 
-                           MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
-                      (* Icon bitmaps)
-                      (BITMAPS MASH.Icon MASH.IconMask)
-                      (* VARS)
-                      (INITVARS (MASH.VALID-HOSTS '(IVY INDIGO PHYLUM ERIS QV CHERRY)))
-                      (GLOBALVARS MASH.VALID-HOSTS)
-                      (ADDVARS (BackgroundMenuCommands (Mail% Share '(MASH.TopLevel) 
-                                                              "Start the Mail Share menu")))
-                      (VARS (BackgroundMenu NIL))))
+(RPAQQ LAFITE-MAILSHARECOMS

+       ((* Menu Functions)
+        (FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent 
+             MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
+        (* Icon bitmaps)
+        (BITMAPS MASH.Icon MASH.IconMask)
+        (* VARS)
+        [INITVARS (MASH.VALID-HOSTS '(IVY INDIGO PHYLUM ERIS QV CHERRY]
+        (GLOBALVARS MASH.VALID-HOSTS)
+        (ADDVARS (BackgroundMenuCommands (Mail% Share '(MASH.TopLevel)
+                                                "Start the Mail Share menu")))
+        (VARS (BackgroundMenu NIL))))
 
 
 
@@ -237,12 +237,12 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
 (GLOBALVARS MASH.VALID-HOSTS)
 )
 
-(ADDTOVAR BackgroundMenuCommands
 (Mail% Share '(MASH.TopLevel) "Start the Mail Share menu"))
+(ADDTOVAR BackgroundMenuCommands
 (Mail% Share '(MASH.TopLevel)
+                                        "Start the Mail Share menu"))
 
 (RPAQQ BackgroundMenu
 NIL)
-(PUTPROPS MAILSHARE COPYRIGHT ("Xerox Corporation" 1986 1987))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1099 9386 (MASH.TopLevel 1109 . 1795) (MASH.CreateFreeMenu 1797 . 2978) (MASH.GetMail 
-2980 . 6921) (MASH.Quit 6923 . 7601) (MASH.Consistent 7603 . 8502) (MASH.MakeDirectoryName 8504 . 8783
-) (MASH.MakeProfileName 8785 . 9126) (MASH.MakeIconWindow 9128 . 9384)))))
+  (FILEMAP (NIL (944 9231 (MASH.TopLevel 954 . 1640) (MASH.CreateFreeMenu 1642 . 2823) (MASH.GetMail 
+2825 . 6766) (MASH.Quit 6768 . 7446) (MASH.Consistent 7448 . 8347) (MASH.MakeDirectoryName 8349 . 8628
+) (MASH.MakeProfileName 8630 . 8971) (MASH.MakeIconWindow 8973 . 9229)))))
 STOP

library/lafite/LAFITE-MIME

@@ -1,29 +1,28 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 3-Aug-2005 09:39:34" {DSK}<project>medley3.5>lispusers>MIME.;42
 139917 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS DEMIMEPART)
+
(FILECREATED "24-Feb-2024 10:05:37" {WMEDLEY}<library>lafite>LAFITE-MIME.;1
 140113 
 
-      previous date%: "28-Jun-2002 16:23:39" {DSK}<project>medley3.5>lispusers>MIME.;41)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS MIMECOMS)
+
+      :PREVIOUS-DATE " 3-Aug-2005 09:39:34" {WMEDLEY}<library>lafite>MIME.;1)
 
 
-(* ; "
-Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-MIMECOMS)
 
-(PRETTYCOMPRINT MIMECOMS)
-
-(RPAQQ MIMECOMS

+(RPAQQ LAFITE-MIMECOMS

        ((FNS DEMIME PARSEMIME DEMIMEPART DEMIMETEXT DEMIMEAPPL MIMEERROR MIMEHEADERS MIMEPARAMS 
              PARSE-SUNATTACHMENT RECODEMIMEHEADER)
         (COMS 
               (* ;; "Replaces function on LAFITECOMMANDS and LAFITEHARDCOPY, so that MIME objects are decoded in messages.  These functions require the LAFITEMSG and MAILFOLDER records to be available:")

 
               (DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
-                                                                    LAFITEDECLS))
+                                                                    LAFITE-DECLS))
               (FNS LA.COPY.MESSAGE.TEXT \LAFITE.APPEND.MESSAGE.BODY)
               
               (* ;; 
-
   "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")

+
     "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")

 
               (FNS PRINTMESSAGESUMMARY.STRING))
         (FNS ADDMIMEOBJECT MIMEOBJINIT MIMEOBJ.DISPLAYFN MIMEOBJ.COPYFN MIMEOBJ.BUTTONEVENTINFN 
@@ -41,7 +40,7 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
         (GLOBALVARS ATTACHMENTDIR)
         [COMS 
               (* ;; 
-
       "MIMEFASTRECODECHARCODE is a copy of FASTRECODECHARCODED on /project/dict/code/CHARACTERFNS")

+
         "MIMEFASTRECODECHARCODE is a copy of FASTRECODECHARCODED on /project/dict/code/CHARACTERFNS")

 
               (FNS CACHEMIMECHARRECODEMAPS MIMEFASTRECODECHARCODE MIMERECODEMAP)
               (INITVARS (CURRENTCHARENCODING 'XEROX-RENDERING))
@@ -582,7 +581,7 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 (DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE 
 
 (FILESLOAD (LOADCOMP)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 )
 (DEFINEQ
 
@@ -685,8 +684,8 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 
 
 
-(* ;; 
-"Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")

+(* ;; "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets."
+)

 
 (DEFINEQ
 
@@ -1649,84 +1648,83 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS BINHEXBYTE  MACRO

-   (NIL (IF
 (EQ REPEAT 0)
-            THEN
 [PROG (C C2 REPFLAG)
-                       GETBYTE
-                           [WHILE
 (MEMB (SETQ C (BIN INSTREAM))
-                                            (CHARCODE (CR LF]
-                           (CL:UNLESS (EQ (CHARCODE %:
)
-                                          C)
-                               [SETQ C (CL:SVREF BINHEXCHARARRAY (- C (CONSTANT (CHCON1 BINHEXCHARS]
+(PUTPROPS BINHEXBYTE
 MACRO

+          (NIL (IF
 (EQ REPEAT 0)
+                   THEN
 [PROG (C C2 REPFLAG)
+                          GETBYTE
+                              [WHILE
 (MEMB (SETQ C (BIN INSTREAM))
+                                           (CHARCODE (CR LF]
+                              (CL:UNLESS (EQ (CHARCODE %:)
+                                             C)
+                                  [SETQ C (CL:SVREF BINHEXCHARARRAY (- C (CONSTANT (CHCON1 
+                                                                                          BINHEXCHARS
+                                                                                          ]
 
-                               (* ;; "Save byte in C for repetition")

+                                  (* ;; "Save byte in C for repetition")

 
-                               (SETQ C (SELECTQ POS
-                                           (0                (* ; 
-
           "Start of byte, used 6 bits from first code, 2 bits from second code, carry over 4 bits")

-                                              (SETQ POS 1)
-                                              [WHILE
 (MEMB (SETQ C2 (BIN INSTREAM))
-                                                               (CHARCODE (CR LF]
-                                              (CL:WHEN (EQ (CHARCODE %:
)
-                                                           C2)
-                                                     (HELP 
+                                  (SETQ C (SELECTQ POS
+                                              (0             (* ; 
+
             "Start of byte, used 6 bits from first code, 2 bits from second code, carry over 4 bits")

+                                                 (SETQ POS 1)
+                                                 [WHILE
 (MEMB (SETQ C2 (BIN INSTREAM))
+                                                              (CHARCODE (CR LF]
+                                                 (CL:WHEN (EQ (CHARCODE %:)
+                                                              C2)
+                                                        (HELP 
                                                      "BINHEX FILE TERMINATES IN THE MIDDLE OF A BYTE"
-                                                           ))
-                                              [SETQ C2 (CL:SVREF BINHEXCHARARRAY
-                                                              (- C2 (CONSTANT (CHCON1 BINHEXCHARS]
-                                              (SETQ NEXTBYTE (LOGAND 255 (LLSH C2 4)))
-                                              (LOGOR (LLSH C 2)
-                                                     (LRSH C2 4)))
-                                           (1                (* ; 
-
                    " NEXTBYTE has 4 left-adjusted bits, use 4 bits from current code, save 2 bits")

-                                              (SETQ POS 2)
-                                              (PROG1 (LOGOR NEXTBYTE (LRSH C 2))
-                                                  (SETQ NEXTBYTE (LOGAND 255 (LLSH C 6)))))
-                                           (2                (* ; 
-
                "NEXTBYTE has 2 left-adjusted bits, use all 6 bits from current code, save nothing")

-                                              (SETQ POS 0)
-                                              (PROG1 (LOGOR NEXTBYTE C)
-                                                     (SETQ NEXTBYTE 0)))
-                                           NIL))
+                                                              ))
+                                                 [SETQ C2 (CL:SVREF BINHEXCHARARRAY
+                                                                 (- C2 (CONSTANT (CHCON1 BINHEXCHARS]
+                                                 (SETQ NEXTBYTE (LOGAND 255 (LLSH C2 4)))
+                                                 (LOGOR (LLSH C 2)
+                                                        (LRSH C2 4)))
+                                              (1             (* ; 
+
                      " NEXTBYTE has 4 left-adjusted bits, use 4 bits from current code, save 2 bits")

+                                                 (SETQ POS 2)
+                                                 (PROG1 (LOGOR NEXTBYTE (LRSH C 2))
+                                                     (SETQ NEXTBYTE (LOGAND 255 (LLSH C 6)))))
+                                              (2             (* ; 
+
                  "NEXTBYTE has 2 left-adjusted bits, use all 6 bits from current code, save nothing")

+                                                 (SETQ POS 0)
+                                                 (PROG1 (LOGOR NEXTBYTE C)
+                                                        (SETQ NEXTBYTE 0)))
+                                              NIL))
 
-                               (* ;; "144 is hex 90, the repetition mark")

+                                  (* ;; "144 is hex 90, the repetition mark")

 
-                               (IF
 REPFLAG
-                                   THEN
 
+                                  (IF
 REPFLAG
+                                      THEN
 
+                                           (* ;; "C now contains the repetition factor")

 
-                                         (* ;; "C now contains the repetition factor")

-
-                                         (IF
 (EQ C 0)
-                                             THEN
 (SETQ LASTBYTE 144)
-                                                   (RETURN 144)
-                                           ELSE
 
+                                           (IF
 (EQ C 0)
+                                               THEN
 (SETQ LASTBYTE 144)
+                                                    (RETURN 144)
+                                             ELSE
 
 
                                             (* ;; "We already put out the prefix byte, and now we are putting out one that corresponds to the repeat-mark+number.")

 
-                                                 (SETQ REPEAT (- C 2))
-                                                 (RETURN LASTBYTE))
-                                 ELSEIF
 (EQ C 144)
-                                   THEN
 (SETQ REPFLAG T)
-                                         (GO GETBYTE)
-                                 ELSE
 (SETQ LASTBYTE C)
-                                       (RETURN C)))]
-          ELSE
 (CL:DECF REPEAT)
-                LASTBYTE)))
+                                                  (SETQ REPEAT (- C 2))
+                                                  (RETURN LASTBYTE))
+                                    ELSEIF
 (EQ C 144)
+                                      THEN
 (SETQ REPFLAG T)
+                                           (GO GETBYTE)
+                                    ELSE
 (SETQ LASTBYTE C)
+                                         (RETURN C)))]
+                 ELSE
 (CL:DECF REPEAT)
+                      LASTBYTE)))
 
-(PUTPROPS BINHEXWORD  MACRO

-   (NIL (LOGOR (LLSH (BINHEXBYTE)
-                     8)
-               (BINHEXBYTE))))
+(PUTPROPS BINHEXWORD
 MACRO
 (NIL (LOGOR (LLSH (BINHEXBYTE)
+                                             8)
+                                       (BINHEXBYTE))))
 
-(PUTPROPS BINHEXLONG  MACRO

-   (NIL (LOGOR (LLSH (BINHEXWORD)
-                     16)
-               (BINHEXWORD))))
+(PUTPROPS BINHEXLONG
 MACRO
 (NIL (LOGOR (LLSH (BINHEXWORD)
+                                             16)
+                                       (BINHEXWORD))))
 )
 )
 
 (RPAQ? ATTACHMENTDIR
 '(CONCAT "{dsk}/tilde/" (L-CASE (USERNAME))
-                                 "/attachments"))
+                             "/attachments"))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS ATTACHMENTDIR)
@@ -1823,9 +1821,8 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 
 (RPAQ? CURRENTCHARENCODING
 'XEROX-RENDERING)
 
-(RPAQQ CACHEDCHARENCODINGS
 (ISO8859/1 ISO-8859-1 ISO8859_1 ISO% 8859-1 LATIN1 ISO8859/2 
-                                      ISO-8859-2 ISO8859_2 LATIN2 CP1252 WINDOWS-1252 CP1250 
-                                      WINDOWS-1250))
+(RPAQQ CACHEDCHARENCODINGS
 (ISO8859/1 ISO-8859-1 ISO8859_1 ISO% 8859-1 LATIN1 ISO8859/2 ISO-8859-2 
+                                  ISO8859_2 LATIN2 CP1252 WINDOWS-1252 CP1250 WINDOWS-1250))
 
 
 
@@ -1951,22 +1948,21 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 (DECLARE%: EVAL@COMPILE
 
 (RECORD MIMEPART
 (STARTPOS ENDPOS TYPE ENCODING DISPOSITION PARTNUM SUBPARTS)
-                     (RECORD TYPE ((MAINTYPE SUBTYPE) . TYPEPROPS))
-                     (RECORD DISPOSITION ((MAINDISPOSITION SUBDISPOSITION) . DISPOSITIONPROPS)))
+                 (RECORD TYPE ((MAINTYPE SUBTYPE) . TYPEPROPS))
+                 (RECORD DISPOSITION ((MAINDISPOSITION SUBDISPOSITION) . DISPOSITIONPROPS)))
 )
 )
-(PUTPROPS MIME COPYRIGHT ("Xerox Corporation" 1998 1999 1920 2000 2001 2002 2005))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2958 37439 (DEMIME 2968 . 4254) (PARSEMIME 4256 . 12136) (DEMIMEPART 12138 . 15903) (
-DEMIMETEXT 15905 . 20315) (DEMIMEAPPL 20317 . 25190) (MIMEERROR 25192 . 25520) (MIMEHEADERS 25522 . 
-27090) (MIMEPARAMS 27092 . 30800) (PARSE-SUNATTACHMENT 30802 . 33712) (RECODEMIMEHEADER 33714 . 37437)
-) (37733 44293 (LA.COPY.MESSAGE.TEXT 37743 . 40444) (\LAFITE.APPEND.MESSAGE.BODY 40446 . 44291)) (
-44407 44646 (PRINTMESSAGESUMMARY.STRING 44417 . 44644)) (44647 54572 (ADDMIMEOBJECT 44657 . 46002) (
-MIMEOBJINIT 46004 . 46929) (MIMEOBJ.DISPLAYFN 46931 . 48688) (MIMEOBJ.COPYFN 48690 . 49587) (
-MIMEOBJ.BUTTONEVENTINFN 49589 . 52996) (MIMEOBJ.IMAGEBOXFN 52998 . 54570)) (54592 64584 (DEPS 54602 . 
-57677) (FINDPSSEGMENTS 57679 . 59923) (POSTSCRIPTPART 59925 . 64582)) (64585 101169 (STREAMFROMBASE64 
-64595 . 73017) (STREAMFROMBINHEX 73019 . 78166) (STREAMFROMASCII 78168 . 79197) (
-STREAMFROMENRICHEDTEXT 79199 . 86552) (STREAMFROMUUENCODE 86554 . 89507) (STREAMFROMQUOTEDPRINTABLE 
-89509 . 94702) (STREAMFROMUTF-8 94704 . 101167)) (105793 110524 (CACHEMIMECHARRECODEMAPS 105803 . 
-107748) (MIMEFASTRECODECHARCODE 107750 . 109231) (MIMERECODEMAP 109233 . 110522)))))
+  (FILEMAP (NIL (2880 37361 (DEMIME 2890 . 4176) (PARSEMIME 4178 . 12058) (DEMIMEPART 12060 . 15825) (
+DEMIMETEXT 15827 . 20237) (DEMIMEAPPL 20239 . 25112) (MIMEERROR 25114 . 25442) (MIMEHEADERS 25444 . 
+27012) (MIMEPARAMS 27014 . 30722) (PARSE-SUNATTACHMENT 30724 . 33634) (RECODEMIMEHEADER 33636 . 37359)
+) (37656 44216 (LA.COPY.MESSAGE.TEXT 37666 . 40367) (\LAFITE.APPEND.MESSAGE.BODY 40369 . 44214)) (
+44330 44569 (PRINTMESSAGESUMMARY.STRING 44340 . 44567)) (44570 54495 (ADDMIMEOBJECT 44580 . 45925) (
+MIMEOBJINIT 45927 . 46852) (MIMEOBJ.DISPLAYFN 46854 . 48611) (MIMEOBJ.COPYFN 48613 . 49510) (
+MIMEOBJ.BUTTONEVENTINFN 49512 . 52919) (MIMEOBJ.IMAGEBOXFN 52921 . 54493)) (54515 64507 (DEPS 54525 . 
+57600) (FINDPSSEGMENTS 57602 . 59846) (POSTSCRIPTPART 59848 . 64505)) (64508 101092 (STREAMFROMBASE64 
+64518 . 72940) (STREAMFROMBINHEX 72942 . 78089) (STREAMFROMASCII 78091 . 79120) (
+STREAMFROMENRICHEDTEXT 79122 . 86475) (STREAMFROMUUENCODE 86477 . 89430) (STREAMFROMQUOTEDPRINTABLE 
+89432 . 94625) (STREAMFROMUTF-8 94627 . 101090)) (106123 110854 (CACHEMIMECHARRECODEMAPS 106133 . 
+108078) (MIMEFASTRECODECHARCODE 108080 . 109561) (MIMERECODEMAP 109563 . 110852)))))
 STOP

library/lafite/LAFITE-NEWNSMAIL

@@ -1,18 +1,18 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 5-Sep-95 16:43:15" {DSK}<lispcore>lafite>parc-94>NEWNSMAIL.;2
 91089  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS NEWNSMAILCOMS)
+
(FILECREATED "24-Feb-2024 11:59:44" {WMEDLEY}<library>lafite>LAFITE-NEWNSMAIL.;2
 95095  
 
-      previous date%: " 6-Aug-93 17:20:37" {DSK}<lispcore>lafite>parc-94>NEWNSMAIL.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-NEWNSMAILCOMS NEWNSMAILCOMS)
+                  (FNS \NSMAIL.NEW.CHECK)
+
+      :PREVIOUS-DATE " 5-Sep-95 16:43:15" {WMEDLEY}<library>lafite>NEWNSMAIL.;1)
 
 
-(* ; "
-Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-NEWNSMAILCOMS)
 
-(PRETTYCOMPRINT NEWNSMAILCOMS)
-
-(RPAQQ NEWNSMAILCOMS

+(RPAQQ LAFITE-NEWNSMAILCOMS

        [(COURIERPROGRAMS NEW.MAILTRANSPORT NEW.INBASKET)
         (COMS                                                (* ; "Courier type EnvelopeItem")

               (FNS \NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM)
@@ -68,20 +68,19 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
               (VARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
               (GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
               (ALISTS (LAFITEMODELST NS))
-              (FILES NSMAIL))
+              (FILES LAFITE-NSMAIL))
         (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
                (RECORDS FORWARD)
                (MACROS \NSMAIL.BODY.PART.TYPE)
                (GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES)
                [P (CL:PROCLAIM '(CL:SPECIAL *RETRIEVAL-ERROR*]
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (FILES (LOADCOMP)
-                      NSMAIL ATBL)
+                      LAFITE-NSMAIL ATBL)
                                                              (* ; "ATBL has \COMPUTED.FORM macro.")

                (CONSTANTS * \NSMAIL.CONTENTS.TYPES)
-                                                             (* ; 
-
                                                           "This one we need at run time also")

+                                                             (* ; "This one we need at run time also")

                DOCOPY
                (VARS \NSMAIL.BODY.PART.TYPES))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
@@ -106,7 +105,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
                               (ReportNotAllowed 4)))
        (NAME NSNAME)
        (RNAME NEW.RNAME                                      (* ; 
-
                                                   "(choice (xns 0 name) (gateway 1 gateway.name))")

+
                                                     "(choice (xns 0 name) (gateway 1 gateway.name))")

               )
        (RNAME.LIST (SEQUENCE RNAME))
        [GATEWAY.NAME (RECORD (COUNTRY STRING)
@@ -367,8 +366,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
         (Converted 15 (SEQUENCE CONVERTED.ITEM))
         (AuthenticationLevelOfSender 16 AUTHENTICATION.LEVEL)))
 
-(PUTPROPS NEW.ENVELOPE.ITEM
 COURIERDEF
 (\NS.NEW.READ.ENVELOPE.ITEM 
-                                                      \NS.NEW.WRITE.ENVELOPE.ITEM))
+(PUTPROPS NEW.ENVELOPE.ITEM
 COURIERDEF
 (\NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM))
 
 
 
@@ -414,8 +412,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
         (BodyOffset 198 LONGCARDINAL)
         (LispFormatting 4911 STRING)))
 
-(PUTPROPS HEADING.ATTRIBUTE
 COURIERDEF
 (\NS.READ.HEADING.ATTRIBUTE 
-                                                      \NS.WRITE.HEADING.ATTRIBUTE))
+(PUTPROPS HEADING.ATTRIBUTE
 COURIERDEF
 (\NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE))
 
 
 
@@ -546,7 +543,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
 (RPAQ? \NSMAIL.NEW.SERVER.CACHE
 )
 
 (RPAQQ *NSMAIL-OP-VECTOR*
 (NEWNS.POLLNEWMAIL NEWNS.OPENMAILBOX NEWNS.NEXTMESSAGE 
-                                     NEWNS.RETRIEVEMESSAGE NEWNS.CLOSEMAILBOX))
+                                 NEWNS.RETRIEVEMESSAGE NEWNS.CLOSEMAILBOX))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE)
@@ -577,8 +574,127 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
 )
 
 (\NSMAIL.NEW.CHECK

-(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS) (* ; "Edited  6-Aug-93 16:41 by bvm") (* ;;; "Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not.  Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW (first new message)") (RESETLST (PROG ((JUSTCHECKING (NULL STREAM)) (STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER)) SESSION POLLRESULT TIMER) (SETQ SESSION (fetch STATESESSION of STATE)) RETRY (COND ((NULL SESSION) (if JUSTCHECKING then (* ; "Just polling, don't need session") (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILPOLL) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (GO GOTRESULT)) (COND ((NULL STREAM) (* ; "Need a real Courier stream for some reason here") (COND ((SETQ STREAM (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL))) (RESETSAVE NIL (LIST (QUOTE CLOSEF) STREAM))) (T (RETURN NIL))))) (COND ((EQ (CAR (SETQ SESSION (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGON) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS)))) (QUOTE ERROR)) (GO ERROR))) (* ; "result = (session state anchor)") (SETQ POLLRESULT (CADR SESSION)) (replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION)))) (T (SETQ POLLRESULT (COND ((NULL STREAM) (* ; "Just checking") (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))) (T (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))))))) GOTRESULT (COND ((NULL POLLRESULT) (* ; "Failed somehow") (RETURN NIL)) ((EQ (CAR (LISTP POLLRESULT)) (QUOTE ERROR)) (COND ((EQ (CADR POLLRESULT) (QUOTE SESSION.ERROR)) (* ; "Session timed out, start a new one") (replace STATESESSION of STATE with (SETQ SESSION NIL)) (replace STATEFIRSTNEW of STATE with NIL) (replace STATEOLDLAST of STATE with NIL) (GO RETRY)) (T (SETQ SESSION POLLRESULT) (GO ERROR))))) (replace STATELASTERROR of STATE with NIL) (replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL) (RETURN (COURIER.FETCH (NEW.INBASKET . STATE) TOTAL of POLLRESULT)) ERROR (if (AND (NOT (EQUAL (CDR SESSION) (QUOTE (CONNECTION.PROBLEM NoResponse)))) (NOT (EQUAL (CDR SESSION) (fetch STATELASTERROR of STATE)))) then (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.") (replace STATELASTERROR of STATE with (CDR SESSION)) (LET ((ERRMSG (CASE (CADR SESSION) ((REJECT) (* ; "3rd element = reject reason") (LET* ((REASON (CADDR SESSION)) (TYPE (CAR REASON))) (if (AND (EQ TYPE (QUOTE WrongVersionOfService)) (<= (CAADR REASON) 1) (< (CADADR REASON) 2)) then (* ; "Server supports old inbasket, but not new") (PRINTOUT PROMPTWINDOW T T "****Note: " (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) " does not support new mail protocols." T) (if (NOT RETURNERRORS) then (RETURN NIL))) TYPE)) ((SERVICE.ERROR ACCESS.ERROR) (* ; "the specific reason is just as informative, and more readable than the whole error.") (CADDR SESSION)) (T (COND (NSWIZARDFLG (HELP SESSION))) (SUBSTRING (CDR SESSION) 2 -2))))) (if RETURNERRORS then (RETURN (CONS (QUOTE ERROR) ERRMSG)) elseif (AND (EQ ERRMSG (QUOTE NoSuchInbasket)) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) then (* ;; "We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately") (replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0) else (LET ((*PRINT-CASE* :UPCASE)) (* ; "Lousy atomic error names...") (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A" (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) (CASE ERRMSG (NoSuchService "Mail service not running") (T ERRMSG))))))) (RETURN NIL))))
-)
+  [LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS)

+                                                             (* ; "Edited 24-Feb-2024 11:54 by rmk")


+                                                             (* ; "Edited  6-Aug-93 16:41 by bvm")

+
+(* ;;; "Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not.  Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW (first new message)")

+
+    (RESETLST
+        (PROG ((JUSTCHECKING (NULL STREAM))
+               (STATE (fetch
 (MAILSERVER MAILSTATE) of
 MAILSERVER))
+               SESSION POLLRESULT TIMER)
+              (SETQ SESSION (fetch
 STATESESSION of
 STATE))
+          RETRY
+              [COND
+                 [(NULL SESSION)
+                  (if
 JUSTCHECKING
+                      then
                                   (* ; "Just polling, don't need session")

+                           (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
+                                                   'NEW.INBASKET
+                                                   'MAILPOLL
+                                                   (fetch
 STATENAME of
 STATE)
+                                                   (CAR CREDENTIALS)
+                                                   (CDR CREDENTIALS)
+                                                   'RETURNERRORS))
+                           (GO GOTRESULT))
+                  [COND
+                     ((NULL STREAM)                          (* ; 
+
                                                    "Need a real Courier stream for some reason here")

+                      (COND
+                         ((SETQ STREAM (COURIER.OPEN ADDRESS NIL T 'NSMAIL))
+                          (RESETSAVE NIL (LIST 'CLOSEF STREAM)))
+                         (T (RETURN NIL]
+                  (COND
+                     ((EQ [CAR (SETQ SESSION (COURIER.CALL STREAM 'NEW.INBASKET 'LOGON
+                                                    (fetch
 STATENAME of
 STATE)
+                                                    (CAR CREDENTIALS)
+                                                    (CDR CREDENTIALS)
+                                                    'RETURNERRORS]
+                          'ERROR)
+                      (GO ERROR)))                           (* ; "result = (session state anchor)")

+                  (SETQ POLLRESULT (CADR SESSION))
+                  (replace
 STATESESSION of
 STATE with
 (SETQ SESSION (CAR SESSION]
+                 (T (SETQ POLLRESULT (COND
+                                        ((NULL STREAM)       (* ; "Just checking")

+                                         (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET 
+                                                'NEW.INBASKET 'MAILCHECK SESSION 'RETURNERRORS))
+                                        (T (COURIER.CALL STREAM 'NEW.INBASKET 'MAILCHECK SESSION
+                                                  'RETURNERRORS]
+          GOTRESULT
+              [COND
+                 ((NULL POLLRESULT)                          (* ; "Failed somehow")

+                  (RETURN NIL))
+                 ((EQ (CAR (LISTP POLLRESULT))
+                      'ERROR)
+                  (COND
+                     ((EQ (CADR POLLRESULT)
+                          'SESSION.ERROR)                    (* ; 
+
                                                             "Session timed out, start a new one")

+                      (replace
 STATESESSION of
 STATE with
 (SETQ SESSION NIL))
+                      (replace
 STATEFIRSTNEW of
 STATE with
 NIL)
+                      (replace
 STATEOLDLAST of
 STATE with
 NIL)
+                      (GO RETRY))
+                     (T (SETQ SESSION POLLRESULT)
+                        (GO ERROR]
+              (replace
 STATELASTERROR of
 STATE with
 NIL)
+              (replace
 (MAILSERVER CONTINUANCE) of
 MAILSERVER with
 NIL)
+              (RETURN (COURIER.FETCH (NEW.INBASKET . STATE)
+                             TOTAL of POLLRESULT))
+          ERROR
+              [if
 [AND [NOT (EQUAL (CDR SESSION)
+                                   '(CONNECTION.PROBLEM NoResponse]
+                       (NOT (EQUAL (CDR SESSION)
+                                   (fetch
 STATELASTERROR of
 STATE]
+                  then
 
+                       (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.")

+
+                       (replace
 STATELASTERROR of
 STATE with
 (CDR SESSION))
+                       (LET [(ERRMSG (CASE (CADR SESSION)
+                                         ((REJECT)           (* ; "3rd element = reject reason")

+                                            (LET* ((REASON (CADDR SESSION))
+                                                   (TYPE (CAR REASON)))
+                                                  (if
 (AND (EQ TYPE 'WrongVersionOfService)
+                                                           (<= (CAADR REASON)
+                                                               1)
+                                                           (< (CADADR REASON)
+                                                              2))
+                                                      then
   (* ; 
+
                                                          "Server supports old inbasket, but not new")

+                                                           (PRINTOUT PROMPTWINDOW T T "****Note: "
+                                                                  (fetch
 (MAILSERVER MAILSERVERNAME)
+                                                                     of
 MAILSERVER)
+                                                                  
+                                                              " does not support new mail protocols."
+                                                                  T)
+                                                           (if
 (NOT RETURNERRORS)
+                                                               then
 (RETURN NIL)))
+                                                  TYPE))
+                                         ((SERVICE.ERROR ACCESS.ERROR) 
+                                                             (* ; 
+
                "the specific reason is just as informative, and more readable than the whole error.")

+                                            (CADDR SESSION))
+                                         (T (COND
+                                               (NSWIZARDFLG (HELP SESSION)))
+                                            (SUBSTRING (CDR SESSION)
+                                                   2 -2)))]
+                            (if
 RETURNERRORS
+                                then
 (RETURN (CONS 'ERROR ERRMSG))
+                              elseif
 (AND (EQ ERRMSG 'NoSuchInbasket)
+                                          (\NSMAIL.FIX.MAILBOX.LOCATIONS))
+                                then
 
+
+                                 (* ;; "We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately")

+
+                                     (replace
 (MAILSERVER CONTINUANCE) of
 MAILSERVER with
 0)
+                              else
 (LET ((*PRINT-CASE* :UPCASE))
+                                                             (* ; "Lousy atomic error names...")

+                                        (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A"
+                                               (fetch
 (MAILSERVER MAILSERVERNAME) of
 MAILSERVER)
+                                               (CASE ERRMSG
+                                                   (NoSuchService "Mail service not running")
+                                                   (T ERRMSG))]
+              (RETURN NIL)))])
 
 (NEWNS.NEXTMESSAGE

 (LAMBDA (MAILBOX) (* ; "Edited 13-Dec-89 17:27 by bvm") (LET ((NEXT (NEW.INBASKET.CALL MAILBOX (QUOTE RETRIEVE.ENVELOPES) (fetch NSMAILLASTINDEX of MAILBOX) (QUOTE NEXT) (fetch NSMAILSESSION of MAILBOX)))) (* ;; "NEXT = (envelope status index)") (DESTRUCTURING-BIND (ENVELOPE STATUS INDEX) NEXT (if (EQ INDEX 0) then (* ; "No more messages") NIL else (replace NSMAILLASTINDEX of MAILBOX with INDEX) (replace NSMAILENVTAIL of MAILBOX with ENVELOPE) (* ; "Success") T))))
@@ -684,17 +800,17 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
 (RPAQQ \NSMAIL.GOOD.BODY.PARTS
 (0 5 6 2))
 
 (RPAQQ \NSMAIL.DISCARDABLE.BODY.PARTS
 ((201 "Tioga formatting")
-                                           (202 "Tioga header")))
+                                       (202 "Tioga header")))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
 )
 
 (ADDTOVAR LAFITEMODELST
 (NS 1 \NSMAIL.NEW.SEND.PARSE \NSMAIL.NEW.SEND \NSMAIL.MAKEANSWERFORM 
-                                \NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P 
-                                \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.LOGIN))
+                            \NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P 
+                            \NSMAIL.LOGIN))
 
-(FILESLOAD NSMAIL)
+(FILESLOAD LAFITE-NSMAIL)
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -709,11 +825,10 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS \NSMAIL.BODY.PART.TYPE
 MACRO
 [ARGS (COND
-                                                        ((CADR (ASSOC (CAR ARGS)
-                                                                      \NSMAIL.BODY.PART.TYPES)))
-                                                        (T (ERROR "Unknown body part type"
-                                                                  (CAR ARGS))
-                                                           'IGNOREMACRO])
+                                                ((CADR (ASSOC (CAR ARGS)
+                                                              \NSMAIL.BODY.PART.TYPES)))
+                                                (T (ERROR "Unknown body part type" (CAR ARGS))
+                                                   'IGNOREMACRO])
 )
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -726,16 +841,16 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 
 (FILESLOAD (LOADCOMP)
-       NSMAIL ATBL)
+       LAFITE-NSMAIL ATBL)
 
 
 (RPAQQ \NSMAIL.CONTENTS.TYPES
 ((\CT.NULL 0)
-                                   (\CT.STANDARD.MESSAGE 4)
-                                   (\CT.REPORT 6)))
+                               (\CT.STANDARD.MESSAGE 4)
+                               (\CT.REPORT 6)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \CT.NULL
 0)
@@ -774,26 +889,25 @@ DOCOPY
 
 (ADDTOVAR LAMA
 NEW.INBASKET.CALL)
 )
-(PUTPROPS NEWNSMAIL COPYRIGHT ("Xerox Corporation" 1989 1990 1992 1993 1995))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17944 19459 (\NS.NEW.READ.ENVELOPE.ITEM 17954 . 18719) (\NS.NEW.WRITE.ENVELOPE.ITEM 
-18721 . 19457)) (20397 22075 (\NS.READ.HEADING.ATTRIBUTE 20407 . 21385) (\NS.WRITE.HEADING.ATTRIBUTE 
-21387 . 22073)) (23334 24737 (\NSMAIL.READ.RNAME 23344 . 23902) (\NSMAIL.WRITE.RNAME 23904 . 24395) (
-\NSMAIL.RNAME.LENGTH 24397 . 24735)) (24841 26915 (RNAME.TO.STRING 24851 . 25030) (X400.NAME.TO.STRING
- 25032 . 26719) (EQUAL.RNAMES 26721 . 26913)) (26940 46533 (\NSMAIL.NEW.SEND.PARSE 26950 . 29292) (
-\NSMAIL.CHECK.ENUMERATION 29294 . 30213) (\NSMAIL.NEW.SEND 30215 . 38707) (
-\NSMAIL.NEW.INVALID.RECIPIENTS 38709 . 39290) (\NSMAIL.BUILD.HEADING 39292 . 40591) (
-\NSMAIL.POST.BODY.PART 40593 . 42424) (\NSMAIL.NEW.PREPARE.ATTACHMENT 42426 . 44075) (
-\NSMAIL.CHECK.ABORT 44077 . 44435) (\NSMAIL.NEW.FINDSERVER 44437 . 45492) (\NSMAIL.NEW.CHECKSERVER 
-45494 . 46531)) (48707 88661 (\NSMAIL.NEW.AUTHENTICATE 48717 . 49925) (NEWNS.POLLNEWMAIL 49927 . 50242
-) (NEWNS.OPENMAILBOX 50244 . 50928) (\NSMAIL.NEW.CHECK 50930 . 54952) (NEWNS.NEXTMESSAGE 54954 . 55448
-) (NEWNS.RETRIEVEMESSAGE 55450 . 59314) (\NSMAIL.READ.BODY.PARTS 59316 . 64727) (\NSMAIL.COPY.IA5 
-64729 . 65478) (\NSMAIL.COPY.NSTEXTFILE 65480 . 67629) (\NSMAIL.READ.HEADING 67631 . 70366) (
-\NSMAIL.PARSE.ANNOTATION 70368 . 71102) (\NSMAIL.EMIT.ANNOTATION 71104 . 72372) (LA.TRIM.WHITESPACE 
-72374 . 72496) (\NSMAIL.READ.FORWARDING 72498 . 73523) (\NSMAIL.NEW.PRINT.HEADING 73525 . 79149) (
-\NSMAIL.NEW.PRINT.NAMES 79151 . 80127) (\NSMAIL.EMIT.FORWARDING 80129 . 81963) (\NSMAIL.GDATE 81965 . 
-82081) (\NSMAIL.TRANSLATE.IP.MESSAGEID 82083 . 82630) (\NSMAIL.MAYBE.QUOTE 82632 . 83270) (NULL.NSNAME
- 83272 . 83614) (\NSMAIL.HANDLE.DELIVERY.REPORT 83616 . 86647) (\NSMAIL.RECIPIENT.NAME 86649 . 86876) 
-(NEW.INBASKET.CALL 86878 . 87502) (NEWNS.CLOSEMAILBOX 87504 . 88220) (\NSMAIL.NEW.LOGOFF 88222 . 88659
+  (FILEMAP (NIL (17902 19417 (\NS.NEW.READ.ENVELOPE.ITEM 17912 . 18677) (\NS.NEW.WRITE.ENVELOPE.ITEM 
+18679 . 19415)) (20300 21978 (\NS.READ.HEADING.ATTRIBUTE 20310 . 21288) (\NS.WRITE.HEADING.ATTRIBUTE 
+21290 . 21976)) (23182 24585 (\NSMAIL.READ.RNAME 23192 . 23750) (\NSMAIL.WRITE.RNAME 23752 . 24243) (
+\NSMAIL.RNAME.LENGTH 24245 . 24583)) (24689 26763 (RNAME.TO.STRING 24699 . 24878) (X400.NAME.TO.STRING
+ 24880 . 26567) (EQUAL.RNAMES 26569 . 26761)) (26788 46381 (\NSMAIL.NEW.SEND.PARSE 26798 . 29140) (
+\NSMAIL.CHECK.ENUMERATION 29142 . 30061) (\NSMAIL.NEW.SEND 30063 . 38555) (
+\NSMAIL.NEW.INVALID.RECIPIENTS 38557 . 39138) (\NSMAIL.BUILD.HEADING 39140 . 40439) (
+\NSMAIL.POST.BODY.PART 40441 . 42272) (\NSMAIL.NEW.PREPARE.ATTACHMENT 42274 . 43923) (
+\NSMAIL.CHECK.ABORT 43925 . 44283) (\NSMAIL.NEW.FINDSERVER 44285 . 45340) (\NSMAIL.NEW.CHECKSERVER 
+45342 . 46379)) (48551 92848 (\NSMAIL.NEW.AUTHENTICATE 48561 . 49769) (NEWNS.POLLNEWMAIL 49771 . 50086
+) (NEWNS.OPENMAILBOX 50088 . 50772) (\NSMAIL.NEW.CHECK 50774 . 59139) (NEWNS.NEXTMESSAGE 59141 . 59635
+) (NEWNS.RETRIEVEMESSAGE 59637 . 63501) (\NSMAIL.READ.BODY.PARTS 63503 . 68914) (\NSMAIL.COPY.IA5 
+68916 . 69665) (\NSMAIL.COPY.NSTEXTFILE 69667 . 71816) (\NSMAIL.READ.HEADING 71818 . 74553) (
+\NSMAIL.PARSE.ANNOTATION 74555 . 75289) (\NSMAIL.EMIT.ANNOTATION 75291 . 76559) (LA.TRIM.WHITESPACE 
+76561 . 76683) (\NSMAIL.READ.FORWARDING 76685 . 77710) (\NSMAIL.NEW.PRINT.HEADING 77712 . 83336) (
+\NSMAIL.NEW.PRINT.NAMES 83338 . 84314) (\NSMAIL.EMIT.FORWARDING 84316 . 86150) (\NSMAIL.GDATE 86152 . 
+86268) (\NSMAIL.TRANSLATE.IP.MESSAGEID 86270 . 86817) (\NSMAIL.MAYBE.QUOTE 86819 . 87457) (NULL.NSNAME
+ 87459 . 87801) (\NSMAIL.HANDLE.DELIVERY.REPORT 87803 . 90834) (\NSMAIL.RECIPIENT.NAME 90836 . 91063) 
+(NEW.INBASKET.CALL 91065 . 91689) (NEWNS.CLOSEMAILBOX 91691 . 92407) (\NSMAIL.NEW.LOGOFF 92409 . 92846
 )))))
 STOP

library/lafite/LAFITE-NOXNSPATCH

@@ -0,0 +1,117 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "24-Feb-2024 12:03:41" {WMEDLEY}<library>lafite>LAFITE-NOXNSPATCH.;1
 7148   
+
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "24-Feb-2024 12:02:23" {WMEDLEY}<library>lafite>NOXNSPATCH.;2)
+
+
+(PRETTYCOMPRINT LAFITE-NOXNSPATCHCOMS)
+
+(RPAQQ LAFITE-NOXNSPATCHCOMS

+       [
+        (* ;; "Suppress login/clearinghouse/nsmail if not running XNS.  Mail stuff is necessary in order to parse old NS messages in existing folders.  User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite.")

+
+        [COMS                                                (* ; "Suppress general XNS access")

+              (FNS NOXNSLOGIN NOXNSCANONICAL.NSHOSTNAME NOXNSGETCLEARINGHOUSE)
+              (P (MOVD? 'LOGIN 'XNSLOGIN)
+                 (MOVD 'NOXNSLOGIN 'LOGIN)
+                 (MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
+                 (MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
+                 (MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
+                 (MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE]
+        (COMS                                                (* ; 
+
                                        "Let Unixmail deal with old NS messages when XNS unavailable")

+              (FNS NOXNSNSMAIL.NEW.AUTHENTICATE NOXNSNSMAIL.MAKEANSWERFORM NOXNSNSMAIL.NEW.SEND 
+                   NOXNSNSMAIL.NEW.SEND.PARSE)
+              (INITVARS (NS.USER.NAME "no NS user name"))
+              (VARS (LAFITE.USE.ALL.MODES NIL))
+              (P (MOVD? '\NSMAIL.NEW.AUTHENTICATE 'XNSNSMAIL.NEW.AUTHENTICATE)
+                 (MOVD 'NOXNSNSMAIL.NEW.AUTHENTICATE '\NSMAIL.NEW.AUTHENTICATE)
+                 (MOVD? '\NSMAIL.MAKEANSWERFORM 'XNSNSMAIL.MAKEANSWERFORM)
+                 (MOVD 'NOXNSNSMAIL.MAKEANSWERFORM '\NSMAIL.MAKEANSWERFORM)
+                 (MOVD? '\NSMAIL.NEW.SEND 'XNSNSMAIL.NEW.SEND)
+                 (MOVD 'NOXNSNSMAIL.NEW.SEND '\NSMAIL.NEW.SEND)
+                 (MOVD? '\NSMAIL.NEW.SEND.PARSE 'XNSNSMAIL.NEW.SEND.PARSE)
+                 (MOVD 'NOXNSNSMAIL.NEW.SEND.PARSE '\NSMAIL.NEW.SEND.PARSE))
+              (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
+                                                      LAFITE-DECLS])
+
+
+
+(* ;; 
+"Suppress login/clearinghouse/nsmail if not running XNS.  Mail stuff is necessary in order to parse old NS messages in existing folders.  User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite."
+)

+
+
+
+
+(* ; "Suppress general XNS access")

+
+(DEFINEQ
+
+(NOXNSLOGIN

+  [LAMBDA (HOST FLG DIRECTORY MSG)
                       (* ; "Edited 14-Oct-97 18:38 by rmk:")

+
+    (* ;; "Replace login with NOOP Lisp isn't running XNS")

+
+    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
+           (XNSLOGIN HOST FLG DIRECTORY MSG])
+
+(NOXNSCANONICAL.NSHOSTNAME

+  [LAMBDA (HOST)
                                         (* ; "Edited 11-Feb-98 14:34 by rmk:")

+
+    (* ;; "Replace login with NOOP Lisp isn't running XNS")

+
+    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
+           (XNSCANONICAL.NSHOSTNAME HOST])
+
+(NOXNSGETCLEARINGHOUSE

+  [LAMBDA NIL
                                            (* ; "Edited  6-Mar-99 01:15 by rmk:")

+
+    (* ;; "Replace login with NOOP Lisp isn't running XNS")

+
+    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
+           (XNSGETCLEARINGHOUSE])
+)
+
+(MOVD? 'LOGIN 'XNSLOGIN)
+
+(MOVD 'NOXNSLOGIN 'LOGIN)
+
+(MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
+
+(MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
+
+(MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
+
+(MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE)
+
+
+
+(* ; "Let Unixmail deal with old NS messages when XNS unavailable")

+
+(DEFINEQ
+
+(NOXNSNSMAIL.NEW.AUTHENTICATE

+  [LAMBDA NIL                                                (* ; "Edited 18-Mar-99 10:39 by rmk:")

+                                                             (* ; "Edited  8-Mar-99 20:59 by rmk:")

+                                                             (* ; "Edited  6-Mar-99 11:54 by rmk:")

+
+    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

+
+    (IF
 (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
+        THEN
 (XNSNSMAIL.NEW.AUTHENTICATE)
+      ELSE
 (CREATE
 LAFITEMODEDATA
+                      FULLUSERNAME _ (CONCAT NS.USER.NAME ":" CH.DEFAULT.DOMAIN ":" 
+                                            CH.DEFAULT.ORGANIZATION)
+                      SHORTUSERNAME _ (UNIX-USERNAME)
+                      UNPACKEDUSERNAME _ (CREATE
 NSNAME
+                                                NSOBJECT _ NS.USER.NAME
+                                                NSDOMAIN _ CH.DEFAULT.DOMAIN
+                                                NSORGANIZATION _ CH.DEFAULT.ORGANIZATION])
+
+(NOXNSNSMAIL.MAKEANSWERFORM

+  [LAMBDA (MSGDESCRIPTORS MAILFOLDER)                        (* ; "Edited 31-Mar-99 17:04 by rmk:")

+

library/lafite/LAFITE-NSMAIL

@@ -1,22 +1,94 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 6-Aug-93 17:14:21" {DSK}<archive>lafite>sources>nsmail.;34
 48519  
 
-      changes to%:  (VARS NSMAILCOMS) (FILES LLNSDECLS) (FNS \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.PARSE1 \NSMAIL.MAKE.MAILSERVERS)
+
(FILECREATED "24-Feb-2024 11:55:46" {WMEDLEY}<library>lafite>LAFITE-NSMAIL.;1
 51946  
 
-      previous date%: "26-May-92 11:56:11" {DSK}<archive>lafite>sources>nsmail.;30)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS NSMAILCOMS)
+                  (FNS \NSMAIL.COURIER.OPEN)
+
+      :PREVIOUS-DATE "13-Jan-2024 18:26:57" {WMEDLEY}<library>lafite>NSMAIL.;2)
 
 
-(* ; "
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-NSMAILCOMS)
 
-(PRETTYCOMPRINT NSMAILCOMS)
+(RPAQQ LAFITE-NSMAILCOMS

+       (
+        (* ;; "Stuff used by both LAFITE-NEWNSMAIL & OLDNSMAIL")

 
-(RPAQQ NSMAILCOMS ((* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL") (COMS (* ; "Support of authentication") (FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS \NSMAIL.FIX.MAILBOX.LOCATIONS)) (COMS (* ; "Utilities") (FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM) (* ; "Error handling") (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR) (INITVARS (NSMAILDEBUGFLG) (NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))))) (COMS (* ; "Handling attachments as a special kind of image object") (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT) (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT \MAILOBJ.PARSE.ATTRIBUTES) (ADDVARS (FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))) (VARS MAILOBJ.REFERENCE.FIELD) (INITVARS (MAILOBJ.WINDOWOFFSET 16) (MAILOBJ.SKIPCHAR (CHARCODE "."))) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ) (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT) (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))))) (COMS (FNS \NSMAIL.WRITE.ATTRIBUTE) (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES))) (COMS (* ; "sending mail") (FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1 NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED \NSMAIL.SEND.STREAM.AS.STRING) (FILES LAFITEMAIL) (* ; "for LAFITE.MAKE.PARSE.TABLE") (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))) (GLOBALVARS \LAPARSE.NSMAIL) (INITVARS (NSMAIL.NET.HINT) (*NSMAIL-MAX-NOTE-LENGTH* 8000) (*NSMAIL-CACHE-TIMEOUT* 14400000) (*NSMAIL-GENEROUS-SELF-TEST* T) (LAFITEDL.EXT "DL")) (P (CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))) (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM \NSMAIL.PRINT.NAMES)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE) (CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH) (MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (PROP INFO \NSMAIL.ATTRIBUTE.TYPE) (GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES) (FILES (SOURCE) LAFITEDECLS LLNSDECLS) (* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR") (LOCALVARS . T))))
+        (COMS                                                (* ; "Support of authentication")

+              (FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS 
+                   \NSMAIL.FIX.MAILBOX.LOCATIONS))
+        [COMS                                                (* ; "Utilities")

+              (FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT 
+                   \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM)
+                                                             (* ; "Error handling")

+              (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR)
+              (INITVARS (NSMAILDEBUGFLG)
+                     (NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID 
+                                                 Reply-to]
+        [COMS                                                (* ; 
+
                                             "Handling attachments as a special kind of image object")

+              (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY 
+                   \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT)
+              (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB 
+                   \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY 
+                   \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT 
+                   \MAILOBJ.PARSE.ATTRIBUTES)
+              (ADDVARS (FILING.TYPES (VIEWPOINT 4353)
+                              (RES 4428)
+                              (XEROX860 5120)
+                              (REFERENCE 4427)
+                              (MAILFOLDER 4417)))
+              (VARS MAILOBJ.REFERENCE.FIELD)
+              (INITVARS (MAILOBJ.WINDOWOFFSET 16)
+                     (MAILOBJ.SKIPCHAR (CHARCODE ".")))
+              (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ)
+                     (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED))
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT)
+                                                 (AND (EQ MAKESYSNAME :LYRIC)
+                                                      (FILESLOAD (SYSLOAD)
+                                                             NSRANDOM]
+        (COMS (FNS \NSMAIL.WRITE.ATTRIBUTE)
+              (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES)))
+        (COMS                                                (* ; "sending mail")

+              (FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1 
+                   NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED 
+                   \NSMAIL.SEND.STREAM.AS.STRING)
+              (FILES LAFITE-MAIL)
+                                                             (* ; "for LAFITE.MAKE.PARSE.TABLE")

+              (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
+                    )
+              (GLOBALVARS \LAPARSE.NSMAIL)
+              (INITVARS (NSMAIL.NET.HINT)
+                     (*NSMAIL-MAX-NOTE-LENGTH* 8000)
+                     (*NSMAIL-CACHE-TIMEOUT* 14400000)
+                     (*NSMAIL-GENEROUS-SELF-TEST* T)
+                     (LAFITEDL.EXT "DL"))
+              [P (CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* 
+                                      *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*]
+              (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM 
+                   \NSMAIL.PRINT.NAMES))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE)
+               (CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS 
+                      \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE 
+                      MAX.BULK.SEGMENT.LENGTH)
+               (MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO)
+               (PROP INFO \NSMAIL.ATTRIBUTE.TYPE)
+               (GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD 
+                      MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT 
+                      NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS 
+                      \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
+               (FILES (SOURCE)
+                      LAFITE-DECLS LLNSDECLS)
+               
+               (* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR")

+
+               (LOCALVARS . T))))
 
 
 
-(* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL")

+(* ;; "Stuff used by both LAFITE-NEWNSMAIL & OLDNSMAIL")

 
 
 
@@ -61,8 +133,16 @@ RETURN to attempt retrieval anyway." V))))))
 )
 
 (\NSMAIL.READ.STRING.AS.STREAM

-(LAMBDA (INSTREAM OUTSTREAM) (* bvm%: "30-Jul-84 16:13") (* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM") (PROG (LENGTH) (\WIN INSTREAM) (* ; "Skip sequence count") (COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM))) (COND ((ODDP LENGTH) (\BIN INSTREAM)))))
-)
+  [LAMBDA (INSTREAM OUTSTREAM)                               (* bvm%: "30-Jul-84 16:13")

+
+    (* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM")

+
+    (PROG (LENGTH)
+          (\WIN INSTREAM)                                    (* ; "Skip sequence count")

+          (COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM)))
+          (COND
+             ((ODDP LENGTH)
+              (\BIN INSTREAM])
 )
 
 
@@ -72,8 +152,10 @@ RETURN to attempt retrieval anyway." V))))))
 (DEFINEQ
 
 (\NSMAIL.COURIER.OPEN

-(LAMBDA (ADDRESS) (* ; "Edited  9-Sep-88 12:06 by bvm") (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL) NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSMAIL.ERRORHANDLER)))))
-)
+  [LAMBDA (ADDRESS)
                                          (* ; "Edited 24-Feb-2024 11:52 by rmk")


+                                                             (* ; "Edited  9-Sep-88 12:06 by bvm")

+    (COURIER.OPEN ADDRESS NIL T 'LAFITE-NSMAIL NIL (CONSTANT (LIST 'ERRORHANDLER
+                                                                   (FUNCTION \NSMAIL.ERRORHANDLER])
 
 (\NSMAIL.ERRORHANDLER

 (LAMBDA (STREAM ERRCODE) (* ; "Edited  9-Sep-88 12:35 by bvm") (* ;; "Called when SPP error occurs on NS mail courier connection STREAM.  Fakes an error return from the courier.call.") (LET (POS) (if (AND (EQ ERRCODE (QUOTE STREAM.LOST)) (SETQ POS (STKPOS (FUNCTION COURIER.CALL)))) then (BLOCK 500) (RETFROM POS (QUOTE (ERROR STREAM.LOST)) T) else (\SPP.DEFAULT.ERRORHANDLER STREAM ERRCODE))))
@@ -84,9 +166,9 @@ RETURN to attempt retrieval anyway." V))))))
 )
 )
 
-(RPAQ? NSMAILDEBUGFLG)
+(RPAQ? NSMAILDEBUGFLG
 )
 
-(RPAQ? NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to)))
+(RPAQ? NSMAIL.HEADER.ORDER
 '(Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))
 
 
 
@@ -181,23 +263,38 @@ RETURN to attempt retrieval anyway." V))))))
 )
 )
 
-(ADDTOVAR FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))
+(ADDTOVAR FILING.TYPES
 (VIEWPOINT 4353)
+                       (RES 4428)
+                       (XEROX860 5120)
+                       (REFERENCE 4427)
+                       (MAILFOLDER 4417))
 
-(RPAQQ MAILOBJ.REFERENCE.FIELD (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID)) (SERVICE NSNAME) (ADDRESS NSADDRESS) (HOST STRING) (DIRECTORY STRING) (NAME STRING) (TYPE (FILING . ATTRIBUTE.TYPE)) (NIL UNSPECIFIED) (PAGES CARDINAL) (VERSION CARDINAL) (FLAGS CARDINAL))))
+(RPAQQ MAILOBJ.REFERENCE.FIELD

+       (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID))
+                              (SERVICE NSNAME)
+                              (ADDRESS NSADDRESS)
+                              (HOST STRING)
+                              (DIRECTORY STRING)
+                              (NAME STRING)
+                              (TYPE (FILING . ATTRIBUTE.TYPE))
+                              (NIL UNSPECIFIED)
+                              (PAGES CARDINAL)
+                              (VERSION CARDINAL)
+                              (FLAGS CARDINAL))))
 
-(RPAQ? MAILOBJ.WINDOWOFFSET 16)
+(RPAQ? MAILOBJ.WINDOWOFFSET
 16)
 
-(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
+(RPAQ? MAILOBJ.SKIPCHAR
 (CHARCODE "."))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(RECORD MAILOBJ
 (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO)
-)
+(RECORD MAILOBJ
 (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH 
+                       MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO))
 )
 
 (DECLARE%: EVAL@COMPILE 
 
-(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)
+(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED
 8192)
 
 
 (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)
@@ -205,9 +302,11 @@ RETURN to attempt retrieval anyway." V))))))
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(\MAILOBJ.INIT)
+(\MAILOBJ.INIT
)
 
-(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
+(AND (EQ MAKESYSNAME :LYRIC)
+     (FILESLOAD (SYSLOAD)
+            NSRANDOM))
 )
 (DEFINEQ
 
@@ -217,7 +316,21 @@ RETURN to attempt retrieval anyway." V))))))
 )
 (DECLARE%: EVAL@COMPILE DOCOPY 
 
-(RPAQQ \NSMAIL.ATTRIBUTES ((From 4672 NAME.LIST) (Date 4673 TIME) (Reply-to 4674 NAME.LIST) (To 4676 NAME.LIST) (cc 4677 NAME.LIST) (Subject 9 STRING) (Message-ID 4693 MESSAGEID) (Sender 4705 NAME) (BodySize 16 LONGCARDINAL) (BodyType 17 LONGCARDINAL) (Note 4687 STRING) (OldLispFormatting 4910 STRING) (LispFormatting 4911 STRING) (In-Reply-to 4690 STRING)))
+(RPAQQ \NSMAIL.ATTRIBUTES

+       ((From 4672 NAME.LIST)
+        (Date 4673 TIME)
+        (Reply-to 4674 NAME.LIST)
+        (To 4676 NAME.LIST)
+        (cc 4677 NAME.LIST)
+        (Subject 9 STRING)
+        (Message-ID 4693 MESSAGEID)
+        (Sender 4705 NAME)
+        (BodySize 16 LONGCARDINAL)
+        (BodyType 17 LONGCARDINAL)
+        (Note 4687 STRING)
+        (OldLispFormatting 4910 STRING)
+        (LispFormatting 4911 STRING)
+        (In-Reply-to 4690 STRING)))
 )
 
 
@@ -259,32 +372,47 @@ RETURN to attempt retrieval anyway." V))))))
 )
 )
 
-(FILESLOAD LAFITEMAIL)
+(FILESLOAD LAFITE-MAIL)
 
 
 
 (* ; "for LAFITE.MAKE.PARSE.TABLE")

 
 
-(RPAQQ NSMAIL.PARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT) ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE) ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT) ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance) ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity) ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
+(RPAQQ NSMAIL.PARSEFIELDS

+       (("DATE:" LAFITE.READ.LINE.FOR.TOC Date)
+        ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
+        ("SENDER:" LAFITE.READ.NAME.FIELD Sender)
+        ("FROM:" LAFITE.READ.NAME.FIELD From)
+        ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to)
+        ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to)
+        ("TO:" LAFITE.READ.NAME.FIELD To)
+        ("CC:" LAFITE.READ.NAME.FIELD cc)
+        ("FORMAT:" LAFITE.READ.FORMAT)
+        ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE)
+        ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT)
+        ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance)
+        ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity)
+        ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
 
-(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
+(RPAQ \LAPARSE.NSMAIL
 (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS \LAPARSE.NSMAIL)
 )
 
-(RPAQ? NSMAIL.NET.HINT)
+(RPAQ? NSMAIL.NET.HINT
 )
 
-(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)
+(RPAQ? *NSMAIL-MAX-NOTE-LENGTH*
 8000)
 
-(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)
+(RPAQ? *NSMAIL-CACHE-TIMEOUT*
 14400000)
 
-(RPAQ? *NSMAIL-GENEROUS-SELF-TEST* T)
+(RPAQ? *NSMAIL-GENEROUS-SELF-TEST*
 T)
 
-(RPAQ? LAFITEDL.EXT "DL")
+(RPAQ? LAFITEDL.EXT
 "DL")
 
-(CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))
+(CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* 
+                     *NSMAIL-GENEROUS-SELF-TEST*))
 (DEFINEQ
 
 (\NSMAIL.MESSAGE.P

@@ -306,79 +434,100 @@ RETURN to attempt retrieval anyway." V))))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(RECORD NSMAILBOX
 (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE) (ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION of (fetch NSMAILSTATE of DATUM))) (NSMAILFIRSTINDEX (fetch STATEFIRSTNEW of (fetch NSMAILSTATE of DATUM)))))
-)
+(RECORD NSMAILBOX
 (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE)
+                  [ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch
 STATESESSION
+                                                          of
 (fetch
 NSMAILSTATE of
 DATUM)))
+                                        (NSMAILFIRSTINDEX (fetch
 STATEFIRSTNEW
+                                                             of
 (fetch
 NSMAILSTATE of
 DATUM])
 
-(RECORD NSMAILSTATE
 (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS STATELASTERROR STATETIMER)
-)
+(RECORD NSMAILSTATE
 (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS
+                           STATELASTERROR STATETIMER))
 
 (RECORD NSMAILPARSE
 (NSPSUBJECT NSPRECIPIENTS NSPSTART NSPFORMATTED . NSPFIELDS))
 )
 
 (DECLARE%: EVAL@COMPILE 
 
-(RPAQQ \NSMAIL.SOCKET 26)
+(RPAQQ \NSMAIL.SOCKET
 26)
 
-(RPAQQ \SERIALIZED.FILE.VERSION 2)
+(RPAQQ \SERIALIZED.FILE.VERSION
 2)
 
-(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))
+(RPAQQ \SERIALIZED.FILE.VERSIONS
 (2 3))
 
-(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
+(RPAQQ \NSMAIL.TEXT.BODYTYPE
 2)
 
-(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
+(RPAQQ \NSMAIL.EMPTY.BODYTYPE
 4)
 
-(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)
+(RPAQQ \NSMAIL.REFERENCE.BODYTYPE
 4427)
 
-(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
+(RPAQQ MAX.BULK.SEGMENT.LENGTH
 32768)
 
 
-(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
+(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE 
+       \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
 )
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS) \NSMAIL.ATTRIBUTES))) (T (ERROR "Unknown mail attribute" (CAR ARGS)) (QUOTE IGNOREMACRO)))))
+(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE
 MACRO
 [ARGS (COND
+                                                ((CADR (ASSOC (CAR ARGS)
+                                                              \NSMAIL.ATTRIBUTES)))
+                                                (T (ERROR "Unknown mail attribute" (CAR ARGS))
+                                                   'IGNOREMACRO])
 
-(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO (ARGS (LET ((INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS))) \NSMAIL.ATTRIBUTES)))) (COND (INFO (LIST (QUOTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (CAR ARGS) (CAR INFO) (CADDR ARGS) (KWOTE (CADR INFO)))) (T (QUOTE IGNOREMACRO))))))
+(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE
 MACRO

+          [ARGS (LET [(INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS)))
+                                        \NSMAIL.ATTRIBUTES]
+                     (COND
+                        [INFO (LIST '\NSMAIL.WRITE.ATTRIBUTE.MACRO (CAR ARGS)
+                                    (CAR INFO)
+                                    (CADDR ARGS)
+                                    (KWOTE (CADR INFO]
+                        (T 'IGNOREMACRO])
 
-(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE) (COURIER.WRITE STREAM TYPENO NIL (QUOTE LONGCARDINAL)) (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (QUOTE MAILTRANSPORT) VALUETYPE)))
+(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO
 MACRO
 (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE)
+                                                (COURIER.WRITE STREAM TYPENO NIL 'LONGCARDINAL)
+                                                (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE
+                                                       'MAILTRANSPORT VALUETYPE)))
 )
 
 
-(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
+(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE
 INFO
 NOEVAL)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
+(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR
+       MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG 
+       NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
 )
 
 
-(FILESLOAD (SOURCE) LAFITEDECLS LLNSDECLS)
+(FILESLOAD (SOURCE)
+       LAFITE-DECLS LLNSDECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 )
-(PUTPROPS NSMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1992 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3699 7008 (\NSMAIL.LOGIN 3709 . 3935) (NS.FINDMAILBOXES 3937 . 4394) (
-\NSMAIL.MAKE.MAILSERVERS 4396 . 5190) (\NSMAIL.FIX.MAILBOX.LOCATIONS 5192 . 7006)) (7035 9116 (
-\NSMAIL.CHECK.SERIALIZED.VERSION 7045 . 7358) (\NSMAIL.READ.SERIALIZED.CONTENT 7360 . 8254) (
-\NSMAIL.DISCARD.SERIALIZED.CONTENT 8256 . 8703) (\NSMAIL.READ.STRING.AS.STREAM 8705 . 9114)) (9148 
-10549 (\NSMAIL.COURIER.OPEN 9158 . 9361) (\NSMAIL.ERRORHANDLER 9363 . 9785) (\NSMAIL.SIGNAL.ERROR 9787
- . 10547)) (10747 16949 (\MAILOBJ.CREATE 10757 . 12982) (\MAILOBJ.TYPE.NAME 12984 . 13451) (
-\MAILOBJ.NS.TO.LISP.NAME 13453 . 14804) (\MAILOBJ.DISPLAY 14806 . 15126) (\MAILOBJ.GET 15128 . 15951) 
-(\MAILOBJ.IMAGEBOX 15953 . 16081) (\MAILOBJ.PUT 16083 . 16669) (\MAILOBJ.INIT 16671 . 16947)) (16950 
-31846 (\MAILOBJ.BUTTONEVENTFN 16960 . 19089) (\MAILOBJ.DO.COMMAND 19091 . 19338) (\MAILOBJ.HARDCOPY 
-19340 . 21146) (\MAILOBJ.FB 21148 . 21362) (\MAILOBJ.PUT.FILE 21364 . 23029) (\MAILOBJ.VIEW 23031 . 
-25968) (\MAILOBJ.MUNGE.NAME 25970 . 26234) (\MAILOBJ.COPY.BODY 26236 . 26550) (\MAILOBJ.EXPAND 26552
- . 28273) (\MAILOBJ.COPY.CHILD 28275 . 29632) (\MAILOBJ.COPY.SEQUENCE 29634 . 30002) (
-\MAILOBJ.EXTRACT.TEXT 30004 . 31065) (\MAILOBJ.PARSE.ATTRIBUTES 31067 . 31844)) (32756 33393 (
-\NSMAIL.WRITE.ATTRIBUTE 32766 . 33391)) (33818 40701 (\NSMAIL.PARSE.REFERENCE 33828 . 35746) (
-\NSMAIL.EXPAND.DL 35748 . 36815) (\NSMAIL.PARSE 36817 . 37078) (\NSMAIL.PARSE1 37080 . 38288) (
-NS.REMOVEDUPLICATES 38290 . 38428) (\NSMAIL.GUESS.FILE.TYPE 38430 . 38931) (
-COURIER.WRITE.STREAM.UNSPECIFIED 38933 . 40077) (\NSMAIL.SEND.STREAM.AS.STRING 40079 . 40699)) (41866 
-46243 (\NSMAIL.MESSAGE.P 41876 . 42014) (\NSMAIL.MESSAGE.FROM.SELF.P 42016 . 43715) (
-\NSMAIL.MAKEANSWERFORM 43717 . 45341) (\NSMAIL.PRINT.NAMES 45343 . 46241)))))
+  (FILEMAP (NIL (5263 8572 (\NSMAIL.LOGIN 5273 . 5499) (NS.FINDMAILBOXES 5501 . 5958) (
+\NSMAIL.MAKE.MAILSERVERS 5960 . 6754) (\NSMAIL.FIX.MAILBOX.LOCATIONS 6756 . 8570)) (8599 10821 (
+\NSMAIL.CHECK.SERIALIZED.VERSION 8609 . 8922) (\NSMAIL.READ.SERIALIZED.CONTENT 8924 . 9818) (
+\NSMAIL.DISCARD.SERIALIZED.CONTENT 9820 . 10267) (\NSMAIL.READ.STRING.AS.STREAM 10269 . 10819)) (10853
+ 12473 (\NSMAIL.COURIER.OPEN 10863 . 11285) (\NSMAIL.ERRORHANDLER 11287 . 11709) (\NSMAIL.SIGNAL.ERROR
+ 11711 . 12471)) (12673 18875 (\MAILOBJ.CREATE 12683 . 14908) (\MAILOBJ.TYPE.NAME 14910 . 15377) (
+\MAILOBJ.NS.TO.LISP.NAME 15379 . 16730) (\MAILOBJ.DISPLAY 16732 . 17052) (\MAILOBJ.GET 17054 . 17877) 
+(\MAILOBJ.IMAGEBOX 17879 . 18007) (\MAILOBJ.PUT 18009 . 18595) (\MAILOBJ.INIT 18597 . 18873)) (18876 
+33772 (\MAILOBJ.BUTTONEVENTFN 18886 . 21015) (\MAILOBJ.DO.COMMAND 21017 . 21264) (\MAILOBJ.HARDCOPY 
+21266 . 23072) (\MAILOBJ.FB 23074 . 23288) (\MAILOBJ.PUT.FILE 23290 . 24955) (\MAILOBJ.VIEW 24957 . 
+27894) (\MAILOBJ.MUNGE.NAME 27896 . 28160) (\MAILOBJ.COPY.BODY 28162 . 28476) (\MAILOBJ.EXPAND 28478
+ . 30199) (\MAILOBJ.COPY.CHILD 30201 . 31558) (\MAILOBJ.COPY.SEQUENCE 31560 . 31928) (
+\MAILOBJ.EXTRACT.TEXT 31930 . 32991) (\MAILOBJ.PARSE.ATTRIBUTES 32993 . 33770)) (35145 35782 (
+\NSMAIL.WRITE.ATTRIBUTE 35155 . 35780)) (36322 43205 (\NSMAIL.PARSE.REFERENCE 36332 . 38250) (
+\NSMAIL.EXPAND.DL 38252 . 39319) (\NSMAIL.PARSE 39321 . 39582) (\NSMAIL.PARSE1 39584 . 40792) (
+NS.REMOVEDUPLICATES 40794 . 40932) (\NSMAIL.GUESS.FILE.TYPE 40934 . 41435) (
+COURIER.WRITE.STREAM.UNSPECIFIED 41437 . 42581) (\NSMAIL.SEND.STREAM.AS.STRING 42583 . 43203)) (44526 
+48903 (\NSMAIL.MESSAGE.P 44536 . 44674) (\NSMAIL.MESSAGE.FROM.SELF.P 44676 . 46375) (
+\NSMAIL.MAKEANSWERFORM 46377 . 48001) (\NSMAIL.PRINT.NAMES 48003 . 48901)))))
 STOP

library/lafite/LAFITE-SEND

@@ -1,20 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2
 100794 
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2
 100561 
 
-      :CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 7-Feb-2022 12:04:09" 
-{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
+      :CHANGES-TO (VARS LAFITE-SENDCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
 
 
-(* ; "
-Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-SENDCOMS)
 
-(PRETTYCOMPRINT LAFITESENDCOMS)
-
-(RPAQQ LAFITESENDCOMS

+(RPAQQ LAFITE-SENDCOMS

        ((COMS                                                (* ; "Sending mail")

               (FNS DOLAFITESENDINGCOMMAND \SENDMESSAGE.INITIATE \SENDMSG.DELIVER \SENDMSG.EXIT.TEDIT
                    \SENDMSG.SAVE.FORM \LAFITE.HEADER.EOF \LAFITE.INSERT.REPLYTO \SENDMSG.REPLYTO 
@@ -82,7 +79,7 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
                       RECIPIENTSSTR SUBJECTSTR LAFITE.MSG.ICON LAFITEFORMDIRECTORIES 
                       LAFITE.SEND.FORMATTED)
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))))
 
 
@@ -1756,39 +1753,37 @@ cc: ~A
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 )
-(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000 
-2021 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
-\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
-\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 . 
-12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE 
-18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
-\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
-\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 . 
-28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
-\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU 
-41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
-\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 . 
-47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
- . 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918 
-(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
-\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
-\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916)) 
-(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
-MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 . 
-72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
-\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
-\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE 
-78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
-MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 . 
-87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
-MAKEFORWARDFORM 89813 . 93596)))))
+  (FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) (
+\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) (
+\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 . 
+12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE 
+18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) (
+\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) (
+\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 . 
+28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) (
+\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU 
+41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) (
+\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 . 
+47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508
+ . 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799 
+(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) (
+\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) (
+\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797)) 
+(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) (
+MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 . 
+72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) (
+\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) (
+\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE 
+78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) (
+MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 . 
+87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) (
+MAKEFORWARDFORM 89694 . 93477)))))
 STOP

library/lafite/LAFITE-SORT

@@ -1,20 +1,19 @@
 (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)
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SORT.;2
 19458  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-SORTCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:07:18" {WMEDLEY}<library>lafite>LAFITE-SORT.;1)
 
 
-(* ; "
-Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-SORTCOMS)
 
-(PRETTYCOMPRINT LAFITESORTCOMS)
-
-(RPAQQ LAFITESORTCOMS

+(RPAQQ LAFITE-SORTCOMS

        [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                LAFITEDECLS))
+                                                LAFITE-DECLS))
         (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)
@@ -35,7 +34,7 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 )
 (DEFINEQ
 
@@ -229,14 +228,13 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
 
 (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 
+                                         (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 Selected Range" '\LAFITE.SORT.BY.DATE.REGION 
                                "Sort only the messages between the first and last selected messages."
-                                                           ))))
+                                                       ))))
 
 
 
@@ -325,10 +323,9 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
 (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)))))
+  (FILEMAP (NIL (1952 14608 (LAFITE.ASSURE.DATE.FIELDS 1962 . 8059) (LAFITE.PARSE.DATE.FIELD 8061 . 8698
+) (LAFITE.PARSE.DATE.FIELD.ONLY 8700 . 8915) (LAFITE.SORT.BY.DATE 8917 . 9277) (LAFITE.SORT.MESSAGES 
+9279 . 12669) (LAFITEMSG.DATE.ORDER 12671 . 13419) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13421 . 14065) (
+\LAFITE.SORT.BY.DATE.REGION 14067 . 14606)) (15418 19233 (GDATE1-6 15428 . 19231)))))
 STOP

library/lafite/LAFITE-TEDIT

@@ -0,0 +1,123 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2
 6592   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-TEDITCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
+
+
+(PRETTYCOMPRINT LAFITE-TEDITCOMS)
+
+(RPAQQ LAFITE-TEDITCOMS
 (
+                         (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")

+
+                         (FNS LA.ADJUST.FORMATTING LA.DETACH.TEDIT TEDIT.ASSURE.NO.BACKING.FILE 
+                              LA.WINDOW.FROM.TEXTSTREAM)
+                         (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
+                                                                 LAFITE-DECLS)
+                                (GLOBALVARS *TEDIT-FILE-READTABLE*)
+                                (LOCALVARS . T))))
+
+
+
+(* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")

+
+(DEFINEQ
+
+(LA.ADJUST.FORMATTING

+  [LAMBDA (FORMATSTREAM OUTSTREAM BYTE-LENGTHS)
              (* ; "Edited 18-Jan-2024 10:33 by rmk")


+                                                             (* ; "Edited 13-Jan-2024 21:53 by rmk")


+                                                             (* ; "Edited  3-Jun-88 18:24 by bvm")

+
+    (* ;; "Adjusts the formatting info FORMATSTREAM to account for the prepending of one or more %"paragraphs%" of default looking text, whose lengths are given by BYTE-LENGTHS (or a single number if just one piece).  It then writes the resulting formatting to OUTSTREAM.")

+
+    (* ;; "The original code assumed that there were pieces at the beginning of the file that represented the pageframes and charlooks and paralooks vectors, and that that the information for new pieces had to come just after the last of those.  That required parsing the initial pieces, with too much knowledge of Tedit internals.  The reading function\TEDIT.GET.PIECES3 has been revised to relax that ordering constraint, so it is now possible just to slap the new information on the front and place an updated trailer at the end.")

+
+    (PROG ((TRAILER (\TEDIT.GET.TRAILER FORMATSTREAM))
+           PIECESTART PCCOUNT TRAILERSIZE)
+          (CL:UNLESS (EQ 3 (pop
 TRAILER))
+                 (RETURN NIL))
+          (SETQ PIECESTART (pop
 TRAILER))
+          (SETQ TRAILERSIZE (pop
 TRAILER))
+          (SETQ PCCOUNT (CADR TRAILER))                      (* ; "Skip version")

+
+     (* ;; "Write the new-piece information at the beginning of OUTSTREAM.")

+
+     (* ;; "This code allows for multiple inserted pieces, but unfortunately if the textstream already has any paragraph formatting, we can't make the pieces be different paragraphs without making them also have non-default paralooks.")

+
+     (* ;; "The original code used the looks index of the first real piece, 1 if none was encountered.  That was arbitrary, here we arbitrarily assign whatever charlooks got the first index.  (Tedit could arrange for that also to be the index of the first piece, if it mattered).")

+
+          (add
 PIECESTART (for
 PIECELEN inside
 BYTE-LENGTHS sum
 (\TEDIT.PUT.CHARLOOKS1 OUTSTREAM 
+                                                                       PIECELEN 1)
+                                                                (add
 PCCOUNT 1)
+                                                                PIECELEN))
+
+     (* ;; "We are looking just at the format part so presume that its piece descriptions start at its 0.  Copy rest of piece info, not including the old trailer.")

+
+          (COPYBYTES FORMATSTREAM OUTSTREAM 0 (IDIFFERENCE (GETEOFPTR FORMATSTREAM)
+                                                     TRAILERSIZE))
+
+     (* ;; "The piece-pointer for the new trailer is adjusted  above to account for the new pieces in the corresponding CHARSTREAM.")

+
+          (\TEDIT.PUT.TRAILER OUTSTREAM PIECESTART PCCOUNT 3)
+          (RETURN OUTSTREAM])
+
+(LA.DETACH.TEDIT

+  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited 14-Jan-2024 12:56 by rmk")


+                                                             (* ; "Edited  3-Jun-88 17:27 by bvm")

+
+    (* ;; "Removes the TEXTSTREAM from the window, if any, it is being edited in.")

+
+    (TEXTPROP TEXTSTREAM '\WINDOW NIL])
+
+(TEDIT.ASSURE.NO.BACKING.FILE

+  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited 13-Jan-2024 18:08 by rmk")


+                                                             (* ; "Edited 18-Jun-2023 09:31 by rmk")


+                                                             (* ; "Edited 29-Oct-2022 22:34 by rmk")


+                                                             (* ; "Edited 20-May-92 11:25 by rmk:")

+
+    (* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session.  Essentially eliminates the file-system backing store.")

+
+    (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
+           (OFILE (GETTOBJ TEXTOBJ TXTFILE))
+           NEWFILE)
+          (CL:WHEN [AND (TYPE?
 STREAM OFILE)
+                        (NEQ 'NODIRCORE (FETCH
 (FDEV DEVICENAME) OF
 (FETCH
 (STREAM DEVICE)
+                                                                       OF
 (TRUEFILENAME OFILE]
+              (SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
+
+              (* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE.  But the file PCONTENTS do not yet point to the new stream.  ")

+
+              (CLOSEF? OFILE)
+              (\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T))
+              (FSETTOBJ TEXTOBJ TXTFILE NIL)
+              (PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE)
+              TEXTSTREAM)])
+
+(LA.WINDOW.FROM.TEXTSTREAM

+  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited 18-Jun-2023 09:09 by rmk")


+                                                             (* ; "Edited 23-Sep-87 15:36 by bvm:")

+    (\TEDIT.MAINW TEXTSTREAM])
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (SOURCE)
+       LAFITE-DECLS)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS *TEDIT-FILE-READTABLE*)
+)
+
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(LOCALVARS . T)
+)
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) (
+TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359)))))
+STOP

library/lafite/LAFITE-TIMEDDELETE

@@ -1,20 +1,19 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "28-Jun-89 08:53:23" {POOH/N}<POOH>MAXWELL>LISP>LAFITETIMEDDELETE;1
 11153  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS \LAFITE.DELETEEXPIRED MESSAGEAGE)
+
(FILECREATED "27-Feb-2024 09:28:24" {WMEDLEY}<library>lafite>LAFITE-TIMEDDELETE.;3
 10989  
 
-      previous date%: "13-Oct-88 11:05:53" {PHYLUM}<LISPUSERS>MEDLEY>LAFITETIMEDDELETE.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-TIMEDDELETECOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 23:23:25" {WMEDLEY}<library>lafite>LAFITE-TIMEDDELETE.;2)
 
 
-(* "
-Copyright (c) 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-TIMEDDELETECOMS)
 
-(PRETTYCOMPRINT LAFITETIMEDDELETECOMS)
-
-(RPAQQ LAFITETIMEDDELETECOMS

-       ((DECLARE%: DONTCOPY EVAL@COMPILE (FILES LAFITEDECLS))
-        (FILES LAFITEFIND)
+(RPAQQ LAFITE-TIMEDDELETECOMS

+       ((DECLARE%: DONTCOPY EVAL@COMPILE (FILES LAFITE-DECLS))
+        (FILES LAFITE-FIND)
         (FNS \LAFITE.TIMEDDELETE \LAFITE.SETEXPIRATIONS \LAFITE.DELETEEXPIRED)
         (FNS LTD.INIT MESSAGEAGE)
         (INITVARS EXPIRATIONMENU)
@@ -23,10 +22,10 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
         (P (LTD.INIT))))
 (DECLARE%: DONTCOPY EVAL@COMPILE 
 
-(FILESLOAD LAFITEDECLS)
+(FILESLOAD LAFITE-DECLS)
 )
 
-(FILESLOAD LAFITEFIND)
+(FILESLOAD LAFITE-FIND)
 (DEFINEQ
 
 (\LAFITE.TIMEDDELETE

@@ -207,22 +206,21 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
         ("forever" 0)))
 
 (RPAQQ MARKDURATIONS
 ((1 1)
-                          (2 2)
-                          (3 4)
-                          (4 7)
-                          (5 14)
-                          (6 30)
-                          (7 61)
-                          (8 122)
-                          (9 244)))
+                      (2 2)
+                      (3 4)
+                      (4 7)
+                      (5 14)
+                      (6 30)
+                      (7 61)
+                      (8 122)
+                      (9 244)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS EXPIRATIONMENU EXPIRATIONMENUITEMS MARKDURATIONS)
 )
 
 (LTD.INIT
)
-(PUTPROPS LAFITETIMEDDELETE COPYRIGHT ("Xerox Corporation" 1987 1988 1989))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (934 8084 (\LAFITE.TIMEDDELETE 944 . 1218) (\LAFITE.SETEXPIRATIONS 1220 . 5600) (
-\LAFITE.DELETEEXPIRED 5602 . 8082)) (8085 10316 (LTD.INIT 8095 . 8984) (MESSAGEAGE 8986 . 10314)))))
+  (FILEMAP (NIL (878 8028 (\LAFITE.TIMEDDELETE 888 . 1162) (\LAFITE.SETEXPIRATIONS 1164 . 5544) (
+\LAFITE.DELETEEXPIRED 5546 . 8026)) (8029 10260 (LTD.INIT 8039 . 8928) (MESSAGEAGE 8930 . 10258)))))
 STOP

library/lafite/LAFITE-UNIXMAIL

@@ -1,30 +1,22 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "30-Sep-2021 16:06:26" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNIXMAIL.;2|
 82866  
 
-      |changes| |to:|  (VARS UNIXMAILCOMS)
-                       (FNS UNIX.POLLNEWMAIL UNIX.NEXTMESSAGE UNIXMAILER.OPENMAILBOX 
-                            UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX UNIXSPOOL.OPENMAILBOX
-                            UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX UNIX.FLUSH.STREAM 
-                            UNIX.RETRIEVE.LINE \\UNIXMAIL.SEND \\UNIXMAIL.SEND.WRAPLINES \\SMTP-DUMP
-                            \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.CHECK.ABORT \\UNIXMAIL.MUNG.RECIPIENTS 
-                            \\UNIXMAIL.SMTP \\UNIXMAIL.SMTP.FLUSH \\UNIXMAIL.CHANGE.MODE 
-                            \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.LOGIN \\UNIXMAIL.PARSENAMES 
-                            \\UNIXMAIL.MAKEANSWERFORM \\UNIXMAIL.MESSAGE.FROM.SELF.P 
-                            \\UNIXMAIL.MESSAGE.P \\UNIXMAIL.REALADDRESS \\UNIXMAIL.FQNAME 
-                            \\UNIXMAIL.FIXMICROSOFT)
+
(FILECREATED "24-Feb-2024 11:57:21" |{WMEDLEY}<library>lafite>LAFITE-UNIXMAIL.;4|
 81665  
 
-      |previous| |date:| "10-Feb-2000 12:03:28" |{DSK}<project>medley3.5>library>unixmail.;42|)
+      :EDIT-BY |rmk|
+
+      :CHANGES-TO (VARS LAFITE-UNIXMAILCOMS)
+
+      :PREVIOUS-DATE "24-Feb-2024 11:35:24" |{WMEDLEY}<library>lafite>LAFITE-UNIXMAIL.;3|)
 
 
-; Copyright (c) 1989-1992, 1997, 1999, 1920, 2021 by ENVOS Corporation.
+(PRETTYCOMPRINT LAFITE-UNIXMAILCOMS)
 
-(PRETTYCOMPRINT UNIXMAILCOMS)
-
-(RPAQQ UNIXMAILCOMS

+(RPAQQ LAFITE-UNIXMAILCOMS

        ((DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                  LAFITEDECLS NSMAIL)
+                                                  LAFITE-DECLS LAFITE-NSMAIL)
                (RECORDS UNIXMAILBOX UNIXMAILFILEINFO UNIXMAILPARSE))
+        (DECLARE\: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
+                                               LAFITE))
         (ALISTS (LAFITEMODELST UNIX))
         
         (* |;;| "JDS 4/6/97:  CHANGE TRANSMIT SMTP INTERACTION TO put <> around mail-from name, which SMTP seems to require.")

@@ -89,11 +81,11 @@
                                                          (CDR LAFITESENDINGMENUITEMS))
                                                    '(CHANGE \\SENDMSG.CHANGE.MODE TO 
                                                            \\UNIXMAIL.CHANGE.MODE)))))
-        (PROP FILETYPE UNIXMAIL)))
+        (PROP FILETYPE LAFITE-UNIXMAIL)))
 (DECLARE\: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS NSMAIL)
+       LAFITE-DECLS LAFITE-NSMAIL)
 
 (DECLARE\: EVAL@COMPILE
 
@@ -104,10 +96,15 @@
 (RECORD UNIXMAILPARSE
 (UNIXMAILSUBJECT UNIXFROM UNIXTO UNIXOTHER FORMATTED? UNIXBODY))
 )
 )
+(DECLARE\: DONTEVAL@LOAD DOCOPY 
+
+(FILESLOAD (SYSLOAD)
+       LAFITE)
+)
 
 (ADDTOVAR LAFITEMODELST
 (UNIX 3 \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.SEND \\UNIXMAIL.MAKEANSWERFORM 
-                                  \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
-                                  \\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
+                              \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
+                              \\UNIXMAIL.MESSAGE.FROM.SELF.P \\UNIXMAIL.LOGIN))
 
 
 
@@ -133,9 +130,9 @@
 
 
 (RPAQQ UNIXMAIL.MSOPS.LIST
 ((MAILER UNIX.POLLNEWMAIL UNIXMAILER.OPENMAILBOX UNIX.NEXTMESSAGE 
-                                       UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
-                                (SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE 
-                                       UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
+                                   UNIXMAILER.RETRIEVEMESSAGE UNIXMAILER.CLOSEMAILBOX)
+                            (SPOOL UNIX.POLLNEWMAIL UNIXSPOOL.OPENMAILBOX UNIX.NEXTMESSAGE 
+                                   UNIXSPOOL.RETRIEVEMESSAGE UNIXSPOOL.CLOSEMAILBOX)))
 
 
 
@@ -979,13 +976,13 @@
 (* |;;| "This returns multiple-values, so it's a CL:LAMBDA (what the heck).")

 
 
-(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS
 ()
             (* \; "Edited 27-Feb-99 13:55 by rmk:")

+(CL:DEFUN \\UNIXMAIL.SMTP.TCP.STREAMS
 ()
                     (* \; "Edited 27-Feb-99 13:55 by rmk:")

 
    (* |;;| "Opens two streams representing the input and output streams of an SMTP TCP connection.  On failure return NIL and a string describing the failure.")

 
    (SELECTQ UNIXMAIL.SEND.MODE
        (PROCESS (|if|
 (EQ (MACHINETYPE)
-                              'MAIKO)
+                          'MAIKO)
                     |then|

 
                     (* |;;| "UNIXMAIL.SEND.PROCESS can be a list of possibilities because the process may be in different places in different operating systems (e.g. solaris vs. sunos).  If the first one doesn't exist at this time, we search the remaining ones and move the first one we find to the beginning of the list for next time.  This could be done as an AFTERSYSOUTFORMS, but easy enough just to do it here.")

@@ -993,36 +990,32 @@
                     (LET ((S (CREATE-PROCESS-STREAM
                               (CONCAT (IF
 (NLISTP UNIXMAIL.SEND.PROCESS)
                                           THEN
 UNIXMAIL.SEND.PROCESS
-                                        ELSEIF
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY
-                                                                   (CAR UNIXMAIL.SEND.PROCESS)))
+                                        ELSEIF
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY (CAR 
+                                                                                UNIXMAIL.SEND.PROCESS
+                                                                                            )))
                                           THEN
 (CAR UNIXMAIL.SEND.PROCESS)
                                         ELSE
 (FOR
 P IN
 (CDR UNIXMAIL.SEND.PROCESS)
-                                                    WHEN
 (INFILEP (PACKFILENAME 'HOST
-                                                                             'DSK
-                                                                             'BODY P))
-                                                    DO
 (SETQ UNIXMAIL.SEND.PROCESS
-                                                            (CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)
-                                                                  ))
-                                                          (RETURN P)))
+                                                WHEN
 (INFILEP (PACKFILENAME 'HOST 'DSK 'BODY P))
+                                                DO
 (SETQ UNIXMAIL.SEND.PROCESS
+                                                    (CONS P (DREMOVE P UNIXMAIL.SEND.PROCESS)))
+                                                   (RETURN P)))
                                      (IF
 UNIXMAIL.SEND.HOST
                                          THEN
 (CONCAT " " UNIXMAIL.SEND.HOST)
                                        ELSE
 "")))))
                          (CL:VALUES S S))
                   |else|
 (CL:VALUES NIL 
                           "this MACHINETYPE can't do Unix process-streams; change UNIXMAIL.SEND.MODE"
-                                    )))
+                                )))
        (SOCKET (|if|
 (EQ (MACHINETYPE)
-                             'MAIKO)
-                   |then|
 (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"
-                                                                                    ))
-                                              25)))
-                                   (CL:VALUES S S))
+                         'MAIKO)
+                   |then|
 (LET ((S (OPENTCPSTREAM (OR UNIXMAIL.SEND.HOST (UNIX-GETPARM "HOSTNAME"))
+                                          25)))
+                               (CL:VALUES S S))
                  |else|
 (LET ((S (TCP.OPEN UNIXMAIL.SEND.HOST 25 NIL 'ACTIVE 'INPUT T)))
-                                 (|if|
 S
-                                     |then|
 (CL:VALUES S (TCP.OTHER.STREAM S))
-                                   |else|
 (CL:VALUES NIL 
-                                                 "TCP.OPEN failed; check your Lisp TCP configuration"
-                                                     )))))
+                             (|if|
 S
+                                 |then|
 (CL:VALUES S (TCP.OTHER.STREAM S))
+                               |else|
 (CL:VALUES NIL 
+                                             "TCP.OPEN failed; check your Lisp TCP configuration")))))
        (ERROR "Unrecognized UNIXMAIL.SEND.MODE:" UNIXMAIL.SEND.MODE)))
 
 
@@ -1368,23 +1361,21 @@
 
     (SETQ LAFITESENDINGMENUITEMS (EDITE (CONS (CAR LAFITESENDINGMENUITEMS)
                                               (CDR LAFITESENDINGMENUITEMS))
-                                        '(CHANGE
 \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE)
-                                        )))
+                                        '(CHANGE
 \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE))))
 
-(PUTPROPS UNIXMAIL
 FILETYPE
 :COMPILE-FILE)
-(PUTPROPS UNIXMAIL COPYRIGHT ("ENVOS Corporation" 1989 1990 1991 1992 1997 1999 1920 2021))
+(PUTPROPS LAFITE-UNIXMAIL
 FILETYPE
 :COMPILE-FILE)
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (7835 26260 (UNIX.POLLNEWMAIL 7845 . 9795) (UNIX.NEXTMESSAGE 9797 . 9973) (
-UNIXMAILER.OPENMAILBOX 9975 . 14371) (UNIXMAILER.RETRIEVEMESSAGE 14373 . 15580) (
-UNIXMAILER.CLOSEMAILBOX 15582 . 16607) (UNIXSPOOL.OPENMAILBOX 16609 . 22826) (
-UNIXSPOOL.RETRIEVEMESSAGE 22828 . 24909) (UNIXSPOOL.CLOSEMAILBOX 24911 . 26258)) (26308 56798 (
-UNIX.FLUSH.STREAM 26318 . 26899) (UNIX.RETRIEVE.LINE 26901 . 28090) (\\UNIXMAIL.SEND 28092 . 38386) (
-\\UNIXMAIL.SEND.WRAPLINES 38388 . 42018) (\\SMTP-DUMP 42020 . 43290) (\\UNIXMAIL.SEND.PARSE 43292 . 
-46536) (\\UNIXMAIL.CHECK.ABORT 46538 . 47366) (\\UNIXMAIL.MUNG.RECIPIENTS 47368 . 52236) (
-\\UNIXMAIL.SMTP 52238 . 52843) (\\UNIXMAIL.SMTP.FLUSH 52845 . 55322) (\\UNIXMAIL.CHANGE.MODE 55324 . 
-56796)) (56886 60196 (\\UNIXMAIL.SMTP.TCP.STREAMS 56886 . 60196)) (60275 81847 (
-\\UNIXMAIL.AUTHENTICATE 60285 . 61976) (\\UNIXMAIL.LOGIN 61978 . 62323) (\\UNIXMAIL.PARSENAMES 62325
- . 64643) (\\UNIXMAIL.MAKEANSWERFORM 64645 . 69527) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 69529 . 70658) (
-\\UNIXMAIL.MESSAGE.P 70660 . 70979) (\\UNIXMAIL.REALADDRESS 70981 . 75025) (\\UNIXMAIL.FQNAME 75027 . 
-75632) (\\UNIXMAIL.FIXMICROSOFT 75634 . 81845)))))
+  (FILEMAP (NIL (7064 25489 (UNIX.POLLNEWMAIL 7074 . 9024) (UNIX.NEXTMESSAGE 9026 . 9202) (
+UNIXMAILER.OPENMAILBOX 9204 . 13600) (UNIXMAILER.RETRIEVEMESSAGE 13602 . 14809) (
+UNIXMAILER.CLOSEMAILBOX 14811 . 15836) (UNIXSPOOL.OPENMAILBOX 15838 . 22055) (
+UNIXSPOOL.RETRIEVEMESSAGE 22057 . 24138) (UNIXSPOOL.CLOSEMAILBOX 24140 . 25487)) (25537 56027 (
+UNIX.FLUSH.STREAM 25547 . 26128) (UNIX.RETRIEVE.LINE 26130 . 27319) (\\UNIXMAIL.SEND 27321 . 37615) (
+\\UNIXMAIL.SEND.WRAPLINES 37617 . 41247) (\\SMTP-DUMP 41249 . 42519) (\\UNIXMAIL.SEND.PARSE 42521 . 
+45765) (\\UNIXMAIL.CHECK.ABORT 45767 . 46595) (\\UNIXMAIL.MUNG.RECIPIENTS 46597 . 51465) (
+\\UNIXMAIL.SMTP 51467 . 52072) (\\UNIXMAIL.SMTP.FLUSH 52074 . 54551) (\\UNIXMAIL.CHANGE.MODE 54553 . 
+56025)) (56115 59121 (\\UNIXMAIL.SMTP.TCP.STREAMS 56115 . 59121)) (59200 80772 (
+\\UNIXMAIL.AUTHENTICATE 59210 . 60901) (\\UNIXMAIL.LOGIN 60903 . 61248) (\\UNIXMAIL.PARSENAMES 61250
+ . 63568) (\\UNIXMAIL.MAKEANSWERFORM 63570 . 68452) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68454 . 69583) (
+\\UNIXMAIL.MESSAGE.P 69585 . 69904) (\\UNIXMAIL.REALADDRESS 69906 . 73950) (\\UNIXMAIL.FQNAME 73952 . 
+74557) (\\UNIXMAIL.FIXMICROSOFT 74559 . 80770)))))
 STOP

library/lafite/LAFITETEDIT

@@ -1,208 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-
(FILECREATED "16-Jul-2022 23:37:24" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>lafite>LAFITETEDIT.;5
 12306  
-
-      :CHANGES-TO (VARS LAFITETEDITCOMS)
-
-      :PREVIOUS-DATE "30-Sep-2021 23:07:55" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>lafite>LAFITETEDIT.;4)
-
-
-(* ; "
-Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation.
-")
-
-(PRETTYCOMPRINT LAFITETEDITCOMS)
-
-(RPAQQ LAFITETEDITCOMS

-       (
-        (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")

-
-        (FNS LA.ADJUST.FORMATTING LA.SKIP.LOOKS.LIST LA.DETACH.TEDIT LA.TEDIT.INCLUDE 
-             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) TEDITDCL), because there is a compiled version that is already loaded that isn't enough.")

-
-               (P (CL:UNLESS (GET 'TEDIT-DCL 'FILE)
-                         (FILESLOAD TEDIT-DCL)))
-               (FILES (SOURCE)
-                      LAFITEDECLS)
-               (GLOBALVARS *TEDIT-FILE-READTABLE*)
-               (LOCALVARS . T))))
-
-
-
-(* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")

-
-(DEFINEQ
-
-(LA.ADJUST.FORMATTING

-  [LAMBDA (FORMATSTREAM OUTSTREAM BYTE-LENGTHS)
          (* ; "Edited  3-Jun-88 18:24 by bvm")

-
-    (* ;; "Adjusts the formatting info FORMATSTREAM to account for the prepending of one or more %"paragraphs%" of default looking text, whose lengths are given by BYTE-LENGTHS (or a single number if just one piece).  It then writes the resulting formatting to OUTSTREAM.")

-
-    (PROG ((END (GETEOFPTR FORMATSTREAM))
-           NPIECES PIECEINFOCH# TYPECODE PCLEN PREFIXEND LOOKSINDEX)
-          (COND
-             ((<= END 8)                                     (* ; "This can't be formatting.")

-              (RETURN NIL)))
-          (SETFILEPTR FORMATSTREAM (- END 8))
-          (SETQ PIECEINFOCH# (\DWIN FORMATSTREAM))           (* ; "Where the piece table starts relative to the whole file.  Since in our case TEXT is only the formatting, it will start at zero.")

-          (SETQ NPIECES (\SMALLPIN FORMATSTREAM))            (* ; "Total number of pieces")

-          (if
 (NEQ (\SMALLPIN FORMATSTREAM)
-                       31418)
-              then
                                       (* ; 
-
                                "Not the version of TEdit formatting we understand.  Throw it out.")

-                    (RETURN NIL))
-          (SETFILEPTR FORMATSTREAM 0)
-          [do
 (SETQ PCLEN (\DWIN FORMATSTREAM))
-                 (SETQ TYPECODE (\SMALLPIN FORMATSTREAM))    (* ; "What kind of piece is it?")

-                 (SELECTC TYPECODE
-                     (\PieceDescriptorPAGEFRAME              (* ; 
-
                           "This is page layout info for the file, whose format is an s-expression")

-                          (SKREAD FORMATSTREAM NIL *TEDIT-FILE-READTABLE*))
-                     (\PieceDescriptorCHARLOOKSLIST          (* ; 
-
         "This is the list of CHARLOOKSs used in this document.  This is a sequence of charlooks, ")

-                          (LA.SKIP.LOOKS.LIST
 FORMATSTREAM))
-                     (\PieceDescriptorPARALOOKSLIST          (* ; 
-
                     "This is the list of PARALOOKSs used in this document.  Similar to CHARLOOKS.")

-                          (LA.SKIP.LOOKS.LIST
 FORMATSTREAM))
-                     (\PieceDescriptorPARA                   (* ; 
-
   "Start a new paragraph with different looks.  We will want to insert our new piece before this.")

-                          (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR FORMATSTREAM)
-                                                           6)))
-                                                             (* ; 
-
                                                         "Representation is just a paralooks index")

-                          (\SMALLPIN FORMATSTREAM))
-                     (\PieceDescriptorLOOKS                  (* ; "Character looks for a new piece.  The piece is PCLEN bytes long, which means half that many chars if fat.")

-                          (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR FORMATSTREAM)
-                                                           6)))
-                                                             (* ; 
-
                                      "Peek ahead to see what the charlooks of the first piece are")

-                          (\BIN FORMATSTREAM)                (* ; "FLAG byte.  1=NEW; 2 = FAT")

-                          (SETQ LOOKSINDEX (\SMALLPIN FORMATSTREAM))
-                                                             (* ; "Charlooks index")

-                          (RETURN))
-                     (PROGN                                  (* ; 
-
                                     "Either imageobj or unknown type piece--I hope we're finished")

-                            (RETURN]
-
-     (* ;; "At this point we have read enough format info to know what to do.  Everything up to PREFIXEND is the preamble, which we can copy intact.  Then we insert our own first piece, consisting of the prepended text in a single piece.")

-
-          [COPYBYTES FORMATSTREAM OUTSTREAM 0 (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR 
-                                                                                      FORMATSTREAM)
-                                                                               6]
-          (for
 PIECELEN inside
 BYTE-LENGTHS do
 
-
-                                 (* ;; "This code is generalized to allow multiple inserted pieces, but unfortunately if the textstream already has any paragraph formatting, we can't make the pieces be different paragraphs without making them also have non-default paralooks.")

-
-                                                          (\DWOUT OUTSTREAM PIECELEN)
-                                                          (\SMALLPOUT OUTSTREAM \PieceDescriptorLOOKS
-                                                                 )
-                                                          (BOUT OUTSTREAM 0) 
-                                                             (* ; "Flag byte")

-                                                          (\SMALLPOUT OUTSTREAM (OR LOOKSINDEX 1)) 
-                                                             (* ; "Char looks index--make it look like the first piece, or arbitrarily choose the first looks if the text started with an imageobj or some other ugliness")

-                                                          (add
 PIECEINFOCH# PIECELEN)
-                                                          (add
 NPIECES 1))
-          (COPYBYTES FORMATSTREAM OUTSTREAM PREFIXEND (- END 8))
-                                                             (* ; "Copy rest of piece info")

-          (\DWOUT OUTSTREAM PIECEINFOCH#)                    (* ; 
-
                                                           "New offset of start of formatting")

-          (\SMALLPOUT OUTSTREAM NPIECES)                     (* ; "More pieces now")

-          (\SMALLPOUT OUTSTREAM 31418)                       (* ; "Finally, the password")

-          (RETURN OUTSTREAM])
-
-(LA.SKIP.LOOKS.LIST

-  [LAMBDA (FORMATSTREAM)
                                 (* ; "Edited  3-Jun-88 16:52 by bvm")

-
-    (* ;; "Advance FORMATSTREAM past a sequence of CHAR/PARALOOKS.  Each elements starts with a word giving its byte length, so we can skip over it")

-
-    (for
 I from
 1 to
 (\SMALLPIN FORMATSTREAM) do
 (SETFILEPTR FORMATSTREAM
-                                                                        (+ (GETFILEPTR FORMATSTREAM)
-                                                                           (\SMALLPIN FORMATSTREAM])
-
-(LA.DETACH.TEDIT

-  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited  3-Jun-88 17:27 by bvm")

-
-    (* ;; "Removes the TEXTSTREAM from the window, if any, it is being edited in.")

-
-    (* ;; "Yecch, TEdit ought to have a proper interface for this.")

-
-    (replace
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TEXTSTREAM) with
 NIL])
-
-(LA.TEDIT.INCLUDE

-  [LAMBDA (TEXTSTREAM FILE CH#)
                          (* ; "Edited  3-Jun-88 17:49 by bvm")

-
-    (* ;; "Do an Include of FILE into TEXTSTREAM at (i.e., in front of) character CH#.  Returns the length of the insertion.")

-
-    (* ;; "This code assumes that TEDIT.INCLUDE makes selection be the insertion")

-
-    (TEDIT.SETSEL TEXTSTREAM CH# 0 'RIGHT)
-    (TEDIT.INCLUDE TEXTSTREAM FILE)
-    (fetch
 (SELECTION DCH) of
 (TEDIT.GETSEL TEXTSTREAM])
-
-(LA.WINDOW.FROM.TEXTSTREAM

-  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited 23-Sep-87 15:36 by bvm:")

-    (for
 W in
 (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TEXTSTREAM))
-       when
 (WINDOWPROP W 'TITLE) do
                 (* ; 
-
                                                     "Hairy loop because the window could be split")

-                                            (RETURN W])
-
-(TEDIT.ASSURE.NO.BACKING.FILE

-  [LAMBDA (TEXTSTREAM)
                                   (* ; "Edited 20-May-92 11:25 by rmk:")

-    (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
-           (OFILE (FETCH
 (TEXTOBJ TXTFILE) OF
 TEXTOBJ)))
-          (IF
 (AND (TYPE?
 STREAM OFILE)
-                       (NEQ (FETCH
 (STREAM DEVICE) OF
 OFILE)
-                            'NODIRCORE))
-              THEN
 (LET* [(NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH))
-                              (CH#S (REVERSE (CDR (TEDIT.PUT.PCTB TEXTOBJ NEWFILE]
-
-                             (* ;; "TEDIT.PUT.PCTB has the effect of copying the whole document to NEWFILE.  There are still multiple pieces, because each looks-run is a piece.  Value gives the byte pointers within the resulting file where each real piece of text starts.  Run thru the pieces in the PCTB, pointing them to the new file and their new locations.  We do the cleanup copied from TEDIT.PUT; don't call TEDIT.PUT itself because we want it to think that we are still editing the original source.")

-
-                             [TEDIT.MAPPIECES TEXTOBJ (FUNCTION (LAMBDA (CH# PC)
-                                                                  (COND
-                                                                     ((FETCH
 POBJ OF
 PC))
-                                                                     (T (REPLACE
 PFPOS
-                                                                           OF
 PC
-                                                                           WITH
 (POP
 CH#S))
-                                                                        (CLOSEF? (FETCH
 PFILE
-                                                                                    OF
 PC))
-                                                             (* ; 
-
     "If this is a piece on an open file, close it, since we're never going to read from it again.")

-                                                                        (REPLACE
 PFILE
-                                                                           OF
 PC WITH
 NEWFILE
-                                                                               )
-                                                                        (REPLACE
 PSTR
-                                                                           OF
 PC WITH
 NIL]
-                             (CLOSEF? OFILE)
-                             (REPLACE
 (TEXTOBJ TXTFILE) OF
 TEXTOBJ WITH
 NIL])
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-
-(CL:UNLESS (GET 'TEDIT-DCL 'FILE)
-       (FILESLOAD TEDIT-DCL))
-
-
-(FILESLOAD (SOURCE)
-       LAFITEDECLS)
-
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS *TEDIT-FILE-READTABLE*)
-)
-
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(LOCALVARS . T)
-)
-)
-(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992 2021))
-(DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1337 11935 (LA.ADJUST.FORMATTING 1347 . 7483) (LA.SKIP.LOOKS.LIST 7485 . 8059) (
-LA.DETACH.TEDIT 8061 . 8426) (LA.TEDIT.INCLUDE 8428 . 8917) (LA.WINDOW.FROM.TEXTSTREAM 8919 . 9365) (
-TEDIT.ASSURE.NO.BACKING.FILE 9367 . 11933)))))
-STOP

library/tedit/TEDIT-ABBREV

@@ -1,20 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2022 16:53:34" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;1
 9767   
+
(FILECREATED "17-Mar-2024 18:15:40" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8
 9500   
 
-      :PREVIOUS-DATE "14-Jul-2022 11:08:10" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-ABBREV.;3)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
+
+      :PREVIOUS-DATE "17-Mar-2024 12:06:12" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7)
 
 
 (PRETTYCOMPRINT TEDIT-ABBREVCOMS)
 
 (RPAQQ TEDIT-ABBREVCOMS

-       [(FILES TEDIT-DCL)
-        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
-               (FILES (LOADCOMP)
-                      TEDIT-DCL))
-        (FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
+       [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
         (GLOBALVARS TEDIT.ABBREVS)
         (INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
                                    ("n" . "357,44")
@@ -62,57 +62,39 @@
                                    (" " . "357,41")
                                    ("DATE" . \TEDIT.EXPAND.DATE)
                                    (">>DATE<<" . \TEDIT.EXPAND.DATE])
-
-(FILESLOAD TEDIT-DCL)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ \SCRATCHLEN
 64)
-
-
-(CONSTANTS (\SCRATCHLEN 64))
-)
-
-
-(FILESLOAD (LOADCOMP)
-       TEDIT-DCL)
-)
 (DEFINEQ
 
 (\TEDIT.ABBREV.EXPAND

-  [LAMBDA (STREAM)
                                           (* ; "Edited 30-May-91 19:27 by jds")

+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 17-Mar-2024 12:06 by rmk")


+                                                             (* ; "Edited 17-May-2023 13:31 by rmk")


+                                                             (* ; "Edited  8-Sep-2022 23:53 by rmk")


+                                                             (* ; "Edited  1-Aug-2022 12:04 by rmk")


+                                                             (* ; "Edited 30-May-91 19:27 by jds")

                                                              (* ; "Expand an abbvreviation")

-    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
-           SEL CH# (CH NIL)
-           OLDLOOKS EXPANSION)
+    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM))
+           SEL CH# CH OLDLOOKS EXPANSION)
           (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-          (SETQ CH# (SELECTQ (fetch
 (SELECTION POINT) of
 SEL)
-                        (LEFT (SUB1 (fetch
 (SELECTION CH#) of
 SEL)))
-                        (RIGHT (SUB1 (fetch
 (SELECTION CHLIM) of
 SEL)))
-                        0))
+          (SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL)))
           [COND
-             ((ZEROP (fetch
 (SELECTION DCH) of
 SEL))         (* ; 
+             ((ZEROP (GETSEL SEL DCH))                       (* ; 
 
                                                  "Point Selection, so use the character to the left")

-              (COND
-                 ((ZEROP CH#)                                (* ; 
+              (CL:WHEN (ZEROP CH#)                           (* ; 
 
                                       "If we're off the front of the document, don't bother trying.")

-                  (RETURN)))
-              (\SETUPGETCH CH# TEXTOBJ)
-              [SETQ CH (MKSTRING (CHARACTER (\BIN STREAM]
-              (TEDIT.SETSEL STREAM CH# 1 'RIGHT))
+                  (RETURN))
+              (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)
+                     CH#)
+              [SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM]
+              (TEDIT.SETSEL TSTREAM CH# 1 'RIGHT))
              (T                                              (* ; 
 
                                              "We have a selection that isn't just a caret.  Use it.")

-                (SETQ CH (TEDIT.SEL.AS.STRING STREAM]
-          (SETQ EXPANSION (\TEDIT.TRY.ABBREV
 CH STREAM))     (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")

-          (COND
-             (EXPANSION                                      (* ; 
+                (SETQ CH (TEDIT.SEL.AS.STRING TSTREAM]
+          (SETQ EXPANSION (\TEDIT.TRY.ABBREV
 CH TSTREAM))    (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.")

+          (CL:WHEN EXPANSION                                 (* ; 
 
                                                "It exists, so insert it where the abbrev used to be")

-                    (replace
 (TEXTOBJ \INSERTPCVALID) of
 TEXTOBJ with
 NIL)
-                                                             (* ; "Force it to abandon caching")

-                    (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
-                    (TEDIT.DELETE TEXTOBJ SEL)               (* ; 
+              (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ))
+              (TEDIT.DELETE TEXTOBJ SEL)                     (* ; 
 
                                                            "First, delete the thing being expanded.")

-                    (TEDIT.INSERT STREAM EXPANSION SEL OLDLOOKS])
+              (TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))])
 
 (\TEDIT.EXPAND.DATE

   [LAMBDA (STREAM CH)
                                        (* ; "Edited 23-Feb-88 10:41 by jds")

@@ -224,6 +206,6 @@
          ("DATE" . \TEDIT.EXPAND.DATE)
          (">>DATE<<" . \TEDIT.EXPAND.DATE)))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3281 8423 (\TEDIT.ABBREV.EXPAND 3291 . 5638) (\TEDIT.EXPAND.DATE 5640 . 6273) (
-\TEDIT.TRY.ABBREV 6275 . 8421)))))
+  (FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
+\TEDIT.TRY.ABBREV 6008 . 8154)))))
 STOP

library/tedit/TEDIT-CHAT

@@ -1,199 +1,42 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2022 16:55:43" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-CHAT.;1
 21593  
+
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14
 12223  
 
-      :PREVIOUS-DATE "14-Jul-2022 10:40:06" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-CHAT.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS TEDIT-CHATCOMS)
+                  (FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN)
+
+      :PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}<library>tedit>TEDIT-CHAT.;9)
 
 
 (PRETTYCOMPRINT TEDIT-CHATCOMS)
 
 (RPAQQ TEDIT-CHATCOMS

-       ((COMS                                                (* ; "character routines")

-              (FNS TEDITCHAT.CHARFN \TEXTSTREAMBOUT))
-        (COMS (FNS TEDITSTREAM.INIT TEDITCHAT.MENUFN))
-        (COMS                                                (* ; "TEDIT update routines")

+       ((FNS TEDITSTREAM.INIT TEDITCHAT.MENUFN TEDITCHAT.CHARFN)
+        (COMS                                                (* ; "WHO CALLS TEDIT.DISPLAYTEXT ?")

               (FNS TEDIT.DISPLAYTEXT))
         (GLOBALVARS TEDITCHAT.MENU CHAT.DRIVERTYPES CHAT.DISPLAYTYPES)
         (VARS TEDITCHAT.MENUITEMS (TEDITCHAT.MENU))
         (ADDVARS (CHAT.DRIVERTYPES (TEDIT TEDITCHAT.CHARFN NILL)))
         (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
                                                 CHATDECLS))))
-
-
-
-(* ; "character routines")

-
-(DEFINEQ
-
-(TEDITCHAT.CHARFN

-  [LAMBDA (CH CHAT.STATE)
                                   (* ; "Edited 12-Jun-90 18:00 by mitani")

-    (LET* [(TEXTSTREAM (fetch
 (CHAT.STATE TEXTSTREAM) of
 CHAT.STATE))
-           (SEL (fetch
 (TEXTOBJ SEL) of
 (TEXTOBJ TEXTSTREAM]
-          (\CARET.DOWN (fetch
 (TEXTOBJ DS) of
 (TEXTOBJ TEXTSTREAM)))
-          (SELCHARQ CH
-               (BS (\TEDIT.CHARDELETE TEXTSTREAM "" SEL)
-                   [MOVETO (fetch
 X0 of
 SEL)
-                          (fetch
 Y0 of
 SEL)
-                          (CAR (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TEXTSTREAM])
-               (LF NIL)
-               (BOUT TEXTSTREAM CH])
-
-(\TEXTSTREAMBOUT

-  [LAMBDA (STREAM BYTE)
                                      (* ; "Edited 28-Mar-94 15:29 by jds")

-
-    (* ;; "Do BOUT to a text stream, which is an insertion at the caret.")

-
-    (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM))
-           CH# WINDOW TEXTLEN PS PC PSTR OFFST SEL)
-          (SETQ TEXTLEN (fetch
 (TEXTOBJ TEXTLEN) of
 TEXTOBJ))
-          (SETQ WINDOW (fetch
 (TEXTOBJ \WINDOW) of
 TEXTOBJ))
-          (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-          (COND
-             ((NOT (CAR (fetch
 L1 of
 SEL)))
-              (RETURN)))                                     (* ; 
-
                                   "Return if caret out of bounds, ie, user scrolls past end of text")

-          (SETQ CH# (fetch
 CH# of
 SEL))
-          (AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#))
-          (COND
-             ((IEQP BYTE 13)
-              (\INSERTCR BYTE CH# TEXTOBJ))
-             (T (\INSERTCH BYTE CH# TEXTOBJ)))
-          (AND WINDOW
-               (PROG ((THISLINE (fetch
 (TEXTOBJ THISLINE) of
 TEXTOBJ))
-                      EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES
-                      NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE CURLINE
-                      FONT (L1 (CAR (fetch
 L1 of
 SEL)))
-                      (LN (CAR (fetch
 LN of
 SEL)))
-                      (LOOKS (\TEDIT.APPLY.STYLES (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
-                                    (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ)
-                                    TEXTOBJ)))
-                     (add
 (fetch
 CH# of
 SEL)
-                          1)                                 (* ; 
-
                                    "These must be here, since SELs are valid even without a window.")

-                     (replace
 CHLIM of
 SEL with
 (fetch
 CH# of
 SEL))
-                     (replace
 POINT of
 SEL with
 'LEFT)
-                     (replace
 DCH of
 SEL with
 0)
-                     (replace
 SELKIND of
 SEL with
 'CHAR)
-                     (SETQ CURLINE L1)
-                     (add
 (fetch
 CHARLIM of
 CURLINE)
-                          1)
-                     (add
 (fetch
 CHARTOP of
 CURLINE)
-                          1)
-                     (SETQ FONT (fetch
 CLFONT of
 LOOKS))
-                     (DSPFONT FONT (CAR WINDOW))
-                     [COND
-                        [(OR (IGREATERP (PLUS (fetch
 X0 of
 SEL)
-                                              (CHARWIDTH BYTE FONT))
-                                    (IDIFFERENCE (fetch
 (TEXTOBJ WRIGHT) of
 TEXTOBJ)
-                                           8))
-                             (IEQP BYTE (CHARCODE CR)))      (* ; 
-
                                            "gone off the edge of the line reformat and add new line")

-                         (TEDIT.UPDATE.SCREEN TEXTOBJ)
-                         (\FIXSEL SEL TEXTOBJ (CAR WINDOW))
-                         (SETQ L1 (CAR (fetch
 L1 of
 SEL)))
-                         (SETQ LN (CAR (fetch
 LN of
 SEL)))
-                         (COND
-                            ([OR (NULL (SELECTQ (fetch
 POINT of
 SEL)
-                                           (LEFT L1)
-                                           (RIGHT LN)
-                                           NIL))
-                                 (ILEQ (SELECTQ (fetch
 POINT of
 SEL)
-                                           (LEFT (fetch
 YBOT of
 L1))
-                                           (RIGHT (fetch
 YBOT of
 LN))
-                                           0)
-                                       (fetch
 (REGION BOTTOM) of
 (DSPCLIPPINGREGION NIL (CAR WINDOW]
-                                                             (* ; 
-
    "The caret is off-window in the selection window.  Need to scroll it up so the caret is visible.")

-                             (while
 (ILESSP (fetch
 Y0 of
 SEL)
-                                           (fetch
 (TEXTOBJ WBOTTOM) of
 TEXTOBJ))
-                                do
                           (* ; 
-
                                                  "The caret just went off-screen.  Move it up some.")

-                                   (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 NIL)
-                                   (SCROLLW (CAR WINDOW)
-                                          0
-                                          (LLSH (COND
-                                                   [(SELECTQ (fetch
 POINT of
 SEL)
-                                                        (LEFT L1)
-                                                        (RIGHT LN)
-                                                        NIL)
-                                                    (fetch
 LHEIGHT
-                                                       of
 (SELECTQ (fetch
 POINT of
 SEL)
-                                                              (LEFT L1)
-                                                              (RIGHT LN)
-                                                              (SHOULDNT]
-                                                   (T 12))
-                                                1]
-                        (T (TEDIT.DISPLAYTEXT
 TEXTOBJ BYTE (CHARWIDTH BYTE FONT)
-                                  CURLINE
-                                  (fetch
 X0 of
 SEL)
-                                  (CAR WINDOW)
-                                  SEL)                       (* ; 
-
                                                             "Print out the character on the screen")

-                           (add
 (fetch
 X0 of
 SEL)
-                                (CHARWIDTH BYTE FONT))
-
-                           (* ;; "And move the selection's notion of our X position to the right to account for that character's width.")

-
-                           (replace
 XLIM of
 SEL with
 (fetch
 X0 of
 SEL]
-
-(* ;;; "Fix up the TEXTSTREAM so that the FILEPTR looks like it ought to after the BOUT, even though we've been updating the screen (which usually moves the fileptr....)")

-
-                     [SETQ PS (ffetch
 (PIECE PSTR) of
 (SETQ PC (fetch
 (TEXTOBJ \INSERTPC)
-                                                                  of
 TEXTOBJ]
-                                                             (* ; 
-
                              "This piece resides in a STRING.  Because it's newly 'typed' material.")

-                     (replace
 (TEXTSTREAM PIECE) of
 STREAM with
 PC)
-                                                             (* ; 
-
                                                             "Remember the current piece for others.")

-                                                             (* ; "And which number piece this is.")

-                     (freplace
 (STREAM CPPTR) of
 STREAM with
 (ADDBASE (ffetch
 (STRINGP BASE)
-                                                                         of
 PS)
-                                                                    (LRSH (SETQ OFFST
-                                                                           (ffetch
 (STRINGP OFFST)
-                                                                              of
 PS))
-                                                                          1)))
-                                                             (* ; 
-
                          "Pointer to the actual characters in the string (allowing for substrings.)")

-                     (freplace
 (STREAM CPAGE) of
 STREAM with
 0)
-                     (freplace
 (STREAM COFFSET) of
 STREAM with
 (IPLUS (freplace
 (TEXTSTREAM PCSTARTCH
-                                                                                       ) of
 STREAM
-                                                                         with
 (LOGAND 1 OFFST))
-                                                                      (fetch
 (TEXTOBJ \INSERTLEN)
-                                                                         of
 TEXTOBJ)))
-                     (freplace
 (TEXTSTREAM PCSTARTPG) of
 STREAM with
 0)
-                                                             (* ; 
-
                                                   "Page # within the 'file' where this piece starts")

-                     (freplace
 (STREAM CBUFSIZE) of
 STREAM with
 (fetch
 (STREAM COFFSET) of
 STREAM))
-                     (freplace
 (STREAM EPAGE) of
 STREAM with
 1)
-                     (freplace
 (TEXTSTREAM CHARSLEFT) of
 STREAM with
 0)
-                                                             (* ; 
-
                                                          "We're, perforce, at the end of the piece.")

-                     (freplace
 (TEXTSTREAM REALFILE) of
 STREAM with
 NIL)
-                                                             (* ; "We're not on a file....")

-                 ])
-)
 (DEFINEQ
 
 (TEDITSTREAM.INIT

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

+  [LAMBDA (WINDOW MENUFN)
                                    (* ; "Edited 23-Dec-2023 09:06 by rmk")


+                                                             (* ; "Edited  4-Nov-2022 17:21 by rmk")


+                                                            (* ; "Edited 12-Jun-90 18:01 by mitani")

 
-    (* ;; "Initialize and return TEDIT TEXTSTREAM")

+    (* ;; "Initialize and return TEDIT TEXTSTREAM on WINDOW.")

 
-    (PROG* ((TEXTSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL))
-            (TEXTOBJ (TEXTOBJ TEXTSTREAM)))                  (* ; 
+    (LET [(TEXTSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL '(COPYBYBKSYSBUF T]
+                                                             (* ; 
 
                                             "force shift select typein to be put in keyboard buffer")

-           (TEXTPROP TEXTSTREAM 'COPYBYBKSYSBUF T)
-           (replace
 (STREAM STRMBOUTFN) of
 TEXTSTREAM with
 '\TEXTSTREAMBOUT)
-           (replace
 SET of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ) with
 T)
-           [replace
 L1 of
 (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ) with
 (LIST (fetch
 DESC
-                                                                         of
 (fetch
 (TEXTOBJ THISLINE)
-                                                                               of
 TEXTOBJ]
                                                              (* ; 
 
                                                    "hookup middle button menu instead of TEDIT menu")

-           (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN)
-           (RETURN TEXTSTREAM])
+         (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN)
+         TEXTSTREAM])
 
 (TEDITCHAT.MENUFN

   [LAMBDA (WINDOW)                                           (* || "20-Oct-86 15:03")

@@ -226,22 +69,40 @@
               (NIL)
               (APPLY* COMMAND STATE WINDOW))
           (replace
 (CHAT.STATE HELD) of
 STATE with
 NIL])
+
+(TEDITCHAT.CHARFN

+  [LAMBDA (CH CHAT.STATE)
                                    (* ; "Edited 22-Dec-2023 23:57 by rmk")


+                                                             (* ; "Edited 18-Mar-2023 20:08 by rmk")


+                                                            (* ; "Edited 12-Jun-90 18:00 by mitani")

+    (LET [(TEXTOBJ (TEXTOBJ (fetch
 (CHAT.STATE TEXTSTREAM) of
 CHAT.STATE]
+         (\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
+         (SELCHARQ CH
+              (BS (\TEDIT.CHARDELETE TEXTOBJ (FGETTOBJ TEXTOBJ SEL)))
+              (LF NIL)
+              (BOUT (FGETTOBJ TEXTOBJ STREAMHINT)
+                    CH])
 )
 
 
 
-(* ; "TEDIT update routines")

+(* ; "WHO CALLS TEDIT.DISPLAYTEXT ?")

 
 (DEFINEQ
 
 (TEDIT.DISPLAYTEXT

-  [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL)
           (* ; "Edited 12-Jun-90 18:01 by mitani")

+  [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL)
            (* ; "Edited 23-Dec-2023 09:15 by rmk")


+                                                             (* ; "Edited  6-Apr-2023 21:39 by rmk")


+                                                             (* ; "Edited  4-Nov-2022 17:18 by rmk")


+                                                             (* ; "Edited 25-Sep-2022 13:34 by rmk")


+                                                             (* ; "Edited  6-Aug-2022 13:28 by rmk")


+                                                            (* ; "Edited 12-Jun-90 18:01 by mitani")

                                                              (* This function does the actual 
 
                                                             displaying of typed-in text on the 
 
                                                             edit window.)

+    (HELP 'TEDIT.DISPLAYTEXT 'NOTUSED?)
     (PROG ((LOOKS (\TEDIT.APPLY.STYLES (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
-                         (fetch
 (TEXTOBJ \INSERTPC) of
 TEXTOBJ)
-                         TEXTOBJ))
+                         (\TEDIT.CARETPIECE TEXTOBJ)
+                         (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)))
            (TERMSA (fetch
 (TEXTOBJ TXTTERMSA) of
 TEXTOBJ))
            DY FONT)
           (MOVETO XPOINT (IPLUS (fetch
 YBASE of
 LINE)
@@ -254,8 +115,6 @@
 
                                                             Use it.)

                     (RESETLST
                         (RESETSAVE \PRIMTERMSA TERMSA)
-                        (replace
 (TEXTSTREAM REALFILE) of
 (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                           with
 DS)
                         [COND
                            [(STRINGP CH)
                             (for
 CHAR instring
 CH
@@ -282,11 +141,11 @@
                                                'TEXTURE
                                                'REPLACE WHITESHADE)
                                         (RELMOVETO 36 0 DS))
-                                   (CR (BITBLT NIL 0 0 DS XPOINT (fetch
 YBOT of
 LINE)
-                                              (IMAX 6 (CHARWIDTH CH FONT))
-                                              (fetch
 LHEIGHT of
 LINE)
-                                              'TEXTURE
-                                              'REPLACE WHITESHADE))
+                                   (EOL (BITBLT NIL 0 0 DS XPOINT (fetch
 YBOT of
 LINE)
+                                               (IMAX 6 (CHARWIDTH CH FONT))
+                                               (fetch
 LHEIGHT of
 LINE)
+                                               'TEXTURE
+                                               'REPLACE WHITESHADE))
                                    (\DSPPRINTCHAR (fetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
                                           CH])]
              (T                                              (* No special handling;
@@ -302,12 +161,12 @@
                                                               'TEXTURE
                                                               'REPLACE WHITESHADE)
                                                        (RELMOVETO 36 0 DS))
-                                                  (CR (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
-                                                             (fetch
 YBOT of
 LINE)
-                                                             (IMAX 6 (CHARWIDTH CHAR FONT))
-                                                             (fetch
 LHEIGHT of
 LINE)
-                                                             'TEXTURE
-                                                             'REPLACE WHITESHADE))
+                                                  (EOL (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
+                                                              (fetch
 YBOT of
 LINE)
+                                                              (IMAX 6 (CHARWIDTH CHAR FONT))
+                                                              (fetch
 LHEIGHT of
 LINE)
+                                                              'TEXTURE
+                                                              'REPLACE WHITESHADE))
                                                   (BLTCHAR CHAR DS]
                    (T (SELCHARQ CH
                            (TAB                              (* Put down white)

@@ -318,13 +177,13 @@
                                        'TEXTURE
                                        'REPLACE WHITESHADE)
                                 (RELMOVETO 36 0 DS))
-                           (CR                               (* Blank out the CR's width.)

-                               (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
-                                      (fetch
 YBOT of
 LINE)
-                                      (IMAX 6 (CHARWIDTH CH FONT))
-                                      (fetch
 LHEIGHT of
 LINE)
-                                      'TEXTURE
-                                      'REPLACE WHITESHADE))
+                           (EOL                              (* Blank out the CR's width.)

+                                (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
+                                       (fetch
 YBOT of
 LINE)
+                                       (IMAX 6 (CHARWIDTH CH FONT))
+                                       (fetch
 LHEIGHT of
 LINE)
+                                       'TEXTURE
+                                       'REPLACE WHITESHADE))
                            (BLTCHAR CH DS])
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -353,7 +212,6 @@
        CHATDECLS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1070 11167 (TEDITCHAT.CHARFN 1080 . 1769) (\TEXTSTREAMBOUT 1771 . 11165)) (11168 14251 
-(TEDITSTREAM.INIT 11178 . 12411) (TEDITCHAT.MENUFN 12413 . 14249)) (14290 20705 (TEDIT.DISPLAYTEXT 
-14300 . 20703)))))
+  (FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN
+ 3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333)))))
 STOP

library/tedit/TEDIT-DCL.LCOM

@@ -1,464 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
-(FILECREATED "14-Jul-2022 17:04:17" ("compiled on " 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3) "14-Jul-2022 13:19:07" 
-tcompl'd in "FULL 14-Jul-2022 ..." dated "14-Jul-2022 13:19:12")
-(FILECREATED "14-Jul-2022 17:03:38" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3 84851 :CHANGES-TO (VARS 
-TEDITFILES) :PREVIOUS-DATE "14-Jul-2022 16:29:57" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;2)
-(PRETTYCOMPRINT TEDIT-DCLCOMS)
-(RPAQQ TEDIT-DCLCOMS ((* ;;; 
-"This file is the collected record declarations and compile-time necessities for TEDIT.") (* ;; 
-"FROM TEDIT") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))) (* ;; 
-"FROM TEDITSELECTION") (RECORDS SELECTION) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (COPYSELSHADE 
-30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800))) (VARS TEDITFILES) (* ;; 
-"FROM TEDITSCREEN") (RECORDS THISLINE LINEDESCRIPTOR LINECACHE) (DECLARE%: EVAL@COMPILE DONTCOPY (
-CONSTANTS (LMInvisibleRun 401) (LMLooksChange 400))) (* ;; "FROM TEXTOFD") (RECORDS EDITMARK) (RECORDS
- PIECE TEXTOBJ TEXTIMAGEDATA TEXTSTREAM) (OPTIMIZERS TEXTPROP) (COMS (* ;; 
-"Private data structures and constants FROM TEXTOFD") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (
-\PCTBFreePieces 0) (\PCTBLastPieceOffset 1) (\FirstPieceOffset 2) (\SecondPieceOffset 4) (
-\EltsPerPiece 2)) (MACROS \EDITELT \GETCH \GETCHB \EDITSETA \WORDSETA) (GLOBALVARS \TEXTIMAGEOPS 
-\TEXTOFD \TEXTFDEV))) (* ;;; "FROM TEDITPAGE") (RECORDS PAGEFORMATTINGSTATE PAGEREGION) (DECLARE%: 
-EVAL@COMPILE DONTCOPY (RECORDS TEDITPAPERSIZE) (FUNCTIONS \NEW-COLUMN-START \FIRST-COLUMN-START)) (* 
-;; "FROM TEDITFIND") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\AlphaNumericFlag 256) (\AlphaFlag 
-512) (\OneCharPattern 1024) (\AnyStringPattern 1025) (\OneAlphaPattern 1026) (\AnyAlphaPattern 1027) (
-\OneNonAlphaPattern 1028) (\AnyNonAlphaPattern 1029) (\LeftBracketPattern 1030) (\RightBracketPattern 
-1031) (\SpecialPattern 1024))) (* ;; " FROM TEDITLOOKS") (RECORDS CHARLOOKS FMTSPEC PENDINGTAB) (
-DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \SMALLPIN \SMALLPOUT ONOFF)) (* ;; "FROM TEDITMENU") (
-DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MBUTTON)) (INITRECORDS MBUTTON) (DECLARE%: EVAL@COMPILE 
-DONTCOPY (RECORDS NWAYBUTTON)) (INITRECORDS NWAYBUTTON) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS 
-MARGINBAR)) (INITRECORDS MARGINBAR) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TAB)) (RECORDS MB.3STATE
- MB.BUTTON MB.INSERT MB.MARGINBAR MB.NWAY MB.TEXT MB.TOGGLE) (FUNCTIONS WITHOUT-UPDATES) (* ;; 
-"FROM TEDITHISTORY") (RECORDS TEDITHISTORYEVENT) (* ;; "FROM TEDITFILE") (DECLARE%: EVAL@COMPILE 
-DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0) (\PieceDescriptorOBJECT 1) (\PieceDescriptorPARA 2) (
-\PieceDescriptorPAGEFRAME 3) (\PieceDescriptorCHARLOOKSLIST 4) (\PieceDescriptorPARALOOKSLIST 5) (
-\PieceDescriptorSAFEOBJECT 6))) (* ;; "FROM TEDITCOMMAND") (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS 
-\INSERT\TTY\BUFFER \TEDIT.MOUSESTATE \TEDIT.CHECK)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS 
-TEDITTERMCODE)) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (
-WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 
-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) (* ;; "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) (* ; 
-"Must not break after this character (e.g. Japanese open-quote)") (BEFORE.LB 4) (* ; 
-"OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)"
-) (AFTER.LB 8) (* ; 
-"OK to break after this char, if it's OK to break before the next one (true of most white space)") (
-DISAPPEAR-IF-NOT-SPLIT.LB 16) (* ; 
-"This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)"
-) (NEWCHAR-IF-SPLIT.LB 32) (* ; 
-"Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found."
-))))))
-(DATATYPE SELECTION ((* ;; 
-"Description of a piece of selected text for TEdit.  Text has to be selected before it can be operated on by the user."
-) Y0 (* ; "Y value of topmost line of selection") X0 (* ; "X value of left edge of selection") DX (* ;
- "Width of the selection, if it's on one line.") CH# (* ; "CH# of the first selected character") XLIM 
-(* ; "X value of right edge of last selected character") CHLIM (* ; 
-"CH# of the last character in the selection") DCH (* ; 
-"# of characters selected (can be zero, for point selection.)") L1 (* ; 
-"-> line descriptor for the line where the first selected character is") LN (* ; 
-"-> line descriptor for the line which contains the end of the selection") YLIM (* ; 
-"Y value of the bottom of the line that ends the selection") POINT (* ; 
-"Which end should the caret appear at?  (LEFT or RIGHT)") (SET FLAG) (* ; 
-"T if this selection is real;  NIL if not") (\TEXTOBJ FULLXPOINTER) (* ; 
-"TEXTOBJ that describes the selected text") SELKIND (* ; 
-"What kind of selection?  CHAR or WORD or LINE or PARA") HOW (* ; 
-"SHADE used to highlight this selection") HOWHEIGHT (* ; 
-"Height of the highlight (1 usually, full line for delete selection...)") (HASCARET FLAG) (* ; 
-"T if there should be a caret for this selection") SELOBJ (* ; 
-"If this selection is inside an object, which object?") (ONFLG FLAG) (* ; 
-"T if the selection is highlighted on the screen, else NIL") SELOBJINFO (* ; 
-"A Place for the selected object to put info about selection inside itself.")) SET _ NIL HOW _ 
-BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T Y0 _ 0 X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST 
-NIL))
-(/DECLAREDATATYPE (QUOTE SELECTION) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER)) 
-(QUOTE ((SELECTION 0 POINTER) (SELECTION 2 POINTER) (SELECTION 4 POINTER) (SELECTION 6 POINTER) (
-SELECTION 8 POINTER) (SELECTION 10 POINTER) (SELECTION 12 POINTER) (SELECTION 14 POINTER) (SELECTION 
-16 POINTER) (SELECTION 18 POINTER) (SELECTION 20 POINTER) (SELECTION 20 (FLAGBITS . 0)) (SELECTION 22 
-FULLXPOINTER) (SELECTION 24 POINTER) (SELECTION 26 POINTER) (SELECTION 28 POINTER) (SELECTION 28 (
-FLAGBITS . 0)) (SELECTION 30 POINTER) (SELECTION 30 (FLAGBITS . 0)) (SELECTION 32 POINTER))) (QUOTE 34
-))
-(RPAQQ TEDITFILES (TEDIT-PCTREE TEDIT-TEXTOFD TEDIT TEDIT-ABBREV TEDIT-COMMAND TEDIT-DCL TEDIT-FILE 
-TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-LOOKS TEDIT-MENU TEDIT-PAGE TEDIT-SCREEN 
-TEDIT-SELECTION TEDIT-WINDOW))
-(DATATYPE THISLINE ((* ;; 
-"Cache for line-related character location info, for selection and line-display code to use.") (DESC 
-FULLXPOINTER) (* ; "Line descriptor for the line this describes now") LEN (* ; 
-"Length of the line in characters") CHARS (* ;; 
-"Array of character codes (or objects) on the line (charcode of 400 => dummy entry for looks change--go get next entry in LOOKS)"
-) WIDTHS (* ; "Array of each character's width in points") LOOKS (* ; 
-"Array of any looks changes within the line.  LOOKS (0) = starting character looks for the line") 
-TLSPACEFACTOR (* ; "The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ; 
-"The first space to which SPACEFACTOR is to apply.  This is used so that spaces to the left of a TAB have their default width."
-)) LEN _ 0 CHARS _ (ARRAY 512 (QUOTE POINTER) 0 0) WIDTHS _ (ARRAY 512 (QUOTE POINTER) 0 0) LOOKS _ (
-ARRAY 512 (QUOTE POINTER) NIL 0) TLFIRSTSPACE _ 0)
-(DATATYPE LINEDESCRIPTOR ((* ;; 
-"Description of a single line of formatted text, either on the display or for a printed page.") YBOT (
-* ; "Y value for the bottom of the line (below the descent)") YBASE (* ; 
-"Yvalue for the base line the characters sit on") LEFTMARGIN (* ; "Left margin, in screen points") 
-RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ; 
-"X value of right edge of rightmost character on the line (may exceed right margin, if char is a space.)"
-) SPACELEFT (* ; "Space left on the line, ignoring trailing blanks & CRs.") LHEIGHT (* ; 
-"Total height of hte line, Ascent+Descent.") ASCENT (* ; "Ascent of the line above YBASE") DESCENT (* 
-; "How far line descends below YBASE") LTRUEDESCENT (* ; 
-"The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ; 
-"The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") CHAR1 (* ; 
-"CH# of the first character on the line.") CHARLIM (* ; "CH# of the last character on the line") 
-CHARTOP (* ; "CH# of the character which forced the line break (may exceed CHARLIM)") NEXTLINE (* ; 
-"Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ; 
-"One of SOLID, GREY, NIL.  Tells what kind of special-line marker should be put in the left margin for this paragraph.  (For hardcopy, can also be an indicator for special processing?)"
-) LTEXTOBJ (* ; 
-"A cached TEXTOBJ that this line took its text from.  Used in hardcopy to disambiguate when chno's should be updated..."
-) CACHE (* ; 
-"A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit."
-) LDOBJ (* ; "The object which lies behind this line of text, for updating, etc.") LFMTSPEC (* ; 
-"The format spec for this line's paragraph (eventually)") (DIRTY FLAG) (* ; 
-"T if this line has changed since it was last formatted.") (CR\END FLAG) (* ; 
-"T if this line ends with a CR.") (DELETED FLAG) (* ; 
-"T if this line has been completely deleted since it was last formatted or displayed.  (Used by deletion routines to detect garbage lines)"
-) (LHASPROT FLAG) (* ; "This line contains protected text.") (LHASTABS FLAG) (* ; 
-"If this line has a tab in it, this is the line-relative ch# of the final tab.  This is to let us punt properly with tabs in a line."
-) (1STLN FLAG) (* ; "This line is the first line in a paragraph") (LSTLN FLAG) (* ; 
-"This is the last line in a paragraph")) CHARLIM _ 1000000 NEXTLINE _ NIL PREVLINE _ NIL DIRTY _ NIL 
-YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL)
-(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ; 
-"The bitmap that will be used by this instance of the cache") (LCNEXTCACHE FULLXPOINTER) (* ; 
-"The next cache in the chain, for screen updates.")))
-(/DECLAREDATATYPE (QUOTE THISLINE) (QUOTE (FULLXPOINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER)) (QUOTE ((THISLINE 0 FULLXPOINTER) (THISLINE 2 POINTER) (THISLINE 4 POINTER) (THISLINE 6 
-POINTER) (THISLINE 8 POINTER) (THISLINE 10 POINTER) (THISLINE 12 POINTER))) (QUOTE 14))
-(/DECLAREDATATYPE (QUOTE LINEDESCRIPTOR) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER 
-POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG)) (QUOTE ((LINEDESCRIPTOR 0 POINTER) (
-LINEDESCRIPTOR 2 POINTER) (LINEDESCRIPTOR 4 POINTER) (LINEDESCRIPTOR 6 POINTER) (LINEDESCRIPTOR 8 
-POINTER) (LINEDESCRIPTOR 10 POINTER) (LINEDESCRIPTOR 12 POINTER) (LINEDESCRIPTOR 14 POINTER) (
-LINEDESCRIPTOR 16 POINTER) (LINEDESCRIPTOR 18 POINTER) (LINEDESCRIPTOR 20 POINTER) (LINEDESCRIPTOR 22 
-POINTER) (LINEDESCRIPTOR 24 POINTER) (LINEDESCRIPTOR 26 POINTER) (LINEDESCRIPTOR 28 POINTER) (
-LINEDESCRIPTOR 30 FULLXPOINTER) (LINEDESCRIPTOR 32 POINTER) (LINEDESCRIPTOR 34 POINTER) (
-LINEDESCRIPTOR 36 POINTER) (LINEDESCRIPTOR 38 POINTER) (LINEDESCRIPTOR 40 POINTER) (LINEDESCRIPTOR 40 
-(FLAGBITS . 0)) (LINEDESCRIPTOR 40 (FLAGBITS . 16)) (LINEDESCRIPTOR 40 (FLAGBITS . 32)) (
-LINEDESCRIPTOR 40 (FLAGBITS . 48)) (LINEDESCRIPTOR 38 (FLAGBITS . 0)) (LINEDESCRIPTOR 38 (FLAGBITS . 
-16)) (LINEDESCRIPTOR 38 (FLAGBITS . 32)))) (QUOTE 42))
-(/DECLAREDATATYPE (QUOTE LINECACHE) (QUOTE (POINTER FULLXPOINTER)) (QUOTE ((LINECACHE 0 POINTER) (
-LINECACHE 2 FULLXPOINTER))) (QUOTE 4))
-(RECORD EDITMARK ((* ;; 
-"Used for fast access to a given place in the text--a %"Marker%".   It consists of the piece, and the offset within the piece, and the piece number within the piece table.  That's everything that's needed to set a text stream up quickly to start reading from a given place."
-) PC PCOFF . PCNO))
-(DATATYPE PIECE ((* ; 
-"The piece describes either a string or part of a file.  , or a generalized OBJECT.") PSTR (* ; 
-"The string where this piece's text resides, or NIL") PFILE (* ; 
-"The file which contains this piece's text, or NIL") PFPOS (* ; 
-"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.") 
-NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ; 
-"-> Prior piece in this text object.") PLOOKS (* ; 
-"Formatting info and formatting events in this piece") POBJ (* ; "The OBJECT this piece describes") (
-PPARALAST FLAG) (* ; "This piece contains a paragraph break") PPARALOOKS (* ; 
-"Paragraph looks for this piece") (PNEW FLAG) (* ; 
-"This text is new here;  used by the tentative edit system, and anyone else interested.") (PFATP FLAG)
- (* ; 
-"T if the characters in this piece are FAT -- i.e., are 16 bits each. This is trumped for a piece on a file that has its own PEXTERNALFORMAT"
-) (PTREENODE XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PEXTERNALFORMAT
- POINTER (* ; "The external format of a piece on a file"))) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0 
-PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL)
-(DATATYPE TEXTOBJ ((* ;; 
-"This is where TEdit stores its state information, and internal data about the text being edited.") 
-PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") \INSERTPC (* ; 
-"Piece to hold type-in") \INSERTPCNO (* ; "Piece # of the input piece") \INSERTNEXTCH (* ; 
-"CH# of next char which is typed into that piece.") \INSERTLEFT (* ; "Space left in the type-in piece"
-) \INSERTLEN (* ; "# of characters already in the piece.") \INSERTSTRING (* ; 
-"The string which the piece describes.") \INSERTFIRSTCH (* ; "CH# of first char in the piece.") (
-\INSERTPCVALID FLAG) (* ; 
-"T if it's OK to use the cached piece.  Set to NIL by people who require that the next insertion/deletion use a different piece."
-) \WINDOW (* ; "The window<s> where this textobj is displayed") MOUSEREGION (* ; 
-"Section of the window the mouse is in.") LINES (* ; 
-"-> to top of chain of line descriptors for displayed text") DS (* ; 
-"Display stream where this textobj is displayed") SEL (* ; "The current selection within the text") 
-SCRATCHSEL (* ; "Scratch space for the selection code") MOVESEL (* ; 
-"Source for the next MOVE of text") SHIFTEDSEL (* ; "Source for the next COPY") DELETESEL (* ; 
-"Text to be deleted imminently") WRIGHT (* ; 
-"Right edge of the window (or subregion) where this is displayed") WTOP (* ; 
-"Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ; 
-"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG) 
-(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ; 
-"-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ; 
-"T => The guy has asked the editor to go way") CARET (* ; 
-"Describes the flashing caret for the editing window") CARETLOOKS (* ; 
-"Font to be used for inserted text.") WINDOWTITLE (* ; 
-"Original title for this window, of there was one.") THISLINE (* ; 
-"Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ; 
-"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ; 
-"Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ; 
-"Flag for paragraph formatting.  T if this document is to contain paragraph formatting information.") 
-(TXTREADONLY FLAG) (* ; "This is only available for shift selection.") (TXTEDITING FLAG) (* ; 
-"T => This document is in a window and there is an edit process behind it.  For example, it only makes sense to have a caret show up if you are editing."
-) (TXTNONSCHARS FLAG) (* ; 
-"T => If TEdit rns into a 255, it won't attempt to convert to NS characters.  Used for REALLY plain-text manipulation."
-) TXTTERMSA (* ; "Special instructions for displaying characters on the screen") EDITOPACTIVE (* ; 
-"T if there is an editing operation in progress.  Used to interlock the TEdit menu") DEFAULTCHARLOOKS 
-(* ; 
-"The default character looks -- if any -- to be applied to characters coming into the file from outside."
-) TXTRTBL (* ; "The READTABLE to be used by the command loop for command dispatch") TXTWTBL (* ; 
-"The READTABLE to be used to decide on word breaks") EDITPROPS (* ; 
-"The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ; 
-"T if the next insertion in this document is to be preceded by a deletion of the then-current selection"
-) TXTHISTORY (* ; "The history list for this edit session.") (SELWINDOW FULLXPOINTER) (* ; 
-"The window in which the last 'real' selection got made for this edit;  used to control caret placement"
-) PROMPTWINDOW (* ; 
-"A window to be used for unscheduled interactions;  normally a small window above the edit window") 
-DISPLAYCACHE (* ; "The bitmap to be used when building the image of a line for display") 
-DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPLAYHCPYDS (* ; 
-"The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode"
-) TXTPAGEFRAMES (* ; "A tree of page frames, specifying how the document is to be laid out.") 
-TXTCHARLOOKSLIST (* ; "List of all the CHARLOOKSs in the document, so they can be kept unique") 
-TXTPARALOOKSLIST (* ; "List of all the FMTSPECs in the document, so they can be kept unique") (
-TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ; 
-"T if we're holding off on screen updates until later.  Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW."
-) TXTRAWINCLUDESTREAM (* ; 
-"NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ; 
-"Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ; 
-"Style sheet local to this document.  Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
-(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (IF (NEQ (FETCH (TEXTOBJ \XDIRTY) OF DATUM) 
-NEWVALUE) THEN (* ; "update the title to reflect the change") (\TEDIT.WINDOW.TITLE DATUM (
-\TEDIT.ORIGINAL.WINDOW.TITLE (ffetch (TEXTOBJ TXTFILE) of DATUM) NEWVALUE))) (freplace \XDIRTY OF 
-DATUM WITH NEWVALUE))))) SEL _ (create SELECTION) SCRATCHSEL _ (create SELECTION) MOVESEL _ (create 
-SELECTION HOWHEIGHT _ 32767 HASCARET _ NIL) SHIFTEDSEL _ (create SELECTION HASCARET _ NIL) DELETESEL _
- (create SELECTION HOWHEIGHT _ 32767 HASCARET _ NIL) \INSERTNEXTCH _ -1 \INSERTPC _ NIL \INSERTLEFT _ 
-0 \INSERTLEN _ 0 \INSERTSTRING _ NIL \INSERTFIRSTCH _ 1000000 TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 
-0 WBOTTOM _ 0 TXTFILE _ NIL \XDIRTY _ NIL MOUSEREGION _ (QUOTE TEXT) THISLINE _ (create THISLINE) 
-MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL)
-(DATATYPE TEXTIMAGEDATA ((* ;; "Fills the IMAGEDATA field of text streams.") TICURPARALOOKS (* ; 
-"The current paragraph looks") TICURIMAGESTREAM (* ; "The image stream for this hardcopy transduction"
-) TILOOKSUPDATEFN (* ; "The function to call to update looks for this stream") TIPCOFFSET (* ; 
-"The offset into the current piece, as of the last page cross.")))
-(ACCESSFNS TEXTSTREAM ((* ;; 
-"Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (REALFILE
- (fetch F1 of DATUM) (REPLACE F1 OF DATUM WITH NEWVALUE)) (* ; 
-"The real, underlying file behind the current piece") (CHARSLEFT (fetch F2 of DATUM) (REPLACE F2 OF 
-DATUM WITH NEWVALUE)) (* ;; 
-"The # of characters that will be left in the current piece the next time its file crosses a page boundary"
-) (TEXTOBJ (fetch F3 of DATUM) (REPLACE F3 OF DATUM WITH NEWVALUE)) (* ; 
-"The TEXTOBJ that is editing this text") (PIECE (fetch F5 of DATUM) (REPLACE F5 OF DATUM WITH NEWVALUE
-)) (* ; "The PIECE we're currently fetching chars from/putting chars into") (PCNO (fetch FW8 of DATUM)
- (REPLACE FW8 OF DATUM WITH NEWVALUE)) (* ; "The position of that piece in the piece table") (
-PCSTARTPG (fetch FW6 of DATUM) (REPLACE FW6 OF DATUM WITH NEWVALUE)) (* ; 
-"The underlying file page# that this piece starts on") (PCSTARTCH (fetch FW7 of DATUM) (REPLACE FW7 OF
- DATUM WITH NEWVALUE)) (* ; 
-"The char within page of the underlying file that this piece starts on -- for backbin & co") (PCOFFSET
- (fetch TIPCOFFSET of (fetch IMAGEDATA of DATUM)) (REPLACE TIPCOFFSET OF (fetch IMAGEDATA of DATUM) 
-with NEWVALUE)) (* ; "The offset into the current piece, as of the last page cross.") (CURRENTLOOKS (
-fetch F10 of DATUM) (replace F10 of DATUM with NEWVALUE)) (* ; 
-"The CHARLOOKS that are currently applicable to characters being taken from the stream.") (
-CURRENTPARALOOKS (fetch TICURPARALOOKS of (fetch IMAGEDATA of DATUM)) (REPLACE TICURPARALOOKS OF (
-fetch IMAGEDATA of DATUM) with NEWVALUE)) (* ; 
-"The FMTSPEC that is currently applicable to characters being taken from the stream.") (
-CURRENTIMAGESTREAM (fetch TICURIMAGESTREAM of (fetch IMAGEDATA of DATUM)) (REPLACE TICURIMAGESTREAM OF
- (fetch IMAGEDATA of DATUM) with NEWVALUE) (* ; 
-"The image stream that this text is being put onto;  used for scaling decisions")) (LOOKSUPDATEFN (
-fetch TILOOKSUPDATEFN of (fetch IMAGEDATA of DATUM)) (REPLACE TILOOKSUPDATEFN OF (fetch IMAGEDATA of 
-DATUM) with NEWVALUE)) (* ; "Function to be called each time character looks change.") (FATSTREAMP (
-fetch F4 of DATUM) (REPLACE F4 OF DATUM WITH NEWVALUE)) (* ; 
-"T if the current piece is 16 bit characters.")) (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ (
-create TEXTIMAGEDATA))))
-(/DECLAREDATATYPE (QUOTE PIECE) (QUOTE (POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER 
-POINTER FLAG POINTER FLAG FLAG XPOINTER POINTER)) (QUOTE ((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4
- POINTER) (PIECE 6 POINTER) (PIECE 8 POINTER) (PIECE 10 FULLXPOINTER) (PIECE 12 POINTER) (PIECE 14 
-POINTER) (PIECE 14 (FLAGBITS . 0)) (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS . 
-16)) (PIECE 18 XPOINTER) (PIECE 20 POINTER))) (QUOTE 22))
-(/DECLAREDATATYPE (QUOTE TEXTOBJ) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER
- FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER FULLXPOINTER POINTER
- POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER POINTER POINTER)) (QUOTE ((TEXTOBJ 
-0 POINTER) (TEXTOBJ 2 POINTER) (TEXTOBJ 4 POINTER) (TEXTOBJ 6 POINTER) (TEXTOBJ 8 POINTER) (TEXTOBJ 10
- POINTER) (TEXTOBJ 12 POINTER) (TEXTOBJ 14 POINTER) (TEXTOBJ 16 POINTER) (TEXTOBJ 16 (FLAGBITS . 0)) (
-TEXTOBJ 18 POINTER) (TEXTOBJ 20 POINTER) (TEXTOBJ 22 POINTER) (TEXTOBJ 24 POINTER) (TEXTOBJ 26 POINTER
-) (TEXTOBJ 28 POINTER) (TEXTOBJ 30 POINTER) (TEXTOBJ 32 POINTER) (TEXTOBJ 34 POINTER) (TEXTOBJ 36 
-POINTER) (TEXTOBJ 38 POINTER) (TEXTOBJ 40 POINTER) (TEXTOBJ 42 POINTER) (TEXTOBJ 44 POINTER) (TEXTOBJ 
-44 (FLAGBITS . 0)) (TEXTOBJ 46 FULLXPOINTER) (TEXTOBJ 48 POINTER) (TEXTOBJ 50 POINTER) (TEXTOBJ 52 
-POINTER) (TEXTOBJ 54 POINTER) (TEXTOBJ 56 POINTER) (TEXTOBJ 56 (FLAGBITS . 0)) (TEXTOBJ 58 POINTER) (
-TEXTOBJ 58 (FLAGBITS . 0)) (TEXTOBJ 58 (FLAGBITS . 16)) (TEXTOBJ 58 (FLAGBITS . 32)) (TEXTOBJ 58 (
-FLAGBITS . 48)) (TEXTOBJ 60 POINTER) (TEXTOBJ 62 POINTER) (TEXTOBJ 64 POINTER) (TEXTOBJ 66 POINTER) (
-TEXTOBJ 68 POINTER) (TEXTOBJ 70 POINTER) (TEXTOBJ 70 (FLAGBITS . 0)) (TEXTOBJ 72 POINTER) (TEXTOBJ 74 
-FULLXPOINTER) (TEXTOBJ 76 POINTER) (TEXTOBJ 78 POINTER) (TEXTOBJ 80 POINTER) (TEXTOBJ 82 POINTER) (
-TEXTOBJ 84 POINTER) (TEXTOBJ 86 POINTER) (TEXTOBJ 88 POINTER) (TEXTOBJ 88 (FLAGBITS . 0)) (TEXTOBJ 88 
-(FLAGBITS . 16)) (TEXTOBJ 90 POINTER) (TEXTOBJ 92 POINTER) (TEXTOBJ 94 POINTER))) (QUOTE 96))
-(/DECLAREDATATYPE (QUOTE TEXTIMAGEDATA) (QUOTE (POINTER POINTER POINTER POINTER)) (QUOTE ((
-TEXTIMAGEDATA 0 POINTER) (TEXTIMAGEDATA 2 POINTER) (TEXTIMAGEDATA 4 POINTER) (TEXTIMAGEDATA 6 POINTER)
-)) (QUOTE 8))
-(DEFOPTIMIZER TEXTPROP (TEXTOBJ PROP &OPTIONAL (VAL NIL WRITING)) (* ;; "compiles calls to TEXTPROP") 
-(COND ((NOT (LISTP PROP)) (* ; "property is not quoted.") (QUOTE IGNOREMACRO)) ((NOT (EQ (CAR PROP) (
-QUOTE QUOTE))) (* ; "property is not quoted.") (QUOTE IGNOREMACRO)) ((NOT WRITING) (* ; 
-"fetching a TEXTPROP property.") (SELECTQ (CADR PROP) ((READONLY READ-ONLY) (BQUOTE (fetch (TEXTOBJ 
-TXTREADONLY) of (TEXTOBJ (\, TEXTOBJ))))) ((BEING-EDITED ACTIVE) (BQUOTE (fetch (TEXTOBJ TXTEDITING) 
-of (TEXTOBJ (\, TEXTOBJ))))) ((NO-NS-CHARS NONSCHARS NO-NSCHARS) (BQUOTE (fetch (TEXTOBJ TXTNONSCHARS)
- of (TEXTOBJ (\, TEXTOBJ))))) (BQUOTE (LISTGET (fetch (TEXTOBJ EDITPROPS) of (TEXTOBJ (\, TEXTOBJ))) (
-\, PROP))))) (T (* ; "storing a window property") (SELECTQ (CADR PROP) ((READONLY READ-ONLY) (BQUOTE (
-REPLACE (TEXTOBJ TXTREADONLY) OF (TEXTOBJ (\, TEXTOBJ)) WITH (\, VAL)))) ((BEING-EDITED ACTIVE) (
-BQUOTE (REPLACE (TEXTOBJ TXTEDITING) OF (TEXTOBJ (\, TEXTOBJ)) WITH (\, VAL)))) ((NO-NS-CHARS 
-NONSCHARS NO-NSCHARS) (BQUOTE (REPLACE (TEXTOBJ TXTNONSCHARS) OF (TEXTOBJ (\, TEXTOBJ)) WITH (\, VAL))
-)) (BQUOTE (LET* (($$TEXTOBJ$$ (TEXTOBJ (\, TEXTOBJ))) ($$PROPLST$$ (FETCH EDITPROPS OF $$TEXTOBJ$$)))
- (COND ($$PROPLST$$ (LISTPUT $$PROPLST$$ (\, PROP) (\, VAL))) (T (REPLACE EDITPROPS OF $$TEXTOBJ$$ 
-WITH (LIST (\, PROP) (\, VAL)))))))))))
-(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ; 
-"The current page number.  Counted from 1") FIRSTPAGE (* ;; 
-"T if the current page is the 'first page' .  Is set initially, and can be set again by the user at will.  Gets reset after each page image is printed."
-) MINPAGE# (* ; "The page # of the first page to be printed, or NIL") MAXPAGE# (* ; 
-"The page # of the last page to be printed, or NIL") STATE (* ; "One of FORMATTING or SEARCHING.") 
-REQUIREDREGIONTYPE (* ; 
-"If STATE is SEARCHING, the kind of box we're looking for.  If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page."
-) MAINSTREAM (* ; "The principal textobj/stream source") CHNO (* ; "Our position in that stream") 
-PRESSREGION (* ; "The press code's REGION info.") PAGEHEADINGS (* ; 
-"The list of current values to be printed, indexed by heading type") PAGE#GENERATOR (* ; 
-"List of page numbers;  later, maybe, a function to generate page numbers.  Used to fill in PAGE#TEXT, below"
-) PAGE#TEXT (* ; 
-"If special page numbers are in use, this is the place to take them from.  PAGE# is still used for recto/verso decisions &c"
-) PAGEISRECTO (* ; "T if this is a recto page, NIL if it's a VERSO page.") PAGEFOOTNOTELINES (* ; 
-"A list of extant footnote lines that should appear at the next opportunity") PAGEFLOATINGTOPLINES (* 
-; "A list of lines that should float to the top of the next available place") PAGECOUNT (* ; 
-"The number of pages we've formatted so far.") PAGELINECACHE (* ; 
-"A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time"
-) NEWPAGELAYOUT (* ; 
-"If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again."
-)) PAGECOUNT _ 0)
-(DATATYPE PAGEREGION ((* ;; 
-"Describe a part of a page for page formatting.  Can be made into compound descriptions.") 
-REGIONFILLMETHOD (* ; "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") REGIONSPEC (*
- ; "The page-relative region this occupies") REGIONLOCALINFO (* ; "A PLIST for local information") (
-REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") REGIONSUBBOXES (* ; 
-"The sub-regions of this region") REGIONTYPE (* ; "A user-settable region type")))
-(/DECLAREDATATYPE (QUOTE PAGEREGION) (QUOTE (POINTER POINTER POINTER FULLXPOINTER POINTER POINTER)) (
-QUOTE ((PAGEREGION 0 POINTER) (PAGEREGION 2 POINTER) (PAGEREGION 4 POINTER) (PAGEREGION 6 FULLXPOINTER
-) (PAGEREGION 8 POINTER) (PAGEREGION 10 POINTER))) (QUOTE 12))
-(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") 
-CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;; 
-"Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE.  USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
-) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") (
-CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ; 
-"T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ; 
-"T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ; 
-"T if the characters are to be struck thru, else nil.") CLOFFSET (* ; 
-"A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") (CLSMALLCAP FLAG) (* ; 
-"T if small caps, else NIL") (CLINVERTED FLAG) (* ; 
-"T if the characters are to be shown white-on-black") (CLPROTECTED FLAG) (* ; 
-"T if chars can't be selected, else NIL") (CLINVISIBLE FLAG) (* ; 
-"T if TEDIT is to ignore these chars;  else NIL") (CLSELHERE FLAG) (* ;; 
-"T if TEDIT can put selection after this char (for menu blanks) else NIL;  anything typed after this char will NOT BE PROTECTED."
-) (CLCANCOPY FLAG) (* ;; 
-"T if this text can be selected for copying, even tho protected (it will become unprotected after the copy;  for Dribble/TTY interface)"
-) CLSTYLE (* ; "The style to be used in marking these characters;  overridden by the other fields") 
-CLUSERINFO (* ; "Any information that an outsider wants to include") CLLEADER (* ; 
-"For creating dotted and other kinds of leader") CLRULES (* ;; 
-"For arbitrarily-places horizontal rules.  List of pairs, of (widthinpts  . offsetfrombaselineinpts).  Should be taken account of in ascent/descent calcs."
-) (CLMARK FLAG) (* ;; 
-"Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
-)) CLOFFSET _ 0)
-(DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.") 
-1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ; 
-"Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ; 
-"Right margin for the paragraph") LEADBEFORE (* ; 
-"Leading above the paragraph's first line, in points") LEADAFTER (* ; 
-"Leading below the paragraph's bottom line, in points.  NOT IMPLEMENTED.") LINELEAD (* ; 
-"Leading between lines, in points.  Actually, this space is added BELOW each line in the para.") 
-FMTBASETOBASE (* ; 
-"The baseline-to-baseline spacing between lines in this paragraph.  THIS OVERRIDES THE LINE LEADING") 
-TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default tab width") QUAD (* ; 
-"How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ; 
-"The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ; 
-"The characterstyles that control the appearance of characters in this para (maybe?  may be part of the fmtstyle.)"
-) FMTUSERINFO (* ; "Space for a PLIST of user info") FMTSPECIALX (* ; 
-"A special horizontal location on the printed page for this para.") FMTSPECIALY (* ; 
-"A special vertical location on the page for this para") (FMTHEADINGKEEP FLAG) (* ; 
-"This para should be kept with the top line or so of the next para..") FMTPARATYPE (* ; 
-"What kind of para this is: TEXT, PAGEHEADING, whatever") FMTPARASUBTYPE (* ; 
-"Sub type of the type, e.g., what KIND of page heading this is.") FMTNEWPAGEBEFORE (* ; 
-"Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box."
-) FMTNEWPAGEAFTER (* ; "Similarly") FMTKEEP (* ; 
-"For information about how this paragraph is to be kept with other paragraphs.") FMTCOLUMN (* ; 
-"For setting up side-by-side paragraphs easily ala BravoX") FMTVERTRULES (* ; 
-"For Keeping track of vertical rules in force") (FMTMARK FLAG) (* ; 
-"Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file"
-) (* ; 
-"Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it makes sense to save it on the file."
-) (FMTHARDCOPY FLAG) (* ; "T if this paragraph is to be displayed in hardcopy-format.") FMTREVISED (* 
-; 
-"T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output."
-)) TABSPEC _ (CONS NIL NIL))
-(DATATYPE PENDINGTAB ((* ;; 
-"The data structure for a tab, within the line formatter, that we haven't finished dealing with yet, e.g. a centered tab where you need to wait for AFTER the centered text to do the formatting."
-) PTNEWTX (* ;; 
-"An updated TX, being passed back to the line formatter.  This results from the resolution of an old RIGHT, CENTERED, or DECIMAL tab, which changed the width of a prior tab."
-) PTOLDTAB (* ; "The pending tab") PTTYPE (* ; "Its tab type") PTTABX (* ; "Its nominal X position") (
-PTWBASE FULLXPOINTER) (* ; 
-"The WBASE for its width, for updating when we've figured out how wide the tab really is") PTOLDTX (* 
-; "The TX as of when the tab was encountered.")))
-(/DECLAREDATATYPE (QUOTE CHARLOOKS) (QUOTE (POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER 
-FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER FLAG)) (QUOTE ((CHARLOOKS 0 POINTER) (
-CHARLOOKS 2 POINTER) (CHARLOOKS 4 POINTER) (CHARLOOKS 4 (FLAGBITS . 0)) (CHARLOOKS 4 (FLAGBITS . 16)) 
-(CHARLOOKS 4 (FLAGBITS . 32)) (CHARLOOKS 4 (FLAGBITS . 48)) (CHARLOOKS 2 (FLAGBITS . 0)) (CHARLOOKS 6 
-POINTER) (CHARLOOKS 6 (FLAGBITS . 0)) (CHARLOOKS 6 (FLAGBITS . 16)) (CHARLOOKS 6 (FLAGBITS . 32)) (
-CHARLOOKS 6 (FLAGBITS . 48)) (CHARLOOKS 2 (FLAGBITS . 16)) (CHARLOOKS 2 (FLAGBITS . 32)) (CHARLOOKS 8 
-POINTER) (CHARLOOKS 10 POINTER) (CHARLOOKS 12 POINTER) (CHARLOOKS 14 POINTER) (CHARLOOKS 14 (FLAGBITS
- . 0)))) (QUOTE 16))
-(/DECLAREDATATYPE (QUOTE FMTSPEC) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER FLAG FLAG POINTER)) (QUOTE ((FMTSPEC 0 POINTER) (FMTSPEC 2 POINTER) (FMTSPEC 4 POINTER
-) (FMTSPEC 6 POINTER) (FMTSPEC 8 POINTER) (FMTSPEC 10 POINTER) (FMTSPEC 12 POINTER) (FMTSPEC 14 
-POINTER) (FMTSPEC 16 POINTER) (FMTSPEC 18 POINTER) (FMTSPEC 20 POINTER) (FMTSPEC 22 POINTER) (FMTSPEC 
-24 POINTER) (FMTSPEC 26 POINTER) (FMTSPEC 26 (FLAGBITS . 0)) (FMTSPEC 28 POINTER) (FMTSPEC 30 POINTER)
- (FMTSPEC 32 POINTER) (FMTSPEC 34 POINTER) (FMTSPEC 36 POINTER) (FMTSPEC 38 POINTER) (FMTSPEC 40 
-POINTER) (FMTSPEC 40 (FLAGBITS . 0)) (FMTSPEC 40 (FLAGBITS . 16)) (FMTSPEC 42 POINTER))) (QUOTE 44))
-(/DECLAREDATATYPE (QUOTE PENDINGTAB) (QUOTE (POINTER POINTER POINTER POINTER FULLXPOINTER POINTER)) (
-QUOTE ((PENDINGTAB 0 POINTER) (PENDINGTAB 2 POINTER) (PENDINGTAB 4 POINTER) (PENDINGTAB 6 POINTER) (
-PENDINGTAB 8 FULLXPOINTER) (PENDINGTAB 10 POINTER))) (QUOTE 12))
-(TYPERECORD MB.3STATE ((* ;; "Describes a 3-state menu button.") MBLABEL (* ; 
-"Label for the button on the screen") MBFONT (* ; "Font the label text should appear in") 
-MBCHANGESTATEFN (* ; "Function to call when the button's state changes") MBINITSTATE (* ; 
-"Button's initial state.")) MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
-(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) MBBUTTONEVENTFN _ (QUOTE MB.DEFAULTBUTTON.FN) 
-MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
-(TYPERECORD MB.INSERT (MBINITENTRY))
-(TYPERECORD MB.MARGINBAR (ignoredfield))
-(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) MBFONT _ (
-FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
-(TYPERECORD MB.TEXT (MBSTRING MBFONT))
-(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) MBFONT _ (FONTCREATE (QUOTE 
-HELVETICA) 8 (QUOTE BOLD)))
-(DEFMACRO WITHOUT-UPDATES (TEXTOBJ SCRATCHSEL &BODY BODY) (* ;; 
-"For TEdit windows, run BODY without updating the edit window for TEXTOBJ.  This is useful if you're making a log of changes to a document at one time, where the changes are in essence atomic, and you don't need to see intermediate results.  It's also a good bit faster than constant updating."
-) (* ;; "TEXTOBJ is the TEXTOBJ for the document you'll be modifying.") (* ;; 
-"SCRATCHSEL should be the scratch selection (often used in this work)") (BQUOTE (LET ((OLD-UNWIND-FLAG
- (FETCH (TEXTOBJ TXTDON'TUPDATE) OF (\, TEXTOBJ)))) (CL:UNWIND-PROTECT (PROGN (replace (TEXTOBJ 
-TXTDON'TUPDATE) of (\, TEXTOBJ) with T) (\,@ BODY)) (\SHOWSEL (\, SCRATCHSEL) NIL NIL) (replace SET of
- (\, SCRATCHSEL) with NIL) (\TEDIT.MARK.LINES.DIRTY (\, TEXTOBJ) 1 (fetch (TEXTOBJ TEXTLEN) of (\, 
-TEXTOBJ))) (replace (TEXTOBJ TXTDON'TUPDATE) of (\, TEXTOBJ) with OLD-UNWIND-FLAG) (
-TEDIT.UPDATE.SCREEN (\, TEXTOBJ))))))
-(RECORD TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* ; 
-"A LITATOM, specifying what the event was") THPOINT (* ; "Was the selection to the left or right?") 
-THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ; 
-"First piece involved") THOLDINFO (* ; "Old info, for undo") THAUXINFO (* ; 
-"Auxiliary info about the event, primarily for redo") THTEXTOBJ (* ;; 
-"Place to remember a second textobj, for those like MOVE who need to remember both a source and a destination."
-)) THPOINT _ (QUOTE LEFT))
-(/DECLAREDATATYPE (QUOTE TEDITCARET) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-POINTER POINTER POINTER POINTER)) (QUOTE ((TEDITCARET 0 POINTER) (TEDITCARET 2 POINTER) (TEDITCARET 4 
-POINTER) (TEDITCARET 6 POINTER) (TEDITCARET 8 POINTER) (TEDITCARET 10 POINTER) (TEDITCARET 12 POINTER)
- (TEDITCARET 14 POINTER) (TEDITCARET 16 POINTER) (TEDITCARET 18 POINTER) (TEDITCARET 20 POINTER))) (
-QUOTE 22))
-(DATATYPE PCTNODE (CHNUM (* ; "Character #of piece in this node.") PCE (* ; "PIECE ") LO (* ; 
-"Subtree these nodes' ch#are less than this node.") HI (* ; 
-" Subtree these nodes' ch#are more than this node.") BF (* ; "Balance factor.") (* ; 
-"1: Right(HI) Subtree is higher than left(lo) subtree.") (* ; 
-"0: Right subtree and left subtree are same height") (* ; 
-"-1: Right(HI) Subtree is shorter than left(lo) subtree.") RANK (* ; "(# of nodes in left subtree) +1"
-)) CHNUM _ 0 BF _ 0 RANK _ 1)
-(/DECLAREDATATYPE (QUOTE PCTNODE) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((
-PCTNODE 0 POINTER) (PCTNODE 2 POINTER) (PCTNODE 4 POINTER) (PCTNODE 6 POINTER) (PCTNODE 8 POINTER) (
-PCTNODE 10 POINTER))) (QUOTE 12))
-NIL

library/tedit/TEDIT-DEFAULT-USER.CM

@@ -0,0 +1,88 @@
+[CHAT]
+CONNECT: MAXC2
+TYPESCRIPT: Chat.TypeScript 25000
+FONT: Gacha10.al
+BORDER: BLACK
+BELL: FLASH
+
+[EXECUTIVE]
+eventBooted: settime
+eventRFC: FTP // eventRFC
+eventInstall: // eventInstall
+eventAboutToDie: // eventAboutToDie
+eventUnknown: // eventUnknown
+(635)
+[BRAVO]
+B.INIT:"{6,2,0,4}g'@1.bcpl@@G[@1.bcpl]{6,2,0,0}wny1114,y1114,y1114,{6,4,0,4}g'@1.bt@@G[@1.bt]{6,2,0,0}@@E"
+
+C.INIT:"{6,1,0,0}g'line.cm@@G[line.cm]@@E"
+
+F.INIT:"{6,1,0,0}g'form.@1@@G[form.@1]@@E"
+
+H.INIT:"{6,2,0,6}g'@1@@G[@1]{6,2,0,0}hc'@2@@@@'@3
+*q
+@@E"
+
+M.INIT:"{6,1,0,0}g'form.memo@@G[form.memo]@@E"
+
+N.INIT:"{6,1,0,0}g'@1@@G[@1]@@E"
+
+P.INIT:"{6,2,0,4}g'@1@@G[@1]{6,2,0,0}wny1114,y1114,y1114,{6,4,0,4}g'qspell.tx@@G[qspell.tx]{6,2,0,0}@@E"
+
+B.QUIT:"{6,1,0,0}q
+BCPL/F @4;BRAVO/B @4





+"
+
+C.QUIT:"*P'line.cm@@P[line.cm]*q
+@@line.cm@@
+"
+
+p.QUIT:"{6,1,0,0}q
+PROOFREADER @4;BRAVO/P @4
+"
+
+FONT:0 HELVETICA 10 HELVETICA 12 HELVETICA 10
+FONT:1 HELVETICA 8 HELVETICA 10 HELVETICA 8
+FONT:2 LOGO 24 LOGO 24
+FONT:3 MATH 10 MATH 10
+FONT:4 HIPPO 10 HIPPO 10
+FONT:5 TIMESROMAN 12 TIMESROMAN 14 TIMESROMAN 12
+FONT:6 HELVETICA 10 HELVETICA 12 HELVETICA 10
+FONT:7 HELVETICA 8 HELVETICA 10 HELVETICA 8
+FONT:8 GACHA 10 GACHA 12 GACHA 10
+FONT:9 HELVETICA 18 HELVETICA 18
+FONT:D HYTYPE 12 GACHA 12
+
+
+TABS: Standard tab width = 635
+MARGINS: paragraph margin = 2999,Left margin = 2999, right margin = 18591
+UPDOWN: Delta left = 1270, Delta right = 0, Delta paragraph = 0
+LEAD: Line leading = 1, Paragraph leading = 6
+SCREEN: Screen top = 25, System window end = 90, Screen bottom = 780
+OFFSET: Standard offset = 4
+
+[DDS]
+FONT: timesroman10.al
+SMALLFONT: gacha10.al
+CONTEXT: not (*.al or *.run or sys* or *.scratch* or dds* or swat* or bravo.*  or DEFAULT.ED or DiskDescriptor or *.Boot or *.b or FONTS.WIDTHS or MANUAL1.DRAW or com.cm or rem.cm)
+FULLINIT: No
+SELSPEC: *
+SORT BY: name^,extension^
+SHOW: (times),written,length
+
+[HARDCOPY]
+HOST: Maxc
+PRESS: Clover
+PREFERREDFORMAT: Press
+EXTENSION: .bravo
+FONT: Gacha 10 MRR
+COLOR-PRESS: Viola
+
+
+[SIL]
+0: XHELVETICA10B
+1: XHELVETICA8
+2: HELVETICA12
+3: GATES32
+
+\1610v8V