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)

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

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

@@ -1,4 +1,15 @@
 #!/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)
@@ -7,7 +18,7 @@ main() {
         mkdir -p "${logindir}"
         cmfile=${logindir}/hcfiles.cm
 
-	cat >"${cmfile}" <<-"EOF"
+	cat >"${cmfile}" <<-EOF
 	"
 
 	(PROGN
@@ -27,7 +38,6 @@ main() {
 	"
 	EOF
 
-
         /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command"     \
              --config -                                          \
              --id hcfiles_+                                      \
@@ -37,6 +47,14 @@ main() {
              --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

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