github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-09 04:30:27 +00:00
Code Issues Projects Releases Wiki Activity

Rmk49: responds to #800 (#803)

Browse Source 
* TEDIT, TEXTOFD:  Pass FORMAT in PROPS to OPENSTREAM

In TEDIT and OPENTEXTSTREAM.  I don't think TEDIT interprets the external format, but at least the info is there

* WINDOW: CREATEW prompts on one line

It was calling PROMPTPRINT twice, which resulted in orphan-looking lines

* EXAMINEDEFS: Propagate textwidth to COMPARETEXT

* COMPARETEXT: propagate height/width of text windows, for linelength

#800

* GREP:  Will work with external formats, after FILEPOS update

Line printout could be better, if e.g. it is a Lisp source file, but...

* EXAMINEDEFS:  Propagate window width to COMPARETEXT, for LINELENGTH

* GITFNS: added fetch before git log

* PSEUDOHOSTS: Pseudohost-streams are now registered on the PH device, not the target device

* EXTERNALFORMAT, XCCS:  Globalvar declaration in wrong place

Also updated \CHECKEOLC macro

* GITFNS:  moved git fetch to beginning of prc

* GREP:  Propagated OUTSTREAM
This commit is contained in:
rmkaplan
2022-06-26 18:18:44 -07:00
committed by GitHub
parent c92622e09e
commit 648335bfec
21 changed files with 618 additions and 514 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
library/TEDIT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Jun-2022 00:36:53" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEDIT.;40 143378
(FILECREATED "22-Jun-2022 20:05:24" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT.;41 143462
:CHANGES-TO (FNS TEDIT)
:PREVIOUS-DATE " 4-Jun-2022 15:43:05"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEDIT.;39)
:PREVIOUS-DATE " 6-Jun-2022 00:36:53"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT.;40)
(* ; "
@@ -253,16 +253,14 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(TEDIT
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS)
(* ;; "Edited 6-Jun-2022 00:35 by rmk")
(* ;; "Edited 22-Jun-2022 20:01 by rmk: Call to OPENSTREAM passes FORMAT from PROPS")
(* ;; "Edited 22-Jun-2022 19:58 by rmk")
(* ;; "Edited 4-Jun-2022 15:42 by rmk")
(* ;; "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:")
@@ -279,7 +277,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(STRINGP TEXT)
(CL:PATHNAMEP TEXT))) (* ;
 "Make sure the file exists before trying to open the window.")
(SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '((TYPE TEXT]
(SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD `((TYPE TEXT)
(FORMAT ,(LISTGET PROPS 'FORMAT]
(CL:WHEN (AND WINDOW (OR (LITATOM WINDOW)
(REGIONP WINDOW)))
@@ -2269,7 +2268,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
(* ; "TEDIT Support information")
(RPAQQ TEDITSYSTEMDATE " 6-Jun-2022 00:36:53")
(RPAQQ TEDITSYSTEMDATE "22-Jun-2022 20:05:24")
(RPAQ TEDITSUPPORT "TEditSupport.PA")
(DEFINEQ
@@ -2295,20 +2294,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 (4349 118548 (\TEDIT2 4359 . 7110) (COERCETEXTOBJ 7112 . 15888) (TEDIT 15890 . 21072) (
TEDITSTRING 21074 . 21633) (TEDIT-SEE 21635 . 24224) (TEDIT.CHARWIDTH 24226 . 26250) (TEDIT.COPY 26252
. 34688) (TEDIT.DELETE 34690 . 35380) (TEDIT.DO.BLUEPENDINGDELETE 35382 . 38449) (TEDIT.INSERT 38451
. 43981) (TEDIT.KILL 43983 . 45540) (TEDIT.MAPLINES 45542 . 46941) (TEDIT.MAPPIECES 46943 . 47899) (
TEDIT.MOVE 47901 . 57685) (TEDIT.QUIT 57687 . 59687) (TEDIT.STRINGWIDTH 59689 . 60360) (TEDIT.\INSERT
60362 . 62387) (TEXTOBJ 62389 . 63514) (TEXTSTREAM 63516 . 65131) (\TEDIT.INCLUDE 65133 . 69033) (
\TEDIT.INSERT.PIECES 69035 . 78950) (\TEDIT.MOVE.PIECEMAPFN 78952 . 81031) (\TEDIT.OBJECT.SHOWSEL
81033 . 84662) (\TEDIT.RESTARTFN 84664 . 86659) (\TEDIT.CHARDELETE 86661 . 90623) (
\TEDIT.COPY.PIECEMAPFN 90625 . 93850) (\TEDIT.DELETE 93852 . 101370) (\TEDIT.DIFFUSE.PARALOOKS 101372
. 104136) (\TEDIT.FOREIGN.COPY? 104138 . 107865) (\TEDIT.QUIT 107867 . 111013) (\TEDIT.WORDDELETE
111015 . 115848) (\TEDIT1 115850 . 118546)) (118662 118778 (\CREATE.TEDIT.RESTART.MENU 118672 . 118776
)) (118877 122566 (PLCHAIN 118887 . 119161) (PRINTLINE 119163 . 121927) (SEEFILE 121929 . 122564)) (
122607 142250 (TEDIT.INSERT.OBJECT 122617 . 131694) (TEDIT.EDIT.OBJECT 131696 . 133952) (
TEDIT.FIND.OBJECT 133954 . 134847) (TEDIT.FIND.OBJECT.SUBTREE 134849 . 135655) (TEDIT.PUT.OBJECT
135657 . 137316) (TEDIT.GET.OBJECT 137318 . 140517) (TEDIT.OBJECT.CHANGED 140519 . 142248)) (142528
142891 (MAKETEDITFORM 142538 . 142889)))))
(FILEMAP (NIL (4349 118632 (\TEDIT2 4359 . 7110) (COERCETEXTOBJ 7112 . 15888) (TEDIT 15890 . 21156) (
TEDITSTRING 21158 . 21717) (TEDIT-SEE 21719 . 24308) (TEDIT.CHARWIDTH 24310 . 26334) (TEDIT.COPY 26336
. 34772) (TEDIT.DELETE 34774 . 35464) (TEDIT.DO.BLUEPENDINGDELETE 35466 . 38533) (TEDIT.INSERT 38535
. 44065) (TEDIT.KILL 44067 . 45624) (TEDIT.MAPLINES 45626 . 47025) (TEDIT.MAPPIECES 47027 . 47983) (
TEDIT.MOVE 47985 . 57769) (TEDIT.QUIT 57771 . 59771) (TEDIT.STRINGWIDTH 59773 . 60444) (TEDIT.\INSERT
60446 . 62471) (TEXTOBJ 62473 . 63598) (TEXTSTREAM 63600 . 65215) (\TEDIT.INCLUDE 65217 . 69117) (
\TEDIT.INSERT.PIECES 69119 . 79034) (\TEDIT.MOVE.PIECEMAPFN 79036 . 81115) (\TEDIT.OBJECT.SHOWSEL
81117 . 84746) (\TEDIT.RESTARTFN 84748 . 86743) (\TEDIT.CHARDELETE 86745 . 90707) (
\TEDIT.COPY.PIECEMAPFN 90709 . 93934) (\TEDIT.DELETE 93936 . 101454) (\TEDIT.DIFFUSE.PARALOOKS 101456
. 104220) (\TEDIT.FOREIGN.COPY? 104222 . 107949) (\TEDIT.QUIT 107951 . 111097) (\TEDIT.WORDDELETE
111099 . 115932) (\TEDIT1 115934 . 118630)) (118746 118862 (\CREATE.TEDIT.RESTART.MENU 118756 . 118860
)) (118961 122650 (PLCHAIN 118971 . 119245) (PRINTLINE 119247 . 122011) (SEEFILE 122013 . 122648)) (
122691 142334 (TEDIT.INSERT.OBJECT 122701 . 131778) (TEDIT.EDIT.OBJECT 131780 . 134036) (
TEDIT.FIND.OBJECT 134038 . 134931) (TEDIT.FIND.OBJECT.SUBTREE 134933 . 135739) (TEDIT.PUT.OBJECT
135741 . 137400) (TEDIT.GET.OBJECT 137402 . 140601) (TEDIT.OBJECT.CHANGED 140603 . 142332)) (142612
142975 (MAKETEDITFORM 142622 . 142973)))))
STOP

BIN
library/TEDIT.LCOM
View File

Binary file not shown.

65
library/TEXTOFD
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Jun-2022 15:43:05" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEXTOFD.;19 183223
(FILECREATED "22-Jun-2022 21:25:47" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;20 183270
:CHANGES-TO (FNS OPENTEXTSTREAM)
:PREVIOUS-DATE " 5-May-2022 15:12:26"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>TEXTOFD.;18)
:PREVIOUS-DATE " 4-Jun-2022 15:43:05"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXTOFD.;19)
(* ; "
@@ -108,10 +108,15 @@ 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-Jun-2022 15:42 by rmk")
(* ;
 "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")
[LAMBDA (TEXT WINDOW START END PROPS)
(* ;; "Edited 22-Jun-2022 21:09 by rmk: Pass FORMAT prop to OPENSTREAM FWIW")
(* ;; "Edited 4-Jun-2022 15:42 by rmk")
(* ;; "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.")
(PROG* ([WAS-TEXTSTREAM (AND (type? STREAM TEXT)
@@ -211,7 +216,9 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(CL:WHEN (AND TEXT (OR (LITATOM TEXT)
(STRINGP TEXT)
(CL:PATHNAMEP TEXT)))(* ; "rmk: Strings are now file names")
[SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '((TYPE TEXT])
[SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD
`((TYPE TEXT)
(FORMAT ,(LISTGET PROPS 'FORMAT])
(SETQ TEXTSTREAM (replace (TEXTOBJ STREAMHINT) of TEXTOBJ
with (create TEXTSTREAM
TEXTOBJ _ TEXTOBJ)))
@@ -2725,25 +2732,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 (2996 53588 (COPYTEXTSTREAM 3006 . 6128) (OPENTEXTSTREAM 6130 . 21350) (REOPENTEXTSTREAM
21352 . 21774) (TEDIT.STREAMCHANGEDP 21776 . 22074) (TEXTSTREAMP 22076 . 22390) (TXTFILE 22392 .
22837) (\DELETECH 22839 . 34095) (\SETUPGETCH 34097 . 41376) (\TEDIT.REOPEN.STREAM 41378 . 43228) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43230 . 45668) (\TEXTINIT 45670 . 51481) (\TEXTMARK 51483 . 52231) (
\TEXTTTYBOUT 52233 . 53586)) (53589 79021 (\INSERTCH 53599 . 77325) (\INSERTCR 77327 . 79019)) (79087
99403 (\CHTOPC 79097 . 80286) (\CHTOPCNO 80288 . 81550) (\CLEARPCTB 81552 . 82348) (
\CREATEPIECEORSTREAM 82350 . 85324) (\DELETEPIECE 85326 . 86239) (\FINDPIECE 86241 . 86607) (
\INSERTPIECE 86609 . 89619) (\MAKEPCTB 89621 . 91536) (\SPLITPIECE 91538 . 98497) (\INSERT.FIRST.PIECE
98499 . 99401)) (99455 123693 (\TEXTCLOSEF 99465 . 100692) (\TEXTCLOSEF-SUBTREE 100694 . 101400) (
\TEXTDSPFONT 101402 . 102394) (\TEXTEOFP 102396 . 103755) (\TEXTGETEOFPTR 103757 . 103967) (
\TEXTGETFILEPTR 103969 . 106032) (\TEXTOPENF 106034 . 106864) (\TEXTOPENF-SUBTREE 106866 . 107667) (
\TEXTOUTCHARFN 107669 . 108017) (\TEXTBACKFILEPTR 108019 . 113920) (\TEXTBOUT 113922 . 117270) (
\TEDITOUTCCODEFN 117272 . 118538) (\TEXTSETEOF 118540 . 119049) (\TEXTSETFILEPTR 119051 . 120276) (
\TEXTDSPXPOSITION 120278 . 121135) (\TEXTDSPYPOSITION 121137 . 121682) (\TEXTLEFTMARGIN 121684 .
122167) (\TEXTRIGHTMARGIN 122169 . 123105) (\TEXTDSPCHARWIDTH 123107 . 123345) (\TEXTDSPSTRINGWIDTH
123347 . 123587) (\TEXTDSPLINEFEED 123589 . 123691)) (123694 161531 (\TEXTBIN 123704 . 144583) (
\TEDIT.TEXTBIN.STRINGSETUP 144585 . 150298) (\TEDIT.TEXTBIN.FILESETUP 150300 . 156686) (
\TEDIT.TEXTBIN.NEW.PAGE 156688 . 161529)) (161532 177294 (\TEXTPEEKBIN 161542 . 173035) (
\TEDIT.PEEKBIN.NEW.PAGE 173037 . 177292)) (177332 182550 (CGETTEXTPROP 177342 . 177818) (CTEXTPROP
177820 . 180164) (GETTEXTPROP 180166 . 180761) (PUTTEXTPROP 180763 . 182088) (TEXTPROP 182090 . 182548
(FILEMAP (NIL (2996 53635 (COPYTEXTSTREAM 3006 . 6128) (OPENTEXTSTREAM 6130 . 21397) (REOPENTEXTSTREAM
21399 . 21821) (TEDIT.STREAMCHANGEDP 21823 . 22121) (TEXTSTREAMP 22123 . 22437) (TXTFILE 22439 .
22884) (\DELETECH 22886 . 34142) (\SETUPGETCH 34144 . 41423) (\TEDIT.REOPEN.STREAM 41425 . 43275) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 43277 . 45715) (\TEXTINIT 45717 . 51528) (\TEXTMARK 51530 . 52278) (
\TEXTTTYBOUT 52280 . 53633)) (53636 79068 (\INSERTCH 53646 . 77372) (\INSERTCR 77374 . 79066)) (79134
99450 (\CHTOPC 79144 . 80333) (\CHTOPCNO 80335 . 81597) (\CLEARPCTB 81599 . 82395) (
\CREATEPIECEORSTREAM 82397 . 85371) (\DELETEPIECE 85373 . 86286) (\FINDPIECE 86288 . 86654) (
\INSERTPIECE 86656 . 89666) (\MAKEPCTB 89668 . 91583) (\SPLITPIECE 91585 . 98544) (\INSERT.FIRST.PIECE
98546 . 99448)) (99502 123740 (\TEXTCLOSEF 99512 . 100739) (\TEXTCLOSEF-SUBTREE 100741 . 101447) (
\TEXTDSPFONT 101449 . 102441) (\TEXTEOFP 102443 . 103802) (\TEXTGETEOFPTR 103804 . 104014) (
\TEXTGETFILEPTR 104016 . 106079) (\TEXTOPENF 106081 . 106911) (\TEXTOPENF-SUBTREE 106913 . 107714) (
\TEXTOUTCHARFN 107716 . 108064) (\TEXTBACKFILEPTR 108066 . 113967) (\TEXTBOUT 113969 . 117317) (
\TEDITOUTCCODEFN 117319 . 118585) (\TEXTSETEOF 118587 . 119096) (\TEXTSETFILEPTR 119098 . 120323) (
\TEXTDSPXPOSITION 120325 . 121182) (\TEXTDSPYPOSITION 121184 . 121729) (\TEXTLEFTMARGIN 121731 .
122214) (\TEXTRIGHTMARGIN 122216 . 123152) (\TEXTDSPCHARWIDTH 123154 . 123392) (\TEXTDSPSTRINGWIDTH
123394 . 123634) (\TEXTDSPLINEFEED 123636 . 123738)) (123741 161578 (\TEXTBIN 123751 . 144630) (
\TEDIT.TEXTBIN.STRINGSETUP 144632 . 150345) (\TEDIT.TEXTBIN.FILESETUP 150347 . 156733) (
\TEDIT.TEXTBIN.NEW.PAGE 156735 . 161576)) (161579 177341 (\TEXTPEEKBIN 161589 . 173082) (
\TEDIT.PEEKBIN.NEW.PAGE 173084 . 177339)) (177379 182597 (CGETTEXTPROP 177389 . 177865) (CTEXTPROP
177867 . 180211) (GETTEXTPROP 180213 . 180808) (PUTTEXTPROP 180810 . 182135) (TEXTPROP 182137 . 182595
)))))
STOP

BIN
library/TEXTOFD.LCOM
View File

Binary file not shown.

BIN
lispusers/COMPARETEXT.LCOM
View File

Binary file not shown.

BIN
lispusers/COMPARETEXT.TEDIT
View File

Binary file not shown.

45
lispusers/EXAMINEDEFS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Feb-2022 18:04:08" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;37 12345
(FILECREATED "24-Jun-2022 18:52:03" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;39 12695
:CHANGES-TO (FNS EXAMINEDEFS)
:PREVIOUS-DATE " 1-Feb-2022 23:15:24"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;36)
:PREVIOUS-DATE "23-Jun-2022 17:58:57"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EXAMINEDEFS.;38)
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
@@ -19,13 +19,9 @@
(DEFINEQ
(EXAMINEDEFS
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Feb-2022 15:01 by rmk")
(* ; "Edited 1-Feb-2022 15:42 by rmk")
(* ; "Edited 23-Jan-2022 17:40 by rmk")
(* ; "Edited 18-Jan-2022 22:40 by rmk")
(* ; "Edited 12-Jan-2022 17:29 by rmk")
(* ; "Edited 24-Dec-2021 22:39 by rmk")
(* ; "Edited 20-Dec-2021 11:06 by rmk")
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 24-Jun-2022 18:51 by rmk")
(* ; "Edited 23-Jun-2022 17:58 by rmk")
(* ; "Edited 25-Feb-2022 15:01 by rmk")
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.")
@@ -63,7 +59,7 @@
(CL:UNLESS TITLE2
(SETQ TITLE2 (CL:IF (AND SOURCE2 (ILEQ (COUNT SOURCE2)
5))
SOURCE12
SOURCE2
"File 2")))
(SELECTQ (EDITMODE)
(SEDIT:SEDIT
@@ -122,18 +118,24 @@
(CONS W2 (WINDOWPROP W2 'PROCESS])
(COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS CTWINDOW
(KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
TITLE2)))
TITLE2))
(TEXTWIDTH 700)
(TEXTHEIGHT 600))
(DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS))
(* ; "Reuse an existing CT graph window")
(* ;
 "Reuse an existing CT graph window for this DEF")
(OR [FIND W IN (OPENWINDOWS)
SUCHTHAT (EQUAL KEY (WINDOWPROP W
'EXAMINEDEFS]
(PROG1 (SETQ CTWINDOW
(COMPARETEXT (TEDITDEF NAME DEF1 TYPE)
(TEDITDEF NAME DEF2 TYPE)
(COMPARETEXT (TEDITDEF NAME DEF1 TYPE NIL
TEXTWIDTH)
(TEDITDEF NAME DEF2 TYPE NIL
TEXTWIDTH)
'LINE REGION (LIST TITLE1 TITLE2)
(CONCAT "Compare sources of " NAME
" as " TYPE)))
" as " TYPE)
TEXTWIDTH TEXTHEIGHT))
(WINDOWPROP CTWINDOW 'EXAMINEDEFS
(LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
TITLE2)))])
@@ -167,10 +169,15 @@
NIL TITLE2])
(TEDITDEF
[LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk")
[LAMBDA (NAME DEF TYPE READERENVIRONMENT WIDTH) (* ; "Edited 23-Jun-2022 17:27 by rmk")
(* ; "Edited 28-Jan-2022 23:36 by rmk")
(* ; "Edited 12-Jan-2022 17:27 by rmk")
(LET ((TSTREAM (OPENTEXTSTREAM)))
(DSPFONT DEFAULTFONT TSTREAM)
(CL:WHEN WIDTH
(LINELENGTH (IQUOTIENT WIDTH (CHARWIDTH (CHARCODE SPACE)
TSTREAM))
TSTREAM))
(SELECTQ (CAR DEF)
(DEFINEQ (SETQ DEF (CADR DEF))
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
@@ -206,6 +213,6 @@
(FILESLOAD (SYSLOAD)
COMPARETEXT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (661 12203 (EXAMINEDEFS 671 . 9217) (EXAMINEFILES 9219 . 10614) (TEDITDEF 10616 . 12201)
(FILEMAP (NIL (671 12553 (EXAMINEDEFS 681 . 9275) (EXAMINEFILES 9277 . 10672) (TEDITDEF 10674 . 12551)
))))
STOP

BIN
lispusers/EXAMINEDEFS.LCOM
View File

Binary file not shown.

69
lispusers/GITFNS
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jun-2022 11:09:08" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;315 100727
(FILECREATED "26-Jun-2022 13:33:07" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;318 101193
:CHANGES-TO (VARS GITFNSCOMS)
:CHANGES-TO (COMMANDS prc)
(FNS GIT-COMMIT-DIFFS)
:PREVIOUS-DATE " 4-Jun-2022 20:44:07"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;313)
:PREVIOUS-DATE "25-Jun-2022 21:38:07"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;317)
(PRETTYCOMPRINT GITFNSCOMS)
@@ -433,6 +434,7 @@
'(DRAFT DRAFTS))
(SETQ RB NIL)
(SETQ DR T))
(GIT-COMMAND "git fetch")
(CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT)
"Pull requests")))
(GIT-BRANCHES-COMPARE-DIRECTORIES RB (GIT-MAINBRANCH PROJECT)
@@ -953,7 +955,8 @@
T])
(GIT-COMMIT-DIFFS
[LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 7-May-2022 23:48 by rmk")
[LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT) (* ; "Edited 26-Jun-2022 13:32 by rmk")
(* ; "Edited 7-May-2022 23:48 by rmk")
(* ; "Edited 2-May-2022 13:45 by rmk")
(* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2")
@@ -1534,6 +1537,8 @@
(GIT-WORKING-COMPARE-DIRECTORIES
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
(* ;; "Edited 25-Jun-2022 21:37 by rmk")
(* ;; "Edited 17-May-2022 17:39 by rmk")
(* ;; "Edited 10-May-2022 10:41 by rmk")
@@ -1543,6 +1548,10 @@
(SETQ PROJECT (GIT-GET-PROJECT PROJECT))
(CL:WHEN UPDATE (GIT-REMOTE-UPDATE NIL PROJECT)) (* ; "Doesn't matter if we are looking only at local files in the current branch. We aren't fetching or checking out.")
(CL:UNLESS (AND (FETCH GITHOST OF PROJECT)
(FETCH WHOST OF PROJECT))
(ERROR (FETCH PROJECTNAME OF PROJECT)
" does not have both git and working directories"))
(CL:WHEN (AND (LISTP SUBDIRS)
(NULL (CDR SUBDIRS)))
(SETQ SUBDIRS (CAR SUBDIRS)))
@@ -1914,28 +1923,28 @@
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3420 17267 (GIT-CLONEP 3430 . 4693) (GIT-MAKE-PROJECT 4695 . 12807) (GIT-GET-PROJECT
12809 . 14146) (GIT-PROJECT-PATH 14148 . 15192) (FIND-ANCESTOR-DIRECTORY 15194 . 15543) (
GIT-FIND-CLONE 15545 . 16626) (GIT-MAINBRANCH 16628 . 16912) (GIT-MAINBRANCH? 16914 . 17265)) (23234
26022 (ALLSUBDIRS 23244 . 24530) (MEDLEYSUBDIRS 24532 . 25225) (GITSUBDIRS 25227 . 26020)) (26023
30813 (TOGIT 26033 . 27439) (FROMGIT 27441 . 28422) (GIT-DELETE-FILE 28424 . 29270) (
MYMEDLEY-DELETE-FILES 29272 . 30811)) (30814 33346 (MYMEDLEYSUBDIR 30824 . 31280) (GITSUBDIR 31282 .
31725) (STRIPDIR 31727 . 32098) (STRIPHOST 32100 . 32340) (STRIPNAME 32342 . 33095) (STRIPWHERE 33097
. 33344)) (33347 35249 (GFILE4MFILE 33357 . 33720) (MFILE4GFILE 33722 . 34291) (GIT-REPO-FILENAME
34293 . 35247)) (35298 43099 (GIT-COMMIT 35308 . 36134) (GIT-PUSH 36136 . 36780) (GIT-PULL 36782 .
37394) (GIT-APPROVAL 37396 . 37745) (GIT-GET-FILE 37747 . 40266) (GIT-FILE-EXISTS? 40268 . 41212) (
GIT-REMOTE-UPDATE 41214 . 41938) (GIT-REMOTE-ADD 41940 . 42247) (GIT-FILE-DATE 42249 . 43097)) (43129
51720 (GIT-BRANCH-DIFF 43139 . 47891) (GIT-COMMIT-DIFFS 47893 . 48337) (GIT-BRANCH-RELATIONS 48339 .
51718)) (51765 60700 (GIT-BRANCH-NUM 51775 . 52348) (GIT-CHECKOUT 52350 . 52862) (GIT-WHICH-BRANCH
52864 . 53162) (GIT-MAKE-BRANCH 53164 . 54908) (GIT-BRANCHES 54910 . 56401) (GIT-BRANCH-EXISTS? 56403
. 57107) (GIT-PICK-BRANCH 57109 . 57437) (GIT-PRC-MENU 57439 . 59067) (GIT-PULL-REQUESTS 59069 .
60086) (GIT-SHORT-BRANCH-NAME 60088 . 60379) (GIT-LONG-NAME 60381 . 60698)) (60730 64065 (
GIT-MY-CURRENT-BRANCH 60740 . 61110) (GIT-MY-BRANCHP 61112 . 61617) (GIT-MY-NEXT-BRANCH 61619 . 62113)
(GIT-MY-BRANCHES 62115 . 64063)) (64111 68063 (GIT-ADD-WORKTREE 64121 . 65605) (GIT-REMOVE-WORKTREE
65607 . 66537) (GIT-LIST-WORKTREES 66539 . 67343) (WORKTREEDIR 67345 . 68061)) (68111 97607 (
GIT-GET-DIFFERENT-FILES 68121 . 73946) (GIT-BRANCHES-COMPARE-DIRECTORIES 73948 . 79790) (
GIT-WORKING-COMPARE-DIRECTORIES 79792 . 84258) (GIT-COMPARE-WORKTREE 84260 . 88133) (GITCDOBJBUTTONFN
88135 . 92625) (GIT-CD-LABELFN 92627 . 93709) (GIT-CD-MENUFN 93711 . 95918) (GIT-WORKING-COMPARE-FILES
95920 . 96439) (GIT-BRANCHES-COMPARE-FILES 96441 . 97605)) (97677 100660 (CDGITDIR 97687 . 98065) (
GIT-COMMAND 98067 . 99653) (GITORIGIN 99655 . 100352) (GIT-INITIALS 100354 . 100658)))))
(FILEMAP (NIL (3458 17305 (GIT-CLONEP 3468 . 4731) (GIT-MAKE-PROJECT 4733 . 12845) (GIT-GET-PROJECT
12847 . 14184) (GIT-PROJECT-PATH 14186 . 15230) (FIND-ANCESTOR-DIRECTORY 15232 . 15581) (
GIT-FIND-CLONE 15583 . 16664) (GIT-MAINBRANCH 16666 . 16950) (GIT-MAINBRANCH? 16952 . 17303)) (23311
26099 (ALLSUBDIRS 23321 . 24607) (MEDLEYSUBDIRS 24609 . 25302) (GITSUBDIRS 25304 . 26097)) (26100
30890 (TOGIT 26110 . 27516) (FROMGIT 27518 . 28499) (GIT-DELETE-FILE 28501 . 29347) (
MYMEDLEY-DELETE-FILES 29349 . 30888)) (30891 33423 (MYMEDLEYSUBDIR 30901 . 31357) (GITSUBDIR 31359 .
31802) (STRIPDIR 31804 . 32175) (STRIPHOST 32177 . 32417) (STRIPNAME 32419 . 33172) (STRIPWHERE 33174
. 33421)) (33424 35326 (GFILE4MFILE 33434 . 33797) (MFILE4GFILE 33799 . 34368) (GIT-REPO-FILENAME
34370 . 35324)) (35375 43176 (GIT-COMMIT 35385 . 36211) (GIT-PUSH 36213 . 36857) (GIT-PULL 36859 .
37471) (GIT-APPROVAL 37473 . 37822) (GIT-GET-FILE 37824 . 40343) (GIT-FILE-EXISTS? 40345 . 41289) (
GIT-REMOTE-UPDATE 41291 . 42015) (GIT-REMOTE-ADD 42017 . 42324) (GIT-FILE-DATE 42326 . 43174)) (43206
51906 (GIT-BRANCH-DIFF 43216 . 47968) (GIT-COMMIT-DIFFS 47970 . 48523) (GIT-BRANCH-RELATIONS 48525 .
51904)) (51951 60886 (GIT-BRANCH-NUM 51961 . 52534) (GIT-CHECKOUT 52536 . 53048) (GIT-WHICH-BRANCH
53050 . 53348) (GIT-MAKE-BRANCH 53350 . 55094) (GIT-BRANCHES 55096 . 56587) (GIT-BRANCH-EXISTS? 56589
. 57293) (GIT-PICK-BRANCH 57295 . 57623) (GIT-PRC-MENU 57625 . 59253) (GIT-PULL-REQUESTS 59255 .
60272) (GIT-SHORT-BRANCH-NAME 60274 . 60565) (GIT-LONG-NAME 60567 . 60884)) (60916 64251 (
GIT-MY-CURRENT-BRANCH 60926 . 61296) (GIT-MY-BRANCHP 61298 . 61803) (GIT-MY-NEXT-BRANCH 61805 . 62299)
(GIT-MY-BRANCHES 62301 . 64249)) (64297 68249 (GIT-ADD-WORKTREE 64307 . 65791) (GIT-REMOVE-WORKTREE
65793 . 66723) (GIT-LIST-WORKTREES 66725 . 67529) (WORKTREEDIR 67531 . 68247)) (68297 98073 (
GIT-GET-DIFFERENT-FILES 68307 . 74132) (GIT-BRANCHES-COMPARE-DIRECTORIES 74134 . 79976) (
GIT-WORKING-COMPARE-DIRECTORIES 79978 . 84724) (GIT-COMPARE-WORKTREE 84726 . 88599) (GITCDOBJBUTTONFN
88601 . 93091) (GIT-CD-LABELFN 93093 . 94175) (GIT-CD-MENUFN 94177 . 96384) (GIT-WORKING-COMPARE-FILES
96386 . 96905) (GIT-BRANCHES-COMPARE-FILES 96907 . 98071)) (98143 101126 (CDGITDIR 98153 . 98531) (
GIT-COMMAND 98533 . 100119) (GITORIGIN 100121 . 100818) (GIT-INITIALS 100820 . 101124)))))
STOP

BIN
lispusers/GITFNS.LCOM
View File

Binary file not shown.

125
lispusers/GREP
View File

@@ -1,78 +1,101 @@
(FILECREATED "14-May-86 08:04:43" {DSK}<LISPFILES>GREP.;1 2502
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to: (FNS DOGREP)
(FILECREATED "26-Jun-2022 14:36:21" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9 4685
previous date: " 5-Mar-86 12:15:18" {DANTE}<LISPNEW>LISPUSERS>GREP.;1)
:CHANGES-TO (FNS DOGREP)
:PREVIOUS-DATE "26-Jun-2022 13:28:34"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;7)
(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(* ; "
Copyright (c) 1984-1986 by Xerox Corporation.
")
(PRETTYCOMPRINT GREPCOMS)
(RPAQQ GREPCOMS ((FNS DOGREP GREP PHONE)
(FILES BSEARCH)
(INITVARS (PHONELISTFILES))))
(INITVARS (PHONELISTFILES))))
(DEFINEQ
(DOGREP
[LAMBDA (STR FILES) (* Newman "14-May-86 08:04")
[LAMBDA (STRS FILES OUTSTREAM)
(* * Originally coded by Larry Masinter.)
(* ;; "Edited 26-Jun-2022 14:36 by rmk")
(* ;; "Edited 18-Jun-2022 10:38 by rmk: Search for linebreaks directly, without calling BFILEPOS or FILEPOS just for EOL character. Also now compatible with external formats (if FFILEPOS is), and upgraded to full directory specification")
(* Newman "14-May-86 08:04")
(* ;;; "Originally coded by Larry Masinter.")
(* * No longer permanently modifies the DSPFONT when DSPFONT is not the same as the DEFAULTFONT.
-DVN "14-May-86 08:03:59")
(* ;;; "No longer permanently modifies the DSPFONT when DSPFONT is not the same as the DEFAULTFONT. -DVN '14-May-86 08:03:59'")
(* * No longer permanently modifies the DSPFONT when DSPFONT is not the same as
 the DEFAULTFONT. -DVN "14-May-86 08:03:59")
(if (LISTP FILES)
then (for FILE in FILES do (DOGREP STRS FILE))
elseif (STRPOS "*" FILES)
then (DOGREP STRS (DIRECTORY FILES NIL "*" ""))
else (RESETLST (INFILE FILES)
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(INPUT)))
(RESETSAVE NIL (LIST (QUOTE DSPFONT)
(DSPFONT)))
(bind FOUND for STR inside STRS
do (SETFILEPTR NIL 0)
(bind POS while (SETQ POS
(FFILEPOS STR NIL NIL NIL NIL NIL
UPPERCASEARRAY))
do (OR FOUND (PROGN (PRINTOUT NIL T .FONT COMMENTFONT
"(from "
(INPUT)
")" .FONT DEFAULTFONT)
(SETQ FOUND T)))
(COPYCHARS
NIL T (OR (BFILEPOS [CONSTANT
(MKSTRING (CHARACTER
(CHARCODE CR]
(INPUT)
0 POS)
0)
POS)
(DSPFONT BOLDFONT)
[COPYCHARS NIL T POS (SETQ POS (IPLUS POS
(NCHARS STR]
(DSPFONT DEFAULTFONT)
(COPYCHARS NIL T POS (ADD1 (FILEPOS
(CHARACTER (CHARCODE
CR))
NIL POS])
(if (LISTP FILES)
then (for FILE in FILES do (DOGREP STRS FILE OUTSTREAM))
elseif (STRPOS "*" FILES)
then (DOGREP STRS (DIRECTORY FILES NIL "" "")
OUTSTREAM)
elseif (DIRECTORYNAMEP FILES)
elseif (CL:WITH-OPEN-FILE
(STREAM (OR (FINDFILE FILES T)
FILES)
:DIRECTION :INPUT)
(bind FOUND for STR inside STRS first (SETFILEINFO STREAM 'ENDOFSTREAMOP
(FUNCTION NILL))
do (SETFILEPTR STREAM 0)
(bind POS while (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL UPPERCASEARRAY))
do (OR FOUND (PROGN (PRINTOUT OUTSTREAM T .FONT COMMENTFONT "(from "
(FULLNAME STREAM)
")" .FONT DEFAULTFONT T)
(SETQ FOUND T)))
(* ;; "Copying from the beginning of this line. Originally this used BFILEPOS (backwards FILEPOS?), which did repeated calls to forward FFILEPOS in what appears to be a binary set of probes. But FFILEPOS is really SLOW-POS for a single character, and the last line-start is presumaby not that far back. So just walk backwards.")
(COPYCHARS STREAM OUTSTREAM (OR [WHILE (\BACKCCODE.EOLC STREAM 'ANY)
WHEN (EQ (CHARCODE EOL)
(\PEEKCCODE STREAM T
'ANY))
DO (RETURN (ADD1 (GETFILEPTR STREAM]
0)
POS)
(DSPFONT BOLDFONT OUTSTREAM)
(COPYCHARS STREAM OUTSTREAM POS (ADD POS (NCHARS STR)))
(DSPFONT DEFAULTFONT OUTSTREAM)
(* ;; "Copying to the end of this line (or end of file)")
(BIND C DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
((EOL NIL)
(RETURN))
(PRINTCCODE C OUTSTREAM)))
(TERPRI OUTSTREAM])
(GREP
(LAMBDA (STRS FILES) (* lmm " 1-Apr-85 15:27") (RESETLST (DOGREP STRS FILES))))
[LAMBDA (STRS FILES OUTSTREAM)
(* ;; "Edited 26-Jun-2022 13:28 by rmk: added OUTSTREAM")
(* ;; "Edited 26-Jun-2022 13:25 by rmk")
(* ;; "Edited 18-Jun-2022 09:50 by rmk")
(CL:UNLESS OUTSTREAM (SETQ OUTSTREAM T)) (* lmm " 1-Apr-85 15:27")
(RESETLST
[RESETSAVE NIL `(PROGN (DSPFONT ,(DSPFONT NIL OUTSTREAM)
,OUTSTREAM]
(DOGREP STRS FILES T OUTSTREAM))])
(PHONE
[LAMBDA (NAME) (* lmm
" 5-Mar-86 12:14")
[LAMBDA (NAME) (* lmm " 5-Mar-86 12:14")
(GREP NAME (OR PHONELISTFILES (PROMPTFORWORD "Name of directory file: "])
)
(FILESLOAD BSEARCH)
(RPAQ? PHONELISTFILES )
(PUTPROPS GREP COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (392 2368 (DOGREP 402 . 2000) (GREP 2002 . 2091) (PHONE 2093 . 2366)))))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (517 4570 (DOGREP 527 . 3904) (GREP 3906 . 4383) (PHONE 4385 . 4568)))))
STOP

BIN
lispusers/GREP.LCOM
View File

Binary file not shown.

82
lispusers/PSEUDOHOSTS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Apr-2022 09:38:17" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;140 26309
(FILECREATED "25-Jun-2022 17:24:45" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;149 27524
:CHANGES-TO (FNS EXPAND.PH)
:CHANGES-TO (VARS PSEUDOHOSTSCOMS)
:PREVIOUS-DATE "24-Apr-2022 14:18:32"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>PSEUDOHOSTS.;139)
:PREVIOUS-DATE "25-Jun-2022 17:07:38"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PSEUDOHOSTS.;148)
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -40,6 +40,8 @@
(PSEUDOHOST
[LAMBDA (HOST PREFIX)
(* ;; "Edited 25-Jun-2022 17:00 by rmk")
(* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.")
(CL:WHEN (AND (LISTP HOST)
@@ -87,15 +89,15 @@
(\DEFINEDEVICE HOST
(CREATE FDEV
USING TARGETDEVICE DEVICENAME _ HOST FDEV1 _ TARGETDEVICE FDEV2 _ PREFIX
OPENFILE _ (FUNCTION OPENFILE.PH)
OPENFILELST _ NIL OPENFILE _ (FUNCTION OPENFILE.PH)
GETFILENAME _ (FUNCTION GETFILENAME.PH)
DIRECTORYNAMEP _ (FUNCTION DIRECTORYNAMEP.PH)
CLOSEFILE _ (FUNCTION CLOSEFILE.PH)
REOPENFILE _ (FUNCTION REOPENFILE.PH)
DELETEFILE _ (FUNCTION DELETEFILE.PH)
OPENP _ (FUNCTION OPENP.PH)
UNREGISTERFILE _ (FUNCTION UNREGISTERFILE.PH)
REGISTERFILE _ (FUNCTION REGISTERFILE.PH)
OPENP _ (FUNCTION \GENERIC.OPENP)
UNREGISTERFILE _ (FUNCTION \GENERIC-UNREGISTER-STREAM)
REGISTERFILE _ (FUNCTION \ADD-OPEN-STREAM)
GENERATEFILES _ (FUNCTION GENERATEFILES.PH)
GETFILEINFO _ (FUNCTION GETFILEINFO.PH)
SETFILEINFO _ (FUNCTION SETFILEINFO.PH)
@@ -310,13 +312,22 @@
(DEFINEQ
(OPENFILE.PH
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) (* ; "Edited 25-Jan-2022 08:45 by rmk")
(* ; "Edited 18-Jan-2022 10:29 by rmk")
(LET ((STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
(* ;; "Edited 25-Jun-2022 17:06 by rmk: If the stream was opened through the pseudohost, then it should only be registered on the pseudohost. We assume that it is safe to remove it from the target hosts list. The goal is that OPENP should only see it once, as being open on the pseudohost.")
(* ;; "Edited 25-Jan-2022 08:45 by rmk")
(* ;; "Edited 18-Jan-2022 10:29 by rmk")
(LET ((TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF FDEV))
(STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
FDEV)))
(CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM)
(CONTRACT.PH DATUM FDEV))
(REPLACE (STREAM DEVICE) OF STREAM WITH FDEV)
(CL:WHEN STREAM
(FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM)
(CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM)
(CONTRACT.PH DATUM FDEV))
(REPLACE (STREAM DEVICE) OF STREAM WITH FDEV))
STREAM])
(GETFILENAME.PH
@@ -336,7 +347,8 @@
DEV])
(CLOSEFILE.PH
[LAMBDA (STREAM ABORTFLG) (* ; "Edited 16-Jan-2022 15:38 by rmk")
[LAMBDA (STREAM ABORTFLG) (* ; "Edited 25-Jun-2022 14:38 by rmk")
(* ; "Edited 16-Jan-2022 15:38 by rmk")
(APPLY* (FETCH (FDEV CLOSEFILE) OF (FETCH (PHDEVICE TARGETDEV) OF (FETCH (STREAM DEVICE)
OF STREAM)))
STREAM ABORTFLG])
@@ -357,17 +369,31 @@
(PSEUDOHOST.NAME DELETEFILE (FILENAME DEV])
(OPENP.PH
[LAMBDA (FILENAME ACCESS DEVICE) (* ; "Edited 18-Jan-2022 10:29 by rmk")
[LAMBDA (FILENAME ACCESS DEVICE)
(* ;; "Edited 25-Jun-2022 15:48 by rmk: No longer called. Streams are registered in the pseudohost, not in the target device.")
(* ;; "Edited 18-Jan-2022 10:29 by rmk")
(PSEUDOHOST.TARGETVAL OPENP (FILENAME ACCESS DEVICE])
(UNREGISTERFILE.PH
[LAMBDA (DEVICE STREAM) (* ; "Edited 16-Jan-2022 16:47 by rmk")
[LAMBDA (DEVICE STREAM) (* ; "Edited 25-Jun-2022 15:07 by rmk")
(* ; "Edited 16-Jan-2022 16:47 by rmk")
(* ;;
 "This isn't called now because files are now registered in the pseudohost, not the target device.")
(APPLY* (FETCH (FDEV UNREGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE))
(FETCH (PHDEVICE TARGETDEV) OF DEVICE)
STREAM])
(REGISTERFILE.PH
[LAMBDA (DEVICE STREAM) (* ; "Edited 16-Jan-2022 16:46 by rmk")
[LAMBDA (DEVICE STREAM) (* ; "Edited 25-Jun-2022 15:07 by rmk")
(* ; "Edited 16-Jan-2022 16:46 by rmk")
(* ;; "This isn't called now, because the stream is registered in the pseudohost, not in the target device.")
(APPLY* (FETCH (FDEV REGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE))
(FETCH (PHDEVICE TARGETDEV) OF DEVICE)
STREAM])
@@ -495,13 +521,13 @@
(LOAD 'EXPORTS.ALL))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1338 9286 (PSEUDOHOST 1348 . 6823) (PSEUDOHOSTP 6825 . 7338) (PSEUDOHOSTS 7340 . 7697)
(TARGETHOST 7699 . 7973) (TRUEFILENAME 7975 . 8662) (PSEUDOFILENAME 8664 . 9284)) (9314 16853 (
EXPAND.PH 9324 . 10577) (CONTRACT.PH 10579 . 13244) (SLASHIT 13246 . 14814) (UNSLASHIT 14816 . 16562)
(GETHOSTINFO.PH 16564 . 16851)) (16854 23644 (OPENFILE.PH 16864 . 17425) (GETFILENAME.PH 17427 . 17716
) (DIRECTORYNAMEP.PH 17718 . 18342) (CLOSEFILE.PH 18344 . 18698) (REOPENFILE.PH 18700 . 19265) (
DELETEFILE.PH 19267 . 19551) (OPENP.PH 19553 . 19729) (UNREGISTERFILE.PH 19731 . 20036) (
REGISTERFILE.PH 20038 . 20339) (GENERATEFILES.PH 20341 . 21381) (GETFILEINFO.PH 21383 . 21685) (
SETFILEINFO.PH 21687 . 21886) (NEXTFILEFN.PH 21888 . 22430) (FILEINFOFN.PH 22432 . 22703) (
RENAMEFILE.PH 22705 . 23642)))))
(FILEMAP (NIL (1355 9387 (PSEUDOHOST 1365 . 6924) (PSEUDOHOSTP 6926 . 7439) (PSEUDOHOSTS 7441 . 7798)
(TARGETHOST 7800 . 8074) (TRUEFILENAME 8076 . 8763) (PSEUDOFILENAME 8765 . 9385)) (9415 16954 (
EXPAND.PH 9425 . 10678) (CONTRACT.PH 10680 . 13345) (SLASHIT 13347 . 14915) (UNSLASHIT 14917 . 16663)
(GETHOSTINFO.PH 16665 . 16952)) (16955 24859 (OPENFILE.PH 16965 . 17938) (GETFILENAME.PH 17940 . 18229
) (DIRECTORYNAMEP.PH 18231 . 18855) (CLOSEFILE.PH 18857 . 19324) (REOPENFILE.PH 19326 . 19891) (
DELETEFILE.PH 19893 . 20177) (OPENP.PH 20179 . 20474) (UNREGISTERFILE.PH 20476 . 21018) (
REGISTERFILE.PH 21020 . 21554) (GENERATEFILES.PH 21556 . 22596) (GETFILEINFO.PH 22598 . 22900) (
SETFILEINFO.PH 22902 . 23101) (NEXTFILEFN.PH 23103 . 23645) (FILEINFOFN.PH 23647 . 23918) (
RENAMEFILE.PH 23920 . 24857)))))
STOP

BIN
lispusers/PSEUDOHOSTS.LCOM
View File

Binary file not shown.

155
lispusers/comparetext
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-May-2022 16:35:56" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>comparetext.;118 46470
(FILECREATED "23-Jun-2022 22:50:45" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPARETEXT.;124 48226
:CHANGES-TO (FNS IMCOMPARE.BOXNODE)
:CHANGES-TO (FNS IMCOMPARE.LEFTBUTTONFN COMPARETEXT.TEXTOBJ COMPARETEXT IMCOMPARE.CHUNKS
IMCOMPARE.DISPLAYGRAPH COMPARETEXT.WINDOW)
:PREVIOUS-DATE "25-Feb-2022 14:36:43"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>comparetext.;116)
:PREVIOUS-DATE "20-May-2022 16:35:56"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>COMPARETEXT.;118)
(* ; "
@@ -33,11 +34,17 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(DEFINEQ
(COMPARETEXT
[LAMBDA (FILE1 FILE2 HASH.TYPE REGION FILELABELS TITLE) (* ; "Edited 12-Jan-2022 16:32 by rmk")
(* ; "Edited 8-Nov-2021 08:44 by rmk")
(* ; "Edited 8-Jan-84 21:06 by mjs")
[LAMBDA (FILE1 FILE2 HASH.TYPE CHUNKREGION FILELABELS TITLE TEXTWIDTH TEXTHEIGHT)
(* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at REGION. If REGION = NIL, the user is asked to specify a region. If REGION = T, a standard region is used.")
(* ;; "Edited 23-Jun-2022 17:13 by rmk: Clarified that the REGION is the region of the chunk window, added TEXTWIDTH and HEIGHT to specify the size of each text window.")
(* ;; "Edited 12-Jan-2022 16:32 by rmk")
(* ;; "Edited 8-Nov-2021 08:44 by rmk")
(* ;; "Edited 8-Jan-84 21:06 by mjs")
(* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at CHUNKREGION. If CHUNKREGION = NIL, the user is asked to specify a region. If CHUNKREGION = T, a standard region is used.")
(SELECTQ HASH.TYPE
((PARA LINE WORD))
@@ -55,10 +62,11 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(create IMCOMPARE.CHUNK
FILENAME _ FULLFILE2
FILEPTR _ 0)
HASH.TYPE REGION FILELABELS TITLE])
HASH.TYPE CHUNKREGION FILELABELS TITLE TEXTWIDTH TEXTHEIGHT])
(COMPARETEXT.WINDOW
[LAMBDA (GRAPH REGION TITLE) (* ; "Edited 25-Feb-2022 14:34 by rmk")
[LAMBDA (GRAPH CHUNKREGION TITLE) (* ; "Edited 23-Jun-2022 16:56 by rmk")
(* ; "Edited 25-Feb-2022 14:34 by rmk")
(* ; "Edited 19-Feb-2022 12:01 by rmk")
(* ; "Edited 2-Feb-2022 17:29 by rmk")
(* ; "Edited 23-Jan-2022 18:18 by rmk")
@@ -73,37 +81,38 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(FETCH (REGION WIDTH) OF GRAPHREGION]
[SETQ HEIGHT (IMIN 200 (IPLUS (FETCH (REGION HEIGHT) OF GRAPHREGION)
(ITIMES 2 (FONTHEIGHT DEFAULTFONT]
(SETQ REGION
(if (EQ REGION T)
(SETQ CHUNKREGION
(if (EQ CHUNKREGION T)
then (create REGION
LEFT _ 25
BOTTOM _ 25
WIDTH _ 500
HEIGHT _ 150)
elseif (REGIONP REGION)
elseif (POSITIONP REGION)
elseif (REGIONP CHUNKREGION)
elseif (POSITIONP CHUNKREGION)
THEN
(* ;;
 "This is a reference position providing the horizontal midpoint of the graph region and the top")
(RELCREATEREGION WIDTH HEIGHT 'LEFT 'TOP (IDIFFERENCE (FETCH (POSITION XCOORD)
OF REGION)
OF CHUNKREGION)
(IQUOTIENT WIDTH 2))
(FETCH (POSITION YCOORD) OF REGION))
ELSE (RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP REGION)))
[SETQ WINDOW (CREATEW REGION (OR TITLE (CONCAT "Compare text" (CL:IF FILEPREFIX
(CONCAT " of " FILEPREFIX)
"")
" showing "
(CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS)
"all"
"only different")
" chunks, hashed by "
(SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE)
(PARA "paragraph")
(LINE "line")
(WORD "word")
(SHOULDNT]
(FETCH (POSITION YCOORD) OF CHUNKREGION))
ELSE (RELCREATEREGION WIDTH HEIGHT 'RIGHT 'TOP CHUNKREGION)))
[SETQ WINDOW (CREATEW CHUNKREGION (OR TITLE (CONCAT "Compare text" (CL:IF FILEPREFIX
(CONCAT " of "
FILEPREFIX)
"")
" showing "
(CL:IF (GRAPHERPROP GRAPH 'ALLCHUNKS)
"all"
"only different")
" chunks, hashed by "
(SELECTQ (GRAPHERPROP GRAPH 'HASH.TYPE)
(PARA "paragraph")
(LINE "line")
(WORD "word")
(SHOULDNT]
(GETPROMPTWINDOW WINDOW)
(CL:WHEN (EQ WIDTH (FETCH (REGION WIDTH) OF (WINDOWREGION WINDOW)))
(WINDOWPROP WINDOW 'MAXSIZE (CONS WIDTH MAX.SMALLP)))
@@ -111,21 +120,29 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
WINDOW])
(COMPARETEXT.TEXTOBJ
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 18-Feb-2022 17:05 by rmk")
[LAMBDA (NODE WINDOW INCOL1) (* ; "Edited 23-Jun-2022 17:20 by rmk")
(* ; "Edited 18-Feb-2022 17:05 by rmk")
(* ; "Edited 30-Jan-2022 09:03 by rmk")
(* ; "Edited 28-Jan-2022 22:37 by rmk")
(* ;; "Returns the text object for the chunk column in the graphwindow WINDOW, on the left if INCOL1. If the windows are automatic, they are lined up under the middle of WINDOW.")
(DECLARE (USEDFREE COMPARETEXT.AUTOTEDIT))
(LET (TEXTOBJ TSTREAM TWINDOW REGION REGIONARGS (NODEID (FETCH (GRAPHNODE NODEID) OF NODE)))
(LET (TEXTOBJ TSTREAM TWINDOW REGION REGIONARGS TEXTWIDTH TEXTHEIGHT (GRAPH (WINDOWPROP
WINDOW
'GRAPH))
(NODEID (FETCH (GRAPHNODE NODEID) OF NODE)))
(CL:UNLESS [AND [SETQ TEXTOBJ (WINDOWPROP WINDOW (CL:IF INCOL1
'COL1TEXTOBJ
'COL2TEXTOBJ)]
(OPENWP (WFROMDS (TEXTSTREAM TEXTOBJ]
(SETQ REGIONARGS (LIST 700 600 (CL:IF INCOL1
'RIGHT
'LEFT)
(SETQ TEXTWIDTH (OR (GRAPHERPROP GRAPH 'TEXTWIDTH)
700))
(SETQ TEXTHEIGHT (OR (GRAPHERPROP GRAPH 'TEXTHEIGHT)
600))
(SETQ REGIONARGS (LIST TEXTWIDTH TEXTHEIGHT (CL:IF INCOL1
'RIGHT
'LEFT)
'TOP
`(,WINDOW 0.5 ,(CL:IF INCOL1
-1
@@ -146,10 +163,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
'COL2TEXTOBJ)
TEXTOBJ)
[WINDOWPROP TWINDOW 'TITLE (CL:IF INCOL1
(CADR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
'FILELABELS))
(CADDR (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
'FILELABELS)))]
(CADR (GRAPHERPROP GRAPH 'FILELABELS))
(CADDR (GRAPHERPROP GRAPH 'FILELABELS)))]
(MOVEWITH TWINDOW WINDOW)
(CLOSEWITH TWINDOW WINDOW))
TEXTOBJ])
@@ -216,8 +231,10 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(WINDOWPROP WINDOW 'LASTNODES (LIST NODE1 NODE2])
(IMCOMPARE.CHUNKS
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION FILELABELS TITLE) (* ; "Edited 12-Jan-2022 10:06 by rmk")
(* ; "Edited 23-Dec-2021 00:02 by rmk")
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE CHUNKREGION FILELABELS TITLE TEXTWIDTH TEXTHEIGHT)
(* ; "Edited 23-Jun-2022 17:13 by rmk")
(* ; "Edited 12-Jan-2022 10:06 by rmk")
(* ; "Edited 23-Dec-2021 00:02 by rmk")
(* ; "Edited 8-Sep-1984 00:06 by rmk")
(* ;; "This is the main text-comparison function. It compares the text in the two chunks <which may be small pieces of files, or entire files> and produces a graph showing how the sub-chunks of the two main chunks are related. The two main chunks may be in the same file, and the file may actually be an open Tedit textstream. The main chunks are broken down according to HASH.TYPE, which may be PARA <chunk by paragraph>, LINE, WORD, or PARA. The file difference graph is displayed at REGION.")
@@ -272,8 +289,8 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(* ;; "The file comparison is complete. Format and display the file difference graph")
(IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS
TITLE])
(IMCOMPARE.DISPLAYGRAPH CHUNK1 CHUNK2 HASH.TYPE CHUNKREGION CHUNKLIST1 CHUNKLIST2 FILELABELS
TITLE TEXTWIDTH TEXTHEIGHT])
(IMCOMPARE.COLLECT.HASH.CHUNKS
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 20-Jan-2022 23:09 by rmk")
@@ -314,9 +331,10 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
CHUNK))])
(IMCOMPARE.DISPLAYGRAPH
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE REGION CHUNKLIST1 CHUNKLIST2 FILELABELS TITLE)
(* ; "Edited 12-Jan-2022 09:58 by rmk")
(* ; "Edited 27-Dec-2021 11:58 by rmk")
[LAMBDA (CHUNK1 CHUNK2 HASH.TYPE CHUNKREGION CHUNKLIST1 CHUNKLIST2 FILELABELS TITLE TEXTWIDTH
TEXTHEIGHT) (* ; "Edited 23-Jun-2022 17:13 by rmk")
(* ; "Edited 12-Jan-2022 09:58 by rmk")
(* ; "Edited 27-Dec-2021 11:58 by rmk")
(* ; "Edited 23-Dec-2021 00:14 by rmk")
(* mjs "11-Jul-85 09:10")
@@ -431,8 +449,9 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
,FILE2LABEL)
COL1X
,COL1X COL2X ,COL2X ALLCHUNKS
,COMPARETEXT.ALLCHUNKS]
(SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH REGION TITLE)
,COMPARETEXT.ALLCHUNKS TEXTWIDTH ,TEXTWIDTH
TEXTHEIGHT ,TEXTHEIGHT]
(SHOWGRAPH GRAPH (COMPARETEXT.WINDOW GRAPH CHUNKREGION TITLE)
(FUNCTION IMCOMPARE.LEFTBUTTONFN)
(FUNCTION IMCOMPARE.MIDDLEBUTTONFN)
T NIL])
@@ -614,14 +633,28 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
(DEFINEQ
(IMCOMPARE.LEFTBUTTONFN
[LAMBDA (NODE WINDOW) (* ; "Edited 25-Dec-2021 23:29 by rmk")
(* ; "Edited 22-Dec-2021 21:41 by rmk")
(* ; "Edited 18-Dec-2021 13:02 by rmk")
[LAMBDA (NODE WINDOW)
(* ;; "Edited 23-Jun-2022 22:50 by rmk: Turn off previous selection before turning on new one")
(* ;; "Edited 25-Dec-2021 23:29 by rmk")
(* ;; "Edited 22-Dec-2021 21:41 by rmk")
(* ;; "Edited 18-Dec-2021 13:02 by rmk")
(* mjs " 2-Apr-85 14:21")
(CL:WHEN NODE
(LET [(INCOL1 (EQ (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
(LET ([INCOL1 (EQ (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH)
'COL1X)
(FETCH (POSITION XCOORD) OF (FETCH (GRAPHNODE NODEPOSITION) OF NODE]
TEXTOBJ)
(* ;; "Turn off any previous selection")
(CL:WHEN (SETQ TEXTOBJ (WINDOWPROP WINDOW 'COL1TEXTOBJ))
(TEDIT.SHOWSEL (TEXTSTREAM TEXTOBJ)))
(CL:WHEN (SETQ TEXTOBJ (WINDOWPROP WINDOW 'COL2TEXTOBJ))
(TEDIT.SHOWSEL (TEXTSTREAM TEXTOBJ)))
(IF (FIXP (CAR (fetch (GRAPHNODE NODEID) of NODE)))
THEN (IMCOMPARE.BOXNODE WINDOW NODE (FOR N (YPOS _ (FETCH YCOORD
OF (FETCH NODEPOSITION
@@ -743,12 +776,12 @@ Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation.
)
(PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1353 39090 (COMPARETEXT 1363 . 2863) (COMPARETEXT.WINDOW 2865 . 6366) (
COMPARETEXT.TEXTOBJ 6368 . 9076) (COMPARETEXT.SETSEL 9078 . 9868) (CHUNKNODELABEL 9870 . 10991) (
IMCOMPARE.BOXNODE 10993 . 11969) (IMCOMPARE.CHUNKS 11971 . 16347) (IMCOMPARE.COLLECT.HASH.CHUNKS 16349
. 19266) (IMCOMPARE.DISPLAYGRAPH 19268 . 27111) (IMCOMPARE.HASH 27113 . 31300) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 31302 . 34798) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 34800 . 36755) (
IMCOMPARE.SHOW.DIST 36757 . 37203) (IMCOMPARE.UPDATE.SYMBOL.TABLE 37205 . 39088)) (39091 45248 (
IMCOMPARE.LEFTBUTTONFN 39101 . 41678) (IMCOMPARE.MIDDLEBUTTONFN 41680 . 44796) (IMCOMPARE.COPYBUTTONFN
44798 . 45246)) (45301 45992 (TAIL1 45311 . 45665) (TAIL2 45667 . 45990)))))
(FILEMAP (NIL (1473 40549 (COMPARETEXT 1483 . 3123) (COMPARETEXT.WINDOW 3125 . 6923) (
COMPARETEXT.TEXTOBJ 6925 . 10067) (COMPARETEXT.SETSEL 10069 . 10859) (CHUNKNODELABEL 10861 . 11982) (
IMCOMPARE.BOXNODE 11984 . 12960) (IMCOMPARE.CHUNKS 12962 . 17570) (IMCOMPARE.COLLECT.HASH.CHUNKS 17572
. 20489) (IMCOMPARE.DISPLAYGRAPH 20491 . 28570) (IMCOMPARE.HASH 28572 . 32759) (
IMCOMPARE.MERGE.CONNECTED.CHUNKS 32761 . 36257) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36259 . 38214) (
IMCOMPARE.SHOW.DIST 38216 . 38662) (IMCOMPARE.UPDATE.SYMBOL.TABLE 38664 . 40547)) (40550 47004 (
IMCOMPARE.LEFTBUTTONFN 40560 . 43434) (IMCOMPARE.MIDDLEBUTTONFN 43436 . 46552) (IMCOMPARE.COPYBUTTONFN
46554 . 47002)) (47057 47748 (TAIL1 47067 . 47421) (TAIL2 47423 . 47746)))))
STOP

39
sources/EXTERNALFORMAT
View File

@@ -1,14 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Jun-2022 11:09:34" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;30 32742
(FILECREATED "26-Jun-2022 14:32:42" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;32 32949
:CHANGES-TO (FNS \FORMATBYTESTREAM \FORMATBYTESTRING \EXTERNALFORMAT)
(RESOURCES \FORMATBYTESTRING.STREAM)
(VARS EXTERNALFORMATCOMS)
:CHANGES-TO (VARS EXTERNALFORMATCOMS)
(MACROS \CHECKEOLC)
:PREVIOUS-DATE "18-Jun-2022 22:04:22"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;21)
:PREVIOUS-DATE "22-Jun-2022 11:09:34"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;30)
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
@@ -22,6 +21,7 @@
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
(INITVARS (*EXTERNALFORMATS* NIL)
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
@@ -263,6 +263,10 @@
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
)
(RPAQ? *EXTERNALFORMATS* NIL)
@@ -544,13 +548,14 @@
(T (SELCHARQ CH
(LF (SELECTC (OR EOLC (FFETCH (STREAM EOLCONVENTION)
OF STRM))
((LIST LF.EOLC ANY.EOLC)
((LIST LF.EOLC ANY.EOLC 'LF 'ANY)
(CHARCODE EOL))
(CHARCODE LF)))
(CR (SELECTC (OR EOLC (FFETCH (STREAM EOLCONVENTION)
OF STRM))
(CR.EOLC (CHARCODE EOL))
((LIST ANY.EOLC CRLF.EOLC)
((LIST CR.EOLC 'ANY)
(CHARCODE EOL))
((LIST ANY.EOLC CRLF.EOLC 'CRLF 'ANY)
(\CHECKEOLC.CRLF STRM PEEKBINFLG COUNTP))
(CHARCODE CR)))
CH])
@@ -620,11 +625,11 @@
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6250 11540 (\EXTERNALFORMAT 6260 . 10225) (MAKE-EXTERNALFORMAT 10227 . 11538)) (11541
14654 (\INSTALL.EXTERNALFORMAT 11551 . 13000) (\REMOVE.EXTERNALFORMAT 13002 . 13833) (FIND-FORMAT
13835 . 14652)) (14984 29243 (\OUTCHAR 14994 . 16130) (\INCCODE 16132 . 17318) (\BACKCCODE 17320 .
18214) (\BACKCCODE.EOLC 18216 . 21093) (\PEEKCCODE 21095 . 21411) (\PEEKCCODE.NOEOLC 21413 . 21675) (
\INCCODE.EOLC 21677 . 23536) (\FORMATBYTESTREAM 23538 . 25171) (\FORMATBYTESTRING 25173 . 26675) (
\CHECKEOLC.CRLF 26677 . 29241)) (30803 32646 (\CREATE.THROUGH.EXTERNALFORMAT 30813 . 31615) (
\THROUGHIN 31617 . 32037) (\THROUGHBACKCCODE 32039 . 32306) (\THROUGHOUTCHARFN 32308 . 32644)))))
(FILEMAP (NIL (6252 11542 (\EXTERNALFORMAT 6262 . 10227) (MAKE-EXTERNALFORMAT 10229 . 11540)) (11543
14656 (\INSTALL.EXTERNALFORMAT 11553 . 13002) (\REMOVE.EXTERNALFORMAT 13004 . 13835) (FIND-FORMAT
13837 . 14654)) (15105 29364 (\OUTCHAR 15115 . 16251) (\INCCODE 16253 . 17439) (\BACKCCODE 17441 .
18335) (\BACKCCODE.EOLC 18337 . 21214) (\PEEKCCODE 21216 . 21532) (\PEEKCCODE.NOEOLC 21534 . 21796) (
\INCCODE.EOLC 21798 . 23657) (\FORMATBYTESTREAM 23659 . 25292) (\FORMATBYTESTRING 25294 . 26796) (
\CHECKEOLC.CRLF 26798 . 29362)) (31010 32853 (\CREATE.THROUGH.EXTERNALFORMAT 31020 . 31822) (
\THROUGHIN 31824 . 32244) (\THROUGHBACKCCODE 32246 . 32513) (\THROUGHOUTCHARFN 32515 . 32851)))))
STOP

BIN
sources/EXTERNALFORMAT.LCOM
View File

Binary file not shown.

459
sources/WINDOW
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 2-Aug-2021 00:44:48" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>WINDOW.;3 224604
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \MEDW.DSPCREATE)
(FILECREATED "22-Jun-2022 20:19:26" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>WINDOW.;4 224622
previous date%: "13-Jun-2021 10:14:32"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>WINDOW.;2)
:CHANGES-TO (FNS CREATEW)
:PREVIOUS-DATE " 2-Aug-2021 00:44:48"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>WINDOW.;3)
(* ; "
@@ -32,7 +33,7 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
(\SCREENBITMAPS))
(GLOBALVARS \TTYREGIONOFFSETSPTR TTYREGIONOFFSETS \DEFAULTTTYDISPLAYSTREAM)
(VARIABLES \TopLevelTtyWindow))
(COMS (* ; "Window menu operations")
(COMS (* ; "Window menu operations")
(FNS WINDOW.MOUSE.HANDLER \PROTECTED.APPLY DOWINDOWCOM DOBACKGROUNDCOM
DEFAULT.BACKGROUND.COPYFN)
(VARS (BackgroundCopyMenu))
@@ -55,42 +56,42 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
(EXPORT (MACROS .COPYKEYDOWNP. WSOP))
(PROP ARGNAMES WSOP)
(RECORDS WSOPS WSDATA))
(COMS (* ; "Window utilities")
(COMS (* ; "Window utilities")
(FNS ADVISEWDS SHOWWFRAME SHOWWTITLE \STRINGWIDTHGUESS RESHOWTITLE TOTOPW
\INTERNALTOTOPW \TTW1 WHICHW)
(INITVARS (WINDOWTITLEPRINTLEVEL '(2 . 5))
(WINDOWTITLESHADE BLACKSHADE)))
[COMS (* ; "Window vs non-window world")
[COMS (* ; "Window vs non-window world")
(FNS WFROMDS NU\TOTOPWDS \COERCETODS)
(DECLARE%: DONTCOPY (EXPORT (MACROS \COERCETODS .WHILE.ON.TOP.)))
(P (MOVD 'NU\TOTOPWDS '\TOTOPWDS]
(COMS (* ; "User interface functions")
(COMS (* ; "User interface functions")
(FNS WINDOWP INSURE.WINDOW WINDOWPROP WINDOWADDPROP WINDOWDELPROP GETWINDOWPROP
GETWINDOWUSERPROP PUTWINDOWPROP REMWINDOWPROP WINDOWADDFNPROP)
(* ; "Compiled WINDOWPROP")
(* ; "Compiled WINDOWPROP")
(PROP ARGNAMES WINDOWPROP)
(OPTIMIZERS WINDOWPROP)
(FNS CWINDOWPROP CGETWINDOWPROP \GETWINDOWHEIGHT \GETWINDOWWIDTH))
(COMS (FNS OPENWP TOPWP RESHAPEBYREPAINTFN \INBETWEENP DECODE/WINDOW/OR/DISPLAYSTREAM
GROW/REGION CLRPROMPT PROMPTPRINT OPENWINDOWS \INSUREWINDOW)
(* ;
 "these entries are left in for backward compatibility. They were dedocumented 6/83. rrb")
(* ;
 "these entries are left in for backward compatibility. They were dedocumented 6/83. rrb")
(P (MOVD 'OPENWP 'ACTIVEWP))
(FNS OVERLAPPINGWINDOWS WOVERLAPP ORDERFROMBOTTOMTOTOP)
(* ; "screen size changing functions.")
(* ; "screen size changing functions.")
(FNS \ONSCREENW \PUTONSCREENW \UPDATECACHEDFIELDS \WWCHANGESCREENSIZE CREATEWFROMIMAGE
UPDATEWFROMIMAGE))
[COMS
(* ;; "MEDLEY-NATIVE-WINDOWS INTERFACE FUNCTIONS")
(* ;; "MEDLEY-NATIVE-WINDOWS INTERFACE FUNCTIONS")
(GLOBALVARS \SCREENS \SCREENTYPES)
[INITVARS
(* ;; "\SCREENS is a list of all known screens. The SCREEN-CREATE function for the screen type must register it there. It's used, e.g., by DSPCREATE to find the right screen given a screen bitmap.")
(* ;; "\SCREENS is a list of all known screens. The SCREEN-CREATE function for the screen type must register it there. It's used, e.g., by DSPCREATE to find the right screen given a screen bitmap.")
(\SCREENS)
(* ;; "\SCREENTYPES is used to interpret the values we get back from the query-for-screen-types function, and to look up the methods for creating a screen and destroying one.")
(* ;; "\SCREENTYPES is used to interpret the values we get back from the query-for-screen-types function, and to look up the methods for creating a screen and destroying one.")
(\SCREENTYPES '((1 MEDLEY OPEN-SCREEN CREATESCREEN CLOSE-SCREEN NILL)
(2 MEDLEY-COLOR-4)
@@ -100,7 +101,7 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
(32 X-COLOR)
(64 MS-WINDOWS]
(* ;; "OLD-MEDLEY-SCREEN window management functions")
(* ;; "OLD-MEDLEY-SCREEN window management functions")
(FNS \MEDW.CREATEW \MEDW.OPENW \MEDW.CLOSEW \MEDW.MOVEW \MEDW.RELMOVEW \MEDW.SHRINKW
\MEDW.EXPANDW \MEDW.SHAPEW \MEDW.REDISPLAYW \MEDW.BURYW \MEDW.TOTOPW
@@ -110,8 +111,8 @@ Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation
(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (MACROS WINDOWOP)))
(DECLARE%: DONTEVAL@COMPILE DONTEVAL@LOAD DOCOPY
(* ;;
 "Take care of installing the generic DSPCREATE over the simple one defined in LLDISPLAY.")
(* ;;
 "Take care of installing the generic DSPCREATE over the simple one defined in LLDISPLAY.")
(P (CL:UNLESS (EQUAL (GETD 'DSPCREATE)
(GETD '\GENERIC.DSPCREATE))
@@ -184,7 +185,7 @@ Middle button down moves closest corner.")
(MOVD? 'TRUE 'LISPWINDOWP))
(VARS (\WINDOWWORLD T)))
(* ;; "Arrange for the proper compiler")
(* ;; "Arrange for the proper compiler")
(PROP FILETYPE WINDOW)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
@@ -469,9 +470,9 @@ Middle button down moves closest corner.")
(RPAQQ \TTYREGIONOFFSETSPTR NIL)
(RPAQ? TTYREGIONOFFSETS '((0 . 0)
(20 . -20)
(40 . 0)
(20 . 20)))
(20 . -20)
(40 . 0)
(20 . 20)))
(RPAQ? DEFAULTTTYREGION '(153 100 384 208))
@@ -914,22 +915,23 @@ Middle button down moves closest corner.")
WINDOW])
(CREATEW
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 7-Jan-94 11:16 by nilsson")
[LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 22-Jun-2022 20:18 by rmk")
(* ; "Edited 7-Jan-94 11:16 by nilsson")
(* ;; "Generic CREATEW function.")
(LET (SCREEN REG)
(COND
[(NULL REGION)
(PROMPTPRINT "Specify region for window")
(COND
(TITLE (PROMPTPRINT " %"" TITLE "%"")))
(PROMPTPRINT "Specify region for window" (CL:IF TITLE
(CONCAT " %"" TITLE "%"")
""))
(SETQ REGION (GETSCREENREGION MinWindowWidth MinWindowHeight))
(SETQ SCREEN (fetch (SCREENREGION SCREEN) of REGION))
(SETQ REG (COPY (fetch (SCREENREGION REGION) of REGION]
((type? REGION REGION)
(SETQ SCREEN \CURSORSCREEN) (* ;
 "Protect against user smashing REGION later on.")
 "Protect against user smashing REGION later on.")
(SETQ REG (COPY REGION)))
[(type? SCREENREGION REGION)
(SETQ SCREEN (fetch (SCREENREGION SCREEN) of REGION))
@@ -1390,17 +1392,16 @@ Middle button down moves closest corner.")
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
(KEYDOWNP 'RSHIFT)
(KEYDOWNP 'COPY])
(KEYDOWNP 'RSHIFT)
(KEYDOWNP 'COPY])
(PUTPROPS WSOP MACRO [ARGS (LET ((METHOD (CADR (CAR ARGS)))
(DISPLAY (CADR ARGS))
(OTHERARGS (CDDR ARGS)))
`(SPREADAPPLY* (fetch (WSOPS ,METHOD)
of (fetch (FDEV WINDOWOPS)
of ,DISPLAY))
,DISPLAY
,@OTHERARGS])
(DISPLAY (CADR ARGS))
(OTHERARGS (CDDR ARGS)))
`(SPREADAPPLY* (fetch (WSOPS ,METHOD) of (fetch (FDEV WINDOWOPS)
of ,DISPLAY))
,DISPLAY
,@OTHERARGS])
)
(* "END EXPORTED DEFINITIONS")
@@ -1412,7 +1413,7 @@ Middle button down moves closest corner.")
(RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT))
(RECORD WSDATA (WSDESTINATION WSREGION WSBACKGROUND WSCOLORMAP)
(SYSTEM))
(SYSTEM))
)
@@ -1870,14 +1871,14 @@ Middle button down moves closest corner.")
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \COERCETODS MACRO [OPENLAMBDA (X)
(COND
((type? WINDOW X)
(fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X])
(COND
((type? WINDOW X)
(fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X])
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
(UNINTERRUPTABLY
(\INTERNALTOTOPW FIRST) . REST)))
(UNINTERRUPTABLY
(\INTERNALTOTOPW FIRST) . REST)))
)
(* "END EXPORTED DEFINITIONS")
@@ -2046,7 +2047,7 @@ Middle button down moves closest corner.")
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(DEFOPTIMIZER WINDOWPROP (&REST ARGS)
(CWINDOWPROP ARGS))
(CWINDOWPROP ARGS))
(DEFINEQ
(CWINDOWPROP
@@ -2646,12 +2647,12 @@ Middle button down moves closest corner.")
(RPAQ? \SCREENS )
(RPAQ? \SCREENTYPES '((1 MEDLEY OPEN-SCREEN CREATESCREEN CLOSE-SCREEN NILL)
(2 MEDLEY-COLOR-4)
(4 MEDLEY-COLOR-8)
(8 MEDLEY-COLOR-24)
(16 X-MONO)
(32 X-COLOR)
(64 MS-WINDOWS)))
(2 MEDLEY-COLOR-4)
(4 MEDLEY-COLOR-8)
(8 MEDLEY-COLOR-24)
(16 X-MONO)
(32 X-COLOR)
(64 MS-WINDOWS)))
@@ -3533,18 +3534,17 @@ Middle button down moves closest corner.")
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS WINDOWOP DMACRO [ARGS (LET ((OPNAME (CAR ARGS))
(METHOD-DEVICE (CADR ARGS))
(TAIL (CDDR ARGS)))
(COND
[(AND (LISTP OPNAME)
(EQ (CAR OPNAME)
'QUOTE))
`(SPREADAPPLY* (fetch (SCREEN
,(CADR OPNAME))
of ,METHOD-DEVICE)
,METHOD-DEVICE
,@TAIL]
(T (ERROR "OPNAME not quoted: " OPNAME])
(METHOD-DEVICE (CADR ARGS))
(TAIL (CDDR ARGS)))
(COND
[(AND (LISTP OPNAME)
(EQ (CAR OPNAME)
'QUOTE))
`(SPREADAPPLY* (fetch (SCREEN ,(CADR OPNAME))
of ,METHOD-DEVICE)
,METHOD-DEVICE
,@TAIL]
(T (ERROR "OPNAME not quoted: " OPNAME])
)
(* "END EXPORTED DEFINITIONS")
@@ -3580,139 +3580,138 @@ Middle button down moves closest corner.")
)
(DECLARE%: EVAL@COMPILE
(DATATYPE WINDOW (DSP (* ;
 "The display stream you use to actually printto the window.")
NEXTW (* ;
 "Next window in the open-window list")
SAVE (* ;
 "Saved image from anything this window's on top of")
REG (* ;
 "Screen region this window occupies")
BUTTONEVENTFN (* ;
 "FN called when left/middle mouse button goes up/down")
RIGHTBUTTONFN (* ;
 "FN called when right mouse button goes up/down")
CURSORINFN (* ;
 "Fn called when mouse enters window")
CURSOROUTFN (* ; "Called when mouse leaves window")
CURSORMOVEDFN (* ;
 "Called when mouse moves in window")
REPAINTFN (* ; "Redisplay part of thie window")
RESHAPEFN (* ; "Called when window is reshaped")
EXTENT (* ; "Scrolling limits")
USERDATA (* ;
 "Proplist to hold other window properites")
VERTSCROLLREG (* ; "Region of vert scroll bar")
HORIZSCROLLREG (* ; "Tegion of horiz scroll bar")
SCROLLFN (* ; "Fn to scroll this window")
VERTSCROLLWINDOW (* ; "Vert scroll bar")
HORIZSCROLLWINDOW (* ; "Horiz scroll bar")
CLOSEFN (* ; "Called at close time")
MOVEFN (* ; "Called when window is moved")
WTITLE (* ; "Window's title string, if any")
NEWREGIONFN (* ; "Called to get new window shape")
WBORDER (* ; "Window border-width, in pixels")
PROCESS (* ;
 "Medley process associated with this window")
WINDOWENTRYFN (* ;
 "Fn to call when kbd focus is switched here")
SCREEN (* ; "Screen this window appears on")
(NATIVE-HANDLE FIXP) (* ;
 "Uniterpreted place for native window to store a C pointer to its private info")
(NATIVE-INFO1 FIXP) (* ;
 "Reserved in case the pointer must be 64 bits")
(NATIVE-W1 WORD) (* ; "Word for use by native handler")
(NATIVE-W2 WORD) (* ; "Word for use by native handler")
(NATIVE-P1 POINTER) (* ;
 "Lisp pointer for use by native handler")
)
BUTTONEVENTFN _ (FUNCTION TOTOPW)
WBORDER _ WBorder WINDOWENTRYFN _ (FUNCTION GIVE.TTY.PROCESS)
(SYSTEM))
(DATATYPE WINDOW (DSP (* ;
 "The display stream you use to actually printto the window.")
NEXTW (* ;
 "Next window in the open-window list")
SAVE (* ;
 "Saved image from anything this window's on top of")
REG (* ;
 "Screen region this window occupies")
BUTTONEVENTFN (* ;
 "FN called when left/middle mouse button goes up/down")
RIGHTBUTTONFN (* ;
 "FN called when right mouse button goes up/down")
CURSORINFN (* ;
 "Fn called when mouse enters window")
CURSOROUTFN (* ; "Called when mouse leaves window")
CURSORMOVEDFN (* ; "Called when mouse moves in window")
REPAINTFN (* ; "Redisplay part of thie window")
RESHAPEFN (* ; "Called when window is reshaped")
EXTENT (* ; "Scrolling limits")
USERDATA (* ;
 "Proplist to hold other window properites")
VERTSCROLLREG (* ; "Region of vert scroll bar")
HORIZSCROLLREG (* ; "Tegion of horiz scroll bar")
SCROLLFN (* ; "Fn to scroll this window")
VERTSCROLLWINDOW (* ; "Vert scroll bar")
HORIZSCROLLWINDOW (* ; "Horiz scroll bar")
CLOSEFN (* ; "Called at close time")
MOVEFN (* ; "Called when window is moved")
WTITLE (* ; "Window's title string, if any")
NEWREGIONFN (* ; "Called to get new window shape")
WBORDER (* ; "Window border-width, in pixels")
PROCESS (* ;
 "Medley process associated with this window")
WINDOWENTRYFN (* ;
 "Fn to call when kbd focus is switched here")
SCREEN (* ; "Screen this window appears on")
(NATIVE-HANDLE FIXP) (* ;
 "Uniterpreted place for native window to store a C pointer to its private info")
(NATIVE-INFO1 FIXP) (* ;
 "Reserved in case the pointer must be 64 bits")
(NATIVE-W1 WORD) (* ; "Word for use by native handler")
(NATIVE-W2 WORD) (* ; "Word for use by native handler")
(NATIVE-P1 POINTER) (* ;
 "Lisp pointer for use by native handler")
)
BUTTONEVENTFN _ (FUNCTION TOTOPW)
WBORDER _ WBorder WINDOWENTRYFN _ (FUNCTION GIVE.TTY.PROCESS)
(SYSTEM))
(DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS
SCDATA
(DATATYPE SCREEN (SCONOFF SCDESTINATION SCWIDTH SCHEIGHT SCTOPW SCTOPWDS SCTITLEDS SCFDEV SCDS SCDATA
(* ;; "Space for native window manager interface to use.")
(* ;; "Space for native window manager interface to use.")
(HANDLE FIXP) (* ;
 "Handle for emulator to store info about display for C code use.")
(HANDLE2 FIXP) (* ;
 "Reserved in case HANDLE needs to be 64 bits on the C side.")
(NATIVE-INFO POINTER) (* ;
 "POINTER for the private use of the emulator window code")
NATIVETYPE (* ;
 "Symbol to tell what kind of native window system we're using.")
(HANDLE FIXP) (* ;
 "Handle for emulator to store info about display for C code use.")
(HANDLE2 FIXP) (* ;
 "Reserved in case HANDLE needs to be 64 bits on the C side.")
(NATIVE-INFO POINTER) (* ;
 "POINTER for the private use of the emulator window code")
NATIVETYPE (* ;
 "Symbol to tell what kind of native window system we're using.")
(* ;; "- - - Functional interface to screen management - - -")
(* ;; "- - - Functional interface to screen management - - -")
WINIMAGEOPS (* ;
 "IMAGEOPS to be used in display streas on this kind of screen")
WINFDEV (* ;
 "FDEV for display streams on this screen")
CREATEWFN (* ; "Create a window")
OPENWFN (* ; "Open a window")
CLOSEWFN (* ; "Close a window")
MOVEWFN (* ; "Move a window")
RELMOVEWFN (* ; "Move window, relative")
SHRINKWFN (* ; "Shrink window to icon")
EXPANDWFN (* ; "Expand icon to window")
SHAPEWFN (* ; "Reshape a window")
REDISPLAYFN (* ; "Redisplay (part of) a window")
GETWINDOWPROPFN (* ; "Get window property value")
PUTWINDOWPROPFN (* ; "Set window property value")
BURYWFN (* ; "Move window behind all others")
TOTOPWFN (* ;
 "Move iwindow in front of all others")
IMPORTWFN (* ;
 "Take a native window and save its state internally")
EXPORTWFN (* ;
 "Take a saved window state and open it on this screen, filling in screen and methods as needed.")
DESTROYFN (* ;
 "Destroy this window, for GC finaliszation")
SETCURSORFN (* ; "Set the cursor for this window.")
PROMPTW (* ;
 "The prompt window for this screen")
SHOWGCFN (* ;
 "Show GC indication; called with ON/OFF arg, t=>show gcing status, NIL=>turn off GC indicator.")
DSPCREATEFN (* ;
 "Create a displaystream on this screen.")
BBTTOWIN (* ;
 "BITBLT from a lisp bitmap to a window")
BBTFROMWIN (* ;
 "BITBLT from a window to a lisp bitmap")
BBTWINWIN (* ;
 "BITBLT from a window to another window.")
SCCURSOR (* ;
 "CURSOR that's in effect for this screen by default.")
SCKEYBOARD (* ;
 "Something about which keyboard we're receiving from.")
SCDEPTH (* ;
 "# of bits per pixel on the screen. THIS WILL REPLACE SCBITSPERPIXEL ASAP.")
SCCLOSEDOWN (* ;
 "Close down this screen cleanly, saving window state.")
SCCLOSESCREEN (* ;
 "Close down thie screen cleanly, no state saving.")
SCREOPEN (* ; "Reopen this screen?")
SCCARETFLASH (* ; "Function to flash thecaret.")
SCGETSCREENPOSITION (* ; "GETSCREENPOSITION")
SCGETBOXSCREENPOSITION (* ; "GETBOXPOSITION")
SCGETSCREENREGION (* ; "GETREGION")
SCMOVEPOINTER (* ; "\CURSORPOSITION")
)
SCONOFF _ 'OFF
[ACCESSFNS ((SCBITSPERPIXEL (COND
((fetch (SCREEN SCDESTINATION) of DATUM)
(fetch (BITMAP BITMAPBITSPERPIXEL)
of (fetch (SCREEN SCDESTINATION)
of DATUM)))
(T 1)))
(SCREGION (create REGION
LEFT _ 0
BOTTOM _ 0
WIDTH _ (fetch (SCREEN SCWIDTH) of DATUM)
HEIGHT _ (fetch (SCREEN SCHEIGHT) of DATUM]
(SYSTEM))
WINIMAGEOPS (* ;
 "IMAGEOPS to be used in display streas on this kind of screen")
WINFDEV (* ;
 "FDEV for display streams on this screen")
CREATEWFN (* ; "Create a window")
OPENWFN (* ; "Open a window")
CLOSEWFN (* ; "Close a window")
MOVEWFN (* ; "Move a window")
RELMOVEWFN (* ; "Move window, relative")
SHRINKWFN (* ; "Shrink window to icon")
EXPANDWFN (* ; "Expand icon to window")
SHAPEWFN (* ; "Reshape a window")
REDISPLAYFN (* ; "Redisplay (part of) a window")
GETWINDOWPROPFN (* ; "Get window property value")
PUTWINDOWPROPFN (* ; "Set window property value")
BURYWFN (* ; "Move window behind all others")
TOTOPWFN (* ;
 "Move iwindow in front of all others")
IMPORTWFN (* ;
 "Take a native window and save its state internally")
EXPORTWFN (* ;
 "Take a saved window state and open it on this screen, filling in screen and methods as needed.")
DESTROYFN (* ;
 "Destroy this window, for GC finaliszation")
SETCURSORFN (* ; "Set the cursor for this window.")
PROMPTW (* ; "The prompt window for this screen")
SHOWGCFN (* ;
 "Show GC indication; called with ON/OFF arg, t=>show gcing status, NIL=>turn off GC indicator.")
DSPCREATEFN (* ;
 "Create a displaystream on this screen.")
BBTTOWIN (* ;
 "BITBLT from a lisp bitmap to a window")
BBTFROMWIN (* ;
 "BITBLT from a window to a lisp bitmap")
BBTWINWIN (* ;
 "BITBLT from a window to another window.")
SCCURSOR (* ;
 "CURSOR that's in effect for this screen by default.")
SCKEYBOARD (* ;
 "Something about which keyboard we're receiving from.")
SCDEPTH (* ;
 "# of bits per pixel on the screen. THIS WILL REPLACE SCBITSPERPIXEL ASAP.")
SCCLOSEDOWN (* ;
 "Close down this screen cleanly, saving window state.")
SCCLOSESCREEN (* ;
 "Close down thie screen cleanly, no state saving.")
SCREOPEN (* ; "Reopen this screen?")
SCCARETFLASH (* ; "Function to flash thecaret.")
SCGETSCREENPOSITION (* ; "GETSCREENPOSITION")
SCGETBOXSCREENPOSITION (* ; "GETBOXPOSITION")
SCGETSCREENREGION (* ; "GETREGION")
SCMOVEPOINTER (* ; "\CURSORPOSITION")
)
SCONOFF _ 'OFF [ACCESSFNS ((SCBITSPERPIXEL (COND
((fetch (SCREEN SCDESTINATION)
of DATUM)
(fetch (BITMAP BITMAPBITSPERPIXEL)
of (fetch (SCREEN SCDESTINATION)
of DATUM)))
(T 1)))
(SCREGION (create REGION
LEFT _ 0
BOTTOM _ 0
WIDTH _ (fetch (SCREEN SCWIDTH)
of DATUM)
HEIGHT _ (fetch (SCREEN SCHEIGHT)
of DATUM]
(SYSTEM))
)
(/DECLAREDATATYPE 'WINDOW
@@ -4032,41 +4031,41 @@ Middle button down moves closest corner.")
(PUTPROPS WINDOW COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1992 1993 1994 1999 2000 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11548 26188 (WINDOWWORLD 11558 . 15311) (WINDOWWORLDP 15313 . 15613) (CHANGEBACKGROUND
15615 . 16652) (CHANGEBACKGROUNDBORDER 16654 . 17205) (TILE 17207 . 17799) (
\TTY.CREATING.DISPLAYSTREAM 17801 . 18348) (\CREATE.TTY.OUTCHARFN 18350 . 18650) (
\CREATE.TTYDISPLAYSTREAM 18652 . 21691) (HASTTYWINDOWP 21693 . 21973) (TTYINFOSTREAM 21975 . 22499) (
CREATESCREEN 22501 . 25444) (\INSURESCREEN 25446 . 25695) (\BITMAPTOSCREEN 25697 . 26058) (MAINSCREEN
26060 . 26186)) (26847 44130 (WINDOW.MOUSE.HANDLER 26857 . 39652) (\PROTECTED.APPLY 39654 . 39902) (
DOWINDOWCOM 39904 . 41924) (DOBACKGROUNDCOM 41926 . 43084) (DEFAULT.BACKGROUND.COPYFN 43086 . 44128))
(44211 76094 (BURYW 44221 . 44509) (CLEARW 44511 . 44901) (CLOSEW 44903 . 45677) (\CLOSEW1 45679 .
46032) (\OKTOCLOSEW 46034 . 46393) (\INTERACTIVE.CLOSEW 46395 . 47218) (OPENW 47220 . 48275) (
DOUSERFNS 48277 . 49438) (DOUSERFNS2 49440 . 49936) (\USERFNISDON'T 49938 . 50209) (\OPENW1 50211 .
50561) (CREATEW 50563 . 51827) (CREATEW1 51829 . 54107) (\CREATEW1 54109 . 55328) (OPENDISPLAYSTREAM
55330 . 55653) (MOVEW 55655 . 55870) (PPROMPT3 55872 . 56200) (\ONSCREENCLIPPINGREGION 56202 . 56753)
(RELMOVEW 56755 . 57053) (SHAPEW 57055 . 61974) (SHAPEW1 61976 . 64678) (\SHAPEW2 64680 . 67366) (
RESHOWBORDER 67368 . 67879) (\RESHOWBORDER1 67881 . 72807) (TRACKW 72809 . 73924) (SNAPW 73926 . 75599
) (WINDOWREGION 75601 . 76092)) (76095 76791 (MINIMUMWINDOWSIZE 76105 . 76789)) (78548 101813 (
ADVISEWDS 78558 . 86501) (SHOWWFRAME 86503 . 88255) (SHOWWTITLE 88257 . 92291) (\STRINGWIDTHGUESS
92293 . 92652) (RESHOWTITLE 92654 . 97295) (TOTOPW 97297 . 97536) (\INTERNALTOTOPW 97538 . 98628) (
\TTW1 98630 . 101230) (WHICHW 101232 . 101811)) (101942 104780 (WFROMDS 101952 . 103950) (NU\TOTOPWDS
103952 . 104388) (\COERCETODS 104390 . 104778)) (105471 112271 (WINDOWP 105481 . 105627) (
INSURE.WINDOW 105629 . 105968) (WINDOWPROP 105970 . 106402) (WINDOWADDPROP 106404 . 108138) (
WINDOWDELPROP 108140 . 108566) (GETWINDOWPROP 108568 . 109118) (GETWINDOWUSERPROP 109120 . 109547) (
PUTWINDOWPROP 109549 . 110014) (REMWINDOWPROP 110016 . 111071) (WINDOWADDFNPROP 111073 . 112269)) (
112479 120043 (CWINDOWPROP 112489 . 113494) (CGETWINDOWPROP 113496 . 118714) (\GETWINDOWHEIGHT 118716
. 119624) (\GETWINDOWWIDTH 119626 . 120041)) (120044 135492 (OPENWP 120054 . 120332) (TOPWP 120334 .
120617) (RESHAPEBYREPAINTFN 120619 . 130871) (\INBETWEENP 130873 . 131089) (
DECODE/WINDOW/OR/DISPLAYSTREAM 131091 . 133131) (GROW/REGION 133133 . 133696) (CLRPROMPT 133698 .
134102) (PROMPTPRINT 134104 . 134368) (OPENWINDOWS 134370 . 135154) (\INSUREWINDOW 135156 . 135490)) (
135623 138872 (OVERLAPPINGWINDOWS 135633 . 137915) (WOVERLAPP 137917 . 138172) (ORDERFROMBOTTOMTOTOP
138174 . 138870)) (138921 143704 (\ONSCREENW 138931 . 139637) (\PUTONSCREENW 139639 . 140466) (
\UPDATECACHEDFIELDS 140468 . 140732) (\WWCHANGESCREENSIZE 140734 . 142123) (CREATEWFROMIMAGE 142125 .
143088) (UPDATEWFROMIMAGE 143090 . 143702)) (144261 200125 (\MEDW.CREATEW 144271 . 148945) (
\MEDW.OPENW 148947 . 151305) (\MEDW.CLOSEW 151307 . 152673) (\MEDW.MOVEW 152675 . 163287) (
\MEDW.RELMOVEW 163289 . 163668) (\MEDW.SHRINKW 163670 . 171854) (\MEDW.EXPANDW 171856 . 174123) (
\MEDW.SHAPEW 174125 . 178731) (\MEDW.REDISPLAYW 178733 . 180688) (\MEDW.BURYW 180690 . 181972) (
\MEDW.TOTOPW 181974 . 183322) (\MEDW.DSPCREATE 183324 . 185828) (\GENERIC.DSPCREATE 185830 . 189294) (
\MEDW.GETWINDOWPROP 189296 . 191534) (\MEDW.PUTWINDOWPROP 191536 . 198321) (\MEDW.CURSOR 198323 .
200123)) (200126 200746 (\GENERIC.CURSOR 200136 . 200744)))))
(FILEMAP (NIL (11536 26176 (WINDOWWORLD 11546 . 15299) (WINDOWWORLDP 15301 . 15601) (CHANGEBACKGROUND
15603 . 16640) (CHANGEBACKGROUNDBORDER 16642 . 17193) (TILE 17195 . 17787) (
\TTY.CREATING.DISPLAYSTREAM 17789 . 18336) (\CREATE.TTY.OUTCHARFN 18338 . 18638) (
\CREATE.TTYDISPLAYSTREAM 18640 . 21679) (HASTTYWINDOWP 21681 . 21961) (TTYINFOSTREAM 21963 . 22487) (
CREATESCREEN 22489 . 25432) (\INSURESCREEN 25434 . 25683) (\BITMAPTOSCREEN 25685 . 26046) (MAINSCREEN
26048 . 26174)) (26823 44106 (WINDOW.MOUSE.HANDLER 26833 . 39628) (\PROTECTED.APPLY 39630 . 39878) (
DOWINDOWCOM 39880 . 41900) (DOBACKGROUNDCOM 41902 . 43060) (DEFAULT.BACKGROUND.COPYFN 43062 . 44104))
(44187 76265 (BURYW 44197 . 44485) (CLEARW 44487 . 44877) (CLOSEW 44879 . 45653) (\CLOSEW1 45655 .
46008) (\OKTOCLOSEW 46010 . 46369) (\INTERACTIVE.CLOSEW 46371 . 47194) (OPENW 47196 . 48251) (
DOUSERFNS 48253 . 49414) (DOUSERFNS2 49416 . 49912) (\USERFNISDON'T 49914 . 50185) (\OPENW1 50187 .
50537) (CREATEW 50539 . 51998) (CREATEW1 52000 . 54278) (\CREATEW1 54280 . 55499) (OPENDISPLAYSTREAM
55501 . 55824) (MOVEW 55826 . 56041) (PPROMPT3 56043 . 56371) (\ONSCREENCLIPPINGREGION 56373 . 56924)
(RELMOVEW 56926 . 57224) (SHAPEW 57226 . 62145) (SHAPEW1 62147 . 64849) (\SHAPEW2 64851 . 67537) (
RESHOWBORDER 67539 . 68050) (\RESHOWBORDER1 68052 . 72978) (TRACKW 72980 . 74095) (SNAPW 74097 . 75770
) (WINDOWREGION 75772 . 76263)) (76266 76962 (MINIMUMWINDOWSIZE 76276 . 76960)) (78609 101874 (
ADVISEWDS 78619 . 86562) (SHOWWFRAME 86564 . 88316) (SHOWWTITLE 88318 . 92352) (\STRINGWIDTHGUESS
92354 . 92713) (RESHOWTITLE 92715 . 97356) (TOTOPW 97358 . 97597) (\INTERNALTOTOPW 97599 . 98689) (
\TTW1 98691 . 101291) (WHICHW 101293 . 101872)) (102003 104841 (WFROMDS 102013 . 104011) (NU\TOTOPWDS
104013 . 104449) (\COERCETODS 104451 . 104839)) (105484 112284 (WINDOWP 105494 . 105640) (
INSURE.WINDOW 105642 . 105981) (WINDOWPROP 105983 . 106415) (WINDOWADDPROP 106417 . 108151) (
WINDOWDELPROP 108153 . 108579) (GETWINDOWPROP 108581 . 109131) (GETWINDOWUSERPROP 109133 . 109560) (
PUTWINDOWPROP 109562 . 110027) (REMWINDOWPROP 110029 . 111084) (WINDOWADDFNPROP 111086 . 112282)) (
112488 120052 (CWINDOWPROP 112498 . 113503) (CGETWINDOWPROP 113505 . 118723) (\GETWINDOWHEIGHT 118725
. 119633) (\GETWINDOWWIDTH 119635 . 120050)) (120053 135501 (OPENWP 120063 . 120341) (TOPWP 120343 .
120626) (RESHAPEBYREPAINTFN 120628 . 130880) (\INBETWEENP 130882 . 131098) (
DECODE/WINDOW/OR/DISPLAYSTREAM 131100 . 133140) (GROW/REGION 133142 . 133705) (CLRPROMPT 133707 .
134111) (PROMPTPRINT 134113 . 134377) (OPENWINDOWS 134379 . 135163) (\INSUREWINDOW 135165 . 135499)) (
135632 138881 (OVERLAPPINGWINDOWS 135642 . 137924) (WOVERLAPP 137926 . 138181) (ORDERFROMBOTTOMTOTOP
138183 . 138879)) (138930 143713 (\ONSCREENW 138940 . 139646) (\PUTONSCREENW 139648 . 140475) (
\UPDATECACHEDFIELDS 140477 . 140741) (\WWCHANGESCREENSIZE 140743 . 142132) (CREATEWFROMIMAGE 142134 .
143097) (UPDATEWFROMIMAGE 143099 . 143711)) (144246 200110 (\MEDW.CREATEW 144256 . 148930) (
\MEDW.OPENW 148932 . 151290) (\MEDW.CLOSEW 151292 . 152658) (\MEDW.MOVEW 152660 . 163272) (
\MEDW.RELMOVEW 163274 . 163653) (\MEDW.SHRINKW 163655 . 171839) (\MEDW.EXPANDW 171841 . 174108) (
\MEDW.SHAPEW 174110 . 178716) (\MEDW.REDISPLAYW 178718 . 180673) (\MEDW.BURYW 180675 . 181957) (
\MEDW.TOTOPW 181959 . 183307) (\MEDW.DSPCREATE 183309 . 185813) (\GENERIC.DSPCREATE 185815 . 189279) (
\MEDW.GETWINDOWPROP 189281 . 191519) (\MEDW.PUTWINDOWPROP 191521 . 198306) (\MEDW.CURSOR 198308 .
200108)) (200111 200731 (\GENERIC.CURSOR 200121 . 200729)))))
STOP

BIN
sources/WINDOW.LCOM
View File

Binary file not shown.

40
sources/XCCS
View File

@@ -1,10 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Sep-2021 19:49:22" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;47 13404
changes to%: (FNS \CREATE.XCCS.EXTERNALFORMAT)
(FILECREATED "26-Jun-2022 14:33:06" {DSK}<users>kaplan>local>medley3.5>working-medley>sources>XCCS.;48 13142
previous date%: "13-Aug-2021 14:08:48"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;46)
:CHANGES-TO (VARS XCCSCOMS)
:PREVIOUS-DATE "10-Sep-2021 19:49:22"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>XCCS.;47)
(PRETTYCOMPRINT XCCSCOMS)
@@ -15,7 +16,6 @@
(FNS \CREATE.XCCS.EXTERNALFORMAT)
(FNS \NSIN.24BITENCODING.ERROR)
(INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*))
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
(INITVARS (\DEFAULTINCCODE '\XCCSINCCODE)
(\DEFAULTOUTCHAR '\XCCSOUTCHAR)
(\DEFAULTPEEKCCODE '\XCCSPEEKCCODE)
@@ -241,10 +241,6 @@
)
(RPAQ? *SIGNAL-24BIT-NSENCODING-ERROR* )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DEFAULTINCCODE \DEFAULTOUTCHAR \DEFAULTBACKCCODE \DEFAULTPEEKCCODE)
)
(RPAQ? \DEFAULTINCCODE '\XCCSINCCODE)
@@ -268,19 +264,19 @@
(PUTPROPS \RUNCODED MACRO (OPENLAMBDA (STREAM)
(* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented")
(* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented")
(* ;
 "note that neq is ok since charsets are known to be SMALLP's")
(NEQ (fetch CHARSET of STREAM)
\NORUNCODE)))
 "note that neq is ok since charsets are known to be SMALLP's")
(NEQ (fetch CHARSET of STREAM)
\NORUNCODE)))
)
(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE)
`((OPENLAMBDA (STRM)
(FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STRM)
STRM
,NEWVALUE))
,STREAM))
`((OPENLAMBDA (STRM)
(FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STRM)
STRM
,NEWVALUE))
,STREAM))
(* "END EXPORTED DEFINITIONS")
@@ -290,8 +286,8 @@
(\CREATE.XCCS.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1319 1548 (ACCESS-CHARSET 1329 . 1546)) (1549 10417 (\XCCSINCCODE 1559 . 4331) (
\XCCSPEEKCCODE 4333 . 6869) (\XCCSOUTCHAR 6871 . 9091) (\XCCSBACKCCODE 9093 . 10088) (
\XCCSFORMATBYTESTREAM 10090 . 10415)) (10418 10976 (\CREATE.XCCS.EXTERNALFORMAT 10428 . 10974)) (10977
11808 (\NSIN.24BITENCODING.ERROR 10987 . 11806)))))
(FILEMAP (NIL (1218 1447 (ACCESS-CHARSET 1228 . 1445)) (1448 10316 (\XCCSINCCODE 1458 . 4230) (
\XCCSPEEKCCODE 4232 . 6768) (\XCCSOUTCHAR 6770 . 8990) (\XCCSBACKCCODE 8992 . 9987) (
\XCCSFORMATBYTESTREAM 9989 . 10314)) (10317 10875 (\CREATE.XCCS.EXTERNALFORMAT 10327 . 10873)) (10876
11707 (\NSIN.24BITENCODING.ERROR 10886 . 11705)))))
STOP

BIN
sources/XCCS.LCOM
View File

Binary file not shown.