1
0
mirror of synced 2026-02-25 08:39:51 +00:00

Rmk40 shakedown gitfns projects (#774)

* GITFNS:  smoothed out some project glitches

Also added "titlestring" to cob command when creating a new branch.
cob next "fixed a bug" will create the next branch for the current initials with the title string appended.

* MACHINEINDEPENDENT:  DOFILESLOAD tries packing on DIRECTORY as well as DIRECTORIES
This commit is contained in:
rmkaplan
2022-05-21 19:55:00 -07:00
committed by GitHub
parent d2ce98d131
commit 48ebc675a7
5 changed files with 261 additions and 198 deletions

View File

@@ -1,12 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-May-2022 10:51:44" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;278 95386
(FILECREATED "19-May-2022 19:19:14" 
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;296 97537
:CHANGES-TO (COMMANDS cdg cdw)
:CHANGES-TO (FNS GIT-MY-CURRENT-BRANCH GIT-MAKE-BRANCH GIT-NEXT-WORKING-BRANCH GIT-BRANCH-NUM
GIT-MY-BRANCHP GIT-MY-BRANCHES)
(VARS GITFNSCOMS)
(COMMANDS cob)
:PREVIOUS-DATE "13-May-2022 10:45:15"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;277)
:PREVIOUS-DATE "19-May-2022 14:08:39"
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;295)
(PRETTYCOMPRINT GITFNSCOMS)
@@ -40,7 +43,7 @@
(* ;; "Lisp exec commands")
(INITVARS (GIT-MERGE-COMPARES T))
(COMMANDS gmc bbc prc cob b? cdg cdw)
(COMMANDS gwc bbc prc cob b? cdg cdw)
(* ;; "")
@@ -69,8 +72,8 @@
(* ;; "Branches")
(FNS GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS?
GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS)
(FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES
GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS)
(* ;; "My branches")
@@ -88,7 +91,7 @@
(* ;; "Comparisons")
(FNS GIT-GET-DIFFERENT-FILES GIT-COMPARE-BRANCHES GIT-COMPARE-WITH-MYMEDLEY
(FNS GIT-GET-DIFFERENT-FILES GIT-COMPARE-BRANCHES GIT-COMPARE-WITH-WORKINGMEDLEY
GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN)
(INITVARS (FROMGITN 0))
@@ -97,7 +100,8 @@
(* ;; "Utilities")
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS)))
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS)
(PROPS (GITFNS FILETYPE))))
@@ -141,6 +145,7 @@
(GIT-MAKE-PROJECT
[LAMBDA (PROJECTNAME PROJECTPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS)
(* ; "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")
@@ -201,26 +206,49 @@
`("deleted/" "*.sysout"))
:TEST
(FUNCTION STRING.EQUAL)))
[SETQ WP
(DIRECTORYNAME (SELECTQ WORKINGPATH
((T NIL)
(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))
">")))
(TRUEFILENAME WORKINGPATH]
(* ;; "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 my working directory "
ELSE (ERROR (CONCAT "Can't find the working directory "
(OR WORKINGPATH "")
" for " PROJECTNAME]
(SETQ PROJECT (CREATE GIT-PROJECT
@@ -350,7 +378,7 @@
(RPAQ? GIT-MERGE-COMPARES T)
(DEFCOMMAND gmc (SUBDIR . OTHERS)
(DEFCOMMAND gwc (SUBDIR . OTHERS)
(* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project")
@@ -361,14 +389,14 @@
THEN (SETQ PROJECT (CAR STAIL))
(GO $$OUT))
(CAR STAIL)))
(GIT-COMPARE-WITH-MYMEDLEY SUBDIRS NIL NIL NIL T PROJECT)))
(GIT-COMPARE-WITH-WORKINGMEDLEY SUBDIRS NIL NIL NIL T PROJECT)))
(DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
(* ;; "Compares 2 git branches. Defaults to local/ if LOCAL, otherwise defaults to origin/. BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(GIT-COMPARE-BRANCHES BRANCH1 (OR BRANCH (GIT-MAINBRANCH PROJECT LOCAL))
(GIT-COMPARE-BRANCHES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
LOCAL PROJECT))
(DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT)
@@ -378,7 +406,7 @@
(LET ((RB REMOTEBRANCH)
(DR DRAFTS))
(IF PROJECT
THEN (SETQ PROOJECT (GIT-GET-PROJECT PROJECT))
THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
ELSEIF (GIT-GET-PROJECT RB T)
THEN (SETQ PROJECT RB)
(SETQ RB NIL)
@@ -389,29 +417,31 @@
'(DRAFT DRAFTS))
(SETQ RB NIL)
(SETQ DR T))
(CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT)
"Pull requests" NIL PROJECT)))
(CL:WHEN (OR RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT)
"Pull requests"))
(GIT-COMPARE-BRANCHES RB (GIT-MAINBRANCH PROJECT)
NIL PROJECT))))
(DEFCOMMAND cob (BRANCH PROJECT)
(DEFCOMMAND cob (BRANCH TITLESTRING PROJECT)
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now). Default is to bring up a menu of locally available branches.")
(* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and STRING if given will be attached to the branch-name. Default is to bring up a menu of locally available branches.")
(CL:UNLESS PROJECT
(CL:WHEN (GIT-GET-PROJECT BRANCH T)
(SETQ PROJECT BRANCH)
(SETQ BRANCH NIL)))
(CL:UNLESS (STRINGP TITLESTRING)
(SETQ PROJECT TITLESTRING))
(CL:UNLESS PROJECT
(CL:WHEN (GIT-GET-PROJECT BRANCH T)
(SETQ PROJECT BRANCH)
(SETQ BRANCH NIL)))
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(SELECTQ (U-CASE BRANCH)
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
PROJECT))
((NEW NEXT)
(GIT-MAKE-BRANCH NIL NIL PROJECT))
(GIT-CHECKOUT (OR BRANCH (GIT-PICK-BRANCH NIL (CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT)
T)
" branches")
'LOCAL PROJECT))
(GIT-MAKE-BRANCH NIL TITLESTRING PROJECT))
(GIT-CHECKOUT (OR BRANCH (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
(CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT)
T)
" branches")))
PROJECT)))
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
@@ -982,6 +1012,19 @@
(DEFINEQ
(GIT-BRANCH-NUM
[LAMBDA (BRANCH INITS) (* ; "Edited 19-May-2022 19:11 by rmk")
(* ;; "Returns nnn if BRANCH is ({local|origin}/)INITSnnn(-xxxx)")
(CL:UNLESS INITS
(SETQ INITS (GIT-INITIALS)))
(LET (NPOS (SPOS (OR (STRPOS "/" BRANCH 1 NIL NIL T)
1)))
(CL:WHEN (SETQ NPOS (STRPOS INITS BRANCH SPOS NIL NIL T UPPERCASEARRAY))
[NUMBERP (SUBATOM BRANCH NPOS (SUB1 (OR (STRPOS "-" BRANCH NPOS)
0])])
(GIT-CHECKOUT
[LAMBDA (BRANCH PROJECT) (* ; "Edited 9-May-2022 15:12 by rmk")
(* ; "Edited 7-May-2022 23:51 by rmk")
@@ -998,7 +1041,8 @@
(MKATOM (CONCAT "local/" (CAR (GIT-COMMAND "git rev-parse --abbrev-ref HEAD" NIL NIL PROJECT])
(GIT-MAKE-BRANCH
[LAMBDA (NAME TITLESTRING PROJECT) (* ; "Edited 9-May-2022 15:13 by rmk")
[LAMBDA (NAME TITLESTRING PROJECT) (* ; "Edited 19-May-2022 17:57 by rmk")
(* ; "Edited 9-May-2022 15:13 by rmk")
(* ;; " The new branch is directly under the currently checked out branch. Maybe it should always make it under the main branch?")
@@ -1010,7 +1054,14 @@
(CL:UNLESS NAME
(SETQ NAME (GIT-MY-NEXT-BRANCH PROJECT)))
(CL:WHEN TITLESTRING
(SETQ NAME (CONCAT NAME (CONCAT ": " TITLESTRING))))
(* ;; "Git branch names can't contain spaces or colons")
[SETQ TITLESTRING (CONCATCODES (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE TITLESTRING I))
COLLECT (IF (EQ C (CHARCODE SPACE))
THEN (CHARCODE -)
ELSE C]
(SETQ NAME (CONCAT NAME "--" TITLESTRING)))
(LET ((UNDER (GIT-WHICH-BRANCH PROJECT))
(RESULT (GIT-COMMAND (CONCAT "git checkout -b " NAME)
NIL NIL PROJECT)))
@@ -1024,27 +1075,30 @@
ELSE (HELP "Unexpected git result" RESULT])
(GIT-BRANCHES
[LAMBDA (WHERE PROJECT) (* ; "Edited 9-May-2022 14:10 by rmk")
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 19-May-2022 10:06 by rmk")
(* ; "Edited 9-May-2022 14:10 by rmk")
(* ; "Edited 7-May-2022 23:29 by rmk")
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(* ;; "Strips of the %"* %" that indicates the current branch and the 2-space padding on other branches. Packs local/ on to local branches")
(LET [[LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
(LET ([LOCAL (CL:WHEN (MEMB (U-CASE WHERE)
'(NIL ALL LOCAL))
(FOR B IN (GIT-COMMAND "git branch" NIL NIL PROJECT)
COLLECT (PACK* "local/" (SUBATOM B 3))))]
(REMOTE (CL:WHEN (MEMB (U-CASE WHERE)
[REMOTE (CL:WHEN (MEMB (U-CASE WHERE)
'(NIL ALL REMOTE T))
(FOR B IN (GIT-COMMAND "git branch -r" NIL NIL PROJECT)
COLLECT (SUBATOM B 3)))]
(SORT (APPEND LOCAL REMOTE])
BRANCHES)
(SETQ BRANCHES (APPEND LOCAL REMOTE))
(CL:WHEN EXCLUDEMERGED
(SETQ BRANCHES (FOR B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT LOCAL)) IN BRANCHES
UNLESS (GIT-COMMIT-DIFFS B MAINBRANCH PROJECT) COLLECT B)))
(SORT BRANCHES])
(GIT-BRANCH-EXISTS?
[LAMBDA (BRANCH NOERROR PROJECT) (* ; "Edited 9-May-2022 14:18 by rmk")
(* ; "Edited 7-May-2022 23:28 by rmk")
(* ; "Edited 3-May-2022 12:56 by rmk")
(* ; "Edited 17-Nov-2021 18:24 by rmk:")
[LAMBDA (BRANCH NOERROR PROJECT EXCLUDEMERGED) (* ; "Edited 19-May-2022 10:10 by rmk")
(* ;; "Returns the canonical name of the branch (xxx or origin/xxx) depending on whether BRANCH is local/xxx or origin/xxx")
@@ -1053,51 +1107,43 @@
THEN 'REMOTE
ELSEIF (STRPOS "local/" BRANCH 1 NIL T)
THEN 'LOCAL)
PROJECT)))
PROJECT EXCLUDEMERGED)))
ELSEIF (NOT NOERROR)
THEN (ERROR "Unknown branch" BRANCH])
(GIT-PICK-BRANCH
[LAMBDA (BRANCHES TITLE WHERE PROJECT) (* ; "Edited 11-May-2022 23:53 by rmk")
(* ; "Edited 9-May-2022 17:07 by rmk")
(* ; "Edited 7-May-2022 23:54 by rmk")
(* ; "Edited 6-Mar-2022 08:55 by rmk")
(* ; "Edited 25-Feb-2022 09:02 by rmk")
(MENU (CREATE MENU
TITLE _ (OR TITLE 'Branches)
ITEMS _ (OR (LISTP BRANCHES)
(GIT-BRANCHES WHERE PROJECT))
MENUFONT _ DEFAULTFONT])
[LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk")
(CL:WHEN (MKLIST BRANCHES)
(MENU (CREATE MENU
TITLE _ (OR TITLE 'Branches)
ITEMS _ BRANCHES
MENUFONT _ DEFAULTFONT)))])
(GIT-PRC-MENU
[LAMBDA (DRAFT PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk")
(* ; "Edited 7-May-2022 23:48 by rmk")
(* ; "Edited 6-May-2022 09:59 by rmk")
(* ; "Edited 3-May-2022 22:58 by rmk")
(* ; "Edited 29-Apr-2022 21:42 by rmk")
(LET* ((PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))
(RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
NIL T PROJECT))
(SUPERSETS (CAR RELATIONS))
(EQUALS (CADR RELATIONS)))
(SORT [FOR PR REL LABEL IN PRS
COLLECT (SETQ LABEL (IF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
SUPERSETS]
THEN (CONCAT (CADDR PR)
" > " REL)
ELSEIF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
EQUALS]
THEN (CONCAT (CADDR PR)
" = " REL)
ELSE (CADDR PR)))
(LIST (CL:IF (MEMB 'DRAFT PR)
(CONCAT LABEL " (draft)")
LABEL)
(GITORIGIN (CADDR PR))
(CONCAT " " (CADR PR)
" #"
(CAR PR]
T])
[LAMBDA (DRAFT PROJECT) (* ; "Edited 16-May-2022 19:44 by rmk")
(LET ((PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
(CL:WHEN PRS
(SETQ RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
NIL T PROJECT))
(SORT [FOR PR REL LABEL (SUPERSETS _ (CAR RELATIONS))
(EQUALS _ (CADR RELATIONS)) IN PRS
COLLECT (SETQ LABEL (IF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
SUPERSETS]
THEN (CONCAT (CADDR PR)
" > " REL)
ELSEIF [SETQ REL (CAR (CDR (SASSOC (CADDR PR)
EQUALS]
THEN (CONCAT (CADDR PR)
" = " REL)
ELSE (CADDR PR)))
(LIST (CL:IF (MEMB 'DRAFT PR)
(CONCAT LABEL " (draft)")
LABEL)
(GITORIGIN (CADDR PR))
(CONCAT " " (CADR PR)
" #"
(CAR PR]
T))])
(GIT-PULL-REQUESTS
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 9-May-2022 16:54 by rmk")
@@ -1125,37 +1171,27 @@
(DEFINEQ
(GIT-MY-CURRENT-BRANCH
[LAMBDA (PROJECT) (* ; "Edited 7-May-2022 23:51 by rmk")
(* ; "Edited 19-Jan-2022 13:22 by rmk")
(CAR (LAST (GIT-MY-BRANCHES PROJECT])
[LAMBDA (PROJECT INITS) (* ; "Edited 19-May-2022 19:13 by rmk")
(CL:UNLESS INITS
(SETQ INITS (GIT-INITIALS)))
(FOR B IN (GIT-MY-BRANCHES PROJECT NIL INITS) LARGEST (OR (GIT-BRANCH-NUM B INITS)
0])
(GIT-MY-BRANCHP
[LAMBDA (BRANCH PROJECT) (* ; "Edited 7-May-2022 23:56 by rmk")
(* ; "Edited 26-Jan-2022 11:41 by rmk")
[LAMBDA (BRANCH PROJECT) (* ; "Edited 19-May-2022 17:44 by rmk")
(* ; "Edited 19-Jan-2022 13:22 by rmk")
(* ;; "Returns n if BRANCH is INITIALSn (local or origin), possibly followed by a trailing comment after colon or space.")
(* ;; "Returns n if BRANCH is INITIALSn (local or origin), possibly followed by a trailing comment after hyphen.")
(CL:UNLESS BRANCH
(SETQ BRANCH (GIT-WHICH-BRANCH PROJECT)))
(LET* ((INITS (GIT-INITIALS))
(INC (NCHARS INITS))
(SPOS (ADD1 (OR (STRPOS "/" BRANCH)
0)))
(EPOS))
(CL:WHEN (STRPOS INITS BRANCH SPOS NIL T NIL UPPERCASEARRAY)
(CL:WHEN (SETQ EPOS (\UPF.NEXTPOS (CHARCODE (%: SPACE))
BRANCH SPOS))
(ADD EPOS -1))
(SUBATOM BRANCH (IPLUS SPOS INC)
EPOS))])
(GIT-BRANCH-NUM (OR BRANCH (GIT-WHICH-BRANCH PROJECT])
(GIT-MY-NEXT-BRANCH
[LAMBDA (PROJECT) (* ; "Edited 7-May-2022 23:56 by rmk")
(* ; "Edited 19-Jan-2022 23:14 by rmk")
[LAMBDA (PROJECT) (* ; "Edited 19-May-2022 14:08 by rmk")
(* ; "Edited 8-Jan-2022 09:43 by rmk")
(* ;; "Figures out what my next incremental branch would be. ")
(* ;; "Figures out the number of my next incremental branch would be. ")
(PACK* (GIT-INITIALS)
(ADD1 (OR (GIT-MY-BRANCHP (GIT-MY-CURRENT-BRANCH PROJECT)
@@ -1163,11 +1199,7 @@
0])
(GIT-MY-BRANCHES
[LAMBDA (PROJECT) (* ; "Edited 7-May-2022 23:51 by rmk")
(* ; "Edited 6-Mar-2022 21:50 by rmk")
(* ; "Edited 19-Jan-2022 13:20 by rmk")
(* ; "Edited 8-Jan-2022 09:53 by rmk")
(* ; "Edited 12-Dec-2021 11:46 by rmk")
[LAMBDA (PROJECT EXCLUDEMERGED INITS) (* ; "Edited 19-May-2022 19:10 by rmk")
(* ;; "This returns only local branch names: xyzn and not origin/xyzn or local/xyzn")
@@ -1175,12 +1207,27 @@
(* ;; "The return list is sorted so that lower n's come before later n's. The last element is my current branch")
(FOR B (INITS _ (CONCAT "local/" (GIT-INITIALS)))
INC IN (GIT-BRANCHES NIL PROJECT) FIRST (SETQ INC (NCHARS INITS))
WHEN (STRPOS INITS B 1 NIL T NIL UPPERCASEARRAY) COLLECT B
FINALLY (RETURN (SORT $$VAL (FUNCTION (LAMBDA (A B)
(ILESSP (SUBATOM A (ADD1 INC))
(SUBATOM B (ADD1 INC])
(CL:UNLESS INITS
(SETQ INITS (GIT-INITIALS)))
(FOR B IPOS IN (GIT-BRANCHES 'LOCAL PROJECT EXCLUDEMERGED)
WHEN [AND (SETQ IPOS (STRPOS INITS B 1 NIL NIL NIL UPPERCASEARRAY))
(OR (EQ IPOS 1)
(EQ (CHARCODE /)
(NTHCHARCODE B (SUB1 IPOS] COLLECT (CONS B (GIT-BRANCH-NUM B INITS))
FINALLY
(* ;; "We expect a branch beginning with INITS rmk is of the form %"rmknnn%" or %"rmknnn--somestring%". If so, we want to sort b the number. If not, sort alphabetically at the end, with numbered ones first.")
(RETURN (FOR B IN [SORT $$VAL (FUNCTION (LAMBDA (X Y)
(IF (CDR X)
THEN (IF (CDR Y)
THEN (ILESSP (CDR X)
(CDR Y))
ELSE T)
ELSEIF (NOT (CDR Y))
THEN (ALPHORDER (CAR X)
(CAR Y]
COLLECT (CAR B])
)
@@ -1447,12 +1494,15 @@
ELSE '(0 differences))
ELSE '(0 differences])
(GIT-COMPARE-WITH-MYMEDLEY
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
(* ; "Edited 10-May-2022 10:41 by rmk")
(GIT-COMPARE-WITH-WORKINGMEDLEY
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
(* ;; "Edited 17-May-2022 17:39 by rmk")
(* ;; "Edited 10-May-2022 10:41 by rmk")
(* ;;
 "Edited 29-Mar-2022 13:58 by rmk: my medley subdirectories with the current local git branch.")
 "Edited 29-Mar-2022 13:58 by rmk: working medley subdirectories with the current local git branch.")
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.")
@@ -1467,11 +1517,11 @@
THEN (SETQ SUBDIRS (ALLSUBDIRS PROJECT))
"ALL subdirectories"
ELSE SUBDIRS)))
(FOR SUBDIR TITLE CDVAL (MYPROJ _ (CONCAT "My " (L-CASE (FETCH PROJECTNAME OF PROJECT)
T)))
(FOR SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (FETCH PROJECTNAME OF PROJECT)
T)))
(NENTRIES _ 0)
(BRANCH2 _ (GIT-WHICH-BRANCH PROJECT))
FIRST (PRINTOUT T "Comparing " SUBDIRSTRING " of " MYPROJ " and " BRANCH2 T)
FIRST (PRINTOUT T "Comparing " SUBDIRSTRING 6 " of " WPROJ " and Git " BRANCH2 T)
(BKSYSBUF " ") INSIDE SUBDIRS
COLLECT (TERPRI T)
(SETQ CDVAL (COMPAREDIRECTORIES (MYMEDLEYSUBDIR SUBDIR T PROJECT)
@@ -1497,12 +1547,12 @@
(SETQ $$VAL (CDMERGE $$VAL))
[SETQ SUBDIRS (CONCATLIST (FOR SUBDIR IN SUBDIRS COLLECT (CONCAT SUBDIR " "])
[FOR CDVAL TITLE IN $$VAL AS SUBDIR INSIDE SUBDIRS
DO (SETQ TITLE (CONCAT "Comparing " MYPROJ " and " BRANCH2 " " SUBDIR
DO (SETQ TITLE (CONCAT "Comparing " WPROJ " and " BRANCH2 " " SUBDIR
" " (LENGTH (fetch (CDVALUE CDENTRIES)
of CDVAL))
" files"))
[CDBROWSER CDVAL TITLE `(,MYPROJ ,BRANCH2)
`(BRANCH1 ,MYPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
`(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
GIT-CD-LABELFN PROJECT ,PROJECT)
NIL
`(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
@@ -1512,7 +1562,7 @@
(FOR CDENTRY IN (fetch CDENTRIES of CDVAL)
COLLECT (fetch MATCHNAME of CDENTRY)))
(ADD NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVAL]
(SETQ LAST-MYMEDLEY-CDVALUES $$VAL)
(SETQ LAST-WMEDLEY-CDVALUES $$VAL)
(TERPRI T)
(RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1)
'difference
@@ -1795,27 +1845,30 @@
INITIALS)
(ERROR "INITIALS is not set"])
)
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3224 15673 (GIT-CLONEP 3234 . 4497) (GIT-MAKE-PROJECT 4499 . 11213) (GIT-GET-PROJECT
11215 . 12552) (GIT-PROJECT-PATH 12554 . 13598) (FIND-ANCESTOR-DIRECTORY 13600 . 13949) (
GIT-FIND-CLONE 13951 . 15032) (GIT-MAINBRANCH 15034 . 15318) (GIT-MAINBRANCH? 15320 . 15671)) (20524
23312 (ALLSUBDIRS 20534 . 21820) (MEDLEYSUBDIRS 21822 . 22515) (GITSUBDIRS 22517 . 23310)) (23313
28103 (TOGIT 23323 . 24729) (FROMGIT 24731 . 25712) (GIT-DELETE-FILE 25714 . 26560) (
MYMEDLEY-DELETE-FILES 26562 . 28101)) (28104 30636 (MYMEDLEYSUBDIR 28114 . 28570) (GITSUBDIR 28572 .
29015) (STRIPDIR 29017 . 29388) (STRIPHOST 29390 . 29630) (STRIPNAME 29632 . 30385) (STRIPWHERE 30387
. 30634)) (30637 32539 (GFILE4MFILE 30647 . 31010) (MFILE4GFILE 31012 . 31581) (GIT-REPO-FILENAME
31583 . 32537)) (32588 40339 (GIT-COMMIT 32598 . 33424) (GIT-PUSH 33426 . 34070) (GIT-PULL 34072 .
34684) (GIT-APPROVAL 34686 . 35035) (GIT-GET-FILE 35037 . 37506) (GIT-FILE-EXISTS? 37508 . 38452) (
GIT-REMOTE-UPDATE 38454 . 39178) (GIT-REMOTE-ADD 39180 . 39487) (GIT-FILE-DATE 39489 . 40337)) (40369
49297 (GIT-BRANCH-DIFF 40379 . 45082) (GIT-COMMIT-DIFFS 45084 . 45528) (GIT-BRANCH-RELATIONS 45530 .
49295)) (49342 57178 (GIT-CHECKOUT 49352 . 49864) (GIT-WHICH-BRANCH 49866 . 50164) (GIT-MAKE-BRANCH
50166 . 51399) (GIT-BRANCHES 51401 . 52378) (GIT-BRANCH-EXISTS? 52380 . 53397) (GIT-PICK-BRANCH 53399
. 54188) (GIT-PRC-MENU 54190 . 56157) (GIT-PULL-REQUESTS 56159 . 57176)) (57208 60548 (
GIT-MY-CURRENT-BRANCH 57218 . 57508) (GIT-MY-BRANCHP 57510 . 58546) (GIT-MY-NEXT-BRANCH 58548 . 59142)
(GIT-MY-BRANCHES 59144 . 60546)) (60594 64546 (GIT-ADD-WORKTREE 60604 . 62088) (GIT-REMOVE-WORKTREE
62090 . 63020) (GIT-LIST-WORKTREES 63022 . 63826) (WORKTREEDIR 63828 . 64544)) (64594 92310 (
GIT-GET-DIFFERENT-FILES 64604 . 70330) (GIT-COMPARE-BRANCHES 70332 . 76046) (GIT-COMPARE-WITH-MYMEDLEY
76048 . 80505) (GIT-COMPARE-WORKTREE 80507 . 84380) (GITCDOBJBUTTONFN 84382 . 88872) (GIT-CD-LABELFN
88874 . 89956) (GIT-CD-MENUFN 89958 . 92308)) (92380 95363 (CDGITDIR 92390 . 92768) (GIT-COMMAND 92770
. 94356) (GITORIGIN 94358 . 95055) (GIT-INITIALS 95057 . 95361)))))
(FILEMAP (NIL (3441 17288 (GIT-CLONEP 3451 . 4714) (GIT-MAKE-PROJECT 4716 . 12828) (GIT-GET-PROJECT
12830 . 14167) (GIT-PROJECT-PATH 14169 . 15213) (FIND-ANCESTOR-DIRECTORY 15215 . 15564) (
GIT-FIND-CLONE 15566 . 16647) (GIT-MAINBRANCH 16649 . 16933) (GIT-MAINBRANCH? 16935 . 17286)) (22251
25039 (ALLSUBDIRS 22261 . 23547) (MEDLEYSUBDIRS 23549 . 24242) (GITSUBDIRS 24244 . 25037)) (25040
29830 (TOGIT 25050 . 26456) (FROMGIT 26458 . 27439) (GIT-DELETE-FILE 27441 . 28287) (
MYMEDLEY-DELETE-FILES 28289 . 29828)) (29831 32363 (MYMEDLEYSUBDIR 29841 . 30297) (GITSUBDIR 30299 .
30742) (STRIPDIR 30744 . 31115) (STRIPHOST 31117 . 31357) (STRIPNAME 31359 . 32112) (STRIPWHERE 32114
. 32361)) (32364 34266 (GFILE4MFILE 32374 . 32737) (MFILE4GFILE 32739 . 33308) (GIT-REPO-FILENAME
33310 . 34264)) (34315 42066 (GIT-COMMIT 34325 . 35151) (GIT-PUSH 35153 . 35797) (GIT-PULL 35799 .
36411) (GIT-APPROVAL 36413 . 36762) (GIT-GET-FILE 36764 . 39233) (GIT-FILE-EXISTS? 39235 . 40179) (
GIT-REMOTE-UPDATE 40181 . 40905) (GIT-REMOTE-ADD 40907 . 41214) (GIT-FILE-DATE 41216 . 42064)) (42096
51024 (GIT-BRANCH-DIFF 42106 . 46809) (GIT-COMMIT-DIFFS 46811 . 47255) (GIT-BRANCH-RELATIONS 47257 .
51022)) (51069 59282 (GIT-BRANCH-NUM 51079 . 51652) (GIT-CHECKOUT 51654 . 52166) (GIT-WHICH-BRANCH
52168 . 52466) (GIT-MAKE-BRANCH 52468 . 54212) (GIT-BRANCHES 54214 . 55595) (GIT-BRANCH-EXISTS? 55597
. 56301) (GIT-PICK-BRANCH 56303 . 56631) (GIT-PRC-MENU 56633 . 58261) (GIT-PULL-REQUESTS 58263 .
59280)) (59312 62647 (GIT-MY-CURRENT-BRANCH 59322 . 59692) (GIT-MY-BRANCHP 59694 . 60199) (
GIT-MY-NEXT-BRANCH 60201 . 60695) (GIT-MY-BRANCHES 60697 . 62645)) (62693 66645 (GIT-ADD-WORKTREE
62703 . 64187) (GIT-REMOVE-WORKTREE 64189 . 65119) (GIT-LIST-WORKTREES 65121 . 65925) (WORKTREEDIR
65927 . 66643)) (66693 94417 (GIT-GET-DIFFERENT-FILES 66703 . 72429) (GIT-COMPARE-BRANCHES 72431 .
78145) (GIT-COMPARE-WITH-WORKINGMEDLEY 78147 . 82612) (GIT-COMPARE-WORKTREE 82614 . 86487) (
GITCDOBJBUTTONFN 86489 . 90979) (GIT-CD-LABELFN 90981 . 92063) (GIT-CD-MENUFN 92065 . 94415)) (94487
97470 (CDGITDIR 94497 . 94875) (GIT-COMMAND 94877 . 96463) (GITORIGIN 96465 . 97162) (GIT-INITIALS
97164 . 97468)))))
STOP

Binary file not shown.

View File

@@ -14,7 +14,7 @@ where
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
@@ -59,8 +59,9 @@ This compares the files in branch1 and branch2, for example
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.
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)
@@ -69,13 +70,13 @@ b? (project) [command]
The command cob ("check out branch") checks out a specified branch:
cob branch (titlestring) (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.
This checks out branch of project and then executes git pull. The branch parameter may also be a local branch, T (= my current branch), or NEW/NEXT (= my next branch). My current branch is a 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 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 titlestring 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 titlestring 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]
The currently checked out branch is obtained by the b? command:
b? (project) [command]
Correlating git source control with separate Medley development
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 >MY-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.
@@ -85,8 +86,8 @@ TIMESROMAN$TERMINALMODERN
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}.
If 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.
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 RUNNINGHEADMODERN
TIMESROMAN$TERMINALMODERN
.È4 ÈÈ4 ÈÈ4ÈÈ4ÈÈ4ÈÈ4ÈÈ4È È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADMODERN
TIMESROMAN$TERMINALMODERN