Minor fixes to loadup-lfg and related scripts as result of debugging.

* FILEIO: EOL for input defaults to ANY, EXT-FORMAT can specify EOL

As per technical meeting on 7/15/2024

* Revert "FILEIO: EOL for input defaults to ANY, EXT-FORMAT can specify EOL"

This reverts commit 6a7e8c3665.

* FILEIO:  Fix comment

* Added DETECTEDEOLCONVENTION to STREAM declaration

and recompiled calls to macro \CHECKEOLC.

* COMAPARETEXT:  was trying to set EOL to ANY on a Tedit stream

* LCOMS needing to be recompiled for \CHECKEOLC macro and Create STREAM

(plus a new (unchanged) version of IOCHAR needed to get the cleanup to work for the recompile)

* EXTERNALFORMAT macro and function implement EOL detection

* FILEIO: stream records detected EOL, also RENAMEFILE uses COPYBYTES

UFS doesn't check file devices identity, doesn't give type-change message.  Recompiled for create stream

* ADIR has TRUEDEVICE

* Revert "FILEIO: stream records detected EOL, also RENAMEFILE uses COPYBYTES"

This reverts commit fa97aa6157.

* Revert "EXTERNALFORMAT macro and function implement EOL detection"

This reverts commit eb098615ed.

* Revert "LCOMS needing to be recompiled for \CHECKEOLC macro and Create STREAM"

This reverts commit 5967452c63.

* Revert "Added DETECTEDEOLCONVENTION to STREAM declaration"

This reverts commit 196f105cf5.

* Trying to complete the ANY/EOLC and binary RENAMEFILE issues

* loadup glitch

.github/ISSUE_TEMPLATE/bug_report.md

@@ -3,6 +3,7 @@ name: Bug report (not specific)
 about: Create a report to help us improve
 title: ''
 labels: ''
+assignees: ''
 
 ---
 
@@ -22,11 +23,13 @@ A clear and concise description of what you expected to happen.
 If applicable, add screenshots to help explain your problem.
 
 **Context (please complete the following information):**
- - OS: [e.g. Mac/Linux/Cygwin]
- - OS Version: [e.g. High Siera/Ubuntu 18/Raspbian]
- - Host arch: [e.g. x86_64, arm7l, arm64, sparc]
+ - Are you using online.interlisp.org? [yes / no]
+ - OS: [e.g. macOS/Linux/Cygwin]
+ - OS Version: [e.g. Ventura, Ubuntu 24, Raspberry Pi OS]
+ - Display/window system: [e.g. X11, SDL, VNC, Web browser]
+ - Host arch: [e.g. x86_64, arm7l, arm64, SPARC]
  - Maiko version: [e.g. commit ID from `git log | head`]
- - IL:MAKESYSDATE: [ date ]
+ - `IL:MAKESYSDATE`: [ date ] or `(il:print-lisp-information)`: copy-paste or screenshot this
 
 **Additional context**
 Add any other context about the problem here.

.github/ISSUE_TEMPLATE/documentation.md

@@ -3,6 +3,7 @@ name: Documentation problem
 about: Problems with this web site?
 title: ''
 labels: ''
+assignees: ''
 
 ---
 

.github/ISSUE_TEMPLATE/feature_request.md

@@ -3,6 +3,7 @@ name: Feature request
 about: Suggest an idea for this project
 title: ''
 labels: ''
+assignees: ''
 
 ---
 

.github/workflows/buildDocker.yml

@@ -70,7 +70,7 @@ jobs:
   # based on the latest commit to the repo
 
   sentry:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     outputs:
       release_not_built: ${{ steps.check.outputs.release_not_built }}
 
@@ -99,7 +99,7 @@ jobs:
 
   build_and-push:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     needs: [sentry]
     if: |
@@ -211,7 +211,7 @@ jobs:
 
   complete:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}

.github/workflows/buildLoadup.yml

@@ -66,7 +66,7 @@ jobs:
   # based on the latest commit to the repo
 
   sentry:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     outputs:
       release_not_built: ${{ steps.check.outputs.release_not_built }}
 
@@ -96,7 +96,7 @@ jobs:
 
   loadup:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     outputs:
       combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
@@ -257,7 +257,7 @@ jobs:
   #
   linux_installer:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     needs: [sentry, loadup]
     if: |
@@ -333,7 +333,7 @@ jobs:
   #
   macos_installer:
 
-    runs-on: macos-12
+    runs-on: macos-14
 
     needs: [sentry, loadup]
     if: |
@@ -507,7 +507,7 @@ jobs:
 
   downloads_page:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     needs: [sentry, loadup, linux_installer, macos_installer, cygwin_installer]
     if: |
@@ -606,7 +606,7 @@ jobs:
 
   complete:
 
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
 
     outputs:
       build_successful: ${{ steps.output.outputs.build_successful }}

.github/workflows/buildReleaseInclDocker.yml

@@ -3,6 +3,7 @@
 #
 # Interlisp webflow to build a Medley release and push it to github.
 # And to build a multiplatform Docker image for the release and push it to Docker Hub.
+# And to kickoff a build and deploy workflow for Medley-online within the online repo.
 #
 # This workflow just calls two reuseable workflows to the two task:
 # buildLoadup.yml and buildDocker.yml
@@ -14,12 +15,12 @@
 # ******************************************************************************
 
 
-name: "Build/Push Release & Docker"
+name: "Build/Push Release, Docker, OIO"
 
 # Run this workflow on ...
 on:
   schedule:
-    - cron: '0 9 * * 3'
+    - cron: '17 9 * * 3'
 
   workflow_dispatch:
     inputs:
@@ -68,7 +69,7 @@ jobs:
   # the result of a workflow_dispatch or a workflow_call
 
   inputs:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-24.04
     outputs:
       draft: ${{ steps.one.outputs.draft }}
       force: ${{ steps.one.outputs.force }}
@@ -111,3 +112,26 @@ jobs:
 
 ######################################################################################
 
+  # Run HCFILES and push to files.interlisp.org
+  do_HCFILES:
+    needs: [inputs, do_release]
+    uses: ./.github/workflows/doHCFILES.yml
+    with:
+        draft: ${{ needs.inputs.outputs.draft }}
+    secrets: inherit
+
+######################################################################################
+
+  # Kickoff workflow in online repo to build and deploy Medley docker image to oio
+  do_oio:
+    runs-on: ubuntu-24.04
+    needs: [inputs, do_docker]
+    steps:
+      - name: trigger-oio-buildAndDeploy
+        run: |
+          if [ ! "${{ needs.inputs.outputs.draft }}" = "true" ]
+          then
+            gh workflow run buildAndDeployMedleyDocker.yml --repo Interlisp/online --ref master
+          fi
+        env:
+          GITHUB_TOKEN: ${{ secrets.ONLINE_TOKEN }}

.github/workflows/doHCFILES.yml

@@ -0,0 +1,139 @@
+#*******************************************************************************
+# doHCFILES.yml
+#
+# Interlisp workflow to run HCFILES.  HCFILES prints out PDF files for all of the
+# files in the Medley directory and posts them on files.interlisp.org.
+#  
+# This workflow is designed to be kickjed off by the buildReleaseInclDocker
+# workflow running in the Medley repo, once the release has been completed successfully
+#
+# Copyright 2024 by Interlisp.org
+#
+# ******************************************************************************
+
+name: Run HCFILES
+
+# Run this workflow on ...
+on:
+  workflow_dispatch:
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        type: choice
+        options:
+        - 'false'
+        - 'true'
+
+  workflow_call:
+    inputs:
+      draft:
+        description: "Mark this as a draft release"
+        required: false
+        type: string
+        default: 'false'
+    secrets:
+      OIO_SSH_KEY:
+        required: true
+      MU_TOKEN:
+        required: true
+
+defaults:
+  run:
+    shell: bash
+
+jobs:
+
+  run_HCFILES:
+
+    runs-on: ubuntu-24.04
+
+    steps:
+
+      - name: Checkout Medley repo
+        uses: actions/checkout@v4
+
+      - name: Checkout notecards
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/notecards
+          path: ./notecards
+
+      - name: Checkout loops
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/loops
+          path: ./loops
+
+      - name: Checkout test
+        uses: actions/checkout@v4
+        with:
+          repository: ${{ github.repository_owner }}/test
+          path: ./test
+
+      - name: Cleanup .git for notecards, loops, test
+        run: rm -rf ./notecards/.git ./loops/.git ./test/.git
+
+      - name: Download Maiko
+        run: |
+          gh release download --output /tmp/maiko.tgz \
+                              --repo ${{ github.repository_owner }}/maiko \
+                              --pattern '*-linux.x86_64.tgz'
+          tar -xzf /tmp/maiko.tgz
+        env:
+          GH_TOKEN: ${{ secrets.MU_TOKEN }}
+
+      - name: Install vnc & ghostscript (ps2pdf)
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y tightvncserver
+          sudo apt-get install -y ghostscript
+
+      - name: Build apps.sysout
+        run: |
+          Xvnc -geometry 1280x720 :0 &
+          export DISPLAY=":0"
+          scripts/loadup-all.sh -apps
+
+      - name: Run HCFILES
+        run: |
+          export DISPLAY=":0"
+          scripts/do_hcfiles.sh
+
+      - name: Push Medley files (including created pdf files) to files.interlisp.org
+        run: |
+            # create a tar file of all of the directories to be pushed
+            tarfile=/tmp/source-$$.tgz
+            tar -c -z -f ${tarfile} --exclude=.git .
+            # set up ssh identity
+            eval $(ssh-agent)
+            ssh-add - <<< "${SSH_KEY}"
+            # set destination directory on files.interlisp.org
+            if [ "${{ inputs.draft }}" = "true" ]
+            then
+              dest=/srv/oio/files/development/medley
+            else
+              dest=/srv/oio/files/production/medley
+            fi
+            # Push tar file up to files.interlisp.org
+            batchfile=/tmp/batch-$$
+            echo "-put ${tarfile} ${dest}.tgz" > ${batchfile}
+            sftp -o StrictHostKeyChecking=no -b ${batchfile} ubuntu@files.interlisp.org
+            # now tar is up, untar it and juggle backups
+            scriptfile=/tmp/script-$$
+            # create script file to do the work
+            cat > ${scriptfile} <<EOF
+            rm -rf ${dest}.new
+            mkdir -p ${dest}.new
+            tar -C ${dest}.new -x -z -f ${dest}.tgz
+            rm -f ${dest}.tgz
+            rm -rf ${dest}.oldold
+            if [ -e ${dest}.old ]; then mv ${dest}.old ${dest}.oldold; fi
+            if [ -e ${dest} ]; then mv ${dest} ${dest}.old; fi
+            mv ${dest}.new ${dest}
+            EOF
+            # execute the script file via ssh
+            ssh -aTxo BatchMode=yes ubuntu@files.interlisp.org /bin/sh -s < ${scriptfile}
+        env:
+            SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
+
+

.gitignore

@@ -14,7 +14,10 @@ maiko/
 # because they will get regenerated when you rebuild.
 # MEDLEY-UTILS HCFILES regenerates
 
-*.pdf
+# do not ignore .pdf files after all... rather, [new workflow](scripts/make-gh-pages.md) stores it in the src repository gh-pages branch.
+
+# *.pdf
+# index.html
 
 
 # all loadup files 
@@ -34,6 +37,10 @@ loadups/fuller.database
 
 *.IMPTR
 
+# (Accidentally) created sysouts at any level
+*.sysout
+*.SYSOUT
+
 #compiled code -- leave in for now
 
 # *.lcom

LICENSE

@@ -1,6 +1,6 @@
 MIT License
 
-Copyright Interlisp.org contributors
+Copyright © 2024 Interlisp.org. Portions originally copyrighted by Xerox, Venue, John Sybalsky, and other contributors.
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

doctools/IMTEDIT

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4
 116622 
+
(FILECREATED "12-Apr-2024 19:58:59" {WMEDLEY}<doctools>IMTEDIT.;5
 117369 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TRANSLATE.DUMPOUT MAKE.IM.DOCUMENT)
+      :CHANGES-TO (FNS MAKE.IM.DOCUMENT)
 
-      :PREVIOUS-DATE "20-Jul-2022 15:10:53" {WMEDLEY}<doctools>IMTEDIT.;2)
+      :PREVIOUS-DATE " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4)
 
 
 (PRETTYCOMPRINT IMTEDITCOMS)
@@ -15,16 +15,17 @@
        ((FNS IM.TEDIT DUMP DUMP.HEADERS.FOOTERS DUMP.HRULE CHANGE.FONT IM.BOUT.IMAGEOBJ 
              IM.TEDIT.DUMP.COMMANDS IM.TEDIT.DUMP.FOOTNOTES IM.TEDIT.DUMP.PARA INDEXX.PARSE.TYPE 
              FORMAT.DEF FORMAT.LISPWORD MAKE.IM.DOCUMENT PRINT.NOTE SEND.INFO)
-        (COMS (* fns for drawing vrules to the left of definition text -- an unused, never-fully 
-                 debuged feature)
+        (COMS                                                (* ; 
+
    "fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature")

               (FNS IM.VRULE.DISPLAYFN CREATE.VRULE.OBJECT PRINT.VRULES.ON.PAGE)
               (VARS (IM.VRULE.STATE.LIST))
               (INITVARS (IM.VRULE.OBJECT.IMAGEFNS NIL)
                      (IM.PRINT.VRULE.FLG NIL)))
-        (COMS (* fns for printing page numbers)
+        (COMS                                                (* ; "fns for printing page numbers")

               (FNS IM.FOLIO.DISPLAYFN IM.FOLIO.SIZEFN CREATE.FOLIO.OBJECT GET.FOLIO.STRING)
               (INITVARS (IM.FOLIO.OBJECT.IMAGEFNS NIL)))
-        (COMS (* TOPROG functions, used to define the translating actions of IM text objects.)
+        (COMS                                                (* ; 
+
                       "TOPROG functions, used to define the translating actions of IM text objects.")

               (FNS ARG#TOPROG BIGLISPCODE#TOPROG BRACKET#TOPROG CHAPTER#TOPROG COMMENT#TOPROG 
                    DEF#TOPROG FIGURE#TOPROG FN#TOPROG FNDEF#TOPROG FOOT#TOPROG INCLUDE#TOPROG 
                    INDEX#TOPROG INDEXX#TOPROG IT#TOPROG LBRACKET#TOPROG LISP#TOPROG LISPCODE#TOPROG 
@@ -54,104 +55,112 @@
                (IM.TEXT.FONT '(FAMILY MODERN FACE MRR SIZE 10))
                (IM.HEADER.FOOTER.FONT '(FAMILY MODERN FACE MRR SIZE 8))
                (IM.XEROX.LOGO.FONT '(FAMILY MODERN FACE BRR SIZE 30]
-        (COMS (* the following variables specify all of the lengths used for possitioning IM text, 
-                 headers, etc. on the page. All of these are measured with respect to the page 
-                 *margins* <the region on the page defined by the Tedit margin parameters> or with 
-                 respect to the page *edges* <the edges of the physical page>.)
-              (* Note%: The formatting and printing does not always position the image on the page 
-                 exactly as specified. It will probably be necessary to adjust any variables based on
-                 the page edges until they come out correctly on your printer.)
-              (* indentation of 1st line of definitian header, measured in points from left page 
-                 margin. Also used for indentation of hrule under defn header.)
+        (COMS 
+              (* ;; "the following variables specify all of the lengths used for possitioning IM text, headers, etc.  on the page.  All of these are measured with respect to the page *margins* <the region on the page defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>.")

+
+              
+              (* ;; "Note: The formatting and printing does not always position the image on the page exactly as specified.  It will probably be necessary to adjust any variables based on the page edges until they come out correctly on your printer.")

+
+              
+              (* ;; "indentation of 1st line of definitian header, measured in points from left page margin.  Also used for indentation of hrule under defn header.")

+
               (INITVARS (IM.DEF.TITLE.1STLEFTMARGIN 75))
-              (* indentation of 2nd and other overflow lines of definition header, measured in points
-                 from left page margin.)
+              
+              (* ;; "indentation of 2nd and other overflow lines of definition header, measured in points from left page margin.")

+
               (INITVARS (IM.DEF.TITLE.LEFTMARGIN 204))
-              (* indentation of vertical rule to the left of definition text, measured in points from
-                 left page margin. This is a never-used, never-debugged feature.)
+              
+              (* ;; "indentation of vertical rule to the left of definition text, measured in points from left page margin.  This is a never-used, never-debugged feature.")

+
               (INITVARS (IM.VRULE.X 194))
-              (* y-pos of top-left corner of top text line, measured in points from bottom page edge.
-                 )
+                                                             (* ; 
+
               "y-pos of top-left corner of top text line, measured in points from bottom page edge.")

               (INITVARS (IM.TEXT.TOPMARGIN 738))
-              (* y-pos of bottom-left corner of bottom text line, measured in points from bottom page
-                 edge.)
+                                                             (* ; 
+
         "y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.")

               (INITVARS (IM.TEXT.BOTTOMMARGIN 54))
-              (* x-pos of left edge of text, measured in points from the left page margin.)
+                                                             (* ; 
+
                          "x-pos of left edge of text, measured in points from the left page margin.")

               (INITVARS (IM.TEXT.LEFTMARGIN 204))
-              (* x-pos of right edge of text, measured in points from the left page margin.)
+                                                             (* ; 
+
                         "x-pos of right edge of text, measured in points from the left page margin.")

               (INITVARS (IM.TEXT.RIGHTMARGIN 504))
-              (* X-pos and Y-pos of the lower-left corner of the 
-                 "[This page intentionally left blank]" message printed on blank pages, measured in 
-                 points from the left and bottom page edges.)
+              
+              (* ;; "X-pos and Y-pos of the lower-left corner of the '[This page intentionally left blank]' message printed on blank pages, measured in points from the left and bottom page edges.")

+
               (INITVARS (IM.BLANKPAGE.SPECIALX 258)
                      (IM.BLANKPAGE.SPECIALY 400))
-              (* In the table of contents, indentation of first and second-level subsection headers,
-                 measured in points from the left page margin.)
+              
+              (* ;; "In the table of contents, indentation of first and second-level subsection headers, measured in points from the left page margin.")

+
               (INITVARS (IM.TOC.SUBSEC.ONE.LEFTMARGIN 120)
                      (IM.TOC.SUBSEC.TWO.LEFTMARGIN 216))
-              (* in the index, the indentation of the first line and remaining lines of a top-level 
-                 entry, of a subentry, and of a subsubentry, measured in points from the left page 
-                 margin <for the left column>.)
+              
+              (* ;; "in the index, the indentation of the first line and remaining lines of a top-level entry, of a subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.")

+
               (INITVARS (IM.INDEX.1STLEFTMARGIN 0)
                      (IM.INDEX.LEFTMARGIN 75)
                      (IM.INDEX.SUB.1STLEFTMARGIN 25)
                      (IM.INDEX.SUB.LEFTMARGIN 75)
                      (IM.INDEX.SUBSUB.1STLEFTMARGIN 50)
                      (IM.INDEX.SUBSUB.LEFTMARGIN 75))
-              (* on the title page, the y-pos of the lower-left corner of the first line in the title
-                 <and of the XEROX logo>, measured in points from the bottom page margin. The X-pos 
-                 is always 0 for the XEROX logo, and the normal text indentation for the title.)
+              
+              (* ;; "on the title page, the y-pos of the lower-left corner of the first line in the title <and of the XEROX logo>, measured in points from the bottom page margin.  The X-pos is always 0 for the XEROX logo, and the normal text indentation for the title.")

+
               (INITVARS (IM.TITLEPAGE.TITLE.Y 258))
-              (* on the title page, the y-pos of the lower-left corner of the first line in the 
-                 document number, measured in points from the bottom page margin. The Y-pos is always
-                 the normal text indentation.)
+              
+              (* ;; "on the title page, the y-pos of the lower-left corner of the first line in the document number, measured in points from the bottom page margin.  The Y-pos is always the normal text indentation.")

+
               (INITVARS (IM.TITLEPAGE.DOCNUMBER.Y 45))
-              (* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the 
-                 indentation of the title after the subsec number, measured in points from the left 
-                 page margin. "18" is the tab used if the subsec number is wider than 40 pts.)
+              
+              (* ;; "Tedit tab setting used for subsection heading text.  '(40 . LEFT)' determines the indentation of the title after the subsec number, measured in points from the left page margin.  '18' is the tab used if the subsec number is wider than 40 pts.")

+
               [INITVARS (IM.SUBSEC.TITLE.TABS '(18 (40 . LEFT]
-              (* Tedit tab setting used for chapter titles, headers, and footers to right-justify 
-                 text. "(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, 
-                 measured in points from the left page margin.)
+              
+              (* ;; "Tedit tab setting used for chapter titles, headers, and footers to right-justify text.  '(504 . RIGHT)' specifies a right tab at the right-hand edge of the text, measured in points from the left page margin.")

+
               [INITVARS (IM.RIGHT.MARGIN.TABS '(0 (504 . RIGHT]
-              (* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. 
-                 "(186 . RIGHT)" right-justifies the label on the left of the center space. 
-                 "(204 . LEFT)" starts the first line of the list item with the same indentation as 
-                 normal text. Both measurements are measured in points from the left page margin.)
+              
+              (* ;; "Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists.  '(186 . RIGHT)' right-justifies the label on the left of the center space.  '(204 . LEFT)' starts the first line of the list item with the same indentation as normal text.  Both measurements are measured in points from the left page margin.")

+
               [INITVARS (IM.LABELED.LIST.TABS '(18 (186 . RIGHT)
                                                    (204 . LEFT]
-              (* left, right, top, and bottom margins of the "page region" %, measured in points from
-                 the four edges of the page.)
+              
+              (* ;; "left, right, top, and bottom margins of the 'page region' , measured in points from the four edges of the page.")

+
               (INITVARS (IM.PAGE.LEFTMARGIN 58)
                      (IM.PAGE.RIGHTMARGIN 54)
                      (IM.PAGE.TOPMARGIN 54)
                      (IM.PAGE.BOTTOMMARGIN 54))
-              (* top margin of the page region for the first page of a chapter <where the first 
-                 paragraph is the chapter title>, measured in points from the top page edge.)
+              
+              (* ;; "top margin of the page region for the first page of a chapter <where the first paragraph is the chapter title>, measured in points from the top page edge.")

+
               (INITVARS (IM.PAGE.FIRST.TOPMARGIN 12))
-              (* top margin of the page region for the first page of the index, measured in points 
-                 from the top page edge. Note that in the case of the index, because it uses two 
-                 columns, the index title is implemented as a Tedit header, instead of as the first 
-                 paragraph of the document.)
+              
+              (* ;; "top margin of the page region for the first page of the index, measured in points from the top page edge.  Note that in the case of the index, because it uses two columns, the index title is implemented as a Tedit header, instead of as the first paragraph of the document.")

+
               (INITVARS (IM.INDEX.PAGE.FIRST.TOPMARGIN 144))
-              (* y-pos of lower-left corner of footer text, measured in points from the bottom page 
-                 edge.)
+                                                             (* ; 
+
           "y-pos of lower-left corner of footer text, measured in points from the bottom page edge.")

               (INITVARS (IM.FOOTER.Y 22))
-              (* y-pos of the footer hrule, measured in points from the bottom page edge.)
+                                                             (* ; 
+
                           "y-pos of the footer hrule, measured in points from the bottom page edge.")

               (INITVARS (IM.FOOTER.RULE.Y 30))
-              (* y-pos of lower-left corner of header text, measured in points from the bottom page 
-                 edge.)
+                                                             (* ; 
+
           "y-pos of lower-left corner of header text, measured in points from the bottom page edge.")

               (INITVARS (IM.HEADER.Y 761))
-              (* y-pos of the header hrule, measured in points from the bottom page edge.)
+                                                             (* ; 
+
                           "y-pos of the header hrule, measured in points from the bottom page edge.")

               (INITVARS (IM.HEADER.RULE.Y 757))
-              (* y-pos of lower-left corner of bottom draft message, measured in points from the 
-                 bottom page edge.)
+                                                             (* ; 
+
  "y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.")

               (INITVARS (IM.DRAFT.MESSAGE.BOTTOM.Y 5))
-              (* y-pos of lower-left corner of top draft message, measured in points from the bottom
-                 page edge.)
+                                                             (* ; 
+
     "y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.")

               (INITVARS (IM.DRAFT.MESSAGE.TOP.Y 775))
-              (* x-pos of lower-left corner of both top and bottom draft messages, measured in points
-                 from the left page edge.)
+              
+              (* ;; "x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left page edge.")

+
               (INITVARS (IM.DRAFT.MESSAGE.X 200)))
         (FILES TEDIT IMTRAN HRULE IMINDEX)
         (FNS TRANSLATE.DUMPOUT TRANSLATE.SAVE.DUMPOUT)
@@ -491,6 +500,8 @@
 (MAKE.IM.DOCUMENT

   [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
 
+    (* ;; "Edited 12-Apr-2024 19:58 by rmk")

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

@@ -506,9 +517,7 @@
 
 (* ;;; "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 `(IM.INDEX.PTRFILENAME ,PTRFILENAME 
-                                                               AFTERHARDCOPYFN (FUNCTION 
-                                                                                IM.INDEX.INIT]
+    (PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME]
            (FONT.STACK (CONS))
            (IM.TEDIT.LAST.PARA.BEGIN 1)
            (IM.TEDIT.LAST.FONT.BEGIN 1)
@@ -650,7 +659,8 @@
 
 
 
-(* fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature)

+(* ; "fns for drawing vrules to the left of definition text -- an unused, never-fully debuged feature"
+)

 
 (DEFINEQ
 
@@ -735,7 +745,7 @@
 
 
 
-(* fns for printing page numbers)

+(* ; "fns for printing page numbers")

 
 (DEFINEQ
 
@@ -831,7 +841,7 @@
 
 
 
-(* TOPROG functions, used to define the translating actions of IM text objects.)

+(* ; "TOPROG functions, used to define the translating actions of IM text objects.")

 
 (DEFINEQ
 
@@ -2062,75 +2072,78 @@
 
 
 
-(* the following variables specify all of the lengths used for possitioning IM text, headers, etc. on 
-the page. All of these are measured with respect to the page *margins* <the region on the page defined
- by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>.
+(* ;; 
+"the following variables specify all of the lengths used for possitioning IM text, headers, etc.  on the page.  All of these are measured with respect to the page *margins* <the region on the page defined by the Tedit margin parameters> or with respect to the page *edges* <the edges of the physical page>."
 )

 
 
 
 
-(* Note%: The formatting and printing does not always position the image on the page exactly as 
-specified. It will probably be necessary to adjust any variables based on the page edges until they 
-come out correctly on your printer.)

+(* ;; 
+"Note: The formatting and printing does not always position the image on the page exactly as specified.  It will probably be necessary to adjust any variables based on the page edges until they come out correctly on your printer."
+)

 
 
 
 
-(* indentation of 1st line of definitian header, measured in points from left page margin. Also used 
-for indentation of hrule under defn header.)

+(* ;; 
+"indentation of 1st line of definitian header, measured in points from left page margin.  Also used for indentation of hrule under defn header."
+)

 
 
 (RPAQ? IM.DEF.TITLE.1STLEFTMARGIN
 75)
 
 
 
-(* indentation of 2nd and other overflow lines of definition header, measured in points from left page
- margin.)

+(* ;; 
+"indentation of 2nd and other overflow lines of definition header, measured in points from left page margin."
+)

 
 
 (RPAQ? IM.DEF.TITLE.LEFTMARGIN
 204)
 
 
 
-(* indentation of vertical rule to the left of definition text, measured in points from left page 
-margin. This is a never-used, never-debugged feature.)

+(* ;; 
+"indentation of vertical rule to the left of definition text, measured in points from left page margin.  This is a never-used, never-debugged feature."
+)

 
 
 (RPAQ? IM.VRULE.X
 194)
 
 
 
-(* y-pos of top-left corner of top text line, measured in points from bottom page edge.)

+(* ; "y-pos of top-left corner of top text line, measured in points from bottom page edge.")

 
 
 (RPAQ? IM.TEXT.TOPMARGIN
 738)
 
 
 
-(* y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.)

+(* ; "y-pos of bottom-left corner of bottom text line, measured in points from bottom page edge.")

 
 
 (RPAQ? IM.TEXT.BOTTOMMARGIN
 54)
 
 
 
-(* x-pos of left edge of text, measured in points from the left page margin.)

+(* ; "x-pos of left edge of text, measured in points from the left page margin.")

 
 
 (RPAQ? IM.TEXT.LEFTMARGIN
 204)
 
 
 
-(* x-pos of right edge of text, measured in points from the left page margin.)

+(* ; "x-pos of right edge of text, measured in points from the left page margin.")

 
 
 (RPAQ? IM.TEXT.RIGHTMARGIN
 504)
 
 
 
-(* X-pos and Y-pos of the lower-left corner of the "[This page intentionally left blank]" message 
-printed on blank pages, measured in points from the left and bottom page edges.)

+(* ;; 
+"X-pos and Y-pos of the lower-left corner of the '[This page intentionally left blank]' message printed on blank pages, measured in points from the left and bottom page edges."
+)

 
 
 (RPAQ? IM.BLANKPAGE.SPECIALX
 258)
@@ -2139,8 +2152,9 @@ printed on blank pages, measured in points from the left and bottom page edges.)
 
 
 
-(* In the table of contents, indentation of first and second-level subsection headers, measured in 
-points from the left page margin.)

+(* ;; 
+"In the table of contents, indentation of first and second-level subsection headers, measured in points from the left page margin."
+)

 
 
 (RPAQ? IM.TOC.SUBSEC.ONE.LEFTMARGIN
 120)
@@ -2149,8 +2163,9 @@ points from the left page margin.)

 
 
 
-(* in the index, the indentation of the first line and remaining lines of a top-level entry, of a 
-subentry, and of a subsubentry, measured in points from the left page margin <for the left column>.)

+(* ;; 
+"in the index, the indentation of the first line and remaining lines of a top-level entry, of a subentry, and of a subsubentry, measured in points from the left page margin <for the left column>."
+)

 
 
 (RPAQ? IM.INDEX.1STLEFTMARGIN
 0)
@@ -2167,45 +2182,45 @@ subentry, and of a subsubentry, measured in points from the left page margin <fo
 
 
 
-(* on the title page, the y-pos of the lower-left corner of the first line in the title <and of the 
-XEROX logo>, measured in points from the bottom page margin. The X-pos is always 0 for the XEROX logo,
- and the normal text indentation for the title.)

+(* ;; 
+"on the title page, the y-pos of the lower-left corner of the first line in the title <and of the XEROX logo>, measured in points from the bottom page margin.  The X-pos is always 0 for the XEROX logo, and the normal text indentation for the title."
+)

 
 
 (RPAQ? IM.TITLEPAGE.TITLE.Y
 258)
 
 
 
-(* on the title page, the y-pos of the lower-left corner of the first line in the document number, 
-measured in points from the bottom page margin. The Y-pos is always the normal text indentation.)

+(* ;; 
+"on the title page, the y-pos of the lower-left corner of the first line in the document number, measured in points from the bottom page margin.  The Y-pos is always the normal text indentation."
+)

 
 
 (RPAQ? IM.TITLEPAGE.DOCNUMBER.Y
 45)
 
 
 
-(* Tedit tab setting used for subsection heading text. "(40 . LEFT)" determines the indentation of the
- title after the subsec number, measured in points from the left page margin. "18" is the tab used if 
-the subsec number is wider than 40 pts.)

+(* ;; 
+"Tedit tab setting used for subsection heading text.  '(40 . LEFT)' determines the indentation of the title after the subsec number, measured in points from the left page margin.  '18' is the tab used if the subsec number is wider than 40 pts."
+)

 
 
 (RPAQ? IM.SUBSEC.TITLE.TABS
 '(18 (40 . LEFT)))
 
 
 
-(* Tedit tab setting used for chapter titles, headers, and footers to right-justify text. 
-"(504 . RIGHT)" specifies a right tab at the right-hand edge of the text, measured in points from the 
-left page margin.)

+(* ;; 
+"Tedit tab setting used for chapter titles, headers, and footers to right-justify text.  '(504 . RIGHT)' specifies a right tab at the right-hand edge of the text, measured in points from the left page margin."
+)

 
 
 (RPAQ? IM.RIGHT.MARGIN.TABS
 '(0 (504 . RIGHT)))
 
 
 
-(* Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists. "(186 . RIGHT)" 
-right-justifies the label on the left of the center space. "(204 . LEFT)" starts the first line of the
- list item with the same indentation as normal text. Both measurements are measured in points from the
- left page margin.)

+(* ;; 
+"Tedit tab setting used for labeled lists, numbered lists, bullet-ed lists.  '(186 . RIGHT)' right-justifies the label on the left of the center space.  '(204 . LEFT)' starts the first line of the list item with the same indentation as normal text.  Both measurements are measured in points from the left page margin."
+)

 
 
 (RPAQ? IM.LABELED.LIST.TABS
 '(18 (186 . RIGHT)
@@ -2213,8 +2228,9 @@ right-justifies the label on the left of the center space. "(204 . LEFT)" starts
 
 
 
-(* left, right, top, and bottom margins of the "page region" %, measured in points from the four edges
- of the page.)

+(* ;; 
+"left, right, top, and bottom margins of the 'page region' , measured in points from the four edges of the page."
+)

 
 
 (RPAQ? IM.PAGE.LEFTMARGIN
 58)
@@ -2227,67 +2243,70 @@ right-justifies the label on the left of the center space. "(204 . LEFT)" starts
 
 
 
-(* top margin of the page region for the first page of a chapter <where the first paragraph is the 
-chapter title>, measured in points from the top page edge.)

+(* ;; 
+"top margin of the page region for the first page of a chapter <where the first paragraph is the chapter title>, measured in points from the top page edge."
+)

 
 
 (RPAQ? IM.PAGE.FIRST.TOPMARGIN
 12)
 
 
 
-(* top margin of the page region for the first page of the index, measured in points from the top page
- edge. Note that in the case of the index, because it uses two columns, the index title is implemented
- as a Tedit header, instead of as the first paragraph of the document.)

+(* ;; 
+"top margin of the page region for the first page of the index, measured in points from the top page edge.  Note that in the case of the index, because it uses two columns, the index title is implemented as a Tedit header, instead of as the first paragraph of the document."
+)

 
 
 (RPAQ? IM.INDEX.PAGE.FIRST.TOPMARGIN
 144)
 
 
 
-(* y-pos of lower-left corner of footer text, measured in points from the bottom page edge.)

+(* ; "y-pos of lower-left corner of footer text, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.FOOTER.Y
 22)
 
 
 
-(* y-pos of the footer hrule, measured in points from the bottom page edge.)

+(* ; "y-pos of the footer hrule, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.FOOTER.RULE.Y
 30)
 
 
 
-(* y-pos of lower-left corner of header text, measured in points from the bottom page edge.)

+(* ; "y-pos of lower-left corner of header text, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.HEADER.Y
 761)
 
 
 
-(* y-pos of the header hrule, measured in points from the bottom page edge.)

+(* ; "y-pos of the header hrule, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.HEADER.RULE.Y
 757)
 
 
 
-(* y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.)

+(* ; 
+"y-pos of lower-left corner of bottom draft message, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.DRAFT.MESSAGE.BOTTOM.Y
 5)
 
 
 
-(* y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.)

+(* ; "y-pos of lower-left corner of top draft message, measured in points from the bottom page edge.")

 
 
 (RPAQ? IM.DRAFT.MESSAGE.TOP.Y
 775)
 
 
 
-(* x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left 
-page edge.)

+(* ;; 
+"x-pos of lower-left corner of both top and bottom draft messages, measured in points from the left page edge."
+)

 
 
 (RPAQ? IM.DRAFT.MESSAGE.X
 200)
@@ -2388,23 +2407,23 @@ page edge.)

 (PUTPROPS SAVE.DUMPOUT
 MACRO
 (X (TRANSLATE.SAVE.DUMPOUT
 X)))
 )
 (DECLARE%: DONTCOPY
-  (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)))))
+  (FILEMAP (NIL (11391 38703 (IM.TEDIT 11401 . 13082) (DUMP 13084 . 15379) (DUMP.HEADERS.FOOTERS 15381
+ . 17747) (DUMP.HRULE 17749 . 18900) (CHANGE.FONT 18902 . 20096) (IM.BOUT.IMAGEOBJ 20098 . 20421) (
+IM.TEDIT.DUMP.COMMANDS 20423 . 23976) (IM.TEDIT.DUMP.FOOTNOTES 23978 . 24419) (IM.TEDIT.DUMP.PARA 
+24421 . 25195) (INDEXX.PARSE.TYPE 25197 . 26492) (FORMAT.DEF 26494 . 28625) (FORMAT.LISPWORD 28627 . 
+28778) (MAKE.IM.DOCUMENT 28780 . 37558) (PRINT.NOTE 37560 . 37774) (SEND.INFO 37776 . 38701)) (38817 
+42835 (IM.VRULE.DISPLAYFN 38827 . 39151) (CREATE.VRULE.OBJECT 39153 . 40933) (PRINT.VRULES.ON.PAGE 
+40935 . 42833)) (42997 47752 (IM.FOLIO.DISPLAYFN 43007 . 43685) (IM.FOLIO.SIZEFN 43687 . 44536) (
+CREATE.FOLIO.OBJECT 44538 . 46084) (GET.FOLIO.STRING 46086 . 47750)) (47888 94128 (ARG#TOPROG 47898 . 
+48037) (BIGLISPCODE#TOPROG 48039 . 49275) (BRACKET#TOPROG 49277 . 49441) (CHAPTER#TOPROG 49443 . 52124
+) (COMMENT#TOPROG 52126 . 52678) (DEF#TOPROG 52680 . 56015) (FIGURE#TOPROG 56017 . 57361) (FN#TOPROG 
+57363 . 57760) (FNDEF#TOPROG 57762 . 61654) (FOOT#TOPROG 61656 . 62197) (INCLUDE#TOPROG 62199 . 62514)
+ (INDEX#TOPROG 62516 . 63606) (INDEXX#TOPROG 63608 . 65689) (IT#TOPROG 65691 . 65832) (LBRACKET#TOPROG
+ 65834 . 65988) (LISP#TOPROG 65990 . 66131) (LISPCODE#TOPROG 66133 . 67252) (LISPWORD#TOPROG 67254 . 
+67994) (LIST#TOPROG 67996 . 72418) (MACDEF#TOPROG 72420 . 73598) (NOTE#TOPROG 73600 . 74280) (
+PRINT.SPECIAL.CHARS#TOPROG 74282 . 75259) (PROPDEF#TOPROG 75261 . 75538) (RBRACKET#TOPROG 75540 . 
+75694) (REF#TOPROG 75696 . 83535) (RM#TOPROG 83537 . 83675) (SUB#TOPROG 83677 . 83825) (SUBSEC#TOPROG 
+83827 . 88330) (SUPER#TOPROG 88332 . 88486) (TABLE#TOPROG 88488 . 92440) (TAG#TOPROG 92442 . 92709) (
+TERM#TOPROG 92711 . 93024) (VAR#TOPROG 93026 . 93429) (VARDEF#TOPROG 93431 . 94126)) (111920 116862 (
+TRANSLATE.DUMPOUT 111930 . 116461) (TRANSLATE.SAVE.DUMPOUT 116463 . 116860)))))
 STOP

installers/cygwin/.gitignore

@@ -4,3 +4,4 @@ maiko*.tgz
 setup-x86_64.exe
 medley.bat
 
+

installers/cygwin/medley.iss

@@ -9,7 +9,6 @@
 ;#
 ;###############################################################################
 
-#define x86_or_x64 "x64"
 #if GetEnv('COMBINED_RELEASE_TAG') != ""
 #define VERSION=GetEnv('COMBINED_RELEASE_TAG')
 #else
@@ -24,20 +23,17 @@
 
 [Setup]
 PrivilegesRequired=lowest
-ArchitecturesAllowed={#x86_or_x64}
+ArchitecturesAllowed=x64compatible
+ArchitecturesInstallIn64BitMode=x64compatible
 AppName=Medley
 AppVersion={#version}
 AppPublisher=Interlisp.org
 AppPublisherURL=https://interlisp.org/
-AppCopyright=Copyright (C) 2023 Interlisp.org
-DefaultDirName={%USERPROFILE}\il
+AppCopyright=Copyright (C) 2023-2024 Interlisp.org
+DefaultDirName="{%USERPROFILE}\il"
 DefaultGroupName=Medley
 Compression=lzma2
 SolidCompression=yes
-; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
-; done in "64-bit mode" on x64, meaning it should use the native
-; 64-bit Program Files directory and the 64-bit view of the registry.
-ArchitecturesInstallIn64BitMode=x64
 OutputDir="."
 OutputBaseFilename={#OUTFILE}
 SetupIconFile="Medley.ico"
@@ -48,7 +44,7 @@ WizardImageFile=medley_logo.bmp
 WizardSmallImageFile=medley_logo_small.bmp
 WizardImageStretch=no
 UninstallDisplayIcon="{app}\Medley.ico"
-UninstallFilesDir={app}\uninstall
+UninstallFilesDir="{app}\uninstall"
 UsePreviousAppDir=no
 
 [Dirs]
@@ -68,18 +64,21 @@ Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
 ; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
 
 [Run]
-Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
+Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root ""{app}"" --site https://mirrors.kernel.org/sourceware/cygwin --only-site --local-package-dir ""{app}\cygwin"" --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..."
 Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden
-Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\medley.tgz"; Flags: runhidden; StatusMsg: "Installing Medley ..."
-Filename: "powershell"; Parameters: "remove-item -force -recurse {app}\maiko"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
-Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\maiko-cygwin.x86_64.tgz"; Flags: runhidden; StatusMsg: "Installing Maiko ..."
+Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\medley.tgz"""; Flags: runhidden; StatusMsg: "Installing Medley ..."
+Filename: "powershell"; Parameters: "remove-item -force -recurse ""{app}\maiko"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
+Filename: "tar"; Parameters: "-x -z -C ""{app}"" -f ""{app}\install\maiko-cygwin.x86_64.tgz"""; Flags: runhidden; StatusMsg: "Installing Maiko ..."
 ; Recreate medley symbolic links (lost in tars)
 Filename: "{app}\bin\bash"; Parameters: "-login -c 'cd /medley/scripts/medley && ln -s medley.command medley.sh && cd ../.. && ln -s /medley/scripts/medley/medley.sh medley'"; Flags: runhidden
 ; Create medley.bat
-Filename: "powershell"; Parameters: "write-output \""{app}\bin\bash -login -c '/medley/scripts/medley/medley.sh %*'\""  | out-file medley.bat -Encoding ascii"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
-Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden; StatusMsg: "Adding to PATH ..."
-Filename: "powershell"; Parameters: "remove-item -recurse -force {app}\install"; Flags: runhidden; StatusMsg: "Cleaning up ..."
+Filename: "powershell"; Parameters: "write-output '""""""""{app}\bin\bash"""""""" -login -c """"""""/medley/scripts/medley/medley.sh %*""""""""'  | out-file medley.bat -Encoding ascii -NoNewline"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..."
+Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add ""{app}"""; Flags: runhidden; StatusMsg: "Adding to PATH ..."
+Filename: "powershell"; Parameters: "remove-item -recurse -force """"""""{app}\install"""""""""; Flags: runhidden; StatusMsg: "Cleaning up ..."
+
+[UninstallDelete]
+Type: filesandordirs; Name: "{app}"
 
 [UninstallRun]
-Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden 
+Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove ""{app}"""; Flags: runhidden 
 

installers/cygwin/prep-for-local-testing.ps1

@@ -0,0 +1,9 @@
+#
+#  Prep the installer/cygwin directory to locally test the medley.iss installer
+#  Normally these downloads are done by the github workflow
+#
+#  fgh 2024-11-15
+#
+wget https://cygwin.com/setup-x86_64.exe -OutFile setup-x86_64.exe
+gh release download --repo interlisp/maiko --pattern *-cygwin.x86_64.tgz --output maiko-cygwin.x86_64.tgz --clobber
+gh release download --repo interlisp/medley --pattern medley-full-linux-x86_64-*.tgz --output medley.tgz --clobber

internal/MEDLEY-UTILS

@@ -1,10 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Apr-2024 16:25:20" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;9
 28903  
+
(FILECREATED "14-Jul-2024 12:51:12" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;16
 30093  
 
-      :EDIT-BY "lmm"
+      :CHANGES-TO (FNS MAKE-INDEX-HTMLS)
 
-      :PREVIOUS-DATE "26-Apr-2024 16:34:08" {DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;8)
+      :PREVIOUS-DATE "13-Jul-2024 23:39:43" {DSK}<home>frank>il>medley>internal>MEDLEY-UTILS.;14)
 
 
 (PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -124,13 +124,16 @@
            "Welcome to Fuller sysout"])
 
 (MAKE-INDEX-HTMLS

-  [LAMBDA (BASE TOP)
                                         (* ; "Edited 29-Apr-2024 14:18 by lmm")


+  [LAMBDA (BASE TOP LEVEL)
                                   (* ; "Edited 29-Apr-2024 14:18 by lmm")


                                                              (* ; "Edited 26-Apr-2024 16:15 by lmm")


                                                              (* ; "Edited 20-Apr-2024 12:34 by lmm")


                                                              (* ; "Edited 13-Apr-2024 21:18 by lmm")

     [OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
     (OR (DIRECTORYNAMEP BASE)
         (ERROR BASE "not a directory name"))
+    (OR (AND (NUMBERP LEVEL)
+             (IGREATERP LEVEL 0))
+        (SETQ LEVEL 1))
     (LET* ((SUBDIRS NIL)
            (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
            (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
@@ -138,9 +141,20 @@
            SLASHED SHORTNAME)
           (CL:WITH-OPEN-FILE
            (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
-           (CL:FORMAT S "<HTML><HEAD><TITLE>Index page for ~a</TITLE></HEAD>~%%" (SETQ SLASHED
-                                                                                  (SLASHIT BASE)))
+           (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
+           (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
+           (CL:FORMAT S "<SCRIPT>~%%")
+           (CL:FORMAT S "    function up_onclick(){~%%")
+           (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
+           (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
+           (CL:FORMAT S "     }~%%")
+           (CL:FORMAT S "</SCRIPT>~%%")
+           (CL:FORMAT S "</HEAD>~%%")
            (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
+           (CL:UNLESS (EQ LEVEL 1)
+                  (CL:FORMAT S 
+      "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
+                         ))
            (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
            (FOR
 FULLNAME IN
 (DIRECTORY (CONCAT BASE "*.*;"))
               DO
 (IF
 (EQ (NTHCHAR FULLNAME -1)
@@ -181,7 +195,8 @@
 
                    ELSE
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
            (CL:FORMAT S "</UL></BODY></HTML>~%%"))
-          (NCONC SUBDIRS (FOR
 D IN
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE])
+          (NCONC SUBDIRS (FOR
 D IN
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
+                                                       (ADD1 LEVEL])
 
 (MEDLEY-FIX-LINKS

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

@@ -258,7 +273,8 @@
 (DEFINEQ
 
 (HCFILES

-  [LAMBDA (BASE REDO SUBSETS)
                                (* ; "Edited 23-Apr-2024 23:15 by lmm")


+  [LAMBDA (BASE REDO SUBSETS)
                                (* ; "Edited 30-Jun-2024 08:27 by lmm")


+                                                             (* ; "Edited 23-Apr-2024 23:15 by lmm")


                                                              (* ; "Edited 22-Apr-2024 13:22 by lmm")


                                                              (* ; "Edited  5-Feb-2024 12:16 by lmm")


                                                              (* ; "Edited  4-Nov-2023 11:14 by lmm")


@@ -302,12 +318,7 @@
                (* ;; 
 
               " doesnt (yet) implement  / to - translattion. .readme should show up as -.readme.")

 
-                     (SETQ DEST (PACKFILENAME 'EXTENSION 'pdf 'NAME
-                                       (IF
 EXT
-                                           THEN
 (LISTGET SRC 'NAME)
-                                         ELSE
 (PACK* (LISTGET SRC 'NAME)
-                                                     '-src))
-                                       'BODY NOV))
+                     (SETQ DEST (CONCAT NOV ".pdf"))
                      (CL:WHEN (AND (NOT REDO)
                                    (INFILEP DEST))
                          (CL:FORMAT T "~a already there~%%" DEST)
@@ -338,13 +349,16 @@
                          (PRINTOUT T "DONE" T))])
 
 (MAKE-INDEX-HTMLS

-  [LAMBDA (BASE TOP)
                                         (* ; "Edited 29-Apr-2024 14:18 by lmm")


+  [LAMBDA (BASE TOP LEVEL)
                                   (* ; "Edited 29-Apr-2024 14:18 by lmm")


                                                              (* ; "Edited 26-Apr-2024 16:15 by lmm")


                                                              (* ; "Edited 20-Apr-2024 12:34 by lmm")


                                                              (* ; "Edited 13-Apr-2024 21:18 by lmm")

     [OR BASE (SETQ BASE (PSEUDOFILENAME (MEDLEYDIR]
     (OR (DIRECTORYNAMEP BASE)
         (ERROR BASE "not a directory name"))
+    (OR (AND (NUMBERP LEVEL)
+             (IGREATERP LEVEL 0))
+        (SETQ LEVEL 1))
     (LET* ((SUBDIRS NIL)
            (DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
            (PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
@@ -352,9 +366,20 @@
            SLASHED SHORTNAME)
           (CL:WITH-OPEN-FILE
            (S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
-           (CL:FORMAT S "<HTML><HEAD><TITLE>Index page for ~a</TITLE></HEAD>~%%" (SETQ SLASHED
-                                                                                  (SLASHIT BASE)))
+           (CL:FORMAT S "<HTML>~%%<HEAD>~%%")
+           (CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
+           (CL:FORMAT S "<SCRIPT>~%%")
+           (CL:FORMAT S "    function up_onclick(){~%%")
+           (CL:FORMAT S "        var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
+           (CL:FORMAT S "        location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
+           (CL:FORMAT S "     }~%%")
+           (CL:FORMAT S "</SCRIPT>~%%")
+           (CL:FORMAT S "</HEAD>~%%")
            (CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
+           (CL:UNLESS (EQ LEVEL 1)
+                  (CL:FORMAT S 
+      "<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
+                         ))
            (CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
            (FOR
 FULLNAME IN
 (DIRECTORY (CONCAT BASE "*.*;"))
               DO
 (IF
 (EQ (NTHCHAR FULLNAME -1)
@@ -395,7 +420,8 @@
 
                    ELSE
 (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
            (CL:FORMAT S "</UL></BODY></HTML>~%%"))
-          (NCONC SUBDIRS (FOR
 D IN
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE])
+          (NCONC SUBDIRS (FOR
 D IN
 SUBDIRS join
 (MAKE-INDEX-HTMLS
 D (OR TOP BASE)
+                                                       (ADD1 LEVEL])
 )
 
 (PUTPROPS MEDLEY-UTILS
 FILETYPE
 :COMPILE-FILE)
@@ -502,9 +528,9 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1064 11630 (GATHER-INFO 1074 . 6456) (MAKE-FULLER-DB 6458 . 7235) (MAKE-INDEX-HTMLS 
-7237 . 10999) (MEDLEY-FIX-LINKS 11001 . 11394) (MEDLEY-FIX-DATES 11396 . 11628)) (12809 15597 (
-MAKE-EXPORTS-ALL 12819 . 13878) (MAKE-WHEREIS-HASH 13880 . 15069) (MAKE-WHEREIS-LOOPS 15071 . 15595)) 
-(15598 23855 (HCFILES 15608 . 20089) (MAKE-INDEX-HTMLS 20091 . 23853)) (24105 28717 (RECOMPILE-ONE 
-24115 . 26012) (RECMPL 26014 . 26617) (COMPILE-SETUP 26619 . 27243) (REMAKEFILES 27245 . 28715)))))
+  (FILEMAP (NIL (1086 12345 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7257) (MAKE-INDEX-HTMLS 
+7259 . 11714) (MEDLEY-FIX-LINKS 11716 . 12109) (MEDLEY-FIX-DATES 12111 . 12343)) (13524 16312 (
+MAKE-EXPORTS-ALL 13534 . 14593) (MAKE-WHEREIS-HASH 14595 . 15784) (MAKE-WHEREIS-LOOPS 15786 . 16310)) 
+(16313 25045 (HCFILES 16323 . 20586) (MAKE-INDEX-HTMLS 20588 . 25043)) (25295 29907 (RECOMPILE-ONE 
+25305 . 27202) (RECMPL 27204 . 27807) (COMPILE-SETUP 27809 . 28433) (REMAKEFILES 28435 . 29905)))))
 STOP

library/IMAGEOBJ

@@ -1,137 +1,69 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Dec-95 13:21:56" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1
 35602  
+
(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3
 34260  
 
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS GET.OBJ.FROM.USER)
 
-      changes to%:  (FNS BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN)
-
-
-
-      previous date%: " 6-Dec-95 15:18:32" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1)
-
-
-
-
-
-(* ; "
-
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation.  All rights reserved.
-
-")
-
+      :PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
 
 
 (PRETTYCOMPRINT IMAGEOBJCOMS)
 
-
-
 (RPAQQ IMAGEOBJCOMS

-
        ((COMS 
-
-              (* ;; "Bit-map image objects")

-
-
+              (* ;; "Bit-map image objects")

 
               (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
-
                    )
-
               
-
-              (* ;; "fns for the bitmap tedit object.")

-
-
+              (* ;; "fns for the bitmap tedit object.")

 
               (FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN BMOBJ.PUTFN 
-
                    BMOBJ.INIT BMOBJ.GETFN5 BMOBJ.CREATE.MENU)
-
               (INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700))
-
                      (*SMALLSCREENFACTOR* 0.5))
-
               (FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2 BMOBJ.GETFN3 BMOBJ.GETFN4)
-
-                                                             (* ; 
-
-
                                            "GETFNs for backward compatibility with older objects.")

-
+                                                             (* ; 
+
                                              "GETFNs for backward compatibility with older objects.")

               (RECORDS BITMAPOBJ)
-
               [INITVARS (DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1]
-
               
-
-              (* ;; "make ^O be a character that inserts an object read from the user.")

-
-
+              (* ;; "make ^O be a character that inserts an object read from the user.")

 
               (GLOBALVARS (BITMAP.OBJ.MENU))
-
               (ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
-
                                                          
-
                                                        "prompts for an area of the screen to insert."
-
                                                          )
-
                               ("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
-
                                      
-
                                   "prompts for an area of the screen to insert, scaled down by 50%%."
-
                                      )
-
                               ("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
-
                                      
-
                    "prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50."
-
                                      )
-
                               ("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
-
                                      "Inserts *INSERT-BITMAP* in a document"))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN2))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN3))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN4))
-
                      (IMAGEOBJGETFNS (BMOBJ.GETFN5))
-
                      (IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)))
-
               (VARS (BackgroundCopyMenu))
-
               (FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED)
-
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT)))
-
               (FILES EDITBITMAP))))
 
 
 
-
-
-
-
 (* ;; "Bit-map image objects")

 
-
-
 (DEFINEQ
 
-
-
 (BITMAPTEDITOBJ

   [LAMBDA (BITMAP SCALEFACTOR ROTATION DESCENT)
          (* ; "Edited 13-Aug-93 17:17 by rmk:")

                                                              (* ; "Edited  6-Jan-89 16:34 by jds")

@@ -146,8 +78,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                            BMOBJDESCENT _ (OR DESCENT 0))
            BITMAPIMAGEFNS])
 
-
-
 (COERCETOBITMAP

   [LAMBDA (BMSPEC)
                                      (* ; "Edited 11-Jun-90 16:28 by mitani")

                                                              (* tries to interpret X as a spec 
@@ -182,16 +112,12 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                              (fetch
 (REGION HEIGHT) of
 CR))
                       BM])
 
-
-
 (WINDOWTITLEFONT

   (LAMBDA (FONT)
                                             (* rrb " 1-Feb-84 15:26")

                                                              (* reset type of function that changes 
 
                                                             the title font)

     (DSPFONT FONT WindowTitleDisplayStream)))
 
-
-
 (\PRINTBINARYBITMAP

   (LAMBDA (BITMAP STREAM)
                                    (* rrb "23-Jul-84 15:16")

           
@@ -211,8 +137,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                         BMH BYTESPERWORD))
           (RETURN BITMAP))))
 
-
-
 (\READBINARYBITMAP

   (LAMBDA (STREAM)
                                           (* rrb "23-Jul-84 15:17")

           
@@ -229,23 +153,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                  (ITIMES (fetch
 (BITMAP BITMAPRASTERWIDTH) of
 BITMAP)
                         BMH BYTESPERWORD))
           (RETURN BITMAP))))
-
 )
 
 
 
-
-
-
-
 (* ;; "fns for the bitmap tedit object.")

 
-
-
 (DEFINEQ
 
-
-
 (BMOBJ.BUTTONEVENTINFN

   [LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)

                                                              (* ; "Edited 14-Aug-93 19:44 by rmk:")

@@ -315,8 +230,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
                             "And clear any cached shrunk bitmaps so the display looks reasonable.")

            (RETURN 'CHANGED])
 
-
-
 (BMOBJ.COPYFN

   [LAMBDA (IMAGEOBJ)
                                     (* ; "Edited 13-Aug-93 17:13 by rmk:")

                                                              (* ; "Edited  6-Jan-89 16:19 by jds")

@@ -329,8 +242,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                 (FETCH
 (BITMAPOBJ BMOBJROTATION) OF
 BMOBJ)
                 (FETCH
 (BITMAPOBJ BMOBJDESCENT) OF
 BMOBJ])
 
-
-
 (BMOBJ.DISPLAYFN

 
   [LAMBDA (IMAGEOBJ IMAGE.STREAM)                            (* ; "Edited  7-Dec-95 13:20 by ")

@@ -449,8 +360,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
                             'REPLACE NIL NIL FACTOR])
 
-
-
 (BMOBJ.IMAGEBOXFN

 
   [LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN)     (* ; "Edited  7-Dec-95 13:20 by ")

@@ -537,8 +446,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
                  XKERN _ 0])
 
-
-
 (BMOBJ.PUTFN

   [LAMBDA (BMOBJ STREAM)
                                 (* ; "Edited 13-Aug-93 15:41 by rmk:")

                                                              (* ; "Edited 11-Jan-89 17:00 by jds")

@@ -558,8 +465,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                  STREAM FILERDTBL)
           (SPACES 1 STREAM])
 
-
-
 (BMOBJ.INIT

   [LAMBDA NIL
                                            (* ; "Edited 13-Aug-93 14:27 by rmk:")

                                                              (* ; "Edited 11-Jan-89 17:01 by jds")

@@ -581,8 +486,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                                 (FUNCTION NILL)
                                 (FUNCTION NILL])
 
-
-
 (BMOBJ.GETFN5

   [LAMBDA (INPUT.STREAM TEXTSTREAM)
                      (* ; "Edited 13-Aug-93 15:40 by rmk:")

                                                              (* jds "30-Oct-85 11:29")

@@ -592,8 +495,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
            (READ INPUT.STREAM FILERDTBL)
            (READ INPUT.STREAM FILERDTBL])
 
-
-
 (BMOBJ.CREATE.MENU

   [LAMBDA NIL
                                                (* ; "Edited 30-Jul-87 19:19 by jds")

           
@@ -628,21 +529,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
            MENUOFFSET _ (create
 POSITION
                                XCOORD _ -1
                                YCOORD _ 0])
-
 )
 
-
-
 (RPAQ? *SMALLSCREEN*
 (ILESSP SCREENWIDTH 700))
 
-
-
 (RPAQ? *SMALLSCREENFACTOR*
 0.5)
-
 (DEFINEQ
 
-
-
 (SCALED.BITMAP.GETFN

   (LAMBDA (INPUT.STREAM TEXTSTREAM)
                          (* jds "30-Oct-85 11:29")

           
@@ -654,8 +547,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
           (RETURN (BITMAPTEDITOBJ
 BITMAP (FQUOTIENT 1.0 FACTOR)
                          0)))))
 
-
-
 (BMOBJ.GETFN

   (LAMBDA (STREAM)
                                           (* rrb "17-Jul-84 11:46")

           
@@ -669,8 +560,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                  (RETURN (BITMAPTEDITOBJ
 BITMAP (CAR FIELDS)
                                 (CADR FIELDS)))))))
 
-
-
 (BMOBJ.GETFN2

   (LAMBDA (STREAM)
                                           (* rrb "17-Jul-84 11:29")

           
@@ -683,8 +572,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
           (RETURN (BITMAPTEDITOBJ
 (\READBINARYBITMAP
 STREAM)
                          SCALE ROT)))))
 
-
-
 (BMOBJ.GETFN3

   [LAMBDA (STREAM)
                                       (* ; "Edited 11-Jan-89 17:03 by jds")

 
@@ -702,8 +589,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
           (RETURN (BITMAPTEDITOBJ
 (\READBINARYBITMAP
 STREAM)
                          SCALE 0 DESC])
 
-
-
 (BMOBJ.GETFN4

   [LAMBDA (STREAM)
                                       (* ; "Edited  6-Jan-89 16:33 by jds")

 
@@ -731,162 +616,90 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 
          (BITMAPTEDITOBJ
 (\READBINARYBITMAP
 STREAM)
                 SCALE ROT DESCENT])
-
 )
 
 
 
-
-
-
-
 (* ; "GETFNs for backward compatibility with older objects.")

 
-
-
 (DECLARE%: EVAL@COMPILE
 
-
-
 (RECORD BITMAPOBJ
 (
+                   (* ;; "Describes a bitmap imageobj")

 
-                       (* ;; "Describes a bitmap imageobj")

-
-
-
-                       BITMAP                                (* ; "The bitmap itself")

-
-                       BMOBJSCALEFACTOR                      (* ; 
-
-
                                                        "The factor to scale it by when displaying")

-
-                       BMOBJROTATION                         (* ; 
-
-
                                                           "A rotation to apply when displaying")

-
-                       BMOBJDESCENT                          (* ; 
-
-
                                            "How far below the base line to display it.  NIL => 0.")

-
-                       ))
-
+                   BITMAP                                    (* ; "The bitmap itself")

+                   BMOBJSCALEFACTOR                          (* ; 
+
                                                          "The factor to scale it by when displaying")

+                   BMOBJROTATION                             (* ; 
+
                                                             "A rotation to apply when displaying")

+                   BMOBJDESCENT                              (* ; 
+
                                              "How far below the base line to display it.  NIL => 0.")

+                   ))
 )
 
-
-
 (RPAQ? DEFAULT.BITMAP.SCALE
 '(0.75 (DISPLAY 1)))
 
 
 
-
-
-
-
 (* ;; "make ^O be a character that inserts an object read from the user.")

 
-
-
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-
-
 (GLOBALVARS (BITMAP.OBJ.MENU))
-
 )
 
-
-
 (ADDTOVAR BackgroundCopyMenuCommands

-
           (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
-
                 "prompts for an area of the screen to insert.")
-
           ("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
-
                  "prompts for an area of the screen to insert, scaled down by 50%%.")
-
           ("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
-
                  "prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50.")
-
           ("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
-
                  "Inserts *INSERT-BITMAP* in a document"))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN2))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN3))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN4))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (BMOBJ.GETFN5))
 
-
-
 (ADDTOVAR IMAGEOBJGETFNS
 (SCALED.BITMAP.GETFN))
 
-
-
 (RPAQQ BackgroundCopyMenu
 NIL)
-
 (DEFINEQ
 
-
-
 (GET.OBJ.FROM.USER

-  [LAMBDA (TEXTSTREAM TEXTOBJ)
                           (* ; "Edited 26-Apr-91 10:54 by jds")

+  [LAMBDA (TEXTSTREAM TEXTOBJ)
                               (* ; "Edited  7-Jul-2024 21:04 by rmk")


+                                                             (* ; "Edited 26-Apr-91 10:54 by jds")

 
-    (* ;; "reads an expression from the user and puts the result into the textstream.")

+    (* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")

 
-    (ERSETQ (PROG ((VAL (PROMPTFOREVALED
 "Form to eval:"))
-                   (SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-                   BM)
-                  (CL:TYPECASE VAL
-                      (STRINGP                               (* ; 
-
                                                          "Atoms and strings get inserted as text.")

-                         (AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL)))
-                      (LITATOM                               (* ; 
-
                                                          "Atoms and strings get inserted as text.")

-                         (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
-                                         SEL)))
-                      (IMAGEOBJ                              (* ; "IMAGEOBJs get inserted as is")

-                         (TEDIT.INSERT.OBJECT VAL TEXTSTREAM (SELECTQ (fetch
 POINT of
 SEL)
-                                                                 (LEFT (fetch
 (SELECTION CH#)
-                                                                          of
 SEL))
-                                                                 (RIGHT (fetch
 (SELECTION CHLIM)
-                                                                           of
 SEL))
-                                                                 NIL)))
-                      (T (COND
-                            ((SETQ BM (COERCETOBITMAP
 VAL))
+    (ERSETQ (LET ((VAL (PROMPTFOREVALED
 "Form to eval:"))
+                  BM)
+                 (CL:WHEN VAL
+                     (CL:TYPECASE VAL
+                         (STRINGP                            (* ; 
+
                                                            "Atoms and strings get inserted as text.")

+                            (TEDIT.INSERT TEXTSTREAM VAL))
+                         (LITATOM                            (* ; 
+
                                                            "Atoms and strings get inserted as text.")

+                            (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)))
+                         (IMAGEOBJ                           (* ; "IMAGEOBJs get inserted as is")

+                            (TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
+                         (T [COND
+                               ((SETQ BM (COERCETOBITMAP
 VAL))
                                                              (* ; 
-
                    "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")

-                             (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ
 BM 1 0)
-                                    TEXTSTREAM
-                                    (SELECTQ (fetch
 POINT of
 SEL)
-                                        (LEFT (fetch
 (SELECTION CH#) of
 SEL))
-                                        (RIGHT (fetch
 (SELECTION CHLIM) of
 SEL))
-                                        NIL)))
-                            (T                               (* ; 
-
                                      "Not a bitmap, nor one of the special cases above;  complain")

-                               (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
-                                               SEL))         (* ; 
-
       "(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT 'Not implemented to have ' VAL ' in documents yet.') T)")

-                               ))))])
-
-
+
                      "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")

+                                (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ
 BM 1 0)
+                                       TEXTSTREAM))
+                               (T                            (* ; 
+
                                "Not a bitmap, nor one of the special cases above;  see what happens")

+                                  (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T])))])
 
 (BITMAPOBJ.SNAPW

   [LAMBDA (SCALE SAVE)
                                   (* ; "Edited 14-Aug-93 19:54 by rmk:")

@@ -911,8 +724,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                                    0]
           (RETURN])
 
-
-
 (PROMPTFOREVALED

   (LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT)
                (* jds "26-Sep-85 16:46")

           
@@ -950,42 +761,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
                                                     '>)))))
           (CLOSEW WIN)
           (RETURN NEWVALUE))))
-
 )
-
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-
-
 (BMOBJ.INIT
)
-
 )
 
-
-
 (FILESLOAD EDITBITMAP)
-
-(PUTPROPS IMAGEOBJ COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993
-
- 1995))
-
 (DECLARE%: DONTCOPY
-
-  (FILEMAP (NIL (3164 7671 (BITMAPTEDITOBJ 3176 . 3819) (COERCETOBITMAP 3823 . 5867) (WINDOWTITLEFONT 
-
-5871 . 6218) (\PRINTBINARYBITMAP 6222 . 7013) (\READBINARYBITMAP 7017 . 7668)) (7728 23863 (
-
-BMOBJ.BUTTONEVENTINFN 7740 . 12286) (BMOBJ.COPYFN 12290 . 12916) (BMOBJ.DISPLAYFN 12920 . 16649) (
-
-BMOBJ.IMAGEBOXFN 16653 . 19068) (BMOBJ.PUTFN 19072 . 20004) (BMOBJ.INIT 20008 . 21047) (BMOBJ.GETFN5 
-
-21051 . 21641) (BMOBJ.CREATE.MENU 21645 . 23860)) (23958 27253 (SCALED.BITMAP.GETFN 23970 . 24396) (
-
-BMOBJ.GETFN 24400 . 24935) (BMOBJ.GETFN2 24939 . 25424) (BMOBJ.GETFN3 25428 . 26216) (BMOBJ.GETFN4 
-
-26220 . 27250)) (29245 35381 (GET.OBJ.FROM.USER 29257 . 32020) (BITMAPOBJ.SNAPW 32024 . 33150) (
-
-PROMPTFOREVALED 33154 . 35378)))))
-
+  (FILEMAP (NIL (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT 
+5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 (
+BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) (
+BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5 
+20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) (
+BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4 
+25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) (
+PROMPTFOREVALED 31934 . 34158)))))
 STOP
-

library/PDFSTREAM

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56
 14033  
+
(FILECREATED "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59
 14133  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS PDFSTREAMCOMS)
 
-      :PREVIOUS-DATE " 9-Oct-2023 00:42:25" {WMEDLEY}<library>PDFSTREAM.;55)
+      :PREVIOUS-DATE "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56)
 
 
 (PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -30,6 +30,7 @@
                                             (FONTCREATE POSTSCRIPT.FONTCREATE)
                                             (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
                                             (CREATECHARSET \CREATECHARSET.PSC]
+              (ALISTS (DEFAULTFILETYPELIST PDF))
               (VARS (DEFAULTPRINTERTYPE 'PDF))
               (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
               (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
@@ -73,6 +74,8 @@
                                 (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
                                 (CREATECHARSET \CREATECHARSET.PSC)))
 
+(ADDTOVAR DEFAULTFILETYPELIST
 (PDF . BINARY))
+
 (RPAQQ DEFAULTPRINTERTYPE
 PDF)
 (DEFINEQ
 
@@ -280,8 +283,8 @@
                                    thereis
 (ShellWhich (CAR TEMPLATE])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3162 5776 (PDFFILEP 3172 . 4086) (PDF.HARDCOPYW 4088 . 4686) (PDF.TEXT 4688 . 5405) (
-PDF.TEDIT 5407 . 5774)) (6216 13276 (OPEN-PDF-STREAM 6226 . 8362) (CLOSE-PDF-STREAM 8364 . 9651) (
-PS-TO-PDF 9653 . 13274)) (13277 13675 (SEE-PDF 13287 . 13673)) (13726 14010 (PDFCONVERTER 13736 . 
-14008)))))
+  (FILEMAP (NIL (3262 5876 (PDFFILEP 3272 . 4186) (PDF.HARDCOPYW 4188 . 4786) (PDF.TEXT 4788 . 5505) (
+PDF.TEDIT 5507 . 5874)) (6316 13376 (OPEN-PDF-STREAM 6326 . 8462) (CLOSE-PDF-STREAM 8464 . 9751) (
+PS-TO-PDF 9753 . 13374)) (13377 13775 (SEE-PDF 13387 . 13773)) (13826 14110 (PDFCONVERTER 13836 . 
+14108)))))
 STOP

library/POSTSCRIPTSTREAM

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12
 258100 
+
(FILECREATED "10-Dec-2024 15:16:36" {WMEDLEY}<library>POSTSCRIPTSTREAM.;15
 258118 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS POSTSCRIPTFILEP)
+      :CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS)
 
-      :PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
+      :PREVIOUS-DATE "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12)
 
 
 (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -18,11 +18,11 @@
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
         (INITRECORDS \POSTSCRIPTDATA)
         (FNS POSTSCRIPT.INIT)
-        (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
-                        (PSC . TEXT)
+        (ADDVARS (DEFAULTFILETYPELIST (PS . BINARY)
+                        (PSC . BINARY)
                         (PSF . BINARY)
                         (PSCFONT . BINARY)
-                        (POSTSCRIPT . TEXT))
+                        (POSTSCRIPT . BINARY))
                (*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
                       (AVANTGARDE-DEMI . AD)
                       (BECKMAN . BM)
@@ -483,11 +483,11 @@
     (\POSTSCRIPT.NSHASH
 *POSTSCRIPT-NS-TRANSLATIONS*])
 )
 
-(ADDTOVAR DEFAULTFILETYPELIST
 (PS . TEXT)
-                              (PSC . TEXT)
+(ADDTOVAR DEFAULTFILETYPELIST
 (PS . BINARY)
+                              (PSC . BINARY)
                               (PSF . BINARY)
                               (PSCFONT . BINARY)
-                              (POSTSCRIPT . TEXT))
+                              (POSTSCRIPT . BINARY))
 
 (ADDTOVAR *DISPLAY-FONT-NAME-MAP*
 (AVANTGARDE-BOOK . AB)
                                   (AVANTGARDE-DEMI . AD)
@@ -4383,38 +4383,38 @@
 (ADDTOVAR LAMA
 POSTSCRIPT.PUTCOMMAND)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 . 
-32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
-PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
-PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
-POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
-\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622 
-74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
-POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
-POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE 
-81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
-POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND 
-94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
-POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024) 
-(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719) 
-(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
-\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 . 
-126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 . 
-133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 . 
-142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 . 
-147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
-\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
- (\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 . 
-160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
- . 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 . 
-167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC 
-168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
-\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 . 
-180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
-\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
-\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC 
-199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
-205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 . 
-206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 . 
-254985)))))
+  (FILEMAP (NIL (22211 29315 (POSTSCRIPT.INIT 22221 . 29313)) (30301 65085 (PSCFONT.READFONT 30311 . 
+32219) (PSCFONT.SPELLFILE 32221 . 32799) (PSCFONT.COERCEFILE 32801 . 34373) (
+PSCFONTFROMCACHE.SPELLFILE 34375 . 35360) (PSCFONTFROMCACHE.COERCEFILE 35362 . 37014) (
+PSCFONT.WRITEFONT 37016 . 38031) (READ-AFM-FILE 38033 . 43904) (CONVERT-AFM-FILES 43906 . 45118) (
+POSTSCRIPT.GETFONTID 45120 . 46515) (POSTSCRIPT.FONTCREATE 46517 . 58916) (
+\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58918 . 61315) (POSTSCRIPT.FONTSAVAILABLE 61317 . 65083)) (65640 
+74786 (OPENPOSTSCRIPTSTREAM 65650 . 74452) (CLOSEPOSTSCRIPTSTREAM 74454 . 74784)) (74831 81123 (
+POSTSCRIPT.HARDCOPYW 74841 . 78190) (POSTSCRIPT.TEDIT 78192 . 78672) (POSTSCRIPT.TEXT 78674 . 78965) (
+POSTSCRIPTFILEP 78967 . 80074) (MAKEEPSFILE 80076 . 81121)) (81124 126010 (POSTSCRIPT.BITMAPSCALE 
+81134 . 83590) (POSTSCRIPT.CLOSESTRING 83592 . 84126) (POSTSCRIPT.ENDPAGE 84128 . 84999) (
+POSTSCRIPT.OUTSTR 85001 . 86022) (POSTSCRIPT.PUTBITMAPBYTES 86024 . 94495) (POSTSCRIPT.PUTCOMMAND 
+94497 . 95546) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95548 . 100996) (POSTSCRIPT.SHOWACCUM 100998 . 103236) (
+POSTSCRIPT.STARTPAGE 103238 . 105817) (\POSTSCRIPTTAB 105819 . 106690) (\PS.BOUTFIXP 106692 . 108042) 
+(\PS.SCALEHACK 108044 . 110873) (\PS.SCALEREGION 110875 . 111435) (\SCALEDBITBLT.PSC 111437 . 115737) 
+(\SETPOS.PSC 115739 . 116201) (\SETXFORM.PSC 116203 . 118022) (\STRINGWIDTH.PSC 118024 . 118478) (
+\SWITCHFONTS.PSC 118480 . 124637) (\TERPRI.PSC 124639 . 126008)) (126045 181765 (\BITBLT.PSC 126055 . 
+126608) (\BLTSHADE.PSC 126610 . 130892) (\CHARWIDTH.PSC 130894 . 131661) (\CREATECHARSET.PSC 131663 . 
+133361) (\DRAWARC.PSC 133363 . 135843) (\DRAWCIRCLE.PSC 135845 . 138254) (\DRAWCURVE.PSC 138256 . 
+142277) (\DRAWELLIPSE.PSC 142279 . 144756) (\DRAWLINE.PSC 144758 . 147108) (\DRAWPOINT.PSC 147110 . 
+147698) (\DRAWPOLYGON.PSC 147700 . 150814) (\DSPBOTTOMMARGIN.PSC 150816 . 151381) (
+\DSPCLIPPINGREGION.PSC 151383 . 152826) (\DSPCOLOR.PSC 152828 . 153669) (\DSPFONT.PSC 153671 . 157881)
+ (\DSPLEFTMARGIN.PSC 157883 . 158452) (\DSPLINEFEED.PSC 158454 . 159030) (\DSPPUSHSTATE.PSC 159032 . 
+160795) (\DSPPOPSTATE.PSC 160797 . 163306) (\DSPRESET.PSC 163308 . 163954) (\DSPRIGHTMARGIN.PSC 163956
+ . 164528) (\DSPROTATE.PSC 164530 . 165553) (\DSPSCALE.PSC 165555 . 166486) (\DSPSCALE2.PSC 166488 . 
+167307) (\DSPSPACEFACTOR.PSC 167309 . 168281) (\DSPTOPMARGIN.PSC 168283 . 169000) (\DSPTRANSLATE.PSC 
+169002 . 171576) (\DSPXPOSITION.PSC 171578 . 172177) (\DSPYPOSITION.PSC 172179 . 172751) (
+\FILLCIRCLE.PSC 172753 . 175399) (\FILLPOLYGON.PSC 175401 . 179317) (\FIXLINELENGTH.PSC 179319 . 
+180813) (\MOVETO.PSC 180815 . 181566) (\NEWPAGE.PSC 181568 . 181763)) (181821 204973 (
+\POSTSCRIPT.CHANGECHARSET 181831 . 182635) (\POSTSCRIPT.OUTCHARFN 182637 . 195494) (
+\POSTSCRIPT.PRINTSLUG 195496 . 197463) (\POSTSCRIPT.SPECIALOUTCHARFN 197465 . 199897) (\UPDATE.PSC 
+199899 . 201122) (\POSTSCRIPT.ACCENTFN 201124 . 202066) (\POSTSCRIPT.ACCENTPAIR 202068 . 204971)) (
+205071 206716 (\PSC.SPACEDISP 205081 . 205360) (\PSC.SPACEWID 205362 . 205981) (\PSC.SYMBOLS 205983 . 
+206714)) (206825 209816 (\POSTSCRIPT.NSHASH 206835 . 209814)) (254291 255005 (POSTSCRIPTSEND 254301 . 
+255003)))))
 STOP

library/UNICODE

@@ -1,14 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Mar-2024 23:07:42" {WMEDLEY}<library>UNICODE.;73
 100984 
+
(FILECREATED "26-Aug-2024 16:58:36" {WMEDLEY}<library>UNICODE.;74
 100982 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS UNICODE-EXTEND-TRANSLATION? INVERT-ALL-UNICODE-MAPPINGS ALL-UNICODE-MAPPINGS 
-                       MERGE-UNICODE-TRANSLATION-TABLES)
-                  (VARS UNICODECOMS)
+      :CHANGES-TO (FNS UNICODE-EXTEND-TRANSLATION?)
 
-      :PREVIOUS-DATE "27-Mar-2024 14:50:54" {WMEDLEY}<library>UNICODE.;72)
+      :PREVIOUS-DATE "27-Mar-2024 23:07:42" {WMEDLEY}<library>UNICODE.;73)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
@@ -661,7 +659,8 @@
                 NEXTCODE])
 
 (UNICODE-EXTEND-TRANSLATION?

-  [LAMBDA (CODE TRANSLATION-TABLE)
                           (* ; "Edited 27-Mar-2024 23:02 by rmk")


+  [LAMBDA (CODE TRANSLATION-TABLE)
                           (* ; "Edited 26-Aug-2024 16:49 by rmk")


+                                                             (* ; "Edited 27-Mar-2024 23:02 by rmk")


                                                              (* ; "Edited  5-Feb-2024 13:48 by rmk")


                                                              (* ; "Edited  3-Feb-2024 12:40 by rmk")

 
@@ -673,11 +672,11 @@
                                   'UNICODE-MAPPINGS.TXT)
                            T UNICODEDIRECTORIES))
          (CL:WHEN FILE
-             (SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT)
-                                  (FFILEPOS (CONCAT "[" (LRSH CODE 8)
-                                                   " ")
-                                         STREAM NIL NIL NIL T)
-                                  (READ STREAM)))
+             [SETQ MAPPING (CL:WITH-OPEN-FILE (STREAM FILE :INPUT)
+                                  (CL:WHEN (FFILEPOS (CONCAT "[" (LRSH CODE 8)
+                                                            " ")
+                                                  STREAM NIL NIL NIL T)
+                                         (READ STREAM]
              (CL:WHEN MAPPING
 
                  (* ;; 
@@ -1866,23 +1865,23 @@
 
 (PUTPROPS UNICODE
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4211 18357 (UTF8.OUTCHARFN 4221 . 7019) (UTF8.INCCODEFN 7021 . 12633) (UTF8.PEEKCCODEFN
- 12635 . 17375) (\UTF8.BACKCCODEFN 17377 . 18355)) (18358 22612 (UTF16BE.OUTCHARFN 18368 . 19278) (
-UTF16BE.INCCODEFN 19280 . 20296) (UTF16BE.PEEKCCODEFN 20298 . 21529) (\UTF16BE.BACKCCODEFN 21531 . 
-22610)) (22613 26900 (UTF16LE.OUTCHARFN 22623 . 23630) (UTF16LE.INCCODEFN 23632 . 24648) (
-UTF16LE.PEEKCCODEFN 24650 . 25817) (\UTF16LE.BACKCCODEFN 25819 . 26898)) (26901 29830 (READBOM 26911
- . 28915) (WRITEBOM 28917 . 29828)) (29860 33050 (MAKE-UNICODE-FORMATS 29870 . 33048)) (33147 41529 (
-UNICODE.UNMAPPED 33157 . 35231) (UNICODE-EXTEND-TRANSLATION? 35233 . 37152) (UTF8.BINCODE 37154 . 
-39733) (\UTF8.FETCHCODE 39735 . 41527)) (41530 47051 (UTF8.VALIDATE 41540 . 44137) (
-UTF8-SIZE-FROM-BYTE1 44139 . 44571) (NUTF8-BYTE1-BYTES 44573 . 45310) (NUTF8-CODE-BYTES 45312 . 46369)
- (NUTF8-STRING-BYTES 46371 . 47049)) (48482 48831 (XTOUCODE 48492 . 48660) (UTOXCODE 48662 . 48829)) (
-49774 55820 (READ-UNICODE-MAPPING-FILENAMES 49784 . 52731) (READ-UNICODE-MAPPING 52733 . 55818)) (
-55887 69217 (MAKE-UNICODE-TRANSLATION-TABLES 55897 . 64969) (MERGE-UNICODE-TRANSLATION-TABLES 64971 . 
-66105) (MERGE-UNICODE-TRANSLATION-TABLES1 66107 . 69215)) (69218 76326 (INVERT-ALL-UNICODE-MAPPINGS 
-69228 . 72849) (ALL-UNICODE-MAPPINGS 72851 . 76324)) (77294 89725 (WRITE-UNICODE-MAPPING 77304 . 81054
-) (WRITE-UNICODE-INCLUDED 81056 . 85778) (WRITE-UNICODE-MAPPING-HEADER 85780 . 87028) (
-WRITE-UNICODE-MAPPING-FILENAME 87030 . 88560) (HEXSTRING 88562 . 89723)) (89726 90402 (
-XCCS-UTF8-AFTER-OPEN 89736 . 90400)) (92927 98429 (UTF8HEXSTRING 92937 . 95142) (XTOUSTRING 95144 . 
-98064) (XCCSSTRING 98066 . 98427)) (98430 99318 (UNHEXSTRING 98440 . 99316)) (99319 100829 (SHOWCHARS 
-99329 . 100827)))))
+  (FILEMAP (NIL (4068 18214 (UTF8.OUTCHARFN 4078 . 6876) (UTF8.INCCODEFN 6878 . 12490) (UTF8.PEEKCCODEFN
+ 12492 . 17232) (\UTF8.BACKCCODEFN 17234 . 18212)) (18215 22469 (UTF16BE.OUTCHARFN 18225 . 19135) (
+UTF16BE.INCCODEFN 19137 . 20153) (UTF16BE.PEEKCCODEFN 20155 . 21386) (\UTF16BE.BACKCCODEFN 21388 . 
+22467)) (22470 26757 (UTF16LE.OUTCHARFN 22480 . 23487) (UTF16LE.INCCODEFN 23489 . 24505) (
+UTF16LE.PEEKCCODEFN 24507 . 25674) (\UTF16LE.BACKCCODEFN 25676 . 26755)) (26758 29687 (READBOM 26768
+ . 28772) (WRITEBOM 28774 . 29685)) (29717 32907 (MAKE-UNICODE-FORMATS 29727 . 32905)) (33004 41527 (
+UNICODE.UNMAPPED 33014 . 35088) (UNICODE-EXTEND-TRANSLATION? 35090 . 37150) (UTF8.BINCODE 37152 . 
+39731) (\UTF8.FETCHCODE 39733 . 41525)) (41528 47049 (UTF8.VALIDATE 41538 . 44135) (
+UTF8-SIZE-FROM-BYTE1 44137 . 44569) (NUTF8-BYTE1-BYTES 44571 . 45308) (NUTF8-CODE-BYTES 45310 . 46367)
+ (NUTF8-STRING-BYTES 46369 . 47047)) (48480 48829 (XTOUCODE 48490 . 48658) (UTOXCODE 48660 . 48827)) (
+49772 55818 (READ-UNICODE-MAPPING-FILENAMES 49782 . 52729) (READ-UNICODE-MAPPING 52731 . 55816)) (
+55885 69215 (MAKE-UNICODE-TRANSLATION-TABLES 55895 . 64967) (MERGE-UNICODE-TRANSLATION-TABLES 64969 . 
+66103) (MERGE-UNICODE-TRANSLATION-TABLES1 66105 . 69213)) (69216 76324 (INVERT-ALL-UNICODE-MAPPINGS 
+69226 . 72847) (ALL-UNICODE-MAPPINGS 72849 . 76322)) (77292 89723 (WRITE-UNICODE-MAPPING 77302 . 81052
+) (WRITE-UNICODE-INCLUDED 81054 . 85776) (WRITE-UNICODE-MAPPING-HEADER 85778 . 87026) (
+WRITE-UNICODE-MAPPING-FILENAME 87028 . 88558) (HEXSTRING 88560 . 89721)) (89724 90400 (
+XCCS-UTF8-AFTER-OPEN 89734 . 90398)) (92925 98427 (UTF8HEXSTRING 92935 . 95140) (XTOUSTRING 95142 . 
+98062) (XCCSSTRING 98064 . 98425)) (98428 99316 (UNHEXSTRING 98438 . 99314)) (99317 100827 (SHOWCHARS 
+99327 . 100825)))))
 STOP

library/tedit/TEDIT-ABBREV

@@ -1,71 +1,69 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Mar-2024 18:15:40" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8
 9500   
+
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9
 10946  
 
       :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)
+      :PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
 
 
 (PRETTYCOMPRINT TEDIT-ABBREVCOMS)
 
-(RPAQQ TEDIT-ABBREVCOMS

-       [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
-        (GLOBALVARS TEDIT.ABBREVS)
-        (INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
-                                   ("n" . "357,44")
-                                   ("m" . "357,45")
-                                   ("T" . "357,57")
-                                   ("d" . "357,60")
-                                   ("D" . "357,61")
-                                   ("s" . "0,247")
-                                   ("'" . "0,271")
-                                   ("`" . "0,251")
-                                   ("%"" . "0,252")
-                                   ("~" . "0,272")
-                                   ("1/4" . "0,274")
-                                   ("1/2" . "0,275")
-                                   ("3/4" . "0,276")
-                                   ("1/3" . "357,375")
-                                   ("2/3" . "357,376")
-                                   ("c" . "0,323")
-                                   ("c/o" . "357,100")
-                                   ("%%" . "357,100")
-                                   ("->" . "0,256")
-                                   ("ra" . "0,256")
-                                   ("|" . "0,257")
-                                   ("da" . "0,257")
-                                   ("^" . "0,255")
-                                   ("ua" . "0,255")
-                                   ("<-" . "0,254")
-                                   ("la" . "0,254")
-                                   ("_" . "0,254")
-                                   ("L" . "0,243")
-                                   ("o" . "0,260")
-                                   ("Y" . "0,245")
-                                   ("+" . "0,261")
-                                   ("x" . "0,264")
-                                   ("/" . "0,270")
-                                   ("=" . "357,121")
-                                   ("p" . "0,266")
-                                   ("r" . "0,322")
-                                   ("t" . "0,324")
-                                   ("tm" . "0,324")
-                                   ("box" . "42,42")
-                                   ("cbox" . "42,61")
-                                   ("-" . "357,43")
-                                   ("=" . "357,42")
-                                   (" " . "357,41")
-                                   ("DATE" . \TEDIT.EXPAND.DATE)
-                                   (">>DATE<<" . \TEDIT.EXPAND.DATE])
+(RPAQQ TEDIT-ABBREVCOMS
 [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
+                         (GLOBALVARS TEDIT.ABBREVS)
+                         (INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
+                                                    ("n" . "357,44")
+                                                    ("m" . "357,45")
+                                                    ("T" . "357,57")
+                                                    ("d" . "357,60")
+                                                    ("D" . "357,61")
+                                                    ("s" . "0,247")
+                                                    ("'" . "0,271")
+                                                    ("`" . "0,251")
+                                                    ("%"" . "0,252")
+                                                    ("~" . "0,272")
+                                                    ("1/4" . "0,274")
+                                                    ("1/2" . "0,275")
+                                                    ("3/4" . "0,276")
+                                                    ("1/3" . "357,375")
+                                                    ("2/3" . "357,376")
+                                                    ("c" . "0,323")
+                                                    ("c/o" . "357,100")
+                                                    ("%%" . "357,100")
+                                                    ("->" . "0,256")
+                                                    ("ra" . "0,256")
+                                                    ("|" . "0,257")
+                                                    ("da" . "0,257")
+                                                    ("^" . "0,255")
+                                                    ("ua" . "0,255")
+                                                    ("<-" . "0,254")
+                                                    ("la" . "0,254")
+                                                    ("_" . "0,254")
+                                                    ("L" . "0,243")
+                                                    ("o" . "0,260")
+                                                    ("Y" . "0,245")
+                                                    ("+" . "0,261")
+                                                    ("x" . "0,264")
+                                                    ("/" . "0,270")
+                                                    ("=" . "357,121")
+                                                    ("p" . "0,266")
+                                                    ("r" . "0,322")
+                                                    ("t" . "0,324")
+                                                    ("tm" . "0,324")
+                                                    ("box" . "42,42")
+                                                    ("cbox" . "42,61")
+                                                    ("-" . "357,43")
+                                                    ("=" . "357,42")
+                                                    (" " . "357,41")
+                                                    ("DATE" . \TEDIT.EXPAND.DATE)
+                                                    (">>DATE<<" . \TEDIT.EXPAND.DATE])
 (DEFINEQ
 
 (\TEDIT.ABBREV.EXPAND

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


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 31-Oct-2024 17:50 by rmk")


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


@@ -74,7 +72,7 @@
     (PROG ((TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM))
            SEL CH# CH OLDLOOKS EXPANSION)
           (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-          (SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL)))
+          (SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
           [COND
              ((ZEROP (GETSEL SEL DCH))                       (* ; 
 
                                                  "Point Selection, so use the character to the left")

@@ -158,54 +156,53 @@
 (GLOBALVARS TEDIT.ABBREVS)
 )
 
-(RPAQ? TEDIT.ABBREVS

-       '(("b" . "357,146")
-         ("n" . "357,44")
-         ("m" . "357,45")
-         ("T" . "357,57")
-         ("d" . "357,60")
-         ("D" . "357,61")
-         ("s" . "0,247")
-         ("'" . "0,271")
-         ("`" . "0,251")
-         ("%"" . "0,252")
-         ("~" . "0,272")
-         ("1/4" . "0,274")
-         ("1/2" . "0,275")
-         ("3/4" . "0,276")
-         ("1/3" . "357,375")
-         ("2/3" . "357,376")
-         ("c" . "0,323")
-         ("c/o" . "357,100")
-         ("%%" . "357,100")
-         ("->" . "0,256")
-         ("ra" . "0,256")
-         ("|" . "0,257")
-         ("da" . "0,257")
-         ("^" . "0,255")
-         ("ua" . "0,255")
-         ("<-" . "0,254")
-         ("la" . "0,254")
-         ("_" . "0,254")
-         ("L" . "0,243")
-         ("o" . "0,260")
-         ("Y" . "0,245")
-         ("+" . "0,261")
-         ("x" . "0,264")
-         ("/" . "0,270")
-         ("=" . "357,121")
-         ("p" . "0,266")
-         ("r" . "0,322")
-         ("t" . "0,324")
-         ("tm" . "0,324")
-         ("box" . "42,42")
-         ("cbox" . "42,61")
-         ("-" . "357,43")
-         ("=" . "357,42")
-         (" " . "357,41")
-         ("DATE" . \TEDIT.EXPAND.DATE)
-         (">>DATE<<" . \TEDIT.EXPAND.DATE)))
+(RPAQ? TEDIT.ABBREVS
 '(("b" . "357,146")
+                       ("n" . "357,44")
+                       ("m" . "357,45")
+                       ("T" . "357,57")
+                       ("d" . "357,60")
+                       ("D" . "357,61")
+                       ("s" . "0,247")
+                       ("'" . "0,271")
+                       ("`" . "0,251")
+                       ("%"" . "0,252")
+                       ("~" . "0,272")
+                       ("1/4" . "0,274")
+                       ("1/2" . "0,275")
+                       ("3/4" . "0,276")
+                       ("1/3" . "357,375")
+                       ("2/3" . "357,376")
+                       ("c" . "0,323")
+                       ("c/o" . "357,100")
+                       ("%%" . "357,100")
+                       ("->" . "0,256")
+                       ("ra" . "0,256")
+                       ("|" . "0,257")
+                       ("da" . "0,257")
+                       ("^" . "0,255")
+                       ("ua" . "0,255")
+                       ("<-" . "0,254")
+                       ("la" . "0,254")
+                       ("_" . "0,254")
+                       ("L" . "0,243")
+                       ("o" . "0,260")
+                       ("Y" . "0,245")
+                       ("+" . "0,261")
+                       ("x" . "0,264")
+                       ("/" . "0,270")
+                       ("=" . "357,121")
+                       ("p" . "0,266")
+                       ("r" . "0,322")
+                       ("t" . "0,324")
+                       ("tm" . "0,324")
+                       ("box" . "42,42")
+                       ("cbox" . "42,61")
+                       ("-" . "357,43")
+                       ("=" . "357,42")
+                       (" " . "357,41")
+                       ("DATE" . \TEDIT.EXPAND.DATE)
+                       (">>DATE<<" . \TEDIT.EXPAND.DATE)))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
-\TEDIT.TRY.ABBREV 6008 . 8154)))))
+  (FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
+\TEDIT.TRY.ABBREV 6831 . 8977)))))
 STOP

library/tedit/TEDIT-CHAT

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14
 12223  
+
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16
 12363  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-CHATCOMS)
-                  (FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN)
+      :CHANGES-TO (FNS TEDITCHAT.CHARFN)
 
-      :PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}<library>tedit>TEDIT-CHAT.;9)
+      :PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
 
 
 (PRETTYCOMPRINT TEDIT-CHATCOMS)
@@ -71,16 +70,18 @@
           (replace
 (CHAT.STATE HELD) of
 STATE with
 NIL])
 
 (TEDITCHAT.CHARFN

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


+  [LAMBDA (CH CHAT.STATE)
                                    (* ; "Edited 24-Jun-2024 00:04 by rmk")


+                                                             (* ; "Edited  2-May-2024 18:09 by rmk")


+                                                             (* ; "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])
+    (LET* ((TSTREAM (fetch
 (CHAT.STATE TEXTSTREAM) of
 CHAT.STATE))
+           (TEXTOBJ (TEXTOBJ TSTREAM)))
+          (\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
+          (SELCHARQ CH
+               (BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
+               (LF NIL)
+               (BOUT TSTREAM CH])
 )
 
 
@@ -212,6 +213,6 @@
        CHATDECLS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN
- 3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333)))))
+  (FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
+ 3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
 STOP

library/tedit/TEDIT-COMMAND

@@ -1,15 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-Apr-2024 11:55:17" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;87
 53604  
+
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133
 49278  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.COPYTOCLIPBOARD \TEDIT.WRITE.SEL)
-                  (MACROS \TEDIT.MOUSESTATE)
+      :CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
 
-      :PREVIOUS-DATE "21-Apr-2024 10:17:38" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;80)
+      :PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
 
 
 (PRETTYCOMPRINT TEDIT-COMMANDCOMS)
@@ -247,8 +244,9 @@
     PROC])
 
 (\TEDIT.MARKACTIVE

-  [LAMBDA (TEXTOBJ)
                                         (* ; "Edited 12-Jun-90 18:04 by mitani")

-    (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 T)
+  [LAMBDA (TEXTOBJ OPERATION)
                                (* ; "Edited 29-Jun-2024 10:32 by rmk")


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

+    (replace
 (TEXTOBJ EDITOPACTIVE) of
 TEXTOBJ with
 OPERATION)
     TEXTOBJ])
 
 (\TEDIT.MARKINACTIVE

@@ -257,193 +255,135 @@
     TEXTOBJ])
 
 (\TEDIT.COMMAND.LOOP

-  [LAMBDA (STREAM RTBL)
                                      (* ; "Edited 21-Apr-2024 09:08 by rmk")


-                                                             (* ; "Edited  2-Apr-2024 15:35 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 28-Nov-2024 10:01 by rmk")


+                                                             (* ; "Edited 21-Nov-2024 11:51 by rmk")


+                                                             (* ; "Edited 13-Sep-2024 22:34 by rmk")


+                                                             (* ; "Edited 26-Aug-2024 23:26 by rmk")


+                                                             (* ; "Edited 18-Aug-2024 23:05 by rmk")


+                                                             (* ; "Edited  2-Aug-2024 08:46 by rmk")


+                                                             (* ; "Edited 13-Jul-2024 23:13 by rmk")


+                                                             (* ; "Edited 12-Jul-2024 00:39 by rmk")


+                                                             (* ; "Edited  9-Jul-2024 18:02 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 16:24 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 12:31 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 00:08 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:21 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 10:58 by rmk")


+                                                             (* ; "Edited  7-May-2024 10:42 by rmk")


                                                              (* ; "Edited 20-Mar-2024 10:59 by rmk")


-                                                             (* ; "Edited 15-Mar-2024 14:23 by rmk")


-                                                             (* ; "Edited  9-Mar-2024 11:35 by rmk")


                                                              (* ; "Edited 24-Feb-2024 15:33 by rmk")


-                                                             (* ; "Edited 21-Feb-2024 14:49 by rmk")


-                                                             (* ; "Edited 18-Feb-2024 23:35 by rmk")


                                                              (* ; "Edited 24-Dec-2023 09:50 by rmk")


                                                              (* ; "Edited 22-Sep-2023 20:40 by rmk")


-                                                             (* ; "Edited 16-Sep-2023 22:48 by rmk")


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

 
     (* ;; "Main command loop for the TEDIT editor.  Includes keyboard polling and command dispatch")

 
-    (PROG ((TEXTOBJ (CL:IF (type?
 STREAM STREAM)
-                        (fetch
 (TEXTSTREAM TEXTOBJ) of
 STREAM)
-                        STREAM))
-           SEL PANES)
-          (TEXTOBJ! TEXTOBJ)
-          (SETQ SEL (TEXTSEL TEXTOBJ))
-          (SETQ PANES (FGETTOBJ TEXTOBJ \WINDOW))
-          (SETQ RTBL (OR RTBL (FGETTOBJ TEXTOBJ TXTRTBL)
-                         TEDIT.READTABLE))                   (* ; 
-
                                                     "Used to derive command characters from type-in")

-          (for
 P inpanes
 TEXTOBJ do
 (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
-                                                             (* ; "Add the pane to this process")

-          (until
 (TTY.PROCESSP) do
                           (* ; 
+    (LET
+     [(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
+     (for
 P inpanes
 TEXTOBJ do
 (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
+                                                             (* ; "Add the process to our panes")

+     (until
 (TTY.PROCESSP) do
                                (* ; 
 
                                               "Wait until we really have the TTY before proceeding.")

-                                   (DISMISS 250))
-          (RESETLST
-              (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP
 (LIST TEXTOBJ PANES)
-                                T))
-              (LET
-               (CH FN TCH (READSA (fetch
 READSA of
 %#CURRENTRDTBL#))
-                   (TERMSA (OR (FGETTOBJ TEXTOBJ TXTTERMSA)
-                               \PRIMTERMSA))
-                   (TEDITSA (fetch
 READSA of
 RTBL))
-                   (TEDITFNHASH (fetch
 READMACRODEFS of
 RTBL))
-                   (LOOPFN (GETTEXTPROP TEXTOBJ 'LOOPFN))
-                   (CHARFN (GETTEXTPROP TEXTOBJ 'CHARFN))
-                   SELOPERATION SOURCESEL SELPANE)
-               (DECLARE
 (SPECVARS SELOPERATION SOURCESEL SELPANE))
+                              (DISMISS 250))
+     (RESETLST
+         (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP
 (LIST TEXTOBJ)
+                           T))
+         (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
+            do

+            (ERSETQ
+             (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
+                do

+                (\WAITFORSYSBUFP 25)                         (* ; "Await type-in or mouse action")

+                (while
 (FGETTOBJ TEXTOBJ EDITOPACTIVE) do
 (\TEDIT.FLASHCARET TEXTOBJ) 
                                                              (* ; 
-
                                                       "Set by \TEDIT.BUTTONEVENTFN in MOUSE process")

-               (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
-                  do

-                  (ERSETQ
-                   (until
 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
-                      do
 (\WAITFORSYSBUFP 25)                (* ; "Await type-in or mouse action")

-                         (until
 (OR SELOPERATION (NOT (FGETTOBJ TEXTOBJ EDITOPACTIVE)))
-                            do
 (\TEDIT.FLASHCARET TEXTOBJ)
-                               (BLOCK))
-                         (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
-                             (CL:WHEN (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE)
-                                                             (* ; 
-
                     "We got here somehow with the window not in sync with the text.  Run an update.")

-                                 (\TEDIT.SHOWSEL SEL NIL)
-                                 (\TEDIT.UPDATE.SCREEN TEXTOBJ)
-                                 (\TEDIT.FIXSEL SEL TEXTOBJ)
-                                 (\TEDIT.SHOWSEL SEL T))
-                             (\TEDIT.FLASHCARET TEXTOBJ)     (* ; 
+
                                                        "Flash caret while other operation completes")

+                                                          (BLOCK))
+                (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
+                    (\TEDIT.FLASHCARET TEXTOBJ)              (* ; 
 
                  "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")

-                             (FSETTOBJ TEXTOBJ EDITOPACTIVE T)
-                                                             (* ; 
+                    (FSETTOBJ TEXTOBJ EDITOPACTIVE T)        (* ; 
 
                                          "Before starting to work, note that we're doing something.")

-                             (CL:WHEN LOOPFN
-                                 (ERSETQ (APPLY* LOOPFN (FGETTOBJ TEXTOBJ STREAMHINT))))
 
-                             (* ;; "")

+                    (* ;; "")

 
-                             (* ;; 
-
         "Process any pending selections from \TEDIT.BUTTONEVENTFN, here instead of in MOUSE process")

+                    (* ;; "Handle user type-in")

 
-                             (SELECTQ (PROG1 SELOPERATION (SETQ SELOPERATION NIL))
-                                 (NORMAL (CL:WHEN (FGETSEL SOURCESEL SET)
-                                             (SETQ SEL (\TEDIT.COPYSEL SOURCESEL SEL))
-                                                             (* ; "SOURCESEL is new SEL selection")

-                                             (FSETTOBJ TEXTOBJ CARETLOOKS (
-                                                                          \TEDIT.GET.INSERT.CHARLOOKS
-                                                                           TEXTOBJ SEL))
-                                             (\TEDIT.SHOWSEL SEL T)))
-                                 (MOVE                       (* ; "Move source to SEL")

-                                       (TEDIT.MOVE SOURCESEL SEL))
-                                 (COPY                       (* ; "Copy source to SEL.")

-                                       (TEDIT.COPY SOURCESEL SEL))
-                                 (COPYLOOKS                  (* ; "Copy source-looks  to SEL")

-                                            (if
 (EQ 'PARA (GETSEL SOURCESEL SELKIND))
-                                                then
 (TEDIT.COPY.PARALOOKS TEXTOBJ SOURCESEL SEL)
-                                              else
 (TEDIT.COPY.LOOKS TEXTOBJ SOURCESEL SEL)))
-                                 (DELETE                     (* ; "Delete CTRL selection")

-                                         (\TEDIT.DELETE TEXTOBJ SOURCESEL NIL SELPANE))
-                                 NIL)
-
-                             (* ;; "")

-
-                             (* ;; "Handle user type-in")

-
-                             [while
 (\SYSBUFP)
-                                do
 (SETQ CH (\GETKEY))
-                                   (CL:WHEN CHARFN           (* ; 
+                    [bind
 CH TCH FN first
 (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN))
+                                              (ERSETQ (APPLY* FN TSTREAM))) while
 (\SYSBUFP)
+                       do
 (SETQ CH (\GETKEY))
+                          (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
+                                                             (* ; 
 
                                                "Give the OEM user control for each character typed.")

-                                       (SETQ TCH (APPLY* CHARFN (FGETTOBJ TEXTOBJ STREAMHINT)
-                                                        CH))
+                              (SETQ TCH (APPLY* FN TSTREAM CH))
 
-                                       (* ;; 
+                              (* ;; 
 
      "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")

 
-                                       (OR (EQ TCH T)
-                                           (SETQ CH TCH)))
-                                   (SELECTC (AND CH (\SYNCODE TEDITSA CH))
-                                       (CHARDELETE.TTC       (* ; 
-
                                       "Backspace handler: Remove the character just before SEL:CH#.")

-                                            (\TEDIT.CHARDELETE TEXTOBJ SEL)
-                                            (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (CHARDELETE.FORWARD.TTC 
-                                            (\TEDIT.CHARDELETE.FORWARD TEXTOBJ SEL)
-                                            (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (WORDDELETE.TTC 
-                                            (\TEDIT.WORDDELETE TEXTOBJ SEL)
-                                            (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (WORDDELETE.FORWARD.TTC 
-                                            (\TEDIT.WORDDELETE.FORWARD TEXTOBJ SEL)
-                                            (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (DELETE.TTC           (* ; 
-
                                                    "DEL Key handler: Delete the selected characters")

-                                                   (\TEDIT.DELETE TEXTOBJ SEL)
-                                                   (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (UNDO.TTC             (* ; 
-
                                                        "He hit the CANCEL key, so go UNDO something")

-                                                 (TEDIT.UNDO TEXTOBJ)
-                                                 (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (REDO.TTC             (* ; 
+                              (OR (EQ TCH T)
+                                  (SETQ CH TCH)))
+                          (SELECTC (AND CH (\SYNCODE (fetch
 READSA of
 (FGETTOBJ TEXTOBJ TXTRTBL))
+                                                  CH))
+                              (CHARDELETE.TTC 
+                                   (\TEDIT.CHARDELETE TSTREAM))
+                              (CHARDELETE.FORWARD.TTC 
+                                   (\TEDIT.CHARDELETE TSTREAM T))
+                              (WORDDELETE.TTC 
+                                   (\TEDIT.WORDDELETE TSTREAM))
+                              (WORDDELETE.FORWARD.TTC 
+                                   (\TEDIT.WORDDELETE.FORWARD TSTREAM))
+                              (DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
+                              (UNDO.TTC                      (* ; 
+
                                                  "Take off the BPD, the undoing and put it back on.")

+                                        (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
+                                        (TEDIT.UNDO TSTREAM))
+                              (REDO.TTC                      (* ; 
 
                                                          "He hit the REDO key, so go REDO something")

-                                                 (TEDIT.REDO TEXTOBJ)
-                                                 (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
-                                       (FUNCTIONCALL.TTC     (* ; 
+                                        (TEDIT.REDO TSTREAM)
+                                        (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ))
+                              (FUNCTIONCALL.TTC              (* ; 
 
                                                 "This is a special character -- it calls a function")

-                                            (CL:WHEN [SETQ FN (CAR (FETCH
 MACROFN
-                                                                      OF
 (GETHASH CH TEDITFNHASH]
+                                   (CL:WHEN [SETQ FN (CAR (fetch
 MACROFN
+                                                             of
 (GETHASH CH (fetch
 READMACRODEFS
+                                                                               of
 (FGETTOBJ TEXTOBJ 
+                                                                                         TXTRTBL]
                                                              (* ; 
 
                                                          "There IS a command function to be called.")

-                                                (APPLY* FN (FGETTOBJ TEXTOBJ STREAMHINT)
-                                                       TEXTOBJ SEL)
+                                       (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))
                                                              (* ; "do it")

                                                              (* ; 
 
                        "After a user function (that is not wheelscroll) no more blue-pending-delete")

 
-                                              (* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")

+                                       (* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")

 
-                                                (CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
-                                                               (MEMB CH CLIPBOARDCODES))
+                                       (CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
+                                                      (MEMB CH CLIPBOARDCODES))
                                                              (* ; 
 
                                    "The FNs handled the selection. should preserve the highlighting")

-                                                    (\TEDIT.SHOWSEL SEL NIL)
-                                                    (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
-                                                    (\TEDIT.SHOWSEL SEL T))))
-                                       (NEXT.TTC             (* ; 
-
                       "Move to the next blank to fill in.  For now, blanks are delimited by >>...<<")

-                                                 (TEDIT.NEXT TEXTOBJ))
-                                       (EXPAND.TTC           (* ; "EXPAND AN ABBREVIATION")

-                                                   (\TEDIT.ABBREV.EXPAND (FGETTOBJ TEXTOBJ STREAMHINT
-                                                                                )))
-                                       (SELECTC (AND TERMSA CH (fetch
 TERMCLASS
-                                                                  of
 (\SYNCODE TERMSA CH)))
-                                           (CHARDELETE.TC    (* ; 
-
                                       "Backspace handler: Remove the character just before SEL:CH#.")

-                                                          (\TEDIT.CHARDELETE TEXTOBJ SEL)
-                                                          (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL 
-                                                                 TEXTOBJ))
-                                           (WORDDELETE.TC    (* ; "Back-WORD handler")

-                                                          (\TEDIT.WORDDELETE TEXTOBJ)
-                                                          (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL 
-                                                                 TEXTOBJ))
-                                           (LINEDELETE.TC    (* ; 
-
                                                    "DEL Key handler: Delete the selected characters")

-                                                          (\TEDIT.DELETE TEXTOBJ SEL)
-                                                          (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL 
-                                                                 TEXTOBJ))
-                                           (CL:WHEN CH       (* ; 
+                                           (\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
+                                           (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
+                                           (\TEDIT.SHOWSEL NIL T TEXTOBJ))))
+                              (NEXT.TTC                      (* ; 
+
                                            "Move to the next blank to fill in, delimited by >>...<<")

+                                        (TEDIT.NEXT TSTREAM))
+                              (EXPAND.TTC                    (* ; "EXPAND AN ABBREVIATION")

+                                          (\TEDIT.ABBREV.EXPAND TSTREAM))
+                              (SELECTC (AND CH (fetch
 TERMCLASS of
 (\SYNCODE (OR (FGETTOBJ TEXTOBJ 
+                                                                                        TXTTERMSA)
+                                                                                 \PRIMTERMSA)
+                                                                          CH)))
+                                  (CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM))
+                                  (WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM))
+                                  (LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ))
+                                  (CL:WHEN CH                (* ; 
 
                                                             "Any other key: insert the character.")

-                                               (\TEDIT.INSERT CH SEL TEXTOBJ))])
-                         (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
-                  (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))))])
+                                      (\TEDIT.INSERT CH (TEXTSEL TEXTOBJ)
+                                             TSTREAM NIL T))])
+                (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
+            (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
 
 (\TEDIT.COMMAND.RESET.SETUP

-  [LAMBDA (TEXT&WIND STARTING)
                               (* ; "Edited 17-Mar-2024 18:54 by rmk")


+  [LAMBDA (ARGS STARTING)
                                    (* ; "Edited 29-Jun-2024 00:10 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 18:54 by rmk")


                                                              (* ; "Edited 22-Feb-2024 23:14 by rmk")


                                                              (* ; "Edited  5-Oct-2023 22:41 by rmk")


                                                              (* ; "Edited 22-Sep-2023 20:41 by rmk")


@@ -453,21 +393,20 @@
 
     (* ;; "If STARTING is T, set up the reset-driven connections and values for editing;  otherwise, break links and reset values for non-editing")

 
-    (PROG ((TEXTOBJ (CAR TEXT&WIND))
-           (PANES (CADR TEXT&WIND))
-           (OTTYWINDOW (CADDR TEXT&WIND))
-           (OTTYENTRYFN (CADDDR TEXT&WIND))
-           (OTTYEXITFN (CAR (CDDDDR TEXT&WIND)))
-           (OWINDOW (CADR (CDDDDR TEXT&WIND)))
-           TTYWINDOW)
+    (PROG ((TEXTOBJ (pop
 ARGS))
+           (OTTYWINDOW (pop
 ARGS))
+           (OTTYENTRYFN (pop
 ARGS))
+           (OTTYEXITFN (pop
 ARGS))
+           (OWINDOW (pop
 ARGS))
+           TTYWINDOW PRIMPANE)
+          (SETQ PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE))
           [COND
              (STARTING                                       (* ; 
 
                                           "We're going INTO the command loop.  Set up all the stuff")

                     (FSETTOBJ TEXTOBJ EDITOPACTIVE T)        (* ; 
 
                             "Mark us busy until we're set up, so that nobody tries any funny stuff.")

                     (SETQ OWINDOW (PROCESSPROP (THIS.PROCESS)
-                                         'WINDOW
-                                         (CAR PANES)))       (* ; 
+                                         'WINDOW PRIMPANE))  (* ; 
 
                                                             "Attach the process to this window.")

                     (\TEDIT.INTERRUPT.SETUP
 (THIS.PROCESS))  (* ; 
 
                                     "Disarm all interrupt chars, re-arm them when we leave the edit")

@@ -493,7 +432,7 @@
                                                              (* ; 
 
                           "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS")

                         (WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
-                        (WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR PANES)))
+                        (WINDOWPROP TTYWINDOW 'MAINWINDOW PRIMPANE))
                     (FSETTOBJ TEXTOBJ TXTEDITING T)          (* ; 
 
                                            "Tell TEdit that this document is actively being edited.")

                                                              (* ; 
@@ -502,21 +441,19 @@
              (T                                              (* ; 
 
                                                 "Coming OUT OF the command loop -- reset everything")

                 (PROCESSPROP (THIS.PROCESS)
-                       'WINDOW
-                       (CAR PANES))                          (* ; 
+                       'WINDOW PRIMPANE)                     (* ; 
 
                              "Detach the window from the edit process, to prevent circularity there")

-                (WINDOWPROP (CAR PANES)
-                       'PROCESS NIL)
+                (WINDOWPROP PRIMPANE 'PROCESS NIL)
                 (\TEDIT.INTERRUPT.SETUP
 (THIS.PROCESS)
                        T)                                    (* ; 
 
                                                     "Re-arm the interrupts we turned off coming in.")

-                (CL:WHEN [AND (TXTFILE TEXTOBJ)
-                              (NOT (fetch
 (TEXTWINDOW CLOSINGFILE) of
 (CAR PANES]
+                (CL:WHEN (AND (TXTFILE TEXTOBJ)
+                              (NOT (fetch
 (TEXTWINDOW CLOSINGFILE) of
 PRIMPANE)))
                                                              (* ; 
 
         "Remember to close the file we were editing (Only if the window function isn't closing it.)")

                     (CLOSEF? (TXTFILE TEXTOBJ))              (* ; 
 
                                                       "Let anyone else who wants to close the file.")

-                    (replace
 (TEXTWINDOW CLOSINGFILE) of
 (CAR PANES) with
 NIL))
+                    (replace
 (TEXTWINDOW CLOSINGFILE) of
 PRIMPANE with
 NIL))
                 (PROCESSPROP (THIS.PROCESS)
                        'TTYEXITFN OTTYEXITFN)
                 (PROCESSPROP (THIS.PROCESS)
@@ -532,7 +469,7 @@
                     (TTYDISPLAYSTREAM OTTYWINDOW)
                     (PROCESSPROP (THIS.PROCESS)
                            'TEDITTTYWINDOW NIL))]
-          (RETURN (LIST TEXTOBJ PANES OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
+          (RETURN (LIST TEXTOBJ OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
 )
 
 (RPAQ? TEDIT.INTERRUPTS
 '((2 BREAK)
@@ -974,12 +911,12 @@
 
 (\TEDIT.CLIPBOARD
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8457 30896 (\TEDIT.INTERRUPT.SETUP 8467 . 10114) (\TEDIT.MARKACTIVE 10116 . 10328) (
-\TEDIT.MARKINACTIVE 10330 . 10546) (\TEDIT.COMMAND.LOOP 10548 . 24296) (\TEDIT.COMMAND.RESET.SETUP 
-24298 . 30894)) (31180 46377 (\TEDIT.READTABLE 31190 . 32847) (\TEDIT.WORDBOUND.READTABLE 32849 . 
-35442) (TEDIT.GETSYNTAX 35444 . 37883) (TEDIT.SETSYNTAX 37885 . 40363) (TEDIT.GETFUNCTION 40365 . 
-41725) (TEDIT.SETFUNCTION 41727 . 44166) (TEDIT.WORDGET 44168 . 44429) (TEDIT.WORDSET 44431 . 45128) (
-TEDIT.ATOMBOUND.READTABLE 45130 . 46375)) (46705 47614 (\TEDIT.WHEELSCROLL 46715 . 47612)) (47767 
-53347 (\TEDIT.CLIPBOARD 47777 . 49532) (\TEDIT.COPYTOCLIPBOARD 49534 . 50314) (
-\TEDIT.EXTRACTTOCLIPBOARD 50316 . 50511) (\TEDIT.WRITE.SEL 50513 . 53345)))))
+  (FILEMAP (NIL (8312 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
+\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP 
+19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 . 
+31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 . 
+37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) (
+TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441 
+49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) (
+\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019)))))
 STOP

library/tedit/TEDIT-FIND

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Mar-2024 12:06:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;102
 30083  
+
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134
 36434  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.BASICFIND \TEDIT.BASICFIND.BACKWARD \TEDIT.WCFIND.BACKWARD)
+      :CHANGES-TO (FNS TEDIT.SUBSTITUTE)
 
-      :PREVIOUS-DATE "15-Mar-2024 14:10:05" {WMEDLEY}<library>tedit>TEDIT-FIND.;98)
+      :PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
 
 
 (PRETTYCOMPRINT TEDIT-FINDCOMS)
@@ -28,7 +28,9 @@
 (DEFINEQ
 
 (TEDIT.FIND

-  [LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS?)
        (* ; "Edited 19-Jun-2023 22:27 by rmk")


+  [LAMBDA (TSTREAM TARGET START END WILDCARDS?)
              (* ; "Edited 10-May-2024 21:55 by rmk")


+                                                             (* ; "Edited 24-Apr-2024 23:47 by rmk")


+                                                             (* ; "Edited 19-Jun-2023 22:27 by rmk")


                                                             (* ; "Edited  6-May-2018 17:34 by rmk:")


                                                              (* ; "Edited 30-May-91 20:56 by jds")

 
@@ -38,26 +40,30 @@
 
     (* ;; "RMK:  FIND isn't undoable, FIND-AGAIN is armed on meta-g.  No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")

 
-    (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
-    (CL:WHEN TARGETSTRING
-        (SETQ TARGETSTRING (MKSTRING TARGETSTRING))
-        (CL:UNLESS END
-            (SETQ END (TEXTLEN TEXTOBJ)))
-        (CL:UNLESS START
-            (SETQ START (TEDIT.GETPOINT TEXTOBJ)))
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:WHEN TARGET
 
         (* ;; "* and # are implicitly quoted if not WILDCARDS?  This could be handled simply by calling CONS  instead of  \TEDIT.PARSE.SEARCHSTRING")

 
-        (CL:WHEN (ILEQ START END)
-            (CL:IF WILDCARDS?
-                (\TEDIT.WCFIND
 (ffetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                       (\TEDIT.PARSE.SEARCHSTRING
 TARGETSTRING)
-                       START END)
-                (CAR (\TEDIT.BASICFIND
 (ffetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                            TARGETSTRING START END)))))])
+        [if
 (IMAGEOBJP TARGET)
+            then
 (TEDIT.FIND.OBJECT TSTREAM TARGET START END)
+          elseif
 [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
+            then
 (CL:UNLESS END
+                     (SETQ END (FGETTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)
+                                      TEXTLEN)))
+                 (CL:UNLESS START
+                     (SETQ START (TEDIT.GETPOINT TSTREAM)))
+                 (CL:WHEN (ILEQ START END)
+                     (CL:IF WILDCARDS?
+                         (\TEDIT.WCFIND
 TSTREAM (\TEDIT.PARSE.SEARCHSTRING
 TARGET)
+                                START END)
+                         (CAR (\TEDIT.BASICFIND
 TSTREAM TARGET START END))))])])
 
 (TEDIT.FIND.BACKWARD

-  [LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS? AGAIN)
  (* ; "Edited 12-Jul-2023 08:24 by rmk")


+  [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN)
        (* ; "Edited 19-May-2024 12:07 by rmk")


+                                                             (* ; "Edited 10-May-2024 22:00 by rmk")


+                                                             (* ; "Edited 24-Apr-2024 23:43 by rmk")


+                                                             (* ; "Edited 12-Jul-2023 08:24 by rmk")


                                                              (* ; "Edited 20-Jun-2023 12:12 by rmk")


                                                              (* ; "Edited 18-Jun-2023 23:43 by rmk")


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

@@ -66,197 +72,220 @@
 
     (* ;; "If WILDCARDS?, the value is the pair (MATCHSTART  MATCHEND) for that match, since the caller doesn't know the length.  But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long.  This is quirky, but that's the way it is documented.")

 
-    (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
-    (CL:WHEN [AND TARGETSTRING (NEQ 0 (NCHARS (SETQ TARGETSTRING (MKSTRING TARGETSTRING]
-        (SETQ START (IMAX 1 (OR START 1)))
-        (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TEXTOBJ)))
-                        (TEXTLEN TEXTOBJ)))
-        (CL:WHEN AGAIN
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:WHEN TARGET
+        [if
 (IMAGEOBJP TARGET)
+            then
 (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN)
+          elseif
 [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
+            then
 (SETQ START (IMAX 1 (OR START 1)))
+                 (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
+                                 (FGETTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)
+                                        TEXTLEN)))
+                 (CL:WHEN AGAIN
 
-            (* ;; "Assume that we aren't interested in another match at the current position.")

+                     (* ;; 
+
                     "Assume that we aren't interested in another match at the current position.")

 
-            (ADD
 END -1))
-        (CL:WHEN (ILEQ START END)
-            (CL:IF WILDCARDS?
-                (\TEDIT.WCFIND.BACKWARD
 (ffetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                       (DREVERSE (\TEDIT.PARSE.SEARCHSTRING
 TARGETSTRING))
-                       START END)
-                (CAR (\TEDIT.BASICFIND.BACKWARD
 (ffetch
 (TEXTOBJ STREAMHINT) of
 TEXTOBJ)
-                            TARGETSTRING START END)))))])
+                     (ADD
 END -1))
+                 (CL:WHEN (ILEQ START END)
+                     (CL:IF WILDCARDS?
+                         (\TEDIT.WCFIND.BACKWARD
 TSTREAM (\TEDIT.PARSE.SEARCHSTRING
 TARGET T)
+                                START END)
+                         (CAR (\TEDIT.BASICFIND.BACKWARD
 TSTREAM TARGET START END))))])])
 
 (TEDIT.SUBSTITUTE

-  [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?)
          (* ; "Edited 15-Mar-2024 14:09 by rmk")


+  [LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?)
             (* ; "Edited  8-Dec-2024 15:47 by rmk")


+                                                             (* ; "Edited 26-Nov-2024 23:49 by rmk")


+                                                             (* ; "Edited 15-Aug-2024 09:20 by rmk")


+                                                             (* ; "Edited 14-Jul-2024 00:24 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:46 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 10:49 by rmk")


+                                                             (* ; "Edited 18-May-2024 23:03 by rmk")


                                                              (* ; "Edited  9-Mar-2024 11:36 by rmk")


-                                                             (* ; "Edited  3-Mar-2024 12:24 by rmk")


-                                                             (* ; "Edited 29-Feb-2024 17:00 by rmk")


-                                                             (* ; "Edited 27-Feb-2024 08:20 by rmk")


+                                                             (* ; "Edited 12-May-2024 21:11 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 14:09 by rmk")


                                                              (* ; "Edited  6-Jan-2024 11:09 by rmk")


                                                              (* ; "Edited 12-Nov-2023 12:29 by rmk")


                                                              (* ; "Edited 22-Sep-2023 20:36 by rmk")


                                                              (* ; "Edited 31-May-2023 00:04 by rmk")


-                                                             (* ; "Edited 24-May-2023 20:01 by rmk")


                                                              (* ; "Edited 30-Mar-94 16:04 by jds")

+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
 
     (* ;; "Replace all instances of PATTERN with REPLACEMENT.  If CONFIRM?  is non-NIL, ask before each replacement.")

 
-    (CL:UNLESS (\TEDIT.READONLY TEXTSTREAM)
-        (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
-               (NREPLACEMENTS 0)
-               (YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
-               SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN 
-               ACTIONSTRING)
-              (CL:UNLESS [SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
-                                                               (\TEDIT.GET.TARGET.STRING TEXTOBJ
-                                                                      'TEDIT.LAST.SUBSTITUTE.STRING]
-                                                             (* ; 
-
                                                          "If the search pattern is empty, bail out.")

-                  (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
-                  (RETURN))
-              (CL:UNLESS REPLACEMENT
-                  [SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:" (GETTEXTPROP
-                                                                               TEXTOBJ
-                                                                               
-                                                                               '
+    (CL:UNLESS (\TEDIT.READONLY TSTREAM)
+        (RESETLST
+            (PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
+                   (NREPLACEMENTS 0)
+                   (YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
+                   SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
+                   ACTIONSTRING)
+
+             (* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string.  If the search pattern is empty, bail out.")

+
+                  [CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
+                                                                   (GETTEXTPROP TEXTOBJ 
+                                                                          '
+                                                                         TEDIT.LAST.SUBSTITUTE.STRING
+                                                                          ]
+                  (CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ 
+                                                                      "Replace string:"
+                                                                      (GETTEXTPROP TEXTOBJ
+                                                                             
+                                                                             '
                                                                         TEDIT.LAST.REPLACEMENT.STRING
-                                                                               ])
-              (if
 (type?
 SELPIECES REPLACEMENT)
-                elseif
 (OR (STRINGP REPLACEMENT)
-                           (LITATOM REPLACEMENT))
-                  then
 (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
-                elseif
 (LISTP REPLACEMENT)
-                  then
 (HELP "LISTP REPLACEMENT"))
+                                                                             ]
+                      (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
+                      (RETURN))
+                  [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
+                         '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
+                  (if
 (type?
 SELPIECES REPLACEMENT)
+                    elseif
 (OR (STRINGP REPLACEMENT)
+                               (LITATOM REPLACEMENT))
+                      then
 (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
 
-         (* ;; "Could be NIL or empty string, meaning just delete all occurrences.")

+             (* ;; "Could be NIL or empty string, meaning just delete all occurrences.")

 
-              (SETQ REPLACE-LEN (fetch
 (SELPIECES SPLEN) of
 REPLACEMENT))
-              (SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
-                                     "delet"
-                                     "substitut"))
+                  (SETQ REPLACE-LEN (fetch
 (SELPIECES SPLEN) of
 REPLACEMENT))
+                  (SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
+                                         "delet"
+                                         "substitut"))
 
-         (* ;; 
-
         "If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.")

+             (* ;; 
+
           "If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.")

 
-              (SETQ CONFIRMFLG (CL:IF PATTERN
-                                   CONFIRM?
-                                   (MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each " 
-                                                                          ACTIONSTRING "ion?")
-                                                  "No")
-                                          YESLIST)))
-              (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
-                                                "ing...")
-                     T)
-              (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
-              (\TEDIT.SHOWSEL SEL NIL)
-              (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
+                  (SETQ CONFIRMFLG (CL:IF PATTERN
+                                       CONFIRM?
+                                       (MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each " 
+                                                                              ACTIONSTRING "ion?")
+                                                      "No")
+                                              YESLIST)))
+                  (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
+                                                    "ing...")
+                         T)
+                  (SETQ SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ))
+                  (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                  (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
                                                              (* ; "Turn off any blue pending delete")

 
-         (* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")

+             (* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")

 
-              (SETQ STARTCHAR# (GETSEL SEL CH#))
-              [SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH]
-              [if
 CONFIRMFLG
-                  then
 
-                       (* ;; "In this case the selection moves along, ending up at the last hit.")

+                  (SETQ STARTCHAR# (GETSEL SEL CH#))
+                  [SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH))
+                                     (GETTOBJ TEXTOBJ TEXTLEN)
+                                     (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))]
+                  [if
 CONFIRMFLG
+                      then
 
+                           (* ;; "In this case the selection moves along, ending up at the last hit.")

 
-                       [bind
 PENDING.SEL CHOICE while
 (SETQ RANGE (TEDIT.FIND
 TEXTOBJ SEARCHSTRING 
-                                                                         STARTCHAR# ENDCHAR# T))
-                          do
                                 (* ; 
+                           [bind
 PENDING.SEL CHOICE while
 (SETQ RANGE (TEDIT.FIND
 TEXTOBJ 
+                                                                             SEARCHSTRING STARTCHAR#
+                                                                             ENDCHAR# T))
+                              do
                             (* ; 
 
                                                 "Show each substitution site and ask for permission")

-                             (SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
-                                                      (ADD1 (IDIFFERENCE (CADR RANGE)
-                                                                   (CAR RANGE)))
-                                                      'RIGHT T))
-                             (\TEDIT.SHOWSEL PENDING.SEL T)
-                             (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
-                             (SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ 
-                                                              "OK to replace? ['q' quits]" "Yes")
-                                                     1))
-                                 (Q (RETURN))
-                                 (Y                          (* ; "Do this one")

-                                    (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
-                                                                     'COPY TEXTOBJ)
-                                           TEXTOBJ PENDING.SEL)
-                                    (add
 NREPLACEMENTS 1)
-                                    (SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
+                                 (SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
+                                                          (ADD1 (IDIFFERENCE (CADR RANGE)
+                                                                       (CAR RANGE)))
+                                                          'RIGHT T))
+                                 (\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ)
+                                 (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
+                                 (SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ 
+                                                                  "OK to replace? ['q' quits]" "Yes")
+                                                         1))
+                                     (Q (RETURN))
+                                     (Y                      (* ; "Do this one")

+                                        (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
+                                                                         'COPY TEXTOBJ)
+                                               TEXTOBJ PENDING.SEL)
+                                        (add
 NREPLACEMENTS 1)
+                                        (SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
                                                              (* ; "Next start, compensate for end")

-                                    [add
 ENDCHAR# (IDIFFERENCE REPLACE-LEN (ADD1 (IDIFFERENCE
-                                                                                  (CADR RANGE)
-                                                                                  (CAR RANGE])
-                                 (PROGN 
-                                        (* ;; 
+                                        [add
 ENDCHAR# (IDIFFERENCE REPLACE-LEN
+                                                             (ADD1 (IDIFFERENCE (CADR RANGE)
+                                                                          (CAR RANGE])
+                                     (PROGN 
+                                            (* ;; 
 
    "Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")

 
-                                        (TEDIT.SHOWSEL TEXTOBJ NIL PENDING.SEL)
-                                        (SETQ STARTCHAR# (ADD1 (CAR RANGE]
-                else
 
-                     (* ;; "No confirmation required.  Do the substitutions without showing intermediate work, collect all of the replacement events")

+                                            (\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
+                                            (SETQ STARTCHAR# (ADD1 (CAR RANGE]
+                    else
 
+                         (* ;; "No confirmation required.  Do the substitutions without showing intermediate work, collect all of the replacement events")

 
-                     (bind
 FIRSTHIT HITLEN HITDIFF (TOTALDIFF _ 0)
-                           (SAVESEL _ (\TEDIT.COPYSEL SEL))
-                        while
 (SETQ RANGE (TEDIT.FIND
 TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T))
-                        collect
 (CL:UNLESS FIRSTHIT          (* ; "For final line updating.")

-                                    (SETQ FIRSTHIT (CAR RANGE)))
-                              [SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
-                                                        (CAR RANGE]
-                              (\TEDIT.UPDATE.SEL SEL (CAR RANGE)
-                                     HITLEN
-                                     'RIGHT)
-                              (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
-                                                               'COPY TEXTOBJ)
-                                     TEXTOBJ SEL)
-                              (add
 NREPLACEMENTS 1)
-                              (SETQ STARTCHAR# (GETSEL SEL CHLIM))
-                              (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
-                              (add
 ENDCHAR# HITDIFF)
-                              (add
 TOTALDIFF HITDIFF)
-                              (\TEDIT.POPEVENT TEXTOBJ)
-                        finally
 (CL:WHEN $$VAL
+                         (bind
 FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
+                               (SAVESEL _ (\TEDIT.COPYSEL SEL))
+                               EVENTS while
 (SETQ RANGE (TEDIT.FIND
 TEXTOBJ SEARCHSTRING STARTCHAR# 
+                                                               ENDCHAR# T))
+                            do
 (CL:UNLESS FIRSTHIT           (* ; "For final line updating.")

+                                   (SETQ FIRSTHIT (CAR RANGE)))
+                               [SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
+                                                         (CAR RANGE]
+                               (\TEDIT.UPDATE.SEL SEL (CAR RANGE)
+                                      HITLEN
+                                      'RIGHT)
+                               (\TEDIT.FIXSEL SEL TEXTOBJ)
+                               (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
+                                                                'COPY TEXTOBJ)
+                                      TEXTOBJ SEL)
+                               (push
 EVENTS (\TEDIT.POPEVENT TEXTOBJ)) 
+                                                             (* ; 
+
                                                          "Collect the events for a single composite")

+                               (add
 NREPLACEMENTS 1)
+                               (SETQ STARTCHAR# (GETSEL SEL CHLIM))
+                               (SETQ HITLAST STARTCHAR#)
+                               (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
+                               (add
 ENDCHAR# HITDIFF)
+                               (add
 TOTALDIFF HITDIFF)
+                            finally
 (CL:UNLESS (EQ NREPLACEMENTS 0)
 
-                                    (* ;; 
-
                                    "At least one replacement, update the lines that have changed.")

+                                        (* ;; 
+
                                      "At least one replacement, update the lines that have changed.")

 
-                                    (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
-                                           (IDIFFERENCE (GETSEL SEL CHLIM)
-                                                  FIRSTHIT))
+                                        (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
+                                               (IDIFFERENCE (GETSEL SEL CHLIM)
+                                                      FIRSTHIT))
 
-                                 (* ;; "We want the new selection to begin at the beginning of the original selection, somewhere before the first hit, and end at the position that the prior ending moved to.  The text grew or shrank with each hit.")

+                                 (* ;; "Not clear what the final selection should be, if there are multiple changes.  The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)?  Or just the selection of the last substitution?")

 
-                                    (\TEDIT.SHOWSEL SEL NIL)
-                                    (\TEDIT.UPDATE.SEL SEL (GETSEL SAVESEL CH#)
-                                           (IPLUS (GETSEL SAVESEL DCH)
-                                                  TOTALDIFF)
-                                           'RIGHT)
-                                    (\TEDIT.HISTORYADD TEXTOBJ (DREVERSE $$VAL)))]
+                                        (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                                        (\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
+                                                                               )
+                                               'RIGHT)
+                                        (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))]
 
-         (* ;; "Save the search & replacement strings to offer for next time:")

+             (* ;; "Save the search & replacement strings to offer for next time:")

 
-              (\TEDIT.SHOWSEL SEL T)
-              (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
-              (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING 
-                                                                         REPLACEMENT NIL TEXTOBJ))
-              (TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
-                                             (0 (CONCAT " No " ACTIONSTRING "ions made"))
-                                             (1 (CONCAT " 1 " ACTIONSTRING "ion made"))
-                                             (CONCAT " " (MKSTRING NREPLACEMENTS)
-                                                    " " ACTIONSTRING "ions made"))
-                     T)
-              (RETURN NREPLACEMENTS)))])
+                  (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                  (TEDIT.NORMALIZECARET TSTREAM SEL)
+                  (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
+                  (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
+                                                                       REPLACEMENT NIL TEXTOBJ))
+                  (TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
+                                                 (0 (CONCAT " No " ACTIONSTRING "ions made"))
+                                                 (1 (CONCAT " 1 " ACTIONSTRING "ion made"))
+                                                 (CONCAT " " (MKSTRING NREPLACEMENTS)
+                                                        " " ACTIONSTRING "ions made"))
+                         T)
+                  (RETURN NREPLACEMENTS))))])
 
 (TEDIT.NEXT

-  [LAMBDA (STREAM)
                                           (* ; "Edited 15-Mar-2024 13:34 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 21-Oct-2024 00:40 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:47 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:23 by rmk")


+                                                             (* ; "Edited 12-May-2024 21:10 by rmk")


                                                              (* ; "Edited 16-Feb-2024 23:48 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:34 by rmk")


                                                              (* ; "Edited 14-Dec-2023 21:20 by rmk")


                                                              (* ; "Edited 20-Jun-2023 00:05 by rmk")


                                                              (* ; "Edited  3-May-2023 23:47 by rmk")


                                                              (* ; "Edited 18-Apr-2023 23:46 by rmk")


                                                              (* ; "Edited 30-May-91 20:57 by jds")

-    (LET ((TEXTOBJ (TEXTOBJ STREAM))
+    (LET ((TEXTOBJ (TEXTOBJ TSTREAM))
           TARGET SEL OPTION FIELDSEL)
          (SETQ SEL (TEXTSEL TEXTOBJ))
          (SETQ TARGET (TEDIT.FIND
 TEXTOBJ ">>*<<" NIL NIL T))(* ; 
 
                                                             "find the first >>delimited<< field")

-         (SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (GETSEL SEL CH#)))
-                                                             (* ; 
+         (SETQ FIELDSEL (TEDIT.FIND
 TEXTOBJ "{*}" NIL NIL T))(* ; 
 
                                "find the first menu-type insertion field, usually delimited with {}")

          [SETQ OPTION (COND
                          [(AND TARGET FIELDSEL)              (* ; "take the first one")

@@ -273,28 +302,30 @@
                      (replace
 (TEXTOBJ BLUEPENDINGDELETE) of
 TEXTOBJ with
 T)
                                                              (* ; 
 
                                         "Original comment: %"never pending a deletion%", but it is!")

-                     (\TEDIT.SHOWSEL SEL NIL)                (* ; 
+                     (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)        (* ; 
 
                                                             "Set up SELECTION to be the found text")

                      (\TEDIT.UPDATE.SEL SEL (CAR TARGET)
                             (IDIFFERENCE (ADD1 (CADR TARGET))
                                    (CAR TARGET))
-                            'RIGHT)
-                     (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL)  (* ; "Always selected normally")

+                            'RIGHT
+                            'PENDINGDEL)
+                     (\TEDIT.FIXSEL SEL TEXTOBJ)             (* ; "Always selected normally")

                      (TEDIT.NORMALIZECARET TEXTOBJ)          (* ; "And get it into the window")

-                     (\TEDIT.SHOWSEL SEL T))
+                     (\TEDIT.SHOWSEL SEL T TEXTOBJ))
              (FIELD                                          (* ; 
 
   "Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")

                     (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
-                    (\TEDIT.SHOWSEL SEL NIL)                 (* ; 
+                    (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)         (* ; 
 
                                                             "Set SELECTION to be the found text")

                     (\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
                            (GETSEL FIELDSEL DCH)
-                           'LEFT)
-                    (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL)   (* ; "And get it into the window")

+                           'LEFT
+                           'PENDINGDEL)                      (* ; "And get it into the window")

+                    (\TEDIT.FIXSEL SEL TEXTOBJ)
                     (TEDIT.NORMALIZECARET TEXTOBJ))
              (NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
                       (SETQ SEL NIL))
-             (SHOULDNT "No legal value found in selectq in TEDIT.NEXT"))
+             (\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT"))
          (CL:WHEN SEL                                        (* ; 
 
                    "There really IS a selection made here, so set up the charlooks for it properly.")

              (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))])
@@ -307,192 +338,227 @@
 (DEFINEQ
 
 (\TEDIT.WCFIND

-  [LAMBDA (TSTREAM TARGETLIST START END HITSTART ANCHORED)
   (* ; "Edited 19-Jun-2023 23:50 by rmk")

+  [LAMBDA (TSTREAM TARGETLIST START END)
                     (* ; "Edited 26-Jun-2024 08:04 by rmk")


+                                                             (* ; "Edited 23-Jun-2024 12:00 by rmk")


+                                                             (* ; "Edited 19-May-2024 23:46 by rmk")


+                                                             (* ; "Edited  3-May-2024 07:11 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 20:45 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 11:59 by rmk")


+                                                             (* ; "Edited 20-Jun-2023 13:52 by rmk")

 
-    (* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITSTART is the first character of such a match")

+    (* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings.  This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.")

 
-    (CL:UNLESS (IGREATERP START END)
-        [LET (RESULT)
-             (COND
-                ((NULL TARGETLIST)                           (* ; "Final match")

-                 (LIST (OR HITSTART (SUB1 START))
-                       (SUB1 START)))
-                [(EQ '%# (CAR TARGETLIST))                   (* ; 
-
                                                    "Single-char wildcard, next segment is anchored ")

-                 (OR (\TEDIT.WCFIND
 TSTREAM (CDR TARGETLIST)
-                            (ADD1 START)
-                            END
-                            (OR HITSTART START)
-                            T)
-                     (CL:UNLESS ANCHORED                     (* ; 
-
                                                  "Initial # didn't match, let it slide in this loop")

-                         (for
 S from
 (ADD1 START) to
 END
-                            when
 (SETQ RESULT (\TEDIT.WCFIND
 TSTREAM TARGETLIST S END S T))
-                            do
 (RETURN RESULT)))]
-                ((EQ '* (CAR TARGETLIST))
+    (CL:WHEN TARGETLIST
+        [bind
 STACK CONFIG HITSTART ANCHORED RESULT TARGETTAIL TARGET (TOPSTART _ (SUB1 START))
+           do
 (SETQ CONFIG (pop
 STACK))
+              (if
 CONFIG
+                  then
 (SETQ START (pop
 CONFIG))
+                       (SETQ TARGETTAIL (pop
 CONFIG))
+                       (SETQ HITSTART (pop
 CONFIG))
+                       (SETQ ANCHORED (pop
 CONFIG))
+                elseif
 (IGEQ TOPSTART END)
+                  then
 (RETURN NIL)                          (* ; "No more, failed")

+                else
 (add
 TOPSTART 1)                        (* ; "First time or outer advance")

+                     (SETQ START TOPSTART)
+                     (SETQ TARGETTAIL TARGETLIST)
+                     (SETQ HITSTART NIL)
+                     (SETQ ANCHORED NIL))
+              (SETQ TARGET (CAR TARGETTAIL))
+              (SELECTQ TARGET
+                  (%# (CL:UNLESS (CDR TARGETTAIL)
+                          (RETURN (LIST (OR HITSTART START)
+                                        START)))
+                      (CL:WHEN (ILEQ START END)              (* ; 
+
                                                           "If we are unanchored, slipping continues")

+                          (push
 STACK (LIST (ADD1 START)
+                                            (CDR TARGETTAIL)
+                                            (OR HITSTART START)
+                                            ANCHORED))))
+                  (* 
+                     (* ;; "Unanchored config for the tail that starts here.")

 
-                 (* ;; "Variable width wildcard, not anchored so the match can slide along.")

-
-                 (\TEDIT.WCFIND
 TSTREAM (CDR TARGETLIST)
-                        START END HITSTART))
-                ((SETQ RESULT (\TEDIT.BASICFIND
 TSTREAM (CAR TARGETLIST)
-                                     START END ANCHORED))    (* ; 
-
                                                             "Matched a string segment, keep going")

-                 (\TEDIT.WCFIND
 TSTREAM (CDR TARGETLIST)
-                        (ADD1 (CADR RESULT))
-                        END
-                        (OR HITSTART (CAR RESULT])])
+                     (push
 STACK (LIST START (CDR TARGETTAIL)
+                                       HITSTART NIL)))
+                  (if
 (SETQ RESULT (\TEDIT.BASICFIND
 TSTREAM TARGET START END ANCHORED))
+                      then
 (CL:UNLESS (CDR TARGETTAIL)       (* ; "Success!")

+                               (RETURN (LIST (OR HITSTART (CAR RESULT))
+                                             (CADR RESULT))))
+                           (SETQ START (ADD1 (CADR RESULT))) (* ; "Next target")

+                           (CL:WHEN (ILEQ START END)
+                               [push
 STACK (LIST START (CDR TARGETTAIL)
+                                                 (OR HITSTART (CAR RESULT])
+                    elseif
 (NOT ANCHORED)
+                      then
 (RETURN NIL])])
 
 (\TEDIT.BASICFIND

-  [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED)
          (* ; "Edited 17-Mar-2024 12:06 by rmk")


+  [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED)
          (* ; "Edited 23-Jun-2024 12:03 by rmk")


+                                                             (* ; "Edited 22-Jun-2024 12:01 by rmk")


+                                                             (* ; "Edited 19-May-2024 23:18 by rmk")


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


                                                              (* ; "Edited 20-Jun-2023 00:11 by rmk")


                                                              (* ; "Edited 30-May-91 20:56 by jds")

 
-    (* ;; "Search thru TEXTOBJ, starting where the caret is, for an exact match of TARGETSTRING.  Optionally, start the search at character START. ")

+    (* ;; "Search thru TSTREAM for an exact match of TARGETSTRING.  ")

 
     (* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM")

 
     (bind
 LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING))
-          (CHAR1 _ (NTHCHARCODE TARGETSTRING 1))
-          (ANCHOR _ (SUB1 START)) first
 [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
+          (ANCHOR _ (SUB1 START)) first
 (CL:WHEN (ZEROP NCHARS)
+                                               (RETURN NIL))
+                                        [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
                                                                    ANCHOR
-                                                                   (IDIFFERENCE END NCHARS))]
-       eachtime
 (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR) 
+                                                                   (IDIFFERENCE END NCHARS))] 
 
-             (* ;; "Match failed, bump the start--single char wild-card # always matches")

- while
 [SETQ ANCHOR (find
 A from
 (ADD1 ANCHOR) to
 LASTANCHOR suchthat
 (EQ CHAR1 (BIN TSTREAM]
-       when
 [OR (EQ NCHARS 1)
-                (for
 I from
 2 to
 NCHARS always
 (EQ (NTHCHARCODE TARGETSTRING I)
-                                                   (BIN TSTREAM]
-       do
 (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
+                                        (* ;; "LASTANCHOR protects us from running into the EOF")

+ eachtime
 (CL:WHEN (IGEQ ANCHOR LASTANCHOR)
+                 (RETURN NIL))
+       (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
+       (add
 ANCHOR 1)                                        (* ; "Move the anchor up 1")

+
+       (* ;; "Match failed, bump the start--single char wild-card # always matches")

+
+        when
 (for
 I from
 1 do
 (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I)
+                                             (BIN TSTREAM))
+                                     (RETURN NIL))
+                              (CL:WHEN (EQ I NCHARS)         (* ; "Matched the last char")

+                                  (RETURN T))) do
 (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
 
 (\TEDIT.WCFIND.BACKWARD

-  [LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED)
     (* ; "Edited 17-Mar-2024 11:59 by rmk")


+  [LAMBDA (TSTREAM TARGETLIST START END)
                     (* ; "Edited 26-Jun-2024 08:05 by rmk")


+                                                             (* ; "Edited 23-Jun-2024 12:02 by rmk")


+                                                             (* ; "Edited 19-May-2024 23:46 by rmk")


+                                                             (* ; "Edited  3-May-2024 07:11 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 20:45 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 11:59 by rmk")


                                                              (* ; "Edited 20-Jun-2023 13:52 by rmk")

 
-    (* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITEND is the last character of such a match")

+    (* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings.  This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.")

 
-    (LET (RESULT)
-         (COND
-            ((NULL TARGETLIST)                               (* ; "Final match")

-             (LIST (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM))
-                   (OR HITEND END)))
-            [(EQ '%# (CAR TARGETLIST))                       (* ; 
-
                                                    "Single-char wildcard, next segment is anchored ")

-             (OR (\TEDIT.WCFIND.BACKWARD
 TSTREAM (CDR TARGETLIST)
-                        START
-                        (SUB1 END)
-                        (OR HITEND END)
-                        T)
-                 (CL:UNLESS ANCHORED                         (* ; 
-
                                                  "Initial # didn't match, let it slide in this loop")

-                     (for
 E from
 (SUB1 END) to
 START by
 -1
-                        when
 (SETQ RESULT (\TEDIT.WCFIND.BACKWARD
 TSTREAM TARGETLIST START E E T))
-                        do
 (RETURN RESULT)))]
-            ((EQ '* (CAR TARGETLIST))
+    (CL:WHEN TARGETLIST
+        [bind
 STACK CONFIG HITEND ANCHORED RESULT TARGETTAIL TARGET (TOPEND _ (ADD1 END))
+           do
 (SETQ CONFIG (pop
 STACK))
+              (if
 CONFIG
+                  then
 (SETQ END (pop
 CONFIG))
+                       (SETQ TARGETTAIL (pop
 CONFIG))
+                       (SETQ HITEND (pop
 CONFIG))
+                       (SETQ ANCHORED (pop
 CONFIG))
+                elseif
 (ILEQ TOPEND START)
+                  then
 (RETURN NIL)                          (* ; "No more, failed")

+                else
 (add
 TOPEND -1)                         (* ; "First time or outer advance")

+                     (SETQ END TOPEND)
+                     (SETQ TARGETTAIL TARGETLIST)
+                     (SETQ HITEND NIL)
+                     (SETQ ANCHORED NIL))
+              (SETQ TARGET (CAR TARGETTAIL))
+              (SELECTQ TARGET
+                  (%# (CL:UNLESS (CDR TARGETTAIL)
+                          (RETURN (LIST END (OR HITEND END))))
+                      (CL:WHEN (ILEQ START END)              (* ; 
+
                                                           "If we are unanchored, slipping continues")

+                          (push
 STACK (LIST (SUB1 END)
+                                            (CDR TARGETTAIL)
+                                            (OR HITEND (SUB1 END))
+                                            ANCHORED))))
+                  (* 
+                     (* ;; "Unanchored config for the tail that starts here.")

 
-             (* ;; "Variable width wildcard, not anchored so the match can slide along.")

-
-             (\TEDIT.WCFIND.BACKWARD
 TSTREAM (CDR TARGETLIST)
-                    START END HITEND))
-            ((SETQ RESULT (\TEDIT.BASICFIND.BACKWARD
 TSTREAM (CAR TARGETLIST)
-                                 START END ANCHORED))        (* ; 
-
                                                             "Matched a string segment, keep going")

-             (\TEDIT.WCFIND.BACKWARD
 TSTREAM (CDR TARGETLIST)
-                    START
-                    (SUB1 (CAR RESULT))
-                    (OR HITEND (CADR RESULT])
+                     (push
 STACK (LIST END (CDR TARGETTAIL)
+                                       HITEND NIL)))
+                  (if
 (SETQ RESULT (\TEDIT.BASICFIND.BACKWARD
 TSTREAM TARGET START END ANCHORED))
+                      then
 (CL:UNLESS (CDR TARGETTAIL)       (* ; "Success!")

+                               [RETURN (LIST (CAR RESULT)
+                                             (OR HITEND (CADR RESULT])
+                           (SETQ END (SUB1 (CADR RESULT)))   (* ; "Next target")

+                           (CL:WHEN (ILEQ START END)
+                               [push
 STACK (LIST END (CDR TARGETTAIL)
+                                                 (OR HITEND (CADR RESULT])
+                    elseif
 (NOT ANCHORED)
+                      then
 (RETURN NIL])])
 
 (\TEDIT.BASICFIND.BACKWARD

-  [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED)
          (* ; "Edited 17-Mar-2024 12:06 by rmk")


-                                                             (* ; "Edited 12-Jul-2023 08:14 by rmk")


-                                                             (* ; "Edited 23-Apr-2023 12:42 by rmk")

+  [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED)
          (* ; "Edited 23-Jun-2024 11:32 by rmk")


+                                                             (* ; "Edited 19-May-2024 23:07 by rmk")


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


+                                                             (* ; "Edited 20-Jun-2023 00:11 by rmk")


+                                                             (* ; "Edited 30-May-91 20:56 by jds")

 
-    (* ;; "Returns a (Startmatch Endmatch) pair of character positions in TSTREAM that denote the nearest occurrence of TARGETSTRING whose first character is at or ahead of START and whose last character is at or before END. ")

+    (* ;; "Seach backwards thru TSTREAM for an exact match of TARGETSTRING.")

 
-    (* ;; "A better interface would return a selection for the string-match, but we repeat the pair interface that is documented for forward search.")

+    (* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM")

 
-    (* ;; 
-
    "Note that caller must decrement END in subsequent calls to avoid looping on the same match.")

+    (bind
 LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING))
+          (ANCHOR _ (ADD1 END)) first
 (CL:WHEN (ZEROP NCHARS)
+                                             (RETURN NIL))
+                                      (CL:WHEN ANCHORED
+                                          (SETQ START (IDIFFERENCE ANCHOR NCHARS))) 
 
-    (* ;; "")

+                                      (* ;; "LASTANCHOR protects agains the beginning of the stream")

 
-    (* ;; "The last target character first matches at END.  Setting the initial ANCHOR one past END and going into the anchor backup loop won't work if END points to the last character in the stream--the \TEXTSETFILEPTR would be out of bounds.  So the first anchor-match has to be special, by setting the fileptr at END and peeking.")

-
-    [SETQ END (IMIN END (TEXTLEN (TEXTOBJ TSTREAM]
-    (bind
 ANCHOR LASTANCHOR (NCHARS1 _ (SUB1 (NCHARS TARGETSTRING)))
-          (CHARN _ (NTHCHARCODE TARGETSTRING -1))
-       first
 
-             (* ;; "NCHARS1 because the last character is matched separately.")

-
-             (CL:WHEN (ILESSP (IDIFFERENCE END START)
-                             NCHARS1)                        (* ; "Too few characters")

-                 (RETURN NIL))
-             (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 END))
-             (CL:WHEN [AND (EQ CHARN (\TEDIT.TEXTPEEKBIN TSTREAM))
-                           (OR (EQ NCHARS1 0)
-                               (for
 I from
 NCHARS1 to
 1 by
 -1 always
 (EQ (NTHCHARCODE TARGETSTRING I)
-                                                                         (\TEDIT.TEXTBACKFILEPTR
-                                                                          TSTREAM]
-                 (RETURN (LIST (IDIFFERENCE END NCHARS1)
-                               END)))
-             (CL:WHEN ANCHORED                               (* ; "Anchored at END, didn't match")

-                 (RETURN NIL))
-             (SETQ ANCHOR (SUB1 END))
-             (SETQ LASTANCHOR (IPLUS START NCHARS1)) eachtime
 (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
-                                                             (* ; 
-
                                                       "The filepos one before  the last CHARN match")

-                                                           (ADD
 ANCHOR -1) 
-                                                             (* ; "For next attempt")

-       while
 (find
 old
 ANCHOR from
 ANCHOR to
 LASTANCHOR by
 -1 suchthat
 (EQ CHARN (
-                                                                               \TEDIT.TEXTBACKFILEPTR
-                                                                                  TSTREAM)))
-       when
 [OR (EQ NCHARS1 0)
-                (for
 I from
 NCHARS1 to
 1 by
 -1 always
 (EQ (NTHCHARCODE TARGETSTRING I)
-                                                          (\TEDIT.TEXTBACKFILEPTR TSTREAM]
-       do
 (ADD
 ANCHOR 1)
-          (RETURN (LIST (IDIFFERENCE ANCHOR NCHARS1)
-                        ANCHOR])
+                                      [SETQ LASTANCHOR (SUB1 (CL:IF ANCHORED
+                                                                 ANCHOR
+                                                                 (IPLUS START NCHARS))]
+       eachtime
 (CL:WHEN (ILESSP ANCHOR LASTANCHOR)          (* ; "Won't fit in the frame")

+                    (RETURN NIL))
+             (add
 ANCHOR -1)                                 (* ; "Move the anchor back 1")

+             (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
+       when
 (for
 I from
 1 do
 (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I)
+                                            (\TEDIT.TEXTBACKFILEPTR TSTREAM))
+                                    (RETURN NIL))
+                             (CL:WHEN (EQ I NCHARS)          (* ; "Matched the last char")

+                                 (RETURN T))) do
 (RETURN (LIST (IDIFFERENCE (ADD1 ANCHOR)
+                                                                      NCHARS)
+                                                               ANCHOR])
 
 (\TEDIT.PARSE.SEARCHSTRING

-  [LAMBDA (TARGETSTRING)
                                     (* ; "Edited 19-Jun-2023 16:42 by rmk")

+  [LAMBDA (TARGETSTRING BACKWARD)
                            (* ; "Edited 23-Jun-2024 08:02 by rmk")


+                                                             (* ; "Edited 19-May-2024 22:43 by rmk")


+                                                             (* ; "Edited 19-Jun-2023 16:42 by rmk")

                                                              (* jds "31-Jan-84 13:26")

 
-    (* ;; 
-
    "Quote Is an escape if it comes before a wild card.  ''# would match ' in front of literal .")

+    (* ;; "Parse TARGETSTRING into string-segments that are separated by the wild-card characters # and * (or escape).  Each # is left as its own segment, multiple *'s collapse to one, and *'s on the edges are removed.   ' quotes the following character.")

 
-    (for
 TTAIL C SEG on
 (CHCON TARGETSTRING)
-       do
 (SETQ C (CAR TTAIL))
-          (SELCHARQ C
-               (%' (if
 (MEMB (CADR TTAIL)
-                             (CHARCODE (%# *
)))
-                       then
 (POP
 TTAIL)
-                            (PUSH
 SEG (CAR TTAIL))
-                     else
 (PUSH
 SEG C)))
-               (%# (CL:WHEN SEG
-                       (push
 $$VAL (CONCATCODES (DREVERSE SEG))))
-                   (push
 $$VAL (CHARACTER C))
-                   (SETQ SEG NIL))
-               (* (CL:UNLESS (EQ (CAR $$VAL)
-                                 '*)                         (* ; "Reduce adjacent *s to one.")

-                      (CL:WHEN SEG
-                          (push
 $$VAL (CONCATCODES (DREVERSE SEG))))
-                      (CL:UNLESS $$VAL                       (* ; "Ignore leading *")

-                          (push
 $$VAL (CHARACTER C)))
-                      (SETQ SEG NIL)))
-               (PUSH
 SEG C)) finally
 [if
 SEG
-                                         then
 (PUSH
 $$VAL (CONCATCODES (DREVERSE SEG)))
-                                       else
                  (* ; "Ignore trailing *")

-                                            (SETQ $$VAL (find
 VTAIL on
 $$VAL
-                                                           suchthat
 (NEQ (CAR $$VAL)
-                                                                         '*]
-                                   (RETURN (CL:IF $$VAL
-                                               (DREVERSE $$VAL)
-                                               TARGETSTRING)])
+    (* ;; "If BACKWARD, the search string segments are reverse, and the characters within each segment are reversed, so that the search can go backwards.")

+
+    (* ;; " ")

+
+    (for
 CTAIL C SEGCODES on
 (CHCON TARGETSTRING) eachtime
 (SETQ C (CAR CTAIL))
+       do
 (SELCHARQ C
+               ((* ESCAPE)                                   (* ; 
+
                                                            "Throw away the  first and multiiple *'s")

+                    (CL:WHEN SEGCODES
+                        [push
 $$VAL (CONCATCODES (CL:IF BACKWARD
+                                                     SEGCODES
+                                                     (DREVERSE SEGCODES))]
+                        (SETQ SEGCODES NIL))
+                    (CL:WHEN (AND $$VAL (NEQ '* (CAR $$VAL)))
+                        (push
 $$VAL '*)))
+               (%#                                           (* ; "# stands alone")

+                   (CL:WHEN SEGCODES
+                       [push
 $$VAL (CONCATCODES (CL:IF BACKWARD
+                                                    SEGCODES
+                                                    (DREVERSE SEGCODES))])
+                   (push
 $$VAL '%#)
+                   (SETQ SEGCODES NIL))
+               (%'                                           (* ; "Quote the next character")

+                   (CL:WHEN (CDR CTAIL)
+                       (push
 SEGCODES (CADR CTAIL))
+                       (SETQ CTAIL (CDR CTAIL))))
+               (push
 SEGCODES C)) finally
 (if
 SEGCODES
+                                              then
 [push
 $$VAL (CONCATCODES (CL:IF BACKWARD
+                                                                                SEGCODES
+                                                                                (DREVERSE SEGCODES))]
+                                            elseif
 (EQ '* (CAR $$VAL))
+                                              then
 
+                                                   (* ;; "Strip the first edge *")

+
+                                                   (pop
 $$VAL))
+                                        (RETURN (CL:IF BACKWARD
+                                                    $$VAL
+                                                    (DREVERSE $$VAL))])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (832 18922 (TEDIT.FIND 842 . 2482) (TEDIT.FIND.BACKWARD 2484 . 4297) (TEDIT.SUBSTITUTE 
-4299 . 14915) (TEDIT.NEXT 14917 . 18920)) (18955 30060 (\TEDIT.WCFIND 18965 . 20966) (\TEDIT.BASICFIND
- 20968 . 22446) (\TEDIT.WCFIND.BACKWARD 22448 . 24507) (\TEDIT.BASICFIND.BACKWARD 24509 . 28037) (
-\TEDIT.PARSE.SEARCHSTRING 28039 . 30058)))))
+  (FILEMAP (NIL (784 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE 
+5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND
+ 25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) (
+\TEDIT.PARSE.SEARCHSTRING 33332 . 36409)))))
 STOP

library/tedit/TEDIT-FNKEYS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "15-Mar-2024 14:07:55" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;74
 32961  
+
(FILECREATED "26-Nov-2024 23:53:32" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;101
 38718  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL \TEDIT.KEY.FIND)
+      :CHANGES-TO (FNS \TEDIT.KEY.FIND)
 
-      :PREVIOUS-DATE " 9-Mar-2024 11:47:31" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;69)
+      :PREVIOUS-DATE "23-Nov-2024 16:29:11" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;100)
 
 
 (PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
@@ -17,12 +17,14 @@
 
               (FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV 
                    \TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL 
-                   \TEDIT.KEY.FIND \TEDIT.GET.TARGET.STRING \TEDIT.KEY.FIND.BACKWARD 
-                   \TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN \TEDIT.ITALIC.SEL.OFF 
-                   \TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL \TEDIT.SHOWCARETLOOKS 
-                   \TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL \TEDIT.UCASE.SEL 
-                   \TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON \TEDIT.STRIKEOUT.SEL.ON 
-                   \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL \TEDIT.KEY.SUBSTITUTE))
+                   \TEDIT.KEY.FIND \TEDIT.KEY.FIND.SEARCHSTRING \TEDIT.GET.TARGET.STRING 
+                   \TEDIT.KEY.FIND.BACKWARD \TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN 
+                   \TEDIT.ITALIC.SEL.OFF \TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL 
+                   \TEDIT.SHOWCARETLOOKS \TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL
+                   \TEDIT.UCASE.SEL \TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON 
+                   \TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL 
+                   \TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED \TEDIT.ONECHAR.BACKWARD 
+                   \TEDIT.ONECHAR.FORWARD))
         (COMS 
               (* ;; "Auxiliary functions used in the above main functions:")

 
@@ -69,12 +71,16 @@
                              ("Function,^A" FN \TEDIT.SHOWCARETLOOKS)
                              ("Meta,a" FN \TEDIT.SELECT.ALL)
                              ("Meta,A" FN \TEDIT.SELECT.ALL)
+                             ("Meta,d" FN \TEDIT.MANPAGE)
+                             ("Meta,D" FN \TEDIT.MANPAGE)
                              ("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD)
                              ("Meta,f" FN \TEDIT.KEY.FIND)
                              ("Meta,g" FN \TEDIT.FINDAGAIN)
                              ("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD)
                              ("Meta,N" NEXT)
                              ("Meta,n" NEXT)
+                             ("Meta,o" FN \TEDIT.CALL.ED)
+                             ("Meta,O" FN \TEDIT.CALL.ED)
                              ("Meta,p" FN \TEDIT.PRINT.MENU)
                              ("Meta,P" FN \TEDIT.PRINT.MENU)
                              ("Meta,r" REDO)
@@ -84,7 +90,11 @@
                              ("Meta,U" FN \TEDIT.UNDO.UNDO)
                              ("Meta,u" UNDO)
                              ("Meta,z" UNDO)
-                             ("Meta,Z" \TEDIT.UNDO.UNDO]
+                             ("Meta,Z" \TEDIT.UNDO.UNDO)
+                             ("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
+                             ("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
+                             ("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
+                             ("Meta,." FN \TEDIT.ONECHAR.FORWARD]
         (P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
                                               (SELECTQ (CADR ENTRY)
                                                      (FN (TEDIT.SETFUNCTION (CAR ENTRY)
@@ -164,92 +174,125 @@
                                              NIL TEXTOBJ])
 
 (\TEDIT.KEY.FIND

-  [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD)
            (* ; "Edited 15-Mar-2024 13:36 by rmk")


+  [LAMBDA (TSTREAM TEXTOBJ SEL AGAIN BACKWARD SEARCHSTRING)
  (* ; "Edited 26-Nov-2024 23:47 by rmk")


+                                                             (* ; "Edited 23-Nov-2024 16:25 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:47 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 16:20 by rmk")


+                                                             (* ; "Edited 22-Jun-2024 10:00 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:29 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:36 by rmk")


+                                                             (* ; "Edited 24-Apr-2024 23:39 by rmk")


                                                              (* ; "Edited  9-Mar-2024 11:36 by rmk")


-                                                             (* ; "Edited 29-Feb-2024 17:06 by rmk")


-                                                             (* ; "Edited 27-Feb-2024 00:22 by rmk")


-                                                             (* ; "Edited 16-Feb-2024 23:43 by rmk")


                                                              (* ; "Edited 14-Dec-2023 21:14 by rmk")


                                                              (* ; "Edited 12-Jul-2023 08:26 by rmk")


                                                              (* ; "Edited 20-Jun-2023 13:06 by rmk")


                                                             (* ; "Edited  6-May-2018 17:14 by rmk:")


                                                              (* ; "Edited 30-May-91 21:05 by jds")

 
-    (* ;; "just calls the normal tedit.find starting at the right of the current selection.  SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).")

+    (* ;; "Case sensitive search, with * and # wildcards. Just calls the normal tedit.find starting at the right of the current selection.  SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).")

 
-    (* ;; "AGAIN suppresses confirmation of a previous target, but also assumes that the user is not interested in trying again at the current character position--starts forward or backward from there.")

+    (* ;; "AGAIN suppresses confirmation of a previous target.")

 
-    (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
-          TARGET CH)                                         (* ; 
-
                                                      "Case sensitive search, with * and # wildcards")

-
-         (* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property.  But then it would only pertain to a particular pane.  Better store it on the textobj.")

-
-         (CL:WHEN AGAIN
-             (SETQ TARGET (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING)))
-         (CL:UNLESS TARGET
-             (SETQ AGAIN NIL)                                (* ; 
-
                                                         "If no previous target, we aren't %"again%"")

-             [SETQ TARGET (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD
-                                                      "Backward search string: "
-                                                      "Search string: ")
-                                 (\TEDIT.GET.TARGET.STRING
 TEXTOBJ 'TEDIT.LAST.FIND.STRING])
-         (CL:WHEN TARGET
-             (CL:UNLESS SEL
-                 (SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
-             (\TEDIT.SHOWSEL SEL NIL)                        (* ; 
-
                                                            "Save for next search, even if not found")

-             (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING TARGET)
-             (SETQ CH (if
 BACKWARD
-                          then
 (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %"" TARGET
-                                                                 "%"")
-                                      T)
-                               (TEDIT.FIND.BACKWARD TEXTOBJ (MKSTRING TARGET)
-                                      NIL NIL T)
-                        else
 (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" TARGET "%"")
-                                    T)
-                             (TEDIT.FIND TEXTOBJ (MKSTRING TARGET)
-                                    NIL NIL T)))
-             (COND
-                (CH (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" found")
-                           T)                                (* ; "We found the target text.")

-                    (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (CL:UNLESS TEXTOBJ
+        (SETQ TEXTOBJ (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
+    (RESETLST
+        [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Find")
+               '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
+        (LET ((TEXTOBJ (TEXTOBJ TSTREAM))
+              CH)
+             (CL:UNLESS SEARCHSTRING
+                 (SETQ SEARCHSTRING (\TEDIT.KEY.FIND.SEARCHSTRING
 TEXTOBJ AGAIN BACKWARD)))
+             (CL:WHEN (AND SEARCHSTRING (IGEQ (NCHARS SEARCHSTRING)
+                                              1))
+                 (CL:UNLESS SEL
+                     (SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
+                 (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                 (SETQ CH (if
 BACKWARD
+                              then
 (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %"" 
+                                                                     SEARCHSTRING "%"")
+                                          T)
+                                   (TEDIT.FIND.BACKWARD TSTREAM (MKSTRING SEARCHSTRING)
+                                          NIL NIL T)
+                            else
 (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" SEARCHSTRING 
+                                                                   "%"")
+                                        T)
+                                 (TEDIT.FIND TSTREAM (MKSTRING SEARCHSTRING)
+                                        NIL NIL T)))
+                 (if
 CH
+                     then
 (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" found")
+                                 T)                          (* ; "We found the target text.")

+                          (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) 
                                                              (* ; 
 
                                                             "Set up SELECTION to be the found text")

-                    (\TEDIT.UPDATE.SEL SEL (CAR CH)
-                           (ADD1 (IDIFFERENCE (CADR CH)
-                                        (CAR CH)))
-                           (CL:IF BACKWARD
-                               'LEFT
-                               'RIGHT))
-                    (TEDIT.SET.SEL.LOOKS SEL (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY)
-                                                 'PENDINGDEL
-                                                 'NORMAL))
-                    [SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH)
-                                                      (CAR CH)
-                                                      'WORD
-                                                      'CHAR]
-                    (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
-                    (\TEDIT.FIXSEL SEL TEXTOBJ)
-                    (TEDIT.NORMALIZECARET TEXTOBJ))
-                (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" not found")
-                          T)))
-             (\TEDIT.SHOWSEL SEL T))])
+                          (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                          (\TEDIT.UPDATE.SEL SEL (CAR CH)
+                                 (ADD1 (IDIFFERENCE (CADR CH)
+                                              (CAR CH)))
+                                 (CL:IF BACKWARD
+                                     'LEFT
+                                     'RIGHT)
+                                 (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY)
+                                     'PENDINGDEL
+                                     'NORMAL))
+                          (\TEDIT.FIXSEL SEL TEXTOBJ)
+                          (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                          [SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH)
+                                                            (CAR CH)
+                                                            'WORD
+                                                            'CHAR]
+                          (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
+                          (TEDIT.NORMALIZECARET TEXTOBJ)
+                   else
 (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" not found")
+                               T))
+                 (\TEDIT.SHOWSEL SEL T TEXTOBJ))))])
+
+(\TEDIT.KEY.FIND.SEARCHSTRING

+  [LAMBDA (TEXTOBJ AGAIN BACKWARD)
                           (* ; "Edited 22-Jun-2024 10:17 by rmk")

+
+    (* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property.  But then it would only pertain to a particular pane.  Better store it on the textobj.")

+
+    (LET (SEARCHSTRING)
+         (CL:WHEN AGAIN
+             (SETQ SEARCHSTRING (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING)))
+         (CL:UNLESS SEARCHSTRING
+             (SETQ SEARCHSTRING (\TEDIT.GET.TARGET.STRING
 TEXTOBJ 'TEDIT.LAST.FIND.STRING))
+             (SETQ SEARCHSTRING (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD
+                                                            "Backward search string: "
+                                                            "Search string: ")
+                                       SEARCHSTRING))
+             (CL:WHEN SEARCHSTRING                           (* ; 
+
                                                            "Save for next search, even if not found")

+                 (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING SEARCHSTRING)))
+         SEARCHSTRING])
 
 (\TEDIT.GET.TARGET.STRING

-  [LAMBDA (TEXTOBJ PROP)
                                     (* ; "Edited 29-Feb-2024 17:08 by rmk")

+  [LAMBDA (TEXTOBJ PROP)
                                     (* ; "Edited 14-Jul-2024 00:09 by rmk")


+                                                             (* ; "Edited 23-Jun-2024 23:06 by rmk")


+                                                             (* ; "Edited 22-Jun-2024 12:03 by rmk")


+                                                             (* ; "Edited 29-Feb-2024 17:08 by rmk")

 
-    (* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN, TEDIT.SUBSTITUTE.  It tries to determine the best tentative target string for a search.  PROP is either TEDIT.LAST.FIND.STRING or TEDIT.LAST.SUBSTITUTE.STRING.")

+    (* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN.  It tries to determine the best tentative target string for a search.  PROP is presumably TEDIT.LAST.FIND.STRING.")

 
-    (* ;; "Current heuristic:  use selection if longer than 1 character, otherwise last search string.  Note that meta-G goes directly to the last search.")

+    (* ;; "Current heuristic:  If a previous string, use it if it contains wild cards, otherwise the current non-point selection.  Note that meta-G goes directly to the last search.")

 
-    (if
 (GETTEXTPROP TEXTOBJ PROP)
-        then
 (if
 (IGREATERP (GETSEL (GETTOBJ TEXTOBJ SEL)
-                                   DCH)
+    (* ;; "TEDIT.SUBSTITUTE doesn't call this because the current selection is the search domain")

+
+    (LET [(PREV (STRINGP (GETTEXTPROP TEXTOBJ PROP]
+         (if
 [AND PREV (find
 I from
 1 to
 (NCHARS PREV)
+                          suchthat
 (AND (MEMB (NTHCHARCODE PREV I)
+                                              (CHARCODE (%# ESCAPE *
)))
+                                        (NEQ (CHARCODE %')
+                                             (NTHCHARCODE PREV (SUB1 I]
+             then
 PREV
+           elseif
 (IGEQ (FGETSEL (FGETTOBJ TEXTOBJ SEL)
+                               DCH)
                         1)
-                 then
 (TEDIT.SEL.AS.STRING TEXTOBJ)
-               else
 (GETTEXTPROP TEXTOBJ PROP))
-      else
 (TEDIT.SEL.AS.STRING TEXTOBJ])
+             then
 
+                  (* ;; "TEDIT.SEL.AS.STRING breaks on image objects, should be fixed there.")

+
+                  (CAR (NLSETQ (TEDIT.SEL.AS.STRING TEXTOBJ)))
+           else
 PREV])
 
 (\TEDIT.KEY.FIND.BACKWARD

   [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN)
                     (* ; "Edited 20-Jun-2023 13:57 by rmk")


@@ -287,7 +330,8 @@
                  SEL])
 
 (\TEDIT.LCASE.SEL

-  [LAMBDA (STREAM TEXTOBJ SEL)
                               (* ; "Edited 15-Mar-2024 13:57 by rmk")


+  [LAMBDA (STREAM TEXTOBJ SEL)
                               (* ; "Edited  7-Jul-2024 09:05 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:57 by rmk")


                                                              (* ; "Edited  3-Mar-2024 12:28 by rmk")


                                                              (* ; "Edited 28-May-2023 00:34 by rmk")


                                                              (* ; "Edited 24-May-2023 22:46 by rmk")

@@ -296,7 +340,8 @@
 
     (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
                                                                                      \TEDIT.SELPIECES
-                                                                                      SEL))
+                                                                                      SEL NIL TEXTOBJ
+                                                                                      ))
                                      (FUNCTION L-CASECODE)
                                      NIL TEXTOBJ)
            TEXTOBJ SEL)
@@ -345,7 +390,8 @@
            SEL])
 
 (\TEDIT.UCASE.SEL

-  [LAMBDA (STREAM TEXTOBJ SEL)
                               (* ; "Edited 15-Mar-2024 13:57 by rmk")


+  [LAMBDA (STREAM TEXTOBJ SEL)
                               (* ; "Edited  7-Jul-2024 09:04 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:57 by rmk")


                                                              (* ; "Edited  3-Mar-2024 12:56 by rmk")


                                                              (* ; "Edited 28-May-2023 00:33 by rmk")


                                                              (* ; "Edited 24-May-2023 22:45 by rmk")

@@ -354,7 +400,8 @@
 
     (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
                                                                                      \TEDIT.SELPIECES
-                                                                                      SEL))
+                                                                                      SEL NIL TEXTOBJ
+                                                                                      ))
                                      (FUNCTION U-CASECODE)
                                      NIL TEXTOBJ)
            TEXTOBJ SEL)
@@ -382,8 +429,9 @@
            SEL])
 
 (\TEDIT.SELECT.ALL

-  [LAMBDA (TEXTSTREAM TEXTOBJ SEL)
                          (* ; "Edited  6-May-2018 12:41 by rmk:")

-    (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch
 TEXTLEN of
 TEXTOBJ))
+  [LAMBDA (TEXTSTREAM TEXTOBJ SEL)
                           (* ; "Edited 29-Jun-2024 15:05 by rmk")


+                                                            (* ; "Edited  6-May-2018 12:41 by rmk:")

+    (TEDIT.SETSEL TEXTSTREAM 1 (GETTOBJ TEXTOBJ TEXTLEN)
            'LEFT])
 
 (\TEDIT.KEY.SUBSTITUTE

@@ -392,6 +440,50 @@
     (* ;; "Stub for function-key")

 
     (TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T])
+
+(\TEDIT.MANPAGE

+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 25-Jun-2024 11:59 by rmk")


+                                                             (* ; "Edited 26-May-2024 21:53 by rmk")


+                                                             (* ; "Edited 25-May-2024 14:50 by rmk")

+
+    (* ;; "If meta-D is typed in an existing DINFO window, the new stuff comes up but then the window closes.  That could be debugged, but probably not worth it.  The DINFO window has its own links to things that it thought were worth indexing.")

+
+    (CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
+                      'DINFOGRAPH)
+        (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL)))])
+
+(\TEDIT.CALL.ED

+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 25-May-2024 15:03 by rmk")

+    (ED [MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
+        '(:DONTWAIT])
+
+(\TEDIT.ONECHAR.BACKWARD

+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 21-Nov-2024 20:31 by rmk")


+                                                             (* ; "Edited  1-Sep-2024 10:39 by rmk")

+    (TEXTOBJ! TEXTOBJ)
+    (SELECTION! SEL)
+    (LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
+         (CL:UNLESS (ILEQ PT 1)
+             (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+             (\TEDIT.UPDATE.SEL SEL (SUB1 PT)
+                    0)
+             (\TEDIT.FIXSEL SEL TEXTOBJ)
+             (\TEDIT.SHOWSEL SEL T TEXTOBJ))])
+
+(\TEDIT.ONECHAR.FORWARD

+  [LAMBDA (TSTREAM TEXTOBJ SEL)
                              (* ; "Edited 21-Nov-2024 20:31 by rmk")


+                                                             (* ; "Edited  1-Sep-2024 10:39 by rmk")

+
+    (* ;; "Moves caret to a point one character forward.")

+
+    (TEXTOBJ! TEXTOBJ)
+    (LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
+         (CL:UNLESS (IGEQ PT (TEXTLEN TEXTOBJ))
+             (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+             (\TEDIT.UPDATE.SEL SEL (ADD1 PT)
+                    0)
+             (\TEDIT.FIXSEL SEL TEXTOBJ)
+             (\TEDIT.SHOWSEL SEL T TEXTOBJ))])
 )
 
 
@@ -511,13 +603,14 @@
              (\TEDIT.SHOWCARETLOOKS
 TEXTSTREAM TEXTOBJ SEL))])
 
 (\TEDIT.STRIKEOUT.CARET.ON

-  [LAMBDA (TEXTSTREAM TEXTOBJ SEL)
                          (* ; "Edited 12-Jun-90 18:32 by mitani")

-    (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT ON)
-                         (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
-                         TEXTOBJ)))
-          (COND
-             (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
-                    (\TEDIT.SHOWCARETLOOKS
 TEXTSTREAM TEXTOBJ SEL])
+  [LAMBDA (TEXTSTREAM TEXTOBJ SEL)
                           (* ; "Edited 10-Aug-2024 16:31 by rmk")


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

+    (LET ((LOOKS (\TEDIT.CHANGE.CHARLOOKS.NEW '(STRIKEOUT ON)
+                        (fetch
 (TEXTOBJ CARETLOOKS) of
 TEXTOBJ)
+                        TEXTOBJ)))
+         (CL:WHEN LOOKS
+             (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
+             (\TEDIT.SHOWCARETLOOKS
 TEXTSTREAM TEXTOBJ SEL))])
 )
 
 
@@ -585,12 +678,16 @@
         ("Function,^A" FN \TEDIT.SHOWCARETLOOKS)
         ("Meta,a" FN \TEDIT.SELECT.ALL)
         ("Meta,A" FN \TEDIT.SELECT.ALL)
+        ("Meta,d" FN \TEDIT.MANPAGE)
+        ("Meta,D" FN \TEDIT.MANPAGE)
         ("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD)
         ("Meta,f" FN \TEDIT.KEY.FIND)
         ("Meta,g" FN \TEDIT.FINDAGAIN)
         ("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD)
         ("Meta,N" NEXT)
         ("Meta,n" NEXT)
+        ("Meta,o" FN \TEDIT.CALL.ED)
+        ("Meta,O" FN \TEDIT.CALL.ED)
         ("Meta,p" FN \TEDIT.PRINT.MENU)
         ("Meta,P" FN \TEDIT.PRINT.MENU)
         ("Meta,r" REDO)
@@ -600,7 +697,11 @@
         ("Meta,U" FN \TEDIT.UNDO.UNDO)
         ("Meta,u" UNDO)
         ("Meta,z" UNDO)
-        ("Meta,Z" \TEDIT.UNDO.UNDO)))
+        ("Meta,Z" \TEDIT.UNDO.UNDO)
+        ("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
+        ("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
+        ("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
+        ("Meta,." FN \TEDIT.ONECHAR.FORWARD)))
 
 [MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
                               (SELECTQ (CADR ENTRY)
@@ -609,21 +710,23 @@
                                   (TEDIT.SETSYNTAX (CAR ENTRY)
                                          (CADR ENTRY]
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5609 23249 (\TEDIT.BOLD.SEL.OFF 5619 . 5957) (\TEDIT.BOLD.SEL.ON 5959 . 6287) (
-\TEDIT.CENTER.SEL 6289 . 7805) (\TEDIT.CENTER.SEL.REV 7807 . 8103) (\TEDIT.DEFAULTS.CARET 8105 . 8598)
- (\TEDIT.DEFAULTSSEL 8600 . 9047) (\TEDIT.SETDEFAULT.FROM.SEL 9049 . 9726) (\TEDIT.KEY.FIND 9728 . 
-14757) (\TEDIT.GET.TARGET.STRING 14759 . 15623) (\TEDIT.KEY.FIND.BACKWARD 15625 . 15930) (
-\TEDIT.FINDAGAIN.BACKWARD 15932 . 16343) (\TEDIT.FINDAGAIN 16345 . 16636) (\TEDIT.ITALIC.SEL.OFF 16638
- . 16890) (\TEDIT.ITALIC.SEL.ON 16892 . 17085) (\TEDIT.LARGERSEL 17087 . 17375) (\TEDIT.LCASE.SEL 
-17377 . 18564) (\TEDIT.SHOWCARETLOOKS 18566 . 20166) (\TEDIT.SMALLERSEL 20168 . 20459) (
-\TEDIT.SUBSCRIPTSEL 20461 . 20664) (\TEDIT.SUPERSCRIPTSEL 20666 . 20870) (\TEDIT.UCASE.SEL 20872 . 
-22003) (\TEDIT.UNDERLINE.SEL.OFF 22005 . 22203) (\TEDIT.UNDERLINE.SEL.ON 22205 . 22401) (
-\TEDIT.STRIKEOUT.SEL.ON 22403 . 22599) (\TEDIT.STRIKEOUT.SEL.OFF 22601 . 22799) (\TEDIT.SELECT.ALL 
-22801 . 23024) (\TEDIT.KEY.SUBSTITUTE 23026 . 23247)) (23321 29730 (\TEDIT.BOLD.CARET.OFF 23331 . 
-23866) (\TEDIT.BOLD.CARET.ON 23868 . 24400) (\TEDIT.ITALIC.CARET.OFF 24402 . 24939) (
-\TEDIT.ITALIC.CARET.ON 24941 . 25484) (\TEDIT.LARGER.CARET 25486 . 26021) (\TEDIT.SMALLER.CARET 26023
- . 26560) (\TEDIT.SUBSCRIPT.CARET 26562 . 27103) (\TEDIT.SUPERSCRIPT.CARET 27105 . 27647) (
-\TEDIT.UNDERLINE.CARET.OFF 27649 . 28189) (\TEDIT.UNDERLINE.CARET.ON 28191 . 28729) (
-\TEDIT.STRIKEOUT.CARET.OFF 28731 . 29271) (\TEDIT.STRIKEOUT.CARET.ON 29273 . 29728)) (29799 30501 (
-\TK.DESCRIBEFONT 29809 . 30499)))))
+  (FILEMAP (NIL (6220 28574 (\TEDIT.BOLD.SEL.OFF 6230 . 6568) (\TEDIT.BOLD.SEL.ON 6570 . 6898) (
+\TEDIT.CENTER.SEL 6900 . 8416) (\TEDIT.CENTER.SEL.REV 8418 . 8714) (\TEDIT.DEFAULTS.CARET 8716 . 9209)
+ (\TEDIT.DEFAULTSSEL 9211 . 9658) (\TEDIT.SETDEFAULT.FROM.SEL 9660 . 10337) (\TEDIT.KEY.FIND 10339 . 
+15406) (\TEDIT.KEY.FIND.SEARCHSTRING 15408 . 16548) (\TEDIT.GET.TARGET.STRING 16550 . 18264) (
+\TEDIT.KEY.FIND.BACKWARD 18266 . 18571) (\TEDIT.FINDAGAIN.BACKWARD 18573 . 18984) (\TEDIT.FINDAGAIN 
+18986 . 19277) (\TEDIT.ITALIC.SEL.OFF 19279 . 19531) (\TEDIT.ITALIC.SEL.ON 19533 . 19726) (
+\TEDIT.LARGERSEL 19728 . 20016) (\TEDIT.LCASE.SEL 20018 . 21413) (\TEDIT.SHOWCARETLOOKS 21415 . 23015)
+ (\TEDIT.SMALLERSEL 23017 . 23308) (\TEDIT.SUBSCRIPTSEL 23310 . 23513) (\TEDIT.SUPERSCRIPTSEL 23515 . 
+23719) (\TEDIT.UCASE.SEL 23721 . 25060) (\TEDIT.UNDERLINE.SEL.OFF 25062 . 25260) (
+\TEDIT.UNDERLINE.SEL.ON 25262 . 25458) (\TEDIT.STRIKEOUT.SEL.ON 25460 . 25656) (
+\TEDIT.STRIKEOUT.SEL.OFF 25658 . 25856) (\TEDIT.SELECT.ALL 25858 . 26174) (\TEDIT.KEY.SUBSTITUTE 26176
+ . 26397) (\TEDIT.MANPAGE 26399 . 27155) (\TEDIT.CALL.ED 27157 . 27369) (\TEDIT.ONECHAR.BACKWARD 27371
+ . 27941) (\TEDIT.ONECHAR.FORWARD 27943 . 28572)) (28646 35157 (\TEDIT.BOLD.CARET.OFF 28656 . 29191) (
+\TEDIT.BOLD.CARET.ON 29193 . 29725) (\TEDIT.ITALIC.CARET.OFF 29727 . 30264) (\TEDIT.ITALIC.CARET.ON 
+30266 . 30809) (\TEDIT.LARGER.CARET 30811 . 31346) (\TEDIT.SMALLER.CARET 31348 . 31885) (
+\TEDIT.SUBSCRIPT.CARET 31887 . 32428) (\TEDIT.SUPERSCRIPT.CARET 32430 . 32972) (
+\TEDIT.UNDERLINE.CARET.OFF 32974 . 33514) (\TEDIT.UNDERLINE.CARET.ON 33516 . 34054) (
+\TEDIT.STRIKEOUT.CARET.OFF 34056 . 34596) (\TEDIT.STRIKEOUT.CARET.ON 34598 . 35155)) (35226 35928 (
+\TK.DESCRIBEFONT 35236 . 35926)))))
 STOP

library/tedit/TEDIT-HCPY

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Apr-2024 09:12:32" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;153
 33754  
+
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164
 32996  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
+      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
 
-      :PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;152)
+      :PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
 
 
 (PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -87,9 +87,11 @@
                  "Can't HARDCOPY:  No print server specified." T])
 
 (\TEDIT.PRINT.MENU

-  [LAMBDA (TSTREAM)
                                          (* ; "Edited 25-Jun-2023 13:16 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited 28-Jun-2024 22:09 by rmk")


+                                                             (* ; "Edited 25-Jun-2023 13:16 by rmk")


                                                              (* ; "Edited  6-Jun-2023 17:48 by rmk")

-    (LET [(W (CAR (fetch
 (TEXTOBJ \WINDOW) of
 (TEXTOBJ TSTREAM]
+    (LET ((W (GETTOBJ (TEXTOBJ TSTREAM)
+                    PRIMARYPANE)))
          (SELECTQ [MENU (create
 MENU
                                ITEMS _ '(("Print to a file" 'FILE 
                                               "Puts image on a file; prompts for filename and format"
@@ -101,7 +103,8 @@
              NIL])
 
 (TEDIT.HCPYFILE

-  [LAMBDA (TSTREAM FILE BREAKPAGETITLE)
                      (* ; "Edited  4-Oct-2022 09:23 by rmk")


+  [LAMBDA (TSTREAM FILE BREAKPAGETITLE)
                      (* ; "Edited 29-Jun-2024 16:33 by rmk")


+                                                             (* ; "Edited  4-Oct-2022 09:23 by rmk")


                                                              (* ; "Edited  1-Oct-2022 22:12 by rmk")


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

 
@@ -125,10 +128,14 @@
                                                                'HCPY)
                                                            'BODY
                                                            (fetch
 (STREAM FULLFILENAME) of
 TXTFILE]
-                (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
+             (if
 FILENM
+                 then
 (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
+               else
 (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
 
 (\TEDIT.HARDCOPY.DISPLAYLINE

-  [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE)
     (* ; "Edited 19-Apr-2024 09:09 by rmk")


+  [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE)
     (* ; "Edited 13-Dec-2024 23:49 by rmk")


+                                                             (* ; "Edited 13-Jun-2024 17:13 by rmk")


+                                                             (* ; "Edited 19-Apr-2024 09:09 by rmk")


                                                              (* ; "Edited 20-Mar-2024 11:04 by rmk")


                                                              (* ; "Edited 15-Mar-2024 19:23 by rmk")


                                                              (* ; "Edited 24-Dec-2023 22:07 by rmk")


@@ -151,16 +158,16 @@
                       (FGETTOBJ TEXTOBJ TEXTLEN))
         [LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
              (CL:UNLESS (EQ LINE (fetch
 DESC of
 THISLINE))
-                 (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
+                 (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
+                        (FGETLD LINE LCHAR1)
                         LINE REGION PRSTREAM FORMATTINGSTATE))
 
              (* ;; "Use the characters cached in THISLINE.")

 
-             (for
 CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch
 (THISLINE
-                                                                                          
+             (for
 CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch
 (THISLINE 
                                                                                         TLSPACEFACTOR
-                                                                                          )
-                                                                                     of
 THISLINE))
+                                                                                           )
+                                                                                of
 THISLINE))
                   (FIRST-SCALEDSPACE-SLOT _ (ffetch
 (THISLINE TLFIRSTSPACE) of
 THISLINE))
                   (SCALE _ (DSPSCALE NIL PRSTREAM))
                   (TX _ (FGETLD LINE LX1)) incharslots
 THISLINE first
 (DSPSPACEFACTOR 1 PRSTREAM)
@@ -225,11 +232,7 @@
                                                                                          )
                                                                               of
 CLOOKS]
                                                     (T (FGETLD LINE YBASE]
-                                      (DSPYPOSITION CURY PRSTREAM)
-                                      (CL:WHEN (SETQ KERN (LISTGET (fetch
 (CHARLOOKS CLUSERINFO)
-                                                                      of
 CLOOKS)
-                                                                 'KERN))
-                                          (SETQ KERN (HCSCALE SCALE KERN))) 
+                                      (DSPYPOSITION CURY PRSTREAM) 
 
                                       (* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")

 
@@ -253,6 +256,8 @@
 
                                         (SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC
 CHARSLOT THISLINE 
                                                            PRSTREAM))
+                                 elseif
 (EQ 'KERN CHAR)
+                                   then
 (RELMOVETO 0 CHARW PRSTREAM)
                                  else
 (\OUTCHAR PRSTREAM CHAR))
                                (add
 TX CHARW))) finally
 
 
@@ -272,13 +277,14 @@
 
 (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS

   [LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)

+                                                             (* ; "Edited 26-Oct-2024 11:04 by rmk")


                                                              (* ; "Edited 17-Mar-2024 17:22 by rmk")


                                                              (* ; "Edited 19-Jan-2024 23:19 by rmk")


                                                              (* ; "Edited  3-Oct-2022 13:05 by rmk")

 
     (* ;; "Return setup LINE to skip a sequence of heading pieces STATE")

 
-    (SELECTQ (fetch
 (FMTSPEC FMTPARATYPE) of
 FMTSPEC)
+    (SELECTQ (GETPARA FMTSPEC FMTPARATYPE)
         (PAGEHEADING 
                      (* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")

 
@@ -287,11 +293,11 @@
                      T)
         (EVEN                                                (* ; "Skip an odd page.")

               (CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
-                  (TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
+                  (\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
                   T))
         (ODD                                                 (* ; "Skip an even page")

              (CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
-                 (TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
+                 (\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
                  T))
         NIL])
 
@@ -337,7 +343,8 @@
     (MOVETO CURX CURY PRSTREAM])
 
 (\TEDIT.HCPYFMTSPEC

-  [LAMBDA (SPEC IMAGESTREAM)
                                 (* ; "Edited 15-Mar-2024 19:34 by rmk")


+  [LAMBDA (DISPLAYFMT IMAGESTREAM)
                           (* ; "Edited 28-Jul-2024 22:25 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 19:34 by rmk")


                                                              (* ; "Edited  7-Mar-2023 21:03 by rmk")


                                                              (* ; "Edited  6-Mar-2023 15:14 by rmk")


                                                              (* ; "Edited 20-Oct-2022 22:35 by rmk")


@@ -346,44 +353,31 @@
 
     (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent.  (Special positions are made paper-relative first.).  ")

 
-    (LET ((SCALE (DSPSCALE NIL IMAGESTREAM))
-          FMTSPEC)
-         [SETQ FMTSPEC (create
 FMTSPEC using
 SPEC FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
-                                             (HCSCALE SCALE (fetch
 (FMTSPEC 1STLEFTMAR) of
 SPEC))
-                                             LEFTMAR _ (HCSCALE SCALE (fetch
 (FMTSPEC LEFTMAR)
-                                                                         of
 SPEC))
-                                             RIGHTMAR _ (HCSCALE SCALE (fetch
 (FMTSPEC RIGHTMAR)
-                                                                          of
 SPEC))
-                                             QUAD _ (fetch
 (FMTSPEC QUAD) of
 SPEC)
-                                             TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE)
-                                             FMTSPECIALX _ (AND (fetch
 (FMTSPEC FMTSPECIALX)
-                                                                   of
 SPEC)
-                                                                (HCSCALE SCALE
-                                                                       (SCALEPAGEUNITS
-                                                                        (fetch
 (FMTSPEC FMTSPECIALX)
-                                                                           of
 SPEC)
-                                                                        1.0 NIL)))
-                                             FMTSPECIALY _ (AND (fetch
 (FMTSPEC FMTSPECIALY)
-                                                                   of
 SPEC)
-                                                                (HCSCALE SCALE
-                                                                       (SCALEPAGEUNITS
-                                                                        (fetch
 (FMTSPEC FMTSPECIALY)
-                                                                           of
 SPEC)
-                                                                        1.0 NIL)))
-                                             LEADBEFORE _ (HCSCALE SCALE (fetch
 (FMTSPEC LEADBEFORE)
-                                                                            of
 SPEC))
-                                             LEADAFTER _ (HCSCALE SCALE (fetch
 (FMTSPEC LEADAFTER)
-                                                                           of
 SPEC))
-                                             LINELEAD _ (HCSCALE SCALE (fetch
 (FMTSPEC LINELEAD)
-                                                                          of
 SPEC))
-                                             FMTBASETOBASE _ (AND (fetch
 (FMTSPEC FMTBASETOBASE)
-                                                                     of
 SPEC)
-                                                                  (HCSCALE SCALE (fetch
 (FMTSPEC
-                                                                                         
-                                                                                        FMTBASETOBASE
-                                                                                         )
-                                                                                    of
 SPEC]
-         FMTSPEC])
+    (LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
+          (create
 FMTSPEC using
 DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
+                                (HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR))
+                                LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR))
+                                RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR))
+                                QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT)
+                                FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB))
+                                FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS)
+                                                 SCALE)
+                                FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX)
+                                                   (HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA 
+                                                                                         DISPLAYFMT 
+                                                                                         FMTSPECIALX)
+                                                                         1.0 NIL)))
+                                FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY)
+                                                   (HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA 
+                                                                                         DISPLAYFMT 
+                                                                                         FMTSPECIALY)
+                                                                         1.0 NIL)))
+                                LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE))
+                                LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER))
+                                LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD))
+                                FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE)
+                                                     (HCSCALE SCALE (FGETPARA DISPLAYFMT 
+                                                                           FMTBASETOBASE])
 
 (\TEDIT.INTEGER.IMAGEBOX

   [LAMBDA (OLDBOX)                                           (* jds "23-Oct-84 13:52")

@@ -451,7 +445,9 @@
 (DEFINEQ
 
 (TEDIT.HARDCOPYFN

-  [LAMBDA (WINDOW IMAGESTREAM)
                               (* ; "Edited 20-Mar-2024 10:49 by rmk")


+  [LAMBDA (WINDOW IMAGESTREAM)
                               (* ; "Edited 13-Dec-2024 22:33 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 14:42 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 10:49 by rmk")


                                                              (* ; "Edited 25-Sep-2023 16:29 by rmk")


                                                              (* ; "Edited  4-Jul-2023 11:16 by rmk")


                                                             (* ; "Edited 21-Sep-2021 15:33 by rmk:")

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

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

 
-         (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
-             (SETQ WINDOW (\TEDIT.MAINW WINDOW))
-             (SETQ TEXTOBJ (fetch
 (TEXTWINDOW WTEXTOBJ) of
 WINDOW)))
-         (RESETLST
-             [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
-                    '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
-             (FSETTOBJ TEXTOBJ EDITOPACTIVE 'Hardcopy)       (* ; "Build the hardcopy")

-             (SETQ WASDIRTY (FGETTOBJ TEXTOBJ \DIRTY))
-             (PROG1 (TEDIT.FORMAT.HARDCOPY WINDOW IMAGESTREAM)
-                    (FSETTOBJ TEXTOBJ \DIRTY WASDIRTY)))])
+         (TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW)
+                                              MENUFLG)
+                                    (\TEDIT.MAINW WINDOW)
+                                    WINDOW)
+                IMAGESTREAM])
 
 (\TEDIT.HARDCOPYFILEFN

   [LAMBDA (W EXT)
                                            (* ; "Edited 25-Sep-2023 16:19 by rmk")

@@ -566,11 +555,11 @@
          (CLOSEF DOC])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3475 26808 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5474) (TEDIT.HCPYFILE
- 5476 . 7416) (\TEDIT.HARDCOPY.DISPLAYLINE 7418 . 17356) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17358 . 
-18765) (\TEDIT.HARDCOPY.MODIFYLOOKS 18767 . 21001) (\TEDIT.HCPYFMTSPEC 21003 . 25137) (
-\TEDIT.INTEGER.IMAGEBOX 25139 . 25810) (\TEDIT.DISPLAY.DIACRITIC 25812 . 26806)) (26883 27713 (
-\TEDIT.SCALEREGION 26893 . 27711)) (27972 31667 (TEDIT.HARDCOPYFN 27982 . 29442) (
-\TEDIT.HARDCOPYFILEFN 29444 . 30005) (\TEDIT.POSTSCRIPT.HARDCOPY 30007 . 30938) (\TEDIT.PRESS.HARDCOPY
- 30940 . 31665)) (32930 33731 (TEDIT-BOOK 32940 . 33729)))))
+  (FILEMAP (NIL (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE
+ 5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 . 
+19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) (
+\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 (
+\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) (
+\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY
+ 30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971)))))
 STOP

library/tedit/TEDIT-HISTORY

@@ -1,21 +1,25 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154
 33348  
+
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219
 53094  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.UNDO)
+      :CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO 
+                       TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE
+                       \TEDIT.COMPOSITE.EVENT)
+                  (VARS TEDIT-HISTORYCOMS)
+                  (MACROS \TEDIT.HISTORYADD1)
 
-      :PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
+      :PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
 
 
 (PRETTYCOMPRINT TEDIT-HISTORYCOMS)
 
 (RPAQQ TEDIT-HISTORYCOMS

        ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT)
-                                                (MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH)
-                                                ))
+                                                (MACROS \TEDIT.LASTEVENT GETTH SETTH)))
         (FNS \TEDIT.HISTORYEVENT.DEFPRINT)
+        (MACROS \TEDIT.HISTORYADD1)
         (INITRECORDS TEDITHISTORYEVENT)
         (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
         (INITVARS (TEDIT.HISTORY.TYPELST NIL)
@@ -23,13 +27,16 @@
         (COMS 
               (* ;; "History-list maintenance functions")

 
-              (FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
+              (FNS \TEDIT.HISTORYADD \TEDIT.HISTORYADD.COMPOSITE \TEDIT.CUMULATE.EVENTS 
+                   \TEDIT.COMPOSITE.EVENT \TEDIT.HISTORY.PROP \TEDIT.HISTORY.EVENT \TEDIT.POPEVENT))
         (COMS 
               (* ;; "Specialized UNDO & REDO functions.")

 
               (FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
-              (FNS \TEDIT.UNDO.INSERTION \TEDIT.UNDO.DELETION \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE)
-              (FNS \TEDIT.REDO.INSERTION \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE))))
+              (FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE 
+                   \TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS 
+                   \TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE)
+              (FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
@@ -47,16 +54,16 @@
                              NIL                             (* ; 
 
                                  "Was THAUXINFO: Auxiliary info about the event, primarily for redo")

                              THDELETEDPIECES)
-                            [ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (AND (fetch
 (TEDITHISTORYEVENT
-                                                                                THCH#) of
 DATUM)
-                                                                        (IPLUS (fetch
 (
+                            [ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch
 (
                                                                                     TEDITHISTORYEVENT
-                                                                                       THCH#)
-                                                                                  of
 DATUM)
-                                                                               (fetch
 (
+                                                                                      THCH#)
+                                                                                 of
 DATUM)
+                                                                              0)
+                                                                          (OR (fetch
 (
                                                                                     TEDITHISTORYEVENT
-                                                                                       THLEN)
-                                                                                  of
 DATUM]
+                                                                                      THLEN)
+                                                                                 of
 DATUM)
+                                                                              0]
                             (INIT (DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT
                                                                 )))
                             THPOINT _ 'LEFT)
@@ -80,9 +87,6 @@
 (PUTPROPS \TEDIT.LASTEVENT
 MACRO
 ((TOBJ)
                                   (CAR (fetch
 (TEXTOBJ TXTHISTORY) of
 TOBJ))))
 
-(PUTPROPS \TEDIT.POPEVENT
 MACRO
 ((TOBJ)
-                                 (pop
 (fetch
 (TEXTOBJ TXTHISTORY) of
 TOBJ))))
-
 (PUTPROPS GETTH
 MACRO
 ((EVENT FIELD)
                        (fetch
 (TEDITHISTORYEVENT FIELD) of
 EVENT)))
 
@@ -114,6 +118,15 @@
                       (CDR LOC)
                       "}"])
 )
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS \TEDIT.HISTORYADD1
 MACRO
 ((TEXTOBJ EVENT)
+
+                                    (* ;; "This is the primitive, to be upgraded if we go to a ring.")

+
+                                    (push
 (FGETTOBJ TEXTOBJ TXTHISTORY)
+                                          EVENT)))
+)
 
 (/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
                                              POINTER)
@@ -144,7 +157,11 @@
 (DEFINEQ
 
 (\TEDIT.HISTORYADD

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  3-Mar-2024 12:15 by rmk")


+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  8-Dec-2024 17:32 by rmk")


+                                                             (* ; "Edited 29-Aug-2024 12:30 by rmk")


+                                                             (* ; "Edited 11-Aug-2024 21:57 by rmk")


+                                                             (* ; "Edited 30-Apr-2024 22:51 by rmk")


+                                                             (* ; "Edited  3-Mar-2024 12:15 by rmk")


                                                              (* ; "Edited 19-Feb-2024 12:09 by rmk")


                                                              (* ; "Edited 30-Dec-2023 22:19 by rmk")


                                                              (* ; "Edited 11-Aug-2023 14:25 by rmk")


@@ -158,55 +175,73 @@
 
     (* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards.  Old code seemed to treat those as separate events, and  only the second/right one could be undone.")

 
-    (CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY))
-        (if
 (type?
 TEDITHISTORYEVENT EVENT)
-            then
 (CL:WHEN (MEMB (GETTH EVENT THACTION)
-                                (CONSTANT (LIST :Put :Get))) (* ; 
+    (if
 (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
+        then
 
+             (* ;; "Maybe the first event after setting the textprop--now's the time to flush")

+
+             (FSETTOBJ TEXTOBJ TXTHISTORY NIL)
+             (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
+      else
 (if
 (type?
 TEDITHISTORYEVENT EVENT)
+               then
 (CL:WHEN (MEMB (GETTH EVENT THACTION)
+                                   (CONSTANT (LIST :Put :Get)))
+                                                             (* ; 
 
                                                     "Can't back up over Put/Get, flush the history.")

-                     (FSETTOBJ TEXTOBJ TXTHISTORY NIL)) 
+                        (FSETTOBJ TEXTOBJ TXTHISTORY NIL)) 
 
-                 (* ;; "Somebody may have already done there own fixup.")

+                    (* ;; "Somebody may have already done there own fixup.")

 
-                 (LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
-                      (CL:WHEN (AND (type?
 TEDITHISTORYEVENT OLDEVENT)
-                                    (EQ :Delete (GETTH EVENT THACTION))
-                                    (EQ :Delete (GETTH OLDEVENT THACTION)))
+                    (LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
+                         (CL:WHEN (AND (type?
 TEDITHISTORYEVENT OLDEVENT)
+                                       (EQ :Delete (GETTH EVENT THACTION))
+                                       (EQ :Delete (GETTH OLDEVENT THACTION)))
 
-                          (* ;; 
-
                          "Repeated successive deletions, we can combine them if they are adjacent.")

+                             (* ;; 
+
                           "Repeated successive deletions, we can combine them if they are adjacent.")

 
-                          (CL:WHEN (IEQP (GETTH EVENT THCHLIM)
-                                         (GETTH OLDEVENT THCH#))
+                             (CL:WHEN (IEQP (GETTH EVENT THCHLIM)
+                                            (GETTH OLDEVENT THCH#))
                                                              (* ; 
 
                                                           "OLDEVENT is first, EVENT is still delete")

-                              (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 EVENT OLDEVENT TEXTOBJ))
-                              (\TEDIT.POPEVENT TEXTOBJ)      (* ; "Pop OLDEVENT before repushing")

-                              (SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
+                                 (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 EVENT OLDEVENT TEXTOBJ))
+                                 (\TEDIT.POPEVENT
 TEXTOBJ)   (* ; "Pop OLDEVENT before repushing")

+                                 (SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
 
-                          (* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")

+                             (* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")

 
-                          (CL:WHEN [AND OLDEVENT (type?
 TEDITHISTORYEVENT OLDEVENT)
-                                        (EQ :Delete (GETTH OLDEVENT THACTION))
-                                        (IEQP (GETTH OLDEVENT THCHLIM)
-                                              (IPLUS (GETTH EVENT THCH#)
-                                                     (GETTH OLDEVENT THLEN]
+                             (CL:WHEN [AND OLDEVENT (type?
 TEDITHISTORYEVENT OLDEVENT)
+                                           (EQ :Delete (GETTH OLDEVENT THACTION))
+                                           (IEQP (GETTH OLDEVENT THCHLIM)
+                                                 (IPLUS (GETTH EVENT THCH#)
+                                                        (GETTH OLDEVENT THLEN]
 
-                              (* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates.  EVENT came later, with its TCH# in a coordinate system reduced by THLEN.  So we have to add it back.")

+                                 (* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates.  EVENT came later, with its TCH# in a coordinate system reduced by THLEN.  So we have to add it back.")

 
-                              (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 OLDEVENT EVENT))
-                              (\TEDIT.POPEVENT TEXTOBJ)))
-                      (push
 (GETTOBJ TEXTOBJ TXTHISTORY)
-                            EVENT))
-          elseif
 (LISTP EVENT)
-            then
 
-                 (* ;; "A monolithic sequence of undoable events")

+                                 (SETQ EVENT (\TEDIT.CUMULATE.EVENTS
 OLDEVENT EVENT))
+                                 (\TEDIT.POPEVENT
 TEXTOBJ)))
+                         (\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
+             elseif
 (LISTP EVENT)
+               then
 
+                    (* ;; "A monolithic sequence of undoable events")

 
-                 (push
 (GETTOBJ TEXTOBJ TXTHISTORY)
-                       EVENT)))
+                    (* ;; "SHOULDNT HAPPEN ?")

+
+                    (\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
     EVENT])
 
+(\TEDIT.HISTORYADD.COMPOSITE

+  [LAMBDA (TEXTOBJ EVENTS)
                                   (* ; "Edited  8-Dec-2024 19:31 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 18:47 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 08:02 by rmk")


+                                                             (* ; "Edited  8-May-2024 12:34 by rmk")

+    (CL:WHEN EVENTS
+        (\TEDIT.HISTORYADD
 TEXTOBJ (CL:IF (CDR EVENTS)
+                                       (\TEDIT.HISTORY.EVENT
 TEXTOBJ :Composite NIL NIL NIL NIL 
+                                              EVENTS)
+                                       (CAR EVENTS))))])
+
 (\TEDIT.CUMULATE.EVENTS

-  [LAMBDA (EVENT1 EVENT2 TEXTOBJ)
                            (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (EVENT1 EVENT2 TEXTOBJ)
                            (* ; "Edited  8-Dec-2024 17:35 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited  3-Mar-2024 12:15 by rmk")


                                                              (* ; "Edited  3-Jun-2023 17:09 by rmk")


                                                              (* ; "Edited 27-May-2023 00:54 by rmk")


@@ -222,8 +257,68 @@
     (SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
                                          (GETTH EVENT2 THDELETEDPIECES)
                                          TEXTOBJ))
-    (SETTH EVENT1 THLEN (fetch
 (SELPIECES SPLEN) of
 (GETTH EVENT1 THDELETEDPIECES)))
+    (SETTH EVENT1 THLEN (GETSPC (GETTH EVENT1 THDELETEDPIECES)
+                               SPLEN))
     EVENT1])
+
+(\TEDIT.COMPOSITE.EVENT

+  [LAMBDA (TEXTOBJ EVENTS)
                                   (* ; "Edited  8-Dec-2024 15:47 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 18:47 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 08:02 by rmk")


+                                                             (* ; "Edited  8-May-2024 12:34 by rmk")

+    (CL:WHEN EVENTS
+        (\TEDIT.HISTORYADD
 (CL:IF (CDR EVENTS)
+                               (\TEDIT.HISTORY.EVENT
 TEXTOBJ (OR ACTION :Composite)
+                                      NIL NIL NIL NIL NEWEVENTS)
+                               (CAR EVENTS))))])
+
+(\TEDIT.HISTORY.PROP

+  [LAMBDA (TEXTOBJ SETNEWVALUE NEWVALUE)
                     (* ; "Edited 22-Sep-2024 08:42 by rmk")

+
+    (* ;; "Called fromTEDIT.TEXT.PROP to manage the history list.  History is ON by default, and the events always correspond to the current state of the document.  If it's OFF, the next document-changing event will cause HISTORYADD to flush the past and no further events will be recorded until it is turned ON again to start a new epoch.  CLEAR flushes old events but then turns on collection.")

+
+    (PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
+               'OFF
+               'ON)
+        (CL:WHEN SETNEWVALUE
+            (SELECTQ NEWVALUE
+                ((ON T) 
+                     (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
+                ((OFF NIL) 
+                           (* ;; 
+
   "HISTORYADD will wipe out everything the next time it is called event--gives a chance to back out")

+
+                     (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE T))
+                (CLEAR                                       (* ; 
+
                                             "Wipes out current history now, then resumes collection")

+                       (FSETTOBJ TEXTOBJ TXTHISTORY NIL)
+                       (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
+                (\ILLEGAL.ARG NEWVALUE))))])
+
+(\TEDIT.HISTORY.EVENT

+  [LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)

+                                                             (* ; "Edited 26-Sep-2024 15:44 by rmk")


+                                                             (* ; "Edited 23-Sep-2024 16:47 by rmk")

+
+    (* ;; "Don't create if it's inactive")

+
+    (CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
+        (CL:WHEN (AND (NULL LEN)
+                      (type?
 SELPIECES CH#))
+            (SETQ LEN (fetch
 (SELPIECES SPLEN) of
 CH#))
+            (SETQ CH# (fetch
 (SELPIECES SPFIRSTCHAR) of
 CH#)))
+        (create
 TEDITHISTORYEVENT
+               THACTION _ ACTION
+               THCH# _ CH#
+               THLEN _ LEN
+               THPOINT _ (OR POINT 'LEFT)
+               THFIRSTPIECE _ FIRSTPIECE
+               THOLDINFO _ OLDINFO
+               THDELETEDPIECES _ DELETEDPIECES))])
+
+(\TEDIT.POPEVENT

+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  7-Dec-2024 21:24 by rmk")

+    (pop
 (GETTOBJ TEXTOBJ TXTHISTORY])
 )
 
 
@@ -233,7 +328,14 @@
 (DEFINEQ
 
 (TEDIT.UNDO

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 20-Mar-2024 11:04 by rmk")


+  [LAMBDA (TSTREAM NOUNDOUNDO)
                               (* ; "Edited  8-Dec-2024 19:41 by rmk")


+                                                             (* ; "Edited 25-Nov-2024 13:17 by rmk")


+                                                             (* ; "Edited 12-Aug-2024 10:49 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 21:21 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:23 by rmk")


+                                                             (* ; "Edited 12-May-2024 21:08 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 11:04 by rmk")


+                                                             (* ; "Edited  8-May-2024 11:16 by rmk")


                                                              (* ; "Edited 15-Mar-2024 13:36 by rmk")


                                                              (* ; "Edited  7-Mar-2024 12:48 by rmk")


                                                              (* ; "Edited  3-Mar-2024 20:02 by rmk")


@@ -246,95 +348,123 @@
 
     (* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.")

 
-    (TEXTOBJ! TEXTOBJ)
-    (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY)
-
-        (* ;; "Only undo things if the document is allowed to change.")

-
-        (TEDIT.PROMPTPRINT TEXTOBJ "" T)
-        (PROG ((SEL (TEXTSEL TEXTOBJ))
-               (EVENT (\TEDIT.POPEVENT TEXTOBJ))
-               PREVEVENTS UNDOEVENT)
-              (CL:UNLESS EVENT
-                  (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+            (SEL (TEXTSEL TEXTOBJ))
+            EVENT PREVEVENT UNDOEVENT)
+           (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
                   (RETURN))
+           (SETQ EVENT (\TEDIT.LASTEVENT TEXTOBJ))
+           (CL:UNLESS EVENT
+               (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
+               (RETURN))
+           (CL:WHEN (MEMB (GETTH EVENT THACTION)
+                          '(:Get :Put))
+               (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
+                      T)
+               (RETURN))
+           (SETQ EVENT (\TEDIT.POPEVENT
 TEXTOBJ))
+           (SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))       (* ; 
+
                                                             "So we can test for the undoundo event.")

+           (CL:UNLESS EVENT
+               (TEDIT.PROMPTPRINT TSTREAM "Nothing to undo" T)
+               (RETURN))
 
-         (* ;; "Each main event was popped.  Each subfunction must put back on the history-undo  list one or more new events that would undo its undoing.  ")

+     (* ;; "Each main event was popped.  Each subfunction must put back on the history-undo  list one or more new events that would undo its undoing.  ")

 
-         (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")

+     (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")

 
-              (SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY))
-              (\TEDIT.SHOWSEL SEL NIL)
-              (\TEDIT.UNDO1
 TEXTOBJ EVENT)
+           (TEDIT.PROMPTCLEAR TSTREAM)
+           (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+           (\TEDIT.UNDO1
 TSTREAM EVENT)
 
-         (* ;; "Get the event that undid EVENT")

+     (* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")

 
-              (SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))
-              (FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS)
-              (CL:WHEN [OR (NULL PREVEVENTS)
-                           (AND (type?
 TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS)))
-                                (MEMB (GETTH (CAR PREVEVENTS)
-                                             THACTION)
-                                      (CONSTANT (LIST :Get :Put]
-                     (SETTOBJ TEXTOBJ \DIRTY NIL))
+           (CL:UNLESS (EQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))
+               (SETQ UNDOEVENT (\TEDIT.POPEVENT
 TEXTOBJ)))
+           (CL:WHEN [OR (NULL PREVEVENT)
+                        (MEMB (GETTH PREVEVENT THACTION)
+                              (CONSTANT (LIST :Get :Put]
+                  (FSETTOBJ TEXTOBJ \DIRTY NIL))
+           (CL:UNLESS NOUNDOUNDO
 
-         (* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u).  This is so that M-U can undo the undoing.")

+               (* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u).  This is so that M-U can undo the undoing by redoing the original event.")

 
-              (push
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ)
-                    (LIST (CAR PREVEVENTS)
-                          UNDOEVENT EVENT))
-              (\TEDIT.FIXSEL SEL TEXTOBJ)
-              (\TEDIT.SHOWSEL SEL T)))])
+               (push
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
+                     (LIST PREVEVENT UNDOEVENT EVENT)))
+           (\TEDIT.FIXSEL SEL TEXTOBJ)
+           (\TEDIT.SHOWSEL SEL T TEXTOBJ])
 
 (\TEDIT.UNDO1

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  4-Mar-2024 14:55 by rmk")


+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited 25-Nov-2024 13:56 by rmk")


+                                                             (* ; "Edited 29-Sep-2024 13:51 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 21:41 by rmk")


+                                                             (* ; "Edited 19-Aug-2024 00:11 by rmk")


+                                                             (* ; "Edited 12-Aug-2024 23:42 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:10 by rmk")


+                                                             (* ; "Edited  4-Mar-2024 14:55 by rmk")


                                                              (* ; "Edited 16-Jul-2023 11:14 by rmk")


                                                              (* ; "Edited 30-May-2023 23:50 by rmk")


                                                              (* ; "Edited 25-May-2023 00:33 by rmk")

-    (SELECTC (GETTH EVENT THACTION)
-        ((LIST :Insert :Copy) 
-             (\TEDIT.UNDO.INSERTION
 TEXTOBJ EVENT))
-        (:Move (\TEDIT.UNDO.MOVE
 TEXTOBJ EVENT))
-        (:Delete                                             (* ; "Deletion or case-shift")

-                 (\TEDIT.UNDO.DELETION
 TEXTOBJ EVENT))
-        (:Move (\TEDIT.UNDO.MOVE
 TEXTOBJ EVENT))
-        (:Looks                                              (* ; "Character-looks change")

-                (\TEDIT.UNDO.LOOKS TEXTOBJ EVENT))
-        (:ParaLooks                                          (* ; "PARA looks change")

-                    (\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
-        (:PageFormat                                         (* ; "Pageframe change")

-                     [SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (GETTH EVENT THOLDINFO)
-                                                        (SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ 
-                                                                                      TXTPAGEFRAMES)))
-                            ]
-                     (\TEDIT.HISTORYADD
 TEXTOBJ EVENT))
-        ((LIST :Replace :LowerCase :UpperCase) 
-                                               (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")

+    (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
+         (CL:WHEN (GETTH EVENT THCH#)
+             (\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
+             (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
+                    EVENT)
+             (\TEDIT.SHOWSEL NIL T TEXTOBJ)
+             (\TEDIT.SCROLL.CARET TSTREAM))
+         (PROG1 (SELECTC (GETTH EVENT THACTION)
+                    ((LIST :Insert :Copy) 
+                         (\TEDIT.UNDO.INSERT
 TEXTOBJ EVENT))
+                    (:Move (\TEDIT.UNDO.MOVE
 TSTREAM EVENT))
+                    (:Delete                                 (* ; "Deletion or case-shift")

+                             (\TEDIT.UNDO.DELETE
 TEXTOBJ EVENT))
+                    (:CharLooks                              (* ; "Character-looks change")

+                                (\TEDIT.UNDO.CHARLOOKS
 TEXTOBJ EVENT))
+                    (:ParaLooks                              (* ; "PARA looks change")

+                                (\TEDIT.UNDO.PARALOOKS
 TEXTOBJ EVENT))
+                    (:PageFormat                             (* ; "Pageframe change")

+                                 (\TEDIT.UNDO.PAGELOOKS
 TEXTOBJ EVENT))
+                    ((LIST :Replace :LowerCase :UpperCase) 
 
-             (\TEDIT.UNDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
-        (:Closefile                                          (* ; "Closes an included file")

-                    (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
-                        (CLOSEF? (GETTH EVENT THOLDINFO))))
-        ((LIST :Get :Put)                                    (* ; 
+                                                 (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")

+
+                         (\TEDIT.UNDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
+                    (:ReplaceCode (\TEDIT.UNDO.REPLACECODE
 TEXTOBJ EVENT))
+                    (:Closefile                              (* ; "Closes an included file")

+                                (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
+                                    (CLOSEF? (GETTH EVENT THOLDINFO))))
+                    (:Composite (\TEDIT.UNDO.COMPOSITE
 TSTREAM EVENT))
+                    ((LIST :Get :Put)                        (* ; 
 
                                                             "He did a GET or PUT-- not undoable.")

-             (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
-                    T))
-        (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
-                                    TEDIT.HISTORY.TYPELST]
-             (COND
-                (UNDOFN 
+                         (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION
+                                                                                       ))
+                                T))
+                    (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
+                                                TEDIT.HISTORY.TYPELST]
+                         (COND
+                            (UNDOFN 
 
-                       (* ;; "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

+                                   (* ;; 
+
                                   "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")

 
-                       (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
-                              (GETTH EVENT THCH#)
-                              (GETTH EVENT THFIRSTPIECE)))
-                (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT 
-                                                                                         THACTION))
-                          T])
+                                   (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
+                                          (GETTH EVENT THCH#)
+                                          (GETTH EVENT THFIRSTPIECE)))
+                            (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
+                                                                 (GETTH EVENT THACTION))
+                                      T])
 
 (TEDIT.REDO

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 15-Mar-2024 13:36 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited  8-Dec-2024 17:53 by rmk")


+                                                             (* ; "Edited 27-Nov-2024 23:11 by rmk")


+                                                             (* ; "Edited 26-Sep-2024 16:49 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 23:58 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 07:41 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:23 by rmk")


+                                                             (* ; "Edited 12-May-2024 21:08 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:36 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:13 by rmk")


                                                              (* ; "Edited  4-Mar-2024 21:33 by rmk")


                                                              (* ; "Edited  2-Mar-2024 09:41 by rmk")


                                                              (* ; "Edited 21-Dec-2023 11:57 by rmk")


@@ -343,71 +473,81 @@
 
     (* ;; "REDO the last thing this guy did.")

 
-    (CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
-        (PROG ((SEL (GETTOBJ TEXTOBJ SEL))
-               (EVENT (\TEDIT.LASTEVENT TEXTOBJ))
-               CH)
-              (CL:UNLESS EVENT
-                  (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
-                  (RETURN))
-              (CL:UNLESS (GETSEL SEL SET)
-                  (TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
-                  (RETURN))
+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+            (SEL (GETTOBJ TEXTOBJ SEL))
+            (EVENT (\TEDIT.LASTEVENT TEXTOBJ))
+            CH)
+           (CL:WHEN (\TEDIT.READONLY TEXTOBJ)
+                  (RETURN NIL))
+           (CL:UNLESS EVENT
+               (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
+               (RETURN))
+           (CL:UNLESS (GETSEL SEL SET)
+               (TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
+               (RETURN))
 
-         (* ;; "There really is something to redo and something to do it to.")

+     (* ;; "There really is something to redo and something to do it to.")

 
-              (\TEDIT.SHOWSEL SEL NIL)
-              (SELECTC (GETTH EVENT THACTION)
-                  ((LIST :Insert :Copy :Move)                (* ; "It was an insertion")

-                       (\TEDIT.REDO.INSERTION
 TEXTOBJ EVENT SEL))
-                  (:Delete                                   (* ; "It was a deletion")

-                           (\TEDIT.DELETE TEXTOBJ SEL))
-                  (:Replace                                  (* ; 
+           (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+           (SELECTC (GETTH EVENT THACTION)
+               ((LIST :Insert :Copy :Move)                   (* ; "It was an insertion")

+                    (\TEDIT.REDO.INSERT
 TEXTOBJ EVENT SEL))
+               (:Delete                                      (* ; "It was a deletion")

+                        (\TEDIT.DELETE TEXTOBJ SEL))
+               (:Replace                                     (* ; 
 
                                                          "It was a replacement (a del/insert combo)")

-                            (\TEDIT.REDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
-                  (:LowerCase                                (* ; "He lower-cased something")

-                              (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
-                  (:UpperCase                                (* ; "He upper-cased something")

-                              (\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
-                  (:Looks                                    (* ; "It was a character looks change")

-                          (TEDIT.LOOKS TEXTOBJ (PLOOKS (GETTH EVENT THFIRSTPIECE))
-                                 SEL))
-                  (:ParaLooks                                (* ; "It was a Paragraph looks change")

-                              (TEDIT.PARALOOKS TEXTOBJ (PPARALOOKS (GETTH EVENT THFIRSTPIECE))
-                                     SEL))
-                  (:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
-                  (:Find                                     (* ; "EXACT-MATCH SEARCH COMMAND")

+                         (\TEDIT.REDO.REPLACE
 TEXTOBJ EVENT (GETTH EVENT THACTION)))
+               (:LowerCase                                   (* ; "He lower-cased something")

+                           (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
+               (:UpperCase                                   (* ; "He upper-cased something")

+                           (\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
+               (:CharLooks                                   (* ; "It was a character looks change")

+                           (\TEDIT.CHANGE.CHARLOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
+                                  SEL))
+               (:ParaLooks                                   (* ; "It was a Paragraph looks change")

+                           (\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
+                                  SEL))
+               (:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
+               (:Find                                        (* ; "EXACT-MATCH SEARCH COMMAND")

                                                              (* (* ;; "RESTLST ?")
 
                                                             (AND NIL (RESETSAVE (CURSOR 
 
                                                             WAITINGCURSOR))) (TEDIT.PROMPTPRINT 
 
                                                             TEXTOBJ "Searching..." T)
 
                                                             (SETQ SEL (fetch (TEXTOBJ SEL) of 
-
                                                             TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL)
-
                                                             (SETQ CH (TEDIT.FIND TEXTOBJ
+
                                                             TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL 
+
                                                             TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
 
                                                             (GETTH EVENT THAUXINFO)))
 
                                                             (COND (CH (TEDIT.PROMPTPRINT TEXTOBJ 
 
                                                             "done.") (\TEDIT.UPDATE.SEL SEL CH
 
                                                             (NCHARS (GETTH EVENT THAUXINFO))
 
                                                             (QUOTE RIGHT)) (\TEDIT.FIXSEL SEL 
 
                                                             TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
-
                                                             (\TEDIT.SHOWSEL SEL T))
+
                                                             (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))
 
                                                             (T (TEDIT.PROMPTPRINT TEXTOBJ 
 
                                                             "[Not found]"))))

-                         )
-                  (:Move                                     (* ; "He moved some text")

-                         (\TEDIT.REDO.MOVE
 TEXTOBJ EVENT (GETTH EVENT THLEN)
-                                (IMAX 1 (TEDIT.GETPOINT NIL SEL))
-                                (GETTH EVENT THFIRSTPIECE)))
-                  ((LIST :Get :Put)                          (* ; "Why can't you redo a get or put ?")

-                       (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
-                              T T))
-                  (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
-                                                    " isn't implemented.")
-                         T))
-              (\TEDIT.SHOWSEL SEL T)))])
+                      )
+               (:Move 
+                      (* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place.  The insert part is probably OK--that maps to the :Insert clause above.")

+
+                      (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
+                             T T))
+               (:Composite (\TEDIT.REDO.COMPOSITE
 TEXTOBJ EVENT SEL))
+               ((LIST :Get :Put NIL)                         (* ; "Why can't you redo a get or put ?")

+                    (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
+                           T T))
+               (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
+                                                 " isn't implemented.")
+                      T))
+           (\TEDIT.SHOWSEL SEL T TEXTOBJ])
 
 (\TEDIT.UNDO.UNDO

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  3-Mar-2024 21:27 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited  8-Dec-2024 18:24 by rmk")


+                                                             (* ; "Edited 26-Sep-2024 22:57 by rmk")


+                                                             (* ; "Edited 22-Sep-2024 11:08 by rmk")


+                                                             (* ; "Edited 12-Aug-2024 23:45 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 09:50 by rmk")


+                                                             (* ; "Edited  3-Mar-2024 21:27 by rmk")


                                                              (* ; "Edited 13-Jun-2023 15:05 by rmk")


                                                              (* ; "Edited  3-Jun-2023 23:04 by rmk")


                                                              (* ; "Edited  1-Jun-2023 23:53 by rmk")

@@ -419,33 +559,34 @@
 
     (* ;; "This makes sense only if the document is now in the state immediately after the undoing--if any other events have intervened, the character positions and the general state of the document are unrelated. So the elements of the undo list also contain the state of the (forward) history list after the undoing was undone.  If we have moved back to the same point in history, we can do the undoing.")

 
-    (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
-    (TEDIT.PROMPTPRINT TEXTOBJ "" T)
-    (LET [(LASTUNDONE (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
-         (if
 (NULL LASTUNDONE)
-             then
 (TEDIT.PROMPTPRINT TEXTOBJ "There is no action whose undoing can be reversed" T)
-           elseif
 (EQ (CAR LASTUNDONE)
-                      (\TEDIT.LASTEVENT TEXTOBJ))
-             then
 
-                  (* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")

+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
+    (LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+           (LASTUNDONE (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
+          (TEDIT.PROMPTCLEAR TSTREAM)
+          (if
 (NULL LASTUNDONE)
+              then
 (TEDIT.PROMPTPRINT TSTREAM "There is no action whose undoing can be reversed")
+            elseif
 (EQ (CAR LASTUNDONE)
+                       (\TEDIT.LASTEVENT TEXTOBJ))
+              then
 
+                   (* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")

 
-                  (push
 (FGETTOBJ TEXTOBJ TXTHISTORY)
-                        (CADR LASTUNDONE))
-                  (TEDIT.UNDO
 TEXTOBJ) 
+                   (\TEDIT.HISTORYADD1 TEXTOBJ (CADR LASTUNDONE))
+                   (TEDIT.UNDO
 TSTREAM)
+                   (TEDIT.PROMPTPRINT TSTREAM "Undo undone" T) 
 
-                  (* ;; "This saved what we just undid, don't want to keep reundoing it.")

+                   (* ;; "This undoing saved what we just undid, don't want to keep reundoing it.")

 
-                  (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
-                  (push
 (FGETTOBJ TEXTOBJ TXTHISTORY)
-                        (CADDR LASTUNDONE))
-           else
 (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)       (* ; 
+                   (pop
 (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
+                   (\TEDIT.HISTORYADD1 TEXTOBJ (CADDR LASTUNDONE))
+            else
 (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)      (* ; 
 
                                        "If something else has happened, there are no undos to undo.")

-                (TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T])
+                 (TEDIT.PROMPTPRINT TSTREAM "Cannot undo the previous undo" T])
 )
 (DEFINEQ
 
-(\TEDIT.UNDO.INSERTION

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 30-May-2023 22:54 by rmk")


+(\TEDIT.UNDO.INSERT

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited  8-Jul-2024 00:07 by rmk")


+                                                             (* ; "Edited 30-May-2023 22:54 by rmk")


                                                              (* ; "Edited 26-May-2023 23:49 by rmk")


                                                              (* ; "Edited 24-May-2023 23:53 by rmk")


                                                              (* ; "Edited  2-May-2023 23:26 by rmk")


@@ -453,11 +594,13 @@
 
     (* ;; "UNDO a prior Insert, Copy, or Include. ")

 
-    (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
-                                  EVENT])
+    (\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
+                                                 EVENT)
+                                  TEXTOBJ])
 
-(\TEDIT.UNDO.DELETION

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 15-Mar-2024 13:54 by rmk")


+(\TEDIT.UNDO.DELETE

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 29-Sep-2024 00:23 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited 30-May-2023 23:31 by rmk")


                                                              (* ; "Edited 27-May-2023 23:39 by rmk")


                                                              (* ; "Edited 21-Apr-93 12:01 by jds")

@@ -470,35 +613,32 @@
            (GETTH EVENT THCH#])
 
 (\TEDIT.UNDO.MOVE

-  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited  8-Dec-2024 19:38 by rmk")


+                                                             (* ; "Edited 25-Nov-2024 14:12 by rmk")


+                                                             (* ; "Edited 29-Sep-2024 00:23 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:50 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 10:17 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited  4-Mar-2024 16:08 by rmk")

 
-    (* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense.  The deleted string would reappear in some random place.")

+    (* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)")

 
-    (LET ((DELEVENT (CAR (GETTH EVENT THOLDINFO)))
-          (FOBJ (CDR (GETTH EVENT THOLDINFO)))
-          (SEL (FGETTOBJ TEXTOBJ SEL)))
-         (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL SEL EVENT))
-                                                             (* ; "Undo the insert in this document")

-         (CL:WHEN (GETTH EVENT THDELETEDPIECES)              (* ; 
-
                                                             ":Move must have started as :Replace")

-             (\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
-                                             'INSERT TEXTOBJ)
-                    TEXTOBJ
-                    (GETTH EVENT THCH#)))
-         (if
 FOBJ
-             then
 (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ))
-                                                             (* ; 
-
                                                             "Delete is last event in other document")

-                      (TEDIT.UNDO
 FOBJ))
-           else
 (\TEDIT.UNDO1
 TEXTOBJ DELEVENT))
-
-         (* ;; "Put the point back after the original target. Caller wil fix it.")

-
-         (\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T])
+    (LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
+           (SEL (TEXTSEL TEXTOBJ))
+           (REPLACE
 (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
+                                        THACTION]
+          (\TEDIT.UNDO.COMPOSITE
 TSTREAM EVENT)
+          (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL (if
 REPLACE
+                                                   then
 (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
+                                                        'PENDINGDEL
+                                                 else
 'NORMAL))
+          (\TEDIT.FIXSEL SEL TSTREAM)
+          (\TEDIT.SHOWSEL SEL T TSTREAM])
 
 (\TEDIT.UNDO.REPLACE

-  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 13-Sep-2024 23:50 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 11:59 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited 30-May-2023 23:10 by rmk")


                                                              (* ; "Edited 27-May-2023 16:49 by rmk")


                                                              (* ; "Edited 24-May-2023 22:43 by rmk")

@@ -508,27 +648,176 @@
     (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
                                      NIL TEXTOBJ)
            TEXTOBJ
-           (\TEDIT.UPDATE.SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+           (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
                   EVENT))
     (SETTH (\TEDIT.LASTEVENT TEXTOBJ)
            THACTION ACTION])
+
+(\TEDIT.UNDO.CHARLOOKS

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 25-Nov-2024 21:59 by rmk")


+                                                             (* ; "Edited 28-Sep-2024 22:37 by rmk")


+                                                             (* ; "Edited 26-Sep-2024 16:06 by rmk")


+                                                             (* ; "Edited 11-Aug-2024 22:11 by rmk")


+                                                             (* ; "Edited  5-Jul-2024 22:54 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:21 by rmk")


+                                                             (* ; "Edited 19-Feb-2024 11:32 by rmk")


+                                                             (* ; "Edited 14-Dec-2023 21:01 by rmk")


+                                                             (* ; "Edited 30-May-2023 22:56 by rmk")


+                                                             (* ; "Edited 18-Apr-2023 23:56 by rmk")


+                                                             (* ; "Edited 30-May-91 21:44 by jds")

+
+    (* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed.  We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece")

+
+    (for
 U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
+                                                      TEXTOBJ))
+         (CHNO _ (GETTH EVENT THCH#))
+         (SEL _ (FGETTOBJ TEXTOBJ SEL))
+         (CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in
 (CDR (GETTH EVENT THOLDINFO))
+       do
 
+          (* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")

+
+          (* ;; "Perhaps we should also save the CHNO of the CARETPC")

+
+          (SETQ NEXTCHNO (CAR U))
+          (SETQ OLDLOOKS (CDR U))
+          (CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
+              (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
+          [push
 NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC] 
+
+          (* ;; "U starts at the first piece.  We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...))  But then, what about the last piece.  Maybe we have to do our own popping, or look at UTAIL.  Or end in (NEXTPC-CHNO . NIL ).  Or text for IGEQ THCHLIM")

+
+          (for
 P inpieces
 PC do
 (FSETPC P PLOOKS OLDLOOKS)
+                                (add
 CHNO (PLEN P))
+                                (CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run")

+                                    (SETQ PC P)
+                                    (RETURN))) finally
 
+
+                                                     (* ;; 
+
                     "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")

+
+                                                     (CL:WHEN NEWUNDOLIST
+                                                         (change
 (GETTH EVENT THOLDINFO)
+                                                                (CONS (CAR DATUM)
+                                                                      (DREVERSE NEWUNDOLIST)))
+                                                         (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                                                         (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
+                                                                'NORMAL)
+                                                         (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS
+                                                                (GETTH EVENT THCH#)
+                                                                (GETTH EVENT THLEN))
+                                                         (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                                                         (TEDIT.PROMPTPRINT TEXTOBJ 
+                                                                "Character looks restored" T)) 
+
+                                                     (* ;; 
+
                                        "Save the event for REDO, even if these pieces didn't change")

+
+                                                     (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(\TEDIT.UNDO.PARALOOKS

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 25-Nov-2024 22:00 by rmk")


+                                                             (* ; "Edited 28-Sep-2024 22:38 by rmk")


+                                                             (* ; "Edited 27-Sep-2024 12:23 by rmk")


+                                                             (* ; "Edited 11-Aug-2024 22:10 by rmk")


+                                                             (* ; "Edited  5-Jul-2024 22:54 by rmk")


+                                                             (* ; "Edited 18-May-2024 16:22 by rmk")


+                                                             (* ; "Edited 19-Feb-2024 11:32 by rmk")


+                                                             (* ; "Edited 11-Dec-2023 11:10 by rmk")


+                                                             (* ; "Edited 21-Sep-2023 23:51 by rmk")


+                                                             (* ; "Edited 30-May-2023 22:55 by rmk")


+                                                             (* ; "Edited 18-Apr-2023 23:57 by rmk")


+                                                             (* ; "Edited 30-May-91 21:44 by jds")

+
+    (* ;; "Undo the setting of paragraph looks.")

+
+    (for
 U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
+                                             TEXTOBJ))
+         (CHNO _ (GETTH EVENT THCH#))
+         (SEL _ (FGETTOBJ TEXTOBJ SEL)) in
 (CDR (GETTH EVENT THOLDINFO))
+       do
 
+          (* ;; "Find the first piece of the next changed paragraph")

+
+          (for
 P inpieces
 PC do
 (CL:WHEN (IEQP CHNO (CAR U))
+                                    (SETQ PC P)
+                                    (RETURN))
+                                (add
 CHNO (PLEN P)))
+          (SETQ OLDLOOKS (CDR U))
+          (push
 NEWUNDOLIST (CONS CHNO (PPARALOOKS PC)))     (* ; "Save for UNDO UNDO")

+
+          (* ;; "Change all the pieces in this paragraph")

+
+          (for
 P inpieces
 PC do
 (FSETPC P PPARALOOKS OLDLOOKS)
+                                (CL:WHEN (PPARALAST P)
+                                    (SETQ PC P)
+                                    (RETURN))
+                                (add
 CHNO (PLEN P))) finally
 
+
+                                                           (* ;; 
+
                     "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")

+
+                                                           (CL:WHEN NEWUNDOLIST
+                                                               (change
 (GETTH EVENT THOLDINFO)
+                                                                      (CONS (CAR DATUM)
+                                                                            (DREVERSE NEWUNDOLIST)))
+                                                               (\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
+                                                               (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
+                                                                      'NORMAL)
+                                                               (\TEDIT.UPDATE.LINES TEXTOBJ
+                                                                      'LOOKS
+                                                                      (GETTH EVENT THCH#)
+                                                                      (GETTH EVENT THLEN))
+                                                               (\TEDIT.SHOWSEL SEL T TEXTOBJ)
+                                                               (TEDIT.PROMPTPRINT TEXTOBJ 
+                                                                      "Paragraph looks restored" T))
+                                                           
+                                                           (* ;; 
+
                                        "Save the event for REDO, even if these pieces didn't change")

+
+                                                           (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(\TEDIT.UNDO.PAGELOOKS

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 12-Aug-2024 10:28 by rmk")

+    [SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
+                                       (SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
+    (TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T)
+    (\TEDIT.HISTORYADD
 TEXTOBJ EVENT])
+
+(\TEDIT.UNDO.COMPOSITE

+  [LAMBDA (TSTREAM EVENT)
                                    (* ; "Edited  8-Dec-2024 15:47 by rmk")


+                                                             (* ; "Edited 25-Nov-2024 22:27 by rmk")


+                                                             (* ; "Edited 15-Aug-2024 10:14 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:17 by rmk")

+
+    (* ;; "A composite event is a group of other events that are to be undone at the same time.  Only show the selection of the last undo event.  We want to end up with a single event on history. We don't want to bump the count.  (Presumably EVENT was alread popped)")

+
+    (for
 E EVENTS CUREVENT (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) in
 (GETTH EVENT THOLDINFO)
+       do
 (SETQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))
+          (\TEDIT.UNDO1
 TSTREAM E)
+          (CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")

+              (push
 EVENTS (\TEDIT.POPEVENT
 TEXTOBJ)))
+          (\TEDIT.SHOWSEL NIL NIL TSTREAM) finally
 (\TEDIT.HISTORYADD.COMPOSITE
 TEXTOBJ EVENTS))
+    (\TEDIT.SCROLL.CARET TSTREAM])
+
+(\TEDIT.UNDO.REPLACECODE

+  [LAMBDA (TEXTOBJ EVENT)
                                    (* ; "Edited 23-Sep-2024 00:45 by rmk")

+    (TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
+           (GETTH EVENT THOLDINFO])
 )
 (DEFINEQ
 
-(\TEDIT.REDO.INSERTION

-  [LAMBDA (TEXTOBJ EVENT SEL)
                                (* ; "Edited 15-Mar-2024 13:54 by rmk")


+(\TEDIT.REDO.INSERT

+  [LAMBDA (TEXTOBJ EVENT SEL)
                                (* ; "Edited 15-Aug-2024 10:47 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited 31-May-2023 10:26 by rmk")


                                                              (* ; "Edited 18-May-2023 19:24 by rmk")


                                                              (* ; "Edited 21-Apr-93 01:06 by jds")

-
-    (* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret.  We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.")

-
     (\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
                                     'INSERT TEXTOBJ)
            TEXTOBJ SEL])
 
 (\TEDIT.REDO.REPLACE

-  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


+  [LAMBDA (TEXTOBJ EVENT ACTION)
                             (* ; "Edited  7-Jul-2024 11:59 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 13:54 by rmk")


                                                              (* ; "Edited  2-Oct-2023 11:43 by rmk")


                                                              (* ; "Edited 31-May-2023 10:25 by rmk")


                                                              (* ; "Edited 27-May-2023 11:16 by rmk")


@@ -540,31 +829,25 @@
     (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
                                      NIL TEXTOBJ)
            TEXTOBJ
-           (\TEDIT.UPDATE.SEL (fetch
 (TEXTOBJ SEL) of
 TEXTOBJ)
+           (\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
                   EVENT))
     (SETTH (\TEDIT.LASTEVENT TEXTOBJ)
            THACTION ACTION])
 
-(\TEDIT.REDO.MOVE

-  [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE)
                 (* ; "Edited 15-Mar-2024 13:36 by rmk")


-                                                             (* ; "Edited 16-Feb-2024 23:36 by rmk")


-                                                             (* ; "Edited  7-Jun-2023 23:19 by rmk")


-                                                             (* ; "Edited 27-May-2023 11:18 by rmk")


-                                                             (* ; "Edited 23-May-2023 12:54 by rmk")


-                                                             (* ; "Edited 30-May-91 21:28 by jds")

-    (LET ((SCR2 (GETTOBJ TEXTOBJ SCRATCHSEL2)))
-         (\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#)
-                LEN)
-         (SETSEL SCR2 SET T)
-         (\TEDIT.FIXSEL SCR2 TEXTOBJ)
-         (\TEDIT.SET.SEL.LOOKS SCR2 'MOVE)
-         (TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL])
+(\TEDIT.REDO.COMPOSITE

+  [LAMBDA (TEXTOBJ EVENT SEL)
                                (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:12 by rmk")

+    (\TEDIT.THELP 'Redo-composite])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD 
-6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) (
-\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162 
-(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 . 
-29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) (
-\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323)))))
+  (FILEMAP (NIL (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD 
+7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) (
+\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635
+ . 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199
+ . 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 (
+\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934) 
+(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610
+ . 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) (
+\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) (
+\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069)))))
 STOP

library/tedit/TEDIT-OLDFILE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Mar-2024 11:06:42" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;11
 73247  
+
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27
 72985  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1)
+      :CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
 
-      :PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;10)
+      :PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
 
 
 (PRETTYCOMPRINT TEDIT-OLDFILECOMS)
@@ -46,7 +46,9 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB2

-  [LAMBDA (TEXT TEXTOBJ PCCOUNT START END)
                   (* ; "Edited 20-Mar-2024 11:00 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 10:28 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 11:00 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 15-Mar-2024 14:37 by rmk")


                                                              (* ; "Edited 21-Jan-2024 10:21 by rmk")


@@ -65,9 +67,10 @@
 
     (* ;; "END = use this as eofptr of file.  For use in reading files within files.")

 
-    (TEXTOBJ! TEXTOBJ)
-    (LET (PIECEINFOCH# (CURFILECH# (OR START 0))
-                LOOKSHASH PARAHASH)
+    (LET ((TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
+          PIECEINFOCH#
+          (CURFILECH# (OR START 0))
+          LOOKSHASH PARAHASH)
          (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
                                  8))
          (SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -167,8 +170,7 @@
                                 PPARALOOKS _ OLDPARALOOKS
                                 PTYPE _ OBJECT.PTYPE
                                 PBYTESPERCHAR _ PCLEN))
-                        (\TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT)
-                               PC TEXT CURFILECH# PCLEN)
+                        (\TEDIT.GET.OBJECT TSTREAM PC TEXT CURFILECH# PCLEN)
                         (add
 CURFILECH# PCLEN)
                         (FSETPC PC PLOOKS (if
 (ZEROP (BIN TEXT))
                                               then
 
@@ -182,7 +184,7 @@
 
                                      "There are new character looks for this object.  Read them in.")

 
                                                  (\TEDIT.GET.SINGLE.CHARLOOKS2
 TEXT))))
-                   (SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
+                   (\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB"))
                (CL:WHEN PC                                   (* ; 
 
                                                       "If we created a piece, save it in the table.")

                    (\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
@@ -273,7 +275,8 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.CHARLOOKS2
 FILE])
 
 (\TEDIT.GET.SINGLE.CHARLOOKS2

-  [LAMBDA (FILE)
                                             (* ; "Edited 16-Jan-2024 22:53 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 31-Jul-2024 00:05 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 22:53 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited 25-Nov-2023 23:22 by rmk")


                                                              (* ; "Edited  7-Nov-2023 22:00 by rmk")


@@ -298,7 +301,7 @@
                  [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
                  [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
                  [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
-                 [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
+                 [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                  [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
                  (SETQ CLSIZE SIZE)
                  (SETQ CLOFFSET SUPER))
@@ -328,76 +331,68 @@
            (RETURN LOOKS])
 
 (\TEDIT.PUT.SINGLE.PARALOOKS2

-  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 16-Jan-2024 23:01 by rmk")


+  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 23:25 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 16:07 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 23:01 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:14 by rmk")


                                                              (* ; "Edited  3-Mar-2023 23:23 by rmk")


                                                              (* ; "Edited 30-May-91 20:33 by jds")

                                                              (* ; 
 
                  "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")

-    (PROG (DEFTAB TABSPECS OUTPUTFORMAT LEN)
-          (\SMALLPOUT FILE (fetch
 (FMTSPEC 1STLEFTMAR) of
 LOOKS))
-                                                             (* ; 
+    (PROG (DEFTAB TABS OUTPUTFORMAT LEN)
+          (\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR))      (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-          (\SMALLPOUT FILE (fetch
 (FMTSPEC LEFTMAR) of
 LOOKS))
-                                                             (* ; 
+          (\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR))         (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-          (\SMALLPOUT FILE (fetch
 (FMTSPEC RIGHTMAR) of
 LOOKS))
-                                                             (* ; "Right margin for the paragraph")

-          (\SMALLPOUT FILE (fetch
 (FMTSPEC LEADBEFORE) of
 LOOKS))
-                                                             (* ; "Leading before the paragraph")

-          (\SMALLPOUT FILE (fetch
 (FMTSPEC LEADAFTER) of
 LOOKS))
-                                                             (* ; "Lead after the paragraph")

-          (\SMALLPOUT FILE (fetch
 (FMTSPEC LINELEAD) of
 LOOKS))
-                                                             (* ; "inter-line leading")

-          (SETQ DEFTAB (CAR (fetch
 (FMTSPEC TABSPEC) of
 LOOKS)))
-          (SETQ TABSPECS (CDR (fetch
 (FMTSPEC TABSPEC) of
 LOOKS)))
+          (\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR))        (* ; "Right margin for the paragraph")

+          (\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE))      (* ; "Leading before the paragraph")

+          (\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER))       (* ; "Lead after the paragraph")

+          (\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD))        (* ; "inter-line leading")

+          (SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
+          (SETQ TABS (FGETPARA LOOKS FMTTABS))
           (COND
-             ((AND (fetch
 (FMTSPEC TABSPEC) of
 LOOKS)
-                   (OR DEFTAB TABSPECS))                     (* ; 
+             ((AND (OR DEFTAB TABS))                         (* ; 
 
                             "There are tab specs to save, or there is a default tab setting to save")

               (\BOUT FILE 3))
              (T                                              (* ; 
 
                                                          "There are no tab looks.  Just let him go.")

                 (\BOUT FILE 2)))
-          (\BOUT FILE (SELECTQ (fetch
 (FMTSPEC QUAD) of
 LOOKS)
+          (\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
                           (LEFT 1)
                           (RIGHT 2)
                           ((CENTER CENTERED) 
                                3)
                           ((JUST JUSTIFIED) 
                                4)
-                          (SHOULDNT)))
-          [COND
-             ((OR TABSPECS DEFTAB)                           (* ; "There are tab specs to save.")

-              (COND
-                 (DEFTAB (\SMALLPOUT FILE DEFTAB))
-                 (T (\SMALLPOUT FILE 0)))
-              (\BOUT FILE (LENGTH TABSPECS))
-              (COND
-                 (TABSPECS                                   (* ; "# of tab settings <256!")

-                        (for
 TAB in
 TABSPECS do
 (\SMALLPOUT FILE (fetch
 TABX of
 TAB)) 
-                                                             (* ; "And setting.")

-                                                (\BOUT FILE (SELECTQ (fetch
 TABKIND of
 TAB)
-                                                                (LEFT 0)
-                                                                (RIGHT 1)
-                                                                (CENTERED 2)
-                                                                (DECIMAL 3)
-                                                                (SHOULDNT))) 
-                                                             (* ; "Tab type")
]
-          (\SMALLPOUT FILE (OR (fetch
 (FMTSPEC FMTSPECIALX) of
 LOOKS)
+                          (\TEDIT.THELP)))
+          (CL:WHEN (OR TABS DEFTAB)                          (* ; "There are tab specs to save.")

+              (\SMALLPOUT FILE (OR DEFTAB 0))
+              (\BOUT FILE (LENGTH TABS))
+              (CL:WHEN TABS                                  (* ; "# of tab settings <256!")

+                  [for
 TAB in
 TABS do
 (\SMALLPOUT FILE (fetch
 (TAB TABX) of
 TAB)) 
+                                                             (* ; "And setting and type")

+                                      (\BOUT FILE (SELECTQ (fetch
 (TAB TABKIND) of
 TAB)
+                                                      (LEFT 0)
+                                                      (RIGHT 1)
+                                                      (CENTERED 2)
+                                                      (DECIMAL 3)
+                                                      (\TEDIT.THELP]))
+          (\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
                                0))
-          (\SMALLPOUT FILE (OR (fetch
 (FMTSPEC FMTSPECIALY) of
 LOOKS)
+          (\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
                                0))
-          (\ARBOUT FILE (fetch
 (FMTSPEC FMTUSERINFO) of
 LOOKS))
-          (\ATMOUT FILE (fetch
 (FMTSPEC FMTPARATYPE) of
 LOOKS))
-          (\ATMOUT FILE (fetch
 (FMTSPEC FMTPARASUBTYPE) of
 LOOKS))
-          (\ARBOUT FILE (fetch
 (FMTSPEC FMTSTYLE) of
 LOOKS))
-          (\ARBOUT FILE (fetch
 (FMTSPEC FMTCHARSTYLES) of
 LOOKS))
-          (\ARBOUT FILE (fetch
 (FMTSPEC FMTNEWPAGEBEFORE) of
 LOOKS))
-          (\ARBOUT FILE (fetch
 (FMTSPEC FMTNEWPAGEAFTER) of
 LOOKS])
+          (\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO))
+          (\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE))
+          (\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE))
+          (\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE))
+          (\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES))
+          (\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
+          (\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
 
 (\TEDIT.PUT.SINGLE.CHARLOOKS2

-  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 16-Jan-2024 23:01 by rmk")


+  [LAMBDA (FILE LOOKS)
                                       (* ; "Edited 31-Jul-2024 00:05 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 23:01 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:14 by rmk")


                                                              (* ; "Edited 30-May-91 20:26 by jds")

                                                              (* ; 
@@ -468,7 +463,7 @@
                                  NIL 4)
                                 (T 0))
                              (COND
-                                ((fetch
 (CHARLOOKS CLSELHERE) of
 LOOKS)
+                                ((fetch
 (CHARLOOKS CLSELAFTER) of
 LOOKS)
                                  2)
                                 (T 0))
                              (COND
@@ -484,69 +479,65 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.PARALOOKS2
 FILE])
 
 (\TEDIT.GET.SINGLE.PARALOOKS2

-  [LAMBDA (FILE)
                                             (* ; "Edited 16-Jan-2024 22:54 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 23-Oct-2024 16:07 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited  5-Aug-2024 09:48 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 23:22 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 21:35 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 22:54 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited  3-Mar-2023 23:18 by rmk")


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


                                                              (* ; "Edited 30-May-91 20:33 by jds")

                                                              (* ; 
 
                           "Read a paragraph format spec from the FILE, and return it for later use.")

-    (PROG ((LOOKS (create
 FMTSPEC))
-           TABFLG DEFTAB TABCOUNT TABS TABSPEC)
-          (replace
 (FMTSPEC 1STLEFTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+    (LET ((FMT (create
 FMTSPEC))
+          TABFLG DEFTAB TABS)
+         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-          (replace
 (FMTSPEC LEFTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-          (replace
 (FMTSPEC RIGHTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Right margin for the paragraph")

-          (replace
 (FMTSPEC LEADBEFORE) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Leading before the paragraph")

-          (replace
 (FMTSPEC LEADAFTER) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Lead after the paragraph")

-          (replace
 (FMTSPEC LINELEAD) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "inter-line leading")

-          (replace
 (FMTSPEC TABSPEC) of
 LOOKS with
 (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
-                                                             (* ; "Will be tab specs")

-          (SETQ TABFLG (BIN FILE))
-          (replace
 (FMTSPEC QUAD) of
 LOOKS with
 (SELECTC (BIN FILE)
-                                                    (1 'LEFT)
-                                                    (2 'RIGHT)
-                                                    (3 'CENTERED)
-                                                    (4 'JUSTIFIED)
-                                                    (SHOULDNT)))
-          (COND
-             ((NOT (ZEROP (LOGAND TABFLG 1)))                (* ; "There are tabs to read")

-              (SETQ DEFTAB (\SMALLPIN FILE))
-              (SETQ TABCOUNT (BIN FILE))
-              [SETQ TABS (for
 TAB# from
 1 to
 TABCOUNT collect
 (create
 TAB
-                                                                     TABX _ (\SMALLPIN FILE)
-                                                                     TABKIND _
-                                                                     (SELECTQ (BIN FILE)
-                                                                         (0 'LEFT)
-                                                                         (1 'RIGHT)
-                                                                         (2 'CENTERED)
-                                                                         (3 'DECIMAL)
-                                                                         (SHOULDNT]
-              (CL:UNLESS (ZEROP DEFTAB)
-                     (RPLACA TABSPEC DEFTAB))
-              (RPLACD TABSPEC TABS)))
-          [COND
-             ((NOT (ZEROP (LOGAND TABFLG 2)))                (* ; 
+         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

+         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

+         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

+         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

+         (SETQ TABFLG (BIN FILE))
+         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
+                                (1 'LEFT)
+                                (2 'RIGHT)
+                                (3 'CENTERED)
+                                (4 'JUSTIFIED)
+                                (\TEDIT.THELP)))
+         (CL:UNLESS (ZEROP (LOGAND TABFLG 1))                (* ; "There are tabs to read")

+             (SETQ DEFTAB (\SMALLPIN FILE))
+             (CL:WHEN (ILEQ DEFTAB 1)
+                    (SETQ DEFTAB DEFAULTTAB))
+             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
+             [SETQ TABS (for
 TAB# from
 1 to
 (BIN FILE) collect
 (create
 TAB
+                                                                      TABX _ (\SMALLPIN FILE)
+                                                                      TABKIND _
+                                                                      (SELECTQ (BIN FILE)
+                                                                          (0 'LEFT)
+                                                                          (1 'RIGHT)
+                                                                          (2 'CENTERED)
+                                                                          (3 'DECIMAL)
+                                                                          (\TEDIT.THELP]
+             (FSETPARA FMT FMTTABS TABS))
+         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
+                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
+         (CL:UNLESS (ZEROP (LOGAND TABFLG 2))                (* ; 
 
                                                   "There are other paragraph parameters to be read.")

-              (replace
 (FMTSPEC FMTSPECIALX) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+             (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE))     (* ; 
 
                                                      "Special X location on page for this paragraph")

-              (replace
 (FMTSPEC FMTSPECIALY) of
 LOOKS with
 (\SMALLPIN FILE))
-              (replace
 (FMTSPEC FMTUSERINFO) of
 LOOKS with
 (\ARBIN FILE))
-              (replace
 (FMTSPEC FMTPARATYPE) of
 LOOKS with
 (\ATMIN FILE))
-              (replace
 (FMTSPEC FMTPARASUBTYPE) of
 LOOKS with
 (\ATMIN FILE))
-              (replace
 (FMTSPEC FMTSTYLE) of
 LOOKS with
 (\ARBIN FILE))
-              (replace
 (FMTSPEC FMTCHARSTYLES) of
 LOOKS with
 (\ARBIN FILE))
-              (replace
 (FMTSPEC FMTNEWPAGEBEFORE) of
 LOOKS with
 (\ARBIN FILE))
-              (replace
 (FMTSPEC FMTNEWPAGEAFTER) of
 LOOKS with
 (\ARBIN FILE]
-          (RETURN LOOKS])
+             (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
+             (FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
+             (FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
+             (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
+             (FSETPARA FMT FMTSTYLE (\ARBIN FILE))
+             (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
+             (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
+             (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
+         FMT])
 
 (\TEDIT.PUT.CHARLOOKS.LIST2

   [LAMBDA (FILE LOOKSLIST)
                                   (* ; "Edited 16-Jan-2024 23:02 by rmk")


@@ -600,7 +591,9 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB1

-  [LAMBDA (TEXT TEXTOBJ PCCOUNT START END)
                   (* ; "Edited 20-Mar-2024 11:00 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 10:28 by rmk")


+                                                             (* ; "Edited 20-Mar-2024 11:00 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 21-Jan-2024 10:23 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


@@ -619,8 +612,9 @@
 
     (* ;; "END = use this as eofptr of file.  For use in reading files within files.")

 
-    (TEXTOBJ! TEXTOBJ)
-    (LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0)))
+    (LET ((TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
+          PIECEINFOCH#
+          (CURFILECH# (OR START 0)))
          (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
                                  8))
          (SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -675,8 +669,7 @@
                                 PPARALOOKS _ OLDPARALOOKS
                                 PTYPE _ THINFILE.PTYPE
                                 PBYTESPERCHAR _ PCLEN))
-                        (TEDIT.GET.OBJECT1
 (FGETTOBJ TEXTOBJ STREAMHINT)
-                               PC TEXT CURFILECH#)
+                        (TEDIT.GET.OBJECT1
 TSTREAM PC TEXT CURFILECH#)
                         (add
 CURFILECH# PCLEN)
                         [COND
                            ((NOT (ZEROP (BIN TEXT)))         (* ; 
@@ -689,7 +682,7 @@
 
                                                    "No new looks;  steal them from the prior piece.")

                               (FSETPC PC PLOOKS (OR (AND OLDPC (PLOOKS OLDPC))
                                                     DEFAULTCHARLOOKS])
-                   (SHOULDNT "Impossible piece-type code"))
+                   (\TEDIT.THELP "Impossible piece-type code"))
                (CL:WHEN PC
                    (\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
                    (SETQ OLDPC PC)) finally
 (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
@@ -702,7 +695,8 @@
     (\TEDIT.PARSE.PAGEFRAMES1
 (READ FILE])
 
 (\TEDIT.PARSE.PAGEFRAMES1

-  [LAMBDA (PAGELIST PARENT)
                                  (* ; "Edited  7-Nov-2023 13:27 by rmk")


+  [LAMBDA (PAGELIST PARENT)
                                  (* ; "Edited 30-Aug-2024 15:43 by rmk")


+                                                             (* ; "Edited  7-Nov-2023 13:27 by rmk")


                                                              (* ; "Edited  8-Mar-2023 18:14 by rmk")


                                                              (* ; "Edited  4-Oct-2022 16:57 by rmk")


                                                              (* ; "Edited  1-Oct-2022 16:02 by rmk")

@@ -736,10 +730,14 @@
                                                           collect
 (\TEDIT.PARSE.PAGEFRAMES1
 ALIST 
                                                                          PAGEFRAME)))
              PAGEFRAME)
-            (T (for
 FRAMESPEC in
 (CAR PAGELIST) collect
 (\TEDIT.PARSE.PAGEFRAMES1
 FRAMESPEC NIL])
+            (T (SETQ PAGELIST (CAR PAGELIST))
+               (TEDIT.COMPOUND.PAGEFORMAT (\TEDIT.PARSE.PAGEFRAMES1
 (pop
 PAGELIST))
+                      (\TEDIT.PARSE.PAGEFRAMES1
 (pop
 PAGELIST))
+                      (\TEDIT.PARSE.PAGEFRAMES1
 (pop
 PAGELIST])
 
 (\TEDIT.GET.CHARLOOKS1

-  [LAMBDA (PC FILE)
                                          (* ; "Edited 16-Jan-2024 22:55 by rmk")


+  [LAMBDA (PC FILE)
                                          (* ; "Edited 31-Jul-2024 00:05 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 22:55 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited 25-Nov-2023 23:21 by rmk")


                                                              (* ; "Edited  7-Nov-2023 22:02 by rmk")


@@ -776,7 +774,7 @@
                [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
                [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
                [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
-               [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
+               [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
                (SETQ CLSIZE SIZE)
                (SETQ CLOFFSET SUPER))
@@ -805,7 +803,11 @@
          (replace
 (CHARLOOKS CLFONT) of
 LOOKS with
 FONT])
 
 (\TEDIT.GET.PARALOOKS1

-  [LAMBDA (FILE)
                                             (* ; "Edited 16-Jan-2024 22:55 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited 23-Oct-2024 16:08 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited  5-Aug-2024 09:48 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 22:00 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 22:55 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited 27-Oct-2023 13:00 by rmk")


                                                              (* ; "Edited  3-Mar-2023 23:20 by rmk")


@@ -813,63 +815,57 @@
                                                              (* ; "Edited 30-May-91 20:34 by jds")

                                                              (* ; 
 
                           "Read a paragraph format spec from the FILE, and return it for later use.")

-    (LET ((LOOKS (create
 FMTSPEC))
-          TABFLG DEFTAB TABCOUNT TABS TABSPEC)
-         (replace
 (FMTSPEC 1STLEFTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+    (LET ((FMT (create
 FMTSPEC))
+          TABFLG DEFTAB)
+         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-         (replace
 (FMTSPEC LEFTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-         (replace
 (FMTSPEC RIGHTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Right margin for the paragraph")

-         (replace
 (FMTSPEC LEADBEFORE) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Leading before the paragraph")

-         (replace
 (FMTSPEC LEADAFTER) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Lead after the paragraph")

-         (replace
 (FMTSPEC LINELEAD) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "inter-line leading")

-         (replace
 (FMTSPEC TABSPEC) of
 LOOKS with
 (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
+         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

+         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

+         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

+         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

                                                              (* ; "Will be tab specs")

          (SETQ TABFLG (BIN FILE))
-         (replace
 (FMTSPEC QUAD) of
 LOOKS with
 (SELECTC (BIN FILE)
-                                                   (1 'LEFT)
-                                                   (2 'RIGHT)
-                                                   (3 'CENTERED)
-                                                   (4 'JUSTIFIED)
-                                                   (SHOULDNT)))
+         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
+                                (1 'LEFT)
+                                (2 'RIGHT)
+                                (3 'CENTERED)
+                                (4 'JUSTIFIED)
+                                (\TEDIT.THELP)))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 1))                (* ; "There are tabs to read")

              (SETQ DEFTAB (\SMALLPIN FILE))
-             (SETQ TABCOUNT (BIN FILE))
-             [SETQ TABS (for
 TAB# from
 1 to
 TABCOUNT collect
 (create
 TAB
-                                                                    TABX _ (\SMALLPIN FILE)
-                                                                    TABKIND _
-                                                                    (SELECTQ (BIN FILE)
-                                                                        (0 'LEFT)
-                                                                        (1 'RIGHT)
-                                                                        (2 'CENTERED)
-                                                                        (3 'DECIMAL)
-                                                                        (SHOULDNT]
-             (CL:UNLESS (ZEROP DEFTAB)
-                    (RPLACA TABSPEC DEFTAB))
-             (RPLACD TABSPEC TABS))
+             (CL:WHEN (ILEQ DEFTAB 1)
+                    (SETQ DEFTAB DEFAULTTAB))
+             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
+             [FSETPARA FMT FMTTABS (for
 TAB# from
 1 to
 (BIN FILE)
+                                      collect
 (create
 TAB
+                                                     TABX _ (\SMALLPIN FILE)
+                                                     TABKIND _ (SELECTQ (BIN FILE)
+                                                                   (0 'LEFT)
+                                                                   (1 'RIGHT)
+                                                                   (2 'CENTERED)
+                                                                   (3 'DECIMAL)
+                                                                   (\TEDIT.THELP])
+         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
+                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
          (CL:UNLESS (ZEROP (LOGAND TABFLG 2))                (* ; 
 
                                                   "There are other paragraph parameters to be read.")

-             (replace
 (FMTSPEC FMTSPECIALX) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+             (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE))     (* ; 
 
                                                      "Special X location on page for this paragraph")

-             (replace
 (FMTSPEC FMTSPECIALY) of
 LOOKS with
 (\SMALLPIN FILE))
-             (replace
 (FMTSPEC FMTUSERINFO) of
 LOOKS with
 (\ARBIN FILE))
-             (replace
 (FMTSPEC FMTPARATYPE) of
 LOOKS with
 (\ATMIN FILE))
-             (replace
 (FMTSPEC FMTPARASUBTYPE) of
 LOOKS with
 (\ATMIN FILE))
-             (replace
 (FMTSPEC FMTSTYLE) of
 LOOKS with
 (\ARBIN FILE))
-             (replace
 (FMTSPEC FMTCHARSTYLES) of
 LOOKS with
 (\ARBIN FILE))
-             (replace
 (FMTSPEC FMTNEWPAGEBEFORE) of
 LOOKS with
 (\ARBIN FILE))
-             (replace
 (FMTSPEC FMTNEWPAGEAFTER) of
 LOOKS with
 (\ARBIN FILE)))
-         LOOKS])
+             (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
+             (FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
+             (FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
+             (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
+             (FSETPARA FMT FMTSTYLE (\ARBIN FILE))
+             (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
+             (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
+             (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
+         FMT])
 
 (TEDIT.GET.OBJECT1

-  [LAMBDA (STREAM PIECE FILE CURCH#)
                         (* ; "Edited 27-Oct-2023 12:58 by rmk")


+  [LAMBDA (STREAM PIECE FILE CURCH#)
                         (* ; "Edited 31-Jul-2024 12:09 by rmk")


+                                                             (* ; "Edited 27-Oct-2023 12:58 by rmk")


                                                              (* ; "Edited  6-Aug-2022 09:11 by rmk")


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

 
@@ -891,7 +887,8 @@
          (FSETPC PIECE PLOOKS (if
 (PREVPIECE PIECE)
                                   then
 (PLOOKS (PREVPIECE PIECE))
                                 elseif
 (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
-                                else
 (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)
+                                else
 (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT 
+                                                                       DEFAULTFONT)
                                             TEXTOBJ)))
          (PCONTENTS PIECE])
 )
@@ -903,7 +900,9 @@
 (DEFINEQ
 
 (\TEDIT.GET.PCTB0

-  [LAMBDA (TEXT TEXTOBJ PCCOUNT START END)
                   (* ; "Edited 17-Mar-2024 12:41 by rmk")


+  [LAMBDA (TEXT TSTREAM PCCOUNT START END)
                   (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 29-Apr-2024 10:27 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 15-Mar-2024 14:47 by rmk")


                                                              (* ; "Edited 21-Jan-2024 10:27 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


@@ -915,8 +914,9 @@
 
 (* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE")

 
-    (LET (OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
-                (SBINABLE (fetch
 (STREAM BINABLE) of
 TEXT)))
+    (LET ((TEXTOBJ (TEXTOBJ! (fetch
 (TEXTSTREAM TEXTOBJ) of
 TSTREAM)))
+          OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
+          (SBINABLE (fetch
 (STREAM BINABLE) of
 TEXT)))
          (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
                                  8))
          (SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -943,8 +943,7 @@
                         (\TEDIT.GET.CHARLOOKS0
 PC TEXT)
                         (add
 CURFILECH# (PLEN PC)))
                    (\PieceDescriptorOBJECT 
-                        (\TEDIT.GET.OBJECT0
 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT))
-                               PC TEXT CURFILECH#)
+                        (\TEDIT.GET.OBJECT0
 TSTREAM PC TEXT CURFILECH#)
                         (add
 CURFILECH# (PLEN PC))           (* ; 
 
                                            "Only object--can't be followed by either of the others.")

                         (FSETPC PC PLEN 1))
@@ -958,12 +957,13 @@
                         (\TEDIT.GET.CHARLOOKS0
 PC TEXT)      (* ; "This document is 'formatted' .")

                         (add
 CURFILECH# (PLEN PC))
                         (AND TEXTOBJ (FSETTOBJ TEXTOBJ FORMATTEDP T)))
-                   (SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
+                   (\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB"))
                (SETQ OLDPC PC)
                (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally
 (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
 
 (\TEDIT.GET.CHARLOOKS0

-  [LAMBDA (PC FILE)
                                          (* ; "Edited 16-Jan-2024 23:03 by rmk")


+  [LAMBDA (PC FILE)
                                          (* ; "Edited 31-Jul-2024 00:05 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 23:03 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


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


                                                              (* ; "Edited 30-May-91 20:26 by jds")

@@ -1007,7 +1007,7 @@
                 [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
                 [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
                 [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
-                [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
+                [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
                 [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
                 (SETQ CLSIZE SIZE)
                 (SETQ CLOFFSET SUPER))
@@ -1027,7 +1027,8 @@
                                                                     'ITALIC])
 
 (\TEDIT.GET.OBJECT0

-  [LAMBDA (STREAM PIECE FILE CURCH#)
                         (* ; "Edited  6-Aug-2022 15:57 by rmk")


+  [LAMBDA (STREAM PIECE FILE CURCH#)
                         (* ; "Edited 31-Jul-2024 12:09 by rmk")


+                                                             (* ; "Edited  6-Aug-2022 15:57 by rmk")


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

 
     (* ;; "Get an object from the file")

@@ -1051,71 +1052,70 @@
                                                   (T (OR (fetch
 (TEXTOBJ DEFAULTCHARLOOKS)
                                                             of
 TEXTOBJ)
                                                          (\TEDIT.UNIQUIFY.CHARLOOKS (
-                                                                                  CHARLOOKS.FROM.FONT
+                                                                           \TEDIT.CHARLOOKS.FROM.FONT
                                                                                      DEFAULTFONT)
                                                                 TEXTOBJ]
          OBJ])
 
 (\TEDIT.GET.PARALOOKS0

-  [LAMBDA (PC FILE)
                                          (* ; "Edited 16-Jan-2024 22:57 by rmk")


+  [LAMBDA (PC FILE)
                                          (* ; "Edited 23-Oct-2024 16:09 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited  5-Aug-2024 09:47 by rmk")


+                                                             (* ; "Edited 29-Jul-2024 23:23 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 22:23 by rmk")


+                                                             (* ; "Edited 16-Jan-2024 22:57 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


                                                              (* ; "Edited  3-Mar-2023 23:14 by rmk")


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


                                                              (* ; "Edited 30-May-91 20:34 by jds")

                                                              (* ; 
 
                  "Put a description of LOOKS into FILE.  LOOKS apply to characters CH1 thru CHLIM-1")

-    (PROG ((LOOKS (create
 FMTSPEC))
-           TABFLG DEFTAB TABCOUNT TABS TABSPEC)
-          (replace
 (PIECE PPARALOOKS) of
 PC with
 LOOKS)
-          (replace
 (FMTSPEC 1STLEFTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+    (LET ((FMT (create
 FMTSPEC))
+          TABFLG DEFTAB TABS)
+         (SETPC PC PPARALOOKS FMT)
+         (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE))          (* ; 
 
                                                    "Left margin for the first line of the paragraph")

-          (replace
 (FMTSPEC LEFTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; 
+         (FSETPARA FMT LEFTMAR (\SMALLPIN FILE))             (* ; 
 
                                                          "Left margin for the rest of the paragraph")

-          (replace
 (FMTSPEC RIGHTMAR) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Right margin for the paragraph")

-          (replace
 (FMTSPEC LEADBEFORE) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Leading before the paragraph")

-          (replace
 (FMTSPEC LEADAFTER) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "Lead after the paragraph")

-          (replace
 (FMTSPEC LINELEAD) of
 LOOKS with
 (\SMALLPIN FILE))
-                                                             (* ; "inter-line leading")

-          (replace
 (FMTSPEC TABSPEC) of
 LOOKS with
 (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
-                                                             (* ; "Will be tab specs")

-          (SETQ TABFLG (BIN FILE))
-          (replace
 (FMTSPEC QUAD) of
 LOOKS with
 (SELECTC (BIN FILE)
-                                                    (1 'LEFT)
-                                                    (2 'RIGHT)
-                                                    (3 'CENTERED)
-                                                    (4 'JUSTIFIED)
-                                                    (SHOULDNT)))
-          (COND
-             ((NOT (ZEROP TABFLG))                           (* ; "There are tabs to read")

-              (SETQ DEFTAB (\SMALLPIN FILE))
-              (SETQ TABCOUNT (BIN FILE))
-              [SETQ TABS (for
 TAB# from
 1 to
 TABCOUNT collect
 (create
 TAB
-                                                                     TABX _ (\SMALLPIN FILE)
-                                                                     TABKIND _
-                                                                     (SELECTQ (BIN FILE)
-                                                                         (0 'LEFT)
-                                                                         (1 'RIGHT)
-                                                                         (2 'CENTERED)
-                                                                         (3 'DECIMAL)
-                                                                         (SHOULDNT]
-              (OR (ZEROP DEFTAB)
-                  (RPLACA TABSPEC DEFTAB))
-              (RPLACD TABSPEC TABS])
+         (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE))            (* ; "Right margin for the paragraph")

+         (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE))          (* ; "Leading before the paragraph")

+         (FSETPARA FMT LEADAFTER (\SMALLPIN FILE))           (* ; "Lead after the paragraph")

+         (FSETPARA FMT LINELEAD (\SMALLPIN FILE))            (* ; "inter-line leading")

+         (SETQ TABFLG (BIN FILE))
+         (FSETPARA FMT QUAD (SELECTC (BIN FILE)
+                                (1 'LEFT)
+                                (2 'RIGHT)
+                                (3 'CENTERED)
+                                (4 'JUSTIFIED)
+                                (\TEDIT.THELP)))
+         (CL:UNLESS (ZEROP TABFLG)                           (* ; "There are tabs to read")

+             (SETQ DEFTAB (\SMALLPIN FILE))
+             (CL:WHEN (ILEQ DEFTAB 1)
+                    (SETQ DEFTAB DEFAULTTAB))
+             (FSETPARA FMT FMTDEFAULTTAB DEFTAB)
+             [SETQ TABS (for
 TAB# from
 1 to
 (BIN FILE) collect
 (create
 TAB
+                                                                      TABX _ (\SMALLPIN FILE)
+                                                                      TABKIND _
+                                                                      (SELECTQ (BIN FILE)
+                                                                          (0 'LEFT)
+                                                                          (1 'RIGHT)
+                                                                          (2 'CENTERED)
+                                                                          (3 'DECIMAL)
+                                                                          (\TEDIT.THELP]
+             (FSETPARA FMT FMTTABS TABS))
+         (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
+                (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
+         FMT])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1666 38666 (\TEDIT.GET.PCTB2 1676 . 11742) (\TEDIT.GET.PARALOOKS2 11744 . 12333) (
-\TEDIT.GET.CHARLOOKS2 12335 . 13666) (\TEDIT.PARSE.PAGEFRAMES2 13668 . 16407) (
-\TEDIT.GET.CHARLOOKS.LIST2 16409 . 16916) (\TEDIT.GET.SINGLE.CHARLOOKS2 16918 . 20635) (
-\TEDIT.PUT.SINGLE.PARALOOKS2 20637 . 25388) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25390 . 29864) (
-\TEDIT.GET.PARALOOKS.LIST2 29866 . 30373) (\TEDIT.GET.SINGLE.PARALOOKS2 30375 . 35384) (
-\TEDIT.PUT.CHARLOOKS.LIST2 35386 . 37465) (\TEDIT.PUT.PARALOOKS.LIST2 37467 . 38664)) (38743 59003 (
-\TEDIT.GET.PCTB1 38753 . 45217) (\TEDIT.GET.PAGEFRAMES1 45219 . 45671) (\TEDIT.PARSE.PAGEFRAMES1 45673
- . 48049) (\TEDIT.GET.CHARLOOKS1 48051 . 52423) (\TEDIT.GET.PARALOOKS1 52425 . 57457) (
-TEDIT.GET.OBJECT1 57459 . 59001)) (59063 73224 (\TEDIT.GET.PCTB0 59073 . 62808) (\TEDIT.GET.CHARLOOKS0
- 62810 . 67397) (\TEDIT.GET.OBJECT0 67399 . 69349) (\TEDIT.GET.PARALOOKS0 69351 . 73222)))))
+  (FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) (
+\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) (
+\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) (
+\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) (
+\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) (
+\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 (
+\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203
+ . 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) (
+TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0
+ 62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960)))))
 STOP

library/tedit/TEDIT-PCTREE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239
 66617  
+
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243
 67795  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.INSERTPIECES)
+      :CHANGES-TO (FNS \TEDIT.DELETEPIECES)
 
-      :PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
+      :PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
 
 
 (PRETTYCOMPRINT TEDIT-PCTREECOMS)
@@ -272,10 +272,15 @@
                     DELTA])
 
 (\TEDIT.FIRSTPIECE

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 31-Oct-2023 19:37 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 21-Aug-2024 16:07 by rmk")


+                                                             (* ; "Edited 31-Oct-2023 19:37 by rmk")


                                                              (* ; "Edited 11-Apr-2023 12:54 by rmk")


                                                              (* ; "Edited 24-Aug-2022 12:45 by rmk")

-    (for
 (NODE _ (CAR (GETTOBJ TEXTOBJ PCTB))) by
 (ffetch
 (BTREENODE DOWN1) of
 NODE)
+    (for
 (NODE _ (CAR (GETTOBJ (if
 (type?
 TEXTOBJ TEXTOBJ)
+                                   then
 TEXTOBJ
+                                 elseif
 (type?
 STREAM TEXTOBJ)
+                                   then
 (fetch
 (TEXTSTREAM TEXTOBJ) of
 TEXTOBJ))
+                             PCTB))) by
 (ffetch
 (BTREENODE DOWN1) of
 NODE)
        unless
 (type?
 BTREENODE NODE) do
 
 
                                  (* ;; "If we don't bottom out in a piece, something else is screwed up.  But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")

@@ -284,7 +289,8 @@
                                                        NODE])
 
 (\TEDIT.DELETETREE

-  [LAMBDA (OLD
 PCNODE TEXTOBJ)
                               (* ; "Edited 17-Mar-2024 00:22 by rmk")


+  [LAMBDA (OLD
 PCNODE TEXTOBJ)
                               (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:22 by rmk")


                                                              (* ; "Edited 31-Oct-2023 10:23 by rmk")


                                                              (* ; "Edited 26-Oct-2023 12:50 by rmk")


                                                              (* ; "Edited 30-May-2023 08:58 by rmk")


@@ -313,7 +319,7 @@
 
                (bind
 TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE))
                   first
 (SETQ OLDSLOT (\FINDSLOT PCNODE OLD))
-                        (CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE"))
+                        (CL:UNLESS OLDSLOT (\TEDIT.THELP "Piece/node not in PCNODE"))
                         (CL:WHEN (EQ OLDSLOT LAST)           (* ; "Just shrink by one")

                             (\FILLSLOT OLDSLOT NIL 0)
                             (GO $$OUT))
@@ -504,18 +510,20 @@
                             (RETURN NODE])
 
 (\TEDIT.SET-TOTLEN

-  [LAMBDA (PCNODE)
                                           (* ; "Edited 21-Oct-2023 17:22 by rmk")


+  [LAMBDA (PCNODE)
                                           (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 21-Oct-2023 17:22 by rmk")


                                                              (* ; "Edited 15-Aug-2022 17:15 by rmk")


                                                              (* ; "Edited  9-May-93 15:40 by jds")

 
     (* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")

 
-    (HELP 'NOTCALLED)
+    (\TEDIT.THELP 'NOTCALLED)
     (replace
 (BTREENODE TOTLEN) of
 PCNODE with
 (for
 S inslots
 PCNODE sum
 (fetch
 (BTSLOT DLEN)
                                                                             of
 S])
 
 (\TEDIT.MAKE.VACANT.BTREESLOT

-  [LAMBDA (BTNODE TEXTOBJ)
                                   (* ; "Edited 16-Mar-2024 10:23 by rmk")


+  [LAMBDA (BTNODE TEXTOBJ)
                                   (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 16-Mar-2024 10:23 by rmk")


                                                              (* ; "Edited  7-Dec-2023 21:08 by rmk")


                                                              (* ; "Edited 31-Oct-2023 10:32 by rmk")


                                                              (* ; "Edited 10-Jun-2023 00:13 by rmk")


@@ -563,7 +571,7 @@
                     (UNINTERRUPTABLY
                         (replace
 (BTREENODE UPWARD) of
 BTNODE with
 PARENT)
                         (RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB))
-                                    (HELP "BTNODE NOT FOUND"))
+                                    (\TEDIT.THELP "BTNODE NOT FOUND"))
                                PARENT)))
 
              (* ;; "Tree is still valid, but PARENT how has a needed empty slot.")

@@ -643,19 +651,21 @@
          NEW])
 
 (\TEDIT.UNLINKPIECE

-  [LAMBDA (PREV PC TEXTOBJ)
                                  (* ; "Edited 21-Oct-2023 17:24 by rmk")


+  [LAMBDA (PREV PC TEXTOBJ)
                                  (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 21-Oct-2023 17:24 by rmk")


                                                              (* ; "Edited 30-May-2023 00:31 by rmk")

 
     (* ;; "Takes PC out of the piece chain, linking prev and next around it.")

 
-    (HELP 'NOTCALLED?)
+    (\TEDIT.THELP 'NOTCALLED?)
     (CL:WHEN PREV
         (freplace
 (PIECE NEXTPIECE) of
 PREV with
 (NEXTPIECE PC)))
     (freplace
 (PIECE PREVPIECE) of
 (OR (NEXTPIECE PC)
                                        (ffetch
 (TEXTOBJ LASTPIECE) of
 TEXTOBJ)) with
 PREV])
 
 (\TEDIT.SPLITPIECE

-  [LAMBDA (PC CHOFFSET TEXTOBJ)
                              (* ; "Edited 17-Mar-2024 00:11 by rmk")


+  [LAMBDA (PC CHOFFSET TEXTOBJ)
                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 00:11 by rmk")


                                                              (* ; "Edited 28-Dec-2023 22:17 by rmk")


                                                              (* ; "Edited  7-Dec-2023 21:07 by rmk")


                                                              (* ; "Edited 25-Nov-2023 11:50 by rmk")


@@ -687,7 +697,7 @@
                               (CONSTANT (APPEND STRING.PTYPES FILE.PTYPES)))
                                                              (* ; 
 
                  "Dont' want the error under the UNINTERRABPTABLY.  Remove when everything is good.")

-                 (SHOULDNT "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
+                 (\TEDIT.THELP "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
 
              (* ;; "")

 
@@ -817,7 +827,8 @@
     PIECES])
 
 (\TEDIT.DELETEPIECES

-  [LAMBDA (SELPIECES TEXTOBJ)
                                (* ; "Edited 16-Mar-2024 10:00 by rmk")


+  [LAMBDA (SELPIECES TEXTOBJ)
                                (* ; "Edited 26-Nov-2024 10:50 by rmk")


+                                                             (* ; "Edited 16-Mar-2024 10:00 by rmk")


                                                              (* ; "Edited 25-Nov-2023 12:12 by rmk")


                                                              (* ; "Edited  4-Nov-2023 23:03 by rmk")


                                                              (* ; "Edited 22-Oct-2023 11:43 by rmk")


@@ -837,10 +848,11 @@
 
     (\TEDIT.BTVALIDATE
 '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
     (for
 PC PREV NEXT first
 (FSETTOBJ TEXTOBJ HINTPC NIL)
-                            (SETQ PREV (PREVPIECE (fetch
 (SELPIECES SPFIRST) of
 SELPIECES))) 
+                            (SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST))) 
                                                              (* ; "For incremental chain-update")

-                            (SETQ NEXT (OR (NEXTPIECE (fetch
 (SELPIECES SPLAST) of
 SELPIECES))
-                                           (FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces
 SELPIECES
+                            (SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
+                                           (FGETTOBJ TEXTOBJ LASTPIECE)))
+                            (FSETTOBJ TEXTOBJ \DIRTY T) inselpieces
 SELPIECES
        do
 (UNINTERRUPTABLY
               (\TEDIT.UPDATEPCNODES
 PC (IMINUS (PLEN PC))
                      TEXTOBJ)
@@ -856,9 +868,9 @@
                                                   (* ;; 
 
           "TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.")

 
-                                                  (FSETPC (fetch
 (SELPIECES SPFIRST) of
 SELPIECES)
+                                                  (FSETPC (GETSPC SELPIECES SPFIRST)
                                                          PREVPIECE NIL)
-                                                  (FSETPC (fetch
 (SELPIECES SPLAST) of
 SELPIECES)
+                                                  (FSETPC (GETSPC SELPIECES SPLAST)
                                                          NEXTPIECE NIL))
     (\TEDIT.BTVALIDATE
 '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
 
@@ -1057,12 +1069,13 @@
 
 (\TEDIT.BTFAIL

   [LAMBDA (STRING VAL)
-    (DECLARE
 (USEDFREE TAG MSG))
                             (* ; "Edited 28-May-2023 08:45 by rmk")

-    (HELP (CONCAT (OR TAG "")
-                 " "
-                 (OR MSG "")
-                 ": " STRING)
-          VAL])
+    (DECLARE
 (USEDFREE TAG MSG))
                             (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 28-May-2023 08:45 by rmk")

+    (\TEDIT.THELP (CONCAT (OR TAG "")
+                         " "
+                         (OR MSG "")
+                         ": " STRING)
+           VAL])
 
 (\TEDIT.MATCHPCS

   [LAMBDA (NODE)
                                             (* ; "Edited 16-Mar-2024 11:07 by rmk")


@@ -1085,13 +1098,13 @@
 (GLOBALVARS BTVALIDATETAGS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
-\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) (
-\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) (
-\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE 
-35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) (
-\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 . 
-52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) (
-\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693
- . 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492)))))
+  (FILEMAP (NIL (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
+\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) (
+\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) (
+\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE 
+36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) (
+\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 . 
+53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) (
+\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729
+ . 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670)))))
 STOP

library/tedit/TEDIT-RENAMES

@@ -0,0 +1,172 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED " 2-Aug-2024 08:48:45" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;5
 7187   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS TEDITSYMBOLMAP)
+
+      :PREVIOUS-DATE "22-Jul-2024 11:31:22" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;4)
+
+
+(PRETTYCOMPRINT TEDIT-RENAMESCOMS)
+
+(RPAQQ TEDIT-RENAMESCOMS
 (
+                          (* ;; "TEDITSYMBOLMAP is a list that maps names for current TEDIT items  (e.g.  \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE).")

+
+                          
+                          (* ;; 
+
                        "FORWARDEDFILES  maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")

+
+                          (VARS TEDITSYMBOLMAP)
+                          (VARS FORWARDEDFILES)))
+
+
+
+(* ;; 
+"TEDITSYMBOLMAP is a list that maps names for current TEDIT items  (e.g.  \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE)."
+)

+
+
+
+
+(* ;; "FORWARDEDFILES  maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")

+
+
+(RPAQQ TEDITSYMBOLMAP

+       ((MB.NB.ARRANGEBUTTONS MB.NB.PACKITEMS)
+        (MB.NWAYBUTTON.BUTTONEVENTINFN MB.NWAYBUTTON.SELFN)
+        (\TEDIT.BTFAIL BTFAIL)
+        (\TEDIT.BTVALIDATE BTVALIDATE)
+        (\TEDIT.BTVALIDATE.PRINT BTVALIDATE.PRINT)
+        (\TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.LOOKS)
+        (\TEDIT.CHECK-BTREE CHECK-BTREE)
+        (\TEDIT.CHECK-BTREE1 CHECK-BTREE1)
+        (\TEDIT.EQCLOOKS EQCLOOKS)
+        (\TEDIT.EQFMTSPEC EQFMTSPEC)
+        (\TEDIT.REOPENTEXTSTREAM REOPENTEXTSTREAM)
+        (\TEDIT.SAMECLOOKS SAMECLOOKS)
+        (\TEDIT.DO.BLUEPENDINGDELETE TEDIT.DO.BLUEPENDINGDELETE)
+        (\TEDIT.FORMATBOX TEDIT.FORMATBOX)
+        (\TEDIT.FORMATFOLIO TEDIT.FORMATFOLIO)
+        (\TEDIT.FORMATHEADING TEDIT.FORMATHEADING)
+        (\TEDIT.FORMATPAGE TEDIT.FORMATPAGE)
+        (\TEDIT.FORMATTEXTBOX TEDIT.FORMATTEXTBOX)
+        (\TEDIT.GET.CHARLOOKS0 TEDIT.GET.CHARLOOKS0)
+        (\TEDIT.GET.OBJECT TEDIT.GET.OBJECT)
+        (\TEDIT.GET.OBJECT0 TEDIT.GET.OBJECT0)
+        (\TEDIT.GET.PARALOOKS0 TEDIT.GET.PARALOOKS0)
+        (\TEDIT.GET.PCTB0 TEDIT.GET.PCTB0)
+        (\TEDIT.PUT.OBJECT TEDIT.PUT.OBJECT)
+        (\TEDIT.RESET.EXTEND.PENDING.DELETE TEDIT.RESET.EXTEND.PENDING.DELETE)
+        (\TEDIT.SELECTED.PIECES TEDIT.SELECTED.PIECES)
+        (\TEDIT.UPDATE.SCREEN TEDIT.UPDATE.SCREEN)
+        (\TEDIT.ALIGNEDPIECE \ALIGNEDPIECE)
+        (\TEDIT.BACKFORMAT \BACKFORMAT)
+        (\TEDIT.CHTOPC \CHTOPC)
+        (\TEDIT.COPYSEL \COPYSEL)
+        (\TEDIT.CREATE.TEDIT.RESTART.MENU \CREATE.TEDIT.RESTART.MENU)
+        (\TEDIT.DELETEPIECES \DELETEPIECES)
+        (\TEDIT.DELETETREE \DELETETREE)
+        (\TEDIT.DISPLAYLINE \DISPLAYLINE)
+        (\TEDIT.DISPLAYLINE.TABS \DISPLAYLINE.TABS)
+        (\TEDIT.FILLPANE \FILLPANE)
+        (\TEDIT.FIRSTPIECE \FIRSTPIECE)
+        (\TEDIT.FIXSEL \FIXSEL)
+        (\TEDIT.FORMATBLOCK \FORMATBLOCK)
+        (\TEDIT.FORMATLINE \FORMATLINE)
+        (\TEDIT.FORMATLINE.EMPTY \FORMATLINE.EMPTY)
+        (\TEDIT.FORMATLINE.JUSTIFY \FORMATLINE.JUSTIFY)
+        (\TEDIT.FORMATLINE.LASTLEGAL \FORMATLINE.LASTLEGAL)
+        (\TEDIT.FORMATLINE.PURGE.SPACES \FORMATLINE.PURGE.SPACES)
+        (\TEDIT.FORMATLINE.SCALETABS \FORMATLINE.SCALETABS)
+        (\TEDIT.FORMATLINE.SETUP \FORMATLINE.SETUP)
+        (\TEDIT.FORMATLINE.TABS \FORMATLINE.TABS)
+        (\TEDIT.FORMATLINE.UPDATELOOKS \FORMATLINE.UPDATELOOKS)
+        (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \HARDCOPY.FORMATLINE.HEADINGS)
+        (\TEDIT.INSERT TEDIT.\INSERT)
+        (\TEDIT.INSERTCH \INSERTCH)
+        (\TEDIT.INSERTCH.EXTEND \INSERTCH.EXTEND)
+        (\TEDIT.INSERTCH.HISTORY \INSERTCH.HISTORY)
+        (\TEDIT.INSERTCH.INSERTION \INSERTCH.INSERTION)
+        (\TEDIT.INSERTEOL \INSERTEOL)
+        (\TEDIT.INSERTPIECE \INSERTPIECE)
+        (\TEDIT.INSERTPIECES \INSERTPIECES)
+        (\TEDIT.INSERTTREE \INSERTTREE)
+        (\TEDIT.LASTPIECE \LASTPIECE)
+        (\TEDIT.LINKNEWPIECE \LINKNEWPIECE)
+        (\TEDIT.MAKE.VACANT.BTREESLOT \MAKE.VACANT.BTREESLOT)
+        (\TEDIT.MAKEPCTB \MAKEPCTB)
+        (\TEDIT.MATCHPCS \MATCHPCS)
+        (\TEDIT.NAMEDTAB.INIT \NAMEDTAB.INIT)
+        (\TEDIT.PCTOCH \PCTOCH)
+        (\TEDIT.PRIMARYPANE \TEDIT.PRIMARYW)
+        (\TEDIT.SELPIECES \SELPIECES)
+        (\TEDIT.SELPIECES.CHARTRANSFORM \SELPIECES.CHARTRANSFORM)
+        (\TEDIT.SELPIECES.CONCAT \SELPIECES.CONCAT)
+        (\TEDIT.SELPIECES.COPY \SELPIECES.COPY)
+        (\TEDIT.SELPIECES.FROM.STRING \SELPIECES.FROM.STRING)
+        (\TEDIT.SELPIECES.TO.STRING \SELPIECES.TO.STRING)
+        (\TEDIT.SHOWSEL \SHOWSEL)
+        (\TEDIT.SPLITPIECE \SPLITPIECE)
+        (\TEDIT.TEDIT.FORMATLINES \TEDIT.FORMATLINES)
+        (\TEDIT.POSTSCRIPT.HARDCOPY \TEDIT.HARDCOPY)
+        (\TEDIT.TEDIT.HARDCOPY \TEDIT.HARDCOPY)
+        (\TEDIT.TEXTBACKFILEPTR \TEXTBACKFILEPTR)
+        (\TEDIT.TEXTBIN \TEXTBIN)
+        (\TEDIT.TEXTBOUT \TEXTBOUT)
+        (\TEDIT.TEXTCLOSEF \TEXTCLOSEF)
+        (\TEDIT.TEXTDSPCHARWIDTH \TEXTDSPCHARWIDTH)
+        (\TEDIT.TEXTDSPFONT \TEXTDSPFONT)
+        (\TEDIT.TEXTDSPLINEFEED \TEXTDSPLINEFEED)
+        (\TEDIT.TEXTDSPSTRINGWIDTH \TEXTDSPSTRINGWIDTH)
+        (\TEDIT.TEXTDSPXPOSITION \TEXTDSPXPOSITION)
+        (\TEDIT.TEXTDSPYPOSITION \TEXTDSPYPOSITION)
+        (\TEDIT.TEXTEOFP \TEXTEOFP)
+        (\TEDIT.TEXTGETEOFPTR \TEXTGETEOFPTR)
+        (\TEDIT.TEXTGETFILEPTR \TEXTGETFILEPTR)
+        (\TEDIT.TEXTINIT \TEXTINIT)
+        (\TEDIT.TEXTLEFTMARGIN \TEXTLEFTMARGIN)
+        (\TEDIT.TEXTOPENF \TEXTOPENF)
+        (\TEDIT.TEXTPEEKBIN \TEXTPEEKBIN)
+        (\TEDIT.TEXTRIGHTMARGIN \TEXTRIGHTMARGIN)
+        (\TEDIT.TEXTSETEOF \TEXTSETEOF)
+        (\TEDIT.TEXTSETFILEPTR \TEXTSETFILEPTR)
+        (\TEDIT.TEXTBACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
+        (\TEDIT.TEXTSTREAM.BACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
+        (\TEDIT.TEXTFORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
+        (\TEDIT.TEXTSTREAM.FORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
+        (\TEDIT.TEXTINCCODEFN \TEXTSTREAM.INCCCODEFN)
+        (\TEDIT.TEXTSTREAM.INCCCODEFN \TEXTSTREAM.INCCCODEFN)
+        (\TEDIT.TEXTOUTCHARFN \TEXTSTREAM.OUTCHARFN)
+        (\TEDIT.TEXTSTREAM.OUTCHARFN \TEXTSTREAM.OUTCHARFN)
+        (\TEDIT.TEXTTTYBOUT \TEXTTTYBOUT)
+        (\TEDIT.UNLINKPIECE \UNLINKPIECE)
+        (\TEDIT.UPDATEPCNODES \UPDATEPCNODES)
+        (\TEDIT.XYTOSEL \TEDIT.SELECT.LINE.SCANNER)))
+
+(RPAQQ FORWARDEDFILES

+       ((PCTREE TEDIT-PCTREE)
+        (TEDIT TEDIT)
+        (TEDIT-FILE TEDIT-FILE)
+        (TEDIT-TEXTOFD TEDIT-STREAM)
+        (TEDITABBREV TEDIT-ABBREV)
+        (TEDITCHAT TEDIT-CHAT)
+        (TEDITCOMMAND TEDIT-COMMAND)
+        (TEDITDCL TEDITDCL)
+        (TEDITDEBUG TEDIT-DEBUG)
+        (TEDITFILE TEDIT-FILE TEDIT-OLDFILE)
+        (TEDITFIND TEDIT-FIND)
+        (TEDITFNKEYS TEDIT-FNKEYS)
+        (TEDITHCPY TEDIT-HCPY)
+        (TEDITHISTORY TEDIT-HISTORY)
+        (TEDITLOOKS TEDIT-LOOKS)
+        (TEDITMENU TEDIT-MENU)
+        (TEDITPAGE TEDIT-PAGE)
+        (TEDITSCREEN TEDIT-SCREEN)
+        (TEDITSELECTION TEDIT-SELECTION)
+        (TEDITWINDOW TEDIT-WINDOW)
+        (TFBRAVO TEDIT-TFBRAVO)))
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL)))
+STOP

library/tedit/TEDIT-STRESS

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Mar-2024 21:34:32" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;70
 15296  
+
(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}<library>tedit>TEDIT-STRESS.;71
 15583  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK)
-                  (VARS TEDIT-STRESSCOMS)
+      :CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
 
-      :PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;54)
+      :PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
 
 
 (PRETTYCOMPRINT TEDIT-STRESSCOMS)
@@ -25,6 +24,7 @@
 
 (STRESSHC

   [LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)

+                                                             (* ; "Edited 21-Oct-2024 00:26 by rmk")


                                                              (* ; "Edited 19-Mar-2024 21:33 by rmk")


                                                              (* ; "Edited 14-Mar-2024 15:15 by rmk")


                                                              (* ; "Edited 13-Mar-2024 00:23 by rmk")

@@ -83,7 +83,7 @@
                               T))
                 (CLOSEF? TSTRM)
                 (CL:WHEN SINGLESTEP
-                    (HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
+                    (\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
           (PRINTOUT T "  Hardcopied " N " files without failure" T)
        finally
 (RETURN (LIST R N])
 
@@ -121,7 +121,8 @@
                                                      T)) finally
 (RETURN (LIST R N])
 
 (STRESSPUT

-  [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP)
               (* ; "Edited 19-Mar-2024 21:34 by rmk")


+  [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP)
               (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 19-Mar-2024 21:34 by rmk")


                                                              (* ; "Edited 12-Mar-2024 09:48 by rmk")

 
     (* ;; "Opens, puts, reopens and tests for equivalence")

@@ -142,13 +143,13 @@
                                     (TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
                                     (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
                                     (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM
 TSTRM TSP STOP)))
-                                           (HELP "Get of put not equivalent" F))
+                                           (\TEDIT.THELP "Get of put not equivalent" F))
                                     (CLOSEF TSP))
                       else
 (SETQ TSTRM (OPENTEXTSTREAM F))
                            (TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
                            (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
                            (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM
 TSTRM TSP STOP)))
-                                  (HELP "Get of put not equivalent" F))
+                                  (\TEDIT.THELP "Get of put not equivalent" F))
                            (CLOSEF TSP))
                     then
 (CLOSEF TSTRM)
                          (add
 N 1)
@@ -242,7 +243,8 @@
 (DEFINEQ
 
 (EQTEXTSTREAM

-  [LAMBDA (TS1 TS2 STOP)
                                     (* ; "Edited 11-Mar-2024 16:53 by rmk")

+  [LAMBDA (TS1 TS2 STOP)
                                     (* ; "Edited 21-Oct-2024 00:26 by rmk")


+                                                             (* ; "Edited 11-Mar-2024 16:53 by rmk")

     (AND (IEQP (TEDIT.NCHARS TS1)
                (TEDIT.NCHARS TS2))
          (OR (for
 I C1 C2 from
 1 to
 (TEDIT.NCHARS TS1) eachtime
 (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
@@ -255,8 +257,8 @@
                            (AND (IMAGEOBJP C1)
                                 (IMAGEOBJP C2)
                                 (EQUALALL C1 C2))) do
 (CL:WHEN STOP
-                                                          (HELP "Different characters: "
-                                                                (LIST I C1 C2)))
+                                                          (\TEDIT.THELP "Different characters: "
+                                                                 (LIST I C1 C2)))
                                                       (RETURN NIL) finally
 (RETURN T])
 
 (SYSOUTRING

@@ -293,7 +295,7 @@
        finally
 (CL:UNLESS NORECLAIM (RECLAIM])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) (
-STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695
-)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271)))))
+  (FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) (
+STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864
+)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558)))))
 STOP

library/tedit/TEDIT-TFBRAVO

@@ -1,15 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Mar-2024 18:27:18" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;153
 91304  
+
(FILECREATED "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163
 92210  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-TFBRAVOCOMS)
-                  (FNS \TEDIT.NAMEDTAB.INIT)
+      :CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS)
 
-      :PREVIOUS-DATE "17-Mar-2024 12:41:56" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152)
+      :PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;162)
 
 
 (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -124,7 +121,7 @@
                                                   (WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72)))
                                                                 NUM))
                                                   (NIL NUM)
-                                                  (HELP "UNKNOWN DIMENSION" DIMENSION))))
+                                                  (\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION))))
                                 NUM)))
 )
 
@@ -303,7 +300,8 @@
     (SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
 
 (\TFBRAVO.READ.USER.CM

-  [LAMBDA (USER.CM)
                                          (* ; "Edited 18-Aug-2023 22:26 by rmk")


+  [LAMBDA (USER.CM)
                                          (* ; "Edited 27-Aug-2024 18:12 by rmk")


+                                                             (* ; "Edited 18-Aug-2023 22:26 by rmk")


                                                              (* ; "Edited 10-Aug-2023 13:02 by rmk")


                                                              (* ; "Edited  7-Aug-2023 12:52 by rmk")


                                                              (* ; "Edited  1-Aug-2023 22:11 by rmk")


@@ -330,7 +328,9 @@
 
           LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL)))
                                                    USER.CM USER.CM.RDTBL)))
-                     (RETURN ALIST))                         (* ; 
+                  (CL:UNLESS (ASSOC 'DefaultTab ALIST)
+                      (push
 ALIST (CONS 'DefaulTab DEFAULTTAB)))
+                  (RETURN ALIST))                            (* ; 
 
                                                           "If the '[BRAVO]' section is the last one")

               (COND
                  ((NULL LINE)                                (* ; "ignore blank lines")

@@ -378,7 +378,9 @@
               (GO LLP)))])
 
 (\TFBRAVO.INIT.PARALOOKS

-  [LAMBDA (ALIST)
                                            (* ; "Edited 13-Aug-2023 11:27 by rmk")


+  [LAMBDA (ALIST)
                                            (* ; "Edited  4-Aug-2024 22:17 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 21:36 by rmk")


+                                                             (* ; "Edited 13-Aug-2023 11:27 by rmk")


                                                              (* ; "Edited  8-Aug-2023 23:51 by rmk")


                                                              (* ; "Edited  7-Aug-2023 14:59 by rmk")


                                                              (* ; "Edited 31-May-91 15:26 by jds")

@@ -400,8 +402,8 @@
                (SETQ LEADBEFORE (OR (CADR (ASSOC 'ParagraphLeading ALIST))
                                     0))
                (SETQ LEADAFTER 0)
-               (SETQ TABSPEC (LIST (OR (CADR (ASSOC 'DefaultTab ALIST))
-                                       36)))
+               (SETQ FMTDEFAULTTAB (OR (CADR (ASSOC 'DefaultTab ALIST))
+                                       DEFAULTTAB))
                (SETQ FMTSPECIALX 0)
                (SETQ FMTSPECIALY 0))
          INITFMTSPEC])
@@ -491,7 +493,8 @@
 (DEFINEQ
 
 (\TFBRAVO.PARSE.PARA

-  [LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ)
                       (* ; "Edited 14-Nov-2023 13:03 by rmk")


+  [LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ)
                       (* ; "Edited 21-Oct-2024 00:33 by rmk")


+                                                             (* ; "Edited 14-Nov-2023 13:03 by rmk")


                                                              (* ; "Edited  7-Nov-2023 21:53 by rmk")


                                                              (* ; "Edited 21-Aug-2023 23:41 by rmk")


                                                              (* ; "Edited 20-Aug-2023 22:48 by rmk")


@@ -540,14 +543,18 @@
               (^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS
 OLDFMTSPEC BSTREAM TEXTOBJ))
                   (SETQ RUNS (\TFBRAVO.CREATE.RUNS
 BSTREAM PSTART PLEN)))
               (NIL)
-              (SHOULDNT "Bravo paragraph not ending in ^Z, CR, EOF"))
+              (\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF"))
          (create
 PARA
                 PARAFMTSPEC _ FMTSPEC
                 RUNS _ RUNS
                 FORMATPTRS _ FORMATPTRS])
 
 (\TFBRAVO.READ.PARALOOKS

-  [LAMBDA (OLDFMTSPEC BSTREAM)
                               (* ; "Edited  9-Sep-2023 21:40 by rmk")


+  [LAMBDA (OLDFMTSPEC BSTREAM)
                               (* ; "Edited 19-Dec-2024 23:42 by rmk")


+                                                             (* ; "Edited 21-Oct-2024 00:27 by rmk")


+                                                             (* ; "Edited 27-Aug-2024 21:59 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 21:39 by rmk")


+                                                             (* ; "Edited  9-Sep-2023 21:40 by rmk")


                                                              (* ; "Edited 21-Aug-2023 21:43 by rmk")


                                                              (* ; "Edited 20-Aug-2023 15:48 by rmk")


                                                              (* ; "Edited 18-Aug-2023 23:08 by rmk")


@@ -560,55 +567,55 @@
     (* ;; 
 
    "Decodes bravo paragraph looks into a TEDIT FMTSPEC.  OLDFMTSPEC is used just for its tabs.")

 
-    (bind
 LMFLAG 1LMFLAG COMMAND TABX TABNAME TABDEFAULT NAMEDTABS (NEWFMTSPEC _
-                                                                          (create
 FMTSPEC
-                                                                             using
 USER.CM.FMTSPEC))
-       first
 (CL:UNLESS (EQ 'PROFILE (fetch
 (FMTSPEC FMTPARATYPE) of
 OLDFMTSPEC))
+    (\DTEST OLDFMTSPEC 'FMTSPEC)
+    (bind
 LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC 
+                                                                             FMTDEFAULTTAB))
+          (NEWFMTSPEC _ (create
 FMTSPEC using
 USER.CM.FMTSPEC))
+       first
 (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC FMTPARATYPE))
 
                  (* ;; "It appears that heading-tabs don't carry over to other paragraphs.  Although maybe the default interval-tab does?")

 
-                 (SETQ TABDEFAULT (CAR (fetch
 (FMTSPEC TABSPEC) of
 OLDFMTSPEC)))
+                 (SETQ TABDEFAULT (OR (FGETPARA OLDFMTSPEC FMTDEFAULTTAB)
+                                      (FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
 
                  (* ;; "We don't put the NAMEDTABS in the TABSPEC since we don't know which ones will be activated by any particular run. ")

 
-                 (SETQ NAMEDTABS (COPY (fetch
 (FMTSPEC FMTUSERINFO) of
 OLDFMTSPEC))))
+                 (SETQ NAMEDTABS (COPY (FGETPARA OLDFMTSPEC FMTUSERINFO))))
        do
 (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
                (l (SETQ LMFLAG T)
-                  (replace
 (FMTSPEC LEFTMAR) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T
-                                                                       'MICATOHALFPICAPOINTS)))
+                  (FSETPARA NEWFMTSPEC LEFTMAR (\TFBRAVO.READNUM?
 BSTREAM T 'MICATOHALFPICAPOINTS)))
                (d (SETQ 1LMFLAG T)
-                  (replace
 (FMTSPEC 1STLEFTMAR) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T
-                                                                          'MICATOHALFPICAPOINTS)))
-               (z (replace
 (FMTSPEC RIGHTMAR) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T
-                                                                        'MICATOHALFPICAPOINTS)))
-               (x (replace
 (FMTSPEC LINELEAD) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T)))
-               (e (replace
 (FMTSPEC LEADAFTER) of
 NEWFMTSPEC with
 0)
-                  (replace
 (FMTSPEC LEADBEFORE) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T)))
+                  (FSETPARA NEWFMTSPEC 1STLEFTMAR (\TFBRAVO.READNUM?
 BSTREAM T 'MICATOHALFPICAPOINTS)
+                         ))
+               (z (FSETPARA NEWFMTSPEC RIGHTMAR (\TFBRAVO.READNUM?
 BSTREAM T 'MICATOHALFPICAPOINTS)))
+               (x (FSETPARA NEWFMTSPEC LINELEAD (\TFBRAVO.READNUM?
 BSTREAM T)))
+               (e (FSETPARA NEWFMTSPEC LEADAFTER 0)
+                  (FSETPARA NEWFMTSPEC LEADBEFORE (\TFBRAVO.READNUM?
 BSTREAM T)))
                (y                                            (* ; "vertical tabs are supported")

-                  (replace
 (FMTSPEC FMTSPECIALX) of
 NEWFMTSPEC with
 0)
-                  (replace
 (FMTSPEC FMTSPECIALY) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T)))
-               (k (replace
 (FMTSPEC FMTHEADINGKEEP) of
 NEWFMTSPEC with
 (\TFBRAVO.READNUM?
 BSTREAM T)))
+                  (FSETPARA NEWFMTSPEC FMTSPECIALX 0)
+                  (FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM?
 BSTREAM T)))
+               (k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM?
 BSTREAM T)))
                (w 'HardcopyMode)
-               (j (replace
 (FMTSPEC QUAD) of
 NEWFMTSPEC with
 'JUSTIFIED))
-               (c (replace
 (FMTSPEC QUAD) of
 NEWFMTSPEC with
 'CENTERED))
+               (j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED))
+               (c (FSETPARA NEWFMTSPEC QUAD 'CENTERED))
                (q 
                   (* ;; "Profiles are marked here but then interpreted at the top")

 
-                  (replace
 (FMTSPEC FMTPARATYPE) of
 NEWFMTSPEC with
 'PROFILE))
+                  (FSETPARA NEWFMTSPEC FMTPARATYPE 'PROFILE))
                (%(                                           (* ; "Collect the named tabs")

                    (SETQ TABX (\TFBRAVO.READNUM?
 BSTREAM T)) (* ; "Name or X position")

 
                    (* ;; "Tabs apparently round down/truncate, not up.")

 
                    (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
-                        (%) (SETQ TABDEFAULT (FIXR (FQUOTIENT TABX MICASPERPT))))
+                        (%) (SETQ TABDEFAULT (HCUNSCALE MICASPERPT TABX)))
                         (%, (CL:WHEN (IGREATERP TABX 14)
-                                   (HELP TABX " is not a legal tab-name"))
+                                   (\TEDIT.THELP TABX " is not a legal tab-name"))
                             (SETQ TABNAME (ADD1 TABX))       (* ; "Adding 1 to align with t1, t2...")

                             (SETQ TABX (\TFBRAVO.READNUM?
 BSTREAM T))
                             (CL:UNLESS (EQ (CHARCODE %))
                                            (BIN BSTREAM))
-                                   (HELP "MISSING CLOSING ) IN TABSPEC"))
+                                   (\TEDIT.THELP "MISSING CLOSING ) IN TABSPEC"))
 
                             (* ;; "Here we collect the tabs declared in this paragraph or inherited from before. 65535 means delete  that the named tab (possibly inherited), otherwise the name is given a new TABX for all runs of this paragraph and beyond.")

 
@@ -618,23 +625,22 @@
                               else
 (RPLACD [OR (ASSOC TABNAME NAMEDTABS)
                                                (CAR (push
 NAMEDTABS (CONS TABNAME]
                                           (create
 TAB
-                                                 TABX _ (FIXR (FQUOTIENT TABX MICASPERPT))
+                                                 TABX _ (HCUNSCALE MICASPERPT TABX)
                                                  TABKIND _ 'LEFT])
-                        (HELP "ILLFORMED BRAVO TAB SPEC")))
+                        (\TEDIT.THELP "ILLFORMED BRAVO TAB SPEC")))
                (SPACE)
                ((CR \) 
                     (CL:WHEN (AND LMFLAG (NOT 1LMFLAG))      (* ; 
 
                                   "If there was a Left margin but no firstline left then default it")

-                        (replace
 (FMTSPEC 1STLEFTMAR) of
 NEWFMTSPEC with
 (fetch
 (FMTSPEC LEFTMAR)
-                                                                            of
 NEWFMTSPEC)))
-                    (replace
 TABSPEC of
 NEWFMTSPEC with
 (CONS TABDEFAULT))
-                    (replace
 (FMTSPEC FMTUSERINFO) of
 NEWFMTSPEC with
 (DREVERSE NAMEDTABS))
+                        (FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR)))
+                    (FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT)
+                    (FSETPARA NEWFMTSPEC FMTUSERINFO (DREVERSE NAMEDTABS))
                     (CL:WHEN (EQ COMMAND (CHARCODE CR))      (* ; 
 
                                                 "Read the \ separator, but leave the terminating CR")

                         (\BACKFILEPTR BSTREAM))
                     (RETURN NEWFMTSPEC))
-               (HELP (CHARACTER COMMAND)
-                     '" is not a legal Bravo paragraph-format character"])
+               (\TEDIT.THELP (CHARACTER COMMAND)
+                      '" is not a legal Bravo paragraph-format character"])
 
 (\TFBRAVO.CREATE.RUNS

   [LAMBDA (BSTREAM PSTART PLEN)
                              (* ; "Edited 14-Nov-2023 13:01 by rmk")


@@ -654,7 +660,8 @@
                                                 (SETQ OLDCHARLOOKS (fetch
 (RUN RUNLOOKS) of
 RUN])
 
 (\TFBRAVO.READ.CHARLOOKS

-  [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN)
               (* ; "Edited  9-Sep-2023 21:39 by rmk")


+  [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN)
               (* ; "Edited 21-Oct-2024 00:27 by rmk")


+                                                             (* ; "Edited  9-Sep-2023 21:39 by rmk")


                                                              (* ; "Edited 20-Aug-2023 16:15 by rmk")


                                                              (* ; "Edited 18-Aug-2023 20:11 by rmk")


                                                              (* ; "Edited 31-May-91 15:25 by jds")

@@ -709,8 +716,8 @@
                           (SETQ LEN PLEN))                   (* ; 
 
                                       "Otherwise, PLEN is what's left for the final substantive run")

                    (GO $$OUT))
-               (HELP (CHARACTER COMMAND)
-                     " is not a legal Bravo command character look"))
+               (\TEDIT.THELP (CHARACTER COMMAND)
+                      " is not a legal Bravo command character look"))
        finally
 
 
              (* ;; "Wait til end to do font, so we have the bold/italic looks for sure.  Last run may not have an explicit length")

@@ -1087,7 +1094,9 @@
          NEWPARAS])
 
 (\TFBRAVO.RUN.TABSPEC

-  [LAMBDA (RUN PARAFMTSPEC)
                                  (* ; "Edited 15-Mar-2024 19:42 by rmk")


+  [LAMBDA (RUN PARAFMTSPEC)
                                  (* ; "Edited 27-Aug-2024 22:02 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 21:30 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 19:42 by rmk")


                                                              (* ; "Edited 22-Aug-2023 16:54 by rmk")


                                                              (* ; "Edited 19-Aug-2023 15:47 by rmk")

 
@@ -1105,41 +1114,43 @@
 
     (* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1.  t0 doesn't match.")

 
-    (LET ([LASTTAB (CAR (LAST (CDR (fetch
 (FMTSPEC TABSPEC) of
 PARAFMTSPEC]
-          (TABDEFS (fetch
 (FMTSPEC FMTUSERINFO) of
 PARAFMTSPEC))
-          (TABDEFAULT (CAR (fetch
 (FMTSPEC TABSPEC) of
 PARAFMTSPEC)))
+    (DECLARE
 (USEDFREE USER.CM.FMTSPEC))
+    (LET ([LASTTAB (CAR (LAST (FGETPARA PARAFMTSPEC FMTTABS]
+          (TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
+          (TABDEFAULT (OR (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)
+                          (FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
           (RUNTABS (fetch
 (RUN RUNTABS) of
 RUN))
-          TAB TABSPEC)
+          TAB TABS)
          (CL:WHEN (AND TABDEFS (NULL RUNTABS))
              (SETQ RUNTABS (CONS (CAAR TABDEFS))))
          (CL:WHEN (AND TABDEFS RUNTABS)
              (CL:WHEN (EQUAL RUNTABS '(0))                   (* ; 
 
                "If e.g. Tab 0 is set but the run has no tn's, assume that the first tn is intended.")

                  (SETQ RUNTABS '(1 2)))
-             [SETQ TABSPEC (for
 TABNAME in
 RUNTABS
-                              collect
 
+             [SETQ TABS (for
 TABNAME in
 RUNTABS
+                           collect
 
 
-                                    (* ;; 
+                                 (* ;; 
 
                         "For t0 we try to find the tab after the one last used in the previous run.")

 
-                                    (if
 (CDR (ASSOC TABNAME TABDEFS))
-                                      elseif
 [AND (EQ TABNAME 0)
-                                                  (for
 TDTAIL TD on
 TABDEFS
-                                                     eachtime
 (SETQ TD (CAR TDTAIL))
-                                                     when
 (EQ LASTTAB (CDR TD))
-                                                     do
 [SETQ TABDEFAULT (fetch
 TABX
-                                                                            of
 (CDR (CADR TDTAIL]
-                                                        (RETURN (CDR (CADR TDTAIL]
-                                      else
 (GO $$ITERATE]
+                                 (if
 (CDR (ASSOC TABNAME TABDEFS))
+                                   elseif
 [AND (EQ TABNAME 0)
+                                               (for
 TDTAIL TD on
 TABDEFS eachtime
 (SETQ TD
+                                                                                   (CAR TDTAIL))
+                                                  when
 (EQ LASTTAB (CDR TD))
+                                                  do
 [SETQ TABDEFAULT (fetch
 TABX
+                                                                         of
 (CDR (CADR TDTAIL]
+                                                     (RETURN (CDR (CADR TDTAIL]
+                                   else
 (GO $$ITERATE]
 
              (* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph.  That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings.  Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph.  So things would go bonkers.")

 
-             [SETQ TABSPEC (SORT (for
 TAB in
 TABDEFS collect
 (CDR TAB))
-                                 (FUNCTION (LAMBDA (T1 T2)
-                                             (ILEQ (fetch
 (TAB TABX) of
 T1)
-                                                   (fetch
 (TAB TABX) of
 T2]
-             (SETQ PARAFMTSPEC (create
 FMTSPEC using
 PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT TABSPEC))
-              ))
+             [SETQ TABS (SORT (for
 TAB in
 TABDEFS collect
 (CDR TAB))
+                              (FUNCTION (LAMBDA (T1 T2)
+                                          (ILEQ (fetch
 (TAB TABX) of
 T1)
+                                                (fetch
 (TAB TABX) of
 T2]
+             (SETQ PARAFMTSPEC (create
 FMTSPEC using
 PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
+                                                     TABS)))
          PARAFMTSPEC])
 
 (\TFBRAVO.INSTALL.PAGEFORMAT

@@ -1220,10 +1231,12 @@
 (DEFINEQ
 
 (\TFBRAVO.ASSERT

-  [LAMBDA (X Y)
                                              (* ; "Edited  9-Aug-2023 10:32 by rmk")

+  [LAMBDA (X Y)
                                              (* ; "Edited 21-Oct-2024 00:27 by rmk")


+                                                             (* ; "Edited  9-Aug-2023 10:32 by rmk")

                                                              (* gbn "19-Sep-84 21:39")

     (CL:UNLESS (EQ X Y)
-        (HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y " was found.")))])
+        (\TEDIT.THELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y 
+                                                                 " was found.")))])
 
 (\TEST.CHARACTER.LOOKS

   [LAMBDA (BSTREAM)
                                          (* ; "Edited 17-Aug-2023 09:18 by rmk")


@@ -1332,7 +1345,9 @@
 (DEFINEQ
 
 (\TFBRAVO.ADD.NAMEDTAB

-  [LAMBDA (RUN PARAFMTSPEC TEXTOBJ)
                          (* ; "Edited  9-Sep-2023 21:44 by rmk")


+  [LAMBDA (RUN PARAFMTSPEC TEXTOBJ)
                          (* ; "Edited  4-Aug-2024 18:05 by rmk")


+                                                             (* ; "Edited 28-Jul-2024 21:29 by rmk")


+                                                             (* ; "Edited  9-Sep-2023 21:44 by rmk")


                                                              (* ; "Edited 18-Aug-2023 18:42 by rmk")


                                                              (* ; "Edited 15-Aug-2023 00:26 by rmk")


                                                              (* ; "Edited 13-Aug-2023 19:56 by rmk")

@@ -1344,38 +1359,38 @@
     (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants.  For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that  Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs.  ")

 
     (* ;; "")

-                                                             (* ; "")

 
     (* ;; "THIS IS NOT USED, TO BE REMOVED.  RUNTABOFFSETS DOESN'T EXIST")

 
+    (NOTUSED)
     (LET ((RUNLOOKS (fetch
 (RUN RUNLOOKS) of
 RUN))
-          (TABDEFS (fetch
 (FMTSPEC FMTUSERINFO) of
 PARAFMTSPEC))
-          (TABDEFAULT (CAR (fetch
 (FMTSPEC TABSPEC) of
 PARAFMTSPEC)))
+          (TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
+          (TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB))
           (TABOFFSETS '(fetch
 (RUN RUNTABOFFSETS) of
 RUN))
-          TAB TABNAMES TABSPEC)
+          TAB TABNAMES TABS)
          (SETQ TABNAMES (fetch
 (CHARLOOKS CLUSERINFO) of
 RUNLOOKS))
          (CL:WHEN TABDEFS
              [if
 TABNAMES
-                 then
 (SETQ TABSPEC (for
 TN in
 TABNAMES eachtime
 (add
 TN -1)
-                                       when
 (SETQ TAB (CDR (ASSOC TN TABDEFS)))
-                                       unless
 (EQ TAB T) until
 (EQ TN -1) collect
 TAB))
+                 then
 (SETQ TABS (for
 TN in
 TABNAMES eachtime
 (add
 TN -1)
+                                    when
 (SETQ TAB (CDR (ASSOC TN TABDEFS)))
+                                    unless
 (EQ TAB T) until
 (EQ TN -1) collect
 TAB))
                elseif
 (CDR TABDEFS)
                  then
 
                       (* ;; "If the run has no names, then assume that its first TAB aligns at the earliest defined tab, next aligns at the second, etc. Sort tabs by increasing TABX, not names. ")

 
-                      [SETQ TABSPEC (SORT (for
 TD in
 TABDEFS collect
 (CDR TD))
-                                          (FUNCTION (LAMBDA (T1 T2)
-                                                      (ILEQ (fetch
 (TAB TABX) of
 T1)
-                                                            (fetch
 (TAB TABX) of
 T2]
+                      [SETQ TABS (SORT (for
 TD in
 TABDEFS collect
 (CDR TD))
+                                       (FUNCTION (LAMBDA (T1 T2)
+                                                   (ILEQ (fetch
 (TAB TABX) of
 T1)
+                                                         (fetch
 (TAB TABX) of
 T2]
                elseif
 (EQ 0 (CAR (CAR TABDEFS)))
                  then
 
                       (* ;; 
 
         "No name and 0, make it be the default. How else would we decide where the second tab goes?")

 
                       (SETQ TABDEFAULT (fetch
 (TAB TABX) of
 (CDAR TABDEFS]
-             (CL:WHEN [OR TABSPEC (NEQ TABDEFAULT (CAR (fetch
 (FMTSPEC TABSPEC) of
 PARAFMTSPEC]
-                 (SETQ PARAFMTSPEC (create
 FMTSPEC using
 PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT 
-                                                                                     TABSPEC)))
+             (CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)))
+                 (SETQ PARAFMTSPEC (create
 FMTSPEC using
 PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT 
+                                                         FMTTABS _ TABS))
                  (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)))
          PARAFMTSPEC])
 
@@ -1450,18 +1465,18 @@
 (AND NIL (\TEDIT.NAMEDTAB.INIT
))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6795 13177 (TEDIT.BRAVOFILE? 6805 . 8535) (TEDITFROMBRAVO 8537 . 13175)) (13288 28274 (
-\TFBRAVO.GET.USER.CM 13298 . 16108) (\TFBRAVO.USER.CM.LOOKS 16110 . 17285) (\TFBRAVO.READ.USER.CM 
-17287 . 21624) (\TFBRAVO.INIT.PARALOOKS 21626 . 23387) (\TFBRAVO.INIT.PAGEFORMAT 23389 . 24269) (
-\TFBRAVO.GETPARAMS 24271 . 27125) (\TFBRAVO.FIND.LAST.TRAILER 27127 . 28272)) (28316 48329 (
-\TFBRAVO.PARSE.PARA 28326 . 32013) (\TFBRAVO.READ.PARALOOKS 32015 . 38649) (\TFBRAVO.CREATE.RUNS 38651
- . 40039) (\TFBRAVO.READ.CHARLOOKS 40041 . 45059) (\TFBRAVO.FONT.FROM.CHARLOOKS 45061 . 46430) (
-\TFBRAVO.READNUM? 46432 . 48327)) (48366 59117 (\TFBRAVO.HANDLE.HEADING 48376 . 51008) (
-\TFBRAVO.PARSE.PROFILE.PARA 51010 . 59115)) (59160 80307 (\TFBRAVO.INSERT.PARA 59170 . 59823) (
-\TFBRAVO.INSERT.RUN 59825 . 63022) (\TFBRAVO.SPLIT.PARA 63024 . 70266) (\TFBRAVO.RUN.TABSPEC 70268 . 
-74612) (\TFBRAVO.INSTALL.PAGEFORMAT 74614 . 80305)) (80308 84268 (\TFBRAVO.ASSERT 80318 . 80665) (
-\TEST.CHARACTER.LOOKS 80667 . 82553) (\TEST.PARAGRAPH.LOOKS 82555 . 84266)) (84753 91138 (
-\TFBRAVO.ADD.NAMEDTAB 84763 . 88096) (\TFBRAVO.COPY.NAMEDTAB 88098 . 88546) (\TFBRAVO.PUT.NAMEDTAB 
-88548 . 88828) (\TFBRAVO.GET.NAMEDTAB 88830 . 89207) (\NAMEDTABNYET 89209 . 89369) (\NAMEDTABSIZE 
-89371 . 89886) (\NAMEDTABPREPRINT 89888 . 90086) (\TEDIT.NAMEDTAB.INIT 90088 . 91136)))))
+  (FILEMAP (NIL (6681 13063 (TEDIT.BRAVOFILE? 6691 . 8421) (TEDITFROMBRAVO 8423 . 13061)) (13174 28618 (
+\TFBRAVO.GET.USER.CM 13184 . 15994) (\TFBRAVO.USER.CM.LOOKS 15996 . 17171) (\TFBRAVO.READ.USER.CM 
+17173 . 21743) (\TFBRAVO.INIT.PARALOOKS 21745 . 23731) (\TFBRAVO.INIT.PAGEFORMAT 23733 . 24613) (
+\TFBRAVO.GETPARAMS 24615 . 27469) (\TFBRAVO.FIND.LAST.TRAILER 27471 . 28616)) (28660 48692 (
+\TFBRAVO.PARSE.PARA 28670 . 32470) (\TFBRAVO.READ.PARALOOKS 32472 . 38894) (\TFBRAVO.CREATE.RUNS 38896
+ . 40284) (\TFBRAVO.READ.CHARLOOKS 40286 . 45422) (\TFBRAVO.FONT.FROM.CHARLOOKS 45424 . 46793) (
+\TFBRAVO.READNUM? 46795 . 48690)) (48729 59480 (\TFBRAVO.HANDLE.HEADING 48739 . 51371) (
+\TFBRAVO.PARSE.PROFILE.PARA 51373 . 59478)) (59523 80972 (\TFBRAVO.INSERT.PARA 59533 . 60186) (
+\TFBRAVO.INSERT.RUN 60188 . 63385) (\TFBRAVO.SPLIT.PARA 63387 . 70629) (\TFBRAVO.RUN.TABSPEC 70631 . 
+75277) (\TFBRAVO.INSTALL.PAGEFORMAT 75279 . 80970)) (80973 85116 (\TFBRAVO.ASSERT 80983 . 81513) (
+\TEST.CHARACTER.LOOKS 81515 . 83401) (\TEST.PARAGRAPH.LOOKS 83403 . 85114)) (85601 92044 (
+\TFBRAVO.ADD.NAMEDTAB 85611 . 89002) (\TFBRAVO.COPY.NAMEDTAB 89004 . 89452) (\TFBRAVO.PUT.NAMEDTAB 
+89454 . 89734) (\TFBRAVO.GET.NAMEDTAB 89736 . 90113) (\NAMEDTABNYET 90115 . 90275) (\NAMEDTABSIZE 
+90277 . 90792) (\NAMEDTABPREPRINT 90794 . 90992) (\TEDIT.NAMEDTAB.INIT 90994 . 92042)))))
 STOP

library/tedit/tedit-exports.all

@@ -1,23 +1,24 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-Mar-2024 11:16:36" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;120
 47172  
+
(FILECREATED "14-Dec-2024 11:45:45" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196
 52876  
 
       :EDIT-BY rmk
 
-      :PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}<library>TEDIT>tedit-exports.all;118)
+      :PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}<library>TEDIT>tedit-exports.all;195)
 
 
 (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION 
 PRINT))))))))
 (FILESLOAD (FROM LOADUPS) EXPORTS.ALL)
 (PUTPROPS TEDIT-ASSERT MACRO (ARGS (COND (CHECK-TEDIT-ASSERTIONS (BQUOTE (CL:UNLESS (\, (CAR ARGS)) (
-HELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS))))))))
+\TEDIT.THELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS)
+)))))))
 (GLOBALVARS CHECK-TEDIT-ASSERTIONS)
 (RPAQ? CHECK-TEDIT-ASSERTIONS T)
 (PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
 \TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
-(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:26"))
+(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 21:39:48"))
 (RPAQQ \BTREEWORDSPERSLOT 4)
 (RPAQQ \BTREEMAXCOUNT 8)
 (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -52,23 +53,24 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
  (\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
 (I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE))) 
 by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
-(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:07"))
+(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:12:27"))
 (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. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
 ) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;; 
 "If DCH=0, this is a caret-only selection, with no highlighting.  In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
 ) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ; 
-"X value of left edge of selection on the first line") NIL (* ; 
-"Was 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 on the last line") CHLIM (* ; 
+"X value of left edge of selection on the first line") SELLINES (* ; 
+"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was 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 on the last line") CHLIM (* ; 
 "Last character is at (SUB1 CHLIM)") DCH (* ; 
 "# of characters selected (can be zero, for empty/point selection.) This controls highlighting") 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") NIL (* ; 
 "Was 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") (SELTEXTOBJ FULLXPOINTER) (* ; 
-"TEXTOBJ that describes the selected text") SELKIND (* ; 
+"T if this selection is real;  NIL if not") (SELTEXTSTREAM FULLXPOINTER) (* ; 
+"TEXTSTREAM 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) (* ; 
@@ -76,44 +78,50 @@ by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
 "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.")) (INIT (DEFPRINT (QUOTE 
-SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS (DX (AND (FIXP (fetch (SELECTION X0) of 
-DATUM)) (FIXP (fetch (SELECTION XLIM) of DATUM)) (IDIFFERENCE (fetch (SELECTION XLIM) of DATUM) (fetch
- (SELECTION X0) of DATUM))))) SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (
-QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST NIL))
+SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS ((SELTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) 
+of (GETSEL DATUM SELTEXTSTREAM))) (CHLAST (STANDARD (SUB1 (GETSEL DATUM CHLIM)) (SETSEL DATUM CHLIM (
+ADD1 NEWVALUE))) (FAST (SUB1 (FSETSEL DATUM CHLIM)) (FSETSEL DATUM CHLIM (ADD1 NEWVALUE)))))) SET _ 
+NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST
+ NIL))
 (DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR))
 (DEFPRINT (QUOTE SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))
 (RPAQQ COPYSELSHADE 30583)
 (RPAQQ COPYLOOKSSELSHADE 30583)
-(RPAQQ EDITMOVESHADE -1)
+(RPAQ EDITMOVESHADE BLACKSHADE)
 (RPAQQ EDITGRAY 32800)
-(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800))
-(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (fetch (LINEDESCRIPTOR LCHAR1) of 
-LINE)) (ILEQ CHNO (fetch (LINEDESCRIPTOR LCHARLIM) of LINE)) LINE)))
-(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLIM) (AND (IGEQ CHLIM (GETLD L LCHAR1)) (ILEQ CH# (
-FGETLD L LCHARLIM)))))
+(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800))
+(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (GETLD LINE LCHAR1)) (ILESSP CHNO 
+(FGETLD LINE LCHARLIM)) LINE)))
+(PUTPROPS FWITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (FGETLD LINE LCHAR1)) (ILESSP 
+CHNO (FGETLD LINE LCHARLIM)) LINE)))
+(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (AND (IGEQ (GETLD L LCHARLAST) CH#) (ILEQ (
+FGETLD L LCHAR1) CHLAST))))
+(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ; 
+"True if a CH#..CHLAST selection would include L") (AND (IGREATERP (FGETLD L LCHARLIM) CH#) (ILEQ (
+FGETLD L LCHAR1) CHLAST))))
+(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (AND (IGEQ X LOW) (ILEQ X HIGH))))
 (PUTPROPS GETSEL MACRO ((S FIELD) (fetch (SELECTION FIELD) of S)))
 (PUTPROPS SETSEL MACRO ((S FIELD NEWVALUE) (replace (SELECTION FIELD) of S with NEWVALUE)))
 (PUTPROPS FGETSEL MACRO ((S FIELD) (ffetch (SELECTION FIELD) of S)))
 (PUTPROPS FSETSEL MACRO ((S FIELD NEWVALUE) (freplace (SELECTION FIELD) of S with NEWVALUE)))
+(PUTPROPS SELECTION! MACRO ((SEL) (\DTEST SEL (QUOTE SELECTION))))
+(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (BIND 
+$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY DECLARE (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST 
+$$SPLENGTH) FIRST (\DTEST (OR $$SELPIECES (GO $$OUT)) (QUOTE SELPIECES)) (SETQ I.V. (SETQ $$SPFIRST (
+\DTEST (ffetch (SELPIECES SPFIRST) of $$SELPIECES) (QUOTE PIECE)))) (SETQ $$SPLAST (\DTEST (ffetch (
+SELPIECES SPLAST) of $$SELPIECES) (QUOTE PIECE))) (SETQ $$SPLENGTH (ffetch (SELPIECES SPLEN) of 
+$$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE PIECE)))))) T)
+(PUTPROPS GETSPC MACRO ((SP FIELD) (fetch (SELPIECES FIELD) of SP)))
+(PUTPROPS SETSPC MACRO ((SP FIELD NEWVALUE) (replace (SELPIECES FIELD) of SP with NEWVALUE)))
+(PUTPROPS FGETSPC MACRO ((SP FIELD) (ffetch (SELPIECES FIELD) of SP)))
+(PUTPROPS FSETSPC MACRO ((SP FIELD NEWVALUE) (freplace (SELPIECES FIELD) of SP with NEWVALUE)))
+(PUTPROPS SELPIECES! MACRO ((SPC) (\DTEST SPC (QUOTE SELPIECES))))
 (GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
 (GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION 
 TEDIT.DELETESELECTION)
-(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (bind 
-$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY declare (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST 
-$$SPLENGTH) first (SETQ I.V. (SETQ $$SPFIRST (\DTEST (OR (fetch (SELPIECES SPFIRST) of $$SELPIECES) (
-GO $$OUT)) (QUOTE PIECE)))) (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) (SETQ $$SPLENGTH
- (fetch (SELPIECES SPLEN) of $$SELPIECES)) while I.V. repeatuntil (EQ I.V. $$SPLAST) by (NEXTPIECE 
-I.V.))))) T)
-(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:55"))
-(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") TLSPACEFACTOR (* ; 
-"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ; 
-"The first space to which SPACEFACTOR is to apply.  This is used sothat spaces to the left of a TAB have their default width."
-) CHARSLOTS (* ; 
-"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
-) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)") 
-CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
+(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 6-Dec-2024 12:50:42"))
+(RECORD TAB (TABX . TABKIND))
+(RECORD TABSPEC (DEFAULTTAB . TABS))
 (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.")))
@@ -125,12 +133,13 @@ CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.
 RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ; 
 "X value of right edge of LCHARLIM character on the line (may exceed right margin, if char is a space.). In natural stream units"
 ) LX1 (* ; "X value of the left edge of LCHAR1 from the left margin, in stream natural units.") 
-LHEIGHT (* ; "Total height of hte line, Ascent+Descent plus leading") ASCENT (* ; 
-"Ascent of the line above YBASE, adjusted for line leading") DESCENT (* ; 
+LHEIGHT (* ; 
+"Total height of hte line, Ascent+Descent plus leading. Includes paragraph and line leading") LASCENT 
+(* ; "Ascent of the line above YBASE, adjusted for line and paragraph leading") LDESCENT (* ; 
 "How far line descends below YBASE, adjusted for line leading") LTRUEDESCENT (* ; 
 "The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ; 
 "The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") LCHAR1 (* ; 
-"CH# of the first character on the line.") LCHARLIM (* ; "CH# of the last character on the line") 
+"CH# of the first character on the line.") LCHARLAST (* ; "CH# of the last character on the line") 
 FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ; 
 "Was CHARTOP: CH# of the character which forced the line break (may be less than  CHARLIM)") NEXTLINE 
 (* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ;
@@ -141,19 +150,27 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
 ) NIL (* ; 
 "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit.  Now:  THISLINE comes from TEXTOBJ"
 ) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC (
-* ; "The format spec for this line's paragraph (eventually)") (LDIRTY FLAG) (* ; 
-"T if this line has changed since it was last formatted.") (NIL FLAG) (* ; "Was FORCED-END flag") (
-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.") (LDUMMY FLAG) (* ; 
+* ; "The format spec for this line's paragraph (eventually)") (NIL FLAG) (* ; 
+"Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ; 
+"Was FORCED-END flag") (NIL FLAG) (* ; 
+"Was DELETED: T if this line has been completely deleted since it was last formatted or displayed.  (Used by deletion routines to detect garbage lines)"
+) (NIL FLAG) (* ; "Was LHASPROT This line contains protected text.") (LDUMMY FLAG) (* ; 
 "This is a dummy line. Was: LHASTABS.  But never fetched and this descriptions wasn't true: 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")) (INIT (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION 
-\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (IPLUS (FGETLD DATUM YBOT) (FGETLD DATUM LHEIGHT))
-) (LTRUEHEIGHT (IPLUS (FGETLD DATUM LTRUEASCENT (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYTOP (IPLUS (
-GETLD DATUM YBOT) (FGETLD DATUM LTRUEHEIGHT))) (LTRUEYBOT (IDIFFERENCE (FGETLD DATUM YBASE) (FGETLD 
-DATUM LTRUEDESCENT))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LCHARLIM _ 1000000 NEXTLINE _ NIL
- PREVLINE _ NIL LDIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL)
+\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (STANDARD (IPLUS (GETLD DATUM YBASE) (GETLD DATUM 
+LASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM LASCENT)))) (LTRUEYTOP (STANDARD (IPLUS (
+GETLD DATUM YBASE) (FGETLD DATUM LTRUEASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM 
+LTRUEASCENT)))) (LTRUEHEIGHT (STANDARD (IPLUS (GETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)) 
+FAST (IPLUS (FGETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYBOT (STANDARD (
+IDIFFERENCE (GETLD DATUM YBASE) (FGETLD DATUM LTRUEDESCENT)) FAST (IDIFFERENCE (FGETLD DATUM YBASE) (
+FGETLD DATUM LTRUEDESCENT)))) (LLEADBEFORE (STANDARD (IDIFFERENCE (GETLD DATUM LASCENT) (FGETLD DATUM 
+LTRUEASCENT)) FAST (IDIFFERENCE (FGETLD DATUM LASCENT) (FGETLD DATUM LTRUEASCENT)))) (LCHARLIM (
+STANDARD (ADD1 (GETLD DATUM LCHARLAST)) FAST (ADD1 (FGETLD DATUM LCHARLAST))) (STANDARD (SETLD DATUM 
+LCHARLAST (SUB1 NEWVALUE)) FAST (FSETLD DATUM LCHARLAST (SUB1 NEWVALUE)))) (LNCH (STANDARD (
+IDIFFERENCE (GETLD DATUM LCHARLIM) (GETLD DATUM LCHAR1)) FAST (IDIFFERENCE (FGETLD DATUM LCHARLIM) (
+FGETLD DATUM LCHAR1)))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 YBOT _ 0 YBASE _ 0 LEFTMARGIN _
+ 0)
 (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT))
 (I.S.OPR (QUOTE inlines) NIL (QUOTE (bind $$PREVLINE declare (LOCALVARS $$PREVLINE) first (SETQ I.V. (
 \DTEST (OR BODY (GO $$OUT)) (QUOTE LINEDESCRIPTOR))) by (PROGN (SETQ $$PREVLINE I.V.) (\DTEST (OR (
@@ -165,18 +182,39 @@ fetch (LINEDESCRIPTOR PREVLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR))))))
 (PUTPROPS FGETLD MACRO ((L FIELD) (ffetch (LINEDESCRIPTOR FIELD) of L)))
 (PUTPROPS SETLD MACRO ((L FIELD NEWVALUE) (replace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
 (PUTPROPS FSETLD MACRO ((L FIELD NEWVALUE) (freplace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
-(PUTPROPS SETYPOS MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE DESCENT) (
+(PUTPROPS SETYBOT MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE LDESCENT) (
 FSETLD LINE YBOT BOTTOM)))))
+(PUTPROPS SETYTOP MACRO (OPENLAMBDA (LINE TOP) (SETYBOT LINE (IDIFFERENCE TOP (GETLD LINE LHEIGHT)))))
+(PUTPROPS SETYBASE MACRO (OPENLAMBDA (LINE BASE) (FSETLD LINE YBOT (IDIFFERENCE (GETLD LINE LDESCENT) 
+(FSETLD LINE YBASE BASE)))))
 (PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN
  LINE2 (SETLD LINE2 PREVLINE LINE1))))
+(PUTPROPS LINEDESCRIPTOR! MACRO ((LD) (\DTEST LD (QUOTE LINEDESCRIPTOR))))
 (PUTPROPS HCSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
 FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
 (PUTPROPS HCUNSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
 FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
+(PUTPROPS SCALEUP MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I in 
+ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
+(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I 
+in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
 (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
 (ADDTOVAR CHARACTERNAMES (EM-DASH "357,045") (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (
 NONBREAKING-SPACE "357,041"))
+(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
+ 192) (ILEQ CHAR 207))))
+(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
+FGETLD LINE LHEIGHT) HEIGHT))))
 (* ; "Formatting slots held by THISLINE")
+(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") TLSPACEFACTOR (* ; 
+"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ; 
+"The first space to which SPACEFACTOR is to apply.  This is used sothat spaces to the left of a TAB have their default width."
+) CHARSLOTS (* ; 
+"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
+) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)") 
+CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
 (BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS.")))
 (PUTPROPS CHAR MACRO ((CSLOT) (ffetch (CHARSLOT CHAR) of CSLOT)))
 (PUTPROPS CHARW MACRO ((CSLOT) (ffetch (CHARSLOT CHARW) of CSLOT)))
@@ -224,9 +262,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
  THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.) 
 eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.)) 
 repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
-(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
- 192) (ILEQ CHAR 207))))
-(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:35"))
+(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:31"))
 (DATATYPE PIECE ((* ; 
 "The piece describes either a string or part of a file.  , or a generalized OBJECT.") PCONTENTS (* ; 
 "The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
@@ -243,37 +279,39 @@ PNEW FLAG) (* ;
  XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ; 
 "High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ; 
 "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
-POBJ (IMAGEOBJP (PCONTENTS DATUM))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ 
+POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
+PCHARLOOKS (PLOOKS DATUM) (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) FAST (freplace (
+PIECE PLOOKS) of DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ 
 TEDIT.DEFAULT.FMTSPEC)
 (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") PANES (* ; 
-"A list of panes (subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
+PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ; 
+"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
 ) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end") 
-NIL (* ; 
+CHARFN (* ; 
 "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#") 
 HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ; 
 "Was # of characters already in the piece.") INSERTSTRING (* ; 
 "A substring of storage that is available for an insertion.") TXTHISTORYUNDONE (* ; 
 "Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece."
-) (TXTLINELEADINGABOVE FLAG) (* ; 
-"NIL for old/existing Tedit files whose lines are formatted with leading below, T for newer files. Was \INSERTPCVALID. 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. Now just set HINTPC to NIL."
-) \WINDOW (* ; "The window-pane<s> where this textobj is displayed") MOUSEREGION (* ; 
-"Section of the window the mouse is in.") NIL (* ; 
+) (NIL FLAG) (* ; 
+" Was \INSERTPCVALID. 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. Now just set HINTPC to NIL."
+) (TXTREADONLYQUIET FLAG) (* ; "T => don't print READONLY abort messages") PARABREAKCHARS (* ; 
+"Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE"
+) MOUSEREGION (* ; "Section of the window the mouse is in.") LOOPFN (* ; 
 "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES."
 ) DS (* ; 
 "NOTE:  THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed") 
-SEL (* ; "The current selection within the text") SCRATCHSEL (* ; 
-"Scratch space for the selection code") SCRATCHSEL2 (* ; 
-"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY") 
-NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ; 
-"Right edge of the window (or subregion) where this is displayed") WTOP (* ; 
+SEL (* ; "The current selection within the text") NIL (* ; "Was: Scratch space for the selection code"
+) NIL (* ; "Was MOVESEL: Source for the next MOVE of text") NIL (* ; 
+"Was SHIFTEDSEL: Source for the next COPY") NIL (* ; "Was 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 (* ; 
+"T => The guy has asked the editor to go way") NIL (* ; 
+"Was 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) (* ; 
@@ -292,7 +330,8 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
 "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.") (SELPANE FULLXPOINTER) (* ; 
+) (TXTHISTORYINACTIVE FLAG) (* ; "T if history events are not recorded (e.g. for transcript files)") 
+TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ; 
 "The pane in which the last 'real' selection got made for this edit;  used by TEDIT.NORMALIZECAREET") 
 PROMPTWINDOW (* ; 
 "A window to be used for unscheduled interactions;  normally a small window above the edit window") 
@@ -302,7 +341,9 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL
 ) 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) (* ; 
+TXTAPPENDONLY FLAG) (* ; 
+"Allows updates only at the end of the stream.  Was TXTNEEDSUPDATE: 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 (* ; 
@@ -310,9 +351,8 @@ TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TU
 "Style sheet local to this document.  Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
 (\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM
 )) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))))) SEL _ (create 
-SELECTION) SCRATCHSEL _ (create SELECTION) SCRATCHSEL2 _ (create SELECTION) 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 INSERTSTRING _ NIL)
+SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _
+ (create THISLINE) FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
 (ACCESSFNS TEXTSTREAM ((* ;; 
 "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;; 
 "The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3) 
@@ -320,23 +360,25 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i
 (PIECE (fetch (STREAM F5) of DATUM) (REPLACE (STREAM F5) OF DATUM WITH NEWVALUE)) (* ; 
 "The PIECE we're currently fetching chars from/putting chars into") (PCCHARSLEFT (fetch (STREAM F1) of
  DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") (
-CURRENTLOOKS (fetch (STREAM F10) of DATUM) (replace (STREAM F10) of DATUM with NEWVALUE)) (* ; 
-"The CHARLOOKS that are currently applicable to characters being taken from the stream.") (
-CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with 
+NIL) (* ; 
+"Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ."
+) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with 
 NEWVALUE)) (* ; 
 "The FMTSPEC that is currently applicable to characters being taken from the stream. This was  the only residual field of TEXTIMAGEDATA, now gone."
-) (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ; 
-"Function to be called at every piece change when line-formatting.") (STARTINGCOFFSET (fetch (STREAM 
-F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? (AND (type? STREAM DATUM) (type? 
-TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create STREAM BINABLE _ NIL BOUTABLE _ NIL 
-ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4
- _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL)))
+) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ; 
+"Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting."
+) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? 
+(AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create 
+STREAM BINABLE _ NIL BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ 
+\TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS 
+IMAGEDATA _ NIL)))
 (PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
 (PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
 (PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
 (PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
 (PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
 (PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
+(PUTPROPS PCHARLOOKS MACRO ((PC) (PLOOKS PC)))
 (PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
 (PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
 (PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
@@ -345,16 +387,16 @@ ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _
 (PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC)))
 (PUTPROPS PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC)))
 (PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
+(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
 (PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
 (PUTPROPS FSETPC MACRO ((PC FIELD NEWVALUE) (freplace (PIECE FIELD) of PC with NEWVALUE)))
 (PUTPROPS GETPC MACRO ((PC FIELD) (fetch (PIECE FIELD) of PC)))
 (PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
 (PUTPROPS THINPIECEP MACRO ((PC) (* ;; 
 "Assume that objects start out thin, for  CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care."
-) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) (OBJECT.PTYPE 
-T) NIL)))
-(PUTPROPS VISIBLEPIECEP MACRO ((PC) (NOT (OR (EQ 0 (PLEN PC)) (fetch (CHARLOOKS CLINVISIBLE) of (
-PLOOKS PC))))))
+) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) NIL)))
+(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC) 
+CLINVISIBLE)))))
 (PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat (
 VISIBLEPIECEP NPC))))
 (PUTPROPS \PREV.VISIBLE.PIECE MACRO ((PC) (find PPC backpieces (AND PC (PREVPIECE PC)) suchthat (
@@ -366,12 +408,18 @@ VISIBLEPIECEP PPC))))
 (PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ)))
 (PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ)))
 (PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ))))
+(PUTPROPS GETTSTR MACRO ((TSTR FIELD) (fetch (TEXTSTREAM FIELD) of TSTR)))
+(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
+(PUTPROPS FGETTSTR MACRO ((TSTR FIELD) (ffetch (TEXTSTREAM FIELD) of TSTR)))
+(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
+(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR 
+TSTR TEXTOBJ)) TSTR)))
 (RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
 FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
 UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE 
 UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
 BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE 
-THINSTRING.PTYPE))))
+THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))))
 (RPAQQ THINFILE.PTYPE 0)
 (RPAQQ FATFILE1.PTYPE 1)
 (RPAQQ FATFILE2.PTYPE 2)
@@ -388,14 +436,15 @@ UTF16LE.PTYPE))
 (RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
 (RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
 (RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
+(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
 (CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
 FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
 UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE 
 UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
 BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE 
-THINSTRING.PTYPE)))
+THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
 (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
-(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:37"))
+(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:17:20"))
 (RPAQQ NONE.TTC 0)
 (RPAQQ CHARDELETE.TTC 1)
 (RPAQQ WORDDELETE.TTC 2)
@@ -414,10 +463,10 @@ THINSTRING.PTYPE)))
 (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) (CHARDELETE.FORWARD.TTC 10) (
 WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
-(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* Test to see if only the specified mouse button is down. 
-DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it WAS called.) (
-SELECTQ (CAR BUTTON) (LEFT (QUOTE (IEQP LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (IEQP LASTMOUSEBUTTONS 1)
-)) (RIGHT (QUOTE (IEQP LASTMOUSEBUTTONS 2))) (SHOULDNT))))
+(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;; 
+"Test to see if only the specified mouse button is down.  DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
+) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
+) (RIGHT (QUOTE (EQ LASTMOUSEBUTTONS 2))) (SHOULDNT))))
 (PUTPROPS \TEDIT.CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (for 
 I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP) 
 "TEdit consistency-check failure [RETURN to continue]:  " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
@@ -431,15 +480,16 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
 (RPAQQ NEWCHAR-IF-SPLIT.LB 32)
 (CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16) 
 (NEWCHAR-IF-SPLIT.LB 32))
-(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:16"))
+(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "28-Nov-2024 10:03:03"))
 (PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
 \BIN STREAM)) BITSPERWORD)))
 (PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
 LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
-(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:52"))
-(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:42"))
+(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 23:00:13"))
+(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2024 16:09:28"))
 (DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") 
-CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;; 
+(* ;; "NOTE:  If fields change EQCLOOKS should change too.") 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) (* ; 
@@ -450,9 +500,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE 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 TEDIT is to ignore these chars;  else NIL") (CLSELAFTER FLAG) (* ; 
+"T if TEDIT can put selection after this char (for menu fields).") (* ;; "Was CLSELHERE. ") (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)"
 ) (CLUNBREAKABLE FLAG) (* ; "Spaces are treated as nonbreaking spaces") CLSTYLE (* ; 
 "The style to be used in marking these characters;  overridden by the other fields") CLUSERINFO (* ; 
@@ -461,7 +511,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
 "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 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
+) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields).")) 
+CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
 (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 (* ; 
@@ -471,8 +522,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
 "Leading between lines, in points.  This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented."
 ) 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 (* ; 
+NIL (* ; "Was 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 (* ; 
@@ -492,17 +543,28 @@ TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default t
 ) (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."
-) FMTHARDCOPYSCALE) (* ; 
-"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T)"
-) (INIT (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 
-LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL))
+) FMTHARDCOPYSCALE (* ; 
+"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T"
+) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT (
+DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 
+0)
 (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
 (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))
 (PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A
 )) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
 \PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V)))
 (PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF)))))
-(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:29"))
+(PUTPROPS FSETPARA MACRO ((F FIELD NEWVALUE) (freplace (FMTSPEC FIELD) of F with NEWVALUE)))
+(PUTPROPS FGETPARA MACRO ((F FIELD) (ffetch (FMTSPEC FIELD) of F)))
+(PUTPROPS GETPARA MACRO ((F FIELD) (fetch (FMTSPEC FIELD) of F)))
+(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) (replace (FMTSPEC FIELD) of F with NEWVALUE)))
+(PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL)))
+(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE)))
+(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL)))
+(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
+(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC))))
+(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
+(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46"))
 (DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
  is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
  means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
@@ -513,64 +575,79 @@ the caret up during screen updates) TCCARETX (* X position in the window that th
 TCCARETY (* Y position in the window where the caret appears) TCCARET (* A lisp CARET to be flashed (
 eventually))) TCNOWTIME _ (CREATECELL \FIXP) TCTHENTIME _ (CREATECELL \FIXP) TCCURSORBM _ BXCARET 
 TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET))
-(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM (QUOTE TEDIT-NEXT-PANE-DOWN)) (PUTWINDOWPROP 
-DATUM (QUOTE TEDIT-NEXT-PANE-DOWN) NEWVALUE)) (WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (
-PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (
-TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW 
-WTEXTSTREAM) of DATUM))) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES
-) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (
-QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM 
-(QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP 
-DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN))
- (LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN) NV) NV))))
-(DATATYPE PANE ((XPWINDOW FULLXPOINTER) PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER))
- (ACCESSFNS (PWINDOW (PROGN DATUM))))
-(PUTPROPS FGETPANE MACRO ((P FIELD) (ffetch (PANE FIELD) of P)))
-(PUTPROPS GETPANE MACRO ((P FIELD) (fetch (PANE FIELD) of P)))
-(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) (replace (PANE FIELD) of P with NEWVALUE)))
-(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) (freplace (PANE FIELD) of P with NEWVALUE)))
-(I.S.OPR (QUOTE inpanes) NIL (QUOTE (inside (fetch (TEXTOBJ \WINDOW) of BODY))))
-(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:16:27"))
-(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)))
-(RECORD MBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (
-QUOTE MB.DISPLAY)) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.THREESTATE.DISPLAY)) (EQ (
-IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE \TEXTMENU.TOGGLE.DISPLAY))))))
-(RECORD NWAYBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE
- MB.NB.DISPLAYFN)))))
-(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (TYPE? (AND (IMAGEOBJP DATUM) (EQ (
-IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.MARGINBAR.DISPLAYFN)))))
-(RECORD TAB (TABX . TABKIND))
-(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:06"))
-(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 12:06:12"))
-(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "15-Mar-2024 14:07:55"))
-(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:37"))
+(ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (PUTWINDOWPROP DATUM (
+QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) 
+of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) (
+CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (QUOTE 
+TEDIT.CURSORREGION) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (
+PUTWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (PANEPROPS (GETWINDOWPROP DATUM (QUOTE PANEPROPS)
+) (PUTWINDOWPROP DATUM (QUOTE PANEPROPS) NEWVALUE))) (TYPE? (AND (WINDOWP DATUM) (TYPENAMEP (fetch (
+TEXTWINDOW PTEXTOBJ) of DATUM) (QUOTE TEXTOBJ)))))
+(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") PREFIXLINE (* ; 
+"Dummy line that covers all the characters above the first visible line") SUFFIXLINE (* ; 
+"Dummy line that covers all the characters below the last visible line") PCARET NEXTPANE (PREVPANE 
+XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION))
+(PUTPROPS FGETPANEPROP MACRO ((P FIELD) (ffetch (PANEPROPS FIELD) of P)))
+(PUTPROPS GETPANEPROP MACRO ((P FIELD) (fetch (PANEPROPS FIELD) of P)))
+(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) (replace (PANEPROPS FIELD) of P with NEWVALUE)))
+(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) (freplace (PANEPROPS FIELD) of P with NEWVALUE)))
+(PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE)))
+(PUTPROPS PANEPREFIX MACRO ((PANE) (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) PREFIXLINE))))
+(PUTPROPS PANESUFFIX MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) SUFFIXLINE)))
+(PUTPROPS PANETOPLINE MACRO ((PANE) (FGETLD (PANEPREFIX PANE) NEXTLINE)))
+(PUTPROPS PANECARET MACRO ((PANE) (\DTEST (GETPANEPROP (PANEPROPS PANE) PCARET) (QUOTE TEDITCARET))))
+(PUTPROPS PANESTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))
+(PUTPROPS PANETOBJ MACRO ((PANE) (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW 
+WTEXTSTREAM) of PANE)))))
+(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) (GETLD (PANESUFFIX PANE) PREVLINE)))
+(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) (FSETLD (PANEPREFIX PANE) LCHARLAST CHNO)))
+(PUTPROPS PANETOP MACRO ((PANE PREG) (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE)))))
+(PUTPROPS PANEWIDTH MACRO ((PANE PREG) (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
+)))
+(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
+)
+(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
+)))))
+(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
+)))))
+(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (DSPCLIPPINGREGION NIL PANE))))
+(I.S.OPR (QUOTE inpanes) NIL (QUOTE (bind $$BODY _ BODY declare (LOCALVARS $$BODY) first (SETQ I.V. (
+OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BODY) (GO $$OUT))) by (OR
+ (GETPANEPROP (PANEPROPS I.V.) NEXTPANE) (GO $$OUT)))))
+(I.S.OPR (QUOTE backpanes) NIL (QUOTE (first (SETQ I.V. (OR (find P inpanes BODY suchthat (NULL (
+GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO 
+$$OUT)))))
+(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
+(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:00:10"))
+(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:24:22"))
+(RPAQQ PTSPERPICA 12)
+(RPAQQ PTSPERINCH 72)
+(RPAQQ PICASPERINCH 6)
+(RPAQQ MICASPERINCH 2540)
+(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
+(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
+(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH))
+(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT 
+PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT 
+MICASPERINCH PTSPERINCH)))
+(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2024 21:21:48"))
+(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12"))
+(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "26-Nov-2024 23:53:32"))
+(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23"))
 (DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* 
 ; "A keyword 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") NIL (* ; 
 "Was THAUXINFO: Auxiliary info about the event, primarily for redo") THDELETEDPIECES) (ACCESSFNS 
-TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT THCH#) of DATUM) (IPLUS (fetch (
-TEDITHISTORYEVENT THCH#) of DATUM) (fetch (TEDITHISTORYEVENT THLEN) of DATUM)))))) (INIT (DEFPRINT (
-QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
+TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (TEDITHISTORYEVENT THCH#) of DATUM) 0) (OR (fetch (
+TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION 
+\TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
 (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))
 (PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
-(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
 (PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
 (PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with 
 NEWVALUE)))
-(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:20"))
+(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 19:41:55"))
 (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."
@@ -601,9 +678,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
 (PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
 (PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
 )
-(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
-(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
-(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:27:18"))
+(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 22:39:52"))
+(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
+(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50"))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP

lispusers/COMPAREDIRECTORIES

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259
 131082 
+
(FILECREATED " 1-May-2024 14:53:20" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;260
 131326 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS FIX-DIRECTORY-DATES)
+      :CHANGES-TO (FNS COMPAREDIRECTORIES)
 
-      :PREVIOUS-DATE "29-Sep-2023 17:25:57" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;257)
+      :PREVIOUS-DATE "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259)
 
 
 (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
@@ -63,7 +63,8 @@
 
 (COMPAREDIRECTORIES

   [LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS 
-                FIXDIRECTORYDATES)
                           (* ; "Edited 29-Sep-2023 17:25 by rmk")


+                FIXDIRECTORYDATES SHORTDIRNAMES)
             (* ; "Edited  1-May-2024 14:52 by rmk")


+                                                             (* ; "Edited 29-Sep-2023 17:25 by rmk")


                                                              (* ; "Edited  5-Apr-2023 10:12 by rmk")


                                                              (* ; "Edited 29-Mar-2022 11:50 by rmk")


                                                              (* ; "Edited 23-Feb-2022 21:10 by rmk")


@@ -116,7 +117,11 @@
               (PRINTOUT T "Fixing directory dates" T)
               (FIX-DIRECTORY-DATES
 DIR1)
               (FIX-DIRECTORY-DATES
 DIR2))
-          (CDPRINT.HEADER
 DIR1 DIR2 SELECT DATE T)
+          (CDPRINT.HEADER
 (OR (CAR SHORTDIRNAMES)
+                              DIR1)
+                 (OR (CADR SHORTDIRNAMES)
+                     DIR2)
+                 SELECT DATE T)
           (PRINTOUT T " ... ")
           (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS
 DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1
                               USEDIRECTORYDATE (MEMB 'AUTHOR SELECT)))
@@ -2197,25 +2202,25 @@
 
 (MOVD? 'NILL 'TEDIT.FILEDATE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2527 22645 (COMPAREDIRECTORIES 2537 . 7627) (COMPAREDIRECTORIES.INFOS 7629 . 10587) (
-COMPAREDIRECTORIES.CANDIDATES 10589 . 13974) (CDENTRIES.SELECT 13976 . 18751) (
-COMPAREDIRECTORIES.INFOS.TYPE 18753 . 19879) (MATCHNAME 19881 . 20561) (CD.INSURECDVALUE 20563 . 22177
-) (CD.UPDATEWIDTHS 22179 . 22643)) (22646 33268 (CDFILES 22656 . 28670) (CDFILES.MATCH 28672 . 30297) 
-(CDFILES.PATS 30299 . 33266)) (33269 51090 (CDPRINT 33279 . 35796) (CDPRINT.HEADER 35798 . 36695) (
-CDPRINT.LINE 36697 . 39929) (CDPRINT.MAXWIDTHS 39931 . 44046) (CDPRINT.COLHEADERS 44048 . 45333) (
-CDPRINT.COLUMNS 45335 . 50455) (CDTEDIT 50457 . 51088)) (51091 60212 (CDMAP 51101 . 52533) (CDENTRY 
-52535 . 52844) (CDSUBSET 52846 . 54285) (CDMERGE 54287 . 58271) (CDMERGE.COMMON 58273 . 59588) (
-CD.SORT 59590 . 60210)) (60213 67751 (BINCOMP 60223 . 64512) (EOLTYPE 64514 . 67076) (EOLTYPE.SHOW 
-67078 . 67749)) (68279 80806 (FIND-UNCOMPILED-FILES 68289 . 71932) (FIND-UNSOURCED-FILES 71934 . 74318
-) (FIND-SOURCE-FILES 74320 . 76058) (FIND-COMPILED-FILES 76060 . 77937) (FIND-UNLOADED-FILES 77939 . 
-78792) (FIND-LOADED-FILES 78794 . 79222) (FIND-MULTICOMPILED-FILES 79224 . 80804)) (80807 89238 (
-CREATED-AS 80817 . 85614) (SOURCE-FOR-COMPILED-P 85616 . 88543) (COMPILE-SOURCE-DATE-DIFF 88545 . 
-89236)) (89239 100002 (FIX-DIRECTORY-DATES 89249 . 92699) (FIX-EQUIV-DATES 92701 . 94226) (
-COPY-COMPARED-FILES 94228 . 96049) (COPY-MISSING-FILES 96051 . 98208) (COMPILED-ON-SAME-SOURCE 98210
- . 100000)) (100196 108034 (CDBROWSER 100206 . 104133) (CDBROWSER.STRINGS 104135 . 108032)) (108196 
-109932 (CD.TABLEITEM 108206 . 108426) (CD.TABLEITEM.PRINTFN 108428 . 108627) (CD.TABLEITEM.COPYFN 
-108629 . 109687) (CDTABLEBROWSER.HEADING.REPAINTFN 109689 . 109930)) (109933 130588 (
-CDTABLEBROWSER.WHENSELECTEDFN 109943 . 110411) (CD.COMMANDSELECTEDFN 110413 . 115514) (CD-MENUFN 
-115516 . 119827) (CD-COMPARE-FILES 119829 . 123181) (CDBROWSER-COPY 123183 . 126852) (
-CDBROWSER-DELETE-FILE 126854 . 130067) (CD-SWAPDIRS 130069 . 130586)))))
+  (FILEMAP (NIL (2526 22889 (COMPAREDIRECTORIES 2536 . 7871) (COMPAREDIRECTORIES.INFOS 7873 . 10831) (
+COMPAREDIRECTORIES.CANDIDATES 10833 . 14218) (CDENTRIES.SELECT 14220 . 18995) (
+COMPAREDIRECTORIES.INFOS.TYPE 18997 . 20123) (MATCHNAME 20125 . 20805) (CD.INSURECDVALUE 20807 . 22421
+) (CD.UPDATEWIDTHS 22423 . 22887)) (22890 33512 (CDFILES 22900 . 28914) (CDFILES.MATCH 28916 . 30541) 
+(CDFILES.PATS 30543 . 33510)) (33513 51334 (CDPRINT 33523 . 36040) (CDPRINT.HEADER 36042 . 36939) (
+CDPRINT.LINE 36941 . 40173) (CDPRINT.MAXWIDTHS 40175 . 44290) (CDPRINT.COLHEADERS 44292 . 45577) (
+CDPRINT.COLUMNS 45579 . 50699) (CDTEDIT 50701 . 51332)) (51335 60456 (CDMAP 51345 . 52777) (CDENTRY 
+52779 . 53088) (CDSUBSET 53090 . 54529) (CDMERGE 54531 . 58515) (CDMERGE.COMMON 58517 . 59832) (
+CD.SORT 59834 . 60454)) (60457 67995 (BINCOMP 60467 . 64756) (EOLTYPE 64758 . 67320) (EOLTYPE.SHOW 
+67322 . 67993)) (68523 81050 (FIND-UNCOMPILED-FILES 68533 . 72176) (FIND-UNSOURCED-FILES 72178 . 74562
+) (FIND-SOURCE-FILES 74564 . 76302) (FIND-COMPILED-FILES 76304 . 78181) (FIND-UNLOADED-FILES 78183 . 
+79036) (FIND-LOADED-FILES 79038 . 79466) (FIND-MULTICOMPILED-FILES 79468 . 81048)) (81051 89482 (
+CREATED-AS 81061 . 85858) (SOURCE-FOR-COMPILED-P 85860 . 88787) (COMPILE-SOURCE-DATE-DIFF 88789 . 
+89480)) (89483 100246 (FIX-DIRECTORY-DATES 89493 . 92943) (FIX-EQUIV-DATES 92945 . 94470) (
+COPY-COMPARED-FILES 94472 . 96293) (COPY-MISSING-FILES 96295 . 98452) (COMPILED-ON-SAME-SOURCE 98454
+ . 100244)) (100440 108278 (CDBROWSER 100450 . 104377) (CDBROWSER.STRINGS 104379 . 108276)) (108440 
+110176 (CD.TABLEITEM 108450 . 108670) (CD.TABLEITEM.PRINTFN 108672 . 108871) (CD.TABLEITEM.COPYFN 
+108873 . 109931) (CDTABLEBROWSER.HEADING.REPAINTFN 109933 . 110174)) (110177 130832 (
+CDTABLEBROWSER.WHENSELECTEDFN 110187 . 110655) (CD.COMMANDSELECTEDFN 110657 . 115758) (CD-MENUFN 
+115760 . 120071) (CD-COMPARE-FILES 120073 . 123425) (CDBROWSER-COPY 123427 . 127096) (
+CDBROWSER-DELETE-FILE 127098 . 130311) (CD-SWAPDIRS 130313 . 130830)))))
 STOP

lispusers/COMPARESOURCES

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Feb-2024 16:08:54" {WMEDLEY}<lispusers>COMPARESOURCES.;137
 40939  
+
(FILECREATED "13-Jun-2024 11:46:26" {WMEDLEY}<lispusers>COMPARESOURCES.;138
 40991  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS COMPARESOURCESCOMS)
-                  (FNS COMPARESOURCES CSBROWSER \CS.IGNOREFORMS)
+      :CHANGES-TO (FNS \CS.COMPARE.MASTERS)
 
-      :PREVIOUS-DATE "17-Jun-2023 15:22:40" {WMEDLEY}<lispusers>COMPARESOURCES.;131)
+      :PREVIOUS-DATE " 7-Feb-2024 16:08:54" {WMEDLEY}<lispusers>COMPARESOURCES.;137)
 
 
 (PRETTYCOMPRINT COMPARESOURCESCOMS)
@@ -142,7 +141,8 @@
                       'SAME])
 
 (\CS.COMPARE.MASTERS

-  [LAMBDA (BODY1 BODY2 DW?)
                                  (* ; "Edited 17-Jun-2023 15:19 by rmk")


+  [LAMBDA (BODY1 BODY2 DW?)
                                  (* ; "Edited 13-Jun-2024 11:46 by rmk")


+                                                             (* ; "Edited 17-Jun-2023 15:19 by rmk")


                                                              (* ; "Edited 25-Feb-2022 18:02 by rmk")


                                                              (* ; "Edited 18-Jan-2022 22:00 by rmk")


                                                              (* ; "Edited 19-Dec-2021 21:05 by rmk")


@@ -155,8 +155,8 @@
 
                                                             "We don't care about editdate comments")

          (SETQ BODY2 (CL:REMOVE-IF (FUNCTION EDITDATE?)
                             BODY2))
-         (SETQ BODY1 (\CS.FIXFNS
 BODY1))
-         (SETQ BODY2 (\CS.FIXFNS
 BODY2))
+         (SETQ BODY1 (\CS.FIXFNS
 BODY1 DW?))
+         (SETQ BODY2 (\CS.FIXFNS
 BODY2 DW?))
          (CL:WHEN (AND (SETQ THING1 (ASSOC 'DEFINE-FILE-INFO BODY1))
                        (SETQ THING2 (ASSOC 'DEFINE-FILE-INFO BODY2))
                        (\CS.COMPARE.DEFINE-FILE-INFO
 THING1 THING2))
@@ -703,17 +703,17 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1748 26130 (COMPARESOURCES 1758 . 8406) (\CS.COMPARE.MASTERS 8408 . 15929) (
-\CS.COMPARE.TYPES 15931 . 19197) (\CS.EXAMINE 19199 . 22377) (\CS.FIXFNS 22379 . 23881) (
-\CS.SORT.DECLARES 23883 . 24226) (\CS.SORT.DECLARE1 24228 . 25648) (\CS.FILTER.GARBAGE 25650 . 26128))
- (26131 31474 (\CS.ISFNFORM 26141 . 26409) (\CS.COMPARE.FNS 26411 . 26653) (\CS.FNSID 26655 . 26799) (
-\CS.ISVARFORM 26801 . 26906) (\CS.COMPARE.VARS 26908 . 27570) (\CS.ISMACROFORM 27572 . 27710) (
-\CS.ISRECFORM 27712 . 28040) (\CS.REC.NAME 28042 . 28361) (\CS.ISCOURIERFORM 28363 . 28463) (
-\CS.ISTEMPLATEFORM 28465 . 28563) (\CS.COMPARE.TEMPLATES 28565 . 28930) (\CS.ISPROPFORM 28932 . 29087)
- (\CS.PROP.NAME 29089 . 29234) (\CS.COMPARE.PROPS 29236 . 29393) (\CS.ISADDVARFORM 29395 . 29488) (
-\CS.COMPARE.ADDVARS 29490 . 29655) (\CS.ISFPKGCOMFORM 29657 . 29864) (\CS.COMPARE.FPKGCOMS 29866 . 
-30073) (\CS.COMPARE.DEFINE-FILE-INFO 30075 . 30665) (\CS.IGNOREFORMS 30667 . 31472)) (31475 37539 (
-CSOBJ.CREATE 31485 . 31898) (CSOBJ.DISPLAYFN 31900 . 32653) (CSOBJ.IMAGEBOXFN 32655 . 34816) (
-CSOBJ.BUTTONEVENTINFN 34818 . 37289) (CSOBJ.COPYBUTTONEVENTINFN 37291 . 37537)) (38420 40605 (
-CSBROWSER 38430 . 40603)))))
+  (FILEMAP (NIL (1683 26182 (COMPARESOURCES 1693 . 8341) (\CS.COMPARE.MASTERS 8343 . 15981) (
+\CS.COMPARE.TYPES 15983 . 19249) (\CS.EXAMINE 19251 . 22429) (\CS.FIXFNS 22431 . 23933) (
+\CS.SORT.DECLARES 23935 . 24278) (\CS.SORT.DECLARE1 24280 . 25700) (\CS.FILTER.GARBAGE 25702 . 26180))
+ (26183 31526 (\CS.ISFNFORM 26193 . 26461) (\CS.COMPARE.FNS 26463 . 26705) (\CS.FNSID 26707 . 26851) (
+\CS.ISVARFORM 26853 . 26958) (\CS.COMPARE.VARS 26960 . 27622) (\CS.ISMACROFORM 27624 . 27762) (
+\CS.ISRECFORM 27764 . 28092) (\CS.REC.NAME 28094 . 28413) (\CS.ISCOURIERFORM 28415 . 28515) (
+\CS.ISTEMPLATEFORM 28517 . 28615) (\CS.COMPARE.TEMPLATES 28617 . 28982) (\CS.ISPROPFORM 28984 . 29139)
+ (\CS.PROP.NAME 29141 . 29286) (\CS.COMPARE.PROPS 29288 . 29445) (\CS.ISADDVARFORM 29447 . 29540) (
+\CS.COMPARE.ADDVARS 29542 . 29707) (\CS.ISFPKGCOMFORM 29709 . 29916) (\CS.COMPARE.FPKGCOMS 29918 . 
+30125) (\CS.COMPARE.DEFINE-FILE-INFO 30127 . 30717) (\CS.IGNOREFORMS 30719 . 31524)) (31527 37591 (
+CSOBJ.CREATE 31537 . 31950) (CSOBJ.DISPLAYFN 31952 . 32705) (CSOBJ.IMAGEBOXFN 32707 . 34868) (
+CSOBJ.BUTTONEVENTINFN 34870 . 37341) (CSOBJ.COPYBUTTONEVENTINFN 37343 . 37589)) (38472 40657 (
+CSBROWSER 38482 . 40655)))))
 STOP

lispusers/DOC-OBJECTS

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Mar-2024 23:42:37" {WMEDLEY}<lispusers>DOC-OBJECTS.;36
 52788  
+
(FILECREATED " 9-Dec-2024 21:07:13" {WMEDLEY}<lispusers>DOC-OBJECTS.;58
 52672  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS DOCOBJ-INCLUDE-EDIT-WINDOWP)
+      :CHANGES-TO (FNS DOCOBJ-STRING-IMAGEBOX)
 
-      :PREVIOUS-DATE "19-Mar-2024 19:36:25" {WMEDLEY}<lispusers>DOC-OBJECTS.;35)
+      :PREVIOUS-DATE " 8-Dec-2024 15:49:01" {WMEDLEY}<lispusers>DOC-OBJECTS.;57)
 
 
 (PRETTYCOMPRINT DOC-OBJECTSCOMS)
@@ -17,7 +17,7 @@
 (* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities.  The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object.  This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands).  Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ.  Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments.  They can be (and are) used freely to record state or other desired info.  The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc.")

 
         (FILES (SYSLOAD)
-               TEDIT TEDIT IMAGEOBJ)
+               TEDIT IMAGEOBJ)
         (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
         (VARS (DocObjectsMenu NIL)
               (DocObjectsConfirmEditMenu NIL))
@@ -28,7 +28,7 @@
 
               (FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS 
                    DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE 
-                   DOCOBJ-INVOKE-IMAGEOBJFN DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
+                   DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
         [COMS 
               (* ;; "Eval'd Form")

 
@@ -108,7 +108,7 @@
 
 
 (FILESLOAD (SYSLOAD)
-       TEDIT TEDIT IMAGEOBJ)
+       TEDIT IMAGEOBJ)
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD TEDIT-EXPORTS.ALL)
@@ -167,44 +167,37 @@
     (GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM])
 
 (DOCOBJ-GET-LOOKS

-  [LAMBDA (TEXTOBJ CH#ORCHARLOOKS)
                           (* ; "Edited 19-Mar-2024 19:36 by rmk")


+  [LAMBDA (TEXTOBJ CH#ORCHARLOOKS)
                           (* ; "Edited  5-Apr-2024 12:20 by rmk")


+                                                             (* ; "Edited 19-Mar-2024 19:36 by rmk")


                                                              (* ; "Edited 29-Oct-2022 21:30 by rmk")

                                                              (* Koomen " 4-Feb-87 23:37")

 
 (* ;;; "Adapted from {ERIS}<TEDIT>TEDITLOOKS.;30 dated '15-Oct-85 16:51:10' to return looks itself, rather than a proplist.")

                                                              (* jds "10-Jul-85 16:02")

                                                              (* ; "Return a PLIST of character looks")

-    (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ))
-           LOOKS FONT NLOOKS)
-          [COND
-             ((type?
 CHARLOOKS CH#ORCHARLOOKS)               (* ; 
+    (LET ((TEXTOBJ (TEXTOBJ TEXTOBJ)))
+         (if
 (type?
 CHARLOOKS CH#ORCHARLOOKS)
+             then
                                            (* ; 
 
                                                     "He handed us a CHARLOOKS.  Unparse it for him.")

-              (SETQ LOOKS CH#ORCHARLOOKS))
-             ((ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))             (* ; 
+                  CH#ORCHARLOOKS
+           elseif
 (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
+             then
                                            (* ; 
 
                                      "There's no text in the document.  Use the extant caret looks.")

-              (SETQ LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)))
-             [(FIXP CH#ORCHARLOOKS)                          (* ; 
+                  (FGETTOBJ TEXTOBJ CARETLOOKS)
+           else
 (PLOOKS (\TEDIT.CHTOPC (if
 (FIXP CH#ORCHARLOOKS)
+                                           then
              (* ; 
 
                                                    "He gave us a CH# to get the looks of.  Grab it.")

-              (SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
-                                                       CH#ORCHARLOOKS)
-                                         TEXTOBJ]
-             [(type?
 SELECTION CH#ORCHARLOOKS)               (* ; 
+                                                CH#ORCHARLOOKS
+                                         elseif
 (type?
 SELECTION CH#ORCHARLOOKS)
+                                           then
              (* ; 
 
                                                             "Get the looks of the selected text")

-              (SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
-                                                       (GETSEL CH#ORCHARLOOKS CH#))
-                                         TEXTOBJ]
-             ((NULL CH#ORCHARLOOKS)                          (* ; 
+                                                (GETSEL CH#ORCHARLOOKS CH#)
+                                         elseif
 (NULL CH#ORCHARLOOKS)
+                                           then
              (* ; 
 
                                                             "Get the looks of the selected text")

-              (SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
-                                                       (GETSEL (FGETTOBJ TEXTOBJ SEL)
-                                                              CH#))
-                                         TEXTOBJ]
-          (RETURN LOOKS)
-
-(* ;;; "Now break the looks apart into a PROPLIST")

-
-          (SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS))
-          (RETURN NLOOKS])
+                                                (GETSEL (FGETTOBJ TEXTOBJ SEL)
+                                                       CH#))
+                               TEXTOBJ])
 
 (DOCOBJ-REGISTER-OBJECT

   [LAMBDA (OBJECT)
                                          (* ; "Edited 23-Oct-87 14:48 by Koomen")

@@ -218,8 +211,9 @@
              OBJECT])
 
 (DOCOBJ-STRING-IMAGEBOX

-  [LAMBDA (STRING IMAGESTREAM)
            (* Koomen " 9-Feb-87 17:22")

-    (DECLARE
 (SPECVARS CHNO TEXTOBJ))
+  [LAMBDA (STRING IMAGESTREAM)
                               (* ; "Edited  9-Dec-2024 21:04 by rmk")

+                                                             (* Koomen " 9-Feb-87 17:22")

+    (DECLARE
 (USEDFREE CHNO TEXTOBJ))
     (PROG (LOOKS CLOFFSET FONT DEVICE HEIGHT DESCENT)
           (SETQ LOOKS (DOCOBJ-GET-LOOKS
 TEXTOBJ CHNO))
           (SETQ CLOFFSET (fetch
 (CHARLOOKS CLOFFSET) of
 LOOKS))
@@ -230,10 +224,10 @@
           (SETQ HEIGHT (FONTHEIGHT FONT))
           (SETQ DESCENT (FONTPROP FONT 'DESCENT))
           (RETURN (create
 IMAGEBOX
-                         XSIZE _
 (STRINGWIDTH STRING FONT)
-                         YSIZE _
 (IPLUS HEIGHT (IABS CLOFFSET))
-                         YDESC _
 (IDIFFERENCE DESCENT CLOFFSET)
-                         XKERN _
 0])
+                         XSIZE _ (STRINGWIDTH STRING FONT)
+                         YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
+                         YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
+                         XKERN _ 0])
 
 (DOCOBJ-WAIT-MOUSE

   [LAMBDA (STREAM)
                 (* ; 
@@ -245,108 +239,104 @@
                           (LASTMOUSEY STREAM)))
               then
 (RETURN NIL)) finally
 (RETURN T])
 
-(DOCOBJ-INVOKE-IMAGEOBJFN

-  [LAMBDA (CH# PIECE IMAGEOBJFNNAME)
                         (* ; "Edited 28-Jun-2023 19:45 by rmk")


-                                                             (* ; "Edited  9-Sep-2022 16:10 by rmk")


-                                                             (* ; "Edited  7-Sep-2022 23:11 by rmk")


-                                                             (* ; "Edited  6-Sep-2022 10:05 by rmk")


-                                                            (* ; "Edited 15-Oct-87 23:35 by Koomen")

-
-    (* ;; "If PIECE is an IMAGEOBJ, invoke the function associated with the ImageObj property IMAGEOBJFNNAME on the IMAGEOBJ and the character position where the IMAGEOBJ is located. ")

-
-    (CL:WHEN (AND (type?
 PIECE PIECE)
-                  (EQ OBJECT.PTYPE (PTYPE PIECE)))
-        (LET ((IMAGEOBJ (PCONTENTS PIECE))
-              IMAGEOBJFN)
-             (SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME))
-             (CL:WHEN (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN))
-                    (APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE))))])
-
 (DOCOBJ-BEFOREHARDCOPYFN

-  [LAMBDA (TEXTSTREAM TEXTOBJ)
                               (* ; "Edited 16-Mar-2024 10:05 by rmk")


+  [LAMBDA (TEXTSTREAM)
                                       (* ; "Edited  8-Dec-2024 15:48 by rmk")


+                                                             (* ; "Edited 12-Jul-2024 12:46 by rmk")


+                                                             (* ; "Edited  7-Jul-2024 00:09 by rmk")


+                                                             (* ; "Edited  8-May-2024 00:05 by rmk")


+                                                             (* ; "Edited  6-May-2024 22:50 by rmk")


+                                                             (* ; "Edited  5-Apr-2024 08:03 by rmk")


+                                                             (* ; "Edited 16-Mar-2024 10:05 by rmk")


                                                              (* ; "Edited 16-Jul-2023 16:53 by rmk")


                                                              (* ; "Edited 10-Jul-2023 22:29 by rmk")

                                                              (* ; 
 
                                                        "Edited 25-May-93 13:07 by sybalsky:mv:envos")

 
-    (* ;; "This is the only BEFOREHARDCOPYFN, provided by DOC-OBJECTS.  If the text doesn't contain any such objects, the property is NIL and the piece-scan doesn't happen.  This is installed in the TEXTOBJ by the call to  DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")

+    (* ;; "This is the only BEFOREHARDCOPYFN provided by DOC-OBJECTS.  If the text doesn't contain any such objects, the property is NIL and te piece-scan doesn't happen.  This is installed in the TEXTOBJ by the call to  DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")

+
+    (* ;; "This runs through the file applying the BEFOREHARDCOPYFN of every object that has one.  For example, an include object will replace the object by its target file.")

+
+    (* ;; "This records all of the history events created during the object pass into a single composite even so that the DOCOBJ-AFTERHARDCOPYFN can restore the stream to its original state.")

 
     (RESETLST
 
         (* ;; "We don't want to update the display lines to show the intermediate state while we are updating the pieces.    ")

 
-        (RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
-               `(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
-        (LET ((PREVEVENTS (GETTOBJ TEXTOBJ TXTHISTORY))
-              (OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
-              (PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
-              FAILED)
+        (TEDIT.DEFER.UPDATES TEXTSTREAM)
+        (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
+               (OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
+               (PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
+               FAILED EVENTS)
 
-             (* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else.  But presumably it links into the previous saved piece, and we continue from there.")

+              (* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else.  But presumably it links into the previous saved piece, and we continue from there.")

 
-             [bind
 OBJ FN PREVPC (CH# _ 1)
-                   (PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while
 PC
-                do
 (SETQ PC (if
 (AND (EQ OBJECT.PTYPE (PTYPE PC))
-                                     (SETQ OBJ (PCONTENTS PC))
-                                     (SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
-                                     (DEFINEDP FN))
-                                then
 (SETQ PREVPC (PREVPIECE PC))
-                                     (CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
-                                         (SETQ FAILED T)
-                                         (RETURN))
-                                     (if
 PREVPC
-                                         then
 (NEXTPIECE (if
 (EQ PC (NEXTPIECE PREVPC))
-                                                             then
 
-                                                                  (* ;; 
+              [bind
 OBJ FN PREVPC (CH# _ 1)
+                    (PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while
 PC
+                 do
 (SETQ PC (if
 (AND (EQ OBJECT.PTYPE (PTYPE PC))
+                                      (SETQ OBJ (PCONTENTS PC))
+                                      (SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
+                                      (DEFINEDP FN))
+                                 then
 (SETQ PREVPC (PREVPIECE PC))
+                                      (CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
+                                          (SETQ FAILED T)
+                                          (RETURN))
+                                      (push
 EVENTS (\TEDIT.POPEVENT TEXTOBJ)) 
+                                                             (* ; "Accumulate undo events")

+                                      (if
 PREVPC
+                                          then
 (NEXTPIECE (if
 (EQ PC (NEXTPIECE PREVPC))
+                                                              then
 
+                                                                   (* ;; 
 
                                                                  "Nothing affected this PC, advance")

 
-                                                                  (add
 CH# (PLEN PC))
-                                                                  PC
-                                                           else
 
-                                                                (* ;; 
+                                                                   (add
 CH# (PLEN PC))
+                                                                   PC
+                                                            else
 
+                                                                 (* ;; 
 
                                                              "Otherwise investigate its replacement")

 
-                                                                PREVPC))
-                                       elseif
 (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
-                                         then
 (add
 CH# (PLEN PC))
-                                              (NEXTPIECE PC)
-                                       else
 
-                                            (* ;; 
+                                                                 PREVPC))
+                                        elseif
 (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
+                                          then
 (add
 CH# (PLEN PC))
+                                               (NEXTPIECE PC)
+                                        else
 
+                                             (* ;; 
 
                                           "Investigate the replacement of the previous first piece.")

 
-                                            (\TEDIT.FIRSTPIECE TEXTOBJ))
-                              else
 (add
 CH# (PLEN PC))
-                                   (NEXTPIECE PC]            (* ; "Restore previous settings")

+                                             (\TEDIT.FIRSTPIECE TEXTOBJ))
+                               else
 (add
 CH# (PLEN PC))
+                                    (NEXTPIECE PC]           (* ; "Restore previous settings")

                                                              (* ; 
 
                                                          "The history event may restore SEL, but...")

-             (SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
+              (SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
 
-             (* ;; "Make a single undoing event for the after fn")

+              (* ;; "Make a single event for the afterfn to undo")

 
-             (for
 ETAIL on
 (GETTOBJ TEXTOBJ TXTHISTORY) until
 (EQ ETAIL PREVEVENTS)
-                collect
 (CAR ETAIL) finally
 (SETTOBJ TEXTOBJ TXTHISTORY (CONS $$VAL PREVEVENTS)))
-
-             (* ;; "In case something screws up, at least redisplaying will show something correctly (even if we aren't \DIRTY)")

-
-             (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
-             (CL:WHEN FAILED
-                 (DOCOBJ-AFTERHARDCOPYFN
 TEXTSTREAM TEXTOBJ) (* ; "UNDO whatever was saved")

-                 (SETTOBJ TEXTOBJ SEL PREVSEL)
-                 'DON'T)))])
+              (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS)
+              (CL:WHEN FAILED
+                  (DOCOBJ-AFTERHARDCOPYFN
 TEXTSTREAM)        (* ; "UNDO whatever was saved")

+                  (SETTOBJ TEXTOBJ SEL PREVSEL)
+                  'DON'T)))])
 
 (DOCOBJ-AFTERHARDCOPYFN

-  [LAMBDA (TEXTSTREAM TEXTOBJ)
                               (* ; "Edited 15-Mar-2024 14:24 by rmk")


+  [LAMBDA (TSTREAM)
                                          (* ; "Edited  7-Jul-2024 00:07 by rmk")


+                                                             (* ; "Edited  5-Jul-2024 22:59 by rmk")


+                                                             (* ; "Edited  3-Jul-2024 09:55 by rmk")


+                                                             (* ; "Edited  8-May-2024 10:42 by rmk")


+                                                             (* ; "Edited  7-May-2024 08:20 by rmk")


+                                                             (* ; "Edited  5-Apr-2024 08:05 by rmk")


+                                                             (* ; "Edited 15-Mar-2024 14:24 by rmk")


                                                              (* ; "Edited 15-Jul-2023 15:57 by rmk")

                                                              (* ; 
 
                                                        "Edited 25-May-93 13:08 by sybalsky:mv:envos")

+    (SETQ TSTREAM (TEXTSTREAM TSTREAM))
     (RESETLST
-        (RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
-               `(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
-        (LET ((PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
-             (TEDIT.UNDO TEXTOBJ)
-             (SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)
-             (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
-             (\TEDIT.UPDATE.SCREEN TEXTOBJ)))])
+        [RESETSAVE (TEXTPROP TSTREAM 'DON'TUPDATE T)
+               `(PROGN (TEXTPROP ,TSTREAM 'DON'TUPDATE OLDVALUE)
+                       (\TEDIT.FILL.PANES ,TSTREAM]
+        (LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
+               (PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
+              (TEDIT.UNDO TSTREAM T)
+              (SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)))])
 )
 
 
@@ -750,11 +740,10 @@
          IMAGEOBJ])
 
 (DOCOBJ-INCLUDE-EDIT

-  [LAMBDA (INCLOBJ)
                                     (* ; "Edited  9-May-2018 11:09 by rmk:")


-                                                            (* ; "Edited  9-May-2018 10:35 by rmk:")

-                                                             (* ; 
-
                                                           "Edited 26-Oct-87 19:57 by Koomen")

-    (DECLARE
 (SPECVARS TEXTOBJ))
+  [LAMBDA (INCLOBJ TSTREAM)
                                  (* ; "Edited 12-May-2024 09:03 by rmk")


+                                                            (* ; "Edited  9-May-2018 11:09 by rmk:")


+                                                            (* ; "Edited  9-May-2018 10:35 by rmk:")


+                                                            (* ; "Edited 26-Oct-87 19:57 by Koomen")

     (SELECTQ [MENU (OR DOCOBJ-INCLUDE-EDITMENU (SETQ DOCOBJ-INCLUDE-EDITMENU
                                                 (create
 MENU
                                                        TITLE _ "Edit Include"
@@ -771,41 +760,38 @@
                                                        CENTERFLG _ T
                                                        MENUOFFSET _ '(-1 . 30)
                                                        CHANGEOFFSETFLG _ 'Y]
-        (NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TEXTOBJ "Enter new file name: " (fetch

-                                                                                  (INCLOBJ FILENAME)
+        (NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TSTREAM "Enter new file name: " (fetch
 (INCLOBJ
+                                                                                         FILENAME)
                                                                                     of
 INCLOBJ]
                        (if
 [AND NEWNAME (SETQ NEWNAME (MKSTRING NEWNAME))
-                                    (NOT (EQUAL NEWNAME (fetch
 (INCLOBJ FILENAME) of
 INCLOBJ]
+                                (NOT (EQUAL NEWNAME (fetch
 (INCLOBJ FILENAME) of
 INCLOBJ]
                            then
 (replace
 (INCLOBJ FILENAME) of
 INCLOBJ with
 NEWNAME)
-                                 T)))
+                                T)))
         (EDIT.FILE (for
 W in
 (OPENWINDOWS)
-                      bind
 [FULLNAME _ (OR [FINDFILE (fetch
 (INCLOBJ FILENAME) of
 INCLOBJ
-                                                                )
-                                                      T
-                                                      (CONS (PACKFILENAME.STRING 'HOST
-                                                                   (FILENAMEFIELD (FETCH
 TXTFILE
-                                                                                     OF
 TEXTOBJ)
-                                                                          'HOST)
-                                                                   'DIRECTORY
-                                                                   (FILENAMEFIELD (FETCH
 TXTFILE
-                                                                                     OF
 TEXTOBJ)
-                                                                          'DIRECTORY]
-                                               (INFILEP (fetch
 (INCLOBJ FILENAME) of
 INCLOBJ]
+                      bind
 [FULLNAME _ (OR (FINDFILE-WITH-EXTENSIONS
+                                            (fetch
 (INCLOBJ FILENAME) of
 INCLOBJ)
+                                            (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
+                                                                              TXTFILE
+                                                                              'HOST)
+                                                         'DIRECTORY
+                                                         (FILENAMEFIELD TXTFILE 'DIRECTORY))
+                                                  DIRECTORIES)
+                                            *TEDIT-EXTENSIONS*)
+                                           (INFILEP (fetch
 (INCLOBJ FILENAME) of
 INCLOBJ]
                       first
 (if
 (NULL FULLNAME)
-                                    then
 (TEDIT.PROMPTPRINT TEXTOBJ "Can't find " T)
-                                          (TEDIT.PROMPTPRINT TEXTOBJ (fetch
 (INCLOBJ FILENAME)
-                                                                        of
 INCLOBJ))
-                                          (RETURN)) when
 (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP

-                                                                      FULLNAME W))
+                                then
 (TEDIT.PROMPTPRINT TSTREAM "Can't find " T)
+                                     (TEDIT.PROMPTPRINT TSTREAM (fetch
 (INCLOBJ FILENAME)
+                                                                   of
 INCLOBJ))
+                                     (RETURN)) when
 (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP
 FULLNAME W))
                       do
 (TOTOPW W)
-                            (GIVE.TTY.PROCESS W)
-                            (RETURN) finally
 (TEDIT (MKATOM FULLNAME))))
+                         (GIVE.TTY.PROCESS W)
+                         (RETURN) finally
 (TEDIT (MKATOM FULLNAME))))
         (ENABLE (if
 (NOT (fetch
 (INCLOBJ ENABLEDP) of
 INCLOBJ))
                     then
 (replace
 (INCLOBJ ENABLEDP) of
 INCLOBJ with
 T)
-                          T))
+                         T))
         (DISABLE (if
 (fetch
 (INCLOBJ ENABLEDP) of
 INCLOBJ)
                      then
 (replace
 (INCLOBJ ENABLEDP) of
 INCLOBJ with
 NIL)
-                           T))
+                          T))
         NIL])
 
 (DOCOBJ-INCLUDE-EDIT-WINDOWP

@@ -842,56 +828,51 @@
 (DEFINEQ
 
 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN

-  [LAMBDA (TEXTOBJ OBJ PC CH#)
                               (* ; "Edited 16-Feb-2024 23:47 by rmk")


+  [LAMBDA (TEXTOBJ OBJ PC CH#)
                               (* ; "Edited 13-Sep-2024 15:13 by rmk")


+                                                             (* ; "Edited 12-May-2024 08:48 by rmk")


+                                                             (* ; "Edited  7-May-2024 23:33 by rmk")


+                                                             (* ; "Edited 16-Feb-2024 23:47 by rmk")


                                                              (* ; "Edited 23-Jul-2023 22:45 by rmk")


                                                              (* ; "Edited 16-Jul-2023 11:14 by rmk")


                                                              (* ; "Edited 10-Jul-2023 22:18 by rmk")


                                                              (* ; "Edited 22-Jun-2023 16:44 by rmk")

 
-    (* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file.  The undo event will restore the object.  Since the piece with the object is deleted, its paragraph looks are ignored and only the lookos of the inserted file are interpreted.  E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.'")

+    (* ;; "This  replaces the PC, the piece with an included-file object, with the contents of that file.  The undo event will restore the object.  Since the piece with the object is deleted, its paragraph looks are ignored and only the looks of the inserted file are interpreted.  E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.")

 
     (* ;; "Returns T if the inclusion is succeeds as intended, NIL otherwise.")

 
     (* ;; "Not sure why the INCLUDEDP property.  If enabled, it's included.")

 
-    (if
 (fetch
 (INCLOBJ ENABLEDP) of
 (IMAGEOBJPROP OBJ 'OBJECTDATUM))
-        then
 (LET ([INCLFILE (fetch
 (INCLOBJ FILENAME) of
 (IMAGEOBJPROP OBJ 'OBJECTDATUM]
-                   (TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
-                   INCLSTREAM)
-                  [SETQ INCLFILE (FINDFILE INCLFILE T (AND TXTFILE (CONS (PACKFILENAME.STRING
-                                                                          'HOST
-                                                                          (FILENAMEFIELD TXTFILE
-                                                                                 'HOST)
-                                                                          'DIRECTORY
-                                                                          (FILENAMEFIELD TXTFILE
-                                                                                 'DIRECTORY))
-                                                                         DIRECTORIES]
-                  (if
 INCLFILE
-                      then
 
-                           (* ;; "No point in prompting:  it just flashes by")

+    (CL:WHEN (fetch
 (INCLOBJ ENABLEDP) of
 (IMAGEOBJPROP OBJ 'OBJECTDATUM))
+        (LET ([INCLFILE (fetch
 (INCLOBJ FILENAME) of
 (IMAGEOBJPROP OBJ 'OBJECTDATUM]
+              (TXTFILE (GETTOBJ TEXTOBJ TXTFILE)))
+             (SETQ INCLFILE (FINDFILE-WITH-EXTENSIONS INCLFILE
+                                   (AND TXTFILE (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
+                                                                                  TXTFILE
+                                                                                  'HOST)
+                                                             'DIRECTORY
+                                                             (FILENAMEFIELD TXTFILE 'DIRECTORY))
+                                                      DIRECTORIES))
+                                   *TEDIT-EXTENSIONS*))
+             (if
 INCLFILE
+                 then
                                        (* ; "Don't update/show until end")

+                      (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
+                             CH# 1 'LEFT)                    (* ; "Deletes this include-object")

+                      (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ))
+                      (TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
+                      (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included " INCLFILE)) 
 
-                           (AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE "...")
-                                           T))
-                           (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
-                                  CH# 1 'LEFT T)             (* ; "Set the destination")

-                           (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)
-                                  T)
-                           (TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
-                           (AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE 
-                                                                      "...done")))
-                    else
 
-                         (* ;; "Did not succeed as intended.  Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")

+                      (* ;; "Succeeded as intended")

 
-                         (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch
 (INCLOBJ FILENAME
-                                                                                           )
-                                                                                of
 OBJ)
-                                                           " not found")
-                                T T)
-                         NIL))
-      else
 
-           (* ;; "Succeeded as intended")

+                      T
+               else
 
+                    (* ;; "Did not succeed as intended.  Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")

 
-           T])
+                    (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch
 (INCLOBJ FILENAME)
+                                                                           of
 OBJ)
+                                                      " not found")
+                           T T)
+                    NIL)))])
 
 (DOCOBJ-INCLUDE-CLEANUPFN

   [LAMBDA (TEXTSTREAM STARTPOS LEN)
                          (* ; "Edited 15-Mar-2024 14:08 by rmk")


@@ -919,12 +900,13 @@
 
 (DOCOBJ-INCLUDE-BUTTONEVENTINFN

   [LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)

+                                                             (* ; "Edited 12-May-2024 09:01 by rmk")


                                                             (* ; "Edited 23-Oct-87 00:46 by Koomen")

-
     (if
 (AND (EQ BUTTON 'MIDDLE)
              (DOCOBJ-WAIT-MOUSE
 WINDOWSTREAM))
         then
 (ALLOW.BUTTON.EVENTS)
-             (if
 (DOCOBJ-INCLUDE-EDIT
 (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))
+             (if
 (DOCOBJ-INCLUDE-EDIT
 (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)
+                        HOSTSTREAM)
                  then
 (DOCOBJ-INCLUDE-RESET-OBJ
 IMAGEOBJ)
                       'CHANGED])
 
@@ -1011,30 +993,29 @@
 (PUTPROPS DOC-OBJECTS
 MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7682 21029 (DOCOBJ-ACQUIRE-OBJECT 7692 . 8693) (DOCOBJ-INIT 8695 . 9323) (
-DOCOBJ-TEDIT-MENU-ENTRY 9325 . 9747) (DOCOBJ-GET-LOOKS 9749 . 12364) (DOCOBJ-REGISTER-OBJECT 12366 . 
-13020) (DOCOBJ-STRING-IMAGEBOX 13022 . 13970) (DOCOBJ-WAIT-MOUSE 13972 . 14432) (
-DOCOBJ-INVOKE-IMAGEOBJFN 14434 . 15557) (DOCOBJ-BEFOREHARDCOPYFN 15559 . 20205) (
-DOCOBJ-AFTERHARDCOPYFN 20207 . 21027)) (21059 21326 (DOCOBJ-ACQUIRE-EVALED-OBJECT 21069 . 21324)) (
-21526 21668 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21536 . 21666)) (22007 26803 (DOCOBJ-EDIT-TIMESTAMP 22017
- . 22546) (DOCOBJ-MAKE-TIMESTAMP 22548 . 22959) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 22961 . 24031) (
-DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24033 . 24564) (DOCOBJ-TIMESTAMP-COPYFN 24566 . 24891) (
-DOCOBJ-TIMESTAMP-DISPLAYFN 24893 . 25186) (DOCOBJ-TIMESTAMP-GETFN 25188 . 25428) (
-DOCOBJ-TIMESTAMP-IMAGEBOXFN 25430 . 25786) (DOCOBJ-TIMESTAMP-PREPRINTFN 25788 . 26019) (
-DOCOBJ-TIMESTAMP-PUTFN 26021 . 26390) (DOCOBJ-TIMESTAMP-TO-STRING 26392 . 26801)) (27097 31404 (
-DOCOBJ-MAKE-FILESTAMP 27107 . 27448) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27450 . 28492) (
-DOCOBJ-FILESTAMP-COPYFN 28494 . 28809) (DOCOBJ-FILESTAMP-DISPLAYFN 28811 . 29099) (
-DOCOBJ-FILESTAMP-GETFN 29101 . 29454) (DOCOBJ-FILESTAMP-IMAGEBOXFN 29456 . 29794) (
-DOCOBJ-FILESTAMP-GET-FULLNAME 29796 . 30414) (DOCOBJ-FILESTAMP-NEW-FULLNAME 30416 . 30889) (
-DOCOBJ-FILESTAMP-PREPRINTFN 30891 . 31100) (DOCOBJ-FILESTAMP-PUTFN 31102 . 31402)) (31727 34224 (
-DOCOBJ-MAKE-HRULE 31737 . 32151) (DOCOBJ-EDIT-HRULE 32153 . 32625) (DOCOBJ-HRULE-INIT 32627 . 32959) (
-DOCOBJ-HRULE-GET-WIDTH 32961 . 33772) (DOCOBJ-HRULE-BUTTONEVENTINFN 33774 . 34222)) (34643 43315 (
-DOCOBJ-MAKE-INCLUDE 34653 . 35054) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35056 . 36061) (
-DOCOBJ-INCLUDE-CREATE-OBJ 36063 . 36831) (DOCOBJ-INCLUDE-EDIT 36833 . 41432) (
-DOCOBJ-INCLUDE-EDIT-WINDOWP 41434 . 42290) (DOCOBJ-INCLUDE-RESET-OBJ 42292 . 43313)) (43316 52247 (
-DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43326 . 47048) (DOCOBJ-INCLUDE-CLEANUPFN 47050 . 48569) (
-DOCOBJ-INCLUDE-BUTTONEVENTINFN 48571 . 49105) (DOCOBJ-INCLUDE-COPYFN 49107 . 49325) (
-DOCOBJ-INCLUDE-DISPLAYFN 49327 . 50079) (DOCOBJ-INCLUDE-GETFN 50081 . 50804) (
-DOCOBJ-INCLUDE-IMAGEBOXFN 50806 . 51815) (DOCOBJ-INCLUDE-PREPRINTFN 51817 . 52036) (
-DOCOBJ-INCLUDE-PUTFN 52038 . 52245)))))
+  (FILEMAP (NIL (7640 21328 (DOCOBJ-ACQUIRE-OBJECT 7650 . 8651) (DOCOBJ-INIT 8653 . 9281) (
+DOCOBJ-TEDIT-MENU-ENTRY 9283 . 9705) (DOCOBJ-GET-LOOKS 9707 . 12167) (DOCOBJ-REGISTER-OBJECT 12169 . 
+12823) (DOCOBJ-STRING-IMAGEBOX 12825 . 13881) (DOCOBJ-WAIT-MOUSE 13883 . 14343) (
+DOCOBJ-BEFOREHARDCOPYFN 14345 . 19815) (DOCOBJ-AFTERHARDCOPYFN 19817 . 21326)) (21358 21625 (
+DOCOBJ-ACQUIRE-EVALED-OBJECT 21368 . 21623)) (21825 21967 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21835 . 21965
+)) (22306 27102 (DOCOBJ-EDIT-TIMESTAMP 22316 . 22845) (DOCOBJ-MAKE-TIMESTAMP 22847 . 23258) (
+DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23260 . 24330) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24332 . 24863) (
+DOCOBJ-TIMESTAMP-COPYFN 24865 . 25190) (DOCOBJ-TIMESTAMP-DISPLAYFN 25192 . 25485) (
+DOCOBJ-TIMESTAMP-GETFN 25487 . 25727) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25729 . 26085) (
+DOCOBJ-TIMESTAMP-PREPRINTFN 26087 . 26318) (DOCOBJ-TIMESTAMP-PUTFN 26320 . 26689) (
+DOCOBJ-TIMESTAMP-TO-STRING 26691 . 27100)) (27396 31703 (DOCOBJ-MAKE-FILESTAMP 27406 . 27747) (
+DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27749 . 28791) (DOCOBJ-FILESTAMP-COPYFN 28793 . 29108) (
+DOCOBJ-FILESTAMP-DISPLAYFN 29110 . 29398) (DOCOBJ-FILESTAMP-GETFN 29400 . 29753) (
+DOCOBJ-FILESTAMP-IMAGEBOXFN 29755 . 30093) (DOCOBJ-FILESTAMP-GET-FULLNAME 30095 . 30713) (
+DOCOBJ-FILESTAMP-NEW-FULLNAME 30715 . 31188) (DOCOBJ-FILESTAMP-PREPRINTFN 31190 . 31399) (
+DOCOBJ-FILESTAMP-PUTFN 31401 . 31701)) (32026 34523 (DOCOBJ-MAKE-HRULE 32036 . 32450) (
+DOCOBJ-EDIT-HRULE 32452 . 32924) (DOCOBJ-HRULE-INIT 32926 . 33258) (DOCOBJ-HRULE-GET-WIDTH 33260 . 
+34071) (DOCOBJ-HRULE-BUTTONEVENTINFN 34073 . 34521)) (34942 43284 (DOCOBJ-MAKE-INCLUDE 34952 . 35353) 
+(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35355 . 36360) (DOCOBJ-INCLUDE-CREATE-OBJ 36362 . 37130) (
+DOCOBJ-INCLUDE-EDIT 37132 . 41401) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41403 . 42259) (
+DOCOBJ-INCLUDE-RESET-OBJ 42261 . 43282)) (43285 52131 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43295 . 46789) 
+(DOCOBJ-INCLUDE-CLEANUPFN 46791 . 48310) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48312 . 48989) (
+DOCOBJ-INCLUDE-COPYFN 48991 . 49209) (DOCOBJ-INCLUDE-DISPLAYFN 49211 . 49963) (DOCOBJ-INCLUDE-GETFN 
+49965 . 50688) (DOCOBJ-INCLUDE-IMAGEBOXFN 50690 . 51699) (DOCOBJ-INCLUDE-PREPRINTFN 51701 . 51920) (
+DOCOBJ-INCLUDE-PUTFN 51922 . 52129)))))
 STOP

lispusers/EQUATIONS

@@ -1,24 +1,22 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 3-Mar-88 13:51:10" {ERINYES}<LISPUSERS>LYRIC>EQUATIONS.;1
 86057  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS EQIO.Put EQIO.Get)
+
(FILECREATED "28-Jun-2024 22:11:21" {WMEDLEY}<lispusers>EQUATIONS.;2
 85831  
 
-      previous date%: "27-May-87 11:20:49" |{IE:PARC:XEROX}<LISP>LYRIC>LISPUSERS>EQUATIONS.;1|)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS EQN.WindowFromText)
+
+      :PREVIOUS-DATE " 3-Mar-88 13:51:10" {WMEDLEY}<lispusers>EQUATIONS.;1)
 
-(* "
-Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT EQUATIONSCOMS)
 
-(RPAQQ EQUATIONSCOMS
 
+(RPAQQ EQUATIONSCOMS

        (
 
 (* ;;; "EQUATION module: Part 1 of 3")

 
                                                              (* ; "functions for image object")

-
         (FNS EQIO.CreateFns EQIO.Create EQIO.Imagebox EQIO.Display EQIO.ButtonEventIn EQIO.Copy 
              EQIO.CopyList EQIO.Get EQIO.Put EQIO.WhenDeleted EQIO.SelectRegion EQIO.Selection 
              EQIO.DefaultSelectFn EQIO.MakeSelectionMenu)
@@ -32,7 +30,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
 
 (* ;;; "functions to handle equation specification info")

 
-        (FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined 
+        (FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined
              EQIO.GetBox EQIO.GetDataSpec EQIO.GetDataSpecList EQIO.GetDataPosition 
              EQIO.GetDataSelectRegion EQIO.MakeSpec EQIO.MakeDataSpec)
         
@@ -46,7 +44,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
         [P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation]
         (P                                                   (* ; 
 
                             "needed to force the getfn to be recognized before any new eqns defined")

-
            (SETQ EquationImageFns (EQIO.CreateFns)))
         (VARS UnknownEquationData)
         (PROP ARGNAMES EQIO.TypeProp EQIO.NumPieces EQIO.AllProps EQIO.EqnProperty)
@@ -61,7 +58,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
 (* ;;; "EQUATIONEDIT module: Part 2 of 3")

 
                                                              (* ; "functions to edit data pieces")

-
         (FNS EQN.AbortEdit EQN.StopEdit EQN.ContinueEdit EQN.FinishEdit EQN.MakeEditWindow 
              EQN.SetUpEdit EQN.StartEdit EQN.StartNextEdit EQN.UpdateEdit EQN.DefaultData 
              EQN.TypeMenu)
@@ -69,7 +65,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
 
 (* ;;; "hooks to control behavior of equation subeditor")

 
-        (FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn 
+        (FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn
              EQN.TEditSpecialChar EQN.SnuggleWindows EQN.SnuggleMainWindow)
         
 
@@ -680,25 +676,27 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
 (RPAQ? EquationInfo
 NIL)
 
 (RPAQ? EquationDefaultSelectFn
 'EQIO.DefaultSelectFn)
+
 [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation]
+
                                                              (* ; 
 
                             "needed to force the getfn to be recognized before any new eqns defined")

 
-(SETQ EquationImageFns (EQIO.CreateFns))
+(SETQ EquationImageFns (EQIO.CreateFns
))
 
 (RPAQQ UnknownEquationData
 (((Gacha 10)
                              "[unknown equation]")))
 
-(PUTPROPS EQIO.TypeProp ARGNAMES
 (NIL (type prop {newValue})
+(PUTPROPS EQIO.TypeProp
 ARGNAMES
 (NIL (type prop {newValue})
                                       args))
 
-(PUTPROPS EQIO.NumPieces ARGNAMES
 (NIL (eqnObj {newValue})
+(PUTPROPS EQIO.NumPieces
 ARGNAMES
 (NIL (eqnObj {newValue})
                                        args))
 
-(PUTPROPS EQIO.AllProps ARGNAMES
 (NIL (eqnObj {newValue})
+(PUTPROPS EQIO.AllProps
 ARGNAMES
 (NIL (eqnObj {newValue})
                                       args))
 
-(PUTPROPS EQIO.EqnProperty ARGNAMES
 (NIL (eqnObj prop {newValue})
+(PUTPROPS EQIO.EqnProperty
 ARGNAMES
 (NIL (eqnObj prop {newValue})
                                          args))
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
@@ -1316,13 +1314,12 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
     (EQN.ResultWindow
 window])
 
 (EQN.WindowFromText

-  [LAMBDA (textObjORStream)
                                  (* thh%: "28-Jun-85 14:32")

-                                                             (* gets window corresponding to a text 
-
                                                             object or stream)

-          
-          (* note%: \WINDOW field actually is a list whose only element is the window)

+  [LAMBDA (textObjORStream)
                                  (* ; "Edited 28-Jun-2024 22:11 by rmk")

+                                                             (* thh%: "28-Jun-85 14:32")

 
-    (LET [(w (fetch
 \WINDOW of
 (TEXTOBJ textObjORStream]
+    (* ;; "gets window corresponding to a text object or stream")

+
+    (LET [(w (\TEDIT.PRIMARYPANE (TEXTOBJ textObjORStream]
          (OR (WINDOWP w)
              (WINDOWP (CAR w))
              (ERROR "EQN.WindowFromText: unable to find window for textobj/stream = " textObjORStream
@@ -1477,22 +1474,22 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
 ) (TimesRoman 12) NIL))))
 
 
-(PUTPROPS EQN.ObjEditWindow ARGNAMES
 (NIL (eqnObj {newEditWindow})
+(PUTPROPS EQN.ObjEditWindow
 ARGNAMES
 (NIL (eqnObj {newEditWindow})
                                           args))
 
-(PUTPROPS EQN.ContinueFlg ARGNAMES
 (NIL (editWindow {continueFlg})
+(PUTPROPS EQN.ContinueFlg
 ARGNAMES
 (NIL (editWindow {continueFlg})
                                         args))
 
-(PUTPROPS EQN.PieceNumber ARGNAMES
 (NIL (editWindow {pieceNumber})
+(PUTPROPS EQN.PieceNumber
 ARGNAMES
 (NIL (editWindow {pieceNumber})
                                         args))
 
-(PUTPROPS EQN.ResultObj ARGNAMES
 (NIL (editWindow {resultObj})
+(PUTPROPS EQN.ResultObj
 ARGNAMES
 (NIL (editWindow {resultObj})
                                       args))
 
-(PUTPROPS EQN.ResultWindow ARGNAMES
 (NIL (editWindow {resultWindow})
+(PUTPROPS EQN.ResultWindow
 ARGNAMES
 (NIL (editWindow {resultWindow})
                                          args))
 
-(PUTPROPS EQN.EditWindow ARGNAMES
 (NIL (window {editWindow})
+(PUTPROPS EQN.EditWindow
 ARGNAMES
 (NIL (window {editWindow})
                                        args))
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
@@ -1797,37 +1794,37 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation.  All rights reserved.
 
 (* ;;; "Now load EQUATIONFORMS")

 
+
 (FILESLOAD EQUATIONFORMS)
-(PUTPROPS EQUATIONS COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4524 19553 (EQIO.CreateFns 4534 . 5067) (EQIO.Create 5069 . 6335) (EQIO.Imagebox 6337
- . 6749) (EQIO.Display 6751 . 8362) (EQIO.ButtonEventIn 8364 . 12205) (EQIO.Copy 12207 . 12588) (
-EQIO.CopyList 12590 . 13161) (EQIO.Get 13163 . 13571) (EQIO.Put 13573 . 14128) (EQIO.WhenDeleted 14130
- . 14624) (EQIO.SelectRegion 14626 . 15773) (EQIO.Selection 15775 . 17279) (EQIO.DefaultSelectFn 17281
- . 18519) (EQIO.MakeSelectionMenu 18521 . 19551)) (19627 25629 (EQIO.EqnType 19637 . 19888) (
-EQIO.EqnDataList 19890 . 20230) (EQIO.SetDataList 20232 . 20629) (EQIO.EqnData 20631 . 20810) (
-EQIO.EqnProperty 20812 . 21740) (EQIO.AllProps 21742 . 22257) (EQIO.Specify 22259 . 22756) (
-EQIO.GetInitialProps 22758 . 23890) (EQIO.NumPieces 23892 . 25135) (EQIO.NewStructure 25137 . 25627)) 
-(25696 30158 (EQIO.AddType 25706 . 26219) (EQIO.GetInfo 26221 . 26571) (EQIO.SetInfo 26573 . 27214) (
-EQIO.TypeProp 27216 . 28162) (EQIO.ResetTypeProps 28164 . 28486) (EQIO.IsDefined 28488 . 28773) (
-EQIO.GetBox 28775 . 28995) (EQIO.GetDataSpec 28997 . 29330) (EQIO.GetDataSpecList 29332 . 29477) (
-EQIO.GetDataPosition 29479 . 29619) (EQIO.GetDataSelectRegion 29621 . 29765) (EQIO.MakeSpec 29767 . 
-30003) (EQIO.MakeDataSpec 30005 . 30156)) (31711 48815 (EQN.AbortEdit 31721 . 32233) (EQN.StopEdit 
-32235 . 32682) (EQN.ContinueEdit 32684 . 36336) (EQN.FinishEdit 36338 . 37071) (EQN.MakeEditWindow 
-37073 . 38492) (EQN.SetUpEdit 38494 . 39671) (EQN.StartEdit 39673 . 42974) (EQN.StartNextEdit 42976 . 
-43493) (EQN.UpdateEdit 43495 . 44892) (EQN.DefaultData 44894 . 47579) (EQN.TypeMenu 47581 . 48813)) (
-48882 56790 (EQN.Equation 48892 . 50151) (EQN.NextPiece 50153 . 50878) (EQN.FinishEqn 50880 . 51409) (
-EQN.NoUpdateAbort 51411 . 51824) (EQN.PreventUpdate 51826 . 52261) (EQN.CharFn 52263 . 54348) (
-EQN.TEditSpecialChar 54350 . 55069) (EQN.SnuggleWindows 55071 . 55662) (EQN.SnuggleMainWindow 55664 . 
-56788)) (56844 58583 (EQN.EquationFontNumber 56854 . 57613) (EQN.EquationFont 57615 . 57957) (
-EQN.GetEqnFont 57959 . 58140) (EQN.MakeFS 58142 . 58581)) (58612 61753 (EQN.AdjustWindow 58622 . 60582
-) (EQN.CheckWindowSize 60584 . 61751)) (61754 67638 (EQN.SubEditorP 61764 . 61997) (EQN.WindowFromText
- 61999 . 62656) (EQN.EditWindow 62658 . 63736) (EQN.ResultWindow 63738 . 64288) (EQN.ResultObj 64290
- . 64758) (EQN.PieceNumber 64760 . 65309) (EQN.ContinueFlg 65311 . 65874) (EQN.ValidEditWindow 65876
- . 66310) (EQN.ObjEditWindow 66312 . 67636)) (67639 68756 (EQN.Make 67649 . 68754)) (69964 85899 (
-FS.Box 69974 . 72220) (FS.Copy 72222 . 72862) (FS.Display 72864 . 75850) (FS.Get 75852 . 76321) (
-FS.Put 76323 . 76794) (FS.ItemFont 76796 . 77157) (FS.ItemValue 77159 . 77565) (FS.ItemShift 77567 . 
-77947) (FS.MakeItem 77949 . 78371) (FS.Extract 78373 . 82297) (FS.ExtractFont 82299 . 82902) (
-FS.ExtractShift 82904 . 83467) (FS.Insert 83469 . 85458) (FS.AllowedChar 85460 . 85697) (
-FS.RealStringP 85699 . 85897)))))
+  (FILEMAP (NIL (4439 19468 (EQIO.CreateFns 4449 . 4982) (EQIO.Create 4984 . 6250) (EQIO.Imagebox 6252
+ . 6664) (EQIO.Display 6666 . 8277) (EQIO.ButtonEventIn 8279 . 12120) (EQIO.Copy 12122 . 12503) (
+EQIO.CopyList 12505 . 13076) (EQIO.Get 13078 . 13486) (EQIO.Put 13488 . 14043) (EQIO.WhenDeleted 14045
+ . 14539) (EQIO.SelectRegion 14541 . 15688) (EQIO.Selection 15690 . 17194) (EQIO.DefaultSelectFn 17196
+ . 18434) (EQIO.MakeSelectionMenu 18436 . 19466)) (19542 25544 (EQIO.EqnType 19552 . 19803) (
+EQIO.EqnDataList 19805 . 20145) (EQIO.SetDataList 20147 . 20544) (EQIO.EqnData 20546 . 20725) (
+EQIO.EqnProperty 20727 . 21655) (EQIO.AllProps 21657 . 22172) (EQIO.Specify 22174 . 22671) (
+EQIO.GetInitialProps 22673 . 23805) (EQIO.NumPieces 23807 . 25050) (EQIO.NewStructure 25052 . 25542)) 
+(25611 30073 (EQIO.AddType 25621 . 26134) (EQIO.GetInfo 26136 . 26486) (EQIO.SetInfo 26488 . 27129) (
+EQIO.TypeProp 27131 . 28077) (EQIO.ResetTypeProps 28079 . 28401) (EQIO.IsDefined 28403 . 28688) (
+EQIO.GetBox 28690 . 28910) (EQIO.GetDataSpec 28912 . 29245) (EQIO.GetDataSpecList 29247 . 29392) (
+EQIO.GetDataPosition 29394 . 29534) (EQIO.GetDataSelectRegion 29536 . 29680) (EQIO.MakeSpec 29682 . 
+29918) (EQIO.MakeDataSpec 29920 . 30071)) (31648 48752 (EQN.AbortEdit 31658 . 32170) (EQN.StopEdit 
+32172 . 32619) (EQN.ContinueEdit 32621 . 36273) (EQN.FinishEdit 36275 . 37008) (EQN.MakeEditWindow 
+37010 . 38429) (EQN.SetUpEdit 38431 . 39608) (EQN.StartEdit 39610 . 42911) (EQN.StartNextEdit 42913 . 
+43430) (EQN.UpdateEdit 43432 . 44829) (EQN.DefaultData 44831 . 47516) (EQN.TypeMenu 47518 . 48750)) (
+48819 56727 (EQN.Equation 48829 . 50088) (EQN.NextPiece 50090 . 50815) (EQN.FinishEqn 50817 . 51346) (
+EQN.NoUpdateAbort 51348 . 51761) (EQN.PreventUpdate 51763 . 52198) (EQN.CharFn 52200 . 54285) (
+EQN.TEditSpecialChar 54287 . 55006) (EQN.SnuggleWindows 55008 . 55599) (EQN.SnuggleMainWindow 55601 . 
+56725)) (56781 58520 (EQN.EquationFontNumber 56791 . 57550) (EQN.EquationFont 57552 . 57894) (
+EQN.GetEqnFont 57896 . 58077) (EQN.MakeFS 58079 . 58518)) (58549 61690 (EQN.AdjustWindow 58559 . 60519
+) (EQN.CheckWindowSize 60521 . 61688)) (61691 67455 (EQN.SubEditorP 61701 . 61934) (EQN.WindowFromText
+ 61936 . 62473) (EQN.EditWindow 62475 . 63553) (EQN.ResultWindow 63555 . 64105) (EQN.ResultObj 64107
+ . 64575) (EQN.PieceNumber 64577 . 65126) (EQN.ContinueFlg 65128 . 65691) (EQN.ValidEditWindow 65693
+ . 66127) (EQN.ObjEditWindow 66129 . 67453)) (67456 68573 (EQN.Make 67466 . 68571)) (69805 85740 (
+FS.Box 69815 . 72061) (FS.Copy 72063 . 72703) (FS.Display 72705 . 75691) (FS.Get 75693 . 76162) (
+FS.Put 76164 . 76635) (FS.ItemFont 76637 . 76998) (FS.ItemValue 77000 . 77406) (FS.ItemShift 77408 . 
+77788) (FS.MakeItem 77790 . 78212) (FS.Extract 78214 . 82138) (FS.ExtractFont 82140 . 82743) (
+FS.ExtractShift 82745 . 83308) (FS.Insert 83310 . 85299) (FS.AllowedChar 85301 . 85538) (
+FS.RealStringP 85540 . 85738)))))
 STOP

lispusers/GITFNS

@@ -1,12 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "20-May-2024 22:13:04" {WMEDLEY}<lispusers>GITFNS.;530
 131382 
+
(FILECREATED "12-Jun-2024 23:02:26" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;6
 133403 
 
-      :EDIT-BY rmk
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS GIT-PULL-REQUESTS)
+      :CHANGES-TO (FNS PRC-COMMAND GIT-BRANCH-RELATIONS GIT-BRANCHES GIT-BRANCH-MENU 
+                       GIT-PULL-REQUESTS GIT-PRC-BRANCHES CDGITDIR GIT-COMMAND GITORIGIN 
+                       GIT-RESULT-TO-LINES STRIPLOCAL GIT-WHICH-BRANCH GIT-GET-DIFFERENT-FILES 
+                       GIT-REMOTE-UPDATE GIT-CHECKOUT GIT-MAKE-BRANCH GIT-MY-BRANCHP 
+                       GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES)
 
-      :PREVIOUS-DATE "13-May-2024 19:31:18" {WMEDLEY}<lispusers>GITFNS.;529)
+      :PREVIOUS-DATE "10-Jun-2024 18:43:43" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;5)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
@@ -294,24 +298,24 @@
                                                              (* ; "Edited 13-May-2022 10:40 by rmk")


                                                              (* ; "Edited  9-May-2022 20:02 by rmk")


                                                              (* ; "Edited  8-May-2022 11:38 by rmk")

-    (CL:WHEN (SETQ PROJECT (IF
 (TYPE?
 GIT-PROJECT PROJECT)
-                               THEN
 PROJECT
-                             ELSEIF
 (CDR (ASSOC (OR (U-CASE PROJECT)
+    (CL:WHEN (SETQ PROJECT (if
 (type?
 GIT-PROJECT PROJECT)
+                               then
 PROJECT
+                             elseif
 (CDR (ASSOC (OR (U-CASE PROJECT)
                                                     GIT-DEFAULT-PROJECT)
                                                 GIT-PROJECTS))
-                             ELSEIF
 NOERROR
-                               THEN
 NIL
-                             ELSE
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
+                             elseif
 NOERROR
+                               then
 NIL
+                             else
 (ERROR "NOT A GIT-PROJECT" PROJECT)))
         (SELECTQ FIELD
-            (PROJECTNAME (FETCH
 PROJECTNAME OF
 PROJECT))
-            (WHOST (FETCH
 WHOST OF
 PROJECT))
-            (GITHOST (FETCH
 GITHOST OF
 PROJECT))
-            (EXCLUSIONS (FETCH
 EXCLUSIONS OF
 PROJECT))
+            (PROJECTNAME (fetch
 PROJECTNAME of
 PROJECT))
+            (WHOST (fetch
 WHOST of
 PROJECT))
+            (GITHOST (fetch
 GITHOST of
 PROJECT))
+            (EXCLUSIONS (fetch
 EXCLUSIONS of
 PROJECT))
             (DEFAULTSUBDIRS 
-                 (FETCH
 DEFAULTSUBDIRS OF
 PROJECT))
-            (CLONEPATH (FETCH
 CLONEPATH OF
 PROJECT))
-            (MAINBRANCH [OR (FETCH
 MAINBRANCH OF
 PROJECT)
-                            (REPLACE
 MAINBRANCH OF
 PROJECT WITH
 (OR (GIT-BRANCH-EXISTS?
 'origin/main
+                 (fetch
 DEFAULTSUBDIRS of
 PROJECT))
+            (CLONEPATH (fetch
 CLONEPATH of
 PROJECT))
+            (MAINBRANCH [OR (fetch
 MAINBRANCH of
 PROJECT)
+                            (replace
 MAINBRANCH of
 PROJECT with
 (OR (GIT-BRANCH-EXISTS?
 'origin/main
                                                                            T PROJECT)
                                                                     (GIT-BRANCH-EXISTS?
 
                                                                            'origin/master NIL PROJECT
@@ -543,13 +547,13 @@
     (* ;; "DRAFTS can be DRAFT(S), NODRAFTS, or NIL.  If DRAFTS, then only draft PR's are shown, of NODRAFTS then only nondrafts are shown.  Anything else, both drafts and nondrafts are shown in the menu.")

 
     (LET (PRS MENUWINDOW OLDMENUWINDOW)
-         (IF
 PROJECT
-             THEN
 (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-           ELSEIF
 (GIT-GET-PROJECT
 REMOTEBRANCH NIL T)
-             THEN
 (SETQ PROJECT REMOTEBRANCH)
+         (if
 PROJECT
+             then
 (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
+           elseif
 (GIT-GET-PROJECT
 REMOTEBRANCH NIL T)
+             then
 (SETQ PROJECT REMOTEBRANCH)
                   (SETQ REMOTEBRANCH NIL)
-           ELSEIF
 (GIT-GET-PROJECT
 DRAFTS NIL T)
-             THEN
 (SETQ PROJECT DRAFTS)
+           elseif
 (GIT-GET-PROJECT
 DRAFTS NIL T)
+             then
 (SETQ PROJECT DRAFTS)
                   (SETQ DRAFTS NIL))
          (CL:UNLESS PROJECT (SETQ PROJECT GIT-DEFAULT-PROJECT))
          (SELECTQ (U-CASE REMOTEBRANCH)
@@ -584,8 +588,8 @@
                                          (fetch
 PRLOGIN of
 PR)
                                          ")" T)
                                   NIL) collect
 PR))
-         (IF
 PRS
-             THEN
 (if
 (CDR PRS)
+         (if
 PRS
+             then
 (if
 (CDR PRS)
                       then
 (SETQ MENUWINDOW (ADDMENU (GIT-BRANCH-MENU
 (GIT-PRC-BRANCHES
 DRAFTS 
                                                                              PROJECT PRS)
                                                             (CONCAT (LENGTH PRS)
@@ -602,12 +606,12 @@
                            (CL:WHEN [OPENWP (CDR (SETQ OLDMENUWINDOW (ASSOC PROJECT GIT-PRC-MENUS]
                                (CLOSEW (CDR OLDMENUWINDOW)))
                            (OPENW MENUWINDOW)
-                           (RPLACD [OR OLDMENUWINDOW (CAR (PUSH
 GIT-PRC-MENUS (CONS PROJECT]
+                           (RPLACD [OR OLDMENUWINDOW (CAR (push
 GIT-PRC-MENUS (CONS PROJECT]
                                   MENUWINDOW)
                            MENUWINDOW
                     else
 (GIT-PR-COMPARE
 (fetch
 PRNAME of
 (CAR PRS))
                                 PROJECT))
-           ELSE
 (CONCAT "No open " (OR REMOTEBRANCH "")
+           else
 (CONCAT "No open " (OR REMOTEBRANCH "")
                        " pull requests"])
 )
 
@@ -970,7 +974,8 @@
 
 (GIT-REMOTE-UPDATE

   [LAMBDA (DOIT PROJECT)
-    (DECLARE
 (USEDFREE LAST-REMOTE-UPDATE-IDATE))
            (* ; "Edited  7-May-2022 22:41 by rmk")

+    (DECLARE
 (USEDFREE LAST-REMOTE-UPDATE-IDATE))
            (* ; "Edited 12-Jun-2024 12:57 by mth")


+                                                             (* ; "Edited  7-May-2022 22:41 by rmk")

 
     (* ;; "Because git hangs on this (and other things), do this no more than once a day")

 
@@ -978,7 +983,7 @@
                  (IGREATERP (IDIFFERENCE (IDATE)
                                    LAST-REMOTE-UPDATE-IDATE)
                         (CONSTANT (TIMES 24 60 60 1000]
-        (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH
 PROJECT)
+        (PRINTOUT T "Updating from remote, local branch is " (GIT-WHICH-BRANCH
 PROJECT T)
                T)
         (PROG1 (GIT-COMMAND
 "git remote update origin" NIL PROJECT)
             (SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))])
@@ -1078,6 +1083,8 @@
 (GIT-BRANCH-DIFF

   [LAMBDA (BRANCH1 BRANCH2 PROJECT)
 
+    (* ;; "Edited 10-Jun-2024 16:43 by mth")

+
     (* ;; "Edited  2-May-2024 11:28 by mth")

 
     (* ;; "Edited 29-Sep-2022 10:52 by rmk")

@@ -1117,10 +1124,10 @@
           (SETQ RLINES NIL)
           (CL:WHEN (LISTP RESULTFILE)
               (SETQ ERRORFILE (CADR RESULTFILE))
-              (SETQ ELINES (GIT-RESULT-TO-LINES
 ERRORFILE))
+              (SETQ ELINES (GIT-RESULT-TO-LINES
 ERRORFILE T))
               (DELFILE ERRORFILE)
               (SETQ RESULTFILE (CAR RESULTFILE)))
-          (SETQ RLINES (GIT-RESULT-TO-LINES
 RESULTFILE))
+          (SETQ RLINES (GIT-RESULT-TO-LINES
 RESULTFILE T))
           (DELFILE RESULTFILE)
           (CL:WHEN ELINES
               (if
 [AND (STRPOS "warning: inexact rename detection was skipped due to too many files."
@@ -1141,30 +1148,32 @@
                               (GO RETRY))
                            (ERROR "Incomplete branch differences" (LIST BRANCH1 BRANCH2)))
                 else
 (for
 L in
 ELINES do
 (PRINTOUT T L T))))
-          (RETURN (SORT (for
 L in
 RLINES
+          (RETURN (SORT (for
 (L FN) in
 RLINES
                            collect
 (SELCHARQ (CHCON1 L)
                                         (A (CL:IF (EQ (CHARCODE TAB)
                                                       (NTHCHARCODE L 2))
-                                               (LIST 'ADDED (SUBSTRING L 3))
+                                               (LIST 'ADDED (SETQ FN (SUBSTRING L 3)))
                                                (ERROR "ADDED NOT RECOGNIZED" L)))
                                         (D (CL:IF (EQ (CHARCODE TAB)
                                                       (NTHCHARCODE L 2))
-                                               (LIST 'DELETED (SUBSTRING L 3))
+                                               (LIST 'DELETED (SETQ FN (SUBSTRING L 3)))
                                                (ERROR "DELETED NOT RECOGNIZED" L)))
                                         (M (CL:IF (SETQ POS (STRPOS "	" L))
-                                               (LIST 'CHANGED (SUBSTRING L (ADD1 POS)))
+                                               [LIST 'CHANGED (SETQ FN (SUBSTRING L (ADD1 POS]
                                                (ERROR "CHANGED NOT RECOGNIZED" L)))
                                         (C (if
 (AND (EQ (CHARCODE TAB)
                                                         (NTHCHARCODE L 5))
                                                     (SETQ POS (STRPOS "	" L 7)))
-                                               then
 (LIST 'COPIED (SUBSTRING L 6 (SUB1 POS))
+                                               then
 (LIST 'COPIED (SETQ FN (SUBSTRING L 6
+                                                                                  (SUB1 POS)))
                                                           (OR (FIXP (SUBATOM L 2 4))
                                                               (HELP "C without a number" L)))
                                              else
 (HELP "COPY NOT RECOGNIZED" L)))
                                         (R (if
 (AND (EQ (CHARCODE TAB)
                                                         (NTHCHARCODE L 5))
                                                     (SETQ POS (STRPOS "	" L 7)))
-                                               then
 (LIST 'RENAMED (SUBSTRING L 6 (SUB1 POS))
+                                               then
 (LIST 'RENAMED (SETQ FN (SUBSTRING L 6
+                                                                                   (SUB1 POS)))
                                                           (SUBSTRING L (ADD1 POS))
                                                           (OR (FIXP (SUBATOM L 2 4))
                                                               (HELP "R without a number" L)))
@@ -1175,7 +1184,8 @@
                                                                           " Ignore remaining files? "
                                                                                      )))
                                                   (ERROR!)))
-                                        (HELP "Unrecognized git-diff code " L)))
+                                        (HELP "Unrecognized git-diff code " L))
+                           unless
 (STREQUAL ".git/" (SUBSTRING FN 1 5)))
                         T])
 
 (GIT-COMMIT-DIFFS

@@ -1201,20 +1211,20 @@
      ((MAIN (GIT-MAINBRANCH
 PROJECT)))
      (CL:WHEN STRIPWHERE
          (SETQ MAIN (STRIPWHERE
 MAIN)))
-     (FOR
 DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS

-        ON
 (FOR
 B IN
 BRANCHES COLLECT
 (CL:WHEN STRIPWHERE
+     (for
 DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS

+        on
 (for
 B in
 BRANCHES collect
 (CL:WHEN STRIPWHERE
                                           (SETQ B (STRIPWHERE
 B)))
                                     (CONS B (GIT-COMMIT-DIFFS
 B MAIN PROJECT)))
-        DO
 
+        do
 
            (* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.")

 
            (SETQ D1 (CAR DTAIL))
-           [FOR
 D2 IN
 (CDR DTAIL)
-              DO
 (CL:WHEN (EQUAL (CDR D1)
+           [for
 D2 in
 (CDR DTAIL)
+              do
 (CL:WHEN (EQUAL (CDR D1)
                                  (CDR D2))                   (* ; "Unlikely")

-                     (PUSH
 [CDR (OR (ASSOC (CAR D1)
+                     (push
 [CDR (OR (ASSOC (CAR D1)
                                            EQUALS
)
-                                    (CAR (PUSH
 EQUALS
 (CONS (CAR D1]
+                                    (CAR (push
 EQUALS
 (CONS (CAR D1]
                            (CAR D2))
                      (GO $$ITERATE))
                  (SETQ MORE2 (MEMBER (CADR D1)
@@ -1222,33 +1232,33 @@
 
                                                             "The most recent commit of D1 is in D2")

                  (SETQ MORE1 (MEMBER (CADR D2)
                                     (CDR D1)))
-                 (IF
 MORE2
-                     THEN
 (CL:UNLESS MORE1
-                              (PUSH
 [CDR (OR (ASSOC (CAR D2)
+                 (if
 MORE2
+                     then
 (CL:UNLESS MORE1
+                              (push
 [CDR (OR (ASSOC (CAR D2)
                                                     SUPERSETS)
-                                             (CAR (PUSH
 SUPERSETS (CONS (CAR D2]
+                                             (CAR (push
 SUPERSETS (CONS (CAR D2]
                                     (CAR D1)))
-                   ELSEIF
 MORE1
-                     THEN
 (PUSH
 [CDR (OR (ASSOC (CAR D1)
+                   elseif
 MORE1
+                     then
 (push
 [CDR (OR (ASSOC (CAR D1)
                                                 SUPERSETS)
-                                         (CAR (PUSH
 SUPERSETS (CONS (CAR D1]
+                                         (CAR (push
 SUPERSETS (CONS (CAR D1]
                                 (CAR D2]
-        FINALLY
 
+        finally
 
 
               (* ;; "Sort the supersets so that the larger ones come before the smaller ones")

 
               (CL:WHEN STRIPWHERE
-                  [SETQ SUPERSETS (FOR
 S IN
 SUPERSETS COLLECT
 (FOR
 SS IN
 S COLLECT
 (STRIPWHERE
 SS]
-                  [SETQ EQUALS
 (FOR
 S IN
 EQUALS
 COLLECT
 (FOR
 SS IN
 S COLLECT
 (STRIPWHERE
 SS])
-              [FOR
 S IN
 SUPERSETS
-                 DO
 (CHANGE
 (CDR S)
+                  [SETQ SUPERSETS (for
 S in
 SUPERSETS collect
 (for
 SS in
 S collect
 (STRIPWHERE
 SS]
+                  [SETQ EQUALS
 (for
 S in
 EQUALS
 collect
 (for
 SS in
 S collect
 (STRIPWHERE
 SS])
+              [for
 S in
 SUPERSETS
+                 do
 (change
 (CDR S)
                            (SORT DATUM (FUNCTION (LAMBDA (B1 B2)
                                                    (OR (MEMB B2 (CDR (ASSOC B1 SUPERSETS)))
                                                        (NOT (MEMB B1 (CDR (ASSOC B2 SUPERSETS]
-              [FOR
 E IN
 EQUALS
 DO
 (CHANGE
 (CDR E)
-                                         (IF
 (MEMB MAIN (CDR E))
-                                             THEN
 (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
-                                           ELSE
 (SORT DATUM]
+              [for
 E in
 EQUALS
 do
 (change
 (CDR E)
+                                         (if
 (MEMB MAIN (CDR E))
+                                             then
 (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
+                                           else
 (SORT DATUM]
               (RETURN (LIST SUPERSETS EQUALS
])
 )
 
@@ -1277,14 +1287,15 @@
                                                      0])])
 
 (GIT-CHECKOUT

-  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited  2-May-2024 11:17 by mth")


+  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited 12-Jun-2024 22:44 by mth")


+                                                             (* ; "Edited  2-May-2024 11:17 by mth")


                                                              (* ; "Edited  7-Jul-2022 20:21 by rmk")


                                                              (* ; "Edited  9-May-2022 15:12 by rmk")


                                                              (* ; "Edited  7-May-2022 23:51 by rmk")


                                                             (* ; "Edited  2-Nov-2021 22:40 by rmk:")

     (CL:UNLESS BRANCH
         (SETQ BRANCH (GIT-MAINBRANCH
 PROJECT)))
-    (LET ((CURRENTBRANCH (GIT-WHICH-BRANCH
 PROJECT)))
+    (LET ((CURRENTBRANCH (GIT-WHICH-BRANCH
 PROJECT T)))
          [SETQ CURRENTBRANCH (SUBSTRING CURRENTBRANCH (ADD1 (STRPOS "/" CURRENTBRANCH]
          (CL:UNLESS [STRING.EQUAL CURRENTBRANCH (SUBSTRING BRANCH (ADD1 (OR (STRPOS "/" BRANCH)
                                                                             0]
@@ -1295,14 +1306,16 @@
          BRANCH])
 
 (GIT-WHICH-BRANCH

-  [LAMBDA (PROJECT)
                                          (* ; "Edited  7-May-2022 22:41 by rmk")

+  [LAMBDA (PROJECT ALL)
                                      (* ; "Edited 12-Jun-2024 12:57 by mth")


+                                                             (* ; "Edited  7-May-2022 22:41 by rmk")

 
     (* ;; "Returns the current (local) branch in PROJECT")

 
-    (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND
 "git rev-parse --abbrev-ref HEAD" NIL NIL PROJECT])
+    (MKATOM (CONCAT "local/" (CAR (GIT-COMMAND
 "git rev-parse --abbrev-ref HEAD" ALL NIL PROJECT])
 
 (GIT-MAKE-BRANCH

-  [LAMBDA (NAME TITLESTRING PROJECT)
                         (* ; "Edited  2-May-2024 11:24 by mth")


+  [LAMBDA (NAME TITLESTRING PROJECT)
                         (* ; "Edited 12-Jun-2024 22:47 by mth")


+                                                             (* ; "Edited  2-May-2024 11:24 by mth")


                                                              (* ; "Edited 18-Jul-2022 21:45 by rmk")


                                                              (* ; "Edited 19-May-2022 17:57 by rmk")


                                                              (* ; "Edited  9-May-2022 15:13 by rmk")

@@ -1320,12 +1333,14 @@
 
         (* ;; "Git branch names can't contain spaces or colons")

 
+        (* ;; "mth: Notice that this is only dealing with spaces. There are other %"troublesome%" characters beyond colon, as well.")

+
         [SETQ TITLESTRING (CONCATCODES (for
 I C from
 1 while
 (SETQ C (NTHCHARCODE TITLESTRING I))
                                           collect
 (if
 (EQ C (CHARCODE SPACE))
                                                       then
 (CHARCODE -
)
                                                     else
 C]
         (SETQ NAME (CONCAT NAME "--" TITLESTRING)))
-    (LET ((UNDER (GIT-WHICH-BRANCH
 PROJECT))
+    (LET ((UNDER (GIT-WHICH-BRANCH
 PROJECT T))
           RESULT)
          (if
 (EQ 'Y (ASKUSER NIL 'N (CONCAT "Branch " NAME " will be created under " UNDER 
                                            ". Is that OK? ")))
@@ -1343,7 +1358,8 @@
                 NIL])
 
 (GIT-BRANCHES

-  [LAMBDA (WHERE
 PROJECT EXCLUDEMERGED)
                      (* ; "Edited  2-May-2024 11:26 by mth")


+  [LAMBDA (WHERE
 PROJECT EXCLUDEMERGED)
                      (* ; "Edited 12-Jun-2024 12:46 by mth")


+                                                             (* ; "Edited  2-May-2024 11:26 by mth")


                                                              (* ; "Edited  9-Aug-2022 10:45 by rmk")


                                                              (* ; "Edited 18-Jul-2022 08:11 by rmk")


                                                              (* ; "Edited  8-Jul-2022 10:33 by rmk")


@@ -1357,12 +1373,12 @@
 
     (LET ([LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
                                 '(NIL ALL LOCAL))
-                     [for
 B in
 (GIT-COMMAND
 "git branch" NIL NIL PROJECT)
+                     [for
 B in
 (GIT-COMMAND
 "git branch" T NIL PROJECT)
                         collect
 (SUBATOM B 3 (SUB1 (OR (STRPOS " -> " B)
                                                        0])]
           [REMOTE (CL:WHEN (MEMB (U-CASE WHERE)
                                  '(NIL ALL REMOTE T))
-                      [for
 B in
 (GIT-COMMAND
 "git branch -r" NIL NIL PROJECT)
+                      [for
 B in
 (GIT-COMMAND
 "git branch -r" T NIL PROJECT)
                          collect
 (SUBATOM B 3 (SUB1 (OR (STRPOS " -> " B)
                                                         0])]
           BRANCHES)
@@ -1408,7 +1424,7 @@
     (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
         (CL:WHEN PIN?
             [SETQ BRANCHES (APPEND BRANCHES '(("      Pin menu" 'PinMenu])
-        (CREATE
 MENU
+        (create
 MENU
                TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
                                         " branches"))
                ITEMS _ BRANCHES
@@ -1463,13 +1479,13 @@
            (ERROR "gh must be installed in order to enumerate pull requests:"))
     (LET [(JPARSE (JSON-PARSE (CAR (GIT-COMMAND
 "gh pr list --json number,headRefName,title,isDraft,reviewDecision,url,headRepository,headRepositoryOwner"
                                           T NIL PROJECT]
-         (FOR
 JSOBJ DRAFT PR IN
 (SELECTQ (CAR JPARSE)
+         (for
 JSOBJ DRAFT PR in
 (SELECTQ (CAR JPARSE)
                                     (ARRAY (CDR JPARSE))
                                     (OBJECT JPARSE)
                                     (ERROR "UNRECOGNIZED PRC LIST FROM GIT" JPARSE))
-            EACHTIME
 [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] WHEN
 (OR INCLUDEDRAFTS
+            eachtime
 [SETQ DRAFT (EQ 'true (JSON-GET JSOBJ 'isDraft] when
 (OR INCLUDEDRAFTS
                                                                               (NOT DRAFT))
-            COLLECT
 [SETQ PR (CREATE
 PULLREQUEST
+            collect
 [SETQ PR (create
 PULLREQUEST
                                     PRNUMBER _ (JSON-GET JSOBJ 'number)
                                     PRNAME _ (JSON-GET JSOBJ 'headRefName)
                                     PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
@@ -1529,28 +1545,28 @@
     (CL:UNLESS PRS
         (SETQ PRS (GIT-PULL-REQUESTS
 T PROJECT)))
     (CL:WHEN PRS
-        (LET ((RELATIONS (GIT-BRANCH-RELATIONS
 (FOR
 PR IN
 PRS
-                                                  COLLECT
 (GITORIGIN
 (fetch
 PRNAME of
 PR)))
+        (LET ((RELATIONS (GIT-BRANCH-RELATIONS
 (for
 PR in
 PRS
+                                                  collect
 (GITORIGIN
 (fetch
 PRNAME of
 PR)))
                                 NIL T PROJECT)))
-             (SORT (FOR
 PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
-                        (EQUALS _ (CADR RELATIONS)) IN
 PRS
-                      EACHTIME
 (SETQ PRNAME (fetch
 PRNAME of
 PR))
+             (SORT (for
 PR REL LABEL PRNAME STATUS (SUPERSETS _ (CAR RELATIONS))
+                        (EQUALS _ (CADR RELATIONS)) in
 PRS
+                      eachtime
 (SETQ PRNAME (fetch
 PRNAME of
 PR))
                             (SETQ LABEL (CONCAT "#" (fetch
 (PULLREQUEST PRNUMBER) of
 PR)
                                                " "
-                                               (IF
 [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
-                                                   THEN
 (CONCAT PRNAME " > " REL)
-                                                 ELSEIF
 [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS
]
-                                                   THEN
 (CONCAT PRNAME " = " REL)
-                                                 ELSE
 PRNAME)))
-                            (SETQ STATUS (FETCH
 PRSTATUS OF
 PR))
-                      WHEN
 (SELECTQ DRAFT
+                                               (if
 [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
+                                                   then
 (CONCAT PRNAME " > " REL)
+                                                 elseif
 [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS
]
+                                                   then
 (CONCAT PRNAME " = " REL)
+                                                 else
 PRNAME)))
+                            (SETQ STATUS (fetch
 PRSTATUS of
 PR))
+                      when
 (SELECTQ DRAFT
                                (DRAFTS (EQ STATUS 'D))
                                (NODRAFTS (NEQ STATUS 'D))
-                               T) COLLECT
 (LIST (CONCAT " " STATUS " " LABEL)
+                               T) collect
 (LIST (CONCAT " " STATUS " " LABEL)
                                                 (GITORIGIN
 PRNAME)
-                                                (CONCAT " " STATUS " #" (FETCH
 PRNUMBER OF
 PR)
+                                                (CONCAT " " STATUS " #" (fetch
 PRNUMBER of
 PR)
                                                        " "
-                                                       (FETCH
 PRDESCRIPTION OF
 PR))
+                                                       (fetch
 PRDESCRIPTION of
 PR))
                                                 NIL PR))
                    T)))])
 )
@@ -1569,14 +1585,15 @@
                                                               0])
 
 (GIT-MY-BRANCHP

-  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited 19-May-2022 17:44 by rmk")


+  [LAMBDA (BRANCH PROJECT)
                                   (* ; "Edited 12-Jun-2024 22:48 by mth")


+                                                             (* ; "Edited 19-May-2022 17:44 by rmk")


                                                              (* ; "Edited 19-Jan-2022 13:22 by rmk")

 
     (* ;; "Returns n if BRANCH is INITIALSn (local or origin), possibly followed by a trailing comment after hyphen.")

 
     (CL:UNLESS BRANCH
-        (SETQ BRANCH (GIT-WHICH-BRANCH
 PROJECT)))
-    (GIT-BRANCH-NUM
 (OR BRANCH (GIT-WHICH-BRANCH
 PROJECT])
+        (SETQ BRANCH (GIT-WHICH-BRANCH
 PROJECT T)))
+    (GIT-BRANCH-NUM
 (OR BRANCH (GIT-WHICH-BRANCH
 PROJECT T])
 
 (GIT-MY-NEXT-BRANCH

   [LAMBDA (PROJECT)
                                          (* ; "Edited 19-May-2022 14:08 by rmk")


@@ -1726,9 +1743,9 @@
     (LET
      (MAPPINGS FROMGIT (DIFFS (GIT-BRANCH-DIFF
 BRANCH1 BRANCH2 PROJECT)))
      (CL:WHEN DIFFS
-         (SETQ FROMGIT (PACK* '{FROMGIT (ADD
 FROMGITN 1)
+         (SETQ FROMGIT (PACK* '{FROMGIT (add
 FROMGITN 1)
                               '}))
-         (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (FETCH
 PROJECTNAME OF
 PROJECT)
+         (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (fetch
 PROJECTNAME of
 PROJECT)
                                     ">"
                                     (DATE)
                                     ">"))
@@ -1741,8 +1758,8 @@
          (CL:UNLESS DIR2
              (SETQ DIR2 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH2)
                                ">")))
-         (FOR
 D IN
 DIFFS
-            DO
 (SELECTQ (CAR D)
+         (for
 D in
 DIFFS
+            do
 (SELECTQ (CAR D)
                    (ADDED                                    (* ; 
 
     "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?")

                           (SETQ D (CADR D))
@@ -1789,14 +1806,14 @@
 
                              (* ;; "Let the directories figure it out")

 
-                             (AND NIL (IF
 (EQ (CADDR GFILE)
+                             (AND NIL (if
 (EQ (CADDR GFILE)
                                               100)
-                                          THEN
 
+                                          then
 
 
                                  (* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to.  Maybe the first one should always be one that exists, the second may just be a useful name.  But we have to know whether to match against INFO1 or INFO2")

 
                                                (HELP GFILE 100)
-                                               (PUSH
 MAPPINGS
+                                               (push
 MAPPINGS
                                                      (LIST (LIST)
                                                            (FULLNAME F1)
                                                            (SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE))
@@ -1805,7 +1822,7 @@
                                                            (NTHCHAR (CAR D)
                                                                   1)
                                                            100))
-                                        ELSE
 
+                                        else
 
                                              (* ;; 
 
                                    "If not a perfect match, then the directory should figure it out")

 
@@ -1816,7 +1833,9 @@
          (LIST DIR1 DIR2 MAPPINGS))])
 
 (GIT-BRANCHES-COMPARE-DIRECTORIES

-  [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT)
                    (* ; "Edited  1-May-2024 14:58 by rmk")


+  [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT)
                    (* ; "Edited 12-Jun-2024 22:52 by mth")


+                                                             (* ; "Edited 10-Jun-2024 18:42 by mth")


+                                                             (* ; "Edited  1-May-2024 14:58 by rmk")


                                                              (* ; "Edited 26-Sep-2023 22:40 by rmk")


                                                              (* ; "Edited 10-Jun-2023 17:28 by rmk")


                                                              (* ; "Edited 12-Sep-2022 14:41 by rmk")


@@ -1825,23 +1844,26 @@
                                                              (* ; "Edited  9-May-2022 15:14 by rmk")


                                                              (* ; "Edited  3-May-2022 23:04 by rmk")

     (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
-    (SETQ BRANCH1 (IF
 BRANCH1
-                      THEN
 (GITORIGIN
 BRANCH1 LOCAL)
-                    ELSE
 (GIT-WHICH-BRANCH
 PROJECT)))
+    (SETQ BRANCH1 (if
 BRANCH1
+                      then
 (GITORIGIN
 BRANCH1 LOCAL)
+                    else
 (GIT-WHICH-BRANCH
 PROJECT T)))
     (LET (CDVALUE DIRS NENTRIES MAPPINGS (SHORT1 (GIT-SHORT-BRANCH-NAME
 BRANCH1))
                 (SHORT2 (GIT-SHORT-BRANCH-NAME
 BRANCH2)))
-         (PRINTOUT T "Comparing all " (L-CASE (FETCH
 PROJECTNAME OF
 PROJECT)
+         (PRINTOUT T "Comparing all " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                              T)
                 " subdirectories of " SHORT1 " and " SHORT2 T)
          (PRINTOUT T "Fetching differences" T)
          (SETQ DIRS (GIT-GET-DIFFERENT-FILES
 BRANCH1 BRANCH2 NIL NIL PROJECT))
          (SETQ MAPPINGS (CADDR DIRS))
-         (IF
 DIRS
-             THEN
 (TERPRI T)
+         (if
 DIRS
+             then
 (TERPRI T) 
+
+                  (* ;; "INCLUDEDFILES parameter to COMPAREDIRECTORIES needs to allow both top-level files, and leading dot filenames.")

+
                   [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
                                        (CADR DIRS)
                                        '(> < ~= -* *-)
-                                       '*>*.*
+                                       '(*.* *>*.* .* *>.*)
                                        (GIT-GET-PROJECT
 PROJECT 'EXCLUSIONS)
                                        NIL NIL NIL NIL (LIST (PACKFILENAME 'HOST NIL 'BODY
                                                                     (CAR DIRS))
@@ -1857,30 +1879,30 @@
                          (FUNCTION (LAMBDA (CDE)
                                      (DECLARE
 (USEDFREE INFO1 INFO2))
                                      (LET [(MAP (CL:UNLESS INFO2
-                                                    (FIND
 M IN
 MAPPINGS
-                                                       SUCHTHAT
 (STRING.EQUAL (CAR M)
-                                                                       (FETCH
 (CDINFO FULLNAME)
-                                                                          OF
 INFO1)
+                                                    (find
 M in
 MAPPINGS
+                                                       suchthat
 (STRING.EQUAL (CAR M)
+                                                                       (fetch
 (CDINFO FULLNAME)
+                                                                          of
 INFO1)
                                                                        FILEDIRCASEARRAY)))]
                                           (CL:WHEN MAP
                                               (HELP 'MAP MAP))
                                           (CL:WHEN INFO1
-                                              (CHANGE
 (FETCH
 (CDINFO FULLNAME) OF
 INFO1)
+                                              (change
 (fetch
 (CDINFO FULLNAME) of
 INFO1)
                                                      (SLASHIT (PACKFILENAME.STRING 'VERSION NIL
                                                                      'BODY DATUM)
                                                             T)))
                                           (CL:WHEN INFO2
-                                              (CHANGE
 (FETCH
 (CDINFO FULLNAME) OF
 INFO2)
+                                              (change
 (fetch
 (CDINFO FULLNAME) of
 INFO2)
                                                      (SLASHIT (PACKFILENAME.STRING 'VERSION NIL
                                                                      'BODY DATUM)
                                                             T)))
-                                          (IF
 MAP
-                                              THEN
 
+                                          (if
 MAP
+                                              then
 
 
                                  (* ;; "This handles renames and copies.  We want the nominal source of a rename to be in the first column, even though the target location is the one that was fetched.")

 
-                                                   (REPLACE
 (CDENTRY INFO2) OF
 CDE
-                                                      WITH
 (CREATE
 CDINFO
+                                                   (replace
 (CDENTRY INFO2) of
 CDE
+                                                      with
 (create
 CDINFO
                                                                   FULLNAME _ (CADR MAP)
                                                                   DATE _ (CL:IF (EQ 'R (CADDR MAP))
                                                                              " <-"
@@ -1889,31 +1911,33 @@
                                                                   AUTHOR _ ""
                                                                   TYPE _ ""
                                                                   EOL _ ""))
-                                                   (REPLACE
 (CDENTRY DATEREL) OF
 CDE
-                                                      WITH
 (CADDR MAP]
+                                                   (replace
 (CDENTRY DATEREL) of
 CDE
+                                                      with
 (CADDR MAP]
                   (TERPRI T)
-                  (IF
 (FETCH
 (CDVALUE CDENTRIES) OF
 CDVALUE)
-                      THEN
 (SETQ LAST-BRANCH-CDVALUE CDVALUE)
-                           (CDBROWSER CDVALUE (CONCAT (L-CASE (FETCH
 PROJECTNAME OF
 PROJECT)
+                  (if
 (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE)
+                      then
 (SETQ LAST-BRANCH-CDVALUE CDVALUE)
+                           (CDBROWSER CDVALUE (CONCAT (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                                              T)
                                                      " " SHORT1 "  vs  " SHORT2 "      "
-                                                     (LENGTH (FETCH
 (CDVALUE CDENTRIES) OF
 CDVALUE))
+                                                     (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE))
                                                      " files")
                                   (LIST SHORT1 SHORT2)
                                   `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
                                           ,PROJECT)
                                   GIT-CDBROWSER-SEPARATE-DIRECTIONS
                                   `(Compare See))
-                           (SETQ NENTRIES (LENGTH (FETCH
 (CDVALUE CDENTRIES) OF
 CDVALUE)))
+                           (SETQ NENTRIES (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVALUE)))
                            (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
                                               'difference
                                               'differences))
-                    ELSE
 '(0 differences))
-           ELSE
 '(0 differences])
+                    else
 '(0 differences))
+           else
 '(0 differences])
 
 (GIT-WORKING-COMPARE-DIRECTORIES

   [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
 
+    (* ;; "Edited 12-Jun-2024 22:52 by mth")

+
     (* ;; "Edited 26-Sep-2023 22:41 by rmk")

 
     (* ;; "Edited 17-Jun-2023 22:54 by rmk")

@@ -1933,28 +1957,28 @@
 
     (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
     (CL:WHEN UPDATE (GIT-REMOTE-UPDATE
 NIL PROJECT))         (* ; "Doesn't matter if we are looking only at local files in the current branch.  We aren't fetching or checking out.")

-    (CL:UNLESS (AND (FETCH
 GITHOST OF
 PROJECT)
-                    (FETCH
 WHOST OF
 PROJECT))
-        (ERROR (FETCH
 PROJECTNAME OF
 PROJECT)
+    (CL:UNLESS (AND (fetch
 GITHOST of
 PROJECT)
+                    (fetch
 WHOST of
 PROJECT))
+        (ERROR (fetch
 PROJECTNAME of
 PROJECT)
                " does not have both git and working directories"))
     (CL:WHEN (AND (LISTP SUBDIRS)
                   (NULL (CDR SUBDIRS)))
         (SETQ SUBDIRS (CAR SUBDIRS)))
     (CL:UNLESS SUBDIRS
-        (SETQ SUBDIRS (OR (FETCH
 DEFAULTSUBDIRS OF
 PROJECT)
+        (SETQ SUBDIRS (OR (fetch
 DEFAULTSUBDIRS of
 PROJECT)
                           'ALL)))
     (SETQ SUBDIRS (L-CASE SUBDIRS))
-    (LET ((SUBDIRSTRING (IF
 (EQ SUBDIRS 'all)
-                            THEN
 (SETQ SUBDIRS (ALLSUBDIRS
 PROJECT))
+    (LET ((SUBDIRSTRING (if
 (EQ SUBDIRS 'all)
+                            then
 (SETQ SUBDIRS (ALLSUBDIRS
 PROJECT))
                                  "ALL subdirectories"
-                          ELSE
 SUBDIRS)))
-         (FOR
 SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (FETCH
 PROJECTNAME OF
 PROJECT)
+                          else
 SUBDIRS)))
+         (for
 SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch
 PROJECTNAME of
 PROJECT)
                                                                     T)))
               (NENTRIES _ 0)
-              (BRANCH2 _ (GIT-WHICH-BRANCH
 PROJECT))
-            FIRST
 (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
-                  (BKSYSBUF " ") INSIDE
 SUBDIRS
-            COLLECT
 (TERPRI T)
+              (BRANCH2 _ (GIT-WHICH-BRANCH
 PROJECT T))
+            first
 (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
+                  (BKSYSBUF " ") inside
 SUBDIRS
+            collect
 (TERPRI T)
                   (SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR
 SUBDIR T PROJECT)
                                      (GITSUBDIR
 SUBDIR T PROJECT)
                                      (OR SELECT '(> < ~= -* *-))
@@ -1967,24 +1991,24 @@
                                                   (SUBSTRING E (ADD1 DPOS))
                                                   E))
                                      NIL NIL NIL FIXDIRECTORYDATES))
-                  [FOR
 CDE IN
 (FETCH
 CDENTRIES OF
 CDVAL)
-                     DO
 (CL:WHEN (FETCH
 INFO1 OF
 CDE)
-                            (CHANGE
 (FETCH
 (CDINFO FULLNAME) OF
 (FETCH
 INFO1 OF
 CDE))
+                  [for
 CDE in
 (fetch
 CDENTRIES of
 CDVAL)
+                     do
 (CL:WHEN (fetch
 INFO1 of
 CDE)
+                            (change
 (fetch
 (CDINFO FULLNAME) of
 (fetch
 INFO1 of
 CDE))
                                    (UNSLASHIT DATUM T)))
-                        (CL:WHEN (FETCH
 INFO2 OF
 CDE)
-                            (CHANGE
 (FETCH
 (CDINFO FULLNAME) OF
 (FETCH
 INFO2 OF
 CDE))
+                        (CL:WHEN (fetch
 INFO2 of
 CDE)
+                            (change
 (fetch
 (CDINFO FULLNAME) of
 (fetch
 INFO2 of
 CDE))
                                    (SLASHIT DATUM T)))]
                   CDVAL
-            FINALLY
 
+            finally
 
 
                   (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.")

 
                   (CL:WHEN (AND (CDR $$VAL)
                                 GIT-MERGE-COMPARES)
                       (SETQ $$VAL (CDMERGE $$VAL))
-                      [SETQ SUBDIRS (CONCATLIST (FOR
 SUBDIR IN
 SUBDIRS COLLECT
 (CONCAT SUBDIR "  "])
-                  [FOR
 CDVAL TITLE IN
 $$VAL AS
 SUBDIR INSIDE
 SUBDIRS
-                     DO
 (SETQ TITLE (CONCAT WPROJ "  vs.   " BRANCH2 "      " SUBDIR "         "
+                      [SETQ SUBDIRS (CONCATLIST (for
 SUBDIR in
 SUBDIRS collect
 (CONCAT SUBDIR "  "])
+                  [for
 CDVAL TITLE in
 $$VAL as
 SUBDIR inside
 SUBDIRS
+                     do
 (SETQ TITLE (CONCAT WPROJ "  vs.   " BRANCH2 "      " SUBDIR "         "
                                            (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVAL))
                                            " files"))
                         [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
@@ -1995,9 +2019,9 @@
                                        ,@(CL:UNLESS (GIT-MAINBRANCH?
 BRANCH2 PROJECT T)
                                              '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))]
                         (CONS (CONCAT SUBDIR "/")
-                              (FOR
 CDENTRY IN
 (fetch
 CDENTRIES of
 CDVAL)
-                                 COLLECT
 (fetch
 MATCHNAME of
 CDENTRY)))
-                        (ADD
 NENTRIES (LENGTH (FETCH
 (CDVALUE CDENTRIES) OF
 CDVAL]
+                              (for
 CDENTRY in
 (fetch
 CDENTRIES of
 CDVAL)
+                                 collect
 (fetch
 MATCHNAME of
 CDENTRY)))
+                        (add
 NENTRIES (LENGTH (fetch
 (CDVALUE CDENTRIES) of
 CDVAL]
                   (SETQ LAST-WMEDLEY-CDVALUES $$VAL)
                   (TERPRI T)
                   (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
@@ -2264,7 +2288,7 @@
                                                              (* ; "Edited  7-Jul-2022 09:36 by rmk")


                                                              (* ; "Edited  7-May-2022 22:41 by rmk")


                                                             (* ; "Edited  2-Nov-2021 21:12 by rmk:")

-    (CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH
 GITHOST OF
 PROJECT))
+    (CONCAT "cd " (SLASHIT (TRUEFILENAME (fetch
 GITHOST of
 PROJECT))
                          NIL T)
            " && "])
 
@@ -2280,8 +2304,8 @@
     (CL:UNLESS (OR (EQ 1 (STRPOS "git" CMD))
                    (EQ 1 (STRPOS "gh" CMD)))
         (SETQ CMD (CONCAT "git " CMD)))
-    [BIND
 LPOS WHILE
 (SETQ LPOS (STRPOS "local/" CMD))
-       DO
 (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS))
+    [bind
 LPOS while
 (SETQ LPOS (STRPOS "local/" CMD))
+       do
 (SETQ CMD (CONCAT (SUBSTRING CMD 1 (SUB1 LPOS))
                            (SUBSTRING CMD (IPLUS LPOS (NCHARS "local/"]
     (LET (LINES (RESULTFILE (GIT-COMMAND-TO-FILE
 CMD PROJECT NOERROR)))
          (CL:WHEN (LISTP RESULTFILE)                         (* ; "CADR is Unix error stream")

@@ -2303,10 +2327,10 @@
     (* ;; "Insures origin/ unless LOCAL or local/ already")

 
     (CL:UNLESS BRANCH (HELP "BRANCH MUST BE SPECIFIED"))
-    (IF
 (OR (STRPOS "origin/" BRANCH)
+    (if
 (OR (STRPOS "origin/" BRANCH)
             (STRPOS "local/" BRANCH))
-        THEN
 BRANCH
-      ELSE
 (CONCAT (CL:IF LOCAL
+        then
 BRANCH
+      else
 (CONCAT (CL:IF LOCAL
                        "local/"
                        "origin/")
                   BRANCH])
@@ -2338,7 +2362,7 @@
            (RESULTFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-result"))
            (ERRORFILE (CONCAT "{UNIX}/tmp/" PROJECTNAME "-" DATE "-" RAND "-error"))
            COMPLETIONCODE)
-          [SETQ COMPLETIONCODE (PROCESS-COMMAND
 (CONCAT (CDGITDIR
 PROJECT)
+          [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCAT (CDGITDIR
 PROJECT)
                                                        CMD " > " (STRIPHOST
 RESULTFILE)
                                                        " 2> "
                                                        (STRIPHOST
 ERRORFILE]
@@ -2365,12 +2389,12 @@
                                             (FILEPOS "unknown command %"" ESTREAM 0 1)))
                                   (FILEPOS "' is not a git command." ESTREAM (NCHARS CMD)))
                             (SETQ COMPLETIONCODE 1))))
-          (IF
 (EQ 0 COMPLETIONCODE)
-              THEN
 (IF
 (AND RESULTFILE ERRORFILE)
-                       THEN
 (LIST RESULTFILE ERRORFILE)
-                     ELSEIF
 RESULTFILE
-                     ELSE
 ERRORFILE)
-            ELSE
 (DELFILE RESULTFILE)
+          (if
 (EQ 0 COMPLETIONCODE)
+              then
 (if
 (AND RESULTFILE ERRORFILE)
+                       then
 (LIST RESULTFILE ERRORFILE)
+                     elseif
 RESULTFILE
+                     else
 ERRORFILE)
+            else
 (DELFILE RESULTFILE)
                  (DELFILE ERRORFILE)
                  (CL:UNLESS NOERROR
                      (ERROR (CONCAT "Command failed: " CMD)))
@@ -2382,18 +2406,18 @@
     (* ;; "Suppress .git lines unless ALL")

 
     (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT (SYSTEM-EXTERNALFORMAT))
-           (BIND
 LINE UNTIL
 (EOFP STREAM) WHEN
 [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P 
+           (bind
 LINE until
 (EOFP STREAM) when
 [PROGN (SETQ LINE (CL:READ-LINE STREAM :EOF-ERROR-P 
                                                                         NIL :EOF-VALUE NIL))
                                                       (OR ALL (NOT (STRPOS ".git" LINE 1]
-              COLLECT
 LINE])
+              collect
 LINE])
 
 (STRIPLOCAL

   [LAMBDA (STRING)
                                           (* ; "Edited 18-Jul-2022 09:52 by rmk")

 
     (* ;; "Removes local/ substrings wherever they appear.  To be used in coerecing from a lisp internal convention that local branches carry a local tag to the git convention that an unqualified name is local.")

 
-    [BIND
 POS WHILE
 (SETQ POS (STRPOS "local/" STRING))
-       DO
 (SETQ STRING (CONCAT (SUBSTRING STRING 1 (SUB1 POS))
+    [bind
 POS while
 (SETQ POS (STRPOS "local/" STRING))
+       do
 (SETQ STRING (CONCAT (SUBSTRING STRING 1 (SUB1 POS))
                               (OR (SUBSTRING STRING (IPLUS POS (CONSTANT (NCHARS "local/")))
                                          -1)
                                   ""]
@@ -2402,33 +2426,33 @@
 
 (PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4187 20766 (GIT-CLONEP 4197 . 5525) (GIT-INIT 5527 . 6157) (GIT-MAKE-PROJECT 6159 . 
-13824) (GIT-GET-PROJECT 13826 . 15751) (GIT-PUT-PROJECT-FIELD 15753 . 17394) (GIT-PROJECT-PATH 17396
- . 18440) (FIND-ANCESTOR-DIRECTORY 18442 . 18791) (GIT-FIND-CLONE 18793 . 19874) (GIT-MAINBRANCH 19876
- . 20271) (GIT-MAINBRANCH? 20273 . 20764)) (26229 30851 (PRC-COMMAND 26239 . 30849)) (30907 33695 (
-ALLSUBDIRS 30917 . 32203) (MEDLEYSUBDIRS 32205 . 32898) (GITSUBDIRS 32900 . 33693)) (33696 38486 (
-TOGIT 33706 . 35112) (FROMGIT 35114 . 36095) (GIT-DELETE-FILE 36097 . 36943) (MYMEDLEY-DELETE-FILES 
-36945 . 38484)) (38487 41490 (MYMEDLEYSUBDIR 38497 . 38953) (GITSUBDIR 38955 . 39398) (STRIPDIR 39400
- . 39771) (STRIPHOST 39773 . 40013) (STRIPNAME 40015 . 40768) (STRIPWHERE 40770 . 41488)) (41491 43393
- (GFILE4MFILE 41501 . 41864) (MFILE4GFILE 41866 . 42435) (GIT-REPO-FILENAME 42437 . 43391)) (43442 
-53693 (GIT-COMMIT 43452 . 44278) (GIT-PUSH 44280 . 45040) (GIT-PULL 45042 . 45794) (GIT-APPROVAL 45796
- . 46145) (GIT-GET-FILE 46147 . 48169) (GIT-FILE-EXISTS? 48171 . 48445) (GIT-REMOTE-UPDATE 48447 . 
-49171) (GIT-REMOTE-ADD 49173 . 49480) (GIT-FILE-DATE 49482 . 50529) (GIT-FILE-HISTORY 50531 . 52465) (
-GIT-PRINT-FILE-HISTORY 52467 . 53517) (GIT-FETCH 53519 . 53691)) (53723 64496 (GIT-BRANCH-DIFF 53733
- . 60133) (GIT-COMMIT-DIFFS 60135 . 60808) (GIT-BRANCH-RELATIONS 60810 . 64494)) (64541 82978 (
-GIT-BRANCH-NUM 64551 . 65124) (GIT-CHECKOUT 65126 . 66301) (GIT-WHICH-BRANCH 66303 . 66601) (
-GIT-MAKE-BRANCH 66603 . 68932) (GIT-BRANCHES 68934 . 71424) (GIT-BRANCH-EXISTS? 71426 . 72297) (
-GIT-PICK-BRANCH 72299 . 72789) (GIT-BRANCH-MENU 72791 . 73672) (GIT-BRANCH-WHENSELECTEDFN 73674 . 
-75839) (GIT-PULL-REQUESTS 75841 . 79359) (GIT-SHORT-BRANCH-NAME 79361 . 79652) (GIT-LONG-NAME 79654 . 
-79971) (GIT-PRC-BRANCHES 79973 . 82976)) (83008 86343 (GIT-MY-CURRENT-BRANCH 83018 . 83388) (
-GIT-MY-BRANCHP 83390 . 83895) (GIT-MY-NEXT-BRANCH 83897 . 84391) (GIT-MY-BRANCHES 84393 . 86341)) (
-86389 90464 (GIT-ADD-WORKTREE 86399 . 88006) (GIT-REMOVE-WORKTREE 88008 . 88938) (GIT-LIST-WORKTREES 
-88940 . 89744) (WORKTREEDIR 89746 . 90462)) (90512 123216 (GIT-GET-DIFFERENT-FILES 90522 . 96946) (
-GIT-BRANCHES-COMPARE-DIRECTORIES 96948 . 103801) (GIT-WORKING-COMPARE-DIRECTORIES 103803 . 109199) (
-GIT-COMPARE-WORKTREE 109201 . 113179) (GITCDOBJBUTTONFN 113181 . 117671) (GIT-CD-LABELFN 117673 . 
-118755) (GIT-CD-MENUFN 118757 . 121197) (GIT-WORKING-COMPARE-FILES 121199 . 121819) (
-GIT-BRANCHES-COMPARE-FILES 121821 . 122985) (GIT-PR-COMPARE 122987 . 123214)) (123286 131315 (CDGITDIR
- 123296 . 123983) (GIT-COMMAND 123985 . 125543) (GITORIGIN 125545 . 126242) (GIT-INITIALS 126244 . 
-126548) (GIT-COMMAND-TO-FILE 126550 . 130039) (GIT-RESULT-TO-LINES 130041 . 130648) (STRIPLOCAL 130650
- . 131313)))))
+  (FILEMAP (NIL (4636 21215 (GIT-CLONEP 4646 . 5974) (GIT-INIT 5976 . 6606) (GIT-MAKE-PROJECT 6608 . 
+14273) (GIT-GET-PROJECT 14275 . 16200) (GIT-PUT-PROJECT-FIELD 16202 . 17843) (GIT-PROJECT-PATH 17845
+ . 18889) (FIND-ANCESTOR-DIRECTORY 18891 . 19240) (GIT-FIND-CLONE 19242 . 20323) (GIT-MAINBRANCH 20325
+ . 20720) (GIT-MAINBRANCH? 20722 . 21213)) (26678 31300 (PRC-COMMAND 26688 . 31298)) (31356 34144 (
+ALLSUBDIRS 31366 . 32652) (MEDLEYSUBDIRS 32654 . 33347) (GITSUBDIRS 33349 . 34142)) (34145 38935 (
+TOGIT 34155 . 35561) (FROMGIT 35563 . 36544) (GIT-DELETE-FILE 36546 . 37392) (MYMEDLEY-DELETE-FILES 
+37394 . 38933)) (38936 41939 (MYMEDLEYSUBDIR 38946 . 39402) (GITSUBDIR 39404 . 39847) (STRIPDIR 39849
+ . 40220) (STRIPHOST 40222 . 40462) (STRIPNAME 40464 . 41217) (STRIPWHERE 41219 . 41937)) (41940 43842
+ (GFILE4MFILE 41950 . 42313) (MFILE4GFILE 42315 . 42884) (GIT-REPO-FILENAME 42886 . 43840)) (43891 
+54253 (GIT-COMMIT 43901 . 44727) (GIT-PUSH 44729 . 45489) (GIT-PULL 45491 . 46243) (GIT-APPROVAL 46245
+ . 46594) (GIT-GET-FILE 46596 . 48618) (GIT-FILE-EXISTS? 48620 . 48894) (GIT-REMOTE-UPDATE 48896 . 
+49731) (GIT-REMOTE-ADD 49733 . 50040) (GIT-FILE-DATE 50042 . 51089) (GIT-FILE-HISTORY 51091 . 53025) (
+GIT-PRINT-FILE-HISTORY 53027 . 54077) (GIT-FETCH 54079 . 54251)) (54283 65403 (GIT-BRANCH-DIFF 54293
+ . 61040) (GIT-COMMIT-DIFFS 61042 . 61715) (GIT-BRANCH-RELATIONS 61717 . 65401)) (65448 84460 (
+GIT-BRANCH-NUM 65458 . 66031) (GIT-CHECKOUT 66033 . 67319) (GIT-WHICH-BRANCH 67321 . 67728) (
+GIT-MAKE-BRANCH 67730 . 70309) (GIT-BRANCHES 70311 . 72906) (GIT-BRANCH-EXISTS? 72908 . 73779) (
+GIT-PICK-BRANCH 73781 . 74271) (GIT-BRANCH-MENU 74273 . 75154) (GIT-BRANCH-WHENSELECTEDFN 75156 . 
+77321) (GIT-PULL-REQUESTS 77323 . 80841) (GIT-SHORT-BRANCH-NAME 80843 . 81134) (GIT-LONG-NAME 81136 . 
+81453) (GIT-PRC-BRANCHES 81455 . 84458)) (84490 87938 (GIT-MY-CURRENT-BRANCH 84500 . 84870) (
+GIT-MY-BRANCHP 84872 . 85490) (GIT-MY-NEXT-BRANCH 85492 . 85986) (GIT-MY-BRANCHES 85988 . 87936)) (
+87984 92059 (GIT-ADD-WORKTREE 87994 . 89601) (GIT-REMOVE-WORKTREE 89603 . 90533) (GIT-LIST-WORKTREES 
+90535 . 91339) (WORKTREEDIR 91341 . 92057)) (92107 125241 (GIT-GET-DIFFERENT-FILES 92117 . 98541) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 98543 . 105774) (GIT-WORKING-COMPARE-DIRECTORIES 105776 . 111224) (
+GIT-COMPARE-WORKTREE 111226 . 115204) (GITCDOBJBUTTONFN 115206 . 119696) (GIT-CD-LABELFN 119698 . 
+120780) (GIT-CD-MENUFN 120782 . 123222) (GIT-WORKING-COMPARE-FILES 123224 . 123844) (
+GIT-BRANCHES-COMPARE-FILES 123846 . 125010) (GIT-PR-COMPARE 125012 . 125239)) (125311 133336 (CDGITDIR
+ 125321 . 126008) (GIT-COMMAND 126010 . 127568) (GITORIGIN 127570 . 128267) (GIT-INITIALS 128269 . 
+128573) (GIT-COMMAND-TO-FILE 128575 . 132060) (GIT-RESULT-TO-LINES 132062 . 132669) (STRIPLOCAL 132671
+ . 133334)))))
 STOP

lispusers/GREP

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31
 6115   
+
(FILECREATED "10-Sep-2024 12:54:27" {WMEDLEY}<lispusers>GREP.;34
 6309   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS DOGREP)
+      :CHANGES-TO (FNS TGREP)
 
-      :PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}<lispusers>GREP.;29)
+      :PREVIOUS-DATE "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31)
 
 
 (PRETTYCOMPRINT GREPCOMS)
@@ -115,9 +115,15 @@
         OUTSTREAM)])
 
 (TGREP

-  [LAMBDA (STRS FILES)
                                       (* ; "Edited 20-Jan-2024 14:14 by rmk")

-    (TEXTSTREAM (TEDIT (GREP
 STRS FILES (OPENTEXTSTREAM))
-                       'TGREP NIL '(READONLY T])
+  [LAMBDA (STRS FILES DONTDEFER)
                             (* ; "Edited 10-Sep-2024 12:54 by rmk")

+
+    (* ;; "TSTREAM to return the text stream")

+
                                                             (* ; "Edited 20-Jan-2024 14:14 by rmk")

+    (TEVAL (PROGN (GREP
 STRS FILES)
+                  TSTREAM)
+           'TGREP
+           `(TGREP
 ,STRS ,FILES)
+           DONTDEFER])
 )
 
 (MOVD? 'NILL 'TEDIT.FORMATTEDFILEP)
@@ -130,6 +136,6 @@
 
 (RPAQ? PHONELISTFILES
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE 
-5878 . 6061)))))
+  (FILEMAP (NIL (495 6024 (DOGREP 505 . 4543) (GREP 4545 . 5595) (TGREP 5597 . 6022)) (6062 6257 (PHONE 
+6072 . 6255)))))
 STOP

lispusers/MODERNIZE

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7
 30816  
+
(FILECREATED "30-Jun-2024 22:38:08" {WMEDLEY}<lispusers>MODERNIZE.;50
 30912  
+
+      :EDIT-BY rmk
 
       :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
 
-      :PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
-)
+      :PREVIOUS-DATE "27-Jan-2024 13:38:15" {WMEDLEY}<lispusers>MODERNIZE.;49)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
@@ -499,7 +500,8 @@
            (FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN])
 
 (\MODERNIZED.TEDIT.BUTTONEVENTFN

-  [LAMBDA (W STREAM)
                                         (* ; "Edited 29-Jul-2023 10:48 by rmk")


+  [LAMBDA (W STREAM)
                                         (* ; "Edited 30-Jun-2024 22:29 by rmk")


+                                                             (* ; "Edited 29-Jul-2023 10:48 by rmk")


                                                             (* ; "Edited 13-Oct-2021 21:43 by rmk:")

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

@@ -510,8 +512,8 @@
            NIL
            (WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
            [APPLY (FUNCTION UNIONREGIONS)
-                  (bind
 PANE _ (CENTRALWINDOW W) collect
 (WINDOWPROP PANE 'REGION)
-                     repeatwhile
 (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
+                  (for
 PANE in
 (\TEDIT.PANELIST (CENTRALWINDOW W)) collect
 (WINDOWPROP PANE
+                                                                                  'REGION]
            (WINDOWPROP (CENTRALWINDOW W)
                   'TITLE])
 )
@@ -614,11 +616,11 @@
 (ADDTOVAR LAMA
 MODERN-ADD-EXEC)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW 
-9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) (
-11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 . 
-21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW 
-22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 (
-\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489 
-29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053)))))
+  (FILEMAP (NIL (5066 11428 (MODERNWINDOW 5076 . 6616) (MODERNWINDOW.SETUP 6618 . 9567) (UNMODERNWINDOW 
+9569 . 9963) (MODERNWINDOW.UNSETUP 9965 . 10777) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10779 . 11426)) (
+11493 22459 (MODERNWINDOW.BUTTONEVENTFN 11503 . 18530) (NEARTOP 18532 . 19460) (NEARESTCORNER 19462 . 
+21329) (INCORNER.REGION 21331 . 22457)) (22517 24989 (MODERN-ADD-EXEC 22527 . 22958) (MODERN-SNAPW 
+22960 . 23503) (TOTOPW.MODERNIZE 23505 . 23933) (MODERN-MENUBUTTONFN 23935 . 24987)) (24990 27419 (
+\MODERNIZED.FREEMENU.BUTTONEVENTFN 25000 . 25647) (MODERNIZED.TB.BUTTONEVENTFN 25649 . 27417)) (27460 
+29151 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29149)))))
 STOP

lispusers/QIX

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "24-Aug-2022 07:58:48" |{DSK}<home>larry>medley>lispusers>QIX.;2|
 11276  
+
(FILECREATED "14-Jun-2024 14:54:24" |{WMEDLEY}<lispusers>QIX.;4|
 12192  
 
-      :CHANGES-TO (FNS QIX.IDLE)
+      :EDIT-BY |rmk|
 
-      :PREVIOUS-DATE "12-Aug-87 03:05:50" |{DSK}<home>larry>medley>lispusers>QIX.;1|)
+      :CHANGES-TO (FNS QIX.GROW)
 
+      :PREVIOUS-DATE "14-Jun-2024 14:49:48" |{WMEDLEY}<lispusers>QIX.;3|)
 
-; Copyright (c) 1987 by Xerox Corporation.
 
 (PRETTYCOMPRINT QIXCOMS)
 
@@ -18,69 +18,72 @@
 (DEFINEQ
 
 (QIX.GROW

-  (LAMBDA (WINDOW DONTDISMISS)
                       (* \; "Edited  1-Aug-87 16:57 by JEFF.SHRAGER")

-          
-          (* * |This| |sets| |up| \a QIX |the| |specified| |window.|
-
          |The| |QIX's| |parameters| |are| |defined| |at| |random,| |but| |with| 
-
          |reasonable| |value| |ranges.| |The| |dismiss| |argument| |tell| |the| QIX 
-
          |whether| |to| DISMISS |every| |cycle| |or| |not.|
-
          B\e |careful.|)

+  (LAMBDA (WINDOW DONTDISMISS)
                              (* \; "Edited 14-Jun-2024 14:54 by rmk")

+                                                             (* \; 
+
                                                             "Edited  1-Aug-87 16:57 by JEFF.SHRAGER")

+
+(* |;;;| "This sets up a QIX the specified window.  The QIX's parameters are defined at random, but with reasonable value ranges.  The dismiss argument tell the QIX whether to DISMISS every cycle or not.  Be careful.")

 
     (PROG (P P2 (W (OR WINDOW (CREATEW)))
              L)
           (SETQ *STOP.QIXS* NIL)
-          
-          (* * P |and| P2 |define| \a QIX.)

+
+(* |;;;| "P and P2 define a QIX.")

 
           (SETQ P (|create|
 QIX.POINT
-                         X _ (RAND 1 200)
-                         Y _ (RAND 1 100)
+                         QX _ (RAND 1 200)
+                         QY _ (RAND 1 100)
                          VH _ (RAND 1 20)
                          VV _ (RAND 1 20)))
           (SETQ P2 (|create|
 QIX.POINT
-                          X _ (RAND 1 200)
-                          Y _ (RAND 1 100)
+                          QX _ (RAND 1 200)
+                          QY _ (RAND 1 100)
                           VH _ (RAND 1 20)
                           VV _ (RAND 1 20)))
-          
-          (* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and| 
-
          |gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's| 
-
          |own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)

+
+(* |;;;| "L is the tail list.  It starts out full of NILs and gets filled as the QIX moves.  It is also inserted in it's own mouth so that the whole thing wraps around.")

 
           (SETQ L (APPEND (|for|
 X |from|
 1 |to|
 (RAND 5 25)
                              |collect|
 (COPY '(A S D F)))
-                         (LIST (LIST (|fetch|
 X P)
-                                     (|fetch|
 Y P)
-                                     (|fetch|
 X P2)
-                                     (|fetch|
 Y P2)))))
+                         (LIST (LIST (|fetch|
 (QIX.POINT QX)
+                                            P)
+                                     (|fetch|
 (QIX.POINT QY)
+                                            P)
+                                     (|fetch|
 (QIX.POINT QX)
+                                            P2)
+                                     (|fetch|
 (QIX.POINT QY)
+                                            P2)))))
           (RPLACD (LAST L)
                  L)
       LOOP
           (COND
              (*STOP.QIXS* (RPLACD L NIL)
                     (RETURN NIL)))
-          
-          (* * |Draw| |the| |QIX's| |head| |line.|)

 
-          (MOVETO (|fetch|
 X P)
-                 (|fetch|
 Y P)
+(* |;;;| "Draw the QIX's head line.")

+
+          (MOVETO (|fetch|
 (QIX.POINT QX)
+                         P)
+                 (|fetch|
 (QIX.POINT QY)
+                        P)
                  W)
-          (DRAWTO (|fetch|
 X P2)
-                 (|fetch|
 Y P2)
+          (DRAWTO (|fetch|
 (QIX.POINT QX)
+                         P2)
+                 (|fetch|
 (QIX.POINT QY)
+                        P2)
                  1
                  'REPLACE W)
-          
-          (* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)

+
+(* |;;;| "Move the points according to their QX and QY velocities.")

 
           (QIX.MOVE.POINT
 P W)
           (QIX.MOVE.POINT
 P2 W)
-          
-          (* * |Take| \a |deep| |breath| |if| |the| |user| |asks| |you| |to.|
-
          |This| |slows| |things| |down.|)

+
+(* |;;;| "Take a deep breath if the user asks you to.  This slows things down.")

 
           (OR DONTDISMISS (DISMISS))
-          
-          (* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)

+
+(* |;;;| "Delete the first object on the tail list.")

 
           (COND
              ((EQ (CAAR L)
@@ -93,60 +96,63 @@
                              (CADDDR OLD)
                              1
                              'ERASE W))))
-          
-          (* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which| 
-
          |effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| 
-
          |them| |immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| 
-
          |list.|)

+
+(* |;;;| "Replace the current point with the new head, which effectively adds it to the end of the list, since we them immediately move to the next elt in this circular list.")

 
           (RPLACA (CAR L)
-                 (|fetch|
 X P))
+                 (|fetch|
 (QIX.POINT QX)
+                        P))
           (RPLACA (CDAR L)
-                 (|fetch|
 Y P))
+                 (|fetch|
 (QIX.POINT QY)
+                        P))
           (RPLACA (CDDAR L)
-                 (|fetch|
 X P2))
+                 (|fetch|
 (QIX.POINT QX)
+                        P2))
           (RPLACA (CDDDAR L)
-                 (|fetch|
 Y P2))
+                 (|fetch|
 (QIX.POINT QY)
+                        P2))
           (SETQ L (CDR L))
           (GO LOOP))))
 
 (QIX.IDLE

-  (LAMBDA (W)
                                             (* \; "Edited 24-Aug-2022 07:53 by larry")

+  (LAMBDA (W)
                                               (* \; "Edited 14-Jun-2024 14:49 by rmk")


+                                                          (* \; "Edited 24-Aug-2022 07:53 by larry")

                                                              (* \; 
 
                                                             "Edited  1-Aug-87 16:58 by JEFF.SHRAGER")

 
-         (* * CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND
-
         (WASTING SPACE) FROM BEFORE.)

+(* |;;;| "CLOBBER ANY OLD QIXS THAT WERE LEFT AROUND (WASTING SPACE) FROM BEFORE.")

 
     (AND (BOUNDP '*OLD-QIXS*)
          (FOR
 Q IN
 *OLD-QIXS* DO
 (RPLACD Q NIL)))
     (PROG (P P2 L QIXS)
 
-         (* * P |and| P2 |define| \a QIX.)

+(* |;;;| "P and P2 define a QIX.")

 
           (SETQ QIXS (|for|
 I |from|
 1 |to|
 5
                         |collect|
 (PROGN (SETQ P (|create|
 QIX.POINT
-                                                        X _ (RAND 1 200)
-                                                        Y _ (RAND 1 100)
+                                                        QX _ (RAND 1 200)
+                                                        QY _ (RAND 1 100)
                                                         VH _ (RAND 1 20)
                                                         VV _ (RAND 1 20)))
                                          (SETQ P2 (|create|
 QIX.POINT
-                                                         X _ (RAND 1 200)
-                                                         Y _ (RAND 1 100)
+                                                         QX _ (RAND 1 200)
+                                                         QY _ (RAND 1 100)
                                                          VH _ (RAND 1 20)
                                                          VV _ (RAND 1 20)))
 
-         (* * L |is| |the| |tail| |list.| I\t |starts| |out| |full| |of| NIL\s |and| 
-
         |gets| |filled| |as| |the| QIX |moves.| I\t |is| |also| |inserted| |in| |it's| 
-
         |own| |mouth| |so| |that| |the| |whole| |thing| |wraps| |around.|)

+(* |;;;| "L is the tail list.  It starts out full of NILs and gets filled as the QIX moves.  It is also inserted in it's own mouth so that the whole thing wraps around.")

 
                                          (SETQ L
                                           (APPEND (|for|
 X |from|
 1 |to|
 (RAND 5 25)
                                                      |collect|
 (COPY '(A S D F)))
-                                                 (LIST (LIST (|fetch|
 X P)
-                                                             (|fetch|
 Y P)
-                                                             (|fetch|
 X P2)
-                                                             (|fetch|
 Y P2)))))
+                                                 (LIST (LIST (|fetch|
 (QIX.POINT QX)
+                                                                    P)
+                                                             (|fetch|
 (QIX.POINT QY)
+                                                                    P)
+                                                             (|fetch|
 (QIX.POINT QX)
+                                                                    P2)
+                                                             (|fetch|
 (QIX.POINT QY)
+                                                                    P2)))))
                                          (RPLACD (LAST L)
                                                 L)
                                          (LIST P P2 L))))
@@ -157,22 +163,26 @@
                                   (SETQ P2 (CADR Q))
                                   (SETQ L (CADDR Q)) 
 
-         (* * |Draw| |the| |QIX's| |head| |line.|)

+(* |;;;| "Draw the QIX's head line.")

 
-                                  (MOVETO (|fetch|
 X P)
-                                         (|fetch|
 Y P)
+                                  (MOVETO (|fetch|
 (QIX.POINT QX)
+                                                 P)
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P)
                                          W)
-                                  (DRAWTO (|fetch|
 X P2)
-                                         (|fetch|
 Y P2)
+                                  (DRAWTO (|fetch|
 (QIX.POINT QX)
+                                                 P2)
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P2)
                                          1
                                          'REPLACE W) 
 
-         (* * |Move| |the| |points| |according| |to| |their| X |and| Y |velocities.|)

+(* |;;;| "Move the points according to their QX and QY velocities.")

 
                                   (QIX.MOVE.POINT
 P W)
                                   (QIX.MOVE.POINT
 P2 W) 
 
-         (* * |Delete| |the| |first| |object| |on| |the| |tail| |list.|)

+(* |;;;| "Delete the first object on the tail list.")

 
                                   (COND
                                      ((EQ (CAAR L)
@@ -186,34 +196,36 @@
                                                      1
                                                      'ERASE W)))) 
 
-         (* * |Replace| |the| |current| |point| |with| |the| |new| |head,| |which| 
-
         |effectively| |adds| |it| |to| |the| |end| |of| |the| |list,| |since| |we| THEN 
-
         |immediately| |move| |to| |the| |next| |elt| |in| |this| |circular| |list.|)

+(* |;;;| "Replace the current point with the new head, which effectively adds it to the end of the list, since we THEN immediately move to the next elt in this circular list.")

 
                                   (RPLACA (CAR L)
-                                         (|fetch|
 X P))
+                                         (|fetch|
 (QIX.POINT QX)
+                                                P))
                                   (RPLACA (CDAR L)
-                                         (|fetch|
 Y P))
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P))
                                   (RPLACA (CDDAR L)
-                                         (|fetch|
 X P2))
+                                         (|fetch|
 (QIX.POINT QX)
+                                                P2))
                                   (RPLACA (CDDDAR L)
-                                         (|fetch|
 Y P2))
+                                         (|fetch|
 (QIX.POINT QY)
+                                                P2))
                                   (RPLACA (CDDR Q)
                                          (CDR L)))
           (GO LOOP))))
 
 (QIX.MOVE.POINT

-  (LAMBDA (P W)
                                              (* |edited:| "16-May-85 00:39")

-          
-          (* * |This| |guy| |updates| |the| QIX |line| |endpoints| |according| |to| 
-
          |their| |velocities| |in| |the| X |and| Y |directions.|
-
          I\f |we| |hit| \a |wall,| |then| |simply| |negate| |the| |relevant| |velocity| 
-
          |vector.|)

+  (LAMBDA (P W)
                                             (* \; "Edited 14-Jun-2024 14:48 by rmk")

+                                                             (* |edited:| "16-May-85 00:39")

+
+(* |;;;| "This guy updates the QIX line endpoints according to their velocities in the X and Y directions.  If we hit a wall, then simply negate the relevant velocity vector.")

 
     (PROG ((VV (|fetch|
 VV P))
            (VH (|fetch|
 VH P))
-           (X (|fetch|
 X P))
-           (Y (|fetch|
 Y P)))
+           (X (|fetch|
 (QIX.POINT QX)
+                     P))
+           (Y (|fetch|
 (QIX.POINT QY)
+                     P)))
           (PROG ((NEWX (IPLUS X VH))
                  (NEWY (IPLUS Y VV)))
                 (COND
@@ -230,8 +242,10 @@
                    ((GREATERP NEWX (WINDOWPROP W 'WIDTH))
                     (SETQ NEWX (WINDOWPROP W 'WIDTH))
                     (SETQ VH (ITIMES -1 VH))))
-                (|replace|
 Y P NEWY)
-                (|replace|
 X P NEWX)
+                (|replace|
 (QIX.POINT QY)
+                       P NEWY)
+                (|replace|
 (QIX.POINT QX)
+                       P NEWX)
                 (|replace|
 VV P VV)
                 (|replace|
 VH P VH)))))
 
@@ -249,13 +263,12 @@
 )
 (DECLARE\: EVAL@COMPILE
 
-(RECORD QIX.POINT
 (X Y VH VV))
+(RECORD QIX.POINT
 (QX QY VH VV))
 )
 
 (SETQ IDLE.FUNCTIONS (CONS '("5 Qix's" 'QIX.IDLE)
                            IDLE.FUNCTIONS))
-(PUTPROPS QIX COPYRIGHT ("Xerox Corporation" 1987))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (592 11044 (QIX.GROW 602 . 4158) (QIX.IDLE 4160 . 8972) (QIX.MOVE.POINT 8974 . 10356) (
-QIX.PLAY 10358 . 11042)))))
+  (FILEMAP (NIL (544 12010 (QIX.GROW 554 . 4311) (QIX.IDLE 4313 . 9800) (QIX.MOVE.POINT 9802 . 11322) (
+QIX.PLAY 11324 . 12008)))))
 STOP

lispusers/READ-BDF

@@ -0,0 +1,219 @@
+(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" (USE "XCL" "LISP") (EXPORT "READ-BDF")) READTABLE 
+"XCL" BASE 10)
+
+
(IL:FILECREATED "23-Sep-2024 12:38:25" IL:{LU}READ-BDF.\;2
 12260  
+
+      :EDIT-BY "mth"
+
+      :CHANGES-TO (IL:FUNCTIONS READ-BDF READ-GLYPH)
+
+      :PREVIOUS-DATE "22-Aug-2024 20:54:00" IL:{LU}READ-BDF.\;1)
+
+
+(IL:PRETTYCOMPRINT IL:READ-BDFCOMS)
+
+(IL:RPAQQ IL:READ-BDFCOMS
 ((IL:STRUCTURES BDF-FONT GLYPH)
+                           (IL:FUNCTIONS READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH)
+                           (FILE-ENVIRONMENTS "READ-BDF")))
+
+(DEFSTRUCT (BDF-FONT
 (:CONC-NAME "BF-"))
+   (NAME NIL :TYPE STRING)
+   (SIZE NIL :TYPE LIST)
+   (BOUNDINGBOX NIL :TYPE LIST)
+   (METRICSSET 0 :TYPE (INTEGER 0 2))
+   (PROPERTIES NIL :TYPE LIST)
+   SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST))
+
+(DEFSTRUCT GLYPH

+   (NAME NIL :TYPE STRING)
+   ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP)
+
+(DEFUN READ-BDF
 (PATH)
                                (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth")


+                                                      (IL:* IL:\; "Edited 22-Aug-2024 16:43 by mth")


+                                                      (IL:* IL:\; "Edited 17-Jul-2024 14:45 by mth")


+                                                      (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth")

+   (LET
+    (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS (NGLYPHS 0)
+           (*PACKAGE* (FIND-PACKAGE "BDF")))
+    (WITH-OPEN-FILE
+     (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT)
+     (UNLESS (STRING-EQUAL "STARTFONT" (READ FILE-STREAM))
+            (ERROR "Invalid BDF file - must begin with STARTFONT."))
+
+     (IL:* IL:|;;| "ignore the file format version number")

+
+     (READ-LINE FILE-STREAM)
+     (SETQ FONT (MAKE-BDF-FONT))
+     (LOOP
+      :UNTIL FONT-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
+      (WHEN LINE                                             (IL:* IL:\; "Ignore blank lines")

+          (MULTIPLE-VALUE-SETQ (KEY POS)
+                 (READ-FROM-STRING LINE))
+          (UNLESS (MEMBER KEY '(COMMENT CONTENTVERSION))
+              (WHEN (<= POS (LENGTH LINE))
+                  (SETQ LINE (SUBSEQ LINE POS)))
+              (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING
 LINE))
+              (CASE KEY
+                  (FONT (SETF (BF-NAME FONT)
+                              LINE))
+                  (METRICSSET (IF (AND (INTEGERP (SETQ V (FIRST ITEMS)))
+                                       (<= 0 V 2))
+                                  (SETF (BF-METRICSSET FONT)
+                                        V)
+                                  (ERROR 
+                                     "Invalid BDF file - METRICSSET (~A) is invalid or out of range."
+                                         V)))
+                  (SIZE (SETF (BF-SIZE FONT)
+                              ITEMS))
+                  (FONTBOUNDINGBOX (SETF (BF-BOUNDINGBOX FONT)
+                                         ITEMS))
+                  (SWIDTH (SETF (BF-SWIDTH FONT)
+                                ITEMS))
+                  (DWIDTH (SETF (BF-DWIDTH FONT)
+                                ITEMS))
+                  (SWIDTH1 (SETF (BF-SWIDTH1 FONT)
+                                 ITEMS))
+                  (DWIDTH1 (SETF (BF-DWIDTH1 FONT)
+                                 ITEMS))
+                  (VVECTOR (SETF (BF-VVECTOR FONT)
+                                 ITEMS))
+                  (STARTPROPERTIES 
+                     (IF (AND (INTEGERP (SETQ V (FIRST ITEMS)))
+                              (PLUSP V))
+                         (SETQ PROPS (LOOP :UNTIL PROPS-COMPLETE :APPEND
+                                           (WITH-INPUT-FROM-STRING
+                                            (SI (SETQ LINE (READ-LINE FILE-STREAM)))
+                                            (UNLESS (SETQ PROPS-COMPLETE
+                                                          (STRING-EQUAL "ENDPROPERTIES"
+                                                                 (STRING-TRIM '(#\Space #\Tab)
+                                                                        LINE)))
+                                                (SETQ KEY (READ SI))
+                                                (IF (AND KEY (SYMBOLP KEY)
+                                                         (SETQ VV (READ SI))
+                                                         (OR (STRINGP VV)
+                                                             (INTEGERP VV)))
+                                                    (LIST (INTERN (STRING KEY)
+                                                                 "KEYWORD")
+                                                          VV)
+                                                    (ERROR 
+                                                        "Invalid BDF file - malformed PROPERTY (~A)."
+                                                           LINE))))))
+                         (ERROR 
+                               "Invalid BDF file - STARTPROPERTIES count (~A) is invalid or missing."
+                                V))
+                     (IF (EQL V (SETQ VV (/ (LENGTH PROPS)
+                                            2)))
+                         (SETF (BF-PROPERTIES FONT)
+                               PROPS)
+                         (ERROR 
+                          "Invalid BDF file - STARTPROPERTIES count (~D) does not match actual (~D)."
+                                V VV)))
+                  (CHARS 
+                     (SETQ NGLYPHS (FIRST ITEMS))
+                     (UNLESS (AND NGLYPHS (INTEGERP NGLYPHS)
+                                  (PLUSP NGLYPHS))
+                            (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." 
+                                   NGLYPHS))
+                     (SETF (BF-GLYPHS FONT)
+                           (LOOP :REPEAT NGLYPHS :COLLECT (READ-GLYPH
 FILE-STREAM FONT))))
+                  (ENDFONT (SETQ FONT-COMPLETE T))))))
+     FONT)))
+
+(DEFUN READ-DELIMITED-LIST-FROM-STRING
 (INPUT-STRING &OPTIONAL (DELIMIT #\]))

+                                                      (IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")

+   (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT)))
+          (READ-DELIMITED-LIST DELIMIT SI)))
+
+(DEFUN READ-GLYPH
 (FILE-STREAM FONT)
                  (IL:* IL:\; "Edited 23-Sep-2024 12:38 by mth")


+                                                      (IL:* IL:\; "Edited 22-Aug-2024 20:53 by mth")


+                                                      (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth")

+   (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
+                       :DWIDTH
+                       (COPY-LIST (BF-DWIDTH FONT))
+                       :SWIDTH1
+                       (COPY-LIST (BF-SWIDTH1 FONT))
+                       :DWIDTH1
+                       (COPY-LIST (BF-DWIDTH1 FONT))
+                       :VVECTOR
+                       (COPY-LIST (BF-VVECTOR FONT))))
+         CHAR-COMPLETE LINE ITEMS V KEY POS STARTED BBW BBH)
+        (LOOP :UNTIL CHAR-COMPLETE :DO (SETQ LINE (READ-LINE FILE-STREAM))
+              (WHEN LINE                                     (IL:* IL:\; "Ignore blank lines")

+                  (MULTIPLE-VALUE-SETQ (KEY POS)
+                         (READ-FROM-STRING LINE))
+                  (WHEN (<= POS (LENGTH LINE))
+                      (SETQ LINE (SUBSEQ LINE POS)))
+                  (SETQ ITEMS (READ-DELIMITED-LIST-FROM-STRING
 LINE))
+                  (COND
+                     ((EQ KEY 'STARTCHAR)
+                      (WHEN STARTED (ERROR "Invalid BDF file - STARTCHAR inside glyph."))
+                      (SETF STARTED T)
+                      (SETF (GLYPH-NAME GLYPH)
+                            (STRING LINE)))
+                     (T (UNLESS STARTED (ERROR "Invalid BDF file - glyph has ben started."))
+                        (CASE KEY
+                            (ENCODING (SETF (GLYPH-ENCODING GLYPH)
+                                            (IF (EQUAL -1 (FIRST ITEMS))
+                                                ITEMS
+                                                (FIRST ITEMS))))
+                            (SWIDTH (SETF (GLYPH-SWIDTH GLYPH)
+                                          ITEMS))
+                            (DWIDTH (SETF (GLYPH-DWIDTH GLYPH)
+                                          ITEMS))
+                            (SWIDTH1 (SETF (GLYPH-SWIDTH1 GLYPH)
+                                           ITEMS))
+                            (DWIDTH1 (SETF (GLYPH-DWIDTH1 GLYPH)
+                                           ITEMS))
+                            (VVECTOR (SETF (GLYPH-VVECTOR GLYPH)
+                                           ITEMS))
+                            (BBX (SETF (GLYPH-BBW GLYPH)
+                                       (SETQ BBW (FIRST ITEMS))
+                                       (GLYPH-BBH GLYPH)
+                                       (SETQ BBH (SECOND ITEMS))
+                                       (GLYPH-BBXOFF0 GLYPH)
+                                       (THIRD ITEMS)
+                                       (GLYPH-BBYOFF0 GLYPH)
+                                       (FOURTH ITEMS)))
+                            (BITMAP (LET* ((BM (IL:BITMAPCREATE BBW BBH 1))
+                                           (BM.BASE (IL:|fetch|
 IL:BITMAPBASE IL:|of|
 BM))
+                                           (BM.RASTERWIDTH (IL:|fetch|
 IL:BITMAPRASTERWIDTH
+                                                              IL:|of|
 BM))
+                                           (NBYTES (CEILING BBW 8))
+                                           (NCHARS (* 2 NBYTES))
+                                           (NWORDS (CEILING BBW 16))
+                                           BITS BYTEPOS WORDINDEX)
+                                          (LOOP :WITH BITROW = 0 :REPEAT BBH :DO
+                                                (SETQ LINE (STRING-TRIM '(#\Space #\Tab)
+                                                                  (READ-LINE FILE-STREAM)))
+                                                (UNLESS (AND (EQUAL NCHARS (LENGTH LINE))
+                                                             (SETQ BITS
+                                                                   (PARSE-INTEGER LINE :RADIX 16 
+                                                                          :JUNK-ALLOWED T)))
+                                                       (ERROR 
+                                                          "Invalid BDF file - bad line in BITMAP: ~A"
+                                                              LINE))
+                                                (WHEN (ODDP NBYTES)
+                                                    (SETQ BITS (ASH BITS 8)))
+                                                (SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
+                                                (SETQ BYTEPOS (* 16 (1- NWORDS)))
+                                                (LOOP :REPEAT NWORDS :DO
+                                                      (IL:\\PUTBASE BM.BASE WORDINDEX
+                                                             (LDB (BYTE 16 BYTEPOS)
+                                                                  BITS))
+                                                      (INCF WORDINDEX)
+                                                      (DECF BYTEPOS 16))
+                                                (INCF BITROW))
+                                          (SETF (GLYPH-BITMAP GLYPH)
+                                                BM)))
+                            (ENDCHAR (SETQ CHAR-COMPLETE T)))))))
+        GLYPH))
+
+(DEFINE-FILE-ENVIRONMENT "READ-BDF"
 :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP")
+                                                    (:EXPORT "READ-BDF"))
+   :READTABLE "XCL"
+   :COMPILER :COMPILE-FILE)
+(IL:PUTPROPS IL:READ-BDF IL:COPYRIGHT (IL:NONE))
+(IL:DECLARE\: IL:DONTCOPY
+  (IL:FILEMAP (NIL (983 6167 (READ-BDF 983 . 6167)) (6169 6492 (READ-DELIMITED-LIST-FROM-STRING 6169 . 
+6492)) (6494 11972 (READ-GLYPH 6494 . 11972)))))
+IL:STOP

lispusers/REGIONMANAGER

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133
 41064  
+
(FILECREATED "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134
 41230  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS RM-CREATEW)
+      :CHANGES-TO (FNS CLOSE-TYPED-W)
 
-      :PREVIOUS-DATE "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129)
+      :PREVIOUS-DATE " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133)
 
 
 (PRETTYCOMPRINT REGIONMANAGERCOMS)
@@ -248,15 +248,17 @@
          REGION])
 
 (CLOSE-TYPED-W

-  [LAMBDA (TYPE)
                                             (* ; "Edited 14-Sep-2023 07:39 by rmk")


+  [LAMBDA (TYPE)
                                             (* ; "Edited 27-Oct-2024 21:59 by rmk")


+                                                             (* ; "Edited 14-Sep-2023 07:39 by rmk")


                                                              (* ; "Edited 29-Dec-2021 15:58 by rmk")


                                                             (* ; "Edited 27-Nov-2021 11:50 by rmk:")

 
-    (* ;; "Closes all windows whose regions are of type TYPE")

+    (* ;; "Closes all windows whose regions are of type TYPE (case-independent)")

 
     (CL:WHEN TYPE
-        (for
 W R in
 (OPENWINDOWS) eachtime
 [SETQ WT (CAR (WINDOWPROP W 'TYPED-REGION]
-           when
 (AND WT (EQMEMB WT TYPE)) do
 (CLOSEW W)))])
+        (for
 W TRPROP in
 (OPENWINDOWS) eachtime
 (SETQ TRPROP (WINDOWPROP W 'TYPED-REGION))
+           when
 (STRING.EQUAL (CAR TRPROP)
+                       TYPE) do
 (CLOSEW W)))])
 )
 
 (RPAQ? TYPED-REGIONS
 )
@@ -730,11 +732,11 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1612 6730 (SET-TYPED-REGIONS 1622 . 3797) (GRAB-TYPED-REGION 3799 . 4825) (
-REGISTER-TYPED-REGION 4827 . 6124) (REGION-TYPE 6126 . 6728)) (6731 14637 (RM-CREATEW 6741 . 8864) (
-RM-CLOSEW 8866 . 11884) (RM-GETREGION 11886 . 14035) (CLOSE-TYPED-W 14037 . 14635)) (15280 22759 (
-RELCREATEREGION 15290 . 19913) (RELGETREGION 19915 . 22522) (RELCREATEPOSITION 22524 . 22757)) (22760 
-29564 (\RELCREATEREGION.REF 22770 . 26521) (\RELCREATEREGION.SIZE 26523 . 29562)) (29617 38959 (
-RM-ATTACHWINDOW 29627 . 38957)) (38960 40694 (CLOSEWITH 38970 . 39497) (CLOSEWITH.DOIT 39499 . 39779) 
-(MOVEWITH 39781 . 40304) (MOVEWITH.DOIT 40306 . 40692)))))
+  (FILEMAP (NIL (1615 6733 (SET-TYPED-REGIONS 1625 . 3800) (GRAB-TYPED-REGION 3802 . 4828) (
+REGISTER-TYPED-REGION 4830 . 6127) (REGION-TYPE 6129 . 6731)) (6734 14803 (RM-CREATEW 6744 . 8867) (
+RM-CLOSEW 8869 . 11887) (RM-GETREGION 11889 . 14038) (CLOSE-TYPED-W 14040 . 14801)) (15446 22925 (
+RELCREATEREGION 15456 . 20079) (RELGETREGION 20081 . 22688) (RELCREATEPOSITION 22690 . 22923)) (22926 
+29730 (\RELCREATEREGION.REF 22936 . 26687) (\RELCREATEREGION.SIZE 26689 . 29728)) (29783 39125 (
+RM-ATTACHWINDOW 29793 . 39123)) (39126 40860 (CLOSEWITH 39136 . 39663) (CLOSEWITH.DOIT 39665 . 39945) 
+(MOVEWITH 39947 . 40470) (MOVEWITH.DOIT 40472 . 40858)))))
 STOP

lispusers/SOLITAIRE

@@ -1,16 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Aug-2022 08:54:17" {DSK}<home>larry>medley>lispusers>SOLITAIRE.;2
 26883  
+
(FILECREATED "14-Jun-2024 15:48:55" {WMEDLEY}<lispusers>SOLITAIRE.;4
 27251  
 
-      :CHANGES-TO (FNS SOLO DEALDECK GETCARD)
-                  (VARS SOLITAIRECOMS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "15-Jan-86 23:32:05" {DSK}<home>larry>medley>lispusers>SOLITAIRE.;1)
+      :CHANGES-TO (RECORDS CARD)
+                  (FNS GETCARD MOVECARD UPCARD NXTCARD)
 
+      :PREVIOUS-DATE "24-Aug-2022 08:54:17" {WMEDLEY}<lispusers>SOLITAIRE.;2)
 
-(* ; "
-Copyright (c) 1982, 1985-1986 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT SOLITAIRECOMS)
 
@@ -169,11 +167,12 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
       else
 NIL])
 
 (GETCARD

-  [LAMBDA (I)                                                (* bas%: "30-JUL-82 19:04")

+  [LAMBDA (I)
                                                (* ; "Edited 14-Jun-2024 15:48 by rmk")

+                                                             (* bas%: "30-JUL-82 19:04")

     (PROG ((C (ELT DECK I)))
           (if
 (fetch
 FACE of
 C)
             else
 (replace
 FACE of
 C with
 (CARDIMAGE
 C))
-                 (replace
 SAV of
 C with
 (BITMAPCREATE CardWidth CardHeight)))
+                 (replace
 (CARD CDSAV) of
 C with
 (BITMAPCREATE CardWidth CardHeight)))
           (replace
 CX of
 C with
 (replace
 CY of
 C with
 NIL))
           (RETURN C])
 
@@ -192,13 +191,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
         then
 (SEARCHSTACKS
 (TOP H])
 
 (MOVECARD

-  [LAMBDA (C X Y)                                            (* lmm " 6-Aug-85 00:04")

+  [LAMBDA (C X Y)
                                            (* ; "Edited 14-Jun-2024 15:46 by rmk")

+                                                             (* lmm " 6-Aug-85 00:04")

     (if
 (fetch
 CX of
 C)
         then
 (DOMOVE
 (fetch
 FACE of
 C)
                     (fetch
 CX of
 C)
                     (fetch
 CY of
 C)
-                    X Y (fetch
 SAV of
 C))
-      else
 (BITBLT SOLOW X Y (fetch
 SAV of
 C)
+                    X Y (fetch
 (CARD CDSAV) of
 C))
+      else
 (BITBLT SOLOW X Y (fetch
 (CARD CDSAV) of
 C)
                   NIL NIL NIL NIL 'INPUT 'REPLACE)
            (BITBLT (fetch
 FACE of
 C)
                   NIL NIL SOLOW X Y NIL NIL 'INPUT 'REPLACE))
@@ -264,7 +264,8 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
              (PUSHCARD
 S2 (CAR L])
 
 (UPCARD

-  [LAMBDA (X Y)                                              (* lmm " 6-Aug-85 00:04")

+  [LAMBDA (X Y)
                                              (* ; "Edited 14-Jun-2024 15:46 by rmk")

+                                                             (* lmm " 6-Aug-85 00:04")

 
          (* Brings up X image which is assumed to be overlapped by Y image.
 
         Assumes YOFFSET only)

@@ -272,14 +273,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
     (if
 Y
         then
 (PROG [(DY (IDIFFERENCE (fetch
 CY of
 X)
                                (fetch
 CY of
 Y]
-                   (BITBLT (fetch
 SAV of
 X)
-                          0 0 (fetch
 SAV of
 Y)
+                   (BITBLT (fetch
 (CARD CDSAV) of
 X)
+                          0 0 (fetch
 (CARD CDSAV) of
 Y)
                           0 DY CardWidth (IDIFFERENCE CardHeight DY)
                           'INPUT
                           'REPLACE)
                    (BITBLT SOLOW (fetch
 CX of
 X)
                           (fetch
 CY of
 X)
-                          (fetch
 SAV of
 X)
+                          (fetch
 (CARD CDSAV) of
 X)
                           0 0 CardWidth (IDIFFERENCE CardHeight DY)
                           'INPUT
                           'REPLACE)
@@ -308,7 +309,8 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
                       (RETURN T])
 
 (NXTCARD

-  [LAMBDA (S)                                                (* bas%: "15-Jan-86 21:44")

+  [LAMBDA (S)
                                                (* ; "Edited 14-Jun-2024 15:46 by rmk")

+                                                             (* bas%: "15-Jan-86 21:44")

     (PROG1 (pop
 (fetch
 FACEDOWN of
 S))
         [if
 (fetch
 FACEDOWN of
 S)
           else
 
@@ -335,7 +337,7 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
                       'REPLACE)
                (if
 (fetch
 FACEUP of
 S)
                    then
 (BLTSHADE (DSPTEXTURE NIL SOLOW)
-                               (fetch
 SAV of
 (BOTTOM S))
+                               (fetch
 (CARD CDSAV) of
 (BOTTOM S))
                                0
                                (IMINUS (fetch
 YO of
 S))
                                (IDIFFERENCE CardWidth (fetch
 XO of
 S))
@@ -531,7 +533,7 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
 
 (DECLARE%: EVAL@COMPILE
 
-(DATATYPE CARD
 (SUIT RANK FACE SAV CX CY)
+(DATATYPE CARD
 (SUIT RANK FACE CDSAV CX CY)
                (ACCESSFNS CARD (COLOR (ILESSP (fetch
 SUIT of
 DATUM)
                                              Diamonds))))
 
@@ -642,15 +644,14 @@ Copyright (c) 1982, 1985-1986 by Xerox Corporation.
 (RPAQ? SOLORESULTS
 )
 
 (ADDTOVAR IDLE.FUNCTIONS
 ("Solitaire" 'SOLO))
-(PUTPROPS SOLITAIRE COPYRIGHT ("Xerox Corporation" 1982 1985 1986))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1950 4087 (SOLO 1960 . 3297) (SOLITAIRE 3299 . 4085)) (4088 20454 (CARDIMAGE 4098 . 
-5754) (COUNTCARDS 5756 . 5969) (CREATEHAND 5971 . 6576) (CREATESTACK 6578 . 7427) (DEALDECK 7429 . 
-8012) (FLIPSTACK 8014 . 8249) (GETCARD 8251 . 8701) (GOODMOVE? 8703 . 9100) (HTOS? 9102 . 9269) (
-MOVECARD 9271 . 9910) (DOMOVE 9912 . 11543) (MOVEHS 11545 . 11816) (MOVES 11818 . 12129) (MOVES1 12131
- . 12433) (UPCARD 12435 . 13651) (MOVESSS 13653 . 14595) (NXTCARD 14597 . 16369) (PUSHCARD 16371 . 
-17033) (POSTVALUE 17035 . 18036) (SEARCHSTACKS 18038 . 18281) (SHOWCARDSTACK 18283 . 18912) (
-SHUFFLEDECK 18914 . 19718) (STACKLOC 19720 . 20052) (STOS? 20054 . 20316) (TOPSUITSTACK 20318 . 20452)
-) (20455 22457 (HIST 20465 . 22054) (ARRAYMAX 22056 . 22455)) (22479 24001 (SHOWCONFIG 22489 . 22951) 
-(PRINTCARDSTACK 22953 . 23305) (CARDNAME 23307 . 23999)))))
+  (FILEMAP (NIL (1885 4022 (SOLO 1895 . 3232) (SOLITAIRE 3234 . 4020)) (4023 20888 (CARDIMAGE 4033 . 
+5689) (COUNTCARDS 5691 . 5904) (CREATEHAND 5906 . 6511) (CREATESTACK 6513 . 7362) (DEALDECK 7364 . 
+7947) (FLIPSTACK 7949 . 8184) (GETCARD 8186 . 8754) (GOODMOVE? 8756 . 9153) (HTOS? 9155 . 9322) (
+MOVECARD 9324 . 10090) (DOMOVE 10092 . 11723) (MOVEHS 11725 . 11996) (MOVES 11998 . 12309) (MOVES1 
+12311 . 12613) (UPCARD 12615 . 13967) (MOVESSS 13969 . 14911) (NXTCARD 14913 . 16803) (PUSHCARD 16805
+ . 17467) (POSTVALUE 17469 . 18470) (SEARCHSTACKS 18472 . 18715) (SHOWCARDSTACK 18717 . 19346) (
+SHUFFLEDECK 19348 . 20152) (STACKLOC 20154 . 20486) (STOS? 20488 . 20750) (TOPSUITSTACK 20752 . 20886)
+) (20889 22891 (HIST 20899 . 22488) (ARRAYMAX 22490 . 22889)) (22913 24435 (SHOWCONFIG 22923 . 23385) 
+(PRINTCARDSTACK 23387 . 23739) (CARDNAME 23741 . 24433)))))
 STOP