Add git commit ID to beginning of loadups .dribble files. (#1778)

* Add git commit ID to beginning of loadups .dribble files.
The commit ID is put into the .dribble file in the .sh scripts. (using echo ... > name.dribble)
The changes to MEDLEY-UTILS, LOADUP-FULL, and LOADUP-LISP are to enable the passing of APPENDFLG to (DRIBBLE ... APPENDFLG).

* I hadn't saved file before previous commit.

* Add to IL:SYSOUTCOMMITS instead of to the .dribble files.

* Initialize SYSOUTCOMMITS so PUTASSOC has somewhere to put value(s)

.github/workflows/buildReleaseInclDocker.yml

@@ -110,6 +110,16 @@ jobs:
         force: ${{ needs.inputs.outputs.force }}
     secrets: inherit
 
+######################################################################################
+
+  # 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

.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-latest
+
+    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 

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

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Apr-2024 17:22:52" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;531
 155019 
+
(FILECREATED "11-Jul-2024 14:26:05" {MEDLEY}<library>TEDIT>TEDIT-FILE.;23
 155256 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.PIECES3)
+      :CHANGES-TO (FNS \TEDIT.GET.PIECES3)
 
-      :PREVIOUS-DATE " 2-Apr-2024 12:15:23" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;529)
+      :PREVIOUS-DATE " 7-Apr-2024 17:22:52" {MEDLEY}<library>TEDIT>TEDIT-FILE.;20)
 
 
 (PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -855,7 +855,8 @@
 (DEFINEQ
 
 (\TEDIT.GET.PIECES3

-  [LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END)
            (* ; "Edited  7-Apr-2024 17:20 by rmk")


+  [LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END)
            (* ; "Edited 11-Jul-2024 14:20 by rmk")


+                                                             (* ; "Edited  7-Apr-2024 17:20 by rmk")


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


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


                                                              (* ; "Edited 14-Jan-2024 00:22 by rmk")


@@ -939,7 +940,9 @@
                                             (\TEDIT.GET.SINGLE.CHARLOOKS
 TEXT TEXTOBJ))))
               (\PieceDescriptorPAGEFRAME                     (* ; 
 
                                                             "This is page layout info for the file")

-                   (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT))))
+                   (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT 
+                                                                               *TEDIT-FILE-READTABLE*
+                                                                                  ))))
               (\PieceDescriptorCHARLOOKSLIST                 (* ; 
 
                                                 "Read the list of CHARLOOKSs used in this document.")

                    (add
 PCNO -1)                             (* ; 
@@ -2449,27 +2452,27 @@
 
 (RPAQ? *TEDIT-FILE-READTABLE*
 (COPYREADTABLE \ORIGREADTABLE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4804 30415 (TEDIT.GET 4814 . 9656) (TEDIT.FORMATTEDFILEP 9658 . 10974) (TEDIT.FILEDATE 
-10976 . 12147) (TEDIT.INCLUDE 12149 . 19117) (TEDIT.RAW.INCLUDE 19119 . 19927) (TEDIT.PUT 19929 . 
-26872) (TEDIT.PUT.STREAM 26874 . 30413)) (30416 49580 (\TEDIT.GET.FOREIGN.FILE 30426 . 33611) (
-\TEDIT.GET.UNFORMATTED.FILE 33613 . 37487) (\TEDIT.GET.FORMATTED.FILE 37489 . 40277) (
-\TEDIT.FORMATTEDSTREAMP 40279 . 43179) (\ARBIN 43181 . 43901) (\ATMIN 43903 . 44440) (\DWIN 44442 . 
-44821) (\STRINGIN 44823 . 45531) (\TEDIT.GET.TRAILER 45533 . 48049) (\TEDIT.CACHEFILE 48051 . 49578)) 
-(49746 62858 (\TEDIT.GET.PIECES3 49756 . 59620) (\TEDIT.GET.IDATE3 59622 . 61017) (
-\TEDIT.MAKE.STRINGPIECE 61019 . 62856)) (62859 74802 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 62869 . 68985) 
-(\TEDIT.INTERPRET.XCCS.SHIFTS 68987 . 74800)) (74824 80846 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 74834 . 
-80844)) (80869 89373 (\TEDIT.GET.CHARLOOKS.LIST 80879 . 81610) (\TEDIT.GET.SINGLE.CHARLOOKS 81612 . 
-86185) (\TEDIT.GET.CHARLOOKS 86187 . 87517) (\TEDIT.GET.PARALOOKS.INDEX 87519 . 88063) (
-\TEDIT.GET.CHARLOOKS.INDEX 88065 . 89371)) (89374 97612 (\TEDIT.GET.PARALOOKS.LIST 89384 . 90006) (
-\TEDIT.GET.SINGLE.PARALOOKS 90008 . 97020) (\TEDIT.GET.PARALOOKS 97022 . 97610)) (97613 101012 (
-\TEDIT.GET.OBJECT 97623 . 101010)) (101074 133645 (\TEDIT.PUT.PCTB 101084 . 115087) (
-\TEDIT.PUT.TRAILER 115089 . 115856) (\TEDIT.PUT.PCTB.MERGEABLE 115858 . 119376) (
-\TEDIT.PUT.UTF8.SPLITPIECES 119378 . 124465) (\TEDIT.PUT.PCTB.NEXTNEW 124467 . 128242) (
-\TEDIT.INSERT.NEWPIECES 128244 . 131243) (\TEDIT.PUTRESET 131245 . 131487) (\ARBOUT 131489 . 132213) (
-\ATMOUT 132215 . 132820) (\DWOUT 132822 . 133101) (\STRINGOUT 133103 . 133643)) (133646 145039 (
-\TEDIT.PUT.CHARLOOKS.LIST 133656 . 135328) (\TEDIT.PUT.SINGLE.CHARLOOKS 135330 . 140574) (
-\TEDIT.PUT.CHARLOOKS 140576 . 141720) (\TEDIT.PUT.CHARLOOKS1 141722 . 142773) (\TEDIT.PUT.OBJECT 
-142775 . 145037)) (145040 153078 (\TEDIT.PUT.PARALOOKS.LIST 145050 . 145952) (
-\TEDIT.PUT.SINGLE.PARALOOKS 145954 . 152003) (\TEDIT.PUT.PARALOOKS 152005 . 153076)) (153173 154855 (
-TEDITFROMLISPSOURCE 153183 . 154853)))))
+  (FILEMAP (NIL (4746 30357 (TEDIT.GET 4756 . 9598) (TEDIT.FORMATTEDFILEP 9600 . 10916) (TEDIT.FILEDATE 
+10918 . 12089) (TEDIT.INCLUDE 12091 . 19059) (TEDIT.RAW.INCLUDE 19061 . 19869) (TEDIT.PUT 19871 . 
+26814) (TEDIT.PUT.STREAM 26816 . 30355)) (30358 49522 (\TEDIT.GET.FOREIGN.FILE 30368 . 33553) (
+\TEDIT.GET.UNFORMATTED.FILE 33555 . 37429) (\TEDIT.GET.FORMATTED.FILE 37431 . 40219) (
+\TEDIT.FORMATTEDSTREAMP 40221 . 43121) (\ARBIN 43123 . 43843) (\ATMIN 43845 . 44382) (\DWIN 44384 . 
+44763) (\STRINGIN 44765 . 45473) (\TEDIT.GET.TRAILER 45475 . 47991) (\TEDIT.CACHEFILE 47993 . 49520)) 
+(49688 63095 (\TEDIT.GET.PIECES3 49698 . 59857) (\TEDIT.GET.IDATE3 59859 . 61254) (
+\TEDIT.MAKE.STRINGPIECE 61256 . 63093)) (63096 75039 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 63106 . 69222) 
+(\TEDIT.INTERPRET.XCCS.SHIFTS 69224 . 75037)) (75061 81083 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 75071 . 
+81081)) (81106 89610 (\TEDIT.GET.CHARLOOKS.LIST 81116 . 81847) (\TEDIT.GET.SINGLE.CHARLOOKS 81849 . 
+86422) (\TEDIT.GET.CHARLOOKS 86424 . 87754) (\TEDIT.GET.PARALOOKS.INDEX 87756 . 88300) (
+\TEDIT.GET.CHARLOOKS.INDEX 88302 . 89608)) (89611 97849 (\TEDIT.GET.PARALOOKS.LIST 89621 . 90243) (
+\TEDIT.GET.SINGLE.PARALOOKS 90245 . 97257) (\TEDIT.GET.PARALOOKS 97259 . 97847)) (97850 101249 (
+\TEDIT.GET.OBJECT 97860 . 101247)) (101311 133882 (\TEDIT.PUT.PCTB 101321 . 115324) (
+\TEDIT.PUT.TRAILER 115326 . 116093) (\TEDIT.PUT.PCTB.MERGEABLE 116095 . 119613) (
+\TEDIT.PUT.UTF8.SPLITPIECES 119615 . 124702) (\TEDIT.PUT.PCTB.NEXTNEW 124704 . 128479) (
+\TEDIT.INSERT.NEWPIECES 128481 . 131480) (\TEDIT.PUTRESET 131482 . 131724) (\ARBOUT 131726 . 132450) (
+\ATMOUT 132452 . 133057) (\DWOUT 133059 . 133338) (\STRINGOUT 133340 . 133880)) (133883 145276 (
+\TEDIT.PUT.CHARLOOKS.LIST 133893 . 135565) (\TEDIT.PUT.SINGLE.CHARLOOKS 135567 . 140811) (
+\TEDIT.PUT.CHARLOOKS 140813 . 141957) (\TEDIT.PUT.CHARLOOKS1 141959 . 143010) (\TEDIT.PUT.OBJECT 
+143012 . 145274)) (145277 153315 (\TEDIT.PUT.PARALOOKS.LIST 145287 . 146189) (
+\TEDIT.PUT.SINGLE.PARALOOKS 146191 . 152240) (\TEDIT.PUT.PARALOOKS 152242 . 153313)) (153410 155092 (
+TEDITFROMLISPSOURCE 153420 . 155090)))))
 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

scripts/clean_hcfiles.sh

@@ -0,0 +1,143 @@
+#!/bin/sh
+#
+#  clean_hcfiles.sh
+#
+#  Script to clean Medley directory after running do_hcfiles.sh.
+#  Removes pdf files and index.html files created by do_hcfiles.sh.
+#
+#  Caution: uses git clean - so it will delete any untracked files in
+#  the Medley directory tree.
+#
+#  FGH 2024-07-15
+#
+#  Copyright 2024 Interlisp.org
+#
+
+main() {
+
+    MEDLEYDIR=$(cd "${SCRIPTDIR}/.." && pwd)
+    export MEDLEYDIR
+    cd "${MEDLEYDIR}" || exit
+
+    shellfile=/tmp/checkgit-$$.sh
+
+    cat >"${shellfile}" <<-'EOF'
+	#!/bin/sh
+	git status --porcelain "$1" | grep --quiet --no-messages "??"
+	if [ $? -eq 0 ]
+	then
+	rm -f "$1"
+	rm -f "$1".~*~
+	fi
+	EOF
+
+    chmod +x "${shellfile}"
+
+    find . -iname index.html -exec "${shellfile}" {} \;
+    find . -iname \*.pdf -exec "${shellfile}" {} \;
+
+    rm -f "${shellfile}"
+
+}
+
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${SCRIPTDIR}" ]
+then
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        SCRIPTDIR="$(get_script_dir "$0")"
+	export SCRIPTDIR
+
+fi
+
+main "$@"

scripts/do_hcfiles.sh

@@ -0,0 +1,159 @@
+#!/bin/sh
+#
+#  do_hcfiles.sh
+#
+#  Script to run HCFILES in Medley to create PDFs of Medley files as well as
+#  index.html files so that the Medley directory tree plus the generated PDFs can be
+#  stored on and accessed from a web server
+#
+#  FGH 2024-07-15
+#
+#  Copyright 2024 Interlisp.org
+#
+
+main() {
+        MEDLEYDIR=$(cd "${SCRIPTDIR}/.." && pwd)
+        export MEDLEYDIR
+        logindir=/tmp/hcfiles-$$
+        mkdir -p "${logindir}"
+        cmfile=${logindir}/hcfiles.cm
+
+	cat >"${cmfile}" <<-EOF
+	"
+
+	(PROGN
+          (IL:MEDLEY-INIT-VARS 'IL:GREET)
+	  (IL:FILESLOAD MEDLEY-UTILS PDFSTREAM GITFNS))
+          (IL:DRIBBLE '{DSK}${logindir}/hcfiles.dribble)
+          (IL:SETQ IL:*UPPER-CASE-FILE-NAMES* NIL)
+          (IL:SETQ IL:NO-HELP NIL)
+          (IL:ADVISE 'IL:UNSAFE.TO.MODIFY :BEFORE '(RETURN NIL))
+          (IL:ADVISE 'IL:HELP :BEFORE '(IL:COND (IL:NO-HELP (IL:ERROR IL:MESS1 IL:MESS2 T))))
+          (IL:LET ((IL:NO-HELP T)) (DECLARE (SPECIAL IL:NO-HELP)) (IL:HCFILES))
+          (IL:MAKE-INDEX-HTMLS)
+          (IL:DRIBBLE)
+          (IL:LOGOUT T)
+	)
+
+	"
+	EOF
+
+        /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command"     \
+             --config -                                          \
+             --id hcfiles_+                                      \
+             --geometry 1024x768                                 \
+             --noscroll                                          \
+             --logindir "${logindir}"                            \
+             --greet "${cmfile}"                                 \
+             --apps
+
+        # save dribble file to loadups; extract and save fails
+        "${MEDLEYDIR}"/scripts/cpv ${logindir}/HCFILES.DRIBBLE "${MEDLEYDIR}"/loadups/hcfiles.dribble
+        grep "IL:FAIL" < "${MEDLEYDIR}"/loadups/hcfiles.dribble > ${logindir}/fails
+        "${MEDLEYDIR}"/scripts/cpv ${logindir}/fails "${MEDLEYDIR}"/loadups/hcfiles-fails.txt
+
+        # cleanup
+        rm -rf "${logindir}"
+
+}
+
+# shellcheck disable=SC2164,SC2034
+if [ -z "${SCRIPTDIR}" ]
+then
+	#
+	#
+	# Some functions to determine what directory this script is being executed from
+	#
+	#
+	get_abs_filename() {
+	  # $1 : relative filename
+	  echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
+	}
+
+	# This function taken from
+	# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
+	rreadlink() (
+
+	  # Execute this function in a *subshell* to localize variables and the effect of `cd`.
+
+	  target=$1
+	  fname=
+	  targetDir=
+	  CDPATH=
+
+	  # Try to make the execution environment as predictable as possible:
+	  # All commands below are invoked via `command`, so we must make sure that `command`
+	  # itself is not redefined as an alias or shell function.
+	  # (Note that command is too inconsistent across shells, so we don't use it.)
+	  # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
+	  # an external utility version of it (e.g, Ubuntu).
+	  # `command` bypasses aliases and shell functions and also finds builtins 
+	  # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
+	  # to happen.
+	  { \unalias command; \unset -f command; } >/dev/null 2>&1
+	  [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
+
+	  while :; do # Resolve potential symlinks until the ultimate target is found.
+	      [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
+	      command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
+	      fname=$(command basename -- "$target") # Extract filename.
+	      [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
+	      if [ -L "$fname" ]; then
+	        # Extract [next] target path, which may be defined
+	        # *relative* to the symlink's own directory.
+	        # Note: We parse `ls -l` output to find the symlink target
+	        #       which is the only POSIX-compliant, albeit somewhat fragile, way.
+	        target=$(command ls -l "$fname")
+	        target=${target#* -> }
+	        continue # Resolve [next] symlink target.
+	      fi
+	      break # Ultimate target reached.
+	  done
+	  targetDir=$(command pwd -P) # Get canonical dir. path
+	  # Output the ultimate target's canonical path.
+	  # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
+	  if [ "$fname" = '.' ]; then
+	    command printf '%s\n' "${targetDir%/}"
+	  elif  [ "$fname" = '..' ]; then
+	    # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
+	    # AFTER canonicalization.
+	    command printf '%s\n' "$(command dirname -- "${targetDir}")"
+	  else
+	    command printf '%s\n' "${targetDir%/}/$fname"
+	  fi
+	)
+
+	get_script_dir() {
+
+	    # call this with $0 (from main script) as its (only) parameter
+	    # if you need to preserve cwd, run this is a subshell since
+	    # it can change cwd
+
+	    # set -x
+
+	    local_SCRIPT_PATH="$( get_abs_filename "$1" )";
+
+	    while [ -h "$local_SCRIPT_PATH" ];
+	    do
+	        cd "$( dirname -- "$local_SCRIPT_PATH"; )";
+	        local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
+	    done
+
+	    cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
+	    local_SCRIPT_PATH="$( pwd; )";
+
+	    # set +x
+
+	    echo "${local_SCRIPT_PATH}"
+	}
+
+	# end of script directory functions
+	###############################################################################
+
+        # figure out the script dir
+        SCRIPTDIR="$(get_script_dir "$0")"
+	export SCRIPTDIR
+
+fi
+
+main "$@"

scripts/loadup-apps-from-full.sh

@@ -32,20 +32,25 @@ main() {
 	    exit 1
 	fi
 
+    git_commit_ID "${NOTECARDSDIR}"
+    NOTECARDS_COMMIT_ID="${COMMIT_ID}"
+    export NOTECARDS_COMMIT_ID
+
 	cat >"${cmfile}" <<-"EOF"
 	"
 
 	(PROGN
 	   (IL:MEDLEY-INIT-VARS 'IL:GREET)
-	   (IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
+	   (IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble))))
 	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD)
 	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD)
 	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD)
 	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD)
-	   (IL:LOAD
-	       (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM))
-	       'IL:SYSLOAD
-	   )
+	   (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-APPS.LCOM)) 'IL:SYSLOAD)
+       (IL:PRINT (IL:UNIX-GETENV (QUOTE NOTECARDS_COMMIT_ID)))
+       (IL:PUTASSOC (QUOTE IL:MEDLEY) (LIST (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) IL:SYSOUTCOMMITS)
+       (IL:PUTASSOC (QUOTE IL:NOTECARDS) (LIST (IL:UNIX-GETENV (QUOTE NOTECARDS_COMMIT_ID))) IL:SYSOUTCOMMITS)
+       (IL:PRINT IL:SYSOUTCOMMITS)
 	   (IL:HARDRESET)
 	)
 	SHH

scripts/loadup-aux.sh

@@ -17,10 +17,12 @@ main() {
           (DRIBBLE (QUOTE {DSK}<TMP>FOOBAR))
 	  (IL:MAKE-EXPORTS-ALL (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE exports.all))))
 	  (DRIBBLE)
+	  (IL:PUTASSOC (QUOTE IL:MEDLEY) (LIST (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) IL:SYSOUTCOMMITS)
 	  (IL:MAKE-WHEREIS-HASH
 	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.dribble)))
 	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash-tmp)))
 	    (IL:CONCAT WORKDIR (IL:L-CASE (QUOTE whereis.hash)))
+        NIL NIL
 	  )
 	  (IL:LOGOUT T)
 	)

scripts/loadup-db-from-full.sh

@@ -18,6 +18,7 @@ main() {
 
 	(PROG
 	  ((WORKDIR (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /))))
+	  (SETQ IL:SYSOUTCOMMITS (LIST (LIST (QUOTE IL:MEDLEY) (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID)))))
 	  (IL:MEDLEY-INIT-VARS)
 	  (IL:FILESLOAD MEDLEY-UTILS)
 	  (SETQ IL:DIRECTORIES (CONS (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) IL:DIRECTORIES))

scripts/loadup-full-from-lisp.sh

@@ -12,6 +12,7 @@ main() {
 	(PROGN
 	  (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV (QUOTE LOADUP_SOURCEDIR))(QUOTE /LOADUP-FULL.LCOM)))
 	  (IL:LOADUP-FULL (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /full.dribble))))
+	  (IL:PUTASSOC (QUOTE IL:MEDLEY) (LIST (IL:UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) IL:SYSOUTCOMMITS)
 	  (IL:HARDRESET)
 	)
 	SHH

scripts/loadup-init.sh

@@ -12,6 +12,7 @@ main() {
 	(SETQ MEDLEYDIR NIL)
 	(LOAD (CONCAT (UNIX-GETENV "MEDLEYDIR") "/sources/MEDLEYDIR.LCOM"))
 	(MEDLEY-INIT-VARS)
+	(PUTASSOC (QUOTE MEDLEY) (LIST (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) SYSOUTCOMMITS)
 	(CNDIR (UNIX-GETENV "LOADUP_WORKDIR"))
 	(DRIBBLE "init.dribble")
 
@@ -28,15 +29,18 @@ main() {
 	   (LOADUP-SOURCE-DIR (CONCAT "{DSK}" (UNIX-GETENV "LOADUP_SOURCEDIR") "/"))
 	  )
 	  (SETQ DIRECTORIES (CONS LOADUP-SOURCE-DIR DIRECTORIES))
+      (PRINT (DATE))
+	  (PRINT (SETQ SYSOUTCOMMITS (LIST (LIST (QUOTE MEDLEY) (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))))))
 	  (RESETLST (RESETSAVE OK.TO.MODIFY.FNS T)
 	    (MAKEINITGREET (CONCAT WORKDIR "init.sysout") (CONCAT WORKDIR "init.dlinit"))
 	  )
 	)
+
 	(DRIBBLE)
 	(LOGOUT T)
 	STOP
 	EOF
-
+    
 	run_medley "${LOADUP_SOURCEDIR}/starter.sysout"
 
 	loadup_finish "init.dlinit" "init.*" "RDSYS*" "I-NEW*"

scripts/loadup-lisp-from-mid.sh

@@ -5,7 +5,7 @@ main() {
 	. "${LOADUP_SCRIPTDIR}/loadup-setup.sh"
 
 	loadup_start
-
+    
 	cat >"${cmfile}" <<-"EOF"
 	"
 
@@ -14,6 +14,7 @@ main() {
 	  (MEDLEY-INIT-VARS)
 	  (LOAD (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_SOURCEDIR)) (QUOTE /LOADUP-LISP.LCOM)))
 	  (LOADUP-LISP (CONCAT (QUOTE {DSK}) (UNIX-GETENV (QUOTE LOADUP_WORKDIR)) (QUOTE /lisp.dribble)))
+	  (PUTASSOC (QUOTE MEDLEY) (LIST (UNIX-GETENV (QUOTE LOADUP_COMMIT_ID))) SYSOUTCOMMITS)
 	  (HARDRESET)
 	)
 	SHH

scripts/loadup-setup.sh

@@ -50,8 +50,20 @@ then
   fi
 fi
 
+HAS_GIT= [ -f $(which git) ] && [ -x $(which git) ]
+export HAS_GIT
 
+git_commit_ID () {
+  if ${HAS_GIT};
+  then
+    # This does NOT indicate if there are any modified files!
+    COMMIT_ID=$(git -C "$1" rev-parse --short HEAD)
+  fi
+}
 
+git_commit_ID "${LOADUP_SOURCEDIR}"
+LOADUP_COMMIT_ID="${COMMIT_ID}"
+export LOADUP_COMMIT_ID
 
 scr="-sc 1024x768 -g 1042x790"
 geometry=1024x768

scripts/make-gh-pages.md

@@ -3,71 +3,65 @@ HCFILES writes in {MEDLEYDIR} but it should write in something like (SRCDIR)
 
 # setup
 
- github pages are maintained in the 'src' repository as a forked repo
- If you don't have a clone of src: 
-```
-   gh repo clone interlisp/src # make one
-   cd src                      # all other commands 
-```
-the first time once you've cloned, point the 'src' clone 
-```
-   gh remote add upstream https://github.com/interlisp/medley
+## Remove extraneous files
+
+There are lots of ways to get there but basically set up the execution environment with everything clean but notecards loops, test are copied in. If you don't make fresh, at least 'git clean'.
 
 ```
-now update src repository to match 'medley'
-Run these in the 'src' repository!
+gh repo clone interlisp/medley
+gh repo clone interlisp/notecards
+gh repo clone interlisp/loops
+gh repo clone interlisp/test
 
-```
-   git fetch upstream                # pull down remote branches
-   git checkout master               # make sure you're in master
-   git rebase upstream/master        # update src's master
-                                      # to latest medley's master
-   git push -f origin master          # push back go sfc
+cp -r notecards loops test medley
+rm -rf notecards/.git loops/.git test/.git
 ```
 
-# Run Medly to create PDFs.
+# making the .pdfs and index.html files
 
-Start with the apps sysout to spare yourself package problems
-In an Interlisp exec:
+## best start with a fresh loadup
 ```
-  (FILESLOAD PDFSTREAM GITFNS MEDLEY-UTILS)
-  (HCFILES)
-  (MAKE-INDEX-HTMLS)
-```
-check out that it looks right if you point your browser the index/index.hrml at the top level
-
-# deploying
-
-* find the current release tags
-Not sure how to do that.
-
-```
-   wget -l 1 https://github.com/interlisp/medley/releases/latest
-```
-will retrieve a 3xx redirect from the web server;
-But all you need is the name, not the web page.
-anyway, assuming the release is medley-YYMMDD-xxxxxxx. 
-
-put release name in variable
-```
-  export release=medley-240420-1234567
-```
-## make a new branch
-```
-   git checkout -b pages-$release
-```
-*temporarily* change .gitignore to allow checkin of pdfs and index.html
-```
-cp .gitignore /tmp/save$release
-cp .gitignore.for.pages .gitignore
-```
-Now you can push this to the github-pages
-```
-	git add .
-	git commit -m "rerun making ghpages and index"
-	git push
+./scripts/loadup-all.sh
 ```
 
+# Now run in Medley "apps" loadup 
+```
+  ./medley -a &
+```
+and enter the following to make the PDFs and the index.html files that links them.
 
+```
+(DRIBBLE "medley/loadups/hcfiles.dribble")
 
+(FILESLOAD MEDLEY-UTILS PDFSTREAM GITFNS)
+
+(SETQ NO-HELP NIL)
+ADVISE(HELP :BEFORE (IF NO-HELP THEN ( (ERROR MESS1 MESS2)))
+    (LET ((NO-HELP T)) (DECLARE (SPECIAL NO-HELP)) (HCFILES)))
+
+(MAKE-INDEX-HTML)
+```
+# Deploying
+
+The trick is to take a repository based on the master branch of medley and produce a gh-pages branch in the Interlisp/src reposiory.
+
+```
+git remote set-url --push https://github.com/Interlisp/src
+git branch -D gh-pages  ## if necessary
+git checkout -b gh-pages ## make the current directory content the same
+
+## make sure the .gitignore DOESN'T ignore .pdf and index.html files
+
+git add .
+git commit -m "add created pdf's and index.html's"
+git push --force
+
+# Put it all back
+
+after you've done this, you can clean up (from the medley folder):
+```
+find . -iname "*.pdf" -exec rm {} \;
+git remote set-url --push https://github.com/Interlisp/medley
+rm -rf loops notecards test
+```
 

scripts/medley/medley.command

@@ -318,15 +318,20 @@ IL_DIR="$(cd "${MEDLEYDIR}/.."; pwd)"
 wsl=false
 darwin=false
 cygwin=false
+linux=false
+platform=unknown
 
 if [ "$(uname)" = "Darwin" ]
 then
   darwin=true
+  platform=darwin
 elif [ "$(uname -s | head --bytes 6)" = "CYGWIN" ]
 then
   cygwin=true
+  platform=cgwin
 elif [ -e "/proc/version" ] && grep --ignore-case --quiet Microsoft /proc/version
 then
+  platform=wsl
   wsl=true
   wsl_ver=0
   # WSL2
@@ -351,7 +356,19 @@ Exiting"
       fi
     fi
   fi
+else
+  linux=true
+  platform=linux
 fi
+#################### TEST CODE ####################
+
+#wsl=false
+#darwin=false
+#cygwin=false
+#linux=true
+#platform=linux
+
+#################### TEST CODE ####################
 
 # process config file and args
 # shellcheck source=./medley_configfile.sh
@@ -552,8 +569,8 @@ flags:
     -t STRING | --title STRING : use STRING as title of window
 
     -d :N | --display :N       : use X display :N
-+w
-+w  -v | --vnc                 : (WSL only) Use a VNC window instead of an X window
+
+    -v | --vnc                 : Use a VNC window instead of an X window (Not available: MacOS & Windows/Cygwin)
 
     -i STRING | --id STRING    : use STRING as the id for this run of Medley (default: default)
 
@@ -805,13 +822,32 @@ do
             use_vnc=true
             ;;
         esac
-        if [ "${use_vnc}" = true ] && { [ ! "${wsl}" = true ] || [ ! "$(uname -m)" = x86_64 ] ; }
+        if [ "${use_vnc}" = true ]
         then
-          echo "Warning: The -v or --vnc flag was set."
-          echo "But the vnc option is only available when running on "
-          echo "Windows System for Linux (wsl) on x86_64 machines."
-          echo "Ignoring the -v or --vnc flag."
-          use_vnc=false
+          case ${platform} in
+            darwin)
+              echo "Warning The -v (--vnc) flag was set, but the vnc option is"
+              echo "not available on MacOS.  Ignoring the -v (--vnc) flag."
+              use_vnc=false
+              ;;
+            cygwin)
+              echo "Warning The -v (--vnc) flag was set, but the vnc option is"
+              echo "not available on Windows (Cygwin).  Ignoring the -v (--vnc) flag."
+              use_vnc=false
+              ;;
+	    wsl)
+              if [ ! "$(uname -m)" = x86_64 ]
+              then
+                echo "Warning: The -v or --vnc flag was set."
+                echo "But the vnc option is only available when running on "
+                echo "Windows System for Linux (wsl) on x86_64 machines."
+                echo "Ignoring the -v or --vnc flag."
+                use_vnc=false
+              fi
+              ;;
+            linux)
+              ;;
+          esac
         fi
         ;;
       -x | --logindir)
@@ -1380,9 +1416,9 @@ fi
 
 
 # Run maiko either directly or with vnc
-if [ "${wsl}" = true ] && [ "${use_vnc}" = true ]
+if [ "${use_vnc}" = true ]
 then
-  # do the vnc thing on wsl (if called for)
+  # do the vnc thing - if called for
   # shellcheck source=./medley_vnc.sh
 #   . "${SCRIPTDIR}/medley_vnc.sh"
 # shellcheck shell=sh
@@ -1402,9 +1438,14 @@ then
 #   Copyright 2023 Interlisp.org
 #
 ###############################################################################
-
+#set -x
   ip_addr() {
-    ip -4 -br address show dev eth0 | awk '{print $3}' | sed 's-/.*$--'
+    if [ "${wsl}" = true ]
+    then
+      ip -4 -br address show dev eth0 | awk '{print $3}' | sed 's-/.*$--'
+    else
+      echo "127.0.0.1"
+    fi
   }
 
   find_open_display() {
@@ -1446,21 +1487,39 @@ then
   }
 
   #
-  # Make sure prequisites for vnc support in wsl are in place
+  # Make sure prequisites for vnc support are in place
   #
-  if [ "${use_vnc}" = "true" ];
+  if [ -z "$(which Xtigervnc)" ]
+  then
+    echo "Error: The -v or --vnc flag was set."
+    echo "But it appears that the TigerVNC server (Xtigervnc) has not been installed."
+    echo "Please install the TigerVNC server and try again.  On Debian and Ubuntu, use:"
+    echo "\"sudo apt install tigervnc-standalone-server\". On most other Linux distros, use the"
+    echo "distro's package manager to install the \"tigervnc-server\" package."
+    echo "Exiting."
+    exit 4
+  fi
+  if [ "${linux}" = "true" ]
+  then
+    if [ -z "$(which xtigervncviewer)" ]
+    then
+      echo "Error: The -v or --vnc flag was set."
+      echo "But it appears that that the TigerVNC viewer (xtigervncviewer) is not installed on your system."
+      echo "Please install the TigerVNC viewer and try again.  On Debian and Ubuntu, use:"
+      echo "\"sudo apt install tigervnc-viewer\".  On most other Linux distros, use the"
+      echo "the distro's package manager to install the \"tigervnc-viewer\" (or sometimes just \"tigervnc\")"
+      echo "package."
+      echo "Exiting."
+      exit 5
+    else
+       vncviewer="$(which xtigervncviewer)"
+    fi
+  elif [ "${wsl}" = "true" ]
   then
     win_userprofile="$(cmd.exe /c "<nul set /p=%UserProfile%" 2>/dev/null)"
     vnc_dir="$(wslpath "${win_userprofile}")/AppData/Local/Interlisp"
     vnc_exe="vncviewer64-1.12.0.exe"
-    if [ "$(which Xvnc)" = "" ] || [ "$(Xvnc -version 2>&1 | grep -iq tigervnc; echo $?)" -eq 1 ]
-    then
-      echo "Error: The -v or --vnc flag was set."
-      echo "But it appears that that TigerVNC \(Xvnc\) has not been installed."
-      echo "Please install TigerVNC using \"sudo apt install tigervnc-standalone-server tigervnc-xorg-extension\""
-      echo "Exiting."
-      exit 4
-    elif [ ! -e "${vnc_dir}/${vnc_exe}" ];
+    if [ ! -e "${vnc_dir}/${vnc_exe}" ];
     then
       if [ -e "${IL_DIR}/wsl/${vnc_exe}" ];
       then
@@ -1478,7 +1537,7 @@ then
           if [ -z "${resp}" ]; then resp=n; fi
           case "${resp}" in
             n* | N* )
-              echo "Ok.  You can download the Tiger VNC viewer \(v1.12.0\) .exe yourself and "
+              echo "Ok.  You can download the Tiger VNC viewer (v1.12.0) .exe yourself and "
               echo "place it in ${vnc_dir}/${vnc_exe}.  Then retry."
               echo "Exiting."
               exit 5
@@ -1494,6 +1553,7 @@ then
         done
       fi
     fi
+    vncviewer="${vnc_dir}/${vnc_exe}"
   fi
   #
   #  Start the log file so we can trace any issues with vnc, etc
@@ -1513,6 +1573,7 @@ then
   #    find an unused display and an available port
   #
   #set -x
+  ORIGINAL_DISPLAY="${DISPLAY}"
   OPEN_DISPLAY="$(find_open_display)"
   if [ "${OPEN_DISPLAY}" -eq -1 ];
   then
@@ -1539,15 +1600,15 @@ then
   #  Start the Xvnc server
   #
   mkdir -p "${LOGINDIR}"/logs
-  /usr/bin/Xvnc "${DISPLAY}" \
-                -rfbport "${VNC_PORT}" \
-                -geometry "${geometry}" \
-                -SecurityTypes None \
-                -NeverShared \
-                -DisconnectClients=0 \
-                -desktop "${title}" \
-                --MaxDisconnectionTime=10 \
-                >> "${LOG}" 2>&1 &
+  Xvnc "${DISPLAY}" \
+       -rfbport "${VNC_PORT}" \
+       -geometry "${geometry}" \
+       -SecurityTypes None \
+       -NeverShared \
+       -DisconnectClients=0 \
+       -desktop "${title}" \
+       --MaxDisconnectionTime=10 \
+       >> "${LOG}" 2>&1 &
 
   sleep .5
   #
@@ -1557,25 +1618,24 @@ then
     start_maiko "$@"
     if [ -n "$(pgrep -f "${vnc_exe}.*:${VNC_PORT}")" ]; then vncconfig -disconnect; fi
   } &
-
   #
-  #  Start the vncviewer on the windows side
+  #  Start the vncviewer
   #
 
   #  First give medley time to startup
   #  sleep .25
-  #  SLeep appears not to be needed, but faster/slower machines ????
+  #  Sleep appears not to be needed, but faster/slower machines ????
   #  FGH 2023-02-08
 
-  #  Then start vnc viewer on Windows side
+  #  Then start vnc viewer
   vncv_loc=$(( OPEN_DISPLAY * 50 ))
   start_time=$(date +%s)
-  "${vnc_dir}"/${vnc_exe}                           \
-               -geometry "+${vncv_loc}+${vncv_loc}" \
-               -ReconnectOnError=off                \
-               −AlertOnFatalError=off               \
-               "$(ip_addr)":"${VNC_PORT}"           \
-               >>"${LOG}" 2>&1                      &
+  export DISPLAY="${ORIGINAL_DISPLAY}"
+  "${vncviewer}" -geometry "+${vncv_loc}+${vncv_loc}"  \
+                 −AlertOnFatalError=0                  \
+                 -ReconnectOnError=0                   \
+                 "$(ip_addr)":"${VNC_PORT}"            \
+                 >>"${LOG}" 2>&1                       &
   wait $!
   if [ $(( $(date +%s) - start_time )) -lt 5 ]
   then

scripts/medley/medley_args.sh

@@ -239,13 +239,32 @@ do
             use_vnc=true
             ;;
         esac
-        if [ "${use_vnc}" = true ] && { [ ! "${wsl}" = true ] || [ ! "$(uname -m)" = x86_64 ] ; }
+        if [ "${use_vnc}" = true ]
         then
-          echo "Warning: The -v or --vnc flag was set."
-          echo "But the vnc option is only available when running on "
-          echo "Windows System for Linux (wsl) on x86_64 machines."
-          echo "Ignoring the -v or --vnc flag."
-          use_vnc=false
+          case ${platform} in
+            darwin)
+              echo "Warning The -v (--vnc) flag was set, but the vnc option is"
+              echo "not available on MacOS.  Ignoring the -v (--vnc) flag."
+              use_vnc=false
+              ;;
+            cygwin)
+              echo "Warning The -v (--vnc) flag was set, but the vnc option is"
+              echo "not available on Windows (Cygwin).  Ignoring the -v (--vnc) flag."
+              use_vnc=false
+              ;;
+	    wsl)
+              if [ ! "$(uname -m)" = x86_64 ]
+              then
+                echo "Warning: The -v or --vnc flag was set."
+                echo "But the vnc option is only available when running on "
+                echo "Windows System for Linux (wsl) on x86_64 machines."
+                echo "Ignoring the -v or --vnc flag."
+                use_vnc=false
+              fi
+              ;;
+            linux)
+              ;;
+          esac
         fi
         ;;
       -x | --logindir)

scripts/medley/medley_main.sh

@@ -128,15 +128,20 @@ IL_DIR="$(cd "${MEDLEYDIR}/.."; pwd)"
 wsl=false
 darwin=false
 cygwin=false
+linux=false
+platform=unknown
 
 if [ "$(uname)" = "Darwin" ]
 then
   darwin=true
+  platform=darwin
 elif [ "$(uname -s | head --bytes 6)" = "CYGWIN" ]
 then
   cygwin=true
+  platform=cgwin
 elif [ -e "/proc/version" ] && grep --ignore-case --quiet Microsoft /proc/version
 then
+  platform=wsl
   wsl=true
   wsl_ver=0
   # WSL2
@@ -161,7 +166,19 @@ Exiting"
       fi
     fi
   fi
+else
+  linux=true
+  platform=linux
 fi
+#################### TEST CODE ####################
+
+#wsl=false
+#darwin=false
+#cygwin=false
+#linux=true
+#platform=linux
+
+#################### TEST CODE ####################
 
 # process config file and args
 # shellcheck source=./medley_configfile.sh

scripts/medley/medley_run.sh

@@ -327,9 +327,9 @@ fi
 
 
 # Run maiko either directly or with vnc
-if [ "${wsl}" = true ] && [ "${use_vnc}" = true ]
+if [ "${use_vnc}" = true ]
 then
-  # do the vnc thing on wsl (if called for)
+  # do the vnc thing - if called for
   # shellcheck source=./medley_vnc.sh
   . "${SCRIPTDIR}/medley_vnc.sh"
 else

scripts/medley/medley_usage.sh

@@ -98,8 +98,8 @@ flags:
     -t STRING | --title STRING : use STRING as title of window
 
     -d :N | --display :N       : use X display :N
-+w
-+w  -v | --vnc                 : (WSL only) Use a VNC window instead of an X window
+
+    -v | --vnc                 : Use a VNC window instead of an X window (Not available: MacOS & Windows/Cygwin)
 
     -i STRING | --id STRING    : use STRING as the id for this run of Medley (default: default)
 

scripts/medley/medley_vnc.sh

@@ -16,9 +16,14 @@
 #   Copyright 2023 Interlisp.org
 #
 ###############################################################################
-
+#set -x
   ip_addr() {
-    ip -4 -br address show dev eth0 | awk '{print $3}' | sed 's-/.*$--'
+    if [ "${wsl}" = true ]
+    then
+      ip -4 -br address show dev eth0 | awk '{print $3}' | sed 's-/.*$--'
+    else
+      echo "127.0.0.1"
+    fi
   }
 
   find_open_display() {
@@ -60,21 +65,39 @@
   }
 
   #
-  # Make sure prequisites for vnc support in wsl are in place
+  # Make sure prequisites for vnc support are in place
   #
-  if [ "${use_vnc}" = "true" ];
+  if [ -z "$(which Xtigervnc)" ]
+  then
+    echo "Error: The -v or --vnc flag was set."
+    echo "But it appears that the TigerVNC server (Xtigervnc) has not been installed."
+    echo "Please install the TigerVNC server and try again.  On Debian and Ubuntu, use:"
+    echo "\"sudo apt install tigervnc-standalone-server\". On most other Linux distros, use the"
+    echo "distro's package manager to install the \"tigervnc-server\" package."
+    echo "Exiting."
+    exit 4
+  fi
+  if [ "${linux}" = "true" ]
+  then
+    if [ -z "$(which xtigervncviewer)" ]
+    then
+      echo "Error: The -v or --vnc flag was set."
+      echo "But it appears that that the TigerVNC viewer (xtigervncviewer) is not installed on your system."
+      echo "Please install the TigerVNC viewer and try again.  On Debian and Ubuntu, use:"
+      echo "\"sudo apt install tigervnc-viewer\".  On most other Linux distros, use the"
+      echo "the distro's package manager to install the \"tigervnc-viewer\" (or sometimes just \"tigervnc\")"
+      echo "package."
+      echo "Exiting."
+      exit 5
+    else
+       vncviewer="$(which xtigervncviewer)"
+    fi
+  elif [ "${wsl}" = "true" ]
   then
     win_userprofile="$(cmd.exe /c "<nul set /p=%UserProfile%" 2>/dev/null)"
     vnc_dir="$(wslpath "${win_userprofile}")/AppData/Local/Interlisp"
     vnc_exe="vncviewer64-1.12.0.exe"
-    if [ "$(which Xvnc)" = "" ] || [ "$(Xvnc -version 2>&1 | grep -iq tigervnc; echo $?)" -eq 1 ]
-    then
-      echo "Error: The -v or --vnc flag was set."
-      echo "But it appears that that TigerVNC \(Xvnc\) has not been installed."
-      echo "Please install TigerVNC using \"sudo apt install tigervnc-standalone-server tigervnc-xorg-extension\""
-      echo "Exiting."
-      exit 4
-    elif [ ! -e "${vnc_dir}/${vnc_exe}" ];
+    if [ ! -e "${vnc_dir}/${vnc_exe}" ];
     then
       if [ -e "${IL_DIR}/wsl/${vnc_exe}" ];
       then
@@ -92,7 +115,7 @@
           if [ -z "${resp}" ]; then resp=n; fi
           case "${resp}" in
             n* | N* )
-              echo "Ok.  You can download the Tiger VNC viewer \(v1.12.0\) .exe yourself and "
+              echo "Ok.  You can download the Tiger VNC viewer (v1.12.0) .exe yourself and "
               echo "place it in ${vnc_dir}/${vnc_exe}.  Then retry."
               echo "Exiting."
               exit 5
@@ -108,6 +131,7 @@
         done
       fi
     fi
+    vncviewer="${vnc_dir}/${vnc_exe}"
   fi
   #
   #  Start the log file so we can trace any issues with vnc, etc
@@ -127,6 +151,7 @@
   #    find an unused display and an available port
   #
   #set -x
+  ORIGINAL_DISPLAY="${DISPLAY}"
   OPEN_DISPLAY="$(find_open_display)"
   if [ "${OPEN_DISPLAY}" -eq -1 ];
   then
@@ -153,15 +178,15 @@
   #  Start the Xvnc server
   #
   mkdir -p "${LOGINDIR}"/logs
-  /usr/bin/Xvnc "${DISPLAY}" \
-                -rfbport "${VNC_PORT}" \
-                -geometry "${geometry}" \
-                -SecurityTypes None \
-                -NeverShared \
-                -DisconnectClients=0 \
-                -desktop "${title}" \
-                --MaxDisconnectionTime=10 \
-                >> "${LOG}" 2>&1 &
+  Xvnc "${DISPLAY}" \
+       -rfbport "${VNC_PORT}" \
+       -geometry "${geometry}" \
+       -SecurityTypes None \
+       -NeverShared \
+       -DisconnectClients=0 \
+       -desktop "${title}" \
+       --MaxDisconnectionTime=10 \
+       >> "${LOG}" 2>&1 &
 
   sleep .5
   #
@@ -171,25 +196,24 @@
     start_maiko "$@"
     if [ -n "$(pgrep -f "${vnc_exe}.*:${VNC_PORT}")" ]; then vncconfig -disconnect; fi
   } &
-
   #
-  #  Start the vncviewer on the windows side
+  #  Start the vncviewer
   #
 
   #  First give medley time to startup
   #  sleep .25
-  #  SLeep appears not to be needed, but faster/slower machines ????
+  #  Sleep appears not to be needed, but faster/slower machines ????
   #  FGH 2023-02-08
 
-  #  Then start vnc viewer on Windows side
+  #  Then start vnc viewer
   vncv_loc=$(( OPEN_DISPLAY * 50 ))
   start_time=$(date +%s)
-  "${vnc_dir}"/${vnc_exe}                           \
-               -geometry "+${vncv_loc}+${vncv_loc}" \
-               -ReconnectOnError=off                \
-               −AlertOnFatalError=off               \
-               "$(ip_addr)":"${VNC_PORT}"           \
-               >>"${LOG}" 2>&1                      &
+  export DISPLAY="${ORIGINAL_DISPLAY}"
+  "${vncviewer}" -geometry "+${vncv_loc}+${vncv_loc}"  \
+                 −AlertOnFatalError=0                  \
+                 -ReconnectOnError=0                   \
+                 "$(ip_addr)":"${VNC_PORT}"            \
+                 >>"${LOG}" 2>&1                       &
   wait $!
   if [ $(( $(date +%s) - start_time )) -lt 5 ]
   then

sources/CMLREAD

@@ -1,17 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Jul-2022 23:31:31" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CMLREAD.;15
 12803  
+
(FILECREATED "23-Sep-2024 11:55:33" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;4
 12882  
 
-      :CHANGES-TO (FNS CL:PEEK-CHAR)
+      :EDIT-BY "mth"
 
-      :PREVIOUS-DATE "16-Aug-2021 23:42:49" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>CMLREAD.;14)
+      :CHANGES-TO (FNS CL:READ-FROM-STRING)
 
+      :PREVIOUS-DATE "16-Sep-2024 12:26:09" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;3)
 
-(* ; "
-Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT CMLREADCOMS)
 
@@ -188,16 +184,19 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
 
 (CL:READ-FROM-STRING

   [CL:LAMBDA (STRING &OPTIONAL EOF-ERROR-P EOF-VALUE &KEY START END PRESERVE-WHITESPACE)

+                                                             (* ; "Edited 23-Sep-2024 11:47 by mth")


+                                                             (* ; "Edited 16-Sep-2024 12:22 by mth")


                                                            (* ; "Edited  8-Jun-90 14:15 by ymasuda")

          (LET [(STREAM (OPENSTRINGSTREAM (COND
                                             [END (SUBSTRING STRING 1 (IMIN END (NCHARS STRING]
                                             (T (MKSTRING STRING]
-              (COND
-                 (START (SETFILEPTR STREAM START)))
+              [COND
+                 (START (SETFILEPTR STREAM (UNFOLD START 2]
               (CL:VALUES (CL:IF PRESERVE-WHITESPACE
                              (CL:READ-PRESERVING-WHITESPACE STREAM EOF-ERROR-P EOF-VALUE)
                              (CL:READ STREAM EOF-ERROR-P EOF-VALUE))
-                     (\GETFILEPTR STREAM])
+                     (FOLDLO (\GETFILEPTR STREAM)
+                            2])
 
 (CL:READ-BYTE

   [CL:LAMBDA (BINARY-INPUT-STREAM &OPTIONAL (EOF-ERRORP T)
@@ -287,11 +286,10 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
 (ADDTOVAR LAMA
 CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR 
                      CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
 )
-(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2525 3510 (CL:COPY-READTABLE 2535 . 3508)) (3511 10454 (CL:READ-LINE 3521 . 4393) (
-CL:READ-CHAR 4395 . 4945) (CL:UNREAD-CHAR 4947 . 5408) (CL:PEEK-CHAR 5410 . 7704) (CL:LISTEN 7706 . 
-7971) (CL:READ-CHAR-NO-HANG 7973 . 8745) (CL:CLEAR-INPUT 8747 . 8984) (CL:READ-FROM-STRING 8986 . 9741
-) (CL:READ-BYTE 9743 . 10196) (CL:WRITE-BYTE 10198 . 10452)) (11448 11921 (WITH-READER-ENVIRONMENT 
-11448 . 11921)))))
+  (FILEMAP (NIL (2433 3418 (CL:COPY-READTABLE 2443 . 3416)) (3419 10627 (CL:READ-LINE 3429 . 4301) (
+CL:READ-CHAR 4303 . 4853) (CL:UNREAD-CHAR 4855 . 5316) (CL:PEEK-CHAR 5318 . 7612) (CL:LISTEN 7614 . 
+7879) (CL:READ-CHAR-NO-HANG 7881 . 8653) (CL:CLEAR-INPUT 8655 . 8892) (CL:READ-FROM-STRING 8894 . 9914
+) (CL:READ-BYTE 9916 . 10369) (CL:WRITE-BYTE 10371 . 10625)) (11621 12094 (WITH-READER-ENVIRONMENT 
+11621 . 12094)))))
 STOP

sources/DEFPACKAGE-IMPORT

@@ -1,28 +1,35 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED "16-May-90 15:31:19" {DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;2
 1000   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS DEFPACKAGE-IMPORTCOMS)
+
(FILECREATED " 5-Sep-2024 22:33:36" {DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2
 1161   
 
-      previous date%: "12-Dec-86 13:26:35" {DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;1
-)
+      :EDIT-BY "mth"
 
+      :CHANGES-TO (VARS DEFPACKAGE-IMPORTCOMS)
+
+      :PREVIOUS-DATE "16-May-90 15:31:19" 
+{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;1)
 
-(* ; "
-Copyright (c) 1986, 1990 by Venue & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
 
 (RPAQQ DEFPACKAGE-IMPORTCOMS
 ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
-                                            "INTERLISP"))
-                                  (PROP MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
+                                        "INTERLISP")
+                                 (IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
+                                        "LISP")
+                                 (EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP")
+                                        "LISP"))
+                              (PROP MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
 
 (IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
        "INTERLISP")
 
-(PUTPROPS DEFPACKAGE-IMPORT
 MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"
-                                                                ))
-(PUTPROPS DEFPACKAGE-IMPORT COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
+(IMPORT (CL:INTERN "DEFPACKAGE" "XCL")
+       "LISP")
+
+(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP")
+       "LISP")
+
+(PUTPROPS DEFPACKAGE-IMPORT
 MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP

sources/DEFPACKAGE-IMPORT.LCOM

@@ -1 +1,17 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jan-98 12:25:04" ("compiled on " {DSK}<lispcore>sources>DEFPACKAGE-IMPORT.;1) 
"30-Mar-95 20:33:04" bcompl'd in "Medley 14-Aug-95 ..." dated "14-Aug-95 15:27:48")
(FILECREATED "16-May-90 15:31:19" {DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;2 1000 
changes to%: (VARS DEFPACKAGE-IMPORTCOMS) previous date%: "12-Dec-86 13:26:35" 
{DSK}<usr>local>lde>lispcore>sources>DEFPACKAGE-IMPORT.;1)
(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")) (PROP 
MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")
(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS DEFPACKAGE-IMPORT COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
NIL
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+(FILECREATED " 5-Sep-2024 22:35:06" ("compiled on " 
+{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2) "31-Jul-2024 02:24:35" tcompl'd in 
+"FULL 31-Jul-2024 ..." dated "31-Jul-2024 02:24:38")
+(FILECREATED " 5-Sep-2024 22:33:36" {DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;2 1161
+ :EDIT-BY "mth" :CHANGES-TO (VARS DEFPACKAGE-IMPORTCOMS) :PREVIOUS-DATE "16-May-90 15:31:19" 
+{DSK}<home>matt>Interlisp>medley>sources>DEFPACKAGE-IMPORT.;1)
+(PRETTYCOMPRINT DEFPACKAGE-IMPORTCOMS)
+(RPAQQ DEFPACKAGE-IMPORTCOMS ((P (IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP") (IMPORT (CL:INTERN
+ "DEFPACKAGE" "XCL") "LISP") (EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP") "LISP")) (PROP 
+MAKEFILE-ENVIRONMENT DEFPACKAGE-IMPORT)))
+(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "INTERLISP")
+(IMPORT (CL:INTERN "DEFPACKAGE" "XCL") "LISP")
+(EXPORT (CL:FIND-SYMBOL "DEFPACKAGE" "LISP") "LISP")
+(PUTPROPS DEFPACKAGE-IMPORT MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
+NIL

sources/INSPECT

@@ -1,18 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Sep-2023 23:40:42" {WMEDLEY}<sources>INSPECT.;28
 124779 
+
(FILECREATED " 4-Jul-2024 12:16:52" {WMEDLEY}<sources>INSPECT.;31
 126551 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS INSPECTABLEFIELDNAMES)
+      :CHANGES-TO (VARS INSPECTCOMS)
 
-      :PREVIOUS-DATE "15-Jun-2023 16:03:17" {WMEDLEY}<sources>INSPECT.;27)
+      :PREVIOUS-DATE " 4-Jul-2024 11:11:46" {WMEDLEY}<sources>INSPECT.;30)
 
 
-(* ; "
-Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
-")
-
 (PRETTYCOMPRINT INSPECTCOMS)
 
 (RPAQQ INSPECTCOMS

@@ -71,6 +67,11 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
                                                  11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 
                                                  28 29 30 31)
                                      GETTTBLPROP SETTTBLPROP]
+        [COMS                                                (* ; 
+
                                                           "Show USERDATA in the main inspect window")

+              (FNS WINDOW\INSPECTPROPS WINDOW\PROPFETCHFN WINDOW\PROPSTOREFN)
+              (ADDVARS (INSPECTMACROS (WINDOW WINDOW\INSPECTPROPS WINDOW\PROPFETCHFN 
+                                             WINDOW\PROPSTOREFN]
         (COMS                                                (* ; "Hunk inspector")

               (FNS INSPECT/AS/BLOCKRECORD INSPECT/TYPELESS LIST-ALL-BLOCKRECORDS INSPECT/HUNK 
                    \INSPECT.DATATYPE.RAW.FETCH \INSPECT.FETCH.8 \INSPECT.FETCH.32 \INSPECT.FETCH.CHAR
@@ -2054,6 +2055,41 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
 
 
 
+(* ; "Show USERDATA in the main inspect window")

+
+(DEFINEQ
+
+(WINDOW\INSPECTPROPS

+  [LAMBDA (WINDOW)
                                           (* ; "Edited  4-Jul-2024 00:03 by rmk")


+                                                             (* ; "Edited 30-Jun-2024 09:04 by rmk")

+
+    (* ;; "Stick the user properties at the end with --USERDATA-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.")

+
+    (LET ([WFIELDS (REMOVE 'USERDATA (INSPECTABLEFIELDNAMES
 (SYSRECLOOK1 'WINDOW]
+          (UFIELDS (for
 X in
 (fetch
 (WINDOW USERDATA) of
 WINDOW) by
 (CDDR X) collect
 X)))
+         (CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS)
+                        (MEMB 'WINDOW INSPECTDONTSORTFIELDS))
+             (SETQ UFIELDS (SORT UFIELDS)))
+         (APPEND WFIELDS (CONS '--USERDATA--)
+                UFIELDS])
+
+(WINDOW\PROPFETCHFN

+  [LAMBDA (WINDOW PROPNAME)
                                  (* ; "Edited  3-Jul-2024 23:56 by rmk")


+                                                             (* ; "Edited 29-Jun-2024 22:57 by rmk")

+    (if
 (EQ PROPNAME '--USERDATA--)
+        then
 '------
+      else
 (GETWINDOWPROP WINDOW PROPNAME])
+
+(WINDOW\PROPSTOREFN

+  [LAMBDA (WINDOW PROPNAME VALUE)
                            (* ; "Edited 30-Jun-2024 08:52 by rmk")

+    (CL:UNLESS (EQ PROPNAME '--USERDATA--)
+           (PUTWINDOWPROP WINDOW PROPNAME VALUE])
+)
+
+(ADDTOVAR INSPECTMACROS
 (WINDOW WINDOW\INSPECTPROPS WINDOW\PROPFETCHFN WINDOW\PROPSTOREFN))
+
+
+
 (* ; "Hunk inspector")

 
 (DEFINEQ
@@ -2221,43 +2257,43 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
          ("As 32-bit array" '(32 \INSPECT.FETCH.32 \INSPECT.STORE.32))
          ("As Character array" '(8 \INSPECT.FETCH.CHAR \INSPECT.STORE.CHAR))
          ("As Fat Character array" '(16 \INSPECT.FETCH.FATCHAR \INSPECT.STORE.FATCHAR])
-(PUTPROPS INSPECT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991 1993 
-1995 1999 2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7001 45354 (INSPECTW.CREATE 7011 . 12306) (INSPECTW.REPAINTFN 12308 . 17844) (
-INSPECTW.REDISPLAY 17846 . 26718) (\INSPECTW.VALUE.MARGIN 26720 . 27123) (INSPECTW.REPLACE 27125 . 
-27833) (INSPECTW.SELECTITEM 27835 . 28825) (\INSPECTW.REDISPLAYPROP 28827 . 31257) (INSPECTW.FETCH 
-31259 . 31682) (INSPECTW.PROPERTIES 31684 . 32325) (DECODE.WINDOW.ARG 32327 . 34055) (
-DEFAULT.INSPECTW.PROPCOMMANDFN 34057 . 36085) (DEFAULT.INSPECTW.VALUECOMMANDFN 36087 . 37503) (
-DEFAULT.INSPECTW.TITLECOMMANDFN 37505 . 40954) (\SELITEM.FROM.PROPERTY 40956 . 41398) (
-\INSPECT.COMPUTE.TITLE 41400 . 42684) (LEVELEDFORM 42686 . 43405) (MAKEWITHINREGION 43407 . 45352)) (
-45355 62660 (ITEMW.REPAINTFN 45365 . 46585) (\ITEM.WINDOW.BUTTON.HANDLER 46587 . 47006) (
-\ITEM.WINDOW.SELECTION.HANDLER 47008 . 49675) (\INSPECTW.COMMAND.HANDLER 49677 . 53678) (
-ITEM.WINDOW.SET.STACK.ARG 53680 . 55884) (REPLACESTKARG 55886 . 56985) (IN/ITEM? 56987 . 57869) (
-\ITEMW.DESELECTITEM 57871 . 58135) (\ITEMW.SELECTITEM 58137 . 58399) (\ITEMW.CLEARSELECTION 58401 . 
-58756) (\ITEMW.FLIPITEM 58758 . 59231) (PRINTANDBOX 59233 . 61742) (PRINTATBOX 61744 . 62261) (
-ITEMOFPROPERTYVALUE 62263 . 62658)) (62661 66402 (\ITEM.WINDOW.COPY.HANDLER 62671 . 64528) (
-\ITEMW.FLIPCOPY 64530 . 64989) (BKSYSBUF.GENERAL 64991 . 66400)) (66794 91709 (INSPECT 66804 . 71334) 
-(\APPLYINSPECTMACRO 71336 . 72397) (INSPECT/BITMAP 72399 . 73551) (INSPECT/DATATYPE 73553 . 77067) (
-INSPECTABLEFIELDNAMES 77069 . 78402) (REMOVEDUPS 78404 . 78609) (INSPECT/ARRAY 78611 . 79676) (
-INSPECT/TOP/LEVEL/LIST 79678 . 80795) (INSPECT/PROPLIST 80797 . 81885) (NONSYSPROPNAMES 81887 . 82183)
- (INSPECT/LISTP 82185 . 82624) (ALISTP 82626 . 82835) (PROPLISTP 82837 . 83477) (INSPECT/ALIST 83479
- . 83955) (ASSOCGET 83957 . 84168) (/ASSOCPUT 84170 . 84435) (INSPECT/PLIST 84437 . 84921) (
-INSPECT/TYPERECORD 84923 . 85280) (INSPECT/AS/RECORD 85282 . 86519) (SELECT.LIST.INSPECTOR 86521 . 
-88572) (STANDARDEDITE 88574 . 88857) (NTHTOPLEVELELT 88859 . 89175) (SETNTHTOPLEVELELT 89177 . 89937) 
-(DEDITE 89939 . 90146) (FINDRECDECL 90148 . 90731) (FINDSYSRECDECL 90733 . 91134) (
-MAKE-INSPECTOR-PROFILE 91136 . 91521) (CONFIRM-SET 91523 . 91707)) (93533 101747 (INSPECT/ATOM 93543
- . 97648) (SELECT.ATOM.ASPECT 97650 . 98794) (INSPECT/AS/FUNCTION 98796 . 101082) (SELECT.FNS.EDITOR 
-101084 . 101745)) (101788 107213 (INSPECTCODE 101798 . 102950) (\TEDIT.INSPECTCODE 102952 . 104930) (
-\INSPECT/CODE/RESHAPEFN 104932 . 106471) (\INSPECT/CODE/REPAINTFN 106473 . 107211)) (107251 108857 (
-INSPECT/HARRAYP 107261 . 108009) (HARRAYKEYS 108011 . 108390) (INSPECTW.GETHASH 108392 . 108619) (
-INSPECTW.PUTHASH 108621 . 108855)) (108906 115115 (RDTBL\NONOTHERCODES 108916 . 109936) (GETSYNTAXPROP
- 109938 . 111436) (SETSYNTAXPROP 111438 . 113165) (GETTTBLPROP 113167 . 114085) (SETTTBLPROP 114087 . 
-115113)) (115594 124236 (INSPECT/AS/BLOCKRECORD 115604 . 116604) (INSPECT/TYPELESS 116606 . 117997) (
-LIST-ALL-BLOCKRECORDS 117999 . 118274) (INSPECT/HUNK 118276 . 120879) (\INSPECT.DATATYPE.RAW.FETCH 
-120881 . 121207) (\INSPECT.FETCH.8 121209 . 121358) (\INSPECT.FETCH.32 121360 . 121531) (
-\INSPECT.FETCH.CHAR 121533 . 121696) (\INSPECT.FETCH.FATCHAR 121698 . 121860) (\INSPECT.FETCH.PTR 
-121862 . 122033) (\INSPECT.STORE.8 122035 . 122341) (\INSPECT.STORE.16 122343 . 122643) (
-\INSPECT.STORE.32 122645 . 123080) (\INSPECT.STORE.CHAR 123082 . 123408) (\INSPECT.STORE.FATCHAR 
-123410 . 123732) (\INSPECT.STORE.PTR 123734 . 124081) (INSPECT/MAKE/CCODEP 124083 . 124234)))))
+  (FILEMAP (NIL (7293 45646 (INSPECTW.CREATE 7303 . 12598) (INSPECTW.REPAINTFN 12600 . 18136) (
+INSPECTW.REDISPLAY 18138 . 27010) (\INSPECTW.VALUE.MARGIN 27012 . 27415) (INSPECTW.REPLACE 27417 . 
+28125) (INSPECTW.SELECTITEM 28127 . 29117) (\INSPECTW.REDISPLAYPROP 29119 . 31549) (INSPECTW.FETCH 
+31551 . 31974) (INSPECTW.PROPERTIES 31976 . 32617) (DECODE.WINDOW.ARG 32619 . 34347) (
+DEFAULT.INSPECTW.PROPCOMMANDFN 34349 . 36377) (DEFAULT.INSPECTW.VALUECOMMANDFN 36379 . 37795) (
+DEFAULT.INSPECTW.TITLECOMMANDFN 37797 . 41246) (\SELITEM.FROM.PROPERTY 41248 . 41690) (
+\INSPECT.COMPUTE.TITLE 41692 . 42976) (LEVELEDFORM 42978 . 43697) (MAKEWITHINREGION 43699 . 45644)) (
+45647 62952 (ITEMW.REPAINTFN 45657 . 46877) (\ITEM.WINDOW.BUTTON.HANDLER 46879 . 47298) (
+\ITEM.WINDOW.SELECTION.HANDLER 47300 . 49967) (\INSPECTW.COMMAND.HANDLER 49969 . 53970) (
+ITEM.WINDOW.SET.STACK.ARG 53972 . 56176) (REPLACESTKARG 56178 . 57277) (IN/ITEM? 57279 . 58161) (
+\ITEMW.DESELECTITEM 58163 . 58427) (\ITEMW.SELECTITEM 58429 . 58691) (\ITEMW.CLEARSELECTION 58693 . 
+59048) (\ITEMW.FLIPITEM 59050 . 59523) (PRINTANDBOX 59525 . 62034) (PRINTATBOX 62036 . 62553) (
+ITEMOFPROPERTYVALUE 62555 . 62950)) (62953 66694 (\ITEM.WINDOW.COPY.HANDLER 62963 . 64820) (
+\ITEMW.FLIPCOPY 64822 . 65281) (BKSYSBUF.GENERAL 65283 . 66692)) (67086 92001 (INSPECT 67096 . 71626) 
+(\APPLYINSPECTMACRO 71628 . 72689) (INSPECT/BITMAP 72691 . 73843) (INSPECT/DATATYPE 73845 . 77359) (
+INSPECTABLEFIELDNAMES 77361 . 78694) (REMOVEDUPS 78696 . 78901) (INSPECT/ARRAY 78903 . 79968) (
+INSPECT/TOP/LEVEL/LIST 79970 . 81087) (INSPECT/PROPLIST 81089 . 82177) (NONSYSPROPNAMES 82179 . 82475)
+ (INSPECT/LISTP 82477 . 82916) (ALISTP 82918 . 83127) (PROPLISTP 83129 . 83769) (INSPECT/ALIST 83771
+ . 84247) (ASSOCGET 84249 . 84460) (/ASSOCPUT 84462 . 84727) (INSPECT/PLIST 84729 . 85213) (
+INSPECT/TYPERECORD 85215 . 85572) (INSPECT/AS/RECORD 85574 . 86811) (SELECT.LIST.INSPECTOR 86813 . 
+88864) (STANDARDEDITE 88866 . 89149) (NTHTOPLEVELELT 89151 . 89467) (SETNTHTOPLEVELELT 89469 . 90229) 
+(DEDITE 90231 . 90438) (FINDRECDECL 90440 . 91023) (FINDSYSRECDECL 91025 . 91426) (
+MAKE-INSPECTOR-PROFILE 91428 . 91813) (CONFIRM-SET 91815 . 91999)) (93825 102039 (INSPECT/ATOM 93835
+ . 97940) (SELECT.ATOM.ASPECT 97942 . 99086) (INSPECT/AS/FUNCTION 99088 . 101374) (SELECT.FNS.EDITOR 
+101376 . 102037)) (102080 107505 (INSPECTCODE 102090 . 103242) (\TEDIT.INSPECTCODE 103244 . 105222) (
+\INSPECT/CODE/RESHAPEFN 105224 . 106763) (\INSPECT/CODE/REPAINTFN 106765 . 107503)) (107543 109149 (
+INSPECT/HARRAYP 107553 . 108301) (HARRAYKEYS 108303 . 108682) (INSPECTW.GETHASH 108684 . 108911) (
+INSPECTW.PUTHASH 108913 . 109147)) (109198 115407 (RDTBL\NONOTHERCODES 109208 . 110228) (GETSYNTAXPROP
+ 110230 . 111728) (SETSYNTAXPROP 111730 . 113457) (GETTTBLPROP 113459 . 114377) (SETTTBLPROP 114379 . 
+115405)) (115912 117362 (WINDOW\INSPECTPROPS 115922 . 116777) (WINDOW\PROPFETCHFN 116779 . 117133) (
+WINDOW\PROPSTOREFN 117135 . 117360)) (117491 126133 (INSPECT/AS/BLOCKRECORD 117501 . 118501) (
+INSPECT/TYPELESS 118503 . 119894) (LIST-ALL-BLOCKRECORDS 119896 . 120171) (INSPECT/HUNK 120173 . 
+122776) (\INSPECT.DATATYPE.RAW.FETCH 122778 . 123104) (\INSPECT.FETCH.8 123106 . 123255) (
+\INSPECT.FETCH.32 123257 . 123428) (\INSPECT.FETCH.CHAR 123430 . 123593) (\INSPECT.FETCH.FATCHAR 
+123595 . 123757) (\INSPECT.FETCH.PTR 123759 . 123930) (\INSPECT.STORE.8 123932 . 124238) (
+\INSPECT.STORE.16 124240 . 124540) (\INSPECT.STORE.32 124542 . 124977) (\INSPECT.STORE.CHAR 124979 . 
+125305) (\INSPECT.STORE.FATCHAR 125307 . 125629) (\INSPECT.STORE.PTR 125631 . 125978) (
+INSPECT/MAKE/CCODEP 125980 . 126131)))))
 STOP

sources/LLPACKAGE

@@ -1,15 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
 
-
(IL:FILECREATED "24-Oct-2021 10:20:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;4|
 82444  
+
(IL:FILECREATED " 5-Sep-2024 17:42:20" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;3|
 87515  
 
-      IL:|changes| IL:|to:|  (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL IL:FIND-SYMBOL*)
+      :EDIT-BY "mth"
 
-      IL:|previous| IL:|date:| "22-Sep-92 11:47:31" IL:|{DSK}<home>larry>medley>sources>LLPACKAGE.;1|
+      :CHANGES-TO (IL:FNS XCL:DEFPACKAGE)
+
+      :PREVIOUS-DATE " 4-Sep-2024 13:17:23" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;2|
 )
 
 
-; Copyright (c) 1986-1987, 1990-1992 by Venue & Xerox Corporation.
-
 (IL:PRETTYCOMPRINT IL:LLPACKAGECOMS)
 
 (IL:RPAQQ IL:LLPACKAGECOMS

@@ -83,9 +83,9 @@
 
            (IL:FUNCTIONS IL:\\INDEXATOMPNAME)
                                                              (IL:* IL:\; 
-
                                          "Defined in EXPORTS.ALL and used by the DO-SYMBOLS macro")

+
                                            "Defined in EXPORTS.ALL and used by the DO-SYMBOLS macro")

            (IL:DECLARE\: IL:EVAL@COMPILE                     (IL:* IL:\; 
-
                    "These are used in expanding the DO-SYMBOLS macro, which is used in this file.")

+
                      "These are used in expanding the DO-SYMBOLS macro, which is used in this file.")

                   (IL:FUNCTIONS IL:MAKE-DO-SYMBOLS-VARS IL:MAKE-DO-SYMBOLS-CODE))
            (IL:FUNCTIONS DO-EXTERNAL-SYMBOLS XCL:DO-LOCAL-SYMBOLS XCL:DO-INTERNAL-SYMBOLS DO-SYMBOLS
                   DO-ALL-SYMBOLS)
@@ -96,7 +96,7 @@
            (IL:FUNCTIONS IL:BRIEFLY-DESCRIBE-SYMBOL APROPOS APROPOS-LIST)
            
            (IL:* IL:|;;| 
-
         "Reader and printer's interface to packages (plus *PACKAGE-FROM-INDEX* above)")

+
           "Reader and printer's interface to packages (plus *PACKAGE-FROM-INDEX* above)")

 
            (IL:FUNCTIONS IL:FIND-EXTERNAL-SYMBOL)
            (IL:FUNCTIONS IL:FIND-EXACT-SYMBOL IL:PACKAGE-NAME-AS-SYMBOL IL:\\FIND.PACKAGE.INTERNAL)
@@ -175,10 +175,10 @@
 )
 
 (DEFMACRO IL:\\FATCHARSEENP
 (IL:BASE IL:OFFSET IL:LEN IL:FATP)
-   `(AND ,IL:FATP (NOT (NULL (IL:FOR
 IL:I IL:FROM
 ,IL:OFFSET
-                                IL:TO
 (IL:SUB1 (IL:IPLUS ,IL:OFFSET ,IL:LEN))
+   `(AND ,IL:FATP (NOT (NULL (IL:FOR
 IL:I IL:FROM
 ,IL:OFFSET IL:TO
 (IL:SUB1 (IL:IPLUS ,IL:OFFSET
+                                                                                   ,IL:LEN))
                                 IL:SUCHTHAT
 (IL:IGREATERP (IL:\\GETBASEFAT ,IL:BASE IL:I)
-                                                       IL:\\MAXTHINCHAR))))))
+                                                   IL:\\MAXTHINCHAR))))))
 
 (DEFMACRO IL:\\PACKAGIFY
 (IL:OBJ)
    "If OBJ isn't already a package, turn the symbol or string into the package of that name."
@@ -220,9 +220,8 @@
 
 (DEFUN IL:\\UPCASEBASE
 (IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
    (IL:|for|
 IL:I IL:|from|
 IL:OFFSET IL:|to|
 (IL:IPLUS IL:OFFSET IL:LENGTH)
-      IL:|do|
 (IL:\\PUTBASECHAR IL:FATP IL:BASE IL:I (IL:NUMERIC-UPCASE
 (IL:\\GETBASECHAR
-                                                                                 IL:FATP IL:BASE IL:I
-                                                                                 )))))
+      IL:|do|
 (IL:\\PUTBASECHAR IL:FATP IL:BASE IL:I (IL:NUMERIC-UPCASE
 (IL:\\GETBASECHAR IL:FATP 
+                                                                               IL:BASE IL:I)))))
 
 (DEFUN IL:APROPOS-SEARCH
 (SYMBOL IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
    "The symbol to substring comparison macro for APROPOS and APROPOS-LIST.  The string is assumed to already be uppercase."
@@ -240,13 +239,13 @@
               T)
            (UNLESS (EQL (IL:\\GETBASECHAR IL:FATP IL:BASE IL:JNDEX)
                         (IL:NUMERIC-UPCASE
 (IL:\\GETBASECHAR IL:SYMBOL-FATP IL:SYMBOL-BASE
-                                                      (IL:ADD1 IL:KNDEX))))
+                                                  (IL:ADD1 IL:KNDEX))))
                   (RETURN NIL)))
          (RETURN T))))
 
 (DEFSTRUCT (PACKAGE-HASHTABLE
 (:CONSTRUCTOR %MAKE-PACKAGE-HASHTABLE)
-                                  (:COPIER NIL)
-                                  (:PRINT-FUNCTION PRINT-PACKAGE-HASHTABLE))
+                              (:COPIER NIL)
+                              (:PRINT-FUNCTION PRINT-PACKAGE-HASHTABLE))
    "Packages are implemented using a special kind of hashtable (this one).  It is an open hashtable with a parallel 8-bit I-vector of hash-codes.  The primary purpose of the hash for each entry is to reduce paging by allowing collisions and misses to be detected without paging in the symbol and pname for an entry.  If the hash for an entry doesn't match that for the symbol that we are looking for, then we can go on without touching the symbol, pname, or even hastable vector.  It turns out that, contrary to my expectations, paging is a very important consideration the design of the package representation.  Using a similar scheme without the entry hash, the fasloader was spending more than half its time paging in INTERN.  The hash code also indicates the status of an entry.  If it zero, the the entry is unused.  If it is one, then it is deleted.  Double-hashing is used for collision resolution."
    TABLE
    HASH
@@ -255,9 +254,9 @@
    DELETED)
 
 (DEFSTRUCT (PACKAGE
 (:CONC-NAME %PACKAGE-)
-                        (:CONSTRUCTOR %MAKE-PACKAGE)
-                        (:PREDICATE PACKAGEP)
-                        (:PRINT-FUNCTION PRINT-PACKAGE))
+                    (:CONSTRUCTOR %MAKE-PACKAGE)
+                    (:PREDICATE PACKAGEP)
+                    (:PRINT-FUNCTION PRINT-PACKAGE))
    INDEX
    (TABLES (LIST NIL))
    NAME NAMESYMBOL NICKNAMES (USE-LIST NIL)
@@ -321,7 +320,7 @@
    "The current package, in which read symbols are intern'ed.")
 
 (DEFVAR XCL::*UNSAFE-TO-DELETE-PACKAGE-NAMES*
 '("LISP" "INTERLISP" "XEROX-COMMON-LISP")
-                                                  "Packages whose deletion requires confirmation.")
+                                              "Packages whose deletion requires confirmation.")
 
 (XCL:DEFGLOBALVAR IL:*LISP-PACKAGE*
 NIL
    "Global for internal references to the lisp package.")
@@ -357,8 +356,8 @@
          (IL:LEN (IL:|ffetch|
 (IL:STRINGP IL:LENGTH) IL:|of|
 IL:PRINT-NAME))
          (IL:OFFST (IL:|ffetch|
 (IL:STRINGP IL:OFFST) IL:|of|
 IL:PRINT-NAME)))
         (IL:UNINTERRUPTABLY
-            (IL:\\CREATE.SYMBOL IL:BASE IL:OFFST IL:LEN IL:FATP (IL:\\FATCHARSEENP
 IL:BASE 
-                                                                       IL:OFFST IL:LEN IL:FATP)))))
+            (IL:\\CREATE.SYMBOL IL:BASE IL:OFFST IL:LEN IL:FATP (IL:\\FATCHARSEENP
 IL:BASE IL:OFFST 
+                                                                       IL:LEN IL:FATP)))))
 
 
 
@@ -367,12 +366,11 @@
 )

 
 
-(XCL:DEFGLOBALVAR IL:*PACKAGE-FROM-NAME*
 (IL:HASHARRAY 255 'IL:ERROR 'IL:STRINGHASHBITS
-                                                    'IL:STREQUAL)
-                                             "An equal hashtable from package names to packages.")
+(XCL:DEFGLOBALVAR IL:*PACKAGE-FROM-NAME*
 (IL:HASHARRAY 255 'IL:ERROR 'IL:STRINGHASHBITS 'IL:STREQUAL)
+                                         "An equal hashtable from package names to packages.")
 
 (XCL:DEFGLOBALVAR IL:*PACKAGE-FROM-INDEX*
 (MAKE-ARRAY 256 ':INITIAL-ELEMENT NIL)
-                                              "Index to package converter.")
+                                          "Index to package converter.")
 
 (DEFCONSTANT XCL:*TOTAL-PACKAGES-LIMIT*
 255
    "The total number of packages that the system may have (excluding the 'uninterned' package).")
@@ -499,9 +497,9 @@
                   (RETURN IL:X)))))
 
 (DEFUN MAKE-PACKAGE
 (NAME &KEY (USE '("LISP"))
-                              NICKNAMES PREFIX-NAME (EXTERNAL-ONLY NIL)
-                              (INTERNAL-SYMBOLS 10)
-                              (EXTERNAL-SYMBOLS 10))
+                          NICKNAMES PREFIX-NAME (EXTERNAL-ONLY NIL)
+                          (INTERNAL-SYMBOLS 10)
+                          (EXTERNAL-SYMBOLS 10))
    "Check for package name conflicts in name and nicknames, then make the package.  Do a use-package for each thing in the use list so that checking for conflicting exports among used packages is done."
    (DECLARE
 (SPECIAL IL:*PACKAGE-FROM-INDEX* IL:*PACKAGE-FROM-NAME*))
    (WHEN (FIND-PACKAGE
 NAME)
@@ -518,14 +516,143 @@
                           :INDEX %PACKAGE-INDEX)))
          (USE-PACKAGE
 USE PACKAGE)
          (IL:ENTER-NEW-NICKNAMES
 PACKAGE (IF (IL:STREQUAL NAME (SYMBOL-NAME PREFIX-NAME))
-                                                 NICKNAMES
-                                                 (CONS PREFIX-NAME NICKNAMES)))
+                                             NICKNAMES
+                                             (CONS PREFIX-NAME NICKNAMES)))
          (IL:PUTHASH NAME PACKAGE IL:*PACKAGE-FROM-NAME*)
          (SETF (AREF IL:*PACKAGE-FROM-INDEX* %PACKAGE-INDEX)
                PACKAGE)))
 (IL:DEFINEQ
 
-(xcl:defpackage

+(XCL:DEFPACKAGE

+  (IL:NLAMBDA IL:ARGS
                                 (IL:* IL:\; "Edited  4-Sep-2024 13:17 by mth")


+                                                        (IL:* IL:\; "Edited  2-Dec-87 10:39 by raf")

+    (IL:SETQ IL:ARGS (XCL:REMOVE-COMMENTS IL:ARGS))
+    (LET
+     ((PACKAGE (FIND-PACKAGE
 (CAR IL:ARGS))))
+     (COND
+        ((PACKAGEP PACKAGE)                                  (IL:* IL:\; 
+
                                   "If one already exists, test compatability of package definitions")

+         (IL:|for|
 IL:OPTION IL:|in|
 (CDR IL:ARGS)
+            IL:|do|

+            (LET* ((IL:KEY (COND
+                              ((KEYWORDP IL:OPTION)
+                               IL:OPTION)
+                              ((IL:LISTP IL:OPTION)
+                               (CAR IL:OPTION))
+                              (T (IL:ERROR "Bad option for defpackage " IL:OPTION))))
+                   (VALUES (COND
+                              ((KEYWORDP IL:OPTION)
+                               (LIST T))
+                              ((IL:LISTP IL:OPTION)
+                               (CDR IL:OPTION))
+                              (T (IL:ERROR "Bad option for defpackage " IL:OPTION)))))
+                  (IL:SELECTQ IL:KEY
+                        ((:INTERNAL-SYMBOLS :EXTERNAL-SYMBOLS) 
+                              NIL)
+                        (:EXTERNAL-ONLY (IF (NOT (%PACKAGE-EXTERNAL-ONLY PACKAGE))
+                                            (IL:ERROR 
+                                             "Package NOT :external-only as asserted by defpackage: "
+                                                   PACKAGE)))
+                        (:PREFIX-NAME (SETF (%PACKAGE-NAMESYMBOL PACKAGE)
+                                            (MAKE-SYMBOL
 (CAR VALUES))))
+                        (:USE (USE-PACKAGE
 VALUES PACKAGE))
+                        (:NICKNAMES (IL:ENTER-NEW-NICKNAMES
 PACKAGE VALUES))
+                        (:EXPORT (EXPORT
 (IL:FOR
 IL:SYMBOL IL:IN
 VALUES
+                                            IL:COLLECT
 (IL:IF
 (IL:LITATOM IL:SYMBOL)
+                                                           IL:THEN
 (IL:IF
 (SYMBOL-PACKAGE
 IL:SYMBOL)
+                                                                       IL:THEN
 IL:SYMBOL
+                                                                     IL:ELSE
 (INTERN
 (SYMBOL-NAME
+                                                                                      IL:SYMBOL)
+                                                                                    PACKAGE))
+                                                         IL:ELSEIF
 (IL:STRINGP IL:SYMBOL)
+                                                           IL:THEN
 (INTERN
 IL:SYMBOL PACKAGE)
+                                                         IL:ELSE
 (IL:ERROR 
+                                                        "Bad object in :export option of defpackage "
+                                                                        IL:SYMBOL)))
+                                        PACKAGE))
+                        (:IMPORT (IMPORT
 VALUES PACKAGE))
+                        ((:SHADOW :SHADOWING-IMPORT) 
+                              (LET ((IL:SYMBOLS-TO-SHADOW (IL:MAPCONC
+                                                           VALUES
+                                                           (IL:FUNCTION (IL:LAMBDA (SYMBOL)
+                                                                          (COND
+                                                                             ((NOT
+                                                                               (IL:MEMB SYMBOL
+                                                                                      (
+                                                                           %PACKAGE-SHADOWING-SYMBOLS
+                                                                                       PACKAGE)))
+                                                                              (LIST SYMBOL))))))))
+                                   (IL:SELECTQ IL:KEY
+                                         (:SHADOW (SHADOW
 IL:SYMBOLS-TO-SHADOW PACKAGE))
+                                         (:SHADOWING-IMPORT 
+                                               (SHADOWING-IMPORT
 IL:SYMBOLS-TO-SHADOW PACKAGE))
+                                         NIL)))
+                        (IL:ERROR "Bad keyword for defpackage " IL:KEY)))))
+        (T                                                   (IL:* IL:\; 
+
                                                             "Otherwise, make a new package to spec")

+         (LET
+          ((IL:POST-MAKE-FORMS NIL))
+          (IL:SETQ PACKAGE
+           (IL:APPLY 'MAKE-PACKAGE
+                  (CONS (CAR IL:ARGS)
+                        (IL:|for|
 IL:OPTION IL:|in|
 (CDR IL:ARGS)
+                           IL:|join|
 (LET ((IL:KEY (COND
+                                                      ((KEYWORDP IL:OPTION)
+                                                       IL:OPTION)
+                                                      ((IL:LISTP IL:OPTION)
+                                                       (CAR IL:OPTION))
+                                                      (T (IL:ERROR "Bad option for defpackage " 
+                                                                IL:OPTION))))
+                                           (VALUES (COND
+                                                      ((KEYWORDP IL:OPTION)
+                                                       (LIST T))
+                                                      ((IL:LISTP IL:OPTION)
+                                                       (CDR IL:OPTION))
+                                                      (T (IL:ERROR "Bad option for defpackage " 
+                                                                IL:OPTION)))))
+                                          (IL:SELECTQ IL:KEY
+                                                ((:USE :NICKNAMES) 
+                                                      (LIST IL:KEY (IL:|if|
 (CAR VALUES)
+                                                                       IL:|then|
 VALUES
+                                                                     IL:|else|
 
+                                                             (IL:* IL:\; "Handles case where NIL is being used to explicitly say the package's :USE list is empty, since the default is to use LISP.")

+                                                                           NIL)))
+                                                ((:PREFIX-NAME :INTERNAL-SYMBOLS :EXTERNAL-SYMBOLS 
+                                                        :EXTERNAL-ONLY) 
+                                                      (LIST IL:KEY (CAR VALUES)))
+                                                ((:SHADOW :EXPORT :IMPORT :SHADOWING-IMPORT) 
+                                                      (IL:SETQ IL:POST-MAKE-FORMS
+                                                       (CONS (CONS IL:KEY VALUES)
+                                                             IL:POST-MAKE-FORMS))
+                                                      NIL)
+                                                (IL:ERROR "Bad keyword for defpackage " IL:KEY)))))))
+          (IL:MAPC
+           IL:POST-MAKE-FORMS
+           (IL:FUNCTION (IL:LAMBDA (IL:FORM)
+                          (IL:SELECTQ (CAR IL:FORM)
+                                (:SHADOW (SHADOW
 (CDR IL:FORM)
+                                                PACKAGE))
+                                (:EXPORT (EXPORT

+                                          (IL:FOR
 IL:SYMBOL IL:IN
 (CDR IL:FORM)
+                                             IL:COLLECT
 (IL:IF
 (IL:LITATOM IL:SYMBOL)
+                                                            IL:THEN
 (IL:IF
 (SYMBOL-PACKAGE
 IL:SYMBOL)
+                                                                        IL:THEN
 IL:SYMBOL
+                                                                      IL:ELSE
 (INTERN
 (SYMBOL-NAME
+                                                                                       IL:SYMBOL)
+                                                                                     PACKAGE))
+                                                          IL:ELSEIF
 (IL:STRINGP IL:SYMBOL)
+                                                            IL:THEN
 (INTERN
 IL:SYMBOL PACKAGE)
+                                                          IL:ELSE
 (IL:ERROR 
+                                                        "Bad object in :export option of defpackage "
+                                                                         IL:SYMBOL)))
+                                          PACKAGE))
+                                (:IMPORT (IMPORT
 (CDR IL:FORM)
+                                                PACKAGE))
+                                (:SHADOWING-IMPORT 
+                                      (SHADOWING-IMPORT
 (CDR IL:FORM)
+                                             PACKAGE))
+                                (IL:SHOULDNT "Bogus form on post-make-forms"))))))))
+     (PACKAGE-NAME
 PACKAGE))))
 )
 
 
@@ -569,16 +696,15 @@
                                              (NOT (IL:FMEMB IL:SYM IL:SHADOWING-SYMBOLS)))
                                       (PUSHNEW IL:SYM IL:CSET :TEST 'EQ))))
                     (DOLIST (IL:P IL:USE-LIST)
-                                      (PUSHNEW IL:SYM IL:CSET :TEST 'EQ))))
-                    (DOLIST (IL:P IL:USE-LIST)
-                        (DO-EXTERNAL-SYMBOLS

-                         (IL:SYM IL:P)
-                         (MULTIPLE-VALUE-BIND (IL:S IL:W)
-                                (IL:FIND-EXTERNAL-SYMBOL
 (SYMBOL-NAME IL:SYM)
-                                       IL:PKG)
-                                (WHEN (AND IL:W (NOT (EQ IL:S IL:SYM))
-                                           (NOT (IL:FMEMB (INTERN
 (SYMBOL-NAME IL:SYM)
-                                                                 PACKAGE)
+                        (DO-EXTERNAL-SYMBOLS
 (IL:SYM IL:P)
+                               (MULTIPLE-VALUE-BIND (IL:S IL:W)
+                                      (IL:FIND-EXTERNAL-SYMBOL
 (SYMBOL-NAME IL:SYM)
+                                             IL:PKG)
+                                      (WHEN (AND IL:W (NOT (EQ IL:S IL:SYM))
+                                                 (NOT (IL:FMEMB (INTERN
 (SYMBOL-NAME IL:SYM)
+                                                                       PACKAGE)
+                                                             IL:SHADOWING-SYMBOLS)))
+                                          (PUSHNEW IL:SYM IL:CSET :TEST 'EQ))))))
                    (T (DO-EXTERNAL-SYMBOLS
 (IL:SYM IL:PKG)
                              (MULTIPLE-VALUE-BIND (IL:S IL:W)
                                     (FIND-SYMBOL
 (SYMBOL-NAME IL:SYM)
@@ -800,7 +926,7 @@
                    (UNLESS (AND IL:W (EQ IL:S IL:SYM))
                        (WHEN (OR (EQ IL:W :INTERNAL)
                                  (EQ IL:W :EXTERNAL))        (IL:* IL:\; 
-                       (WHEN (OR (EQ IL:W :INTERNAL)
+
                                                " If it was shadowed, we don't want Unintern to fail")

                            (SETF (%PACKAGE-SHADOWING-SYMBOLS PACKAGE)
                                  (DELETE IL:S (%PACKAGE-SHADOWING-SYMBOLS PACKAGE)))
                            (UNINTERN
 IL:S PACKAGE))
@@ -873,7 +999,7 @@
           (SXHASH (IL:SYMBOL-HASH
 IL:SYMBOL-BASE 1 IL:SYMBOL-LENGTH IL:SYMBOL-FATP))
           (IL:H2 (IL:REHASH-FACTOR
 SXHASH IL:LEN)))
          (DECLARE
 (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32))
-          (IL:H2 (IL:REHASH-FACTOR
 SXHASH IL:LEN)))
+                        IL:VEC)
                 (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8))
                       IL:HASH))
          (COND
@@ -886,7 +1012,7 @@
                 ((>= IL:SIZE IL:HASHTABLE-SIZE-LIMIT)
 
                  (IL:* IL:|;;| 
-
+
                 "We've spilled over into needing the list-of-tables feature, so add to the list.")

 
                  (IL:SETQ IL:VEC (IL:NCONC1 IL:VEC (MAKE-ARRAY IL:LEN :ELEMENT-TYPE
                                                           '(UNSIGNED-BYTE 32))))
@@ -898,7 +1024,7 @@
                  (IL:ADD-SYMBOL
 IL:TABLE SYMBOL))
                 (T 
                    (IL:* IL:|;;| 
-                (T 
+
                   "The initial table is still smaller than the limit.  Increase its size.")

 
                    (LET ((IL:SIZE (PACKAGE-HASHTABLE-SIZE IL:TABLE))
                          (IL:VEC1 (CAR IL:VEC))
@@ -909,8 +1035,7 @@
                         (DOTIMES (IL:I IL:LEN)
                             (WHEN (IL:IGREATERP (AREF IL:HASH1 IL:I)
                                          1)
-                            (WHEN (IL:IGREATERP (AREF IL:HASH1 IL:I)
-                                         1)
+                                (IL:ADD-SYMBOL
 IL:TABLE (IL:\\INDEXATOMPNAME
 (AREF IL:VEC1 IL:I))))))
                    )))
             (T (LET ((IL:THIS-HASH (CAR (IL:FLAST IL:HASH)))
                      (IL:THIS-VEC (CAR (IL:FLAST IL:VEC))))
@@ -926,10 +1051,9 @@
                          (SETF (AREF IL:THIS-HASH IL:I)
                                (IL:ENTRY-HASH
 IL:SYMBOL-LENGTH SXHASH)))))))))
 
-                               (IL:ENTRY-HASH
 IL:SYMBOL-LENGTH SXHASH)))))))))
-
-(DEFMACRO IL:WITH-SYMBOL
 ((IL:INDEX-VAR IL:SYMBOL-VAR IL:TABLE IL:BASE IL:OFFSET IL:LENGTH 
-                                     IL:FATP SXHASH IL:ENTRY-HASH IL:HASH-TABLE-TABLE 
+(DEFMACRO IL:WITH-SYMBOL
 ((IL:INDEX-VAR IL:SYMBOL-VAR IL:TABLE IL:BASE IL:OFFSET IL:LENGTH IL:FATP 
+                                 SXHASH IL:ENTRY-HASH IL:HASH-TABLE-TABLE IL:HASH-TABLE-HASH)
+                          &BODY IL:FORMS)
    "Find where the symbol named String is stored in Table.  Index-Var is bound to the index, or NIL if it is not present.  Symbol-Var is bound to the symbol.  Length and Hash are the length and sxhash of String.  Entry-Hash is the entry-hash of the string and length."
    (LET ((IL:VEC (OR IL:HASH-TABLE-TABLE (IL:GENSYM)))
          (IL:HASH (OR IL:HASH-TABLE-HASH (IL:GENSYM)))
@@ -947,7 +1071,7 @@
                 ,IL:HASH
                 ,IL:LIMIT)
                (DECLARE
 (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8))
-                ,IL:LIMIT)
+                              ,IL:HASH)
                       (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 32))
                             ,IL:VEC))
                (PROG (,IL:INDEX-VAR ,IL:SYMBOL-VAR ,IL:EHASH)
@@ -955,9 +1079,8 @@
                 (IL:* IL:|;;| "Loop thru all the hash tables looking for the symbol.")

 
                  IL:OUTER-LOOP
-
-                 IL:OUTER-LOOP
-                     (IL:SETQ ,IL:HASH (IL:POP
 ,IL:HASHS))
+                     (IL:SETQ ,IL:HASH (IL:POP
 ,IL:HASHS))   (IL:* IL:\; "Hashvalues")

+                     (IL:SETQ ,IL:VEC (IL:POP
 ,IL:VECS))     (IL:* IL:\; "The symbol vector")

                      (IL:SETQ ,IL:INDEX-VAR (IL:IREMAINDER ,SXHASH ,IL:LEN))
                                                              (IL:* IL:\; "Starting probe.")

                      (IL:SETQ ,IL:LIMIT ,IL:LEN)
@@ -972,37 +1095,34 @@
 
                          (IL:* IL:|;;| "SIngle-byte hash matches; try the whole name.")

 
-                         (IL:* IL:|;;| "SIngle-byte hash matches; try the whole name.")

-
-                         (IL:SETQ ,IL:SYMBOL-VAR (IL:\\INDEXATOMPNAME
 (AREF ,IL:VEC 
-                                                                                ,IL:INDEX-VAR)))
+                         (IL:SETQ ,IL:SYMBOL-VAR (IL:\\INDEXATOMPNAME
 (AREF ,IL:VEC ,IL:INDEX-VAR)))
+                         (WHEN (IL:\\SYMBOL-EQUALBASE
 ,IL:SYMBOL-VAR ,IL:BASE ,IL:OFFSET ,IL:LENGTH
                                       ,IL:FATP)
                                (GO IL:DOIT)))
                         ((EQL 0 ,IL:EHASH)                   (IL:* IL:\; 
-                               (GO IL:DOIT)))
+
                                               "Found an empty hash slot, so it's not in this table.")

                          (COND
                             ((NULL ,IL:HASHS)
 
                              (IL:* IL:|;;| 
-
+
                      "we've run out of sub-tables to look in.  Give the we-couldn't-find-it signal.")

 
                              (IL:SETQ ,IL:INDEX-VAR NIL)
                              (GO IL:DOIT))
                             (T (GO IL:OUTER-LOOP))))
                         ((EQL 0 (IL:SETQ ,IL:LIMIT (IL:SUB1 ,IL:LIMIT)))
                                                              (IL:* IL:\; 
-                        ((EQL 0 (IL:SETQ ,IL:LIMIT (IL:SUB1 ,IL:LIMIT)))
+
                                        "We.ve been thru the whole table, so it's not in this table.")

                          (COND
                             ((NULL ,IL:HASHS)
 
                              (IL:* IL:|;;| 
-
+
                      "we've run out of sub-tables to look in.  Give the we-couldn't-find-it signal.")

 
                              (IL:SETQ ,IL:INDEX-VAR NIL)
                              (GO IL:DOIT))
                             (T (GO IL:OUTER-LOOP)))))
-                             (GO IL:DOIT))
-                            (T (GO IL:OUTER-LOOP)))))
+                     (IL:SETQ ,IL:INDEX-VAR (IL:SYMBOL-HASH-REPROBE
 ,IL:INDEX-VAR ,IL:H2 ,IL:LEN))
                      (GO LOOP)
                  IL:DOIT
                      (RETURN (PROGN ,@IL:FORMS))))))
@@ -1051,12 +1171,12 @@
                                             (IL:SETQ IL:WHERE :INTERNAL)
                                             (IL:SETQ IL:DONE T))))
                     (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
-                                            (IL:SETQ IL:DONE T))))
-                    (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
+                                           IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL 
+                                           NIL)
                            (WHEN IL:FOUND
 
                                (IL:* IL:|;;| 
-
+
                               "Was (cl:return-from find-symbol* (cl:values cl:symbol :internal))")

 
                                (IL:SETQ IL:WHERE :INTERNAL)
                                (IL:SETQ IL:DONE T)))))
@@ -1071,12 +1191,12 @@
                                             (IL:SETQ IL:WHERE :EXTERNAL)
                                             (IL:SETQ IL:DONE T))))
                     (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
-                                            (IL:SETQ IL:DONE T))))
-                    (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
+                                           IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL 
+                                           NIL)
                            (WHEN IL:FOUND
 
                                (IL:* IL:|;;| 
-
+
                               "Was (cl:return-from find-symbol* (cl:values cl:symbol :external))")

 
                                (IL:SETQ IL:SYM SYMBOL)
                                (IL:SETQ IL:WHERE :EXTERNAL)
@@ -1101,13 +1221,13 @@
                                                               IL:TABLE))
 
                                                    (IL:* IL:|;;| 
-
+
                                 "Was (cl:return-from find-symbol* (cl:values cl:symbol :inherited))")

 
                                                    (IL:SETQ IL:WHERE :INHERITED)
                                                    (IL:SETQ IL:DONE T))))
                            (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (CAR IL:TABLE)
-                                                   (IL:SETQ IL:DONE T))))
-                           (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (CAR IL:TABLE)
+                                                  IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH 
+                                                  IL:EHASH NIL NIL)
                                   (WHEN IL:FOUND
                                       (UNLESS (EQ IL:PREV IL:HEAD)
                                           (SHIFTF (CDR IL:PREV)
@@ -1116,7 +1236,7 @@
                                                  IL:TABLE))
 
                                       (IL:* IL:|;;| 
-
+
                                 "Was (cl:return-from find-symbol* (cl:values cl:symbol :inherited))")

 
                                       (IL:SETQ IL:SYM SYMBOL)
                                       (IL:SETQ IL:WHERE :INHERITED)
@@ -1134,17 +1254,17 @@
                        (T (IL:ERROR "Not a string " IL:NAME))))
    (COND
       ((NULL PACKAGE)                                        (IL:* IL:\; 
-   (COND
+
                                                            "XCL extension, makes uninterned symbols")

        (MAKE-SYMBOL
 IL:NAME))
       (T                                                     (IL:* IL:\; 
-       (MAKE-SYMBOL
 IL:NAME))
+
                                                             "Package is at least non-null")

          (IL:SETQ PACKAGE (IL:\\PACKAGIFY
 PACKAGE))
          (LET ((IL:BASE (IL:|ffetch|
 (IL:STRINGP IL:BASE) IL:|of|
 IL:NAME))
                (IL:OFFSET (IL:|ffetch|
 (IL:STRINGP IL:OFFST) IL:|of|
 IL:NAME))
                (IL:LENGTH (IL:|ffetch|
 (IL:STRINGP IL:LENGTH) IL:|of|
 IL:NAME))
                (IL:FATP (IL:|ffetch|
 (IL:STRINGP IL:FATSTRINGP) IL:|of|
 IL:NAME)))
-               (IL:LENGTH (IL:|ffetch|
 (IL:STRINGP IL:LENGTH) IL:|of|
 IL:NAME))
-               (IL:FATP (IL:|ffetch|
 (IL:STRINGP IL:FATSTRINGP) IL:|of|
 IL:NAME)))
+              (IL:INTERN*
 IL:BASE IL:OFFSET IL:LENGTH IL:FATP (IL:\\FATCHARSEENP
 IL:BASE IL:OFFSET 
+                                                                     IL:LENGTH IL:FATP)
                      PACKAGE NIL)))))
 
 (DEFUN FIND-SYMBOL
 (IL:NAME &OPTIONAL (PACKAGE *PACKAGE*))
@@ -1173,7 +1293,7 @@
           (IL:HASH (IL:SYMBOL-HASH
 IL:BASE IL:OFFSET IL:LENGTH IL:FATP))
           (IL:EHASH (IL:ENTRY-HASH
 IL:LENGTH IL:HASH)))
          (IL:WITH-SYMBOL
 (IL:INDEX SYMBOL IL:TABLE IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH 
-          (IL:EHASH (IL:ENTRY-HASH
 IL:LENGTH IL:HASH)))
+                                IL:EHASH NIL IL:TABLE-HASH)
                 (SETF (AREF IL:TABLE-HASH IL:INDEX)
                       1)
                 (INCF (PACKAGE-HASHTABLE-DELETED IL:TABLE)))))
@@ -1196,7 +1316,7 @@
                              (IL:FIND-EXTERNAL-SYMBOL
 IL:NAME IL:P)
                              (WHEN IL:W (PUSHNEW IL:S IL:CSET))))
                   (WHEN (CDR IL:CSET)                        (IL:* IL:\; 
-                             (WHEN IL:W (PUSHNEW IL:S IL:CSET))))
+
                                                     "If there is more than one, handle the conflict")

                       (IL:RESOLVE-UNINTERN-CONFLICT SYMBOL IL:CSET PACKAGE)))
              (SETF (%PACKAGE-SHADOWING-SYMBOLS PACKAGE)
                    (DELETE SYMBOL IL:SHADOWING-SYMBOLS :TEST #'EQ)))
@@ -1207,8 +1327,8 @@
                          (OR (EQ IL:W :INTERNAL)
                              (EQ IL:W :EXTERNAL)))
                     (IL:NUKE-SYMBOL
 (IF (EQ IL:W :INTERNAL)
-                             (EQ IL:W :EXTERNAL)))
-                    (IL:NUKE-SYMBOL
 (IF (EQ IL:W :INTERNAL)
+                                        (%PACKAGE-INTERNAL-SYMBOLS PACKAGE)
+                                        (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE))
                            IL:NAME)
                     (IF (EQ (SYMBOL-PACKAGE
 SYMBOL)
                             PACKAGE)
@@ -1291,9 +1411,9 @@
 )
 
 (DEFMACRO DO-EXTERNAL-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-
-(DEFMACRO DO-EXTERNAL-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-                                          IL:RESULT-FORM)
+                                      IL:RESULT-FORM)
+                               &BODY
+                               (IL:CODE IL:DECLS))
    "Do-External-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms once for each external symbol in the given Package with Var bound to the current symbol."
    (LET ((IL:VARS (IL:MAKE-DO-SYMBOLS-VARS
)))
         `(PROG (,IL:VAR ,@IL:VARS)
@@ -1304,9 +1424,9 @@
                         IL:CODE))))
 
 (DEFMACRO XCL:DO-LOCAL-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-
-(DEFMACRO XCL:DO-LOCAL-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-                                           IL:RESULT-FORM)
+                                       IL:RESULT-FORM)
+                                &BODY
+                                (IL:CODE IL:DECLS))
    "Do-Local-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms at least once for each symbol actually in the given Package with Var bound to the current symbol."
    (LET* ((IL:DONE-INTERNAL (IL:GENSYM))
           (IL:DONE-EXTERNAL (IL:GENSYM))
@@ -1318,13 +1438,11 @@
                  ,@IL:DECLS
                  (WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
                      (GO ,IL:DONE-INTERNAL))
-                 (WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
-                     (GO ,IL:DONE-INTERNAL))
+                 ,@(IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS ,PACKAGE)
                           `(GO ,IL:DONE-INTERNAL)
                           IL:CODE)
                  ,IL:DONE-INTERNAL
-                          IL:CODE)
-                 ,IL:DONE-INTERNAL
+                 ,@(IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-EXTERNAL-SYMBOLS ,PACKAGE)
                           `(GO ,IL:DONE-EXTERNAL)
                           IL:CODE)
                  ,IL:DONE-EXTERNAL
@@ -1332,9 +1450,9 @@
                  (RETURN ,IL:RESULT-FORM))))
 
 (DEFMACRO XCL:DO-INTERNAL-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-
-(DEFMACRO XCL:DO-INTERNAL-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-                                              IL:RESULT-FORM)
+                                          IL:RESULT-FORM)
+                                   &BODY
+                                   (IL:CODE IL:DECLS))
    "Do-Internal-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms at least once for each symbol actually in the given Package and not exported with Var bound to the current symbol."
    (LET* ((IL:DONE-INTERNAL (IL:GENSYM))
           (IL:VARS (IL:MAKE-DO-SYMBOLS-VARS
))
@@ -1345,8 +1463,7 @@
                  ,@IL:DECLS
                  (WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
                      (GO ,IL:DONE-INTERNAL))
-                 (WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
-                     (GO ,IL:DONE-INTERNAL))
+                 ,@(IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS ,PACKAGE)
                           `(GO ,IL:DONE-INTERNAL)
                           IL:CODE)
                  ,IL:DONE-INTERNAL
@@ -1354,9 +1471,9 @@
                  (RETURN ,IL:RESULT-FORM))))
 
 (DEFMACRO DO-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-
-(DEFMACRO DO-SYMBOLS
 ((IL:VAR &OPTIONAL (PACKAGE '*PACKAGE*)
-                                 IL:RESULT-FORM)
+                             IL:RESULT-FORM)
+                      &BODY
+                      (IL:CODE IL:DECLS))
    "Do-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms at least once for each symbol accessible in the given Package with Var bound to the current symbol."
    (LET* ((IL:DONE-INTERNAL (IL:GENSYM))
           (IL:DONE-EXTERNAL (IL:GENSYM))
@@ -1375,13 +1492,11 @@
                  ,@IL:DECLS
                  (WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
                      (GO ,IL:DONE-INTERNAL))
-                 (WHEN (%PACKAGE-EXTERNAL-ONLY ,PACKAGE)
-                     (GO ,IL:DONE-INTERNAL))
+                 ,@(IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS ,PACKAGE)
                           `(GO ,IL:DONE-INTERNAL)
                           IL:CODE)
                  ,IL:DONE-INTERNAL
-                          IL:CODE)
-                 ,IL:DONE-INTERNAL
+                 ,@(IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-EXTERNAL-SYMBOLS ,PACKAGE)
                           `(GO ,IL:DONE-EXTERNAL)
                           IL:CODE)
                  ,IL:DONE-EXTERNAL
@@ -1390,29 +1505,29 @@
                      (IL:SETQ ,IL:VAR NIL)
                      (RETURN ,IL:RESULT-FORM))
                  (IL:SETQ ,IL:THIS-INHERIT (CAR ,IL:INHERITS))
-                     (RETURN ,IL:RESULT-FORM))
-                 (IL:SETQ ,IL:THIS-INHERIT (CAR ,IL:INHERITS))
-                 ,@(IL:MAKE-DO-SYMBOLS-CODE

-                    IL:VARS IL:VAR IL:THIS-INHERIT `(PROGN (IL:SETQ ,IL:INHERITS (CDR ,IL:INHERITS))
-                                                           (GO ,IL:NEXT-INHERIT))
-                    `((WHEN (OR (NOT ,IL:SHADOWED)
-                                (EQ (FIND-SYMBOL
 (SYMBOL-NAME ,IL:VAR)
-                                           ,IL:N-PACKAGE)
+                 ,@(IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR IL:THIS-INHERIT
+                          `(PROGN (IL:SETQ ,IL:INHERITS (CDR ,IL:INHERITS))
+                                  (GO ,IL:NEXT-INHERIT))
+                          `((WHEN (OR (NOT ,IL:SHADOWED)
+                                      (EQ (FIND-SYMBOL
 (SYMBOL-NAME ,IL:VAR)
+                                                 ,IL:N-PACKAGE)
+                                          ,IL:VAR))
+                                  ,@IL:CODE))))))
 
 (DEFMACRO DO-ALL-SYMBOLS
 ((IL:VAR &OPTIONAL IL:RESULT-FORM)
-
-(DEFMACRO DO-ALL-SYMBOLS
 ((IL:VAR &OPTIONAL IL:RESULT-FORM)
+                          &BODY
+                          (IL:CODE IL:DECLS))
    "Do-All-Symbols (Var [Package [Result-Form]]) {Declaration}* {Tag | Statement}* Executes the Forms once for each symbol in each package with Var bound to the current symbol."
    (LET* ((IL:PACKAGE-LOOP (IL:GENSYM))
           (IL:TAG (IL:GENSYM))
           (IL:PACKAGE-LIST (IL:GENSYM))
           (IL:VARS (IL:MAKE-DO-SYMBOLS-VARS
))
-          (IL:PACKAGE-LIST (IL:GENSYM))
-          (IL:VARS (IL:MAKE-DO-SYMBOLS-VARS
))
+          (IL:INTERNAL-CODE (IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-INTERNAL-SYMBOLS
+                                                                      (CAR ,IL:PACKAGE-LIST))
                                    `(GO ,IL:TAG)
                                    IL:CODE))
-                                   `(GO ,IL:TAG)
-                                   IL:CODE))
+          (IL:EXTERNAL-CODE (IL:MAKE-DO-SYMBOLS-CODE
 IL:VARS IL:VAR `(%PACKAGE-EXTERNAL-SYMBOLS
+                                                                      (CAR ,IL:PACKAGE-LIST))
                                    `(PROGN (IL:SETQ ,IL:PACKAGE-LIST (CDR ,IL:PACKAGE-LIST))
                                            (GO ,IL:PACKAGE-LOOP))
                                    IL:CODE)))
@@ -1494,12 +1609,10 @@
                  (LET ((PACKAGE (IL:\\PACKAGIFY
 PACKAGE)))
                       (IF IL:EXTERNAL-ONLY
                           (DO-EXTERNAL-SYMBOLS
 (SYMBOL PACKAGE)
-                      (IF IL:EXTERNAL-ONLY
-                          (DO-EXTERNAL-SYMBOLS
 (SYMBOL PACKAGE)
+                                 (IF (IL:APROPOS-SEARCH
 SYMBOL IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
                                      (PUSH SYMBOL LIST)))
                           (DO-SYMBOLS
 (SYMBOL PACKAGE)
-                                     (PUSH SYMBOL LIST)))
-                          (DO-SYMBOLS
 (SYMBOL PACKAGE)
+                                 (IF (IL:APROPOS-SEARCH
 SYMBOL IL:BASE IL:OFFSET IL:LENGTH IL:FATP)
                                      (PUSH SYMBOL LIST)))))))
         LIST))
 
@@ -1510,7 +1623,7 @@
 
 (DEFUN IL:FIND-EXTERNAL-SYMBOL
 (STRING PACKAGE)
    (IL:SETQ STRING (IL:MKSTRING STRING))                     (IL:* IL:\; 
-(DEFUN IL:FIND-EXTERNAL-SYMBOL
 (STRING PACKAGE)
+
                                                        "Convert symbols to strings (for the reader)")

    (LET* ((IL:BASE (IL:|ffetch|
 (IL:STRINGP IL:BASE) IL:|of|
 STRING))
           (IL:OFFSET (IL:|ffetch|
 (IL:STRINGP IL:OFFST) IL:|of|
 STRING))
           (IL:LENGTH (IL:|ffetch|
 (IL:STRINGP IL:LENGTH) IL:|of|
 STRING))
@@ -1526,8 +1639,7 @@
                                                            IL:RESULT))
                                     (VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1))))
                 (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
-                                    (VALUES IL:SYM (NOT (IL:IEQP IL:RESULT -1))))
-                (IL:WITH-SYMBOL
 (IL:FOUND SYMBOL (%PACKAGE-EXTERNAL-SYMBOLS PACKAGE)
+                                       IL:BASE IL:OFFSET IL:LENGTH IL:FATP IL:HASH IL:EHASH NIL NIL)
                        (VALUES SYMBOL IL:FOUND)))))
 
 (DEFUN IL:FIND-EXACT-SYMBOL
 (SYMBOL PACKAGE)
@@ -1562,32 +1674,40 @@
 
 (IL:ADDTOVAR IL:LAMA
 )
 )
-(IL:ADDTOVAR IL:LAMA
 )
 (IL:DECLARE\: IL:DONTCOPY
-(IL:PUTPROPS IL:LLPACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1992))
-(IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (9779 10219 (IL:\\UPCASEBASE 9779 . 10219)) (10221 11342 (IL:APROPOS-SEARCH 10221 . 
-11342)) (12882 12964 (PACKAGE-NAME 12882 . 12964)) (12966 13058 (PACKAGE-NICKNAMES 12966 . 13058)) (
-13060 13168 (PACKAGE-SHADOWING-SYMBOLS 13060 . 13168)) (13170 13260 (PACKAGE-USE-LIST 13170 . 13260)) 
-(13262 13360 (PACKAGE-USED-BY-LIST 13262 . 13360)) (13362 14517 (IL:MAKE-PACKAGE-HASHTABLE 13362 . 
-14517)) (14519 14681 (PRINT-PACKAGE 14519 . 14681)) (14683 15074 (PRINT-PACKAGE-HASHTABLE 14683 . 
-15074)) (16142 16923 (MAKE-SYMBOL 16142 . 16923)) (18034 18444 (IL:\\PKG-FIND-FREE-PACKAGE-INDEX 18034
- . 18444)) (18501 18647 (IL:SETF-SYMBOL-PACKAGE 18501 . 18647)) (18649 18741 (SYMBOL-PACKAGE 18649 . 
-18741)) (21512 21684 (IL:INTERNAL-SYMBOL-COUNT 21512 . 21684)) (21686 21804 (IL:EXTERNAL-SYMBOL-COUNT 
-21686 . 21804)) (21806 22962 (IL:ENTER-NEW-NICKNAMES 21806 . 22962)) (22964 23390 (
-IL:MAKE-PRIME-HASHTABLE-SIZE 22964 . 23390)) (23392 25061 (MAKE-PACKAGE 23392 . 25061)) (25062 28355 (
-XCL:DEFPACKAGE 25075 . 28353)) (28404 28626 (FIND-PACKAGE 28404 . 28626)) (28628 31966 (USE-PACKAGE 
-28628 . 31966)) (31968 32448 (IN-PACKAGE 31968 . 32448)) (32450 32724 (XCL:PKG-GOTO 32450 . 32724)) (
-32726 33826 (RENAME-PACKAGE 32726 . 33826)) (33828 35279 (XCL:DELETE-PACKAGE 33828 . 35279)) (35281 
-38227 (EXPORT 35281 . 38227)) (38229 39472 (UNEXPORT 38229 . 39472)) (39474 41118 (IMPORT 39474 . 
-41118)) (41120 42398 (SHADOWING-IMPORT 41120 . 42398)) (42400 43454 (SHADOW 42400 . 43454)) (43456 
-44111 (UNUSE-PACKAGE 43456 . 44111)) (44175 44481 (LIST-ALL-PACKAGES 44175 . 44481)) (44538 48313 (
-IL:ADD-SYMBOL 44538 . 48313)) (52637 53940 (IL:INTERN* 52637 . 53940)) (53942 59790 (IL:FIND-SYMBOL* 
-53942 . 59790)) (59792 61243 (INTERN 59792 . 61243)) (61245 61823 (FIND-SYMBOL 61245 . 61823)) (61881 
-62781 (IL:NUKE-SYMBOL 61881 . 62781)) (62783 64903 (UNINTERN 62783 . 64903)) (64905 66048 (
-IL:MOBY-UNINTERN 64905 . 66048)) (66107 66179 (IL:\\INDEXATOMPNAME 66107 . 66179)) (66291 66438 (
-IL:MAKE-DO-SYMBOLS-VARS 66291 . 66438)) (66440 67895 (IL:MAKE-DO-SYMBOLS-CODE 66440 . 67895)) (75495 
-76020 (FIND-ALL-SYMBOLS 75495 . 76020)) (76022 76301 (IL:BRIEFLY-DESCRIBE-SYMBOL 76022 . 76301)) (
-76303 77817 (APROPOS 76303 . 77817)) (77819 79476 (APROPOS-LIST 77819 . 79476)) (79580 81153 (
-IL:FIND-EXTERNAL-SYMBOL 79580 . 81153)) (81155 81675 (IL:FIND-EXACT-SYMBOL 81155 . 81675)) (81677 
+  (IL:FILEMAP (NIL (5304 5829 (IL:PACKAGE-LISTIFY 5304 . 5829)) (5831 6219 (IL:\\SIMPLE-STRINGIFY 5831
+ . 6219)) (6221 6713 (IL:SYMBOL-LISTIFY 6221 . 6713)) (6715 6777 (IL:COPY-STRING 6715 . 6777)) (6779 
+7517 (IL:\\SYMBOL-EQUALBASE 6779 . 7517)) (7521 7957 (IL:\\FATCHARSEENP 7521 . 7957)) (7959 8487 (
+IL:\\PACKAGIFY 7959 . 8487)) (8489 9526 (IL:\\STRING-EQUALBASE 8489 . 9526)) (9528 9752 (
+IL:NUMERIC-UPCASE 9528 . 9752)) (9754 10111 (IL:\\UPCASEBASE 9754 . 10111)) (10113 11230 (
+IL:APROPOS-SEARCH 10113 . 11230)) (12750 12832 (PACKAGE-NAME 12750 . 12832)) (12834 12926 (
+PACKAGE-NICKNAMES 12834 . 12926)) (12928 13036 (PACKAGE-SHADOWING-SYMBOLS 12928 . 13036)) (13038 13128
+ (PACKAGE-USE-LIST 13038 . 13128)) (13130 13228 (PACKAGE-USED-BY-LIST 13130 . 13228)) (13230 14385 (
+IL:MAKE-PACKAGE-HASHTABLE 13230 . 14385)) (14387 14549 (PRINT-PACKAGE 14387 . 14549)) (14551 14942 (
+PRINT-PACKAGE-HASHTABLE 14551 . 14942)) (16006 16787 (MAKE-SYMBOL 16006 . 16787)) (17838 18248 (
+IL:\\PKG-FIND-FREE-PACKAGE-INDEX 17838 . 18248)) (18305 18451 (IL:SETF-SYMBOL-PACKAGE 18305 . 18451)) 
+(18453 18545 (SYMBOL-PACKAGE 18453 . 18545)) (18587 20224 (IL:SYMBOL-HASH 18587 . 20224)) (20226 20358
+ (IL:REHASH-FACTOR 20226 . 20358)) (20360 20526 (IL:SYMBOL-HASH-REPROBE 20360 . 20526)) (20528 20919 (
+IL:ENTRY-HASH 20528 . 20919)) (20968 21314 (IL:COUNT-PACKAGE-HASHTABLE 20968 . 21314)) (21316 21488 (
+IL:INTERNAL-SYMBOL-COUNT 21316 . 21488)) (21490 21608 (IL:EXTERNAL-SYMBOL-COUNT 21490 . 21608)) (21610
+ 22766 (IL:ENTER-NEW-NICKNAMES 21610 . 22766)) (22768 23194 (IL:MAKE-PRIME-HASHTABLE-SIZE 22768 . 
+23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 34317 (XCL:DEFPACKAGE 24859 . 34315)) (34366
+ 34588 (FIND-PACKAGE 34366 . 34588)) (34590 37951 (USE-PACKAGE 34590 . 37951)) (37953 38433 (
+IN-PACKAGE 37953 . 38433)) (38435 38709 (XCL:PKG-GOTO 38435 . 38709)) (38711 39811 (RENAME-PACKAGE 
+38711 . 39811)) (39813 41264 (XCL:DELETE-PACKAGE 39813 . 41264)) (41266 44212 (EXPORT 41266 . 44212)) 
+(44214 45457 (UNEXPORT 44214 . 45457)) (45459 47103 (IMPORT 45459 . 47103)) (47105 48385 (
+SHADOWING-IMPORT 47105 . 48385)) (48387 49441 (SHADOW 48387 . 49441)) (49443 50098 (UNUSE-PACKAGE 
+49443 . 50098)) (50162 50468 (LIST-ALL-PACKAGES 50162 . 50468)) (50525 54208 (IL:ADD-SYMBOL 50525 . 
+54208)) (54210 58263 (IL:WITH-SYMBOL 54210 . 58263)) (58265 59568 (IL:INTERN* 58265 . 59568)) (59570 
+65402 (IL:FIND-SYMBOL* 59570 . 65402)) (65404 66855 (INTERN 65404 . 66855)) (66857 67435 (FIND-SYMBOL 
+66857 . 67435)) (67493 68389 (IL:NUKE-SYMBOL 67493 . 68389)) (68391 70505 (UNINTERN 68391 . 70505)) (
+70507 71650 (IL:MOBY-UNINTERN 70507 . 71650)) (71709 71781 (IL:\\INDEXATOMPNAME 71709 . 71781)) (71893
+ 72040 (IL:MAKE-DO-SYMBOLS-VARS 71893 . 72040)) (72042 73497 (IL:MAKE-DO-SYMBOLS-CODE 72042 . 73497)) 
+(73501 74279 (DO-EXTERNAL-SYMBOLS 73501 . 74279)) (74281 75627 (XCL:DO-LOCAL-SYMBOLS 74281 . 75627)) (
+75629 76745 (XCL:DO-INTERNAL-SYMBOLS 75629 . 76745)) (76747 79045 (DO-SYMBOLS 76747 . 79045)) (79047 
+80729 (DO-ALL-SYMBOLS 79047 . 80729)) (80797 81322 (FIND-ALL-SYMBOLS 80797 . 81322)) (81324 81603 (
+IL:BRIEFLY-DESCRIBE-SYMBOL 81324 . 81603)) (81605 83119 (APROPOS 81605 . 83119)) (83121 84688 (
+APROPOS-LIST 83121 . 84688)) (84792 86319 (IL:FIND-EXTERNAL-SYMBOL 84792 . 86319)) (86321 86841 (
+IL:FIND-EXACT-SYMBOL 86321 . 86841)) (86843 86923 (IL:PACKAGE-NAME-AS-SYMBOL 86843 . 86923)) (86925 
+87074 (IL:\\FIND.PACKAGE.INTERNAL 86925 . 87074)))))
 IL:STOP

sources/MEDLEYDIR

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Jul-2023 08:57:43" {WMEDLEY}<sources>MEDLEYDIR.;22
 10362  
+
(FILECREATED "26-Aug-2024 22:11:48" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;4
 11113  
 
-      :EDIT-BY rmk
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS MEDLEYDIR)
+      :CHANGES-TO (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS)
+                  (FNS SET-SYSOUT-COMMIT)
 
-      :PREVIOUS-DATE "17-Jul-2023 16:13:10" {WMEDLEY}<sources>MEDLEYDIR.;21)
+      :PREVIOUS-DATE " 8-Jul-2024 22:49:43" {DSK}<home>matt>Interlisp>medley>sources>MEDLEYDIR.;3)
 
 
 (PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -15,16 +16,19 @@
        [
         (* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)")

 
-        (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR)
-        (INITVARS (MEDLEYDIR)
-               (\SAVE.MEDLEYDIR))
+        (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR SET-SYSOUT-COMMIT)
+        [INITVARS (MEDLEYDIR)
+               (\SAVE.MEDLEYDIR)
+               (SYSOUTCOMMITS (OR (AND (BOUNDP 'SYSOUTCOMMITS)
+                                       SYSOUTCOMMITS)
+                                  (LIST (LIST 'MEDLEY NIL]
         (ADDVARS (AROUNDEXITFNS MEDLEY-INIT-VARS))
         
         (* ;; "**WARNING**  The EVALed expressions get run early in the lodup.")

 
         (VARS MEDLEY-INIT-VARS)
         (DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS 
-                                                       \SAVE.MEDLEYDIR DIRECTORIES])
+                                                       \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS])
 
 
 
@@ -158,12 +162,21 @@
                   (EQ 1 (STRPOS OLD (U-CASE (MKSTRING BODY]
         THEN
 [PACK* NEW (SUBSTRING BODY (ADD1 (NCHARS OLD]
       ELSE
 BODY])
+
+(SET-SYSOUT-COMMIT

+  [LAMBDA (REPO COMMIT-ID-ENV-VAR)
                           (* ; "Edited  8-Jul-2024 23:31 by mth")

+    (PUTASSOC REPO (LIST (UNIX-GETENV COMMIT-ID-ENV-VAR))
+           SYSOUTCOMMITS])
 )
 
 (RPAQ? MEDLEYDIR
 )
 
 (RPAQ? \SAVE.MEDLEYDIR
 )
 
+(RPAQ? SYSOUTCOMMITS
 (OR (AND (BOUNDP 'SYSOUTCOMMITS)
+                              SYSOUTCOMMITS)
+                         (LIST (LIST 'MEDLEY NIL))))
+
 (ADDTOVAR AROUNDEXITFNS
 MEDLEY-INIT-VARS)
 
 
@@ -172,7 +185,9 @@
 
 
 (RPAQQ MEDLEY-INIT-VARS

-       ([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
+       ((ShellBrowser)
+        (ShellOpener)
+        [LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
         [LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
         (LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
         (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
@@ -203,9 +218,9 @@
                                    NIL NIL T))))
 (DECLARE%: EVAL@COMPILE DOCOPY 
 
-(ADDTOVAR GLOBALVARS
 MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
+(ADDTOVAR GLOBALVARS
 MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1432 8288 (MEDLEY-INIT-VARS 1442 . 4920) (MEDLEYDIR 4922 . 7306) (MEDLEYSUBSTDIR 7308
- . 8286)))))
+  (FILEMAP (NIL (1749 8823 (MEDLEY-INIT-VARS 1759 . 5237) (MEDLEYDIR 5239 . 7623) (MEDLEYSUBSTDIR 7625
+ . 8603) (SET-SYSOUT-COMMIT 8605 . 8821)))))
 STOP

sources/WINDOWOBJ

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Apr-2024 18:08:13" {WMEDLEY}<sources>WINDOWOBJ.;26
 32448  
+
(FILECREATED "17-Jul-2024 21:54:38" {WMEDLEY}<sources>WINDOWOBJ.;27
 32550  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS ENCAPSULATEDOBJP)
-                  (VARS WINDOWOBJCOMS)
+      :CHANGES-TO (FNS IMAGEFNSCREATE)
 
-      :PREVIOUS-DATE " 5-Dec-2023 21:15:38" {WMEDLEY}<sources>WINDOWOBJ.;23)
+      :PREVIOUS-DATE "23-Apr-2024 18:08:13" {WMEDLEY}<sources>WINDOWOBJ.;26)
 
 
 (PRETTYCOMPRINT WINDOWOBJCOMS)
@@ -133,6 +132,7 @@
 (IMAGEFNSCREATE

   [LAMBDA (DISPLAYFN IMAGEBOXFN PUTFN GETFN COPYFN BUTTONEVENTINFN COPYBUTTONEVENTINFN WHENMOVEDFN 
                  WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN CLASSNAME)

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

                                                              (* jds "19-Feb-85 09:33")

 
     (* ;; "returns a structure which contains the image functions for a type of image object.")

@@ -156,7 +156,8 @@
            WHENDELETEDFN _ WHENDELETEDFN
            WHENCOPIEDFN _ WHENCOPIEDFN
            WHENOPERATEDONFN _ WHENOPERATEDONFN
-           PREPRINTFN _ PREPRINTFN])
+           PREPRINTFN _ PREPRINTFN
+           IMAGECLASSNAME _ CLASSNAME])
 
 (IMAGEFNSP

   [LAMBDA (X)
                                            (* rrb " 1-Feb-84 11:13")

@@ -595,11 +596,11 @@ Either delete this image object or load its support files." IMAGEOBJ)
 (ADDTOVAR LAMA
 IMAGEOBJPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4826 23314 (COPYINSERT 4836 . 6363) (IMAGEBOX 6365 . 6545) (IMAGEFNSCREATE 6547 . 7742)
- (IMAGEFNSP 7744 . 7985) (IMAGEOBJCREATE 7987 . 8532) (IMAGEOBJP 8534 . 8775) (IMAGEOBJPROP 8777 . 
-14669) (\IMAGEUSERPROP 14671 . 15265) (HPRINT.IMAGEOBJ 15267 . 15856) (COPYIMAGEOBJ 15858 . 16601) (
-READIMAGEOBJ 16603 . 21960) (WRITEIMAGEOBJ 21962 . 23312)) (23528 32170 (
-ENCAPSULATEDOBJ.BUTTONEVENTINFN 23538 . 25321) (ENCAPSULATEDOBJ.PUTFN 25323 . 26438) (
-ENCAPSULATEDOBJ.DISPLAYFN 26440 . 28243) (ENCAPSULATEDOBJ.IMAGEBOXFN 28245 . 30421) (ENCAPSULATEDOBJP 
-30423 . 30731) (ENCAPSULATEDIMAGEFNS 30733 . 32168)))))
+  (FILEMAP (NIL (4785 23416 (COPYINSERT 4795 . 6322) (IMAGEBOX 6324 . 6504) (IMAGEFNSCREATE 6506 . 7844)
+ (IMAGEFNSP 7846 . 8087) (IMAGEOBJCREATE 8089 . 8634) (IMAGEOBJP 8636 . 8877) (IMAGEOBJPROP 8879 . 
+14771) (\IMAGEUSERPROP 14773 . 15367) (HPRINT.IMAGEOBJ 15369 . 15958) (COPYIMAGEOBJ 15960 . 16703) (
+READIMAGEOBJ 16705 . 22062) (WRITEIMAGEOBJ 22064 . 23414)) (23630 32272 (
+ENCAPSULATEDOBJ.BUTTONEVENTINFN 23640 . 25423) (ENCAPSULATEDOBJ.PUTFN 25425 . 26540) (
+ENCAPSULATEDOBJ.DISPLAYFN 26542 . 28345) (ENCAPSULATEDOBJ.IMAGEBOXFN 28347 . 30523) (ENCAPSULATEDOBJP 
+30525 . 30833) (ENCAPSULATEDIMAGEFNS 30835 . 32270)))))
 STOP