From 48ebc675a7f81f12173912b814df517e43d09167 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Sat, 21 May 2022 19:55:00 -0700 Subject: [PATCH] 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 --- lispusers/GITFNS | 363 ++++++++++++++++++-------------- lispusers/GITFNS.LCOM | Bin 39766 -> 40947 bytes lispusers/GITFNS.TEDIT | 25 +-- sources/MACHINEINDEPENDENT | 71 ++++--- sources/MACHINEINDEPENDENT.LCOM | Bin 39404 -> 39455 bytes 5 files changed, 261 insertions(+), 198 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index b59f306f..16bb1c94 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,15 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-May-2022 10:51:44" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;278 95386 +(FILECREATED "19-May-2022 19:19:14"  +{DSK}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}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;277) + :PREVIOUS-DATE "19-May-2022 14:08:39" +{DSK}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 diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index a06f9731feb2bbf3135f78b51abc45c1904bbe2f..0efac76da4523328f0d18947cc0fe59cf2d395c2 100644 GIT binary patch delta 4963 zcmb7IeQXow8P8olF(h@;5Wu1E)Rf==F23{K*$!>+*}lX_?!(;Kg!F^pBo1*C5}Kr= ztSh0Ym9|l~(szYUojO%r*R9=0z+@U*rTn!{nkG%ts!8p(O53FUGpS{2t5s`9_q=zu zlZO4V1?2aApZC4@-skK0d*1u~PuLHZ*=LTl#e#bNbdV46JaDld`v2lXzPlcoE6mRI zPUcTe<)?e6W=8WEmPz+o{K-Zt!!fH<5byP){i82hVI_ zbmqj#;#6S_3Xh(go!i+1{c1Ltuw)~d4jMV#8S3(YQkIcFoeyqwrxn`+#cA;Og1_4n=u=ZhN1!K}mW_VJ z4rWaV^cgmI$h+q|7gmn!s9-2ZvcW;q8c>b?vMT>o)1mTY20YXddS$HG-4Hk|TQ+?P z-;y+SD#1pVjg$?eGb7#5ld+V;s+qHcsXo+ojj95gyeAy{zg1;pVo72-mK8&!Soc07 z5;zwj&(!;<;0N`ubW!W3R4Xalifmc(5cB~TcC^b_=0PQy#go<^Ag3ChWR}UN4F_3f zgrpnyG&2p!R(YMiRD13UBayR>ds!w%e$;pevzh$5aSQ(bt+8uE(NlwebWP1WYbJ9o zH-9_AP88SE6<2P)Ow^{Xwwo`R-mc-6{X(z023Jv_3xJ8}#``eat~; z&$zcH5alDV&&p_WG6m6)NSH(IwUHP{+l7c2f{dIT*bNZ@d$y8GnQ7C`LL@9e(lnAX zb~&-KCWO6}HBu~AStCV6P%O)|K#GK_LX4c8VQaFTRZM5-}D6eZbCI7(pOPf@9#MW*SNcL_vb2)`KHk0Wr+O1Nvc2#iNRRgk(IM7DRN2 znNbW7Ly~jg%C>h`HVko^2+2+=UuxkP!55D@^o8Pf(q#O}(35UWn${-4)G z2!)_D@A)MYkHn%dGg~}foZfdLKQ~{Pg-BFbkzg)MQGRvYpeixwkrSpxHQ`Z{jh#FQ zXsm>p8o~|_n6w~p5ulDC7dJeAI3kGPf7}ldJ_`Op+J?dZ7`9xD(VSjfCD)c!YLB`6~hW4GQ96iMsU*a!O#{IlpYOjxou$;T2`Mk zsFyMj0-JVJ+(|XmEbWEBUEd8g8MdZ|m0xY5c{0K-&(JnLIWbmjZlK+z+R4^dMvkXZ za*PU^8|m-RwXJd0U8~a6Tfl`6O}_19Vc3gFh4GHDA!kh;O<4_$Xr;$jWs>7;dN5Vi zY{Y4Shg>G3tUw9MKtxBOtvSck-3}}!(@Ju{%w-)rm0mnxG20}t6g#J7QE3q~E2UW2 z!#s72pb}ONgnxm@uZ@2%;o!nZ&9Z#8d$LuolhY0yJg{_BZF8sC<+!7tyq+AC{cM9l zrsa;{)x8Geh;>I*?-bm4b}D#Q`}x78=79;{eb>{IZ~b)fse!JaE&kJag1jcTEf~(` zXcaCdKw8nzsTkxg9&m^Um{7{0oQw>Hwko3v$3?5%5N2Ry3Fc1)cOq{3yYLTE6>QL0 zls5*`D)J{fdJpm_V0xCHt0Gs@Oer?-0vOpe5|~BDB$L?2Mx*3p!nY|B0e^mKwvZn? zjm%t}o1a4uNFnl4qJtF$ay_wi6UXtGGmlJl1nq_jJX`VP+wWrIbDylZFZ~HdB3+AdpEcG^w6J#RN#q=BLq%bHIsYSAPJ* zQIivjhOR;PTW*KC00j|nBAMcjgb09nY%5uEp}%V0 zw#7Y;$ZT=!m4?KtLhW|K9fDjm)&5zG_<4~m8d@r5g#L|oECro1oXiBQ2*Vr@~ss9{R z#3#z0lk3v8OLeN3xleX1hg9&!0MQ0MAc%|C)9jJOztjW}byhOosp^rjsbp1o3le!j z-@#<4A;evY63CW5vweTCD|%Yz&feI+r3zfxp2p=awh`wEi^8z zrE$OrAXoH_?T7-JnUpmQNtXrWREjWGdnsc!wl&O2X!T-DMP_z z>aeWk=p~5#BRP}*a{W{T*8L@BB*!jbJY$L6pG{*eS4}I4;#ewSnS(Y~0#evL@(L6m zaB9nPa*CLzIGa4Ll zcSZP07vZ2R#NEn0yt-uN1UXrFVgUnstT;Yim@Q0?BA`pO%9uHMdMDfyL?l5!7Yf*- z3GqsvpDkeFg;yH)28aDJ#ifD{{!^wvf~)pvn7GP`sGJ*4Jcwe2zc~=754Q8VZ*p)eG+ZqSm zPZy>0$G@|g6}S?2_C2hx&GN=M||Pbb{Z1La5y z4yxI7S7nn*Gmd;!}%%FeXdiE1?{SuHHM5dK+KxI-UQ)=D&u+usZ!U@C%s>a}yu2mup`TpvX@_T4Ss(de_5PKO zsakYt)sJNA^46}v=S$VVp`3}|Ra^+GJPBE{@A;kN$Co>6ySqK5zh0iH-4)2>vaYSy Pm>PPr)M*HSl$ZVknNRI` delta 3867 zcma)9Z)_Xo8TXyjHg?-2PLn8c3VnJViQUGH?|gT*(~|jozQmXKeD0myk`)Lhb{n^8 zQYB$5LSWbcA;w0#SN!RpO`0|&q-k1%7bM0YeA=dIY-mEGlhCB?(>`s24G9TN+4G)# zX%T!NZSubN+~fDp^ZcIQ^Yec;*}uHbUb?3{7BR|e5g{rFz(>aEIJ&a(ZWwP9NU+%Fv`htAOaLDPdf|+2sfw*BmZi*ufqkE(cRk4z$!~W}v7S%KzV;(~J=fKM;xjh9-(L6p zflRlLu%17Wwe~xhAYpt1_;W0 ztdH7#`u)GPxS}q`k5&|eUa+&gyKRJMy*0lQ8OSX$)#eiS5AoJahxidV>q+5QpU`hb`fMD4yu_~6`V#BEgva~vs*q=QgD4FIRTnwnHETLY}*)% zLMdWq`OIu9`Z#)qByARA9KhL0R!aCFdl|7bgjj_e>WjSN%M zJ0qtljPHo}SR7j(z0~y3=h(}sO7-%O-3i1uVjYR}t3zdkJZHIW$wYrdLk^x8vnI?#1 zNhfWmvbvg$q%9?{p2z~?v-Mh#+*!Pt-kC^VyQkRn%!d7WJ?9Srj}YWai%5*sIm&ov zYpbwaU3q9>l|xcYl67rgkjE?zLwRAjTCS`iht^hBSCAt4s7(H*?eD{q;ozag3ZjmK zIHr0S(UBm5i91Y5=#3z9p1LRGLednZE&4#f|!XGMtg!wScqK5epA!n)>odU!l zO@1*ku;XVtJsy_4J8^A*-H|h#=sF3aA;$W&5x?Z)$u07`;~gZR_wKMTVP0}X7a2b( z>j%2yt>DW%7@CpBQYJspGYn5Y(A6GfhbG5?4g#FYYL*71e=5A=0haN!krPw>y(#a8 zFReQJ23RIr(RKbu&-I>7jjLV0L$6Olm2` z0bhXekoxp!J#cWB!Mts-3^HgoQ0_3hyc>JW?(SL>k<4sA%QAWA0eyn6^_tY+px6vL zE8RHan9Pn_PCZ|6deX7X?%zC1OT+AUe6O4P>&{Bf(-Y=?$H~c4bAx_&r+#J+{oH&o z7@Y0fG}EL9!A-;^hrGrd{T6w z%_Hm3#KwV_w~^1s;$SPbZK??2ZR+NuQP-Nl_mughI4LN-UMw2&-`pWwHDf6gMNAI>HA+A!&V;Wnh7H0QM6b#hQz4^dS+e8 z+0dk&+vo{NCxqRhR48b-2?>mLJPIMCxtI{fU*JYtOo5?t8H>~lKS`&tPNSfpAfb^_ z!{F)jFdjBlIDgZ*x8hFz_Yn;{Cb@MHJZy7D?mGc>xfNas(zM>1L3WmI(E%L0H%B*6O!Elo zg{8T+^1>+B_^b7`0Bg*Uw#wslc&hUKUSr14GC6G~qGnDixsqn1#``lFu0GRvqgr6= zC_YfqOct{sBlcS-l&ONrq%HH5tyzvnpk!z$dcL{+*HI&FSFyw=+$BUY0Ywe@P{$Ly zjmnWevBb6liy^nVQY+Sl$G@e#goI2EKHF0lkl1lYOfTv%5KwQpw{T6O;BG`KSo7b*5f7E;kxvA7hAp>c!^K)NOc%~bthQFiELCb}&QzDH zi*rcmR9mV`7uW8B;}M|p(ymr<#E{|Fkn%FlQHr^ZN5cJR#MDg0X#liS$WpTzI9BwH983Wzo*Tgi_r$qFbt=(Nejx{)35AgE;K%P zPGZU6^T9w9K&X40w*^0$c>ZL7GuH5{T(f6#VF>xj&!0a@zWbby?74J*I~oqdv15L+ zd?`KX#1s3hVrh|6dNCVuA%RQ1e@P?3%Lh>%9J`!pT)jNW;@1Bl-(#={8sB{3BtzbP z@iX%5^@HS}FMZNxYsC}f=F8(9K-H3)v@rScivuKjB|{#+vPOifdGglPZt~t$4Oe~V zr4Sjvb_8burjOLG4Uj9>2EF)UvUzO)tv9djcb*2Xe|-Q#CrVWJ_#M#`-d;Z3xbOOs Jw~gwv{{z5M!$|-D diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT index b09d9acc..99591f8c 100644 --- a/lispusers/GITFNS.TEDIT +++ b/lispusers/GITFNS.TEDIT @@ -14,7 +14,7 @@ where PROJECTNAME is the name of the project (e.g. MEDLEY, NOTECARDS, LOOPS...) PROJECTPATH is the local path to the clone (e.g. {dsk}...>git-medley) - WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}...>my-medley>) + WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}...>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) DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified. @@ -59,8 +59,9 @@ This compares the files in branch1 and branch2, for example 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. The command cob ("check out branch") checks out a specified branch: -cob branch (project) [command] -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 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. +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 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 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: @@ -69,13 +70,13 @@ 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 >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 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. +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 gmc ("git-my-compare") command: -gmc 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 or the project. If it is ALL, then files in all subdirectoriesthat are not found in the project's EXCLUSIONS are compared. +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}. -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 to the git clone or deleting git files will set git up for future commits. +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} 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 44444 4..8.8J PAGEHEADING RUNNINGHEADMODERN @@ -85,8 +86,8 @@ TIMESROMAN$TERMINALMODERN   HRULE.GETFN  HRULE.GETFNMODERN   HRULE.GETFNMODERN    HRULE.GETFNMODERN   HRULE.GETFNMODERN  - ,  R   ; B1 L-.$w a       / 27#h     k      ( 'G  !    =c    5  3>B  - ,  I     )1          <  &    $(?! x   I  ""     D : + ,  R   ; B1 L-.$w a       / 27#h     k      ( 'G  !    =c    5  3>B  + ,  I     )1          <  & ,   %9"?! M + k  I  ""     D : Z D - D (. (  1   D   J f -? D  z D  +EXz \ No newline at end of file + D -. (  2   D   J f +< D  z D  ,hZz \ No newline at end of file diff --git a/sources/MACHINEINDEPENDENT b/sources/MACHINEINDEPENDENT index bd1846bc..9082595e 100644 --- a/sources/MACHINEINDEPENDENT +++ b/sources/MACHINEINDEPENDENT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Mar-2022 12:05:22"  -{DSK}kaplan>Local>medley3.5>my-medley>sources>MACHINEINDEPENDENT.;24 113260 +(FILECREATED "19-May-2022 16:22:57"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;27 113751 - :CHANGES-TO (FNS FINDFILE-WITH-EXTENSIONS) + :CHANGES-TO (FNS DOFILESLOAD) - :PREVIOUS-DATE "15-Mar-2022 11:50:25" -{DSK}kaplan>Local>medley3.5>my-medley>sources>MACHINEINDEPENDENT.;23) + :PREVIOUS-DATE "19-May-2022 16:19:10" +{DSK}kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;26) (* ; " @@ -288,11 +288,15 @@ with the terms of said license. (DOFILESLOAD [LAMBDA (FILES) - (DECLARE (USEDFREE LDFLG)) (* ; "Edited 15-Mar-2022 00:48 by rmk") - (* ; "Edited 4-May-88 14:23 by bvm") + (DECLARE (USEDFREE LDFLG)) + + (* ;; "Edited 19-May-2022 16:22 by rmk: (FROM LISPUSERS) tries LISPUSERSDIRECTORY as well as LISPUSERSDIRECTORIES") + + (* ;; "Edited 15-Mar-2022 00:48 by rmk") + + (* ;; "Edited 4-May-88 14:23 by bvm") (* ; "does the work of FILESLOAD") - (for FILE inside FILES bind DIRS LOADOPTIONSFLG FORCEDEXT? NOERRORFLG WORD FULL - (FN _ 'LOAD?) + (for FILE inside FILES bind DIRS LOADOPTIONSFLG FORCEDEXT? NOERRORFLG FULL (FN _ 'LOAD?) (EXT _ :COMPILED) first [COND ((BOUNDP 'LDFLG) @@ -351,7 +355,7 @@ with the terms of said license.  "already weeded out the ones with filedates") (LOAD FULL LOADOPTIONSFLG)) (CL:FUNCALL FN FULL LOADOPTIONSFLG] - (T (while (LISTP FILE) + (T (bind WORD PACKED while (LISTP FILE) do (SELECTQ (CAR FILE) (LOADCOMP (SETQQ FN LOADCOMP?) (SETQ LOADOPTIONSFLG NIL) @@ -374,8 +378,13 @@ with the terms of said license. (({ <) NIL) T) - [BOUNDP (SETQ WORD (PACK* WORD 'DIRECTORIES] - (SETQ WORD (EVALV WORD))) + [OR [BOUNDP (SETQ PACKED (PACK* WORD + + 'DIRECTORIES + ] + (BOUNDP (SETQ PACKED (PACK* WORD + 'DIRECTORY] + (SETQ WORD (EVALV PACKED))) (* ;  "KLUDGE: Turns, e.g., (FROM LISPUSERS) into (FROM VALUEOF LISPUSERSDIRECTORIES)") WORD) @@ -2388,23 +2397,23 @@ This has little hope of working any more.") (PUTPROPS MACHINEINDEPENDENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1985 1986 1987 1988 1989 1990 1991 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (12853 25784 (LOAD? 12863 . 14714) (FILESLOAD 14716 . 15005) (DOFILESLOAD 15007 . 22139) - (FINDFILE-WITH-EXTENSIONS 22141 . 25340) (READ-FILECREATED 25342 . 25782)) (25901 31222 (DMPHASH -25911 . 27505) (HASHOVERFLOW 27507 . 31220)) (31978 63315 (BKBUFS 31988 . 33107) (CHANGENAME 33109 . -33370) (CHNGNM 33372 . 35220) (CLBUFS 35222 . 36495) (DEFINE 36497 . 37221) (FNS.PUTDEF 37223 . 40638) - (EQMEMB 40640 . 40822) (EQUALN 40824 . 41653) (FNCHECK 41655 . 43662) (FNTYP1 43664 . 43761) (LCSKIP -43763 . 44607) (MAPRINT 44609 . 45555) (MKLIST 45557 . 45707) (NAMEFIELD 45709 . 47234) (NLIST 47236 - . 47571) (PRINTBELLS 47573 . 47699) (PROMPTCHAR 47701 . 49591) (RAISEP 49593 . 49854) (READFILE 49856 - . 52200) (READLINE 52202 . 57642) (REMPROPLIST 57644 . 58532) (RESETBUFS 58534 . 58984) (TAB 58986 . -59582) (UNSAVED1 59584 . 60689) (WRITEFILE 60691 . 62433) (CLOSE-AND-MAYBE-DELETE 62435 . 62779) ( -UNSAFE.TO.MODIFY 62781 . 63313)) (65639 68583 (FILEDATE 65649 . 68581)) (68813 92552 (FILEMAP 68823 . -69293) (\PARSE-FILE-HEADER 69295 . 73110) (GET-ENVIRONMENT-AND-FILEMAP 73112 . 75339) ( -LOOKUP-ENVIRONMENT-AND-FILEMAP 75341 . 77532) (GET-FILEMAP-FROM-FILECREATED 77534 . 78358) ( -\FILEMAP-HASHOVERFLOW 78360 . 83024) (FLUSHFILEMAPS 83026 . 83649) (LISPSOURCEFILEP 83651 . 84830) ( -GETFILEMAP 84832 . 85251) (PUTFILEMAP 85253 . 87444) (UPDATEFILEMAP 87446 . 92550)) (93218 96804 ( -LVLPRINT 93228 . 93401) (LVLPRIN1 93403 . 93585) (LVLPRIN2 93587 . 93819) (LVLPRIN 93821 . 94835) ( -LVLPRIN0 94837 . 96802)) (96838 101755 (FLUSHRIGHT 96848 . 97663) (PRINTPARA 97665 . 98763) ( -PRINTPARA1 98765 . 101753)) (101791 104076 (SUBLIS 101801 . 102409) (SUBPAIR 102411 . 103639) (DSUBLIS - 103641 . 104074)) (104099 104699 (CONSTANTOK 104109 . 104697)) (106452 107157 (NLAMBDA.ARGS 106462 . -107155))))) + (FILEMAP (NIL (12850 26275 (LOAD? 12860 . 14711) (FILESLOAD 14713 . 15002) (DOFILESLOAD 15004 . 22630) + (FINDFILE-WITH-EXTENSIONS 22632 . 25831) (READ-FILECREATED 25833 . 26273)) (26392 31713 (DMPHASH +26402 . 27996) (HASHOVERFLOW 27998 . 31711)) (32469 63806 (BKBUFS 32479 . 33598) (CHANGENAME 33600 . +33861) (CHNGNM 33863 . 35711) (CLBUFS 35713 . 36986) (DEFINE 36988 . 37712) (FNS.PUTDEF 37714 . 41129) + (EQMEMB 41131 . 41313) (EQUALN 41315 . 42144) (FNCHECK 42146 . 44153) (FNTYP1 44155 . 44252) (LCSKIP +44254 . 45098) (MAPRINT 45100 . 46046) (MKLIST 46048 . 46198) (NAMEFIELD 46200 . 47725) (NLIST 47727 + . 48062) (PRINTBELLS 48064 . 48190) (PROMPTCHAR 48192 . 50082) (RAISEP 50084 . 50345) (READFILE 50347 + . 52691) (READLINE 52693 . 58133) (REMPROPLIST 58135 . 59023) (RESETBUFS 59025 . 59475) (TAB 59477 . +60073) (UNSAVED1 60075 . 61180) (WRITEFILE 61182 . 62924) (CLOSE-AND-MAYBE-DELETE 62926 . 63270) ( +UNSAFE.TO.MODIFY 63272 . 63804)) (66130 69074 (FILEDATE 66140 . 69072)) (69304 93043 (FILEMAP 69314 . +69784) (\PARSE-FILE-HEADER 69786 . 73601) (GET-ENVIRONMENT-AND-FILEMAP 73603 . 75830) ( +LOOKUP-ENVIRONMENT-AND-FILEMAP 75832 . 78023) (GET-FILEMAP-FROM-FILECREATED 78025 . 78849) ( +\FILEMAP-HASHOVERFLOW 78851 . 83515) (FLUSHFILEMAPS 83517 . 84140) (LISPSOURCEFILEP 84142 . 85321) ( +GETFILEMAP 85323 . 85742) (PUTFILEMAP 85744 . 87935) (UPDATEFILEMAP 87937 . 93041)) (93709 97295 ( +LVLPRINT 93719 . 93892) (LVLPRIN1 93894 . 94076) (LVLPRIN2 94078 . 94310) (LVLPRIN 94312 . 95326) ( +LVLPRIN0 95328 . 97293)) (97329 102246 (FLUSHRIGHT 97339 . 98154) (PRINTPARA 98156 . 99254) ( +PRINTPARA1 99256 . 102244)) (102282 104567 (SUBLIS 102292 . 102900) (SUBPAIR 102902 . 104130) (DSUBLIS + 104132 . 104565)) (104590 105190 (CONSTANTOK 104600 . 105188)) (106943 107648 (NLAMBDA.ARGS 106953 . +107646))))) STOP diff --git a/sources/MACHINEINDEPENDENT.LCOM b/sources/MACHINEINDEPENDENT.LCOM index 26e05ee47c47411fec7f281c3cb2306b9f1e537b..704b563a17b297c7208e33eafe0b0267f4da9ddd 100644 GIT binary patch delta 1308 zcmZux-*4Mg6pr1pby0^(S3;Lg=n!e6sg&Y-ZQs}yV#{o&F?D<+J84#_YP8|1iB{UF zO#BcJ(GWuLfS~vV@k5{ui3cRKG^@nMAP>Cqr+}1qB;fiwEA56Ke9!srJ>PfE^*R2d zFMe}R{PfBhy->aSP610810n{-hFaXaPENkHvwOX>y%}lZ`ED@}=^T3Opkzo|4zBHP zytecDjn39a2pezT*nQ)?0TwMgt{u3vWI<;ea^;5W!qM=>#l;+iS8uYI|KmkUE}x!{ zIZWR!)$QjjctSl+Gnx`F9L>`$0zz_8MPQhflDA|Bg*t`#blD4z=9CAc=G!X{Z3G32 z(LX_sbOT9`lMAH3F6Kl*j&6-VyP<&P__kT6zGDYa2Bd;(mEEP-B(Px8YK^6D73?c@ z+Y21(1q*o)KRi925-x3~*u!7X+?nL-sTkRRrJ3bMYo?hU_9Z$K{WX4WedhE;yxVD> z%VvLRKL2awV0?LM>`vuj`~8aWup<7n?1u8C;SVm4y*Kt=FLmH>*5Urm1ms?tYh3H4 zz8!65+-eh|H=mmCPWKn-R6pE_PwMP6Naw`bh^W7 znQ`}Q0)9@XJ&t|Aj4jc5x}E)~m1)fm+_8hnHsATV_fJ+BaeOt{Oc_k-etZ2vPk3pB ze#uY{GHh;y-R`CK2Cld!v@(fOe~xA%a^i)mPcyvsaO>UScj4B{!_NloTZ7KNMw63V zv^5*@L;bUZ<1k0RptF2!WulKy>~(v8|CpLrbOLMkO37V8plBLgrVY=kF%v{M&iuLpn?3_;y@yrnZW zz_Nf~qlT+VD*qRH6cFT2R$uye7>Hs*+@Vky%obzbeOLM!QL)gNj() zqpk;~NDk*?6%Ieu? zS_wEs;?Qe>y`WZzic7C?oF1C0@}Uw3{(-6o+JB&j@DD&|XI(-h_OS2AeDl5Ujoy2@ zr~lj4A6)sgkgs0f%3}j#K-e;{_IdJlxU#mxRPys~1@dDS5MBuq$k}!cg6~2_X6yjd{ z44wsj9Q0;#10=OftI{8{^7Z9czpqbPX{UzdAPg(bxyW$?19{o6Y{- zn2aZnXIV?(o^`Z8d!8aV*uBG5PDL3-x7O|qJno;4@oHl#zHxkJdsGsC{HVQi?RElE zKVChZ_|4X?+ai|^eomS8il6`T6W@8^wNj2JJu$kjn5DCGHcdVjqrS?0C!L$R_hCD$ z!rwY?a{YTh_7wEj_I^jxTm5^x_j+7!YO5nDO?N_!#C+)7;00+nht5o$6X}T}TOCoY z{UB1iIuh>>J=`AL8@%6n{gP|_I?p<<|N6hw7yCQ^49u7&f~LDt<|_zHLSRwUeWwN{ zW>72J%X2_V1+XvM!bd=gMM$7P3DZV-q7utDUQPwEATJD-gXB36>&M4TU<(pb!gOWVn4NK#u=YYV^(@-_lm zOzVkSA^}u$4A_Lqj5l{ms*7ZY4 zyA5V3t+@bZk){or1tu3oDv~SafXPfa3@|z}+oWKEr~qLY