1
0
mirror of synced 2026-03-05 19:19:56 +00:00

Merge pull request #775 from Interlisp/rmk41--TEDIT-interprets-strings-as-filename

Rmk41  tedit interprets strings as filename
This commit is contained in:
rmkaplan
2022-06-04 15:23:14 -07:00
committed by GitHub
8 changed files with 280 additions and 278 deletions

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Dec-2021 20:50:54" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDIT.;30 142870
(FILECREATED "19-May-2022 22:46:25" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT.;37 143285
:CHANGES-TO (FNS TEDIT TEDIT-SEE)
:CHANGES-TO (FNS TEDITSTRING)
:PREVIOUS-DATE "28-Dec-2021 11:02:43"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDIT.;24)
:PREVIOUS-DATE " 5-May-2022 15:19:42"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT.;34)
(* ; "
@@ -31,12 +32,12 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
)
(GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE
TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES TEDIT.MAPPIECES
TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM \TEDIT.INCLUDE
\TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL \TEDIT.RESTARTFN
\TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS
\TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDITSTRING TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY
TEDIT.DELETE TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES
TEDIT.MAPPIECES TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM
\TEDIT.INCLUDE \TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL
\TEDIT.RESTARTFN \TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE
\TEDIT.DIFFUSE.PARALOOKS \TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
(P (MOVD? 'NILL 'OBJECTOUTOFTEDIT))
(* ;
 "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
@@ -250,22 +251,30 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
NIL])
(TEDIT
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ; "Edited 30-Dec-2021 20:50 by rmk")
(* ; "Edited 28-Dec-2021 00:12 by rmk")
(* ; "Edited 24-Dec-2021 19:21 by rmk")
(* ; "Edited 11-Jun-99 14:14 by rmk:")
(* ; "Edited 3-Jun-88 14:27 by jds")
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
(* ;; "Edited 31-Jan-2022 17:19 by rmk: String TEXT is a file name")
(* ;; "Edited 30-Dec-2021 20:50 by rmk")
(* ;; "Edited 28-Dec-2021 00:12 by rmk")
(* ;; "Edited 24-Dec-2021 19:21 by rmk")
(* ;; "Edited 11-Jun-99 14:14 by rmk:")
(* ;; "Edited 3-Jun-88 14:27 by jds")
(* ;; "User entry to the text editor. Takes an optional window to be used for editing")
(* ;; "DONTSPAWN => Don't try to create a new process for this edit.")
(PROG (PROC TEDITCREATEDWINDOW) (* ;
 "Include the default properties in the list.")
(PROG (PROC TEDITCREATEDWINDOW)
[COND
((AND TEXT (ATOM TEXT)) (* ;
((AND TEXT (OR (LITATOM TEXT)
(STRINGP TEXT))) (* ;
 "Make sure the file exists before trying to open the window.")
(SETQ TEXT (OPENFILE TEXT 'INPUT 'OLD '((TYPE TEXT]
(SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '((TYPE TEXT]
(CL:WHEN (AND WINDOW (OR (LITATOM WINDOW)
(REGIONP WINDOW)))
@@ -284,10 +293,9 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(NOT TEDIT.DEFAULT.WINDOW)
(\TEDIT.ACTIVE.WINDOWP TEDIT.DEFAULT.WINDOW))
(TEDIT.CREATEW (COND
((AND TEXT (ATOM TEXT))
(CONCAT
(TEXT (CONCAT
"Please specify an editing window for "
TEXT))
TEXT))
(T
"Please specify a region for the editing window."
))
@@ -336,11 +344,24 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(TTY.PROCESS PROC)))
(RETURN PROC])
(TEDITSTRING
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
(* ;;; "Edited 19-May-2022 22:46 by rmk: An interface function to replace calls to TEDIT when the text argument may be the string to be edited rather than the name of a file. This enables the transition that gets TEDIT aligned with the convention that strings, as well as litatoms, are file names")
(TEDIT (IF (STRINGP TEXT)
THEN (LET ((TSTRM (OPENTEXTSTREAM NIL NIL NIL PROPS)))
(PRIN3 TEXT TSTRM)
TSTRM)
ELSE TEXT)
WINDOW DONTSPAWN PROPS])
(TEDIT-SEE
[LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 30-Dec-2021 18:03 by rmk")
(* ; "Edited 16-Dec-2021 12:33 by rmk")
(* ; "Edited 13-Oct-2021 10:00 by rmk:")
(* ; "Edited 27-Feb-2021 20:07 by rmk:")
[LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 5-May-2022 15:18 by rmk")
(* ; "Edited 30-Dec-2021 18:03 by rmk")
(* ; "Edited 16-Dec-2021 12:33 by rmk")
(* ; "Edited 13-Oct-2021 10:00 by rmk:")
(* ; "Edited 27-Feb-2021 20:07 by rmk:")
(* ; "Edited 1-Feb-88 19:00 by bvm:")
(* ;; "See FILE in a scrollable READONLY TEDIT window. If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.")
@@ -359,8 +380,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(* ;; "Lisp source file")
(SETQ SEESTREAM (OPENTEXTSTREAM))
(DSPFONT DEFAULTFONT SEESTREAM)
(COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
(APPLY* (FUNCTION SEE)
STREAM SEESTREAM)
ELSE
(* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.")
@@ -2243,7 +2264,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(* ; "TEDIT Support information")
(RPAQQ TEDITSYSTEMDATE "30-Dec-2021 20:50:54")
(RPAQQ TEDITSYSTEMDATE "19-May-2022 22:46:25")
(RPAQ TEDITSUPPORT "TEditSupport.PA")
(DEFINEQ
@@ -2269,19 +2290,20 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
1992 1993 1995 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4336 118040 (\TEDIT2 4346 . 7097) (COERCETEXTOBJ 7099 . 15875) (TEDIT 15877 . 21230) (
TEDIT-SEE 21232 . 23716) (TEDIT.CHARWIDTH 23718 . 25742) (TEDIT.COPY 25744 . 34180) (TEDIT.DELETE
34182 . 34872) (TEDIT.DO.BLUEPENDINGDELETE 34874 . 37941) (TEDIT.INSERT 37943 . 43473) (TEDIT.KILL
43475 . 45032) (TEDIT.MAPLINES 45034 . 46433) (TEDIT.MAPPIECES 46435 . 47391) (TEDIT.MOVE 47393 .
57177) (TEDIT.QUIT 57179 . 59179) (TEDIT.STRINGWIDTH 59181 . 59852) (TEDIT.\INSERT 59854 . 61879) (
TEXTOBJ 61881 . 63006) (TEXTSTREAM 63008 . 64623) (\TEDIT.INCLUDE 64625 . 68525) (\TEDIT.INSERT.PIECES
68527 . 78442) (\TEDIT.MOVE.PIECEMAPFN 78444 . 80523) (\TEDIT.OBJECT.SHOWSEL 80525 . 84154) (
\TEDIT.RESTARTFN 84156 . 86151) (\TEDIT.CHARDELETE 86153 . 90115) (\TEDIT.COPY.PIECEMAPFN 90117 .
93342) (\TEDIT.DELETE 93344 . 100862) (\TEDIT.DIFFUSE.PARALOOKS 100864 . 103628) (\TEDIT.FOREIGN.COPY?
103630 . 107357) (\TEDIT.QUIT 107359 . 110505) (\TEDIT.WORDDELETE 110507 . 115340) (\TEDIT1 115342 .
118038)) (118154 118270 (\CREATE.TEDIT.RESTART.MENU 118164 . 118268)) (118369 122058 (PLCHAIN 118379
. 118653) (PRINTLINE 118655 . 121419) (SEEFILE 121421 . 122056)) (122099 141742 (TEDIT.INSERT.OBJECT
122109 . 131186) (TEDIT.EDIT.OBJECT 131188 . 133444) (TEDIT.FIND.OBJECT 133446 . 134339) (
TEDIT.FIND.OBJECT.SUBTREE 134341 . 135147) (TEDIT.PUT.OBJECT 135149 . 136808) (TEDIT.GET.OBJECT 136810
. 140009) (TEDIT.OBJECT.CHANGED 140011 . 141740)) (142020 142383 (MAKETEDITFORM 142030 . 142381)))))
(FILEMAP (NIL (4355 118455 (\TEDIT2 4365 . 7116) (COERCETEXTOBJ 7118 . 15894) (TEDIT 15896 . 20924) (
TEDITSTRING 20926 . 21540) (TEDIT-SEE 21542 . 24131) (TEDIT.CHARWIDTH 24133 . 26157) (TEDIT.COPY 26159
. 34595) (TEDIT.DELETE 34597 . 35287) (TEDIT.DO.BLUEPENDINGDELETE 35289 . 38356) (TEDIT.INSERT 38358
. 43888) (TEDIT.KILL 43890 . 45447) (TEDIT.MAPLINES 45449 . 46848) (TEDIT.MAPPIECES 46850 . 47806) (
TEDIT.MOVE 47808 . 57592) (TEDIT.QUIT 57594 . 59594) (TEDIT.STRINGWIDTH 59596 . 60267) (TEDIT.\INSERT
60269 . 62294) (TEXTOBJ 62296 . 63421) (TEXTSTREAM 63423 . 65038) (\TEDIT.INCLUDE 65040 . 68940) (
\TEDIT.INSERT.PIECES 68942 . 78857) (\TEDIT.MOVE.PIECEMAPFN 78859 . 80938) (\TEDIT.OBJECT.SHOWSEL
80940 . 84569) (\TEDIT.RESTARTFN 84571 . 86566) (\TEDIT.CHARDELETE 86568 . 90530) (
\TEDIT.COPY.PIECEMAPFN 90532 . 93757) (\TEDIT.DELETE 93759 . 101277) (\TEDIT.DIFFUSE.PARALOOKS 101279
. 104043) (\TEDIT.FOREIGN.COPY? 104045 . 107772) (\TEDIT.QUIT 107774 . 110920) (\TEDIT.WORDDELETE
110922 . 115755) (\TEDIT1 115757 . 118453)) (118569 118685 (\CREATE.TEDIT.RESTART.MENU 118579 . 118683
)) (118784 122473 (PLCHAIN 118794 . 119068) (PRINTLINE 119070 . 121834) (SEEFILE 121836 . 122471)) (
122514 142157 (TEDIT.INSERT.OBJECT 122524 . 131601) (TEDIT.EDIT.OBJECT 131603 . 133859) (
TEDIT.FIND.OBJECT 133861 . 134754) (TEDIT.FIND.OBJECT.SUBTREE 134756 . 135562) (TEDIT.PUT.OBJECT
135564 . 137223) (TEDIT.GET.OBJECT 137225 . 140424) (TEDIT.OBJECT.CHANGED 140426 . 142155)) (142435
142798 (MAKETEDITFORM 142445 . 142796)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Dec-2021 10:29:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;12 182752
(FILECREATED " 5-May-2022 15:12:26" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;18 183046
:CHANGES-TO (FNS \TEXTBIN \TEXTPEEKBIN)
:CHANGES-TO (FNS \TEXTINIT)
:PREVIOUS-DATE "22-Dec-2021 10:01:53"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;11)
:PREVIOUS-DATE "31-Jan-2022 22:04:01"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;14)
(* ; "
@@ -107,20 +107,22 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(RETURN NEWSTREAM])
(OPENTEXTSTREAM
[LAMBDA (TEXT WINDOW START END PROPS) (* ; "Edited 4-May-93 14:38 by jds")
[LAMBDA (TEXT WINDOW START END PROPS) (* ;
 "Edited 31-Jan-2022 17:25 by rmk: A string TEXT is converted here to a stream")
(* ; "Edited 4-May-93 14:38 by jds")
(* ;
 "Create a text-type STREAM to describe TEXT. Optionally, connect that to WINDOW for display.")
 "Create a text-type STREAM to describe TEXT. Optionally, connect that to WINDOW for display.")
(PROG* ([WAS-TEXTSTREAM (AND (type? STREAM TEXT)
(type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT]
[TEXTOBJ (COND
(WAS-TEXTSTREAM (* ;
 "If the guy gave us a text stream to edit, use its TEXTOBJ as ours.")
(create TEXTOBJ
reusing (fetch (TEXTSTREAM TEXTOBJ) of TEXT)
\INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 \INSERTPCVALID _ NIL))
 "If the guy gave us a text stream to edit, use its TEXTOBJ as ours.")
(create TEXTOBJ reusing (fetch (TEXTSTREAM TEXTOBJ) of TEXT)
\INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1
\INSERTPCVALID _ NIL))
((type? TEXTOBJ TEXT)
(create TEXTOBJ using TEXT \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1
\INSERTPCVALID _ NIL))
\INSERTPCVALID _ NIL))
(T (create TEXTOBJ]
(TEDIT.GET.FINISHEDFORMS NIL)
[PROPS (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)
@@ -129,18 +131,18 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(EQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ]
FONT SEL PCTB PC TEXTSTREAM OTEXTOBJ PROP CLEARGET? PARALOOKS PWINDOW)
(* ;
 "Remember if the textobj had a window already.")
 "Remember if the textobj had a window already.")
(replace (TEXTOBJ \WINDOW) of TEXTOBJ with (AND WINDOW (LIST WINDOW)))
(* ;
 "Necessary because some incoming object types depend on knowing where the window is.")
 "Necessary because some incoming object types depend on knowing where the window is.")
(replace (TEXTOBJ LINES) of TEXTOBJ with NIL)
(* ;; "This is here so if we re-OPENTEXTSTREAM an existing stream/window pair we don't get two sets of line descriptors")
(for PROPNAME in PROPS by (CDDR PROPNAME) as PROPVAL
in (CDR PROPS) by (CDDR PROPVAL) do (TEXTPROP TEXTOBJ PROPNAME PROPVAL)
) (* ;
 "Save the PROPS for later people who'd like to know them")
(for PROPNAME in PROPS by (CDDR PROPNAME) as PROPVAL in (CDR PROPS)
by (CDDR PROPVAL) do (TEXTPROP TEXTOBJ PROPNAME PROPVAL))
(* ;
 "Save the PROPS for later people who'd like to know them")
[SETQ FONT (COND
((type? CHARLOOKS (LISTGET PROPS 'FONT))
(LISTGET PROPS 'FONT))
@@ -152,38 +154,36 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(T (OR (LISTGET PROPS 'FONT)
DEFAULTFONT]
NIL TEXTOBJ] (* ;
"Find the default font for this session -- either what the guy tells us, or the global default font")
 "Find the default font for this session -- either what the guy tells us, or the global default font")
(SETQ PARALOOKS (LISTGET PROPS 'PARALOOKS))
(* ;; "Get the default paragraph looks. This must come before the first piece is created, so its fields can be filled in right.")
(replace (TEXTOBJ FMTSPEC) of TEXTOBJ
with (\TEDIT.UNIQUIFY.PARALOOKS [SETQ PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
(OR PARALOOKS
(create FMTSPEC
using
(replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS
[SETQ PARALOOKS
(\TEDIT.PARSE.PARALOOKS.LIST
(OR PARALOOKS (create FMTSPEC using
TEDIT.DEFAULT.FMTSPEC
]
TEXTOBJ))
TEXTOBJ))
[COND
[WAS-TEXTSTREAM (* ;
 "We got a TEXTOFD stream to edit; just use it")
 "We got a TEXTOFD stream to edit; just use it")
(SETQ OTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT))
(SETQ TEXTSTREAM TEXT)
(for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ)
(fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)
(fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)
(fetch (TEXTOBJ MOVESEL) of TEXTOBJ)
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
(fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)
(fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)
(fetch (TEXTOBJ MOVESEL) of TEXTOBJ)
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
do
(* ;; "Make all the selections point to the CURRENT textobj!")
(* ;; "Make all the selections point to the CURRENT textobj!")
(COND
((EQ OTEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELN))
(replace (SELECTION \TEXTOBJ) of SELN with TEXTOBJ))
(T (replace (SELECTION SET) of SELN with NIL)))
(replace (SELECTION ONFLG) of SELN with NIL))
(COND
((EQ OTEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELN))
(replace (SELECTION \TEXTOBJ) of SELN with TEXTOBJ))
(T (replace (SELECTION SET) of SELN with NIL)))
(replace (SELECTION ONFLG) of SELN with NIL))
(replace (TEXTSTREAM TEXTOBJ) of TEXTSTREAM with TEXTOBJ)
(replace (TEXTOBJ STREAMHINT) of TEXTOBJ with TEXTSTREAM)
(SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ))
@@ -193,106 +193,106 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(* ; "And mark it not changed.")
(COND
(FONT (* ;
 "If a new default font was specified, set it up.")
(replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ
with (\TEDIT.UNIQUIFY.CHARLOOKS FONT TEXTOBJ]
((type? TEXTOBJ TEXT) (* ;
 "We got a TEXTOBJ to edit; fill in the stream, since it might have been GC'd.")
 "If a new default font was specified, set it up.")
(replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (
\TEDIT.UNIQUIFY.CHARLOOKS
FONT TEXTOBJ]
((type? TEXTOBJ TEXT) (* ;
 "We got a TEXTOBJ to edit; fill in the stream, since it might have been GC'd.")
(SETQ TEXTSTREAM (replace (TEXTOBJ STREAMHINT) of TEXTOBJ
with (create TEXTSTREAM
TEXTOBJ _ TEXTOBJ)))
TEXTOBJ _ TEXTOBJ)))
(SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ))
(for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)))
(T (* ;
 "Otherwise, create a TEXTOFD to describe the text we're editing.-")
 "Otherwise, create a TEXTOFD to describe the text we're editing.-")
(CL:WHEN (AND TEXT (OR (LITATOM TEXT)
(STRINGP TEXT))) (* ; "rmk: Strings are now file names")
[SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '((TYPE TEXT])
(SETQ TEXTSTREAM (replace (TEXTOBJ STREAMHINT) of TEXTOBJ
with (create TEXTSTREAM
TEXTOBJ _ TEXTOBJ)))
[replace (TEXTOBJ PCTB) of TEXTOBJ
with (SETQ PCTB (TEDIT.BUILD.PCTB TEXT TEXTOBJ START END FONT PARALOOKS
(LISTGET PROPS 'CLEARGET]
TEXTOBJ _ TEXTOBJ)))
[replace (TEXTOBJ PCTB) of TEXTOBJ with (SETQ PCTB
(TEDIT.BUILD.PCTB TEXT TEXTOBJ START END
FONT PARALOOKS (LISTGET PROPS
'CLEARGET]
(* ;; "(setq pc (\\editelt pctb (add1 |\\FirstPieceOffset|)))")
(SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB)
0))
(for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM))
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (fetch (BTREENODE TOTLEN)
of PCTB]
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
with (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ
(replace (TEXTOBJ DEFAULTCHARLOOKS)
of TEXTOBJ with (
(replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (fetch (BTREENODE TOTLEN) of PCTB]
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS
(\TEDIT.CARETLOOKS.VERIFY
TEXTOBJ
(replace (TEXTOBJ DEFAULTCHARLOOKS)
of TEXTOBJ with (
\TEDIT.UNIQUIFY.CHARLOOKS
FONT TEXTOBJ)))
TEXTOBJ))
(replace (TEXTOBJ CARET) of TEXTOBJ with (create
TEDITCARET
TCCARETDS _
(AND WINDOW (WINDOWPROP WINDOW
'DSP))
TCFORCEUP _ T))
FONT TEXTOBJ)))
TEXTOBJ))
(replace (TEXTOBJ CARET) of TEXTOBJ with (create TEDITCARET
TCCARETDS _ (AND WINDOW
(WINDOWPROP WINDOW
'DSP))
TCFORCEUP _ T))
(replace (TEXTOBJ TXTREADONLY) of TEXTOBJ with (LISTGET PROPS 'READONLY))
(replace (TEXTOBJ TXTTERMSA) of TEXTOBJ with (AND (SETQ PROP
(LISTGET PROPS 'TERMTABLE))
(fetch TERMSA
of PROP)))
(replace (TEXTOBJ TXTTERMSA) of TEXTOBJ with (AND (SETQ PROP (LISTGET PROPS 'TERMTABLE))
(fetch TERMSA of PROP)))
(replace (TEXTOBJ TXTRTBL) of TEXTOBJ with (LISTGET PROPS 'READTABLE))
(replace (TEXTOBJ TXTWTBL) of TEXTOBJ with (LISTGET PROPS 'BOUNDTABLE))
[COND
((LISTGET PROPS 'PAGEFORMAT) (* ;
 "A default page formatting was supplied. Impose it on the document.")
 "A default page formatting was supplied. Impose it on the document.")
(TEDIT.PAGEFORMAT TEXTOBJ (LISTGET PROPS 'PAGEFORMAT]
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(SETQ PROP (LISTGET PROPS 'SEL)) (* ; "Initial Selection, if any.")
(COND
((EQ PROP 'DON'T) (* ;
 "A SEL prop of DON'T means don't make an initial selection")
 "A SEL prop of DON'T means don't make an initial selection")
(replace (SELECTION SET) of SEL with NIL))
((type? SELECTION PROP) (* ;
 "We came in with an explicit initial sel. Set it up.")
((type? SELECTION PROP) (* ;
 "We came in with an explicit initial sel. Set it up.")
(\COPYSEL PROP SEL)
(replace (SELECTION SET) of SEL with T)
(replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ))
((AND (fetch (SELECTION SET) of SEL)
(NOT PROP)) (* ;
 "If we came into this with a valid selection, highlight it.")
 "If we came into this with a valid selection, highlight it.")
(replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ))
(T (* ;
 "Starting without a selection; let's start with a point selection before the first character.")
 "Starting without a selection; let's start with a point selection before the first character.")
(replace (SELECTION CH#) of SEL with (COND
((FIXP PROP))
(PROP (CAR PROP))
(1)))
((FIXP PROP))
(PROP (CAR PROP))
(1)))
(replace (SELECTION CHLIM) of SEL with (COND
((FIXP PROP))
(PROP (IPLUS (CAR PROP)
(CADR PROP)))
(1)))
((FIXP PROP))
(PROP (IPLUS (CAR PROP)
(CADR PROP)))
(1)))
(replace (SELECTION DCH) of SEL with (COND
((FIXP PROP)
0)
(PROP (CADR PROP))
(0)))
((FIXP PROP)
0)
(PROP (CADR PROP))
(0)))
(replace (SELECTION DX) of SEL with 0)
(replace (SELECTION POINT) of SEL with 'LEFT)
(replace (SELECTION SELKIND) of SEL with 'CHAR)
(replace (SELECTION SET) of SEL with (NOT (fetch (TEXTOBJ
TXTREADONLY)
of TEXTOBJ)))
(replace (SELECTION SET) of SEL with (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ)))
[COND
((fetch (SELECTION SET) of SEL) (* ;
 "If there's an initial selection, it implies initial caret looks, too.")
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS
TEXTOBJ SEL]
((fetch (SELECTION SET) of SEL) (* ;
 "If there's an initial selection, it implies initial caret looks, too.")
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL
]
(COND
((AND WINDOW (NOT TEXTOBJ.WINDOW.VALID)) (* ;
 "Only if there's a window to display it in:")
 "Only if there's a window to display it in:")
(replace (TEXTOBJ \WINDOW) of TEXTOBJ with NIL)
(\TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS)
(* ;
 "Set up the window, and display the initial text.")
 "Set up the window, and display the initial text.")
)
((SETQ PWINDOW (LISTGET PROPS 'PROMPTWINDOW))
@@ -300,10 +300,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ with PWINDOW)))
(\SETUPGETCH (create EDITMARK
PC _ (\GETBASEPTR (\FIRSTNODE PCTB)
0)
PCOFF _ 0
PCNO _ 1)
PC _ (\GETBASEPTR (\FIRSTNODE PCTB)
0)
PCOFF _ 0
PCNO _ 1)
TEXTOBJ) (* ; "Set the file ptr to 0")
(RETURN TEXTSTREAM])
@@ -676,9 +676,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(RETURN PC])
(\TEXTINIT
[LAMBDA NIL (* ; "Edited 7-Oct-2021 08:40 by rmk:")
[LAMBDA NIL (* ; "Edited 5-May-2022 15:12 by rmk")
(* ; "Edited 7-Oct-2021 08:40 by rmk:")
(* ;
 "Create the FDEV and STREAM prototypes for TEXT streams.")
 "Create the FDEV and STREAM prototypes for TEXT streams.")
(* ;; "TEXT streams make use of the following STREAM fields:")
@@ -700,7 +701,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(* ;; "(FW8 WORD)")
(SETQ \TEXTIMAGEOPS (create IMAGEOPS
[SETQ \TEXTIMAGEOPS (create IMAGEOPS
IMAGETYPE _ 'TEXT
IMXPOSITION _ (FUNCTION \TEXTDSPXPOSITION)
IMYPOSITION _ (FUNCTION \TEXTDSPYPOSITION)
@@ -711,7 +712,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
IMFONTCREATE _ 'DISPLAY
IMLINEFEED _ (FUNCTION \TEXTDSPLINEFEED)
IMCHARWIDTH _ (FUNCTION \TEXTDSPCHARWIDTH)
IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH)))
IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH)
IMSCALE _ (FUNCTION (LAMBDA NIL 1]
(SETQ \TEXTFDEV (create FDEV
DEVICENAME _ 'TEXT
RESETABLE _ T
@@ -780,9 +782,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(LET ((STREAM (STREAM-ERROR-STREAM CONDITION)))
(COND
[(AND (BOUNDP 'ERRORPOS)
(TEXTSTREAMP STREAM))
(* ;
 "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")
(TEXTSTREAMP STREAM)) (* ;
 "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")
(LET ((XCL::RESULT (REOPENTEXTSTREAM STREAM)))
(CL:WHEN XCL::RESULT
(ENVAPPLY (STKNAME ERRORPOS)
@@ -791,7 +792,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
ERRORPOS T T))]
(*TEDIT-OLD-STREAM-ERROR-HANDLER*
(* ;
 "Some other kind of stream, so punt to the old handler (if there is one):")
 "Some other kind of stream, so punt to the old handler (if there is one):")
(APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
(\TEXTMARK
@@ -2721,25 +2722,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989
1990 1991 1993 1994 1995 1999 2000 2001 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2992 53117 (COPYTEXTSTREAM 3002 . 6124) (OPENTEXTSTREAM 6126 . 21003) (REOPENTEXTSTREAM
21005 . 21427) (TEDIT.STREAMCHANGEDP 21429 . 21727) (TEXTSTREAMP 21729 . 22043) (TXTFILE 22045 .
22490) (\DELETECH 22492 . 33748) (\SETUPGETCH 33750 . 41029) (\TEDIT.REOPEN.STREAM 41031 . 42881) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42883 . 45321) (\TEXTINIT 45323 . 51010) (\TEXTMARK 51012 . 51760) (
\TEXTTTYBOUT 51762 . 53115)) (53118 78550 (\INSERTCH 53128 . 76854) (\INSERTCR 76856 . 78548)) (78616
98932 (\CHTOPC 78626 . 79815) (\CHTOPCNO 79817 . 81079) (\CLEARPCTB 81081 . 81877) (
\CREATEPIECEORSTREAM 81879 . 84853) (\DELETEPIECE 84855 . 85768) (\FINDPIECE 85770 . 86136) (
\INSERTPIECE 86138 . 89148) (\MAKEPCTB 89150 . 91065) (\SPLITPIECE 91067 . 98026) (\INSERT.FIRST.PIECE
98028 . 98930)) (98984 123222 (\TEXTCLOSEF 98994 . 100221) (\TEXTCLOSEF-SUBTREE 100223 . 100929) (
\TEXTDSPFONT 100931 . 101923) (\TEXTEOFP 101925 . 103284) (\TEXTGETEOFPTR 103286 . 103496) (
\TEXTGETFILEPTR 103498 . 105561) (\TEXTOPENF 105563 . 106393) (\TEXTOPENF-SUBTREE 106395 . 107196) (
\TEXTOUTCHARFN 107198 . 107546) (\TEXTBACKFILEPTR 107548 . 113449) (\TEXTBOUT 113451 . 116799) (
\TEDITOUTCCODEFN 116801 . 118067) (\TEXTSETEOF 118069 . 118578) (\TEXTSETFILEPTR 118580 . 119805) (
\TEXTDSPXPOSITION 119807 . 120664) (\TEXTDSPYPOSITION 120666 . 121211) (\TEXTLEFTMARGIN 121213 .
121696) (\TEXTRIGHTMARGIN 121698 . 122634) (\TEXTDSPCHARWIDTH 122636 . 122874) (\TEXTDSPSTRINGWIDTH
122876 . 123116) (\TEXTDSPLINEFEED 123118 . 123220)) (123223 161060 (\TEXTBIN 123233 . 144112) (
\TEDIT.TEXTBIN.STRINGSETUP 144114 . 149827) (\TEDIT.TEXTBIN.FILESETUP 149829 . 156215) (
\TEDIT.TEXTBIN.NEW.PAGE 156217 . 161058)) (161061 176823 (\TEXTPEEKBIN 161071 . 172564) (
\TEDIT.PEEKBIN.NEW.PAGE 172566 . 176821)) (176861 182079 (CGETTEXTPROP 176871 . 177347) (CTEXTPROP
177349 . 179693) (GETTEXTPROP 179695 . 180290) (PUTTEXTPROP 180292 . 181617) (TEXTPROP 181619 . 182077
(FILEMAP (NIL (2980 53411 (COPYTEXTSTREAM 2990 . 6112) (OPENTEXTSTREAM 6114 . 21173) (REOPENTEXTSTREAM
21175 . 21597) (TEDIT.STREAMCHANGEDP 21599 . 21897) (TEXTSTREAMP 21899 . 22213) (TXTFILE 22215 .
22660) (\DELETECH 22662 . 33918) (\SETUPGETCH 33920 . 41199) (\TEDIT.REOPEN.STREAM 41201 . 43051) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43053 . 45491) (\TEXTINIT 45493 . 51304) (\TEXTMARK 51306 . 52054) (
\TEXTTTYBOUT 52056 . 53409)) (53412 78844 (\INSERTCH 53422 . 77148) (\INSERTCR 77150 . 78842)) (78910
99226 (\CHTOPC 78920 . 80109) (\CHTOPCNO 80111 . 81373) (\CLEARPCTB 81375 . 82171) (
\CREATEPIECEORSTREAM 82173 . 85147) (\DELETEPIECE 85149 . 86062) (\FINDPIECE 86064 . 86430) (
\INSERTPIECE 86432 . 89442) (\MAKEPCTB 89444 . 91359) (\SPLITPIECE 91361 . 98320) (\INSERT.FIRST.PIECE
98322 . 99224)) (99278 123516 (\TEXTCLOSEF 99288 . 100515) (\TEXTCLOSEF-SUBTREE 100517 . 101223) (
\TEXTDSPFONT 101225 . 102217) (\TEXTEOFP 102219 . 103578) (\TEXTGETEOFPTR 103580 . 103790) (
\TEXTGETFILEPTR 103792 . 105855) (\TEXTOPENF 105857 . 106687) (\TEXTOPENF-SUBTREE 106689 . 107490) (
\TEXTOUTCHARFN 107492 . 107840) (\TEXTBACKFILEPTR 107842 . 113743) (\TEXTBOUT 113745 . 117093) (
\TEDITOUTCCODEFN 117095 . 118361) (\TEXTSETEOF 118363 . 118872) (\TEXTSETFILEPTR 118874 . 120099) (
\TEXTDSPXPOSITION 120101 . 120958) (\TEXTDSPYPOSITION 120960 . 121505) (\TEXTLEFTMARGIN 121507 .
121990) (\TEXTRIGHTMARGIN 121992 . 122928) (\TEXTDSPCHARWIDTH 122930 . 123168) (\TEXTDSPSTRINGWIDTH
123170 . 123410) (\TEXTDSPLINEFEED 123412 . 123514)) (123517 161354 (\TEXTBIN 123527 . 144406) (
\TEDIT.TEXTBIN.STRINGSETUP 144408 . 150121) (\TEDIT.TEXTBIN.FILESETUP 150123 . 156509) (
\TEDIT.TEXTBIN.NEW.PAGE 156511 . 161352)) (161355 177117 (\TEXTPEEKBIN 161365 . 172858) (
\TEDIT.PEEKBIN.NEW.PAGE 172860 . 177115)) (177155 182373 (CGETTEXTPROP 177165 . 177641) (CTEXTPROP
177643 . 179987) (GETTEXTPROP 179989 . 180584) (PUTTEXTPROP 180586 . 181911) (TEXTPROP 181913 . 182371
)))))
STOP

Binary file not shown.

BIN
lispusers/MODERNIZE.TEDIT Normal file

Binary file not shown.

View File

@@ -1,78 +0,0 @@
MODERNIZE documentation
Ron Kaplan, February 2021
[A renaming of an earlier MACINTERFACE package]
MODERNIZE is a simple Lispusers package that changes the mouse actions on Medley windows so that moving and shaping can be done in a way that approximates the behavior of windows on modern platforms, Mac, Windows, etc. It also adds some meta keys to also emulate more conventional behavior.
Thus, for a window that has been created or transformed in this way, you can move the window by left-clicking in the title bar and dragging the window's ghost region. Or you can reshape by clicking in a corner of the title bar or near the bottom of the window to drag out the ghost region by that corner.
The menu behavior for other buttons or buttons clicked in other positions is unchanged.
For bottom corners, "near" means inside the window within MODERN-WINDOW-MARGIN (initially 25) pixels above or to the left/right of the corner.
For top corners, "near" means within the title bar and within the margin from the left/right edges.
(Windows that don't have a title-bar, like Snap windows, can be set up so that moving can happen by clicking anywhere, and shaping at the top is determined by the margin inside the window region.)
When the package is loaded, this behavior is installed for the following kinds of windows:
Tedit
Debugger/break
Sedit
Inspector
Snap
Exec
File Browser
Grapher
The function MODERNWINDOW.SETUP establishes the new behavior for classes of windows:
(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).
MODERNWINDOW.SETUP moves the definition of ORIGFN to the name (PACK* 'MODERN-ORIG- ORIGFN), and then provides a new definition for ORIGFN that does the moving or reshaping for clicks in the triggering locations, and otherwise passes control through to the original definition.
If ORIGNFN is a button event function, then MODERNWINDOWFN should not be specified. In that case a new definition for ORIGFN is constructed to provide the desired windowing behavior.
Otherwise, if ORIGFN is the function that creates windows of a class (e.g. SNAPW), then a MODERNWINDOWFN should be provided to create such windows (by calling (PACK* MODERN-ORIG- ORIGFN)). The definition of MODERNWINDOWFN replaces the original definition of ORIGFN.
If the flag ANYWHERE is non-NIL, especially for windows without a title bar, then the moving behavior is triggered by a click anywhere in the window (except the corners).
Because this works by redefining existing functions, it is important that the MODERNIZE package be loaded AFTER Tedit and Sedit, if those are not already in the sysout. And it should be called to upgrade the proper functions for other window classes that might later be added.
Provided these capabilities are already loaded, the following window classes are "modernized" when MODERNIZE is loaded are:
TEDIT
SEDIT
INSPECTOR
SNAP
DEBUGGER
EXEC
TABLEBROWSER
FILEBROWSER
FREEMENU
GRAPHER
PROMPTWINDOW
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 TITLEPROPORTION)
This saves the windows existing BUTTONEVENTFN as a window property PREMODERN-BUTTONEVENTFN, and installs a simple stub function in its place.
If things go awry:
(UNMODERN.SETUP ORIGFN) is provided to restore the original behavior for windows whose buttonevent function is ORIGIN.
(UNMODERNWINDOW WINDOW) restores a modernized window (via MACWINDOW) to its original state.
Known issues:
Clicking at the bottom of an EXEC window running TTYIN is effective only when the input line is empty.

View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-May-2022 16:22:57" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;27 113751
(FILECREATED "22-May-2022 13:19:56" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;34 117192
:CHANGES-TO (FNS DOFILESLOAD)
:CHANGES-TO (FNS LISPFILETYPE LISPSOURCEFILEP)
(VARS MACHINEINDEPENDENTCOMS)
:PREVIOUS-DATE "19-May-2022 16:19:10"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;26)
:PREVIOUS-DATE "19-May-2022 16:22:57"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MACHINEINDEPENDENT.;27)
(* ; "
@@ -48,7 +49,7 @@ with the terms of said license.
 "Functions for retrieving and remembering FILEMAPs and file reader environments")
(FNS FILEMAP \PARSE-FILE-HEADER GET-ENVIRONMENT-AND-FILEMAP
LOOKUP-ENVIRONMENT-AND-FILEMAP GET-FILEMAP-FROM-FILECREATED \FILEMAP-HASHOVERFLOW
FLUSHFILEMAPS LISPSOURCEFILEP GETFILEMAP PUTFILEMAP UPDATEFILEMAP)
FLUSHFILEMAPS LISPSOURCEFILEP LISPFILETYPE GETFILEMAP PUTFILEMAP UPDATEFILEMAP)
[INITVARS (*FILEMAP-LIMIT* 20)
(*FILEMAP-VERSIONS* 2)
(*FILEMAP-HASH* (HASHARRAY *FILEMAP-LIMIT* (FUNCTION \FILEMAP-HASHOVERFLOW)
@@ -1647,25 +1648,81 @@ WRITEFILE OF ")
ROOTNAME])
(LISPSOURCEFILEP
[LAMBDA (FILE) (* ; "Edited 9-Jul-2021 22:12 by rmk:")
[LAMBDA (FILE)
(* ;;; "If the first few characters of FILE `look like' those output by MAKEFILE then return the alleged address in the file of its FILEMAP expression.")
(* ;; "Edited 22-May-2022 09:49 by rmk: If FILE is a stream but not open for input, open it")
(* ;; "Edited 9-Jul-2021 22:12 by rmk:")
(* ;;; "If the first few characters of FILE `look like' those output by MAKEFILE then return the alleged address in the file of its FILEMAP expression.")
(RESETLST
(CL:UNLESS (STREAMP FILE)
(CL:UNLESS (AND (STREAMP FILE)
(GETSTREAM FILE 'INPUT T))
[RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT])
(CL:WHEN (RANDACCESSP FILE)
(LET ((HERE (GETFILEPTR FILE)))
(CL:MULTIPLE-VALUE-BIND (ENV MAP)
[\PARSE-FILE-HEADER FILE (FUNCTION (LAMBDA (STREAM)
(* ;
 "Pointed now right after the FILECREATED expression")
(CAR (NLSETQ (SKREAD STREAM)
(SKREAD STREAM)
(FIXP (READ STREAM]
(* ;
 "Pointed now right after the FILECREATED expression")
(CAR (NLSETQ (SKREAD STREAM)
(SKREAD STREAM)
(FIXP (READ STREAM]
(SETFILEPTR FILE HERE)
(CL:VALUES ENV MAP)))))])
(LISPFILETYPE
[LAMBDA (FILE) (* ; "Edited 22-May-2022 13:18 by rmk")
(* ;; "If FILE is a Lisp file, returns values TYPE FILEDATE SOURCEDATE, where TYPE is SOURCE, COMPILED, or NIL, DATE is the filedate of FILE and SOURCEDATE is the date of the source file for a compiled file (if it can be determined).")
(* ;; "Could be extended to return a subtypes (MANAGED/UNMANAGED for source files, LCOM or DFASL for compiled.")
(* ;; "If not RANDACCESSP, this depends on the fact that another stream can be opened on the file. (MULTIPLE-STREAM-PER-FILE.ALLOWED ?)")
(CL:WHEN FILE
(LET (TYPE DATE SDATE) (* ;
 "VALUES has to be outside of the NLSETQ")
[NLSETQ (RESETLST
[LET (STREAM)
[COND
[(AND (SETQ STREAM (\GETSTREAM FILE 'INPUT T))
(RANDACCESSP STREAM))
(RESETSAVE NIL `(SETFILEPTR ,STREAM ,(GETFILEPTR STREAM]
(T (RESETSAVE NIL `(CLOSEF ,(SETQ STREAM (OPENSTREAM FILE
'INPUT]
(SETFILEPTR STREAM 0)
(SETQ TYPE
(COND
((SETQ DATE (FASL-FILEDATE STREAM T))
(* ;; " Aha, a Dfasl file")
(* ;; " Having decided it's a DFASL, FASL-FILEDATE T returned the compiled date, calling again with NIL returns the source date. Better would be for FASL-FILEDATE to return both in a single call, as a multiple value.")
(SETFILEPTR STREAM 0)
(SETQ SDATE (FASL-FILEDATE STREAM NIL))
'COMPILED)
(T (* ; "Any other filetype")
(SETFILEPTR STREAM 0) (* ; "Reset: don't know what FASL did")
(CL:MULTIPLE-VALUE-BIND
(ENV FORM)
(\PARSE-FILE-HEADER STREAM 'RETURN)
(CL:WHEN (EQ (CAR (LISTP FORM))
'FILECREATED)
(* ;; "Compiled if 2 dates, otherwise source")
[SETQ DATE (CAR (LISTP (CDR FORM]
(SETQ FORM (WITH-READER-ENVIRONMENT ENV (READ STREAM)))
(IF (EQ (CAR (LISTP FORM))
'FILECREATED)
THEN [SETQ SDATE (CAR (LISTP (CDR FORM]
'COMPILED
ELSE 'SOURCE))])]
(CL:VALUES TYPE DATE SDATE)))])
(GETFILEMAP
[LAMBDA (STREAM FL) (* bvm%: "27-Aug-86 15:48")
@@ -2397,23 +2454,23 @@ This has little hope of working any more.")
(PUTPROPS MACHINEINDEPENDENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1985 1986 1987 1988
1989 1990 1991 2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12850 26275 (LOAD? 12860 . 14711) (FILESLOAD 14713 . 15002) (DOFILESLOAD 15004 . 22630)
(FINDFILE-WITH-EXTENSIONS 22632 . 25831) (READ-FILECREATED 25833 . 26273)) (26392 31713 (DMPHASH
26402 . 27996) (HASHOVERFLOW 27998 . 31711)) (32469 63806 (BKBUFS 32479 . 33598) (CHANGENAME 33600 .
33861) (CHNGNM 33863 . 35711) (CLBUFS 35713 . 36986) (DEFINE 36988 . 37712) (FNS.PUTDEF 37714 . 41129)
(EQMEMB 41131 . 41313) (EQUALN 41315 . 42144) (FNCHECK 42146 . 44153) (FNTYP1 44155 . 44252) (LCSKIP
44254 . 45098) (MAPRINT 45100 . 46046) (MKLIST 46048 . 46198) (NAMEFIELD 46200 . 47725) (NLIST 47727
. 48062) (PRINTBELLS 48064 . 48190) (PROMPTCHAR 48192 . 50082) (RAISEP 50084 . 50345) (READFILE 50347
. 52691) (READLINE 52693 . 58133) (REMPROPLIST 58135 . 59023) (RESETBUFS 59025 . 59475) (TAB 59477 .
60073) (UNSAVED1 60075 . 61180) (WRITEFILE 61182 . 62924) (CLOSE-AND-MAYBE-DELETE 62926 . 63270) (
UNSAFE.TO.MODIFY 63272 . 63804)) (66130 69074 (FILEDATE 66140 . 69072)) (69304 93043 (FILEMAP 69314 .
69784) (\PARSE-FILE-HEADER 69786 . 73601) (GET-ENVIRONMENT-AND-FILEMAP 73603 . 75830) (
LOOKUP-ENVIRONMENT-AND-FILEMAP 75832 . 78023) (GET-FILEMAP-FROM-FILECREATED 78025 . 78849) (
\FILEMAP-HASHOVERFLOW 78851 . 83515) (FLUSHFILEMAPS 83517 . 84140) (LISPSOURCEFILEP 84142 . 85321) (
GETFILEMAP 85323 . 85742) (PUTFILEMAP 85744 . 87935) (UPDATEFILEMAP 87937 . 93041)) (93709 97295 (
LVLPRINT 93719 . 93892) (LVLPRIN1 93894 . 94076) (LVLPRIN2 94078 . 94310) (LVLPRIN 94312 . 95326) (
LVLPRIN0 95328 . 97293)) (97329 102246 (FLUSHRIGHT 97339 . 98154) (PRINTPARA 98156 . 99254) (
PRINTPARA1 99256 . 102244)) (102282 104567 (SUBLIS 102292 . 102900) (SUBPAIR 102902 . 104130) (DSUBLIS
104132 . 104565)) (104590 105190 (CONSTANTOK 104600 . 105188)) (106943 107648 (NLAMBDA.ARGS 106953 .
107646)))))
(FILEMAP (NIL (12928 26353 (LOAD? 12938 . 14789) (FILESLOAD 14791 . 15080) (DOFILESLOAD 15082 . 22708)
(FINDFILE-WITH-EXTENSIONS 22710 . 25909) (READ-FILECREATED 25911 . 26351)) (26470 31791 (DMPHASH
26480 . 28074) (HASHOVERFLOW 28076 . 31789)) (32547 63884 (BKBUFS 32557 . 33676) (CHANGENAME 33678 .
33939) (CHNGNM 33941 . 35789) (CLBUFS 35791 . 37064) (DEFINE 37066 . 37790) (FNS.PUTDEF 37792 . 41207)
(EQMEMB 41209 . 41391) (EQUALN 41393 . 42222) (FNCHECK 42224 . 44231) (FNTYP1 44233 . 44330) (LCSKIP
44332 . 45176) (MAPRINT 45178 . 46124) (MKLIST 46126 . 46276) (NAMEFIELD 46278 . 47803) (NLIST 47805
. 48140) (PRINTBELLS 48142 . 48268) (PROMPTCHAR 48270 . 50160) (RAISEP 50162 . 50423) (READFILE 50425
. 52769) (READLINE 52771 . 58211) (REMPROPLIST 58213 . 59101) (RESETBUFS 59103 . 59553) (TAB 59555 .
60151) (UNSAVED1 60153 . 61258) (WRITEFILE 61260 . 63002) (CLOSE-AND-MAYBE-DELETE 63004 . 63348) (
UNSAFE.TO.MODIFY 63350 . 63882)) (66208 69152 (FILEDATE 66218 . 69150)) (69382 96484 (FILEMAP 69392 .
69862) (\PARSE-FILE-HEADER 69864 . 73679) (GET-ENVIRONMENT-AND-FILEMAP 73681 . 75908) (
LOOKUP-ENVIRONMENT-AND-FILEMAP 75910 . 78101) (GET-FILEMAP-FROM-FILECREATED 78103 . 78927) (
\FILEMAP-HASHOVERFLOW 78929 . 83593) (FLUSHFILEMAPS 83595 . 84218) (LISPSOURCEFILEP 84220 . 85511) (
LISPFILETYPE 85513 . 88762) (GETFILEMAP 88764 . 89183) (PUTFILEMAP 89185 . 91376) (UPDATEFILEMAP 91378
. 96482)) (97150 100736 (LVLPRINT 97160 . 97333) (LVLPRIN1 97335 . 97517) (LVLPRIN2 97519 . 97751) (
LVLPRIN 97753 . 98767) (LVLPRIN0 98769 . 100734)) (100770 105687 (FLUSHRIGHT 100780 . 101595) (
PRINTPARA 101597 . 102695) (PRINTPARA1 102697 . 105685)) (105723 108008 (SUBLIS 105733 . 106341) (
SUBPAIR 106343 . 107571) (DSUBLIS 107573 . 108006)) (108031 108631 (CONSTANTOK 108041 . 108629)) (
110384 111089 (NLAMBDA.ARGS 110394 . 111087)))))
STOP

Binary file not shown.