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-03-26 02:25:53 +00:00 · 2024-10-07 10:22:48 -07:00 · 2024-10-07 10:19:09 -07:00
11 changed files with 72 additions and 31 deletions
--- 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/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