From fe90ac5f9f0a8e582b47edff80d5160f223574b6 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 31 Jan 2022 09:51:50 -0800 Subject: [PATCH] Rmk19 (#664) * PSEUDOHOSTS: Overlay a file system at the end of a path in another file system New package, please look through it. * REGIONMANAGER: added RELCREATEPOSITION, allow for arguments to be spread If the WIDTH argument looks like a list of arguments, the arguments are spread out. Means that a relative region can be passed through intermediate functions. * EXAMINEDEFS: More control over regions and windows Examination windows are returned so that callers can manipulate them * TEDIT-PF-SEE: tf respects reader environment and bold faces of DEFUN and DEFMACRO names * COMPAREDIRECTORIES: refactored for more flexibility and easier maintenance Also, based on SPY, made more internal operations work on streams that are located and created once, rather than on file Added CDMERGE to merge CDVALUES for different subdirectories, to permit scrolling of all differences in a single browser window * COMPARESOURCES: Region for CS browser is passed through, window is returned Also tried to eliminate mismatching of simple edit timestamps * COMPARETEXT: Files can be input streams, region is passed in, window is returned * COMPAREDIRECTORIES again: Fixed a promptwindow bug * GITFNS: New package for comparing and copying back and forth from My Medley to the git clone * REGIONMANAGER: Added CLOSEWITH and MOVEWITh Primitives for building hierarchically dependent window clusters * PSEUDOHOSTS: Added PSEUDOHOSTNAME, hierarchical hosts #663 For hierarchical hosts (hosts whose prefixes are extensions of the prefixes of other pseudohosts), always the pseudofilename is always the shortest one. See #663 for more details * EXAMINEDEFS: Fix prettyprint of non-function expressions * GITFNS, Comparison files: Use CLOSEWITH and MOVEWITH abstractions for window hierarchies --- lispusers/COMPAREDIRECTORIES | 179 ++++++++++++----------- lispusers/COMPAREDIRECTORIES.LCOM | Bin 37443 -> 37090 bytes lispusers/COMPARESOURCES | 56 ++++---- lispusers/COMPARESOURCES.LCOM | Bin 17248 -> 17097 bytes lispusers/COMPARETEXT.LCOM | Bin 11940 -> 11478 bytes lispusers/EXAMINEDEFS | 51 ++++--- lispusers/EXAMINEDEFS.LCOM | Bin 3625 -> 3953 bytes lispusers/GITFNS | 60 ++++---- lispusers/GITFNS.LCOM | Bin 27253 -> 27015 bytes lispusers/PSEUDOHOSTS | 226 ++++++++++++++++++------------ lispusers/PSEUDOHOSTS.LCOM | Bin 7525 -> 8188 bytes lispusers/PSEUDOHOSTS.TEDIT | Bin 5636 -> 6268 bytes lispusers/REGIONMANAGER | 55 ++++++-- lispusers/REGIONMANAGER.LCOM | Bin 7770 -> 8691 bytes lispusers/REGIONMANAGER.TEDIT | 61 +++++++- lispusers/comparetext | 58 +++----- 16 files changed, 418 insertions(+), 328 deletions(-) diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 5f201f88..15706739 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Jan-2022 17:47:36"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;160 112621 +(FILECREATED "29-Jan-2022 00:03:59"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;169 111694 - :CHANGES-TO (FNS CD.COMMANDSELECTEDFN) + :CHANGES-TO (FNS CD-MENUFN) + (VARS CDTABLEBROWSER.MENUITEMS) - :PREVIOUS-DATE "26-Jan-2022 15:33:55" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;159) + :PREVIOUS-DATE "28-Jan-2022 17:12:22" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;162) (* ; " @@ -1587,7 +1588,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CDBROWSER [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS) - (* ;; "Edited 25-Jan-2022 13:05 by rmk: a table browser for the differences in CDVALUE.") + (* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.") (* ;; "Creates a table browser for the differences in CDVALUE.") @@ -1613,25 +1614,18 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp FINALLY (RETURN (WIDTHIFWINDOW (IMAX $$EXTREME (STRINGWIDTH " CD commands " DEFAULTFONT] + + (* ;; "2 allows for the prompt window") + [SETQ REGION (GETREGION (PLUS TB.LEFT.MARGIN ITEMWIDTH (TIMES 2 WBorder) MENUWIDTH) - (TIMES (IMAX (IMIN 15 (LENGTH STRINGS)) - (ADD1 (LENGTH MENUITEMS))) + (TIMES (IPLUS 2 (IMAX (IMIN 15 (LENGTH STRINGS)) + (LENGTH MENUITEMS))) (FONTPROP DEFAULTFONT 'HEIGHT] - - (* ;; "Promptwindow seems to do its own thing, even if under construction. So we preshrink the main window.") - - [SETQ REGION (CREATE REGION USING REGION HEIGHT _ (DIFFERENCE (FETCH (REGION HEIGHT) - OF REGION) - (FONTPROP DEFAULTFONT - 'HEIGHT] (SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare directories " (LENGTH STRINGS) " files")) NIL T)) - [WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W) - (FOR W INSIDE (WINDOWPROP W 'SUBWINDOWS) - DO (CLOSEW (WFROMDS W] (WINDOWPROP WINDOW 'UNDERCONSTRUCTION T) (* ;; "TABLEBROWSER is odd: USERDATA is a single recognized property. But it allows for other unrecognized properties in the list, it pushes them on to a list USERPROPS...and then throws it away. So here I'm using USERDATA to hold the directory lengths so they can be stripped off for display. It may actually be better to have a field name in CDVALUE for all of the shared stuff in front of the entries, and keep it all.") @@ -1816,23 +1810,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CD-MENUFN [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) - (* ;; "Edited 25-Jan-2022 10:19 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 29-Jan-2022 00:03 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.") (* ;; "The 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 . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.") + (CL:WHEN (MEMB (OR (CADDR MENUITEM) + (CAR MENUITEM)) + '(Compare See See% right See% both See% left)) + (* ; "Close the previous ones") + (CLOSEWITH.DOIT WINDOW)) (LET - (SUBWINDOWS) - (CL:WHEN (MEMB (OR (CADDR MENUITEM) - (CAR MENUITEM)) - '(Compare See% right See% both See% left)) - (FOR W IN (WINDOWPROP WINDOW 'SUBWINDOWS) WHEN (OPENWP W) DO (CLOSEW W))) - (SELECTQ (OR (CADDR MENUITEM) - (CAR MENUITEM)) - (Compare (IF (AND FILE1 FILE2) - THEN [SETQ SUBWINDOWS - (SELECTQ TYPE + (CHILDREN) + (SETQ CHILDREN + (SELECTQ (OR (CADDR MENUITEM) + (CAR MENUITEM)) + (Compare (IF (AND FILE1 FILE2) + THEN (SELECTQ TYPE (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2 (RELCREATEREGION [FIXR (TIMES 0.75 (FETCH (REGION WIDTH) @@ -1860,57 +1855,56 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (LIST LABEL1 LABEL2))) (PROGN (FLASHWINDOW T) (PRIN3 "Unable to compare, showing both" T) - (TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2] - ELSE (FLASHWINDOW T) - (PRIN3 "Only one file" T))) - (See% left (IF FILE1 - THEN (SETQ SUBWINDOWS (TEDIT-SEE FILE1 - (RELCREATEREGION - 700 700 'RIGHT 'TOP `(,WINDOW 0.5) + (TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2))) + 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 (SETQ SUBWINDOWS (TEDIT-SEE FILE2 - (RELCREATEREGION - 700 700 'LEFT 'TOP `(,WINDOW 0.5) + 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) T) - NIL - (CONCAT "SEE window for " LABEL2))) - ELSE (FLASHWINDOW T) - (PRIN3 "No file to print" T))) - (See% both (IF (AND FILE1 FILE2) - THEN (SETQ SUBWINDOWS (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 - (RELCREATEREGION - 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701) - (IPLUS (FETCH (REGION BOTTOM) - OF (WINDOWPROP WINDOW 'REGION)) - -1) - T))) - ELSE (FLASHWINDOW T) - (PRIN3 "Only one file" T))) - (Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2] - (PRIN3 (CL:IF DEST - (CONCAT "Copied to " DEST) - (PROGN (FLASHWINDOW T) - (CONCAT FILE2 " could not be copied"))) - T))) - (Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1] - (PRIN3 (CL:IF DEST - (CONCAT "Copied to " DEST) - (PROGN (FLASHWINDOW T) - (CONCAT FILE1 " could not be copied"))) - T))) - (SHOULDNT)) - (FOR W INSIDE SUBWINDOWS DO (WINDOWADDPROP WINDOW 'SUBWINDOWS (WFROMDS W]) + NIL + (CONCAT "SEE window for " LABEL2)) + ELSE (FLASHWINDOW T) + (PRIN3 "No file to print" T))) + ((See See% both) + (IF (AND FILE1 FILE2) + THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 + (RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701) + (IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW + 'REGION)) + -1) + T)) + ELSE (FLASHWINDOW T) + (PRIN3 "Only one file" T))) + (Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2] + (PRIN3 (CL:IF DEST + (CONCAT "Copied to " DEST) + (PROGN (FLASHWINDOW T) + (CONCAT FILE2 " could not be copied"))) + T))) + (Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1] + (PRIN3 (CL:IF DEST + (CONCAT "Copied to " DEST) + (PROGN (FLASHWINDOW T) + (CONCAT FILE1 " could not be copied"))) + T))) + (SHOULDNT))) + (CLOSEWITH CHILDREN WINDOW) + (MOVEWITH CHILDREN WINDOW]) ) (RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) @@ -1918,30 +1912,31 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (Copy% <- CD-MENUFN) (See% left CD-MENUFN) (See% right CD-MENUFN) - (See% both CD-MENUFN))) + (See% both CD-MENUFN) + (See CD-MENUFN))) (FILESLOAD (SYSLOAD) COMPARESOURCES COMPARETEXT) (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2497 19012 (COMPAREDIRECTORIES 2507 . 8956) (COMPAREDIRECTORIES.INFOS 8958 . 11078) ( -CDENTRIES.SELECT 11080 . 15766) (COMPAREDIRECTORIES.INFOS.TYPE 15768 . 16396) (MATCHNAME 16398 . 16928 -) (CD.INSURECDVALUE 16930 . 18544) (CD.UPDATEWIDTHS 18546 . 19010)) (19013 29285 (CDFILES 19023 . -25379) (CDFILES.MATCH 25381 . 27006) (CDFILES.PATS 27008 . 29283)) (29286 44371 (CDPRINT 29296 . 31641 -) (CDPRINT.HEADER 31643 . 32540) (CDPRINT.LINE 32542 . 35098) (CDPRINT.MAXWIDTHS 35100 . 39215) ( -CDPRINT.COLHEADERS 39217 . 39855) (CDPRINT.COLUMNS 39857 . 43736) (CDTEDIT 43738 . 44369)) (44372 -52741 (CDMAP 44382 . 45814) (CDENTRY 45816 . 46125) (CDSUBSET 46127 . 47566) (CDMERGE 47568 . 51422) ( -CDMERGE.COMMON 51424 . 52739)) (52742 60280 (BINCOMP 52752 . 57041) (EOLTYPE 57043 . 59605) ( -EOLTYPE.SHOW 59607 . 60278)) (60808 74015 (FIND-UNCOMPILED-FILES 60818 . 64461) (FIND-UNSOURCED-FILES -64463 . 67272) (FIND-SOURCE-FILES 67274 . 68978) (FIND-COMPILED-FILES 68980 . 71058) ( -FIND-UNLOADED-FILES 71060 . 71804) (FIND-LOADED-FILES 71806 . 72360) (FIND-MULTICOMPILED-FILES 72362 - . 74013)) (74016 82218 (CREATED-AS 74026 . 78823) (SOURCE-FOR-COMPILED-P 78825 . 81523) ( -COMPILE-SOURCE-DATE-DIFF 81525 . 82216)) (82219 92525 (FIX-DIRECTORY-DATES 82229 . 85222) ( -FIX-EQUIV-DATES 85224 . 86749) (COPY-COMPARED-FILES 86751 . 88572) (COPY-MISSING-FILES 88574 . 90731) -(COMPILED-ON-SAME-SOURCE 90733 . 92523)) (92719 100458 (CDBROWSER 92729 . 97353) (CDBROWSER.STRINGS -97355 . 100456)) (100620 101892 (CD.TABLEITEM 100630 . 100850) (CD.TABLEITEM.PRINTFN 100852 . 101051) -(CD.TABLEITEM.COPYFN 101053 . 101647) (CDTABLEBROWSER.HEADING.REPAINTFN 101649 . 101890)) (101893 -112086 (CDTABLEBROWSER.WHENSELECTEDFN 101903 . 102371) (CD.COMMANDSELECTEDFN 102373 . 105764) ( -CD-MENUFN 105766 . 112084))))) + (FILEMAP (NIL (2536 19051 (COMPAREDIRECTORIES 2546 . 8995) (COMPAREDIRECTORIES.INFOS 8997 . 11117) ( +CDENTRIES.SELECT 11119 . 15805) (COMPAREDIRECTORIES.INFOS.TYPE 15807 . 16435) (MATCHNAME 16437 . 16967 +) (CD.INSURECDVALUE 16969 . 18583) (CD.UPDATEWIDTHS 18585 . 19049)) (19052 29324 (CDFILES 19062 . +25418) (CDFILES.MATCH 25420 . 27045) (CDFILES.PATS 27047 . 29322)) (29325 44410 (CDPRINT 29335 . 31680 +) (CDPRINT.HEADER 31682 . 32579) (CDPRINT.LINE 32581 . 35137) (CDPRINT.MAXWIDTHS 35139 . 39254) ( +CDPRINT.COLHEADERS 39256 . 39894) (CDPRINT.COLUMNS 39896 . 43775) (CDTEDIT 43777 . 44408)) (44411 +52780 (CDMAP 44421 . 45853) (CDENTRY 45855 . 46164) (CDSUBSET 46166 . 47605) (CDMERGE 47607 . 51461) ( +CDMERGE.COMMON 51463 . 52778)) (52781 60319 (BINCOMP 52791 . 57080) (EOLTYPE 57082 . 59644) ( +EOLTYPE.SHOW 59646 . 60317)) (60847 74054 (FIND-UNCOMPILED-FILES 60857 . 64500) (FIND-UNSOURCED-FILES +64502 . 67311) (FIND-SOURCE-FILES 67313 . 69017) (FIND-COMPILED-FILES 69019 . 71097) ( +FIND-UNLOADED-FILES 71099 . 71843) (FIND-LOADED-FILES 71845 . 72399) (FIND-MULTICOMPILED-FILES 72401 + . 74052)) (74055 82257 (CREATED-AS 74065 . 78862) (SOURCE-FOR-COMPILED-P 78864 . 81562) ( +COMPILE-SOURCE-DATE-DIFF 81564 . 82255)) (82258 92564 (FIX-DIRECTORY-DATES 82268 . 85261) ( +FIX-EQUIV-DATES 85263 . 86788) (COPY-COMPARED-FILES 86790 . 88611) (COPY-MISSING-FILES 88613 . 90770) +(COMPILED-ON-SAME-SOURCE 90772 . 92562)) (92758 99800 (CDBROWSER 92768 . 96695) (CDBROWSER.STRINGS +96697 . 99798)) (99962 101234 (CD.TABLEITEM 99972 . 100192) (CD.TABLEITEM.PRINTFN 100194 . 100393) ( +CD.TABLEITEM.COPYFN 100395 . 100989) (CDTABLEBROWSER.HEADING.REPAINTFN 100991 . 101232)) (101235 +111110 (CDTABLEBROWSER.WHENSELECTEDFN 101245 . 101713) (CD.COMMANDSELECTEDFN 101715 . 105106) ( +CD-MENUFN 105108 . 111108))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 3abba64c37d846be6c5f6ef9d81c597b2dee3115..6fe1f45a31451dd3f5caf949c6468e25abf3f37e 100644 GIT binary patch delta 2785 zcma)8U5FD`6i%|P)pf0|f8C1UX;j!PB%OQbFIie)Ho4i1CNt^GBw0c5FVT(7Cfjw3 z3PMC$svuGs5c*bap?xadm3=4(q4-p2p-;s=)Cc=kD6Ee{p*{Cb5;txr&BJ8wJ?DJq z=brnWdHhx6+5O08v%8bAV`myMDp3lOG$qMXYVz&}r^Cs+KS{%}JhO`aX!zJ5E&uh1 zy;VyBAw)|m{tw~3BSJr8O~QnK|IWd~Qw4{WOuOjD(uT(%N)s=A5q*l#DM~p?M5AAx zid=lSR^Jv56aVk|%6RyfF*0T!7+NjbuxLG-}*yGP1wC(XH<+#}Tb%YE2LUYo;)%?Assyf&OW|cuz3Cu9B;Mnf~+Z! zO2<88I>$_pAeA+9X@^<&2oGb4~W0=T^)F$lMs0p*&NzrL?YqUO-8uMn@x1w zJx8=(du(T@E391L(zOT6p%-lzpHDq}{8rxgdPlHgwOwznSP~$P|NQ!amLuNx2UtID zj)d!bp47I##&Nc9=FjEGbk};kT?^--2m|M7VdDiRdEDt zHu&2an$Tqx@^*=pO(Y7PCh!*9Zg(Yto3)F%wB>R@O{3>|*cWT_v6a8VZnef43e3DSX3alowit!fgm zStD;+jC*vE$rW%|E}+y7XSP)2i<74179Gq{+-@ZyfydIO7jqeMl8*co5U--i8|*o& zykbrQGLn(O^uB=Pgt`t`MmH(D6;QgC*nli!wEf634iHXrGEx;%%epetq|}j6J<%`0 zqV$r9m6+oqiMv46PLM62N`I78=0}z<7!LE;ERGQ*{9e@xwrh$pK*_7o5xv_FL_-c- z7aiee>vqQ=!O_^mb6UaZBKS$spKKDNGG`q~Xs-yc2)&Msr)|>%qC=kLr;+3}O@&U5 zps6@9n+sQuz`HTfB&jD*u~>m1b`)AFMTQphjN-J+c%YzXw^}^{XPZlNIL2^NR;$54 zM>Rzzfts9D0=323g}EghJ4C?9JiB20@)^r<>ecg0Kqa)pPQ=mM=`J7%3SNtsnBXS{ zFFAH;8VC+S9uUF#Cj!zmaP6X#!d}EWHs=@4ELQnI(s<4rdIcKIB{*Bf#X_xG ziGr5UA&NQT0+yPnrQx9t)NP>*Yu~4=V#`PEM*S)@8&xqKqa)%2XF`gr5Yr_x2@3XA zl;4lbwMM0R8O}Es(E%UtTnXjK4pFNqta%6vi?zlQ&RG1==rcPi>}2dgVK;)Uofu?D z6KL2U6E?Bz-@18t6t7v}lxVvD{mnyf;U@)d5Q=f&C6nTq4_=swPVMki9=^Ew`Icdr L!1M7xz5D22t1_x$ delta 2989 zcmaJ@U1%fM71oTLZR+eg*4mqR-GrPt*PU1&;(TH5XwvJY7X7D}PCP78f0*j^0XP!Oek3G}rgPb~!cR7w;2(zo>7J0q`U zrxkcSbI-lsIp@3Qp6`D0OZkt#lHXgOG4sz~?d3H^(?B&>sJTLn+i$)iDYyTu#CP90 zA7`cN7tM)Zmb`fdR8=!H6;?`B%UNSVK6GKR;slfN-a8k*x&$kp&lA5#D_?zU9Tu!RC zelgw3?%wPCP`X!@e`kN0kBi4}@9&vKQiM{?4OkNhg=WQf>*WAc1=d*Dw4Jisi~{C+ zzUwVbF6t0Ot2jD=!@=DbH!n(3JO0jAYfhfXsX6zt>|x--`76^br(STM&K`E+&$hlE zFZ2xQ-FTz-OtruHFcY5N{P@b;u;tEuwmWp^n#*GBBN6bGsg~qU$^0*Q$Wm(m3m=l@ zdHlt{?kznel6;6KQ;$FFeKIhVBDfxNnqVk|hmS$my)+5Xizawc`o+@$y`X~?hE}Os zXHEpPP=IiCxo%x%%d0--$9$ls0WVn|f|fO)ssW|)a%ipAm>se@kYeE&t47A;bEdm_u{g&Q7w>TRHgiR3h_TEy@j zJtBQr$`(+4oVDeW>un$~)m7vod8J1D^IMM$C{@A3ghDhE%=>iIq=1Xc>Fy+FfZ!I1 z`mH!vpr9)%EZ`h?t-rN(wb#0iUqmpaMEn>>5+?%@A+6Q(!{PT4gmp zSV&&^Xc0I~OOSnX;!I{DH=VJtxDO{Rsn5$-)cwJQ@c5~f?d;+AW=7Lm!u09xzI173 z813$7{?ow6znkY%!$Er(H9F0y=Cl9|m$%dhuvgY0Ch!}d#|R}-;8Ey=vst#!r!yPp;*KN>&(xe zdw_f0d-4ll5ra=U%O|YwOMi<0@PnC$rQeQxyfBOoALV0n(z`wR_sQ^>)A%3Xzxa4_ zO1K-LIQN$~M$4c1-^*WYP9I;M`R8c)#xOc~u5s{uO1W-`Phm|MpV_O5b)O!rBs_Pb{|gYE0{HQR zoYvu>n#;*Hib3{$`-9GpZ0Q4AzLykTvi$;fxcAr0qFFrI#!T!YBXKbG0t8hzs+FA( zOgzW@&=N2ywu+>?nS?;4W(C#ste7gA2K=<+fdLcM#j{G6`G;fG85r0#6AYuEj4%wN zFot31+>}BX=xZE8Esh`*b8H=N{A}H-+XIJjj{!=73O=hPT{-Qux@p2owi84?OJmki z=tEYv!+gLP=qmQNBspE7r#;f`4ld2p0XzQOzeRUkllK^{evT48+4G?QY&bfdkaVB%FFWdjUUwNn4uTbJP3JQ$>K-=Gyz zL;jnf8#GZ)y@(24K~W?c1nu@Ec(uRN!7GC)%v2~fnkg!%Fb}r7Z*+F>ilB%I#MD#e zCFn}b*lfSP0~#@)W;+bDQJH{-yD2t7E$}L=dsxP0Q1RZtC0xbQ7lD{~A#fwVgw=}2 zEtNP7JxzBKC5%g?NtM{TF*j=>J}Tk0Zo36LeN;%p)X{L!#L68XR|zb*z0J3v-)jpU zU6{m+g93}nvJQDuQJ3(1DDmwZvuCl2_~;VqJB{~m%x0-d&@eN_Z$`p0$@Lgb7aq}0 z!GcyO#COMPARESOURCES.;115 41781 +(FILECREATED "28-Jan-2022 18:22:40"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270 :CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN) - :PREVIOUS-DATE "24-Jan-2022 23:12:17" {MM}COMPARESOURCES.;113) + :PREVIOUS-DATE "28-Jan-2022 17:12:39" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116) (* ; " @@ -35,13 +37,9 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (DEFINEQ (COMPARESOURCES - [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 26-Dec-2021 21:32 by rmk") - (* ; "Edited 20-Dec-2021 09:51 by rmk") - (* ; "Edited 9-Dec-2021 23:13 by rmk") - (* ; "Edited 4-Dec-2021 19:54 by rmk") - (* ; "Edited 23-Nov-2021 19:46 by rmk:") - (* ; "Edited 30-Oct-2021 20:13 by rmk:") - (* ; "Edited 19-Apr-2018 10:49 by rmk:") + [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 28-Jan-2022 17:10 by rmk") + (* ; "Edited 26-Dec-2021 21:32 by rmk") + (* ; "Edited 19-Apr-2018 10:49 by rmk:") (* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream") @@ -92,7 +90,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. 'DECLARE%:] (SETQ BODYY (CL:SET-DIFFERENCE BODYY DECLAREY)) (WITH-READER-ENVIRONMENT (OR ENVX ENVY (MAKE-READER-ENVIRONMENT)) - (\CS.COMPARE.MASTERS BODYX BODYY DW? CONTEXTSTREAM COMPARESTREAM) + (\CS.COMPARE.MASTERS BODYX BODYY DW?) (* ;; "Done with the non-DECLARE: expressions. Nw sort what's left according to when it is eval'ed so that we can hopefully further reduce the amount of stuff to compare") @@ -125,7 +123,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.  "REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order") (\CS.COMPARE.MASTERS (REVERSE X) (REVERSE Y) - DW? CONTEXTSTREAM COMPARESTREAM] + DW?] (TERPRI CONTEXTSTREAM)) (SELECTQ INSERTOBJECTS (OBJECTWINDOW (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM)) @@ -554,7 +552,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. ELSE (ADD LINELENGTH (CHARWIDTH C FONT]) (CSOBJ.BUTTONEVENTINFN - [LAMBDA (OBJ WINDOW) (* ; "Edited 25-Jan-2022 16:04 by rmk") + [LAMBDA (OBJ WINDOW) (* ; "Edited 28-Jan-2022 18:22 by rmk") + (* ; "Edited 25-Jan-2022 16:04 by rmk") (* ; "Edited 23-Jan-2022 18:11 by rmk") (LET [(COMPAREDATA (IMAGEOBJPROP OBJ 'COMPAREDATA] @@ -578,8 +577,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (LET [EWINDOW (RELPOS (RELCREATEPOSITION `(,WINDOW 0.5) `(,WINDOW 0 -2] - (CL:WHEN [WINDOWP (SETQ EWINDOW (WINDOWPROP WINDOW 'EXAMINEWINDOW] - (CLOSEW EWINDOW)) + (CLOSEWITH.DOIT WINDOW) (SETQ EWINDOW (IF (IMAGEOBJPROP OBJ 'ONLYONE) THEN @@ -595,10 +593,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. 'TOP RELPOS NIL T] ELSE (* ; "Spread the arguments") (EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 RELPOS))) - (WINDOWPROP WINDOW 'EXAMINEWINDOW EWINDOW) - (WINDOWADDPROP WINDOW 'CLOSEFN [FUNCTION (LAMBDA (W) - (CLOSEW (WINDOWPROP W 'EXAMINEWINDOW] - T) + (CLOSEWITH EWINDOW WINDOW) + (MOVEWITH EWINDOW WINDOW) EWINDOW)))]) (CSOBJ.COPYBUTTONEVENTINFN @@ -690,16 +686,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 (1768 27559 (COMPARESOURCES 1778 . 8291) (\CS.COMPARE.MASTERS 8293 . 16437) ( -\CS.COMPARE.TYPES 16439 . 19577) (\CS.EXAMINE 19579 . 23806) (\CS.FIXFNS 23808 . 25310) ( -\CS.SORT.DECLARES 25312 . 25655) (\CS.SORT.DECLARE1 25657 . 27077) (\CS.FILTER.GARBAGE 27079 . 27557)) - (27560 31540 (\CS.ISFNFORM 27570 . 27838) (\CS.COMPARE.FNS 27840 . 28082) (\CS.FNSID 28084 . 28228) ( -\CS.ISVARFORM 28230 . 28335) (\CS.COMPARE.VARS 28337 . 28999) (\CS.ISMACROFORM 29001 . 29139) ( -\CS.ISRECFORM 29141 . 29234) (\CS.ISCOURIERFORM 29236 . 29336) (\CS.ISTEMPLATEFORM 29338 . 29436) ( -\CS.COMPARE.TEMPLATES 29438 . 29803) (\CS.ISPROPFORM 29805 . 29960) (\CS.PROP.NAME 29962 . 30107) ( -\CS.COMPARE.PROPS 30109 . 30266) (\CS.ISADDVARFORM 30268 . 30361) (\CS.COMPARE.ADDVARS 30363 . 30528) -(\CS.ISFPKGCOMFORM 30530 . 30737) (\CS.COMPARE.FPKGCOMS 30739 . 30946) (\CS.COMPARE.DEFINE-FILE-INFO -30948 . 31538)) (31541 37731 (CSOBJ.CREATE 31551 . 31964) (CSOBJ.DISPLAYFN 31966 . 32719) ( -CSOBJ.IMAGEBOXFN 32721 . 34882) (CSOBJ.BUTTONEVENTINFN 34884 . 37481) (CSOBJ.COPYBUTTONEVENTINFN 37483 - . 37729)) (38595 41299 (CSBROWSER 38605 . 41297))))) + (FILEMAP (NIL (1850 27174 (COMPARESOURCES 1860 . 7906) (\CS.COMPARE.MASTERS 7908 . 16052) ( +\CS.COMPARE.TYPES 16054 . 19192) (\CS.EXAMINE 19194 . 23421) (\CS.FIXFNS 23423 . 24925) ( +\CS.SORT.DECLARES 24927 . 25270) (\CS.SORT.DECLARE1 25272 . 26692) (\CS.FILTER.GARBAGE 26694 . 27172)) + (27175 31155 (\CS.ISFNFORM 27185 . 27453) (\CS.COMPARE.FNS 27455 . 27697) (\CS.FNSID 27699 . 27843) ( +\CS.ISVARFORM 27845 . 27950) (\CS.COMPARE.VARS 27952 . 28614) (\CS.ISMACROFORM 28616 . 28754) ( +\CS.ISRECFORM 28756 . 28849) (\CS.ISCOURIERFORM 28851 . 28951) (\CS.ISTEMPLATEFORM 28953 . 29051) ( +\CS.COMPARE.TEMPLATES 29053 . 29418) (\CS.ISPROPFORM 29420 . 29575) (\CS.PROP.NAME 29577 . 29722) ( +\CS.COMPARE.PROPS 29724 . 29881) (\CS.ISADDVARFORM 29883 . 29976) (\CS.COMPARE.ADDVARS 29978 . 30143) +(\CS.ISFPKGCOMFORM 30145 . 30352) (\CS.COMPARE.FPKGCOMS 30354 . 30561) (\CS.COMPARE.DEFINE-FILE-INFO +30563 . 31153)) (31156 37220 (CSOBJ.CREATE 31166 . 31579) (CSOBJ.DISPLAYFN 31581 . 32334) ( +CSOBJ.IMAGEBOXFN 32336 . 34497) (CSOBJ.BUTTONEVENTINFN 34499 . 36970) (CSOBJ.COPYBUTTONEVENTINFN 36972 + . 37218)) (38084 40788 (CSBROWSER 38094 . 40786))))) STOP diff --git a/lispusers/COMPARESOURCES.LCOM b/lispusers/COMPARESOURCES.LCOM index 8df19dbfd6efaa41d0ae4a44959086f62c51e863..63169175a8770cc40e2900d30c042e924fac6c80 100644 GIT binary patch delta 1340 zcmbVM%WvF77>~0_SrRCLrXeB``Y=V>RN9qi?D33ESupk_aq7picA8X*NVnZZDeR+d z${|81QYGL5Qs|uF58!}^wj6puJ#gv`u3UfvHxLznK*g+g-L4Q9uw;Ml-}ji$^UKG| z{g0HR?Sz##8r?G1Fb2eIjBP_xp`>2vb*^1)x0=xFf(kPqc**$>&u#9vZtPdzYg}tL zy49d}rO~c-TFrLrK(CN$=b$_ks^U9kd5Nunip|I1Shsb{CYA*I{H}30W~o#vDl{86 zWwL)p7@Dma>dH)M)epE^=T6E!>GZEP|EC(2tjH%A7zk5M>?yCh+t2^%JUJnsubrzi1A2M#PT|(E(igW1e=R?V)#rBSf_N@7?S#*wQ!y02 zl@1dR#nBW|X2t!f^Do`Lw~=AI`{4Gma(&2Wig@9L-GyW2k_e|4w@fdt&?K>>%mA7$$e&_+dwg6K@>qQ0EtTJ>g*KCam+I1{P)`MzbJ(bED#TUg$&@ z(|8M*#lXuW7{jpRCKWdhYfhb4LMKTj6fkN&LS?2k#v_mpwYm?C7$9l1gn$`1V9#PL9J(2JH_Q4Tz4!+2V^U$bvPV4mPls*1@o>9L1p4<8zwbM}8=d`f_Na2`8kEZA6<`_y zHP;f^iwfP|P3io8x2Xalq^~^n`x$W=eX20=Ct5sxrkJhMrNOs7^;@=(&xmFG*>tv# z;(NSz*mSaOju&z|w>LLY(lr8Me1UKI={jJGf*ZuiNMa25wiEgh_xNf8m?B69ld|Q| z%Ugcr$t}dDIZ|dOz=X*q3x)?(=WBi(0hTwITZ%WM6p+l|ht3+8r&+7VHF>kiv&~ah wyx330l<_6TayqFrV?&34ucm-?3Uz;NU2+-&dxVTE3~>}(j3eHEnY?!LZw^0N?*IS* delta 1485 zcmZuw&u`pB6plC9q}c}4AhJLL=wTJHi?l1xjK?0EM#QXV69=!owH-Evh%_{Xq-qlc z=>Z`W2?@BAA7zBNfjAcsQBVaE(w_MrI3NTUgeZb5sul*26Qj4iy#a zhdx-dDYlWR!p&dwbarwH+DaBo9o~dZpI(eBO$5#x*aFD zkc2(3G#%W+gE1y1$ES9gc^HM6_#h%PbVzvAjXYq~1i1zXm`)3eFj#TAT^_g?7-rD& z?U*MG*K4W#htOyUDGg+fw{j)FvLzAhb=IeQJB;^;6)i5 zB%o%&keXVNipm${v?(QpMJ#B=XjKe5ty1eB(5syKq=pHd^^NA^gjkYe-_SuY~KajGvcWWXTE<2IN~ z1AczV@g3g>)1+W0JWjwg@DW(HB8LrKHZvz6eGQEq*-@m4?@nJ}r^RRk4 z^~^UJvN@3gVfD<0WJq)bd2TrxDJdXW3T0_PHAgh7py~2<4A_!VOj~EmCpB_!z|0(g z*%9F9vr+PMWkr163j@G9fmXN_B!CeEuj9;fslF@;){KK%$pOiub^%%F|AiAjkk5t* zq2hzt>PFrULbTky9RNXQ!M7l1SdhrKVL1doZ_D(QLFCOZNDEtF7xWN;Fz_#g0S6?9 N>{xI1Z|Jl4{s#iDYfb&vHU5sp#XYv>^UY~r1=cul?BNqb@ s?1$2x0t^~PrWOj$KK{Y3;hrHL3Pz>|3cmhfV9w-iygxQy<2xr002L1|$p8QV delta 570 zcmZvZ!A`4I@obhZk)g zk>T|E-&@*?)e?w+Oo$@VhZxC7KPecGv4%>ah)3$=h~G>MbcB!ynxP6g4>0%vcp!rB z9@@-7V3>7Z2a6p!X5hIk<{}94z+J6y9IuzxIJSh)q<8u9*&^yZ;^nA6-iwrx>GsFj znmr>23*tPrq!>@_Z^c6JG#YU^5h>7cPs{*Bgu(N@`f&@00)gciZdjn@Tdo6Y34&_V zZ5S<3SvO|eZ~0AAZ-64t@e+w>#PE{*7cWW+TvnHHiO{=)43CR!%Ss|kVOZ6w*)*Ms z3GB^ZRpf=7BtylmK1*;CumQ&iN)!MfMf4;J2~CgquE6!8MbVtxEwB$ jc}m?dyr%2X)cPl1l<9Lmo1T3fmPyo5)qzQT<8|i?4v>FO diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index 31ab7fc0..93bf4a15 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Jan-2022 10:20:31"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31 11252 +(FILECREATED "28-Jan-2022 23:36:31"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;32 11715 - :CHANGES-TO (FNS EXAMINEFILES) + :CHANGES-TO (FNS TEDITDEF) - :PREVIOUS-DATE "23-Jan-2022 17:41:43" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;30) + :PREVIOUS-DATE "25-Jan-2022 10:20:31" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -160,30 +160,35 @@ NIL TITLE2]) (TEDITDEF - [LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 12-Jan-2022 17:27 by rmk") + [LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk") + (* ; "Edited 12-Jan-2022 17:27 by rmk") (LET ((TSTREAM (OPENTEXTSTREAM))) (DSPFONT DEFAULTFONT TSTREAM) - (CL:WHEN (EQ (CAR DEF) - 'DEFINEQ) - (SETQ DEF (CADR DEF))) - (IF (EQ NAME (CAR DEF)) - THEN (DSPFONT BOLDFONT TSTREAM) - (PRINT NAME TSTREAM) - (DSPFONT DEFAULTFONT TSTREAM) - (SETQ DEF (CADR DEF)) - (PRINTDEF DEF 3 T NIL NIL TSTREAM) - ELSEIF (EQ NAME (CADR DEF)) - THEN - (* ;; "Presumably a DEFUN. Print the CAR, boldface the cadr") - + (SELECTQ (CAR DEF) + (DEFINEQ (SETQ DEF (CADR DEF)) + (PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2) + (PRINTDEF (CADR DEF) + 2 T NIL NIL TSTREAM)) + ((DEFMACRO DEFUN) (* ; "Has args after name") (PRINTOUT TSTREAM "(" .P2 (CAR DEF) " " .FONT BOLDFONT .P2 (CADR DEF) .FONT DEFAULTFONT " " .P2 (CADDR DEF) - T 3) + T) (PRINTDEF (CDDDR DEF) 3 T T NIL TSTREAM) - (PRIN3 ")" TSTREAM) - ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)) + (PRIN3 ")" TSTREAM)) + (IF (EQ NAME (CADR DEF)) + THEN + (* ;; "Like RPAQQ, bold the name") + + [PRINTOUT TSTREAM "(" .P2 (CAR DEF) + " " .FONT BOLDFONT .P2 (CADR DEF) + .FONT DEFAULTFONT T .TAB (IPLUS 2 (NCHARS (CAR DEF] + (PRINTDEF (CDDR DEF) + (IPLUS 2 (NCHARS (CAR DEF))) + T T NIL TSTREAM) + (PRIN3 ")" TSTREAM) + ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM))) TSTREAM]) ) @@ -194,6 +199,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (662 11110 (EXAMINEDEFS 672 . 8791) (EXAMINEFILES 8793 . 9988) (TEDITDEF 9990 . 11108))) + (FILEMAP (NIL (658 11573 (EXAMINEDEFS 668 . 8787) (EXAMINEFILES 8789 . 9984) (TEDITDEF 9986 . 11571))) )) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 29be30c65641cb740fb8f172718c78c299251d43..47d81119c2221e076750f03855268925b2aa3ae1 100644 GIT binary patch delta 875 zcmZ8f%Wl(95Y4?H)FwsZu|;TP1SE?@z7N~6VG%d6aZqqtCqYOoP)njFQb?iUC~ zgK`b5oxpk7?T-fa4$_5f^5$Hpzc!X+L1^jvMhTzWq_pdmpj>su{>x zZiA}@8?0&OLadp(#-D2BR7_jbU|O2M63L35dS8#psVkhpho{=VmHRpCPC2o!6xT7};NnM_83*6taR z{t@Pyl8Pq-`idh=Pq32z!gkgHk!Lv=D`nGO6>i$ALDI5ai2r^s1xDQwTb0_Tn=TQT z^tB)3m^XAZbnWJ%%+#lh{5IN@-kB_oj7oH-nA9l8gUnkaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;35 57074 +(FILECREATED "29-Jan-2022 00:01:52" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;37 56734 - :CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY) + :CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY GIT-COMPARE-BRANCHES) - :PREVIOUS-DATE "26-Jan-2022 22:40:03" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;34) + :PREVIOUS-DATE "28-Jan-2022 12:12:30" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;36) (PRETTYCOMPRINT GITFNSCOMS) @@ -23,7 +23,7 @@ (MYMEDLEYHOST 'MM) (GITMEDLEYHOST 'GIT)) (INITVARS (GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) - (GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED)) + (GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2)) (GIT-MERGE-COMPARES T)) (P (PSEUDOHOST MYMEDLEYHOST MEDLEYDIR) (PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR)) @@ -106,7 +106,7 @@ (RPAQ? GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) -(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED)) +(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2)) (RPAQ? GIT-MERGE-COMPARES T) @@ -734,7 +734,8 @@ (LIST DIR1 DIR2))]) (GIT-COMPARE-BRANCHES - [LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 26-Jan-2022 13:42 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 28-Jan-2022 23:58 by rmk") + (* ; "Edited 26-Jan-2022 13:42 by rmk") (* ; "Edited 11-Jan-2022 11:10 by rmk") (* ; "Edited 6-Jan-2022 13:05 by rmk") (* ; "Edited 4-Jan-2022 22:52 by rmk") @@ -774,11 +775,7 @@ (LIST BRANCH1 BRANCH2) `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2) NIL - `(Compare "" (,(CONCAT "See " BRANCH1) - CD-MENUFN See% left) - (,(CONCAT "See " BRANCH2) - CD-MENUFN See% right) - See% both)) + `(Compare See)) ELSE "NO DIFFERENCES") ELSE "NO DIFFERENCES"]) @@ -786,7 +783,7 @@ [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE) (* ;; - "Edited 26-Jan-2022 22:53 by rmk: my medley subdirectories with the current local git branch.") + "Edited 28-Jan-2022 23:57 by rmk: my medley subdirectories with the current local git branch.") (* ;; "Compares my medley subdirectories with the current local git branch.") @@ -836,10 +833,7 @@ `(BRANCH1 "My Medley" BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN GIT-CD-LABELFN) NIL - `(Compare "" ("See My Medley" CD-MENUFN See% left) - (,(CONCAT "See " BRANCH2) - CD-MENUFN See% right) - See% both "" (Copy% <- GIT-CD-MENUFN) + `(Compare See "" (Copy% <- GIT-CD-MENUFN) (|Delete ALL <-| GIT-CD-MENUFN) ,@(CL:UNLESS (STRPOS "master" BRANCH2) '("" (Copy% -> GIT-CD-MENUFN) @@ -1124,20 +1118,20 @@ (ERROR "INITIALS is not set"]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4688 9814 (TOGIT 4698 . 6617) (FROMGIT 6619 . 7478) (GIT-DELETE-FILE 7480 . 8374) ( -MYMEDLEY-DELETE-FILES 8376 . 9812)) (9815 11456 (MEDLEYSUBDIR 9825 . 10265) (GITSUBDIR 10267 . 10843) -(STRIPDIR 10845 . 11216) (STRIPHOST 11218 . 11454)) (11457 13394 (GFILE4MFILE 11467 . 12138) ( -MFILE4GFILE 12140 . 12693) (GIT-REPO-FILENAME 12695 . 13392)) (13395 15729 (MEDLEYSUBDIRS 13405 . -14373) (GITSUBDIRS 14375 . 15727)) (15856 22350 (GIT-COMMIT 15866 . 16444) (GIT-PUSH 16446 . 17002) ( -GIT-PULL 17004 . 17410) (GIT-BRANCH-DIFF 17412 . 18607) (GIT-APPROVAL 18609 . 18810) (GIT-GET-FILE -18812 . 19916) (GIT-FILE-EXISTS? 19918 . 20797) (GIT-REMOTE-UPDATE 20799 . 21841) (GIT-FILE-DATE 21843 - . 22348)) (22395 26572 (GIT-CHECKOUT 22405 . 22646) (GIT-WHICH-BRANCH 22648 . 23232) (GIT-MAKE-BRANCH - 23234 . 24725) (GIT-BRANCHES 24727 . 25507) (GIT-BRANCH-EXISTS? 25509 . 26570)) (26602 29307 ( -GIT-MY-CURRENT-BRANCH 26612 . 26785) (GIT-MY-BRANCHP 26787 . 27706) (GIT-MY-NEXT-BRANCH 27708 . 28149) - (GIT-MY-BRANCHES 28151 . 29305)) (29353 33123 (GIT-ADD-WORKTREE 29363 . 31123) (GIT-REMOVE-WORKTREE -31125 . 31703) (GIT-LIST-WORKTREES 31705 . 32509) (WORKTREEDIR 32511 . 33121)) (33171 54106 ( -GIT-GET-DIFFERENT-FILES 33181 . 35051) (GIT-COMPARE-BRANCHES 35053 . 38191) (GIT-COMPARE-WITH-MYMEDLEY - 38193 . 42091) (GIT-COMPARE-WORKTREE 42093 . 45570) (GITCDOBJBUTTONFN 45572 . 50576) (GIT-CD-LABELFN -50578 . 51660) (GIT-CD-MENUFN 51662 . 54104)) (54152 57051 (CDGITDIR 54162 . 54594) (GIT-COMMAND 54596 - . 56164) (GITORIGIN 56166 . 56743) (GIT-INITIALS 56745 . 57049))))) + (FILEMAP (NIL (4731 9857 (TOGIT 4741 . 6660) (FROMGIT 6662 . 7521) (GIT-DELETE-FILE 7523 . 8417) ( +MYMEDLEY-DELETE-FILES 8419 . 9855)) (9858 11499 (MEDLEYSUBDIR 9868 . 10308) (GITSUBDIR 10310 . 10886) +(STRIPDIR 10888 . 11259) (STRIPHOST 11261 . 11497)) (11500 13437 (GFILE4MFILE 11510 . 12181) ( +MFILE4GFILE 12183 . 12736) (GIT-REPO-FILENAME 12738 . 13435)) (13438 15772 (MEDLEYSUBDIRS 13448 . +14416) (GITSUBDIRS 14418 . 15770)) (15899 22393 (GIT-COMMIT 15909 . 16487) (GIT-PUSH 16489 . 17045) ( +GIT-PULL 17047 . 17453) (GIT-BRANCH-DIFF 17455 . 18650) (GIT-APPROVAL 18652 . 18853) (GIT-GET-FILE +18855 . 19959) (GIT-FILE-EXISTS? 19961 . 20840) (GIT-REMOTE-UPDATE 20842 . 21884) (GIT-FILE-DATE 21886 + . 22391)) (22438 26615 (GIT-CHECKOUT 22448 . 22689) (GIT-WHICH-BRANCH 22691 . 23275) (GIT-MAKE-BRANCH + 23277 . 24768) (GIT-BRANCHES 24770 . 25550) (GIT-BRANCH-EXISTS? 25552 . 26613)) (26645 29350 ( +GIT-MY-CURRENT-BRANCH 26655 . 26828) (GIT-MY-BRANCHP 26830 . 27749) (GIT-MY-NEXT-BRANCH 27751 . 28192) + (GIT-MY-BRANCHES 28194 . 29348)) (29396 33166 (GIT-ADD-WORKTREE 29406 . 31166) (GIT-REMOVE-WORKTREE +31168 . 31746) (GIT-LIST-WORKTREES 31748 . 32552) (WORKTREEDIR 32554 . 33164)) (33214 53766 ( +GIT-GET-DIFFERENT-FILES 33224 . 35094) (GIT-COMPARE-BRANCHES 35096 . 38064) (GIT-COMPARE-WITH-MYMEDLEY + 38066 . 41751) (GIT-COMPARE-WORKTREE 41753 . 45230) (GITCDOBJBUTTONFN 45232 . 50236) (GIT-CD-LABELFN +50238 . 51320) (GIT-CD-MENUFN 51322 . 53764)) (53812 56711 (CDGITDIR 53822 . 54254) (GIT-COMMAND 54256 + . 55824) (GITORIGIN 55826 . 56403) (GIT-INITIALS 56405 . 56709))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 32563473e7af3b5577a80f5da4a61993c7079b29..629d60233542e4765199d5512137f031bf547712 100644 GIT binary patch delta 906 zcmZuvOK1~87|y2E!d7j4)Ry|-cWYx78r_|p*+&}NB%4jMHOZFURHX_bG+PX&4_Yrd z30}Mv>mYdcC<-Z|UOW^$d#iX8#FGdriXJ@aY;CMchvlE|f6Vv)^UZ#L#ogWF?p-}< z#3m~XF(e@bk`$NZI6-SSy#Y-G0jaw=q{I~?PK>qJL$okEM7uZ`<^Qk1i~tKFAI;i% z%XF<&$;vRAJzCHTm+sPlC#t5<$J_`_&i0)XAwK0=mu+X-i)GkZU=8%$5o8o+pCSck zIklAx|3C-uzEG$mxzTZFJ@koMWR815pO6UuAQwJ-rgO4mqfFnD-0j5>TL%^)Ior` zTHRj}K-N^|Y_GtPm{VD(GApZ?r_Xhre$!=+Zw(s}j%&2?@uythap$ZP*;XKTV{ouL z5V2XKJqbd~i4nS*m^%O75h7*SY<>+zi7K}*OR&BpL!bgd26!cR%JEwL7e&sMlwdr- z1}oYb7i+9!I-Rjyz?$+$BCNKt45|c`dL6I=3$;4?-GC5wp$h^Kh0up%qdiCgVZO3* z%U@ncRsqW}8_B4Cx(6dF+Qt98G@ ziV3F8@sk`+Uyh%mAI5Ell%&+ECO@7&1iYDdJTUX6JQ77(D$j&@Xf?}2`@31NooQ|P Hk2-$=(1hiS delta 1125 zcmZuvO>7fK6!tn0kfHnt(IOM7*9lnO2-Dr!nf5m~?yZU{~wP`Pm60w<8tN(l7=yxrJoAk1O*d+&Si&CK`hmFLoj z7t*yO+w{~>buvX2N`cZe*V0^>KjZJo~-?p%~(!v^OC``k-eYa@FP3lb6M_?YxjyyS^ZPfF3PzpNSR3W&%xu}&||jYn`zEpG#{Wf%{$ zxo;D3Tt9RNRa^2QxA5t;bUZ4ZxZCr4G#Y%@4@HkHd_Go_8X>>q!JWkw_*FP|%hDb> zn$(yE{&3DOITg?}bs1C3f&)&)^_&Av8K^~}P|SPoVc+(E8Y&drav@g%%2@}hmbnZ~ zL%i1Sjcb^hI(x1w zA36sbH-VI0C_00Kwr7_Mwofog#XrWjIg>)tuh;j$>8aTX8Skh=5{Hi1cv!m%H6jF56oJ54qgkK9z*H~@7X}8~h*5R2hP$ep zqTe*7n7Cl7t(#^-l5Vt~TDPSie{y%biBS2{L_EGBFmWMrRb0<-@hr2wJ7nVGQD(1L z%=p%0mn8mx2Y3FBBzYkJlHlC1Rye`A0e;0h==#8^(ynQp-!Dr?0xvsq07ExBPB6T= zKbkK(9x&s7Q<&btD(DJSn@zxHPd1u?^4v6l{7Qi9nt1nHW;0iToUP8x)~7MYbfIT^ zqf8aYvpcJr9%#iWUnOi?ey*~Puv|g;Ly<==!brW=tY0Mfy01)Y+rbs=BEay^n#=ZV zwScT>VVsLw*&gvYy9;H1n{|ZJuSl`hss8srcgu22hNM`mZ5J~q^HGSk?w{=KZoR4f GwdMkaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;119 22617 +(FILECREATED "30-Jan-2022 08:58:48"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135 25556 - :CHANGES-TO (VARS PSEUDOHOSTSCOMS) + :CHANGES-TO (FNS PSEUDOHOST CONTRACT.PH EXPAND.PH PSEUDOFILENAME) + (RECORDS PHDEVICE TARGETDEVICE) + (VARS PSEUDOHOSTSCOMS) - :PREVIOUS-DATE "26-Jan-2022 23:33:17" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;118) + :PREVIOUS-DATE "28-Jan-2022 09:06:55" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;123) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -15,7 +17,7 @@ [ (* ;; "Public entries") - (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME) + (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME) (* ;; "Internals") @@ -24,7 +26,7 @@ OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) (P (PSEUDOHOST 'LI LOGINHOST/DIR)) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE) + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) (P (CL:UNLESS (GETP 'EXPORTS.ALL 'FILE) (LOAD 'EXPORTS.ALL))]) @@ -36,26 +38,32 @@ (DEFINEQ (PSEUDOHOST - [LAMBDA (HOST PREFIX) (* ; "Edited 25-Jan-2022 09:58 by rmk") - (* ; "Edited 23-Jan-2022 20:43 by rmk") - (* ; "Edited 18-Jan-2022 13:08 by rmk") + [LAMBDA (HOST PREFIX) + + (* ;; "Edited 30-Jan-2022 08:58 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.") + (CL:WHEN (AND (LISTP HOST) (NULL PREFIX)) (SETQ PREFIX (CADR HOST)) (SETQ HOST (CAR HOST))) (SETQ HOST (U-CASE (MKATOM HOST))) - (IF PREFIX - THEN (CL:UNLESS (FILENAMEFIELD PREFIX 'HOST) - (SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST 'DSK 'BODY PREFIX)))) - (CL:UNLESS (MEMB (NTHCHARCODE PREFIX -1) - (CHARCODE (> / <))) - (SETQ PREFIX (CONCAT PREFIX (IF (STRPOS "/" PREFIX) - THEN "/" - ELSE ">")))) - [LET (PREVIOUS TARGETHOST TARGETDEVICE) - (CL:WHEN (SETQ PREVIOUS (PSEUDOHOSTP HOST))(* ; + [IF PREFIX + THEN (CL:WHEN (PSEUDOHOSTP HOST) (* ;  "Redefining: first clear out the previous one") - (PSEUDOHOST HOST NIL)) + (PSEUDOHOST HOST NIL)) + [LET (TARGETHOST TARGETDEVICE PREFIXHOST) + (CL:UNLESS [SETQ PREFIXHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST] + (SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST (SETQ PREFIXHOST 'DSK) + 'BODY PREFIX)))) + + (* ;; "We want the maximal prefix. If {LI} is a pseudohost with prefix {DSK} and we are defining {FOO} with prefix {LI}, we want FOO's prefix to be {DSK}xyz>. , And if FUM is then defined as {FOO}, we want its prefix to be {DSK}xyz>mno>. This gives the true filenames.") + + (SETQ PREFIX (EXPAND.PH PREFIX PREFIXHOST)) + (CL:UNLESS (MEMB (NTHCHARCODE PREFIX -1) + (CHARCODE (> / <))) + (SETQ PREFIX (CONCAT PREFIX (IF (STRPOS "/" PREFIX) + THEN "/" + ELSE ">")))) [SETQ TARGETHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST] (* ;; "We know about the directory separators for these particular devices. Maybe there should be separate list of slash-hosts somewhere that we can use.") @@ -70,35 +78,48 @@ (* ;; "Save the last directory marker to pack on if needed.") - (\DEFINEDEVICE HOST (CREATE FDEV - USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE - FDEV2 _ (CONS PREFIX (CL:IF (EQ (CHARCODE /) - (NTHCHARCODE PREFIX -1 - )) - '/ - '<)) - OPENFILE _ (FUNCTION OPENFILE.PH) - GETFILENAME _ (FUNCTION GETFILENAME.PH) - DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH) - CLOSEFILE _ (FUNCTION CLOSEFILE.PH) - REOPENFILE _ (FUNCTION REOPENFILE.PH) - DELETEFILE _ (FUNCTION DELETEFILE.PH) - OPENP _ (FUNCTION OPENP.PH) - UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH) - REGISTERFILE _ (FUNCTION REGISTERFILE.PH) - GENERATEFILES _ (FUNCTION GENERATEFILES.PH) - GETFILEINFO _ (FUNCTION GETFILEINFO.PH) - SETFILEINFO _ (FUNCTION SETFILEINFO.PH) - RENAMEFILE _ (FUNCTION RENAMEFILE.PH] - ELSEIF (PSEUDOHOSTP HOST) - THEN (UNINTERRUPTABLY - - (* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.") + (\DEFINEDEVICE HOST + (CREATE FDEV + USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE FDEV2 _ PREFIX + OPENFILE _ (FUNCTION OPENFILE.PH) + GETFILENAME _ (FUNCTION GETFILENAME.PH) + DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH) + CLOSEFILE _ (FUNCTION CLOSEFILE.PH) + REOPENFILE _ (FUNCTION REOPENFILE.PH) + DELETEFILE _ (FUNCTION DELETEFILE.PH) + OPENP _ (FUNCTION OPENP.PH) + UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH) + REGISTERFILE _ (FUNCTION REGISTERFILE.PH) + GENERATEFILES _ (FUNCTION GENERATEFILES.PH) + GETFILEINFO _ (FUNCTION GETFILEINFO.PH) + SETFILEINFO _ (FUNCTION SETFILEINFO.PH) + RENAMEFILE _ (FUNCTION RENAMEFILE.PH))) - (SETQ \FILEDEVICES (DREMOVE (\GETDEVICEFROMNAME HOST \FILEDEVICES) - \FILEDEVICES)) - (\DEFINEDEVICE HOST NIL)) - ELSE (ERROR HOST "is not a pseudohost")) + (* ;; "The ultimate target device keeps a map of prefixes and the hostnames they map to. The longest matching prefix is chosen when a name that expands to the target device is contracted.") + + (CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEVICE) + (SORT (CONS (LIST PREFIX HOST (CL:IF (EQ (CHARCODE /) + (NTHCHARCODE PREFIX -1)) + '/ + '<)) + DATUM) + (FUNCTION (LAMBDA (P1 P2) + (IGREATERP (NCHARS (CAR P1)) + (NCHARS (CAR P2] + ELSEIF (SETQ PREFIX (CADR (PSEUDOHOSTP HOST))) + THEN + (* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.") + + (LET* ((PHHOST (\GETDEVICEFROMNAME HOST \FILEDEVICES)) + (TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF PHHOST))) + (UNINTERRUPTABLY + (CL:WHEN TARGETDEV (* ; + "Don't want to fail uninterruptably") + (CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEV) + (DREMOVE (ASSOC PREFIX DATUM) + DATUM))) + (SETQ \FILEDEVICES (DREMOVE PHHOST \FILEDEVICES)) + (\DEFINEDEVICE HOST NIL))] HOST]) (PSEUDOHOSTP @@ -131,6 +152,15 @@ (CL:IF (TYPE? PHDEVICE DEVICE) (EXPAND.PH FILENAME DEVICE) FILENAME)]) + +(PSEUDOFILENAME + [LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk") + (* ; "Edited 28-Jan-2022 09:06 by rmk") + (FOR D PN (FILENAME _ (IF (STREAMP FILE) + THEN (FETCH (STREAM FULLFILENAME) OF FILE) + ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES + WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) + DO (RETURN PN) FINALLY (RETURN FILENAME]) ) @@ -142,52 +172,64 @@ (EXPAND.PH [LAMBDA (FILENAME PHDEV) - (* ;; "Edited 26-Jan-2022 11:06 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") + (* ;; "Edited 30-Jan-2022 00:15 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") (* ;; "Assumes that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") - (IF (TYPE? STREAM FILENAME) + [IF (TYPE? STREAM FILENAME) THEN (CL:UNLESS PHDEV (SETQ PHDEV (FETCH (STREAM DEVICE) OF FILENAME))) (SETQ FILENAME (FETCH (STREAM FULLNAME) OF FILENAME)) ELSEIF (NOT (TYPE? FDEV PHDEV)) - THEN (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV))) - (LET (SUFFIX SUFFIXPOS) - (CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME)) - (SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS))) - (CL:WHEN (FMEMB (CHCON1 SUFFIX) - (CHARCODE (< > /))) - (SETQ SUFFIX (SUBSTRING SUFFIX 2))) - (CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV) - SUFFIX))]) + THEN (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV (FILENAMEFIELD FILENAME 'HOST] + (IF (TYPE? PHDEVICE PHDEV) + THEN (LET (SUFFIX SUFFIXPOS) + (CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME)) + (SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS))) + (CL:WHEN (FMEMB (CHCON1 SUFFIX) + (CHARCODE (< > /))) + (SETQ SUFFIX (SUBSTRING SUFFIX 2))) + (CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV) + SUFFIX))) + ELSE FILENAME]) (CONTRACT.PH - [LAMBDA (NAME PHDEV) (* ; "Edited 25-Jan-2022 09:44 by rmk") - (* ; "Edited 20-Jan-2022 20:04 by rmk") - (* ; "Edited 18-Jan-2022 22:54 by rmk") - (* ; "Edited 16-Jan-2022 19:57 by rmk") - (* ; "Edited 14-Jan-2022 00:03 by rmk") + [LAMBDA (NAME PHDEV) + + (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") + + (* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.") + + (* ;; "If pseudohosts are defined in terms of other pseudohosts (e.g. FUM is defined in terms of FOO which is defined in terms of LI which is rooted in DSK, then the pseudodevices presumably were created in that order, so the first name we encounter will be the one with the longest prefix. So {DSK}... might collapse to {FUM}. But {FOO}... will not. ") + (CL:UNLESS (TYPE? FDEV PHDEV) (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV))) (CL:WHEN NAME - (LET* [(PREFIX (FETCH (PHDEVICE PREFIX) OF PHDEV)) - (CONNECTOR (FETCH (PHDEVICE CONNECTOR) OF PHDEV)) - (SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX] - (IF (STRPOS PREFIX NAME 1 NIL T NIL FILEDIRCASEARRAY) - THEN (CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY) + (FOR PM PREFIX SUFFIX CONNECTOR IN (FETCH (TARGETDEVICE PREFIXMAP) OF (FETCH (PHDEVICE + TARGETDEV + ) + OF PHDEV)) + WHEN (STRPOS (SETQ PREFIX (CAR PM)) + NAME 1 NIL T NIL FILEDIRCASEARRAY) + DO + (* ;; "This is the lowest host. ") - (* ;; "Must be a subdirectory. (CDR INFO) tells us whether to use / or > depending on what the prefix has") + [SETQ SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX] + (CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY) - [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) - ELSE (UNSLASHIT SUFFIX]) - (PACK* '{ (FETCH (FDEV DEVICENAME) OF PHDEV) - "}" - (OR SUFFIX "")) - ELSE - (* ;; "If the target's NAME didn't begin with the prefix, then the caller must have jumped outside the pseudo root. So just return the NAME") + (* ;; "CONNECTOR tells us whether to use / or > depending on what the prefix has") - NAME)))]) + (SETQ CONNECTOR (CADDR PM)) + [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) + THEN (SLASHIT SUFFIX) + ELSE (UNSLASHIT SUFFIX]) + (RETURN (PACK* '{ (CADR PM) + "}" + (OR SUFFIX ""))) FINALLY + + (* ;; "If we didn't match a prefix, then this was not related to any pseudhost descending from the target, it is a pure target name, presumably because something like a relative .. reference took it off all paths. We return the original name.") + + (RETURN NAME)))]) (SLASHIT [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk") @@ -376,13 +418,15 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(ACCESSFNS PHDEVICE [(PREFIX (CAR (FETCH (FDEV FDEV2) OF DATUM))) +(ACCESSFNS PHDEVICE ((PREFIX (FETCH (FDEV FDEV2) OF DATUM)) (TARGETDEV (FETCH (FDEV FDEV1) OF DATUM) - (REPLACE (FDEV FDEV1) OF DATUM WITH NEWVALUE)) - (CONNECTOR (CDR (FETCH (FDEV FDEV2) OF DATUM] + (REPLACE (FDEV FDEV1) OF DATUM WITH NEWVALUE))) (TYPE? (FETCH (PHDEVICE PREFIX) OF DATUM))) (RECORD PHGENFILESTATE (PHDEVICE . TARGETGENFILESTATE)) + +(ACCESSFNS TARGETDEVICE ((PREFIXMAP (FETCH (FDEV FDEV3) OF DATUM) + (REPLACE (FDEV FDEV3) OF DATUM WITH NEWVALUE)))) ) (DECLARE%: EVAL@COMPILE @@ -427,12 +471,12 @@ (LOAD 'EXPORTS.ALL)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1205 7096 (PSEUDOHOST 1215 . 5418) (PSEUDOHOSTP 5420 . 5770) (PSEUDOHOSTS 5772 . 6129) -(TARGETHOST 6131 . 6405) (TRUEFILENAME 6407 . 7094)) (7124 13330 (EXPAND.PH 7134 . 8189) (CONTRACT.PH -8191 . 10010) (SLASHIT 10012 . 11580) (UNSLASHIT 11582 . 13328)) (13331 20121 (OPENFILE.PH 13341 . -13902) (GETFILENAME.PH 13904 . 14193) (DIRECTORYNAMEP.PH 14195 . 14819) (CLOSEFILE.PH 14821 . 15175) ( -REOPENFILE.PH 15177 . 15742) (DELETEFILE.PH 15744 . 16028) (OPENP.PH 16030 . 16206) (UNREGISTERFILE.PH - 16208 . 16513) (REGISTERFILE.PH 16515 . 16816) (GENERATEFILES.PH 16818 . 17858) (GETFILEINFO.PH 17860 - . 18162) (SETFILEINFO.PH 18164 . 18363) (NEXTFILEFN.PH 18365 . 18907) (FILEINFOFN.PH 18909 . 19180) ( -RENAMEFILE.PH 19182 . 20119))))) + (FILEMAP (NIL (1355 8925 (PSEUDOHOST 1365 . 6625) (PSEUDOHOSTP 6627 . 6977) (PSEUDOHOSTS 6979 . 7336) +(TARGETHOST 7338 . 7612) (TRUEFILENAME 7614 . 8301) (PSEUDOFILENAME 8303 . 8923)) (8953 16177 ( +EXPAND.PH 8963 . 10190) (CONTRACT.PH 10192 . 12857) (SLASHIT 12859 . 14427) (UNSLASHIT 14429 . 16175)) + (16178 22968 (OPENFILE.PH 16188 . 16749) (GETFILENAME.PH 16751 . 17040) (DIRECTORYNAMEP.PH 17042 . +17666) (CLOSEFILE.PH 17668 . 18022) (REOPENFILE.PH 18024 . 18589) (DELETEFILE.PH 18591 . 18875) ( +OPENP.PH 18877 . 19053) (UNREGISTERFILE.PH 19055 . 19360) (REGISTERFILE.PH 19362 . 19663) ( +GENERATEFILES.PH 19665 . 20705) (GETFILEINFO.PH 20707 . 21009) (SETFILEINFO.PH 21011 . 21210) ( +NEXTFILEFN.PH 21212 . 21754) (FILEINFOFN.PH 21756 . 22027) (RENAMEFILE.PH 22029 . 22966))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 6bf39e065921f84ea1d8173c848494613c527be7..4df8d2083f91a4b4a6939cd000163630ca4cc028 100644 GIT binary patch delta 2816 zcmZuzPiz!b7@wII3JZlcG@u2{#}eZ%*fMYa?d(QyraQBpVRvVSnOSIS6Sb_d1dw?0 zAY?hnfy6|~MB$)PNE*Wa3uL`ecsuc&%O(XXAI5oGn+Pm{SIvRjt#_)&cA@9F>b zP5$7Wj;w;Ds;UN+s$+W7b~F+DP^ftk^hJQG@5P~6jVA*K?3uvyEZR%AsJRW>Gn;l1 z3ZY%~Lo0&7vFwv>)rQy%r|mc$;QUE5#L4xkw! zB5D;?W!Xw{u`exC6iEpxmYyrPKp>F71rY*L1a6e$IKkkzV#Aqf^VbMhAToG(PRv5f zI>nslHgbjjuxZ2qUFKacw!^R$#O74PhM)uL#*rWZ8Baq5w^J83yC7UPk27ZsdT2lzzx?F-8Mb8YD<`=+053Xh z)#~sC8o^-;?-{Srfy)MMV@&9_-7%@#Hj_UGE_J%@W;$yc=J|h_$GIbGAF+_{vG3ye z_;~8_KpSTk<~646TB;aqGkV_TN#oQGHZgi&Q=LV8AbmGFvbnjsyPnOQ-qFoqFh)`j z?b~K2-Mz89k%jFp{md0qsSH+VH~o_~sG0FQ;2RDzTXZ6vq^lB@#~%MU@4)F*bLY+$=d zM1!bdMvfZ;K5}Szy%8zt(3+^4kqx9IL+=IFT)SZbQOnT52U|5`Ac_Q090q;_MAD&Y zH>ZFQ{jpq$Snhk%<#OLXh)7^o>%I7(;bgk4raZB$Qtm?r1cf9&ZaUaeB@t>!Xiy1B zJ4&gPbr6CLDM+8PB4_Rju6qd-qQDW5%WAqp)e0Ldi+ksZ^a>(zW_(j>r( zOHG~3rpjpZ>=3c16A^P%6pS|QM)<pYi)$R4g@wt1BFthY9`C!W<{%CT3tGe^Lld8&ygOaUk z$@13IoyTiUPohzPJtn>uevx5#x$NoCIzR_d1AOMRx2~$((LtW$<5XmB7-?EtuB7A9 z{D3pCI_Qq@bJ-a_aobcVU5I7Ta$R%SU>RT z*=939z>)0i9S}L$nrl{X3bZ^iyq4!t+|$i+3qrS-(CUD(z;(?mi{-aRfoI}tFhQHW z`)YD4H`ck+K6h;Gb{oZY`T6ddrGq95xpLoJ9X2*pHIw|M+ug+*&N+ca_@);+Rr3*p zR!6-0o^Z%zh+0#40N0yF?LZWtmP2xal-Ds&#RsWYbub2jlGqnO)iW7FD2SqESm5(! zyd)xO7*z>HOpb1QVG5~vDPPR>Bg~3C3NFo$LX65u%Wu@GVa;U>NXsvyLC{QYZri;F zWrJS48&aV(!_b_?AA>J9B@eef+qs$@UrGViM$JKb@x};0%g-5S7tbuVhKDGfmtQrG zGyKl}!f?CKZlQj5vEA-@?iGGUFDNb*uy%_k?oT`@QMY{bX%ucZs01y$e+9QBgBN z#fp%MGi#_U5G+!8`u1gd1)wV{2Zs3_Lzz$~<9mbQT))yK@9d3s<(`(zT=Da(w3C>o!FJL@K3Vp2eTVLi^-?^_H6I}T}oE=k+EDMfI_uVX?dvE5fqSpK?3{7 JlI{Cv{{tm_i$?$e delta 2056 zcmZuyO>7%Q6!to9)4FjJD^aVYG+Ht%uCu#tn<@uNUDZ*l z2C3!LRG|_Gsh1K)qDUYiAr4gHK+{H|6v;vrNQe`hxb(=q0*)Z@X4ZC0iw~Z8Z|42X zd++=9@6*2*KR7!^wb{iBS7&LKQXsS_t3{%1t(}XL!qyKb2d}PQZ>?Uvy!Fq*|6R;& z-LRKP0VvH84T>e(a2Kp#HuPZnjNu26tOr)Z^lUE(gOXPZW}sO2tuv0-2xd(qv>-!s zyV0p!lw}_MhP_GhGkwNTH1o;nI>-n=%Zvo9cV|vBcMp2>mG$HtT=9H`F^7w z8uL{PoansloWpGvgiRS#SSdSID{_e$NjbAJqfpWm16q(@?UBgv)c z|6;POw}d=;U)s3L4}|n!O6+(4j3Is|{Ja@|$6$X9(AjocPv}Cme7EDJZS49GC+CIy z?A{`qOTdXmq1#EVb7zYp(qsJ%E>wij)W_oOW@U`FjV4R)Ih2_Au32Tb6F1L}-qwYY zxTcT9rWG{{SQO6(Mb==&w91a#c|FjA3~p#+AN`VNT0k`g+>&o$t0-WPJBC!rGqQJl zQ!YSIH3HiSaRO9mxIHOLpfOuA0t-kX2fV(nQNu`9)dZ4PV0SKnXlkE`J4FT;aJ#s|7H9tLB}t zK$T&oH(q7mtMRM>pShba&Ro9pHg;q%wW-ho_?_2Pt&?>d6q<#=3V8;OTlRzsb40)Y zQDrHrT+7GWa(%$>$yk5iT5tj!Tdov3ELX#QL5o%M>X!R@UEIm#z_hAXwiq(Zm(Gz{tMQO2Q*g7BQCaZxNRIvFZf*HwXVcs*Bp`eO`LI-|Y9$w)%oJmfDqNtEry#`1* zZ~@-BcIoZrdTagK^$bu|W#8``AJ0Q(E(1iRkU52`l8siXu|M~b6DOotOww1I2RJO! zQp|2{AKlCMKhY?E8KX{G=6_Ea?zuG?D)B_e`bH}e=5zfUz6&Hbk}wS#71nyn5wZu2QISOkdb;f9*f0wk-+vO z`()@y=8hqxFO3cwoB16!aN7y*-0^sbFY&;>LX?^OP+Qk(j*&9Bb#F6C<1%f~ zJxz@tqi9j)Y{`igow!yhMB3oYiZqJ{Z1Uit!x6qr$LDZ2eBW4}f!JpQta5OC^Zj0` z>9o|{#~3CJBLB1$xAnEwYAZ+$@;+@ZMJ%`0YBsy7Nv9d{;YSe@z85XR{#$X< z@g9$CcLw=-F($}&gwq~Tk#&$5jtd6q6-(>q4uZh#@EHQJ!#qfVot>KRE1^n|8IdPh zW%#8zC8{1lYPbPJzyya=R1{TWRmH;RoG1mz@bM*(xtW1HdGP75bdY^@)K2x|HOZvO zVDv@gC)wr6+Av2ZXP2_e@tR~$CYNSR&kajneHo^G3t?#T@2}ncRN6>3+$ac*kS$IT OwlQ@?O0v6Cm;MFryK6-VkfHNqz+;T!syIfXpqVPgR#a*peRo>Ga0dj!ZXk&M*F_JU0N+| zzi*y+865(=5*!;O$z)=W%KP(GfI*T5AVJASNP*TS*$@m>>?q8vA~)UV{)a7(|6UUU zh1rTDW_b9JA^rF)YST{3jpgU^w+ig!+$mDY71FyxkQ#dg3ieaAy3;2}y#fI$M+A!Y z&U<9PRDb0^+NJk6e_$h5U)T@c?rDh##5^NFv#AMnF8}Eqt~)f6Crf+l)i<`H+`H?q FzX56@zn%a9 delta 174 zcmexk(4w>99h+@tUS>&VVoqjNYOz8|Myf(VacXHwenx(AiGq)(LSnH(qC# zu0mRVk%EuEyQiOre{hJti)WC+WO;VY$^Pt8Vi}n^sS3&Yd3mYHC8;S2CHV@8d6f#A zC$N8Eob14@y*Y>bG?%It0}!wPF%yUZB7{H;kO(h`0TRjHTqh>a$fz-Sp19IvUkOb% K&czHRRl5L30xzQg diff --git a/lispusers/REGIONMANAGER b/lispusers/REGIONMANAGER index 3d68fac5..5d9ceba3 100644 --- a/lispusers/REGIONMANAGER +++ b/lispusers/REGIONMANAGER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Jan-2022 13:24:29"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;106 34264 +(FILECREATED "28-Jan-2022 23:52:21"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;113 36064 - :CHANGES-TO (FNS RELCREATEREGION \RELCREATEREGION.SIZE RELGETREGION) + :CHANGES-TO (FNS CLOSEWITH MOVEWITH MOVEWITH.DOIT CLOSEWITH.DOIT) - :PREVIOUS-DATE "25-Jan-2022 15:38:10" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;105) + :PREVIOUS-DATE "28-Jan-2022 16:55:38" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;108) (PRETTYCOMPRINT REGIONMANAGERCOMS) @@ -36,6 +36,7 @@ (* ;; "Composite application construction") (COMS (FNS RM-ATTACHWINDOW) + (FNS CLOSEWITH CLOSEWITH.DOIT MOVEWITH MOVEWITH.DOIT) (P (MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG) (MOVD 'RM-ATTACHWINDOW 'ATTACHWINDOW)) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS RFIELDDIFF]) @@ -613,6 +614,39 @@ (WINDOWPROP WINDOWTOATTACH 'PASSTOMAINCOMS WINDOWCOMACTION)))) VAL]) ) +(DEFINEQ + +(CLOSEWITH + [LAMBDA (CHILDREN PARENT) (* ; "Edited 28-Jan-2022 23:51 by rmk") + [FOR C ONE INSIDE CHILDREN WHEN (AND C (SETQ C (WFROMDS C))) DO (SETQ ONE T) + (WINDOWADDPROP PARENT + 'CLOSECHILDREN C) + FINALLY (CL:WHEN ONE + (WINDOWADDPROP PARENT 'CLOSEFN (FUNCTION CLOSEWITH.DOIT)))] + PARENT]) + +(CLOSEWITH.DOIT + [LAMBDA (PARENT) (* ; "Edited 28-Jan-2022 17:54 by rmk") + (FOR C IN (WINDOWPROP PARENT 'CLOSECHILDREN) WHEN (OPENWP C) DO (CLOSEW C)) + (WINDOWPROP PARENT 'CLOSECHILDREN NIL) + PARENT]) + +(MOVEWITH + [LAMBDA (CHILDREN PARENT) (* ; "Edited 28-Jan-2022 23:43 by rmk") + [FOR C ONE INSIDE CHILDREN WHEN (AND C (SETQ C (WFROMDS C))) DO (SETQ ONE T) + (WINDOWADDPROP PARENT + 'MOVECHILDREN C) + FINALLY (CL:WHEN ONE + (WINDOWADDPROP PARENT 'MOVEFN (FUNCTION MOVEWITH.DOIT)))] + PARENT]) + +(MOVEWITH.DOIT + [LAMBDA (PARENT NEWPOS) (* ; "Edited 28-Jan-2022 22:34 by rmk") + [FOR C (DELTA _ (PTDIFFERENCE NEWPOS (WINDOWPOSITION PARENT))) IN (WINDOWPROP PARENT + 'MOVECHILDREN) + DO (MOVEW C (PTPLUS DELTA (WINDOWPOSITION C] + PARENT]) +) (MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG) @@ -626,9 +660,10 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1612 3799 (SET-TYPED-REGIONS 1622 . 3797)) (3800 10801 (RM-CREATEW 3810 . 6317) ( -RM-CLOSEW 6319 . 7720) (RM-GETREGION 7722 . 10308) (CLOSE-TYPED-W 10310 . 10799)) (11717 19196 ( -RELCREATEREGION 11727 . 16350) (RELGETREGION 16352 . 18959) (RELCREATEPOSITION 18961 . 19194)) (19197 -24499 (\RELCREATEREGION.REF 19207 . 22239) (\RELCREATEREGION.SIZE 22241 . 24497)) (24552 33894 ( -RM-ATTACHWINDOW 24562 . 33892))))) + (FILEMAP (NIL (1677 3864 (SET-TYPED-REGIONS 1687 . 3862)) (3865 10866 (RM-CREATEW 3875 . 6382) ( +RM-CLOSEW 6384 . 7785) (RM-GETREGION 7787 . 10373) (CLOSE-TYPED-W 10375 . 10864)) (11782 19261 ( +RELCREATEREGION 11792 . 16415) (RELGETREGION 16417 . 19024) (RELCREATEPOSITION 19026 . 19259)) (19262 +24564 (\RELCREATEREGION.REF 19272 . 22304) (\RELCREATEREGION.SIZE 22306 . 24562)) (24617 33959 ( +RM-ATTACHWINDOW 24627 . 33957)) (33960 35694 (CLOSEWITH 33970 . 34497) (CLOSEWITH.DOIT 34499 . 34779) +(MOVEWITH 34781 . 35304) (MOVEWITH.DOIT 35306 . 35692))))) STOP diff --git a/lispusers/REGIONMANAGER.LCOM b/lispusers/REGIONMANAGER.LCOM index 13abab87d5441ec8c38ab0163f58c4217841ddd6..c5ca9f11a5ddbf2037828407b0510c6a426137a9 100644 GIT binary patch delta 1209 zcmb_by>HV%6t^7~%!is*Afy)bS_T}XRQ`z5#Hvs%`%+&>e5crn+cF`6C_*q$i3N}c z{sAgWtVpaZRijFjr2_;1023-38x!Im;BuEZq;xfQ~UUu0hIEFldA4}lSF6v{_i^{$mBUm#3Xx6AYw(VH8B~YLH z(e0P3z3ux?w{K-HVH#uz$Jr)_owck1ywjJ9p+@;oZU3EBPQ$KH$A?`0OycvG?WSN0Ewo+Tre} zRMM&zBsla*;`%=A5(ARAu*(-vAaWi1lk8uJe!hUg1gtmCgjTw1^gLxw`9R|w!?vbRio&}R&)qzkH zCKN1IyB7;=9GIcQ8X5(95$dvFN?D5xC4ZblvZv1+#n@c`SEuw}g*uH+!fUD9k_^ad3hXiVF^2rBx>dF*dE#v}wb{51A)vx(RUcnFM@;~6LDJCxVv z#m7W&F*P={alGM?!JR8N3-x1@pUjIr$E3YwmjSSc34f4)R E0OTSkaplan>Local>medley3.5>my-medley>lispusers>comparetext.;109 49971 +(FILECREATED "30-Jan-2022 09:03:52"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;112 47459 :CHANGES-TO (FNS COMPARETEXT.TEXTOBJ) - :PREVIOUS-DATE "23-Jan-2022 20:22:06" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;108) + :PREVIOUS-DATE "28-Jan-2022 17:12:30" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;110) (* ; " @@ -130,12 +130,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. WINDOW]) (COMPARETEXT.TEXTOBJ - [LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 27-Jan-2022 13:14 by rmk") - (* ; "Edited 23-Jan-2022 16:51 by rmk") - (* ; "Edited 20-Jan-2022 22:29 by rmk") - (* ; "Edited 19-Jan-2022 08:52 by rmk") - (* ; "Edited 30-Dec-2021 21:21 by rmk") - (* ; "Edited 27-Dec-2021 15:56 by rmk") + [LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Jan-2022 09:03 by rmk") + (* ; "Edited 28-Jan-2022 22:37 by rmk") (* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.") @@ -172,30 +168,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. 'FILELABELS)) (CADDR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) 'FILELABELS)))] - [WINDOWADDPROP WINDOW 'MOVEFN (FUNCTION (LAMBDA (W NEWPOS) - (LET ((DELTA (PTDIFFERENCE NEWPOS ( - WINDOWPOSITION - W))) - TOBJ TW) - (CL:WHEN [AND (SETQ TOBJ - (WINDOWPROP W - 'COL1TEXTOBJ)) - (SETQ TW - (WFROMDS (TEXTSTREAM - TOBJ] - (MOVEW TW (PTPLUS DELTA ( - WINDOWPOSITION - TW)))) - (CL:WHEN [AND (SETQ TOBJ - (WINDOWPROP W - 'COL2TEXTOBJ)) - (SETQ TW - (WFROMDS (TEXTSTREAM - TOBJ] - (MOVEW TW (PTPLUS DELTA ( - WINDOWPOSITION - TW)))) - NIL]) + (MOVEWITH TWINDOW WINDOW) + (CLOSEWITH TWINDOW WINDOW)) TEXTOBJ]) (COMPARETEXT.SETSEL @@ -781,12 +755,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. ) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1345 42591 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) ( -COMPARETEXT.TEXTOBJ 7677 . 12786) (COMPARETEXT.SETSEL 12788 . 13578) (CHUNKNODELABEL 13580 . 14701) ( -IMCOMPARE.BOXNODE 14703 . 15470) (IMCOMPARE.CHUNKS 15472 . 19848) (IMCOMPARE.COLLECT.HASH.CHUNKS 19850 - . 22767) (IMCOMPARE.DISPLAYGRAPH 22769 . 30612) (IMCOMPARE.HASH 30614 . 34801) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 34803 . 38299) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 38301 . 40256) ( -IMCOMPARE.SHOW.DIST 40258 . 40704) (IMCOMPARE.UPDATE.SYMBOL.TABLE 40706 . 42589)) (42592 48749 ( -IMCOMPARE.LEFTBUTTONFN 42602 . 45179) (IMCOMPARE.MIDDLEBUTTONFN 45181 . 48297) (IMCOMPARE.COPYBUTTONFN - 48299 . 48747)) (48802 49493 (TAIL1 48812 . 49166) (TAIL2 49168 . 49491))))) + (FILEMAP (NIL (1345 40079 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) ( +COMPARETEXT.TEXTOBJ 7677 . 10274) (COMPARETEXT.SETSEL 10276 . 11066) (CHUNKNODELABEL 11068 . 12189) ( +IMCOMPARE.BOXNODE 12191 . 12958) (IMCOMPARE.CHUNKS 12960 . 17336) (IMCOMPARE.COLLECT.HASH.CHUNKS 17338 + . 20255) (IMCOMPARE.DISPLAYGRAPH 20257 . 28100) (IMCOMPARE.HASH 28102 . 32289) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 32291 . 35787) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 35789 . 37744) ( +IMCOMPARE.SHOW.DIST 37746 . 38192) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38194 . 40077)) (40080 46237 ( +IMCOMPARE.LEFTBUTTONFN 40090 . 42667) (IMCOMPARE.MIDDLEBUTTONFN 42669 . 45785) (IMCOMPARE.COPYBUTTONFN + 45787 . 46235)) (46290 46981 (TAIL1 46300 . 46654) (TAIL2 46656 . 46979))))) STOP