Compare commits
39 Commits
v0.14
...
nightly-21
| Author | SHA1 | Date | |
|---|---|---|---|
|
25c397ccdf | ||
|
b18d16b807 | ||
|
|
9b7df4a022 | ||
|
|
4efe2f93af | ||
|
4fac4e3e96 | ||
|
|
966b837351 | ||
|
|
dac0acd0d5 | ||
|
|
105b0d1f3a | ||
|
|
10e3916e7e | ||
|
|
2cf33cebcf | ||
|
|
d40aeffdc7 | ||
|
|
6f9cafc578 | ||
|
|
a781751832 | ||
|
|
d5b26c1352 | ||
|
|
0a5ff04393 | ||
|
|
a946a90ef8 | ||
|
|
66fa5e42cf | ||
|
05df858e55 | ||
|
|
f64f8bbb87 | ||
|
|
2388f730ca | ||
|
|
607d9ab2e7 | ||
|
|
f0ad3c5f60 | ||
|
|
179325c528 | ||
|
|
21c8759084 | ||
|
f0b9ce3dae | ||
|
|
1d81350714 | ||
|
|
5a83a9cd8f | ||
|
|
ba70b3a126 | ||
|
|
26e4af726a | ||
|
|
ad912885aa | ||
|
|
ee5efd782f | ||
|
|
9ddef79484 | ||
|
|
5a04b88dcc | ||
|
|
945ffe56f8 | ||
|
|
7d8efbdfd6 | ||
|
|
6e9791ad0a | ||
|
|
3e64317db5 | ||
|
|
78d53039c5 | ||
|
|
094f0146c9 |
82
.github/workflows/build.yml
vendored
Normal file
82
.github/workflows/build.yml
vendored
Normal file
@@ -0,0 +1,82 @@
|
||||
# based on https://blog.oddbit.com/post/2020-09-25-building-multi-architecture-im/
|
||||
---
|
||||
# Interlisp workflow to build Docker Image that support multiple architectures
|
||||
name: 'Build Medley Docker image'
|
||||
|
||||
# Run this workflow on push to master
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- master
|
||||
|
||||
# Jobs that compose this workflow
|
||||
jobs:
|
||||
# Job to build the docker image
|
||||
docker:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
# Checkout the branch
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
|
||||
# Setup needed environment variables
|
||||
- name: Prepare
|
||||
id: prep
|
||||
run: |
|
||||
DOCKER_IMAGE=interlisp/${GITHUB_REPOSITORY#*/}
|
||||
VERSION=latest
|
||||
SHORTREF=${GITHUB_SHA::8}
|
||||
|
||||
# If this is git tag, use the tag name as a docker tag
|
||||
if [[ $GITHUB_REF == refs/tags/* ]]; then
|
||||
VERSION=${GITHUB_REF#refs/tags/v}
|
||||
fi
|
||||
TAGS="${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${SHORTREF}"
|
||||
|
||||
# If the VERSION looks like a version number, assume that
|
||||
# this is the most recent version of the image and also
|
||||
# tag it 'latest'.
|
||||
if [[ $VERSION =~ ^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$ ]]; then
|
||||
TAGS="$TAGS,${DOCKER_IMAGE}:latest"
|
||||
fi
|
||||
|
||||
# Set output parameters.
|
||||
echo ::set-output name=tags::${TAGS}
|
||||
echo ::set-output name=docker_image::${DOCKER_IMAGE}
|
||||
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
|
||||
|
||||
# Setup Docker Machine Emulation environment
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@master
|
||||
with:
|
||||
platforms: all
|
||||
|
||||
# Setup Docker Buildx function
|
||||
- name: Set up Docker Buildx
|
||||
id: buildx
|
||||
uses: docker/setup-buildx-action@master
|
||||
|
||||
# Login to DockerHub - required to store the image
|
||||
- name: Login to DockerHub
|
||||
if: github.event_name != 'pull_request'
|
||||
uses: docker/login-action@v1
|
||||
with:
|
||||
username: ${{ secrets.DOCKER_USERNAME }}
|
||||
password: ${{ secrets.DOCKER_PASSWORD }}
|
||||
|
||||
# Start the Docker Build using the Dockerfilein the repository
|
||||
- name: Build
|
||||
uses: docker/build-push-action@v2
|
||||
with:
|
||||
builder: ${{ steps.buildx.outputs.name }}
|
||||
context: .
|
||||
file: ./Dockerfile
|
||||
# Platforms
|
||||
# linux/amd64 -- Standard x86_64
|
||||
# linux/arm64 -- Apple M1
|
||||
# linux/arm/v7 -- Raspberry pi
|
||||
platforms: linux/amd64,linux/arm64,linux/arm/v7
|
||||
# Push the created image
|
||||
push: true
|
||||
# tags to assign to the Docker image
|
||||
tags: ${{ steps.prep.outputs.tags }}
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -27,3 +27,4 @@ core
|
||||
|
||||
# set up by install-diff-filter.sh script
|
||||
.gitattributes
|
||||
sources/LLREAD.LCOM.~1~
|
||||
|
||||
29
Dockerfile
29
Dockerfile
@@ -1,24 +1,19 @@
|
||||
FROM ubuntu:focal
|
||||
ENV DEBIAN_FRONTEND=noninteractive
|
||||
FROM interlisp/maiko:latest
|
||||
ARG BUILD_DATE
|
||||
LABEL name="Medley"
|
||||
LABEL description="The Medley Interlisp environment"
|
||||
LABEL url="https://github.com/Interlisp/medley"
|
||||
LABEL build-time=$BUILD_DATE
|
||||
|
||||
RUN apt-get update && apt-get install -y build-essential clang libx11-dev
|
||||
COPY maiko /build/
|
||||
WORKDIR /build/bin
|
||||
RUN rm -rf /build/linux*
|
||||
RUN ./makeright x
|
||||
|
||||
|
||||
FROM ubuntu:focal
|
||||
ENV DEBIAN_FRONTEND=noninteractive
|
||||
RUN apt-get update && apt-get install -y tightvncserver
|
||||
|
||||
EXPOSE 5900
|
||||
|
||||
RUN apt-get update && apt-get install -y tightvncserver
|
||||
RUN mkdir /app
|
||||
WORKDIR /app
|
||||
COPY basics ./
|
||||
COPY --from=0 /build/linux.x86_64/* ./
|
||||
# Need to refine this down to only needed directories.
|
||||
COPY . /app/medley
|
||||
|
||||
WORKDIR /app/medley
|
||||
|
||||
RUN adduser --disabled-password --gecos "" medley
|
||||
USER medley
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1270x720 :0 & DISPLAY=:0 /app/ldex -g 1280x720 full.sysout
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 PATH="/app/maiko:$PATH" ./run-medley -full -g 1280x720 -sc 1280x720
|
||||
0
docs/ReleaseNote/APPENDIXB-SEDIT.pdf
Executable file → Normal file
0
docs/ReleaseNote/APPENDIXB-SEDIT.pdf
Executable file → Normal file
0
docs/ReleaseNote/APPENDIXC-ICONW.pdf
Executable file → Normal file
0
docs/ReleaseNote/APPENDIXC-ICONW.pdf
Executable file → Normal file
0
docs/ReleaseNote/ENVOSCOVERSHEET.pdf
Executable file → Normal file
0
docs/ReleaseNote/ENVOSCOVERSHEET.pdf
Executable file → Normal file
0
docs/ReleaseNote/Indexfinal.pdf
Executable file → Normal file
0
docs/ReleaseNote/Indexfinal.pdf
Executable file → Normal file
0
docs/ReleaseNote/LOT.pdf
Executable file → Normal file
0
docs/ReleaseNote/LOT.pdf
Executable file → Normal file
0
docs/ReleaseNote/PREFACE.pdf
Executable file → Normal file
0
docs/ReleaseNote/PREFACE.pdf
Executable file → Normal file
0
docs/ReleaseNote/PRINTINGSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/PRINTINGSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC4-IRMERRATA.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC4-IRMERRATA.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC7-CLIMPLMNTN.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC7-CLIMPLMNTN.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABS2L.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABS2L.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSINFOP.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSINFOP.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSLAYOUTL.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSLAYOUTL.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/TOC.pdf
Executable file → Normal file
0
docs/ReleaseNote/TOC.pdf
Executable file → Normal file
0
docs/ReleaseNote/Titlepage.pdf
Executable file → Normal file
0
docs/ReleaseNote/Titlepage.pdf
Executable file → Normal file
0
docs/ReleaseNote/indexbase.pdf
Executable file → Normal file
0
docs/ReleaseNote/indexbase.pdf
Executable file → Normal file
@@ -1 +1,65 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 6-Feb-2021 16:44:35" {DSK}<home>larry>ilisp>medley>greetfiles>SIMPLE-INIT.;4 2208
|
||||
|
||||
changes to%: (VARS SIMPLE-INITCOMS)
|
||||
|
||||
previous date%: " 5-Feb-2021 12:57:29" {DSK}<home>larry>ilisp>medley>greetfiles>SIMPLE-INIT.;3
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT SIMPLE-INITCOMS)
|
||||
|
||||
(RPAQQ SIMPLE-INITCOMS
|
||||
(
|
||||
|
||||
(* ;;; " Previous content moved into SYNCLISPFILES ")
|
||||
|
||||
(VARS (FILING.ENUMERATION.DEPTH 1)
|
||||
[LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
[USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT"]
|
||||
(COPYRIGHTSRESERVED NIL))
|
||||
[P (SETQ MEDLEYDIR NIL)
|
||||
(MEDLEY-INIT-VARS)
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
|
||||
(FNS INTERLISPMODE)))
|
||||
|
||||
|
||||
|
||||
(* ;;; " Previous content moved into SYNCLISPFILES ")
|
||||
|
||||
|
||||
(RPAQQ FILING.ENUMERATION.DEPTH 1)
|
||||
|
||||
(RPAQ LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"))))
|
||||
|
||||
(RPAQ USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT")))
|
||||
|
||||
(RPAQQ COPYRIGHTSRESERVED NIL)
|
||||
|
||||
(SETQ MEDLEYDIR NIL)
|
||||
|
||||
(MEDLEY-INIT-VARS)
|
||||
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
|
||||
(DEFINEQ
|
||||
|
||||
(INTERLISPMODE
|
||||
[LAMBDA (OLD?) (* N.H.Briggs " 2-Feb-88 14:26")
|
||||
(PROCESSPROP 'EXEC 'PROFILE (XCL:COPY-PROFILE (if OLD?
|
||||
then "OLD-INTERLISP-T"
|
||||
else "INTERLISP")))
|
||||
(XCL:SET-DEFAULT-EXEC-TYPE (if OLD?
|
||||
then "OLD-INTERLISP-T"
|
||||
else "INTERLISP"))
|
||||
(SETQ *DEFAULT-MAKEFILE-ENVIRONMENT* (LIST :READTABLE (if OLD?
|
||||
then "OLD-INTERLISP-FILE"
|
||||
else "INTERLISP")
|
||||
:PACKAGE "INTERLISP"])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1360 2185 (INTERLISPMODE 1370 . 2183)))))
|
||||
STOP
|
||||
|
||||
@@ -1 +1,62 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "18-Mar-88 16:09:05" {ERIS}<LISPCORE>INTERNAL>LIBRARY>ABC.;4 2101
|
||||
|
||||
changes to%: (VARS ABCCOMS)
|
||||
|
||||
previous date%: "29-Jul-87 12:04:16" {ERIS}<LISPCORE>INTERNAL>LIBRARY>ABC.;3)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ABCCOMS)
|
||||
|
||||
(RPAQQ ABCCOMS ((VARS (MSRECORDTRANFLG T)
|
||||
(DWIMIFYCOMPFLG)
|
||||
(MSMACROPROPS COMPILERMACROPROPS)
|
||||
(CLEANUPOPTIONS '(RC F))
|
||||
(CROSSCOMPILING T)
|
||||
(ASKEDITHIST T)
|
||||
(RECOMPILEDEFAULT 'CHANGES)
|
||||
(CROSSCOMPILING 'ASK))
|
||||
(FILES (SOURCE)
|
||||
FILESETS)
|
||||
(P (MOVD? 'APPLY* 'SPREADAPPLY*)
|
||||
[RESETVARS ((CROSSCOMPILING T))
|
||||
(FILESLOAD EXPORTS.ALL)
|
||||
(AND (EQ (ASKUSER DWIMWAIT 'N "Check imports? " NIL T)
|
||||
'Y)
|
||||
(ERSETQ (CHECKIMPORTS EXPORTFILES T]
|
||||
(PRIN1
|
||||
"**** SET IL:DFNFLG TO IL:PROP IF YOU EDIT SYSTEM SOURCES THAT CAN'T BE RUN INTERPRETED"
|
||||
T))))
|
||||
|
||||
(RPAQQ MSRECORDTRANFLG T)
|
||||
|
||||
(RPAQQ DWIMIFYCOMPFLG NIL)
|
||||
|
||||
(RPAQ MSMACROPROPS COMPILERMACROPROPS)
|
||||
|
||||
(RPAQQ CLEANUPOPTIONS (RC F))
|
||||
|
||||
(RPAQQ CROSSCOMPILING T)
|
||||
|
||||
(RPAQQ ASKEDITHIST T)
|
||||
|
||||
(RPAQQ RECOMPILEDEFAULT CHANGES)
|
||||
|
||||
(RPAQQ CROSSCOMPILING ASK)
|
||||
(FILESLOAD (SOURCE)
|
||||
FILESETS)
|
||||
(MOVD? 'APPLY* 'SPREADAPPLY*)
|
||||
[RESETVARS ((CROSSCOMPILING T))
|
||||
(FILESLOAD EXPORTS.ALL)
|
||||
(AND (EQ (ASKUSER DWIMWAIT 'N "Check imports? " NIL T)
|
||||
'Y)
|
||||
(ERSETQ (CHECKIMPORTS EXPORTFILES T]
|
||||
(PRIN1 "**** SET IL:DFNFLG TO IL:PROP IF YOU EDIT SYSTEM SOURCES THAT CAN'T BE RUN INTERPRETED" T)
|
||||
(PUTPROPS ABC COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -41,11 +41,34 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(PRINT-LAND-MONTH
|
||||
(PRINT-LAND-MONTH
|
||||
(LAMBDA (MONTH YEAR STREAM) (* \; "Edited 17-Oct-87 17:45 by jds")
|
||||
|
||||
(* |;;| "Print a single month's calendar landscape on letter paper.")
|
||||
|
||||
|
||||
(LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'INTERPRESS '(LANDSCAPE T)))))
|
||||
(PRINT-SCALED-MONTH MONTH YEAR 635 635 1.0 1.0 PRINTSTREAM 12 18 6)
|
||||
(CLOSEF PRINTSTREAM))))
|
||||
|
||||
|
||||
(PRINT-LAND-YEAR
|
||||
(LAMBDA (YEAR STREAM) (* \; "Edited 17-Oct-87 17:49 by jds")
|
||||
|
||||
(* |;;| "Print a single month's calendar landscape on letter paper.")
|
||||
|
||||
(LET ((PRINTSTREAM (OR STREAM (OPENIMAGESTREAM "{LPT}" 'INTERPRESS '(LANDSCAPE T)))))
|
||||
(|for| MONTH |from| 1 |to| 12
|
||||
|do| (PRINT-SCALED-MONTH MONTH YEAR 635 635 1.0 1.0 PRINTSTREAM 12 18 6)
|
||||
(DSPNEWPAGE PRINTSTREAM))
|
||||
(CLOSEF PRINTSTREAM))))
|
||||
|
||||
(PRINT-NOTEBOOK-MONTH
|
||||
(LAMBDA (MONTH YEAR STREAM) (* \; "Edited 17-Sep-87 21:55 by jds")
|
||||
|
||||
(* |;;| "Print a single month's calendar on a half-sheet, suitable for punching and putting in a Time-Design notebook or a 5 1/2 x 8 1/2\" reminder book.")
|
||||
|
||||
(* |;;| "If you leave STREAM NIL, you'll get one page on the printer.")
|
||||
|
||||
(PRINT-SCALED-MONTH MONTH YEAR 0 0 0.75 0.6 STREAM)))
|
||||
|
||||
(PRINT-NOTEBOOK-YEAR
|
||||
(LAMBDA (YEAR STREAM) (* \; "Edited 23-Mar-94 17:22 by turpiN:mv:envos")
|
||||
@@ -78,7 +101,10 @@
|
||||
|do| (PRINT-SCALED-MONTH MONTH YEAR 50627 YOFFSET 0.33 0.23 PRINTSTREAM 6 8 6))
|
||||
(CLOSEF PRINTSTREAM))))
|
||||
|
||||
((EVENP MONTH 2)
|
||||
(PRINT-NARROW-MONTH
|
||||
(LAMBDA (MONTH YEAR STREAM) (* \; "Edited 17-Sep-87 22:32 by jds")
|
||||
|
||||
(PRINT-SCALED-MONTH MONTH YEAR 0 0 0.45 0.95 STREAM NIL NIL NIL '(LANDSCAPE T))))
|
||||
)
|
||||
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Binary file not shown.
0
internal/library/DO-TEST.pdf
Executable file → Normal file
0
internal/library/DO-TEST.pdf
Executable file → Normal file
File diff suppressed because one or more lines are too long
@@ -1 +1,71 @@
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
|
||||
(FILECREATED " 3-Dec-86 12:01:43" {ERIS}<LISPCORE>INTERNAL>LIBRARY>FASL-DEBUG.;3 3296
|
||||
|
||||
changes to%: (VARS FASL-DEBUGCOMS)
|
||||
(FUNCTIONS FASL-LOAD DUMP-SOME-TEXT TEST-FASL-OUT DUMP-SOME-VALUES READ-BACK-FASL
|
||||
PROCESS-TEXT PROCESS-ITEM MAKE-FASL-TRACE-WINDOW)
|
||||
|
||||
previous date%: "19-Sep-86 13:32:53" {ERIS}<LISPCORE>INTERNAL>LIBRARY>FASL-DEBUG.;1)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FASL-DEBUGCOMS)
|
||||
|
||||
(RPAQQ FASL-DEBUGCOMS ((FUNCTIONS FASL-LOAD TEST-FASL-OUT DUMP-SOME-TEXT DUMP-SOME-VALUES
|
||||
READ-BACK-FASL PROCESS-TEXT PROCESS-ITEM MAKE-FASL-TRACE-WINDOW)
|
||||
(PROP FILETYPE FASL-DEBUG)))
|
||||
|
||||
(CL:DEFUN FASL-LOAD (NAME) (CL:WITH-OPEN-FILE (S NAME :DIRECTION :INPUT)
|
||||
(FASL:PROCESS-FILE S)))
|
||||
|
||||
|
||||
(CL:DEFUN TEST-FASL-OUT NIL (FASL:WITH-OPEN-HANDLE (HANDLE "test.dfasl;1" :IF-EXISTS :OVERWRITE)
|
||||
(DUMP-SOME-TEXT HANDLE "This is a test.")
|
||||
(DUMP-SOME-VALUES HANDLE)))
|
||||
|
||||
|
||||
(CL:DEFUN DUMP-SOME-TEXT (HANDLE STRING) (CL:PRINC STRING (FASL:BEGIN-TEXT HANDLE)))
|
||||
|
||||
|
||||
(CL:DEFUN DUMP-SOME-VALUES (HANDLE) (FASL:BEGIN-BLOCK HANDLE)
|
||||
(FASL:DUMP-VALUE HANDLE 1.1)
|
||||
(FASL:DUMP-VALUE HANDLE -1.1)
|
||||
(FASL:DUMP-VALUE HANDLE 0.11)
|
||||
(FASL:DUMP-VALUE HANDLE -0.11))
|
||||
|
||||
|
||||
(CL:DEFUN READ-BACK-FASL (&OPTIONAL (NAME "test.dfasl")) [WITH-OPEN-FILE (S NAME :DIRECTION :INPUT)
|
||||
(CL:UNLESS (EQL (BIN S)
|
||||
FASL:SIGNATURE)
|
||||
(CL:ERROR
|
||||
"Incorrect signature.")
|
||||
)
|
||||
(FASL:CHECK-VERSION S)
|
||||
(CL:LOOP (CL:WHEN (EOFP S)
|
||||
(RETURN))
|
||||
(FASL:PROCESS-SEGMENT
|
||||
S
|
||||
#'PROCESS-TEXT
|
||||
#'PROCESS-ITEM])
|
||||
|
||||
|
||||
(CL:DEFUN PROCESS-TEXT (S) (CL:PRINC S)
|
||||
(CL:TERPRI))
|
||||
|
||||
|
||||
(CL:DEFUN PROCESS-ITEM (X) (CL:FORMAT T "Value: ~S~%%" X))
|
||||
|
||||
|
||||
(CL:DEFUN MAKE-FASL-TRACE-WINDOW NIL (LET ((W (CREATEW NIL "FASL trace")))
|
||||
(DSPSCROLL 'ON W)
|
||||
(CL:SETF FASL::DEBUG-STREAM (GETSTREAM W))))
|
||||
|
||||
|
||||
(PUTPROPS FASL-DEBUG FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS FASL-DEBUG COPYRIGHT ("Xerox Corporation" 1986))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +1,56 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 3-May-2018 15:37:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>internal>library>MAKE-EXPORTS-ALL.;1 1800
|
||||
|
||||
changes to%: (VARS MAKE-EXPORTS-ALLCOMS))
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MAKE-EXPORTS-ALLCOMS)
|
||||
|
||||
(RPAQQ MAKE-EXPORTS-ALLCOMS
|
||||
((* "Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME"
|
||||
)
|
||||
(*
|
||||
"Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory."
|
||||
)
|
||||
(* "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||
(* "Edited September 29, 1986 by van Melle")
|
||||
(P (BKSYSBUF '(PROGN (CNDIR (CONCAT (UNIX-GETENV "MEDLEYDIR")
|
||||
'/lispcore/sources/))
|
||||
(LOAD 'FILESETS)
|
||||
(RENAMEFILE (GATHEREXPORTS EXPORTFILES '{CORE}EXPORTS.ALL)
|
||||
'../library/EXPORTS.ALL))
|
||||
T))))
|
||||
|
||||
|
||||
|
||||
(*
|
||||
"Edited May 3, 2018 by Ron Kaplan--relative to MEDLEYDIR/lispcore/. Don't know why it does the CORE/RENAME"
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* "Edited Aug 17 94 by Sybalsky -- point it to /king/export/lispcore as the truth directory.")
|
||||
|
||||
|
||||
|
||||
|
||||
(* "Edited July 5, 1990 by Sybalsky -- point it to Pele as the truth directory.")
|
||||
|
||||
|
||||
|
||||
|
||||
(* "Edited September 29, 1986 by van Melle")
|
||||
|
||||
|
||||
(BKSYSBUF '(PROGN (CNDIR (CONCAT (UNIX-GETENV "MEDLEYDIR")
|
||||
'/lispcore/sources/))
|
||||
(LOAD 'FILESETS)
|
||||
(RENAMEFILE (GATHEREXPORTS EXPORTFILES '{CORE}EXPORTS.ALL)
|
||||
'../library/EXPORTS.ALL))
|
||||
T)
|
||||
(PUTPROPS MAKE-EXPORTS-ALL COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
@@ -1 +1,28 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "15-Jun-90 10:32:43"
|
||||
|{DSK}<usr>local>lde>lispcore>internal>library>MAKE-TCP-EXPORTS.;2| 1356
|
||||
|
||||
|changes| |to:| (VARS MAKE-TCP-EXPORTSCOMS)
|
||||
|
||||
|previous| |date:| "14-Jul-88 19:44:17"
|
||||
|{DSK}<usr>local>lde>lispcore>internal>library>MAKE-TCP-EXPORTS.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT MAKE-TCP-EXPORTSCOMS)
|
||||
|
||||
(RPAQQ MAKE-TCP-EXPORTSCOMS ((VARIABLES XCL-USER::*TCP-EXPORT-LIST*)))
|
||||
|
||||
(DEFGLOBALVAR XCL-USER::*TCP-EXPORT-LIST*
|
||||
'(XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCP XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPCHAT
|
||||
XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPCONFIG XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPDEBUG
|
||||
XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPDOMAIN XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPFTP
|
||||
XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPFTPSRV XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPHTE
|
||||
XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPLLAR XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPLLICMP
|
||||
XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPLLIP XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPNAMES
|
||||
XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPTFTP XCL-USER::{ERIS}<LISPCORE>LIBRARY>TCPUDP))
|
||||
(PUTPROPS MAKE-TCP-EXPORTS COPYRIGHT ("Venue & Xerox Corporation" 1988 1990))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -162,17 +162,166 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(NEWERDCOMS?
|
||||
(NEWERDCOMS?
|
||||
(LAMBDA (DIRPAIRS EXTENSIONS FILTER) (* \; "Edited 9-Dec-86 21:39 by bvm")
|
||||
(OR DIRPAIRS (SETQ DIRPAIRS '(({ERIS}<LISPCORE>NEWSTRING>SOURCES> {ERIS}<LISPCORE>SOURCES>)
|
||||
({ERIS}<LISPCORE>NEWSTRING>LIBRARY> {ERIS}<LISPCORE>LIBRARY>)
|
||||
({ERIS}<LISPCORE>NEWSTRING>INTERNAL>LIBRARY>
|
||||
{ERIS}<LISPCORE>INTERNAL>LIBRARY>))))
|
||||
(OR EXTENSIONS (SETQ EXTENSIONS '(LCOM DCOM)))
|
||||
(|for| PAIR |in| DIRPAIRS
|
||||
|join| (RESETLST
|
||||
(LET ((THISDIR (CAR PAIR))
|
||||
(OTHERDIR (CADR PAIR))
|
||||
(THISEXT (CAR EXTENSIONS))
|
||||
(OTHEREXT (CADR EXTENSIONS))
|
||||
NEXT DT OTHERFILE OTHERDT OTHERWDT THISAUTHOR DIRPRINTED GEN)
|
||||
(SETQ GEN (\\GENERATEFILES (PACKFILENAME.STRING 'DIRECTORY THISDIR
|
||||
'NAME "*" 'EXTENSION THISEXT
|
||||
'VERSION "")
|
||||
'(ICREATIONDATE)
|
||||
'(RESETLST)))
|
||||
(|while| (SETQ NEXT (\\GENERATENEXTFILE GEN)) |eachtime|
|
||||
(SETQ OTHERWDT NIL)
|
||||
|when| (AND (SETQ OTHERFILE (INFILEP (PACKFILENAME.STRING
|
||||
'DIRECTORY OTHERDIR
|
||||
'EXTENSION OTHEREXT
|
||||
'VERSION NIL 'BODY NEXT)))
|
||||
(SETQ DT (\\GENERATEFILEINFO GEN 'ICREATIONDATE))
|
||||
(OR (AND (SETQ OTHERDT (GETFILEINFO OTHERFILE
|
||||
'ICREATIONDATE))
|
||||
(< DT OTHERDT))
|
||||
(AND (SETQ OTHERWDT (GETFILEINFO OTHERFILE
|
||||
'IWRITEDATE))
|
||||
(< DT OTHERWDT)))
|
||||
(OR (NULL FILTER)
|
||||
(CL:FUNCALL FILTER NEXT OTHERFILE DT OTHERDT
|
||||
OTHERWDT GEN)))
|
||||
|collect| (|if| (NOT DIRPRINTED)
|
||||
|then| (|printout| T T " " THISDIR 18
|
||||
"This Date" 38 "Other Date" 58
|
||||
"Author" T)
|
||||
(SETQ DIRPRINTED T))
|
||||
(|printout| T (SUBSTRING NEXT
|
||||
(STRPOS THISDIR NEXT 1 NIL T T
|
||||
UPPERCASEARRAY))
|
||||
18
|
||||
(GDATE DT)
|
||||
38
|
||||
(GDATE OTHERDT)
|
||||
58)
|
||||
(|if| OTHERWDT
|
||||
|then| (|printout| T (GDATE OTHERWDT)
|
||||
" "))
|
||||
(|printout| T (GETFILEINFO OTHERFILE 'AUTHOR)
|
||||
T)
|
||||
(FILENAMEFIELD NEXT 'NAME)))))))
|
||||
|
||||
(OR DIRPAIRS (SETQ DIRPAIRS '(({ERIS}<LISPCORE>NEWSTRING>SOURCES> {ERIS}<LISPCORE>SOURCES>)
|
||||
(NEWERSOURCES?
|
||||
(LAMBDA (DIRPAIRS FILTER) (* \; "Edited 9-Dec-86 23:07 by bvm")
|
||||
(OR DIRPAIRS (SETQ DIRPAIRS '(({ERIS}<LISPCORE>NEWSTRING>SOURCES> {ERIS}<LISPCORE>SOURCES>)
|
||||
({ERIS}<LISPCORE>NEWSTRING>LIBRARY> {ERIS}<LISPCORE>LIBRARY>)
|
||||
({ERIS}<LISPCORE>NEWSTRING>INTERNAL>LIBRARY>
|
||||
{ERIS}<LISPCORE>INTERNAL>LIBRARY>))))
|
||||
(|for| PAIR |in| DIRPAIRS
|
||||
|do| (RESETLST
|
||||
(LET ((THISDIR (CAR PAIR))
|
||||
(OTHERDIR (CADR PAIR))
|
||||
NEXT DT THISFILE THISDT WDT DIRPRINTED GEN)
|
||||
(SETQ GEN (\\GENERATEFILES (PACKFILENAME.STRING 'DIRECTORY OTHERDIR
|
||||
'NAME "*" 'VERSION "")
|
||||
'(ICREATIONDATE IWRITEDATE AUTHOR)
|
||||
'(RESETLST)))
|
||||
(|while| (SETQ NEXT (\\GENERATENEXTFILE GEN))
|
||||
|eachtime| (SETQ THISDT (SETQ WDT (SETQ DT NIL)))
|
||||
|when| (AND (SETQ DT (\\GENERATEFILEINFO GEN 'ICREATIONDATE))
|
||||
(OR (NULL (SETQ THISFILE (INFILEP (PACKFILENAME.STRING
|
||||
'DIRECTORY THISDIR
|
||||
'EXTENSION COMPILE.EXT
|
||||
'VERSION NIL
|
||||
'BODY NEXT))))
|
||||
(AND (SETQ THISDT (GETFILEINFO THISFILE
|
||||
'ICREATIONDATE))
|
||||
(OR (> DT THISDT)
|
||||
(AND (SETQ WDT (\\GENERATEFILEINFO
|
||||
GEN
|
||||
'IWRITEDATE))
|
||||
(> WDT THISDT)))))
|
||||
(OR (NULL FILTER)
|
||||
(CL:FUNCALL FILTER NEXT THISFILE DT WDT THISDT GEN)))
|
||||
|do| (|if| (NOT DIRPRINTED)
|
||||
|then| (|printout| T T " " OTHERDIR 18 " Its Date" 38
|
||||
" Other Date" 58 "Author" T)
|
||||
(SETQ DIRPRINTED T))
|
||||
(OR (GET (NAMEFIELD NEXT)
|
||||
'FILEDATES)
|
||||
(PRIN1 "+" T))
|
||||
(|printout| T (SUBSTRING NEXT
|
||||
(STRPOS OTHERDIR NEXT 1 NIL T T UPPERCASEARRAY
|
||||
))
|
||||
18
|
||||
(GDATE DT)
|
||||
38
|
||||
(|if| THISDT
|
||||
|then| (GDATE THISDT)
|
||||
|else| " - - -")
|
||||
58)
|
||||
(|if| WDT
|
||||
|then| (|printout| T (GDATE WDT)
|
||||
" "))
|
||||
(|printout| T (\\GENERATEFILEINFO GEN 'AUTHOR)
|
||||
T)))))))
|
||||
|
||||
({ERIS}<LISPCORE>NEWSTRING>INTERNAL>LIBRARY>
|
||||
(SETUP-FOR-RECOMPILE
|
||||
(LAMBDA NIL (* \; "Edited 8-Dec-86 21:23 by jop:")
|
||||
(* \;
|
||||
"So we don't get alot of warnings")
|
||||
(SETQ *REMOVE-INTERLISP-COMMENTS* NIL) (* \;
|
||||
"So we don't get asked stupid questions")
|
||||
(SETQ CROSSCOMPILING T) (* \;
|
||||
"setup up new compiled file version")
|
||||
(PUTPROP ':D4 'CODEREADER (COPYALL (GETPROP 'D1 'CODEREADER)))
|
||||
(RPAQQ CODEINDICATOR :D4)
|
||||
(RPAQQ COMPILE.EXT LCOM) (* \;
|
||||
"Smash garbage collectable opcodes")
|
||||
(SMASH-OPCODES GARBAGE-OPCODES) (* \; "Setup for unwind recompile")
|
||||
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>UNWINDMACROS 'SYSLOAD)
|
||||
(* \; "may not be necessary")
|
||||
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>PROC 'PROP) (* \; "Setup for new string recompile")
|
||||
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>LLCHAR 'PROP)
|
||||
(REMPROP 'STRINGP 'DOPVAL) (* \; "to get correct record def's")
|
||||
(LOAD '{ERIS}<LISPCORE>SOURCES>CMLARRAY 'PROP) (* \; "Setup for new stream record")
|
||||
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>FILEIO 'PROP) (* \;
|
||||
"To setup packagified global type number vars")
|
||||
(LOAD '{ERIS}<LISPCORE>NEWSTRING>SOURCES>DTDECLARE.DCOM 'SYSLOAD)
|
||||
(* \;
|
||||
"hack for typep - not needed if makesysdate > Nov 23")
|
||||
(CL:DEFTYPE :DATATYPE (OBJECT)
|
||||
`(DATATYPE ,OBJECT)) (* \; "dribble hack")
|
||||
(WBREAK NIL) (* \; "So the debuuger will compile")
|
||||
(LOAD '{ERIS}<LISPCORE>SOURCES>XCL-PACKAGE.DCOM) (* \; "To fix the broken FP printer")
|
||||
(LOADFNS '\\CONVERT.FLOATING.NUMBER '{ERIS}<LISPCORE>SOURCES>LLFLOAT.DCOM)))
|
||||
|
||||
(OR EXTENSIONS (SETQ EXTENSIONS '(LCOM DCOM)))
|
||||
(SMASH-OPCODES
|
||||
(LAMBDA (OPCODE-ALIST) (* \; "Edited 24-Nov-86 17:56 by jop:")
|
||||
(LET (OPNUMBER)
|
||||
(CL:DOLIST (OPCODE OPCODE-ALIST)
|
||||
(SETQ OPNUMBER (CADR OPCODE))
|
||||
(CL:NSUBSTITUTE-IF (LIST OPNUMBER ':UNUSED)
|
||||
(FUNCTION (CL:LAMBDA (OP)
|
||||
(EQL (CAR OP)
|
||||
OPNUMBER)))
|
||||
\\OPCODES :COUNT 1)
|
||||
(SETQ \\OPCODEARRAY NIL)))))
|
||||
|
||||
|join| (RESETLST
|
||||
(GET-DIRECTORY-LISTING
|
||||
(LAMBDA (DIRECTORY EXTENSION) (* \; "Edited 24-Nov-86 18:14 by jop:")
|
||||
(|for| X |infiles| (DIRECTORY.FILL.PATTERN DIRECTORY (OR EXTENSION "")
|
||||
"") |collect| (FILENAMEFIELD X 'NAME))))
|
||||
|
||||
(OTHERDIR (CADR PAIR))
|
||||
(GET-OPEN-FILES
|
||||
(LAMBDA (DEVICE-NAME) (* \; "Edited 25-Nov-86 18:16 by jop:")
|
||||
(FETCH (FDEV OPENFILELST) OF (CDR (ASSOC DEVICE-NAME \\DEVICENAMETODEVICE)))))
|
||||
)
|
||||
|
||||
|
||||
@@ -326,19 +475,108 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(* |;;| "Control variables")
|
||||
(FIX-FILES
|
||||
(CL:LAMBDA (FILENAMES SOURCEDIR DESTDIR &OPTIONAL (DRIBBLE-FILE '{DSK6}BIGCOMP.DRIBBLE)
|
||||
DELETE-DRIBBLE? RECORDS-TO-FIX) (* \; "Edited 15-Aug-90 12:02 by jds")
|
||||
|
||||
|
||||
(* |;;| "Make large-scale fix-ups to a bunch of files.")
|
||||
|
||||
(PACKAGE-STARTUP LLPACKAGE LLSYMBOL CMLARRAY CMLLIST CMLMACROS DMISC COMPATIBILITY APUTDQ
|
||||
(CL:BLOCK FIX-FILES
|
||||
(LET ((COMPLETION 'ERROR)
|
||||
(NUM-FILES (LENGTH FILENAMES)))
|
||||
(IDLE.SET.OPTION 'TIMEOUT T)
|
||||
(SETQ NOSPELLFLG T)
|
||||
(SETQ DWIMIFYCOMPFLG NIL)
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROGN (DRIBBLE DRIBBLE-FILE)
|
||||
(WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
|
||||
'PAGEFULLFN
|
||||
'NILL)
|
||||
(CNDIR DESTDIR)
|
||||
(PRINTOUT NIL "= = = = = Setting up for large-scale fix-up run on "
|
||||
(DATE)
|
||||
" = = = = =" T T)
|
||||
(|for| FILE |in| FILENAMES |as| FILE-NUM |from| 1
|
||||
|do| (DSPNEWPAGE (GETSTREAM NIL 'OUTPUT))
|
||||
(LET* ((SOURCEFILE (PACKFILENAME 'BODY FILE 'DIRECTORY
|
||||
SOURCEDIR))
|
||||
(DESTFILE (PACKFILENAME 'BODY FILE 'DIRECTORY DESTDIR)))
|
||||
(RESETLST
|
||||
(PRINTOUT NIL T "Fixing file " SOURCEFILE " at "
|
||||
(DATE)
|
||||
" - - -" T)
|
||||
(PRINTOUT NIL T "(File number " FILE-NUM " of "
|
||||
NUM-FILES ": " (- NUM-FILES FILE-NUM)
|
||||
" left)" T T)
|
||||
(PRINT (FIX-FILE FILE RECORDS-TO-FIX)
|
||||
T)
|
||||
(PRINTOUT NIL T T "- - - End of " FILE
|
||||
" fix-up - - -" T))))
|
||||
(PRINTOUT NIL T T T "= = = = = END OF CLEANUP RUN = = = = =")
|
||||
(SETQ COMPLETION 'SUCCESS))
|
||||
(PRINTOUT NIL T "Fix-up status: " COMPLETION T T)
|
||||
(DRIBBLE)
|
||||
(WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
|
||||
'PAGEFULLFN NIL))
|
||||
(SEND.FILE.TO.PRINTER DRIBBLE-FILE)
|
||||
(AND DELETE-DRIBBLE? (DELFILE DRIBBLE-FILE))))))
|
||||
|
||||
BOOTSTRAP MISC AINTERRUPT AERROR ABASIC APRINT ATERM MOD44IO VANILLADISK PMAP ADIR AOFD
|
||||
(FIX-FILE
|
||||
(LAMBDA (FILE RECORD-NAMES MAKEFILE-ONLY?) (* \; "Edited 21-Jan-93 16:30 by jds")
|
||||
|
||||
LLBIGNUM LLFLOAT LLARITH LLARRAYELT LLMVS LLINTERP LLGC LLBASIC IMAGEIO FILEIO LLNEW
|
||||
(* |;;| "Perform cleanup tasks on FILE.")
|
||||
|
||||
DEFPACKAGE-IMPORT XCL-PACKAGE LISP-PACKAGE FASL-PACKAGE COMPILER-PACKAGE BSP DPUPFTP
|
||||
(LOAD FILE 'PROP)
|
||||
(LOADCOMP FILE 'PROP)
|
||||
|
||||
CMLPROGV CMLEVAL COMMON CMLSPECIALFORMS CONDITION-HIERARCHY XCLC-RUNTIME CMLTYPES
|
||||
(* |;;| "(FIX-COPYRIGHT FILE)")
|
||||
|
||||
(AND (FILEFNSLST FILE)
|
||||
(|for| RECNAME |in| (APPEND (FILECOMSLST FILE 'RECORDS)
|
||||
RECORD-NAMES) |do| (QUALIFY-FIELDS RECNAME FILE))
|
||||
)
|
||||
(MARKASCHANGED FILE 'FILES)
|
||||
(COND
|
||||
(MAKEFILE-ONLY? (MAKEFILE FILE))
|
||||
(T (APPLY* 'CLEANUP FILE)))))
|
||||
|
||||
(FIX-COPYRIGHT
|
||||
(LAMBDA (FILENAME)
|
||||
(LET ((CR (GETPROP FILENAME 'COPYRIGHT)))
|
||||
(COND
|
||||
(CR (RPLACA CR "Venue & Xerox Corporation"))
|
||||
(T (PUTPROP FILENAME 'COPYRIGHT (LIST "Venue" 1990)))))))
|
||||
|
||||
(FIX-FILE-COPYRIGHT
|
||||
(LAMBDA (FILE)
|
||||
(LOADFROM FILE NIL 'PROP)
|
||||
(FIX-COPYRIGHT FILE)
|
||||
(MARKASCHANGED FILE 'FILES)
|
||||
(APPLY* 'CLEANUP FILE)))
|
||||
|
||||
(QUALIFY-FIELDS
|
||||
(LAMBDA (RECNAME FILE) (* \; "Edited 28-Sep-87 14:41 by bvm:")
|
||||
(APPLY* 'EDITFNS FILE `(LPQ F ((*ANY* FETCH |fetch| REPLACE |replace| FFETCH |ffetch| FREPLACE
|
||||
|freplace| /REPLACE |/replace|)
|
||||
(*ANY* ,@(APPEND (RECORDFIELDNAMES RECNAME)))
|
||||
--)
|
||||
2
|
||||
(MBD ,RECNAME)
|
||||
0 P))))
|
||||
|
||||
(FIX-TEDIT
|
||||
(LAMBDA (FILE) (* \; "Edited 17-Aug-90 16:07 by jds")
|
||||
(LET ((STRM (OPENTEXTSTREAM (MKATOM FILE))))
|
||||
(TEDIT.SUBLOOKS STRM '(FAMILY OPTIMA)
|
||||
'(FAMILY CLASSIC))
|
||||
(TEDIT.PUT STRM FILE)
|
||||
(CLOSEF STRM))))
|
||||
|
||||
(FIX-DOCS
|
||||
(LAMBDA (DIRECTORY)
|
||||
(LET ((FILES (|for| FILE |in| (DIRECTORY (CONCAT DIRECTORY "*.TEDIT;"))
|
||||
|collect| (PACKFILENAME.STRING 'VERSION NIL 'BODY FILE))))
|
||||
(|for| FILE |in| FILES |do| (FIX-TEDIT FILE)))))
|
||||
)
|
||||
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1 +1,48 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE (DEFPACKAGE "NATIVE-TRANSLATOR" ( USE "IL")))
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE (DEFPACKAGE "NATIVE-TRANSLATOR" ( USE "IL")))
|
||||
(FILECREATED "15-Jun-90 18:46:45"
|
||||
{DSK}<usr>local>lde>lispcore>internal>library>NATIVE-TRANSLATOR-PACKAGE.;2 1706
|
||||
|
||||
changes to%: (VARS NATIVE-TRANSLATOR-PACKAGECOMS)
|
||||
|
||||
previous date%: "10-Jun-88 11:23:35"
|
||||
{DSK}<usr>local>lde>lispcore>internal>library>NATIVE-TRANSLATOR-PACKAGE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT NATIVE-TRANSLATOR-PACKAGECOMS)
|
||||
|
||||
(RPAQQ NATIVE-TRANSLATOR-PACKAGECOMS (
|
||||
|
||||
(* ;;; "Setting up the TRANSLATOR package.")
|
||||
|
||||
(P (DEFPACKAGE "NATIVE-TRANSLATOR" (:NICKNAMES "NT")
|
||||
(:USE "IL")))
|
||||
|
||||
(* ;; "Arrange for the correct makefile environment")
|
||||
|
||||
(PROP MAKEFILE-ENVIRONMENT NATIVE-TRANSLATOR-PACKAGE)))
|
||||
|
||||
|
||||
|
||||
(* ;;; "Setting up the TRANSLATOR package.")
|
||||
|
||||
|
||||
(DEFPACKAGE "NATIVE-TRANSLATOR" (:NICKNAMES "NT")
|
||||
(:USE "IL"))
|
||||
|
||||
|
||||
|
||||
(* ;; "Arrange for the correct makefile environment")
|
||||
|
||||
|
||||
(PUTPROPS NATIVE-TRANSLATOR-PACKAGE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE
|
||||
(DEFPACKAGE
|
||||
"NATIVE-TRANSLATOR"
|
||||
(:USE "IL"))))
|
||||
(PUTPROPS NATIVE-TRANSLATOR-PACKAGE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1 +1,114 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "26-Jun-90 18:51:31" {DSK}<usr>local>lde>lispcore>internal>library>PEANO.;2 3337
|
||||
|
||||
changes to%: (VARS PEANOCOMS)
|
||||
|
||||
previous date%: " 8-Nov-88 14:27:45" {DSK}<usr>local>lde>lispcore>internal>library>PEANO.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PEANOCOMS)
|
||||
|
||||
(RPAQQ PEANOCOMS ((FNS PEANODEMO PEANOROTATE PEANO1 PEANOSTEP)
|
||||
(MACROS PLOT)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(GLOBALVARS XNOW YNOW ORIENT PEANOSCALE PEANOWINDOW)
|
||||
(VARS PEANOSCALE (PEANOWINDOW NIL))))
|
||||
(DEFINEQ
|
||||
|
||||
(PEANODEMO
|
||||
[LAMBDA (LEVEL SCALE) (* rrb "31-MAY-82 12:16")
|
||||
(OR LEVEL (SETQ LEVEL 7))
|
||||
(COND
|
||||
(SCALE (SETQ PEANOSCALE (FIX SCALE)))
|
||||
((FIXP PEANOSCALE))
|
||||
(T (SETQ PEANOSCALE 3)))
|
||||
(PROGN [COND
|
||||
((TYPENAMEP PEANOWINDOW 'WINDOW))
|
||||
(T (SETQ PEANOWINDOW
|
||||
(CREATEW (create REGION
|
||||
LEFT _ 624
|
||||
BOTTOM _ 402
|
||||
WIDTH _ 396
|
||||
HEIGHT _ 406)
|
||||
"Peano curves"]
|
||||
(CLEARW PEANOWINDOW)
|
||||
(MOVETO PEANOSCALE PEANOSCALE PEANOWINDOW))
|
||||
(SETQ XNOW 1)
|
||||
(SETQ YNOW 1)
|
||||
(SETQ ORIENT 0)
|
||||
(PEANO1 LEVEL 1])
|
||||
|
||||
(PEANOROTATE
|
||||
[LAMBDA (DIRECTION) (* bas%: "30-APR-82 19:29")
|
||||
(add ORIENT DIRECTION)
|
||||
(COND
|
||||
((IGREATERP ORIENT 3)
|
||||
(SETQ ORIENT (IDIFFERENCE ORIENT 4)))
|
||||
((ILESSP ORIENT 0)
|
||||
(SETQ ORIENT (IPLUS ORIENT 4])
|
||||
|
||||
(PEANO1
|
||||
[LAMBDA (LEVEL HAND) (* rrb "31-MAY-82 13:17")
|
||||
(COND
|
||||
((EQ LEVEL 1)
|
||||
(PLOT))
|
||||
(T (SETQ LEVEL (SUB1 LEVEL))
|
||||
(PEANOROTATE HAND)
|
||||
(PEANO1 LEVEL (IMINUS HAND))
|
||||
(PEANOSTEP)
|
||||
(PLOT)
|
||||
(PEANOSTEP)
|
||||
(PEANOROTATE (IMINUS HAND))
|
||||
(PEANO1 LEVEL HAND)
|
||||
(PEANOSTEP)
|
||||
(PLOT)
|
||||
(PEANOSTEP)
|
||||
(PEANO1 LEVEL HAND)
|
||||
(PEANOROTATE (IMINUS HAND))
|
||||
(PEANOSTEP)
|
||||
(PLOT)
|
||||
(PEANOSTEP)
|
||||
(PEANO1 LEVEL (IMINUS HAND))
|
||||
(PEANOROTATE HAND)
|
||||
(BLOCK])
|
||||
|
||||
(PEANOSTEP
|
||||
[LAMBDA NIL (* rrb "31-MAY-82 11:31")
|
||||
(SELECTQ ORIENT
|
||||
(0 (SETQ XNOW (ADD1 XNOW)))
|
||||
(1 (SETQ YNOW (ADD1 YNOW)))
|
||||
(2 (SETQ XNOW (SUB1 XNOW)))
|
||||
(3 (SETQ YNOW (SUB1 YNOW)))
|
||||
(ERROR "Step: strange direction" ORIENT))
|
||||
(MOVETO (ITIMES XNOW PEANOSCALE)
|
||||
(ITIMES YNOW PEANOSCALE)
|
||||
PEANOWINDOW])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PLOT MACRO (NIL (RELDRAWTO PEANOSCALE 0 PEANOSCALE 'REPLACE PEANOWINDOW)))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS XNOW YNOW ORIENT PEANOSCALE PEANOWINDOW)
|
||||
)
|
||||
|
||||
(RPAQQ PEANOSCALE 3)
|
||||
|
||||
(RPAQQ PEANOWINDOW NIL)
|
||||
(PUTPROPS PEANO COPYRIGHT ("Venue & Xerox Corporation" 1982 1988 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (726 2957 (PEANODEMO 736 . 1527) (PEANOROTATE 1529 . 1819) (PEANO1 1821 . 2536) (
|
||||
PEANOSTEP 2538 . 2955)))))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1 +1,3 @@
|
||||
Files in this directory /usr/local/lde/internal/
|
||||
Files in this directory /usr/local/lde/internal/
|
||||
where copied from {eris}<lispcore>internal>library>
|
||||
31-Jan-90
|
||||
|
||||
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -1 +1,95 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "26-Jun-90 19:24:01" {DSK}<usr>local>lde>lispcore>internal>library>SPLICE.;2 3583
|
||||
|
||||
changes to%: (VARS SPLICECOMS)
|
||||
|
||||
previous date%: "22-Nov-84 16:35:38" {DSK}<usr>local>lde>lispcore>internal>library>SPLICE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SPLICECOMS)
|
||||
|
||||
(RPAQQ SPLICECOMS ((FNS * SPLICEFNS)
|
||||
(VARS BYTESPERPAGE)))
|
||||
|
||||
(RPAQQ SPLICEFNS (CLIP JJOIN LSPLICE NCLIP NSPLICE SPLICE SPLICEJ SPLICES))
|
||||
(DEFINEQ
|
||||
|
||||
(CLIP
|
||||
[LAMBDA (SRCFIL DSTFIL) (* bvm%: "24-Sep-84 15:03")
|
||||
(CLOSEALL)
|
||||
[COPYBYTES (OPENFILE SRCFIL 'INPUT)
|
||||
(OPENFILE DSTFIL 'BOTH 'OLD NIL '(DON'T.CHANGE.DATE]
|
||||
(CLOSEALL])
|
||||
|
||||
(JJOIN
|
||||
[LAMBDA (SRCFIL DSTFIL) (* scp " 6-DEC-82 15:43")
|
||||
(CLOSEALL)
|
||||
(COPYBYTES (OPENFILE SRCFIL 'INPUT)
|
||||
(OPENFILE DSTFIL 'APPEND 'OLD))
|
||||
(CLOSEALL])
|
||||
|
||||
(LSPLICE
|
||||
[LAMBDA NIL (* scp "14-DEC-82 22:30")
|
||||
(CLIP '{DSK}DLISPDOMINO.DB '{DSK}LISP.DLBOOT])
|
||||
|
||||
(NCLIP
|
||||
[LAMBDA (SRCFIL DSTFIL) (* JonL "22-Nov-84 16:34")
|
||||
(RESETLST
|
||||
[RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
(if (IGREATERP (IABS (IDIFFERENCE 200 (OR (GETFILEINFO SRCFIL 'SIZE)
|
||||
200)))
|
||||
100)
|
||||
then (HELP SRCFIL "File size not appropriate for DLion ucode .db")
|
||||
elseif (AND (NEQ (GETFILEINFO SRCFIL 'TYPE)
|
||||
'BINARY)
|
||||
(GETFILEINFO SRCFIL 'TYPE))
|
||||
then (HELP SRCFIL "File type must be BINARY for DLion ucode .db"))
|
||||
[RESETSAVE [SETQ DSTFIL (OPENSTREAM DSTFIL 'BOTH 'OLD NIL '(DON'T.CHANGE.DATE]
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
(if (ILESSP (OR (GETFILEINFO DSTFIL 'SIZE)
|
||||
2000)
|
||||
2000)
|
||||
then (HELP DSTFIL "File size not appropriate for .sysout")
|
||||
elseif (AND (NEQ (GETFILEINFO DSTFIL 'TYPE)
|
||||
'BINARY)
|
||||
(GETFILEINFO DSTFIL 'TYPE))
|
||||
then (HELP DSTFIL "File type must be BINARY for .sysout")
|
||||
elseif (NOT (RANDACCESSP DSTFIL))
|
||||
then (HELP DSTFIL ".sysout File must be RANDACCESSP for CLIP'ing"))
|
||||
(SETFILEPTR SRCFIL 512)
|
||||
(SETFILEPTR DSTFIL 1024)
|
||||
(COPYBYTES SRCFIL DSTFIL)
|
||||
(LIST (FULLNAME SRCFIL)
|
||||
(FULLNAME DSTFIL)))])
|
||||
|
||||
(NSPLICE
|
||||
[LAMBDA (DLBOOTNAME) (* edited%: " 6-APR-83 15:34")
|
||||
(NCLIP '{DSK}DLISPDOMINO.DB (OR DLBOOTNAME '{DSK}BIGTEST.DLBOOT])
|
||||
|
||||
(SPLICE
|
||||
[LAMBDA (DLBOOTNAME) (* scp "14-JAN-83 11:42")
|
||||
(CLIP '{DSK}DLISPDOMINO.DB (OR DLBOOTNAME '{DSK}BIGTEST.DLBOOT])
|
||||
|
||||
(SPLICEJ
|
||||
[LAMBDA NIL (* scp " 6-DEC-82 15:45")
|
||||
(JOIN '{DSK}TEST.SYSOUT '{DSK}TEST.DLBOOT])
|
||||
|
||||
(SPLICES
|
||||
[LAMBDA NIL (* JonL "22-NOV-82 17:29")
|
||||
(PROG NIL
|
||||
LP (SPLICE)
|
||||
(LOGOUT)
|
||||
(GO LP])
|
||||
)
|
||||
|
||||
(RPAQQ BYTESPERPAGE 512)
|
||||
(PUTPROPS SPLICE COPYRIGHT ("Venue & Xerox Corporation" 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (587 3467 (CLIP 597 . 834) (JJOIN 836 . 1051) (LSPLICE 1053 . 1211) (NCLIP 1213 . 2766)
|
||||
(NSPLICE 2768 . 2950) (SPLICE 2952 . 3127) (SPLICEJ 3129 . 3284) (SPLICES 3286 . 3465)))))
|
||||
STOP
|
||||
|
||||
@@ -1 +1,82 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "26-Jun-90 19:28:14" |{DSK}<usr>local>lde>lispcore>internal>library>TAR.;2| 3663
|
||||
|
||||
|changes| |to:| (VARS TARCOMS)
|
||||
|
||||
|previous| |date:| "31-Dec-00 17:55:22" |{DSK}<usr>local>lde>lispcore>internal>library>TAR.;1|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1900, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT TARCOMS)
|
||||
|
||||
(RPAQQ TARCOMS ((RECORDS TARHEADER)
|
||||
(FNS GATHER-NAME READ-TAR-FILE)))
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD TARHEADER ((FILENAME BYTE 100)
|
||||
(MODE BYTE 8)
|
||||
(UID BYTE 8)
|
||||
(GID BYTE 8)
|
||||
(SIZE BYTE 12)
|
||||
(MTIME BYTE 12)
|
||||
(CHKSUM BYTE 8)
|
||||
(LINKFLAG BYTE)
|
||||
(LINKNAME BYTE 100)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-NAME
|
||||
(LAMBDA (BASE OFFSET) (* \; "Edited 19-Oct-87 00:41 by jds")
|
||||
|
||||
(APPLY 'CONCAT (|bind| CH |for| I |from| OFFSET |to| 100 |until| (ZEROP CH)
|
||||
|when| (NOT (ZEROP (SETQ CH (\\GETBASEBYTE BASE I))))
|
||||
|collect| (COND
|
||||
((IEQP CH (CHARCODE /))
|
||||
">")
|
||||
((IEQP CH (CHARCODE _))
|
||||
"-")
|
||||
(T (CHARACTER CH)))))))
|
||||
|
||||
(READ-TAR-FILE
|
||||
(LAMBDA (FILENAME START LIST-ONLY SKIP-EXISTING-FILES) (* \; "Edited 31-Dec-00 17:55 by jds")
|
||||
|
||||
(CL:WITH-OPEN-STREAM
|
||||
(INSTREAM (OPENSTREAM FILENAME 'INPUT 'OLD '((SEQUENTIAL T)
|
||||
(BUFFERS 40))))
|
||||
(LET* ((BUFFER (NCREATE 'VMEMPAGEP))
|
||||
(SIZE-STRING (CL:MAKE-ARRAY 12 :ELEMENT-TYPE 'CL:STRING-CHAR :DISPLACED-TO-BASE
|
||||
(\\ADDBASE BUFFER 62)))
|
||||
SIZE FILENAME OLDFPTR)
|
||||
|
||||
(* |;;| "Read the file header:")
|
||||
|
||||
(SETFILEPTR INSTREAM (OR START 0))
|
||||
(|while| (NOT (EOFP INSTREAM))
|
||||
|do| (\\BINS INSTREAM BUFFER 0 512)
|
||||
(SETQ FILENAME (GATHER-NAME BUFFER 2))
|
||||
(SETQ SIZE (CL:WITH-INPUT-FROM-STRING (IN SIZE-STRING)
|
||||
(LET ((*READTABLE* (FIND-READTABLE "XCL"))
|
||||
(*READ-BASE* 8))
|
||||
(CL:READ IN))))
|
||||
(PRINTOUT T "FILE: " FILENAME ", SIZE = " SIZE T)
|
||||
(COND
|
||||
((AND (NOT LIST-ONLY)
|
||||
(> SIZE 0))
|
||||
(SETQ OLDFPTR (GETFILEPTR INSTREAM))
|
||||
(COND
|
||||
((OR (NOT SKIP-EXISTING-FILES)
|
||||
(NOT (CL:PROBE-FILE FILENAME)))
|
||||
(CL:WITH-OPEN-STREAM (OUT (OPENSTREAM FILENAME 'OUTPUT 'NEW
|
||||
`((SEQUENTIAL T)
|
||||
(BUFFERS 40)
|
||||
(LENGTH ,SIZE))))
|
||||
(COPYBYTES INSTREAM OUT SIZE))))
|
||||
(SETFILEPTR INSTREAM (+ OLDFPTR (ITIMES 512 (IQUOTIENT (+ SIZE 511)
|
||||
512)))))))))))
|
||||
)
|
||||
(PUTPROPS TAR COPYRIGHT ("Venue & Xerox Corporation" 1987 1900 1990))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (944 3570 (GATHER-NAME 954 . 1560) (READ-TAR-FILE 1562 . 3568)))))
|
||||
STOP
|
||||
|
||||
@@ -1 +1,70 @@
|
||||
(FILECREATED "30-Sep-86 18:49:53" {ERIS}<LISPCORE>INTERNAL>TYPEHAX.;4 3701
|
||||
(FILECREATED "30-Sep-86 18:49:53" {ERIS}<LISPCORE>INTERNAL>TYPEHAX.;4 3701
|
||||
|
||||
changes to: (VARS TYPEHAXCOMS)
|
||||
(FUNCTIONS COLLECT-SUPER-CHAIN TEST-TYPEP ALLOCATE-WITH-NAME ALLOCATE-SUPER-CHAIN
|
||||
ALLOCATE-11-BIT-TYPES ALLOCATE-TO-TYPE-NUMBER)
|
||||
|
||||
previous date: "30-Sep-86 15:05:33" {ERIS}<LISPCORE>INTERNAL>TYPEHAX.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TYPEHAXCOMS)
|
||||
|
||||
(RPAQQ TYPEHAXCOMS ((FUNCTIONS ALLOCATE-11-BIT-TYPES ALLOCATE-SUPER-CHAIN ALLOCATE-TO-TYPE-NUMBER
|
||||
ALLOCATE-WITH-NAME COLLECT-SUPER-CHAIN TEST-TYPEP)))
|
||||
(DEFUN ALLOCATE-11-BIT-TYPES NIL (ALLOCATE-TO-TYPENUMBER 1023)
|
||||
(* ;;;
|
||||
"allocates typenumber 1023, then allocates a type named %"realbig%", and checks it's instances")
|
||||
(ALLOCATE-WITH-NAME (QUOTE REALBIG))
|
||||
(CL:SETQ AREALBIG (NCREATE (QUOTE REALBIG)))
|
||||
(TYPENAMEP AREALBIG (QUOTE REALBIG))
|
||||
(EQ (NTYPX AREALBIG)
|
||||
1024))
|
||||
|
||||
(DEFUN ALLOCATE-SUPER-CHAIN (DEPTH &OPTIONAL (SUPER* (QUOTE SUPER*-TYPE))
|
||||
(ROOT (QUOTE ROOT-TYPE)))
|
||||
(* ;;;
|
||||
"Allocates datatypes up to datatype x inclusive.")
|
||||
(LET ((SUPER (CAAR (DECLAREDATATYPE SUPER* (QUOTE (POINTER))
|
||||
NIL NIL NIL))))
|
||||
(DOTIMES (I (- DEPTH 1))
|
||||
(SETQ SUPER (CAAR (DECLAREDATATYPE (GENSYM (QUOTE TEST))
|
||||
(QUOTE (POINTER))
|
||||
NIL NIL SUPER))))
|
||||
(DECLAREDATATYPE ROOT (QUOTE (POINTER))
|
||||
NIL NIL SUPER)))
|
||||
|
||||
(DEFUN ALLOCATE-TO-TYPE-NUMBER (X) (* ;;;
|
||||
"Allocates datatypes up to datatype x inclusive.")
|
||||
(LET ((REMAINING (- X \MaxTypeNumber)))
|
||||
(CL:IF (< REMAINING 1)
|
||||
(CL:ERROR "There are already ~D datatypes." \MaxTypeNumber)
|
||||
(PROGN (DECLAREDATATYPE (QUOTE TEST-SUPER)
|
||||
(QUOTE (POINTER))
|
||||
NIL NIL) (* ;; "declare a super for the rest of the types.")
|
||||
(DOTIMES (I REMAINING)
|
||||
(DECLAREDATATYPE (GENSYM (QUOTE TEST))
|
||||
(QUOTE (POINTER))
|
||||
NIL NIL (QUOTE TEST-SUPER)))))))
|
||||
|
||||
(DEFUN ALLOCATE-WITH-NAME (TYPENAME &OPTIONAL (SUPER (QUOTE TEST-SUPER)))
|
||||
(ETYPECASE TYPENAME (SYMBOL (DECLAREDATATYPE TYPENAME (QUOTE (POINTER))
|
||||
NIL NIL SUPER))))
|
||||
|
||||
(DEFUN COLLECT-SUPER-CHAIN (ROOT) (CL:DO* ((TYPE ROOT SUPER)
|
||||
(SUPER (GETSUPERTYPE TYPE)
|
||||
(GETSUPERTYPE TYPE))
|
||||
(SUPER-CHAIN NIL))
|
||||
((NULL SUPER)
|
||||
SUPER-CHAIN)
|
||||
(CL:PUSH SUPER SUPER-CHAIN)))
|
||||
|
||||
(DEFUN TEST-TYPEP (TYPE) (* ;;;
|
||||
"ensures that instances of TYPE are instances of all its supertypes.")
|
||||
(LET ((INSTANCE (NCREATE TYPE)))
|
||||
(CL:MAPCAR (CL:FUNCTION (CL:LAMBDA (TYPE)
|
||||
(TYPEP INSTANCE TYPE)))
|
||||
(COLLECT-SUPER-CHAIN TYPE))))
|
||||
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Binary file not shown.
Binary file not shown.
@@ -1,26 +1,30 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "13-Jul-94 15:32:54" |{DSK}<king>export>lispcore>library>BIGBITMAPS.;2| 105325
|
||||
(FILECREATED "13-Jun-2021 14:02:38"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;5| 113115
|
||||
|
||||
|changes| |to:| (VARS BIGBITMAPSCOMS)
|
||||
|changes| |to:| (FNS \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH BIGBITMAPP)
|
||||
(VARS BIGBITMAPSCOMS)
|
||||
|
||||
|previous| |date:| "20-Jan-93 13:40:44" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>BIGBITMAPS.;10|)
|
||||
|previous| |date:| "10-May-2021 15:37:51"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>BIGBITMAPS.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1991, 1993, 1994 by Venue. All rights reserved.
|
||||
; Copyright (c) 1991, 1993-1994, 2021 by Venue.
|
||||
|
||||
(PRETTYCOMPRINT BIGBITMAPSCOMS)
|
||||
|
||||
(RPAQQ BIGBITMAPSCOMS
|
||||
((DECLARE\: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (RECORDS BIGBM)
|
||||
((DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BIGBM)
|
||||
(CONSTANTS (|\\MaxBitMapHeight| 65535)
|
||||
(|\\MaxBitMapWidth| 65535)
|
||||
(|\\MaxBitMapWords| 131066))
|
||||
(MACROS |GetNewFragment|)
|
||||
(MACROS |\\SFInvert|))
|
||||
(INITRECORDS BIGBM)
|
||||
(FNS BITBLT.BIGBM BITMAPCREATE.BIGBM BITMAPCREATE BITMAPCOPY BLTSHADE.BIGBM BITBLT
|
||||
(FNS BIGBITMAPP BITBLT.BIGBM BITMAPCREATE.BIGBM BITMAPCREATE BITMAPCOPY BLTSHADE.BIGBM BITBLT
|
||||
\\ORG.BITBLT \\BLTSHADE.DISPLAY \\RESHOWBORDER1)
|
||||
(FNS \\DRAWCIRCLE.BIGBM \\FILLCIRCLE.BIGBM \\DRAWELLIPSE.BIGBM \\DRAWCURVE.BIGBM)
|
||||
(FNS \\DRAWCIRCLE.BIGBM \\FILLCIRCLE.BIGBM \\DRAWELLIPSE.BIGBM \\DRAWCURVE.BIGBM
|
||||
\\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH)
|
||||
(FNS DSPCREATE DSPDESTINATION |\\SFFixY| |\\SFFixDestination| |\\SFFixClippingRegion|)
|
||||
(FNS \\SW2BM BITMAPHEIGHT BITMAPWIDTH |\\SFFixFont| BITSPERPIXEL)
|
||||
(FNS COLORIZEBITMAP \\BWTOCOLORBLT UNCOLORIZEBITMAP)
|
||||
@@ -28,7 +32,7 @@
|
||||
(MOVD? 'BLTSHADE 'ORG.BLTSHADE)
|
||||
(MOVD 'BLTSHADE.BIGBM 'BLTSHADE)
|
||||
(MOVD 'BITBLT 'BKBITBLT)))))
|
||||
(DECLARE\: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(DATATYPE BIGBM (BIGBMWIDTH BIGBMHEIGHT BIGBMLIST))
|
||||
@@ -65,11 +69,11 @@
|
||||
|
||||
(PUTPROPS |\\SFInvert| MACRO ((|BitMap| \y)
|
||||
|
||||
(* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| |are| |stored| |with|
|
||||
0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower|
|
||||
|left.| |The| |correction| |is| |actually| |off| |by| |one|
|
||||
(|greater|) |because| \a |majority| |of| |the| |places| |that| |it| |is|
|
||||
|called| |actually| |need| |one| |more| |than| |corrected| Y |value.|)
|
||||
(* |corrects| |for| |the| |fact| |that| |alto| |bitmaps| |are| |stored| |with|
|
||||
0\,0 |as| |upper| |left| |while| |lisp| |bitmaps| |have| 0\,0 |as| |lower|
|
||||
|left.| |The| |correction| |is| |actually| |off| |by| |one|
|
||||
(|greater|) |because| \a |majority| |of| |the| |places| |that| |it| |is|
|
||||
|called| |actually| |need| |one| |more| |than| |corrected| Y |value.|)
|
||||
|
||||
(IDIFFERENCE (|fetch| (BITMAP BITMAPHEIGHT) |of|
|
||||
|BitMap|)
|
||||
@@ -84,6 +88,10 @@
|
||||
'6)
|
||||
(DEFINEQ
|
||||
|
||||
(BIGBITMAPP
|
||||
(LAMBDA (X) (* \; "Edited 13-Jun-2021 13:27 by rmk:")
|
||||
(TYPE? BIGBM X)))
|
||||
|
||||
(BITBLT.BIGBM
|
||||
(LAMBDA (SRCE SRCELEFT SRCEBOTTOM DEST DESTLEFT DESTBOTTOM WIDTH HEIGHT SRCETYPE OPERATION TEXTURE
|
||||
CLIPPINGREGION) (* \; "Edited 24-Jan-91 11:19 by matsuda")
|
||||
@@ -989,6 +997,114 @@
|
||||
)
|
||||
(RETURN DISPLAYSTREAM)))
|
||||
(T (\\DRAWCURVE.DISPLAY DISPLAYSTREAM KNOTS CLOSED BRUSH DASHING))))))
|
||||
|
||||
(\\DRAWLINE.BIGBM.DASH
|
||||
(LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 BRUSH DASHING OPERATION)
|
||||
(* \; "Edited 13-Jun-2021 14:02 by rmk:")
|
||||
(GLOBALRESOURCES \\BRUSHBBT (LET ((DD (|fetch| IMAGEDATA |of| DISPLAYSTREAM))
|
||||
BITMAP BIGBMLIST HEIGHT BOTTOM BM YY1 YY2 |ClippingTop|
|
||||
|ClippingBottom| |CTop| |CBottom|)
|
||||
(SETQ BITMAP (|ffetch| |DDDestination| |of| DD))
|
||||
(SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP))
|
||||
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
|
||||
(SETQ |ClippingTop| (|ffetch| |DDClippingTop| |of|
|
||||
DD))
|
||||
(SETQ |ClippingBottom| (|ffetch| |DDClippingBottom|
|
||||
|of| DD))
|
||||
(SETQ BM (|GetNewFragment| BIGBMLIST))
|
||||
(|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|))
|
||||
|do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT
|
||||
BM)))
|
||||
(SETQ |CTop| (COND
|
||||
((IGREATERP |ClippingTop| HEIGHT)
|
||||
(IDIFFERENCE HEIGHT BOTTOM))
|
||||
(T (IDIFFERENCE |ClippingTop| BOTTOM)))
|
||||
)
|
||||
(|if| (IGEQ |CTop| 0)
|
||||
|then| (SETQ |CBottom|
|
||||
(COND
|
||||
((ILESSP |ClippingBottom| BOTTOM)
|
||||
0)
|
||||
(T (IDIFFERENCE |ClippingBottom|
|
||||
BOTTOM))))
|
||||
(|replace| |DDDestination| |of|
|
||||
DD
|
||||
|with| BM)
|
||||
(|replace| |DDClippingTop| |of|
|
||||
DD
|
||||
|with| |CTop|)
|
||||
(|replace| |DDClippingBottom|
|
||||
|of| DD |with| |CBottom|)
|
||||
(\\LINEWITHBRUSH X1 (IDIFFERENCE Y1 BOTTOM)
|
||||
X2
|
||||
(IDIFFERENCE Y2 BOTTOM)
|
||||
BRUSH
|
||||
(\\GOOD.DASHLST DASHING BRUSH)
|
||||
DISPLAYSTREAM \\BRUSHBBT OPERATION)
|
||||
(SETQ BM (|GetNewFragment| BIGBMLIST))
|
||||
(SETQ HEIGHT BOTTOM)))
|
||||
(|freplace| |DDDestination| |of| DD |with| BITMAP)
|
||||
(|freplace| |DDClippingTop| |of| DD |with|
|
||||
|ClippingTop|)
|
||||
(|freplace| |DDClippingBottom| |of| DD |with|
|
||||
|ClippingBottom|
|
||||
)))))
|
||||
|
||||
(\\DRAWLINE.BIGBM.NODASH
|
||||
(LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR)
|
||||
(* \; "Edited 13-Jun-2021 13:59 by rmk:")
|
||||
(LET ((DD (|fetch| IMAGEDATA |of| DISPLAYSTREAM))
|
||||
BITMAP BIGBMLIST HEIGHT BOTTOM BM |CTop| |CBottom| |ClippingTop| |ClippingBottom| YY1 YY2)
|
||||
(SETQ BITMAP (|ffetch| |DDDestination| |of| DD))
|
||||
(SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP))
|
||||
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
|
||||
(SETQ BM (|GetNewFragment| BIGBMLIST))
|
||||
(SETQ |ClippingTop| (|ffetch| |DDClippingTop| |of| DD))
|
||||
(SETQ |ClippingBottom| (|ffetch| |DDClippingBottom| |of| DD))
|
||||
(SETQ YY1 (\\DSPTRANSFORMY (OR (FIXP Y1)
|
||||
(FIXR Y1))
|
||||
DD))
|
||||
(SETQ YY2 (\\DSPTRANSFORMY (OR (FIXP Y2)
|
||||
(FIXR Y2))
|
||||
DD))
|
||||
(|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|))
|
||||
|do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM)))
|
||||
(SETQ |CTop| (COND
|
||||
((IGREATERP |ClippingTop| HEIGHT)
|
||||
(IDIFFERENCE HEIGHT BOTTOM))
|
||||
(T (IDIFFERENCE |ClippingTop| BOTTOM))))
|
||||
(COND
|
||||
((IGEQ |CTop| 0)
|
||||
(SETQ |CBottom| (COND
|
||||
((ILESSP |ClippingBottom| BOTTOM)
|
||||
0)
|
||||
(T (IDIFFERENCE |ClippingBottom| BOTTOM))))
|
||||
(\\CLIPANDDRAWLINE (\\DSPTRANSFORMX (OR (FIXP X1)
|
||||
(FIXR X1))
|
||||
DD)
|
||||
(IDIFFERENCE YY1 BOTTOM)
|
||||
(\\DSPTRANSFORMX (OR (FIXP X2)
|
||||
(FIXR X2))
|
||||
DD)
|
||||
(IDIFFERENCE YY2 BOTTOM)
|
||||
(COND
|
||||
((NULL WIDTH)
|
||||
1)
|
||||
((OR (FIXP WIDTH)
|
||||
(FIXR WIDTH))))
|
||||
(SELECTQ OPERATION
|
||||
(NIL (|ffetch| DDOPERATION |of| DD))
|
||||
((REPLACE PAINT INVERT ERASE)
|
||||
OPERATION)
|
||||
(\\ILLEGAL.ARG OPERATION))
|
||||
BM
|
||||
(|ffetch| |DDClippingLeft| |of| DD)
|
||||
(SUB1 (|ffetch| |DDClippingRight| |of| DD))
|
||||
|CBottom|
|
||||
(SUB1 |CTop|)
|
||||
DISPLAYSTREAM COLOR)))
|
||||
(SETQ BM (|GetNewFragment| BIGBMLIST))
|
||||
(SETQ HEIGHT BOTTOM)))))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1400,14 +1516,14 @@
|
||||
(RETURN COLORBITMAP))))
|
||||
|
||||
(\\BWTOCOLORBLT
|
||||
(LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
|
||||
(* \; "Edited 13-Jul-90 14:11 by matsuda")
|
||||
(LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
|
||||
(* \; "Edited 8-May-2021 22:31 by rmk:")
|
||||
|
||||
(* |blits| |from| \a |black| |and| |white| |bitmap| |into| \a |color| |bitmap|
|
||||
|which| |has| DESTNBITS |bits| |per| |pixel.|
|
||||
DESTCOLORBM |is| \a |pointer| |to| |the| |color| |bitmap.|)
|
||||
(* |assumes| |all| |datatypes| |and|
|
||||
|bounds| |have| |been| |checked|)
|
||||
(* |blits| |from| \a |black| |and| |white| |bitmap| |into| \a |color| |bitmap|
|
||||
|which| |has| DESTNBITS |bits| |per| |pixel.|
|
||||
DESTCOLORBM |is| \a |pointer| |to| |the| |color| |bitmap.|)
|
||||
(* |assumes| |all| |datatypes| |and|
|
||||
|bounds| |have| |been| |checked|)
|
||||
(SELECTQ DESTNBITS
|
||||
(4 (PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW DESWRD DESOFF
|
||||
NBITS DESALIGNLEFT SCR)
|
||||
@@ -1422,24 +1538,24 @@
|
||||
(SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM))
|
||||
(SETQ DESWRD (FOLDLO DLEFT 4))
|
||||
(SETQ DESOFF (MOD DLEFT 4))
|
||||
(SETQ NBITS 4) (* DESTCOLORBM |is| |used| |to|
|
||||
|allow| |one| |bit| |per| |pixel|
|
||||
|bitblt| |operations| |on| |the|
|
||||
|bitmap.|)
|
||||
(SETQ NBITS 4) (* DESTCOLORBM |is| |used| |to|
|
||||
|allow| |one| |bit| |per| |pixel|
|
||||
|bitblt| |operations| |on| |the|
|
||||
|bitmap.|)
|
||||
(COND
|
||||
((NOT (EQ 0 DESOFF)) (* |save| |the| |left| |bits| |of|
|
||||
|the| |destination| |bitmap| |so|
|
||||
|it| |can| |be| |word| |aligned.|)
|
||||
((NOT (EQ 0 DESOFF)) (* |save| |the| |left| |bits| |of|
|
||||
|the| |destination| |bitmap| |so|
|
||||
|it| |can| |be| |word| |aligned.|)
|
||||
(SETQ SCR (BITMAPCREATE 4 HEIGHT 4))
|
||||
(BITBLT DESTCOLORBM (SETQ DESALIGNLEFT (LLSH DESWRD 2))
|
||||
DBOTTOM SCR 0 0 DESOFF HEIGHT 'INPUT 'REPLACE)))
|
||||
(|for| LINECOUNTER |from| 1 |to| HEIGHT
|
||||
|do|
|
||||
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|)
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|)
|
||||
|
||||
(\\4BITLINEBLT (\\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT
|
||||
(IPLUS LINECOUNTER
|
||||
@@ -1454,9 +1570,9 @@
|
||||
DESWRD))
|
||||
WIDTH MAP 0COLOR 1COLOR))
|
||||
(COND
|
||||
(DESALIGNLEFT (* |move| |the| |color| |bits| |to|
|
||||
|the| |right| |and| |restore| |the|
|
||||
|saved| |color| |bits.|)
|
||||
(DESALIGNLEFT (* |move| |the| |color| |bits| |to|
|
||||
|the| |right| |and| |restore| |the|
|
||||
|saved| |color| |bits.|)
|
||||
(BITBLT DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM (IPLUS
|
||||
DESALIGNLEFT
|
||||
DESOFF)
|
||||
@@ -1464,32 +1580,32 @@
|
||||
(BITBLT SCR 0 0 DESTCOLORBM DESALIGNLEFT DBOTTOM DESOFF HEIGHT
|
||||
'INPUT
|
||||
'REPLACE)))))
|
||||
(8 ((OPCODES SUBRCALL 142 11)
|
||||
SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS)
|
||||
(8
|
||||
|
||||
(* PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW
|
||||
DESWRD DESOFF) (SETQ MAP (|fetch| (ARRAYP BASE) |of|
|
||||
(\\MAP8 0COLOR 1COLOR))) (SETQ SRCBASE (|fetch|
|
||||
(BITMAP BITMAPBASE) |of| SOURCEBWBM)) (SETQ SRCHEIGHT
|
||||
(|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM))
|
||||
(SETQ SRCRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| SOURCEBWBM))
|
||||
(SETQ SRCWRD (FOLDLO SLEFT BITSPERWORD))
|
||||
(SETQ SRCOFFSET (MOD SLEFT BITSPERWORD))
|
||||
(SETQ DESBASE (|fetch| (BITMAP BITMAPBASE) |of| DESTCOLORBM))
|
||||
(SETQ DESHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| DESTCOLORBM))
|
||||
(SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM))
|
||||
(SETQ DESWRD (FOLDLO DLEFT 2)) (SETQ DESOFF
|
||||
(MOD DLEFT 2)) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do|
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|) (\\8BITLINEBLT (\\ADDBASE SRCBASE
|
||||
(IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER SBOTTOM)) SRCRW)
|
||||
SRCWRD)) SRCOFFSET (\\ADDBASE DESBASE (IPLUS
|
||||
(ITIMES (IDIFFERENCE DESHEIGHT (IPLUS LINECOUNTER DBOTTOM)) DESRW) DESWRD))
|
||||
DESOFF WIDTH MAP 0COLOR 1COLOR)) *)
|
||||
(* PROG (MAP SRCBASE SRCHEIGHT SRCRW SRCWRD SRCOFFSET DESBASE DESHEIGHT DESRW
|
||||
DESWRD DESOFF) (SETQ MAP (|fetch| (ARRAYP BASE) |of|
|
||||
(\\MAP8 0COLOR 1COLOR))) (SETQ SRCBASE (|fetch|
|
||||
(BITMAP BITMAPBASE) |of| SOURCEBWBM)) (SETQ SRCHEIGHT
|
||||
(|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM))
|
||||
(SETQ SRCRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| SOURCEBWBM))
|
||||
(SETQ SRCWRD (FOLDLO SLEFT BITSPERWORD))
|
||||
(SETQ SRCOFFSET (MOD SLEFT BITSPERWORD))
|
||||
(SETQ DESBASE (|fetch| (BITMAP BITMAPBASE) |of| DESTCOLORBM))
|
||||
(SETQ DESHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| DESTCOLORBM))
|
||||
(SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM))
|
||||
(SETQ DESWRD (FOLDLO DLEFT 2)) (SETQ DESOFF
|
||||
(MOD DLEFT 2)) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do|
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|) (\\8BITLINEBLT (\\ADDBASE SRCBASE
|
||||
(IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT (IPLUS LINECOUNTER SBOTTOM)) SRCRW)
|
||||
SRCWRD)) SRCOFFSET (\\ADDBASE DESBASE (IPLUS
|
||||
(ITIMES (IDIFFERENCE DESHEIGHT (IPLUS LINECOUNTER DBOTTOM)) DESRW) DESWRD))
|
||||
DESOFF WIDTH MAP 0COLOR 1COLOR)) *)
|
||||
|
||||
)
|
||||
((OPCODES SUBRCALL 142 11)
|
||||
SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS))
|
||||
(24 (PROG (SRCBASE SRCHEIGHT SRCRW DESBASE DESHEIGHT DESRW)
|
||||
(SETQ SRCBASE (|fetch| (BITMAP BITMAPBASE) |of| SOURCEBWBM))
|
||||
(SETQ SRCHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCEBWBM))
|
||||
@@ -1500,10 +1616,10 @@
|
||||
(|for| LINECOUNTER |from| 1 |to| HEIGHT
|
||||
|do|
|
||||
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|)
|
||||
(* |linecounter| |goes| |from| 1 |to| |height| |because| |bitmaps| |are|
|
||||
|stored| |internally| |with| |top| |first| |so| |subtracting| |height| |is|
|
||||
|necessary| |to| |get| |offset| |of| |line| |and| |the| 1 |corrects| |for|
|
||||
|height| |difference.|)
|
||||
|
||||
(\\24BITLINEBLT (\\ADDBASE SRCBASE (ITIMES (IDIFFERENCE SRCHEIGHT
|
||||
(IPLUS LINECOUNTER
|
||||
@@ -1630,16 +1746,17 @@
|
||||
|
||||
(MOVD 'BITBLT 'BKBITBLT)
|
||||
)
|
||||
(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994))
|
||||
(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994 2021))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (3181 47731 (BITBLT.BIGBM 3191 . 14014) (BITMAPCREATE.BIGBM 14016 . 15358) (BITMAPCREATE
|
||||
15360 . 16962) (BITMAPCOPY 16964 . 17499) (BLTSHADE.BIGBM 17501 . 20637) (BITBLT 20639 . 22287) (
|
||||
\\ORG.BITBLT 22289 . 33858) (\\BLTSHADE.DISPLAY 33860 . 43098) (\\RESHOWBORDER1 43100 . 47729)) (47732
|
||||
63529 (\\DRAWCIRCLE.BIGBM 47742 . 51105) (\\FILLCIRCLE.BIGBM 51107 . 55153) (\\DRAWELLIPSE.BIGBM
|
||||
55155 . 59675) (\\DRAWCURVE.BIGBM 59677 . 63527)) (63530 79105 (DSPCREATE 63540 . 65970) (
|
||||
DSPDESTINATION 65972 . 69870) (|\\SFFixY| 69872 . 75594) (|\\SFFixDestination| 75596 . 76779) (
|
||||
|\\SFFixClippingRegion| 76781 . 79103)) (79106 87192 (\\SW2BM 79116 . 84140) (BITMAPHEIGHT 84142 .
|
||||
84640) (BITMAPWIDTH 84642 . 85134) (|\\SFFixFont| 85136 . 86108) (BITSPERPIXEL 86110 . 87190)) (87193
|
||||
105083 (COLORIZEBITMAP 87203 . 89840) (\\BWTOCOLORBLT 89842 . 98124) (UNCOLORIZEBITMAP 98126 . 105081)
|
||||
))))
|
||||
(FILEMAP (NIL (3337 48035 (BIGBITMAPP 3347 . 3493) (BITBLT.BIGBM 3495 . 14318) (BITMAPCREATE.BIGBM
|
||||
14320 . 15662) (BITMAPCREATE 15664 . 17266) (BITMAPCOPY 17268 . 17803) (BLTSHADE.BIGBM 17805 . 20941)
|
||||
(BITBLT 20943 . 22591) (\\ORG.BITBLT 22593 . 34162) (\\BLTSHADE.DISPLAY 34164 . 43402) (
|
||||
\\RESHOWBORDER1 43404 . 48033)) (48036 71314 (\\DRAWCIRCLE.BIGBM 48046 . 51409) (\\FILLCIRCLE.BIGBM
|
||||
51411 . 55457) (\\DRAWELLIPSE.BIGBM 55459 . 59979) (\\DRAWCURVE.BIGBM 59981 . 63831) (
|
||||
\\DRAWLINE.BIGBM.DASH 63833 . 68192) (\\DRAWLINE.BIGBM.NODASH 68194 . 71312)) (71315 86890 (DSPCREATE
|
||||
71325 . 73755) (DSPDESTINATION 73757 . 77655) (|\\SFFixY| 77657 . 83379) (|\\SFFixDestination| 83381
|
||||
. 84564) (|\\SFFixClippingRegion| 84566 . 86888)) (86891 94977 (\\SW2BM 86901 . 91925) (BITMAPHEIGHT
|
||||
91927 . 92425) (BITMAPWIDTH 92427 . 92919) (|\\SFFixFont| 92921 . 93893) (BITSPERPIXEL 93895 . 94975))
|
||||
(94978 112868 (COLORIZEBITMAP 94988 . 97625) (\\BWTOCOLORBLT 97627 . 105909) (UNCOLORIZEBITMAP 105911
|
||||
. 112866)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +1,17 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 1-Aug-2020 21:16:25" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CHARS.;1 517
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CHARSCOMS)
|
||||
|
||||
(RPAQQ CHARSCOMS ((ALISTS (CHARACTERNAMES RSQ LSQ LDQ RDQ NEQ))))
|
||||
|
||||
(ADDTOVAR CHARACTERNAMES (RSQ "0,271")
|
||||
(LSQ "0,251")
|
||||
(LDQ "0,252")
|
||||
(RDQ "0,272")
|
||||
(NEQ "041,142"))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
692
library/CHAT
692
library/CHAT
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -1 +1,100 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "20-Jan-93 13:47:40" {DSK}<python>lde>lispcore>library>CHATDECLS.;2 3757
|
||||
|
||||
changes to%: (RECORDS CHAT.STATE CHATDISPLAYTYPE CHATUSERSTATE)
|
||||
|
||||
previous date%: "11-Jun-90 14:39:02" {DSK}<python>lde>lispcore>library>CHATDECLS.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CHATDECLSCOMS)
|
||||
|
||||
(RPAQQ CHATDECLSCOMS ((* Declarations used by various CHAT files)
|
||||
(RECORDS CHAT.STATE CHATDISPLAYTYPE CHATUSERSTATE)))
|
||||
|
||||
|
||||
|
||||
(* Declarations used by various CHAT files)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE CHAT.STATE ((HELD FLAG)
|
||||
(CHATINEMACS FLAG)
|
||||
(UNDERLINEMODE FLAG)
|
||||
(ROLLMODE FLAG)
|
||||
(WRAPMODE FLAG)
|
||||
(LOCALECHO FLAG)
|
||||
(NIL BITS 1)
|
||||
(RUNNING? POINTER)
|
||||
(WINDOW POINTER)
|
||||
(DSP POINTER)
|
||||
(OUTSTREAM POINTER)
|
||||
(INSTREAM POINTER)
|
||||
(TEXTSTREAM POINTER)
|
||||
(TTYWIDTH WORD)
|
||||
(TTYHEIGHT WORD)
|
||||
(XPOS WORD)
|
||||
(YPOS WORD)
|
||||
(FONTWIDTH WORD)
|
||||
(FONTHEIGHT WORD)
|
||||
(FONTDESCENT WORD)
|
||||
(TOPMARGIN WORD)
|
||||
(BOTTOMMARGIN WORD)
|
||||
CLEARMODEFN TYPEOUTPROC TERM.TAB.STOPS TERM.IDENTITY.STRING
|
||||
TERM.NORMAL.FONT ITALICFONT TERM.STATE FONT PLAINFONT CHATBOLDFONT HOMEPOS
|
||||
TYPESCRIPTSTREAM)
|
||||
XPOS _ 0 YPOS _ 0 BOTTOMMARGIN _ 0 ROLLMODE _ T)
|
||||
|
||||
(RECORD CHATDISPLAYTYPE (HOST DPYCODE DPYNAME))
|
||||
|
||||
(RECORD CHATUSERSTATE (HELD RUNNING? INSTREAM OUTSTREAM CARETSTATE TYPESCRIPTOFD TYPEOUTPROC
|
||||
CHATINEMACS))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'CHAT.STATE
|
||||
'(FLAG FLAG FLAG FLAG FLAG FLAG (BITS 1)
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD WORD WORD
|
||||
WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER)
|
||||
'((CHAT.STATE 0 (FLAGBITS . 0))
|
||||
(CHAT.STATE 0 (FLAGBITS . 16))
|
||||
(CHAT.STATE 0 (FLAGBITS . 32))
|
||||
(CHAT.STATE 0 (FLAGBITS . 48))
|
||||
(CHAT.STATE 0 (FLAGBITS . 64))
|
||||
(CHAT.STATE 0 (FLAGBITS . 80))
|
||||
(CHAT.STATE 0 (BITS . 96))
|
||||
(CHAT.STATE 2 POINTER)
|
||||
(CHAT.STATE 4 POINTER)
|
||||
(CHAT.STATE 6 POINTER)
|
||||
(CHAT.STATE 8 POINTER)
|
||||
(CHAT.STATE 10 POINTER)
|
||||
(CHAT.STATE 12 POINTER)
|
||||
(CHAT.STATE 1 (BITS . 15))
|
||||
(CHAT.STATE 14 (BITS . 15))
|
||||
(CHAT.STATE 15 (BITS . 15))
|
||||
(CHAT.STATE 16 (BITS . 15))
|
||||
(CHAT.STATE 17 (BITS . 15))
|
||||
(CHAT.STATE 18 (BITS . 15))
|
||||
(CHAT.STATE 19 (BITS . 15))
|
||||
(CHAT.STATE 20 (BITS . 15))
|
||||
(CHAT.STATE 21 (BITS . 15))
|
||||
(CHAT.STATE 22 POINTER)
|
||||
(CHAT.STATE 24 POINTER)
|
||||
(CHAT.STATE 26 POINTER)
|
||||
(CHAT.STATE 28 POINTER)
|
||||
(CHAT.STATE 30 POINTER)
|
||||
(CHAT.STATE 32 POINTER)
|
||||
(CHAT.STATE 34 POINTER)
|
||||
(CHAT.STATE 36 POINTER)
|
||||
(CHAT.STATE 38 POINTER)
|
||||
(CHAT.STATE 40 POINTER)
|
||||
(CHAT.STATE 42 POINTER)
|
||||
(CHAT.STATE 44 POINTER))
|
||||
'46)
|
||||
(PUTPROPS CHATDECLS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1990 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
1265
library/COLOR
1265
library/COLOR
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1,4 +1,61 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 3-May-93 18:44:36" "{DSK}<project>lfg>parser>DATABASEFNS.;4" 17283
|
||||
|
||||
changes to%: (FNS DUMPDB)
|
||||
|
||||
previous date%: " 7-Jul-92 09:57:14" "{DSK}<project>lfg>parser>DATABASEFNS.;3")
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DATABASEFNSCOMS)
|
||||
|
||||
(RPAQQ DATABASEFNSCOMS
|
||||
[(* Does automatic Masterscope database maintenance)
|
||||
[DECLARE%: FIRST (P (VIRGINFN 'LOAD T)
|
||||
(MOVD? 'LOAD 'OLDLOAD)
|
||||
(VIRGINFN 'LOADFROM T)
|
||||
(MOVD? 'LOADFROM 'OLDLOADFROM)
|
||||
(VIRGINFN 'MAKEFILE T)
|
||||
(MOVD? 'MAKEFILE 'OLDMAKEFILE]
|
||||
(FNS DBFILE DBFILE1 DBFILE2 LOAD LOADFROM MAKEFILE)
|
||||
(ADDVARS (LINKEDFNS OLDLOAD))
|
||||
(P (RELINK 'MAKEFILES))
|
||||
(FNS DUMPDB LOADDB MAKEDB)
|
||||
(PROP PROPTYPE DATABASE)
|
||||
(INITVARS (LOADDBFLG 'ASK)
|
||||
(SAVEDBFLG 'ASK))
|
||||
(ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
|
||||
(* To permit MSHASH interface)
|
||||
(INITVARS (MSHASHFILENAME)
|
||||
(MSFILETABLE))
|
||||
(LOCALVARS . T)
|
||||
(BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T])
|
||||
|
||||
|
||||
|
||||
(* Does automatic Masterscope database maintenance)
|
||||
|
||||
(DECLARE%: FIRST
|
||||
|
||||
(VIRGINFN 'LOAD T)
|
||||
|
||||
(MOVD? 'LOAD 'OLDLOAD)
|
||||
|
||||
(VIRGINFN 'LOADFROM T)
|
||||
|
||||
(MOVD? 'LOADFROM 'OLDLOADFROM)
|
||||
|
||||
(VIRGINFN 'MAKEFILE T)
|
||||
|
||||
(MOVD? 'MAKEFILE 'OLDMAKEFILE)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(DBFILE
|
||||
[LAMBDA (FILE ASKFLAG) (* lmm "29-APR-81 20:27")
|
||||
|
||||
(* Finds a database file that corresponds to the contents of FILE.
|
||||
@@ -27,7 +84,9 @@
|
||||
(T (FINDFILE FILE]
|
||||
(CONS (FILEDATE FILE)
|
||||
FILE]
|
||||
(ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
|
||||
(AND FILEDATES (RETURN (DBFILE1 FILE FILEDATES])
|
||||
|
||||
(DBFILE1
|
||||
[LAMBDA (F FILEDATES) (* jds "25-Sep-86 20:04")
|
||||
|
||||
(* Searches databases based on F to find one that matches FILEDATES.
|
||||
@@ -50,7 +109,9 @@
|
||||
'*
|
||||
'BODY F)))
|
||||
when (SETQ DBF (DBFILE2 DBF FILEDATES))
|
||||
|
||||
do (RETURN (CONS DBF FILEDATES])
|
||||
|
||||
(DBFILE2
|
||||
[LAMBDA (DBF FILEDATES) (* ; "Edited 28-Nov-90 12:42 by rmk:")
|
||||
(* T if DBF is the name of the
|
||||
database file matching FILEDATES)
|
||||
@@ -66,23 +127,110 @@
|
||||
(CAR (READ DBF (FIND-READTABLE "INTERLISP"]
|
||||
DBF)
|
||||
(T (CLOSEF DBF)
|
||||
|
||||
NIL])
|
||||
|
||||
(LOAD
|
||||
[LAMBDA (FILE LDFLG PRINTFLG) (* lmm "29-APR-81 20:27")
|
||||
(SETQ FILE (OLDLOAD FILE LDFLG PRINTFLG))
|
||||
(COND
|
||||
((NEQ LDFLG 'SYSLOAD)
|
||||
(LOADDB FILE T)))
|
||||
COMPILE.EXT) (* Map compiled file into symbolic
|
||||
FILE])
|
||||
|
||||
(LOADFROM
|
||||
[LAMBDA (FILE FNS LDFLG) (* lmm "29-APR-81 20:27")
|
||||
(SETQ FILE (OLDLOADFROM FILE FNS LDFLG))
|
||||
(LOADDB FILE T)
|
||||
[(AND (NULL (FILENAMEFIELD FILE 'VERSION))
|
||||
FILE])
|
||||
|
||||
(MAKEFILE
|
||||
[LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* lmm "29-APR-81 20:27")
|
||||
(SETQ FILE (OLDMAKEFILE FILE OPTIONS REPRINTFNS SOURCEFILE))
|
||||
(DUMPDB FILE T)
|
||||
(ASKFLAG (INFILEP FILE))
|
||||
FILE])
|
||||
)
|
||||
|
||||
(ADDTOVAR LINKEDFNS OLDLOAD)
|
||||
|
||||
(RELINK 'MAKEFILES)
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 3-May-93 18:44 by rmk:")
|
||||
|
||||
(* Dumps a Masterscope database for functions in FILE.
|
||||
Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice
|
||||
calls it. A user-level call would default PROPFLG to NIL.)
|
||||
|
||||
(* The FILE check is because MAKEFILE returns a list when it doesn't understand
|
||||
the options)
|
||||
|
||||
(DECLARE (GLOBALVARS MSHASHFILENAME MSFILETABLE SAVEDBFLG))
|
||||
(AND FILE (OR (LITATOM FILE)
|
||||
(STRINGP FILE))
|
||||
(PROG (DBFILE (FL (NAMEFIELD FILE))
|
||||
FNS
|
||||
(FFNS (FILEFNSLST FILE)))
|
||||
(COND
|
||||
(FFNS)
|
||||
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
|
||||
(* Always dump if this is a known
|
||||
file)
|
||||
(SETQ PROPFLG NIL))
|
||||
(T (COND
|
||||
(PROPFLG (/REMPROP FL 'DATABASE))
|
||||
(T (printout T T FILE " has no functions." T)))
|
||||
(RETURN)))
|
||||
(SETQ FNS FFNS)
|
||||
(COND
|
||||
([OR (NULL PROPFLG)
|
||||
(EQ (GETPROP FL 'DATABASE)
|
||||
'YES)
|
||||
(EQ SAVEDBFLG 'YES)
|
||||
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
|
||||
(* If MSHASH is loaded, only dump
|
||||
functions in the local database)
|
||||
[COND
|
||||
(MSHASHFILENAME (SETQ FNS (for FN in FNS
|
||||
when (PROGN (UPDATEFN FN)
|
||||
(LOCALFNP FN)) collect FN]
|
||||
(RESETLST
|
||||
[RESETSAVE (SETQ DBFILE (OPENSTREAM (PACKFILENAME 'EXTENSION 'DATABASE
|
||||
'VERSION NIL 'BODY FILE)
|
||||
'OUTPUT
|
||||
'NEW))
|
||||
'(PROGN (CLOSEF? OLDVALUE)
|
||||
(AND RESETSTATE (DELFILE OLDVALUE]
|
||||
(RESETSAVE (OUTPUT DBFILE))
|
||||
(RESETSAVE (SETREADTABLE (FIND-READTABLE "INTERLISP")))
|
||||
(RESETSAVE (CL:IN-PACKAGE "INTERLISP")
|
||||
(LIST 'CL:IN-PACKAGE (CL:PACKAGE-NAME *PACKAGE*)))
|
||||
(PRIN1 "(PROGN (PRIN1 %"Use LOADDB to load database files!%
|
||||
%" T) (ERROR!))%
|
||||
(CONS (FILEDATE FILE)
|
||||
"
|
||||
)
|
||||
[AND MSFILETABLE (STORETABLE FL MSFILETABLE (PRINT (CAR (GETPROP FL
|
||||
'FILEDATES]
|
||||
(COND
|
||||
(MSHASHFILENAME (UPDATECONTAINS FL FFNS T)))
|
||||
(* T flag means that the function
|
||||
won't be erased--it might still be
|
||||
interesting)
|
||||
(printout NIL "FNS " .P2 FFNS T) (* So the database file knows which
|
||||
functions are on the file)
|
||||
(COND
|
||||
(FNS (DUMPDATABASE FNS))
|
||||
(T (printout NIL "STOP" T))))
|
||||
[COND
|
||||
(PROPFLG (PRINT (FULLNAME DBFILE)
|
||||
T))
|
||||
(T (/PUT FL 'DATABASEFILENAME DBFILE) (* Remember that we have this file
|
||||
valid already.)
|
||||
(/PUT FL 'DATABASE 'YES] (* Take future note of the databae
|
||||
on a user call)
|
||||
(RETURN (FULLNAME DBFILE])
|
||||
|
||||
(LOADDB
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 7-Jul-92 09:57 by rmk:")
|
||||
|
||||
(* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls. Before asking, it looks around first to see whether a database file of the appropriate name really exists.")
|
||||
@@ -163,7 +311,9 @@
|
||||
(SETQ DBFILE NIL)))
|
||||
(/PUT NF 'DATABASEFILENAME DBFILE) (* ;
|
||||
"Remember the name of the database we just loaded.")
|
||||
the options)
|
||||
(RETURN (FULLNAME DBFILE])])
|
||||
|
||||
(MAKEDB
|
||||
[LAMBDA (F) (* DECLARATIONS%: UNDOABLE)
|
||||
(* rmk%: " 9-NOV-83 02:56")
|
||||
(DECLARE (GLOBALVARS SAVEDBFLG MSFILETABLE DWIMWAIT))
|
||||
@@ -184,4 +334,40 @@
|
||||
"Do you want a Masterscope Database for this file? ")
|
||||
)
|
||||
'YES)
|
||||
(EQ (GETPROP FL 'DATABASE)
|
||||
(T 'NO])
|
||||
)
|
||||
|
||||
(PUTPROPS DATABASE PROPTYPE IGNORE)
|
||||
|
||||
(RPAQ? LOADDBFLG 'ASK)
|
||||
|
||||
(RPAQ? SAVEDBFLG 'ASK)
|
||||
|
||||
(ADDTOVAR MAKEFILEFORMS (MAKEDB FILE))
|
||||
|
||||
|
||||
|
||||
(* To permit MSHASH interface)
|
||||
|
||||
|
||||
(RPAQ? MSHASHFILENAME )
|
||||
|
||||
(RPAQ? MSFILETABLE )
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(BLOCK%: LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(RESETSAVE DWIMIFYCOMPFLG T)
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1637 6218 (DBFILE 1647 . 3295) (DBFILE1 3297 . 4820) (DBFILE2 4822 . 5584) (LOAD 5586
|
||||
. 5816) (LOADFROM 5818 . 6006) (MAKEFILE 6008 . 6216)) (6274 16706 (DUMPDB 6284 . 10572) (LOADDB
|
||||
10574 . 15618) (MAKEDB 15620 . 16704)))))
|
||||
STOP
|
||||
|
||||
2414
library/DEDIT
2414
library/DEDIT
File diff suppressed because one or more lines are too long
822
library/DEDITPP
822
library/DEDITPP
File diff suppressed because one or more lines are too long
476
library/DES
476
library/DES
File diff suppressed because one or more lines are too long
141
library/DMCHAT
141
library/DMCHAT
File diff suppressed because one or more lines are too long
129
library/DOSPRINT
129
library/DOSPRINT
@@ -1,24 +1,45 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "20-Nov-95 11:34:56" {DSK}<MEDLEY>LIBRARY/DOSPRINT.\;1 2006
|
||||
|
||||
|changes| |to:| (VARS DOSPRINTCOMS)
|
||||
|
||||
|previous| |date:| "26-Jul-93 14:01:26" {DSK}<MEDLEY>LIBRARY/DOSPRINT.\;1)
|
||||
|
||||
|
||||
; Copyright (c) 1995 by Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT DOSPRINTCOMS)
|
||||
|
||||
(RPAQQ DOSPRINTCOMS ((FNS DOSPRINT)
|
||||
(INITVARS (|DosPrinterName| NIL))
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (GLOBALVARS |DosPrinterName|))
|
||||
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
|
||||
(NLAMA)
|
||||
(NLAML)
|
||||
(LAMA)))))
|
||||
(DEFINEQ
|
||||
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
|
||||
(FILECREATED "20-Nov-95 11:34:56" {DSK}<MEDLEY>LIBRARY/DOSPRINT.\;1 2006
|
||||
|
||||
|
||||
|
||||
|changes| |to:| (VARS DOSPRINTCOMS)
|
||||
|
||||
|
||||
|
||||
|previous| |date:| "26-Jul-93 14:01:26" {DSK}<MEDLEY>LIBRARY/DOSPRINT.\;1)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
; Copyright (c) 1995 by Xerox Corporation. All rights reserved.
|
||||
|
||||
|
||||
|
||||
(PRETTYCOMPRINT DOSPRINTCOMS)
|
||||
|
||||
|
||||
|
||||
(RPAQQ DOSPRINTCOMS ((FNS DOSPRINT)
|
||||
|
||||
(INITVARS (|DosPrinterName| NIL))
|
||||
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (GLOBALVARS |DosPrinterName|))
|
||||
|
||||
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
|
||||
|
||||
(NLAMA)
|
||||
|
||||
(NLAML)
|
||||
|
||||
(LAMA)))))
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
|
||||
|
||||
(DOSPRINT
|
||||
(LAMBDA (HOST FILE PRINTOPTIONS) (* \; "Edited 26-Jul-93 13:48 by ")
|
||||
(LET* ((PRINTER (OR HOST |DosPrinterName|))
|
||||
@@ -29,25 +50,47 @@
|
||||
(CL:WITH-OPEN-STREAM (|in| (OPENSTREAM FILE 'INPUT))
|
||||
(CL:FORMAT PROMPTWINDOW "Spooling output to DOS printer \"~A\"..." PRINTER)
|
||||
(COPYCHARS |in| |out|)
|
||||
(CL:FORMAT PROMPTWINDOW "Done."))))))
|
||||
)
|
||||
|
||||
(RPAQ? |DosPrinterName| NIL)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS |DosPrinterName|)
|
||||
)
|
||||
)
|
||||
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS DOSPRINT COPYRIGHT ("Xerox Corporation" 1995))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (958 1636 (DOSPRINT 970 . 1633)))))
|
||||
STOP
|
||||
(CL:FORMAT PROMPTWINDOW "Done."))))))
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
(RPAQ? |DosPrinterName| NIL)
|
||||
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
|
||||
|
||||
(GLOBALVARS |DosPrinterName|)
|
||||
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
|
||||
)
|
||||
|
||||
(PUTPROPS DOSPRINT COPYRIGHT ("Xerox Corporation" 1995))
|
||||
|
||||
(DECLARE\: DONTCOPY
|
||||
|
||||
(FILEMAP (NIL (958 1636 (DOSPRINT 970 . 1633)))))
|
||||
|
||||
STOP
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +1,93 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "23-Aug-95 13:01:43" |{DSK}<lispcore>library>FILE-UPDATE.;3| 2268
|
||||
|
||||
|changes| |to:| (FNS FIX-FILE)
|
||||
|
||||
|previous| |date:| "23-Aug-95 10:54:34" |{DSK}<lispcore>library>FILE-UPDATE.;2|)
|
||||
|
||||
|
||||
; Copyright (c) 1995 by Venue. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT FILE-UPDATECOMS)
|
||||
|
||||
(RPAQQ FILE-UPDATECOMS
|
||||
(
|
||||
(* |;;| "==================================")
|
||||
|
||||
|
||||
(* |;;| " M E D L E Y 3 . 0 F I L E - U P D A T E U T I L I T Y")
|
||||
|
||||
|
||||
(* |;;| "")
|
||||
|
||||
|
||||
(* |;;| "Use the function FIX-FILE to make updated copies of any source files that have DATATYPE declarations in them.")
|
||||
|
||||
|
||||
(* |;;| "")
|
||||
|
||||
|
||||
(* |;;| "You will need to fix any BLOCKRECORD declarations by hand.")
|
||||
|
||||
|
||||
(* |;;| "==================================")
|
||||
|
||||
(FNS FIX-FILE)))
|
||||
|
||||
|
||||
|
||||
(* |;;| "==================================")
|
||||
|
||||
|
||||
|
||||
|
||||
(* |;;| " M E D L E Y 3 . 0 F I L E - U P D A T E U T I L I T Y")
|
||||
|
||||
|
||||
|
||||
|
||||
(* |;;| "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* |;;|
|
||||
"Use the function FIX-FILE to make updated copies of any source files that have DATATYPE declarations in them."
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
(* |;;| "")
|
||||
|
||||
|
||||
|
||||
|
||||
(* |;;| "You will need to fix any BLOCKRECORD declarations by hand.")
|
||||
|
||||
|
||||
|
||||
|
||||
(* |;;| "==================================")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(FIX-FILE
|
||||
(LAMBDA (FILE) (* \; "Edited 23-Aug-95 13:01 by jds")
|
||||
|
||||
(* |;;| "Take a lisp source file, and re-dump it with aall record declarations (NOT including BLOCKRECORDS) changed so they're compatible with Medley 3.0.")
|
||||
|
||||
(* |;;| "This really only involves marking each record as changed, so the file manager re-dumps the pre-parsed version of the record declaration.")
|
||||
|
||||
(LOAD FILE 'PROP)
|
||||
(LOADCOMP FILE 'PROP)
|
||||
(AND (FILEFNSLST FILE)
|
||||
(|for| RECNAME |in| (FILECOMSLST FILE 'RECORDS) |do| (MARKASCHANGED RECNAME
|
||||
'RECORDS)))
|
||||
(MARKASCHANGED FILE 'FILES)
|
||||
(MAKEFILE FILE)))
|
||||
)
|
||||
(PUTPROPS FILE-UPDATE COPYRIGHT ("Venue" 1995))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1424 2197 (FIX-FILE 1434 . 2195)))))
|
||||
STOP
|
||||
|
||||
4274
library/FILEBROWSER
4274
library/FILEBROWSER
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
4348
library/FX-80DRIVER
4348
library/FX-80DRIVER
File diff suppressed because one or more lines are too long
819
library/GCHAX
819
library/GCHAX
File diff suppressed because one or more lines are too long
952
library/GRAPHER
952
library/GRAPHER
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
678
library/HASH
678
library/HASH
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
514
library/HRULE
514
library/HRULE
File diff suppressed because one or more lines are too long
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user