From 792edfdad5928d273a81b44a67d2c051427e9a81 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Sun, 9 Jan 2022 09:17:17 -0800 Subject: [PATCH] Rmk14: Browsers for COMPAREDIRECTORIES, COMPARESOURCES, COMPARETEXT for TEDIT files (#642) * TEXTOFD: Property OBJECTBYTE returned instead of image objects This allows COMPARETEXT to work on TEDIT files * ATBL: Default reader environment uses *DEFAULT-EXTERNALFORMAT* instead of :XCCS constant * CMLEXEC: Fix FILETYPE property It had CL:COMPILE-FILE, but the directory had LCOMs. Changed to :FAKE-COMPILE-FILE. * FILEIO: single place for EOL specification Now only in SETFILEINFO, not separately in \DO.PARAMS.AT.OPEN * WINDOWOBJ: COPYINSERT now uniformly allows lists of objects It was incomplete. * COMPARETEXT: Now works for TEDIT files * EXAMINEDEFS: side-by-side attached SEDIT windows for comparing alternative definitions * OBJECTWINDOW: container for arbitrary image objects * ATBL: fixed typo * MODERNIZEP: pass shape and move to main window if PASSTOMAINCOMS * EXAMINEDEFS: Remove EXAMINEDEFS-REGION Replaced by equivalent functionality in new package REGIONMANAGER * TEDIT: adjustments to give caller control of window region * Revert "TEDIT: adjustments to give caller control of window region" This reverts commit aec12b41f0877d4d8b0864bdabc7cc412a313bc9. * Revert "EXAMINEDEFS: Remove EXAMINEDEFS-REGION" This reverts commit 0c670bbc564499f72c17bbfbc0eb24a7da4059b4. * TEDIT, TEDITWINDOW: Adjustments for propagating (typed) regions * EXAMINEDEFS: added EXAMINEFILES for looking viewing files side-by-side Fix titling glitch, add EXAMINEFILES * OBJECTWINDOW: minor cleanup * REGIONMANAGER: new package for managing typed regions, relative regions, and constellation regions * TEDIT-PF-SEE: commands for scrollable PF and SEE alternatives * COREIO: Fixed bug in \CORE.SETFILEINFO * COMPAREDIRECTORIES: Added CDBROWSER and associated reworking * COMPARESOURCES: Added CSBROWSER and associated reworking * COMPARETEXT: Reworked for TEDIT files Also for better window management --- library/TEDIT | 104 +- library/TEDIT.LCOM | Bin 38924 -> 39116 bytes library/TEDITWINDOW | 192 ++-- library/TEDITWINDOW.LCOM | Bin 56489 -> 56508 bytes lispusers/COMPAREDIRECTORIES | 1491 +++++++++++++++++++--------- lispusers/COMPAREDIRECTORIES.LCOM | Bin 23936 -> 34120 bytes lispusers/COMPAREDIRECTORIES.TEDIT | 47 +- lispusers/COMPARESOURCES | 723 ++++++++++---- lispusers/COMPARESOURCES.LCOM | Bin 10362 -> 17008 bytes lispusers/COMPARESOURCES.TEDIT | Bin 9365 -> 10078 bytes lispusers/COMPARETEXT.LCOM | Bin 9124 -> 11615 bytes lispusers/COMPARETEXT.TEDIT | Bin 6425 -> 6467 bytes lispusers/EXAMINEDEFS | 54 +- lispusers/EXAMINEDEFS.LCOM | Bin 2236 -> 2345 bytes lispusers/EXAMINEDEFS.TEDIT | Bin 4371 -> 4166 bytes lispusers/MODERNIZE | 174 ++-- lispusers/MODERNIZE.LCOM | Bin 10725 -> 10920 bytes lispusers/OBJECTWINDOW | 49 +- lispusers/OBJECTWINDOW.LCOM | Bin 25686 -> 25696 bytes lispusers/OBJECTWINDOW.TEDIT | Bin 5918 -> 6054 bytes lispusers/REGIONMANAGER | 598 +++++++++++ lispusers/REGIONMANAGER.LCOM | Bin 0 -> 7392 bytes lispusers/REGIONMANAGER.TEDIT | 59 ++ lispusers/TEDIT-PF-SEE | 219 ++-- lispusers/TEDIT-PF-SEE.LCOM | Bin 3606 -> 3547 bytes lispusers/TEDIT-PF-SEE.TEDIT | Bin 0 -> 4021 bytes lispusers/comparetext | 828 +++++++++------ sources/ATBL | 55 +- sources/ATBL.LCOM | Bin 35256 -> 35244 bytes sources/COREIO | 89 +- sources/COREIO.LCOM | Bin 16700 -> 16649 bytes 31 files changed, 3253 insertions(+), 1429 deletions(-) create mode 100644 lispusers/REGIONMANAGER create mode 100644 lispusers/REGIONMANAGER.LCOM create mode 100644 lispusers/REGIONMANAGER.TEDIT create mode 100644 lispusers/TEDIT-PF-SEE.TEDIT diff --git a/library/TEDIT b/library/TEDIT index 3d3ffcc9..2ca665cf 100644 --- a/library/TEDIT +++ b/library/TEDIT @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Dec-2021 12:34:26" {DSK}kaplan>Local>medley3.5>my-medley>library>TEDIT.;21 142324 +(FILECREATED "30-Dec-2021 20:50:54" {DSK}kaplan>Local>medley3.5>my-medley>library>TEDIT.;30 142870 - :CHANGES-TO (FNS TEDIT-SEE) + :CHANGES-TO (FNS TEDIT TEDIT-SEE) - :PREVIOUS-DATE "13-Oct-2021 10:00:40" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDIT.;20) + :PREVIOUS-DATE "28-Dec-2021 11:02:43" +{DSK}kaplan>Local>medley3.5>my-medley>library>TEDIT.;24) (* ; " @@ -250,21 +250,29 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. NIL]) (TEDIT - [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ; "Edited 11-Jun-99 14:14 by rmk:") - (* ; "Edited 11-Jun-99 14:13 by rmk:") - (* ; "Edited 11-Jun-99 14:08 by rmk:") - (* ; "Edited 3-Jun-88 14:27 by jds") + [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ; "Edited 30-Dec-2021 20:50 by rmk") + (* ; "Edited 28-Dec-2021 00:12 by rmk") + (* ; "Edited 24-Dec-2021 19:21 by rmk") + (* ; "Edited 11-Jun-99 14:14 by rmk:") + (* ; "Edited 3-Jun-88 14:27 by jds") - (* ;; "User entry to the text editor. Takes an optional window to be used for editing") + (* ;; "User entry to the text editor. Takes an optional window to be used for editing") - (* ;; "DONTSPAWN => Don't try to create a new process for this edit.") + (* ;; "DONTSPAWN => Don't try to create a new process for this edit.") - (PROG (PROC TEDITCREATEDWINDOW) (* ; - "Include the default properties in the list.") + (PROG (PROC TEDITCREATEDWINDOW) (* ; + "Include the default properties in the list.") [COND - ((AND TEXT (ATOM TEXT)) (* ; - "Make sure the file exists before trying to open the window.") + ((AND TEXT (ATOM TEXT)) (* ; + "Make sure the file exists before trying to open the window.") (SETQ TEXT (OPENFILE TEXT 'INPUT 'OLD '((TYPE TEXT] + (CL:WHEN (AND WINDOW (OR (LITATOM WINDOW) + (REGIONP WINDOW))) + + (* ;; "Pass specified and typed regions to TEDIT.CREATEW") + + (PUSH PROPS 'REGION-TYPE WINDOW) + (SETQ WINDOW NIL)) (RESETLST [RESETSAVE NIL `(AND ,WINDOW (WINDOWPROP ,WINDOW 'TEXTOBJ NIL] (WITH.MONITOR TEDIT.STARTUP.MONITORLOCK @@ -272,7 +280,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. ((NOT WINDOW) (SETQ TEDITCREATEDWINDOW T) (SETQ WINDOW (COND - [(OR (NOT TEDIT.DEFAULT.WINDOW) + [(OR (LISTGET PROPS 'REGION-TYPE) + (NOT TEDIT.DEFAULT.WINDOW) (\TEDIT.ACTIVE.WINDOWP TEDIT.DEFAULT.WINDOW)) (TEDIT.CREATEW (COND ((AND TEXT (ATOM TEXT)) @@ -288,28 +297,27 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. 'REGION) TEXT (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS))) - (* ; "Replace the old title") + (* ; "Replace the old title") TEDIT.DEFAULT.WINDOW))) - (* ;; - "Mark the newly-created window reserved until the OPENTEXTSTREAM has done its work.") + (* ;; + "Mark the newly-created window reserved until the OPENTEXTSTREAM has done its work.") - (* ;; - "mark that we created the window so that we know we can update the title, etc.") + (* ;; + "mark that we created the window so that we know we can update the title, etc.") (WINDOWPROP WINDOW 'TEXTOBJ T))))) [SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL (APPEND PROPS '(BEING-EDITED T] - (* ; - "Connect the editor to the window") + (* ; "Connect the editor to the window") (replace (TEXTOBJ TXTEDITING) of (TEXTOBJ TEXT) with T) - (* ; "For the moment, mark the document as actively in edit. (so caret flashes when the window is first brought up.)") + (* ; "For the moment, mark the document as actively in edit. (so caret flashes when the window is first brought up.)") [COND (TEDITCREATEDWINDOW (TEXTPROP TEXT 'TEDITCREATEDWINDOW 'T] (COND - (DONTSPAWN (* ; - "Either no processes running, or specifically not to spawn one.") + (DONTSPAWN (* ; + "Either no processes running, or specifically not to spawn one.") (RETURN (\TEDIT2 TEXT WINDOW T))) - (T (* ; "Spawn a process to do the edit.") + (T (* ; "Spawn a process to do the edit.") [SETQ PROC (ADD.PROCESS (LIST '\TEDIT2 (KWOTE TEXT) WINDOW NIL) 'NAME @@ -323,13 +331,14 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (PROCESSPROP PROC 'WINDOW WINDOW) (COND ((NOT (LISTGET (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)) - 'LEAVETTY)) (* ; - "Unless he asked us to leave the tty where it is, TEdit should get it.") + 'LEAVETTY)) (* ; + "Unless he asked us to leave the tty where it is, TEdit should get it.") (TTY.PROCESS PROC))) (RETURN PROC]) (TEDIT-SEE - [LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 16-Dec-2021 12:33 by rmk") + [LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 30-Dec-2021 18:03 by rmk") + (* ; "Edited 16-Dec-2021 12:33 by rmk") (* ; "Edited 13-Oct-2021 10:00 by rmk:") (* ; "Edited 27-Feb-2021 20:07 by rmk:") (* ; "Edited 1-Feb-88 19:00 by bvm:") @@ -362,11 +371,12 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (CL:UNLESS (RANDACCESSP STREAM) (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) (COPYCHARS STREAM SEESTREAM))) - [SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL `(READONLY T FONT ,DEFAULTFONT] + [SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL + `(READONLY T LEAVETTY T FONT ,DEFAULTFONT] [WINDOWPROP (WFROMDS TSTREAM) 'TITLE (OR TITLE (CONCAT "SEE window for " (FULLNAME STREAM] - (FULLNAME STREAM]) + TSTREAM]) (TEDIT.CHARWIDTH [LAMBDA (CH FONT TERMSA) (* jds "22-OCT-83 19:32") @@ -2233,7 +2243,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ; "TEDIT Support information") -(RPAQQ TEDITSYSTEMDATE "16-Dec-2021 12:34:26") +(RPAQQ TEDITSYSTEMDATE "30-Dec-2021 20:50:54") (RPAQ TEDITSUPPORT "TEditSupport.PA") (DEFINEQ @@ -2259,19 +2269,19 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4330 117494 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) ( -TEDIT-SEE 20842 . 23170) (TEDIT.CHARWIDTH 23172 . 25196) (TEDIT.COPY 25198 . 33634) (TEDIT.DELETE -33636 . 34326) (TEDIT.DO.BLUEPENDINGDELETE 34328 . 37395) (TEDIT.INSERT 37397 . 42927) (TEDIT.KILL -42929 . 44486) (TEDIT.MAPLINES 44488 . 45887) (TEDIT.MAPPIECES 45889 . 46845) (TEDIT.MOVE 46847 . -56631) (TEDIT.QUIT 56633 . 58633) (TEDIT.STRINGWIDTH 58635 . 59306) (TEDIT.\INSERT 59308 . 61333) ( -TEXTOBJ 61335 . 62460) (TEXTSTREAM 62462 . 64077) (\TEDIT.INCLUDE 64079 . 67979) (\TEDIT.INSERT.PIECES - 67981 . 77896) (\TEDIT.MOVE.PIECEMAPFN 77898 . 79977) (\TEDIT.OBJECT.SHOWSEL 79979 . 83608) ( -\TEDIT.RESTARTFN 83610 . 85605) (\TEDIT.CHARDELETE 85607 . 89569) (\TEDIT.COPY.PIECEMAPFN 89571 . -92796) (\TEDIT.DELETE 92798 . 100316) (\TEDIT.DIFFUSE.PARALOOKS 100318 . 103082) (\TEDIT.FOREIGN.COPY? - 103084 . 106811) (\TEDIT.QUIT 106813 . 109959) (\TEDIT.WORDDELETE 109961 . 114794) (\TEDIT1 114796 . -117492)) (117608 117724 (\CREATE.TEDIT.RESTART.MENU 117618 . 117722)) (117823 121512 (PLCHAIN 117833 - . 118107) (PRINTLINE 118109 . 120873) (SEEFILE 120875 . 121510)) (121553 141196 (TEDIT.INSERT.OBJECT -121563 . 130640) (TEDIT.EDIT.OBJECT 130642 . 132898) (TEDIT.FIND.OBJECT 132900 . 133793) ( -TEDIT.FIND.OBJECT.SUBTREE 133795 . 134601) (TEDIT.PUT.OBJECT 134603 . 136262) (TEDIT.GET.OBJECT 136264 - . 139463) (TEDIT.OBJECT.CHANGED 139465 . 141194)) (141474 141837 (MAKETEDITFORM 141484 . 141835))))) + (FILEMAP (NIL (4336 118040 (\TEDIT2 4346 . 7097) (COERCETEXTOBJ 7099 . 15875) (TEDIT 15877 . 21230) ( +TEDIT-SEE 21232 . 23716) (TEDIT.CHARWIDTH 23718 . 25742) (TEDIT.COPY 25744 . 34180) (TEDIT.DELETE +34182 . 34872) (TEDIT.DO.BLUEPENDINGDELETE 34874 . 37941) (TEDIT.INSERT 37943 . 43473) (TEDIT.KILL +43475 . 45032) (TEDIT.MAPLINES 45034 . 46433) (TEDIT.MAPPIECES 46435 . 47391) (TEDIT.MOVE 47393 . +57177) (TEDIT.QUIT 57179 . 59179) (TEDIT.STRINGWIDTH 59181 . 59852) (TEDIT.\INSERT 59854 . 61879) ( +TEXTOBJ 61881 . 63006) (TEXTSTREAM 63008 . 64623) (\TEDIT.INCLUDE 64625 . 68525) (\TEDIT.INSERT.PIECES + 68527 . 78442) (\TEDIT.MOVE.PIECEMAPFN 78444 . 80523) (\TEDIT.OBJECT.SHOWSEL 80525 . 84154) ( +\TEDIT.RESTARTFN 84156 . 86151) (\TEDIT.CHARDELETE 86153 . 90115) (\TEDIT.COPY.PIECEMAPFN 90117 . +93342) (\TEDIT.DELETE 93344 . 100862) (\TEDIT.DIFFUSE.PARALOOKS 100864 . 103628) (\TEDIT.FOREIGN.COPY? + 103630 . 107357) (\TEDIT.QUIT 107359 . 110505) (\TEDIT.WORDDELETE 110507 . 115340) (\TEDIT1 115342 . +118038)) (118154 118270 (\CREATE.TEDIT.RESTART.MENU 118164 . 118268)) (118369 122058 (PLCHAIN 118379 + . 118653) (PRINTLINE 118655 . 121419) (SEEFILE 121421 . 122056)) (122099 141742 (TEDIT.INSERT.OBJECT +122109 . 131186) (TEDIT.EDIT.OBJECT 131188 . 133444) (TEDIT.FIND.OBJECT 133446 . 134339) ( +TEDIT.FIND.OBJECT.SUBTREE 134341 . 135147) (TEDIT.PUT.OBJECT 135149 . 136808) (TEDIT.GET.OBJECT 136810 + . 140009) (TEDIT.OBJECT.CHANGED 140011 . 141740)) (142020 142383 (MAKETEDITFORM 142030 . 142381))))) STOP diff --git a/library/TEDIT.LCOM b/library/TEDIT.LCOM index dde38748a4b0898768d0540b9c3bc5b7d627c795..be733c3db7e7419d73f41a609f6e2843c5728b08 100644 GIT binary patch delta 1657 zcmZuy&u<$=6!tnLq#IHkk{Xoq_vQv%B^h6?J2;ldbIC&F(sBL=I7Y2wOl~ z6%I%ojB-QDfih|ja6?=W2a-mS;L_ZX5FC1i8~g=G+#BA^uH6t~S>CtvX5RbW`@T2c z+t2@YkpE(Jmg$w|&Q^u$lmON1CVq{3?*|UkH7HU0sgu}s-KZPY5^Ubx*}DDVo&EDfnRUPV$CC6WM<4O`hx#h=MI+?T*yRHWHFmhMCpc_}37#5+|PC+Mioz@Lj0+ol# zHN`l5DQ{oAax;Mz5D23njM1X7>iNxJ6-~zV`&R}nFw#63)YPp(?yKB0IVJABm&4Db z_=&ze$bH`5npl=gZywHWh}Ey9{!nbkgNN@ zZwyBJei=Xi)bWPcvUOowrtQl}g9+x)X-3-=si@4UHgl*MR6Itb2akjohp^Hba-+a1y9mX>*40ph}*Guq+W_4Ge?- z{9I*PMMMm@-%Nsq8$g)J{mJ4OAqJnme>qQd-kE$cZxQ*%Y~jo^CLUL*2`R)%vKG2v zAxFv5d?)a|B#2N+P^JLTb-(Py`72HKED3_PJ0V*Ry zp@HwUHBIIJT>7c7`>c|?Fb&G}qp{tC+>Z`Fdj3=8T}}$c@;1Bv_jit@>zjjX*NfvD5(N+;EPc~_|>cp$fRjN+lv$A7jQZwaR$BiCRLxjoqZ{3yu*ktanyK24Dok;8;7lt`lrFt72-`S#hyEV5Tkj8ZbkU zA_s>dTWOP-&N7SEFkUJ=%#t`!((-}U2-cIn1yKhmifPG-ni2=Tjl9kRR!>n)iM!qZ z7%c+6)4?TUm}x+1ZPWv*W3}xjUSt$JUv>y1pB4}?YH3aXnQ5ti3G&P`PQpmFx;U9C zxTcTHYt%a1LLo~^C@M~BRvgkaFj0aFuIDdSL`(7F!$p;sXZBtem|9ZW+4WO}#7o+E zspWp8a3+og}aAXOz0v{EJ6b~i9A6;HnY+fkZV^{)j7Z=6z S@Impf!MT4chkFk`Q~m|92b9|Y delta 1420 zcmZuxL2nyH6!yANNZdGasFR2!s1FMy8_Cwr%zD?mLV}HVH(6xwZg$5pLE!*S)K~@5 zmK=~O)rd1lM5C&AgoL=IwK!B9dIhNmdgKNiIHLZ8_RTtWqAGiseKYgko9}(|y?OdD z``u~whi;MRRp+2rr79&rsKqpk>L)kD0VNeE5$$}F5=%2IMoRG6orB)d7q|MKAM8W! z;Okp=zIw+3?m9lNCaw$pFQMdhS}nL3U8~hfu>a{XhFq4_C{=Q0&u_WS*tIbgtduST zR)Ujz@2w%y9MLGF8d%LOJJ@uSDi5LT1&R1YSuYY+4SUCDC8?IGTAF%t_x&tYhpSn0 zRzsjQ$Mx(^i`Tk-;DlZ9fM5k5aWp7Q))+)_7$vx=E1k_4<*twiEI9)unaDW*+@BTFA-e)4xWJe@v$i#dn`X zy{Y{)T|doNI4oq!gi?q)d;~~h0ix=nJNM>}N?^~9A~$d-m^w7WXcrn3_WU5}#O_%I zhK3tK)8NA0Eo}_3hNo~l=3an_RT$60xD6ER*s^0M#euWQuDyX3Q(8wH`~73IR0!-g zE~(>_-XaZS!U55dsFnjnC*TJuLmEMuFDr%|Z=6#^P;`&chdV3( O4laFZhph+SC@%plC1Mc( diff --git a/library/TEDITWINDOW b/library/TEDITWINDOW index 3edfdfa4..9e5137b1 100644 --- a/library/TEDITWINDOW +++ b/library/TEDITWINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Oct-2021 18:52:11"  -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18 187780 +(FILECREATED " 1-Jan-2022 23:55:46"  +{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;31 189222 - changes to%: (FNS TEDIT.DEACTIVATE.WINDOW) + :CHANGES-TO (FNS TEDIT.CREATEW) - previous date%: "12-Oct-2021 15:10:06" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;17) + :PREVIOUS-DATE " 1-Jan-2022 17:37:20" +{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;30) (* ; " @@ -34,7 +34,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (INITVARS (TEDIT.DEFAULT.WINDOW NIL)) (GLOBALVARS TEDIT.DEFAULT.WINDOW) (COMS (* ; - "User-level %"is this a TEdit window?%" function.") + "User-level %"is this a TEdit window?%" function.") (FNS TEDITWINDOWP)) (COMS (* ; "User-typein support") (FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME)) @@ -51,8 +51,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (COMS (* ; "Process-world interfaces") (FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN)) (COMS (INITVARS (\CARETRATE 333)) - (* ; - "Caret handler; stolen from CHAT.") + (* ; "Caret handler; stolen from CHAT.") (FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET)) [COMS (* ; "Menu interfacing") @@ -89,15 +88,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD)) [TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL] (* ; - "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).") + "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).") (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + "Changed by yabu.fx, for SUNLOADUP without DWIM.") [TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION NIL] (* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).") (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + "Changed by yabu.fx, for SUNLOADUP without DWIM.") ]) (FILESLOAD TEDITDCL) @@ -119,27 +118,53 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (DEFINEQ (TEDIT.CREATEW - [LAMBDA (PROMPT FILE PROPS) (* jds "23-May-85 15:19") + [LAMBDA (PROMPT FILE PROPS) (* ; "Edited 1-Jan-2022 23:54 by rmk") + (* ; "Edited 30-Dec-2021 23:00 by rmk") + (* ; "Edited 29-Dec-2021 16:35 by rmk") + (* ; "Edited 24-Dec-2021 19:21 by rmk") + (* ; "Edited 27-Oct-2021 12:25 by rmk:") + + (* ;; "RMK: PROPS are passed to CREATEW and \TEDIT.ORIGINAL.WINDOW.TITLE. .") + + (* ;; + "RMK: If PROMPTWINDOW is in PROPS, I don't see how it gets attached to the new Tedit window.") + + (* ;; + "Also odd: The argument PROMPT gets printed, but then gets replaced by the property PROMPT") + + (* ;; "Don't set the global TEDIT default window if we have a region property, that must be special purpose.") + (* jds "23-May-85 15:19") (CLRPROMPT) (printout PROMPTWINDOW PROMPT T) - (PROG ((PROMPT (LISTGET PROPS 'PROMPTWINDOW)) - (PHEIGHT 0) - PWINDOW REGION) - [COND - ((EQ PROMPT 'DON'T)) - (PROMPT) - (T (SETQ PHEIGHT (HEIGHTIFWINDOW (ITIMES (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - (FONTPROP TEDIT.PROMPT.FONT 'HEIGHT] - (SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32))) - (add (fetch HEIGHT of REGION) - (IMINUS PHEIGHT)) - (SETQ TEDIT.DEFAULT.WINDOW (CREATEW REGION (\TEDIT.ORIGINAL.WINDOW.TITLE FILE))) - (CLRPROMPT) - (OR PROMPT (GETPROMPTWINDOW TEDIT.DEFAULT.WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - TEDIT.PROMPT.FONT))) - TEDIT.DEFAULT.WINDOW]) + (LET ((PROMPT (LISTGET PROPS 'PROMPTWINDOW)) + (PHEIGHT 0) + REGION + (REGIONTYPE (LISTGET PROPS 'REGION-TYPE)) + WINDOW) + + (* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.") + + [COND + ((EQ PROMPT 'DON'T)) + [PROMPT (CL:WHEN (WINDOWP PROMPT) (* ; + "RMK: If not a window, PHEIGHT remains 0") + (SETQ PHEIGHT (FETCH (REGION HEIGHT) OF (WINDOWREGION PROMPT))))] + (T (SETQ PHEIGHT (HEIGHTIFWINDOW (ITIMES (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) + TEDIT.PROMPTWINDOW.HEIGHT 1) + (FONTPROP TEDIT.PROMPT.FONT 'HEIGHT] + (SETQ REGION (OR (REGIONP REGIONTYPE) + (GETREGION 32 (IPLUS PHEIGHT 32) + REGIONTYPE))) + (add (fetch HEIGHT of REGION) + (IMINUS PHEIGHT)) + (SETQ WINDOW (CREATEW REGION (\TEDIT.ORIGINAL.WINDOW.TITLE FILE NIL PROPS) + NIL NIL PROPS)) + (WINDOWPROP WINDOW 'TEDITCREATED T) + (OR PROMPT (GETPROMPTWINDOW WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) + TEDIT.PROMPTWINDOW.HEIGHT 1) + TEDIT.PROMPT.FONT)) + (CL:UNLESS REGIONTYPE (SETQ TEDIT.DEFAULT.WINDOW WINDOW)) + WINDOW]) (\TEDIT.CREATEW.FROM.REGION [LAMBDA (REGION FILE PROPS) (* gbn "15-Nov-84 18:04") @@ -1627,43 +1652,36 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ""]) (\TEDIT.ORIGINAL.WINDOW.TITLE - [LAMBDA (FILE DIRTY?) (* ; "Edited 24-Aug-2021 23:25 by rmk:") + [LAMBDA (FILE DIRTY? PROPS) (* ; "Edited 27-Oct-2021 12:25 by rmk:") + (* ; "Edited 24-Aug-2021 23:25 by rmk:") - (* ;; "Given a file name, derive a title for the TEdit window that is editing it.") + (* ;; "Given a file name, derive a title for the TEdit window that is editing it. RMK: Title may be provided in a property") - (PROG (TITLE) - (RETURN (COND - ((NULL FILE) (* ; - "Just calling (TEDIT) should give a 'Text Editor Window'") - (CONCAT (COND - (DIRTY? "* ") - (T "")) + (LET (TITLE) + [SETQ TITLE (COND + ((LISTGET PROPS 'TITLE)) + ((NULL FILE) (* ; + "Just calling (TEDIT) should give a 'Text Editor Window'") + "Text Editor Window") + ((AND (STRINGP FILE) + (ZEROP (NCHARS FILE))) (* ; + "So should editing an empty string") + "Text Editor Window") + ((WINDOWP FILE) (* ; + "if \TEDIT.WINDOW.SETUP has assigned a title, use it") + (OR (WINDOWPROP FILE 'TITLE) "Text Editor Window")) - ((AND (STRINGP FILE) - (ZEROP (NCHARS FILE))) (* ; - "So should editing an empty string") - (CONCAT (COND - (DIRTY? "* ") - (T "")) - "Text Editor Window")) - ((WINDOWP FILE) - (COND - ((SETQ TITLE (WINDOWPROP FILE 'TITLE)) - (* ; - "if \TEDIT.WINDOW.SETUP has assigned a title, use it") - TITLE) - (T "Text Editor Window"))) - (T (* ; - "Strings use the string itself, otherwise grab the full file name.") - (CONCAT (COND - (DIRTY? "* ") - (T "")) - "Edit Window for: " - (CL:TYPECASE FILE - (STRINGP FILE) - (STREAM (fetch (STREAM FULLNAME) of FILE)) - (LITATOM FILE) - (T FILE))]) + (T (* ; + "Strings use the string itself, otherwise grab the full file name.") + (CONCAT "Edit Window for: " (CL:TYPECASE FILE + (STRINGP FILE) + (STREAM (fetch (STREAM FULLNAME) + of FILE)) + (LITATOM FILE) + (T FILE))] + (COND + (DIRTY? (CONCAT "* " TITLE)) + (T TITLE]) (\TEDIT.WINDOW.TITLE [LAMBDA (TEXTSTREAM NEW.TITLE) (* jds "23-May-85 15:20") @@ -2851,30 +2869,30 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (RPAQ? TEDIT.ICON.TITLE.REGION [CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]) -(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION - NIL)))) +(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION NIL)) + )) (PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 1993 1994 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7291 94107 (TEDIT.CREATEW 7301 . 8437) (\TEDIT.CREATEW.FROM.REGION 8439 . 9423) ( -TEDIT.CURSORMOVEDFN 9425 . 20811) (TEDIT.CURSOROUTFN 20813 . 21348) (TEDIT.WINDOW.SETUP 21350 . 23159) - (TEDIT.MINIMAL.WINDOW.SETUP 23161 . 30950) (\TEDIT.ACTIVE.WINDOWP 30952 . 31933) ( -\TEDIT.BUTTONEVENTFN 31935 . 56925) (\TEDIT.WINDOW.OPS 56927 . 60888) (\TEDIT.EXPANDFN 60890 . 61293) -(\TEDIT.MAINW 61295 . 62584) (\TEDIT.PRIMARYW 62586 . 63798) (\TEDIT.COPYINSERTFN 63800 . 64771) ( -\TEDIT.NEWREGIONFN 64773 . 67240) (\TEDIT.SET.WINDOW.EXTENT 67242 . 73344) (\TEDIT.SHRINK.ICONCREATE -73346 . 75618) (\TEDIT.SHRINKFN 75620 . 76195) (\TEDIT.SPLITW 76197 . 82298) (\TEDIT.UNSPLITW 82300 . -87994) (\TEDIT.WINDOW.SETUP 87996 . 93716) (\SAFE.FIRST 93718 . 94105)) (95437 96344 (TEDITWINDOWP -95447 . 96342)) (96381 98877 (TEDIT.GETINPUT 96391 . 98374) (\TEDIT.MAKEFILENAME 98376 . 98875)) ( -98926 105377 (TEDIT.PROMPTPRINT 98936 . 101840) (TEDIT.PROMPTFLASH 101842 . 103797) ( -\TEDIT.PROMPT.PAGEFULLFN 103799 . 105375)) (105612 109674 (TEXTSTREAM.TITLE 105622 . 106243) ( -\TEDIT.ORIGINAL.WINDOW.TITLE 106245 . 108290) (\TEDIT.WINDOW.TITLE 108292 . 108962) ( -\TEXTSTREAM.FILENAME 108964 . 109672)) (109717 154616 (TEDIT.DEACTIVATE.WINDOW 109727 . 117034) ( -\TEDIT.REPAINTFN 117036 . 119893) (\TEDIT.RESHAPEFN 119895 . 125515) (\TEDIT.SCROLLFN 125517 . 154614) -) (154658 156707 (\TEDIT.PROCIDLEFN 154668 . 156017) (\TEDIT.PROCENTRYFN 156019 . 156312) ( -\TEDIT.PROCEXITFN 156314 . 156705)) (156786 167786 (\EDIT.DOWNCARET 156796 . 157477) (\EDIT.FLIPCARET -157479 . 159014) (TEDIT.FLASHCARET 159016 . 160130) (\EDIT.UPCARET 160132 . 160585) ( -TEDIT.NORMALIZECARET 160587 . 166538) (\SETCARET 166540 . 167460) (\TEDIT.CARET 167462 . 167784)) ( -167820 181575 (TEDIT.ADD.MENUITEM 167830 . 169745) (TEDIT.DEFAULT.MENUFN 169747 . 179014) ( -TEDIT.REMOVE.MENUITEM 179016 . 180017) (\TEDIT.CREATEMENU 180019 . 180472) (\TEDIT.MENU.WHENHELDFN -180474 . 181244) (\TEDIT.MENU.WHENSELECTEDFN 181246 . 181573))))) + (FILEMAP (NIL (7220 95654 (TEDIT.CREATEW 7230 . 9984) (\TEDIT.CREATEW.FROM.REGION 9986 . 10970) ( +TEDIT.CURSORMOVEDFN 10972 . 22358) (TEDIT.CURSOROUTFN 22360 . 22895) (TEDIT.WINDOW.SETUP 22897 . 24706 +) (TEDIT.MINIMAL.WINDOW.SETUP 24708 . 32497) (\TEDIT.ACTIVE.WINDOWP 32499 . 33480) ( +\TEDIT.BUTTONEVENTFN 33482 . 58472) (\TEDIT.WINDOW.OPS 58474 . 62435) (\TEDIT.EXPANDFN 62437 . 62840) +(\TEDIT.MAINW 62842 . 64131) (\TEDIT.PRIMARYW 64133 . 65345) (\TEDIT.COPYINSERTFN 65347 . 66318) ( +\TEDIT.NEWREGIONFN 66320 . 68787) (\TEDIT.SET.WINDOW.EXTENT 68789 . 74891) (\TEDIT.SHRINK.ICONCREATE +74893 . 77165) (\TEDIT.SHRINKFN 77167 . 77742) (\TEDIT.SPLITW 77744 . 83845) (\TEDIT.UNSPLITW 83847 . +89541) (\TEDIT.WINDOW.SETUP 89543 . 95263) (\SAFE.FIRST 95265 . 95652)) (96984 97891 (TEDITWINDOWP +96994 . 97889)) (97928 100424 (TEDIT.GETINPUT 97938 . 99921) (\TEDIT.MAKEFILENAME 99923 . 100422)) ( +100473 106924 (TEDIT.PROMPTPRINT 100483 . 103387) (TEDIT.PROMPTFLASH 103389 . 105344) ( +\TEDIT.PROMPT.PAGEFULLFN 105346 . 106922)) (107159 111152 (TEXTSTREAM.TITLE 107169 . 107790) ( +\TEDIT.ORIGINAL.WINDOW.TITLE 107792 . 109768) (\TEDIT.WINDOW.TITLE 109770 . 110440) ( +\TEXTSTREAM.FILENAME 110442 . 111150)) (111195 156094 (TEDIT.DEACTIVATE.WINDOW 111205 . 118512) ( +\TEDIT.REPAINTFN 118514 . 121371) (\TEDIT.RESHAPEFN 121373 . 126993) (\TEDIT.SCROLLFN 126995 . 156092) +) (156136 158185 (\TEDIT.PROCIDLEFN 156146 . 157495) (\TEDIT.PROCENTRYFN 157497 . 157790) ( +\TEDIT.PROCEXITFN 157792 . 158183)) (158264 169264 (\EDIT.DOWNCARET 158274 . 158955) (\EDIT.FLIPCARET +158957 . 160492) (TEDIT.FLASHCARET 160494 . 161608) (\EDIT.UPCARET 161610 . 162063) ( +TEDIT.NORMALIZECARET 162065 . 168016) (\SETCARET 168018 . 168938) (\TEDIT.CARET 168940 . 169262)) ( +169298 183053 (TEDIT.ADD.MENUITEM 169308 . 171223) (TEDIT.DEFAULT.MENUFN 171225 . 180492) ( +TEDIT.REMOVE.MENUITEM 180494 . 181495) (\TEDIT.CREATEMENU 181497 . 181950) (\TEDIT.MENU.WHENHELDFN +181952 . 182722) (\TEDIT.MENU.WHENSELECTEDFN 182724 . 183051))))) STOP diff --git a/library/TEDITWINDOW.LCOM b/library/TEDITWINDOW.LCOM index 0f4d0b90729144a2d28f58696b1217fc2fbf9249..a407325e15cc45d12a7b0be2f64c7096261426c2 100644 GIT binary patch delta 1159 zcmZuwO-~b16fG^4Fhm29fPBSkG0+;P%zHDPnT`u6?X;cJ&P=ASRJ0pNQHn?t#E5Z$ z;SV6r(gkaGK+^?@i7OZGU8qY<+?W`Cf^R-b#4yR^-Fx4eGw0s(-uu(ghttrT>L4Jt zu)N7)4r9Q)l1M0mc<@9FK7DDk!HE$b#UOG4gB4Cv1n%Jb#7f#yQ$(#oV-q6TO0fw4 z0^{*`1nSG%tMy9>#7K;ZX0@W~k!1b@b(FlC@|74o0wgCfm8qojDLto_Sz3E;4|Uk(sCo0#r3UV^qNe9xOGd z89EKIACe_gwe|2!pJ^E-lf)qKGi)CRr$*-=2k0|BFxj1Vqq7#9Z-@4d1GfDucspC@ zb++5rHbC2euZ2D*dsq(!gA4TSTGzgPxv`L1n|JGL_4%t|2T-fKR1LS9Z`~}~zr$m@ z9}BJV;;^&d?~gxzf~k+Fe}8%=nh2* zN$5C@1P*H6v<*wM7p`0%M@V!?e0s!n#$!S@EP(^esO7Y!nZ&R_#+UF&frXf8W}-2sH5uMn*`=-04$Ghcf{bR7rCAzs;2cY8=V2%i2n|4&@26|w>$!Gs z(;4{Db9d5*bMCUVe%6}S!lCw@GH1ySvLcZ1+>|+)Ccf z`t#H|ln@|o=;;(45pALqa&$WM;OVK7YJwy|E&D)qToMt~G`(E0RNu%1f9^9cfllv? zRR*4eGO;v0XVTk;cnrm=MpDEm0m8`HQd2ZU!gfxupQD%Yq$m40TC1+ZZ0gJVeOq&Nev6=9Z6b?KeiB{RNUi7k2;v delta 1028 zcmZuw&rcIU6mEB0kSY-f%CA74n+RPK>dyY|US!j5%Z7G$vt81F!~|)DBB2JVazhin zOD3K?n0PSpW*{U&OgMS)=D`D;IC%BopWw_c#A4WF=e>FFd*8hM-t5-{_R|6TrrM9x zNq4C=DGDM2q#KH8AaUoh$}Trr_(gnl2%bLeOC@Lr zWilBKYKyIU?XqH7=J-^)V3(|%Z<&FW{|^+kf$;D6_<0|rNGI)Snl8Z7%HsNReG^*E z+XkcyP6bl<=x|_yhbJ5LXN~65&G2NBhA z0||VqXuA&J*GU7vW4f5#1pdg3v%MUPkCVdW8rW-aoQjd>KEp6GEu1^Oo;=penFn zJC#}AI-8fGLF9QLBXDxlre6Uv!%E=WPSFFRa70h8H<=EU?7$4%vJXfJL6%u2^Ux?h zbpMr-0y2LYIIGrZLA9}7Yd(iZ%?$&91B9}`Q6m9&hwcRdKWNlarry>ilisp>medley>lispusers>COMPAREDIRECTORIES.;277 64829 - changes to%: (VARS MEDLEY-FIX-DIRS COMPAREDIRECTORIESCOMS) +(FILECREATED "30-Dec-2021 18:22:13"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;116 100755 - previous date%: " 2-Mar-2021 22:02:21" -{DSK}larry>ilisp>medley>lispusers>COMPAREDIRECTORIES.;276) + :CHANGES-TO (FNS CD-MENUFN) + + :PREVIOUS-DATE "25-Dec-2021 12:59:47" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;114) (* ; " @@ -18,12 +19,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp ( (* ;; "Compare the contents of two directories.") - (FNS COMPAREDIRECTORIES CDFILES COMPAREDIRECTORIES.INFOS MATCHNAME) - (VARS) - (FNS CDPRINT CDPRINT.LINE) + (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME + CD.INSURECDVALUE CD.UPDATEWIDTHS) + (FNS CDFILES CDFILES.MATCH CDFILES.PATS) + (FNS CDPRINT CDPRINT.LINE CDPRINT.MAXWIDTHS CDPRINT.COLHEADERS CDPRINT.COLUMNS CDTEDIT) (FNS CDMAP CDENTRY CDSUBSET) (FNS BINCOMP EOLTYPE EOLTYPE.SHOW) - (RECORDS CDENTRY CDINFO) + (RECORDS CDVALUE CDENTRY CDINFO CDMAXNCHARS) (* ;; "look for compiled files older than the sources") @@ -34,9 +36,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp COMPILED-ON-SAME-SOURCE) [VARS (ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01") (IDATE "1-Jan-2020 12:00:00"] - (INITVARS (LASTCDENTRIES NIL)) - (COMS (FNS COMPARE-ENTRY-SOURCE-FILES) - (FILES COMPARESOURCES)))) + (INITVARS (LASTCDVALUE NIL)) + + (* ;; "Compare-directories browser") + + (COMS (FNS CDBROWSER CDBROWSER.STRINGS) + + (* ;; "TABLEBROWSER browser") + + (FILES (SYSLOAD) + TABLEBROWSER) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + TABLEBROWSER)) + (FNS CD.TABLEITEM CD.TABLEITEM.PRINTFN CD.TABLEITEM.COPYFN + CDTABLEBROWSER.HEADING.REPAINTFN) + (FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN) + (VARS CDTABLEBROWSER.MENUITEMS) + (FILES (SYSLOAD) + COMPARESOURCES COMPARETEXT)))) @@ -45,42 +62,46 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (DEFINEQ (COMPAREDIRECTORIES - [LAMBDA (DIR1 DIR2 SELECT FILEPATTERNS EXTENSIONSTOAVOID USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS) - (* ; "Edited 7-Jan-2021 23:21 by rmk:") + [LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS + FIXDIRECTORYDATES) (* ; "Edited 23-Dec-2021 18:59 by rmk") + (* ; "Edited 19-Dec-2021 20:07 by rmk") + (* ; "Edited 30-Nov-2021 13:51 by rmk:") + (* ; "Edited 23-Nov-2021 12:57 by rmk:") + (* ; "Edited 6-Nov-2021 12:08 by rmk:") + (* ; "Edited 31-Oct-2021 11:01 by rmk:") + (* ; "Edited 7-Jan-2021 23:21 by rmk:") - (* ;; "Compare the contents of two directories, e.g., for change-control purposes. Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other. If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (< >), T is the same as (< > =). Also allows selection based on file-length criteria.") + (* ;; "Compare the contents of two directories, e.g., for change-control purposes. Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other. If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (< >), T is the same as (< > =). Also allows selection based on file-length criteria.") - (* ;; "") + (* ;; "") - (* ;; "Unless USEDIRECTORYDATE, comparison is with respect to the the LISP filecreated dates if evailable.") + (* ;; "Unless USEDIRECTORYDATE, comparison is with respect to the the LISP filecreated dates if evailable.") - (* ;; "") + (* ;; "") - (* ;; "If OUTPUTFILE is NIL, the list of compared entries is returned. Otherwise the selected entries are printed on OUTPUTFILE (T for the display).") + (* ;; "If OUTPUTFILE is NIL, the list of compared entries is returned. Otherwise the selected entries are printed on OUTPUTFILE (T for the display).") [SETQ SELECT (SELECTQ SELECT (NIL '(< > -* *-)) (T '(< > -* *- =)) - (FOR S IN (MKLIST SELECT) COLLECT (SELECTQ S - ((AFTER >) - '>) - ((BEFORE <) - '<) - ((SAME SAMEDATE =) - '=) - (AUTHOR 'AUTHOR) - (-* '-*) - (*- '*-) - (~= '~=) - (ERROR - "UNRECOGNIZED SELECT PARAMETER" - S] - (PROG (INFOS1 INFOS2 CANDIDATES SELECTED COMPAREDATE DEPTH1 DEPTH2) + (for S in (MKLIST SELECT) collect (SELECTQ S + ((AFTER >) + '>) + ((BEFORE <) + '<) + ((SAME SAMEDATE =) + '=) + (AUTHOR 'AUTHOR) + (-* '-*) + (*- '*-) + (~= '~=) + (ERROR "UNRECOGNIZED SELECT PARAMETER" S] + (PROG (INFOS1 INFOS2 CANDIDATES CDENTRIES COMPAREDATE DEPTH1 DEPTH2 CDVALUE) [SETQ COMPAREDATE (INTERSECTION SELECT '(< > =] - (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.") + (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.") - (* ;; "Allow all subdirectories if a directory ends in *, but peel it off for the resolution") + (* ;; "Allow all subdirectories if a directory ends in *, but peel it off for the resolution") (CL:WHEN (EQ '* (NTHCHAR DIR1 -1)) (SETQ DEPTH1 T) @@ -92,399 +113,645 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (ERROR "DIRECTORY DOES NOT EXIST" DIR1))) (SETQ DIR2 (OR (DIRECTORYNAME (OR DIR2 T)) (ERROR "DIRECTORY DOES NOT EXIST" DIR2))) + (CL:WHEN FIXDIRECTORYDATES + (PRINTOUT T "Fixing directory dates" T) + (FIX-DIRECTORY-DATES DIR1) + (FIX-DIRECTORY-DATES DIR2)) (PRINTOUT T "Comparing " DIR1 6 "vs. " DIR2 T "as of " (DATE) " selecting " SELECT " ... ") - (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 FILEPATTERNS EXTENSIONSTOAVOID - ALLVERSIONS DEPTH1) - USEDIRECTORYDATE)) - (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 FILEPATTERNS EXTENSIONSTOAVOID - ALLVERSIONS DEPTH2) - USEDIRECTORYDATE)) - (CL:UNLESS (AND INFOS2 INFOS1) - (RETURN)) + (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES + ALLVERSIONS DEPTH1) + USEDIRECTORYDATE DIR1)) + (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 INCLUDEDFILES EXCLUDEDFILES + ALLVERSIONS DEPTH2) + USEDIRECTORYDATE DIR2)) + (SETQ CDVALUE (CREATE CDVALUE + CDDIR1 _ DIR1 + CDDIR2 _ DIR2 + CDCOMPAREDATE _ (DATE) + CDSELECT _ SELECT)) + (CL:UNLESS (OR INFOS2 INFOS1) + (RETURN CDVALUE)) - (* ;; "At this point the CAR of each info is the atomic match-name. Peel it off to produce candidate entries.") + (* ;; "At this point the CAR of each info is the atomic match-name. Peel it off to produce candidate entries.") - (* ;; - "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname") + (* ;; + "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname") - [SETQ CANDIDATES (FOR I1 IN INFOS1 - JOIN (IF ALLVERSIONS - THEN (OR (FOR I2 IN INFOS2 - WHEN (EQ (CAR I2) - (CAR I1)) - COLLECT (LIST (CAR I1) - (CDR I1) - (CDR I2))) - (CONS (LIST (CAR I1) - (CDR I1) - NIL))) - ELSE (CONS (LIST (CAR I1) - (CDR I1) - (CDR (ASSOC (CAR I1) - INFOS2] + [SETQ CANDIDATES (for I1 in INFOS1 + join (if ALLVERSIONS + then (OR (for I2 in INFOS2 when (EQ (CAR I2) + (CAR I1)) + collect (LIST (CAR I1) + (CDR I1) + (CDR I2))) + (CONS (LIST (CAR I1) + (CDR I1) + NIL))) + else (CONS (LIST (CAR I1) + (CDR I1) + (CDR (ASSOC (CAR I1) + INFOS2] - (* ;; "Could be some 2's without 1's") + (* ;; "Could be some 2's without 1's") - (SORT [NCONC CANDIDATES (FOR I2 IN INFOS2 UNLESS (ASSOC (CAR I2) - CANDIDATES) - COLLECT (LIST (CAR I2) - NIL - (CDR I2] + (SORT [NCONC CANDIDATES (for I2 in INFOS2 unless (ASSOC (CAR I2) + CANDIDATES) + collect (LIST (CAR I2) + NIL + (CDR I2] T) - (* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)") + (* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)") - (* ;; "Do the SELECT filtering and insert the date relation.") + (* ;; "Do the SELECT filtering and insert the date relation.") - [SETQ SELECTED - (FOR C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP IN CANDIDATES - EACHTIME (SETQ MATCHNAME (POP C)) - (SETQ INFO1 (POP C)) - (SETQ INFO2 (POP C)) - (IF (AND INFO1 INFO2) - THEN (SETQ IDATE1 (IDATE (FETCH DATE OF INFO1))) - (SETQ IDATE2 (IDATE (FETCH DATE OF INFO2))) - (SETQ DATEREL (IF (IGREATERP IDATE1 IDATE2) - THEN '> - ELSEIF (ILESSP IDATE1 IDATE2) - THEN '< - ELSE '=)) - ELSE + [SETQ CDENTRIES + (for C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP in CANDIDATES + eachtime (SETQ MATCHNAME (pop C)) + (SETQ INFO1 (pop C)) + (SETQ INFO2 (pop C)) + (if (AND INFO1 INFO2) + then (SETQ IDATE1 (IDATE (fetch DATE of INFO1))) + (SETQ IDATE2 (IDATE (fetch DATE of INFO2))) + (SETQ DATEREL (if (IGREATERP IDATE1 IDATE2) + then '> + elseif (ILESSP IDATE1 IDATE2) + then '< + else '=)) + else + (* ;; "Just for printing--no comparison") - (* ;; "Just for printing--no comparison") + (SETQ DATEREL '*)) + when (if (AND INFO1 INFO2) + then (CL:WHEN (OR (NULL COMPAREDATE) + (SELECTQ DATEREL + (> (MEMB '> SELECT)) + (< (MEMB '< SELECT)) + (= (MEMB '= SELECT)) + (SHOULDNT))) + (SETQ BINCOMP (BINCOMP (fetch (CDINFO FULLNAME) OF INFO1) + (fetch (CDINFO FULLNAME) OF INFO2) + T + (fetch (CDINFO EOL) OF INFO1) + (fetch (CDINFO EOL) OF INFO2))) - (SETQ DATEREL '*)) - WHEN (IF (AND INFO1 INFO2) - THEN (CL:WHEN (OR (NULL COMPAREDATE) - (SELECTQ DATEREL - (> (MEMB '> SELECT)) - (< (MEMB '< SELECT)) - (= (MEMB '= SELECT)) - (SHOULDNT))) - (SETQ BINCOMP (BINCOMP (FETCH FULLNAME OF INFO1) - (FETCH FULLNAME OF INFO2) - T - (FETCH EOL OF INFO1) - (FETCH EOL OF INFO2))) + (* ;; "We want the ~= test to reflect exact byte equivalence, including the same EOL. We use the BINCOMP value below to indicate EOL differences, so we check it here.") - (* ;; "We want the ~= test to reflect exact byte equivalence, including the same EOL. We use the BINCOMP value below to indicate EOL differences, so we check it here.") + [NOT (AND (MEMB '~= SELECT) + BINCOMP + (EQ (fetch (CDINFO EOL) OF INFO1) + (fetch (CDINFO EOL) OF INFO2]) + elseif INFO1 + then + (* ;; "OK if INFO2 is missing?") - [NOT (AND (MEMB '~= SELECT) - BINCOMP - (EQ (FETCH EOL OF INFO1) - (FETCH EOL OF INFO2]) - ELSEIF INFO1 - THEN + (MEMB '*- SELECT) + else + (* ;; "OK if INFO1 is missing?") - (* ;; "OK if INFO2 is missing?") - - (MEMB '*- SELECT) - ELSE - - (* ;; "OK if INFO1 is missing?") - - (MEMB '-* SELECT)) - COLLECT (CREATE CDENTRY - MATCHNAME _ MATCHNAME - INFO1 _ INFO1 - DATEREL _ DATEREL - INFO2 _ INFO2 - EQUIV _ (CL:UNLESS (EQ DATEREL '*) - BINCOMP] - (PRINTOUT T (LENGTH SELECTED) + (MEMB '-* SELECT)) + collect (create CDENTRY + MATCHNAME _ MATCHNAME + INFO1 _ INFO1 + DATEREL _ DATEREL + INFO2 _ INFO2 + EQUIV _ (CL:UNLESS (EQ DATEREL '*) + BINCOMP] + (PRINTOUT T (LENGTH CDENTRIES) " entries" T) - (PUSH SELECTED (LIST DIR1 DIR2 SELECT (DATE))) - (SETQ LASTCDENTRIES SELECTED) - (CL:UNLESS OUTPUTFILE (RETURN SELECTED)) - (RETURN (CDPRINT SELECTED OUTPUTFILE (MEMB 'AUTHOR SELECT SELECT]) - -(CDFILES - [LAMBDA (DIR FILEPATTERNS EXTENSIONSTOAVOID ALLVERSIONS DEPTH) - (* ; "Edited 16-Oct-2020 13:42 by rmk:") - - (* ;; "Returns a list of fullnames for files that satisfy the criteria") - - (* ;; "For each name returned by (DIRECTORY DIR), assumes that FILEPATTERNS applies to the suffix after the directory (i.e. after NAMEPOS). That includes possibly subdirectories, dotted files in ultimate file names, and versions.") - - (* ;; " Exclude subdirectories unless FILEPATTERNS includes *>*") - - (* ;; " Exclude dotted files (.xxx) unless FILEPATTERNS includes .*") - - (* ;; " Exclude files with extensions in EXTENSIONSTOAVOID (*=NIL does no filtering)") - - (* ;; " Exclude older versions unless ALLVERSIONS=T") - - (* ;; " DEPTH is the number of subdirectories below the ones specified in DIR (NIL top-level of DIR only, T = any depth)") - - (* ;; "Resolve relative directories, so we can suppress subdirectory matches. ") - - (SETQ EXTENSIONSTOAVOID (MKLIST (U-CASE EXTENSIONSTOAVOID))) - [SETQ FILEPATTERNS (MKLIST (OR FILEPATTERNS '*] - (FOR FP FN FPNAME FPEXT EXCLUDEDOTTED (TOPDIR _ (DIRECTORYNAME (OR DIR T))) IN - FILEPATTERNS - JOIN [SETQ FPNAME (U-CASE (FILENAMEFIELD FP 'NAME] - [SETQ FPEXT (U-CASE (FILENAMEFIELD FP 'EXTENSION] - (CL:UNLESS FPNAME - (IF FPEXT - THEN - - (* ;; ".XY") - - (SETQ FPNAME (PACK* "." FPEXT)) - ELSE (SETQ FPNAME '*))) - (CL:UNLESS FPEXT - (SETQ FPEXT '*)) - (SETQ EXCLUDEDOTTED (NEQ (CHARCODE %.) - (CHCON1 FPNAME))) - (SETQ FN (PACKFILENAME.STRING 'VERSION (CL:IF ALLVERSIONS - '* - "") - 'DIRECTORY TOPDIR 'NAME '* 'EXTENSION '*)) - - (* ;; "DEPTH is the number of internal %">%"") - - [IF (EQ DEPTH T) - THEN (SETQ DEPTH MAX.SMALLP) - ELSEIF DEPTH - ELSE (SETQ DEPTH (BIND (CNT _ 0) - (POS _ 0) - (FNDIR _ (FILENAMEFIELD FN 'DIRECTORY)) - WHILE (SETQ POS (STRPOS ">" FNDIR (ADD1 POS))) - DO (ADD CNT 1) FINALLY (RETURN CNT] - (FOR FULLNAME NAME EXT THISDEPTH IN (DIRECTORY FN) - EACHTIME [SETQ NAME (U-CASE (FILENAMEFIELD FULLNAME 'NAME] - [SETQ EXT (U-CASE (FILENAMEFIELD FULLNAME 'EXTENSION] - (CL:UNLESS NAME - (IF EXT - THEN - - (* ;; ".XY") - - (SETQ NAME (PACK* "." EXT)) - (SETQ EXT NIL))) - (CL:WHEN (AND EXCLUDEDOTTED (EQ (CHARCODE %.) - (CHCON1 NAME))) - (GO $$ITERATE)) - (SETQ THISDEPTH (BIND (CNT _ 0) - (POS _ 0) - (FNDIR _ (FILENAMEFIELD FULLNAME 'DIRECTORY)) - WHILE (SETQ POS (STRPOS ">" FNDIR (ADD1 POS))) - DO (ADD CNT 1) FINALLY (RETURN CNT))) - - (* ;; "An empty subdirectory may appear without name or extensions") - WHEN (AND (OR NAME EXT) - (OR (EQ FPNAME '*) - (EQ FPNAME NAME)) - (OR (EQ FPEXT '*) - (EQ FPEXT EXT))) UNLESS [OR (IGREATERP THISDEPTH DEPTH) - (AND EXT (OR (MEMB '* EXTENSIONSTOAVOID) - (MEMB EXT EXTENSIONSTOAVOID] - COLLECT FULLNAME) FINALLY (CL:UNLESS $$VAL (PRINTOUT T - "No relevant files in " - TOPDIR T]) + (REPLACE CDENTRIES OF CDVALUE WITH CDENTRIES) + (CD.UPDATEWIDTHS CDVALUE) + (SETQ LASTCDVALUE CDVALUE) + (CL:UNLESS OUTPUTFILE (RETURN CDVALUE)) + (RETURN (CDPRINT CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT]) (COMPAREDIRECTORIES.INFOS - [LAMBDA (FILES USEDIRECTORYDATE) (* ; "Edited 13-Oct-2020 08:42 by rmk:") + [LAMBDA (FILES USEDIRECTORYDATE DIR) (* ; "Edited 23-Dec-2021 18:59 by rmk") + (* ; "Edited 12-Dec-2021 22:50 by rmk") + (* ; "Edited 23-Nov-2021 12:27 by rmk:") + (* ; "Edited 13-Oct-2020 08:42 by rmk:") - (* ;; "Value is a list of CDINFOS with the match-name consed on to the front") + (* ;; "Value is a list of CDINFOS with the match-name consed on to the front") - (FOR FULLNAME TYPE LDATE IN FILES + (FOR FULLNAME TYPE LDATE (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES COLLECT - (* ;; "GDATE/IDATE in case Y2K") + (* ;; "GDATE/IDATE in case Y2K") - (SETQ LDATE (FILEDATE FULLNAME)) (* ; "Is it a Lisp file?") - (CONS (MATCHNAME FULLNAME) + (SETQ LDATE (OR (FILEDATE FULLNAME T) + (FILEDATE FULLNAME))) (* ; + "Is it a Lisp file? Get it's internal filecreated date. ") + (CONS (MATCHNAME FULLNAME STARTPOS) (CREATE CDINFO FULLNAME _ FULLNAME DATE _ [GDATE (IDATE (IF USEDIRECTORYDATE THEN (GETFILEINFO FULLNAME 'CREATIONDATE) - ELSEIF (OR LDATE (GETFILEINFO FULLNAME - 'CREATIONDATE] + ELSEIF (OR LDATE (GETFILEINFO FULLNAME + 'CREATIONDATE] LENGTH _ (GETFILEINFO FULLNAME 'LENGTH) AUTHOR _ (GETFILEINFO FULLNAME 'AUTHOR) - TYPE _ (IF LDATE - THEN (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION) - *COMPILED-EXTENSIONS*) - 'COMPILED - 'SOURCE) - ELSE (PRINTFILETYPE FULLNAME)) + TYPE _ (COMPAREDIRECTORIES.INFOS.TYPE FULLNAME LDATE) EOL _ (EOLTYPE FULLNAME]) +(COMPAREDIRECTORIES.INFOS.TYPE + [LAMBDA (FULLNAME LDATE) (* ; "Edited 12-Dec-2021 22:50 by rmk") + (IF (OR LDATE (FILEDATE FULLNAME T) + (FILEDATE FULLNAME)) + THEN (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION) + *COMPILED-EXTENSIONS*) + 'COMPILED + 'SOURCE) + ELSEIF (PRINTFILETYPE FULLNAME) + ELSE (SELECTQ (U-CASE (FILENAMEFIELD FULLNAME 'EXTENSION)) + ((TXT TEXT SH MD C) + 'TEXT) + 'OTHER]) + (MATCHNAME - [LAMBDA (NAME) (* ; "Edited 5-Sep-2020 13:41 by rmk:") + [LAMBDA (NAME STARTPOS) (* ; "Edited 23-Dec-2021 22:41 by rmk") + (* ; "Edited 5-Sep-2020 13:41 by rmk:") - (* ;; "The NAME.DIR for matching related files") + (* ;; "The NAME.DIR for matching related files") - (LET ((M (PACKFILENAME 'HOST NIL 'VERSION NIL 'DIRECTORY NIL 'BODY NAME))) + (LET [(M (PACKFILENAME 'VERSION NIL 'BODY (SUBATOM NAME STARTPOS] - (* ;; "Strip off the nuisance period") + (* ;; "Strip off the nuisance period") (CL:IF (EQ (CHARCODE %.) (NTHCHARCODE M -1)) (SUBATOM M 1 -2) M)]) + +(CD.INSURECDVALUE + [LAMBDA (CDVALUE?) (* ; "Edited 30-Nov-2021 14:37 by rmk:") + + (* ;; "Maybe just a list of entries without the global information. Try to fix it") + + (CL:UNLESS CDVALUE? + (PRINTOUT T T "Note: Using LASTCDVALUE" T T) + (SETQ CDVALUE? LASTCDVALUE)) + (CD.UPDATEWIDTHS (IF (STRINGP (FETCH (CDVALUE CDDIR2) OF CDVALUE?)) + THEN CDVALUE? + ELSE (create CDVALUE + CDENTRIES _ CDVALUE? + CDDIR1 _ [for E in CDVALUE? when (fetch INFO1 of E) + do (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL + 'VERSION NIL 'BODY + (fetch (CDINFO FULLNAME) + OF (fetch INFO1 of E] + CDDIR2 _ [for E in CDVALUE? when (fetch INFO2 of E) + do (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL + 'VERSION NIL 'BODY + (fetch (CDINFO FULLNAME) + OF (fetch INFO2 of E] + CDCOMPAREDATE _ (DATE]) + +(CD.UPDATEWIDTHS + [LAMBDA (CDVALUE) (* ; "Edited 4-Dec-2021 09:25 by rmk") + (* ; "Edited 30-Nov-2021 13:34 by rmk:") + (LET ((WIDTHS (CDPRINT.MAXWIDTHS CDVALUE))) + (REPLACE (CDVALUE CDMAXNC1) OF CDVALUE WITH (CAR WIDTHS)) + (REPLACE (CDVALUE CDMAXNC2) OF CDVALUE WITH (CADR WIDTHS))) + CDVALUE]) +) +(DEFINEQ + +(CDFILES + [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 23-Dec-2021 22:49 by rmk") + (* ; "Edited 6-Nov-2021 12:08 by rmk:") + (* ; "Edited 16-Oct-2020 13:42 by rmk:") + + (* ;; "Returns a list of fullnames for files that satisfy the criteria. We generate all candidates that match INCLUDEDFILES but not EXCLUDEDFILES in DIR.") + + (* ;; "For each name returned by (DIRECTORY DIR), assumes that INCLUDEDFILES applies to the suffix after the directory (i.e. after NAMEPOS). That includes possibly subdirectories, dotted files in ultimate file names, and versions.") + + (* ;; " Exclude subdirectories unless INCLUDEDFILES includes *>*") + + (* ;; " Exclude dotted files (.xxx) unless INCLUDEDFILES includes .*") + + (* ;; " Exclude older versions unless ALLVERSIONS=T") + + (* ;; " DEPTH is the number of subdirectories below the ones specified in DIR (NIL top-level of DIR only, T = any depth)") + + (* ;; "Resolve relative directories, so we can suppress subdirectory matches. ") + + (* ;; "EXCLUDEDFILES is a filepattern with * meaning everything, COM means *.LCOM and *.DFASL") + + [SETQ EXCLUDEDFILES `(.DS_Store + ,@(MKLIST EXCLUDEDFILES] + (CL:UNLESS (EQMEMB '.* INCLUDEDFILES) (* ; + "Excluded dot files unless specifically asked for") + [SETQ EXCLUDEDFILES `(.* ,@(MKLIST EXCLUDEDFILES]) + (SETQ EXCLUDEDFILES (LDIFFERENCE EXCLUDEDFILES INCLUDEDFILES)) + (LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*] + (EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES))) + (TOPDIR (DIRECTORYNAME (OR DIR T))) + HOST FILING.ENUMERATION.DEPTH ENUMPAT) + (DECLARE (SPECVARS FILING.ENUMERATION.DEPTH)) + (SETQ HOST (FILENAMEFIELD TOPDIR 'HOST)) + (SETQ TOPDIR (FILENAMEFIELD TOPDIR 'DIRECTORY)) + [SETQ FILING.ENUMERATION.DEPTH (IF (EQ DEPTH T) + THEN MAX.SMALLP + ELSEIF DEPTH + ELSE + (* ;; "DEPTH is the number of internal > or /") + + (FOR P IN INCLUDES LARGEST (CADDDR P) + FINALLY (RETURN $$EXTREME] + + (* ;; "ENUMPAT is the single pattern that we use for the directory enumeration (given the enumeration depth). We have to go to the most general specification, then filter the generated results.") + + (FOR P (N _ (CAAR INCLUDES)) + (E _ (CADAR INCLUDES)) + (SD _ (CADDAR INCLUDES)) IN (CDR INCLUDES) + DO (CL:UNLESS (EQ '* N) + (SETQ N (POP P))) + (CL:UNLESS (EQ '* E) + (SETQ E (POP P))) + (CL:UNLESS (OR (EQ SD '*) + (EQ SD (CAR P))) + (SETQ SD NIL)) FINALLY (CL:WHEN (EQ SD '*) + (SETQ SD "")) + (SETQ ENUMPAT (PACKFILENAME 'HOST HOST 'DIRECTORY + (CONCAT TOPDIR ">" (OR SD "")) + 'NAME N 'EXTENSION E 'VERSION + (CL:IF ALLVERSIONS + '* + ""))) + (CL:UNLESS (CDR INCLUDES) + (* ; + "No further filtering if there is only one pattern") + (SETQ INCLUDES NIL))) + + (* ;; "We enumerate all the files, checking to see that") + + (FOR FULLNAME NAME EXT SUBDIR UNPACK THISDEPTH (STARTPOS _ (ADD1 (NCHARS TOPDIR))) + IN (DIRECTORY ENUMPAT) EACHTIME (CL:WHEN (DIRECTORYNAMEP FULLNAME) + (* ; "Skip directories") + (GO $$ITERATE)) + (SETQ UNPACK (UNPACKFILENAME FULLNAME)) + (SETQ NAME (LISTGET UNPACK 'NAME)) + (SETQ EXT (LISTGET UNPACK 'EXTENSION)) + (SETQ SUBDIR (SUBATOM (LISTGET UNPACK 'DIRECTORY) + STARTPOS)) + (CL:UNLESS NAME + (CL:WHEN EXT (* ; ".XY") + (SETQ NAME (PACK* "." EXT)) + (SETQ EXT NIL))) + (SETQ THISDEPTH (FOR I (CNT _ 1) FROM 1 + DO (SELCHARQ (NTHCHARCODE SUBDIR I) + ((> /) + (ADD CNT 1)) + (NIL (RETURN CNT)) + NIL))) + WHEN (OR (NULL INCLUDES) + (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH INCLUDES)) + UNLESS (CDFILES.MATCH SUBDIR NAME EXT THISDEPTH EXCLUDES) COLLECT FULLNAME]) + +(CDFILES.MATCH + [LAMBDA (SUBDIR NAME EXT THISDEPTH PATTERNS) (* ; "Edited 23-Dec-2021 21:47 by rmk") + + (* ;; "True if the components of the fullname match at least one of the patterns") + + (THEREIS P IN PATTERNS SUCHTHAT (AND [OR (STRING.EQUAL NAME (CAR P)) + (EQ '* (CAR P)) + (AND (EQ (CHARCODE %.) + (CHCON1 (CAR P))) + (EQ (EQ (CHARCODE %.) + (CHCON1 NAME))) + (OR (STRING.EQUAL NAME (SUBATOM (CAR P) + 2)) + (EQ (CHARCODE *1) + (NTHCHARCODE (CAR P) + 2] + (OR (STRING.EQUAL EXT (CADR P)) + (EQ '* (CADR P))) + (OR (STRING.EQUAL SUBDIR (CADDR P)) + (NULL (CADDR P))) + (ILEQ THISDEPTH (CADDDR P]) + +(CDFILES.PATS + [LAMBDA (PATTERNS) (* ; "Edited 23-Dec-2021 17:02 by rmk") + + (* ;; "Returns (NAME EXT SUBDIR DEPTH) items where NAME or EXT may be the wildcard *, SD is the subdirectory (if any) and DEPTH is the number of / or > in the subdirectory") + + (IF (OR (NULL PATTERNS) + (EQMEMB '* PATTERNS)) + THEN '( + + (* * NIL 1) +) + ELSE (FOR P N E SD D UNPACK INSIDE PATTERNS + JOIN (SETQ UNPACK (UNPACKFILENAME P)) + (SETQ SD (LISTGET UNPACK 'SUBDIRECTORY)) + + (* ;; "Count the subdirectory depth") + + [SETQ D (IF (EQ SD '*) + THEN MAX.SMALLP + ELSE (FOR I (CNT _ 1) FROM 1 DO (SELCHARQ (NTHCHARCODE SD I) + ((/ >) + (ADD CNT 1)) + (NIL (RETURN CNT)) + NIL] + (SETQ N (LISTGET UNPACK 'NAME)) + (SETQ E (LISTGET UNPACK 'EXTENSION)) + (IF [OR (AND (STRING.EQUAL N 'COM) + (NULL E)) + (AND (STRING.EQUAL E 'COM) + (MEMB N ' (* NIL)] + THEN (FOR CE IN *COMPILED-EXTENSIONS* COLLECT (LIST '* CE SD D)) + ELSE (CONS (IF N + THEN (LIST N E SD D) + ELSEIF E + THEN + + (* ;; "This is the case .XXX, which presumably identifies a dotted file. If this is supposed to be all files with extension XXX, it shoud be specified as *.XXX, the case above. So we move .E into the N field.") + + (LIST (PACK* '%. E) + NIL SD D) + ELSE ` + + (* * (\, SD) (\, D)) +]) ) (DEFINEQ (CDPRINT - [LAMBDA (CDENTRIES FILE PRINTAUTHOR) (* ; "Edited 13-Oct-2020 08:38 by rmk:") + [LAMBDA (CDVALUE FILE COLHEADINGS PRINTAUTHOR) (* ; "Edited 19-Dec-2021 20:10 by rmk") + (* ; "Edited 30-Nov-2021 20:59 by rmk:") + (* ; "Edited 13-Oct-2020 08:38 by rmk:") - (* ;; "Typically CDENTRIES will have a header. If not, we fake one up, at least for the directories and today's date.") + (* ;; "Typically CDVALUE will have a provdenance header. If not, we fake one up, at least for the directories and today's date.") - (CL:UNLESS CDENTRIES - (PRINTOUT T T "Note: Using LASTCDENTRIES" T T) - (SETQ CDENTRIES LASTCDENTRIES)) + (SETQ CDVALUE (CD.INSURECDVALUE CDVALUE)) (RESETLST - (LET (INFO1 TEXT STREAM DATE1POS ENDDATE1 DIR1 DIR2 (HEADER (CAR CDENTRIES)) - NCHARSDIR1) - (CL:UNLESS (STRINGP (CADR HEADER)) - (SETQ HEADER (LIST [FOR E IN CDENTRIES WHEN (FETCH INFO1 - OF E) - DO (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL - 'VERSION NIL 'BODY - (FETCH FULLNAME - OF (FETCH INFO1 OF E] - [FOR E IN CDENTRIES WHEN (FETCH INFO2 - OF E) - DO (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL - 'VERSION NIL 'BODY - (FETCH FULLNAME - OF (FETCH INFO2 OF E] - NIL - (DATE))) - (PUSH CDENTRIES HEADER)) - (SETQ DIR1 (CAR HEADER)) - (SETQ NCHARSDIR1 (NCHARS DIR1)) - (SETQ DIR2 (CADR HEADER)) - (CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T)) - [RESETSAVE (SETQ STREAM (OPENSTREAM (PACKFILENAME 'EXTENSION 'TXT 'BODY FILE) - 'OUTPUT - 'NEW)) - '(PROGN (CLOSEF? OLDVALUE]) - (CL:WHEN DIR1 - (PRINTOUT STREAM "Comparing " DIR1 6 "vs. " DIR2 T "as of " (CADDDR HEADER)) - (CL:WHEN (CADDR HEADER) - (PRINTOUT STREAM " selecting " (CADDR HEADER))) - (PRINTOUT STREAM -2 (LENGTH (CDR CDENTRIES)) - " entries" T T)) - (LINELENGTH 1000 STREAM) (* ; "Don't wrap") - - (* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing. We have to measure the filename, date, size, and author if desired") - - (IF (CDR CDENTRIES) - THEN (FOR E INFO1 (MAXDATE1WIDTH _ 0) - (SPACEWIDTH _ 1) - (PARENWIDTH _ 2) IN (CDR CDENTRIES) - WHEN (SETQ INFO1 (FETCH INFO1 OF E)) - LARGEST [SETQ MAXDATE1WIDTH (IMAX MAXDATE1WIDTH - (NCHARS (FETCH DATE - OF INFO1] - (IPLUS (- (NCHARS (FETCH FULLNAME OF INFO1)) - NCHARSDIR1) - (NCHARS (FETCH LENGTH OF INFO1)) - (CL:IF PRINTAUTHOR - (IPLUS SPACEWIDTH PARENWIDTH - (NCHARS (FETCH AUTHOR OF INFO1))) - 0)) FINALLY - - (* ;; - "First 4 for width of equiv. $$EXTREME is NIL if there are no INFO1's") - - (SETQ DATE1POS (IPLUS (OR $$EXTREME 10) - 4 - (ITIMES 3 SPACEWIDTH))) - (SETQ ENDDATE1 (IPLUS DATE1POS MAXDATE1WIDTH) - )) - (FOR E IN (CDR CDENTRIES) - DO (CDPRINT.LINE STREAM E PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 - (NCHARS DIR2))) - ELSE (PRINTOUT T "CDENTRIES is empty" T)) - (AND STREAM (CLOSEF? STREAM))))]) + (LET* [STREAM (COLUMNS (CDPRINT.COLUMNS CDVALUE COLHEADINGS PRINTAUTHOR)) + (DATE1POS (POP COLUMNS)) + (ENDDATE1 (POP COLUMNS)) + (COL1WIDTH (POP COLUMNS)) + (COL2WIDTH (POP COLUMNS)) + (COL2START (POP COLUMNS)) + (NCHARSDIR1 (FETCH NCDIR OF (FETCH CDMAXNC1 OF CDVALUE))) + (NCHARSDIR2 (FETCH NCDIR OF (FETCH CDMAXNC2 OF CDVALUE] + (CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T)) + [RESETSAVE (SETQ STREAM (OPENSTREAM (PACKFILENAME 'EXTENSION 'TXT 'BODY FILE) + 'OUTPUT + 'NEW)) + '(PROGN (CLOSEF? OLDVALUE]) + (LINELENGTH 1000 STREAM) (* ; "Don't wrap") + (CL:WHEN (FETCH (CDVALUE CDDIR1) OF CDVALUE) + (PRINTOUT STREAM "Comparing " (FETCH (CDVALUE CDDIR1) OF CDVALUE) + 6 "vs. " (FETCH (CDVALUE CDDIR2) OF CDVALUE) + T "as of " (FETCH (CDVALUE CDCOMPAREDATE) OF CDVALUE)) + (CL:WHEN (FETCH (CDVALUE CDSELECT) OF CDVALUE) + (PRINTOUT STREAM " selecting " (FETCH (CDVALUE CDSELECT) OF CDVALUE))) + (PRINTOUT STREAM -2 (LENGTH (fetch CDENTRIES of CDVALUE)) + " entries" T T)) + (if (fetch CDENTRIES of CDVALUE) + then (CDPRINT.COLHEADERS STREAM COLHEADINGS ENDDATE1 COL1WIDTH COL2START COL2WIDTH) + (for E in (fetch CDENTRIES of CDVALUE) + do (CDPRINT.LINE STREAM E PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 + NCHARSDIR2)) + else (PRINTOUT T "CDVALUE is empty" T)) + (AND STREAM (CLOSEF? STREAM))))]) (CDPRINT.LINE - [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2) - (* ; "Edited 9-Jan-2021 10:12 by rmk:") + [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2) + (* ; "Edited 22-Nov-2021 22:38 by rmk:") + (* ; "Edited 9-Jan-2021 10:12 by rmk:") - (* ;; "Format one line of the directory comparison listing. If PRINTAUTHOR and AUTHOR1 or AUTHOR2 are non-NIL, list the author in parens; otherwise omit it.") + (* ;; "Format one line of the directory comparison listing. If PRINTAUTHOR and AUTHOR1 or AUTHOR2 are non-NIL, list the author in parens; otherwise omit it.") - (LET ((INFO1 (FETCH INFO1 OF ENTRY)) - (INFO2 (FETCH INFO2 OF ENTRY))) - (PRINTOUT STREAM (SELECTQ (FETCH EQUIV OF ENTRY) + (LET ((INFO1 (fetch INFO1 of ENTRY)) + (INFO2 (fetch INFO2 of ENTRY))) + (PRINTOUT STREAM (SELECTQ (fetch EQUIV of ENTRY) (T "==") (NIL " ") - (CONCAT (SELECTQ (CAR (FETCH EQUIV OF ENTRY)) + (CONCAT (SELECTQ (CAR (fetch EQUIV of ENTRY)) (CR 'C) (LF 'L) (CRLF 2) "x") - (SELECTQ (CADR (FETCH EQUIV OF ENTRY)) + (SELECTQ (CADR (fetch EQUIV of ENTRY)) (CR 'C) (LF 'L) (CRLF 2) "x"))) " ") (CL:WHEN INFO1 - (PRINTOUT STREAM (SUBSTRING (FETCH FULLNAME OF INFO1) + (PRINTOUT STREAM (SUBSTRING (fetch (CDINFO FULLNAME) OF INFO1) (ADD1 NCHARSDIR1) NIL (CONSTANT (CONCAT))) " ") (CL:WHEN PRINTAUTHOR - (PRINTOUT STREAM "(" (FETCH AUTHOR OF INFO1) + (PRINTOUT STREAM "(" (fetch (CDINFO AUTHOR) OF INFO1) ") ")) - (PRINTOUT STREAM (FETCH LENGTH OF INFO1) - .TAB0 DATE1POS (FETCH DATE OF INFO1))) - (PRINTOUT STREAM .TAB0 ENDDATE1 " " (FETCH DATEREL OF ENTRY) + (PRINTOUT STREAM (fetch (CDINFO LENGTH) OF INFO1) + .TAB0 DATE1POS (fetch DATE of INFO1))) + (PRINTOUT STREAM .TAB0 ENDDATE1 " " (fetch DATEREL of ENTRY) " ") (CL:WHEN INFO2 - (PRINTOUT STREAM (FETCH DATE OF INFO2) + (PRINTOUT STREAM (fetch DATE of INFO2) " " - (SUBSTRING (FETCH FULLNAME OF INFO2) + (SUBSTRING (fetch (CDINFO FULLNAME) OF INFO2) (ADD1 NCHARSDIR2) NIL (CONSTANT (CONCAT))) " ") (CL:WHEN PRINTAUTHOR - (PRINTOUT STREAM "(" (FETCH AUTHOR OF INFO2) + (PRINTOUT STREAM "(" (fetch (CDINFO AUTHOR) OF INFO2) ") ")) - (PRINTOUT STREAM (FETCH LENGTH OF INFO2))) + (PRINTOUT STREAM (fetch (CDINFO LENGTH) OF INFO2))) (TERPRI STREAM]) + +(CDPRINT.MAXWIDTHS + [LAMBDA (CDVALUE) (* ; "Edited 30-Nov-2021 13:51 by rmk:") + + (* ;; + "This computes the maximum widths needed for a printer to get all the entry-columns lined up. ") + + (* ;; "The FULLNAME field of INFOs includes the full directory. The caller is responsible for discounting the lengths of the common directory prefixes.") + + (* ;; "") + + (LET ((CDENTRIES (CL:IF (STRINGP (FETCH CDDIR2 OF CDVALUE)) + (FETCH CDENTRIES OF CDVALUE) + CDVALUE))) + (CL:WHEN CDENTRIES + [LIST (CREATE CDMAXNCHARS + NCFULLNAME _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO FULLNAME) + OF (FETCH (CDENTRY INFO1) + OF CD)) + "")) + FINALLY (RETURN (OR $$EXTREME 0))) + NCLENGTH _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO LENGTH) + OF (FETCH (CDENTRY INFO1) OF CD)) + "")) FINALLY (RETURN (OR $$EXTREME 0))) + NCAUTHOR _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO AUTHOR) + OF (FETCH (CDENTRY INFO1) OF CD)) + "")) FINALLY (RETURN (OR $$EXTREME 0))) + NCTYPE _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO TYPE) + OF (FETCH (CDENTRY INFO1) OF CD)) + "")) FINALLY (RETURN (OR $$EXTREME 0))) + NCDIR _ (NCHARS (FETCH (CDVALUE CDDIR1) OF CDVALUE))) + (CREATE CDMAXNCHARS + NCFULLNAME _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO FULLNAME) + OF (FETCH (CDENTRY INFO2) + OF CD)) + "")) + FINALLY (RETURN (OR $$EXTREME 0))) + NCLENGTH _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO LENGTH) + OF (FETCH (CDENTRY INFO2) OF CD)) + "")) FINALLY (RETURN (OR $$EXTREME 0))) + NCAUTHOR _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO AUTHOR) + OF (FETCH (CDENTRY INFO2) OF CD)) + "")) FINALLY (RETURN (OR $$EXTREME 0))) + NCTYPE _ (FOR CD IN CDENTRIES + LARGEST (NCHARS (OR (FETCH (CDINFO TYPE) + OF (FETCH (CDENTRY INFO2) OF CD)) + "")) FINALLY (RETURN (OR $$EXTREME 0))) + NCDIR _ (NCHARS (FETCH (CDVALUE CDDIR2) OF CDVALUE])]) + +(CDPRINT.COLHEADERS + [LAMBDA (STREAM COLHEADINGS ENDDATE1 COL1WIDTH COL2START COL2WIDTH) + (* ; "Edited 30-Nov-2021 14:47 by rmk:") + + (* ;; "If column headers are provided, center them over the columns") + + (CL:WHEN (EQLENGTH COLHEADINGS 2) + (TAB (DIFFERENCE ENDDATE1 COL1WIDTH) + 0 STREAM) + (FLUSHRIGHT ENDDATE1 (CAR COLHEADINGS) + 0 NIL T STREAM) + (TAB COL2START 0 STREAM) + (FLUSHRIGHT (PLUS COL2START COL2WIDTH) + (CADR COLHEADINGS) + 0 NIL T STREAM) + (TERPRI STREAM))]) + +(CDPRINT.COLUMNS + [LAMBDA (CDVALUE COLHEADINGS PRINTAUTHOR) (* ; "Edited 30-Nov-2021 14:03 by rmk:") + + (* ;; "Compute the column locations for CDPRINT.LINE") + + (* ;; "Even though the longest length and author might not go with the longest file name, it is a reasonable approximation to assume that in fact the longest filename did have the longest length. Lengths differ by just a few characters, and a long length with a short filename might balance out. If the long file did have a long length, then it would all be exact. ") + + (SETQ CDVALUE (CD.INSURECDVALUE CDVALUE)) + (LET (INFO1 DATE1POS ENDDATE1 (COL1WIDTH 10) + (COL2WIDTH 10) + (DATERELWIDTH 5) + (MAXWIDTHS1 (FETCH (CDVALUE CDMAXNC1) OF CDVALUE)) + (MAXWIDTHS2 (FETCH (CDVALUE CDMAXNC2) OF CDVALUE)) + (MAXAUTHOR1 0) + (MAXAUTHOR2 0) + [DATEWIDTH (CONSTANT (NCHARS (DATE] + MAXFILE1WIDTH MAXFILE2WIDTH (EQUIV 4)) + + (* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing. We have to measure the filename, date, size, and author if desired") + + (if (fetch CDENTRIES of CDVALUE) + then + (* ;; "Compute the column locations") + + (* ;; "Even though the longest length and author might not go with the longest file name, it is a reasonable approximation to assume that in fact the longest filename did have the longest length. Lengths differ by just a few characters, and a long length with a short filename might balance out. If the long file did have a long length, then it would all be exact. ") + + (* ;; "Include space between truncated file and length") + + [SETQ MAXFILE1WIDTH (IMAX 10 (IPLUS (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS1) + (FETCH NCDIR OF MAXWIDTHS1)) + (CONSTANT (NCHARS " ")) + (fetch NCLENGTH of MAXWIDTHS1] + [SETQ MAXFILE2WIDTH (IMAX 10 (NCHARS (CADR COLHEADINGS)) + (IPLUS (IDIFFERENCE (fetch NCFULLNAME of MAXWIDTHS2) + (FETCH NCDIR OF MAXWIDTHS2)) + (CONSTANT (NCHARS " ")) + (fetch NCLENGTH of MAXWIDTHS2] + (CL:WHEN PRINTAUTHOR + (SETQ MAXAUTHOR1 (IPLUS (CONSTANT (NCHARS "() ")) + (fetch NCAUTHOR of MAXWIDTHS1))) + (SETQ MAXAUTHOR2 (IPLUS (CONSTANT (NCHARS "() ")) + (fetch NCAUTHOR of MAXWIDTHS2)))) + + (* ;; + "First 4 for width of equiv. 2 spaces between end of widest file and the date column") + + [SETQ DATE1POS (IPLUS EQUIV MAXFILE1WIDTH MAXAUTHOR1 (CONSTANT (NCHARS " "] + (SETQ ENDDATE1 (IPLUS DATE1POS DATEWIDTH)) + + (* ;; "If column headers are provided, center them over the columns") + + (CL:WHEN (EQLENGTH COLHEADINGS 2) + (SETQ COL1WIDTH (IMAX (NCHARS (CAR COLHEADINGS)) + (IPLUS MAXFILE1WIDTH MAXAUTHOR1 DATEWIDTH))) + (SETQ COL2WIDTH (IMAX (NCHARS (CADR COLHEADINGS)) + (IPLUS MAXFILE2WIDTH MAXAUTHOR2 DATEWIDTH)))) + (LIST DATE1POS ENDDATE1 COL1WIDTH COL2WIDTH (PLUS EQUIV COL1WIDTH DATERELWIDTH]) + +(CDTEDIT + [LAMBDA (CDVALUE TITLE COLHEADINGS PRINTAUTHOR) (* ; "Edited 5-Nov-2021 16:44 by rmk:") + (* ; "Edited 31-Oct-2021 11:02 by rmk:") + + (* ;; "CDPRINT to a read-only TEDIT file.") + + (LET ((TSTREAM (OPENTEXTSTREAM))) + (DSPFONT DEFAULTFONT TSTREAM) + (CDPRINT CDVALUE TSTREAM COLHEADINGS PRINTAUTHOR) + (TERPRI TSTREAM) + (TEDIT TSTREAM NIL NIL `(READONLY T WINDOWTYPE CDTEDIT TITLE ,(OR TITLE + "Compare directories"]) ) (DEFINEQ (CDMAP - [LAMBDA (CDENTRIES FN) (* ; "Edited 6-Sep-2020 15:58 by rmk:") - (CL:UNLESS CDENTRIES - (PRINTOUT T T "Note: Using LASTCDENTRIES" T T) - (SETQ CDENTRIES LASTCDENTRIES)) - (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (CDR CDENTRIES) - DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV) - EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE)) - (SETQ INFO1 (FETCH INFO1 OF CDE)) - (SETQ DATEREL (FETCH DATEREL OF CDE)) - (SETQ INFO2 (FETCH INFO2 OF CDE)) - (SETQ EQUIV (FETCH EQUIV OF CDE)) DO (APPLY* FN CDE]) + [LAMBDA (CDVALUE FN) (* ; "Edited 5-Nov-2021 16:46 by rmk:") + (* ; "Edited 6-Sep-2020 15:58 by rmk:") + (CL:UNLESS CDVALUE + (PRINTOUT T T "Note: Using LASTCDVALUE" T T) + (SETQ CDVALUE LASTCDVALUE)) + (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (FETCH CDENTRIES OF CDVALUE) + DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV) EACHTIME (SETQ MATCHNAME + (FETCH MATCHNAME OF CDE)) + (SETQ INFO1 (FETCH INFO1 + OF CDE)) + (SETQ DATEREL + (FETCH DATEREL OF CDE)) + (SETQ INFO2 (FETCH INFO2 + OF CDE)) + (SETQ EQUIV (FETCH EQUIV + OF CDE)) + DO (APPLY* FN CDE]) (CDENTRY - [LAMBDA (MATCHNAME CDENTRIES) (* ; "Edited 5-Sep-2020 21:09 by rmk:") - (ASSOC MATCHNAME (OR CDENTRIES LASTCDENTRIES]) + [LAMBDA (MATCHNAME CDVALUE) (* ; "Edited 5-Nov-2021 16:47 by rmk:") + (* ; "Edited 5-Sep-2020 21:09 by rmk:") + (ASSOC MATCHNAME (FETCH CDENTRIES OF (OR CDVALUE LASTCDVALUE]) (CDSUBSET - [LAMBDA (CDENTRIES FN) (* ; "Edited 15-Sep-2020 13:49 by rmk:") - (CL:UNLESS CDENTRIES - (PRINTOUT T T "Note: Using LASTCDENTRIES" T T) - (SETQ CDENTRIES LASTCDENTRIES)) - (CONS (CAR CDENTRIES) - (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (CDR CDENTRIES) - DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV) - EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE)) - (SETQ INFO1 (FETCH INFO1 OF CDE)) - (SETQ DATEREL (FETCH DATEREL OF CDE)) - (SETQ INFO2 (FETCH INFO2 OF CDE)) - (SETQ EQUIV (FETCH EQUIV OF CDE)) WHEN (APPLY* FN CDE) COLLECT - CDE]) + [LAMBDA (CDVALUE FN) (* ; "Edited 4-Dec-2021 09:08 by rmk") + (* ; "Edited 30-Nov-2021 11:01 by rmk:") + (* ; "Edited 5-Nov-2021 16:56 by rmk:") + (* ; "Edited 15-Sep-2020 13:49 by rmk:") + (SETQ CDVALUE (CD.INSURECDVALUE CDVALUE)) + (CD.UPDATEWIDTHS (CREATE CDVALUE USING CDVALUE CDENTRIES _ + (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV + IN (FETCH CDENTRIES OF CDVALUE) + DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV) + EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE)) + (SETQ INFO1 (FETCH INFO1 OF CDE)) + (SETQ DATEREL (FETCH DATEREL OF CDE)) + (SETQ INFO2 (FETCH INFO2 OF CDE)) + (SETQ EQUIV (FETCH EQUIV OF CDE)) + WHEN (APPLY* FN CDE) COLLECT CDE]) ) (DEFINEQ @@ -614,9 +881,16 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp ) (DECLARE%: EVAL@COMPILE +(RECORD CDVALUE ((CDDIR1 CDDIR2 CDCOMPAREDATE CDSELECT CDMAXNC1 CDMAXNC2) . CDENTRIES) + (RECORD CDVALUE (CDPARAMETERS)) + CDMAXNC1 _ (CREATE CDMAXNCHARS) + CDMAXNC2 _ (CREATE CDMAXNCHARS)) + (RECORD CDENTRY (MATCHNAME INFO1 DATEREL INFO2 . EQUIV)) (RECORD CDINFO (FULLNAME DATE LENGTH AUTHOR TYPE EOL)) + +(RECORD CDMAXNCHARS (NCFULLNAME NCLENGTH NCAUTHOR NCTYPE NCDIR)) ) @@ -995,176 +1269,475 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (DEFINEQ (FIX-DIRECTORY-DATES - [LAMBDA (FILES MARGIN) (* ; "Edited 30-Oct-2020 22:01 by rmk:") + [LAMBDA (FILES MARGIN) (* ; "Edited 29-Nov-2021 20:30 by rmk:") + (* ; "Edited 23-Nov-2021 12:16 by rmk:") + (* ; "Edited 30-Oct-2020 22:01 by rmk:") - (* ;; "For Lisp source and compiled files, ensures that the directory file date corresponds to the filecreated date. Returns the list of files whose dates were changed.") + (* ;; "For Lisp source and compiled files, ensures that the directory file date corresponds to the filecreated date. Returns the list of files whose dates were changed. For compiled files, it could be that the current directory date was set improperly because of the confusing about the fact that FILEDATE (without CFLG) returns the filedate of the source file, not the compiled file itself. Another fix so that it doesn't do the HELP if it discovers that the directory has the source date") - (* ;; "This allows for the fact that directory dates that are no later than, say, 30 seconds of the filecreated date are probably OK--the directory date may be set when the file is closed.") + (* ;; "") - (* ;; "Use IDATEs in case FDCDATE is not Y2K.") + (* ;; "Note that (FILEDATE ) returns the filecreated date of the source, not of the compiled file. (FILEDATE T) returns the date that we actually want. We could check on the extension, but the safer thing, perhaps, is to ask for first for the compiled date on every file, and use if if it isn't NIL. If it is NIL, then ask for the source date.") - (* ;; "Stop if directory date is more than 2 minutes earlier than the filecreated date. Earlier could be because the dates are asserted at different points in the filing process. But 2 minutes is worth thinking about. Returning from HELP will get them aligned.") + (* ;; "") + + (* ;; "Really, there should be a FILEDATE entry that isn't confused in this way, internally figures out the date that the file itself was created") + + (* ;; "") + + (* ;; "This allows for the fact that directory dates that are no later than, say, 30 seconds of the filecreated date are probably OK--the directory date may be set when the file is closed.") + + (* ;; "Use IDATEs in case FDCDATE is not Y2K.") + + (* ;; "Stop if directory date is more than 2 minutes earlier than the filecreated date. Earlier could be because the dates are asserted at different points in the filing process. But 2 minutes is worth thinking about. Returning from HELP will get them aligned.") (SETQ MARGIN (ITIMES (OR MARGIN 2) 60 ONESECOND)) (FOR F DIDATE FCDATE IN (OR (LISTP FILES) - (FILDIR FILES)) WHEN (SETQ FCDATE (FILEDATE F)) + (FILDIR FILES)) WHEN (SETQ FCDATE (OR (FILEDATE F T) + (FILEDATE F))) UNLESS (IEQP (SETQ DIDATE (GETFILEINFO F 'ICREATIONDATE)) - (SETQ FCDATE (IDATE FCDATE))) COLLECT (CL:WHEN (IGREATERP (IDIFFERENCE - FCDATE DIDATE) - MARGIN) - (HELP - "DIRECTORY DATE EARLIER THAN FILECREATED DATE" - (LIST F (GDATE DIDATE) - (GDATE FCDATE)))) - (SETFILEINFO F 'ICREATIONDATE FCDATE) - F]) + (SETQ FCDATE (IDATE FCDATE))) + COLLECT (CL:WHEN (IGREATERP (IDIFFERENCE FCDATE DIDATE) + MARGIN) + + (* ;; + "If a previous pass use the source date for a compiled file, fix it. Otherwise, something is odd.") + + (CL:UNLESS (IEQP DIDATE (IDATE (FILEDATE F))) + (HELP "DIRECTORY DATE EARLIER THAN FILECREATED DATE" (LIST F (GDATE DIDATE) + (GDATE FCDATE))))) + (SETFILEINFO F 'ICREATIONDATE FCDATE) + F]) (FIX-EQUIV-DATES - [LAMBDA (CDENTRIES) (* ; "Edited 1-Sep-2020 16:21 by rmk:") + [LAMBDA (CDVALUE) (* ; "Edited 8-Dec-2021 10:22 by rmk") + (* ; "Edited 22-Nov-2021 22:31 by rmk:") + (* ; "Edited 5-Nov-2021 16:49 by rmk:") + (* ; "Edited 1-Sep-2020 16:21 by rmk:") - (* ;; "For every entry whose files are EQUIVALENT and whose filedates are different, sets the directory of the file with the later date to be the date of the one with the earlier date. This preumes that the later one must have been a copy. ") + (* ;; "For every entry whose files are EQUIVALENT and whose filedates are different, sets the directory of the file with the later date to be the date of the one with the earlier date. This preumes that the later one must have been a copy. ") - (CL:UNLESS CDENTRIES - (PRINTOUT T "Note: Using LASTCDENTRIES" T) - (SETQ CDENTRIES LASTCDENTRIES)) - (FOR CDE EARLY LATE IN (CDR CDENTRIES) WHEN (FETCH EQUIV OF CDE) - UNLESS (EQ '= (FETCH DATEREL OF CDE)) - COLLECT (SELECTQ (FETCH DATEREL OF CDE) - (> (SETQ EARLY (FETCH INFO2 OF CDE)) - (SETQ LATE (FETCH INFO1 OF CDE))) - (< (SETQ EARLY (FETCH INFO1 OF CDE)) - (SETQ LATE (FETCH INFO2 OF CDE))) - (SHOULDNT)) - (SETFILEINFO (FETCH FULLNAME OF LATE) + (for CDE EARLY LATE in (fetch CDENTRIES of (CD.INSURECDVALUE CDVALUE)) + when (fetch EQUIV of CDE) unless (EQ '= (fetch DATEREL of CDE)) + collect (SELECTQ (fetch DATEREL of CDE) + (> (SETQ EARLY (fetch INFO2 of CDE)) + (SETQ LATE (fetch INFO1 of CDE))) + (< (SETQ EARLY (fetch INFO1 of CDE)) + (SETQ LATE (fetch INFO2 of CDE))) + (SHOULDNT)) + (SETFILEINFO (fetch (CDINFO FULLNAME) OF LATE) 'ICREATIONDATE - (GETFILEINFO (FETCH FULLNAME OF EARLY) + (GETFILEINFO (fetch (CDINFO FULLNAME) OF EARLY) 'ICREATIONDATE)) - (FETCH FULLNAME OF LATE]) + (fetch (CDINFO FULLNAME) OF LATE]) (COPY-COMPARED-FILES - [LAMBDA (CDENTRIES TARGET MATCHNAMES) (* ; "Edited 1-Sep-2020 16:20 by rmk:") + [LAMBDA (CDVALUE TARGET MATCHNAMES) (* ; "Edited 22-Nov-2021 22:39 by rmk:") + (* ; "Edited 5-Nov-2021 16:53 by rmk:") + (* ; "Edited 1-Sep-2020 16:20 by rmk:") - (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.") + (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.") - (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target. Value is the list of matchnames whose files have been copied.") + (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target. Value is the list of matchnames whose files have been copied.") - (* ;; "Directory filedates and other properties are preserved.") + (* ;; "Directory filedates and other properties are preserved.") (CL:UNLESS (MEMB TARGET '(1 2)) (ERROR "INVALID TARGET" TARGET)) - (CL:UNLESS CDENTRIES - (PRINTOUT T "Note: Using LASTCDENTRIES" T) - (SETQ CDENTRIES LASTCDENTRIES)) + (CL:UNLESS CDVALUE + (PRINTOUT T "Note: Using LASTCDVALUE" T) + (SETQ CDVALUE LASTVALUE)) (SETQ MATCHNAMES (MKLIST MATCHNAMES)) - (FOR CDE SINFO TINFO MATCHNAME IN (CDR CDENTRIES) EACHTIME (SETQ SINFO - (FETCH INFO1 - OF CDE)) - (SETQ TINFO (FETCH INFO2 - OF CDE)) - (CL:WHEN (EQ TARGET 1) - (SWAP SINFO TINFO)) - (SETQ MATCHNAME - (FETCH MATCHNAME - OF CDE)) - WHEN (AND (FETCH FULLNAME OF SINFO) - (FETCH FULLNAME OF TINFO)) UNLESS (AND MATCHNAMES - (NOT (MEMB MATCHNAME - MATCHNAMES))) - COLLECT (COPYFILE (FETCH FULLNAME OF SINFO) - (PACKFILENAME 'VERSION NIL 'BODY (FETCH FULLNAME OF TINFO))) + (for CDE SINFO TINFO MATCHNAME in (fetch CDENTRIES of CDVALUE) + eachtime (SETQ SINFO (fetch INFO1 of CDE)) + (SETQ TINFO (fetch INFO2 of CDE)) + (CL:WHEN (EQ TARGET 1) + (swap SINFO TINFO)) + (SETQ MATCHNAME (fetch MATCHNAME of CDE)) when (AND (fetch (CDINFO FULLNAME) + OF SINFO) + (fetch (CDINFO FULLNAME) + OF TINFO)) + unless (AND MATCHNAMES (NOT (MEMB MATCHNAME MATCHNAMES))) + collect (COPYFILE (fetch (CDINFO FULLNAME) OF SINFO) + (PACKFILENAME 'VERSION NIL 'BODY (fetch (CDINFO FULLNAME) OF TINFO))) MATCHNAME]) (COPY-MISSING-FILES - [LAMBDA (CDENTRIES TARGET MATCHNAMES) (* ; "Edited 1-Sep-2020 16:21 by rmk:") + [LAMBDA (CDVALUE TARGET MATCHNAMES) (* ; "Edited 10-Dec-2021 21:56 by rmk") + (* ; "Edited 22-Nov-2021 22:32 by rmk:") + (* ; "Edited 5-Nov-2021 16:55 by rmk:") + (* ; "Edited 1-Sep-2020 16:21 by rmk:") - (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.") + (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.") - (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target. Value is the list of matchnames whose files have been copied.") + (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target. Value is the list of matchnames whose files have been copied.") - (* ;; "Directory filedates and other properties are preserved.") + (* ;; "Directory filedates and other properties are preserved.") (CL:UNLESS (MEMB TARGET '(1 2)) (ERROR "INVALID TARGET" TARGET)) - (CL:UNLESS CDENTRIES - (PRINTOUT T "Note: Using LASTCDENTRIES" T) - (SETQ CDENTRIES LASTCDENTRIES)) - (CL:UNLESS (STRINGP (CADR (CAR CDENTRIES))) - (ERROR "(CAR CDENTRIES) IS NOT A VALID PARAMETER LIST" (CAR CDENTRIES))) + (SETQ CDVALUE (CD.INSURECDVALUE CDVALUE)) (SETQ MATCHNAMES (MKLIST MATCHNAMES)) - (FOR CDE SINFO TINFO TDIR MATCHNAME (TDIR _ (CL:IF (EQ TARGET 1) - (CAAR CDENTRIES) - (CADAR CDENTRIES))) IN (CDR CDENTRIES) - EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE)) - (SETQ SINFO (FETCH INFO1 OF CDE)) - (SETQ TINFO (FETCH INFO2 OF CDE)) - (CL:WHEN (EQ TARGET 1) - (SWAP SINFO TINFO)) WHEN (AND (FETCH FULLNAME OF SINFO) - (NOT (FETCH FULLNAME OF TINFO))) - UNLESS (AND MATCHNAMES (NOT (MEMB MATCHNAME MATCHNAMES))) - COLLECT + (for CDE SINFO TINFO TDIR MATCHNAME (TDIR _ (CL:IF (EQ TARGET 1) + (fetch (CDVALUE CDDIR1) of CDVALUE) + (fetch (CDVALUE CDDIR2) of CDVALUE))) + in (fetch CDENTRIES of CDVALUE) eachtime (SETQ MATCHNAME (fetch MATCHNAME of CDE)) + (SETQ SINFO (fetch INFO1 of CDE)) + (SETQ TINFO (fetch INFO2 of CDE)) + (CL:WHEN (EQ TARGET 1) + (swap SINFO TINFO)) + when (AND (fetch (CDINFO FULLNAME) OF SINFO) + (NOT (fetch (CDINFO FULLNAME) OF TINFO))) + unless (AND MATCHNAMES (NOT (MEMB MATCHNAME MATCHNAMES))) + collect - (* ;; "Using the source fullname in the target should preserve the version number") + (* ;; "Using the source fullname in the target should preserve the version number") - (COPYFILE (FETCH FULLNAME OF SINFO) - (PACKFILENAME 'BODY TDIR 'BODY (FETCH FULLNAME OF SINFO))) + (COPYFILE (fetch (CDINFO FULLNAME) OF SINFO) + (PACKFILENAME 'BODY TDIR 'BODY (fetch (CDINFO FULLNAME) OF SINFO))) MATCHNAME]) (COMPILED-ON-SAME-SOURCE - [LAMBDA (CDENTRIES) (* ; "Edited 9-Sep-2020 13:00 by rmk:") + [LAMBDA (CDVALUE) (* ; "Edited 22-Nov-2021 22:40 by rmk:") + (* ; "Edited 5-Nov-2021 16:55 by rmk:") + (* ; "Edited 9-Sep-2020 13:00 by rmk:") - (* ;; "Returms a subset of CDENTRIES consisting of files that are compiled on the same source (i.e. their source names or dates are the same). Preserves the header.") + (* ;; "Returms a subset of CDENTRIES consisting of files that are compiled on the same source (i.e. their source names or dates are the same). Preserves the header.") - (CDSUBSET CDENTRIES (FUNCTION (LAMBDA (CDE) - (DECLARE (USEDFREE INFO1 INFO2)) - (LET (CREATED1 CREATED2) - (CL:WHEN [AND (EQ 'COMPILED (FETCH TYPE OF - INFO1)) - (EQ 'COMPILED (FETCH TYPE OF - INFO2)) - [CDDR (SETQ CREATED1 - (CREATED-AS (FETCH FULLNAME - OF INFO1] - (CDDR (SETQ CREATED2 - (CREATED-AS (FETCH FULLNAME - OF INFO2] - (OR (EQUAL (CADDR CREATED1) - (CADDR CREATED2)) - (EQUAL (CADDDR CREATED1) - (CADDDR CREATED2))))]) + (CDSUBSET CDVALUE (FUNCTION (LAMBDA (CDE) + (DECLARE (USEDFREE INFO1 INFO2)) + (LET (CREATED1 CREATED2) + (CL:WHEN [AND (EQ 'COMPILED (fetch (CDINFO TYPE) OF INFO1)) + (EQ 'COMPILED (fetch (CDINFO TYPE) OF INFO2)) + [CDDR (SETQ CREATED1 (CREATED-AS + (fetch (CDINFO FULLNAME) + OF INFO1] + (CDDR (SETQ CREATED2 (CREATED-AS + (fetch (CDINFO FULLNAME) + OF INFO2] + (OR (EQUAL (CADDR CREATED1) + (CADDR CREATED2)) + (EQUAL (CADDDR CREATED1) + (CADDDR CREATED2))))]) ) (RPAQ ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01") - (IDATE "1-Jan-2020 12:00:00"))) + (IDATE "1-Jan-2020 12:00:00"))) + +(RPAQ? LASTCDVALUE NIL) + + + +(* ;; "Compare-directories browser") -(RPAQ? LASTCDENTRIES NIL) (DEFINEQ -(COMPARE-ENTRY-SOURCE-FILES - [LAMBDA (CDENTRY LISTSTREAM EXAMINE DW?) (* ; "Edited 30-Aug-2020 12:22 by rmk:") +(CDBROWSER + [LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS) + (* ; "Edited 25-Dec-2021 12:50 by rmk") + (* ; "Edited 16-Dec-2021 11:51 by rmk") + (* ; "Edited 14-Dec-2021 21:41 by rmk") + (* ; "Edited 10-Dec-2021 21:38 by rmk") + (* ; "Edited 30-Nov-2021 15:03 by rmk:") + (* ; "Edited 29-Nov-2021 14:18 by rmk:") - (* ;; "Wrapper to call COMPARESOURCES on the Lisp source files of CDENTRY") + (* ;; "Creates a table browser for the differences in CDVALUE.") - (CL:WHEN [AND (EQ 'SOURCE (FETCH TYPE OF (FETCH INFO1 OF CDENTRY))) - (EQ 'SOURCE (FETCH TYPE OF (FETCH INFO2 OF CDENTRY] - (COMPARESOURCES (FETCH FULLNAME OF (FETCH INFO1 OF CDENTRY)) - (FETCH FULLNAME OF (FETCH INFO2 OF CDENTRY)) - EXAMINE DW? LISTSTREAM))]) + (SETQ MENUITEMS (IF MENUITEMS + THEN (FOR I IN MENUITEMS COLLECT (OR (LISTP I) + (SASSOC I CDTABLEBROWSER.MENUITEMS) + (ERROR "UNKNOWN CDBROWSER MENU ITEM" I)) + ) + ELSE CDTABLEBROWSER.MENUITEMS)) + (LET ((STRINGS (CDBROWSER.STRINGS CDVALUE COLHEADINGS SEPARATEDIRECTIONS)) + WINDOW BROWSER REGION ITEMWIDTH MENUWIDTH) + (CL:WHEN STRINGS + + (* ;; "Suggest a width that will show all the items") + + (SETQ ITEMWIDTH (FOR PAIR IN STRINGS LARGEST (STRINGWIDTH (CAR PAIR) + DEFAULTFONT) + FINALLY (RETURN $$EXTREME))) + [SETQ MENUWIDTH (FOR I IN MENUITEMS LARGEST (STRINGWIDTH (CAR (MKLIST I)) + DEFAULTFONT) + FINALLY (RETURN (WIDTHIFWINDOW (IMAX $$EXTREME (STRINGWIDTH + " CD commands " + DEFAULTFONT] + [SETQ REGION (GETREGION (PLUS TB.LEFT.MARGIN ITEMWIDTH (TIMES 2 WBorder) + MENUWIDTH) + (TIMES [IMIN 15 (IMAX (IPLUS 4 (LENGTH STRINGS)) + (ADD1 (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 "Compare directories") + NIL T)) + (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.") + + [SETQ BROWSER (TB.MAKE.BROWSER (FOR PAIR IN STRINGS COLLECT (CD.TABLEITEM PAIR)) + WINDOW + `(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA + ,(APPEND BROWSERPROPS (LIST 'CDVALUE CDVALUE] + (ATTACHMENU (CREATE MENU + TITLE _ " CD commands " + MENUFONT _ DEFAULTFONT + CENTERFLG _ T + ITEMS _ MENUITEMS + WHENSELECTEDFN _ (FUNCTION CDTABLEBROWSER.WHENSELECTEDFN)) + WINDOW + 'RIGHT + 'TOP T) + (WINDOWPROP WINDOW 'UNDERCONSTRUCTION NIL) + (GETPROMPTWINDOW WINDOW) + (OPENW WINDOW) + BROWSER)]) + +(CDBROWSER.STRINGS + [LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 14-Dec-2021 21:03 by rmk") + (* ; "Edited 8-Dec-2021 11:22 by rmk") + (* ; "Edited 27-Nov-2021 21:37 by rmk:") + + (* ;; "Create a list of elements one for each CDENTRY of the form (printstring CDENTRY LATER)") + + (* ;; "Wouldn't have to fool around with the stream if there was an option for CDPRINT to return the list of formatted strings.") + + (* ;; "If SEPARATEDIRECTIONS, groups the files that would go from left to right from the files that would go from right to left, with a blank in the middle") + + (CL:UNLESS CDVALUE (SETQ CDVALUE LASTCDVALUE)) + (CL:WHEN (FETCH CDENTRIES OF CDVALUE) + (LET ((SCRATCHSTREAM (OPENSTREAM '{NODIRCORE} 'OUTPUT)) + PREAMBLE COLHEADERS PAIRS L2R R2L BROWSER OBJWINDOW HEADINGW HEADINGHEIGHT) + (CDPRINT CDVALUE SCRATCHSTREAM COLHEADINGS) + (OPENSTREAM SCRATCHSTREAM 'INPUT) + (SETQ PREAMBLE (BIND LINE UNTIL [EQ 0 (NCHARS (SETQ LINE (CL:READ-LINE SCRATCHSTREAM] + COLLECT LINE)) + (CL:WHEN COLHEADINGS + (SETQ COLHEADERS (CL:READ-LINE SCRATCHSTREAM))) + (SETQ PAIRS (BIND LATER UNTIL (EOFP SCRATCHSTREAM) AS CDENTRY + IN (FETCH CDENTRIES OF CDVALUE) + COLLECT (SETQ LATER (SELECTQ (FETCH DATEREL OF CDENTRY) + (> 'LEFT) + (< 'RIGHT) + ((* ?) + (IF (FETCH INFO1 OF CDENTRY) + THEN 'LEFT + ELSE 'RIGHT)) + (SHOULDNT))) + + (* ;; "Take off the EQUIV field. Should used COL1START") + + (LIST (SUBSTRING (CL:READ-LINE SCRATCHSTREAM) + 2) + CDENTRY LATER))) + (CL:WHEN SEPARATEDIRECTIONS + (FOR PAIR IN PAIRS DO (SELECTQ (CADDR PAIR) + (LEFT (PUSH L2R PAIR)) + (RIGHT (PUSH R2L PAIR)) + (SHOULDNT))) + (CL:WHEN (AND L2R R2L) + + (* ;; "Stick a blank object between") + + (SETQ PAIRS (NCONC (DREVERSE L2R) + (LIST "") + (DREVERSE R2L))))) + (CL:WHEN COLHEADERS + (PUSH PAIRS (LIST COLHEADERS))) + PAIRS))]) ) -(FILESLOAD COMPARESOURCES) + + +(* ;; "TABLEBROWSER browser") + + +(FILESLOAD (SYSLOAD) + TABLEBROWSER) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (LOADCOMP) + TABLEBROWSER) +) +(DEFINEQ + +(CD.TABLEITEM + [LAMBDA (DATA) (* ; "Edited 27-Nov-2021 22:09 by rmk:") + (CREATE TABLEITEM + TIDATA _ DATA + TIUNSELECTABLE _ (NOT (CADR DATA]) + +(CD.TABLEITEM.PRINTFN + [LAMBDA (BROWSER ITEM WINDOW) (* ; "Edited 27-Nov-2021 21:38 by rmk:") + (PRIN3 (CAR (FETCH TIDATA OF ITEM)) + WINDOW]) + +(CD.TABLEITEM.COPYFN + [LAMBDA (CDBROWSER ITEM) (* ; "Edited 25-Dec-2021 12:58 by rmk") + (LET [(CDENTRY (CADR (FETCH TIDATA OF ITEM] + (SELECTQ [MENU (CREATE MENU + TITLE _ "Which File?" + ITEMS _ '(Left Right] + (Left (COPYINSERT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY)))) + (Right (COPYINSERT (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY)))) + NIL]) + +(CDTABLEBROWSER.HEADING.REPAINTFN + [LAMBDA (WINDOW REGION) (* ; "Edited 28-Nov-2021 09:09 by rmk:") + (MOVETOUPPERLEFT WINDOW) + (PRIN3 (WINDOWPROP WINDOW 'COLHEADINGSTRING) + WINDOW]) +) +(DEFINEQ + +(CDTABLEBROWSER.WHENSELECTEDFN + [LAMBDA (ITEM MENU KEY) (* ; "Edited 28-Nov-2021 20:56 by rmk:") + (* ; "Edited 21-Jan-88 11:40 by bvm") + (ADD.PROCESS `(,(FUNCTION CD.COMMANDSELECTEDFN) + ',ITEM + ',MENU + ',KEY) + 'NAME + (PACK* 'CD- (CAR ITEM)) + 'BEFOREEXIT + 'DON'T]) + +(CD.COMMANDSELECTEDFN + [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 25-Dec-2021 11:20 by rmk") + (* ; "Edited 16-Dec-2021 13:45 by rmk") + (* ; "Edited 13-Dec-2021 17:13 by rmk") + (* ; "Edited 9-Dec-2021 21:36 by rmk") + (* ; "Edited 8-Dec-2021 11:27 by rmk") + (* ; "Edited 5-Dec-2021 13:28 by rmk") + (* ; "Edited 3-Dec-2021 00:21 by rmk:") + (* ; "Edited 29-Nov-2021 23:08 by rmk:") + (* ; "Edited 12-Jan-87 12:57 by bvm:") + + (* ;; "Cobbled from FB.COMMANDSELECTEDFN. But here we assume that the menu item is of the form (display-string FN . EXTRAS), we peel out the FN to apply, leave the rest alone.") + + (DECLARE (SPECVARS MENUITEM MENU KEY)) + (RESETLST + [LET* [(WINDOW (WINDOWPROP (WFROMMENU MENU) + 'MAINWINDOW)) + (PROMPTWINDOW (GETPROMPTWINDOW WINDOW)) + (CDBROWSER (WINDOWPROP WINDOW 'TABLEBROWSER)) + (USERDATA (TB.USERDATA CDBROWSER)) + (CDVALUE (LISTGET USERDATA 'CDVALUE)) + (FN (CADR (LISTP MENUITEM] + (DECLARE (SPECVARS WINDOW PROMPTWINDOW CDVALUE USERDATA)) + (GIVE.TTY.PROCESS PROMPTWINDOW) + (TTYDISPLAYSTREAM PROMPTWINDOW) (* ; "Pwindow") + (IF (EQ 0 (TB.NUMBER.OF.ITEMS CDBROWSER 'SELECTED)) + THEN (FLASHWINDOW PROMPTWINDOW) + (PRIN3 "Please make a selection" T) + ELSE (TB.MAP.SELECTED.ITEMS CDBROWSER + [FUNCTION (LAMBDA (CDBROWSER TBITEM) + (LET* ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) + (FILE1 (FETCH (CDINFO FULLNAME) + (FETCH (CDENTRY INFO1) OF CDENTRY))) + (FILE2 (FETCH (CDINFO FULLNAME) + (FETCH (CDENTRY INFO2) OF CDENTRY))) + (TYPE (FETCH (CDINFO TYPE) OF (FETCH (CDENTRY INFO1) + OF CDENTRY))) + (LABELS (APPLY* (OR (LISTGET USERDATA 'LABELFN) + (FUNCTION NILL)) + FILE1 FILE2 USERDATA)) + (LABEL1 (OR (CAR LABELS) + FILE1)) + (LABEL2 (OR (CADR LABELS) + FILE2))) + (DECLARE (SPECVARS . T)) + + (* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.") + + (CLEARW T) + (CL:FUNCALL FN TBITEM MENUITEM CDBROWSER KEY] + (FUNCTION NILL])]) + +(CD-MENUFN + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 30-Dec-2021 18:21 by rmk") + (* ; "Edited 20-Dec-2021 09:56 by rmk") + (* ; "Edited 16-Dec-2021 13:30 by rmk") + (* ; "Edited 13-Dec-2021 22:11 by rmk") + (* ; "Edited 10-Dec-2021 21:42 by rmk") + (* ; "Edited 9-Dec-2021 21:24 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.") + + (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.") + + (SELECTQ (OR (CADDR MENUITEM) + (CAR MENUITEM)) + (Compare (IF (AND FILE1 FILE2) + THEN (SELECTQ TYPE + (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2)) + (COMPILED (PRIN3 "Cannot compare compiled files" T)) + ((TEXT TEDIT) + (* ;; + "Works for TEDIT, but doesn't detect image object differences") + + (COMPARETEXT FILE1 FILE2 'LINE NIL (LIST LABEL1 LABEL2))) + (PROGN (PRIN3 "Unable to compare, showing both" T) + (TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2))) + ELSE (PRIN3 "Only one file" T))) + (See% left (IF FILE1 + THEN (TEDIT-SEE FILE1 NIL NIL (CONCAT "SEE window for " LABEL1)) + ELSE (FLASHWINDOW T) + (PRIN3 "No file to print" T))) + (See% right (IF FILE2 + THEN (TEDIT-SEE FILE2 NIL NIL (CONCAT "SEE window for " LABEL2)) + ELSE (FLASHWINDOW T) + (PRIN3 "No file to print" T))) + (See% both (IF (AND FILE1 FILE2) + THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2) + ELSE (PRIN3 "Only one file" T))) + (Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2] + (PRIN3 (CL:IF DEST + (CONCAT "Copied to " DEST) + (CONCAT FILE2 " could not be copied")) + T))) + (Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1] + (PRIN3 (CL:IF DEST + (CONCAT "Copied to " DEST) + (CONCAT FILE1 " could not be copied")) + T))) + (SHOULDNT]) +) + +(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) + (Copy% -> CD-MENUFN) + (Copy% <- CD-MENUFN) + (See% left CD-MENUFN) + (See% right CD-MENUFN) + (See% both 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 (1617 17385 (COMPAREDIRECTORIES 1627 . 10854) (CDFILES 10856 . 15431) ( -COMPAREDIRECTORIES.INFOS 15433 . 16948) (MATCHNAME 16950 . 17383)) (17386 24593 (CDPRINT 17396 . 22196 -) (CDPRINT.LINE 22198 . 24591)) (24594 26346 (CDMAP 24604 . 25300) (CDENTRY 25302 . 25470) (CDSUBSET -25472 . 26344)) (26347 33288 (BINCOMP 26357 . 30646) (EOLTYPE 30648 . 32613) (EOLTYPE.SHOW 32615 . -33286)) (33501 46708 (FIND-UNCOMPILED-FILES 33511 . 37154) (FIND-UNSOURCED-FILES 37156 . 39965) ( -FIND-SOURCE-FILES 39967 . 41671) (FIND-COMPILED-FILES 41673 . 43751) (FIND-UNLOADED-FILES 43753 . -44497) (FIND-LOADED-FILES 44499 . 45053) (FIND-MULTICOMPILED-FILES 45055 . 46706)) (46709 54911 ( -CREATED-AS 46719 . 51516) (SOURCE-FOR-COMPILED-P 51518 . 54216) (COMPILE-SOURCE-DATE-DIFF 54218 . -54909)) (54912 63891 (FIX-DIRECTORY-DATES 54922 . 56890) (FIX-EQUIV-DATES 56892 . 58152) ( -COPY-COMPARED-FILES 58154 . 60278) (COPY-MISSING-FILES 60280 . 62119) (COMPILED-ON-SAME-SOURCE 62121 - . 63889)) (64046 64657 (COMPARE-ENTRY-SOURCE-FILES 64056 . 64655))))) + (FILEMAP (NIL (2418 17067 (COMPAREDIRECTORIES 2428 . 12186) (COMPAREDIRECTORIES.INFOS 12188 . 13867) ( +COMPAREDIRECTORIES.INFOS.TYPE 13869 . 14451) (MATCHNAME 14453 . 14983) (CD.INSURECDVALUE 14985 . 16599 +) (CD.UPDATEWIDTHS 16601 . 17065)) (17068 26728 (CDFILES 17078 . 23061) (CDFILES.MATCH 23063 . 24449) +(CDFILES.PATS 24451 . 26726)) (26729 41174 (CDPRINT 26739 . 29343) (CDPRINT.LINE 29345 . 31901) ( +CDPRINT.MAXWIDTHS 31903 . 36018) (CDPRINT.COLHEADERS 36020 . 36658) (CDPRINT.COLUMNS 36660 . 40539) ( +CDTEDIT 40541 . 41172)) (41175 44371 (CDMAP 41185 . 42617) (CDENTRY 42619 . 42928) (CDSUBSET 42930 . +44369)) (44372 51313 (BINCOMP 44382 . 48671) (EOLTYPE 48673 . 50638) (EOLTYPE.SHOW 50640 . 51311)) ( +51841 65048 (FIND-UNCOMPILED-FILES 51851 . 55494) (FIND-UNSOURCED-FILES 55496 . 58305) ( +FIND-SOURCE-FILES 58307 . 60011) (FIND-COMPILED-FILES 60013 . 62091) (FIND-UNLOADED-FILES 62093 . +62837) (FIND-LOADED-FILES 62839 . 63393) (FIND-MULTICOMPILED-FILES 63395 . 65046)) (65049 73251 ( +CREATED-AS 65059 . 69856) (SOURCE-FOR-COMPILED-P 69858 . 72556) (COMPILE-SOURCE-DATE-DIFF 72558 . +73249)) (73252 83558 (FIX-DIRECTORY-DATES 73262 . 76255) (FIX-EQUIV-DATES 76257 . 77782) ( +COPY-COMPARED-FILES 77784 . 79605) (COPY-MISSING-FILES 79607 . 81764) (COMPILED-ON-SAME-SOURCE 81766 + . 83556)) (83752 91440 (CDBROWSER 83762 . 88335) (CDBROWSER.STRINGS 88337 . 91438)) (91602 92874 ( +CD.TABLEITEM 91612 . 91832) (CD.TABLEITEM.PRINTFN 91834 . 92033) (CD.TABLEITEM.COPYFN 92035 . 92629) ( +CDTABLEBROWSER.HEADING.REPAINTFN 92631 . 92872)) (92875 100220 (CDTABLEBROWSER.WHENSELECTEDFN 92885 . +93353) (CD.COMMANDSELECTEDFN 93355 . 97161) (CD-MENUFN 97163 . 100218))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index b1928e10c5d6f88318c5e52e8dc3380a5defc0b2..05661b70112c9980b68070d42fe3b01b622117b9 100644 GIT binary patch literal 34120 zcmc(I3v^rOeIGAK+cIO(1WhwCt18#9OjD}K5CGp+WPkuDKm>3p05m1XHX;d(NsAU8 zNp9k%564Zqouus=C(f(sk~&#l?N$gBy7-B<>w4OqowKcVQl;m#JKI^$+HI$YuG7<< zvomYI-~a#JiwlsHoiy9zg!t}vzx&MD?BUSajmMu@TVJWz8|Uqi-TmQYap7lnl%1M<_#_{5XaG~whH(ei+9i3iR4Hwm0z0A+iMuh{8Bb+`=1^i9Szx))0Z&T z9eSOJh7P^0DgTJ4h_xP@nwYR>6X|&VSgJTua_r&xe6hPZokRBQVj=ZF##t(kB(WP9 z{)BH)BC``ST$CU2;*THd-o7jLY;wALc+rlI+jE&b@7uVD+8kCPmE}dm&hRS2a#+h@ zmd9)YBda4bQeC#m)IseW+zjNr8FDN zXpwEEZFjU>p+y@#B~$qlK?zrrb|Rin%D{LzApw+~(sq_gi%TWq2reh=rJ@JD@(?P=?bOLcb}5-kvK60-;$^Kh5xbZI zmX&ZbY~!t%v5g643SoQRj!xLwc(G*We#q{6?Jle1=DB+JMhE^~?)a0ntGG7-bdMT>zfM|Eqtyazn43nX}j@Ry-{7$`py1@T^gjd z{xkAZopn2QpFh-c`^QW#&q?jaWvmO`9MZQl^_$YGgAaZrJ@i7Lv)=j4H+vjCF6 z2#y7^)elyzpmoc!p4wtA7!Nvwo%Nuzzpq|$_F2xpz-pzMvdSS8t*zR-w9W|yR?%14 zZa4?(eU6PD50v*eoWVeOu=;zBJybr>sJ>y^?z3_O(tLHW?_}p^GWFH;gQptU@{b?y zd!&L_4mbxp>km6aeX`^_{e19p$QkXdKjn<|m3u0(?%Nl}Y>zYG^xWYLNF!(9?EL(* zm#r`M%H^r_9o6To^1W7mVDrbFd#zRHULE@3hBI8h%{h#r50{4;&cQ(W;N@#SziRYn3N0XEIQpY?P-Pj#r-bm5(%>+1h)YBefZ4Hekuy%10Z{5w{#`I7gk>>jqEm zaAMBU*9{s7EPqt~mgmq7w&H8f5&ZqE(_70ra|Ty`O;K`A)}=b881O~;F?IW$Ij#Lw zU+qT)2GH9-c4jT-h_#0C@gK_it1wee`n$jKPA7Tgw)U1=t6S9pXI6);1J*a!e!`h{ zW}P|bh&zJko#fL5iox=D!--&N$Fa1L@>s(e4U|VOzd7lQ50xWWT4!K>)i>H(2-LkD z!{G?HNFupdfQSORPri`K&4KbyjJu_=DN`DoiF({8JT^II7t_vCHpvIayyjzIMB2p| z*oc&7T;62QM8J)Nl}>}5kjC0mGZT3K=+Yvqmov#yx@b>LM{V#m49cFGnzT8%ust<7 z?v^H|?QAN4tdzE=qSJQKDWDs?;~_A{d?I2`jE@Urv?rqAKief7^24G%0d|-$9AYAj zLG0Ra3_Q*>9LH#NIO7*v9(NRRq-aO+<{j%Nr`=aYC*Ai)u_~!T!6`s)5SAwr-zkv*qSzO6 z54-KXM(#y0<>Jy@5iC7_43ffxoiC*!G!^U!cEooF{d;#Hr-;m3#7n@r?eNT`z5ucw zpe$m?mr7|2B^;g#+lTQpK5dW4Z^S-4g6pxc{j=`@T%lfm!txWDw2z=NJR?72llD=2 zW@egyrJI?_2{fCT;O&`l-i=I;q5H`A3|}%mE`3f-$VdjS?l>?w$8sd=Z6vL`tT!0S;PV~EcKs<8rq z>M;oIE9Wm=SX;Rmvd5=qa0xjXf5$PdkbQAwedX+>weyd%W_-d9oxW&qyq_20X*=|j z7uhm8jbZ|7!08LxFp5cp=GQ*NtI8S#^-CKUo)XFXA|&@HCKd9w)=oN*jPgzivQnm4 zLT};m>)nn3TZWHd8t*xT&BW-J@=zI^WBJU3&{B*n1yus;fH~rI7^k$ys$!Y()Rgb~ z&`vV$sN$uObf@gBEG}ip(y2v?mH>9>7Di+Z+r?76P+9~gXY2@JRz$fS#KAG(2*kic zcE`s-qB~=A!ZglZ4W79v-C6HC-fKOqJg&Ycr~IU+k;@46&&5Ak`KZ%V-A=bAC$d8?RsSc5@7Ro;ade)!<;kUK9V|FO65h&Ka8#Vxelu% z5dSSB=Y3rz!I~Xw?!%(2vhv7YsqWQQ^<%zPvI&N&QIs&qsDlWuSMi+S@XmzBG;J-e)_4%|b@%N@7NpLVrbMcasqhe|} zLBdIOV(oh=R3yc5RQl?i0Vv zCq4%9Fg?|_aM8Ak8EV^YvJ-T3YU11uVc9SNjJwhR^n4>%f#ItJ;z|nK3h;K>i!gYQ z*$psAA2``z$TdQM!{|!e!Y<{t1*|urlhjRs3Jj0TCBJcLW!AQrE|Nd_^lR9E+9zSC zhPTgv%R2#=mLfR7FlJGvPFwpLS_-5C*1i~^kisMmfY(0G1gXenO}Gc( zXA|_0Zt=1EuPn%@~mZCPxh*&`m*@4nvN5>5UuCQ->rSeH|vNK(Aso2_l zSG@CcQjG84ysf>_({o0z?~2!NlAD4tbCplauV)+xMsGMSw}q0w*H?ZpSy|iqbmRQB zYrk0En-1Q&C*N6Lb9(w7N@LHhG|(3R4_LweTb$m``Z;Gnx-mwX@_=esY6Ceg1i%@n z-y{W5*rm18r$7Djlc;UTZ}o9PmR0U;I6cofy-v>?pLTl7J&ki<fZuKDMlzR0!v|q zgvLfoBN;@|)Qp4n`FY4VI53g%FvQ`g%Ra#NCJmB$%q0r8=}EaHKcIgQ$5pJcqmYig zyRh>?bMteiNSH!cJ^_p*Pj)+1mJgM;t!75#PM;nH;oqGGuo{Xi$&pS=uAwt$lbQK> z*lhC&icjM(H8#gH4ocLdpW_&e(Ap>{(_t8Lp{YQjp}rIWzsFywkuK?tK#FTV8o}U| zOhaXF_D_Z)gd{x0zQTBc?{Hx7CndT75~Uuqfb1V%YT)Ukdc3v6LHS8f5uO zfWZkq5ddLI27?x*_tjqOg?PpiAl^Khu>>!+Hpeq+8iJTodr<9%C~i7vx*m|m^5vTYCZOGX3kB___O4h4#6X&Um8IWI;BUZs{i_)mGJ7G)U%vLU;M1V-%48|fmL5w?NU#s1Oy=o>Fn58$I)%5v z8Mboevl&2(?0z4HL8CBiqzlts$=?i$t}FB6koRM*=+4VRyvo z%loT`E2Q+&%<0YL)sO}vy{~?=GXVNE_>40!1PTwc>7P1-ebu3bPc3At@64(-Fe{y{ zeoUUPn8#NKrS^r(*KX_>j=*r^TBRaDex+bxkO?)BwL=1}ZvMTdNx=^}kiJwVaVZl3 zATl{cXuy+qj{*rvD#Cy$=vCN1fRp_CwT3WoTChrNCJKB_G63=BFnlotE#NSe_`^2D zr$Yp{VU*>{4j-ZhuYy*5Yz&k`;7)oiW@cv(FXfjr`Q*rA!6|_}9tLPZ)5TwqCDAYO zKEfMlyn9KKKx`^zy#Jv-=w7JO3&zfVtdXu`F1r zuc*gFEBQ{#6yZ`y%fsyrAaqF&jkJg(+irXJbplpxzYMhb29i$qB>}HGAibGO{}bjl z=4ZJ-Pz$G*2NtsV+}<0hlVQ-+JLp8YIqmc<4<27|dYs<9H}TeOK-m9URk6qTFO1Tc zHbN*BRuI-i)+wgu?+3FRb2X!JppdFY(dni(0nt1Kd4Yn9suzGV0t!5nP zG^{8%vgrqW)|6mfHJ0lLt%jfnu);-P{?q%ku9_0?*_6PDO$jzQSAC;SEoS8iMy{nW zdZYz847;GIfziN}CMIo8!Mr>SMbcS>xkb?f7TH!g2!ahvNA6wEK`?4i3$#IqNNO1v zf}X@93+!>#M=mDVH@pHqnFNLmZAi)zh2|P^5pV6Hz4G`Im!6^#5<)}ME*b%SY_)|( zATN2g(8w6HO0|X3jND=ig?GQ(9tQn6mbZu9U3Ri+HtWb=_m&8RJ)7dgZvQ# zLgV0#7N8Y&Xbwq6sniwrcl)8-0~k|@0$K|>Cg8SOP`GC>3AA>BN{^0@3W&S%1Jptd z8lYx5??6oib@qrgz2)!&G-V!LKSX)fX%WuMtJr0AP(wT7@QRu~j=xA!1 zr-c zx`N_p>VZtA1j^@uFZ(UdDKK(n$o`on!Fq6r($r-ZnNggPPy3z}=x4h`cMj3>lv@B-*qQ3xs_ z-j6_`L%zbvWCaFwNcc9?p2Kx9+vcTm(L&SsyyPT?E&&C2z$7nfbe9X6k;Vu|hi9%mq zsCPcrmu^=4R(r+ov{(GGRKzUpSY0c=4*s;g{a>|L{I9kO>sHgF8LM`Qzhd3BjLk@B z@yiRJ$}YU|$?Quo&R)KDKdrw&jNMy|YK!YN*>9R$ug%SBIKIw{Zqydn8_b(;xNWZU zsyF|m*XVk!{teKbMqr`+z;md!TBMWOEdqnxB1C9YjKG!e76Hd@5fEyMVK{3|5#oU< zK}u3HwlU+v>;PD&BNPA)umv*l#~=p5o#-HF5`p`lS1_EYB|-t(C%Fl?BP&Cl(KN`( zc%@nhSsAX3-XV60CYNi~7DUGoc?z684k7f$xG^kYf;7>0A&P$$T5^Vy|hx{x`RF45gXVgzB+SBb4)<&>Q|p<;3Cp!Eg4(0#`_@{%FBkkQ?7ScXc6PT}9N@dbhLx_2-@aA6f4% z@5Am%Z!mYF{s8I^pgwD5-G{P#$Zk{|`}OBx9xV^feQCWDU0PRPS?@$E>*}j8Ht)Nd zySg5@TJEnnJy**EF8tJ{;@Z8lFL#x9Lg*;OjzZsd-|P(L<<>#mI>=iGUvT=Jfpo^{ zO}}>hH6?5iBO_p)F1mrGxkU)tF4QoB!Bp=gMS8vzL?>rTE>8eF8g1e22*#yMX`5t> zkd)MXd?^bxJ6{3@Wi80YA^?MToKW>JmYz$9jHEhYdR4_fjh$?&zVJGTxTKRFlqWEC z@KPPKPmS_a8``>(#YMgxP)Xg0URNWYb`QhdtAj>7N+PM5pCQSiT9K^jQ6#xAccD_nhen1W(^+%&MoX7hwnmy9-z^i^TZ~{{~*ooQvPu z(_k3G_n?)$J=dZD4VU=(PC(TQ3{mD3HTIau+nhY323lu$Gh+o}h%H?V4D@#JT^^89 z`b&9GN+4Gvg%}B=-zd4#)t>ZLn{=wV+TaK~t~S8*=b?7m>3K^(t;XyITFO^z)+peJQivUA=R? zd+W;YG#k`g8|>YBezp4R+0EyUW3dNcuKtpMyQ^`-*g=~hm?t5LfON^1U#F`Bc}j+GOLDg_}<%>Y`lFh2*bKaoa_(37Zb$4$+zARK{bPaZx7qx zC-tyxT()HfV+P<6cZq=Rz7hqA$C$^1oiJb*+cpi}l0cCdcie|@dt`eaAj17+8n|}l zuZlJi>OW<2_DMB? zBnIXlupbw~$$^CM__lzYNVpcwmGBsmQ;7=aau{4;Ttc`=+E^kE{7n}e%)S`HxS)do z^!Fays!i%GseHRMt#?lJh|ed!VPu6H8_93Ph5Vh_(@02PTVG5zF=zA6q*h+3B$~BX zmgBKAfySAREBT$r_xhEI9Y)tFT{S7Lvb+V4;!-bwNz5ay5vYOn1&HJ;14)uOt-o@VW`#u4EERsjb@b%ks<_h@70i--8X~o`(7Nj$0Pb)*t%O@ z)ACl3ZH7X)^d2E-zCNZAoq&5v>}lI;l6&|%VW`ujf-u6!-6H6eTJu14qyP$JI*0ww z*Y`L~5pLJe%l$oj9lPCPkPwEW_AulDSo~lr47=q+-DZKv72bwh72#xNL3d})@EoY0 zXPyX?c9vnRl$cV(ttZ9+^uK0xc339_P~?vS2V9va?D`Gq>bi(i$;JtFr-9Jd22a?H zbQ3l=XXLqWSO2}Q@^b~{?$x`@%}qY}FMKU(wrO%g^t8=qS6lhNK6m-rhauY_Cc*`d zFnGS1`6#CZxyuCL!iXfmhUgUe1^0hwF_l`tUQs4!6WXwe6v|+>#t(o45**xT_zNSl zZv5`dhyjknXv%hoZ=W!G$P0My%;vUis1dW90-ejDWD9;ks_1UKYt143n}EIAlNN=% z`S;r;a@g(yM8`n9QX7Pi<+;XsxFCHGoeDffCee;tiJX%ZNtpiV02s zLP8b?GDU6l@0TVK_n6~RSW`>iX7-%5{9 zsI6p;$^b~Hf%nA{R1<`Q7;|D6#MCXqrApHo(#z?*(X=aqcD%TNY>EPMYus8ma1zeq zsku|k%>|yB#-QKY0qCX{OmsYGwp-(Qh`ja%4#oqrt?Jl7wIMkx+^U;?YHDUm`tHNR^ff z`H}g8lVfa(QCE{ox!fs+h9Kr2tr#9c5t3Ar&*rmO%M&AFlK=?Z3FW+FEe3t2AOIly zQ;@A%9XxxZT#~U0w}NepdIlv71mrNi0(sf9c|?>TTntp{0nNGCWg@QNgT4|}zu^d* zXE!WPGDHh0){GY(K`MJPn<|We)=3BpCr6q`U$zc^J{vzKwFvEkcRZ28Vll%3!7ymL zeWI*|XItKiw=*h_aXOp`Uyr`sgb-XIhFNe3V`EMS4QN7xlJoImHWx1(0||C%5W{QW zeA_X;jJFWS)HXg;N<7-GlZET)rv^G<*{yVbRdF)j1@lU8rteHgMGafynO^H<*&2=0 z&kC|VRLO{R_YGK9_R_L)O6*&IurTys_3y2Rq_2kqh?=o(&jkWVbM2X{cP-x=JaLQD z(^we~X!F6<>Z6t$ zu56-(&A8M-AP<)J)$YtW`{DvxuwzU(`y?0+F}D4PQR|afQ z5ejz@uNi*EIXHxPV?@?mb%y%}-KC-t>hhc4pcU%xVIaX4ncW}J)D%foMCKywMiB^z zFqRk`xF5tDk&TkSqDbdv0zs~aLaZ%WhJDE&q)Re(9ejtQ(;S{L5=WM&5k09c_&br{ zUa%5iB7Mkt2cymbdx{VdA@DLIg>f`)cr9gJfU_nj0i_^Cy2uL_=A#aNn5D!jJ;4uU zI>PG^$cyy3{DzHlG#)>FzJmO}2sq{NJjfT37>JQavRW7qA#i0@(=tbW?=VOX4cM%L zuHkl~M;4Zt*OLtr^VDqK1?UXKEZKkA<+!gb6{J{5e#|Z+I}^c8#6xZv4TB~MS~VuG zf>hfC8^gWF93sY)>@+f$iqTGH=t)t2VJYM36ObI-Q%{7HI7@l@nIU&8)nPL|6-872 z-Y%5^wcL@)fLz$%+MSSbiO!*5{Dw^Z!12D5mEehYAmMt*>wAIs(#?z2FIZ*U5S2jf$8(N`jBehRW4Qc& zr1l>G!tE~)A`mrD-dFwC&VeC#oT_hFzg75FoW3DYmg@Hb5RfVhvKtYJbP(dc1A0U6 z+6A4#gM2v2xGfjE87|&}m|=(`l-rpW2mauDjLC6sFfAl?fFRVIKdLP z3?h5UWfIcbL}bv4!^l9_W)MJKbO$~*8(}~@fwM>##Ajp|(7h~e-1(C|`os@n;-Vtr zBJuEc#Y5Qx}$(F@I1WRUhW|q{O3kw(EKATX%ow6Ef$+UxIEU4 z?;=-6TqK`CEOJu#c`N^hB!z`14gw?P5zOcfx>R|*M-V)>eivA7pvi_ma7(VU9?mNV zbWth&GGoGDMof5C)&UIVX7OrNf0xYUWvi@;V0i#>BfsdFi+zDW?Pue`6Mf8%c?S;6 zDEDu^x4Mp_GE5k^?s`<#_7e;#^^y^gZzv~#mQZkzx-PP*3ZTe)#T6E&3C;?esD_lG;EZl)|7!>5ga^(B z162I({NIE0-}N9JV1ES+0P<$XZ!V7-@ldcQ80sbX-{Kq~_Xf zpg%-uFcc_1w@G>`!fm%%#B-EddhC-*{# zbz2mvsPoz8ymp!u-A7~#1y$pSgYL#~l9w=0D<%v8bE|Yd|MKe3D}mQI4VlODjp~1X zAJ|_ecVvO93oIMtsCy{DLEvjZ=i(hpwtNOMzzO2 z$?Iv7!iqaB+AgTpE^=tce?vA^AZS}nmKna`cxS!mwsbJw4N)}d^z@oD#biMqTGkZL z+K?~h>EZN1{pQ>%GSp96FJv=;{a-^uabWO{#__;|)hm!4!8$(_ubrVR*snl`UP_7oP;sL4h9n8vz8hSa}>fQ!I}XV7>@iSoXtL>Yz^-N)>B2umya zgJ%hgBkubfVhx3twLmANwbtDSGN|ddoyUSfprzrMV981bpc^*H04$XPFTfwKQoy4* z4B?Ob^ERR;U~p&N5C87rriNYdcQSi<{Q3_}G=xD1Gx0))5&U332nI!z9Sk7SDS+J94(3=K zF@V%SP(j{K$Uz;@J(}iN08MLGzyg|O&5 zz_0@Q8)5Qj1GGgti#tyEcG?e6#S3A7fG35ZZ_v-qWbdB!UBgfUt909GsLVaS{zFjN zVBE(stuSFTsYeXP49>%V5Zwm}+$RJJJrGRYp4K>x<>N$6-p~%nNONg3Z;1Ru6BUsi zz??D~I22dqH4u0Gs4HXxvp4sY$qQ18Pl9&cZPY{3g_-pzCgaVb9X3230!EjPp6 z7ku9h%c@ra>uRCp{@|T^1U&_{<dEuxdp{4nD~I}+-O=6 z5rrt#giE&?98h~B^V8mVxJol!g&LjP80-+HKqAYC01Z7g=4s%pd79RHFWE&9P)7hM zx8-3D!VC!H!n^{LZ)pVDMu_*PoB2X^KnB_{McE-9^3yyZFvvt(Kg4RWOj;p*tx)@QVI5NFM7zRUGQ>!Fvw^w``RpMGraJ98hIdkmO+rYmN}!J@xk z&&N!@;P>kZzad+2T<93wrEyJEgQ0h>Vy$g`vyq;&-dNqb5}XU*vfiD>@Bc;xSbdl= zFglIx)=h?Yx{O-INS{$0D6DpR(1Yd@Bbc>$ft_HOhu9vl>1IFEp`mq2{D2Ix)HOJ2cx2^5Zm%@iI{fPQAQcd zn#H{uz5d?%k;U)+ce#b-fzMv8z#xQ%{DCZa43l0-t!|yRiN)UOoJ!-1hd7%Ma!Tf? zheZQ*RD}*B5PO^75GlvL$$Xgs?(urpdSLy?pDp+NncwoL(d<;T)zMzxqe}K8wH2S1 z{cv99_z0rAHgoyh_u{YD-ksBia)b2;1VFQTN{_ZD8&Szv`^t+v+h|qPpE2>-Ou04! zm}rJf4@{@BG+Ne&#`qH4PSUs8aY+Lbv-imniK;hel6rfZ<qOQYL#pSfT?)A`2dP)McDeH#>F#G{*mgB z>HRO@0u^ZV$S>>>ktMHB=JZFlNw+6&xvop~^8T`Td4c_qTw68>BCL^yWtm}PfLgET z-9jndo?eag`<4~u;T^3Nh>tizOUqGaTfPS?PF!9*B}QYO!mnWqE*HVEyS^L*90MrB z;EEPa$<0gf<%X!k9mkJh=t=-g5(Pu+nKt2uFMM?m&6onzvN)}=KbwPcrzJY2vD}N3 zzum*YK!yXs56B6cvSViXUyYyJ`cyvm>ML0$FyyS-RNksZ=RWWBm=lceF*~BptGwD3 z6pNf5>`XJW;p;BufP-+q5#u03zSDbb}2MMzF7S6Z=|@I{mVH)F}i? z-zK(uLzs8SbEhd-wqX{dM7Hmu>+JxMqY+1_*Y!6^yq3ukM9J{5Uc=yhS{~Ql&^FCv zF&B&(Cdo>Hi;Be>haoT|h#MEd7C20EfbFh;wR6eUm7_)f)mTCK>B&Ig%E6+RPocbz zx%D(Rd>^OW@o8pQS>GqG^$XaHEH#6HVv4CEq!y8)2Nh(_NOe0co4zhNS8$dYCT0jfc55*%V2GaRL;F(_S`Y>COm+!U(+RNou=5K+C3SGHdw4a{-dKfzr#;7-Lbi(u&dxF_hyke zZ~c#87@r5|tUvD9Fomar;oEt9KSLCrc7}ykFOSM5B1E9#^fLprU(mm=+_%2R>3wZI zupIgBYfj&5>s>0@TusUSb4WDB69ar=07qS|-|Fmpy|(1+s}`;D0n6<*gsj!)oRDMV zJj4*4P5T4o{gf$x!8UN4WV8CHCJxmXh9`avWzjb+3Uin=eXivp*dSHO= z0nGDH06ob4@5q%T$>AdeUN+~Nn4lk4DL@ZHk`F2D=L!!v_v&=p*7Glq_vM60?es_E z?qiVSWJF>X7}Qgn9(f<7h<9oHWq)6zvOL<~+o-Jd-_oe0`nwuBiheAebli{JUM=iz zJXSgXbJr@;8A3QJ&R~Cc!#9RCJt|RaR%Me_s5GJ_uy6vR9<{e+=mqM?K%nAc$)Lgn zL^otB=@p?G(Z)!LD3#)gG+`1aBtlr2!$FD*sZke|#;Lu>7tv`F0ktqXg3Jmu6Mb;L z1dhyT=`xBgmF6tV(cnysO{XOJJOYabIH18-9&zTsNjsw?>?>w7-`Iam%fB024>{H? zf~!mW%)FUon6Y8Leh@mAa7oRm-oU|2Fx<Z9AajqI<@g#C-#}N#c$l}ujTyPxBz76Y_(+C2SPsiZ%GH8#} z2!6V&lRYq0_^zKu&=;jcp|Ns20%K?)amVGv0{^PxG$jZ%=mKKDS8UywQOYqTw23lI z#x27eauatA!7L*`Vr z&A)brKuMJt;q)YVZ}q;m>z^>!-!Q*59IiMNu=M!zPslSLYlt2Nr@y}1oMnOYUl9$8 zm@zU0|0%D^57yjMUP+Vtonik_oZ;-?LsfH7?sLv?Zt!9KX3A}dDg6)G+FiMtt*lA- z+3KJYL|HWX1MQ$|0sh~GLD0x3P7ZP-1fl@^W*PbO_-Ys600*|geA2w2Ez;HCc!Fxv zS}Gqw@f%np{?7ssXB?UJSN8#6eV+FS3<_%yi&+<`% z6u~z#vZ;9<<^^d;NiA+lRT$Ah_XC;qI~MK}G@jyn7*H#<5$wnK&IC^qU^Xj6824nh zY5T)@2VzkIpQQL1k_w)&q-Ub|xPV|XMMRP-NVYZ&m4*+-`ten#fVH}Xc=vQA^T~5h zKlblB#u}P#KRiwv=&=(egm?|fMYDg8n3?xPT-lBub74b#w_#X#eGm+|GcHH{{ZYVD z&4VH;bO%tvDEgn^fhVwnfQ4;;n<1%&Jc$Hvjve#8%_C=c-;F^%j6 zGvxVEg|$alFWF$a*_HQSvS9(=frruH@3Jt!QY(LIT{K!EhNUa%_z>mX(DLfq*;RWU zCiVM;w4oFa&x1h2bWifNA3*1er*bpl8 zF|te*Z0wx#K&s>{L2xM$#<>VBR9Zv?v-vHHl$1D9fgZafO=xQp za0-QT6?Y4BD3J2`9M~~+KR2IJ(GJssVC_~KEMJ=1E$pE2+h4>)qsX~VhLxbl7DJp#{7za0JThl)jc`HtN=ucwi}}0s&mF* z0?!ATOUdaCpf@anSwfeRB6%m0fb@GS8a;sx!gA5x!gj5ARGRbf*25(5%4vR;PlX=F z9&o9poj4@90pg0B&jUQ(x2LNG=@2~%TtQL+I0p|5#!(t5y|k=|bB{Ss{^iW^F*+aT& zMG2u=J1?Xvxw1pM_=6FrK^>O6q#_{K(_0OZQ(Os3)>Q>fPuOu0M<7#PvCX}!)BsD! z&vNO)VjZ8k5mtx?gz5-5s;Gfe*Q6?l(_Q`50ddpco5%}9Iw>pPGi zY0v#yDKt>+g1y>6dJsK^lnjt7y2s+EDUxV%p3aObt)qs|Ser z9(CqTbHp{2N~e!r##<9!;sZreUPzzpCJngM8RD$hf1T+nmElW+K`wrx0 znJHl|wFPYwNWn*{u$|Y%E$9jEbm_}+Hy^~+Pn76x%YkSb;s`!0nQe>fE2l56*pHt+ zhr~tq(@z`ch4gNJt7m9wjXXfm8KVKjVQWq*Cbl-+|FnE;BYrLf0h}nEo6}7JPX{_7 z-M+<_6O6?d`B}LW(_d)Ft5%CG@hK?>e7VBMcSAMR2xN)L(u25TDGOYZI zjT42{V#&~XuhNecrqUCw2Tl|OL+}{bhj~(u4OKKcQ7D$gw9&gmH?^N=oT&FJP4nM2 znW06&bA8&p7*7wv&NXEkAMKUk06`OdxR2q%Oec-(nok&d+KC72ZfdJgYYdH5P0O-NHK+oT5%Q2ASkVy zXZV2#A7Km2x0~EYm_lX-K_iGh!VKM(NAMPN2V?f$H)1>$q@pnXsK5mK1b65;%x~N4=*tZ) zoj-jBp)BYZ78!h|Z{=S5;_3zl@Te@UrZFc@pXcOF3;BiMU6CPO1P{O=)+sPNt|kpY z?w+fWTRz#1Tl5MP7UL&Q>~dSq?!WIou9FPJzO;%E8)Q`D8-(&@!Al?9@SjsRisNPZ zHEdgg4d|O}ej$8^SC~)t8F2Kq)f@ULIM1I&zR>!0FY1Z@FMyhtn=f0Sz2KnvG>m)2 zFRFMA&Dxm5*##!uliIx_CNY`qhqwExomFv z;GrXtK+X2_cQ8IliZ_wK#x=P;Pfgpo*lL=YXItW|rEYu84k7c0Y<$uk(9`r<84A#z z=xg4(E!@VN*Y=N|VgjuZ2PEh1E_A7D^~rh@Z1n)*O-#PGhrN&zd$>E({78>ItU(u{ z@W}Dg=SL95JBAFA*|D+Nu`ri^*SljO95c@b`3#)ye1p$^NWt<@H}1-|yI48mezg-P zMcQXBY<%z{&#yolFmwHNK|R^WlY(4pxZ7EGs72)Tb)$@IxOl3_O+3^hn&RnXDv<@I zBQiGy)g@-ui`r_5%ZUL9BOLDL)4bc(1G`_UJY% zgV%dYvo{Q^YNB)W)`;`Oq9_glp!Je0j=Kw@D>&|< z`0#Kd3GxT##~;e7<_U?p0sYXA&KuNcGobW7=unZyZZC0gxM$Wox28>5pLpOzU55kuO#`6R2% z(D-xADZFAw!09V3k9kDT9?mDcr|}UwJ$wl=m3|r++3++&y!ZPg;QHEX$ag1Bw-xDH@LyTC@PX*N~BH7l&FZZ zYuAyW$g$lxO-Ay?cI`To)Ui7mC)4mDPTKf^CV$jv)0yOtx}$d5L}_RG`lCZ7ohE-- z{q61@aHJHs8fme&_wD!C-S78(-=2Q-qWkK*()B|*uYWL;)sqE1QPNXHCc)m^*u`Eo zpejTO#6!Wj8j*=#J~MOf!qoJ{IGH&QBJVS);?U)NlQZWg4or_-y!iBisp+ZN3kS@d z?guMsB+`8kqo5jBgEBdNaiYe_duDR%{9_Zd55~#)nM;#X=N}_eV4j;8pPqP{kijRW zr%CbY*_kIU5vNvteSI<+AG-uyR%^?Igbv8v|F=z0?Rj3PCPj^^TaGy59D5%sP*Mk)p!63DxWAC zs~7I}f?YmQ(7|0#mS`cP7fC!7_4@N97$gH3gS{tsP)Q2gR?xHTK_MCTq_TcM^cD1B zL&g}SY*>x*E+37MT%wdr8;P9G-h@e#{V1DBhEXbDrkMZa-m{^o<8VKHA_bH;kW24Zbulz0tUljgO|==dMfT9?583+)jI> zN!lZH^jB%u(iZB6j$P$lRVus7^8DQ=sK2Y+Rh|2#RMsS_xyxF$9Inz@KkDemt28>Y zu%E^kVl?WOxVZAZDvjIy168_@9=P+$V@#2`c6xyByYn)Cc#*eX;BC1deBPXQ{Rxeu zeU&yYWNE+o!}SkI{pNqI-(HDIG%ig+0{er$`1P)3Ov?jR&SQYD&CP9e;O3Uql*^OL zbFDNg1PhUZeBmJ)rcv5YlaT;&T{R;x6C)lnyXm2#lmSEYO0vQ+0YF$JX7}JN)|e8lIZ-ScBE>Wv z&ZaOgW)sIkaE}UO5DTKmI#CR9{~}Q>Wc4D!5I^W70)Jt?Mmk0WGG$EaqQDqD3NRb)&DM zMI2*bBcy1WEl&&9#^Bf1TQwjw)D&A8Euh-E24f+ME*Op2y-0|Z5(6X{uD!z&fSdWX zO)plwSaAqU442ZhfMtfUJ#4juq?i4MBc!JnzmR`rKh`x!(1ydT4Jl+FiD?>ZfmsJg zObw!qat_g005nl7*gg`4nFoMb0dQ8e7~_v|uv4%O-`;%XnAeX*4j>9loWFE&YGPI< z8rD)Kh!AKs?6*v2C#EOPTw<{WBY`N9$7adQqj(5L6(T=5%P50TNlqfbja}q~=GQ;9 zL-Lv*e2SV4UQ+Se>u*6YPERSFDW>#1wh>SnA^Ncr>x7Agrb>tm4rjCWQ-BN_fO3$; zNS+q)i=&F;mM3g#GCQ2oQxxEt!bq45<^?iBn~GyQ-;pIS9X(8lPHzxqANY-MQeRc6L0=$+)N{&nC`;w$SFs zZ*jaRH~%4ReEe_Ajn%n-rH##}H&nC2;?FkIRu*j91n_@9?LIbt*CmxZ>+CpTnN+D5 z6VXcy%2i4h+o`;;RS1;1e9%so@v7l#l-OpzH1GO@v*Q+v|EHELRFH3i`;i>iX8G+L zCCinCq+vZ8R9;>P(Os!Kiw}dWoevAZUF@W?)oY=hh=tS#jO{=K@|D}Fh^gh)`MaBG zM;Bt|+%H}JP#`Q&PlH!-_|sIC6iWqmd^KPk10;4h2P+vpn}Rc`B$)<=DFQAM$)O$+ z)KoIun@kjSWG#{U6fpz*?3eJM8bAJ01q|AdsKQU}JZO}tfFMf^6(~2DsaSf5d4S*lWM@K9-=X51W*Oh1|g1(gplgamRT z?N%|9Ju3*5GJe$XPCg#OurWg}0&JfgJAa8hic(>gXY<`&^Dj2G@3NpXOtL&o<_TiU zXr5)BfHn&%&Ch#xtRaIWV*X^Pt>SuRz2tKDH;t_W2(8I9N+-DUd>}kEo47Iltg+;E z_&I;g8^@rdYb@+^JdHGPw-X@qCGINES*$sa3eQH6*}Z#s$vZUZJO1Y!3!WP4`u^On zk!~QI>NLx3Kp^D1Ut&jyk6=4Q&cIHn^MFP)a!BWNEF~x5;EG2CuS0x!v~A<`M{I1Um59JKdG&{rVX^A= z<`Vnu+Q8bm0Lk%4!VXwBam6KNvT9+L6^rnifkSL~SIJyhI=XGnsbg?NDb0$r)CZRW@M3 z&K10yl~Be=CMCkOMv4%s*Phu@9%B|OwIPMigby%Hi%^8|i!hB?O~h4WBk&j_#b@FH zt_B{xiU{m5xr9* z_|EL98mJ%M;*>+&t*VCgJH2jlh;yns-_i!_^$?f5;$5268rEy{rG<9qOg3V(uDGq< zh~LfmSdUJ6OMvxr-t+H*1~cBAmv-al?Bmn!rqmWzV`9x*U!=R1)=Y1jUUO^OLp%QA z)(Psnb#lvyf8O=qQn?k{?5-d8ipzQS5kw_PBqQ@5U#2bYa?AY3=h!4>M0b7K>REVQ zn>TFDWA!aILtZ#eeW(wu3a`03PMhz%S*6Xaw3R2sFm3z@Bo@uBk-mi%+Ce*Su`zq_ z>e*W;E$Ob8X&2q~tFKaCcCylV{;rpo+C#K;q%WJJjkJNUq<1~b__m-T{%7;Xj;)oU z@vri66k6dB4sMnf^}&NAjBsaHJ3+gw2*Uv_AMML#44s4#U4=)HP`KU=#%iOe5^REi zW_LBjEejFq(vM(InT=ZEBWG zoV#%8Y2*)(=P1`y1iF1IB%U~s1KT?el`i>fn)s|l3&ll(+gZS+ONwcY= ziR`f6-Cc_lB1D{fGLmCkQL+lw42md@x2!s?(9VvXNb)Kdl&)7ND+kB6SAJ1~w3)6czn92Q$taZh5AsBr;IA4Y^8WptK`xOO z_N#qHdp+1hRvKx(-1q!iuaU`e4W^wMu>PpHdt^&iUn#b3^;BdKPb=09E49JJ^0&m2 zC*RuWV$9h;9>0+lAhZd^zVWcJqplc`Vl^9F7rx%-Z)`d3lKR~&*m;)LWtx3vGN5hv zkY!`Parw>Ho4e`;AUg9~N34K#RmyV()~G`0?a+4fc3@ZvnPKHeSjxLf|HDkR)#O28 zIkQf9q>A&P5O4~a=ha=r>kpB5VgR=|JTq}lw*|=%@{t-r>kWPhqFxI|9$Fr| z8``=J7v}e|F~+2Sf{`#@q+hZ-6f^%$4ZA~8vmyA5`MvN1F!jUmJ*Gx~yQxtoY}frw z6|>m=2VeRNk*!i_@%f14hLqory@j?n?rZj12{~JnT4uQ2d@`PLhhye@@n3`P=H9(% zm-qU2JE_I7aIAs70ho864X_h`D>dc^0+cW8`yO~7+#f_cyT7ZZPap0VN4N=#-`@YK zw2@z(kx?xD&_M;Xmk)NLedFMbpx2L!`?!IeFOg*lEc@EPPu3tXrFWQL`?I7TpB~tK zAjgD9`bQWh{8{om+TE!kwEuXheJy`!-bg*R72>R_PTWs%hNf3xUlQ zgkynlBg1K4O8YSO>GbhV+hw_UQCv7ho9X{R>SA6#9Nx)}G^eub4ngPG3h*N<_^qTA z#u!7ROrLM%20LmThm9;n((E+a++@5BvN@yGS0lTZ=(e#0qF3ndHH^so0quarKchco zI)C>_uNb|31nYnbV*6ri;cuAie<@v9hqX|Hn)#LC9p+QR*{xpd>sW81=rD+Z$o~v4 zO5w$Kj-GV`(hcaUN;Tw=RaAwo-=b-Pa$3w!B zpB`_AegAnp%0(l{yuSM!TkBjXypwHVHIRNtQ^6)m*ay_T^3humWp9xU=Te&4b zlqY!14tUv0JJ_179KpASeYo$(tu~T^{g{N}689#TCgSFYV-0dWZY61cwAcO+;BYz9 zcx1>C$5F#OKeL(NdE_^3&;+)KVj88SmFeO9zc<#t!IofNJ+r+HUl}1KmnjyJPCA7& zo<8}>G5N=v%=t$;9=`vAvPf+e9^c`mSidA{Li6?0&#^BoOf1j66adbOwZ0MRVIQsOQE zHy7A8md%x9^Zl_l=W4WU_99UFk=nD6_>Ic8O%6}5o_VJe?kzseF#Kg%xD8*BFJ^2J z?ztkNG`~A8d*ILJ*DGxm&XJQ_JKM{)W3=}kVD+<4s;QBKxNu=Nf{7ffqFDOHRJTfl zx|mTM@Cd54HT`Z0C7)a3rRMU@-TmyLKB6z*+zJw8Q5cp6k_qu44<#K|-O@;?!eR~r zk$szl`v`uoBrHAlx!r({tDigSyWdx8@u>u##C=*lJ?s|W&G9p66zyc#{^d2I^~!60 zbh)?B3a>nD;sri|(?W{PsEneWs<4p@&t}Z6 zSGS: select entries where file1 has a later date than file2 BEFORE or <: select entries where file1 has an earlier date than file2 SAMEDATE or =: select entries where file1 and file2 have the same date -*: exclude entries where file1 does not exist *-: exclude entries where file2 does not exist ~=: exclude entries where file1 and file2 are byte-equivalent SELECT = NIL is equivalent to (< > -* *-). Excludes files with matching dates, a useful default for identifying files that may require further attention. SELECT = T is equivalent to (= < > -* *-). Includes all files for processing by other functions or later filtering by CDSUBSET (below). SELECT may also contain the token AUTHOR to indicate that authors should be provided in the printed output (see CDPRINT below). Unless USEDIRECTORYDATES, the FILECREATED date is used for the date comparison of Lisp source and compiled files, otherwise the file-system CREATIONDATE is used. If OUTPUTFILE=NIL, then a list of the form (Parameters . entries) is returned. Parameters is a list (DIR1 DIR2 SELECT DATE) that records the parameters of the comparison. Entries contains one entry for each of the file-comparisons that meets the SELECT criteria. Each entry is a CDENTRY record with fields (matchname info1 daterel info2 equiv) where matchname is the name.extension shared by the two files, and each file info is either NIL (for nonexistent files) or a CDINFO record with fields (FULLNAME DATE LENGTH AUTHOR TYPE EOL) TYPE is SOURCE for Lisp source (filecreated) files, COMPILED for Lisp compiled files, otherwise the PRINTFILETYPE (TEXT, TEDIT...) or NIL. EOL is CR, LF, CRLF, or NIL. When both files exist, the date relation is one of <, =, or >. Otherwise, the date relation is * if only one file exists. EQUIV is EQUIVALENT for files with different dates but exactly the same bytes, otherwise NIL. If OUTPUTFILE is not NIL, then it is a filename or open stream on which selected entries will be printed (T for the terminal) by CDPRINT. COMPAREDIRECTORIES sets the variable LASTCDENTRIES is set to the selected entries. This is used by the functions below if their CDENTRIES is NIL. (CDFILES DIR FILEPATTERNS EXTENSIONSTOAVOID ALLVERSIONS DEPTH) [Function] Returns a list of full filenames for files in directory DIR (NIL=T=the connected directory) that match the other file-name filtering criteria. Files are excluded if: Their name does not match a pattern in FILEPATTERNS (NIL = *). Dotted files are excluded unless FILEPATTERNS includes .* and files in subdirectories are excluded if the number of subdirectories exceeds DEPTH (below). Their extension is in the list EXTENSIONSTOAVOID (* excludes all extensions). They are not the highest version unless ALLVERSIONS=T. DEPTH controls the depth of subdirectory exploration. T means all levels, NIL means no subdirectories. Otherwise the maximum number of ">" characters below the starting DIR in the fullname of files. (CDFILES) produces all the newest, undotted files in the immediate connected directory. (CDPRINT CDENTRIES FILE PRINTAUTHOR) [Function] Prints CDENTRIES on FILE, with one line for each entry. The line for each entry is of the form FILE1 (AUTHOR) SIZE DATE relation DATE FILE2 (AUTHOR) SIZE For example ACE.;1 (Joe) 4035 2-May-1985 18:03:54 < 30-Sep-1985 11:14:48 ACE.;3 (Sam) 5096. The line for byte-equivalent files is prefixed with ==. If the files are equivalent except for a difference in end-of-line conventions, the equivalence prefix will indicate the convention for each file (C for CR, L, for LF, 2 for CRLF). Thus C2 indicates that the files are equivalent except that file1 marks line ends with CR and file2 with CRLF. Note that because of the setting of LASTCDENTRIES, evaluating (CDPRINT) after COMPAREDIRECTORIES prints the results of the last comparision. For conciseness, authors are included only if PRINTAUTHOR or if AUTHOR is included in the SELECT parameter of CDENTRIES. Also, the redundant file-name hosts/directories are not printed. (CDMAP CDENTRIES FN) [Function] (CDSUBSET CDENTRIES FN) [Function] CDMAP applies FN to each CDENTRY in CDENTRIES. CDSUBSET applies FN and also returns the subset of CDENTRIES for which FN is non-NIL and preserves in the value the parameters of CDENTRIES. For convenience, at each invocation the variables MATCHNAME INFO1 DATEREL INFO2 and EQUIV are bound to the corresponding fields and can be used freely by FN. USEFUL UTILITIES (FIX-DIRECTORY-DATES FILES) [Function] For every file included in or specified by FILES, if it is a Lisp source or compiled whose directory creation date is more than 30 seconds later than its internal filecreated date (presumably because of copying), then its directory date is reset to match the internal date. FILES can be a list of file names or a pattern interpretable by FILDIR. Returns a list of files whose dates have been changed. (FIX-EQUIV-DATES CDENTRIES) [Function] If there is an entry in CDENTRIES whose files are EQUIVALENT but with different directory creation dates, the directory date of the file with the later date (presumably a copy) is reset to match the date of the earlier file. In the end all equivalent files will have the same (earliest) date. Returns a list of files whose dates have been changed. (COPY-MISSING-FILES CDENTRIES TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with a source file but no target file has a matchname in MATCHNAMES, the source file is copied to the target directory. All target-absent files are copied if MATCNAMES is NIL. Source properties (including version number) are preserved in the target. (COPY-COMPARED-FILES CDENTRIES TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with both source and target files has a matchname in MATCHNAMES, the source file is copied to a new version of the target file. All files are copied if MATCHNAMES is NIL. (COMPARE-ENTRY-SOURCE-FILES CDENTRY LISTSTREAM EXAMINE DW?) [Function] This is a simple wrapper for calling COMPARESOURCES if the CDENTRY files are Lisp source files. The function (CDENTRY MATCHNAME CDENTRIES is useful for extracting a particular entry, with CDENTRIES defaulting to LASTCDENTRIES. (COMPILED-ON-SAME-SOURCE CDENTRIES) [Function] Returns the subset of entries with Lisp compiled files (dfasl or lcom) that are compiled on the same source, according to SOURCE-FOR-COMPILED-P below. Presumably one should be removed to avoid confusion. (FIND-SOURCE-FILES CFILES SDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES and SFILES is list of files in SDIRS that CFILE was compiled on according to SOURCE-FOR-COMPILED-P. This suggests that at least one of SFILES should be copied to CFILE's location (or vice versa). (FIND-COMPILED-FILES SFILES CDIRS DFASLMARGIN) [Function] Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES and CFILES are files in CDIRS that are compiled on SFILE according to SOURCE-FOR-COMPILED-P. This suggests that at least one of CFILES should be copied to SFILE's location. (FIND-UNCOMPILED-FILES FILES DFASLMARGIN COMPILEXTS) [Function] Returns a list of elements each of which corresponds to a source file in FILES for which no appropriate compiled file can be found. An appropriate compiled file is a file in the same location with extension in COMPILEEXTS (defaulting to *COMPILED-EXTENSIONS*) that satisfies SOURCE-FOR-COMPILED-P. Each element is a list of the form (sourcefile . cfiles) cfiles contains compiled files that were compiled on a different version of sourcefile, NIL if no such files exist. Each cfile item is a pair (cfile timediff) where timediff is the time difference (in minutes) between the creation date of the compiled-file's source and the creation date of sourcefile (positive if the cfile was compiled later, as should be the case). FILES can be an explicit list of files, or a file specification interpretable by FILDIR; in that case only the newest source-file versions are processed. (FIND-UNSOURCED-FILES CFILES DFASLMARGIN COMPILEXTS) [Function] Returns the subset of the compiled files specified by CFILES for which a corresponding source file according to SOURCE-FOR-COMPILED-P cannot be found in the same directory. CFILES can be a list of files or a pattern that FILDIR can interpret. COMPILEEXTS can be one or more explicit compile-file extensions, defaulting to *COMPILED-EXTENSIONS*. (SOURCE-FOR-COMPILED-P SOURCE COMPILED DFASLMARGIN) [Function] Returns T if it can confirm that Lisp COMPILED file was compiled on Lisp SOURCE file. SOURCE and COMPILED can be provided as CREATED-AS values, to avoid repetitive computation. This compares the information in the filecreated expressions, original file names and original dates, and not the current directory names and dates. It appears that the times in DFASL files may differ from the filecreated source dates by a few minutes. The DFASLMARGIN can be provided to loosen up the date matching criterion. DFASLMARGIN is a pair (max min) and a DFASL COMPILED is deemed to be compiled on SOURCE if the compiled's source date is no more than max and no less than min minutes after the source date. A negative min allows for the possibility that the compiled-source date is earlier than the candidate source date. DFASLMARGIN defaults to (20 0). A single positive number x is coerced to (x 0). A single negative number is coerced to (-x x) (compiled file is no more than x minutes later or earlier). T is infinity in either direction. Examples: (T 0): COMPILED compiled on source later than SOURCE (0 T): COMPILED compiled on source earlier than SOURCE (odd) 12: COMPILED compiled on source later than SOURCE by no more than 12 minutes -12: COMPILED compiled on source 12 minutes before or after SOURCE (FIND-MULTICOMPILED-FILES FILES SHOWINFO) [Function] Returns a list of files in FILES that have more than one type of compiled file (e.g. LCOM and DFASL). FILES is interpretable by FILDIR. If SHOWINFO, then the value contains a list for each file of the form ÿÿï!ÿ(rootname loaded-version . CREATED-AS information for each compile-type) Otherwise just the rootname of the source is returns. (CREATED-AS FILE) [Function] If FILE is a Lisp source or compiled file, returns a record of its original filename and filecreated dates, and for compiled files, also the original compiled-on name and date. The return for a source file is a pair (sfullname sfilecreateddate) The return for a compiled file is a quadruple (cfullname cfilecreated sfullname sfilecreateddate) where sfullname and sourcefilecreated are extracted from the file's compiled-on information. The return is (fullname NIL) for a non-Lisp file. (EOLTYPE FILE SHOWCONTEXT) [Function] Returns the EOLTYPE of FILE (CR, LF, CRLF) if the type is unmistakable: contains at least one instance of one type and no instances of any others. Returns NIL if there is evidence of inconsistent types. If SHOWCONTEXT is an integer, it is the number of bytes for EOLTYPE to display before and after an instance of an inconsistent type. At each instance, the user is asked whether to continue scanning for other instances. SHOWCONTEXT = T is interpreted as 100. (BINCOMP FILE1 FILE2 EOLDIFFOK) [Function] Returns T if FILE1 and FILE2 are byte-identical. If EOLDIFFOK and FILE1 and FILE2 differ only in their eol conventions, the value is a list of the form (EOL1 EOL2), e.g. (CR CRLF). Otherwise the value is NIL. (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ÈÈ40ÈÈ4 ÈÈ4ÈÈ.4@È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEAD. -GACHA -TERMINALMODERN -MODERN -TERMINAL + By: Larry Masinter and Ron Kaplan This document edited on December 2, 1987 December 28, 1998 (Ron Kaplan) April 7, 2018 (Ron Kaplan) Rewritten December, 2021 (Ron Kaplan) COMPAREDIRECTORIES compares the contents of two directories, identifying files according to their creation dates and lengths. It is called using the function (COMPAREDIRECTORIES DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATES OUTPUTFILE ALLVERSIONS) [Function] Compares the creation dates of files with matching names in the lists that CDFILES returns for DIR1 and DIR2. Collects or prints CDENTRIES for those files that meet the SELECT criteria. May also collect or print entries for relevant files that exist in DIR1 or DIR2 but not both. +SELECT specifies which the match/mismatch criteria for filtering the output. If SELECT is or contains AFTER or >: select entries where file1 has a later date than file2 BEFORE or <: select entries where file1 has an earlier date than file2 SAMEDATE or =: select entries where file1 and file2 have the same date -*: exclude entries where file1 does not exist *-: exclude entries where file2 does not exist ~=: exclude entries where file1 and file2 are byte-equivalent SELECT = NIL is equivalent to (< > -* *-). Excludes files with matching dates, a useful default for identifying files that may require further attention. SELECT = T is equivalent to (= < > -* *-). Includes all files for processing by other functions or later filtering by CDSUBSET (below). SELECT may also contain the token AUTHOR to indicate that authors should be provided in the printed output (see CDPRINT below). Unless USEDIRECTORYDATES, the FILECREATED date is used for the date comparison of Lisp source and compiled files, otherwise the file-system CREATIONDATE is used. If OUTPUTFILE=NIL, then the value is a CDVALUE structure with fields (CDPARAMETERS . CDENTRIES). CDPARAMETERS records the parameters in the call to COMPAREDIRECTORIES and CDENTRIES is the list of per-file comparison results. CDPARAMETERS has fields + CDDIR1 CDDIR2 CDCOMPAREDATE CDSELECT. +CDENTRIES contains one entry for each of the file-comparisons that meets the SELECT criteria. Each entry is a CDENTRY record with fields MATCHNAME INFO1 DATERULE INFO2 EQUIV where MATCHNAME is the name.extension shared by the two files, and each file info is either NIL (for nonexistent files) or a CDINFO record with fields (FULLNAME DATE LENGTH AUTHOR TYPE EOL) TYPE is SOURCE for Lisp source (filecreated) files, COMPILED for Lisp compiled files, otherwise the PRINTFILETYPE (TEXT, TEDIT...) or NIL. EOL is CR, LF, CRLF, or NIL. When both files exist, the date relation is one of <, =, or >. Otherwise, the date relation is * if only one file exists. EQUIV is EQUIVALENT for files with different dates but exactly the same bytes, otherwise NIL. If OUTPUTFILE is not NIL, then it is a filename or open stream on which selected entries will be printed (T for the terminal) by CDPRINT. COMPAREDIRECTORIES always sets the variable LASTCDVALUE to the CDVALUE data structure. This is used by the functions below if their CDENTRIES is NIL. (CDPRINT CDVALUE FILE COLHEADINGS PRINTAUTHOR ) [Function] Prints CDVALUE on FILE, with one line for each entry. The line for each entry is of the form FILE1 (AUTHOR) SIZE DATE DATEREL DATE FILE2 (AUTHOR) SIZE For example ACE.;1 (Joe) 235 2-May-1985 18:03:54 < 30-Sep-1985 11:14:48 ACE.;3 (Sam) 396 The line for byte-equivalent files is prefixed with ==. If the files are equivalent except for a difference in end-of-line conventions, the equivalence prefix will indicate the convention for each file (C for CR, L, for LF, 2 for CRLF). Thus C2 indicates that the files are equivalent except that file1 marks line ends with CR and file2 with CRLF. +COLHEADINGS can be a pair (col1 col2) of strings to be printed as column headings. Note that because COMPAREDIRECTORIES sets LASTCDVALUE, evaluating (CDPRINT) after COMPAREDIRECTORIES prints the results of the last comparision. For conciseness, authors are included only if PRINTAUTHOR or if AUTHOR is included in the CDSELECT parameter of CDVALUE. Also, redundant file-name hosts/directories are not printed. + +(CDTEDIT CDVALUE TITLE COLHEADINGS PRINTAUTHOR) [Function] +Produces the CDPRINT output in a read-only TEDIT window, with TITLE if given. + +(CDBROWSER CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS PRINTAUTHOR) [Function] +Produce the CDPRINT output in a TABLEBROWSER window with menu commands for comparing the contents of individual files, viewing files in read-only TEDIT windows, copying files from one directory to another, etc. Lisp source files are compared with COMPARESOURCES, text files with COMPARETEXT. If SEPARATEDIRECTIONS, the entry lines are grouped according to whether the date relation is < or >. +(CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) [Function] Returns a list of full filenames for files in directory DIR (NIL=T=the connected directory) that match the other file-name filtering criteria. Files are excluded if: Their name does not match a pattern in INCLUDEDFILES (NIL = *.*). Dotted files are excluded unless FILEPATTERNS includes .* and files in subdirectories are excluded if the number of subdirectories exceeds DEPTH (below). They do not match patterns on the list EXCLUDEDFILES. *.* excludes all extensions, *.COM or just COM excludes extentsions on *COMPILED-EXTENSIONS*. EXCLUDEDFILES contains .* to suppress dotted files unless .* also appears in INCLUDEDFILES. They are not the highest version unless ALLVERSIONS=T. DEPTH controls the depth of subdirectory exploration. T means all levels, NIL means no subdirectories. Otherwise the maximum number of > or / characters below the starting DIR in the fullname of files. (CDFILES) produces all the newest, undotted files in the immediate connected directory. (CDMAP CDVALUE FN) [Function] (CDSUBSET CDVALUE FN) [Function] CDMAP applies FN to each CDENTRY in CDVALUE. CDSUBSET applies FN and also returns the subset of the entries for which FN is non-NIL and preserves in the value the parameters of CDVALUE. For convenience, at each invocation the variables MATCHNAME INFO1 DATEREL INFO2 and EQUIV are bound to the corresponding fields and can be used freely by FN. USEFUL UTILITIES (FIX-DIRECTORY-DATES FILES) [Function] For every file included in or specified by FILES, if it is a Lisp source or compiled whose directory creation date is more than 30 seconds later than its internal filecreated date (presumably because of copying), then its directory date is reset to match the internal date. FILES can be a list of file names or a pattern interpretable by FILDIR. Returns a list of files whose dates have been changed. (FIX-EQUIV-DATES CDVALUE) [Function] If there is an entry in CDVALUE whose files are EQUIVALENT but with different directory creation dates, the directory date of the file with the later date (presumably a copy) is reset to match the date of the earlier file. In the end all equivalent files will have the same (earliest) date. Returns a list of files whose dates have been changed. (COPY-MISSING-FILES CDVALUE TARGET MATCHNAMES) [Function] Target is 1 or 2, indicating the direction of potential copies. If an entry with a source file but no target file has a matchname in MATCHNAMES, the source file is copied to the target directory. All target-absent files are copied if MATCNAMES is NIL. Source properties (including version number) are preserved in the target. (COPY-COMPARED-FILES CDVALUE TARGET MATCHNAMES) [Function] TARGET is 1 or 2, indicating the direction of potential copies. If an entry with both source and target files has a matchname in MATCHNAMES, the source file is copied to a new version of the target file. All files are copied if MATCHNAMES is NIL. (COMPILED-ON-SAME-SOURCE CDVALUE) [Function] Returns the subset of entries with Lisp compiled files (dfasl or lcom) that are compiled on the same source, according to SOURCE-FOR-COMPILED-P below. Presumably one should be removed to avoid confusion. (FIND-SOURCE-FILES CFILES SDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES and SFILES is list of files in SDIRS that CFILE was compiled on according to SOURCE-FOR-COMPILED-P. This suggests that at least one of SFILES should be copied to CFILE's location (or vice versa). (FIND-COMPILED-FILES SFILES CDIRS DFASLMARGIN) [Function] Returns (CFILE . SFILES) pairs where SFILE is a Lisp source file in SFILES and CFILES are files in CDIRS that are compiled on SFILE according to SOURCE-FOR-COMPILED-P. This suggests that at least one of CFILES should be copied to SFILE's location. (FIND-UNCOMPILED-FILES FILES DFASLMARGIN COMPILEXTS) [Function] Returns a list of elements each of which corresponds to a source file in FILES for which no appropriate compiled file can be found. An appropriate compiled file is a file in the same location with extension in COMPILEEXTS (defaulting to *COMPILED-EXTENSIONS*) that satisfies SOURCE-FOR-COMPILED-P. Each element is a list of the form (sourcefile . cfiles) cfiles contains compiled files that were compiled on a different version of sourcefile, NIL if no such files exist. Each cfile item is a pair (cfile timediff) where timediff is the time difference (in minutes) between the creation date of the compiled-file's source and the creation date of sourcefile (positive if the cfile was compiled later, as should be the case). FILES can be an explicit list of files, or a file specification interpretable by FILDIR; in that case only the newest source-file versions are processed. (FIND-UNSOURCED-FILES CFILES DFASLMARGIN COMPILEXTS) [Function] Returns the subset of the compiled files specified by CFILES for which a corresponding source file according to SOURCE-FOR-COMPILED-P cannot be found in the same directory. CFILES can be a list of files or a pattern that FILDIR can interpret. COMPILEEXTS can be one or more explicit compile-file extensions, defaulting to *COMPILED-EXTENSIONS*. (SOURCE-FOR-COMPILED-P SOURCE COMPILED DFASLMARGIN) [Function] Returns T if it can confirm that Lisp COMPILED file was compiled on Lisp SOURCE file. SOURCE and COMPILED can be provided as CREATED-AS values, to avoid repetitive computation. This compares the information in the filecreated expressions, original file names and original dates, and not the current directory names and dates. It appears that the times in DFASL files may differ from the filecreated source dates by a few minutes. The DFASLMARGIN can be provided to loosen up the date matching criterion. DFASLMARGIN is a pair (max min) and a DFASL COMPILED is deemed to be compiled on SOURCE if the compiled's source date is no more than max and no less than min minutes after the source date. A negative min allows for the possibility that the compiled-source date is earlier than the candidate source date. DFASLMARGIN defaults to (20 0). A single positive number x is coerced to (x 0). A single negative number is coerced to (-x x) (compiled file is no more than x minutes later or earlier). T is infinity in either direction. Examples: (T 0): COMPILED compiled on source later than SOURCE (0 T): COMPILED compiled on source earlier than SOURCE (odd) + 12: COMPILED compiled on source later than SOURCE by no more than 12 minutes -12: COMPILED compiled on source 12 minutes before or after SOURCE (FIND-MULTICOMPILED-FILES FILES SHOWINFO) [Function] Returns a list of files in FILES that have more than one type of compiled file (e.g. LCOM and DFASL). FILES is interpretable by FILDIR. If SHOWINFO, then the value contains a list for each file of the form ÿÿï!ÿ(rootname loaded-version . CREATED-AS information for each compile-type) Otherwise just the rootname of the source is returns. (CREATED-AS FILE) [Function] If FILE is a Lisp source or compiled file, returns a record of its original filename and filecreated dates, and for compiled files, also the original compiled-on name and date. The return for a source file is a pair (sfullname sfilecreateddate) The return for a compiled file is a quadruple (cfullname cfilecreated sfullname sfilecreateddate) where sfullname and sourcefilecreated are extracted from the file's compiled-on information. The return is (fullname NIL) for a non-Lisp file. (EOLTYPE FILE SHOWCONTEXT) [Function] Returns the EOLTYPE of FILE (CR, LF, CRLF) if the type is unmistakable: contains at least one instance of one type and no instances of any others. Returns NIL if there is evidence of inconsistent types. If SHOWCONTEXT is an integer, it is the number of bytes for EOLTYPE to display before and after an instance of an inconsistent type. At each instance, the user is asked whether to continue scanning for other instances. SHOWCONTEXT = T is interpreted as 100. (BINCOMP FILE1 FILE2 EOLDIFFOK) [Function] Returns T if FILE1 and FILE2 are byte-identical. If EOLDIFFOK and FILE1 and FILE2 differ only in their eol conventions, the value is a list of the form (EOL1 EOL2), e.g. (CR CRLF). Otherwise the value is NIL. (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ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEAD.MODERNTERMINALMODERN +TERMINAL MODERN MODERN -MODERNLOGOMODERN -    HRULE.GETFNMODERN - +LOGOMODERN +   HRULE.GETFNMODERN +  HRULE.GETFNMODERN - +  HRULE.GETFNMODERN -   HRULE.GETFNMODERN  - HRULE.GETFNMODERN #!(ž - -\ -fJLL44C›Š€£6)˜*©Ú‹”K¦ÙN7ÉX1_A P]Ž»'%Z.“,]>I?û= ä0Ì:<ûAOA[@HÑ:BRJ6ÐK7Ù".9'Ñ-Õ  - 1Szº \ No newline at end of file +   HRULE.GETFNMODERN  + HRULE.GETFNMODERN #!'Œo K  Of@A?44C  m +H  c   ' .   $ D( o*&mÚ +~ ?  +<G@ L]  .   .. @@ * m   Ì H= 8k' / ^ '    +! ( Ì O"   F4A'+c& +!<† +\ T=| +Z + .z=: %< &AI† %A64)* D@& +ÀK < Ü ß  ! &/65; +$7Ù".9' § .š -  G "  3öYzº \ No newline at end of file diff --git a/lispusers/COMPARESOURCES b/lispusers/COMPARESOURCES index 24459b0b..7dfdcaf6 100644 --- a/lispusers/COMPARESOURCES +++ b/lispusers/COMPARESOURCES @@ -1,43 +1,76 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Sep-2020 19:02:30"  -{DSK}kaplan>Local>medley3.5>lispcore>lispusers>COMPARESOURCES.;3 20197 - changes to%: (FNS \CS.COMPARE.MASTERS) +(FILECREATED " 3-Jan-2022 08:40:38"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;106 42666 - previous date%: "19-Apr-2018 10:50:03" -{DSK}kaplan>Local>medley3.5>lispcore>lispusers>COMPARESOURCES.;2) + :CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN CSOBJ.COPYBUTTONEVENTINFN) + (VARS COMPARESOURCESCOMS) + + :PREVIOUS-DATE "27-Dec-2021 11:56:48" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;105) (* ; " -Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All rights reserved. +Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. ") (PRETTYCOMPRINT COMPARESOURCESCOMS) (RPAQQ COMPARESOURCESCOMS - ((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.SORT.DECLARES \CS.SORT.DECLARE1 - \CS.FILTER.GARBAGE) - (FNS \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM \CS.ISRECFORM \CS.ISCOURIERFORM - \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM \CS.PROP.NAME \CS.COMPARE.PROPS - \CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS) + ((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.EXAMINE \CS.FIXFNS + \CS.SORT.DECLARES \CS.SORT.DECLARE1 \CS.FILTER.GARBAGE) + (FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM + \CS.ISRECFORM \CS.ISCOURIERFORM \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM + \CS.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM + \CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO) + [COMS (FNS CSOBJ.CREATE CSOBJ.DISPLAYFN CSOBJ.IMAGEBOXFN CSOBJ.BUTTONEVENTINFN + CSOBJ.COPYBUTTONEVENTINFN) + (INITVARS (COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN + NIL NIL NIL 'CSOBJ.BUTTONEVENTINFN + '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) (GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS DEFAULT.DECLARE.TAGS)))) (DEFINEQ (COMPARESOURCES - [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 19-Apr-2018 10:49 by rmk:") + [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:") -(* ;;; "Compare two lisp source files, reporting differences.") +(* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream") (DECLARE (SPECVARS FILEX FILEY EXAMINE DIFFERENCES)) - (PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY) - [SETQ FILEX (OR (FINDFILE FILEX T) - (RETURN (printout LISTSTREAM FILEX " not found" T] - [SETQ FILEY (OR (FINDFILE FILEY T) - (RETURN (printout LISTSTREAM FILEY " not found" T] + (PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY DATECOL + [INSERTOBJECTS (AND EXAMINE (IF (TEXTSTREAMP LISTSTREAM) + THEN 'TEDIT + ELSEIF (OBJWINDOWP LISTSTREAM) + THEN 'OBJECTWINDOW] + (COMPARESTREAM LISTSTREAM) + (CONTEXTSTREAM LISTSTREAM) + OBJECTS) + (DECLARE (SPECVARS INSERTOBJECTS OBJECTABLE)) + (CL:WHEN INSERTOBJECTS + (SETQ COMPARESTREAM (CL:MAKE-STRING-OUTPUT-STREAM)) + (SETQ CONTEXTSTREAM (CL:MAKE-STRING-OUTPUT-STREAM)) + (LINELENGTH 65535 COMPARESTREAM) (* ; "Let the receiver do the wrapping") + (LINELENGTH 65535 CONTEXTSTREAM)) + (OR (INFILEP FILEX) + (SETQ FILEX (FINDFILE FILEX T)) + (RETURN (printout CONTEXTSTREAM FILEX " not found" T))) + (OR (INFILEP FILEY) + (SETQ FILEY (FINDFILE FILEY T)) + (RETURN (printout CONTEXTSTREAM FILEY " not found" T))) - (* ;; "Read the two files, throwing out extraneous forms & such:") + (* ;; "Read the two files, throwing out extraneous forms & such:") (CL:MULTIPLE-VALUE-SETQ (BODYX ENVX) (READFILE FILEX)) @@ -45,186 +78,322 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ (CL:MULTIPLE-VALUE-SETQ (BODYY ENVY) (READFILE FILEY)) (SETQ BODYY (\CS.FILTER.GARBAGE BODYY)) - (printout LISTSTREAM "Comparing " FILEX " dated " (GETFILEINFO FILEX 'CREATIONDATE) - " and " FILEY " dated " (GETFILEINFO FILEY 'CREATIONDATE) - ":" T T) + [SETQ DATECOL (PLUS 2 (CONSTANT (NCHARS "Comparing")) + (IMAX (NCHARS FILEX) + (NCHARS FILEY] + (printout CONTEXTSTREAM "Comparing " FILEX .TAB0 DATECOL "dated " (GETFILEINFO FILEX + 'CREATIONDATE) + .TAB + [SUB1 (CONSTANT (IDIFFERENCE (NCHARS "Comparing ") + (NCHARS "and "] + " and " FILEY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE) + T T) [SETQ DECLAREX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR) - 'DECLARE%:] + 'DECLARE%:] (SETQ BODYX (CL:SET-DIFFERENCE BODYX DECLAREX)) [SETQ DECLAREY (for EXPR in BODYY collect EXPR when (EQ (CAR EXPR) - 'DECLARE%:] + 'DECLARE%:] (SETQ BODYY (CL:SET-DIFFERENCE BODYY DECLAREY)) (WITH-READER-ENVIRONMENT (OR ENVX ENVY (MAKE-READER-ENVIRONMENT)) - (\CS.COMPARE.MASTERS BODYX BODYY DW? LISTSTREAM) + (\CS.COMPARE.MASTERS BODYX BODYY DW? CONTEXTSTREAM COMPARESTREAM) - (* ;; "Done with the non-DECLARE: expressions. Now sort what's left according to when it is eval'ed so that we can hopefully further reduce the amount of stuff to compare") + (* ;; "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") (SETQ BODYX (\CS.SORT.DECLARES DECLAREX)) (SETQ BODYY (\CS.SORT.DECLARES DECLAREY)) [SETQ BODYX (APPEND BODYX (for Y in BODYY collect (LIST (CAR Y)) unless (SASSOC (CAR Y) - BODYX] - (* ; - "Add placeholders for any declaration types in Y not in X to simplify what follows") + BODYX] + (* ; + "Add placeholders for any declaration types in Y not in X to simplify what follows") [for X in BODYX bind Y TYPE do (SETQ Y (SASSOC (CAR X) - BODYY)) - (SETQ TYPE (CAR X)) - [SETQ X (LDIFFERENCE (CDR X) - (PROG1 (CDR Y) - (SETQ Y (LDIFFERENCE (CDR Y) - X)))] - (COND - ((OR X Y) - (printout LISTSTREAM T "------" [CONS 'DECLARE%: (APPEND ( + BODYY)) + (SETQ TYPE (CAR X)) + (SETQ X (CL:SET-DIFFERENCE (CDR X) + (PROG1 (CDR Y) + (SETQ Y (CL:SET-DIFFERENCE (CDR Y) + X :TEST (FUNCTION EQUALALL)))) + :TEST + (FUNCTION EQUALALL))) + (COND + ((OR X Y) + (printout CONTEXTSTREAM T "------" [CONS 'DECLARE%: (APPEND ( CL:SET-DIFFERENCE TYPE DEFAULT.DECLARE.TAGS ) '(--] - " forms------" T) (* ; - "REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order") - (\CS.COMPARE.MASTERS (REVERSE X) - (REVERSE Y) - DW? LISTSTREAM] - (TERPRI LISTSTREAM)) + " forms------" T) (* ; + "REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order") + (\CS.COMPARE.MASTERS (REVERSE X) + (REVERSE Y) + DW? CONTEXTSTREAM COMPARESTREAM] + (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)) (RETURN (OR (REVERSE DIFFERENCES) 'SAME]) (\CS.COMPARE.MASTERS - [LAMBDA (BODYX BODYY DW? LISTSTREAM) (* ; "Edited 5-Sep-2020 19:01 by rmk:") - (* ; "Edited 15-Apr-88 14:41 by bvm") - (LET (FNSX FNSY YTHING XTHING PRED DIFS Y TMP DEFFERS) - (DECLARE (USEDFREE DIFFERENCES)) - [SETQ FNSX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR) - 'DEFINEQ] - (SETQ BODYX (CL:SET-DIFFERENCE BODYX FNSX)) - (SETQ FNSX (for BOD in FNSX join (CDR BOD))) - [SETQ FNSY (for EXPR in BODYY collect EXPR when (EQ (CAR EXPR) - 'DEFINEQ] - (SETQ BODYY (CL:SET-DIFFERENCE BODYY FNSY)) - (SETQ FNSY (for BOD in FNSY join (CDR BOD))) - [COND - ((OR FNSX FNSY) - (printout LISTSTREAM "---Functions: " T) - [COND - (DW? (LET ((NOSPELLFLG T)) - (DECLARE (SPECVARS NOSPELLFLG)) - (for X in FNSX when (SETQ Y (ASSOC (CAR X) - FNSY)) - do (* ; - "Only bother dwimifying the ones that look different") - (DWIMIFY (CADR X) - T) - (DWIMIFY (CADR Y) - T] - (COND - ((SETQ DIFS (\CS.COMPARE.TYPES FNSX FNSY NIL [FUNCTION (LAMBDA (X Y STREAM) - (COMPARELISTS - (CADR X) - (CADR Y) - STREAM] - (FUNCTION CAR) - LISTSTREAM)) - (push DIFFERENCES (CONS 'FNS DIFS] - [for TYPE in FILEPKGTYPES when (AND (CL:SYMBOLP TYPE) - (SETQ DEFFERS (GET TYPE :DEFINED-BY))) + [LAMBDA (BODYX BODYY DW?) (* ; "Edited 19-Dec-2021 21:05 by rmk") + (* ; "Edited 9-Dec-2021 23:26 by rmk") + (* ; "Edited 4-Dec-2021 10:00 by rmk") + (* ; "Edited 2-Dec-2021 14:25 by rmk:") + (* ; "Edited 27-Nov-2021 12:31 by rmk:") + (* ; "Edited 5-Sep-2020 19:01 by rmk:") + (* ; "Edited 15-Apr-88 14:41 by bvm") + (DECLARE (USEDFREE DIFFERENCES COMPARESTREAM)) + (LET (YTHING XTHING PRED DIFS TMP) + (SETQ BODYX (\CS.FIXFNS BODYX)) + (SETQ BODYY (\CS.FIXFNS BODYY)) + (CL:WHEN (AND (SETQ XTHING (ASSOC 'DEFINE-FILE-INFO BODYX)) + (SETQ YTHING (ASSOC 'DEFINE-FILE-INFO BODYY)) + (\CS.COMPARE.DEFINE-FILE-INFO XTHING YTHING)) + (SETQ BODYX (REMOVE XTHING BODYX)) + (SETQ BODYY (REMOVE YTHING BODYY))) + + (* ;; "These are for commonlispy definers") + + [for TYPE DEFFERS in FILEPKGTYPES when (AND (CL:SYMBOLP TYPE) + (SETQ DEFFERS (GET TYPE :DEFINED-BY))) do + (* ;; "handle definer based things") - (* ;; "handle definer based things") + (for DEFFER in DEFFERS do (SETQ XTHING (for X in BODYX collect X + when (EQ (CAR X) + DEFFER))) + (SETQ YTHING (for X in BODYY collect X + when (EQ (CAR X) + DEFFER))) - (for DEFFER in DEFFERS - do (SETQ XTHING (for X in BODYX collect X - when (EQ (CAR X) - DEFFER))) - (SETQ YTHING (for X in BODYY collect X - when (EQ (CAR X) - DEFFER))) - (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING)) - (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING)) - (COND - ((SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING - (CONCAT (OR (CL:DOCUMENTATION TYPE 'DEFINE-TYPES) - TYPE) - " defined by " DEFFER) - NIL - (GET DEFFER :DEFINITION-NAME) - LISTSTREAM)) - (COND - ((SETQ TMP (ASSOC TYPE DIFFERENCES)) - (NCONC TMP DIFS)) - (T (push DIFFERENCES (CONS TYPE DIFS] - [for TYPE in COMPARESOURCETYPES - do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE)) - (SETQ XTHING (for X in BODYX collect X when (CL:FUNCALL PRED X))) - (SETQ YTHING (for X in BODYY collect X when (CL:FUNCALL PRED X))) - (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING)) - (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING)) - (COND - ((SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING - (OR (fetch (CSTYPE TITLE) of TYPE) - (L-CASE (MKSTRING (fetch (CSTYPE FPKGTYPE) - of TYPE)) - T)) - (fetch (CSTYPE COMPAREFN) of TYPE) - (OR (fetch (CSTYPE IDFN) of TYPE) - (FUNCTION CADR)) - LISTSTREAM)) - (SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE)) - (COND - ((SETQ TMP (ASSOC TYPE DIFFERENCES)) - (NCONC TMP DIFS)) - (T (push DIFFERENCES (CONS TYPE DIFS] - [SETQ BODYY (LDIFFERENCE BODYY (PROG1 BODYX - (SETQ BODYX (LDIFFERENCE BODYX BODYY)))] + (* ;; "Take out all of the THINGS we are about to do. ") + + (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST + (FUNCTION EQUALALL))) + (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST + (FUNCTION EQUALALL))) + (COND + ((SETQ DIFS (\CS.COMPARE.TYPES + XTHING YTHING + (CONCAT (OR (CL:DOCUMENTATION TYPE + 'DEFINE-TYPES) + TYPE) + " defined by " DEFFER) + NIL + (GET DEFFER :DEFINITION-NAME))) + (COND + ((SETQ TMP (ASSOC TYPE DIFFERENCES)) + (NCONC TMP DIFS)) + (T (push DIFFERENCES (CONS TYPE DIFS] + + (* ;; "These are for other filepkage types, as registered in COMPARESOURCETYPES") + + [for TYPE in COMPARESOURCETYPES do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE)) + (SETQ XTHING (for X in BODYX collect X + when (CL:FUNCALL PRED X))) + (SETQ YTHING (for X in BODYY collect X + when (CL:FUNCALL PRED X))) + (SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST + (FUNCTION EQUALALL))) + (SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST + (FUNCTION EQUALALL))) + (COND + ([SETQ DIFS (\CS.COMPARE.TYPES + XTHING YTHING + (OR (fetch (CSTYPE TITLE) of TYPE) + (MKSTRING (fetch (CSTYPE FPKGTYPE) + of TYPE))) + (fetch (CSTYPE COMPAREFN) of TYPE) + (OR (fetch (CSTYPE IDFN) of TYPE) + (FUNCTION CADR] + (SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE)) + (COND + ((SETQ TMP (ASSOC TYPE DIFFERENCES)) + (NCONC TMP DIFS)) + (T (push DIFFERENCES (CONS TYPE DIFS] + (SETQ BODYY (CL:SET-DIFFERENCE BODYY (PROG1 BODYX + (SETQ BODYX (CL:SET-DIFFERENCE + BODYX BODYY :TEST + (FUNCTION EQUALALL)))) + :TEST + (FUNCTION EQUALALL))) (COND ((OR BODYX BODYY) - (printout LISTSTREAM T "---Expressions:" T) + (printout CONTEXTSTREAM T "---Expressions:" T) (LET ((COMMENTX 0) - (COMMENTY 0) - EXTRAS) (* ; "Remove comments") - [SETQ BODYX (for X in BODYX collect X - unless (COND - ((EQ (CAR X) - COMMENTFLG) - (add COMMENTX 1) - T] - [SETQ BODYY (for Y in BODYY collect Y - unless (COND - ((EQ (CAR Y) - COMMENTFLG) - (add COMMENTY 1) - T] + (COMMENTY 0)) (* ; "Remove comments") + [SETQ BODYX (for X in BODYX collect X unless (COND + ((EQ (CAR X) + COMMENTFLG) + (add COMMENTX 1) + T] + [SETQ BODYY (for Y in BODYY collect Y unless (COND + ((EQ (CAR Y) + COMMENTFLG) + (add COMMENTY 1) + T] (COND ((OR (NEQ COMMENTX 0) (NEQ COMMENTY 0)) - (printout LISTSTREAM .I1 COMMENTX " comments -> " .I1 COMMENTY " comments." T T - ))) + (printout CONTEXTSTREAM .I1 COMMENTX " comments -> " .I1 COMMENTY " comments." + T T))) [COND - ((SETQ EXTRAS (COND - (BODYX (COND - (BODYY (COMPARELISTS BODYX BODYY LISTSTREAM) - NIL) - (T (printout LISTSTREAM "These are not on " FILEY) - BODYX))) - (BODYY (printout LISTSTREAM "These are not on " FILEX) - BODYY))) - (printout LISTSTREAM ":" T) - (for X in EXTRAS do (LVLPRINT X LISTSTREAM 2 3] - [COND - ((AND (OR BODYX BODYY) - (OR (EQ EXAMINE T) - (EQMEMB 'MISC EXAMINE))) - (IF (EQMEMB 2WINDOWS EXAMINE) - THEN (EDITE BODYX) - (EDITE BODYY) - ELSE (EDITE (LIST BODYX BODYY] + [BODYX (COND + (BODYY (COMPARELISTS BODYX BODYY COMPARESTREAM) + (\CS.EXAMINE BODYX BODYY)) + (T (printout COMPARESTREAM "These are not on File 2:" T) + (FOR X IN BODYX DO (LVLPRINT X COMPARESTREAM 2 3) + (\CS.EXAMINE X NIL T] + (BODYY (printout COMPARESTREAM "These are not on File 1:" T) + (FOR Y IN BODYY DO (LVLPRINT Y COMPARESTREAM 2 3) + (\CS.EXAMINE NIL Y T] (OR (ASSOC 'Other DIFFERENCES) (push DIFFERENCES (LIST 'Other '--]) (\CS.COMPARE.TYPES -(LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN LISTSTREAM) (DECLARE (USEDFREE FILEX FILEY EXAMINE)) (* ; "Edited 29-Dec-86 11:49 by jds") (* ;;; "Compare things using COMPAREFN. Deltas -> LISTSTREAM.") (COND ((AND (OR XTHING YTHING) (PROGN (SETQ XTHING (LDIFFERENCE XTHING (PROG1 YTHING (SETQ YTHING (LDIFFERENCE YTHING XTHING))))) (OR XTHING YTHING))) (LET (X Y RESULT NAME) (AND TITLE (printout LISTSTREAM T "---" TITLE ":" T T)) (for TAIL on XTHING do (SETQ NAME (CL:FUNCALL IDFN (SETQ X (CAR TAIL)))) (COND ((NOT (SETQ Y (find Y in YTHING suchthat (EQUAL (CL:FUNCALL IDFN Y) NAME)))) (printout LISTSTREAM |.P2| NAME " is not on " FILEY T) (COND ((OR (EQ EXAMINE T) (EQMEMB (QUOTE NEW) EXAMINE)) (EDITE X)))) (T (printout LISTSTREAM |.P2| NAME ": " T) (COND (COMPAREFN (CL:FUNCALL COMPAREFN X Y LISTSTREAM)) (T (COMPARELISTS X Y LISTSTREAM))) (TERPRI LISTSTREAM) (COND ((OR (EQ EXAMINE T) (EQMEMB (QUOTE OLD) EXAMINE)) (EDITE (LIST X Y)))) (RPLACA (FMEMB Y YTHING)))) (RPLACA TAIL) (push RESULT NAME)) (for Y in (LDIFFERENCE YTHING XTHING) do (printout LISTSTREAM |.P2| (SETQ NAME (CL:FUNCALL IDFN Y)) " is not on " FILEX T) (COND ((OR (EQ EXAMINE T) (EQMEMB (QUOTE NEW) EXAMINE)) (EDITE Y))) (push RESULT NAME)) RESULT)))) -) + [LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN) (* ; "Edited 9-Dec-2021 23:19 by rmk") + (* ; "Edited 1-Dec-2021 23:25 by rmk:") + (* ; "Edited 30-Nov-2021 23:07 by rmk:") + (* ; "Edited 27-Nov-2021 12:32 by rmk:") + (* ; "Edited 25-Nov-2021 13:29 by rmk:") + (* ; "Edited 29-Dec-86 11:49 by jds") + +(* ;;; "Compare things using COMPAREFN. Deltas -> COMPARESTREAM. Anything that passes the WHEN predicate has a difference somewhere, will produce some output. ") + + (DECLARE (USEDFREE CONTEXTSTREAM COMPARESTREAM)) + (LET (X Y RESULT NAME) + (CL:WHEN (AND (OR XTHING YTHING) + (PROGN (SETQ XTHING (CL:SET-DIFFERENCE XTHING + (PROG1 YTHING + (SETQ YTHING (CL:SET-DIFFERENCE + YTHING XTHING :TEST + (FUNCTION EQUALALL)))) + :TEST + (FUNCTION EQUALALL))) + (OR XTHING YTHING))) + DF + + (* ;; "We know we are going to have some output. Strings can go directly onto theCONTEXTSTREAM, and objects may then be inserted.") + + (AND TITLE (printout CONTEXTSTREAM T "---" TITLE ":" T T)) + (for TAIL on XTHING + do [SETQ NAME (CL:FUNCALL IDFN (SETQ X (CAR TAIL] + [COND + ([NOT (SETQ Y (find Y in YTHING suchthat (EQUAL (CL:FUNCALL IDFN Y) + NAME] + (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT + " is not on File 2" T T) + (\CS.EXAMINE X NIL T NAME)) + (T (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME ":" .FONT DEFAULTFONT T) + (COND + (COMPAREFN (CL:FUNCALL COMPAREFN X Y COMPARESTREAM)) + (T (COMPARELISTS X Y COMPARESTREAM))) + (\CS.EXAMINE X Y NIL NAME) + (RPLACA (FMEMB Y YTHING] + (RPLACA TAIL) + (push RESULT NAME)) + (for Y in (CL:SET-DIFFERENCE YTHING XTHING :TEST (FUNCTION EQUALALL)) + do (SETQ NAME (CL:FUNCALL IDFN Y)) + (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT + " is not on File 1" T T) + (\CS.EXAMINE Y NIL T NAME) + (push RESULT NAME)) + 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:") + (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.") + + (* ;; "I don't understand MISC: changed but otherwise unclassified. Does that mean just an unknown type?") + + (* ;; "The only call seemed to be from \CS.COMPARE.MASTERS, where EXTRAS is set to either BODYX or BODYY if the other one is NIL. It may be that that call only happens in the MISC case.") + + (CL:UNLESS NAME (SETQ NAME "from File")) + + (* ;; "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) + + (* ;; "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)) + + (* ;; "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) + ELSEIF (OR (LISTP X) + (LISTP Y)) + THEN (* ; + "No point in bringing up an editor on a non-list") + (IF ONLYONE + THEN (IF (OR (EQMEMB T EXAMINE) + (EQMEMB 'NEW EXAMINE)) + THEN (EDITE (OR X Y))) + ELSEIF (OR (EQMEMB T EXAMINE) + (EQMEMB 'OLD EXAMINE) + (EQMEMB 'MISCC)) + THEN (IF (EQMEMB '2WINDOWS EXAMINE) + THEN (EXAMINEDEFS X Y NAME TYPE) + ELSE (EDITE (LIST X Y]) + +(\CS.FIXFNS + [LAMBDA (BODY DW?) (* ; "Edited 29-Nov-2021 20:42 by rmk:") + (* ; "Edited 26-Nov-2021 13:34 by rmk:") + + (* ;; "RMK: Functions are special in that they are grouped under DEFINEQ and they may need dwimifying. We don't want to deal with these idiosyncracies below, so our strategy is to split each multi-fn defineq into a sequence of single-fn defineqs , one for each function, then let it fall through. After dwimifying, things should be standard.") + + (LET (DEFINEQS FNS (NOSPELLFLG T)) + (DECLARE (SPECVARS NOSPELLFLG)) + [SETQ DEFINEQS (for EXPR in BODY collect EXPR when (EQ (CAR EXPR) + 'DEFINEQ] + (SETQ BODY (CL:SET-DIFFERENCE BODY DEFINEQS)) (* ; + "Remove all the multiple function defineqs, so we can pack on the exploded forms") + [SETQ FNS (for DFQ in DEFINEQS join (FOR FN IN (CDR DFQ) + COLLECT + + (* ;; "FN is a single (NAME DEF) pair") + + `(DEFINEQ (,@FN] + (CL:WHEN DW? + (FOR FN IN FNS DO (DWIMIFY (CADADR FN) + T))) + (SETQ BODY (APPEND FNS BODY]) (\CS.SORT.DECLARES (LAMBDA (DECLS) (* bvm%: "15-Nov-85 18:58") (* ;;; "Sorts DECLS, a list of (DECLARE: --) expressions, into a set of declarations by tag, returning a list of entries of the form (tags . expressions)") (LET (RESULT) (DECLARE (SPECVARS RESULT)) (for DEC in DECLS do (\CS.SORT.DECLARE1 DEC DEFAULT.DECLARE.TAGS)) RESULT)) @@ -240,6 +409,24 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ ) (DEFINEQ +(\CS.ISFNFORM + [LAMBDA (X) (* ; "Edited 29-Nov-2021 20:34 by rmk:") + (* ; "Edited 26-Nov-2021 13:19 by rmk:") + (EQ 'DEFINEQ (CAR (LISTP X]) + +(\CS.COMPARE.FNS + [LAMBDA (DQX DQY STREAM) (* ; "Edited 29-Nov-2021 20:51 by rmk:") + + (* ;; "CADADR is the body") + + (COMPARELISTS (CADADR DQX) + (CADADR DQY) + STREAM]) + +(\CS.FNSID + [LAMBDA (DQX) (* ; "Edited 29-Nov-2021 20:50 by rmk:") + (CAR (CADR DQX]) + (\CS.ISVARFORM (LAMBDA (X) (* bvm%: "25-Sep-85 12:05") (SELECTQ (CAR X) ((RPAQ RPAQQ RPAQ?) T) NIL))) @@ -290,10 +477,142 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ (\CS.COMPARE.FPKGCOMS (LAMBDA (X Y STREAM) (* ; "Edited 29-Dec-86 12:16 by jds") (* * (PUTDEF (QUOTE name) (QUOTE FILEPKGCOMS) (QUOTE stuff))) (COMPARELISTS (CADR (CADDDR X)) (CADR (CADDDR Y)) STREAM)) ) + +(\CS.COMPARE.DEFINE-FILE-INFO + [LAMBDA (DFI1 DFI2) (* ; "Edited 19-Dec-2021 21:02 by rmk") + (AND (EQUAL (LISTGET :READTABLE DFI1) + (LISTGET :READTABLE DFI2)) + (EQUAL (LISTGET :PACKAGE DFI1) + (LISTGET :PACKAGE DFI2)) + (EQ (OR (LISTGET :BASE DFI1) + 10) + (OR (LISTGET :BASE DFI2) + 10)) + (EQ (OR (LISTGET :FORMAT DFI1) + *DEFAULT-EXTERNALFORMAT*) + (OR (LISTGET :FORMAT DFI2) + *DEFAULT-EXTERNALFORMAT*]) +) +(DEFINEQ + +(CSOBJ.CREATE + [LAMBDA (STRING COMPAREDATA ONLYONE) (* ; "Edited 4-Dec-2021 09:57 by rmk") + (* ; "Edited 1-Dec-2021 13:26 by rmk:") + (LET ((OBJ (IMAGEOBJCREATE STRING COMPARESOURCES-IMAGEFNS))) + (IMAGEOBJPROP OBJ 'COMPAREDATA COMPAREDATA) + (IMAGEOBJPROP OBJ 'ONLYONE ONLYONE) + OBJ]) + +(CSOBJ.DISPLAYFN + [LAMBDA (OBJ WINDOW) (* ; "Edited 4-Dec-2021 08:24 by rmk") + (* ; "Edited 1-Dec-2021 14:18 by rmk:") + (DSPFONT DEFAULTFONT WINDOW) + (FOR I C (FONTARRAY _ (FONTMAPARRAY)) + (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) FROM 1 + DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I)) + (EOL (TERPRI WINDOW)) + (NIL (RETURN)) + (IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR))) + THEN (DSPFONT (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1))) + WINDOW) + ELSE (PRINTCCODE C WINDOW]) + +(CSOBJ.IMAGEBOXFN + [LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 9-Dec-2021 23:02 by rmk") + (* ; "Edited 7-Dec-2021 10:50 by rmk") + (* ; "Edited 5-Dec-2021 23:52 by rmk") + (* ; "Edited 4-Dec-2021 08:24 by rmk") + (* ; "Edited 1-Dec-2021 13:27 by rmk:") + + (* ;; "Calculate the height of each line, and the width of the widest line.") + + (* ;; + "Probably ought to compute the max height per line, at every font change, add it at each EOL.") + + (SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT)) + (FOR I C (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (FONT _ (FONTCREATE DEFAULTFONT NIL NIL NIL IMAGESTREAM)) + (HEIGHT _ 0) + (LINELENGTH _ 0) + (MAXLINELENGTH _ 0) + (FONTARRAY _ (FONTMAPARRAY)) FROM 1 + DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I)) + (EOL (ADD HEIGHT (FONTPROP FONT 'HEIGHT)) + (CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH) + (SETQ MAXLINELENGTH LINELENGTH)) + (SETQ LINELENGTH 0)) + (NIL (* ; "end of string") + (CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH) + (SETQ MAXLINELENGTH LINELENGTH)) + (RETURN (CREATE IMAGEBOX + XSIZE _ MAXLINELENGTH + YSIZE _ HEIGHT + YDESC _ (DIFFERENCE HEIGHT (FONTPROP FONT 'HEIGHT)) + XKERN _ 0))) + (IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR))) + THEN (SETQ FONT (FONTCREATE (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1))) + NIL NIL NIL IMAGESTREAM)) + ELSE (ADD LINELENGTH (CHARWIDTH C FONT]) + +(CSOBJ.BUTTONEVENTINFN + [LAMBDA (OBJ WINDOW) (* ; "Edited 26-Dec-2021 16:28 by rmk") + (* ; "Edited 24-Dec-2021 14:09 by rmk") + (* ; "Edited 20-Dec-2021 11:01 by rmk") + (* ; "Edited 12-Dec-2021 21:30 by rmk") + (* ; "Edited 10-Dec-2021 10:21 by rmk") + (* ; "Edited 7-Dec-2021 17:49 by rmk") + (* ; "Edited 4-Dec-2021 20:05 by rmk") + (LET + [(COMPAREDATA (IMAGEOBJPROP OBJ 'COMPAREDATA] + (CL:WHEN (AND COMPAREDATA (MOUSESTATE LEFT) + (UNTILMOUSESTATE (NOT LEFT))) + [LET ((NAME (POP COMPAREDATA)) + (TYPE (POP COMPAREDATA)) + (DEF1 (POP COMPAREDATA)) + (DEF2 (POP COMPAREDATA)) + (TITLE1 (POP COMPAREDATA)) + (TITLE2 (CAR COMPAREDATA))) + + (* ;; "Move the cursor to just slightly below the current object, so that the edit windows are well aligned. We have to figure out the bottom of the current object, in screen coordinates.") + + [LET ((OBJREGION (OBJ.FIND.REGION WINDOW OBJ))) + (\CURSORPOSITION (IPLUS 20 LASTMOUSEX) + (IPLUS (IDIFFERENCE (FETCH (REGION BOTTOM) OF (OBJ.FIND.REGION WINDOW OBJ)) + (FETCH (REGION HEIGHT) + OBJREGION)) + (FETCH (REGION TOP) OF (WINDOWREGION WINDOW] + (IF (IMAGEOBJPROP OBJ 'ONLYONE) + THEN [SEDIT:SEDIT + (OR DEF1 DEF2) + `(:REGION ,(RELGETREGION 600 (CL:IF (ILESSP (COUNT (OR DEF1 DEF2)) + 100) + 150 + 400) + 'LEFT + 'TOP NIL NIL T] + ELSE (* ; "Spread the arguments") + (EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 + (RELGETREGION 800 (CL:IF (ILESSP (IMAX (COUNT DEF1) + (COUNT DEF2)) + 100) + 150 + 400) + 'LEFT + 'TOP NIL NIL T])]) + +(CSOBJ.COPYBUTTONEVENTINFN + [LAMBDA (OBJ WINDOW REGION) (* ; "Edited 3-Jan-2022 08:36 by rmk") + (CL:WHEN (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA)) + [COPYINSERT (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA])]) ) +(RPAQ? COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN NIL NIL NIL + 'CSOBJ.BUTTONEVENTINFN + 'CSOBJ.COPYBUTTONEVENTINFN)) + (RPAQQ COMPARESOURCETYPES - ((VARS \CS.ISVARFORM \CS.COMPARE.VARS) + ((FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID "FNS defined by DEFINEQ") + (VARS \CS.ISVARFORM \CS.COMPARE.VARS) (MACROS \CS.ISMACROFORM) (RECORDS \CS.ISRECFORM) (PROPS \CS.ISPROPFORM \CS.COMPARE.PROPS \CS.PROP.NAME "Properties") @@ -303,6 +622,60 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ (FILEPKGCOMS \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS CADADR))) (RPAQQ DEFAULT.DECLARE.TAGS (EVAL@LOAD DONTEVAL@COMPILE COPY NOTFIRST)) +(DEFINEQ + +(CSBROWSER + [LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION) (* ; "Edited 26-Dec-2021 21:06 by rmk") + (* ; "Edited 24-Dec-2021 22:48 by rmk") + (* ; "Edited 20-Dec-2021 09:55 by rmk") + (* ; "Edited 16-Dec-2021 12:38 by rmk") + (* ; "Edited 10-Dec-2021 12:03 by rmk") + + (* ;; "If 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.") + + (* ;; "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)) + (OR (INFILEP FILEX) + (SETQ FILEX (FINDFILE FILEX NIL DIRECTORIES)) + (ERROR "FILE NOT FOUND" FILEX)) + (OR (INFILEP FILEY) + (SETQ 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 NIL TITLE NIL T (FONTPROP + DEFAULTFONT + 'HEIGHT] + (WINDOWPROP WINDOW 'UNDERSCONTRUCTION T) + (GETPROMPTWINDOW WINDOW T) + (WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL) + (PROG1 (COMPARESOURCES FILEX FILEY '(T 2WINDOWS) + DW? WINDOW) + (OPENW WINDOW)))) + (TEDIT [LET ((TSTREAM (OPENTEXTSTREAM))) + (DSPFONT DEFAULTFONT TSTREAM) + (PROG1 (COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM) + [TEDIT TSTREAM NIL NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT + TITLE ,TITLE] + (CL:WHEN NIL + EXAMINE + (COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} + 'OUTPUT))))]) + (HELP]) +) + +(RPAQ? COMPARESOURCES-BROWSER-TYPE 'OBJECTWINDOW) + +(FILESLOAD (SYSLOAD) + OBJECTWINDOW EXAMINEDEFS REGIONMANAGER) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -314,14 +687,18 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ (GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS DEFAULT.DECLARE.TAGS) ) ) -(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020)) +(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1166 16557 (COMPARESOURCES 1176 . 5134) (\CS.COMPARE.MASTERS 5136 . 13057) ( -\CS.COMPARE.TYPES 13059 . 14308) (\CS.SORT.DECLARES 14310 . 14653) (\CS.SORT.DECLARE1 14655 . 16075) ( -\CS.FILTER.GARBAGE 16077 . 16555)) (16558 19286 (\CS.ISVARFORM 16568 . 16673) (\CS.COMPARE.VARS 16675 - . 17337) (\CS.ISMACROFORM 17339 . 17477) (\CS.ISRECFORM 17479 . 17572) (\CS.ISCOURIERFORM 17574 . -17674) (\CS.ISTEMPLATEFORM 17676 . 17774) (\CS.COMPARE.TEMPLATES 17776 . 18141) (\CS.ISPROPFORM 18143 - . 18298) (\CS.PROP.NAME 18300 . 18445) (\CS.COMPARE.PROPS 18447 . 18604) (\CS.ISADDVARFORM 18606 . -18699) (\CS.COMPARE.ADDVARS 18701 . 18866) (\CS.ISFPKGCOMFORM 18868 . 19075) (\CS.COMPARE.FPKGCOMS -19077 . 19284))))) + (FILEMAP (NIL (1920 27703 (COMPARESOURCES 1930 . 8443) (\CS.COMPARE.MASTERS 8445 . 16581) ( +\CS.COMPARE.TYPES 16583 . 19721) (\CS.EXAMINE 19723 . 23950) (\CS.FIXFNS 23952 . 25454) ( +\CS.SORT.DECLARES 25456 . 25799) (\CS.SORT.DECLARE1 25801 . 27221) (\CS.FILTER.GARBAGE 27223 . 27701)) + (27704 31684 (\CS.ISFNFORM 27714 . 27982) (\CS.COMPARE.FNS 27984 . 28226) (\CS.FNSID 28228 . 28372) ( +\CS.ISVARFORM 28374 . 28479) (\CS.COMPARE.VARS 28481 . 29143) (\CS.ISMACROFORM 29145 . 29283) ( +\CS.ISRECFORM 29285 . 29378) (\CS.ISCOURIERFORM 29380 . 29480) (\CS.ISTEMPLATEFORM 29482 . 29580) ( +\CS.COMPARE.TEMPLATES 29582 . 29947) (\CS.ISPROPFORM 29949 . 30104) (\CS.PROP.NAME 30106 . 30251) ( +\CS.COMPARE.PROPS 30253 . 30410) (\CS.ISADDVARFORM 30412 . 30505) (\CS.COMPARE.ADDVARS 30507 . 30672) +(\CS.ISFPKGCOMFORM 30674 . 30881) (\CS.COMPARE.FPKGCOMS 30883 . 31090) (\CS.COMPARE.DEFINE-FILE-INFO +31092 . 31682)) (31685 38243 (CSOBJ.CREATE 31695 . 32108) (CSOBJ.DISPLAYFN 32110 . 32863) ( +CSOBJ.IMAGEBOXFN 32865 . 35026) (CSOBJ.BUTTONEVENTINFN 35028 . 37993) (CSOBJ.COPYBUTTONEVENTINFN 37995 + . 38241)) (39107 42184 (CSBROWSER 39117 . 42182))))) STOP diff --git a/lispusers/COMPARESOURCES.LCOM b/lispusers/COMPARESOURCES.LCOM index 0c2890bce87d339db72e30a8870427616df9a60f..8b8d106d1524c54dc80e773aba05d15e3d5789c8 100644 GIT binary patch literal 17008 zcmb_keQaCTb>}1PI96g+l3mwP4d;e%9Vx2>zQ<3gUBV}lGM_~9NhD=SjuXW;l}i4Q z0^7kF358#ZiMhqdS*PMZPy zV~F=V=iK-B9z`eVP`4uQ=ehTubM866d+udMilu3%RvMdjDy1=}Htnhtb9Q0YK3!6A zr`9ahD^6oBu1?fTcCl$sRl16&>_$nMiP65k5u#8)vu3HN;wm{dbADsYN?4Xk*NctW-}v~#_0?L;JMcKsuhs?cz!X2z!$noYM>I#a4OvGSTOEx2>b-8Ji&?es#WqJm?LkB`Sy z>--I@rmx4~mK7g;UtIYmazUl6OeUiy3uU`@y3`nJx@u&))=+)F;DSfh$QirdP+>+R z*BDikbM?|0$6aWQ6(MUZ-O7#?S1*#RO=X&s>C9vbvi_xsHa*%Go`#w%=K4nFl$BJE z%+;Z!W2A+TD3n<05mMAnfhh&7x!fXwKBC{0HBALYC>5Fw$|Mx6sNhzRnNY=2p#mja zMkeQFmXOJ+Qtb?tW+*`=X*J~*m#HYlDJn~oY`Rc}Qw`Pf(s-u2-Ie`oJ=)ptO2ytoWrpY3 zmaod7dDvC4T`(f@b2mP;GEi{`c+7LvPL*L$)lk(P;;JWVyZ5>My9b!j_t3;wPJBP& zp7?$gfBWcfaNmb2)xwN(Xg@E@9pEuvcZc}Y1K_HwsBDy5#XV;8Ms@y(K3Yimsd`;-IKeA-BWABD<@at zZC6EC)b=|+aZjCEIl1+-_iXsjorV=&%grMONcE(8=RU9TO5CV&>y?vjH*Qe#c+@?~ z|Bv&`_~U-&@X2;}N&Ju8lRFn>jqSjyrJ;N3DeA}cxsp@ET3Le4H3c^=%sk0o0pSTR zF1bg!V&!PN=pJQaTOStoeUYhg?WfBxvR1TbIlC+Sb09J@k(yAjw52*c>_o~^TNn=^U@x4LI|L%4IuLb6LwDA(u%h zG=M!-xpY>MT{TrMmG)9ekhACJO0}Y;a#l_iDwB;;bF5?JR1Wr2x@9MF9<6LH-J@wX zlkHWSv{b`xG~9y9gF*jWx*#>8v-!bT;9QmBtcubvo&#k`ta=XK13*U?Apx z8gq9SnsW=yF)_&W<nfeFJo2fW)nP#@J;Cg4xb^0^_7n}3N}Ih( zQ^}s9NF{QrYR{I&$Yqu4WAG+U-K|vtM^tj67vGYZUW`vdIkf1K$+Vw@kc1n_&XO45 zC4E6zBq)1ISw3T}oF_yJV{u*DqhqCg)-W9_<+sIH+}8Bl`eT^TfEw@!bkBtDc}Zvh zsVDf1sgIww>r(_d&2&PYtDYgJr%WgxafU>pOwzv|?STRO_87d=9(w_}Ryt2);8(Hsu#%HWj$jN~w0bSys^hKrWRPDS<#`Y|dp+9M&C`GT*Zauo1TFBBtan5}@cn zfjOYWi8SeZ6&oG00)Td!m?^w{Y1&?>_zE`Ov`=FPn;8#|0Lf+{u+sd3U9o{qv)Qzo zY?i>hYz7#?FUEqTIFo{j5L|=4nFI~NCCJ0buaEIR6eW{t zWNd6y?7fVp2RPG;K%SN2FB6uKwiy24`AOBEWSKC8kODfu4{P^HQ2dc5%`wp|8-8Nn^o@^!a04kB4+Mh?i zA7MHVukS8xHms&-tP_x;Ck6TGV~pL&>V1wrQlE8<3r!hJKU2$*!5#r zyWCwCZ9C-}7xIL5V>Ncd?f?VHHFuyh1p#4?|3Pgrb@bfsaBX&YF*STK)jk~MQSV%; zMxWTelbdBiTR#EVaR+XHdF5E!Jqk#43^?ZK%8|A^6kQqGzEgIOomx4{kceBUwtE7t z6k44C(ghY?8Q#8=bk(Vq6I(x{CErtv8n5OD?Loat<2kGn%kC7s@CzG&t zym@%vc|hX_Y^dE2^Y&s+h~-61+uO#+M6BC)4jL=*%QO8uN8I>IPocfjVxhGm+xKcY z8)(@w7AJ4N4ETKc4ZzsnxeM)|c6ubd9;eXb6nc!e-H$?r#-TzVU3sMKjzm{Rw%_@I zJAP{AqnHizVlk)rof9GCw-o8tpc`Mz;lvf=jRN?*w$2P7)&94wN9~=D_3Uj+?+08f z*n7>j0=-!gpg+4uIx4X?EL#V7)=Z>R?8CjYtC@f|s+_41N`bqlP?3f)W&$olz{|u0 zP!}A(*J%Ql-|sV#@xk8&z=`z80{oq;!Sod@mDSM8>zxHY(ukN3)+!4atq08}vR*PX zF`a0enDZs8C9j#ua7GYM+3#$u;3TX@8jCf@?m6d=ms7w~!!UB0UcJRua=rwsW+p84# zyI!igXG#i^)+vCvphw*kZ3LJRT(?AVDi7pQ257-d05Oh@K{w#P-5YDG*O0_0l1!&^ z9gLI4>ICDY;lh0AleRoWl*(pQ!7kQS3XJ#bQ)n#RQqY7>F|d#nTS{D%<+8Ila3xmg{|qI>;g+2> z8K&*n$JdUvEBKq889wV_tdn*(H@B9^fgNyZPOtTt#rs^J+wU#VAMYD8@K33fm?F&>J9ZBMpNfnk#=778d6`5X!J_)-U^lM3YypU(IV0iVI z76nl{1TCEMWC|8ec`~L&J|@rv$IT#h3;OF3!=XtSmM%LJnwhlL`Wy{F!Sv4r75HJD6RO`ixorO*Z|p|mq56GWzr zO%U5EI;FX_$}%pN#Qxxuj1_E%AGOD^OP`P%bmZD&dwf-p*c95NyRHVNafqzgQ>6;x z88};V62{tCG7d!c7rxFL^1?msh23At$G&dI$U;Tlo&w~(J-?1%aO7X-TQTJRs=Ypc z9N({PNB+hS8%Ms_9vp}?7&ZcSTasG3dWQk!l|#38j+8H7eTTR4?g1WZ=~HEHULU@= zuif-|x{_LI1-d>|zWUC)(kT=H%KOg%IMTl<9)-vbtPQYry?yI`9+C$cn3u9|&c|*E z>YP7*>%RPMOb)37^R4yUHy>)nUZQp0{7|6vE$)ccujs;8=3_e^iQmiHg(BO)fxL~G z$XJn)BmzAY$SA2Kfeg8WfnR7qsi2x%W5I88sMbPwPp;kMRun;joN6pgY0WXwqt+~A zbJYuOv4qf<8O|fBhplnfK&6RjX&_K(LiNL=!8~8mAx6C+Vc+2S2`5k?fds)$^OV6<+{Rp~QlStB zVFHPwNbF=(MRp19MuakfItA3&_9g#|{{98yV+O#xKSLnsme3x~Bm9-~Kr*{QJ@88(U^ zB1#k)jz%KJpfd8GYZ=R(dlXvO?J`f49a506IeKUWHd^B~?+IJX zqv#6e1Ak^ypbYzEp^ghz0f~$tN!X~YfDd}IY)fVSFqg^wMkJb#LiFY3*zUfy0psyj z4Ce8_v@!gG;J2+4VrJwf^>eej_9dx(TtWxv_9Kxx+qW;;vrcpwcUs$#-}X9qakGugI=|s&1a=n-}9cckH0)yvDu1##)dxf+%81hYiGC8hBSS7 zRu-^za%T6qy}&Kb?hY-$@}1QkF7~x&W@ne&e(^papE}!iZqP^rr=iG+E9Zt1Wor2UYoE$qLX$xR$+NrY^!>+ivmf;M}PkzRP z1(ISugq^V~`HE{7VL-6Y3Db8Vr=KbvI{E6z{RpkarzsT*JgI_hsvG(PC2@?^{v@cuWtQMq~=r(jo`Y4u4Ae; z-cC?JW^TFeoG#O?SBE|D4IM?mVUjxN=SBX?oW?X>EY+)G7A(%L#7t!;56{=rq_}lw zG$Q5J&S9XhZzczJ?_;GX!x;`ePo3U>)4^!enR$DsoY$fh1N@szZ;A~SV?jyUcWpE! z0M41|2n{EdpwwV4I>#AAiuADv20*8vnmWZ7CUl1);)V}{`C?`gq;qOcQ!=n7S`gTz zQiNkTz(KUvL2`K}RHp!<>|$1D8N}?9t;Ke-YQ{G^%!??)Fj^6;hVZulvY3 z5B5KW%E)m~Tj&ZJROax1T+m|SxD@9!Zx^ofHOFbxONCzJktB?Km@@1i7=-Jrf?F?g zv?oBPfR}qtsi&fATH>1YEXkH~2TbjB-L3{GHA_H^c(wH|)9NCHXA52@pN_XDyb6sg z@45}9uwb$Uumo@Kn0YdUo>e^ArcL4HK1dvwed6zwyzQ$YoBWRLptxyJD=|Olj;I3s z2q*kG6La0UUh6(A;*fRUI*2JmqieT)UV0+-DG{A5(1KTM&0+F4fMPT;|1-9U# zf*#vMW4QBOS*Fb=D1kpdFZPAI>_v9;}uwoH;fz$0uO?(cQigMA9Z@1i}qo62a|B zeus=VB9Z`hnDkyTQ%J~5LzI*BM1-G%B68Eo@X051e%79m-$bxK3n1uy^{`G{daF!SuT$U(~b7@A93RE|zd*!A2ICuZ7PbchS(@t}q1 zqFNvkrVm%)&9H+=Xo7*I6=5?f_A*Y&dUZgYd~nk9C;v~uOuJsU=}`k7q~d?3(hoxD z2!$abdA|PWM8hLb?SrtJa*ViqFBC8$!CP7D;nk~S*8z4g7w2;!>bgPR2om;g2x8?b*k@8LG8gu4L*_JTnU z#B+7566_3C;1;#(DL(DsI0#uYBWm7V-<^ z53q+26kBwPc#37>$V0O6LTD6rgQQIyb%GMbeJ!=ptOSk<W;>NSN@Jw80Bvu{IzoD{lw`YSI160lm@WZB@N=8h410FoNQAL4_bWJq4pA0_XBZ zh|1`J*EE&j2EuzOq%Xp7%PWTsZF{;mCxRMjn3QNhw1Z}>%vV$ou~gen(f+)$???P9 z`2KL&G6KFwo&B-hJ}KY&cb50g&&vi5aeMv-?>T5oENal`yK;mnzo|>2hI@p(&<|z1 zpN$$blzsE+oj2cP1w0&>UJoZ~JTzTpF4dZvYjz88~>xT}| zBA{nXX`oWAx&7{dJG2o~=*#`we*Su`HT%|A+OzLMMQ9SQ7W5!Nr<;G9F)3UMw3LimcAfxcK= zJ*bICS};O*ELkg#du8xt-DS9lJvV)}L=FSjF6XB3JBQPCj9bLRR8r$Aezbwdf%K~l z?4NJ}6f`(7Xtb4smXhy5u((p1rbwbLz*Q9&m@AXonD)JCiBooI;1nVEWf>=*L^`o z&^>T4FGe7^2YXF>s_ri0mmHpFz|m5hXEN^Eo05C=uBqvzE3=V*@*(#+bg3=(I&AU1 zmw$v01HblwGe$hh!7;1p;z&jJNg?Nqygxw?ljzxvv2CH7B(3tW9gDGjk$dE&-^~Z| zYYj#x7b34PaFv~|-S^E0Y_B>h)#A0=()*P>cj4`+dxVO(wy--a8#?frKg7R};QC^Z zdRyxGb_OVFK?gu~8WM(D!}WEODg1Sxv>Y@Hc^@cGl^ltqOVJvyFK_c`Q~Jjj4l71m zADVXxYzYUAXj5EO-aa!mBaU)rO-5hm`FB1j)ItAvlI;N|K#B%u##cj001~lma2ah7$v2;$0TC#ZCiZI1OQ#4GFBXA*hI?~lST@C|< zutvBQBC2Ff#LX@u5I|2P_*D?y026*Dy<;C_V(*3uU?WTQx?5K;2Xy3@$?!Qw0i;PC zzpxJ1VIfinpyt2ThAs8pYQySDJ@BkwPZyy~8XGZ5mrMN6BiVtxo{|fH>8-nPgO#1^ zI~@SXQh}3ntIrl2@_?Dd?;|K2T3;y8QytL=o|8$E&3=T5hs3A zz#TvdT*3`H2zQlXmI(DUo69s2e$N-45pwjPOTt@wtJDbpOfg)+Hwn7P|NRQxE_h`e zRpM6O^*q1c);ELQ_YjR9HxtwbE5R|r`w0Sm`AFels_>)B!7-^)M&Zz|wDUp~!G;|1 zlj=^KPV!z9O>#Q4#SsLij2}M)gIYnNUWGS7+Tz@i8c{~VIKeJds;3+Zrv%%0!4WFM zsska7U@JfV5PBou9WDR^A)kh@F?6DqOy>+Ld3LUHj{1N6O4Sdi(x8Fg1pDW1HNpcx zZ2AZ>(kF42uGwJP!Sc?mMipWt{$Hq37bx*b=ymkKEu-|W*Kcb@m31^Fd=(nzr}o_- z(s$Rjhy1&qanL039B2bWN{!_PUlxUJRsaL{X=s99nIYm(r|Ea@WkPpR{>|2i1brKL zkU;A~kJA-*%C7L12+2v7-Pau{4#uQ=@&qdoWAa#+_k0(*2gU0vA?6k=?-o1V<*@8S zt?njwt?hf^sz2TN@N{MQV*B*oll!dDw$tVaDvZ0NI2oY8vr5^1^KmSM*xRQq*WD}< znz1$V42W-T-d}&u4D2% zLS8F=s2jIit@Ru9o>bk~RQUD(4W`s>1HHU&2R&k51^xWpF5>AgrlE~3rb+h*9v1>8 z7;R{0=m@Om2j0sf3jMx-oO`LQ8tL5C(q;+m9so@67*~+0gy)j MX#gwr0H@cdHvj+t literal 10362 zcmb_iYit`=cIHs_IxlHONmdj^wQmX6rHn|+8NSuj%MnRgBayrchcYGS!N{f(DRv}7 zvfB-c0>yTL7T7jv3#?-VyV->c1YKaekYp2Rk`~1FUr?aM0tH&MzYFY-MWMDSP_#hY z@7%|5Mxx{Wv4%BsALpKX?z!il^W8Iy6-#qYwKO&7luJ`ib&j($OLk$=zEomSr&=%7 z%8t7fWoK$7yI8kp%SW1LZMVeC_+)>K7!*KNFBMsorKa5Vn^RWYiZe4e6Srm(@hFQ$ zuWi45bMwY}i*0X#sQ-70?&9yhxV*c*vwQLS+RYnlTNlgQ*Vb-ae0#lhWBr}Pbn4=b z&E1>Vws+P=;kKYG@XC^1E4h5RRw%jCzmb>(uiTV!>gg6y3C&Q#{?)Hrv%zbBf`}Qs7U&{3Kbd(dq-&%_hIv~95_`-3~hW{TPV*b*}{?7~tF#x+IObAh2H%`T9EbsJK$ zL0FuiNMek%ORA<>u~aC-2v$)^>BizBYo|@Z|;Y_%SVS^bt+<})dgS2 zkI?bjLREBJS!_R5Zl8LBWcms{nnRz3_|Ruz{GFh`$cc!vP$)h_eVvL};>T6-`o!@w z{XH<1Q~74PJ1oT-o);t9r^HGIjg}z_haWb_JAAA?%*Qvzn`6z<4j&0ONA@4ueEfWK zZ0|oGOK5fp9Wnd;5d*Axb6wTM%~4}PP&daqeAFQF(J&tq|3`I)e2@M)A3Io6I`(g) zSO6b?o%A9|MW-l@_t;m(fsYDB@G1hRYHukQ{GKW_l_k z0g)^AVrhz;RH-%v&*Id0wNk3qSpthVzDO&R>D8J_Xc?_!+AAis_AD!-RAX5tyHu)^ z%Mn4@ifbBj_)_a8bf!v}O_ze>%#=riwJ92JJ`?ki7BCI=bo!EAo29^Sn%Kn3WparK z3mK@`E|MguNMkudpG|q>*?5;aW9k*AQ)+5xUCNL|kaen(Ya*rTEKk_1qRV+?h^%Rd z3%Fu0m%W{wuG^PfmIlmFTZ^!kgo*lUVvqjuO3BUyt8#a#R4&hzFQHk}5^vB}mheuCSrPZ0 zIcg@O0_vogzfzxfsx-`EtGbBDU3Ezq1n#Q4BI0`>+*>N#OMD=eM3`ZP%`v#Ju3K`c z0l-3m0#v-^k+7(znALz?^M)Wz3#72Lc!`!MS~8+#l}NLqh|M^8iJc0ai2TVD`H1-p zAL?tL<|9KZ`FY{muZAM=r|0*6(-)X1gtUkF7{bnIbELzE!p)(*zvE-)o1=UG)iO}) z`+$$Mr}&WQ5BIfyj!?N`EAGDv?yI&8URT55?(9j7(H!AJ&+Yy6aWf%)9+~N8aHiGy zd#wXUM5lsSL#H5uPiOYS&4|%IABlXGPxQ6thKJ{!4H4DEqtGwlz^mUCwaR!SKYlIW zX@ES!Szr6b;n&Gd_lF|!ME>yJ ze&{0}{Ym(&V9k2VL|zrv$>p~KiGO!V-#ISV)0{=-3u zqxOD={ov;ST*S5y2e*Cyp(}TTfXkOqT~t)G&IpeJJLV(yv;4f6(%?Ksi|saSpy82= z4db8D9^_F&Y=l%gc!mvnpi5#dZ?O}gY^wE=Cja^Pny=gWmaSDQ-{Jg6tp^|ve@z+B zaeI2J6&V`$tt0fW5c_Hf3pvZv5|REN&kkJ;^Y~kb-{IC))4Z*SH}*sSEq81G;k415zFr8{)NAIzBvPF{Q7MyD5d20p0^*21-iy`r*mF(`05} z(dH$Y#P;AU@9^M~s%!(s(_~XWG-$7iI8?zG!=Nog4*~1^A@k1(2 z+?5xij{U8?y)iy6y@;gFkG4ldNj%Ug+yzB3itMGLL$Ny%M_`ggD~UVa6iChiet5;W9t@Bm zB&jY}ST?6YQ8p{N*F`f$MhUdDK)h0b3+a|S`#p9PR1C4ZugDhX@vMh|-h=yrK3F08@-H3FaLW z07h}F5qQr`B;#yq3g(3H&Tnn3@1O|ws%T|$tm3!@SXDYBOBtA8!7kQV5}Pz5GHebl ze5y*&Gno{ahO%yQQxX8IlB$Fh$SSj75rNc+B(pLCzyM)Ec)NzTyxAyHoy?N(&xF0p z)ZR-3HB^z%t4VhWLZz^Apvn5i`tCYg+gTT|Qsm`K6EpPc$l)FoWyq+#y}os87rC$; zE(FN@tuS+vWwSuOUMHKnNcc6INp=ZvLnCNhLLzQ`cXxApYZp=^aioBN*WcLOLR#(W zJE&N=e-Po^?X7FK1Q|nO?YNn#d{RcCK`cCn0|Yo&x1F+pgF@c~29YkrtpRNku*Ly3 z9VCtdFfhrS;#^h0L#0wtgQsxnxcpEGNMTCK0V$+82Y}kegLGY?B+(qMN*dl7KY5}r z^p$-3DVyS%@mG1fl~*yYqhj7ivg>=1eBbOrrX>BG@U105(V10mf14sxul#=KKUxvv zL@{EVEE_A=D+3hLBd4l;?aLcOtM}hn?7^Zjq#6~I#vq*Y*~XyosfYJZHwOC<=-!ha zcW?sb-Ob2-uJ8F*Y@u8nnSTJyg%=hZuAuf{s3VMJj`Ub+aMocx z>-&5_Zh@ZYqXh((Bu>8!CW)>WPULiKNGRuRvINd4`5Oz@fnXLRfqSZCVd0{z-4nT9 znbH>Kh;!{l56io>TbNxkwc=V16P`~op%bfooHxYuhQOaFx@Nk;~z?S;0kZ@4s zP|#UM3{%3wZ={r~nq)@eq!9||!x8(${AyqO#KxfUa;xvp_Cr5w$@BSsN4)pW$m(~* z>)l1wdq?)ZEO9l4{hR2QH<%CXMJK$9#3gPzdVpqkU9!6)UVE<|?JftpFCOil3Ur^< z-AbB2lD!Y)72y?o;_hPE7T(|w?Zu68?G`t#?4=AzdUsJSVDH>Qd%|886j$0q%fN$I z)PQSGbru#E!sE|%obdh^{}hT@l+#q$%*v#6won6w;I@(Vc^OL!2@Q977CVBR7NF4* zcNtD|rBs>4uG7KnCYCG&`8lUX2n3mvDo3(TRB$}K3MK1gvx(?fx@?#8Wp3kK02dTF zKCg9KVCqL&ka_a;r!uleu0rJEQm}8$!fQ<8)5Wnya$Gc#M@2x3FRcOrLv|%XXr>OQJm&7i^=E- z3|YsKaVK$xnl9?Q7&s~wdP!!N21rKE5f1j z0~B(K@E$Zkef;!R=D3&b+8nP{q-PL|TA`JkMH<7%8|s|iA6A9GQ11tQn}bpkIM>>e z{nFRz`xq5oLIRB5-V`cqOk*Nf`yV8}pmTwAR;cjE6yV?XQ3|kS*v8@apdK54Di!GI z^DNpTMrgiuFx=Wa{83`C{j^ZwJc9DjH)+r>P8tb^orTX2=JRTYq`Uf-;5RFdwE#D= zXg`u@Rz&7OXQ7+6LMye9sQpC4pF%W7saoB}2OFlpI@YhAY=VO{p;((I*Wj;km5$Q{G=N48*qXu&K9bcCY`A8x zfN=&m(_IO_0>B7fD~h{_k52)g;hj=XLsz_{BUe(A=Me)S+NGLZ@o}n`DobVL+`mMu zBdqXcNe}Y)=rf@^)WLY>Jn4_13qk(M@XHR&m&;2_AtO!}@>qboO zGerf-6A>(Me^paGZVfc8RJ2mHU)e{Umr`~N=d@m5C1r_Rm(rU0wG3)5gp|JNco&O_ zpN|AP0@)S)i<#rMacc2HE4N<^^f$?TMKI(~%3rL|=x)UHa~J+rc6Ys`&}P?($!@FNYWPMJV!mdKZf*_VG^d?%YG!gm|T%u zKPEkH;zqu`;pM=^iQ zCW;JR)NZvlMG^`>uVVN$+AYE9sQu`=kSbs`x(8cg7m*W$7{LgrwcxW}(D;0ZGEu)Z z1!mCZq$lWZP_GSSu`VV*c2y9-Uf*7bj}97Y5NX{7VQlaG+4%s8#ptR?X;DQftFS-P|v27cnwXpuP{H$$&YY2suQoML8AB z?|_R}M(rlFsK+66!EVyv0HuVDC(IVTH>2;huC6Z*$N@G>W$SJq?g13{*Py(;UwgFJ^ zJ^QH_8~~0;xjEq)SnwPc2+#FUz2mtq<1DZlG&q(-5VsPqZp^V1J-?vOynw1{LWG4Y zjn0Zfs9VL-E;dy?qkg9@8}Om>WG<0$YFbS`@oxgu&q#$-3U zG(^ZvIg`06Co^Y~^RF2bF^{nv;vHGZ+(tCyVdi=g|D4H9;+^19917&m?3`xEOIej+ z$gKqPvYk~7hCDinf6uN?5i(44a*>ShTD3}Pd%a9_d13a)XiD*=dVglAHgXn^3$hA( zTB-K|ZfPT`$)@}|XXJ+Qq~S&uwNeBd5S5<<&Z~otdytZr-{9Jmwxb?SOA-$Gd+tC# Yr@|_CNWPjkdavilQlrzWbXf%1MtRbWE
SK=L1uGy<~KCtr}`V)U4t zF6YjuGkK$&Hc<4woFTss0}wEtU|=Q4|FE%3%8W}fs&tLoEUAhJb^(GQ<5936mc$YZEDS7vr52&IkU$9{ zRZ_04HvMrYndZTh*6uj1r}en;Oq!R>1ftBD$aaF6KDq5vXFM$(x0z|&c9OOabf*vP zOWp6By8sp-<>VopA@=V5|2gM7-#K^3GUl9BFem0L+nlfpbB;J&G-h+gyeYy~!8J>^ zRW63b>5^$=TqAAwWT%a?DYWQ#fBzWuFpFxgnGxYwbRtu|JfTN*P3YQ;uFpiZuow$p z-nwyfqh9sI)}{!H{@==!bHDxc;!bsY=lu2coAve0^Y+%|_4@f6Rj*#X9g9q!zj1p) zzMQXb?A&~ot5PrP+tpju=Wj(mr$wXVBCJn$2Gpi!qVbvd6b87oU2P9peg5Y5&QmjD z*2x!*lIfZ&ZiIfE^n%#HbmkUqTLk-wL?U6~t>40QkLZ6g79RhpR{gVDrHCh|^=UCP zn>7maW_iMO#MoS+Ec%aF(72c>mdqu~Su9Uva3om3RA7T9XC@OflkuO?2}~!)gL4ow znPmT%Eym)4WWqMmrd<{>Q8MQ(ryz8ZHOkqDyIO?ga1C8V`KgVMi@xX8zP{t>t9|%8 zxck{wVl?gfS)chPCoUcP!!4?l?x){}>8F|6;1@$a22~~dlJ#w_l`?80BV5?5U8`mB zGBSdM#ffw+^T=`PV4!bI)24)#_ct^$n_VpA$|5-}%u>lIiNqA^LJVozO}D~i}xmTn7)W$f)L z_Es4bN{Y9T_haR?EN>qFtnQr)7J0j;0%hKx^UIqLS^ON}-`&5HZ_UQLePhYEn6;g< zxh$p(Jq{m2tD!IbF<`jAGW8S=!aWrjh_a zz2>YHVWGsYM7zw5#2gNJIlZ;*Rkx8&2w<$SXuESx!5tThbzJRJ1N*ED8pjN8}wLf~vexd#@pFID3iV82O9(SDmGx^}Yzr<<&2~6`9&N#ZvSI$3?vur%s z^FG7_9{4@*dLH4q@o=ji&p#(62{S*~eazw(xy_G19{D+%XHyo+Y%b$$3o0AavDs1$ zG8vYbSag~s1L=IRr3*1ANO94BlX8`WQgFK#Fio*Qbv4ry2_cQzG6YfcwOixtQG-07bhr{)a%_@=_a$)S(uWqm3tc8U(9S3o^Tzhu&`p!8~Ti>a{I$yet zJPj}%-rB6+7T(5{E7k4l<}J#MiST;8jucKZEOu&J&uwg872$ql0ArC)!-}md)B|=S zJS(|{AaW5FlW1P7SJ!u{V&`V{^2U|hVqI)kuWo?9T-n+dw`x@(*~rEYvg9PYA;yOu z!f34pG&(REAOkof@TjiG%1+NMW>9U#O#ewU!Q776=!uBd?E-QtGhy~hQxsE z0zbJT|1<*{yz1?q;o|$$t&su5B=gP^Fnl^8if++fEQ{$D_+eg_OEw(4+CuQDWDt{a z=!X$}a?0-#cGB+>QZ41P-DPaL-6fPH0P|4q!(Eb;x*2P3&McXQSyJZYm#asw-X9xlQ_O z2BYZ zPL98O(&$XSlWGhfnT?6a*0PlAxA9#Eh48V=$9ElC*@NZrZU`m-IV?1~?pyU1v(WH< zh;L{eaVPqrVfdDCXh7wb+-s2PfRt*GZ9Yk$2r+^H#=}9O3~5Guu>#Wg1Stkh@X1h& zx@eOj9b>V1B5MVC))Qn#4!JH8S9H)(Qd`1z7>NMy)?+PJqJ!H83!=W60;WQTEf=I# zOLmhd4HPv%pJ2Zd68K}9u+2H(KD1L>0NN&O7beLClhZBBzyz#K$FSvr4hi=)V8Ix< zmrlW66)u_^OQ!20IWAzT#?p@KI(adnj|1pLl+}1n{L^(+dhcK znh6E<&yZY<6ho>4AkC`Ey_8iy`Tkqi7e4y>!tY(b#4s6U!$JR#IrNj-n4LeE^w1RZ`LjVV_^czyD_Jok{OK zCTkmMkX_dG0l&2IqgLV{`^G?}=4`9T^GGBEY2beso5L=*D}t4@(?pYcRU8{T3Hde3 zF7;amS#PI#&pTV-^PScX{4@?NHzALf6YSD{16=nwh&`icN_wn@d<=$ED_i6BFJw0) z<_$h^JQv!Vf6S`!=1JUNm7u$3N$0jFlY5pmQbu~#TF6MGA5bnTS?=XmmFow)r}8R2 zK5YZ~^QwBXi5~^&jg!rsdZF>=$|HLemlfUpRv}kZr6=2S0!4YVG;c;0 zVfG3Ia~8tha-64w&h-6jf&Cy>VU`d|0t$CH1v}zK#4jP0BZ<GaC1Z8GpA|8v zfk$*1ppgY5Z;G-tGjn#aK$^b z(=JYSC_j|??gODdWr=9Q;4{Y=KC-Og{KK+(5z4##=*ZucX+RFoZ9{2L6_KsNtm|1qXx%BqJ-ov@t z$lATeKj%i@Y5+B~crvi>Qkdbg&`Qa3cLADOlH{CTIp_%s=$G;G&Lc)@7H%fkac|~wi4NA-ss$-I9a8$#GK?u79wQO|Jj8zclMg6lZDKqc4YRiHp)eatfE9ws2SE@+_m*_c`NjyX*Cx-0~Xd*VPXyL)n}&bd6tY z-tyXw|C5%ra>5z%>ZkYZPSyR2Xx2SPeDsDRUZ{Kfm0`j;s+75{hBlCmyD{fIOja|jjy2ORcF*w|FTvaIf+qKn!q{r&d0y=*tNRq zEqs4}dCdHR6^d}uH9`*-?YbkZj(1IriRxYPGR z&3Tl^syy1PIRi2|(7e<4Bc(Fq?MCH_p57}uGhV%)i=81ymx-snH;>mwYJr_iHl4)Y zDJNMQsU#}#rV~{w(Waw2Bkxu8=ADm!-ARsC63xbsotcrs$oCrGQYu+*ccSpPT3Kj1 zS&Sh0lr!u|B3W}5yq9Vtff44KP6i{)VT4R2-E_{YmGey}MI)pz!Wn07w349_2AoH+ z=-G2l0gHZ7sg#OGEMxprO{|7>`$gYu8jQC?@{b2deI zImeN)QD>OnmdQvS^;bFNd9&Ol*W;g!nhc^2D3z6_Q`#MMR$g;f6sJU#4l;1}38(bB z15PkfaZ#=+P7$ZRvUk!c(n^a>r=V5}Sdm(>vFg*#(nw_q6=cQ62VmduWf10EmZWcr zFfpKelKsQui;0WG{eXlC7~W30lRpU`kGQtxFgZB;=NWQR$A;Q~A>lDCrU1K&22RYG7YOu?JA+*Uu^U?s{Fz;5uzZoFr z8)$*idgg?yk6?XV8I>2)GKcPr3b?&1!R62c*#J2|8)1vNbYz~lrtC)K9RsY~6sFuE zl6fnWvCZ@%{Ne%}{wY|oP9b@Yogzf@+7O9|tPF{*h(wYus>qHcrleVraafT6q3)n^ zj6A8XsBVwNWop&(j^L9PGGs-yKo?Qk4czUF!)##Zi2jrj>{`NwTS$7?*9P@t>FoO# zylWr531CrDhJSmo>o#-91i<`nGgV`e&#`B|=G7lLc(rLG0``NAi;WNJ;^6L+3-yN& z?w+<5{_T2wfH`9C^Iq*@qrtr#>@N5n|HTm1E9l~7EbpAa2>#(M|Q zZ~?<55I=f?3)2JlAl*H3kd8@-TY_ZiVBu0ipreSc8EFtK$)9zi@AxnQ+!;}UVM~}bk;Z2b%SI_vj?CHf;3SC4OTRWk)P{l{ zzkvvgO4q4huMMP>6++#6DNo%UZd$m(QeQ*xMX~VDxc!Zkda1AR4~QmFKnX?o-A7G4 z>7Odf9Ao#>S(VBaE~R{=&@cRTi+>w`ghR%i^fL$x9`YIQ>t?rB=CiAaEf?`LA~(w5 zK%ZR1cQDTDP0UbLzsYk{)mM1pANEdMPN?xWeKdnZvmmPx0UvkU5i5kLj1_F7KWqj7 zpt79f_EWl*yiFGZ>D5%@7d_>joNfHazpq_eu&%QjWhDV?s-eAqp*S2OjhT|M%!f{~ z&Q`RC!lvY9bY}no8C{nl4s;!1;3F4Y=ZUN-@3AQ8iW}e_VL2)~(ArOUcD5h!U`g@q zSa&F)z3IN_q>d5(4Qiq6YH06RZ9rL53|{}<&o3y~Jg@+RLG11HYdJLsG7C}3sn*Fa z=R8hZDqXnaq6F?EgD}J%3#H@{GSOudc-{=gfMj?#((gem^8-ZuQl5f)h27PrkqXpfSsy$RvO;^qwG+Iml#!KBZa$z~NCCPRuuSz}_wk&O ztsQW2j*FYQ#@|}%YU8i`MmTZ}-&O>fh#%X9w?t;G6C#(9Rb=B#0@-71n35k$lV2#T2tT7o^m>ea`}ErPQtjr_@isH_X~{-ErU`F^k2%Kno7d6;h?6 z5gA*b>a}mf_!7tWvT06P)6RfaQuw#?+Dz5Se zUdWE#gVFlo!a&ew(s2H_TlX0br$)nZd&~MdO)gdh^8?e`gp##bAwyFY$rm_GgvBJRe?rZ?rn9*83ixujMAXQ9{ln5FxZ%D_8a zxS%V4S+pkVrM<3k{K=1OdA&bz;ZlM>-zA^H^&D9qSXKWR2o*8MavaQdn~+C n-QId$%x-Pp+}d8hg%5%7;m|ZbeZ&uLrl;ZS;3tV`6Dj_Gz#Gj= literal 9124 zcmb_iU2GfKbtXr4va80aWXlViYdAN|)};)K%NdfAs4lh~l0$LCA%`Z1mSlU&$QpVn ziIxmW+g-OQnig&PQlL$NZ1S?*?zTY+^dYir0rhSIzIOZ6hXS$tj|NDQwkTwveJRkS z-#K?k4r$3qiwO42o%{cD&Ue0ZE+aW3ZeijR zYwe~hwl+mrjQ(n_R{XWs>O0Nto!2*3?zUGpU$?eaSK6=NX}ay^y?8YF`ki}I^5gaP z+Roj#xGMFsvfbQmzOx(s1uZry!fMJlUScj8pVQ*#|JHW1H)8XhyW2ZIHz%@osiId6 z$5?WNS@OQ3S=++&ooGR?6{6Wfy}+`QC)$gj z(%MBlm53$9T(+Q>=Z)HwV~a?>Toa?uUz%?dCPk!bWbJCM=HCw5fk`n}sT$WzyIz~h z;arCotj#5obMa(Y{4|bHO-+vaW+mowv!juUP=#&fNVG&n#6;Ox0;AG&;vD?#(Cg>Q4MwB8DZxUkb&Zx!$n3L#-~B9nF3 z4&U#z&%2w!|7^d@d3%=+A}?^K-2RJ{lWgCe)djm^U16 zGt}vXfFf6_*oS0X;9Z7N#%Dy2AF(Zf|Xi-BwfF24o0#?e^{Fc5`#JDc;;(x!VehnUn};S2lls7Zo;L zacgV0#Z`C0BB6?KeUr5R&CRu6X|gb|EI>Q^nvt=W%686>vPM$kt%C)G3i6PYesxQ) zIZ)oHB;R+UcL-9N**I_IWW1Ny3hql{0B zs!=nXS80e>GuSVqN;~#UCiX3kd6lmjRUDm{K&F3b9)x*Xq;<7OLR%D|?m(f`u0joF z#{{>I)|N{d+lorq|9`7ov{o^)asa>P`LeNH-~1F55SqX;o|gKh%h&jbVisDwRSShR zew*W;KUo|(m_K8-SU*f|w!FZv>!wu2p-e85HPU(}YcAwYeVTPBcr#ewUfu|99PVEz zDfBvPDT-23l=B@tf=I8O?-Z3Ad%p{f)22ze2wsG$PW$8_2UBV3%TYq6XwJ;%jjB=3 z8c`Mvn8CQOZpo<58_{|h%2bBkF>-Q;Y9i&==i_U|L=MnwRAGK+7;)x$FxoO^`TxNt1u`gam}~Lqbh(9^fl)ws|$&LeuWv5F;aOtM?ZpUD|vR}3(~CCA$;wiw*EmJ&B1vZfQw+trfpAYD;~7UveSHsB}~ z6WG^zryyXC^zyQp#sS!tfC;fP3lRFuGB|}gOV|W^1RSf>$*lNc?71qX$6_&6g103i zF%P{bk3wxfI-}e#gFRHoF`oiz2h)|qhc5uCT|#A&uV-ZJxwGmr7mX}s72sX5%Q>?= z9|d{wV6Y;9Ay{?)QxnS&MGXQs(8OOyO%Yo6ny5)`qC$azG#A zL8T;XOxe&r-nBj53{6OrS2M2@*&C#6KJw>j>hvH1?ww(_@)3D>oHUys`p zj~k&*+qFYaKeR)?(RLpA(3joUNv(NDYEU&ix<#xBbecM!2*0 zL;F&w6#DMo`@u${^pet;?%0XmSc(2vJh+_tY5Pj3Wly_bZH0W}X&pO;@idGVYeYNt zWusAu7eGQg=zPHYryxL#9y)+R3Pa~`|@W7 z=B_0MW~G9;z*+zsyPgV$lo^X=4t7J0tApRW*WV^JNi-i_|Z)jJ(q?il=<^Ag*bC2vP^m z<+&C@+AS4CN80K#@R?{6g(YMFf?bsvO*&1m#OySIdyzAR1waTAB0L2*2W&As7Z!0i zaP%gRXmM-X4GZ{uVQX!(8HP~6!CKi~@th_wgs_9aiO7>vmFqcGJ6A+&Wv7L(#;to| zz)K>BFe=SGv4N;G-aRuXz^H0b2f2*eiwu;6#IUEYjRXQg2CnhXD}|AR6Rok}GOIEx z$VkDc z*F15B!2x}dnKeFibhO0Ngqih{Lu`Xtl1CO3#8qmBQI@ufxC)s)O=NkQRJB}}{ITZf zRfl*bg&jPKN!}#YiFy%;m`6A#MerJY_mMQOcYQoOk|{j7;jTY@2$&6~b%}h3`%Y(k z>_l<>=^vlDANa3yi}$Sf8A7`2Zu`{X*E`mOe_8v^-aod*;e%He+AkhHxM(i?V52?8 zpfmh_)cVfeL+;~nf1!xcKD;0Jqt3J4{=xmg?@*8bz&$>GUXObp>0XC6b+}&{>P{9u zm|gG^uXYocp4;mIOG^hU-wzMWk5>KQhc3lBe?qcCd%O%@EJ~R-+Beg_v ze6H8@!yrIu8!1$ay${Np~x+<5x% zy#m*GSH8wr06DS->*N^?p&~HG+cE`6z!!yIcmp`*#U=2#riJ4yM`4DtMh#Io90$(4 zR<9Z!Nmdc5m77~8zsUmA%~B{@zy!;DxMwxP60_)u4`Ha@Y!3}(J%r`@w(1z1#;p2v zyoeVBPK}elhuAhehAuFs5T1j<6A*5C5252A*I=<>z*};Fc?ea}>6grM)RPekqAlU{ zHDHzpcl!T4-M^$urG1h)IKwQ7MIg=3u?>Fh{YM)656vn&1pq$OxJzrG-MVGjSxFM0 zg`!LqYH&Ve!V3tHe-$3IV#fqDJn3g|!}Ae(Lf!MWXk{5tq(vQ3@@U?gXB*e^#yFgY zmHslK$jZ0~rax$nrGraEM<1nKW&d2q+&^O~@4=@Jn)uI){AOCY71;Y8gq`FaMR-0& zO}yzpRg^jU{@DUT4?!i!rIe2p`bBWcP>2}U}p7TI#|%Tn@>J<sI!+!O#3bnR0Oa4C((_o6Cxr4Q5R%ijgoy0k^j`dwBQgt zJ1aOE-hBm_U3awpU}P;3{UG@D?te7ks&rb&>Uz#N4O}n~bSR4ySX=L|Bbo3KGk}b2 z2#ER8i4kf;gzXDo!XSY8BrX{Eu5oSiO|jZ~Yjb0V=`k)+G!b6jdQ04SYiC#NG~3P9 zU9qx>8;It%yq*x7TQ1#PZ13#i!Vq*k!Z#sopUH4f;#RSL^C3H+yN=y^cbj7CHj{B0 z^&SR!du^u`9pL2TrXj?PD88pc2x#i13LEgaDCtYlB_^x%1S;d3;!E8SnS^S6iIrZe zdmf}zVG$iyM`VDL_27mty`0|roEsbuo+w)Szy0g=^#yZ-6{aBl{xizR!9SBgPU8%! z`XVnC7Ztq&mLA*ePzJmpzBOLNmg8(HI zj!d#Kc)I`$RR0}0<%*in)Ae*NdVv%ZmzrXZuf8th{AJ04)7{%ndH zcf%U}{9}x`Zym>)J6|V*4u8L(uT;Jcj}SE6m{&vuaF!F1t92VeY~Q}4Q0Ddeot#9T zSvH+(#8e`_zIzr+AjC|SdO-;;VPuMW+>vUa$}v~9 zj(YqP1z$%}wId`?SVSFnwU{*NHy3yul=3)45EVA$smf)zAn>X-gh~oE+%>~T1oSRz z*P(&{3z2s2eS!!B=LaLh{r4jqPvIx1!Ekth5!Hn diff --git a/lispusers/COMPARETEXT.TEDIT b/lispusers/COMPARETEXT.TEDIT index 9c64998f47e06faaaf02f13414ccda6aa439bc46..4c0ff82228448d2d5a42115b45a1b92d955af3d9 100644 GIT binary patch delta 1304 zcmZXR&rcIU6vuawEk6n*D%6-5^EiNDN{x+C4klQkmBvyCT~K3;nRch`;&x`UKd9)T zXQLM#jq&Kwn@Mk8{RfOk4<5YxFM#uAyQSb^XWx9@k9ptsK4rgWzg`_)Efh=n>wsq# z)^nBhjQMCQ58L^B#m%z9rQF?osj@isxDc{hU~~3lGRh&$it@zkVb@ShB#ex*vfUM9 zO&6~c74avrTu6iK@s=CdtO0F1XaWI`He@Xbnj`?*hrQ4bq|2f}84nvxsB=#`DKtFd zHZuUlI&|kpF6mLo2R_tz$O7uQ#FO=~E(I{&jm7aa- z1=LCdV4_EfwZxfo04B9;Y=Bw3?E~>-wo4hP4k^@ahx$?HSeUp{j_cVZpkgUGuM@GG zyw$-LS2s7da@%<`|Ip0jcFavPzg9F+U*Lrl7Hnn*HgTMT#WZ%vdQ*rV^r=H@vNs@M zz*{7+YZ%!d#EA~mk+`<)Q&3u4d@+=E3&$vRO4~xozDsL%{Qw$GE*;U#eeovwd)kKu zH6td4sU=9w;^jm^fADVVs536LpnIQ4l~sqH6jmy&uJ4rZS5R2FSQ^j;W~>ae)$TBe zRI47{$9Y-c^XNUsE%`LAS#F&vwNPt@?3oYtY_ve1v?#dTmqU|_z@;!AfZyb8);*j$ zGW1b#I6W(F%)Fl)(liY}P49i`h8Jx_eiLXI;_u9|ZiuI;-g(YIEF%;0R3QoRCABQ( zQVZfo>TCxwy0OeInsGe-Rqa7=c`#yFUM3Nsfi>h`zk_C+g5cL6!1iYl#3>ylw~@p- zXQVw9gDYr^%CFyvGB75It~d$HDH~&zfk&UX@}h2ilIfAoanN)e)RUr(A&>=ioUV$C ziFP3-ajY66KE4rq`sDe428%KiaAC6thGxYHk(0`r=H&289tm5WAs|cZA MJa4RM+b_QT10N|1uK)l5 delta 1214 zcmZXSJ#Q015Qgs@$4;=1*KSdN7iiRSEE$0yz0p6>Q! zps{G^qZI`d^hgv)?r8ZJNHqM66u`{dXAV=`diI%j-q{)X+t&N7FPq7Y!&+yr-l!c` z4r*}JsLta3%JF`webTJKlUAj# z)NvGkPHksP0QLT~&v-L^L(ldtn}KUM40wNhv~-r(5gfVdW#`{+6ugKNS}=O-taX4xIubDp-!dK%@oDH=sNGJj6GsCp4&)iDm%kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;7 6367 +(FILECREATED " 2-Jan-2022 23:15:58"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;19 6871 - :CHANGES-TO (FNS EXAMINEDEFS) + :CHANGES-TO (FNS EXAMINEFILES) - :PREVIOUS-DATE "19-Dec-2021 22:45:48" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;5) + :PREVIOUS-DATE "30-Dec-2021 21:49:58" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;18) (PRETTYCOMPRINT EXAMINEDEFSCOMS) -(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEDEFS-REGION) +(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES) (INITVARS (EXAMINEDEFS-PROCESS-LIST)))) (DEFINEQ (EXAMINEDEFS - [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 20-Dec-2021 11:06 by rmk") + [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 24-Dec-2021 22:39 by rmk") + (* ; "Edited 20-Dec-2021 11:06 by rmk") (* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.") @@ -45,9 +46,11 @@ ELSEIF (GETDEF NAME TYPE SOURCE2) ELSE (ERROR NAME " not found on " SOURCE2))) (CL:UNLESS TITLE1 - (SETQ TITLE1 (OR SOURCE1 "File 1"))) + (SETQ TITLE1 (OR (AND SOURCE1 (LITATOM SOURCE1)) + "File 1"))) (CL:UNLESS TITLE2 - (SETQ TITLE2 (OR SOURCE2 "File 2"))) + (SETQ TITLE2 (OR (AND SOURCE2 (LITATOM SOURCE2)) + "File 2"))) (SELECTQ (EDITMODE) (SEDIT:SEDIT (* ;; @@ -99,22 +102,31 @@ (PROGN (EDITE DEF1) (EDITE DEF2]) -(EXAMINEDEFS-REGION - [LAMBDA (WIDTH HEIGHT) (* ; "Edited 10-Dec-2021 10:15 by rmk") +(EXAMINEFILES + [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 2-Jan-2022 23:15 by rmk") + (* ; "Edited 30-Dec-2021 21:49 by rmk") - (* ;; "Prompts for a WIDTH-HEIGHT region with the top-left corner positioned at the initial cursor but the cursor then moved to the bottom-right for size adjustments. Thus the default behavior is that the upper left corner is fixed.") + (* ;; "We get a region, then split it in half. Should we attach or at least co-move and co-close the 2 windows?") - (GETMOUSESTATE) - (LET* ((LEFT LASTMOUSEX) - (RIGHT (IPLUS LEFT WIDTH)) - (TOP LASTMOUSEY) - (BOTTOM (IDIFFERENCE TOP HEIGHT))) - (\CURSORPOSITION RIGHT BOTTOM) - (GETREGION NIL NIL (CREATEREGION LEFT BOTTOM WIDTH HEIGHT) - NIL NIL (LIST LEFT TOP RIGHT BOTTOM]) + (CL:UNLESS REGION + (SETQ REGION (GETREGION))) + (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) + REGION + 'RIGHT + 'TOP + `(,REGION 0.5) + (FETCH (REGION TOP) OF REGION)) + NIL TITLE1) + (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) + REGION + 'LEFT + 'TOP + `(,REGION 0.5) + (FETCH (REGION TOP) OF REGION)) + NIL TITLE2]) ) (RPAQ? EXAMINEDEFS-PROCESS-LIST ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (513 6305 (EXAMINEDEFS 523 . 5601) (EXAMINEDEFS-REGION 5603 . 6303))))) + (FILEMAP (NIL (510 6809 (EXAMINEDEFS 520 . 5811) (EXAMINEFILES 5813 . 6807))))) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 80023d0e56f75b3d7c8044528298d512e5aa87f7..d2963945990761e7069a2ad221872ff9eafa0b60 100644 GIT binary patch delta 1087 zcma)*&rj4q6vx@(;Ouym8on zLDGbO!EiDLxtSPm{s~0yp8X5dnRbgH9_(TI<}>fjym{X@A8#MsdDEW(A}_4($V4Fo z2(?kOHS^$A{~lTms9jhjwx-#rAAFr%Yx@Cd4D+-3G80`fg%-n760xnbo=v>L_FIfkNUZ0VCWb zxry9F5dH!xnS~7)+v7@?y|)#iIB$iPmo>$G?}Y%_P!Or)Ns?4L9sD}IF(Fo8&JC}N zzf*YpPmG&|+#0JRBJgM7Cvwafpdzvl^0zXormmcG;9YoW9hT1oj}P8R|Kcv5`(y;&N8nbWn+Y112;5`2YX_ delta 1003 zcmZvbOK;Oa5P@$EpPK#3o94_LbjsY zgzUXYZx~IeBkPP#wKZa6viGz0$fMl^wqHTLJM8!2tW~?+uEWNYH=7&(-EG#J)kc@~ zsT)&=QxEF@bD#Z|d&~fx=myxX?*u)Xw0H=OZjeBgt~&!3&^(4F*ilUHvv8QSJaOK6 zpBUS!W~iT71CRFGQ5?E7Nq|@?gb@wW2#86*4Wkhd zLz@b^1%uF|agegW3sWFE28VOU^-Dlhc*ufe7}JtqQj&3r5P>8Q#O_hvDxqRdVW9%7 z=S~CH;eb``Uwf=7=j|1xv_~TU;^dh2SQr4(5lqDS2oN^2!+Dx&2CNPf&bs1u8ittl zeBsAXz@F~H8UZ_S1{AQOols<&Q;I|eCwD0RqCEgxR<^!y`-)~k9iG45eJLhPkYKeM z5@|hw2rHrmw|6!H*QblB+XRv;y=!R%d+HmzAfLGEmjYl?_bzjHCJqH_-h^Kq9lzA zd6lhg-4x@}Law|jHAI0=Qz_~&c>vQe^J2ThI0@q@Oc>9zt>)$f(bzQMqO(O_ME(0t eGGQaIP8aJ!DL(NMI3Ky$y9!%6lY{I>CHxCueDiAn diff --git a/lispusers/EXAMINEDEFS.TEDIT b/lispusers/EXAMINEDEFS.TEDIT index 38630968510436fecdd718fd2fffe38e1d4768d8..ce966800001039f2be2bdfc695be9a6fa4d84947 100644 GIT binary patch delta 492 zcmY*V%}T>S5KdZJ{GsAiPotMwq{YUACl7_D60j9)KtVigl1aOgZbEiz)JtDMDCj$Q zliqv)pTU<9!564IX$2j2X1@8D+4**-yYKMW-S$&t3IpH*+UVoR!xX?eu$qn6n^v*n z$3iNMBBppOrZ2_sNed)uHh^#}d}4u1NYeP02l^TngO_qKfN=s+Gj;F2P8nRg?YQ;6 zZ9~RI5N8sYJ^~oecjFx!aY2J>h!F5F#1w^(5t;VS2x57ZDtXi+b7Oh z57>a|2gn3{9&$az;Gb|vaX?Ddkg0q@uBIv>jMKbUS-e=F)kP7=Axp8bwr5|qx=zpT zIHz_WC^q4ck_E2gQk5rbJ~!rHJ31H(IW^FB)mi?}b!BFkpH|G;>~mw^G@qwio5$kF u&{opEN}!;QCY{awvdgd@s}&>%#V=b>gx0#4eK@$3H7pH1FOkNg>&8Y(SEEG=5_ z-}T4Ai9hgeb;LrKh7Llov@{X+n7|}uS(JtrRJ=m%RH86G zXt$r<2<=V%VK6y?x4~dOf{`B#NAqVO&xhlsj+`R>sr?_lvJ8tzpQBbX03;jrdXU2K z08XYtxrc#OLWUg%7n~>;S6Vq0W*e}4jWry~lq{Qy0!=T*KaP7tE21Ieg`((EnB za>zPQNI5YJK0>KnS}WHLLG3du`+V)-|FsFrsALc)rVZ(!ef4Mi+nw&N$IrHG-YtGT z@4*#yp0`>T)%TrO74CGO+?O*^bfgeTT}bC{(-~IOd3bg+=23HWZEpbG<|L3pJhe}P a>q55MylT`}DeCrSJZZOB;Ct`C{Q3u3rmm6z diff --git a/lispusers/MODERNIZE b/lispusers/MODERNIZE index e9102278..c49392d2 100644 --- a/lispusers/MODERNIZE +++ b/lispusers/MODERNIZE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Oct-2021 15:42:11"  -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41 30305 +(FILECREATED "25-Dec-2021 22:27:41"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39 30532 - changes to%: (FNS MODERNIZED.TB.BUTTONEVENTFN) + :CHANGES-TO (FNS MODERN-MENUBUTTONFN) - previous date%: "16-Oct-2021 15:29:38" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40) + :PREVIOUS-DATE "25-Dec-2021 22:20:10" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;38) (PRETTYCOMPRINT MODERNIZECOMS) @@ -216,8 +216,9 @@ (DEFINEQ (MODERNWINDOW.BUTTONEVENTFN - [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN) - (* ; "Edited 16-Oct-2021 15:25 by rmk:") + [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN) + (* ; "Edited 25-Dec-2021 22:19 by rmk") + (* ; "Edited 16-Oct-2021 15:25 by rmk:") (* ;; "WINDOW is the window that received the click and that should be passed through to the original function, if we don't pick it off here.") @@ -232,81 +233,78 @@ (LET (CORNER ATTACHEDREGION) (IF CORNERREGION THEN + (* ;; "Caller tells us whether the corner window has a title.") - (* ;; "Caller tells us whether the corner window has a title.") - - (CL:UNLESS (FIXP TOPMARGIN) - (SETQ TOPMARGIN (if TOPMARGIN - then (FONTPROP WindowTitleDisplayStream 'HEIGHT) - else MODERN-WINDOW-MARGIN))) + (CL:UNLESS (FIXP TOPMARGIN) + (SETQ TOPMARGIN (if TOPMARGIN + then (FONTPROP WindowTitleDisplayStream 'HEIGHT) + else MODERN-WINDOW-MARGIN))) ELSE (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION)) (* ; "WINDOW is the corner window") - (SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN) - elseif (WINDOWPROP WINDOW 'TITLE) - then (FONTPROP WindowTitleDisplayStream 'HEIGHT) - else MODERN-WINDOW-MARGIN))) + (SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN) + elseif (WINDOWPROP WINDOW 'TITLE) + then (FONTPROP WindowTitleDisplayStream 'HEIGHT) + else MODERN-WINDOW-MARGIN))) (if (AND (MOUSESTATE (ONLY LEFT)) - (EQ LASTKEYBOARD 0) - (INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY)) + (EQ LASTKEYBOARD 0) + (INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY)) then + (* ;; "INSIDE? check because we may be called by a click in WINDOW that is outside the corner region, we just pass it through.") - (* ;; "INSIDE? check because we may be called by a click in WINDOW that is outside the corner region, we just pass it through.") + (TOTOPW WINDOW) + (SETQ ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW))) - (TOTOPW WINDOW) - (SETQ ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW))) + (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.") - (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.") + (* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ") - (* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ") + (SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN)) + (if [AND CORNER (NOT (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS] + then + (* ;; + "The upper corners may be in the title bar, near the side, so test corners before titlebar.") - (SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN)) - (if CORNER - then + (* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.") - (* ;; - "The upper corners may be in the title bar, near the side, so test corners before titlebar.") + (* ;; "WINDOWREGION includes the attached windows") - (* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.") + (LET ((LEFT (fetch (REGION LEFT) of ATTACHEDREGION)) + (RIGHT (fetch (REGION RIGHT) of ATTACHEDREGION)) + (TOP (fetch (REGION TOP) of ATTACHEDREGION)) + (BOTTOM (fetch (REGION BOTTOM) of ATTACHEDREGION)) + STARTINGREGION) - (* ;; "WINDOWREGION includes the attached windows") + (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.") - (LET ((LEFT (fetch (REGION LEFT) of ATTACHEDREGION)) - (RIGHT (fetch (REGION RIGHT) of ATTACHEDREGION)) - (TOP (fetch (REGION TOP) of ATTACHEDREGION)) - (BOTTOM (fetch (REGION BOTTOM) of ATTACHEDREGION)) - STARTINGREGION) - - (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.") - - (CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN)) - [SETQ STARTINGREGION - (GETREGION NIL NIL NIL NIL NIL - (SELECTQ CORNER - (RIGHTBOTTOM (\CURSORPOSITION RIGHT BOTTOM) - (GETMOUSESTATE) - (LIST LEFT TOP RIGHT BOTTOM)) - (LEFTBOTTOM (\CURSORPOSITION LEFT BOTTOM) - (GETMOUSESTATE) - (LIST RIGHT TOP LEFT BOTTOM)) - (RIGHTTOP (\CURSORPOSITION RIGHT TOP) + (CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN)) + [SETQ STARTINGREGION + (GETREGION NIL NIL NIL NIL NIL + (SELECTQ CORNER + (RIGHTBOTTOM (\CURSORPOSITION RIGHT BOTTOM) + (GETMOUSESTATE) + (LIST LEFT TOP RIGHT BOTTOM)) + (LEFTBOTTOM (\CURSORPOSITION LEFT BOTTOM) (GETMOUSESTATE) - (LIST LEFT BOTTOM RIGHT TOP)) - (LEFTTOP (\CURSORPOSITION LEFT TOP) - (GETMOUSESTATE) - (LIST RIGHT BOTTOM LEFT TOP)) - (SHOULDNT]) - (SHAPEW (CENTRALWINDOW WINDOW) - STARTINGREGION)) - T - elseif (OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION)) - then (NEARESTCORNER ATTACHEDREGION) - (MOVEW (CENTRALWINDOW WINDOW)) - T - elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW - 'PREMODERN-BUTTONEVENTFN] - then (APPLY* ORIGFUNCTION WINDOW)) - elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW - 'PREMODERN-BUTTONEVENTFN] + (LIST RIGHT TOP LEFT BOTTOM)) + (RIGHTTOP (\CURSORPOSITION RIGHT TOP) + (GETMOUSESTATE) + (LIST LEFT BOTTOM RIGHT TOP)) + (LEFTTOP (\CURSORPOSITION LEFT TOP) + (GETMOUSESTATE) + (LIST RIGHT BOTTOM LEFT TOP)) + (SHOULDNT]) + (SHAPEW (CENTRALWINDOW WINDOW) + STARTINGREGION)) + T + elseif (AND [NOT (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS] + (OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION))) + then (NEARESTCORNER ATTACHEDREGION) + (MOVEW (CENTRALWINDOW WINDOW)) + T + elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW + 'PREMODERN-BUTTONEVENTFN] + then (APPLY* ORIGFUNCTION WINDOW)) + elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN] then (APPLY* ORIGFUNCTION WINDOW]) (NEARTOP @@ -406,19 +404,21 @@ (MODERNWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))]) (MODERN-MENUBUTTONFN - [LAMBDA (WINDOW) (* ; "Edited 23-May-2021 20:37 by rmk:") + [LAMBDA (WINDOW) (* ; "Edited 25-Dec-2021 22:26 by rmk") + (* ; "Edited 23-May-2021 20:37 by rmk:") - (* ;; "Replaces the button fn for a Menu window, allowing title clicks to do the move. Sometimes the title isn't in the window, it's in the menu.") + (* ;; "Replaces the button fn for a Menu window, allowing title clicks to do the move. Sometimes the title isn't in the window, it's in the menu.") (LET (MENU) - (IF [AND (MOUSESTATE (ONLY LEFT)) - (EQ LASTKEYBOARD 0) - (OR (WINDOWPROP WINDOW 'TITLE) - (AND [NULL (CDR (SETQ MENU (MKLIST (WINDOWPROP WINDOW 'MENU] - (TYPE? MENU (SETQ MENU (CAR MENU))) - (FETCH (MENU TITLE) OF MENU))) - (NEARTOP (WINDOWPROP WINDOW 'REGION) - (FONTPROP WindowTitleDisplayStream 'HEIGHT] + (IF [AND [NOT (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS] + (MOUSESTATE (ONLY LEFT)) + (EQ LASTKEYBOARD 0) + (OR (WINDOWPROP WINDOW 'TITLE) + (AND [NULL (CDR (SETQ MENU (MKLIST (WINDOWPROP WINDOW 'MENU] + (TYPE? MENU (SETQ MENU (CAR MENU))) + (FETCH (MENU TITLE) OF MENU))) + (NEARTOP (WINDOWPROP WINDOW 'REGION) + (FONTPROP WindowTitleDisplayStream 'HEIGHT] THEN (MOVEW WINDOW) ELSE (MODERN-ORIG-MENUBUTTONFN WINDOW]) ) @@ -532,7 +532,7 @@ (* (MODERNWINDOW.SETUP - (QUOTE ONEDINSPECT.BUTTONEVENTFN))) + (QUOTE ONEDINSPECT.BUTTONEVENTFN))) (MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) @@ -571,7 +571,7 @@ (MODERNWINDOW (PROCESSPROP (TTY.PROCESS) - 'WINDOW)) + 'WINDOW)) (* ;; "Table browser and filebrowser)") @@ -612,12 +612,12 @@ (ADDTOVAR LAMA MODERN-ADD-EXEC) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5135 11412 (MODERNWINDOW 5145 . 6600) (MODERNWINDOW.SETUP 6602 . 9551) (UNMODERNWINDOW -9553 . 9947) (MODERNWINDOW.UNSETUP 9949 . 10761) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10763 . 11410)) ( -11477 21412 (MODERNWINDOW.BUTTONEVENTFN 11487 . 18287) (NEARTOP 18289 . 19217) (NEARESTCORNER 19219 . -20098) (INCORNER.REGION 20100 . 21410)) (21470 23792 (MODERN-ADD-EXEC 21480 . 21911) (MODERN-SNAPW -21913 . 22456) (TOTOPW.MODERNIZE 22458 . 22886) (MODERN-MENUBUTTONFN 22888 . 23790)) (23793 26222 ( -\MODERNIZED.FREEMENU.BUTTONEVENTFN 23803 . 24450) (MODERNIZED.TB.BUTTONEVENTFN 24452 . 26220)) (26263 -28542 (TEDIT.MODERNIZE 26273 . 27087) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27089 . 28211) (TEDIT.SELECTALL - 28213 . 28540))))) + (FILEMAP (NIL (5122 11399 (MODERNWINDOW 5132 . 6587) (MODERNWINDOW.SETUP 6589 . 9538) (UNMODERNWINDOW +9540 . 9934) (MODERNWINDOW.UNSETUP 9936 . 10748) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10750 . 11397)) ( +11464 21491 (MODERNWINDOW.BUTTONEVENTFN 11474 . 18366) (NEARTOP 18368 . 19296) (NEARESTCORNER 19298 . +20177) (INCORNER.REGION 20179 . 21489)) (21549 24021 (MODERN-ADD-EXEC 21559 . 21990) (MODERN-SNAPW +21992 . 22535) (TOTOPW.MODERNIZE 22537 . 22965) (MODERN-MENUBUTTONFN 22967 . 24019)) (24022 26451 ( +\MODERNIZED.FREEMENU.BUTTONEVENTFN 24032 . 24679) (MODERNIZED.TB.BUTTONEVENTFN 24681 . 26449)) (26492 +28771 (TEDIT.MODERNIZE 26502 . 27316) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27318 . 28440) (TEDIT.SELECTALL + 28442 . 28769))))) STOP diff --git a/lispusers/MODERNIZE.LCOM b/lispusers/MODERNIZE.LCOM index 32671a8ef631ad28cedbfde7d0bc536e8a22e6c6..9ed9b561a47617fd762666af587fa08107e751ac 100644 GIT binary patch delta 1546 zcmZuxOOF#r5VoDo0-FUb;jvl}No5bPd+=)dF)u4pnDw;n5uRzQrw0cKBp@Ij;&FjU zIa%C^!e$P+Mx1hqlwjq&=lq4_%r(j(KOogJv&K8#Ido5TeO*;wJ^Fq6OZH}bhT84$ z{x@xEQ38~9sN3OtkKNYO@AAFor48n9!)6^qI+nfn*QJN;SR~nQrnO9Z2|RiRo4sr} zgn9VR&dw&>yYu4yy`#(!vbnvo)r*Frt3;qhxCp{B| z+>Qg)kCJU@{&TF=SUwHS@ZA}~VEUza$H%8mH1PYaeYM#CT)umJ|LOyCv|^S&&Q<4I zKUK(AEE}%Hz$R7;j#ID5f(zRe1f0`p54xa)z8-dD~!*% zDE$1G-&*~9{YcgHi`+XoYI!vO`Q+J_?VD}FIdZ%%#=tSPU6E)N3`@3n!XOcW5~=P= zl?Vl#+Qo^MBjAKVEaF|@mIr;I%S%}*)JUP4`4*&uV1$;L$7`0E>zXS{^e2%_fVl** zG8=}824>qv7h}!Pu_+qkKHThPDwS#^(?}OrD6ON2vw)(WQ$tbDI)p0xQ=8Rc+&u&{ zE-9gKGfL7-i7G+FrDY0;Q}C&!fN&e4q)gooay3Q>b0N?==nh0^;1fBXX=p7=ggT%l z=6VbS$)W2g6kmZ`57wd3lZhUPs6WtP*Q3M=FP4XTC6|jcGSr&0f@8_u{D-9rA90)K zZ$SHZfBt>5*=U|#YaBf*Pjlz|OMDLUU(a8hFj5gEl+Ol$VDNK!Cxq16!#yhTHumzN zCSq2-_o}%fv$4vTmri9C#(?iF_(qMpkZdJMI^Yw2({U0Y5 BfLQ_LARsc4RhYd$v$8P%1X>R-m0-B)co6;> zJfAPXqsQ~Biw~bZiSFgLWZJk`B1U*ey1WxJt;ic!((a+~S-wA40O{jFDRtlkNY?uS zN?@Z*-kmnAN~|B9%=B@ z!>>pB(?}OvTgFglH)s<`QHKh3eAlcsZO39lgTSGtOFh5BT!*?q3=(O4)&Qa-@W#!C zaMjeLt7^a)^<6q@81qP;ZPBZs7k9I{>F~dq{p@$S(d?KPTmK^ zEj81NyEVy0yem!s;y7WwPAALEbS*H{U2{3;<-z$I(@6ND@9Z%})S^*0-7(t%WN=+} zl1UstEcnm{5sI(cvrM|$67Z@L^?@E9JzNP6aIpW8#f1?lm7wL CSx%?` diff --git a/lispusers/OBJECTWINDOW b/lispusers/OBJECTWINDOW index 778e55fe..09996d73 100644 --- a/lispusers/OBJECTWINDOW +++ b/lispusers/OBJECTWINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Dec-2021 18:20:31"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>OBJECTWINDOW.;4 94660 +(FILECREATED "26-Dec-2021 18:59:24"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>OBJECTWINDOW.;5 94928 - :CHANGES-TO (FNS OBJ.CREATEW OBJ.ADDMANYTOW OBJ.INSERTOBJECTS) + :CHANGES-TO (FNS OBJ.CREATEW) - :PREVIOUS-DATE "16-Dec-2021 23:33:24" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>OBJECTWINDOW.;3) + :PREVIOUS-DATE "21-Dec-2021 18:20:31" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>OBJECTWINDOW.;4) (PRETTYCOMPRINT OBJECTWINDOWCOMS) @@ -174,15 +174,20 @@ WINDOW]) (OBJ.CREATEW - [LAMBDA (WINDOWTYPE REGION TITLE BORDERSIZE NOOPENFLG SEPDIST BOXFN DISPLAYFN BUTTONINFN HARDCOPYFN - HCPYHEADING) (* ; "Edited 21-Dec-2021 17:19 by rmk") + [LAMBDA (WINDOWTYPE REGION/WINDOW TITLE BORDERSIZE NOOPENFLG SEPDIST BOXFN DISPLAYFN BUTTONINFN + HARDCOPYFN HCPYHEADING) (* ; "Edited 26-Dec-2021 18:48 by rmk") + (* ; "Edited 21-Dec-2021 17:19 by rmk") (* ; "Edited 16-Dec-2021 23:32 by rmk") (* ; "Edited 26-Nov-96 14:31 by rmk:") (* bbb " 9-May-86 16:59") (CL:UNLESS (MEMB WINDOWTYPE '(HORIZONTAL VERTICAL)) (\ILLEGAL.ARG WINDOWTYPE)) (LET (WINDOW) - (SETQ WINDOW (CREATEW REGION TITLE BORDERSIZE NOOPENFLG)) + (IF (WINDOWP REGION/WINDOW) + THEN (SETQ WINDOW REGION/WINDOW) + (CL:WHEN TITLE + (WINDOWPROP WINDOW 'TITLE TITLE)) + ELSE (SETQ WINDOW (CREATEW REGION/WINDOW TITLE BORDERSIZE NOOPENFLG))) (WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE) (OBJ.CLEARW WINDOW) (WINDOWPROP WINDOW 'SCROLLFN (FUNCTION OBJ.SCROLLFN)) @@ -1479,18 +1484,18 @@ (AND (GETD 'MODERNWINDOW.SETUP) (MODERNWINDOW.SETUP (FUNCTION OBJ.BUTTONEVENTINFN))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1959 19677 (OBJ.ADDMANYTOW 1969 . 2461) (OBJ.ADDTOW 2463 . 8184) (OBJ.CLEARW 8186 . -9312) (OBJ.CREATEW 9314 . 11231) (OBJ.DELFROMW 11233 . 11645) (OBJ.FIND.REGION 11647 . 12112) ( -OBJ.INSERTOBJECTS 12114 . 17722) (OBJ.MAP.OBJECTS 17724 . 18381) (OBJ.OBJECTS 18383 . 18655) ( -OBJ.REPLACE 18657 . 19236) (OBJWINDOWP 19238 . 19675)) (19729 94546 (OBJ.APPLY.USER.FN 19739 . 22971) -(OBJ.BUTTONEVENTFN 22973 . 23135) (OBJ.BUTTONEVENTINFN 23137 . 25477) (OBJ.CLEAR.EXTENT 25479 . 25775) - (OBJ.COMPUTE.IMAGEBOX 25777 . 28122) (OBJ.COMPUTE.REGION 28124 . 28615) (OBJ.COPYBUTTONEVENTFN 28617 - . 32412) (OBJ.DELFROMW.HORIZONTAL 32414 . 39179) (OBJ.DELFROMW.VERTICAL 39181 . 45808) ( -OBJ.DRAW.OBJECT 45810 . 47241) (OBJ.END.OF.OBJECT 47243 . 48444) (OBJ.FIND.OBJECT 48446 . 50323) ( -OBJ.FIND.REGION.HORIZONTAL 50325 . 52166) (OBJ.FIND.REGION.VERTICAL 52168 . 54130) (OBJ.FLIP.OBJECT -54132 . 54628) (OBJ.HARDCOPYFN 54630 . 56745) (OBJ.INDEX.OBJECT 56747 . 58275) (OBJ.INSTANTIATE 58277 - . 59582) (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT 59584 . 60270) (OBJ.RECOMPUTE.EXTENT 60272 . 69818) ( -OBJ.REPAINTFN 69820 . 72780) (OBJ.REPLACE.HORIZONTAL 72782 . 79298) (OBJ.REPLACE.VERTICAL 79300 . -85926) (OBJ.RESHAPEFN 85928 . 86467) (OBJ.SCROLLFN 86469 . 87004) (OBJ.SCROLLFN.HORIZONTAL 87006 . -90166) (OBJ.SCROLLFN.VERTICAL 90168 . 94544))))) + (FILEMAP (NIL (1926 19945 (OBJ.ADDMANYTOW 1936 . 2428) (OBJ.ADDTOW 2430 . 8151) (OBJ.CLEARW 8153 . +9279) (OBJ.CREATEW 9281 . 11499) (OBJ.DELFROMW 11501 . 11913) (OBJ.FIND.REGION 11915 . 12380) ( +OBJ.INSERTOBJECTS 12382 . 17990) (OBJ.MAP.OBJECTS 17992 . 18649) (OBJ.OBJECTS 18651 . 18923) ( +OBJ.REPLACE 18925 . 19504) (OBJWINDOWP 19506 . 19943)) (19997 94814 (OBJ.APPLY.USER.FN 20007 . 23239) +(OBJ.BUTTONEVENTFN 23241 . 23403) (OBJ.BUTTONEVENTINFN 23405 . 25745) (OBJ.CLEAR.EXTENT 25747 . 26043) + (OBJ.COMPUTE.IMAGEBOX 26045 . 28390) (OBJ.COMPUTE.REGION 28392 . 28883) (OBJ.COPYBUTTONEVENTFN 28885 + . 32680) (OBJ.DELFROMW.HORIZONTAL 32682 . 39447) (OBJ.DELFROMW.VERTICAL 39449 . 46076) ( +OBJ.DRAW.OBJECT 46078 . 47509) (OBJ.END.OF.OBJECT 47511 . 48712) (OBJ.FIND.OBJECT 48714 . 50591) ( +OBJ.FIND.REGION.HORIZONTAL 50593 . 52434) (OBJ.FIND.REGION.VERTICAL 52436 . 54398) (OBJ.FLIP.OBJECT +54400 . 54896) (OBJ.HARDCOPYFN 54898 . 57013) (OBJ.INDEX.OBJECT 57015 . 58543) (OBJ.INSTANTIATE 58545 + . 59850) (OBJ.MOVETO.LAST.INSTANTIATED.OBJECT 59852 . 60538) (OBJ.RECOMPUTE.EXTENT 60540 . 70086) ( +OBJ.REPAINTFN 70088 . 73048) (OBJ.REPLACE.HORIZONTAL 73050 . 79566) (OBJ.REPLACE.VERTICAL 79568 . +86194) (OBJ.RESHAPEFN 86196 . 86735) (OBJ.SCROLLFN 86737 . 87272) (OBJ.SCROLLFN.HORIZONTAL 87274 . +90434) (OBJ.SCROLLFN.VERTICAL 90436 . 94812))))) STOP diff --git a/lispusers/OBJECTWINDOW.LCOM b/lispusers/OBJECTWINDOW.LCOM index f55dcce57cc21bfd5e6e14bce3e4e4361796dd2e..b5eef2e7b3cff6767a70fdfe9d17d7a38d01f67c 100644 GIT binary patch delta 861 zcmZuv-D=c86gKsuwyrdaoJPq-Q22dBW;A|8ooE0;mdQHcL?igTeoh^aTZbLa> z3Kt?t_$f<9tT+XXV9KX~It+0vh_gbx$WqDFA#Dm}SY#@8E_o`ek^`|UkU}QPQX@3& z#H@(IEMH7gAlQLT7ZC_5DYFzrs%Y%_5Q#ERSQCsXg&>NOM8&JEkERq?p^)i}Nbfx{RozBHbWO5<7|x4bO~(~KVp zHO+gmY0tQ@n`sCQshP(4)EqbHxoCd4+Xev$W+I8zOfOPy!QSuU^4?*qKZy7D%$ctW zy#L*I97w0S(xsV7f#5oVeNxk478GyqKVSc&Btcz?X$=Xy8sOs^z}y<(1l3+7kFps! ze=DxltZbPgxZWA|;I)vFk0NPD*$6O#37_=M;}gPQtTORRB|4Ho2!ec&DWjchp6F@L zfglE2XvxiHz0z_VW${3zi(z8^k`KG7=faErRBM%pWJ@ywvB*;ym0}k`U(L68k+6d% zaf;2d{TSl_syqD1cy4Lr7njR}HAWP+Mz`63lwD*zA4e%Sa^HiS#A8=%8i}%)hYfq3 pFjTVDjOMEAUd?M_>h1oFRu|fY2GG@DgA@~?Eg+Phe}3>){{hjE;5PsO diff --git a/lispusers/OBJECTWINDOW.TEDIT b/lispusers/OBJECTWINDOW.TEDIT index 9e37243146dafdd7b81913c67d7ac8655e6a41a9..e8fad1bb8ede7bdffe59ddff5059267baf55c688 100644 GIT binary patch delta 203 zcmbQIw@iP72ot-0xTl|sfB0k(rVns73$uT{XPQEgtGlPaA5?)tX0bw|LV0FhN`ASH zLS_kwpPZjpmReMjnxasWuaKChke`&5np^@^1f)tb6hb^hd|dSu6#PpvQj5wni&J%g zrsSoTqbMp$P0!5FL$QxHTp=?}Aum5q*U!^OZ*wqnG(ThYanEf}uWsc?-=4Ai^W*`m#F&KeZe6pvo(qtwvp~kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;99 31663 + + :CHANGES-TO (FNS SET-TYPED-REGIONS \RELCREATEREGION.REF \RELCREATEREGION.SIZE) + + :PREVIOUS-DATE " 1-Jan-2022 23:14:42" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;95) + + +(PRETTYCOMPRINT REGIONMANAGERCOMS) + +(RPAQQ REGIONMANAGERCOMS + [ + (* ;; "Typed regions") + + [COMS (FNS SET-TYPED-REGIONS) + (FNS RM-CREATEW RM-CLOSEW RM-GETREGION CLOSE-TYPED-W) + (INITVARS (TYPED-REGIONS)) + (GLOBALVARS TYPED-REGIONS) + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TYPED-REGION REGION-SOURCE)) + (INITRECORDS TYPED-REGION REGION-SOURCE) + (P (MOVD? 'CREATEW 'CREATEW.ORIG) + (MOVD? 'CLOSEW 'CLOSEW.ORIG) + (MOVD? 'GETREGION 'GETREGION.ORIG) + (MOVD 'RM-CREATEW 'CREATEW) + (MOVD 'RM-CLOSEW 'CLOSEW) + (MOVD 'RM-GETREGION 'GETREGION] + + (* ;; "Relative regions") + + (COMS (FNS RELCREATEREGION RELGETREGION) + (FNS \RELCREATEREGION.REF \RELCREATEREGION.SIZE)) + + (* ;; "Composite application construction") + + (COMS (FNS RM-ATTACHWINDOW) + (P (MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG) + (MOVD 'RM-ATTACHWINDOW 'ATTACHWINDOW)) + (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS RFIELDDIFF]) + + + +(* ;; "Typed regions") + +(DEFINEQ + +(SET-TYPED-REGIONS + [LAMBDA (TYPELISTS REPLACE) (* ; "Edited 2-Jan-2022 16:01 by rmk") + (* ; "Edited 29-Dec-2021 16:17 by rmk") + (* ; "Edited 28-Dec-2021 12:59 by rmk") + (* ; "Edited 27-Nov-2021 08:55 by rmk:") + (* ; "Edited 26-Oct-2021 18:04 by rmk:") + + (* ;; "User can pre-initialize a sequence of regions for a given type. Generally, TYPELISTS is a list of the form") + + (* ;; " ((TYPEATOM1 . REGIONS)...(TYPEATOMn . REGIONS). Copies of the regions of TYPELIST are added in front of any regions that might already be present for that type. The regions have haslinks to its type and an inuse status indicator.") + + (* ;; "") + + (* ;; "Convenience cases:") + + (* ;; + " TYPEATOM: Interpreted as ((TYPEATOM)): No region specified, but regions can accumulate") + + (* ;; "") + + (* ;; " (TYPEATOM .REGIONS): Interpreted as ((TYPEATOM . REGIONS).") + + (if (LITATOM TYPELISTS) + then (SETQ TYPELISTS (CONS (CONS TYPELISTS))) + elseif (LITATOM (LISTP TYPELISTS)) + then (SETQ TYPELISTS (CONS TYPELISTS))) + (for TL TYPE REGIONS PREV in TYPELISTS + do (SETQ TYPE (CAR TL)) + (SETQ REGIONS (CDR TL)) + (CL:UNLESS (AND TYPE (LITATOM TYPE) + (for R in REGIONS always (REGIONP R))) + (ERROR "Not a TYPED-REGIONS specification" REGIONS)) + (SETQ REGIONS (COPY REGIONS)) (* ; + "Not to be confused with any other equal regions.") + (if (SETQ PREV (ASSOC TYPE TYPED-REGIONS)) + then [RPLACD PREV (CL:IF REPLACE + REGIONS + (NCONC REGIONS (CDR PREV)))] + else (push TYPED-REGIONS (CONS TYPE REGIONS]) +) +(DEFINEQ + +(RM-CREATEW + [LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 1-Jan-2022 23:12 by rmk") + (* ; "Edited 29-Dec-2021 19:25 by rmk") + + (* ;; "Generic CREATEW function for managed regions. If REGIONTYPE is specified (as REGION or in PROPS), then we try to find a previous region for that type that is currently unused, create one if needed.") + + (* ;; "We have to bracket the original window creation because the we have to mark that the window uses that region, to put it back in the pool when the window is closed.") + + (LET (WINDOW REGIONTYPE TYPEDREGION TYPELIST) + [SETQ REGIONTYPE (if (AND REGION (LITATOM REGION)) + then (PROG1 REGION (SETQ REGION NIL)) + else (LISTGET PROPS 'REGION-TYPE] + (SETQ TYPELIST (ASSOC REGIONTYPE TYPED-REGIONS)) + + (* ;; "We have REGIONTYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type?") + + (* ;; "Note: REGION can also be a screenregion, that falls through.") + + (IF (REGIONP REGION) + THEN (SETQ TYPEDREGION (FETCH REGION-SOURCE OF REGION)) + ELSEIF TYPELIST + THEN + (* ;; + "If we don't find an unused region, CREATEW will create one in the ordinary way. We type it below.") + + [SETQ TYPEDREGION (FIND R FOUND in (CDR TYPELIST) + SUCHTHAT (NOT (fetch REGION-INUSE of R] + (SETQ REGION TYPEDREGION)) + (SETQ WINDOW (CREATEW.ORIG REGION TITLE BORDERSIZE NOOPENFLG PROPS)) + + (* ;; "CREATEW doesn't call the user-entry GETREGION, so we have to trap and install its return region here.") + + (CL:WHEN (AND TYPELIST (NULL TYPEDREGION)) (* ; + "If not, we don't record this even if typed.") + (SETQ TYPEDREGION (OR (FETCH REGION-SOURCE OF (SETQ REGION (WINDOWREGION WINDOW))) + (COPY REGION))) + (NCONC1 TYPELIST TYPEDREGION)) + (CL:WHEN TYPEDREGION + (replace REGION-INUSE of TYPEDREGION with T) + (WINDOWPROP WINDOW 'TYPED-REGION TYPEDREGION) + (WINDOWPROP WINDOW 'REGION-TYPE REGIONTYPE)) + WINDOW]) + +(RM-CLOSEW + [LAMBDA (WINDOW) (* ; "Edited 29-Dec-2021 15:44 by rmk") + (* ; "Edited 28-Dec-2021 11:02 by rmk") + (* ; "Edited 27-Nov-2021 10:00 by rmk:") + (* ; "Edited 26-Oct-2021 21:54 by rmk:") + (* ; + "Edited 25-Apr-94 10:08 by sybalsky") + (* ; "") + + (* ;; + "Makes the window's typed region available for reuse, if the window is marked with a TYPEDREGION.") + + (* ;; "It's possible that the window exists and can be reopened after it has been closed. The glitch in that case is that we may have decided to make the window's region available to another window, and if this window is opened again it will come on top of that other one (if it hasn't moved). Oh well.") + + (LET [(TYPEDREGION (WINDOWPROP WINDOW 'TYPED-REGION] + (CL:WHEN (AND (CLOSEW.ORIG WINDOW) + TYPEDREGION) + (REPLACE REGION-INUSE OF TYPEDREGION WITH NIL) + (WINDOWPROP WINDOW 'TYPED-REGION NIL) + T)]) + +(RM-GETREGION + [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) + (* ; "Edited 1-Jan-2022 21:49 by rmk") + + (* ;; "If INITREGION is a type atom and a region of that type is available, then use it as the INITREGION. Otherwise, add a copy of the new region to the available list, and assert that the new region has the copy as its source.") + + (* ;; "We don't know what will happen to the new region, but if it ends up as a region for CREATEW, the source information enables us to mark its source as inuse.") + + (* ;; "This allows for the possibility that the application is actually asking the user for a constellation region that will be shrunk in anticipation of future satellite attachments. A future retrieval will return the original size and position, and it will then presumably be shrunk in the same way.") + + (LET (REGION (TYPELIST (ASSOC (CL:WHEN (AND INITREGION (LITATOM INITREGION)) + INITREGION) + TYPED-REGIONS))) + (FOR R in (CDR TYPELIST) UNLESS (fetch REGION-INUSE of R) + WHEN [AND (OR (NULL MINWIDTH) + (ILEQ MINWIDTH (FETCH WIDTH OF R))) + (OR (NULL MINHEIGHT) + (ILEQ MINHEIGHT (FETCH HEIGHT OF R] + DO + (* ;; "Copy so the caller can update the region without affecting the recyclable source, but remember what it is based on. We don't mark it as used here, maybe a window won't be built around it and it will fade away. However, there is the risk that another GETREGION will find the same source before it is given to a window, in which case 2 windows might open up in the same place.") + + (SETQ REGION (COPY R)) + (REPLACE REGION-SOURCE OF REGION WITH R) + (RETURN)) + + (* ;; "If we found a good one, we're done. Otherwise, run the normal code, but save the new region if it is typed.") + + (CL:UNLESS REGION + (SETQ REGION (GETREGION.ORIG MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG + INITCORNERS)) + (CL:WHEN TYPELIST + + (* ;; + "The new region is based on a typed region. The saved source is a copy of what we return.") + + (NCONC1 TYPELIST (REPLACE REGION-SOURCE OF REGION WITH (COPY REGION))))) + REGION]) + +(CLOSE-TYPED-W + [LAMBDA (TYPE) (* ; "Edited 29-Dec-2021 15:58 by rmk") + (* ; "Edited 27-Nov-2021 11:50 by rmk:") + + (* ;; "Closes all windows of REGIONTYPE inside TYPE") + + (CL:WHEN TYPE + (for W R in (OPENWINDOWS) when (AND (SETQ WT (WINDOWPROP W 'REGION-TYPE)) + (EQMEMB WT TYPE)) do (CLOSEW W)))]) +) + +(RPAQ? TYPED-REGIONS ) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TYPED-REGIONS) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(HASHLINK TYPED-REGION (REGION-INUSE REGION-INUSE-HASH)) + +(HASHLINK REGION-SOURCE (REGION-SOURCE REGION-SOURCE-HASH)) +) + +(DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-INUSE-HASH)) + +(SETUPHASHARRAY 'REGION-INUSE-HASH NIL) + +(DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-SOURCE-HASH)) + +(SETUPHASHARRAY 'REGION-SOURCE-HASH NIL) +) + +(DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-INUSE-HASH)) + +(SETUPHASHARRAY 'REGION-INUSE-HASH NIL) + +(DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-SOURCE-HASH)) + +(SETUPHASHARRAY 'REGION-SOURCE-HASH NIL) + +(MOVD? 'CREATEW 'CREATEW.ORIG) + +(MOVD? 'CLOSEW 'CLOSEW.ORIG) + +(MOVD? 'GETREGION 'GETREGION.ORIG) + +(MOVD 'RM-CREATEW 'CREATEW) + +(MOVD 'RM-CLOSEW 'CLOSEW) + +(MOVD 'RM-GETREGION 'GETREGION) + + + +(* ;; "Relative regions") + +(DEFINEQ + +(RELCREATEREGION + [LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) (* ; "Edited 30-Dec-2021 20:54 by rmk") + (* ; "Edited 27-Dec-2021 15:54 by rmk") + + (* ;; "The region is oriented so that he REFX and REFY are at the corner named by CORNERX/Y. ") + + (* ;; "Creates a WIDTH-HEIGHT region relative to the CORNER and REF parameters.") + + (* ;; "CORNERX and CORNERY default to LEFT and BOTTOM. ") + + (* ;; "REFX and REFY default to the current cursor screen coordinates. Otherwise, ") + + (* ;; " REFX is a position and REFY is NIL: REFX and REFY are extracted from the position") + + (* ;; " Positive integers: absolute screen coordinates") + + (* ;; + " (region spec) or (window spec) pairs: coordinates relative to the region or the window's region") + + (* ;; " Spec can name the X/Y endpoints (e.g. LEFT/0 or RIGHT/1) or a floating point proportion of the distance on the relevant dimension (e.g. .5= the midpoint.") + + (* ;; "If ONSCREEN, the width or height is adjusted so that the corner opposite to the fixed corner is always visible.") + + (* ;; "") + + (* ;; "Resolve the width and height, if based on a region or window ") + + (SETQ WIDTH (\RELCREATEREGION.SIZE WIDTH 'X)) + (SETQ HEIGHT (\RELCREATEREGION.SIZE HEIGHT 'Y)) + + (* ;; "Resolve the corner") + + (CL:UNLESS CORNERX + (SETQ CORNERX 'LEFT)) + (CL:UNLESS CORNERY + (SETQ CORNERY 'BOTTOM)) + (CL:WHEN (AND (LISTP CORNERX) + (NULL CORNERY)) + (SETQ CORNERY (CADR CORNERX)) + (SETQ CORNERX (CAR CORNERX))) + + (* ;; "Resolve the reference point") + + [IF (AND (POSITIONP REFX) + (NULL REFY)) + THEN (SETQ REFY (FETCH (POSITION YCOORD) OF REFX)) + (SETQ REFX (FETCH (POSITION XCOORD) OF REFX)) + ELSE (GETMOUSESTATE) + (SETQ REFX (\RELCREATEREGION.REF REFX 'X)) + (SETQ REFY (\RELCREATEREGION.REF REFY 'Y] + + (* ;; "Align the new-region corner with the reference point") + + (LET* ((LEFT REFX) + (BOTTOM REFY) + (RIGHT (IPLUS LEFT WIDTH)) + (TOP (IPLUS BOTTOM HEIGHT))) + (CL:WHEN (EQ 'RIGHT CORNERX) + (SETQ RIGHT LEFT) + (SETQ LEFT (IDIFFERENCE LEFT WIDTH))) + (CL:WHEN (EQ 'TOP CORNERY) + (SETQ TOP BOTTOM) + (SETQ BOTTOM (IDIFFERENCE BOTTOM HEIGHT))) + (CL:WHEN ONSCREEN (* ; "Keep the region on the screen. ") + (CL:WHEN (ILESSP LEFT 0) + (ADD WIDTH LEFT) + (SETQ LEFT 0)) + (CL:WHEN (ILESSP BOTTOM 0) + (ADD HEIGHT BOTTOM) + (SETQ BOTTOM 0)) + (CL:WHEN (IGREATERP RIGHT SCREENWIDTH) + (ADD WIDTH (IDIFFERENCE SCREENWIDTH RIGHT))) + (CL:WHEN (IGREATERP TOP SCREENHEIGHT) + (ADD HEIGHT (IDIFFERENCE SCREENHEIGHT TOP)))) + (CREATEREGION LEFT BOTTOM WIDTH HEIGHT]) + +(RELGETREGION + [LAMBDA (WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) (* ; "Edited 28-Dec-2021 23:13 by rmk") + (* ; "Edited 10-Dec-2021 10:15 by rmk") + + (* ;; "Prompts for a relative region as created by RELCREATEREGION. Initially the anchored corner is fixed and the cursor is moved to the diagonally opposite corner. If MINSIZE, the WIDTH and HEIGHT are taken to be the minimums that are acceptable, modulo the fact that the opposite corner is guaranteed to be visibleand, the size of the ghost region can only grow. If not MINSIZE, we also allow the user to shrink the ghost region.") + + (CL:WHEN (AND (LISTP CORNERX) + (NULL CORNERY)) + (SETQ CORNERY (CADR CORNERX)) + (SETQ CORNERX (CAR CORNERX))) + (CL:UNLESS CORNERX + (SETQ CORNERX 'LEFT)) + (CL:UNLESS CORNERY + (SETQ CORNERY 'BOTTOM)) + (LET* ((REGION (OR (REGIONP WIDTH) + (RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY T))) + (BASEX (FETCH (REGION LEFT) OF REGION)) + (BASEY (FETCH (REGION BOTTOM) OF REGION)) + (RWIDTH (FETCH (REGION WIDTH) OF REGION)) + (RHEIGHT (FETCH (REGION HEIGHT) OF REGION)) + (OPPX (IPLUS BASEX RWIDTH)) + (OPPY (IPLUS BASEY RHEIGHT))) + + (* ;; "Default parameters assume the anchor is (LEFT BOTTOM)") + + (CL:WHEN (EQ 'RIGHT CORNERX) + (SWAP BASEX OPPX)) + (CL:WHEN (EQ 'TOP CORNERY) + (SWAP BASEY OPPY)) + (\CURSORPOSITION OPPX OPPY) + (CL:UNLESS MINSIZE (* ; "No minimum size constraint") + (SETQ RWIDTH NIL) + (SETQ RHEIGHT NIL)) + (GETREGION RWIDTH RHEIGHT REGION NIL NIL (LIST BASEX BASEY OPPX OPPY]) +) +(DEFINEQ + +(\RELCREATEREGION.REF + [LAMBDA (REF WHICH) (* ; "Edited 2-Jan-2022 11:01 by rmk") + + (* ;; "REF can be NIL, an absolute screen position, the atom SCREEN, or a list of (anchor fraction adjustment) where anchor can be a region, window, or the atom SCREEN, fraction can be a number or atoms LEFT/RIGHT/BOTTOM/TOP as apropriate.") + (* ; "Edited 30-Dec-2021 17:49 by rmk") + (LET (ANCHOR VAL SIZE FRACTION SPEC (BASE 0)) + + (* ;; "Would be nice if the screen had a region") + + (IF (NULL REF) + THEN (CL:IF (EQ WHICH 'X) + LASTMOUSEX + LASTMOUSEY) + ELSEIF (AND (FIXP REF) + (NOT (MINUSP REF))) + THEN REF + ELSEIF (EQ REF 'SCREEN) + THEN + (* ;; "LEFT and BOTTOM are 0") + + 0 + ELSEIF [AND (LISTP REF) + (SETQ ANCHOR (OR (REGIONP (CAR REF)) + (AND (WINDOWP (CAR REF)) + (WINDOWREGION (CAR REF))) + (AND (EQ (CAR REF) + 'SCREEN) + 'SCREEN] + THEN (SETQ SPEC (CDR REF)) + [IF (EQ WHICH 'X) + THEN (IF (EQ ANCHOR 'SCREEN) + THEN (SETQ SIZE SCREENWIDTH) + ELSE (SETQ BASE (FETCH (REGION LEFT) OF ANCHOR)) + (SETQ SIZE (FETCH (REGION WIDTH) OF ANCHOR))) + (SETQ FRACTION (SELECTQ (CAR SPEC) + ((NIL LEFT) + 0) + (RIGHT 1) + (CAR SPEC))) + ELSE (IF (EQ ANCHOR 'SCREEN) + THEN (SETQ SIZE SCREENHEIGHT) + ELSE (SETQ BASE (FETCH (REGION BOTTOM) OF ANCHOR)) + (SETQ SIZE (FETCH (REGION HEIGHT) OF ANCHOR))) + (SETQ FRACTION (SELECTQ (CAR SPEC) + ((NIL BOTTOM) + 0) + (TOP 1) + (CAR SPEC] + [SETQ VAL (IPLUS BASE (ROUND (TIMES FRACTION SIZE] + (CL:WHEN (CADR SPEC) + (ADD VAL (CADR SPEC))) + VAL + ELSE (\ILLEGAL.ARG REF]) + +(\RELCREATEREGION.SIZE + [LAMBDA (PARAM WHICH) (* ; "Edited 2-Jan-2022 11:00 by rmk") + (* ; "Edited 30-Dec-2021 17:51 by rmk") + + (* ;; + "PARAM can be FIXP or (region anchor adjustment) which determine size relative to the region.") + + (LET (VAL ANCHOR SPEC) + (IF (FIXP PARAM) + ELSEIF [SETQ ANCHOR (OR (REGIONP PARAM) + (AND (WINDOWP PARAM) + (WINDOWREGION PARAM] + THEN (CL:IF (EQ WHICH 'X) + (FETCH WIDTH OF ANCHOR) + (FETCH HEIGHT OF ANCHOR)) + ELSEIF (LISTP PARAM) + THEN (IF (SETQ ANCHOR (OR (REGIONP (CAR PARAM)) + (AND (WINDOWP (CAR PARAM)) + (WINDOWREGION (CAR PARAM))) + (AND (EQ (CAR PARAM) + 'SCREEN) + 'SCREEN) + (\ILLEGAL.ARG PARAM))) + THEN [SETQ VAL (CL:IF (EQ WHICH 'X) + (CL:IF (EQ ANCHOR 'SCREEN) + SCREENWIDTH + (FETCH WIDTH OF ANCHOR)) + (CL:IF (EQ ANCHOR 'SCREEN) + SCREENHEIGHT + (FETCH HEIGHT OF ANCHOR)))] + (SETQ SPEC (CDR PARAM)) + (CL:WHEN (CAR SPEC) + (SETQ VAL (ROUND (TIMES (CAR SPEC) + VAL)))) + (CL:WHEN (CADR SPEC) + (ADD VAL (CADR SPEC))) + VAL) + ELSEIF (EQ PARAM 'SCREEN) + THEN (CL:IF (EQ WHICH 'X) + SCREENWIDTH + SCREENHEIGHT) + ELSE (\ILLEGAL.ARG PARAM]) +) + + + +(* ;; "Composite application construction") + +(DEFINEQ + +(RM-ATTACHWINDOW + [LAMBDA (WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) + (* ; "Edited 29-Dec-2021 09:36 by rmk") + (* ; "Edited 28-Nov-2021 16:10 by rmk:") + + (* ;; "MAINWINDOW may not be the central window, could be attached to an attachment.") + + (* ;; "If the central window is under construction, we shrink it down so that the new attachment fits within the original footprint of the central window and all of its previous attachments.") + + (* ;; "This addresses the common situation where the user provides a region for the central window and the constellation of windows that will surround it, and the whole constellation is supposed to stay within that original bounding box, even as new attachments (promptwindows, menus...) are tacked on.") + + (* ;; "") + + (* ;; "A second extension: If WINDOWCOMACTION is a list, smash it into the PASSTOMAINCOMS. ATTACHWINDOW.ORIG only allows a few atomic-value options.") + + (LET (MIN (CENTRALWINDOW (CENTRALWINDOW MAINWINDOW)) + CENTRALREGION NEWALLREGION ORIGALLREGION NEWCENTRALREGION VAL) + (CL:WHEN (OR TAKEFROMCENTRAL (WINDOWPROP CENTRALWINDOW 'UNDERCONSTRUCTION)) + (SETQ ORIGALLREGION (ATTACHEDWINDOWREGION CENTRALWINDOW)) + (SETQ CENTRALREGION (WINDOWREGION CENTRALWINDOW))) + (SETQ VAL (ATTACHWINDOW.ORIG WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION)) + (CL:WHEN ORIGALLREGION + (SETQ NEWALLREGION (ATTACHEDWINDOWREGION CENTRALWINDOW)) + (CL:UNLESS (EQUAL ORIGALLREGION NEWALLREGION) + + (* ;; "Something changed, presumably the total region expanded, so something has to shrink to stay within the original region. We want to shrink the main window only, keeping everything else as it was. Hopefully, previously attached windows that wanted a fixed size on the relevant dimension have a MINSIZE that won't let them shrink. And hopefully the central window does allow shrinking, otherwise nothing happens.") + + (* ;; "It also could be that the region hasn't changed, if the new window hides in the shadow of a previously attached one.") + + (SETQ NEWCENTRALREGION (SELECTQ EDGE + (LEFT (CREATE REGION USING CENTRALREGION LEFT _ + (PLUS (FETCH (REGION LEFT) + OF CENTRALREGION) + (RFIELDDIFF LEFT + ORIGALLREGION + NEWALLREGION)) + WIDTH _ + (DIFFERENCE + (FETCH (REGION WIDTH) + OF CENTRALREGION) + (RFIELDDIFF WIDTH + NEWALLREGION + ORIGALLREGION)))) + (RIGHT (CREATE REGION USING CENTRALREGION WIDTH _ + (DIFFERENCE + (FETCH (REGION WIDTH) + OF CENTRALREGION) + (RFIELDDIFF WIDTH + NEWALLREGION + ORIGALLREGION)))) + (TOP (CREATE REGION USING CENTRALREGION HEIGHT _ + (DIFFERENCE (FETCH (REGION + HEIGHT) + OF CENTRALREGION + ) + (RFIELDDIFF HEIGHT + NEWALLREGION + ORIGALLREGION)))) + (BOTTOM (CREATE REGION + USING CENTRALREGION BOTTOM _ + (PLUS (FETCH (REGION BOTTOM) + OF CENTRALREGION) + (RFIELDDIFF BOTTOM ORIGALLREGION + NEWALLREGION)) + HEIGHT _ (DIFFERENCE (FETCH (REGION + HEIGHT) + OF CENTRALREGION + ) + (RFIELDDIFF HEIGHT + NEWALLREGION + ORIGALLREGION)))) + (SHOULDNT))) + + (* ;; "We want to reshape only the central window. We detach the new (just attached) window, do the shrinking, then reattach. If other attached windows get reshaped, that's par for the course. Presumably they are specified as fixed on the relevant dimension, or the user doesn't care.") + + (* ;; "Maybe this little wrinkle is solving a non-problem--if the user cares about whether or not the new window will shrink, now or with later reshaping, then he should have specified its own minsize property.") + + (* ;; "On the otherhand, maybe we should remove all of the SHAPEW's (or but in DONT) in the PASSTOMAIN coms of all the windows attached directly or indirectly to the central window, do the reshaping, and then restore.") + + (DETACHWINDOW WINDOWTOATTACH MAINWINDOW) + (SHAPEW CENTRALWINDOW NEWCENTRALREGION) + + (* ;; "Now reattach the new window") + + (SETQ VAL (ATTACHWINDOW.ORIG WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE + WINDOWCOMACTION)) + + (* ;; "This is a little error check for debugging, to catch cases where there might be interactions with other interfering strategies. If the new window turned out to be bigger on the relevant dimension than the original set up, then we simply have to relax.") + + (* ;; "If the new window is bigger than the original region on the other dimenion dimension, then we have to relax our requirement. We use ATTACHEDWINDOWREGION in case the new window is already a conglomerate.") + + (CL:UNLESS (OR (EQUAL ORIGALLREGION (ATTACHEDWINDOWREGION CENTRALWINDOW)) + (SELECTQ EDGE + ((TOP BOTTOM) + (GEQ (FETCH (REGION WIDTH) OF (ATTACHEDWINDOWREGION + WINDOWTOATTACH + 'REGION)) + (FETCH (REGION WIDTH) OF ORIGALLREGION))) + ((LEFT RIGHT) + (GEQ (FETCH (REGION HEIGHT) OF (ATTACHEDWINDOWREGION + WINDOWTOATTACH + 'REGION)) + (FETCH (REGION HEIGHT) OF ORIGALLREGION))) + NIL)) + (HELP ORIGALLREGION (ATTACHEDWINDOWREGION MAINWINDOW))) + (CL:WHEN (LISTP WINDOWCOMACTION) + + (* ;; "Maybe this should be done in the ORIG function--an oversight?") + + (WINDOWPROP WINDOWTOATTACH 'PASSTOMAINCOMS WINDOWCOMACTION)))) + VAL]) +) + +(MOVD? 'ATTACHWINDOW 'ATTACHWINDOW.ORIG) + +(MOVD 'RM-ATTACHWINDOW 'ATTACHWINDOW) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS RFIELDDIFF MACRO ((FIELD R1 R2) + (DIFFERENCE (FETCH (REGION FIELD) OF R1) + (FETCH (REGION FIELD) OF R2)))) +) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1602 3789 (SET-TYPED-REGIONS 1612 . 3787)) (3790 10791 (RM-CREATEW 3800 . 6307) ( +RM-CLOSEW 6309 . 7710) (RM-GETREGION 7712 . 10298) (CLOSE-TYPED-W 10300 . 10789)) (11707 16778 ( +RELCREATEREGION 11717 . 14876) (RELGETREGION 14878 . 16776)) (16779 21898 (\RELCREATEREGION.REF 16789 + . 19646) (\RELCREATEREGION.SIZE 19648 . 21896)) (21951 31293 (RM-ATTACHWINDOW 21961 . 31291))))) +STOP diff --git a/lispusers/REGIONMANAGER.LCOM b/lispusers/REGIONMANAGER.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..c2f03a9ee7e171392455d3c4571c0fbe3bde99bc GIT binary patch literal 7392 zcmb_h>yH~(758}a!ccWhOA4W_E-Qt43%l}+AM4$qbjJ30XYBEeGoDR$leEfiywu*L z$tp>K3Lyoxs1gsMv`w}&1&JaaYK7#uSt*aUmJokJO4<*6=m)+affBV}k@(%mymmLG z5?v|d`#AU9bIF0WX!ZZ-L=eiYm7YV>RQ#) z%GQSAvewp#oE=Z4GL%CFWS(9nV?>##FP@rEvWi0F;!IYaQHo7b^7??$^FkPcTO%pmzyl?f9AOf-r0Y$cXstz zM(XObreilX8)CYX`=+PI!AuT!RB|(g;!G}&9hS~42YW96VD-$|y)&e(dlTM5ORr9F zMs3oAG_^U)B2g}rlaphlvv>~DZoxgD9UK2lhyL6SNpf1?JS!EPQCUxNnF^ONF>!xPQA0H zcK3AmEG2%Sj?nH!be9t6)wH(F7+K%e9hDZO8)oumeegh?&cD`3r*||*){DI_zjZo+ zzeb9Fhm9}LpPTh#^k?_c^>5Z2dsutVLv&pCtlC1;E5L?JxoEI(s7QYyts zu#6N-WXwK&jx5Hf$l2B9Z8s@65a@{kH^QJIB zmK-wes&fd6r&QSa{I#;gxA^&X@6B3(K(*xvPM$7CI2G}(Rk=*ar6?%}0G z{}t)UknQiA>;LNY|7j)rAHl9L;H>T$TH7FU0UDX}xPGW=h@6)XU?q%W>_nBh>il+@wh5eKc%sn#aoER(PuerJpiA8wm2gN30ELM zl9v(*No6Kt=1WTnZqcic8lAzOZfHnO)McjYjV3ZUYupmKVyJegkx9U{C^IecJ)ta@ z8V-`?g&&96^Ge9#8S@4PiF>TYUIIazsK|fDy{SaqR zvo)7`6#Oe3LSJD^0+q?6Y1)Qv&Ke#jv$S`}ta=7i__J+^#Ex?367`>}BW0$s-RZPs zB-81U`pA0j0dxHU=1ls1aLGjCy0N~^95uN&g$ni^sQ(Y?2peSvdHdVyn%YPvrMqvB zX|HN%(dI)uWG*zq<-`83>dC|X3vd`^I<$m5#X*m7<|BD37x+Xmv{|9Z3G+Eh$PdoU zN8zsIebYq2SlSBBMc)W9G|TxoZkZt&Mns(ufE6C;F;mj`$E^q@mqsW~uin24`b(t0 zk@WLRh}^@22kYvcKd2+G)zybDnJiSX%yFAxmE(~hHsEw|D3U2cBP$mChXix~29nW)`41$(kqi`t_$8IC8=r%gkt!oQtP?gr^(a1sZ6q$68 zhA7&m<1&c=&PUt7fwr9yhh0i&p$?Xk3Bd=H9EGMNUG$qVbnQmU! z->fE=Qp2jWw5z|D>2=8S1jF6ZuAv@b3_3tsziy}>q@|>(;X6`h^LJh`4yzwttB8(y zMEmf1ZBSk@?yjlEEhLkbYb)m6HO;)WlpL;HuQSBnz06Zj{X+f*1yflToMloWh`*^bE5K7r^L5dUZf%OUM>n_(1y=eGhW&pPY(^FZ0V4=ds5C?uupMpC+AAne`5Cn>#SHUPfu zbqn7e0)j6$&3CU01ioz7-@DPY8Hj7Y>mE6JzF`^Nj#+Qo-97l@F&LRc(hkNUVmC=zmt|V@#5(^3IW1{h@Kaf@>PI+}F`&|I_ z&(-9Ug8LwE3Qm`XY>S^r*Gy`urqo#zGcONU`aE9U85B?S3maCvm}E=hYhD_z{8UJI z;>S(t9m8t;jY;^y;bv00*um%4XnmAph6V^)`kR)e&uZ2r&F9oRU1!d&lBvRm3U5mE z;U|8zMs2BNk)fzJqB<0wC*#Ht^JrWS#Q+LX0D(I#T$MX0Y##G>Ii$vYW1a;5Pf9)| z^>e<4C~iepJ85wuVM(OeROrKP!A6L9$mIW?Ki z(yJVK=}O`@$AHl4RZ-b5489_a{R*}0C_ebA9g3Uh1#HGQ!se@LN8sktklFDC#(Uwa z;{)eG9|nW3bL8}Q`y&EM&(n?O)#Tw$N4h-hNCrp1wK@P`;B#x#808olYzg)d9MrR; z;E;g{4h|Y{V^gSTco`rHzW_bBI{Otr+!NYlH#9+o{K5Nxk6*PjOraM8kb-~_g$N#R zfD0KBUw}YHPKd3L^8r-oZ6dl@RziFMYT%QVeLf*ac!o$B%?Zu(w2Hw+^#f2*M3@4t ze=EA}xtb-8MH2|U1!-0|!ph|601B23i&&}50+pB%8`9Fp(;9lsb(&%Zz|0HPRh*^> zf3zU-L$G7(RlJkYx=1v@U8A+PxFGvi8PDN|8z<7AccLEG7~s;2JM_2s1(fB3UmI-r z9sYA8a>ISfdgF@peLjBEYJBq26{%Mi5o|CqtV@>Eklw!q+|>a~T8~@!_x}6nv7uy= z=9VjoH37-Jbr60kZU02TKLh@Pn(<>rKKT0^Fy8%rg7qXLwx|?LBECPBi3t^3^a88v z-c>br{Grk0zmbE#XYoUS@^()o(>DXT9vMaoP0n5V&&S<6-8=nBF3g|An!zJ6N+AfR zJ>PrX;^yF+S4S>$;wrmK+Vn1o;1|D4=HV%ZZUKUb%iOejm0Mk)GdDGTkBQvWJtpqO zN|`Q-6?_MNYgK5JHnbM*(F(5nRXyT73SNTRhBIeXZI2Z0AxPerBgz#{96JUsBwHR& zVUHf1)W0*sfnqL&w3SDqXld;>ZX9q6I8mGAkhXjs6%mejWm1^pSt^Hm(w{|O^ovXx z4^+s03Ia)x{c!oB2@$s8JiwPHx*|bl)m=QbwLN!^6)mjL$>3Sh^A;dQ%f-vK*hf4f zQ`tb}wzLBWHqVeu=5exb9~twWTg7YendPVPl6H1%oMhOU*emR&M_A0#*V)Kx8+&=< zZyy*9tGn1u6U*pxz(Eaf0h!oq$~dNGEvKwmY%)GaGF81|X|BF^CPj3lRh1qTPx7Sd z*mzt(?VWLTT;Hng*j-l~R$Pba7IgQ|KuPF}ZKmlQtUf_92j(1HTg2lOc*Oero{rHt zF;hfH8@|X;Ap~iPGYV7{kOw0%=KjW^&VvQMY=XB>8JZ-dSQ57}_YY^tMZNxo^27FWTpsj&+FXXW(S-nnJ6xVm~$y!Mjg z!0EX&&mQMbzfrv6K+%i~@i&@t!?dtPbo5@zkJ1FniVaf11Hi`cnu-7xN!NAYLN!yj zs#UXAqk0x@`a}%I)OjPm!DC3|857fR(76_U3DsOzgEw$!ZKfo)X>G|Z^0@TB*hNVN zzc~2W|C1dGbR*Cy^qKPEFWl%;JY@rE6iFLgC&oKCeehoa8%3dNrXoivw~}KEx=#_p crw&3!3>5xe(ZPF(9i<6mj}4BeV93;e0nl0^CjbBd literal 0 HcmV?d00001 diff --git a/lispusers/REGIONMANAGER.TEDIT b/lispusers/REGIONMANAGER.TEDIT new file mode 100644 index 00000000..70961946 --- /dev/null +++ b/lispusers/REGIONMANAGER.TEDIT @@ -0,0 +1,59 @@ +Medley REGIONMANAGER2 + 4 + 1 + REGIONMANAGER 1 + 4 + By: + Ron Kaplan This document created in December 2021. + Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications. +The REGIONMANAGER package provides simple extensions to the core region and window functions. These are aimed at giving users and application implementors more flexible and systematic control over the specification and reuse of screen regions. It introduces three new notions: +A "typed region" allows the regions of particular applications to be specified, classified, and recycled according to their types. +The size, location, and orientation of a "relative region" is specified with respect to particular screen points and the location of other windows. +A "constellation region" encloses the collection of satellite windows (prompts, menus, etc) that surround the central window of an application. +REGIONMANAGER is innocuous in that explicit user action is required to change the default behavior of any system components. + Typed regions +REGIONMANAGER adds overlay veneers to the core CREATEW, CLOSEW, and GETREGION functions to make it easier to predict and control how different applications arrange their windows on the screen without always needing to respond to a ghost-region prompt. +The REGION/INITREGION arguments may now be region-type atoms in addition to either NIL or particular regions as CREATEW and GETREGION otherwise allow. The type-atom will resolve to a region drawn from a predefined pool of regions associated with that type, if the pool has at least one that is not currently allocated to another window. If the pool has no available regions, then the pool will be enlarged with a region that the user produces from a normal ghost-region prompt, and the type-atom will then resolve to the newly installed region. +A typed-region is marked as "inuse" and therefore unavailable when CREATEW assigns it to a window, and the extended CLOSEW marks it as again available when the window is closed. +An example of how an application can take advantage of this facility is the TEDIT-PF-SEE package. This provides lightweight alternatives to the PF and SEE commands that print their output to scrollable read-only Tedit windows, specifying PF-TEDIT and SEE-TEDIT as their region types. The user can predefine a preference-ordered sequence of recyclable regions that bring up multiple output windows in a predictable tiled arrangement, without region-prompting for each invocation. +The global variable TYPED-REGIONS is an alist that maintains the relationship between atomic type-names and the list of regions that belong to each type. The list is ordered according to preferences set by the user, and a type-atom is always resolved to the first unused region in its list. If the user is asked to sweep out a new region, that region is added at the end, as the least preferable. The function SET-TYPED-REGIONS is provided to add or replace TYPED-REGION entries. +(SET-TYPED-REGIONS TYPELISTS REPLACE) [Function] +TYPELISTS is an alist of the form +((type1 . regions1)(type2 . regions2)...) +where each regioni is a possibly empty list of regions. For convenience, if TYPELISTS is just a literal type-atom, it is interpreted as ((type)), and if it is a list (type . regions) begining with an atom, it is interpreted as ((type . regions). The new regions replace preexisting regions if REPLACE, otherwise they are added at the front. +Typically, a call to SET-TYPED-REGIONS would be placed in a user's INIT file to set up the preference order for the regions that the user wants to participate in this reallocation scheme. If an application uses a type that is not on TYPED-REGIONS, then that type-atom is treated as NIL and always gives rise to the normal ghost-region prompting. Thus a user will observe no change in system behavior if TYPED-REGIONS is left with its initial value NIL. A type that is added with an empty region list (as opposed to not being on the list at all) will allow new regions to accumulate for recycling. + +Relative regions +Two functions are provided to make it easy to create regions relative and oriented with respect to a specified reference point. These may be useful for constructing an application that includes a constellation of windows arranged in a particular relative way. +(RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function] +RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen. +WIDTH and HEIGHT can be given as absolute (natural) numbers) or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows: +natural number: the number of screen points +list of the form (anchor fraction adjustment), where anchor is a region, window, or the atom SCREEN. The corres-ponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying ( .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively. +region/window/SCREEN: equivalent to (region/window/SCREEN 1 0). +CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be splayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left. +The reference-point arguments REFX and REFY are interpreted as follows: +NIL: LASTMOUSEX/LASTMOUSEY +natural number: an absolute screen coordinate +(anchor fraction adjustment) or just region/window/SCREEN: the quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification ( .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region. +For convenience, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY. + +(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function] +Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen. + +Constellation regions +Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region. +Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window. +An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window. +REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment. +(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function] +This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions.(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ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADTERMINALÿüTERMINALÿü +TIMESROMAN$TERMINALMODERN MODERN +  HRULE.GETFN  HRULE.GETFNMODERN +  HRULE.GETFNMODERN + + + HRULE.GETFNMODERN   HRULE.GETFNMODERN   (È„•‘}/ ¯[ ChT Û Á?  + +; 3o) MA &MmJS- +j /3t2C ƒ "= , l¬™¤Ç S~ æ- 4!U™Î(N!zº \ No newline at end of file diff --git a/lispusers/TEDIT-PF-SEE b/lispusers/TEDIT-PF-SEE index 02a16940..1d2819e7 100644 --- a/lispusers/TEDIT-PF-SEE +++ b/lispusers/TEDIT-PF-SEE @@ -1,143 +1,123 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Oct-2021 19:23:40"  -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;32 7178 +(FILECREATED " 2-Jan-2022 22:03:27"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;104 6489 - changes to%: (FNS CLOSE-TYPED-WINDOW) + :CHANGES-TO (VARS TEDIT-PF-SEECOMS) - previous date%: "12-Oct-2021 22:31:01" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;31) + :PREVIOUS-DATE "30-Dec-2021 23:17:58" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TEDIT-PF-SEE.;103) (PRETTYCOMPRINT TEDIT-PF-SEECOMS) -(RPAQQ TEDIT-PF-SEECOMS - [(FNS SEE-TEDIT PF-TEDIT) - (COMS (FNS GET-TYPED-WINDOW CLOSE-TYPED-WINDOW) - (INITVARS (TYPED-WINDOWS))) - (COMMANDS ts tpf) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA]) +(RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT) + (COMMANDS ts tf) + (FILES (SYSLOAD) + REGIONMANAGER) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS + (NLAMA) + (NLAML) + (LAMA]) (DEFINEQ -(SEE-TEDIT - [LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 11-Oct-2021 08:51 by rmk:") - (SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX)) - (ERROR "FILE NOT FOUND" FILE))) - (TEDIT-SEE FILE (GET-TYPED-WINDOW (OR WINDOW 'SEE-TEDIT) - (CONCAT "SEE window for " FILE)) - FORMAT) - FILE]) - (PF-TEDIT - [LAMBDA (FN IFILES) (* ; "Edited 12-Oct-2021 15:22 by rmk:") + [LAMBDA (FN IFILES REPRINT) (* ; "Edited 30-Dec-2021 23:17 by rmk") (* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.") + (* ;; "This uses PFCOPYBYTES so we see what it looks like on the file. But some functions were not prettyprinted, so they appear as useless garbage.") + + (* ;; "In that case, calling again with REPRINT=T will read and reprint. And, invoking tf again with no arguments at all will also reprint the last function in the same window") + + (SETQ IFILES (MKLIST IFILES)) (CL:WHEN (LISTP FN) (SETQ FN (CAR FN))) - (IF FN - THEN (* ; "FN name specified; use it.") - (SETQ LASTWORD FN) - ELSE (* ; "Not specified, use LASTWORD") - (SETQ FN LASTWORD)) + (SELECTQ FN + ((t T NIL) + (SETQ REPRINT T) + (SETQ FN LASTWORD)) + (SETQ LASTWORD FN)) + (CL:UNLESS FN (ERROR "No function to print")) + (CL:WHEN (INTERSECTION '(T t) + IFILES) + (SETQ REPRINT T) + [SETQ IFILES (LDIFFERENCE IFILES '(t T]) (IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T) - (WHEREIS FN 'FUNCTIONS T] - THEN (* ; "skip compiled files") - (FOR IFILE LOC TSTREAM ENV INSIDE IFILES - UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION) - *COMPILED-EXTENSIONS*) - DO (SETQ LOC (FINDFNDEF FN IFILE)) - (IF (LISTP LOC) - THEN [CL:WITH-OPEN-FILE (ISTREAM (POP LOC) - :DIRECTION :INPUT) - (SETQ ENV (LISPSOURCEFILEP ISTREAM)) - (SETFILEINFO ISTREAM 'FORMAT ENV) - (SETQ TSTREAM (OPENTEXTSTREAM)) - (DSPFONT DEFAULTFONT TSTREAM) - (PRINT-READER-ENVIRONMENT ENV TSTREAM) - (PFCOPYBYTES ISTREAM TSTREAM (POP LOC) - (POP LOC)) - (TERPRI TSTREAM) - (SETQ TSTREAM (TEDIT TSTREAM (GET-TYPED-WINDOW - 'PF-TEDIT - (CONCAT FN " from " - (FULLNAME ISTREAM))) - NIL - '(READONLY T] - ELSEIF (EQ LOC 'FILE.NOT.FOUND) - THEN (printout T "file " IFILE " not found." T) - ELSE (printout T FN " not found on " LOC "." T))) + (WHEREIS FN 'FUNCTIONS T] + THEN (* ; "skip compiled files") + + (* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.") + + (FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES + UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION) + *COMPILED-EXTENSIONS*) + DO (SETQ LOC (FINDFNDEF FN IFILE)) + (IF (LISTP LOC) + THEN (SETQ TFPROP (LIST FN (CAR LOC))) + [SETQ WINDOW (FIND W IN (OPENWINDOWS) + SUCHTHAT (AND (EQUAL TFPROP (WINDOWPROP W 'TF)) + (WINDOWPROP W 'TEXTOBJ] + [IF (AND WINDOW (NOT REPRINT)) + THEN + (* ;; + "If already an open PF window on this function in this file, just raise it to the top") + + (TOTOPW WINDOW) + (RETURN) + ELSE (CL:WITH-OPEN-FILE (ISTREAM (POP LOC) + :DIRECTION :INPUT) + (SETQ ENV (LISPSOURCEFILEP ISTREAM)) + (SETFILEINFO ISTREAM 'FORMAT ENV) + (SETQ TSTREAM (OPENTEXTSTREAM)) + (DSPFONT DEFAULTFONT TSTREAM) + (PRINT-READER-ENVIRONMENT ENV TSTREAM) + (IF REPRINT + THEN (SETFILEPTR ISTREAM (POP LOC)) + (SETQ EXPR (WITH-READER-ENVIRONMENT ENV (READ ISTREAM)) + ) + (IF (EQ FN (CAR EXPR)) + THEN (DSPFONT BOLDFONT TSTREAM) + (PRINT FN TSTREAM) + (DSPFONT DEFAULTFONT TSTREAM) + (SETQ EXPR (CADR EXPR)) + (PRINTDEF EXPR 3 NIL NIL NIL TSTREAM) + ELSE (PRINTDEF EXPR NIL NIL NIL NIL TSTREAM)) + ELSE (PFCOPYBYTES ISTREAM TSTREAM (POP LOC) + (POP LOC))) + (TERPRI TSTREAM) + [TEDIT TSTREAM (OR WINDOW 'PF-TEDIT) + NIL + `(READONLY T LEAVETTY T TITLE ,(CONCAT FN " from " + (FULLNAME ISTREAM] + + (* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.") + + (WINDOWPROP (WFROMDS TSTREAM) + 'TF TFPROP) + + (* ;; "Remove this when TEDIT honors the TITLE property") + + (WINDOWPROP (WFROMDS TSTREAM) + 'TITLE + (CONCAT FN " from " (FULLNAME ISTREAM] + ELSEIF (EQ LOC 'FILE.NOT.FOUND) + THEN (printout T "file " IFILE " not found." T) + ELSE (printout T FN " not found on " LOC "." T))) + (SETQ *LAST-DF* FN) ELSE (PRINTOUT T FN " has no function definition" T]) ) -(DEFINEQ -(GET-TYPED-WINDOW - [LAMBDA (WINDOWTYPE TITLE NOOPENFLG) (* ; "Edited 11-Oct-2021 10:06 by rmk:") +(DEFCOMMAND ts (FILE WINDOW FORMAT) + (TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX)) + (ERROR "FILE NOT FOUND" FILE)) + (OR WINDOW 'SEE-TEDIT) + FORMAT)) - (* ;; "WINDOWTYPE=T means always create a new window. If a WINDOW, then reuse it.") +(DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES)) - (* ;; "Otherwise, create a window of type WINDOWTYPE, using a previously specified region if one is available.") - - (LET (WINDOW REGION WLIST) - [IF (OR (EQ WINDOWTYPE T) - (SETQ WINDOW (WINDOWP WINDOWTYPE))) - THEN (SETQ WINDOWTYPE NIL) - ELSE [SETQ WLIST (OR (ASSOC WINDOWTYPE TYPED-WINDOWS) - (CAR (PUSH TYPED-WINDOWS (CONS WINDOWTYPE] - (SETQ REGION (FIND X IN (CDR WLIST) SUCHTHAT (TYPE? REGION X] - (CL:UNLESS WINDOW - - (* ;; "Make sure we have a titlebar and promptwindow") - - (SETQ WINDOW (CREATEW REGION "" NIL NOOPENFLG)) - (GETPROMPTWINDOW WINDOW) - - (* ;; - "Replace the region on WLIST with the window, so we can maintan a likely preference order.") - - (IF REGION - THEN (DSUBST WINDOW REGION WLIST) - ELSE (NCONC1 WLIST WINDOW))) - (CL:WHEN TITLE - (WINDOWPROP WINDOW 'TITLE TITLE)) - (CL:WHEN WINDOWTYPE - (WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE) - (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CLOSE-TYPED-WINDOW))) - WINDOW]) - -(CLOSE-TYPED-WINDOW - [LAMBDA (WINDOW ALL) (* ; "Edited 16-Oct-2021 19:23 by rmk:") - - (* ;; "Puts the region of WINDOW back on the region list for its type, for later reuse. If ALL, closes all windows of the type of WINDOW (and recursively puts their regions also on the list).") - - (CL:WHEN (OPENWP WINDOW) - [LET [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE] - (CL:WHEN WINDOWTYPE - (IF ALL - THEN (FOR W IN (OPENWINDOWS) WHEN (EQ WINDOWTYPE - (WINDOWPROP W 'WINDOWTYPE) - ) - UNLESS (EQ W WINDOW) DO (CLOSEW W)) - ELSE - - (* ;; "This may no longer be needed, now that TEDIT removes the process for READONLY windows just as for ordinary edit windows.") - - (AND NIL (CL:WHEN (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS)) - (* ; - "Otherwise, the window pops up if you don't click away") - (TTY.PROCESS T))) - (DSUBST (WINDOWPROP WINDOW 'REGION) - WINDOW TYPED-WINDOWS)))]) - WINDOW]) -) - -(RPAQ? TYPED-WINDOWS ) - -(DEFCOMMAND ts (FILE WINDOW FORMAT) (SEE-TEDIT FILE WINDOW FORMAT)) - -(DEFCOMMAND tpf (FN IFILES) (PF-TEDIT FN IFILES)) +(FILESLOAD (SYSLOAD) + REGIONMANAGER) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -147,6 +127,5 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (843 3913 (SEE-TEDIT 853 . 1263) (PF-TEDIT 1265 . 3911)) (3914 6866 (GET-TYPED-WINDOW -3924 . 5397) (CLOSE-TYPED-WINDOW 5399 . 6864))))) + (FILEMAP (NIL (956 6010 (PF-TEDIT 966 . 6008))))) STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM index f5f8a508e87e244a8b051a6cce917b041eb588db..45be05d1a6f87b8125540805fd6664678dbbdb66 100644 GIT binary patch literal 3547 zcmb_f-ESMm5hp1(ZfIAa6xA?{z!(rUKoX(A``~8^fhXRcdCKwje0S8@MF2x0rI3hB zDUu8{XbTi*|AF?QeRqHs=#wo&KvSUQYmGkVC4Yq<`rPEVdv_G;xIiBw2)Da4yEC)1 zGrt*@OlH|Gt6H|hsL#3vdAxv4) zsCDX%j;2Gy{^`L&=fTfUPS5UjXm)%)na)0;DQvKYjzi05H#awnG~PRhjc<{u*NWx; z>#E<|)u^Gj+SKXw4fj3^sv)P+uHgriUv@%|4}vmvJfH2_d>B+syaE-qTGc!liAPXK z)jCSEQ*V8LPS?tLynwXAsMTr;b<9@2ylw z3tEfVL(d1XP0ZcJsMN@E#i$UX-xxZf#obU4R1!AxNX#|znKV}{bP6rp#1r#6ZF9#= zk2DCk*Xw1<4t{VmlZ{s2&ERjeK95#E5wmFhh8X5Q6yH&P9^D$|B_Uc*CwDG>8LjSS zcXOkg^OX0F*t3?+^k3mW*MD^l|7+K-CF0lDM}>K`5f!qpFO=wRDrh5}EOZod*-_zW zWilQQeA4az?ughCZ`A^=-7BVGG)#&5FE-)x0O=*!g4C4oqZ=vChdfe?9 zVAfhBQdx$diiC+QpAXD{)Ry|jDYaR<;x;sr5lm`bNoA>eV@Xy`?C=o?q_i94Sv~GO z+I|$WfRv_AGC&YSh>G^oLa&h-crrv3O^F$ZF7=9vd=a5fjTQwg6xiv7KIw^&s^Brd zig>ks?hY8jb4jM!Chmd89;T5GKP6%$h9eCC+W{Z?J-|C;1GLmOg4hm$;A#^oV*wJ> zl%V1OGj>@RJ_20Vq-orBut4OeSx(J{WV~UQ0&gJ|jSxEU4hmqC4o{DtU{tmC)#|_D zLXF|VLRMd8s*>hXW;K(`WIP!v4`g5<7?7?#r_*zIz@Vy59b=pOLhF^}SSWxakt8tW zN`VIih(KzlS?&QZlDzf+BN8SAObM6}=#+ZbBUR#xKqOoE6KJF^-~o{lQv(T7F|^=- z5rh%<%@|86Vp%mU0a);91&HlIkXgkWGB>cf8&rTHuWqhnR*dn=7vtYe?(FBfiv^1sT!Y%Mp;0Zub zr~52{*kK?HN68ae{1z$<4tdDE2*6mE=VNFVz*r|Vm8RuNWNb8Ozy{kAB1Q5DjJ9m% zm`KwWeQbD8ZK_yk6!n?UY)Al%r1O?Wj%iyKIBt&-q{+TCKvRLNA(+g3pZmZ8O%r+@ zw(0V4)8a$dMA1lbg48x1V5wn2W7^WGW4kCSfJF3IrtK#}Rk%^0E8pJ1^+oZA^-z@N zDhzC*M!3?1fN+1yMXgcjT!5gitAM@9-WfVgI(#}Colnv3jt>r}v#FRCNylA_=rgr8 zM$wPb;qlX1(iLkcN=rnsO$X%=eKY9I7M0Ekut$v=l|pC~Rio%GX*xfqlhf(!T(qia z2?6Q?ZA9mVOI>x&vT4khe9w6B;5!T|mBf`&hn1;>?E}L_Nj*QK^Ft7Xs{<+pj{=7q zW*K;R9}j{(`0?O_Z?c|a_zVqq-b8=Jb`7U1c9O~EJb^$g-B46j)L)5-zU*&HhH1tV z*D(eL~Q zL!}2pw5-sFdE8|S?@;(qxG(-dIhADC;THsi5h4y%5D{0Das(U7l4ddy2ovIV8QjFW kH?D99^IY0YstIJI?ic;4EIfg@wRF7na+J^YC(q8tC&K|vPANy(Us%zjU%ubH7@l8j z{p9HEbkFsIdZU0OAKV`C#ngQH8B zd-FoPy*s6c1u!=H{P&oB4_(9EgY zbx1U=uB-Ku`t^lCEo2dkA_s=*RxO)%NTZe?cFdR@QYmq?LnRVODUk9bMNu-1(F8B$ zo8mG1Hjf)wF?pg4%-OxCVz?sZPur~Bc%bCVRgzG^*;H0($Bu8t)u>R@_nNRlGsq4@ zKO|L!0iMNx?>TY1XdlG37dgHcA)b1fmiNGvj1uL<<{ytw2a}KKcybQhsx_bmmmtrN zamTJ_<)}h=&vB(W;z{vAjJJFg3R!@aO*KoUk}5sqnH`%Vr(R$0dcr-$AoOFq8Lz`( zCHbN0+NReHio%i6I<+8=qZnD%!B{2NZ{n?yvy|y%d;5?XgoE@dMrA^Zn_V|<`5vr= zp)C*I|CMr2Nrm4K{_WqLhwSKx9Xo%Mh044eu)F6`@(zQ&)Ly!u=EwY7LTeuI4)cK5 z?{lQ&ro0ueml0<5zQXFG{+sjf-%TNaDqQ)vvk#Jq5g0XbpIR#24&`Qf5z0+K2)WAc ztBN&Y5IR&bC}=hP;Bfmewj(ky4Z&bV!CZD&gj<}@_c}J5pjXI>0``YiAwPf&fl7R+ z!S!}5!pn46Cc%J_-wm5!O4km63S{9ToTM5F$^}}~5?~+>^gZ{G;sVtSz=e*_C(j6M zu~;N9ph*mfh+aoel~F@@?kj0UkzUILkp7{tvCHn09RNmsk2_7 z)Vuf6O1d$~{66(W`9q_BfBxIv{U^%YoW0**c#LJ3gZ&^k=NX4?c3dmcGj~-jg34 zo_qXRVDYW1PgwG5`ok3?=8iOGzABTJ&HwuEaboq2ue<+iMODdbwIyP;s>G;DT18{D zVpLwrjHOJ!UIH2uu!f?#{9IbdM0r>s1eL6Eomv%jiC9TMs!?U&ld9>G4?WNXa?qfT z-Ps0`!5xUPNV1k=yB1Xi*K(#I=cEmlQZg_$>9H9gk1S0jUaxJ3wiA)AErtN8D$*7^ zZh$m5m^4YPA`2MAq?Ri;EYy%#_~>{+7t8=6t6NS8ZUjxkHjS2~O?nM%;PICTjs&|2 z9>)kIjry$_c+=_R65Rd#G-*6E!Qj_IsHvNf9HTXXyi&$vbaVj)I(~lIzZ|1m84Qod zr(-chBHyYrT=7JL9Uzr(YbG?2RH3~iOb(Fd%L=HWZV1w8xjS4MV<$!}5u7hoL}$Xp zz1pHgAceoZky0{irF3Kb>Msq3@xhA`GVJQ@M)$k3Y-9AW`>>x)eUM&TyYnbBD~!JL zvi)h~FnCAX%)ke{Z0=08wzJFVzfx0=PwsI3Ouy&;ZjjO+yhvweUygr0AH8sA{~TZa z<5BvJzzUIRFJj`*xqiG zI89g#rc=xMY6t}EI5q-L$jcle|6g`UVvn;{!pt!gTxz1JybdkG3i4g)JVjVP%A~-X z9GGb=sgfPNmQvc&ra4u)Ag`^Zoy_cww-B$-+Pmyt)_V2H?x6AN&q-XJ!8BTmR+fmJDuMC)@~rz};3m(het zRd#^7>Q8*de-PSnd?+f2sLrzBC!IWmB6Y*S+}peLf%4qzE}OF@TNEfS7RpxmR$|_c z7xc4^=fwMFh($MJQIMN;OwWqw55aDCIljK@he(lEi=9{ZI6D?zO3FJ7So9;{%!RO!MHid>4`s?&n*aa+ diff --git a/lispusers/TEDIT-PF-SEE.TEDIT b/lispusers/TEDIT-PF-SEE.TEDIT new file mode 100644 index 0000000000000000000000000000000000000000..56fd89349088c97348429d57670fb65ed8e9a61b GIT binary patch literal 4021 zcmeHI&2HO95T+F;P2?K=L7EmV3QW-eB>_v2RmE|NUTAA&GoeV8q~fGS4;yL~v873Z zq->~%-g?Ok^j-P{d7M5%XLd%V=;@x>Q=ypR?wM@IzD6l z_V%E?z1!YiH_|&=4_4m+w82Xgc*L`qC)>dyDqxm|%Ttk*5axoHVg^wH4|%fW`3m~I ze!q*!$ghl&6=Xd8l|L82XR`u$T#7v5WppNRJB4x~U@`)p%mAT4n4X^E8n+g_ge*^I z%TSP0lta2Kvt>!8iZD;(m_LgJVEtJqP2v?u^l%;}v-G@xoMTW_UJD5^;V}n&((?4*ERBcwNk*(wOVZBrKyeF(lHmfVIs+7s6;`1i)zO90r!_0O%vj zX13)A2Ch9e@hpdyS3W;gr~bK}sFim{pa zQrFzU!<7r*P>76UCq&g89>-}Y`6Bp&hl{l`T>uN~5NtmHBri!N1831p%yy_y0w>4J zW0p_5%K~Xf0#(Kf$P)1m{IV=c;DrJ*8Fk@cMYZ@cE-!rL@gQ6v#t>zJ>cG|)(P@Ts zhG`aIg?XNy%77wW<|qX^Ypol_cu}GTPIurLX=4smuL)vsxf0q)FN#AtPcCG~#f)Tt zyOrSN>E_G0mK=3!oe#;uxj?Y0N1`lOohB2Qagpv2mPQVk`qgf(XOmJw8e@(vi;^>< z2x-UG#W6f1iPx#ys13;w=qHvlbWeDIbtK8ljkH< zr7~iOgB=wata00IuTLRV7nj38Ag@PwvBsuj9%0RDrtH*IHrmR?b9rSX(0P4ZNmqD@ z%2h_wrlW*Y&7A5j7eyxUj-QEmg;ybXF(@;I$^_(Lg7P*V+E){hKq6d4Y*k!xG7<&0d= zP0u{A4h`@F(+e!;h@!rRT?6zU^k8qd5BDGR@lBU8bw1CuUH6d>`VUic2#3rG@JbI2 zI6OAJYR8{a(L>Lg1enNj9$UV3fP!*IBOKB;I}9cWA&~DA&kfMPhH96P?)G40jxGBs zjNKvg9B>~q&$gT@LEu@Bm^)SBQwKeoJ@#Z`IzG)$?DNz%QCqed;Rs;fISIhpkxhQ9_+#3-X84rdMdqvk#9sR`oE*`9gU#B zyNys^&9`_P4MUFH>)Lf~K&y?H+I#eKZ4mB7zS9_to z*x1)@ypcDBZnhB5e?AXs7m>*468bHgIMpQ6w${d&^1kAGQ`^)&)7pVGX1?d*zpZvx zd9^g{j&>9OE5?>%+S<(~_O^CIjd|_;#`D6~Zv1G`!ftD_3mP?en{0Hx7QSvBdsCZr zk618r$SxUBhi_f!w4q&H=IsO$r4pawwx!YUWt{5}E>2%zuLG|-;QtE5maAUXT_A%j zQyb{0-{42~N5Q+)IP&=Wvd3LAP_nNs?|fbxB){bH<-aT+*B0VZrjhvw6Wt(b`IHu~ zSbDXEl1iUxZE5m+SX-Jrf7F%+k5yYJ37t;Dkx47Vo!W!y%SvC=773JmDNy3OMGLar zrUgZOKnt?Sl4Oz2WNBL6ApQicGK#ik6n#^G2sgRF!CZFFc MpX+~W?r(qn1HX%P)Bpeg literal 0 HcmV?d00001 diff --git a/lispusers/comparetext b/lispusers/comparetext index c30a95ef..b7804763 100644 --- a/lispusers/comparetext +++ b/lispusers/comparetext @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Dec-2021 10:37:46"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;20 39405 +(FILECREATED "30-Dec-2021 21:22:01"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;100 48929 - :CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS COMPARETEXT) - (RECORDS IMCOMPARE.CHUNK) + :CHANGES-TO (FNS COMPARETEXT.TEXTOBJ) - :PREVIOUS-DATE "19-Dec-2021 12:45:35" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;19) + :PREVIOUS-DATE "27-Dec-2021 15:56:54" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;98) (* ; " @@ -17,132 +16,296 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (PRETTYCOMPRINT COMPARETEXTCOMS) (RPAQQ COMPARETEXTCOMS - ((FNS COMPARETEXT IMCOMPARE.BOXNODE IMCOMPARE.CHUNKS IMCOMPARE.COLLECT.HASH.CHUNKS - IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH IMCOMPARE.FIND.TEDIT.TEXT.OBJECT IMCOMPARE.HASH - IMCOMPARE.LEFTBUTTONFN IMCOMPARE.LENGTHEN.ATOM IMCOMPARE.MERGE.CONNECTED.CHUNKS - IMCOMPARE.MERGE.UNCONNECTED.CHUNKS IMCOMPARE.MIDDLEBUTTONFN IMCOMPARE.SHOW.DIST - IMCOMPARE.UPDATE.SYMBOL.TABLE) - (P (MOVD 'COMPARETEXT 'IMCOMPARE)) - (INITVARS (IMCOMPARE.LAST.NODE NIL) - (IMCOMPARE.LAST.GRAPH.WINDOW NIL)) - (RECORDS IMCOMPARE.CHUNK IMCOMPARE.SYMB) + ((FNS COMPARETEXT COMPARETEXT.WINDOW COMPARETEXT.TEXTOBJ COMPARETEXT.SETSEL CHUNKNODELABEL + IMCOMPARE.BOXNODE IMCOMPARE.CHUNKS IMCOMPARE.COLLECT.HASH.CHUNKS IMCOMPARE.DISPLAYGRAPH + IMCOMPARE.HASH IMCOMPARE.MERGE.CONNECTED.CHUNKS IMCOMPARE.MERGE.UNCONNECTED.CHUNKS + IMCOMPARE.SHOW.DIST IMCOMPARE.UPDATE.SYMBOL.TABLE) + (FNS IMCOMPARE.LEFTBUTTONFN IMCOMPARE.MIDDLEBUTTONFN IMCOMPARE.COPYBUTTONFN) (FILES (SYSLOAD) - GRAPHER) - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) - GRAPHER)))) + GRAPHER REGIONMANAGER) + (FNS TAIL1 TAIL2) + (* ; "Debugging") + (INITVARS (COMPARETEXT.ALLCHUNKS T) + (COMPARETEXT.AUTOTEDIT T)) + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS IMCOMPARE.CHUNK IMCOMPARE.SYMB) + (FILES (LOADCOMP) + GRAPHER)))) (DEFINEQ (COMPARETEXT - [LAMBDA (NEWFILENAME OLDFILENAME HASH.TYPE GRAPH.REGION FILELABELS) - (* ; "Edited 22-Dec-2021 10:35 by rmk") + [LAMBDA (FILE1 FILE2 HASH.TYPE REGION FILELABELS) (* ; "Edited 22-Dec-2021 23:49 by rmk") (* ; "Edited 15-Dec-2021 16:23 by rmk") (* ; "Edited 13-Dec-2021 12:21 by rmk") (* ; "Edited 8-Nov-2021 08:44 by rmk:") (* mjs " 8-Jan-84 21:06") - (* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at GRAPHREGION. If GRAPH.REGION = NIL, the user is asked to specify a region. If GRAPH.REGION = T, a standard region is used.") + (* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at REGION. If REGION = NIL, the user is asked to specify a region. If REGION = T, a standard region is used.") (SELECTQ HASH.TYPE ((PARA LINE WORD)) (NIL (SETQ HASH.TYPE 'PARA)) (ERROR (CONCAT "Unrecognize HASHTYPE " HASH.TYPE))) - (LET ((NEWFILE (FINDFILE NEWFILENAME T)) - (OLDFILE (FINDFILE OLDFILENAME T))) - (CL:UNLESS (AND OLDFILE NEWFILE) - (ERROR "Can't find both files" (LIST NEWFILENAME OLDFILENAME))) + (LET ((FULLFILE1 (FINDFILE FILE1 T)) + (FULLFILE2 (FINDFILE FILE2 T))) + (CL:UNLESS (AND FULLFILE1 FULLFILE2) + (ERROR "Can't find both files" (LIST FILE1 FILE2))) (IMCOMPARE.CHUNKS (create IMCOMPARE.CHUNK - FILENAME _ NEWFILE + FILENAME _ FULLFILE1 FILEPTR _ 0) (create IMCOMPARE.CHUNK - FILENAME _ OLDFILE + FILENAME _ FULLFILE2 FILEPTR _ 0) - HASH.TYPE - (if (EQ GRAPH.REGION T) - then (create REGION - LEFT _ 25 - BOTTOM _ 25 - WIDTH _ 500 - HEIGHT _ 150) - elseif GRAPH.REGION - else (CLRPROMPT) - (printout PROMPTWINDOW "Please specify a window for the file difference graph" - T) - (GETREGION)) - FILELABELS]) + HASH.TYPE NIL FILELABELS]) + +(COMPARETEXT.WINDOW + [LAMBDA (GRAPH REGION) (* ; "Edited 27-Dec-2021 13:47 by rmk") + (* ; "Edited 25-Dec-2021 11:40 by rmk") + (* ; "Edited 22-Dec-2021 15:51 by rmk") + + (* ;; "Set up the graph WINDOW. If REGION isn't provided we prompt with a region that is wide enough for the graph and high enough for at least an initial segment.") + + (LET [WINDOW GRAPHREGION GWIDTH (FILEPREFIX (CAR (GRAPHERPROP GRAPH 'FILELABELS] + [SETQ REGION + (if (EQ REGION T) + then (create REGION + LEFT _ 25 + BOTTOM _ 25 + WIDTH _ 500 + HEIGHT _ 150) + elseif (REGIONP REGION) + else (CLRPROMPT) + (printout PROMPTWINDOW "Please specify a region for the comparison graph" T) + (SETQ GRAPHREGION (GRAPHREGION GRAPH)) + (SETQ GWIDTH (FETCH (REGION WIDTH) OF GRAPHREGION)) + + (* ;; "I don't know why the graphregion doesn't include the last line") + + (SETQ REGION (RELGETREGION (IPLUS (TIMES 2 WBorder) + GWIDTH) + [IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION) + (ITIMES 2 (FONTHEIGHT DEFAULTFONT] + 'RIGHT + 'TOP] + [SETQ WINDOW (CREATEW REGION (CONCAT "Compare text" (CL:IF FILEPREFIX + (CONCAT " of " FILEPREFIX) + "") + " showing " + (CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS) + "all" + "only different") + " chunks, hashed by " + (SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE) + (PARA "paragraph") + (LINE "line") + (WORD "word") + (SHOULDNT] + (GETPROMPTWINDOW WINDOW) + (CL:WHEN (EQ GWIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW))) + (WINDOWPROP WINDOW 'MAXSIZE (CONS GWIDTH MAX.SMALLP))) + (GETPROMPTWINDOW WINDOW) + [WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W) + (LET (TOBJ TWINDOW) + (CL:WHEN (AND (SETQ TOBJ (WINDOWPROP + W + 'COL1TEXTOBJ)) + (SETQ TWINDOW + (WFROMDS (TEXTSTREAM TOBJ))) + (OPENWP TWINDOW)) + (CLOSEW TWINDOW)) + (CL:WHEN (AND (SETQ TOBJ (WINDOWPROP + W + 'COL2TEXTOBJ)) + (SETQ TWINDOW + (WFROMDS (TEXTSTREAM TOBJ))) + (OPENWP TWINDOW)) + (CLOSEW TWINDOW] + WINDOW]) + +(COMPARETEXT.TEXTOBJ + [LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 30-Dec-2021 21:21 by rmk") + (* ; "Edited 27-Dec-2021 15:56 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.") + + (DECLARE (USEDFREE COMPARETEXT.AUTOTEDIT)) + (LET (TEXTOBJ TSTREAM TWINDOW REGION (NODEID (FETCH (GRAPHNODE NODEID) OF NODE))) + (CL:UNLESS [AND [SETQ TEXTOBJ (WINDOWPROP WINDOW (CL:IF INCOL1 + 'COL1TEXTOBJ + 'COL2TEXTOBJ)] + (OPENWP (WFROMDS (TEXTSTREAM TEXTOBJ] + (SETQ REGION (RELCREATEREGION 475 600 (CL:IF INCOL1 + 'RIGHT + 'LEFT) + 'TOP + (CL:IF INCOL1 + `(,WINDOW 0.5 -1) + `(,WINDOW 0.5 1)) + `(,WINDOW BOTTOM -2) + T)) + [SETQ TSTREAM (TEXTSTREAM (TEDIT (CL:IF (FIXP (CAR NODEID)) + (FETCH (IMCOMPARE.CHUNK FILENAME) of NODEID) + NODEID) + (IF COMPARETEXT.AUTOTEDIT + THEN + (* ;; + "Just use it as created, don't prompt for adjustments") + + REGION + ELSE (RELGETREGION REGION NIL (CL:IF INCOL1 + 'RIGHT + 'LEFT) + 'TOP)) + NIL + `(READONLY T LEAVETTY T] + (SETQ TWINDOW (WFROMDS TSTREAM)) + (SETQ TEXTOBJ (TEXTOBJ TSTREAM)) + (WINDOWPROP WINDOW (CL:IF INCOL1 + 'COL1TEXTOBJ + 'COL2TEXTOBJ) + TEXTOBJ) + [WINDOWPROP TWINDOW 'TITLE (CL:IF INCOL1 + (CADR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) + 'FILELABELS)) + (CADDR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) + 'FILELABELS)))] + [WINDOWADDPROP WINDOW 'MOVEFN (FUNCTION (LAMBDA (W NEWPOS) + (LET ((DELTA (PTDIFFERENCE NEWPOS ( + WINDOWPOSITION + W))) + TOBJ TW) + (CL:WHEN (SETQ TOBJ (WINDOWPROP + W + 'COL1TEXTOBJ)) + (MOVEW (SETQ TW (WFROMDS (TEXTSTREAM + TOBJ))) + (PTPLUS DELTA (WINDOWPOSITION + TW)))) + (CL:WHEN (SETQ TOBJ (WINDOWPROP + W + 'COL2TEXTOBJ)) + (MOVEW (SETQ TW (WFROMDS (TEXTSTREAM + TOBJ))) + (PTPLUS DELTA (WINDOWPOSITION + TW)))) + NIL]) + TEXTOBJ]) + +(COMPARETEXT.SETSEL + [LAMBDA (TEXTOBJ NODE) (* ; "Edited 25-Dec-2021 10:52 by rmk") + + (* ;; "25 so that we normalize with a little bit of context") + + (LET* ((CHUNK (FETCH (GRAPHNODE NODEID) OF NODE)) + (FILEPTR (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK))) + (TEDIT.SETSEL TEXTOBJ (IMAX 1 (IDIFFERENCE FILEPTR 25)) + 0 + 'LEFT) + (TEDIT.NORMALIZECARET TEXTOBJ) + (TEDIT.SETSEL TEXTOBJ FILEPTR (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK) + 'LEFT) + (TEDIT.NORMALIZECARET TEXTOBJ) + (AND NIL (TTY.PROCESS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) + 'PROCESS]) + +(CHUNKNODELABEL + [LAMBDA (CHUNK MIN.LENGTH EXTENDER) (* ; "Edited 25-Dec-2021 11:56 by rmk") + (* ; "Edited 13-Dec-2021 21:18 by rmk") + (* mjs "30-Dec-83 15:11") + + (* ;; "Label for CHUNK is at least MIN.LENGTH characters long, by concatenating the first character of EXTENDER (or space, if not given) to the front") + + (LET ((FILEPTR (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) + (LENGTH (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK)) + X) + (SETQ X (CONCAT FILEPTR ":" LENGTH)) + (AND NIL (IF (ILESSP (NCHARS X) + MIN.LENGTH) + THEN (CONCAT (ALLOCSTRING (IDIFFERENCE MIN.LENGTH (NCHARS X)) + (CL:IF EXTENDER + (NTHCHAR EXTENDER 1) + " ")) + X) + ELSE X)) + X]) (IMCOMPARE.BOXNODE - [LAMBDA (NODE WINDOW) (* rmk%: "14-Dec-84 13:40") - (if IMCOMPARE.LAST.NODE - then (RESET/NODE/BORDER IMCOMPARE.LAST.NODE 'INVERT IMCOMPARE.LAST.GRAPH.WINDOW) - (SETQ IMCOMPARE.LAST.NODE NIL) - (SETQ IMCOMPARE.LAST.GRAPH.WINDOW NIL)) - (if NODE - then (RESET/NODE/BORDER NODE 'INVERT WINDOW) - (SETQ IMCOMPARE.LAST.NODE NODE) - (SETQ IMCOMPARE.LAST.GRAPH.WINDOW WINDOW]) + [LAMBDA (WINDOW NODE1 NODE2) (* ; "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)) + (CL:WHEN (CADR LASTNODES) + (FLIPNODE (CADR LASTNODES) + WINDOW)) + (CL:WHEN NODE1 (FLIPNODE NODE1 WINDOW)) + (CL:WHEN NODE2 (FLIPNODE NODE2 WINDOW)) + (WINDOWPROP WINDOW 'LASTNODES (LIST NODE1 NODE2]) (IMCOMPARE.CHUNKS - [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION FILELABELS) - (* ; "Edited 18-Dec-2021 13:21 by rmk") - (* ; "Edited 15-Dec-2021 16:28 by rmk") - (* ; "Edited 13-Dec-2021 12:32 by rmk") - (* rmk%: " 8-Sep-84 00:06") + [LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION FILELABELS) (* ; "Edited 25-Dec-2021 13:02 by rmk") + (* ; "Edited 23-Dec-2021 00:02 by rmk") + (* ; "Edited 8-Sep-1984 00:06 by rmk") - (* ;; "This is the main text-comparison function. It compares the text in the two chunks and produces a graph showing how the sub-chunks of the two main chunks are related. The two main chunks may be in the same file, and the file may actually be an open Tedit textstream. The main chunks are broken down according to HASH.TYPE, which may be PARA , LINE, WORD, or PARA. The file difference graph is displayed at GRAPH.REGION.") + (* ;; "This is the main text-comparison function. It compares the text in the two chunks and produces a graph showing how the sub-chunks of the two main chunks are related. The two main chunks may be in the same file, and the file may actually be an open Tedit textstream. The main chunks are broken down according to HASH.TYPE, which may be PARA , LINE, WORD, or PARA. The file difference graph is displayed at REGION.") (* ;; "This text comparison algorithm is originally from the article 'A Technique for Isolating Differences Between Files' by Paul Heckel, in CACM, V21, #4, April 1978 --- major difference is that I use lists instead of arrays") (* ;; "") - (* ;; "Collect lists of chunks from each of the main chunks, dividing them according to HASH.TYPE. We start with whole-file chunks to provide the interface that the") + (* ;; "Collect lists of chunks from each of the main chunks, dividing them according to HASH.TYPE. We start with whole-file chunk. but this works also for a chunk that corresponds to a subsection of a file.") (LET ((CHUNK.SYMBOL.TABLE (HASHARRAY 500)) - (NEWFILE.CHUNK.LIST (IMCOMPARE.COLLECT.HASH.CHUNKS NEWFILE.SPEC.CHUNK HASH.TYPE)) - (OLDFILE.CHUNK.LIST (IMCOMPARE.COLLECT.HASH.CHUNKS OLDFILE.SPEC.CHUNK HASH.TYPE))) + (CHUNKLIST1 (IMCOMPARE.COLLECT.HASH.CHUNKS CHUNK1 HASH.TYPE)) + (CHUNKLIST2 (IMCOMPARE.COLLECT.HASH.CHUNKS CHUNK2 HASH.TYPE))) - (* ;; "Update the chunk symbol table. For each hash value, this table records the number of 'new' chunks with that hash value, the number of 'old' chunks with that value, and a pointer to the place in OLD.CHUNK.LIST .") + (* ;; "Update the chunk symbol table. For each hash value, this table records the number of file1 chunks with that hash value, the number of file2 chunks with that value, and a pointer to a tail of CHUNKLIST2 (not to a chunk itself).") - (IMCOMPARE.UPDATE.SYMBOL.TABLE NEWFILE.CHUNK.LIST CHUNK.SYMBOL.TABLE NIL) - (IMCOMPARE.UPDATE.SYMBOL.TABLE OLDFILE.CHUNK.LIST CHUNK.SYMBOL.TABLE T) + (IMCOMPARE.UPDATE.SYMBOL.TABLE CHUNKLIST1 CHUNK.SYMBOL.TABLE NIL) + (IMCOMPARE.UPDATE.SYMBOL.TABLE CHUNKLIST2 CHUNK.SYMBOL.TABLE T) - (* ;; "For every new chunk whose hash value matches EXACTLY ONE old chunk's value, 'connect' it to the old chunk by setting the new chunk's OTHERCHUNK field to point to the appropriate place in the old chunk list . Also, make sure that OTHERCHUNK of the matching old chunk is non-NIL, so that unconnected old chunks will be merged correctly.") + (* ;; "For every file1 chunk whose hash value matches EXACTLY ONE file2 chunk's value, 'connect' it to the file2 chunk by setting the file1 chunk's OTHERCHUNK field to point to the appropriate tail of the file1 chunk list . Also, make sure that OTHERCHUNK of the matching file1 chunk is non-NIL, so that unconnected file1 chunks will be merged correctly.") - (for NEW.CHUNK in NEWFILE.CHUNK.LIST bind SYMB - do (SETQ SYMB (GETHASH (fetch (IMCOMPARE.CHUNK HASHVALUE) of NEW.CHUNK) - CHUNK.SYMBOL.TABLE)) - (if (AND (EQ 1 (fetch (IMCOMPARE.SYMB NEWCOUNT) of SYMB)) - (EQ 1 (fetch (IMCOMPARE.SYMB OLDCOUNT) of SYMB))) - then (replace (IMCOMPARE.CHUNK OTHERCHUNK) of NEW.CHUNK with (fetch ( - IMCOMPARE.SYMB - OLDPTR) - of SYMB)) - (replace (IMCOMPARE.CHUNK OTHERCHUNK) of (CAR (fetch (IMCOMPARE.SYMB OLDPTR) - of SYMB)) with T))) + (for C1 in CHUNKLIST1 bind SYMB do (SETQ SYMB (GETHASH (fetch (IMCOMPARE.CHUNK HASHVALUE) + of C1) + CHUNK.SYMBOL.TABLE)) + (if (AND (EQ 1 (fetch (IMCOMPARE.SYMB NEWCOUNT) + of SYMB)) + (EQ 1 (fetch (IMCOMPARE.SYMB OLDCOUNT) + of SYMB))) + then (replace (IMCOMPARE.CHUNK OTHERCHUNK) + of C1 with (fetch (IMCOMPARE.SYMB OLDPTR) + of SYMB)) + (replace (IMCOMPARE.CHUNK OTHERCHUNK) + of (CAR (fetch (IMCOMPARE.SYMB OLDPTR) + of SYMB)) with T))) (* ;; "Merge connected chunks forward") - (IMCOMPARE.MERGE.CONNECTED.CHUNKS NEWFILE.CHUNK.LIST NIL) + (IMCOMPARE.MERGE.CONNECTED.CHUNKS CHUNKLIST1 NIL) (* ;; "Merge connected chunks backwards") - (SETQ NEWFILE.CHUNK.LIST (DREVERSE NEWFILE.CHUNK.LIST)) - (SETQ OLDFILE.CHUNK.LIST (DREVERSE OLDFILE.CHUNK.LIST)) - (IMCOMPARE.MERGE.CONNECTED.CHUNKS NEWFILE.CHUNK.LIST T) - (SETQ NEWFILE.CHUNK.LIST (DREVERSE NEWFILE.CHUNK.LIST)) - (SETQ OLDFILE.CHUNK.LIST (DREVERSE OLDFILE.CHUNK.LIST)) + (SETQ CHUNKLIST1 (DREVERSE CHUNKLIST1)) + (SETQ CHUNKLIST2 (DREVERSE CHUNKLIST2)) + (IMCOMPARE.MERGE.CONNECTED.CHUNKS CHUNKLIST1 T) + (SETQ CHUNKLIST1 (DREVERSE CHUNKLIST1)) + (SETQ CHUNKLIST2 (DREVERSE CHUNKLIST2)) (* ;; "Merge unconnected chunks") - (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS NEWFILE.CHUNK.LIST) - (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS OLDFILE.CHUNK.LIST) + (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS CHUNKLIST1) + (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS CHUNKLIST2) (* ;; "The file comparison is complete. Format and display the file difference graph") - (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE - GRAPH.REGION NEWFILE.CHUNK.LIST OLDFILE.CHUNK.LIST FILELABELS]) + (IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS]) (IMCOMPARE.COLLECT.HASH.CHUNKS - [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 22-Dec-2021 10:37 by rmk") + [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 24-Dec-2021 22:30 by rmk") (* ; "Edited 13-Dec-2021 16:32 by rmk") (* ; "Edited 23-Dec-98 16:54 by rmk:") (* mjs " 8-Jan-84 20:57") @@ -151,159 +314,156 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (* ;; "It is overkill to open raw text streams as TEDIT stream. So we open, test for TEDIT and if so, close and reoopen. TEDIT may not yet honor external formats other than XCCS for rawtext files.") - (BIND (FILENAME _ (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK)) - STREAM ENDPOS FIRST (SETQ STREAM (OPENSTREAM FILENAME 'INPUT 'OLD)) - (CL:WHEN (\TEDIT.FORMATTEDP1 STREAM) - (CLOSEF STREAM) (* ; + (RESETLST + (BIND (FILENAME _ (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK)) + STREAM ENDPOS FIRST [RESETSAVE (SETQ STREAM (OPENSTREAM FILENAME 'INPUT 'OLD)) + '(PROGN (CLOSEF? OLDVALUE] + (CL:WHEN (\TEDIT.FORMATTEDP1 STREAM) + (* ;  "The OBJECTCHAR is produced in place of image objects") - [SETQ STREAM (OPENTEXTSTREAM FILENAME NIL NIL NIL - `(OBJECTBYTE ,(CHARCODE NULL]) - (SETFILEINFO STREAM 'EOL 'ANY) - (CL:UNLESS (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK) + [RESETSAVE [SETQ STREAM + (OPENTEXTSTREAM STREAM NIL NIL NIL + `(OBJECTBYTE ,(CHARCODE NULL] + '(PROGN (CLOSEF? OLDVALUE]) + (SETFILEINFO STREAM 'EOL 'ANY) + (CL:UNLESS (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK) - (* ;; + (* ;;  "For TEDIT files, the character length isn't known until after text-opening") - (REPLACE (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK - WITH (GETFILEINFO STREAM 'LENGTH))) - (SETFILEPTR STREAM (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) - (SETQ ENDPOS (IPLUS (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK) - (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK))) - WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS)) - COLLECT (REPLACE FILENAME OF CHUNK WITH FILENAME) - CHUNK FINALLY (CLOSEF STREAM]) + (REPLACE (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK + WITH (GETFILEINFO STREAM 'LENGTH))) + (SETFILEPTR STREAM (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) + (SETQ ENDPOS (IPLUS (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK) + (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) + of CHUNK))) + WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS)) + COLLECT (REPLACE FILENAME OF CHUNK WITH FILENAME) + CHUNK))]) -(IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH - [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION NEWFILE.CHUNK.LIST - OLDFILE.CHUNK.LIST FILELABELS) (* ; "Edited 18-Dec-2021 13:16 by rmk") - (* ; "Edited 16-Dec-2021 10:48 by rmk") - (* ; "Edited 13-Dec-2021 12:19 by rmk") +(IMCOMPARE.DISPLAYGRAPH + [LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS) + (* ; "Edited 27-Dec-2021 11:58 by rmk") + (* ; "Edited 23-Dec-2021 00:14 by rmk") (* mjs "11-Jul-85 09:10") -(* ;;; "format and display the graph") + (* ;; "Format and display the graph") - (LET ((NEWFILENAME (fetch (IMCOMPARE.CHUNK FILENAME) of NEWFILE.SPEC.CHUNK)) - (OLDFILENAME (fetch (IMCOMPARE.CHUNK FILENAME) of OLDFILE.SPEC.CHUNK)) - NEWFILELABEL OLDFILELABEL (OLD.CHUNK.NODE.FROM.NODES NIL) - (BORDERSIZE 1) - GRAPH.WINDOW NEW.CHUNK.NODES OLD.CHUNK.NODES OLD.CHUNK.XCOORD NEW.CHUNK.XCOORD - YCOORD.INCREMENT DIFF.GRAPH) + (DECLARE (USEDFREE COMPARETEXT.ALLCHUNKS)) + (LET ((FULLFILE1 (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK1)) + (FULLFILE2 (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK2)) + FILE1LABEL FILE2LABEL FILEPREFIX 2TO1MAP (BORDERSIZE 1) + NODES1 NODES2 COL1HEADER COL1X COL2HEADER COL2X YINCREMENT GRAPH TEMP1) -(* ;;; "set up GRAPH.WINDOW. This is done first so you can get the width and height of strings to be printed in the window.") + (* ;; "Create the nodes for the column headers") - (SETQ NEWFILELABEL (OR (CAR (LISTP FILELABELS)) - NEWFILENAME)) - (SETQ OLDFILELABEL (OR (CADR (LISTP FILELABELS)) - OLDFILENAME)) - [SETQ GRAPH.WINDOW (CREATEW GRAPH.REGION (CONCAT "Text File Differences, hashed by " - (SELECTQ HASH.TYPE - ((PARA NIL) - "Paragraph") - (LINE "Line") - (WORD "Word") - (SHOULDNT] - (WINDOWPROP GRAPH.WINDOW 'IMPARE.HASH.TYPE HASH.TYPE) - [WINDOWADDPROP GRAPH.WINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW) - (if (EQ WINDOW IMCOMPARE.LAST.GRAPH.WINDOW) - then (SETQ IMCOMPARE.LAST.GRAPH.WINDOW - NIL) - (SETQ IMCOMPARE.LAST.NODE NIL] - (SETQ NEW.CHUNK.XCOORD (IQUOTIENT (STRINGWIDTH NEWFILELABEL GRAPH.WINDOW) - 2)) - [SETQ OLD.CHUNK.XCOORD (IPLUS NEW.CHUNK.XCOORD (IMAX 100 (IPLUS NEW.CHUNK.XCOORD - (IQUOTIENT (STRINGWIDTH - OLDFILELABEL - GRAPH.WINDOW) - 2) - 20] - [SETQ YCOORD.INCREMENT (IMINUS (IPLUS 2 (ITIMES 2 BORDERSIZE) - (fetch (REGION HEIGHT) of (STRINGREGION NEWFILELABEL - GRAPH.WINDOW] + (SETQ FILE1LABEL (OR (CAR (LISTP FILELABELS)) + FULLFILE1)) + (SETQ FILE2LABEL (OR (CADR (LISTP FILELABELS)) + FULLFILE2)) + (CL:WHEN (SETQ FILEPREFIX (FB.GREATEST.PREFIX FILE1LABEL FILE2LABEL)) + [SETQ FILE1LABEL (SUBSTRING FILE1LABEL (ADD1 (NCHARS FILEPREFIX] + [SETQ FILE2LABEL (SUBSTRING FILE2LABEL (ADD1 (NCHARS FILEPREFIX]) + (SETQ COL1X (IQUOTIENT (STRINGWIDTH FILE1LABEL DEFAULTFONT) + 2)) + (SETQ COL1HEADER (NODECREATE FULLFILE1 FILE1LABEL (CREATEPOSITION COL1X 0) + NIL NIL DEFAULTFONT -2)) + [SETQ COL2X (IPLUS COL1X (IMAX 100 (IPLUS COL1X 30 (IQUOTIENT (STRINGWIDTH FILE2LABEL + DEFAULTFONT) + 2] + (SETQ COL2HEADER (NODECREATE FULLFILE2 FILE2LABEL (CREATEPOSITION COL2X 0) + NIL NIL DEFAULTFONT -2)) -(* ;;; "collect new-chunk graph nodes, while accumulating OLD.CHUNK.NODE.FROM.NODES, assoc list from old-chunks to new-chunks") + (* ;; "It would be nice to get corresponding chunks at the same positions in their lists, so that equality lines will be horizontal. Different numbers of inserts above can throw that off, we try to insert NIL spaces to even things up.") - (SETQ NEW.CHUNK.NODES (for NEW.CHUNK in NEWFILE.CHUNK.LIST as Y from YCOORD.INCREMENT - by YCOORD.INCREMENT bind CORRESPONDING.OLD.CHUNK - collect (SETQ CORRESPONDING.OLD.CHUNK (CAR (fetch (IMCOMPARE.CHUNK - OTHERCHUNK) - of NEW.CHUNK))) - (if CORRESPONDING.OLD.CHUNK - then (SETQ OLD.CHUNK.NODE.FROM.NODES - (CONS (CONS CORRESPONDING.OLD.CHUNK NEW.CHUNK) - OLD.CHUNK.NODE.FROM.NODES))) + [FOR C1TAIL C1 O1 ON CHUNKLIST1 AS C2TAIL C2 ON CHUNKLIST2 + EACHTIME (SETQ C1 (CAR C1TAIL)) + (SETQ C2 (CAR C2TAIL)) + (SETQ O1 (CAR (FETCH OTHERCHUNK OF C1))) UNLESS (EQ C2 O1) + DO (IF (AND O1 (EQ O1 (CADR C2TAIL))) + THEN + (* ;; + "We push NIL into the C1TAIL cell that C1 formerly occupied, move C1 down ") + + (ATTACH NIL C1TAIL) + ELSEIF [EQ C2 (CAR (FETCH OTHERCHUNK OF (SETQ C1 (CADR C1TAIL] + THEN (ATTACH NIL C2TAIL) (* ; + "OTHERCHUNK is the tail that contains C2, so it also has to be updated.") + (REPLACE OTHERCHUNK OF C1 WITH (CDR C2TAIL))) + + (* ;; "Make them run out at the same time.") + + (IF (AND (CDR C1TAIL) + (NULL (CDR C2TAIL))) + THEN (RPLACD C2TAIL (CONS)) + ELSEIF (AND (CDR C2TAIL) + (NULL (CDR C1TAIL))) + THEN (RPLACD C1TAIL (CONS] + [SETQ YINCREMENT (IMINUS (IPLUS 2 (ITIMES 2 BORDERSIZE) + (FONTPROP DEFAULTFONT 'HEIGHT] + + (* ;; "Collect new-chunk graph nodes, while accumulating 2TO1MAP, assoc list from file2 chunks to file1 chunks. We skip the NILs inserted above (although Y increments).") + + [SETQ NODES1 (for C1 C2 in CHUNKLIST1 as Y from YINCREMENT by YINCREMENT + collect (CL:WHEN C1 + (CL:WHEN (SETQ C2 (CAR (fetch (IMCOMPARE.CHUNK OTHERCHUNK) + of C1))) + (PUSH 2TO1MAP (CONS C2 C1))) (* ;  "Start out with 2 point white border, so we can invert it") - (NODECREATE NEW.CHUNK (IMCOMPARE.LENGTHEN.ATOM - (PACK* (fetch (IMCOMPARE.CHUNK FILEPTR - ) of NEW.CHUNK) - ":" - (fetch (IMCOMPARE.CHUNK - CHUNKLENGTH) - of NEW.CHUNK)) - 12) - (create POSITION - XCOORD _ NEW.CHUNK.XCOORD - YCOORD _ Y) - (if CORRESPONDING.OLD.CHUNK - then (LIST CORRESPONDING.OLD.CHUNK) - else NIL) - NIL DEFAULTFONT -2))) - (SETQ OLD.CHUNK.NODES (for OLD.CHUNK in OLDFILE.CHUNK.LIST as Y from YCOORD.INCREMENT - by YCOORD.INCREMENT bind CORRESPONDING.NEW.CHUNK - collect (SETQ CORRESPONDING.NEW.CHUNK (CDR (ASSOC OLD.CHUNK - OLD.CHUNK.NODE.FROM.NODES - ))) - (NODECREATE OLD.CHUNK (IMCOMPARE.LENGTHEN.ATOM - (PACK* (fetch (IMCOMPARE.CHUNK FILEPTR - ) of OLD.CHUNK) - ":" - (fetch (IMCOMPARE.CHUNK - CHUNKLENGTH) - of OLD.CHUNK)) - 12 "-") - (create POSITION - XCOORD _ OLD.CHUNK.XCOORD - YCOORD _ Y) - NIL - (if CORRESPONDING.NEW.CHUNK - then (LIST CORRESPONDING.NEW.CHUNK) - else NIL) - DEFAULTFONT -2))) - (SETQ DIFF.GRAPH (create GRAPH - DIRECTEDFLG _ T - SIDESFLG _ T - GRAPHNODES _ - (NCONC (LIST (NODECREATE NEWFILENAME NEWFILELABEL - (create POSITION - XCOORD _ NEW.CHUNK.XCOORD - YCOORD _ 0) - NIL NIL DEFAULTFONT -2)) - NEW.CHUNK.NODES - (LIST (NODECREATE OLDFILENAME OLDFILELABEL - (create POSITION - XCOORD _ OLD.CHUNK.XCOORD - YCOORD _ 0) - NIL NIL DEFAULTFONT -2)) - OLD.CHUNK.NODES))) - (GRAPHERPROP DIFF.GRAPH 'FILELABELS (LIST NEWFILELABEL OLDFILELABEL)) - (* ; - "So Middle mouse graphs can get the right labels") - (GRAPHERPROP DIFF.GRAPH 'HASH.TYPE HASH.TYPE) - (SHOWGRAPH DIFF.GRAPH GRAPH.WINDOW (FUNCTION IMCOMPARE.LEFTBUTTONFN) + (NODECREATE C1 (CHUNKNODELABEL C1 10) + (CREATEPOSITION COL1X Y) + (CL:WHEN C2 (CONS C2)) + NIL DEFAULTFONT -2))] + [SETQ NODES2 (for C2 C1 in CHUNKLIST2 as Y from YINCREMENT by YINCREMENT + collect (CL:WHEN C2 + (SETQ C1 (CDR (ASSOC C2 2TO1MAP))) + (NODECREATE C2 (CHUNKNODELABEL C2 10 (AND NIL "-")) + (CREATEPOSITION COL2X Y) + NIL + (CL:WHEN C1 (CONS C1)) + DEFAULTFONT -2))] + + (* ;; "Now eliminate all the C1/C2 node pairs that are at the same Yposition. Those would just have uninformative horizontal lines representing no differences. Maybe this can be done on the fly--don't construct such pairs--but that will come later. The node") + + (IF COMPARETEXT.ALLCHUNKS + THEN (SETQ NODES1 (DREMOVE NIL NODES1)) + (SETQ NODES2 (DREMOVE NIL NODES2)) + ELSE + (* ;; "The nodes in both lists correspond, with NILs padding where needed. We can simplify the picture if we take out equivalent chunks, otherwise we show all their horizontal lines.") + + (FOR N1 KEPT1 KEPT2 (YPOS _ YINCREMENT) IN NODES1 AS N2 IN NODES2 + UNLESS [AND N1 N2 (EQ (FETCH NODEID OF N2) + (CAR (FETCH OTHERCHUNK OF (FETCH NODEID OF N1] + DO (CL:WHEN N1 + (PUSH KEPT1 N1) + (REPLACE YCOORD OF (FETCH NODEPOSITION OF N1) WITH YPOS)) + (CL:WHEN N2 + (PUSH KEPT2 N2) + (REPLACE YCOORD OF (FETCH NODEPOSITION OF N2) WITH YPOS)) + (ADD YPOS YINCREMENT) FINALLY (SETQ NODES1 KEPT1) + (SETQ NODES2 KEPT2))) + + (* ;; + "Keep column xcords so leftbutton can tell a node's column, keep labels for new middle mouse graph ") + + [SETQ GRAPH (create GRAPH + DIRECTEDFLG _ T + SIDESFLG _ T + GRAPHNODES _ (NCONC (LIST COL1HEADER) + NODES1 + (LIST COL2HEADER) + NODES2) + GRAPH.PROPS _ `(HASH.TYPE ,HASH.TYPE FILELABELS (,FILEPREFIX ,FILE1LABEL + ,FILE2LABEL) + COL1X + ,COL1X COL2X ,COL2X ALLCHUNKS + ,COMPARETEXT.ALLCHUNKS] + (SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH REGION) + (FUNCTION IMCOMPARE.LEFTBUTTONFN) (FUNCTION IMCOMPARE.MIDDLEBUTTONFN) T NIL]) -(IMCOMPARE.FIND.TEDIT.TEXT.OBJECT - [LAMBDA (FILE) (* ; "Edited 16-Dec-2021 08:40 by rmk") - (* mjs " 2-Jan-84 16:19") - - (* ;; "returns the Tedit text object of the first Tedit window which is currently looking at FILE, if there is one. Returns NIL if none is found.") - - (for W in (OPENWINDOWS) bind POSS.TOBJ when [AND (SETQ POSS.TOBJ (WINDOWPROP W 'TEXTOBJ)) - (EQ FILE (FULLNAME (fetch (TEXTOBJ TXTFILE) - of POSS.TOBJ] - unless (TEDIT.STREAMCHANGEDP POSS.TOBJ) do (RETURN POSS.TOBJ]) - (IMCOMPARE.HASH [LAMBDA (STREAM HASH.TYPE ENDPOS) (* ; "Edited 19-Dec-2021 09:07 by rmk") (* ; "Edited 15-Dec-2021 15:58 by rmk") @@ -370,58 +530,6 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. CHUNKLENGTH _ (IDIFFERENCE (GETFILEPTR STREAM) STARTPOS)))]) -(IMCOMPARE.LEFTBUTTONFN - [LAMBDA (GNODE WINDOW) (* ; "Edited 18-Dec-2021 13:02 by rmk") - (* mjs " 2-Apr-85 14:21") - (if GNODE - then (LET ((NODEID (fetch (GRAPHNODE NODEID) of GNODE))) - (IF (FIXP (CAR NODEID)) - THEN (IMCOMPARE.BOXNODE GNODE WINDOW) - [LET ((FILEPTR 1) - (CHUNKLENGTH 0) - (TEDIT.TEXT.OBJECT NIL) - FILE) - (SETQ FILE (fetch (IMCOMPARE.CHUNK FILENAME) of NODEID)) - (SETQ FILEPTR (fetch (IMCOMPARE.CHUNK FILEPTR) of NODEID)) - (SETQ CHUNKLENGTH (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of NODEID)) - (SETQ TEDIT.TEXT.OBJECT (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT FILE)) - (if TEDIT.TEXT.OBJECT - then (TEDIT.SETSEL TEDIT.TEXT.OBJECT (IMAX 1 (IDIFFERENCE FILEPTR - 25)) - 0 - 'LEFT) - (TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT) - (TEDIT.SETSEL TEDIT.TEXT.OBJECT FILEPTR CHUNKLENGTH - 'LEFT) - (TEDIT.NORMALIZECARET TEDIT.TEXT.OBJECT) - (TTY.PROCESS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) - of TEDIT.TEXT.OBJECT)) - 'PROCESS)) - else (TEDIT FILE NIL NIL (LIST 'SEL (LIST FILEPTR CHUNKLENGTH] - ELSEIF (AND (LITATOM NODEID) - (INFILEP NODEID)) - THEN - (* ;; - "A file name as a column header, do TEDIT on the whole file, no selection") - - (TEDIT-SEE NODEID) - ELSE (SHOULDNT]) - -(IMCOMPARE.LENGTHEN.ATOM - [LAMBDA (X MIN.LENGTH EXTENDER) (* ; "Edited 13-Dec-2021 21:18 by rmk") - (* mjs "30-Dec-83 15:11") - - (* ;; "makes sure that the atom X is at least MIN.LENGTH characters long, by concatenating the first character of EXTENDER (or space, if not given) to the front") - - (IF (ILESSP (NCHARS X) - MIN.LENGTH) - THEN (PACK* (ALLOCSTRING (IDIFFERENCE MIN.LENGTH (NCHARS X)) - (CL:IF EXTENDER - (NTHCHAR EXTENDER 1) - " ")) - X) - ELSE X]) - (IMCOMPARE.MERGE.CONNECTED.CHUNKS [LAMBDA (NEW.CHUNK.LIST BACKWARDS.FLG) (* mjs " 6-Jan-84 10:35") (while NEW.CHUNK.LIST bind NEW.CHUNK OLD.CHUNK.PTR @@ -490,46 +598,6 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.  list) (RPLACD CHUNK.LST (CDDR CHUNK.LST]) -(IMCOMPARE.MIDDLEBUTTONFN - [LAMBDA (GNODE WINDOW) - - (* ;; "Edited 16-Dec-2021 10:55 by rmk: Remove previous HASH.TYPE from the middle mouse menu") - (* ; "Edited 16-Dec-2021 10:51 by rmk") - (* mjs " 6-Jan-84 11:37") - - (* ;; "This function is called if the MIDDLE mouse button is pressed over a graph node. The selected node is IMCOMPARE-ed with the last node selected . The type of hashing used is selected from a pop-up menu. If none of the hashing types is selected, the current node is boxed. The pop-up menu is always located a little above the current cursor position, so a quick double-MIDDLE-click is an easy way to change the current boxed node.") - - (if GNODE - then (PROG (INNER.HASH.TYPE) - (CLRPROMPT) - (printout PROMPTWINDOW "Please select the type of hashing you wish." T) - [SETQ INNER.HASH.TYPE (MENU (create MENU - ITEMS _ (REMOVE (GRAPHERPROP - (WINDOWPROP WINDOW - 'GRAPH) - 'HASH.TYPE) - '(PARA LINE WORD)) - MENUOFFSET _ - (create POSITION - XCOORD _ 20 - YCOORD _ -20] - (if (NULL INNER.HASH.TYPE) - then (* ; - "if no hash type is selected, just box the current node and return") - (IMCOMPARE.BOXNODE GNODE WINDOW) - (RETURN)) - (if (NULL IMCOMPARE.LAST.NODE) - then (CLRPROMPT) - (PRIN1 "You must select another graph node first." PROMPTWINDOW) - (RETURN)) - (printout PROMPTWINDOW "Comparing chunks by " INNER.HASH.TYPE T) - (IMCOMPARE.CHUNKS (fetch (GRAPHNODE NODEID) of IMCOMPARE.LAST.NODE) - (fetch (GRAPHNODE NODEID) of GNODE) - INNER.HASH.TYPE - (WINDOWPROP WINDOW 'REGION) - (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) - 'FILELABELS]) - (IMCOMPARE.SHOW.DIST [LAMBDA (LST MAX) (* mjs "30-Dec-83 15:13") (PROG ((WINDOW (CREATEW)) @@ -570,12 +638,124 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (replace (IMCOMPARE.SYMB NEWCOUNT) of SYMB with (ADD1 (fetch (IMCOMPARE.SYMB NEWCOUNT) of SYMB]) ) +(DEFINEQ -(MOVD 'COMPARETEXT 'IMCOMPARE) +(IMCOMPARE.LEFTBUTTONFN + [LAMBDA (NODE WINDOW) (* ; "Edited 25-Dec-2021 23:29 by rmk") + (* ; "Edited 22-Dec-2021 21:41 by rmk") + (* ; "Edited 18-Dec-2021 13:02 by rmk") + (* mjs " 2-Apr-85 14:21") + (CL:WHEN NODE + (LET [(INCOL1 (EQ (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) + 'COL1X) + (FETCH (POSITION XCOORD) OF (FETCH (GRAPHNODE NODEPOSITION) OF NODE] + (IF (FIXP (CAR (fetch (GRAPHNODE NODEID) of NODE))) + THEN (IMCOMPARE.BOXNODE WINDOW NODE (FOR N (YPOS _ (FETCH YCOORD + OF (FETCH NODEPOSITION + OF NODE))) + IN (FETCH GRAPHNODES + OF (WINDOWPROP WINDOW 'GRAPH)) + UNLESS (EQ N NODE) + WHEN (EQ YPOS (FETCH YCOORD + OF (FETCH NODEPOSITION + OF N))) + DO + (* ;; + "We won't match the other label node because it has a unique ypos") -(RPAQ? IMCOMPARE.LAST.NODE NIL) + (COMPARETEXT.SETSEL (COMPARETEXT.TEXTOBJ + N WINDOW (NOT INCOL1) + ) + N) + (RETURN N))) + (COMPARETEXT.SETSEL (COMPARETEXT.TEXTOBJ NODE WINDOW INCOL1) + NODE) + ELSE + (* ;; "The column header, set up the file window with no selection.") -(RPAQ? IMCOMPARE.LAST.GRAPH.WINDOW NIL) + (COMPARETEXT.TEXTOBJ NODE WINDOW INCOL1))))]) + +(IMCOMPARE.MIDDLEBUTTONFN + [LAMBDA (NODE WINDOW) (* ; "Edited 27-Dec-2021 11:59 by rmk") + (* ; "Edited 25-Dec-2021 11:51 by rmk") + (* ; "Edited 24-Dec-2021 10:42 by rmk") + (* ; "Edited 22-Dec-2021 16:08 by rmk") + + (* ;; "Edited 16-Dec-2021 10:55 by rmk: Remove previous HASH.TYPE from the middle mouse menu") + (* ; "Edited 16-Dec-2021 10:51 by rmk") + (* mjs " 6-Jan-84 11:37") + + (* ;; "This function is called if the MIDDLE mouse button is pressed over a graph node. The selected node is IMCOMPARE-ed with the last node selected . The type of hashing used is selected from a pop-up menu. If none of the hashing types is selected, the current node is boxed. The pop-up menu is always located a little above the current cursor position, so a quick double-MIDDLE-click is an easy way to change the current boxed node.") + + (CL:WHEN NODE + [PROG (INNER.HASH.TYPE REGION (LASTNODES (WINDOWPROP WINDOW 'LASTNODES)) + (PWINDOW (GETPROMPTWINDOW WINDOW))) + (CLEARW PWINDOW) + (CL:UNLESS LASTNODES + (PRIN3 "Select nodes to be expanded" PWINDOW) + (RETURN)) + [SETQ INNER.HASH.TYPE (MENU (create MENU + TITLE _ "New hash type?" + ITEMS _ (REMOVE (GRAPHERPROP (WINDOWPROP + WINDOW + 'GRAPH) + 'HASH.TYPE) + '(PARA LINE WORD)) + MENUOFFSET _ + (create POSITION + XCOORD _ 20 + YCOORD _ -20] + (printout PWINDOW "Comparing chunks by " INNER.HASH.TYPE T) + + (* ;; "Offset the region a little bit, so that the parent region is visible") + + [SETQ REGION (COPY (WINDOWPROP WINDOW 'REGION] + (ADD (FETCH (REGION LEFT) OF REGION) + 30) + (ADD (FETCH (REGION BOTTOM) OF REGION) + -30) + (IMCOMPARE.CHUNKS (FETCH (GRAPHNODE NODEID) OF (CAR LASTNODES)) + (FETCH (GRAPHNODE NODEID) OF (CADR LASTNODES)) + INNER.HASH.TYPE REGION (CDR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) + 'FILELABELS])]) + +(IMCOMPARE.COPYBUTTONFN + [LAMBDA (WINDOW NODE) (* ; "Edited 25-Dec-2021 13:26 by rmk") + (* ; "") + + (* ;; "The grapher calls this with the window but not the node. So there must be some internal grapher stuff to find the node from the mouse coordinates. The goal would be to at least do a COPYINSERT of the filename.") + + (HELP]) +) + +(FILESLOAD (SYSLOAD) + GRAPHER REGIONMANAGER) +(DEFINEQ + +(TAIL1 + [LAMBDA (ALL) (* ; "Edited 25-Dec-2021 21:54 by rmk") + (FOR X IN (CL:IF ALL + CHUNKLIST1 + C1TAIL) COLLECT (LIST (FETCH FILEPTR OF X) + (FETCH FILEPTR OF (CAR (FETCH OTHERCHUNK OF X]) + +(TAIL2 + [LAMBDA (ALL) (* ; "Edited 25-Dec-2021 21:29 by rmk") + (FOR X IN (CL:IF ALL + CHUNKLIST2 + C2TAIL) COLLECT (LIST (FETCH FILEPTR OF X) + (FETCH OTHERCHUNK OF X]) +) + + + +(* ; "Debugging") + + +(RPAQ? COMPARETEXT.ALLCHUNKS T) + +(RPAQ? COMPARETEXT.AUTOTEDIT T) +(DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD IMCOMPARE.CHUNK (HASHVALUE FILEPTR CHUNKLENGTH FILENAME . OTHERCHUNK) @@ -584,20 +764,18 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (RECORD IMCOMPARE.SYMB (NEWCOUNT OLDCOUNT . OLDPTR)) ) -(FILESLOAD (SYSLOAD) - GRAPHER) -(DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) GRAPHER) ) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1334 38876 (COMPARETEXT 1344 . 3554) (IMCOMPARE.BOXNODE 3556 . 4072) (IMCOMPARE.CHUNKS -4074 . 8592) (IMCOMPARE.COLLECT.HASH.CHUNKS 8594 . 11053) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH -11055 . 20136) (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT 20138 . 20912) (IMCOMPARE.HASH 20914 . 25101) ( -IMCOMPARE.LEFTBUTTONFN 25103 . 27545) (IMCOMPARE.LENGTHEN.ATOM 27547 . 28249) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 28251 . 31747) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 31749 . 33704) ( -IMCOMPARE.MIDDLEBUTTONFN 33706 . 36541) (IMCOMPARE.SHOW.DIST 36543 . 36989) ( -IMCOMPARE.UPDATE.SYMBOL.TABLE 36991 . 38874))))) + (FILEMAP (NIL (1344 41549 (COMPARETEXT 1354 . 2933) (COMPARETEXT.WINDOW 2935 . 7132) ( +COMPARETEXT.TEXTOBJ 7134 . 12023) (COMPARETEXT.SETSEL 12025 . 12815) (CHUNKNODELABEL 12817 . 13938) ( +IMCOMPARE.BOXNODE 13940 . 14707) (IMCOMPARE.CHUNKS 14709 . 19062) (IMCOMPARE.COLLECT.HASH.CHUNKS 19064 + . 21842) (IMCOMPARE.DISPLAYGRAPH 21844 . 29570) (IMCOMPARE.HASH 29572 . 33759) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 33761 . 37257) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 37259 . 39214) ( +IMCOMPARE.SHOW.DIST 39216 . 39662) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39664 . 41547)) (41550 47707 ( +IMCOMPARE.LEFTBUTTONFN 41560 . 44137) (IMCOMPARE.MIDDLEBUTTONFN 44139 . 47255) (IMCOMPARE.COPYBUTTONFN + 47257 . 47705)) (47760 48451 (TAIL1 47770 . 48124) (TAIL2 48126 . 48449))))) STOP diff --git a/sources/ATBL b/sources/ATBL index 123c79e6..a3dc9fc0 100644 --- a/sources/ATBL +++ b/sources/ATBL @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Dec-2021 14:09:43" {DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;31 91882 +(FILECREATED "26-Dec-2021 14:32:50" {DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;32 91860 - :CHANGES-TO (FNS EQUAL-READER-ENVIRONMENT) + :CHANGES-TO (FNS MAKE-READER-ENVIRONMENT) - :PREVIOUS-DATE "24-Oct-2021 21:53:59" -{DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;29) + :PREVIOUS-DATE "19-Dec-2021 14:09:43" +{DSK}kaplan>Local>medley3.5>my-medley>sources>ATBL.;31) (* ; " @@ -1832,10 +1832,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (MAKE-READER-ENVIRONMENT [LAMBDA (PACKAGE READTABLE BASE FORMAT PACKAGEFORM READTABLEFORM) - (* ; - "Edited 24-Oct-2021 21:53 by rmk:") - (* ; - "Edited 16-Aug-2021 23:44 by rmk:") + (* ; "Edited 26-Dec-2021 14:32 by rmk") + (* ; "Edited 24-Oct-2021 21:53 by rmk:") + (* ; "Edited 16-Aug-2021 23:44 by rmk:") (* ;; "PACKAGE can be a prop list of keyword-values") @@ -1852,12 +1851,12 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. ((CL:PACKAGEP PACKAGE) PACKAGE) [PACKAGE (OR (CL:FIND-PACKAGE PACKAGE) - (\DEST PACKAGE 'PACKAGE] + (\DTEST PACKAGE 'PACKAGE] (T *PACKAGE*)) REREADTABLE _ (COND ((READTABLEP READTABLE)) [READTABLE (OR (FIND-READTABLE READTABLE) - (\DEST READTABLE 'READTABLEP] + (\DTEST READTABLE 'READTABLEP] (T *READTABLE*)) REBASE _ (COND (BASE (\CHECKRADIX BASE)) @@ -1925,22 +1924,22 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation. (PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (17750 28902 (GETSYNTAX 17760 . 22591) (SETSYNTAX 22593 . 23666) (SYNTAXP 23668 . 26165) - (\COPYSYNTAX 26167 . 26884) (\GETCHARCODE 26886 . 27174) (\SETFATSYNCODE 27176 . 28467) ( -\MAPCHARTABLE 28469 . 28900)) (28935 43901 (CONTROL 28945 . 29197) (COPYTERMTABLE 29199 . 29566) ( -DELETECONTROL 29568 . 32209) (GETDELETECONTROL 32211 . 33173) (ECHOCHAR 33175 . 34616) (ECHOCONTROL -34618 . 35075) (ECHOMODE 35077 . 35323) (GETECHOMODE 35325 . 35489) (GETCONTROL 35491 . 35657) ( -GETTERMTABLE 35659 . 35726) (RAISE 35728 . 36154) (GETRAISE 36156 . 36318) (RESETTERMTABLE 36320 . -37404) (SETTERMTABLE 37406 . 37640) (TERMTABLEP 37642 . 37803) (\GETTERMSYNTAX 37805 . 38076) ( -\GTTERMTABLE 38078 . 38414) (\ORIGTERMTABLE 38416 . 42026) (\SETTERMSYNTAX 42028 . 42663) ( -\TERMCLASSTOCODE 42665 . 43094) (\TERMCODETOCLASS 43096 . 43483) (\LITCHECK 43485 . 43899)) (46412 -70236 (COPYREADTABLE 46422 . 46620) (FIND-READTABLE 46622 . 46769) (IN-READTABLE 46771 . 46931) ( -ESCAPE 46933 . 47186) (GETBRK 47188 . 47326) (GETREADTABLE 47328 . 47464) (GETSEPR 47466 . 47604) ( -READMACROS 47606 . 47869) (READTABLEP 47871 . 48034) (READTABLEPROP 48036 . 53194) (RESETREADTABLE -53196 . 57443) (SETBRK 57445 . 59055) (SETREADTABLE 59057 . 59245) (SETSEPR 59247 . 60789) ( -\GETREADSYNTAX 60791 . 63481) (\GTREADTABLE 63483 . 63708) (\GTREADTABLE1 63710 . 63966) ( -\ORIGREADTABLE 63968 . 65876) (\READCLASSTOCODE 65878 . 66329) (\SETMACROSYNTAX 66331 . 68126) ( -\SETREADSYNTAX 68128 . 69189) (\READTABLEP.DEFPRINT 69191 . 70234)) (83068 87521 (\ATBLSET 83078 . -87519)) (87968 91406 (MAKE-READER-ENVIRONMENT 87978 . 89656) (EQUAL-READER-ENVIRONMENT 89658 . 90808) -(SET-READER-ENVIRONMENT 90810 . 91404))))) + (FILEMAP (NIL (17749 28901 (GETSYNTAX 17759 . 22590) (SETSYNTAX 22592 . 23665) (SYNTAXP 23667 . 26164) + (\COPYSYNTAX 26166 . 26883) (\GETCHARCODE 26885 . 27173) (\SETFATSYNCODE 27175 . 28466) ( +\MAPCHARTABLE 28468 . 28899)) (28934 43900 (CONTROL 28944 . 29196) (COPYTERMTABLE 29198 . 29565) ( +DELETECONTROL 29567 . 32208) (GETDELETECONTROL 32210 . 33172) (ECHOCHAR 33174 . 34615) (ECHOCONTROL +34617 . 35074) (ECHOMODE 35076 . 35322) (GETECHOMODE 35324 . 35488) (GETCONTROL 35490 . 35656) ( +GETTERMTABLE 35658 . 35725) (RAISE 35727 . 36153) (GETRAISE 36155 . 36317) (RESETTERMTABLE 36319 . +37403) (SETTERMTABLE 37405 . 37639) (TERMTABLEP 37641 . 37802) (\GETTERMSYNTAX 37804 . 38075) ( +\GTTERMTABLE 38077 . 38413) (\ORIGTERMTABLE 38415 . 42025) (\SETTERMSYNTAX 42027 . 42662) ( +\TERMCLASSTOCODE 42664 . 43093) (\TERMCODETOCLASS 43095 . 43482) (\LITCHECK 43484 . 43898)) (46411 +70235 (COPYREADTABLE 46421 . 46619) (FIND-READTABLE 46621 . 46768) (IN-READTABLE 46770 . 46930) ( +ESCAPE 46932 . 47185) (GETBRK 47187 . 47325) (GETREADTABLE 47327 . 47463) (GETSEPR 47465 . 47603) ( +READMACROS 47605 . 47868) (READTABLEP 47870 . 48033) (READTABLEPROP 48035 . 53193) (RESETREADTABLE +53195 . 57442) (SETBRK 57444 . 59054) (SETREADTABLE 59056 . 59244) (SETSEPR 59246 . 60788) ( +\GETREADSYNTAX 60790 . 63480) (\GTREADTABLE 63482 . 63707) (\GTREADTABLE1 63709 . 63965) ( +\ORIGREADTABLE 63967 . 65875) (\READCLASSTOCODE 65877 . 66328) (\SETMACROSYNTAX 66330 . 68125) ( +\SETREADSYNTAX 68127 . 69188) (\READTABLEP.DEFPRINT 69190 . 70233)) (83067 87520 (\ATBLSET 83077 . +87518)) (87967 91384 (MAKE-READER-ENVIRONMENT 87977 . 89634) (EQUAL-READER-ENVIRONMENT 89636 . 90786) +(SET-READER-ENVIRONMENT 90788 . 91382))))) STOP diff --git a/sources/ATBL.LCOM b/sources/ATBL.LCOM index d01f73acfb642e6b89bc99350ca3dff5bd0f37dc..49a09944f99350703ee4aeb10db5932d3a483b80 100644 GIT binary patch delta 390 zcmdlnnQ6^rrU~I9MrOJ$smZ!V21bSoh9*|V=2nIV6SMtIj5HOLj7$-7Mn+af7FI@< zN(xCusmb}d1(`XiDGFSv6$Lq&$(bcNm8w<>lNUBhaA)QzD7l6D_$U~ePW&fkiD`zh zsgfp_hMT94t8}QP7+IMbO!j58lQL4^vNW_XGf=Q{_HgubcMaAJ@mJ7r z^9u&qB|dpCqma0vCBl(F4;WZlnHVc6a834SwB4-Cbi9c14rB0u;NX$!5EmpNs$jdLu$jnPu$jnnvatrnGQ82WeEXXLPjA@9Gk&-5thMT94 zt8glam;2Bn=g~EDbFzj1;V#JskbqU4wN){1r6Z{DLR1X_TCNo>54| z$VAsaxdh@QBSR}wV=Gh3iPd&YMwXjRnT{7RUYY#2#9c^olb8c10}yQGcSr}(T$2Mz zi|Qdv5P!o01`Q(v3xyaL*WeJKOHCErJpEjBfzELWadh%=RWP(LSBUZS3v=}GbkPfP zbn%Q(Ff=ezfGY@4uz=|{H&t-$K4aCG)|baw^%&d9(RMX|9$fa7M(vSwib2$)_; diff --git a/sources/COREIO b/sources/COREIO index fc1dcbcb..c92dc071 100644 --- a/sources/COREIO +++ b/sources/COREIO @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "22-Nov-2021 09:25:42" {DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;3 55023 +(FILECREATED " 3-Jan-2022 20:02:51" {DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;4 55136 - changes to%: (FNS \CORE.SETFILEINFO) + :CHANGES-TO (FNS \CORE.SETFILEINFO) - previous date%: " 4-Oct-2018 14:13:06" -{DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;2) + :PREVIOUS-DATE "22-Nov-2021 09:25:42" +{DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;3) (* ; " @@ -612,35 +612,36 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. STREAM]) (\CORE.SETFILEINFO - [LAMBDA (STREAM ATTRIBUTE VALUE DEV) (* ; "Edited 22-Nov-2021 09:25 by rmk:") + [LAMBDA (STREAM ATTRIBUTE VALUE DEV) + + (* ;; "Edited 3-Jan-2022 20:00 by rmk: fixed bug--coercing CREATIONDATE twice") + (* ; "Edited 3-Jan-2022 19:59 by rmk") + + (* ;; "Edited 22-Nov-2021 09:25 by rmk:") (* bvm%: "15-Jan-85 17:40") - (PROG ((INFOBLOCK (\CORE.GETINFOBLOCK STREAM 'OLD DEV))) - (SELECTQ ATTRIBUTE - (CREATIONDATE (SETQ VALUE (OR (IDATE VALUE) - (LISPERROR "ILLEGAL ARG" VALUE)))) - (ICREATIONDATE (OR (FIXP VALUE) - (LISPERROR "NON-NUMERIC ARG" VALUE))) - NIL) - (RETURN (AND INFOBLOCK (SELECTQ ATTRIBUTE - ((TYPE FILETYPE) - (replace IOFIBType of INFOBLOCK with VALUE)) - (EOL (replace COREEOLC of INFOBLOCK - with (SELECTQ VALUE - (CR CR.EOLC) - (LF LF.EOLC) - (CRLF CRLF.EOLC) - (LISPERROR "ILLEGAL ARG" VALUE)))) - (CREATIONDATE (replace IOFIBCreationTime of INFOBLOCK - with (IDATE VALUE))) - (READDATE (replace IOFIBReadTime of INFOBLOCK - with (IDATE VALUE))) - (WRITEDATE (replace IOFIBWriteTime of INFOBLOCK - with (IDATE VALUE))) - (ICREATIONDATE (replace IOFIBCreationTime of INFOBLOCK - with VALUE)) - (IREADDATE (replace IOFIBReadTime of INFOBLOCK with VALUE)) - (IWRITEDATE (replace IOFIBWriteTime of INFOBLOCK with VALUE)) - NIL]) + (LET ((INFOBLOCK (\CORE.GETINFOBLOCK STREAM 'OLD DEV))) + (AND INFOBLOCK (SELECTQ ATTRIBUTE + ((TYPE FILETYPE) + (replace IOFIBType of INFOBLOCK with VALUE)) + (EOL (replace COREEOLC of INFOBLOCK with (SELECTQ VALUE + (CR CR.EOLC) + (LF LF.EOLC) + (CRLF CRLF.EOLC) + (LISPERROR "ILLEGAL ARG" + VALUE)))) + (CREATIONDATE (replace IOFIBCreationTime of INFOBLOCK + with (OR (IDATE VALUE) + (\ILLEGAL.ARG VALUE)))) + (READDATE (replace IOFIBReadTime of INFOBLOCK with (OR (IDATE VALUE) + (\ILLEGAL.ARG + VALUE)))) + (WRITEDATE (replace IOFIBWriteTime of INFOBLOCK + with (OR (IDATE VALUE) + (\ILLEGAL.ARG VALUE)))) + (ICREATIONDATE (replace IOFIBCreationTime of INFOBLOCK with VALUE)) + (IREADDATE (replace IOFIBReadTime of INFOBLOCK with VALUE)) + (IWRITEDATE (replace IOFIBWriteTime of INFOBLOCK with VALUE)) + NIL]) (\CORE.GETNEXTBUFFER [LAMBDA (STREAM WHATFOR NOERRORFLG) (* ; "Edited 17-Sep-90 13:22 by jds") @@ -954,16 +955,16 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 1993 1999 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1710 44229 (\CORE.CLOSEFILE 1720 . 2493) (\CORE.DELETEFILE 2495 . 4481) ( -\CORE.DIRECTORYNAMEP 4483 . 4744) (\CORE.FINDPAGE 4746 . 7975) (\CORE.GENERATEFILES 7977 . 10564) ( -\CORE.NEXTFILEFN 10566 . 11065) (\CORE.FILEINFOFN 11067 . 11296) (\CORE.GETFILEHANDLE 11298 . 13452) ( -\CORE.GETFILEINFO 13454 . 14417) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14419 . 15956) (\CORE.GETFILENAME -15958 . 18247) (\CORE.GETINFOBLOCK 18249 . 20872) (\CORE.NAMESCAN 20874 . 22641) (\CORE.NAMESEGMENT -22643 . 23080) (\CORE.OPENFILE 23082 . 26201) (\COREFILE.SETPARAMETERS 26203 . 28384) ( -\CORE.PACKFILENAME 28386 . 28781) (\CORE.RELEASEPAGES 28783 . 29384) (\CORE.SETFILEPTR 29386 . 30485) -(\CORE.UPDATEOF 30487 . 32116) (\CORE.BACKFILEPTR 32118 . 34326) (\CORE.SETEOFPTR 34328 . 36197) ( -\CORE.SETACCESSTIME 36199 . 36824) (\CORE.SETFILEINFO 36826 . 39012) (\CORE.GETNEXTBUFFER 39014 . -42970) (\CORE.UNPACKFILENAME 42972 . 44227)) (44230 47863 (COREDEVICE 44240 . 44411) ( -\CREATECOREDEVICE 44413 . 47861)) (47864 50165 (\NODIRCOREFDEV 47874 . 48471) (\NODIRCORE.OPENFILE -48473 . 50163))))) + (FILEMAP (NIL (1707 44342 (\CORE.CLOSEFILE 1717 . 2490) (\CORE.DELETEFILE 2492 . 4478) ( +\CORE.DIRECTORYNAMEP 4480 . 4741) (\CORE.FINDPAGE 4743 . 7972) (\CORE.GENERATEFILES 7974 . 10561) ( +\CORE.NEXTFILEFN 10563 . 11062) (\CORE.FILEINFOFN 11064 . 11293) (\CORE.GETFILEHANDLE 11295 . 13449) ( +\CORE.GETFILEINFO 13451 . 14414) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14416 . 15953) (\CORE.GETFILENAME +15955 . 18244) (\CORE.GETINFOBLOCK 18246 . 20869) (\CORE.NAMESCAN 20871 . 22638) (\CORE.NAMESEGMENT +22640 . 23077) (\CORE.OPENFILE 23079 . 26198) (\COREFILE.SETPARAMETERS 26200 . 28381) ( +\CORE.PACKFILENAME 28383 . 28778) (\CORE.RELEASEPAGES 28780 . 29381) (\CORE.SETFILEPTR 29383 . 30482) +(\CORE.UPDATEOF 30484 . 32113) (\CORE.BACKFILEPTR 32115 . 34323) (\CORE.SETEOFPTR 34325 . 36194) ( +\CORE.SETACCESSTIME 36196 . 36821) (\CORE.SETFILEINFO 36823 . 39125) (\CORE.GETNEXTBUFFER 39127 . +43083) (\CORE.UNPACKFILENAME 43085 . 44340)) (44343 47976 (COREDEVICE 44353 . 44524) ( +\CREATECOREDEVICE 44526 . 47974)) (47977 50278 (\NODIRCOREFDEV 47987 . 48584) (\NODIRCORE.OPENFILE +48586 . 50276))))) STOP diff --git a/sources/COREIO.LCOM b/sources/COREIO.LCOM index 3ca8afd2f05a7fd791f585d92326b66986debca9..97dd3e7a8c6494f9f8d6e3ec4e5ad7cfd428b3ae 100644 GIT binary patch delta 824 zcmZva-)qxQ6vvx7#nlI$EyDb<9mBw7*phpan|1+VX_~fILlbU0r_h(NmQjsv$Ph(v z*f-xSdGufKMW;^+{yjeFpWsQm(vmF?_l9#n=X=igp8IR4d>ksDb_!q=AMU;^qK*it z+qz*R8$AzoQv(%n?hI|tZDy(Ps=s&e;&2f4dywnDIgAE-gQMu}=+CO0!%L--3ccMU zg3ggaRJGiCUHG0WJ*VT<2uk%q<(LYi_YVpt;&-_WqHjGrT16_ z+wEeFG(bfxwhmq=Rv74;Hgem<(Yxx&{p{bhTUs`gS=ido(C1!B)}|^xWIPKrJl?f7M&tsh4DYbg46fI1#`1*SL7&lGmhTEO0 z)As7(NeEbGseoyv0?5+=9lFBzy@unL9N7S52x9D>RZ_{ULh>`V-T+oMrZ6X+`Cgbw zm1Z!pMtREWW$5~%9ePp*GQO=XZz0uk14%Y~PqgYm)qg~8C}Bqm8fG#Kw2ZR|H$l+6 zYw>68X5L^R#?u!;Ym%bJqdWPlbWJlEX2o|m^2gkQByVEW(9b9{q*(HjrdlN8O1};j p1X}5$T?rP&QcZIXUf=_nPoL0pOWbvyhUDd98R+Na!^Y1W{{b=o#ryyO delta 903 zcmZuvzi-n(6pquV5@vv^Bvr-oWD$jc68Y}@<7|P{IB`@9%eI`Lg2d7$Rw;E!)rKxe zM9RiS@XEr*f&>&MkRtvA{*-Pk44myiQ>Pw$_rCYN?|bj=UXQsSWA4q?4UB8f;G~8{ zj6l?MEb9`U?0X`qf&j{S4r3i*ou~rr90k3>!QoyQ^nvd^-G06s9GCUz=e^ap9PiJS z)a!Kt`rAXsyF^ODLY2SWwrsQMn~kp70^zb=1emmLIwG^5Ic% zvNw2foEVjL<|NhJ-jEH1C?H8kL>HCG%MA{n-p!xga$5OZuCTG2V_)-X{9jq&8vP_b z`?5AQuEf|k-Ux5<@ouN^shB3;83aBUA)mn0&96)2&$&O5QVGhX>E?3GeU=s{s@G?V zr8E`hqhFOGzcyorh3I#sGa~HFpLh?uMx$f4tw$bUjb;FqWB?gw07(U_#m*1#f*Mk0 zDWqj&5T#(zqzuW-)3!RE>HDq^iZmZdtikgfL8)GJt-8KM5Q*L|uZ|?JwtS1-U($mn zLeurxG`49uZP&0L0H&;rU2!XAD9R#(wO}Q$z;d0GMYKg0)?m&_qzPj*Z-q1s{yQP& zo9zXu42z%JKO-c`46xgP2!VLPn8kn)gEMm=Q32DnLAx*jO=hGj#C>!hdnTw9l2sP7 NLtXGbb?$sG{RJlY;fw$P