XTOUCODE doesn't fail for nonexistent mappings (#1816)

assigns a unique otherwise unallocated Unicode code.  Addresses bug reported in #1814

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

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

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