diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 1c2efa56..962d86d0 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "31-Mar-2026 10:50:22" {WMEDLEY}COMPAREDIRECTORIES.;287 138875 +(FILECREATED "28-Apr-2026 23:41:24" {MEDLEY}COMPAREDIRECTORIES.;289 139726 :EDIT-BY rmk - :CHANGES-TO (FNS CDBROWSER-COPY) + :CHANGES-TO (FNS CDFILES.PATS CDFILES.MATCH CDBROWSER-COPY) - :PREVIOUS-DATE "10-Feb-2026 21:28:55" {WMEDLEY}COMPAREDIRECTORIES.;286) + :PREVIOUS-DATE "28-Apr-2026 21:38:49" {MEDLEY}COMPAREDIRECTORIES.;288) (PRETTYCOMPRINT COMPAREDIRECTORIESCOMS) @@ -507,32 +507,37 @@ UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME]) (CDFILES.MATCH - [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 26-Jan-2022 15:33 by rmk") + [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 28-Apr-2026 23:40 by rmk") + (* ; "Edited 26-Jan-2022 15:33 by rmk") (* ; "Edited 23-Dec-2021 21:47 by rmk") + (thereis P in PATTERNS suchthat - (* ;; "True if the components of the fullname match at least one of the patterns") + (* ;; "The SUBDIR test is tricky. If the exclusion pattern was internal/fonts/**, this shows up as (* * internal/fonts 65535), it has to match internal/fonts/display/completed/. Below we test for an initial substring") - (THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P) - FILEDIRCASEARRAY) - (EQ '* (CAR P)) - (AND (EQ (CHARCODE %.) - (CHCON1 (CAR P))) - (EQ (CHARCODE %.) - (CHCON1 NAME)) - (OR (STRING.EQUAL NAME (SUBATOM (CAR P) - 2)) - (EQ (CHARCODE *) - (NTHCHARCODE (CAR P) - 2] - (OR (STRING.EQUAL EXT (CADR P)) - (EQ '* (CADR P))) - (OR (STRING.EQUAL SUBDIR (CADDR P)) - (NULL (CADDR P)) - (EQ '* (CADDR P))) - (ILEQ THISDEPTH (CADDDR P]) + (AND [OR (STRING.EQUAL NAME (CAR P) + FILEDIRCASEARRAY) + (EQ '* (CAR P)) + (AND (EQ (CHARCODE %.) + (CHCON1 (CAR P))) + (EQ (CHARCODE %.) + (CHCON1 NAME)) + (OR (STRING.EQUAL NAME (SUBATOM (CAR P) + 2)) + (EQ (CHARCODE *) + (NTHCHARCODE (CAR P) + 2] + (OR (STRING.EQUAL EXT (CADR P)) + (EQ '* (CADR P))) + (ILEQ THISDEPTH (CADDDR P)) + (OR (STRING.EQUAL SUBDIR (CADDR P)) + (NULL (CADDR P)) + (EQ '* (CADDR P)) + (STRPOS (CADDR P) + SUBDIR 1 NIL T]) (CDFILES.PATS - [LAMBDA (PATTERNS) (* ; "Edited 17-Jun-2023 23:36 by rmk") + [LAMBDA (PATTERNS) (* ; "Edited 28-Apr-2026 23:01 by rmk") + (* ; "Edited 17-Jun-2023 23:36 by rmk") (* ; "Edited 23-Dec-2021 17:02 by rmk") (* ;; "Returns (NAME EXT SUBDIR DEPTH) items where NAME or EXT may be the wildcard *, SD is the subdirectory (if any) and DEPTH is the number of / or > in the subdirectory") @@ -544,15 +549,15 @@ (* * NIL 1) ) ELSE (FOR P N E SD DEPTH UNPACK INSIDE PATTERNS - JOIN (SETQ UNPACK (UNPACKFILENAME.STRING P)) (* ; + JOIN (SETQ UNPACK (UNPACKFILENAME P)) (* ;  "String so we can tell the difference between x and x.") - [SETQ SD (MKATOM (LISTGET UNPACK 'SUBDIRECTORY] + (SETQ SD (LISTGET UNPACK 'SUBDIRECTORY)) (* ;; "Count the subdirectory depth") - [SETQ DEPTH (IF (EQ SD '*) - THEN MAX.SMALLP - ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I) + [SETQ DEPTH (if (EQ SD '*) + then MAX.SMALLP + else (for I (CNT _ 1) from 1 do (SELCHARQ (NTHCHARCODE SD I) ((/ >) (ADD CNT 1)) (NIL (RETURN CNT)) @@ -560,28 +565,31 @@ (SETQ N (LISTGET UNPACK 'NAME)) (SETQ N (if (NULL N) then '* + elseif (EQ N '**) + then (SETQ DEPTH MAX.SMALLP) + '* elseif (NEQ 0 (NCHARS N)) - then (MKATOM N))) + then N)) (SETQ E (LISTGET UNPACK 'EXTENSION)) (SETQ E (if (NULL E) then '* elseif (NEQ 0 (NCHARS E)) - then (MKATOM E))) - (if [OR (AND (STRING.EQUAL N 'COM) + then E)) + (if [OR (AND (EQ N 'COM) (NULL E)) - (AND (STRING.EQUAL E 'COM) + (AND (EQ E 'COM) (MEMB N ' (* NIL)] - THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD DEPTH)) - ELSE (CONS (IF N - THEN (LIST N E SD DEPTH) - ELSEIF E - THEN + then (for CE in *COMPILED-EXTENSIONS* collect (LIST '* CE SD DEPTH)) + else (CONS (if N + then (LIST N E SD DEPTH) + elseif E + then (* ;; "This is the case .XXX, which presumably identifies a dotted file. If this is supposed to be all files with extension XXX, it shoud be specified as *.XXX, the case above. So we move .E into the N field.") (LIST (PACK* '%. E) NIL SD DEPTH) - ELSE ` + else ` (* * (\, SD) (\, DEPTH)) ]) @@ -2146,7 +2154,8 @@ NIL]) (CDBROWSER-COPY - [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 31-Mar-2026 10:49 by rmk") + [LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Apr-2026 18:54 by rmk") + (* ; "Edited 31-Mar-2026 10:49 by rmk") (* ; "Edited 28-Oct-2025 17:39 by rmk") (* ; "Edited 25-Oct-2025 23:58 by rmk") (* ; "Edited 24-May-2022 15:49 by rmk") @@ -2185,7 +2194,8 @@ (PRIN3 "No source file to copy" T) (RETURN NIL)) (CL:WHEN [AND (EQ DATERELBAD (FETCH (CDENTRY DATEREL) OF CDENTRY)) - (PROGN (FLASHWINDOW T) + (PROGN (GIVE.TTY.PROCESS T) + (FLASHWINDOW T) (EQ 'N (ASKUSER NIL NIL "Target is newer than source. Really copy? "] (RETURN NIL)) @@ -2195,6 +2205,7 @@ )) 'VERSION)) (PROGN (FLASHWINDOW T) + (GIVE.TTY.PROCESS T) (EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE " is not the newest version. Really copy? " ] @@ -2326,25 +2337,25 @@ (MOVD? 'NILL 'TEDIT.FILEDATE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2658 23637 (COMPAREDIRECTORIES 2668 . 8003) (COMPAREDIRECTORIES.INFOS 8005 . 11234) ( -COMPAREDIRECTORIES.CANDIDATES 11236 . 14621) (CDENTRIES.SELECT 14623 . 19525) ( -COMPAREDIRECTORIES.INFOS.TYPE 19527 . 20871) (MATCHNAME 20873 . 21553) (CD.INSURECDVALUE 21555 . 23169 -) (CD.UPDATEWIDTHS 23171 . 23635)) (23638 34343 (CDFILES 23648 . 29745) (CDFILES.MATCH 29747 . 31372) -(CDFILES.PATS 31374 . 34341)) (34344 52362 (CDPRINT 34354 . 36871) (CDPRINT.HEADER 36873 . 37770) ( -CDPRINT.LINE 37772 . 41201) (CDPRINT.MAXWIDTHS 41203 . 45318) (CDPRINT.COLHEADERS 45320 . 46605) ( -CDPRINT.COLUMNS 46607 . 51727) (CDTEDIT 51729 . 52360)) (52363 61484 (CDMAP 52373 . 53805) (CDENTRY -53807 . 54116) (CDSUBSET 54118 . 55557) (CDMERGE 55559 . 59543) (CDMERGE.COMMON 59545 . 60860) ( -CD.SORT 60862 . 61482)) (61485 69023 (BINCOMP 61495 . 65784) (EOLTYPE 65786 . 68348) (EOLTYPE.SHOW -68350 . 69021)) (69551 82078 (FIND-UNCOMPILED-FILES 69561 . 73204) (FIND-UNSOURCED-FILES 73206 . 75590 -) (FIND-SOURCE-FILES 75592 . 77330) (FIND-COMPILED-FILES 77332 . 79209) (FIND-UNLOADED-FILES 79211 . -80064) (FIND-LOADED-FILES 80066 . 80494) (FIND-MULTICOMPILED-FILES 80496 . 82076)) (82079 90510 ( -CREATED-AS 82089 . 86886) (SOURCE-FOR-COMPILED-P 86888 . 89815) (COMPILE-SOURCE-DATE-DIFF 89817 . -90508)) (90511 101274 (FIX-DIRECTORY-DATES 90521 . 93971) (FIX-EQUIV-DATES 93973 . 95498) ( -COPY-COMPARED-FILES 95500 . 97321) (COPY-MISSING-FILES 97323 . 99480) (COMPILED-ON-SAME-SOURCE 99482 - . 101272)) (101468 109346 (CDBROWSER 101478 . 105445) (CDBROWSER.STRINGS 105447 . 109344)) (109508 -111244 (CD.TABLEITEM 109518 . 109738) (CD.TABLEITEM.PRINTFN 109740 . 109939) (CD.TABLEITEM.COPYFN -109941 . 110999) (CDTABLEBROWSER.HEADING.REPAINTFN 111001 . 111242)) (111245 138359 ( -CDTABLEBROWSER.WHENSELECTEDFN 111255 . 111723) (CD.COMMANDSELECTEDFN 111725 . 117898) (CD-MENUFN -117900 . 124377) (CD-COMPARE-FILES 124379 . 127906) (CDBROWSER-COPY 127908 . 133233) ( -CDBROWSER-DELETE-FILE 133235 . 137838) (CD-SWAPDIRS 137840 . 138357))))) + (FILEMAP (NIL (2683 23662 (COMPAREDIRECTORIES 2693 . 8028) (COMPAREDIRECTORIES.INFOS 8030 . 11259) ( +COMPAREDIRECTORIES.CANDIDATES 11261 . 14646) (CDENTRIES.SELECT 14648 . 19550) ( +COMPAREDIRECTORIES.INFOS.TYPE 19552 . 20896) (MATCHNAME 20898 . 21578) (CD.INSURECDVALUE 21580 . 23194 +) (CD.UPDATEWIDTHS 23196 . 23660)) (23663 34971 (CDFILES 23673 . 29770) (CDFILES.MATCH 29772 . 31782) +(CDFILES.PATS 31784 . 34969)) (34972 52990 (CDPRINT 34982 . 37499) (CDPRINT.HEADER 37501 . 38398) ( +CDPRINT.LINE 38400 . 41829) (CDPRINT.MAXWIDTHS 41831 . 45946) (CDPRINT.COLHEADERS 45948 . 47233) ( +CDPRINT.COLUMNS 47235 . 52355) (CDTEDIT 52357 . 52988)) (52991 62112 (CDMAP 53001 . 54433) (CDENTRY +54435 . 54744) (CDSUBSET 54746 . 56185) (CDMERGE 56187 . 60171) (CDMERGE.COMMON 60173 . 61488) ( +CD.SORT 61490 . 62110)) (62113 69651 (BINCOMP 62123 . 66412) (EOLTYPE 66414 . 68976) (EOLTYPE.SHOW +68978 . 69649)) (70179 82706 (FIND-UNCOMPILED-FILES 70189 . 73832) (FIND-UNSOURCED-FILES 73834 . 76218 +) (FIND-SOURCE-FILES 76220 . 77958) (FIND-COMPILED-FILES 77960 . 79837) (FIND-UNLOADED-FILES 79839 . +80692) (FIND-LOADED-FILES 80694 . 81122) (FIND-MULTICOMPILED-FILES 81124 . 82704)) (82707 91138 ( +CREATED-AS 82717 . 87514) (SOURCE-FOR-COMPILED-P 87516 . 90443) (COMPILE-SOURCE-DATE-DIFF 90445 . +91136)) (91139 101902 (FIX-DIRECTORY-DATES 91149 . 94599) (FIX-EQUIV-DATES 94601 . 96126) ( +COPY-COMPARED-FILES 96128 . 97949) (COPY-MISSING-FILES 97951 . 100108) (COMPILED-ON-SAME-SOURCE 100110 + . 101900)) (102096 109974 (CDBROWSER 102106 . 106073) (CDBROWSER.STRINGS 106075 . 109972)) (110136 +111872 (CD.TABLEITEM 110146 . 110366) (CD.TABLEITEM.PRINTFN 110368 . 110567) (CD.TABLEITEM.COPYFN +110569 . 111627) (CDTABLEBROWSER.HEADING.REPAINTFN 111629 . 111870)) (111873 139210 ( +CDTABLEBROWSER.WHENSELECTEDFN 111883 . 112351) (CD.COMMANDSELECTEDFN 112353 . 118526) (CD-MENUFN +118528 . 125005) (CD-COMPARE-FILES 125007 . 128534) (CDBROWSER-COPY 128536 . 134084) ( +CDBROWSER-DELETE-FILE 134086 . 138689) (CD-SWAPDIRS 138691 . 139208))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 996c3950..341d2592 100644 Binary files a/lispusers/COMPAREDIRECTORIES.LCOM and b/lispusers/COMPAREDIRECTORIES.LCOM differ diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 035519af..1ce3bdc3 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "16-Mar-2026 12:05:55" {WMEDLEY}GITFNS.;578 134065 +(FILECREATED "29-Apr-2026 12:51:53" {MEDLEY}GITFNS.;592 137200 :EDIT-BY rmk - :CHANGES-TO (FNS GIT-BRANCH-WHENSELECTEDFN PRC-COMMAND) + :CHANGES-TO (FNS GIT-GWC-COMMAND) + (COMMANDS gwc) + (VARS GITFNSCOMS) - :PREVIOUS-DATE " 2-Mar-2026 14:00:13" {WMEDLEY}GITFNS.;576) + :PREVIOUS-DATE "29-Apr-2026 09:00:33" {MEDLEY}GITFNS.;588) (PRETTYCOMPRINT GITFNSCOMS) @@ -51,7 +53,7 @@ (INITVARS (GIT-MERGE-COMPARES T) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (COMMANDS gwc bbc prc cob b? cdg cdw) - (FNS PRC-COMMAND) + (FNS PRC-COMMAND GIT-GWC-COMMAND) (* ;; "") @@ -60,7 +62,7 @@ (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) (FNS TOGIT FROMGIT) - (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) + (FNS WORKINGSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) (* ;; "") @@ -169,6 +171,9 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 29-Apr-2026 09:00 by rmk") + (* ; "Edited 17-Apr-2026 12:33 by rmk") + (* ; "Edited 15-Apr-2026 16:33 by rmk") (* ; "Edited 25-Feb-2026 23:25 by rmk") (* ; "Edited 25-Oct-2025 16:53 by rmk") (* ; "Edited 22-Oct-2025 12:45 by rmk") @@ -275,7 +280,8 @@ "for " PROJECTNAME] (SETQ PROJECT (create GIT-PROJECT PROJECTNAME ← PROJECTNAME - GITHOST ← (PACK* "{" (PSEUDOHOST PROJECTNAME CLONEPATH) + GITHOST ← (PACK* "{" (PSEUDOHOST (CONCAT "G" PROJECTNAME) + CLONEPATH) "}") WHOST ← (AND WORKINGPATH (PACK* "{" (PSEUDOHOST (CONCAT "W" PROJECTNAME) @@ -439,18 +445,7 @@ (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") - - (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS))) - PROJECT) - (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))) +(DEFCOMMAND gwc (SUBDIR . OTHERS) (GIT-GWC-COMMAND SUBDIR OTHERS)) (DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT) @@ -616,6 +611,32 @@ PROJECT)) else (CONCAT "No open " (OR REMOTEBRANCH "") " pull requests"]) + +(GIT-GWC-COMMAND + [LAMBDA (SUBDIR OTHERS) (* ; "Edited 29-Apr-2026 12:51 by rmk") + + (* ;; "Compares the specified local git-medley subdirectories against my working Medley. The SUBDIRS are the arguments up to one that looks like a project, which may be followed by - and some excluded files") + + (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS))) + EXCLUDEDFILES PROJECT) + (SETQ SUBDIRS (for STAIL on SUBDIRS unless (CL:WHEN (AND (NULL PROJECT) + (SETQ PROJECT (GIT-GET-PROJECT + (CAR STAIL) + NIL T))) + (CL:UNLESS (EQ '- (CADR STAIL)) + (RETURN $$VAL)) + T) collect (CL:WHEN (EQ '- (CAR STAIL)) + (SETQ EXCLUDEDFILES + (CDR STAIL)) + (RETURN $$VAL)) + (CAR STAIL))) + (CL:UNLESS PROJECT + (SETQ PROJECT (GIT-GET-PROJECT PROJECT))) + (if (AND (fetch GITHOST of PROJECT) + (fetch WHOST of PROJECT)) + then (GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL EXCLUDEDFILES NIL T PROJECT) + else (PRINTOUT T "gwc requires " (fetch PROJECTNAME of PROJECT) + " to have both git and working directories" T T]) ) @@ -727,7 +748,7 @@ ) (DEFINEQ -(MYMEDLEYSUBDIR +(WORKINGSUBDIR [LAMBDA (SUBDIR STAR PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk") (* ; "Edited 7-May-2022 23:15 by rmk") (UNSLASHIT (PACK* (PACKFILENAME 'HOST (FETCH WHOST OF PROJECT) @@ -1398,13 +1419,12 @@ " branches"]) (GIT-BRANCH-MENU - [LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 1-May-2024 14:36 by rmk") + [LAMBDA (BRANCHES TITLE) (* ; "Edited 18-Apr-2026 21:36 by rmk") + (* ; "Edited 1-May-2024 14:36 by rmk") (* ; "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")) @@ -1950,6 +1970,8 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 29-Apr-2026 08:46 by rmk") + (* ;; "Edited 28-Oct-2025 14:00 by rmk") (* ;; "Edited 25-Oct-2025 23:32 by rmk") @@ -1960,18 +1982,12 @@ (* ;; "Edited 26-Sep-2023 22:41 by rmk") - (* ;; "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") (* ;; "Edited 17-May-2022 17:39 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.") @@ -1991,7 +2007,8 @@ (LET ((SUBDIRSTRING (if (EQ SUBDIRS 'all) then (SETQ SUBDIRS (ALLSUBDIRS PROJECT)) "ALL subdirectories" - else SUBDIRS))) + else SUBDIRS)) + (EXCLUSIONS)) (for SUBDIR TITLE CDVAL (WPROJ ← (CONCAT "Working " (L-CASE (fetch PROJECTNAME of PROJECT) T))) (NENTRIES ← 0) @@ -1999,11 +2016,12 @@ 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) + (SETQ CDVAL (COMPAREDIRECTORIES (WORKINGSUBDIR SUBDIR T PROJECT) (GITSUBDIR SUBDIR T PROJECT) (OR SELECT '(> < ~= -* *-)) '(*.* *>*.* .* *>.*) - (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + (for E DPOS in (APPEND (MKLIST EXCLUDEDFILES) + (GIT-GET-PROJECT PROJECT 'EXCLUSIONS)) collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E 'DIRECTORY) 1 NIL T T FILEDIRCASEARRAY)) @@ -2216,7 +2234,7 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:30 by rmk") (* ; "Edited 25-Oct-2025 23:44 by rmk") (* ; "Edited 21-Sep-2022 21:34 by rmk") (* ; "Edited 22-May-2022 19:13 by rmk") @@ -2225,9 +2243,32 @@ (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") - (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW)) + (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA)) (SELECTQ (OR (CADDR MENUITEM) (CAR MENUITEM)) + (Delete% -> (FLASHWINDOW PWINDOW) + (GIVE.TTY.PROCESS PWINDOW) + (CL:WHEN [OR (EQ KEY 'MIDDLE) + (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "] + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T))) + (|Delete ALL <-| + (FLASHWINDOW PWINDOW) + (GIVE.TTY.PROCESS PWINDOW) + (if (NAMEFIELD LABEL1 T) + then (CL:WHEN [OR (EQ KEY 'MIDDLE) + (EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of " + (NAMEFIELD LABEL1 T) + " ? "] + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T)) + else (PRINTOUT T "Nothing to delete"))) + (Delete% BOTH (FLASHWINDOW PWINDOW) + (GIVE.TTY.PROCESS PWINDOW) + (CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT + "Delete all Medley and git versions of " + (NAMEFIELD LABEL1 T) + " ? "))) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL T) + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL T T))) (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM))) (SHOULDNT]) @@ -2429,33 +2470,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4197 21075 (GIT-CLONEP 4207 . 5638) (GIT-INIT 5640 . 6270) (GIT-MAKE-PROJECT 6272 . -14129) (GIT-GET-PROJECT 14131 . 16056) (GIT-PUT-PROJECT-FIELD 16058 . 17699) (GIT-PROJECT-PATH 17701 - . 18745) (FIND-ANCESTOR-DIRECTORY 18747 . 19098) (GIT-FIND-CLONE 19100 . 20183) (GIT-MAINBRANCH 20185 - . 20580) (GIT-MAINBRANCH? 20582 . 21073)) (26538 31832 (PRC-COMMAND 26548 . 31830)) (31888 34676 ( -ALLSUBDIRS 31898 . 33184) (MEDLEYSUBDIRS 33186 . 33879) (GITSUBDIRS 33881 . 34674)) (34677 37082 ( -TOGIT 34687 . 36095) (FROMGIT 36097 . 37080)) (37083 40093 (MYMEDLEYSUBDIR 37093 . 37549) (GITSUBDIR -37551 . 37994) (STRIPDIR 37996 . 38374) (STRIPHOST 38376 . 38616) (STRIPNAME 38618 . 39371) ( -STRIPWHERE 39373 . 40091)) (40094 42329 (GFILE4MFILE 40104 . 40800) (MFILE4GFILE 40802 . 41371) ( -GIT-REPO-FILENAME 41373 . 42327)) (42378 52635 (GIT-COMMIT 42388 . 43214) (GIT-PUSH 43216 . 43976) ( -GIT-PULL 43978 . 44730) (GIT-APPROVAL 44732 . 45081) (GIT-GET-FILE 45083 . 46998) (GIT-FILE-EXISTS? -47000 . 47274) (GIT-REMOTE-UPDATE 47276 . 48111) (GIT-REMOTE-ADD 48113 . 48420) (GIT-FILE-DATE 48422 - . 49469) (GIT-FILE-HISTORY 49471 . 51405) (GIT-PRINT-FILE-HISTORY 51407 . 52459) (GIT-FETCH 52461 . -52633)) (52665 64617 (GIT-BRANCH-DIFF 52675 . 59564) (GIT-COMMIT-DIFFS 59566 . 60457) ( -GIT-BRANCH-RELATIONS 60459 . 64143) (GIT-MODIFIED 64145 . 64615)) (64662 83597 (GIT-BRANCH-NUM 64672 - . 65245) (GIT-CHECKOUT 65247 . 66533) (GIT-WHICH-BRANCH 66535 . 66942) (GIT-MAKE-BRANCH 66944 . 69523 -) (GIT-BRANCHES 69525 . 72122) (GIT-BRANCH-EXISTS? 72124 . 72995) (GIT-PICK-BRANCH 72997 . 73487) ( -GIT-BRANCH-MENU 73489 . 74378) (GIT-BRANCH-WHENSELECTEDFN 74380 . 76087) (GIT-PULL-REQUESTS 76089 . -79974) (GIT-SHORT-BRANCH-NAME 79976 . 80267) (GIT-LONG-NAME 80269 . 80586) (GIT-PRC-BRANCHES 80588 . -83595)) (83627 88381 (GIT-MY-CURRENT-BRANCH 83637 . 84007) (GIT-MY-BRANCHP 84009 . 84627) ( -GIT-MY-NEXT-BRANCH 84629 . 86429) (GIT-MY-BRANCHES 86431 . 88379)) (88427 92511 (GIT-ADD-WORKTREE -88437 . 90044) (GIT-REMOVE-WORKTREE 90046 . 90978) (GIT-LIST-WORKTREES 90980 . 91791) (WORKTREEDIR -91793 . 92509)) (92559 125597 (GIT-GET-DIFFERENT-FILES 92569 . 99477) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 99479 . 107118) (GIT-WORKING-COMPARE-DIRECTORIES 107120 . 112922) ( -GIT-COMPARE-WORKTREE 112924 . 116902) (GITCDOBJBUTTONFN 116904 . 121402) (GIT-CD-LABELFN 121404 . -122490) (GIT-CD-MENUFN 122492 . 123578) (GIT-WORKING-COMPARE-FILES 123580 . 124200) ( -GIT-BRANCHES-COMPARE-FILES 124202 . 125366) (GIT-PR-COMPARE 125368 . 125595)) (125667 133998 (CDGITDIR - 125677 . 126364) (GIT-COMMAND 126366 . 127924) (GITORIGIN 127926 . 128623) (GIT-INITIALS 128625 . -128929) (GIT-COMMAND-TO-FILE 128931 . 132416) (GIT-RESULT-TO-LINES 132418 . 133331) (STRIPLOCAL 133333 - . 133996))))) + (FILEMAP (NIL (4257 21537 (GIT-CLONEP 4267 . 5698) (GIT-INIT 5700 . 6330) (GIT-MAKE-PROJECT 6332 . +14591) (GIT-GET-PROJECT 14593 . 16518) (GIT-PUT-PROJECT-FIELD 16520 . 18161) (GIT-PROJECT-PATH 18163 + . 19207) (FIND-ANCESTOR-DIRECTORY 19209 . 19560) (GIT-FIND-CLONE 19562 . 20645) (GIT-MAINBRANCH 20647 + . 21042) (GIT-MAINBRANCH? 21044 . 21535)) (26309 33483 (PRC-COMMAND 26319 . 31601) (GIT-GWC-COMMAND +31603 . 33481)) (33539 36327 (ALLSUBDIRS 33549 . 34835) (MEDLEYSUBDIRS 34837 . 35530) (GITSUBDIRS +35532 . 36325)) (36328 38733 (TOGIT 36338 . 37746) (FROMGIT 37748 . 38731)) (38734 41743 ( +WORKINGSUBDIR 38744 . 39199) (GITSUBDIR 39201 . 39644) (STRIPDIR 39646 . 40024) (STRIPHOST 40026 . +40266) (STRIPNAME 40268 . 41021) (STRIPWHERE 41023 . 41741)) (41744 43979 (GFILE4MFILE 41754 . 42450) +(MFILE4GFILE 42452 . 43021) (GIT-REPO-FILENAME 43023 . 43977)) (44028 54285 (GIT-COMMIT 44038 . 44864) + (GIT-PUSH 44866 . 45626) (GIT-PULL 45628 . 46380) (GIT-APPROVAL 46382 . 46731) (GIT-GET-FILE 46733 . +48648) (GIT-FILE-EXISTS? 48650 . 48924) (GIT-REMOTE-UPDATE 48926 . 49761) (GIT-REMOTE-ADD 49763 . +50070) (GIT-FILE-DATE 50072 . 51119) (GIT-FILE-HISTORY 51121 . 53055) (GIT-PRINT-FILE-HISTORY 53057 . +54109) (GIT-FETCH 54111 . 54283)) (54315 66267 (GIT-BRANCH-DIFF 54325 . 61214) (GIT-COMMIT-DIFFS 61216 + . 62107) (GIT-BRANCH-RELATIONS 62109 . 65793) (GIT-MODIFIED 65795 . 66265)) (66312 85259 ( +GIT-BRANCH-NUM 66322 . 66895) (GIT-CHECKOUT 66897 . 68183) (GIT-WHICH-BRANCH 68185 . 68592) ( +GIT-MAKE-BRANCH 68594 . 71173) (GIT-BRANCHES 71175 . 73772) (GIT-BRANCH-EXISTS? 73774 . 74645) ( +GIT-PICK-BRANCH 74647 . 75137) (GIT-BRANCH-MENU 75139 . 76040) (GIT-BRANCH-WHENSELECTEDFN 76042 . +77749) (GIT-PULL-REQUESTS 77751 . 81636) (GIT-SHORT-BRANCH-NAME 81638 . 81929) (GIT-LONG-NAME 81931 . +82248) (GIT-PRC-BRANCHES 82250 . 85257)) (85289 90043 (GIT-MY-CURRENT-BRANCH 85299 . 85669) ( +GIT-MY-BRANCHP 85671 . 86289) (GIT-MY-NEXT-BRANCH 86291 . 88091) (GIT-MY-BRANCHES 88093 . 90041)) ( +90089 94173 (GIT-ADD-WORKTREE 90099 . 91706) (GIT-REMOVE-WORKTREE 91708 . 92640) (GIT-LIST-WORKTREES +92642 . 93453) (WORKTREEDIR 93455 . 94171)) (94221 128732 (GIT-GET-DIFFERENT-FILES 94231 . 101139) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 101141 . 108780) (GIT-WORKING-COMPARE-DIRECTORIES 108782 . 114597) ( +GIT-COMPARE-WORKTREE 114599 . 118577) (GITCDOBJBUTTONFN 118579 . 123077) (GIT-CD-LABELFN 123079 . +124165) (GIT-CD-MENUFN 124167 . 126713) (GIT-WORKING-COMPARE-FILES 126715 . 127335) ( +GIT-BRANCHES-COMPARE-FILES 127337 . 128501) (GIT-PR-COMPARE 128503 . 128730)) (128802 137133 (CDGITDIR + 128812 . 129499) (GIT-COMMAND 129501 . 131059) (GITORIGIN 131061 . 131758) (GIT-INITIALS 131760 . +132064) (GIT-COMMAND-TO-FILE 132066 . 135551) (GIT-RESULT-TO-LINES 135553 . 136466) (STRIPLOCAL 136468 + . 137131))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 03bd1bb9..fa32aa44 100644 Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT index 0aa747b4..86b5f8c1 100644 Binary files a/lispusers/GITFNS.TEDIT and b/lispusers/GITFNS.TEDIT differ