github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-01 14:06:47 +00:00
Code Issues Projects Releases Wiki Activity

Rmk47: TEDIT, GITFNS, COREIO (#791)

Browse Source 
* 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
2022-06-13 15:20:41 -07:00
committed by GitHub
parent f262c98f53
commit 3c7fb08932
13 changed files with 550 additions and 470 deletions
Download Patch File Download Diff File Expand all files Collapse all files

278
lispusers/COMPAREDIRECTORIES
View File

@@ -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