Rmk47: TEDIT, GITFNS, COREIO (#791)
* COMPARETEXT: Inverted nodes stay inverted when scrolled * COMPARESOURCES: Remove unused stub for browsing in TEDIT window * COMPAREDIRECTORIES: Upgrade to new LISPFILETYPE, add CD-COMPARE-FILES CD-COMPARE-FILES interface to compare 2 given files, not whole directory * TEDIT: Show only file name, not stream address * COREIO: preserve STREAMPROPS on stream reopen * GITFNS: Various project and git-interface cleanups
This commit is contained in:
rmkaplan
GitHub
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-May-2022 20:28:46"
|
||||
{DSK}<users>kaplan>local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;218 123686
|
||||
(FILECREATED "25-May-2022 08:44:46"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;234 125334
|
||||
|
||||
:CHANGES-TO (FNS SOURCE-FOR-COMPILED-P)
|
||||
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Apr-2022 09:25:02"
|
||||
{DSK}<users>kaplan>local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;217)
|
||||
:PREVIOUS-DATE "24-May-2022 15:49:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;233)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -52,8 +52,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
TABLEBROWSER))
|
||||
(FNS CD.TABLEITEM CD.TABLEITEM.PRINTFN CD.TABLEITEM.COPYFN
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN)
|
||||
(FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CDBROWSER-COPY
|
||||
CDBROWSER-DELETE-FILE CD-SWAPDIRS)
|
||||
(FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CD-COMPARE-FILES
|
||||
CDBROWSER-COPY CDBROWSER-DELETE-FILE CD-SWAPDIRS)
|
||||
(VARS CDTABLEBROWSER.MENUITEMS)
|
||||
(FILES (SYSLOAD)
|
||||
COMPARESOURCES COMPARETEXT))))
|
||||
@@ -150,6 +150,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(COMPAREDIRECTORIES.INFOS
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE)
|
||||
|
||||
(* ;; "Edited 22-May-2022 14:17 by rmk")
|
||||
|
||||
(* ;; "Edited 29-Mar-2022 11:53 by rmk: Produces a list of CDINFOS with the match-name consed on to the front.")
|
||||
|
||||
(* ;; "Each entry is a list of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ")
|
||||
@@ -159,12 +161,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
COLLECT
|
||||
|
||||
(* ;; "GDATE/IDATE in case Y2K")
|
||||
(* ;
|
||||
"Is it a Lisp file? Get it's internal filecreated date. ")
|
||||
|
||||
(SETQ STREAM (OPENSTREAM FULLNAME 'INPUT)) (* ;
|
||||
"So all the GETFILEINFO's, FILEDATES, etc. don't have to do the directory searching.")
|
||||
(SETQ LDATE (OR (FILEDATE STREAM T)
|
||||
(FILEDATE STREAM)))
|
||||
(* ;
|
||||
"Is it a Lisp file? Get it's internal filecreated date. ")
|
||||
(CL:MULTIPLE-VALUE-SETQ (TYPE LDATE)
|
||||
(COMPAREDIRECTORIES.INFOS.TYPE STREAM))
|
||||
(PROG1 (LIST (MATCHNAME FULLNAME STARTPOS)
|
||||
(CREATE CDINFO
|
||||
FULLNAME _ (FULLNAME STREAM)
|
||||
@@ -174,7 +177,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
LDATE)))
|
||||
LENGTH _ (GETFILEINFO STREAM 'LENGTH)
|
||||
AUTHOR _ (GETFILEINFO STREAM 'AUTHOR)
|
||||
TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE STREAM LDATE)
|
||||
TYPE _ TYPE
|
||||
EOL _ (EOLTYPE STREAM)))
|
||||
(CLOSEF? STREAM))
|
||||
FINALLY
|
||||
@@ -319,18 +322,20 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
CDE])
|
||||
|
||||
(COMPAREDIRECTORIES.INFOS.TYPE
|
||||
[LAMBDA (FULLNAME LDATE) (* ; "Edited 25-Apr-2022 09:02 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 22-May-2022 14:27 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 09:02 by rmk")
|
||||
(* ; "Edited 4-Jan-2022 13:10 by rmk")
|
||||
(* ; "Edited 12-Dec-2021 22:50 by rmk")
|
||||
(LET [(EXT (FILENAMEFIELD FULLNAME 'EXTENSION]
|
||||
(IF LDATE
|
||||
THEN (CL:IF (MEMB EXT *COMPILED-EXTENSIONS*)
|
||||
'COMPILED
|
||||
'SOURCE)
|
||||
ELSEIF (PRINTFILETYPE FULLNAME)
|
||||
ELSE (CL:IF (MEMB EXT '(TXT TEXT SH MD C))
|
||||
'TEXT
|
||||
'OTHER)])
|
||||
(LET (TYPE DATE)
|
||||
(CL:MULTIPLE-VALUE-SETQ (TYPE DATE)
|
||||
(LISPFILETYPE FILE))
|
||||
(CL:UNLESS TYPE
|
||||
(SETQ TYPE (IF (PRINTFILETYPE FILE)
|
||||
ELSEIF (MEMB (FILENAMEFIELD FILE 'EXTENSION)
|
||||
'(TXT TEXT SH MD C))
|
||||
THEN 'TEXT
|
||||
ELSE 'OTHER)))
|
||||
(CL:VALUES TYPE DATE])
|
||||
|
||||
(MATCHNAME
|
||||
[LAMBDA (NAME STARTPOS) (* ; "Edited 24-Feb-2022 09:10 by rmk")
|
||||
@@ -1866,105 +1871,123 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||
|
||||
(* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
(* ;; "Edited 21-May-2022 21:59 by rmk")
|
||||
|
||||
(* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
(* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
|
||||
|
||||
(* ;; "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 CDENTRY LABEL1 LABLE2 FILE1 FILE2 WINDOW))
|
||||
(DECLARE (USEDFREE LABEL1 LABEL2 FILE1 FILE2 WINDOW TYPE))
|
||||
(SETQ MENUITEM (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM)))
|
||||
(CL:WHEN (MEMB MENUITEM '(Compare See See% right See% both See% left))
|
||||
(* ; "Close the previous ones")
|
||||
(CLOSEWITH.DOIT WINDOW))
|
||||
(LET
|
||||
(CHILDREN)
|
||||
(SETQ CHILDREN
|
||||
(SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN [SELECTQ TYPE
|
||||
(SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
|
||||
(RELCREATEREGION
|
||||
[FIXR (TIMES 0.75 (FETCH (REGION WIDTH)
|
||||
OF (WINDOWPROP WINDOW
|
||||
'REGION]
|
||||
200
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,WINDOW 0.125)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
20)
|
||||
NIL)))
|
||||
(COMPILED (FLASHWINDOW T)
|
||||
(PRIN3 "Cannot compare compiled files" T))
|
||||
((TEXT TEDIT OTHER)
|
||||
(* ;;
|
||||
"Works for TEDIT, but doesn't detect image object differences")
|
||||
|
||||
(LET ((COMPARETEXT.ALLCHUNKS))
|
||||
(DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS))
|
||||
(COMPARETEXT FILE1 FILE2 'LINE
|
||||
(RELCREATEPOSITION `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
20))
|
||||
(LIST LABEL1 LABEL2))))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(PRIN3 "Unable to compare, showing both" T)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP
|
||||
`(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL]
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1 (RELCREATEREGION 700 700 'RIGHT 'TOP
|
||||
`(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2 (RELCREATEREGION 700 700 'LEFT 'TOP
|
||||
`(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 (RELCREATEREGION
|
||||
1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(LET (CHILDREN)
|
||||
(SETQ CHILDREN (SELECTQ MENUITEM
|
||||
(Compare (IF (AND FILE1 FILE2)
|
||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE
|
||||
(WINDOWPROP WINDOW 'REGION))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "Only one file" T)))
|
||||
(See% left (IF FILE1
|
||||
THEN (TEDIT-SEE FILE1
|
||||
(RELCREATEREGION
|
||||
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
T)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL1))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
(See% right (IF FILE2
|
||||
THEN (TEDIT-SEE FILE2
|
||||
(RELCREATEREGION
|
||||
700 700 'LEFT 'TOP `(,WINDOW 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)
|
||||
NIL
|
||||
(CONCAT "SEE window for " LABEL2))
|
||||
ELSE (FLASHWINDOW T)
|
||||
(PRIN3 "No file to print" T)))
|
||||
((See See% both)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF (WINDOWPROP WINDOW 'REGION))
|
||||
-1)
|
||||
NIL)))
|
||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
||||
(|Delete ALL <-|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
||||
(|Delete ALL ->|
|
||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
||||
(SHOULDNT)))
|
||||
(CLOSEWITH CHILDREN WINDOW)
|
||||
(MOVEWITH CHILDREN WINDOW])
|
||||
|
||||
(CD-COMPARE-FILES
|
||||
[LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION) (* ; "Edited 22-May-2022 14:41 by rmk")
|
||||
(PROG NIL
|
||||
(SETQ FILE1 (OR (STREAMP FILE1)
|
||||
(INFILEP FILE1)))
|
||||
(SETQ FILE2 (OR (STREAMP FILE2)
|
||||
(INFILEP FILE2)))
|
||||
(CL:UNLESS TYPE
|
||||
(SETQ TYPE (COMPAREDIRECTORIES.INFOS.TYPE FILE1))
|
||||
(CL:UNLESS (EQ TYPE (COMPAREDIRECTORIES.INFOS.TYPE FILE2))
|
||||
(FLASHWINDOW T)
|
||||
(PRIN3 "Can't compare files of different types" T)
|
||||
(RETURN)))
|
||||
(RETURN (SELECTQ TYPE
|
||||
(SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2
|
||||
(AND PARENTREGION (RELCREATEREGION
|
||||
(FIXR (TIMES 0.75 (FETCH (REGION WIDTH)
|
||||
OF PARENTREGION)))
|
||||
200
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,PARENTREGION 0.125)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF PARENTREGION
|
||||
)
|
||||
20)
|
||||
NIL))))
|
||||
(COMPILED (FLASHWINDOW T)
|
||||
(PRIN3 "Cannot compare compiled files" T))
|
||||
((TEXT TEDIT OTHER)
|
||||
(* ;;
|
||||
"Works for TEDIT, but doesn't detect image object differences")
|
||||
|
||||
(LET ((COMPARETEXT.ALLCHUNKS))
|
||||
(DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS))
|
||||
(COMPARETEXT FILE1 FILE2 'LINE
|
||||
(AND PARENTREGION (RELCREATEPOSITION
|
||||
`(,PARENTREGION 0.5)
|
||||
(IPLUS (FETCH (REGION BOTTOM) OF
|
||||
PARENTREGION
|
||||
)
|
||||
20)))
|
||||
(LIST LABEL1 LABEL2))))
|
||||
(PROGN (FLASHWINDOW T)
|
||||
(PRIN3 "Unable to compare, showing both" T)
|
||||
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
|
||||
(AND PARENTREGION (RELCREATEREGION 1400 700 'LEFT 'TOP
|
||||
`(,PARENTREGION 0.5 -701)
|
||||
(IPLUS (FETCH (REGION BOTTOM)
|
||||
OF PARENTREGION)
|
||||
-1)
|
||||
NIL])
|
||||
|
||||
(CDBROWSER-COPY
|
||||
[LAMBDA (CDBROWSER TBITEM SOURCE) (* ; "Edited 25-Apr-2022 09:24 by rmk")
|
||||
[LAMBDA (CDBROWSER TBITEM SOURCE) (* ; "Edited 24-May-2022 15:49 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 09:24 by rmk")
|
||||
(* ; "Edited 5-Feb-2022 17:27 by rmk")
|
||||
(* ; "Edited 2-Feb-2022 22:18 by rmk")
|
||||
|
||||
@@ -2095,24 +2118,25 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
|
||||
2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2611 21960 (COMPAREDIRECTORIES 2621 . 7454) (COMPAREDIRECTORIES.INFOS 7456 . 10307) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10309 . 13694) (CDENTRIES.SELECT 13696 . 18471) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18473 . 19194) (MATCHNAME 19196 . 19876) (CD.INSURECDVALUE 19878 . 21492
|
||||
) (CD.UPDATEWIDTHS 21494 . 21958)) (21961 31630 (CDFILES 21971 . 27724) (CDFILES.MATCH 27726 . 29351)
|
||||
(CDFILES.PATS 29353 . 31628)) (31631 46716 (CDPRINT 31641 . 33986) (CDPRINT.HEADER 33988 . 34885) (
|
||||
CDPRINT.LINE 34887 . 37443) (CDPRINT.MAXWIDTHS 37445 . 41560) (CDPRINT.COLHEADERS 41562 . 42200) (
|
||||
CDPRINT.COLUMNS 42202 . 46081) (CDTEDIT 46083 . 46714)) (46717 55086 (CDMAP 46727 . 48159) (CDENTRY
|
||||
48161 . 48470) (CDSUBSET 48472 . 49911) (CDMERGE 49913 . 53767) (CDMERGE.COMMON 53769 . 55084)) (55087
|
||||
62625 (BINCOMP 55097 . 59386) (EOLTYPE 59388 . 61950) (EOLTYPE.SHOW 61952 . 62623)) (63153 75680 (
|
||||
FIND-UNCOMPILED-FILES 63163 . 66806) (FIND-UNSOURCED-FILES 66808 . 69192) (FIND-SOURCE-FILES 69194 .
|
||||
70932) (FIND-COMPILED-FILES 70934 . 72811) (FIND-UNLOADED-FILES 72813 . 73666) (FIND-LOADED-FILES
|
||||
73668 . 74096) (FIND-MULTICOMPILED-FILES 74098 . 75678)) (75681 84112 (CREATED-AS 75691 . 80488) (
|
||||
SOURCE-FOR-COMPILED-P 80490 . 83417) (COMPILE-SOURCE-DATE-DIFF 83419 . 84110)) (84113 94419 (
|
||||
FIX-DIRECTORY-DATES 84123 . 87116) (FIX-EQUIV-DATES 87118 . 88643) (COPY-COMPARED-FILES 88645 . 90466)
|
||||
(COPY-MISSING-FILES 90468 . 92625) (COMPILED-ON-SAME-SOURCE 92627 . 94417)) (94613 101959 (CDBROWSER
|
||||
94623 . 98550) (CDBROWSER.STRINGS 98552 . 101957)) (102121 103857 (CD.TABLEITEM 102131 . 102351) (
|
||||
CD.TABLEITEM.PRINTFN 102353 . 102552) (CD.TABLEITEM.COPYFN 102554 . 103612) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 103614 . 103855)) (103858 123102 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
103868 . 104336) (CD.COMMANDSELECTEDFN 104338 . 109439) (CD-MENUFN 109441 . 115804) (CDBROWSER-COPY
|
||||
115806 . 119366) (CDBROWSER-DELETE-FILE 119368 . 122581) (CD-SWAPDIRS 122583 . 123100)))))
|
||||
(FILEMAP (NIL (2640 22197 (COMPAREDIRECTORIES 2650 . 7483) (COMPAREDIRECTORIES.INFOS 7485 . 10359) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10361 . 13746) (CDENTRIES.SELECT 13748 . 18523) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18525 . 19431) (MATCHNAME 19433 . 20113) (CD.INSURECDVALUE 20115 . 21729
|
||||
) (CD.UPDATEWIDTHS 21731 . 22195)) (22198 31867 (CDFILES 22208 . 27961) (CDFILES.MATCH 27963 . 29588)
|
||||
(CDFILES.PATS 29590 . 31865)) (31868 46953 (CDPRINT 31878 . 34223) (CDPRINT.HEADER 34225 . 35122) (
|
||||
CDPRINT.LINE 35124 . 37680) (CDPRINT.MAXWIDTHS 37682 . 41797) (CDPRINT.COLHEADERS 41799 . 42437) (
|
||||
CDPRINT.COLUMNS 42439 . 46318) (CDTEDIT 46320 . 46951)) (46954 55323 (CDMAP 46964 . 48396) (CDENTRY
|
||||
48398 . 48707) (CDSUBSET 48709 . 50148) (CDMERGE 50150 . 54004) (CDMERGE.COMMON 54006 . 55321)) (55324
|
||||
62862 (BINCOMP 55334 . 59623) (EOLTYPE 59625 . 62187) (EOLTYPE.SHOW 62189 . 62860)) (63390 75917 (
|
||||
FIND-UNCOMPILED-FILES 63400 . 67043) (FIND-UNSOURCED-FILES 67045 . 69429) (FIND-SOURCE-FILES 69431 .
|
||||
71169) (FIND-COMPILED-FILES 71171 . 73048) (FIND-UNLOADED-FILES 73050 . 73903) (FIND-LOADED-FILES
|
||||
73905 . 74333) (FIND-MULTICOMPILED-FILES 74335 . 75915)) (75918 84349 (CREATED-AS 75928 . 80725) (
|
||||
SOURCE-FOR-COMPILED-P 80727 . 83654) (COMPILE-SOURCE-DATE-DIFF 83656 . 84347)) (84350 94656 (
|
||||
FIX-DIRECTORY-DATES 84360 . 87353) (FIX-EQUIV-DATES 87355 . 88880) (COPY-COMPARED-FILES 88882 . 90703)
|
||||
(COPY-MISSING-FILES 90705 . 92862) (COMPILED-ON-SAME-SOURCE 92864 . 94654)) (94850 102196 (CDBROWSER
|
||||
94860 . 98787) (CDBROWSER.STRINGS 98789 . 102194)) (102358 104094 (CD.TABLEITEM 102368 . 102588) (
|
||||
CD.TABLEITEM.PRINTFN 102590 . 102789) (CD.TABLEITEM.COPYFN 102791 . 103849) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 103851 . 104092)) (104095 124750 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
104105 . 104573) (CD.COMMANDSELECTEDFN 104575 . 109676) (CD-MENUFN 109678 . 113989) (CD-COMPARE-FILES
|
||||
113991 . 117343) (CDBROWSER-COPY 117345 . 121014) (CDBROWSER-DELETE-FILE 121016 . 124229) (CD-SWAPDIRS
|
||||
124231 . 124748)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-May-2022 10:17:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;123 41825
|
||||
(FILECREATED "22-May-2022 18:46:01"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPARESOURCES.;128 39655
|
||||
|
||||
:CHANGES-TO (FNS CSBROWSER)
|
||||
:CHANGES-TO (FNS COMPARESOURCES CSBROWSER \CS.EXAMINE)
|
||||
(VARS COMPARESOURCESCOMS)
|
||||
|
||||
:PREVIOUS-DATE "11-May-2022 19:12:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;122)
|
||||
:PREVIOUS-DATE "12-May-2022 10:17:13"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPARESOURCES.;123)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -29,7 +30,6 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
'CSOBJ.COPYBUTTONEVENTINFN]
|
||||
(VARS COMPARESOURCETYPES DEFAULT.DECLARE.TAGS)
|
||||
(COMS (FNS CSBROWSER)
|
||||
(INITVARS (COMPARESOURCES-BROWSER-TYPE 'OBJECTWINDOW))
|
||||
(FILES (SYSLOAD)
|
||||
OBJECTWINDOW EXAMINEDEFS REGIONMANAGER))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CSTYPE)
|
||||
@@ -37,19 +37,15 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(COMPARESOURCES
|
||||
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM IGNORECOMMENTS)(* ; "Edited 11-May-2022 19:12 by rmk")
|
||||
(* ; "Edited 28-Jan-2022 17:10 by rmk")
|
||||
(* ; "Edited 26-Dec-2021 21:32 by rmk")
|
||||
(* ; "Edited 19-Apr-2018 10:49 by rmk:")
|
||||
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM IGNORECOMMENTS LABELX LABELY)
|
||||
(* ; "Edited 22-May-2022 18:45 by rmk")
|
||||
|
||||
(* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream")
|
||||
(* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream, or an object window")
|
||||
|
||||
(DECLARE (SPECVARS FILEX FILEY EXAMINE DIFFERENCES))
|
||||
(PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY DATECOL
|
||||
[INSERTOBJECTS (AND EXAMINE (IF (TEXTSTREAMP LISTSTREAM)
|
||||
THEN 'TEDIT
|
||||
ELSEIF (OBJWINDOWP LISTSTREAM)
|
||||
THEN 'OBJECTWINDOW]
|
||||
(PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY DATECOL (INSERTOBJECTS
|
||||
(AND EXAMINE (OBJWINDOWP
|
||||
LISTSTREAM)))
|
||||
(COMPARESTREAM LISTSTREAM)
|
||||
(CONTEXTSTREAM LISTSTREAM)
|
||||
OBJECTS)
|
||||
@@ -59,10 +55,12 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(SETQ CONTEXTSTREAM (CL:MAKE-STRING-OUTPUT-STREAM))
|
||||
(LINELENGTH 65535 COMPARESTREAM) (* ; "Let the receiver do the wrapping")
|
||||
(LINELENGTH 65535 CONTEXTSTREAM))
|
||||
(OR (INFILEP FILEX)
|
||||
(OR (STREAMP FILEX)
|
||||
(INFILEP FILEX)
|
||||
(SETQ FILEX (FINDFILE FILEX T))
|
||||
(RETURN (printout CONTEXTSTREAM FILEX " not found" T)))
|
||||
(OR (INFILEP FILEY)
|
||||
(OR (STREAMP FILEY)
|
||||
(INFILEP FILEY)
|
||||
(SETQ FILEY (FINDFILE FILEY T))
|
||||
(RETURN (printout CONTEXTSTREAM FILEY " not found" T)))
|
||||
|
||||
@@ -79,15 +77,18 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(DECLARE (SPECVARS *REMOVE-INTERLISP-COMMENTS*))
|
||||
(SETQ BODYX (REMOVE-COMMENTS BODYX))
|
||||
(SETQ BODYY (REMOVE-COMMENTS BODYY))))
|
||||
(CL:UNLESS LABELX (SETQ LABELX FILEX))
|
||||
(CL:UNLESS LABELY (SETQ LABELY FILEY))
|
||||
[SETQ DATECOL (PLUS 2 (CONSTANT (NCHARS "Comparing"))
|
||||
(IMAX (NCHARS FILEX)
|
||||
(NCHARS FILEY]
|
||||
(printout CONTEXTSTREAM "Comparing " FILEX .TAB0 DATECOL "dated " (GETFILEINFO FILEX
|
||||
'CREATIONDATE)
|
||||
(IMAX (NCHARS LABELX)
|
||||
(NCHARS LABELY]
|
||||
(printout CONTEXTSTREAM "Comparing " LABELX .TAB0 DATECOL "dated " (GETFILEINFO
|
||||
FILEX
|
||||
'CREATIONDATE)
|
||||
.TAB
|
||||
[SUB1 (CONSTANT (IDIFFERENCE (NCHARS "Comparing ")
|
||||
(NCHARS "and "]
|
||||
" and " FILEY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE)
|
||||
" and " LABELY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE)
|
||||
T T)
|
||||
[SETQ DECLAREX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR)
|
||||
'DECLARE%:]
|
||||
@@ -131,15 +132,11 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(REVERSE Y)
|
||||
DW?]
|
||||
(TERPRI CONTEXTSTREAM))
|
||||
(SELECTQ INSERTOBJECTS
|
||||
(OBJECTWINDOW (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE (CL:GET-OUTPUT-STREAM-STRING
|
||||
CONTEXTSTREAM))))
|
||||
(SETQ OBJECTS (DREVERSE OBJECTS))
|
||||
(OBJ.ADDMANYTOW LISTSTREAM OBJECTS))
|
||||
(TEDIT (HELP "Don't know about TEDIT"))
|
||||
(NIL)
|
||||
(HELP))
|
||||
(CL:WHEN INSERTOBJECTS
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))))
|
||||
(SETQ OBJECTS (DREVERSE OBJECTS))
|
||||
(OBJ.ADDMANYTOW LISTSTREAM OBJECTS))
|
||||
(RETURN (OR (REVERSE DIFFERENCES)
|
||||
'SAME])
|
||||
|
||||
@@ -304,13 +301,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
RESULT)])
|
||||
|
||||
(\CS.EXAMINE
|
||||
[LAMBDA (X Y ONLYONE NAME TYPE) (* ; "Edited 24-Dec-2021 22:48 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 22:46 by rmk")
|
||||
(* ; "Edited 9-Dec-2021 23:23 by rmk")
|
||||
(* ; "Edited 4-Dec-2021 16:43 by rmk")
|
||||
(* ; "Edited 2-Dec-2021 15:23 by rmk:")
|
||||
(* ; "Edited 29-Nov-2021 20:37 by rmk:")
|
||||
(* ; "Edited 27-Nov-2021 11:21 by rmk:")
|
||||
[LAMBDA (X Y ONLYONE NAME TYPE) (* ; "Edited 22-May-2022 16:28 by rmk")
|
||||
(* ; "Edited 27-Nov-2021 11:21 by rmk:")
|
||||
(DECLARE (USEDFREE EXAMINE INSERTOBJECTS COMPARESTREAM CONTEXTSTREAM OBJECTS))
|
||||
|
||||
(* ;; "ONLYONE as a flag, because we don't want to test X or Y for NIL, that could be the contrasting value.")
|
||||
@@ -324,34 +316,30 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(* ;; "Context gets printed to the CONTEXTSTREAM, diffs go to the COMPARESTREAM. If we aren't doing objects, those are the same streams, and the output gets printed in the right order. Nothing to do here.")
|
||||
|
||||
(IF INSERTOBJECTS
|
||||
THEN (SELECTQ INSERTOBJECTS
|
||||
(OBJECTWINDOW [LET (STRING)
|
||||
THEN [LET (STRING)
|
||||
|
||||
(* ;; "Take out last EOL, let SEPDIST space things out.")
|
||||
(* ;; "Take out last EOL, let SEPDIST space things out.")
|
||||
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
(SETQ STRING (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))
|
||||
(CL:WHEN (EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -1))
|
||||
(SETQ STRING (OR (SUBSTRING STRING 1 -2)
|
||||
"")))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE STRING)))
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR COMPARESTREAM))
|
||||
(SETQ STRING (CL:GET-OUTPUT-STREAM-STRING COMPARESTREAM))
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
(SETQ STRING (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))
|
||||
(CL:WHEN (EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -1))
|
||||
(SETQ STRING (OR (SUBSTRING STRING 1 -2)
|
||||
"")))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE STRING)))
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR COMPARESTREAM))
|
||||
(SETQ STRING (CL:GET-OUTPUT-STREAM-STRING COMPARESTREAM))
|
||||
|
||||
(* ;; "Don't know why, but SEPTDIST doesn't work if there if there isn't at least one EOL. Magically, this gets the right appearance and behavior.")
|
||||
(* ;; "Don't know why, but SEPTDIST doesn't work if there if there isn't at least one EOL. Magically, this gets the right appearance and behavior.")
|
||||
|
||||
(CL:WHEN (AND (EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -1))
|
||||
(EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -2)))
|
||||
(SETQ STRING (OR (SUBSTRING STRING 1 -2)
|
||||
"")))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE STRING
|
||||
(LIST NAME TYPE X Y LABEL1 LABEL2)
|
||||
ONLYONE)))])
|
||||
(TEDIT (HELP "TEDIT NOT IMPLEMENTED"))
|
||||
NIL)
|
||||
(CL:WHEN (AND (EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -1))
|
||||
(EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -2)))
|
||||
(SETQ STRING (OR (SUBSTRING STRING 1 -2)
|
||||
"")))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE STRING (LIST NAME TYPE X Y LABEL1 LABEL2)
|
||||
ONLYONE)))]
|
||||
ELSEIF (OR (LISTP X)
|
||||
(LISTP Y))
|
||||
THEN (* ;
|
||||
@@ -634,8 +622,11 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(CSBROWSER
|
||||
[LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION IGNORECOMMENTS)
|
||||
(* ; "Edited 12-May-2022 10:16 by rmk")
|
||||
[LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION IGNORECOMMENTS TITLE)
|
||||
|
||||
(* ;; "Edited 22-May-2022 18:42 by rmk")
|
||||
|
||||
(* ;; "Edited 12-May-2022 10:16 by rmk")
|
||||
|
||||
(* ;; "Edited 24-Jan-2022 23:11 by rmk: EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.")
|
||||
|
||||
@@ -646,44 +637,33 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
(* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers. If the file can be found that way, then lower functions will find it.")
|
||||
|
||||
(DECLARE (SPECVARS LABEL1 LABEL2))
|
||||
(SETQ FILEX (OR (INFILEP FILEX)
|
||||
(SETQ FILEX (OR (STREAMP FILEX)
|
||||
(INFILEP FILEX)
|
||||
(FINDFILE FILEX NIL DIRECTORIES)
|
||||
(ERROR "FILE NOT FOUND" FILEX)))
|
||||
(SETQ FILEY (OR (INFILEP FILEY)
|
||||
(SETQ FILEY (OR (STREAMP FILEY)
|
||||
(INFILEP FILEY)
|
||||
(FINDFILE FILEY NIL DIRECTORIES)
|
||||
(ERROR "FILE NOT FOUND" FILEY)))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILEX)
|
||||
(ERROR FILEX " is not a Medley source file"))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILEY)
|
||||
(ERROR FILEX " is not a Medley source file"))
|
||||
(LET [(TITLE (CONCAT "COMPARESOURCES of " (OR LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FILEX))
|
||||
" and "
|
||||
(OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY]
|
||||
(SELECTQ COMPARESOURCES-BROWSER-TYPE
|
||||
(OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T
|
||||
(FONTPROP DEFAULTFONT 'HEIGHT]
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
|
||||
(GETPROMPTWINDOW WINDOW T)
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
|
||||
(COMPARESOURCES FILEX FILEY '(T 2WINDOWS)
|
||||
DW? WINDOW IGNORECOMMENTS)
|
||||
(OPENW WINDOW)
|
||||
WINDOW))
|
||||
(TEDIT (LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM IGNORECOMMENTS)
|
||||
[TEDIT TSTREAM REGION NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT TITLE
|
||||
,TITLE]
|
||||
(CL:WHEN NIL
|
||||
EXAMINE
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} 'OUTPUT)))
|
||||
(WFROMDS TSTREAM)))
|
||||
(HELP])
|
||||
(CL:UNLESS TITLE
|
||||
[SETQ TITLE (CONCAT "COMPARESOURCES of " (OR LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FILEX))
|
||||
" and "
|
||||
(OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY])
|
||||
(LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T (FONTPROP DEFAULTFONT 'HEIGHT]
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
|
||||
(GETPROMPTWINDOW WINDOW T)
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
|
||||
(COMPARESOURCES FILEX FILEY '(T 2WINDOWS)
|
||||
DW? WINDOW IGNORECOMMENTS LABEL1 LABEL2)
|
||||
(OPENW WINDOW)
|
||||
WINDOW])
|
||||
)
|
||||
|
||||
(RPAQ? COMPARESOURCES-BROWSER-TYPE 'OBJECTWINDOW)
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
OBJECTWINDOW EXAMINEDEFS REGIONMANAGER)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -699,16 +679,16 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1852 26954 (COMPARESOURCES 1862 . 8290) (\CS.COMPARE.MASTERS 8292 . 15704) (
|
||||
\CS.COMPARE.TYPES 15706 . 18972) (\CS.EXAMINE 18974 . 23201) (\CS.FIXFNS 23203 . 24705) (
|
||||
\CS.SORT.DECLARES 24707 . 25050) (\CS.SORT.DECLARE1 25052 . 26472) (\CS.FILTER.GARBAGE 26474 . 26952))
|
||||
(26955 31491 (\CS.ISFNFORM 26965 . 27233) (\CS.COMPARE.FNS 27235 . 27477) (\CS.FNSID 27479 . 27623) (
|
||||
\CS.ISVARFORM 27625 . 27730) (\CS.COMPARE.VARS 27732 . 28394) (\CS.ISMACROFORM 28396 . 28534) (
|
||||
\CS.ISRECFORM 28536 . 28864) (\CS.REC.NAME 28866 . 29185) (\CS.ISCOURIERFORM 29187 . 29287) (
|
||||
\CS.ISTEMPLATEFORM 29289 . 29387) (\CS.COMPARE.TEMPLATES 29389 . 29754) (\CS.ISPROPFORM 29756 . 29911)
|
||||
(\CS.PROP.NAME 29913 . 30058) (\CS.COMPARE.PROPS 30060 . 30217) (\CS.ISADDVARFORM 30219 . 30312) (
|
||||
\CS.COMPARE.ADDVARS 30314 . 30479) (\CS.ISFPKGCOMFORM 30481 . 30688) (\CS.COMPARE.FPKGCOMS 30690 .
|
||||
30897) (\CS.COMPARE.DEFINE-FILE-INFO 30899 . 31489)) (31492 37556 (CSOBJ.CREATE 31502 . 31915) (
|
||||
CSOBJ.DISPLAYFN 31917 . 32670) (CSOBJ.IMAGEBOXFN 32672 . 34833) (CSOBJ.BUTTONEVENTINFN 34835 . 37306)
|
||||
(CSOBJ.COPYBUTTONEVENTINFN 37308 . 37554)) (38437 41343 (CSBROWSER 38447 . 41341)))))
|
||||
(FILEMAP (NIL (1864 25616 (COMPARESOURCES 1874 . 8001) (\CS.COMPARE.MASTERS 8003 . 15415) (
|
||||
\CS.COMPARE.TYPES 15417 . 18683) (\CS.EXAMINE 18685 . 21863) (\CS.FIXFNS 21865 . 23367) (
|
||||
\CS.SORT.DECLARES 23369 . 23712) (\CS.SORT.DECLARE1 23714 . 25134) (\CS.FILTER.GARBAGE 25136 . 25614))
|
||||
(25617 30153 (\CS.ISFNFORM 25627 . 25895) (\CS.COMPARE.FNS 25897 . 26139) (\CS.FNSID 26141 . 26285) (
|
||||
\CS.ISVARFORM 26287 . 26392) (\CS.COMPARE.VARS 26394 . 27056) (\CS.ISMACROFORM 27058 . 27196) (
|
||||
\CS.ISRECFORM 27198 . 27526) (\CS.REC.NAME 27528 . 27847) (\CS.ISCOURIERFORM 27849 . 27949) (
|
||||
\CS.ISTEMPLATEFORM 27951 . 28049) (\CS.COMPARE.TEMPLATES 28051 . 28416) (\CS.ISPROPFORM 28418 . 28573)
|
||||
(\CS.PROP.NAME 28575 . 28720) (\CS.COMPARE.PROPS 28722 . 28879) (\CS.ISADDVARFORM 28881 . 28974) (
|
||||
\CS.COMPARE.ADDVARS 28976 . 29141) (\CS.ISFPKGCOMFORM 29143 . 29350) (\CS.COMPARE.FPKGCOMS 29352 .
|
||||
29559) (\CS.COMPARE.DEFINE-FILE-INFO 29561 . 30151)) (30154 36218 (CSOBJ.CREATE 30164 . 30577) (
|
||||
CSOBJ.DISPLAYFN 30579 . 31332) (CSOBJ.IMAGEBOXFN 31334 . 33495) (CSOBJ.BUTTONEVENTINFN 33497 . 35968)
|
||||
(CSOBJ.COPYBUTTONEVENTINFN 35970 . 36216)) (37099 39228 (CSBROWSER 37109 . 39226)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
334
lispusers/GITFNS
334
lispusers/GITFNS
@@ -1,15 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-May-2022 19:19:14"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;296 97537
|
||||
(FILECREATED " 4-Jun-2022 20:44:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;313 100657
|
||||
|
||||
:CHANGES-TO (FNS GIT-MY-CURRENT-BRANCH GIT-MAKE-BRANCH GIT-NEXT-WORKING-BRANCH GIT-BRANCH-NUM
|
||||
GIT-MY-BRANCHP GIT-MY-BRANCHES)
|
||||
(VARS GITFNSCOMS)
|
||||
(COMMANDS cob)
|
||||
:CHANGES-TO (FNS GIT-BRANCH-DIFF)
|
||||
|
||||
:PREVIOUS-DATE "19-May-2022 14:08:39"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>GITFNS.;295)
|
||||
:PREVIOUS-DATE "29-May-2022 21:59:23"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;312)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@@ -73,7 +70,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-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME
|
||||
GIT-LONG-NAME)
|
||||
|
||||
(* ;; "My branches")
|
||||
|
||||
@@ -91,8 +89,9 @@
|
||||
|
||||
(* ;; "Comparisons")
|
||||
|
||||
(FNS GIT-GET-DIFFERENT-FILES GIT-COMPARE-BRANCHES GIT-COMPARE-WITH-WORKINGMEDLEY
|
||||
GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN)
|
||||
(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)
|
||||
(INITVARS (FROMGITN 0))
|
||||
|
||||
(* ;; "")
|
||||
@@ -389,14 +388,28 @@
|
||||
THEN (SETQ PROJECT (CAR STAIL))
|
||||
(GO $$OUT))
|
||||
(CAR STAIL)))
|
||||
(GIT-COMPARE-WITH-WORKINGMEDLEY SUBDIRS NIL NIL NIL T PROJECT)))
|
||||
(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)")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(GIT-COMPARE-BRANCHES BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
|
||||
(SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
|
||||
((NIL T)
|
||||
(GIT-MY-CURRENT-BRANCH PROJECT))
|
||||
((LOCAL REMOTE ORIGIN)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
|
||||
(OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
|
||||
BRANCH1)))
|
||||
(SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
|
||||
((NIL T)
|
||||
(GIT-MAINBRANCH PROJECT LOCAL))
|
||||
((LOCAL REMOTE ORIGIN)
|
||||
(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))
|
||||
LOCAL PROJECT))
|
||||
|
||||
(DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT)
|
||||
@@ -412,22 +425,22 @@
|
||||
(SETQ RB NIL)
|
||||
ELSEIF (GIT-GET-PROJECT DRAFTS T)
|
||||
THEN (SETQ PROJECT DRAFTS)
|
||||
(SETQ DRAFTS NIL))
|
||||
(SETQ DRFTS NIL))
|
||||
(CL:WHEN (MEMB (U-CASE RB)
|
||||
'(DRAFT DRAFTS))
|
||||
(SETQ RB NIL)
|
||||
(SETQ DR T))
|
||||
(CL:WHEN (OR RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT)
|
||||
"Pull requests"))
|
||||
(GIT-COMPARE-BRANCHES RB (GIT-MAINBRANCH PROJECT)
|
||||
(CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT)
|
||||
"Pull requests")))
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES RB (GIT-MAINBRANCH PROJECT)
|
||||
NIL PROJECT))))
|
||||
|
||||
(DEFCOMMAND cob (BRANCH TITLESTRING 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 STRING 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 TITLESTRING)
|
||||
(SETQ PROJECT TITLESTRING))
|
||||
(CL:UNLESS (STRINGP NEXTTITLESTRING)
|
||||
(SETQ PROJECT NEXTTITLESTRING))
|
||||
(CL:UNLESS PROJECT
|
||||
(CL:WHEN (GIT-GET-PROJECT BRANCH T)
|
||||
(SETQ PROJECT BRANCH)
|
||||
@@ -437,12 +450,14 @@
|
||||
(T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
|
||||
PROJECT))
|
||||
((NEW NEXT)
|
||||
(GIT-MAKE-BRANCH NIL TITLESTRING PROJECT))
|
||||
(GIT-CHECKOUT (OR BRANCH (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
|
||||
(CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT)
|
||||
T)
|
||||
" branches")))
|
||||
PROJECT)))
|
||||
(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 (FETCH PROJECTNAME OF PROJECT)
|
||||
T)
|
||||
" branches"]
|
||||
(GIT-CHECKOUT BRANCH PROJECT))))
|
||||
|
||||
(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT)
|
||||
@@ -767,6 +782,8 @@
|
||||
(GIT-GET-FILE
|
||||
[LAMBDA (BRANCH GITFILE LOCALFILE NOERROR PROJECT)
|
||||
|
||||
(* ;; "Edited 22-May-2022 17:34 by rmk")
|
||||
|
||||
(* ;; "Edited 8-May-2022 16:54 by rmk: the stream, not the name because of the NODIRCORE case.")
|
||||
|
||||
(* ;; "Edited 6-Mar-2022 17:45 by rmk: the stream, not the name because of the NODIRCORE case.")
|
||||
@@ -870,6 +887,8 @@
|
||||
(GIT-BRANCH-DIFF
|
||||
[LAMBDA (BRANCH1 BRANCH2 PROJECT)
|
||||
|
||||
(* ;; "Edited 4-Jun-2022 20:43 by rmk")
|
||||
|
||||
(* ;; "Edited 9-May-2022 16:21 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).")
|
||||
|
||||
(* ;; "Edited 6-May-2022 14:04 by rmk: returns an ALIST that classifies how the files in BRANCH1 and BRANCH2 differ (changed, renamed, added, deleted, copied).")
|
||||
@@ -893,7 +912,7 @@
|
||||
POS NIL T)
|
||||
THEN BRANCH1
|
||||
ELSE BRANCH2)))
|
||||
(SORT [FOR L IN LINES
|
||||
(SORT (FOR L IN LINES
|
||||
COLLECT (SELCHARQ (CHCON1 L)
|
||||
(A (CL:IF (EQ (CHARCODE TAB)
|
||||
(NTHCHARCODE L 2))
|
||||
@@ -927,7 +946,7 @@
|
||||
" Ignore remaining files? "
|
||||
)))
|
||||
(ERROR!)))
|
||||
(HELP "Unrecognized git-diff code" (NTHCHAR L 1]
|
||||
(HELP "Unrecognized git-diff code %"" L "%"")))
|
||||
T])
|
||||
|
||||
(GIT-COMMIT-DIFFS
|
||||
@@ -940,65 +959,61 @@
|
||||
NIL NIL PROJECT])
|
||||
|
||||
(GIT-BRANCH-RELATIONS
|
||||
[LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 9-May-2022 16:12 by rmk")
|
||||
[LAMBDA (BRANCHES BRANCH2 STRIPWHERE PROJECT) (* ; "Edited 29-May-2022 21:59 by rmk")
|
||||
(* ; "Edited 9-May-2022 16:12 by rmk")
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
|
||||
(* ;; "Returns a pair (SUPERSETS EQUALS), where each item in SUPERSETS is a list of the form (B0 B1 B2...) where each Bi is a superset of Bj for i < j and EQUALS is a list of branch equivalence classes. ")
|
||||
|
||||
(CL:WHEN BRANCH2
|
||||
(SETQ BRANCHES (LIST BRANCHES BRANCH2)))
|
||||
(FOR DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS ON (FOR B IN BRANCHES
|
||||
COLLECT (CONS B (GIT-COMMIT-DIFFS B (
|
||||
GIT-MAINBRANCH
|
||||
PROJECT)
|
||||
PROJECT)))
|
||||
DO
|
||||
(* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.")
|
||||
(LET
|
||||
((MAIN (GIT-MAINBRANCH PROJECT)))
|
||||
(FOR DTAIL D1 MORE1 MORE2 SUPERSETS EQUALS
|
||||
ON (FOR B IN BRANCHES COLLECT (CONS B (GIT-COMMIT-DIFFS B MAIN PROJECT)))
|
||||
DO
|
||||
(* ;; "For each branch we now have the list of commit identifiers (hexstrings) that they do not share with the main branch.")
|
||||
|
||||
(SETQ D1 (CAR DTAIL))
|
||||
[FOR D2 IN (CDR DTAIL)
|
||||
DO (CL:WHEN (EQUAL (CDR D1)
|
||||
(CDR D2)) (* ; "Unlikely")
|
||||
(PUSH [CDR (OR (ASSOC (CAR D1)
|
||||
EQUALS)
|
||||
(CAR (PUSH EQUALS (CONS (CAR D1]
|
||||
(CAR D2))
|
||||
(GO $$ITERATE))
|
||||
(SETQ MORE2 (MEMBER (CADR D1)
|
||||
(CDR D2))) (* ;
|
||||
(SETQ D1 (CAR DTAIL))
|
||||
[FOR D2 IN (CDR DTAIL)
|
||||
DO (CL:WHEN (EQUAL (CDR D1)
|
||||
(CDR D2)) (* ; "Unlikely")
|
||||
(PUSH [CDR (OR (ASSOC (CAR D1)
|
||||
EQUALS)
|
||||
(CAR (PUSH EQUALS (CONS (CAR D1]
|
||||
(CAR D2))
|
||||
(GO $$ITERATE))
|
||||
(SETQ MORE2 (MEMBER (CADR D1)
|
||||
(CDR D2))) (* ;
|
||||
"The most recent commit of D1 is in D2")
|
||||
(SETQ MORE1 (MEMBER (CADR D2)
|
||||
(CDR D1)))
|
||||
(IF MORE2
|
||||
THEN (CL:UNLESS MORE1
|
||||
(PUSH [CDR (OR (ASSOC (CAR D2)
|
||||
SUPERSETS)
|
||||
(CAR (PUSH SUPERSETS (CONS (CAR D2]
|
||||
(CAR D1)))
|
||||
ELSEIF MORE1
|
||||
THEN (PUSH [CDR (OR (ASSOC (CAR D1)
|
||||
SUPERSETS)
|
||||
(CAR (PUSH SUPERSETS (CONS (CAR D1]
|
||||
(CAR D2]
|
||||
FINALLY
|
||||
(SETQ MORE1 (MEMBER (CADR D2)
|
||||
(CDR D1)))
|
||||
(IF MORE2
|
||||
THEN (CL:UNLESS MORE1
|
||||
(PUSH [CDR (OR (ASSOC (CAR D2)
|
||||
SUPERSETS)
|
||||
(CAR (PUSH SUPERSETS (CONS (CAR D2]
|
||||
(CAR D1)))
|
||||
ELSEIF MORE1
|
||||
THEN (PUSH [CDR (OR (ASSOC (CAR D1)
|
||||
SUPERSETS)
|
||||
(CAR (PUSH SUPERSETS (CONS (CAR D1]
|
||||
(CAR D2]
|
||||
FINALLY
|
||||
|
||||
(* ;; "Sort the supersets so that the larger ones come before the smaller ones")
|
||||
(* ;; "Sort the supersets so that the larger ones come before the smaller ones")
|
||||
|
||||
(CL:WHEN STRIPWHERE
|
||||
[SETQ SUPERSETS (FOR S IN SUPERSETS COLLECT (FOR SS IN S COLLECT (STRIPWHERE SS]
|
||||
[SETQ EQUALS (FOR S IN EQUALS COLLECT (FOR SS IN S COLLECT (STRIPWHERE SS])
|
||||
[FOR S IN SUPERSETS
|
||||
DO (CHANGE (CDR S)
|
||||
(SORT DATUM (FUNCTION (LAMBDA (B1 B2)
|
||||
(OR (MEMB B2 (CDR (ASSOC B1 SUPERSETS)))
|
||||
(NOT (MEMB B1 (CDR (ASSOC B2 SUPERSETS]
|
||||
[FOR E IN EQUALS DO (CHANGE (CDR E)
|
||||
(IF (MEMB (GIT-MAINBRANCH PROJECT)
|
||||
(CDR E))
|
||||
THEN (CONS (GIT-MAINBRANCH PROJECT)
|
||||
(DREMOVE (GIT-MAINBRANCH PROJECT)
|
||||
(SORT DATUM)))
|
||||
ELSE (SORT DATUM]
|
||||
(RETURN (LIST SUPERSETS EQUALS])
|
||||
(CL:WHEN STRIPWHERE
|
||||
[SETQ SUPERSETS (FOR S IN SUPERSETS COLLECT (FOR SS IN S COLLECT (STRIPWHERE SS]
|
||||
[SETQ EQUALS (FOR S IN EQUALS COLLECT (FOR SS IN S COLLECT (STRIPWHERE SS])
|
||||
[FOR S IN SUPERSETS
|
||||
DO (CHANGE (CDR S)
|
||||
(SORT DATUM (FUNCTION (LAMBDA (B1 B2)
|
||||
(OR (MEMB B2 (CDR (ASSOC B1 SUPERSETS)))
|
||||
(NOT (MEMB B1 (CDR (ASSOC B2 SUPERSETS]
|
||||
[FOR E IN EQUALS DO (CHANGE (CDR E)
|
||||
(IF (MEMB MAIN (CDR E))
|
||||
THEN (CONS MAIN (DREMOVE MAIN (SORT DATUM)))
|
||||
ELSE (SORT DATUM]
|
||||
(RETURN (LIST SUPERSETS EQUALS])
|
||||
)
|
||||
|
||||
|
||||
@@ -1075,7 +1090,8 @@
|
||||
ELSE (HELP "Unexpected git result" RESULT])
|
||||
|
||||
(GIT-BRANCHES
|
||||
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 19-May-2022 10:06 by rmk")
|
||||
[LAMBDA (WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 23-May-2022 14:25 by rmk")
|
||||
(* ; "Edited 19-May-2022 10:06 by rmk")
|
||||
(* ; "Edited 9-May-2022 14:10 by rmk")
|
||||
(* ; "Edited 7-May-2022 23:29 by rmk")
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
@@ -1093,8 +1109,8 @@
|
||||
BRANCHES)
|
||||
(SETQ BRANCHES (APPEND LOCAL REMOTE))
|
||||
(CL:WHEN EXCLUDEMERGED
|
||||
(SETQ BRANCHES (FOR B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT LOCAL)) IN BRANCHES
|
||||
UNLESS (GIT-COMMIT-DIFFS B MAINBRANCH PROJECT) COLLECT B)))
|
||||
(SETQ BRANCHES (FOR B (MAINBRANCH _ (GIT-MAINBRANCH PROJECT 'LOCAL)) IN BRANCHES
|
||||
UNLESS (GIT-COMMIT-DIFFS MAINBRANCH B PROJECT) COLLECT B)))
|
||||
(SORT BRANCHES])
|
||||
|
||||
(GIT-BRANCH-EXISTS?
|
||||
@@ -1162,6 +1178,21 @@
|
||||
,(SUBATOM LINE (ADD1 TAB3]
|
||||
ELSE (SUBATOM LINE (ADD1 TAB2)
|
||||
(SUB1 TAB3])
|
||||
|
||||
(GIT-SHORT-BRANCH-NAME
|
||||
[LAMBDA (BRANCH) (* ; "Edited 22-May-2022 22:36 by rmk")
|
||||
|
||||
(* ;; "Reduces rmk29--xxxxx to rmk29 for display")
|
||||
|
||||
(SUBSTRING BRANCH 1 (SUB1 (OR (STRPOS "--" BRANCH 1)
|
||||
0])
|
||||
|
||||
(GIT-LONG-NAME
|
||||
[LAMBDA (BRANCH WHERE PROJECT EXCLUDEMERGED) (* ; "Edited 24-May-2022 17:49 by rmk")
|
||||
|
||||
(* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz")
|
||||
|
||||
(FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B])
|
||||
)
|
||||
|
||||
|
||||
@@ -1320,10 +1351,13 @@
|
||||
[LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT)
|
||||
(DECLARE (USEDFREE FROMGITN))
|
||||
|
||||
(* ;; "Edited 21-May-2022 23:38 by rmk")
|
||||
|
||||
(* ;; "Edited 9-May-2022 14:17 by rmk: Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.")
|
||||
|
||||
(* ;; "Edited 6-May-2022 08:26 by rmk: Ask git for the files that differ between the branches, copy those files down to local DIR1 and DIR2, return the directories and a list of (dir1-file1 file2) mappings for renamed and copied files.")
|
||||
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1 NIL PROJECT))
|
||||
(SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2 NIL PROJECT))
|
||||
(LET
|
||||
@@ -1409,19 +1443,19 @@
|
||||
(HELP "UNKNOWN GIT-DIFF TAG" D)))
|
||||
(LIST DIR1 DIR2 MAPPINGS))])
|
||||
|
||||
(GIT-COMPARE-BRANCHES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 9-May-2022 15:14 by rmk")
|
||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 22-May-2022 22:47 by rmk")
|
||||
(* ; "Edited 9-May-2022 15:14 by rmk")
|
||||
(* ; "Edited 3-May-2022 23:04 by rmk")
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(SETQ BRANCH1 (IF BRANCH1
|
||||
THEN (GITORIGIN BRANCH1 LOCAL)
|
||||
ELSE (GIT-WHICH-BRANCH PROJECT)))
|
||||
(SETQ BRANCH2 (GITORIGIN (OR BRANCH2 (GIT-MAINBRANCH PROJECT))
|
||||
LOCAL))
|
||||
(PRINTOUT T "Comparing all " (L-CASE (FETCH PROJECTNAME OF PROJECT)
|
||||
T)
|
||||
" subdirectories of " BRANCH1 " and " BRANCH2 T)
|
||||
(LET (CDVALUE DIRS NENTRIES MAPPINGS)
|
||||
(LET (CDVALUE DIRS NENTRIES MAPPINGS (SHORT1 (GIT-SHORT-BRANCH-NAME BRANCH1))
|
||||
(SHORT2 (GIT-SHORT-BRANCH-NAME BRANCH2)))
|
||||
(PRINTOUT T "Comparing all " (L-CASE (FETCH PROJECTNAME OF PROJECT)
|
||||
T)
|
||||
" subdirectories of " SHORT1 " and " SHORT2 T)
|
||||
(PRINTOUT T "Fetching differences" T)
|
||||
(SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2 NIL NIL PROJECT))
|
||||
(SETQ MAPPINGS (CADDR DIRS))
|
||||
@@ -1479,10 +1513,10 @@
|
||||
(CDBROWSER CDVALUE (CONCAT "Comparing " (L-CASE (FETCH PROJECTNAME
|
||||
OF PROJECT)
|
||||
T)
|
||||
" " BRANCH1 " and " BRANCH2 " "
|
||||
" " SHORT1 " and " SHORT2 " "
|
||||
(LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE))
|
||||
" files")
|
||||
(LIST BRANCH1 BRANCH2)
|
||||
(LIST SHORT1 SHORT2)
|
||||
`(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
|
||||
,PROJECT)
|
||||
NIL
|
||||
@@ -1494,7 +1528,7 @@
|
||||
ELSE '(0 differences))
|
||||
ELSE '(0 differences])
|
||||
|
||||
(GIT-COMPARE-WITH-WORKINGMEDLEY
|
||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||
|
||||
(* ;; "Edited 17-May-2022 17:39 by rmk")
|
||||
@@ -1731,7 +1765,8 @@
|
||||
(OR LABEL2 FILE2])
|
||||
|
||||
(GIT-CD-MENUFN
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 8-May-2022 09:26 by rmk")
|
||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "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")
|
||||
@@ -1740,24 +1775,20 @@
|
||||
(SELECTQ (OR (CADDR MENUITEM)
|
||||
(CAR MENUITEM))
|
||||
(Delete% -> (FLASHWINDOW PWINDOW)
|
||||
(IF FILE1
|
||||
THEN (PRIN3 "Use 'Delete BOTH' instead")
|
||||
ELSE (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))))
|
||||
(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)
|
||||
(IF FILE2
|
||||
THEN (PRIN3 "Use 'Delete BOTH' instead")
|
||||
ELSE (GIVE.TTY.PROCESS PWINDOW)
|
||||
(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))))
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(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)))
|
||||
(Delete% BOTH (FLASHWINDOW PWINDOW)
|
||||
(GIVE.TTY.PROCESS PWINDOW)
|
||||
(CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT
|
||||
@@ -1768,6 +1799,38 @@
|
||||
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
|
||||
(TB.DELETE.ITEM CDBROWSER TBITEM)))
|
||||
(SHOULDNT])
|
||||
|
||||
(GIT-WORKING-COMPARE-FILES
|
||||
[LAMBDA (FILE PROJECT) (* ; "Edited 22-May-2022 14:45 by rmk")
|
||||
(LET ((FILE1 (UNSLASHIT (PACKFILENAME 'HOST (GIT-GET-PROJECT PROJECT NIL 'WHOST)
|
||||
'BODY FILE)
|
||||
T))
|
||||
(FILE2 (SLASHIT (PACKFILENAME 'HOST (GIT-GET-PROJECT PROJECT NIL 'GITHOST)
|
||||
'BODY FILE)
|
||||
T)))
|
||||
(CD-COMPARE-FILES FILE1 FILE2 FILE1 FILE2])
|
||||
|
||||
(GIT-BRANCHES-COMPARE-FILES
|
||||
[LAMBDA (FILE BRANCH1 BRANCH2 PROJECT LOCAL) (* ; "Edited 22-May-2022 22:50 by rmk")
|
||||
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
|
||||
(SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
|
||||
((NIL T)
|
||||
(GIT-MY-CURRENT-BRANCH PROJECT))
|
||||
((LOCAL REMOTE ORIGIN)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
|
||||
BRANCH1))
|
||||
(SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
|
||||
((NIL T)
|
||||
(GIT-MAINBRANCH PROJECT LOCAL))
|
||||
((LOCAL REMOTE ORIGIN)
|
||||
(GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
|
||||
BRANCH2))
|
||||
(LET ((FILE1 (GIT-GET-FILE BRANCH1 FILE NIL NIL PROJECT))
|
||||
(FILE2 (GIT-GET-FILE BRANCH2 FILE NIL NIL PROJECT)))
|
||||
(CD-COMPARE-FILES FILE1 FILE2 (CONCAT (GIT-SHORT-BRANCH-NAME BRANCH1)
|
||||
" " FILE)
|
||||
(CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2)
|
||||
" " FILE])
|
||||
)
|
||||
|
||||
(RPAQ? FROMGITN 0)
|
||||
@@ -1848,27 +1911,28 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3441 17288 (GIT-CLONEP 3451 . 4714) (GIT-MAKE-PROJECT 4716 . 12828) (GIT-GET-PROJECT
|
||||
12830 . 14167) (GIT-PROJECT-PATH 14169 . 15213) (FIND-ANCESTOR-DIRECTORY 15215 . 15564) (
|
||||
GIT-FIND-CLONE 15566 . 16647) (GIT-MAINBRANCH 16649 . 16933) (GIT-MAINBRANCH? 16935 . 17286)) (22251
|
||||
25039 (ALLSUBDIRS 22261 . 23547) (MEDLEYSUBDIRS 23549 . 24242) (GITSUBDIRS 24244 . 25037)) (25040
|
||||
29830 (TOGIT 25050 . 26456) (FROMGIT 26458 . 27439) (GIT-DELETE-FILE 27441 . 28287) (
|
||||
MYMEDLEY-DELETE-FILES 28289 . 29828)) (29831 32363 (MYMEDLEYSUBDIR 29841 . 30297) (GITSUBDIR 30299 .
|
||||
30742) (STRIPDIR 30744 . 31115) (STRIPHOST 31117 . 31357) (STRIPNAME 31359 . 32112) (STRIPWHERE 32114
|
||||
. 32361)) (32364 34266 (GFILE4MFILE 32374 . 32737) (MFILE4GFILE 32739 . 33308) (GIT-REPO-FILENAME
|
||||
33310 . 34264)) (34315 42066 (GIT-COMMIT 34325 . 35151) (GIT-PUSH 35153 . 35797) (GIT-PULL 35799 .
|
||||
36411) (GIT-APPROVAL 36413 . 36762) (GIT-GET-FILE 36764 . 39233) (GIT-FILE-EXISTS? 39235 . 40179) (
|
||||
GIT-REMOTE-UPDATE 40181 . 40905) (GIT-REMOTE-ADD 40907 . 41214) (GIT-FILE-DATE 41216 . 42064)) (42096
|
||||
51024 (GIT-BRANCH-DIFF 42106 . 46809) (GIT-COMMIT-DIFFS 46811 . 47255) (GIT-BRANCH-RELATIONS 47257 .
|
||||
51022)) (51069 59282 (GIT-BRANCH-NUM 51079 . 51652) (GIT-CHECKOUT 51654 . 52166) (GIT-WHICH-BRANCH
|
||||
52168 . 52466) (GIT-MAKE-BRANCH 52468 . 54212) (GIT-BRANCHES 54214 . 55595) (GIT-BRANCH-EXISTS? 55597
|
||||
. 56301) (GIT-PICK-BRANCH 56303 . 56631) (GIT-PRC-MENU 56633 . 58261) (GIT-PULL-REQUESTS 58263 .
|
||||
59280)) (59312 62647 (GIT-MY-CURRENT-BRANCH 59322 . 59692) (GIT-MY-BRANCHP 59694 . 60199) (
|
||||
GIT-MY-NEXT-BRANCH 60201 . 60695) (GIT-MY-BRANCHES 60697 . 62645)) (62693 66645 (GIT-ADD-WORKTREE
|
||||
62703 . 64187) (GIT-REMOVE-WORKTREE 64189 . 65119) (GIT-LIST-WORKTREES 65121 . 65925) (WORKTREEDIR
|
||||
65927 . 66643)) (66693 94417 (GIT-GET-DIFFERENT-FILES 66703 . 72429) (GIT-COMPARE-BRANCHES 72431 .
|
||||
78145) (GIT-COMPARE-WITH-WORKINGMEDLEY 78147 . 82612) (GIT-COMPARE-WORKTREE 82614 . 86487) (
|
||||
GITCDOBJBUTTONFN 86489 . 90979) (GIT-CD-LABELFN 90981 . 92063) (GIT-CD-MENUFN 92065 . 94415)) (94487
|
||||
97470 (CDGITDIR 94497 . 94875) (GIT-COMMAND 94877 . 96463) (GITORIGIN 96465 . 97162) (GIT-INITIALS
|
||||
97164 . 97468)))))
|
||||
(FILEMAP (NIL (3384 17231 (GIT-CLONEP 3394 . 4657) (GIT-MAKE-PROJECT 4659 . 12771) (GIT-GET-PROJECT
|
||||
12773 . 14110) (GIT-PROJECT-PATH 14112 . 15156) (FIND-ANCESTOR-DIRECTORY 15158 . 15507) (
|
||||
GIT-FIND-CLONE 15509 . 16590) (GIT-MAINBRANCH 16592 . 16876) (GIT-MAINBRANCH? 16878 . 17229)) (23164
|
||||
25952 (ALLSUBDIRS 23174 . 24460) (MEDLEYSUBDIRS 24462 . 25155) (GITSUBDIRS 25157 . 25950)) (25953
|
||||
30743 (TOGIT 25963 . 27369) (FROMGIT 27371 . 28352) (GIT-DELETE-FILE 28354 . 29200) (
|
||||
MYMEDLEY-DELETE-FILES 29202 . 30741)) (30744 33276 (MYMEDLEYSUBDIR 30754 . 31210) (GITSUBDIR 31212 .
|
||||
31655) (STRIPDIR 31657 . 32028) (STRIPHOST 32030 . 32270) (STRIPNAME 32272 . 33025) (STRIPWHERE 33027
|
||||
. 33274)) (33277 35179 (GFILE4MFILE 33287 . 33650) (MFILE4GFILE 33652 . 34221) (GIT-REPO-FILENAME
|
||||
34223 . 35177)) (35228 43029 (GIT-COMMIT 35238 . 36064) (GIT-PUSH 36066 . 36710) (GIT-PULL 36712 .
|
||||
37324) (GIT-APPROVAL 37326 . 37675) (GIT-GET-FILE 37677 . 40196) (GIT-FILE-EXISTS? 40198 . 41142) (
|
||||
GIT-REMOTE-UPDATE 41144 . 41868) (GIT-REMOTE-ADD 41870 . 42177) (GIT-FILE-DATE 42179 . 43027)) (43059
|
||||
51650 (GIT-BRANCH-DIFF 43069 . 47821) (GIT-COMMIT-DIFFS 47823 . 48267) (GIT-BRANCH-RELATIONS 48269 .
|
||||
51648)) (51695 60630 (GIT-BRANCH-NUM 51705 . 52278) (GIT-CHECKOUT 52280 . 52792) (GIT-WHICH-BRANCH
|
||||
52794 . 53092) (GIT-MAKE-BRANCH 53094 . 54838) (GIT-BRANCHES 54840 . 56331) (GIT-BRANCH-EXISTS? 56333
|
||||
. 57037) (GIT-PICK-BRANCH 57039 . 57367) (GIT-PRC-MENU 57369 . 58997) (GIT-PULL-REQUESTS 58999 .
|
||||
60016) (GIT-SHORT-BRANCH-NAME 60018 . 60309) (GIT-LONG-NAME 60311 . 60628)) (60660 63995 (
|
||||
GIT-MY-CURRENT-BRANCH 60670 . 61040) (GIT-MY-BRANCHP 61042 . 61547) (GIT-MY-NEXT-BRANCH 61549 . 62043)
|
||||
(GIT-MY-BRANCHES 62045 . 63993)) (64041 67993 (GIT-ADD-WORKTREE 64051 . 65535) (GIT-REMOVE-WORKTREE
|
||||
65537 . 66467) (GIT-LIST-WORKTREES 66469 . 67273) (WORKTREEDIR 67275 . 67991)) (68041 97537 (
|
||||
GIT-GET-DIFFERENT-FILES 68051 . 73876) (GIT-BRANCHES-COMPARE-DIRECTORIES 73878 . 79720) (
|
||||
GIT-WORKING-COMPARE-DIRECTORIES 79722 . 84188) (GIT-COMPARE-WORKTREE 84190 . 88063) (GITCDOBJBUTTONFN
|
||||
88065 . 92555) (GIT-CD-LABELFN 92557 . 93639) (GIT-CD-MENUFN 93641 . 95848) (GIT-WORKING-COMPARE-FILES
|
||||
95850 . 96369) (GIT-BRANCHES-COMPARE-FILES 96371 . 97535)) (97607 100590 (CDGITDIR 97617 . 97995) (
|
||||
GIT-COMMAND 97997 . 99583) (GITORIGIN 99585 . 100282) (GIT-INITIALS 100284 . 100588)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -30,10 +30,10 @@ If MEDLEYDIR is defined,
|
||||
|
||||
For convenience, if PROJECTPATH is NIL or T (and not a path), then a squence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory):
|
||||
(UNIX-GETENV PROJECTNAME)
|
||||
(UNIX-GETENV (CONCAT PROJECTNAME 'DIR)
|
||||
(UNIX-GETENV (CONCAT PROJECTNAME 'DIR)
|
||||
(CONCAT MEDLEYDIR "../git-" PROJECTNAME)
|
||||
(a sister of MEDLEYDIR named git-PROJECTNAME, e.g. git-notecards)
|
||||
Thus:
|
||||
Thus:
|
||||
If MEDLEYDIR is defined,
|
||||
(GIT-MAKE-PROJECT 'MEDLEY) will make the MEDLEY project
|
||||
If NOTECARDS is defined
|
||||
@@ -57,11 +57,12 @@ bbc branch1 branch2 (project) [command]
|
||||
prc rmk15
|
||||
brings up a lispusers/COMPAREDIRECTORIES browser for the files that currently differ between origin/rmk15 and origin/master. If the selected files are Lisp source files, the Compare item on the file browser menu will show the differences in a lispusers/COMPARESOURCES browser. The differences for other file types will be shown in a lispusers/COMPARETEXT browser.
|
||||
If branch is not specified and the shell command gh is available, then a menu of open pull-request branches will be provided. If gh is not available, the menu will offer all known branches. If the optional DRAFT is provided, then the menu will include draft PR's as well as open ones.
|
||||
If one PR, say rmk15, contains all the commits of another (rmk14), then the menu will indicate this by
|
||||
rmk15 > rmk14
|
||||
Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
|
||||
Note that the prc comparison is read-only: any comments, approvals, or merges of the branch must be specified using the normal Medley-external git interfaces and commands.
|
||||
|
||||
prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
|
||||
prc is the special case of the more general bbc command ("branch-branch compare) for comparing the files in any two branches:
|
||||
bbc branch1 branch2 (project) [command]
|
||||
This compares the files in branch1 and branch2, for example
|
||||
bbc rmk15 lmm12 (local)
|
||||
This will compare the files in origin/rmk15 and origin/lmm12 in the GIT-DEFAULT project. branch1 defaults to the origin files of the currently checked out branch, the second defaults to origin/master. If local is non-NIL, then a branch that has neither local/ or origin/ prepended will default to local (e.g. local/rmk15) instead of origin/. Local refers to the files that are currently in the clone directory, which may not be the same as the origin files, depending on the push/pull status.
|
||||
@@ -69,25 +70,25 @@ b? (project) [command]
|
||||
|
||||
The command cob ("check out branch") checks out a specified branch:
|
||||
cob branch (nexttitlestring) (project) [command]
|
||||
This checks out branch of project and then executes git pull. The branch parameter may also be a local branch, T (= the current working branch), or NEW/NEXT (= the next working branch). The current working branch is the branch named <initials>nnn, e.g. rmk15. The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials.
|
||||
This checks out branch of project and then executes git pull. The branch parameter may also be a local branch, T (= the current working branch), or NEW/NEXT (= the next working branch). The current working branch is the branch named <initials>nnn, e.g. rmk15. The initials are the value of INITIALS as used for SEDIT time stamps, and nnn is the largest of the integers of all of the branches beginning with those initials.
|
||||
If branch is NEW or NEXT, then a new initialed branch is created and becomes the user's current branch. Its number is one greater than the largest number of previous initialed branches. If nexttitlestring is provided, then that string will be appended to the name of the branch, after the initials and next number, and two hyphens. Spaces in nexttitlestring will also be replaced by hyphens, according to git conventions.
|
||||
If branch is not provided, a menu of locally available branches pops up.
|
||||
|
||||
The currently checked out branch is obtained by the b? command:
|
||||
b? (project) [command]
|
||||
|
||||
Correlating git source control with separate Medley development
|
||||
Correlating git source control with separate Medley development
|
||||
It is generally unsafe to do Medley development by operating with files in a local clone repository. Medley provides a residential development environment that integrates tightly with the local file system. It is important to have consistent access to the source files of the currently running system, especially for files whose contents have been only partially loaded. A git pull or a branch switch that introduces new versions of some files or removes old files altogether can lead to unpredictable disconnects that are hard to recover from. This is true also because development can go on in the same Medley memory image for days if not weeks, so it is important to have explicit control of any file version changes.
|
||||
GITFNS mitigates the danger by conventions that separate the files in the git clone from the files in the working Medley development directory. The location of the Medley development source tree for a project is given by the WORKINGPATH argument to GIT-MAKE-PROJECT. If WORKINGPATH is T or NIL and there exists a directory >working-projectname> as a sister to the clone, then that is taken to be the WORKINGPATH and thus the prefix for a pseudohost {Wprojectname}.
|
||||
When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR (or {WMEDLEY}) as a prefix. In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR.
|
||||
When Medley development is carried out in the WORKINGPATH, the variable MEDLEYDIR should point initially to the working directory, and the directory search paths (DIRECTORIES, LISPUSERSDIRECTORIES, FONTDIRECTORIES, etc.) all have MEDLEYDIR (or {WMEDLEY}) as a prefix. In that case, the clone for the project, if PROJECTPATH doesn't specify it explicitly, should be located at the >git-medley> sister directory of MEDLEYDIR.
|
||||
Any back and forth transfer of information between the git clone and Medley development must be done by explicit synchronization actions. Crucially, Medley-updated files do not appear in the clone directories and new clone files do not move to the Medley directories without user intervention.
|
||||
The files in Medley working tree and the git clone of a project can be compared with the gwc ("git-working-compare") command:
|
||||
gwc subdirectories (project) [command]
|
||||
This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
|
||||
This produces a browser for all the files in the corresponding WORKINGPATH subdirectories that differ from the files in the currently checked out branch of the git clone. If subdirectories is omitted, it defaults to the DEFAULTSUBDIRS of the project. If it is ALL, then files in all subdirectories that are not found in the project's EXCLUSIONS are compared.
|
||||
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}.
|
||||
If master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.
|
||||
Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
|
||||
GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
|
||||
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))
|
||||
. È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD MODERN
|
||||
TIMESROMAN $ TERMINAL MODERN
|
||||
In addition to the commands for comparing and viewing files, the menu for this browser also has commands for copying files from the git clone {Gprojectname} to {Wprojectname} and deleting files from {Wprojectname}.
|
||||
If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits.
|
||||
Note that the menu item for deleting Medley files will cause all version to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname}<deletion> subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files.
|
||||
GITFNS does not (yet?) include functions for commits, pushes, or merges for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons.
|
||||
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))
|
||||
. È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È 4 È È . È . Š Š8 . Š Š8 J È È PAGEHEADING RUNNINGHEAD TERMINAL
|
||||
MODERN
|
||||
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Feb-2022 14:36:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;116 46252
|
||||
(FILECREATED "20-May-2022 16:35:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>comparetext.;118 46470
|
||||
|
||||
:CHANGES-TO (FNS COMPARETEXT.WINDOW)
|
||||
:CHANGES-TO (FNS IMCOMPARE.BOXNODE)
|
||||
|
||||
:PREVIOUS-DATE "19-Feb-2022 12:01:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115)
|
||||
:PREVIOUS-DATE "25-Feb-2022 14:36:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>comparetext.;116)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -193,20 +193,26 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
X])
|
||||
|
||||
(IMCOMPARE.BOXNODE
|
||||
[LAMBDA (WINDOW NODE1 NODE2) (* ; "Edited 25-Dec-2021 12:01 by rmk")
|
||||
[LAMBDA (WINDOW NODE1 NODE2)
|
||||
|
||||
(* ;; "Edited 20-May-2022 16:35 by rmk: Invert nodes rather than FLIPNODES, so they stay inverted when scrolled")
|
||||
|
||||
(* ;; "Edited 25-Dec-2021 12:01 by rmk")
|
||||
(* rmk%: "14-Dec-84 13:40")
|
||||
|
||||
(* ;; "Marks NODE1 and NODE2 as having been selected, removing marks on previous nodes.")
|
||||
|
||||
(LET [(LASTNODES (WINDOWPROP WINDOW 'LASTNODES] (* ; "FLIPNODE ?")
|
||||
(CL:WHEN (CAR LASTNODES)
|
||||
(FLIPNODE (CAR LASTNODES)
|
||||
WINDOW))
|
||||
(RESET/NODE/LABELSHADE (CAR LASTNODES)
|
||||
'INVERT WINDOW))
|
||||
(CL:WHEN (CADR LASTNODES)
|
||||
(FLIPNODE (CADR LASTNODES)
|
||||
WINDOW))
|
||||
(CL:WHEN NODE1 (FLIPNODE NODE1 WINDOW))
|
||||
(CL:WHEN NODE2 (FLIPNODE NODE2 WINDOW))
|
||||
(RESET/NODE/LABELSHADE (CADR LASTNODES)
|
||||
'INVERT WINDOW))
|
||||
(CL:WHEN NODE1
|
||||
(RESET/NODE/LABELSHADE NODE1 'INVERT WINDOW))
|
||||
(CL:WHEN NODE2
|
||||
(RESET/NODE/LABELSHADE NODE2 'INVERT WINDOW))
|
||||
(WINDOWPROP WINDOW 'LASTNODES (LIST NODE1 NODE2])
|
||||
|
||||
(IMCOMPARE.CHUNKS
|
||||
@@ -737,12 +743,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1344 38872 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6357) (
|
||||
COMPARETEXT.TEXTOBJ 6359 . 9067) (COMPARETEXT.SETSEL 9069 . 9859) (CHUNKNODELABEL 9861 . 10982) (
|
||||
IMCOMPARE.BOXNODE 10984 . 11751) (IMCOMPARE.CHUNKS 11753 . 16129) (IMCOMPARE.COLLECT.HASH.CHUNKS 16131
|
||||
. 19048) (IMCOMPARE.DISPLAYGRAPH 19050 . 26893) (IMCOMPARE.HASH 26895 . 31082) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 31084 . 34580) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34582 . 36537) (
|
||||
IMCOMPARE.SHOW.DIST 36539 . 36985) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36987 . 38870)) (38873 45030 (
|
||||
IMCOMPARE.LEFTBUTTONFN 38883 . 41460) (IMCOMPARE.MIDDLEBUTTONFN 41462 . 44578) (IMCOMPARE.COPYBUTTONFN
|
||||
44580 . 45028)) (45083 45774 (TAIL1 45093 . 45447) (TAIL2 45449 . 45772)))))
|
||||
(FILEMAP (NIL (1353 39090 (COMPARETEXT 1363 . 2863) (COMPARETEXT.WINDOW 2865 . 6366) (
|
||||
COMPARETEXT.TEXTOBJ 6368 . 9076) (COMPARETEXT.SETSEL 9078 . 9868) (CHUNKNODELABEL 9870 . 10991) (
|
||||
IMCOMPARE.BOXNODE 10993 . 11969) (IMCOMPARE.CHUNKS 11971 . 16347) (IMCOMPARE.COLLECT.HASH.CHUNKS 16349
|
||||
. 19266) (IMCOMPARE.DISPLAYGRAPH 19268 . 27111) (IMCOMPARE.HASH 27113 . 31300) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 31302 . 34798) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34800 . 36755) (
|
||||
IMCOMPARE.SHOW.DIST 36757 . 37203) (IMCOMPARE.UPDATE.SYMBOL.TABLE 37205 . 39088)) (39091 45248 (
|
||||
IMCOMPARE.LEFTBUTTONFN 39101 . 41678) (IMCOMPARE.MIDDLEBUTTONFN 41680 . 44796) (IMCOMPARE.COPYBUTTONFN
|
||||
44798 . 45246)) (45301 45992 (TAIL1 45311 . 45665) (TAIL2 45667 . 45990)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user