Skip to content

Extend GITFNS/COMPAREDIRECTORIES so that the See and Compare commands work after files have been rearranged #2331

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Extend GITFNS/COMPAREDIRECTORIES so that the See and Compare commands work after files have been rearranged #2331

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c413d15
COMPAREDIRECTORIES and GITFNS keep information for seeing and compari…
rmkaplan Oct 28, 2025
b589a3f
Lost an edit
rmkaplan Oct 29, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
192 changes: 120 additions & 72 deletions lispusers/COMPAREDIRECTORIES
View file
Open in desktop

Large diffs are not rendered by default.

Binary file modified lispusers/COMPAREDIRECTORIES.LCOM
View file
Open in desktop
Binary file not shown.
19 changes: 11 additions & 8 deletions lispusers/EXAMINEDEFS
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "25-Oct-2025 10:24:30" {WMEDLEY}<lispusers>EXAMINEDEFS.;59 17123
(FILECREATED "28-Oct-2025 14:24:17" {WMEDLEY}<lispusers>EXAMINEDEFS.;60 17313

:EDIT-BY rmk

:CHANGES-TO (FNS EXAMINEDEFS)
:CHANGES-TO (FNS EXAMINEFILES)

:PREVIOUS-DATE " 6-Apr-2025 23:54:50" {WMEDLEY}<lispusers>EXAMINEDEFS.;57)
:PREVIOUS-DATE "25-Oct-2025 10:24:30" {WMEDLEY}<lispusers>EXAMINEDEFS.;59)


(PRETTYCOMPRINT EXAMINEDEFSCOMS)
Expand Down Expand Up @@ -173,7 +173,8 @@
(EDITE DEF2])

(EXAMINEFILES
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk")
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 28-Oct-2025 14:23 by rmk")
(* ; "Edited 19-Jul-2023 13:48 by rmk")
(* ; "Edited 1-Feb-2022 23:15 by rmk")
(* ; "Edited 25-Jan-2022 10:08 by rmk")
(* ; "Edited 2-Jan-2022 23:15 by rmk")
Expand All @@ -183,15 +184,17 @@

(CL:UNLESS REGION
(SETQ REGION (GETREGION)))
(LIST (AND (INFILEP FILE1)
(LIST (AND (OR (STREAMP FILE1)
(INFILEP FILE1))
(TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
REGION
'RIGHT
'TOP
`(,REGION 0.5)
(FETCH (REGION TOP) OF REGION))
NIL TITLE1))
(AND (INFILEP FILE2)
(AND (OR (STREAMP FILE2)
(INFILEP FILE2))
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
REGION
'LEFT
Expand Down Expand Up @@ -284,6 +287,6 @@
(FILESLOAD (SYSLOAD)
COMPARETEXT VERSIONDEFS)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (665 16892 (EXAMINEDEFS 675 . 11290) (EXAMINEFILES 11292 . 12774) (TEDITDEF 12776 .
15098) (EXVV 15100 . 16890)))))
(FILEMAP (NIL (666 17082 (EXAMINEDEFS 676 . 11291) (EXAMINEFILES 11293 . 12964) (TEDITDEF 12966 .
15288) (EXVV 15290 . 17080)))))
STOP
Binary file modified lispusers/EXAMINEDEFS.LCOM
View file
Open in desktop
Binary file not shown.
156 changes: 49 additions & 107 deletions lispusers/GITFNS
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "26-Oct-2025 00:01:44" {WMEDLEY}<lispusers>GITFNS.;565 135222
(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}<lispusers>GITFNS.;569 131593

:EDIT-BY rmk

:CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-CD-MENUFN GIT-MAKE-PROJECT GIT-CLONEP)
:CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES)

:PREVIOUS-DATE "25-Oct-2025 10:37:40" {WMEDLEY}<lispusers>GITFNS.;562)
:PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}<lispusers>GITFNS.;568)


(PRETTYCOMPRINT GITFNSCOMS)
Expand Down Expand Up @@ -59,7 +59,7 @@
(* ;; "File correspondents")

(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
(FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
(FNS TOGIT FROMGIT)
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)

Expand Down Expand Up @@ -720,46 +720,6 @@
(CONCAT GF " cannot be copied"))
T)
DEST])

(GIT-DELETE-FILE
[LAMBDA (FILE PROJECT) (* ; "Edited 8-May-2022 09:27 by rmk")
(* ; "Edited 18-Jan-2022 23:07 by rmk")
(* ; "Edited 19-Dec-2021 16:11 by rmk")
(* ; "Edited 16-Dec-2021 13:00 by rmk")

(* ;; "This deletes a file in the local checkout git directory {UNIX}... FILE has to already be a full file name, for safety.")

(* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ")

(* ;; "We could make this undoable by copying it to deleted/, but git also can restore.")

(GIT-CLONEP FILE NIL T)
(DELFILE FILE])

(MYMEDLEY-DELETE-FILES
[LAMBDA (FILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk")
(* ; "Edited 8-May-2022 23:31 by rmk")

(* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.")

(* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.")

(SETQ FILE (CONTRACT.PH FILE (FETCH WHOST OF PROJECT)))
(CL:WHEN (EQ (FILENAMEFIELD (FETCH WHOST OF PROJECT)
'HOST)
(FILENAMEFIELD FILE 'HOST))
(FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE)))
COLLECT

(* ;;
 "Delete the earlier ones first, if it goes bad, you don't want them to persist")

(CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>"
(FILENAMEFIELD F
'DIRECTORY))
'BODY F))
(ERROR "Could not delete " F))
F))])
)
(DEFINEQ

Expand Down Expand Up @@ -1846,7 +1806,8 @@
(LIST DIR1 DIR2 MAPPINGS))])

(GIT-BRANCHES-COMPARE-DIRECTORIES
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 2-Oct-2025 23:12 by rmk")
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 28-Oct-2025 14:01 by rmk")
(* ; "Edited 2-Oct-2025 23:12 by rmk")
(* ; "Edited 12-Jun-2024 22:52 by mth")
(* ; "Edited 10-Jun-2024 18:42 by mth")
(* ; "Edited 1-May-2024 14:58 by rmk")
Expand Down Expand Up @@ -1938,8 +1899,10 @@
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE))
" files")
(LIST SHORT1 SHORT2)
`(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
,PROJECT)
`((LABELFN . GIT-CD-LABELFN)
(BRANCH1 ,@BRANCH1)
(BRANCH2 ,@BRANCH2)
(PROJECT ,@PROJECT))
GIT-CDBROWSER-SEPARATE-DIRECTIONS
`(Compare See))
(SETQ NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE)))
Expand All @@ -1952,6 +1915,8 @@
(GIT-WORKING-COMPARE-DIRECTORIES
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)

(* ;; "Edited 28-Oct-2025 14:00 by rmk")

(* ;; "Edited 25-Oct-2025 23:32 by rmk")

(* ;; "Edited 29-Apr-2025 15:14 by rmk")
Expand Down Expand Up @@ -2031,9 +1996,12 @@
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
" files"))
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
`(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
GIT-CD-LABELFN PROJECT ,PROJECT)
[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)
Expand Down Expand Up @@ -2213,43 +2181,18 @@
(OR LABEL2 FILE2])

(GIT-CD-MENUFN
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 25-Oct-2025 23:44 by rmk")
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 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")
(* ; "Edited 8-May-2022 09:26 by rmk")
(* ; "Edited 10-Dec-2021 08:52 by rmk")

(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom")

(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY))
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW))
(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 " ? "]
(GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT))
(TB.DELETE.ITEM CDBROWSER TBITEM)))
(|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)
" ? "]
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
(TB.DELETE.ITEM CDBROWSER TBITEM))
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)
" ? ")))
(GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT))
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
(TB.DELETE.ITEM CDBROWSER TBITEM)))
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
(SHOULDNT])

Expand Down Expand Up @@ -2451,33 +2394,32 @@

(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4243 21049 (GIT-CLONEP 4253 . 5684) (GIT-INIT 5686 . 6316) (GIT-MAKE-PROJECT 6318 .
14107) (GIT-GET-PROJECT 14109 . 16034) (GIT-PUT-PROJECT-FIELD 16036 . 17677) (GIT-PROJECT-PATH 17679
. 18723) (FIND-ANCESTOR-DIRECTORY 18725 . 19074) (GIT-FIND-CLONE 19076 . 20157) (GIT-MAINBRANCH 20159
. 20554) (GIT-MAINBRANCH? 20556 . 21047)) (26512 31441 (PRC-COMMAND 26522 . 31439)) (31497 34285 (
ALLSUBDIRS 31507 . 32793) (MEDLEYSUBDIRS 32795 . 33488) (GITSUBDIRS 33490 . 34283)) (34286 39076 (
TOGIT 34296 . 35702) (FROMGIT 35704 . 36685) (GIT-DELETE-FILE 36687 . 37533) (MYMEDLEY-DELETE-FILES
37535 . 39074)) (39077 42080 (MYMEDLEYSUBDIR 39087 . 39543) (GITSUBDIR 39545 . 39988) (STRIPDIR 39990
. 40361) (STRIPHOST 40363 . 40603) (STRIPNAME 40605 . 41358) (STRIPWHERE 41360 . 42078)) (42081 44316
(GFILE4MFILE 42091 . 42787) (MFILE4GFILE 42789 . 43358) (GIT-REPO-FILENAME 43360 . 44314)) (44365
54620 (GIT-COMMIT 44375 . 45201) (GIT-PUSH 45203 . 45963) (GIT-PULL 45965 . 46717) (GIT-APPROVAL 46719
. 47068) (GIT-GET-FILE 47070 . 48985) (GIT-FILE-EXISTS? 48987 . 49261) (GIT-REMOTE-UPDATE 49263 .
50098) (GIT-REMOTE-ADD 50100 . 50407) (GIT-FILE-DATE 50409 . 51456) (GIT-FILE-HISTORY 51458 . 53392) (
GIT-PRINT-FILE-HISTORY 53394 . 54444) (GIT-FETCH 54446 . 54618)) (54650 66130 (GIT-BRANCH-DIFF 54660
. 61549) (GIT-COMMIT-DIFFS 61551 . 62442) (GIT-BRANCH-RELATIONS 62444 . 66128)) (66175 84914 (
GIT-BRANCH-NUM 66185 . 66758) (GIT-CHECKOUT 66760 . 68046) (GIT-WHICH-BRANCH 68048 . 68455) (
GIT-MAKE-BRANCH 68457 . 71036) (GIT-BRANCHES 71038 . 73633) (GIT-BRANCH-EXISTS? 73635 . 74506) (
GIT-PICK-BRANCH 74508 . 74998) (GIT-BRANCH-MENU 75000 . 75881) (GIT-BRANCH-WHENSELECTEDFN 75883 .
77422) (GIT-PULL-REQUESTS 77424 . 81295) (GIT-SHORT-BRANCH-NAME 81297 . 81588) (GIT-LONG-NAME 81590 .
81907) (GIT-PRC-BRANCHES 81909 . 84912)) (84944 88392 (GIT-MY-CURRENT-BRANCH 84954 . 85324) (
GIT-MY-BRANCHP 85326 . 85944) (GIT-MY-NEXT-BRANCH 85946 . 86440) (GIT-MY-BRANCHES 86442 . 88390)) (
88438 92513 (GIT-ADD-WORKTREE 88448 . 90055) (GIT-REMOVE-WORKTREE 90057 . 90987) (GIT-LIST-WORKTREES
90989 . 91793) (WORKTREEDIR 91795 . 92511)) (92561 126762 (GIT-GET-DIFFERENT-FILES 92571 . 99479) (
GIT-BRANCHES-COMPARE-DIRECTORIES 99481 . 106920) (GIT-WORKING-COMPARE-DIRECTORIES 106922 . 112559) (
GIT-COMPARE-WORKTREE 112561 . 116539) (GITCDOBJBUTTONFN 116541 . 121031) (GIT-CD-LABELFN 121033 .
122115) (GIT-CD-MENUFN 122117 . 124743) (GIT-WORKING-COMPARE-FILES 124745 . 125365) (
GIT-BRANCHES-COMPARE-FILES 125367 . 126531) (GIT-PR-COMPARE 126533 . 126760)) (126832 135155 (CDGITDIR
126842 . 127529) (GIT-COMMAND 127531 . 129089) (GITORIGIN 129091 . 129788) (GIT-INITIALS 129790 .
130094) (GIT-COMMAND-TO-FILE 130096 . 133581) (GIT-RESULT-TO-LINES 133583 . 134488) (STRIPLOCAL 134490
. 135153)))))
(FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 .
14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632
. 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112
. 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 (
ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 (
TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR
37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) (
STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) (
GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) (
GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS?
46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973
. 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 .
52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) (
GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324
. 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197
) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) (
GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME
78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 (
GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004)
(GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE
87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 (
GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) (
GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) (
GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) (
GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) (
GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 .
125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 .
129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524)))))
STOP
Binary file modified lispusers/GITFNS.LCOM
View file
Open in desktop
Binary file not shown.