github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

GITFNS: Better default directory-finding, better pseudohosts (#1064) (#1065)

Browse Source 
* GITFNS:  Better default directory-finding, better pseudohosts  (addresses #1064)

Also updated documentation

* GITFNS:  better error message in GIT-MAKE-PROJECT
This commit is contained in:
rmkaplan 2023-02-18 17:19:29 -08:00 committed by GitHub
parent 4b95a8b5d3
commit 12b5e90727
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 254 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

300
lispusers/GITFNS
View File

@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Oct-2022 10:55:40" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;454 118392
(FILECREATED " 5-Feb-2023 12:43:27" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;467 117168
:CHANGES-TO (COMMANDS cdg cdw)
:CHANGES-TO (FNS GIT-MAKE-PROJECT)
:PREVIOUS-DATE " 1-Oct-2022 12:14:04"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;453)
:PREVIOUS-DATE " 1-Feb-2023 18:54:25"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;466)
(PRETTYCOMPRINT GITFNSCOMS)
@ -27,14 +27,15 @@
FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH GIT-MAINBRANCH?)
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS GIT-PROJECT PULLREQUEST))
(INITVARS (GIT-DEFAULT-PROJECT 'MEDLEY)
[GIT-DEFAULT-PROJECTS '((MEDLEY T T
[GIT-DEFAULT-PROJECTS '((MEDLEY NIL NIL
(EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/
tmp/ fontsold/ clos/ cltl2/)
(greetfiles scripts sources library lispusers
internal doctools rooms))
(NOTECARDS T T)
(LOOPS T T)
(TEST T T]
(NOTECARDS)
(LOOPS)
(TEST)
(MAIKO]
(GIT-PROJECTS NIL)))
(P (GIT-INIT))
(ADDVARS (AROUNDEXITFNS GIT-INIT))
@ -151,146 +152,132 @@
ELSE (ERROR "NOT A GIT CLONE" HOST/DIR])
(GIT-INIT
[LAMBDA (EVENT) (* ; "Edited 1-Oct-2022 12:13 by FGH")
[LAMBDA (EVENT) (* ; "Edited 1-Feb-2023 16:22 by rmk")
(* ; "Edited 1-Oct-2022 12:13 by FGH")
(* ; "Edited 8-Aug-2022 21:52 by lmm")
(SELECTQ EVENT
((NIL AFTERMAKESYS AFTERSYSOUT)
(SETQ GIT-PROJECTS NIL)
(for X in GIT-DEFAULT-PROJECTS do (APPLY (FUNCTION GIT-MAKE-PROJECT)
X))
(MKLIST X)))
NIL)
NIL])
(GIT-MAKE-PROJECT
[LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
[LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
(* ; "Edited 5-Feb-2023 12:43 by rmk")
(* ; "Edited 1-Feb-2023 16:55 by rmk")
(* ; "Edited 11-Aug-2022 17:54 by rmk")
(* ; "Edited 13-Jul-2022 13:47 by rmk")
(* ; "Edited 6-Jul-2022 19:34 by rmk")
(* ; "Edited 17-May-2022 17:08 by rmk")
(* ; "Edited 13-May-2022 10:40 by rmk")
(* ; "Edited 12-May-2022 00:26 by rmk")
(* ; "Edited 9-May-2022 16:20 by rmk")
(* ;; "PROJECTPATH must resolve to a git clone.")
(* ;; "CLONEPATH must resolve to a git clone.")
(* ;; "Search sequence for PROJECTPATH, if T or NIL")
(* ;; " (UNIX-GETENV PROJECTNAME) Unix variable ROOMS is the full path name.")
(* ;; " (UNIX-GETENV PROJECTNAME)")
(* ;; " (MEDLEYDIR PROJECTNAME) e.g. {dsk}/Users/kaplan/medley3.5/loops/")
(* ;; " (UNIX-GETENV (CONCAT PROJECTNAME DIR)")
(* ;;
 " (MEDLEYDIR (CONCAT %"git-%" PROJECTNAME) e.g. {dsk}/Users/kaplan/medley3.5/git-medley/")
(* ;; " git-PROJECTNAME sister of MEDLEYDIR ")
(* ;;
 " (MEDLEYDIR (CONCAT PROJECTNAME %"DIR%") e.g. {dsk}/Users/kaplan/medley3.5/notecardsdir/")
(* ;; "If not found, error if NIL, return NIL if T ")
(* ;; " (MEDLEYDIR (CONCAT %"git-%" PROJECTNAME) ")
(* ;; "")
(* ;; "The clone pseudohost is PROJECTNAME e.g. {NOTECARDS}")
(* ;; "If there is a >working-PROJECTNAME> parallel to clonepath, its pseudhost is WPROJECTNAME, e.g. WNOTECARDS")
(* ;; "Error if clone is not found.")
(* ;; "WORKINGPATH T or NIL means try to find a parallel to the projectpath, T means don't cause an error if not found. ")
(SETQ PROJECTNAME (U-CASE (MKATOM PROJECTNAME)))
(CL:WHEN (MEMB PROJECTPATH '(NIL T))
[SETQ PROJECTPATH (OR (GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME)
NIL NIL T)
T)
(GIT-CLONEP (UNIX-GETENV PROJECTNAME)
T)
(GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME 'DIR))
T)
(GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE
PROJECTNAME
)
"/"))
T)
(AND (NULL PROJECTPATH)
(ERROR (CONCAT "Can't a find clone directory for " PROJECTNAME])
(CL:WHEN PROJECTPATH
(LET (CLONEPATH GITIGNORE PROJECT GITPATH WP)
(SETQ PROJECTPATH (SLASHIT (PACKFILENAME 'HOST 'UNIX 'DIRECTORY (UNPACKFILENAME.STRING
(TRUEFILENAME
PROJECTPATH)
'DIRECTORY
'RETURN))
T))
(SETQ CLONEPATH (if (GIT-CLONEP PROJECTPATH T T)
elseif (SETQ GITPATH (GIT-PROJECT-PATH PROJECTNAME PROJECTPATH))
then (SETQ PROJECTPATH GITPATH)
(GIT-CLONEP PROJECTPATH NIL T)
else (ERROR "Can't find GIT clone for" PROJECTPATH)))
(CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY
CLONEPATH)))
(SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE)
(bind L until (EOFP STREAM)
while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL
:EOF-VALUE NIL))
unless (OR (EQ 0 (NCHARS L))
(STRPOS "#" L)) collect L))))
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for E inside EXCLUSIONS
collect (MKSTRING E))
GITIGNORE
`("deleted/" "*.sysout"))
:TEST
(FUNCTION STRING.EQUAL)))
[SETQ CLONEPATH (if (MEMB CLONEPATH '(NIL T))
then
(* ;; "The %"DIR%" handles MEDLEY -> MEDLEYDIR or LOOPS -> LOOPSDIR.")
(* ;; "The %"my-%" case is for backward compatibility, eventually deprecated.")
(* ;; "")
(SETQ WP
(SELECTQ WORKINGPATH
((T NIL)
(OR (DIRECTORYNAME (PACKFILENAME.STRING
'HOST
'DSK
'BODY
(CONCAT (SUBSTRING CLONEPATH 1
(STRPOS "/" CLONEPATH -2 NIL NIL NIL
FILEDIRCASEARRAY T))
"working-"
(OR (SUBSTRING PROJECTPATH
(OR (STRPOS CLONEPATH PROJECTPATH 1 NIL
NIL T FILEDIRCASEARRAY)
-2))
(L-CASE PROJECTNAME))
">"))
T)
(DIRECTORYNAME (PACKFILENAME.STRING
'HOST
'DSK
'BODY
(CONCAT (SUBSTRING CLONEPATH 1
(STRPOS "/" CLONEPATH -2 NIL NIL NIL
FILEDIRCASEARRAY T))
"my-"
(OR (SUBSTRING PROJECTPATH
(OR (STRPOS CLONEPATH PROJECTPATH 1 NIL
NIL T FILEDIRCASEARRAY)
-2))
(L-CASE PROJECTNAME))
">"))
T)))
(DIRECTORYNAME (TRUEFILENAME WORKINGPATH)
T)))
[SETQ WORKINGPATH (if WP
then (UNSLASHIT WP T)
elseif (EQ WORKINGPATH T)
then NIL
else (ERROR (CONCAT "Can't find the working directory "
(OR WORKINGPATH "")
" for " PROJECTNAME]
(SETQ PROJECT (create GIT-PROJECT
PROJECTNAME _ PROJECTNAME
GITHOST _ (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME)
PROJECTPATH)
"}")
WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W"
(OR (GIT-CLONEP (UNIX-GETENV PROJECTNAME)
T)
(GIT-CLONEP (UNIX-GETENV (PACK* PROJECTNAME "DIR"))
T)
(GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME)
NIL NIL T)
T)
(GIT-CLONEP (MEDLEYDIR (CONCAT "../" PROJECTNAME)
NIL NIL T)
T)
(GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE
PROJECTNAME)
WP)
"}"))
EXCLUSIONS _ EXCLUSIONS
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
CLONEPATH _ CLONEPATH))
(/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
(CAR (push GIT-PROJECTS (CONS PROJECTNAME]
PROJECT)
PROJECTNAME))])
"/"))
T)
(ERROR (CONCAT "Can't a find clone directory for " PROJECTNAME)))
elseif (GIT-CLONEP (SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY
(UNPACKFILENAME.STRING (TRUEFILENAME
CLONEPATH)
'DIRECTORY
'RETURN))
T)
T T)
else (ERROR (CONCAT "Can't find clone directory " CLONEPATH " for " PROJECTNAME
]
(LET (GITIGNORE PROJECT WP)
(CL:WHEN (SETQ GITIGNORE (INFILEP (PACKFILENAME.STRING 'NAME ".gitignore" 'BODY CLONEPATH)))
(SETQ GITIGNORE (CL:WITH-OPEN-FILE (STREAM GITIGNORE)
(bind L until (EOFP STREAM)
while (SETQ L (CL:READ-LINE STREAM :EOF-ERROR-P NIL :EOF-VALUE
NIL))
unless (OR (EQ 0 (NCHARS L))
(STRPOS "#" L)) collect L))))
(SETQ EXCLUSIONS (CL:REMOVE-DUPLICATES (APPEND (for E inside EXCLUSIONS
collect (MKSTRING E))
GITIGNORE
`("deleted/" "*.sysout"))
:TEST
(FUNCTION STRING.EQUAL)))
(* ;; "We now have the clonepath and the extra parameters for the project. Do we have a separate working environment?")
(SETQ WP
(SELECTQ WORKINGPATH
((T NIL)
(DIRECTORYNAME (PACKFILENAME.STRING 'HOST 'DSK 'BODY
(CONCAT (SUBSTRING CLONEPATH 1
(STRPOS "/" CLONEPATH -2 NIL NIL NIL
FILEDIRCASEARRAY T))
"working-"
(OR (SUBSTRING CLONEPATH
(OR (STRPOS CLONEPATH CLONEPATH 1 NIL NIL
T FILEDIRCASEARRAY)
-2))
(L-CASE PROJECTNAME))
">"))
T))
(DIRECTORYNAME (TRUEFILENAME WORKINGPATH)
T)))
[SETQ WORKINGPATH (if WP
then (UNSLASHIT WP T)
elseif WORKINGPATH
then (ERROR (CONCAT "Can't find the working directory "
(AND (EQ WORKINGPATH T)
"")
" for " PROJECTNAME]
(SETQ PROJECT (create GIT-PROJECT
PROJECTNAME _ PROJECTNAME
GITHOST _ (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH)
"}")
WHOST _ (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" PROJECTNAME
)
WORKINGPATH)
"}"))
EXCLUSIONS _ EXCLUSIONS
DEFAULTSUBDIRS _ (MKLIST DEFAULTSUBDIRS)
CLONEPATH _ CLONEPATH))
(/RPLACD [OR (ASSOC PROJECTNAME GIT-PROJECTS)
(CAR (push GIT-PROJECTS (CONS PROJECTNAME]
PROJECT)
PROJECTNAME])
(GIT-GET-PROJECT
[LAMBDA (PROJECT FIELD NOERROR) (* ; "Edited 7-Jul-2022 11:25 by rmk")
@ -391,11 +378,12 @@
(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
(RPAQ? GIT-DEFAULT-PROJECTS
'((MEDLEY T T (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
'((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
(greetfiles scripts sources library lispusers internal doctools rooms))
(NOTECARDS T T)
(LOOPS T T)
(TEST T T)))
(NOTECARDS)
(LOOPS)
(TEST)
(MAIKO)))
(RPAQ? GIT-PROJECTS NIL)
@ -2213,31 +2201,31 @@
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3970 19443 (GIT-CLONEP 3980 . 5243) (GIT-INIT 5245 . 5757) (GIT-MAKE-PROJECT 5759 .
14144) (GIT-GET-PROJECT 14146 . 16071) (GIT-PROJECT-PATH 16073 . 17117) (FIND-ANCESTOR-DIRECTORY 17119
. 17468) (GIT-FIND-CLONE 17470 . 18551) (GIT-MAINBRANCH 18553 . 18948) (GIT-MAINBRANCH? 18950 . 19441
)) (25861 28649 (ALLSUBDIRS 25871 . 27157) (MEDLEYSUBDIRS 27159 . 27852) (GITSUBDIRS 27854 . 28647)) (
28650 33440 (TOGIT 28660 . 30066) (FROMGIT 30068 . 31049) (GIT-DELETE-FILE 31051 . 31897) (
MYMEDLEY-DELETE-FILES 31899 . 33438)) (33441 36444 (MYMEDLEYSUBDIR 33451 . 33907) (GITSUBDIR 33909 .
34352) (STRIPDIR 34354 . 34725) (STRIPHOST 34727 . 34967) (STRIPNAME 34969 . 35722) (STRIPWHERE 35724
. 36442)) (36445 38347 (GFILE4MFILE 36455 . 36818) (MFILE4GFILE 36820 . 37389) (GIT-REPO-FILENAME
37391 . 38345)) (38396 48218 (GIT-COMMIT 38406 . 39232) (GIT-PUSH 39234 . 39878) (GIT-PULL 39880 .
40492) (GIT-APPROVAL 40494 . 40843) (GIT-GET-FILE 40845 . 42810) (GIT-FILE-EXISTS? 42812 . 43086) (
GIT-REMOTE-UPDATE 43088 . 43812) (GIT-REMOTE-ADD 43814 . 44121) (GIT-FILE-DATE 44123 . 45054) (
GIT-FILE-HISTORY 45056 . 46990) (GIT-PRINT-FILE-HISTORY 46992 . 48042) (GIT-FETCH 48044 . 48216)) (
48248 58841 (GIT-BRANCH-DIFF 48258 . 54598) (GIT-COMMIT-DIFFS 54600 . 55153) (GIT-BRANCH-RELATIONS
55155 . 58839)) (58886 71118 (GIT-BRANCH-NUM 58896 . 59469) (GIT-CHECKOUT 59471 . 60530) (
GIT-WHICH-BRANCH 60532 . 60830) (GIT-MAKE-BRANCH 60832 . 63045) (GIT-BRANCHES 63047 . 65315) (
GIT-BRANCH-EXISTS? 65317 . 66021) (GIT-PICK-BRANCH 66023 . 66351) (GIT-PRC-MENU 66353 . 68356) (
GIT-PULL-REQUESTS 68358 . 70504) (GIT-SHORT-BRANCH-NAME 70506 . 70797) (GIT-LONG-NAME 70799 . 71116))
(71148 74483 (GIT-MY-CURRENT-BRANCH 71158 . 71528) (GIT-MY-BRANCHP 71530 . 72035) (GIT-MY-NEXT-BRANCH
72037 . 72531) (GIT-MY-BRANCHES 72533 . 74481)) (74529 78481 (GIT-ADD-WORKTREE 74539 . 76023) (
GIT-REMOVE-WORKTREE 76025 . 76955) (GIT-LIST-WORKTREES 76957 . 77761) (WORKTREEDIR 77763 . 78479)) (
78529 109738 (GIT-GET-DIFFERENT-FILES 78539 . 84963) (GIT-BRANCHES-COMPARE-DIRECTORIES 84965 . 91122)
(GIT-WORKING-COMPARE-DIRECTORIES 91124 . 95950) (GIT-COMPARE-WORKTREE 95952 . 99930) (GITCDOBJBUTTONFN
99932 . 104422) (GIT-CD-LABELFN 104424 . 105506) (GIT-CD-MENUFN 105508 . 107948) (
GIT-WORKING-COMPARE-FILES 107950 . 108570) (GIT-BRANCHES-COMPARE-FILES 108572 . 109736)) (109808
118325 (CDGITDIR 109818 . 110378) (GIT-COMMAND 110380 . 111938) (GITORIGIN 111940 . 112637) (
GIT-INITIALS 112639 . 112943) (GIT-COMMAND-TO-FILE 112945 . 116434) (PROCESS-COMMAND 116436 . 117049)
(GIT-RESULT-TO-LINES 117051 . 117658) (STRIPLOCAL 117660 . 118323)))))
(FILEMAP (NIL (4019 18210 (GIT-CLONEP 4029 . 5292) (GIT-INIT 5294 . 5924) (GIT-MAKE-PROJECT 5926 .
12911) (GIT-GET-PROJECT 12913 . 14838) (GIT-PROJECT-PATH 14840 . 15884) (FIND-ANCESTOR-DIRECTORY 15886
. 16235) (GIT-FIND-CLONE 16237 . 17318) (GIT-MAINBRANCH 17320 . 17715) (GIT-MAINBRANCH? 17717 . 18208
)) (24637 27425 (ALLSUBDIRS 24647 . 25933) (MEDLEYSUBDIRS 25935 . 26628) (GITSUBDIRS 26630 . 27423)) (
27426 32216 (TOGIT 27436 . 28842) (FROMGIT 28844 . 29825) (GIT-DELETE-FILE 29827 . 30673) (
MYMEDLEY-DELETE-FILES 30675 . 32214)) (32217 35220 (MYMEDLEYSUBDIR 32227 . 32683) (GITSUBDIR 32685 .
33128) (STRIPDIR 33130 . 33501) (STRIPHOST 33503 . 33743) (STRIPNAME 33745 . 34498) (STRIPWHERE 34500
. 35218)) (35221 37123 (GFILE4MFILE 35231 . 35594) (MFILE4GFILE 35596 . 36165) (GIT-REPO-FILENAME
36167 . 37121)) (37172 46994 (GIT-COMMIT 37182 . 38008) (GIT-PUSH 38010 . 38654) (GIT-PULL 38656 .
39268) (GIT-APPROVAL 39270 . 39619) (GIT-GET-FILE 39621 . 41586) (GIT-FILE-EXISTS? 41588 . 41862) (
GIT-REMOTE-UPDATE 41864 . 42588) (GIT-REMOTE-ADD 42590 . 42897) (GIT-FILE-DATE 42899 . 43830) (
GIT-FILE-HISTORY 43832 . 45766) (GIT-PRINT-FILE-HISTORY 45768 . 46818) (GIT-FETCH 46820 . 46992)) (
47024 57617 (GIT-BRANCH-DIFF 47034 . 53374) (GIT-COMMIT-DIFFS 53376 . 53929) (GIT-BRANCH-RELATIONS
53931 . 57615)) (57662 69894 (GIT-BRANCH-NUM 57672 . 58245) (GIT-CHECKOUT 58247 . 59306) (
GIT-WHICH-BRANCH 59308 . 59606) (GIT-MAKE-BRANCH 59608 . 61821) (GIT-BRANCHES 61823 . 64091) (
GIT-BRANCH-EXISTS? 64093 . 64797) (GIT-PICK-BRANCH 64799 . 65127) (GIT-PRC-MENU 65129 . 67132) (
GIT-PULL-REQUESTS 67134 . 69280) (GIT-SHORT-BRANCH-NAME 69282 . 69573) (GIT-LONG-NAME 69575 . 69892))
(69924 73259 (GIT-MY-CURRENT-BRANCH 69934 . 70304) (GIT-MY-BRANCHP 70306 . 70811) (GIT-MY-NEXT-BRANCH
70813 . 71307) (GIT-MY-BRANCHES 71309 . 73257)) (73305 77257 (GIT-ADD-WORKTREE 73315 . 74799) (
GIT-REMOVE-WORKTREE 74801 . 75731) (GIT-LIST-WORKTREES 75733 . 76537) (WORKTREEDIR 76539 . 77255)) (
77305 108514 (GIT-GET-DIFFERENT-FILES 77315 . 83739) (GIT-BRANCHES-COMPARE-DIRECTORIES 83741 . 89898)
(GIT-WORKING-COMPARE-DIRECTORIES 89900 . 94726) (GIT-COMPARE-WORKTREE 94728 . 98706) (GITCDOBJBUTTONFN
98708 . 103198) (GIT-CD-LABELFN 103200 . 104282) (GIT-CD-MENUFN 104284 . 106724) (
GIT-WORKING-COMPARE-FILES 106726 . 107346) (GIT-BRANCHES-COMPARE-FILES 107348 . 108512)) (108584
117101 (CDGITDIR 108594 . 109154) (GIT-COMMAND 109156 . 110714) (GITORIGIN 110716 . 111413) (
GIT-INITIALS 111415 . 111719) (GIT-COMMAND-TO-FILE 111721 . 115210) (PROCESS-COMMAND 115212 . 115825)
(GIT-RESULT-TO-LINES 115827 . 116434) (STRIPLOCAL 116436 . 117099)))))
STOP

BIN
lispusers/GITFNS.LCOM
View File

Binary file not shown.

167
lispusers/GITFNS.TEDIT
View File

@ -1,95 +1,148 @@
Medley GITFNS2
Medley GITFNS 2
4
1
GITFNS 1
4
By Ron Kaplan This document was last edited in May 2022. GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository. This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file. This may be particularly helpful in evaluating the changes in a pull request.
Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions. GITFNS allows for intelligent comparisons between Lisp source files,Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
By Ron Kaplan This document was last edited in February 2023. GITFNS provides a Medley-oriented interface for comparing the files in two different branches of a git repository. This makes it easier to understand what functions or other definitions have changed in a Lisp source file, or what text has changed in a Tedit file. This may be particularly helpful in evaluating the changes in a pull request.
Separately, GITFNS also provides tools and conventions for bridging between git's file-oriented style of development and version control and Medley's residential development style with its own version control conventions. GITFNS allows for intelligent comparisons between Lisp source files, Tedit files, and text files in a local git clone and a local Medley-style working directory, and for migrating files to and from the git clone and the working directory.
Git projects: Connecting git clones to GITFNS capabilities
The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk. The path to a clone can be used to create a "git project" for that clone:
(GIT-MAKE-PROJECT PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS
DEFAULTSUBDIRS) [function]
The GITFNS capabilities operate on pre-existing clones of remote git repositories that have been installed at the end of some path on the local disk. The path to a clone can be used to create a GITFNS "project" for that clone:
(GIT-MAKE-PROJECT PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS
DEFAULTSUBDIRS) [Function]
where
PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...)
PROJECTPATH is the local path to the clone
(e.g. {dsk}<users>...>git-medley)
PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...)
CLONEPATH specifies the local path to the clone
e.g. {dsk}<users>...>git-medley
WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}<users>...>working-medley>)
When the project has a WORKINGPATH:
EXCLUSIONS is a list of files and directories to be excluded from comparisons (beyond what its .GITIGNORE specifies)
When the project has a working path:
EXCLUSIONS is a list of files and directories to be excluded from comparisons (including what its .gitignore specifies)
DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified.
For convenience, if PROJECTPATH is NIL or T (and not a path), then a squence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
(UNIX-GETENV PROJECTNAME)
(UNIX-GETENV (CONCAT PROJECTNAME 'DIR)
(CONCAT MEDLEYDIR "../git-" PROJECTNAME)
For convenience, if CLONEPATH is NIL or T (and not a path), then a sequence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
(UNIX-GETENV PROJECTNAME) e.g. (UNIX-GETENV 'LOOPS)
(UNIX-GETENV (CONCAT PROJECTNAME "DIR") e.g.{UNIX-GETENV 'LOOPSDIR)
(MEDLEYDIR PROJECTNAME)) a subdirectory of MEDLEYDIR
(MEDLEYDIR (CONCAT "../" PROJECTNAME)) a sister of MEDLEYDIR
(MEDLEYDIR (CONCAT "../git-" PROJECTNAME)
(a sister of MEDLEYDIR named git-PROJECTNAME, e.g. git-notecards)
Thus:
If MEDLEYDIR is defined,
(GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project
(GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project
If NOTECARDS is defined
(GIT-MAKE-PROJECT 'NOTECARDS) will make the NOTECARDS project
If NOTECARDS is not defined but the clone >git-notecards> is a sister of MEDLEYDIR, then the NOTECARDS project will still be created.
If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME. Otherwise, NIL will be returned if PROJECTPATH is T (= no-error), and PROJECTPATH=NIL will result in an error.
If a clone is discovered and a project is created, the value of GIT-MAKE-PROJECT is PROJECTNAME. Otherwise, NIL will be returned if CLONEPATH is T (= no-error), and CLONEPATH=NIL will result in an error.
When they are created, git projects are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional PROJECTNAME argument is not provided.
GIT-MAKE-PROJECT creates a pseudohost {projectname} whose path prefix is the path that resolved to the clone. The file GITFNS in the clone LISPUSERS directory, for example, can be referenced as {MEDLEY}<LISPUSERS>GITFNS.
GIT-MAKE-PROJECT will also create a pseudohost {Wprojectname} for the user's working environment for the project. If WORKINGPATH is provided, that will be the prefix for that pseudohost. If WORKINGPATH is NIL and a directory named working-projectname> is a sister to the clone directory, the pseudohost will point to that.
When GITFNS is loaded, GIT-MAKE-PROJECT is called for MEDLEY, NOTECARDS, and LOOPS, with PROJECTPATH=T. Thus, those projects will be created automatically, if MEDLEYDIR is defined and the relevant directories exist in their expected relative positions.
When they are created, GIT-PROJECTS are registered by name on the a-list GIT-PROJECTS, and they can otherwise be referenced by their names.
The variable GIT-DEFAULT-PROJECT, initially MEDLEY, contains the project name used by the commands below when the optional projectname argument is not provided.
GIT-MAKE-PROJECT also creates a pseudohost {Gprojectname} whose path prefix is the prefix for the project's clone. If WORKINGPATH is provided, then a second pseudohost {Wprojectname} points to the working files for the project.
GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
cdg (projectname) (subdir) [command]
cdw (projectname) (subdir) [command
For example, cdg notecards library connects to {GNOTECARDS}/library/.
(GIT-INIT EVENT) [Function]
GIT-INIT creates the default set of projects when GITFNS is loaded, as specified in the variable GIT-DEFAULT-PROJECTS, initially containing MEDLEY NOTECARDS LOOPS TEST. GIT-INIT is added to AROUNDEXITFNS so that new pseudohost bindings for the default projects will be created if the sysout or makesys is started on a new machine.
GIT-DEFAULT-PROJECTS [Variable]
Determines the projects that are created (or recreated) by GIT-INIT. This is initialized for the MEDLEY NOTECARDS LOOPS TEST projects, with CLONEPATH=NIL GITFNS also defines two directory-connecting commands for conveniently connecting to the git and working pseudohosts of a project:
cdg (projectname) (subdir) [Command]
cdw (projectname) (subdir) [Command]
For example, cdg notecards library connects to {NOTECARDS}/library/.
Comparing directories and files in different git branches
In its simplest application, GITFNS is just an off-to-the-side add-on to whatever work practices the user has developed with respect to a locally installed git project. Its only advantage is to allow for more interpretable git-branch comparisons, especially for pull-request approval. These comparisons are provided by the prc ("pull request compare") Medley executive command:
prc (branch) (DRAFT) (projectname) [command]
This compares the files in branch against the files in the main branch of the project (origin/master or origin/main). Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project. Then
prc rmk15
prc (branch) (DRAFT) (projectname) [Command] This compares the files in branch against the files in the main branch of the project (origin/master or origin/main). Thus, suppose that a pull request has been issued on github for a particular branch, say branch rmk15 of the default project. Then prc rmk15
brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser.
If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided. If gh is not available, the menu will offer all known branches. If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones.
If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by
rmk15 > rmk14
Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
bbc branch1 branch2 (project) [command]
This compares the files in branch1 and branch2, for example
Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands. prc is the special case of the more general bbc command ("branch-branch compare") for comparing the files in any two branches:
bbc branch1 branch2 (project) [Command] This compares the files in branch1 and branch2, for example
bbc rmk15 lmm12 (local)
This will compare the files in origin/rmk15 and origin/lmm12 in the GIT-DEFAULT project. branch1 defaults to the origin files of the currently checked out branch, the second defaults to origin/master. If local is non-NIL, then a branch that has neither local/ or origin/ prepended will default to local (e.g. local/rmk15) instead of origin/. Local refers to the files that are currently in the clone directory, which may not be the same as the origin files, depending on the push/pull status.
Either of the branches can be specified with an atom LOCAL, REMOTE, or ORIGIN, in which case bbc will offer menus listing the currently existing branches of that type.
NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare. A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally.
The command cob ("check out branch") checks out a specified branch:
cob branch (nexttitlestring) (project) [command]
NOTE: Branch comparison makes use of a git command that has a limit (diff.renameLimit) on the number of files that it can successfully compare. A message will be printed if that limit is exceeded, asking whether a larger value for that limit should be applied globally. The command cob ("check out branch") checks out a specified branch:
cob branch (next-title-string) (project) [Command]
This checks out branch of project and then executes git pull. The branch parameter may also be a local branch, T (= the current working branch), or NEW/NEXT (= the next working branch). The current working branch is the branch named <initials>nnn, e.g. rmk15. The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials.
If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. If nexttitlestring is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens. Spaces in nexttitlestring will also be replaced by hyphens, according to git conventions.
If branch is not provided, a menu of locally available branches pops up.
The currently checked out branch is obtained by the b? command:
b? (project) [command]
If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. If next-title-string is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens. Spaces in next-title-string will also be replaced by hyphens, according to git conventions.
If branch is not provided, a menu of locally available branches pops up. The currently checked out branch is obtained by the b? command:
b? (project) [Command]
Correlating git source control with separate Medley development
It is generally unsafe to do Medley development by operating with files in a local clone repository. Medley provides a residential development environment that integrates tightly with the local file system. It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from. This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes.
GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory. The location of the Medley development source tree for a project is given by the WORKINGPATH argument to GIT-MAKE-PROJECT. If WORKINGPATH is T or NIL and there exists a directory >working-projectname> as a sister to the clone, then that is taken to be the WORKINGPATH and thus the prefix for a pseudohost {Wprojectname}.
When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR (or {WMEDLEY}) as a prefix. In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR.
Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions. Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention.
The files in Medley working tree and the git clone of a project can be compared with the gwc ("git-working-compare") command:
gwc subdirectories (project) [command]
This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}.
gwc subdirectories (project) [Command]
This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {projectname} to {Wprojectname} and deleting files from {Wprojectname}.
If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.
Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) .È4 ÈÈ4 ÈÈ4ÈÈ4ÈÈ4ÈÈ4ÈÈ4È È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADTERMINAL
Note that the menu item for deleting Medley files will cause all versions to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deleted> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
GITFNS does not (yet?) include functions for commits, pushes, or merge for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))).È.È4 ÈÈ4 ÈÈ4ÈÈ4ÈÈ4ÈÈ4ÈÈ4È È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADTERMINAL
MODERN
TIMESROMAN$TERMINALMODERN
MODERN MODERN
MODERN
  HRULE.GETFN  HRULE.GETFNMODERN
  HRULE.GETFNMODERN
   HRULE.GETFNMODERN   HRULE.GETFNMODERN 
 ,  R Íè  ; âB1 L-.Š$w a  <00>     / 27#h ð  ß  n  ƒ  Ç ƒ ( 'G  !    =c    5  3 $  
 Ç,  I   À  )1          <’ö 5H -  & 0   %9"?  M  s  I  ""    ¾   w 6 D l  BZ D
Ù D -. (  ‡2   D  ‡ Uf
< D  õz D  œ.D‚zº
 HRULE.GETFNMODERN
  HRULE.GETFNMODERN
  HRULE.GETFNMODERN
   HRULE.GETFNMODERN   HRULE.GETFNMODERN  
1

R
Íé

;
¹@,

 "  &  \ 
X
 p  6 ,
 
)
 
) 
+      5     
@ &  
I 7
 o
 E .
8 > I


Y  €

$
; 
}
(
) 9
!
0
4  c
 
5  vB 
1OLJ
''

œ
)2
+
 

    Z !  œ
5H

5
5
>$N ! M
§‹A
@
4

@Ô
â   k 6.  R   < 9  
'
Y" ( ? “F 
<00>

ìË
ò1Sýzº