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

DEFINE-FILE-INFO with its own reader environment (#381)

Browse Source 
* DEFINE-FILE-INFO with its own reader environment

Including format.  That reader environment also allows colon as a package delimiter, in addition to the funky control and upper panel character.

"Function" is now a synonym for character set 2.  WITH-READER-ENVIRONMENT doesn't bind EXTERNALFORMAT.

* Changed *DEFAULT-MAKEFILE-ENVIRONMENT* to use Interlisp rdtbl

* Store FDEV's default externalformat in the FDEV

And related adjustments so that the display output stream (which is created in various places) is always created with the right (CR) EOL convention.  Also a little simpler interface for creating external formats.
This commit is contained in:
rmkaplan
2021-08-05 13:43:08 -07:00
committed by GitHub
parent 3fc26567c0
commit d64e9282bf
33 changed files with 32623 additions and 30396 deletions
Download Patch File Download Diff File Expand all files Collapse all files

214
sources/BOOTSTRAP
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 9-Jul-2021 15:32:36" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;20 40815
(FILECREATED "30-Jul-2021 10:02:14" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;49 46093
changes to%: (FNS \LOAD-STREAM \DO-DEFINE-FILE-INFO)
changes to%: (FNS READ-READER-ENVIRONMENT)
previous date%: " 9-Jul-2021 14:02:39"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;18)
previous date%: "29-Jul-2021 20:31:41"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;48)
(* ; "
@@ -21,7 +21,11 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(COMS (* ;
 "Need these in order to load even compiled files SYSLOAD")
(FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD
PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME DEFINE-FILE-INFO \DO-DEFINE-FILE-INFO))
PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME))
[COMS (* ; "For DEFINE-FILE-INFO")
(FNS DEFINE-FILE-INFO \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT
READ-READER-ENVIRONMENT MAKE-DEFINE-FILE-INFO-ENV)
(INITVARS (*DEFINE-FILE-INFO-ENV* (MAKE-DEFINE-FILE-INFO-ENV]
(INITVARS (EOLCHARCODE (CHCON1 "
"))
(PRETTYHEADER)
@@ -365,7 +369,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(\LOAD-STREAM
[LAMBDA (STREAM LDFLG PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)
(DECLARE (SPECVARS LDFLG PRINTFLG LOAD-VERBOSE-STREAM))
(* ; "Edited 9-Jul-2021 15:30 by rmk:")
(* ; "Edited 17-Jul-2021 21:58 by rmk:")
(* ;;; "Internal function that loads from an already open stream. LOAD-VERBOSE-STREAM if non-nil is the stream to which to print %"file created%" messages and such. Similarly, PRINTFLG, if non-nil, is the stream to which to print the value of each expression.")
@@ -380,11 +384,11 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(ADDSPELLFLG ADDSPELLFLG)
(LISPXHIST LISPXHIST)
(PRLST (AND FILEPKGFLG (FILEPKGCHANGES)))
(FILECREATEDENV *OLD-INTERLISP-READ-ENVIRONMENT*)
(DEFINEDENV)
FILEMAP FNADRLST ROOTNAME TEM FILECREATEDLST LOADA MAYBEWANTFILEMAP INTERLISP-P
FILECREATEDLOC)
(DECLARE (SPECVARS DFNFLG BUILDMAPFLG FILEPKGFLG ADDSPELLFLG LISPXHIST FILECREATEDLST
FILECREATEDENV FILECREATEDLOC FILE))
DEFINEDENV FILECREATEDLOC FILE))
(if (AND LOAD-VERBOSE-STREAM FILE)
then (LISPXTERPRI LOAD-VERBOSE-STREAM)
(if (NEQ LOAD-VERBOSE-STREAM T)
@@ -439,7 +443,21 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
then (RETURN (\CML-LOAD STREAM PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)))
(if (AND BUILDMAPFLG (RANDACCESSP STREAM))
then (SETQ MAYBEWANTFILEMAP T))
(WITH-READER-ENVIRONMENT FILECREATEDENV
(* ;; "Get the environment from the DEFINE-FILE-INFO expression. This is read in the DEFINE-FILE-INFO-ENVIRONMENT.")
(SETQ DEFINEDENV (READ-READER-ENVIRONMENT STREAM *OLD-INTERLISP-READ-ENVIRONMENT*))
(CL:WHEN PACKAGE
(* ;; "Caller better really mean it--overrides what's on file! But we don't want to smash what the reader returned, couldbe the old-interlisp-file-env.")
[SETQ DEFINEDENV (CREATE READER-ENVIRONMENT USING DEFINEDENV REPACKAGE _
(SETQ *PACKAGE*
(\DTEST PACKAGE 'PACKAGE])
(* ;; "At this point we have the environment for the file, the external format is set. We now read/interpret all the other forms.")
(WITH-READER-ENVIRONMENT DEFINEDENV
(PROG (ADR)
LP (if FILEMAP
then (* ;
@@ -476,8 +494,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(ADDFILE FILE T PRLST FILECREATEDLST))
[if FILEMAP
then (PUTFILEMAP FILE (CAR FILEMAP)
FILECREATEDLST FILECREATEDENV NIL FILECREATEDLOC
)
FILECREATEDLST DEFINEDENV NIL FILECREATEDLOC)
(if UPDATEMAPFLG
then (SETFILEPTR STREAM ADR)
(* ;
@@ -490,22 +507,6 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
[if (LISTP LOADA)
then
(SELECTQ (CAR LOADA)
(DEFINE-FILE-INFO (* ;
 "Handle this specially, since we want to remember the environment")
(SETQ FILECREATEDLOC (GETFILEPTR STREAM))
(SET-READER-ENVIRONMENT [SETQ LOADA
(SETQ FILECREATEDENV
(\DO-DEFINE-FILE-INFO
STREAM
(CDR LOADA]
STREAM)
[if PACKAGE
then (* ;
 "Caller better really mean it--overrides what's on file!")
(replace REPACKAGE of
FILECREATEDENV
with (SETQ *PACKAGE*
(\DTEST PACKAGE 'PACKAGE])
(FILECREATED (if MAYBEWANTFILEMAP
then (* ; "See if we have a valid file map")
(SETQ ADR (GETFILEPTR STREAM))
@@ -517,7 +518,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
'FILEMAP)
(NULL (CAR (SETQ TEM (CADR TEM]
then (* ; "Has ok map")
(PUTFILEMAP FILE TEM NIL FILECREATEDENV)
(PUTFILEMAP FILE TEM NIL DEFINEDENV)
else (* ;
 "Need to build a file map as we go")
(SETQ FILEMAP (TCONC NIL NIL)))
@@ -696,6 +697,13 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(FULLNAME NAME))
(T NAME))
(NOT COMPFLG])
)
(* ; "For DEFINE-FILE-INFO")
(DEFINEQ
(DEFINE-FILE-INFO
[NLAMBDA ARGS (* bvm%: "13-Oct-86 17:24")
@@ -706,34 +714,39 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL ARGS])
(\DO-DEFINE-FILE-INFO
[LAMBDA (STREAM ARGS) (* ; "Edited 9-Jul-2021 15:32 by rmk:")
[LAMBDA (STREAM ARGS) (* ; "Edited 17-Jul-2021 22:17 by rmk:")
(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")
(* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM")
(LET (PACKAGE READTABLE BASE FORMAT VALUE)
[for TAIL on ARGS by (CDDR TAIL)
do (SETQ VALUE (CADR TAIL))
(SELECTQ (CAR TAIL)
(:PACKAGE (SETQ PACKAGE
(OR (if (LISTP VALUE)
then (LET ((P (EVAL VALUE)))
(if (TYPEP P 'PACKAGE)
then P
else (CL:FIND-PACKAGE P)))
else (CL:FIND-PACKAGE VALUE))
(ERROR "Can't find package for reader environment" VALUE))))
(:READTABLE (SETQ READTABLE (OR (if (LISTP VALUE)
then (\DTEST (EVAL VALUE)
'READTABLEP)
else (FIND-READTABLE VALUE))
(ERROR
((:PACKAGE %:PACKAGE)
(SETQ PACKAGE
(OR (if (LISTP VALUE)
then (LET ((P (EVAL VALUE)))
(if (TYPEP P 'PACKAGE)
then P
else (CL:FIND-PACKAGE P)))
else (CL:FIND-PACKAGE VALUE))
(ERROR "Can't find package for reader environment" VALUE))))
((:READTABLE %:READTABLE)
(SETQ READTABLE (OR (if (LISTP VALUE)
then (\DTEST (EVAL VALUE)
'READTABLEP)
else (FIND-READTABLE VALUE))
(ERROR
"Can't find read table for reader environment"
VALUE))))
(:BASE (SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE)
VALUE))))
((:BASE %:BASE)
(SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE)
then (EVAL VALUE)
else VALUE))
(ERROR "Bad read base for reader environment" VALUE))))
((:FORMAT FORMAT)
((:FORMAT FORMAT %:FORMAT)
(SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT
VALUE))))
(ERROR "Unrecognized file info key" (CAR TAIL]
@@ -747,8 +760,100 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
REREADTABLE _ (OR READTABLE FILERDTBL)
REBASE _ (OR BASE 10)
REFORMAT _ FORMAT])
(PRINT-READER-ENVIRONMENT
[LAMBDA (ENV STREAM) (* ; "Edited 18-Jul-2021 09:05 by rmk:")
(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")
(CL:UNLESS (EQUAL-READER-ENVIRONMENT ENV *OLD-INTERLISP-READ-ENVIRONMENT*)
(LET ((*PACKAGE* *INTERLISP-PACKAGE*)
(*PRINT-BASE* 10)
PKG)
(PRINT [CONS 'DEFINE-FILE-INFO `(,@[AND (SETQ PKG (fetch REPACKAGE of ENV))
`(:PACKAGE ,(CL:PACKAGE-NAME PKG]
:READTABLE
,(READTABLEPROP (fetch REREADTABLE of ENV)
'NAME)
:BASE
,(fetch REBASE of ENV)
:FORMAT
,(FETCH REFORMAT OF ENV]
STREAM
(FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*))))])
(READ-READER-ENVIRONMENT
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 30-Jul-2021 09:58 by rmk:")
(* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")
(* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")
(CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
(LET ((START (GETFILEPTR STREAM))
ARGS
(ENV DEFAULTENV)
(*READTABLE* (FETCH (READER-ENVIRONMENT REREADTABLE) OF
*OLD-INTERLISP-READ-ENVIRONMENT*
)))
(DECLARE (SPECVARS *READTABLE*))
(SELCHARQ (SKIPSEPRCODES STREAM)
(";" (* ; "Assume it's a common lisp file")
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
*COMMON-LISP-READ-ENVIRONMENT*
))
*COMMON-LISP-READ-ENVIRONMENT*)
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
*DEFINE-FILE-INFO-ENV*
)) (* ;
 "Should we reset the format if we fail?")
(READCCODE STREAM)
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
(IF (EQ 'DEFINE-FILE-INFO (RATOM STREAM))
THEN
(* ;;
 "After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
[SETQ ENV (\DO-DEFINE-FILE-INFO STREAM (SETQ ARGS
(CL:READ-DELIMITED-LIST
(CHARCODE ")")
STREAM]
ELSE (* ; "Hope we are RANDACCESSP")
(SETFILEPTR STREAM START))
(* ;;
 "If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
(CL:IF (AND RETURNFORM ARGS)
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
ENV)))
DEFAULTENV])
(MAKE-DEFINE-FILE-INFO-ENV
[LAMBDA NIL (* ; "Edited 29-Jul-2021 20:29 by rmk:")
(* ;; "Makes the reader environment and read table used for printing and reading the DEFINE-FILE-INFO expression. Like the OLD-INTERLISP-FILE, but : is the preferred package delim")
(LET [(RTBL (COPYREADTABLE (FETCH REREADTABLE OF *OLD-INTERLISP-READ-ENVIRONMENT*]
(* ;;
 "But this is all rather silly: Why not just have ordinary Interlisp atoms for the key words. ")
(* (READTABLEPROP RTBL
 (QUOTE PACKAGECHAR)
 (CHARCODE %:)))
(SETSYNTAX (CHARCODE %:)
'PACKAGEDELIM RTBL) (* ;
 "In transition: read : but don't yet put it out")
(* ;; "The INTERLISP package doesn't exist in bootstrap, the REPACKAGE field is filled in in PACKAGE-ENABLE in PACKAGE-STARTUP")
(CREATE READER-ENVIRONMENT USING *OLD-INTERLISP-READ-ENVIRONMENT* REREADTABLE _ RTBL
])
)
(RPAQ? *DEFINE-FILE-INFO-ENV* (MAKE-DEFINE-FILE-INFO-ENV))
(RPAQ? EOLCHARCODE (CHCON1 "
"))
@@ -849,12 +954,13 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4465 14137 (GETPROP 4475 . 5047) (SETATOMVAL 5049 . 5178) (RPAQQ 5180 . 5233) (RPAQ
5235 . 5547) (RPAQ? 5549 . 5919) (MOVD 5921 . 7785) (MOVD? 7787 . 8217) (SELECTQ 8219 . 8406) (
SELECTQ1 8408 . 8750) (NCONC1 8752 . 8948) (PUTPROP 8950 . 10434) (PROPNAMES 10436 . 10627) (ADDPROP
10629 . 12692) (REMPROP 12694 . 13548) (MEMB 13550 . 13809) (CLOSEF? 13811 . 14135)) (14210 38711 (
LOAD 14220 . 15389) (\LOAD-STREAM 15391 . 29116) (FILECREATED 29118 . 30536) (FILECREATED1 30538 .
31646) (PRETTYCOMPRINT 31648 . 32133) (BOOTSTRAP-NAMEFIELD 32135 . 33095) (PUTPROPS 33097 . 33465) (
DECLARE%: 33467 . 33599) (DECLARE%:1 33601 . 34473) (ROOTFILENAME 34475 . 35423) (DEFINE-FILE-INFO
35425 . 35860) (\DO-DEFINE-FILE-INFO 35862 . 38709)))))
(FILEMAP (NIL (4740 14412 (GETPROP 4750 . 5322) (SETATOMVAL 5324 . 5453) (RPAQQ 5455 . 5508) (RPAQ
5510 . 5822) (RPAQ? 5824 . 6194) (MOVD 6196 . 8060) (MOVD? 8062 . 8492) (SELECTQ 8494 . 8681) (
SELECTQ1 8683 . 9025) (NCONC1 9027 . 9223) (PUTPROP 9225 . 10709) (PROPNAMES 10711 . 10902) (ADDPROP
10904 . 12967) (REMPROP 12969 . 13823) (MEMB 13825 . 14084) (CLOSEF? 14086 . 14410)) (14485 35049 (
LOAD 14495 . 15664) (\LOAD-STREAM 15666 . 28740) (FILECREATED 28742 . 30160) (FILECREATED1 30162 .
31270) (PRETTYCOMPRINT 31272 . 31757) (BOOTSTRAP-NAMEFIELD 31759 . 32719) (PUTPROPS 32721 . 33089) (
DECLARE%: 33091 . 33223) (DECLARE%:1 33225 . 34097) (ROOTFILENAME 34099 . 35047)) (35087 43925 (
DEFINE-FILE-INFO 35097 . 35532) (\DO-DEFINE-FILE-INFO 35534 . 38596) (PRINT-READER-ENVIRONMENT 38598
. 39879) (READ-READER-ENVIRONMENT 39881 . 42647) (MAKE-DEFINE-FILE-INFO-ENV 42649 . 43923)))))
STOP

BIN
sources/BOOTSTRAP.LCOM
View File

Binary file not shown.

66
sources/CMLREAD
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 9-Jul-2021 08:09:06" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;9 12772
(FILECREATED "29-Jul-2021 20:34:35" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;10 14968
changes to%: (RECORDS READER-ENVIRONMENT)
changes to%: (FUNCTIONS WITH-READER-ENVIRONMENT)
previous date%: " 3-Jul-2021 13:32:59"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;8)
previous date%: " 9-Jul-2021 08:09:06"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;9)
(* ; "
@@ -256,9 +256,7 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(LET ((*PACKAGE* (ffetch (READER-ENVIRONMENT REPACKAGE) of E))
(*READTABLE* (ffetch (READER-ENVIRONMENT REREADTABLE) of E))
(*READ-BASE* (ffetch (READER-ENVIRONMENT REBASE) of E))
(*PRINT-BASE* (ffetch (READER-ENVIRONMENT REBASE) of E))
(*EXTERNALFORMAT* (ffetch (READER-ENVIRONMENT REFORMAT) of E)))
(DECLARE (SPECVARS *EXTERNALFORMAT*))
(*PRINT-BASE* (ffetch (READER-ENVIRONMENT REBASE) of E)))
,@BODY))
(\DTEST ,ENV 'READER-ENVIRONMENT)))
@@ -285,10 +283,54 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
CL:LISTEN CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE
CL:COPY-READTABLE)
)
(PRETTYCOMPRINT CMLREADCOMS)
(RPAQQ CMLREADCOMS
[(COMS
(* ;; "Misc Common Lisp reader functions")
(FNS CL:COPY-READTABLE)
(FNS CL:READ-LINE CL:READ-CHAR CL:UNREAD-CHAR CL:PEEK-CHAR CL:LISTEN
CL:READ-CHAR-NO-HANG CL:CLEAR-INPUT CL:READ-FROM-STRING CL:READ-BYTE CL:WRITE-BYTE
)
(* ;
 "must turn off packed version of CLISP infix")
(VARS [CLISPCHARS (LDIFFERENCE CLISPCHARS '(- *]
(CLISPCHARRAY (MAKEBITTABLE CLISPCHARS))
(DWIMINMACROSFLG))
(VARIABLES *READ-DEFAULT-FLOAT-FORMAT*)
(GLOBALVARS CMLRDTBL READ-LINE-RDTBL))
[COMS
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
(RECORDS READER-ENVIRONMENT)
(FUNCTIONS WITH-READER-ENVIRONMENT)
(ADDVARS (SYSSPECVARS *PACKAGE* *READTABLE* *READ-BASE* *PRINT-BASE*))
(PROP INFO WITH-READER-ENVIRONMENT)
(GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*)
(INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _
(CL:FIND-PACKAGE "USER")
REREADTABLE _ CMLRDTBL REBASE _ 10
REFORMAT _ :XCCS]
(PROP FILETYPE CMLREAD)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG
CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR
CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
)
(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2592 3577 (CL:COPY-READTABLE 2602 . 3575)) (3578 10211 (CL:READ-LINE 3588 . 4460) (
CL:READ-CHAR 4462 . 5012) (CL:UNREAD-CHAR 5014 . 5475) (CL:PEEK-CHAR 5477 . 7461) (CL:LISTEN 7463 .
7728) (CL:READ-CHAR-NO-HANG 7730 . 8502) (CL:CLEAR-INPUT 8504 . 8741) (CL:READ-FROM-STRING 8743 . 9498
) (CL:READ-BYTE 9500 . 9953) (CL:WRITE-BYTE 9955 . 10209)))))
(FILEMAP (NIL (2600 3585 (CL:COPY-READTABLE 2610 . 3583)) (3586 10219 (CL:READ-LINE 3596 . 4468) (
CL:READ-CHAR 4470 . 5020) (CL:UNREAD-CHAR 5022 . 5483) (CL:PEEK-CHAR 5485 . 7469) (CL:LISTEN 7471 .
7736) (CL:READ-CHAR-NO-HANG 7738 . 8510) (CL:CLEAR-INPUT 8512 . 8749) (CL:READ-FROM-STRING 8751 . 9506
) (CL:READ-BYTE 9508 . 9961) (CL:WRITE-BYTE 9963 . 10217)))))
STOP

BIN
sources/CMLREAD.LCOM
View File

Binary file not shown.

BIN
sources/COREIO.LCOM
View File

Binary file not shown.

192
sources/FILEIO
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 9-Jul-2021 17:43:09" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;58 179154
(FILECREATED " 2-Aug-2021 10:13:47" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;68 180948
changes to%: (VARS FILEIOCOMS)
(FNS \EXTERNALFORMAT)
changes to%: (FNS \INSTALL.EXTERNALFORMAT \EXTERNALFORMAT)
(RECORDS FDEV STREAM)
previous date%: " 9-Jul-2021 09:35:10"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;57)
previous date%: " 1-Aug-2021 23:16:14"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;64)
(* ; "
@@ -55,6 +55,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
[COMS (* ;
 "EXTERNALFORMAT declaration and related functions")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
(FNS MAKE-EXTERNALFORMAT)
(INITRECORDS EXTERNALFORMAT)
(SYSRECORDS EXTERNALFORMAT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT \EXTERNALFORMAT)
@@ -120,15 +121,15 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(FNS \EOF.ACTION \EOSERROR \GETEOFPTR \INCFILEPTR \PEEKBIN \SETCLOSEDFILELENGTH
\SETEOFPTR \SETFILEPTR)
(FNS \FIXPOUT \FIXPIN)
(DECLARE%: DONTCOPY
(EXPORT (MACROS \DECFILEPTR \GETFILEPTR \SIGNEDWIN \SIGNEDWOUT \WIN \WOUT \BINS
\BOUTS \BOUTEOL \EOFP SIZE.FROM.LENGTH)
(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE)
(VAX 10)
9))
WordsPerPage)
[CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 30]
(RECORDS BYTEPTR))
(FNS \BOUTEOL)
(DECLARE%: DONTCOPY (EXPORT (MACROS \DECFILEPTR \GETFILEPTR \SIGNEDWIN \SIGNEDWOUT \WIN
\WOUT \BINS \BOUTS \EOFP SIZE.FROM.LENGTH)
(CONSTANTS BitsPerByte (ByteOffsetSize (SELECTQ (SYSTEMTYPE)
(VAX 10)
9))
WordsPerPage)
[CONSTANTS (\MAXFILEPTR (SUB1 (LLSH 1 30]
(RECORDS BYTEPTR))
(CONSTANTS MaxChar)))
(COMS (* ; "Buffered IO")
(FNS \BUFFERED.BIN \BUFFERED.PEEKBIN \BUFFERED.BOUT \BUFFERED.BINS \BUFFERED.BOUTS
@@ -245,7 +246,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(DEVICE POINTER)
(USERVISIBLE FLAG)
(EOLCONVENTION BITS 2)
(NOTXCCS FLAG)
(NIL FLAG)
(VALIDATION POINTER)
(CPAGE POINTER)
(EPAGE POINTER)
@@ -321,8 +322,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(USERVISIBLE FLAG) (* ;
 "Listed by OPENP; NIL for terminal, dribble ...")
(EOLCONVENTION BITS 2) (* ; "End-of-line convention")
(NOTXCCS FLAG) (* ;
 "True if the character encoding format is not XCCS.")
(NIL FLAG) (* ; "Was NOTXCCS.")
(VALIDATION POINTER) (* ;
 "A number somehow identifying file, used to determine if file has changed in our absence")
(CPAGE POINTER) (* ;
@@ -412,7 +412,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
ENDOFSTREAMOP _ (FUNCTION \EOSERROR)
IMAGEOPS _ \NOIMAGEOPS EOLCONVENTION _ LF.EOLC STRMBINFN _ (FUNCTION \STREAM.NOT.OPEN)
STRMBOUTFN _ (FUNCTION \STREAM.NOT.OPEN)
LASTCCODE _ 65535 NOTXCCS _ NIL)
LASTCCODE _ 65535)
)
(/DECLAREDATATYPE 'STREAM
@@ -940,7 +940,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(* ;; "-----For any stream (here to not recompile everything)-----")
(NIL POINTER) (* ;
(DEFAULTEXTERNALFORMAT POINTER) (* ;
 "Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).")
)
DIRECTORYNAMEP _ (FUNCTION NILL)
@@ -1177,7 +1177,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(TRUNCATEFILE POINTER)
(WINDOWOPS POINTER)
(WINDOWDATA POINTER)
(NIL POINTER)))
(DEFAULTEXTERNALFORMAT POINTER)))
)
@@ -1221,6 +1221,33 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(* "END EXPORTED DEFINITIONS")
)
(DEFINEQ
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL)
(* ; "Edited 1-Aug-2021 23:13 by rmk:")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
((LIST 'CR CR.EOLC)
CR.EOLC)
((LIST 'CRLF CRLF.EOLC)
CRLF.EOLC)
(NIL)
(SHOULDNT)))
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC])
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
(BITS 1)
@@ -1251,7 +1278,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(DEFINEQ
(\INSTALL.EXTERNALFORMAT
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-May-2021 12:55 by rmk:")
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 2-Aug-2021 10:13 by rmk:")
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
@@ -1271,12 +1298,12 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
NAME))
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
(COND
((type? EXTERNALFORMAT EXTERNALFORMAT)
(\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
NAME)
(T (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT])
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
(\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
NAME
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
EXTERNALFORMAT])
(\REMOVE.EXTERNALFORMAT
[LAMBDA (NAME/EXTFORMAT) (* ; "Edited 5-May-2021 15:42 by rmk:")
@@ -1301,7 +1328,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 9-Jul-2021 17:42 by rmk:")
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 2-Aug-2021 10:11 by rmk:")
(* ; "Edited 26-Feb-91 13:20 by nm")
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
@@ -1314,7 +1341,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT*.")
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
(\DTEST STREAM 'STREAM)
(CL:WHEN NEWFORMAT/NAME
@@ -1326,6 +1353,8 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
of (fetch DEVICE
of STREAM))
*DEFAULT-EXTERNALFORMATS*))
(FETCH (FDEV DEFAULTEXTERNALFORMAT)
OF (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMAT*)))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
@@ -3048,6 +3077,21 @@ update the map")
16)
(\WIN STRM])
)
(DEFINEQ
(\BOUTEOL
[LAMBDA (STREAM) (* ; "Edited 1-Aug-2021 10:08 by rmk:")
(* ;; "Convenient closed function to put out EOL characters without depending on EXPORTS.ALL for constants. This could also set the position back to 0.")
(SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM)
(LF.EOLC (\BOUT STREAM (CHARCODE LF)))
(CR.EOLC (\BOUT STREAM (CHARCODE CR)))
(CRLF.EOLC (\BOUT STREAM (CHARCODE CR))
(\BOUT STREAM (CHARCODE LF)))
(ANY.EOLC (SHOULDNT))
NIL])
)
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -3082,15 +3126,6 @@ update the map")
(FDEVOP 'BLOCKOUT (fetch (STREAM DEVICE) of STRM)
STRM BASE OFF NBYTES)))
(PUTPROPS \BOUTEOL MACRO (OPENLAMBDA (STRM)
(SELECTC (FETCH (STREAM EOLCONVENTION) OF STRM)
(LF.EOLC (\BOUT STRM (CHARCODE LF)))
(CR.EOLC (\BOUT STRM (CHARCODE CR)))
(CRLF.EOLC (\BOUT STRM (CHARCODE CR))
(\BOUT STRM (CHARCODE LF)))
(ANY.EOLC (SHOULDNT))
NIL)))
(PUTPROPS \EOFP BYTEMACRO (OPENLAMBDA (STRM)
(FDEVOP 'EOFP (fetch (STREAM DEVICE) of STRM)
STRM)))
@@ -3382,43 +3417,44 @@ update the map")
(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
1990 1991 1992 1993 1999 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (28433 31923 (STREAMPROP 28443 . 28877) (GETSTREAMPROP 28879 . 29352) (PUTSTREAMPROP
29354 . 31771) (STREAMP 31773 . 31921)) (31966 34485 (\DEFPRINT.BY.NAME 31976 . 33128) (
\STREAM.DEFPRINT 33130 . 34178) (\FDEV.DEFPRINT 34180 . 34483)) (34743 39784 (\GETACCESS 34753 . 35207
) (\SETACCESS 35209 . 39782)) (63955 70961 (\INSTALL.EXTERNALFORMAT 63965 . 65398) (
\REMOVE.EXTERNALFORMAT 65400 . 66231) (FIND-FORMAT 66233 . 66784) (\EXTERNALFORMAT 66786 . 70959)) (
71284 73103 (\CREATE.THROUGH.EXTERNALFORMAT 71294 . 72096) (\THROUGHIN 72098 . 72504) (
\THROUGHBACKCCODE 72506 . 72751) (\THROUGHOUTCHARFN 72753 . 73101)) (73211 79180 (\DEFINEDEVICE 73221
. 75537) (\GETDEVICEFROMNAME 75539 . 76012) (\GETDEVICEFROMHOSTNAME 76014 . 77058) (\REMOVEDEVICE
77060 . 78183) (\REMOVEDEVICE.NAMES 78185 . 79178)) (79220 103880 (\CLOSEFILE 79230 . 80055) (
\DELETEFILE 80057 . 80351) (\DEVICEEVENT 80353 . 82123) (\GENERATEFILES 82125 . 82603) (
\GENERATENEXTFILE 82605 . 83256) (\GENERATEFILEINFO 83258 . 83719) (\GETFILENAME 83721 . 84110) (
\GENERIC.OUTFILEP 84112 . 84582) (\OPENFILE 84584 . 87162) (\DO.PARAMS.AT.OPEN 87164 . 89717) (
\RENAMEFILE 89719 . 90143) (\REVALIDATEFILE 90145 . 92747) (\PAGED.REVALIDATEFILELST 92749 . 94307) (
\PAGED.REVALIDATEFILES 94309 . 96028) (\PAGED.REVALIDATEFILE 96030 . 98313) (\BUFFERED.REVALIDATEFILE
98315 . 100601) (\BUFFERED.REVALIDATEFILELST 100603 . 101787) (\PRINT-REVALIDATION-RESULT 101789 .
102204) (\TRUNCATEFILE 102206 . 102597) (\FILE-CONFLICT 102599 . 103878)) (103916 108579 (
\GENERATENOFILES 103926 . 106022) (\NULLFILEGENERATOR 106024 . 106268) (\NOFILESNEXTFILEFN 106270 .
108261) (\NOFILESINFOFN 108263 . 108577)) (108698 110606 (\FILE.NOT.OPEN 108708 . 109221) (
\FILE.WONT.OPEN 109223 . 109551) (\ILLEGAL.DEVICEOP 109553 . 109835) (\IS.NOT.RANDACCESSP 109837 .
110283) (\STREAM.NOT.OPEN 110285 . 110604)) (110741 113039 (\FDEVINSTANCE 110751 . 113037)) (114589
121963 (CNDIR 114599 . 115904) (DIRECTORYNAME 115906 . 120089) (DIRECTORYNAMEP 120091 . 120707) (
HOSTNAMEP 120709 . 121516) (\ADD.CONNECTED.DIR 121518 . 121961)) (122008 152651 (\BACKFILEPTR 122018
. 122206) (\BACKPEEKBIN 122208 . 122569) (\BACKBIN 122571 . 122922) (BIN 122924 . 123141) (\BIN
123143 . 123420) (\BINS 123422 . 123708) (BOUT 123710 . 124072) (\BOUT 124074 . 124389) (\BOUTS 124391
. 124702) (COPYBYTES 124704 . 128036) (COPYCHARS 128038 . 134960) (COPYFILE 134962 . 135759) (
\COPYOPENFILE 135761 . 138834) (\INFER.FILE.TYPE 138836 . 139790) (EOFP 139792 . 140089) (FORCEOUTPUT
140091 . 140338) (\FLUSH.OPEN.STREAMS 140340 . 140696) (CHARSET 140698 . 142362) (ACCESS-CHARSET
142364 . 142581) (GETEOFPTR 142583 . 142833) (GETFILEINFO 142835 . 146028) (\TYPE.FROM.FILETYPE 146030
. 146500) (\FILETYPE.FROM.TYPE 146502 . 146681) (GETFILEPTR 146683 . 146935) (SETFILEINFO 146937 .
150550) (SETFILEPTR 150552 . 152271) (BOUT16 152273 . 152458) (BIN16 152460 . 152649)) (152754 157959
(\GENERIC.BINS 152764 . 153044) (\GENERIC.BOUTS 153046 . 153311) (\GENERIC.RENAMEFILE 153313 . 155144)
(\GENERIC.OPENP 155146 . 156461) (\GENERIC.READP 156463 . 157504) (\GENERIC.CHARSET 157506 . 157957))
(157960 158299 (\MAP-OPEN-STREAMS 157970 . 158297)) (160169 162249 (\EOF.ACTION 160179 . 160430) (
\EOSERROR 160432 . 160625) (\GETEOFPTR 160627 . 160809) (\INCFILEPTR 160811 . 161161) (\PEEKBIN 161163
. 161354) (\SETCLOSEDFILELENGTH 161356 . 161690) (\SETEOFPTR 161692 . 161880) (\SETFILEPTR 161882 .
162247)) (162250 162792 (\FIXPOUT 162260 . 162560) (\FIXPIN 162562 . 162790)) (166458 176322 (
\BUFFERED.BIN 166468 . 167320) (\BUFFERED.PEEKBIN 167322 . 168104) (\BUFFERED.BOUT 168106 . 168966) (
\BUFFERED.BINS 168968 . 172653) (\BUFFERED.BOUTS 172655 . 174456) (\BUFFERED.COPYBYTES 174458 . 176320
)) (176351 178703 (\NULLDEVICE 176361 . 178379) (\NULL.OPENFILE 178381 . 178701)))))
(FILEMAP (NIL (28483 31973 (STREAMPROP 28493 . 28927) (GETSTREAMPROP 28929 . 29402) (PUTSTREAMPROP
29404 . 31821) (STREAMP 31823 . 31971)) (32016 34535 (\DEFPRINT.BY.NAME 32026 . 33178) (
\STREAM.DEFPRINT 33180 . 34228) (\FDEV.DEFPRINT 34230 . 34533)) (34793 39834 (\GETACCESS 34803 . 35257
) (\SETACCESS 35259 . 39832)) (62838 64091 (MAKE-EXTERNALFORMAT 62848 . 64089)) (65277 72720 (
\INSTALL.EXTERNALFORMAT 65287 . 66748) (\REMOVE.EXTERNALFORMAT 66750 . 67581) (FIND-FORMAT 67583 .
68134) (\EXTERNALFORMAT 68136 . 72718)) (73043 74862 (\CREATE.THROUGH.EXTERNALFORMAT 73053 . 73855) (
\THROUGHIN 73857 . 74263) (\THROUGHBACKCCODE 74265 . 74510) (\THROUGHOUTCHARFN 74512 . 74860)) (74970
80939 (\DEFINEDEVICE 74980 . 77296) (\GETDEVICEFROMNAME 77298 . 77771) (\GETDEVICEFROMHOSTNAME 77773
. 78817) (\REMOVEDEVICE 78819 . 79942) (\REMOVEDEVICE.NAMES 79944 . 80937)) (80979 105639 (\CLOSEFILE
80989 . 81814) (\DELETEFILE 81816 . 82110) (\DEVICEEVENT 82112 . 83882) (\GENERATEFILES 83884 . 84362
) (\GENERATENEXTFILE 84364 . 85015) (\GENERATEFILEINFO 85017 . 85478) (\GETFILENAME 85480 . 85869) (
\GENERIC.OUTFILEP 85871 . 86341) (\OPENFILE 86343 . 88921) (\DO.PARAMS.AT.OPEN 88923 . 91476) (
\RENAMEFILE 91478 . 91902) (\REVALIDATEFILE 91904 . 94506) (\PAGED.REVALIDATEFILELST 94508 . 96066) (
\PAGED.REVALIDATEFILES 96068 . 97787) (\PAGED.REVALIDATEFILE 97789 . 100072) (\BUFFERED.REVALIDATEFILE
100074 . 102360) (\BUFFERED.REVALIDATEFILELST 102362 . 103546) (\PRINT-REVALIDATION-RESULT 103548 .
103963) (\TRUNCATEFILE 103965 . 104356) (\FILE-CONFLICT 104358 . 105637)) (105675 110338 (
\GENERATENOFILES 105685 . 107781) (\NULLFILEGENERATOR 107783 . 108027) (\NOFILESNEXTFILEFN 108029 .
110020) (\NOFILESINFOFN 110022 . 110336)) (110457 112365 (\FILE.NOT.OPEN 110467 . 110980) (
\FILE.WONT.OPEN 110982 . 111310) (\ILLEGAL.DEVICEOP 111312 . 111594) (\IS.NOT.RANDACCESSP 111596 .
112042) (\STREAM.NOT.OPEN 112044 . 112363)) (112500 114798 (\FDEVINSTANCE 112510 . 114796)) (116348
123722 (CNDIR 116358 . 117663) (DIRECTORYNAME 117665 . 121848) (DIRECTORYNAMEP 121850 . 122466) (
HOSTNAMEP 122468 . 123275) (\ADD.CONNECTED.DIR 123277 . 123720)) (123767 154410 (\BACKFILEPTR 123777
. 123965) (\BACKPEEKBIN 123967 . 124328) (\BACKBIN 124330 . 124681) (BIN 124683 . 124900) (\BIN
124902 . 125179) (\BINS 125181 . 125467) (BOUT 125469 . 125831) (\BOUT 125833 . 126148) (\BOUTS 126150
. 126461) (COPYBYTES 126463 . 129795) (COPYCHARS 129797 . 136719) (COPYFILE 136721 . 137518) (
\COPYOPENFILE 137520 . 140593) (\INFER.FILE.TYPE 140595 . 141549) (EOFP 141551 . 141848) (FORCEOUTPUT
141850 . 142097) (\FLUSH.OPEN.STREAMS 142099 . 142455) (CHARSET 142457 . 144121) (ACCESS-CHARSET
144123 . 144340) (GETEOFPTR 144342 . 144592) (GETFILEINFO 144594 . 147787) (\TYPE.FROM.FILETYPE 147789
. 148259) (\FILETYPE.FROM.TYPE 148261 . 148440) (GETFILEPTR 148442 . 148694) (SETFILEINFO 148696 .
152309) (SETFILEPTR 152311 . 154030) (BOUT16 154032 . 154217) (BIN16 154219 . 154408)) (154513 159718
(\GENERIC.BINS 154523 . 154803) (\GENERIC.BOUTS 154805 . 155070) (\GENERIC.RENAMEFILE 155072 . 156903)
(\GENERIC.OPENP 156905 . 158220) (\GENERIC.READP 158222 . 159263) (\GENERIC.CHARSET 159265 . 159716))
(159719 160058 (\MAP-OPEN-STREAMS 159729 . 160056)) (161928 164008 (\EOF.ACTION 161938 . 162189) (
\EOSERROR 162191 . 162384) (\GETEOFPTR 162386 . 162568) (\INCFILEPTR 162570 . 162920) (\PEEKBIN 162922
. 163113) (\SETCLOSEDFILELENGTH 163115 . 163449) (\SETEOFPTR 163451 . 163639) (\SETFILEPTR 163641 .
164006)) (164009 164551 (\FIXPOUT 164019 . 164319) (\FIXPIN 164321 . 164549)) (164552 165160 (\BOUTEOL
164562 . 165158)) (168252 178116 (\BUFFERED.BIN 168262 . 169114) (\BUFFERED.PEEKBIN 169116 . 169898)
(\BUFFERED.BOUT 169900 . 170760) (\BUFFERED.BINS 170762 . 174447) (\BUFFERED.BOUTS 174449 . 176250) (
\BUFFERED.COPYBYTES 176252 . 178114)) (178145 180497 (\NULLDEVICE 178155 . 180173) (\NULL.OPENFILE
180175 . 180495)))))
STOP

BIN
sources/FILEIO.LCOM
View File

Binary file not shown.

87
sources/IMAGEIO
View File

@@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jun-99 16:33:59" {DSK}<project>medley3.5>sources>IMAGEIO.;2 79184
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 2-Aug-2021 19:41:35" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;4 79616
changes to%: (FNS OPENIMAGESTREAM)
changes to%: (FNS \DISPLAYINIT)
previous date%: "22-Apr-94 15:19:02" {DSK}<project>medley3.5>sources>IMAGEIO.;1)
previous date%: "28-Jun-99 16:33:59"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;1)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994, 1999 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT IMAGEIOCOMS)
@@ -919,17 +921,17 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS IMAGEOP MACRO
[ARGS (CONS 'SPREADAPPLY* (CONS (COND
[(EQ (CAR (LISTP (CAR ARGS)))
'QUOTE)
(LIST 'fetch (LIST 'IMAGEOPS (CADAR ARGS))
'of
(LIST 'fetch '(STREAM IMAGEOPS)
'of
(CADR ARGS]
(T (HELP "IMAGEOP - OPNAME not quoted:" ARGS)))
(CDDR ARGS])
(PUTPROPS IMAGEOP MACRO [ARGS (CONS 'SPREADAPPLY*
(CONS (COND
[(EQ (CAR (LISTP (CAR ARGS)))
'QUOTE)
(LIST 'fetch (LIST 'IMAGEOPS (CADAR ARGS))
'of
(LIST 'fetch '(STREAM IMAGEOPS)
'of
(CADR ARGS]
(T (HELP "IMAGEOP - OPNAME not quoted:" ARGS)))
(CDDR ARGS])
)
(DECLARE%: EVAL@COMPILE
@@ -1168,11 +1170,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
NIL])
(\DISPLAYINIT
[LAMBDA NIL (* ; "Edited 19-Apr-94 04:36 by sybalsky")
[LAMBDA NIL (* ; "Edited 2-Aug-2021 19:41 by rmk:")
(* ;; "Initializes global variables for the Display device")
(* ;; "Initializes global variables for the Display device")
(* ;; "Display Streams are referred to only by themselves so they do not need directory operations. Most of the fields in the DisplayDevice are empty to avoid something bad happening.")
(* ;; "Display Streams are referred to only by themselves so they do not need directory operations. Most of the fields in the DisplayDevice are empty to avoid something bad happening.")
(DECLARE (GLOBALVARS DisplayFDEV \DISPLAYIMAGEOPS \DisplayDeviceMethods \DisplayDeviceData))
(SETQ \DisplayDeviceMethods (create WSOPS))
@@ -1249,7 +1251,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
WINDOWOPS _ \DisplayDeviceMethods
WINDOWDATA _ \DisplayDeviceData
DEVICEINFO _ (create DISPLAYSTATE)))
DEVICEINFO _ (create DISPLAYSTATE)
DEFAULTEXTERNALFORMAT _ (MAKE-EXTERNALFORMAT :DISPLAY NIL NIL NIL
(FUNCTION \DSPPRINTCHAR)
NIL CR.EOLC)))
(\DEFINEDEVICE 'LFDISPLAY DisplayFDEV])
(\4DISPLAYINIT
@@ -1502,26 +1507,26 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
(ADDTOVAR LAMA IMAGESTREAMP)
)
(PUTPROPS IMAGEIO COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
1993 1994 1999))
1993 1994 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3354 12111 (IMAGESTREAMP 3364 . 4196) (IMAGESTREAMTYPE 4198 . 4411) (IMAGESTREAMTYPEP
4413 . 5048) (OPENIMAGESTREAM 5050 . 10004) (\GOOD.DASHLST 10006 . 12109)) (12146 14443 (
DRAWDASHEDLINE 12156 . 14441)) (14444 21784 (DSPBACKCOLOR 14454 . 14826) (DSPBOTTOMMARGIN 14828 .
15213) (DSPCOLOR 15215 . 15579) (DSPCLIPPINGREGION 15581 . 16286) (DSPRESET 16288 . 16568) (DSPFONT
16570 . 16934) (DSPLEFTMARGIN 16936 . 17317) (DSPLINEFEED 17319 . 17619) (DSPOPERATION 17621 . 17998)
(DSPRIGHTMARGIN 18000 . 18383) (DSPTOPMARGIN 18385 . 18764) (DSPSCALE 18766 . 19133) (DSPSPACEFACTOR
19135 . 19528) (DSPXPOSITION 19530 . 19835) (DSPYPOSITION 19837 . 20142) (DSPROTATE 20144 . 20439) (
DSPPUSHSTATE 20441 . 20687) (DSPPOPSTATE 20689 . 20932) (DSPDEFAULTSTATE 20934 . 21186) (DSPSCALE2
21188 . 21479) (DSPTRANSLATE 21481 . 21782)) (21785 30586 (DSPNEWPAGE 21795 . 22487) (DRAWBETWEEN
22489 . 23191) (DRAWCIRCLE 23193 . 23689) (DRAWARC 23691 . 24208) (DRAWCURVE 24210 . 24887) (
DRAWELLIPSE 24889 . 25675) (DRAWLINE 25677 . 26067) (DRAWPOLYGON 26069 . 26524) (DRAWPOINT 26526 .
26945) (FILLPOLYGON 26947 . 27513) (DRAWTO 27515 . 27933) (FILLCIRCLE 27935 . 28158) (MOVETO 28160 .
28524) (RELDRAWTO 28526 . 29443) (BITMAPIMAGESIZE 29445 . 29616) (SCALEDBITBLT 29618 . 30584)) (30587
37626 (\DRAWPOINT.GENERIC 30597 . 30944) (\DRAWPOLYGON.GENERIC 30946 . 33254) (\DRAWCIRCLE.GENERIC
33256 . 34914) (\DRAWELLIPSE.GENERIC 34916 . 37624)) (37627 43013 (\IMAGEIOINIT 37637 . 41770) (
\NOIMAGE.DSPFONT 41772 . 42847) (\UNIMPIMAGEOP 42849 . 43011)) (43136 46260 (INSURE.BRUSH 43146 .
44520) (BRUSHP 44522 . 45312) (\POSSIBLECOLOR 45314 . 45865) (NEGSHADE 45867 . 46258)) (46820 47504 (
DASHINGP 46830 . 47160) (INSURE.DASHING 47162 . 47502)) (57806 78002 (\DisplayEventFn 57816 . 58326) (
\DISPLAYINIT 58328 . 63754) (\4DISPLAYINIT 63756 . 68393) (\8DISPLAYINIT 68395 . 73034) (
\24DISPLAYINIT 73036 . 77743) (\DISPLAYSTREAMTYPEBPP 77745 . 78000)))))
(FILEMAP (NIL (3353 12110 (IMAGESTREAMP 3363 . 4195) (IMAGESTREAMTYPE 4197 . 4410) (IMAGESTREAMTYPEP
4412 . 5047) (OPENIMAGESTREAM 5049 . 10003) (\GOOD.DASHLST 10005 . 12108)) (12145 14442 (
DRAWDASHEDLINE 12155 . 14440)) (14443 21783 (DSPBACKCOLOR 14453 . 14825) (DSPBOTTOMMARGIN 14827 .
15212) (DSPCOLOR 15214 . 15578) (DSPCLIPPINGREGION 15580 . 16285) (DSPRESET 16287 . 16567) (DSPFONT
16569 . 16933) (DSPLEFTMARGIN 16935 . 17316) (DSPLINEFEED 17318 . 17618) (DSPOPERATION 17620 . 17997)
(DSPRIGHTMARGIN 17999 . 18382) (DSPTOPMARGIN 18384 . 18763) (DSPSCALE 18765 . 19132) (DSPSPACEFACTOR
19134 . 19527) (DSPXPOSITION 19529 . 19834) (DSPYPOSITION 19836 . 20141) (DSPROTATE 20143 . 20438) (
DSPPUSHSTATE 20440 . 20686) (DSPPOPSTATE 20688 . 20931) (DSPDEFAULTSTATE 20933 . 21185) (DSPSCALE2
21187 . 21478) (DSPTRANSLATE 21480 . 21781)) (21784 30585 (DSPNEWPAGE 21794 . 22486) (DRAWBETWEEN
22488 . 23190) (DRAWCIRCLE 23192 . 23688) (DRAWARC 23690 . 24207) (DRAWCURVE 24209 . 24886) (
DRAWELLIPSE 24888 . 25674) (DRAWLINE 25676 . 26066) (DRAWPOLYGON 26068 . 26523) (DRAWPOINT 26525 .
26944) (FILLPOLYGON 26946 . 27512) (DRAWTO 27514 . 27932) (FILLCIRCLE 27934 . 28157) (MOVETO 28159 .
28523) (RELDRAWTO 28525 . 29442) (BITMAPIMAGESIZE 29444 . 29615) (SCALEDBITBLT 29617 . 30583)) (30586
37625 (\DRAWPOINT.GENERIC 30596 . 30943) (\DRAWPOLYGON.GENERIC 30945 . 33253) (\DRAWCIRCLE.GENERIC
33255 . 34913) (\DRAWELLIPSE.GENERIC 34915 . 37623)) (37626 43012 (\IMAGEIOINIT 37636 . 41769) (
\NOIMAGE.DSPFONT 41771 . 42846) (\UNIMPIMAGEOP 42848 . 43010)) (43135 46259 (INSURE.BRUSH 43145 .
44519) (BRUSHP 44521 . 45311) (\POSSIBLECOLOR 45313 . 45864) (NEGSHADE 45866 . 46257)) (46815 47499 (
DASHINGP 46825 . 47155) (INSURE.DASHING 47157 . 47497)) (57980 78429 (\DisplayEventFn 57990 . 58500) (
\DISPLAYINIT 58502 . 64181) (\4DISPLAYINIT 64183 . 68820) (\8DISPLAYINIT 68822 . 73461) (
\24DISPLAYINIT 73463 . 78170) (\DISPLAYSTREAMTYPEBPP 78172 . 78427)))))
STOP

BIN
sources/IMAGEIO.LCOM
View File

Binary file not shown.

467
sources/LLDISPLAY
View File

@@ -1,36 +1,36 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Apr-94 00:20:42" {DSK}<users>nilsson>mnw>LLDISPLAY.;7 267646
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 1-Aug-2021 23:41:37" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;5 268898
changes to%: (FNS \BACKCOLOR.DISPLAY DSPTEXTURE \DSPRESET.DISPLAY \MEDW.XOFFSET \MEDW.YOFFSET
DSPXOFFSET DSPYOFFSET)
(VARS LLDISPLAYCOMS)
changes to%: (FNS DSPCREATE)
previous date%: "25-Feb-94 17:56:47" {DSK}<users>nilsson>mnw>LLDISPLAY.;6)
previous date%: " 1-Aug-2021 23:37:06"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLDISPLAY.;4)
(* ; "
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT LLDISPLAYCOMS)
(RPAQQ LLDISPLAYCOMS
(RPAQQ LLDISPLAYCOMS
[(DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO)
(MACROS \GETDISPLAYDATA)))
(* ;
 "User-visible records are on ADISPLAY --- must be init'ed here")
(* ;
 "User-visible records are on ADISPLAY --- must be init'ed here")
(INITRECORDS BITMAP PILOTBBT REGION \DISPLAYDATA)
[COMS (* ; "BITMASKS")
[COMS (* ; "BITMASKS")
(FNS \FBITMAPBIT \FBITMAPBIT.UFN \NEWPAGE.DISPLAY INITBITMASKS)
(OPTIMIZERS \FBITMAPBIT)
[EXPORT (DECLARE%: DONTCOPY (MACROS \BITMASK \4BITMASK \NOTBITMASK \NOT4BITMASK)
(GLOBALVARS BITMASKARRAY NOTBITMASKARRAY 4BITMASKARRAY NOT4BITMASKARRAY)
(CONSTANTS (WORDMASK 65535]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS]
[COMS (* ; "init cursor")
[COMS (* ; "init cursor")
(FNS \CreateCursorBitMap)
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap]
[COMS (* ; "bitmap functions.")
[COMS (* ; "bitmap functions.")
(FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT
BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING \SLOWBLTCHAR
TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP
@@ -45,15 +45,15 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(FNS BITMAPBIT.EXPANDER)
(FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY \BLTSHADE.BITMAP)
(FNS
(* ;; "For SunLoadup")
(* ;; "For SunLoadup")
\BITBLT.BITMAP.SLOW)
(FNS
(* ;; " punt case for C funcs.bitblt_bitmap,bitshade.bitmap")
(* ;; " punt case for C funcs.bitblt_bitmap,bitshade.bitmap")
\PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP)
(FNS
(* ;; "from SUMEX-AIM")
(* ;; "from SUMEX-AIM")
\SCALEDBITBLT.DISPLAY \BACKCOLOR.DISPLAY)
(DECLARE%: DONTCOPY (CONSTANTS (\DisplayWordAlign 16)
@@ -66,11 +66,11 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(VARS (\BBSCRATCHTEXTURE)
(\PILOTBBTSCRATCHBM))
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD? 'BITBLT 'BKBITBLT]
(* ;
 "macro for this file so that BITBLT can be broken by users")
(* ;
 "macro for this file so that BITBLT can be broken by users")
(EXPORT (DECLARE%: DONTCOPY DONTEVAL@LOAD DOEVAL@COMPILE
(P (PUTPROP 'BITBLT 'MACRO '(= . BKBITBLT]
(COMS (* ; "display stream functions")
(COMS (* ; "display stream functions")
(FNS DISPLAYSTREAMP DSPSOURCETYPE DSPXOFFSET DSPYOFFSET)
(FNS DSPCREATE DSPDESTINATION DSPTEXTURE \DISPLAYSTREAMINCRXPOSITION \SFFixDestination
\SFFixClippingRegion \SFFixFont \SFFIXLINELENGTH
@@ -86,14 +86,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(INITVARS (PROMPTWINDOW T)
(\WINDOWWORLD NIL)
(\MAINSCREEN NIL)))
[COMS (* ; "Stub for window package")
[COMS (* ; "Stub for window package")
(INITVARS (\TOPWDS)
(\SCREENBITMAPS))
(P (MOVD? 'NILL '\TOTOPWDS))
(DECLARE%: DONTCOPY EVAL@COMPILE (EXPORT (MACROS \INSURETOPWDS .WHILE.TOP.DS.
.WHILE.CURSOR.DOWN.)
(ADDVARS (GLOBALVARS \TOPWDS]
(COMS (* ; "DisplayStream TTY functions")
(COMS (* ; "DisplayStream TTY functions")
(FNS TTYDISPLAYSTREAM)
(EXPORT (OPTIMIZERS TTYDISPLAYSTREAM))
(FNS DSPSCROLL PAGEHEIGHT)
@@ -114,13 +114,13 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(EXPORT (GLOBALVARS BELLCNT BELLRATE TTYBACKGROUNDFNS \DisplayStoppedForLogout
\CARET.UP)
(MACROS \CHECKCARET)))
[COMS (* ;
 "transformation related functions.")
[COMS (* ;
 "transformation related functions.")
(FNS \DSPCLIPTRANSFORMX \DSPCLIPTRANSFORMY \DSPTRANSFORMREGION \DSPUNTRANSFORMY
\DSPUNTRANSFORMX \OFFSETCLIPPINGREGION)
(DECLARE%: DONTCOPY (EXPORT (MACROS \DSPTRANSFORMX \DSPTRANSFORMY \OFFSETBOTTOM
\OFFSETLEFT]
[COMS (* ; "screen related functions")
[COMS (* ; "screen related functions")
(FNS UPDATESCREENDIMENSIONS \CreateScreenBitMap)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (UPDATESCREENDIMENSIONS))
(INITVARS (SCREENHEIGHT 808)
@@ -132,7 +132,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(ColorScreenBitMap NIL)))
(GLOBALVARS \OLDSCREENHEIGHT \OLDSCREENWIDTH \MaxScreenPage ScreenBitMap)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (CURSOR.INIT]
[COMS (* ; "initialization")
[COMS (* ; "initialization")
(INITVARS (\DISPLAYINFOALIST))
(FNS \CoerceToDisplayDevice \CREATEDISPLAY DISPLAYSTREAMINIT \STARTDISPLAY
\MOVE.WINDOWS.ONTO.SCREEN \UPDATE.PBT.RASTERWIDTHS \STOPDISPLAY \DEFINEDISPLAYINFO
@@ -301,19 +301,19 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
'68)
(DECLARE%: EVAL@COMPILE
[PUTPROPS \GETDISPLAYDATA MACRO (ARGS (COND
[(CADR ARGS)
(SUBPAIR '(STRM STRMVAR)
ARGS
'(\DTEST (fetch (STREAM IMAGEDATA)
of (SETQ STRMVAR (\OUTSTREAMARG
STRM)))
'\DISPLAYDATA]
(T (SUBST (CAR ARGS)
'STRM
'(\DTEST (fetch (STREAM IMAGEDATA)
of (\OUTSTREAMARG STRM))
'\DISPLAYDATA]
(PUTPROPS \GETDISPLAYDATA MACRO [ARGS (COND
[(CADR ARGS)
(SUBPAIR '(STRM STRMVAR)
ARGS
'(\DTEST (fetch (STREAM IMAGEDATA)
of (SETQ STRMVAR
(\OUTSTREAMARG STRM)))
'\DISPLAYDATA]
(T (SUBST (CAR ARGS)
'STRM
'(\DTEST (fetch (STREAM IMAGEDATA)
of (\OUTSTREAMARG STRM))
'\DISPLAYDATA])
)
(* "END EXPORTED DEFINITIONS")
@@ -490,18 +490,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
[PUTPROPS \BITMASK MACRO ((N)
(\WORDELT BITMASKARRAY (LOGAND N 15]
(PUTPROPS \BITMASK MACRO ((N)
(\WORDELT BITMASKARRAY (LOGAND N 15))))
[PUTPROPS \4BITMASK MACRO ((N)
(\WORDELT 4BITMASKARRAY (LOGAND N 3]
(PUTPROPS \4BITMASK MACRO ((N)
(\WORDELT 4BITMASKARRAY (LOGAND N 3))))
[PUTPROPS \NOTBITMASK MACRO ((N)
(DECLARE (GLOBALVARS NOTBITMASKARRAY))
(\WORDELT NOTBITMASKARRAY (LOGAND N 15]
(PUTPROPS \NOTBITMASK MACRO ((N)
(DECLARE (GLOBALVARS NOTBITMASKARRAY))
(\WORDELT NOTBITMASKARRAY (LOGAND N 15))))
[PUTPROPS \NOT4BITMASK MACRO ((N)
(\WORDELT NOT4BITMASKARRAY (LOGAND N 3]
(PUTPROPS \NOT4BITMASK MACRO ((N)
(\WORDELT NOT4BITMASKARRAY (LOGAND N 3))))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -1482,14 +1482,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(CL:DEFUN FINISH-READING-BITMAP (STREAM)
(* ;;; "The syntax for bitmaps is")
(* ;;; "The syntax for bitmaps is")
(* ;; "#*(width height [bits-per-pixel])XXXXXX...")
(* ;; "#*(width height [bits-per-pixel])XXXXXX...")
(* ;;; "where WIDTH and HEIGHT are the dimensions of the bitmap, BITS-PER-PIXEL can be omitted if it is equal to one, and the X's are single characters between @ and O (in ASCII), each representing four bits. There will be exactly (* (ceiling (* WIDTH BITS-PER-PIXEL) 16) 4) characters for each row of the bitmap and exactly HEIGHT rows. Note that there are no spaces allowed between the * and the (, between the ) and the first X, or anywhere inside the string of X's. Also, the character after the last X must not be of type OTHER.")
(* ;;; "where WIDTH and HEIGHT are the dimensions of the bitmap, BITS-PER-PIXEL can be omitted if it is equal to one, and the X's are single characters between @ and O (in ASCII), each representing four bits. There will be exactly (* (ceiling (* WIDTH BITS-PER-PIXEL) 16) 4) characters for each row of the bitmap and exactly HEIGHT rows. Note that there are no spaces allowed between the * and the (, between the ) and the first X, or anywhere inside the string of X's. Also, the character after the last X must not be of type OTHER.")
(* ;;;
"When we enter this function, called from HASH-STAR, the stream should be pointing at the (.")
(* ;;;
"When we enter this function, called from HASH-STAR, the stream should be pointing at the (.")
(LET
((DIMENSIONS (READ STREAM)))
@@ -1499,7 +1499,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DESTRUCTURING-BIND
(WIDTH HEIGHT &OPTIONAL (BITS-PER-PIXEL 1)
&REST EXTRAS)
DIMENSIONS (* ; "Parsing the dimensions.")
DIMENSIONS (* ; "Parsing the dimensions.")
(IF (OR (NOT (FIXP WIDTH))
(NOT (FIXP HEIGHT))
(NOT (FIXP BITS-PER-PIXEL))
@@ -1518,7 +1518,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(LET [(STREAM (\GETSTREAM STREAM 'INPUT]
(CL:DOTIMES (ROW HEIGHT)
[IF (ZEROP (FETCH (STREAM CHARSET) OF STREAM))
THEN (* ; "Do it the quicker way")
THEN (* ; "Do it the quicker way")
(CL:DOTIMES (QUAD QUAD-CHARS-PER-ROW)
(LET [(NIB00 (- (\BIN STREAM)
(CHARCODE @)))
@@ -1540,7 +1540,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(\PUTBASEBYTE BASE 1 (LOGOR (LLSH NIB10 4)
NIB11)))
(SETQ BASE (\ADDBASE BASE 1)))
ELSE (* ; "Somewhat slower...")
ELSE (* ; "Somewhat slower...")
(CL:DOTIMES (QUAD QUAD-CHARS-PER-ROW)
(LET [(NIB00 (- (READCCODE STREAM)
(CHARCODE @)))
@@ -1578,16 +1578,16 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA)
(PUTPROPS \INVALIDATEDISPLAYCACHE MACRO ((DISPLAYDATA)
(* This marks the character-printing caches of the displaystream as invalid.
 Needed when the font or Y position changes)
(* This marks the character-printing caches of the displaystream as invalid.
 Needed when the font or Y position changes)
(freplace (\DISPLAYDATA DDCHARSET) of DISPLAYDATA
with MAX.SMALLP)
(freplace (\DISPLAYDATA DDCHARSETASCENT) of
(freplace (\DISPLAYDATA DDCHARSET) of
DISPLAYDATA
with MAX.SMALLP)))
with MAX.SMALLP)
(freplace (\DISPLAYDATA DDCHARSETASCENT)
of DISPLAYDATA with MAX.SMALLP)))
)
(* "END EXPORTED DEFINITIONS")
@@ -1599,8 +1599,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DEFOPTIMIZER BITMAPP (Y)
`((OPENLAMBDA (X)
(AND (type? BITMAP X)
X))
(AND (type? BITMAP X)
X))
,Y))
(DEFINEQ
@@ -2759,59 +2759,62 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \DSPGETCHARWIDTH MACRO ((CHARCODE DD)
(\FGETWIDTH (ffetch (\DISPLAYDATA DDWIDTHSCACHE) of DD)
CHARCODE)))
(PUTPROPS \DSPGETCHARWIDTH MACRO ((CHARCODE DD)
(\FGETWIDTH (ffetch (\DISPLAYDATA DDWIDTHSCACHE)
of DD)
CHARCODE)))
(PUTPROPS \DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD)
(\FGETIMAGEWIDTH (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS)
of DD)
CHARCODE)))
(PUTPROPS \DSPGETCHARIMAGEWIDTH MACRO ((CHARCODE DD)
(\FGETIMAGEWIDTH (ffetch (\DISPLAYDATA
DDCHARIMAGEWIDTHS)
of DD)
CHARCODE)))
(PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DD)
(\GETBASE (ffetch (\DISPLAYDATA DDOFFSETSCACHE) of DD)
CHARCODE)))
(PUTPROPS \DSPGETCHAROFFSET MACRO ((CHARCODE DD)
(\GETBASE (ffetch (\DISPLAYDATA DDOFFSETSCACHE)
of DD)
CHARCODE)))
(PUTPROPS \CONVERTOP MACRO ((OP) (* rrb "14-NOV-80 11:14")
(* Only for alto bitblt !!)
(SELECTQ OP
(replace 0 of NIL with NIL)
(PAINT 1)
(INVERT 2)
(ERASE 3)
0)))
(PUTPROPS \CONVERTOP MACRO ((OP) (* rrb "14-NOV-80 11:14")
(* Only for alto bitblt !!)
(SELECTQ OP
(replace 0 of NIL with NIL)
(PAINT 1)
(INVERT 2)
(ERASE 3)
0)))
(PUTPROPS \SFInvert MACRO ((BitMap y)
(PUTPROPS \SFInvert MACRO ((BitMap y)
(* corrects for the fact that alto bitmaps are stored with 0,0 as upper left
 while lisp bitmaps have 0,0 as lower left.
 The correction is actually off by one (greater) because a majority of the
 places that it is called actually need one more than corrected Y value.)
(* corrects for the fact that alto bitmaps are stored with 0,0 as upper left
 while lisp bitmaps have 0,0 as lower left.
 The correction is actually off by one (greater) because a majority of the
 places that it is called actually need one more than corrected Y value.)
(IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT) of BitMap)
y)))
(IDIFFERENCE (fetch (BITMAP BITMAPHEIGHT) of BitMap)
y)))
[PUTPROPS \SFReplicate MACRO (LAMBDA (pattern)
(LOGOR pattern (LLSH pattern 8)
(SETQ pattern (LLSH pattern 4))
(LLSH pattern 8]
(PUTPROPS \SFReplicate MACRO [LAMBDA (pattern)
(LOGOR pattern (LLSH pattern 8)
(SETQ pattern (LLSH pattern 4))
(LLSH pattern 8])
[PUTPROPS \SETPBTFUNCTION MACRO (OPENLAMBDA (BBT SourceType Operation)
(PROGN (replace (PILOTBBT PBTOPERATION) of BBT
with (SELECTQ Operation
(ERASE 1)
(PAINT 2)
(INVERT 3)
0))
(replace (PILOTBBT PBTSOURCETYPE) of BBT
with (COND
((EQ (EQ SourceType 'INVERT)
(EQ Operation 'ERASE))
0)
(T 1]
(PUTPROPS \SETPBTFUNCTION MACRO [OPENLAMBDA (BBT SourceType Operation)
(PROGN (replace (PILOTBBT PBTOPERATION) of BBT
with (SELECTQ Operation
(ERASE 1)
(PAINT 2)
(INVERT 3)
0))
(replace (PILOTBBT PBTSOURCETYPE) of BBT
with (COND
((EQ (EQ SourceType 'INVERT)
(EQ Operation 'ERASE))
0)
(T 1])
(PUTPROPS \BITBLT1 MACRO ((bbt)
(BitBltSUBR bbt)))
(PUTPROPS \BITBLT1 MACRO ((bbt)
(BitBltSUBR bbt)))
)
(* "END EXPORTED DEFINITIONS")
@@ -2897,9 +2900,9 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DEFINEQ
(DSPCREATE
[LAMBDA (DESTINATION) (* ; "Edited 16-Nov-87 17:32 by jop")
[LAMBDA (DESTINATION) (* ; "Edited 1-Aug-2021 23:41 by rmk:")
(* ;; "Creates a stream-of-type-display on the DESTINATION bitmap or display device")
(* ;; "Creates a stream-of-type-display on the DESTINATION bitmap or display device")
(LET (DSTRM)
[COND
@@ -2909,24 +2912,25 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(SETQ DSTRM (create STREAM
USERCLOSEABLE _ NIL
OUTCHARFN _ (FUNCTION \DSPPRINTCHAR)
EOLCONVENTION _ CR.EOLC
IMAGEDATA _ (create \DISPLAYDATA)
IMAGEOPS _ \DISPLAYIMAGEOPS
DEVICE _ DisplayFDEV
ACCESS _ 'OUTPUT)) (* ;
 "initial x and y positions are 0 when the data is created.")
(DSPFONT DEFAULTFONT DSTRM) (* ;
 "dspfont can win since the (default) display imageops are filled in the stream")
(DSPDESTINATION DESTINATION DSTRM) (* ;
 "dspdestination calls \SFFixFont, which presumes there is a font present.")
ACCESS _ 'OUTPUT)) (* ;
 "initial x and y positions are 0 when the data is created.")
(DSPFONT DEFAULTFONT DSTRM) (* ;
 "dspfont can win since the (default) display imageops are filled in the stream")
(DSPDESTINATION DESTINATION DSTRM) (* ;
 "dspdestination calls \SFFixFont, which presumes there is a font present.")
(DSPFONT DEFAULTFONT DSTRM)
(* ;; "the reference to SCREENWIDTH here is for historic reasons: until 3-feb-86 the default right margin was always SCREENWIDTH. It should be the width of the destination and for any destination larger than the screen this is a serious bug and was fixed. The MAX of the right value and SCREENWIDTH was left in because existing code might be assumine a large right margin for small bitmaps and auto-CR in without it. rrb")
(* ;; "the reference to SCREENWIDTH here is for historic reasons: until 3-feb-86 the default right margin was always SCREENWIDTH. It should be the width of the destination and for any destination larger than the screen this is a serious bug and was fixed. The MAX of the right value and SCREENWIDTH was left in because existing code might be assumine a large right margin for small bitmaps and auto-CR in without it. rrb")
(DSPRIGHTMARGIN (MAX SCREENWIDTH (fetch (BITMAP BITMAPWIDTH) of DESTINATION))
DSTRM)
(DSPSOURCETYPE 'INPUT DSTRM)
(DSPOPERATION 'REPLACE DSTRM) (* ;
 "called to cause the updating of the bitblt table from the fields initialized earlier.")
(DSPOPERATION 'REPLACE DSTRM) (* ;
 "called to cause the updating of the bitblt table from the fields initialized earlier.")
DSTRM])
(DSPDESTINATION
@@ -3347,61 +3351,66 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DECLARE%: DONTCOPY EVAL@COMPILE
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
[PROGN [PUTPROPS \INSURETOPWDS DMACRO (OPENLAMBDA (DS)
(OR (EQ DS \TOPWDS)
(COND
((FMEMB (DSPDESTINATION NIL DS)
\SCREENBITMAPS)
(\TOTOPWDS DS]
(PUTPROPS \INSURETOPWDS MACRO ((DS) (* For non-window implementations)
(PROGN]
[PROGN (PUTPROPS \INSURETOPWDS DMACRO [OPENLAMBDA (DS)
(OR (EQ DS \TOPWDS)
(COND
((FMEMB (DSPDESTINATION NIL DS)
\SCREENBITMAPS)
(\TOTOPWDS DS])
(PUTPROPS \INSURETOPWDS MACRO ((DS) (* For non-window implementations)
(PROGN)))]
[PUTPROPS .WHILE.TOP.DS. MACRO ((FIRST . REST)
(PROG (DISPINTERRUPT SOFTCURSORUP)
(PUTPROPS .WHILE.TOP.DS. MACRO [(FIRST . REST)
(PROG (DISPINTERRUPT SOFTCURSORUP)
(* FIRST should be a displaystream and a variable.
 This macro may also take a soft cursor down, similar to the way
 .WHILE.CURSOR.DOWN. does, but only if FIRST's destination is the same as the
 soft cursor's destination. *)
(* FIRST should be a displaystream and a variable.
 This macro may also take a soft cursor down, similar to the way
 .WHILE.CURSOR.DOWN. does, but only if FIRST's destination is the same as the
 soft cursor's destination. *)
[COND
(\SOFTCURSORP (SETQ SOFTCURSORUP
(AND \SOFTCURSORUPP (EQ (DSPDESTINATION
NIL FIRST)
\CURSORDESTINATION)))
(COND
(SOFTCURSORUP (SETQ DISPINTERRUPT (\GETBASE
[COND
(\SOFTCURSORP (SETQ SOFTCURSORUP
(AND \SOFTCURSORUPP
(EQ (DSPDESTINATION NIL
FIRST)
\CURSORDESTINATION)))
(COND
(SOFTCURSORUP (SETQ DISPINTERRUPT
(\GETBASE \EM.DISPINTERRUPT
0))
(\PUTBASE \EM.DISPINTERRUPT 0 0)
(\SOFTCURSORDOWN]
(\INSURETOPWDS FIRST)
(PROGN . REST)
(COND
(SOFTCURSORUP (\SOFTCURSORUPCURRENT)
(\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT])
(PUTPROPS .WHILE.CURSOR.DOWN. MACRO [(FIRST . REST)
(PROG (DISPINTERRUPT SOFTCURSORUP)
(* This macro should wrap around any code that draws or bitblts directly from
 or to a screen bitmap. E.g. DRAWGRAYBOX in HLDISPLAY which puts up a shadow box
 during GETREGION. The purpose of this macro is that a soft
 (e.g. color) cursor's bits not be taken to be screen bits while FIRST & REST
 are done. *)
[COND
(\SOFTCURSORP (SETQ SOFTCURSORUP \SOFTCURSORUPP
)
(COND
(SOFTCURSORUP (SETQ DISPINTERRUPT
(\GETBASE
\EM.DISPINTERRUPT
0))
(\PUTBASE \EM.DISPINTERRUPT 0 0)
(\SOFTCURSORDOWN]
(\INSURETOPWDS FIRST)
(PROGN . REST)
(COND
(SOFTCURSORUP (\SOFTCURSORUPCURRENT)
(\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]
[PUTPROPS .WHILE.CURSOR.DOWN. MACRO ((FIRST . REST)
(PROG (DISPINTERRUPT SOFTCURSORUP)
(* This macro should wrap around any code that draws or bitblts directly from
 or to a screen bitmap. E.g. DRAWGRAYBOX in HLDISPLAY which puts up a shadow box
 during GETREGION. The purpose of this macro is that a soft
 (e.g. color) cursor's bits not be taken to be screen bits while FIRST & REST
 are done. *)
[COND
(\SOFTCURSORP (SETQ SOFTCURSORUP \SOFTCURSORUPP)
(COND
(SOFTCURSORUP (SETQ DISPINTERRUPT
(\GETBASE \EM.DISPINTERRUPT 0)
)
(\PUTBASE \EM.DISPINTERRUPT 0 0)
(\SOFTCURSORDOWN]
(PROGN FIRST . REST)
(COND
(SOFTCURSORUP (\SOFTCURSORUPCURRENT)
(\PUTBASE \EM.DISPINTERRUPT 0 DISPINTERRUPT]
0))
(\PUTBASE \EM.DISPINTERRUPT 0
0)
(\SOFTCURSORDOWN]
(PROGN FIRST . REST)
(COND
(SOFTCURSORUP (\SOFTCURSORUPCURRENT)
(\PUTBASE \EM.DISPINTERRUPT 0
DISPINTERRUPT])
)
(ADDTOVAR GLOBALVARS \TOPWDS)
@@ -3592,9 +3601,9 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DEFMACRO \MAYBE-DRIBBLE-CHAR (DISPLAY-STREAM CHARCODE)
"if we are dribbling, then dribble this character"
(* ;; "*DRIBBLE-OUTPUT* is a per-process special.")
(* ;; "*DRIBBLE-OUTPUT* is a per-process special.")
(* ;; "Only dribble if *DRIBBLE-OUTPUT* is not NIL, and IS a stream; the NIL check is for speed, since the STREAMP is something like 30 of the time spent printing to the exec window!!")
(* ;; "Only dribble if *DRIBBLE-OUTPUT* is not NIL, and IS a stream; the NIL check is for speed, since the STREAMP is something like 30 of the time spent printing to the exec window!!")
`(AND *DRIBBLE-OUTPUT* (STREAMP *DRIBBLE-OUTPUT*)
(EQ ,DISPLAY-STREAM (TTYDISPLAYSTREAM))
@@ -4019,8 +4028,8 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
)
(DECLARE%: EVAL@COMPILE
[PUTPROPS \CHECKCARET MACRO ((X)
(AND \CARET.UP (\CARET.DOWN X]
(PUTPROPS \CHECKCARET MACRO ((X)
(AND \CARET.UP (\CARET.DOWN X))))
)
(* "END EXPORTED DEFINITIONS")
@@ -4120,21 +4129,21 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
[PUTPROPS \DSPTRANSFORMX MACRO ((X DD) (* transforms an x coordinate into
 the destination coordinate.)
(IPLUS X (fetch (\DISPLAYDATA DDXOFFSET) of DD]
(PUTPROPS \DSPTRANSFORMX MACRO ((X DD) (* transforms an x coordinate into
 the destination coordinate.)
(IPLUS X (fetch (\DISPLAYDATA DDXOFFSET) of DD))))
[PUTPROPS \DSPTRANSFORMY MACRO ((Y DD) (* transforms an y coordinate into
 the destination coordinate.)
(IPLUS Y (fetch (\DISPLAYDATA DDYOFFSET) of DD]
(PUTPROPS \DSPTRANSFORMY MACRO ((Y DD) (* transforms an y coordinate into
 the destination coordinate.)
(IPLUS Y (fetch (\DISPLAYDATA DDYOFFSET) of DD))))
(PUTPROPS \OFFSETBOTTOM MACRO ((X) (* gives the destination coordinate
 address of the origin.)
(fetch (\DISPLAYDATA DDYOFFSET) of X)))
(PUTPROPS \OFFSETBOTTOM MACRO ((X) (* gives the destination coordinate
 address of the origin.)
(fetch (\DISPLAYDATA DDYOFFSET) of X)))
(PUTPROPS \OFFSETLEFT MACRO ((DD) (* returns the x origin of display
 data destination coordinates.)
(fetch (\DISPLAYDATA DDXOFFSET) of DD)))
(PUTPROPS \OFFSETLEFT MACRO ((DD) (* returns the x origin of display
 data destination coordinates.)
(fetch (\DISPLAYDATA DDXOFFSET) of DD)))
)
(* "END EXPORTED DEFINITIONS")
@@ -4467,10 +4476,10 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
)
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* always initialized now)
T))
(PUTPROPS DISPLAYINITIALIZEDP MACRO (NIL (* always initialized now)
T))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -4507,7 +4516,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(DISPLAYSTREAMINIT 1000)
)
(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE)
(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
@@ -4517,44 +4526,44 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1993,
(ADDTOVAR LAMA )
)
(PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988
1989 1990 1993 1994))
1989 1990 1993 1994 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (20593 23261 (\FBITMAPBIT 20603 . 21063) (\FBITMAPBIT.UFN 21065 . 22084) (
\NEWPAGE.DISPLAY 22086 . 22221) (INITBITMASKS 22223 . 23259)) (25222 25731 (\CreateCursorBitMap 25232
. 25729)) (25848 84908 (BITBLT 25858 . 36248) (BLTSHADE 36250 . 37028) (\BITBLTSUB 37030 . 47165) (
\GETPILOTBBTSCRATCHBM 47167 . 47782) (BITMAPCOPY 47784 . 48360) (BITMAPCREATE 48362 . 49922) (
BITMAPBIT 49924 . 58311) (BLTCHAR 58313 . 58929) (\BLTCHAR 58931 . 59433) (\MEDW.BLTCHAR 59435 . 64313
) (\CHANGECHARSET.DISPLAY 64315 . 67273) (\INDICATESTRING 67275 . 68471) (\SLOWBLTCHAR 68473 . 75569)
(TEXTUREP 75571 . 75841) (INVERT.TEXTURE 75843 . 76117) (INVERT.TEXTURE.BITMAP 76119 . 77654) (
BITMAPWIDTH 77656 . 78028) (READBITMAP 78030 . 80512) (\INSUREBITSPERPIXEL 80514 . 80809) (
MAXIMUMCOLOR 80811 . 80952) (OPPOSITECOLOR 80954 . 81133) (MAXIMUMSHADE 81135 . 81346) (OPPOSITESHADE
81348 . 81527) (\MEDW.BITBLT 81529 . 84906)) (91458 91939 (BITMAPBIT.EXPANDER 91468 . 91937)) (91940
140474 (\BITBLT.DISPLAY 91950 . 115189) (\BITBLT.BITMAP 115191 . 124290) (\BITBLT.MERGE 124292 .
126545) (\BLTSHADE.DISPLAY 126547 . 133647) (\BLTSHADE.BITMAP 133649 . 140472)) (140475 149795 (
\BITBLT.BITMAP.SLOW 140485 . 149793)) (149796 166177 (\PUNT.BLTSHADE.BITMAP 149806 . 156902) (
\PUNT.BITBLT.BITMAP 156904 . 166175)) (166178 169618 (\SCALEDBITBLT.DISPLAY 166188 . 167821) (
\BACKCOLOR.DISPLAY 167823 . 169616)) (173493 175766 (DISPLAYSTREAMP 173503 . 174111) (DSPSOURCETYPE
174113 . 175122) (DSPXOFFSET 175124 . 175443) (DSPYOFFSET 175445 . 175764)) (175767 192014 (DSPCREATE
175777 . 177827) (DSPDESTINATION 177829 . 180932) (DSPTEXTURE 180934 . 181096) (
\DISPLAYSTREAMINCRXPOSITION 181098 . 181385) (\SFFixDestination 181387 . 182565) (\SFFixClippingRegion
182567 . 184739) (\SFFixFont 184741 . 185791) (\SFFIXLINELENGTH 185793 . 187289) (
\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187291 . 189104) (\SFFixY 189106 . 192012)) (192015 194209 (
\MEDW.XOFFSET 192025 . 193166) (\MEDW.YOFFSET 193168 . 194207)) (194210 202136 (
\DSPCLIPPINGREGION.DISPLAY 194220 . 194966) (\DSPFONT.DISPLAY 194968 . 197338) (\DISPLAY.PILOTBITBLT
197340 . 197489) (\DSPLINEFEED.DISPLAY 197491 . 198062) (\DSPLEFTMARGIN.DISPLAY 198064 . 198795) (
\DSPOPERATION.DISPLAY 198797 . 199821) (\DSPRIGHTMARGIN.DISPLAY 199823 . 200668) (
\DSPXPOSITION.DISPLAY 200670 . 201527) (\DSPYPOSITION.DISPLAY 201529 . 202134)) (206297 211333 (
TTYDISPLAYSTREAM 206307 . 211331)) (211652 212682 (DSPSCROLL 211662 . 212362) (PAGEHEIGHT 212364 .
212680)) (212727 215749 (\DSPRESET.DISPLAY 212737 . 215747)) (216309 236947 (\DSPPRINTCHAR 216319 .
224157) (\DSPPRINTCR/LF 224159 . 236945)) (236948 237540 (\TTYBACKGROUND 236958 . 237538)) (237541
240828 (DSPBACKUP 237551 . 240826)) (241012 241268 (COLORDISPLAYP 241022 . 241266)) (241269 243340 (
DISPLAYBEFOREEXIT 241279 . 242105) (DISPLAYAFTERENTRY 242107 . 243338)) (243701 248233 (
\DSPCLIPTRANSFORMX 243711 . 244300) (\DSPCLIPTRANSFORMY 244302 . 245027) (\DSPTRANSFORMREGION 245029
. 245561) (\DSPUNTRANSFORMY 245563 . 245823) (\DSPUNTRANSFORMX 245825 . 246085) (
\OFFSETCLIPPINGREGION 246087 . 248231)) (249501 252088 (UPDATESCREENDIMENSIONS 249511 . 250140) (
\CreateScreenBitMap 250142 . 252086)) (252647 265806 (\CoerceToDisplayDevice 252657 . 253070) (
\CREATEDISPLAY 253072 . 254912) (DISPLAYSTREAMINIT 254914 . 258058) (\STARTDISPLAY 258060 . 260971) (
\MOVE.WINDOWS.ONTO.SCREEN 260973 . 263165) (\UPDATE.PBT.RASTERWIDTHS 263167 . 264949) (\STOPDISPLAY
264951 . 265443) (\DEFINEDISPLAYINFO 265445 . 265804)) (266398 267159 (INITIALIZEDISPLAYSTREAMS 266408
. 267157)))))
(FILEMAP (NIL (20543 23211 (\FBITMAPBIT 20553 . 21013) (\FBITMAPBIT.UFN 21015 . 22034) (
\NEWPAGE.DISPLAY 22036 . 22171) (INITBITMASKS 22173 . 23209)) (25256 25765 (\CreateCursorBitMap 25266
. 25763)) (25882 84942 (BITBLT 25892 . 36282) (BLTSHADE 36284 . 37062) (\BITBLTSUB 37064 . 47199) (
\GETPILOTBBTSCRATCHBM 47201 . 47816) (BITMAPCOPY 47818 . 48394) (BITMAPCREATE 48396 . 49956) (
BITMAPBIT 49958 . 58345) (BLTCHAR 58347 . 58963) (\BLTCHAR 58965 . 59467) (\MEDW.BLTCHAR 59469 . 64347
) (\CHANGECHARSET.DISPLAY 64349 . 67307) (\INDICATESTRING 67309 . 68505) (\SLOWBLTCHAR 68507 . 75603)
(TEXTUREP 75605 . 75875) (INVERT.TEXTURE 75877 . 76151) (INVERT.TEXTURE.BITMAP 76153 . 77688) (
BITMAPWIDTH 77690 . 78062) (READBITMAP 78064 . 80546) (\INSUREBITSPERPIXEL 80548 . 80843) (
MAXIMUMCOLOR 80845 . 80986) (OPPOSITECOLOR 80988 . 81167) (MAXIMUMSHADE 81169 . 81380) (OPPOSITESHADE
81382 . 81561) (\MEDW.BITBLT 81563 . 84940)) (84944 90259 (FINISH-READING-BITMAP 84944 . 90259)) (
91522 92003 (BITMAPBIT.EXPANDER 91532 . 92001)) (92004 140538 (\BITBLT.DISPLAY 92014 . 115253) (
\BITBLT.BITMAP 115255 . 124354) (\BITBLT.MERGE 124356 . 126609) (\BLTSHADE.DISPLAY 126611 . 133711) (
\BLTSHADE.BITMAP 133713 . 140536)) (140539 149859 (\BITBLT.BITMAP.SLOW 140549 . 149857)) (149860
166241 (\PUNT.BLTSHADE.BITMAP 149870 . 156966) (\PUNT.BITBLT.BITMAP 156968 . 166239)) (166242 169682 (
\SCALEDBITBLT.DISPLAY 166252 . 167885) (\BACKCOLOR.DISPLAY 167887 . 169680)) (174000 176273 (
DISPLAYSTREAMP 174010 . 174618) (DSPSOURCETYPE 174620 . 175629) (DSPXOFFSET 175631 . 175950) (
DSPYOFFSET 175952 . 176271)) (176274 192575 (DSPCREATE 176284 . 178388) (DSPDESTINATION 178390 .
181493) (DSPTEXTURE 181495 . 181657) (\DISPLAYSTREAMINCRXPOSITION 181659 . 181946) (\SFFixDestination
181948 . 183126) (\SFFixClippingRegion 183128 . 185300) (\SFFixFont 185302 . 186352) (\SFFIXLINELENGTH
186354 . 187850) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187852 . 189665) (\SFFixY 189667 . 192573))
(192576 194770 (\MEDW.XOFFSET 192586 . 193727) (\MEDW.YOFFSET 193729 . 194768)) (194771 202697 (
\DSPCLIPPINGREGION.DISPLAY 194781 . 195527) (\DSPFONT.DISPLAY 195529 . 197899) (\DISPLAY.PILOTBITBLT
197901 . 198050) (\DSPLINEFEED.DISPLAY 198052 . 198623) (\DSPLEFTMARGIN.DISPLAY 198625 . 199356) (
\DSPOPERATION.DISPLAY 199358 . 200382) (\DSPRIGHTMARGIN.DISPLAY 200384 . 201229) (
\DSPXPOSITION.DISPLAY 201231 . 202088) (\DSPYPOSITION.DISPLAY 202090 . 202695)) (207467 212503 (
TTYDISPLAYSTREAM 207477 . 212501)) (212822 213852 (DSPSCROLL 212832 . 213532) (PAGEHEIGHT 213534 .
213850)) (213897 216919 (\DSPRESET.DISPLAY 213907 . 216917)) (217479 238117 (\DSPPRINTCHAR 217489 .
225327) (\DSPPRINTCR/LF 225329 . 238115)) (238118 238710 (\TTYBACKGROUND 238128 . 238708)) (238711
241998 (DSPBACKUP 238721 . 241996)) (242182 242438 (COLORDISPLAYP 242192 . 242436)) (242439 244510 (
DISPLAYBEFOREEXIT 242449 . 243275) (DISPLAYAFTERENTRY 243277 . 244508)) (244890 249422 (
\DSPCLIPTRANSFORMX 244900 . 245489) (\DSPCLIPTRANSFORMY 245491 . 246216) (\DSPTRANSFORMREGION 246218
. 246750) (\DSPUNTRANSFORMY 246752 . 247012) (\DSPUNTRANSFORMX 247014 . 247274) (
\OFFSETCLIPPINGREGION 247276 . 249420)) (250728 253315 (UPDATESCREENDIMENSIONS 250738 . 251367) (
\CreateScreenBitMap 251369 . 253313)) (253874 267033 (\CoerceToDisplayDevice 253884 . 254297) (
\CREATEDISPLAY 254299 . 256139) (DISPLAYSTREAMINIT 256141 . 259285) (\STARTDISPLAY 259287 . 262198) (
\MOVE.WINDOWS.ONTO.SCREEN 262200 . 264392) (\UPDATE.PBT.RASTERWIDTHS 264394 . 266176) (\STOPDISPLAY
266178 . 266670) (\DEFINEDISPLAYINFO 266672 . 267031)) (267641 268402 (INITIALIZEDISPLAYSTREAMS 267651
. 268400)))))
STOP

671
sources/LLDISPLAY.LCOM
View File

File diff suppressed because one or more lines are too long

44
sources/LLREAD
View File

@@ -1,12 +1,11 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "27-Jun-2021 23:26:36" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;47 97691
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "29-Jul-2021 22:16:26" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;50 97706
changes to%: (FNS \PEEKCCODE.NOEOLC \INCCODE.EOLC)
(VARS LLREADCOMS)
changes to%: (VARS CHARACTERSETNAMES)
previous date%: "24-Jun-2021 17:26:28"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;45)
previous date%: "29-Jul-2021 22:14:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLREAD.;48)
(* ; "
@@ -1560,6 +1559,7 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
("LF" 10)))
(RPAQQ CHARACTERSETNAMES ((Meta 1)
(Function 2)
("Greek" 38)
("Cyrillic" 39)
("Hira" 36)
@@ -1794,19 +1794,19 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(LOCALVARS . T)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
)
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3513 11730 (LASTC 3523 . 3829) (PEEKC 3831 . 4219) (PEEKCCODE 4221 . 4514) (RATOM 4516
. 5597) (READ 5599 . 6159) (READC 6161 . 6796) (READCCODE 6798 . 7551) (READP 7553 . 8105) (
SETREADMACROFLG 8107 . 8406) (SKIPSEPRCODES 8408 . 9391) (SKIPSEPRS 9393 . 9779) (SKREAD 9781 . 11728)
) (11776 20451 (CL:READ 11786 . 12335) (CL:READ-PRESERVING-WHITESPACE 12337 . 13059) (
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
)
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3485 11702 (LASTC 3495 . 3801) (PEEKC 3803 . 4191) (PEEKCCODE 4193 . 4486) (RATOM 4488
. 5569) (READ 5571 . 6131) (READC 6133 . 6768) (READCCODE 6770 . 7523) (READP 7525 . 8077) (
SETREADMACROFLG 8079 . 8378) (SKIPSEPRCODES 8380 . 9363) (SKIPSEPRS 9365 . 9751) (SKREAD 9753 . 11700)
) (11748 20423 (CL:READ 11758 . 12307) (CL:READ-PRESERVING-WHITESPACE 12309 . 13031) (
CL:READ-DELIMITED-LIST 13033 . 13948) (CL:PARSE-INTEGER 13950 . 20421)) (20516 33455 (RSTRING 20526 .

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.

1868
sources/MACHINEINDEPENDENT
View File

File diff suppressed because it is too large Load Diff

BIN
sources/MACHINEINDEPENDENT.LCOM
View File

Binary file not shown.

128
sources/MAKEINIT
View File

@@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Mar-2021 22:14:46" {DSK}<Users>larry>ilisp>medley>SOURCES>MAKEINIT.;2 52570
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "19-Jul-2021 23:50:29" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>MAKEINIT.;4 54410
changes to%: (FNS MAKEINITGREET)
changes to%: (FNS MKI.PASSFILE)
previous date%: " 9-Mar-2021 16:40:20" {DSK}<Users>larry>ilisp>medley>SOURCES>MAKEINIT.;1)
previous date%: "17-Jul-2021 21:29:31"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>MAKEINIT.;3)
(* ; "
Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT MAKEINITCOMS)
@@ -15,7 +17,7 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. Al
(RPAQQ MAKEINITCOMS
((COMS
(* ;;; "From MAKEINITGREET")
(* ;;; "From MAKEINITGREET")
(FNS MAKEINITGREET)
(FILES (SOURCE)
@@ -24,11 +26,11 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. Al
LLARITH LLFLOAT)
(FILES RENAMEFNS XCL-PACKAGE CMLARRAY-SUPPORT VMEM))
(COMS
(* ;; "From original MAKEINIT")
(* ;; "From original MAKEINIT")
(FNS LOADMAKEINIT LOADMKIFILES RELOAD MAKEINIT MKI.START)
(COMS (* ;
 "reading compiled files and processing well-known expressions")
(COMS (* ;
 "reading compiled files and processing well-known expressions")
(FNS MKI.PASSFILE SCRATCHARRAY DOFORM CONSTFORMP NOTICECOMS EVALFORMAKEINIT)
(FNS I.ADDTOVAR I.DECLARE%: I.DEFINE-FILE-INFO I.FILECREATED I.PUTPROPS I.RPAQ
I.RPAQQ I.RPAQ? I.SETTOPVAL I.NOUNDO)
@@ -36,10 +38,10 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. Al
RPAQQ LISPXPRINT PRETTYCOMPRINT * SETTOPVAL SETQQ SETQ /SETTOPVAL))
(FNS I.ATOMNUMBER I.\ATOMCELL I.FIXUPNUM I.FIXUPPTR I.FIXUPSYM I.WORDSPERNAMEENTRY
I.SETSTKNTOFFSET)
(COMS (* ; "stuff for MAXC")
(COMS (* ; "stuff for MAXC")
(FNS MKI.ATOM MKI.IEEE))
[COMS (* ;
 "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.")
[COMS (* ;
 "stuff to maintain symbol values, prop lists during makeinit--all dumped at end.")
(FNS MKI.DSET MKI.ADDTO MKI.PUTPROP)
(VARS (MKI.ARRAY)
(MKI.TVHA (HASHARRAY 400))
@@ -58,10 +60,10 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. Al
(FILES (LOADCOMP)
MEM)))
(COMS
(* ;; "from DLFIXINIT")
(* ;; "from DLFIXINIT")
(* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now")
(* ;; " This file is all because the dandelion needed its microcode embedded in the init file, and MAIKO wasn't around. So this is all to make room for microcode we don't need. Except something(?) might expect the %"InterfacePage%" as page 2 of the file, so we're leaving it in place now")
(FNS DLFIXINIT DLSORTSYSOUTPAGES DLNEXTFP DLLOCKEDPAGEP DLSETLOCKBIT DLCOPYPAGEMAP
DLCOPYVMPAGE DLADDPAGEMAPENTRIES ASSIGNFILEPAGE ASSIGNFILEPAGERANGE DLDUMPSYSOUT
@@ -195,8 +197,62 @@ Copyright (c) 1982-1988, 1990-1992, 1998, 2021 by Venue & Xerox Corporation. Al
(DEFINEQ
(MKI.PASSFILE
(LAMBDA (FILESET) (* ; "Edited 30-Mar-87 17:17 by bvm:") (* ;;; "Read a DCOM file and load its contents into the INIT.") (* ;;; "FILESET can be one of a number, which is a LISPSET number, or a list of file names, or a file name") (COND ((NUMBERP FILESET) (* ; "We were given a nLISPSET number. Pack it up to get the list of files") (MKI.PASSFILE (EVALV (PACK* FILESET (QUOTE LISPSET))))) ((LISTP FILESET) (* ; "We were given a list of file names") (MAPC FILESET (FUNCTION MKI.PASSFILE))) (T (* ; "It's a file name. Read it in.") (INPUT (SETQ FILESET (OPENSTREAM (OR (FINDFILE (PACKFILENAME.STRING (QUOTE BODY) FILESET (QUOTE EXTENSION) REMOTECOMPILE.EXT) T) FILESET) (QUOTE INPUT) (QUOTE OLD) 8 MKI.SEQUENTIAL))) (MKI.ADDTO (QUOTE LOADEDFILELST) (LIST (SETQ FILESET (FULLNAME FILESET)))) (PRINT FILESET T T) (LET* ((FILEROOT (NAMEFIELD FILESET)) (COMSNAMES (LIST (PACK* FILEROOT (QUOTE COMS)))) SKIPVARS MEXPRS X) (DECLARE (SPECVARS COMSNAMES SKIPVARS MEXPRS)) (* ; " used by I.RPAQQ and DOFORM") (* ;;; "Loop here reading from the dcom file into the init.") (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT* (until (SELECTQ (SETQ X (READ)) ((STOP NIL) (* ; "End of file") T) NIL) do (COND ((NLISTP X) (* ;; "Start of a code object. Skip the code indicator (assume it says to read with DCODERD) and read the code") (IF (NOT (LITATOM (READ))) THEN (ERROR "Bad compiled function" X)) (I.DCODERD X)) (T (* ; "It's a form. go either do it now or add it to the forms to execute inside the init.") (DOFORM X))) finally (COND ((CAR MEXPRS) (* ; "There are expressions to be executed in the INIT when it comes up. Save them.") (MKI.ADDTO (SETQ FILESET (PACK* FILEROOT ".EXPRESSIONS")) (CAR MEXPRS)) (MKI.ADDTO (QUOTE BOOTFILES) (LIST FILESET)))))) (CLOSEF (INPUT))))))
)
[LAMBDA (FILESET) (* ; "Edited 19-Jul-2021 23:50 by rmk:")
(* ;;; "Read a DCOM file and load its contents into the INIT.")
(* ;;;
"FILESET can be one of a number, which is a LISPSET number, or a list of file names, or a file name")
(COND
[(NUMBERP FILESET) (* ;
 "We were given a nLISPSET number. Pack it up to get the list of files")
(MKI.PASSFILE (EVALV (PACK* FILESET 'LISPSET]
((LISTP FILESET) (* ;
 "We were given a list of file names")
(MAPC FILESET (FUNCTION MKI.PASSFILE)))
(T (* ; "It's a file name. Read it in.")
(INPUT (SETQ FILESET (OPENSTREAM (OR (FINDFILE (PACKFILENAME.STRING 'BODY FILESET
'EXTENSION REMOTECOMPILE.EXT)
T)
FILESET)
'INPUT
'OLD 8 MKI.SEQUENTIAL)))
[MKI.ADDTO 'LOADEDFILELST (LIST (SETQ FILESET (FULLNAME FILESET]
(PRINT FILESET T T)
(LET* ((FILEROOT (NAMEFIELD FILESET))
[COMSNAMES (LIST (PACK* FILEROOT 'COMS]
SKIPVARS MEXPRS X)
(DECLARE (SPECVARS COMSNAMES SKIPVARS MEXPRS))
(* ; " used by I.RPAQQ and DOFORM")
(* ;;; "Loop here reading from the dcom file into the init. ")
(* ;; "RMK: Pick off the DEFINE-FILE-INFO first, so we can read the rest of the file. This is done locally, not in the DOFORM. The rest of the file is run in the external format that the reader returns.")
(WITH-READER-ENVIRONMENT (READ-READER-ENVIRONMENT (INPUT)
*OLD-INTERLISP-READ-ENVIRONMENT*)
[until (SELECTQ (SETQ X (READ))
((STOP NIL) (* ; "End of file")
T)
NIL) do (COND
((NLISTP X)
(* ;; "Start of a code object. Skip the code indicator (assume it says to read with DCODERD) and read the code")
(IF (NOT (LITATOM (READ)))
THEN (ERROR "Bad compiled function" X))
(I.DCODERD X))
(T (* ;
 "It's a form. go either do it now or add it to the forms to execute inside the init.")
(DOFORM X)))
finally (COND
((CAR MEXPRS) (* ;
 "There are expressions to be executed in the INIT when it comes up. Save them.")
(MKI.ADDTO (SETQ FILESET (PACK* FILEROOT ".EXPRESSIONS"))
(CAR MEXPRS))
(MKI.ADDTO 'BOOTFILES (LIST FILESET])
(CLOSEF (INPUT])
(SCRATCHARRAY
(LAMBDA (NBYTES ALIGN) (* ; "Edited 30-Mar-87 16:20 by bvm:") (COND ((OR (NULL MKI.ARRAY) (IGREATERP NBYTES (ARRAYSIZE MKI.ARRAY))) (* ;; "make sure the scratch array is big enough. Note that the scratch array is unboxed, not code, since we aren't going to be storing legitimate local code in it (let's not fool the garbage collector too much).") (SETQ MKI.ARRAY (create ARRAYP TYP _ \ST.BYTE BASE _ (\ALLOCBLOCK (FOLDHI NBYTES BYTESPERCELL) UNBOXEDBLOCK.GCT 0 CELLSPERQUAD) LENGTH _ NBYTES ORIG _ 0)))) (for I from 0 to (SUB1 (UNFOLD ALIGN BYTESPERCELL)) do (\BYTESETA MKI.ARRAY I 0)) (* ; "clear the fnheader area") MKI.ARRAY)
@@ -997,25 +1053,25 @@ DONTCOPY
(PUTPROPS MAKEINIT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1992 1998 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3943 4690 (MAKEINITGREET 3953 . 4688)) (4873 11258 (LOADMAKEINIT 4883 . 6086) (
LOADMKIFILES 6088 . 6403) (RELOAD 6405 . 6888) (MAKEINIT 6890 . 10550) (MKI.START 10552 . 11256)) (
11336 15237 (MKI.PASSFILE 11346 . 13139) (SCRATCHARRAY 13141 . 13790) (DOFORM 13792 . 14469) (
CONSTFORMP 14471 . 14705) (NOTICECOMS 14707 . 15015) (EVALFORMAKEINIT 15017 . 15235)) (15238 17358 (
I.ADDTOVAR 15248 . 15342) (I.DECLARE%: 15344 . 15620) (I.DEFINE-FILE-INFO 15622 . 15812) (
I.FILECREATED 15814 . 16188) (I.PUTPROPS 16190 . 16303) (I.RPAQ 16305 . 16526) (I.RPAQQ 16528 . 16724)
(I.RPAQ? 16726 . 16941) (I.SETTOPVAL 16943 . 17175) (I.NOUNDO 17177 . 17356)) (17994 23994 (
I.ATOMNUMBER 18004 . 18495) (I.\ATOMCELL 18497 . 20250) (I.FIXUPNUM 20252 . 21069) (I.FIXUPPTR 21071
. 21552) (I.FIXUPSYM 21554 . 22502) (I.WORDSPERNAMEENTRY 22504 . 23259) (I.SETSTKNTOFFSET 23261 .
23992)) (24026 25534 (MKI.ATOM 24036 . 24232) (MKI.IEEE 24234 . 25532)) (25631 26396 (MKI.DSET 25641
. 25924) (MKI.ADDTO 25926 . 26111) (MKI.PUTPROP 26113 . 26394)) (26570 27122 (DUMPVP 26580 . 26677) (
BOUTZEROS 26679 . 26758) (BIN16 26760 . 26941) (BOUT16 26943 . 27120)) (28037 50771 (DLFIXINIT 28047
. 29022) (DLSORTSYSOUTPAGES 29024 . 34150) (DLNEXTFP 34152 . 34489) (DLLOCKEDPAGEP 34491 . 34705) (
DLSETLOCKBIT 34707 . 34969) (DLCOPYPAGEMAP 34971 . 38022) (DLCOPYVMPAGE 38024 . 38414) (
DLADDPAGEMAPENTRIES 38416 . 39231) (ASSIGNFILEPAGE 39233 . 40466) (ASSIGNFILEPAGERANGE 40468 . 40875)
(DLDUMPSYSOUT 40877 . 42629) (DLDUMPFPTOVP 42631 . 43670) (DLDUMPPAGEMAPS 43672 . 44372) (
DLDUMPVMEMPAGES 44374 . 45030) (DLSETBOOTPTR 45032 . 45262) (DLDUMPARRAY 45264 . 45651) (
DLMARKASDUMPED 45653 . 46106) (DLDUMPVMEMPAGE 46108 . 46796) (INSTALLDOMINO 46798 . 47445) (
INSTALLDOMINO.DIRECT 47447 . 48599) (INSTALLNEWDOMINO 48601 . 50769)) (50793 52150 (DLPRINTFPTOVP
50803 . 51092) (PRINTPRIMARYMAP 51094 . 51808) (DLREADPAGEOFWORDS 51810 . 51977) (SETDIF 51979 . 52148
(FILEMAP (NIL (3966 4713 (MAKEINITGREET 3976 . 4711)) (4896 11281 (LOADMAKEINIT 4906 . 6109) (
LOADMKIFILES 6111 . 6426) (RELOAD 6428 . 6911) (MAKEINIT 6913 . 10573) (MKI.START 10575 . 11279)) (
11359 17077 (MKI.PASSFILE 11369 . 14979) (SCRATCHARRAY 14981 . 15630) (DOFORM 15632 . 16309) (
CONSTFORMP 16311 . 16545) (NOTICECOMS 16547 . 16855) (EVALFORMAKEINIT 16857 . 17075)) (17078 19198 (
I.ADDTOVAR 17088 . 17182) (I.DECLARE%: 17184 . 17460) (I.DEFINE-FILE-INFO 17462 . 17652) (
I.FILECREATED 17654 . 18028) (I.PUTPROPS 18030 . 18143) (I.RPAQ 18145 . 18366) (I.RPAQQ 18368 . 18564)
(I.RPAQ? 18566 . 18781) (I.SETTOPVAL 18783 . 19015) (I.NOUNDO 19017 . 19196)) (19834 25834 (
I.ATOMNUMBER 19844 . 20335) (I.\ATOMCELL 20337 . 22090) (I.FIXUPNUM 22092 . 22909) (I.FIXUPPTR 22911
. 23392) (I.FIXUPSYM 23394 . 24342) (I.WORDSPERNAMEENTRY 24344 . 25099) (I.SETSTKNTOFFSET 25101 .
25832)) (25866 27374 (MKI.ATOM 25876 . 26072) (MKI.IEEE 26074 . 27372)) (27471 28236 (MKI.DSET 27481
. 27764) (MKI.ADDTO 27766 . 27951) (MKI.PUTPROP 27953 . 28234)) (28410 28962 (DUMPVP 28420 . 28517) (
BOUTZEROS 28519 . 28598) (BIN16 28600 . 28781) (BOUT16 28783 . 28960)) (29877 52611 (DLFIXINIT 29887
. 30862) (DLSORTSYSOUTPAGES 30864 . 35990) (DLNEXTFP 35992 . 36329) (DLLOCKEDPAGEP 36331 . 36545) (
DLSETLOCKBIT 36547 . 36809) (DLCOPYPAGEMAP 36811 . 39862) (DLCOPYVMPAGE 39864 . 40254) (
DLADDPAGEMAPENTRIES 40256 . 41071) (ASSIGNFILEPAGE 41073 . 42306) (ASSIGNFILEPAGERANGE 42308 . 42715)
(DLDUMPSYSOUT 42717 . 44469) (DLDUMPFPTOVP 44471 . 45510) (DLDUMPPAGEMAPS 45512 . 46212) (
DLDUMPVMEMPAGES 46214 . 46870) (DLSETBOOTPTR 46872 . 47102) (DLDUMPARRAY 47104 . 47491) (
DLMARKASDUMPED 47493 . 47946) (DLDUMPVMEMPAGE 47948 . 48636) (INSTALLDOMINO 48638 . 49285) (
INSTALLDOMINO.DIRECT 49287 . 50439) (INSTALLNEWDOMINO 50441 . 52609)) (52633 53990 (DLPRINTFPTOVP
52643 . 52932) (PRINTPRIMARYMAP 52934 . 53648) (DLREADPAGEOFWORDS 53650 . 53817) (SETDIF 53819 . 53988
)))))
STOP

BIN
sources/MAKEINIT.LCOM
View File

Binary file not shown.

34
sources/PACKAGE-STARTUP
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "28-Jun-2021 13:02:48" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;2| 36550
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10 FORMAT XCCS)
(FILECREATED " 1-Aug-2021 18:08:23" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;9| 36725
|changes| |to:| (FUNCTIONS PACKAGE-ENABLE)
|previous| |date:| "15-Mar-91 17:09:30"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;1|)
|previous| |date:| "29-Jul-2021 20:33:07"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;8|)
; Copyright (c) 1986-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
@@ -571,6 +571,7 @@
(DECLARE (CL:SPECIAL *INTERLISP-PACKAGE* *PACKAGE* *OLD-INTERLISP-READ-ENVIRONMENT*
*PER-EXEC-VARIABLES*))
(|replace| REPACKAGE |of| *OLD-INTERLISP-READ-ENVIRONMENT* |with| *INTERLISP-PACKAGE*)
(|replace| REPACKAGE |of| *DEFINE-FILE-INFO-ENV* |with| *INTERLISP-PACKAGE*)
(COND
((FIND-READTABLE "LISP")
(READTABLEPROP (FIND-READTABLE "LISP")
@@ -593,7 +594,8 @@
(T (PROMPTPRINT "Invalid package, reset to LISP")
(SETQ *PACKAGE* (CL:FIND-PACKAGE "LISP")))))
*PER-EXEC-VARIABLES* :TEST 'CL:EQUAL)
(CL:SETF *DEFAULT-MAKEFILE-ENVIRONMENT* '(:READTABLE "XCL" :PACKAGE "INTERLISP" :FORMAT :XCCS))
(CL:SETF *DEFAULT-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT
:XCCS))
(MOVD '\\NEW.READ.SYMBOL '\\READ.SYMBOL)
(MOVD '\\NEW.MKATOM '\\MKATOM)
(CL:SETF *PACKAGE* PACKAGE)
@@ -643,14 +645,14 @@
)
(PUTPROPS PACKAGE-STARTUP COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2021))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3098 3193 (RETURN-FIRST-OF-THREE 3098 . 3193)) (3195 3333 (
ERROR-MISSING-EXTERNAL-SYMBOL 3195 . 3333)) (3938 4906 (CHECK-SYMBOL-NAMESTRING 3938 . 4906)) (4908
8069 (\\NEW.READ.SYMBOL 4908 . 8069)) (8071 9777 (\\NEW.MKATOM 8071 . 9777)) (23575 23657 (
LITATOM.EXISTS 23575 . 23657)) (24337 25303 (NAMESTRING-CONVERSION-CLAUSE 24337 . 25303)) (25305 26554
(CONVERT-LITATOM 25305 . 26554)) (26556 28625 (CONCOCT-SYMBOL 26556 . 28625)) (28627 28921 (
TRANSFER-SYMBOL 28627 . 28921)) (28923 29631 (INTERN-LITATOM 28923 . 29631)) (29633 30260 (
\\LITATOM.EATCHARS 29633 . 30260)) (30262 30539 (PACKAGE-INIT 30262 . 30539)) (30541 31118 (
PACKAGE-CLEAR 30541 . 31118)) (31120 32515 (PACKAGE-MAKE 31120 . 32515)) (32517 33838 (
PACKAGE-HIERARCHY-INIT 32517 . 33838)) (33840 35303 (PACKAGE-ENABLE 33840 . 35303)) (35305 35948 (
PACKAGE-DISABLE 35305 . 35948)) (35995 36021 (ID 35995 . 36021)))))
(FILEMAP (NIL (3123 3218 (RETURN-FIRST-OF-THREE 3123 . 3218)) (3220 3358 (
ERROR-MISSING-EXTERNAL-SYMBOL 3220 . 3358)) (3963 4931 (CHECK-SYMBOL-NAMESTRING 3963 . 4931)) (4933
8094 (\\NEW.READ.SYMBOL 4933 . 8094)) (8096 9802 (\\NEW.MKATOM 8096 . 9802)) (23600 23682 (
LITATOM.EXISTS 23600 . 23682)) (24362 25328 (NAMESTRING-CONVERSION-CLAUSE 24362 . 25328)) (25330 26579
(CONVERT-LITATOM 25330 . 26579)) (26581 28650 (CONCOCT-SYMBOL 26581 . 28650)) (28652 28946 (
TRANSFER-SYMBOL 28652 . 28946)) (28948 29656 (INTERN-LITATOM 28948 . 29656)) (29658 30285 (
\\LITATOM.EATCHARS 29658 . 30285)) (30287 30564 (PACKAGE-INIT 30287 . 30564)) (30566 31143 (
PACKAGE-CLEAR 30566 . 31143)) (31145 32540 (PACKAGE-MAKE 31145 . 32540)) (32542 33863 (
PACKAGE-HIERARCHY-INIT 32542 . 33863)) (33865 35478 (PACKAGE-ENABLE 33865 . 35478)) (35480 36123 (
PACKAGE-DISABLE 35480 . 36123)) (36170 36196 (ID 36170 . 36196)))))
STOP

BIN
sources/PACKAGE-STARTUP.LCOM
View File

Binary file not shown.

111
sources/WINDOW
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jun-2021 10:14:32" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>WINDOW.;2 224540
(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
changes to%: (FNS \TTY.CREATING.DISPLAYSTREAM)
changes to%: (FNS \MEDW.DSPCREATE)
previous date%: " 9-Apr-2000 17:36:29"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>WINDOW.;1)
previous date%: "13-Jun-2021 10:14:32"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>WINDOW.;2)
(* ; "
@@ -3258,38 +3258,39 @@ Middle button down moves closest corner.")
WINDOW])
(\MEDW.DSPCREATE
[LAMBDA (SCREEN DESTINATION OLDSTREAM) (* ; "Edited 28-Dec-93 14:09 by nilsson")
[LAMBDA (SCREEN DESTINATION OLDSTREAM) (* ; "Edited 2-Aug-2021 00:44 by rmk:")
(* ;; "MEDLEY-WINDOW-SPECIFIC version of DSPCREATE. This is what gets called by dispatch from \GENERIC.DSPCREATE.")
(* ;; "MEDLEY-WINDOW-SPECIFIC version of DSPCREATE. This is what gets called by dispatch from \GENERIC.DSPCREATE.")
(* ;; "Creates a stream-of-type-display on the DESTINATION bitmap or display device")
(* ;; "Creates a stream-of-type-display on the DESTINATION bitmap or display device")
(LET ([DSTRM (OR OLDSTREAM (create STREAM
USERCLOSEABLE _ NIL
EOLCONVENTION _ CR.EOLC
IMAGEDATA _ (create \DISPLAYDATA]
(DESTINATION (OR (BITMAPP (fetch (SCREEN SCDESTINATION) of SCREEN))
(BITMAPP DESTINATION)
ScreenBitMap))) (* ;
 "initial x and y positions are 0 when the data is created.")
ScreenBitMap))) (* ;
 "initial x and y positions are 0 when the data is created.")
(with STREAM DSTRM (SETQ DEVICE (fetch (SCREEN WINFDEV) of SCREEN))
(SETQ ACCESS 'OUTPUT)
(SETQ STRMBOUTFN (FUNCTION \DSPPRINTCHAR))
(SETQ OUTCHARFN (FUNCTION \DSPPRINTCHAR))
(SETQ IMAGEOPS (fetch (SCREEN WINIMAGEOPS) of SCREEN))
(replace (\DISPLAYDATA DDDestination) of IMAGEDATA with DESTINATION))
(DSPFONT DEFAULTFONT DSTRM) (* ;
 "dspfont can win since the (default) display imageops are filled in the stream")
(DSPDESTINATION DESTINATION DSTRM) (* ;
 "dspdestination calls \SFFixFont, which presumes there is a font present.")
(DSPFONT DEFAULTFONT DSTRM) (* ;
 "dspfont can win since the (default) display imageops are filled in the stream")
(DSPDESTINATION DESTINATION DSTRM) (* ;
 "dspdestination calls \SFFixFont, which presumes there is a font present.")
(DSPFONT DEFAULTFONT DSTRM)
(* ;; "the reference to SCREENWIDTH here is for historic reasons: until 3-feb-86 the default right margin was always SCREENWIDTH. It should be the width of the destination and for any destination larger than the screen this is a serious bug and was fixed. The MAX of the right value and SCREENWIDTH was left in because existing code might be assumine a large right margin for small bitmaps and auto-CR in without it. rrb")
(* ;; "the reference to SCREENWIDTH here is for historic reasons: until 3-feb-86 the default right margin was always SCREENWIDTH. It should be the width of the destination and for any destination larger than the screen this is a serious bug and was fixed. The MAX of the right value and SCREENWIDTH was left in because existing code might be assumine a large right margin for small bitmaps and auto-CR in without it. rrb")
(DSPRIGHTMARGIN (MAX SCREENWIDTH (fetch (BITMAP BITMAPWIDTH) of DESTINATION))
DSTRM)
(DSPSOURCETYPE 'INPUT DSTRM)
(DSPOPERATION 'REPLACE DSTRM) (* ;
 "called to cause the updating of the bitblt table from the fields initialized earlier.")
(DSPOPERATION 'REPLACE DSTRM) (* ;
 "called to cause the updating of the bitblt table from the fields initialized earlier.")
DSTRM])
(\GENERIC.DSPCREATE
@@ -4031,41 +4032,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 (11546 26186 (WINDOWWORLD 11556 . 15309) (WINDOWWORLDP 15311 . 15611) (CHANGEBACKGROUND
15613 . 16650) (CHANGEBACKGROUNDBORDER 16652 . 17203) (TILE 17205 . 17797) (
\TTY.CREATING.DISPLAYSTREAM 17799 . 18346) (\CREATE.TTY.OUTCHARFN 18348 . 18648) (
\CREATE.TTYDISPLAYSTREAM 18650 . 21689) (HASTTYWINDOWP 21691 . 21971) (TTYINFOSTREAM 21973 . 22497) (
CREATESCREEN 22499 . 25442) (\INSURESCREEN 25444 . 25693) (\BITMAPTOSCREEN 25695 . 26056) (MAINSCREEN
26058 . 26184)) (26845 44128 (WINDOW.MOUSE.HANDLER 26855 . 39650) (\PROTECTED.APPLY 39652 . 39900) (
DOWINDOWCOM 39902 . 41922) (DOBACKGROUNDCOM 41924 . 43082) (DEFAULT.BACKGROUND.COPYFN 43084 . 44126))
(44209 76092 (BURYW 44219 . 44507) (CLEARW 44509 . 44899) (CLOSEW 44901 . 45675) (\CLOSEW1 45677 .
46030) (\OKTOCLOSEW 46032 . 46391) (\INTERACTIVE.CLOSEW 46393 . 47216) (OPENW 47218 . 48273) (
DOUSERFNS 48275 . 49436) (DOUSERFNS2 49438 . 49934) (\USERFNISDON'T 49936 . 50207) (\OPENW1 50209 .
50559) (CREATEW 50561 . 51825) (CREATEW1 51827 . 54105) (\CREATEW1 54107 . 55326) (OPENDISPLAYSTREAM
55328 . 55651) (MOVEW 55653 . 55868) (PPROMPT3 55870 . 56198) (\ONSCREENCLIPPINGREGION 56200 . 56751)
(RELMOVEW 56753 . 57051) (SHAPEW 57053 . 61972) (SHAPEW1 61974 . 64676) (\SHAPEW2 64678 . 67364) (
RESHOWBORDER 67366 . 67877) (\RESHOWBORDER1 67879 . 72805) (TRACKW 72807 . 73922) (SNAPW 73924 . 75597
) (WINDOWREGION 75599 . 76090)) (76093 76789 (MINIMUMWINDOWSIZE 76103 . 76787)) (78546 101811 (
ADVISEWDS 78556 . 86499) (SHOWWFRAME 86501 . 88253) (SHOWWTITLE 88255 . 92289) (\STRINGWIDTHGUESS
92291 . 92650) (RESHOWTITLE 92652 . 97293) (TOTOPW 97295 . 97534) (\INTERNALTOTOPW 97536 . 98626) (
\TTW1 98628 . 101228) (WHICHW 101230 . 101809)) (101940 104778 (WFROMDS 101950 . 103948) (NU\TOTOPWDS
103950 . 104386) (\COERCETODS 104388 . 104776)) (105469 112269 (WINDOWP 105479 . 105625) (
INSURE.WINDOW 105627 . 105966) (WINDOWPROP 105968 . 106400) (WINDOWADDPROP 106402 . 108136) (
WINDOWDELPROP 108138 . 108564) (GETWINDOWPROP 108566 . 109116) (GETWINDOWUSERPROP 109118 . 109545) (
PUTWINDOWPROP 109547 . 110012) (REMWINDOWPROP 110014 . 111069) (WINDOWADDFNPROP 111071 . 112267)) (
112477 120041 (CWINDOWPROP 112487 . 113492) (CGETWINDOWPROP 113494 . 118712) (\GETWINDOWHEIGHT 118714
. 119622) (\GETWINDOWWIDTH 119624 . 120039)) (120042 135490 (OPENWP 120052 . 120330) (TOPWP 120332 .
120615) (RESHAPEBYREPAINTFN 120617 . 130869) (\INBETWEENP 130871 . 131087) (
DECODE/WINDOW/OR/DISPLAYSTREAM 131089 . 133129) (GROW/REGION 133131 . 133694) (CLRPROMPT 133696 .
134100) (PROMPTPRINT 134102 . 134366) (OPENWINDOWS 134368 . 135152) (\INSUREWINDOW 135154 . 135488)) (
135621 138870 (OVERLAPPINGWINDOWS 135631 . 137913) (WOVERLAPP 137915 . 138170) (ORDERFROMBOTTOMTOTOP
138172 . 138868)) (138919 143702 (\ONSCREENW 138929 . 139635) (\PUTONSCREENW 139637 . 140464) (
\UPDATECACHEDFIELDS 140466 . 140730) (\WWCHANGESCREENSIZE 140732 . 142121) (CREATEWFROMIMAGE 142123 .
143086) (UPDATEWFROMIMAGE 143088 . 143700)) (144259 200061 (\MEDW.CREATEW 144269 . 148943) (
\MEDW.OPENW 148945 . 151303) (\MEDW.CLOSEW 151305 . 152671) (\MEDW.MOVEW 152673 . 163285) (
\MEDW.RELMOVEW 163287 . 163666) (\MEDW.SHRINKW 163668 . 171852) (\MEDW.EXPANDW 171854 . 174121) (
\MEDW.SHAPEW 174123 . 178729) (\MEDW.REDISPLAYW 178731 . 180686) (\MEDW.BURYW 180688 . 181970) (
\MEDW.TOTOPW 181972 . 183320) (\MEDW.DSPCREATE 183322 . 185764) (\GENERIC.DSPCREATE 185766 . 189230) (
\MEDW.GETWINDOWPROP 189232 . 191470) (\MEDW.PUTWINDOWPROP 191472 . 198257) (\MEDW.CURSOR 198259 .
200059)) (200062 200682 (\GENERIC.CURSOR 200072 . 200680)))))
(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)))))
STOP

BIN
sources/WINDOW.LCOM
View File

Binary file not shown.

38
sources/XCCS
View File

@@ -1,10 +1,10 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "24-Jun-2021 23:15:05" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;36 13925
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 1-Aug-2021 23:16:58" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;37 13678
changes to%: (VARS XCCSCOMS)
changes to%: (FNS \CREATE.XCCS.EXTERNALFORMAT)
previous date%: "24-Jun-2021 16:47:37"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;35)
previous date%: "24-Jun-2021 23:15:05"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;36)
(PRETTYCOMPRINT XCCSCOMS)
@@ -210,19 +210,19 @@
(DEFINEQ
(\CREATE.XCCS.EXTERNALFORMAT
[LAMBDA NIL (* ; "Edited 24-Jun-2021 16:45 by rmk:")
[LAMBDA (NAME EOL) (* ; "Edited 1-Aug-2021 23:13 by rmk:")
(* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here")
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT
NAME _ :XCCS
INCCODEFN _ (FUNCTION \XCCSINCCODE)
PEEKCCODEFN _ (FUNCTION \XCCSPEEKCCODE)
BACKCCODEFN _ (FUNCTION \XCCSBACKCCODE)
OUTCHARFN _ (FUNCTION \XCCSOUTCHAR)
FORMATBYTESTREAMFN _ (FUNCTION \XCCSFORMATBYTESTREAM)
EOL _ LF.EOLC
EOLVALID _ NIL])
(CL:UNLESS NAME (SETQ NAME :XCCS))
(CL:UNLESS EOL
(SETQ EOL 'LF))
(MAKE-EXTERNALFORMAT NAME (FUNCTION \XCCSINCCODE)
(FUNCTION \XCCSPEEKCCODE)
(FUNCTION \XCCSBACKCCODE)
(FUNCTION \XCCSOUTCHAR)
(FUNCTION \XCCSFORMATBYTESTREAM)
EOL])
)
(DEFINEQ
@@ -290,8 +290,8 @@
(\CREATE.XCCS.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1292 1521 (ACCESS-CHARSET 1302 . 1519)) (1522 10652 (\XCCSINCCODE 1532 . 4344) (
\XCCSPEEKCCODE 4346 . 6882) (\XCCSOUTCHAR 6884 . 9422) (\XCCSBACKCCODE 9424 . 10323) (
\XCCSFORMATBYTESTREAM 10325 . 10650)) (10653 11497 (\CREATE.XCCS.EXTERNALFORMAT 10663 . 11495)) (11498
12329 (\NSIN.24BITENCODING.ERROR 11508 . 12327)))))
(FILEMAP (NIL (1333 1562 (ACCESS-CHARSET 1343 . 1560)) (1563 10693 (\XCCSINCCODE 1573 . 4385) (
\XCCSPEEKCCODE 4387 . 6923) (\XCCSOUTCHAR 6925 . 9463) (\XCCSBACKCCODE 9465 . 10364) (
\XCCSFORMATBYTESTREAM 10366 . 10691)) (10694 11250 (\CREATE.XCCS.EXTERNALFORMAT 10704 . 11248)) (11251
12082 (\NSIN.24BITENCODING.ERROR 11261 . 12080)))))
STOP

BIN
sources/XCCS.LCOM
View File

Binary file not shown.