github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-29 21:27:41 +00:00
Code Issues Projects Releases Wiki Activity

GITFNS: PROCESS-COMMAND moved to UNIXUTILS, cleanups from previous (unexamined) PR

Browse Source 
The other PR will be cleaned out
This commit is contained in:
rmkaplan
2023-09-23 16:30:47 -07:00
parent 68ed78a9f9
commit 445de6745d
2 changed files with 195 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files

324
lispusers/GITFNS
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (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) (PRETTYCOMPRINT GITFNSCOMS)
@@ -47,6 +49,7 @@
(INITVARS (GIT-MERGE-COMPARES T) (INITVARS (GIT-MERGE-COMPARES T)
(GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
(COMMANDS gwc bbc prc cob b? cdg cdw) (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? (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-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY
GIT-FETCH) GIT-FETCH GIT-PR-BRANCHES)
(* ;; "Differences") (* ;; "Differences")
@@ -77,8 +80,8 @@
(* ;; "Branches") (* ;; "Branches")
(FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-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-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS
GIT-LONG-NAME) GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
(* ;; "My branches") (* ;; "My branches")
@@ -98,7 +101,7 @@
(FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES
GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN 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)) (INITVARS (FROMGITN 0))
(* ;; "") (* ;; "")
@@ -106,8 +109,8 @@
(* ;; "Utilities") (* ;; "Utilities")
(FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES
GIT-RESULT-TO-LINES STRIPLOCAL) STRIPLOCAL)
(PROPS (GITFNS FILETYPE)))) (PROPS (GITFNS FILETYPE))))
@@ -314,7 +317,8 @@
PROJECT))]) PROJECT))])
(GIT-PUT-PROJECT-FIELD (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 7-Jul-2022 11:25 by rmk")
(* ; "Edited 13-May-2022 10:40 by rmk") (* ; "Edited 13-May-2022 10:40 by rmk")
(* ; "Edited 9-May-2022 20:02 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") (* ;; "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) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
THEN PROJECT (SELECTQ FIELD
ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT) (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE))
GIT-DEFAULT-PROJECT) (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE))
GIT-PROJECTS)) (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE))
ELSEIF NOERROR (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE))
THEN NIL (DEFAULTSUBDIRS
ELSE (ERROR "NOT A GIT-PROJECT" PROJECT))) (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE))
(SELECTQ FIELD (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE))
(PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE))
(WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) PROJECT])
(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 (GIT-PROJECT-PATH
[LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") [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") (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
(LET ((RB REMOTEBRANCH) (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
(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")))
(DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
@@ -553,6 +528,46 @@
(SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
(OR SUBDIR ""))) (OR SUBDIR "")))
T)) 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 (GIT-FETCH
[LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk") [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk")
(GIT-COMMAND "git fetch" T NIL PROJECT]) (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]) THEN (ERROR "Unknown branch" BRANCH])
(GIT-PICK-BRANCH (GIT-PICK-BRANCH
[LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk") [LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk")
(CL:WHEN (MKLIST BRANCHES) (* ; "Edited 30-Jun-2023 16:58 by rmk")
(MENU (CREATE MENU (* ; "Edited 18-May-2022 13:44 by rmk")
TITLE _ (OR TITLE 'Branches) (MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES)
ITEMS _ BRANCHES " branches"])
MENUFONT _ DEFAULTFONT)))])
(GIT-PRC-MENU (GIT-BRANCH-MENU
[LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") [LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk")
(* ; "Edited 4-Aug-2022 18:55 by rmk") (* ; "Edited 30-Jun-2023 16:58 by rmk")
(* ; "Edited 9-Jul-2022 19:01 by rmk") (* ; "Edited 18-May-2022 13:44 by rmk")
(* ; "Edited 16-May-2022 19:44 by rmk") (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES))
(CL:UNLESS PRS (CL:WHEN PIN?
(SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) [SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu])
(CL:WHEN PRS (CREATE MENU
(LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES)
NIL T PROJECT))) " branches"))
(SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) ITEMS _ BRANCHES
(EQUALS _ (CADR RELATIONS)) IN PRS MENUFONT _ DEFAULTFONT))])
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-PULL-REQUESTS (GIT-PULL-REQUESTS
[LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk") [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") (* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz")
(FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B]) (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))]) (LIST DIR1 DIR2 MAPPINGS))])
(GIT-BRANCHES-COMPARE-DIRECTORIES (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 20-Jul-2022 21:18 by rmk")
(* ; "Edited 22-May-2022 22:47 by rmk") (* ; "Edited 22-May-2022 22:47 by rmk")
(* ; "Edited 9-May-2022 15:14 by rmk") (* ; "Edited 9-May-2022 15:14 by rmk")
@@ -1683,10 +1740,11 @@
(SETQ MAPPINGS (CADDR DIRS)) (SETQ MAPPINGS (CADDR DIRS))
(IF DIRS (IF DIRS
THEN (TERPRI T) THEN (TERPRI T)
(SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS)
(CADR 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.") (* ;; "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 (GIT-WORKING-COMPARE-DIRECTORIES
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) [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 20-Jul-2022 21:18 by rmk")
(* ;; "Edited 25-Jun-2022 21:37 by rmk") (* ;; "Edited 25-Jun-2022 21:37 by rmk")
@@ -1793,7 +1855,13 @@
(GITSUBDIR SUBDIR T PROJECT) (GITSUBDIR SUBDIR T PROJECT)
(OR SELECT '(> < ~= -* *-)) (OR SELECT '(> < ~= -* *-))
NIL 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)) NIL NIL NIL FIXDIRECTORYDATES))
[FOR CDE IN (FETCH CDENTRIES OF CDVAL) [FOR CDE IN (FETCH CDENTRIES OF CDVAL)
DO (CL:WHEN (FETCH INFO1 OF CDE) DO (CL:WHEN (FETCH INFO1 OF CDE)
@@ -2067,6 +2135,11 @@
" " FILE) " " FILE)
(CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2) (CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2)
" " FILE]) " " 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) (RPAQ? FROMGITN 0)
@@ -2083,11 +2156,13 @@
(DEFINEQ (DEFINEQ
(CDGITDIR (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-Jul-2022 09:36 by rmk")
(* ; "Edited 7-May-2022 22:41 by rmk") (* ; "Edited 7-May-2022 22:41 by rmk")
(* ; "Edited 2-Nov-2021 21:12 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 (GIT-COMMAND
@@ -2198,16 +2273,6 @@
(ERROR (CONCAT "Command failed: " CMD))) (ERROR (CONCAT "Command failed: " CMD)))
NIL]) 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 (GIT-RESULT-TO-LINES
[LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk") [LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk")
@@ -2234,32 +2299,33 @@
(PUTPROPS GITFNS FILETYPE :TCOMPL) (PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . (FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 .
13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435 13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133
. 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915 . 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613
. 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS . 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 (
28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 (
(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES
34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME 34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587
36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE . 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580
38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH (GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629
40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) ( 52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727
GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) ( . 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 .
GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) ( 46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) (
GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524 GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) (
) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT 52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS
60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . 59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) (
66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727) GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) (
(GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487) GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) (
) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) ( GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) (
GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP
75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR 76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 (
79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) ( GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873)
GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) ( (WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) (
GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) (
106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) ( GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 .
GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND 111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) (
111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR
114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL 115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 .
119031 . 119694))))) 119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299
. 123962)))))
STOP STOP

BIN
lispusers/GITFNS.LCOM
View File

Binary file not shown.