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)
Fix Issue#1841: using medley --vnc option on RaspberryPi OS (#1842 )
2026-04-05 22:03:12 +00:00 · 2024-10-07 10:22:48 -07:00 · 2024-10-07 10:19:09 -07:00 · 2024-09-26 14:08:36 -07:00 · 2024-09-26 13:54:15 -07:00
15 changed files with 306 additions and 48 deletions
--- a/lispusers/READ-BDF
+++ b/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
--- a/lispusers/READ-BDF.DFASL
+++ b/lispusers/READ-BDF.DFASL
--- a/scripts/loadup-apps-from-full.sh
+++ b/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
--- a/scripts/loadup-aux.sh
+++ b/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)
 	)
--- a/scripts/loadup-db-from-full.sh
+++ b/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))
--- a/scripts/loadup-full-from-lisp.sh
+++ b/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
--- a/scripts/loadup-init.sh
+++ b/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*"
--- a/scripts/loadup-lisp-from-mid.sh
+++ b/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
--- a/scripts/loadup-setup.sh
+++ b/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
--- a/scripts/medley/medley.command
+++ b/scripts/medley/medley.command
@@ -1489,10 +1489,10 @@ then
  #
  # Make sure prequisites for vnc support are in place
  #
-  if [ -z "$(which Xvnc)" ] || [ "$(Xvnc -version 2>&1 | grep -iq tigervnc; echo $?)" -eq 1 ]
+  if [ -z "$(which Xtigervnc)" ]
  then
    echo "Error: The -v or --vnc flag was set."
-    echo "But it appears that that TigerVNC server \(Xvnc\) has not been installed."
+    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."
@@ -1501,10 +1501,10 @@ then
  fi
  if [ "${linux}" = "true" ]
  then
-    if [ -z "$(which vncviewer)" ] || [ "$(vncviewer -v 2>&1 | head -2 | grep -iq tigervnc; echo $?)" -eq 1 ]
+    if [ -z "$(which xtigervncviewer)" ]
    then
      echo "Error: The -v or --vnc flag was set."
-      echo "But it appears that that the TigerVNC viewer \(vncviewer\) is not installed on your system."
+      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\")"
@@ -1512,7 +1512,7 @@ then
      echo "Exiting."
      exit 5
    else
-       vncviewer="$(which vncviewer)"
+       vncviewer="$(which xtigervncviewer)"
    fi
  elif [ "${wsl}" = "true" ]
  then
@@ -1537,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
--- a/scripts/medley/medley_vnc.sh
+++ b/scripts/medley/medley_vnc.sh
@@ -67,10 +67,10 @@
  #
  # Make sure prequisites for vnc support are in place
  #
-  if [ -z "$(which Xvnc)" ] || [ "$(Xvnc -version 2>&1 | grep -iq tigervnc; echo $?)" -eq 1 ]
+  if [ -z "$(which Xtigervnc)" ]
  then
    echo "Error: The -v or --vnc flag was set."
-    echo "But it appears that that TigerVNC server \(Xvnc\) has not been installed."
+    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."
@@ -79,10 +79,10 @@
  fi
  if [ "${linux}" = "true" ]
  then
-    if [ -z "$(which vncviewer)" ] || [ "$(vncviewer -v 2>&1 | head -2 | grep -iq tigervnc; echo $?)" -eq 1 ]
+    if [ -z "$(which xtigervncviewer)" ]
    then
      echo "Error: The -v or --vnc flag was set."
-      echo "But it appears that that the TigerVNC viewer \(vncviewer\) is not installed on your system."
+      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\")"
@@ -90,7 +90,7 @@
      echo "Exiting."
      exit 5
    else
-       vncviewer="$(which vncviewer)"
+       vncviewer="$(which xtigervncviewer)"
    fi
  elif [ "${wsl}" = "true" ]
  then
@@ -115,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
--- a/sources/CMLREAD
+++ b/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
--- a/sources/CMLREAD.LCOM
+++ b/sources/CMLREAD.LCOM
--- a/sources/MEDLEYDIR
+++ b/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
--- a/sources/MEDLEYDIR.LCOM
+++ b/sources/MEDLEYDIR.LCOM
Author	SHA1	Message	Date
Matt Heffron	fe04869cb3	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)	2024-10-07 10:22:48 -07:00
Frank Halasz	178807afff	Fix Issue#1841: using medley --vnc option on RaspberryPi OS (#1842 ) In scripts/medley/medley_vnc.sh, update references to Xvnc and vncviewer to their tigervnc-specific versions Xtigervnc and xtigervncviewer. Fixes Issue#1841.	2024-10-07 10:19:09 -07:00
Matt Heffron	e1989850f3	Added new module READ-BDF. (#1811 ) * Added new module READ-BDF. This will parse a bdf font file into a BDF::BDF-FONT structure. It does NOT create (convert into) an IL:FONTDESCRIPTOR instance. Minimal error checking! * Remove work-around for bug in CL:READ-FROM-STRING that is fixed in PR #1833	2024-09-26 14:08:36 -07:00
Matt Heffron	fface7d9de	CL READ-FROM-STRING returns byte position instead of character position. (#1833 ) * Fix for issue 1812: CL:READ-FROM-STRING returns byte position instead of character position. * Previous edit hadn't noticed corresponding issue using the value of the START argument passed to SETFILEPTR	2024-09-26 13:54:15 -07:00