From 32461da7eb2fad9daa3f79893fb14e9c01436689 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 12 Oct 2021 16:49:35 -0700 Subject: [PATCH 1/3] 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@ Date: Tue, 12 Oct 2021 16:50:07 -0700 Subject: [PATCH 2/3] INSPECT: INSPECTCODE starts with DEFAULTFONT (presumably fixed pitch) --- sources/INSPECT | 105 ++++++++++++++++++++++--------------------- sources/INSPECT.LCOM | Bin 49478 -> 49517 bytes 2 files changed, 53 insertions(+), 52 deletions(-) diff --git a/sources/INSPECT b/sources/INSPECT index 6a1d6b35..22ef397e 100644 --- a/sources/INSPECT +++ b/sources/INSPECT @@ -1,11 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED "10-Jul-2021 20:31:23"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>INSPECT.;10 119111 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS RDTBL\NONOTHERCODES) +(FILECREATED "11-Oct-2021 14:04:22"  +{DSK}kaplan>Local>medley3.5>git-medley>sources>INSPECT.;11 119118 - previous date%: "10-Jul-2021 20:20:35" -{DSK}kaplan>Local>medley3.5>git-medley>sources>INSPECT.;9) + changes to%: (FNS \TEDIT.INSPECTCODE) + + previous date%: "10-Jul-2021 20:31:23" +{DSK}kaplan>Local>medley3.5>git-medley>sources>INSPECT.;10) (* ; " @@ -16,7 +17,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (RPAQQ INSPECTCOMS [(COMS - (* ;; "functions to implement an item window. An ITEM window is a window that contains SELECTABLEITEMS. An item from the window is selected using the left button. The middle button will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum. It is used by the inspector.") + (* ;; "functions to implement an item window. An ITEM window is a window that contains SELECTABLEITEMS. An item from the window is selected using the left button. The middle button will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum. It is used by the inspector.") (FNS INSPECTW.CREATE INSPECTW.REPAINTFN INSPECTW.REDISPLAY \INSPECTW.VALUE.MARGIN INSPECTW.REPLACE INSPECTW.SELECTITEM \INSPECTW.REDISPLAYPROP INSPECTW.FETCH @@ -33,7 +34,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (MAXINSPECTCDRLEVEL 50) MinSpaceBetweenProperyAndValue MaxInspectorPropertyValueWidth MaxValueLeftMargin PropertyLeftMargin)) - (COMS (* ; "functions for the inspector") + (COMS (* ; "functions for the inspector") (FNS INSPECT \APPLYINSPECTMACRO INSPECT/BITMAP INSPECT/DATATYPE INSPECTABLEFIELDNAMES REMOVEDUPS INSPECT/ARRAY INSPECT/TOP/LEVEL/LIST INSPECT/PROPLIST NONSYSPROPNAMES INSPECT/LISTP ALISTP PROPLISTP INSPECT/ALIST ASSOCGET /ASSOCPUT INSPECT/PLIST @@ -51,16 +52,16 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (MaxInspectorWindowHeight 606)) (VARS INSPECTPRINTLEVEL) - (* ;; "To deal with profiles in spawned processes") + (* ;; "To deal with profiles in spawned processes") (MACROS EVAL.AS.PROCESS.WITH.PROFILE WITH-INSPECTOR-ENV)) - (COMS (* ; "Atom inspector") + (COMS (* ; "Atom inspector") (FNS INSPECT/ATOM SELECT.ATOM.ASPECT INSPECT/AS/FUNCTION SELECT.FNS.EDITOR)) - (COMS (* ; "Compiled code inspector") + (COMS (* ; "Compiled code inspector") (FNS INSPECTCODE \TEDIT.INSPECTCODE \INSPECT/CODE/RESHAPEFN \INSPECT/CODE/REPAINTFN)) - (COMS (* ; "Hash table inspector") + (COMS (* ; "Hash table inspector") (FNS INSPECT/HARRAYP HARRAYKEYS INSPECTW.GETHASH INSPECTW.PUTHASH)) - [COMS (* ; "Readtable, termtable inspectors") + [COMS (* ; "Readtable, termtable inspectors") (FNS RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP GETTTBLPROP SETTTBLPROP) (ADDVARS (INSPECTMACROS (READTABLEP RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP) (TERMTABLEP (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL RAISE @@ -69,7 +70,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31) GETTTBLPROP SETTTBLPROP] - (COMS (* ; "Hunk inspector") + (COMS (* ; "Hunk inspector") (FNS INSPECT/AS/BLOCKRECORD INSPECT/TYPELESS LIST-ALL-BLOCKRECORDS INSPECT/HUNK \INSPECT.DATATYPE.RAW.FETCH \INSPECT.FETCH.8 \INSPECT.FETCH.32 \INSPECT.FETCH.CHAR \INSPECT.FETCH.FATCHAR \INSPECT.FETCH.PTR \INSPECT.STORE.8 \INSPECT.STORE.16 @@ -1720,7 +1721,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (\INSPECT/CODE/RESHAPEFN WINDOW]) (\TEDIT.INSPECTCODE - [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 3-Feb-87 16:56 by jop") + [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 11-Oct-2021 14:04 by rmk:") (PROG ((STREAM (OPENSTREAM '{NODIRCORE} 'BOTH)) WINDOW SEL) (APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE)) @@ -1737,7 +1738,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (fetch (COMPILED-CLOSURE FRAMENAME) of FN] - NIL NIL '(READONLY T PROMPTWINDOW DON'T] + NIL NIL `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT] (COND ((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1))) (* ; "Highlight location of PC") @@ -2146,40 +2147,40 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero (PUTPROPS INSPECT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991 1993 1995 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6999 42727 (INSPECTW.CREATE 7009 . 11764) (INSPECTW.REPAINTFN 11766 . 17302) ( -INSPECTW.REDISPLAY 17304 . 26176) (\INSPECTW.VALUE.MARGIN 26178 . 26581) (INSPECTW.REPLACE 26583 . -27291) (INSPECTW.SELECTITEM 27293 . 28283) (\INSPECTW.REDISPLAYPROP 28285 . 30715) (INSPECTW.FETCH -30717 . 31140) (INSPECTW.PROPERTIES 31142 . 31783) (DECODE.WINDOW.ARG 31785 . 33513) ( -DEFAULT.INSPECTW.PROPCOMMANDFN 33515 . 35533) (DEFAULT.INSPECTW.VALUECOMMANDFN 35535 . 36793) ( -DEFAULT.INSPECTW.TITLECOMMANDFN 36795 . 38485) (\SELITEM.FROM.PROPERTY 38487 . 38929) ( -\INSPECT.COMPUTE.TITLE 38931 . 40057) (LEVELEDFORM 40059 . 40778) (MAKEWITHINREGION 40780 . 42725)) ( -42728 60029 (ITEMW.REPAINTFN 42738 . 43958) (\ITEM.WINDOW.BUTTON.HANDLER 43960 . 44375) ( -\ITEM.WINDOW.SELECTION.HANDLER 44377 . 47044) (\INSPECTW.COMMAND.HANDLER 47046 . 51047) ( -ITEM.WINDOW.SET.STACK.ARG 51049 . 53253) (REPLACESTKARG 53255 . 54354) (IN/ITEM? 54356 . 55238) ( -\ITEMW.DESELECTITEM 55240 . 55504) (\ITEMW.SELECTITEM 55506 . 55768) (\ITEMW.CLEARSELECTION 55770 . -56125) (\ITEMW.FLIPITEM 56127 . 56600) (PRINTANDBOX 56602 . 59111) (PRINTATBOX 59113 . 59630) ( -ITEMOFPROPERTYVALUE 59632 . 60027)) (60030 63635 (\ITEM.WINDOW.COPY.HANDLER 60040 . 61761) ( -\ITEMW.FLIPCOPY 61763 . 62222) (BKSYSBUF.GENERAL 62224 . 63633)) (64027 86502 (INSPECT 64037 . 68300) -(\APPLYINSPECTMACRO 68302 . 69284) (INSPECT/BITMAP 69286 . 70321) (INSPECT/DATATYPE 70323 . 73566) ( -INSPECTABLEFIELDNAMES 73568 . 74089) (REMOVEDUPS 74091 . 74296) (INSPECT/ARRAY 74298 . 75335) ( -INSPECT/TOP/LEVEL/LIST 75337 . 76296) (INSPECT/PROPLIST 76298 . 77273) (NONSYSPROPNAMES 77275 . 77571) - (INSPECT/LISTP 77573 . 77895) (ALISTP 77897 . 78106) (PROPLISTP 78108 . 78748) (INSPECT/ALIST 78750 - . 79105) (ASSOCGET 79107 . 79318) (/ASSOCPUT 79320 . 79585) (INSPECT/PLIST 79587 . 79950) ( -INSPECT/TYPERECORD 79952 . 80192) (INSPECT/AS/RECORD 80194 . 81318) (SELECT.LIST.INSPECTOR 81320 . -83365) (STANDARDEDITE 83367 . 83650) (NTHTOPLEVELELT 83652 . 83968) (SETNTHTOPLEVELELT 83970 . 84730) -(DEDITE 84732 . 84939) (FINDRECDECL 84941 . 85524) (FINDSYSRECDECL 85526 . 85927) ( -MAKE-INSPECTOR-PROFILE 85929 . 86314) (CONFIRM-SET 86316 . 86500)) (88396 96485 (INSPECT/ATOM 88406 . -92386) (SELECT.ATOM.ASPECT 92388 . 93532) (INSPECT/AS/FUNCTION 93534 . 95820) (SELECT.FNS.EDITOR 95822 - . 96483)) (96526 101925 (INSPECTCODE 96536 . 97682) (\TEDIT.INSPECTCODE 97684 . 99642) ( -\INSPECT/CODE/RESHAPEFN 99644 . 101183) (\INSPECT/CODE/REPAINTFN 101185 . 101923)) (101963 103448 ( -INSPECT/HARRAYP 101973 . 102600) (HARRAYKEYS 102602 . 102981) (INSPECTW.GETHASH 102983 . 103210) ( -INSPECTW.PUTHASH 103212 . 103446)) (103497 109706 (RDTBL\NONOTHERCODES 103507 . 104527) (GETSYNTAXPROP - 104529 . 106027) (SETSYNTAXPROP 106029 . 107756) (GETTTBLPROP 107758 . 108676) (SETTTBLPROP 108678 . -109704)) (110185 118568 (INSPECT/AS/BLOCKRECORD 110195 . 111078) (INSPECT/TYPELESS 111080 . 112326) ( -LIST-ALL-BLOCKRECORDS 112328 . 112603) (INSPECT/HUNK 112605 . 115211) (\INSPECT.DATATYPE.RAW.FETCH -115213 . 115539) (\INSPECT.FETCH.8 115541 . 115690) (\INSPECT.FETCH.32 115692 . 115863) ( -\INSPECT.FETCH.CHAR 115865 . 116028) (\INSPECT.FETCH.FATCHAR 116030 . 116192) (\INSPECT.FETCH.PTR -116194 . 116365) (\INSPECT.STORE.8 116367 . 116673) (\INSPECT.STORE.16 116675 . 116975) ( -\INSPECT.STORE.32 116977 . 117412) (\INSPECT.STORE.CHAR 117414 . 117740) (\INSPECT.STORE.FATCHAR -117742 . 118064) (\INSPECT.STORE.PTR 118066 . 118413) (INSPECT/MAKE/CCODEP 118415 . 118566))))) + (FILEMAP (NIL (6986 42714 (INSPECTW.CREATE 6996 . 11751) (INSPECTW.REPAINTFN 11753 . 17289) ( +INSPECTW.REDISPLAY 17291 . 26163) (\INSPECTW.VALUE.MARGIN 26165 . 26568) (INSPECTW.REPLACE 26570 . +27278) (INSPECTW.SELECTITEM 27280 . 28270) (\INSPECTW.REDISPLAYPROP 28272 . 30702) (INSPECTW.FETCH +30704 . 31127) (INSPECTW.PROPERTIES 31129 . 31770) (DECODE.WINDOW.ARG 31772 . 33500) ( +DEFAULT.INSPECTW.PROPCOMMANDFN 33502 . 35520) (DEFAULT.INSPECTW.VALUECOMMANDFN 35522 . 36780) ( +DEFAULT.INSPECTW.TITLECOMMANDFN 36782 . 38472) (\SELITEM.FROM.PROPERTY 38474 . 38916) ( +\INSPECT.COMPUTE.TITLE 38918 . 40044) (LEVELEDFORM 40046 . 40765) (MAKEWITHINREGION 40767 . 42712)) ( +42715 60016 (ITEMW.REPAINTFN 42725 . 43945) (\ITEM.WINDOW.BUTTON.HANDLER 43947 . 44362) ( +\ITEM.WINDOW.SELECTION.HANDLER 44364 . 47031) (\INSPECTW.COMMAND.HANDLER 47033 . 51034) ( +ITEM.WINDOW.SET.STACK.ARG 51036 . 53240) (REPLACESTKARG 53242 . 54341) (IN/ITEM? 54343 . 55225) ( +\ITEMW.DESELECTITEM 55227 . 55491) (\ITEMW.SELECTITEM 55493 . 55755) (\ITEMW.CLEARSELECTION 55757 . +56112) (\ITEMW.FLIPITEM 56114 . 56587) (PRINTANDBOX 56589 . 59098) (PRINTATBOX 59100 . 59617) ( +ITEMOFPROPERTYVALUE 59619 . 60014)) (60017 63622 (\ITEM.WINDOW.COPY.HANDLER 60027 . 61748) ( +\ITEMW.FLIPCOPY 61750 . 62209) (BKSYSBUF.GENERAL 62211 . 63620)) (64014 86489 (INSPECT 64024 . 68287) +(\APPLYINSPECTMACRO 68289 . 69271) (INSPECT/BITMAP 69273 . 70308) (INSPECT/DATATYPE 70310 . 73553) ( +INSPECTABLEFIELDNAMES 73555 . 74076) (REMOVEDUPS 74078 . 74283) (INSPECT/ARRAY 74285 . 75322) ( +INSPECT/TOP/LEVEL/LIST 75324 . 76283) (INSPECT/PROPLIST 76285 . 77260) (NONSYSPROPNAMES 77262 . 77558) + (INSPECT/LISTP 77560 . 77882) (ALISTP 77884 . 78093) (PROPLISTP 78095 . 78735) (INSPECT/ALIST 78737 + . 79092) (ASSOCGET 79094 . 79305) (/ASSOCPUT 79307 . 79572) (INSPECT/PLIST 79574 . 79937) ( +INSPECT/TYPERECORD 79939 . 80179) (INSPECT/AS/RECORD 80181 . 81305) (SELECT.LIST.INSPECTOR 81307 . +83352) (STANDARDEDITE 83354 . 83637) (NTHTOPLEVELELT 83639 . 83955) (SETNTHTOPLEVELELT 83957 . 84717) +(DEDITE 84719 . 84926) (FINDRECDECL 84928 . 85511) (FINDSYSRECDECL 85513 . 85914) ( +MAKE-INSPECTOR-PROFILE 85916 . 86301) (CONFIRM-SET 86303 . 86487)) (88383 96472 (INSPECT/ATOM 88393 . +92373) (SELECT.ATOM.ASPECT 92375 . 93519) (INSPECT/AS/FUNCTION 93521 . 95807) (SELECT.FNS.EDITOR 95809 + . 96470)) (96513 101932 (INSPECTCODE 96523 . 97669) (\TEDIT.INSPECTCODE 97671 . 99649) ( +\INSPECT/CODE/RESHAPEFN 99651 . 101190) (\INSPECT/CODE/REPAINTFN 101192 . 101930)) (101970 103455 ( +INSPECT/HARRAYP 101980 . 102607) (HARRAYKEYS 102609 . 102988) (INSPECTW.GETHASH 102990 . 103217) ( +INSPECTW.PUTHASH 103219 . 103453)) (103504 109713 (RDTBL\NONOTHERCODES 103514 . 104534) (GETSYNTAXPROP + 104536 . 106034) (SETSYNTAXPROP 106036 . 107763) (GETTTBLPROP 107765 . 108683) (SETTTBLPROP 108685 . +109711)) (110192 118575 (INSPECT/AS/BLOCKRECORD 110202 . 111085) (INSPECT/TYPELESS 111087 . 112333) ( +LIST-ALL-BLOCKRECORDS 112335 . 112610) (INSPECT/HUNK 112612 . 115218) (\INSPECT.DATATYPE.RAW.FETCH +115220 . 115546) (\INSPECT.FETCH.8 115548 . 115697) (\INSPECT.FETCH.32 115699 . 115870) ( +\INSPECT.FETCH.CHAR 115872 . 116035) (\INSPECT.FETCH.FATCHAR 116037 . 116199) (\INSPECT.FETCH.PTR +116201 . 116372) (\INSPECT.STORE.8 116374 . 116680) (\INSPECT.STORE.16 116682 . 116982) ( +\INSPECT.STORE.32 116984 . 117419) (\INSPECT.STORE.CHAR 117421 . 117747) (\INSPECT.STORE.FATCHAR +117749 . 118071) (\INSPECT.STORE.PTR 118073 . 118420) (INSPECT/MAKE/CCODEP 118422 . 118573))))) STOP diff --git a/sources/INSPECT.LCOM b/sources/INSPECT.LCOM index 6c0070ceec3d5c488e6aae03745f666faab36ead..0207bbf86208aeb5c2c1daabba0d450a9408fdf3 100644 GIT binary patch delta 1101 zcma)+OH30{6ozRLFtgDFLIea3qhLz{%pF>2i>cPmOq^I|N@pt1V3C)P1dU)~qWFpl zxG>S&ory-bgz_qn(w0|@ZZwj(QDb**bwOg>`8XFFG0}y0@%5i`?z#7$bMN%U?d;FD zv+paFc8;?tYC!gfWS=QZz!OrV_m0$vf=GZkJc7d`iVv=5uuI1qq8Yiet2dFbmI>F)#XABz#f+yBE24_77Q#OUGh zaQ~%Y@A;mKw9YEj5ds_`ZbDqpd!}b-uzwgvE>wEJrf3HIZIFJo@bso7kCt1HT8R*g zSl`_#1O=QR$%-!=Fcn=h?U0quu~6^WxzfQb9A~$=gYcQ+?LnhsZJi=%fMD2cRW(U( z4Tkg}5VxDHrfRZ;4=xw{YLljintcJaL-zYZvWW?jNf@$e$k;KbBNM<<2}r$*M#hgv zIGc#?Xv%G->en?8g$7_k(QqGDkcpGV1_;Ost}8l#y#!!aK+?5COgR9ZH3u^;@o-## z2anl6JAFIen9tep&|SdS{2n}&@475p?D}1^g6C|Zps%F`exG!+0XCaoXFt`@)C64Y z%fwBKg`<}z`;i|edytmuGTIsSp?VZ$&p)DJ)|rAfGI-+T6un{iL2) zc`k@f!Oqd{WEmz$llzemlWbx-SwuJIa&zkISw5XSh%rlwEqWluOpc`nc5!x0ZKYUu zjTOd)l`3Ri1e(n!j|PG`hJaVwPo$N}x@#^76#{M91Q%wzUKLJ{xMxFow delta 1036 zcma)*O-vJ86vt_6MR^$$V^!1$$MI{rpw7Le^h0Cb(9USdFjJDH}_+& z?{Tm1n!%yQu$^Yjg_>M4nGIGcM%vVqj;^_S3S_3%HJv+I$5qaNtBEj6@NnTowptB> z4Dp}#c!I|g^=jc|7<;Y-_8&V1va!cB;pd=GC?rE?{%lt#RQ)155|)3by$rbAtA(J7 zu{dK44j;{*I?{Cp&Ys?!0L8Gf;H2C}v)!^S+uf}@Njs%y@vTSpivc3I%-iUR7ai}b z%Zr0h@yK6+fA$^spRS;VPx^8)i*v~Aaa+??%5Kd#b_Q590x8`{TY8F|hI-Vlu9hQF zpc_iNp{(v^brV=vofjxD1&r0>`K!CPNeYXJ$ef!_+7_@F2VodwMn%F8J;K4%4HxD9 zXjD>w@p_Q!7M2W5je$b1lCmwc4P2muHD~4z2_$ZHgLtw(=8>@GN_BC%f5!$gzuX3o zR9ttb$3xD)ce{w*fjrtuE%pv*QC+eYjiE-e z`iEMG`Eo6O848mX8a_z;d$^nUY4{K^ckcjk>|Psj`N(17xsiRuXCtC%w77Rp58#dB zF0$SiZDQhn9v@x^;L!andA`whV#lbc`D9dN)s;k@LaCGZxg?bKu@2&!|5xLSF;QXD zxai$CF4TA9BCdIY@~_X<;PZ)H*mG+oh9(`7FHMT;xH)MBCB?~TEiKTj< zakMs5-%D>8R@H?7I{J!55%Q6hmCE@v%ol6%V%fjocZ>x7;3DdKSDb>*+0I`)0&w|CMq$GqaSe zuch`X@dr8ZFwhG;;3VcBh$??gY^RCIsGSv8P7`}6;_3LR%HZ6R@WX8PI*G;O5g^3r OBeNKRGiq(6P3ap@rZ-^# From 588835603c2b23a7138bc90b97609a5c9deee542 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 12 Oct 2021 22:35:58 -0700 Subject: [PATCH 3/3] lispusers/TEDIT-PF-SEE: Explicitly give up TTY process on close I'm not sure why the READONLY TEDIT-SEE windows get the TTY process, that may be the underlying problem. But at least here I now make sure that the if the window is the tty process on closing, it gives it back to the exec. Otherwise, the window pops back up if there is input (even wheel scroll interrupts) before the user clicks somewhere else --- lispusers/TEDIT-PF-SEE | 24 ++++++++++++++---------- lispusers/TEDIT-PF-SEE.LCOM | Bin 3586 -> 3677 bytes 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/lispusers/TEDIT-PF-SEE b/lispusers/TEDIT-PF-SEE index 56bc5c8e..55630ce5 100644 --- a/lispusers/TEDIT-PF-SEE +++ b/lispusers/TEDIT-PF-SEE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "12-Oct-2021 15:22:43"  -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;28 6665 +(FILECREATED "12-Oct-2021 22:31:01"  +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;30 6975 - changes to%: (FNS PF-TEDIT) + changes to%: (FNS CLOSE-TYPED-WINDOW) - previous date%: "11-Oct-2021 10:07:08" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;26) + previous date%: "12-Oct-2021 15:22:43" +{DSK}kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;29) (PRETTYCOMPRINT TEDIT-PF-SEECOMS) @@ -108,7 +108,7 @@ WINDOW]) (CLOSE-TYPED-WINDOW - [LAMBDA (WINDOW ALL) (* ; "Edited 11-Oct-2021 09:09 by rmk:") + [LAMBDA (WINDOW ALL) (* ; "Edited 12-Oct-2021 22:30 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).") @@ -120,8 +120,12 @@ (WINDOWPROP W 'WINDOWTYPE) ) UNLESS (EQ W WINDOW) DO (CLOSEW W)) - ELSE (DSUBST (WINDOWPROP WINDOW 'REGION) - WINDOW TYPED-WINDOWS)))]) + ELSE (CL:WHEN (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS)) + (* ; + "Otherwise, the window pops up if you don't click away") + (TTY.PROCESS T)) + (DSUBST (WINDOWPROP WINDOW 'REGION) + WINDOW TYPED-WINDOWS)))]) WINDOW]) ) @@ -139,6 +143,6 @@ (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))))) + (FILEMAP (NIL (843 3913 (SEE-TEDIT 853 . 1263) (PF-TEDIT 1265 . 3911)) (3914 6663 (GET-TYPED-WINDOW +3924 . 5397) (CLOSE-TYPED-WINDOW 5399 . 6661))))) STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM index 8b90d1b6e60eab616edefb0b1a1d6a50d6bcadc3..70d0c477c6915144c3c19fbea042e3378b4097c8 100644 GIT binary patch delta 317 zcmZpYxhpdvnZwA)%Gl7#z;I%Aq=d17rh<~8k*k)eW-ft87gmGQ(o5<<>C z{=u%gA&~*DF1q2KelGsu6aVP3LlsOmWRydgRPAYJY@lFfX>O{JoROH9o?5I>lCNr| zpyB2htiXk7kfuUGQEFLcerd5nN@7W>s?}si#so&o&8AG&oCZbAj0{W;oD4v)Dbpbx zM00@%K}H6TO%aZp3^~9&K_*Y;t*pWu+$JyJR*%sGtDlw$ruIX0pJa0g<_4*C5Mak)Z-m($K)lWa1qOjsQ2^ z5LXw^kjZR}dhAf~$<~Z=lfN+rv05mYnVC)Az$mH@Q>Ljf76fM8RILpq4&0uh3Y3?7@D9XACzRB#CnbqWsIY|f*`1OSbZGa3K@