From ac1fcd2e2e45ecb97f2129e4ef1b021e9a09288d Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 19 Feb 2022 18:29:37 -0800 Subject: [PATCH 1/4] BROWSER: missing specvars, added MODERNWINDOW This should be included with Masterscope --- library/BROWSER | 86 +++++++++++++++++++++++-------------------- library/BROWSER.LCOM | Bin 10110 -> 10459 bytes 2 files changed, 46 insertions(+), 40 deletions(-) diff --git a/library/BROWSER b/library/BROWSER index c941717d..53640727 100644 --- a/library/BROWSER +++ b/library/BROWSER @@ -1,13 +1,16 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Mar-94 13:43:20" |{PELE:MV:ENVOS}LIBRARY>BROWSER.;4| 26296 - changes to%: (FNS BROWSER.MIDDLEFN) +(FILECREATED " 7-Feb-2022 14:06:19" {DSK}kaplan>Local>medley3.5>my-medley>library>BROWSER.;3 26344 - previous date%: "20-Jan-93 16:00:51" |{PELE:MV:ENVOS}LIBRARY>BROWSER.;3|) + :CHANGES-TO (VARS BROWSERCOMS) + (FNS GET.BROWSE.PP.WINDOW NUMSPATHS) + + :PREVIOUS-DATE "25-Mar-94 13:43:20" +{DSK}kaplan>Local>medley3.5>my-medley>library>BROWSER.;1) (* ; " -Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT BROWSERCOMS) @@ -31,6 +34,7 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (BrowserPPWindowWidth 750) (BROWSERFONT '(GACHA 8] [P (MOVD? 'MSPATHS 'OLDMSPATHS) + (MOVD? 'NILL 'MODERNWINDOW) (PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] (OR (MEMB 'BROWSER.WHENFNSCHANGED WC) (FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC] @@ -56,6 +60,7 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (NUMSPATHS [LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING) + (* ; "Edited 7-Feb-2022 13:57 by rmk") (* ; "Edited 11-Apr-88 11:08 by jrb:") (COND [(AND (WINDOWWORLD) @@ -72,37 +77,36 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T)) ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH) (CALLRELATION (PARSERELATION 'CALL] - (DECLARE (SPECVARS SEEN UNDONE)) + (DECLARE (SPECVARS SEEN UNDONE GRAPHNODE.LIST)) (CLRHASH SEEN) (for X in UNDONE do (PUTHASH X (COND - ((AND NOTRACE - (MSMEMBSET X NOTRACE)) - -1) - (T 0)) - SEEN) - (OR INVERTED (UPDATEFN X NIL 0))) + ((AND NOTRACE (MSMEMBSET X NOTRACE)) + -1) + (T 0)) + SEEN) + (OR INVERTED (UPDATEFN X NIL 0))) [do (COND - (NAMED (PUTHASH (CAR NAMED) - 0 SEEN) - [push ROOTS (fetch (GRAPHNODE NODEID) - of (BRPATHS1 (CAR NAMED] - (SETQ NAMED (CDR NAMED))) - (UNDONE [COND - ([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE) - SEEN))) - (EQ TEM 0) - (AND (LISTP TEM) - (NULL (CAR TEM] - (PUTHASH (CAR UNDONE) - (LIST NIL) - SEEN) - (SETQ NAMED (LIST (CAR UNDONE] - (SETQ UNDONE (CDR UNDONE))) - (T (RETURN] + (NAMED (PUTHASH (CAR NAMED) + 0 SEEN) + [push ROOTS (fetch (GRAPHNODE NODEID) + of (BRPATHS1 (CAR NAMED] + (SETQ NAMED (CDR NAMED))) + (UNDONE [COND + ([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE) + SEEN))) + (EQ TEM 0) + (AND (LISTP TEM) + (NULL (CAR TEM] + (PUTHASH (CAR UNDONE) + (LIST NIL) + SEEN) + (SETQ NAMED (LIST (CAR UNDONE] + (SETQ UNDONE (CDR UNDONE))) + (T (RETURN] (RETURN (LAYOUTFOREST GRAPHNODE.LIST ROOTS BROWSERFORMAT BROWSERBOXING] (PROG1 (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE) (* ; - "this LIST is actually an 'instance' of PATHSARGS") + "this LIST is actually an 'instance' of PATHSARGS") ] (T (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING]) @@ -204,7 +208,8 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (GET.BROWSE.PP.WINDOW]) (GET.BROWSE.PP.WINDOW - [LAMBDA NIL (* ; "Edited 31-Mar-87 11:23 by jop") + [LAMBDA NIL (* ; "Edited 7-Feb-2022 14:01 by rmk") + (* ; "Edited 31-Mar-87 11:23 by jop") (* ;  "returns the window for pretty printing from the browser.") (COND @@ -215,6 +220,7 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (WINDOWPROP PFWINDOW 'REPAINTFN 'PPREPAINTFN) (WINDOWPROP PFWINDOW 'RESHAPEFN 'PPRESHAPEFN) (WINDOWPROP PFWINDOW 'SCROLLFN 'SCROLLBYREPAINTFN) + (MODERNWINDOW PFWINDOW) PFWINDOW]) (GET.BROWSE.DESCRIBE.WINDOW @@ -446,10 +452,8 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (RECORD BROWSEWIN (ARGS GRAPH WINDOW)) (RECORD PATHSARGS (FROM TO . ETC) - [ACCESSFNS PATHSARGS ((DISCRIMINANT (CONS (fetch (PATHSARGS FROM) - of DATUM) - (fetch (PATHSARGS TO) - of DATUM]) + [ACCESSFNS PATHSARGS ((DISCRIMINANT (CONS (fetch (PATHSARGS FROM) of DATUM) + (fetch (PATHSARGS TO) of DATUM]) ) ) @@ -471,6 +475,8 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat (MOVD? 'MSPATHS 'OLDMSPATHS) +(MOVD? 'NILL 'MODERNWINDOW) + [PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED] (OR (MEMB 'BROWSER.WHENFNSCHANGED WC) (FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC] @@ -482,10 +488,10 @@ Copyright (c) 1983, 1984, 1987, 1988, 1990, 1993, 1994 by Venue & Xerox Corporat ) (PUTPROPS BROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1987 1988 1990 1993 1994)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1952 24987 (NUMSPATHS 1962 . 5228) (BROWSER 5230 . 5493) (BROWSER.WHENFNSCHANGED 5495 - . 7794) (BRPATHS1 7796 . 10062) (BROWSER.LEFTFN 10064 . 10922) (GET.BROWSE.PP.WINDOW 10924 . 11606) ( -GET.BROWSE.DESCRIBE.WINDOW 11608 . 12356) (BROWSEPP 12358 . 13232) (PPREPAINTFN 13234 . 16368) ( -PPRESHAPEFN 16370 . 16550) (DESCRIBEREPAINTFN 16552 . 17248) (BROWSERDESCRIBE 17250 . 18008) ( -BROWSER.MIDDLEFN 18010 . 19317) (DEDITPROCESSRUNNINGP 19319 . 19590) (REDRAWBROWSEGRAPH 19592 . 20355) - (STBROWSER 20357 . 24985))))) + (FILEMAP (NIL (2054 25148 (NUMSPATHS 2064 . 5246) (BROWSER 5248 . 5511) (BROWSER.WHENFNSCHANGED 5513 + . 7812) (BRPATHS1 7814 . 10080) (BROWSER.LEFTFN 10082 . 10940) (GET.BROWSE.PP.WINDOW 10942 . 11767) ( +GET.BROWSE.DESCRIBE.WINDOW 11769 . 12517) (BROWSEPP 12519 . 13393) (PPREPAINTFN 13395 . 16529) ( +PPRESHAPEFN 16531 . 16711) (DESCRIBEREPAINTFN 16713 . 17409) (BROWSERDESCRIBE 17411 . 18169) ( +BROWSER.MIDDLEFN 18171 . 19478) (DEDITPROCESSRUNNINGP 19480 . 19751) (REDRAWBROWSEGRAPH 19753 . 20516) + (STBROWSER 20518 . 25146))))) STOP diff --git a/library/BROWSER.LCOM b/library/BROWSER.LCOM index c62ed9b432d4fb6c27037caafe8a9158c68e7704..bdffbde2d8c3c18010fc0938d72a78ae3e4488ad 100644 GIT binary patch delta 1824 zcmbspOKjU@IBwIebsuU=pXuvs(yUG)!FKvcvnt3mFT znldlkUdZhhcXkuk3)|(wjfA|lS|}$ri)-cLUNkb3*xU&f!tLiDMBfn`|^;;9(zggb{S zI?TgG&>;pHL(sFTmJ%bfWLhYi14Gj+6RBCSLoj4qFA?aaljq0LWv~IiagEhO)HF(n}Iu>EaBtvg%w)@={i!*-87YERgGC7=7bE=!%%l1p6qP~G_TuG)BbR%-Zc|5NJV zPl+n6`D)RS_8sm2NY$e&l$$T5b@*PabQ~)Um-p{@7(N=s4!JAH0ng8Xp0nJM@$CF5 z&Ba)`^Eg69R2EIqf`*xx z(Vt=YEqP zVdI%}J6%u7-SPaHdlY>zboP4+(O=Eo4Tw5gN2pP}3%HAVx_Vu3{#QJd$D_NgImkIu zn>y&ydZ&k(XFh+bJhU=voOw1p` zD#GW-3kZ+KuOb}vUqg7ug%A8MApKQv&{+v6PtzehH;R@|JqOHkPQyE*O0tZyD)VSL z&VFD4EguA?ykI9o&QT!T0!&iFQ^nAZJ~8Rsnpo&NZL5Wz(N~CkwDaY}7~1|c5k)u> z92}w<+@a;=`eUoTKcY`N%RwJ%m4jn_b**~)U5B*uQ80iCUj$*Su27q0T2n1xG6J4g qh>@^w2ADA7|5+iic=p`22HGvo$xb|jVSYO|g>ZQCaubc|(fqihCZ8P4zLm;eR0%{ayJ zEEF(IGM6ppjw*1GacXLcg6zgV=6RI|8|DHL%KIOxY_OIg06sq#@N+Cf!STJ6APHP@ zl@sJuMY}&EiCSu2QH5DaoKtyq?Sf_C7}yY7iH0DP-`Ls8?ZJL&lmnWK%NjK9k`!Yx zNr=l{*e&M{3#EfSiy+!jEHk;du`?OWlKK>m;X{$npGueg(1iccpro?#dt zaIpw!tlJ0Ne$WI#h7_={BF7Y2Fcf!RB@CjxDyZf|#UTQ+l2-Y70p%#fRV9gnj{yv* zigG$GEtuavNGs;f0>7$=F;TWo{f!I86*bAHO@lz=Xim9Nw+bSO6t7}qc)|9(wY_2^ z@|o9k=SOWeTxaVhp1x5WY&V6x$L%KcuEHhrBe7+ob$;e%Tb63l;t8AYF%@Sg-)D(6 z-Su%+cUkry-Z_7Jd+D;J)19A+`R$r)Z#w-!I%OBLpDz$gmnx?I*2CoXub(BGPFol4 zU!D9+RR35c@>x&a8D-DcC%+JlU=m@aCS=bylKtk%7qafr`#a1yU5Of%F1<_d)}8uQ zeNcDhJ=U@~&*ZamSI5R*OZks)=kjT;EVXMY}Nz%z!&yIY9*cEwFC}N z_(EnQuprdWnJBEJVp!6+4ABdlNC@98DJ17KAq~MO%uA{jClCdE0h}s9;?suHaos`E zEE6`~bPNzt#D3$*F%~3gvz6+dWHk{j0gWMfbqU|ni+#j^CUV>avKCD8No~S->NqDz z<7o?p_&sMQlzTyW@t9 zu-Q^pt*eUh%sFekbh?_bg2pH08hZXo9va_uc3#;n7k2icbg&P13p?4;T^wrTQAc01 znX+1Sie|ExonhQ?4Em}mcOLUrzr6CqO#fE*Vg20I6ErR3SEtSGo!%*Pd+a%CLjCK5 zX2N#|UmzX~6;biiP`~MZKAb_!P#cKfQtOCg*ESK~v+%cTH&I?5*=#1gUN9bvXB;Hx z^Iqe{$fPk$UvKu}ufcdUI%DK%m&1z-Z#6oEKK)~U#MD@Ch@`O>mX{loR39!`l Date: Sat, 19 Feb 2022 18:32:24 -0800 Subject: [PATCH 2/4] TEDITWINDOW: Fix offscreen scrolling #669 --- library/TEDITWINDOW | 468 +++++++++++++++++++-------------------- library/TEDITWINDOW.LCOM | Bin 56515 -> 56680 bytes 2 files changed, 223 insertions(+), 245 deletions(-) diff --git a/library/TEDITWINDOW b/library/TEDITWINDOW index 96997d8a..dab2bf16 100644 --- a/library/TEDITWINDOW +++ b/library/TEDITWINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Jan-2022 23:14:36"  -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;32 189300 +(FILECREATED "18-Feb-2022 14:54:02"  +{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;33 187007 - :CHANGES-TO (FNS TEDIT.GETINPUT) + :CHANGES-TO (FNS \TEDIT.SCROLLFN) - :PREVIOUS-DATE " 1-Jan-2022 23:55:46" -{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;31) + :PREVIOUS-DATE "21-Jan-2022 23:14:36" +{DSK}kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;32) (* ; " @@ -1969,9 +1969,13 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ]) (\TEDIT.SCROLLFN - [LAMBDA (W DX DY) (* ; "Edited 19-Sep-2021 23:10 by rmk:") - (* Handle scrolling of the edit - window) + [LAMBDA (W DX DY) + + (* ;; + "Edited 18-Feb-2022 14:53 by rmk: Repaint after scrolling for windows that are partially off-screen") + + (* ;; "Edited 19-Sep-2021 23:10 by rmk:") + (* Handle scrolling of the edit window) (TOTOPW W) (PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (PRIORCR 0) @@ -1985,34 +1989,30 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ((ZEROP (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) (* Don't scroll a zero-length file) (RETURN)) - ((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) - (* Don't scroll while something - interesting is happening!) + ((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) (* Don't scroll while something + interesting is happening!) (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress." T) (RETURN))) (* Displaystream for the window) - (SETQ WHEIGHT (fetch HEIGHT of WREG)) (* Height of the window) - (SETQ LOWESTY WHEIGHT) (* Lowest Y of a line-bottom yet - seet) - (SETQ WWIDTH (fetch WIDTH of WREG)) (* Width of the window) + (SETQ WHEIGHT (fetch HEIGHT of WREG)) (* Height of the window) + (SETQ LOWESTY WHEIGHT) (* Lowest Y of a line-bottom yet seet) + (SETQ WWIDTH (fetch WIDTH of WREG)) (* Width of the window) (SETQ LINES (WINDOWPROP W 'LINES)) (* List of formatted lines) - (AND PRESCROLLFN (DOUSERFNS PRESCROLLFN W)) (* If there's a pre-scroll fn, - execute it now.) + (AND PRESCROLLFN (DOUSERFNS PRESCROLLFN W)) (* If there's a pre-scroll fn, execute + it now.) (COND ((fetch (SELECTION SET) of (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) (* Turn off the selection during the - scroll.) + scroll.) (SETQ SELWASON (fetch (SELECTION ONFLG) of SEL)) (\SHOWSEL SEL NIL NIL))) - (SETQ SHIFTEDSELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ SHIFTEDSEL) - of TEXTOBJ))) + (SETQ SHIFTEDSELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) + ) (\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) NIL NIL) - (SETQ MOVESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ MOVESEL) - of TEXTOBJ))) + (SETQ MOVESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))) (\SHOWSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) NIL NIL) - (SETQ DELETESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ DELETESEL) - of TEXTOBJ))) + (SETQ DELETESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))) (\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) NIL NIL) (COND @@ -2023,83 +2023,69 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat [(ILESSP 0 DY) (* Scroll text up) (SETQ LINE LINES) (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT)) do (SETQ LINE (fetch (LINEDESCRIPTOR - NEXTLINE) - of LINE))) + WHEIGHT)) do (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) + of LINE))) (first [COND - ((AND LINE (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - TRUEY)) (* Make sure we scroll up at least - one line.) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of - LINE) - (replace (LINEDESCRIPTOR YBOT) of LINE - with WHEIGHT))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] - while LINE do (* Find the line whose top is to - move to the top of the window) - [COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - TRUEY) - (RETURN)) - (T (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR - DESCENT) - of LINE) - (replace (LINEDESCRIPTOR - YBOT) of LINE - with WHEIGHT] - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE))) + ((AND LINE (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) + TRUEY)) (* Make sure we scroll up at least one + line.) + (replace (LINEDESCRIPTOR YBASE) of LINE + with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE) + (replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT))) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] while LINE + do (* Find the line whose top is to move + to the top of the window) + [COND + ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) + TRUEY) + (RETURN)) + (T (replace (LINEDESCRIPTOR YBASE) of LINE + with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE) + (replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT] + (SETQ PREVLINE LINE) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) [COND (LINE (* There is a line to go to the top) (SETQ RHEIGHT (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) (fetch (LINEDESCRIPTOR ASCENT) of LINE))) (* Find the Ypos of the top of the - line's image) + line's image) (BITBLT W 0 0 W 0 (IDIFFERENCE WHEIGHT RHEIGHT) WWIDTH RHEIGHT 'INPUT 'REPLACE) (BITBLT NIL 0 0 W 0 0 WWIDTH (IDIFFERENCE WHEIGHT RHEIGHT) 'TEXTURE 'REPLACE WHITESHADE) - [bind NL (PL _ PREVLINE) for I from 1 to 50 while - PL - do (* Let him keep 50 lines above what - he can see on the screen) - (SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of PL)) + [bind NL (PL _ PREVLINE) for I from 1 to 50 while PL + do (* Let him keep 50 lines above what he + can see on the screen) + (SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of PL)) finally (COND - ((AND PL (NEQ PL LINES)) + ((AND PL (NEQ PL LINES)) (* There were more than 50 lines - (and we aren't pointing at the root) - %, so lop the spare ones off.) - (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) - of LINES)) - (UNINTERRUPTABLY - (replace (LINEDESCRIPTOR NEXTLINE) - of LINES with PL) - (replace (LINEDESCRIPTOR PREVLINE) - of PL with LINES)) - (bind NNL while (AND NL (NEQ NL PL)) - do (SETQ NNL NL) - (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) - of NL)) - (replace (LINEDESCRIPTOR NEXTLINE) - of NNL with NIL] + (and we aren't pointing at the root)%, + so lop the spare ones off.) + (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) + (UNINTERRUPTABLY + (replace (LINEDESCRIPTOR NEXTLINE) of LINES + with PL) + (replace (LINEDESCRIPTOR PREVLINE) of PL with LINES)) + (bind NNL while (AND NL (NEQ NL PL)) + do (SETQ NNL NL) + (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) + of NL)) + (replace (LINEDESCRIPTOR NEXTLINE) of NNL + with NIL] (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch BOTTOM of WREG))) - do (* Update the bottom and baseline) - (replace (LINEDESCRIPTOR YBOT) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of - LINE) - (IDIFFERENCE WHEIGHT RHEIGHT))) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of - LINE) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE))) - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] + (fetch BOTTOM of WREG))) + do (* Update the bottom and baseline) + (replace (LINEDESCRIPTOR YBOT) of LINE + with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) + (IDIFFERENCE WHEIGHT RHEIGHT))) + (replace (LINEDESCRIPTOR YBASE) of LINE + with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) + (fetch (LINEDESCRIPTOR DESCENT) of LINE))) + (SETQ PREVLINE LINE) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] (COND ((AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) (fetch BOTTOM of WREG))) @@ -2108,72 +2094,67 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat LINE TEXTOBJ NIL W)) (PREVLINE (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) PREVLINE TEXTOBJ NIL W] - (T (* Scroll text down in window, - adding lines at top to fill.) + (T (* Scroll text down in window, adding + lines at top to fill.) (SETQ PREVLINE (SETQ TOPLINE LINES)) (* Find the top line on the screen%:) [while TOPLINE do (* Run thru the lines, until we hit the first one that is below the top of the - edit window) + edit window) - (COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) - of TOPLINE) - WHEIGHT) - (RETURN)) - (T (SETQ PREVLINE TOPLINE) - (SETQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE - ) of TOPLINE] + (COND + ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of TOPLINE) + WHEIGHT) + (RETURN)) + (T (SETQ PREVLINE TOPLINE) + (SETQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) + of TOPLINE] [COND ((AND (EQ PREVLINE LINES) (OR (NOT (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) - of (fetch (LINEDESCRIPTOR NEXTLINE) - of PREVLINE)) + (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of (fetch (LINEDESCRIPTOR + NEXTLINE) + of PREVLINE)) 1))) (* There's nothing between us and - start of file that's formatted; - start by making some.) + start of file that's formatted; + start by making some.) (SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT] (SETQ THEIGHT 0) (* Accumulates the heights of the lines we've backed over. - When this exceeds the scrolling distance, we've found the line.) + When this exceeds the scrolling distance, we've found the line.) - (bind (FIRSTTIME _ T) while (OR FIRSTTIME - (AND (ILESSP THEIGHT (IABS DY)) - (IGEQ (fetch (LINEDESCRIPTOR - CHAR1) - of PREVLINE) - 1))) + (bind (FIRSTTIME _ T) while (OR FIRSTTIME (AND (ILESSP THEIGHT (IABS DY)) + (IGEQ (fetch (LINEDESCRIPTOR + CHAR1) of PREVLINE) + 1))) do (* Starting with PREVLINE, accumulate LHEIGHTs until we hit top of text or have - accumulated enough lines to fill the screen) + accumulated enough lines to fill the screen) - (add THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of PREVLINE)) - (SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE)) - [COND - ((OR (NOT PREVLINE) - (ILESSP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE) - 1)) (* We need to format some lines - above where we are -- - go do it.) - (SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT] - (SETQ FIRSTTIME NIL)) + (add THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of PREVLINE)) + (SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE)) + [COND + ((OR (NOT PREVLINE) + (ILESSP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE) + 1)) (* We need to format some lines above + where we are -- go do it.) + (SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT] + (SETQ FIRSTTIME NIL)) [COND ([OR (EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) - (EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) - of (fetch (LINEDESCRIPTOR NEXTLINE) of - PREVLINE - ] + (EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of (fetch (LINEDESCRIPTOR + NEXTLINE) + of PREVLINE] (* Always move at least one line backward. - So if we're about to move no lines, force a single line.) + So if we're about to move no lines, force a single line.) ) ((ILESSP (IABS DY) - THEIGHT) (* BACK UP ONE LINE TO GET TO THE - ONE WHICH PUSHED US OVER TOP) + THEIGHT) (* BACK UP ONE LINE TO GET TO THE ONE + WHICH PUSHED US OVER TOP) (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) (SETQ THEIGHT (IDIFFERENCE THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of PREVLINE] @@ -2181,7 +2162,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat ((NEQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE] (* Move to the first line to be - formatted.-) + formatted.-) (BITBLT W 0 THEIGHT W 0 0 WWIDTH (IDIFFERENCE WHEIGHT THEIGHT) 'INPUT 'REPLACE) @@ -2189,27 +2170,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat WWIDTH THEIGHT 'TEXTURE 'REPLACE WHITESHADE) (bind (LINE _ TOPLINE) while LINE do (COND - ((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IPLUS (fetch BOTTOM of WREG) - THEIGHT)) (* This line will be on screen. - Adjust its YBOT/YBASE) - (replace (LINEDESCRIPTOR YBOT) of LINE - with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) - of LINE) - THEIGHT)) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) - of LINE) - THEIGHT)) - (SETQ LOWESTY (fetch (LINEDESCRIPTOR YBOT) of LINE))) - (T (replace (LINEDESCRIPTOR YBOT) of LINE - with (SUB1 (fetch BOTTOM of WREG))) - (replace (LINEDESCRIPTOR NEXTLINE) - of (fetch (LINEDESCRIPTOR PREVLINE) of LINE) - with NIL) - (SETQ LINE (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (RETURN))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) + ((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) + (IPLUS (fetch BOTTOM of WREG) + THEIGHT)) (* This line will be on screen. + Adjust its YBOT/YBASE) + (replace (LINEDESCRIPTOR YBOT) of LINE + with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINE) + THEIGHT)) + (replace (LINEDESCRIPTOR YBASE) of LINE + with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LINE) + THEIGHT)) + (SETQ LOWESTY (fetch (LINEDESCRIPTOR YBOT) of LINE))) + (T (replace (LINEDESCRIPTOR YBOT) of LINE + with (SUB1 (fetch BOTTOM of WREG))) + (replace (LINEDESCRIPTOR NEXTLINE) of (fetch (LINEDESCRIPTOR + PREVLINE) + of LINE) with NIL) + (SETQ LINE (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) + (RETURN))) + (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) (* Clear anything below us)) (BITBLT NIL 0 0 W 0 (fetch BOTTOM of WREG) WWIDTH @@ -2221,104 +2200,89 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat do (* Move down lines to be added, adjusting YBOT/YBASE and DISPALYLINE-ing them, - until the next line to do EQ TOPLINE) + until the next line to do EQ TOPLINE) - [replace (LINEDESCRIPTOR YBOT) of PREVLINE - with (COND - [(AND (fetch (LINEDESCRIPTOR PREVLINE) of - PREVLINE - ) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) - of PREVLINE) - 0) - (fetch (FMTSPEC FMTBASETOBASE) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of PREVLINE))) - (SETQ YBOT (IDIFFERENCE - (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of (fetch - (LINEDESCRIPTOR - PREVLINE) - of PREVLINE))) - (IPLUS (fetch (FMTSPEC FMTBASETOBASE) - of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of PREVLINE)) - (fetch (LINEDESCRIPTOR DESCENT) - of PREVLINE] - (T (SETQ YBOT (IDIFFERENCE YBOT (fetch ( + [replace (LINEDESCRIPTOR YBOT) of PREVLINE + with (COND + [(AND (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE) + (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE) + 0) + (fetch (FMTSPEC FMTBASETOBASE) of (fetch (LINEDESCRIPTOR + LFMTSPEC) + of PREVLINE))) + (SETQ YBOT (IDIFFERENCE (IPLUS YBOT (fetch (LINEDESCRIPTOR + DESCENT) + of (fetch ( LINEDESCRIPTOR - LHEIGHT) - of PREVLINE] - (replace (LINEDESCRIPTOR YBASE) of PREVLINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE) - )) - (\DISPLAYLINE TEXTOBJ PREVLINE W) - (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE] + PREVLINE) + of PREVLINE))) + (IPLUS (fetch (FMTSPEC FMTBASETOBASE) + of (fetch (LINEDESCRIPTOR LFMTSPEC + ) of PREVLINE)) + (fetch (LINEDESCRIPTOR DESCENT) + of PREVLINE] + (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT) + of PREVLINE] + (replace (LINEDESCRIPTOR YBASE) of PREVLINE + with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) + (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE))) + (\DISPLAYLINE TEXTOBJ PREVLINE W) + (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE] ((FLOATP DY) (* Do a thumbing-type scroll) (SETQ CH# (IMAX (IMIN (SUB1 TEXTLEN) (FIXR (FTIMES TEXTLEN DY))) 1)) (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) [while (AND LINE (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - CH#)) do (SETQ LINE (fetch (LINEDESCRIPTOR - NEXTLINE) - of LINE)) + CH#)) do (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) + of LINE)) finally (COND - ((AND LINE (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of - LINE) - CH#)) - (SETQ LINE NIL] (* find out if any line currently - formatted includes the target char) + ((AND LINE (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) + CH#)) + (SETQ LINE NIL] (* find out if any line currently + formatted includes the target char) (COND ((AND LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) (IGEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) 1)) (* If so, let's do this as a fast scroll, rather than a complete repaint of the - screen) + screen) [SETQ DY (COND [(ILEQ WHEIGHT (fetch (LINEDESCRIPTOR YBOT) of LINE)) (* this line is off the top of the - window) + window) (IMINUS (for (DESCENDLINE _ (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE)) - by (fetch (LINEDESCRIPTOR NEXTLINE) of - DESCENDLINE - ) - while (AND DESCENDLINE (ILEQ WHEIGHT - (fetch ( + of LINE)) + by (fetch (LINEDESCRIPTOR NEXTLINE) of DESCENDLINE) + while (AND DESCENDLINE (ILEQ WHEIGHT (fetch ( LINEDESCRIPTOR YBOT) - of DESCENDLINE))) + of DESCENDLINE))) sum (* sum the heights of all the lines in between the new top line and the present - top line) + top line) - (fetch (LINEDESCRIPTOR LHEIGHT) of - DESCENDLINE - ] + (fetch (LINEDESCRIPTOR LHEIGHT) of DESCENDLINE] (T (IDIFFERENCE (IDIFFERENCE WHEIGHT (fetch (LINEDESCRIPTOR YBOT) of LINE)) (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] (\TEDIT.SCROLLFN W 0 DY) - (* recurse telling to normally scroll instead of thumb scroll so that the - screen is not blanked and reformatted unnecessarily) + (* recurse telling to normally scroll instead of thumb scroll so that the screen + is not blanked and reformatted unnecessarily) ) (T [for LINE inside (fetch (SELECTION L1) of SEL) when LINE - do (replace (LINEDESCRIPTOR YBOT) of LINE - with (SUB1 (fetch BOTTOM of WREG] + do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 (fetch BOTTOM + of WREG] (* Make sure it thinks the old - selection is off-screen for now) + selection is off-screen for now) [for LINE inside (fetch (SELECTION LN) of SEL) when LINE - do (replace (LINEDESCRIPTOR YBOT) of LINE - with (SUB1 (fetch BOTTOM of WREG] + do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 (fetch BOTTOM + of WREG] (BITBLT NIL 0 0 W 0 (fetch BOTTOM of WREG) WWIDTH (IDIFFERENCE WHEIGHT (fetch BOTTOM of WREG)) @@ -2326,20 +2290,20 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat 'REPLACE WHITESHADE) (SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ WHEIGHT CH# W)) (* Find the first line to go in the - window) - (replace (LINEDESCRIPTOR YBOT) of LINE with - (IDIFFERENCE WHEIGHT - (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE))) + window) + (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE WHEIGHT + (fetch (LINEDESCRIPTOR + LHEIGHT) + of LINE))) (* Set it up as the top line.) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (LINEDESCRIPTOR DESCENT) of LINE))) + (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR + YBOT) of LINE) + (fetch (LINEDESCRIPTOR + DESCENT) + of LINE))) (\DISPLAYLINE TEXTOBJ LINE W) (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL W))) (* And fill out the window from - there.) + LINE TEXTOBJ NIL W))) (* And fill out the window from there.) )) (AND POSTSCROLLFN (DOUSERFNS POSTSCROLLFN W)) (* For user subsystem cleanup) [COND @@ -2364,7 +2328,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat TEXTOBJ) (AND DELETESELWASON (\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) NIL T] - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ W]) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ W)) + + (* ;; "rmk: This makes scrolling for partially off-screen window work properly.") + + (CL:UNLESS (LET [(WREG (WINDOWPROP W 'REGION] + (AND (IGEQ (FETCH (REGION BOTTOM) OF WREG) + 0) + (IGEQ (FETCH (REGION LEFT) OF WREG) + 0) + (ILEQ (FETCH (REGION PTOP) OF WREG) + SCREENHEIGHT) + (ILEQ (FETCH (REGION PRIGHT) OF WREG) + SCREENWIDTH))) + (\TEDIT.REPAINTFN W)) + NIL]) ) @@ -2874,25 +2852,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat (PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 1993 1994 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7221 95655 (TEDIT.CREATEW 7231 . 9985) (\TEDIT.CREATEW.FROM.REGION 9987 . 10971) ( -TEDIT.CURSORMOVEDFN 10973 . 22359) (TEDIT.CURSOROUTFN 22361 . 22896) (TEDIT.WINDOW.SETUP 22898 . 24707 -) (TEDIT.MINIMAL.WINDOW.SETUP 24709 . 32498) (\TEDIT.ACTIVE.WINDOWP 32500 . 33481) ( -\TEDIT.BUTTONEVENTFN 33483 . 58473) (\TEDIT.WINDOW.OPS 58475 . 62436) (\TEDIT.EXPANDFN 62438 . 62841) -(\TEDIT.MAINW 62843 . 64132) (\TEDIT.PRIMARYW 64134 . 65346) (\TEDIT.COPYINSERTFN 65348 . 66319) ( -\TEDIT.NEWREGIONFN 66321 . 68788) (\TEDIT.SET.WINDOW.EXTENT 68790 . 74892) (\TEDIT.SHRINK.ICONCREATE -74894 . 77166) (\TEDIT.SHRINKFN 77168 . 77743) (\TEDIT.SPLITW 77745 . 83846) (\TEDIT.UNSPLITW 83848 . -89542) (\TEDIT.WINDOW.SETUP 89544 . 95264) (\SAFE.FIRST 95266 . 95653)) (96985 97892 (TEDITWINDOWP -96995 . 97890)) (97929 100502 (TEDIT.GETINPUT 97939 . 99999) (\TEDIT.MAKEFILENAME 100001 . 100500)) ( -100551 107002 (TEDIT.PROMPTPRINT 100561 . 103465) (TEDIT.PROMPTFLASH 103467 . 105422) ( -\TEDIT.PROMPT.PAGEFULLFN 105424 . 107000)) (107237 111230 (TEXTSTREAM.TITLE 107247 . 107868) ( -\TEDIT.ORIGINAL.WINDOW.TITLE 107870 . 109846) (\TEDIT.WINDOW.TITLE 109848 . 110518) ( -\TEXTSTREAM.FILENAME 110520 . 111228)) (111273 156172 (TEDIT.DEACTIVATE.WINDOW 111283 . 118590) ( -\TEDIT.REPAINTFN 118592 . 121449) (\TEDIT.RESHAPEFN 121451 . 127071) (\TEDIT.SCROLLFN 127073 . 156170) -) (156214 158263 (\TEDIT.PROCIDLEFN 156224 . 157573) (\TEDIT.PROCENTRYFN 157575 . 157868) ( -\TEDIT.PROCEXITFN 157870 . 158261)) (158342 169342 (\EDIT.DOWNCARET 158352 . 159033) (\EDIT.FLIPCARET -159035 . 160570) (TEDIT.FLASHCARET 160572 . 161686) (\EDIT.UPCARET 161688 . 162141) ( -TEDIT.NORMALIZECARET 162143 . 168094) (\SETCARET 168096 . 169016) (\TEDIT.CARET 169018 . 169340)) ( -169376 183131 (TEDIT.ADD.MENUITEM 169386 . 171301) (TEDIT.DEFAULT.MENUFN 171303 . 180570) ( -TEDIT.REMOVE.MENUITEM 180572 . 181573) (\TEDIT.CREATEMENU 181575 . 182028) (\TEDIT.MENU.WHENHELDFN -182030 . 182800) (\TEDIT.MENU.WHENSELECTEDFN 182802 . 183129))))) + (FILEMAP (NIL (7222 95656 (TEDIT.CREATEW 7232 . 9986) (\TEDIT.CREATEW.FROM.REGION 9988 . 10972) ( +TEDIT.CURSORMOVEDFN 10974 . 22360) (TEDIT.CURSOROUTFN 22362 . 22897) (TEDIT.WINDOW.SETUP 22899 . 24708 +) (TEDIT.MINIMAL.WINDOW.SETUP 24710 . 32499) (\TEDIT.ACTIVE.WINDOWP 32501 . 33482) ( +\TEDIT.BUTTONEVENTFN 33484 . 58474) (\TEDIT.WINDOW.OPS 58476 . 62437) (\TEDIT.EXPANDFN 62439 . 62842) +(\TEDIT.MAINW 62844 . 64133) (\TEDIT.PRIMARYW 64135 . 65347) (\TEDIT.COPYINSERTFN 65349 . 66320) ( +\TEDIT.NEWREGIONFN 66322 . 68789) (\TEDIT.SET.WINDOW.EXTENT 68791 . 74893) (\TEDIT.SHRINK.ICONCREATE +74895 . 77167) (\TEDIT.SHRINKFN 77169 . 77744) (\TEDIT.SPLITW 77746 . 83847) (\TEDIT.UNSPLITW 83849 . +89543) (\TEDIT.WINDOW.SETUP 89545 . 95265) (\SAFE.FIRST 95267 . 95654)) (96986 97893 (TEDITWINDOWP +96996 . 97891)) (97930 100503 (TEDIT.GETINPUT 97940 . 100000) (\TEDIT.MAKEFILENAME 100002 . 100501)) ( +100552 107003 (TEDIT.PROMPTPRINT 100562 . 103466) (TEDIT.PROMPTFLASH 103468 . 105423) ( +\TEDIT.PROMPT.PAGEFULLFN 105425 . 107001)) (107238 111231 (TEXTSTREAM.TITLE 107248 . 107869) ( +\TEDIT.ORIGINAL.WINDOW.TITLE 107871 . 109847) (\TEDIT.WINDOW.TITLE 109849 . 110519) ( +\TEXTSTREAM.FILENAME 110521 . 111229)) (111274 153879 (TEDIT.DEACTIVATE.WINDOW 111284 . 118591) ( +\TEDIT.REPAINTFN 118593 . 121450) (\TEDIT.RESHAPEFN 121452 . 127072) (\TEDIT.SCROLLFN 127074 . 153877) +) (153921 155970 (\TEDIT.PROCIDLEFN 153931 . 155280) (\TEDIT.PROCENTRYFN 155282 . 155575) ( +\TEDIT.PROCEXITFN 155577 . 155968)) (156049 167049 (\EDIT.DOWNCARET 156059 . 156740) (\EDIT.FLIPCARET +156742 . 158277) (TEDIT.FLASHCARET 158279 . 159393) (\EDIT.UPCARET 159395 . 159848) ( +TEDIT.NORMALIZECARET 159850 . 165801) (\SETCARET 165803 . 166723) (\TEDIT.CARET 166725 . 167047)) ( +167083 180838 (TEDIT.ADD.MENUITEM 167093 . 169008) (TEDIT.DEFAULT.MENUFN 169010 . 178277) ( +TEDIT.REMOVE.MENUITEM 178279 . 179280) (\TEDIT.CREATEMENU 179282 . 179735) (\TEDIT.MENU.WHENHELDFN +179737 . 180507) (\TEDIT.MENU.WHENSELECTEDFN 180509 . 180836))))) STOP diff --git a/library/TEDITWINDOW.LCOM b/library/TEDITWINDOW.LCOM index 703235a10e3cefee2df4227e5b55d02d76a9b61d..330f8b23b9e369d3636814d6b63759370bfa7bd9 100644 GIT binary patch delta 3267 zcmZuzO>7%g5UvxEl0d7b2?aGEJ%tdGL!zDcv-{Q(RULcXY`XPY_T~o&QhyRb5@uY5F-JNT1J(nk|fm3pW*?O_&dtSLhHm;KK@}lRFw2j%>*>SRV>21{OWm}9- z4^5R_&necN(*-n0#(Q}e{hcf483Ab-hDGwl`9kHKQ=bWZGF7hB$xz0XX_BwjoF&&^ ztk0CtYE;a^F|y_30!1cg7Y5j^NMzGq=YUw$<0hW9o0?=of?P z|Ls2-M|TefKNuLGfBF1Q|A&p-FaBst<@oUMgkM%z->V}rcw%^X(qCwT;X&b}Am`s3 zY5tsT+Pgn6oO^WBKhc+a@Y+8=0Dd(;rWAs|eSNuKFRF9Z?g(xwEP+mbb9OM=yYbY- z;lDory7BNypSN6j8W%%b@#@rr{l?*c(a$%wb2NJ4=Ge*WO(}K8)^DRn?llfKqs^OR zOINaR?Z^~m)X?sgf)FuSbE*Zm65wr9Ln7){>WejJ*{ziPWrQpm`KL~Y)G#?&tuiB7WO|FED{U>X4LmG12r{jOoFFBhMQ(1OP!91ZrMH`rR+;j5*G7PUI za8?3;ZUGlerWQ)p!Tu7sz9KE8_wb@)EwGW!ffKfDfNjx~8rWuHA8c-?)L7aE*j-wX z+LM+{?@2DQfr6xTQU`(QSaj*rkJ)K7dz=Wp zFx^{jWAVp^xNSu68Rl1WmSc%#1K`5eF={3m=Mnpvh72QVaK z)+L6mOv7;2YZ&NcVMd&tu+tlW_Fx+A!4Ar05;w&gQ`Oasn_}H{I7pGwZl$`2T^Ad> z<`!7ZkfL|a91B73A^@!}l5QdZG)oV(4f<^XmV7o11`ZGn6U`J(bRA+~Bhmz!5xx2O zNT}U{nrsiss;)xXcsx<1&>8plyGHslEdxwz!< WEe8<&zPEzU*ss2S=Agd6v+zI2b6o%c delta 3172 zcmZuzO>7%g5Uy=C50*RCmXsW^i z3DK1zC=^u{WG`?83GQwbB#=-JoVaiYaX{k24SM6!h*>-K{yg_kXXee!oB7^1GyC_C zg`a;Ye7-(S$wGbW<^si(BFajHmzed%{?&laqawwLGg=a|L}U?-zj1r#&4YJt?Y+IT zjdtF@b^F~{O2~JrHGgs0@oSCdnveEwqN2Ozc_nDl6s2veRDhHJWo9Z8V;~avqhME$3=YueBGdW#2(Xl&(yO z5)c2$E$7Iwop(RTJrmyfaC`pvvZfacC(qT#F2KKEUVHd#{UG{l@5$)@-H9inpND_# zP8>gVXKajqrTIzWu$w#7(|w0alanuNH`3*&rv}Q2$;nw=?$=!**`HY@@ z^yO}c-_^W(=4t*-_v|gr`)4nJaASWU%{)5lo;AYRy9dF?h3~Z6SvlSPRJ%F&)o#Ay zp6Zp8i`~b+_I&k3KDYnd^o7&zRLHYA-VWK5P8#g*i$YLz{gp z+m)8~JhuU_X33#4ygoA-fCi(@_KIF_JJG9hiZuPaZKVafC_Y zNG83cWuYoOq|=HXnn=N4iu^opz1FDebB>^g zU-EoJEUFCkmZj;&v}0E=M; z%!*LD?zD6hF)$nA7ZG|WPz#C~B1-|Hfk14P#K98bpL+Tdi-Qs>!tr~Zry1cW!lCNG z6V{r(ZXrr775;bca!!Tlv)RD54FkZ()Nx_z;KFQhLPo^HW;|^7;|0mgFre)_8@^tu z1Ctm}2$Ue8lvD9*I$|M|H83O!-Y^zq9D*nyYwQJL@(cV2#6%o)L}J32k-^y$00V*J%cIe%u8%xp_T(QuS6U_$8D_@3F+)Dl}gyM((wae z1hF7k_EHO*Iw6gRBmw}*`U=Y+0TIF=3lU7cXgV{D+*QBbbSluFl!ag4pMvf+?ii6D zSJ2l3S1!#0xNQdF(2LpNT%_6FLy5y8974{4=Mm|8kTYe5U?U!ljlhZtlPxUUYymtH zgQ1nplZ~JnBPLs@GO?f|m@hzz?ArsmIEJkjBV zz_Q2|L3m`HBjMJAseqVBV(9Oz4~9ix=!6Ln=H`7ECaK|z&2bd%tBjq>K1>TKW@M+R zL4Rr1AkAiyc3?DyMXm2w2TFZiOfdRt=kho7UVH;Nqb7u)4ZYDutKD|ig9Q0PC zAO>_?r6&Tw#9;|%;&U?#4j(#MD{g?v&sS-39da1tSx;;f&Jvp|+V=6jWAMc>*o#!f ztB=CUkFBVUV=Hkj-m4T^Ct(KDXBZ4RJwAa?xugVBcVIVYcKA}mDm*;e$P;z^$I<=z E|3Ys`0RR91 From c4fac75f0a3daf3cdaab50ee320c609cd4c24e39 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 19 Feb 2022 18:35:11 -0800 Subject: [PATCH 3/4] LAFITE files: Tedit--strings are filenames more of #666 --- library/lafite/LAFITECOMMANDS | 221 ++++++++-------- library/lafite/LAFITECOMMANDS.LCOM | Bin 59029 -> 59168 bytes library/lafite/LAFITEFOLDERS | 166 +++++++++--- library/lafite/LAFITEFOLDERS.LCOM | Bin 31037 -> 31185 bytes library/lafite/LAFITESEND | 402 +++++++++++++++-------------- library/lafite/LAFITESEND.LCOM | Bin 45076 -> 45513 bytes library/lafite/MAILSCAVENGE | 69 ++--- library/lafite/MAILSCAVENGE.LCOM | Bin 11961 -> 12010 bytes 8 files changed, 476 insertions(+), 382 deletions(-) diff --git a/library/lafite/LAFITECOMMANDS b/library/lafite/LAFITECOMMANDS index 2719daeb..62ed44c9 100644 --- a/library/lafite/LAFITECOMMANDS +++ b/library/lafite/LAFITECOMMANDS @@ -1,9 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Sep-2021 22:58:57"  -{DSK}KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITECOMMANDS.;1 163531 - previous date%: "28-Jun-99 10:23:32" -{DSK}KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITECOMMANDS.;1) +(FILECREATED " 7-Feb-2022 12:04:09"  +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;2 164626 + + :CHANGES-TO (FILES LAFITEDECLS) + (FNS \LAFITE.HARDCOPY.PROC \LAFITE.HARDCOPY.HEADERS) + + :PREVIOUS-DATE "30-Sep-2021 22:58:57" +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;1) (* ; " @@ -688,28 +692,26 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (ADDTOVAR LAFITE.EXTRA.DISPLAY.COMMANDS ("Looks" '\LAFITE.SET.LOOKS.FROM.MENU "Change the appearance of the selected text, or whole message if nothing selected" - ) - ("Hardcopy" '\LAFITE.HARDCOPY.FROM.DISPLAY - "Hardcopy this message in its current appearance") - ("Unhide" '\LAFITE.UNHIDE.HEADERS + ) + ("Hardcopy" '\LAFITE.HARDCOPY.FROM.DISPLAY + "Hardcopy this message in its current appearance") + ("Unhide" '\LAFITE.UNHIDE.HEADERS "Display the header fields that are hidden from view." - (SUBITEMS ("Hide" '\LAFITE.REHIDE.HEADERS + (SUBITEMS ("Hide" '\LAFITE.REHIDE.HEADERS "Hide uninteresting fields from view again" - )))) + )))) (ADDTOVAR LAFITE.LOOKS.SUBCOMMANDS ("VP Line Breaks" 'LAFITE.SUBSTITUTE.VP.EOL - "Replace the Viewpoint end of line character with ours." - ) - ("Lowercase" 'LAFITE.SET.LOWER.CASE - "Lowercase the region or whole message.") - ("Spread Paragraphs" 'LAFITE.SET.PARA.SEPARATION + "Replace the Viewpoint end of line character with ours.") + ("Lowercase" 'LAFITE.SET.LOWER.CASE + "Lowercase the region or whole message.") + ("Spread Paragraphs" 'LAFITE.SET.PARA.SEPARATION "Separate paragraphs by 10 points (useful for Tioga messages)." - ) - ("Default" '\LAFITE.SET.DEFAULT.LOOKS - "Change selection (or whole text) back to default font" - ) - ("Fixed Width" '\LAFITE.SET.FIXED.LOOKS - "Change selection (or whole text) to fixed-width font")) + ) + ("Default" '\LAFITE.SET.DEFAULT.LOOKS + "Change selection (or whole text) back to default font") + ("Fixed Width" '\LAFITE.SET.FIXED.LOOKS + "Change selection (or whole text) to fixed-width font")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \LAFITE.DISPLAY.COMMANDS) @@ -1207,16 +1209,14 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (ADDTOVAR LAFITEEXTRAMENUITEMS ("Enable MoveTo Menu" '\LAFITE.ENABLE.MOVE.MENU "Attach a menu of folders for accelerated MoveTo (or modify existing one)" - (SUBITEMS ("Restore MoveTo Menu" - '\LAFITE.RESTORE.MOVE.MENU + (SUBITEMS ("Restore MoveTo Menu" '\LAFITE.RESTORE.MOVE.MENU "Just reopen the attached MoveTo menu if it existed." - ))) - ("Copy To" '\LAFITE.COPYTO - "Like MoveTo, but don't delete the message(s).")) + ))) + ("Copy To" '\LAFITE.COPYTO + "Like MoveTo, but don't delete the message(s).")) (ADDTOVAR LAFITE.EXTRA.MOVE.ITEMS ("---Display---" '\LAFITE.DISPLAY "Display the next message") - ("---Delete---" '\LAFITE.DELETE - "Delete the selected message(s)")) + ("---Delete---" '\LAFITE.DELETE "Delete the selected message(s)")) (RPAQ? LAFITE.AUTO.MOVE.MENU ) @@ -2225,7 +2225,8 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. 'MESSAGEHARDCOPIER]) (\LAFITE.HARDCOPY.PROC - [LAMBDA (MAILFOLDER ITEM MENU MSGLST BATCHFLG) (* ; "Edited 23-Aug-88 15:37 by bvm") + [LAMBDA (MAILFOLDER ITEM MENU MSGLST BATCHFLG) (* ; "Edited 7-Feb-2022 12:00 by rmk") + (* ; "Edited 23-Aug-88 15:37 by bvm") (PROG (LCASEFILENAME TEXTSTREAM) (RESETLST (LA.RESETSHADE ITEM MENU (AND BATCHFLG LAFITEHARDCOPYBATCHSHADE)) @@ -2238,8 +2239,8 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (SETQ LCASEFILENAME (L-CASE (fetch (MAILFOLDER FULLFOLDERNAME) of MAILFOLDER))) [SETQ TEXTSTREAM (COND - [(AND BATCHFLG (SETQ CONTINUEFLG (fetch - (MAILFOLDER + [(AND BATCHFLG (SETQ CONTINUEFLG (fetch (MAILFOLDER + HARDCOPYSTREAM ) of MAILFOLDER] @@ -2247,22 +2248,23 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. LAFITEHARDCOPY.MIN.TOC (>= (LENGTH MSGLST) LAFITEHARDCOPY.MIN.TOC)) - (\LAFITE.HARDCOPY.HEADERS MAILFOLDER - LCASEFILENAME MSGLST)) + (\LAFITE.HARDCOPY.HEADERS MAILFOLDER LCASEFILENAME + MSGLST)) (T (* ; "Start fresh") - (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT + (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'FONT LAFITEHARDCOPYFONT - ] + ] (\LAFITE.HARDCOPY.BODIES MAILFOLDER TEXTSTREAM MSGLST CONTINUEFLG) (COND - (BATCHFLG (\LAFITE.MARK.HARDCOPIED MAILFOLDER MSGLST - HARDCOPYBATCHMARK) - (replace (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER - with TEXTSTREAM) + (BATCHFLG (\LAFITE.MARK.HARDCOPIED MAILFOLDER MSGLST HARDCOPYBATCHMARK) + (replace (MAILFOLDER HARDCOPYSTREAM) of MAILFOLDER with + TEXTSTREAM + ) (replace (MAILFOLDER HARDCOPYMESSAGES) of MAILFOLDER - with (NCONC (fetch (MAILFOLDER HARDCOPYMESSAGES) - of MAILFOLDER) - MSGLST)) + with (NCONC (fetch (MAILFOLDER HARDCOPYMESSAGES) of + MAILFOLDER + ) + MSGLST)) (SETQ TEXTSTREAM])) (COND (TEXTSTREAM (* ; "Send to printer now...") @@ -2270,48 +2272,51 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (\LAFITE.HARDCOPY.HEADERS [LAMBDA (MAILFOLDER LCASEFILENAME MESSAGES INCLUDE# TEXTSTREAM) + (* ; "Edited 7-Feb-2022 12:01 by rmk") (* ; "Edited 3-Jun-88 17:50 by bvm") (PROG ((OUTPUTFILE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) TITLELEN TITLE TOCSTART TOCLEN FROMSTR SUBJLEFT DATELEFT TABSTOPS) (LINELENGTH MAX.SMALLP OUTPUTFILE) - (for MSG in MESSAGES as N from 1 - do + (for MSG in MESSAGES as N from 1 do + (* ;; + "Each line consists of [#.]datefromsubject") - (* ;; "Each line consists of [#.]datefromsubject") - - (OR (fetch (LAFITEMSG PARSED?) of MSG) - (LAFITE.PARSE.MSG.FOR.TOC MSG MAILFOLDER)) - (POSITION OUTPUTFILE 0) - [COND - (INCLUDE# (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) - (CL:FORMAT OUTPUTFILE "~D." N) - (\OUTCHAR OUTPUTFILE (CHARCODE TAB] - (PRIN3 (OR (fetch (LAFITEMSG DATE) of MSG) - UNSUPPLIEDFIELDSTR) - OUTPUTFILE) - (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) - (PRIN3 (OR (COND - ((fetch (LAFITEMSG MSGFROMMEP) of MSG) - (PRIN3 "To: " OUTPUTFILE) - (OR (fetch (LAFITEMSG TO) of MSG) - (LAFITE.FETCH.TO.FIELD MSG MAILFOLDER))) - (T (fetch (LAFITEMSG FROM) of MSG))) - UNSUPPLIEDFIELDSTR) - OUTPUTFILE) - (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) - (PRIN3 (OR (fetch (LAFITEMSG SUBJECT) of MSG) - UNSUPPLIEDFIELDSTR) - OUTPUTFILE) - (TERPRI OUTPUTFILE)) + (OR (fetch (LAFITEMSG PARSED?) of MSG) + (LAFITE.PARSE.MSG.FOR.TOC MSG MAILFOLDER)) + (POSITION OUTPUTFILE 0) + [COND + (INCLUDE# (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) + (CL:FORMAT OUTPUTFILE "~D." N) + (\OUTCHAR OUTPUTFILE (CHARCODE TAB] + (PRIN3 (OR (fetch (LAFITEMSG DATE) of MSG) + UNSUPPLIEDFIELDSTR) + OUTPUTFILE) + (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) + (PRIN3 (OR (COND + ((fetch (LAFITEMSG MSGFROMMEP) + of MSG) + (PRIN3 "To: " OUTPUTFILE) + (OR (fetch (LAFITEMSG TO) of MSG) + (LAFITE.FETCH.TO.FIELD MSG + MAILFOLDER))) + (T (fetch (LAFITEMSG FROM) of MSG))) + UNSUPPLIEDFIELDSTR) + OUTPUTFILE) + (\OUTCHAR OUTPUTFILE (CHARCODE TAB)) + (PRIN3 (OR (fetch (LAFITEMSG SUBJECT) of MSG) + UNSUPPLIEDFIELDSTR) + OUTPUTFILE) + (TERPRI OUTPUTFILE)) (SETQ OUTPUTFILE (OPENSTREAM (CLOSEF OUTPUTFILE) 'INPUT)) (SETQ TITLE (CL:FORMAT NIL "Messages from ~A~%%Listed on ~A~%%~%%" LCASEFILENAME (DATE))) (SETQ TITLELEN (NCHARS TITLE)) [COND (TEXTSTREAM (* ; - "Need to insert all this stuff at beginning of textstream") + "Need to insert all this stuff at beginning of textstream") (TEDIT.INSERT TEXTSTREAM TITLE 1)) - (T (SETQ TEXTSTREAM (OPENTEXTSTREAM TITLE (AND NIL (CREATEW NIL "Lafite headers")) + (T (SETQ TEXTSTREAM (OPENTEXTSTREAM (OPENSTRINGSTREAM TITLE) + (AND NIL (CREATEW NIL "Lafite headers")) NIL NIL (LIST 'FONT LAFITEHARDCOPYFONT] (PROGN (* ; "Make title centered") (TEDIT.PARALOOKS TEXTSTREAM '(QUAD CENTERED) @@ -2325,7 +2330,7 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (TEDIT.INSERT TEXTSTREAM [CONSTANT (CONCATCODES (CHARCODE (FF] (+ TOCSTART TOCLEN))) (* ; "Formfeed after the insertion") (PROGN (* ; - "Now give the toc lines the appropriate tab settings.") + "Now give the toc lines the appropriate tab settings.") (SETQ DATELEFT (COND (INCLUDE# 30) (T 0))) @@ -2335,7 +2340,7 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. 'LEFT] [COND (INCLUDE# (push TABSTOPS '(20 . RIGHT) - (CONS DATELEFT 'LEFT] + (CONS DATELEFT 'LEFT] (TEDIT.PARALOOKS TEXTSTREAM `(TABS (NIL ,@TABSTOPS) LEFTMARGIN ,(+ SUBJLEFT 20)) @@ -2492,7 +2497,7 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (ADDTOVAR LAFITEEXTRAMENUITEMS ("Cancel Pending Hardcopy" '\LAFITE.CANCEL.HARDCOPY "Forget about hardcopying the messages so far marked for hardcopy." - )) + )) (RPAQ? LAFITEHARDCOPYBATCHFLG NIL) @@ -2546,37 +2551,37 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. ) (PUTPROPS LAFITECOMMANDS COPYRIGHT ("Xerox Corporation" 1988 1989 1992 1993 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7824 27492 (\LAFITE.DISPLAY 7834 . 9539) (\LAFITE.DO.DISPLAY 9541 . 13706) ( -SELECTMESSAGETODISPLAY 13708 . 16076) (MESSAGEDISPLAYER 16078 . 23494) (LA.COPY.MESSAGE.TEXT 23496 . -24250) (\LAFITE.CLOSE.DISPLAYWINDOWS 24252 . 25846) (\LAFITE.CLOSE.DISPLAYER 25848 . 27490)) (27493 -36085 (\LAFITE.UNHIDE.HEADERS 27503 . 28593) (\LAFITE.HIDE.HEADERS 28595 . 29248) ( -\LAFITE.REHIDE.HEADERS 29250 . 30286) (LAFITE.EAT.UNDESIRABLE.FIELD 30288 . 31047) (LAFITE.EAT.GVGV -31049 . 32210) (\LAFITE.HARDCOPY.FROM.DISPLAY 32212 . 35731) (LAFITE.HARDCOPY.TAB.WIDTH 35733 . 36083) -) (36086 44389 (\LAFITE.SET.LOOKS.FROM.MENU 36096 . 36273) (\LAFITE.SET.DEFAULT.LOOKS 36275 . 36466) ( -\LAFITE.SET.FIXED.LOOKS 36468 . 36660) (LAFITE.SET.LOOKS 36662 . 41119) (LAFITE.SET.TAB.LOOKS 41121 . -41832) (LAFITE.SET.PARA.SEPARATION 41834 . 42042) (LAFITE.SET.LOWER.CASE 42044 . 42895) ( -LAFITE.SUBSTITUTE.VP.EOL 42897 . 44387)) (46459 54787 (LAFITE.DELETE.MESSAGES 46469 . 47519) ( -\LAFITE.DELETE 47521 . 48708) (DISPLAYAFTERDELETE 48710 . 53436) (\LAFITE.SELECT.NEXT 53438 . 54076) ( -\LAFITE.UNDELETE 54078 . 54785)) (54809 69304 (LAFITE.MOVE.MESSAGES 54819 . 55466) (\COERCE.TO.MSGLST -55468 . 56226) (\LAFITE.MOVETO 56228 . 60172) (\LAFITE.COPYTO 60174 . 60590) (\LAFITE.MOVETO.PROC -60592 . 61862) (\LAFITE.MOVE.MESSAGES.INTERNAL 61864 . 69302)) (69330 77882 (\LAFITE.ENABLE.MOVE.MENU -69340 . 70382) (\LAFITE.ADD.TO.MOVE.MENU 70384 . 71400) (\LAFITE.UPDATE.MOVE.MENU 71402 . 76042) ( -\LAFITE.RESTORE.MOVE.MENU 76044 . 76720) (\LAFITE.HANDLE.AUTO.MOVE 76722 . 77880)) (78864 96348 ( -\LAFITE.UPDATE 78874 . 84507) (\LAFITE.EXPUNGE.PROC 84509 . 85314) (\LAFITE.UPDATE.PROC 85316 . 86399) - (\LAFITE.HARDCOPYONLY.PROC 86401 . 86843) (LAB.CHOOSE.UPDATE.MENU 86845 . 87626) ( -LAB.CREATE.UPDATE.MENU 87628 . 89527) (LAB.UPDATE.NEEDED? 89529 . 91099) (\LAFITE.START.UPDATE 91101 - . 92133) (LAB.START.COMMAND 92135 . 92985) (\LAFITE.FINISH.UPDATE 92987 . 95240) ( -\LAFITE.CLOSE.OTHER.FOLDERS 95242 . 96346)) (96349 131143 (LAB.FLUSHWINDOW 96359 . 98038) ( -LAB.APPENDMESSAGES 98040 . 101202) (\LAFITE.COMPACT.FOLDER 101204 . 105368) (\LAFITE.COMPACT.FOLDER1 -105370 . 121409) (\LAFITE.COMPACT.FOLDER2 121411 . 126125) (\LAFITE.COMPACT.EXTRA 126127 . 128442) ( -\LAFITE.INVALIDATE.TOC 128444 . 129137) (\LAFITE.RENAMEFILE 129139 . 129609) (SMART-RENAMEFILEP 129611 - . 130171) (LA.OPENTEMPFILE 130173 . 131141)) (131144 144486 (\LAFITE.UPDATE.FOLDER 131154 . 133131) ( -\LAFITE.UPDATE.CONTENTS 133133 . 133850) (\LAFITE.UPDATE.CONTENTS1 133852 . 138706) (WRITETOCENTRY -138708 . 141826) (WRITETOCMARKBYTES 141828 . 142070) (WRITEFOLDERMARKBYTES 142072 . 144484)) (144512 -162219 (LAFITE.HARDCOPY.MESSAGES 144522 . 144982) (\LAFITE.HARDCOPY 144984 . 145319) ( -\LAFITE.HARDCOPY.PROC 145321 . 148539) (\LAFITE.HARDCOPY.HEADERS 148541 . 152862) ( -\LAFITE.MARK.HARDCOPIED 152864 . 154574) (\LAFITE.TRANSMIT.HARDCOPY 154576 . 156166) ( -\LAFITE.HARDCOPY.BODIES 156168 . 157410) (\LAFITE.APPEND.MESSAGE.BODY 157412 . 159520) ( -\LAFITE.DO.PENDING.HARDCOPY 159522 . 160597) (\LAFITE.CANCEL.HARDCOPY 160599 . 161315) ( -\LAFITE.CLEAR.HARDCOPY.STATE 161317 . 162217))))) + (FILEMAP (NIL (7934 27602 (\LAFITE.DISPLAY 7944 . 9649) (\LAFITE.DO.DISPLAY 9651 . 13816) ( +SELECTMESSAGETODISPLAY 13818 . 16186) (MESSAGEDISPLAYER 16188 . 23604) (LA.COPY.MESSAGE.TEXT 23606 . +24360) (\LAFITE.CLOSE.DISPLAYWINDOWS 24362 . 25956) (\LAFITE.CLOSE.DISPLAYER 25958 . 27600)) (27603 +36195 (\LAFITE.UNHIDE.HEADERS 27613 . 28703) (\LAFITE.HIDE.HEADERS 28705 . 29358) ( +\LAFITE.REHIDE.HEADERS 29360 . 30396) (LAFITE.EAT.UNDESIRABLE.FIELD 30398 . 31157) (LAFITE.EAT.GVGV +31159 . 32320) (\LAFITE.HARDCOPY.FROM.DISPLAY 32322 . 35841) (LAFITE.HARDCOPY.TAB.WIDTH 35843 . 36193) +) (36196 44499 (\LAFITE.SET.LOOKS.FROM.MENU 36206 . 36383) (\LAFITE.SET.DEFAULT.LOOKS 36385 . 36576) ( +\LAFITE.SET.FIXED.LOOKS 36578 . 36770) (LAFITE.SET.LOOKS 36772 . 41229) (LAFITE.SET.TAB.LOOKS 41231 . +41942) (LAFITE.SET.PARA.SEPARATION 41944 . 42152) (LAFITE.SET.LOWER.CASE 42154 . 43005) ( +LAFITE.SUBSTITUTE.VP.EOL 43007 . 44497)) (46416 54744 (LAFITE.DELETE.MESSAGES 46426 . 47476) ( +\LAFITE.DELETE 47478 . 48665) (DISPLAYAFTERDELETE 48667 . 53393) (\LAFITE.SELECT.NEXT 53395 . 54033) ( +\LAFITE.UNDELETE 54035 . 54742)) (54766 69261 (LAFITE.MOVE.MESSAGES 54776 . 55423) (\COERCE.TO.MSGLST +55425 . 56183) (\LAFITE.MOVETO 56185 . 60129) (\LAFITE.COPYTO 60131 . 60547) (\LAFITE.MOVETO.PROC +60549 . 61819) (\LAFITE.MOVE.MESSAGES.INTERNAL 61821 . 69259)) (69287 77839 (\LAFITE.ENABLE.MOVE.MENU +69297 . 70339) (\LAFITE.ADD.TO.MOVE.MENU 70341 . 71357) (\LAFITE.UPDATE.MOVE.MENU 71359 . 75999) ( +\LAFITE.RESTORE.MOVE.MENU 76001 . 76677) (\LAFITE.HANDLE.AUTO.MOVE 76679 . 77837)) (78695 96179 ( +\LAFITE.UPDATE 78705 . 84338) (\LAFITE.EXPUNGE.PROC 84340 . 85145) (\LAFITE.UPDATE.PROC 85147 . 86230) + (\LAFITE.HARDCOPYONLY.PROC 86232 . 86674) (LAB.CHOOSE.UPDATE.MENU 86676 . 87457) ( +LAB.CREATE.UPDATE.MENU 87459 . 89358) (LAB.UPDATE.NEEDED? 89360 . 90930) (\LAFITE.START.UPDATE 90932 + . 91964) (LAB.START.COMMAND 91966 . 92816) (\LAFITE.FINISH.UPDATE 92818 . 95071) ( +\LAFITE.CLOSE.OTHER.FOLDERS 95073 . 96177)) (96180 130974 (LAB.FLUSHWINDOW 96190 . 97869) ( +LAB.APPENDMESSAGES 97871 . 101033) (\LAFITE.COMPACT.FOLDER 101035 . 105199) (\LAFITE.COMPACT.FOLDER1 +105201 . 121240) (\LAFITE.COMPACT.FOLDER2 121242 . 125956) (\LAFITE.COMPACT.EXTRA 125958 . 128273) ( +\LAFITE.INVALIDATE.TOC 128275 . 128968) (\LAFITE.RENAMEFILE 128970 . 129440) (SMART-RENAMEFILEP 129442 + . 130002) (LA.OPENTEMPFILE 130004 . 130972)) (130975 144317 (\LAFITE.UPDATE.FOLDER 130985 . 132962) ( +\LAFITE.UPDATE.CONTENTS 132964 . 133681) (\LAFITE.UPDATE.CONTENTS1 133683 . 138537) (WRITETOCENTRY +138539 . 141657) (WRITETOCMARKBYTES 141659 . 141901) (WRITEFOLDERMARKBYTES 141903 . 144315)) (144343 +163318 (LAFITE.HARDCOPY.MESSAGES 144353 . 144813) (\LAFITE.HARDCOPY 144815 . 145150) ( +\LAFITE.HARDCOPY.PROC 145152 . 148630) (\LAFITE.HARDCOPY.HEADERS 148632 . 153961) ( +\LAFITE.MARK.HARDCOPIED 153963 . 155673) (\LAFITE.TRANSMIT.HARDCOPY 155675 . 157265) ( +\LAFITE.HARDCOPY.BODIES 157267 . 158509) (\LAFITE.APPEND.MESSAGE.BODY 158511 . 160619) ( +\LAFITE.DO.PENDING.HARDCOPY 160621 . 161696) (\LAFITE.CANCEL.HARDCOPY 161698 . 162414) ( +\LAFITE.CLEAR.HARDCOPY.STATE 162416 . 163316))))) STOP diff --git a/library/lafite/LAFITECOMMANDS.LCOM b/library/lafite/LAFITECOMMANDS.LCOM index 97a061df72827a850698137dcbdcc7772f523069..a5b32a9fdf545bde665245c8de2afccc45509313 100644 GIT binary patch delta 1179 zcma)6O>fjj7_Jjq!~#+(f>4qJFGg+Gf^}xbpKE$C_ITHg*IsNd5Qq?jtoVkIaG;15 zi93jN#0gbu%b`+FZ8l#BkT`OIbAAQCf!DiPk!^cmFP`_AXJ($~d1vLxS6@#=0|<5?w7pj;}PWe~YRh~BstWeSvoI73~NiULkEsbE3Ji zU%XlN_7a$hy(IQ9Mw5z>&iIgSildzg$q@CC;rDQ0Mse*s;wYMbe zKCTAffdzt97}vzq%X4}aA|B)oH?4&+7zEFEk7J-V_84){3jy5$9@-mFU7UC|`n68_ zIbuwhFDuYvnx$=}+eM9m3ib3ZPIqo#J+mpU-)~q&@WoRpD2!O!DoV*#HF)ocA)dXO z3^BSg_FjcFtkrV`G_4A9e#^l>3#Qv3|Lo&)r?|ho2fw-wW$Z`ZO^dre#sL~p@D|&h JeXk!X9|4EzIXVCU delta 1269 zcmbVM&2QX96vrEiXhM*HMyTaOFBYKP!LIyhIN7n20}eVJd0d?+n!qOZ^+A)+9v44oyZ^_ zaXd`)X?SzJ_txOuVgH@pIq1DVT)*(V2Wx|k^Zm6|=&ykubvcL0TEj4OICpkKXG&v>&F20UD%hSgk*i~63|vLpgtIi4jo!8W%>!1mkJi&cP&QOk^Sk6I-Bc zLV>yjmea0c%mh$}j>9&RJGYMa(by*q;LPaci;+;B5oW4Y@%=*Lko`nrxf5X}w9maL z6&+Tn>tat#5fidBkBc}>fM8p`yz{gI+2b51s&xy%4eMV4rLtl%PV#v-2mza}yt?zm zv*Y6X8^+j#Gz*g=JYC3pJ7+dc;9*p#qgjj-FkOYt7L+ay-i?DRPrcqixLEAqj6XgwVlZ%(}7nfY815z?*JZY*oWZ}yCLs>d!mA@ zvZpEt$rolafite>sources>lafitefolders;9" 42102 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS PROMPTFORFILENAME \LAFITE.RENAME.FOLDER) +(FILECREATED " 7-Feb-2022 12:04:09"  +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;2 44421 - previous date%: "29-Aug-89 11:11:20" "{pooh/n}lafite>sources>lafitefolders;8") + :CHANGES-TO (FNS \LAFITE.MAKE.RANDOM.DISPLAY) + + :PREVIOUS-DATE " 2-Nov-89 18:16:37" +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;1) -(* " -Copyright (c) 1989 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1989 by Xerox Corporation. ") (PRETTYCOMPRINT LAFITEFOLDERSCOMS) -(RPAQQ LAFITEFOLDERSCOMS ((* ;; "Maintenance of Lafite's folder structures, menus etc.") (COMS (* ; "The profile") (FNS \LAFITE.READ.PROFILE \LAFITE.PROCESS.PROFILE \LAFITE.WRITE.PROFILE \LAFITE.MERGE.NAMELISTS \LAFITE.READ.OLD.PROFILE \LAFITE.MERGE.FOLDERS \LAFITE.MERGE.STRUCTURES \LAFITE.REPACK.FOLDERS) (INITVARS (\LAFITEPROFILECHANGED) (LAFITEMAILFOLDERS) (\LAFITEPROFILEDATE)) (ADDVARS (LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS) (LAFITE.FOLDER.STRUCTURE \LAFITE.MERGE.STRUCTURES)))) (COMS (* ; "Prompting for folders") (FNS \LAFITE.PROMPTFORFOLDER PROMPTFORFILENAME MAKELAFITEMAILFOLDERSMENU MAKELAFITEFOLDERSMENUITEMS LAFITE.GROUP.ITEM \LAFITE.ARRANGE.MENU \LAFITE.MAKE.FOLDER.MENU LAFITE.SELECT.FOLDERS LAFITE.SELECT.MULTIPLE \LAFITE.HANDLE.MULTIPLE.SELECTION COLLECT.SHADED.ITEMS) (INITVARS (LAFITE.2COLUMN.MENU.MIN.ITEMS 10) (LAFITEFOLDERSMENU) (LAFITEMULTIPLEFOLDERSMENU)) (ADDVARS (LAFITEMENUVARS LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU))) (COMS (* ; "Name hacking") (FNS LA.LONGFILENAME LA.SHORTFILENAME FORGETMAILFILE \LAFITE.FOLDER.NAME.CHANGED \LAFITE.CHANGE.NAME.IN.LIST \LAFITE.RECOMPUTE.FOLDER.NAMES \LAFITE.NEW.SHORT.NAME \LAFITE.NOTICE.FILE \LAFITE.UNCACHE.FOLDER) (INITVARS LAFITE.HOST.ABBREVS \LAFITE.PSEUDO.DEVICES)) (COMS (* ; "Hacking the hierarchy") (FNS \LAFITE.NOTICE.FOLDERS \LAFITE.GC.FOLDERS \LAFITE.GC.FOLDERS.CONFIRM \LAFITE.MAKE.RANDOM.DISPLAY \LAFITE.CHANGE.FOLDER.LIST \LAFITE.RENAME.FOLDER \LAFITE.ADD.NEW.GROUP \LAFITE.CHECK.GROUP.NAME \LAFITE.CHANGE.GROUP.MEMBERS \LAFITE.SELECT.GROUP.FOLDERS \LAFITE.CHANGE.SUBGROUPS \LAFITE.CHANGE.TOP.GROUPS \LAFITE.DELETE.GROUP LAFITE.RENAME.GROUP \LAFITE.EDIT.HIERARCHY LAFITE.FIND.GROUP UALPHORDERCAR) (VARS LAFITE.SPACER.MENU.ITEM LAFITE.GROUP.COMMANDS (LAFITE.GROUP.COMMANDS.MENU))) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T) (GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS) (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *LA.ABBREVS.IN.PROFILE*))))))) +(RPAQQ LAFITEFOLDERSCOMS + [ + (* ;; "Maintenance of Lafite's folder structures, menus etc.") + + [COMS (* ; "The profile") + (FNS \LAFITE.READ.PROFILE \LAFITE.PROCESS.PROFILE \LAFITE.WRITE.PROFILE + \LAFITE.MERGE.NAMELISTS \LAFITE.READ.OLD.PROFILE \LAFITE.MERGE.FOLDERS + \LAFITE.MERGE.STRUCTURES \LAFITE.REPACK.FOLDERS) + (INITVARS (\LAFITEPROFILECHANGED) + (LAFITEMAILFOLDERS) + (\LAFITEPROFILEDATE)) + (ADDVARS (LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) + (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) + (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS) + (LAFITE.FOLDER.STRUCTURE \LAFITE.MERGE.STRUCTURES] + (COMS (* ; "Prompting for folders") + (FNS \LAFITE.PROMPTFORFOLDER PROMPTFORFILENAME MAKELAFITEMAILFOLDERSMENU + MAKELAFITEFOLDERSMENUITEMS LAFITE.GROUP.ITEM \LAFITE.ARRANGE.MENU + \LAFITE.MAKE.FOLDER.MENU LAFITE.SELECT.FOLDERS LAFITE.SELECT.MULTIPLE + \LAFITE.HANDLE.MULTIPLE.SELECTION COLLECT.SHADED.ITEMS) + (INITVARS (LAFITE.2COLUMN.MENU.MIN.ITEMS 10) + (LAFITEFOLDERSMENU) + (LAFITEMULTIPLEFOLDERSMENU)) + (ADDVARS (LAFITEMENUVARS LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU))) + (COMS (* ; "Name hacking") + (FNS LA.LONGFILENAME LA.SHORTFILENAME FORGETMAILFILE \LAFITE.FOLDER.NAME.CHANGED + \LAFITE.CHANGE.NAME.IN.LIST \LAFITE.RECOMPUTE.FOLDER.NAMES \LAFITE.NEW.SHORT.NAME + \LAFITE.NOTICE.FILE \LAFITE.UNCACHE.FOLDER) + (INITVARS LAFITE.HOST.ABBREVS \LAFITE.PSEUDO.DEVICES)) + (COMS (* ; "Hacking the hierarchy") + (FNS \LAFITE.NOTICE.FOLDERS \LAFITE.GC.FOLDERS \LAFITE.GC.FOLDERS.CONFIRM + \LAFITE.MAKE.RANDOM.DISPLAY \LAFITE.CHANGE.FOLDER.LIST \LAFITE.RENAME.FOLDER + \LAFITE.ADD.NEW.GROUP \LAFITE.CHECK.GROUP.NAME \LAFITE.CHANGE.GROUP.MEMBERS + \LAFITE.SELECT.GROUP.FOLDERS \LAFITE.CHANGE.SUBGROUPS \LAFITE.CHANGE.TOP.GROUPS + \LAFITE.DELETE.GROUP LAFITE.RENAME.GROUP \LAFITE.EDIT.HIERARCHY LAFITE.FIND.GROUP + UALPHORDERCAR) + (VARS LAFITE.SPACER.MENU.ITEM LAFITE.GROUP.COMMANDS (LAFITE.GROUP.COMMANDS.MENU))) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) + LAFITEDECLS) + (LOCALVARS . T) + (GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS) + (P (CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*]) @@ -58,13 +102,16 @@ Copyright (c) 1989 by Xerox Corporation. All rights reserved. ) ) -(RPAQ? \LAFITEPROFILECHANGED) +(RPAQ? \LAFITEPROFILECHANGED ) -(RPAQ? LAFITEMAILFOLDERS) +(RPAQ? LAFITEMAILFOLDERS ) -(RPAQ? \LAFITEPROFILEDATE) +(RPAQ? \LAFITEPROFILEDATE ) -(ADDTOVAR LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS) (LAFITE.FOLDER.STRUCTURE \LAFITE.MERGE.STRUCTURES)) +(ADDTOVAR LAFITE.PROFILE.VARS (*LA.ABBREVS.IN.PROFILE*) + (LAFITEMAILFOLDERS \LAFITE.MERGE.FOLDERS) + (LAFITEFORMFILES \LAFITE.MERGE.NAMELISTS) + (LAFITE.FOLDER.STRUCTURE \LAFITE.MERGE.STRUCTURES)) @@ -117,13 +164,13 @@ Copyright (c) 1989 by Xerox Corporation. All rights reserved. ) ) -(RPAQ? LAFITE.2COLUMN.MENU.MIN.ITEMS 10) +(RPAQ? LAFITE.2COLUMN.MENU.MIN.ITEMS 10) -(RPAQ? LAFITEFOLDERSMENU) +(RPAQ? LAFITEFOLDERSMENU ) -(RPAQ? LAFITEMULTIPLEFOLDERSMENU) +(RPAQ? LAFITEMULTIPLEFOLDERSMENU ) -(ADDTOVAR LAFITEMENUVARS LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU) +(ADDTOVAR LAFITEMENUVARS LAFITEFOLDERSMENU LAFITEMULTIPLEFOLDERSMENU) @@ -168,9 +215,9 @@ Copyright (c) 1989 by Xerox Corporation. All rights reserved. ) ) -(RPAQ? LAFITE.HOST.ABBREVS NIL) +(RPAQ? LAFITE.HOST.ABBREVS NIL) -(RPAQ? \LAFITE.PSEUDO.DEVICES NIL) +(RPAQ? \LAFITE.PSEUDO.DEVICES NIL) @@ -192,8 +239,34 @@ Copyright (c) 1989 by Xerox Corporation. All rights reserved. ) (\LAFITE.MAKE.RANDOM.DISPLAY -(LAMBDA (TITLE SAMPLESTRING INITIALCONTENT) (* ; "Edited 23-Aug-88 14:54 by bvm") (LET ((REG (WINDOWREGION LAFITESTATUSWINDOW)) (HEIGHT (HEIGHTIFWINDOW (TIMES 6 (FONTPROP NIL (QUOTE HEIGHT))) T)) BOTTOM WINDOW) (SETQ WINDOW (OPENTEXTSTREAM INITIALCONTENT (CREATEW (MAKEWITHINREGION (create REGION LEFT _ (fetch (REGION LEFT) of REG) BOTTOM _ (COND ((< (SETQ BOTTOM (- (fetch (REGION BOTTOM) of REG) HEIGHT)) 0) (* ; "tried placing it below status window, but that's off screen") (fetch (REGION TOP) of REG)) (T BOTTOM)) WIDTH _ (IMAX (FIXR (TIMES 1.5 (STRINGWIDTH SAMPLESTRING))) (TIMES 64 (CHARWIDTH (CHARCODE M)))) HEIGHT _ HEIGHT)) TITLE) NIL NIL (QUOTE (PROMPTWINDOW DON'T)))) (SETFILEPTR WINDOW -1) (LINELENGTH MAX.SMALLP WINDOW) WINDOW)) -) + [LAMBDA (TITLE SAMPLESTRING INITIALCONTENT) (* ; "Edited 7-Feb-2022 11:59 by rmk") + (* ; "Edited 23-Aug-88 14:54 by bvm") + (LET ((REG (WINDOWREGION LAFITESTATUSWINDOW)) + (HEIGHT (HEIGHTIFWINDOW (TIMES 6 (FONTPROP NIL 'HEIGHT)) + T)) + BOTTOM WINDOW) + [SETQ WINDOW (OPENTEXTSTREAM (OPENSTRINGSTREAM INITIALCONTENT) + (CREATEW (MAKEWITHINREGION + (create REGION + LEFT _ (fetch (REGION LEFT) of REG) + BOTTOM _ (COND + ((< (SETQ BOTTOM (- (fetch (REGION BOTTOM) + of REG) + HEIGHT)) + 0) + (* ; + "tried placing it below status window, but that's off screen") + (fetch (REGION TOP) of REG)) + (T BOTTOM)) + WIDTH _ [IMAX (FIXR (TIMES 1.5 (STRINGWIDTH + SAMPLESTRING))) + (TIMES 64 (CHARWIDTH (CHARCODE M] + HEIGHT _ HEIGHT)) + TITLE) + NIL NIL '(PROMPTWINDOW DON'T] + (SETFILEPTR WINDOW -1) + (LINELENGTH MAX.SMALLP WINDOW) + WINDOW]) (\LAFITE.CHANGE.FOLDER.LIST (LAMBDA (NEWFILES NEWCASEFILES NOTFOUND TEXTSTREAM) (* ; "Edited 12-Apr-89 16:34 by bvm") (* ;; "Change Lafite's set of folders by adding NEWFILES, removing NOTFOUND and renaming each (oldname . newname) in NEWCASEFILES. Outputs %"Done%" to optional TEXTSTREAM") (for FILE in NEWFILES do (* ; "add these") (\LAFITE.FOLDER.NAME.CHANGED NIL FILE)) (for FILE in NOTFOUND do (* ; "forget these") (\LAFITE.FOLDER.NAME.CHANGED FILE NIL)) (for FILE in NEWCASEFILES do (* ; "Fix case on these") (\LAFITE.FOLDER.NAME.CHANGED (CAR FILE) (CDR FILE))) (if TEXTSTREAM then (* ; "Use TEDIT.INSERT here instead of printout to insure that scrolling occurs if needed.") (TEDIT.INSERT TEXTSTREAM " @@ -247,14 +320,21 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM)))))) (LAMBDA (X Y) (* ; "Edited 13-Apr-89 14:38 by bvm") (ALPHORDER (CAR X) (CAR Y) UPPERCASEARRAY))) ) -(RPAQQ LAFITE.SPACER.MENU.ITEM (#*(32 1)OOOOOOOO NIL "(this is not a choice)")) +(RPAQQ LAFITE.SPACER.MENU.ITEM (#*(32 1)OOOOOOOO NIL "(this is not a choice)")) -(RPAQQ LAFITE.GROUP.COMMANDS (("Delete Group" (QUOTE \LAFITE.DELETE.GROUP) "Remove this group from the hierarchy") ("Rename Group" (QUOTE LAFITE.RENAME.GROUP) "Change the name of this group") ("Change Members" (QUOTE \LAFITE.CHANGE.GROUP.MEMBERS) "Change the membership of this group") ("Change Subgroups" (QUOTE \LAFITE.CHANGE.SUBGROUPS) "Change the subgroups of this group") ("Create Subgroup" (QUOTE \LAFITE.ADD.NEW.GROUP) "Create a new group and make it a subgroup of this group"))) +(RPAQQ LAFITE.GROUP.COMMANDS + (("Delete Group" '\LAFITE.DELETE.GROUP "Remove this group from the hierarchy") + ("Rename Group" 'LAFITE.RENAME.GROUP "Change the name of this group") + ("Change Members" '\LAFITE.CHANGE.GROUP.MEMBERS "Change the membership of this group") + ("Change Subgroups" '\LAFITE.CHANGE.SUBGROUPS "Change the subgroups of this group") + ("Create Subgroup" '\LAFITE.ADD.NEW.GROUP + "Create a new group and make it a subgroup of this group"))) -(RPAQQ LAFITE.GROUP.COMMANDS.MENU NIL) +(RPAQQ LAFITE.GROUP.COMMANDS.MENU NIL) (DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD (SOURCE) LAFITEDECLS) +(FILESLOAD (SOURCE) + LAFITEDECLS) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -267,27 +347,27 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM)))))) ) -(CL:PROCLAIM (QUOTE (CL:SPECIAL *LA.ABBREVS.IN.PROFILE*))) +(CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*)) ) (PUTPROPS LAFITEFOLDERS COPYRIGHT ("Xerox Corporation" 1989)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2597 10462 (\LAFITE.READ.PROFILE 2607 . 4811) (\LAFITE.PROCESS.PROFILE 4813 . 6003) ( -\LAFITE.WRITE.PROFILE 6005 . 7839) (\LAFITE.MERGE.NAMELISTS 7841 . 8575) (\LAFITE.READ.OLD.PROFILE -8577 . 9176) (\LAFITE.MERGE.FOLDERS 9178 . 9490) (\LAFITE.MERGE.STRUCTURES 9492 . 9692) ( -\LAFITE.REPACK.FOLDERS 9694 . 10460)) (10780 19324 (\LAFITE.PROMPTFORFOLDER 10790 . 11340) ( -PROMPTFORFILENAME 11342 . 12183) (MAKELAFITEMAILFOLDERSMENU 12185 . 12349) (MAKELAFITEFOLDERSMENUITEMS - 12351 . 13466) (LAFITE.GROUP.ITEM 13468 . 14005) (\LAFITE.ARRANGE.MENU 14007 . 15289) ( -\LAFITE.MAKE.FOLDER.MENU 15291 . 15816) (LAFITE.SELECT.FOLDERS 15818 . 16203) (LAFITE.SELECT.MULTIPLE -16205 . 18549) (\LAFITE.HANDLE.MULTIPLE.SELECTION 18551 . 19023) (COLLECT.SHADED.ITEMS 19025 . 19322)) - (19529 28038 (LA.LONGFILENAME 19539 . 21414) (LA.SHORTFILENAME 21416 . 23239) (FORGETMAILFILE 23241 - . 23701) (\LAFITE.FOLDER.NAME.CHANGED 23703 . 24926) (\LAFITE.CHANGE.NAME.IN.LIST 24928 . 25307) ( -\LAFITE.RECOMPUTE.FOLDER.NAMES 25309 . 26730) (\LAFITE.NEW.SHORT.NAME 26732 . 27413) ( -\LAFITE.NOTICE.FILE 27415 . 27596) (\LAFITE.UNCACHE.FOLDER 27598 . 28036)) (28146 41112 ( -\LAFITE.NOTICE.FOLDERS 28156 . 29796) (\LAFITE.GC.FOLDERS 29798 . 30885) (\LAFITE.GC.FOLDERS.CONFIRM -30887 . 31697) (\LAFITE.MAKE.RANDOM.DISPLAY 31699 . 32477) (\LAFITE.CHANGE.FOLDER.LIST 32479 . 33232) -(\LAFITE.RENAME.FOLDER 33234 . 34964) (\LAFITE.ADD.NEW.GROUP 34966 . 35691) (\LAFITE.CHECK.GROUP.NAME -35693 . 36044) (\LAFITE.CHANGE.GROUP.MEMBERS 36046 . 36421) (\LAFITE.SELECT.GROUP.FOLDERS 36423 . -37429) (\LAFITE.CHANGE.SUBGROUPS 37431 . 38082) (\LAFITE.CHANGE.TOP.GROUPS 38084 . 38792) ( -\LAFITE.DELETE.GROUP 38794 . 39376) (LAFITE.RENAME.GROUP 39378 . 40234) (\LAFITE.EDIT.HIERARCHY 40236 - . 40795) (LAFITE.FIND.GROUP 40797 . 40993) (UALPHORDERCAR 40995 . 41110))))) + (FILEMAP (NIL (3536 11401 (\LAFITE.READ.PROFILE 3546 . 5750) (\LAFITE.PROCESS.PROFILE 5752 . 6942) ( +\LAFITE.WRITE.PROFILE 6944 . 8778) (\LAFITE.MERGE.NAMELISTS 8780 . 9514) (\LAFITE.READ.OLD.PROFILE +9516 . 10115) (\LAFITE.MERGE.FOLDERS 10117 . 10429) (\LAFITE.MERGE.STRUCTURES 10431 . 10631) ( +\LAFITE.REPACK.FOLDERS 10633 . 11399)) (11828 20372 (\LAFITE.PROMPTFORFOLDER 11838 . 12388) ( +PROMPTFORFILENAME 12390 . 13231) (MAKELAFITEMAILFOLDERSMENU 13233 . 13397) (MAKELAFITEFOLDERSMENUITEMS + 13399 . 14514) (LAFITE.GROUP.ITEM 14516 . 15053) (\LAFITE.ARRANGE.MENU 15055 . 16337) ( +\LAFITE.MAKE.FOLDER.MENU 16339 . 16864) (LAFITE.SELECT.FOLDERS 16866 . 17251) (LAFITE.SELECT.MULTIPLE +17253 . 19597) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19599 . 20071) (COLLECT.SHADED.ITEMS 20073 . 20370)) + (20595 29104 (LA.LONGFILENAME 20605 . 22480) (LA.SHORTFILENAME 22482 . 24305) (FORGETMAILFILE 24307 + . 24767) (\LAFITE.FOLDER.NAME.CHANGED 24769 . 25992) (\LAFITE.CHANGE.NAME.IN.LIST 25994 . 26373) ( +\LAFITE.RECOMPUTE.FOLDER.NAMES 26375 . 27796) (\LAFITE.NEW.SHORT.NAME 27798 . 28479) ( +\LAFITE.NOTICE.FILE 28481 . 28662) (\LAFITE.UNCACHE.FOLDER 28664 . 29102)) (29220 43399 ( +\LAFITE.NOTICE.FOLDERS 29230 . 30870) (\LAFITE.GC.FOLDERS 30872 . 31959) (\LAFITE.GC.FOLDERS.CONFIRM +31961 . 32771) (\LAFITE.MAKE.RANDOM.DISPLAY 32773 . 34764) (\LAFITE.CHANGE.FOLDER.LIST 34766 . 35519) +(\LAFITE.RENAME.FOLDER 35521 . 37251) (\LAFITE.ADD.NEW.GROUP 37253 . 37978) (\LAFITE.CHECK.GROUP.NAME +37980 . 38331) (\LAFITE.CHANGE.GROUP.MEMBERS 38333 . 38708) (\LAFITE.SELECT.GROUP.FOLDERS 38710 . +39716) (\LAFITE.CHANGE.SUBGROUPS 39718 . 40369) (\LAFITE.CHANGE.TOP.GROUPS 40371 . 41079) ( +\LAFITE.DELETE.GROUP 41081 . 41663) (LAFITE.RENAME.GROUP 41665 . 42521) (\LAFITE.EDIT.HIERARCHY 42523 + . 43082) (LAFITE.FIND.GROUP 43084 . 43280) (UALPHORDERCAR 43282 . 43397))))) STOP diff --git a/library/lafite/LAFITEFOLDERS.LCOM b/library/lafite/LAFITEFOLDERS.LCOM index 824e0744fe4c399cab825e2aca6a0928b69e34f8..42c20c7fa7f915d6254a7a8a3d356b77f84bc26c 100644 GIT binary patch delta 1568 zcmbtUZA@Eb6t=K}T+nW~m5&v8sfq<{>Ah_!+(FwbeOvChy>0Kklx822wsZ^7LO=L) zDl^d^Ce8(46PG2M;g9p%xEjMBv&1YhhD9_nX8tw0xF1ZT#y?Ap=PeClVlor^<9W}= zbIy6s>3i;{zv{mJP1j}dMC#B8h6mymp{v^+`d+ zh_!b!jD?bi6)b4jkIcwz4WyG+&dza&<#@Z3XZy^^VouFvb5oi0B$}HA5_86{jy^j$ zR!kR)o|!~0lbH2LbE!nelTA-%(kl*|%adKP?kJwjRI-pLtavhsQ&aP4k0b=d0SyPj zk{>Io?FiQm8QH(favbkqdAl9TBn#=?!s+E)q4+3I)`r_wr{EHSF-byu<7_sY8BHeU z;gbKBug}bM-?Lf!z<+7Ze~<3=Hiw)}C&wawctntcShZ?lWC_SBVu(RB84w>)a7+x3 zsa8My0mPs)hX40)_mpS58FK#qwi*uc{(gq!54woIYF)>WTUAGOOo^>lYCw6g(MGP; zy$6N~#;wycmI&%2cYH0SkLzFF2UcPK4PBY`1t>QgFMv|YA52o)tty^eJ5;aV$=`1L z32e1ZmjT~wdJ*u6=HG$b+0sDCP`;FEJzWKsO_NG39qs2pdB6QFYKwK|Xy(t&@6x0A z$Pbhe@48-zR35ttEb@5I8Sq}|QR&U@+V)dYgZ(Th=j_*Lnvml*jd#0-sB19YS~}nN zA&vA7Y=XU>f2A6Zi$hN8-tr_t;k=iq!dADHwtZL+;-<+#dg3R^hVLQrZJ@V26Aot5 zTrvmWpz)s_eSzi-hI)0clBLkY`nvnzM=pkPt4ojc!>)Q(&o_ zC>+7CjB!oXVC_PPWm&Ydfa9=|E))_*@wljsh_Zr%VpvA~eF&b9GA{ZdpWBTBVq8IP z7D2oy2Y1X4S2-=1>cF;>nLH<(;g0LFrG~LUnSQb*H`TfjYjeT7*p}O&kA^T`X`O8Q zoTUqqr)qcGUkCq<_>bT(T|L%CY2O|H1C*~$MGFi}H~k;EuHUQ1n}#KH7+Iv(BB z(_kde%sdbH=gbV?bY>E8D>Dw5m~A4StO(M9W+Sw0DL1;s-{HAaMkS)dl^V5gOrD7DMpNq6^Y~EYTSd@qm^^#vs8%^-VC@YA5v@{$NM5*%K zf&qRx-wGkO=V_7XEKT~(g5~f(BP#3=mdEJG7dnAuSj2#1iygbAJ}@-b%c4}N79~Dg zGx=nZt@xuPH*F;QmUufF4KX&zC5^xZPJ&sk-N)7dIm)1FP>h+ AY5)KL delta 1454 zcmZuxZA=?w98XtaY~4k46b1}x1)7!K(KkRw z5S{wPsoN71-*q2!Ce9_=4<^23(adDVY4#Emv*;2NO`KVbo5uJ_{Xd1p%q(es&;RB3 zf4x4>h2Kq|+%PeWDEVbYvis$bWS14cirS-+AZo&%kc4Pi(WGcdjz#FBcUf0#6hmmk zK+q%+(Hv(NO4D|44`N-s%fquC8ZmTIpEWYsbPDM?L?dcRj0Kkm4rX%GzVw2j=Zn5< zreGxXeA<^yOl68`pOMHXA&D;}_+?G9jd4QZZ`(z7xDW6Oi*7Yepn@Z;k{azaNaIBL<$(clMI$c0T{T?1MlwXNqVc%9f zH*OuXAtRqIXY^8`+8Ow1&Rbm`smt>4zee>PnP`59lsfh_Npse9mBhc_J4lY-++UEW54~T4@+AL^84jzjheVAIO@i|7(5pl_X>O~` z2vQA*r~DVez8d(5a0i2jN&IKwZqpHbBfJB*D8`Db4~5`Pgd`=PjUblupqQkQe||)Z z!q@U5H6p>q7}sJNT!k=Voo=*tDdHeIQCJ8{aakLYm8cYuRRwuiG&~|isS|{FK7EEP=lRSdWI6TORlsA}gMfc$Q-I0YINS5K!MPBi z?rFtu&IR$&p(eaB4@2NkK8cTq+wi%305su&W^6C;Ak7pe06#B`0iG{fFguO%fJ!@kfT>dpB(PeF^N@!y3*?|p{FD$~#1}j}IB_SF*2lSPh*7Y!S z%M%rrlzn9V`5@rgc@3~_VH~i$K=NN& eAj{mnH~@HPe!Im%@*+hJLGEW42Wu!0seb{s?5|h= diff --git a/library/lafite/LAFITESEND b/library/lafite/LAFITESEND index a6b7fdda..ef7c6b00 100644 --- a/library/lafite/LAFITESEND +++ b/library/lafite/LAFITESEND @@ -1,9 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Sep-2021 22:58:58"  -{DSK}KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESEND.;1 99805 - previous date%: " 3-Dec-2000 14:53:30" -{DSK}KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESEND.;1) +(FILECREATED " 7-Feb-2022 12:04:09"  +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;2 100778 + + :CHANGES-TO (FILES LAFITEDECLS) + (FNS \SENDMESSAGE.RESTARTABLE \SENDMESSAGE LAFITE.SENDMESSAGE MAKEXXXSUPPORTFORM + MAKENEWMESSAGEFORM MAKEANSWERFORM LAFITE.FILL.IN.ANSWER.FORM MAKEFORWARDFORM) + + :PREVIOUS-DATE "30-Sep-2021 22:58:58" +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;1) (* ; " @@ -501,16 +506,18 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation. (DEFINEQ (\SENDMESSAGE - [LAMBDA (FORM TEDITPROPS FORMNAME) (* ; "Edited 10-Feb-89 12:22 by bvm") + [LAMBDA (FORM TEDITPROPS FORMNAME) (* ; "Edited 7-Feb-2022 11:54 by rmk") + (* ; "Edited 10-Feb-89 12:22 by bvm") (* ;;; "FORM can be a string, file, or stream --- The value of \SENDMESSAGE is T only if the message was actually sent") (OR (TEXTSTREAMP FORM) - (SETQ FORM (OPENTEXTSTREAM FORM NIL NIL NIL TEDITPROPS))) + (SETQ FORM (OPENTEXTSTREAM (OPENSTRINGSTREAM FORM) + NIL NIL NIL TEDITPROPS))) (TEDIT.STREAMCHANGEDP FORM T) (* ; "Clear the changed bit") (if (NOT (LISTGET TEDITPROPS 'LEAVETTY)) - then (* ; "Take control of the keyboard") - (TTY.PROCESS (THIS.PROCESS))) + then (* ; "Take control of the keyboard") + (TTY.PROCESS (THIS.PROCESS))) (PROG [(MODE (LISTGET TEDITPROPS 'LAFITEMODE] (* ; "Old way of specifying mode") (if MODE then (TEXTPROP FORM 'LAFITEMODE MODE) @@ -518,87 +525,84 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation. elseif (SETQ MODE (fetch LAFITEMODE of \LAFITEMODE)) then (TEXTPROP FORM 'LAFITEMODE MODE) else (PRINTOUT PROMPTWINDOW T "Can't send mail without a Lafite mode.") - (RETURN NIL)) + (RETURN NIL)) (RETURN (\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME]) (\SENDMESSAGE.RESTARTABLE - [LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 3-Nov-89 15:06 by bvm") + [LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 7-Feb-2022 11:50 by rmk") + (* ; "Edited 3-Nov-89 15:06 by bvm") (bind (CURRENTMESSAGE _ FORM) - (FIRSTTIME _ T) - EDITORRESULT DONE SENTOK PARSE + (FIRSTTIME _ T) + EDITORRESULT DONE SENTOK PARSE do (PROCESSPROP (THIS.PROCESS) - 'BEFOREEXIT NIL) (* ; - "Allow LOGOUT until delivery is attempted. Need to do this if we loop or restart") - (COND - ([NULL (PROG1 EDITORWINDOW - [SETQ EDITORWINDOW (\SENDMESSAGE.MAKEWINDOW CURRENTMESSAGE NIL - EDITORWINDOW (TEXTPROP FORM 'LAFITEMODE])] + 'BEFOREEXIT NIL) (* ; + "Allow LOGOUT until delivery is attempted. Need to do this if we loop or restart") + (COND + ([NULL (PROG1 EDITORWINDOW + [SETQ EDITORWINDOW (\SENDMESSAGE.MAKEWINDOW CURRENTMESSAGE NIL EDITORWINDOW + (TEXTPROP FORM 'LAFITEMODE])] (* ; - "First time thru. Fix it so that we can restart if aborted") - (PROCESSPROP (THIS.PROCESS) - 'RESTARTFORM - (LIST (FUNCTION \SENDMESSAGE.RESTARTABLE) - (KWOTE FORM) - (KWOTE TEDITPROPS) - (KWOTE EDITORWINDOW))) (* ; - "If process is reset or aborted, this is how to resurrect") - (PROCESSPROP (THIS.PROCESS) - 'RESTARTABLE T) - (WINDOWPROP EDITORWINDOW 'LAFITEFORM FORMNAME))) - (COND - (FIRSTTIME (RESETSAVE NIL (LIST (FUNCTION \SENDMESSAGE.CLEANUP) - EDITORWINDOW)) - (push LAFITECURRENTEDITORWINDOWS EDITORWINDOW) - (SETQ FIRSTTIME))) - [SETQ EDITORRESULT (TEDIT FORM EDITORWINDOW T (APPEND TEDITPROPS (LIST 'FONT - LAFITEEDITORFONT] - (COND - ((TTY.PROCESSP) (* ; "give back the keyboard") - (TTY.PROCESS T))) - (WINDOWDELPROP EDITORWINDOW 'CLOSEFN 'DON'T) (* ; "let the window close") - (COND - ((NOT (type? SENDINGCOMMAND EDITORRESULT)) + "First time thru. Fix it so that we can restart if aborted") + (PROCESSPROP (THIS.PROCESS) + 'RESTARTFORM + (LIST (FUNCTION \SENDMESSAGE.RESTARTABLE) + (KWOTE FORM) + (KWOTE TEDITPROPS) + (KWOTE EDITORWINDOW))) (* ; + "If process is reset or aborted, this is how to resurrect") + (PROCESSPROP (THIS.PROCESS) + 'RESTARTABLE T) + (WINDOWPROP EDITORWINDOW 'LAFITEFORM FORMNAME))) + (COND + (FIRSTTIME (RESETSAVE NIL (LIST (FUNCTION \SENDMESSAGE.CLEANUP) + EDITORWINDOW)) + (push LAFITECURRENTEDITORWINDOWS EDITORWINDOW) + (SETQ FIRSTTIME))) + [SETQ EDITORRESULT (TEDIT (OPENSTRINGSTREAM FORM) + EDITORWINDOW T (APPEND TEDITPROPS (LIST 'FONT LAFITEEDITORFONT] + (COND + ((TTY.PROCESSP) (* ; "give back the keyboard") + (TTY.PROCESS T))) + (WINDOWDELPROP EDITORWINDOW 'CLOSEFN 'DON'T) (* ; "let the window close") + (COND + ((NOT (type? SENDINGCOMMAND EDITORRESULT)) (* ; + "get out anyway since the user used the TEDIT `quit' command instead of one of the sending commands") + (SETQ DONE T)) + (T (* ; + "the user used the lafite menu to get out rather than the TEDIT menu so we have to do something") (* ; -"get out anyway since the user used the TEDIT `quit' command instead of one of the sending commands") - (SETQ DONE T)) - (T (* ; - "the user used the lafite menu to get out rather than the TEDIT menu so we have to do something") - (* ; - "make sure CURRENTMESSAGE is always a string") - (SETQ CURRENTMESSAGE (fetch (SENDINGCOMMAND MESSAGE) of EDITORRESULT)) - (SETQ DONE (SELECTQ (AND EDITORRESULT (fetch (SENDINGCOMMAND COMMAND) - of EDITORRESULT)) - (%##SEND## [SETQ SENTOK (\SENDMESSAGE0 CURRENTMESSAGE - EDITORWINDOW (SETQ PARSE - (fetch - (SENDINGCOMMAND - MESSAGEPARSE) - of EDITORRESULT - ]) - (SHOULDNT))) - (SHADEITEM (fetch (SENDINGCOMMAND ITEM) of EDITORRESULT) - (fetch (SENDINGCOMMAND MENU) of EDITORRESULT) - WHITESHADE) (* ; - "Unshade command. DOLAFITESENDINGCOMMAND shaded it to begin with") - )) - (COND - (DONE (* ; "Message successfully dispatched") - (PROCESSPROP (THIS.PROCESS) - 'RESTARTABLE NIL) (* ; - "Don't try to restart if there's any sort of error now") - (COND - (CURRENTMESSAGE (* ; - "Mark text unchanged now, so no trouble closing icon") - (TEDIT.STREAMCHANGEDP CURRENTMESSAGE T))) - (COND - ((NULL SENTOK) - (CLOSEW EDITORWINDOW)) - (T (* ; "shrink the window") - (\LAFITE.AFTER.DELIVER EDITORWINDOW CURRENTMESSAGE PARSE))) - (RETURN SENTOK)) - (T (* ; - "Loop if deliver failed or \LAFITE.SAVE.FORM was aborted.") - ]) + "make sure CURRENTMESSAGE is always a string") + (SETQ CURRENTMESSAGE (fetch (SENDINGCOMMAND MESSAGE) of EDITORRESULT)) + (SETQ DONE (SELECTQ (AND EDITORRESULT (fetch (SENDINGCOMMAND COMMAND) of EDITORRESULT + )) + (%##SEND## [SETQ SENTOK (\SENDMESSAGE0 CURRENTMESSAGE EDITORWINDOW + (SETQ PARSE (fetch (SENDINGCOMMAND + MESSAGEPARSE) + of EDITORRESULT]) + (SHOULDNT))) + (SHADEITEM (fetch (SENDINGCOMMAND ITEM) of EDITORRESULT) + (fetch (SENDINGCOMMAND MENU) of EDITORRESULT) + WHITESHADE) (* ; + "Unshade command. DOLAFITESENDINGCOMMAND shaded it to begin with") + )) + (COND + (DONE (* ; "Message successfully dispatched") + (PROCESSPROP (THIS.PROCESS) + 'RESTARTABLE NIL) (* ; + "Don't try to restart if there's any sort of error now") + (COND + (CURRENTMESSAGE (* ; + "Mark text unchanged now, so no trouble closing icon") + (TEDIT.STREAMCHANGEDP CURRENTMESSAGE T))) + (COND + ((NULL SENTOK) + (CLOSEW EDITORWINDOW)) + (T (* ; "shrink the window") + (\LAFITE.AFTER.DELIVER EDITORWINDOW CURRENTMESSAGE PARSE))) + (RETURN SENTOK)) + (T (* ; + "Loop if deliver failed or \LAFITE.SAVE.FORM was aborted.") + ]) (\SENDMESSAGE.CLEANUP [LAMBDA (EDITORWINDOW) (* ; "Edited 6-Oct-87 15:58 by bvm:") @@ -795,11 +799,12 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation. (T STR))))]) (LAFITE.SENDMESSAGE - [LAMBDA (MESSAGEFORM) (* ; "Edited 12-Sep-88 14:07 by bvm") + [LAMBDA (MESSAGEFORM) (* ; "Edited 7-Feb-2022 11:55 by rmk") + (* ; "Edited 12-Sep-88 14:07 by bvm") (* ;;; "this is the external interface to sending a message") - (SETQ MESSAGEFORM (OPENTEXTSTREAM MESSAGEFORM)) + (SETQ MESSAGEFORM (OPENTEXTSTREAM (OPENSTRINGSTREAM MESSAGEFORM))) (LET* ((MODE (TEXTPROP MESSAGEFORM 'LAFITEMODE)) (*LAFITE-MODE-DATA* (\LAFITE.GET.USER.DATA MODE)) PARSE) @@ -1197,16 +1202,16 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation. (MAKEXXXSUPPORTFORM "Lisp" LISPSUPPORT]) (MAKEXXXSUPPORTFORM - [LAMBDA (SYSTEMNAME ADDRESS SYSTEMDATE) (* ; "Edited 3-May-89 18:37 by bvm") + [LAMBDA (SYSTEMNAME ADDRESS SYSTEMDATE) (* ; "Edited 7-Feb-2022 11:56 by rmk") + (* ; "Edited 3-May-89 18:37 by bvm") (PROG ((SUBJFIELD ">>Terse summary of problem<<") (UCODEVERSION (MICROCODEVERSION)) (SCRATCH (OPENSTREAM "{nodircore}" 'BOTH)) TEXTSTREAM SELECTPOSITION MODE) [COND [(LISTP ADDRESS) (* ; - "Mode-dependent address. Pick the first address that's in a mode we know how to send") - (SETQ ADDRESS (for PAIR in ADDRESS when (\LAFITE.GET.USER.DATA - (SETQ MODE (CAR PAIR))) + "Mode-dependent address. Pick the first address that's in a mode we know how to send") + (SETQ ADDRESS (for PAIR in ADDRESS when (\LAFITE.GET.USER.DATA (SETQ MODE (CAR PAIR))) do (RETURN (CADR PAIR] (T (* ; "Just send in current mode") (SETQ MODE (fetch LAFITEMODE of \LAFITEMODE] @@ -1214,11 +1219,11 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation. ((NOT ADDRESS) (printout PROMPTWINDOW T "Can't -- no address known for " SYSTEMNAME " report.") (RETURN))) - (SETQ TEXTSTREAM (OPENTEXTSTREAM (CONCAT "Subject: " SYSTEMNAME ": ") + (SETQ TEXTSTREAM (OPENTEXTSTREAM (OPENSTRINGSTREAM (CONCAT "Subject: " SYSTEMNAME ": ")) NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) (SETQ SELECTPOSITION (ADD1 (GETEOFPTR TEXTSTREAM))) (PROGN (* ; - "Now write the main stuff to a scratch stream. faster than bouting a byte at a time to tedit") + "Now write the main stuff to a scratch stream. faster than bouting a byte at a time to tedit") (printout SCRATCH SUBJFIELD T) (printout SCRATCH "To: " ADDRESS T) (printout SCRATCH "cc: " (FULLUSERNAME NIL MODE) @@ -1258,8 +1263,9 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (RETURN TEXTSTREAM]) (MAKENEWMESSAGEFORM - [LAMBDA NIL (* ; "Edited 6-Jun-88 12:22 by bvm") - (LET ((OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) + [LAMBDA NIL (* ; "Edited 7-Feb-2022 11:56 by rmk") + (* ; "Edited 6-Jun-88 12:22 by bvm") + (LET ((OUTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) SELECTPOSITION) (printout OUTSTREAM "Subject: ") (SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM))) @@ -1269,8 +1275,8 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) T T) (printout OUTSTREAM MESSAGESTR T) (if LAFITE.SIGNATURE - then (* ; "Pre-sign it") - (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) + then (* ; "Pre-sign it") + (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) (TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS SUBJECTSTR) 'RIGHT T) OUTSTREAM]) @@ -1442,7 +1448,8 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (MARKMESSAGE MSGDESCRIPTOR MAILFOLDER ANSWERMARK])]) (MAKEANSWERFORM - [LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* ; "Edited 10-Aug-89 17:28 by bvm") + [LAMBDA (MSGDESCRIPTORS MAILFOLDER) (* ; "Edited 7-Feb-2022 11:58 by rmk") + (* ; "Edited 10-Aug-89 17:28 by bvm") (LET* ((FIRSTMSG (if (LISTP MSGDESCRIPTORS) then (CAR MSGDESCRIPTORS) else MSGDESCRIPTORS)) @@ -1450,20 +1457,17 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (MODE (CL:NTH MODEBITS *LAFITE-WELL-KNOWN-MODES*))) (if (NULL MODE) then (if [OR (NEQ MODEBITS 0) - (NULL (SETQ MODE (\LAFITE.GUESS.MODE FIRSTMSG] - then (LAB.PROMPTPRINT MAILFOLDER (if (EQ MODEBITS 0) - then - "Message of unknown protocol." - else + (NULL (SETQ MODE (\LAFITE.GUESS.MODE FIRSTMSG] + then (LAB.PROMPTPRINT MAILFOLDER (if (EQ MODEBITS 0) + then "Message of unknown protocol." + else "Warning: This message was retrieved under a protocol not currently enabled." - )) - (LAB.PROMPTPRINT MAILFOLDER "Will answer in " (SETQ MODE - (fetch - (LAFITEOPS - LAFITEMODE) - of \LAFITEMODE - )) - " mode; this may not work. "))) + )) + (LAB.PROMPTPRINT MAILFOLDER "Will answer in " (SETQ MODE + (fetch (LAFITEOPS + LAFITEMODE) + of \LAFITEMODE)) + " mode; this may not work. "))) (* ;; "Currently we only pay attention to the first message. If we ever do otherwise, we'll want to notice whether the other messages are in the same mode") @@ -1474,14 +1478,13 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (if (NULL *LAFITE-MODE-DATA*) then (LAB.FORMAT MAILFOLDER "Failed: can't authenticate user in ~A mode" MODE) - elseif (SETQ MSG (CL:FUNCALL (fetch (LAFITEMODEDATA ANSWERER) of - *LAFITE-MODE-DATA* - ) - MSGDESCRIPTORS MAILFOLDER)) + elseif (SETQ MSG (CL:FUNCALL (fetch (LAFITEMODEDATA ANSWERER) of *LAFITE-MODE-DATA*) + MSGDESCRIPTORS MAILFOLDER)) then (if (TEXTSTREAMP MSG) - then (TEXTPROP MSG 'LAFITEMODE MODE) - MSG - else (OPENTEXTSTREAM MSG NIL NIL NIL `(LAFITEMODE ,MODE]) + then (TEXTPROP MSG 'LAFITEMODE MODE) + MSG + else (OPENTEXTSTREAM (OPENSTRINGSTREAM MSG) + NIL NIL NIL `(LAFITEMODE ,MODE]) (LA.PRINT.COMMA.LIST [LAMBDA (STRINGS STREAM) (* ; "Edited 6-Jun-88 12:50 by bvm") @@ -1491,21 +1494,22 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (PRIN3 STR STREAM]) (LAFITE.FILL.IN.ANSWER.FORM - [LAMBDA (SUBJECT FROM DATE TO CC ADDRESSPRINTFN) (* ; "Edited 10-Jun-88 17:19 by bvm") + [LAMBDA (SUBJECT FROM DATE TO CC ADDRESSPRINTFN) (* ; "Edited 7-Feb-2022 11:58 by rmk") + (* ; "Edited 10-Jun-88 17:19 by bvm") (* ;; "Construct an answer form replying to a message from FROM on DATE with specified SUBJECT. Reply should go to the lists of names TO and CC. ADDRESSPRINTFN is a function that prints a list of names suitably for the protocol in question.") - (LET ((OUTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) + (LET ((OUTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) SELECTPOSITION) (LINELENGTH MAX.SMALLP OUTSTREAM) (* ; - "Sigh, apparently text streams have linelength") + "Sigh, apparently text streams have linelength") (PROGN (printout OUTSTREAM "Subject: ") (if SUBJECT then (COND - ((NOT (STRING-EQUAL (SUBSTRING SUBJECT 1 3) - "Re:")) - (printout OUTSTREAM "Re: "))) - (printout OUTSTREAM SUBJECT) + ((NOT (STRING-EQUAL (SUBSTRING SUBJECT 1 3) + "Re:")) + (printout OUTSTREAM "Re: "))) + (printout OUTSTREAM SUBJECT) else (printout OUTSTREAM "(reply to message)"))) (PROGN (printout OUTSTREAM T "In-reply-to: ") (if (NULL FROM) @@ -1515,8 +1519,8 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (PROGN (printout OUTSTREAM "To: ") (if TO then (CL:FUNCALL ADDRESSPRINTFN TO OUTSTREAM) - else (* ; "No to, so ask to fill in") - (printout OUTSTREAM RECIPIENTSSTR T)) + else (* ; "No to, so ask to fill in") + (printout OUTSTREAM RECIPIENTSSTR T)) (TERPRI OUTSTREAM)) (COND (CC (printout OUTSTREAM "cc: ") @@ -1526,8 +1530,8 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (SETQ SELECTPOSITION (ADD1 (GETFILEPTR OUTSTREAM))) (printout OUTSTREAM MESSAGESTR T) (if LAFITE.SIGNATURE - then (* ; "Pre-sign it") - (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) + then (* ; "Pre-sign it") + (PRIN3 LAFITE.SIGNATURE OUTSTREAM)) (TEDIT.SETSEL OUTSTREAM SELECTPOSITION (NCHARS MESSAGESTR) 'RIGHT T) OUTSTREAM]) @@ -1583,12 +1587,13 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (MARKMESSAGE MSG MAILFOLDER FORWARDMARK])]) (MAKEFORWARDFORM - [LAMBDA (WINDOW FOLDER MESSAGELIST) (* ; "Edited 5-Jan-90 17:46 by bvm") + [LAMBDA (WINDOW FOLDER MESSAGELIST) (* ; "Edited 7-Feb-2022 11:59 by rmk") + (* ; "Edited 5-Jan-90 17:46 by bvm") (* ;; "Make a message form that forwards each of the messages in MESSAGELIST") (PROG ((FOLDERSTREAM (\LAFITE.OPEN.FOLDER FOLDER 'INPUT :ABORT)) - (TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) + (TEXTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT))) (CURMSG (CAR MESSAGELIST)) SUBJECT SELECTPOSITION SELECTLEN) (OR (fetch (LAFITEMSG PARSED?) of CURMSG) @@ -1596,8 +1601,7 @@ Impact: >> Fatal, Serious, Moderate, Annoying, Minor <<" T T) (LINELENGTH MAX.SMALLP TEXTSTREAM) (PRIN3 "Subject: " TEXTSTREAM) (COND - ([OR LAFITEFORWARDSUBJECTSTR (NULL (SETQ SUBJECT (fetch (LAFITEMSG SUBJECT) - of CURMSG] + ([OR LAFITEFORWARDSUBJECTSTR (NULL (SETQ SUBJECT (fetch (LAFITEMSG SUBJECT) of CURMSG] (SETQ SELECTPOSITION (ADD1 (GETFILEPTR TEXTSTREAM))) [SETQ SELECTLEN (NCHARS (SETQ SUBJECT (OR LAFITEFORWARDSUBJECTSTR SUBJECTSTR] (PRIN3 SUBJECT TEXTSTREAM)) @@ -1616,23 +1620,29 @@ cc: ~A " RECIPIENTSSTR (FULLUSERNAME) (CAR LAFITEFORWARDSTRINGS)) (if LAFITE.SIGNATURE - then (* ; - "Sign it up here, after the user's inserted comments, if any") - (PRIN3 LAFITE.SIGNATURE TEXTSTREAM) - (TERPRI TEXTSTREAM)) - (for MSGDESCRIPTOR in MESSAGELIST bind NTHTIME - do (PRIN3 (COND - (NTHTIME (* ; "%"Next message%"") - (CADDR LAFITEFORWARDSTRINGS)) - (T (* ; "%"Begin forwarded messages%"") - (SETQ NTHTIME T) - (CADR LAFITEFORWARDSTRINGS))) - TEXTSTREAM) - (TERPRI TEXTSTREAM) - (\LAFITE.APPEND.MESSAGE.BODY TEXTSTREAM FOLDERSTREAM MSGDESCRIPTOR - \LAPARSE.DONT.FORWARD.HEADERS) - (TERPRI TEXTSTREAM) - (TEDIT.CARETLOOKS TEXTSTREAM LAFITEEDITORFONT)) + then (* ; + "Sign it up here, after the user's inserted comments, if any") + (PRIN3 LAFITE.SIGNATURE TEXTSTREAM) + (TERPRI TEXTSTREAM)) + (for MSGDESCRIPTOR in MESSAGELIST bind NTHTIME do (PRIN3 (COND + (NTHTIME + (* ; "%"Next message%"") + (CADDR + LAFITEFORWARDSTRINGS + )) + (T + (* ; "%"Begin forwarded messages%"") + (SETQ NTHTIME T) + (CADR LAFITEFORWARDSTRINGS)) + ) + TEXTSTREAM) + (TERPRI TEXTSTREAM) + (\LAFITE.APPEND.MESSAGE.BODY TEXTSTREAM + FOLDERSTREAM MSGDESCRIPTOR + \LAPARSE.DONT.FORWARD.HEADERS) + (TERPRI TEXTSTREAM) + (TEDIT.CARETLOOKS TEXTSTREAM + LAFITEEDITORFONT)) (PRIN3 (CADDDR LAFITEFORWARDSTRINGS) TEXTSTREAM) (TERPRI TEXTSTREAM) @@ -1640,25 +1650,23 @@ cc: ~A (RETURN TEXTSTREAM]) ) -(RPAQQ LAFITESENDINGMENUITEMS (("Deliver" '\SENDMSG.DELIVER "Send the message in the edit window" - ) - ("Reply To" '\SENDMSG.REPLYTO - "Insert a Reply-to field in this message") - ("Change Mode" '\SENDMSG.CHANGE.MODE - "Change the mode (mail protocol) used to send this message." - ) - ("Save" '\SENDMSG.SAVE.FORM +(RPAQQ LAFITESENDINGMENUITEMS (("Deliver" '\SENDMSG.DELIVER "Send the message in the edit window") + ("Reply To" '\SENDMSG.REPLYTO + "Insert a Reply-to field in this message") + ("Change Mode" '\UNIXMAIL.CHANGE.MODE + "Change the mode (mail protocol) used to send this message.") + ("Save" '\SENDMSG.SAVE.FORM "Save the message in a file for later use (retrieve with middle-button SendMail)" - ))) + ))) (RPAQQ LAFITEFORMSMENUITEMS (("Saved Form" '%##ANOTHERFORM## - "You will be asked to specify a filename for the form") - ("Standard Form" (FUNCTION MAKENEWMESSAGEFORM) - "A clean message form"))) + "You will be asked to specify a filename for the form") + ("Standard Form" (FUNCTION MAKENEWMESSAGEFORM) + "A clean message form"))) (RPAQQ LAFITEFORMATMENUITEMS (("Send Formatted Message" 'TEDIT) - ("Send Plain Text" 'TEXT) - ("Abort" 'ABORT))) + ("Send Plain Text" 'TEXT) + ("Abort" 'ABORT))) (RPAQQ LAFITEFORWARDSTRINGS (">>CoveringMessage<<" " ----- Begin Forwarded Messages ----- @@ -1670,9 +1678,9 @@ cc: ~A (ADDTOVAR \SYSTEMCACHEVARS \LAFITE.REPORT.MACHINE) (ADDTOVAR LAFITESPECIALFORMS ("Lisp Report" (FUNCTION MAKELISPSUPPORTFORM) - "A form to report a Lisp bug or suggestion") - ("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM) - "A form to report a Lafite bug or suggestion")) + "A form to report a Lisp bug or suggestion") + ("Lafite Report" (FUNCTION MAKELAFITESUPPORTFORM) + "A form to report a Lafite bug or suggestion")) (ADDTOVAR LAFITEMENUVARS LAFITEFORMSMENU LAFITEFORMATMENU) @@ -1709,9 +1717,9 @@ cc: ~A (RPAQ? SUBJECTSTR ">>Subject<<") (RPAQ? LAFITE.SEND.FORMATTED '((NSCHARS :ASK) - (CHARLOOKS :ASK) - (PARALOOKS :ASK) - (IMAGEOBJ :ASK))) + (CHARLOOKS :ASK) + (PARALOOKS :ASK) + (IMAGEOBJ :ASK))) @@ -1726,15 +1734,15 @@ cc: ~A (RPAQQ LAFITE.MSG.ICON (#*(82 72)@@@@@@@@@GO@@@@@@@@@@@@@@@@@@@@@AOOL@@@@@@@@@@@@@@@@@@@@GH@O@@@@@@@@@@@@@@@@@@@CN@@CL@@@@@@@@@@@@@@@@@@OH@@@OH@@@@@@@@@@@@@@@@CL@@@@CN@@@@@@@@@@@@@@@@O@@@@@@GH@@@@@@@@@@@@@@CL@@@@@@AN@@@@@@@@@@@@@AO@@@@@@@@GL@@@@@@@@@@@@GL@@@@@@@@AO@@@@@@@@@@@AN@@@@@@@@@@CL@@@@@@@@@@GH@@@@@@@@@@@O@@@@@@@@@CN@@@@@@@@@@@@CL@@@@@@@@OH@@@@@@@@@@@@@OH@@@@@@CL@@@@@@@@@@@@@@CN@@@@@@O@@@@@@@@@@@@@@@@GH@@@@CL@@@@@@@@@@@@@@@@AN@@@@O@@@@@@@@@@@@@@@@@@GH@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@O@@@@@@@@@@@@@@@@@@GL@@@ML@@@@@@@@@@@@@@@@ALL@@@LN@@@@@@@@@@@@@@@@CHL@@@LCH@@@@@@@@@@@@@@@N@L@@@LAL@@@@@@@@@@@@@@CL@L@@@L@G@@@@@@@@@@@@@@G@@L@@@L@CL@@@@@@@@@@@@AL@@L@@@L@@N@@@@@@@@@@@@CH@@L@@@L@@CH@@@@@@@@@@@N@@@L@@@L@@AL@@@@@@@@@@AL@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@L@@@L@@N@@@@@@@@@@@@CH@@L@@@L@CL@@@@@@@@@@@@AL@@L@@@L@G@@@@@@@@@@@@@@G@@L@@@LAL@@@@@@@@@@@@@@CL@L@@@LCH@@@@@@@@@@@@@@@N@L@@@LN@@@@@@@@@@@@@@@@CHL@@@ML@@@@@@@@@@@@@@@@ALL@@@O@@@@@@@@@@@@@@@@@@GL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@ - #*(82 72)@@@@@@@@@GO@@@@@@@@@@@@@@@@@@@@@AOOL@@@@@@@@@@@@@@@@@@@@GOOO@@@@@@@@@@@@@@@@@@@COOOOL@@@@@@@@@@@@@@@@@@OOOOOOH@@@@@@@@@@@@@@@@COOOOOON@@@@@@@@@@@@@@@@OOOOOOOOH@@@@@@@@@@@@@@COOOOOOOON@@@@@@@@@@@@@AOOOOOOOOOOL@@@@@@@@@@@@GOOOOOOOOOOO@@@@@@@@@@@AOOOOOOOOOOOOL@@@@@@@@@@GOOOOOOOOOOOOO@@@@@@@@@COOOOOOOOOOOOOOL@@@@@@@@OOOOOOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOOOOON@@@@@@OOOOOOOOOOOOOOOOOOH@@@@COOOOOOOOOOOOOOOOOON@@@@OOOOOOOOOOOOOOOOOOOOH@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@ - (8 8 64 36))) + #*(82 72)@@@@@@@@@GO@@@@@@@@@@@@@@@@@@@@@AOOL@@@@@@@@@@@@@@@@@@@@GOOO@@@@@@@@@@@@@@@@@@@COOOOL@@@@@@@@@@@@@@@@@@OOOOOOH@@@@@@@@@@@@@@@@COOOOOON@@@@@@@@@@@@@@@@OOOOOOOOH@@@@@@@@@@@@@@COOOOOOOON@@@@@@@@@@@@@AOOOOOOOOOOL@@@@@@@@@@@@GOOOOOOOOOOO@@@@@@@@@@@AOOOOOOOOOOOOL@@@@@@@@@@GOOOOOOOOOOOOO@@@@@@@@@COOOOOOOOOOOOOOL@@@@@@@@OOOOOOOOOOOOOOOOH@@@@@@COOOOOOOOOOOOOOOON@@@@@@OOOOOOOOOOOOOOOOOOH@@@@COOOOOOOOOOOOOOOOOON@@@@OOOOOOOOOOOOOOOOOOOOH@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOL@@@ + (8 8 64 36))) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD SENDINGCOMMAND (COMMAND ITEM MENU MESSAGE MESSAGEPARSE) - [TYPE? (AND (LISTP DATUM) - (FMEMB (fetch COMMAND of DATUM) - '(%##SEND## %##SAVE## %##FORGETIT##]) + [TYPE? (AND (LISTP DATUM) + (FMEMB (fetch COMMAND of DATUM) + '(%##SEND## %##SAVE## %##FORGETIT##]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -1758,29 +1766,29 @@ cc: ~A (PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5301 28278 (DOLAFITESENDINGCOMMAND 5311 . 5801) (\SENDMESSAGE.INITIATE 5803 . 7742) ( -\SENDMSG.DELIVER 7744 . 8352) (\SENDMSG.EXIT.TEDIT 8354 . 8725) (\SENDMSG.SAVE.FORM 8727 . 10714) ( -\LAFITE.HEADER.EOF 10716 . 11009) (\LAFITE.INSERT.REPLYTO 11011 . 11619) (\SENDMSG.REPLYTO 11621 . -12180) (\SENDMSG.CHANGE.MODE 12182 . 17758) (\SENDMSG.FIND.FIELD 17760 . 18270) (\SENDMESSAGE.PARSE -18272 . 19068) (\LAFITE.PREPARE.SEND 19070 . 21903) (\LAFITE.PREPARE.ERROR 21905 . 23087) ( -\LAFITE.CHOOSE.MSG.FORMAT 23089 . 25730) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25732 . 26657) ( -\SENDMESSAGE.MENUPROMPT 26659 . 27522) (\SENDMESSAGE.PROMPT 27524 . 28060) (\SENDMESSAGEFAIL 28062 . -28276)) (28279 52755 (\SENDMESSAGE 28289 . 29481) (\SENDMESSAGE.RESTARTABLE 29483 . 34790) ( -\SENDMESSAGE.CLEANUP 34792 . 35008) (\SENDMESSAGE.MAKEWINDOW 35010 . 41183) (MAKELAFITEDELIVERMENU -41185 . 41492) (\LAFITE.CLOSEMSG? 41494 . 42444) (\LAFITE.AFTER.DELIVER 42446 . 45765) ( -\LAFITE.UNSENT.ICON 45767 . 46077) (\LAFITE.FETCH.SUBJECT 46079 . 46879) (LAFITE.SENDMESSAGE 46881 . -47642) (\SENDMESSAGE0 47644 . 50508) (LA.ASSURE.PROMPT.WINDOW 50510 . 51407) (\LAFITE.SEND.FAIL 51409 - . 51880) (\LAFITE.INVALID.RECIPIENTS 51882 . 52340) (\SENDMESSAGE.ABORT 52342 . 52753)) (52787 62700 -(\OUTBOX.CREATE 52797 . 54260) (\OUTBOX.RESET 54262 . 54755) (\OUTBOX.CLOSEFN 54757 . 54897) ( -\OUTBOX.REPAINTFN 54899 . 55562) (\OUTBOX.RESHAPEFN 55564 . 56847) (\OUTBOX.SHADEITEM 56849 . 57522) ( -\OUTBOX.BUTTONFN 57524 . 60372) (\OUTBOX.DISPLAYLINE 60374 . 60868) (\OUTBOX.ADD.ITEM 60870 . 62698)) -(62996 79218 (\LAFITE.MESSAGEFORM 63006 . 67349) (MAKELAFITESUPPORTFORM 67351 . 67540) ( -MAKELISPSUPPORTFORM 67542 . 67708) (MAKEXXXSUPPORTFORM 67710 . 71690) (MAKENEWMESSAGEFORM 71692 . -72531) (MAKELAFITEPRIVATEFORMSITEMS 72533 . 72961) (\LAFITE.UNCACHE.MESSAGEFORM 72963 . 73416) ( -\LAFITE.DELETE.MESSAGEFORM 73418 . 74019) (\LAFITE.SELECT.FORM 74021 . 74376) ( -\LAFITE.DELETE.FORM.INTERNAL 74378 . 75522) (\LAFITE.READ.FORM 75524 . 78261) (\LAFITE.FIND.TEMPLATE -78263 . 79216)) (79242 87146 (\LAFITE.ANSWER 79252 . 79657) (\LAFITE.ANSWER.PROC 79659 . 81553) ( -MAKEANSWERFORM 81555 . 84367) (LA.PRINT.COMMA.LIST 84369 . 84855) (LAFITE.FILL.IN.ANSWER.FORM 84857 . -87144)) (87171 92434 (\LAFITE.FORWARD 87181 . 87589) (\LAFITE.FORWARD.PROC 87591 . 89580) ( -MAKEFORWARDFORM 89582 . 92432))))) + (FILEMAP (NIL (5539 28516 (DOLAFITESENDINGCOMMAND 5549 . 6039) (\SENDMESSAGE.INITIATE 6041 . 7980) ( +\SENDMSG.DELIVER 7982 . 8590) (\SENDMSG.EXIT.TEDIT 8592 . 8963) (\SENDMSG.SAVE.FORM 8965 . 10952) ( +\LAFITE.HEADER.EOF 10954 . 11247) (\LAFITE.INSERT.REPLYTO 11249 . 11857) (\SENDMSG.REPLYTO 11859 . +12418) (\SENDMSG.CHANGE.MODE 12420 . 17996) (\SENDMSG.FIND.FIELD 17998 . 18508) (\SENDMESSAGE.PARSE +18510 . 19306) (\LAFITE.PREPARE.SEND 19308 . 22141) (\LAFITE.PREPARE.ERROR 22143 . 23325) ( +\LAFITE.CHOOSE.MSG.FORMAT 23327 . 25968) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25970 . 26895) ( +\SENDMESSAGE.MENUPROMPT 26897 . 27760) (\SENDMESSAGE.PROMPT 27762 . 28298) (\SENDMESSAGEFAIL 28300 . +28514)) (28517 52962 (\SENDMESSAGE 28527 . 29879) (\SENDMESSAGE.RESTARTABLE 29881 . 34865) ( +\SENDMESSAGE.CLEANUP 34867 . 35083) (\SENDMESSAGE.MAKEWINDOW 35085 . 41258) (MAKELAFITEDELIVERMENU +41260 . 41567) (\LAFITE.CLOSEMSG? 41569 . 42519) (\LAFITE.AFTER.DELIVER 42521 . 45840) ( +\LAFITE.UNSENT.ICON 45842 . 46152) (\LAFITE.FETCH.SUBJECT 46154 . 46954) (LAFITE.SENDMESSAGE 46956 . +47849) (\SENDMESSAGE0 47851 . 50715) (LA.ASSURE.PROMPT.WINDOW 50717 . 51614) (\LAFITE.SEND.FAIL 51616 + . 52087) (\LAFITE.INVALID.RECIPIENTS 52089 . 52547) (\SENDMESSAGE.ABORT 52549 . 52960)) (52994 62907 +(\OUTBOX.CREATE 53004 . 54467) (\OUTBOX.RESET 54469 . 54962) (\OUTBOX.CLOSEFN 54964 . 55104) ( +\OUTBOX.REPAINTFN 55106 . 55769) (\OUTBOX.RESHAPEFN 55771 . 57054) (\OUTBOX.SHADEITEM 57056 . 57729) ( +\OUTBOX.BUTTONFN 57731 . 60579) (\OUTBOX.DISPLAYLINE 60581 . 61075) (\OUTBOX.ADD.ITEM 61077 . 62905)) +(63203 79611 (\LAFITE.MESSAGEFORM 63213 . 67556) (MAKELAFITESUPPORTFORM 67558 . 67747) ( +MAKELISPSUPPORTFORM 67749 . 67915) (MAKEXXXSUPPORTFORM 67917 . 71966) (MAKENEWMESSAGEFORM 71968 . +72924) (MAKELAFITEPRIVATEFORMSITEMS 72926 . 73354) (\LAFITE.UNCACHE.MESSAGEFORM 73356 . 73809) ( +\LAFITE.DELETE.MESSAGEFORM 73811 . 74412) (\LAFITE.SELECT.FORM 74414 . 74769) ( +\LAFITE.DELETE.FORM.INTERNAL 74771 . 75915) (\LAFITE.READ.FORM 75917 . 78654) (\LAFITE.FIND.TEMPLATE +78656 . 79609)) (79635 87366 (\LAFITE.ANSWER 79645 . 80050) (\LAFITE.ANSWER.PROC 80052 . 81946) ( +MAKEANSWERFORM 81948 . 84478) (LA.PRINT.COMMA.LIST 84480 . 84966) (LAFITE.FILL.IN.ANSWER.FORM 84968 . +87364)) (87391 93587 (\LAFITE.FORWARD 87401 . 87809) (\LAFITE.FORWARD.PROC 87811 . 89800) ( +MAKEFORWARDFORM 89802 . 93585))))) STOP diff --git a/library/lafite/LAFITESEND.LCOM b/library/lafite/LAFITESEND.LCOM index 7e180958f6a9163adc75cb4c423b49d04575cf7b..0d99d7dbeba94f685893121b6a6cb6bbe600909b 100644 GIT binary patch delta 4144 zcmbVPU2Ggz74~kL&}~-ym z#KCrv+%{QSiHDK`b_NwB)Tc_7cmzN3gaGk?RPlnuPlcdT#XEh32gG;pomuZX?hBDK zdw5LJ|s=867_TkG` z@%H}VdlQ$~3?%5W1Y=cBtGa&p_tEsbKb%bG4u(gX?lo_Dc{y&kT49vThf$N1(l;KC zcHJOe@*+9VaOeHRE92xw*$>KUrYxt#ax|9Qs4n|kcZfFMZZt^$x#e7cs2=%v`kD&O53_uYs51c4C3?< zcXba&KJ~6I{$F>UA=OsoUH8LwJX?o5NJ-=RY}~mk+(8M9Z94eV$l<*SsrTihFBR9w z#ShO64V}5Netro5jxPS{ifp6@+6NQVAg#y`D4`XHBwmCLp^ilwew?)038A)uyNrL0 zavRgjNjP^EhOm0=iro{nd2iH2Gg&FOqOj)0G2uM@I{$o^nIvp^f!HQa0H-FQY6Lw$ zSjfiI-m24rlbBwCiea;rEcrn_T!Nu#8~?5 z<)HA3bocU~&nlN(oqWIWR{F`LS>*b|gVCZv(-t4=Qc`P#vA0Axyp&lLKP|#-i^Pj= z-9xZ63AY$}VY^We62eWBtj1nYZ^8xcf~OPaaH4Ej_Zo6JvtaE$M=?X(x$Y-~af__F zEx4=B$Ot>dQR!c%HoK*1USTBi;>3*-cdp?P?!c-ijlg+@T%MQ^+DuFkPMPQ-co)3H zPsE6B$a&ZaJyx;$q#0ta9tKm;2?&#Rm=6eplUI{wzwQ9tBL_3%6m1yG9WAaJf^c9i z#`w{bGgF1fO4Bo?Bm22`hM!n?Y-p&E#mXPQQY%>LCv&4AP;wjyCjtE^p5b#o020n6)Df}+|+l`+T&L7=7{J$3+BWWorAtfdR*NM!|L)gW_nwHZP)8-wL?LBO`xR5k!@ z!;vC^wPP>BrMe!XFF%ffH1h>OUbbP+f&Huv2dZg`>msteaK4p9g27Lsl$uNq4e%~S zs7N!X=htq9rD>~D=_fr)Bn6q2CCOUSq$(d+w!m7}h5;jgVKE^VG*>OdV(Guu#)_sT ze^>=S;{_YvOJ{gR^e#BTa!&FZf}&K^Tx&!zHdAneyUn`N`c=XL%%5^MQ^UB|J?X(_e2C! z5MdVYu!i(CM?&iXiXu2N0Lb81xm?nXYSJ8#6!_@_98xCuS1pAlGPpV2T)Y=Dl8xkE zh!`agBLixpKonR*;HzQOhJ&ddTt|_96d)*wJZ{fj^=hIJK*G+ER*wCJz)jkb$l~eY z=17+V7Ak)UNhJEntNAS-RYWWXfVTdPcm~lvUU!I~caeF)b(sf*=aOyV3m8g^U%B;i zXKfGNnUa8o18~>gwkB_=U5g_0-Tb zL%}e3X<4d>Ar)xp&g<`<6$K4VNAA4_&mY{|#P{F#_R@p&V*2L&4?g3={pU8%6 z1cd99D7AYDAqOF9M;w<;BaE{a!Xj${f>}$iq`!WC>~mlicug6F*p-xSe!0~Z z@P-#GB#X$(Crm2SDJl+0F$}dwA3B%=$P9NGf}?Mgf}00HgEXXkd@4*BL%^#@r8f9M z0foYZ8oAxs-M#rzhiq@4Ly;Y{sa-VSC@qpVLHKuOcRF{! zxj(xnac3GOqD{*YvbUY@E7$~k_5P0&Py$dH{Py(tSY{y|QaFt0h3$<8P zJiw5b8J-b?gmMf}ieds-+{`(GBFU>gsMXU+An15Iim1;-kau&=LwfJSbcRSy0LVVT zAl1D4V7$nk^p_8&#!-7g`A3}14I}-}1G0o{pysmYq(UUDr{@LYi3x@X%bbhQ0v_3PfaEA15O0rPK$WP{F+`m79~c=}m43MM z#TD>;)t$p5o0!B8@SYPqh!+Ua?z<&{ar~6<9~ia(ybS7iBWW+(zw*L;7Xml#yEgz~ cAbbFpKl}bW7ang1{&Lgx8%Og${lm!r0P{m8WdHyG delta 4001 zcmbVPU2Ggz753UmfK=NS5|Y%alB2Pb*uZY*-a9ipvqg@_yJLIenc3~mxQ=PkHnrD3 zh1!wr6h%?IMDSF#fiMUm1VX&2_YW%d8mYh3PMOcK_l@1k9`IS@!k2^olWvY zqNo0PdF&!eJZwOUnZ?fQOq?Xd@# z%GB|pcf?PPo$ejK-3%A+d~qpsI^p!9-S+HY+G{mzZ`ya7p0gsV`t-aTRnpnC=gxNQ z&dRiB&$*G4eL^Q_R-b2NS*EJfjot2>TRS)RlBb-n({Y7FrP*DDy{bw~tLvgJRE3g@ zYyaoXhu6n;>8Zbrjf{-VtbJ+(|K9!eO#H8jKTN15wL5OWh*_K>r-KPGQzg$0qxMon z%rN6pY5Wos49i!d*6d|scvwERSYOqs^`#ny(Mq-5X*HZMBwmZv^QU^uqE_1pT72cg z*-|V=KcyYWXC{u=-4;!jHV;@2kiQLe{-v`!r%jcJLeG}WMn*9x6w5?108=|^~` zO`^sqT(FxC0Oga=YnZi`yk-z#qS94~E+5MFyraVLCZ(QiI$pA!8;D~uG(yIp=|)H` z_{eS}K+O`5U!L0Rl_v$<-*Ljo?nL&i=a4WTXEn?|KQSRMo|qt^*5qui)tPr9H-dy) zRCkMx?AD6$r@gVs_-ZsyPCNW4r2&*h3hYCeQn**XF# z%Z;oOFbclph-bFO2YXrn=zaj%Ab<=3O!qLDi)3D67Dw;$L4yOVE`H0*I6ff`g_L1yw7P;%)8Spzzk-ez)=lHPIhPU0$o< zZz3%SIqqIvmFo;9eY{bHG3Pdy@%QJWCr;Lz=JCMwXyk)Y6x}97Ri#)K9({VL)=L0)h>d30y zLzX89DN2P!S>=*DP02_Nx9y^12&DiNRXjL9p@=b_uzXT`C0f$h)G&&6l89@hgg0M% zy}SCvzMNyKpagup{p{htUvGY<^r!gJoqMJC;}7p}T3g$Y5xcxOK3+a5M^BHSJ<Y!9dtGFqvOB#HKtS^^Ty-ecrk+`mJZ z=p_TkbAtJ30S!Ul*Ej{;BEl+QLJBjEicdh>#$)#O ziSnQ_30=f5ynU|M$A>@_mvIv)bbTV=R+`liCcs0>l(!>%zz7n5*;b*-kfXcvQNEM5 zYEbA<=LSG#plM*Xm(vH!dJxbWI=u`75^00u7ziM}M*iB!=@9j~fc@n6fHVTYEr7+q zEaj6n`X{IAhx1iDvKk$2HBbTKy>~8-13ob6k-{W2Gk*Ua8s#GX^p8%B2~;|K%N*I4 zK@GJKk~3W7U0;E;&~D1bCpmIqKv(gDub)1P)*!tMj{z|BA@*YNZ|{vSqB9<-04C`K z4_~%B%>vmC9VPN}3!vp@{NH diff --git a/library/lafite/MAILSCAVENGE b/library/lafite/MAILSCAVENGE index 0e07e6d5..a88057e6 100644 --- a/library/lafite/MAILSCAVENGE +++ b/library/lafite/MAILSCAVENGE @@ -1,9 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Sep-2021 22:57:39"  -{DSK}kaplan>Local>medley3.5>git-medley>library>lafite>MAILSCAVENGE.;2 40187 - previous date%: "15-Jun-90 18:25:37" -{DSK}kaplan>Local>medley3.5>git-medley>library>lafite>MAILSCAVENGE.;1) +(FILECREATED " 7-Feb-2022 12:04:09"  +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;4 40080 + + :CHANGES-TO (FNS \MAILSCAVENGE.MAKEWINDOW) + + :PREVIOUS-DATE "30-Sep-2021 22:57:39" +{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;3) (* ; " @@ -509,36 +512,34 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation. *ERRORMSGSTREAM* ARGS)))) (\MAILSCAVENGE.MAKEWINDOW - [LAMBDA (FOLDER) (* ; "Edited 21-Apr-89 15:34 by bvm") + [LAMBDA (FOLDER) (* ; "Edited 7-Feb-2022 11:51 by rmk") + (* ; "Edited 21-Apr-89 15:34 by bvm") (* ;; - "Return a tedit window to use for Scavenger report, or NIL if FOLDER doesn't have a browser") + "Return a tedit window to use for Scavenger report, or NIL if FOLDER doesn't have a browser") (LET ((BROWSERWINDOW (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) (if BROWSERWINDOW - then (LET* ((FONT (DSPFONT NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER)) - ) - (ERRHEIGHT (HEIGHTIFWINDOW (TIMES 10 (FONTPROP FONT 'HEIGHT)) - T)) - (ERRW (CREATEW (CREATEREGION 0 0 10 ERRHEIGHT) - (CONCAT "Mail Scavenger Report for " (fetch - (MAILFOLDER + then (LET* ((FONT (DSPFONT NIL (fetch (MAILFOLDER BROWSERWINDOW) of FOLDER))) + (ERRHEIGHT (HEIGHTIFWINDOW (TIMES 10 (FONTPROP FONT 'HEIGHT)) + T)) + (ERRW (CREATEW (CREATEREGION 0 0 10 ERRHEIGHT) + (CONCAT "Mail Scavenger Report for " (fetch (MAILFOLDER SHORTFOLDERNAME - ) of - FOLDER)) - T))) - (ATTACHWINDOW ERRW BROWSERWINDOW - (if (< (fetch (REGION BOTTOM) of (WINDOWPROP - BROWSERWINDOW - 'REGION)) - ERRHEIGHT) - then (* ; "Won't fit below") - 'TOP - else 'BOTTOM) - 'JUSTIFY - 'LOCALCLOSE) - (OPENTEXTSTREAM "" ERRW NIL NIL `(FONT ,FONT PROMPTWINDOW DON'T)) - ERRW]) + ) + of FOLDER)) + T))) + (ATTACHWINDOW ERRW BROWSERWINDOW + (if (< (fetch (REGION BOTTOM) of (WINDOWPROP BROWSERWINDOW + 'REGION)) + ERRHEIGHT) + then (* ; "Won't fit below") + 'TOP + else 'BOTTOM) + 'JUSTIFY + 'LOCALCLOSE) + (OPENTEXTSTREAM NIL ERRW NIL NIL `(FONT ,FONT PROMPTWINDOW DON'T)) + ERRW]) (\MAILSCAVENGE.ASKUSER [LAMBDA (PROMPT) @@ -655,10 +656,10 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation. ) (PUTPROPS MAILSCAVENGE COPYRIGHT ("Venue & Xerox Corporation" 1985 1989 1990 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1409 39666 (LAFITE.SCAVENGE 1419 . 1941) (\MAILSCAVENGE.INTERNAL 1943 . 28454) ( -\MAILSCAVENGE.OPEN.SCRATCH 28456 . 29059) (\MAILSCAVENGE.LENGTHWIDTH 29061 . 29474) ( -\MAILSCAVENGE.LFCOPYBYTES 29476 . 30045) (\MAILSCAVENGE.READSTAMP 30047 . 30794) ( -\MAILSCAVENGE.DUPLICATE? 30796 . 31497) (\MAILSCAVENGE.FORMAT 31499 . 32326) (\MAILSCAVENGE.MAKEWINDOW - 32328 . 34382) (\MAILSCAVENGE.ASKUSER 34384 . 37514) (\MAILSCAVENGE.FIX.LENGTHS 37516 . 38674) ( -\MAILSCAVENGE.CONFIRM 38676 . 39664))))) + (FILEMAP (NIL (1459 39559 (LAFITE.SCAVENGE 1469 . 1991) (\MAILSCAVENGE.INTERNAL 1993 . 28504) ( +\MAILSCAVENGE.OPEN.SCRATCH 28506 . 29109) (\MAILSCAVENGE.LENGTHWIDTH 29111 . 29524) ( +\MAILSCAVENGE.LFCOPYBYTES 29526 . 30095) (\MAILSCAVENGE.READSTAMP 30097 . 30844) ( +\MAILSCAVENGE.DUPLICATE? 30846 . 31547) (\MAILSCAVENGE.FORMAT 31549 . 32376) (\MAILSCAVENGE.MAKEWINDOW + 32378 . 34275) (\MAILSCAVENGE.ASKUSER 34277 . 37407) (\MAILSCAVENGE.FIX.LENGTHS 37409 . 38567) ( +\MAILSCAVENGE.CONFIRM 38569 . 39557))))) STOP diff --git a/library/lafite/MAILSCAVENGE.LCOM b/library/lafite/MAILSCAVENGE.LCOM index 1abf12e97fb335f1d54078e297770d5f8408a67f..29cbfe3a169d7436a56d9c22ef70f267fe69cf84 100644 GIT binary patch delta 372 zcmdlP`zm&VhccIjo2QSfbC9cJh^vc&l7hLeTWXT7k%5tsf}xR>fr*uo;lwO6rrgTO zzZq2}Of-Q?3=v9K= zB~5~kFtD6hr3Q6`l!=0gfq{jAf|av}qo2ELux^OIf`*%4umTs*4H5#H3RVF@u3?`3 zp~1Q?KwnLEX0(B7Wi;Nb$fTeoK8uBcfzg4D0SHd22^uncY+-KN$j~`CLM4weWAbSg z8AgN2FH}lcxik!o%_b+R=G$^WX;DQE-)`TGWhgnRnA_=hXF`1`4cXeyYQDk%9T oX67gaCnuJr=B1|=DFme!etBZn?v4L)IYJskifsvttk+GG5k(G(%#B4L>^vsgU z=1i&*Mw$vrMwUowjI4|-tPG7NJ`nfG%P+~u%u83u%u`Tu3-$3)Kvt-yr>CTll30?O zg4F;EB~315mrVZ2XaloU&q%?(QNp{cG{X`Zg7fr6oh zm655HvAL4M#5!e|PDaDcu}lg|;`3M-7#JPc7=YlUnxG-G#}?+MjSRh$r>Nv9<%2}M zGg8t)v?rJ+CB@4M78PL7Ff=upte{%L%Bx{$Vla88YCapUhJvAq* Date: Sat, 19 Feb 2022 18:37:42 -0800 Subject: [PATCH 4/4] Comparison tools: Cosmetic fixes, a few glitches --- lispusers/COMPAREDIRECTORIES | 253 ++++++++++++++----- lispusers/COMPAREDIRECTORIES.LCOM | Bin 37090 -> 39205 bytes lispusers/COMPAREDIRECTORIES.TEDIT | 6 +- lispusers/COMPARETEXT.LCOM | Bin 11478 -> 10916 bytes lispusers/EXAMINEDEFS | 56 ++--- lispusers/EXAMINEDEFS.LCOM | Bin 3953 -> 3953 bytes lispusers/GITFNS | 392 +++++++++++++++++------------ lispusers/GITFNS.LCOM | Bin 27015 -> 27029 bytes lispusers/PSEUDOHOSTS | 33 ++- lispusers/PSEUDOHOSTS.LCOM | Bin 8188 -> 8106 bytes lispusers/comparetext | 59 ++--- 11 files changed, 477 insertions(+), 322 deletions(-) diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 15706739..c4afea93 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Jan-2022 00:03:59"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;169 111694 +(FILECREATED "18-Feb-2022 17:05:27"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;189 119161 :CHANGES-TO (FNS CD-MENUFN) - (VARS CDTABLEBROWSER.MENUITEMS) - :PREVIOUS-DATE "28-Jan-2022 17:12:22" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;162) + :PREVIOUS-DATE "11-Feb-2022 16:21:21" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;188) (* ; " @@ -52,7 +51,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp TABLEBROWSER)) (FNS CD.TABLEITEM CD.TABLEITEM.PRINTFN CD.TABLEITEM.COPYFN CDTABLEBROWSER.HEADING.REPAINTFN) - (FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN) + (FNS CDTABLEBROWSER.WHENSELECTEDFN CD.COMMANDSELECTEDFN CD-MENUFN CDBROWSER-COPY + CDBROWSER-DELETE-FILE CD-SWAPDIRS) (VARS CDTABLEBROWSER.MENUITEMS) (FILES (SYSLOAD) COMPARESOURCES COMPARETEXT)))) @@ -65,7 +65,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (COMPAREDIRECTORIES [LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS - FIXDIRECTORYDATES) (* ; "Edited 26-Jan-2022 13:33 by rmk") + FIXDIRECTORYDATES) (* ; "Edited 4-Feb-2022 13:44 by rmk") + (* ; "Edited 31-Jan-2022 21:52 by rmk") + (* ; "Edited 26-Jan-2022 13:33 by rmk") (* ; "Edited 4-Jan-2022 12:09 by rmk") (* ; "Edited 31-Oct-2021 11:01 by rmk:") (* ; "Edited 7-Jan-2021 23:21 by rmk:") @@ -108,9 +110,9 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (SETQ DEPTH2 T) (SETQ DIR2 (SUBSTRING DIR2 1 -2))) (SETQ DIR1 (OR (DIRECTORYNAME (OR DIR1 T)) - (ERROR "DIRECTORY DOES NOT EXIST" DIR1))) + DIR1)) (SETQ DIR2 (OR (DIRECTORYNAME (OR DIR2 T)) - (ERROR "DIRECTORY DOES NOT EXIST" DIR2))) + DIR2)) (CL:WHEN FIXDIRECTORYDATES (PRINTOUT T "Fixing directory dates" T) (FIX-DIRECTORY-DATES DIR1) @@ -153,12 +155,12 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (* ;; "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] - T) + (SETQ CANDIDATES (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)") @@ -1758,7 +1760,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp 'DON'T]) (CD.COMMANDSELECTEDFN - [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 27-Jan-2022 17:46 by rmk") + [LAMBDA (MENUITEM MENU KEY) (* ; "Edited 5-Feb-2022 17:23 by rmk") + (* ; "Edited 27-Jan-2022 17:46 by rmk") (* ; "Edited 10-Jan-2022 22:51 by rmk") (* ; "Edited 25-Dec-2021 11:20 by rmk") (* ; "Edited 12-Jan-87 12:57 by bvm:") @@ -1810,24 +1813,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (CD-MENUFN [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) - (* ;; "Edited 29-Jan-2022 00:03 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.") + (* ;; "Edited 18-Feb-2022 16:56 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.") (* ;; "The FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.") (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom.") - (CL:WHEN (MEMB (OR (CADDR MENUITEM) - (CAR MENUITEM)) - '(Compare See See% right See% both See% left)) + (DECLARE (USEDFREE CDENTRY LABEL1 LABLE2 FILE1 FILE2 WINDOW)) + (SETQ MENUITEM (OR (CADDR MENUITEM) + (CAR MENUITEM))) + (CL:WHEN (MEMB MENUITEM '(Compare See See% right See% both See% left)) (* ; "Close the previous ones") (CLOSEWITH.DOIT WINDOW)) (LET (CHILDREN) (SETQ CHILDREN - (SELECTQ (OR (CADDR MENUITEM) - (CAR MENUITEM)) + (SELECTQ MENUITEM (Compare (IF (AND FILE1 FILE2) - THEN (SELECTQ TYPE + THEN [SELECTQ TYPE (SOURCE (CSBROWSER FILE1 FILE2 NIL LABEL1 LABEL2 (RELCREATEREGION [FIXR (TIMES 0.75 (FETCH (REGION WIDTH) @@ -1840,11 +1843,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW 'REGION)) 20) - T))) + NIL))) (COMPILED (FLASHWINDOW T) (PRIN3 "Cannot compare compiled files" T)) - ((TEXT TEDIT) - (* ;; + ((TEXT TEDIT OTHER) + (* ;;  "Works for TEDIT, but doesn't detect image object differences") (COMPARETEXT FILE1 FILE2 'LINE @@ -1855,7 +1858,13 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (LIST LABEL1 LABEL2))) (PROGN (FLASHWINDOW T) (PRIN3 "Unable to compare, showing both" T) - (TEDIT-SEE-VERSIONS FILE1 FILE2 LABEL1 LABEL2))) + (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 + (RELCREATEREGION 1400 700 'LEFT 'TOP + `(,WINDOW 0.5 -701) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + -1) + NIL] ELSE (FLASHWINDOW T) (PRIN3 "Only one file" T))) (See% left (IF FILE1 @@ -1875,36 +1884,143 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW 'REGION)) -1) - T) + NIL) NIL (CONCAT "SEE window for " LABEL2)) ELSE (FLASHWINDOW T) (PRIN3 "No file to print" T))) ((See See% both) - (IF (AND FILE1 FILE2) - THEN (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 - (RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701) - (IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW - 'REGION)) - -1) - T)) - ELSE (FLASHWINDOW T) - (PRIN3 "Only one file" T))) - (Copy% -> (LET [(DEST (COPYFILE FILE1 (PACKFILENAME 'VERSION NIL FILE2] - (PRIN3 (CL:IF DEST - (CONCAT "Copied to " DEST) - (PROGN (FLASHWINDOW T) - (CONCAT FILE2 " could not be copied"))) - T))) - (Copy% <- (LET [(DEST (COPYFILE FILE2 (PACKFILENAME 'VERSION NIL FILE1] - (PRIN3 (CL:IF DEST - (CONCAT "Copied to " DEST) - (PROGN (FLASHWINDOW T) - (CONCAT FILE1 " could not be copied"))) - T))) + (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2 (RELCREATEREGION + 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701) + (IPLUS (FETCH (REGION BOTTOM) + OF (WINDOWPROP WINDOW 'REGION)) + -1) + NIL))) + (Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT)) + (Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT)) + (Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T)) + (|Delete ALL <-| + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL)) + (Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T)) + (|Delete ALL ->| + (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL)) (SHOULDNT))) (CLOSEWITH CHILDREN WINDOW) (MOVEWITH CHILDREN WINDOW]) + +(CDBROWSER-COPY + [LAMBDA (CDBROWSER TBITEM SOURCE) (* ; "Edited 5-Feb-2022 17:27 by rmk") + (* ; "Edited 2-Feb-2022 22:18 by rmk") + + (* ;; "Copies the file identified as SOURCE (LEFT or RIGHT) in CDENTRY to the other file of the end. If the destination file is missing, it is assumed to be a new/unversioned file of the same name as the source but with the directory prefix switched. CDVALUE needed to know what directory prefixes are involved.") + + (* ;; "Returns NIL if the copy fails.") + + (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) + (PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER) + 'CDVALUE)) + (SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE)) + (DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE)) + (CDENTRY (CADR (FETCH TIDATA OF TBITEM))) + (SOURCEINFO (FETCH (CDENTRY INFO1) OF CDENTRY)) + (DESTINFO (FETCH (CDENTRY INFO2) OF CDENTRY)) + SOURCEFILE DESTFILE SOURCEVER (DATERELBAD '<) + RESULT) + + (* ;; "Start assuming LEFT, switch if RIGHT") + + (CL:WHEN (EQ SOURCE 'RIGHT) + (SWAP SOURCEINFO DESTINFO) + (SWAP SOURCEDIR DESTDIR) + (SETQ DATERELBAD '>)) + (SETQ SOURCEFILE (FETCH (CDINFO FULLNAME) OF SOURCEINFO)) + (SETQ DESTFILE (FETCH (CDINFO FULLNAME) OF DESTINFO)) + (CLEARW T) + (CL:UNLESS SOURCEFILE + (PRIN3 "No source file to copy" T) + (RETURN NIL)) + (CL:WHEN [AND (EQ DATERELBAD (FETCH (CDENTRY DATEREL) OF CDENTRY)) + (PROGN (FLASHWINDOW T) + (EQ 'N (ASKUSER NIL NIL + "Target is newer than source. Really copy? "] + (RETURN NIL)) + (CL:WHEN [AND (SETQ SOURCEVER (FILENAMEFIELD SOURCE 'VERSION)) + (ILESSP SOURCEVER (FILENAMEFIELD (INFILEP (PACKFILENAME 'VERFSION NIL + 'BODY SOURCEFILE)) + 'VERSION)) + (PROGN (FLASHWINDOW T) + (EQ 'N (ASKUSER NIL NIL (CONCAT SOURCEFILE + " is not the newest version. Really copy? " + ] + (RETURN NIL)) + (CLEARW T) + (CL:UNLESS DESTFILE + (SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR))) + (SETQ RESULT (COPYFILE SOURCEFILE (PACKFILENAME 'VERSION NIL 'BODY DESTFILE))) + (PRIN3 (IF RESULT + THEN (TB.DELETE.ITEM CDBROWSER TBITEM) + (CONCAT "Copied to " RESULT) + ELSE (FLASHWINDOW T) + (CONCAT SOURCEFILE " could not be copied")) + T) + (RETURN RESULT)))]) + +(CDBROWSER-DELETE-FILE + [LAMBDA (CDBROWSER TBITEM SIDE ONLYONE SAVE) (* ; "Edited 5-Feb-2022 17:46 by rmk") + (* ; "Edited 18-Jan-2022 23:02 by rmk") + (* ; "Edited 19-Dec-2021 23:33 by rmk") + + (* ;; "FILE is a full filename from a CDENTRY, and it will be removed. Unless ONLYONE and FILE has a version number, then all previous versions of the file are also removed so tha the next earliest version doesn't reemerge.") + + (* ;; "The deleted directory should be pruned separately, from time to time. ") + + (* ;; " Presumably SAVE is NIL for a git host, since git can restore on its own.") + + (* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.") + + (CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM) + [LET ((CDENTRY (CADR (FETCH TIDATA OF TBITEM))) + FILE OTHERFILE) + (SETQ FILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY))) + (SETQ OTHERFILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY))) + (CL:WHEN (EQ SIDE 'RIGHT) + (SWAP FILE OTHERFILE)) + (CL:WHEN FILE + (FOR F INSIDE (IF (FILENAMEFIELD FILE 'VERSION) + THEN [IF ONLYONE + THEN FILE + ELSE (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* + 'BODY FILE] + ELSE FILE) + COLLECT + + (* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).") + + (IF SAVE + THEN (CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY + (CONCAT "deleted>" + (FILENAMEFIELD F + 'DIRECTORY)) + 'BODY F)) + (ERROR "Could not delete " F)) + ELSE (DELFILE FILE)) + F FINALLY + + (* ;; "Perhaps only mark it as deleted if both files are gone?") + + (TB.DELETE.ITEM CDBROWSER TBITEM)))])]) + +(CD-SWAPDIRS + [LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk") + + (* ;; "Replaces prefix FROMDIR of FILE with TODIR") + + (IF (STRPOS FROMDIR FILE 1 NIL NIL T FILEDIRCASEARRAY) + THEN [SETQ FILE (CONCAT TODIR (SUBSTRING FILE (ADD1 (NCHARS FROMDIR] + (CL:IF KEEPVERSION + FILE + (PACKFILENAME.STRING 'VERSION NIL 'BODY FILE)) + ELSE (ERROR FILE (CONCAT " doesn't begin with " FROMDIR]) ) (RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN) @@ -1920,23 +2036,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2536 19051 (COMPAREDIRECTORIES 2546 . 8995) (COMPAREDIRECTORIES.INFOS 8997 . 11117) ( -CDENTRIES.SELECT 11119 . 15805) (COMPAREDIRECTORIES.INFOS.TYPE 15807 . 16435) (MATCHNAME 16437 . 16967 -) (CD.INSURECDVALUE 16969 . 18583) (CD.UPDATEWIDTHS 18585 . 19049)) (19052 29324 (CDFILES 19062 . -25418) (CDFILES.MATCH 25420 . 27045) (CDFILES.PATS 27047 . 29322)) (29325 44410 (CDPRINT 29335 . 31680 -) (CDPRINT.HEADER 31682 . 32579) (CDPRINT.LINE 32581 . 35137) (CDPRINT.MAXWIDTHS 35139 . 39254) ( -CDPRINT.COLHEADERS 39256 . 39894) (CDPRINT.COLUMNS 39896 . 43775) (CDTEDIT 43777 . 44408)) (44411 -52780 (CDMAP 44421 . 45853) (CDENTRY 45855 . 46164) (CDSUBSET 46166 . 47605) (CDMERGE 47607 . 51461) ( -CDMERGE.COMMON 51463 . 52778)) (52781 60319 (BINCOMP 52791 . 57080) (EOLTYPE 57082 . 59644) ( -EOLTYPE.SHOW 59646 . 60317)) (60847 74054 (FIND-UNCOMPILED-FILES 60857 . 64500) (FIND-UNSOURCED-FILES -64502 . 67311) (FIND-SOURCE-FILES 67313 . 69017) (FIND-COMPILED-FILES 69019 . 71097) ( -FIND-UNLOADED-FILES 71099 . 71843) (FIND-LOADED-FILES 71845 . 72399) (FIND-MULTICOMPILED-FILES 72401 - . 74052)) (74055 82257 (CREATED-AS 74065 . 78862) (SOURCE-FOR-COMPILED-P 78864 . 81562) ( -COMPILE-SOURCE-DATE-DIFF 81564 . 82255)) (82258 92564 (FIX-DIRECTORY-DATES 82268 . 85261) ( -FIX-EQUIV-DATES 85263 . 86788) (COPY-COMPARED-FILES 86790 . 88611) (COPY-MISSING-FILES 88613 . 90770) -(COMPILED-ON-SAME-SOURCE 90772 . 92562)) (92758 99800 (CDBROWSER 92768 . 96695) (CDBROWSER.STRINGS -96697 . 99798)) (99962 101234 (CD.TABLEITEM 99972 . 100192) (CD.TABLEITEM.PRINTFN 100194 . 100393) ( -CD.TABLEITEM.COPYFN 100395 . 100989) (CDTABLEBROWSER.HEADING.REPAINTFN 100991 . 101232)) (101235 -111110 (CDTABLEBROWSER.WHENSELECTEDFN 101245 . 101713) (CD.COMMANDSELECTEDFN 101715 . 105106) ( -CD-MENUFN 105108 . 111108))))) + (FILEMAP (NIL (2555 19321 (COMPAREDIRECTORIES 2565 . 9265) (COMPAREDIRECTORIES.INFOS 9267 . 11387) ( +CDENTRIES.SELECT 11389 . 16075) (COMPAREDIRECTORIES.INFOS.TYPE 16077 . 16705) (MATCHNAME 16707 . 17237 +) (CD.INSURECDVALUE 17239 . 18853) (CD.UPDATEWIDTHS 18855 . 19319)) (19322 29594 (CDFILES 19332 . +25688) (CDFILES.MATCH 25690 . 27315) (CDFILES.PATS 27317 . 29592)) (29595 44680 (CDPRINT 29605 . 31950 +) (CDPRINT.HEADER 31952 . 32849) (CDPRINT.LINE 32851 . 35407) (CDPRINT.MAXWIDTHS 35409 . 39524) ( +CDPRINT.COLHEADERS 39526 . 40164) (CDPRINT.COLUMNS 40166 . 44045) (CDTEDIT 44047 . 44678)) (44681 +53050 (CDMAP 44691 . 46123) (CDENTRY 46125 . 46434) (CDSUBSET 46436 . 47875) (CDMERGE 47877 . 51731) ( +CDMERGE.COMMON 51733 . 53048)) (53051 60589 (BINCOMP 53061 . 57350) (EOLTYPE 57352 . 59914) ( +EOLTYPE.SHOW 59916 . 60587)) (61117 74324 (FIND-UNCOMPILED-FILES 61127 . 64770) (FIND-UNSOURCED-FILES +64772 . 67581) (FIND-SOURCE-FILES 67583 . 69287) (FIND-COMPILED-FILES 69289 . 71367) ( +FIND-UNLOADED-FILES 71369 . 72113) (FIND-LOADED-FILES 72115 . 72669) (FIND-MULTICOMPILED-FILES 72671 + . 74322)) (74325 82527 (CREATED-AS 74335 . 79132) (SOURCE-FOR-COMPILED-P 79134 . 81832) ( +COMPILE-SOURCE-DATE-DIFF 81834 . 82525)) (82528 92834 (FIX-DIRECTORY-DATES 82538 . 85531) ( +FIX-EQUIV-DATES 85533 . 87058) (COPY-COMPARED-FILES 87060 . 88881) (COPY-MISSING-FILES 88883 . 91040) +(COMPILED-ON-SAME-SOURCE 91042 . 92832)) (93028 100070 (CDBROWSER 93038 . 96965) (CDBROWSER.STRINGS +96967 . 100068)) (100232 101504 (CD.TABLEITEM 100242 . 100462) (CD.TABLEITEM.PRINTFN 100464 . 100663) +(CD.TABLEITEM.COPYFN 100665 . 101259) (CDTABLEBROWSER.HEADING.REPAINTFN 101261 . 101502)) (101505 +118577 (CDTABLEBROWSER.WHENSELECTEDFN 101515 . 101983) (CD.COMMANDSELECTEDFN 101985 . 105485) ( +CD-MENUFN 105487 . 111662) (CDBROWSER-COPY 111664 . 115035) (CDBROWSER-DELETE-FILE 115037 . 118056) ( +CD-SWAPDIRS 118058 . 118575))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index 6fe1f45a31451dd3f5caf949c6468e25abf3f37e..09ed9544f877f1c925c6a0b267854564f63ca1e7 100644 GIT binary patch delta 4784 zcmai2|8HB>758)Kw?MPB1PWaTXI2XdlRdw$wnGJZwqNQ;Y(MwC=O$*9&|p)0gajq- z3aHxaHfW_um7s6h7j1)qgtQ@kXcIDtt`O}<{(wn{Up8$&PLsOdCT$b@+Pflxu0|Hx#xV&dHL(R@%Pu_Z_bX%+2nL}3CZDwRr5^GvtZyrXC8@ zi_$N`GrPYfeLuXin*u|oLb2xBRi84tK^3c#CnKv-+4OueGHf+fuQ5Ys?V?}u$k21- zTQ0U>s1VyKlcA-1BNcnC>IuI@hGJm1RrOul@=~4!PXSWSkmtB;Ak#C|eFdjlP)L)r z;j?>=+{4r{mwKe;!qa=c9;mtW_EaVlDNzlE%&kt9EVF32r0N*?^jdw*kS1|_Jq)LrScRuiPcH3>q9;HfGZ zN=$cN=`5Y4W@n}Ke0O=}RUSF3i7?owOT+6Q?Q_qCUke@&WSX_BMQ4_#Nr7QyOU6j$ zBfJxHeBLUvNnH%ttU-RGW=&B1-_q{bU1mHkZQNx_3-RVMyIg*^KRwB#V)MXg%xs=z z)3@HcE+sczJP&$!>_5e(4`6<+y6Jjtzs@(G4F4P)IeL)4{JHSqiw^}o?DcyiCBKb+*JOZly?4UmCi?aE;lulPaX9H;n<9)ixn>ccK=A8J zyIxs}-{eTQ!yRI_z4YalZ4uaq;U9l+?|$iLe8a7^S$E?Qn|VMw4=7>a09N?-iw_?0 zxl#8Bb0&KSTbtYT#O^>kbm!gN(SwGx`6=psh_Nq(F&}IJKmPxZHvk&MB45Sc6i~m; zPw~Os%;amY^?={r9GG7a!f!{D9e%)T<(~9AJ?XYsQ12-I4fAX)fRUdNjbPT61~HYE$(l1OcGVK3qvv#Tt+F8W zz_m`;PL=d5h{~>dbr&b%sjDO3LHM?x^el^X)ECBLrcb(@-rgT=*K)>=?HbsNahFOO zBP}p(DFW71c^fz&jS;9o)@1E=@29dy-q3Pl5rJC&O0;(F(NQq*)9ynbJh-GLw*J)2}yo_+*b z#r1hnG>{ChY~4y^j|{5^FD1w5bk3#QZVQ*i!!cmdnJPLqEJC=V(4l^3!2Pa$qJ-E~ zG`di1Ew;KXGRtL3K5+q2iTf0*2okO9w#MO<%h)A3}0 zDyc+phKiV3e)-j7bUcYl*aJ%=p7|_P=6%7ft96VPmb-1zRpeExMOs$n zVj2wLN;P<&i>-9dw!5Te5vzbvvq4X}ib}>M7F#cLNkOq^0!k()0F*Q;4^o0;B%b4! zP+a9KDi8~JG*T?|aj7yu*d-%*izKH7MlOOtQ{g#vw_rgnPV~~tXI5Gh_YIGep3!JL zozf|pNy`(+7bAS@(%3!dkJ#)4X+}D{eraq-Q_@(tcSOypVr7_AL&MU2$Kbhyv$Xgs zEibj`h0bCtK?<6LK2$}|gkzVF?nfMR)M1hhB`jX1L+HY|q^v+!MyGTN4_OZ{T>f^j zgBvD`+2QdTPDZZf)yqEBC`YUfLL}zRB3`r68Bf7MHOf%Y@_f!^HPmZy{ODEZYj$}GhNetT z%vY~V>J+b1oZKHh@a}L)l0Gg;ap{K1%lT($A-)rrZqCFp_@q5Qy2&Ny4{o;S$2Rk# zCcINAe{%CF`^Lw;wX*bSMVcS!RqpDCTeTatqCM&y1e|nh?cu1hw?%ux%auU9dOh|_ z0nY85AKfTMvd+i{Rr@I}3I$az-sVqdgcmBYVQlT0=!~LoaK^69F{vOXgsWV3`{;bv zfB(7mt1XkN+-5%CXV`n!zkIDd8VU7@h`z)bLyc3T78l%#7B`}072MB=E9fz}icB!Q znL6ql!V>8$=v&F^0|cia?pScJ9&_5Z%0*HPoe&b3Ll~f(*3808PXY{zB+sWr!A#k{ zRUw5}omzv3m=b^v2X@G)WQAhVn>A|)AP*VLin3+8vq)jlZf@(A(Z~0UmQkVys2F-g zv69osc_HmibG(u550SS3}!hk2*iAVtfv$!Rf* z922wfT~CzNhOM!l0Z>k+Cn#fV5hxue+=y@H%a-krF^{m12c9EPj-EUhnwK636p&bg zI;*s_+@)^2MN6&ot<^4lueGw;SzbyJxvevcpp)l8yiY<@fddj?;SN6gy33f5(Mu%! zGb?9XU5%R#;E)*X@VBoozhjF4_moJu@43 zN2Z zRojP8-@JCU`p75OuC$S%3aimpnY)VBF3WWtR=Wbm;Ue16Y05~w!BjzkjnY(RUDH5X z%J?GOk$Jf+74ZR&n6?Pz3G$4h(GU!v8mt`=2_A?H=Q*=8Nm!io;Fr-g14n$jBIaEt#J(`9;3?`S#T>#0qbY^7|K5KE;D;bc)}@Moaq*6Pxu wU0P_J?JUvx4mz;J`tL6PXqQfX>CC?>?ws9yWIRFRVfsoMe-(J{$`6PB2mKms#{d8T delta 2638 zcmaJ@O>7fK6tjJ{DH}O)(>+Y_d1kuvan8a$ZLmC8J zx>Tx)R3epj1wuX1N|k!5nnbBo3Dt-8(p!(^(n@gZjVq`2&8*|tgp$K%cHVs7``I_& z^LJ~J$KOQmOb${#c6O#3qY|YcNlA$%75&Q(FC0+y5r|TC%Sc(0>D>6_&39V&EU2Aw^2^Dum=<%$P${02<&0p-<7g06;O3z+hl{N!q z3flxR6%5<9@GNDJF>Q>=vZwQ@2?H3RfzAJ|=iP{^`$u~p999*GLb*81TFau4J*IxKi-zj2bz&7Z50QGdldGIO-S@%<(jK`!C%MHC{!Vrl;1!Tv765`Iz-8on+Z z2K|c+#nR5e{;PlH=HS2&o9t6{XJa4V+P6}TJPdZ*y!p3p9ynAKei{tc7S?TGWB-r! zN-fyX(+0MgU8(M@opRTbJi=<%b>tD=+d>fa=QX?hZ?k4WwxI{xlU)tn-VE?$-I?=v z+Vk!!{GW(qcQ|a`6U8xC8faI%3TsfXJwJ|%2%fGbgWAtKFC}oc5q#Rq9Zt>Ko}kUz z;@_^&u*Og=tP;usUUiKoAf2Dkq@eq0lhY6x!s#i`T}1*LRBpeYJ5Yi9o9uC@9jcI0bdW zm`Y8Uc_WY*MUlZaa)H|0#<*$aL6JQP&YO9sXk(7zZptW~I1NlU<`@RZD4vbvWR-2h z%d-AFoCK1|K*m^G17ZoKg_v=L#;SQ(Hl`-FF*A&|JupUPp>|9tS}QX}J?DbSfTD`G zS+FS0WMU=5b}(xPXhYW#;K}V#QWWyEHBm^}hHFf@K&iSFTfuTnm)DJw=c6OqW-UusBKL;sO1Eey7en~oQ~j#Z%-D-!I(K^0}g|B0~Vp#k@1XWxbCH@Zl#6vD2VX5B1e5;DX|O8*@QM&rZ2~3@+A|=Rr>B z{0#@0DvrrG%EU3I%fYdw%G~@i4hh}IYHK9Qi z6RP0PoaGu0FdW6);Hj8Wn?b=|j#|})8&Ip3;ZkLx9PI;zF&LKO3dA&tjDU;{6XlJ6 ztx}z>U4u)tC8U(mH9v%Qy!O$2O`y5E#idGh8ONa}KMy-8W~mn7`mkpcF9Om80^4K4 z?qvQSpAGHA`x7`NIQhf3V1FO}3RCzVp%@BYASsS15$Y#yomhYP#V1{zBQV_OFWr^= NmHUU*f4Mu?@gHU2dd&a; diff --git a/lispusers/COMPAREDIRECTORIES.TEDIT b/lispusers/COMPAREDIRECTORIES.TEDIT index 8915d21d..24d80a71 100644 --- a/lispusers/COMPAREDIRECTORIES.TEDIT +++ b/lispusers/COMPAREDIRECTORIES.TEDIT @@ -17,7 +17,7 @@ Produces the CDPRINT output in a read-only TEDIT window, with TITLE if given. 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. (CDMERGE CDVALUES) [Function] Merges all subsets of CDVALUES that have the same CDSELECT into a single CDVALUE with the union of their CDENTRIES. The CDCOMPAREDATE of the merger will be the latest of the dates, and the directories and match names will be adjusted to reflect the original subdirectory sources. - (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) + (CDMAP CDVALUE FN) [Function] (CDSUBSET CDVALUE FN) [Function] CDMAP and CDSUBSET both apply FN to each CDENTRY in CDVALUE, perhaps modifying the information in the entry. CDSUBSET returns a new cdvalue structure whose entries are the subset of the entries (perhaps modified) for which FN is non-NIL. 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 @@ -32,10 +32,10 @@ Merges all subsets of CDVALUES that have the same CDSELECT into a single CDVALUE H  c   ' .   $ D( o*&m{ˆ = ~ ?  <G@ L]  .   .. @@ * m   Ì H= 8k' / ^ '    -! ( Ì O"   F4A'+c& +! ( Ì O"3A _A'+c& !<† \ T=| Z  .z=: %< &AI† %A64)* D@& ÀK < Ü ß  ! &/65; -$7Ù".9' § .š -  G "  5¥czº \ No newline at end of file +$7Ù".9' § .š -  G "  5Úazº \ No newline at end of file diff --git a/lispusers/COMPARETEXT.LCOM b/lispusers/COMPARETEXT.LCOM index fe3e6ec16d86b3a74a40bdf648419869a06f192e..69290287b54054cbaf2639c6eb7df38c7412e262 100644 GIT binary patch delta 843 zcmZuvO>fgc5Uq_Gl^_sEMdJ8a5NZU8yz7r7KGjW}#Knz`5{Zh|htbZPH~Zd>=X~p9`$M$M%lTTen-_`@;KEe6 zsp+TtTle%F7%yF@8Kzb?xj6m#AdZ}7)r-&{g4Noti;KKMp}^3ICrRhZ{xZvDS89%H zR|4A#?JAM3Fp$QQlhL6WTuDDmcsvu#!Sn-r)A8D^e3hF26DXRBZi;kAT9>r5y8K&8 z-z|364Mc0BaVHt0h9atV&1$=0&1;4^NY#wIaBX#OfxhfCNOztsu3n#>wg>X&`MNAi zKVDFjrGXsXN(-4sOV;1=7c+gCc_`gYKV`n3++J8wg@U>r`hmCMhx6&ET!r7BXH@Ya z${e#|VAmb52~pB6wTWU8v)M!tMS+UftXLt0VW8FU+HSQ;2{%v=EWcp~ey~F~^HS*_ zFwKcQZ{(UlV7s#`=ek_*OITUJ_gYR!zI>3c8P$iTr(c)yCyI&<>v_xBwjp#Ckrz}U z)Dm2$NeJzZZv_?^<7il|Mj_ntZE~f;a@|U!-F(^tS9OF_Z>oa8sW(D!#h4)qhilhD z=$LMXYpvOCi`Il5t$-cT-(x2bngKTG4--bZ1RuoXcyAmZ^e9(!Fudx$8SWoGK`%b+ z(emvc6DAa5j)sF{bo$+HGERmQ242>{;=zDUG;4;#-sq@5+yl!JAixNp>SENT!0EB9 fGP?Pi^b$;xw-Z|6^jmH@jkCYxUgyla@&5iFhm6zc delta 1347 zcmZuwPi)&%9FDWC?Sh0l35g`~7?G_kG`cKXjgTzfIl{N@c${ zsc?mJC`LmO4UIqkyt~79A@ka0j*Esc8k+I=ulGKS?W5SgyN}TXa;xLIxLR1PR%P^i zXKDYH4OFF}sPb;9+;UvI8QNxSTaf>6g2jEw+2BxhRa^Wdp|U!07mXmaKXLp{RI#X= zPN-jw$n*x|4WVSsl5%br|CQ#Zq9_~J6a$QB!^&>lh zUV|UlUJ^i8*0CC2$21j5EA$Vo2&#b$b`%p)hfo#l*{kt8ksSu19}w@)t2u$YtY%_a zUCq$0%ZYfQq3OGPEnq$K*qYo@d2##tR|h(hyVF@eouP#~EW2fP+_>d?@h+sVH;aX9 zSBQ{q^)~M0aPN(a$?MPdi$&?rPstV~^0ycNT>oHenCG9~U%YkW{o5ZcDau0^%k{6* zjAbw9{K8vi79ZdEZJtY!o7b`mXS+}qx`w5Mre)<62+hc#()uu1t1C2)ptJIpRf1&B zr4Q{r$M+z3&d`f(tcK;SOduGW6FFYfj3E>aQQPmhmKTF-8umgnXs;#U`injluliV> zA++7)maB7FEz^nAbHGSz`g;sa<*#61;(#`CZ8J>3X!@5iGJ3BsZ*B+#e&oaiFhE_S ze1gAK(tT&wXPL9b})y0pSJ99zd>16x}{n22M&eF*l<%EFT8;@y4 zy2&^_o<1B+hLB4XV31|7>>(gGcCL mmJUbL2?o;{&W=+&$XiOIQ;Ov?o$qX2lZvC`^LK83^X`A|WklBi diff --git a/lispusers/EXAMINEDEFS b/lispusers/EXAMINEDEFS index 93bf4a15..b24513ad 100644 --- a/lispusers/EXAMINEDEFS +++ b/lispusers/EXAMINEDEFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Jan-2022 23:36:31"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;32 11715 +(FILECREATED " 1-Feb-2022 23:15:24"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36 11920 - :CHANGES-TO (FNS TEDITDEF) + :CHANGES-TO (FNS EXAMINEFILES) - :PREVIOUS-DATE "25-Jan-2022 10:20:31" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31) + :PREVIOUS-DATE " 1-Feb-2022 15:43:17" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;35) (PRETTYCOMPRINT EXAMINEDEFSCOMS) @@ -19,7 +19,8 @@ (DEFINEQ (EXAMINEDEFS - [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 23-Jan-2022 17:40 by rmk") + [LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 15:42 by rmk") + (* ; "Edited 23-Jan-2022 17:40 by rmk") (* ; "Edited 18-Jan-2022 22:40 by rmk") (* ; "Edited 12-Jan-2022 17:29 by rmk") (* ; "Edited 24-Dec-2021 22:39 by rmk") @@ -54,11 +55,9 @@ ELSEIF (GETDEF NAME TYPE SOURCE2) ELSE (ERROR NAME " not found on " SOURCE2))) (CL:UNLESS TITLE1 - (SETQ TITLE1 (OR (AND SOURCE1 (LITATOM SOURCE1)) - "File 1"))) + (SETQ TITLE1 (OR SOURCE1 "File 1"))) (CL:UNLESS TITLE2 - (SETQ TITLE2 (OR (AND SOURCE2 (LITATOM SOURCE2)) - "File 2"))) + (SETQ TITLE2 (OR SOURCE2 "File 2"))) (SELECTQ (EDITMODE) (SEDIT:SEDIT (* ;; @@ -136,28 +135,29 @@ (EDITE DEF2]) (EXAMINEFILES - [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Jan-2022 10:08 by rmk") + [LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 1-Feb-2022 23:15 by rmk") + (* ; "Edited 25-Jan-2022 10:08 by rmk") (* ; "Edited 2-Jan-2022 23:15 by rmk") (* ; "Edited 30-Dec-2021 21:49 by rmk") - (* ;; "We get a region, then split it in half. Should we attach or at least co-move and co-close the 2 windows?") + (* ;; "We get a region, then split it in half. ") (CL:UNLESS REGION (SETQ REGION (GETREGION))) - (LIST (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]) + (LIST (AND FILE1 (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1) + REGION + 'RIGHT + 'TOP + `(,REGION 0.5) + (FETCH (REGION TOP) OF REGION)) + NIL TITLE1)) + (AND FILE2 (TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1) + REGION + 'LEFT + 'TOP + `(,REGION 0.5) + (FETCH (REGION TOP) OF REGION)) + NIL TITLE2]) (TEDITDEF [LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk") @@ -199,6 +199,6 @@ (FILESLOAD (SYSLOAD) COMPARETEXT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (658 11573 (EXAMINEDEFS 668 . 8787) (EXAMINEFILES 8789 . 9984) (TEDITDEF 9986 . 11571))) -)) + (FILEMAP (NIL (662 11778 (EXAMINEDEFS 672 . 8792) (EXAMINEFILES 8794 . 10189) (TEDITDEF 10191 . 11776) +)))) STOP diff --git a/lispusers/EXAMINEDEFS.LCOM b/lispusers/EXAMINEDEFS.LCOM index 47d81119c2221e076750f03855268925b2aa3ae1..143f98482c5d83875201d71d25654a2208af5cbe 100644 GIT binary patch delta 1121 zcmZuwO>fgc5GAywX+R)EC6GX66oiyWBzSkd{yLz#_Bt_gY|C~?EA`TnAXQLWwHzvX z$S**mvcv&?08&pt=^1h3z?BOp_zC?3h;i(Q6!5{GdAsv=-uUgw!pXwR-aL?oGgxm> ziBh1pO#oTbtV(PX>J$>}~Jt-Znrin;q8|j_ZjS zHl9M&>3SYa5;U95D)iT$VbTAHm1@0G%gU`tn2ES*|Fvt}+J4(pfDoNZU|4O_Z;7~( z1WJ$%llui)0vs?LoR`^T|7{c<#EJR zh}%Kev;71VqCiU|J=eE`UN;s|7zH74U4gJ$pgE#SUmG6jFLk)sZ_&I$HvdY00UK1%T5o3-`jn+eu8AHNw1!T&LfJm_F`f)cBc|9;) z{|6z^32YG+M*!1gFq6cz+M^n|2Mjxnv-S+s*%&i%y#Pl`z?e3c!$|t`+`LNIsSQ-k z+8gO5I>|;BiIyAqKr{|{7y@Bhx;pC&2^m`uM-l^9wbQvwz(aq6tWhNWGgPMPaK9TT zuCoG6l_7Fl?F5+2z$i{*Q~|>`I|3+@j!~+R0wvgH+{n}d!LnR;AyEgkCHfjT*U*1! zyZGXqrhfU_G}@$=zA0b7jFX^Ga z_R(@P_Sj{qv>RN@PE{#Ca(jE&jKKI9AAME{pg_bWBNDM&J`&D delta 1166 zcmZuwJ#Q0P6vc#95;q`)0wf4WmXK^|?Va~EUlqg5b3EY8jAq6pNHm5RDS}|+fJEml zx7cFQNEEvTB`wI>cIgluJr#dorR5Lo?w#?F5QGc+e!P3$IoIcX-u%4z+s=7zcW;az zb-BSgxNwE(3ikZL?wohf;^xVo<0_|x=H1!k-t^${{=>;0CeI$v4zIe%br9x(?qmNE zTK&;*h_8oxym+&?^3J3hu(S?ykMniw*yUU)C1yR*c5_V!dp<`S;i2zcU}_rbM{` z4O7`i5koeJN5de>VG09VI^PMSAl?~eI!)3zfyoRcqq+8pZwD^q@S= zY_wB`YM}Ui?cyby9e0_O^cLxvg15l9EIzEgKKGPN`$O<*tu!yW`daaR{m0_3^;Pkaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;37 56734 +(FILECREATED "19-Feb-2022 10:22:09" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;58 58648 :CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY GIT-COMPARE-BRANCHES) - :PREVIOUS-DATE "28-Jan-2022 12:12:30" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;36) + :PREVIOUS-DATE "13-Feb-2022 21:27:07" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;57) (PRETTYCOMPRINT GITFNSCOMS) @@ -23,10 +23,11 @@ (MYMEDLEYHOST 'MM) (GITMEDLEYHOST 'GIT)) (INITVARS (GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) - (GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2)) + (GIT-IGNORE-DIRECTORIES '(loadups patches tmp fontsold deleted clos cltl2)) (GIT-MERGE-COMPARES T)) (P (PSEUDOHOST MYMEDLEYHOST MEDLEYDIR) (PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR)) + (FNS GIT-CLONEP) (* ;; "") @@ -40,12 +41,10 @@ (* ;; "File correspondents") + (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS) (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES) - (FNS MEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST) + (FNS MEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME) (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME) - (FNS MEDLEYSUBDIRS GITSUBDIRS) - (VARS (MEDLEYSUBDIRS (MEDLEYSUBDIRS)) - (GITSUBDIRS (GITSUBDIRS))) (* ;; "") @@ -53,7 +52,7 @@ (* ;; "Git commands") (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-BRANCH-DIFF GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? - GIT-REMOTE-UPDATE GIT-FILE-DATE) + GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE) (* ;; "") @@ -106,13 +105,37 @@ (RPAQ? GIT-IGNORE-FILES '(EXPORTS.ALL RDSYS RDSYS.LCOM)) -(RPAQ? GIT-IGNORE-DIRECTORIES '(LOADUPS PATCHES TMP FONTSOLD DELETED CLOS CLTL2)) +(RPAQ? GIT-IGNORE-DIRECTORIES '(loadups patches tmp fontsold deleted clos cltl2)) (RPAQ? GIT-MERGE-COMPARES T) (PSEUDOHOST MYMEDLEYHOST MEDLEYDIR) (PSEUDOHOST GITMEDLEYHOST GITMEDLEYDIR) +(DEFINEQ + +(GIT-CLONEP + [LAMBDA (HOST/DIR NOERROR) (* ; "Edited 5-Feb-2022 11:35 by rmk") + + (* ;; + "Returns the canonical git pseudohost for HOST/DIR, NIL if it doesn't denote a git clone. ") + + (CL:UNLESS HOST/DIR + (SETQ HOST/DIR '{GIT})) + (CL:UNLESS (EQ (CHARCODE {) + (CHCON1 HOST/DIR)) + (SETQ HOST/DIR (CONCAT "{" HOST/DIR "}"))) + (SETQ HOST/DIR (TRUEFILENAME HOST/DIR)) + (CL:UNLESS (MEMB (NTHCHARCODE HOST/DIR -1) + (CHARCODE (/ > < }))) + (SETQ HOST/DIR (CONCAT HOST/DIR "/"))) + (IF (DIRECTORYNAMEP (CONCAT HOST/DIR ".git/")) + THEN (PSEUDOFILENAME HOST/DIR) + ELSEIF NOERROR + THEN NIL + ELSE (ERROR (PSEUDOFILENAME HOST/DIR) + "is not a git clone"]) +) @@ -167,16 +190,56 @@ (DEFINEQ +(ALLSUBDIRS + [LAMBDA (HOST1 HOST2) + + (* ;; + "Edited 4-Feb-2022 17:57 by rmk: the union of the subdirectories that exist under all the hosts") + + (* ;; "Returns the union of the subdirectories that exist under all the hosts") + + (LET ((HOSTS (MKLIST HOST1)) + VAL) + (CL:WHEN HOST2 (PUSHNEW HOSTS HOST2)) + (CL:UNLESS HOSTS + (SETQ HOSTS (LIST MYMEDLEYHOST GITMEDLEYHOST))) + (SORT (FOR H VAL IN HOSTS + JOIN (FOR F IN (FILDIR (PACKFILENAME 'HOST H 'BODY '*)) WHEN (DIRECTORYNAMEP F) + UNLESS (OR [EQ (CHARCODE %.) + (CHCON1 (SETQ D (FILENAMEFIELD F 'DIRECTORY] + (THEREIS SKIP IN GIT-IGNORE-DIRECTORIES + SUCHTHAT (STRPOS SKIP D 1 NIL T NIL FILEDIRCASEARRAY))) + DO (SETQ D (UNSLASHIT (L-CASE D))) + (CL:UNLESS (MEMBER D VAL) + (PUSH VAL D))) FINALLY (RETURN VAL]) + +(MEDLEYSUBDIRS + [LAMBDA (MEDLEYHOST ALLSUBDIRS) (* ; "Edited 4-Feb-2022 18:06 by rmk") + (CL:UNLESS MEDLEYHOST (SETQ MEDLEYHOST MYMEDLEYHOST)) + (FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS)) COLLECT (UNSLASHIT (PACKFILENAME 'HOST MEDLEYHOST + 'DIRECTORY D) + T]) + +(GITSUBDIRS + [LAMBDA (GITHOST ALLSUBDIRS) (* ; "Edited 4-Feb-2022 18:06 by rmk") + (CL:UNLESS GITHOST (SETQ GITHOST GITMEDLEYHOST)) + (FOR D IN (OR ALLSUBDIRS (ALLSUBDIRS)) COLLECT (SLASHIT (PACKFILENAME 'HOST GITHOST 'DIRECTORY D) + T]) +) +(DEFINEQ + (TOGIT - [LAMBDA (MFILES) (* ; "Edited 19-Jan-2022 23:35 by rmk") + [LAMBDA (MFILES) (* ; "Edited 4-Feb-2022 18:08 by rmk") + (* ; "Edited 2-Feb-2022 18:56 by rmk") + (* ; "Edited 19-Jan-2022 23:35 by rmk") (* ; "Edited 18-Jan-2022 16:33 by rmk") (* ; "Edited 13-Jan-2022 15:47 by rmk") (* ;; "Copies MFILES to {GIT}. We do a sanity check to make sure particular MFILE is the latest version--we may have created another one without revising the directory browser.") - (CL:WHEN (EQ 'master (GIT-WHICH-BRANCH)) + (CL:WHEN (STRPOS "master" (GIT-WHICH-BRANCH)) (ERROR "Can't copy to the master branch")) - (FOR MF GF DEST INSIDE MFILES COLLECT (SETQ MF (OR (FINDFILE MF NIL MEDLEYSUBDIRS) + (FOR MF GF DEST INSIDE MFILES COLLECT (SETQ MF (OR (FINDFILE MF NIL (MEDLEYSUBDIRS)) (ERROR "FILE NOT FOUND" MF))) (CL:UNLESS (STRING.EQUAL MF (INFILEP (PACKFILENAME 'VERSION NIL @@ -195,8 +258,9 @@ DEST]) (FROMGIT - [LAMBDA (GFILES) (* ; "Edited 18-Jan-2022 16:31 by rmk") - (FOR GF MF DEST INSIDE GFILES COLLECT (SETQ GF (OR (FINDFILE GF NIL GITSUBDIRS) + [LAMBDA (GFILES) (* ; "Edited 4-Feb-2022 18:08 by rmk") + (* ; "Edited 18-Jan-2022 16:31 by rmk") + (FOR GF MF DEST INSIDE GFILES COLLECT (SETQ GF (OR (FINDFILE GF NIL (GITSUBDIRS)) (ERROR "FILE NOT FOUND" GF))) (SETQ MF (MFILE4GFILE GF)) (PRIN3 (IF (SETQ DEST (COPYFILE GF MF)) @@ -276,27 +340,35 @@ (CL:IF POS (SUBSTRING NAME (ADD1 POS)) NAME)]) + +(STRIPNAME + [LAMBDA (FILE) + + (* ;; "Edited 5-Feb-2022 08:38 by rmk: the name/ext/version of FILE without disturbing host or directory. Strips everything after last / >") + + (* ;; "Removes the name/ext/version of FILE without disturbing host or directory. Strips everything after last / >") + + (FOR I LASTDIRPOS FROM 1 DO (SELCHARQ (NTHCHARCODE FILE I) + ((> < /) + (SETQ LASTDIRPOS I)) + (NIL (RETURN (CL:IF LASTDIRPOS + (SUBSTRING FILE 1 LASTDIRPOS) + FILE))) + NIL]) ) (DEFINEQ (GFILE4MFILE - [LAMBDA (MFILE) (* ; "Edited 18-Jan-2022 15:24 by rmk") - (SETQ MFILE (OR (FINDFILE MFILE NIL MEDLEYSUBDIRS) - (ERROR "FILE NOT FOUND" MFILE))) - (SLASHIT [IF (EQ MYMEDLEYHOST (FILENAMEFIELD MFILE 'HOST)) - THEN (PACKFILENAME 'HOST GITMEDLEYHOST 'VERSION NIL 'BODY MFILE) - ELSE (PACKFILENAME 'VERSION NIL 'BODY (CONCAT GITMEDLEYDIR (SUBSTRING - MFILE - (ADD1 (NCHARS MEDLEYDIR] + [LAMBDA (MFILE GITHOST) (* ; "Edited 4-Feb-2022 18:04 by rmk") + (SLASHIT (PACKFILENAME 'HOST (OR GITHOST GITMEDLEYHOST) + 'VERSION NIL 'BODY MFILE) T]) (MFILE4GFILE - [LAMBDA (GFILE) (* ; "Edited 18-Jan-2022 15:24 by rmk") - (UNSLASHIT (IF (EQ GITMEDLEYHOST (FILENAMEFIELD GFILE 'HOST)) - THEN (PACKFILENAME 'HOST MYMEDLEYHOST 'VERSION NIL 'BODY GFILE) - ELSE (PACKFILENAME 'VERSION NIL 'BODY (CONCAT MEDLEYDIR (SUBSTRING - GFILE - (ADD1 (NCHARS GITMEDLEYDIR]) + [LAMBDA (GFILE MHOST) (* ; "Edited 4-Feb-2022 18:04 by rmk") + (* ; "Edited 18-Jan-2022 15:24 by rmk") + (UNSLASHIT (PACKFILENAME 'HOST (OR MHOST MYMEDLEYHOST) + 'VERSION NIL 'BODY GFILE]) (GIT-REPO-FILENAME [LAMBDA (GFILE) (* ; "Edited 18-Jan-2022 15:42 by rmk") @@ -312,41 +384,6 @@ (SETQ GFILE (SUBSTRING GFILE 1 -2))) GFILE]) ) -(DEFINEQ - -(MEDLEYSUBDIRS - [LAMBDA NIL (* ; "Edited 26-Jan-2022 14:52 by rmk") - (* ; "Edited 24-Jan-2022 17:28 by rmk") - (* ; "Edited 18-Jan-2022 15:34 by rmk") - (* ; "Edited 13-Jan-2022 20:16 by rmk") - (FOR F IN (FILDIR (PACKFILENAME 'HOST MYMEDLEYHOST 'BODY '*)) WHEN (DIRECTORYNAMEP F) - UNLESS (THEREIS SKIP IN GIT-IGNORE-DIRECTORIES SUCHTHAT (STRPOS SKIP (FILENAMEFIELD - F - 'DIRECTORY) - 1 NIL T NIL FILEDIRCASEARRAY)) - COLLECT (UNSLASHIT F T]) - -(GITSUBDIRS - [LAMBDA NIL (* ; "Edited 26-Jan-2022 15:12 by rmk") - (* ; "Edited 18-Jan-2022 14:57 by rmk") - (* ; "Edited 13-Jan-2022 16:08 by rmk") - (* ; "Edited 3-Jan-2022 11:12 by rmk") - (* ; "Edited 30-Oct-2021 23:28 by rmk:") - - (* ;; "We drive this with MEDLEYSUBDIRS instead of {GIT}* because GIT has lots of things that we don't want to see (.git directories, cltl2, rooms, etc...)") - - (FOR D IN MEDLEYSUBDIRS COLLECT (IF (EQ MYMEDLEYHOST (FILENAMEFIELD D 'HOST)) - THEN (SLASHIT (PACKFILENAME 'HOST GITMEDLEYHOST 'BODY D) - T) - ELSE (SLASHIT (CONCAT GITMEDLEYDIR - (L-CASE (SUBSTRING D (ADD1 (NCHARS - MEDLEYDIR - ]) -) - -(RPAQ MEDLEYSUBDIRS (MEDLEYSUBDIRS)) - -(RPAQ GITSUBDIRS (GITSUBDIRS)) @@ -413,36 +450,37 @@ (GIT-ADD-WORKTREE "master" T]) (GIT-GET-FILE - [LAMBDA (BRANCH GITFILE MEDLEYFILE) (* ; "Edited 3-Jan-2022 23:52 by rmk") - (* ; "Edited 20-Nov-2021 20:28 by rmk:") + [LAMBDA (BRANCH GITFILE LOCALFILE) (* ; "Edited 12-Feb-2022 18:06 by rmk") + (* ; "Edited 3-Jan-2022 23:52 by rmk") + (* ; "Edited 20-Nov-2021 20:28 by rmk:") - (* ;; "If GITFILE in BRANCH exists, it is copied to MEDLEYFILE and MEDLEYFILE is returned. If it doesn't exist, return value is NIL. Maybe it should cause a FILENOTFOUND error?") + (* ;; "If GITFILE in (remote) BRANCH exists, it is copied to LOCALFILE and LOCALFILE is returned. If it doesn't exist, return value is NIL. Maybe it should cause a FILENOTFOUND error?") (CL:WHEN (GIT-FILE-EXISTS? BRANCH GITFILE) - (CL:WITH-OPEN-FILE (STREAM (OR MEDLEYFILE '{NODIRCORE) + (CL:WITH-OPEN-FILE (STREAM (OR LOCALFILE '{NODIRCORE) :IF-EXISTS :NEW-VERSION :DIRECTION :IO) (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) "git show " BRANCH ":" GITFILE)) ) (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) (BIND C WHILE (SETQ C (\BIN s)) DO (\BOUT STREAM C))) - (SETFILEINFO STREAM 'CREATIONDATE (GIT-FILE-DATE GITFILE BRANCH)) + (SETFILEINFO STREAM 'CREATIONDATE (OR (FILEDATE STREAM T) + (FILEDATE STREAM) + (GIT-FILE-DATE GITFILE BRANCH))) STREAM))]) (GIT-FILE-EXISTS? - [LAMBDA (BRANCH GITFILE) (* ; "Edited 10-Dec-2021 21:30 by rmk") + [LAMBDA (BRANCH GITFILE) (* ; "Edited 10-Feb-2022 20:55 by rmk") + (* ; "Edited 10-Dec-2021 21:30 by rmk") - (* ;; "T if GITFILE exists on BRANCH") + (* ;; "T if GITFILE exists on BRANCH. If s is EOFP, the file exists but is empty") - (CL:WITH-OPEN-FILE (STREAM '{NODIRCORE :DIRECTION :IO) - (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) - "git show " BRANCH ":" GITFILE))) - (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) - (LET ((LINE (CL:READ-LINE s))) - (NOT (OR (STREQUAL LINE (CONCAT "fatal: path '" GITFILE - "' does not exist in '" BRANCH "'")) - (STREQUAL LINE (CONCAT "fatal: path '" GITFILE - "' exists on disk, but not in '" BRANCH "'"]) + (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM (CONCAT (CDGITDIR) + "git show " BRANCH ":" GITFILE))) + (SETFILEINFO s 'ENDOFSTREAMOP (FUNCTION NILL)) + (NOT (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE "fatal: path '" I)) + ALWAYS (EQ (BIN s) + C]) (GIT-REMOTE-UPDATE [LAMBDA (DOIT) (* ; "Edited 16-Dec-2021 10:45 by rmk") @@ -462,6 +500,14 @@ (PROG1 (GIT-COMMAND "git remote update origin") (SETQ LAST-REMOTE-UPDATE-IDATE (IDATE))))]) +(GIT-REMOTE-ADD + [LAMBDA (NAME URL) (* ; "Edited 31-Jan-2022 13:53 by rmk") + (LET [(RESULT (GIT-COMMAND (CONCAT "git remote add " NAME " " URL] + + (* ;; "Does it return an error line? What if URL is not good? ") + + (CAR RESULT]) + (GIT-FILE-DATE [LAMBDA (GFILE BRANCH) (* ; "Edited 3-Jan-2022 19:43 by rmk") (LET [(DATE (CAR (GIT-COMMAND (CONCAT "git log -1 --pretty=%"format:%%cD%" " @@ -702,7 +748,8 @@ (DEFINEQ (GIT-GET-DIFFERENT-FILES - [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 23-Jan-2022 21:45 by rmk") + [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2) (* ; "Edited 12-Feb-2022 18:35 by rmk") + (* ; "Edited 23-Jan-2022 21:45 by rmk") (* ; "Edited 11-Jan-2022 11:03 by rmk") (* ; "Edited 5-Jan-2022 08:01 by rmk") @@ -711,43 +758,36 @@ (SETQ BRANCH1 (GIT-BRANCH-EXISTS? BRANCH1)) (SETQ BRANCH2 (GIT-BRANCH-EXISTS? BRANCH2)) (LET ([MERGE (CAR (GIT-COMMAND (CONCAT "git merge-base " BRANCH1 " " BRANCH2] - (DATE (DATE)) DIFFS) (SETQ DIFFS (GIT-BRANCH-DIFF BRANCH1 MERGE)) (CL:WHEN DIFFS - (PSEUDOHOST 'FROMGIT (CONCAT "{core}" DATE ">")) + (PSEUDOHOST 'FROMGIT (CONCAT "{CORE}" (DATE) + ">")) + + (* ;; "UNSLASHIT because CORE doesn't know about slash") + (CL:UNLESS DIR1 - (SETQ DIR1 (CONCAT "{FROMGIT}<" (UNSLASHIT BRANCH1) + (SETQ DIR1 (CONCAT "{FROMGIT}" (UNSLASHIT BRANCH1) ">"))) (CL:UNLESS DIR2 - (SETQ DIR2 (CONCAT "{FROMGIT}<" (UNSLASHIT BRANCH2) + (SETQ DIR2 (CONCAT "{FROMGIT}" (UNSLASHIT BRANCH2) ">"))) - [FOR GFILE MFILE IN DIFFS DO - (* ;; "Unslash because CORE doesn't know about /. ") - - (SETQ MFILE (UNSLASHIT (CONCAT DIR1 GFILE))) - (CL:WHEN (GIT-GET-FILE BRANCH1 GFILE MFILE) - (FIX-DIRECTORY-DATES (CONS MFILE))) - (SETQ MFILE (UNSLASHIT (CONCAT DIR2 GFILE))) - (CL:WHEN (GIT-GET-FILE MERGE GFILE MFILE) - (FIX-DIRECTORY-DATES (CONS MFILE)))] + (FOR GFILE IN DIFFS DO (GIT-GET-FILE BRANCH1 GFILE (CONCAT DIR1 GFILE)) + (GIT-GET-FILE MERGE GFILE (CONCAT DIR2 GFILE))) (LIST DIR1 DIR2))]) (GIT-COMPARE-BRANCHES - [LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 28-Jan-2022 23:58 by rmk") - (* ; "Edited 26-Jan-2022 13:42 by rmk") - (* ; "Edited 11-Jan-2022 11:10 by rmk") - (* ; "Edited 6-Jan-2022 13:05 by rmk") - (* ; "Edited 4-Jan-2022 22:52 by rmk") - (* ; "Edited 22-Dec-2021 16:14 by rmk") - (* ; "Edited 16-Dec-2021 11:18 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL) (* ; "Edited 19-Feb-2022 10:21 by rmk") + (* ; "Edited 13-Feb-2022 21:27 by rmk") + (* ; "Edited 2-Feb-2022 08:46 by rmk") + (* ; "Edited 28-Jan-2022 23:58 by rmk") (SETQ BRANCH1 (IF BRANCH1 THEN (GITORIGIN BRANCH1 LOCAL) ELSE (GIT-WHICH-BRANCH))) (SETQ BRANCH2 (GITORIGIN (OR BRANCH2 "master") LOCAL)) (PRINTOUT T "Comparing all subdirectories of " BRANCH1 " and " BRANCH2 T) - (LET (CDVALUE DIRS) + (LET (CDVALUE DIRS NENTRIES) (PRINTOUT T "Fetching differences" T) (SETQ DIRS (GIT-GET-DIFFERENT-FILES BRANCH1 BRANCH2)) (IF DIRS @@ -755,20 +795,32 @@ (SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) (CADR DIRS) '(> < ~= -* *-) - '*>*.*)) + '*>*.*)) + + (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading ;1's.") + + (* ;; + " Also, lower case the directories. Perhaps can be done when the files are fetched?") + + [CDMAP CDVALUE (FUNCTION (LAMBDA (CDE) + (DECLARE (USEDFREE INFO1 INFO2)) + (CL:WHEN INFO1 + (CHANGE (FETCH (CDINFO FULLNAME) OF INFO1) + (SLASHIT (CL:IF + (STRPOS ";1" DATUM -2 NIL T) + (SUBSTRING DATUM 1 -3) + DATUM) + T))) + (CL:WHEN INFO2 + (CHANGE (FETCH (CDINFO FULLNAME) OF INFO2) + (SLASHIT (CL:IF + (STRPOS ";1" DATUM -2 NIL T) + (SUBSTRING DATUM 1 -3) + DATUM) + T)))] (TERPRI T) (IF (FETCH (CDVALUE CDENTRIES) OF CDVALUE) - THEN - (* ;; - "Lower case the directories. Perhaps can be done when the files are gotten?") - - [FOR CDE INFO IN (FETCH (CDVALUE CDENTRIES) OF CDVALUE) - DO (CL:WHEN (SETQ INFO (FETCH INFO1 OF CDE)) - (CHANGE (FETCH (CDINFO FULLNAME) OF INFO) - (SLASHIT DATUM T))) - (CL:WHEN (SETQ INFO (FETCH INFO2 OF CDE)) - (CHANGE (FETCH (CDINFO FULLNAME) OF INFO) - (SLASHIT DATUM T)))] + THEN (SETQ LAST-BRANCH-CDVALUE CDVALUE) (CDBROWSER CDVALUE (CONCAT "Compare " BRANCH1 " and " BRANCH2 " " (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE)) " files") @@ -776,14 +828,18 @@ `(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2) NIL `(Compare See)) - ELSE "NO DIFFERENCES") - ELSE "NO DIFFERENCES"]) + (SETQ NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE))) + (LIST NENTRIES (CL:IF (EQ NENTRIES 1) + 'difference + 'differences)) + ELSE '(0 differences)) + ELSE '(0 differences]) (GIT-COMPARE-WITH-MYMEDLEY - [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE) + [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE HOST1 HOST2) (* ;; - "Edited 28-Jan-2022 23:57 by rmk: my medley subdirectories with the current local git branch.") + "Edited 19-Feb-2022 10:19 by rmk: my medley subdirectories with the current local git branch.") (* ;; "Compares my medley subdirectories with the current local git branch.") @@ -794,13 +850,14 @@ (SETQ SUBDIRS (L-CASE SUBDIRS)) (PRINTOUT T "Comparing " (SELECTQ SUBDIRS (nil (SETQ SUBDIRS '(sources library lispusers))) - (all (SETQ SUBDIRS MEDLEYSUBDIRS) + (all (SETQ SUBDIRS (ALLSUBDIRS HOST1 HOST2)) "ALL subdirectories") SUBDIRS) " of My Medley and " (GIT-WHICH-BRANCH) T) - (for SUBDIR TITLE CDVAL (BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS + (for SUBDIR TITLE CDVAL (NENTRIES _ 0) + (BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS collect (TERPRI T) (SETQ CDVAL (COMPAREDIRECTORIES (MEDLEYSUBDIR SUBDIR T) (GITSUBDIR SUBDIR T) @@ -822,26 +879,27 @@ GIT-MERGE-COMPARES) (SETQ $$VAL (CDMERGE $$VAL)) [SETQ SUBDIRS (CONCATLIST (FOR SUBDIR IN SUBDIRS COLLECT (CONCAT SUBDIR " "]) - (RETURN - (for CDVAL TITLE IN $$VAL as SUBDIR inside SUBDIRS - collect (SETQ TITLE (CONCAT "Compare My Medley and " BRANCH2 " " SUBDIR - " " (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) - " files")) - [if TEDIT - then [CDTEDIT CDVAL TITLE `("My Medley" ,BRANCH2] - else (CDBROWSER CDVAL TITLE `("My Medley" ,BRANCH2) - `(BRANCH1 "My Medley" BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN - GIT-CD-LABELFN) - NIL - `(Compare See "" (Copy% <- GIT-CD-MENUFN) - (|Delete ALL <-| GIT-CD-MENUFN) - ,@(CL:UNLESS (STRPOS "master" BRANCH2) - '("" (Copy% -> GIT-CD-MENUFN) - (Delete% -> GIT-CD-MENUFN)))] - (CONS (CONCAT SUBDIR "/") - (for CDENTRY in (fetch CDENTRIES of CDVAL) collect (fetch MATCHNAME - of CDENTRY))) - finally (TERPRI T]) + [for CDVAL TITLE IN $$VAL as SUBDIR inside SUBDIRS + do (SETQ TITLE (CONCAT "Compare My Medley and " BRANCH2 " " SUBDIR " " + (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) + " files")) + [if TEDIT + then [CDTEDIT CDVAL TITLE `("My Medley" ,BRANCH2] + else (CDBROWSER CDVAL TITLE `("My Medley" ,BRANCH2) + `(BRANCH1 "My Medley" BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN + GIT-CD-LABELFN) + NIL + `(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN) + ,@(CL:UNLESS (STRPOS "master" BRANCH2) + '("" Copy% -> (Delete% -> GIT-CD-MENUFN)))] + (CONS (CONCAT SUBDIR "/") + (for CDENTRY in (fetch CDENTRIES of CDVAL) collect (fetch MATCHNAME of CDENTRY))) + (ADD NENTRIES (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVAL] + (SETQ LAST-MYMEDLEY-CDVALUES $$VAL) + (TERPRI T) + (RETURN (LIST NENTRIES (CL:IF (EQ NENTRIES 1) + 'difference + 'differences)]) (GIT-COMPARE-WORKTREE [LAMBDA (BRANCH DONTUPDATE) (* ; "Edited 25-Nov-2021 08:49 by rmk:") @@ -1004,8 +1062,9 @@ (OR LABEL2 FILE2]) (GIT-CD-MENUFN - [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 19-Dec-2021 23:28 by rmk") - (* ; "Edited 16-Dec-2021 13:49 by rmk") + [LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 5-Feb-2022 17:36 by rmk") + (* ; "Edited 19-Dec-2021 23:28 by rmk") + (* ; "Edited 16-Dec-2021 13:49 by rmk") (* ; "Edited 10-Dec-2021 08:52 by rmk") (* ;; "MENUITEM is of the form (display-atom . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom") @@ -1013,10 +1072,6 @@ (DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY)) (SELECTQ (OR (CADDR MENUITEM) (CAR MENUITEM)) - (Copy% -> (CL:WHEN (CAR (TOGIT FILE1)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) - (Copy% <- (CL:WHEN (CAR (FROMGIT FILE2)) - (TB.DELETE.ITEM CDBROWSER TBITEM))) (Delete% -> (FLASHWINDOW PWINDOW) (IF FILE1 THEN (PRIN3 "Use 'Delete BOTH' instead") @@ -1058,14 +1113,15 @@ (DEFINEQ (CDGITDIR - [LAMBDA NIL (* ; "Edited 18-Jan-2022 15:37 by rmk") - (* ; "Edited 16-Nov-2021 10:16 by rmk:") - (* ; "Edited 2-Nov-2021 21:12 by rmk:") + [LAMBDA (GITCLONE) (* ; "Edited 5-Feb-2022 11:35 by rmk") + (* ; "Edited 18-Jan-2022 15:37 by rmk") + (* ; "Edited 16-Nov-2021 10:16 by rmk:") + (* ; "Edited 2-Nov-2021 21:12 by rmk:") (* ;; "Strips off {UNIX}") - (CONCAT "cd " (STRIPHOST GITMEDLEYDIR) - "; "]) + (CONCAT "cd " (STRIPHOST (TRUEFILENAME (GIT-CLONEP GITCLONE))) + " ; "]) (GIT-COMMAND [LAMBDA (CMD ALL NOERROR) (* ; "Edited 3-Jan-2022 10:47 by rmk") @@ -1118,20 +1174,22 @@ (ERROR "INITIALS is not set"]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4731 9857 (TOGIT 4741 . 6660) (FROMGIT 6662 . 7521) (GIT-DELETE-FILE 7523 . 8417) ( -MYMEDLEY-DELETE-FILES 8419 . 9855)) (9858 11499 (MEDLEYSUBDIR 9868 . 10308) (GITSUBDIR 10310 . 10886) -(STRIPDIR 10888 . 11259) (STRIPHOST 11261 . 11497)) (11500 13437 (GFILE4MFILE 11510 . 12181) ( -MFILE4GFILE 12183 . 12736) (GIT-REPO-FILENAME 12738 . 13435)) (13438 15772 (MEDLEYSUBDIRS 13448 . -14416) (GITSUBDIRS 14418 . 15770)) (15899 22393 (GIT-COMMIT 15909 . 16487) (GIT-PUSH 16489 . 17045) ( -GIT-PULL 17047 . 17453) (GIT-BRANCH-DIFF 17455 . 18650) (GIT-APPROVAL 18652 . 18853) (GIT-GET-FILE -18855 . 19959) (GIT-FILE-EXISTS? 19961 . 20840) (GIT-REMOTE-UPDATE 20842 . 21884) (GIT-FILE-DATE 21886 - . 22391)) (22438 26615 (GIT-CHECKOUT 22448 . 22689) (GIT-WHICH-BRANCH 22691 . 23275) (GIT-MAKE-BRANCH - 23277 . 24768) (GIT-BRANCHES 24770 . 25550) (GIT-BRANCH-EXISTS? 25552 . 26613)) (26645 29350 ( -GIT-MY-CURRENT-BRANCH 26655 . 26828) (GIT-MY-BRANCHP 26830 . 27749) (GIT-MY-NEXT-BRANCH 27751 . 28192) - (GIT-MY-BRANCHES 28194 . 29348)) (29396 33166 (GIT-ADD-WORKTREE 29406 . 31166) (GIT-REMOVE-WORKTREE -31168 . 31746) (GIT-LIST-WORKTREES 31748 . 32552) (WORKTREEDIR 32554 . 33164)) (33214 53766 ( -GIT-GET-DIFFERENT-FILES 33224 . 35094) (GIT-COMPARE-BRANCHES 35096 . 38064) (GIT-COMPARE-WITH-MYMEDLEY - 38066 . 41751) (GIT-COMPARE-WORKTREE 41753 . 45230) (GITCDOBJBUTTONFN 45232 . 50236) (GIT-CD-LABELFN -50238 . 51320) (GIT-CD-MENUFN 51322 . 53764)) (53812 56711 (CDGITDIR 53822 . 54254) (GIT-COMMAND 54256 - . 55824) (GITORIGIN 55826 . 56403) (GIT-INITIALS 56405 . 56709))))) + (FILEMAP (NIL (3466 4312 (GIT-CLONEP 3476 . 4310)) (5552 7490 (ALLSUBDIRS 5562 . 6688) (MEDLEYSUBDIRS +6690 . 7129) (GITSUBDIRS 7131 . 7488)) (7491 12965 (TOGIT 7501 . 9649) (FROMGIT 9651 . 10629) ( +GIT-DELETE-FILE 10631 . 11525) (MYMEDLEY-DELETE-FILES 11527 . 12963)) (12966 15362 (MEDLEYSUBDIR 12976 + . 13416) (GITSUBDIR 13418 . 13994) (STRIPDIR 13996 . 14367) (STRIPHOST 14369 . 14605) (STRIPNAME +14607 . 15360)) (15363 16664 (GFILE4MFILE 15373 . 15619) (MFILE4GFILE 15621 . 15963) ( +GIT-REPO-FILENAME 15965 . 16662)) (16713 23632 (GIT-COMMIT 16723 . 17301) (GIT-PUSH 17303 . 17859) ( +GIT-PULL 17861 . 18267) (GIT-BRANCH-DIFF 18269 . 19464) (GIT-APPROVAL 19466 . 19667) (GIT-GET-FILE +19669 . 21044) (GIT-FILE-EXISTS? 21046 . 21770) (GIT-REMOTE-UPDATE 21772 . 22814) (GIT-REMOTE-ADD +22816 . 23123) (GIT-FILE-DATE 23125 . 23630)) (23677 27854 (GIT-CHECKOUT 23687 . 23928) ( +GIT-WHICH-BRANCH 23930 . 24514) (GIT-MAKE-BRANCH 24516 . 26007) (GIT-BRANCHES 26009 . 26789) ( +GIT-BRANCH-EXISTS? 26791 . 27852)) (27884 30589 (GIT-MY-CURRENT-BRANCH 27894 . 28067) (GIT-MY-BRANCHP +28069 . 28988) (GIT-MY-NEXT-BRANCH 28990 . 29431) (GIT-MY-BRANCHES 29433 . 30587)) (30635 34405 ( +GIT-ADD-WORKTREE 30645 . 32405) (GIT-REMOVE-WORKTREE 32407 . 32985) (GIT-LIST-WORKTREES 32987 . 33791) + (WORKTREEDIR 33793 . 34403)) (34453 55532 (GIT-GET-DIFFERENT-FILES 34463 . 36052) ( +GIT-COMPARE-BRANCHES 36054 . 39902) (GIT-COMPARE-WITH-MYMEDLEY 39904 . 43622) (GIT-COMPARE-WORKTREE +43624 . 47101) (GITCDOBJBUTTONFN 47103 . 52107) (GIT-CD-LABELFN 52109 . 53191) (GIT-CD-MENUFN 53193 . +55530)) (55578 58625 (CDGITDIR 55588 . 56168) (GIT-COMMAND 56170 . 57738) (GITORIGIN 57740 . 58317) ( +GIT-INITIALS 58319 . 58623))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 629d60233542e4765199d5512137f031bf547712..2894ae238c4dd72f38ac90f867c8edfe7b2711f0 100644 GIT binary patch delta 6823 zcmb_heQX=ab>}W+$)YWvC`+=X)5&A{Ba(2GxyxOC*mp81awSqCxim>xr_1GNNu-ae zWy`RX6bC2A+_gx8ph?deTv8Od1hI_**Dpv`S-3gpi1d%92#TaYuDKKi8Wbqd0!dM& zDA4|sxW9S3{E+Voq(EhOcXnoW=goV+_j~URKmQ}?tshBmF7_*7?@W2ctNK)xDZcZn zdfpelb1gTdhsK#l3AGId&THZGihAeAW}&@*a&pqcO3Pd25_5gj3t`W=YiuT&GGaL+ zS}@}H>PIZ;VRv4;*sX_{OAiIK5dW@}A5{FU)m7!Z8a(d{(!8o39Cyto3*K1D%otgA zJ|1$7C7Hr9rjg5;IhJHTmN4^$bMa(uoH<@|I2>}M*8K|Zjul6@xUJvb+a1^ttq5HY ziROyqvk@9yag?qY~qO&id>`eavFXOP~A70ld{n3H8;AB&lpShP@O!GPUl0ga`N^fc2omMJ7+ ziD)in#to)vtdLtUnhW^##tVwZVhMalfmwp=Hq`hTw3woVm}hO1-PqV-%j}i4Ew;M8 zaii>EA)R?9@qEt1f(rBCrdPvkObfDr$^t&7sQNhb`Ff; zyQOIDNMiTc;^5-(%JA?Dzf($#e5Jnq?}_0TwtrSlxRnEQ&YCOTN0#rE9?cWBQgo%u zVF4Z*b-TMV&e~H)D}w*5V`S1$H$ zKLY&1A(k)XvSywsK_6kp$T0;rT*%~8(R?CVV2U1ODX&l%Q~Zhz6KGc>T?!D+B#l&@ z6%}ENC%_qCFJ%NgRTfgke2lYTkY%H>`6dc=mF3M`0eDlCaO(>!sImzb2(oE2zQh6w zpLps-)emb6Ahcmgxb;3O1N&`AfDvOIl0%N%E37!`Zl4^j`40+ZY(HC)+>(q=CHUwl1r_Ag{-?eFH`t=fe^n_@KI{(UHcHnFf9zt*-HHN?Nz%c>tC zJFsUXmT=hG%Kxk60VeEuK^XM^C^tDBw!^Q2#1^7;8W+#nH3m_NpXEGzc zMZ~!ehJc&J#CjM=&BSR%5U6F426L%;gRixQ=Y;v|!TzC;W&t%AVwa6vK51r%K!XZD z**Va!=mF-5ZQNW#K-}739*7#`?{u6P44|J@%9tQ6b0HH4Vfy$#c6biCK!l#_%bQ!} zTl{f{ate6(O}McXaW8i!Y8}bmlJoAP%5O=J67s`T#j-&0z(VycD17@($5=RQYbfk* zC@2KVY*RL<+twUnY*Xtx{7HzUk?KXzu=E1wZ|X%22+p*XGVaPGQ-~HJ1Pivx&vf>= z5gyui>ksWFIy(@JqacKtH8dkwT3Nsv>P)~EK~ zDXl-ZcfYiLZjaX!OJDxu13$_aAP*4@dPe$Yxnyga|tbRz(!FrA4kl zo3xPCOcom6NUTDJnSoU3-RGC59AFgUjA+f7rACFWk)BS$Ef$A>G5p{*p>VhzR90;V zoZ!2#g&Bl?8#5yIA$(zM+|_P`rhIAQ3L%|k9U9@qP{I zcG4w$DBg&s5nBChIv35v5@-^+ z*$UNJ)aTRuu<)kb;gATrL@0T>7Px!pTs21u%~`6fxpO3St-FvXD3HbLR%d0^RX^P+ zVMmHjXD_8Mr;^A3L})V#Vnuko$>0RAqE|e7<48Ff99BF~8+_Dk3s*>;kMXyL{#Mrf z{3j;@*xtY~4e1$lZEr2fRF*Ph(bVquhXWE1kDl&|S@`ANk*7CQwn@8>`a-%7+l${y{xvf62HPjBrGwrgc}{Nyu}va0i) zXU-0)R&ph9A!Iz$fd}Sg{x!xLvRV1c51KE z%7cW}RIt3r+s$-3nu#O*uvw|WD{x>B{(%ie270S}ePgT4mP;juq;humQ=WTIxsmG$ zVX-|0L3d^*&!1O=@_SDHDRtsli$Io2f98B+$MHEb0)KO^pZ~Rbp_<%2D^dYDGB-Wf z2Cl?htnKkAl7N4hjv?(6I71F2M4mM)L?NQJf)KK&{bNX=8Uf1RYN|oo`%KERu*t?G zpRdg?L-0!~3&`<7;PxzVH$hhm(Q1~TA$y&f;Snv70$1nEG~}Qt1RC;8A?QHUp4;{S zGIQZBqCYG$^j0^#LG+5ybUTKenEzOts*?R17KW@SCj`cXZ&4mjEfvQ8xC2HOOFHO_boyQVA3LKL9>?^zo_JY05 zTyi#5jkoXq3mbD@{{JE3z`)VfweBUmKJ3dw>+DA1QMwCDwV zsDc%3p;SRQ2p9Hn>m2~JIj^Z75k4A#0y_qq)og%TlEQ=GMH4xJV2`wsn>7R_W}`VH z59q0sg*2*EL3Y$@B~ac*3gERdiP}}ZbJXcL$lnhK-6I58Gk3ASPndz~n!#OR6Tie%13(*YG(i}{t0!oQRGpgi9?ZlCgx% z-5~r>b1t|_)TIi=!w=20%P56~aBd-{9T7)ftpfgPIbdTn5HX!UY&aS6R3qf=~r30Tv{)`iu4M( z#lB~lXWuin)MQr;*^AAtpjZz|Rq#`jZZ$>Y|26eY%8#9)Q&hA*Ha5kcW3N5Wyc2A~ zJ1+8Z58JrPniAOb91JrLl*=|hxl&rYRbJiNxU~j8ckN!ec)zcw&vC%ffoxi;bws6I zGj~Wjt->1lgt?H4XGD>uv%>Ub+(;P(V=`GV(ui0g#v@&WRTT$K!n)QVRRT=lE}EZT z5Rp;!H|t~-i9+jSO9f_Ulb4OjLSbn#n=@lZUVstD1S0il99*EDcw%LN$0jky`CQlG zsuJ)w*HftI7Du;;xuLf8L^%BLdJxGzJpo?ZS4Q^s#KJ)8lN$|$#ky76D2`lg7epBT z&_V!-wGI|+TLy?zfxRUP?HP)-@$!0kt9%AEEV2wG5W=7WD#4&nVV|}}g`>a+KFyFv zEU{B!pCXJlUiD5<$j4!hhg}pvQ3CvH3llveAF+CH2E>1`Fd{1<{_};=V@N-&elfvb z!o&RhXA95p$mL!fuu+_(-vE$|o&?canU{6=PLYW&#HYm4$S9%k1}RaAm&{VOtpH5z z=jF)Jg67#b-goZ7=K;6IY+)!je5TX$`-N;3$0)=jmJP>iGCL8{>PW0lxWi;mAxT-?j|@*78yQ!OL2&Yl22pUV9`sS`-%gSiyOr-uNFu81dCf|F!+#I%Ej*%pXK+LdwJx_7$#P( z`1#kbeC%*rUFYKUE6?*^UO9>3(d7&L#pN?-RhOguyUT-UeXtxKzG9{Su{pFA1wMmhe;+05Vilju#PC`j06AG~{ z!%~Yi(k-#s1yb~(Z8`{0>>|i+8}ua$tZbDwld1yD=rxqwsI7P9K zo1U3_`6oL?1?O_^%-osz&YbUj-%MWrSa|hg;akOHa@fDHe%mjLvP?vAR+MHn`L&mF zCzaq7@ydaAqpZv-;aM&G+JBpc&ia{|880cX?^Mdfwf_SZ1FGIBmoH(Y^jJ=h7W6nq zeZrJp^4eFg98!YBr3HeDN|8O%`eZzja;52 zNQe^mG51gUoetrk1Ai~F$0M3Kc-C1QpkF>XEx75w9^9y{El$37|MP1OpA^(cHfLlM zA_c-EW@cj10+F;JNu;9rWYNgP%_5Oh8BN($W&@EFmCUn}nzr8MAklLh7FY^A%$e4u|@WhiKcZD(5#_}CX)o#!Y9Ne zd_JO5VPyEMFBl|qW_*hOgFHXLEGiAFHg1x6s$Y|t2BHpFU>aBNkM zGf|rc%lOzvVak;;Qm`(h!MNi?0lC{aMce!B;l2a4&W)Olhg?2`h}PJ!3#EPZkw|*g zs!N)Aph0A2dRL9ot^wx&#~nv6;HYK~Gpf~(Y_Xq+i#<0SwWSDWAb)-IV2r=y__NBN zkt2Pq=k9bzT|TnL>JG8TOP}yh`Qs^8vB`^W5LXP7JmaVVzJg+1yb0T|)(Rx75NutZ z6OM!eBoj+U;VJyMi;E>pj7DU6AilEp5Z$N3ntAx5gkfd&S0fH9jfKrnzC{?WqRn{hy|jW|eyZPsH2Gq=j5 zFiYeB>(6+{RJMb=z%rz@dqcd)G}O%ow8^^@f(-d|p9qwwg#D1TYu&&3YM-91;V4J@uPcslvV%N#&nddH~u zCjs!^Cnw)^_SD~6V1$Gp+wKkxZL&`xDSs@QN2CaK@=$8>Pz68iuT-1Eba>zd3&>sk zgZuLs0)^$~O4{DHhyU$>Gbq!@$zApn9lK0L&jnU|-g7oGmy1G4z$>nYJbo}-vA23O zjcScVMKLG=rVS_b@gTF9OJj~d^YlZ{MWev+$>+G`Tt6EH4nXyWt1;0hFtbDC+4M@v zfEq)4@_KY$-Am1WCd-u~DqrY+nB`k7r3}G+}X}4EmK*Fs}V;$+zY0ut=VG0`j;&Wn}0##%DGl%HH!{ z#s}|tQu*7>?VWA1b(@qow_mzIHomk&Zg1_7&D(_aLC}0*eP{jVEV;A3Q)N}E!oNlq zhOf(8m2KXg4`Y9%Nc2bJlcN&07g2}DR2E4YijoBvb|FB;(@)X=9q*-|oH}=aF+pRj z(OSrMvxaq0fpW$PNq-VmW;{dt5QBX-V)Vt))AX082Pqv5&>?b${@>^X{jYJipwh9` zlk~HbK`iFP0A}dm1tUUV*y(UMU!+H`jnF@ho%LuyJ2e|inQ$lQcXLA&h0tG)A3G^A z^)<742EL=JWHvfy<_ZK3!&=X&ND|4cVIuXKwSG*6fMQ#dvv)+F> zIsw7qd}G3GWjRndh*%<#$1)`nN1{xBF9n^S_R$G>dYq#&IOL2ZIm51%f3U`#hf~j> zTe4nT7(8=ev8R4$crI4;c-+Fnxl~(HK8U2!+{3<;u6j6@jaX-M^0DSc=k?t^hfhW( zn=r2WTWaiQOUolau>5acFK{0uH7OkI5O68Xa%L-?4zc9o@gZ354N>;DhL8e*&JmEK zG)I6wHH)&^*+&dE8?JOs&ob$}z8p8XoV68G)XN@nx1N!`XepjBm(UVj4K~)@(nTs!zu9nHO|} z$LmSw;F;cqo_c9GNmm0)HTN9f@B5!06RtajXX~SjPAB{AUvOUA{YF`^qW6i$?q?n4 zU-KE<))U)}u-uFoGGJ?!k&^=!GiS^j86qQ?#Nu-~vzXU&@C&{>C;8C{z~k^TUr6#( zQ$f$+bVdEaw`xczE!1TMaD*EkKqT-e%t;V~ghl7{R05-mDruG_MI_Ugr)Q?whA5&& zycv_biJsFlF+J}kau~bxSS1MKi*4PyvwpWi@|DUI(IkWtFL`0}W@Q^Yi0I)Z{Exke zcv-()W~ZWn>S9L;>q{^Fap-x$MaRPzOIW{k24emhCIzE_!yt+X#_<&#<4{Cy!%w2D z4DQBRJNRig2U_1i;+y?ipwOR(i^q}K?9WVOgx<=rQ;1O(bB*~7#Du$Ceu_Bn9q)1U z(e2rw>o{l0qkk$+)AwgD*0^9q1~>YR`uIYb@#Pnd;syNtbb+($y+P3xx$k(p=X=Hn z)qgaE4-DtK7P%T}izxO_wBFCjQ7z6?%jNhH{&i_!S1JpG!eMiy>=fQ`3T;N2BaC&m zH?7}x{V+0_Uzh_A7wfK6)pH%k@6FWY`}aS;!Nz&YJi#a71Rg568|F~`km;^^O2=L? z-IJxE2EP8pJZ6P~4M$@ErX4dqJ@uYfh0;XB9IGF;R&S2Gd%kau)k?lb^=sysfM0XW zSsH8b@vXRQ`uK}E;pE2f7b|BiO*Uc=M$8Fw(&`Q&<*K>6*;Ut;US3M_r#-5N|IwE( zxh<#S16iZdf4=0YS#xtku?6PD?#Z$se1XNkg~gtdw_%d{u;~RFq%__zJ3kaU2*`5ZKmJRSY#9R?$Mla#*6k z?W_(w^^&2jc7GWP+7boyYNzb7NX6ht4Pp^{FnJkAY5rZ zvz*9G5nsG=v$9jMo9KZnM~}j5z1Cd}zL!Gu?3J^VlF}UFl7IgY8ny#dsG$HguZ%v& z(zx_JlCG3*R_>u1d0^K&WUk}gg^k60O_5VYrfbbVFHw+YwnR?}1?f+(oJz?650y|p z6nvM-CGyq3A^vGH?Vob7`vNc7dV#c-V5?*h-$YX>vi+rv^5)&jjh(H#n~>E#G4j^X zV%BlM(Hn&Z)O({s*;1tkCmL4jEc^iBPPi~<-H^E3&DMF`YCh6z-uq4Nuy9sE3YJfr z%c*##KonfJ73OB*dP*p;YwH&*nSLSc0#n==ttkl?_nIxhiboTc_nEGyyGxzQh|p2CqD4(qMy5HXt5 zNn*!z4C%+FldvL2U0g(hmz@(!px?fUB^&|vTPoqcAX>9cm2g_N=a%3)kIe>uwkE@@ zopXV2`=$cp?97MYRIslR>@JvC2)u;F=2cRYv3Nvq+*dYzVa`M@AVVouL9q}TCHUG` ztX9HEbjkk}T&f0GJA;WJD{OuX7elITxf^^1UY4Xf75CiB6FS+Q~OJf5Z@79*kPfKCsCnwg%`q3?s$rGAbyHI0= zPT9>9cKc!J9ovksmeumyze+H$u*U!=aT#r7D|0#fVVitci9`_f`+#-&+I-ye=@#8K# z2ix4kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135 25556 +(FILECREATED " 5-Feb-2022 08:23:53"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;136 25474 - :CHANGES-TO (FNS PSEUDOHOST CONTRACT.PH EXPAND.PH PSEUDOFILENAME) - (RECORDS PHDEVICE TARGETDEVICE) - (VARS PSEUDOHOSTSCOMS) + :CHANGES-TO (FNS EXPAND.PH) - :PREVIOUS-DATE "28-Jan-2022 09:06:55" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;123) + :PREVIOUS-DATE "30-Jan-2022 08:58:48" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;135) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -172,7 +170,7 @@ (EXPAND.PH [LAMBDA (FILENAME PHDEV) - (* ;; "Edited 30-Jan-2022 00:15 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") + (* ;; "Edited 5-Feb-2022 08:23 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") (* ;; "Assumes that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") @@ -185,7 +183,8 @@ (IF (TYPE? PHDEVICE PHDEV) THEN (LET (SUFFIX SUFFIXPOS) (CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME)) - (SETQ SUFFIX (SUBSTRING FILENAME (ADD1 SUFFIXPOS))) + (SETQ SUFFIX (OR (SUBSTRING FILENAME (ADD1 SUFFIXPOS)) + "")) (CL:WHEN (FMEMB (CHCON1 SUFFIX) (CHARCODE (< > /))) (SETQ SUFFIX (SUBSTRING SUFFIX 2))) @@ -471,12 +470,12 @@ (LOAD 'EXPORTS.ALL)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1355 8925 (PSEUDOHOST 1365 . 6625) (PSEUDOHOSTP 6627 . 6977) (PSEUDOHOSTS 6979 . 7336) -(TARGETHOST 7338 . 7612) (TRUEFILENAME 7614 . 8301) (PSEUDOFILENAME 8303 . 8923)) (8953 16177 ( -EXPAND.PH 8963 . 10190) (CONTRACT.PH 10192 . 12857) (SLASHIT 12859 . 14427) (UNSLASHIT 14429 . 16175)) - (16178 22968 (OPENFILE.PH 16188 . 16749) (GETFILENAME.PH 16751 . 17040) (DIRECTORYNAMEP.PH 17042 . -17666) (CLOSEFILE.PH 17668 . 18022) (REOPENFILE.PH 18024 . 18589) (DELETEFILE.PH 18591 . 18875) ( -OPENP.PH 18877 . 19053) (UNREGISTERFILE.PH 19055 . 19360) (REGISTERFILE.PH 19362 . 19663) ( -GENERATEFILES.PH 19665 . 20705) (GETFILEINFO.PH 20707 . 21009) (SETFILEINFO.PH 21011 . 21210) ( -NEXTFILEFN.PH 21212 . 21754) (FILEINFOFN.PH 21756 . 22027) (RENAMEFILE.PH 22029 . 22966))))) + (FILEMAP (NIL (1226 8796 (PSEUDOHOST 1236 . 6496) (PSEUDOHOSTP 6498 . 6848) (PSEUDOHOSTS 6850 . 7207) +(TARGETHOST 7209 . 7483) (TRUEFILENAME 7485 . 8172) (PSEUDOFILENAME 8174 . 8794)) (8824 16095 ( +EXPAND.PH 8834 . 10108) (CONTRACT.PH 10110 . 12775) (SLASHIT 12777 . 14345) (UNSLASHIT 14347 . 16093)) + (16096 22886 (OPENFILE.PH 16106 . 16667) (GETFILENAME.PH 16669 . 16958) (DIRECTORYNAMEP.PH 16960 . +17584) (CLOSEFILE.PH 17586 . 17940) (REOPENFILE.PH 17942 . 18507) (DELETEFILE.PH 18509 . 18793) ( +OPENP.PH 18795 . 18971) (UNREGISTERFILE.PH 18973 . 19278) (REGISTERFILE.PH 19280 . 19581) ( +GENERATEFILES.PH 19583 . 20623) (GETFILEINFO.PH 20625 . 20927) (SETFILEINFO.PH 20929 . 21128) ( +NEXTFILEFN.PH 21130 . 21672) (FILEINFOFN.PH 21674 . 21945) (RENAMEFILE.PH 21947 . 22884))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 4df8d2083f91a4b4a6939cd000163630ca4cc028..b9e679716876f0e971beb57e70afac13084d9cf6 100644 GIT binary patch delta 417 zcmexkzsi0>xQK$Ou3Ku7u91O}k%EDRm65TPsqw_@$a*tP1tkSTgq)F)m9e3ffq{|& zS5i@Ga(-?>W=?8~LTW`pQL(C(f@?&8qo0djfQLe6o`RBFsE>~VvTi*+Jtc*d#1fzm zY^ItiX>w_}dHT3I2e~?ixVk7PVRu)xr?HuWk*SHfiGr20hohgnYp`yJzk-IFU$6of z+zFZrRslh-VV?e>!MZL$<0d;XCTyO>^oNso8508olfz*KAlQ^Vc{Y!VT!o+lV?K!Q zzy%^Bx1>3EX5Rp_x3cF?zQ&^_vBhyKuR}UW7A(vOVkI$cm^WF3S3%m$P{G;X&)G3V z!O+A^Avn}2I3&o^&t1XL*l@Bxuc)w*nF7dPevZDbZl10_E(#VVlgoLPL`;np++1A4 g6by|F6+HZdf!YlXCa>kyV>LHdP*U1_i&seq0DWR*%K!iX delta 518 zcmZ8eyH4Cd6kXh5tqTxR(&fhDv0JR=*DUK15<3}>*N%2=Yi0~VLP8K$5#s$QkRm}% z2l59{(NLj~R7sa#px|RDG6n?@Q(WCU=iEEz+_|2Am_J{f@a)#-)t#1WyDr!rj5^rw zTx>3#q9&Mb`vr47>;)JFCg^Ji!>_yBdmCHBbr>G+9UM+!$OS9HEY5_4jU6zfqTh$t z?UrSku)cbvTHcQJZEX8yQ*T5`pHa?;WFeGyBP*xiB81w2X-v`{6D^rRBT5D6uU?~B zDmkIj%41+(a*~Es_C%-#rewgH(BO<_JQR?}AzMf&14(#~$)`f$3xq51*@U3kK+Nb( zz&Tg^tPrhG=~CJ|FDtPFY_~B&7vE#e^=>`wVbr+PYBjCOheX${ZyU94`P-d=io;X%8IN yhvjGO5zhvdM{t|~{u_=G)(>HJw)|k26Mh>a%Sc>Ey8_R7MrZqJO5kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;112 47459 +(FILECREATED "19-Feb-2022 12:01:45"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;115 46109 - :CHANGES-TO (FNS COMPARETEXT.TEXTOBJ) + :CHANGES-TO (FNS COMPARETEXT.WINDOW) - :PREVIOUS-DATE "28-Jan-2022 17:12:30" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;110) + :PREVIOUS-DATE "18-Feb-2022 17:05:22" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;114) (* ; " @@ -58,7 +58,9 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. HASH.TYPE REGION FILELABELS TITLE]) (COMPARETEXT.WINDOW - [LAMBDA (GRAPH REGION TITLE) (* ; "Edited 23-Jan-2022 18:18 by rmk") + [LAMBDA (GRAPH REGION TITLE) (* ; "Edited 19-Feb-2022 12:01 by rmk") + (* ; "Edited 2-Feb-2022 17:29 by rmk") + (* ; "Edited 23-Jan-2022 18:18 by rmk") (* ; "Edited 12-Jan-2022 10:06 by rmk") (* ; "Edited 22-Dec-2021 15:51 by rmk") @@ -87,13 +89,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. OF REGION) (IQUOTIENT WIDTH 2)) (FETCH (POSITION YCOORD) OF REGION)) - ELSE (CLEARW (GETPROMPTWINDOW WINDOW)) - (printout (GETPROMPTWINDOW WINDOW) - "Please specify a region for the comparison graph" T) - - (* ;; "I don't know why the graphregion doesn't include the last line") - - (RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION))) + ELSE (RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION))) [SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare text" (CL:IF FILEPREFIX (CONCAT " of " FILEPREFIX) "") @@ -111,26 +107,11 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. (CL:WHEN (EQ WIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW))) (WINDOWPROP WINDOW 'MAXSIZE (CONS WIDTH 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-Jan-2022 09:03 by rmk") + [LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 18-Feb-2022 17:05 by rmk") + (* ; "Edited 30-Jan-2022 09:03 by rmk") (* ; "Edited 28-Jan-2022 22:37 by rmk") (* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.") @@ -149,7 +130,7 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. -1 1)) `(,WINDOW BOTTOM -2) - T)) + NIL)) (SETQ REGION (CL:IF COMPARETEXT.AUTOTEDIT (RELCREATEREGION REGIONARGS) (RELGETREGION REGIONARGS))) @@ -755,12 +736,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. ) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1345 40079 (COMPARETEXT 1355 . 2855) (COMPARETEXT.WINDOW 2857 . 7675) ( -COMPARETEXT.TEXTOBJ 7677 . 10274) (COMPARETEXT.SETSEL 10276 . 11066) (CHUNKNODELABEL 11068 . 12189) ( -IMCOMPARE.BOXNODE 12191 . 12958) (IMCOMPARE.CHUNKS 12960 . 17336) (IMCOMPARE.COLLECT.HASH.CHUNKS 17338 - . 20255) (IMCOMPARE.DISPLAYGRAPH 20257 . 28100) (IMCOMPARE.HASH 28102 . 32289) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 32291 . 35787) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 35789 . 37744) ( -IMCOMPARE.SHOW.DIST 37746 . 38192) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38194 . 40077)) (40080 46237 ( -IMCOMPARE.LEFTBUTTONFN 40090 . 42667) (IMCOMPARE.MIDDLEBUTTONFN 42669 . 45785) (IMCOMPARE.COPYBUTTONFN - 45787 . 46235)) (46290 46981 (TAIL1 46300 . 46654) (TAIL2 46656 . 46979))))) + (FILEMAP (NIL (1344 38729 (COMPARETEXT 1354 . 2854) (COMPARETEXT.WINDOW 2856 . 6214) ( +COMPARETEXT.TEXTOBJ 6216 . 8924) (COMPARETEXT.SETSEL 8926 . 9716) (CHUNKNODELABEL 9718 . 10839) ( +IMCOMPARE.BOXNODE 10841 . 11608) (IMCOMPARE.CHUNKS 11610 . 15986) (IMCOMPARE.COLLECT.HASH.CHUNKS 15988 + . 18905) (IMCOMPARE.DISPLAYGRAPH 18907 . 26750) (IMCOMPARE.HASH 26752 . 30939) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 30941 . 34437) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34439 . 36394) ( +IMCOMPARE.SHOW.DIST 36396 . 36842) (IMCOMPARE.UPDATE.SYMBOL.TABLE 36844 . 38727)) (38730 44887 ( +IMCOMPARE.LEFTBUTTONFN 38740 . 41317) (IMCOMPARE.MIDDLEBUTTONFN 41319 . 44435) (IMCOMPARE.COPYBUTTONFN + 44437 . 44885)) (44940 45631 (TAIL1 44950 . 45304) (TAIL2 45306 . 45629))))) STOP