From 32461da7eb2fad9daa3f79893fb14e9c01436689 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 12 Oct 2021 16:49:35 -0700 Subject: [PATCH] Lispusers packages: MODERNIZE, THINFILES TEDIT-PF-SEE (new) MODERNIZE interacts better with TEDIT split windows, THINFILES works better on filenames, not just extensions. TEDIT-PF is new: provides commands tpf and ts for doing PFCOPYBYTES or SEE to scrollable read-only TEDIT windows, also functions for remembering and reusing the regions of windows of particular types. --- lispusers/MODERNIZE | 196 ++++++++++++++++++++---------------- lispusers/MODERNIZE.LCOM | Bin 9095 -> 9270 bytes lispusers/MODERNIZE.TXT | 8 +- lispusers/TEDIT-PF-SEE | 144 ++++++++++++++++++++++++++ lispusers/TEDIT-PF-SEE.LCOM | Bin 0 -> 3586 bytes lispusers/THINFILES | 67 ++++++------ lispusers/THINFILES.LCOM | Bin 3053 -> 3230 bytes 7 files changed, 292 insertions(+), 123 deletions(-) create mode 100644 lispusers/TEDIT-PF-SEE create mode 100644 lispusers/TEDIT-PF-SEE.LCOM diff --git a/lispusers/MODERNIZE b/lispusers/MODERNIZE index 599f838e..dba985b2 100644 --- a/lispusers/MODERNIZE +++ b/lispusers/MODERNIZE @@ -1,92 +1,91 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 8-Jul-2021 23:33:42"  -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;16 23978 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS MODERNWINDOW) +(FILECREATED "12-Oct-2021 14:57:29"  +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;28 25303 - previous date%: " 3-Jul-2021 10:32:03" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;15) + changes to%: (FNS MODERNWINDOW.BUTTONEVENTFN \MODERNIZED.TEDIT.BUTTONEVENTFN) + + previous date%: "12-Oct-2021 08:34:48" +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;26) (PRETTYCOMPRINT MODERNIZECOMS) (RPAQQ MODERNIZECOMS [ - (* ;; "Externals") + (* ;; "Externals") (COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP) (INITVARS (MODERN-WINDOW-MARGIN 25))) - (* ;; "Internals") + (* ;; "Internals") [COMS (FNS MODERNWINDOW.BUTTONEVENTFN NEARTOP NEARESTCORNER INCORNER.REGION) - (* ;; "Behavior for some known window creators") + (* ;; "Behavior for some known window creators") (FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN) - (* ;; "Add some Meta commands") + (* ;; "Add some Meta commands") - (FNS TEDIT.MODERNIZE TEDIT.SELECTALL) + (FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN TEDIT.SELECTALL) (DECLARE%: DONTEVAL@LOAD DOCOPY (P - (* ;; "Tedit") + (* ;; "Tedit") - (MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN) (TEDIT.MODERNIZE) - (* ;; "Inspector") + (* ;; "Inspector") (MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER) - (* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either") + (* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either") (* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN)) (MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) - (* ;; "Freemenu") + (* ;; "Freemenu") (MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN) - (* ;; "SEDIT") + (* ;; "SEDIT") (MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN) - (* ;; "Debugger") + (* ;; "Debugger") (MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT) - (* ;; "Snap") + (* ;; "Snap") (MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW) - (* ;; "New execs") + (* ;; "New execs") (MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC) - (* ;; "Existing exec of the load") + (* ;; "Existing exec of the load") (MODERNWINDOW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) - (* ;; "Table browser (for filebrowser)") + (* ;; "Table browser (for filebrowser)") (MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN) - (* ;; "Grapher") + (* ;; "Grapher") (MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE) - (* ;; "Sketch") + (* ;; "Sketch") (MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER) - (* ;; "Promptwindow") + (* ;; "Promptwindow") (MODERNWINDOW PROMPTWINDOW T) - (* ;; - "Menus: Move only and only with title clicks") + (* ;; "Menus: Move only with title clicks") (MODERNWINDOW.SETUP 'MENUBUTTONFN 'MODERN-MENUBUTTONFN] @@ -202,39 +201,45 @@ (DEFINEQ (MODERNWINDOW.BUTTONEVENTFN - [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION)(* ; "Edited 24-Jun-2021 14:49 by rmk:") - (IF (AND (MOUSESTATE (ONLY LEFT)) + [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION) + (* ; "Edited 12-Oct-2021 14:56 by rmk:") + + (* ;; "CORNERREGION is the region that determines the identification of corner and title clicks, presumably excludes uninteresting menus and other attachments that would also be part of the moving and reshaping region (the ATTACHEDREGION below).") + + (if (AND (MOUSESTATE (ONLY LEFT)) (EQ LASTKEYBOARD 0)) - THEN (TOTOPW WINDOW) - (LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION)) - (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW] + then (TOTOPW WINDOW) + (CL:UNLESS CORNERREGION (* ; + "Could cover a bunch of Tedit split-panes") + (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION))) + (LET [CORNER TOPMARGIN (ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW] - (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.") + (* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.") - (* ;; "This is particularly the case of FILEBROWSER windows, where the the modified ATTACHEDWINDOWTOTOPFN drives the click here. ") + (* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ") - (SETQ TOPMARGIN (IF (WINDOWPROP WINDOW 'TOPMARGIN) - ELSEIF (WINDOWPROP WINDOW 'TITLE) - THEN (FONTPROP WindowTitleDisplayStream 'HEIGHT) - ELSE MODERN-WINDOW-MARGIN)) - (SETQ CORNER (INCORNER.REGION MAINREGION TOPMARGIN)) - (IF CORNER - THEN + (SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN) + elseif (WINDOWPROP WINDOW 'TITLE) + then (FONTPROP WindowTitleDisplayStream 'HEIGHT) + else MODERN-WINDOW-MARGIN)) + (SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN)) + (if CORNER + then - (* ;; - "The upper corners may be in the title bar, near the side, so test corners before titlebar.") + (* ;; + "The upper corners may be in the title bar, near the side, so test corners before titlebar.") - (* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.") + (* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.") - (* ;; "WINDOWREGION includes the attached windows") + (* ;; "WINDOWREGION includes the attached windows") - (LET ((LEFT (FETCH LEFT OF ATTACHEDREGION)) - (RIGHT (FETCH RIGHT OF ATTACHEDREGION)) - (TOP (FETCH TOP OF ATTACHEDREGION)) - (BOTTOM (FETCH BOTTOM OF ATTACHEDREGION)) + (LET ((LEFT (fetch (REGION LEFT) of ATTACHEDREGION)) + (RIGHT (fetch (REGION RIGHT) of ATTACHEDREGION)) + (TOP (fetch (REGION TOP) of ATTACHEDREGION)) + (BOTTOM (fetch (REGION BOTTOM) of ATTACHEDREGION)) STARTINGREGION) - (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.") + (* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.") (CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN)) [SETQ STARTINGREGION @@ -253,22 +258,22 @@ (GETMOUSESTATE) (LIST RIGHT BOTTOM LEFT TOP)) (SHOULDNT]) - (SHAPEW (CL:IF (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS)) - (WINDOWPROP WINDOW 'MAINWINDOW) - WINDOW) + (SHAPEW (CENTRALWINDOW WINDOW) STARTINGREGION)) T - ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN TITLEPROPORTION)) - THEN (NEARESTCORNER ATTACHEDREGION) - (MOVEW (CL:IF (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS)) - (WINDOWPROP WINDOW 'MAINWINDOW) - WINDOW)) + elseif (OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION)) + then + + (* ;; "") + + (NEARESTCORNER ATTACHEDREGION) + (MOVEW (CENTRALWINDOW WINDOW)) T - ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW + elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN] - THEN (APPLY* ORIGFUNCTION WINDOW))) - ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN] - THEN (APPLY* ORIGFUNCTION WINDOW]) + then (APPLY* ORIGFUNCTION WINDOW))) + elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN] + then (APPLY* ORIGFUNCTION WINDOW]) (NEARTOP [LAMBDA (MAINREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 24-Jun-2021 14:51 by rmk:") @@ -391,10 +396,12 @@ (DEFINEQ (TEDIT.MODERNIZE - [LAMBDA NIL (* ; "Edited 24-Jun-2021 20:54 by rmk:") + [LAMBDA NIL (* ; "Edited 11-Oct-2021 15:02 by rmk:") + (MODERNWINDOW.SETUP (FUNCTION \TEDIT.BUTTONEVENTFN) + (FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN)) (CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN) - (* ;; "All") + (* ;; "All") (TEDIT.SETFUNCTION (CHARCODE "Meta,a") (FUNCTION TEDIT.SELECTALL) @@ -403,7 +410,7 @@ (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) - (* ;; "Quit") + (* ;; "Quit") (TEDIT.SETFUNCTION (CHARCODE "Meta,q") (FUNCTION TEDIT.QUIT) @@ -412,6 +419,19 @@ (FUNCTION TEDIT.QUIT) TEDIT.READTABLE))]) +(\MODERNIZED.TEDIT.BUTTONEVENTFN + [LAMBDA (W STREAM) (* ; "Edited 12-Oct-2021 14:27 by rmk:") + + (* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.") + + (* ;; "We pass the pain that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.") + + (MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN) + NIL NIL (APPLY (FUNCTION UNIONREGIONS) + (bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE + 'REGION) + repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]) + (TEDIT.SELECTALL [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] @@ -422,91 +442,89 @@ (DECLARE%: DONTEVAL@LOAD DOCOPY -(* ;; "Tedit") +(* ;; "Tedit") -(MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN) - (TEDIT.MODERNIZE) -(* ;; "Inspector") +(* ;; "Inspector") (MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER) -(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either") +(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either") - (* (MODERNWINDOW.SETUP - (QUOTE ONEDINSPECT.BUTTONEVENTFN))) + (* (MODERNWINDOW.SETUP + (QUOTE ONEDINSPECT.BUTTONEVENTFN))) (MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) -(* ;; "Freemenu") +(* ;; "Freemenu") (MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN) -(* ;; "SEDIT") +(* ;; "SEDIT") (MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN) -(* ;; "Debugger") +(* ;; "Debugger") (MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT) -(* ;; "Snap") +(* ;; "Snap") (MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW) -(* ;; "New execs") +(* ;; "New execs") (MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC) -(* ;; "Existing exec of the load") +(* ;; "Existing exec of the load") (MODERNWINDOW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) -(* ;; "Table browser (for filebrowser)") +(* ;; "Table browser (for filebrowser)") (MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN) -(* ;; "Grapher") +(* ;; "Grapher") (MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE) -(* ;; "Sketch") +(* ;; "Sketch") (MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER) -(* ;; "Promptwindow") +(* ;; "Promptwindow") (MODERNWINDOW PROMPTWINDOW T) -(* ;; "Menus: Move only and only with title clicks") +(* ;; "Menus: Move only with title clicks") (MODERNWINDOW.SETUP 'MENUBUTTONFN 'MODERN-MENUBUTTONFN) @@ -520,10 +538,10 @@ (ADDTOVAR LAMA MODERN-ADD-EXEC) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4933 10561 (MODERNWINDOW 4943 . 6398) (MODERNWINDOW.SETUP 6400 . 9349) (UNMODERNWINDOW -9351 . 9745) (MODERNWINDOW.UNSETUP 9747 . 10559)) (10626 18766 (MODERNWINDOW.BUTTONEVENTFN 10636 . -15663) (NEARTOP 15665 . 16585) (NEARESTCORNER 16587 . 17466) (INCORNER.REGION 17468 . 18764)) (18824 -21146 (MODERN-ADD-EXEC 18834 . 19265) (MODERN-SNAPW 19267 . 19810) (TOTOPW.MODERNIZE 19812 . 20240) ( -MODERN-MENUBUTTONFN 20242 . 21144)) (21187 22227 (TEDIT.MODERNIZE 21197 . 21896) (TEDIT.SELECTALL -21898 . 22225))))) + (FILEMAP (NIL (4845 10473 (MODERNWINDOW 4855 . 6310) (MODERNWINDOW.SETUP 6312 . 9261) (UNMODERNWINDOW +9263 . 9657) (MODERNWINDOW.UNSETUP 9659 . 10471)) (10538 18976 (MODERNWINDOW.BUTTONEVENTFN 10548 . +15873) (NEARTOP 15875 . 16795) (NEARESTCORNER 16797 . 17676) (INCORNER.REGION 17678 . 18974)) (19034 +21356 (MODERN-ADD-EXEC 19044 . 19475) (MODERN-SNAPW 19477 . 20020) (TOTOPW.MODERNIZE 20022 . 20450) ( +MODERN-MENUBUTTONFN 20452 . 21354)) (21397 23609 (TEDIT.MODERNIZE 21407 . 22221) ( +\MODERNIZED.TEDIT.BUTTONEVENTFN 22223 . 23278) (TEDIT.SELECTALL 23280 . 23607))))) STOP diff --git a/lispusers/MODERNIZE.LCOM b/lispusers/MODERNIZE.LCOM index 99423f35cd056bba4208c94ccad9421a1765f418..29264dc89f6f0238ec555176e76f5d6245baa8f0 100644 GIT binary patch delta 2150 zcmah~O>7fa5Vjri(}jdU97z0=Oq>EXtu61Ly> zn9cKi44AXc+2zw`78aXx(7bqNabb30W%1IUJoz~od46FDV#T_y!$#m#DiwpdlPhSz zwBP80=3uzPCX3LhX8IzVeshI{; zAp?g^+cqmmieQ^n+y$_-$&!r}54u{U1V=>`*_za-4GRU+GE@u6G|09s7fPz)A!=yu zO4k`Y*qW`YRf{~=86vMUA-_aEU?Qy?xFIDQnxUADq>G;b|NA`wUuTaGe`_z%b+P-m z#Vrr7uKJgp<13V$op_3hlxyyOr|adOHJ5bwJH`SNr>Fu$m)nD$R{Xt2zaxLGv9mR; zOgYlyb5~b=Kb8FW4+Q*oPychb6rkify(8G|*#{lWhwrZXuFTKjPn&ZYHzRAh;ef5V zewQn{F(1O;jYUr*Ty9g)E3LApQQnABX+tseii@((LkX4J6m+BPD!k!b+uKE>J<;c7 z!t8Uv7Wxl=q)ZjIQrXSHk`q71(}72Fep|N1=Q1#<+U_gVYpPYXunzbv|0J#`;j0~0 z8^DV^6jZ~uWZks{UdV!>%9dKQz53w!oWr4Y#dBDFCAmsXx%39pL414QS(e`B)eN5& z$(y~L>sQ4@pRjIi6+0viGljZUGp(vw(`;J89DWW^_BDzl$m?+q8)0~0eFf~Tq-v^N zui{wCW&j7RW~YwSH5)QGA^tlFl6R`9IFfA{$0jd4#$t2i6ByhMIoLGY1_B_UXcu|7 zd&}mzH_(E-A~A6~daAOaf`;R$hJ_c>IIJ>luG z(l^zV)c)j{KEcaJ(om1tNg7EKYr(+J3)Bs)YqwZxIF!91X<`K=XWS%{&!G>K^ShrR z_l9P1Jvcm#D}E-(r^894ei?odS2;A*%WTdqc{>y(z0gm-2o0f5N0{253jff>Bp|*Y z$o;V}nT|-vOpb-f$B|Mu6RXjuB@@vhawXbL!qEdL{bnpiUX3b9eH*2hheuw(_0kB1 z`z{h9_hN%&+vu|$Oye*y!b7AsD)ce2N^|M_xjaB+`9hO?I68&Oawtgt9<`9F!qYuW z+^Wh)4gonaJT$<>-FVkOeF+Q_{reN5s7@*L(W8Eh3^-H-{TuXn-;YHcD(jtvSPUs? gB!}ze7)=z#Kuo~<29e;#=YO;GncO$cb4lla;s_bY5MpE-Wvu)aum=R9|0NU3)4EhLu-sb51w&)*RH9AXd@} zus`|aSWOJS**v`oGT!0806tX4N`%NuJfJC+gy zVPDzFtiWfJ0u=^1>HcQ$PTO@E99OYj-7MH@LAOjOLmH+m*R>3EQ{Y-Kg`$g| z2qjgcjzEVD#V+Vn!$Z!pP1Q!11I2ZfTv5&MW=w*i=q7o;Qya~|Ty3ec{F+-^uUGT6 zwUzq(4QG9|I==`Sa7prK=Sk(qj$l(udlNp}FHu`>`@P=s=##sF+bn#Qx*wnGphKSh z_L%o(P+zQ>SY3mS<1Bh>uK#lJd?)2zs-P~Q(_b(cc)0lQLp?~{UB9ot-Otzm3KcxM zb+_r$YZZK^D;{t!x@}lJEZeqMV97+_+Auy_D?VqWL@5nS;ByQU5szc+W*XTx%maz6 z9>erV<9?!W=>P*KDtU~z+1#OHw8$5Gw;BB$vn(SsrH}R@Z=SPy8CvU|x?Mb<>!Qkg zyv~;BNcllES?Nw^L`i~z>Usxz)=}-UjfX=N_@huRjrZV!ItLQ~+Uof#Pn)tCYy zL$sz*sSHEtffJ-OI7Ow5azT`-yh}*=a)G09FUMx}PneKQk!M4E zgVkqPSQ{Q{R|Q_oz?Iyr?O1l%a&(uTZ=REBz57|1>v0w*3y-lltoRU1z7BGuA9hNpiDiC?JxpmT*H%O6>0WYyoR2D~^M=8!u$eG8_g4x(njYd@K@9 z@6CiC1y?DRfZLmA2NHq&eDa?_i2O9P5D49B>nG;0M*i-Ikgeefgnu1=0qxoFH2EwX zLGSDEIN68}4_)#8#ndczR#Uxzd#IU-1dNBsA7M;HW+FedhA=)udLt2%ACVDzW8^B@ z--l+?-&lF!?1KL-bfYkaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;28 6665 + + changes to%: (FNS PF-TEDIT) + + previous date%: "11-Oct-2021 10:07:08" +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;26) + + +(PRETTYCOMPRINT TEDIT-PF-SEECOMS) + +(RPAQQ TEDIT-PF-SEECOMS + [(FNS SEE-TEDIT PF-TEDIT) + (COMS (FNS GET-TYPED-WINDOW CLOSE-TYPED-WINDOW) + (INITVARS (TYPED-WINDOWS))) + (COMMANDS ts tpf) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA]) +(DEFINEQ + +(SEE-TEDIT + [LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 11-Oct-2021 08:51 by rmk:") + (SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX)) + (ERROR "FILE NOT FOUND" FILE))) + (TEDIT-SEE FILE (GET-TYPED-WINDOW (OR WINDOW 'SEE-TEDIT) + (CONCAT "SEE window for " FILE)) + FORMAT) + FILE]) + +(PF-TEDIT + [LAMBDA (FN IFILES) (* ; "Edited 12-Oct-2021 15:22 by rmk:") + + (* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.") + + (CL:WHEN (LISTP FN) + (SETQ FN (CAR FN))) + (IF FN + THEN (* ; "FN name specified; use it.") + (SETQ LASTWORD FN) + ELSE (* ; "Not specified, use LASTWORD") + (SETQ FN LASTWORD)) + (IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T) + (WHEREIS FN 'FUNCTIONS T] + THEN (* ; "skip compiled files") + (FOR IFILE LOC TSTREAM ENV INSIDE IFILES + UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION) + *COMPILED-EXTENSIONS*) + DO (SETQ LOC (FINDFNDEF FN IFILE)) + (IF (LISTP LOC) + THEN [CL:WITH-OPEN-FILE (ISTREAM (POP LOC) + :DIRECTION :INPUT) + (SETQ ENV (LISPSOURCEFILEP ISTREAM)) + (SETFILEINFO ISTREAM 'FORMAT ENV) + (SETQ TSTREAM (OPENTEXTSTREAM)) + (DSPFONT DEFAULTFONT TSTREAM) + (PRINT-READER-ENVIRONMENT ENV TSTREAM) + (PFCOPYBYTES ISTREAM TSTREAM (POP LOC) + (POP LOC)) + (TERPRI TSTREAM) + (SETQ TSTREAM (TEDIT TSTREAM (GET-TYPED-WINDOW + 'PF-TEDIT + (CONCAT FN " from " + (FULLNAME ISTREAM))) + NIL + '(READONLY T] + ELSEIF (EQ LOC 'FILE.NOT.FOUND) + THEN (printout T "file " IFILE " not found." T) + ELSE (printout T FN " not found on " LOC "." T))) + ELSE (PRINTOUT T FN " has no function definition" T]) +) +(DEFINEQ + +(GET-TYPED-WINDOW + [LAMBDA (WINDOWTYPE TITLE NOOPENFLG) (* ; "Edited 11-Oct-2021 10:06 by rmk:") + + (* ;; "WINDOWTYPE=T means always create a new window. If a WINDOW, then reuse it.") + + (* ;; "Otherwise, create a window of type WINDOWTYPE, using a previously specified region if one is available.") + + (LET (WINDOW REGION WLIST) + [IF (OR (EQ WINDOWTYPE T) + (SETQ WINDOW (WINDOWP WINDOWTYPE))) + THEN (SETQ WINDOWTYPE NIL) + ELSE [SETQ WLIST (OR (ASSOC WINDOWTYPE TYPED-WINDOWS) + (CAR (PUSH TYPED-WINDOWS (CONS WINDOWTYPE] + (SETQ REGION (FIND X IN (CDR WLIST) SUCHTHAT (TYPE? REGION X] + (CL:UNLESS WINDOW + + (* ;; "Make sure we have a titlebar and promptwindow") + + (SETQ WINDOW (CREATEW REGION "" NIL NOOPENFLG)) + (GETPROMPTWINDOW WINDOW) + + (* ;; + "Replace the region on WLIST with the window, so we can maintan a likely preference order.") + + (IF REGION + THEN (DSUBST WINDOW REGION WLIST) + ELSE (NCONC1 WLIST WINDOW))) + (CL:WHEN TITLE + (WINDOWPROP WINDOW 'TITLE TITLE)) + (CL:WHEN WINDOWTYPE + (WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE) + (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CLOSE-TYPED-WINDOW))) + WINDOW]) + +(CLOSE-TYPED-WINDOW + [LAMBDA (WINDOW ALL) (* ; "Edited 11-Oct-2021 09:09 by rmk:") + + (* ;; "Puts the region of WINDOW back on the region list for its type, for later reuse. If ALL, closes all windows of the type of WINDOW (and recursively puts their regions also on the list).") + + (CL:WHEN (OPENWP WINDOW) + [LET [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE] + (CL:WHEN WINDOWTYPE + (IF ALL + THEN (FOR W IN (OPENWINDOWS) WHEN (EQ WINDOWTYPE + (WINDOWPROP W 'WINDOWTYPE) + ) + UNLESS (EQ W WINDOW) DO (CLOSEW W)) + ELSE (DSUBST (WINDOWPROP WINDOW 'REGION) + WINDOW TYPED-WINDOWS)))]) + WINDOW]) +) + +(RPAQ? TYPED-WINDOWS ) + +(DEFCOMMAND ts (FILE WINDOW FORMAT) (SEE-TEDIT FILE WINDOW FORMAT)) + +(DEFCOMMAND tpf (FN IFILES) (PF-TEDIT FN IFILES)) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA ) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (833 3903 (SEE-TEDIT 843 . 1253) (PF-TEDIT 1255 . 3901)) (3904 6353 (GET-TYPED-WINDOW +3914 . 5387) (CLOSE-TYPED-WINDOW 5389 . 6351))))) +STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..8b90d1b6e60eab616edefb0b1a1d6a50d6bcadc3 GIT binary patch literal 3586 zcmb_f-)|#H5gyxnyN7|*hLaH5lkQ3uNOpvyneor~j^K%>9Zz;VGnpC3$+0|SZD(zf zjiV&Xfe;c1_y-XCa^eXg@fv(YVh;&F^FJW*FYN2x3w&KYcDx&ec(~Qd(_LNNU0wCn zSCzai+KwlRZO0Ww$7}oaUSPEzSv!Jqju(s2b)q0g?}fs$V{6-eL%eN8f(*To&F19^ zEvUu9rkr6G{lR6?)J=noO2af8)6W zot+$=Zn@LJ(aF}c(ePyS)6zy|>*?gOsAgLylZ&(GtcyFGxEQpHkq{dnnDxS~8x6ft zF5`wL=cDDFqo16eUwo%Q*vALZ1V*%bu1l-tZftDiXn1r9Bj0?6JajWx_`lxzrM-=+ z)oO(XSwL>T%Z83qjSYzBAV zi91Dc5DPDId@n*2OBGta15+yNl#_>lJUJasKc?g9IWTI}fe}1{JU_-8d!C)6D&;-L zRp!WFiVtFZ)lZ?YjEtr0xBwlE z+VEZ+#mJ~G#s;~53ty9*rL084+lQ=7xTsXas6t3*tLMgT--ER)McT)(U0arfm?t@Tb1jb0*XXyIvP;OQhq1*(7kfH3pn%olxp+nU&lDOpu zhuep-h^UNd2(~IpmJ(qRZgE22>k2rbR3$qK*dJz<`~WfpD)FJI0|BuNFH>KIB-=%P zFKmGoT@e5kwfYTT807@z5-o-f7|08K&po8LK=m@`QHYYq}{HWoCk@8^8y3-lXz8Gfy@N)dC z)XPr#uMY2L_5K6?eEP4Z!-J28nb`-a-SlUy!ascFWG#J{XM86Abb0Ravc%#$SD&!t z)$F?~M$8>$%zRa*ESvxN-;>1Z*H(A`*N&Q&H|tBpnl*({gUqVQXvL_ql$DpV(#;mo zn1nSHjpeewkQo5x0wH8nt2e1tHI|4~1Z0$J41AQilHx-TG=Ur}Q&)7ifn;z8Vl0!a z?FiSVn&eu}G~}GJp{gf?@+LjD0_2fx%Eaq;L@1nyO6Fn+kQy>=apDF@bAw5fj2g0l zL5zl=`kI9%8F+ug@q!+h0YuiYoeWihY_~Ih z$Xavj_Z`j^OJz@U_P&}o)m%+jg9RN)UA1cRILo$C=HQyjCLy-!#Y$2xy(uwK9XwgU zO#*tv9`Lvmcc``r{_bs~W>jmkP+)sENRA>vUA3HjU^}@~lC}ZZGIze-A;>ggaT~y@ zlvYC^VaKtNctT$05c&UdLK1u2wGw8Iq2y8vt>jH;5mu1zN{1rD`ol~Lyvc!?#fmD~ z(Q7HKGizBhgA4N7TH486zx58{^;u_^-OF09KG_{MU;QzOYx?l&pX#W8+-<6QE*qu# z(qna<9y?yt3q^uQ*fWZtGN(iu5v?Fr~^4FjoDE zRs0V^5yywJg2?Ku3VzbHLnu=>46MDqTMLxu4tLp{E!m<#dAU(Fz_$|fcD$gUbv!5D zw?b@sJr)IZSl9CGh%V7tpB+PDi}Q;ByMJqP7)9Kz*0394$m<;kmO YoE=LqCFLCkEcy{}=0aG=qKnP`2TLkassI20 literal 0 HcmV?d00001 diff --git a/lispusers/THINFILES b/lispusers/THINFILES index b2e4eaf6..38b1a985 100644 --- a/lispusers/THINFILES +++ b/lispusers/THINFILES @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Aug-2021 20:46:55"  -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;5 8653 - changes to%: (FNS FB.THINCOMMAND) +(FILECREATED " 9-Oct-2021 00:35:17"  +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;11 8621 - previous date%: " 8-Aug-2021 15:05:08" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;4) + changes to%: (FNS FB.THINP) + + previous date%: " 7-Oct-2021 12:40:24" +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;8) (* ; " @@ -14,16 +15,16 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation. (PRETTYCOMPRINT THINFILESCOMS) -(RPAQQ THINFILESCOMS [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) - FILEBROWSER)) - (FNS FB.THINCOMMAND FB.THINP) - (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS* - '(SYSOUT DCOM DATABASE LCOM DFASL MCOM - MFASL DRIBBLE] - (THINNAMES NIL)) - (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND +(RPAQQ THINFILESCOMS + [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + FILEBROWSER)) + (FNS FB.THINCOMMAND FB.THINP) + (INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS* + '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE] + (THINNAMES NIL)) + (APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND "Delvers non-source files and removes all but the last source file of each day." - ]) + ]) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) @@ -116,29 +117,33 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation. (FB.PROMPTWPRINT FBROWSER T "Done, " NDELETED " files marked for deletion."]) (FB.THINP - [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY) - (* ; "Edited 8-Aug-2021 15:05 by rmk:") + [LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY) + (* ; "Edited 9-Oct-2021 00:35 by rmk:") + (SETQ FILENAME (U-CASE FILENAME)) (COND - ((FMEMB (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION)) - THINEXTENSIONS) (* ; - "always delver files that can be reconstructed from the source.") - T) - ((AND THINNAMES (EQMEMB (U-CASE (FILENAMEFIELD FILENAME 'NAME)) - THINNAMES)) - T) - (OLDESTVERSION? (* ; - "don't delete the oldest version of source files.") + [(OR (EQMEMB (FILENAMEFIELD FILENAME 'EXTENSION) + THINEXTENSIONS) + (FIND TN (FN _ (FILENAMEFIELD FILENAME 'NAME)) + (FE _ (FILENAMEFIELD FILENAME 'EXTENSION)) INSIDE THINNAMES + SUCHTHAT + + (* ;; "Separate extractions because period for null extension is confusing") + + (AND (EQ FN (FILENAMEFIELD TN 'NAME)) + (EQ FE (FILENAMEFIELD TN 'EXTENSION] + (OLDESTVERSION? (* ; + "don't delete the oldest version of source files.") NIL) - ((ILESSP AGE ONEDAY) (* ; - "don't delete anything written within 24 hours.") + ((ILESSP AGE ONEDAY) (* ; + "don't delete anything written within 24 hours.") NIL) ((ILESSP (ITIMES DELTATIMESTAMP 3) - ONEDAY) (* ; - "delete anything that occurs on the same day as something else (except for the first day)") + ONEDAY) (* ; + "delete anything that occurs on the same day as something else (except for the first day)") T) ((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30)) - (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.") + (* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.") T]) ) @@ -153,5 +158,5 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation. )) (PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1297 8184 (FB.THINCOMMAND 1307 . 6808) (FB.THINP 6810 . 8182))))) + (FILEMAP (NIL (1106 8152 (FB.THINCOMMAND 1116 . 6617) (FB.THINP 6619 . 8150))))) STOP diff --git a/lispusers/THINFILES.LCOM b/lispusers/THINFILES.LCOM index 1727e4d84bc171c5e271e27fbdedad1379f30520..6d8cb35871bcf179dced63ce00b7edb2f7feb505 100644 GIT binary patch delta 650 zcmaDWK2LIjhccIjo2QSfbC9cJh^vc&l7gkKe{zYgk%5t+f`NgRv8k1z`NXWSdP74^ z3`s+CD+2>11+Ju`)a3l!g3O%M6ou4^f}&zoD+MT#k7M}G(f>bA;eE1K*31C z%@s%)D!BP6OuoeKQE#dM@|SBwh^t?)r$5LV1v9XapQEp9u%-gTG*%`CRtHW7AV^|J zNe9tfAVQFl!6Wp;R-RDiEgT-9GFzB4g|_B7AmovlVS>Ue-YLt4w)#15GRY8NUhKUm zqs5zXk2llqdQTsOmJgfmc%g95`fNR$x#5(HGw3 zGz<+*6+rO~a;%%DtB;F_hmwYyr;n?1kgH>etBZn?p{1^4X}YeFfsvttp^=r5rImr<#O$zoGffOR z19K}Q6D5U`0r>s+EG00+LokQ!4`? zvY1%y#%Quxn`sB@