From 07b7f2af811f74f2e8ac66ece9e32fd0690884bc Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 29 Apr 2025 15:22:45 -0700 Subject: [PATCH] GITFNS gwc looks at all subdirectories, like prc --- lispusers/GITFNS | 407 +++++++++++++++++++++--------------------- lispusers/GITFNS.LCOM | Bin 51379 -> 51443 bytes 2 files changed, 205 insertions(+), 202 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 2b25892b0..b6ef04295 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,28 +1,29 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Mar-2025 21:25:00" {WMEDLEY}GITFNS.;539 133841 +(FILECREATED "29-Apr-2025 15:17:37" {WMEDLEY}GITFNS.;541 134267 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-GET-FILE GIT-RESULT-TO-LINES) + :CHANGES-TO (VARS GITFNSCOMS) + (FNS GIT-WORKING-COMPARE-DIRECTORIES) - :PREVIOUS-DATE "21-Mar-2025 19:07:34" {WMEDLEY}GITFNS.;536) + :PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}GITFNS.;539) (PRETTYCOMPRINT GITFNSCOMS) -(RPAQQ GITFNSCOMS +(RPAQQ GITFNSCOMS ( - (* ;; "Set up") + (* ;; "Set up") (FILES (SYSLOAD FROM LISPUSERS) COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER ) - (* ;; "") + (* ;; "") - (* ;; "GIT projects") + (* ;; "GIT projects") (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH @@ -43,94 +44,94 @@ (P (GIT-INIT)) (ADDVARS (AROUNDEXITFNS GIT-INIT)) - (* ;; "") + (* ;; "") - (* ;; "Lisp exec commands") + (* ;; "Lisp exec commands") (INITVARS (GIT-MERGE-COMPARES T) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (COMMANDS gwc bbc prc cob b? cdg cdw) (FNS PRC-COMMAND) - (* ;; "") + (* ;; "") - (* ;; "File correspondents") + (* ;; "File correspondents") (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) - (* ;; "") + (* ;; "") - (* ;; "Git commands") + (* ;; "Git commands") (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY GIT-FETCH) - (* ;; "Differences") + (* ;; "Differences") (FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS) - (* ;; "") + (* ;; "") - (* ;; "Branches") + (* ;; "Branches") (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-BRANCH-WHENSELECTEDFN GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES) - (* ;; "My branches") + (* ;; "My branches") (FNS GIT-MY-CURRENT-BRANCH GIT-MY-BRANCHP GIT-MY-NEXT-BRANCH GIT-MY-BRANCHES) - (* ;; "") + (* ;; "") - (* ;; "Worktrees") + (* ;; "Worktrees") (FNS GIT-ADD-WORKTREE GIT-REMOVE-WORKTREE GIT-LIST-WORKTREES WORKTREEDIR) - (* ;; "") + (* ;; "") - (* ;; "Comparisons") + (* ;; "Comparisons") (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE) (INITVARS (FROMGITN 0)) - (* ;; "") + (* ;; "") - (* ;; "Utilities") + (* ;; "Utilities") (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES STRIPLOCAL) - (PROPS (GITFNS FILETYPE)))) + (PROPS (GITFNS FILETYPE)))) -(* ;; "Set up") +(* ;; "Set up") -(FILESLOAD (SYSLOAD FROM LISPUSERS) +(FILESLOAD (SYSLOAD FROM LISPUSERS) COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER) -(* ;; "") +(* ;; "") -(* ;; "GIT projects") +(* ;; "GIT projects") (DEFINEQ @@ -401,15 +402,15 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH)) +(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH)) -(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN)) +(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN)) ) ) -(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY) +(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY) -(RPAQ? GIT-DEFAULT-PROJECTS +(RPAQ? 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) @@ -417,120 +418,120 @@ (TEST) (MAIKO))) -(RPAQ? GIT-PROJECTS NIL) +(RPAQ? GIT-PROJECTS NIL) -(RPAQ? GIT-PRC-MENUS NIL) +(RPAQ? GIT-PRC-MENUS NIL) -(GIT-INIT) +(GIT-INIT) -(ADDTOVAR AROUNDEXITFNS GIT-INIT) +(ADDTOVAR AROUNDEXITFNS GIT-INIT) -(* ;; "") +(* ;; "") -(* ;; "Lisp exec commands") +(* ;; "Lisp exec commands") -(RPAQ? GIT-MERGE-COMPARES T) +(RPAQ? GIT-MERGE-COMPARES T) -(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T) +(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T) (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") + (* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project") - (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS))) + (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS))) PROJECT) - (SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL) + (SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (CAR STAIL) NIL T) - THEN (SETQ PROJECT (CAR STAIL)) - (GO $$OUT)) - (CAR STAIL))) - (GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT))) + THEN (SETQ PROJECT (CAR STAIL)) + (GO $$OUT)) + (CAR STAIL))) + (GIT-WORKING-COMPARE-DIRECTORIES 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)") + (* ;; "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-FETCH PROJECT) - (SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (GIT-FETCH PROJECT) + (SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1) ((NIL T) - (GIT-MY-CURRENT-BRANCH PROJECT)) + (GIT-MY-CURRENT-BRANCH PROJECT)) ((LOCAL REMOTE ORIGIN) - (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T))) - (OR (GIT-LONG-NAME BRANCH1 NIL PROJECT) + (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T))) + (OR (GIT-LONG-NAME BRANCH1 NIL PROJECT) BRANCH1))) - (SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2) + (SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2) ((NIL T) - (GIT-MAINBRANCH PROJECT LOCAL)) + (GIT-MAINBRANCH PROJECT LOCAL)) ((LOCAL REMOTE ORIGIN) - (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T))) - (OR (GIT-LONG-NAME BRANCH2 NIL PROJECT) + (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T))) + (OR (GIT-LONG-NAME BRANCH2 NIL PROJECT) BRANCH2))) - (GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL)) + (GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL)) LOCAL PROJECT)) (DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT) - (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") + (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") - (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT)) + (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT)) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) - (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name. 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 NEXTTITLESTRING if given will be attached to the branch-name. Default is to bring up a menu of locally available branches.") - (CL:UNLESS (STRINGP NEXTTITLESTRING) - (SETQ PROJECT NEXTTITLESTRING)) + (CL:UNLESS (STRINGP NEXTTITLESTRING) + (SETQ PROJECT NEXTTITLESTRING)) (CL:UNLESS PROJECT - (CL:WHEN (GIT-GET-PROJECT BRANCH NIL T) - (SETQ PROJECT BRANCH) - (SETQ BRANCH NIL))) - (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - (GIT-FETCH PROJECT) - (SELECTQ (U-CASE BRANCH) - (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT) + (CL:WHEN (GIT-GET-PROJECT BRANCH NIL T) + (SETQ PROJECT BRANCH) + (SETQ BRANCH NIL))) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (GIT-FETCH PROJECT) + (SELECTQ (U-CASE BRANCH) + (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT) PROJECT)) ((NEW NEXT) - (GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT)) - (CL:WHEN [SETQ BRANCH (IF BRANCH - THEN (GIT-LONG-NAME BRANCH NIL PROJECT) - ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T) - (CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME) + (GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT)) + (CL:WHEN [SETQ BRANCH (IF BRANCH + THEN (GIT-LONG-NAME BRANCH NIL PROJECT) + ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T) + (CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME) T) " branches"] - (GIT-CHECKOUT BRANCH PROJECT)))) + (GIT-CHECKOUT BRANCH PROJECT)))) -(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - (GIT-FETCH PROJECT) - (CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME) +(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (GIT-FETCH PROJECT) + (CONCAT (L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME) T) " " - (GIT-WHICH-BRANCH PROJECT))) - -(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T) - (SETQ SUBDIR PROJECT) - (SETQ PROJECT GIT-DEFAULT-PROJECT)) - (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR)) - (CHARCODE (> /] - (SETQ SUBDIR (CONCAT SUBDIR "/"))) - (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST) - (OR SUBDIR ""))) + (GIT-WHICH-BRANCH PROJECT))) + +(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T) + (SETQ SUBDIR PROJECT) + (SETQ PROJECT GIT-DEFAULT-PROJECT)) + (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR)) + (CHARCODE (> /] + (SETQ SUBDIR (CONCAT SUBDIR "/"))) + (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST) + (OR SUBDIR ""))) T)) -(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T) - (SETQ SUBDIR PROJECT) - (SETQ PROJECT GIT-DEFAULT-PROJECT)) - (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR)) - (CHARCODE (> /] - (SETQ SUBDIR (CONCAT SUBDIR "/"))) - (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) - (OR SUBDIR ""))) +(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T) + (SETQ SUBDIR PROJECT) + (SETQ PROJECT GIT-DEFAULT-PROJECT)) + (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR)) + (CHARCODE (> /] + (SETQ SUBDIR (CONCAT SUBDIR "/"))) + (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) + (OR SUBDIR ""))) T)) (DEFINEQ @@ -616,12 +617,12 @@ -(* ;; "") +(* ;; "") -(* ;; "File correspondents") +(* ;; "File correspondents") (DEFINEQ @@ -864,12 +865,12 @@ -(* ;; "") +(* ;; "") -(* ;; "Git commands") +(* ;; "Git commands") (DEFINEQ @@ -1073,7 +1074,7 @@ -(* ;; "Differences") +(* ;; "Differences") (DEFINEQ @@ -1261,12 +1262,12 @@ -(* ;; "") +(* ;; "") -(* ;; "Branches") +(* ;; "Branches") (DEFINEQ @@ -1574,7 +1575,7 @@ -(* ;; "My branches") +(* ;; "My branches") (DEFINEQ @@ -1641,12 +1642,12 @@ -(* ;; "") +(* ;; "") -(* ;; "Worktrees") +(* ;; "Worktrees") (DEFINEQ @@ -1717,12 +1718,12 @@ -(* ;; "") +(* ;; "") -(* ;; "Comparisons") +(* ;; "Comparisons") (DEFINEQ @@ -1934,98 +1935,100 @@ else '(0 differences)) else '(0 differences]) -(GIT-WORKING-COMPARE-DIRECTORIES +(GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) - (* ;; "Edited 12-Jun-2024 22:52 by mth") + (* ;; "Edited 29-Apr-2025 15:14 by rmk") + + (* ;; "Edited 12-Jun-2024 22:52 by mth") - (* ;; "Edited 26-Sep-2023 22:41 by rmk") + (* ;; "Edited 26-Sep-2023 22:41 by rmk") - (* ;; "Edited 17-Jun-2023 22:54 by rmk") + (* ;; "Edited 17-Jun-2023 22:54 by rmk") - (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 10-Jun-2023 21:32 by rmk") - (* ;; "Edited 20-Jul-2022 21:18 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") - (* ;; "Edited 25-Jun-2022 21:37 by rmk") + (* ;; "Edited 25-Jun-2022 21:37 by rmk") - (* ;; "Edited 17-May-2022 17:39 by rmk") + (* ;; "Edited 17-May-2022 17:39 by rmk") - (* ;; "Edited 10-May-2022 10:41 by rmk") + (* ;; "Edited 10-May-2022 10:41 by rmk") (* ;; - "Edited 29-Mar-2022 13:58 by rmk: working 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.") - (CL:UNLESS (AND (fetch GITHOST of PROJECT) - (fetch WHOST of PROJECT)) - (ERROR (fetch PROJECTNAME of PROJECT) + (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.") + (CL:UNLESS (AND (fetch GITHOST of PROJECT) + (fetch WHOST of PROJECT)) + (ERROR (fetch PROJECTNAME of PROJECT) " does not have both git and working directories")) - (CL:WHEN (AND (LISTP SUBDIRS) - (NULL (CDR SUBDIRS))) - (SETQ SUBDIRS (CAR SUBDIRS))) + (CL:WHEN (AND (LISTP SUBDIRS) + (NULL (CDR SUBDIRS))) + (SETQ SUBDIRS (CAR SUBDIRS))) (CL:UNLESS SUBDIRS - (SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT) + (SETQ SUBDIRS (OR (fetch DEFAULTSUBDIRS of PROJECT) 'ALL))) - (SETQ SUBDIRS (L-CASE SUBDIRS)) - (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) - then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) + (SETQ SUBDIRS (L-CASE SUBDIRS)) + (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) + then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) "ALL subdirectories" - else SUBDIRS))) - (for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) + else SUBDIRS))) + (for SUBDIR TITLE CDVAL (WPROJ _ (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) T))) (NENTRIES _ 0) - (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT 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) - (GITSUBDIR SUBDIR T PROJECT) - (OR SELECT '(> < ~= -* *-)) - NIL - (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) - collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + (BRANCH2 _ (GIT-WHICH-BRANCH PROJECT 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) + (GITSUBDIR SUBDIR T PROJECT) + (OR SELECT '(> < ~= -* *-)) + '(*.* *>*.* .* *>.*) + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E 'DIRECTORY) 1 NIL T T FILEDIRCASEARRAY)) (CL:IF DPOS - (SUBSTRING E (ADD1 DPOS)) + (SUBSTRING E (ADD1 DPOS)) E)) NIL NIL NIL FIXDIRECTORYDATES)) - [for CDE in (fetch CDENTRIES of CDVAL) - do (CL:WHEN (fetch INFO1 of CDE) - (change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE)) - (UNSLASHIT DATUM T))) - (CL:WHEN (fetch INFO2 of CDE) - (change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE)) - (SLASHIT DATUM T)))] + [for CDE in (fetch CDENTRIES of CDVAL) + do (CL:WHEN (fetch INFO1 of CDE) + (change (fetch (CDINFO FULLNAME) of (fetch INFO1 of CDE)) + (UNSLASHIT DATUM T))) + (CL:WHEN (fetch INFO2 of CDE) + (change (fetch (CDINFO FULLNAME) of (fetch INFO2 of CDE)) + (SLASHIT DATUM T)))] CDVAL - finally + finally - (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") + (* ;; "Set up the browsers after everything has been done, otherwise if the user doesn't pay attention it might hang waiting for a region.") - (CL:WHEN (AND (CDR $$VAL) + (CL:WHEN (AND (CDR $$VAL) GIT-MERGE-COMPARES) - (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 WPROJ " vs. " BRANCH2 " " SUBDIR " " - (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) + (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 WPROJ " vs. " BRANCH2 " " SUBDIR " " + (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) " files")) - [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) + [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN GIT-CD-LABELFN PROJECT ,PROJECT) GIT-CDBROWSER-SEPARATE-DIRECTIONS `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) - ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) + ,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T) '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))] - (CONS (CONCAT SUBDIR "/") - (for CDENTRY in (fetch CDENTRIES of CDVAL) - collect (fetch MATCHNAME of CDENTRY))) - (add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL] - (SETQ LAST-WMEDLEY-CDVALUES $$VAL) - (TERPRI T) - (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) + (CONS (CONCAT SUBDIR "/") + (for CDENTRY in (fetch CDENTRIES of CDVAL) + collect (fetch MATCHNAME of CDENTRY))) + (add NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL] + (SETQ LAST-WMEDLEY-CDVALUES $$VAL) + (TERPRI T) + (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) 'difference 'differences)]) @@ -2270,16 +2273,16 @@ RB NIL PROJECT]) ) -(RPAQ? FROMGITN 0) +(RPAQ? FROMGITN 0) -(* ;; "") +(* ;; "") -(* ;; "Utilities") +(* ;; "Utilities") (DEFINEQ @@ -2427,35 +2430,35 @@ STRING]) ) -(PUTPROPS GITFNS FILETYPE :TCOMPL) +(PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4202 20781 (GIT-CLONEP 4212 . 5540) (GIT-INIT 5542 . 6172) (GIT-MAKE-PROJECT 6174 . -13839) (GIT-GET-PROJECT 13841 . 15766) (GIT-PUT-PROJECT-FIELD 15768 . 17409) (GIT-PROJECT-PATH 17411 - . 18455) (FIND-ANCESTOR-DIRECTORY 18457 . 18806) (GIT-FIND-CLONE 18808 . 19889) (GIT-MAINBRANCH 19891 - . 20286) (GIT-MAINBRANCH? 20288 . 20779)) (26244 31173 (PRC-COMMAND 26254 . 31171)) (31229 34017 ( -ALLSUBDIRS 31239 . 32525) (MEDLEYSUBDIRS 32527 . 33220) (GITSUBDIRS 33222 . 34015)) (34018 38808 ( -TOGIT 34028 . 35434) (FROMGIT 35436 . 36417) (GIT-DELETE-FILE 36419 . 37265) (MYMEDLEY-DELETE-FILES -37267 . 38806)) (38809 41812 (MYMEDLEYSUBDIR 38819 . 39275) (GITSUBDIR 39277 . 39720) (STRIPDIR 39722 - . 40093) (STRIPHOST 40095 . 40335) (STRIPNAME 40337 . 41090) (STRIPWHERE 41092 . 41810)) (41813 43715 - (GFILE4MFILE 41823 . 42186) (MFILE4GFILE 42188 . 42757) (GIT-REPO-FILENAME 42759 . 43713)) (43764 -54019 (GIT-COMMIT 43774 . 44600) (GIT-PUSH 44602 . 45362) (GIT-PULL 45364 . 46116) (GIT-APPROVAL 46118 - . 46467) (GIT-GET-FILE 46469 . 48384) (GIT-FILE-EXISTS? 48386 . 48660) (GIT-REMOTE-UPDATE 48662 . -49497) (GIT-REMOTE-ADD 49499 . 49806) (GIT-FILE-DATE 49808 . 50855) (GIT-FILE-HISTORY 50857 . 52791) ( -GIT-PRINT-FILE-HISTORY 52793 . 53843) (GIT-FETCH 53845 . 54017)) (54049 65169 (GIT-BRANCH-DIFF 54059 - . 60806) (GIT-COMMIT-DIFFS 60808 . 61481) (GIT-BRANCH-RELATIONS 61483 . 65167)) (65214 84600 ( -GIT-BRANCH-NUM 65224 . 65797) (GIT-CHECKOUT 65799 . 67085) (GIT-WHICH-BRANCH 67087 . 67494) ( -GIT-MAKE-BRANCH 67496 . 70075) (GIT-BRANCHES 70077 . 72672) (GIT-BRANCH-EXISTS? 72674 . 73545) ( -GIT-PICK-BRANCH 73547 . 74037) (GIT-BRANCH-MENU 74039 . 74920) (GIT-BRANCH-WHENSELECTEDFN 74922 . -77461) (GIT-PULL-REQUESTS 77463 . 80981) (GIT-SHORT-BRANCH-NAME 80983 . 81274) (GIT-LONG-NAME 81276 . -81593) (GIT-PRC-BRANCHES 81595 . 84598)) (84630 88078 (GIT-MY-CURRENT-BRANCH 84640 . 85010) ( -GIT-MY-BRANCHP 85012 . 85630) (GIT-MY-NEXT-BRANCH 85632 . 86126) (GIT-MY-BRANCHES 86128 . 88076)) ( -88124 92199 (GIT-ADD-WORKTREE 88134 . 89741) (GIT-REMOVE-WORKTREE 89743 . 90673) (GIT-LIST-WORKTREES -90675 . 91479) (WORKTREEDIR 91481 . 92197)) (92247 125381 (GIT-GET-DIFFERENT-FILES 92257 . 98681) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 98683 . 105914) (GIT-WORKING-COMPARE-DIRECTORIES 105916 . 111364) ( -GIT-COMPARE-WORKTREE 111366 . 115344) (GITCDOBJBUTTONFN 115346 . 119836) (GIT-CD-LABELFN 119838 . -120920) (GIT-CD-MENUFN 120922 . 123362) (GIT-WORKING-COMPARE-FILES 123364 . 123984) ( -GIT-BRANCHES-COMPARE-FILES 123986 . 125150) (GIT-PR-COMPARE 125152 . 125379)) (125451 133774 (CDGITDIR - 125461 . 126148) (GIT-COMMAND 126150 . 127708) (GITORIGIN 127710 . 128407) (GIT-INITIALS 128409 . -128713) (GIT-COMMAND-TO-FILE 128715 . 132200) (GIT-RESULT-TO-LINES 132202 . 133107) (STRIPLOCAL 133109 - . 133772))))) + (FILEMAP (NIL (4225 20804 (GIT-CLONEP 4235 . 5563) (GIT-INIT 5565 . 6195) (GIT-MAKE-PROJECT 6197 . +13862) (GIT-GET-PROJECT 13864 . 15789) (GIT-PUT-PROJECT-FIELD 15791 . 17432) (GIT-PROJECT-PATH 17434 + . 18478) (FIND-ANCESTOR-DIRECTORY 18480 . 18829) (GIT-FIND-CLONE 18831 . 19912) (GIT-MAINBRANCH 19914 + . 20309) (GIT-MAINBRANCH? 20311 . 20802)) (26471 31400 (PRC-COMMAND 26481 . 31398)) (31448 34236 ( +ALLSUBDIRS 31458 . 32744) (MEDLEYSUBDIRS 32746 . 33439) (GITSUBDIRS 33441 . 34234)) (34237 39027 ( +TOGIT 34247 . 35653) (FROMGIT 35655 . 36636) (GIT-DELETE-FILE 36638 . 37484) (MYMEDLEY-DELETE-FILES +37486 . 39025)) (39028 42031 (MYMEDLEYSUBDIR 39038 . 39494) (GITSUBDIR 39496 . 39939) (STRIPDIR 39941 + . 40312) (STRIPHOST 40314 . 40554) (STRIPNAME 40556 . 41309) (STRIPWHERE 41311 . 42029)) (42032 43934 + (GFILE4MFILE 42042 . 42405) (MFILE4GFILE 42407 . 42976) (GIT-REPO-FILENAME 42978 . 43932)) (43975 +54230 (GIT-COMMIT 43985 . 44811) (GIT-PUSH 44813 . 45573) (GIT-PULL 45575 . 46327) (GIT-APPROVAL 46329 + . 46678) (GIT-GET-FILE 46680 . 48595) (GIT-FILE-EXISTS? 48597 . 48871) (GIT-REMOTE-UPDATE 48873 . +49708) (GIT-REMOTE-ADD 49710 . 50017) (GIT-FILE-DATE 50019 . 51066) (GIT-FILE-HISTORY 51068 . 53002) ( +GIT-PRINT-FILE-HISTORY 53004 . 54054) (GIT-FETCH 54056 . 54228)) (54256 65376 (GIT-BRANCH-DIFF 54266 + . 61013) (GIT-COMMIT-DIFFS 61015 . 61688) (GIT-BRANCH-RELATIONS 61690 . 65374)) (65413 84799 ( +GIT-BRANCH-NUM 65423 . 65996) (GIT-CHECKOUT 65998 . 67284) (GIT-WHICH-BRANCH 67286 . 67693) ( +GIT-MAKE-BRANCH 67695 . 70274) (GIT-BRANCHES 70276 . 72871) (GIT-BRANCH-EXISTS? 72873 . 73744) ( +GIT-PICK-BRANCH 73746 . 74236) (GIT-BRANCH-MENU 74238 . 75119) (GIT-BRANCH-WHENSELECTEDFN 75121 . +77660) (GIT-PULL-REQUESTS 77662 . 81180) (GIT-SHORT-BRANCH-NAME 81182 . 81473) (GIT-LONG-NAME 81475 . +81792) (GIT-PRC-BRANCHES 81794 . 84797)) (84825 88273 (GIT-MY-CURRENT-BRANCH 84835 . 85205) ( +GIT-MY-BRANCHP 85207 . 85825) (GIT-MY-NEXT-BRANCH 85827 . 86321) (GIT-MY-BRANCHES 86323 . 88271)) ( +88311 92386 (GIT-ADD-WORKTREE 88321 . 89928) (GIT-REMOVE-WORKTREE 89930 . 90860) (GIT-LIST-WORKTREES +90862 . 91666) (WORKTREEDIR 91668 . 92384)) (92426 125819 (GIT-GET-DIFFERENT-FILES 92436 . 98860) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 98862 . 106093) (GIT-WORKING-COMPARE-DIRECTORIES 106095 . 111802) ( +GIT-COMPARE-WORKTREE 111804 . 115782) (GITCDOBJBUTTONFN 115784 . 120274) (GIT-CD-LABELFN 120276 . +121358) (GIT-CD-MENUFN 121360 . 123800) (GIT-WORKING-COMPARE-FILES 123802 . 124422) ( +GIT-BRANCHES-COMPARE-FILES 124424 . 125588) (GIT-PR-COMPARE 125590 . 125817)) (125881 134204 (CDGITDIR + 125891 . 126578) (GIT-COMMAND 126580 . 128138) (GITORIGIN 128140 . 128837) (GIT-INITIALS 128839 . +129143) (GIT-COMMAND-TO-FILE 129145 . 132630) (GIT-RESULT-TO-LINES 132632 . 133537) (STRIPLOCAL 133539 + . 134202))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index a8c7625a6806bc4384e20a4e751441000915bfa0..41362e26693d7f283f6fa3b03a2b81caf290b6a8 100644 GIT binary patch delta 837 zcmZuvQESss6gCvWRVN6W4?5i0m5milmwS_YZxe=^rb!n~laizxLs09QLQ&V!4pD|1 zQh$IW|G+<>qc2mC{Q@8S2|oKE=(~8MEl%+~ecw6fp7VVt86D)lALL$b%n)5RdwrQG zgaW1p=7!1-9B1pKNs>_d1V~79>x5{lTJy~7I>#HUuMef`wW(7gK3q_yZyri0mG|)JZk9>!?Y%$qEjYh)_wdJ;(Zc?gw9mk^ z{c5}hyi@`!@GUb2&M8=xau{qxb_krZOsQNmUB4WfzO{A(7*i+BjFQO+TH+AfVLfz# zQf=Jexls(1;7Py6Rfs$@T61I2gbir;6RPSMqDDE2L)Wi@$~g#F48yJ w@?=mH2?P|gj3Ti_Nf&l!(~rYTb9ulz5xM4e3#y$RfiTZ_w+(2Nd-=BV6G}1IaR2}S delta 814 zcmZuv-)qxQ6gC@z78M6$2%GY8Wn#h9Bsa-T!a&nB%_3=1lho;hLRnKRbU$c^D7qEd zK=8?u|Gi zC=n`&jrKrPBt?TPS(0ffI>8`Y-`d#j^|KDLm)nEkvIWmiMbAyex*xdcZGzNWL4dR6 zl}d%6)864l|I?+EluNgZawm4}bjGda--K)9-Rl>r37JwumGi!^bhREP|1`^+pXSSD zSk2gdnn97eaWnRzY0_yz;3p|GnN9Om-9!@D$*P}1 zRV^K@a7wAckhH2v8vCIK$|yK&MhU1cqi`~`8*bfqgBrMh`P|X`ES1^h&D%v`q%w4R z-EKC>HrKNu7&qD3+J3c+6%kC~EwhY&`HK9a+XIdz4b3=u;5vL?NjllksfmGIb%S~c z-PG_G8%8l!&5xlQ3jTPYKxg_XmZ5p(+5VuK4xZ1&qxcD^tiXNj1g*r6_-z|H+WkJ) zf*l0>jc~tBkh_FCZRAh)?+9xCe*dPYf)H*r1wofT%^@j4S0&D-!B1&%dJ>!{tROFj n75;;8%awwX{L;bV5@fSr?adCn-VR4HEBICyq%?63KG%K&uGi7!