GITFNS: PROCESS-COMMAND moved to UNIXUTILS, cleanups from previous (unexamined) PR
The other PR will be cleaned out
This commit is contained in:
rmkaplan
parent
68ed78a9f9
commit
445de6745d
324
lispusers/GITFNS
324
lispusers/GITFNS
@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}<lispusers>GITFNS.;469 119763
|
||||
(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}<lispusers>GITFNS.;483 124031
|
||||
|
||||
:CHANGES-TO (FNS GIT-MAKE-PROJECT)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}<lispusers>GITFNS.;468)
|
||||
:CHANGES-TO (FNS CDGITDIR)
|
||||
|
||||
:PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}<lispusers>GITFNS.;482)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@ -47,6 +49,7 @@
|
||||
(INITVARS (GIT-MERGE-COMPARES T)
|
||||
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
|
||||
(COMMANDS gwc bbc prc cob b? cdg cdw)
|
||||
(FNS PRC-COMMAND)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@ -65,7 +68,7 @@
|
||||
|
||||
(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)
|
||||
GIT-FETCH GIT-PR-BRANCHES)
|
||||
|
||||
(* ;; "Differences")
|
||||
|
||||
@ -77,8 +80,8 @@
|
||||
(* ;; "Branches")
|
||||
|
||||
(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 GIT-SHORT-BRANCH-NAME
|
||||
GIT-LONG-NAME)
|
||||
GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS
|
||||
GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
|
||||
|
||||
(* ;; "My branches")
|
||||
|
||||
@ -98,7 +101,7 @@
|
||||
|
||||
(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-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE)
|
||||
(INITVARS (FROMGITN 0))
|
||||
|
||||
(* ;; "")
|
||||
@ -106,8 +109,8 @@
|
||||
|
||||
(* ;; "Utilities")
|
||||
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND
|
||||
GIT-RESULT-TO-LINES STRIPLOCAL)
|
||||
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES
|
||||
STRIPLOCAL)
|
||||
(PROPS (GITFNS FILETYPE))))
|
||||
|
||||
|
||||
@ -314,7 +317,8 @@
|
||||
PROJECT))])
|
||||
|
||||
(GIT-PUT-PROJECT-FIELD
|
||||
[LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk")
|
||||
[LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 10-Jun-2023 21:48 by rmk")
|
||||
(* ; "Edited 11-Mar-2023 23:00 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 11:25 by rmk")
|
||||
(* ; "Edited 13-May-2022 10:40 by rmk")
|
||||
(* ; "Edited 9-May-2022 20:02 by rmk")
|
||||
@ -322,24 +326,17 @@
|
||||
|
||||
(* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings")
|
||||
|
||||
(CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT)
|
||||
THEN PROJECT
|
||||
ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT)
|
||||
GIT-DEFAULT-PROJECT)
|
||||
GIT-PROJECTS))
|
||||
ELSEIF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "NOT A GIT-PROJECT" PROJECT)))
|
||||
(SELECTQ FIELD
|
||||
(PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE))
|
||||
(WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE))
|
||||
(GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE))
|
||||
(EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE))
|
||||
(DEFAULTSUBDIRS
|
||||
(REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE))
|
||||
(CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE))
|
||||
(MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE))
|
||||
PROJECT))])
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(SELECTQ FIELD
|
||||
(PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE))
|
||||
(WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE))
|
||||
(GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE))
|
||||
(EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE))
|
||||
(DEFAULTSUBDIRS
|
||||
(REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE))
|
||||
(CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE))
|
||||
(MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE))
|
||||
PROJECT])
|
||||
|
||||
(GIT-PROJECT-PATH
|
||||
[LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk")
|
||||
@ -478,29 +475,7 @@
|
||||
|
||||
(* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
|
||||
|
||||
(LET ((RB REMOTEBRANCH)
|
||||
(DR DRAFTS)
|
||||
(PRS))
|
||||
(IF PROJECT
|
||||
THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
ELSEIF (GIT-GET-PROJECT RB NIL T)
|
||||
THEN (SETQ PROJECT RB)
|
||||
(SETQ RB NIL)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS NIL T)
|
||||
THEN (SETQ PROJECT DRAFTS)
|
||||
(SETQ DRFTS NIL))
|
||||
(CL:WHEN (MEMB (U-CASE RB)
|
||||
'(DRAFT DRAFTS))
|
||||
(SETQ RB NIL)
|
||||
(SETQ DR T))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT))
|
||||
(IF PRS
|
||||
THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS)
|
||||
"Pull requests")))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT)
|
||||
RB NIL PROJECT))
|
||||
ELSE "No open pull requests")))
|
||||
(PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
|
||||
|
||||
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
|
||||
|
||||
@ -553,6 +528,46 @@
|
||||
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
|
||||
(OR SUBDIR "")))
|
||||
T))
|
||||
(DEFINEQ
|
||||
|
||||
(PRC-COMMAND
|
||||
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 28-Jul-2023 09:03 by rmk")
|
||||
(LET (PRS PRMENU)
|
||||
(IF PROJECT
|
||||
THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
ELSEIF (GIT-GET-PROJECT REMOTEBRANCH NIL T)
|
||||
THEN (SETQ PROJECT REMOTEBRANCH)
|
||||
(SETQ REMOTEBRANCH NIL)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS NIL T)
|
||||
THEN (SETQ PROJECT DRAFTS)
|
||||
(SETQ DRAFTS NIL))
|
||||
(CL:WHEN (MEMB (U-CASE REMOTEBRANCH)
|
||||
'(DRAFT DRAFTS))
|
||||
(SETQ REMOTEBRANCH NIL)
|
||||
(SETQ DRAFTS T))
|
||||
(GIT-FETCH PROJECT)
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFTS PROJECT))
|
||||
(CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu))
|
||||
(for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
|
||||
NIL NIL NIL NIL FILEDIRCASEARRAY)
|
||||
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
|
||||
NIL NIL NIL NIL FILEDIRCASEARRAY)) collect PR
|
||||
finally (CL:WHEN $$VAL (SETQ PRS $$VAL))
|
||||
(SETQ REMOTEBRANCH NIL)))
|
||||
(IF PRS
|
||||
THEN (CL:UNLESS REMOTEBRANCH
|
||||
(SETQ PRS (GIT-PRC-BRANCHES DRAFTS PROJECT PRS))
|
||||
(SETQ PRMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS)
|
||||
" pull requests")
|
||||
NIL))
|
||||
(SETQ REMOTEBRANCH (MENU PRMENU)))
|
||||
(if (EQ 'PinMenu REMOTEBRANCH)
|
||||
then (ADDMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS)
|
||||
" pull requests")))
|
||||
elseif REMOTEBRANCH
|
||||
then (GIT-PR-COMPARE REMOTEBRANCH PROJECT))
|
||||
ELSE "No open pull requests"])
|
||||
)
|
||||
|
||||
|
||||
|
||||
@ -1004,6 +1019,35 @@
|
||||
(GIT-FETCH
|
||||
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk")
|
||||
(GIT-COMMAND "git fetch" T NIL PROJECT])
|
||||
|
||||
(GIT-PR-BRANCHES
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
)
|
||||
|
||||
|
||||
@ -1321,41 +1365,24 @@
|
||||
THEN (ERROR "Unknown branch" BRANCH])
|
||||
|
||||
(GIT-PICK-BRANCH
|
||||
[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)))])
|
||||
[LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"])
|
||||
|
||||
(GIT-PRC-MENU
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
(GIT-BRANCH-MENU
|
||||
[LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk")
|
||||
(* ; "Edited 30-Jun-2023 16:58 by rmk")
|
||||
(* ; "Edited 18-May-2022 13:44 by rmk")
|
||||
(CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
|
||||
(CL:WHEN PIN?
|
||||
[SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
|
||||
(CREATE MENU
|
||||
TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
|
||||
" branches"))
|
||||
ITEMS _ BRANCHES
|
||||
MENUFONT _ DEFAULTFONT))])
|
||||
|
||||
(GIT-PULL-REQUESTS
|
||||
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk")
|
||||
@ -1402,6 +1429,35 @@
|
||||
(* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz")
|
||||
|
||||
(FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B])
|
||||
|
||||
(GIT-PRC-BRANCHES
|
||||
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk")
|
||||
(* ; "Edited 4-Aug-2022 18:55 by rmk")
|
||||
(* ; "Edited 9-Jul-2022 19:01 by rmk")
|
||||
(* ; "Edited 16-May-2022 19:44 by rmk")
|
||||
(CL:UNLESS PRS
|
||||
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT)))
|
||||
(CL:WHEN PRS
|
||||
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR)))
|
||||
NIL T PROJECT)))
|
||||
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS))
|
||||
(EQUALS _ (CADR RELATIONS)) IN PRS
|
||||
COLLECT (SETQ PRNAME (fetch PRNAME of PR))
|
||||
(SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR)
|
||||
" "
|
||||
(IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS]
|
||||
THEN (CONCAT PRNAME " > " REL)
|
||||
ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS]
|
||||
THEN (CONCAT PRNAME " = " REL)
|
||||
ELSE PRNAME)))
|
||||
(LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR))
|
||||
(CONCAT LABEL " (draft)")
|
||||
LABEL)
|
||||
(GITORIGIN PRNAME)
|
||||
(CONCAT " " (FETCH PRDESCRIPTION OF PR)
|
||||
" #"
|
||||
(FETCH PRNUMBER OF PR]
|
||||
T)))])
|
||||
)
|
||||
|
||||
|
||||
@ -1664,7 +1720,8 @@
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk")
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk")
|
||||
(* ; "Edited 12-Sep-2022 14:41 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
(* ; "Edited 22-May-2022 22:47 by rmk")
|
||||
(* ; "Edited 9-May-2022 15:14 by rmk")
|
||||
@ -1683,10 +1740,11 @@
|
||||
(SETQ MAPPINGS (CADDR DIRS))
|
||||
(IF DIRS
|
||||
THEN (TERPRI T)
|
||||
(SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
|
||||
[SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
|
||||
(CADR DIRS)
|
||||
'(> < ~= -* *-)
|
||||
'*>*.*))
|
||||
'*>*.*
|
||||
(GIT-GET-PROJECT PROJECT 'EXCLUSIONS]
|
||||
|
||||
(* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.")
|
||||
|
||||
@ -1754,6 +1812,10 @@
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 17-Jun-2023 22:54 by rmk")
|
||||
|
||||
(* ;; "Edited 10-Jun-2023 21:32 by rmk")
|
||||
|
||||
(* ;; "Edited 20-Jul-2022 21:18 by rmk")
|
||||
|
||||
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
|
||||
@ -1793,7 +1855,13 @@
|
||||
(GITSUBDIR SUBDIR T PROJECT)
|
||||
(OR SELECT '(> < ~= -* *-))
|
||||
NIL
|
||||
(FETCH EXCLUSIONS OF PROJECT)
|
||||
(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))
|
||||
E))
|
||||
NIL NIL NIL FIXDIRECTORYDATES))
|
||||
[FOR CDE IN (FETCH CDENTRIES OF CDVAL)
|
||||
DO (CL:WHEN (FETCH INFO1 OF CDE)
|
||||
@ -2067,6 +2135,11 @@
|
||||
" " FILE)
|
||||
(CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2)
|
||||
" " FILE])
|
||||
|
||||
(GIT-PR-COMPARE
|
||||
[LAMBDA (RB PROJECT) (* ; "Edited 6-Jul-2023 22:22 by rmk")
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT)
|
||||
RB NIL PROJECT])
|
||||
)
|
||||
|
||||
(RPAQ? FROMGITN 0)
|
||||
@ -2083,11 +2156,13 @@
|
||||
(DEFINEQ
|
||||
|
||||
(CDGITDIR
|
||||
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk")
|
||||
[LAMBDA (PROJECT) (* ; "Edited 23-Sep-2023 13:01 by rmk")
|
||||
(* ; "Edited 8-Jul-2022 10:34 by rmk")
|
||||
(* ; "Edited 7-Jul-2022 09:36 by rmk")
|
||||
(* ; "Edited 7-May-2022 22:41 by rmk")
|
||||
(* ; "Edited 2-Nov-2021 21:12 by rmk:")
|
||||
(CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT]
|
||||
(CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH GITHOST OF PROJECT))
|
||||
NIL T)
|
||||
" && "])
|
||||
|
||||
(GIT-COMMAND
|
||||
@ -2198,16 +2273,6 @@
|
||||
(ERROR (CONCAT "Command failed: " CMD)))
|
||||
NIL])
|
||||
|
||||
(PROCESS-COMMAND
|
||||
[LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk")
|
||||
|
||||
(* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.")
|
||||
|
||||
(CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD))
|
||||
(BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1)
|
||||
of PS))
|
||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||
|
||||
(GIT-RESULT-TO-LINES
|
||||
[LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk")
|
||||
|
||||
@ -2234,32 +2299,33 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 .
|
||||
13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435
|
||||
. 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915
|
||||
. 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS
|
||||
28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420)
|
||||
(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR
|
||||
34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME
|
||||
36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE
|
||||
38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH
|
||||
40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) (
|
||||
GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) (
|
||||
GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) (
|
||||
GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524
|
||||
) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT
|
||||
60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 .
|
||||
66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727)
|
||||
(GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487)
|
||||
) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) (
|
||||
GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE
|
||||
75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR
|
||||
79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) (
|
||||
GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 .
|
||||
106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) (
|
||||
GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND
|
||||
111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE
|
||||
114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL
|
||||
119031 . 119694)))))
|
||||
(FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 .
|
||||
13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133
|
||||
. 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613
|
||||
. 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 (
|
||||
ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 (
|
||||
TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES
|
||||
34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587
|
||||
. 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580
|
||||
(GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629
|
||||
52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727
|
||||
. 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 .
|
||||
46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) (
|
||||
GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) (
|
||||
52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS
|
||||
59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) (
|
||||
GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) (
|
||||
GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) (
|
||||
GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) (
|
||||
GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP
|
||||
76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 (
|
||||
GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873)
|
||||
(WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) (
|
||||
GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) (
|
||||
GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 .
|
||||
111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) (
|
||||
GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR
|
||||
115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 .
|
||||
119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299
|
||||
. 123962)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user