github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-25 20:06:44 +00:00
Code Issues Projects Releases Wiki Activity

Lispusers packages: MODERNIZE, THINFILES TEDIT-PF-SEE (new)

Browse Source 
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.
This commit is contained in:
rmkaplan
2021-10-12 16:49:35 -07:00
parent e222743f74
commit 32461da7eb
7 changed files with 292 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files

196
lispusers/MODERNIZE
View File

@@ -1,92 +1,91 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 8-Jul-2021 23:33:42" 
{DSK}<Users>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}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;28 25303
previous date%: " 3-Jul-2021 10:32:03"
{DSK}<Users>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}<Users>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

BIN
lispusers/MODERNIZE.LCOM
View File

Binary file not shown.

8
lispusers/MODERNIZE.TXT
View File

@@ -30,7 +30,7 @@ When the package is loaded, this behavior is installed for the following kinds o
The function MODERNWINDOW.SETUP establishes the new behavior for classes of windows:
(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE)
(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE TITLEPROPORTION)
ORIGFN is either the name of the BUTTONEVENTFN for a class of windows (e.g. \TEDIT.BUTTONEVENTFN for Tedit windows) or it is a function that creates windows of a particulate kind (e.g. SNAPW or ADD-EXEC).
@@ -60,7 +60,7 @@ Provided these capabilities are already loaded, the following window classes are
If it is not known or it is inconvenient to systematically upgrade a button function or a window-creation function, the new behavior can be provided after a particular window has been created, by invoking
(MODERNWINDOW WINDOW ANYWHERE)
(MODERNWINDOW WINDOW ANYWHERE TITLEPROPORTION)
This saves the windows existing BUTTONEVENTFN as a window property PREMODERN-BUTTONEVENTFN, and installs a simple stub function in its place.
@@ -70,7 +70,9 @@ If things go awry:
(UNMODERNWINDOW WINDOW) restores a modernized window (via MACWINDOW) to its original state.
Known issue: Clicking at the bottom-right corner of Tedit windows sometimes doesn't catch the new behavior--there seems to be a conflict with Tedit's window-splitting conventions. Clicking a little further into the window seems more reliable.
Known issues:
Clicking at the bottom of an EXEC window running TTYIN is effective only when the input line is empty.

144
lispusers/TEDIT-PF-SEE Normal file
View File

@@ -0,0 +1,144 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Oct-2021 15:22:43" 
{DSK}<Users>kaplan>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}<Users>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

BIN
lispusers/TEDIT-PF-SEE.LCOM Normal file
View File

Binary file not shown.

67
lispusers/THINFILES
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Aug-2021 20:46:55" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;5 8653
changes to%: (FNS FB.THINCOMMAND)
(FILECREATED " 9-Oct-2021 00:35:17" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;11 8621
previous date%: " 8-Aug-2021 15:05:08"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;4)
changes to%: (FNS FB.THINP)
previous date%: " 7-Oct-2021 12:40:24"
{DSK}<Users>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

BIN
lispusers/THINFILES.LCOM
View File

Binary file not shown.