Compare commits
11 Commits
medley-230
...
medley-230
| Author | SHA1 | Date | |
|---|---|---|---|
|
4fed40bb85 | ||
|
|
3cca8c4940 | ||
|
|
b493d98aeb | ||
|
|
beb4a77195 | ||
|
e067e02dde | ||
|
|
1af56ddaa2 | ||
|
16dd66a016 | ||
|
|
81b74be043 | ||
|
|
f8a5d0fbe5 | ||
|
|
3e0ec62d27 | ||
|
|
654675661f |
18
.github/workflows/buildReleaseInclDocker.yml
vendored
18
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -18,6 +18,9 @@ name: "Build/Push Release & Docker"
|
||||
|
||||
# Run this workflow on ...
|
||||
on:
|
||||
schedule:
|
||||
- cron: '0 9 * * 1'
|
||||
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
draft:
|
||||
@@ -53,7 +56,7 @@ on:
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
|
||||
|
||||
|
||||
# Jobs that compose this workflow
|
||||
jobs:
|
||||
@@ -72,17 +75,14 @@ jobs:
|
||||
steps:
|
||||
- id: one
|
||||
run: >
|
||||
if [ '${{ toJSON(inputs) }}' = 'null' ];
|
||||
if [ '${{ toJSON(inputs) }}' != 'null' ];
|
||||
then
|
||||
echo "workflow_dispatch";
|
||||
echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
else
|
||||
echo "workflow_call";
|
||||
echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
echo "draft=false" >> $GITHUB_OUTPUT;
|
||||
echo "force=false" >> $GITHUB_OUTPUT;
|
||||
fi
|
||||
|
||||
|
||||
######################################################################################
|
||||
|
||||
|
||||
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2| 10212
|
||||
(FILECREATED "23-May-2023 07:10:58" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;12| 10354
|
||||
|
||||
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
|
||||
:CHANGES-TO (FNS GATHER-INFO)
|
||||
|
||||
:PREVIOUS-DATE "22-May-2023 22:57:21" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;11|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
@@ -15,7 +17,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
(LAMBDA (PHASE) (* \; "Edited 26-Dec-2021 18:56 by larry")
|
||||
(LAMBDA (PHASE) (* \; "Edited 22-May-2023 23:59 by lmm")
|
||||
(* \; "Edited 26-Dec-2021 18:56 by larry")
|
||||
(* \; "Edited 24-Oct-2021 09:43 by larry")
|
||||
(SELECTQ PHASE
|
||||
(ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
|
||||
@@ -47,7 +50,7 @@
|
||||
DEFD))
|
||||
(|for| X |in| DEFINEDFNS |when| (CCODEP X)
|
||||
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
|
||||
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|
||||
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY BOUND-BY SPECIAL-BY GLOBAL-BY)
|
||||
|as| VAL |in| Y |do| (|for| S |in| VAL
|
||||
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
|
||||
(SETQ CALLEDFNS NIL)
|
||||
@@ -170,7 +173,7 @@
|
||||
(DRIBBLE))))
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
|
||||
. 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
|
||||
9367 . 10187)))))
|
||||
(FILEMAP (NIL (624 7499 (GATHER-INFO 634 . 6162) (MAKE-FULLER-DB 6164 . 6854) (MEDLEY-FIX-LINKS 6856
|
||||
. 7253) (MEDLEY-FIX-DATES 7255 . 7497)) (8538 10331 (MAKE-EXPORTS-ALL 8548 . 9507) (MAKE-WHEREIS-HASH
|
||||
9509 . 10329)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
530
library/BROWSER
530
library/BROWSER
@@ -1,17 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2022 14:06:19" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;3 26344
|
||||
(FILECREATED "26-Apr-2023 12:41:36" {DSK}<home>larry>il>medley>library>BROWSER.;6 29801
|
||||
|
||||
:CHANGES-TO (VARS BROWSERCOMS)
|
||||
(FNS GET.BROWSE.PP.WINDOW NUMSPATHS)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "25-Mar-94 13:43:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;1)
|
||||
:CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER
|
||||
BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW
|
||||
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
|
||||
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH)
|
||||
(VARS BROWSERCOMS BROWSER.BORDERS)
|
||||
|
||||
:PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}<home>larry>il>medley>library>BROWSER.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT BROWSERCOMS)
|
||||
|
||||
@@ -20,27 +20,26 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
GRAPHER)
|
||||
(CONSTANTS (CHANGEDSHADE 8840)))
|
||||
(FNS NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN GET.BROWSE.PP.WINDOW
|
||||
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
|
||||
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH STBROWSER)
|
||||
(FNS MSPATHS.DISPATCH NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN
|
||||
GET.BROWSE.PP.WINDOW GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN
|
||||
DESCRIBEREPAINTFN BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP
|
||||
REDRAWBROWSEGRAPH STBROWSER)
|
||||
(GLOBALRESOURCES BROWSEHASH)
|
||||
(DECLARE%: DONTCOPY (RECORDS BROWSEWIN PATHSARGS))
|
||||
[VARS (BROWSERBOXING)
|
||||
(BROWSERFORMAT)
|
||||
(BROWSERWINDOWS)
|
||||
(NODESELECTIONWINDOW)
|
||||
(PFWINDOW)
|
||||
(BROWSER.DESCRIBE.WINDOW)
|
||||
(BrowserPPWindowWidth 750)
|
||||
(BROWSERFONT '(GACHA 8]
|
||||
[P (MOVD? 'MSPATHS 'OLDMSPATHS)
|
||||
(MOVD? 'NILL 'MODERNWINDOW)
|
||||
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
|
||||
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
|
||||
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (SELECTQ (SYSTEMTYPE)
|
||||
(D (BROWSER T))
|
||||
NIL])
|
||||
[INITVARS (BROWSER T)
|
||||
(BROWSERBOXING)
|
||||
(BROWSERFORMAT)
|
||||
(BROWSERWINDOWS)
|
||||
(NODESELECTIONWINDOW)
|
||||
(PFWINDOW)
|
||||
(BROWSER.DESCRIBE.WINDOW)
|
||||
(BrowserPPWindowWidth 750)
|
||||
(BROWSERMAX 10)
|
||||
(BROWSERFONT '(GACHA 8]
|
||||
(P (MOVD? 'NILL 'MODERNWINDOW))
|
||||
(VARS BROWSER.BORDERS)
|
||||
(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (BROWSER T])
|
||||
|
||||
(FILESLOAD MASTERSCOPE GRAPHER)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -58,64 +57,74 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(NUMSPATHS
|
||||
(MSPATHS.DISPATCH
|
||||
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
|
||||
(* ; "Edited 7-Feb-2022 13:57 by rmk")
|
||||
(* ; "Edited 11-Apr-88 11:08 by jrb:")
|
||||
(COND
|
||||
[(AND (WINDOWWORLD)
|
||||
(* ; "Edited 15-Apr-2023 11:33 by lmm")
|
||||
(IF (AND (GETD 'NUMSPATHS)
|
||||
(WINDOWWORLD)
|
||||
(EQ (OUTPUT)
|
||||
T))
|
||||
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
|
||||
APPLY LAMBDA (X)
|
||||
(GETPROP X 'AVOID]
|
||||
(RESETVARS ((MSPRINTFLG))
|
||||
(AND INVERTED (UPDATECHANGED))
|
||||
(STBROWSER
|
||||
[GLOBALRESOURCE
|
||||
BROWSEHASH
|
||||
(PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T))
|
||||
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
|
||||
(CALLRELATION (PARSERELATION 'CALL]
|
||||
(DECLARE (SPECVARS SEEN UNDONE GRAPHNODE.LIST))
|
||||
(CLRHASH SEEN)
|
||||
(for X in UNDONE do (PUTHASH X (COND
|
||||
((AND NOTRACE (MSMEMBSET X NOTRACE))
|
||||
-1)
|
||||
(T 0))
|
||||
SEEN)
|
||||
(OR INVERTED (UPDATEFN X NIL 0)))
|
||||
[do (COND
|
||||
(NAMED (PUTHASH (CAR NAMED)
|
||||
0 SEEN)
|
||||
[push ROOTS (fetch (GRAPHNODE NODEID)
|
||||
of (BRPATHS1 (CAR NAMED]
|
||||
(SETQ NAMED (CDR NAMED)))
|
||||
(UNDONE [COND
|
||||
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
|
||||
SEEN)))
|
||||
(EQ TEM 0)
|
||||
(AND (LISTP TEM)
|
||||
(NULL (CAR TEM]
|
||||
(PUTHASH (CAR UNDONE)
|
||||
(LIST NIL)
|
||||
SEEN)
|
||||
(SETQ NAMED (LIST (CAR UNDONE]
|
||||
(SETQ UNDONE (CDR UNDONE)))
|
||||
(T (RETURN]
|
||||
(RETURN (LAYOUTFOREST GRAPHNODE.LIST ROOTS BROWSERFORMAT BROWSERBOXING]
|
||||
(PROG1 (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE)
|
||||
(* ;
|
||||
"this LIST is actually an 'instance' of PATHSARGS")
|
||||
]
|
||||
(T (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
|
||||
THEN (NUMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
|
||||
ELSE (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
|
||||
|
||||
(NUMSPATHS
|
||||
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
|
||||
(DECLARE (SPECVARS INVERTED GRAPHNODE.LIST)) (* ; "Edited 26-Apr-2023 09:12 by lmm")
|
||||
(* ; "Edited 15-Apr-2023 18:43 by lmm")
|
||||
(* ; "Edited 7-Feb-2022 13:57 by rmk")
|
||||
(* ; "Edited 11-Apr-88 11:08 by jrb:")
|
||||
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
|
||||
APPLY LAMBDA (X)
|
||||
(GETPROP X 'AVOID]
|
||||
(AND INVERTED (UPDATECHANGED))
|
||||
(OR DEPTH (SETQ DEPTH BROWSERMAX))
|
||||
(WITH-RESOURCES BROWSEHASH (PROG [NAMED TEM (UNDONE (MSLISTSET FROM T))
|
||||
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
|
||||
(CALLRELATION (PARSERELATION 'CALL]
|
||||
(DECLARE (SPECVARS SEEN GRAPHNODE.LIST CALLRELATION))
|
||||
(CLRHASH SEEN)
|
||||
(for X in UNDONE do (PUTHASH X (COND
|
||||
((AND NOTRACE (MSMEMBSET
|
||||
X NOTRACE))
|
||||
-1)
|
||||
(T 0))
|
||||
SEEN)
|
||||
(OR INVERTED (UPDATEFN X NIL 0)))
|
||||
[do (COND
|
||||
(NAMED (PUTHASH (CAR NAMED)
|
||||
0 SEEN)
|
||||
(PUSH ROOTS (fetch (GRAPHNODE NODEID)
|
||||
of (BRPATHS1 (CAR NAMED)
|
||||
DEPTH)))
|
||||
(SETQ NAMED (CDR NAMED)))
|
||||
(UNDONE [COND
|
||||
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
|
||||
SEEN)))
|
||||
(EQ TEM 0)
|
||||
(AND (LISTP TEM)
|
||||
(NULL (CAR TEM]
|
||||
(PUTHASH (CAR UNDONE)
|
||||
(LIST NIL)
|
||||
SEEN)
|
||||
(SETQ NAMED (LIST (CAR UNDONE]
|
||||
(SETQ UNDONE (CDR UNDONE)))
|
||||
(T (RETURN]
|
||||
(RETURN (STBROWSER (LAYOUTGRAPH GRAPHNODE.LIST ROOTS
|
||||
(APPEND BROWSERFORMAT BROWSERBOXING))
|
||||
(LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE
|
||||
MARKING DEPTH])
|
||||
|
||||
(BROWSER
|
||||
[LAMBDA (DISPLAYFLG) (* rmk%: "16-Dec-83 15:39")
|
||||
(COND
|
||||
(DISPLAYFLG (SETQ BROWSERFONT (FONTCREATE BROWSERFONT))
|
||||
(MOVD 'NUMSPATHS 'MSPATHS))
|
||||
(T (MOVD 'OLDMSPATHS 'MSPATHS])
|
||||
[LAMBDA (DISPLAYFLG) (* ; "Edited 15-Apr-2023 14:55 by lmm")
|
||||
(* rmk%: "16-Dec-83 15:39")
|
||||
(MOVD? 'MSPATHS 'OLDMSPATHS)
|
||||
(MOVD 'MSPATHS.DISPATCH 'MSPATHS)
|
||||
(SETQ BROWSER DISPLAYFLG)
|
||||
(OR (FONTP BROWSERFONT)
|
||||
(SETQ BROWSERFONT (FONTCREATE BROWSERFONT)))
|
||||
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
|
||||
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
|
||||
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC])
|
||||
|
||||
(BROWSER.WHENFNSCHANGED
|
||||
[LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS%: (RECORDS BROWSEWIN))
|
||||
@@ -134,78 +143,122 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
FNNAME))
|
||||
(BROWSERDESCRIBE FNNAME BROWSER.DESCRIBE.WINDOW)))
|
||||
(for X in BROWSERWINDOWS do (COND
|
||||
((find GRAPHNODE
|
||||
in (fetch (GRAPH GRAPHNODES)
|
||||
of (fetch (BROWSEWIN GRAPH)
|
||||
of X))
|
||||
suchthat (EQ (fetch (GRAPHNODE NODELABEL)
|
||||
of GRAPHNODE)
|
||||
FNNAME))
|
||||
(COND
|
||||
((fetch (BROWSEWIN GRAPH) of X)
|
||||
(DSPFILL NIL CHANGEDSHADE 'PAINT
|
||||
(fetch (BROWSEWIN WINDOW) of
|
||||
X))
|
||||
(WINDOWPROP (fetch (BROWSEWIN WINDOW)
|
||||
of X)
|
||||
'BUTTONEVENTFN
|
||||
(FUNCTION REDRAWBROWSEGRAPH))
|
||||
(replace (BROWSEWIN GRAPH) of X
|
||||
with NIL])
|
||||
((find GRAPHNODE in (fetch (GRAPH GRAPHNODES)
|
||||
of (fetch (BROWSEWIN GRAPH) of X))
|
||||
suchthat (EQ (fetch (GRAPHNODE NODELABEL) of GRAPHNODE)
|
||||
FNNAME))
|
||||
(COND
|
||||
((fetch (BROWSEWIN GRAPH) of X)
|
||||
(DSPFILL NIL CHANGEDSHADE 'PAINT (fetch (BROWSEWIN WINDOW)
|
||||
of X))
|
||||
(WINDOWPROP (fetch (BROWSEWIN WINDOW) of X)
|
||||
'BUTTONEVENTFN
|
||||
(FUNCTION REDRAWBROWSEGRAPH))
|
||||
(replace (BROWSEWIN GRAPH) of X with NIL])
|
||||
|
||||
(BRPATHS1
|
||||
[LAMBDA (FROM) (* ; "Edited 11-Apr-88 11:27 by jrb:")
|
||||
(DECLARE (GLOBALVARS BROWSERFONT))
|
||||
(PROG (TEM)
|
||||
[LAMBDA (FROM DEPTH) (* ; "Edited 25-Apr-2023 10:59 by lmm")
|
||||
(* ; "Edited 11-Apr-88 11:27 by jrb:")
|
||||
(DECLARE (SPECVARS INVERTED)
|
||||
(GLOBALVARS BROWSERFONT MISSING.GRAPH.NODEBORDER))
|
||||
(PROG (TEM ENTRY TOFNS)
|
||||
(MSPATHS2 FROM)
|
||||
(COND
|
||||
((EQ (SETQ TEM (GETHASH FROM SEEN))
|
||||
-1) (* ;
|
||||
"on NOPATHS list - create a node for it with no subs")
|
||||
"on NOPATHS list - create a node for it with no subs")
|
||||
(SETQ TEM (create GRAPHNODE
|
||||
NODEID _ FROM
|
||||
NODELABEL _ FROM
|
||||
NODEFONT _ BROWSERFONT
|
||||
TONODES _ NIL))
|
||||
(push GRAPHNODE.LIST TEM)
|
||||
(PUAH GRAPHNODE.LIST TEM)
|
||||
(PUTHASH FROM TEM SEEN)
|
||||
(RETURN TEM))
|
||||
((NEQ TEM 0) (* ; "already expanded into a list")
|
||||
(RETURN TEM))
|
||||
(T (RETURN (PROG ((ENTRY (create GRAPHNODE
|
||||
NODEID _ FROM
|
||||
NODELABEL _ FROM
|
||||
NODEFONT _ BROWSERFONT)))
|
||||
(push GRAPHNODE.LIST ENTRY)
|
||||
(PUTHASH FROM ENTRY SEEN)
|
||||
(replace (GRAPHNODE TONODES) of ENTRY
|
||||
with (for X
|
||||
in (for Y
|
||||
in (COND
|
||||
((NOT INVERTED)
|
||||
(GETRELATION FROM CALLRELATION))
|
||||
(T (GETRELATION FROM CALLRELATION T)
|
||||
)) when (MSPATHS2 Y)
|
||||
collect Y) when (SETQ X (BRPATHS1
|
||||
X))
|
||||
collect (fetch (GRAPHNODE NODEID) of X)))
|
||||
(RETURN ENTRY])
|
||||
(T [SETQ TOFNS (COND
|
||||
((NOT INVERTED)
|
||||
(GETRELATION FROM CALLRELATION))
|
||||
(T (GETRELATION FROM CALLRELATION T]
|
||||
(SETQ ENTRY (create GRAPHNODE
|
||||
NODEID _ FROM
|
||||
NODELABEL _ FROM
|
||||
NODEFONT _ BROWSERFONT))
|
||||
(PUSH GRAPHNODE.LIST ENTRY)
|
||||
(PUTHASH FROM ENTRY SEEN)
|
||||
(IF (AND TOFNS (<= DEPTH 0))
|
||||
THEN (REPLACE (GRAPHNODE NODEBORDER) OF ENTRY WITH (CDDR (ASSOC 'ENDOFLINE
|
||||
BROWSER.BORDERS))
|
||||
)
|
||||
(RETURN ENTRY))
|
||||
(replace (GRAPHNODE TONODES) of ENTRY with (for X
|
||||
in (for Y in TOFNS
|
||||
when (MSPATHS2 Y) collect Y)
|
||||
when (SETQ X (BRPATHS1 X
|
||||
(- DEPTH 1)))
|
||||
collect (fetch (GRAPHNODE NODEID)
|
||||
of X)))
|
||||
(RETURN ENTRY])
|
||||
|
||||
(BROWSER.LEFTFN
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 31-Mar-87 11:16 by jop")
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 26-Apr-2023 12:41 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:16 by jop")
|
||||
(* ;
|
||||
"function that is applied upon selection of a node.")
|
||||
(COND
|
||||
((NULL NODE))
|
||||
((EQ (fetch NODELABEL of NODE)
|
||||
(WINDOWPROP (GET.BROWSE.PP.WINDOW)
|
||||
'FNBROWSED))
|
||||
(BROWSERDESCRIBE (fetch NODELABEL of NODE)
|
||||
(GET.BROWSE.DESCRIBE.WINDOW)))
|
||||
(T (* ;
|
||||
"if first time touched, pretty print it.")
|
||||
(BROWSEPP (fetch NODELABEL of NODE)
|
||||
(GET.BROWSE.PP.WINDOW])
|
||||
(PROG (FN SELECTION)
|
||||
(IF (NULL NODE)
|
||||
THEN (RETURN)
|
||||
(MOVEW NWINDOW) (* ;
|
||||
" really want to just drag the content around")
|
||||
(RETURN))
|
||||
(IF (NULL (SETQ FN (FETCH NODELABEL OF NODE)))
|
||||
THEN (RETURN))
|
||||
[SETQ SELECTION (MENU (CREATE MENU
|
||||
ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
|
||||
|
||||
(* ;; "Mot implemented: Ignore Avoid")
|
||||
|
||||
(DESTRUCTURING-BIND (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
|
||||
(FOR BW IN BROWSERWINDOWS WHEN (EQ (FETCH (BROWSEWIN WINDOW) OF BW)
|
||||
NWINDOW) DO (RETURN (FETCH (BROWSEWIN ARGS)
|
||||
OF BW))
|
||||
FINALLY (PROMPTPRINT "No browser window found for" FN)
|
||||
(RETURN))
|
||||
|
||||
(* ;; "Now we have the arguments to MSPATHS .. insert this node?")
|
||||
|
||||
(SELECTQ SELECTION
|
||||
((NIL)
|
||||
(RETURN))
|
||||
((CallsFrom CallsTo)
|
||||
(* ;; "new graph, FN at the root")
|
||||
|
||||
(NUMSPATHS (CREATE SENTENCE
|
||||
SUBJECT _ '(NIL NIL . FNS)
|
||||
MSPRED _ 'QUOTE
|
||||
OTHERSTUFF _ (LIST FN))
|
||||
(IF INVERTED
|
||||
THEN TO
|
||||
ELSE FROM)
|
||||
INVERTED AVOIDING NIL NOTRACE MARKING DEPTH))
|
||||
NIL
|
||||
(Ignore (* ; "local ignore"))
|
||||
(Avoid (* ; " global ignore"))
|
||||
(Edit (ED FN (IF (HASDEF FN 'FNS)
|
||||
THEN 'FNS
|
||||
ELSEIF (HASDEF FN 'FUNCTIONS)
|
||||
THEN 'FUNCTIONS
|
||||
ELSE (PROMPTPRINT FN "no definition")
|
||||
NIL)))
|
||||
(Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW)
|
||||
'FNBROWSED))
|
||||
(BROWSEPP FN (GET.BROWSE.PP.WINDOW))))
|
||||
(Describe (BROWSERDESCRIBE FN (GET.BROWSE.DESCRIBE.WINDOW)))
|
||||
(InspectCode (IF (NOT (CCODEP FN))
|
||||
THEN (PROMPTPRINT FN "not compiled")
|
||||
ELSE (INSPECTCODE FN)))
|
||||
(HELP])
|
||||
|
||||
(GET.BROWSE.PP.WINDOW
|
||||
[LAMBDA NIL (* ; "Edited 7-Feb-2022 14:01 by rmk")
|
||||
@@ -253,9 +306,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
BOTTOM])
|
||||
|
||||
(PPREPAINTFN
|
||||
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani")
|
||||
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani")
|
||||
|
||||
(* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.")
|
||||
(* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.")
|
||||
|
||||
(PROG ((FN (WINDOWPROP WINDOW 'FNBROWSED))
|
||||
(EXTENT (WINDOWPROP WINDOW 'EXTENT))
|
||||
@@ -265,25 +318,23 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(MOVETOUPPERLEFT WINDOW EXTENT)
|
||||
(printout WINDOW .FONT DEFAULTFONT)
|
||||
(COND
|
||||
((for FPTYPE in MSFNTYPES
|
||||
when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE FILEPKGNAME)
|
||||
of FPTYPE)
|
||||
NIL
|
||||
'NOERROR))
|
||||
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME)
|
||||
of FPTYPE))
|
||||
(RETURN DEF) finally NIL)
|
||||
(* ;
|
||||
"set up linelength characteristics.")
|
||||
((for FPTYPE in MSFNTYPES when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE
|
||||
FILEPKGNAME)
|
||||
of FPTYPE)
|
||||
NIL
|
||||
'NOERROR))
|
||||
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) of FPTYPE))
|
||||
(RETURN DEF) finally NIL) (* ;
|
||||
"set up linelength characteristics.")
|
||||
(RESETLST
|
||||
(RESETSAVE (OUTPUT WINDOW))
|
||||
(RESETSAVE (SETREADTABLE T))
|
||||
(RESETSAVE **COMMENT**FLG)
|
||||
(if (EQ FNTYPE 'FNS)
|
||||
then (printout WINDOW "(" .FONT LAMBDAFONT |.P2| FN .FONT
|
||||
DEFAULTFONT T))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION
|
||||
NIL WINDOW))
|
||||
then (printout WINDOW "(" .FONT LAMBDAFONT .P2 FN .FONT
|
||||
DEFAULTFONT T))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL
|
||||
WINDOW))
|
||||
WINDOW)
|
||||
(PRINTDEF DEF (AND (EQ FNTYPE 'FNS)
|
||||
2)
|
||||
@@ -291,19 +342,19 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(if (EQ FNTYPE 'FNS)
|
||||
then (PRIN1 ")" WINDOW)))
|
||||
(fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)))
|
||||
(T (* ;
|
||||
"set right margin out so wouldn't clip.")
|
||||
(T (* ;
|
||||
"set right margin out so wouldn't clip.")
|
||||
(DSPRIGHTMARGIN 5000 WINDOW)
|
||||
(APPLY* (FUNCTION PF*)
|
||||
FN NIL (GETSTREAM WINDOW))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION
|
||||
NIL WINDOW))
|
||||
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL WINDOW
|
||||
))
|
||||
WINDOW)
|
||||
BrowserPPWindowWidth)))
|
||||
(T 0])
|
||||
|
||||
(PPRESHAPEFN
|
||||
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
|
||||
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
|
||||
(BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED)
|
||||
WINDOW])
|
||||
|
||||
@@ -314,17 +365,18 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(PROG [(FN (WINDOWPROP WIN 'FNBROWSED))
|
||||
(EXTENT (WINDOWPROP WIN 'EXTENT]
|
||||
(COND
|
||||
(FN (RESETLST (RESETSAVE MSPRINTFLG NIL)
|
||||
(RESETSAVE (OUTPUT WIN))
|
||||
(DSPSCROLL 'OFF WIN)
|
||||
(COND
|
||||
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
|
||||
(MSDESCRIBE FN])
|
||||
(FN (RESETLST
|
||||
(RESETSAVE MSPRINTFLG NIL)
|
||||
(RESETSAVE (OUTPUT WIN))
|
||||
(DSPSCROLL 'OFF WIN)
|
||||
(COND
|
||||
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
|
||||
(MSDESCRIBE FN))])
|
||||
|
||||
(BROWSERDESCRIBE
|
||||
[LAMBDA (FN WIN) (* ; "Edited 31-Mar-87 11:15 by jop")
|
||||
|
||||
(* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.")
|
||||
|
||||
(* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.")
|
||||
|
||||
(WINDOWPROP WIN 'FNBROWSED FN)
|
||||
(CLEARW WIN)
|
||||
@@ -337,9 +389,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
(DSPYPOSITION NIL WIN])
|
||||
|
||||
(BROWSER.MIDDLEFN
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds")
|
||||
[LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds")
|
||||
(* ;
|
||||
"called when yellow selection from browser. Call display editor on the function.")
|
||||
"called when yellow selection from browser. Call display editor on the function.")
|
||||
(COND
|
||||
((NULL NODE))
|
||||
[(THIS.PROCESS) (* ; "processes are running.")
|
||||
@@ -352,7 +404,7 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
" " "into the Dedit " "window then selecting 'Edit'."))
|
||||
(T (ADD.PROCESS `(ED ',(fetch NODELABEL of NODE])
|
||||
((SEDIT SEDIT:SEDIT) (* ;
|
||||
"SEdit doesn't have to worry about this stuff")
|
||||
"SEdit doesn't have to worry about this stuff")
|
||||
(ED (fetch NODELABEL of NODE)
|
||||
':DONTWAIT))
|
||||
(ED (fetch NODELABEL of NODE]
|
||||
@@ -360,8 +412,8 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
|
||||
(DEDITPROCESSRUNNINGP
|
||||
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:27 by jop")
|
||||
|
||||
(* ;; "is there a dedit process running?")
|
||||
|
||||
(* ;; "is there a dedit process running?")
|
||||
|
||||
(AND (EQ (EDITMODE)
|
||||
'DEDIT)
|
||||
@@ -369,73 +421,69 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
|
||||
(REDRAWBROWSEGRAPH
|
||||
[LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN))
|
||||
(* ; "Edited 15-Apr-2023 16:12 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:24 by jop")
|
||||
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW)
|
||||
of X)
|
||||
WINDOW]
|
||||
(AND WN (APPLY 'NUMSPATHS (fetch (BROWSEWIN ARGS) of WN)))
|
||||
(* ; "(OR WN (SHOULDNT))")
|
||||
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) of X)
|
||||
WINDOW]
|
||||
(AND WN (APPLY (FUNCTION NUMSPATHS)
|
||||
(fetch (BROWSEWIN ARGS) of WN))) (* ; "(OR WN (SHOULDNT))")
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE))
|
||||
(APPLYTOSELECTEDNODE WINDOW])
|
||||
|
||||
(STBROWSER
|
||||
[LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN))
|
||||
(* ; "Edited 25-Apr-2023 21:05 by lmm")
|
||||
(* ; "Edited 31-Mar-87 11:18 by jop")
|
||||
|
||||
(* ;; "puts a browser graph for the args FROMFN in a window. If a similar graph is already a window, that window is reused; otherwise a new window is created.")
|
||||
|
||||
(WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS
|
||||
when (EQUAL (fetch (PATHSARGS DISCRIMINANT) of ARGS)
|
||||
(fetch (PATHSARGS DISCRIMINANT) of (fetch
|
||||
(BROWSEWIN ARGS)
|
||||
of W)))
|
||||
(WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS when (EQUAL (fetch (PATHSARGS DISCRIMINANT)
|
||||
of ARGS)
|
||||
(fetch (PATHSARGS DISCRIMINANT)
|
||||
of (fetch (BROWSEWIN ARGS)
|
||||
of W)))
|
||||
do (replace (BROWSEWIN ARGS) of W with ARGS)
|
||||
(replace (BROWSEWIN GRAPH) of W with GRAPH)
|
||||
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN))
|
||||
(RETURN W)
|
||||
(replace (BROWSEWIN GRAPH) of W with GRAPH)
|
||||
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN))
|
||||
(RETURN W)
|
||||
finally (SETQ W (SHOWGRAPH GRAPH (CONCAT "PATHS"
|
||||
(COND
|
||||
((SETQ TMP (fetch
|
||||
(PATHSARGS FROM)
|
||||
of ARGS))
|
||||
(COND
|
||||
((SETQ TMP (fetch (PATHSARGS FROM)
|
||||
of ARGS))
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T ""))
|
||||
(COND
|
||||
((SETQ TMP (fetch (PATHSARGS TO)
|
||||
of ARGS))
|
||||
(* ;
|
||||
"CADDDR here gets the thing that looks like it might be a function name.")
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T ""))
|
||||
(COND
|
||||
((SETQ TMP (fetch
|
||||
(PATHSARGS TO)
|
||||
of ARGS))
|
||||
(* ;
|
||||
"CADDDR here gets the thing that looks like it might be a function name.")
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T "")))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN)))
|
||||
"CADDDR here gets the thing that looks like it might be a function name.")
|
||||
(CONCAT (COND
|
||||
((CADR (CADR TMP))
|
||||
" FROM ")
|
||||
(T " TO "))
|
||||
(CADDDR TMP)))
|
||||
(T "")))
|
||||
(FUNCTION BROWSER.LEFTFN)
|
||||
(FUNCTION BROWSER.MIDDLEFN)))
|
||||
(push BROWSERWINDOWS
|
||||
(create BROWSEWIN
|
||||
ARGS _ ARGS
|
||||
GRAPH _ GRAPH
|
||||
WINDOW _ W))
|
||||
(create BROWSEWIN
|
||||
ARGS _ ARGS
|
||||
GRAPH _ GRAPH
|
||||
WINDOW _ W))
|
||||
(RETURN W))
|
||||
'CLOSEFN
|
||||
(FUNCTION (LAMBDA (WINDOW) (* ;
|
||||
"The closing function for browser windows. removes it from BROWSERWINDOWS")
|
||||
"The closing function for browser windows. removes it from BROWSERWINDOWS")
|
||||
(SETQ BROWSERWINDOWS (DREMOVE (for X in BROWSERWINDOWS
|
||||
when (EQ (fetch (BROWSEWIN WINDOW)
|
||||
of X)
|
||||
WINDOW)
|
||||
do (RETURN X))
|
||||
of X)
|
||||
WINDOW) do (RETURN X))
|
||||
BROWSERWINDOWS])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
@@ -457,41 +505,49 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQQ BROWSERBOXING NIL)
|
||||
(RPAQ? BROWSER T)
|
||||
|
||||
(RPAQQ BROWSERFORMAT NIL)
|
||||
(RPAQ? BROWSERBOXING )
|
||||
|
||||
(RPAQQ BROWSERWINDOWS NIL)
|
||||
(RPAQ? BROWSERFORMAT )
|
||||
|
||||
(RPAQQ NODESELECTIONWINDOW NIL)
|
||||
(RPAQ? BROWSERWINDOWS )
|
||||
|
||||
(RPAQQ PFWINDOW NIL)
|
||||
(RPAQ? NODESELECTIONWINDOW )
|
||||
|
||||
(RPAQQ BROWSER.DESCRIBE.WINDOW NIL)
|
||||
(RPAQ? PFWINDOW )
|
||||
|
||||
(RPAQQ BrowserPPWindowWidth 750)
|
||||
(RPAQ? BROWSER.DESCRIBE.WINDOW )
|
||||
|
||||
(RPAQQ BROWSERFONT (GACHA 8))
|
||||
(RPAQ? BrowserPPWindowWidth 750)
|
||||
|
||||
(MOVD? 'MSPATHS 'OLDMSPATHS)
|
||||
(RPAQ? BROWSERMAX 10)
|
||||
|
||||
(RPAQ? BROWSERFONT '(GACHA 8))
|
||||
|
||||
(MOVD? 'NILL 'MODERNWINDOW)
|
||||
|
||||
[PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
|
||||
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
|
||||
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
|
||||
(RPAQQ BROWSER.BORDERS
|
||||
((NORMAL "Normal" 2 -1)
|
||||
(GHOST "Shown elsewhere" 2 8840)
|
||||
(RECURSIVEGHOST "End of recursive chain" 2 0 -1)
|
||||
(MERGED "Includes other branches" 4 42405)
|
||||
(SELFRECURSIVE "Includes self-recursive calls" 2 61375)
|
||||
(RECURSIVE "Head of recursive chain" 4 28086)
|
||||
(ENDOFLINE "exceeded depth limit" 6 64510)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(SELECTQ (SYSTEMTYPE)
|
||||
(D (BROWSER T))
|
||||
NIL)
|
||||
(BROWSER T)
|
||||
)
|
||||
(PUTPROPS BROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1987 1988 1990 1993 1994))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2054 25148 (NUMSPATHS 2064 . 5246) (BROWSER 5248 . 5511) (BROWSER.WHENFNSCHANGED 5513
|
||||
. 7812) (BRPATHS1 7814 . 10080) (BROWSER.LEFTFN 10082 . 10940) (GET.BROWSE.PP.WINDOW 10942 . 11767) (
|
||||
GET.BROWSE.DESCRIBE.WINDOW 11769 . 12517) (BROWSEPP 12519 . 13393) (PPREPAINTFN 13395 . 16529) (
|
||||
PPRESHAPEFN 16531 . 16711) (DESCRIBEREPAINTFN 16713 . 17409) (BROWSERDESCRIBE 17411 . 18169) (
|
||||
BROWSER.MIDDLEFN 18171 . 19478) (DEDITPROCESSRUNNINGP 19480 . 19751) (REDRAWBROWSEGRAPH 19753 . 20516)
|
||||
(STBROWSER 20518 . 25146)))))
|
||||
(FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
|
||||
(BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
|
||||
GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
|
||||
) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
|
||||
BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
|
||||
REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/BROWSER.TEDIT
Normal file
BIN
library/BROWSER.TEDIT
Normal file
Binary file not shown.
10
library/lafite/docs/README
Normal file
10
library/lafite/docs/README
Normal file
@@ -0,0 +1,10 @@
|
||||
Lafite README
|
||||
|
||||
the end-user documentation for Lafite in a PDF is on Google Drive
|
||||
|
||||
https://drive.google.com/drive/folders/1Zb2IudbnlzfEK5YzTcEr7k2liclFUquE?usp=sharing
|
||||
|
||||
Here (in the GitHub Interlisp/medley repo)
|
||||
you will find the .TEdit sources that can be used to produce the documentation using ths utility HCFILES on the file MEDLEY-UTILS in the "internal" folder.
|
||||
|
||||
For Lafite there are two folders, one with the (latest) documentation and one with release notes.
|
||||
BIN
library/lafite/docs/release-notes/ChangesLyric.tedit
Normal file
BIN
library/lafite/docs/release-notes/ChangesLyric.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-1-90.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-1-90.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-11-89.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-11-89.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-2-1-89.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-2-1-89.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-2-23-89.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-2-23-89.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-5-89.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-5-89.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-8-89.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-8-89.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITE-Delta-9-88.tedit
Normal file
BIN
library/lafite/docs/release-notes/LAFITE-Delta-9-88.tedit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/LAFITEDELTA.TED
Normal file
BIN
library/lafite/docs/release-notes/LAFITEDELTA.TED
Normal file
Binary file not shown.
448
library/lafite/docs/release-notes/Lafite-85.TEdit
Normal file
448
library/lafite/docs/release-notes/Lafite-85.TEdit
Normal file
File diff suppressed because one or more lines are too long
BIN
library/lafite/docs/release-notes/Lafite-Jun-88.TEdit
Normal file
BIN
library/lafite/docs/release-notes/Lafite-Jun-88.TEdit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/Lafite-Update.TEdit
Normal file
BIN
library/lafite/docs/release-notes/Lafite-Update.TEdit
Normal file
Binary file not shown.
446
library/lafite/docs/release-notes/LafiteImpl.ted
Normal file
446
library/lafite/docs/release-notes/LafiteImpl.ted
Normal file
File diff suppressed because one or more lines are too long
BIN
library/lafite/docs/release-notes/ReleaseMsg.TEdit
Normal file
BIN
library/lafite/docs/release-notes/ReleaseMsg.TEdit
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/Tasks.ted
Normal file
BIN
library/lafite/docs/release-notes/Tasks.ted
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/TasksDone.ted
Normal file
BIN
library/lafite/docs/release-notes/TasksDone.ted
Normal file
Binary file not shown.
BIN
library/lafite/docs/release-notes/unixmail.tedit
Normal file
BIN
library/lafite/docs/release-notes/unixmail.tedit
Normal file
Binary file not shown.
File diff suppressed because one or more lines are too long
32
library/lafite/docs/users-guide/LAFITEMANUAL-APPENDIXB.TEDIT
Normal file
32
library/lafite/docs/users-guide/LAFITEMANUAL-APPENDIXB.TEDIT
Normal file
File diff suppressed because one or more lines are too long
Binary file not shown.
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-INDEXCUSTOMER.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-INDEXCUSTOMER.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-INDEXINTERNAL.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-INDEXINTERNAL.TEDIT
Normal file
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC1.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC1.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC10.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC10.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC11.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC11.TEDIT
Normal file
Binary file not shown.
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC12.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC12.TEDIT
Normal file
Binary file not shown.
14
library/lafite/docs/users-guide/LAFITEMANUAL-SEC13.TEDIT
Normal file
14
library/lafite/docs/users-guide/LAFITEMANUAL-SEC13.TEDIT
Normal file
File diff suppressed because one or more lines are too long
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC14.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC14.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC2.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC2.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC3.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC3.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC4.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC4.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC5.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC5.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC6.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC6.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC7.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC7.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC8.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC8.TEDIT
Normal file
Binary file not shown.
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC9.TEDIT
Normal file
BIN
library/lafite/docs/users-guide/LAFITEMANUAL-SEC9.TEDIT
Normal file
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,17 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Jul-2022 15:28:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;11 100587
|
||||
(FILECREATED "10-May-2023 09:12:17" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;12 101009
|
||||
|
||||
:CHANGES-TO (FNS PFI.PRINT.BITMAP)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE " 5-May-2022 23:33:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;10)
|
||||
:CHANGES-TO (FNS PFI.PRINT.FILECREATED)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 15:28:08" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;11
|
||||
)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PRETTYFILEINDEXCOMS)
|
||||
|
||||
@@ -453,7 +450,8 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(PFI.PRINT.FILECREATED
|
||||
[LAMBDA (EXPR ENV) (* ; "Edited 5-May-2022 21:53 by rmk")
|
||||
[LAMBDA (EXPR ENV) (* ; "Edited 10-May-2023 08:43 by lmm")
|
||||
(* ; "Edited 5-May-2022 21:53 by rmk")
|
||||
(* ; "Edited 30-Nov-2021 22:08 by larry")
|
||||
(* ; "Edited 30-Nov-2021 21:40 by larry")
|
||||
(* ; "Edited 9-Jul-2021 07:59 by rmk:")
|
||||
@@ -465,77 +463,88 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(pop EXPR)
|
||||
(CHANGEFONT ITALICFONT)
|
||||
(LET* [(STRINGS '("File created: " "changes to: " "previous date: " "Read Table: "
|
||||
"Package: " "Base: " "Format: "))
|
||||
(FONT (DSPFONT))
|
||||
(STRWIDTHS (for STR in STRINGS collect (STRINGWIDTH STR FONT)))
|
||||
(TABSTOP (+ (DSPLEFTMARGIN)
|
||||
(APPLY (FUNCTION MAX)
|
||||
STRWIDTHS]
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "File created:")
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" " .FONT LAMBDAFONT (pop EXPR)
|
||||
T T) (* ; "date and file name")
|
||||
(if (OR (NULL (CAR EXPR))
|
||||
(FIXP (CAR EXPR)))
|
||||
then (* ; "Skip over filemaploc")
|
||||
(pop EXPR))
|
||||
(if (SELECTQ (CAR EXPR)
|
||||
(changes (SETQ EXPR (CDR EXPR))
|
||||
T)
|
||||
(:CHANGES-TO T)
|
||||
NIL)
|
||||
then (* ; "handle %"Changes to:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDR EXPR))
|
||||
(PRINTDEF (while (LISTP (CAR EXPR)) collect (pop EXPR))
|
||||
T NIL T)
|
||||
(TERPRI)
|
||||
(TERPRI)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
(if (SELECTQ (CAR EXPR)
|
||||
(previous (SETQ EXPR (CDR EXPR))
|
||||
(PROG* [(STRINGS '("File created: " "edit by: " "changes to: " "previous date: "
|
||||
"Read Table: " "Package: " "Base: " "Format: "))
|
||||
(FONT (DSPFONT))
|
||||
(STRWIDTHS (for STR in STRINGS collect (STRINGWIDTH STR FONT)))
|
||||
(TABSTOP (+ (DSPLEFTMARGIN)
|
||||
(APPLY (FUNCTION MAX)
|
||||
STRWIDTHS]
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "File created:")
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" " .FONT LAMBDAFONT (pop EXPR)
|
||||
T T) (* ; "date and file name")
|
||||
(if (OR (NULL (CAR EXPR))
|
||||
(FIXP (CAR EXPR)))
|
||||
then (* ; "Skip over filemaploc")
|
||||
(pop EXPR))
|
||||
(IF (EQ (CAR EXPR)
|
||||
:EDIT-BY)
|
||||
THEN (PFI.PRINT.TO.TAB (POP STRINGS)
|
||||
(POP STRWIDTHS)
|
||||
TABSTOP)
|
||||
(POP EXPR)
|
||||
(PRIN1 (POP EXPR))
|
||||
(TERPRI)
|
||||
(TERPRI)
|
||||
ELSE (POP STRINGS)
|
||||
(POP STRWIDTHS))
|
||||
(if (SELECTQ (CAR EXPR)
|
||||
(changes (SETQ EXPR (CDR EXPR))
|
||||
T)
|
||||
(:PREVIOUS-DATE
|
||||
T)
|
||||
NIL)
|
||||
then (* ; "Handle %"Previous date:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDR EXPR))
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" "
|
||||
(pop EXPR)
|
||||
T T)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
(:CHANGES-TO T)
|
||||
NIL)
|
||||
then (* ; "handle %"Changes to:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDR EXPR))
|
||||
(PRINTDEF (while (LISTP (CAR EXPR)) collect (pop EXPR))
|
||||
T NIL T)
|
||||
(TERPRI)
|
||||
(TERPRI)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
(if (SELECTQ (CAR EXPR)
|
||||
(previous (SETQ EXPR (CDR EXPR))
|
||||
T)
|
||||
(:PREVIOUS-DATE
|
||||
T)
|
||||
NIL)
|
||||
then (* ; "Handle %"Previous date:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDR EXPR))
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" "
|
||||
(pop EXPR)
|
||||
T T)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
|
||||
(* ;; "Show environment")
|
||||
(* ;; "Show environment")
|
||||
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Read table")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :READTABLE)
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Package")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :PACKAGE)
|
||||
(if (NEQ *PRINT-BASE* 10)
|
||||
then (PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(PFI.PRINT.ENVIRONMENT ENV :BASE)
|
||||
else (pop STRINGS))
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Format")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :FORMAT])
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Read table")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :READTABLE)
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Package")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :PACKAGE)
|
||||
(if (NEQ *PRINT-BASE* 10)
|
||||
then (PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(PFI.PRINT.ENVIRONMENT ENV :BASE)
|
||||
else (pop STRINGS))
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Format")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :FORMAT])
|
||||
|
||||
(PFI.PRINT.TO.TAB
|
||||
[LAMBDA (STR WIDTH TABSTOP) (* ; "Edited 29-Mar-88 12:44 by bvm")
|
||||
@@ -1184,30 +1193,29 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
'NILL)
|
||||
'NON.PFI.PRINT.BITMAP NIL T)
|
||||
)
|
||||
(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10069 12304 (PFI.NEW.LISTFILES1 10079 . 10573) (PFI.ENQUEUE 10575 . 11199) (
|
||||
\PFI.DO.HARDCOPY 11201 . 11787) (MAYBE.PRETTYFILEINDEX 11789 . 12302)) (12305 34820 (PRETTYFILEINDEX
|
||||
12315 . 26348) (PFI.MAKE.LPT.STREAM 26350 . 29401) (PFI.SETUP.TRANSLATIONS 29403 . 30917) (
|
||||
PFI.OUTCHARFN 30919 . 32893) (PFI.COLLECT.DEFINERS 32895 . 33707) (PFI.AFTER.NEW.PAGE 33709 . 34818))
|
||||
(34821 40734 (PFI.PRINT.FILECREATED 34831 . 38921) (PFI.PRINT.TO.TAB 38923 . 39368) (
|
||||
PFI.PRINT.ENVIRONMENT 39370 . 40732)) (40735 48250 (PFI.PROCESS.FILE 40745 . 41975) (PFI.PASS.COMMENT
|
||||
41977 . 42947) (PFI.HANDLE.EXPR 42949 . 43616) (PFI.DEFAULT.HANDLER 43618 . 45671) (PFI.PRETTYPRINT
|
||||
45673 . 46008) (PFI.LINES.REMAINING 46010 . 46337) (PFI.MAYBE.NEW.PAGE 46339 . 47173) (
|
||||
PFI.ESTIMATE.SIZE 47175 . 47706) (PFI.ESTIMATE.SIZE1 47708 . 48248)) (48287 58496 (PFI.HANDLE.RPAQQ
|
||||
48297 . 49705) (PFI.HANDLE.DECLARE 49707 . 50646) (PFI.HANDLE.EVAL-WHEN 50648 . 51131) (
|
||||
PFI.HANDLE.DEFDEFINER 51133 . 52423) (PFI.HANDLE.DEFINEQ 52425 . 52669) (PFI.PRINT.LAMBDA 52671 .
|
||||
53009) (PFI.PRINT.LAMBDA.BODY 53011 . 53346) (PFI.HANDLE.PUTDEF 53348 . 53845) (PFI.HANDLE.PUTPROPS
|
||||
53847 . 54462) (PFI.HANDLE./DECLAREDATATYPE 54464 . 55011) (PFI.HANDLE.* 55013 . 56275) (
|
||||
PFI.PRINT.COMMENTS 56277 . 57899) (PFI.HANDLE.FILEMAP 57901 . 58189) (PFI.HANDLE.PACKAGE 58191 . 58494
|
||||
)) (58524 59516 (PFI.PREVIEW.DECLARE 58534 . 59196) (PFI.PREVIEW.DEFINEQ 59198 . 59514)) (59552 70540
|
||||
(PFI.PRINT.INDEX 59562 . 60413) (PFI.CONDENSE.INDEX 60415 . 62222) (PFI.SORT.INDICES 62224 . 63363) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 63365 . 64829) (PFI.PRINT.INDICES 64831 . 69373) (PFI.CENTER.PRINT 69375 .
|
||||
69945) (PFI.INDEX.BREAK 69947 . 70405) (PFI.LOOKUP.NAME 70407 . 70538)) (70541 71772 (PFI.ADD.TO.INDEX
|
||||
70551 . 71061) (PFI.VARNAME 71063 . 71473) (PFI.CONSTANTNAMES 71475 . 71770)) (71807 80120 (
|
||||
MULTIFILEINDEX 71817 . 72613) (MULTIFILEINDEX1 72615 . 74071) (PFI.PRINT.MULTI.INDEX 74073 . 79176) (
|
||||
PFI.CHOOSE.BEST 79178 . 79405) (PFI.MERGE.INDICES 79407 . 80118)) (80177 83246 (PFI.MAYBE.SEE.PRETTY
|
||||
80187 . 81970) (PFI.MAYBE.PP.DEFINITION 81972 . 83244)) (83316 91426 (PFI.PRINT.BITMAP 83326 . 91424))
|
||||
(94195 97309 (PUTPROPS.PRETTYPRINT 94205 . 95616) (RPAQX.PRETTYPRINT 95618 . 96343) (
|
||||
COURIERPROGRAM.PRETTYPRINT 96345 . 97045) (MAYBE.PRETTYPRINT.BOLD 97047 . 97307)))))
|
||||
(FILEMAP (NIL (9974 12209 (PFI.NEW.LISTFILES1 9984 . 10478) (PFI.ENQUEUE 10480 . 11104) (
|
||||
\PFI.DO.HARDCOPY 11106 . 11692) (MAYBE.PRETTYFILEINDEX 11694 . 12207)) (12210 34725 (PRETTYFILEINDEX
|
||||
12220 . 26253) (PFI.MAKE.LPT.STREAM 26255 . 29306) (PFI.SETUP.TRANSLATIONS 29308 . 30822) (
|
||||
PFI.OUTCHARFN 30824 . 32798) (PFI.COLLECT.DEFINERS 32800 . 33612) (PFI.AFTER.NEW.PAGE 33614 . 34723))
|
||||
(34726 41240 (PFI.PRINT.FILECREATED 34736 . 39427) (PFI.PRINT.TO.TAB 39429 . 39874) (
|
||||
PFI.PRINT.ENVIRONMENT 39876 . 41238)) (41241 48756 (PFI.PROCESS.FILE 41251 . 42481) (PFI.PASS.COMMENT
|
||||
42483 . 43453) (PFI.HANDLE.EXPR 43455 . 44122) (PFI.DEFAULT.HANDLER 44124 . 46177) (PFI.PRETTYPRINT
|
||||
46179 . 46514) (PFI.LINES.REMAINING 46516 . 46843) (PFI.MAYBE.NEW.PAGE 46845 . 47679) (
|
||||
PFI.ESTIMATE.SIZE 47681 . 48212) (PFI.ESTIMATE.SIZE1 48214 . 48754)) (48793 59002 (PFI.HANDLE.RPAQQ
|
||||
48803 . 50211) (PFI.HANDLE.DECLARE 50213 . 51152) (PFI.HANDLE.EVAL-WHEN 51154 . 51637) (
|
||||
PFI.HANDLE.DEFDEFINER 51639 . 52929) (PFI.HANDLE.DEFINEQ 52931 . 53175) (PFI.PRINT.LAMBDA 53177 .
|
||||
53515) (PFI.PRINT.LAMBDA.BODY 53517 . 53852) (PFI.HANDLE.PUTDEF 53854 . 54351) (PFI.HANDLE.PUTPROPS
|
||||
54353 . 54968) (PFI.HANDLE./DECLAREDATATYPE 54970 . 55517) (PFI.HANDLE.* 55519 . 56781) (
|
||||
PFI.PRINT.COMMENTS 56783 . 58405) (PFI.HANDLE.FILEMAP 58407 . 58695) (PFI.HANDLE.PACKAGE 58697 . 59000
|
||||
)) (59030 60022 (PFI.PREVIEW.DECLARE 59040 . 59702) (PFI.PREVIEW.DEFINEQ 59704 . 60020)) (60058 71046
|
||||
(PFI.PRINT.INDEX 60068 . 60919) (PFI.CONDENSE.INDEX 60921 . 62728) (PFI.SORT.INDICES 62730 . 63869) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 63871 . 65335) (PFI.PRINT.INDICES 65337 . 69879) (PFI.CENTER.PRINT 69881 .
|
||||
70451) (PFI.INDEX.BREAK 70453 . 70911) (PFI.LOOKUP.NAME 70913 . 71044)) (71047 72278 (PFI.ADD.TO.INDEX
|
||||
71057 . 71567) (PFI.VARNAME 71569 . 71979) (PFI.CONSTANTNAMES 71981 . 72276)) (72313 80626 (
|
||||
MULTIFILEINDEX 72323 . 73119) (MULTIFILEINDEX1 73121 . 74577) (PFI.PRINT.MULTI.INDEX 74579 . 79682) (
|
||||
PFI.CHOOSE.BEST 79684 . 79911) (PFI.MERGE.INDICES 79913 . 80624)) (80683 83752 (PFI.MAYBE.SEE.PRETTY
|
||||
80693 . 82476) (PFI.MAYBE.PP.DEFINITION 82478 . 83750)) (83822 91932 (PFI.PRINT.BITMAP 83832 . 91930))
|
||||
(94701 97815 (PUTPROPS.PRETTYPRINT 94711 . 96122) (RPAQX.PRETTYPRINT 96124 . 96849) (
|
||||
COURIERPROGRAM.PRETTYPRINT 96851 . 97551) (MAYBE.PRETTYPRINT.BOLD 97553 . 97813)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -41,6 +41,7 @@ pass=""
|
||||
mem="-m 256"
|
||||
scroll=22
|
||||
noscroll=""
|
||||
display=""
|
||||
title="Medley Interlisp"
|
||||
|
||||
if [ -z "$LDEDESTSYSOUT" ] ; then
|
||||
@@ -55,8 +56,6 @@ if [ -z "$LDEINIT" ] ; then
|
||||
export LDEINIT="$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT"
|
||||
fi
|
||||
|
||||
export LDEKBDTYPE=x
|
||||
|
||||
while [ "$#" -ne 0 ]; do
|
||||
case "$1" in
|
||||
-loadup)
|
||||
@@ -102,7 +101,7 @@ while [ "$#" -ne 0 ]; do
|
||||
shift
|
||||
;;
|
||||
--display | -d)
|
||||
export DISPLAY="$2"
|
||||
display="-display $2"
|
||||
shift
|
||||
;;
|
||||
-prog)
|
||||
@@ -197,10 +196,10 @@ if ! command -v "$prog" > /dev/null 2>&1; then
|
||||
fi
|
||||
fi
|
||||
|
||||
echo "running: $prog $noscroll $geometry $screensize -title \"$title\" $mem $pass $LDESRCESYSOUT"
|
||||
echo "running: $prog $display $noscroll $geometry $screensize -title \"$title\" $mem $pass $LDESRCESYSOUT"
|
||||
echo "greet: $LDEINIT"
|
||||
|
||||
export INMEDLEY=1
|
||||
|
||||
"$prog" $noscroll $geometry $screensize $mem -title "$title" $pass "$LDESRCESYSOUT"
|
||||
"$prog" $display $noscroll $geometry $screensize $mem -title "$title" $pass "$LDESRCESYSOUT"
|
||||
|
||||
|
||||
41
sources/ADIR
41
sources/ADIR
@@ -1,15 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "31-Oct-2022 23:50:03" {WMEDLEY}<sources>ADIR.;19 66146
|
||||
(FILECREATED "11-May-2023 21:39:25" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2 65907
|
||||
|
||||
:CHANGES-TO (FNS \COPYSYS)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "31-Oct-2022 14:16:39" {WMEDLEY}<sources>ADIR.;18)
|
||||
:CHANGES-TO (FNS OPENFILE)
|
||||
|
||||
:PREVIOUS-DATE "31-Oct-2022 23:50:03"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
|
||||
@@ -92,11 +91,9 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(OPENFILE FILE 'BOTH 'OLD])
|
||||
|
||||
(OPENFILE
|
||||
[LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 23-May-91 19:12 by jds")
|
||||
(if MULTIPLE.STREAMS.PER.FILE.ALLOWED
|
||||
then (OPENSTREAM FILE ACCESS RECOG PARAMETERS OPTIONAL)
|
||||
else (fetch (STREAM FULLNAME) of (OPENSTREAM FILE ACCESS RECOG PARAMETERS
|
||||
OPTIONAL])
|
||||
[LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 11-May-2023 21:05 by lmm")
|
||||
(* ; "Edited 23-May-91 19:12 by jds")
|
||||
(FULLNAME (OPENSTREAM FILE ACCESS RECOG PARAMETERS OPTIONAL])
|
||||
|
||||
(OPENSTREAM
|
||||
[LAMBDA (FILE ACCESS RECOG PARAMETERS OBSOLETE) (* ; "Edited 13-Jun-2021 11:25 by rmk:")
|
||||
@@ -1231,17 +1228,15 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
|
||||
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
|
||||
)
|
||||
(PUTPROPS ADIR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
|
||||
1991 1992 1920 2017 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3185 14480 (DELFILE 3195 . 3356) (FULLNAME 3358 . 3725) (INFILE 3727 . 3875) (INFILEP
|
||||
3877 . 4012) (IOFILE 4014 . 4154) (OPENFILE 4156 . 4556) (OPENSTREAM 4558 . 8898) (OUTFILE 8900 . 9051
|
||||
) (OUTFILEP 9053 . 9189) (RENAMEFILE 9191 . 9497) (SIMPLE.FINDFILE 9499 . 9909) (VMEMSIZE 9911 . 10078
|
||||
) (\COPYSYS 10080 . 13199) (\FLUSHVM 13201 . 14273) (\LOGOUT0 14275 . 14478)) (14938 36843 (
|
||||
UNPACKFILENAME.STRING 14948 . 34222) (\UPF.DIRECTORY 34224 . 36841)) (38371 41043 (UNPACKFILENAME
|
||||
38381 . 38567) (LASTCHPOS 38569 . 39263) (FILENAMEFIELD 39265 . 39750) (FILENAMEFIELD.STRING 39752 .
|
||||
40331) (PACKFILENAME 40333 . 40676) (PACKFILENAME.STRING 40678 . 41041)) (55513 56426 (
|
||||
FILEDIRCASEARRAY 55523 . 56424)) (56593 63773 (LOGOUT 56603 . 57520) (MAKESYS 57522 . 59151) (SYSOUT
|
||||
59153 . 60705) (SAVEVM 60707 . 61507) (HERALD 61509 . 61669) (INTERPRET.REM.CM 61671 . 63396) (
|
||||
\USEREVENT 63398 . 63771)) (63955 65682 (USERNAME 63965 . 64921) (SETUSERNAME 64923 . 65680)))))
|
||||
(FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP
|
||||
3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944
|
||||
) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971)
|
||||
(\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 (
|
||||
UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME
|
||||
38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 .
|
||||
40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 (
|
||||
FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT
|
||||
59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) (
|
||||
\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
331
sources/AOFD
331
sources/AOFD
@@ -1,12 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Apr-2023 08:05:54" {DSK}<home>larry>il>medley>sources>AOFD.;2 37842
|
||||
(FILECREATED "11-May-2023 21:39:26" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;2 36068
|
||||
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS CLOSEALL)
|
||||
:CHANGES-TO (VARS AOFDCOMS)
|
||||
(FNS CLOSEF)
|
||||
|
||||
:PREVIOUS-DATE " 9-Aug-2021 23:30:19" {DSK}<home>larry>il>medley>sources>AOFD.;1)
|
||||
:PREVIOUS-DATE "29-Apr-2023 05:38:34"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>AOFD.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT AOFDCOMS)
|
||||
@@ -21,9 +23,8 @@
|
||||
(FNS CLOSEALL CLOSEF EOFCLOSEF INPUT OPENP OUTPUT POSITION RANDACCESSP \IOMODEP
|
||||
WHENCLOSE)
|
||||
(FNS STREAMADDPROP)
|
||||
(INITVARS (DEFAULTEOFCLOSE 'NILL)
|
||||
(\OPENFILES))
|
||||
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES))
|
||||
(INITVARS (DEFAULTEOFCLOSE 'NILL))
|
||||
(GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV))
|
||||
(COMS
|
||||
(* ;; "STREAM interface to Read and Write to random memory")
|
||||
|
||||
@@ -42,7 +43,7 @@
|
||||
|
||||
(* ;; "(DECLARE%%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT)))")
|
||||
)
|
||||
(COMS (FNS GETSTREAM \ADDOFD \CLEAROFD \DELETEOFD \GETSTREAM \SEARCHOPENFILES)
|
||||
(COMS (FNS GETSTREAM \CLEAROFD \GETSTREAM)
|
||||
(DECLARE%: DONTCOPY (EXPORT (MACROS \INSTREAMARG \OUTSTREAMARG \STREAMARG)))
|
||||
(MACROS GETOFD \GETOFD))
|
||||
(LOCALVARS . T)
|
||||
@@ -57,7 +58,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\ADD-OPEN-STREAM
|
||||
[LAMBDA (DEVICE STREAM) (* hdj "28-May-86 11:22")
|
||||
[LAMBDA (DEVICE STREAM) (* hdj "28-May-86 11:22")
|
||||
(if (NOT (STREAMP STREAM))
|
||||
then (\ILLEGAL.ARG STREAM))
|
||||
(pushnew (fetch (FDEV OPENFILELST) of DEVICE)
|
||||
@@ -65,9 +66,9 @@
|
||||
STREAM])
|
||||
|
||||
(\GENERIC-UNREGISTER-STREAM
|
||||
[LAMBDA (DEVICE STREAM) (* hdj "22-Sep-86 18:30")
|
||||
[LAMBDA (DEVICE STREAM) (* hdj "22-Sep-86 18:30")
|
||||
|
||||
(* ;;; "Remove an open stream from the list of streams kept by DEVICE. Assumes the use of the FDEV's OPENFILELSTto store the streams. Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")
|
||||
(* ;;; "Remove an open stream from the list of streams kept by DEVICE. Assumes the use of the FDEV's OPENFILELSTto store the streams. Errors if passed a stream the device doesn't know about if *ISSUE-CLOSE-WARNINGS* is non-NIL.")
|
||||
|
||||
(DECLARE (GLOBALVARS *ISSUE-CLOSE-WARNINGS*))
|
||||
(if (NOT (STREAMP STREAM))
|
||||
@@ -83,21 +84,16 @@
|
||||
(DEFINEQ
|
||||
|
||||
(CLOSEALL
|
||||
[LAMBDA (ALLFLG)
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-2023 08:05 by lmm")
|
||||
(* hdj "11-Jul-86 10:33")
|
||||
|
||||
(* ;; "(if MULTIPLE.STREAMS.PER.FILE.ALLOWED then (ERROR 'CLOSEALL no longer supported'))")
|
||||
|
||||
(* ;; "Need to APPEND because CLOSEF will remove things from \OPENFILES")
|
||||
|
||||
(for STREAM in (APPEND \OPENFILES) when [AND (fetch USERVISIBLE of STREAM)
|
||||
(\IOMODEP STREAM NIL T)
|
||||
(OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
|
||||
[LAMBDA (ALLFLG) (* ; "Edited 28-Apr-2023 20:51 by lmm")
|
||||
(for STREAM in (OPENP) when [AND (fetch USERVISIBLE of STREAM)
|
||||
(fetch USERCLOSEABLE of STREAM)
|
||||
(\IOMODEP STREAM NIL T)
|
||||
(OR ALLFLG (NOT (STREAMPROP STREAM 'CLOSEALL]
|
||||
collect (CLOSEF STREAM])
|
||||
|
||||
(CLOSEF
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:26 by rmk:")
|
||||
[LAMBDA (FILE) (* ; "Edited 11-May-2023 21:18 by lmm")
|
||||
(* ; "Edited 13-Jun-2021 11:26 by rmk:")
|
||||
(PROG ((STREAM (\GETSTREAM FILE)))
|
||||
(COND
|
||||
((OR (\OUTTERMP STREAM)
|
||||
@@ -113,10 +109,8 @@
|
||||
(COND
|
||||
((EQ STREAM *STANDARD-OUTPUT*)
|
||||
(SETQ *STANDARD-OUTPUT* \TERM.OFD)))
|
||||
(AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
|
||||
(\DELETEOFD STREAM))
|
||||
|
||||
(* ;; "Logical close before physical close; otherwise, we might have a logically open file with no physically open file behind it. (Device LPT depends on this)")
|
||||
(* ;; "Logical close before physical close; otherwise, we might have a logically open file with no physically open file behind it. (Device LPT depends on this)")
|
||||
|
||||
(\CLOSEFILE STREAM)
|
||||
[MAPC (STREAMPROP STREAM 'AFTERCLOSE)
|
||||
@@ -125,7 +119,7 @@
|
||||
(RETURN (fetch (STREAM FULLNAME) of STREAM])
|
||||
|
||||
(EOFCLOSEF
|
||||
[LAMBDA (FILE) (* bvm%: "15-Jan-85 17:58")
|
||||
[LAMBDA (FILE) (* bvm%: "15-Jan-85 17:58")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
(PROG ((STREAM (GETSTREAM FILE)))
|
||||
(APPLY* (OR (STREAMPROP STREAM 'EOFCLOSE)
|
||||
@@ -133,21 +127,21 @@
|
||||
STREAM])
|
||||
|
||||
(INPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
|
||||
(PROG1 (if (EQ *STANDARD-INPUT* \LINEBUF.OFD)
|
||||
then T
|
||||
else (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
|
||||
then *STANDARD-INPUT*
|
||||
else (fetch (STREAM FULLNAME) of *STANDARD-INPUT*)))
|
||||
then *STANDARD-INPUT*
|
||||
else (fetch (STREAM FULLNAME) of *STANDARD-INPUT*)))
|
||||
[COND
|
||||
(FILE (SETQ *STANDARD-INPUT* (COND
|
||||
((EQ FILE T) (* ;
|
||||
"Check explicitly for T to avoid needless creations")
|
||||
((EQ FILE T) (* ;
|
||||
"Check explicitly for T to avoid needless creations")
|
||||
\LINEBUF.OFD)
|
||||
(T (\GETSTREAM FILE 'INPUT])])
|
||||
|
||||
(OPENP
|
||||
[LAMBDA (FILE ACCESS) (* hdj "29-Sep-86 17:41")
|
||||
[LAMBDA (FILE ACCESS) (* hdj "29-Sep-86 17:41")
|
||||
(DECLARE (GLOBALVARS MULTIPLE.STREAMS.PER.FILE.ALLOWED \FILEDEVICES))
|
||||
(if (AND FILE (type? STREAM FILE))
|
||||
then (\GETSTREAM FILE ACCESS T)
|
||||
@@ -157,45 +151,44 @@
|
||||
\FILEDEVICES NIL])
|
||||
|
||||
(OUTPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:27 by rmk:")
|
||||
(PROG1 (if (EQ *STANDARD-OUTPUT* \TERM.OFD)
|
||||
then T
|
||||
else (if MULTIPLE.STREAMS.PER.FILE.ALLOWED
|
||||
then *STANDARD-OUTPUT*
|
||||
else (fetch (STREAM FULLNAME) of *STANDARD-OUTPUT*)))
|
||||
then *STANDARD-OUTPUT*
|
||||
else (fetch (STREAM FULLNAME) of *STANDARD-OUTPUT*)))
|
||||
[COND
|
||||
(FILE (SETQ *STANDARD-OUTPUT* (COND
|
||||
((EQ FILE T) (* ;
|
||||
"Check for this special so we don't create a tty window needlessly")
|
||||
((EQ FILE T) (* ;
|
||||
"Check for this special so we don't create a tty window needlessly")
|
||||
\TERM.OFD)
|
||||
(T (\GETSTREAM FILE 'OUTPUT])])
|
||||
|
||||
(POSITION
|
||||
[LAMBDA (FILE N) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[LAMBDA (FILE N) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
(PROG [(STRM (COND
|
||||
(FILE (\GETSTREAM FILE))
|
||||
(T *STANDARD-OUTPUT*]
|
||||
(RETURN (PROG1 (fetch CHARPOSITION of STRM)
|
||||
(COND
|
||||
(N (replace CHARPOSITION of STRM with (COND
|
||||
((IGREATERP N 0)
|
||||
N)
|
||||
(T
|
||||
(* ; "compatible with PDP-10 version")
|
||||
0])
|
||||
[COND
|
||||
(N (replace CHARPOSITION of STRM with (COND
|
||||
((IGREATERP N 0)
|
||||
N)
|
||||
(T
|
||||
(* ; "compatible with PDP-10 version")
|
||||
0])])
|
||||
|
||||
(RANDACCESSP
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:28 by rmk:")
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:28 by rmk:")
|
||||
(PROG ((STREAM (\GETSTREAM FILE)))
|
||||
(RETURN (AND (fetch (FDEV RANDOMACCESSP) of (fetch (STREAM DEVICE) of
|
||||
STREAM))
|
||||
(RETURN (AND (fetch (FDEV RANDOMACCESSP) of (fetch (STREAM DEVICE) of STREAM))
|
||||
(NEQ STREAM \LINEBUF.OFD)
|
||||
(fetch (STREAM FULLNAME) of STREAM])
|
||||
|
||||
(\IOMODEP
|
||||
[LAMBDA (STREAM ACCESS NOERROR) (* rmk%: "21-OCT-83 11:10")
|
||||
|
||||
(* ;; "Returns STREAM if it represents a File open with access mode ACCESS")
|
||||
[LAMBDA (STREAM ACCESS NOERROR) (* rmk%: "21-OCT-83 11:10")
|
||||
|
||||
(* ;; "Returns STREAM if it represents a File open with access mode ACCESS")
|
||||
|
||||
(COND
|
||||
([COND
|
||||
@@ -212,7 +205,8 @@
|
||||
(T (\FILE.NOT.OPEN STREAM NOERROR])
|
||||
|
||||
(WHENCLOSE
|
||||
[LAMBDA NARGS (* lmm " 2-Sep-84 16:07")
|
||||
[LAMBDA NARGS (* ; "Edited 28-Apr-2023 21:19 by lmm")
|
||||
(* lmm " 2-Sep-84 16:07")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
(PROG [(STREAM (AND (IGREATERP NARGS 0)
|
||||
(GETSTREAM (ARG NARGS 1]
|
||||
@@ -225,9 +219,9 @@
|
||||
(YES NIL)
|
||||
(ERRORX (LIST 27 FN])
|
||||
(BEFORE (COND
|
||||
(FN (STREAMADDPROP STREAM 'BEFORECLOSE FN T))))
|
||||
(FN (STREAMADDPROP STREAM 'BEFORECLOSE FN))))
|
||||
(AFTER (COND
|
||||
(FN (STREAMADDPROP STREAM 'AFTERCLOSE FN T))))
|
||||
(FN (STREAMADDPROP STREAM 'AFTERCLOSE FN))))
|
||||
(STATUS (STREAMPROP STREAM 'STATUSFN FN))
|
||||
(EOF (STREAMPROP STREAM 'EOFCLOSE FN))
|
||||
(ERRORX (LIST 27 (ARG NARGS I]
|
||||
@@ -241,11 +235,9 @@
|
||||
)
|
||||
|
||||
(RPAQ? DEFAULTEOFCLOSE 'NILL)
|
||||
|
||||
(RPAQ? \OPENFILES )
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES)
|
||||
(GLOBALVARS DEFAULTEOFCLOSE \STREAMSTRING.FDEV)
|
||||
)
|
||||
|
||||
|
||||
@@ -271,7 +263,7 @@
|
||||
|
||||
(\BASEBYTES.IO.INIT
|
||||
[LAMBDA NIL
|
||||
(DECLARE (GLOBALVARS \BASECHARDEVICE)) (* ; "Edited 13-Sep-90 16:27 by jds")
|
||||
(DECLARE (GLOBALVARS \BASECHARDEVICE)) (* ; "Edited 13-Sep-90 16:27 by jds")
|
||||
|
||||
(* ;; "Initialize the FDEV for base-bytes type devices (e.g. string streams).")
|
||||
|
||||
@@ -315,7 +307,7 @@
|
||||
|
||||
(replace BBSNCHARS of STREAM
|
||||
with (IDIFFERENCE (fetch COFFSET of STREAM)
|
||||
(fetch BIASOFFST of STREAM]
|
||||
(fetch BIASOFFST of STREAM]
|
||||
SETFILEPTR _ (FUNCTION \BASEBYTES.SETFILEPTR)
|
||||
GETFILEPTR _ [FUNCTION (LAMBDA (STREAM)
|
||||
(IDIFFERENCE (fetch COFFSET of STREAM)
|
||||
@@ -334,10 +326,9 @@
|
||||
(\DEFINEDEVICE NIL \BASEBYTESDEVICE])
|
||||
|
||||
(\MAKEBASEBYTESTREAM
|
||||
[LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM)
|
||||
(* ; "Edited 13-Jun-2021 11:33 by rmk:")
|
||||
[LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM) (* ; "Edited 13-Jun-2021 11:33 by rmk:")
|
||||
|
||||
(* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")
|
||||
(* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")
|
||||
|
||||
(OR BASE (EQ LEN 0)
|
||||
(SHOULDNT))
|
||||
@@ -351,53 +342,50 @@
|
||||
(\ILLEGAL.ARG ACCESS))
|
||||
(if (type? STREAM OSTREAM)
|
||||
then (if (EQ (ffetch (STREAM DEVICE) of OSTREAM)
|
||||
\BASEBYTESDEVICE)
|
||||
then (replace (STREAM ACCESS) of OSTREAM with NIL)
|
||||
else (CLOSEF OSTREAM)
|
||||
(SETQ OSTREAM (create BASEBYTESTREAM
|
||||
DEVICE _ \BASEBYTESDEVICE smashing OSTREAM)))
|
||||
\BASEBYTESDEVICE)
|
||||
then (replace (STREAM ACCESS) of OSTREAM with NIL)
|
||||
else (CLOSEF OSTREAM)
|
||||
(SETQ OSTREAM (create BASEBYTESTREAM
|
||||
DEVICE _ \BASEBYTESDEVICE smashing OSTREAM)))
|
||||
else (SETQ OSTREAM (create BASEBYTESTREAM
|
||||
DEVICE _ \BASEBYTESDEVICE)))
|
||||
DEVICE _ \BASEBYTESDEVICE)))
|
||||
(UNINTERRUPTABLY
|
||||
(freplace (STREAM USERCLOSEABLE) of OSTREAM with NIL)
|
||||
(freplace (STREAM USERVISIBLE) of OSTREAM with NIL)
|
||||
(freplace (STREAM BYTESIZE) of OSTREAM with BITSPERBYTE)
|
||||
(freplace (STREAM CPAGE) of OSTREAM with (freplace (STREAM EPAGE)
|
||||
of OSTREAM with 0))
|
||||
(freplace (STREAM CPAGE) of OSTREAM with (freplace (STREAM EPAGE) of OSTREAM with 0))
|
||||
(freplace (STREAM CBUFPTR) of OSTREAM with BASE)
|
||||
(freplace (STREAM COFFSET) of OSTREAM with (freplace (BASEBYTESTREAM
|
||||
BIASOFFST)
|
||||
of OSTREAM with OFFST))
|
||||
(freplace (STREAM CBUFSIZE) of OSTREAM with (freplace (STREAM EOFFSET)
|
||||
of OSTREAM with LEN))
|
||||
(freplace (STREAM COFFSET) of OSTREAM with (freplace (BASEBYTESTREAM BIASOFFST) of OSTREAM
|
||||
with OFFST))
|
||||
(freplace (STREAM CBUFSIZE) of OSTREAM with (freplace (STREAM EOFFSET) of OSTREAM
|
||||
with LEN))
|
||||
(replace (STREAM ACCESS) of OSTREAM with ACCESS)
|
||||
|
||||
(* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")
|
||||
(* ;; "Insures that the BINABLE BOUTABLE and EXTENDABLE bits are setup setup, and that the correct BIN and BOUT fns are 'inherited' from the FDEV as well")
|
||||
|
||||
(freplace (STREAM FULLFILENAME) of OSTREAM with NIL)
|
||||
(freplace (STREAM OUTCHARFN) of OSTREAM with (FUNCTION \MBS.OUTCHARFN))
|
||||
(freplace (STREAM LINELENGTH) of OSTREAM with 0)
|
||||
(freplace (STREAM CHARPOSITION) of OSTREAM with 0)
|
||||
(freplace (BASEBYTESTREAM WRITEXTENSIONFN) of OSTREAM with (SELECTQ ACCESS
|
||||
((OUTPUT BOTH)
|
||||
|
||||
WRITEXTENSIONFN)
|
||||
NIL))
|
||||
((OUTPUT BOTH)
|
||||
WRITEXTENSIONFN)
|
||||
NIL))
|
||||
(freplace (BASEBYTESTREAM BBSNCHARS) of OSTREAM with 0))
|
||||
OSTREAM])
|
||||
|
||||
(\MBS.OUTCHARFN
|
||||
[LAMBDA (STREAM CHAR) (* JonL " 7-NOV-83 21:54")
|
||||
[LAMBDA (STREAM CHAR) (* JonL " 7-NOV-83 21:54")
|
||||
(BOUT (SETQ STREAM (\DTEST STREAM 'STREAM))
|
||||
CHAR) (* ;
|
||||
"The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")
|
||||
CHAR) (* ;
|
||||
"The BBSNCHARS field *may* just be paralleling the CHARPOSITION field of the stream.")
|
||||
(add (ffetch BBSNCHARS of STREAM)
|
||||
1])
|
||||
|
||||
(\BASEBYTES.NAME.FROM.STREAM
|
||||
[LAMBDA (STREAM) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
|
||||
(* ;; "STRING streams have a FULLFILENAME which is just the string itself; other random basebytes streams have this field null")
|
||||
[LAMBDA (STREAM) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
|
||||
(* ;; "STRING streams have a FULLFILENAME which is just the string itself; other random basebytes streams have this field null")
|
||||
|
||||
(OR (fetch FULLFILENAME of STREAM)
|
||||
(LIST (fetch CBUFPTR of STREAM)
|
||||
@@ -405,7 +393,7 @@
|
||||
(GETEOFPTR STREAM])
|
||||
|
||||
(\BASEBYTES.BOUT
|
||||
[LAMBDA (STREAM BYTE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[LAMBDA (STREAM BYTE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
(PROG (CO)
|
||||
A (if (IGEQ (SETQ CO (fetch COFFSET of STREAM))
|
||||
(fetch EOFFSET of STREAM))
|
||||
@@ -414,11 +402,12 @@
|
||||
(GO A)
|
||||
else (ERROR "Attempt to write past end of bytes block")))
|
||||
(RETURN (\PUTBASEBYTE (fetch CBUFPTR of STREAM)
|
||||
(PROG1 CO (freplace COFFSET of STREAM with (ADD1 CO)))
|
||||
(PROG1 CO
|
||||
(freplace COFFSET of STREAM with (ADD1 CO)))
|
||||
BYTE])
|
||||
|
||||
(\BASEBYTES.SETFILEPTR
|
||||
[LAMBDA (STREAM I) (* ; "Edited 13-Sep-90 16:30 by jds")
|
||||
[LAMBDA (STREAM I) (* ; "Edited 13-Sep-90 16:30 by jds")
|
||||
|
||||
(* ;; "SETFILEPTR for string streams &c.")
|
||||
|
||||
@@ -427,14 +416,13 @@
|
||||
(if (IGREATERP I' (fetch EOFFSET of STREAM))
|
||||
then (ERROR "Beyond end of byte range" I)
|
||||
else
|
||||
(* ;; "Fix both FILEPTR and CHARPOSITION to match.")
|
||||
|
||||
(* ;; "Fix both FILEPTR and CHARPOSITION to match.")
|
||||
|
||||
(replace COFFSET of STREAM with I')
|
||||
(replace BBSNCHARS of STREAM with I'])
|
||||
(replace COFFSET of STREAM with I')
|
||||
(replace BBSNCHARS of STREAM with I'])
|
||||
|
||||
(\BASEBYTES.READP
|
||||
[LAMBDA (STREAM FLG) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[LAMBDA (STREAM FLG) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
(PROG ((CO (fetch COFFSET of STREAM))
|
||||
(%#LEFT (fetch EOFFSET of STREAM)))
|
||||
(add %#LEFT (IMINUS CO))
|
||||
@@ -447,33 +435,33 @@
|
||||
(CHARCODE CR])
|
||||
|
||||
(\BASEBYTES.BIN
|
||||
[LAMBDA (STREAM) (* JonL " 7-NOV-83 22:49")
|
||||
|
||||
(* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")
|
||||
|
||||
(* ;;
|
||||
"Remember also that the VAX version installs a different STRMBINFN for the stringstream case")
|
||||
[LAMBDA (STREAM) (* JonL " 7-NOV-83 22:49")
|
||||
|
||||
(* ;; "Normally, the microcoded version of BIN will handle this, since the BINABLE flag is set and since the COFFSET etc fields are setup appropriately")
|
||||
|
||||
(* ;;
|
||||
"Remember also that the VAX version installs a different STRMBINFN for the stringstream case")
|
||||
|
||||
(PROG1 (\BASEBYTES.PEEKBIN STREAM)
|
||||
(add (fetch COFFSET of STREAM)
|
||||
1])
|
||||
(add (fetch COFFSET of STREAM)
|
||||
1))])
|
||||
|
||||
(\BASEBYTES.PEEKBIN
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 13-Jun-2021 11:34 by rmk:")
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 13-Jun-2021 11:34 by rmk:")
|
||||
(PROG ((CO (fetch (STREAM COFFSET) of STREAM)))
|
||||
(SELECTQ (SYSTEMTYPE)
|
||||
(VAX (if (fetch (STREAM FULLNAME) of STREAM)
|
||||
then (* ; "Aha, it's a string stream")
|
||||
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
|
||||
then (* ; "Aha, it's a string stream")
|
||||
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
|
||||
NIL)
|
||||
(RETURN (if (IGEQ CO (fetch (STREAM EOFFSET) of STREAM))
|
||||
then (if (NOT NOERRORFLG)
|
||||
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
|
||||
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
|
||||
else (\GETBASEBYTE (fetch (STREAM CBUFPTR) of STREAM)
|
||||
CO])
|
||||
CO])
|
||||
|
||||
(\BASEBYTES.TRUNCATEFN
|
||||
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:20")
|
||||
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:20")
|
||||
([LAMBDA (I' BO EO)
|
||||
(add I' BO)
|
||||
(if (ILESSP I 0)
|
||||
@@ -487,7 +475,7 @@
|
||||
(fetch EOFFSET of STREAM])
|
||||
|
||||
(\BASEBYTES.OPENFN
|
||||
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
(if (fetch FULLFILENAME of NAME)
|
||||
then (OPENSTRINGSTREAM NAME ACCESS)
|
||||
else (\MAKEBASEBYTESTREAM (fetch CBUFPTR of NAME)
|
||||
@@ -498,7 +486,7 @@
|
||||
NAME])
|
||||
|
||||
(\BASEBYTES.BLOCKIO
|
||||
[LAMBDA (STREAM BASE OFFST N DIRECTION) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[LAMBDA (STREAM BASE OFFST N DIRECTION) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
(PROG (SBASE CO EO)
|
||||
A (if (ILEQ N 0)
|
||||
then (RETURN))
|
||||
@@ -508,8 +496,8 @@
|
||||
(if (IGREATERP N (IDIFFERENCE EO (SUB1 CO)))
|
||||
then (if (EQ DIRECTION 'INPUT)
|
||||
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM)
|
||||
else (* ;
|
||||
"Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")
|
||||
else (* ;
|
||||
"Do a single BOUT to see if the WRITEXTENSIONFN will fix it up")
|
||||
(BOUT STREAM (\GETBASEBYTE BASE OFFST))
|
||||
(add OFFST 1)
|
||||
(add N -1)
|
||||
@@ -531,12 +519,12 @@
|
||||
(DEFINEQ
|
||||
|
||||
(OPENSTRINGSTREAM
|
||||
[LAMBDA (STR ACCESS) (* ; "Edited 8-Aug-2021 00:02 by rmk:")
|
||||
(* rmk%: "28-Mar-85 08:40")
|
||||
[LAMBDA (STR ACCESS) (* ; "Edited 8-Aug-2021 00:02 by rmk:")
|
||||
(* rmk%: "28-Mar-85 08:40")
|
||||
|
||||
(* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")
|
||||
(* ;; "We fatten thin strings at the start so that the byte-level functions (bin, bout, getfileptr, setfrileptr) give the same (2-bytes per character) picture of the byte sequence even if we started out thin.")
|
||||
|
||||
(* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")
|
||||
(* ;; "Does not register the stream on \OPENFILES, nor does it search \OPENFILES for a previously opened stream. ")
|
||||
|
||||
(SELECTQ ACCESS
|
||||
((INPUT OUTPUT BOTH))
|
||||
@@ -546,21 +534,21 @@
|
||||
(\ILLEGAL.ARG STR))
|
||||
(LET (STREAM)
|
||||
(IF (AND (EQ ACCESS 'INPUT)
|
||||
(NOT (ffetch (STRINGP FATSTRINGP) of STR)))
|
||||
(NOT (ffetch (STRINGP FATSTRINGP) of STR)))
|
||||
THEN (\FATTENSTRING STR)
|
||||
ELSE (\SMASHABLESTRING STR T))
|
||||
|
||||
(* ;; "String storage is now fat")
|
||||
(* ;; "String storage is now fat")
|
||||
|
||||
(SETQ STREAM (\MAKEBASEBYTESTREAM (OR (ffetch (STRINGP BASE) of STR)
|
||||
T)
|
||||
T)
|
||||
(UNFOLD (ffetch (STRINGP OFFST) of STR)
|
||||
BYTESPERWORD)
|
||||
(UNFOLD (ffetch (STRINGP LENGTH) of STR)
|
||||
BYTESPERWORD)
|
||||
ACCESS))
|
||||
|
||||
(* ;; "Differences between a basebytestream and a stringstream")
|
||||
(* ;; "Differences between a basebytestream and a stringstream")
|
||||
|
||||
(\EXTERNALFORMAT STREAM :STRING)
|
||||
(freplace USERCLOSEABLE of STREAM with T)
|
||||
@@ -568,9 +556,9 @@
|
||||
STREAM])
|
||||
|
||||
(MAKE-STRING-FORMAT
|
||||
[LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:")
|
||||
|
||||
(* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")
|
||||
(* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")
|
||||
|
||||
(MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
|
||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||
@@ -579,7 +567,7 @@
|
||||
[FUNCTION (LAMBDA (STRM NOERROR)
|
||||
(CL:WHEN (\PEEKBIN STRM NOERROR)
|
||||
|
||||
(* ;; "This guards against the EOF error")
|
||||
(* ;; "This guards against the EOF error")
|
||||
|
||||
(PROG1 (LOGOR (LLSH (\BIN STRM)
|
||||
8)
|
||||
@@ -590,7 +578,7 @@
|
||||
(CL:WHEN (\BACKFILEPTR STRM)
|
||||
(IF (\BACKFILEPTR STRM)
|
||||
THEN (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 2))
|
||||
T
|
||||
T
|
||||
ELSEIF COUNTP
|
||||
THEN (SETQ *BYTECOUNTER* 1)))]
|
||||
[FUNCTION (LAMBDA (STRM CODE)
|
||||
@@ -611,17 +599,17 @@
|
||||
(DEFINEQ
|
||||
|
||||
(\STRINGSTREAM.INIT
|
||||
[LAMBDA NIL (* ; "Edited 9-Aug-2021 23:30 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 9-Aug-2021 23:30 by rmk:")
|
||||
|
||||
(* ;; "RMK: This is described as creating a file device for %"old style%" strings. But the variable that it sets is never referenced. The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")
|
||||
(* ;; "RMK: This is described as creating a file device for %"old style%" strings. But the variable that it sets is never referenced. The common lisp functions that treat strings as streams all seem to go through OPENSTRINGSTREAM, which now has a proper external format.")
|
||||
|
||||
(* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions. ")
|
||||
(* ;; "Moreover, it appears that the BIN function defined here, in terms of GNC, would have had the effect of updating the string pointer of the string as visible using ordinary string functions. ")
|
||||
|
||||
(* ;; "Finally, this appears to be read only. No BOUT is provided.")
|
||||
(* ;; "Finally, this appears to be read only. No BOUT is provided.")
|
||||
|
||||
(* ;; "")
|
||||
(* ;; "")
|
||||
|
||||
(* ;; " In sum: this is a candidate for removal.")
|
||||
(* ;; " In sum: this is a candidate for removal.")
|
||||
|
||||
(SETQ \STRINGSTREAM.FDEV (create FDEV
|
||||
DEVICENAME _ 'STRING
|
||||
@@ -644,16 +632,13 @@
|
||||
BIN _ [FUNCTION (LAMBDA (STREAM)
|
||||
(replace F2 of STREAM
|
||||
with (COND
|
||||
((fetch F1 of STREAM)
|
||||
(PROG1 (fetch F1
|
||||
of STREAM)
|
||||
(replace F1
|
||||
of STREAM
|
||||
with NIL)))
|
||||
((GNCCODE (fetch
|
||||
FULLFILENAME
|
||||
of STREAM)))
|
||||
(T (\EOF.ACTION STREAM]
|
||||
((fetch F1 of STREAM)
|
||||
(PROG1 (fetch F1 of STREAM)
|
||||
(replace F1 of STREAM
|
||||
with NIL)))
|
||||
((GNCCODE (fetch FULLFILENAME
|
||||
of STREAM)))
|
||||
(T (\EOF.ACTION STREAM]
|
||||
PEEKBIN _ [FUNCTION (LAMBDA (STREAM NOERRORFLG)
|
||||
(OR (fetch F1 of STREAM)
|
||||
(CHCON1 (fetch FULLFILENAME
|
||||
@@ -664,8 +649,7 @@
|
||||
(NOT (EOFP STREAM]
|
||||
BACKFILEPTR _ [FUNCTION (LAMBDA (STREAM)
|
||||
(replace F1 of STREAM
|
||||
with (fetch F2 of STREAM
|
||||
]
|
||||
with (fetch F2 of STREAM]
|
||||
EOFP _ (FUNCTION (LAMBDA (STREAM)
|
||||
(AND (NOT (fetch F1 of STREAM))
|
||||
(EQ (NCHARS (fetch FULLFILENAME
|
||||
@@ -680,34 +664,20 @@
|
||||
(DEFINEQ
|
||||
|
||||
(GETSTREAM
|
||||
[LAMBDA (FILE ACCESS NOERROR) (* rrb "31-Oct-85 09:36")
|
||||
(* ; "USER ENTRY")
|
||||
[LAMBDA (FILE ACCESS NOERROR) (* rrb "31-Oct-85 09:36")
|
||||
(* ; "USER ENTRY")
|
||||
(\GETSTREAM FILE ACCESS NOERROR])
|
||||
|
||||
(\ADDOFD
|
||||
[LAMBDA (STREAM) (* rmk%: "21-OCT-83 16:32")
|
||||
|
||||
(* ;; "Returns the STREAM it adds to \OPENFILES")
|
||||
|
||||
(\CLEAROFD)
|
||||
(AND (fetch NAMEDP of STREAM)
|
||||
(push \OPENFILES STREAM))
|
||||
STREAM])
|
||||
|
||||
(\CLEAROFD
|
||||
[LAMBDA NIL (* lmm "30-SEP-80 20:08")
|
||||
(* ;
|
||||
"If GETOFD caches its args, this can clear the cache")
|
||||
[LAMBDA NIL (* lmm "30-SEP-80 20:08")
|
||||
(* ;
|
||||
"If GETOFD caches its args, this can clear the cache")
|
||||
NIL])
|
||||
|
||||
(\DELETEOFD
|
||||
[LAMBDA (OFD) (* rmk%: "25-OCT-79 08:20")
|
||||
(SETQ \OPENFILES (DREMOVE OFD \OPENFILES])
|
||||
|
||||
(\GETSTREAM
|
||||
[LAMBDA (X ACCESS NOERROR) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
|
||||
(* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream. ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL. NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")
|
||||
[LAMBDA (X ACCESS NOERROR) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
|
||||
(* ;; "\GETSTREAM accepts a stream, NIL, T, or a window, and returns a corresponding stream. ACCESS is INPUT, OUTPUT, APPEND, BOTH or NIL. NOERROR, if non-NIL, means to return NIL if the file is not open in the specified access mode; otherwise, an error is caused.")
|
||||
|
||||
(DECLARE (GLOBALVARS \DEFAULTLINEBUF \DEFAULTTTYDISPLAYSTREAM))
|
||||
(COND
|
||||
@@ -751,16 +721,6 @@
|
||||
(type? WINDOW X))
|
||||
(fetch (WINDOW DSP) of X))
|
||||
(T (\FILE.NOT.OPEN X NOERROR])
|
||||
|
||||
(\SEARCHOPENFILES
|
||||
[LAMBDA (NAME ACCESS) (* ; "Edited 13-Jun-2021 11:35 by rmk:")
|
||||
|
||||
(* ;; "Returns a stream whose fullname is NAME if it has accessmode ACCESS")
|
||||
|
||||
(for STREAM in \OPENFILES when (EQ NAME (fetch (STREAM FULLNAME) of STREAM))
|
||||
do (RETURN (COND
|
||||
(ACCESS (\IOMODEP STREAM ACCESS T))
|
||||
(T STREAM])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
@@ -799,16 +759,15 @@
|
||||
(ADDTOVAR LAMA WHENCLOSE)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2459 3566 (\ADD-OPEN-STREAM 2469 . 2746) (\GENERIC-UNREGISTER-STREAM 2748 . 3564)) (
|
||||
3607 10891 (CLOSEALL 3617 . 4349) (CLOSEF 4351 . 5547) (EOFCLOSEF 5549 . 5845) (INPUT 5847 . 6619) (
|
||||
OPENP 6621 . 7020) (OUTPUT 7022 . 7796) (POSITION 7798 . 8610) (RANDACCESSP 8612 . 9087) (\IOMODEP
|
||||
9089 . 9726) (WHENCLOSE 9728 . 10889)) (10892 11014 (STREAMADDPROP 10902 . 11012)) (11989 24870 (
|
||||
\BASEBYTES.IO.INIT 11999 . 15195) (\MAKEBASEBYTESTREAM 15197 . 18509) (\MBS.OUTCHARFN 18511 . 18899) (
|
||||
\BASEBYTES.NAME.FROM.STREAM 18901 . 19364) (\BASEBYTES.BOUT 19366 . 20083) (\BASEBYTES.SETFILEPTR
|
||||
20085 . 20706) (\BASEBYTES.READP 20708 . 21344) (\BASEBYTES.BIN 21346 . 21877) (\BASEBYTES.PEEKBIN
|
||||
21879 . 22710) (\BASEBYTES.TRUNCATEFN 22712 . 23216) (\BASEBYTES.OPENFN 23218 . 23708) (
|
||||
\BASEBYTES.BLOCKIO 23710 . 24868)) (24993 28302 (OPENSTRINGSTREAM 25003 . 26720) (MAKE-STRING-FORMAT
|
||||
26722 . 28300)) (28574 33235 (\STRINGSTREAM.INIT 28584 . 33233)) (33312 36884 (GETSTREAM 33322 . 33545
|
||||
) (\ADDOFD 33547 . 33834) (\CLEAROFD 33836 . 34117) (\DELETEOFD 34119 . 34270) (\GETSTREAM 34272 .
|
||||
36436) (\SEARCHOPENFILES 36438 . 36882)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
178
sources/HIST
178
sources/HIST
@@ -1,16 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "10-Jul-91 12:07:43" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>HIST.;3| 152184
|
||||
|
||||
|changes| |to:| (VARS HISTCOMS)
|
||||
(FILECREATED "19-Apr-2023 18:58:13" |{DSK}<home>larry>il>medley>sources>HIST.;6| 152088
|
||||
|
||||
|previous| |date:| "16-May-90 18:10:04" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>HIST.;2|)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (FNS GREET0)
|
||||
|
||||
:PREVIOUS-DATE "19-Mar-2023 10:09:08" |{DSK}<home>larry>il>medley>sources>HIST.;1|)
|
||||
|
||||
; Copyright (c) 1978, 1984, 1985, 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
; The following program was created in 1978 but has not been published
|
||||
; within the meaning of the copyright law, is furnished under license,
|
||||
; and may not be used, copied and/or disclosed except in accordance
|
||||
; with the terms of said license.
|
||||
|
||||
(PRETTYCOMPRINT HISTCOMS)
|
||||
|
||||
@@ -2527,7 +2524,7 @@ this sysout is initialized for user " T)
|
||||
)
|
||||
|
||||
(ADDTOVAR SYSTEMINITVARS (LISPXHISTORY NIL 0 100 100)
|
||||
(GREETHIST))
|
||||
(GREETHIST))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(RPAQQ \#REDOCNT 3)
|
||||
@@ -2656,8 +2653,8 @@ this sysout is initialized for user " T)
|
||||
|
||||
(ADDTOVAR HISTORYSAVEFORMS )
|
||||
|
||||
(ADDTOVAR LISPXCOMS |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix| |forget|
|
||||
|name| |redo| |repeat| |retry| |undo| |use|)
|
||||
(ADDTOVAR LISPXCOMS |...| ?? FIX FORGET NAME ORIGINAL REDO REPEAT RETRY UNDO USE |fix| |forget|
|
||||
|name| |redo| |repeat| |retry| |undo| |use|)
|
||||
|
||||
(ADDTOVAR SYSTATS
|
||||
(LISPXSTATS LISPX INPUTS)
|
||||
@@ -2703,27 +2700,27 @@ this sysout is initialized for user " T)
|
||||
(ADDTOVAR NOCLEARSTKLST )
|
||||
|
||||
(APPENDTOVAR AFTERSYSOUTFORMS (COND ((LISTP SYSOUTGAG)
|
||||
(EVAL SYSOUTGAG))
|
||||
(SYSOUTGAG)
|
||||
((OR (NULL USERNAME)
|
||||
(EQ USERNAME (USERNAME NIL T)))
|
||||
(TERPRI T)
|
||||
(PRIN1 HERALDSTRING T)
|
||||
(TERPRI T)
|
||||
(TERPRI T)
|
||||
(GREET0)
|
||||
(TERPRI T))
|
||||
(T (LISPXPRIN1 '"****ATTENTION USER " T)
|
||||
(LISPXPRIN1 (USERNAME)
|
||||
T)
|
||||
(LISPXPRIN1 '":
|
||||
(EVAL SYSOUTGAG))
|
||||
(SYSOUTGAG)
|
||||
((OR (NULL USERNAME)
|
||||
(EQ USERNAME (USERNAME NIL T)))
|
||||
(TERPRI T)
|
||||
(PRIN1 HERALDSTRING T)
|
||||
(TERPRI T)
|
||||
(TERPRI T)
|
||||
(GREET0)
|
||||
(TERPRI T))
|
||||
(T (LISPXPRIN1 '"****ATTENTION USER " T)
|
||||
(LISPXPRIN1 (USERNAME)
|
||||
T)
|
||||
(LISPXPRIN1 '":
|
||||
this sysout is initialized for user " T)
|
||||
(LISPXPRIN1 USERNAME T)
|
||||
(LISPXPRIN1 '".
|
||||
(LISPXPRIN1 USERNAME T)
|
||||
(LISPXPRIN1 '".
|
||||
" T)
|
||||
(LISPXPRIN1 '"To reinitialize, type GREET()
|
||||
(LISPXPRIN1 '"To reinitialize, type GREET()
|
||||
" T)))
|
||||
(SETINITIALS))
|
||||
(SETINITIALS))
|
||||
|
||||
(MAPC SYSTATS (FUNCTION (LAMBDA (X)
|
||||
(AND (LISTP X)
|
||||
@@ -2756,46 +2753,48 @@ this sysout is initialized for user " T)
|
||||
(return t)))
|
||||
(printout t "error during GREET..." t))))
|
||||
|
||||
(greet0
|
||||
(lambda nil (* |lmm| "28-DEC-82 08:49")
|
||||
(cond
|
||||
(greetdates
|
||||
(lispxprin1
|
||||
(prog ((date (date))
|
||||
hour tem digit)
|
||||
(return (or (and (fixp (setq digit (nthchar date -1)))
|
||||
(or (and (evenp (lrsh digit 1))
|
||||
(stringp (setq tem
|
||||
(cdr (sassoc (u-case (substring date 1 6))
|
||||
greetdates)))))
|
||||
(and (evenp digit)
|
||||
(fixp (setq hour (subatom date 11 12)))
|
||||
(cond
|
||||
((and firstname (ilessp hour 6))
|
||||
(GREET0
|
||||
(LAMBDA NIL (* \; "Edited 19-Apr-2023 18:55 by lmm")
|
||||
(* \; "Edited 19-Mar-2023 09:58 by lmm")
|
||||
(* |lmm| "28-DEC-82 08:49")
|
||||
(COND
|
||||
(GREETDATES (LISPXPRIN1 (CL:MULTIPLE-VALUE-BIND
|
||||
(SECONDS MINUTES HOUR DAY MONTH YEAR)
|
||||
(CL:GET-DECODED-TIME)
|
||||
(OR (AND (EVENP (LRSH SECONDS 1))
|
||||
(CDR (SASSOC (CL:FORMAT NIL "~2D-~A" DAY
|
||||
(CL:NTH MONTH
|
||||
'("JAN" "FEB" "MAR" "APR" "MAY"
|
||||
"JUN" "JUL" "AUG" "SEP"
|
||||
"OCT" "NOV" "DEC")))
|
||||
GREETDATES)))
|
||||
(AND (EVENP SECONDS)
|
||||
(COND
|
||||
((AND FIRSTNAME (ILESSP HOUR 6))
|
||||
'"You're working late tonight")
|
||||
((ilessp hour 12)
|
||||
((ILESSP HOUR 12)
|
||||
'"Good morning")
|
||||
((ilessp hour 18)
|
||||
((ILESSP HOUR 18)
|
||||
'"Good afternoon")
|
||||
(t '"Good evening")))
|
||||
(and (evenp digit 3)
|
||||
"Hello")))
|
||||
'"Hi")))
|
||||
t)
|
||||
(cond
|
||||
(firstname (lispxprin1 '", " t)
|
||||
(lispxprin1 firstname t)))
|
||||
(lispxprin1 "." t)
|
||||
(lispxterpri t)))))
|
||||
(T '"Good evening")))
|
||||
(AND (EVENP SECONDS 3)
|
||||
"Hello")
|
||||
'"Hi"))
|
||||
T)
|
||||
(COND
|
||||
(FIRSTNAME (LISPXPRIN1 '", " T)
|
||||
(LISPXPRIN1 FIRSTNAME T)))
|
||||
(LISPXPRIN1 "." T)
|
||||
(LISPXTERPRI T)))))
|
||||
)
|
||||
|
||||
(ADDTOVAR PREGREETFORMS (DREMOVE GREETFORM RESETFORMS)
|
||||
(SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0)))
|
||||
(SETQ CONSOLETIME0 (CLOCK 0))
|
||||
(SETQ CPUTIME0 (CLOCK 2)))
|
||||
(SETQ CONSOLETIME (SETQ CPUTIME (SETQ EDITIME 0)))
|
||||
(SETQ CONSOLETIME0 (CLOCK 0))
|
||||
(SETQ CPUTIME0 (CLOCK 2)))
|
||||
|
||||
(ADDTOVAR POSTGREETFORMS (SETINITIALS)
|
||||
(AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS)))
|
||||
(AND EDITCHARACTERS (APPLY 'SETTERMCHARS EDITCHARACTERS)))
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(RPAQQ GREETHIST NIL)
|
||||
@@ -2803,21 +2802,21 @@ this sysout is initialized for user " T)
|
||||
(RPAQQ SYSTEMTYPE NIL)
|
||||
|
||||
(RPAQQ GREETFORM (LISPXEVAL '(GREET)
|
||||
'_))
|
||||
'_))
|
||||
|
||||
(RPAQQ CUTEFLG NIL)
|
||||
|
||||
(RPAQQ GREETDATES ((" 1-JAN" . "Happy new year")
|
||||
("12-FEB" . "Happy Lincoln's birthday")
|
||||
("14-FEB" . "Happy Valentine's day")
|
||||
("22-FEB" . "Happy Washington's birthday")
|
||||
("15-MAR" . "Beware the Ides of March")
|
||||
("17-MAR" . "Happy St. Patrick's day")
|
||||
("18-MAY" . "It's Victoria Day")
|
||||
(" 1-JUL" . "It's Canada Day")
|
||||
("31-OCT" . "Trick or Treat")
|
||||
(" 5-NOV" . "<boom> it's Guy Fawkes day")
|
||||
("25-DEC" . "Merry Christmas")))
|
||||
("12-FEB" . "Happy Lincoln's birthday")
|
||||
("14-FEB" . "Happy Valentine's day")
|
||||
("22-FEB" . "Happy Washington's birthday")
|
||||
("15-MAR" . "Beware the Ides of March")
|
||||
("17-MAR" . "Happy St. Patrick's day")
|
||||
("18-MAY" . "It's Victoria Day")
|
||||
(" 1-JUL" . "It's Canada Day")
|
||||
("31-OCT" . "Trick or Treat")
|
||||
(" 5-NOV" . "<boom> it's Guy Fawkes day")
|
||||
("25-DEC" . "Merry Christmas")))
|
||||
|
||||
(RPAQQ USERNAME NIL)
|
||||
|
||||
@@ -2837,11 +2836,11 @@ this sysout is initialized for user " T)
|
||||
|
||||
|
||||
(ADDTOVAR BEFOREMAKESYSFORMS (SETQ RESETFORMS (CONS GREETFORM RESETFORMS))
|
||||
(SETQ MAKESYSDATE (DATE)))
|
||||
(SETQ MAKESYSDATE (DATE)))
|
||||
|
||||
|
||||
(ADDTOVAR AFTERMAKESYSFORMS (LISPXEVAL '(GREET)
|
||||
'_))
|
||||
'_))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -3038,21 +3037,20 @@ this sysout is initialized for user " T)
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS HIST COPYRIGHT ("Venue & Xerox Corporation" T 1978 1984 1985 1986 1987 1988 1990 1991))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (14585 21330 (PRINTHISTORY 14595 . 16385) (ENTRY# 16387 . 16722) (PRINTHISTORY1 16724 .
|
||||
19893) (PRINTHISTORY2 19895 . 21328)) (21331 129761 (EVALQT 21341 . 22141) (ENTEREVALQT 22143 . 22698)
|
||||
(USEREXEC 22700 . 23335) (LISPXREAD 23337 . 25140) (LISPXREADBUF 25142 . 27368) (LISPXREADP 27370 .
|
||||
27919) (LISPXUNREAD 27921 . 28214) (LISPX 28216 . 63911) (LISPX/ 63913 . 65367) (LISPX/1 65369 . 70655
|
||||
) (LISPXEVAL 70657 . 71281) (LISPXSTOREVALUE 71283 . 71537) (HISTORYSAVE 71539 . 78823) (LISPXFIND
|
||||
78825 . 86260) (LISPXGETINPUT 86262 . 86475) (REMEMBER 86477 . 86671) (GETEXPRESSIONFROMEVENTSPEC
|
||||
86673 . 88783) (LISPXFIND0 88785 . 93059) (LISPXFIND1 93061 . 93489) (HISTORYFIND 93491 . 99065) (
|
||||
HISTORYFIND1 99067 . 102512) (HISTORYMATCH 102514 . 102589) (VALUEOF 102591 . 103616) (VALUOF 103618
|
||||
. 104508) (VALUOF-EVENT 104510 . 104915) (LISPXUSE 104917 . 111336) (LISPXUSE0 111338 . 114064) (
|
||||
LISPXUSE1 114066 . 115691) (LISPXSUBST 115693 . 116113) (LISPXUSEC 116115 . 124356) (LISPXFIX 124358
|
||||
. 125208) (CHANGESLICE 125210 . 127057) (LISPXSTATE 127059 . 128153) (LISPXTYPEAHEAD 128155 . 129759)
|
||||
) (137892 140620 (GREET 137902 . 139043) (GREET0 139045 . 140618)) (142290 149466 (LISPXPRINT 142300
|
||||
. 142864) (LISPXPRIN1 142866 . 143750) (LISPXPRIN2 143752 . 144694) (LISPXPRINTDEF 144696 . 145250) (
|
||||
LISPXPRINTDEF0 145252 . 145615) (LISPXSPACES 145617 . 146303) (LISPXTERPRI 146305 . 146930) (LISPXTAB
|
||||
146932 . 147490) (USERLISPXPRINT 147492 . 148892) (LISPXPUT 148894 . 149464)))))
|
||||
(FILEMAP (NIL (14244 20989 (PRINTHISTORY 14254 . 16044) (ENTRY# 16046 . 16381) (PRINTHISTORY1 16383 .
|
||||
19552) (PRINTHISTORY2 19554 . 20987)) (20990 129420 (EVALQT 21000 . 21800) (ENTEREVALQT 21802 . 22357)
|
||||
(USEREXEC 22359 . 22994) (LISPXREAD 22996 . 24799) (LISPXREADBUF 24801 . 27027) (LISPXREADP 27029 .
|
||||
27578) (LISPXUNREAD 27580 . 27873) (LISPX 27875 . 63570) (LISPX/ 63572 . 65026) (LISPX/1 65028 . 70314
|
||||
) (LISPXEVAL 70316 . 70940) (LISPXSTOREVALUE 70942 . 71196) (HISTORYSAVE 71198 . 78482) (LISPXFIND
|
||||
78484 . 85919) (LISPXGETINPUT 85921 . 86134) (REMEMBER 86136 . 86330) (GETEXPRESSIONFROMEVENTSPEC
|
||||
86332 . 88442) (LISPXFIND0 88444 . 92718) (LISPXFIND1 92720 . 93148) (HISTORYFIND 93150 . 98724) (
|
||||
HISTORYFIND1 98726 . 102171) (HISTORYMATCH 102173 . 102248) (VALUEOF 102250 . 103275) (VALUOF 103277
|
||||
. 104167) (VALUOF-EVENT 104169 . 104574) (LISPXUSE 104576 . 110995) (LISPXUSE0 110997 . 113723) (
|
||||
LISPXUSE1 113725 . 115350) (LISPXSUBST 115352 . 115772) (LISPXUSEC 115774 . 124015) (LISPXFIX 124017
|
||||
. 124867) (CHANGESLICE 124869 . 126716) (LISPXSTATE 126718 . 127812) (LISPXTYPEAHEAD 127814 . 129418)
|
||||
) (137472 140690 (GREET 137482 . 138623) (GREET0 138625 . 140688)) (142292 149468 (LISPXPRINT 142302
|
||||
. 142866) (LISPXPRIN1 142868 . 143752) (LISPXPRIN2 143754 . 144696) (LISPXPRINTDEF 144698 . 145252) (
|
||||
LISPXPRINTDEF0 145254 . 145617) (LISPXSPACES 145619 . 146305) (LISPXTERPRI 146307 . 146932) (LISPXTAB
|
||||
146934 . 147492) (USERLISPXPRINT 147494 . 148894) (LISPXPUT 148896 . 149466)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
808
sources/LEAF
808
sources/LEAF
@@ -1,19 +1,18 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Jan-93 10:41:31" {DSK}<python>lde>lispcore>sources>LEAF.;2 745474Q
|
||||
|
||||
changes to%: (RECORDS SEQUINPACKET SEQUIN LOOKUPFILEDATA LEAFDATA LEAFERRORDATA LEAFPARAMSDATA
|
||||
LEAFPACKET LEAFINFOBLOCK LEAFSTREAM LEAFDEVICE PUPFILESERVER)
|
||||
(FILECREATED "11-May-2023 21:39:24" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>LEAF.;2 741527Q
|
||||
|
||||
previous date%: " 4-Jan-93 23:36:15" {DSK}<python>lde>lispcore>sources>LEAF.;1)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS LEAFCOMPILETIMECOMS)
|
||||
|
||||
:PREVIOUS-DATE "19-Jan-93 10:41:31" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>LEAF.;1
|
||||
)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LEAFCOMS)
|
||||
|
||||
(RPAQQ LEAFCOMS
|
||||
(RPAQQ LEAFCOMS
|
||||
(
|
||||
|
||||
(* ;;; "Support for the Leaf random-access filing protocol")
|
||||
@@ -53,7 +52,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venu
|
||||
|
||||
(FNS \OPENLEAFCONNECTION \LEAF.BREAKCONNECTION \CLOSELEAFCONNECTION \LEAF.EVENTFN)
|
||||
(* ;
|
||||
"This generic fn ought to be on FILEIO")
|
||||
"This generic fn ought to be on FILEIO")
|
||||
(FNS BREAKCONNECTION))
|
||||
(COMS
|
||||
(* ;; "Functions called when various SEQUIN events occur")
|
||||
@@ -111,137 +110,138 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venu
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ SEQUINCOMS ((RECORDS SEQUINPACKET SEQUIN)
|
||||
(CONSTANTS * SEQUINOPS)
|
||||
(CONSTANTS * SEQUINSTATES)
|
||||
(CONSTANTS (\SC.EQUAL 0)
|
||||
(\SC.PREVIOUS 1)
|
||||
(\SC.DUPLICATE 2)
|
||||
(\SC.AHEAD 3)
|
||||
(\SC.OUTOFRANGE 4)
|
||||
(\PT.SEQUIN 260Q)
|
||||
(\SS.NOSOCKET 10Q)
|
||||
(\SEQUIN.DEFAULT.ALLOCATION 12Q)
|
||||
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
|
||||
(MACROS SEQUINOP)))
|
||||
(RPAQQ SEQUINCOMS
|
||||
((RECORDS SEQUINPACKET SEQUIN)
|
||||
(CONSTANTS * SEQUINOPS)
|
||||
(CONSTANTS * SEQUINSTATES)
|
||||
(CONSTANTS (\SC.EQUAL 0)
|
||||
(\SC.PREVIOUS 1)
|
||||
(\SC.DUPLICATE 2)
|
||||
(\SC.AHEAD 3)
|
||||
(\SC.OUTOFRANGE 4)
|
||||
(\PT.SEQUIN 260Q)
|
||||
(\SS.NOSOCKET 10Q)
|
||||
(\SEQUIN.DEFAULT.ALLOCATION 12Q)
|
||||
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
|
||||
(MACROS SEQUINOP)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS SEQUINPACKET ((SEQUINSTART (fetch PUPBASE of DATUM)))
|
||||
(BLOCKRECORD SEQUINSTART ((NIL 2 WORD)
|
||||
(BLOCKRECORD SEQUINSTART ((NIL 2 WORD)
|
||||
(* ; "Pup length, typeword")
|
||||
(ALLOCATE BYTE)
|
||||
(RECEIVESEQ BYTE)
|
||||
(SEQCONTROL BYTE)
|
||||
(SENDSEQ BYTE)
|
||||
(ALLOCATE BYTE)
|
||||
(RECEIVESEQ BYTE)
|
||||
(SEQCONTROL BYTE)
|
||||
(SENDSEQ BYTE)
|
||||
(* ;
|
||||
"Sequin uses ID fields of PUP for control info")
|
||||
)))
|
||||
"Sequin uses ID fields of PUP for control info")
|
||||
)))
|
||||
|
||||
(DATATYPE SEQUIN (
|
||||
(* ;; "First: stuff used by SEQUIN level")
|
||||
(* ;; "First: stuff used by SEQUIN level")
|
||||
|
||||
(SEQNAME POINTER) (* ; "Name of partner")
|
||||
(SEQFRNPORT POINTER) (* ; "Foreign socket")
|
||||
(SEQSOCKET POINTER) (* ; "Local socket")
|
||||
(SEQSTATE BYTE) (* ; "Sequin connection state")
|
||||
(MYSENDSEQ BYTE) (* ;
|
||||
"Number I will next send. These must be byte fields so that they will wrap around correctly!")
|
||||
(MYRECEIVESEQ BYTE) (* ;
|
||||
"Number I next expect to receive, i.e. Partner's Send number of first unacked packet")
|
||||
(LASTACKEDSEQ BYTE) (* ;
|
||||
"Last Receive seq from partner: all packets with sequence numbers before this one have been acked")
|
||||
(SEQOUTALLOC WORD) (* ;
|
||||
"Output allocation: the number of packets I may send without their being acked")
|
||||
(SEQINALLOC WORD) (* ;
|
||||
"Input allocation: what I tell my partner")
|
||||
(SEQMAXALLOC WORD) (* ;
|
||||
"The largest I will let output allocation get")
|
||||
(%#UNACKEDSEQS WORD) (* ;
|
||||
"Number of data packets we have sent for which no acks have been received")
|
||||
(SEQINPUTQLENGTH WORD) (* ;
|
||||
"Number of packets in input (done) queue")
|
||||
(SEQTIMEOUT WORD) (* ; "Timeout before retransmission")
|
||||
(SEQBASETIMEOUT WORD) (* ;
|
||||
"Timeout for this connection in general")
|
||||
(SEQRETRANSMITMAX WORD) (* ;
|
||||
"How many times to retransmit before complaining")
|
||||
(%#SEQRESTARTS WORD) (* ; "Some statistical info...")
|
||||
(%#SEQRETRANSMITS WORD)
|
||||
(%#SEQDUPLICATES WORD)
|
||||
(%#SEQTIMEOUTS WORD)
|
||||
(%#SEQTURNOVERS WORD)
|
||||
(SEQRETRANSMITQ POINTER) (* ; "Sequin output queue")
|
||||
(SEQTIMER POINTER)
|
||||
(SEQPROCESS POINTER)
|
||||
(SEQIGNOREDUPLICATES FLAG)
|
||||
(SEQRETRANSMITTING FLAG)
|
||||
(SEQCLOSEME FLAG)
|
||||
(SEQCLOSEDFORLOGOUT FLAG)
|
||||
(SEQLASTRESTARTTIMER POINTER) (* ;
|
||||
"Allows for some aging of the connection timeout")
|
||||
(SEQLASTRESTART POINTER)
|
||||
(SEQRETRANSMITNEXT POINTER)
|
||||
(SEQEVENT POINTER) (* ;
|
||||
"Signaled when there is input, state changed, or allocation changed")
|
||||
(SEQLOCK POINTER) (* ; "Monitor lock for this structure")
|
||||
(SEQNAME POINTER) (* ; "Name of partner")
|
||||
(SEQFRNPORT POINTER) (* ; "Foreign socket")
|
||||
(SEQSOCKET POINTER) (* ; "Local socket")
|
||||
(SEQSTATE BYTE) (* ; "Sequin connection state")
|
||||
(MYSENDSEQ BYTE) (* ;
|
||||
"Number I will next send. These must be byte fields so that they will wrap around correctly!")
|
||||
(MYRECEIVESEQ BYTE) (* ;
|
||||
"Number I next expect to receive, i.e. Partner's Send number of first unacked packet")
|
||||
(LASTACKEDSEQ BYTE) (* ;
|
||||
"Last Receive seq from partner: all packets with sequence numbers before this one have been acked")
|
||||
(SEQOUTALLOC WORD) (* ;
|
||||
"Output allocation: the number of packets I may send without their being acked")
|
||||
(SEQINALLOC WORD) (* ;
|
||||
"Input allocation: what I tell my partner")
|
||||
(SEQMAXALLOC WORD) (* ;
|
||||
"The largest I will let output allocation get")
|
||||
(%#UNACKEDSEQS WORD) (* ;
|
||||
"Number of data packets we have sent for which no acks have been received")
|
||||
(SEQINPUTQLENGTH WORD) (* ;
|
||||
"Number of packets in input (done) queue")
|
||||
(SEQTIMEOUT WORD) (* ; "Timeout before retransmission")
|
||||
(SEQBASETIMEOUT WORD) (* ;
|
||||
"Timeout for this connection in general")
|
||||
(SEQRETRANSMITMAX WORD) (* ;
|
||||
"How many times to retransmit before complaining")
|
||||
(%#SEQRESTARTS WORD) (* ; "Some statistical info...")
|
||||
(%#SEQRETRANSMITS WORD)
|
||||
(%#SEQDUPLICATES WORD)
|
||||
(%#SEQTIMEOUTS WORD)
|
||||
(%#SEQTURNOVERS WORD)
|
||||
(SEQRETRANSMITQ POINTER) (* ; "Sequin output queue")
|
||||
(SEQTIMER POINTER)
|
||||
(SEQPROCESS POINTER)
|
||||
(SEQIGNOREDUPLICATES FLAG)
|
||||
(SEQRETRANSMITTING FLAG)
|
||||
(SEQCLOSEME FLAG)
|
||||
(SEQCLOSEDFORLOGOUT FLAG)
|
||||
(SEQLASTRESTARTTIMER POINTER) (* ;
|
||||
"Allows for some aging of the connection timeout")
|
||||
(SEQLASTRESTART POINTER)
|
||||
(SEQRETRANSMITNEXT POINTER)
|
||||
(SEQEVENT POINTER) (* ;
|
||||
"Signaled when there is input, state changed, or allocation changed")
|
||||
(SEQLOCK POINTER) (* ; "Monitor lock for this structure")
|
||||
|
||||
(* ;; "Second-level functions invoked by SEQUIN")
|
||||
(* ;; "Second-level functions invoked by SEQUIN")
|
||||
|
||||
(SEQACKED POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP is acked")
|
||||
(SEQINPUT POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP arrives as input data")
|
||||
(SEQBROKEN POINTER) (* ; "(SEQUIN PUP) called when a BROKEN sequin arrives (PUP = NIL) or attempt to send PUP on broken connection")
|
||||
(SEQABORTED POINTER) (* ;
|
||||
"(SEQUIN) called when PUP arrives with outlandish sequence numbers")
|
||||
(SEQTIMEDOUT POINTER) (* ;
|
||||
"(SEQUIN) called when about to retransmit SEQRETRANSMITMAX times")
|
||||
(SEQCLOSED POINTER) (* ;
|
||||
"(SEQUIN) called when a connection is flushed, but before its retransmit queue is flushed")
|
||||
(SEQIDLETIMEOUTCOMPUTER POINTER) (* ; "Computes timeout before calling SEQIDLEFN when no activity on connection. T means forever, NIL means don't")
|
||||
(SEQIDLEFN POINTER) (* ;
|
||||
"Called when nothing otherwise is happening, after timeout of SEQIDLETIMEOUT")
|
||||
(SEQACKED POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP is acked")
|
||||
(SEQINPUT POINTER) (* ;
|
||||
"(PUP SEQUIN) called when PUP arrives as input data")
|
||||
(SEQBROKEN POINTER) (* ; "(SEQUIN PUP) called when a BROKEN sequin arrives (PUP = NIL) or attempt to send PUP on broken connection")
|
||||
(SEQABORTED POINTER) (* ;
|
||||
"(SEQUIN) called when PUP arrives with outlandish sequence numbers")
|
||||
(SEQTIMEDOUT POINTER) (* ;
|
||||
"(SEQUIN) called when about to retransmit SEQRETRANSMITMAX times")
|
||||
(SEQCLOSED POINTER) (* ;
|
||||
"(SEQUIN) called when a connection is flushed, but before its retransmit queue is flushed")
|
||||
(SEQIDLETIMEOUTCOMPUTER POINTER) (* ; "Computes timeout before calling SEQIDLEFN when no activity on connection. T means forever, NIL means don't")
|
||||
(SEQIDLEFN POINTER) (* ;
|
||||
"Called when nothing otherwise is happening, after timeout of SEQIDLETIMEOUT")
|
||||
|
||||
(* ;; "Stuff used by clients of SEQUIN, in particular, LEAF")
|
||||
(* ;; "Stuff used by clients of SEQUIN, in particular, LEAF")
|
||||
|
||||
(SEQDONEQ POINTER) (* ;
|
||||
"Sequins acked but kept around for further handling")
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(LEAFCACHEDFILE POINTER) (* ;
|
||||
"Last file accessed, to speed up repeated lookups of same name")
|
||||
(LEAFCACHETIMER POINTER) (* ; "To timeout the cache")
|
||||
(LEAFCACHEHITS WORD)
|
||||
(LEAFCACHEMISSES WORD)
|
||||
(LEAFTIMEOUTCOUNT WORD)
|
||||
(LEAFCLOSING FLAG)
|
||||
(LEAFOPENCLOSELOCK POINTER) (* ;
|
||||
"Monitor lock to keep GETFILE and CLOSEFILE from stepping on each other")
|
||||
(LEAFABORTBUTTONWINDOW POINTER)
|
||||
(LEAFABORTSTATUS POINTER)
|
||||
(LEAFTIMEOUTSTATUS POINTER)
|
||||
(SEQTIMEDIN POINTER)
|
||||
(NIL POINTER)
|
||||
(SEQOPENERRORHANDLER POINTER) (* ;
|
||||
"(SEQUIN PUP) called on errors trying to open connection")
|
||||
)
|
||||
SEQSTATE _ \SS.UNOPENED SEQOUTALLOC _ 1 SEQINALLOC _ \SEQUIN.DEFAULT.ALLOCATION
|
||||
SEQRETRANSMITMAX _ \SEQUIN.DEFAULT.RETRANSMITMAX SEQRETRANSMITQ _
|
||||
(NCREATE 'SYSQUEUE)
|
||||
SEQTIMEOUT _ \ETHERTIMEOUT SEQBASETIMEOUT _ \ETHERTIMEOUT SEQTIMER _
|
||||
(\CREATECELL \FIXP)
|
||||
SEQLASTRESTARTTIMER _ (\CREATECELL \FIXP)
|
||||
SEQMAXALLOC _ 12Q SEQACKED _ (FUNCTION NILL)
|
||||
SEQBROKEN _ (FUNCTION NILL)
|
||||
SEQABORTED _ (FUNCTION NILL)
|
||||
SEQABORTED _ (FUNCTION NILL)
|
||||
SEQTIMEDOUT _ (FUNCTION NILL)
|
||||
SEQCLOSED _ (FUNCTION NILL)
|
||||
SEQIDLETIMEOUTCOMPUTER _ (FUNCTION NILL)
|
||||
SEQIDLEFN _ (FUNCTION NILL)
|
||||
SEQTIMEDIN _ (FUNCTION NILL)
|
||||
SEQOPENERRORHANDLER _ (FUNCTION NILL)
|
||||
(SYNONYM SEQDONEQ (INPUTQ)))
|
||||
(SEQDONEQ POINTER) (* ;
|
||||
"Sequins acked but kept around for further handling")
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(LEAFCACHEDFILE POINTER) (* ;
|
||||
"Last file accessed, to speed up repeated lookups of same name")
|
||||
(LEAFCACHETIMER POINTER) (* ; "To timeout the cache")
|
||||
(LEAFCACHEHITS WORD)
|
||||
(LEAFCACHEMISSES WORD)
|
||||
(LEAFTIMEOUTCOUNT WORD)
|
||||
(LEAFCLOSING FLAG)
|
||||
(LEAFOPENCLOSELOCK POINTER) (* ;
|
||||
"Monitor lock to keep GETFILE and CLOSEFILE from stepping on each other")
|
||||
(LEAFABORTBUTTONWINDOW POINTER)
|
||||
(LEAFABORTSTATUS POINTER)
|
||||
(LEAFTIMEOUTSTATUS POINTER)
|
||||
(SEQTIMEDIN POINTER)
|
||||
(NIL POINTER)
|
||||
(SEQOPENERRORHANDLER POINTER) (* ;
|
||||
"(SEQUIN PUP) called on errors trying to open connection")
|
||||
)
|
||||
SEQSTATE _ \SS.UNOPENED SEQOUTALLOC _ 1 SEQINALLOC _ \SEQUIN.DEFAULT.ALLOCATION
|
||||
SEQRETRANSMITMAX _ \SEQUIN.DEFAULT.RETRANSMITMAX SEQRETRANSMITQ _
|
||||
(NCREATE 'SYSQUEUE)
|
||||
SEQTIMEOUT _ \ETHERTIMEOUT SEQBASETIMEOUT _ \ETHERTIMEOUT SEQTIMER _ (\CREATECELL
|
||||
\FIXP)
|
||||
SEQLASTRESTARTTIMER _ (\CREATECELL \FIXP)
|
||||
SEQMAXALLOC _ 12Q SEQACKED _ (FUNCTION NILL)
|
||||
SEQBROKEN _ (FUNCTION NILL)
|
||||
SEQABORTED _ (FUNCTION NILL)
|
||||
SEQABORTED _ (FUNCTION NILL)
|
||||
SEQTIMEDOUT _ (FUNCTION NILL)
|
||||
SEQCLOSED _ (FUNCTION NILL)
|
||||
SEQIDLETIMEOUTCOMPUTER _ (FUNCTION NILL)
|
||||
SEQIDLEFN _ (FUNCTION NILL)
|
||||
SEQTIMEDIN _ (FUNCTION NILL)
|
||||
SEQOPENERRORHANDLER _ (FUNCTION NILL)
|
||||
(SYNONYM SEQDONEQ (INPUTQ)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'SEQUIN
|
||||
@@ -308,17 +308,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venu
|
||||
(SEQUIN 116Q POINTER))
|
||||
'120Q)
|
||||
|
||||
(RPAQQ SEQUINOPS ((\SEQUIN.DATA 0)
|
||||
(\SEQUIN.ACK 1)
|
||||
(\SEQUIN.NOOP 2)
|
||||
(\SEQUIN.RESTART 3)
|
||||
(\SEQUIN.OPEN 5)
|
||||
(\SEQUIN.BREAK 6)
|
||||
(\SEQUIN.OBSOLETE.CLOSE 7)
|
||||
(\SEQUIN.DESTROY 11Q)
|
||||
(\SEQUIN.DALLYING 12Q)
|
||||
(\SEQUIN.QUIT 13Q)
|
||||
(\SEQUIN.BROKEN 14Q)))
|
||||
(RPAQQ SEQUINOPS
|
||||
((\SEQUIN.DATA 0)
|
||||
(\SEQUIN.ACK 1)
|
||||
(\SEQUIN.NOOP 2)
|
||||
(\SEQUIN.RESTART 3)
|
||||
(\SEQUIN.OPEN 5)
|
||||
(\SEQUIN.BREAK 6)
|
||||
(\SEQUIN.OBSOLETE.CLOSE 7)
|
||||
(\SEQUIN.DESTROY 11Q)
|
||||
(\SEQUIN.DALLYING 12Q)
|
||||
(\SEQUIN.QUIT 13Q)
|
||||
(\SEQUIN.BROKEN 14Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SEQUIN.DATA 0)
|
||||
@@ -358,14 +359,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venu
|
||||
)
|
||||
|
||||
(RPAQQ SEQUINSTATES ((\SS.UNOPENED 0)
|
||||
(\SS.OPEN 1)
|
||||
(\SS.DALLYING 2)
|
||||
(\SS.ABORT 3)
|
||||
(\SS.DESTROYED 4)
|
||||
(\SS.TIMEDOUT 5)
|
||||
(\SS.CLOSING 6)
|
||||
(\SS.OPENING 7)
|
||||
(\SS.CLOSED 10Q)))
|
||||
(\SS.OPEN 1)
|
||||
(\SS.DALLYING 2)
|
||||
(\SS.ABORT 3)
|
||||
(\SS.DESTROYED 4)
|
||||
(\SS.TIMEDOUT 5)
|
||||
(\SS.CLOSING 6)
|
||||
(\SS.OPENING 7)
|
||||
(\SS.CLOSED 10Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \SS.UNOPENED 0)
|
||||
@@ -430,8 +431,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venu
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS SEQUINOP MACRO ((SEQ OP . ARGS)
|
||||
(APPLY* (fetch (SEQUIN OP) of SEQ) . ARGS]
|
||||
(PUTPROPS SEQUINOP MACRO ((SEQ OP . ARGS)
|
||||
(APPLY* (fetch (SEQUIN OP) of SEQ) . ARGS)))
|
||||
)
|
||||
|
||||
|
||||
@@ -505,61 +506,61 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1993 by Venu
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE SEQUIN ((SEQNAME POINTER)
|
||||
(SEQFRNPORT POINTER)
|
||||
(SEQSOCKET POINTER)
|
||||
(SEQSTATE BYTE)
|
||||
(MYSENDSEQ BYTE)
|
||||
(MYRECEIVESEQ BYTE)
|
||||
(LASTACKEDSEQ BYTE)
|
||||
(SEQOUTALLOC WORD)
|
||||
(SEQINALLOC WORD)
|
||||
(SEQMAXALLOC WORD)
|
||||
(%#UNACKEDSEQS WORD)
|
||||
(SEQINPUTQLENGTH WORD)
|
||||
(SEQTIMEOUT WORD)
|
||||
(SEQBASETIMEOUT WORD)
|
||||
(SEQRETRANSMITMAX WORD)
|
||||
(%#SEQRESTARTS WORD)
|
||||
(%#SEQRETRANSMITS WORD)
|
||||
(%#SEQDUPLICATES WORD)
|
||||
(%#SEQTIMEOUTS WORD)
|
||||
(%#SEQTURNOVERS WORD)
|
||||
(SEQRETRANSMITQ POINTER)
|
||||
(SEQTIMER POINTER)
|
||||
(SEQPROCESS POINTER)
|
||||
(SEQIGNOREDUPLICATES FLAG)
|
||||
(SEQRETRANSMITTING FLAG)
|
||||
(SEQCLOSEME FLAG)
|
||||
(SEQCLOSEDFORLOGOUT FLAG)
|
||||
(SEQLASTRESTARTTIMER POINTER)
|
||||
(SEQLASTRESTART POINTER)
|
||||
(SEQRETRANSMITNEXT POINTER)
|
||||
(SEQEVENT POINTER)
|
||||
(SEQLOCK POINTER)
|
||||
(SEQACKED POINTER)
|
||||
(SEQINPUT POINTER)
|
||||
(SEQBROKEN POINTER)
|
||||
(SEQABORTED POINTER)
|
||||
(SEQTIMEDOUT POINTER)
|
||||
(SEQCLOSED POINTER)
|
||||
(SEQIDLETIMEOUTCOMPUTER POINTER)
|
||||
(SEQIDLEFN POINTER)
|
||||
(SEQDONEQ POINTER)
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(LEAFCACHEDFILE POINTER)
|
||||
(LEAFCACHETIMER POINTER)
|
||||
(LEAFCACHEHITS WORD)
|
||||
(LEAFCACHEMISSES WORD)
|
||||
(LEAFTIMEOUTCOUNT WORD)
|
||||
(LEAFCLOSING FLAG)
|
||||
(LEAFOPENCLOSELOCK POINTER)
|
||||
(LEAFABORTBUTTONWINDOW POINTER)
|
||||
(LEAFABORTSTATUS POINTER)
|
||||
(LEAFTIMEOUTSTATUS POINTER)
|
||||
(SEQTIMEDIN POINTER)
|
||||
(NIL POINTER)
|
||||
(SEQOPENERRORHANDLER POINTER)))
|
||||
(SEQFRNPORT POINTER)
|
||||
(SEQSOCKET POINTER)
|
||||
(SEQSTATE BYTE)
|
||||
(MYSENDSEQ BYTE)
|
||||
(MYRECEIVESEQ BYTE)
|
||||
(LASTACKEDSEQ BYTE)
|
||||
(SEQOUTALLOC WORD)
|
||||
(SEQINALLOC WORD)
|
||||
(SEQMAXALLOC WORD)
|
||||
(%#UNACKEDSEQS WORD)
|
||||
(SEQINPUTQLENGTH WORD)
|
||||
(SEQTIMEOUT WORD)
|
||||
(SEQBASETIMEOUT WORD)
|
||||
(SEQRETRANSMITMAX WORD)
|
||||
(%#SEQRESTARTS WORD)
|
||||
(%#SEQRETRANSMITS WORD)
|
||||
(%#SEQDUPLICATES WORD)
|
||||
(%#SEQTIMEOUTS WORD)
|
||||
(%#SEQTURNOVERS WORD)
|
||||
(SEQRETRANSMITQ POINTER)
|
||||
(SEQTIMER POINTER)
|
||||
(SEQPROCESS POINTER)
|
||||
(SEQIGNOREDUPLICATES FLAG)
|
||||
(SEQRETRANSMITTING FLAG)
|
||||
(SEQCLOSEME FLAG)
|
||||
(SEQCLOSEDFORLOGOUT FLAG)
|
||||
(SEQLASTRESTARTTIMER POINTER)
|
||||
(SEQLASTRESTART POINTER)
|
||||
(SEQRETRANSMITNEXT POINTER)
|
||||
(SEQEVENT POINTER)
|
||||
(SEQLOCK POINTER)
|
||||
(SEQACKED POINTER)
|
||||
(SEQINPUT POINTER)
|
||||
(SEQBROKEN POINTER)
|
||||
(SEQABORTED POINTER)
|
||||
(SEQTIMEDOUT POINTER)
|
||||
(SEQCLOSED POINTER)
|
||||
(SEQIDLETIMEOUTCOMPUTER POINTER)
|
||||
(SEQIDLEFN POINTER)
|
||||
(SEQDONEQ POINTER)
|
||||
(NIL POINTER)
|
||||
(NIL POINTER)
|
||||
(LEAFCACHEDFILE POINTER)
|
||||
(LEAFCACHETIMER POINTER)
|
||||
(LEAFCACHEHITS WORD)
|
||||
(LEAFCACHEMISSES WORD)
|
||||
(LEAFTIMEOUTCOUNT WORD)
|
||||
(LEAFCLOSING FLAG)
|
||||
(LEAFOPENCLOSELOCK POINTER)
|
||||
(LEAFABORTBUTTONWINDOW POINTER)
|
||||
(LEAFABORTSTATUS POINTER)
|
||||
(LEAFTIMEOUTSTATUS POINTER)
|
||||
(SEQTIMEDIN POINTER)
|
||||
(NIL POINTER)
|
||||
(SEQOPENERRORHANDLER POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -3664,9 +3665,9 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ LOOKUPFILECOMS ((CONSTANTS \PT.LOOKUPFILE \PT.LOOKUPFILEREPLY \PT.LOOKUPFILEERROR
|
||||
\SOCKET.LOOKUPFILE)
|
||||
(RECORDS LOOKUPFILEDATA)
|
||||
(GLOBALVARS \LOOKUPFILE.HOSTINFO)))
|
||||
\SOCKET.LOOKUPFILE)
|
||||
(RECORDS LOOKUPFILEDATA)
|
||||
(GLOBALVARS \LOOKUPFILE.HOSTINFO)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \PT.LOOKUPFILE 200Q)
|
||||
@@ -3683,9 +3684,9 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS LOOKUPFILEDATA ((LOOKUPFILEBASE (fetch PUPCONTENTS of DATUM)))
|
||||
(BLOCKRECORD LOOKUPFILEBASE ((LOOKUPVERSION WORD)
|
||||
(LOOKUPCREATIONDATE FIXP)
|
||||
(LOOKUPLENGTH FIXP))))
|
||||
(BLOCKRECORD LOOKUPFILEBASE ((LOOKUPVERSION WORD)
|
||||
(LOOKUPCREATIONDATE FIXP)
|
||||
(LOOKUPLENGTH FIXP))))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -3853,7 +3854,7 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(RPAQ? *UPPER-CASE-FILE-NAMES* T)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RPAQQ LEAFCOMPILETIMECOMS
|
||||
(RPAQQ LEAFCOMPILETIMECOMS
|
||||
((RECORDS LEAFDATA LEAFERRORDATA LEAFPARAMSDATA LEAFPACKET LEAFINFOBLOCK LEAFSTREAM LEAFDEVICE
|
||||
PUPFILESERVER)
|
||||
(MACROS .NAMEORSTREAM. .PAGE.IS.AFTER.EOF. INCLEAFSTAT)
|
||||
@@ -3904,130 +3905,125 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(LOCALVARS . T)
|
||||
(GLOBALVARS \LEAFDEVICE \SOCKET.LEAF LEAFDEBUGFLG PUPTRACEFLG NOFILEPROPERROR NETWORKOSTYPES
|
||||
LEAFOPCODES SEQUINOPS DEFAULTFILETYPE \LEAF.IDLETIMEOUT \LEAF.CACHETIMEOUT
|
||||
\LEAF.MAXLOOKAHEAD \OPENFILES \LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE
|
||||
UNIXFTPFLG \SEQUIN.TIMEOUTMAX LEAFABORTREGION \MAXLEAFTRIES \LEAF.RECOVERY.TIMEOUT
|
||||
NONLEAFHOSTS \FTPFDEV)))
|
||||
\LEAF.MAXLOOKAHEAD \LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE UNIXFTPFLG
|
||||
\SEQUIN.TIMEOUTMAX LEAFABORTREGION \MAXLEAFTRIES \LEAF.RECOVERY.TIMEOUT NONLEAFHOSTS
|
||||
\FTPFDEV)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD LEAFDATA ((OPWORD WORD)
|
||||
(HANDLE WORD)
|
||||
(FILEADDRESS FIXP)
|
||||
(DATALENGTH WORD)
|
||||
(LEAFFIRSTDATAWORD WORD)) (* ;
|
||||
"Format of typical file operation request.")
|
||||
(BLOCKRECORD LEAFDATA ((LEAFOPCODE BITS 5)
|
||||
(ANSWERBIT BITS 1)
|
||||
(LEAFLENGTH BITS 12Q)
|
||||
(NIL WORD)
|
||||
(READWRITEMODE BITS 2)
|
||||
(EOFBIT BITS 1)
|
||||
(NIL BITS 2)
|
||||
(JUSTHIADDR BITS 13Q)
|
||||
(LOADDR WORD))
|
||||
(* ;
|
||||
"Details of the file address format")
|
||||
(SYNONYM LEAFOPCODE (OPCODE)))
|
||||
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
|
||||
(SIGNEXTEND BITS 5)
|
||||
(NIL BITS 33Q))
|
||||
(* ; "more details")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
|
||||
(OPENMODE WORD))
|
||||
(* ; "format of OPEN file request")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
|
||||
(LEAFFILETYPE WORD)
|
||||
(LEAFBYTESIZE WORD))
|
||||
(HANDLE WORD)
|
||||
(FILEADDRESS FIXP)
|
||||
(DATALENGTH WORD)
|
||||
(LEAFFIRSTDATAWORD WORD)) (* ;
|
||||
"Format of typical file operation request.")
|
||||
(BLOCKRECORD LEAFDATA ((LEAFOPCODE BITS 5)
|
||||
(ANSWERBIT BITS 1)
|
||||
(LEAFLENGTH BITS 12Q)
|
||||
(NIL WORD)
|
||||
(READWRITEMODE BITS 2)
|
||||
(EOFBIT BITS 1)
|
||||
(NIL BITS 2)
|
||||
(JUSTHIADDR BITS 13Q)
|
||||
(LOADDR WORD)) (* ;
|
||||
"Details of the file address format")
|
||||
(SYNONYM LEAFOPCODE (OPCODE)))
|
||||
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
|
||||
(SIGNEXTEND BITS 5)
|
||||
(NIL BITS 33Q)) (* ; "more details")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
|
||||
(OPENMODE WORD))(* ; "format of OPEN file request")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
|
||||
(LEAFFILETYPE WORD)
|
||||
(LEAFBYTESIZE WORD))
|
||||
(* ; "For accessing the file's TYPE")
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
|
||||
(LEAFFILEDATE FIXP))
|
||||
)
|
||||
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
|
||||
(LEAFFILEDATE FIXP))
|
||||
(* ;
|
||||
"Format of SETFILEINFO of CREATIONDATE request")
|
||||
))
|
||||
"Format of SETFILEINFO of CREATIONDATE request")
|
||||
))
|
||||
|
||||
(BLOCKRECORD LEAFERRORDATA ((NIL WORD)
|
||||
(LEAFERRORCODE WORD) (* ; "Error subcode in ERROR leafop")
|
||||
(LEAFERROROPCODE BITS 5) (* ;
|
||||
"The OPCODE in the Leaf packet provoking the error")
|
||||
(NIL BITS 13Q)
|
||||
(LEAFERRORHANDLE WORD) (* ; "The handle in the provoking op")
|
||||
(LEAFERRORMSG WORD) (* ;
|
||||
"Actually IFSSTRING starting here")
|
||||
))
|
||||
(LEAFERRORCODE WORD) (* ; "Error subcode in ERROR leafop")
|
||||
(LEAFERROROPCODE BITS 5) (* ;
|
||||
"The OPCODE in the Leaf packet provoking the error")
|
||||
(NIL BITS 13Q)
|
||||
(LEAFERRORHANDLE WORD) (* ; "The handle in the provoking op")
|
||||
(LEAFERRORMSG WORD) (* ; "Actually IFSSTRING starting here")
|
||||
))
|
||||
|
||||
(BLOCKRECORD LEAFPARAMSDATA ((NIL WORD)
|
||||
(LEAFPMAXDATALENGTH WORD)
|
||||
(LEAFPLOCKTIMEOUT WORD) (* ;
|
||||
"File Lock timeout, in units of 5 seconds")
|
||||
(LEAFPCONNTIMEOUT WORD) (* ;
|
||||
"Overall connection timeout, same units")
|
||||
))
|
||||
(LEAFPMAXDATALENGTH WORD)
|
||||
(LEAFPLOCKTIMEOUT WORD) (* ;
|
||||
"File Lock timeout, in units of 5 seconds")
|
||||
(LEAFPCONNTIMEOUT WORD) (* ;
|
||||
"Overall connection timeout, same units")
|
||||
))
|
||||
|
||||
(ACCESSFNS LEAFPACKET ((LEAFSTATUS (fetch EPUSERFIELD of DATUM)
|
||||
(replace EPUSERFIELD of DATUM with NEWVALUE))
|
||||
(LEAFFLAGS (fetch EPFLAGS of DATUM)
|
||||
(replace EPFLAGS of DATUM with NEWVALUE))
|
||||
(LEAFANSWERWANTED (NEQ (LOGAND (fetch EPFLAGS of DATUM)
|
||||
\LF.WANTANSWER)
|
||||
0))
|
||||
(LEAFALLOWERRORS (NEQ (LOGAND (fetch EPFLAGS of DATUM)
|
||||
\LF.ALLOWERRORS)
|
||||
0))))
|
||||
(replace EPUSERFIELD of DATUM with NEWVALUE))
|
||||
(LEAFFLAGS (fetch EPFLAGS of DATUM)
|
||||
(replace EPFLAGS of DATUM with NEWVALUE))
|
||||
(LEAFANSWERWANTED (NEQ (LOGAND (fetch EPFLAGS of DATUM)
|
||||
\LF.WANTANSWER)
|
||||
0))
|
||||
(LEAFALLOWERRORS (NEQ (LOGAND (fetch EPFLAGS of DATUM)
|
||||
\LF.ALLOWERRORS)
|
||||
0))))
|
||||
|
||||
(BLOCKRECORD LEAFINFOBLOCK ((LFCREATIONDATE FIXP)
|
||||
(LFWRITEDATE FIXP)
|
||||
(LFREADDATE FIXP)) (* ; "just like leader page")
|
||||
(BLOCKRECORD LEAFINFOBLOCK ((HICREATE WORD)
|
||||
(LOCREATE WORD)
|
||||
(HIWRITE WORD)
|
||||
(LOWRITE WORD)
|
||||
(HIREAD WORD)
|
||||
(LOREAD WORD))
|
||||
(LFWRITEDATE FIXP)
|
||||
(LFREADDATE FIXP)) (* ; "just like leader page")
|
||||
(BLOCKRECORD LEAFINFOBLOCK ((HICREATE WORD)
|
||||
(LOCREATE WORD)
|
||||
(HIWRITE WORD)
|
||||
(LOWRITE WORD)
|
||||
(HIREAD WORD)
|
||||
(LOREAD WORD))
|
||||
(* ; "for VALIDATION use")
|
||||
)
|
||||
(CREATE (\ALLOCBLOCK 3)))
|
||||
)
|
||||
(CREATE (\ALLOCBLOCK 3)))
|
||||
|
||||
(ACCESSFNS LEAFSTREAM ((LEAFCONNECTION (fetch F1 of DATUM)
|
||||
(replace F1 of DATUM with NEWVALUE))
|
||||
(LEAFHANDLE (fetch F2 of DATUM)
|
||||
(replace F2 of DATUM with NEWVALUE))
|
||||
(LEAFPAGECACHE (fetch F3 of DATUM)
|
||||
(replace F3 of DATUM with NEWVALUE))
|
||||
(LEAFINFO (fetch F4 of DATUM)
|
||||
(replace F4 of DATUM with NEWVALUE))
|
||||
(LEAFREALLYOPEN (fetch F5 of DATUM)
|
||||
(replace F5 of DATUM with NEWVALUE))
|
||||
(LEAFCACHECNT (fetch FW6 of DATUM)
|
||||
(replace FW6 of DATUM with NEWVALUE))
|
||||
(LEAFERRORCNT (fetch FW7 of DATUM)
|
||||
(replace FW7 of DATUM with NEWVALUE))))
|
||||
(replace F1 of DATUM with NEWVALUE))
|
||||
(LEAFHANDLE (fetch F2 of DATUM)
|
||||
(replace F2 of DATUM with NEWVALUE))
|
||||
(LEAFPAGECACHE (fetch F3 of DATUM)
|
||||
(replace F3 of DATUM with NEWVALUE))
|
||||
(LEAFINFO (fetch F4 of DATUM)
|
||||
(replace F4 of DATUM with NEWVALUE))
|
||||
(LEAFREALLYOPEN (fetch F5 of DATUM)
|
||||
(replace F5 of DATUM with NEWVALUE))
|
||||
(LEAFCACHECNT (fetch FW6 of DATUM)
|
||||
(replace FW6 of DATUM with NEWVALUE))
|
||||
(LEAFERRORCNT (fetch FW7 of DATUM)
|
||||
(replace FW7 of DATUM with NEWVALUE))))
|
||||
|
||||
(ACCESSFNS LEAFDEVICE ((PUPFILESERVER (fetch DEVICEINFO of DATUM)
|
||||
(replace DEVICEINFO of DATUM with NEWVALUE))))
|
||||
(replace DEVICEINFO of DATUM with NEWVALUE))))
|
||||
|
||||
(DATATYPE PUPFILESERVER (
|
||||
(* ;; "Info common to various pup protocols used on a file server, independent of whether a connection is now open")
|
||||
(* ;; "Info common to various pup protocols used on a file server, independent of whether a connection is now open")
|
||||
|
||||
(NIL BYTE)
|
||||
(PFSNAME POINTER)
|
||||
(PFSADDRESS POINTER) (* ; "Pup address")
|
||||
(PFSOSTYPE POINTER)
|
||||
(PFSLEAFFLG POINTER) (* ;
|
||||
"Indicates something about whether LEAF is available")
|
||||
(PFSLEAFSEQUIN POINTER) (* ;
|
||||
"Pointer to SEQUIN for open leaf connection")
|
||||
(PFSLEAFTIMER POINTER) (* ;
|
||||
"Timeout for handling dead servers")
|
||||
(PFSLOOKUPFILESOCKET POINTER) (* ;
|
||||
"The Pup socket for LookupFile requests")
|
||||
(PFSLOOKUPFILELOCK POINTER) (* ; "Lock to secure it")
|
||||
(PFSLOOKUPFAILCNT POINTER) (* ;
|
||||
"Counter used until we know the service exists")
|
||||
(PFSKNOWNDIRS POINTER) (* ;
|
||||
"List of directories known to exist on this host (for DIRECTORYNAMEP)")
|
||||
(NIL POINTER)))
|
||||
(NIL BYTE)
|
||||
(PFSNAME POINTER)
|
||||
(PFSADDRESS POINTER) (* ; "Pup address")
|
||||
(PFSOSTYPE POINTER)
|
||||
(PFSLEAFFLG POINTER) (* ;
|
||||
"Indicates something about whether LEAF is available")
|
||||
(PFSLEAFSEQUIN POINTER) (* ;
|
||||
"Pointer to SEQUIN for open leaf connection")
|
||||
(PFSLEAFTIMER POINTER) (* ; "Timeout for handling dead servers")
|
||||
(PFSLOOKUPFILESOCKET POINTER) (* ;
|
||||
"The Pup socket for LookupFile requests")
|
||||
(PFSLOOKUPFILELOCK POINTER) (* ; "Lock to secure it")
|
||||
(PFSLOOKUPFAILCNT POINTER) (* ;
|
||||
"Counter used until we know the service exists")
|
||||
(PFSKNOWNDIRS POINTER) (* ;
|
||||
"List of directories known to exist on this host (for DIRECTORYNAMEP)")
|
||||
(NIL POINTER)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'PUPFILESERVER '(BYTE POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
@@ -4047,35 +4043,36 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
'30Q)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS .NAMEORSTREAM. MACRO (OPENLAMBDA (FILENAME)
|
||||
(COND
|
||||
((type? STREAM FILENAME)
|
||||
(fetch FULLFILENAME of FILENAME))
|
||||
(T FILENAME]
|
||||
(PUTPROPS .NAMEORSTREAM. MACRO (OPENLAMBDA (FILENAME)
|
||||
(COND
|
||||
((type? STREAM FILENAME)
|
||||
(fetch FULLFILENAME of FILENAME))
|
||||
(T FILENAME))))
|
||||
|
||||
[PUTPROPS .PAGE.IS.AFTER.EOF. MACRO (OPENLAMBDA (STREAM PAGE#)
|
||||
(AND (IGEQ PAGE# (fetch EPAGE of STREAM))
|
||||
(OR (NOT (IEQP (fetch EPAGE of STREAM)
|
||||
PAGE#))
|
||||
(EQ (fetch EOFFSET of STREAM)
|
||||
0]
|
||||
(PUTPROPS .PAGE.IS.AFTER.EOF. MACRO [OPENLAMBDA (STREAM PAGE#)
|
||||
(AND (IGEQ PAGE# (fetch EPAGE of STREAM))
|
||||
(OR (NOT (IEQP (fetch EPAGE of STREAM)
|
||||
PAGE#))
|
||||
(EQ (fetch EOFFSET of STREAM)
|
||||
0])
|
||||
|
||||
[PUTPROPS INCLEAFSTAT MACRO ((X)
|
||||
(change X (IPLUS16 DATUM 1]
|
||||
(PUTPROPS INCLEAFSTAT MACRO ((X)
|
||||
(change X (IPLUS16 DATUM 1))))
|
||||
)
|
||||
|
||||
(RPAQQ LEAFOPCODES ((\LEAFOP.ERROR 0)
|
||||
(\LEAFOP.OPEN 1)
|
||||
(\LEAFOP.CLOSE 2)
|
||||
(\LEAFOP.DELETE 3)
|
||||
(\LEAFOP.LENGTH 4)
|
||||
(\LEAFOP.TRUNCATE 5)
|
||||
(\LEAFOP.READ 6)
|
||||
(\LEAFOP.WRITE 7)
|
||||
(\LEAFOP.RESET 10Q)
|
||||
(\LEAFOP.NOOP 11Q)
|
||||
(\LEAFOP.TELNET 12Q)
|
||||
(\LEAFOP.PARAMS 13Q)))
|
||||
(RPAQQ LEAFOPCODES
|
||||
((\LEAFOP.ERROR 0)
|
||||
(\LEAFOP.OPEN 1)
|
||||
(\LEAFOP.CLOSE 2)
|
||||
(\LEAFOP.DELETE 3)
|
||||
(\LEAFOP.LENGTH 4)
|
||||
(\LEAFOP.TRUNCATE 5)
|
||||
(\LEAFOP.READ 6)
|
||||
(\LEAFOP.WRITE 7)
|
||||
(\LEAFOP.RESET 10Q)
|
||||
(\LEAFOP.NOOP 11Q)
|
||||
(\LEAFOP.TELNET 12Q)
|
||||
(\LEAFOP.PARAMS 13Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \LEAFOP.ERROR 0)
|
||||
@@ -4117,23 +4114,24 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(\LEAFOP.PARAMS 13Q))
|
||||
)
|
||||
|
||||
(RPAQQ IFSERRORS ((\IFSERROR.BAD.CHARACTER 312Q)
|
||||
(\IFSERROR.MALFORMED '(311Q 312Q))
|
||||
(\IFSERROR.FILE.NOT.FOUND 317Q)
|
||||
(\IFSERROR.PROTECTION 320Q)
|
||||
(\IFSERROR.BUSY 321Q)
|
||||
(\IFSERROR.INVALID.DIRECTORY 322Q)
|
||||
(\IFSERROR.ALLOCATION 323Q)
|
||||
(\IFSERROR.USERNAME 330Q)
|
||||
(\IFSERROR.PASSWORD 331Q)
|
||||
(\IFSERROR.NO.LOGIN 332Q)
|
||||
(\PASSWORD.ERRORS '(330Q 331Q 332Q 337Q))
|
||||
(\IFSERROR.CONNECTNAME 333Q)
|
||||
(\IFSERROR.CONNECTPASSWORD 334Q)
|
||||
(\CONNECT.PASSWORD.ERRORS '(333Q 334Q))
|
||||
(\IFSERROR.NEED.USERNAME 337Q)
|
||||
(\IFS.ERROR.BROKEN.LEAF 1751Q)
|
||||
(\IFSERROR.BAD.HANDLE 1763Q)))
|
||||
(RPAQQ IFSERRORS
|
||||
((\IFSERROR.BAD.CHARACTER 312Q)
|
||||
(\IFSERROR.MALFORMED '(311Q 312Q))
|
||||
(\IFSERROR.FILE.NOT.FOUND 317Q)
|
||||
(\IFSERROR.PROTECTION 320Q)
|
||||
(\IFSERROR.BUSY 321Q)
|
||||
(\IFSERROR.INVALID.DIRECTORY 322Q)
|
||||
(\IFSERROR.ALLOCATION 323Q)
|
||||
(\IFSERROR.USERNAME 330Q)
|
||||
(\IFSERROR.PASSWORD 331Q)
|
||||
(\IFSERROR.NO.LOGIN 332Q)
|
||||
(\PASSWORD.ERRORS '(330Q 331Q 332Q 337Q))
|
||||
(\IFSERROR.CONNECTNAME 333Q)
|
||||
(\IFSERROR.CONNECTPASSWORD 334Q)
|
||||
(\CONNECT.PASSWORD.ERRORS '(333Q 334Q))
|
||||
(\IFSERROR.NEED.USERNAME 337Q)
|
||||
(\IFS.ERROR.BROKEN.LEAF 1751Q)
|
||||
(\IFSERROR.BAD.HANDLE 1763Q)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \IFSERROR.BAD.CHARACTER 312Q)
|
||||
@@ -4331,8 +4329,8 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
|
||||
(GLOBALVARS \LEAFDEVICE \SOCKET.LEAF LEAFDEBUGFLG PUPTRACEFLG NOFILEPROPERROR NETWORKOSTYPES
|
||||
LEAFOPCODES SEQUINOPS DEFAULTFILETYPE \LEAF.IDLETIMEOUT \LEAF.CACHETIMEOUT \LEAF.MAXLOOKAHEAD
|
||||
\OPENFILES \LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE UNIXFTPFLG \SEQUIN.TIMEOUTMAX
|
||||
LEAFABORTREGION \MAXLEAFTRIES \LEAF.RECOVERY.TIMEOUT NONLEAFHOSTS \FTPFDEV)
|
||||
\LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE UNIXFTPFLG \SEQUIN.TIMEOUTMAX LEAFABORTREGION
|
||||
\MAXLEAFTRIES \LEAF.RECOVERY.TIMEOUT NONLEAFHOSTS \FTPFDEV)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -4354,54 +4352,52 @@ This shouldn't happen: Lisp and the server have different ideas about which file
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE PUPFILESERVER ((NIL BYTE)
|
||||
(PFSNAME POINTER)
|
||||
(PFSADDRESS POINTER)
|
||||
(PFSOSTYPE POINTER)
|
||||
(PFSLEAFFLG POINTER)
|
||||
(PFSLEAFSEQUIN POINTER)
|
||||
(PFSLEAFTIMER POINTER)
|
||||
(PFSLOOKUPFILESOCKET POINTER)
|
||||
(PFSLOOKUPFILELOCK POINTER)
|
||||
(PFSLOOKUPFAILCNT POINTER)
|
||||
(PFSKNOWNDIRS POINTER)
|
||||
(NIL POINTER)))
|
||||
(PFSNAME POINTER)
|
||||
(PFSADDRESS POINTER)
|
||||
(PFSOSTYPE POINTER)
|
||||
(PFSLEAFFLG POINTER)
|
||||
(PFSLEAFSEQUIN POINTER)
|
||||
(PFSLEAFTIMER POINTER)
|
||||
(PFSLOOKUPFILESOCKET POINTER)
|
||||
(PFSLOOKUPFILELOCK POINTER)
|
||||
(PFSLOOKUPFAILCNT POINTER)
|
||||
(PFSKNOWNDIRS POINTER)
|
||||
(NIL POINTER)))
|
||||
)
|
||||
(PUTPROPS LEAF COPYRIGHT ("Venue & Xerox Corporation" 3677Q 3700Q 3701Q 3702Q 3703Q 3704Q 3706Q 3707Q
|
||||
3710Q 3711Q))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (55721Q 71017Q (CLOSESEQUIN 55733Q . 56752Q) (INITSEQUIN 56754Q . 62060Q) (GETSEQUIN
|
||||
62062Q . 63573Q) (PUTSEQUIN 63575Q . 71015Q)) (71020Q 154423Q (\SEQUIN.CONTROL 71032Q . 72303Q) (
|
||||
\SEQUIN.PUT 72305Q . 77330Q) (\SEQUIN.PROCESS 77332Q . 114606Q) (\SEQUIN.CLOSE 114610Q . 115475Q) (
|
||||
\SEQUIN.FLUSH.CONNECTION 115477Q . 117510Q) (\SEQUIN.CLEANUP 117512Q . 120643Q) (
|
||||
\SEQUIN.FLUSH.RETRANSMIT 120645Q . 122102Q) (\SEQUIN.COMPARE 122104Q . 123243Q) (\SEQUIN.HANDLE.INPUT
|
||||
123245Q . 141222Q) (\SEQUIN.OUT.OF.THE.BLUE 141224Q . 142047Q) (\SEQUIN.HANDLE.ACK 142051Q . 146303Q)
|
||||
(\SEQUIN.RETRANSMIT 146305Q . 151653Q) (\SEQUIN.RETRANSMITNEXT 151655Q . 154421Q)) (154474Q 420376Q (
|
||||
\LEAF.CLOSEFILE 154506Q . 167557Q) (\LEAF.DELETEFILE 167561Q . 173344Q) (\LEAF.DEVICEP 173346Q .
|
||||
210335Q) (\LEAF.RECONNECT 210337Q . 212254Q) (\LEAF.DIRECTORYNAMEP 212256Q . 215567Q) (
|
||||
\LEAF.GENERATEFILES 215571Q . 216203Q) (\LEAF.GETFILE 216205Q . 252644Q) (\PARSE.REMOTE.FILENAME
|
||||
252646Q . 262052Q) (\LEAF.STRIP.QUOTES 262054Q . 263545Q) (\LEAF.GETFILEDATES 263547Q . 265742Q) (
|
||||
\LEAF.GETFILEINFO 265744Q . 271321Q) (\LEAF.GETFILEINFO.OPEN 271323Q . 300142Q) (\LEAF.GETFILENAME
|
||||
300144Q . 302361Q) (\LEAF.OPENFILE 302363Q . 316434Q) (\LEAF.READFILENAME 316436Q . 322347Q) (
|
||||
\LEAF.ADD.QUOTES 322351Q . 324773Q) (\LEAF.READFILEPROP 324775Q . 330044Q) (\LEAF.READPAGES 330046Q .
|
||||
337203Q) (\LEAF.REQUESTPAGE 337205Q . 346115Q) (\LEAF.LOOKUPCACHE 346117Q . 353053Q) (CLEAR.LEAF.CACHE
|
||||
353055Q . 355025Q) (LEAF.ASSURE.FINISHED 355027Q . 362160Q) (\LEAF.FORCEOUTPUT 362162Q . 362454Q) (
|
||||
\LEAF.FLUSH.CACHE 362456Q . 363662Q) (\LEAF.RENAMEFILE 363664Q . 364636Q) (\LEAF.REOPENFILE 364640Q .
|
||||
372213Q) (\LEAF.CREATIONDATE 372215Q . 373052Q) (\LEAF.SETCREATIONDATE 373054Q . 376567Q) (
|
||||
\LEAF.SETFILEINFO 376571Q . 400453Q) (\LEAF.SETFILETYPE 400455Q . 405237Q) (\LEAF.SETVALIDATION
|
||||
405241Q . 407576Q) (\LEAF.TRUNCATEFILE 407600Q . 412773Q) (\LEAF.WRITEPAGES 412775Q . 420374Q)) (
|
||||
420461Q 426570Q (\SENDLEAF 420473Q . 426566Q)) (426644Q 457325Q (\OPENLEAFCONNECTION 426656Q . 450764Q
|
||||
) (\LEAF.BREAKCONNECTION 450766Q . 452572Q) (\CLOSELEAFCONNECTION 452574Q . 453434Q) (\LEAF.EVENTFN
|
||||
453436Q . 457323Q)) (457414Q 462177Q (BREAKCONNECTION 457426Q . 462175Q)) (462303Q 574667Q (
|
||||
\LEAF.ACKED 462315Q . 463024Q) (\LEAF.FIX.BROKEN.SEQUIN 463026Q . 502766Q) (\LEAF.REPAIR.BROKEN.PUP
|
||||
502770Q . 507062Q) (\LEAF.USE.NEW.CONNECTION 507064Q . 522707Q) (\LEAF.RESENDPUPS 522711Q . 523321Q) (
|
||||
\LEAF.HANDLE.INPUT 523323Q . 532633Q) (\LEAF.OPENERRORHANDLER 532635Q . 534260Q) (\LEAF.TIMEDIN
|
||||
534262Q . 535245Q) (\LEAF.TIMEDOUT 535247Q . 543562Q) (\LEAF.NOT.RESPONDING 543564Q . 545134Q) (
|
||||
\LEAF.TIMEDOUT.EXCESSIVE 545136Q . 557603Q) (\LEAF.ABORT.FROMMENU 557605Q . 560534Q) (
|
||||
\LEAF.STREAM.IN.QUEUE 560536Q . 565131Q) (\LEAF.IDLE 565133Q . 567173Q) (\LEAF.MAYBE.FLUSH.CACHE
|
||||
567175Q . 570266Q) (\LEAF.WHENCLOSED 570270Q . 573456Q) (\LEAF.IDLE? 573460Q . 574665Q)) (575012Q
|
||||
630625Q (\ADDLEAFSTRING 575024Q . 600672Q) (\FIXPASSWORD 600674Q . 603031Q) (\GETLEAFSTRING 603033Q .
|
||||
603563Q) (\IFSERRORSTRING 603565Q . 611752Q) (\LEAF.ERROR 611754Q . 617253Q) (\LEAF.DIRECTORYNAMEONLY
|
||||
617255Q . 617776Q) (GETHOSTINFO 620000Q . 625276Q) (GETOSTYPE 625300Q . 625517Q) (EXPANDING-PAGEFULLFN
|
||||
625521Q . 630623Q)) (631032Q 655617Q (\IFS.LOOKUPFILE 631044Q . 655615Q)) (657560Q 661707Q (\LEAFINIT
|
||||
657572Q . 661705Q)) (661765Q 675022Q (PRINTLEAF 661777Q . 675020Q)))))
|
||||
(FILEMAP (NIL (54176Q 67274Q (CLOSESEQUIN 54210Q . 55227Q) (INITSEQUIN 55231Q . 60335Q) (GETSEQUIN
|
||||
60337Q . 62050Q) (PUTSEQUIN 62052Q . 67272Q)) (67275Q 152700Q (\SEQUIN.CONTROL 67307Q . 70560Q) (
|
||||
\SEQUIN.PUT 70562Q . 75605Q) (\SEQUIN.PROCESS 75607Q . 113063Q) (\SEQUIN.CLOSE 113065Q . 113752Q) (
|
||||
\SEQUIN.FLUSH.CONNECTION 113754Q . 115765Q) (\SEQUIN.CLEANUP 115767Q . 117120Q) (
|
||||
\SEQUIN.FLUSH.RETRANSMIT 117122Q . 120357Q) (\SEQUIN.COMPARE 120361Q . 121520Q) (\SEQUIN.HANDLE.INPUT
|
||||
121522Q . 137477Q) (\SEQUIN.OUT.OF.THE.BLUE 137501Q . 140324Q) (\SEQUIN.HANDLE.ACK 140326Q . 144560Q)
|
||||
(\SEQUIN.RETRANSMIT 144562Q . 150130Q) (\SEQUIN.RETRANSMITNEXT 150132Q . 152676Q)) (152751Q 416653Q (
|
||||
\LEAF.CLOSEFILE 152763Q . 166034Q) (\LEAF.DELETEFILE 166036Q . 171621Q) (\LEAF.DEVICEP 171623Q .
|
||||
206612Q) (\LEAF.RECONNECT 206614Q . 210531Q) (\LEAF.DIRECTORYNAMEP 210533Q . 214044Q) (
|
||||
\LEAF.GENERATEFILES 214046Q . 214460Q) (\LEAF.GETFILE 214462Q . 251121Q) (\PARSE.REMOTE.FILENAME
|
||||
251123Q . 260327Q) (\LEAF.STRIP.QUOTES 260331Q . 262022Q) (\LEAF.GETFILEDATES 262024Q . 264217Q) (
|
||||
\LEAF.GETFILEINFO 264221Q . 267576Q) (\LEAF.GETFILEINFO.OPEN 267600Q . 276417Q) (\LEAF.GETFILENAME
|
||||
276421Q . 300636Q) (\LEAF.OPENFILE 300640Q . 314711Q) (\LEAF.READFILENAME 314713Q . 320624Q) (
|
||||
\LEAF.ADD.QUOTES 320626Q . 323250Q) (\LEAF.READFILEPROP 323252Q . 326321Q) (\LEAF.READPAGES 326323Q .
|
||||
335460Q) (\LEAF.REQUESTPAGE 335462Q . 344372Q) (\LEAF.LOOKUPCACHE 344374Q . 351330Q) (CLEAR.LEAF.CACHE
|
||||
351332Q . 353302Q) (LEAF.ASSURE.FINISHED 353304Q . 360435Q) (\LEAF.FORCEOUTPUT 360437Q . 360731Q) (
|
||||
\LEAF.FLUSH.CACHE 360733Q . 362137Q) (\LEAF.RENAMEFILE 362141Q . 363113Q) (\LEAF.REOPENFILE 363115Q .
|
||||
370470Q) (\LEAF.CREATIONDATE 370472Q . 371327Q) (\LEAF.SETCREATIONDATE 371331Q . 375044Q) (
|
||||
\LEAF.SETFILEINFO 375046Q . 376730Q) (\LEAF.SETFILETYPE 376732Q . 403514Q) (\LEAF.SETVALIDATION
|
||||
403516Q . 406053Q) (\LEAF.TRUNCATEFILE 406055Q . 411250Q) (\LEAF.WRITEPAGES 411252Q . 416651Q)) (
|
||||
416736Q 425045Q (\SENDLEAF 416750Q . 425043Q)) (425121Q 455602Q (\OPENLEAFCONNECTION 425133Q . 447241Q
|
||||
) (\LEAF.BREAKCONNECTION 447243Q . 451047Q) (\CLOSELEAFCONNECTION 451051Q . 451711Q) (\LEAF.EVENTFN
|
||||
451713Q . 455600Q)) (455671Q 460454Q (BREAKCONNECTION 455703Q . 460452Q)) (460560Q 573144Q (
|
||||
\LEAF.ACKED 460572Q . 461301Q) (\LEAF.FIX.BROKEN.SEQUIN 461303Q . 501243Q) (\LEAF.REPAIR.BROKEN.PUP
|
||||
501245Q . 505337Q) (\LEAF.USE.NEW.CONNECTION 505341Q . 521164Q) (\LEAF.RESENDPUPS 521166Q . 521576Q) (
|
||||
\LEAF.HANDLE.INPUT 521600Q . 531110Q) (\LEAF.OPENERRORHANDLER 531112Q . 532535Q) (\LEAF.TIMEDIN
|
||||
532537Q . 533522Q) (\LEAF.TIMEDOUT 533524Q . 542037Q) (\LEAF.NOT.RESPONDING 542041Q . 543411Q) (
|
||||
\LEAF.TIMEDOUT.EXCESSIVE 543413Q . 556060Q) (\LEAF.ABORT.FROMMENU 556062Q . 557011Q) (
|
||||
\LEAF.STREAM.IN.QUEUE 557013Q . 563406Q) (\LEAF.IDLE 563410Q . 565450Q) (\LEAF.MAYBE.FLUSH.CACHE
|
||||
565452Q . 566543Q) (\LEAF.WHENCLOSED 566545Q . 571733Q) (\LEAF.IDLE? 571735Q . 573142Q)) (573267Q
|
||||
627102Q (\ADDLEAFSTRING 573301Q . 577147Q) (\FIXPASSWORD 577151Q . 601306Q) (\GETLEAFSTRING 601310Q .
|
||||
602040Q) (\IFSERRORSTRING 602042Q . 610227Q) (\LEAF.ERROR 610231Q . 615530Q) (\LEAF.DIRECTORYNAMEONLY
|
||||
615532Q . 616253Q) (GETHOSTINFO 616255Q . 623553Q) (GETOSTYPE 623555Q . 623774Q) (EXPANDING-PAGEFULLFN
|
||||
623776Q . 627100Q)) (627307Q 654074Q (\IFS.LOOKUPFILE 627321Q . 654072Q)) (656005Q 660134Q (\LEAFINIT
|
||||
656017Q . 660132Q)) (660212Q 673247Q (PRINTLEAF 660224Q . 673245Q)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1286
sources/LOCALFILE
1286
sources/LOCALFILE
File diff suppressed because it is too large
Load Diff
Binary file not shown.
119
sources/MOD44IO
119
sources/MOD44IO
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "16-Mar-2021 19:55:51" {DSK}<home>larry>ilisp>medley>sources>MOD44IO.;3 139027
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS MOD44IOCOMS)
|
||||
(FILECREATED "11-May-2023 21:48:37" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>MOD44IO.;2 138564
|
||||
|
||||
previous date%: "16-Mar-2021 10:09:07" {DSK}<home>larry>ilisp>medley>sources>MOD44IO.;2)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:CHANGES-TO (VARS MOD44IOCOMS)
|
||||
|
||||
:PREVIOUS-DATE "16-Mar-2021 19:55:51"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>MOD44IO.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MOD44IOCOMS)
|
||||
|
||||
@@ -35,7 +35,7 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
(COMS (INITVARS (\M44MULTFLG T))
|
||||
(DECLARE%: DONTCOPY (MACROS UCASECHAR UPDATEVALIDATION)
|
||||
(RECORDS M44DEVICE)
|
||||
(GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
|
||||
(GLOBALVARS \M44MULTFLG \DISKNAMECASEARRAY)
|
||||
(MACROS .LISP.TO.BFS. .BFS.TO.LISP. .DISKCASEARRAY.)
|
||||
(CONSTANTS (PageMapIncrement 64)
|
||||
(\MAX.ALTO.NAME.LENGTH 39))
|
||||
@@ -1261,30 +1261,29 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS UCASECHAR MACRO [(C)
|
||||
(COND
|
||||
((ILESSP C (CHARCODE a))
|
||||
C)
|
||||
(T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
|
||||
(CHARCODE A])
|
||||
(COND
|
||||
((ILESSP C (CHARCODE a))
|
||||
C)
|
||||
(T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
|
||||
(CHARCODE A])
|
||||
|
||||
(PUTPROPS UPDATEVALIDATION MACRO [(STREAM BUF)
|
||||
(replace VALIDATION of STREAM
|
||||
with (\MAKENUMBER (\GETBASE BUF 1)
|
||||
(\GETBASE BUF 3])
|
||||
(replace VALIDATION of STREAM with (\MAKENUMBER (\GETBASE BUF 1)
|
||||
(\GETBASE BUF 3])
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS M44DEVICE ((DSKOBJ (fetch DEVICEINFO of DATUM)
|
||||
(replace DEVICEINFO of DATUM with NEWVALUE)))
|
||||
[TYPE? (AND (type? FDEV DATUM)
|
||||
(EQ (fetch OPENFILE of DATUM)
|
||||
'\M44OpenFile])
|
||||
(replace DEVICEINFO of DATUM with NEWVALUE)))
|
||||
[TYPE? (AND (type? FDEV DATUM)
|
||||
(EQ (fetch OPENFILE of DATUM)
|
||||
'\M44OpenFile])
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
|
||||
(GLOBALVARS \M44MULTFLG \DISKNAMECASEARRAY)
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -1293,9 +1292,7 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(PUTPROPS .BFS.TO.LISP. MACRO (= . SUB1))
|
||||
|
||||
(PUTPROPS .DISKCASEARRAY. MACRO [NIL (fetch (ARRAYP BASE) of (\DTEST
|
||||
\DISKNAMECASEARRAY
|
||||
'ARRAYP])
|
||||
(PUTPROPS .DISKCASEARRAY. MACRO [NIL (fetch (ARRAYP BASE) of (\DTEST \DISKNAMECASEARRAY 'ARRAYP])
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -1316,16 +1313,16 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD M44FILEPROP ((FPROPTYPE BYTE) (* ; "Type of property")
|
||||
(FPROPLENGTH BYTE) (* ; "Length of entire entry in words")
|
||||
(FPROPWORD0 WORD) (* ; "value starts here")
|
||||
) (* ;
|
||||
"Overlays a piece of leader page to describe a file property")
|
||||
)
|
||||
(BLOCKRECORD M44FILEPROP ((FPROPTYPE BYTE) (* ; "Type of property")
|
||||
(FPROPLENGTH BYTE) (* ; "Length of entire entry in words")
|
||||
(FPROPWORD0 WORD) (* ; "value starts here")
|
||||
) (* ;
|
||||
"Overlays a piece of leader page to describe a file property")
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQQ FPROPTYPES ((\FPROP.TYPE 136)
|
||||
(\FPROP.PAGEMAP 137)))
|
||||
(\FPROP.PAGEMAP 137)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \FPROP.TYPE 136)
|
||||
@@ -1338,8 +1335,8 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
|
||||
(RPAQQ FPTYPES ((\FPTYPE.UNKNOWN 0)
|
||||
(\FPTYPE.TEXT 1)
|
||||
(\FPTYPE.BINARY 2)))
|
||||
(\FPTYPE.TEXT 1)
|
||||
(\FPTYPE.BINARY 2)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \FPTYPE.UNKNOWN 0)
|
||||
@@ -1970,11 +1967,11 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD UNAME (VERSION . UCASECHARHEAD)
|
||||
(RECORD UCASECHARHEAD (ORIGCHARHEAD . UCASECHARS)
|
||||
(RECORD ORIGCHARHEAD (PARTNAME . ORIGCHARS))))
|
||||
(RECORD UCASECHARHEAD (ORIGCHARHEAD . UCASECHARS)
|
||||
(RECORD ORIGCHARHEAD (PARTNAME . ORIGCHARS))))
|
||||
|
||||
(RECORD FILESPEC (UNAME FSDIRPTR)
|
||||
[ACCESSFNS FILESPEC ((PNAME (\M44PACKFILENAME (fetch UNAME of DATUM])
|
||||
[ACCESSFNS FILESPEC ((PNAME (\M44PACKFILENAME (fetch UNAME of DATUM])
|
||||
|
||||
(RECORD M44GENFILESTATE (DIROFD SEARCHSTATE GENFILTER GENVERSION HOSTNAME GENSTREAM ENTRYSTART))
|
||||
|
||||
@@ -1984,8 +1981,8 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS BETWEEN MACRO (OPENLAMBDA (V LO HI)
|
||||
(AND (IGEQ V LO)
|
||||
(ILEQ V HI))))
|
||||
(AND (IGEQ V LO)
|
||||
(ILEQ V HI))))
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -2189,29 +2186,27 @@ Copyright (c) 1981-1991, 2021 by Venue & Xerox Corporation.
|
||||
(FILESLOAD (LOADCOMP)
|
||||
LLBFS)
|
||||
)
|
||||
(PUTPROPS MOD44IO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3982 65711 (\M44AddDiskPages 3992 . 5260) (\M44CloseFile 5262 . 5569) (\M44CompleteFH
|
||||
5571 . 9985) (\M44CREATEFILE 9987 . 15917) (\M44DeleteFile 15919 . 17008) (\M44EVENTFN 17010 . 21387)
|
||||
(\M44ExtendFilePageMap 21389 . 23440) (\M44FillInMap 23442 . 25792) (\M44GetFileHandle 25794 . 27898)
|
||||
(\M44GetFileInfo 27900 . 32083) (\M44GETDATEPROP 32085 . 32567) (\M44GetFileName 32569 . 33006) (
|
||||
\M44GetPageLoc 33008 . 33809) (\M44KillFilePageMap 33811 . 34182) (\M44MAKEDIRENTRY 34184 . 35915) (
|
||||
\M44OpenFile 35917 . 42050) (\M44OPENFILEFROMFP 42052 . 43080) (\M44ReadDiskPage 43082 . 45309) (
|
||||
\M44ReadLeaderPage 45311 . 46763) (\M44ReadPages 46765 . 46982) (\M44SetAccessTimes 46984 . 48269) (
|
||||
\M44SetEndOfFile 48271 . 49762) (\M44SetFileInfo 49764 . 51018) (\M44SETFILETYPE 51020 . 53633) (
|
||||
\M44TruncateFile 53635 . 55088) (\M44WriteDiskPage 55090 . 59312) (\M44WriteLeaderPage 59314 . 60172)
|
||||
(\M44WritePages 60174 . 62558) (\M44WritePages1 62560 . 65709)) (65745 78564 (\ADDDISKPAGES 65755 .
|
||||
67568) (\M44DELETEPAGES 67570 . 71612) (\ASSIGNDISKPAGE 71614 . 74866) (\COUNTDISKFREEPAGES 74868 .
|
||||
75405) (\M44MARKPAGEFREE 75407 . 76107) (\M44FLUSHDISKDESCRIPTOR 76109 . 77051) (\MAKELEADERDAS 77053
|
||||
. 77764) (DISKFREEPAGES 77766 . 78112) (\M44FREEPAGECOUNT 78114 . 78562)) (81717 96018 (
|
||||
\M44GENERATEFILES 81727 . 84647) (\M44SORTFILES 84649 . 85026) (\M44GENERATENEXT 85028 . 90673) (
|
||||
\M44NEXTFILEFN 90675 . 91938) (\M44SORTEDNEXTFILEFN 91940 . 94063) (\M44FILEINFOFN 94065 . 96016)) (
|
||||
96062 121329 (\M44PARSEFILENAME 96072 . 104104) (\FINDDIRHOLE 104106 . 106089) (\M44PACKFILENAME
|
||||
106091 . 106721) (\M44READVERSION 106723 . 107149) (\OPENDISKDESCRIPTOR 107151 . 109258) (
|
||||
\M44READDIRFID 109260 . 109696) (\M44READDIRNAME 109698 . 110128) (\M44SEARCHDIR 110130 . 112871) (
|
||||
\M44UNPACKFILENAME 112873 . 121327)) (122158 131181 (\CREATE.FID.FOR.DD 122168 . 122773) (\OPENDISK
|
||||
122775 . 124064) (\OPENDISKDEVICE 124066 . 128315) (\OPENDIR 128317 . 129493) (\M44CHECKPASSWORD
|
||||
129495 . 130824) (\M44HOSTNAMEP 130826 . 131179)) (131450 134817 (\COPYSYS1 131460 . 134815)) (134878
|
||||
136394 (\MAIKO.CHECKFREESPACE 134888 . 136392)) (136742 138730 (GATHERSTATS 136752 . 138728)))))
|
||||
(FILEMAP (NIL (3958 65687 (\M44AddDiskPages 3968 . 5236) (\M44CloseFile 5238 . 5545) (\M44CompleteFH
|
||||
5547 . 9961) (\M44CREATEFILE 9963 . 15893) (\M44DeleteFile 15895 . 16984) (\M44EVENTFN 16986 . 21363)
|
||||
(\M44ExtendFilePageMap 21365 . 23416) (\M44FillInMap 23418 . 25768) (\M44GetFileHandle 25770 . 27874)
|
||||
(\M44GetFileInfo 27876 . 32059) (\M44GETDATEPROP 32061 . 32543) (\M44GetFileName 32545 . 32982) (
|
||||
\M44GetPageLoc 32984 . 33785) (\M44KillFilePageMap 33787 . 34158) (\M44MAKEDIRENTRY 34160 . 35891) (
|
||||
\M44OpenFile 35893 . 42026) (\M44OPENFILEFROMFP 42028 . 43056) (\M44ReadDiskPage 43058 . 45285) (
|
||||
\M44ReadLeaderPage 45287 . 46739) (\M44ReadPages 46741 . 46958) (\M44SetAccessTimes 46960 . 48245) (
|
||||
\M44SetEndOfFile 48247 . 49738) (\M44SetFileInfo 49740 . 50994) (\M44SETFILETYPE 50996 . 53609) (
|
||||
\M44TruncateFile 53611 . 55064) (\M44WriteDiskPage 55066 . 59288) (\M44WriteLeaderPage 59290 . 60148)
|
||||
(\M44WritePages 60150 . 62534) (\M44WritePages1 62536 . 65685)) (65721 78540 (\ADDDISKPAGES 65731 .
|
||||
67544) (\M44DELETEPAGES 67546 . 71588) (\ASSIGNDISKPAGE 71590 . 74842) (\COUNTDISKFREEPAGES 74844 .
|
||||
75381) (\M44MARKPAGEFREE 75383 . 76083) (\M44FLUSHDISKDESCRIPTOR 76085 . 77027) (\MAKELEADERDAS 77029
|
||||
. 77740) (DISKFREEPAGES 77742 . 78088) (\M44FREEPAGECOUNT 78090 . 78538)) (81402 95703 (
|
||||
\M44GENERATEFILES 81412 . 84332) (\M44SORTFILES 84334 . 84711) (\M44GENERATENEXT 84713 . 90358) (
|
||||
\M44NEXTFILEFN 90360 . 91623) (\M44SORTEDNEXTFILEFN 91625 . 93748) (\M44FILEINFOFN 93750 . 95701)) (
|
||||
95747 121014 (\M44PARSEFILENAME 95757 . 103789) (\FINDDIRHOLE 103791 . 105774) (\M44PACKFILENAME
|
||||
105776 . 106406) (\M44READVERSION 106408 . 106834) (\OPENDISKDESCRIPTOR 106836 . 108943) (
|
||||
\M44READDIRFID 108945 . 109381) (\M44READDIRNAME 109383 . 109813) (\M44SEARCHDIR 109815 . 112556) (
|
||||
\M44UNPACKFILENAME 112558 . 121012)) (121815 130838 (\CREATE.FID.FOR.DD 121825 . 122430) (\OPENDISK
|
||||
122432 . 123721) (\OPENDISKDEVICE 123723 . 127972) (\OPENDIR 127974 . 129150) (\M44CHECKPASSWORD
|
||||
129152 . 130481) (\M44HOSTNAMEP 130483 . 130836)) (131107 134474 (\COPYSYS1 131117 . 134472)) (134535
|
||||
136051 (\MAIKO.CHECKFREESPACE 134545 . 136049)) (136399 138387 (GATHERSTATS 136409 . 138385)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
66
sources/PMAP
66
sources/PMAP
@@ -1,26 +1,24 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jul-2022 23:17:41" {DSK}<users>kaplan>local>medley3.5>working-medley>sources>PMAP.;8 59726
|
||||
(FILECREATED "11-May-2023 21:39:25" {DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>PMAP.;2 58865
|
||||
|
||||
:CHANGES-TO (FNS \PAGEDREADP)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE " 7-Aug-2021 12:45:46"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>PMAP.;7)
|
||||
:CHANGES-TO (VARS PMAPCOMS)
|
||||
|
||||
:PREVIOUS-DATE "19-Jul-2022 23:17:41"
|
||||
{DSK}<cygdrive>c>Users>Larry>home>il>MEDLEY>SOURCES>PMAP.;1)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PMAPCOMS)
|
||||
|
||||
(RPAQQ PMAPCOMS
|
||||
( (* ;
|
||||
"Page mapping primitives. This file is shared with VAX.")
|
||||
(FNS ADDMAPBUFFER \ALLOCMAPBUFFER CHECKBUFFERREFVAL CLEARMAP \WRITEOUTBUFFERS \CLEARMAP
|
||||
DOPMAP FINDPTRSBUFFER FORGETPAGES \GETMAPBUFFER LOCKMAP MAPAFTERCLOSE MAPBUFFERCOUNT
|
||||
MAPPAGE MAPWORD \RELEASEBUFFER RELEASINGVMEMPAGE RESTOREMAP UNLOCKMAP \MAPPAGE
|
||||
\COLLECTDIRTYBUFS \SETIODIRTY)
|
||||
(FNS ADDMAPBUFFER \ALLOCMAPBUFFER CHECKBUFFERREFVAL \WRITEOUTBUFFERS \CLEARMAP DOPMAP
|
||||
FINDPTRSBUFFER FORGETPAGES \GETMAPBUFFER LOCKMAP MAPAFTERCLOSE MAPBUFFERCOUNT MAPPAGE
|
||||
MAPWORD \RELEASEBUFFER RELEASINGVMEMPAGE RESTOREMAP UNLOCKMAP \MAPPAGE \COLLECTDIRTYBUFS
|
||||
\SETIODIRTY)
|
||||
(FNS WORDCONTENTS SETWORDCONTENTS /SETWORDCONTENTS WORDOFFSET)
|
||||
(EXPORT (PROP BYTEMACRO WORDCONTENTS SETWORDCONTENTS WORDOFFSET))
|
||||
(COMS (ADDVARS (DEFAULTMAPFILE)
|
||||
@@ -81,22 +79,6 @@ Copyright (c) 1982-1988, 1990, 1993, 2002, 2021 by Venue & Xerox Corporation.
|
||||
(replace NOREFERENCE of BUFF with NIL)))
|
||||
(fetch VMEMPAGE of BUFF))])
|
||||
|
||||
(CLEARMAP
|
||||
[LAMBDA (FILE PAGES RELEASE) (* hdj " 5-Jun-86 11:53")
|
||||
|
||||
(* ;;
|
||||
"Clears the usermapped PAGES of FILE from the buffers. RELEASE is for compatibility with MAXC.")
|
||||
|
||||
(COND
|
||||
[(EQ FILE T) (* ; "T denotes all files")
|
||||
(ERROR "T flag no longer supported for CLEARMAP")
|
||||
(if NIL
|
||||
then (for STREAM in \OPENFILES do (\CLEARMAP STREAM PAGES T]
|
||||
(T (PROG NIL
|
||||
(\CLEARMAP (OR (\GETSTREAM FILE NIL T)
|
||||
(RETURN))
|
||||
PAGES T])
|
||||
|
||||
(\WRITEOUTBUFFERS
|
||||
[LAMBDA (BUFFER STREAM) (* bvm%: "16-May-84 14:32")
|
||||
|
||||
@@ -1100,21 +1082,19 @@ EVAL@COMPILE
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(PUTPROPS PMAP COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1993
|
||||
2002 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2457 29111 (ADDMAPBUFFER 2467 . 2643) (\ALLOCMAPBUFFER 2645 . 3246) (CHECKBUFFERREFVAL
|
||||
3248 . 3823) (CLEARMAP 3825 . 4481) (\WRITEOUTBUFFERS 4483 . 5232) (\CLEARMAP 5234 . 8460) (DOPMAP
|
||||
8462 . 8925) (FINDPTRSBUFFER 8927 . 9801) (FORGETPAGES 9803 . 12088) (\GETMAPBUFFER 12090 . 15212) (
|
||||
LOCKMAP 15214 . 15421) (MAPAFTERCLOSE 15423 . 15726) (MAPBUFFERCOUNT 15728 . 16218) (MAPPAGE 16220 .
|
||||
17729) (MAPWORD 17731 . 18044) (\RELEASEBUFFER 18046 . 18615) (RELEASINGVMEMPAGE 18617 . 19254) (
|
||||
RESTOREMAP 19256 . 22053) (UNLOCKMAP 22055 . 22264) (\MAPPAGE 22266 . 27720) (\COLLECTDIRTYBUFS 27722
|
||||
. 28502) (\SETIODIRTY 28504 . 29109)) (29112 30083 (WORDCONTENTS 29122 . 29291) (SETWORDCONTENTS
|
||||
29293 . 29605) (/SETWORDCONTENTS 29607 . 29912) (WORDOFFSET 29914 . 30081)) (31555 51584 (
|
||||
\MAKE.PMAP.DEVICE 31565 . 32893) (\PAGEDBACKFILEPTR 32895 . 35369) (\PAGEDSETFILEPTR 35371 . 36807) (
|
||||
\PAGED.INCFILEPTR 36809 . 39833) (\PAGEDGETFILEPTR 39835 . 40078) (\PAGEDGETEOFPTR 40080 . 40498) (
|
||||
\PAGEDREADP 40500 . 41863) (\PAGEDEOFP 41865 . 43482) (\PAGED.GETNEXTBUFFER 43484 . 47278) (
|
||||
\PAGED.FORCEOUTPUT 47280 . 49728) (\UPDATEOF 49730 . 50562) (\READPAGES 50564 . 51024) (\WRITEPAGES
|
||||
51026 . 51582)) (51585 55677 (\SETEOF 51595 . 52810) (\PAGED.SETEOFPTR 52812 . 54706) (\NEWLENGTHIS
|
||||
54708 . 55675)) (55819 56199 (PPBUFS 55829 . 56197)))))
|
||||
(FILEMAP (NIL (2366 28362 (ADDMAPBUFFER 2376 . 2552) (\ALLOCMAPBUFFER 2554 . 3155) (CHECKBUFFERREFVAL
|
||||
3157 . 3732) (\WRITEOUTBUFFERS 3734 . 4483) (\CLEARMAP 4485 . 7711) (DOPMAP 7713 . 8176) (
|
||||
FINDPTRSBUFFER 8178 . 9052) (FORGETPAGES 9054 . 11339) (\GETMAPBUFFER 11341 . 14463) (LOCKMAP 14465 .
|
||||
14672) (MAPAFTERCLOSE 14674 . 14977) (MAPBUFFERCOUNT 14979 . 15469) (MAPPAGE 15471 . 16980) (MAPWORD
|
||||
16982 . 17295) (\RELEASEBUFFER 17297 . 17866) (RELEASINGVMEMPAGE 17868 . 18505) (RESTOREMAP 18507 .
|
||||
21304) (UNLOCKMAP 21306 . 21515) (\MAPPAGE 21517 . 26971) (\COLLECTDIRTYBUFS 26973 . 27753) (
|
||||
\SETIODIRTY 27755 . 28360)) (28363 29334 (WORDCONTENTS 28373 . 28542) (SETWORDCONTENTS 28544 . 28856)
|
||||
(/SETWORDCONTENTS 28858 . 29163) (WORDOFFSET 29165 . 29332)) (30806 50835 (\MAKE.PMAP.DEVICE 30816 .
|
||||
32144) (\PAGEDBACKFILEPTR 32146 . 34620) (\PAGEDSETFILEPTR 34622 . 36058) (\PAGED.INCFILEPTR 36060 .
|
||||
39084) (\PAGEDGETFILEPTR 39086 . 39329) (\PAGEDGETEOFPTR 39331 . 39749) (\PAGEDREADP 39751 . 41114) (
|
||||
\PAGEDEOFP 41116 . 42733) (\PAGED.GETNEXTBUFFER 42735 . 46529) (\PAGED.FORCEOUTPUT 46531 . 48979) (
|
||||
\UPDATEOF 48981 . 49813) (\READPAGES 49815 . 50275) (\WRITEPAGES 50277 . 50833)) (50836 54928 (\SETEOF
|
||||
50846 . 52061) (\PAGED.SETEOFPTR 52063 . 53957) (\NEWLENGTHIS 53959 . 54926)) (55070 55450 (PPBUFS
|
||||
55080 . 55448)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
183
sources/XXGEOM
183
sources/XXGEOM
@@ -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
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user