Add git commit ID to beginning of loadups .dribble files.

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

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