github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-10 10:30:13 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into PDFSTREAM

Browse Source
This commit is contained in:
rmkaplan
2023-07-19 14:57:50 -07:00
committed by GitHub
parent ebff4f7268 feff0cefc0
commit b0aa518a41
123 changed files with 3362 additions and 2305 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2539
sources/ADISPLAY
View File

File diff suppressed because it is too large Load Diff

BIN
sources/ADISPLAY.LCOM
View File

Binary file not shown.

40
sources/AOFD
View File

@@ -1,14 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-May-2023 21:39:26" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;2 36068
(FILECREATED "17-May-2023 08:29:55" {DSK}<home>larry>il>medley>sources>AOFD.;5 36263
:EDIT-BY "lmm"
:CHANGES-TO (VARS AOFDCOMS)
(FNS CLOSEF)
:PREVIOUS-DATE "29-Apr-2023 05:38:34"
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;1)
:PREVIOUS-DATE "17-May-2023 08:05:56" {DSK}<home>larry>il>medley>sources>AOFD.;4)
(PRETTYCOMPRINT AOFDCOMS)
@@ -475,8 +471,14 @@
(fetch EOFFSET of STREAM])
(\BASEBYTES.OPENFN
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 17-Jan-87 16:08 by bvm:")
(if (fetch FULLFILENAME of NAME)
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 8-May-2023 14:05 by rmk")
(* ; "Edited 17-Jan-87 16:08 by bvm:")
(if (STREAMP NAME)
then (CL:UNLESS (\IOMODEP NAME ACCESS T)
(\SETACCESS NAME ACCESS))
(\SETFILEPTR NAME 0)
NAME
elseif (fetch FULLFILENAME of NAME)
then (OPENSTRINGSTREAM NAME ACCESS)
else (\MAKEBASEBYTESTREAM (fetch CBUFPTR of NAME)
(fetch BIASOFFST of NAME)
@@ -759,15 +761,15 @@
(ADDTOVAR LAMA WHENCLOSE)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2464 3583 (\ADD-OPEN-STREAM 2474 . 2755) (\GENERIC-UNREGISTER-STREAM 2757 . 3581)) (
3624 10688 (CLOSEALL 3634 . 4112) (CLOSEF 4114 . 5328) (EOFCLOSEF 5330 . 5630) (INPUT 5632 . 6402) (
OPENP 6404 . 6807) (OUTPUT 6809 . 7581) (POSITION 7583 . 8391) (RANDACCESSP 8393 . 8783) (\IOMODEP
8785 . 9414) (WHENCLOSE 9416 . 10686)) (10689 10811 (STREAMADDPROP 10699 . 10809)) (11769 24326 (
\BASEBYTES.IO.INIT 11779 . 14979) (\MAKEBASEBYTESTREAM 14981 . 17909) (\MBS.OUTCHARFN 17911 . 18311) (
\BASEBYTES.NAME.FROM.STREAM 18313 . 18772) (\BASEBYTES.BOUT 18774 . 19528) (\BASEBYTES.SETFILEPTR
19530 . 20151) (\BASEBYTES.READP 20153 . 20797) (\BASEBYTES.BIN 20799 . 21306) (\BASEBYTES.PEEKBIN
21308 . 22138) (\BASEBYTES.TRUNCATEFN 22140 . 22648) (\BASEBYTES.OPENFN 22650 . 23148) (
\BASEBYTES.BLOCKIO 23150 . 24324)) (24449 27753 (OPENSTRINGSTREAM 24459 . 26168) (MAKE-STRING-FORMAT
26170 . 27751)) (28025 32333 (\STRINGSTREAM.INIT 28035 . 32331)) (32410 35110 (GETSTREAM 32420 . 32651
) (\CLEAROFD 32653 . 32946) (\GETSTREAM 32948 . 35108)))))
(FILEMAP (NIL (2363 3482 (\ADD-OPEN-STREAM 2373 . 2654) (\GENERIC-UNREGISTER-STREAM 2656 . 3480)) (
3523 10587 (CLOSEALL 3533 . 4011) (CLOSEF 4013 . 5227) (EOFCLOSEF 5229 . 5529) (INPUT 5531 . 6301) (
OPENP 6303 . 6706) (OUTPUT 6708 . 7480) (POSITION 7482 . 8290) (RANDACCESSP 8292 . 8682) (\IOMODEP
8684 . 9313) (WHENCLOSE 9315 . 10585)) (10588 10710 (STREAMADDPROP 10598 . 10708)) (11668 24521 (
\BASEBYTES.IO.INIT 11678 . 14878) (\MAKEBASEBYTESTREAM 14880 . 17808) (\MBS.OUTCHARFN 17810 . 18210) (
\BASEBYTES.NAME.FROM.STREAM 18212 . 18671) (\BASEBYTES.BOUT 18673 . 19427) (\BASEBYTES.SETFILEPTR
19429 . 20050) (\BASEBYTES.READP 20052 . 20696) (\BASEBYTES.BIN 20698 . 21205) (\BASEBYTES.PEEKBIN
21207 . 22037) (\BASEBYTES.TRUNCATEFN 22039 . 22547) (\BASEBYTES.OPENFN 22549 . 23343) (
\BASEBYTES.BLOCKIO 23345 . 24519)) (24644 27948 (OPENSTRINGSTREAM 24654 . 26363) (MAKE-STRING-FORMAT
26365 . 27946)) (28220 32528 (\STRINGSTREAM.INIT 28230 . 32526)) (32605 35305 (GETSTREAM 32615 . 32846
) (\CLEAROFD 32848 . 33141) (\GETSTREAM 33143 . 35303)))))
STOP

BIN
sources/AOFD.LCOM
View File

Binary file not shown.

90
sources/CMLPATHNAME
View File

@@ -1,17 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Apr-2022 20:29:09" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLPATHNAME.;3 32421
(FILECREATED " 1-May-2023 07:12:28" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;5 30540
:CHANGES-TO (VARS CMLPATHNAMECOMS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "14-Jan-2022 11:40:58"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLPATHNAME.;2)
:CHANGES-TO (FNS PATHNAME)
:PREVIOUS-DATE "30-Apr-2023 14:00:37" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;4)
(* ; "
Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLPATHNAMECOMS)
@@ -213,8 +209,13 @@ Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation.
(DEFINEQ
(PATHNAME
(CL:LAMBDA (THING) (* hdj " 2-Apr-86 11:01") (* ;; "Turns Thing into a pathname. Thing may be a string, symbol, stream, or pathname.") (CL:VALUES (CL:PARSE-NAMESTRING THING)))
)
(CL:LAMBDA (THING) (* ; "Edited 1-May-2023 07:04 by lmm")
(* hdj " 2-Apr-86 11:01")
(* ;; "Turns Thing into a pathname. Thing may be a string, symbol, stream, or pathname.")
[CL:CHECK-TYPE THING (OR STRING STREAM PATHNAME (AND CL:SYMBOL (NOT NULL]
(CL:VALUES (CL:PARSE-NAMESTRING THING))))
(CL:MERGE-PATHNAMES
(CL:LAMBDA (PATHNAME &OPTIONAL (DEFAULTS *DEFAULT-PATHNAME-DEFAULTS*) (DEFAULT-VERSION :NEWEST CL::VERSION-SPECIFIED-P)) (* ; "Edited 21-Aug-90 17:12 by nm") (* ;;; "Merge-Pathnames -- Public Returns a new pathname whose fields are the same as the fields in PATHNAME except that NIL fields are filled in from defaults. Type and Version field are only done if name field has to be done (see manual for explanation). Fills in unspecified slots of Pathname from Defaults (defaults to *default-pathname-defaults*). If the version remains unspecified, gets it from Default-Version.") (LET* ((PATH (PATHNAME PATHNAME)) (DEFAULT-PATH (PATHNAME DEFAULTS)) (HOST (OR (%%PATHNAME-HOST PATH) (%%PATHNAME-HOST DEFAULT-PATH))) (NAME (%%PATHNAME-NAME PATH)) (DEVICE (%%PATHNAME-DEVICE PATH)) (DIR (%%PATHNAME-DIRECTORY PATH)) (DEFAULT-DIR (%%PATHNAME-DIRECTORY DEFAULT-PATH)) DIREND DEFAULT-TYPE) (%%MAKE-PATHNAME HOST (OR DEVICE (%%PATHNAME-DEVICE DEFAULT-PATH)) (OR (AND DIR DEFAULT-DIR (CASE (%%DIRECTORY-COMPONENT-TYPE DIR) (:SUBDIRECTORY (CASE (SETQ DEFAULT-TYPE (%%DIRECTORY-COMPONENT-TYPE DEFAULT-DIR)) (:SUBDIRECTORY (* ; "Default is also a subdirectory, so explicit subdir overrides it") DIR) (T (* ; "Default is a full directory or a relative directory. Make sure to keep the type of the directory being same as the default one.") (CL:IF (EQ (%%DIRECTORY-COMPONENT-PATH DEFAULT-DIR) :WILD) (%%MAKE-DIRECTORY-COMPONENT :TYPE :RELATIVE :PATH (%%DIRECTORY-COMPONENT-PATH DIR)) (%%MAKE-DIRECTORY-COMPONENT :TYPE DEFAULT-TYPE :PATH (CL:CONCATENATE (QUOTE STRING) (%%DIRECTORY-COMPONENT-PATH DEFAULT-DIR) (CL:SECOND \FILENAME.SYNTAX) (%%DIRECTORY-COMPONENT-PATH DIR))))))) (T (CL:IF (NOT (EQ (%%DIRECTORY-COMPONENT-PATH DIR) :WILD)) DIR DEFAULT-DIR)))) DIR DEFAULT-DIR) (OR NAME (%%PATHNAME-NAME DEFAULT-PATH)) (OR (%%PATHNAME-TYPE PATH) (%%PATHNAME-TYPE DEFAULT-PATH)) (OR (%%PATHNAME-VERSION PATH) (CL:IF NAME (CL:IF CL::VERSION-SPECIFIED-P DEFAULT-VERSION :NEWEST) (OR (%%PATHNAME-VERSION DEFAULT-PATH) (CL:IF CL::VERSION-SPECIFIED-P DEFAULT-VERSION :NEWEST)))))))
@@ -502,61 +503,18 @@ Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation.
(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES PATHNAME
%%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME)
)
(PRETTYCOMPRINT CMLPATHNAMECOMS)
(RPAQQ CMLPATHNAMECOMS
[
(* ;; "Common Lisp pathname functions")
(PROP FILETYPE CMLPATHNAME)
(COMS
(* ;; "useful macros")
(FUNCTIONS %%WILD-NAME %%COMPONENT-STRING))
(STRUCTURES PATHNAME DIRECTORY-COMPONENT)
(FNS %%PRINT-PATHNAME CL:MAKE-PATHNAME %%PRINT-DIRECTORY-COMPONENT)
(FUNCTIONS CL:PATHNAME-HOST CL:PATHNAME-DEVICE CL:PATHNAME-DIRECTORY CL:PATHNAME-NAME
CL:PATHNAME-TYPE CL:PATHNAME-VERSION)
(FNS PATHNAME CL:MERGE-PATHNAMES FILE-NAME CL:HOST-NAMESTRING CL:ENOUGH-NAMESTRING
%%NUMERIC-STRING-P)
(FUNCTIONS CL:NAMESTRING CL:PARSE-NAMESTRING CL:TRUENAME)
(FUNCTIONS %%MAKE-PATHNAME)
(FUNCTIONS %%PATHNAME-EQUAL %%DIRECTORY-COMPONENT-EQUAL)
(FUNCTIONS %%INITIALIZE-DEFAULT-PATHNAME)
(VARIABLES *DEFAULT-PATHNAME-DEFAULTS*)
(COMS
(* ;; "Interlisp-D compatibility")
(FUNCTIONS INTERLISP-NAMESTRING UNPACKPATHNAME.STRING))
(FUNCTIONS CL:FILE-NAMESTRING CL:DIRECTORY-NAMESTRING)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (%%INITIALIZE-DEFAULT-PATHNAME)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA
CL:ENOUGH-NAMESTRING
CL:MERGE-PATHNAMES
CL:MAKE-PATHNAME])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME)
)
(PUTPROPS CMLPATHNAME COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2107 2238 (%%WILD-NAME 2107 . 2238)) (2240 2319 (%%COMPONENT-STRING 2240 . 2319)) (2924
8695 (%%PRINT-PATHNAME 2934 . 3095) (CL:MAKE-PATHNAME 3097 . 7847) (%%PRINT-DIRECTORY-COMPONENT 7849
. 8693)) (8697 8890 (CL:PATHNAME-HOST 8697 . 8890)) (8892 9091 (CL:PATHNAME-DEVICE 8892 . 9091)) (
9093 9301 (CL:PATHNAME-DIRECTORY 9093 . 9301)) (9303 9496 (CL:PATHNAME-NAME 9303 . 9496)) (9498 9691 (
CL:PATHNAME-TYPE 9498 . 9691)) (9693 9895 (CL:PATHNAME-VERSION 9693 . 9895)) (9896 15220 (PATHNAME
9906 . 10098) (CL:MERGE-PATHNAMES 10100 . 12186) (FILE-NAME 12188 . 12329) (CL:HOST-NAMESTRING 12331
. 12520) (CL:ENOUGH-NAMESTRING 12522 . 14987) (%%NUMERIC-STRING-P 14989 . 15218)) (15222 18975 (
CL:NAMESTRING 15222 . 18975)) (18977 22448 (CL:PARSE-NAMESTRING 18977 . 22448)) (22450 23453 (
CL:TRUENAME 22450 . 23453)) (23455 23647 (%%MAKE-PATHNAME 23455 . 23647)) (23649 24286 (
%%PATHNAME-EQUAL 23649 . 24286)) (24288 24745 (%%DIRECTORY-COMPONENT-EQUAL 24288 . 24745)) (24747
25370 (%%INITIALIZE-DEFAULT-PATHNAME 24747 . 25370)) (25460 25627 (INTERLISP-NAMESTRING 25460 . 25627)
) (25629 28522 (UNPACKPATHNAME.STRING 25629 . 28522)) (28524 29781 (CL:FILE-NAMESTRING 28524 . 29781))
(29783 29981 (CL:DIRECTORY-NAMESTRING 29783 . 29981)))))
(FILEMAP (NIL (2012 2143 (%%WILD-NAME 2012 . 2143)) (2145 2224 (%%COMPONENT-STRING 2145 . 2224)) (2829
8600 (%%PRINT-PATHNAME 2839 . 3000) (CL:MAKE-PATHNAME 3002 . 7752) (%%PRINT-DIRECTORY-COMPONENT 7754
. 8598)) (8602 8795 (CL:PATHNAME-HOST 8602 . 8795)) (8797 8996 (CL:PATHNAME-DEVICE 8797 . 8996)) (
8998 9206 (CL:PATHNAME-DIRECTORY 8998 . 9206)) (9208 9401 (CL:PATHNAME-NAME 9208 . 9401)) (9403 9596 (
CL:PATHNAME-TYPE 9403 . 9596)) (9598 9800 (CL:PATHNAME-VERSION 9598 . 9800)) (9801 15390 (PATHNAME
9811 . 10268) (CL:MERGE-PATHNAMES 10270 . 12356) (FILE-NAME 12358 . 12499) (CL:HOST-NAMESTRING 12501
. 12690) (CL:ENOUGH-NAMESTRING 12692 . 15157) (%%NUMERIC-STRING-P 15159 . 15388)) (15392 19145 (
CL:NAMESTRING 15392 . 19145)) (19147 22618 (CL:PARSE-NAMESTRING 19147 . 22618)) (22620 23623 (
CL:TRUENAME 22620 . 23623)) (23625 23817 (%%MAKE-PATHNAME 23625 . 23817)) (23819 24456 (
%%PATHNAME-EQUAL 23819 . 24456)) (24458 24915 (%%DIRECTORY-COMPONENT-EQUAL 24458 . 24915)) (24917
25540 (%%INITIALIZE-DEFAULT-PATHNAME 24917 . 25540)) (25630 25797 (INTERLISP-NAMESTRING 25630 . 25797)
) (25799 28692 (UNPACKPATHNAME.STRING 25799 . 28692)) (28694 29951 (CL:FILE-NAMESTRING 28694 . 29951))
(29953 30151 (CL:DIRECTORY-NAMESTRING 29953 . 30151)))))
STOP

BIN
sources/CMLPATHNAME.LCOM
View File

Binary file not shown.

19
sources/FASL-SUPPORT
View File

@@ -1,21 +1,21 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "FASL")
(IL:FILECREATED "16-May-90 17:37:00" IL:|{DSK}<usr>local>lde>lispcore>sources>FASL-SUPPORT.;2| 1408
(DEFINE-FILE-INFO PACKAGE "FASL" READTABLE "XCL" BASE 10)
IL:|changes| IL:|to:| (IL:VARS IL:FASL-SUPPORTCOMS)
(IL:FILECREATED "29-Apr-2023 17:09:01" IL:|{DSK}<home>larry>il>medley>sources>FASL-SUPPORT.;2| 1257
IL:|previous| IL:|date:| "15-Dec-86 16:23:56"
IL:|{DSK}<usr>local>lde>lispcore>sources>FASL-SUPPORT.;1|)
:EDIT-BY "lmm"
:CHANGES-TO (IL:VARS IL:FASL-SUPPORTCOMS)
:PREVIOUS-DATE "16-May-90 17:37:00" IL:|{DSK}<home>larry>il>medley>sources>FASL-SUPPORT.;1|)
; Copyright (c) 1986, 1990 by Venue & Xerox Corporation. All rights reserved.
(IL:PRETTYCOMPRINT IL:FASL-SUPPORTCOMS)
(IL:RPAQQ IL:FASL-SUPPORTCOMS
(
(IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP")
(IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP")
(IL:P (OR (GET 'IL:ABC 'IL:FILEDATES)
(IL:P (OR (GET 'IL:SYSEDIT 'IL:FILEDATES)
(IL:FILESLOAD (IMPORT)
IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC)))
(IL:DEFINE-TYPES FASL-OPS)
@@ -27,7 +27,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>FASL-SUPPORT.;1|)
(IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP")
(OR (GET 'IL:ABC 'IL:FILEDATES)
(OR (GET 'IL:SYSEDIT 'IL:FILEDATES)
(IL:FILESLOAD (IMPORT)
IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC))
@@ -36,7 +36,6 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>FASL-SUPPORT.;1|)
(IL:PUTPROPS IL:FASL-SUPPORT IL:FILETYPE COMPILE-FILE)
(IL:PUTPROPS IL:FASL-SUPPORT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "FASL"))
(IL:PUTPROPS IL:FASL-SUPPORT IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1990))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL)))
IL:STOP

34
sources/FASL-SUPPORT.LCOM
View File

@@ -1 +1,33 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "FASL") (IL:FILECREATED "25-Jan-98 13:21:54" ("compiled on " IL:|{DSK}<lispcore>sources>FASL-SUPPORT.;1|) "30-Mar-95 20:33:04" IL:|bcompl'd| IL:|in| "Medley 14-Aug-95 ..." IL:|dated| "14-Aug-95 15:27:48") (IL:FILECREATED "16-May-90 17:37:00" IL:|{DSK}<usr>local>lde>lispcore>sources>FASL-SUPPORT.;2| 1408 IL:|changes| IL:|to:| (IL:VARS IL:FASL-SUPPORTCOMS) IL:|previous| IL:|date:| "15-Dec-86 16:23:56" IL:|{DSK}<usr>local>lde>lispcore>sources>FASL-SUPPORT.;1|) (IL:PRETTYCOMPRINT IL:FASL-SUPPORTCOMS) (IL:RPAQQ IL:FASL-SUPPORTCOMS ((IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") (IL:P (OR ( GET (QUOTE IL:ABC) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC))) (IL:DEFINE-TYPES FASL-OPS) (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT) IL:FASL-SUPPORT))) (OR (GET (QUOTE IL:ABC) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY IL:MODARITH IL:LLGC)) (XCL:DEF-DEFINE-TYPE FASL-OPS "FASL file opcodes") (IL:PUTPROPS IL:FASL-SUPPORT IL:FILETYPE COMPILE-FILE) (IL:PUTPROPS IL:FASL-SUPPORT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "FASL")) (IL:PUTPROPS IL:FASL-SUPPORT IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1990)) NIL
(DEFINE-FILE-INFO PACKAGE "FASL" READTABLE "XCL" BASE 10)
(IL:FILECREATED "29-Apr-2023 17:09:08" ("compiled on "
IL:|{DSK}<home>larry>il>medley>sources>FASL-SUPPORT.;2|) "27-Apr-2023 05:47:56" "COMPILE-FILEd" IL:|in|
"Welcome to Fuller sysout 27-Apr-2023 ..." IL:|dated| "27-Apr-2023 05:53:17")
(IL:FILECREATED "29-Apr-2023 17:09:01" IL:|{DSK}<home>larry>il>medley>sources>FASL-SUPPORT.;2| 1257
:EDIT-BY "lmm" :CHANGES-TO (IL:VARS IL:FASL-SUPPORTCOMS) :PREVIOUS-DATE "16-May-90 17:37:00"
IL:|{DSK}<home>larry>il>medley>sources>FASL-SUPPORT.;1|)
(IL:RPAQQ IL:FASL-SUPPORTCOMS ((IL:* IL:|;;| "Needed for compiling FASLOAD and FASDUMP") (IL:P (OR (
GET (QUOTE IL:SYSEDIT) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR IL:ADISPLAY
IL:MODARITH IL:LLGC))) (IL:DEFINE-TYPES FASL-OPS) (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
IL:FASL-SUPPORT)))
(OR (GET (QUOTE IL:SYSEDIT) (QUOTE IL:FILEDATES)) (IL:FILESLOAD (IMPORT) IL:LLBASIC IL:LLCHAR
IL:ADISPLAY IL:MODARITH IL:LLGC))
(IL:SET-DOCUMENTATION (QUOTE FASL-OPS) (QUOTE IL:DEFINE-TYPES) (QUOTE "FASL file opcodes"))
(IL:SETQ IL:PRETTYDEFMACROS (ADJOIN (QUOTE (FASL-OPS XCL::X (IL:P IL:* (
XCL::%DEFINE-TYPE-FILE-DEFINITIONS (QUOTE FASL-OPS) (QUOTE XCL::X))))) IL:PRETTYDEFMACROS :TEST (QUOTE
EQUAL)))
(IL:SETQ IL:PRETTYTYPELST (ADJOIN (QUOTE (CHANGEDFASL-OPSLST FASL-OPS "FASL file opcodes"))
IL:PRETTYTYPELST :TEST (QUOTE EQUAL)))
(PROCLAIM (QUOTE (XCL:GLOBAL CHANGEDFASL-OPSLST)))
(OR (BOUNDP (QUOTE CHANGEDFASL-OPSLST)) (SETQ CHANGEDFASL-OPSLST NIL))
(COND ((NOT (GETHASH (QUOTE FASL-OPS) XCL:*DEFINITION-HASH-TABLE*)) (CL::PUTHASH (QUOTE FASL-OPS)
XCL:*DEFINITION-HASH-TABLE* (MAKE-HASH-TABLE :TEST (QUOTE EQUAL) :SIZE 50 :REHASH-SIZE 50))))
(IL:SETQ IL:FILEPKGTYPES (ADJOIN (QUOTE FASL-OPS) IL:FILEPKGTYPES))
(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:GETDEF) (QUOTE XCL::%DEFINE-TYPE-GETDEF))
(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:DELDEF) (QUOTE XCL::%DEFINE-TYPE-DELDEF))
(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:PUTDEF) (QUOTE XCL::%DEFINE-TYPE-PUTDEF))
(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:FILEGETDEF) (QUOTE XCL::%DEFINE-TYPE-FILEGETDEF))
(IL:PUTPROP (QUOTE FASL-OPS) (QUOTE IL:FILEPKGCONTENTS) (QUOTE IL:NILL))
(IL:PUTPROPS IL:FASL-SUPPORT IL:FILETYPE COMPILE-FILE)
(IL:PUTPROPS IL:FASL-SUPPORT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "FASL"))
NIL

137
sources/FILEPKG
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Oct-2022 16:05:09" {WMEDLEY}<sources>FILEPKG.;47 274788
(FILECREATED "18-Jul-2023 23:40:13" {WMEDLEY}<sources>FILEPKG.;50 274539
:CHANGES-TO (FNS EDITCALLERS)
:EDIT-BY rmk
:PREVIOUS-DATE "22-Sep-2022 08:46:29" {WMEDLEY}<sources>FILEPKG.;45)
:CHANGES-TO (FNS GATHEREXPORTS)
:PREVIOUS-DATE "13-Jul-2023 14:56:21" {WMEDLEY}<sources>FILEPKG.;48)
(* ; "
@@ -4300,8 +4302,9 @@ compiling " T)
(DEFINEQ
(FINDCALLERS
[LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36")
(PROG ((X (EDITCALLERS ATOMS FILES T)))
[LAMBDA (ATOMS FILES DEPTH) (* ; "Edited 13-Jul-2023 14:55 by rmk")
(* lmm "30-SEP-78 01:36")
(PROG ((X (EDITCALLERS ATOMS FILES T DEPTH)))
(RETURN (NCONC (DREVERSE (CDR X))
(AND (CAR X)
(LIST (CONS (COND
@@ -4311,7 +4314,9 @@ compiling " T)
(CAR X])
(EDITCALLERS
[LAMBDA (ATOMS FILES COMS)
[LAMBDA (ATOMS FILES COMS DEPTH)
(* ;; "Edited 13-Jul-2023 14:56 by rmk")
(* ;; "Edited 31-Oct-2022 16:04 by rmk")
@@ -4342,7 +4347,7 @@ compiling " T)
((LISTP FILES)
FILES)
((STRPOS "*" FILES) (* ; "Depth 2 for TMAX>TMAX")
(FILDIR FILES 2))
(FILDIR FILES (OR DEPTH 2)))
(T (LIST FILES))) unless (DIRECTORYNAMEP FILE)
do
(RESETLST
@@ -4704,29 +4709,19 @@ compiling " T)
(for FILE in FILES do (IMPORTFILE (CADR FILE])
(GATHEREXPORTS
[LAMBDA (FROMFILES TOFILE FLG) (* ; "Edited 23-Aug-2021 16:40 by rmk:")
(* ;
 "Copies all exported definitions from FROMFILES to TOFILE.")
[LAMBDA (FROMFILES TOFILE FLG) (* ; "Edited 18-Jul-2023 23:39 by rmk")
(* ; "Edited 22-May-2021 00:01 by rmk:")
(* ;; "Use PRETTYDEF so that EXPORTS.ALL is registered with the normal file properties, reader environment, etc.")
(CL:UNLESS FLG (SETQ FLG T))
(SETQ TOFILE (MKATOM TOFILE)) (* ;
 "PRETTYDEF doesn't like strings--why?")
(RESETLST
[RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE)
(SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT]
(RESETSAVE (OUTPUT TOFILE))
(LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*))
(SETQ ENV (if ENV
then (\DO-DEFINE-FILE-INFO TOFILE ENV)
else *OLD-INTERLISP-READ-ENVIRONMENT*))
(WITH-READER-ENVIRONMENT ENV
(PRINT-READER-ENVIRONMENT ENV)
(printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T)
" ON "
(DATE)
"%" T)" T "(LISPXTERPRI T)" T)
(for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T))
(FUNCTION PRINT))
(TERPRI))
(PRINT 'STOP)
(TERPRI)
(FULLNAME TOFILE))))])
[PRETTYDEF NIL TOFILE `((E (MAPC (MKLIST FROMFILES)
(FUNCTION (LAMBDA (F)
(MAPC (IMPORTFILE F FLG)
(FUNCTION PRINT])])
(\DUMPEXPORTS
[NLAMBDA COMS (* bvm%: "24-Oct-86 19:42")
@@ -4866,46 +4861,46 @@ compiling " T)
(PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990
1991 1992 1993 1995 2018 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (18953 20626 (SEARCHPRETTYTYPELST 18963 . 19932) (PRETTYDEFMACROS 19934 . 20370) (
FILEPKGCOMPROPS 20372 . 20624)) (21439 55731 (CLEANUP 21449 . 22839) (COMPILEFILES 22841 . 23117) (
COMPILEFILES0 23119 . 23932) (CONTINUEDIT 23934 . 25311) (MAKEFILE 25313 . 37039) (FILECHANGES 37041
. 39805) (FILEPKG.MERGECHANGES 39807 . 40442) (FILEPKG.CHANGEDFNS 40444 . 40756) (MAKEFILE1 40758 .
44970) (COMPILE-FILE? 44972 . 46559) (MAKEFILES 46561 . 48089) (ADDFILE 48091 . 50634) (ADDFILE0 50636
. 54760) (LISTFILES 54762 . 55729)) (56403 89989 (FILEPKGCHANGES 56413 . 57592) (GETFILEPKGTYPE 57594
. 60544) (MARKASCHANGED 60546 . 62177) (FILECOMS 62179 . 62563) (WHEREIS 62565 . 64094) (
SMASHFILECOMS 64096 . 64324) (FILEFNSLST 64326 . 64492) (FILECOMSLST 64494 . 64980) (UPDATEFILES 64982
. 69480) (INFILECOMS? 69482 . 71325) (INFILECOMTAIL 71327 . 72445) (INFILECOMS 72447 . 72608) (
INFILECOM 72610 . 82628) (INFILECOMSVALS 82630 . 82937) (INFILECOMSVAL 82939 . 83947) (INFILECOMSPROP
83949 . 84742) (IFCPROPS 84744 . 85824) (IFCEXPRTYPE 85826 . 86442) (IFCPROPSCAN 86444 . 87405) (
IFCDECLARE 87407 . 88666) (INFILEPAIRS 88668 . 88967) (INFILECOMSMACRO 88969 . 89987)) (90024 120710 (
FILES? 90034 . 92145) (FILES?1 92147 . 92849) (FILES?PRINTLST 92851 . 93633) (ADDTOFILES? 93635 .
104178) (ADDTOFILE 104180 . 105096) (WHATIS 105098 . 107074) (ADDTOCOMS 107076 . 108614) (ADDTOCOM
108616 . 115103) (ADDTOCOM1 115105 . 116276) (ADDNEWCOM 116278 . 117328) (MAKENEWCOM 117330 . 119177)
(DEFAULTMAKENEWCOM 119179 . 120708)) (120780 123597 (MERGEINSERT 120790 . 123133) (MERGEINSERT1 123135
. 123595)) (123751 125112 (ADDTOFILEKEYLST 123761 . 125110)) (125229 136030 (DELFROMFILES 125239 .
126069) (DELFROMCOMS 126071 . 127750) (DELFROMCOM 127752 . 133517) (DELFROMCOM1 133519 . 134318) (
REMOVEITEM 134320 . 135196) (MOVETOFILE 135198 . 136028)) (136244 138615 (SAVEPUT 136254 . 138613)) (
138740 146983 (UNMARKASCHANGED 138750 . 140234) (PREEDITFN 140236 . 142717) (POSTEDITPROPS 142719 .
145013) (POSTEDITALISTS 145015 . 146981)) (147128 166598 (ALISTS.GETDEF 147138 . 147517) (
ALISTS.WHENCHANGED 147519 . 148165) (CLEARCLISPARRAY 148167 . 149345) (EXPRESSIONS.WHENCHANGED 149347
. 149725) (MAKEALISTCOMS 149727 . 150742) (MAKEFILESCOMS 150744 . 152074) (MAKELISPXMACROSCOMS 152076
. 154094) (MAKEPROPSCOMS 154096 . 154722) (MAKEUSERMACROSCOMS 154724 . 156541) (PROPS.WHENCHANGED
156543 . 157164) (FILEGETDEF.LISPXMACROS 157166 . 158465) (FILEGETDEF.ALISTS 158467 . 159058) (
FILEGETDEF.RECORDS 159060 . 159987) (FILEGETDEF.PROPS 159989 . 160784) (FILEGETDEF.MACROS 160786 .
161668) (FILEGETDEF.VARS 161670 . 162273) (FILEGETDEF.FNS 162275 . 163515) (FILEPKGCOMS.PUTDEF 163517
. 165459) (FILES.PUTDEF 165461 . 166329) (VARS.PUTDEF 166331 . 166474) (FILES.WHENCHANGED 166476 .
166596)) (168620 175851 (RENAME 168630 . 170075) (CHANGECALLERS 170077 . 175849)) (175852 223761 (
SHOWDEF 175862 . 177059) (COPYDEF 177061 . 179809) (GETDEF 179811 . 182354) (GETDEFCOM 182356 . 183322
) (GETDEFCOM0 183324 . 184517) (GETDEFCURRENT 184519 . 190831) (GETDEFERR 190833 . 192103) (
GETDEFFROMFILE 192105 . 196334) (GETDEFSAVED 196336 . 197424) (PUTDEF 197426 . 198133) (EDITDEF 198135
. 199118) (DEFAULT.EDITDEF 199120 . 201958) (EDITDEF.FILES 201960 . 202165) (LOADDEF 202167 . 202343)
(DWIMDEF 202345 . 203199) (DELDEF 203201 . 206095) (DELFROMLIST 206097 . 206601) (HASDEF 206603 .
212840) (GETFILEDEF 212842 . 213354) (SAVEDEF 213356 . 215044) (UNSAVEDEF 215046 . 215942) (
COMPAREDEFS 215944 . 219750) (COMPARE 219752 . 220456) (TYPESOF 220458 . 223759)) (223911 232159 (
FILEPKGCOM 223921 . 228697) (FILEPKGTYPE 228699 . 232157)) (244192 261485 (FINDCALLERS 244202 . 244717
) (EDITCALLERS 244719 . 255369) (EDITFROMFILE 255371 . 260800) (FINDATS 260802 . 261074) (LOOKIN
261076 . 261483)) (261486 263157 (SEPRCASE 261496 . 263155)) (263674 269130 (IMPORTFILE 263684 .
264654) (IMPORTEVAL 264656 . 265542) (IMPORTFILESCAN 265544 . 265957) (CHECKIMPORTS 265959 . 267215) (
GATHEREXPORTS 267217 . 268538) (\DUMPEXPORTS 268540 . 269128)) (269468 271538 (CLEARFILEPKG 269478 .
271536)))))
(FILEMAP (NIL (18975 20648 (SEARCHPRETTYTYPELST 18985 . 19954) (PRETTYDEFMACROS 19956 . 20392) (
FILEPKGCOMPROPS 20394 . 20646)) (21461 55753 (CLEANUP 21471 . 22861) (COMPILEFILES 22863 . 23139) (
COMPILEFILES0 23141 . 23954) (CONTINUEDIT 23956 . 25333) (MAKEFILE 25335 . 37061) (FILECHANGES 37063
. 39827) (FILEPKG.MERGECHANGES 39829 . 40464) (FILEPKG.CHANGEDFNS 40466 . 40778) (MAKEFILE1 40780 .
44992) (COMPILE-FILE? 44994 . 46581) (MAKEFILES 46583 . 48111) (ADDFILE 48113 . 50656) (ADDFILE0 50658
. 54782) (LISTFILES 54784 . 55751)) (56425 90011 (FILEPKGCHANGES 56435 . 57614) (GETFILEPKGTYPE 57616
. 60566) (MARKASCHANGED 60568 . 62199) (FILECOMS 62201 . 62585) (WHEREIS 62587 . 64116) (
SMASHFILECOMS 64118 . 64346) (FILEFNSLST 64348 . 64514) (FILECOMSLST 64516 . 65002) (UPDATEFILES 65004
. 69502) (INFILECOMS? 69504 . 71347) (INFILECOMTAIL 71349 . 72467) (INFILECOMS 72469 . 72630) (
INFILECOM 72632 . 82650) (INFILECOMSVALS 82652 . 82959) (INFILECOMSVAL 82961 . 83969) (INFILECOMSPROP
83971 . 84764) (IFCPROPS 84766 . 85846) (IFCEXPRTYPE 85848 . 86464) (IFCPROPSCAN 86466 . 87427) (
IFCDECLARE 87429 . 88688) (INFILEPAIRS 88690 . 88989) (INFILECOMSMACRO 88991 . 90009)) (90046 120732 (
FILES? 90056 . 92167) (FILES?1 92169 . 92871) (FILES?PRINTLST 92873 . 93655) (ADDTOFILES? 93657 .
104200) (ADDTOFILE 104202 . 105118) (WHATIS 105120 . 107096) (ADDTOCOMS 107098 . 108636) (ADDTOCOM
108638 . 115125) (ADDTOCOM1 115127 . 116298) (ADDNEWCOM 116300 . 117350) (MAKENEWCOM 117352 . 119199)
(DEFAULTMAKENEWCOM 119201 . 120730)) (120802 123619 (MERGEINSERT 120812 . 123155) (MERGEINSERT1 123157
. 123617)) (123773 125134 (ADDTOFILEKEYLST 123783 . 125132)) (125251 136052 (DELFROMFILES 125261 .
126091) (DELFROMCOMS 126093 . 127772) (DELFROMCOM 127774 . 133539) (DELFROMCOM1 133541 . 134340) (
REMOVEITEM 134342 . 135218) (MOVETOFILE 135220 . 136050)) (136266 138637 (SAVEPUT 136276 . 138635)) (
138762 147005 (UNMARKASCHANGED 138772 . 140256) (PREEDITFN 140258 . 142739) (POSTEDITPROPS 142741 .
145035) (POSTEDITALISTS 145037 . 147003)) (147150 166620 (ALISTS.GETDEF 147160 . 147539) (
ALISTS.WHENCHANGED 147541 . 148187) (CLEARCLISPARRAY 148189 . 149367) (EXPRESSIONS.WHENCHANGED 149369
. 149747) (MAKEALISTCOMS 149749 . 150764) (MAKEFILESCOMS 150766 . 152096) (MAKELISPXMACROSCOMS 152098
. 154116) (MAKEPROPSCOMS 154118 . 154744) (MAKEUSERMACROSCOMS 154746 . 156563) (PROPS.WHENCHANGED
156565 . 157186) (FILEGETDEF.LISPXMACROS 157188 . 158487) (FILEGETDEF.ALISTS 158489 . 159080) (
FILEGETDEF.RECORDS 159082 . 160009) (FILEGETDEF.PROPS 160011 . 160806) (FILEGETDEF.MACROS 160808 .
161690) (FILEGETDEF.VARS 161692 . 162295) (FILEGETDEF.FNS 162297 . 163537) (FILEPKGCOMS.PUTDEF 163539
. 165481) (FILES.PUTDEF 165483 . 166351) (VARS.PUTDEF 166353 . 166496) (FILES.WHENCHANGED 166498 .
166618)) (168642 175873 (RENAME 168652 . 170097) (CHANGECALLERS 170099 . 175871)) (175874 223783 (
SHOWDEF 175884 . 177081) (COPYDEF 177083 . 179831) (GETDEF 179833 . 182376) (GETDEFCOM 182378 . 183344
) (GETDEFCOM0 183346 . 184539) (GETDEFCURRENT 184541 . 190853) (GETDEFERR 190855 . 192125) (
GETDEFFROMFILE 192127 . 196356) (GETDEFSAVED 196358 . 197446) (PUTDEF 197448 . 198155) (EDITDEF 198157
. 199140) (DEFAULT.EDITDEF 199142 . 201980) (EDITDEF.FILES 201982 . 202187) (LOADDEF 202189 . 202365)
(DWIMDEF 202367 . 203221) (DELDEF 203223 . 206117) (DELFROMLIST 206119 . 206623) (HASDEF 206625 .
212862) (GETFILEDEF 212864 . 213376) (SAVEDEF 213378 . 215066) (UNSAVEDEF 215068 . 215964) (
COMPAREDEFS 215966 . 219772) (COMPARE 219774 . 220478) (TYPESOF 220480 . 223781)) (223933 232181 (
FILEPKGCOM 223943 . 228719) (FILEPKGTYPE 228721 . 232179)) (244214 261689 (FINDCALLERS 244224 . 244854
) (EDITCALLERS 244856 . 255573) (EDITFROMFILE 255575 . 261004) (FINDATS 261006 . 261278) (LOOKIN
261280 . 261687)) (261690 263361 (SEPRCASE 261700 . 263359)) (263878 268881 (IMPORTFILE 263888 .
264858) (IMPORTEVAL 264860 . 265746) (IMPORTFILESCAN 265748 . 266161) (CHECKIMPORTS 266163 . 267419) (
GATHEREXPORTS 267421 . 268289) (\DUMPEXPORTS 268291 . 268879)) (269219 271289 (CLEARFILEPKG 269229 .
271287)))))
STOP

BIN
sources/FILEPKG.LCOM
View File

Binary file not shown.

18
sources/FILESETS
View File

@@ -1,15 +1,9 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Sep-2022 20:08:31" {DSK}<home>larry>medley>sources>FILESETS.;2 6394
(FILECREATED "23-May-2023 08:11:56" {DSK}<home>larry>il>medley>sources>FILESETS.;24
:EDIT-BY "lmm"
:CHANGES-TO (VARS EXPORTFILES)
:PREVIOUS-DATE "17-Oct-2021 16:06:59" {DSK}<home>larry>medley>sources>FILESETS.;1)
(* ; "
Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
")
:PREVIOUS-DATE " 1-Mar-2023 07:49:03" {DSK}<home>larry>il>medley>sources>FILESETS.;23)
(PRETTYCOMPRINT FILESETSCOMS)
@@ -62,7 +56,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST
CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT))
(RPAQQ 2LISPSET (MACHINEINDEPENDENT POSTLOADUP))
(RPAQQ 2LISPSET (MACHINEINDEPENDENT))
(RPAQQ 3LISPSET (MACROS DLAP BYTECOMPILER COMPILE))
@@ -71,7 +65,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER
IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS
DTDECLARE))
DTDECLARE BIGBITMAPS))
(RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW))
@@ -162,8 +156,6 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
(FPLUS2)
(FTIMES2)
(CREATECELL \CREATECELL)))
(PUTPROPS FILESETS COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990
1998 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

103
sources/LLREAD
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Jul-2022 23:36:54" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLREAD.;102 89980
(FILECREATED "17-Jun-2023 13:12:06" {WMEDLEY}<sources>LLREAD.;104 90176
:CHANGES-TO (FNS PEEKCCODE SKIPSEPRCODES \SUBREAD)
:EDIT-BY rmk
:PREVIOUS-DATE "10-Sep-2021 19:41:58"
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>LLREAD.;101)
:CHANGES-TO (VARS LLREADCOMS CHARACTERNAMES)
:PREVIOUS-DATE "19-Jul-2022 23:36:54" {WMEDLEY}<sources>LLREAD.;102)
(* ; "
@@ -37,7 +37,10 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(COMS (* ; "Reading characters with #\")
(FNS CHARACTER.READ CHARCODE.DECODE)
(FNS HEXNUM? OCTALNUM?)
(VARS CHARACTERNAMES CHARACTERSETNAMES))
(ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs
Newline CR EOL Return Tenexeol Space Sp Linefeed LF)
(CHARACTERSETNAMES Meta Function Greek Cyrillic Hira Hiragana Kata Katakana
Kanji)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * READTYPES)
(MACROS .CALL.SUBREAD. FIXDOT RBCONTEXT PROPRB \RDCONC)
(SPECVARS *READ-NEWLINE-SUPPRESS* \RefillBufferFn)
@@ -1523,38 +1526,38 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
ELSE (RETURN NIL)) FINALLY (RETURN NUM])
)
(RPAQQ CHARACTERNAMES
(("Page" 12)
("Form" 12)
("FF" 12)
("Rubout" 127)
("Del" 127)
("Null" 0)
("Escape" 27)
("Esc" 27)
("Bell" 7)
("Tab" 9)
("Backspace" 8)
("Bs" 8)
("Newline" 13)
("CR" 13)
("EOL" 13)
("Return" 13)
("Tenexeol" 31)
("Space" 32)
("Sp" 32)
("Linefeed" 10)
("LF" 10)))
(ADDTOVAR CHARACTERNAMES
(Page 12)
(Form 12)
(FF 12)
(Rubout 127)
(Del 127)
(Null 0)
(Escape 27)
(Esc 27)
(Bell 7)
(Tab 9)
(Backspace 8)
(Bs 8)
(Newline 13)
(CR 13)
(EOL 13)
(Return 13)
(Tenexeol 31)
(Space 32)
(Sp 32)
(Linefeed 10)
(LF 10))
(RPAQQ CHARACTERSETNAMES (("Meta" 1)
("Function" 2)
("Greek" 38)
("Cyrillic" 39)
("Hira" 36)
("Hiragana" 36)
("Kata" 37)
("Katakana" 37)
("Kanji" 48)))
(ADDTOVAR CHARACTERSETNAMES (Meta 1)
(Function 2)
(Greek 38)
(Cyrillic 39)
(Hira 36)
(Hiragana 36)
(Kata 37)
(Katakana 37)
(Kanji 48))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(RPAQQ READTYPES (READ.RT RATOM.RT NOPROPRB.RT PROPRB.RT))
@@ -1660,17 +1663,17 @@ Copyright (c) 1981-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
(PUTPROPS LLREAD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
1991 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3265 11709 (LASTC 3275 . 3581) (PEEKC 3583 . 3971) (PEEKCCODE 3973 . 4384) (RATOM 4386
. 5467) (READ 5469 . 6029) (READC 6031 . 6672) (READCCODE 6674 . 7433) (READP 7435 . 7987) (
SETREADMACROFLG 7989 . 8288) (SKIPSEPRCODES 8290 . 9370) (SKIPSEPRS 9372 . 9758) (SKREAD 9760 . 11707)
) (11755 20364 (CL:READ 11765 . 12314) (CL:READ-PRESERVING-WHITESPACE 12316 . 13038) (
CL:READ-DELIMITED-LIST 13040 . 13955) (CL:PARSE-INTEGER 13957 . 20362)) (20457 32934 (RSTRING 20467 .
21199) (READ-EXTENDED-TOKEN 21201 . 25073) (\RSTRING2 25075 . 32932)) (32970 63584 (\TOP-LEVEL-READ
32980 . 34963) (\SUBREAD 34965 . 60000) (\SUBREADCONCAT 60002 . 60625) (\ORIG-READ.SYMBOL 60627 .
61695) (\ORIG-INVALID.SYMBOL 61697 . 62596) (\APPLYREADMACRO 62598 . 63014) (INREADMACROP 63016 .
63582)) (63743 63918 (READQUOTE 63753 . 63916)) (63943 75847 (READVBAR 63953 . 65284) (READHASHMACRO
65286 . 71096) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71098 . 71318) (DIGITBASEP 71320 . 72054) (
READNUMBERINBASE 72056 . 73942) (ESTIMATE-DIMENSIONALITY 73944 . 74269) (SKIP.HASH.COMMENT 74271 .
75239) (CMLREAD.FEATURE.PARSER 75241 . 75845)) (75891 82235 (CHARACTER.READ 75901 . 77155) (
CHARCODE.DECODE 77157 . 82233)) (82236 85406 (HEXNUM? 82246 . 84589) (OCTALNUM? 84591 . 85404)))))
(FILEMAP (NIL (3460 11904 (LASTC 3470 . 3776) (PEEKC 3778 . 4166) (PEEKCCODE 4168 . 4579) (RATOM 4581
. 5662) (READ 5664 . 6224) (READC 6226 . 6867) (READCCODE 6869 . 7628) (READP 7630 . 8182) (
SETREADMACROFLG 8184 . 8483) (SKIPSEPRCODES 8485 . 9565) (SKIPSEPRS 9567 . 9953) (SKREAD 9955 . 11902)
) (11950 20559 (CL:READ 11960 . 12509) (CL:READ-PRESERVING-WHITESPACE 12511 . 13233) (
CL:READ-DELIMITED-LIST 13235 . 14150) (CL:PARSE-INTEGER 14152 . 20557)) (20652 33129 (RSTRING 20662 .
21394) (READ-EXTENDED-TOKEN 21396 . 25268) (\RSTRING2 25270 . 33127)) (33165 63779 (\TOP-LEVEL-READ
33175 . 35158) (\SUBREAD 35160 . 60195) (\SUBREADCONCAT 60197 . 60820) (\ORIG-READ.SYMBOL 60822 .
61890) (\ORIG-INVALID.SYMBOL 61892 . 62791) (\APPLYREADMACRO 62793 . 63209) (INREADMACROP 63211 .
63777)) (63938 64113 (READQUOTE 63948 . 64111)) (64138 76042 (READVBAR 64148 . 65479) (READHASHMACRO
65481 . 71291) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71293 . 71513) (DIGITBASEP 71515 . 72249) (
READNUMBERINBASE 72251 . 74137) (ESTIMATE-DIMENSIONALITY 74139 . 74464) (SKIP.HASH.COMMENT 74466 .
75434) (CMLREAD.FEATURE.PARSER 75436 . 76040)) (76086 82430 (CHARACTER.READ 76096 . 77350) (
CHARCODE.DECODE 77352 . 82428)) (82431 85601 (HEXNUM? 82441 . 84784) (OCTALNUM? 84786 . 85599)))))
STOP

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.

19
sources/LOADUP-LISP
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "12-Aug-2022 12:29:57" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;2| 5250
(FILECREATED "27-Feb-2023 17:15:53" |{DSK}<home>larry>il>medley>sources>LOADUP-LISP.;2| 5263
:CHANGES-TO (VARS LOADUP-LISPCOMS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "13-Jul-2022 14:10:00" |{DSK}<home>larry>medley>sources>LOADUP-LISP.;1|)
:CHANGES-TO (FNS LOADUP-LISP)
:PREVIOUS-DATE "12-Aug-2022 12:29:57" |{DSK}<home>larry>il>medley>sources>LOADUP-LISP.;1|)
(PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -17,10 +19,9 @@
(DEFINEQ
(LOADUP-LISP
(LAMBDA NIL (* \; "Edited 13-Jul-2022 14:09 by rmk")
(LAMBDA NIL (* \; "Edited 26-Feb-2023 12:17 by lmm")
(* \; "Edited 13-Jul-2022 14:09 by rmk")
(* \; "Edited 4-Mar-2022 19:13 by larry")
(* \; "Edited 2-Mar-2022 16:31 by larry")
(* \; "Edited 28-Feb-2022 15:02 by larry")
(* \; "Edited 29-Apr-2021 22:30 by rmk:")
(SETQQ COMPILE.EXT LCOM)
(MEDLEY-INIT-VARS) (* \; "should be set earlier")
@@ -99,6 +100,10 @@
(LOADUP '(CMLSMARTARGS))
(LOADUP '(IMPLICIT-KEY-HASH CLOSURE-CACHE))
(* |;;| " not sure what this depends on, so putting it here")
(LOADUP '(BIGBITMAPS))
(* |;;| "Already enabled, but this time fixes tables that weren't defined in the init")
(PACKAGE-ENABLE)
@@ -119,5 +124,5 @@
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (631 5044 (LOADUP-LISP 641 . 5042)))))
(FILEMAP (NIL (654 5057 (LOADUP-LISP 664 . 5055)))))
STOP

BIN
sources/LOADUP-LISP.LCOM
View File

Binary file not shown.

18
sources/MEDLEYDIR
View File

@@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Nov-2022 20:50:20" {DSK}<home>frank>il>medley>wmedley>sources>MEDLEYDIR.;10 10271
(FILECREATED "17-Jul-2023 16:13:10" {DSK}<home>frank>il>medley>gmedley>sources>MEDLEYDIR.;2 9970
:CHANGES-TO (FNS MEDLEY-INIT-VARS)
:CHANGES-TO (VARS MEDLEY-INIT-VARS)
:PREVIOUS-DATE "21-Nov-2022 17:31:30" {DSK}<home>frank>il>medley>wmedley>sources>MEDLEYDIR.;9
:PREVIOUS-DATE "22-Apr-2023 11:53:53" {DSK}<home>frank>il>medley>gmedley>sources>MEDLEYDIR.;1
)
@@ -165,7 +165,7 @@
(RPAQQ MEDLEY-INIT-VARS
[[LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
@@ -190,12 +190,10 @@
(USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
(CONS LOGINHOST/DIR '("INIT"]
RESET)
(XCL::*WHERE-IS-CASH-FILES* (COND ((GETD 'XCL::ADD-WHERE-IS-DATABASE)
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
(NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups"
"WHEREIS.HASH"
NIL T)))
XCL::*WHERE-IS-CASH-FILES*])
(XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups")
"whereis.hash" NIL T))
(LOADUPSDIRECTORIES (MEDLEYDIR '("loadups")
NIL NIL T))))
(DECLARE%: EVAL@COMPILE DOCOPY
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)

BIN
sources/MEDLEYDIR.LCOM
View File

Binary file not shown.

26
sources/SEDIT-LIST-FORMATS
View File

@@ -1,14 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "SEDIT" READTABLE "XCL" BASE 10)
(IL:FILECREATED "17-May-90 11:08:07" IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;2| 9591
IL:|changes| IL:|to:| (IL:FILES IL:SEDIT-INDENT)
(IL:VARS IL:SEDIT-LIST-FORMATSCOMS)
(IL:FILECREATED "17-Jun-2023 19:46:35" IL:|{WMEDLEY}<sources>SEDIT-LIST-FORMATS.;2| 9581
IL:|previous| IL:|date:| "18-Nov-88 10:56:22"
IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
:EDIT-BY IL:|rmk|
:CHANGES-TO (IL:SEDIT-FORMATS IL:SELECTC)
(IL:VARS IL:SEDIT-LIST-FORMATSCOMS)
:PREVIOUS-DATE "17-May-90 11:08:07" IL:|{WMEDLEY}<sources>SEDIT-LIST-FORMATS.;1|)
; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation.
(IL:PRETTYCOMPRINT IL:SEDIT-LIST-FORMATSCOMS)
@@ -19,7 +21,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
(IL:SEDIT-FORMATS RETURN-FROM THROW BLOCK
(IL:* IL:|;;|
 "some handy formats under names we don't expect to find as CAR of form")
 "some handy formats under names we don't expect to find as CAR of form")
:DEFAULT :DATA :BINDING :BINDING-LIST :LAMBDA-LIST :FBINDING :FBINDING-LIST
:COND-CLAUSE :CASE-CLAUSE :HORIZONTAL :HORIZONTAL-NOBREAK :VERTICAL
@@ -36,9 +38,9 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
ECASE ERROR ETYPECASE EVAL-WHEN FLET FORMAT IF IGNORE-ERRORS LABELS LAMBDA
IL:LAMBDA LET LET* LOCALLY LIST LIST* MACROLET MULTIPLE-VALUE-BIND
MULTIPLE-VALUE-SETQ IL:NLAMBDA IL:OPENLAMBDA OR IL:P PROCEED-CASE PROG PROG* PROGN
PROGV RESTART-CASE IL:SELCHARQ IL:SELECTQ TAGBODY THE TYPECASE UNDOABLY UNLESS
UNWIND-PROTECT WHEN WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING WITH-OPEN-FILE
WITH-OPEN-STREAM IL:WITH.MONITOR IL:WITH.FAST.MONITOR IL:WITH.SPY)))
PROGV RESTART-CASE IL:SELCHARQ IL:SELECTQ IL:SELECTC TAGBODY THE TYPECASE UNDOABLY
UNLESS UNWIND-PROTECT WHEN WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING
WITH-OPEN-FILE WITH-OPEN-STREAM IL:WITH.MONITOR IL:WITH.FAST.MONITOR IL:WITH.SPY)))
(IL:PUTPROPS IL:SEDIT-LIST-FORMATS IL:FILETYPE :COMPILE-FILE)
@@ -148,7 +150,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
(DEF-LIST-FORMAT DEFCONSTANT DEFVAR)
(DEF-LIST-FORMAT DEFDEFINER :INDENT ((2)
1)
1)
:ARGS (:KEYWORD :CASE-CLAUSE NIL :LAMBDA-LIST NIL))
(DEF-LIST-FORMAT DEFUN :INDENT ((2))
@@ -309,6 +311,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>SEDIT-LIST-FORMATS.;1|)
:ARGS (:KEYWORD NIL :CASE-CLAUSE)
:LAST NIL)
(DEF-LIST-FORMAT IL:SELECTC IL:SELECTQ)
(DEF-LIST-FORMAT TAGBODY :INDENT (:TAGBODY :STEP 0)
:ARGS (:KEYWORD NIL))

BIN
sources/SEDIT-LIST-FORMATS.DFASL
View File

Binary file not shown.

190
sources/SEDIT-WINDOW
View File

@@ -1,18 +1,19 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL)))
(IL:FILECREATED "14-May-2018 14:12:02" 
IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2| 84658
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT (USE LISP XCL)) READTABLE "XCL" BASE 10)
IL:|changes| IL:|to:| (IL:FNS BUTTONEVENTFN)
(IL:FILECREATED "13-Jul-2023 14:28:53" IL:|{WMEDLEY}<sources>SEDIT-WINDOW.;6| 87869
IL:|previous| IL:|date:| " 2-Apr-92 11:08:50"
IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
:EDIT-BY IL:|rmk|
:CHANGES-TO (IL:FNS BUTTONEVENTFN)
:PREVIOUS-DATE "13-Jul-2023 14:06:39" IL:|{WMEDLEY}<sources>SEDIT-WINDOW.;5|)
; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1992, 2018 by Venue & Xerox Corporation. All rights reserved.
; Copyright (c) 1986-1988, 1990-1992, 2018 by Venue & Xerox Corporation.
(IL:PRETTYCOMPRINT IL:SEDIT-WINDOWCOMS)
(IL:RPAQQ IL:SEDIT-WINDOWCOMS
(IL:RPAQQ IL:SEDIT-WINDOWCOMS
((IL:PROP IL:FILETYPE IL:SEDIT-WINDOW)
(IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-WINDOW)
(IL:LOCALVARS . T)
@@ -36,11 +37,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
SET-SELECTION-NOWHERE SHIFT-DOWN SHOW-CARET SHRINKFN STRING-OFFSET TRACK-EXTEND
TRACK-SELECT UNDERLINE-SELECTION UPDATE-TITLE)))
(IL:PUTPROPS IL:SEDIT-WINDOW IL:FILETYPE :COMPILE-FILE)
(IL:PUTPROPS IL:SEDIT-WINDOW IL:FILETYPE :COMPILE-FILE)
(IL:PUTPROPS IL:SEDIT-WINDOW IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
(DEFPACKAGE IL:SEDIT (:USE IL:LISP
IL:XCL))))
(IL:PUTPROPS IL:SEDIT-WINDOW IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
(DEFPACKAGE IL:SEDIT (:USE IL:LISP IL:XCL
))))
(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY
(IL:LOCALVARS . T)
@@ -58,40 +59,64 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(IL:RPAQQ ICON-TITLE-REGION (5 16 130 24))
(IL:RPAQ TITLED-ICON (IL:CREATE IL:TITLEDICON IL:ICON IL:_ ICON IL:MASK IL:_ ICON-MASK
IL:TITLEREG IL:_ ICON-TITLE-REGION))
(IL:RPAQ TITLED-ICON (IL:CREATE IL:TITLEDICON IL:ICON IL:_ ICON IL:MASK IL:_ ICON-MASK IL:TITLEREG
IL:_ ICON-TITLE-REGION))
(IL:RPAQQ KEEP-WINDOW-REGION T)
(IL:DECLARE\: IL:DONTCOPY
(IL:DECLARE\: IL:EVAL@COMPILE
(IL:PUTPROPS IN-TITLE-BAR IL:MACRO ((WINDOW)
(IL:PUTPROPS IN-TITLE-BAR IL:MACRO ((WINDOW)
(NOT (IL:INSIDEP (IL:DSPCLIPPINGREGION NIL WINDOW)
(IL:LASTMOUSEX WINDOW)
(IL:LASTMOUSEY WINDOW)))))
(IL:PUTPROPS TRACK-BAR-IN-TRACK-SELECT IL:MACRO
(NIL (WHEN (OR (IL:NEQ POINT? (IL:|fetch| POINT-TYPE IL:|of| PENDING-CARET))
(IL:NEQ BAR-X (IL:|fetch| POINT-X IL:|of| PENDING-CARET))
(IL:NEQ BAR-LINE (IL:|fetch| POINT-LINE IL:|of| PENDING-CARET)))
(WHEN POINT?
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X BAR-Y 1 BAR-HEIGHT 'IL:INVERT))
(WHEN (IL:SETQ POINT? (IL:|fetch| POINT-TYPE IL:|of| PENDING-CARET))
(IL:SETQ BAR-X (IL:|fetch| POINT-X IL:|of| PENDING-CARET))
(IL:SETQ BAR-LINE (IL:|fetch| POINT-LINE IL:|of| PENDING-CARET))
(IL:SETQ BAR-HEIGHT (IL:IPLUS (IL:|fetch| LINE-ASCENT IL:|of| BAR-LINE)
(IL:|fetch| LINE-DESCENT IL:|of| BAR-LINE)))
(IL:SETQ BAR-Y (IL:IDIFFERENCE (IL:|fetch| YCOORD IL:|of| BAR-LINE)
(IL:IPLUS (IL:|fetch| LINE-SKIP IL:|of| BAR-LINE)
BAR-HEIGHT)))
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X BAR-Y 1 BAR-HEIGHT 'IL:INVERT)))))
(IL:PUTPROPS TRACK-BAR-IN-TRACK-SELECT IL:MACRO (NIL (WHEN (OR (IL:NEQ POINT? (IL:|fetch| POINT-TYPE
IL:|of|
PENDING-CARET)
)
(IL:NEQ BAR-X (IL:|fetch| POINT-X
IL:|of| PENDING-CARET
))
(IL:NEQ BAR-LINE (IL:|fetch|
POINT-LINE
IL:|of|
PENDING-CARET
)))
(WHEN POINT?
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X
BAR-Y 1 BAR-HEIGHT 'IL:INVERT))
(WHEN (IL:SETQ POINT? (IL:|fetch| POINT-TYPE
IL:|of|
PENDING-CARET
))
(IL:SETQ BAR-X (IL:|fetch| POINT-X
IL:|of| PENDING-CARET)
)
(IL:SETQ BAR-LINE (IL:|fetch| POINT-LINE
IL:|of|
PENDING-CARET
))
(IL:SETQ BAR-HEIGHT
(IL:IPLUS (IL:|fetch| LINE-ASCENT
IL:|of| BAR-LINE)
(IL:|fetch| LINE-DESCENT
IL:|of| BAR-LINE)))
(IL:SETQ BAR-Y
(IL:IDIFFERENCE (IL:|fetch| YCOORD
IL:|of| BAR-LINE)
(IL:IPLUS (IL:|fetch| LINE-SKIP
IL:|of| BAR-LINE)
BAR-HEIGHT)))
(IL:BLTSHADE IL:BLACKSHADE WINDOW BAR-X
BAR-Y 1 BAR-HEIGHT 'IL:INVERT)))))
)
)
(DEFUN SELECT-NODE-SEGMENT (CONTEXT NODE &OPTIONAL (START 1)
END)
END)
(IL:* IL:|;;;| "set the current selection to be a segment under this node")
(IL:* IL:|;;;| "set the current selection to be a segment under this node")
(LET ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT))
(POINT (IL:FETCH CARET-POINT IL:OF CONTEXT)))
@@ -100,7 +125,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(IL:|replace| SELECT-END IL:|of| SELECTION IL:|with| END)
(SELECT-SEGMENT SELECTION CONTEXT NODE)
(IL:* IL:|;;| "set point to be the selection. This should really be done by select-segment but it doesn't because it expects finalization code to be run after it cause it's generally called from the mouse tracking code which finalizes.")
(IL:* IL:|;;| "set point to be the selection. This should really be done by select-segment but it doesn't because it expects finalization code to be run after it cause it's generally called from the mouse tracking code which finalizes.")
(PENDING-DELETE POINT SELECTION)))
(IL:DEFINEQ
@@ -182,9 +207,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(IL:DSPRIGHTMARGIN 64000 DISPLAY-WINDOW))))
(BUTTONEVENTFN
(IL:LAMBDA (WINDOW) (IL:* IL:\; "Edited 23-Apr-2018 09:37 by rmk:")
(IL:LAMBDA (WINDOW) (IL:* IL:\; "Edited 13-Jul-2023 14:27 by rmk")
(IL:* IL:\; "Edited 20-Jun-2023 21:10 by rmk")
(IL:* IL:\; "Edited 17-Jun-2023 19:59 by rmk")
(IL:* IL:\; "Edited 23-Apr-2018 09:37 by rmk:")
(IL:* IL:|;;| "called by the window system whenever the user hits a mouse button in an SEdit window. allows selection and setting the caret point")
(IL:* IL:|;;| "called by the window system whenever the user hits a mouse button in an SEdit window. allows selection and setting the caret point")
(LET* ((CONTEXT (IL:WINDOWPROP WINDOW 'EDIT-CONTEXT))
(LOCK (AND CONTEXT (IL:|fetch| CONTEXT-LOCK IL:|of| CONTEXT)))
@@ -192,12 +220,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(COND
((IL:LASTMOUSESTATE IL:UP)
(IL:* IL:|;;| "oops, no mouse buttons down. what are we doing here?")
(IL:* IL:|;;| "oops, no mouse buttons down. what are we doing here?")
NIL)
((NOT (AND CONTEXT (IL:WINDOWPROP WINDOW 'IL:PROCESS)))
(IL:* IL:|;;| "this context or process is dead. make it a dead SEdit.")
(IL:* IL:|;;| "this context or process is dead. make it a dead SEdit.")
(IL:|printout| (IL:GETPROMPTWINDOW WINDOW)
T "This SEdit is dead.")
@@ -209,21 +237,35 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
((AND (IL:LASTMOUSESTATE IL:RIGHT)
(IN-TITLE-BAR WINDOW))
(IL:* IL:|;;| "right buttoning the title bar or window border gives the default menu of window commands. Not interlocked because want to be able to move window under a break that has the lock.")
(IL:* IL:|;;| "right buttoning the title bar or window border gives the default menu of window commands. Not interlocked because want to be able to move window under a break that has the lock.")
(IL:\\CARET.DOWN)
(IL:DOWINDOWCOM WINDOW))
((AND (NOT (IL:TTY.PROCESSP (IL:WINDOWPROP WINDOW 'IL:PROCESS)))
(NOT SHIFT-DOWN))
(IL:* IL:|;;| "just grab the tty and don't change state")
(IL:* IL:|;;| "just grab the tty and don't change state")
(IL:TOTOPW WINDOW)
(IL:TTY.PROCESS (IL:WINDOWPROP WINDOW 'IL:PROCESS)))
((AND (EQ SHIFT-DOWN 'COPY)
(IL:MOUSESTATE IL:LEFT)
(IN-TITLE-BAR WINDOW))
(IL:* IL:|;;| "RMK: copy-select in the title bar: return the thing being edited. Previous attempt was too immediate, did not conform to usual mouse-up conventions.")
(IL:WHILE (EQ 'COPY (SHIFT-DOWN)))
(IL:GETMOUSESTATE)
(WHEN (IN-TITLE-BAR WINDOW)
(LET ((NAME (IL:LISTGET (IL:WINDOWPROP WINDOW 'TITLE-INFO)
:|name|)))
(WHEN NAME (IL:* IL:\;
 "Not sure about FLG and RDTBL")
(IL:COPYINSERT NAME)))))
((OR (EQ SHIFT-DOWN 'COPY)
(IL:OBTAIN.MONITORLOCK LOCK T))
(IL:* IL:|;;| "at this point we must have the lock, unless we're shift selecting (Copy only: Move and Delete are non-passive operation and must lock)")
(IL:* IL:|;;| "at this point we must have the lock, unless we're shift selecting (Copy only: Move and Delete are non-passive operation and must lock)")
(IL:\\CARET.DOWN)
(IL:TOTOPW WINDOW)
@@ -233,31 +275,27 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(AND (IL:LASTMOUSESTATE IL:LEFT)
(IL:KEYDOWNP 'IL:CTRL))))
(IL:* IL:|;;| "popup help command menu here.")
(IL:* IL:|;;| "popup help command menu here.")
(IL:* IL:|;;| "RMK: CTRL-LEFT = MIDDLE")
(IL:* IL:|;;| "RMK: CTRL-LEFT = MIDDLE")
(HELPMENU CONTEXT))
(T (WITH-PROFILE (IL:|fetch| PROFILE IL:|of| CONTEXT)
(PROG NIL
(CLOSE-OPEN-NODE CONTEXT)
(IL:* IL:|;;| "record that we're busy making a selection in this window, and make sure that variables we use for recording our temporary state are all ready for action. note that these are global vars, and hence all this code is nonrentrant. shouldn't be a problem, since there's only one mouse")
(IL:* IL:|;;| "record that we're busy making a selection in this window, and make sure that variables we use for recording our temporary state are all ready for action. note that these are global vars, and hence all this code is nonrentrant. shouldn't be a problem, since there's only one mouse")
(IL:SETQ SELECTION-PENDING? CONTEXT)
(IL:SETQ PENDING-LAST-X (IL:|fetch| LAST-MOUSE-X IL:|of|
CONTEXT))
(IL:SETQ PENDING-LAST-Y (IL:|fetch| LAST-MOUSE-Y IL:|of|
CONTEXT))
(IL:SETQ PENDING-TYPE (IL:|fetch| LAST-MOUSE-TYPE IL:|of|
CONTEXT))
(IL:SETQ PENDING-LAST-X (IL:|fetch| LAST-MOUSE-X IL:|of| CONTEXT))
(IL:SETQ PENDING-LAST-Y (IL:|fetch| LAST-MOUSE-Y IL:|of| CONTEXT))
(IL:SETQ PENDING-TYPE (IL:|fetch| LAST-MOUSE-TYPE IL:|of| CONTEXT))
(IL:SETQ PENDING-SHIFT SHIFT-DOWN)
(IL:|replace| SELECT-NODE IL:|of| PENDING-SELECTION
IL:|with| NIL)
(IL:|replace| SELECT-NODE IL:|of| PENDING-SELECTION IL:|with| NIL)
(WHEN (NOT PENDING-SHIFT)
(IL:* IL:|;;|
 "if they're setting a new selection take down the main selection")
(IL:* IL:|;;|
 "if they're setting a new selection take down the main selection")
(SELECTION-DOWN CONTEXT))
(IL:SETQ LAST-MOVE-CLOCK NIL)
@@ -268,15 +306,15 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(TRACK-SELECT CONTEXT WINDOW))
(IL:|until| (CHECK-SELECTION-SHIFT CONTEXT T)
IL:|do| (WHEN (NOT (IL:MOUSESTATE IL:UP))
(GO MOUSE-BUTTON-DOWN))
(GO MOUSE-BUTTON-DOWN))
(WHEN (IL:IN/SCROLL/BAR? WINDOW IL:LASTMOUSEX IL:LASTMOUSEY
) (IL:* IL:\;
 "let them scroll while making a selection")
) (IL:* IL:\;
 "let them scroll while making a selection")
(IL:SCROLL.HANDLER WINDOW))
(IL:BLOCK))
(IL:SETQ SELECTION-PENDING? NIL)
(IL:* IL:\;
 "figure out what we should do")
(IL:* IL:\;
 "figure out what we should do")
(FINALIZE-MOUSE-SELECTION CONTEXT WINDOW)))))
(OR (EQ SHIFT-DOWN 'COPY)
(IL:RELEASE.MONITORLOCK LOCK)))))))
@@ -781,22 +819,22 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;1|)
(IL:PUTPROPS IL:SEDIT-WINDOW IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1992
2018))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (9049 9957 (SELECT-NODE-SEGMENT 9049 . 9957)) (9958 84520 (BUILD-WINDOW 9971 . 15811)
(BUTTONEVENTFN 15813 . 21522) (CHECK-SELECTION 21524 . 23564) (CHECK-SELECTION-SHIFT 23566 . 24689) (
CLOSEFN 24691 . 27694) (CONFLICTING-SELECTION? 27696 . 28457) (DISPLAY-SELECTION 28459 . 29486) (
DRAW-HIGHLIGHT 29488 . 30618) (DRAW-OUTLINE 30620 . 31975) (DRAW-UNDERLINE 31977 . 32752) (EXPANDFN
32754 . 33261) (EXPANDREGIONFN 33263 . 33853) (EXTEND-SELECTION 33855 . 36432) (
FINALIZE-MOUSE-SELECTION 36434 . 42980) (FIND-LINE-START 42982 . 43673) (FIND-NODE 43675 . 44950) (
GET-DESTINATION-CONTEXT 44952 . 45504) (GRAY 45506 . 45893) (GROW-CLICK? 45895 . 47880) (
GROW-SELECTION 47882 . 48225) (GROW-SELECTION-DEFAULT 48227 . 48598) (HIGHLIGHT-SELECTION 48600 .
48893) (ICON-COPYFN 48895 . 49239) (LESS-PROMPT-WINDOW 49241 . 49610) (NORMALIZE-SELECTION 49612 .
50978) (OUTLINE-SELECTION 50980 . 52118) (PENDING-DELETE 52120 . 52454) (PLACE-CARET-AND-SELECTION
52456 . 54016) (PUNT-SET-POINT 54018 . 54476) (PUNT-SET-SELECTION 54478 . 54927) (REPAINTFN 54929 .
56207) (RESHAPEFN 56209 . 58547) (SCAN-FOR-BOUNDS 58549 . 61092) (SELECT-NODE 61094 . 61464) (
SELECT-SEGMENT 61466 . 61906) (SELECT-SEGMENT-DEFAULT 61908 . 63935) (SELECTION-DOWN 63937 . 64347) (
SELECTION-UP 64349 . 64775) (SET-POINT 64777 . 65536) (SET-POINT-NOWHERE 65538 . 65797) (
SET-POINT-UNKNOWN 65799 . 66420) (SET-SELECTION 66422 . 66855) (SET-SELECTION-ME 66857 . 67949) (
SET-SELECTION-NOWHERE 67951 . 68149) (SHIFT-DOWN 68151 . 68692) (SHOW-CARET 68694 . 74252) (SHRINKFN
74254 . 76989) (STRING-OFFSET 76991 . 78351) (TRACK-EXTEND 78353 . 80409) (TRACK-SELECT 80411 . 82900)
(UNDERLINE-SELECTION 82902 . 83304) (UPDATE-TITLE 83306 . 84518)))))
(IL:FILEMAP (NIL (11430 12334 (SELECT-NODE-SEGMENT 11430 . 12334)) (12335 87731 (BUILD-WINDOW 12348 .
18188) (BUTTONEVENTFN 18190 . 24733) (CHECK-SELECTION 24735 . 26775) (CHECK-SELECTION-SHIFT 26777 .
27900) (CLOSEFN 27902 . 30905) (CONFLICTING-SELECTION? 30907 . 31668) (DISPLAY-SELECTION 31670 . 32697
) (DRAW-HIGHLIGHT 32699 . 33829) (DRAW-OUTLINE 33831 . 35186) (DRAW-UNDERLINE 35188 . 35963) (EXPANDFN
35965 . 36472) (EXPANDREGIONFN 36474 . 37064) (EXTEND-SELECTION 37066 . 39643) (
FINALIZE-MOUSE-SELECTION 39645 . 46191) (FIND-LINE-START 46193 . 46884) (FIND-NODE 46886 . 48161) (
GET-DESTINATION-CONTEXT 48163 . 48715) (GRAY 48717 . 49104) (GROW-CLICK? 49106 . 51091) (
GROW-SELECTION 51093 . 51436) (GROW-SELECTION-DEFAULT 51438 . 51809) (HIGHLIGHT-SELECTION 51811 .
52104) (ICON-COPYFN 52106 . 52450) (LESS-PROMPT-WINDOW 52452 . 52821) (NORMALIZE-SELECTION 52823 .
54189) (OUTLINE-SELECTION 54191 . 55329) (PENDING-DELETE 55331 . 55665) (PLACE-CARET-AND-SELECTION
55667 . 57227) (PUNT-SET-POINT 57229 . 57687) (PUNT-SET-SELECTION 57689 . 58138) (REPAINTFN 58140 .
59418) (RESHAPEFN 59420 . 61758) (SCAN-FOR-BOUNDS 61760 . 64303) (SELECT-NODE 64305 . 64675) (
SELECT-SEGMENT 64677 . 65117) (SELECT-SEGMENT-DEFAULT 65119 . 67146) (SELECTION-DOWN 67148 . 67558) (
SELECTION-UP 67560 . 67986) (SET-POINT 67988 . 68747) (SET-POINT-NOWHERE 68749 . 69008) (
SET-POINT-UNKNOWN 69010 . 69631) (SET-SELECTION 69633 . 70066) (SET-SELECTION-ME 70068 . 71160) (
SET-SELECTION-NOWHERE 71162 . 71360) (SHIFT-DOWN 71362 . 71903) (SHOW-CARET 71905 . 77463) (SHRINKFN
77465 . 80200) (STRING-OFFSET 80202 . 81562) (TRACK-EXTEND 81564 . 83620) (TRACK-SELECT 83622 . 86111)
(UNDERLINE-SELECTION 86113 . 86515) (UPDATE-TITLE 86517 . 87729)))))
IL:STOP

BIN
sources/SEDIT-WINDOW.DFASL
View File

Binary file not shown.

183
sources/XXGEOM
View File

@@ -1,36 +1,30 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "13-Jun-2021 14:39:29" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XXGEOM.;2 49841
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS XXGEOMCOMS)
(RECORDS XXLINE)
(FNS MAKELINE LINE.LESSP)
(MACROS \GETLINEORIGY \GETLINEDIFFY)
(FILECREATED "14-May-2023 15:47:43" {DSK}<home>larry>il>medley>sources>XXGEOM.;5 48712
previous date%: "19-Jan-93 11:30:54"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XXGEOM.;1)
:EDIT-BY "lmm"
:CHANGES-TO (MACROS GETLINEORIG)
:PREVIOUS-DATE "13-Jun-2021 14:39:29" {DSK}<home>larry>il>medley>sources>XXGEOM.;4)
(* ; "
Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT XXGEOMCOMS)
(RPAQQ XXGEOMCOMS
(
(* ;;; "Integer Geometry Library")
(* ;;; "Integer Geometry Library")
(* ;;; "Scalar methods")
(* ;;; "Scalar methods")
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \SGN))
(FNS \IRND)
(* ;;; "XYpt object and methods")
(* ;;; "XYpt object and methods")
(RECORDS XYPT)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS XYPT.X XYPT.Y))
@@ -39,7 +33,7 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
MMLTLIST IMLTLIST XYPT.LESSP PATH.LESSP CONVEXP)
(* ;;; "Line object and methods")
(* ;;; "Line object and methods")
(RECORDS XXLINE)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETLINEDIFF GETLINEORIG \GETLINEDIFF \GETLINEORIGY
@@ -48,24 +42,24 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(FNS LINEY MIDDX INITX TERMX SCANX XPROD)
(* ;;; "line segment methods")
(* ;;; "line segment methods")
(FNS XYSECTLSEG)
(* ;;; "Bresenham line object and methods")
(* ;;; "Bresenham line object and methods")
(RECORDS BRES)
(FNS MAKEBRES)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS BRESSTEP))
(* ;;; "Debugging control panel")
(* ;;; "Debugging control panel")
(DECLARE%: EVAL@COMPILE DONTCOPY (VARS \GEOM.PANEL))
(* ;;; "Trapezoidal decomposition")
(* ;;; "Trapezoidal decomposition")
(FNS TRAPLOOP TRAPMAKE)
(VARS TRAP.DEBUG)
@@ -84,11 +78,11 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(PUTPROPS \SGN DMACRO ((VAL)
(if (IGREATERP VAL 0)
then 1
elseif (ILESSP VAL 0)
then -1
else 0)))
(if (IGREATERP VAL 0)
then 1
elseif (ILESSP VAL 0)
then -1
else 0)))
)
)
(DEFINEQ
@@ -119,26 +113,26 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(PUTPROPS XYPT.X DMACRO ((PT)
(CAR PT)))
(CAR PT)))
(PUTPROPS XYPT.Y DMACRO ((PT)
(CDR PT)))
(CDR PT)))
)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS HEADPT DMACRO ((PATH)
(CAR PATH)))
(CAR PATH)))
(PUTPROPS NEXTPT DMACRO ((PATH)
(CADR PATH)))
(CADR PATH)))
(PUTPROPS HEADPTY DMACRO ((PATH)
(CDAR PATH)))
(CDAR PATH)))
(PUTPROPS NEXTPTY DMACRO ((PATH)
(CDADR PATH)))
(CDADR PATH)))
)
)
(DEFINEQ
@@ -587,35 +581,30 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(PUTPROPS GETLINEDIFF DMACRO [(SELF DX DY)
(* ;; "External method, get dx, dy from line")
(* ;; "External method, get dx, dy from line")
(WITH LINE SELF (SETQ DX (ffetch (XYPT X) of DIFF))
(SETQ DY (ffetch (XYPT Y) OF DIFF])
(WITH XXLINE SELF (SETQ DX (ffetch (XYPT X) of DIFF))
(SETQ DY (ffetch (XYPT Y) OF DIFF])
(PUTPROPS GETLINEORIG DMACRO [(SELF OX OY)
(* ;; "External method, get dx, dy from line")
(* ;; "External method, get dx, dy from line")
(WITH LINE SELF (SETQ OX (ffetch (XYPT X) of ORIG))
(SETQ OY (ffetch (XYPT Y) OF ORIG])
(WITH XXLINE SELF (SETQ OX (ffetch (XYPT X) of ORIG))
(SETQ OY (ffetch (XYPT Y) OF ORIG])
(PUTPROPS \GETLINEDIFF DMACRO [(SELF DX DY) (* edited " 1-Jan-00 00:00")
(PUTPROPS \GETLINEDIFF DMACRO [(SELF DX DY) (* edited " 1-Jan-00 00:00")
(* ;; "Degenerate private method, get dx, dy from line")
(* ;; "Degenerate private method, get dx, dy from line")
(WITH LINE SELF (SETQ DX (FFETCH (XYPT X) OF
DIFF))
(SETQ DY (FFETCH (XYPT T) OF DIFF])
(WITH XXLINE SELF (SETQ DX (FFETCH (XYPT X) OF DIFF))
(SETQ DY (FFETCH (XYPT T) OF DIFF])
(PUTPROPS \GETLINEORIGY DMACRO [(SELF YPTR)
(SETQ YPTR (FFETCH (XYPT Y) of (FFETCH
(XXLINE ORIG)
of SELF])
(SETQ YPTR (FFETCH (XYPT Y) of (FFETCH (XXLINE ORIG) of SELF])
(PUTPROPS \GETLINEDIFFY DMACRO [(SELF YPTR)
(SETQ YPTR (FFETCH (XYPT Y) of (FFETCH
(XXLINE DIFF)
of SELF])
(SETQ YPTR (FFETCH (XYPT Y) of (FFETCH (XXLINE DIFF) of SELF])
)
)
(DEFINEQ
@@ -990,54 +979,53 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(PUTPROPS BRESSTEP DMACRO ((SELF SCANY INITX TERMX)
(* * Assume that this Y is exactly incremented by one from the last call, so
 DDA can be used. Then passed parameter scany is not used.)
(* * Assume that this Y is exactly incremented by one from the last call, so DDA
 can be used. Then passed parameter scany is not used.)
(* * (WITH BRES SELF (*) (SETQ INITX X)
 (IF (EQ MAJOR (QUOTE X)) THEN (while (ILESSP P 0) do
 (SETQ X (IPLUS X IX)) (SETQ P (IPLUS P IPX)))
 (IF (ILEQ INITX X) THEN (SETQ TERMX X) ELSE
 (SETQ TERMX INITX) (SETQ INITX X)) (SETQ X
 (IPLUS X IX)) (SETQ P (IPLUS P IPY)) ELSE
 (SETQ TERMX X) (if (ILESSP P 0) then (SETQ P
 (IPLUS P IPY)) else (SETQ P (IPLUS P IPX))
 (SETQ X (IPLUS X IX))))))
(* * (WITH BRES SELF (*) (SETQ INITX X) (IF
 (EQ MAJOR (QUOTE X)) THEN (while (ILESSP P 0) do
 (SETQ X (IPLUS X IX)) (SETQ P (IPLUS P IPX)))
 (IF (ILEQ INITX X) THEN (SETQ TERMX X) ELSE
 (SETQ TERMX INITX) (SETQ INITX X)) (SETQ X
 (IPLUS X IX)) (SETQ P (IPLUS P IPY)) ELSE
 (SETQ TERMX X) (if (ILESSP P 0) then (SETQ P
 (IPLUS P IPY)) else (SETQ P (IPLUS P IPX))
 (SETQ X (IPLUS X IX))))))
(LET (X0 DX D DDX DDY)
(LET (X0 DX D DDX DDY)
(* * (WITH BRES SELF (*) (SETQ X0 X) (SETQ DX IX)
 (SETQ D P) (SETQ DDX IPX) (SETQ DDY IPY)))
(* * (WITH BRES SELF (*) (SETQ X0 X) (SETQ DX IX)
 (SETQ D P) (SETQ DDX IPX) (SETQ DDY IPY)))
(SETQ D (FFETCH (BRES P) OF SELF))
(SETQ X0 (FFETCH (BRES X) OF SELF))
(SETQ DX (FFETCH (BRES IX) OF SELF))
(SETQ DDX (FFETCH (BRES IPX) OF SELF))
(SETQ DDY (FFETCH (BRES IPY) OF SELF))
(SETQ D (FFETCH (BRES P) OF SELF))
(SETQ X0 (FFETCH (BRES X) OF SELF))
(SETQ DX (FFETCH (BRES IX) OF SELF))
(SETQ DDX (FFETCH (BRES IPX) OF SELF))
(SETQ DDY (FFETCH (BRES IPY) OF SELF))
(* * Above faster than WITH form * *)
(* * Above faster than WITH form * *)
(SETQ INITX X0)
[IF (EQ (FFETCH (BRES MAJOR) OF SELF)
'X)
THEN (while (ILESSP D 0)
do (SETQ X0 (IPLUS X0 DX))
(SETQ D (IPLUS D DDX)))
(IF (ILEQ INITX X0)
THEN (SETQ TERMX X0)
ELSE (SETQ TERMX INITX)
(SETQ INITX X0))
(SETQ X0 (IPLUS X0 DX))
(SETQ D (IPLUS D DDY))
ELSE (SETQ TERMX X0)
(if (ILESSP D 0)
then (SETQ D (IPLUS D DDY))
else (SETQ D (IPLUS D DDX))
(SETQ X0 (IPLUS X0 DX]
(SETQ INITX X0)
[IF (EQ (FFETCH (BRES MAJOR) OF SELF)
'X)
THEN (while (ILESSP D 0) do (SETQ X0 (IPLUS X0 DX))
(SETQ D (IPLUS D DDX)))
(IF (ILEQ INITX X0)
THEN (SETQ TERMX X0)
ELSE (SETQ TERMX INITX)
(SETQ INITX X0))
(SETQ X0 (IPLUS X0 DX))
(SETQ D (IPLUS D DDY))
ELSE (SETQ TERMX X0)
(if (ILESSP D 0)
then (SETQ D (IPLUS D DDY))
else (SETQ D (IPLUS D DDX))
(SETQ X0 (IPLUS X0 DX]
(* * (WITH BRES SELF (*) (SETQ X X0) (SETQ P D)))
(* * (WITH BRES SELF (*) (SETQ X X0) (SETQ P D)))
(FREPLACE (BRES X) OF SELF with X0)
(FREPLACE (BRES P) OF SELF with D))))
(FREPLACE (BRES X) OF SELF with X0)
(FREPLACE (BRES P) OF SELF with D))))
)
)
@@ -1223,15 +1211,14 @@ Copyright (c) 1985-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
(PRINTOUT MYWIN "CONVEX: " (CONVEXP RLIST)
T])
)
(PUTPROPS XXGEOM COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2461 2894 (\IRND 2471 . 2892)) (3638 23250 (MAKEXYPT 3648 . 3879) (IRNDLIST 3881 . 4485
) (NORMLOOP 4487 . 6115) (SLITLOOP 6117 . 7816) (PREPLOOP 7818 . 8483) (YMAPLIST 8485 . 10046) (
IMAPLIST 10048 . 13607) (UNIQLIST 13609 . 14230) (MERGLIST 14232 . 16879) (MMLTLIST 16881 . 17694) (
IMLTLIST 17696 . 18579) (XYPT.LESSP 18581 . 18950) (PATH.LESSP 18952 . 20278) (CONVEXP 20280 . 23248))
(25235 30477 (MAKELINE 25245 . 25928) (MSECT 25930 . 26399) (XSECT 26401 . 26957) (YSECT 26959 .
27517) (XYSECT 27519 . 28260) (KNOTLINE 28262 . 29186) (KNOTLOOP 29188 . 30064) (LINE.LESSP 30066 .
30475)) (30478 34052 (LINEY 30488 . 30942) (MIDDX 30944 . 31447) (INITX 31449 . 32130) (TERMX 32132 .
32762) (SCANX 32764 . 33548) (XPROD 33550 . 34050)) (34092 35556 (XYSECTLSEG 34102 . 35554)) (36000
38555 (MAKEBRES 36010 . 38553)) (42116 48478 (TRAPLOOP 42126 . 44868) (TRAPMAKE 44870 . 48476)))))
(FILEMAP (NIL (2192 2625 (\IRND 2202 . 2623)) (3321 22933 (MAKEXYPT 3331 . 3562) (IRNDLIST 3564 . 4168
) (NORMLOOP 4170 . 5798) (SLITLOOP 5800 . 7499) (PREPLOOP 7501 . 8166) (YMAPLIST 8168 . 9729) (
IMAPLIST 9731 . 13290) (UNIQLIST 13292 . 13913) (MERGLIST 13915 . 16562) (MMLTLIST 16564 . 17377) (
IMLTLIST 17379 . 18262) (XYPT.LESSP 18264 . 18633) (PATH.LESSP 18635 . 19961) (CONVEXP 19963 . 22931))
(24428 29670 (MAKELINE 24438 . 25121) (MSECT 25123 . 25592) (XSECT 25594 . 26150) (YSECT 26152 .
26710) (XYSECT 26712 . 27453) (KNOTLINE 27455 . 28379) (KNOTLOOP 28381 . 29257) (LINE.LESSP 29259 .
29668)) (29671 33245 (LINEY 29681 . 30135) (MIDDX 30137 . 30640) (INITX 30642 . 31323) (TERMX 31325 .
31955) (SCANX 31957 . 32741) (XPROD 32743 . 33243)) (33285 34749 (XYSECTLSEG 33295 . 34747)) (35193
37748 (MAKEBRES 35203 . 37746)) (41075 47437 (TRAPLOOP 41085 . 43827) (TRAPMAKE 43829 . 47435)))))
STOP

BIN
sources/XXGEOM.LCOM
View File

Binary file not shown.