Compare commits
4 Commits
merge-ron-
...
nightly-21
| Author | SHA1 | Date | |
|---|---|---|---|
|
25c397ccdf | ||
|
b18d16b807 | ||
|
|
9b7df4a022 | ||
|
|
4efe2f93af |
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
|
||||
@@ -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.
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "23-Feb-2021 22:13:09"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.;52 9082
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 3-Jul-2021 13:16:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.;6 9185
|
||||
|
||||
changes to%: (FNS CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
|
||||
changes to%: (VARS CLIPBOARDCOMS)
|
||||
|
||||
previous date%: "23-Feb-2021 11:34:57"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.;50)
|
||||
previous date%: "24-Jun-2021 21:14:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT CLIPBOARDCOMS)
|
||||
@@ -16,7 +16,7 @@
|
||||
CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
|
||||
(FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD)
|
||||
(FNS SEDIT.COPYTOCLIPBOARD)
|
||||
(INITVARS (CLIPBOARD-FORMAT :UTF8))
|
||||
(INITVARS (CLIPBOARD-FORMAT :UTF-8))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
|
||||
UNIXCOMM UNICODE)
|
||||
(P (INSTALL-CLIPBOARD)))
|
||||
@@ -30,49 +30,49 @@
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(INSTALL-CLIPBOARD
|
||||
[LAMBDA NIL (* ; "Edited 8-Aug-2020 07:59 by rmk:")
|
||||
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
|
||||
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
|
||||
(INSTALL-CLIPBOARD
|
||||
[LAMBDA NIL (* ; "Edited 24-Jun-2021 21:14 by rmk:")
|
||||
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
|
||||
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
|
||||
(CL:WHEN (GETD 'LISPINTERRUPTS.PASTE)
|
||||
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG)
|
||||
(MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS))
|
||||
(INTERRUPTCHAR (CHARCODE "1,v")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(INTERRUPTCHAR (CHARCODE "1,V")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
|
||||
(INTERRUPTCHAR (CHARCODE "Meta,v")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(INTERRUPTCHAR (CHARCODE "Meta,V")
|
||||
'(PASTEFROMCLIPBOARD))
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
|
||||
|
||||
(* ;; "Paste")
|
||||
(* ;; "Paste")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,v")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,V")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,V")
|
||||
(FUNCTION PASTEFROMCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Copy")
|
||||
(* ;; "Copy")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,c")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
|
||||
(FUNCTION TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,C")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,C")
|
||||
(FUNCTION TEDIT.COPYTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Extract")
|
||||
(* ;; "Extract")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,X")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
|
||||
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,x")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
|
||||
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
|
||||
TEDIT.READTABLE))
|
||||
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
|
||||
"SEDIT copy: INTERRUPTCHAR does paste")
|
||||
(SEDIT:ADD-COMMAND "1,c" 'SEDIT.COPYTOCLIPBOARD)
|
||||
(SEDIT:ADD-COMMAND "1,C" 'SEDIT.COPYTOCLIPBOARD)
|
||||
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
|
||||
"SEDIT copy: INTERRUPTCHAR does paste")
|
||||
(SEDIT:ADD-COMMAND "Meta,c" 'SEDIT.COPYTOCLIPBOARD "M-c" "Copy to clipboard")
|
||||
(SEDIT:ADD-COMMAND "Meta,C" 'SEDIT.COPYTOCLIPBOARD)
|
||||
(SEDIT:RESET-COMMANDS))])
|
||||
|
||||
(GETCLIPBOARD
|
||||
@@ -184,7 +184,7 @@
|
||||
T])
|
||||
)
|
||||
|
||||
(RPAQ? CLIPBOARD-FORMAT :UTF8)
|
||||
(RPAQ? CLIPBOARD-FORMAT :UTF-8)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
@@ -203,8 +203,8 @@
|
||||
)
|
||||
(PUTPROPS CLIPBOARD COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1309 6429 (INSTALL-CLIPBOARD 1319 . 3141) (GETCLIPBOARD 3143 . 3517) (PUTCLIPBOARD 3519
|
||||
. 3924) (PASTEFROMCLIPBOARD 3926 . 4844) (LISPINTERRUPTS.PASTE 4846 . 5267) (CLIPBOARD-COPY-STREAM
|
||||
5269 . 5769) (CLIPBOARD-PASTE-STREAM 5771 . 6427)) (6430 7189 (TEDIT.COPYTOCLIPBOARD 6440 . 6721) (
|
||||
TEDIT.EXTRACTTOCLIPBOARD 6723 . 7187)) (7190 8729 (SEDIT.COPYTOCLIPBOARD 7200 . 8727)))))
|
||||
(FILEMAP (NIL (1301 6531 (INSTALL-CLIPBOARD 1311 . 3243) (GETCLIPBOARD 3245 . 3619) (PUTCLIPBOARD 3621
|
||||
. 4026) (PASTEFROMCLIPBOARD 4028 . 4946) (LISPINTERRUPTS.PASTE 4948 . 5369) (CLIPBOARD-COPY-STREAM
|
||||
5371 . 5871) (CLIPBOARD-PASTE-STREAM 5873 . 6529)) (6532 7291 (TEDIT.COPYTOCLIPBOARD 6542 . 6823) (
|
||||
TEDIT.EXTRACTTOCLIPBOARD 6825 . 7289)) (7292 8831 (SEDIT.COPYTOCLIPBOARD 7302 . 8829)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(FILECREATED "27-Feb-2021 20:08:26"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;33| 261320
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 23:09:57"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;4| 262331
|
||||
|
||||
|changes| |to:| (FNS FB.EDITCOMMAND.ONEFILE FB.FINISH.COMMAND FB.MAKE.BROWSER.BUSY
|
||||
FB.EDITCOMMAND)
|
||||
|changes| |to:| (FNS FB.EDITCOMMAND.ONEFILE)
|
||||
|
||||
|previous| |date:| "25-Feb-2021 13:24:50"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;27|)
|
||||
|previous| |date:| "27-Feb-2021 20:08:26"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;2|)
|
||||
|
||||
|
||||
; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
|
||||
@@ -1679,7 +1678,8 @@ Your deletions are thus ignored.")))
|
||||
ELSE (FB.FASTSEECOMMAND BROWSER KEY ITEM MENU)))))
|
||||
|
||||
(FB.EDITCOMMAND.ONEFILE
|
||||
(LAMBDA (BROWSER FILE OPTION ITEM MENU) (* \; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
(LAMBDA (BROWSER FILE OPTION ITEM MENU) (* \; "Edited 9-Jul-2021 23:08 by rmk:")
|
||||
(* \; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
(* \; "Edited 1-Feb-88 19:00 by bvm:")
|
||||
|
||||
(* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists. If OPTION is READONLY, we don't want to edit, just view. If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE.")
|
||||
@@ -1690,60 +1690,72 @@ Your deletions are thus ignored.")))
|
||||
(CL:MULTIPLE-VALUE-BIND
|
||||
(IGNORE CONDITION)
|
||||
(IGNORE-ERRORS
|
||||
(IF (LISPSOURCEFILEP FILE)
|
||||
THEN (SELECTQ OPTION
|
||||
((LISP NIL TEDIT)
|
||||
(* |;;|
|
||||
(LET ((ENV (LISPSOURCEFILEP FILE)))
|
||||
(IF ENV
|
||||
THEN (SELECTQ OPTION
|
||||
((LISP NIL TEDIT)
|
||||
(* |;;|
|
||||
"Asks to load prop and edits the coms. We really don't want to use a text editor on a source file.")
|
||||
|
||||
|
||||
(* |;;| "The FUNCALL at the bottom is concerning.")
|
||||
|
||||
(* |;;| "The FUNCALL at the bottom is concerning.")
|
||||
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(FB.EDITLISPFILE FILE BROWSER))
|
||||
(READONLY (* \; "READONLY on call from SEE")
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((NSTR (OPENTEXTSTREAM)))
|
||||
(COPY.TEXT.TO.IMAGE STREAM NSTR)
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(FB.EDITLISPFILE FILE BROWSER))
|
||||
(READONLY (* \; "READONLY on call from SEE")
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((NSTR (OPENTEXTSTREAM)))
|
||||
(\\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT
|
||||
REFORMAT)
|
||||
OF ENV))
|
||||
(COPY.TEXT.TO.IMAGE STREAM NSTR)
|
||||
|
||||
(* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that. That way, the FB window won't pop up on top.")
|
||||
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE
|
||||
))
|
||||
(WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT NSTR NIL NIL
|
||||
'(READONLY T))))
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM))))))
|
||||
(CL:FUNCALL OPTION (MKATOM FILE)))
|
||||
ELSE (SELECTQ OPTION
|
||||
(READONLY
|
||||
(* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access. So in that case we do a secret NODIRCORE copy and look at that.")
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM
|
||||
FB.ITEMUNSELECTEDSHADE
|
||||
))
|
||||
(WINDOWPROP (WFROMDS (TEXTSTREAM
|
||||
(TEDIT NSTR NIL NIL
|
||||
'(READONLY T))))
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM))))))
|
||||
(CL:FUNCALL OPTION (MKATOM FILE)))
|
||||
ELSE (SELECTQ OPTION
|
||||
(READONLY
|
||||
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((NSTR))
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
(SETQ NSTR (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW NIL
|
||||
(LIST (LIST 'TYPE (GETFILEINFO
|
||||
STREAM
|
||||
'TYPE)))))
|
||||
(COPYBYTES STREAM NSTR))
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
|
||||
NIL NIL
|
||||
'(READONLY T))))
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM))))))
|
||||
((TEDIT NIL)
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(TEDIT (MKATOM FILE)))
|
||||
(LISP (FB.PROMPTW.FORMAT BROWSER "Failed because not a Lisp source file"))
|
||||
(CL:FUNCALL OPTION (MKATOM FILE)))))
|
||||
(* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access. So in that case we do a secret NODIRCORE copy and look at that.")
|
||||
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((NSTR))
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
(SETQ NSTR (OPENSTREAM
|
||||
'{NODIRCORE}
|
||||
'BOTH
|
||||
'NEW NIL (LIST (LIST 'TYPE
|
||||
(GETFILEINFO
|
||||
STREAM
|
||||
'TYPE)))))
|
||||
(COPYBYTES STREAM NSTR))
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM
|
||||
FB.ITEMUNSELECTEDSHADE))
|
||||
(WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
|
||||
NIL NIL
|
||||
'(READONLY T))))
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM))))))
|
||||
((TEDIT NIL)
|
||||
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
|
||||
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
|
||||
(TEDIT (MKATOM FILE)))
|
||||
(LISP (FB.PROMPTW.FORMAT BROWSER
|
||||
"Failed because not a Lisp source file"))
|
||||
(CL:FUNCALL OPTION (MKATOM FILE))))))
|
||||
(|if| CONDITION
|
||||
|then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))
|
||||
|
||||
@@ -4212,50 +4224,50 @@ then click Recompute"))))
|
||||
(PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1993 1994 1999 2000 2001 2021))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (28186 50822 (FB 28196 . 29152) (FB.COPYBINARYCOMMAND 29154 . 29500) (FB.COPYTEXTCOMMAND
|
||||
29502 . 29844) (FILEBROWSER 29846 . 42952) (FB.TABLEBROWSER 42954 . 43171) (FB.SELECTEDFILES 43173 .
|
||||
43810) (FB.FETCHFILENAME 43812 . 44204) (FB.DIRECTORYP 44206 . 44534) (FB.PROMPTWPRINT 44536 . 45582)
|
||||
(FB.PROMPTW.FORMAT 45584 . 46321) (FB.PROMPTFORINPUT 46323 . 48575) (FB.YES-OR-NO-P 48577 . 49611) (
|
||||
FB.ALLOW.ABORT 49613 . 50467) (\\FB.HARDCOPY.TOFILE.EXTENSION 50469 . 50820)) (50846 51799 (FB.STARTUP
|
||||
50856 . 51371) (FB.MAKERIGIDWINDOW 51373 . 51797)) (51800 57172 (FB.PRINTFN 51810 . 56963) (FB.COPYFN
|
||||
56965 . 57170)) (57222 63264 (FB.MENU.WHENSELECTEDFN 57232 . 57590) (FB.COMMANDSELECTEDFN 57592 .
|
||||
59131) (FB.SUBITEMP 59133 . 59568) (FB.MAKE.BROWSER.BUSY 59570 . 60308) (FB.FINISH.COMMAND 60310 .
|
||||
62275) (FB.HANDLE.ABORT.BUTTON 62277 . 63262)) (63265 68781 (FB.DELETECOMMAND 63275 . 63556) (
|
||||
FB.DELVERCOMMAND 63558 . 66751) (FB.IS.NOT.SUBDIRECTORY.ITEM 66753 . 66934) (FB.DELVER.FILES 66936 .
|
||||
68025) (FB.DELETE.FILE 68027 . 68779)) (68782 70107 (FB.UNDELETECOMMAND 68792 . 69077) (
|
||||
FB.UNDELETEALLCOMMAND 69079 . 69358) (FB.UNDELETE.FILE 69360 . 70105)) (70108 94289 (FB.COPYCOMMAND
|
||||
70118 . 70387) (FB.RENAMECOMMAND 70389 . 70664) (FB.COPY/RENAME.COMMAND 70666 . 71589) (
|
||||
FB.COPY/RENAME.ONE 71591 . 73913) (FB.COPY/RENAME.MANY 73915 . 80135) (FB.MERGE.DIRECTORIES 80137 .
|
||||
80555) (FB.GREATEST.PREFIX 80557 . 81913) (FB.MAYBE.INSERT.FILE 81915 . 89355) (FB.GET.NEW.FILE.SPEC
|
||||
89357 . 93188) (FB.CANONICAL.DIRECTORY 93190 . 94287)) (94290 102074 (FB.HARDCOPYCOMMAND 94300 . 95430
|
||||
) (FB.HARDCOPY.TOFILE 95432 . 102072)) (102075 113638 (FB.EDITCOMMAND 102085 . 102886) (
|
||||
FB.EDITCOMMAND.ONEFILE 102888 . 107854) (FB.EDITLISPFILE 107856 . 108895) (FB.BROWSECOMMAND 108897 .
|
||||
113636)) (113639 125432 (FB.FASTSEECOMMAND 113649 . 117099) (FB.FASTSEE.ONEFILE 117101 . 120130) (
|
||||
FB.SEEFULLFN 120132 . 124263) (FB.SEEBUTTONFN 124265 . 125430)) (125433 127179 (FB.LOADCOMMAND 125443
|
||||
. 125950) (FB.COMPILECOMMAND 125952 . 126490) (FB.OPERATE.ON.FILES 126492 . 127177)) (127180 174229 (
|
||||
FB.UPDATECOMMAND 127190 . 127415) (FB.MAYBE.EXPUNGE 127417 . 128412) (FB.UPDATEBROWSERITEMS 128414 .
|
||||
141629) (FB.DATE 141631 . 142372) (FB.ADJUST.DATE.WIDTH 142374 . 145342) (FB.SET.BROWSER.TITLE 145344
|
||||
. 146201) (FB.MAYBE.WIDEN.NAMES 146203 . 148322) (FB.SET.DEFAULT.NAME.WIDTH 148324 . 149688) (
|
||||
FB.CREATE.FILEBUCKET 149690 . 156910) (FB.CHECK.NAME.LENGTH 156912 . 159333) (FB.ADD.FILEGROUP 159335
|
||||
. 160862) (FB.INSERT.DIRECTORY 160864 . 161102) (FB.MAKE.SUBDIRECTORY.ITEM 161104 . 162513) (
|
||||
FB.ADD.FILE 162515 . 163128) (FB.INSERT.FILE 163130 . 166542) (FB.ANALYZE.PATTERN 166544 . 171808) (
|
||||
FB.CANONICALIZE.PATTERN 171810 . 173122) (FB.GETALLFILEINFO 173124 . 174227)) (174230 182389 (
|
||||
FB.SORT.VERSIONS 174240 . 177011) (FB.DECREASING.VERSION 177013 . 177682) (FB.INCREASING.VERSION
|
||||
177684 . 178305) (FB.NAMES.DECREASING.VERSION 178307 . 179342) (FB.NAMES.INCREASING.VERSION 179344 .
|
||||
180341) (FB.DECREASING.NUMERIC.ATTR 180343 . 181023) (FB.INCREASING.NUMERIC.ATTR 181025 . 181699) (
|
||||
FB.ALPHABETIC.ATTR 181701 . 182387)) (182390 192232 (FB.SORTCOMMAND 182400 . 189230) (
|
||||
FB.INSERT.SUBDIRECTORIES 189232 . 190029) (FB.GET.SORT.MENU 190031 . 192230)) (192233 208322 (
|
||||
FB.EXPUNGECOMMAND 192243 . 194762) (FB.NEWPATTERNCOMMAND 194764 . 195162) (FB.NEWINFOCOMMAND 195164 .
|
||||
197930) (FB.DEPTHCOMMAND 197932 . 199707) (FB.SHAPECOMMAND 199709 . 203051) (FB.REMOVE.FILE 203053 .
|
||||
204874) (FB.COUNT.FILE.CHANGE 204876 . 206321) (FB.SETNEWPATTERN 206323 . 207493) (FB.GET.NEWPATTERN
|
||||
207495 . 208079) (FB.OPTIONSCOMMAND 208081 . 208320)) (208357 209369 (
|
||||
FB.INFOMENU.SHADEINITIALSELECTIONS 208367 . 209014) (FB.INFO.ITEM.NAMED 209016 . 209367)) (209370
|
||||
218836 (FB.MAKECOUNTERWINDOW 209380 . 210842) (FB.COUNTERW.REDISPLAYFN 210844 . 211431) (
|
||||
FB.UPDATE.COUNTERS 211433 . 213505) (FB.DISPLAY.COUNTERS 213507 . 218567) (FB.COUNTER.STRING 218569 .
|
||||
218834)) (218837 223480 (FB.MAKEHEADINGWINDOW 218847 . 220395) (FB.HEADINGW.REDISPLAYFN 220397 .
|
||||
220663) (FB.HEADINGW.RESHAPEFN 220665 . 221041) (FB.HEADINGW.DISPLAY 221043 . 223478)) (223481 227664
|
||||
(FB.ICONFN 223491 . 223838) (FB.INFOMENU.WHENSELECTEDFN 223840 . 224570) (FB.CLOSEFN 224572 . 225775)
|
||||
(FB.EXPUNGE?.MENU 225777 . 226189) (FB.AFTERCLOSEFN 226191 . 226552) (FB.CLOSE&EXPUNGE 226554 . 227662
|
||||
)) (227665 239723 (FB.HARDCOPY.DIRECTORY 227675 . 238032) (FB.HARDCOPY.PRINT.TITLE 238034 . 238360) (
|
||||
FB.HARDCOPY.MAXWIDTH 238362 . 239721)))))
|
||||
(FILEMAP (NIL (28124 50760 (FB 28134 . 29090) (FB.COPYBINARYCOMMAND 29092 . 29438) (FB.COPYTEXTCOMMAND
|
||||
29440 . 29782) (FILEBROWSER 29784 . 42890) (FB.TABLEBROWSER 42892 . 43109) (FB.SELECTEDFILES 43111 .
|
||||
43748) (FB.FETCHFILENAME 43750 . 44142) (FB.DIRECTORYP 44144 . 44472) (FB.PROMPTWPRINT 44474 . 45520)
|
||||
(FB.PROMPTW.FORMAT 45522 . 46259) (FB.PROMPTFORINPUT 46261 . 48513) (FB.YES-OR-NO-P 48515 . 49549) (
|
||||
FB.ALLOW.ABORT 49551 . 50405) (\\FB.HARDCOPY.TOFILE.EXTENSION 50407 . 50758)) (50784 51737 (FB.STARTUP
|
||||
50794 . 51309) (FB.MAKERIGIDWINDOW 51311 . 51735)) (51738 57110 (FB.PRINTFN 51748 . 56901) (FB.COPYFN
|
||||
56903 . 57108)) (57160 63202 (FB.MENU.WHENSELECTEDFN 57170 . 57528) (FB.COMMANDSELECTEDFN 57530 .
|
||||
59069) (FB.SUBITEMP 59071 . 59506) (FB.MAKE.BROWSER.BUSY 59508 . 60246) (FB.FINISH.COMMAND 60248 .
|
||||
62213) (FB.HANDLE.ABORT.BUTTON 62215 . 63200)) (63203 68719 (FB.DELETECOMMAND 63213 . 63494) (
|
||||
FB.DELVERCOMMAND 63496 . 66689) (FB.IS.NOT.SUBDIRECTORY.ITEM 66691 . 66872) (FB.DELVER.FILES 66874 .
|
||||
67963) (FB.DELETE.FILE 67965 . 68717)) (68720 70045 (FB.UNDELETECOMMAND 68730 . 69015) (
|
||||
FB.UNDELETEALLCOMMAND 69017 . 69296) (FB.UNDELETE.FILE 69298 . 70043)) (70046 94227 (FB.COPYCOMMAND
|
||||
70056 . 70325) (FB.RENAMECOMMAND 70327 . 70602) (FB.COPY/RENAME.COMMAND 70604 . 71527) (
|
||||
FB.COPY/RENAME.ONE 71529 . 73851) (FB.COPY/RENAME.MANY 73853 . 80073) (FB.MERGE.DIRECTORIES 80075 .
|
||||
80493) (FB.GREATEST.PREFIX 80495 . 81851) (FB.MAYBE.INSERT.FILE 81853 . 89293) (FB.GET.NEW.FILE.SPEC
|
||||
89295 . 93126) (FB.CANONICAL.DIRECTORY 93128 . 94225)) (94228 102012 (FB.HARDCOPYCOMMAND 94238 . 95368
|
||||
) (FB.HARDCOPY.TOFILE 95370 . 102010)) (102013 114649 (FB.EDITCOMMAND 102023 . 102824) (
|
||||
FB.EDITCOMMAND.ONEFILE 102826 . 108865) (FB.EDITLISPFILE 108867 . 109906) (FB.BROWSECOMMAND 109908 .
|
||||
114647)) (114650 126443 (FB.FASTSEECOMMAND 114660 . 118110) (FB.FASTSEE.ONEFILE 118112 . 121141) (
|
||||
FB.SEEFULLFN 121143 . 125274) (FB.SEEBUTTONFN 125276 . 126441)) (126444 128190 (FB.LOADCOMMAND 126454
|
||||
. 126961) (FB.COMPILECOMMAND 126963 . 127501) (FB.OPERATE.ON.FILES 127503 . 128188)) (128191 175240 (
|
||||
FB.UPDATECOMMAND 128201 . 128426) (FB.MAYBE.EXPUNGE 128428 . 129423) (FB.UPDATEBROWSERITEMS 129425 .
|
||||
142640) (FB.DATE 142642 . 143383) (FB.ADJUST.DATE.WIDTH 143385 . 146353) (FB.SET.BROWSER.TITLE 146355
|
||||
. 147212) (FB.MAYBE.WIDEN.NAMES 147214 . 149333) (FB.SET.DEFAULT.NAME.WIDTH 149335 . 150699) (
|
||||
FB.CREATE.FILEBUCKET 150701 . 157921) (FB.CHECK.NAME.LENGTH 157923 . 160344) (FB.ADD.FILEGROUP 160346
|
||||
. 161873) (FB.INSERT.DIRECTORY 161875 . 162113) (FB.MAKE.SUBDIRECTORY.ITEM 162115 . 163524) (
|
||||
FB.ADD.FILE 163526 . 164139) (FB.INSERT.FILE 164141 . 167553) (FB.ANALYZE.PATTERN 167555 . 172819) (
|
||||
FB.CANONICALIZE.PATTERN 172821 . 174133) (FB.GETALLFILEINFO 174135 . 175238)) (175241 183400 (
|
||||
FB.SORT.VERSIONS 175251 . 178022) (FB.DECREASING.VERSION 178024 . 178693) (FB.INCREASING.VERSION
|
||||
178695 . 179316) (FB.NAMES.DECREASING.VERSION 179318 . 180353) (FB.NAMES.INCREASING.VERSION 180355 .
|
||||
181352) (FB.DECREASING.NUMERIC.ATTR 181354 . 182034) (FB.INCREASING.NUMERIC.ATTR 182036 . 182710) (
|
||||
FB.ALPHABETIC.ATTR 182712 . 183398)) (183401 193243 (FB.SORTCOMMAND 183411 . 190241) (
|
||||
FB.INSERT.SUBDIRECTORIES 190243 . 191040) (FB.GET.SORT.MENU 191042 . 193241)) (193244 209333 (
|
||||
FB.EXPUNGECOMMAND 193254 . 195773) (FB.NEWPATTERNCOMMAND 195775 . 196173) (FB.NEWINFOCOMMAND 196175 .
|
||||
198941) (FB.DEPTHCOMMAND 198943 . 200718) (FB.SHAPECOMMAND 200720 . 204062) (FB.REMOVE.FILE 204064 .
|
||||
205885) (FB.COUNT.FILE.CHANGE 205887 . 207332) (FB.SETNEWPATTERN 207334 . 208504) (FB.GET.NEWPATTERN
|
||||
208506 . 209090) (FB.OPTIONSCOMMAND 209092 . 209331)) (209368 210380 (
|
||||
FB.INFOMENU.SHADEINITIALSELECTIONS 209378 . 210025) (FB.INFO.ITEM.NAMED 210027 . 210378)) (210381
|
||||
219847 (FB.MAKECOUNTERWINDOW 210391 . 211853) (FB.COUNTERW.REDISPLAYFN 211855 . 212442) (
|
||||
FB.UPDATE.COUNTERS 212444 . 214516) (FB.DISPLAY.COUNTERS 214518 . 219578) (FB.COUNTER.STRING 219580 .
|
||||
219845)) (219848 224491 (FB.MAKEHEADINGWINDOW 219858 . 221406) (FB.HEADINGW.REDISPLAYFN 221408 .
|
||||
221674) (FB.HEADINGW.RESHAPEFN 221676 . 222052) (FB.HEADINGW.DISPLAY 222054 . 224489)) (224492 228675
|
||||
(FB.ICONFN 224502 . 224849) (FB.INFOMENU.WHENSELECTEDFN 224851 . 225581) (FB.CLOSEFN 225583 . 226786)
|
||||
(FB.EXPUNGE?.MENU 226788 . 227200) (FB.AFTERCLOSEFN 227202 . 227563) (FB.CLOSE&EXPUNGE 227565 . 228673
|
||||
)) (228676 240734 (FB.HARDCOPY.DIRECTORY 228686 . 239043) (FB.HARDCOPY.PRINT.TITLE 239045 . 239371) (
|
||||
FB.HARDCOPY.MAXWIDTH 239373 . 240732)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,9 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 7-Mar-2021 19:39:11" {DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.;6 193444
|
||||
(FILECREATED "13-Jun-2021 09:05:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6 196680
|
||||
|
||||
changes to%: (VARS MASTERSCOPECOMS MSDATABASECOMS)
|
||||
changes to%: (FNS MSINTERPRETSET)
|
||||
|
||||
previous date%: " 3-Mar-2021 09:08:58" {DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.;5)
|
||||
previous date%: " 9-Jun-2021 23:55:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -1328,36 +1330,53 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDATABASE
|
||||
[LAMBDA (FNLST) (* lmm "12-APR-81 15:57")
|
||||
(PROG (DUMPEDFLG)
|
||||
(DECLARE (SPECVARS DUMPEDFLG DUMPTABLE))
|
||||
(COND
|
||||
(FNLST (MAPC FNLST (FUNCTION UPDATEFN)))
|
||||
(T (UPDATECHANGED)))
|
||||
(PRINT '(READATABASE))
|
||||
(PRIN1 '%()
|
||||
(TERPRI)
|
||||
[for DUMPTABLE in MSDATABASELST when (NOT (MEMB (CAR DUMPTABLE)
|
||||
NODUMPRELATIONS))
|
||||
do (SETQ DUMPEDFLG NIL)
|
||||
[COND
|
||||
((OR (NOT FNLST)
|
||||
(EQ (CDDR DUMPTABLE)
|
||||
T))
|
||||
|
||||
(* either dumping everything, or this is a permanent table which should be
|
||||
dumped in entirity (e.g. templates))
|
||||
[LAMBDA (FNLST FILE) (* ; "Edited 22-May-2021 00:01 by rmk:")
|
||||
|
||||
(MAPTABLE (CADR DUMPTABLE)
|
||||
(FUNCTION DUMPDATABASE1)))
|
||||
(T (MAPC FNLST (FUNCTION (LAMBDA (FN)
|
||||
(DUMPDATABASE1 (GETTABLE FN (CADR DUMPTABLE))
|
||||
FN]
|
||||
(COND
|
||||
(DUMPEDFLG (PRINT]
|
||||
(TERPRI)
|
||||
(PRIN1 '%))
|
||||
(TERPRI])
|
||||
(* ;; "RMK: Added FILE argument to provide an interface to a standard PRETTYDEF file (MAKEFILE but without all of the coms and fileproperty stuff.")
|
||||
|
||||
(IF FILE
|
||||
THEN
|
||||
|
||||
(* ;; "If FILE is provided, then we construct a command for that file so that the database will be dumped by a call to PRETTYDEF that includes whatever contextual information (e.g. package, readtable) that makes the database LOAD(able).")
|
||||
|
||||
(RESETLST
|
||||
[PRETTYDEF NIL FILE `((E (DUMPDATABASE ,(CL:WHEN FNLST
|
||||
(KWOTE (MKLIST FNLST)))])
|
||||
ELSE
|
||||
|
||||
(* ;; "FILE is NIL, then we presume that it is already open and that whatever header information is needed to ensure LOADability has already been written.")
|
||||
|
||||
(PROG (DUMPEDFLG)
|
||||
(DECLARE (SPECVARS DUMPEDFLG DUMPTABLE))
|
||||
(COND
|
||||
(FNLST (MAPC FNLST (FUNCTION UPDATEFN)))
|
||||
(T (UPDATECHANGED)))
|
||||
(PRINT '(READATABASE))
|
||||
(PRIN1 '%()
|
||||
(TERPRI)
|
||||
[for DUMPTABLE in MSDATABASELST when (NOT (MEMB (CAR DUMPTABLE)
|
||||
NODUMPRELATIONS))
|
||||
do (SETQ DUMPEDFLG NIL)
|
||||
[COND
|
||||
((OR (NOT FNLST)
|
||||
(EQ (CDDR DUMPTABLE)
|
||||
T))
|
||||
|
||||
(* either dumping everything, or this is a permanent table which should be
|
||||
dumped in entirity (e.g. templates))
|
||||
|
||||
(MAPTABLE (CADR DUMPTABLE)
|
||||
(FUNCTION DUMPDATABASE1)))
|
||||
(T (MAPC FNLST (FUNCTION (LAMBDA (FN)
|
||||
(DUMPDATABASE1 (GETTABLE FN (CADR
|
||||
DUMPTABLE
|
||||
))
|
||||
FN]
|
||||
(COND
|
||||
(DUMPEDFLG (PRINT]
|
||||
(TERPRI)
|
||||
(PRIN1 '%))
|
||||
(TERPRI])
|
||||
|
||||
(DUMPDATABASE1
|
||||
[LAMBDA (VALUE FN) (* rmk%: "24-OCT-79 10:02")
|
||||
@@ -2559,7 +2578,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(* ; "interactive routines")
|
||||
|
||||
|
||||
(RPAQ MASTERSCOPEDATE " 7-Mar-2021")
|
||||
(RPAQ MASTERSCOPEDATE "13-Jun-2021")
|
||||
|
||||
(ADDTOVAR HISTORYCOMS %.)
|
||||
(DEFINEQ
|
||||
@@ -2649,10 +2668,10 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(DEFINEQ
|
||||
|
||||
(MSINTERPRETSET
|
||||
[LAMBDA (SET OP ARG) (* ; "Edited 15-Aug-90 11:50 by jds")
|
||||
[LAMBDA (SET OP ARG) (* ; "Edited 13-Jun-2021 09:04 by rmk:")
|
||||
|
||||
(* ;; "DECLARATIONS%%: (RECORDS SENTENCE MSSETPHRASE)")
|
||||
(* ; "Edited 3-Jun-88 12:42 by jrb:")
|
||||
(* ;; "DECLARATIONS%%: (RECORDS SENTENCE MSSETPHRASE)")
|
||||
(* ; "Edited 3-Jun-88 12:42 by jrb:")
|
||||
(PROG (TEM TYPE (REP (fetch (MSSETPHRASE REP) of SET)))
|
||||
START
|
||||
[COND
|
||||
@@ -2698,7 +2717,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(CHECK ARG)
|
||||
((LIST HARD)
|
||||
|
||||
(* ;; "got a list of dotted pairs of hash tables and another set; want to know the set of all things which have the given relation to any in the other set")
|
||||
(* ;; "got a list of dotted pairs of hash tables and another set; want to know the set of all things which have the given relation to any in the other set")
|
||||
|
||||
(PROG ((HTABS (fetch (INRELATION HTABLES) of REP))
|
||||
(INVERTED (fetch (INRELATION INVERTED)
|
||||
@@ -2759,8 +2778,9 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(SHOULDNT 12)))
|
||||
(QUOTE (SELECTQ OP
|
||||
(CHECK (COND
|
||||
(ARG (SETQ NEEDUPDATE (UNION NEEDUPDATE (fetch QUOTED
|
||||
of REP)))
|
||||
(ARG (SETQ NEEDUPDATE (UNION NEEDUPDATE (fetch
|
||||
'QUOTED of
|
||||
REP)))
|
||||
NIL)))
|
||||
((HARD LIST)
|
||||
(SETQ TYPE (OR (fetch (MSSETPHRASE TYPE) of SET)
|
||||
@@ -2768,7 +2788,7 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(COND
|
||||
([AND ARG (NEQ ARG 'FILES)
|
||||
(NEQ TYPE 'FILES)
|
||||
(FMEMB (SETQ TEM (fetch QUOTED of REP))
|
||||
(FMEMB (SETQ TEM (fetch 'QUOTED of REP))
|
||||
FILELST)
|
||||
(COND
|
||||
((EQ ARG 'KNOWN)
|
||||
@@ -2779,28 +2799,29 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
((EQ ARG 'KNOWN)
|
||||
'FNS)
|
||||
(T ARG)))
|
||||
(SETQ TEM (for FILE in (fetch QUOTED of REP)
|
||||
(SETQ TEM (for FILE in (fetch 'QUOTED of
|
||||
REP)
|
||||
join (ONFILE FILE ARG)))
|
||||
(printout T (fetch QUOTED of REP)
|
||||
(printout T (fetch 'QUOTED of REP)
|
||||
" => ON "
|
||||
(fetch QUOTED of REP)
|
||||
(fetch 'QUOTED of REP)
|
||||
T)
|
||||
(replace QUOTED of (fetch (MSSETPHRASE REP)
|
||||
of SET) with TEM))
|
||||
(replace 'QUOTED of (fetch (MSSETPHRASE REP)
|
||||
of SET) with TEM))
|
||||
(T (COND
|
||||
([AND (EQ TYPE 'FNS)
|
||||
(GETP (fetch QUOTED of REP)
|
||||
(GETP (fetch 'QUOTED of REP)
|
||||
'CLISPWORD)
|
||||
(NOT (GETD (fetch QUOTED of REP]
|
||||
(printout T "Warning: " (fetch QUOTED of REP)
|
||||
(NOT (GETD (fetch 'QUOTED of REP]
|
||||
(printout T "Warning: " (fetch 'QUOTED of REP)
|
||||
|
||||
"is a CLISP word and is not treated like a function!"
|
||||
T)))
|
||||
(fetch QUOTED of REP))))
|
||||
(MEMB (FMEMB ARG (fetch QUOTED of REP)))
|
||||
(fetch 'QUOTED of REP))))
|
||||
(MEMB (FMEMB ARG (fetch 'QUOTED of REP)))
|
||||
(SHOULDNT 13)))
|
||||
(OR
|
||||
(* ;; "I.e. WHO ON MYFILE OR @ EXPRP CALL X --- if either of the sets need to be KNOWN and are 'vague' then the entire world needs to be updated")
|
||||
(* ;; "I.e. WHO ON MYFILE OR @ EXPRP CALL X --- if either of the sets need to be KNOWN and are 'vague' then the entire world needs to be updated")
|
||||
|
||||
(SELECTQ OP
|
||||
(CHECK ([LAMBDA (X)
|
||||
@@ -2838,8 +2859,8 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(MSINTERPRETSET (fetch (CSET SET2) of REP)
|
||||
'MEMB ARG)))
|
||||
(SHOULDNT 14)))
|
||||
(AND (* ;
|
||||
"I.e. WHO ON MYFILE AND @ EXPRP CALL Z -- only if both sets are vague does the world need updating")
|
||||
(AND (* ;
|
||||
"I.e. WHO ON MYFILE AND @ EXPRP CALL Z -- only if both sets are vague does the world need updating")
|
||||
(SELECTQ OP
|
||||
(CHECK ([LAMBDA (X)
|
||||
(OR (MSINTERPRETSET (fetch (CSET SET2) of REP)
|
||||
@@ -2877,55 +2898,58 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
'MEMB ARG)))
|
||||
(SHOULDNT 15)))
|
||||
(ANDNOT (replace (SENTENCE ID) of REP with 'AND)
|
||||
[replace (MSSETPHRASE REP) of (fetch SET2 of REP)
|
||||
[replace (MSSETPHRASE REP) of (fetch (CSET SET2) of REP)
|
||||
with (create NOT
|
||||
NEGATED _ (create MSSETPHRASE
|
||||
using (fetch SET2 of REP)
|
||||
using (fetch (CSET SET2)
|
||||
of REP)
|
||||
REP _ (fetch (MSSETPHRASE REP)
|
||||
of (fetch SET2
|
||||
of (fetch
|
||||
(CSET SET2)
|
||||
of REP]
|
||||
(GO RETRY))
|
||||
(IN [SETQ REP (create QUOTE
|
||||
QUOTED _ (MKLIST (CL:EVAL (fetch (IN EXPRESSION)
|
||||
of REP]
|
||||
(GO RETRY))
|
||||
(BLOCKS (* ; "Block set")
|
||||
(BLOCKS (* ; "Block set")
|
||||
(SELECTQ OP
|
||||
(CHECK [[LAMBDA (X Y)
|
||||
(OR X Y]
|
||||
(AND (fetch FNS of REP)
|
||||
(MSINTERPRETSET (fetch FNS of REP)
|
||||
(AND (fetch (BLOCKS FNS) of REP)
|
||||
(MSINTERPRETSET (fetch (BLOCKS FNS) of REP)
|
||||
'CHECK))
|
||||
(AND (fetch FILES of REP)
|
||||
(MSINTERPRETSET (fetch FILES of REP)
|
||||
(AND (fetch (BLOCKS FILES) of REP)
|
||||
(MSINTERPRETSET (fetch (BLOCKS FILES)
|
||||
of REP)
|
||||
'CHECK])
|
||||
(PROGN [SETQ REP (create QUOTE
|
||||
QUOTED _
|
||||
(MSGETBLOCKDEC (fetch TYPES
|
||||
of REP)
|
||||
(fetch FNS of REP)
|
||||
(AND (fetch FILES of REP)
|
||||
(MSINTERPRETSET (fetch
|
||||
FILES
|
||||
of
|
||||
REP)
|
||||
'HARD]
|
||||
(MSGETBLOCKDEC
|
||||
(fetch (BLOCKS TYPES) of REP)
|
||||
(fetch (BLOCKS FNS) of REP)
|
||||
(AND (fetch (BLOCKS FILES) of REP)
|
||||
(MSINTERPRETSET (fetch
|
||||
(BLOCKS FILES)
|
||||
of REP)
|
||||
'HARD]
|
||||
(GO RETRY))))
|
||||
(FIELDS (SELECTQ OP
|
||||
(CHECK (MSINTERPRETSET (fetch RECS of REP)
|
||||
(CHECK (MSINTERPRETSET (fetch (FIELDS RECS) of REP)
|
||||
OP))
|
||||
(PROGN [SETQ REP
|
||||
(create QUOTE
|
||||
QUOTED _
|
||||
(PROG (VAL)
|
||||
(for X
|
||||
in (MSLISTSET (fetch RECS
|
||||
of REP)
|
||||
T)
|
||||
do (SETQ VAL (UNION (RECORDFIELDNAMES
|
||||
X)
|
||||
VAL)))
|
||||
(RETURN VAL]
|
||||
(PROGN [SETQ REP (create
|
||||
QUOTE
|
||||
QUOTED _
|
||||
(PROG (VAL)
|
||||
(for X
|
||||
in (MSLISTSET (fetch
|
||||
(FIELDS RECS)
|
||||
of REP)
|
||||
T)
|
||||
do (SETQ VAL (UNION (RECORDFIELDNAMES
|
||||
X)
|
||||
VAL)))
|
||||
(RETURN VAL]
|
||||
(GO RETRY))))
|
||||
(THAT (PROG (TABLES (MSVERB (fetch (THAT MSVERB) of REP))
|
||||
VALUE
|
||||
@@ -2934,34 +2958,39 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
((AND OR ANDNOT)
|
||||
[SETQ REP
|
||||
(create CSET
|
||||
ID _ (fetch (CVERB C)
|
||||
of (fetch VPART of MSVERB))
|
||||
ID _ (fetch (CVERB C) of (fetch
|
||||
(MSVERB VPART)
|
||||
of MSVERB))
|
||||
SET1 _
|
||||
(create MSSETPHRASE
|
||||
using SET REP _
|
||||
(create THAT
|
||||
MSVERB _
|
||||
(create MSVERB
|
||||
TENSE _ (fetch TENSE
|
||||
of MSVERB)
|
||||
VPART _
|
||||
(fetch (CVERB VB1)
|
||||
of (fetch VPART
|
||||
of MSVERB)))
|
||||
OTHERSET _ OS))
|
||||
(create
|
||||
THAT
|
||||
MSVERB _ (create
|
||||
MSVERB
|
||||
TENSE _ (fetch (MSVERB TENSE)
|
||||
of MSVERB)
|
||||
VPART _
|
||||
(fetch (CVERB VB1)
|
||||
of (fetch (MSVERB
|
||||
VPART)
|
||||
of MSVERB)))
|
||||
OTHERSET _ OS))
|
||||
SET2 _
|
||||
(create MSSETPHRASE
|
||||
using SET REP _
|
||||
(create THAT
|
||||
MSVERB _
|
||||
(create MSVERB
|
||||
TENSE _ (fetch TENSE
|
||||
of MSVERB)
|
||||
VPART _
|
||||
(fetch (CVERB VB2)
|
||||
of (fetch VPART
|
||||
of MSVERB)))
|
||||
OTHERSET _ OS]
|
||||
(create
|
||||
THAT
|
||||
MSVERB _ (create
|
||||
MSVERB
|
||||
TENSE _ (fetch (MSVERB TENSE)
|
||||
of MSVERB)
|
||||
VPART _
|
||||
(fetch (CVERB VB2)
|
||||
of (fetch (MSVERB
|
||||
VPART)
|
||||
of MSVERB)))
|
||||
OTHERSET _ OS]
|
||||
(GO RETRY))
|
||||
(CALL (COND
|
||||
((EQ (fetch (MSVERB MODIFIER) of MSVERB)
|
||||
@@ -2981,17 +3010,17 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
TOPFLG _ T]
|
||||
(GO RETRY))))
|
||||
(CONTAIN (COND
|
||||
((EQ (fetch DET of OS)
|
||||
((EQ (fetch (MSSETPHRASE DET) of OS)
|
||||
'WHICH)
|
||||
(SHOULDNT 16)))
|
||||
|
||||
(* ;; "JRB - Default types on files are now ignored - removed (|fetch| (MSSETPHRASE DEFAULTTYPE) |of| SET) from ORs below.")
|
||||
(* ;; "JRB - Default types on files are now ignored - removed (|fetch| (MSSETPHRASE DEFAULTTYPE) |of| SET) from ORs below.")
|
||||
|
||||
[SETQ REP
|
||||
(create
|
||||
QUOTE
|
||||
QUOTED _
|
||||
(SELECTQ (fetch TENSE of MSVERB)
|
||||
(SELECTQ (fetch (MSVERB TENSE) of MSVERB)
|
||||
(ED (ONFILE (MSINTERPRETSET OS 'HARD)
|
||||
(OR (fetch (MSVERB MODIFIER)
|
||||
of MSVERB)
|
||||
@@ -3009,14 +3038,15 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
NIL)
|
||||
(SELECTQ OP
|
||||
(CHECK (SETQ VALUE (MSINTERPRETSET OS 'CHECK
|
||||
(fetch KNOWN of OS))))
|
||||
(fetch (MSSETPHRASE KNOWN)
|
||||
of OS))))
|
||||
NIL)
|
||||
(SETQ TABLES (GETVERBTABLES (fetch (MSVERB ROOT) of MSVERB
|
||||
)
|
||||
(fetch (MSVERB MODIFIER) of MSVERB)))
|
||||
(replace REP of SET
|
||||
(replace (MSSETPHRASE REP) of SET
|
||||
with (SETQ REP (create INRELATION
|
||||
INVERTED _ (EQ (fetch TENSE
|
||||
INVERTED _ (EQ (fetch (MSVERB TENSE)
|
||||
of MSVERB)
|
||||
'ED)
|
||||
HTABLES _ TABLES
|
||||
@@ -3025,14 +3055,14 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
VALUE))))
|
||||
(PATHS (COND
|
||||
((EQ OP 'CHECK)
|
||||
(CHECKPATHS (fetch MSPATHOPTIONS of REP)))
|
||||
(CHECKPATHS (fetch (PATHS MSPATHOPTIONS) of REP)))
|
||||
(T (SETQ REP (create GETHASH
|
||||
HTABLE _ (LIST (MSONPATH REP))
|
||||
BADMARKS _ T))
|
||||
(GO RETRY))))
|
||||
(SHOULDNT 17]
|
||||
RETRY
|
||||
(replace REP of SET with REP)
|
||||
(replace (MSSETPHRASE REP) of SET with REP)
|
||||
(GO START])
|
||||
|
||||
(MSINTERPA
|
||||
@@ -3148,12 +3178,12 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(RETURN (OR VAL (NULL (FASSOC 'FROM OPTIONS])
|
||||
|
||||
(ONFILE
|
||||
[LAMBDA (FILES TYPES FINDITEMS) (* ; "Edited 2-Jun-88 11:19 by jrb:")
|
||||
(* ;
|
||||
"MSHASHFILE uses cause GETRELATION barfs if CONTAINS table doesn't exist.")
|
||||
[LAMBDA (FILES TYPES FINDITEMS) (* ; "Edited 9-Jun-2021 23:53 by rmk:")
|
||||
(* ;
|
||||
"MSHASHFILE uses cause GETRELATION barfs if CONTAINS table doesn't exist.")
|
||||
(PROG (VAL)
|
||||
|
||||
(* ;; "JRB - TYPES of 'ALL means gather all types Masterscope knows about")
|
||||
(* ;; "JRB - TYPES of 'ALL means gather all types Masterscope knows about")
|
||||
|
||||
[AND (EQ TYPES 'ALL)
|
||||
(SETQ TYPES (for FT in MSFNTYPES collect (fetch (MSANALYZABLE
|
||||
@@ -3167,8 +3197,8 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
((FNS KNOWN NIL)
|
||||
T)
|
||||
NIL))) inside (OR FILES FILELST)
|
||||
do (* ;
|
||||
"Don't notice the file if we only care about FNS and the file is known to the database.")
|
||||
do (* ;
|
||||
"Don't notice the file if we only care about FNS and the file is known to the database.")
|
||||
(COND
|
||||
[(AND FNSONLY (NOT (MEMB FILE FILELST))
|
||||
(GETRELATION FILE 'CONTAINS]
|
||||
@@ -3187,29 +3217,43 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(T (SETQ VAL (UNION (FILECOMSLST FILE TYPE)
|
||||
VAL]
|
||||
[COND
|
||||
((AND MSHASHFILE (NULL VAL)
|
||||
[(AND MSHASHFILE (NULL VAL)
|
||||
(find TYPE inside TYPES suchthat (SELECTQ TYPE
|
||||
((FNS KNOWN NIL)
|
||||
T)
|
||||
NIL)))
|
||||
(* ;
|
||||
"Didn't find it in core; perhaps the CONTAINS table knows")
|
||||
(* ;
|
||||
"Didn't find it in core; perhaps the CONTAINS table knows")
|
||||
(* ; "RMK: or the WHEREIS hashfile")
|
||||
(COND
|
||||
[FILES (for FILE inside FILES
|
||||
do (COND
|
||||
(FINDITEMS (for X inside FINDITEMS
|
||||
when (TESTRELATION X 'CONTAINS FILE T)
|
||||
do (pushnew VAL FILE)))
|
||||
[FINDITEMS (for X inside FINDITEMS
|
||||
do (IF (OR (TESTRELATION X
|
||||
'CONTAINS FILE T)
|
||||
(MEMB FILE
|
||||
(WHEREIS X TYPES T)))
|
||||
THEN (pushnew VAL FILE]
|
||||
(T (SETQ VAL (UNION (GETRELATION FILE 'CONTAINS)
|
||||
VAL]
|
||||
(FINDITEMS
|
||||
|
||||
(* ;; "No files: should use all known files, but that information isn't explicitly kept by MSHASH. Soooo, we'll only do the case where FINDITEMS is given")
|
||||
(* ;; "No files: should use all known files, but that information isn't explicitly kept by MSHASH. Soooo, we'll only do the case where FINDITEMS is given")
|
||||
|
||||
(for X inside FINDITEMS do (SETQ VAL (UNION (GETRELATION
|
||||
X
|
||||
'CONTAINS T)
|
||||
VAL]
|
||||
(for X inside FINDITEMS
|
||||
do (SETQ VAL (UNION (OR (GETRELATION X 'CONTAINS T)
|
||||
(WHEREIS X TYPES T))
|
||||
VAL]
|
||||
(T
|
||||
(* ;; "RMK: If we really have no information, maybe the WHEREIS hashfile knows.")
|
||||
|
||||
(for X inside FINDITEMS
|
||||
do (IF (FOR F IN (OR (GETRELATION X 'CONTAINS T)
|
||||
(RETURN NIL)) DO (PUSHNEW VAL F)
|
||||
FINALLY (RETURN T))
|
||||
ELSE (FOR TYPE INSIDE (OR TYPES 'FNS)
|
||||
DO (FOR F IN (WHEREIS X TYPE T)
|
||||
DO (PUSHNEW VAL F]
|
||||
(RETURN VAL])
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -3685,36 +3729,36 @@ Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corpo
|
||||
(PUTPROPS MASTERSCOPE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993
|
||||
1994 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3402 19171 (UPDATEFN 3412 . 5029) (MSGETDEF 5031 . 6437) (MSNOTICEFILE 6439 . 8832) (
|
||||
MSSHOWUSE 8834 . 14337) (MSUPDATEFN1 14339 . 15027) (MSUPDATE 15029 . 17455) (MSNLAMBDACHECK 17457 .
|
||||
18339) (MSCOLLECTDATA 18341 . 19169)) (19172 20071 (UPDATECHANGED 19182 . 19545) (UPDATECHANGED1 19547
|
||||
. 20069)) (20645 21068 (MSCLOSEFILES 20655 . 21066)) (21749 26181 (MSDESCRIBE 21759 . 24547) (
|
||||
MSDESCRIBE1 24549 . 25612) (FMAPRINT 25614 . 26179)) (26274 26714 (MSPRINTHELPFILE 26284 . 26712)) (
|
||||
26764 29902 (TEMPLATE 26774 . 28195) (GETTEMPLATE 28197 . 28332) (SETTEMPLATE 28334 . 29900)) (30772
|
||||
35696 (ADDTEMPLATEWORD 30782 . 31454) (MSADDANALYZE 31456 . 32954) (MSADDMODIFIER 32956 . 34037) (
|
||||
MSADDRELATION 34039 . 34786) (MSADDTYPE 34788 . 35694)) (37197 42418 (MSMARKCHANGE1 37207 . 38001) (
|
||||
MSINIT 38003 . 39184) (GETVERBTABLES 39186 . 39739) (MSSTOREDATA 39741 . 41420) (STORETABLE 41422 .
|
||||
42416)) (43819 48889 (PARSERELATION 43829 . 44429) (PARSERELATION1 44431 . 45886) (GETRELATION 45888
|
||||
. 46917) (MAPRELATION 46919 . 48053) (TESTRELATION 48055 . 48887)) (48890 50530 (ADDHASH 48900 .
|
||||
49378) (SUBHASH 49380 . 49608) (MAKEHASH 49610 . 49754) (MSREHASH 49756 . 50209) (EQMEMBHASH 50211 .
|
||||
50528)) (50869 57084 (MSVBTABLES 50879 . 56658) (MSUSERVBTABLES 56660 . 57082)) (57167 59378 (
|
||||
BUILDGETRELQ 57177 . 58283) (BUILDTESTRELQ 58285 . 59376)) (59549 59937 (MSERASE 59559 . 59935)) (
|
||||
59938 63170 (DUMPDATABASE 59948 . 61285) (DUMPDATABASE1 61287 . 61632) (READATABASE 61634 . 63168)) (
|
||||
64252 93311 (MSCHECKBLOCKS 64262 . 68082) (MSCHECKBLOCK 68084 . 76704) (MSCHECKFNINBLOCK 76706 . 79706
|
||||
) (MSCHECKBLOCKBASIC 79708 . 82128) (MSCHECKBOUNDFREE 82130 . 84029) (GLOBALVARP 84031 . 84198) (
|
||||
PRINTERROR 84200 . 87416) (MSCHECKVARS1 87418 . 90371) (UNECCSPEC 90373 . 90651) (NECCSPEC 90653 .
|
||||
91000) (SPECVARP 91002 . 91529) (SHORTLST 91531 . 91987) (DOERROR 91989 . 92699) (MSMSGPRINT 92701 .
|
||||
93309)) (94455 109283 (MSPATHS 94465 . 97867) (MSPATHS1 97869 . 102104) (MSPATHS2 102106 . 105516) (
|
||||
MSONPATH 105518 . 106746) (MSPATHS4 106748 . 107830) (DASHES 107832 . 108358) (DOTABS 108360 . 108601)
|
||||
(BELOWMARKER 108603 . 109066) (MSPATHSPRINTFN 109068 . 109281)) (109669 113093 (MSFIND 109679 .
|
||||
109954) (MSEDITF 109956 . 110956) (MSEDITE 110958 . 111995) (EDITGETDEF 111997 . 113091)) (114099
|
||||
122700 (MSMARKCHANGED 114109 . 115833) (CHANGEMACRO 115835 . 116540) (CHANGEVAR 116542 . 116858) (
|
||||
CHANGEI.S. 116860 . 118193) (CHANGERECORD 118195 . 119066) (MSNEEDUNSAVE 119068 . 120060) (UNSAVEFNS
|
||||
120062 . 122698)) (123141 126631 (%. 123151 . 123291) (MASTERSCOPE 123293 . 123819) (MASTERSCOPE1
|
||||
123821 . 124689) (MASTERSCOPEXEC 124691 . 126629)) (126670 164329 (MSINTERPRETSET 126680 . 154173) (
|
||||
MSINTERPA 154175 . 154709) (MSGETBLOCKDEC 154711 . 157224) (LISTHARD 157226 . 158444) (MSMEMBSET
|
||||
158446 . 158591) (MSLISTSET 158593 . 158958) (MSHASHLIST 158960 . 159127) (MSHASHLIST1 159129 . 159455
|
||||
) (CHECKPATHS 159457 . 160097) (ONFILE 160099 . 164327)) (164330 187496 (MSINTERPRET 164340 . 181193)
|
||||
(VERBNOTICELIST 181195 . 182305) (MSOUTPUT 182307 . 182624) (MSCHECKEMPTY 182626 . 183830) (
|
||||
CHECKFORCHANGED 183832 . 184352) (MSSOLVE 184354 . 187494)))))
|
||||
(FILEMAP (NIL (3419 19188 (UPDATEFN 3429 . 5046) (MSGETDEF 5048 . 6454) (MSNOTICEFILE 6456 . 8849) (
|
||||
MSSHOWUSE 8851 . 14354) (MSUPDATEFN1 14356 . 15044) (MSUPDATE 15046 . 17472) (MSNLAMBDACHECK 17474 .
|
||||
18356) (MSCOLLECTDATA 18358 . 19186)) (19189 20088 (UPDATECHANGED 19199 . 19562) (UPDATECHANGED1 19564
|
||||
. 20086)) (20662 21085 (MSCLOSEFILES 20672 . 21083)) (21766 26198 (MSDESCRIBE 21776 . 24564) (
|
||||
MSDESCRIBE1 24566 . 25629) (FMAPRINT 25631 . 26196)) (26291 26731 (MSPRINTHELPFILE 26301 . 26729)) (
|
||||
26781 29919 (TEMPLATE 26791 . 28212) (GETTEMPLATE 28214 . 28349) (SETTEMPLATE 28351 . 29917)) (30789
|
||||
35713 (ADDTEMPLATEWORD 30799 . 31471) (MSADDANALYZE 31473 . 32971) (MSADDMODIFIER 32973 . 34054) (
|
||||
MSADDRELATION 34056 . 34803) (MSADDTYPE 34805 . 35711)) (37214 42435 (MSMARKCHANGE1 37224 . 38018) (
|
||||
MSINIT 38020 . 39201) (GETVERBTABLES 39203 . 39756) (MSSTOREDATA 39758 . 41437) (STORETABLE 41439 .
|
||||
42433)) (43836 48906 (PARSERELATION 43846 . 44446) (PARSERELATION1 44448 . 45903) (GETRELATION 45905
|
||||
. 46934) (MAPRELATION 46936 . 48070) (TESTRELATION 48072 . 48904)) (48907 50547 (ADDHASH 48917 .
|
||||
49395) (SUBHASH 49397 . 49625) (MAKEHASH 49627 . 49771) (MSREHASH 49773 . 50226) (EQMEMBHASH 50228 .
|
||||
50545)) (50886 57101 (MSVBTABLES 50896 . 56675) (MSUSERVBTABLES 56677 . 57099)) (57184 59395 (
|
||||
BUILDGETRELQ 57194 . 58300) (BUILDTESTRELQ 58302 . 59393)) (59566 59954 (MSERASE 59576 . 59952)) (
|
||||
59955 64415 (DUMPDATABASE 59965 . 62530) (DUMPDATABASE1 62532 . 62877) (READATABASE 62879 . 64413)) (
|
||||
65497 94556 (MSCHECKBLOCKS 65507 . 69327) (MSCHECKBLOCK 69329 . 77949) (MSCHECKFNINBLOCK 77951 . 80951
|
||||
) (MSCHECKBLOCKBASIC 80953 . 83373) (MSCHECKBOUNDFREE 83375 . 85274) (GLOBALVARP 85276 . 85443) (
|
||||
PRINTERROR 85445 . 88661) (MSCHECKVARS1 88663 . 91616) (UNECCSPEC 91618 . 91896) (NECCSPEC 91898 .
|
||||
92245) (SPECVARP 92247 . 92774) (SHORTLST 92776 . 93232) (DOERROR 93234 . 93944) (MSMSGPRINT 93946 .
|
||||
94554)) (95700 110528 (MSPATHS 95710 . 99112) (MSPATHS1 99114 . 103349) (MSPATHS2 103351 . 106761) (
|
||||
MSONPATH 106763 . 107991) (MSPATHS4 107993 . 109075) (DASHES 109077 . 109603) (DOTABS 109605 . 109846)
|
||||
(BELOWMARKER 109848 . 110311) (MSPATHSPRINTFN 110313 . 110526)) (110914 114338 (MSFIND 110924 .
|
||||
111199) (MSEDITF 111201 . 112201) (MSEDITE 112203 . 113240) (EDITGETDEF 113242 . 114336)) (115344
|
||||
123945 (MSMARKCHANGED 115354 . 117078) (CHANGEMACRO 117080 . 117785) (CHANGEVAR 117787 . 118103) (
|
||||
CHANGEI.S. 118105 . 119438) (CHANGERECORD 119440 . 120311) (MSNEEDUNSAVE 120313 . 121305) (UNSAVEFNS
|
||||
121307 . 123943)) (124386 127876 (%. 124396 . 124536) (MASTERSCOPE 124538 . 125064) (MASTERSCOPE1
|
||||
125066 . 125934) (MASTERSCOPEXEC 125936 . 127874)) (127915 167565 (MSINTERPRETSET 127925 . 156459) (
|
||||
MSINTERPA 156461 . 156995) (MSGETBLOCKDEC 156997 . 159510) (LISTHARD 159512 . 160730) (MSMEMBSET
|
||||
160732 . 160877) (MSLISTSET 160879 . 161244) (MSHASHLIST 161246 . 161413) (MSHASHLIST1 161415 . 161741
|
||||
) (CHECKPATHS 161743 . 162383) (ONFILE 162385 . 167563)) (167566 190732 (MSINTERPRET 167576 . 184429)
|
||||
(VERBNOTICELIST 184431 . 185541) (MSOUTPUT 185543 . 185860) (MSCHECKEMPTY 185862 . 187066) (
|
||||
CHECKFORCHANGED 187068 . 187588) (MSSOLVE 187590 . 190730)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
164
library/RDSYS
164
library/RDSYS
File diff suppressed because one or more lines are too long
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,19 +1,64 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "25-Aug-94 10:54:07" {DSK}<king>export>lispcore>library>TEDITHCPY.;4 104820
|
||||
(FILECREATED "28-Jun-2021 12:35:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;2 105754
|
||||
|
||||
changes to%: (VARS TEDITHCPYCOMS) (FILES TEDITDCL)
|
||||
changes to%: (FNS \TEDIT.HARDCOPY.FORMATLINE)
|
||||
|
||||
previous date%: "29-Mar-94 17:25:49" {DSK}<king>export>lispcore>library>TEDITHCPY.;3)
|
||||
previous date%: "25-Aug-94 10:54:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITHCPYCOMS)
|
||||
|
||||
(RPAQQ TEDITHCPYCOMS ((FILES TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) (COMS (* ;; "Generic interface functions and common code") (FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX)) (COMS (* ;; "Functions for scaling distances and regions as needed during hardcopy.") (FNS \TEDIT.SCALE \TEDIT.SCALEREGION)) (COMS (* ;; "PRESS-specific code") (VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495))) (* ; "0.75 inches from bottom, 1 from top")) (COMS (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.") (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY) (P (LISTPUT (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE INTERPRESS) PRINTFILETYPES)) (QUOTE TEDIT) (FUNCTION \TEDIT.HARDCOPY))) (P (LET ((PRESSVALUES (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE PRESS) PRINTFILETYPES)))) (COND (PRESSVALUES (* ; "Only install PRESS printing if PRESS is loaded.") (LISTPUT PRESSVALUES (QUOTE TEDIT) (FUNCTION \TEDIT.PRESS.HARDCOPY))))))) (COMS (* ;; "vars for Japanese Line Break") (VARS (TEDIT.DONT.BREAK.CHARS (QUOTE (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539 9571 9573 9575 9582))) (TEDIT.DONT.LAST.CHARS (QUOTE (8524 8538 8536 8534)))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) (COMS (* ;; "Support for hardcopying several files as one document") (FNS TEDIT-BOOK)))
|
||||
)
|
||||
(RPAQQ TEDITHCPYCOMS
|
||||
((FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
(COMS
|
||||
(* ;; "Generic interface functions and common code")
|
||||
|
||||
(FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
|
||||
\TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS
|
||||
\TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX))
|
||||
(COMS
|
||||
(* ;; "Functions for scaling distances and regions as needed during hardcopy.")
|
||||
|
||||
(FNS \TEDIT.SCALE \TEDIT.SCALEREGION))
|
||||
(COMS
|
||||
(* ;; "PRESS-specific code")
|
||||
|
||||
(VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
|
||||
(* ;
|
||||
"0.75 inches from bottom, 1 from top")
|
||||
)
|
||||
[COMS
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
|
||||
|
||||
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
|
||||
(P (LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
|
||||
'TEDIT
|
||||
(FUNCTION \TEDIT.HARDCOPY)))
|
||||
(P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
|
||||
(COND (PRESSVALUES (* ;
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
(COMS
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
|
||||
[VARS (TEDIT.DONT.BREAK.CHARS '(8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251
|
||||
9253 9255 9257 9283 9315 9317 9319 9326 9505 9507
|
||||
9509 9511 9513 9539 9571 9573 9575 9582))
|
||||
(TEDIT.DONT.LAST.CHARS '(8524 8538 8536 8534]
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))
|
||||
(COMS
|
||||
(* ;; "Support for hardcopying several files as one document")
|
||||
|
||||
(FNS TEDIT-BOOK))))
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -26,7 +71,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (LOADCOMP) TEDITDCL)
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TEDITDCL)
|
||||
)
|
||||
|
||||
|
||||
@@ -298,10 +344,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
PRSTREAM LINE])
|
||||
|
||||
(\TEDIT.HARDCOPY.FORMATLINE
|
||||
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING? PAGEINFO)
|
||||
(* ; "Edited 29-Mar-94 17:15 by jds")
|
||||
[LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING? PAGEINFO)
|
||||
(* ; "Edited 28-Jun-2021 12:34 by rmk:")
|
||||
|
||||
(* ;;; "Given a starting place, format the next line of text. Return T if a control-L was seen on the line.")
|
||||
(* ;;; "Given a starting place, format the next line of text. Return T if a control-L was seen on the line.")
|
||||
|
||||
(DECLARE (SPECVARS LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST
|
||||
WLIST DEVICE NEWASCENT NEWDESCENT IMAGESTREAM))
|
||||
@@ -322,77 +368,77 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO CTRL\L\SEEN
|
||||
1STLN FMTSPEC NEWASCENT NEWDESCENT PREVHYPH PREVDHYPH ORIGCHLIST ORIGWLIST)
|
||||
|
||||
(* ;; "Variables:")
|
||||
(* ;; "Variables:")
|
||||
|
||||
(* ;; "(TLEN = Current character count on the line)")
|
||||
(* ;; "(TLEN = Current character count on the line)")
|
||||
|
||||
(* ;; "(CHNO = Current character # in the Text)")
|
||||
(* ;; "(CHNO = Current character # in the Text)")
|
||||
|
||||
(* ;; "(DX = width of current char/object)")
|
||||
(* ;; "(DX = width of current char/object)")
|
||||
|
||||
(* ;; "(TX = current right margin) ")
|
||||
(* ;; "(TX = current right margin) ")
|
||||
|
||||
(* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ")
|
||||
(* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ")
|
||||
|
||||
(* ;; "(CH#B = The CHNO of most recent space/tab)")
|
||||
(* ;; "(CH#B = The CHNO of most recent space/tab)")
|
||||
|
||||
(* ;; "(TXB = right margin of most recent space/tab)")
|
||||
(* ;; "(TXB = right margin of most recent space/tab)")
|
||||
|
||||
(* ;; "(DXB = width of most recent space/tab)")
|
||||
(* ;; "(DXB = width of most recent space/tab)")
|
||||
|
||||
(* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)")
|
||||
(* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)")
|
||||
|
||||
(* ;; "(T1SPACE = a space/CR/TAB has been seen)")
|
||||
(* ;; "(T1SPACE = a space/CR/TAB has been seen)")
|
||||
|
||||
(* ;; "(#BLANKS = # of spaces/tabs seen) ")
|
||||
(* ;; "(#BLANKS = # of spaces/tabs seen) ")
|
||||
|
||||
(* ;; "(LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)")
|
||||
(* ;; "(LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)")
|
||||
|
||||
(* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)")
|
||||
(* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)")
|
||||
|
||||
(* ;; "(ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential line break point)")
|
||||
(* ;; "(ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential line break point)")
|
||||
|
||||
[SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch CHARS of
|
||||
THISLINE]
|
||||
(* ;
|
||||
"Place to put character codes/objects")
|
||||
(* ;
|
||||
"Place to put character codes/objects")
|
||||
[SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS)
|
||||
of THISLINE]
|
||||
(* ; "Place to put width of each item")
|
||||
(* ; "Place to put width of each item")
|
||||
(SETQ LOOKS (fetch LOOKS of THISLINE))
|
||||
(SETQ TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))
|
||||
(SETQ TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ))
|
||||
(replace LOOKSUPDATEFN of TEXTSTREAM with (FUNCTION \TEDIT.HCPYLOOKS.UPDATE))
|
||||
(* ;
|
||||
"This gets called every time we cross a piece boundary, to check for changes in looks.")
|
||||
(* ;
|
||||
"This gets called every time we cross a piece boundary, to check for changes in looks.")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE with TEXTLEN)
|
||||
(* ;
|
||||
"Force each new line to find its true CHARLIM.")
|
||||
(* ;
|
||||
"Force each new line to find its true CHARLIM.")
|
||||
(freplace (LINEDESCRIPTOR CHAR1) of LINE with CH#1)
|
||||
(freplace (LINEDESCRIPTOR CR\END) of LINE with NIL)
|
||||
(* ; "Assume we won't see a CR.")
|
||||
(* ; "Assume we won't see a CR.")
|
||||
(replace (LINEDESCRIPTOR LHASTABS) of LINE with NIL)
|
||||
(* ; "And has no TABs.")
|
||||
(* ; "And has no TABs.")
|
||||
(replace (LINEDESCRIPTOR LSTLN) of LINE with NIL)
|
||||
(* ;
|
||||
"And assume it isn't the last line in a paragraph until we find otherwise.")
|
||||
(* ;
|
||||
"And assume it isn't the last line in a paragraph until we find otherwise.")
|
||||
(replace (THISLINE TLFIRSTSPACE) of THISLINE with 0)
|
||||
(* ;
|
||||
"Start out assuming that all spaces on the line will be scaled.")
|
||||
(* ;
|
||||
"Start out assuming that all spaces on the line will be scaled.")
|
||||
(COND
|
||||
[(COND
|
||||
((AND (ILEQ CH#1 TEXTLEN)
|
||||
(NOT (ZEROP TEXTLEN))) (* ;
|
||||
"Only continue if there's really text we can format.")
|
||||
(\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place")
|
||||
(* ; "And starting character looks")
|
||||
(NOT (ZEROP TEXTLEN))) (* ;
|
||||
"Only continue if there's really text we can format.")
|
||||
(\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place")
|
||||
(* ; "And starting character looks")
|
||||
(SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM))
|
||||
[COND
|
||||
((fetch (CHARLOOKS CLINVISIBLE) of CLOOKS)
|
||||
(* ;
|
||||
"We've hit a run of invisible characters. Skip them, and insert a marker in the line cache")
|
||||
(add LOOKNO 1) (* ;
|
||||
"Fix the counter of charlooks changes")
|
||||
(* ;
|
||||
"We've hit a run of invisible characters. Skip them, and insert a marker in the line cache")
|
||||
(add LOOKNO 1) (* ;
|
||||
"Fix the counter of charlooks changes")
|
||||
(SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM))
|
||||
(\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN)
|
||||
of PC)))
|
||||
@@ -415,15 +461,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
PC TEXTOBJ]
|
||||
(add CHNO (\EDITELT LOOKS LOOKNO))
|
||||
(COND
|
||||
(PC (* ;
|
||||
"Move us to the right place in the stream")
|
||||
(PC (* ;
|
||||
"Move us to the right place in the stream")
|
||||
(\SETUPGETCH (create EDITMARK
|
||||
PC _ PC
|
||||
PCOFF _ 0
|
||||
PCNO _ NIL)
|
||||
TEXTOBJ))
|
||||
(T (* ;
|
||||
"We've walked off the end of the document. Just note that we're not at any piece now.")
|
||||
(T (* ;
|
||||
"We've walked off the end of the document. Just note that we're not at any piece now.")
|
||||
(replace (TEXTSTREAM PIECE) of TEXTSTREAM with NIL]
|
||||
(ILEQ CHNO TEXTLEN)))
|
||||
(\TEDIT.HCPYLOOKS.UPDATE TEXTSTREAM (fetch (TEXTSTREAM PIECE) of TEXTSTREAM
|
||||
@@ -431,25 +477,25 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
CLOOKS)
|
||||
(SETQ ASCENTB ASCENT)
|
||||
(SETQ DESCENTB DESCENT)
|
||||
(\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache")
|
||||
(\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache")
|
||||
(SETQ FONT (fetch (CHARLOOKS CLFONT) of CLOOKS))
|
||||
[SETQ FONT (COND
|
||||
((AND (type? FONTCLASS FONT)
|
||||
(FONTCLASSCOMPONENT FONT DEVICE)))
|
||||
(T (FONTCOPY FONT 'DEVICE DEVICE](* ;
|
||||
"Keep the font around for char widths.")
|
||||
(T (FONTCOPY FONT 'DEVICE DEVICE](* ;
|
||||
"Keep the font around for char widths.")
|
||||
(SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (\TEDIT.APPLY.PARASTYLES
|
||||
(OR (fetch (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of TEXTSTREAM)
|
||||
(fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)
|
||||
)
|
||||
PC TEXTOBJ)
|
||||
IMAGESTREAM)) (* ; "Paragraph formatting info")
|
||||
IMAGESTREAM)) (* ; "Paragraph formatting info")
|
||||
(COND
|
||||
((AND (NEQ FMTSPEC *TEDIT-CACHED-FMTSPEC*)
|
||||
(fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC))
|
||||
|
||||
(* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.")
|
||||
(* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.")
|
||||
|
||||
(SETQ *TEDIT-CURRENTPARA-CACHE* NIL)
|
||||
(SETQ *TEDIT-CACHED-FMTSPEC* FMTSPEC)))
|
||||
@@ -466,27 +512,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(fetch (STREAM COFFSET) of TEXTSTREAM))
|
||||
(IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM)
|
||||
(fetch (STREAM CPAGE) of TEXTSTREAM]
|
||||
(* ;
|
||||
"Are we on the first line of a paragraph?")
|
||||
(* ;
|
||||
"Are we on the first line of a paragraph?")
|
||||
(replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN)
|
||||
(COND
|
||||
((AND 1STLN (NOT DOINGHEADING?)) (* ;
|
||||
"This is a new paragraph. Check for special paragraph types, and handle them accordingly.")
|
||||
((AND 1STLN (NOT DOINGHEADING?)) (* ;
|
||||
"This is a new paragraph. Check for special paragraph types, and handle them accordingly.")
|
||||
(SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC)
|
||||
(PAGEHEADING (* ; "This paragraph is the content for a page heading. Handle it, then don't bother formatting further.")
|
||||
(PAGEHEADING (* ; "This paragraph is the content for a page heading. Handle it, then don't bother formatting further.")
|
||||
(TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO
|
||||
IMAGESTREAM)
|
||||
|
||||
(* ;; "This will capture the text, and set LINE:CHARLIM to the LAST char# in the page heading. That lets formatting continue apace.")
|
||||
(* ;; "This will capture the text, and set LINE:CHARLIM to the LAST char# in the page heading. That lets formatting continue apace.")
|
||||
|
||||
(RETURN NIL))
|
||||
(EVEN (* ; "This paragraph may or may not belong here. If this is an odd page, we don't want to format this paragraph.")
|
||||
(EVEN (* ; "This paragraph may or may not belong here. If this is an odd page, we don't want to format this paragraph.")
|
||||
(COND
|
||||
((ODDP (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE))
|
||||
(TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO
|
||||
IMAGESTREAM)
|
||||
(RETURN NIL))))
|
||||
(ODD (* ; "This paragraph may or may not belong here. If this is an even page, we don't want to format this paragraph.")
|
||||
(ODD (* ; "This paragraph may or may not belong here. If this is an even page, we don't want to format this paragraph.")
|
||||
(COND
|
||||
((EVENP (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE))
|
||||
(TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO
|
||||
@@ -497,50 +543,50 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
with (COND
|
||||
(1STLN (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC))
|
||||
(T (fetch (FMTSPEC LEFTMAR) of FMTSPEC]
|
||||
(* ; "Set the left margin accordingly")
|
||||
(* ; "Set the left margin accordingly")
|
||||
[replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE
|
||||
with (SETQ WIDTH (COND
|
||||
((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)))
|
||||
(fetch (FMTSPEC RIGHTMAR) of FMTSPEC))
|
||||
(T WIDTH] (* ;
|
||||
"RIGHTMAR = 0 => follow the window's width.")
|
||||
(T WIDTH] (* ;
|
||||
"RIGHTMAR = 0 => follow the window's width.")
|
||||
(SETQ TXB1 WIDTH)
|
||||
(for old TLEN from TLEN to 511 as old CHNO from CHNO
|
||||
while (ILEQ CHNO TEXTLEN) when (SETQ CH (\BIN TEXTSTREAM))
|
||||
do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)")
|
||||
do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)")
|
||||
|
||||
(* ;; "The character loop")
|
||||
(* ;; "The character loop")
|
||||
|
||||
(* ;; "Get the next character for the line.")
|
||||
(* ;; "Get the next character for the line.")
|
||||
|
||||
[SETQ DX (COND
|
||||
((SMALLP CH) (* ; "CH is really a character")
|
||||
((SMALLP CH) (* ; "CH is really a character")
|
||||
(\FGETCHARWIDTH FONT CH))
|
||||
(T (* ; "CH is an object")
|
||||
(T (* ; "CH is an object")
|
||||
(SETQ BOX (\TEDIT.INTEGER.IMAGEBOX (APPLY* (IMAGEOBJPROP
|
||||
CH
|
||||
'IMAGEBOXFN)
|
||||
CH IMAGESTREAM TX WIDTH
|
||||
)))
|
||||
(* ; "Get its size")
|
||||
(* ; "Get its size")
|
||||
[SETQ ASCENT (IMAX ASCENT (IDIFFERENCE (fetch YSIZE of BOX)
|
||||
(fetch YDESC of BOX]
|
||||
(SETQ DESCENT (IMAX DESCENT (fetch YDESC of BOX)))
|
||||
(IMAGEOBJPROP CH 'BOUNDBOX BOX)
|
||||
(fetch XSIZE of BOX]
|
||||
(AND KERN (SETQ DX (IPLUS DX KERN))) (* ; "Get CH's X width.")
|
||||
(AND KERN (SETQ DX (IPLUS DX KERN))) (* ; "Get CH's X width.")
|
||||
[SELCHARQ CH
|
||||
(SPACE (* ;
|
||||
"CH is a <Space>. Remember it, in case we need to break the line.")
|
||||
(SPACE (* ;
|
||||
"CH is a <Space>. Remember it, in case we need to break the line.")
|
||||
(COND
|
||||
(GATHERBLANK (SETQ TXB1 TX)
|
||||
(SETQ GATHERBLANK NIL)))
|
||||
(SETQ CH#B CHNO) (* ;
|
||||
"put the location # of the previous space/tab in the character array instead of the space itself")
|
||||
(SETQ CH#B CHNO) (* ;
|
||||
"put the location # of the previous space/tab in the character array instead of the space itself")
|
||||
(COND
|
||||
(NEWASCENT
|
||||
|
||||
(* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it")
|
||||
(* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it")
|
||||
|
||||
(SETQ ASCENT (IMAX ASCENT NEWASCENT))
|
||||
(SETQ DESCENT (IMAX DESCENT NEWDESCENT))
|
||||
@@ -549,8 +595,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(\RPLPTR WLIST 0 DX)
|
||||
(SETQ PREVSP (ADD1 TLEN))
|
||||
(SETQ PREVHYPH NIL)
|
||||
(SETQ PREVDHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(SETQ PREVDHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(SETQ T1SPACE T)
|
||||
(add TX DX)
|
||||
(SETQ TXB TX)
|
||||
@@ -560,33 +606,33 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ DESCENTB DESCENT)
|
||||
(SETQ INVISIBLERUNSB INVISIBLERUNS)
|
||||
(add %#BLANKS 1))
|
||||
(CR (* ;
|
||||
"Ch is a <Return>. Force an end to the line.")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO)
|
||||
(COND
|
||||
((AND NEWASCENT (ZEROP ASCENT)
|
||||
(ZEROP DESCENT)) (* ;
|
||||
"The ascent has changed; catch it")
|
||||
(SETQ ASCENT NEWASCENT)
|
||||
(SETQ DESCENT NEWDESCENT)))
|
||||
(SETQ FORCEEND T)
|
||||
(\RPLPTR CHLIST 0 (CHARCODE CR))
|
||||
(\RPLPTR WLIST 0 (SETQ DX 0))
|
||||
(COND
|
||||
(GATHERBLANK (SETQ TXB1 TX)
|
||||
(SETQ GATHERBLANK NIL)))
|
||||
(SETQ T1SPACE T)
|
||||
(freplace (LINEDESCRIPTOR CR\END) of LINE with T)
|
||||
(SETQ TX (IPLUS TX DX))
|
||||
(replace (LINEDESCRIPTOR LSTLN) of LINE
|
||||
with (fetch (PIECE PPARALAST) of (fetch PIECE
|
||||
of TEXTSTREAM)))
|
||||
(SETQ PREVDHYPH NIL)
|
||||
(SETQ PREVHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(RETURN))
|
||||
(^L (* ;
|
||||
"Ch is a <Form Feed> Force an end to the line. Immediately--just like a CR.")
|
||||
((CR LF) (* ;
|
||||
"Ch is a <Return>. Force an end to the line.")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO)
|
||||
(COND
|
||||
((AND NEWASCENT (ZEROP ASCENT)
|
||||
(ZEROP DESCENT)) (* ;
|
||||
"The ascent has changed; catch it")
|
||||
(SETQ ASCENT NEWASCENT)
|
||||
(SETQ DESCENT NEWDESCENT)))
|
||||
(SETQ FORCEEND T)
|
||||
(\RPLPTR CHLIST 0 (CHARCODE CR))
|
||||
(\RPLPTR WLIST 0 (SETQ DX 0))
|
||||
(COND
|
||||
(GATHERBLANK (SETQ TXB1 TX)
|
||||
(SETQ GATHERBLANK NIL)))
|
||||
(SETQ T1SPACE T)
|
||||
(freplace (LINEDESCRIPTOR CR\END) of LINE with T)
|
||||
(SETQ TX (IPLUS TX DX))
|
||||
(replace (LINEDESCRIPTOR LSTLN) of LINE
|
||||
with (fetch (PIECE PPARALAST) of (fetch PIECE
|
||||
of TEXTSTREAM)))
|
||||
(SETQ PREVDHYPH NIL)
|
||||
(SETQ PREVHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(RETURN))
|
||||
(^L (* ;
|
||||
"Ch is a <Form Feed> Force an end to the line. Immediately--just like a CR.")
|
||||
(SETQ CTRL\L\SEEN T)
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO)
|
||||
(SETQ FORCEEND T)
|
||||
@@ -600,18 +646,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ TX (IPLUS TX DX))
|
||||
(replace (LINEDESCRIPTOR LSTLN) of LINE with T)
|
||||
(SETQ PREVDHYPH NIL)
|
||||
(SETQ PREVHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(SETQ PREVHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(RETURN))
|
||||
(TAB
|
||||
(* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.")
|
||||
(* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.")
|
||||
|
||||
(\RPLPTR CHLIST 0 CH) (* ; "TABs are 0 wide to start with.")
|
||||
(\RPLPTR CHLIST 0 CH) (* ; "TABs are 0 wide to start with.")
|
||||
(replace (THISLINE TLFIRSTSPACE) of THISLINE with TLEN)
|
||||
(COND
|
||||
(NEWASCENT
|
||||
|
||||
(* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it")
|
||||
(* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it")
|
||||
|
||||
(SETQ ASCENT (IMAX ASCENT NEWASCENT))
|
||||
(SETQ DESCENT (IMAX DESCENT NEWDESCENT))
|
||||
@@ -623,15 +669,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
0 TABPENDING (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM
|
||||
))
|
||||
1)
|
||||
NIL)) (* ;
|
||||
"Figure out which tab stop to use, and what we need to do to get there.")
|
||||
NIL)) (* ;
|
||||
"Figure out which tab stop to use, and what we need to do to get there.")
|
||||
[COND
|
||||
((FIXP TABPENDING) (* ;
|
||||
"If it returns a number, that is the new TX, adjusted for any prior tabs")
|
||||
((FIXP TABPENDING) (* ;
|
||||
"If it returns a number, that is the new TX, adjusted for any prior tabs")
|
||||
(SETQ TX TABPENDING)
|
||||
(SETQ TABPENDING NIL))
|
||||
(TABPENDING (* ;
|
||||
"Otherwise, look in the PENDINGTAB for the new TX")
|
||||
(TABPENDING (* ;
|
||||
"Otherwise, look in the PENDINGTAB for the new TX")
|
||||
(SETQ TX (fetch PTNEWTX of TABPENDING]
|
||||
(COND
|
||||
(GATHERBLANK (SETQ TXB1 TX)
|
||||
@@ -639,18 +685,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ CH#B CHNO)
|
||||
(SETQ DX (\GETBASEPTR WLIST 0))
|
||||
(\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE)
|
||||
PREVSP) (* ;
|
||||
"All the spaces before a tab don't take part in justification from here on.")
|
||||
(SETQ %#BLANKS 0) (* ;
|
||||
"So we can allocate extra space among the right number of blanks to justify things after the tab.")
|
||||
PREVSP) (* ;
|
||||
"All the spaces before a tab don't take part in justification from here on.")
|
||||
(SETQ %#BLANKS 0) (* ;
|
||||
"So we can allocate extra space among the right number of blanks to justify things after the tab.")
|
||||
(SETQ PREVSP 0)
|
||||
(SETQ PREVDHYPH NIL)
|
||||
(SETQ PREVHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(SETQ PREVHYPH NIL) (* ;
|
||||
"We're now past needing any hyphens for line breaking, so forget the last hyphen spot.")
|
||||
(SETQ T1SPACE T)
|
||||
(SETQ TX (IPLUS TX DX))
|
||||
(SETQ TXB TX) (* ;
|
||||
"Remember the world in case this is the 'space' before the line breaks")
|
||||
(SETQ TXB TX) (* ;
|
||||
"Remember the world in case this is the 'space' before the line breaks")
|
||||
(SETQ DXB DX)
|
||||
(SETQ LOOK#B LOOKNO)
|
||||
(SETQ ASCENTB ASCENT)
|
||||
@@ -660,35 +706,35 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
((AND (EQ CH (CHARCODE "0,377"))
|
||||
(NOT (ffetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ)))
|
||||
|
||||
(* ;;
|
||||
"Character-set change character. This suggests undetected NS characters.")
|
||||
(* ;;
|
||||
"Character-set change character. This suggests undetected NS characters.")
|
||||
|
||||
(\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM)
|
||||
(* ;
|
||||
"Leaves us ready to BIN again at the same place.")
|
||||
(* ;
|
||||
"Leaves us ready to BIN again at the same place.")
|
||||
|
||||
(* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.")
|
||||
(* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.")
|
||||
|
||||
(SETQ CHLIST (\ADDBASE CHLIST -2))
|
||||
(SETQ WLIST (\ADDBASE WLIST -2))
|
||||
(add CHNO -1)
|
||||
(add TLEN -1)
|
||||
(SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))
|
||||
(* ;
|
||||
"Because moving to NS characters changes the TEXTLEN for the shorter.")
|
||||
(* ;
|
||||
"Because moving to NS characters changes the TEXTLEN for the shorter.")
|
||||
)
|
||||
(T
|
||||
(* ;; "This character isn't special. Just space over for it.")
|
||||
(* ;; "This character isn't special. Just space over for it.")
|
||||
|
||||
(SETQ GATHERBLANK T)
|
||||
(COND
|
||||
((IGREATERP (SETQ TX (IPLUS TX DX))
|
||||
WIDTH) (* ;
|
||||
"We're past the right margin; stop formatting at the last blank.")
|
||||
WIDTH) (* ;
|
||||
"We're past the right margin; stop formatting at the last blank.")
|
||||
(SETQ FORCEEND T)
|
||||
(COND
|
||||
(PREVDHYPH (* ;
|
||||
"There's a hyphen we can break at. Go back there and break the line.")
|
||||
(PREVDHYPH (* ;
|
||||
"There's a hyphen we can break at. Go back there and break the line.")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE
|
||||
with CH#B)
|
||||
(\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH)
|
||||
@@ -703,8 +749,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ DESCENT DESCENTB)
|
||||
(SETQ LOOKNO LOOK#B)
|
||||
(SETQ INVISIBLERUNS INVISIBLERUNSB))
|
||||
(PREVHYPH (* ;
|
||||
"There's a hyphen we can break at. Go back there and break the line.")
|
||||
(PREVHYPH (* ;
|
||||
"There's a hyphen we can break at. Go back there and break the line.")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE
|
||||
with CH#B)
|
||||
(SETQ TX TXB)
|
||||
@@ -713,8 +759,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ DESCENT DESCENTB)
|
||||
(SETQ LOOKNO LOOK#B)
|
||||
(SETQ INVISIBLERUNS INVISIBLERUNSB))
|
||||
(T1SPACE (* ;
|
||||
"There's a breaking point on this line. Go back there and break the line.")
|
||||
(T1SPACE (* ;
|
||||
"There's a breaking point on this line. Go back there and break the line.")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE
|
||||
with CH#B)
|
||||
(SETQ TX TXB)
|
||||
@@ -727,24 +773,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE
|
||||
with (IMAX CH#1 (SUB1 CHNO)))
|
||||
(SETQ TX (IDIFFERENCE TX DX))
|
||||
(* ;
|
||||
"No spaces on this line; break it before this character.")
|
||||
(* ;
|
||||
"No spaces on this line; break it before this character.")
|
||||
|
||||
(* ;; "Check line break character.")
|
||||
(* ;; "Check line break character.")
|
||||
|
||||
(while (OR (MEMBER (\GETBASEPTR CHLIST -2)
|
||||
TEDIT.DONT.LAST.CHARS)
|
||||
(MEMBER CH TEDIT.DONT.BREAK.CHARS))
|
||||
do
|
||||
|
||||
(* ;;
|
||||
"This character ch doesn't appear at first of lines. or")
|
||||
(* ;;
|
||||
"This character ch doesn't appear at first of lines. or")
|
||||
|
||||
(* ;;
|
||||
"Previous character doesn't appear at the end of lines.")
|
||||
(* ;;
|
||||
"Previous character doesn't appear at the end of lines.")
|
||||
|
||||
(* ;;
|
||||
"So,move previous character to next line.")
|
||||
(* ;;
|
||||
"So,move previous character to next line.")
|
||||
|
||||
(SETQ CHLIST (\ADDBASE CHLIST -2))
|
||||
(SETQ WLIST (\ADDBASE WLIST -2))
|
||||
@@ -754,24 +800,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE
|
||||
with (IMAX (SUB1 CHNO)
|
||||
CH#1)))
|
||||
(T (* ;
|
||||
"Can't split BEFORE the first thing on the line!")
|
||||
(T (* ;
|
||||
"Can't split BEFORE the first thing on the line!")
|
||||
(freplace (LINEDESCRIPTOR CHARLIM) of LINE
|
||||
with CHNO)
|
||||
(\RPLPTR CHLIST 0 CH)
|
||||
(\RPLPTR WLIST 0 DX)))
|
||||
(RETURN))
|
||||
(T (* ; "Not past the rightmargin yet...")
|
||||
(T (* ; "Not past the rightmargin yet...")
|
||||
(COND
|
||||
((AND NEWASCENT (SMALLP CH))
|
||||
|
||||
(* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it")
|
||||
(* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it")
|
||||
|
||||
(SETQ ASCENT (IMAX ASCENT NEWASCENT))
|
||||
(SETQ DESCENT (IMAX DESCENT NEWDESCENT))
|
||||
(SETQ NEWASCENT NIL)))
|
||||
(\RPLPTR CHLIST 0 CH)
|
||||
(\RPLPTR WLIST 0 DX)(* ; "Check for decimal tabs")
|
||||
(\RPLPTR WLIST 0 DX)(* ; "Check for decimal tabs")
|
||||
(SELCHARQ CH
|
||||
(%. (COND
|
||||
((AND TABPENDING (NOT (FIXP TABPENDING))
|
||||
@@ -780,8 +826,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(add (fetch (PENDINGTAB PTTABX)
|
||||
of TABPENDING)
|
||||
DX)
|
||||
(* ;
|
||||
"Adjust the pending tab so that the LEFT side of the decimal point goes at the tab stop.")
|
||||
(* ;
|
||||
"Adjust the pending tab so that the LEFT side of the decimal point goes at the tab stop.")
|
||||
(SETQ TABPENDING
|
||||
(\TEDIT.FORMATTABS TEXTOBJ (fetch
|
||||
(FMTSPEC TABSPEC)
|
||||
@@ -794,43 +840,43 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(LRSH (FIXR (DSPSCALE NIL IMAGESTREAM))
|
||||
1)
|
||||
T))
|
||||
(* ;
|
||||
"Figure out which tab stop to use, and what we need to do to get there.")
|
||||
(* ;
|
||||
"Figure out which tab stop to use, and what we need to do to get there.")
|
||||
[COND
|
||||
((FIXP TABPENDING)
|
||||
(* ;
|
||||
"If it returns a number, that is the new TX, adjusted for any prior tabs")
|
||||
(* ;
|
||||
"If it returns a number, that is the new TX, adjusted for any prior tabs")
|
||||
(SETQ TX TABPENDING)
|
||||
(SETQ TABPENDING NIL))
|
||||
(TABPENDING
|
||||
(* ;
|
||||
"Otherwise, look in the PENDINGTAB for the new TX")
|
||||
(* ;
|
||||
"Otherwise, look in the PENDINGTAB for the new TX")
|
||||
(SETQ TX (fetch PTNEWTX
|
||||
of TABPENDING]
|
||||
(COND
|
||||
(GATHERBLANK (SETQ TXB1 TX)
|
||||
(SETQ GATHERBLANK NIL)))
|
||||
(SETQ CH#B CHNO)
|
||||
(* ; "SETQ DX (\GETBASE WLIST 0)")
|
||||
(* ; "SETQ DX (\GETBASE WLIST 0)")
|
||||
(\TEDIT.PURGE.SPACES (fetch CHARS
|
||||
of THISLINE)
|
||||
PREVSP)
|
||||
(* ;
|
||||
"All the spaces before a tab don't take part in justification from here on.")
|
||||
(* ;
|
||||
"All the spaces before a tab don't take part in justification from here on.")
|
||||
(SETQ %#BLANKS 0)
|
||||
(* ;
|
||||
"So we can allocate extra space among the right number of blanks to justify things after the tab.")
|
||||
(* ;
|
||||
"So we can allocate extra space among the right number of blanks to justify things after the tab.")
|
||||
(SETQ PREVSP 0)
|
||||
(SETQ T1SPACE T)
|
||||
(SETQ TXB TX)
|
||||
(* ;
|
||||
"Remember the world in case this is the 'space' before the line breaks")
|
||||
(* ;
|
||||
"Remember the world in case this is the 'space' before the line breaks")
|
||||
(SETQ DXB DX)
|
||||
(SETQ LOOK#B LOOKNO)
|
||||
(SETQ ASCENTB ASCENT)
|
||||
(SETQ DESCENTB DESCENT)
|
||||
(SETQ INVISIBLERUNSB INVISIBLERUNS))))
|
||||
((- "357,045") (* ; "Hyphen, M-dash")
|
||||
((- "357,045") (* ; "Hyphen, M-dash")
|
||||
(SETQ PREVHYPH (ADD1 TLEN))
|
||||
(SETQ PREVDHYPH NIL)
|
||||
(SETQ TXB1 (SETQ TXB TX))
|
||||
@@ -840,10 +886,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ ASCENTB ASCENT)
|
||||
(SETQ DESCENTB DESCENT)
|
||||
(SETQ INVISIBLERUNSB INVISIBLERUNS))
|
||||
("357,042" (* ; "non-breaking hyphen")
|
||||
("357,042" (* ; "non-breaking hyphen")
|
||||
(\RPLPTR CHLIST 0 (CHARCODE "-")))
|
||||
("357,043" (* ; "Discretionary hyphen")
|
||||
(* ; "And isn't actually displayed.")
|
||||
("357,043" (* ; "Discretionary hyphen")
|
||||
(* ; "And isn't actually displayed.")
|
||||
(SETQ PREVDHYPH (ADD1 TLEN))
|
||||
(SETQ PREVHYPH NIL)
|
||||
(SETQ LOOK#B LOOKNO)
|
||||
@@ -851,8 +897,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ ASCENTB ASCENT)
|
||||
(SETQ DESCENTB DESCENT)
|
||||
(\RPLPTR WLIST 0 0)
|
||||
(* ;
|
||||
"Unless we use it, the prevhyph is 0 wide.")
|
||||
(* ;
|
||||
"Unless we use it, the prevhyph is 0 wide.")
|
||||
(\RPLPTR CHLIST 0 NIL)
|
||||
(SETQ TX (IDIFFERENCE TX DX))
|
||||
(SETQ DX (\FGETCHARWIDTH FONT (CHARCODE
|
||||
@@ -860,31 +906,31 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(SETQ TXB1 (SETQ TXB (IPLUS TX DX)))
|
||||
(SETQ DXB DX)
|
||||
(SETQ INVISIBLERUNSB INVISIBLERUNS))
|
||||
("357,041" (* ; "non-breaking space.")
|
||||
("357,041" (* ; "non-breaking space.")
|
||||
(\RPLPTR CHLIST 0 (CHARCODE SPACE)))
|
||||
(COND
|
||||
((AND (SMALLP CH)
|
||||
(IGEQ CH 192)
|
||||
(ILEQ CH 207))
|
||||
(* ; "This is an NS accent character. Space it 0.0 -- SO back TX down by the width of the accent, so it doesn't add to the line width.")
|
||||
(* ; "This is an NS accent character. Space it 0.0 -- SO back TX down by the width of the accent, so it doesn't add to the line width.")
|
||||
(SETQ TX (- TX DX]
|
||||
(SETQ CHLIST (\ADDBASE CHLIST 2)) (* ;
|
||||
"Move the pointers forward for the next character.")
|
||||
(SETQ CHLIST (\ADDBASE CHLIST 2)) (* ;
|
||||
"Move the pointers forward for the next character.")
|
||||
(SETQ WLIST (\ADDBASE WLIST 2)))
|
||||
|
||||
(* ;;; "Done processing characters; the line is now filled.")
|
||||
(* ;;; "Done processing characters; the line is now filled.")
|
||||
|
||||
(COND
|
||||
((AND (IEQP TLEN 255)
|
||||
(ILESSP CHNO TEXTLEN)) (* ;
|
||||
"This line is too long for us to format??")
|
||||
(ILESSP CHNO TEXTLEN)) (* ;
|
||||
"This line is too long for us to format??")
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T)))
|
||||
(COND
|
||||
(TABPENDING (* ;
|
||||
"There is a TAB outstanding. Go handle it.")
|
||||
(TABPENDING (* ;
|
||||
"There is a TAB outstanding. Go handle it.")
|
||||
(add (fetch (PENDINGTAB PTTABX) of TABPENDING)
|
||||
DX) (* ;
|
||||
"Modify the pending tab so that the LEFT side of the CR is at the tab stop.")
|
||||
DX) (* ;
|
||||
"Modify the pending tab so that the LEFT side of the CR is at the tab stop.")
|
||||
(SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch (FMTSPEC TABSPEC)
|
||||
of FMTSPEC)
|
||||
THISLINE CHLIST WLIST TX
|
||||
@@ -897,8 +943,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE)
|
||||
PREVSP)
|
||||
(SETQ PREVSP 0]
|
||||
(T (* ;
|
||||
"No text to go in this line; set Ascent/Descent to the default font from the window.")
|
||||
(T (* ;
|
||||
"No text to go in this line; set Ascent/Descent to the default font from the window.")
|
||||
(SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)))
|
||||
(\EDITSETA LOOKS 0 CLOOKS)
|
||||
[SETQ 1STLN (AND (fetch (STREAM F5) of TEXTSTREAM)
|
||||
@@ -938,8 +984,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
of TEXTOBJ))
|
||||
)
|
||||
DEFAULTFONT)
|
||||
'HEIGHT] (* ;
|
||||
"Line's height (or 12 for an empty line)")
|
||||
'HEIGHT] (* ;
|
||||
"Line's height (or 12 for an empty line)")
|
||||
(replace (LINEDESCRIPTOR ASCENT) of LINE with ASCENT)
|
||||
(replace (LINEDESCRIPTOR DESCENT) of LINE with DESCENT)
|
||||
(freplace (LINEDESCRIPTOR CHARTOP) of LINE with CHNO)
|
||||
@@ -947,8 +993,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(FORCEEND NIL)
|
||||
(T (SETQ CHNO (SUB1 CHNO))
|
||||
(SETQ TLEN (SUB1 TLEN))
|
||||
(SETQ TXB1 TX))) (* ;
|
||||
"If we ran off the end of the text, then keep true space left on the line.")
|
||||
(SETQ TXB1 TX))) (* ;
|
||||
"If we ran off the end of the text, then keep true space left on the line.")
|
||||
(freplace (LINEDESCRIPTOR LXLIM) of LINE with TX)
|
||||
(freplace DESC of THISLINE with LINE)
|
||||
[freplace (THISLINE LEN) of THISLINE
|
||||
@@ -1516,17 +1562,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
PFILE)])
|
||||
)
|
||||
|
||||
(LISTPUT (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE INTERPRESS) PRINTFILETYPES)) (QUOTE TEDIT) (FUNCTION \TEDIT.HARDCOPY))
|
||||
(LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
|
||||
'TEDIT
|
||||
(FUNCTION \TEDIT.HARDCOPY))
|
||||
|
||||
(LET ((PRESSVALUES (ASSOC (QUOTE CONVERSION) (ASSOC (QUOTE PRESS) PRINTFILETYPES)))) (COND (PRESSVALUES (* ; "Only install PRESS printing if PRESS is loaded.") (LISTPUT PRESSVALUES (QUOTE TEDIT) (FUNCTION \TEDIT.PRESS.HARDCOPY)))))
|
||||
[LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
|
||||
(COND
|
||||
(PRESSVALUES (* ;
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
|
||||
|
||||
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
|
||||
|
||||
(RPAQQ TEDIT.DONT.BREAK.CHARS (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255 9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539 9571 9573 9575 9582)
|
||||
)
|
||||
(RPAQQ TEDIT.DONT.BREAK.CHARS (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255
|
||||
9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539
|
||||
9571 9573 9575 9582))
|
||||
|
||||
(RPAQQ TEDIT.DONT.LAST.CHARS (8524 8538 8536 8534))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -1557,13 +1610,13 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(CLOSEF DOC])
|
||||
)
|
||||
(PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994))
|
||||
1991 1992 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2353 99050 (TEDIT.HARDCOPY 2363 . 3614) (TEDIT.HCPYFILE 3616 . 5690) (
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE 5692 . 19837) (\TEDIT.HARDCOPY.FORMATLINE 19839 . 67140) (
|
||||
\DOFORMATTING.HARDCOPY 67142 . 80435) (\TEDIT.HARDCOPY.MODIFYLOOKS 80437 . 82844) (
|
||||
\TEDIT.HCPYLOOKS.UPDATE 82846 . 93454) (\TEDIT.HCPYFMTSPEC 93456 . 98476) (\TEDIT.INTEGER.IMAGEBOX
|
||||
98478 . 99048)) (99139 100223 (\TEDIT.SCALE 99149 . 99443) (\TEDIT.SCALEREGION 99445 . 100221)) (
|
||||
100466 102963 (TEDIT.HARDCOPYFN 100476 . 101327) (\TEDIT.HARDCOPY 101329 . 102238) (
|
||||
\TEDIT.PRESS.HARDCOPY 102240 . 102961)) (103772 104675 (TEDIT-BOOK 103782 . 104673)))))
|
||||
(FILEMAP (NIL (3088 99806 (TEDIT.HARDCOPY 3098 . 4349) (TEDIT.HCPYFILE 4351 . 6425) (
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE 6427 . 20572) (\TEDIT.HARDCOPY.FORMATLINE 20574 . 67896) (
|
||||
\DOFORMATTING.HARDCOPY 67898 . 81191) (\TEDIT.HARDCOPY.MODIFYLOOKS 81193 . 83600) (
|
||||
\TEDIT.HCPYLOOKS.UPDATE 83602 . 94210) (\TEDIT.HCPYFMTSPEC 94212 . 99232) (\TEDIT.INTEGER.IMAGEBOX
|
||||
99234 . 99804)) (99895 100979 (\TEDIT.SCALE 99905 . 100199) (\TEDIT.SCALEREGION 100201 . 100977)) (
|
||||
101222 103719 (TEDIT.HARDCOPYFN 101232 . 102083) (\TEDIT.HARDCOPY 102085 . 102994) (
|
||||
\TEDIT.PRESS.HARDCOPY 102996 . 103717)) (104701 105604 (TEDIT-BOOK 104711 . 105602)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "11-Feb-2001 12:06:42" {DSK}<project>medley3.5>library>TEXTOFD.;8 176221
|
||||
(FILECREATED " 6-May-2021 10:18:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;4 176139
|
||||
|
||||
changes to%: (FNS \TEXTRIGHTMARGIN)
|
||||
changes to%: (FNS \TEXTINIT)
|
||||
|
||||
previous date%: " 4-Jan-2001 18:14:27" {DSK}<project>medley3.5>library>TEXTOFD.;7)
|
||||
previous date%: "11-Feb-2001 12:06:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994, 1995, 1999, 2000, 2001 by John Sybalsky & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEXTOFDCOMS)
|
||||
@@ -674,29 +676,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
|
||||
(RETURN PC])
|
||||
|
||||
(\TEXTINIT
|
||||
[LAMBDA NIL (* ; "Edited 31-May-91 14:18 by jds")
|
||||
(* ;
|
||||
"Create the FDEV and STREAM prototypes for TEXT streams.")
|
||||
[LAMBDA NIL (* ; "Edited 6-May-2021 10:17 by rmk:")
|
||||
(* ;
|
||||
"Create the FDEV and STREAM prototypes for TEXT streams.")
|
||||
|
||||
(* ;; "TEXT streams make use of the following STREAM fields:")
|
||||
(* ;; "TEXT streams make use of the following STREAM fields:")
|
||||
|
||||
(* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")
|
||||
(* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")
|
||||
|
||||
(* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")
|
||||
(* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")
|
||||
|
||||
(* ;; "F2 (* # chars left in piece at end of underlying file's page)")
|
||||
(* ;; "F2 (* # chars left in piece at end of underlying file's page)")
|
||||
|
||||
(* ;; "F3 (* The TEXTOBJ for this stream)")
|
||||
(* ;; "F3 (* The TEXTOBJ for this stream)")
|
||||
|
||||
(* ;; "F4")
|
||||
(* ;; "F4")
|
||||
|
||||
(* ;; "F5 (* The PIECE we're currently inside)")
|
||||
(* ;; "F5 (* The PIECE we're currently inside)")
|
||||
|
||||
(* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")
|
||||
(* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")
|
||||
|
||||
(* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")
|
||||
(* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")
|
||||
|
||||
(* ;; "(FW8 WORD)")
|
||||
(* ;; "(FW8 WORD)")
|
||||
|
||||
(SETQ \TEXTIMAGEOPS (create IMAGEOPS
|
||||
IMAGETYPE _ 'TEXT
|
||||
@@ -742,8 +744,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
|
||||
FDBOUTABLE _ NIL
|
||||
FDEXTENDABLE _ NIL
|
||||
TRUNCATEFILE _ (FUNCTION NILL)
|
||||
WRITEPAGES _ (FUNCTION NILL)
|
||||
READCHARCODE _ (FUNCTION BIN)))
|
||||
WRITEPAGES _ (FUNCTION NILL)))
|
||||
(SETQ \TEXTOFD
|
||||
(create STREAM
|
||||
BINABLE _ T
|
||||
@@ -761,9 +762,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
|
||||
MAXBUFFERS _ 10
|
||||
IMAGEOPS _ \TEXTIMAGEOPS
|
||||
IMAGEDATA _ (create TEXTIMAGEDATA)
|
||||
OUTCHARFN _ (FUNCTION \TEDITOUTCHARFN))) (* ; "The prototypical Text stream")
|
||||
OUTCHARFN _ (FUNCTION \TEDITOUTCHARFN))) (* ; "The prototypical Text stream")
|
||||
|
||||
(* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")
|
||||
(* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")
|
||||
|
||||
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
|
||||
(FUNCTION (LAMBDA (CONDITION)
|
||||
@@ -771,8 +772,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
|
||||
(COND
|
||||
[(AND (BOUNDP 'ERRORPOS)
|
||||
(TEXTSTREAMP STREAM))
|
||||
(* ;
|
||||
"This happened in the error handler, and it happened to a TEdit stream, so try the fix:")
|
||||
(* ;
|
||||
"This happened in the error handler, and it happened to a TEdit stream, so try the fix:")
|
||||
(LET ((XCL::RESULT (REOPENTEXTSTREAM STREAM)))
|
||||
(CL:WHEN XCL::RESULT
|
||||
(ENVAPPLY (STKNAME ERRORPOS)
|
||||
@@ -780,8 +781,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
|
||||
(STKNTH -1 ERRORPOS ERRORPOS)
|
||||
ERRORPOS T T))]
|
||||
(*TEDIT-OLD-STREAM-ERROR-HANDLER*
|
||||
(* ;
|
||||
"Some other kind of stream, so punt to the old handler (if there is one):")
|
||||
(* ;
|
||||
"Some other kind of stream, so punt to the old handler (if there is one):")
|
||||
(APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
|
||||
|
||||
(\TEXTMARK
|
||||
@@ -2654,27 +2655,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994,
|
||||
(ADDTOVAR LAMA TEXTPROP)
|
||||
)
|
||||
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989
|
||||
1990 1991 1993 1994 1995 1999 2000 2001))
|
||||
1990 1991 1993 1994 1995 1999 2000 2001 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3014 53058 (COPYTEXTSTREAM 3024 . 6146) (OPENTEXTSTREAM 6148 . 21025) (REOPENTEXTSTREAM
|
||||
21027 . 21449) (TEDIT.STREAMCHANGEDP 21451 . 21749) (TEXTSTREAMP 21751 . 22065) (TXTFILE 22067 .
|
||||
22512) (\DELETECH 22514 . 33770) (\SETUPGETCH 33772 . 41051) (\TEDIT.REOPEN.STREAM 41053 . 42903) (
|
||||
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42905 . 45343) (\TEXTINIT 45345 . 50951) (\TEXTMARK 50953 . 51701) (
|
||||
\TEXTTTYBOUT 51703 . 53056)) (53059 78491 (\INSERTCH 53069 . 76795) (\INSERTCR 76797 . 78489)) (78557
|
||||
98873 (\CHTOPC 78567 . 79756) (\CHTOPCNO 79758 . 81020) (\CLEARPCTB 81022 . 81818) (
|
||||
\CREATEPIECEORSTREAM 81820 . 84794) (\DELETEPIECE 84796 . 85709) (\FINDPIECE 85711 . 86077) (
|
||||
\INSERTPIECE 86079 . 89089) (\MAKEPCTB 89091 . 91006) (\SPLITPIECE 91008 . 97967) (\INSERT.FIRST.PIECE
|
||||
97969 . 98871)) (98925 123143 (\TEXTCLOSEF 98935 . 100162) (\TEXTCLOSEF-SUBTREE 100164 . 100870) (
|
||||
\TEXTDSPFONT 100872 . 101864) (\TEXTEOFP 101866 . 103225) (\TEXTGETEOFPTR 103227 . 103437) (
|
||||
\TEXTGETFILEPTR 103439 . 105502) (\TEXTOPENF 105504 . 106334) (\TEXTOPENF-SUBTREE 106336 . 107137) (
|
||||
\TEXTOUTCHARFN 107139 . 107487) (\TEXTBACKFILEPTR 107489 . 113390) (\TEXTBOUT 113392 . 116740) (
|
||||
\TEDITOUTCHARFN 116742 . 117988) (\TEXTSETEOF 117990 . 118499) (\TEXTSETFILEPTR 118501 . 119726) (
|
||||
\TEXTDSPXPOSITION 119728 . 120585) (\TEXTDSPYPOSITION 120587 . 121132) (\TEXTLEFTMARGIN 121134 .
|
||||
121617) (\TEXTRIGHTMARGIN 121619 . 122555) (\TEXTDSPCHARWIDTH 122557 . 122795) (\TEXTDSPSTRINGWIDTH
|
||||
122797 . 123037) (\TEXTDSPLINEFEED 123039 . 123141)) (123144 156888 (\TEXTBIN 123154 . 139940) (
|
||||
\TEDIT.TEXTBIN.STRINGSETUP 139942 . 145655) (\TEDIT.TEXTBIN.FILESETUP 145657 . 152043) (
|
||||
\TEDIT.TEXTBIN.NEW.PAGE 152045 . 156886)) (156889 170297 (\TEXTPEEKBIN 156899 . 166038) (
|
||||
\TEDIT.PEEKBIN.NEW.PAGE 166040 . 170295)) (170335 175553 (CGETTEXTPROP 170345 . 170821) (CTEXTPROP
|
||||
170823 . 173167) (GETTEXTPROP 173169 . 173764) (PUTTEXTPROP 173766 . 175091) (TEXTPROP 175093 . 175551
|
||||
(FILEMAP (NIL (2982 52971 (COPYTEXTSTREAM 2992 . 6114) (OPENTEXTSTREAM 6116 . 20993) (REOPENTEXTSTREAM
|
||||
20995 . 21417) (TEDIT.STREAMCHANGEDP 21419 . 21717) (TEXTSTREAMP 21719 . 22033) (TXTFILE 22035 .
|
||||
22480) (\DELETECH 22482 . 33738) (\SETUPGETCH 33740 . 41019) (\TEDIT.REOPEN.STREAM 41021 . 42871) (
|
||||
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42873 . 45311) (\TEXTINIT 45313 . 50864) (\TEXTMARK 50866 . 51614) (
|
||||
\TEXTTTYBOUT 51616 . 52969)) (52972 78404 (\INSERTCH 52982 . 76708) (\INSERTCR 76710 . 78402)) (78470
|
||||
98786 (\CHTOPC 78480 . 79669) (\CHTOPCNO 79671 . 80933) (\CLEARPCTB 80935 . 81731) (
|
||||
\CREATEPIECEORSTREAM 81733 . 84707) (\DELETEPIECE 84709 . 85622) (\FINDPIECE 85624 . 85990) (
|
||||
\INSERTPIECE 85992 . 89002) (\MAKEPCTB 89004 . 90919) (\SPLITPIECE 90921 . 97880) (\INSERT.FIRST.PIECE
|
||||
97882 . 98784)) (98838 123056 (\TEXTCLOSEF 98848 . 100075) (\TEXTCLOSEF-SUBTREE 100077 . 100783) (
|
||||
\TEXTDSPFONT 100785 . 101777) (\TEXTEOFP 101779 . 103138) (\TEXTGETEOFPTR 103140 . 103350) (
|
||||
\TEXTGETFILEPTR 103352 . 105415) (\TEXTOPENF 105417 . 106247) (\TEXTOPENF-SUBTREE 106249 . 107050) (
|
||||
\TEXTOUTCHARFN 107052 . 107400) (\TEXTBACKFILEPTR 107402 . 113303) (\TEXTBOUT 113305 . 116653) (
|
||||
\TEDITOUTCHARFN 116655 . 117901) (\TEXTSETEOF 117903 . 118412) (\TEXTSETFILEPTR 118414 . 119639) (
|
||||
\TEXTDSPXPOSITION 119641 . 120498) (\TEXTDSPYPOSITION 120500 . 121045) (\TEXTLEFTMARGIN 121047 .
|
||||
121530) (\TEXTRIGHTMARGIN 121532 . 122468) (\TEXTDSPCHARWIDTH 122470 . 122708) (\TEXTDSPSTRINGWIDTH
|
||||
122710 . 122950) (\TEXTDSPLINEFEED 122952 . 123054)) (123057 156801 (\TEXTBIN 123067 . 139853) (
|
||||
\TEDIT.TEXTBIN.STRINGSETUP 139855 . 145568) (\TEDIT.TEXTBIN.FILESETUP 145570 . 151956) (
|
||||
\TEDIT.TEXTBIN.NEW.PAGE 151958 . 156799)) (156802 170210 (\TEXTPEEKBIN 156812 . 165951) (
|
||||
\TEDIT.PEEKBIN.NEW.PAGE 165953 . 170208)) (170248 175466 (CGETTEXTPROP 170258 . 170734) (CTEXTPROP
|
||||
170736 . 173080) (GETTEXTPROP 173082 . 173677) (PUTTEXTPROP 173679 . 175004) (TEXTPROP 175006 . 175464
|
||||
)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
109
library/TFBRAVO
109
library/TFBRAVO
@@ -1,14 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Apr-2018 12:19:55" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TFBRAVO.;2 74262
|
||||
(FILECREATED "13-Jun-2021 09:46:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TFBRAVO.;3 74596
|
||||
|
||||
changes to%: (VARS TFBRAVOCOMS)
|
||||
changes to%: (FNS \TFBRAVO.WRITE.RUN \TFBRAVO.WRITE.RUNS \TFBRAVO.PARSE.PARA)
|
||||
|
||||
previous date%: "31-May-91 15:27:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TFBRAVO.;1)
|
||||
previous date%: "19-Apr-2018 12:19:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TFBRAVO.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1990, 1991, 2018 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TFBRAVOCOMS)
|
||||
@@ -427,24 +428,24 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990, 1991, 2018 by Venue & Xerox Corporat
|
||||
(CADR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST)))))
|
||||
|
||||
(\TFBRAVO.WRITE.RUN
|
||||
[LAMBDA (RUN IN PARALOOKS TEXTOBJ) (* ; "Edited 31-May-91 15:25 by jds")
|
||||
(PROG (START END NAMEDTABNUMBER (LOOKS (fetch RUNLOOKS of RUN)))
|
||||
(SETQ NAMEDTABNUMBER (fetch (CHARLOOKS CLUSERINFO) of (fetch RUNLOOKS
|
||||
[LAMBDA (RUN IN PARALOOKS TEXTOBJ) (* ; "Edited 13-Jun-2021 09:44 by rmk:")
|
||||
(PROG (START END NAMEDTABNUMBER (LOOKS (fetch (RUN RUNLOOKS) of RUN)))
|
||||
(SETQ NAMEDTABNUMBER (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS)
|
||||
of RUN)))
|
||||
(COND
|
||||
((ILEQ (fetch RUNLENGTH of RUN)
|
||||
((ILEQ (fetch (RUN RUNLENGTH) of RUN)
|
||||
0)
|
||||
(RETURN))
|
||||
([AND NAMEDTABNUMBER (EQUAL (PEEKC)
|
||||
(CHARACTER (CHARCODE ^I]
|
||||
|
||||
(* only treat the run like a tab if it has charcode 9, even if it has a tab
|
||||
number. Color is overloaded onto tab numbers in BRAVO.
|
||||
Jerks! Jerks!)
|
||||
(* only treat the run like a tab if it has charcode 9, even if it has a tab
|
||||
number. Color is overloaded onto tab numbers in BRAVO.
|
||||
Jerks! Jerks!)
|
||||
|
||||
(\TFBRAVO.ADD.NAMEDTAB TEXTOBJ NAMEDTABNUMBER PARALOOKS))
|
||||
(T (SETQ END (IPLUS (SETQ START (GETFILEPTR IN))
|
||||
(fetch RUNLENGTH of RUN)))
|
||||
(fetch (RUN RUNLENGTH) of RUN)))
|
||||
(TEDIT.RAW.INCLUDE TEXTOBJ IN START END)
|
||||
(TEDIT.LOOKS TEXTOBJ LOOKS])
|
||||
|
||||
@@ -792,15 +793,17 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990, 1991, 2018 by Venue & Xerox Corporat
|
||||
LENGTH TEXTOBJ MARGIN.CANDIDATE])
|
||||
|
||||
(\TFBRAVO.WRITE.RUNS
|
||||
(LAMBDA (PARA INFILE TEXTOBJ) (* gbn "18-Sep-84 16:29")
|
||||
[LAMBDA (PARA INFILE TEXTOBJ) (* ; "Edited 13-Jun-2021 09:45 by rmk:")
|
||||
(DECLARE (USEDFREE UNDERLINE SUPERSCRIPT))
|
||||
(PROG ((RUNS (fetch RUNS of PARA))
|
||||
(PARALOOKS (fetch PARALOOKS of PARA))
|
||||
(PROG ((RUNS (fetch (PARA RUNS) of PARA))
|
||||
(PARALOOKS (fetch (PARA PARALOOKS) of PARA))
|
||||
(LENGTH 0))
|
||||
(for RUN in old RUNS do (\TFBRAVO.WRITE.RUN RUN INFILE PARALOOKS TEXTOBJ)
|
||||
(SETQ LENGTH (IPLUS (fetch RUNLENGTH of RUN)
|
||||
LENGTH)))
|
||||
(RETURN LENGTH))))
|
||||
(for RUN in old RUNS do (\TFBRAVO.WRITE.RUN RUN INFILE PARALOOKS
|
||||
TEXTOBJ)
|
||||
(SETQ LENGTH (IPLUS (fetch (RUN RUNLENGTH)
|
||||
of RUN)
|
||||
LENGTH)))
|
||||
(RETURN LENGTH])
|
||||
|
||||
(\TFBRAVO.SPREAD.LOOKS
|
||||
(LAMBDA (RUN LOOKS) (* jds "22-Aug-84 14:53")
|
||||
@@ -841,40 +844,42 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990, 1991, 2018 by Venue & Xerox Corporat
|
||||
LOOKS))
|
||||
|
||||
(\TFBRAVO.PARSE.PARA
|
||||
(LAMBDA (OLDPLOOKS FILE) (* gbn "31-May-85 22:08")
|
||||
|
||||
(* PLOOKS are the paragraph looks, and RUNi are the character runs in the form
|
||||
returned by READCHARACTERLOOKS, except that the character count for the last
|
||||
run has been filled in correctly. Leaves the input file pointer at the end of
|
||||
the trailer, after the EOL.)
|
||||
[LAMBDA (OLDPLOOKS FILE) (* ; "Edited 13-Jun-2021 09:46 by rmk:")
|
||||
|
||||
(* PLOOKS are the paragraph looks, and RUNi are the character runs in the form
|
||||
returned by READCHARACTERLOOKS, except that the character count for the last
|
||||
run has been filled in correctly. Leaves the input file pointer at the end of
|
||||
the trailer, after the EOL.)
|
||||
|
||||
(PROG (LEN PLOOKS RUNS ORIGPTR)
|
||||
(SETQ ORIGPTR (GETFILEPTR FILE))
|
||||
(SETQ LEN (FILEPOS (CHARACTER (CHARCODE ^Z))
|
||||
FILE))
|
||||
(COND
|
||||
[COND
|
||||
((NOT LEN)
|
||||
(RETURN (create PARA
|
||||
PARALOOKS _ DefaultParagraphLooks
|
||||
RUNS _ NIL))))
|
||||
RUNS _ NIL]
|
||||
(SETQ LEN (IDIFFERENCE LEN ORIGPTR))
|
||||
(BIN FILE) (* BIN past the ^z)
|
||||
(BIN FILE) (* BIN past the ^z)
|
||||
(SETQ PLOOKS (\TFBRAVO.READ.PARALOOKS OLDPLOOKS FILE))
|
||||
(COND
|
||||
((NEQ (CAR (PROG1 PLOOKS (SETQ PLOOKS (CDR PLOOKS))))
|
||||
[COND
|
||||
((NEQ [CAR (PROG1 PLOOKS
|
||||
(SETQ PLOOKS (CDR PLOOKS)))]
|
||||
'\)
|
||||
(RETURN (create PARA
|
||||
PARALOOKS _ PLOOKS
|
||||
RUNS _ (LIST (create RUN
|
||||
RUNLENGTH _ LEN
|
||||
RUNLOOKS _ (\TFBRAVO.FONT.FROM.CHARLOOKS
|
||||
USER.CM.CHARLOOKS)))))))
|
||||
CLP (while (fetch RUNLENGTH of (CAR (push RUNS (\TFBRAVO.READ.CHARLOOKS FILE))))
|
||||
do (SETQ LEN (IDIFFERENCE LEN (fetch RUNLENGTH of (CAR RUNS)))))
|
||||
(replace RUNLENGTH of (CAR RUNS) with LEN)
|
||||
USER.CM.CHARLOOKS]
|
||||
CLP [while [fetch (RUN RUNLENGTH) of (CAR (push RUNS (\TFBRAVO.READ.CHARLOOKS
|
||||
FILE]
|
||||
do (SETQ LEN (IDIFFERENCE LEN (fetch (RUN RUNLENGTH) of (CAR RUNS]
|
||||
(replace (RUN RUNLENGTH) of (CAR RUNS) with LEN)
|
||||
(RETURN (create PARA
|
||||
PARALOOKS _ PLOOKS
|
||||
RUNS _ (DREVERSE RUNS))))))
|
||||
RUNS _ (DREVERSE RUNS])
|
||||
|
||||
(\TFBRAVO.INIT.PARALOOKS
|
||||
[LAMBDA (USER.CM.LOOKS) (* ; "Edited 31-May-91 15:26 by jds")
|
||||
@@ -1320,21 +1325,21 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990, 1991, 2018 by Venue & Xerox Corporat
|
||||
|
||||
(\NAMEDTAB.INIT)
|
||||
)
|
||||
(PUTPROPS TFBRAVO COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990 1991 2018))
|
||||
(PUTPROPS TFBRAVO COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990 1991 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4236 34112 (\TFBRAVO.FIND.LAST.TRAILER 4246 . 5739) (\TFBRAVO.HANDLE.HEADING 5741 .
|
||||
7619) (\TFBRAVO.INIT.CHARLOOKS 7621 . 8437) (\TFBRAVO.INIT.PAGEFORMAT 8439 . 8917) (
|
||||
\TFBRAVO.INSTALL.PAGEFORMAT 8919 . 13556) (\TFBRAVO.PARSE.PROFILE.PARA 13558 . 22071) (
|
||||
\TFBRAVO.PARSE.PROFILE.VALUE 22073 . 22840) (\TFBRAVO.GET.FONTSIZE 22842 . 23158) (
|
||||
\TFBRAVO.GET.FONTSTYLE 23160 . 23488) (\TFBRAVO.WRITE.RUN 23490 . 24597) (\TFBRAVO.ASSERT 24599 .
|
||||
24911) (\SHIFT.DOCUMENT 24913 . 28789) (\TEDIT.BRAVOFILE? 28791 . 30838) (\TEST.CHARACTER.LOOKS 30840
|
||||
. 32480) (\TEST.PARAGRAPH.LOOKS 32482 . 34110)) (34113 37660 (\TFBRAVO.COPY.NAMEDTAB 34123 . 34482) (
|
||||
\TFBRAVO.PUT.NAMEDTAB 34484 . 34780) (\TFBRAVO.GET.NAMEDTAB 34782 . 35059) (\TFBRAVO.ADD.NAMEDTAB
|
||||
35061 . 36038) (\NAMEDTABNYET 36040 . 36205) (\NAMEDTABSIZE 36207 . 37092) (\NAMEDTAB.INIT 37094 .
|
||||
37658)) (37661 73665 (\TFBRAVO.APPLY.PARALOOKS 37671 . 38702) (TEDITFROMBRAVO 38704 . 41106) (
|
||||
\TFBRAVO.WRITE.PARAGRAPH 41108 . 42130) (\TFBRAVO.WRITE.RUNS 42132 . 42713) (\TFBRAVO.SPREAD.LOOKS
|
||||
42715 . 45687) (\TFBRAVO.PARSE.PARA 45689 . 47594) (\TFBRAVO.INIT.PARALOOKS 47596 . 50920) (
|
||||
\TFBRAVO.READ.PARALOOKS 50922 . 58098) (\TFBRAVO.READ.CHARLOOKS 58100 . 66233) (\TFBRAVO.READ.USER.CM
|
||||
66235 . 69565) (\TFBRAVO.GETPARAMS 69567 . 70396) (\TFBRAVO.PARAMNAMEP 70398 . 70846) (\TFBRAVO.EOLS
|
||||
70848 . 71261) (\TFBRAVO.LCASER 71263 . 71815) (\TFBRAVO.FONT.FROM.CHARLOOKS 71817 . 73663)))))
|
||||
(FILEMAP (NIL (4259 34161 (\TFBRAVO.FIND.LAST.TRAILER 4269 . 5762) (\TFBRAVO.HANDLE.HEADING 5764 .
|
||||
7642) (\TFBRAVO.INIT.CHARLOOKS 7644 . 8460) (\TFBRAVO.INIT.PAGEFORMAT 8462 . 8940) (
|
||||
\TFBRAVO.INSTALL.PAGEFORMAT 8942 . 13579) (\TFBRAVO.PARSE.PROFILE.PARA 13581 . 22094) (
|
||||
\TFBRAVO.PARSE.PROFILE.VALUE 22096 . 22863) (\TFBRAVO.GET.FONTSIZE 22865 . 23181) (
|
||||
\TFBRAVO.GET.FONTSTYLE 23183 . 23511) (\TFBRAVO.WRITE.RUN 23513 . 24646) (\TFBRAVO.ASSERT 24648 .
|
||||
24960) (\SHIFT.DOCUMENT 24962 . 28838) (\TEDIT.BRAVOFILE? 28840 . 30887) (\TEST.CHARACTER.LOOKS 30889
|
||||
. 32529) (\TEST.PARAGRAPH.LOOKS 32531 . 34159)) (34162 37709 (\TFBRAVO.COPY.NAMEDTAB 34172 . 34531) (
|
||||
\TFBRAVO.PUT.NAMEDTAB 34533 . 34829) (\TFBRAVO.GET.NAMEDTAB 34831 . 35108) (\TFBRAVO.ADD.NAMEDTAB
|
||||
35110 . 36087) (\NAMEDTABNYET 36089 . 36254) (\NAMEDTABSIZE 36256 . 37141) (\NAMEDTAB.INIT 37143 .
|
||||
37707)) (37710 73994 (\TFBRAVO.APPLY.PARALOOKS 37720 . 38751) (TEDITFROMBRAVO 38753 . 41155) (
|
||||
\TFBRAVO.WRITE.PARAGRAPH 41157 . 42179) (\TFBRAVO.WRITE.RUNS 42181 . 42950) (\TFBRAVO.SPREAD.LOOKS
|
||||
42952 . 45924) (\TFBRAVO.PARSE.PARA 45926 . 47923) (\TFBRAVO.INIT.PARALOOKS 47925 . 51249) (
|
||||
\TFBRAVO.READ.PARALOOKS 51251 . 58427) (\TFBRAVO.READ.CHARLOOKS 58429 . 66562) (\TFBRAVO.READ.USER.CM
|
||||
66564 . 69894) (\TFBRAVO.GETPARAMS 69896 . 70725) (\TFBRAVO.PARAMNAMEP 70727 . 71175) (\TFBRAVO.EOLS
|
||||
71177 . 71590) (\TFBRAVO.LCASER 71592 . 72144) (\TFBRAVO.FONT.FROM.CHARLOOKS 72146 . 73992)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
421
library/UNICODE
421
library/UNICODE
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -36,9 +36,9 @@ The function STREAMPROP obtains or changes the external format of an open stream
|
||||
|
||||
In the latter case, the stream's format is changed to :UTF8 and the previous value is returned, in this example it is Medley's historical default format :XCCS.
|
||||
|
||||
Entries can be placed on the variable *DEFAULT-EXTERNAL-FORMATS* to change the external format that is set by default when a file is opened on a particular device. Loading UNICODE executes
|
||||
Entries can be placed on the variable *DEFAULT-EXTERNALFORMATS* to change the external format that is set by default when a file is opened on a particular device. Loading UNICODE executes
|
||||
|
||||
(PUSH *DEFAULT-EXTERNAL-FORMATS* '(UNIX :UTF8))
|
||||
(PUSH *DEFAULT-EXTERNALFORMATS* '(UNIX :UTF8))
|
||||
|
||||
so that all files opened (by OPENSTREAM, CL:OPEN, etc.) on the UNIX file device will be initialized with :UTF8. Note that the UNIX and DSK file devices reference the same files (although some caution is needed because {UNIX} does not simulate Medley versioning), but the device name in a file name ({UNIX}/Users/... vs. {DSK}/Users/...) selects one or the other. The default setting above applies only to files specified with {UNIX}; a separate default entry for DSK must be established to change its default from :XCCS.
|
||||
|
||||
@@ -58,7 +58,7 @@ where FILESPEC can be a list of files, charset octal strings ("0" "357"), or XCC
|
||||
|
||||
When UNICODE is loaded the mappings for the character sets specified in the variable DEFAULT-XCCS-CHARSETS are installed. This is initialized to
|
||||
|
||||
(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS SYMBOLS3 SYMBOLS4 ACCENTED-LATIN)
|
||||
(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS SYMBOLS3 SYMBOLS4 ACCENTED-LATIN GREEK)
|
||||
|
||||
but DEFAULT-XCCS-CHARSETS can be set to a different collection before UNICODE is loaded.
|
||||
|
||||
@@ -66,7 +66,7 @@ The internal translation tables used by the external formats are constructed fro
|
||||
|
||||
(MAKE-UNICODE-TRANSLATION-TABLES MAPPING [FROM-XCCS-VAR][TO-XCCS-VAR])
|
||||
|
||||
This returns a two-array multiple-value containing the relevant translation information organized for rapid access. If the optional from/to-variables arguments are provide, they are the names of variables whose top-level values will be set to these arrays, for convenience. For the external formats defined above, these variables are *XCCSTOUNICODE* and *UNICODETOXCCS*.
|
||||
This returns a list of two arrays (XCCS-to-Unicode Unicode-to-XCCS)containing the relevant translation information organized for rapid access. If the optional from/to-variables arguments are provide, they are the names of variables whose top-level values will be set to these arrays, for convenience. For the external formats defined above, these variables are *XCCSTOUNICODE* and *UNICODETOXCCS*.
|
||||
|
||||
The macro
|
||||
|
||||
|
||||
412
library/XCCS
412
library/XCCS
@@ -1,412 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED " 4-Aug-2020 22:36:36" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>XCCS.;4 23636
|
||||
|
||||
changes to%: (VARS XCCSCOMS)
|
||||
(FNS HEXCODE BINTOUMAPPING HEXSTRING X2U.BIN)
|
||||
|
||||
previous date%: "30-Jul-2020 13:55:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>XCCS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT XCCSCOMS)
|
||||
|
||||
(RPAQQ XCCSCOMS
|
||||
((COMS (FNS X2U.WIKI XCCS2UNICODE.PARSECELL))
|
||||
(COMS (FNS X2U.BIN XCCORD GETUCODE WIN FINDUCODE))
|
||||
(FNS SHOWMAPPINGS SHOWMAPPING)
|
||||
(FNS COMPAREMAPPINGS COMPARECHARSETS)
|
||||
(FNS MERGEMAPPINGS PRINTMERGED READMERGED)
|
||||
(FNS TRANSLATECHARSET)
|
||||
(FNS CONVERTU2X)
|
||||
(FNS UTF8TOHEXSTRING HEXSTRING HEXCODE BINTOUMAPPING)))
|
||||
(DEFINEQ
|
||||
|
||||
(X2U.WIKI
|
||||
[LAMBDA (WIKIFILE) (* ; "Edited 24-Jul-2020 11:11 by rmk:")
|
||||
|
||||
(* ;; "This scrapes the XCCS to Unicode mappings from the XCCS Wikipedia page.")
|
||||
|
||||
(* ;; "However, that page does not seem to correspond to the version of XCCS that Interlisp has internalized.")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM (OR WIKIFILE
|
||||
"/Users/kaplan/Desktop/Editing Xerox Character Code Standard - Wikipedia.html"
|
||||
)
|
||||
:DIRECTION :INPUT)
|
||||
(BIND CSET CSSTRING WHILE (FILEPOS "{{chset-table-header|XCCS (prefixed with "
|
||||
STREAM NIL NIL NIL T)
|
||||
COLLECT (CL:UNLESS (AND (EQ 0 (READC STREAM))
|
||||
(EQ 'x (READC STREAM)))
|
||||
(HELP "no 0x"))
|
||||
[SETQ CSSTRING (OCTALSTRING (HEXCODE (CONCAT (READC STREAM)
|
||||
(READC STREAM]
|
||||
(CONS CSSTRING (FOR I UC FROM 0 TO 255
|
||||
WHEN (AND (FILEPOS "{{chset-color-" STREAM NIL NIL NIL T)
|
||||
(SETQ UC (XCCS2UNICODE.PARSECELL STREAM)))
|
||||
COLLECT (LIST (CONCAT CSSTRING "," (OCTALSTRING I))
|
||||
UC])
|
||||
|
||||
(XCCS2UNICODE.PARSECELL
|
||||
[LAMBDA (STREAM) (* ; "Edited 21-Jul-2020 14:13 by rmk:")
|
||||
(CL:UNLESS (STREQUAL "undef" (CONCATLIST (BIND C UNTIL (EQ '} (SETQ C (READC STREAM)))
|
||||
COLLECT C)))
|
||||
(FILEPOS "chset-" STREAM NIL NIL NIL T)
|
||||
(FILEPOS "|" STREAM NIL NIL NIL T)
|
||||
(CONCATLIST (BIND C UNTIL (EQ '%| (SETQ C (READC STREAM))) COLLECT C)))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(X2U.BIN
|
||||
[LAMBDA (BINFILE) (* ; "Edited 4-Aug-2020 21:13 by rmk:")
|
||||
(* ; "Edited 21-Jul-2020 13:49 by rmk:")
|
||||
|
||||
(* ;; "This reads the binary file that maps from XCCS character-code ordinal positions to the corresponding Unicode code. Result is a list of (octal-xccs-codes hex-unicodes) pairs.")
|
||||
|
||||
(* ;; "The file is a sequence of 2-byte UC hex codes. Each UC code corresponds to the XC code that you would get if you took out all the undefined code-spaces in all of the preceding character sets. The first 128-code panel of a code chart hasa 33 unused control slots at the beginning (although for charset 0 the last %"unused%" control slot is the ascii space, which is not represented in the file). The last cell of each 128-code panel is also not used.")
|
||||
|
||||
(* ;; "So, the UC code at the first ordinal position in the file corresponds to XC code 33 (octal 41), then we run up to 126, skip 127, then skip another 33 to start the second 128-code panel. And we skip the last cell of that before we move on to the next character set.")
|
||||
|
||||
(* ;; "But also, the next character set after charset 0 is charset 41 octal (33). So we have to skip 256*32 positions.")
|
||||
|
||||
(* ;; "Finally, there are unused cells in the middle of some panels. Those are represented in the file by the sequence %"FFFD%", which maps to the unicode black-box with a ?. There is no need to include those.")
|
||||
|
||||
(CL:WITH-OPEN-FILE
|
||||
(STREAM (OR BINFILE (PACK* (CAR UNICODEDIRECTORIES)
|
||||
'/XCCStoUni))
|
||||
:DIRECTION :INPUT)
|
||||
|
||||
(* ;; "XC is the XC code corresponding to the current UC hex string. I keeps track of the number of hex strings we have read within this panel, before we have to increment by 34")
|
||||
|
||||
(BIND UC CSSTRING [CHARSETFIX _ '(("57" "341" Hebrew)
|
||||
("56" "340" Arabic]
|
||||
(CHARSET _ 0)
|
||||
(LASTFP _ 0) UNTIL (EOFP STREAM)
|
||||
COLLECT (SETQ CSSTRING (OCTALSTRING CHARSET))
|
||||
(CL:WHEN (SASSOC CSSTRING CHARSETFIX)
|
||||
(SETQ CSSTRING (CADR (SASSOC CSSTRING CHARSETFIX))))
|
||||
(CONS CSSTRING (PROG1 [NCONC [FOR XC UC FROM 33 TO 126
|
||||
UNTIL (EOFP STREAM)
|
||||
UNLESS (MEMBER (SETQ UC (HEXSTRING (WIN STREAM)
|
||||
4))
|
||||
'("FFFD" "FFFF"))
|
||||
COLLECT (PROG1 (LIST (CONCAT CSSTRING ","
|
||||
(OCTALSTRING XC))
|
||||
UC LASTFP)
|
||||
(SETQ LASTFP (GETFILEPTR STREAM)))]
|
||||
(FOR XC UC FROM (PLUS 128 33)
|
||||
TO (PLUS 128 126) UNTIL (EOFP STREAM)
|
||||
UNLESS (MEMBER (SETQ UC (HEXSTRING (WIN STREAM)
|
||||
4))
|
||||
'("FFFD" "FFFF"))
|
||||
COLLECT (PROG1 (LIST (CONCAT CSSTRING ","
|
||||
(OCTALSTRING XC))
|
||||
UC LASTFP)
|
||||
(SETQ LASTFP (GETFILEPTR STREAM)))]
|
||||
(ADD CHARSET (CL:IF (EQ CHARSET 0)
|
||||
33
|
||||
1)))])
|
||||
|
||||
(XCCORD
|
||||
[LAMBDA (XCODE) (* ; "Edited 17-Jul-2020 08:11 by rmk:")
|
||||
|
||||
(* ;; "Returns the ordinal position of XCODE in the Xerox Character Code standard, removing all not-used slots.")
|
||||
|
||||
(* ;; "The first 32 of every 256 block is unused, and 34 are unused int he middle of the block (127 to 160)")
|
||||
|
||||
(* ;; "Also, character sets 1-32 do not exist")
|
||||
|
||||
(CL:UNLESS (AND (SMALLP XCODE)
|
||||
(ILESSP XCODE (CHARCODE 0))
|
||||
(IGREATERP XCODE (CHARCODE 9)))
|
||||
(SETQ XCODE (CHARCODE.DECODE XCODE)))
|
||||
(LET ((CHARSET (IQUOTIENT XCODE 256))
|
||||
(PERCHARSET (- 256 (+ 32 34)))
|
||||
(CHARSETORD 0)
|
||||
(CHARINSET (IREMAINDER XCODE 256)))
|
||||
(CL:UNLESS (EQ CHARSET 0) (* ; "33 (41Q) -> 1")
|
||||
(SETQ CHARSETORD (- CHARSET 32)))
|
||||
(CL:WHEN (ILESSP CHARSETORD 0)
|
||||
(ERROR "UNUSED CHARACTER SET" CHARSET))
|
||||
(CL:WHEN [OR (ILESSP CHARINSET 32)
|
||||
(AND (IGEQ CHARINSET 127)
|
||||
(ILEQ CHARINSET (PLUS 128 33]
|
||||
(ERROR "UNUSED CHARACTER" XCODE))
|
||||
(SETQ PRECHARSET (TIMES PERCHARSET CHARSETORD))
|
||||
(IPLUS PRECHARSET (- CHARINSET (IF (ILEQ CHARINSET 127)
|
||||
THEN 32
|
||||
ELSE (PLUS 32 34])
|
||||
|
||||
(GETUCODE
|
||||
[LAMBDA (XCODE STREAM) (* ; "Edited 22-Jul-2020 12:07 by rmk:")
|
||||
(* ; "Edited 16-Jul-2020 23:37 by rmk:")
|
||||
(LET ((XCODE (OR (SMALLP XCODE)
|
||||
(CHARCODE.DECODE XCODE)))
|
||||
SKIP UCODE)
|
||||
[SETQ SKIP (TIMES 33 (ADD1 (IQUOTIENT XCODE 128]
|
||||
(SETFILEPTR STREAM (TIMES 2 (IDIFFERENCE XCODE SKIP)))
|
||||
(SETQ UCODE (LOGOR (LLSH (BIN STREAM)
|
||||
8)
|
||||
(BIN STREAM)))
|
||||
(HEXSTRING UCODE])
|
||||
|
||||
(WIN
|
||||
[LAMBDA (STREAM) (* ; "Edited 16-Jul-2020 23:22 by rmk:")
|
||||
(LOGOR (LLSH (BIN STREAM)
|
||||
8)
|
||||
(BIN STREAM])
|
||||
|
||||
(FINDUCODE
|
||||
[LAMBDA (UC BINFILE) (* ; "Edited 22-Jul-2020 17:13 by rmk:")
|
||||
(CL:WITH-OPEN-FILE (STREAM (OR BINFILE "{DSK}<Users>kaplan>Local>dict>unicode>xerox>XCCStoUni")
|
||||
:DIRECTION :INPUT)
|
||||
(FILEPOS (CONCAT (CHARACTER (LRSH (HEXCODE UC)
|
||||
8))
|
||||
(CHARACTER (LOGAND (HEXCODE UC)
|
||||
255)))
|
||||
STREAM])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(SHOWMAPPINGS
|
||||
[LAMBDA (MAPPINGS) (* ; "Edited 24-Jul-2020 11:06 by rmk:")
|
||||
(FOR M IN MAPPINGS DO (SHOWMAPPING MAPPINGS (CAR M))
|
||||
(TERPRI T])
|
||||
|
||||
(SHOWMAPPING
|
||||
[LAMBDA (MAPPINGS CHARSET) (* ; "Edited 24-Jul-2020 11:08 by rmk:")
|
||||
(CL:WHEN (STRPOS "," CHARSET)
|
||||
(SETQ CHARSET (SUBSTRING CHARSET 1 (STRPOS "," CHARSET))))
|
||||
(PRINTOUT T "Character set " (CAR M)
|
||||
T)
|
||||
(FOR Y IN (CDR (SASSOC CHARSET MAPPINGS)) DO (PRINTOUT T (CAR Y)
|
||||
8
|
||||
(CHARACTER (CHARCODE.DECODE
|
||||
(CAR Y)))
|
||||
" "
|
||||
(CADR Y))
|
||||
(CL:WHEN (CDDR Y)
|
||||
(PRINTOUT T " " (CADDR Y)))
|
||||
(TERPRI T])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(COMPAREMAPPINGS
|
||||
[LAMBDA (MAP1 MAP2) (* ; "Edited 24-Jul-2020 13:39 by rmk:")
|
||||
(LET [(CHARSETS1 (FOR M1 IN MAP1 COLLECT (CAR M1)))
|
||||
(CHARSETS2 (FOR M2 IN MAP2 COLLECT (CAR M2]
|
||||
(LIST [FOR COMMON IN (INTERSECTION CHARSETS1 CHARSETS2)
|
||||
COLLECT (CONS COMMON (COMPARECHARSETS (SASSOC COMMON MAP1)
|
||||
(SASSOC COMMON MAP2]
|
||||
(LDIFFERENCE CHARSETS1 CHARSETS2)
|
||||
(LDIFFERENCE CHARSETS2 CHARSETS1])
|
||||
|
||||
(COMPARECHARSETS
|
||||
[LAMBDA (CS1 CS2) (* ; "Edited 24-Jul-2020 20:21 by rmk:")
|
||||
(CL:UNLESS (STREQUAL (CAR CS1)
|
||||
(CAR CS2))
|
||||
(ERROR "CHARSETS DON'T CORRESPONG"))
|
||||
(FOR XC U1 U2 IN [SORT (UNION (FOR M1 IN (CDR CS1) COLLECT (CAR M1))
|
||||
(FOR M2 IN (CDR CS2) COLLECT (CAR M2)))
|
||||
(FUNCTION (LAMBDA (X1 X2)
|
||||
(ILEQ (CHARCODE.DECODE X1)
|
||||
(CHARCODE.DECODE X2]
|
||||
EACHTIME [SETQ U1 (CADR (SASSOC XC (CDR CS1]
|
||||
[SETQ U2 (CADR (SASSOC XC (CDR CS2] WHEN (IF (AND U1 U2)
|
||||
THEN (NOT (IEQP (CHARCODE.DECODE
|
||||
U1)
|
||||
(CHARCODE.DECODE
|
||||
U2)))
|
||||
ELSE (OR U1 U2))
|
||||
COLLECT (LIST XC U1 U2 (CHARACTER (CHARCODE.DECODE XC])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(MERGEMAPPINGS
|
||||
[LAMBDA (MAP1 MAP2) (* ; "Edited 25-Jul-2020 15:36 by rmk:")
|
||||
(FOR CSET CS1 CS2 IN [SORT (UNION (FOR M1 IN MAP1 COLLECT (CAR M1))
|
||||
(FOR M2 IN MAP2 COLLECT (CAR M2)))
|
||||
(FUNCTION (LAMBDA (CS1 CS2)
|
||||
(ILEQ (CL:PARSE-INTEGER CS1 :RADIX 8)
|
||||
(CL:PARSE-INTEGER CS2 :RADIX 8]
|
||||
COLLECT (SETQ CS1 (SASSOC CSET MAP1))
|
||||
(SETQ CS2 (SASSOC CSET MAP2))
|
||||
(CONS CSET (FOR XC UCODE1 UCODE2 UCHAR1 UCHAR2
|
||||
IN [SORT (UNION (FOR M1 IN (CDR CS1) COLLECT (CAR M1))
|
||||
(FOR M2 IN (CDR CS2) COLLECT (CAR M2)))
|
||||
(FUNCTION (LAMBDA (XC1 XC2)
|
||||
(ILEQ (CHARCODE.DECODE XC1)
|
||||
(CHARCODE.DECODE XC2]
|
||||
COLLECT [SETQ UCODE1 (CADR (SASSOC XC (CDR CS1]
|
||||
[SETQ UCHAR1 (CL:WHEN UCODE1
|
||||
(CHARACTER (CHARCODE.DECODE UCODE1)))]
|
||||
[SETQ UCODE2 (CADR (SASSOC XC (CDR CS2]
|
||||
[SETQ UCHAR2 (CL:WHEN UCODE2
|
||||
(CHARACTER (CHARCODE.DECODE UCODE2)))]
|
||||
(CONS XC (IF UCHAR1
|
||||
THEN (IF (AND UCODE2 (NEQ UCHAR1 UCHAR2))
|
||||
THEN (LIST UCHAR1 UCHAR2 UCODE1 UCODE2
|
||||
)
|
||||
ELSE (LIST UCHAR1 UCODE1))
|
||||
ELSEIF UCHAR2
|
||||
THEN (LIST UCHAR2 UCODE2)
|
||||
ELSE (HELP "XC WITHOUT UC'S" XC])
|
||||
|
||||
(PRINTMERGED
|
||||
[LAMBDA (MERGED CHARSETS FILE) (* ; "Edited 25-Jul-2020 16:08 by rmk:")
|
||||
[SELECTQ CHARSETS
|
||||
(NOJIS (SETQ MERGED (FOR M IN MERGED UNLESS (AND (IGEQ (CL:PARSE-INTEGER
|
||||
(CAR M)
|
||||
:RADIX 8)
|
||||
(CL:PARSE-INTEGER "60"
|
||||
:RADIX 8))
|
||||
(ILESSP (CL:PARSE-INTEGER
|
||||
(CAR M)
|
||||
:RADIX 8)
|
||||
(CL:PARSE-INTEGER "340"
|
||||
:RADIX 8)))
|
||||
COLLECT M))
|
||||
(CL:UNLESS FILE
|
||||
(SETQ FILE 'MERGED-NOJIS)))
|
||||
((ALL NIL)
|
||||
(CL:UNLESS FILE
|
||||
(SETQ FILE 'MERGED-ALL)))
|
||||
(PROGN (SETQ CHARSETS (MKLIST CHARSETS))
|
||||
[SETQ MERGED (FOR CS IN CHARSETS COLLECT (OR (SASSOC CS MERGED)
|
||||
(ERROR CS "does not exist"]
|
||||
(CL:UNLESS FILE
|
||||
(SETQ FILE (PACK* FILE "-" (CAR CHARSETS))))]
|
||||
(SETQ FILE (PACKFILENAME 'BODY FILE 'EXTENSION 'TXT))
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :EXTERNAL-FORMAT :UTF8 :IF-EXISTS :NEW-VERSION
|
||||
)
|
||||
(PRINTOUT STREAM "(")
|
||||
(FOR CSET IN MERGED DO (PRINTOUT STREAM "(" .P2 (CAR CSET)
|
||||
T)
|
||||
(FOR MAP IN (CDR CSET)
|
||||
DO (PRINTOUT STREAM 3 .P2 MAP T))
|
||||
(PRINTOUT STREAM ")" T))
|
||||
(PRINTOUT STREAM ")")
|
||||
(CLOSEF STREAM])
|
||||
|
||||
(READMERGED
|
||||
[LAMBDA (FILE) (* ; "Edited 30-Jul-2020 13:40 by rmk:")
|
||||
|
||||
(* ;; "Reads UTF8 without translation to XCCS")
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT :UTF8-RAW)
|
||||
(* (READC STREAM) (BIND SET UNTIL
|
||||
(EOFP STREAM) COLLECT
|
||||
(SETQ SET (READ STREAM))
|
||||
(PRINTOUT T (CAR) " ")))
|
||||
(READ STREAM])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TRANSLATECHARSET
|
||||
[LAMBDA (MAPPINGS FROMCS TOCS) (* ; "Edited 26-Jul-2020 19:35 by rmk:")
|
||||
(CL:WHEN (SMALLP FROMCS)
|
||||
(SETQ FROMCS (CONCAT FROMCS)))
|
||||
(CL:WHEN (SMALLP TOCS)
|
||||
(SETQ TOCS (CONCAT TOCS)))
|
||||
(LET ((CSETMAP (SASSOC FROMCS MAPPINGS))
|
||||
(NEWCSETMAP))
|
||||
(CL:UNLESS CSETMAP (ERROR "FROM CHARACTER SET NOT FOUND" FROMCS))
|
||||
(SETQ NEWCSMAP (CONS TOCS (FOR CM IN (CDR CSETMAP)
|
||||
COLLECT (CONS [CONCAT TOCS
|
||||
(OR (SUBSTRING (CAR CM)
|
||||
(STRPOS "," (CAR CM)))
|
||||
(HELP "INVALID CHARCODE"
|
||||
(CAR CM]
|
||||
(CDR CM])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CONVERTU2X
|
||||
[LAMBDA NIL (* ; "Edited 27-Jul-2020 14:40 by rmk:")
|
||||
(FOR X IN CBUNICODETOXEROXRENDERING COLLECT (LIST [CHARCODESTRING
|
||||
(OR (FIXP (CADR X))
|
||||
(CHARCODE.DECODE (CADR X]
|
||||
[CHARACTER
|
||||
(OR (FIXP (CADR X))
|
||||
(CHARCODE.DECODE (CADR X]
|
||||
(HEXSTRING (CAR X)
|
||||
4])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(UTF8TOHEXSTRING
|
||||
[LAMBDA (UTF8STRING) (* ; "Edited 28-Jul-2020 17:32 by rmk:")
|
||||
|
||||
(* ;; "Converts from a UTF8 encoding of a number to the hex string that represents that number")
|
||||
|
||||
(LET (BYTE1 BYTE1 BYTE2 BYTE3 BYTE4)
|
||||
(SETQ BYTE1 (HEXCODE (SUBSTRING UTF8STRING 1 2)))
|
||||
|
||||
(* ;; "Distinguish on header byte, extract number of bytes so we don't read too far")
|
||||
|
||||
(HEXSTRING (IF (ILESSP BYTE1 128)
|
||||
THEN
|
||||
|
||||
(* ;; "Test first: Ascii is the common case")
|
||||
|
||||
BYTE1
|
||||
ELSEIF (IGEQ BYTE1 (LLSH 15 4))
|
||||
THEN (* ; "4 bytes")
|
||||
(SETQ BYTE2 (HEXCODE (SUBSTRING UTF8STRING 3 4)))
|
||||
(CL:WHEN (ILESSP BYTE2 128)
|
||||
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
|
||||
(SETQ BYTE3 (HEXCODE (SUBSTRING UTF8STRING 5 6)))
|
||||
(CL:WHEN (ILESSP BYTE3 128)
|
||||
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
|
||||
(SETQ BYTE4 (HEXCODE (SUBSTRING UTF8STRING 7 8)))
|
||||
(CL:WHEN (ILESSP BYTE4 128)
|
||||
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4)))
|
||||
(LOGOR (LLSH (LOADBYTE BYTE1 0 3)
|
||||
18)
|
||||
(LLSH (LOADBYTE BYTE2 0 6)
|
||||
12)
|
||||
(LLSH (LOADBYTE BYTE3 0 6)
|
||||
6)
|
||||
(LOADBYTE BYTE4 0 6))
|
||||
ELSEIF (IGEQ BYTE1 (LLSH 7 5))
|
||||
THEN (* ; "3 bytes")
|
||||
(SETQ BYTE2 (HEXCODE (SUBSTRING UTF8STRING 3 4)))
|
||||
(CL:WHEN (ILESSP BYTE2 128)
|
||||
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
|
||||
(SETQ BYTE3 (HEXCODE (SUBSTRING UTF8STRING 5 6)))
|
||||
(CL:WHEN (ILESSP BYTE3 128)
|
||||
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
|
||||
(LOGOR (LLSH (LOADBYTE BYTE1 0 4)
|
||||
12)
|
||||
(LLSH (LOADBYTE BYTE2 0 6)
|
||||
6)
|
||||
(LOADBYTE BYTE3 0 6))
|
||||
ELSE (* ; "Must be 2 bytes")
|
||||
(SETQ BYTE2 (HEXCODE (SUBSTRING UTF8STRING 3 4)))
|
||||
(CL:WHEN (ILESSP BYTE2 128)
|
||||
(ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
|
||||
(LOGOR (LLSH (LOADBYTE BYTE1 0 5)
|
||||
6)
|
||||
(LOADBYTE BYTE2 0 6])
|
||||
|
||||
(HEXSTRING
|
||||
[LAMBDA (N) (* ; "Edited 4-Aug-2020 21:19 by rmk:")
|
||||
(CL:FORMAT NIL "~4,'0X" N])
|
||||
|
||||
(HEXCODE
|
||||
[LAMBDA (HEXSTRING) (* ; "Edited 4-Aug-2020 21:28 by rmk:")
|
||||
(CL:PARSE-INTEGER HEXSTRING :RADIX 16])
|
||||
|
||||
(BINTOUMAPPING
|
||||
[LAMBDA (BINLIST) (* ; "Edited 4-Aug-2020 21:28 by rmk:")
|
||||
(FOR CS IN BINLIST JOIN (FOR CM IN (CDR CS)
|
||||
COLLECT (LIST (CHARCODE.DECODE (CAR CM))
|
||||
(HEXCODE (CADR CM])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (801 2795 (X2U.WIKI 811 . 2310) (XCCS2UNICODE.PARSECELL 2312 . 2793)) (2796 9601 (
|
||||
X2U.BIN 2806 . 6854) (XCCORD 6856 . 8283) (GETUCODE 8285 . 8894) (WIN 8896 . 9084) (FINDUCODE 9086 .
|
||||
9599)) (9602 10870 (SHOWMAPPINGS 9612 . 9856) (SHOWMAPPING 9858 . 10868)) (10871 12765 (
|
||||
COMPAREMAPPINGS 10881 . 11468) (COMPARECHARSETS 11470 . 12763)) (12766 17927 (MERGEMAPPINGS 12776 .
|
||||
15003) (PRINTMERGED 15005 . 17277) (READMERGED 17279 . 17925)) (17928 18901 (TRANSLATECHARSET 17938 .
|
||||
18899)) (18902 19723 (CONVERTU2X 18912 . 19721)) (19724 23613 (UTF8TOHEXSTRING 19734 . 22929) (
|
||||
HEXSTRING 22931 . 23082) (HEXCODE 23084 . 23245) (BINTOUMAPPING 23247 . 23611)))))
|
||||
STOP
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,5 +1,5 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(LISPXPRIN1 "EXPORTS GATHERED FROM {DSK}<home>larry>ilisp>medley>sources> ON 6-May-2021 15:26:52" T)
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10 FORMAT XCCS)
|
||||
(LISPXPRIN1 "EXPORTS GATHERED FROM {DSK}<home>larry>new>medley>sources> ON 27-Jul-2021 21:13:38" T)
|
||||
(LISPXTERPRI T)
|
||||
(RPAQQ MODARITHMACROS (CEIL FLOOR FOLDHI FOLDLO MODUP UNFOLD MOD))
|
||||
(PUTPROPS CEIL MACRO ((X N) (FLOOR (IPLUS X (CONSTANT (SUB1 N))) N)))
|
||||
@@ -52,7 +52,7 @@ MAX.FIXP))))
|
||||
LOGOR (LSH 1 (SUB1 SMALLP.LENGTH)) (SUB1 (LSH 1 (SUB1 SMALLP.LENGTH))))) (MIN.SMALLP (IDIFFERENCE -1
|
||||
MAX.SMALLP)) (BITS.PER.FIXP BITSPERCELL) (FIXP.LENGTH (SUB1 BITS.PER.FIXP)) (MAX.FIXP (LOGOR (LSH 1 (
|
||||
SUB1 FIXP.LENGTH)) (SUB1 (LSH 1 (SUB1 FIXP.LENGTH))))) (MIN.FIXP (IDIFFERENCE -1 MAX.FIXP)))
|
||||
(PUTPROP (QUOTE MODARITH) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE MODARITH) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(RPAQQ WINDFLG T)
|
||||
(CONSTANTS (WINDFLG T))
|
||||
@@ -614,7 +614,7 @@ QUOTE \\VAG2) |\\D0BCPLspace| (CAR X))))))
|
||||
(PUTPROPS EMADDRESSP MACRO (X (LIST (QUOTE EQ) (LIST (QUOTE \\HILOC) (CAR X)) (COND ((EQ
|
||||
|\\D1BCPLspace| |\\D0BCPLspace|) |\\D0BCPLspace|) (T (QUOTE (|fetch| (IFPAGE |EmulatorSpace|) |of|
|
||||
|\\InterfacePage|)))))))
|
||||
(PUTPROP (QUOTE LLPARAMS) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLPARAMS) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(DATATYPE COMPILED-CLOSURE (FNHEADER ENVIRONMENT))
|
||||
(RPAQQ \\COMPILED-CLOSURE 13)
|
||||
@@ -734,7 +734,7 @@ CODEARRAY NA) |of| DATUM) 0)) (OVERHEADWORDS (PROGN 8)) (ALIGNED (IPLUS (|fetch|
|
||||
(RPAQQ \\NT.PVARCODE 2)
|
||||
(RPAQQ \\NT.FVARCODE 3)
|
||||
(CONSTANTS \\NT.IVARCODE \\NT.PVARCODE \\NT.FVARCODE)
|
||||
(PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLCODE) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(RPAQQ \\ERRORMESSAGELIST ("SYSTEM ERROR" " " "STACK OVERFLOW" "ILLEGAL RETURN" "ARG NOT LIST"
|
||||
"HARD DISK ERROR" "ATTEMPT TO SET NIL OR T" "ATTEMPT TO RPLAC NIL" "UNDEFINED OR ILLEGAL GO"
|
||||
@@ -751,7 +751,7 @@ CODEARRAY NA) |of| DATUM) 0)) (OVERHEADWORDS (PROGN 8)) (ALIGNED (IPLUS (|fetch|
|
||||
(DEFOPTIMIZER LISPERROR (MESSAGE ARG) (BQUOTE (\\LISPERROR (\\\, ARG) (\\\, (CL:IF (CL:STRINGP MESSAGE
|
||||
) (FOR X IN \\ERRORMESSAGELIST AS I FROM 0 WHEN (CL:EQUAL X MESSAGE) DO (RETURN I) FINALLY (RETURN (
|
||||
HELP "Unknown error message" (LIST MESSAGE ARG)))) MESSAGE)))))
|
||||
(PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE AERROR) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM) (ACCESSFNS ((BIASOFFST (|fetch| (STREAM FW6) |of|
|
||||
DATUM) (|replace| (STREAM FW6) |of| DATUM |with| NEWVALUE)) (BBSNCHARS (|fetch| (STREAM FW7) |of|
|
||||
@@ -761,28 +761,13 @@ DATUM) (|replace| (STREAM FW7) |of| DATUM |with| NEWVALUE)) (WRITEXTENSIONFN (|f
|
||||
(PUTPROPS \\OUTSTREAMARG MACRO ((STRM NOERRORFLG) (\\GETSTREAM STRM (QUOTE OUTPUT) NOERRORFLG)))
|
||||
(PUTPROPS \\STREAMARG MACRO (OPENLAMBDA (STRM NOERRORFLG) (COND (NOERRORFLG (\\GETSTREAM STRM NIL T))
|
||||
(T (\\DTEST STRM (QUOTE STREAM))))))
|
||||
(PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE AOFD) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:36:17"))
|
||||
|
||||
(PUTPROPS .SPACECHECK. MACRO ((STRM N) (AND \\THISFILELINELENGTH (IGREATERP (IPLUS N (|fetch|
|
||||
CHARPOSITION |of| STRM)) \\THISFILELINELENGTH) (FRESHLINE STRM))))
|
||||
(PUTPROPS \\CHECKRADIX MACRO (LAMBDA (R) (COND ((OR (NOT (SMALLP R)) (ILESSP R 1) (IGREATERP R 36)) (
|
||||
\\INVALID.RADIX R)) (T R))))
|
||||
(PUTPROPS \\XCCSFILEOUTCHARFN MACRO ((OUTSTREAM CHARCODE) (* |;;;|
|
||||
"Encoder for XCCS format. Default decoder.") (COND ((EQ CHARCODE (CHARCODE EOL)) (COND ((NOT (
|
||||
\\RUNCODED OUTSTREAM)) (* \; "Charset is a constant 0") (\\BOUT OUTSTREAM (\\CHARSET (CHARCODE EOL))))
|
||||
((EQ (\\CHARSET (CHARCODE EOL)) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM))) (T (\\BOUT OUTSTREAM
|
||||
NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM CHARSET) |of| OUTSTREAM |with| (\\CHARSET (
|
||||
CHARCODE EOL)))))) (\\BOUT OUTSTREAM (SELECTC (|ffetch| EOLCONVENTION |of| OUTSTREAM) (CR.EOLC (
|
||||
CHARCODE CR)) (LF.EOLC (CHARCODE LF)) (CRLF.EOLC (\\BOUT OUTSTREAM (CHARCODE CR)) (* |;;|
|
||||
"Don't put out high-order byte preceding LF. The CRLF is EOL only if the bytes are immediately adjacent in the stream, with no additional encoding bytes"
|
||||
) (CHARCODE LF)) (SHOULDNT))) (|freplace| CHARPOSITION |of| OUTSTREAM |with| 0)) (T (COND ((NOT (
|
||||
\\RUNCODED OUTSTREAM)) (\\BOUT OUTSTREAM (\\CHARSET CHARCODE)) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE
|
||||
))) ((EQ (\\CHARSET CHARCODE) (|ffetch| (STREAM CHARSET) |of| OUTSTREAM)) (\\BOUT OUTSTREAM (
|
||||
\\CHAR8CODE CHARCODE))) (T (\\BOUT OUTSTREAM NSCHARSETSHIFT) (\\BOUT OUTSTREAM (|freplace| (STREAM
|
||||
CHARSET) |of| OUTSTREAM |with| (\\CHARSET CHARCODE))) (\\BOUT OUTSTREAM (\\CHAR8CODE CHARCODE)))) (
|
||||
|freplace| CHARPOSITION |of| OUTSTREAM |with| (PROGN (* \; "Ugh. Don't overflow") (IPLUS16 (|ffetch|
|
||||
CHARPOSITION |of| OUTSTREAM) 1)))))))
|
||||
(PUTPROP (QUOTE APRINT) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE APRINT) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:27:52"))
|
||||
|
||||
(GLOBALVARS \\BCPLDISPLAY)
|
||||
(ACCESSFNS LINEBUFFER ((LPARCOUNT (|fetch| FW6 |of| DATUM) (|replace| FW6 |of| DATUM |with| NEWVALUE))
|
||||
@@ -802,7 +787,7 @@ PEEKEDECHOFLG FLAG) (INSTRINGP FLAG)))))
|
||||
(PUTPROPS \\INTERMP MACRO ((OFD) (EQ OFD \\LINEBUF.OFD)))
|
||||
(PUTPROPS \\OUTTERMP MACRO ((OFD) (EQ OFD \\TERM.OFD)))
|
||||
(GLOBALVARS \\DEFAULTLINEBUF)
|
||||
(PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE ATERM) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:37:14"))
|
||||
|
||||
(DATATYPE HARRAYP ((NULLSLOTS WORD) (* \; "Number of NIL-NIL slots, which break chains") (LASTINDEX
|
||||
WORD) (* \;
|
||||
@@ -904,7 +889,7 @@ ARRAYBLOCK ARLEN) |of| DATUM) |\\ArrayBlockTrailerCells|))))) (TYPE? (AND (EQ 0
|
||||
(GLOBALVARS |\\NxtArrayPage| \\FREEBLOCKBUCKETS \\HUNKING?)
|
||||
(PUTPROPS HUNKSIZEFROMNUMBER MACRO ((NTYPX) (FOLDLO (|fetch| DTDSIZE |of| (\\GETDTD NTYPX))
|
||||
WORDSPERCELL)))
|
||||
(PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLARRAYELT) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(DEFOPTIMIZER PUTBASEPTRX (&REST ARGS) (CONS (QUOTE (OPENLAMBDA (DATUM OFFSET NEWVALUE) (
|
||||
UNINTERRUPTABLY (\\PUTBASE DATUM OFFSET (LOGOR (LOGAND 61440 (\\GETBASE DATUM OFFSET)) (LOGAND (
|
||||
@@ -954,7 +939,7 @@ BQUOTE ((OPCODES TYPEMASK.N (\\\, (CAR CE))) (\\\, (CAR X)))) |else| (QUOTE IGNO
|
||||
(CONSTANTS \\GUARDSTORAGEFULL \\GUARD1STORAGEFULL)
|
||||
(GLOBALVARS |\\NxtMDSPage| |\\LeastMDSPage| |\\SecondArrayPage| |\\SecondMDSPage| \\MDSFREELISTPAGE
|
||||
|\\MaxSysTypeNum| |\\MaxTypeNumber| \\STORAGEFULL \\INTERRUPTSTATE \\PENDINGINTERRUPT)
|
||||
(PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLDATATYPE) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(ACCESSFNS POINTER ((PAGE# (IPLUS (LLSH (\\HILOC DATUM) 8) (LRSH (\\LOLOC DATUM) 8))) (WORDINPAGE (
|
||||
LOGAND (\\LOLOC DATUM) 255)) (CELLINPAGE (LRSH (|fetch| WORDINPAGE |of| DATUM) 1)) (BYTEINPAGE (LLSH (
|
||||
@@ -991,7 +976,7 @@ FIXP) (* \; "Empty cells, space for another 2 CONS cells if we can figure out ho
|
||||
(CONSTANTS \\CDR.ONPAGE \\CDR.NIL \\CDR.INDIRECT \\CDR.MAXINDIRECT \\CONSPAGE.LAST)
|
||||
(PUTPROPS LOCAL MACRO ((X) X))
|
||||
(PUTPROPS ALLOCAL MACRO ((X) X))
|
||||
(PUTPROP (QUOTE LLNEW) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLNEW) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (|for| I
|
||||
|in| ARGS |collect| (LIST (QUOTE OR) I (LIST (QUOTE RAID) (KWOTE (LIST (QUOTE |Check-failure:|) I)))))
|
||||
@@ -1101,7 +1086,7 @@ LOGAND X 65535))))) (T (* \; "New symbol") X))))
|
||||
\\NEWATOM-PLISTOFFSET 6) (\\NEWATOM-TYPE# 21))
|
||||
(PUTPROPS \\MOVEWORDS MACRO (OPENLAMBDA (SBASE SOFFSET DBASE DOFFSET NWORDS) (\\BLT (\\ADDBASE DBASE
|
||||
DOFFSET) (\\ADDBASE SBASE SOFFSET) NWORDS)))
|
||||
(PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLBASIC) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(ACCESSFNS STRINGP ((XREADONLY (|fetch| (ARRAY-HEADER READ-ONLY-P) |of| DATUM) (|replace| (
|
||||
ARRAY-HEADER READ-ONLY-P) |of| DATUM |with| NEWVALUE)) (XBASE ((OPENLAMBDA (STRING) (COND ((|fetch| (
|
||||
@@ -1227,13 +1212,12 @@ OFFSET CODE)) (T (\\PUTBASETHIN BASE OFFSET CODE)))))
|
||||
(RPAQQ \\MAXTHINCHAR 255)
|
||||
(RPAQQ \\MAXFATCHAR 65535)
|
||||
(RPAQQ \\MAXCHARSET 255)
|
||||
(RPAQQ NSCHARSETSHIFT 255)
|
||||
(RPAQQ \#STRINGPWORDS 4)
|
||||
(CONSTANTS (\\CHARMASK 255) (\\MAXCHAR 255) (\\MAXTHINCHAR 255) (\\MAXFATCHAR 65535) (\\MAXCHARSET 255
|
||||
) (NSCHARSETSHIFT 255) (\#STRINGPWORDS 4))
|
||||
) (\#STRINGPWORDS 4))
|
||||
(PUTPROPS \\NATOMCHARS DMACRO ((AT) (|fetch| (LITATOM PNAMELENGTH) |of| AT)))
|
||||
(PUTPROPS \\NSTRINGCHARS DMACRO ((S) (|fetch| (STRINGP LENGTH) |of| S)))
|
||||
(PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLCHAR) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:37:02"))
|
||||
|
||||
(ACCESSFNS BF ((BFBLOCK (ADDSTACKBASE DATUM))) (* \; "basic frame pointer") (BLOCKRECORD BFBLOCK ((
|
||||
FLAGS BITS 3) (NIL BITS 3) (RESIDUAL FLAG) (* \; "true if this is not a full BF") (PADDING BITS 1) (
|
||||
@@ -1350,7 +1334,7 @@ BINDNEGVALUES |of| DATUM) 65535))))))
|
||||
(RPAQQ \\NT.PVAR 128)
|
||||
(RPAQQ \\NT.FVAR 192)
|
||||
(CONSTANTS \\NT.IVAR \\NT.PVAR \\NT.FVAR)
|
||||
(PUTPROP (QUOTE LLSTK) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLSTK) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS WORDCONTENTS BYTEMACRO ((PTR) (\\GETBASE PTR 0)))
|
||||
(PUTPROPS SETWORDCONTENTS BYTEMACRO ((PTR N) (\\PUTBASE PTR 0 N)))
|
||||
@@ -1359,7 +1343,7 @@ BINDNEGVALUES |of| DATUM) 65535))))))
|
||||
|fetch| CBUFDIRTY |of| STREAM) (\\SETIODIRTY STREAM (|fetch| CPAGE |of| STREAM)) (|replace| CBUFDIRTY
|
||||
|of| STREAM |with| NIL))) (|replace| CBUFSIZE |of| STREAM |with| 0) (|replace| CBUFPTR |of| STREAM
|
||||
|with| NIL))))
|
||||
(PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE PMAP) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:37:14"))
|
||||
|
||||
(PUTPROPS ADDREF MACRO (OPENLAMBDA (PTR) (PROG1 PTR (\\ADDREF PTR))))
|
||||
(PUTPROPS \\ADDREF DMACRO ((X) ((OPCODES GCREF 0) X)))
|
||||
@@ -1389,7 +1373,7 @@ DATUM 0) -2) (\\PUTBASEFIXP DATUM 0 (LOGOR NEWVALUE 1))))))
|
||||
) (FREEPTR FIXP) (* \; "The GC table entry") (NEXTFREE FIXP) (* \;
|
||||
"If the entry is in use, points to the next entry in this collision chain. If not, offset (in 1/2-entries) of the next free one on the chain."
|
||||
)))
|
||||
(PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLGC) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS \\SYNCODE DMACRO (OPENLAMBDA (TABLE CHAR) (CHECK (|type?| CHARTABLE TABLE)) (* \;
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC") (COND ((IGREATERP CHAR \\MAXTHINCHAR) (OR (AND (|fetch|
|
||||
@@ -1500,7 +1484,7 @@ FLAG) (DISPATCHMACRODEFS POINTER) (* \;
|
||||
"The character code used in this read table for multiple escape") (PACKAGECHAR BYTE) (* \;
|
||||
"The character code used in this read table for package delimiter") (READTBLNAME POINTER) (* \;
|
||||
"The canonical 'name' of this read table")) READSA _ (|create| CHARTABLE))
|
||||
(PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE ATBL) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:38:55"))
|
||||
|
||||
(DATATYPE STREAM ((* |;;|
|
||||
"First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now."
|
||||
@@ -1543,33 +1527,21 @@ IMAGEOPS POINTER) (* \; "Image operations vector") (IMAGEDATA POINTER) (* \;
|
||||
"Max # of buffers the system will allocate.") (LASTCCODE WORD) (* \;
|
||||
"After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535."
|
||||
) (EXTRASTREAMOP POINTER) (* \; "For use of applications programs, not devices") (INCCODEFN POINTER) (
|
||||
* \; "Set by \\EXTERNALFORMAT") (PEEKCCODEFN POINTER) (BACKCHARFN POINTER)) (BLOCKRECORD STREAM ((NIL
|
||||
2 WORD) (UCODEFLAGS1 BITS 1) (* |;;| "respecification of access bits:") (RANDOMWRITEABLE FLAG) (* \;
|
||||
"File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* \;
|
||||
* \; "Set by \\EXTERNALFORMAT") (PEEKCCODEFN POINTER) (BACKCCODEFN POINTER) (EXTERNALFORMAT POINTER))
|
||||
(BLOCKRECORD STREAM ((NIL 2 WORD) (UCODEFLAGS1 BITS 1) (* |;;| "respecification of access bits:") (
|
||||
RANDOMWRITEABLE FLAG) (* \; "File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* \;
|
||||
"File open for append (OUTPUT or APPEND or BOTH)") (READABLE FLAG) (* \;
|
||||
"File open for read (READ or BOTH)") (NIL POINTER))) (BLOCKRECORD STREAM ((NIL 4 WORD) (NIL BITS 14) (
|
||||
* |;;| "JIS character encoding format specific, overrides CHARSET field.") (IN.KANJIIN FLAG) (* \;
|
||||
"True if input stream is in Kanji-in mode.") (OUT.KANJIIN FLAG) (* \;
|
||||
"True if output stream is in Kanji-in mode."))) (ACCESSFNS STREAM ((ACCESS \\GETACCESS \\SETACCESS) (
|
||||
FULLNAME (OR (|fetch| (STREAM FULLFILENAME) |of| DATUM) DATUM)) (NAMEDP (AND (|fetch| (STREAM
|
||||
FULLFILENAME) |of| DATUM) T)))) (ACCESSFNS STREAM (EXTERNALFORMAT (LISTGET (|ffetch| (STREAM
|
||||
OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT)) (LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)
|
||||
)) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (QUOTE EXTERNALFORMAT
|
||||
) NEWVALUE)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE EXTERNALFORMAT)
|
||||
NEWVALUE)))) (|freplace| (STREAM OUTCHARFN) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT FILEOUTCHARFN)
|
||||
|of| NEWVALUE)) (AND (|ffetch| (EXTERNALFORMAT EOLVALID) |of| NEWVALUE) (|freplace| (STREAM
|
||||
EOLCONVENTION) |of| DATUM |with| (|ffetch| (EXTERNALFORMAT EOL) |of| NEWVALUE)))))) (ACCESSFNS STREAM
|
||||
(EXTERNALFORMAT.NAME (LISTGET (|ffetch| (STREAM OTHERPROPS) |of| DATUM) (QUOTE EXTERNALFORMAT.NAME)) (
|
||||
LET ((PROPS (|ffetch| (STREAM OTHERPROPS) |of| DATUM)) (NAME (COND ((LITATOM NEWVALUE) NEWVALUE) (T (
|
||||
MKATOM NEWVALUE))))) (|freplace| (STREAM NOTXCCS) |of| DATUM |with| T) (COND (PROPS (LISTPUT PROPS (
|
||||
QUOTE EXTERNALFORMAT.NAME) NAME)) (T (|freplace| (STREAM OTHERPROPS) |of| DATUM |with| (LIST (QUOTE
|
||||
EXTERNALFORMAT.NAME) NAME))))))) (ACCESSFNS STREAM (FILEOUTCHARFN (|ffetch| (STREAM OUTCHARFN) |of|
|
||||
DATUM))) (SYNONYM CBUFPTR (CPPTR)) USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ |NoBits| CPAGE _ 0
|
||||
EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE (GLOBALVARS
|
||||
\\STREAM.DEFAULT.MAXBUFFERS)) \\STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ (LET NIL (
|
||||
DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) OUTCHARFN _ (FUNCTION \\FILEOUTCHARFN)
|
||||
ENDOFSTREAMOP _ (FUNCTION \\EOSERROR) IMAGEOPS _ \\NOIMAGEOPS EOLCONVENTION _ LF.EOLC STRMBINFN _ (
|
||||
FUNCTION \\STREAM.NOT.OPEN) STRMBOUTFN _ (FUNCTION \\STREAM.NOT.OPEN) LASTCCODE _ 65535 NOTXCCS _ NIL)
|
||||
FULLFILENAME) |of| DATUM) T)))) (SYNONYM CBUFPTR (CPPTR)) USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS
|
||||
_ |NoBits| CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE
|
||||
(GLOBALVARS \\STREAM.DEFAULT.MAXBUFFERS)) \\STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ (
|
||||
LET NIL (DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) ENDOFSTREAMOP _ (FUNCTION \\EOSERROR)
|
||||
IMAGEOPS _ \\NOIMAGEOPS EOLCONVENTION _ LF.EOLC STRMBINFN _ (FUNCTION \\STREAM.NOT.OPEN) STRMBOUTFN _
|
||||
(FUNCTION \\STREAM.NOT.OPEN) LASTCCODE _ 65535 NOTXCCS _ NIL)
|
||||
(PUTPROPS STREAMOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
|
||||
QUOTE QUOTE)) (LIST (QUOTE |fetch|) (CADAR ARGS) (QUOTE |of|) (CADR ARGS))) (T (HELP
|
||||
"STREAMOP - OPNAME not quoted:" ARGS))) (CDDR ARGS)))))
|
||||
@@ -1579,9 +1551,8 @@ QUOTE QUOTE)) (LIST (QUOTE |fetch|) (CADAR ARGS) (QUOTE |of|) (CADR ARGS))) (T (
|
||||
(RPAQQ |WriteBit| 4)
|
||||
(RPAQ |OutputBits| (LOGOR |AppendBit| |WriteBit|))
|
||||
(RPAQ |BothBits| (LOGOR |ReadBit| |OutputBits|))
|
||||
(RPAQQ \\NORUNCODE 255)
|
||||
(CONSTANTS |AppendBit| |NoBits| |ReadBit| |WriteBit| (|OutputBits| (LOGOR |AppendBit| |WriteBit|)) (
|
||||
|BothBits| (LOGOR |ReadBit| |OutputBits|)) \\NORUNCODE)
|
||||
|BothBits| (LOGOR |ReadBit| |OutputBits|)))
|
||||
(PUTPROPS |TestMasked| MACRO ((BITS MASK) (NEQ (LOGAND BITS MASK) 0)))
|
||||
(PUTPROPS APPENDABLE MACRO ((STREAM) (|TestMasked| (|fetch| ACCESSBITS |of| STREAM) |AppendBit|)))
|
||||
(PUTPROPS APPENDONLY MACRO ((STREAM) (EQ (|fetch| ACCESSBITS |of| STREAM) |AppendBit|)))
|
||||
@@ -1593,15 +1564,12 @@ QUOTE QUOTE)) (LIST (QUOTE |fetch|) (CADAR ARGS) (QUOTE |of|) (CADR ARGS))) (T (
|
||||
(PUTPROPS READONLY MACRO ((STREAM) (EQ (|fetch| ACCESSBITS |of| STREAM) |ReadBit|)))
|
||||
(PUTPROPS WRITEABLE MACRO ((STREAM) (OR (OVERWRITEABLE STREAM) (AND (APPENDABLE STREAM) (\\EOFP STREAM
|
||||
)))))
|
||||
(PUTPROPS \\RUNCODED MACRO (OPENLAMBDA (STREAM) (* |;;|
|
||||
"returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented"
|
||||
) (* \; "note that neq is ok since charsets are known to be SMALLP's") (NEQ (|fetch| CHARSET |of|
|
||||
STREAM) \\NORUNCODE)))
|
||||
(RPAQQ EOLCONVENTIONS ((CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2)))
|
||||
(RPAQQ EOLCONVENTIONS ((CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2) (ANY.EOLC 3)))
|
||||
(RPAQQ CR.EOLC 0)
|
||||
(RPAQQ LF.EOLC 1)
|
||||
(RPAQQ CRLF.EOLC 2)
|
||||
(CONSTANTS (CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2))
|
||||
(RPAQQ ANY.EOLC 3)
|
||||
(CONSTANTS (CR.EOLC 0) (LF.EOLC 1) (CRLF.EOLC 2) (ANY.EOLC 3))
|
||||
(PUTPROPS FDEVOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS))
|
||||
) (COND ((AND (LISTP OPNAME) (EQ (CAR OPNAME) (QUOTE QUOTE))) (BQUOTE (SPREADAPPLY* (|fetch| (FDEV (
|
||||
\\\, (CADR OPNAME))) |of| (\\\, METHOD-DEVICE)) (\\\,@ TAIL)))) (T (ERROR "OPNAME not quoted: " OPNAME
|
||||
@@ -1648,9 +1616,10 @@ POINTER) (* \;
|
||||
BREAKCONNECTION POINTER) (* \; "(host fastp dev) => closes connections to host") (* |;;|
|
||||
"-----The following are required methods for operating on open streams-----") (BIN POINTER) (* \;
|
||||
"(stream) => next byte of input") (BOUT POINTER) (* \; "(stream byte) output byte to stream") (PEEKBIN
|
||||
POINTER) (* \; "(stream) => next byte without advancing position in stream") (READCHAR POINTER) (* \;
|
||||
"(stream) => next input char") (WRITECHAR POINTER) (* \; "(stream char) => writes char to stream") (
|
||||
PEEKCHAR POINTER) (UNREADCHAR POINTER) (READP POINTER) (* \;
|
||||
POINTER) (* \; "(stream) => next byte without advancing position in stream") (NIL POINTER) (* \;
|
||||
"Was READCHAR, replaced by READCHARCODE") (NIL POINTER) (* \;
|
||||
"Was WRITECHAR (stream char) => writes char to stream") (NIL POINTER) (* \; "Was PEEKCHAR") (NIL
|
||||
POINTER) (* \; "Was UNREADCHAR") (READP POINTER) (* \;
|
||||
"(stream flag) => T if there is input available from stream right now") (EOFP POINTER) (* \;
|
||||
"(stream) => T if BIN would signal eof.") (BLOCKIN POINTER) (* \; "(stream buffer byteoffset nbytes)")
|
||||
(BLOCKOUT POINTER) (* \; "(stream buffer byteoffset nbytes)") (FORCEOUTPUT POINTER) (* \;
|
||||
@@ -1679,26 +1648,27 @@ TRUNCATEFILE POINTER) (* \;
|
||||
"(stream page offset) make stream's eof be at page,offset, discarding anything after it") (* |;;|
|
||||
"-----For window system, argh-----") (WINDOWOPS POINTER) (* \; "window system operations") (WINDOWDATA
|
||||
POINTER) (* \; "data for window systems") (* |;;|
|
||||
"-----For any stream (here to not recompile everything)-----") (READCHARCODE POINTER) (* \;
|
||||
"Read a character code from the stream (cf BIN for bytes).")) DIRECTORYNAMEP _ (FUNCTION NILL)
|
||||
HOSTNAMEP _ (FUNCTION NILL) READP _ (FUNCTION \\GENERIC.READP) SETFILEPTR _ (FUNCTION
|
||||
\\IS.NOT.RANDACCESSP) GETFILEPTR _ (FUNCTION \\ILLEGAL.DEVICEOP) GETEOFPTR _ (FUNCTION
|
||||
"-----For any stream (here to not recompile everything)-----") (NIL POINTER) (* \;
|
||||
"Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).")) DIRECTORYNAMEP _ (
|
||||
FUNCTION NILL) HOSTNAMEP _ (FUNCTION NILL) READP _ (FUNCTION \\GENERIC.READP) SETFILEPTR _ (FUNCTION
|
||||
\\IS.NO.RANDACCESSP) GETFILEPTR _ (FUNCTION \\ILLEGAL.DEVICEOP) GETEOFPTR _ (FUNCTION
|
||||
\\IS.NOT.RANDACCESSP) EOFP _ (FUNCTION \\ILLEGAL.DEVICEOP) BLOCKIN _ (FUNCTION \\GENERIC.BINS)
|
||||
BLOCKOUT _ (FUNCTION \\GENERIC.BOUTS) RENAMEFILE _ (FUNCTION \\GENERIC.RENAMEFILE) FORCEOUTPUT _ (
|
||||
FUNCTION NILL) REGISTERFILE _ (FUNCTION NILL) OPENP _ (FUNCTION NILL) UNREGISTERFILE _ (FUNCTION NILL)
|
||||
READCHAR _ (FUNCTION \\GENERIC.READCHAR) WRITECHAR _ (FUNCTION \\GENERIC.WRITECHAR) PEEKCHAR _ (
|
||||
FUNCTION \\GENERIC.PEEKCHAR) UNREADCHAR _ (FUNCTION \\GENERIC.UNREADCHAR) CHARSETFN _ (FUNCTION
|
||||
\\GENERIC.CHARSET) BREAKCONNECTION _ (FUNCTION NILL) READCHARCODE _ (FUNCTION \\GENERIC.READCCODE))
|
||||
CHARSETFN _ (FUNCTION \\GENERIC.CHARSET) BREAKCONNECTION _ (FUNCTION NILL))
|
||||
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* \;
|
||||
"If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream.") (EOL
|
||||
BITS 2) (NIL BITS 1) (INCCODEFN POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (
|
||||
PEEKCCODEFN POINTER) (* \; "Called with three arguments -- STREAM, NOERROR and COUNTP") (BACKCHARFN
|
||||
POINTER) (* \; "Called with two arguments -- STREAM and COUNTP") (FILEOUTCHARFN POINTER) (* \;
|
||||
"If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)"
|
||||
) (EOL BITS 2) (NIL BITS 1) (INCCODEFN POINTER) (* \;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL") (PEEKCCODEFN POINTER) (*
|
||||
\; "Called with three arguments -- STREAM, NOERROR, and EOL") (BACKCCODEFN POINTER) (* \;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL") (OUTCHARFN POINTER) (* \;
|
||||
"Called with two arguments -- STREAM and CHARCODE") (NAME POINTER) (* \;
|
||||
"keyword name of this format, provided to \\INSTALL.EXTERNALFORMAT")) EOLVALID _ NIL)
|
||||
(PUTPROPS \\OUTCHAR DMACRO (OPENLAMBDA (STREAM CHARCODE) (STREAMOP (QUOTE OUTCHARFN) STREAM STREAM
|
||||
CHARCODE)))
|
||||
"keyword name of this format, provided to \\INSTALL.EXTERNALFORMAT") (FORMATBYTESTREAMFN POINTER (* \;
|
||||
|
||||
"Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined"
|
||||
))))
|
||||
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
|
||||
(PUTPROPS \\DEVICE-OPEN-STREAMS MACRO (ARGS (LET ((DEVICE (CAR ARGS))) (BQUOTE (FDEVOP (QUOTE OPENP) (
|
||||
\\\, DEVICE) NIL NIL (\\\, DEVICE))))))
|
||||
(PUTPROPS \\CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?) (* |;;|
|
||||
@@ -1719,6 +1689,9 @@ STREAM))))
|
||||
DEVICE) |of| STRM) STRM BASE OFF NBYTES)))
|
||||
(PUTPROPS \\BOUTS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) (FDEVOP (QUOTE BLOCKOUT) (|fetch| (
|
||||
STREAM DEVICE) |of| STRM) STRM BASE OFF NBYTES)))
|
||||
(PUTPROPS \\BOUTEOL MACRO (OPENLAMBDA (STRM) (SELECTC (FETCH (STREAM EOLCONVENTION) OF STRM) (LF.EOLC
|
||||
(\\BOUT STRM (CHARCODE LF))) (CR.EOLC (\\BOUT STRM (CHARCODE CR))) (CRLF.EOLC (\\BOUT STRM (CHARCODE
|
||||
CR)) (\\BOUT STRM (CHARCODE LF))) (ANY.EOLC (SHOULDNT)) NIL)))
|
||||
(PUTPROPS \\EOFP BYTEMACRO (OPENLAMBDA (STRM) (FDEVOP (QUOTE EOFP) (|fetch| (STREAM DEVICE) |of| STRM)
|
||||
STRM)))
|
||||
(PUTPROPS SIZE.FROM.LENGTH MACRO (LAMBDA (LEN) (DECLARE (LOCALVARS LEN)) (AND LEN (FOLDHI LEN
|
||||
@@ -1732,7 +1705,7 @@ BYTESPERPAGE))))
|
||||
(ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) (OFFSET (MOD DATUM BYTESPERPAGE))) (TYPE? (AND
|
||||
(FIXP DATUM) (IGEQ DATUM 0) (ILEQ DATUM \\MAXFILEPTR))) (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE)
|
||||
OFFSET)))
|
||||
(PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE FILEIO) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:38:55"))
|
||||
|
||||
(BLOCKRECORD FIXP ((HINUM WORD) (LONUM WORD)) (CREATE (CREATECELL \\FIXP)) (TYPE? (EQ (NTYPX DATUM)
|
||||
\\FIXP)))
|
||||
@@ -1764,7 +1737,7 @@ ADD1 (IDIFFERENCE MAX.SMALL.INTEGER HY)))) (T (IPLUS HX HY)))) (* |Add| |high| |
|
||||
COND ((EQ HX MAX.SMALL.INTEGER) 0) (T (ADD1 HX)))) (IDIFFERENCE LX (ADD1 (IDIFFERENCE
|
||||
MAX.SMALL.INTEGER LY)))) (T (IPLUS LX LY)))) (\\PUTBASE X 0 HX) (RETURN X))))
|
||||
(PUTPROPS |PutUnboxed| DMACRO (= . \\PUTFIXP))
|
||||
(PUTPROP (QUOTE LLARITH) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLARITH) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS POLYEVAL DMACRO ((X COEFFS DEGREE) (* \;
|
||||
"execute the POLYEVAL opcode on the value X, the array COEFFS with degree DEGREE") (\\FLOATBOX ((
|
||||
@@ -1787,7 +1760,7 @@ FX NEXTBLOCK) |of| AL)) (\\\,@ (|for| X |in| (REVERSE ARGS) |collect| (LET ((FOR
|
||||
SETQ (\\\, (CAR X)) (\\FLOATBOX (\\\, FORMS))))) (T (BQUOTE (SETQ (\\\, X) (\\\, FORMS)))))))) (
|
||||
\\MAKEFREEBLOCK NEXT (TIMES (\\\, (LENGTH ARGS)) WORDSPERCELL)) (|replace| (FX NEXTBLOCK) |of| AL
|
||||
|with| NEXT) (PROGN (\\\,@ FORMS))))))))
|
||||
(PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLFLOAT) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(DEFOPTIMIZER FONTPROP (&REST ARGS) (SELECTQ (AND (EQ (CAADR ARGS) (QUOTE QUOTE)) (CADADR ARGS)) (
|
||||
ASCENT (LIST (QUOTE FONTASCENT) (CAR ARGS))) (DESCENT (LIST (QUOTE FONTDESCENT) (CAR ARGS))) (HEIGHT (
|
||||
@@ -1854,7 +1827,7 @@ WIDTH)))
|
||||
CHAR8CODE))))
|
||||
(RPAQQ \\MAXNSCHAR 65535)
|
||||
(CONSTANTS (\\MAXNSCHAR 65535))
|
||||
(PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE FONT) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(BLOCKRECORD KEYACTION ((* |;;|
|
||||
"KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage."
|
||||
@@ -1902,7 +1875,7 @@ YPOS)))))
|
||||
\\EM.KBDAD1 \\EM.KBDAD2 \\EM.KBDAD3 \\EM.KBDAD4 \\EM.KBDAD5 \\EM.DISPINTERRUPT \\EM.DISPLAYHEAD
|
||||
\\EM.CURSORBITMAP \\MACHINETYPE \\DEFAULTKEYACTION \\COMMANDKEYACTION \\CURRENTKEYACTION
|
||||
\\PERIODIC.INTERRUPT \\PERIODIC.INTERRUPT.FREQUENCY)
|
||||
(PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLKEY) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:27:52"))
|
||||
|
||||
(DATATYPE PILOTBBT ((PBTDESTLO WORD) (PBTDESTHI WORD) (PBTDESTBIT WORD) (PBTDESTBPL SIGNEDWORD) (
|
||||
PBTSOURCELO WORD) (PBTSOURCEHI WORD) (PBTSOURCEBIT WORD) (PBTSOURCEBPL SIGNEDWORD) (PBTWIDTH WORD) (
|
||||
@@ -2003,7 +1976,7 @@ IGNOREMACRO))))
|
||||
(PUTPROPS DISPLAYSTARTEDP MACRO (NIL |\\DisplayStarted|))
|
||||
(GLOBALVARS |\\DisplayStarted| |\\DisplayStreamsInitialized| |\\DisplayInitialed| WHOLEDISPLAY
|
||||
WHOLESCREEN SCREENWIDTH SCREENHEIGHT)
|
||||
(PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLDISPLAY) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(RECORD REGION (LEFT BOTTOM WIDTH HEIGHT) LEFT _ -16383 BOTTOM _ -16383 WIDTH _ 32767 HEIGHT _ 32767 (
|
||||
ACCESSFNS ((TOP (IPLUS (|fetch| (REGION BOTTOM) |of| DATUM) (|fetch| (REGION HEIGHT) |of| DATUM) -1))
|
||||
@@ -2048,7 +2021,7 @@ PRINTCURSOR))))))))
|
||||
(ADDTOVAR GLOBALVARS GRAYSHADE)
|
||||
(RECORD HLS (HUE LIGHTNESS SATURATION))
|
||||
(RECORD RGB (RED GREEN BLUE))
|
||||
(PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE ADISPLAY) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:36:17"))
|
||||
|
||||
(ADDTOVAR SYSSPECVARS \\INTERRUPTABLE)
|
||||
(PUTPROPS UNINTERRUPTABLY INFO EVAL)
|
||||
@@ -2073,7 +2046,7 @@ BITS 8) (* \; "Mask to prevent re-interrupt for an interrupt in progress") (NIL
|
||||
(PUTPROPS \\TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) (DECLARE (GLOBALVARS \\PENDINGINTERRUPT)) (COND (
|
||||
(AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) PREFORM ((LAMBDA (\\INTERRUPTABLE) (
|
||||
\\CALLINTERRUPTED)) T) POSTFORM))))
|
||||
(PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE AINTERRUPT) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(PUTPROPS UNLESSRDSYS MACRO ((NORMAL RDSYS) NORMAL))
|
||||
(PUTPROPS UNLESSINEW MACRO ((NORMAL I-NEW) NORMAL))
|
||||
@@ -2094,7 +2067,7 @@ BITS 8) (* \; "Mask to prevent re-interrupt for an interrupt in progress") (NIL
|
||||
(PUTPROPS VAG2 DMACRO (= . \\VAG2))
|
||||
(PUTPROPS PAGEBASE MACRO ((PTR) (|fetch| (POINTER PAGEBASE) |of| PTR)))
|
||||
(PUTPROPS PAGELOC MACRO (OPENLAMBDA (PTR) (IPLUS (LLSH (\\HILOC PTR) 8) (LRSH (\\LOLOC PTR) 8))))
|
||||
(PUTPROP (QUOTE RENAMEMACROS) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE RENAMEMACROS) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS MOUSESTATE MACRO (ARGS (LIST (QUOTE PROGN) (QUOTE (GETMOUSESTATE)) (MOUSESTATE-EXPR (CAR
|
||||
ARGS) T))))
|
||||
@@ -2113,7 +2086,7 @@ ARGS)))))
|
||||
(PUTPROPS WITHIN MACRO ((A B C) (AND (IGEQ A B) (ILESSP A (IPLUS B C)))))
|
||||
(ADDTOVAR GLOBALVARS LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS)
|
||||
(PUTPROPS IABS MACRO (OPENLAMBDA (A) (COND ((IGEQ A 0) A) (T (IMINUS A)))))
|
||||
(PUTPROP (QUOTE HLDISPLAY) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE HLDISPLAY) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT)) (KEYDOWNP (QUOTE RSHIFT)) (KEYDOWNP
|
||||
(QUOTE COPY)))))
|
||||
@@ -2187,7 +2160,7 @@ SCDESTINATION) |of| DATUM) (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| (|fetch| (S
|
||||
|of| DATUM))) (T 1))) (SCREGION (|create| REGION LEFT _ 0 BOTTOM _ 0 WIDTH _ (|fetch| (SCREEN SCWIDTH)
|
||||
|of| DATUM) HEIGHT _ (|fetch| (SCREEN SCHEIGHT) |of| DATUM))))) (SYSTEM))
|
||||
(GLOBALVARS WINDOWUSERFORMS ENDOFWINDOWUSERFORMS PROMPTWINDOW)
|
||||
(PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE WINDOW) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:36:17"))
|
||||
|
||||
(PUTPROPS NNLITATOM MACRO (OPENLAMBDA (X) (AND X (LITATOM X))))
|
||||
(PUTPROPS \\NULL.OR.FIXP MACRO (OPENLAMBDA (X) (OR (NULL X) (FIXP X))))
|
||||
@@ -2202,7 +2175,7 @@ ERROR VAR MSG)))))))))
|
||||
(PUTPROPS \\MACRO.EVAL DMACRO (Z (PROG ((X (EXPANDMACRO (CAR Z) T))) (|if| (EQ X (CAR Z)) |then| (
|
||||
ERROR "No macro property -- \\MACRO.EVAL" X) |else| (RETURN (EVAL X))))))
|
||||
(DEFOPTIMIZER \\MACRO.MX (FORM) FORM)
|
||||
(PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE MACROAUX) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(RPAQQ MASK0WORD1\'S 32767)
|
||||
(RPAQQ MASK1WORD0\'S 32768)
|
||||
@@ -2274,11 +2247,11 @@ IMOD OFFST BITSPERBYTE)) 1))))
|
||||
(|if| (|if| (EQ 0 (LOGAND |\\BitMask| |\\Byte|)) |then| (NOT (EQ 0 VAL)) |else| (EQ 0 VAL)) |then| (
|
||||
\\PUTBASEBYTE BASE |\\ByteNo| (LOGXOR |\\BitMask| |\\Byte|))) VAL) (FOLDLO OFFST BITSPERBYTE) (
|
||||
MASK.1\'S (IDIFFERENCE (CONSTANT (SUB1 BITSPERBYTE)) (IMOD OFFST BITSPERBYTE)) 1))))
|
||||
(PUTPROP (QUOTE ADDARITH) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE ADDARITH) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(RPAQQ \\MAXFILEPAGE 65534)
|
||||
(CONSTANTS \\MAXFILEPAGE)
|
||||
(PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLFAULT) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS \\UPDATETIMERS MACRO (NIL (* * |Moves| |excess| |time| |from| |the| |processor| |clock| |to|
|
||||
|our| |software| |clocks.| |Needs| |to| |be| |run| |often,| |uninterruptably,| |preferably| |from|
|
||||
@@ -2307,7 +2280,7 @@ SECONDSCLOCK |of| \\MISCSTATS)) 1) T))))))
|
||||
62500))
|
||||
(PUTPROPS ALTO.TO.LISP.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
|
||||
(PUTPROPS LISP.TO.ALTO.DATE MACRO ((DATE) (LOGXOR DATE -2147483648)))
|
||||
(PUTPROP (QUOTE LLTIMER) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLTIMER) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR) BRUSHSHAPE _ (QUOTE ROUND) BRUSHSIZE _ 1)
|
||||
(PUTPROPS IMAGEOP MACRO (ARGS (CONS (QUOTE SPREADAPPLY*) (CONS (COND ((EQ (CAR (LISTP (CAR ARGS))) (
|
||||
@@ -2342,7 +2315,7 @@ _ (FUNCTION NILL) IMTRANSLATE _ (FUNCTION NILL) IMPUSHSTATE _ (FUNCTION NILL) IM
|
||||
NILL) IMSCALE2 _ (FUNCTION NILL) IMDEFAULTSTATE _ (FUNCTION NILL) IMBLTCHAR _ (FUNCTION \\MEDW.BLTCHAR
|
||||
) IMXOFFSET _ (FUNCTION \\MEDW.XOFFSET) IMYOFFSET _ (FUNCTION \\MEDW.YOFFSET))
|
||||
(GLOBALVARS \\NOIMAGEOPS)
|
||||
(PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE IMAGEIO) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(DATATYPE PROCESS ((PROCFX0 WORD) (* \; "= \\STACKHI to make this look like a STACKP") (PROCFX WORD) (
|
||||
* \; "Stack pointer to this context when it is asleep") (PROCSTATUS BYTE) (* \; "Running or waiting")
|
||||
@@ -2382,167 +2355,30 @@ _ (CREATECELL \\FIXP) PROCFX0 _ \\STACKHI)
|
||||
(PUTPROPS TTY.PROCESSP MACRO (X (COND ((CAR X) (QUOTE IGNOREMACRO)) (T (QUOTE (OR (NULL (THIS.PROCESS)
|
||||
) (EQ (THIS.PROCESS) (TTY.PROCESS))))))))
|
||||
(GLOBALVARS \\RUNNING.PROCESS \\TTY.PROCESS \\PROC.RESTARTME \\PROC.RESETME \\PROC.ABORTME)
|
||||
(PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE PROC) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(PUTPROPS \\BACKCHAR MACRO (OPENLAMBDA (STREAM) (* \; "Backs up over an NS character") (\\BACKNSCHAR
|
||||
STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256))))
|
||||
(PUTPROPS \\BACKNSCHAR MACRO ((ST SHIFTEDCHARSET COUNTERVAR) (COND ((\\XCCSP ST) (\\BACKXCCSCHAR ST
|
||||
SHIFTEDCHARSET COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR (
|
||||
CL:FUNCALL (|ffetch| (STREAM BACKCHARFN) |of| ST) ST T)))) (T (CL:FUNCALL (|ffetch| (STREAM BACKCHARFN
|
||||
) |of| ST) ST NIL)))))))
|
||||
(PUTPROPS \\CHECKEOLC MACRO (OPENLAMBDA (CH EOLC STREAM PEEKBINFLG COUNTERVAR) (* |;;|
|
||||
"Subtracts number of bytes read from COUNTERVAR, which may be NIL. In fact, should be NIL if PEEKBINFLG is T."
|
||||
) (SELCHARQ CH (CR (SELECTC EOLC (CR.EOLC (CHARCODE EOL)) (CRLF.EOLC (COND (PEEKBINFLG (* |;;|
|
||||
"T from PEEKC, compile-time constant. In this case, must leave the fileptr where it was, except for possibly advancing over character set shifts"
|
||||
) (COND ((EQ (CHARCODE LF) (UNINTERRUPTABLY (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256)) (*
|
||||
|;;|
|
||||
"Read the NS CR. We know that there aren't any font-shift characters in front of the CR, because they would have already been read by the \\NSPEEK that got the CR character. Since we are going to NS back the CR character, we don't need to update the counter variable"
|
||||
) (PROG1 (\\PEEKBIN STREAM T) (* |;;|
|
||||
"LF must be in next BYTE after NS CR, regardless of coding. Character-set shifting bytes can't intervene. Then we back up over the CR that was \\NSINed above."
|
||||
) (\\BACKNSCHAR STREAM)))) (CHARCODE EOL)) (T (CHARCODE CR)))) ((EQ (CHARCODE LF) (\\PEEKBIN STREAM T)
|
||||
) (\\BIN STREAM) (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (SUB1 COUNTERVAR))) (CHARCODE EOL)) (T (
|
||||
CHARCODE CR)))) (CHARCODE CR))) (LF (COND ((EQ EOLC LF.EOLC) (CHARCODE EOL)) (T (CHARCODE LF)))) CH)))
|
||||
(PUTPROPS \\INCHAR MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") (
|
||||
\\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (FFETCH EOLCONVENTION
|
||||
OF STREAM) STREAM NIL COUNTERVAR)))
|
||||
(PUTPROPS \\INCCODE MACRO (OPENLAMBDA (STREAM COUNTERVAR) (* \; "returns a 16 bit character code") (
|
||||
\\CHECKEOLC (\\NSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM) 256) NIL COUNTERVAR) (|ffetch|
|
||||
EOLCONVENTION |of| STREAM) STREAM NIL COUNTERVAR)))
|
||||
(PUTPROPS \\PEEKCCODE MACRO (OPENLAMBDA (STREAM NOERROR) (\\CHECKEOLC (\\NSPEEK STREAM (UNFOLD (
|
||||
ACCESS-CHARSET STREAM) 256) NIL NOERROR) (|ffetch| EOLCONVENTION |of| STREAM) STREAM T)))
|
||||
(PUTPROPS \\NSIN MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;|
|
||||
"Dispatches to the appropriate character code decoder. If you want to support a new character encoding format, you have to write a decoder and add it here."
|
||||
) (COND ((\\XCCSP ST) (\\XCCSIN ST SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)) (T (COND ((QUOTE COUNTERVAR
|
||||
) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM INCCODEFN) |of| ST) ST T) (AND NUM
|
||||
(SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (STREAM INCCODEFN)
|
||||
|of| ST) ST NIL)))))))
|
||||
(PUTPROPS \\NSPEEK MACRO ((ST SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;;|
|
||||
"Dispatches to the appropriate character code decoder. If you want to support a new character encoding format, you have to write a decoder and add it here."
|
||||
) (COND ((\\XCCSP ST) (\\XCCSPEEK ST (UNFOLD (ACCESS-CHARSET ST) 256) NIL NOERROR)) (T (COND ((QUOTE
|
||||
COUNTERVAR) (CL:MULTIPLE-VALUE-BIND (CODE NUM) (CL:FUNCALL (|ffetch| (STREAM PEEKCCODEFN) |of| ST) ST
|
||||
NOERROR T) (AND NUM (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR NUM))) CODE)) (T (CL:FUNCALL (|ffetch| (
|
||||
STREAM PEEKCCODEFN) |of| ST) ST NOERROR NIL)))))))
|
||||
(PUTPROPS NUMERIC-CHARSET MACRO (= . ACCESS-CHARSET))
|
||||
(PUTPROPS \\CONV.JIS.TO.XCCS MACRO (OPENLAMBDA (KU TEN) (* |;;;|
|
||||
"Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS."
|
||||
) (COND ((\\NOT.EQUIVALENT.TO.XCCS KU) (\\DO.CONV.JIS.TO.XCCS KU TEN)) (T (LOGOR (UNFOLD KU 256) TEN))
|
||||
)))
|
||||
(PUTPROPS \\DO.CONV.JIS.TO.XCCS MACRO ((KU TEN) (* |;;;|
|
||||
" Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
|
||||
(COND ((\\INVALID.TENP TEN) *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (SELECTQ KU ((33 34 38) (* \;
|
||||
"1, 2 and 6 KU") (LET* ((CONVTABLE (\\EXTARACT.CONV.TABLE KU)) (SET (\\EXTRACT.SET TEN CONVTABLE)) (
|
||||
CODE (\\EXTRACT.CODE TEN CONVTABLE))) (COND ((NEQ SET 255) (LOGOR (UNFOLD SET 256) CODE)) (T (COND ((
|
||||
EQ CODE 255) (* \; "Not defined in JIS.") *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (* \;
|
||||
"Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.") (COND (
|
||||
*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU
|
||||
256) TEN)))))))))) (35 (* \; "3 KU") (* \;
|
||||
"Alpha numeric codes are all defined as single byte codes in XCCS.") TEN) (40 (* \; "8 KU") (COND ((<
|
||||
0 TEN 33) (COND (*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*) (T (\\EXTRACT.NO.FONT.CODE (
|
||||
LOGOR KU TEN))))) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (116 (* \; "84 KU") (COND ((< 0 TEN 5) (LOGOR
|
||||
29952 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) (117 (* \; "85 KU") (COND ((< 0 TEN 28) (LOGOR
|
||||
29696 TEN)) (T *DEFAULT-NOT-CONVERTED-FAT-CODE*))) *DEFAULT-NOT-CONVERTED-FAT-CODE*)))))
|
||||
(PUTPROPS \\CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC) (* |;;;|
|
||||
"Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode."
|
||||
) (OR (COND ((\\ASCIIP CC) CC) ((\\NOT.EQUIVALENT.TO.JIS CC) (\\DO.CONV.XCCS.TO.JIS CC)) ((
|
||||
\\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM) (* \;
|
||||
"ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.") (\\CONV.ZENKAKU.KANA CC)) (
|
||||
T CC)) CC)))
|
||||
(PUTPROPS \\DO.CONV.XCCS.TO.JIS MACRO ((CC) (GETHASH CC *XCCS-TO-JIS-CONV-TABLE*)))
|
||||
(PUTPROPS \\ASCIIP MACRO (OPENLAMBDA (CC) (AND (EQ (FOLDLO CC 256) 0) (< (LOGAND CC 255) 128))))
|
||||
(PUTPROPS \\NOT.EQUIVALENT.TO.JIS MACRO (OPENLAMBDA (CC) (OR (EQ (FOLDLO CC 256) 0) (EQ (FOLDLO CC 256
|
||||
) 33) (EQ (FOLDLO CC 256) 34) (EQ (FOLDLO CC 256) 38) (EQ (FOLDLO CC 256) 40) (EQ (FOLDLO CC 256) 239)
|
||||
(EQ (FOLDLO CC 256) 241))))
|
||||
(PUTPROPS \\CONV.HANKAKU.TO.ZENKAKUP MACRO ((OUTSTREAM) (STREAMPROP OUTSTREAM :HTOZP)))
|
||||
(PUTPROPS \\CONV.ZENKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*)))
|
||||
(PUTPROPS \\XCCSIN MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR) (* |;;;|
|
||||
"returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes. COUNTERVAR if non-NIL is decremented by number of bytes read. Doesn't do EOL conversion -- \\INCHAR and \\INCCODE do that."
|
||||
) (LET ((CHAR (\\BIN STREAM)) SCSET) (COND ((EQ CHAR NSCHARSETSHIFT) (* \; "Shifting character sets")
|
||||
(ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ CHAR (\\BIN STREAM))) (AND (QUOTE
|
||||
COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \;
|
||||
"2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE
|
||||
COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ
|
||||
CHAR (\\BIN STREAM)) (SETQ SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set")
|
||||
(SETQ SHIFTEDCSETVAR (UNFOLD SCSET 256))) (T (UNFOLD SCSET 256))))) (T (SETQ SCSET SHIFTEDCSET))) (
|
||||
COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (* \;
|
||||
"just read two bytes and combine them to a 16 bit value") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (
|
||||
IDIFFERENCE COUNTERVAR 2))) (LOGOR (UNFOLD CHAR 256) (\\BIN STREAM))) (CHAR (AND (QUOTE COUNTERVAR) (
|
||||
SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 1))) (AND CHAR (LOGOR SCSET CHAR)))))))
|
||||
(PUTPROPS \\XCCSPEEK MACRO ((STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR) (* |;;|
|
||||
"Returns a 16 bit character code. Doesn't do EOL conversion--\\INCHAR does that. May actually read the character-set shift, storing the result in the stream. COUNTERVAR, if given, is updated to reflect any such bytes that are actually read"
|
||||
) (PROG ((CHAR (\\PEEKBIN STREAM NOERROR)) SCSET) (COND ((NULL CHAR) (RETURN NIL)) ((EQ CHAR
|
||||
NSCHARSETSHIFT) (* \; "CHARSETVAR=NIL means don't set") (\\BIN STREAM) (* \;
|
||||
"Consume the char shift byte") (ACCESS-CHARSET STREAM (SETQ SCSET (COND ((NEQ NSCHARSETSHIFT (SETQ
|
||||
CHAR (\\BIN STREAM))) (* \;
|
||||
"Note: no eof error check on this \\BIN -- an eof in the middle of a charset shift is an error") (AND
|
||||
(QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2))) CHAR) ((PROGN (* \;
|
||||
"2 shift-bytes means not run-encoded") (AND (QUOTE COUNTERVAR) (SETQ COUNTERVAR (IDIFFERENCE
|
||||
COUNTERVAR 3))) (EQ 0 (\\BIN STREAM))) \\NORUNCODE) (T (\\NSIN.24BITENCODING.ERROR STREAM))))) (SETQ
|
||||
SCSET (COND ((QUOTE SHIFTEDCSETVAR) (* \; "CHARSETVAR=NIL means don't set") (SETQ SHIFTEDCSETVAR (
|
||||
UNFOLD SCSET 256))) (T (UNFOLD SCSET 256)))) (COND ((NULL (SETQ CHAR (\\PEEKBIN STREAM NOERROR))) (
|
||||
RETURN NIL)))) (T (SETQ SCSET SHIFTEDCSET))) (RETURN (COND ((EQ SCSET (UNFOLD \\NORUNCODE 256)) (*
|
||||
|;;|
|
||||
"just peek two bytes and combine them to a 16 bit value. Again, is an error if we hit eof in mid-character"
|
||||
) (\\BIN STREAM) (PROG1 (LOGOR (UNFOLD CHAR 256) (\\PEEKBIN STREAM NOERROR)) (\\BACKFILEPTR STREAM)))
|
||||
(T (LOGOR SHIFTEDCSET CHAR)))))))
|
||||
(PUTPROPS \\BACKXCCSCHAR MACRO ((STREAM SHIFTEDCHARSET COUNTERVAR) (AND (\\BACKFILEPTR STREAM) (COND (
|
||||
(COND (SHIFTEDCHARSET (EQ SHIFTEDCHARSET (UNFOLD \\NORUNCODE 256))) (T (EQ \\NORUNCODE (ACCESS-CHARSET
|
||||
STREAM)))) (COND ((\\BACKFILEPTR STREAM) (AND (QUOTE COUNTERVAR) (|add| COUNTERVAR 2)) T) ((QUOTE
|
||||
COUNTERVAR) (|add| COUNTERVAR 1)))) ((QUOTE COUNTERVAR) (|add| COUNTERVAR 1))))))
|
||||
(PUTPROPS \\XCCSP MACRO (OPENLAMBDA (ST) (NOT (|ffetch| (STREAM NOTXCCS) |of| (\\DTEST ST (QUOTE
|
||||
STREAM))))))
|
||||
(PUTPROPS \\EXTRACT.NO.FONT.CODE MACRO ((JISCODE) (CDR (ASSOC JISCODE *JIS-TO-XCCS-CONV-NO-FONT-TABLE*
|
||||
))))
|
||||
(PUTPROPS \\EXTARACT.CONV.TABLE MACRO ((KU) (CDR (ASSOC KU *JIS-TO-XCCS-CONV-TABLE-LIST*))))
|
||||
(PUTPROPS \\NOT.EQUIVALENT.TO.XCCS MACRO ((KU) (* |;;;|
|
||||
" The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here."
|
||||
) (OR (EQ KU 33) (EQ KU 34) (EQ KU 35) (EQ KU 38) (EQ KU 40) (EQ KU 116) (EQ KU 117))))
|
||||
(PUTPROPS \\EXTRACT.SET MACRO ((TEN TABLE) (ELT TABLE (IDIFFERENCE (UNFOLD (IDIFFERENCE TEN 32) 2) 1))
|
||||
))
|
||||
(PUTPROPS \\EXTRACT.CODE MACRO ((TEN TABLE) (ELT TABLE (UNFOLD (IDIFFERENCE TEN 32) 2))))
|
||||
(PUTPROPS \\CHNAGE.KI.MODE MACRO (OPENLAMBDA (ST INPUTFLG ENTERP) (* |;;;|
|
||||
"INPUTFLG is true if \\CHNAGE.KI.MODE is called in the context in which ST is an input stream.") (COND
|
||||
(INPUTFLG (COND (ENTERP (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (
|
||||
T (|freplace| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))) (T (COND (ENTERP (
|
||||
|freplace| (STREAM OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| T)) (T (|freplace| (STREAM
|
||||
OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)) |with| NIL)))))))
|
||||
(PUTPROPS \\KIMODEP MACRO (OPENLAMBDA (ST INPUTFLG) (* |;;;|
|
||||
"INPUTFLG is true if \\KIMODEP is called in the context in which ST is an input stream.") (COND (
|
||||
INPUTFLG (|ffetch| (STREAM IN.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))) (T (|ffetch| (STREAM
|
||||
OUT.KANJIIN) |of| (\\DTEST ST (QUOTE STREAM)))))))
|
||||
(PUTPROPS \\HANKAKUP MACRO ((CHAR) (< 160 CHAR 224)))
|
||||
(PUTPROPS \\KANJIP MACRO ((CHAR) (< 12158 CHAR 29733)))
|
||||
(PUTPROPS \\NOTGAIJIP MACRO ((CHAR) (OR (< 8480 CHAR 10305) (< 12158 CHAR 29733))))
|
||||
(PUTPROPS \\INVALID.TENP MACRO (OPENLAMBDA (TEN) (OR (< TEN 33) (< 126 TEN))))
|
||||
(PUTPROPS \\CONV.HANKAKU.KANA MACRO ((CHAR) (GETHASH CHAR *HANKAKU-TO-ZENKAKU-CONV-TABLE*)))
|
||||
(PUTPROPS \\OUTKI MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE $)) (
|
||||
\\BOUT OUTSTREAM (CHARCODE B))))
|
||||
(PUTPROPS \\OUTKO MACRO ((STREAM) (\\BOUT OUTSTREAM (CHARCODE ESC)) (\\BOUT OUTSTREAM (CHARCODE \()) (
|
||||
\\BOUT OUTSTREAM (CHARCODE J))))
|
||||
(PUTPROPS \\CONV.SJIS.TO.JIS MACRO (OPENLAMBDA (HI LO) (* |;;;|
|
||||
"Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively."
|
||||
) (SETQ CH1 (IDIFFERENCE HI (COND ((> HI 159) 177) (T 113)))) (SETQ CH1 (IPLUS (UNFOLD CH1 2) 1)) (
|
||||
SETQ CH2 (COND ((> LO 158) (PROG1 (IDIFFERENCE LO 126) (SETQ CH1 (IPLUS CH1 1)))) (T (IDIFFERENCE LO (
|
||||
COND ((> LO 126) (IPLUS 31 1)) (T 31))))))))
|
||||
(PUTPROPS \\CONV.JIS.TO.SJIS MACRO (OPENLAMBDA (HI LO) (* |;;;|
|
||||
"Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively."
|
||||
) (SETQ CH2 (COND ((ODDP HI) (SETQ CH2 (IPLUS LO 31)) (COND ((>= CH2 127) (IPLUS CH2 1)) (T CH2))) (T
|
||||
(IPLUS LO 126)))) (SETQ CH1 (IPLUS (FOLDLO (IDIFFERENCE HI 33) 2) 129)) (AND (> CH1 159) (SETQ CH1 (
|
||||
IPLUS CH1 64)))))
|
||||
(PUTPROPS \\SJIS.KANJI.FIRST.BYTEP MACRO (OPENLAMBDA (CHAR) (OR (< 127 CHAR 160) (< 223 CHAR 256))))
|
||||
(PUTPROPS \\EUC.KANJI.FIRST.BYTEP MACRO ((CHAR) (< 160 CHAR 255)))
|
||||
(PUTPROPS \\GAIJIP MACRO ((CHAR) (EQ CHAR 143)))
|
||||
(PUTPROPS \\EUC.HANKAKUP MACRO ((CHAR) (EQ CHAR 142)))
|
||||
(PUTPROP (QUOTE LLREAD) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(RPAQQ \\NORUNCODE 255)
|
||||
(RPAQQ NSCHARSETSHIFT 255)
|
||||
(CONSTANTS (\\NORUNCODE 255) (NSCHARSETSHIFT 255))
|
||||
(PUTPROPS \\RUNCODED MACRO (OPENLAMBDA (STREAM) (* |;;|
|
||||
"returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented"
|
||||
) (* \; "note that neq is ok since charsets are known to be SMALLP's") (NEQ (|fetch| CHARSET |of|
|
||||
STREAM) \\NORUNCODE)))
|
||||
(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) (BQUOTE ((OPENLAMBDA (STRM) (FDEVOP (QUOTE
|
||||
CHARSETFN) (|fetch| (STREAM DEVICE) |of| STRM) STRM (\\\, NEWVALUE))) (\\\, STREAM))))
|
||||
(PUTPROP (QUOTE XCCS) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:37:14"))
|
||||
|
||||
(PUTPROP (QUOTE LLREAD) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:37:14"))
|
||||
|
||||
(PUTPROPS EMPASSWORDLOC DMACRO (LAMBDA NIL (* |lmm| "24-MAR-83 06:46") (|fetch| (IFPAGE |UserPswdAddr|
|
||||
) |of| |\\InterfacePage|)))
|
||||
(PUTPROPS \\DECRYPT.PWD.CHAR MACRO ((CHAR) (LOGXOR CHAR 73)))
|
||||
(PUTPROP (QUOTE PASSWORDS) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE PASSWORDS) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
(RPAQQ MICASPERINCH 2540)
|
||||
(RPAQQ MICASPERMILLIMETER 100)
|
||||
(CONSTANTS (MICASPERINCH 2540) (MICASPERMILLIMETER 100))
|
||||
(PUTPROP (QUOTE INTERPRESS) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE INTERPRESS) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:37:14"))
|
||||
|
||||
(RPAQ MICASPERPT (FQUOTIENT 2540 72))
|
||||
(RPAQQ IHALFMICASPERPT 17)
|
||||
@@ -2550,10 +2386,10 @@ IPLUS CH1 64)))))
|
||||
(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) (IMICASPERPT 35))
|
||||
(DEFMACRO \\MICASTOPTS (MICAS) (COND ((NUMBERP MICAS) (QUOTIENT MICAS MICASPERPT)) (T (BQUOTE (
|
||||
QUOTIENT (\\\, MICAS) MICASPERPT)))))
|
||||
(PUTPROP (QUOTE HARDCOPY) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE HARDCOPY) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:17:21"))
|
||||
|
||||
(FILESLOAD (SYSLOAD FROM VALUEOF DIRECTORIES) CMLARRAY-SUPPORT)
|
||||
(PUTPROP (QUOTE CMLARRAY) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE CMLARRAY) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:28"))
|
||||
|
||||
(RPAQQ \\MISCN-TABLE-LIST ((USER-SUBR 0 \\USER-SUBR-UFN T) (CL:VALUES 1 CL::VALUES-UFN NIL) (CL:SXHASH
|
||||
2 CL::SXHASH-UFN NIL) (CL::EQLHASHBITSFN 3 CL::EQLHASHBITSFN-UFN NIL) (STRINGHASHBITS 4
|
||||
@@ -2587,7 +2423,7 @@ DLD-GET-SYMBOL 171) (DLD-GET-FUNC 172) (DLD-FUNCTION-EXECUTABLE-P 173) (DLD-LIST
|
||||
) (C-MALLOC 175) (C-FREE 176) (C-PUTBASEBYTE 177) (C-GETBASEBYTE 178) (CHAR-OPENFILE 200) (CHAR-BIN
|
||||
201) (CHAR-BOUT 202) (CHAR-IOCTL 203) (CHAR-CLOSEFILE 204) (CHAR-EOFP 205) (CHAR-READP 206) (CHAR-BINS
|
||||
207) (CHAR-BOUTS 208) (CHAR-FILLBUFFER 209)))
|
||||
(PUTPROP (QUOTE LLSUBRS) (QUOTE IMPORTDATE) (IDATE " 6-May-2021 15:25:40"))
|
||||
(PUTPROP (QUOTE LLSUBRS) (QUOTE IMPORTDATE) (IDATE "27-Jul-2021 20:14:29"))
|
||||
|
||||
STOP
|
||||
|
||||
|
||||
@@ -1,16 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "22-Aug-94 13:00:22" {DSK}<king>export>lispcore>lafite>parc-94>LAFITE.;2 73704
|
||||
(FILECREATED "24-Jun-2021 19:17:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4 71992
|
||||
|
||||
previous date%: " 6-Aug-93 15:49:08" {DSK}<king>export>lispcore>lafite>parc-94>LAFITE.;1)
|
||||
changes to%: (FNS \LAFITE.EOF)
|
||||
(FILES LAFITEDECLS)
|
||||
|
||||
previous date%: "22-Aug-94 13:00:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993, 1994 by Xerox Corporation and Bolt Beranek and Newman Inc.. All rights reserved.
|
||||
Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek and Newman Inc..
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITECOMS)
|
||||
|
||||
(RPAQQ LAFITECOMS
|
||||
(RPAQQ LAFITECOMS
|
||||
[(COMS (E (SETQ LAFITESYSTEMDATE (DATE)))
|
||||
(VARS LAFITEVERSION# LAFITESYSTEMDATE))
|
||||
(COMS (FNS LAFITE LAFITE.ON.FROM.BACKGROUND \LAFITE.OFF \LAFITE.START.PROC
|
||||
@@ -70,19 +75,19 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993, 1994 by Xero
|
||||
(LAFITE.PERSONAL.VARS LAFITEDEFAULTHOST&DIR LAFITE.SIGNATURE))
|
||||
(FNS LAFITE.AROUNDEXIT \LAFITE.MARK.FOLDERS.OBSOLETE \LAFITE.CHECK.FOLDERS
|
||||
\LAFITE.ASSURE.FOLDER.READY \LAFITE.AFTERLOGIN))
|
||||
(COMS (* ; "misc utilities")
|
||||
(COMS (* ; "misc utilities")
|
||||
(FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY
|
||||
\LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT \LAFITEMSG.DEFPRINT
|
||||
LA.POSITION.FROM.REGION MAILFOLDERBUSY)
|
||||
(CURSORS LA.CROSSCURSOR)
|
||||
(* ; "Low level file functions")
|
||||
(* ; "Low level file functions")
|
||||
(FNS TOCFILENAME DELETEMAILFOLDER \LAFITE.OPEN.FOLDER \LAFITE.REPORT.FILE.WONT.OPEN
|
||||
\LAFITE.FOLDER.CHANGED \LAFITE.REBROWSE.FOLDER \LAFITE.FOLDER.CHANGED.MENU
|
||||
\LAFITE.SET.FOLDER.STREAM \LAFITE.OPENSTREAM \LAFITE.CREATE.MENU \LAFITE.EOF
|
||||
\LAFITE.CLOSE.FOLDER)
|
||||
(FNS \LAFITE.DESCRIBE.FOLDER))
|
||||
(COMS (* ;
|
||||
"Make is easy to load new versions of Lafite")
|
||||
(COMS (* ;
|
||||
"Make is easy to load new versions of Lafite")
|
||||
(FNS LOAD-LAFITE)
|
||||
(VARS LAFITEFILES))
|
||||
[DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
@@ -97,14 +102,14 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993, 1994 by Xero
|
||||
(FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL
|
||||
LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
|
||||
(P * (PROGN LAFITE.PROCLAMATIONS))
|
||||
(* ;
|
||||
"Proclaim user interface variables. Value is on LAFITEDECLS")
|
||||
(* ;
|
||||
"Proclaim user interface variables. Value is on LAFITEDECLS")
|
||||
(P (\LAFITE.GLOBAL.INIT)
|
||||
(COND ((EQ MAKESYSNAME :LYRIC)
|
||||
(FILESLOAD (SYSLOAD)
|
||||
NSCHARPATCH)
|
||||
(* ;
|
||||
"Patch to horrid Lyric NS chars bug")
|
||||
(* ;
|
||||
"Patch to horrid Lyric NS chars bug")
|
||||
(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
|
||||
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
@@ -112,7 +117,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993, 1994 by Xero
|
||||
|
||||
(RPAQQ LAFITEVERSION# 10)
|
||||
|
||||
(RPAQQ LAFITESYSTEMDATE "22-Aug-94 13:00:29")
|
||||
(RPAQQ LAFITESYSTEMDATE "24-Jun-2021 19:17:01")
|
||||
(DEFINEQ
|
||||
|
||||
(LAFITE
|
||||
@@ -185,7 +190,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1993, 1994 by Xero
|
||||
)
|
||||
)
|
||||
|
||||
(PUTPROPS LAFITE ARGNAMES (NIL (ON/OFF MAILFILE . OPTIONS) . U))
|
||||
(PUTPROPS LAFITE ARGNAMES (NIL (ON/OFF MAILFILE . OPTIONS) . U))
|
||||
(DEFINEQ
|
||||
|
||||
(LAFITEMODE
|
||||
@@ -223,7 +228,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
)
|
||||
)
|
||||
|
||||
(PUTPROPS LAFITEMODELST VARTYPE ALIST)
|
||||
(PUTPROPS LAFITEMODELST VARTYPE ALIST)
|
||||
|
||||
(ADDTOVAR LAFITEMODELST )
|
||||
|
||||
@@ -231,20 +236,17 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
|
||||
(RPAQ? \LAFITE.AUTHENTICATION.FAILURE )
|
||||
|
||||
(RPAQ? LAFITE.BACKGROUND.ITEM '("Mail" '(\LAFITE.MESSAGEFORM NIL NIL 'LEFT)
|
||||
|
||||
"Send an ordinary message. See subcommands for other operations."
|
||||
(SUBITEMS ("Turn Lafite on" '(LAFITE.ON.FROM.BACKGROUND)
|
||||
|
||||
(RPAQ? LAFITE.BACKGROUND.ITEM
|
||||
'("Mail" '(\LAFITE.MESSAGEFORM NIL NIL 'LEFT)
|
||||
"Send an ordinary message. See subcommands for other operations."
|
||||
(SUBITEMS ("Turn Lafite on" '(LAFITE.ON.FROM.BACKGROUND)
|
||||
|
||||
"Turn on Lafite, bringing up status window and browsing default folder."
|
||||
)
|
||||
("Send Mail" '(\LAFITE.MESSAGEFORM)
|
||||
|
||||
"Send a message. Prompts for type of message."
|
||||
)
|
||||
("Set Lafite Mode" '(SET.LAFITE.MODE.INTERACTIVELY)
|
||||
"Set or change Lafite's mail protocol mode.")
|
||||
)))
|
||||
)
|
||||
("Send Mail" '(\LAFITE.MESSAGEFORM)
|
||||
"Send a message. Prompts for type of message.")
|
||||
("Set Lafite Mode" '(SET.LAFITE.MODE.INTERACTIVELY)
|
||||
"Set or change Lafite's mail protocol mode."))))
|
||||
(DEFINEQ
|
||||
|
||||
(\LAFITE.LOGIN
|
||||
@@ -263,37 +265,38 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQQ LAFITEPROFILEVARS ((LAFITEDEFAULTHOST&DIR NIL)
|
||||
(LAFITE.SIGNATURE NIL)
|
||||
(LAFITEBUFFERSIZE 20)
|
||||
(LAFITEIFFROMMETHENSEENFLG T)
|
||||
[LAFITEMENUFONT (FONTCREATE '(HELVETICA 10 BOLD]
|
||||
[LAFITETITLEFONT (FONTCREATE '(HELVETICA 12 BOLD]
|
||||
[LAFITEDISPLAYFONT (FONTCREATE '(TIMESROMAN 10]
|
||||
[LAFITEFIXEDWIDTHFONT (COND ((EQ (CHARWIDTH (CHARCODE "i")
|
||||
DEFAULTFONT)
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
DEFAULTFONT))
|
||||
(* ;
|
||||
"Yes, user has not changed default to a variable width font")
|
||||
DEFAULTFONT)
|
||||
(T (FONTCREATE '(GACHA 10]
|
||||
(LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
|
||||
[LAFITEBROWSERFONT (FONTCREATE '(GACHA 10]
|
||||
[LAFITEMSGICONFONT (FONTCREATE '(HELVETICA 8]
|
||||
(LAFITE.FOLDER.MENU.FONT NIL)
|
||||
(LAFITEINFO.NAME "Lafite.info")
|
||||
(DEFAULTMAILFOLDERNAME "Active.mail")
|
||||
(LAFITEMAIL.EXT "mail")
|
||||
(LAFITESTATUSWINDOWMINWIDTH 200)
|
||||
(LAFITESTATUSWINDOWPOSITION '(735 . 650))
|
||||
(LAFITE.DONT.DISPLAY.HEADERS NIL)
|
||||
(LAFITE.DONT.FORWARD.HEADERS NIL)
|
||||
(LAFITE.DONT.HARDCOPY.HEADERS NIL)
|
||||
(LAFITEDEBUGFLG NIL)
|
||||
(LAFITEMODEDEFAULT NIL)
|
||||
(LAFITESHOWMODEFLG T)
|
||||
(LAFITE.USE.ALL.MODES T)))
|
||||
(RPAQQ LAFITEPROFILEVARS
|
||||
((LAFITEDEFAULTHOST&DIR NIL)
|
||||
(LAFITE.SIGNATURE NIL)
|
||||
(LAFITEBUFFERSIZE 20)
|
||||
(LAFITEIFFROMMETHENSEENFLG T)
|
||||
[LAFITEMENUFONT (FONTCREATE '(HELVETICA 10 BOLD]
|
||||
[LAFITETITLEFONT (FONTCREATE '(HELVETICA 12 BOLD]
|
||||
[LAFITEDISPLAYFONT (FONTCREATE '(TIMESROMAN 10]
|
||||
[LAFITEFIXEDWIDTHFONT (COND ((EQ (CHARWIDTH (CHARCODE "i")
|
||||
DEFAULTFONT)
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
DEFAULTFONT))
|
||||
(* ;
|
||||
"Yes, user has not changed default to a variable width font")
|
||||
DEFAULTFONT)
|
||||
(T (FONTCREATE '(GACHA 10]
|
||||
(LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
|
||||
[LAFITEBROWSERFONT (FONTCREATE '(GACHA 10]
|
||||
[LAFITEMSGICONFONT (FONTCREATE '(HELVETICA 8]
|
||||
(LAFITE.FOLDER.MENU.FONT NIL)
|
||||
(LAFITEINFO.NAME "Lafite.info")
|
||||
(DEFAULTMAILFOLDERNAME "Active.mail")
|
||||
(LAFITEMAIL.EXT "mail")
|
||||
(LAFITESTATUSWINDOWMINWIDTH 200)
|
||||
(LAFITESTATUSWINDOWPOSITION '(735 . 650))
|
||||
(LAFITE.DONT.DISPLAY.HEADERS NIL)
|
||||
(LAFITE.DONT.FORWARD.HEADERS NIL)
|
||||
(LAFITE.DONT.HARDCOPY.HEADERS NIL)
|
||||
(LAFITEDEBUGFLG NIL)
|
||||
(LAFITEMODEDEFAULT NIL)
|
||||
(LAFITESHOWMODEFLG T)
|
||||
(LAFITE.USE.ALL.MODES T)))
|
||||
|
||||
(RPAQ? LAFITEDEFAULTHOST&DIR NIL)
|
||||
|
||||
@@ -309,14 +312,15 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
|
||||
(RPAQ? LAFITEDISPLAYFONT (FONTCREATE '(TIMESROMAN 10)))
|
||||
|
||||
(RPAQ? LAFITEFIXEDWIDTHFONT [COND ((EQ (CHARWIDTH (CHARCODE "i")
|
||||
DEFAULTFONT)
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
DEFAULTFONT))
|
||||
(* ;
|
||||
"Yes, user has not changed default to a variable width font")
|
||||
DEFAULTFONT)
|
||||
(T (FONTCREATE '(GACHA 10])
|
||||
(RPAQ? LAFITEFIXEDWIDTHFONT
|
||||
[COND ((EQ (CHARWIDTH (CHARCODE "i")
|
||||
DEFAULTFONT)
|
||||
(CHARWIDTH (CHARCODE "W")
|
||||
DEFAULTFONT))
|
||||
(* ;
|
||||
"Yes, user has not changed default to a variable width font")
|
||||
DEFAULTFONT)
|
||||
(T (FONTCREATE '(GACHA 10])
|
||||
|
||||
(RPAQ? LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
|
||||
|
||||
@@ -365,14 +369,15 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
(RPAQ? LAFITEEOL "
|
||||
")
|
||||
|
||||
(RPAQQ LAFITEMARKS ((SEENMARK (CHARCODE SP))
|
||||
(UNSEENMARK (CHARCODE ?))
|
||||
(MOVETOMARK (CHARCODE m))
|
||||
(FORWARDMARK (CHARCODE f))
|
||||
(ANSWERMARK (CHARCODE a))
|
||||
(HARDCOPYBATCHMARK (CHARCODE H))
|
||||
(HARDCOPYMARK (CHARCODE h))
|
||||
(HEARDMARK (CHARCODE @))))
|
||||
(RPAQQ LAFITEMARKS
|
||||
((SEENMARK (CHARCODE SP))
|
||||
(UNSEENMARK (CHARCODE ?))
|
||||
(MOVETOMARK (CHARCODE m))
|
||||
(FORWARDMARK (CHARCODE f))
|
||||
(ANSWERMARK (CHARCODE a))
|
||||
(HARDCOPYBATCHMARK (CHARCODE H))
|
||||
(HARDCOPYMARK (CHARCODE h))
|
||||
(HEARDMARK (CHARCODE @))))
|
||||
|
||||
(RPAQ SEENMARK (CHARCODE SP))
|
||||
|
||||
@@ -398,45 +403,37 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
("Quit" '\LAFITE.QUIT
|
||||
"Update and close all mail files and stop Lafite")))
|
||||
|
||||
(RPAQQ LAFITEUPDATEMENUITEMS (("Do Hardcopy Only" '\LAFITE.HARDCOPYONLY.PROC
|
||||
"Will print batched hardcopy but not update file")
|
||||
("Write out changes only" '\LAFITE.UPDATE.PROC
|
||||
"Will update physical file to reflect new marks and deletions"
|
||||
)
|
||||
("Update table of contents only" (FUNCTION \LAFITE.UPDATE.PROC)
|
||||
|
||||
"Write table of contents file to speed next browse of this folder"
|
||||
)
|
||||
("Expunge deleted messages" '\LAFITE.EXPUNGE.PROC
|
||||
"Will rewrite mail file, expunging all deleted messages")
|
||||
("Write changes in sorted order" '\LAFITE.EXPUNGE.PROC "Will rewrite mail file so that the messages are permanently stored in the order in which they now appear in the browser."
|
||||
)
|
||||
("Expunge & Write out changes (sorted)" '\LAFITE.EXPUNGE.PROC "Will rewrite mail file, expunging deleted messages and writing writing the rest in the order in which they now appear in the browser."
|
||||
)
|
||||
("Just close" '\LAFITE.FINISH.UPDATE
|
||||
"Just close the window - don't touch the mail file.")
|
||||
("Just shrink" '\LAFITE.FINISH.UPDATE
|
||||
"Just shrink the window - don't touch the mail file.")))
|
||||
(RPAQQ LAFITEUPDATEMENUITEMS
|
||||
(("Do Hardcopy Only" '\LAFITE.HARDCOPYONLY.PROC
|
||||
"Will print batched hardcopy but not update file")
|
||||
("Write out changes only" '\LAFITE.UPDATE.PROC
|
||||
"Will update physical file to reflect new marks and deletions")
|
||||
("Update table of contents only" (FUNCTION \LAFITE.UPDATE.PROC)
|
||||
"Write table of contents file to speed next browse of this folder")
|
||||
("Expunge deleted messages" '\LAFITE.EXPUNGE.PROC
|
||||
"Will rewrite mail file, expunging all deleted messages")
|
||||
("Write changes in sorted order" '\LAFITE.EXPUNGE.PROC "Will rewrite mail file so that the messages are permanently stored in the order in which they now appear in the browser."
|
||||
)
|
||||
("Expunge & Write out changes (sorted)" '\LAFITE.EXPUNGE.PROC "Will rewrite mail file, expunging deleted messages and writing writing the rest in the order in which they now appear in the browser."
|
||||
)
|
||||
("Just close" '\LAFITE.FINISH.UPDATE "Just close the window - don't touch the mail file.")
|
||||
("Just shrink" '\LAFITE.FINISH.UPDATE "Just shrink the window - don't touch the mail file.")))
|
||||
|
||||
(RPAQQ LAFITESUBQUITMENUITEMS (("Quit" '\LAFITE.QUIT "Turn Lafite off")
|
||||
("Restart" '\LAFITE.RESTART "Turn Lafite off then back on")
|
||||
("Login" '\LAFITE.LOGIN
|
||||
"Change the global username/password and restart Lafite with the new user."
|
||||
(SUBITEMS ("Just re-authenticate" '\LAFITE.REAUTHENTICATE
|
||||
"Re-authenticate currently logged-in user."
|
||||
)
|
||||
("Login without restarting"
|
||||
'\LAFITE.LOGIN.NORESTART
|
||||
(RPAQQ LAFITESUBQUITMENUITEMS
|
||||
(("Quit" '\LAFITE.QUIT "Turn Lafite off")
|
||||
("Restart" '\LAFITE.RESTART "Turn Lafite off then back on")
|
||||
("Login" '\LAFITE.LOGIN
|
||||
"Change the global username/password and restart Lafite with the new user."
|
||||
(SUBITEMS ("Just re-authenticate" '\LAFITE.REAUTHENTICATE
|
||||
"Re-authenticate currently logged-in user.")
|
||||
("Login without restarting" '\LAFITE.LOGIN.NORESTART
|
||||
"Change the global login but don't restart Lafite (keep the same folders open, etc)"
|
||||
)
|
||||
("NS Login" '\NSMAIL.LOGIN
|
||||
"Change the name and/or password for NS operation."
|
||||
)))
|
||||
("Recache" 'LAFITE.COMPUTE.CACHED.VARS
|
||||
"Make Lafite recompute cached information based on current variable settings"
|
||||
)
|
||||
("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE
|
||||
"Change setting of *NSMAIL-TRACE-SERVERS*")))
|
||||
)
|
||||
("NS Login" '\NSMAIL.LOGIN "Change the name and/or password for NS operation.")
|
||||
))
|
||||
("Recache" 'LAFITE.COMPUTE.CACHED.VARS
|
||||
"Make Lafite recompute cached information based on current variable settings")
|
||||
("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE "Change setting of *NSMAIL-TRACE-SERVERS*")))
|
||||
|
||||
(RPAQQ ANOTHERFOLDERMENUITEM ("** Other Folder **" '%##ANOTHERFILE##
|
||||
"You will be asked to specify another mail filename"))
|
||||
@@ -586,8 +583,27 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
)
|
||||
|
||||
(\LAFITE.EOF
|
||||
(LAMBDA (STREAM) (* ; "Edited 15-Sep-87 18:26 by bvm:") (* ;; "End of stream op for Lafite mail folders. Return endless CR's so that parses eventually stop") (if (NEQ (ACCESS-CHARSET STREAM) 0) then (* ;; "We're in another char set, so just returning CR won't do, since it will be interpreted in the wrong char set. Also, can't just smash CHARSET to 0, since some readers cache the charset.") (LET ((STATE (STREAMPROP STREAM (QUOTE EOFDATA)))) (SELECTQ STATE (NIL (STREAMPROP STREAM (QUOTE EOFDATA) 1) (* ; "First return charset shift byte") NSCHARSETSHIFT) (1 (STREAMPROP STREAM (QUOTE EOFDATA) 2) (* ; "Then charset zero.") 0) (PROGN (* ; "Eek, shouldn't happen. Maybe somebody is stupidly reading bytes, so try a cr") (STREAMPROP STREAM (QUOTE EOFDATA) NIL) (CHARCODE CR)))) else (CHARCODE CR)))
|
||||
)
|
||||
[LAMBDA (STREAM) (* ; "Edited 24-Jun-2021 19:16 by rmk:")
|
||||
|
||||
(* ;; "End of stream op for Lafite mail folders. Return endless EOLS's so that parses eventually stop. This is now done in a format independent way. We create a byte stream for the current external format of stream, print an EOL on to it, and then keep returning the bytes that ecode the EOL. If there is a need for an XCCS charset shift or any other magic, that will show up in the byte stream")
|
||||
|
||||
(LET (BYTESTREAM)
|
||||
(IF [NULL (SETQ BYTESTREAM (STREAMPROP STREAM 'BYTESTREAM]
|
||||
THEN (SETQ BYTESTREAM (\FORMATBYTESTREAM STREAM NIL))
|
||||
(* ; "First time, set it up")
|
||||
(STREAMPROP STREAM 'BYTESTREAM BYTESTREAM)
|
||||
(TERPRI BYTESTREAM)
|
||||
(SETFILEPTR BYTESTREAM 0)
|
||||
(BIN BYTESTREAM)
|
||||
ELSEIF (BIN BYTESTREAM)
|
||||
ELSE
|
||||
|
||||
(* ;; "Ran off the end, Reset to make sure it remains consistent with STREAM after it has been reading our bytes")
|
||||
|
||||
(\FORMATBYTESTREAM STREAM BYTESTREAM)
|
||||
(TERPRI BYTESTREAM)
|
||||
(SETFILEPTR BYTESTREAM 0)
|
||||
(BIN BYTESTREAM])
|
||||
|
||||
(\LAFITE.CLOSE.FOLDER
|
||||
(LAMBDA (MAILFOLDER REALLYP) (* ; "Edited 14-Oct-87 20:18 by bvm:") (* ;;; "If MAILFOLDER is open for output, make sure it is completely written out. If REALLYP then actually close the file") (LET ((STREAM (fetch (MAILFOLDER FOLDERSTREAM) of MAILFOLDER))) (COND ((AND STREAM (COND ((OPENP STREAM (QUOTE OUTPUT)) (FORCEOUTPUT STREAM T) (* ; "Due to Leaf bug, best to do the FORCEOUTPUT first even if we're really closing it") (replace (MAILFOLDER FOLDERCREATIONDATE) of MAILFOLDER with (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) (* ; "Update creation date in case it's a device where writing to it affects it (always true over savevm for some devices)") REALLYP) (T (AND REALLYP (OPENP STREAM))))) (* ; "Yes, close it for real") (PROG1 (CLOSEF STREAM) (replace (MAILFOLDER FOLDERSTREAM) of MAILFOLDER with NIL))))))
|
||||
@@ -848,8 +864,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
(COND
|
||||
((EQ MAKESYSNAME :LYRIC)
|
||||
(FILESLOAD (SYSLOAD)
|
||||
NSCHARPATCH) (* ;
|
||||
"Patch to horrid Lyric NS chars bug")
|
||||
NSCHARPATCH) (* ;
|
||||
"Patch to horrid Lyric NS chars bug")
|
||||
(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)))
|
||||
)
|
||||
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
@@ -861,30 +877,30 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
|
||||
(ADDTOVAR LAMA LAFITE)
|
||||
)
|
||||
(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985
|
||||
1986 1987 1988 1989 1993 1994))
|
||||
1986 1987 1988 1989 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7072 22118 (LAFITE 7082 . 8393) (LAFITE.ON.FROM.BACKGROUND 8395 . 8766) (\LAFITE.OFF
|
||||
8768 . 9152) (\LAFITE.START.PROC 9154 . 10930) (LAFITE.COMPUTE.CACHED.VARS 10932 . 13634) (
|
||||
\LAFITE.PROCESS 13636 . 14002) (\LAFITE.START.ABORT 14004 . 14196) (\LAFITE.QUIT 14198 . 14440) (
|
||||
\LAFITE.RESTART 14442 . 14575) (\LAFITE.SUBQUIT 14577 . 15875) (\LAFITE.QUIT.PROC 15877 . 18613) (
|
||||
\LAFITEDEFAULTHOST&DIR 18615 . 19425) (LAFITEDEFAULTHOST&DIR 19427 . 19597) (MAKELAFITECOMMANDWINDOW
|
||||
19599 . 21238) (EXTRACTMENUCOMMAND 21240 . 21488) (DOMAINLAFITECOMMAND 21490 . 21639) (
|
||||
LAFITE.TOGGLE.SERVER.TRACE 21641 . 22116)) (22189 25157 (LAFITEMODE 22199 . 22679) (\LAFITE.INFER.MODE
|
||||
22681 . 23034) (\LAFITE.SHOW.MODE 23036 . 23273) (\LAFITE.MODE.TITLE 23275 . 23560) (
|
||||
LAFITE.SHOW.MODE.P 23562 . 23803) (LAFITE.ALL.MODES.P 23805 . 24148) (SET.LAFITE.MODE.INTERACTIVELY
|
||||
24150 . 24732) (\LAFITE.COMPUTE.MODE.COMMANDS 24734 . 25155)) (26410 28166 (\LAFITE.LOGIN 26420 .
|
||||
26802) (\LAFITE.LOGIN.NORESTART 26804 . 26910) (LAFITE.PROMPT.FOR.LOGIN 26912 . 27931) (
|
||||
\LAFITE.REAUTHENTICATE 27933 . 28164)) (37585 41027 (LAFITE.AROUNDEXIT 37595 . 38133) (
|
||||
\LAFITE.MARK.FOLDERS.OBSOLETE 38135 . 39051) (\LAFITE.CHECK.FOLDERS 39053 . 39452) (
|
||||
\LAFITE.ASSURE.FOLDER.READY 39454 . 39864) (\LAFITE.AFTERLOGIN 39866 . 41025)) (41059 43997 (
|
||||
LA.RESETSHADE 41069 . 41447) (LA.MENU.ITEM 41449 . 41867) (NTHMESSAGE 41869 . 41952) (
|
||||
\LAFITE.MAKE.MSGARRAY 41954 . 42384) (\LAFITE.ADDMESSAGES.TO.ARRAY 42386 . 42967) (
|
||||
\MAILFOLDER.DEFPRINT 42969 . 43216) (\LAFITEMSG.DEFPRINT 43218 . 43380) (LA.POSITION.FROM.REGION 43382
|
||||
. 43859) (MAILFOLDERBUSY 43861 . 43995)) (44175 60041 (TOCFILENAME 44185 . 44616) (DELETEMAILFOLDER
|
||||
44618 . 45138) (\LAFITE.OPEN.FOLDER 45140 . 49755) (\LAFITE.REPORT.FILE.WONT.OPEN 49757 . 50481) (
|
||||
\LAFITE.FOLDER.CHANGED 50483 . 52887) (\LAFITE.REBROWSE.FOLDER 52889 . 55854) (
|
||||
\LAFITE.FOLDER.CHANGED.MENU 55856 . 56779) (\LAFITE.SET.FOLDER.STREAM 56781 . 57475) (
|
||||
\LAFITE.OPENSTREAM 57477 . 58016) (\LAFITE.CREATE.MENU 58018 . 58371) (\LAFITE.EOF 58373 . 59193) (
|
||||
\LAFITE.CLOSE.FOLDER 59195 . 60039)) (60042 60626 (\LAFITE.DESCRIBE.FOLDER 60052 . 60624)) (60687
|
||||
61793 (LOAD-LAFITE 60697 . 61791)) (69504 70781 (\LAFITE.GLOBAL.INIT 69514 . 70779)))))
|
||||
(FILEMAP (NIL (7140 22186 (LAFITE 7150 . 8461) (LAFITE.ON.FROM.BACKGROUND 8463 . 8834) (\LAFITE.OFF
|
||||
8836 . 9220) (\LAFITE.START.PROC 9222 . 10998) (LAFITE.COMPUTE.CACHED.VARS 11000 . 13702) (
|
||||
\LAFITE.PROCESS 13704 . 14070) (\LAFITE.START.ABORT 14072 . 14264) (\LAFITE.QUIT 14266 . 14508) (
|
||||
\LAFITE.RESTART 14510 . 14643) (\LAFITE.SUBQUIT 14645 . 15943) (\LAFITE.QUIT.PROC 15945 . 18681) (
|
||||
\LAFITEDEFAULTHOST&DIR 18683 . 19493) (LAFITEDEFAULTHOST&DIR 19495 . 19665) (MAKELAFITECOMMANDWINDOW
|
||||
19667 . 21306) (EXTRACTMENUCOMMAND 21308 . 21556) (DOMAINLAFITECOMMAND 21558 . 21707) (
|
||||
LAFITE.TOGGLE.SERVER.TRACE 21709 . 22184)) (22261 25229 (LAFITEMODE 22271 . 22751) (\LAFITE.INFER.MODE
|
||||
22753 . 23106) (\LAFITE.SHOW.MODE 23108 . 23345) (\LAFITE.MODE.TITLE 23347 . 23632) (
|
||||
LAFITE.SHOW.MODE.P 23634 . 23875) (LAFITE.ALL.MODES.P 23877 . 24220) (SET.LAFITE.MODE.INTERACTIVELY
|
||||
24222 . 24804) (\LAFITE.COMPUTE.MODE.COMMANDS 24806 . 25227)) (26079 27835 (\LAFITE.LOGIN 26089 .
|
||||
26471) (\LAFITE.LOGIN.NORESTART 26473 . 26579) (LAFITE.PROMPT.FOR.LOGIN 26581 . 27600) (
|
||||
\LAFITE.REAUTHENTICATE 27602 . 27833)) (35346 38788 (LAFITE.AROUNDEXIT 35356 . 35894) (
|
||||
\LAFITE.MARK.FOLDERS.OBSOLETE 35896 . 36812) (\LAFITE.CHECK.FOLDERS 36814 . 37213) (
|
||||
\LAFITE.ASSURE.FOLDER.READY 37215 . 37625) (\LAFITE.AFTERLOGIN 37627 . 38786)) (38820 41758 (
|
||||
LA.RESETSHADE 38830 . 39208) (LA.MENU.ITEM 39210 . 39628) (NTHMESSAGE 39630 . 39713) (
|
||||
\LAFITE.MAKE.MSGARRAY 39715 . 40145) (\LAFITE.ADDMESSAGES.TO.ARRAY 40147 . 40728) (
|
||||
\MAILFOLDER.DEFPRINT 40730 . 40977) (\LAFITEMSG.DEFPRINT 40979 . 41141) (LA.POSITION.FROM.REGION 41143
|
||||
. 41620) (MAILFOLDERBUSY 41622 . 41756)) (41936 58324 (TOCFILENAME 41946 . 42377) (DELETEMAILFOLDER
|
||||
42379 . 42899) (\LAFITE.OPEN.FOLDER 42901 . 47516) (\LAFITE.REPORT.FILE.WONT.OPEN 47518 . 48242) (
|
||||
\LAFITE.FOLDER.CHANGED 48244 . 50648) (\LAFITE.REBROWSE.FOLDER 50650 . 53615) (
|
||||
\LAFITE.FOLDER.CHANGED.MENU 53617 . 54540) (\LAFITE.SET.FOLDER.STREAM 54542 . 55236) (
|
||||
\LAFITE.OPENSTREAM 55238 . 55777) (\LAFITE.CREATE.MENU 55779 . 56132) (\LAFITE.EOF 56134 . 57476) (
|
||||
\LAFITE.CLOSE.FOLDER 57478 . 58322)) (58325 58909 (\LAFITE.DESCRIBE.FOLDER 58335 . 58907)) (58970
|
||||
60076 (LOAD-LAFITE 58980 . 60074)) (67787 69064 (\LAFITE.GLOBAL.INIT 67797 . 69062)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,18 +1,74 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-Aug-93 18:19:26" {DSK}<archive>lafite>sources>lafitemail.;24 68769
|
||||
(FILECREATED "22-Jun-2021 10:19:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;2 70964
|
||||
|
||||
changes to%: (FNS LAFITE.NEW.PARSE.HEADER) (VARS LAFITEMAILCOMS)
|
||||
changes to%: (FNS LA.SKIP.TO.EOL LAFITE.SKIP.WHITE.SPACE)
|
||||
(FILES LAFITEDECLS)
|
||||
|
||||
previous date%: "26-May-92 12:22:49" {DSK}<archive>lafite>sources>lafitemail.;22)
|
||||
previous date%: " 6-Aug-93 18:19:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITEMAILCOMS)
|
||||
|
||||
(RPAQQ LAFITEMAILCOMS ((COMS (* ; "Retrieving mail") (FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL \LAFITE.GETNEWMAIL1 \LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES)) (COMS (* ; "Mail polling and registration") (FNS \LAFITE.GET.USER.DATA \LAFITE.GUESS.MODE \LAFITE.REGISTER.MODE LAFITECLEARCACHE FULLUSERNAME LAFITE.USER.NAME.FROM.LOGIN LAFITEMAILWATCH \LAFITE.WAKE.WATCHER POLLNEWMAIL \LAFITE.NEW.MAIL.EXISTS PRINTLAFITESTATUS LAFITE.STATUS.WITH.TIME \LAFITE.REINITIALIZING)) (COMS (* ; "Parsing mail files") (FNS \LAFITE.PARSE.FOLDER \LAFITE.PARSE.FOLDER1 \LAFITE.HANDLE.DUPLICATES \LAFITE.CHECK.DUPLICATE \LAFITE.REPORT.DUPLICATES BADMAILFILE BADMAILFILE.CLOSEFN BADMAILFILE.FLAGBYTE VERIFYMAILFOLDER VERIFYFAILED \LAFITE.READ.TOC.FILE BADTOCFILE \LAFITE.TOCEOF LA.READCOUNT LA.READSTAMP LA.PRINTHEADER LA.PRINTCOUNT LA.PRINTSTAMP LA.READSHORTSTRING LA.PRINTSHORTSTRING LA.READSTRING \LAFITE.VERIFYMSG LA.MSGFROMMEP) (FNS LAFITE.PARSE.MSG.FOR.TOC LAFITE-EXTRACT-REAL-NAME LAFITE.FETCH.TO.FIELD LAFITE.PARSE.HEADER LAFITE.GRAB.DATE LAFITE.READ.LINE.FOR.TOC LAFITE.READ.FORMAT LAFITE.READ.NAME.FIELD LAFITE.READ.ONE.LINE.FOR.TOC LAFITE.READ.TO.EOL LA.SKIP.TO.EOL LAFITE.SKIP.WHITE.SPACE) (FNS \LAFITE.PARSE.MESSAGE) (COMS (VARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.DATEFIELDONLY LA.SUBJECTFIELDONLY) (FNS LAFITE.INIT.PARSETABLES LAFITE.MAKE.PARSE.TABLE LAFITE.MAKE.PARSE.TABLE1)) (COMS (* ; "New header parser") (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD) (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100) (*LAFITE-PARSE-HEADER-STRING-RESOURCE*)))) (COMS (INITVARS (*LAFITE-VERIFY-ACTION* NIL) (MAILWATCHWAITTIME 5) (LAFITEFLUSHMAILFLG T) (LAFITETOC.EXT "-Lafite-toc") (LAFITENEWMAILFN NIL) (LAFITENEWMAILTUNE NIL) (LAFITEGETMAILTUNE NIL) (LAFITE.AFTER.GETMAIL.FN NIL) (LAFITE.SORT.NEW.MAIL NIL)) (INITVARS (\LAFITE.LAST.STATUS)) (ADDVARS (\SYSTEMCACHEVARS \LAFITE.LAST.STATUS))) (DECLARE%: DOEVAL@COMPILE (P (CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-VERIFY-ACTION* DEFAULTREGISTRY LAFITEDEBUGFLG))) (CL:PROCLAIM (QUOTE (GLOBAL LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITENEWMAILFN LAFITENEWMAILTUNE LAFITEIFFROMMETHENSEENFLG MAILWATCHWAITTIME LAFITETOC.EXT LAFITE.SORT.NEW.MAIL))))) (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE* LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.DATEFIELDONLY LA.SUBJECTFIELDONLY \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD LAFITE.AFTER.GETMAIL.FN) (FILES (SOURCE) LAFITEDECLS) (LOCALVARS . T))))
|
||||
(RPAQQ LAFITEMAILCOMS
|
||||
((COMS (* ; "Retrieving mail")
|
||||
(FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL
|
||||
\LAFITE.GETNEWMAIL1 \LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES))
|
||||
(COMS (* ; "Mail polling and registration")
|
||||
(FNS \LAFITE.GET.USER.DATA \LAFITE.GUESS.MODE \LAFITE.REGISTER.MODE LAFITECLEARCACHE
|
||||
FULLUSERNAME LAFITE.USER.NAME.FROM.LOGIN LAFITEMAILWATCH \LAFITE.WAKE.WATCHER
|
||||
POLLNEWMAIL \LAFITE.NEW.MAIL.EXISTS PRINTLAFITESTATUS LAFITE.STATUS.WITH.TIME
|
||||
\LAFITE.REINITIALIZING))
|
||||
[COMS (* ; "Parsing mail files")
|
||||
(FNS \LAFITE.PARSE.FOLDER \LAFITE.PARSE.FOLDER1 \LAFITE.HANDLE.DUPLICATES
|
||||
\LAFITE.CHECK.DUPLICATE \LAFITE.REPORT.DUPLICATES BADMAILFILE BADMAILFILE.CLOSEFN
|
||||
BADMAILFILE.FLAGBYTE VERIFYMAILFOLDER VERIFYFAILED \LAFITE.READ.TOC.FILE
|
||||
BADTOCFILE \LAFITE.TOCEOF LA.READCOUNT LA.READSTAMP LA.PRINTHEADER LA.PRINTCOUNT
|
||||
LA.PRINTSTAMP LA.READSHORTSTRING LA.PRINTSHORTSTRING LA.READSTRING
|
||||
\LAFITE.VERIFYMSG LA.MSGFROMMEP)
|
||||
(FNS LAFITE.PARSE.MSG.FOR.TOC LAFITE-EXTRACT-REAL-NAME LAFITE.FETCH.TO.FIELD
|
||||
LAFITE.PARSE.HEADER LAFITE.GRAB.DATE LAFITE.READ.LINE.FOR.TOC LAFITE.READ.FORMAT
|
||||
LAFITE.READ.NAME.FIELD LAFITE.READ.ONE.LINE.FOR.TOC LAFITE.READ.TO.EOL
|
||||
LA.SKIP.TO.EOL LAFITE.SKIP.WHITE.SPACE)
|
||||
(FNS \LAFITE.PARSE.MESSAGE)
|
||||
(COMS (VARS LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.DATEFIELDONLY
|
||||
LA.SUBJECTFIELDONLY)
|
||||
(FNS LAFITE.INIT.PARSETABLES LAFITE.MAKE.PARSE.TABLE LAFITE.MAKE.PARSE.TABLE1))
|
||||
(COMS (* ; "New header parser")
|
||||
(FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD)
|
||||
(INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100)
|
||||
(*LAFITE-PARSE-HEADER-STRING-RESOURCE*]
|
||||
(COMS (INITVARS (*LAFITE-VERIFY-ACTION* NIL)
|
||||
(MAILWATCHWAITTIME 5)
|
||||
(LAFITEFLUSHMAILFLG T)
|
||||
(LAFITETOC.EXT "-Lafite-toc")
|
||||
(LAFITENEWMAILFN NIL)
|
||||
(LAFITENEWMAILTUNE NIL)
|
||||
(LAFITEGETMAILTUNE NIL)
|
||||
(LAFITE.AFTER.GETMAIL.FN NIL)
|
||||
(LAFITE.SORT.NEW.MAIL NIL))
|
||||
(INITVARS (\LAFITE.LAST.STATUS))
|
||||
(ADDVARS (\SYSTEMCACHEVARS \LAFITE.LAST.STATUS)))
|
||||
[DECLARE%: DOEVAL@COMPILE (P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-VERIFY-ACTION* DEFAULTREGISTRY
|
||||
LAFITEDEBUGFLG))
|
||||
(CL:PROCLAIM '(GLOBAL LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE
|
||||
LAFITENEWMAILFN LAFITENEWMAILTUNE
|
||||
LAFITEIFFROMMETHENSEENFLG MAILWATCHWAITTIME
|
||||
LAFITETOC.EXT LAFITE.SORT.NEW.MAIL]
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*
|
||||
LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.DATEFIELDONLY
|
||||
LA.SUBJECTFIELDONLY \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL
|
||||
\LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD
|
||||
LAFITE.AFTER.GETMAIL.FN)
|
||||
(FILES (SOURCE)
|
||||
LAFITEDECLS)
|
||||
(LOCALVARS . T))))
|
||||
|
||||
|
||||
|
||||
@@ -249,12 +305,41 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1991, 1992, 1993 by Xerox Corp
|
||||
)
|
||||
|
||||
(LA.SKIP.TO.EOL
|
||||
(LAMBDA (STREAM LASTCH) (* ; "Edited 28-Jul-88 16:23 by bvm") (* ;;; "Flush to end of this field. LASTCH is the last char read before this") (PROG* ((CSET (LLSH (fetch CHARSET of STREAM) 8)) (EOLC (fetch (STREAM EOLCONVENTION) of STREAM)) (EOLCHAR (SELECTC EOLC (LF.EOLC (CHARCODE LF)) (CHARCODE CR)))) (if (EQ LASTCH (CHARCODE EOL)) then (* ; "We're already there") (GO PEEK)) LP (* ;; "Eat chars til eol. Optimize here with \NSIN because this operation wants to be fast, while READCCODE is slow.") (repeatuntil (EQ (\NSIN STREAM CSET CSET) EOLCHAR)) (if (AND (EQ EOLC CRLF.EOLC) (EQ (\PEEKBIN STREAM T) (CHARCODE LF))) then (* ; "Eat the lf after the cr") (\BIN STREAM)) PEEK (SELCHARQ (\NSPEEK STREAM CSET CSET T) ((SPACE TAB) (* ; "Continuation line, keep eating") (GO LP)) NIL)))
|
||||
)
|
||||
[LAMBDA (STREAM LASTCH) (* ; "Edited 22-Jun-2021 10:15 by rmk:")
|
||||
|
||||
(* ;;; "Flush to end of this field. LASTCH is the last char read before this")
|
||||
|
||||
(PROG* [(EOLC (fetch (STREAM EOLCONVENTION) of STREAM))
|
||||
(EOLCHAR (SELECTC EOLC
|
||||
(LF.EOLC (CHARCODE LF))
|
||||
(CHARCODE CR]
|
||||
(if (EQ LASTCH (CHARCODE EOL))
|
||||
then (* ; "We're already there")
|
||||
(GO PEEK))
|
||||
LP
|
||||
|
||||
(* ;; "Eat chars til eol. ")
|
||||
|
||||
(repeatuntil (EQ EOLCHAR (\INCCODE STREAM)))
|
||||
(if (AND (EQ EOLC CRLF.EOLC)
|
||||
(EQ (\PEEKBIN STREAM T)
|
||||
(CHARCODE LF)))
|
||||
then (* ; "Eat the lf after the cr")
|
||||
(* ;
|
||||
"\INCHAR would do that internally")
|
||||
(\BIN STREAM))
|
||||
PEEK
|
||||
(SELCHARQ (\PEEKCCODE STREAM T)
|
||||
((SPACE TAB) (* ; "Continuation line, keep eating")
|
||||
(GO LP))
|
||||
NIL])
|
||||
|
||||
(LAFITE.SKIP.WHITE.SPACE
|
||||
(LAMBDA (STREAM) (* ; "Edited 9-Sep-87 19:07 by bvm:") (bind (CSET _ (LLSH (fetch CHARSET of STREAM) 8)) do (SELCHARQ (\NSPEEK STREAM CSET CSET T) ((SPACE TAB) (\NSIN STREAM CSET CSET)) (RETURN))))
|
||||
)
|
||||
[LAMBDA (STREAM) (* ; "Edited 22-Jun-2021 10:18 by rmk:")
|
||||
(do (SELCHARQ (\PEEKCCODE STREAM T)
|
||||
((SPACE TAB)
|
||||
(\INCCODE STREAM))
|
||||
(RETURN])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -263,15 +348,27 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1991, 1992, 1993 by Xerox Corp
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQQ LA.FULLPARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT)))
|
||||
(RPAQQ LA.FULLPARSEFIELDS
|
||||
(("DATE:" LAFITE.READ.LINE.FOR.TOC Date)
|
||||
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
|
||||
("SENDER:" LAFITE.READ.NAME.FIELD Sender)
|
||||
("FROM:" LAFITE.READ.NAME.FIELD From)
|
||||
("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to)
|
||||
("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to)
|
||||
("TO:" LAFITE.READ.NAME.FIELD To)
|
||||
("CC:" LAFITE.READ.NAME.FIELD cc)
|
||||
("FORMAT:" LAFITE.READ.FORMAT)))
|
||||
|
||||
(RPAQQ LA.TOCFIELDS (("DATE:" LAFITE.GRAB.DATE) ("FROM:" LAFITE.READ.LINE.FOR.TOC From) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
|
||||
(RPAQQ LA.TOCFIELDS (("DATE:" LAFITE.GRAB.DATE)
|
||||
("FROM:" LAFITE.READ.LINE.FOR.TOC From)
|
||||
("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
|
||||
("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
|
||||
|
||||
(RPAQQ LA.TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
|
||||
(RPAQQ LA.TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
|
||||
|
||||
(RPAQQ LA.DATEFIELDONLY (("DATE:" LAFITE.PARSE.DATE.FIELD.ONLY)))
|
||||
(RPAQQ LA.DATEFIELDONLY (("DATE:" LAFITE.PARSE.DATE.FIELD.ONLY)))
|
||||
|
||||
(RPAQQ LA.SUBJECTFIELDONLY (("SUBJECT:" LAFITE.READ.ONE.LINE.FOR.TOC)))
|
||||
(RPAQQ LA.SUBJECTFIELDONLY (("SUBJECT:" LAFITE.READ.ONE.LINE.FOR.TOC)))
|
||||
(DEFINEQ
|
||||
|
||||
(LAFITE.INIT.PARSETABLES
|
||||
@@ -303,75 +400,81 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1991, 1992, 1993 by Xerox Corp
|
||||
)
|
||||
)
|
||||
|
||||
(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
|
||||
(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
|
||||
|
||||
(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
|
||||
(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE* )
|
||||
|
||||
(RPAQ? *LAFITE-VERIFY-ACTION* NIL)
|
||||
(RPAQ? *LAFITE-VERIFY-ACTION* NIL)
|
||||
|
||||
(RPAQ? MAILWATCHWAITTIME 5)
|
||||
(RPAQ? MAILWATCHWAITTIME 5)
|
||||
|
||||
(RPAQ? LAFITEFLUSHMAILFLG T)
|
||||
(RPAQ? LAFITEFLUSHMAILFLG T)
|
||||
|
||||
(RPAQ? LAFITETOC.EXT "-Lafite-toc")
|
||||
(RPAQ? LAFITETOC.EXT "-Lafite-toc")
|
||||
|
||||
(RPAQ? LAFITENEWMAILFN NIL)
|
||||
(RPAQ? LAFITENEWMAILFN NIL)
|
||||
|
||||
(RPAQ? LAFITENEWMAILTUNE NIL)
|
||||
(RPAQ? LAFITENEWMAILTUNE NIL)
|
||||
|
||||
(RPAQ? LAFITEGETMAILTUNE NIL)
|
||||
(RPAQ? LAFITEGETMAILTUNE NIL)
|
||||
|
||||
(RPAQ? LAFITE.AFTER.GETMAIL.FN NIL)
|
||||
(RPAQ? LAFITE.AFTER.GETMAIL.FN NIL)
|
||||
|
||||
(RPAQ? LAFITE.SORT.NEW.MAIL NIL)
|
||||
(RPAQ? LAFITE.SORT.NEW.MAIL NIL)
|
||||
|
||||
(RPAQ? \LAFITE.LAST.STATUS)
|
||||
(RPAQ? \LAFITE.LAST.STATUS )
|
||||
|
||||
(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.LAST.STATUS)
|
||||
(ADDTOVAR \SYSTEMCACHEVARS \LAFITE.LAST.STATUS)
|
||||
(DECLARE%: DOEVAL@COMPILE
|
||||
|
||||
(CL:PROCLAIM (QUOTE (CL:SPECIAL *LAFITE-VERIFY-ACTION* DEFAULTREGISTRY LAFITEDEBUGFLG)))
|
||||
(CL:PROCLAIM '(CL:SPECIAL *LAFITE-VERIFY-ACTION* DEFAULTREGISTRY LAFITEDEBUGFLG))
|
||||
|
||||
(CL:PROCLAIM (QUOTE (GLOBAL LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITENEWMAILFN LAFITENEWMAILTUNE LAFITEIFFROMMETHENSEENFLG MAILWATCHWAITTIME LAFITETOC.EXT LAFITE.SORT.NEW.MAIL)))
|
||||
(CL:PROCLAIM '(GLOBAL LAFITEFLUSHMAILFLG LAFITEGETMAILTUNE LAFITENEWMAILFN LAFITENEWMAILTUNE
|
||||
LAFITEIFFROMMETHENSEENFLG MAILWATCHWAITTIME LAFITETOC.EXT LAFITE.SORT.NEW.MAIL))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE* LA.FULLPARSEFIELDS LA.TOCFIELDS LA.TOFIELDONLY LA.DATEFIELDONLY LA.SUBJECTFIELDONLY \LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD LAFITE.AFTER.GETMAIL.FN)
|
||||
(GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE* LA.FULLPARSEFIELDS
|
||||
LA.TOCFIELDS LA.TOFIELDONLY LA.DATEFIELDONLY LA.SUBJECTFIELDONLY
|
||||
\LAFITE.AUTHENTICATION.FAILURE \LAPARSE.FULL \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD
|
||||
\LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD LAFITE.AFTER.GETMAIL.FN)
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (SOURCE) LAFITEDECLS)
|
||||
(FILESLOAD (SOURCE)
|
||||
LAFITEDECLS)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
)
|
||||
(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1991 1992 1993))
|
||||
(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1991 1992 1993 2021)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3143 12346 (\LAFITE.GETMAIL 3153 . 3385) (\LAFITE.GETMAIL.FROM.ICON 3387 . 3644) (
|
||||
\LAFITE.GETMAIL.PROC 3646 . 3989) (\LAFITE.GETNEWMAIL 3991 . 6652) (\LAFITE.GETNEWMAIL1 6654 . 8016) (
|
||||
\LAFITE.GETNEWMAIL# 8018 . 8206) (\LAFITE.RETRIEVEMESSAGES 8208 . 12344)) (12393 25647 (
|
||||
\LAFITE.GET.USER.DATA 12403 . 13791) (\LAFITE.GUESS.MODE 13793 . 14776) (\LAFITE.REGISTER.MODE 14778
|
||||
. 15505) (LAFITECLEARCACHE 15507 . 15981) (FULLUSERNAME 15983 . 16752) (LAFITE.USER.NAME.FROM.LOGIN
|
||||
16754 . 17833) (LAFITEMAILWATCH 17835 . 18279) (\LAFITE.WAKE.WATCHER 18281 . 18663) (POLLNEWMAIL 18665
|
||||
. 23646) (\LAFITE.NEW.MAIL.EXISTS 23648 . 23903) (PRINTLAFITESTATUS 23905 . 25199) (
|
||||
LAFITE.STATUS.WITH.TIME 25201 . 25389) (\LAFITE.REINITIALIZING 25391 . 25645)) (25683 52890 (
|
||||
\LAFITE.PARSE.FOLDER 25693 . 26351) (\LAFITE.PARSE.FOLDER1 26353 . 29949) (\LAFITE.HANDLE.DUPLICATES
|
||||
29951 . 31288) (\LAFITE.CHECK.DUPLICATE 31290 . 31972) (\LAFITE.REPORT.DUPLICATES 31974 . 32906) (
|
||||
BADMAILFILE 32908 . 36841) (BADMAILFILE.CLOSEFN 36843 . 37115) (BADMAILFILE.FLAGBYTE 37117 . 37269) (
|
||||
VERIFYMAILFOLDER 37271 . 39802) (VERIFYFAILED 39804 . 39937) (\LAFITE.READ.TOC.FILE 39939 . 45385) (
|
||||
BADTOCFILE 45387 . 45736) (\LAFITE.TOCEOF 45738 . 45977) (LA.READCOUNT 45979 . 46639) (LA.READSTAMP
|
||||
46641 . 46961) (LA.PRINTHEADER 46963 . 49226) (LA.PRINTCOUNT 49228 . 49426) (LA.PRINTSTAMP 49428 .
|
||||
49719) (LA.READSHORTSTRING 49721 . 50120) (LA.PRINTSHORTSTRING 50122 . 50850) (LA.READSTRING 50852 .
|
||||
51167) (\LAFITE.VERIFYMSG 51169 . 52180) (LA.MSGFROMMEP 52182 . 52888)) (52891 61736 (
|
||||
LAFITE.PARSE.MSG.FOR.TOC 52901 . 54691) (LAFITE-EXTRACT-REAL-NAME 54693 . 56332) (
|
||||
LAFITE.FETCH.TO.FIELD 56334 . 56839) (LAFITE.PARSE.HEADER 56841 . 58487) (LAFITE.GRAB.DATE 58489 .
|
||||
58738) (LAFITE.READ.LINE.FOR.TOC 58740 . 59014) (LAFITE.READ.FORMAT 59016 . 59290) (
|
||||
LAFITE.READ.NAME.FIELD 59292 . 59940) (LAFITE.READ.ONE.LINE.FOR.TOC 59942 . 60069) (LAFITE.READ.TO.EOL
|
||||
60071 . 60693) (LA.SKIP.TO.EOL 60695 . 61503) (LAFITE.SKIP.WHITE.SPACE 61505 . 61734)) (61737 62267 (
|
||||
\LAFITE.PARSE.MESSAGE 61747 . 62265)) (63061 64873 (LAFITE.INIT.PARSETABLES 63071 . 63492) (
|
||||
LAFITE.MAKE.PARSE.TABLE 63494 . 63947) (LAFITE.MAKE.PARSE.TABLE1 63949 . 64871)) (64908 67419 (
|
||||
LAFITE.NEW.PARSE.HEADER 64918 . 66739) (LAFITE.HANDLE.ORIGINAL.FIELD 66741 . 67417)))))
|
||||
(FILEMAP (NIL (4499 13702 (\LAFITE.GETMAIL 4509 . 4741) (\LAFITE.GETMAIL.FROM.ICON 4743 . 5000) (
|
||||
\LAFITE.GETMAIL.PROC 5002 . 5345) (\LAFITE.GETNEWMAIL 5347 . 8008) (\LAFITE.GETNEWMAIL1 8010 . 9372) (
|
||||
\LAFITE.GETNEWMAIL# 9374 . 9562) (\LAFITE.RETRIEVEMESSAGES 9564 . 13700)) (13749 27003 (
|
||||
\LAFITE.GET.USER.DATA 13759 . 15147) (\LAFITE.GUESS.MODE 15149 . 16132) (\LAFITE.REGISTER.MODE 16134
|
||||
. 16861) (LAFITECLEARCACHE 16863 . 17337) (FULLUSERNAME 17339 . 18108) (LAFITE.USER.NAME.FROM.LOGIN
|
||||
18110 . 19189) (LAFITEMAILWATCH 19191 . 19635) (\LAFITE.WAKE.WATCHER 19637 . 20019) (POLLNEWMAIL 20021
|
||||
. 25002) (\LAFITE.NEW.MAIL.EXISTS 25004 . 25259) (PRINTLAFITESTATUS 25261 . 26555) (
|
||||
LAFITE.STATUS.WITH.TIME 26557 . 26745) (\LAFITE.REINITIALIZING 26747 . 27001)) (27039 54246 (
|
||||
\LAFITE.PARSE.FOLDER 27049 . 27707) (\LAFITE.PARSE.FOLDER1 27709 . 31305) (\LAFITE.HANDLE.DUPLICATES
|
||||
31307 . 32644) (\LAFITE.CHECK.DUPLICATE 32646 . 33328) (\LAFITE.REPORT.DUPLICATES 33330 . 34262) (
|
||||
BADMAILFILE 34264 . 38197) (BADMAILFILE.CLOSEFN 38199 . 38471) (BADMAILFILE.FLAGBYTE 38473 . 38625) (
|
||||
VERIFYMAILFOLDER 38627 . 41158) (VERIFYFAILED 41160 . 41293) (\LAFITE.READ.TOC.FILE 41295 . 46741) (
|
||||
BADTOCFILE 46743 . 47092) (\LAFITE.TOCEOF 47094 . 47333) (LA.READCOUNT 47335 . 47995) (LA.READSTAMP
|
||||
47997 . 48317) (LA.PRINTHEADER 48319 . 50582) (LA.PRINTCOUNT 50584 . 50782) (LA.PRINTSTAMP 50784 .
|
||||
51075) (LA.READSHORTSTRING 51077 . 51476) (LA.PRINTSHORTSTRING 51478 . 52206) (LA.READSTRING 52208 .
|
||||
52523) (\LAFITE.VERIFYMSG 52525 . 53536) (LA.MSGFROMMEP 53538 . 54244)) (54247 63666 (
|
||||
LAFITE.PARSE.MSG.FOR.TOC 54257 . 56047) (LAFITE-EXTRACT-REAL-NAME 56049 . 57688) (
|
||||
LAFITE.FETCH.TO.FIELD 57690 . 58195) (LAFITE.PARSE.HEADER 58197 . 59843) (LAFITE.GRAB.DATE 59845 .
|
||||
60094) (LAFITE.READ.LINE.FOR.TOC 60096 . 60370) (LAFITE.READ.FORMAT 60372 . 60646) (
|
||||
LAFITE.READ.NAME.FIELD 60648 . 61296) (LAFITE.READ.ONE.LINE.FOR.TOC 61298 . 61425) (LAFITE.READ.TO.EOL
|
||||
61427 . 62049) (LA.SKIP.TO.EOL 62051 . 63386) (LAFITE.SKIP.WHITE.SPACE 63388 . 63664)) (63667 64197 (
|
||||
\LAFITE.PARSE.MESSAGE 63677 . 64195)) (65157 66969 (LAFITE.INIT.PARSETABLES 65167 . 65588) (
|
||||
LAFITE.MAKE.PARSE.TABLE 65590 . 66043) (LAFITE.MAKE.PARSE.TABLE1 66045 . 66967)) (67004 69515 (
|
||||
LAFITE.NEW.PARSE.HEADER 67014 . 68835) (LAFITE.HANDLE.ORIGINAL.FIELD 68837 . 69513)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "24-Apr-2021 17:06:30"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;3 36846
|
||||
(FILECREATED "23-Jun-2021 17:00:30"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;10 22675
|
||||
|
||||
changes to%: (FNS \8859OUTCHARFN \8859INCCODEFN \8859PEEKCCODEFN MAKEISOFORMAT)
|
||||
changes to%: (FNS MAKEISOFORMAT MAKEIBMFORMAT MAKEMACFORMAT)
|
||||
|
||||
previous date%: "24-Apr-2021 17:06:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;2)
|
||||
previous date%: "15-Jun-2021 13:53:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.;9)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -15,7 +15,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(PRETTYCOMPRINT ISO8859IOCOMS)
|
||||
|
||||
(RPAQQ ISO8859IOCOMS
|
||||
(
|
||||
[
|
||||
(* ;; "This package defines EXTERNALFORMATS for files that are encoded in either ISO8859/1, the standard IBM extended ascii, or the usual MAC encoding.")
|
||||
|
||||
(COMS (* ; "ISO8859/1")
|
||||
@@ -35,23 +35,10 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(P (MAKEMACFORMAT)))
|
||||
(COMS (* ; "Independent of char encoding")
|
||||
(FNS \COMMONBACKCHARFN \MAKERECODEMAP \RECODECCODE))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY [P (EVAL (SYSRECLOOK1 'EXTERNALFORMAT]
|
||||
|
||||
(* ;; "From FILEIO")
|
||||
|
||||
(CONSTANTS (\NORUNCODE 255))
|
||||
|
||||
(* ;; "From LLCHAR")
|
||||
|
||||
(CONSTANTS (NSCHARSETSHIFT 255))
|
||||
|
||||
(* ;; "From LLREAD")
|
||||
|
||||
(MACROS \XCCSIN \XCCSPEEK \BACKXCCSCHAR)
|
||||
|
||||
(* ;; "From MODARITH")
|
||||
|
||||
(MACROS UNFOLD))))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (GETP 'EXPORTS.ALL 'FILE)
|
||||
(PRINT
|
||||
"NOTE: ISO8859IO requires EXPORTS.ALL for compilation"
|
||||
T])
|
||||
|
||||
|
||||
|
||||
@@ -68,58 +55,36 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(\8859OUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE)
|
||||
(DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 14:34 by ")
|
||||
(DECLARE (GLOBALVARS *XEROXTOISO8859MAP*)) (* ; "Edited 5-May-2021 16:31 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 14:34 by ")
|
||||
(* ; "Edited 7-Dec-95 14:32 by ")
|
||||
|
||||
(* ;; "Converts CHARCODE from internal Xerox-rendering to ISO8859 before printing. Unconverted codes are left unchanged (no error). If any remaining codes are out of charset 0, the Xerox run-encoding is used (which means that y-umlaut (code 255 in iso) will confuse any readers).")
|
||||
(* ;; "Converts CHARCODE from internal encoding to ISO8859 before printing.")
|
||||
|
||||
(\FILEOUTCHARFN STREAM (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
(* ;; "Unconverted codes are left unchanged (no error).")
|
||||
|
||||
(* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
(* ;; "If any remaining codes are out of charset 0, the streams external format will be used. ")
|
||||
|
||||
(\RECODECCODE CHARCODE *XEROXTOISO8859MAP*)
|
||||
ELSE CHARCODE])
|
||||
(* ;; "Calls \PRINTCCODE instead of \OUTCHAR so that recompiling is not needed if the default external format changes.")
|
||||
|
||||
(\8859INCCODEFN
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 15:24 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(IF COUNTP
|
||||
THEN
|
||||
(\PRINTCCODE (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
|
||||
(* ;; "This is a little goofy. \NSIN passes the COUNTP flag, not the variable. It then takes the COUNT result and subtracts it out. But \XCCSIN is already subtracting from 0, giving a negative count. So we have to reverse the value here. Sigh ")
|
||||
(* ;; "We know that ISO doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
(LET ((COUNT 0))
|
||||
(CL:VALUES (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL COUNT)
|
||||
*ISO8859TOXEROXMAP*)
|
||||
(IMINUS COUNT)))
|
||||
ELSE (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256))
|
||||
*ISO8859TOXEROXMAP*])
|
||||
(\RECODECCODE CHARCODE *XEROXTOISO8859MAP*)
|
||||
ELSE CHARCODE)
|
||||
STREAM])
|
||||
|
||||
(\8859INCCODEFN
|
||||
[LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:50 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 15:24 by ")
|
||||
[LAMBDA (STREAM NOERROR COUNTP) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:21 by ")
|
||||
(* ; "Edited 7-Dec-95 15:51 by ")
|
||||
|
||||
(* ;; "Uses \XCCSPEEK to handle Xerox run-coding")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(CL:WHEN BYTECOUNTVAR
|
||||
(SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL)))
|
||||
(\RECODECCODE (\BIN STRM)
|
||||
(LET (PCODE (COUNT 0))
|
||||
(SETQ PCODE (IF COUNTP
|
||||
THEN (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL NOERROR COUNT)
|
||||
ELSE (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL NOERROR)))
|
||||
(IF COUNTP
|
||||
THEN (CL:VALUES (AND PCODE (\RECODECCODE PCODE *ISO8859TOXEROXMAP*))
|
||||
COUNT)
|
||||
ELSE (AND PCODE (\RECODECCODE PCODE *ISO8859TOXEROXMAP*])
|
||||
*ISO8859TOXEROXMAP*])
|
||||
|
||||
(\8859PEEKCCODEFN
|
||||
[LAMBDA (STRM NOERROR) (* ; "Edited 5-May-2021 17:44 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:21 by ")
|
||||
@@ -128,9 +93,9 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(\RECODECCODE (\PEEKCCODE STRM NOERROR)
|
||||
*ISO8859TOXEROXMAP*])
|
||||
)
|
||||
[LAMBDA NIL (* ; "Edited 24-Apr-2021 17:01 by rmk:")
|
||||
(* ; "Edited 9-Mar-99 17:19 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *XEROXTOISO8859MAP* *ISO8859TOXEROXMAP*)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -212,11 +177,12 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(61919 249)
|
||||
(61920 250)
|
||||
(61921 251)
|
||||
(\INSTALL.EXTERNALFORMAT :ISO8859/1 (CREATE EXTERNALFORMAT
|
||||
INCCODEFN _ (FUNCTION \8859INCCODEFN)
|
||||
PEEKCCODEFN _ (FUNCTION \8859PEEKCCODEFN)
|
||||
BACKCHARFN _ (FUNCTION \COMMONBACKCHARFN)
|
||||
FILEOUTCHARFN _ (FUNCTION \8859OUTCHARFN])
|
||||
(61925 252)
|
||||
(61931 253)
|
||||
(252 254)
|
||||
(61933 255)
|
||||
(61805 376]
|
||||
(SETQ *XEROXTOISO8859MAP* (\MAKERECODEMAP XEROXTOISO))
|
||||
(SETQ *ISO8859TOXEROXMAP* (\MAKERECODEMAP XEROXTOISO T)))
|
||||
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
|
||||
NAME _ :ISO8859/1
|
||||
@@ -228,55 +194,26 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(MAKEISOFORMAT)
|
||||
|
||||
[LAMBDA (STREAM CHARCODE) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
|
||||
|
||||
(* ; "IBM-PC Extended Ascii")
|
||||
|
||||
(* ;; "Converts CHARCODE from internal Xerox-rendering to IBM before printing. Unconverted codes are left unchanged (no error). If any remaining codes are out of charset 0, the Xerox run-encoding is used (which means that y-umlaut (code 255 in iso) will confuse any readers).")
|
||||
(DEFINEQ
|
||||
|
||||
(\FILEOUTCHARFN STREAM (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
(\IBMOUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE) (* ; "Edited 5-May-2021 16:38 by rmk:")
|
||||
(\PRINTCCODE (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
(* ;; "We know that IBM doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
(\RECODECCODE CHARCODE *XEROXTOIBMMAP*)
|
||||
ELSE CHARCODE])
|
||||
|
||||
(\IBMINCCODEFN
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 8-Dec-95 13:23 by ")
|
||||
|
||||
(* ;; "Uses \XCCSIN to handle Xerox run-coding")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(IF COUNTP
|
||||
THEN (LET ((COUNT 0))
|
||||
(CL:VALUES (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL COUNT)
|
||||
*IBMTOXEROXMAP*)
|
||||
(IMINUS COUNT)))
|
||||
ELSE (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256))
|
||||
*IBMTOXEROXMAP*])
|
||||
|
||||
(* ;; "We know that IBM doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
[LAMBDA (STREAM NOERROR COUNTP) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:23 by ")
|
||||
(* ; "Edited 8-Dec-95 13:24 by ")
|
||||
(* ; "Edited 7-Dec-95 15:51 by ")
|
||||
|
||||
(* ;; "Uses \XCCSPEEK to handle Xerox run-coding")
|
||||
(\RECODECCODE CHARCODE *XEROXTOIBMMAP*)
|
||||
ELSE CHARCODE)
|
||||
STREAM])
|
||||
|
||||
(\IBMINCCODEFN
|
||||
(LET (PCODE (COUNT 0))
|
||||
(SETQ PCODE (IF COUNTP
|
||||
THEN (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL NOERROR COUNT)
|
||||
ELSE (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL NOERROR)))
|
||||
(IF COUNTP
|
||||
THEN (CL:VALUES (AND PCODE (\RECODECCODE PCODE *IBMTOXEROXMAP*))
|
||||
COUNT)
|
||||
ELSE (AND PCODE (\RECODECCODE PCODE *IBMTOXEROXMAP*])
|
||||
[LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:50 by rmk:")
|
||||
(* ; "Edited 8-Dec-95 13:23 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
(CL:WHEN BYTECOUNTVAR
|
||||
(SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL)))
|
||||
@@ -285,7 +222,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(\IBMPEEKCCODEFN
|
||||
[LAMBDA (STRM NOERROR COUNTP) (* ; "Edited 5-May-2021 17:44 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-99 17:33 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:23 by ")
|
||||
(* ; "Edited 8-Dec-95 13:24 by ")
|
||||
(* ; "Edited 7-Dec-95 15:51 by ")
|
||||
(* ; "Edited 7-Dec-95 15:19 by ")
|
||||
@@ -375,11 +312,12 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(162 155)
|
||||
(163 156)
|
||||
(165 157)
|
||||
(\INSTALL.EXTERNALFORMAT :IBM (CREATE EXTERNALFORMAT
|
||||
INCCODEFN _ (FUNCTION \IBMINCCODEFN)
|
||||
PEEKCCODEFN _ (FUNCTION \IBMPEEKCCODEFN)
|
||||
BACKCHARFN _ (FUNCTION \COMMONBACKCHARFN)
|
||||
FILEOUTCHARFN _ (FUNCTION \IBMOUTCHARFN])
|
||||
(167 21)
|
||||
(171 174)
|
||||
(176 248)
|
||||
(177 241)
|
||||
(178 253)
|
||||
(181 230)
|
||||
(182 20)
|
||||
(183 250)
|
||||
(187 175)
|
||||
@@ -391,54 +329,33 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
|
||||
NAME _ :IBM
|
||||
INCCODEFN _ (FUNCTION \IBMINCCODEFN)
|
||||
[LAMBDA (STREAM CHARCODE) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
PEEKCCODEFN _ (FUNCTION \IBMPEEKCCODEFN)
|
||||
BACKCCODEFN _ (FUNCTION \COMMONBACKCHARFN)
|
||||
(* ;; "Converts CHARCODE from internal Xerox-rendering to MAC before printing. Unconverted codes are left unchanged (no error). If any remaining codes are out of charset 0, the Xerox run-encoding is used (which means that code 255 will confuse any readers).")
|
||||
OUTCHARFN _ (FUNCTION \IBMOUTCHARFN])
|
||||
)
|
||||
(\FILEOUTCHARFN STREAM (IF (IGREATERP CHARCODE 127)
|
||||
THEN
|
||||
|
||||
(MAKEIBMFORMAT)
|
||||
(* ;; "We know that MAC doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
|
||||
(\RECODECCODE CHARCODE *XEROXTOMACMAP*)
|
||||
ELSE CHARCODE])
|
||||
|
||||
(* ; "Macintosh")
|
||||
(\MACINCCODEFN
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 8-Dec-95 13:29 by ")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(* ;; "Uses \XCCSIN to handle Xerox run-coding")
|
||||
(\MACOUTCHARFN
|
||||
[LAMBDA (STREAM CHARCODE) (* ; "Edited 5-May-2021 16:28 by rmk:")
|
||||
(IF COUNTP
|
||||
THEN (LET ((COUNT 0))
|
||||
(CL:VALUES (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL COUNT)
|
||||
*MACTOXEROXMAP*)
|
||||
(IMINUS COUNT)))
|
||||
ELSE (\RECODECCODE (\XCCSIN STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256))
|
||||
*MACTOXEROXMAP*])
|
||||
|
||||
(* ;; "Converts CHARCODE from internal encoding to MAC before printing.")
|
||||
|
||||
(* ;; "Unconverted codes are left unchanged (no error).")
|
||||
|
||||
(* ;; "If any remaining codes are out of charset 0, the streams external format will be used.")
|
||||
|
||||
[LAMBDA (STREAM NOERROR COUNTP) (* ; "Edited 9-Mar-99 16:59 by rmk:")
|
||||
(* ; "Edited 3-Jan-96 14:23 by ")
|
||||
(* ;; "Calls \PRINTCCODE instead of \OUTCHAR so that recompiling is not needed if the default external format changes.")
|
||||
|
||||
(\PRINTCCODE (IF (IGREATERP CHARCODE 127)
|
||||
|
||||
(* ;; "Uses \XCCSPEEK to handle Xerox run-coding")
|
||||
|
||||
(LET (PCODE (COUNT 0))
|
||||
(SETQ PCODE (IF COUNTP
|
||||
THEN (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL NOERROR COUNT)
|
||||
ELSE (\XCCSPEEK STREAM (UNFOLD (ACCESS-CHARSET STREAM)
|
||||
256)
|
||||
NIL NOERROR)))
|
||||
(IF COUNTP
|
||||
THEN (CL:VALUES (AND PCODE (\RECODECCODE PCODE *MACTOXEROXMAP*))
|
||||
COUNT)
|
||||
ELSE (AND PCODE (\RECODECCODE PCODE *MACTOXEROXMAP*])
|
||||
THEN
|
||||
|
||||
(* ;; "We know that MAC doesn't have floating accents, so only singletons are returned. We also know that it agrees with Xerox on first 128")
|
||||
|
||||
(\RECODECCODE CHARCODE *XEROXTOMACMAP*)
|
||||
@@ -447,8 +364,8 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(\MACINCCODEFN
|
||||
[LAMBDA (STRM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 15-Jun-2021 13:50 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 9-Mar-99 17:32 by rmk:")
|
||||
(* ; "Edited 7-Dec-95 16:24 by ")
|
||||
(* ; "Edited 8-Dec-95 13:29 by ")
|
||||
(CL:WHEN BYTECOUNTVAR
|
||||
(SET BYTECOUNTVAR (SUB1 BYTECOUNTVAL)))
|
||||
(\RECODECCODE (\BIN STRM)
|
||||
*MACTOXEROXMAP*])
|
||||
@@ -561,11 +478,12 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(61346 196)
|
||||
(61305 197)
|
||||
(9797 198)
|
||||
(\INSTALL.EXTERNALFORMAT :MACINTOSH (CREATE EXTERNALFORMAT
|
||||
INCCODEFN _ (FUNCTION \MACINCCODEFN)
|
||||
PEEKCCODEFN _ (FUNCTION \MACPEEKCCODEFN)
|
||||
BACKCHARFN _ (FUNCTION \COMMONBACKCHARFN)
|
||||
FILEOUTCHARFN _ (FUNCTION \MACOUTCHARFN])
|
||||
(171 199)
|
||||
(187 200)
|
||||
(8516 201)
|
||||
(32 202)
|
||||
(61220 208)
|
||||
(61221 209)
|
||||
(8574 215)
|
||||
(47 218)
|
||||
(164 219)
|
||||
@@ -576,17 +494,7 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(61233 224)
|
||||
(183 225)
|
||||
(9138 226)
|
||||
(\COMMONBACKCHARFN
|
||||
[LAMBDA (STREAM COUNTP) (* ; "Edited 29-Mar-96 10:55 by rmk")
|
||||
(* ; "Edited 8-Dec-95 13:26 by ")
|
||||
|
||||
(* ;; "Let \BACKXCCSCHAR handle the run-coding. The charset in the stream is the charset byte, unconverted to ISO. This is independent of the particular character translation.")
|
||||
|
||||
(IF COUNTP
|
||||
THEN (LET ((COUNT 0))
|
||||
(\BACKXCCSCHAR STREAM COUNT)
|
||||
COUNT)
|
||||
ELSE (\BACKXCCSCHAR STREAM NIL])
|
||||
(61224 227)
|
||||
(61249 228]
|
||||
(SETQ *XEROXTOMACMAP* (\MAKERECODEMAP XEROXTOMAC))
|
||||
(SETQ *MACTOXEROXMAP* (\MAKERECODEMAP XEROXTOMAC T))
|
||||
@@ -622,160 +530,15 @@ Copyright (c) 1995-1997, 1999, 2021 by Xerox Corporation.
|
||||
(CL:WHEN INVERTED
|
||||
[SETQ CODEMAP (FOR C IN CODEMAP COLLECT (LIST (CADR C)
|
||||
(CAR C])
|
||||
(EVAL (SYSRECLOOK1 'EXTERNALFORMAT))
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \NORUNCODE 255)
|
||||
|
||||
|
||||
(CONSTANTS (\NORUNCODE 255))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ NSCHARSETSHIFT 255)
|
||||
|
||||
|
||||
(CONSTANTS (NSCHARSETSHIFT 255))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \XCCSIN MACRO [(STREAM SHIFTEDCSET SHIFTEDCSETVAR COUNTERVAR)
|
||||
|
||||
(* ;;; "returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8, SHIFTEDCSETVAR if non-NIL is the variable to set if char set changes. COUNTERVAR if non-NIL is decremented by number of bytes read. Doesn't do EOL conversion -- \INCHAR and \INCCODE do that.")
|
||||
|
||||
(LET ((CHAR (\BIN STREAM))
|
||||
SCSET)
|
||||
(COND
|
||||
[(EQ CHAR NSCHARSETSHIFT)
|
||||
(* ; "Shifting character sets")
|
||||
[ACCESS-CHARSET STREAM
|
||||
(SETQ SCSET (COND
|
||||
((NEQ NSCHARSETSHIFT (SETQ CHAR
|
||||
(\BIN STREAM)))
|
||||
(AND 'COUNTERVAR (SETQ COUNTERVAR
|
||||
(IDIFFERENCE
|
||||
COUNTERVAR 2)))
|
||||
CHAR)
|
||||
((PROGN
|
||||
(* ;
|
||||
"2 shift-bytes means not run-encoded")
|
||||
(AND 'COUNTERVAR
|
||||
(SETQ COUNTERVAR
|
||||
(IDIFFERENCE COUNTERVAR
|
||||
3)))
|
||||
(EQ 0 (\BIN STREAM)))
|
||||
\NORUNCODE)
|
||||
(T (\NSIN.24BITENCODING.ERROR STREAM]
|
||||
(SETQ CHAR (\BIN STREAM))
|
||||
(SETQ SCSET (COND
|
||||
('SHIFTEDCSETVAR
|
||||
(* ; "CHARSETVAR=NIL means don't set")
|
||||
(SETQ SHIFTEDCSETVAR (UNFOLD SCSET
|
||||
256)))
|
||||
(T (UNFOLD SCSET 256]
|
||||
(T (SETQ SCSET SHIFTEDCSET)))
|
||||
(COND
|
||||
((EQ SCSET (UNFOLD \NORUNCODE 256))
|
||||
(* ;
|
||||
"just read two bytes and combine them to a 16 bit value")
|
||||
(AND 'COUNTERVAR (SETQ COUNTERVAR (IDIFFERENCE COUNTERVAR 2
|
||||
)))
|
||||
(LOGOR (UNFOLD CHAR 256)
|
||||
(\BIN STREAM)))
|
||||
(CHAR (AND 'COUNTERVAR (SETQ COUNTERVAR (IDIFFERENCE
|
||||
COUNTERVAR 1)
|
||||
))
|
||||
(AND CHAR (LOGOR SCSET CHAR])
|
||||
|
||||
(PUTPROPS \XCCSPEEK MACRO [(STREAM SHIFTEDCSET SHIFTEDCSETVAR NOERROR COUNTERVAR)
|
||||
|
||||
(* ;; "Returns a 16 bit character code. Doesn't do EOL conversion--\INCHAR does that. May actually read the character-set shift, storing the result in the stream. COUNTERVAR, if given, is updated to reflect any such bytes that are actually read")
|
||||
|
||||
(PROG ((CHAR (\PEEKBIN STREAM NOERROR))
|
||||
SCSET)
|
||||
(COND
|
||||
((NULL CHAR)
|
||||
(RETURN NIL))
|
||||
[(EQ CHAR NSCHARSETSHIFT)
|
||||
(* ; "CHARSETVAR=NIL means don't set")
|
||||
(\BIN STREAM) (* ; "Consume the char shift byte")
|
||||
[ACCESS-CHARSET STREAM
|
||||
(SETQ SCSET (COND
|
||||
((NEQ NSCHARSETSHIFT
|
||||
(SETQ CHAR (\BIN STREAM)))
|
||||
(* ;
|
||||
"Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error")
|
||||
(AND 'COUNTERVAR
|
||||
(SETQ COUNTERVAR
|
||||
(IDIFFERENCE COUNTERVAR 2))
|
||||
)
|
||||
CHAR)
|
||||
((PROGN
|
||||
(* ;
|
||||
"2 shift-bytes means not run-encoded")
|
||||
(AND 'COUNTERVAR
|
||||
(SETQ COUNTERVAR
|
||||
(IDIFFERENCE
|
||||
COUNTERVAR 3)
|
||||
))
|
||||
(EQ 0 (\BIN STREAM)))
|
||||
\NORUNCODE)
|
||||
(T (\NSIN.24BITENCODING.ERROR
|
||||
STREAM]
|
||||
[SETQ SCSET (COND
|
||||
('SHIFTEDCSETVAR
|
||||
(* ; "CHARSETVAR=NIL means don't set")
|
||||
(SETQ SHIFTEDCSETVAR
|
||||
(UNFOLD SCSET 256)))
|
||||
(T (UNFOLD SCSET 256]
|
||||
(COND
|
||||
((NULL (SETQ CHAR (\PEEKBIN STREAM NOERROR)))
|
||||
(RETURN NIL]
|
||||
(T (SETQ SCSET SHIFTEDCSET)))
|
||||
(RETURN (COND
|
||||
((EQ SCSET (UNFOLD \NORUNCODE 256))
|
||||
|
||||
(* ;; "just peek two bytes and combine them to a 16 bit value. Again, is an error if we hit eof in mid-character")
|
||||
|
||||
(\BIN STREAM)
|
||||
(PROG1 (LOGOR (UNFOLD CHAR 256)
|
||||
(\PEEKBIN STREAM NOERROR))
|
||||
(\BACKFILEPTR STREAM)))
|
||||
(T (LOGOR SHIFTEDCSET CHAR])
|
||||
|
||||
(PUTPROPS \BACKXCCSCHAR MACRO [(STREAM SHIFTEDCHARSET COUNTERVAR)
|
||||
(AND (\BACKFILEPTR STREAM)
|
||||
(COND
|
||||
[[COND
|
||||
(SHIFTEDCHARSET (EQ SHIFTEDCHARSET
|
||||
(UNFOLD \NORUNCODE 256)))
|
||||
(T (EQ \NORUNCODE (ACCESS-CHARSET STREAM]
|
||||
(COND
|
||||
((\BACKFILEPTR STREAM)
|
||||
(AND 'COUNTERVAR (add COUNTERVAR 2))
|
||||
T)
|
||||
('COUNTERVAR (add COUNTERVAR 1]
|
||||
('COUNTERVAR (add COUNTERVAR 1])
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS UNFOLD MACRO [X (PROG [(FORM (CAR X))
|
||||
(DIVISOR (CAR (CONSTANTEXPRESSIONP (CADR X]
|
||||
(OR (AND DIVISOR (POWEROFTWOP DIVISOR))
|
||||
(\ILLEGAL.ARG (CADR X)))
|
||||
(RETURN (LIST 'LLSH FORM (SUB1 (INTEGERLENGTH DIVISOR])
|
||||
)
|
||||
(FOR M (MAPARRAY _ (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
CSMAP IN CODEMAP UNLESS (EQ (CAR M)
|
||||
(CADR M))
|
||||
DO (CL:UNLESS (SETQ CSMAP (CL:SVREF MAPARRAY (LRSH (CAR M)
|
||||
8)))
|
||||
(FILEMAP (NIL (2391 5846 (\8859OUTCHARFN 2401 . 3463) (\8859INCCODEFN 3465 . 4657) (\8859PEEKCCODEFN
|
||||
4659 . 5844)) (5938 9711 (MAKEISOFORMAT 5948 . 9709)) (9771 12858 (\IBMOUTCHARFN 9781 . 10606) (
|
||||
\IBMINCCODEFN 10608 . 11578) (\IBMPEEKCCODEFN 11580 . 12856)) (12942 16693 (MAKEIBMFORMAT 12952 .
|
||||
16691)) (16741 19512 (\MACOUTCHARFN 16751 . 17558) (\MACINCCODEFN 17560 . 18431) (\MACPEEKCCODEFN
|
||||
18433 . 19510)) (19596 24385 (MAKEMACFORMAT 19606 . 24383)) (24452 26736 (\COMMONBACKCHARFN 24462 .
|
||||
25057) (\MAKERECODEMAP 25059 . 26289) (\RECODECCODE 26291 . 26734)))))
|
||||
(SETQ CSMAP (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT NIL))
|
||||
(CL:SETF (CL:SVREF MAPARRAY (LRSH (CAR M)
|
||||
8))
|
||||
CSMAP))
|
||||
(CL:SETF (CL:SVREF CSMAP (LOGAND (CAR M)
|
||||
255))
|
||||
(CADR M)) FINALLY (RETURN MAPARRAY])
|
||||
|
||||
Binary file not shown.
@@ -1,466 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "22-Feb-2021 14:01:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;78 20371
|
||||
|
||||
changes to%: (VARS MACINTERFACECOMS)
|
||||
|
||||
previous date%: "22-Feb-2021 12:56:21"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;77)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MACINTERFACECOMS)
|
||||
|
||||
(RPAQQ MACINTERFACECOMS
|
||||
[
|
||||
(* ;; "Externals")
|
||||
|
||||
(COMS (FNS MACWINDOW MACWINDOW.SETUP UNMACWINDOW MACWINDOW.UNSETUP)
|
||||
(INITVARS (MACWINDOWMARGIN 25)))
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
[COMS (FNS MACWINDOW.BUTTONEVENTFN MACWINDOW.BUTTONEVENTFN.ANYWHERE NEARTOP NEARESTCORNER
|
||||
INCORNER.REGION)
|
||||
|
||||
(* ;; "Behavior for some known window creators")
|
||||
|
||||
(FNS MACINT-ADD-EXEC MACINT-SNAPW)
|
||||
(FNS TEDIT.MACINTERFACE TEDIT.SELECTALL)
|
||||
(FNS TOTOPW.MACINTERFACE)
|
||||
(P (MOVD 'TOTOPW.MACINTERFACE 'TOTOPW.MODERNIZE)
|
||||
(MOVD 'MACWINDOW 'MODERNWINDOW)
|
||||
(MOVD 'UNMACWINDOW 'UNMODERNWINDOW))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (TEDIT.MACINTERFACE)
|
||||
|
||||
(* ;; "Inspector")
|
||||
|
||||
(MACWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
|
||||
|
||||
|
||||
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
|
||||
|
||||
(* (MACWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
|
||||
(MACWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
|
||||
|
||||
(* ;; "Freemenu")
|
||||
|
||||
(MACWINDOW.SETUP '\FM.BUTTONEVENTFN)
|
||||
|
||||
(* ;; "SEDIT")
|
||||
|
||||
(MACWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
|
||||
|
||||
(* ;; "Debugger")
|
||||
|
||||
(MACWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
|
||||
|
||||
(* ;; "Snap")
|
||||
|
||||
(MACWINDOW.SETUP 'SNAPW 'MACINT-SNAPW)
|
||||
|
||||
(* ;; "New execs")
|
||||
|
||||
(MACWINDOW.SETUP 'ADD-EXEC 'MACINT-ADD-EXEC)
|
||||
|
||||
(* ;; "Existing exec of the load")
|
||||
|
||||
(MACWINDOW (PROCESSPROP (TTY.PROCESS)
|
||||
'WINDOW))
|
||||
|
||||
(* ;; "Table browser (for filebrowser)")
|
||||
|
||||
(MACWINDOW.SETUP 'TB.BUTTONEVENTFN)
|
||||
|
||||
(* ;; "Grapher")
|
||||
|
||||
(MACWINDOW.SETUP 'APPLYTOSELECTEDNODE)
|
||||
|
||||
(* ;; "Promptwindow")
|
||||
|
||||
(MACWINDOW PROMPTWINDOW T]
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA MACINT-ADD-EXEC])
|
||||
|
||||
|
||||
|
||||
(* ;; "Externals")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(MACWINDOW
|
||||
[LAMBDA (WINDOW ANYWHERE) (* ; "Edited 23-Jun-2020 16:01 by rmk:")
|
||||
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn.")
|
||||
|
||||
(CL:UNLESS (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN)
|
||||
(WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (IF ANYWHERE
|
||||
THEN (FUNCTION MACWINDOW.BUTTONEVENTFN.ANYWHERE)
|
||||
ELSE (FUNCTION MACWINDOW.BUTTONEVENTFN))))
|
||||
WINDOW])
|
||||
|
||||
(MACWINDOW.SETUP
|
||||
[LAMBDA (ORIGFN MACWINDOWFN ANYWHERE) (* ; "Edited 13-Feb-2021 19:53 by rmk:")
|
||||
|
||||
(* ;; "ORIGFN is either a function that creates windows of a given type (e.g. SNAPW or ADD-EXEC) or the known BUTTONEVENTFN of a class of windows.")
|
||||
|
||||
(* ;; "Moves ORIGNFN to a new name, prefixed with MACORIG-.")
|
||||
|
||||
(* ;; "If MACWINDOWFN is given, then that replaces the original definition of ORIGFN, and presumably knows how to call the renamed ORIGFN under the right circumstances. This is typically the case where ORIGFN is a window creator.")
|
||||
|
||||
(* ;; "Otherwise, ORIGFN is taken to be the BUTTONEVENTFN for a class of windows, and its new definition is defaulted to one that maps left-clicks in appropriate areas into Mac window operations. If not in appropriate areas, then the renamed ORIGNFN is called to give the original button behavior.")
|
||||
|
||||
(* ;; "If ANYWHERE, moving will happen for any click not in one of the shaping corners.")
|
||||
|
||||
(* ;; "The renamed function has arguments in addition to WINDOW: the new name for the original function, if MACWINDOFN is provided, and the value specified here for ANYWHERE.")
|
||||
|
||||
(LET [RENAMEDORIG (PKGNAME (CL:PACKAGE-NAME (CL:SYMBOL-PACKAGE ORIGFN]
|
||||
|
||||
(* ;; "The renamed version of XCL symbols go into Interlisp, so there is less confusion about accessing it")
|
||||
|
||||
(CL:WHEN (STREQUAL PKGNAME "XEROX-COMMON-LISP")
|
||||
(SETQ PKGNAME "INTERLISP"))
|
||||
(SETQ RENAMEDORIG (CL:INTERN (CONCAT 'MACORIG- ORIGFN)
|
||||
PKGNAME))
|
||||
(MOVD? ORIGFN RENAMEDORIG)
|
||||
(IF MACWINDOWFN
|
||||
THEN (MOVD MACWINDOWFN ORIGFN)
|
||||
ELSE (PUTD ORIGFN `(LAMBDA (WINDOW)
|
||||
(MACWINDOW.BUTTONEVENTFN WINDOW (FUNCTION ,RENAMEDORIG)
|
||||
,ANYWHERE])
|
||||
|
||||
(UNMACWINDOW
|
||||
[LAMBDA (WINDOW) (* ; "Edited 7-Dec-2020 17:57 by rmk:")
|
||||
|
||||
(* ;; "Restores original window behavior")
|
||||
|
||||
(CL:WHEN (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN)
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN NIL))
|
||||
WINDOW])
|
||||
|
||||
(MACWINDOW.UNSETUP
|
||||
[LAMBDA (ORIGFN) (* ; "Edited 6-Jul-2020 13:04 by rmk:")
|
||||
(* ; "Edited 24-Jun-2020 15:09 by rmk:")
|
||||
|
||||
(* ;; "Moves the renamed original function back to its original name")
|
||||
|
||||
(LET [RENAMEDORIG (PKGNAME (CL:PACKAGE-NAME (CL:SYMBOL-PACKAGE ORIGFN]
|
||||
|
||||
(* ;; "The renamed version of XCL symbols go into Interlisp, so there is less confusion about accessing it")
|
||||
|
||||
(CL:WHEN (STREQUAL PKGNAME "XEROX-COMMON-LISP")
|
||||
(SETQ PKGNAME "INTERLISP"))
|
||||
(SETQ RENAMEDORIG (CL:INTERN (CONCAT 'MACORIG- ORIGFN)
|
||||
PKGNAME))
|
||||
(CL:WHEN (GETD RENAMEDORIG)
|
||||
(MOVD RENAMEDORIG ORIGFN])
|
||||
)
|
||||
|
||||
(RPAQ? MACWINDOWMARGIN 25)
|
||||
|
||||
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(MACWINDOW.BUTTONEVENTFN
|
||||
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE) (* ; "Edited 14-Feb-2021 21:51 by rmk:")
|
||||
(* ; "Edited 24-Jun-2020 20:23 by rmk:")
|
||||
(* ; "Edited 23-May-2020 08:34 by rmk:")
|
||||
(* ; "Edited 10-May-2020 03:35 by rmk:")
|
||||
(* ; "Edited 3-May-2020 21:18 by rmk:")
|
||||
(IF (AND (MOUSESTATE (ONLY LEFT))
|
||||
(EQ LASTKEYBOARD 0))
|
||||
THEN (TOTOPW WINDOW)
|
||||
(LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION))
|
||||
(ATTACHEDREGION (WINDOWREGION WINDOW 'SHAPEW]
|
||||
|
||||
(* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.")
|
||||
|
||||
(* ;; "This is particularly the case of FILEBROWSER windows, where the the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")
|
||||
|
||||
(SETQ TOPMARGIN (IF (WINDOWPROP WINDOW 'TOPMARGIN)
|
||||
ELSEIF (WINDOWPROP WINDOW 'TITLE)
|
||||
THEN (FONTPROP WindowTitleDisplayStream 'HEIGHT)
|
||||
ELSE MACWINDOWMARGIN))
|
||||
(SETQ CORNER (INCORNER.REGION MAINREGION TOPMARGIN))
|
||||
(IF CORNER
|
||||
THEN
|
||||
|
||||
(* ;;
|
||||
"The upper corners may be in the title bar, near the side, so test corners before titlebar.")
|
||||
|
||||
(* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")
|
||||
|
||||
(* ;; "WINDOWREGION includes the attached windows")
|
||||
|
||||
(LET ((LEFT (FETCH LEFT OF ATTACHEDREGION))
|
||||
(RIGHT (FETCH RIGHT OF ATTACHEDREGION))
|
||||
(TOP (FETCH TOP OF ATTACHEDREGION))
|
||||
(BOTTOM (FETCH BOTTOM OF ATTACHEDREGION))
|
||||
STARTINGREGION)
|
||||
|
||||
(* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")
|
||||
|
||||
(CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
|
||||
[SETQ STARTINGREGION
|
||||
(GETREGION NIL NIL NIL NIL NIL
|
||||
(SELECTQ CORNER
|
||||
(RIGHTBOTTOM (\CURSORPOSITION RIGHT BOTTOM)
|
||||
(GETMOUSESTATE)
|
||||
(LIST LEFT TOP RIGHT BOTTOM))
|
||||
(LEFTBOTTOM (\CURSORPOSITION LEFT BOTTOM)
|
||||
(GETMOUSESTATE)
|
||||
(LIST RIGHT TOP LEFT BOTTOM))
|
||||
(RIGHTTOP (\CURSORPOSITION RIGHT TOP)
|
||||
(GETMOUSESTATE)
|
||||
(LIST LEFT BOTTOM RIGHT TOP))
|
||||
(LEFTTOP (\CURSORPOSITION LEFT TOP)
|
||||
(GETMOUSESTATE)
|
||||
(LIST RIGHT BOTTOM LEFT TOP))
|
||||
(SHOULDNT])
|
||||
(SHAPEW WINDOW STARTINGREGION))
|
||||
T
|
||||
ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN))
|
||||
THEN (NEARESTCORNER ATTACHEDREGION)
|
||||
(MOVEW WINDOW)
|
||||
T
|
||||
ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
|
||||
'PREMACBUTTONEVENTFN]
|
||||
THEN (APPLY* ORIGFUNCTION WINDOW)))
|
||||
ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN]
|
||||
THEN (APPLY* ORIGFUNCTION WINDOW])
|
||||
|
||||
(MACWINDOW.BUTTONEVENTFN.ANYWHERE
|
||||
[LAMBDA (WINDOW) (* ; "Edited 3-Dec-2020 14:24 by rmk:")
|
||||
(* ; "Edited 24-Jun-2020 13:24 by rmk:")
|
||||
|
||||
(* ;; "Move if left-click anywhere, not just titlebar")
|
||||
|
||||
(MACWINDOW.BUTTONEVENTFN WINDOW NIL T])
|
||||
|
||||
(NEARTOP
|
||||
[LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:19 by rmk:")
|
||||
|
||||
(* ;; "True if the MOUSEY is near the top of MAINREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
|
||||
|
||||
(IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION)
|
||||
TOPMARGIN])
|
||||
|
||||
(NEARESTCORNER
|
||||
[LAMBDA (REGION) (* ; "Edited 14-Feb-2021 21:46 by rmk:")
|
||||
|
||||
(* ;;
|
||||
"Moves the cursor to the corner of REGION that is closest to the current LASTMOUSEX AND LASTMOUSEY")
|
||||
|
||||
(\CURSORPOSITION (CL:IF (ILESSP (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF REGION))
|
||||
(IDIFFERENCE (FETCH RIGHT OF REGION)
|
||||
LASTMOUSEX))
|
||||
(FETCH LEFT OF REGION)
|
||||
(FETCH RIGHT OF REGION))
|
||||
(CL:IF (ILESSP (IDIFFERENCE LASTMOUSEY (FETCH BOTTOM OF REGION))
|
||||
(IDIFFERENCE (FETCH TOP OF REGION)
|
||||
LASTMOUSEY))
|
||||
(FETCH BOTTOM OF REGION)
|
||||
(FETCH TOP OF REGION))])
|
||||
|
||||
(INCORNER.REGION
|
||||
[LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:22 by rmk:")
|
||||
|
||||
(* ;; "MAINREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")
|
||||
|
||||
(* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")
|
||||
|
||||
(IF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF MAINREGION)))
|
||||
MACWINDOWMARGIN)
|
||||
THEN (IF (NEARTOP MAINREGION TOPMARGIN)
|
||||
THEN 'LEFTTOP
|
||||
ELSEIF (ILEQ LASTMOUSEY (IPLUS MACWINDOWMARGIN (FETCH BOTTOM OF
|
||||
MAINREGION
|
||||
)))
|
||||
THEN 'LEFTBOTTOM)
|
||||
ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF MAINREGION)))
|
||||
MACWINDOWMARGIN)
|
||||
THEN (IF (NEARTOP MAINREGION TOPMARGIN)
|
||||
THEN 'RIGHTTOP
|
||||
ELSEIF (ILEQ LASTMOUSEY (IPLUS MACWINDOWMARGIN (FETCH BOTTOM OF
|
||||
MAINREGION
|
||||
)))
|
||||
THEN 'RIGHTBOTTOM])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Behavior for some known window creators")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(MACINT-ADD-EXEC
|
||||
[LAMBDA U (* ; "Edited 24-Jun-2020 14:23 by rmk:")
|
||||
(LET [(PROC (APPLY (FUNCTION MACORIG-ADD-EXEC)
|
||||
(FOR N FROM 1 TO U COLLECT (ARG U N]
|
||||
|
||||
(* ;; "For some reason, the window may not be there immediately")
|
||||
|
||||
(DISMISS 100)
|
||||
(MACWINDOW (PROCESSPROP PROC 'WINDOW))
|
||||
PROC])
|
||||
|
||||
(MACINT-SNAPW
|
||||
[LAMBDA NIL (* ; "Edited 24-Jun-2020 13:19 by rmk:")
|
||||
|
||||
(* ;; "No point in shaping a snap window, just move it.;;")
|
||||
|
||||
(* ;;
|
||||
"This changes the creation function (SNAPW), since snap windows otherwise don't have a BUTTONEVENTN")
|
||||
|
||||
(LET ((W (MACORIG-SNAPW)))
|
||||
[WINDOWPROP W 'BUTTONEVENTFN (FUNCTION (LAMBDA (W)
|
||||
(TOTOPW W)
|
||||
(MOVEW W]
|
||||
W])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.MACINTERFACE
|
||||
[LAMBDA NIL (* ; "Edited 22-Feb-2021 12:56 by rmk:")
|
||||
(CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN)
|
||||
(MACWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
|
||||
|
||||
(* ;; "All")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,a")
|
||||
(FUNCTION TEDIT.SELECTALL)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,A")
|
||||
(FUNCTION TEDIT.SELECTALL)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Quit")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,q")
|
||||
(FUNCTION TEDIT.QUIT)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,Q")
|
||||
(FUNCTION TEDIT.QUIT)
|
||||
TEDIT.READTABLE))])
|
||||
|
||||
(TEDIT.SELECTALL
|
||||
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:")
|
||||
(LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
|
||||
(CL:WHEN TEXTSTREAM
|
||||
(TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM)))
|
||||
'LEFT))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TOTOPW.MACINTERFACE
|
||||
[LAMBDA (WINDOW) (* ; "Edited 13-Feb-2021 23:27 by rmk:")
|
||||
|
||||
(* ;; "This replaces the TOTOPW BUTTONEVENTFN on an attached window where the click is then directed to the MAINWINDOW.")
|
||||
|
||||
(TOTOPW WINDOW)
|
||||
(LET ((MAIN (MAINWINDOW WINDOW T)))
|
||||
(CL:WHEN MAIN
|
||||
(MACWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))])
|
||||
)
|
||||
|
||||
(MOVD 'TOTOPW.MACINTERFACE 'TOTOPW.MODERNIZE)
|
||||
|
||||
(MOVD 'MACWINDOW 'MODERNWINDOW)
|
||||
|
||||
(MOVD 'UNMACWINDOW 'UNMODERNWINDOW)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(TEDIT.MACINTERFACE)
|
||||
|
||||
|
||||
(* ;; "Inspector")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
|
||||
|
||||
|
||||
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
|
||||
|
||||
|
||||
(* (MACWINDOW.SETUP
|
||||
(QUOTE ONEDINSPECT.BUTTONEVENTFN)))
|
||||
|
||||
(MACWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
|
||||
|
||||
|
||||
(* ;; "Freemenu")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP '\FM.BUTTONEVENTFN)
|
||||
|
||||
|
||||
(* ;; "SEDIT")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
|
||||
|
||||
|
||||
(* ;; "Debugger")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
|
||||
|
||||
|
||||
(* ;; "Snap")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP 'SNAPW 'MACINT-SNAPW)
|
||||
|
||||
|
||||
(* ;; "New execs")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP 'ADD-EXEC 'MACINT-ADD-EXEC)
|
||||
|
||||
|
||||
(* ;; "Existing exec of the load")
|
||||
|
||||
|
||||
(MACWINDOW (PROCESSPROP (TTY.PROCESS)
|
||||
'WINDOW))
|
||||
|
||||
|
||||
(* ;; "Table browser (for filebrowser)")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP 'TB.BUTTONEVENTFN)
|
||||
|
||||
|
||||
(* ;; "Grapher")
|
||||
|
||||
|
||||
(MACWINDOW.SETUP 'APPLYTOSELECTEDNODE)
|
||||
|
||||
|
||||
(* ;; "Promptwindow")
|
||||
|
||||
|
||||
(MACWINDOW PROMPTWINDOW T)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA MACINT-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4238 7997 (MACWINDOW 4248 . 4889) (MACWINDOW.SETUP 4891 . 6807) (UNMACWINDOW 6809 .
|
||||
7188) (MACWINDOW.UNSETUP 7190 . 7995)) (8057 16239 (MACWINDOW.BUTTONEVENTFN 8067 . 13089) (
|
||||
MACWINDOW.BUTTONEVENTFN.ANYWHERE 13091 . 13456) (NEARTOP 13458 . 13894) (NEARESTCORNER 13896 . 14775)
|
||||
(INCORNER.REGION 14777 . 16237)) (16297 17274 (MACINT-ADD-EXEC 16307 . 16731) (MACINT-SNAPW 16733 .
|
||||
17272)) (17275 18358 (TEDIT.MACINTERFACE 17285 . 18027) (TEDIT.SELECTALL 18029 . 18356)) (18359 18799
|
||||
(TOTOPW.MACINTERFACE 18369 . 18797)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,52 +0,0 @@
|
||||
MACINTERFACE documentation
|
||||
|
||||
Ron Kaplan, June 2020
|
||||
|
||||
MACINTERFACE is a symbol Lispusers package that changes the mouse actions on Medley windows so that moving and shaping can be done in a way that approximates the behavior of windows on the Mac desktop.
|
||||
|
||||
Thus, for a window that has been created or transformed in this way, you can move the window by left-clicking in the title bar and dragging the window.
|
||||
|
||||
The menu behavior for other buttons in the title bar is unchanged.
|
||||
|
||||
Similarly, you can reshape a window by clicking near one of its corners and dragging it out.
|
||||
|
||||
For bottom corners, "near" means inside the window within MACINTERFACECORNERMARGIN (initially 25) pixels above or to the left/right of the corner.
|
||||
|
||||
For top corners, "near" means within the title bar and within the margin from the left/right edges.
|
||||
|
||||
(Windows that don't have a title-bar, like Snap windows, can be set up so that moving can happen by clicking anywhere, and shaping at the top is determined by the margin inside the window region.)
|
||||
|
||||
When the package is loaded, this behavior is installed for the following kinds of windows:
|
||||
|
||||
Tedit
|
||||
Debugger/break
|
||||
Sedit
|
||||
Inspector
|
||||
Snap
|
||||
Exec
|
||||
|
||||
The function MACWINDOW.SETUP establishes the new behavior for classes of windows:
|
||||
|
||||
(MACWINDOW.SETUP ORIGFN MACWINDOWFN ANYWHERE)
|
||||
|
||||
ORIGFN is either the name of the BUTTONEVENTFN for a class of windows (e.g. \TEDIT.BUTTONEVENTFN for Tedit windows) or it is a function that creates windows of a particulate kind (e.g. SNAPW or ADD-EXEC).
|
||||
|
||||
MACWINDOW.SETUP moves the definition of ORIGFN to the name (PACK* 'MACORIG- ORIGFN), and then provides a new definition for ORIGFN that does the moving or reshaping for clicks in the triggering locations, and otherwise passes control through to the original definition.
|
||||
|
||||
If ORIGNFN is a button event function, then MACWINDOWFN should not be specified. In that case a new definition for ORIGFN is constructed to provide the desired windowing behavior.
|
||||
|
||||
Otherwise, if ORIGFN is the function that creates windows of a class (e.g. SNAPW), then a MACWINDOWFN should be provided to create such window (by calling (PACK* MACORIG- ORIGFN)). The definition of MACWINDOWFN replaces the original definition of ORIGFN.
|
||||
|
||||
If the flag ANYWHERE is non-NIL, especially for windows without a title bar, then the moving behavior is triggered by a click anywhere in the window (except the corners).
|
||||
|
||||
Because this works by redefining existing functions, it is important that the MACINTERFACE package be loaded AFTER Tedit and Sedit, if those are not already in the sysout. And it should be called to upgrade the proper functions for other window classes that might later be added (e.g. GRAPHER).
|
||||
|
||||
If it is not known or it is inconvenient to systematically upgrade a button function or a window-creation function, the new behavior can be provided after a window has been created, by invoking
|
||||
|
||||
(MACWINDOW WINDOW ANYWHERE)
|
||||
|
||||
This saves the windows existing BUTTONEVENTFN as a window property PREMACBUTTONEVENTFN, and installs a simple stub function in its place.
|
||||
|
||||
Known issue: Clicking at the bottom-right corner of Tedit windows sometimes doesn't catch the new behavior--there seems to be a conflict with Tedit's window-splitting conventions.
|
||||
|
||||
A future extension might be to add an X or some circles on the left of the title bar, to implement a close/shrink behaviors.
|
||||
@@ -1 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
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 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "14-Mar-2021 20:33:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;14 20950
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 8-Jul-2021 23:33:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;16 23978
|
||||
|
||||
changes to%: (FNS MODERNWINDOW.SETUP)
|
||||
changes to%: (FNS MODERNWINDOW)
|
||||
|
||||
previous date%: "14-Mar-2021 18:00:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;13)
|
||||
previous date%: " 3-Jul-2021 10:32:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;15)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -19,17 +19,20 @@
|
||||
|
||||
(* ;; "Internals")
|
||||
|
||||
[COMS (FNS MODERNWINDOW.BUTTONEVENTFN MODERNWINDOW.BUTTONEVENTFN.ANYWHERE NEARTOP
|
||||
NEARESTCORNER INCORNER.REGION)
|
||||
[COMS (FNS MODERNWINDOW.BUTTONEVENTFN NEARTOP NEARESTCORNER INCORNER.REGION)
|
||||
|
||||
(* ;; "Behavior for some known window creators")
|
||||
|
||||
(FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE)
|
||||
(FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN)
|
||||
|
||||
(* ;; "Add some Meta commands")
|
||||
|
||||
(FNS TEDIT.MODERNIZE TEDIT.SELECTALL)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (TEDIT.MODERNIZE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P
|
||||
(* ;; "Tedit")
|
||||
|
||||
(MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
|
||||
(TEDIT.MODERNIZE)
|
||||
|
||||
(* ;; "Inspector")
|
||||
|
||||
@@ -80,7 +83,13 @@
|
||||
|
||||
(* ;; "Promptwindow")
|
||||
|
||||
(MODERNWINDOW PROMPTWINDOW T]
|
||||
(MODERNWINDOW PROMPTWINDOW T)
|
||||
|
||||
(* ;;
|
||||
"Menus: Move only and only with title clicks")
|
||||
|
||||
(MODERNWINDOW.SETUP 'MENUBUTTONFN
|
||||
'MODERN-MENUBUTTONFN]
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA MODERN-ADD-EXEC])
|
||||
@@ -92,19 +101,28 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MODERNWINDOW
|
||||
[LAMBDA (WINDOW ANYWHERE) (* ; "Edited 22-Feb-2021 16:44 by rmk:")
|
||||
[LAMBDA (WINDOW ANYWHERE TITLEPROPORTION) (* ; "Edited 8-Jul-2021 23:33 by rmk:")
|
||||
(* ; "Edited 3-Jul-2021 10:31 by rmk:")
|
||||
(* ; "Edited 24-Jun-2021 14:52 by rmk:")
|
||||
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn.")
|
||||
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn. If the window was previously modernized, we restore its original state first, in case it is called here with different parameters")
|
||||
|
||||
(CL:UNLESS (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN)
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (IF ANYWHERE
|
||||
THEN (FUNCTION MODERNWINDOW.BUTTONEVENTFN.ANYWHERE)
|
||||
ELSE (FUNCTION MODERNWINDOW.BUTTONEVENTFN))))
|
||||
(CL:WHEN (AND TITLEPROPORTION (GREATERP TITLEPROPORTION 0.5))
|
||||
(ERROR "TITLEPROPORTION cannot be greater than .5"))
|
||||
(CL:WHEN (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN)
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN NIL))
|
||||
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN))
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN (IF (OR ANYWHERE TITLEPROPORTION)
|
||||
THEN [FUNCTION (LAMBDA (WINDOW)
|
||||
(MODERNWINDOW.BUTTONEVENTFN
|
||||
WINDOW NIL T ,TITLEPROPORTION]
|
||||
ELSE (FUNCTION MODERNWINDOW.BUTTONEVENTFN)))
|
||||
WINDOW])
|
||||
|
||||
(MODERNWINDOW.SETUP
|
||||
[LAMBDA (ORIGFN MODERNWINDOWFN ANYWHERE) (* ; "Edited 14-Mar-2021 20:33 by rmk:")
|
||||
[LAMBDA (ORIGFN MODERNWINDOWFN ANYWHERE TITLEPROPORTION)
|
||||
(* ; "Edited 24-Jun-2021 14:53 by rmk:")
|
||||
|
||||
(* ;; "ORIGFN is either a function that creates windows of a given type (e.g. SNAPW or ADD-EXEC) or the known BUTTONEVENTFN of a class of windows.")
|
||||
|
||||
@@ -122,6 +140,11 @@
|
||||
|
||||
(* ;; "If ORIGFN is defined, then presumably the file containing ORIGFN (e.g. sketch) was loaded before MODERNIZE (if we are being called on our load), and we can rearrange things. But of ORIGFN is not defined, then there is really nothing to do. The package loader itself should call MODERNWINDOW.SETUP if we are defined when it is loaded. ")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:WHEN (AND TITLEPROPORTION (GREATERP TITLEPROPORTION 0.5))
|
||||
(ERROR "TITLEPROPORTION cannot be greater than .5"))
|
||||
(MODERNWINDOW.UNSETUP ORIGFN)
|
||||
[LET [RENAMEDORIG (PKGNAME (CL:PACKAGE-NAME (CL:SYMBOL-PACKAGE ORIGFN]
|
||||
|
||||
(* ;; "The renamed version of XCL symbols go into Interlisp, so there is less confusion about accessing it")
|
||||
@@ -133,10 +156,14 @@
|
||||
(MOVD? ORIGFN RENAMEDORIG)
|
||||
(IF MODERNWINDOWFN
|
||||
THEN (MOVD MODERNWINDOWFN ORIGFN)
|
||||
ELSE (PUTD ORIGFN `(LAMBDA (WINDOW)
|
||||
(MODERNWINDOW.BUTTONEVENTFN WINDOW (FUNCTION
|
||||
,RENAMEDORIG)
|
||||
,ANYWHERE])])
|
||||
ELSE (PUTD ORIGFN `(LAMBDA ,(ARGLIST ORIGFN)
|
||||
(MODERNWINDOW.BUTTONEVENTFN
|
||||
,(CL:IF (LISTP (ARGLIST ORIGFN))
|
||||
(CAR (ARGLIST ORIGFN))
|
||||
(ARGLIST ORIGFN))
|
||||
(FUNCTION ,RENAMEDORIG)
|
||||
,ANYWHERE
|
||||
,TITLEPROPORTION])])
|
||||
|
||||
(UNMODERNWINDOW
|
||||
[LAMBDA (WINDOW) (* ; "Edited 22-Feb-2021 16:44 by rmk:")
|
||||
@@ -175,7 +202,7 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MODERNWINDOW.BUTTONEVENTFN
|
||||
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE) (* ; "Edited 27-Feb-2021 17:57 by rmk:")
|
||||
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION)(* ; "Edited 24-Jun-2021 14:49 by rmk:")
|
||||
(IF (AND (MOUSESTATE (ONLY LEFT))
|
||||
(EQ LASTKEYBOARD 0))
|
||||
THEN (TOTOPW WINDOW)
|
||||
@@ -231,7 +258,7 @@
|
||||
WINDOW)
|
||||
STARTINGREGION))
|
||||
T
|
||||
ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN))
|
||||
ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN TITLEPROPORTION))
|
||||
THEN (NEARESTCORNER ATTACHEDREGION)
|
||||
(MOVEW (CL:IF (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
|
||||
(WINDOWPROP WINDOW 'MAINWINDOW)
|
||||
@@ -243,21 +270,20 @@
|
||||
ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
|
||||
THEN (APPLY* ORIGFUNCTION WINDOW])
|
||||
|
||||
(MODERNWINDOW.BUTTONEVENTFN.ANYWHERE
|
||||
[LAMBDA (WINDOW) (* ; "Edited 22-Feb-2021 16:31 by rmk:")
|
||||
(* ; "Edited 24-Jun-2020 13:24 by rmk:")
|
||||
|
||||
(* ;; "Move if left-click anywhere, not just titlebar")
|
||||
|
||||
(MODERNWINDOW.BUTTONEVENTFN WINDOW NIL T])
|
||||
|
||||
(NEARTOP
|
||||
[LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:19 by rmk:")
|
||||
[LAMBDA (MAINREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 24-Jun-2021 14:51 by rmk:")
|
||||
|
||||
(* ;; "True if the MOUSEY is near the top of MAINREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
|
||||
|
||||
(IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION)
|
||||
TOPMARGIN])
|
||||
(* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")
|
||||
|
||||
(AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION)
|
||||
TOPMARGIN))
|
||||
(OR (NOT TITLEPROPORTION)
|
||||
(LET ((WIDTH (FETCH WIDTH of MAINREGION))
|
||||
(LEFT (FETCH LEFT OF MAINREGION)))
|
||||
(OR (ILESSP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH TITLEPROPORTION)))
|
||||
(IGREATERP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH (DIFFERENCE 1 TITLEPROPORTION])
|
||||
|
||||
(NEARESTCORNER
|
||||
[LAMBDA (REGION) (* ; "Edited 14-Feb-2021 21:46 by rmk:")
|
||||
@@ -339,6 +365,23 @@
|
||||
(LET ((MAIN (MAINWINDOW WINDOW T)))
|
||||
(CL:WHEN MAIN
|
||||
(MODERNWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))])
|
||||
|
||||
(MODERN-MENUBUTTONFN
|
||||
[LAMBDA (WINDOW) (* ; "Edited 23-May-2021 20:37 by rmk:")
|
||||
|
||||
(* ;; "Replaces the button fn for a Menu window, allowing title clicks to do the move. Sometimes the title isn't in the window, it's in the menu.")
|
||||
|
||||
(LET (MENU)
|
||||
(IF [AND (MOUSESTATE (ONLY LEFT))
|
||||
(EQ LASTKEYBOARD 0)
|
||||
(OR (WINDOWPROP WINDOW 'TITLE)
|
||||
(AND [NULL (CDR (SETQ MENU (MKLIST (WINDOWPROP WINDOW 'MENU]
|
||||
(TYPE? MENU (SETQ MENU (CAR MENU)))
|
||||
(FETCH (MENU TITLE) OF MENU)))
|
||||
(NEARTOP (WINDOWPROP WINDOW 'REGION)
|
||||
(FONTPROP WindowTitleDisplayStream 'HEIGHT]
|
||||
THEN (MOVEW WINDOW)
|
||||
ELSE (MODERN-ORIG-MENUBUTTONFN WINDOW])
|
||||
)
|
||||
|
||||
|
||||
@@ -348,25 +391,24 @@
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.MODERNIZE
|
||||
[LAMBDA NIL (* ; "Edited 22-Feb-2021 16:28 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 24-Jun-2021 20:54 by rmk:")
|
||||
(CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN)
|
||||
(MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
|
||||
|
||||
(* ;; "All")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,a")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,a")
|
||||
(FUNCTION TEDIT.SELECTALL)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,A")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,A")
|
||||
(FUNCTION TEDIT.SELECTALL)
|
||||
TEDIT.READTABLE)
|
||||
|
||||
(* ;; "Quit")
|
||||
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,q")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,q")
|
||||
(FUNCTION TEDIT.QUIT)
|
||||
TEDIT.READTABLE)
|
||||
(TEDIT.SETFUNCTION (CHARCODE "1,Q")
|
||||
(TEDIT.SETFUNCTION (CHARCODE "Meta,Q")
|
||||
(FUNCTION TEDIT.QUIT)
|
||||
TEDIT.READTABLE))])
|
||||
|
||||
@@ -379,6 +421,12 @@
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
|
||||
(* ;; "Tedit")
|
||||
|
||||
|
||||
(MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
|
||||
|
||||
(TEDIT.MODERNIZE)
|
||||
|
||||
|
||||
@@ -456,6 +504,12 @@
|
||||
|
||||
|
||||
(MODERNWINDOW PROMPTWINDOW T)
|
||||
|
||||
|
||||
(* ;; "Menus: Move only and only with title clicks")
|
||||
|
||||
|
||||
(MODERNWINDOW.SETUP 'MENUBUTTONFN 'MODERN-MENUBUTTONFN)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -466,10 +520,10 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4369 8713 (MODERNWINDOW 4379 . 5037) (MODERNWINDOW.SETUP 5039 . 7501) (UNMODERNWINDOW
|
||||
7503 . 7897) (MODERNWINDOW.UNSETUP 7899 . 8711)) (8778 16791 (MODERNWINDOW.BUTTONEVENTFN 8788 . 13799)
|
||||
(MODERNWINDOW.BUTTONEVENTFN.ANYWHERE 13801 . 14172) (NEARTOP 14174 . 14610) (NEARESTCORNER 14612 .
|
||||
15491) (INCORNER.REGION 15493 . 16789)) (16849 18267 (MODERN-ADD-EXEC 16859 . 17290) (MODERN-SNAPW
|
||||
17292 . 17835) (TOTOPW.MODERNIZE 17837 . 18265)) (18308 19391 (TEDIT.MODERNIZE 18318 . 19060) (
|
||||
TEDIT.SELECTALL 19062 . 19389)))))
|
||||
(FILEMAP (NIL (4933 10561 (MODERNWINDOW 4943 . 6398) (MODERNWINDOW.SETUP 6400 . 9349) (UNMODERNWINDOW
|
||||
9351 . 9745) (MODERNWINDOW.UNSETUP 9747 . 10559)) (10626 18766 (MODERNWINDOW.BUTTONEVENTFN 10636 .
|
||||
15663) (NEARTOP 15665 . 16585) (NEARESTCORNER 16587 . 17466) (INCORNER.REGION 17468 . 18764)) (18824
|
||||
21146 (MODERN-ADD-EXEC 18834 . 19265) (MODERN-SNAPW 19267 . 19810) (TOTOPW.MODERNIZE 19812 . 20240) (
|
||||
MODERN-MENUBUTTONFN 20242 . 21144)) (21187 22227 (TEDIT.MODERNIZE 21197 . 21896) (TEDIT.SELECTALL
|
||||
21898 . 22225)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Jun-99 17:13:51" {DSK}<project>medley3.5>lispusers>PRETTYFILEINDEX.;3 91069
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 21:55:15"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>PRETTYFILEINDEX.;5 93788
|
||||
|
||||
changes to%: (FNS PRETTYFILEINDEX PFI.PASS.COMMENT)
|
||||
changes to%: (FNS PRETTYFILEINDEX PFI.PRINT.FILECREATED)
|
||||
|
||||
previous date%: "12-Nov-93 09:53:58" {DSK}<project>medley3.5>lispusers>PRETTYFILEINDEX.;2)
|
||||
previous date%: " 9-Jul-2021 08:04:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>PRETTYFILEINDEX.;4)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988, 1992, 1993, 1999 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT PRETTYFILEINDEXCOMS)
|
||||
@@ -181,7 +183,8 @@ Copyright (c) 1988, 1992, 1993, 1999 by Xerox Corporation. All rights reserved.
|
||||
(DEFINEQ
|
||||
|
||||
(PRETTYFILEINDEX
|
||||
[LAMBDA (FILENAME PRINTOPTIONS OUTSTREAM DONTINDEX) (* ; "Edited 11-Apr-95 00:02 by rmk:")
|
||||
[LAMBDA (FILENAME PRINTOPTIONS OUTSTREAM DONTINDEX) (* ; "Edited 9-Jul-2021 21:35 by rmk:")
|
||||
(* ; "Edited 11-Apr-95 00:02 by rmk:")
|
||||
(* ; "Edited 11-Jun-92 15:58 by cat")
|
||||
|
||||
(* ;; "Makes an indexed file (default is the line printer pseudo-file). The index file will have a number of indices, one for each indexable type. Each type index will list all the items of that type in alphabetical order and the page number of where that item's definition is in the file. The indices will be printed last, so that this can be one-pass.")
|
||||
@@ -329,6 +332,9 @@ Copyright (c) 1988, 1992, 1993, 1999 by Xerox Corporation. All rights reserved.
|
||||
(SETQ *PFI-LOCATIONS* :NONE)
|
||||
else (STREAMPROP *STANDARD-OUTPUT* 'AFTERNEWPAGEFN (FUNCTION PFI.AFTER.NEW.PAGE))
|
||||
(* ; "Enable header printing")
|
||||
|
||||
(* ;; "RMK: NOBIND here seems to be deliberate, it seems somehow to match the NOBIND that appears in PFI.HANDLE.RPAQQ.")
|
||||
|
||||
[SETQ *PFI-FILEVARS* `((,(FILECOMS FILENAME) . NOBIND]
|
||||
(* ; "Says to do something with coms")
|
||||
[if (NOT (FIXP *PFI-MAX-WASTED-LINES*))
|
||||
@@ -453,16 +459,107 @@ Copyright (c) 1988, 1992, 1993, 1999 by Xerox Corporation. All rights reserved.
|
||||
(DEFINEQ
|
||||
|
||||
(PFI.PRINT.FILECREATED
|
||||
(LAMBDA (EXPR ENV) (* ; "Edited 13-Apr-88 11:14 by bvm") (* ;; "Display the FILECREATED expression and environment prettily") (* ;; "Form is (FILECREATED date filename filemaploc changes to: changes previous date: date filename)") (pop EXPR) (CHANGEFONT ITALICFONT) (LET* ((STRINGS (QUOTE ("File created:" "changes to:" "previous date:" "Read Table:" "Package:" "Base:"))) (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) (QUOTE changes)) then (* ; "handle %"Changes to:%"") (PFI.PRINT.TO.TAB (pop STRINGS) (pop STRWIDTHS) TABSTOP) (SETQ EXPR (CDDR EXPR)) (PRINTDEF (while (LISTP (CAR EXPR)) collect (pop EXPR)) T NIL T) (TERPRI) (TERPRI) else (pop STRINGS) (pop STRWIDTHS)) (if (EQ (CAR EXPR) (QUOTE previous)) then (* ; "Handle %"Previous date:%"") (PFI.PRINT.TO.TAB (pop STRINGS) (pop STRWIDTHS) TABSTOP) (SETQ EXPR (CDDR EXPR)) (PRINTOUT NIL (pop EXPR) " " (pop EXPR) T T) else (pop STRINGS) (pop STRWIDTHS)) (LET ((SPEC (fetch RESPEC of ENV))) (* ; "Show environment") (PFI.PRINT.TO.TAB (pop STRINGS) (pop STRWIDTHS) TABSTOP) (* ; "Read table") (PFI.PRINT.ENVIRONMENT SPEC :READTABLE) (PFI.PRINT.TO.TAB (pop STRINGS) (pop STRWIDTHS) TABSTOP) (* ; "Package") (PFI.PRINT.ENVIRONMENT SPEC :PACKAGE) (if (NEQ *PRINT-BASE* 10) then (PFI.PRINT.TO.TAB (pop STRINGS) (pop STRWIDTHS) TABSTOP) (PFI.PRINT.ENVIRONMENT SPEC :BASE)))))
|
||||
)
|
||||
[LAMBDA (EXPR ENV) (* ; "Edited 9-Jul-2021 07:59 by rmk:")
|
||||
|
||||
(* ;; "Display the FILECREATED expression and environment prettily")
|
||||
|
||||
(* ;;
|
||||
"Form is (FILECREATED date filename filemaploc changes to: changes previous date: date filename)")
|
||||
|
||||
(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 (EQ (CAR EXPR)
|
||||
'changes)
|
||||
then (* ; "handle %"Changes to:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDDR EXPR))
|
||||
(PRINTDEF (while (LISTP (CAR EXPR)) collect (pop EXPR))
|
||||
T NIL T)
|
||||
(TERPRI)
|
||||
(TERPRI)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
(if (EQ (CAR EXPR)
|
||||
'previous)
|
||||
then (* ; "Handle %"Previous date:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDDR EXPR))
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" "
|
||||
(pop EXPR)
|
||||
T T)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
|
||||
(* ;; "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
|
||||
(LAMBDA (STR WIDTH TABSTOP) (* ; "Edited 29-Mar-88 12:44 by bvm") (* ;; "Print STR of specified WIDTH right-justified to xpos TABSTOP in italic font, leave a couple of spaces, then switch back to defaultfont.") (CHANGEFONT ITALICFONT) (DSPXPOSITION (- TABSTOP WIDTH)) (PRIN3 STR) (RELMOVETO (TIMES 12 (DSPSCALE)) 0) (CHANGEFONT DEFAULTFONT))
|
||||
)
|
||||
|
||||
(PFI.PRINT.ENVIRONMENT
|
||||
(LAMBDA (SPEC KEYWORD) (* ; "Edited 29-Mar-88 12:46 by bvm") (* ;; "Display the KEYWORD component of a reader environment spec") (LET ((VALUE (LISTGET SPEC KEYWORD))) (if (LISTP VALUE) then (* ; "An expression to create it--show pretty. Use IL package, since that's what they appear in at beginning of file") (LET ((*PACKAGE* *INTERLISP-PACKAGE*)) (PRINTDEF VALUE T T)) else (* ; "Just show the value, sans quotations, etc. The selectq is just in case this environment has no spec, something that shouldn't happen if it came from a define-file-info") (PRIN3 (OR VALUE (SELECTQ KEYWORD (:READTABLE (READTABLEPROP *READTABLE* (QUOTE NAME))) (:PACKAGE (CL:PACKAGE-NAME *PACKAGE*)) (SHOULDNT))))) (TERPRI) (TERPRI)))
|
||||
)
|
||||
[LAMBDA (ENV KEYWORD) (* ; "Edited 9-Jul-2021 08:03 by rmk:")
|
||||
|
||||
(* ;; "Display the KEYWORD component of a reader environment spec")
|
||||
|
||||
(LET [(VALUE (SELECTQ KEYWORD
|
||||
(:READTABLE (READTABLEPROP (FETCH (READER-ENVIRONMENT REREADTABLE)
|
||||
OF ENV)
|
||||
'NAME))
|
||||
(:PACKAGE (CL:PACKAGE-NAME (FETCH (READER-ENVIRONMENT REPACKAGE)
|
||||
OF ENV)))
|
||||
(:BASE (FETCH (READER-ENVIRONMENT REBASE) OF ENV))
|
||||
(:FORMAT (FETCH (READER-ENVIRONMENT REFORMAT) OF ENV))
|
||||
(SHOULDNT]
|
||||
(if (LISTP VALUE)
|
||||
then (* ; "An expression to create it--show pretty. Use IL package, since that's what they appear in at beginning of file")
|
||||
(LET ((*PACKAGE* *INTERLISP-PACKAGE*))
|
||||
(PRINTDEF VALUE T T))
|
||||
else (* ;
|
||||
"Just show the value, sans quotations, etc. ")
|
||||
(PRIN3 VALUE))
|
||||
(TERPRI)
|
||||
(TERPRI])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -884,30 +981,30 @@ Copyright (c) 1988, 1992, 1993, 1999 by Xerox Corporation. All rights reserved.
|
||||
'NILL)
|
||||
'NON.PFI.PRINT.BITMAP NIL T)
|
||||
)
|
||||
(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999))
|
||||
(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10096 12331 (PFI.NEW.LISTFILES1 10106 . 10600) (PFI.ENQUEUE 10602 . 11226) (
|
||||
\PFI.DO.HARDCOPY 11228 . 11814) (MAYBE.PRETTYFILEINDEX 11816 . 12329)) (12332 34987 (PRETTYFILEINDEX
|
||||
12342 . 26515) (PFI.MAKE.LPT.STREAM 26517 . 29568) (PFI.SETUP.TRANSLATIONS 29570 . 31084) (
|
||||
PFI.OUTCHARFN 31086 . 33060) (PFI.COLLECT.DEFINERS 33062 . 33874) (PFI.AFTER.NEW.PAGE 33876 . 34985))
|
||||
(34988 37844 (PFI.PRINT.FILECREATED 34998 . 36730) (PFI.PRINT.TO.TAB 36732 . 37097) (
|
||||
PFI.PRINT.ENVIRONMENT 37099 . 37842)) (37845 45029 (PFI.PROCESS.FILE 37855 . 39085) (PFI.PASS.COMMENT
|
||||
39087 . 40057) (PFI.HANDLE.EXPR 40059 . 40726) (PFI.DEFAULT.HANDLER 40728 . 42781) (PFI.PRETTYPRINT
|
||||
42783 . 43118) (PFI.LINES.REMAINING 43120 . 43447) (PFI.MAYBE.NEW.PAGE 43449 . 43952) (
|
||||
PFI.ESTIMATE.SIZE 43954 . 44485) (PFI.ESTIMATE.SIZE1 44487 . 45027)) (45066 54553 (PFI.HANDLE.RPAQQ
|
||||
45076 . 46484) (PFI.HANDLE.DECLARE 46486 . 47425) (PFI.HANDLE.EVAL-WHEN 47427 . 47910) (
|
||||
PFI.HANDLE.DEFDEFINER 47912 . 49202) (PFI.HANDLE.DEFINEQ 49204 . 49448) (PFI.PRINT.LAMBDA 49450 .
|
||||
49788) (PFI.PRINT.LAMBDA.BODY 49790 . 50125) (PFI.HANDLE.PUTDEF 50127 . 50624) (PFI.HANDLE.PUTPROPS
|
||||
50626 . 51241) (PFI.HANDLE./DECLAREDATATYPE 51243 . 51790) (PFI.HANDLE.* 51792 . 53054) (
|
||||
PFI.PRINT.COMMENTS 53056 . 53956) (PFI.HANDLE.FILEMAP 53958 . 54246) (PFI.HANDLE.PACKAGE 54248 . 54551
|
||||
)) (54581 55573 (PFI.PREVIEW.DECLARE 54591 . 55253) (PFI.PREVIEW.DEFINEQ 55255 . 55571)) (55609 66597
|
||||
(PFI.PRINT.INDEX 55619 . 56470) (PFI.CONDENSE.INDEX 56472 . 58279) (PFI.SORT.INDICES 58281 . 59420) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 59422 . 60886) (PFI.PRINT.INDICES 60888 . 65430) (PFI.CENTER.PRINT 65432 .
|
||||
66002) (PFI.INDEX.BREAK 66004 . 66462) (PFI.LOOKUP.NAME 66464 . 66595)) (66598 67829 (PFI.ADD.TO.INDEX
|
||||
66608 . 67118) (PFI.VARNAME 67120 . 67530) (PFI.CONSTANTNAMES 67532 . 67827)) (67864 76177 (
|
||||
MULTIFILEINDEX 67874 . 68670) (MULTIFILEINDEX1 68672 . 70128) (PFI.PRINT.MULTI.INDEX 70130 . 75233) (
|
||||
PFI.CHOOSE.BEST 75235 . 75462) (PFI.MERGE.INDICES 75464 . 76175)) (76234 77852 (PFI.MAYBE.SEE.PRETTY
|
||||
76244 . 77174) (PFI.MAYBE.PP.DEFINITION 77176 . 77850)) (77922 81757 (PFI.PRINT.BITMAP 77932 . 81755))
|
||||
(84602 87716 (PUTPROPS.PRETTYPRINT 84612 . 86023) (RPAQX.PRETTYPRINT 86025 . 86750) (
|
||||
COURIERPROGRAM.PRETTYPRINT 86752 . 87452) (MAYBE.PRETTYPRINT.BOLD 87454 . 87714)))))
|
||||
(FILEMAP (NIL (10148 12383 (PFI.NEW.LISTFILES1 10158 . 10652) (PFI.ENQUEUE 10654 . 11278) (
|
||||
\PFI.DO.HARDCOPY 11280 . 11866) (MAYBE.PRETTYFILEINDEX 11868 . 12381)) (12384 35298 (PRETTYFILEINDEX
|
||||
12394 . 26826) (PFI.MAKE.LPT.STREAM 26828 . 29879) (PFI.SETUP.TRANSLATIONS 29881 . 31395) (
|
||||
PFI.OUTCHARFN 31397 . 33371) (PFI.COLLECT.DEFINERS 33373 . 34185) (PFI.AFTER.NEW.PAGE 34187 . 35296))
|
||||
(35299 40558 (PFI.PRINT.FILECREATED 35309 . 38825) (PFI.PRINT.TO.TAB 38827 . 39192) (
|
||||
PFI.PRINT.ENVIRONMENT 39194 . 40556)) (40559 47743 (PFI.PROCESS.FILE 40569 . 41799) (PFI.PASS.COMMENT
|
||||
41801 . 42771) (PFI.HANDLE.EXPR 42773 . 43440) (PFI.DEFAULT.HANDLER 43442 . 45495) (PFI.PRETTYPRINT
|
||||
45497 . 45832) (PFI.LINES.REMAINING 45834 . 46161) (PFI.MAYBE.NEW.PAGE 46163 . 46666) (
|
||||
PFI.ESTIMATE.SIZE 46668 . 47199) (PFI.ESTIMATE.SIZE1 47201 . 47741)) (47780 57267 (PFI.HANDLE.RPAQQ
|
||||
47790 . 49198) (PFI.HANDLE.DECLARE 49200 . 50139) (PFI.HANDLE.EVAL-WHEN 50141 . 50624) (
|
||||
PFI.HANDLE.DEFDEFINER 50626 . 51916) (PFI.HANDLE.DEFINEQ 51918 . 52162) (PFI.PRINT.LAMBDA 52164 .
|
||||
52502) (PFI.PRINT.LAMBDA.BODY 52504 . 52839) (PFI.HANDLE.PUTDEF 52841 . 53338) (PFI.HANDLE.PUTPROPS
|
||||
53340 . 53955) (PFI.HANDLE./DECLAREDATATYPE 53957 . 54504) (PFI.HANDLE.* 54506 . 55768) (
|
||||
PFI.PRINT.COMMENTS 55770 . 56670) (PFI.HANDLE.FILEMAP 56672 . 56960) (PFI.HANDLE.PACKAGE 56962 . 57265
|
||||
)) (57295 58287 (PFI.PREVIEW.DECLARE 57305 . 57967) (PFI.PREVIEW.DEFINEQ 57969 . 58285)) (58323 69311
|
||||
(PFI.PRINT.INDEX 58333 . 59184) (PFI.CONDENSE.INDEX 59186 . 60993) (PFI.SORT.INDICES 60995 . 62134) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 62136 . 63600) (PFI.PRINT.INDICES 63602 . 68144) (PFI.CENTER.PRINT 68146 .
|
||||
68716) (PFI.INDEX.BREAK 68718 . 69176) (PFI.LOOKUP.NAME 69178 . 69309)) (69312 70543 (PFI.ADD.TO.INDEX
|
||||
69322 . 69832) (PFI.VARNAME 69834 . 70244) (PFI.CONSTANTNAMES 70246 . 70541)) (70578 78891 (
|
||||
MULTIFILEINDEX 70588 . 71384) (MULTIFILEINDEX1 71386 . 72842) (PFI.PRINT.MULTI.INDEX 72844 . 77947) (
|
||||
PFI.CHOOSE.BEST 77949 . 78176) (PFI.MERGE.INDICES 78178 . 78889)) (78948 80566 (PFI.MAYBE.SEE.PRETTY
|
||||
78958 . 79888) (PFI.MAYBE.PP.DEFINITION 79890 . 80564)) (80636 84471 (PFI.PRINT.BITMAP 80646 . 84469))
|
||||
(87316 90430 (PUTPROPS.PRETTYPRINT 87326 . 88737) (RPAQX.PRETTYPRINT 88739 . 89464) (
|
||||
COURIERPROGRAM.PRETTYPRINT 89466 . 90166) (MAYBE.PRETTYPRINT.BOLD 90168 . 90428)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,30 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "25-Mar-88 17:54:27" {ERINYES}<LISPUSERS>MEDLEY>READINTERPRESS.;2 8705
|
||||
(FILECREATED "22-Jun-2021 10:52:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>READINTERPRESS.;4 10412
|
||||
|
||||
changes to%: (FNS READINT.IP)
|
||||
changes to%: (FNS PRINTSEQUENCE)
|
||||
|
||||
previous date%: "15-Jul-86 21:58:05" {PHYLUM}<LISPUSERS>LYRIC>READINTERPRESS.;1)
|
||||
previous date%: "22-Jun-2021 10:35:30"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>READINTERPRESS.;3)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1988 by Xerox Corporation. All rights reserved.
|
||||
(* ; "
|
||||
Copyright (c) 1983-1986, 1988, 2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT READINTERPRESSCOMS)
|
||||
|
||||
(RPAQQ READINTERPRESSCOMS ((* "Utilities for reading Interpress files") (FNS PRINTMASTER) (FNS OPCODE TOKEN FINDNONPRIMNAME FINDOPNAME SHORTINT TOKENFORMAT FINDSEQUENCETYPE PRINTTOKEN PRINTSEQUENCE SEARCHIPLIST READINT.IP SHOWFILE SHOWBYTE) (MACROS BIN.RIP) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) INTERPRESS)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA SHORTINT TOKEN))))
|
||||
)
|
||||
(RPAQQ READINTERPRESSCOMS
|
||||
[(* "Utilities for reading Interpress files")
|
||||
(FNS PRINTMASTER)
|
||||
(FNS OPCODE TOKEN FINDNONPRIMNAME FINDOPNAME SHORTINT TOKENFORMAT FINDSEQUENCETYPE PRINTTOKEN
|
||||
PRINTSEQUENCE SEARCHIPLIST READINT.IP SHOWFILE SHOWBYTE)
|
||||
(MACROS BIN.RIP)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
INTERPRESS))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA SHORTINT TOKEN])
|
||||
|
||||
|
||||
|
||||
@@ -59,8 +70,48 @@ Copyright (c) 1983, 1984, 1985, 1986, 1988 by Xerox Corporation. All rights res
|
||||
)
|
||||
|
||||
(PRINTSEQUENCE
|
||||
(LAMBDA (ISTREAM OUTSTREAM TYPE LENGTH) (* hdj "15-Jul-86 21:43") (SELECTQ TYPE (SEQIDENTIFIER (printout OUTSTREAM 20 "ID: ") (CHARSET ISTREAM 0) (bind (CHARSET _ 0) until (EQ LENGTH 0) do (PRINTCCODE (\NSIN ISTREAM CHARSET CHARSET LENGTH) OUTSTREAM))) (SEQINTEGER (printout OUTSTREAM 20) (for I from 1 to LENGTH do (PRINTTOKEN ISTREAM OUTSTREAM))) (SEQRATIONAL (PROG ((NUM (READINT.IP ISTREAM (LRSH LENGTH 1))) (DENOM (READINT.IP ISTREAM (LRSH LENGTH 1)))) (printout OUTSTREAM 20 NUM "/" DENOM " = " (FQUOTIENT NUM DENOM)))) (SEQSTRING (printout OUTSTREAM 20 "STR[" LENGTH "] = %"") (CHARSET ISTREAM 0) (bind (CHARSET _ 0) until (EQ LENGTH 0) do (PRINTCCODE (\NSIN ISTREAM CHARSET CHARSET LENGTH) OUTSTREAM)) (printout OUTSTREAM (QUOTE %"))) (SEQCOMMENT (for I from 1 to LENGTH first (printout OUTSTREAM 20 "Comment vector of " LENGTH " bytes" 22) do (printout OUTSTREAM |.I4| (BIN ISTREAM)))) (SEQPACKEDPIXELVECTOR (bind YBYTES (I _ 5) (XBITS _ (READINT.IP ISTREAM 2)) (YBITS _ (READINT.IP ISTREAM 2)) first (printout OUTSTREAM 20 "Packed pixel" " vector of " LENGTH " bytes [" XBITS "X" YBITS "]") (SETQ YBYTES (UNFOLD (FOLDHI YBITS BITSPERWORD) BYTESPERWORD)) (* "The number of bytes on a line is always even--gets to a word boundary") while (ILEQ I LENGTH) do (printout OUTSTREAM T 10) (for J from 1 to YBYTES do (printout OUTSTREAM |.I8.-2.T| (BIN ISTREAM)) (add I 1)))) (SEQLARGEVECTOR (for I VAL (BYTESPERELT _ (BIN ISTREAM)) from 2 to LENGTH first (printout OUTSTREAM 20 "Large vector of " BYTESPERELT " bytes per element") do (SETQ VAL (READINT.IP ISTREAM BYTESPERELT)) (printout OUTSTREAM 22 |.I5| I ": " VAL))) (SEQCONTINUED (HELP "Can't handle SEQCONTINUED yet")) (SEQINSERTFILE (HELP "Can't handle SEQINSERTFILE yet")) (SEQCOMPRESSPIXELVECTOR (HELP "Can't handle SEQCOMPRESSPIXELVECTOR yet")) (SHOULDNT)) (TERPRI OUTSTREAM))
|
||||
)
|
||||
[LAMBDA (ISTREAM OUTSTREAM TYPE LENGTH) (* ; "Edited 22-Jun-2021 10:52 by rmk:")
|
||||
(DECLARE (SPECVARS LENGTH)) (* ; "For byte counting")
|
||||
(SELECTQ TYPE
|
||||
(SEQIDENTIFIER (printout OUTSTREAM 20 "ID: ")
|
||||
(until (EQ LENGTH 0) do (PRINTCCODE (\INCCODE ISTREAM 'LENGTH LENGTH)
|
||||
OUTSTREAM)))
|
||||
(SEQINTEGER (printout OUTSTREAM 20)
|
||||
(for I from 1 to LENGTH do (PRINTTOKEN ISTREAM OUTSTREAM)))
|
||||
(SEQRATIONAL (PROG [(NUM (READINT.IP ISTREAM (LRSH LENGTH 1)))
|
||||
(DENOM (READINT.IP ISTREAM (LRSH LENGTH 1]
|
||||
(printout OUTSTREAM 20 NUM "/" DENOM " = " (FQUOTIENT NUM DENOM))))
|
||||
(SEQSTRING (printout OUTSTREAM 20 "STR[" LENGTH "] = %"")
|
||||
(until (EQ LENGTH 0) do (PRINTCCODE (\INCCODE ISTREAM 'LENGTH LENGTH)
|
||||
OUTSTREAM))
|
||||
(printout OUTSTREAM '%"))
|
||||
(SEQCOMMENT (for I from 1 to LENGTH
|
||||
first (printout OUTSTREAM 20 "Comment vector of " LENGTH " bytes" 22)
|
||||
do (printout OUTSTREAM .I4 (BIN ISTREAM))))
|
||||
(SEQPACKEDPIXELVECTOR
|
||||
(bind YBYTES (I _ 5)
|
||||
(XBITS _ (READINT.IP ISTREAM 2))
|
||||
(YBITS _ (READINT.IP ISTREAM 2))
|
||||
first (printout OUTSTREAM 20 "Packed pixel" " vector of " LENGTH " bytes [" XBITS
|
||||
"X" YBITS "]")
|
||||
(SETQ YBYTES (UNFOLD (FOLDHI YBITS BITSPERWORD)
|
||||
BYTESPERWORD)) (*
|
||||
"The number of bytes on a line is always even--gets to a word boundary")
|
||||
while (ILEQ I LENGTH) do (printout OUTSTREAM T 10)
|
||||
(for J from 1 to YBYTES
|
||||
do (printout OUTSTREAM .I8.-2.T (BIN ISTREAM))
|
||||
(add I 1))))
|
||||
(SEQLARGEVECTOR
|
||||
(for I VAL (BYTESPERELT _ (BIN ISTREAM)) from 2 to LENGTH
|
||||
first (printout OUTSTREAM 20 "Large vector of " BYTESPERELT " bytes per element")
|
||||
do (SETQ VAL (READINT.IP ISTREAM BYTESPERELT))
|
||||
(printout OUTSTREAM 22 .I5 I ": " VAL)))
|
||||
(SEQCONTINUED (HELP "Can't handle SEQCONTINUED yet"))
|
||||
(SEQINSERTFILE (HELP "Can't handle SEQINSERTFILE yet"))
|
||||
(SEQCOMPRESSPIXELVECTOR
|
||||
(HELP "Can't handle SEQCOMPRESSPIXELVECTOR yet"))
|
||||
(SHOULDNT))
|
||||
(TERPRI OUTSTREAM])
|
||||
|
||||
(SEARCHIPLIST
|
||||
(LAMBDA (CODE IPLIST) (* rmk%: "15-Mar-84 09:15") (for X in IPLIST when (EQ CODE (CADR X)) do (RETURN (CAR X))))
|
||||
@@ -79,10 +130,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1988 by Xerox Corporation. All rights res
|
||||
)
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
(PUTPROPS BIN.RIP MACRO (ARGS (LET ((ISTREAM (CAR ARGS)) (OSTREAM (CADR ARGS))) (BQUOTE (LET ((C (BIN (\, ISTREAM)))) (COND ((IGREATERP (POSITION (\, OSTREAM)) 15) (printout (\, OSTREAM) 5 "|" 8))) (printout (\, OSTREAM) |.I3| C " ") C)))))
|
||||
|
||||
(PUTPROPS BIN.RIP MACRO [ARGS (LET ((ISTREAM (CAR ARGS))
|
||||
(OSTREAM (CADR ARGS)))
|
||||
`(LET [(C (BIN ,ISTREAM]
|
||||
(COND
|
||||
((IGREATERP (POSITION ,OSTREAM)
|
||||
15)
|
||||
(printout ,OSTREAM 5 "|" 8)))
|
||||
(printout ,OSTREAM .I3 C " ")
|
||||
C])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(FILESLOAD (LOADCOMP) INTERPRESS)
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
INTERPRESS)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -92,10 +154,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1988 by Xerox Corporation. All rights res
|
||||
|
||||
(ADDTOVAR LAMA SHORTINT TOKEN)
|
||||
)
|
||||
(PUTPROPS READINTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1988))
|
||||
(PUTPROPS READINTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1988 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (910 1596 (PRINTMASTER 920 . 1594)) (1597 8114 (OPCODE 1607 . 1732) (TOKEN 1734 . 2306)
|
||||
(FINDNONPRIMNAME 2308 . 2413) (FINDOPNAME 2415 . 2672) (SHORTINT 2674 . 2867) (TOKENFORMAT 2869 . 3111
|
||||
) (FINDSEQUENCETYPE 3113 . 3317) (PRINTTOKEN 3319 . 4270) (PRINTSEQUENCE 4272 . 6133) (SEARCHIPLIST
|
||||
6135 . 6267) (READINT.IP 6269 . 6508) (SHOWFILE 6510 . 7834) (SHOWBYTE 7836 . 8112)))))
|
||||
(FILEMAP (NIL (1210 1896 (PRINTMASTER 1220 . 1894)) (1897 9430 (OPCODE 1907 . 2032) (TOKEN 2034 . 2606
|
||||
) (FINDNONPRIMNAME 2608 . 2713) (FINDOPNAME 2715 . 2972) (SHORTINT 2974 . 3167) (TOKENFORMAT 3169 .
|
||||
3411) (FINDSEQUENCETYPE 3413 . 3617) (PRINTTOKEN 3619 . 4570) (PRINTSEQUENCE 4572 . 7449) (
|
||||
SEARCHIPLIST 7451 . 7583) (READINT.IP 7585 . 7824) (SHOWFILE 7826 . 9150) (SHOWBYTE 9152 . 9428)))))
|
||||
STOP
|
||||
|
||||
BIN
lispusers/READINTERPRESS.LCOM
Normal file
BIN
lispusers/READINTERPRESS.LCOM
Normal file
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "22-Feb-2021 09:47:46"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;43 7259
|
||||
(FILECREATED "11-Jun-2021 12:50:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;18 10803
|
||||
|
||||
changes to%: (VARS WHEELSCROLLCOMS)
|
||||
(FNS ENABLEWHEELSCROLL)
|
||||
changes to%: (FNS ENABLEWHEELSCROLL)
|
||||
|
||||
previous date%: "21-Feb-2021 09:39:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;42)
|
||||
previous date%: "11-Jun-2021 11:11:10"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;14)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT WHEELSCROLLCOMS)
|
||||
@@ -14,15 +13,21 @@
|
||||
(RPAQQ WHEELSCROLLCOMS
|
||||
[(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL
|
||||
LISPINTERRUPTS.WHEELSCROLL)
|
||||
[VARS (WHEELSCROLLINTERRUPTS '((520 (WHEELSCROLL 'VERTICAL WHEELSCROLLDELTA)
|
||||
T)
|
||||
(521 (WHEELSCROLL 'VERTICAL (IMINUS WHEELSCROLLDELTA))
|
||||
T)
|
||||
(522 (WHEELSCROLL 'HORIZONTAL (IMINUS WHEELSCROLLDELTA)
|
||||
T))
|
||||
(523 (WHEELSCROLL 'HORIZONTAL WHEELSCROLLDELTA T]
|
||||
|
||||
(* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (UP 156)
|
||||
(DOWN 157)
|
||||
(LEFT 158)
|
||||
(RIGHT 159)))
|
||||
(GLOBALVARS WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS)
|
||||
(INITVARS (WHEELSCROLLDELTA 20)
|
||||
|
||||
(* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized")
|
||||
|
||||
[ADDVARS (AFTERSYSOUTFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T)))
|
||||
(AFTERMAKESYSFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T]
|
||||
(INITVARS (WHEELSCROLLENABLED NIL)
|
||||
(WHEELSCROLLDELTA 20)
|
||||
(WHEELSCROLLSETTLETIME 50)
|
||||
(\WHEELSCROLLINPROGRESS NIL))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INSTALL-WHEELSCROLL)
|
||||
@@ -30,19 +35,73 @@
|
||||
(DEFINEQ
|
||||
|
||||
(ENABLEWHEELSCROLL
|
||||
[LAMBDA (ON) (* ; "Edited 22-Feb-2021 09:47 by rmk:")
|
||||
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 11-Jun-2021 12:50 by rmk:")
|
||||
(* ; "Edited 28-May-2021 11:46 by rmk:")
|
||||
|
||||
(* ;; "So we can toggle this scrolling, for experimentation.")
|
||||
(* ;; "So we can toggle this scrolling.")
|
||||
|
||||
(IF ON
|
||||
THEN [KEYACTION 'PAD1 '((520 520) . IGNORE]
|
||||
[KEYACTION 'PAD2 '((521 521) . IGNORE]
|
||||
[KEYACTION 'PAD4 '((522 522) . IGNORE]
|
||||
[KEYACTION 'PAD5 '((523 523) . IGNORE]
|
||||
ELSE (KEYACTION 'PAD1 '(IGNORE . IGNORE))
|
||||
(KEYACTION 'PAD2 '(IGNORE . IGNORE))
|
||||
(KEYACTION 'PAD4 '(IGNORE . IGNORE))
|
||||
(KEYACTION 'PAD5 '(IGNORE . IGNORE])
|
||||
THEN (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
|
||||
(GETD 'LISPINTERRUPTS.WHEELSCROLL))
|
||||
(CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
(* ; "In case of LOADFROM?")
|
||||
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
|
||||
(MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS)))
|
||||
|
||||
(* ;; "In some situations these other keyactions seem to be installed, hit them all.")
|
||||
|
||||
[FOR KAT IN (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
DO ((FOR K IN [IF EXCLUDEHORIZONTAL
|
||||
THEN `((PAD1 ,UP)
|
||||
(PAD2 ,DOWN)
|
||||
(PAD4 IGNORE)
|
||||
(PAD5 IGNORE))
|
||||
ELSE `((PAD1 ,UP)
|
||||
(PAD2 ,DOWN)
|
||||
(PAD4 ,LEFT)
|
||||
(PAD5 ,RIGHT]
|
||||
DO (KEYACTION (CAR K)
|
||||
(CONS (CL:IF (EQ (CADR K)
|
||||
'IGNORE)
|
||||
'IGNORE
|
||||
`(,(CADR K)
|
||||
,(CADR K)))
|
||||
`IGNORE)
|
||||
KAT]
|
||||
(FOR I IN WHEELSCROLLINTERRUPTS
|
||||
DO (INTERRUPTCHAR (CAR I)
|
||||
(CADR I)
|
||||
(CADDR I))
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE)
|
||||
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
|
||||
(TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
,(CADR I]
|
||||
TEDIT.READTABLE)))
|
||||
(SETQ WHEELSCROLLENABLED T)
|
||||
ELSE (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
(GETD 'LISPINTERRUPTS))
|
||||
(MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS))
|
||||
(FOR I IN WHEELSCROLLINTERRUPTS DO (INTERRUPTCHAR (CAR I)
|
||||
NIL)
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE)
|
||||
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
|
||||
(TEDIT.SETFUNCTION (CAR I)
|
||||
NIL TEDIT.READTABLE)))
|
||||
(FOR KAT IN (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
|
||||
DO (KEYACTION 'PAD1 '(IGNORE . IGNORE)
|
||||
KAT)
|
||||
(KEYACTION 'PAD2 '(IGNORE . IGNORE)
|
||||
KAT)
|
||||
(KEYACTION 'PAD4 '(IGNORE . IGNORE)
|
||||
KAT)
|
||||
(KEYACTION 'PAD5 '(IGNORE . IGNORE)
|
||||
KAT))
|
||||
(SETQ WHEELSCROLLENABLED NIL])
|
||||
|
||||
(WHEELSCROLL
|
||||
[LAMBDA (DIRECTION DELTA) (* ; "Edited 21-Feb-2021 09:38 by rmk:")
|
||||
@@ -97,21 +156,18 @@
|
||||
(RESETVAR \WHEELSCROLLINPROGRESS T (SCROLLW WINDOW DX DY)))])
|
||||
|
||||
(INSTALL-WHEELSCROLL
|
||||
[LAMBDA NIL (* ; "Edited 17-Feb-2021 11:53 by rmk:")
|
||||
(CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL)
|
||||
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
|
||||
(MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))
|
||||
(FOR I IN WHEELSCROLLINTERRUPTS DO (INTERRUPTCHAR (CAR I)
|
||||
(CADR I)
|
||||
(CADDR I))
|
||||
(CL:WHEN (BOUNDP 'TEDIT.READTABLE)
|
||||
[LAMBDA NIL (* ; "Edited 28-May-2021 11:46 by rmk:")
|
||||
(* ; "Edited 17-Feb-2021 11:53 by rmk:")
|
||||
|
||||
(* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts")
|
||||
(* ;; "We want the UP, DOWN...constants to be compiled awsy")
|
||||
|
||||
(TEDIT.SETFUNCTION (CAR I)
|
||||
`[LAMBDA NIL
|
||||
,(CADR I]
|
||||
TEDIT.READTABLE))])
|
||||
(SETQ WHEELSCROLLINTERRUPTS `((,UP (WHEELSCROLL 'VERTICAL WHEELSCROLLDELTA)
|
||||
T)
|
||||
(,DOWN (WHEELSCROLL 'VERTICAL (IMINUS WHEELSCROLLDELTA))
|
||||
T)
|
||||
(,LEFT (WHEELSCROLL 'HORIZONTAL (IMINUS WHEELSCROLLDELTA)
|
||||
T))
|
||||
(,RIGHT (WHEELSCROLL 'HORIZONTAL WHEELSCROLLDELTA T])
|
||||
|
||||
(LISPINTERRUPTS.WHEELSCROLL
|
||||
[LAMBDA NIL (* ; "Edited 17-Feb-2021 11:09 by rmk:")
|
||||
@@ -121,19 +177,46 @@
|
||||
(APPEND WHEELSCROLLINTERRUPTS (LISPINTERRUPTS.WSORIG])
|
||||
)
|
||||
|
||||
(RPAQQ WHEELSCROLLINTERRUPTS
|
||||
((520 (WHEELSCROLL 'VERTICAL WHEELSCROLLDELTA)
|
||||
T)
|
||||
(521 (WHEELSCROLL 'VERTICAL (IMINUS WHEELSCROLLDELTA))
|
||||
T)
|
||||
(522 (WHEELSCROLL 'HORIZONTAL (IMINUS WHEELSCROLLDELTA)
|
||||
T))
|
||||
(523 (WHEELSCROLL 'HORIZONTAL WHEELSCROLLDELTA T))))
|
||||
|
||||
|
||||
(* ;;
|
||||
"These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys"
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ UP 156)
|
||||
|
||||
(RPAQQ DOWN 157)
|
||||
|
||||
(RPAQQ LEFT 158)
|
||||
|
||||
(RPAQQ RIGHT 159)
|
||||
|
||||
|
||||
(CONSTANTS (UP 156)
|
||||
(DOWN 157)
|
||||
(LEFT 158)
|
||||
(RIGHT 159))
|
||||
)
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized")
|
||||
|
||||
|
||||
(ADDTOVAR AFTERSYSOUTFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T)))
|
||||
|
||||
(ADDTOVAR AFTERMAKESYSFORMS (AND WHEELSCROLLENABLED (ENABLEWHEELSCROLL T)))
|
||||
|
||||
(RPAQ? WHEELSCROLLENABLED NIL)
|
||||
|
||||
(RPAQ? WHEELSCROLLDELTA 20)
|
||||
|
||||
(RPAQ? WHEELSCROLLSETTLETIME 50)
|
||||
@@ -146,7 +229,6 @@
|
||||
(ENABLEWHEELSCROLL T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1432 6591 (ENABLEWHEELSCROLL 1442 . 2071) (WHEELSCROLL 2073 . 4609) (WHEELSCROLL.DOIT
|
||||
4611 . 5247) (INSTALL-WHEELSCROLL 5249 . 6312) (LISPINTERRUPTS.WHEELSCROLL 6314 . 6589)))))
|
||||
(FILEMAP (NIL (1575 9814 (ENABLEWHEELSCROLL 1585 . 5542) (WHEELSCROLL 5544 . 8080) (WHEELSCROLL.DOIT
|
||||
8082 . 8718) (INSTALL-WHEELSCROLL 8720 . 9535) (LISPINTERRUPTS.WHEELSCROLL 9537 . 9812)))))
|
||||
STOP
|
||||
|
||||
|
||||
Binary file not shown.
59375
loadups/full.database
59375
loadups/full.database
File diff suppressed because it is too large
Load Diff
@@ -1,12 +1,12 @@
|
||||
|
||||
Full loadup started at 6-May-2021 15:26:50 while connected to
|
||||
{DSK}<home>larry>ilisp>medley>
|
||||
Full loadup started at 27-Jul-2021 21:13:36 while connected to
|
||||
{DSK}<home>larry>new>medley>
|
||||
|
||||
loading POSTSCRIPTSTREAM
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>POSTSCRIPTSTREAM.LCOM;1
|
||||
compiled on 14-May-2018 10:53:32
|
||||
File created 14-May-2018 10:52:48
|
||||
{DSK}<home>larry>new>medley>library>POSTSCRIPTSTREAM.LCOM;1
|
||||
compiled on 21-Jun-2021 20:29:51
|
||||
File created 21-Jun-2021 20:29:32
|
||||
POSTSCRIPTSTREAMCOMS
|
||||
Loading FULL fonts...
|
||||
Loading CLASSIC 8 10 12
|
||||
@@ -16,147 +16,147 @@ Loading FULL fonts...
|
||||
FULL fonts loaded
|
||||
loading CHAT
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>CHAT.LCOM;1
|
||||
compiled on 25-Oct-93 12:23:25
|
||||
{DSK}<home>larry>new>medley>library>CHAT.LCOM;1
|
||||
compiled on 13-Jun-2021 22:04:59
|
||||
File created 20-Jan-93 13:46:52
|
||||
CHATCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>DMCHAT.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>DMCHAT.LCOM;1
|
||||
compiled on 25-Feb-93 18:08:53
|
||||
File created 20-Jan-93 13:49:09
|
||||
DMCHATCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>CHATTERMINAL.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>CHATTERMINAL.LCOM;1
|
||||
compiled on 24-Feb-93 19:37:23
|
||||
File created 4-Jul-90 02:21:01
|
||||
CHATTERMINALCOMS
|
||||
loading PRESS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>PRESS.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>PRESS.LCOM;1
|
||||
compiled on 5-Feb-2021 22:18:09
|
||||
File created 5-Feb-2021 22:18:06
|
||||
PRESSCOMS
|
||||
loading INTERPRESS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>sources>INTERPRESS.LCOM;7
|
||||
compiled on 16-Apr-2018 21:56:38
|
||||
File created 16-Apr-2018 21:56:38
|
||||
{DSK}<home>larry>new>medley>sources>INTERPRESS.LCOM;7
|
||||
compiled on 27-Jun-2021 23:51:06
|
||||
File created 27-Jun-2021 23:50:51
|
||||
INTERPRESSCOMS
|
||||
loading TEDIT
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDIT.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDIT.LCOM;1
|
||||
compiled on 18-May-2018 09:16:24
|
||||
File created 19-Apr-2018 12:22:03
|
||||
TEDITCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITDCL.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITDCL.LCOM;1
|
||||
compiled on 30-Apr-2021 17:26:58
|
||||
File created 30-Apr-2021 17:26:17
|
||||
TEDITDCLCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>PCTREE.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>PCTREE.LCOM;1
|
||||
compiled on 18-May-2018 09:19:35
|
||||
File created 19-Apr-2018 12:19:49
|
||||
PCTREECOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEXTOFD.LCOM;1
|
||||
compiled on 11-Feb-2001 12:06:43
|
||||
File created 11-Feb-2001 12:06:42
|
||||
{DSK}<home>larry>new>medley>library>TEXTOFD.LCOM;1
|
||||
compiled on 14-Jun-2021 23:30:39
|
||||
File created 6-May-2021 10:18:06
|
||||
TEXTOFDCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITCOMMAND.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITCOMMAND.LCOM;1
|
||||
compiled on 18-May-2018 09:16:59
|
||||
File created 20-Apr-2018 08:07:35
|
||||
TEDITCOMMANDCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITSCREEN.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITSCREEN.LCOM;1
|
||||
compiled on 30-Apr-2021 14:42:15
|
||||
File created 30-Apr-2021 14:42:15
|
||||
TEDITSCREENCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITABBREV.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITABBREV.LCOM;1
|
||||
compiled on 6-Aug-2020 14:52:14
|
||||
File created 6-Aug-2020 14:52:14
|
||||
TEDITABBREVCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITLOOKS.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITLOOKS.LCOM;1
|
||||
compiled on 18-May-2018 09:17:44
|
||||
File created 29-Jan-99 17:33:35
|
||||
TEDITLOOKSCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITFIND.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITFIND.LCOM;1
|
||||
compiled on 18-May-2018 09:17:21
|
||||
File created 6-May-2018 17:34:44
|
||||
TEDITFINDCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITHISTORY.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITHISTORY.LCOM;1
|
||||
compiled on 18-May-2018 09:17:41
|
||||
File created 29-Jan-99 17:34:39
|
||||
TEDITHISTORYCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITFILE.LCOM;1
|
||||
compiled on 30-Apr-2021 14:46:41
|
||||
{DSK}<home>larry>new>medley>library>TEDITFILE.LCOM;1
|
||||
compiled on 12-Jun-2021 12:03:35
|
||||
File created 30-Apr-2021 14:46:41
|
||||
TEDITFILECOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITWINDOW.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITWINDOW.LCOM;1
|
||||
compiled on 18-May-2018 09:18:51
|
||||
File created 21-Jun-99 20:00:42
|
||||
TEDITWINDOWCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITSELECTION.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITSELECTION.LCOM;1
|
||||
compiled on 18-May-2018 09:18:43
|
||||
File created 25-Aug-94 10:56:07
|
||||
TEDITSELECTIONCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>IMAGEOBJ.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>IMAGEOBJ.LCOM;1
|
||||
compiled on 8-Feb-97 11:26:32
|
||||
File created 7-Dec-95 13:21:56
|
||||
IMAGEOBJCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>EDITBITMAP.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>EDITBITMAP.LCOM;1
|
||||
compiled on 25-Feb-93 18:10:27
|
||||
File created 11-Jun-90 15:42:25
|
||||
EDITBITMAPCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>READNUMBER.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>READNUMBER.LCOM;1
|
||||
compiled on 16-Aug-95 11:18:52
|
||||
File created 25-May-93 00:28:30
|
||||
READNUMBERCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TFBRAVO.LCOM;1
|
||||
compiled on 19-Apr-2018 12:19:55
|
||||
File created 19-Apr-2018 12:19:55
|
||||
{DSK}<home>larry>new>medley>library>TFBRAVO.LCOM;1
|
||||
compiled on 13-Jun-2021 09:46:34
|
||||
File created 13-Jun-2021 09:46:34
|
||||
TFBRAVOCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITHCPY.LCOM;1
|
||||
compiled on 18-May-2018 09:17:32
|
||||
File created 25-Aug-94 10:54:07
|
||||
{DSK}<home>larry>new>medley>library>TEDITHCPY.LCOM;1
|
||||
compiled on 28-Jun-2021 12:35:45
|
||||
File created 28-Jun-2021 12:35:45
|
||||
TEDITHCPYCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITPAGE.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITPAGE.LCOM;1
|
||||
compiled on 18-May-2018 09:18:32
|
||||
File created 25-Aug-94 10:55:28
|
||||
TEDITPAGECOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITMENU.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITMENU.LCOM;1
|
||||
compiled on 29-Apr-2021 22:44:22
|
||||
File created 29-Apr-2021 22:44:22
|
||||
TEDITMENUCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITFNKEYS.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITFNKEYS.LCOM;1
|
||||
compiled on 18-May-2018 09:17:25
|
||||
File created 6-May-2018 17:15:13
|
||||
TEDITFNKEYSCOMS
|
||||
loading HRULE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>HRULE.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>HRULE.LCOM;1
|
||||
compiled on 26-Feb-93 11:26:19
|
||||
File created 8-Oct-92 16:50:21
|
||||
HRULECOMS
|
||||
loading TEDITCHAT
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TEDITCHAT.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TEDITCHAT.LCOM;1
|
||||
compiled on 18-May-2018 09:16:55
|
||||
File created 28-Mar-94 16:05:24
|
||||
IL:TEDITCHATCOMS
|
||||
@@ -164,121 +164,121 @@ loading READNUMBER
|
||||
loading EDITBITMAP
|
||||
loading FILEBROWSER
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>FILEBROWSER.LCOM;1
|
||||
compiled on 27-Feb-2021 20:08:26
|
||||
File created 27-Feb-2021 20:08:26
|
||||
{DSK}<home>larry>new>medley>library>FILEBROWSER.LCOM;1
|
||||
compiled on 9-Jul-2021 23:09:57
|
||||
File created 9-Jul-2021 23:09:57
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>TABLEBROWSER.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>TABLEBROWSER.LCOM;1
|
||||
compiled on 20-Feb-2021 23:04:42
|
||||
File created 20-Feb-2021 23:02:39
|
||||
TABLEBROWSERCOMS
|
||||
loading THINFILES
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>THINFILES.LCOM;1
|
||||
{DSK}<home>larry>new>medley>lispusers>THINFILES.LCOM;1
|
||||
compiled on 26-Jun-99 00:47:00
|
||||
File created 1-May-92 16:49:39
|
||||
THINFILESCOMS
|
||||
loading GRAPHER
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>GRAPHER.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>GRAPHER.LCOM;1
|
||||
compiled on 14-Mar-2021 20:40:31
|
||||
File created 14-Mar-2021 20:40:30
|
||||
GRAPHERCOMS
|
||||
loading SPY
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>SPY.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>SPY.LCOM;1
|
||||
compiled on 23-Aug-94 16:33:38
|
||||
File created 29-Apr-94 14:13:52
|
||||
SPYCOMS
|
||||
loading WHERE-IS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>WHERE-IS.DFASL;1
|
||||
{DSK}<home>larry>new>medley>library>WHERE-IS.DFASL;1
|
||||
XCL Compiler output for source file {DSK}<python>lde>lispcore>library>WHERE-IS.;1
|
||||
Source file created Wednesday, 13 June 1990, 1:16:15.
|
||||
FASL file created Thursday, 21 January 1993, 18:52:55.
|
||||
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>HASH-FILE.dfasl;1
|
||||
{DSK}<home>larry>new>medley>library>HASH-FILE.dfasl;1
|
||||
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>HASH-FILE.;2
|
||||
Source file created Monday, 11 June 1990, 16:16:54.
|
||||
FASL file created Friday, 26 February 1993, 11:23:40.
|
||||
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>CASH-FILE.DFASL;5
|
||||
{DSK}<home>larry>new>medley>library>CASH-FILE.DFASL;5
|
||||
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2
|
||||
Source file created 11-Jun-90 14:33:44
|
||||
FASL file created Saturday, 19 September 2020, 22:04:31
|
||||
|
||||
loading COPYFILES
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>COPYFILES.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>COPYFILES.LCOM;1
|
||||
compiled on 6-Apr-2018 21:14:29
|
||||
File created 6-Apr-2018 21:14:29
|
||||
COPYFILESCOMS
|
||||
loading MSANALYZE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>MSANALYZE.DFASL;1
|
||||
{DSK}<home>larry>new>medley>library>MSANALYZE.DFASL;1
|
||||
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>library>MSANALYZE.;2
|
||||
Source file created 3-Mar-2021 10:31:16
|
||||
FASL file created Wednesday, 3 March 2021, 10:31:16
|
||||
|
||||
loading MSPARSE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>MSPARSE.DFASL;1
|
||||
{DSK}<home>larry>new>medley>library>MSPARSE.DFASL;1
|
||||
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSPARSE.;5
|
||||
Source file created Wednesday, 15 August 1990, 13:00:12.
|
||||
FASL file created Sunday, 28 February 1993, 23:24:50.
|
||||
|
||||
loading MASTERSCOPE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.DFASL;4
|
||||
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>library>MASTERSCOPE.;6
|
||||
Source file created 7-Mar-2021 19:39:11
|
||||
FASL file created Sunday, 7 March 2021, 20:20:40
|
||||
{DSK}<home>larry>new>medley>library>MASTERSCOPE.DFASL;4
|
||||
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6
|
||||
Source file created 13-Jun-2021 09:05:17
|
||||
FASL file created Sunday, 13 June 2021, 9:05:17
|
||||
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>MSCOMMON.DFASL;1
|
||||
{DSK}<home>larry>new>medley>library>MSCOMMON.DFASL;1
|
||||
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3
|
||||
Source file created Monday, 4 May 1992, 13:19:40.
|
||||
FASL file created Sunday, 28 February 1993, 23:23:14.
|
||||
|
||||
loading UNIXPRINT
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>UNIXPRINT.DFASL;1
|
||||
{DSK}<home>larry>new>medley>library>UNIXPRINT.DFASL;1
|
||||
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8
|
||||
Source file created Friday, 4 May 2018, 17:18:00.
|
||||
FASL file created Friday, 4 May 2018, 17:18:00.
|
||||
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>UNIXCOMM.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>UNIXCOMM.LCOM;1
|
||||
compiled on 25-Apr-2018 07:31:56
|
||||
File created 25-Apr-2018 07:31:56
|
||||
UNIXCOMMCOMS
|
||||
loading UNICODE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>UNICODE.LCOM;18
|
||||
compiled on 1-Feb-2021 18:00:30
|
||||
File created 1-Feb-2021 18:00:30
|
||||
{DSK}<home>larry>new>medley>library>UNICODE.LCOM;18
|
||||
compiled on 3-Jul-2021 13:37:33
|
||||
File created 3-Jul-2021 13:37:33
|
||||
UNICODECOMS
|
||||
loading ISO8859IO
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>ISO8859IO.LCOM;1
|
||||
compiled on 24-Apr-2021 17:06:43
|
||||
File created 24-Apr-2021 17:06:30
|
||||
{DSK}<home>larry>new>medley>lispusers>ISO8859IO.LCOM;1
|
||||
compiled on 23-Jun-2021 17:00:30
|
||||
File created 23-Jun-2021 17:00:30
|
||||
ISO8859IOCOMS
|
||||
loading HELPSYS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.LCOM;1
|
||||
{DSK}<home>larry>new>medley>lispusers>HELPSYS.LCOM;1
|
||||
compiled on 27-Nov-2020 11:23:11
|
||||
File created 27-Nov-2020 09:47:44
|
||||
HELPSYSCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>DINFO.LCOM;1
|
||||
{DSK}<home>larry>new>medley>lispusers>DINFO.LCOM;1
|
||||
compiled on 14-Feb-2021 23:11:53
|
||||
File created 14-Feb-2021 23:11:36
|
||||
DINFOCOMS
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>HASH.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>HASH.LCOM;1
|
||||
compiled on 26-Feb-93 11:22:10
|
||||
File created 11-Jun-90 16:23:11
|
||||
HASHCOMS
|
||||
@@ -286,25 +286,25 @@ HASHCOMS
|
||||
Reading IRM graph...OK.loading DINFO
|
||||
loading CLIPBOARD
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>CLIPBOARD.LCOM;1
|
||||
compiled on 23-Feb-2021 22:13:09
|
||||
File created 23-Feb-2021 22:13:09
|
||||
{DSK}<home>larry>new>medley>library>CLIPBOARD.LCOM;1
|
||||
compiled on 3-Jul-2021 13:16:26
|
||||
File created 3-Jul-2021 13:16:26
|
||||
CLIPBOARDCOMS
|
||||
loading MODERNIZE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>MODERNIZE.LCOM;1
|
||||
compiled on 14-Mar-2021 20:33:34
|
||||
File created 14-Mar-2021 20:33:34
|
||||
{DSK}<home>larry>new>medley>lispusers>MODERNIZE.LCOM;1
|
||||
compiled on 8-Jul-2021 23:33:42
|
||||
File created 8-Jul-2021 23:33:42
|
||||
MODERNIZECOMS
|
||||
loading PRETTYFILEINDEX
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>PRETTYFILEINDEX.LCOM;3
|
||||
compiled on 28-Jun-99 17:13:58
|
||||
File created 28-Jun-99 17:13:51
|
||||
{DSK}<home>larry>new>medley>lispusers>PRETTYFILEINDEX.LCOM;3
|
||||
compiled on 9-Jul-2021 21:55:15
|
||||
File created 9-Jul-2021 21:55:15
|
||||
PRETTYFILEINDEXCOMS
|
||||
loading WHO-LINE
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.DFASL;1
|
||||
{DSK}<home>larry>new>medley>lispusers>WHO-LINE.DFASL;1
|
||||
XCL Compiler output for source file {DSK}<home>larry>ilisp>medley>lispusers>WHO-LINE.;4
|
||||
Source file created 26-Mar-2021 11:01:59
|
||||
FASL file created Friday, 26 March 2021, 11:01:59
|
||||
@@ -312,7 +312,7 @@ FASL file created Friday, 26 March 2021, 11:01:59
|
||||
loading UNIXCOMM
|
||||
loading UNIXCHAT
|
||||
|
||||
{DSK}<home>larry>ilisp>medley>library>UNIXCHAT.LCOM;1
|
||||
{DSK}<home>larry>new>medley>library>UNIXCHAT.LCOM;1
|
||||
compiled on 21-Jan-93 18:45:15
|
||||
File created 15-Aug-90 11:05:53
|
||||
UNIXCHATCOMS
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -14,7 +14,7 @@ touch ./tmp/loadup.timestamp
|
||||
./scripts/loadup-init.sh && \
|
||||
./scripts/loadup-mid-from-init.sh && \
|
||||
./scripts/loadup-lisp-from-mid.sh && \
|
||||
./scripts/loadup-full.sh && \
|
||||
./scripts/loadup-full-from-lisp.sh && \
|
||||
./scripts/loadup-aux.sh && \
|
||||
echo "**** DONE ****"
|
||||
|
||||
|
||||
25
scripts/loadup-full-from-lisp.sh
Normal file
25
scripts/loadup-full-from-lisp.sh
Normal file
@@ -0,0 +1,25 @@
|
||||
#!/bin/sh
|
||||
|
||||
export MEDLEYDIR=`pwd`
|
||||
|
||||
if [ ! -x run-medley ] ; then
|
||||
echo must run from MEDLEYDIR ;
|
||||
exit 1 ;
|
||||
fi
|
||||
scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
|
||||
|
||||
if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
echo ---- made ----
|
||||
ls -l tmp/full.*
|
||||
echo --------------
|
||||
|
||||
else
|
||||
echo XXXXX FAILURE XXXXX
|
||||
ls -l tmp/full.*
|
||||
exit 1
|
||||
fi
|
||||
@@ -10,7 +10,7 @@ scr="-sc 1024x768 -g 1042x790"
|
||||
|
||||
touch tmp/loadup.timestamp
|
||||
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/tmp/lisp.sysout"
|
||||
./run-medley $scr -greet "$MEDLEYDIR/sources/LOADUP-FULL.CM" "$MEDLEYDIR/loadups/lisp.sysout"
|
||||
|
||||
if [ tmp/full.sysout -nt tmp/loadup.timestamp ]; then
|
||||
|
||||
|
||||
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "16-May-90 11:43:16" {DSK}<usr>local>lde>lispcore>sources>ABASIC.;2 24522
|
||||
(FILECREATED " 9-Jun-2021 19:40:59"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ABASIC.;2 24528
|
||||
|
||||
changes to%: (VARS ABASICCOMS)
|
||||
changes to%: (FNS NILL ZERO)
|
||||
|
||||
previous date%: "10-Nov-87 13:01:39" {DSK}<usr>local>lde>lispcore>sources>ABASIC.;1)
|
||||
previous date%: "16-May-90 11:43:16"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ABASIC.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1982-1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ABASICCOMS)
|
||||
@@ -17,8 +19,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
(FNS NILL EVQ TRUE ZERO CL:IDENTITY DUMMYDEF NOTIMP)
|
||||
(P (DUMMYDEF (WINDOWWORLDP NILL)))
|
||||
(FNS EQUAL NEQ NULL NOT)
|
||||
(COMS (* ;
|
||||
"Belong on ACODE except they would clobber 10-versions in ABC")
|
||||
(COMS (* ;
|
||||
"Belong on ACODE except they would clobber 10-versions in ABC")
|
||||
(FNS LAPRD DEFC CGETD))
|
||||
(FNS NCONC \NCONC2 SORT MERGE SORT1 FASSOC FLAST FLENGTH FMEMB FNTH LIST LIST* COUNT)
|
||||
(FNS CHANGENAME1 CHANGENAME1A)
|
||||
@@ -26,15 +28,15 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
CDDADR CDDAAR CDAAAR CADADR CDADDR CDADAR CAADDR CDAADR CAADAR CADDDR CADAAR CADDAR
|
||||
CAAADR)
|
||||
(FNS SYSTEMTYPE)
|
||||
(COMS (* ;
|
||||
"Because can't have bignums in code at makeinit time")
|
||||
(COMS (* ;
|
||||
"Because can't have bignums in code at makeinit time")
|
||||
(VARS (\IMAX.FLOAT (FIX MAX.FLOAT))
|
||||
(\IMIN.FLOAT (FIX MIN.FLOAT)))
|
||||
(GLOBALVARS \IMAX.FLOAT \IMIN.FLOAT))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DUMMYDEF)
|
||||
(NLAML)
|
||||
(LAMA LIST* LIST NCONC NOTIMP ZERO TRUE NILL])
|
||||
(LAMA LIST* LIST NCONC NOTIMP ZERO NILL])
|
||||
(DEFINEQ
|
||||
|
||||
(EVALQT
|
||||
@@ -62,7 +64,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
(DEFINEQ
|
||||
|
||||
(NILL
|
||||
[LAMBDA NOBIND (* lmm " 4-OCT-83 03:05")
|
||||
[LAMBDA NIL (* ; "Edited 9-Jun-2021 19:40 by rmk:")
|
||||
NIL])
|
||||
|
||||
(EVQ
|
||||
@@ -74,7 +76,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
T])
|
||||
|
||||
(ZERO
|
||||
[LAMBDA NOBIND (* lmm " 4-OCT-83 03:05")
|
||||
[LAMBDA NIL (* ; "Edited 9-Jun-2021 19:40 by rmk:")
|
||||
0])
|
||||
|
||||
(CL:IDENTITY
|
||||
@@ -644,7 +646,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA LIST* LIST NCONC NOTIMP ZERO TRUE NILL)
|
||||
(ADDTOVAR LAMA LIST* LIST NCONC NOTIMP ZERO NILL)
|
||||
)
|
||||
(PRETTYCOMPRINT ABASICCOMS)
|
||||
|
||||
@@ -653,8 +655,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
(FNS NILL EVQ TRUE ZERO CL:IDENTITY DUMMYDEF NOTIMP)
|
||||
(P (DUMMYDEF (WINDOWWORLDP NILL)))
|
||||
(FNS EQUAL NEQ NULL NOT)
|
||||
(COMS (* ;
|
||||
"Belong on ACODE except they would clobber 10-versions in ABC")
|
||||
(COMS (* ;
|
||||
"Belong on ACODE except they would clobber 10-versions in ABC")
|
||||
(FNS LAPRD DEFC CGETD))
|
||||
(FNS NCONC \NCONC2 SORT MERGE SORT1 FASSOC FLAST FLENGTH FMEMB FNTH LIST LIST* COUNT)
|
||||
(FNS CHANGENAME1 CHANGENAME1A)
|
||||
@@ -662,38 +664,38 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporat
|
||||
CDDADR CDDAAR CDAAAR CADADR CDADDR CDADAR CAADDR CDAADR CAADAR CADDDR CADAAR CADDAR
|
||||
CAAADR)
|
||||
(FNS SYSTEMTYPE)
|
||||
(COMS (* ;
|
||||
"Because can't have bignums in code at makeinit time")
|
||||
(COMS (* ;
|
||||
"Because can't have bignums in code at makeinit time")
|
||||
(VARS (\IMAX.FLOAT (FIX MAX.FLOAT))
|
||||
(\IMIN.FLOAT (FIX MIN.FLOAT)))
|
||||
(GLOBALVARS \IMAX.FLOAT \IMIN.FLOAT))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DUMMYDEF)
|
||||
(NLAML)
|
||||
(LAMA LIST* LIST NCONC NOTIMP ZERO NILL])
|
||||
(LAMA LIST* LIST NCONC NOTIMP])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA DUMMYDEF)
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA LIST* LIST NCONC NOTIMP ZERO NILL)
|
||||
(ADDTOVAR LAMA LIST* LIST NCONC NOTIMP)
|
||||
)
|
||||
(PUTPROPS ABASIC COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990))
|
||||
(PUTPROPS ABASIC COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1772 2517 (EVALQT 1782 . 2275) (\SystemERROR 2277 . 2515)) (2518 3516 (NILL 2528 . 2634
|
||||
) (EVQ 2636 . 2737) (TRUE 2739 . 2843) (ZERO 2845 . 2949) (CL:IDENTITY 2951 . 3064) (DUMMYDEF 3066 .
|
||||
3377) (NOTIMP 3379 . 3514)) (3553 8305 (EQUAL 3563 . 8173) (NEQ 8175 . 8222) (NULL 8224 . 8263) (NOT
|
||||
8265 . 8303)) (8383 10259 (LAPRD 8393 . 8884) (DEFC 8886 . 10169) (CGETD 10171 . 10257)) (10260 19969
|
||||
(NCONC 10270 . 10673) (\NCONC2 10675 . 10870) (SORT 10872 . 11256) (MERGE 11258 . 14142) (SORT1 14144
|
||||
. 17315) (FASSOC 17317 . 17553) (FLAST 17555 . 17801) (FLENGTH 17803 . 18118) (FMEMB 18120 . 18479) (
|
||||
FNTH 18481 . 18963) (LIST 18965 . 19268) (LIST* 19270 . 19640) (COUNT 19642 . 19967)) (19970 20799 (
|
||||
CHANGENAME1 19980 . 20471) (CHANGENAME1A 20473 . 20797)) (20800 22254 (CDDR 20810 . 20851) (CDAR 20853
|
||||
. 20894) (CADR 20896 . 20937) (CAAR 20939 . 20980) (CDDDR 20982 . 21029) (CDDAR 21031 . 21078) (CDADR
|
||||
21080 . 21127) (CDAAR 21129 . 21176) (CADDR 21178 . 21225) (CADAR 21227 . 21274) (CAADR 21276 . 21323
|
||||
) (CAAAR 21325 . 21372) (CDDDDR 21374 . 21427) (CAAAAR 21429 . 21482) (CDDDAR 21484 . 21537) (CDDADR
|
||||
21539 . 21592) (CDDAAR 21594 . 21647) (CDAAAR 21649 . 21702) (CADADR 21704 . 21757) (CDADDR 21759 .
|
||||
21812) (CDADAR 21814 . 21867) (CAADDR 21869 . 21922) (CDAADR 21924 . 21977) (CAADAR 21979 . 22032) (
|
||||
CADDDR 22034 . 22087) (CADAAR 22089 . 22142) (CADDAR 22144 . 22197) (CAAADR 22199 . 22252)) (22255
|
||||
22481 (SYSTEMTYPE 22265 . 22479)))))
|
||||
(FILEMAP (NIL (1762 2507 (EVALQT 1772 . 2265) (\SystemERROR 2267 . 2505)) (2508 3542 (NILL 2518 . 2642
|
||||
) (EVQ 2644 . 2745) (TRUE 2747 . 2851) (ZERO 2853 . 2975) (CL:IDENTITY 2977 . 3090) (DUMMYDEF 3092 .
|
||||
3403) (NOTIMP 3405 . 3540)) (3579 8331 (EQUAL 3589 . 8199) (NEQ 8201 . 8248) (NULL 8250 . 8289) (NOT
|
||||
8291 . 8329)) (8409 10285 (LAPRD 8419 . 8910) (DEFC 8912 . 10195) (CGETD 10197 . 10283)) (10286 19995
|
||||
(NCONC 10296 . 10699) (\NCONC2 10701 . 10896) (SORT 10898 . 11282) (MERGE 11284 . 14168) (SORT1 14170
|
||||
. 17341) (FASSOC 17343 . 17579) (FLAST 17581 . 17827) (FLENGTH 17829 . 18144) (FMEMB 18146 . 18505) (
|
||||
FNTH 18507 . 18989) (LIST 18991 . 19294) (LIST* 19296 . 19666) (COUNT 19668 . 19993)) (19996 20825 (
|
||||
CHANGENAME1 20006 . 20497) (CHANGENAME1A 20499 . 20823)) (20826 22280 (CDDR 20836 . 20877) (CDAR 20879
|
||||
. 20920) (CADR 20922 . 20963) (CAAR 20965 . 21006) (CDDDR 21008 . 21055) (CDDAR 21057 . 21104) (CDADR
|
||||
21106 . 21153) (CDAAR 21155 . 21202) (CADDR 21204 . 21251) (CADAR 21253 . 21300) (CAADR 21302 . 21349
|
||||
) (CAAAR 21351 . 21398) (CDDDDR 21400 . 21453) (CAAAAR 21455 . 21508) (CDDDAR 21510 . 21563) (CDDADR
|
||||
21565 . 21618) (CDDAAR 21620 . 21673) (CDAAAR 21675 . 21728) (CADADR 21730 . 21783) (CDADDR 21785 .
|
||||
21838) (CDADAR 21840 . 21893) (CAADDR 21895 . 21948) (CDAADR 21950 . 22003) (CAADAR 22005 . 22058) (
|
||||
CADDDR 22060 . 22113) (CADAAR 22115 . 22168) (CADDAR 22170 . 22223) (CAAADR 22225 . 22278)) (22281
|
||||
22507 (SYSTEMTYPE 22291 . 22505)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
80
sources/ADIR
80
sources/ADIR
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "21-Mar-2021 21:59:07" {DSK}<home>larry>ilisp>medley>sources>ADIR.;30 65795
|
||||
(FILECREATED "13-Jun-2021 11:25:58" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ADIR.;9 65815
|
||||
|
||||
changes to%: (VARS ADIRCOMS)
|
||||
(FNS \FLUSHVM \LOGOUT0)
|
||||
changes to%: (FNS OPENSTREAM)
|
||||
|
||||
previous date%: "16-Mar-2021 19:55:51" {DSK}<home>larry>ilisp>medley>sources>ADIR.;26)
|
||||
previous date%: "21-Mar-2021 21:59:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ADIR.;8)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -14,14 +14,14 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
|
||||
(RPAQQ ADIRCOMS
|
||||
[[COMS (* ; "user-level i/o routines")
|
||||
[[COMS (* ; "user-level i/o routines")
|
||||
(FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP
|
||||
RENAMEFILE SIMPLE.FINDFILE VMEMSIZE \COPYSYS \FLUSHVM \LOGOUT0)
|
||||
(CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
|
||||
(P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P
|
||||
|
||||
(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM. PATHNAMEP (and pathnames) get defined much later in the loadup.")
|
||||
(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM. PATHNAMEP (and pathnames) get defined much later in the loadup.")
|
||||
|
||||
(MOVD? 'NILL 'CL:PATHNAMEP]
|
||||
(COMS (FNS UNPACKFILENAME UNPACKFILENAME.STRING LASTCHPOS \UPF.NEXTPOS \UPF.TEMPFILEP
|
||||
@@ -30,8 +30,8 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
PACKFILENAME.ASSEMBLE UNPACKFILE1))
|
||||
(VARS \FILENAME.SYNTAX)
|
||||
(GLOBALVARS \FILENAME.SYNTAX))
|
||||
(COMS (* ;
|
||||
"saving and restoring system state")
|
||||
(COMS (* ;
|
||||
"saving and restoring system state")
|
||||
(FNS LOGOUT MAKESYS SYSOUT SAVEVM HERALD INTERPRET.REM.CM \USEREVENT)
|
||||
(ADDVARS (AROUNDEXITFNS))
|
||||
(INITVARS (HERALDSTRING "")
|
||||
@@ -89,7 +89,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
OPTIONAL])
|
||||
|
||||
(OPENSTREAM
|
||||
[LAMBDA (FILE ACCESS RECOG PARAMETERS OBSOLETE) (* hdj "28-Aug-86 14:50")
|
||||
[LAMBDA (FILE ACCESS RECOG PARAMETERS OBSOLETE) (* ; "Edited 13-Jun-2021 11:25 by rmk:")
|
||||
(PROG (REC OLDSTREAM STREAM)
|
||||
(SELECTQ ACCESS
|
||||
((INPUT OUTPUT BOTH APPEND))
|
||||
@@ -106,7 +106,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(AND PARAMETERS (NLISTP PARAMETERS)))
|
||||
then
|
||||
|
||||
(* ;; "used to have OPENFILE/OPENSTREAM with BYTESIZE and PARAMETERS. Now it will take PARAMETERS, and generally ignore the BYTESIZE")
|
||||
(* ;; "used to have OPENFILE/OPENSTREAM with BYTESIZE and PARAMETERS. Now it will take PARAMETERS, and generally ignore the BYTESIZE")
|
||||
|
||||
(SETQ PARAMETERS (APPEND (SELECTQ PARAMETERS
|
||||
(7 '((TYPE TEXT)))
|
||||
@@ -117,46 +117,46 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
((OR (EQ FILE T)
|
||||
(NULL FILE))
|
||||
|
||||
(* ;; "Handle T and NIL separately, cause they can return the terminal streams, for which the search isn't necessary and the \ADDOFD shouldn't be done.")
|
||||
(* ;; "Handle T and NIL separately, cause they can return the terminal streams, for which the search isn't necessary and the \ADDOFD shouldn't be done.")
|
||||
|
||||
(SETQ STREAM (\GETSTREAM FILE ACCESS))
|
||||
(\DO.PARAMS.AT.OPEN STREAM ACCESS PARAMETERS)
|
||||
(RETURN STREAM)))
|
||||
|
||||
(* ;; "Explicitly test for PATHNAMEP, as PATHNAMEP will have a NILL def early in the loadup, and the tests in \CONVERT-PATHNAME won't break anything")
|
||||
(* ;; "Explicitly test for PATHNAMEP, as PATHNAMEP will have a NILL def early in the loadup, and the tests in \CONVERT-PATHNAME won't break anything")
|
||||
|
||||
(* ;; "Pavel changed a call to (PATHNAMEP FILE) into (TYPEP FILE `PATHNAME) because PATHNAMEP didn't have a NILL defn early in the loadup and TYPEP has an optimizer on it that compiles away the call to TYPEP which also has no defn early in the loadup.")
|
||||
(* ;; "Pavel changed a call to (PATHNAMEP FILE) into (TYPEP FILE `PATHNAME) because PATHNAMEP didn't have a NILL defn early in the loadup and TYPEP has an optimizer on it that compiles away the call to TYPEP which also has no defn early in the loadup.")
|
||||
|
||||
(* ;; "Pavel also added the call to MKSTRING below as a temporary hack to get around the fact that the Interlisp string functions can't yet handle Common Lisp simple-strings.")
|
||||
(* ;; "Pavel also added the call to MKSTRING below as a temporary hack to get around the fact that the Interlisp string functions can't yet handle Common Lisp simple-strings.")
|
||||
|
||||
(if (TYPEP FILE 'PATHNAME)
|
||||
then (SETQ FILE (\CONVERT-PATHNAME FILE)))
|
||||
|
||||
(* ;; "We open the file before looking to see whether it is already open. This guarantees that we acquire the opening rights at the time we lookup the name. We then check to see if it is currently open in Lisp. If it is, we return the previous stream, which has the file's current state. ")
|
||||
(* ;; "We open the file before looking to see whether it is already open. This guarantees that we acquire the opening rights at the time we lookup the name. We then check to see if it is currently open in Lisp. If it is, we return the previous stream, which has the file's current state. ")
|
||||
|
||||
(* ;; "There are still potential problems: First, an interrupt can happen while we are doing the search which causes the file to be deleted or re-opened beneath us, BEFORE it gets added to \OPENFILES. Second, a network device might not allow multiple openings of the file, even by the same guy with the same mode.")
|
||||
(* ;; "There are still potential problems: First, an interrupt can happen while we are doing the search which causes the file to be deleted or re-opened beneath us, BEFORE it gets added to \OPENFILES. Second, a network device might not allow multiple openings of the file, even by the same guy with the same mode.")
|
||||
|
||||
(SETQ STREAM (\OPENFILE FILE ACCESS REC PARAMETERS))
|
||||
(COND
|
||||
[[AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
|
||||
(SETQ OLDSTREAM (\SEARCHOPENFILES (fetch FULLNAME of STREAM]
|
||||
(SETQ OLDSTREAM (\SEARCHOPENFILES (fetch (STREAM FULLNAME) of STREAM]
|
||||
|
||||
(* ;; "There is already a stream open on the file. Check that there is no conflict. Eventually all this registration belongs in the device, so that we can have multiple streams open per file")
|
||||
(* ;; "There is already a stream open on the file. Check that there is no conflict. Eventually all this registration belongs in the device, so that we can have multiple streams open per file")
|
||||
|
||||
(COND
|
||||
((AND (EQ ACCESS 'INPUT)
|
||||
(EQ (fetch ACCESS of OLDSTREAM)
|
||||
'INPUT)) (* ;
|
||||
"Dispose of the newly-obtained stream, This might be a noop, but a network device (LEAF) cares")
|
||||
(EQ (fetch (STREAM ACCESS) of OLDSTREAM)
|
||||
'INPUT)) (* ;
|
||||
"Dispose of the newly-obtained stream, This might be a noop, but a network device (LEAF) cares")
|
||||
(OR (EQ STREAM OLDSTREAM)
|
||||
(\CLOSEFILE STREAM))
|
||||
(\DO.PARAMS.AT.OPEN OLDSTREAM ACCESS PARAMETERS)
|
||||
(* ; "Do parameters on the old stream")
|
||||
(* ; "Do parameters on the old stream")
|
||||
(RETURN OLDSTREAM))
|
||||
(T (LISPERROR "FILE WON'T OPEN" FILE]
|
||||
(T (AND (NOT MULTIPLE.STREAMS.PER.FILE.ALLOWED)
|
||||
(\ADDOFD STREAM)) (* ;
|
||||
"Parameters done on new stream by \OPENFILE")
|
||||
(\ADDOFD STREAM)) (* ;
|
||||
"Parameters done on new stream by \OPENFILE")
|
||||
(RETURN STREAM])
|
||||
|
||||
(OUTFILE
|
||||
@@ -274,7 +274,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
|
||||
(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM. PATHNAMEP (and pathnames) get defined much later in the loadup.")
|
||||
(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM. PATHNAMEP (and pathnames) get defined much later in the loadup.")
|
||||
|
||||
|
||||
(MOVD? 'NILL 'CL:PATHNAMEP)
|
||||
@@ -709,7 +709,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
LP (COND
|
||||
((<= I N)
|
||||
|
||||
(* ;; "Grab the next field-name / value pair and fold it into the filename:")
|
||||
(* ;; "Grab the next field-name / value pair and fold it into the filename:")
|
||||
|
||||
(COND
|
||||
((LISTP (SETQ VAR (ARG N I)))
|
||||
@@ -803,7 +803,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
BLIP])
|
||||
(RELATIVEDIRECTORY
|
||||
|
||||
(* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified. It really should act as a subdirectory in that case? JDS")
|
||||
(* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified. It really should act as a subdirectory in that case? JDS")
|
||||
|
||||
(OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY
|
||||
(OR (CADR X)
|
||||
@@ -826,7 +826,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (OR VAL BLIP))))
|
||||
(RELATIVEDIRECTORY
|
||||
|
||||
(* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified. It really should act as a subdirectory in that case? JDS")
|
||||
(* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified. It really should act as a subdirectory in that case? JDS")
|
||||
|
||||
(OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (OR VAL BLIP))))
|
||||
(DEVICE (OR DEVICE (SETQ DEVICE (OR VAL BLIP))))
|
||||
@@ -913,8 +913,8 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(SUBSTRING VERSION 2 -1))
|
||||
VERSION])
|
||||
|
||||
(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END)
|
||||
(* lmm "22-APR-81 22:21")
|
||||
(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END)
|
||||
(* lmm "22-APR-81 22:21")
|
||||
(COND
|
||||
[(NOT ONEFIELDFLG)
|
||||
(SETQ VAL (CONS (COND
|
||||
@@ -1158,14 +1158,14 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
|
||||
(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 (2745 13838 (DELFILE 2755 . 2916) (FULLNAME 2918 . 3285) (INFILE 3287 . 3435) (INFILEP
|
||||
3437 . 3572) (IOFILE 3574 . 3714) (OPENFILE 3716 . 4116) (OPENSTREAM 4118 . 8426) (OUTFILE 8428 . 8579
|
||||
) (OUTFILEP 8581 . 8717) (RENAMEFILE 8719 . 9025) (SIMPLE.FINDFILE 9027 . 9437) (VMEMSIZE 9439 . 9606)
|
||||
(\COPYSYS 9608 . 12557) (\FLUSHVM 12559 . 13631) (\LOGOUT0 13633 . 13836)) (14210 33801 (
|
||||
UNPACKFILENAME 14220 . 14406) (UNPACKFILENAME.STRING 14408 . 30680) (LASTCHPOS 30682 . 31376) (
|
||||
\UPF.NEXTPOS 31378 . 32023) (\UPF.TEMPFILEP 32025 . 32602) (FILENAMEFIELD 32604 . 33089) (PACKFILENAME
|
||||
33091 . 33434) (PACKFILENAME.STRING 33436 . 33799)) (56242 63422 (LOGOUT 56252 . 57169) (MAKESYS
|
||||
57171 . 58800) (SYSOUT 58802 . 60354) (SAVEVM 60356 . 61156) (HERALD 61158 . 61318) (INTERPRET.REM.CM
|
||||
61320 . 63045) (\USEREVENT 63047 . 63420)) (63604 65331 (USERNAME 63614 . 64570) (SETUSERNAME 64572 .
|
||||
65329)))))
|
||||
(FILEMAP (NIL (2733 13858 (DELFILE 2743 . 2904) (FULLNAME 2906 . 3273) (INFILE 3275 . 3423) (INFILEP
|
||||
3425 . 3560) (IOFILE 3562 . 3702) (OPENFILE 3704 . 4104) (OPENSTREAM 4106 . 8446) (OUTFILE 8448 . 8599
|
||||
) (OUTFILEP 8601 . 8737) (RENAMEFILE 8739 . 9045) (SIMPLE.FINDFILE 9047 . 9457) (VMEMSIZE 9459 . 9626)
|
||||
(\COPYSYS 9628 . 12577) (\FLUSHVM 12579 . 13651) (\LOGOUT0 13653 . 13856)) (14230 33821 (
|
||||
UNPACKFILENAME 14240 . 14426) (UNPACKFILENAME.STRING 14428 . 30700) (LASTCHPOS 30702 . 31396) (
|
||||
\UPF.NEXTPOS 31398 . 32043) (\UPF.TEMPFILEP 32045 . 32622) (FILENAMEFIELD 32624 . 33109) (PACKFILENAME
|
||||
33111 . 33454) (PACKFILENAME.STRING 33456 . 33819)) (56262 63442 (LOGOUT 56272 . 57189) (MAKESYS
|
||||
57191 . 58820) (SYSOUT 58822 . 60374) (SAVEVM 60376 . 61176) (HERALD 61178 . 61338) (INTERPRET.REM.CM
|
||||
61340 . 63065) (\USEREVENT 63067 . 63440)) (63624 65351 (USERNAME 63634 . 64590) (SETUSERNAME 64592 .
|
||||
65349)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
830
sources/ADISPLAY
830
sources/ADISPLAY
File diff suppressed because it is too large
Load Diff
Binary file not shown.
201
sources/AOFD
201
sources/AOFD
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "13-Sep-90 16:39:58" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>AOFD.;4| 34722
|
||||
(FILECREATED "13-Jun-2021 11:35:32" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;2 35745
|
||||
|
||||
changes to%: (FNS \BASEBYTES.IO.INIT \BASEBYTES.SETFILEPTR)
|
||||
changes to%: (FNS CLOSEF INPUT OUTPUT RANDACCESSP \MAKEBASEBYTESTREAM \BASEBYTES.PEEKBIN
|
||||
\SEARCHOPENFILES)
|
||||
|
||||
previous date%: "16-May-90 12:01:06" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>AOFD.;3|)
|
||||
previous date%: "10-May-2021 15:44:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>AOFD.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1981-1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT AOFDCOMS)
|
||||
@@ -15,7 +17,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(RPAQQ AOFDCOMS
|
||||
[
|
||||
|
||||
(* ;;; "streams (= OpenFileDescriptors)")
|
||||
(* ;;; "streams (= OpenFileDescriptors)")
|
||||
|
||||
(COMS (FNS \ADD-OPEN-STREAM \GENERIC-UNREGISTER-STREAM)
|
||||
(INITVARS (*ISSUE-CLOSE-WARNINGS* NIL))
|
||||
@@ -26,7 +28,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(\OPENFILES))
|
||||
(GLOBALVARS DEFAULTEOFCLOSE \OPENFILES))
|
||||
(COMS
|
||||
(* ;; "STREAM interface to Read and Write to random memory")
|
||||
(* ;; "STREAM interface to Read and Write to random memory")
|
||||
|
||||
(DECLARE%: DONTCOPY (EXPORT (RECORDS BASEBYTESTREAM)))
|
||||
(FNS \BASEBYTES.IO.INIT \MAKEBASEBYTESTREAM \MBS.OUTCHARFN \BASEBYTES.NAME.FROM.STREAM
|
||||
@@ -36,7 +38,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(DECLARE%: DONTEVAL@LOAD (P (\BASEBYTES.IO.INIT)))
|
||||
(FNS OPENSTRINGSTREAM))
|
||||
[COMS
|
||||
(* ;; "STREAM interface for old-style strings")
|
||||
(* ;; "STREAM interface for old-style strings")
|
||||
|
||||
(FNS \STRINGSTREAM.INIT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\STRINGSTREAM.INIT]
|
||||
@@ -93,11 +95,11 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
collect (CLOSEF STREAM])
|
||||
|
||||
(CLOSEF
|
||||
[LAMBDA (FILE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:26 by rmk:")
|
||||
(PROG ((STREAM (\GETSTREAM FILE)))
|
||||
(COND
|
||||
((OR (\OUTTERMP STREAM)
|
||||
(NOT (fetch USERCLOSEABLE of STREAM)))
|
||||
(NOT (fetch (STREAM USERCLOSEABLE) of STREAM)))
|
||||
(RETURN NIL)))
|
||||
[MAPC (STREAMPROP STREAM 'BEFORECLOSE)
|
||||
(FUNCTION (LAMBDA (FN)
|
||||
@@ -111,14 +113,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(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)
|
||||
(FUNCTION (LAMBDA (FN)
|
||||
(APPLY* FN STREAM]
|
||||
(RETURN (fetch FULLNAME of STREAM])
|
||||
(RETURN (fetch (STREAM FULLNAME) of STREAM])
|
||||
|
||||
(EOFCLOSEF
|
||||
[LAMBDA (FILE) (* bvm%: "15-Jan-85 17:58")
|
||||
@@ -129,18 +131,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
STREAM])
|
||||
|
||||
(INPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[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 FULLNAME of *STANDARD-INPUT*)))
|
||||
(COND
|
||||
(FILE (SETQ *STANDARD-INPUT* (COND
|
||||
((EQ FILE T) (* ;
|
||||
"Check explicitly for T to avoid needless creations")
|
||||
\LINEBUF.OFD)
|
||||
(T (\GETSTREAM FILE '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")
|
||||
\LINEBUF.OFD)
|
||||
(T (\GETSTREAM FILE 'INPUT])])
|
||||
|
||||
(OPENP
|
||||
[LAMBDA (FILE ACCESS) (* hdj "29-Sep-86 17:41")
|
||||
@@ -153,18 +155,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
\FILEDEVICES NIL])
|
||||
|
||||
(OUTPUT
|
||||
[LAMBDA (FILE) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
[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 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")
|
||||
\TERM.OFD)
|
||||
(T (\GETSTREAM FILE '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")
|
||||
\TERM.OFD)
|
||||
(T (\GETSTREAM FILE 'OUTPUT])])
|
||||
|
||||
(POSITION
|
||||
[LAMBDA (FILE N) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
@@ -181,11 +183,12 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
0])
|
||||
|
||||
(RANDACCESSP
|
||||
[LAMBDA (FILE) (* rmk%: "14-OCT-83 15:32")
|
||||
[LAMBDA (FILE) (* ; "Edited 13-Jun-2021 11:28 by rmk:")
|
||||
(PROG ((STREAM (\GETSTREAM FILE)))
|
||||
(RETURN (AND (fetch RANDOMACCESSP of (fetch DEVICE of STREAM))
|
||||
(RETURN (AND (fetch (FDEV RANDOMACCESSP) of (fetch (STREAM DEVICE) of
|
||||
STREAM))
|
||||
(NEQ STREAM \LINEBUF.OFD)
|
||||
(fetch FULLNAME of STREAM])
|
||||
(fetch (STREAM FULLNAME) of STREAM])
|
||||
|
||||
(\IOMODEP
|
||||
[LAMBDA (STREAM ACCESS NOERROR) (* rmk%: "21-OCT-83 11:10")
|
||||
@@ -248,9 +251,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(* ;; "STREAM interface to Read and Write to random memory")
|
||||
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD BASEBYTESTREAM STREAM (SUBRECORD STREAM)
|
||||
[ACCESSFNS ((BIASOFFST (fetch (STREAM FW6) of DATUM)
|
||||
@@ -334,9 +335,10 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(\DEFINEDEVICE NIL \BASEBYTESDEVICE])
|
||||
|
||||
(\MAKEBASEBYTESTREAM
|
||||
[LAMBDA (BASE OFFST LEN ACCESS WRITEXTENSIONFN OSTREAM) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
|
||||
(* ;; "If an error is to occur due to non-numeric arg or range restrictions, then let it happen outside the UNINTERRUPTABLY")
|
||||
[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")
|
||||
|
||||
(OR BASE (EQ LEN 0)
|
||||
(SHOULDNT))
|
||||
@@ -350,34 +352,39 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(\ILLEGAL.ARG ACCESS))
|
||||
(if (type? STREAM OSTREAM)
|
||||
then (if (EQ (ffetch (STREAM DEVICE) of OSTREAM)
|
||||
\BASEBYTESDEVICE)
|
||||
then (replace 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 USERCLOSEABLE of OSTREAM with NIL)
|
||||
(freplace USERVISIBLE of OSTREAM with NIL)
|
||||
(freplace BYTESIZE of OSTREAM with BITSPERBYTE)
|
||||
(freplace CPAGE of OSTREAM with (freplace EPAGE of OSTREAM with 0))
|
||||
(freplace CBUFPTR of OSTREAM with BASE)
|
||||
(freplace COFFSET of OSTREAM with (freplace BIASOFFST of OSTREAM with OFFST))
|
||||
(freplace CBUFSIZE of OSTREAM with (freplace EOFFSET of OSTREAM with LEN))
|
||||
(replace 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")
|
||||
(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 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))
|
||||
(replace (STREAM ACCESS) of OSTREAM with ACCESS)
|
||||
|
||||
(freplace FULLFILENAME of OSTREAM with NIL)
|
||||
(freplace OUTCHARFN of OSTREAM with (FUNCTION \MBS.OUTCHARFN))
|
||||
(freplace LINELENGTH of OSTREAM with 0)
|
||||
(freplace CHARPOSITION of OSTREAM with 0)
|
||||
(freplace WRITEXTENSIONFN of OSTREAM with (SELECTQ ACCESS
|
||||
((OUTPUT BOTH)
|
||||
WRITEXTENSIONFN)
|
||||
NIL))
|
||||
(freplace BBSNCHARS of OSTREAM with 0))
|
||||
(* ;; "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))
|
||||
(freplace (BASEBYTESTREAM BBSNCHARS) of OSTREAM with 0))
|
||||
OSTREAM])
|
||||
|
||||
(\MBS.OUTCHARFN
|
||||
@@ -453,18 +460,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
1])
|
||||
|
||||
(\BASEBYTES.PEEKBIN
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 17-Jan-87 16:08 by bvm:")
|
||||
(PROG ((CO (fetch COFFSET of STREAM)))
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 13-Jun-2021 11:34 by rmk:")
|
||||
(PROG ((CO (fetch (STREAM COFFSET) of STREAM)))
|
||||
(SELECTQ (SYSTEMTYPE)
|
||||
(VAX (if (fetch FULLNAME of STREAM)
|
||||
then (* ; "Aha, it's a string stream")
|
||||
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
|
||||
(VAX (if (fetch (STREAM FULLNAME) of STREAM)
|
||||
then (* ; "Aha, it's a string stream")
|
||||
(RETURN (\STRINGPEEKBIN STREAM NOERRORFLG))))
|
||||
NIL)
|
||||
(RETURN (if (IGEQ CO (fetch EOFFSET of STREAM))
|
||||
(RETURN (if (IGEQ CO (fetch (STREAM EOFFSET) of STREAM))
|
||||
then (if (NOT NOERRORFLG)
|
||||
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
|
||||
else (\GETBASEBYTE (fetch CBUFPTR of STREAM)
|
||||
CO])
|
||||
then (STREAMOP 'ENDOFSTREAMOP STREAM STREAM))
|
||||
else (\GETBASEBYTE (fetch (STREAM CBUFPTR) of STREAM)
|
||||
CO])
|
||||
|
||||
(\BASEBYTES.TRUNCATEFN
|
||||
[LAMBDA (STREAM I) (* JonL " 7-NOV-83 22:20")
|
||||
@@ -694,19 +701,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(T (\FILE.NOT.OPEN X NOERROR])
|
||||
|
||||
(\SEARCHOPENFILES
|
||||
[LAMBDA (NAME ACCESS) (* rmk%: "14-OCT-83 15:04")
|
||||
|
||||
(* ;; "Returns a stream whose fullname is NAME if it has accessmode ACCESS")
|
||||
[LAMBDA (NAME ACCESS) (* ; "Edited 13-Jun-2021 11:35 by rmk:")
|
||||
|
||||
(for STREAM in \OPENFILES when (EQ NAME (fetch FULLNAME of STREAM))
|
||||
(* ;; "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])
|
||||
(ACCESS (\IOMODEP STREAM ACCESS T))
|
||||
(T STREAM])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \INSTREAMARG MACRO ((STRM NOERRORFLG)
|
||||
(\GETSTREAM STRM 'INPUT NOERRORFLG)))
|
||||
@@ -715,9 +720,9 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
(\GETSTREAM STRM 'OUTPUT NOERRORFLG)))
|
||||
|
||||
(PUTPROPS \STREAMARG MACRO [OPENLAMBDA (STRM NOERRORFLG)
|
||||
(COND
|
||||
(NOERRORFLG (\GETSTREAM STRM NIL T))
|
||||
(T (\DTEST STRM 'STREAM])
|
||||
(COND
|
||||
(NOERRORFLG (\GETSTREAM STRM NIL T))
|
||||
(T (\DTEST STRM 'STREAM])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -741,18 +746,18 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Co
|
||||
|
||||
(ADDTOVAR LAMA WHENCLOSE)
|
||||
)
|
||||
(PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990))
|
||||
(PUTPROPS AOFD COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2304 3411 (\ADD-OPEN-STREAM 2314 . 2591) (\GENERIC-UNREGISTER-STREAM 2593 . 3409)) (
|
||||
3452 10531 (CLOSEALL 3462 . 4167) (CLOSEF 4169 . 5353) (EOFCLOSEF 5355 . 5651) (INPUT 5653 . 6407) (
|
||||
OPENP 6409 . 6808) (OUTPUT 6810 . 7566) (POSITION 7568 . 8380) (RANDACCESSP 8382 . 8727) (\IOMODEP
|
||||
8729 . 9366) (WHENCLOSE 9368 . 10529)) (10532 10654 (STREAMADDPROP 10542 . 10652)) (11820 23932 (
|
||||
\BASEBYTES.IO.INIT 11830 . 15026) (\MAKEBASEBYTESTREAM 15028 . 17621) (\MBS.OUTCHARFN 17623 . 18011) (
|
||||
\BASEBYTES.NAME.FROM.STREAM 18013 . 18476) (\BASEBYTES.BOUT 18478 . 19195) (\BASEBYTES.SETFILEPTR
|
||||
19197 . 19818) (\BASEBYTES.READP 19820 . 20456) (\BASEBYTES.BIN 20458 . 20989) (\BASEBYTES.PEEKBIN
|
||||
20991 . 21772) (\BASEBYTES.TRUNCATEFN 21774 . 22278) (\BASEBYTES.OPENFN 22280 . 22770) (
|
||||
\BASEBYTES.BLOCKIO 22772 . 23930)) (24055 26305 (OPENSTRINGSTREAM 24065 . 26303)) (26362 29998 (
|
||||
\STRINGSTREAM.INIT 26372 . 29996)) (30060 33611 (GETSTREAM 30070 . 30293) (\ADDOFD 30295 . 30582) (
|
||||
\CLEAROFD 30584 . 30865) (\DELETEOFD 30867 . 31018) (\GETSTREAM 31020 . 33184) (\SEARCHOPENFILES 33186
|
||||
. 33609)))))
|
||||
(FILEMAP (NIL (2373 3480 (\ADD-OPEN-STREAM 2383 . 2660) (\GENERIC-UNREGISTER-STREAM 2662 . 3478)) (
|
||||
3521 10778 (CLOSEALL 3531 . 4236) (CLOSEF 4238 . 5434) (EOFCLOSEF 5436 . 5732) (INPUT 5734 . 6506) (
|
||||
OPENP 6508 . 6907) (OUTPUT 6909 . 7683) (POSITION 7685 . 8497) (RANDACCESSP 8499 . 8974) (\IOMODEP
|
||||
8976 . 9613) (WHENCLOSE 9615 . 10776)) (10779 10901 (STREAMADDPROP 10789 . 10899)) (12065 24946 (
|
||||
\BASEBYTES.IO.INIT 12075 . 15271) (\MAKEBASEBYTESTREAM 15273 . 18585) (\MBS.OUTCHARFN 18587 . 18975) (
|
||||
\BASEBYTES.NAME.FROM.STREAM 18977 . 19440) (\BASEBYTES.BOUT 19442 . 20159) (\BASEBYTES.SETFILEPTR
|
||||
20161 . 20782) (\BASEBYTES.READP 20784 . 21420) (\BASEBYTES.BIN 21422 . 21953) (\BASEBYTES.PEEKBIN
|
||||
21955 . 22786) (\BASEBYTES.TRUNCATEFN 22788 . 23292) (\BASEBYTES.OPENFN 23294 . 23784) (
|
||||
\BASEBYTES.BLOCKIO 23786 . 24944)) (25069 27319 (OPENSTRINGSTREAM 25079 . 27317)) (27376 31012 (
|
||||
\STRINGSTREAM.INIT 27386 . 31010)) (31074 34646 (GETSTREAM 31084 . 31307) (\ADDOFD 31309 . 31596) (
|
||||
\CLEAROFD 31598 . 31879) (\DELETEOFD 31881 . 32032) (\GETSTREAM 32034 . 34198) (\SEARCHOPENFILES 34200
|
||||
. 34644)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
780
sources/APRINT
780
sources/APRINT
File diff suppressed because it is too large
Load Diff
Binary file not shown.
181
sources/ATBL
181
sources/ATBL
@@ -1,28 +1,29 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "12-Feb-2021 22:55:58" {DSK}<home>larry>ilisp>medley>sources>ATBL.;9 257317Q
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 15:28:19" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;11 260310Q
|
||||
|
||||
changes to%: (FNS RESETREADTABLE)
|
||||
changes to%: (FNS SET-READER-ENVIRONMENT)
|
||||
|
||||
previous date%: "20-Apr-2018 17:35:56" {DSK}<home>larry>ilisp>medley>sources>ATBL.;8)
|
||||
previous date%: "28-Jun-2021 09:37:15"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATBL.;10)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT ATBLCOMS)
|
||||
|
||||
(RPAQQ ATBLCOMS
|
||||
[(E (RESETSAVE (RADIX 8)))
|
||||
(COMS (* ;
|
||||
"Common features of read and terminal tables")
|
||||
(COMS (* ;
|
||||
"Common features of read and terminal tables")
|
||||
(DECLARE%: DONTCOPY (EXPORT (MACROS \SYNCODE \SETSYNCODE)
|
||||
(RECORDS CHARTABLE))
|
||||
(CONSTANTS \NSCHARHASHKEYS \NSCHARHASHOVERFLOW)
|
||||
(MACROS \CREATENSCHARHASH))
|
||||
(FNS GETSYNTAX SETSYNTAX SYNTAXP \COPYSYNTAX \GETCHARCODE \SETFATSYNCODE \MAPCHARTABLE)
|
||||
)
|
||||
(COMS (* ; "terminal tables")
|
||||
(COMS (* ; "terminal tables")
|
||||
(FNS CONTROL COPYTERMTABLE DELETECONTROL GETDELETECONTROL ECHOCHAR ECHOCONTROL ECHOMODE
|
||||
GETECHOMODE GETCONTROL GETTERMTABLE RAISE GETRAISE RESETTERMTABLE SETTERMTABLE
|
||||
TERMTABLEP \GETTERMSYNTAX \GTTERMTABLE \ORIGTERMTABLE \SETTERMSYNTAX
|
||||
@@ -31,16 +32,16 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(CONSTANTS * TERMCLASSES)
|
||||
(RECORDS TERMCODE TERMTABLEP)))
|
||||
(INITRECORDS TERMTABLEP))
|
||||
(COMS (* ; "read tables")
|
||||
(COMS (* ; "read tables")
|
||||
(FNS COPYREADTABLE FIND-READTABLE IN-READTABLE ESCAPE GETBRK GETREADTABLE GETSEPR
|
||||
READMACROS READTABLEP READTABLEPROP RESETREADTABLE SETBRK SETREADTABLE SETSEPR
|
||||
\GETREADSYNTAX \GTREADTABLE \GTREADTABLE1 \ORIGREADTABLE \READCLASSTOCODE
|
||||
\SETMACROSYNTAX \SETREADSYNTAX \READTABLEP.DEFPRINT)
|
||||
(PROP ARGNAMES READTABLEPROP)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (* ;
|
||||
"READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's")
|
||||
(* ;
|
||||
"OTHER must be zero because of initialization.")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (* ;
|
||||
"READCLASSTOKENS Generates READCLASSES and some interesting SELECTQ's")
|
||||
(* ;
|
||||
"OTHER must be zero because of initialization.")
|
||||
[VARS READCLASSTOKENS (READCLASSES (MAPCAR READCLASSTOKENS
|
||||
(FUNCTION (LAMBDA
|
||||
(PAIR)
|
||||
@@ -48,8 +49,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
".RC")
|
||||
(CADR PAIR]
|
||||
(MACROS \COMPUTED.FORM)
|
||||
(* ;
|
||||
"This macro ought to be official somehow")
|
||||
(* ;
|
||||
"This macro ought to be official somehow")
|
||||
(RECORDS CONTEXTS ESCAPES WAKEUPS)
|
||||
(EXPORT (MACROS \GETREADMACRODEF \GTREADTABLE \GTREADTABLE1)
|
||||
(CONSTANTS MACROBIT BREAKBIT STOPATOMBIT ESCAPEBIT INNERESCAPEBIT)
|
||||
@@ -64,8 +65,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
[COMS (INITVARS (\READTABLEHASH))
|
||||
(FNS \ATBLSET)
|
||||
(INITRECORDS READER-ENVIRONMENT)
|
||||
(* ;
|
||||
"Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*")
|
||||
(* ;
|
||||
"Definition is on CMLREAD, need it here to initialize *OLD-INTERLISP-READ-ENVIRONMENT*")
|
||||
(FNS MAKE-READER-ENVIRONMENT EQUAL-READER-ENVIRONMENT SET-READER-ENVIRONMENT)
|
||||
(INITVARS (*LISP-PACKAGE*)
|
||||
(*INTERLISP-PACKAGE*)
|
||||
@@ -85,8 +86,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
|
||||
(PUTPROPS \SYNCODE DMACRO [OPENLAMBDA (TABLE CHAR)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(* ;
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(* ;
|
||||
"0 is either NONE.TC, REAL.CCE, or OTHER.RC")
|
||||
(COND
|
||||
((IGREATERP CHAR \MAXTHINCHAR)
|
||||
(OR (AND (fetch (CHARTABLE NSCHARHASH) of TABLE)
|
||||
@@ -97,8 +98,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
|
||||
(PUTPROPS \SETSYNCODE DMACRO [LAMBDA (TABLE CHAR CODE)
|
||||
(CHECK (type? CHARTABLE TABLE))
|
||||
(* ;
|
||||
"0 is REAL.CCE, NONE.TC, OTHER.RC")
|
||||
(* ;
|
||||
"0 is REAL.CCE, NONE.TC, OTHER.RC")
|
||||
(COND
|
||||
((ILEQ CHAR \MAXTHINCHAR)
|
||||
(\PUTBASEBYTE TABLE CHAR CODE))
|
||||
@@ -401,8 +402,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* ;
|
||||
"added size argument for creation of \ORIGTERMTABLE during initialization.")
|
||||
(PUTPROPS \CREATENSCHARHASH MACRO (ARGS (* ;
|
||||
"added size argument for creation of \ORIGTERMTABLE during initialization.")
|
||||
(LIST 'HASHARRAY (OR (CAR ARGS)
|
||||
'\NSCHARHASHKEYS)
|
||||
'\NSCHARHASHOVERFLOW)))
|
||||
@@ -928,8 +929,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS TERMCODE ((CCECHO (LOGAND DATUM 30Q))
|
||||
(TERMCLASS (LOGAND DATUM 7))) (* ;
|
||||
"We assume that values are appropriately shifted")
|
||||
(TERMCLASS (LOGAND DATUM 7))) (* ;
|
||||
"We assume that values are appropriately shifted")
|
||||
(CREATE (LOGOR CCECHO TERMCLASS)))
|
||||
|
||||
(DATATYPE TERMTABLEP (TERMSA RAISEFLG DELCHARECHO LINEDELETE 1STCHDEL NTHCHDEL POSTCHDEL
|
||||
@@ -1617,34 +1618,34 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
|
||||
(RECORD READMACRODEF (MACROTYPE . MACROFN))
|
||||
|
||||
(DATATYPE READTABLEP ((READSA POINTER) (* ;
|
||||
"A CHARTABLE defining syntax of each char")
|
||||
(READMACRODEFS POINTER) (* ;
|
||||
"A hash table associating macro chars with macro definitions")
|
||||
(READMACROFLG FLAG) (* ;
|
||||
"True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)")
|
||||
(ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)")
|
||||
(COMMONLISP FLAG) (* ;
|
||||
"True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules")
|
||||
(NUMBERBASE BITS 5) (* ; "Not used")
|
||||
(CASEINSENSITIVE FLAG) (* ;
|
||||
"If true, unescaped lowercase chars are converted to uppercase in symbols")
|
||||
(COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers")
|
||||
(USESILPACKAGE FLAG) (* ;
|
||||
"If true, IL:READ ignores *PACKAGE* and reads in the IL package")
|
||||
(DATATYPE READTABLEP ((READSA POINTER) (* ;
|
||||
"A CHARTABLE defining syntax of each char")
|
||||
(READMACRODEFS POINTER) (* ;
|
||||
"A hash table associating macro chars with macro definitions")
|
||||
(READMACROFLG FLAG) (* ;
|
||||
"True if read macros are enabled (turned off by Interlisp's crufty READMACROS function)")
|
||||
(ESCAPEFLG FLAG) (* ; "True if the char(s) with escape syntax are enabled (turned off by Interlisp's crufty ESCAPE function)")
|
||||
(COMMONLISP FLAG) (* ;
|
||||
"True if table is a Common Lisp read table and hence must obey Common Lisp syntax rules")
|
||||
(NUMBERBASE BITS 5) (* ; "Not used")
|
||||
(CASEINSENSITIVE FLAG) (* ;
|
||||
"If true, unescaped lowercase chars are converted to uppercase in symbols")
|
||||
(COMMONNUMSYNTAX FLAG) (* ; "True if number notation includes Common Lisp numbers: rationals as a/b, and the dfls exponent markers")
|
||||
(USESILPACKAGE FLAG) (* ;
|
||||
"If true, IL:READ ignores *PACKAGE* and reads in the IL package")
|
||||
(NIL 5 FLAG)
|
||||
(DISPATCHMACRODEFS POINTER) (* ;
|
||||
"An a-list of dispatching macro char and its dispatch definitions")
|
||||
(HASHMACROCHAR BYTE) (* ;
|
||||
"The character code used in this read table for the # dispatch macro")
|
||||
(ESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for single escape")
|
||||
(MULTESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for multiple escape")
|
||||
(PACKAGECHAR BYTE) (* ;
|
||||
"The character code used in this read table for package delimiter")
|
||||
(READTBLNAME POINTER) (* ;
|
||||
"The canonical 'name' of this read table")
|
||||
(DISPATCHMACRODEFS POINTER) (* ;
|
||||
"An a-list of dispatching macro char and its dispatch definitions")
|
||||
(HASHMACROCHAR BYTE) (* ;
|
||||
"The character code used in this read table for the # dispatch macro")
|
||||
(ESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for single escape")
|
||||
(MULTESCAPECHAR BYTE) (* ;
|
||||
"The character code used in this read table for multiple escape")
|
||||
(PACKAGECHAR BYTE) (* ;
|
||||
"The character code used in this read table for package delimiter")
|
||||
(READTBLNAME POINTER) (* ;
|
||||
"The canonical 'name' of this read table")
|
||||
)
|
||||
READSA _ (create CHARTABLE))
|
||||
)
|
||||
@@ -1712,7 +1713,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(DEFINEQ
|
||||
|
||||
(\ATBLSET
|
||||
[LAMBDA NIL (* ; "Edited 20-Apr-2018 17:34 by rmk:")
|
||||
[LAMBDA NIL (* ; "Edited 28-Jun-2021 09:29 by rmk:")
|
||||
(* ; "Edited 3-Dec-86 18:07 by Pavel")
|
||||
(DECLARE (GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE))
|
||||
(COND
|
||||
@@ -1753,10 +1754,11 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(SETSYNTAX (CHARCODE "|")
|
||||
TRDTBL FILERDTBL)
|
||||
(READTABLEPROP FILERDTBL 'NAME "OLD-INTERLISP-FILE")
|
||||
(SETQ *OLD-INTERLISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT
|
||||
REREADTABLE _ FILERDTBL
|
||||
REBASE _ 12Q))
|
||||
(* ;
|
||||
(SETQ *OLD-INTERLISP-READ-ENVIRONMENT*
|
||||
(create READER-ENVIRONMENT
|
||||
REREADTABLE _ FILERDTBL
|
||||
REBASE _ 12Q
|
||||
REFORMAT _ :XCCS)) (* ;
|
||||
"need this to read files in the loadup")
|
||||
)
|
||||
(PROGN (SETQ NEW-IL-RDTBL (COPYREADTABLE TRDTBL))
|
||||
@@ -1793,12 +1795,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
NIL])
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER)
|
||||
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER)
|
||||
'((READER-ENVIRONMENT 0 POINTER)
|
||||
(READER-ENVIRONMENT 2 POINTER)
|
||||
(READER-ENVIRONMENT 4 POINTER)
|
||||
(READER-ENVIRONMENT 6 POINTER))
|
||||
'10Q)
|
||||
(READER-ENVIRONMENT 6 POINTER)
|
||||
(READER-ENVIRONMENT 10Q POINTER))
|
||||
'12Q)
|
||||
|
||||
|
||||
|
||||
@@ -1807,7 +1810,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-READER-ENVIRONMENT
|
||||
[LAMBDA (PACKAGE READTABLE BASE) (* ; "Edited 18-Dec-86 18:28 by bvm:")
|
||||
[LAMBDA (PACKAGE READTABLE BASE FORMAT) (* ; "Edited 28-Jun-2021 09:32 by rmk:")
|
||||
(create READER-ENVIRONMENT
|
||||
REPACKAGE _ (COND
|
||||
(PACKAGE (\DTEST PACKAGE 'PACKAGE))
|
||||
@@ -1817,25 +1820,33 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(T *READTABLE*))
|
||||
REBASE _ (COND
|
||||
(BASE (\CHECKRADIX BASE))
|
||||
(T *PRINT-BASE*])
|
||||
(T *PRINT-BASE*))
|
||||
REFORMAT _ (OR FORMAT *DEFAULT-EXTERNALFORMAT*])
|
||||
|
||||
(EQUAL-READER-ENVIRONMENT
|
||||
[LAMBDA (ENV1 ENV2) (* bvm%: "31-Jul-86 12:54")
|
||||
[LAMBDA (ENV1 ENV2) (* ; "Edited 28-Jun-2021 09:37 by rmk:")
|
||||
(* ; ":XCCS is the prehistoric value")
|
||||
(AND (EQ (fetch (READER-ENVIRONMENT REREADTABLE) of ENV1)
|
||||
(fetch (READER-ENVIRONMENT REREADTABLE) of ENV2))
|
||||
(EQ (fetch (READER-ENVIRONMENT REPACKAGE) of ENV1)
|
||||
(fetch (READER-ENVIRONMENT REPACKAGE) of ENV2))
|
||||
(EQ (fetch (READER-ENVIRONMENT REBASE) of ENV1)
|
||||
(fetch (READER-ENVIRONMENT REBASE) of ENV2])
|
||||
(fetch (READER-ENVIRONMENT REBASE) of ENV2))
|
||||
(EQ (OR (fetch (READER-ENVIRONMENT REFORMAT) of ENV1)
|
||||
:XCCS)
|
||||
(OR (fetch (READER-ENVIRONMENT REFORMAT) of ENV2)
|
||||
:XCCS])
|
||||
|
||||
(SET-READER-ENVIRONMENT
|
||||
[LAMBDA (ENV) (* bvm%: "28-Aug-86 17:44")
|
||||
[LAMBDA (ENV STREAM) (* ; "Edited 9-Jul-2021 14:42 by rmk:")
|
||||
|
||||
(* ;;; "Sets the reader environment variables from ENV. Should usually only be called inside a WITH-READER-ENVIRONMENT.")
|
||||
|
||||
[SETQ *PACKAGE* (ffetch REPACKAGE of (\DTEST ENV 'READER-ENVIRONMENT]
|
||||
(SETQ *READTABLE* (ffetch REREADTABLE of ENV))
|
||||
(SETQ *READ-BASE* (SETQ *PRINT-BASE* (ffetch REBASE of ENV)))
|
||||
(CL:WHEN STREAM
|
||||
(\EXTERNALFORMAT STREAM (ffetch (READER-ENVIRONMENT REFORMAT) OF ENV)))
|
||||
ENV])
|
||||
)
|
||||
|
||||
@@ -1863,24 +1874,24 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2018, 2021 by Venu
|
||||
(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q 3711Q
|
||||
3742Q 3745Q))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (44114Q 67345Q (GETSYNTAX 44126Q . 55055Q) (SETSYNTAX 55057Q . 57144Q) (SYNTAXP 57146Q
|
||||
. 62552Q) (\COPYSYNTAX 62554Q . 63637Q) (\GETCHARCODE 63641Q . 64305Q) (\SETFATSYNCODE 64307Q .
|
||||
66462Q) (\MAPCHARTABLE 66464Q . 67343Q)) (67406Q 124174Q (CONTROL 67420Q . 70020Q) (COPYTERMTABLE
|
||||
70022Q . 70464Q) (DELETECONTROL 70466Q . 75306Q) (GETDELETECONTROL 75310Q . 77216Q) (ECHOCHAR 77220Q
|
||||
. 102116Q) (ECHOCONTROL 102120Q . 103040Q) (ECHOMODE 103042Q . 103434Q) (GETECHOMODE 103436Q .
|
||||
103706Q) (GETCONTROL 103710Q . 104162Q) (GETTERMTABLE 104164Q . 104267Q) (RAISE 104271Q . 105113Q) (
|
||||
GETRAISE 105115Q . 105363Q) (RESETTERMTABLE 105365Q . 107465Q) (SETTERMTABLE 107467Q . 110156Q) (
|
||||
TERMTABLEP 110160Q . 110425Q) (\GETTERMSYNTAX 110427Q . 111036Q) (\GTTERMTABLE 111040Q . 111564Q) (
|
||||
\ORIGTERMTABLE 111566Q . 120427Q) (\SETTERMSYNTAX 120431Q . 121630Q) (\TERMCLASSTOCODE 121632Q .
|
||||
122513Q) (\TERMCODETOCLASS 122515Q . 123324Q) (\LITCHECK 123326Q . 124172Q)) (131165Q 210145Q (
|
||||
COPYREADTABLE 131177Q . 131511Q) (FIND-READTABLE 131513Q . 131742Q) (IN-READTABLE 131744Q . 132210Q) (
|
||||
ESCAPE 132212Q . 132613Q) (GETBRK 132615Q . 133033Q) (GETREADTABLE 133035Q . 133246Q) (GETSEPR 133250Q
|
||||
. 133466Q) (READMACROS 133470Q . 134103Q) (READTABLEP 134105Q . 134354Q) (READTABLEPROP 134356Q .
|
||||
146554Q) (RESETREADTABLE 146556Q . 157076Q) (SETBRK 157100Q . 162204Q) (SETREADTABLE 162206Q . 162473Q
|
||||
) (SETSEPR 162475Q . 165475Q) (\GETREADSYNTAX 165477Q . 172657Q) (\GTREADTABLE 172661Q . 173226Q) (
|
||||
\GTREADTABLE1 173230Q . 173634Q) (\ORIGREADTABLE 173636Q . 177455Q) (\READCLASSTOCODE 177457Q .
|
||||
200366Q) (\SETMACROSYNTAX 200370Q . 204004Q) (\SETREADSYNTAX 204006Q . 206071Q) (\READTABLEP.DEFPRINT
|
||||
206073Q . 210143Q)) (241661Q 252517Q (\ATBLSET 241673Q . 252515Q)) (253256Q 256351Q (
|
||||
MAKE-READER-ENVIRONMENT 253270Q . 254356Q) (EQUAL-READER-ENVIRONMENT 254360Q . 255407Q) (
|
||||
SET-READER-ENVIRONMENT 255411Q . 256347Q)))))
|
||||
(FILEMAP (NIL (44154Q 67405Q (GETSYNTAX 44166Q . 55115Q) (SETSYNTAX 55117Q . 57204Q) (SYNTAXP 57206Q
|
||||
. 62612Q) (\COPYSYNTAX 62614Q . 63677Q) (\GETCHARCODE 63701Q . 64345Q) (\SETFATSYNCODE 64347Q .
|
||||
66522Q) (\MAPCHARTABLE 66524Q . 67403Q)) (67446Q 124234Q (CONTROL 67460Q . 70060Q) (COPYTERMTABLE
|
||||
70062Q . 70524Q) (DELETECONTROL 70526Q . 75346Q) (GETDELETECONTROL 75350Q . 77256Q) (ECHOCHAR 77260Q
|
||||
. 102156Q) (ECHOCONTROL 102160Q . 103100Q) (ECHOMODE 103102Q . 103474Q) (GETECHOMODE 103476Q .
|
||||
103746Q) (GETCONTROL 103750Q . 104222Q) (GETTERMTABLE 104224Q . 104327Q) (RAISE 104331Q . 105153Q) (
|
||||
GETRAISE 105155Q . 105423Q) (RESETTERMTABLE 105425Q . 107525Q) (SETTERMTABLE 107527Q . 110216Q) (
|
||||
TERMTABLEP 110220Q . 110465Q) (\GETTERMSYNTAX 110467Q . 111076Q) (\GTTERMTABLE 111100Q . 111624Q) (
|
||||
\ORIGTERMTABLE 111626Q . 120467Q) (\SETTERMSYNTAX 120471Q . 121670Q) (\TERMCLASSTOCODE 121672Q .
|
||||
122553Q) (\TERMCODETOCLASS 122555Q . 123364Q) (\LITCHECK 123366Q . 124232Q)) (131225Q 210205Q (
|
||||
COPYREADTABLE 131237Q . 131551Q) (FIND-READTABLE 131553Q . 132002Q) (IN-READTABLE 132004Q . 132250Q) (
|
||||
ESCAPE 132252Q . 132653Q) (GETBRK 132655Q . 133073Q) (GETREADTABLE 133075Q . 133306Q) (GETSEPR 133310Q
|
||||
. 133526Q) (READMACROS 133530Q . 134143Q) (READTABLEP 134145Q . 134414Q) (READTABLEPROP 134416Q .
|
||||
146614Q) (RESETREADTABLE 146616Q . 157136Q) (SETBRK 157140Q . 162244Q) (SETREADTABLE 162246Q . 162533Q
|
||||
) (SETSEPR 162535Q . 165535Q) (\GETREADSYNTAX 165537Q . 172717Q) (\GTREADTABLE 172721Q . 173266Q) (
|
||||
\GTREADTABLE1 173270Q . 173674Q) (\ORIGREADTABLE 173676Q . 177515Q) (\READCLASSTOCODE 177517Q .
|
||||
200426Q) (\SETMACROSYNTAX 200430Q . 204044Q) (\SETREADSYNTAX 204046Q . 206131Q) (\READTABLEP.DEFPRINT
|
||||
206133Q . 210203Q)) (241721Q 252472Q (\ATBLSET 241733Q . 252470Q)) (253313Q 257342Q (
|
||||
MAKE-READER-ENVIRONMENT 253325Q . 254504Q) (EQUAL-READER-ENVIRONMENT 254506Q . 256214Q) (
|
||||
SET-READER-ENVIRONMENT 256216Q . 257340Q)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "29-Apr-2021 09:38:58" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;4 56766
|
||||
(FILECREATED "23-Jun-2021 12:31:16" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;2 57229
|
||||
|
||||
changes to%: (FNS \CREATELINEBUFFER)
|
||||
changes to%: (FNS \CHDEL1)
|
||||
|
||||
previous date%: "16-May-90 12:08:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;3)
|
||||
previous date%: "10-May-2021 15:07:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ATERM.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -181,10 +181,10 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
(SETQ TtyDisplayStream (SETQ \TERM.OFD STREAM])])
|
||||
|
||||
(\CHDEL1
|
||||
[LAMBDA NIL (* rmk%: "28-Mar-85 18:25")
|
||||
[LAMBDA NIL (* ; "Edited 23-Jun-2021 12:29 by rmk:")
|
||||
(COND
|
||||
((\BACKNSCHAR \LINEBUF.OFD (UNFOLD \NORUNCODE 256))
|
||||
(PROG1 (\NSPEEK \LINEBUF.OFD (UNFOLD \NORUNCODE 256))
|
||||
((\BACKCCODE \LINEBUF.OFD)
|
||||
(PROG1 (\PEEKCCODE \LINEBUF.OFD)
|
||||
(\SETEOFPTR \LINEBUF.OFD (GETFILEPTR \LINEBUF.OFD)))])
|
||||
|
||||
(\CLOSELINE
|
||||
@@ -243,7 +243,7 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
T])
|
||||
|
||||
(\FILLBUFFER
|
||||
[LAMBDA (FILLTYPE) (* ; "Edited 20-Aug-87 17:52 by jds")
|
||||
[LAMBDA (FILLTYPE) (* ; "Edited 5-May-2021 20:45 by rmk:")
|
||||
|
||||
(* ;; "While filling the line, the current file pointer is the end of the line. When the line is closed, this is made the eof. *READTABLE* is used for syntactic delimiters and paren counting on READ and RATOM calls but isn't referenced (or bound) for READC")
|
||||
|
||||
@@ -300,8 +300,10 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
(\SETFILEPTR \LINEBUF.OFD 0)
|
||||
(replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with
|
||||
RETYPING.LBS))
|
||||
[until (\PAGEDEOFP \LINEBUF.OFD)
|
||||
do (\OUTCHAR \TERM.OFD (\NSIN \LINEBUF.OFD (UNFOLD \NORUNCODE 256]
|
||||
(until (\PAGEDEOFP \LINEBUF.OFD) do (\OUTCHAR \TERM.OFD (\INCHAR
|
||||
|
||||
\LINEBUF.OFD
|
||||
)))
|
||||
(replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with
|
||||
FILLING.LBS
|
||||
)
|
||||
@@ -424,13 +426,14 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
(replace (LINEBUFFER LBRKCOUNT) of \LINEBUF.OFD with ILB)
|
||||
(replace (LINEBUFFER INSTRINGP) of \LINEBUF.OFD with ISP)
|
||||
(replace (LINEBUFFER LPARCOUNT) of \LINEBUF.OFD with ILP))
|
||||
[until (\PAGEDEOFP \LINEBUF.OFD)
|
||||
do (SETQ CHAR (\NSIN \LINEBUF.OFD (UNFOLD \NORUNCODE 256)))
|
||||
(COND
|
||||
[(EQ ESCAPE.RC (SETQ RSNX (\SYNCODE RTBLSA CHAR)))
|
||||
(OR (\PAGEDEOFP \LINEBUF.OFD)
|
||||
(\NSIN \LINEBUF.OFD (UNFOLD \NORUNCODE 256]
|
||||
(T (\INCPARENCOUNT RSNX]
|
||||
[until (\PAGEDEOFP \LINEBUF.OFD) do (SETQ CHAR (\INCHAR \LINEBUF.OFD))
|
||||
(COND
|
||||
((EQ ESCAPE.RC (SETQ RSNX
|
||||
(\SYNCODE RTBLSA
|
||||
CHAR)))
|
||||
(OR (\PAGEDEOFP \LINEBUF.OFD)
|
||||
(\INCHAR \LINEBUF.OFD)))
|
||||
(T (\INCPARENCOUNT RSNX]
|
||||
(replace (LINEBUFFER LINEBUFSTATE) of \LINEBUF.OFD with FILLING.LBS
|
||||
)))
|
||||
(GO NEXT)
|
||||
@@ -1136,18 +1139,18 @@ Copyright (c) 1982-1988, 1990, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS ATERM COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2982 31202 (BKLINBUF 2992 . 3467) (CLEARBUF 3469 . 4801) (LINBUF 4803 . 4989) (
|
||||
PAGEFULLFN 4991 . 6472) (SETLINELENGTH 6474 . 6670) (SYSBUF 6672 . 6858) (TERMCHARWIDTH 6860 . 7277) (
|
||||
TERMINAL-INPUT 7279 . 7847) (TERMINAL-OUTPUT 7849 . 8435) (\CHDEL1 8437 . 8740) (\CLOSELINE 8742 .
|
||||
9031) (\DECPARENCOUNT 9033 . 10616) (\ECHOCHAR 10618 . 11310) (\FILLBUFFER 11312 . 23532) (
|
||||
\FILLBUFFER.WORDSEPRP 23534 . 23779) (\FILLBUFFER.BACKUP 23781 . 23960) (\GETCHAR 23962 . 24351) (
|
||||
\INCPARENCOUNT 24353 . 26965) (\RESETLINE 26967 . 27291) (\RESETTERMINAL 27293 . 28057) (\SAVELINEBUF
|
||||
28059 . 30030) (\STOPSCROLL? 30032 . 31200)) (31413 35269 (\DSCCOUT 31423 . 34563) (\INITBCPLDISPLAY
|
||||
34565 . 35267)) (35462 36712 (VIDEOCOLOR 35472 . 36710)) (37544 43398 (\PEEKREFILL 37554 . 41665) (
|
||||
\READREFILL 41667 . 42261) (\RATOM/RSTRING-REFILL 42263 . 42841) (\READCREFILL 42843 . 43396)) (43399
|
||||
45228 (DRIBBLE 43409 . 45010) (DRIBBLEFILE 45012 . 45226)) (45229 51904 (\SETUP.DEFAULT.LINEBUF 45239
|
||||
. 47696) (\CREATELINEBUFFER 47698 . 50120) (\LINEBUF.READP 50122 . 50471) (\LINEBUF.EOFP 50473 .
|
||||
50812) (\LINEBUF.PEEKBIN 50814 . 51021) (\OPENLINEBUF 51023 . 51902)) (51979 53218 (LINEBUFFER-EOFP
|
||||
51989 . 52447) (LINEBUFFER-SKIPSEPRS 52449 . 53216)) (53575 53849 (\INTERMP 53585 . 53716) (\OUTTERMP
|
||||
53718 . 53847)))))
|
||||
(FILEMAP (NIL (2974 31665 (BKLINBUF 2984 . 3459) (CLEARBUF 3461 . 4793) (LINBUF 4795 . 4981) (
|
||||
PAGEFULLFN 4983 . 6464) (SETLINELENGTH 6466 . 6662) (SYSBUF 6664 . 6850) (TERMCHARWIDTH 6852 . 7269) (
|
||||
TERMINAL-INPUT 7271 . 7839) (TERMINAL-OUTPUT 7841 . 8427) (\CHDEL1 8429 . 8698) (\CLOSELINE 8700 .
|
||||
8989) (\DECPARENCOUNT 8991 . 10574) (\ECHOCHAR 10576 . 11268) (\FILLBUFFER 11270 . 23995) (
|
||||
\FILLBUFFER.WORDSEPRP 23997 . 24242) (\FILLBUFFER.BACKUP 24244 . 24423) (\GETCHAR 24425 . 24814) (
|
||||
\INCPARENCOUNT 24816 . 27428) (\RESETLINE 27430 . 27754) (\RESETTERMINAL 27756 . 28520) (\SAVELINEBUF
|
||||
28522 . 30493) (\STOPSCROLL? 30495 . 31663)) (31876 35732 (\DSCCOUT 31886 . 35026) (\INITBCPLDISPLAY
|
||||
35028 . 35730)) (35925 37175 (VIDEOCOLOR 35935 . 37173)) (38007 43861 (\PEEKREFILL 38017 . 42128) (
|
||||
\READREFILL 42130 . 42724) (\RATOM/RSTRING-REFILL 42726 . 43304) (\READCREFILL 43306 . 43859)) (43862
|
||||
45691 (DRIBBLE 43872 . 45473) (DRIBBLEFILE 45475 . 45689)) (45692 52367 (\SETUP.DEFAULT.LINEBUF 45702
|
||||
. 48159) (\CREATELINEBUFFER 48161 . 50583) (\LINEBUF.READP 50585 . 50934) (\LINEBUF.EOFP 50936 .
|
||||
51275) (\LINEBUF.PEEKBIN 51277 . 51484) (\OPENLINEBUF 51486 . 52365)) (52442 53681 (LINEBUFFER-EOFP
|
||||
52452 . 52910) (LINEBUFFER-SKIPSEPRS 52912 . 53679)) (54038 54312 (\INTERMP 54048 . 54179) (\OUTTERMP
|
||||
54181 . 54310)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,23 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 2-Nov-92 04:15:40" "{Pele:mv:envos}<LispCore>Sources>BOOTSTRAP.;4" 40191
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 15:32:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;20 40815
|
||||
|
||||
changes to%: (FNS MOVD)
|
||||
changes to%: (FNS \LOAD-STREAM \DO-DEFINE-FILE-INFO)
|
||||
|
||||
previous date%: "22-May-92 12:00:44" "{Pele:mv:envos}<LispCore>Sources>BOOTSTRAP.;3")
|
||||
previous date%: " 9-Jul-2021 14:02:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;18)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT BOOTSTRAPCOMS)
|
||||
|
||||
(RPAQQ BOOTSTRAPCOMS
|
||||
[(COMS (* ; "Some basic fns. Note that several are redefined later. E.g., RPAQQ et al real definitions are on UNDO")
|
||||
[(COMS (* ; "Some basic fns. Note that several are redefined later. E.g., RPAQQ et al real definitions are on UNDO")
|
||||
(FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? SELECTQ SELECTQ1 NCONC1 PUTPROP
|
||||
PROPNAMES ADDPROP REMPROP MEMB CLOSEF?))
|
||||
(COMS (* ;
|
||||
"Need these in order to load even compiled files SYSLOAD")
|
||||
(COMS (* ;
|
||||
"Need these in order to load even compiled files SYSLOAD")
|
||||
(FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD
|
||||
PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME DEFINE-FILE-INFO \DO-DEFINE-FILE-INFO))
|
||||
(INITVARS (EOLCHARCODE (CHCON1 "
|
||||
@@ -70,7 +72,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
(AND (CCODEP 'BOOTSTRAP-NAMEFIELD)
|
||||
(PUTD 'BOOTSTRAP-NAMEFIELD]
|
||||
(P (RADIX 10)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (* ; "eventually imported from FASL")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (* ; "eventually imported from FASL")
|
||||
(CONSTANTS FASL:SIGNATURE))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA DEFINE-FILE-INFO DECLARE%: PUTPROPS FILECREATED SELECTQ)
|
||||
@@ -362,16 +364,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
|
||||
(\LOAD-STREAM
|
||||
[LAMBDA (STREAM LDFLG PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)
|
||||
(DECLARE (SPECVARS LDFLG PRINTFLG LOAD-VERBOSE-STREAM))
|
||||
(* ; "Edited 29-Jan-88 19:02 by jop")
|
||||
(DECLARE (SPECVARS LDFLG PRINTFLG LOAD-VERBOSE-STREAM))
|
||||
(* ; "Edited 9-Jul-2021 15:30 by rmk:")
|
||||
|
||||
(* ;;; "Internal function that loads from an already open stream. LOAD-VERBOSE-STREAM if non-nil is the stream to which to print %"file created%" messages and such. Similarly, PRINTFLG, if non-nil, is the stream to which to print the value of each expression.")
|
||||
(* ;;; "Internal function that loads from an already open stream. LOAD-VERBOSE-STREAM if non-nil is the stream to which to print %"file created%" messages and such. Similarly, PRINTFLG, if non-nil, is the stream to which to print the value of each expression.")
|
||||
|
||||
(PROG ((*STANDARD-INPUT* STREAM)
|
||||
(FILE (FULLNAME STREAM))
|
||||
(*PACKAGE* *PACKAGE*)
|
||||
(*READTABLE* (PROG1 FILERDTBL (* ; "This initial value important for SKIPSEPRCODES below, but *READTABLE* gets reset appropriately before anything else is read")
|
||||
))
|
||||
(*READTABLE* (PROG1 FILERDTBL (* ; "This initial value important for SKIPSEPRCODES below, but *READTABLE* gets reset appropriately before anything else is read")
|
||||
))
|
||||
(DFNFLG DFNFLG)
|
||||
(BUILDMAPFLG BUILDMAPFLG)
|
||||
(FILEPKGFLG FILEPKGFLG)
|
||||
@@ -386,13 +388,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
(if (AND LOAD-VERBOSE-STREAM FILE)
|
||||
then (LISPXTERPRI LOAD-VERBOSE-STREAM)
|
||||
(if (NEQ LOAD-VERBOSE-STREAM T)
|
||||
then (* ;
|
||||
"CL:LOAD says to prefix this stuff with comment marker")
|
||||
|
||||
then (* ;
|
||||
"CL:LOAD says to prefix this stuff with comment marker")
|
||||
(PRIN1 "; Loading " LOAD-VERBOSE-STREAM))
|
||||
(* ;
|
||||
"Might use EXEC-FORMAT here except that it isn't defined early in loadup")
|
||||
|
||||
(* ;
|
||||
"Might use EXEC-FORMAT here except that it isn't defined early in loadup")
|
||||
(LISPXPRIN1 FILE LOAD-VERBOSE-STREAM)
|
||||
(LISPXTERPRI LOAD-VERBOSE-STREAM))
|
||||
(if (EQ (SETQ DFNFLG LDFLG)
|
||||
@@ -403,9 +403,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
(SETQ FILEPKGFLG NIL)
|
||||
(SETQ LISPXHIST NIL))
|
||||
(if LISPXHIST
|
||||
then (* ;
|
||||
"Want UNDOSAVE to keep saving regardless of how many undosaves are involved")
|
||||
|
||||
then (* ;
|
||||
"Want UNDOSAVE to keep saving regardless of how many undosaves are involved")
|
||||
(if (SETQ LOADA (FMEMB 'SIDE LISPXHIST))
|
||||
then (FRPLACA (CADR LOADA)
|
||||
-1)
|
||||
@@ -413,22 +412,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
NIL LISPXHIST)))
|
||||
(if (EQ (SETQ TEM (SKIPSEPRCODES STREAM))
|
||||
FASL:SIGNATURE)
|
||||
then (* ;
|
||||
"FASL file handled by FASL loader")
|
||||
|
||||
then (* ;
|
||||
"FASL file handled by FASL loader")
|
||||
(FASL:PROCESS-FILE STREAM)
|
||||
[LET [(MANAGED-FILE-P (GET (SETQ ROOTNAME (ROOTFILENAME FILE T))
|
||||
'FILEDATES]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (* ;
|
||||
"Keep track of every file loaded.")
|
||||
|
||||
then (* ;
|
||||
"Keep track of every file loaded.")
|
||||
(SETQ LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(if MANAGED-FILE-P
|
||||
then (if (EQ LDFLG 'SYSLOAD)
|
||||
then
|
||||
(* ;;
|
||||
"Don't notice DFASL's when you are coming from CL:LOAD, and the user didn't specify a load flag")
|
||||
|
||||
(* ;;
|
||||
"Don't notice DFASL's when you are coming from CL:LOAD, and the user didn't specify a load flag")
|
||||
|
||||
(if (NOT (MEMB ROOTNAME SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES
|
||||
@@ -441,144 +439,127 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
then (RETURN (\CML-LOAD STREAM PRINTFLG LOAD-VERBOSE-STREAM PACKAGE)))
|
||||
(if (AND BUILDMAPFLG (RANDACCESSP STREAM))
|
||||
then (SETQ MAYBEWANTFILEMAP T))
|
||||
(WITH-READER-ENVIRONMENT
|
||||
FILECREATEDENV
|
||||
(PROG (ADR)
|
||||
LP (if FILEMAP
|
||||
then (* ;
|
||||
"need to build map, so read carefully")
|
||||
(WITH-READER-ENVIRONMENT FILECREATEDENV
|
||||
(PROG (ADR)
|
||||
LP (if FILEMAP
|
||||
then (* ;
|
||||
"need to build map, so read carefully")
|
||||
(SETQ LOADA (SKIPSEPRCODES STREAM))
|
||||
(if (OR (SYNTAXP LOADA 'LEFTPAREN)
|
||||
(SYNTAXP LOADA 'LEFTBRACKET))
|
||||
then (* ; "See if we have a DEFINEQ")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(READCCODE STREAM) (* ; "Eat paren")
|
||||
(if (EQ (RATOM STREAM)
|
||||
'DEFINEQ)
|
||||
then (SETQ FNADRLST (TCONC NIL ADR))
|
||||
(TCONC FNADRLST NIL)
|
||||
(TCONC FILEMAP (CAR FNADRLST))
|
||||
(GO DEFQLP))
|
||||
(* ; "Not a DEFINEQ, so back out")
|
||||
(SETFILEPTR STREAM ADR)))
|
||||
(SELECTQ (SETQ LOADA (READ STREAM))
|
||||
((STOP NIL)
|
||||
(if (EQ LDFLG 'SYSLOAD)
|
||||
then (if (NOT (MEMB (SETQ ROOTNAME
|
||||
(ROOTFILENAME FILE
|
||||
(CDR FILECREATEDLST)))
|
||||
SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES
|
||||
ROOTNAME)))
|
||||
(SMASHFILECOMS ROOTNAME)
|
||||
elseif FILEPKGFLG
|
||||
then
|
||||
|
||||
(SETQ LOADA (SKIPSEPRCODES STREAM))
|
||||
(if (OR (SYNTAXP LOADA 'LEFTPAREN)
|
||||
(SYNTAXP LOADA 'LEFTBRACKET))
|
||||
then (* ; "See if we have a DEFINEQ")
|
||||
(* ;; "Do not want any items that are added to FILEPKGCHANGES as a result of being mentioned in this file to remain on FILEPKGCHANGES. Also, we want items mentioned earlier to be deleted if they are taken care of by this file. The extra argument to ADDFILE allows it to restore FILEPKGCHANGES to the intersection of its current value and its previous value.")
|
||||
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(READCCODE STREAM) (* ; "Eat paren")
|
||||
|
||||
(if (EQ (RATOM STREAM)
|
||||
'DEFINEQ)
|
||||
then (SETQ FNADRLST (TCONC NIL ADR))
|
||||
(TCONC FNADRLST NIL)
|
||||
(TCONC FILEMAP (CAR FNADRLST))
|
||||
(GO DEFQLP)) (* ; "Not a DEFINEQ, so back out")
|
||||
|
||||
(SETFILEPTR STREAM ADR)))
|
||||
(SELECTQ (SETQ LOADA (READ STREAM))
|
||||
((STOP NIL)
|
||||
(if (EQ LDFLG 'SYSLOAD)
|
||||
then (if (NOT (MEMB (SETQ ROOTNAME (ROOTFILENAME
|
||||
FILE
|
||||
(CDR FILECREATEDLST
|
||||
)))
|
||||
SYSFILES))
|
||||
then (SETQ SYSFILES (NCONC1 SYSFILES ROOTNAME)
|
||||
))
|
||||
(SMASHFILECOMS ROOTNAME)
|
||||
elseif FILEPKGFLG
|
||||
then
|
||||
(* ;; "Do not want any items that are added to FILEPKGCHANGES as a result of being mentioned in this file to remain on FILEPKGCHANGES. Also, we want items mentioned earlier to be deleted if they are taken care of by this file. The extra argument to ADDFILE allows it to restore FILEPKGCHANGES to the intersection of its current value and its previous value.")
|
||||
|
||||
(ADDFILE FILE T PRLST FILECREATEDLST))
|
||||
[if FILEMAP
|
||||
then (PUTFILEMAP FILE (CAR FILEMAP)
|
||||
FILECREATEDLST FILECREATEDENV NIL FILECREATEDLOC)
|
||||
(if UPDATEMAPFLG
|
||||
then (SETFILEPTR STREAM ADR)
|
||||
(* ;
|
||||
"address of last expression read. good hint for finding filemap")
|
||||
|
||||
(UPDATEFILEMAP STREAM (CAR FILEMAP]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (/SETTOPVAL 'LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(RETURN))
|
||||
NIL)
|
||||
[if (LISTP LOADA)
|
||||
then
|
||||
(SELECTQ (CAR LOADA)
|
||||
(DEFINE-FILE-INFO (* ;
|
||||
"Handle this specially, since we want to remember the environment")
|
||||
|
||||
(SETQ FILECREATEDLOC (GETFILEPTR STREAM))
|
||||
[SET-READER-ENVIRONMENT (SETQ LOADA
|
||||
(SETQ FILECREATEDENV
|
||||
(\DO-DEFINE-FILE-INFO
|
||||
NIL
|
||||
(CDR LOADA]
|
||||
(if PACKAGE
|
||||
then (* ;
|
||||
"Caller better really mean it--overrides what's on file!")
|
||||
|
||||
[replace REPACKAGE of FILECREATEDENV
|
||||
with (SETQ *PACKAGE*
|
||||
(\DTEST PACKAGE 'PACKAGE]
|
||||
(LISTPUT (fetch RESPEC of
|
||||
(ADDFILE FILE T PRLST FILECREATEDLST))
|
||||
[if FILEMAP
|
||||
then (PUTFILEMAP FILE (CAR FILEMAP)
|
||||
FILECREATEDLST FILECREATEDENV NIL FILECREATEDLOC
|
||||
)
|
||||
(if UPDATEMAPFLG
|
||||
then (SETFILEPTR STREAM ADR)
|
||||
(* ;
|
||||
"address of last expression read. good hint for finding filemap")
|
||||
(UPDATEFILEMAP STREAM (CAR FILEMAP]
|
||||
(if (NOT (MEMB FILE LOADEDFILELST))
|
||||
then (/SETTOPVAL 'LOADEDFILELST (CONS FILE LOADEDFILELST)))
|
||||
(RETURN))
|
||||
NIL)
|
||||
[if (LISTP LOADA)
|
||||
then
|
||||
(SELECTQ (CAR LOADA)
|
||||
(DEFINE-FILE-INFO (* ;
|
||||
"Handle this specially, since we want to remember the environment")
|
||||
(SETQ FILECREATEDLOC (GETFILEPTR STREAM))
|
||||
(SET-READER-ENVIRONMENT [SETQ LOADA
|
||||
(SETQ FILECREATEDENV
|
||||
(\DO-DEFINE-FILE-INFO
|
||||
STREAM
|
||||
(CDR LOADA]
|
||||
STREAM)
|
||||
[if PACKAGE
|
||||
then (* ;
|
||||
"Caller better really mean it--overrides what's on file!")
|
||||
(replace REPACKAGE of
|
||||
FILECREATEDENV
|
||||
)
|
||||
:PACKAGE
|
||||
(CL:PACKAGE-NAME *PACKAGE*))))
|
||||
(FILECREATED (if MAYBEWANTFILEMAP
|
||||
then (* ; "See if we have a valid file map")
|
||||
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(if [AND (FIXP (SETQ TEM (CADDDR LOADA)))
|
||||
[SETQ TEM
|
||||
(CAR (NLSETQ (SETFILEPTR STREAM TEM)
|
||||
(READ STREAM]
|
||||
(EQ (CAR TEM)
|
||||
'FILEMAP)
|
||||
(NULL (CAR (SETQ TEM (CADR TEM]
|
||||
then
|
||||
(* ; "Has ok map")
|
||||
|
||||
(PUTFILEMAP FILE TEM NIL FILECREATEDENV)
|
||||
else (* ;
|
||||
"Need to build a file map as we go")
|
||||
|
||||
(SETQ FILEMAP (TCONC NIL NIL)))
|
||||
(SETFILEPTR STREAM ADR)
|
||||
(SETQ MAYBEWANTFILEMAP NIL))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
else (* ;
|
||||
"Atom found. Compiled code definition.")
|
||||
|
||||
(if ADDSPELLFLG
|
||||
then (ADDSPELL LOADA))
|
||||
(if FILEMAP
|
||||
then (SETQ ADR (GETFILEPTR STREAM)))
|
||||
(LAPRD LOADA)
|
||||
(if FILEMAP
|
||||
then (TCONC FILEMAP (CONS ADR (CONS (GETFILEPTR STREAM)
|
||||
LOADA]
|
||||
LP1 (if PRINTFLG
|
||||
then (PRINT LOADA PRINTFLG))
|
||||
(GO LP)
|
||||
DEFQLP
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
((%) %]) (* ; "Closes DEFINEQ.")
|
||||
|
||||
(READCCODE STREAM)
|
||||
(if FNADRLST
|
||||
then (RPLACA (CDAR FNADRLST)
|
||||
(GETFILEPTR STREAM)))
|
||||
(* ;
|
||||
"FNADRLST is a TCONC format list, hence want to RPLACA CDAR, not just CDR.")
|
||||
|
||||
(SETQ LOADA (DEFINE (DREVERSE LOADA)))
|
||||
(GO LP1))
|
||||
((%( %[) (* ;
|
||||
"another function/definition pair")
|
||||
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(SETQ LOADA (CONS (READ STREAM)
|
||||
LOADA))
|
||||
[if FNADRLST
|
||||
then (TCONC FNADRLST (CONS (CAAR LOADA)
|
||||
(CONS ADR (GETFILEPTR STREAM]
|
||||
(GO DEFQLP))
|
||||
NIL)
|
||||
(ERROR "illegal argument in defineq")))
|
||||
with (SETQ *PACKAGE*
|
||||
(\DTEST PACKAGE 'PACKAGE])
|
||||
(FILECREATED (if MAYBEWANTFILEMAP
|
||||
then (* ; "See if we have a valid file map")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(if [AND (FIXP (SETQ TEM (CADDDR LOADA)))
|
||||
[SETQ TEM (CAR (NLSETQ (SETFILEPTR STREAM
|
||||
TEM)
|
||||
(READ STREAM]
|
||||
(EQ (CAR TEM)
|
||||
'FILEMAP)
|
||||
(NULL (CAR (SETQ TEM (CADR TEM]
|
||||
then (* ; "Has ok map")
|
||||
(PUTFILEMAP FILE TEM NIL FILECREATEDENV)
|
||||
else (* ;
|
||||
"Need to build a file map as we go")
|
||||
(SETQ FILEMAP (TCONC NIL NIL)))
|
||||
(SETFILEPTR STREAM ADR)
|
||||
(SETQ MAYBEWANTFILEMAP NIL))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
(SETQ LOADA (\EVAL LOADA)))
|
||||
else (* ;
|
||||
"Atom found. Compiled code definition.")
|
||||
(if ADDSPELLFLG
|
||||
then (ADDSPELL LOADA))
|
||||
(if FILEMAP
|
||||
then (SETQ ADR (GETFILEPTR STREAM)))
|
||||
(LAPRD LOADA)
|
||||
(if FILEMAP
|
||||
then (TCONC FILEMAP (CONS ADR (CONS (GETFILEPTR STREAM)
|
||||
LOADA]
|
||||
LP1 (if PRINTFLG
|
||||
then (PRINT LOADA PRINTFLG))
|
||||
(GO LP)
|
||||
DEFQLP
|
||||
(SELCHARQ (SKIPSEPRCODES STREAM)
|
||||
((%) %]) (* ; "Closes DEFINEQ.")
|
||||
(READCCODE STREAM)
|
||||
(if FNADRLST
|
||||
then (RPLACA (CDAR FNADRLST)
|
||||
(GETFILEPTR STREAM)))
|
||||
(* ;
|
||||
"FNADRLST is a TCONC format list, hence want to RPLACA CDAR, not just CDR.")
|
||||
(SETQ LOADA (DEFINE (DREVERSE LOADA)))
|
||||
(GO LP1))
|
||||
((%( %[) (* ;
|
||||
"another function/definition pair")
|
||||
(SETQ ADR (GETFILEPTR STREAM))
|
||||
(SETQ LOADA (CONS (READ STREAM)
|
||||
LOADA))
|
||||
[if FNADRLST
|
||||
then (TCONC FNADRLST (CONS (CAAR LOADA)
|
||||
(CONS ADR (GETFILEPTR STREAM]
|
||||
(GO DEFQLP))
|
||||
NIL)
|
||||
(ERROR "illegal argument in defineq")))
|
||||
(RETURN FILE])
|
||||
|
||||
(FILECREATED
|
||||
@@ -725,10 +706,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
(SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL ARGS])
|
||||
|
||||
(\DO-DEFINE-FILE-INFO
|
||||
[LAMBDA (STREAM ARGS) (* bvm%: "14-Oct-86 00:28")
|
||||
(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM")
|
||||
[LAMBDA (STREAM ARGS) (* ; "Edited 9-Jul-2021 15:32 by rmk:")
|
||||
|
||||
(LET (PACKAGE READTABLE BASE VALUE)
|
||||
(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")
|
||||
|
||||
(LET (PACKAGE READTABLE BASE FORMAT VALUE)
|
||||
[for TAIL on ARGS by (CDDR TAIL)
|
||||
do (SETQ VALUE (CADR TAIL))
|
||||
(SELECTQ (CAR TAIL)
|
||||
@@ -745,18 +727,26 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
'READTABLEP)
|
||||
else (FIND-READTABLE VALUE))
|
||||
(ERROR
|
||||
"Can't find read table for reader environment"
|
||||
"Can't find read table for reader environment"
|
||||
VALUE))))
|
||||
(:BASE (SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE)
|
||||
then (EVAL VALUE)
|
||||
else VALUE))
|
||||
(ERROR "Bad read base for reader environment" VALUE))))
|
||||
((:FORMAT FORMAT)
|
||||
(SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT
|
||||
VALUE))))
|
||||
(ERROR "Unrecognized file info key" (CAR TAIL]
|
||||
|
||||
(* ;; "Set the defaults. Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*? Maybe the defaults should be take from there?")
|
||||
|
||||
(CL:UNLESS FORMAT (SETQ FORMAT :XCCS))
|
||||
(CL:WHEN STREAM (\EXTERNALFORMAT STREAM FORMAT))
|
||||
(create READER-ENVIRONMENT
|
||||
REPACKAGE _ (OR PACKAGE *INTERLISP-PACKAGE*)
|
||||
REREADTABLE _ (OR READTABLE FILERDTBL)
|
||||
REBASE _ (OR BASE 10)
|
||||
RESPEC _ ARGS])
|
||||
REFORMAT _ FORMAT])
|
||||
)
|
||||
|
||||
(RPAQ? EOLCHARCODE (CHCON1 "
|
||||
@@ -857,14 +847,14 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992 by Venue & Xe
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1992))
|
||||
1992 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4429 14101 (GETPROP 4439 . 5011) (SETATOMVAL 5013 . 5142) (RPAQQ 5144 . 5197) (RPAQ
|
||||
5199 . 5511) (RPAQ? 5513 . 5883) (MOVD 5885 . 7749) (MOVD? 7751 . 8181) (SELECTQ 8183 . 8370) (
|
||||
SELECTQ1 8372 . 8714) (NCONC1 8716 . 8912) (PUTPROP 8914 . 10398) (PROPNAMES 10400 . 10591) (ADDPROP
|
||||
10593 . 12656) (REMPROP 12658 . 13512) (MEMB 13514 . 13773) (CLOSEF? 13775 . 14099)) (14174 38092 (
|
||||
LOAD 14184 . 15353) (\LOAD-STREAM 15355 . 29131) (FILECREATED 29133 . 30551) (FILECREATED1 30553 .
|
||||
31661) (PRETTYCOMPRINT 31663 . 32148) (BOOTSTRAP-NAMEFIELD 32150 . 33110) (PUTPROPS 33112 . 33480) (
|
||||
DECLARE%: 33482 . 33614) (DECLARE%:1 33616 . 34488) (ROOTFILENAME 34490 . 35438) (DEFINE-FILE-INFO
|
||||
35440 . 35875) (\DO-DEFINE-FILE-INFO 35877 . 38090)))))
|
||||
(FILEMAP (NIL (4465 14137 (GETPROP 4475 . 5047) (SETATOMVAL 5049 . 5178) (RPAQQ 5180 . 5233) (RPAQ
|
||||
5235 . 5547) (RPAQ? 5549 . 5919) (MOVD 5921 . 7785) (MOVD? 7787 . 8217) (SELECTQ 8219 . 8406) (
|
||||
SELECTQ1 8408 . 8750) (NCONC1 8752 . 8948) (PUTPROP 8950 . 10434) (PROPNAMES 10436 . 10627) (ADDPROP
|
||||
10629 . 12692) (REMPROP 12694 . 13548) (MEMB 13550 . 13809) (CLOSEF? 13811 . 14135)) (14210 38711 (
|
||||
LOAD 14220 . 15389) (\LOAD-STREAM 15391 . 29116) (FILECREATED 29118 . 30536) (FILECREATED1 30538 .
|
||||
31646) (PRETTYCOMPRINT 31648 . 32133) (BOOTSTRAP-NAMEFIELD 32135 . 33095) (PUTPROPS 33097 . 33465) (
|
||||
DECLARE%: 33467 . 33599) (DECLARE%:1 33601 . 34473) (ROOTFILENAME 34475 . 35423) (DEFINE-FILE-INFO
|
||||
35425 . 35860) (\DO-DEFINE-FILE-INFO 35862 . 38709)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "26-Apr-91 17:25:53" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>BYTECOMPILER.;1| 264022
|
||||
(FILECREATED "13-Jun-2021 09:51:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BYTECOMPILER.;2 263891
|
||||
|
||||
changes to%: (FNS COMP.EXPR)
|
||||
changes to%: (FNS COMP.MLLIST)
|
||||
|
||||
previous date%: "17-Jul-90 11:28:59" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>BYTECOMPILER.;8|)
|
||||
previous date%: "26-Apr-91 17:25:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BYTECOMPILER.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1981-1987, 1900, 1988-1991, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT BYTECOMPILERCOMS)
|
||||
@@ -15,7 +17,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(RPAQQ BYTECOMPILERCOMS
|
||||
[
|
||||
|
||||
(* ;;; "THE BYTE LISP COMPILER")
|
||||
(* ;;; "THE BYTE LISP COMPILER")
|
||||
|
||||
(COMS (INITVARS (*BYTECOMPILER-IS-EXPANDING* NIL))
|
||||
(FNS BYTEBLOCKCOMPILE2 BYTECOMPILE2 COMP.ATTEMPT.COMPILE COMP.RETFROM.POINT
|
||||
@@ -86,17 +88,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(PROP BYTEMACRO SUB1VAR)
|
||||
(OPTIMIZERS EQMEMB MKLIST)
|
||||
(COMS
|
||||
(* ;; "Pass 1 listing")
|
||||
(* ;; "Pass 1 listing")
|
||||
|
||||
(FNS COMP.MLLIST COMP.MLL COMP.MLLVAR COMP.MLLFN)
|
||||
(VARS COPS)
|
||||
(IFPROP MLSYM * (PROGN COPS)))
|
||||
(COMS
|
||||
(* ;; "ARJ --- JUMP LENGTH RESOLVER")
|
||||
(* ;; "ARJ --- JUMP LENGTH RESOLVER")
|
||||
|
||||
(FNS OPT.RESOLVEJUMPS OPT.JLENPASS OPT.JFIXPASS OPT.JSIZE))
|
||||
(COMS
|
||||
(* ;; "Utilities used by all files")
|
||||
(* ;; "Utilities used by all files")
|
||||
|
||||
(FNS OPT.CALLP OPT.JUMPCHECK OPT.DREV OPT.CHLEV OPT.CHECKTAG OPT.NOTJUMP
|
||||
OPT.INITHASH OPT.COMPINIT))
|
||||
@@ -118,7 +120,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(FNS COMP.AREF COMP.ASET COMP.BOX COMP.LOOKFORDECLARE COMP.DECLARETYPE COMP.FLOATBOX
|
||||
COMP.FLOATUNBOX COMP.PREDP COMP.UBFLOAT2 COMP.UNBOX))
|
||||
(ADDVARS (COMPILETYPELST))
|
||||
(COMS (* ; "POST OPTIMIZATION")
|
||||
(COMS (* ; "POST OPTIMIZATION")
|
||||
(FNS OPT.POSTOPT OPT.SETUPOPT OPT.SCANOPT OPT.XVARSCAN OPT.XVARSCAN1 OPT.JUMPOPT
|
||||
OPT.JUMPTHRU OPT.LBMERGE OPT.PRDEL OPT.UBDEL OPT.LBDEL OPT.LABELNTHPR OPT.JUMPREV
|
||||
OPT.COMMONBACK OPT.DELTAGREF OPT.FINDEND OPT.RETOPT OPT.RETFIND OPT.RETPOP
|
||||
@@ -144,7 +146,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(SPECVARS FRAME LEVEL ANY)
|
||||
(SPECVARS FRAME LEVEL ANY)
|
||||
(SPECVARS TAGS ANY)))
|
||||
(COMS (* ; "CONSISTENCY CHECKS")
|
||||
(COMS (* ; "CONSISTENCY CHECKS")
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS OPT.CCHECK)
|
||||
(VARS (COMPILECOMPILERCHECKS NIL)))
|
||||
(FNS OPT.COMPILERERROR OPT.OPTCHECK OPT.CCHECK))
|
||||
@@ -157,7 +159,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
STATN SYSSPECVARS UNIQUE#ARRAY VCA VCONDITIONALS VREFFRA COUTFILE XVARFLG
|
||||
MERGEFRAMEFLG OPTIMIZATIONSOFF NOFREEVARSFNS EQCONSTFN NEWOPTFLG)
|
||||
[P (CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH]
|
||||
(DECLARE%: DONTCOPY (* ; "for compiling compiler")
|
||||
(DECLARE%: DONTCOPY (* ; "for compiling compiler")
|
||||
EVAL@COMPILE
|
||||
(RECORDS CODELST)
|
||||
(PROP MACRO OASSOC)
|
||||
@@ -2836,34 +2838,34 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
|
||||
(DEFOPTIMIZER KWOTE (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (Q)
|
||||
(COND
|
||||
((AND Q (NEQ Q T)
|
||||
(NOT (NUMBERP Q)))
|
||||
(LIST 'QUOTE Q))
|
||||
(T Q)))
|
||||
(COND
|
||||
((AND Q (NEQ Q T)
|
||||
(NOT (NUMBERP Q)))
|
||||
(LIST 'QUOTE Q))
|
||||
(T Q)))
|
||||
ARGS))
|
||||
|
||||
(DEFOPTIMIZER FRPLNODE (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (X A D)
|
||||
(FRPLACD (FRPLACA X A)
|
||||
D))
|
||||
(FRPLACD (FRPLACA X A)
|
||||
D))
|
||||
ARGS))
|
||||
|
||||
(DEFOPTIMIZER RPLNODE (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (X A D)
|
||||
(RPLACD (RPLACA X A)
|
||||
D))
|
||||
(RPLACD (RPLACA X A)
|
||||
D))
|
||||
ARGS))
|
||||
|
||||
(DEFOPTIMIZER LISTGET1 (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (X Y)
|
||||
(CADR (MEMB Y X)))
|
||||
(CADR (MEMB Y X)))
|
||||
ARGS))
|
||||
|
||||
(DEFOPTIMIZER FRPLNODE2 (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (X Y)
|
||||
(FRPLACD (FRPLACA X (CAR Y))
|
||||
(CDR Y)))
|
||||
(FRPLACD (FRPLACA X (CAR Y))
|
||||
(CDR Y)))
|
||||
ARGS))
|
||||
|
||||
(PUTPROPS SUB1VAR BYTEMACRO ((X)
|
||||
@@ -2871,16 +2873,16 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
|
||||
(DEFOPTIMIZER EQMEMB (&REST ARGS)
|
||||
(CONS '(OPENLAMBDA (X Y)
|
||||
(OR (EQ X Y)
|
||||
(AND (LISTP Y)
|
||||
(FMEMB X Y)
|
||||
T)))
|
||||
(OR (EQ X Y)
|
||||
(AND (LISTP Y)
|
||||
(FMEMB X Y)
|
||||
T)))
|
||||
ARGS))
|
||||
|
||||
(DEFOPTIMIZER MKLIST (&REST ARGS)
|
||||
(CONS '[OPENLAMBDA (X)
|
||||
(OR (LISTP X)
|
||||
(AND X (LIST X]
|
||||
(OR (LISTP X)
|
||||
(AND X (LIST X]
|
||||
ARGS))
|
||||
|
||||
|
||||
@@ -2890,20 +2892,21 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(DEFINEQ
|
||||
|
||||
(COMP.MLLIST
|
||||
[LAMBDA (FN CC) (* lmm%: "13-NOV-76 06:56:28")
|
||||
(RESETLST (RESETSAVE (RADIX 10))
|
||||
(RESETSAVE (LINELENGTH 72))
|
||||
(PRIN2 FN)
|
||||
(MAPRINT (fetch ARGS of CC)
|
||||
NIL "(" ")" " " (FUNCTION COMP.MLLVAR))
|
||||
(SPACES 5)
|
||||
[PRINT (CDR (FASSOC (fetch COMTYPE of CC)
|
||||
'((0 . LAMBDA)
|
||||
(2 . LAMBDA*)
|
||||
(1 . NLAMBDA)
|
||||
(2 . NLAMBDA*)
|
||||
(NIL . ???]
|
||||
(COMP.MLL (fetch CODE of CC])
|
||||
[LAMBDA (FN CC) (* ; "Edited 13-Jun-2021 09:50 by rmk:")
|
||||
(RESETLST
|
||||
(RESETSAVE (RADIX 10))
|
||||
(RESETSAVE (LINELENGTH 72))
|
||||
(PRIN2 FN)
|
||||
(MAPRINT (fetch (COMINFO ARGS) of CC)
|
||||
NIL "(" ")" " " (FUNCTION COMP.MLLVAR))
|
||||
(SPACES 5)
|
||||
[PRINT (CDR (FASSOC (fetch (COMINFO COMTYPE) of CC)
|
||||
'((0 . LAMBDA)
|
||||
(2 . LAMBDA*)
|
||||
(1 . NLAMBDA)
|
||||
(2 . NLAMBDA*)
|
||||
(NIL . ???]
|
||||
(COMP.MLL (fetch (COMINFO CODE) of CC)))])
|
||||
|
||||
(COMP.MLL
|
||||
[LAMBDA (LL) (* Pavel "15-Nov-86 16:02")
|
||||
@@ -3261,16 +3264,16 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
)
|
||||
|
||||
(PUTPROPS IMAX2 BYTEMACRO (OPENLAMBDA (X Y)
|
||||
(COND
|
||||
((NOT (IGREATERP X Y))
|
||||
Y)
|
||||
(T X))))
|
||||
(COND
|
||||
((NOT (IGREATERP X Y))
|
||||
Y)
|
||||
(T X))))
|
||||
|
||||
(PUTPROPS IMIN2 BYTEMACRO (OPENLAMBDA (X Y)
|
||||
(COND
|
||||
((IGREATERP X Y)
|
||||
Y)
|
||||
(T X))))
|
||||
(COND
|
||||
((IGREATERP X Y)
|
||||
Y)
|
||||
(T X))))
|
||||
|
||||
(PUTPROPS FLOAT BOX (\FLOATBOX . \FLOATUNBOX))
|
||||
(DEFINEQ
|
||||
@@ -5223,7 +5226,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(DEFMACRO CL:MACROLET (CL::MACRODEFS &BODY CL::BODY &ENVIRONMENT CL::ENV)
|
||||
(DECLARE (SPECVARS *BYTECOMPILER-IS-EXPANDING*))
|
||||
|
||||
(* ;; "This macro for the old interpreter and compiler only. The new interpreter has a special-form definition. When the new compiler is expanding, we simply return a disguised version of the form.")
|
||||
(* ;; "This macro for the old interpreter and compiler only. The new interpreter has a special-form definition. When the new compiler is expanding, we simply return a disguised version of the form.")
|
||||
|
||||
(IF (AND *BYTECOMPILER-IS-EXPANDING* *BYTECOMPILER-OPTIMIZE-MACROLET*)
|
||||
THEN (LET ((CL::NEW-ENV (COMPILER::MAKE-CHILD-ENV CL::ENV)))
|
||||
@@ -5442,17 +5445,17 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
|
||||
(RECORD OP (OPNAME . OPARG))
|
||||
|
||||
(RECORD JUMP (OPNAME TAG . JT) (* kind of OP)
|
||||
(RECORD JUMP (OPNAME TAG . JT) (* kind of OP)
|
||||
)
|
||||
|
||||
(TYPERECORD TAG (LBNO . LEVEL) (* kind of OP)
|
||||
(TYPERECORD TAG (LBNO . LEVEL) (* kind of OP)
|
||||
LBNO _ (SETQ LBCNT (ADD1 LBCNT))
|
||||
[ACCESSFNS TAG ((FRAME (GETHASH DATUM FRA)
|
||||
(PUTHASH DATUM NEWVALUE FRA))
|
||||
(JD (GETHASH DATUM LBA)
|
||||
(PUTHASH DATUM NEWVALUE LBA])
|
||||
|
||||
(RECORD VAR (COMP.VARTYPE . VARNAME) (* A particular kind of OP)
|
||||
(RECORD VAR (COMP.VARTYPE . VARNAME) (* A particular kind of OP)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -5462,9 +5465,9 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
LEVEL
|
||||
(BINDLST NVALS EXTCALL . CPIOK) . PROGLABELS)
|
||||
|
||||
(* FRAMETYPE is one of PROG LAMBDA ERRORSET MAP NIL -
|
||||
VARS are variables bound, NNILS are %# which are bound to NIL -
|
||||
LEVEL is %# of things on stack between this and next higher frame)
|
||||
(* FRAMETYPE is one of PROG LAMBDA ERRORSET MAP NIL -
|
||||
VARS are variables bound, NNILS are %# which are bound to NIL -
|
||||
LEVEL is %# of things on stack between this and next higher frame)
|
||||
|
||||
(ACCESSFNS FRAME ((PARENT (GETHASH DATUM FRA)
|
||||
(PUTHASH DATUM NEWVALUE FRA))
|
||||
@@ -5474,14 +5477,14 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(PUTHASH DATUM NEWVALUE NODARR))
|
||||
(PRIMARYRETURN (GETHASH DATUM BCINFO)
|
||||
(PUTHASH DATUM NEWVALUE BCINFO)))
|
||||
(* PARENT is next higher enclosing
|
||||
frame -
|
||||
shares hash table with TAG.FRAME)
|
||||
(* PARENT is next higher enclosing
|
||||
frame -
|
||||
shares hash table with TAG.FRAME)
|
||||
)
|
||||
(RECORD CPIOK NOXVAR
|
||||
|
||||
(* Share the CPIOK field used by the compiler pass 1 and the NOXVAR field used
|
||||
by the maxc assembler)
|
||||
(* Share the CPIOK field used by the compiler pass 1 and the NOXVAR field used
|
||||
by the maxc assembler)
|
||||
)
|
||||
NNILS _ 0)
|
||||
|
||||
@@ -5497,12 +5500,12 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(RECORD JD (JPT (JMIN . JSN)
|
||||
JU . JML)
|
||||
|
||||
(* JPT is NIL (for tags) or a pointer into ACODE
|
||||
(for jumps)%. JMIN is the lowest possible location for the instruction or tag.
|
||||
JU is the cumulative uncertainty (for tags) or the length uncertainty
|
||||
(for jumps)%. JML is the minimum length
|
||||
(for jumps)%. JSN is a serial number (the original JMIN) used to decide whether
|
||||
a jump goes forward or backward.)
|
||||
(* JPT is NIL (for tags) or a pointer into ACODE
|
||||
(for jumps)%. JMIN is the lowest possible location for the instruction or tag.
|
||||
JU is the cumulative uncertainty (for tags) or the length uncertainty
|
||||
(for jumps)%. JML is the minimum length
|
||||
(for jumps)%. JSN is a serial number (the original JMIN) used to decide whether
|
||||
a jump goes forward or backward.)
|
||||
|
||||
)
|
||||
|
||||
@@ -5530,62 +5533,62 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1900, 1988, 1989, 1990,
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS BYTECOMPILER COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1900
|
||||
1988 1989 1990 1991))
|
||||
1988 1989 1990 1991 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (9298 19200 (BYTEBLOCKCOMPILE2 9308 . 11925) (BYTECOMPILE2 11927 . 12166) (
|
||||
COMP.ATTEMPT.COMPILE 12168 . 13312) (COMP.RETFROM.POINT 13314 . 14004) (COMP.TRANSFORM 14006 . 17469)
|
||||
(COMPERROR 17471 . 17830) (COMPPRINT 17832 . 18056) (COMPERRM 18058 . 19198)) (19201 28848 (
|
||||
COMP.TOPLEVEL.COMPILE 19211 . 25317) (COMP.BINDLIST 25319 . 25637) (COMP.CHECK.VAR 25639 . 26143) (
|
||||
COMP.BIND.VARS 26145 . 28436) (COMP.UNBIND.VARS 28438 . 28846)) (28849 43028 (COMP.VALN 28859 . 28992)
|
||||
(COMP.PROGN 28994 . 29722) (COMP.PROGLST 29724 . 30622) (COMP.EXP1 30624 . 30772) (COMP.EXPR 30774 .
|
||||
35500) (COMP.TRYUSERFN 35502 . 35831) (COMP.USERFN 35833 . 36754) (COMP.CONST 36756 . 37817) (
|
||||
COMP.CALL 37819 . 39258) (COMP.VAR 39260 . 39739) (COMP.VAL1 39741 . 39874) (COMP.PROG1 39876 . 40304)
|
||||
(COMP.EFFECT 40306 . 40885) (COMP.VAL 40887 . 41510) (COMP.MACRO 41512 . 43026)) (43029 45232 (
|
||||
COMP.VARTYPE 43039 . 43268) (COMP.LOOKUPVAR 43270 . 44742) (COMP.LOOKUPCONST 44744 . 45230)) (45233
|
||||
52744 (COMP.ST 45243 . 45746) (COMP.STFN 45748 . 46142) (COMP.STCONST 46144 . 46313) (COMP.STVAR 46315
|
||||
. 46451) (COMP.STPOP 46453 . 46616) (COMP.DELFN 46618 . 46856) (COMP.STRETURN 46858 . 47030) (
|
||||
COMP.STTAG 47032 . 48002) (COMP.STJUMP 48004 . 50020) (COMP.STSETQ 50022 . 50290) (COMP.STCOPY 50292
|
||||
. 50472) (COMP.DELPUSH 50474 . 50638) (COMP.DELPOP 50640 . 50808) (COMP.STBIND 50810 . 52204) (
|
||||
COMP.STUNBIND 52206 . 52742)) (57165 60353 (COMP.ARGTYPE 57175 . 58344) (COMP.CLEANEXPP 58346 . 58662)
|
||||
(COMP.CLEANFNP 58664 . 59078) (COMP.CLEANFNOP 59080 . 59228) (COMP.GLOBALVARP 59230 . 59408) (
|
||||
COMP.LINKCALLP 59410 . 59874) (COMP.ANONP 59876 . 60231) (COMP.NOSIDEEFFECTP 60233 . 60351)) (60354
|
||||
63601 (COMP.CPI 60364 . 62172) (COMP.CPI1 62174 . 62903) (COMP.PICOUNT 62905 . 63599)) (63645 63846 (
|
||||
COMP.EVQ 63655 . 63844)) (63958 66690 (COMP.BOOL 63968 . 66688)) (66691 67219 (COMP.APPLYFNP 66701 .
|
||||
67217)) (67261 67843 (COMP.AC 67271 . 67467) (COMP.PUNT 67469 . 67841)) (67897 69523 (COMP.FUNCTION
|
||||
67907 . 68327) (COMP.LAM1 68329 . 69183) (COMP.GENFN 69185 . 69521)) (69733 79689 (COMP.COND 69743 .
|
||||
72832) (COMP.IF 72834 . 74307) (COMP.SELECTQ 74309 . 79687)) (79876 80406 (COMP.QUOTE 79886 . 80120) (
|
||||
COMP.COMMENT 80122 . 80404)) (80458 83446 (COMP.DECLARE 80468 . 82352) (COMP.DECLARE1 82354 . 83444))
|
||||
(86362 87269 (COMP.CARCDR 86372 . 87056) (COMP.STCROP 87058 . 87267)) (87357 87696 (COMP.NOT 87367 .
|
||||
87694)) (87787 88524 (COMP.SETQ 87797 . 88294) (COMP.SETN 88296 . 88522)) (88525 92500 (COMP.LAMBDA
|
||||
88535 . 92498)) (92749 104633 (COMP.PROG 92759 . 96529) (COMP.GO 96531 . 97549) (COMP.RETURN 97551 .
|
||||
99228) (COMP.BLOCK 99230 . 100836) (COMP.RETURN-FROM 100838 . 102988) (COMP.TAGBODY 102990 . 104631))
|
||||
(104686 107192 (COMP.LABELS 104696 . 107190)) (110639 120378 (COMP.NUMERIC 110649 . 115463) (
|
||||
COMP.NUMBERCALL 115465 . 119055) (COMP.FIX 119057 . 119209) (COMP.STFIX 119211 . 119800) (COMP.DELFIX
|
||||
119802 . 120376)) (120506 122351 (COMP.EQ 120516 . 122349)) (122413 125921 (COMP.NUMBERTEST 122423 .
|
||||
125919)) (127424 134956 (COMP.MAP 127434 . 134954)) (137329 141510 (COMP.MLLIST 137339 . 138022) (
|
||||
COMP.MLL 138024 . 140799) (COMP.MLLVAR 140801 . 141114) (COMP.MLLFN 141116 . 141508)) (142527 148126 (
|
||||
OPT.RESOLVEJUMPS 142537 . 143608) (OPT.JLENPASS 143610 . 146975) (OPT.JFIXPASS 146977 . 147680) (
|
||||
OPT.JSIZE 147682 . 148124)) (148172 151031 (OPT.CALLP 148182 . 148660) (OPT.JUMPCHECK 148662 . 148878)
|
||||
(OPT.DREV 148880 . 149079) (OPT.CHLEV 149081 . 149292) (OPT.CHECKTAG 149294 . 149673) (OPT.NOTJUMP
|
||||
149675 . 150180) (OPT.INITHASH 150182 . 150559) (OPT.COMPINIT 150561 . 151029)) (151225 151996 (
|
||||
OPT.CFRPTQ 151235 . 151994)) (153051 159997 (COMP.AREF 153061 . 154152) (COMP.ASET 154154 . 155247) (
|
||||
COMP.BOX 155249 . 155899) (COMP.LOOKFORDECLARE 155901 . 156454) (COMP.DECLARETYPE 156456 . 157060) (
|
||||
COMP.FLOATBOX 157062 . 157316) (COMP.FLOATUNBOX 157318 . 158288) (COMP.PREDP 158290 . 158493) (
|
||||
COMP.UBFLOAT2 158495 . 159062) (COMP.UNBOX 159064 . 159995)) (160064 218417 (OPT.POSTOPT 160074 .
|
||||
161970) (OPT.SETUPOPT 161972 . 164298) (OPT.SCANOPT 164300 . 173119) (OPT.XVARSCAN 173121 . 174296) (
|
||||
OPT.XVARSCAN1 174298 . 174941) (OPT.JUMPOPT 174943 . 175573) (OPT.JUMPTHRU 175575 . 182498) (
|
||||
OPT.LBMERGE 182500 . 183138) (OPT.PRDEL 183140 . 183622) (OPT.UBDEL 183624 . 183881) (OPT.LBDEL 183883
|
||||
. 184635) (OPT.LABELNTHPR 184637 . 185627) (OPT.JUMPREV 185629 . 198988) (OPT.COMMONBACK 198990 .
|
||||
201957) (OPT.DELTAGREF 201959 . 202837) (OPT.FINDEND 202839 . 203199) (OPT.RETOPT 203201 . 204639) (
|
||||
OPT.RETFIND 204641 . 205116) (OPT.RETPOP 205118 . 207604) (OPT.RETOPT1 207606 . 208001) (OPT.RETTEST
|
||||
208003 . 211618) (OPT.RETMERGE 211620 . 215060) (OPT.CODELEV 215062 . 217067) (OPT.CODEFRAME 217069 .
|
||||
217895) (OPT.DEFREFS 217897 . 218136) (OPT.SETDEFREFS 218138 . 218415)) (218418 239190 (OPT.FRAMEOPT
|
||||
218428 . 219579) (OPT.FRAMEMERGE 219581 . 222713) (OPT.NONILVAR 222715 . 223859) (OPT.MERGEFRAMEP
|
||||
223861 . 225328) (OPT.FRAMELOCAL 225330 . 226147) (OPT.CLEANFRAME 226149 . 226666) (OPT.FRAMEDEL
|
||||
226668 . 234584) (OPT.FRAMEVAR 234586 . 238394) (OPT.DELETEFRAMECHECK 238396 . 238993) (OPT.ONLYMEMB
|
||||
238995 . 239188)) (239272 248086 (OPT.SKIPPUSH 239282 . 241705) (OPT.DELCODE 241707 . 243151) (
|
||||
OPT.PRATTACH 243153 . 243626) (OPT.JUMPCOPYTEST 243628 . 244572) (OPT.EQOP 244574 . 245757) (
|
||||
OPT.EQVALUE 245759 . 246866) (OPT.DELCOPYFN 246868 . 248084)) (248087 250651 (OPT.DEADSETQP 248097 .
|
||||
248600) (OPT.DS1 248602 . 250649)) (254317 259058 (OPT.COMPILERERROR 254327 . 254505) (OPT.OPTCHECK
|
||||
254507 . 258909) (OPT.CCHECK 258911 . 259056)))))
|
||||
(FILEMAP (NIL (9282 19184 (BYTEBLOCKCOMPILE2 9292 . 11909) (BYTECOMPILE2 11911 . 12150) (
|
||||
COMP.ATTEMPT.COMPILE 12152 . 13296) (COMP.RETFROM.POINT 13298 . 13988) (COMP.TRANSFORM 13990 . 17453)
|
||||
(COMPERROR 17455 . 17814) (COMPPRINT 17816 . 18040) (COMPERRM 18042 . 19182)) (19185 28832 (
|
||||
COMP.TOPLEVEL.COMPILE 19195 . 25301) (COMP.BINDLIST 25303 . 25621) (COMP.CHECK.VAR 25623 . 26127) (
|
||||
COMP.BIND.VARS 26129 . 28420) (COMP.UNBIND.VARS 28422 . 28830)) (28833 43012 (COMP.VALN 28843 . 28976)
|
||||
(COMP.PROGN 28978 . 29706) (COMP.PROGLST 29708 . 30606) (COMP.EXP1 30608 . 30756) (COMP.EXPR 30758 .
|
||||
35484) (COMP.TRYUSERFN 35486 . 35815) (COMP.USERFN 35817 . 36738) (COMP.CONST 36740 . 37801) (
|
||||
COMP.CALL 37803 . 39242) (COMP.VAR 39244 . 39723) (COMP.VAL1 39725 . 39858) (COMP.PROG1 39860 . 40288)
|
||||
(COMP.EFFECT 40290 . 40869) (COMP.VAL 40871 . 41494) (COMP.MACRO 41496 . 43010)) (43013 45216 (
|
||||
COMP.VARTYPE 43023 . 43252) (COMP.LOOKUPVAR 43254 . 44726) (COMP.LOOKUPCONST 44728 . 45214)) (45217
|
||||
52728 (COMP.ST 45227 . 45730) (COMP.STFN 45732 . 46126) (COMP.STCONST 46128 . 46297) (COMP.STVAR 46299
|
||||
. 46435) (COMP.STPOP 46437 . 46600) (COMP.DELFN 46602 . 46840) (COMP.STRETURN 46842 . 47014) (
|
||||
COMP.STTAG 47016 . 47986) (COMP.STJUMP 47988 . 50004) (COMP.STSETQ 50006 . 50274) (COMP.STCOPY 50276
|
||||
. 50456) (COMP.DELPUSH 50458 . 50622) (COMP.DELPOP 50624 . 50792) (COMP.STBIND 50794 . 52188) (
|
||||
COMP.STUNBIND 52190 . 52726)) (57149 60337 (COMP.ARGTYPE 57159 . 58328) (COMP.CLEANEXPP 58330 . 58646)
|
||||
(COMP.CLEANFNP 58648 . 59062) (COMP.CLEANFNOP 59064 . 59212) (COMP.GLOBALVARP 59214 . 59392) (
|
||||
COMP.LINKCALLP 59394 . 59858) (COMP.ANONP 59860 . 60215) (COMP.NOSIDEEFFECTP 60217 . 60335)) (60338
|
||||
63585 (COMP.CPI 60348 . 62156) (COMP.CPI1 62158 . 62887) (COMP.PICOUNT 62889 . 63583)) (63629 63830 (
|
||||
COMP.EVQ 63639 . 63828)) (63942 66674 (COMP.BOOL 63952 . 66672)) (66675 67203 (COMP.APPLYFNP 66685 .
|
||||
67201)) (67245 67827 (COMP.AC 67255 . 67451) (COMP.PUNT 67453 . 67825)) (67881 69507 (COMP.FUNCTION
|
||||
67891 . 68311) (COMP.LAM1 68313 . 69167) (COMP.GENFN 69169 . 69505)) (69717 79673 (COMP.COND 69727 .
|
||||
72816) (COMP.IF 72818 . 74291) (COMP.SELECTQ 74293 . 79671)) (79860 80390 (COMP.QUOTE 79870 . 80104) (
|
||||
COMP.COMMENT 80106 . 80388)) (80442 83430 (COMP.DECLARE 80452 . 82336) (COMP.DECLARE1 82338 . 83428))
|
||||
(86346 87253 (COMP.CARCDR 86356 . 87040) (COMP.STCROP 87042 . 87251)) (87341 87680 (COMP.NOT 87351 .
|
||||
87678)) (87771 88508 (COMP.SETQ 87781 . 88278) (COMP.SETN 88280 . 88506)) (88509 92484 (COMP.LAMBDA
|
||||
88519 . 92482)) (92733 104617 (COMP.PROG 92743 . 96513) (COMP.GO 96515 . 97533) (COMP.RETURN 97535 .
|
||||
99212) (COMP.BLOCK 99214 . 100820) (COMP.RETURN-FROM 100822 . 102972) (COMP.TAGBODY 102974 . 104615))
|
||||
(104670 107176 (COMP.LABELS 104680 . 107174)) (110623 120362 (COMP.NUMERIC 110633 . 115447) (
|
||||
COMP.NUMBERCALL 115449 . 119039) (COMP.FIX 119041 . 119193) (COMP.STFIX 119195 . 119784) (COMP.DELFIX
|
||||
119786 . 120360)) (120490 122335 (COMP.EQ 120500 . 122333)) (122397 125905 (COMP.NUMBERTEST 122407 .
|
||||
125903)) (127408 134940 (COMP.MAP 127418 . 134938)) (137223 141414 (COMP.MLLIST 137233 . 137926) (
|
||||
COMP.MLL 137928 . 140703) (COMP.MLLVAR 140705 . 141018) (COMP.MLLFN 141020 . 141412)) (142431 148030 (
|
||||
OPT.RESOLVEJUMPS 142441 . 143512) (OPT.JLENPASS 143514 . 146879) (OPT.JFIXPASS 146881 . 147584) (
|
||||
OPT.JSIZE 147586 . 148028)) (148076 150935 (OPT.CALLP 148086 . 148564) (OPT.JUMPCHECK 148566 . 148782)
|
||||
(OPT.DREV 148784 . 148983) (OPT.CHLEV 148985 . 149196) (OPT.CHECKTAG 149198 . 149577) (OPT.NOTJUMP
|
||||
149579 . 150084) (OPT.INITHASH 150086 . 150463) (OPT.COMPINIT 150465 . 150933)) (151129 151900 (
|
||||
OPT.CFRPTQ 151139 . 151898)) (152915 159861 (COMP.AREF 152925 . 154016) (COMP.ASET 154018 . 155111) (
|
||||
COMP.BOX 155113 . 155763) (COMP.LOOKFORDECLARE 155765 . 156318) (COMP.DECLARETYPE 156320 . 156924) (
|
||||
COMP.FLOATBOX 156926 . 157180) (COMP.FLOATUNBOX 157182 . 158152) (COMP.PREDP 158154 . 158357) (
|
||||
COMP.UBFLOAT2 158359 . 158926) (COMP.UNBOX 158928 . 159859)) (159928 218281 (OPT.POSTOPT 159938 .
|
||||
161834) (OPT.SETUPOPT 161836 . 164162) (OPT.SCANOPT 164164 . 172983) (OPT.XVARSCAN 172985 . 174160) (
|
||||
OPT.XVARSCAN1 174162 . 174805) (OPT.JUMPOPT 174807 . 175437) (OPT.JUMPTHRU 175439 . 182362) (
|
||||
OPT.LBMERGE 182364 . 183002) (OPT.PRDEL 183004 . 183486) (OPT.UBDEL 183488 . 183745) (OPT.LBDEL 183747
|
||||
. 184499) (OPT.LABELNTHPR 184501 . 185491) (OPT.JUMPREV 185493 . 198852) (OPT.COMMONBACK 198854 .
|
||||
201821) (OPT.DELTAGREF 201823 . 202701) (OPT.FINDEND 202703 . 203063) (OPT.RETOPT 203065 . 204503) (
|
||||
OPT.RETFIND 204505 . 204980) (OPT.RETPOP 204982 . 207468) (OPT.RETOPT1 207470 . 207865) (OPT.RETTEST
|
||||
207867 . 211482) (OPT.RETMERGE 211484 . 214924) (OPT.CODELEV 214926 . 216931) (OPT.CODEFRAME 216933 .
|
||||
217759) (OPT.DEFREFS 217761 . 218000) (OPT.SETDEFREFS 218002 . 218279)) (218282 239054 (OPT.FRAMEOPT
|
||||
218292 . 219443) (OPT.FRAMEMERGE 219445 . 222577) (OPT.NONILVAR 222579 . 223723) (OPT.MERGEFRAMEP
|
||||
223725 . 225192) (OPT.FRAMELOCAL 225194 . 226011) (OPT.CLEANFRAME 226013 . 226530) (OPT.FRAMEDEL
|
||||
226532 . 234448) (OPT.FRAMEVAR 234450 . 238258) (OPT.DELETEFRAMECHECK 238260 . 238857) (OPT.ONLYMEMB
|
||||
238859 . 239052)) (239136 247950 (OPT.SKIPPUSH 239146 . 241569) (OPT.DELCODE 241571 . 243015) (
|
||||
OPT.PRATTACH 243017 . 243490) (OPT.JUMPCOPYTEST 243492 . 244436) (OPT.EQOP 244438 . 245621) (
|
||||
OPT.EQVALUE 245623 . 246730) (OPT.DELCOPYFN 246732 . 247948)) (247951 250515 (OPT.DEADSETQP 247961 .
|
||||
248464) (OPT.DS1 248466 . 250513)) (254181 258922 (OPT.COMPILERERROR 254191 . 254369) (OPT.OPTCHECK
|
||||
254371 . 258773) (OPT.CCHECK 258775 . 258920)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
110
sources/CMLREAD
110
sources/CMLREAD
@@ -1,34 +1,36 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Jan-93 10:25:51" {DSK}<python>lde>lispcore>sources>CMLREAD.;2 15363
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 08:09:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;9 12772
|
||||
|
||||
changes to%: (RECORDS READER-ENVIRONMENT)
|
||||
|
||||
previous date%: " 4-Jan-93 17:53:43" {DSK}<python>lde>lispcore>sources>CMLREAD.;1)
|
||||
previous date%: " 3-Jul-2021 13:32:59"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;8)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CMLREADCOMS)
|
||||
|
||||
(RPAQQ CMLREADCOMS
|
||||
(RPAQQ CMLREADCOMS
|
||||
[(COMS
|
||||
(* ;; "Misc Common Lisp reader functions")
|
||||
(* ;; "Misc Common Lisp reader functions")
|
||||
|
||||
(FNS CL:COPY-READTABLE)
|
||||
(FNS CL:READ-LINE CL:READ-CHAR CL:UNREAD-CHAR CL:PEEK-CHAR CL:LISTEN
|
||||
CL:READ-CHAR-NO-HANG CL:CLEAR-INPUT CL:READ-FROM-STRING CL:READ-BYTE CL:WRITE-BYTE
|
||||
)
|
||||
(* ;
|
||||
"must turn off packed version of CLISP infix")
|
||||
(* ;
|
||||
"must turn off packed version of CLISP infix")
|
||||
(VARS [CLISPCHARS (LDIFFERENCE CLISPCHARS '(- *]
|
||||
(CLISPCHARRAY (MAKEBITTABLE CLISPCHARS))
|
||||
(DWIMINMACROSFLG))
|
||||
(VARIABLES *READ-DEFAULT-FLOAT-FORMAT*)
|
||||
(GLOBALVARS CMLRDTBL READ-LINE-RDTBL))
|
||||
[COMS
|
||||
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
|
||||
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
|
||||
|
||||
(RECORDS READER-ENVIRONMENT)
|
||||
(FUNCTIONS WITH-READER-ENVIRONMENT)
|
||||
@@ -37,7 +39,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
(GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*)
|
||||
(INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _
|
||||
(CL:FIND-PACKAGE "USER")
|
||||
REREADTABLE _ CMLRDTBL REBASE _ 10]
|
||||
REREADTABLE _ CMLRDTBL REBASE _ 10
|
||||
REFORMAT _ :XCCS]
|
||||
(PROP FILETYPE CMLREAD)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
@@ -93,9 +96,9 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
(CL:READ-CHAR
|
||||
[CL:LAMBDA (&OPTIONAL (STREAM *STANDARD-INPUT*)
|
||||
(EOF-ERRORP T)
|
||||
EOF-VALUE RECURSIVE-P) (* ; "Edited 14-Dec-86 20:41 by bvm:")
|
||||
EOF-VALUE RECURSIVE-P) (* ; "Edited 14-Dec-86 20:41 by bvm:")
|
||||
|
||||
(* ;; "Inputs a character from STREAM and returns it.")
|
||||
(* ;; "Inputs a character from STREAM and returns it.")
|
||||
|
||||
(LET [(STREAM (\GETSTREAM STREAM 'INPUT]
|
||||
(COND
|
||||
@@ -106,12 +109,12 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
(T (CL:CODE-CHAR (READCCODE STREAM])
|
||||
|
||||
(CL:UNREAD-CHAR
|
||||
(CL:LAMBDA (CHARACTER &OPTIONAL (INPUT-STREAM *STANDARD-INPUT*))
|
||||
(* bvm%: "13-Oct-86 15:44")
|
||||
(CL:LAMBDA (CHARACTER &OPTIONAL (INPUT-STREAM *STANDARD-INPUT*))
|
||||
(* ; "Edited 23-Jun-2021 13:05 by rmk:")
|
||||
|
||||
(* ;; "Puts the CHARACTER back on the front of the input STREAM. According to the manual, `One may apply UNREAD-CHAR only to the character most recently read from INPUT-STREAM.'")
|
||||
(* ;; "Puts the CHARACTER back on the front of the input STREAM. According to the manual, `One may apply UNREAD-CHAR only to the character most recently read from INPUT-STREAM.'")
|
||||
|
||||
(\BACKCHAR (\GETSTREAM INPUT-STREAM 'INPUT))
|
||||
(\BACKCCODE (\GETSTREAM INPUT-STREAM 'INPUT))
|
||||
NIL))
|
||||
|
||||
(CL:PEEK-CHAR
|
||||
@@ -237,28 +240,31 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE RESPEC))
|
||||
(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE NIL REFORMAT))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER)
|
||||
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER)
|
||||
'((READER-ENVIRONMENT 0 POINTER)
|
||||
(READER-ENVIRONMENT 2 POINTER)
|
||||
(READER-ENVIRONMENT 4 POINTER)
|
||||
(READER-ENVIRONMENT 6 POINTER))
|
||||
'8)
|
||||
(READER-ENVIRONMENT 6 POINTER)
|
||||
(READER-ENVIRONMENT 8 POINTER))
|
||||
'10)
|
||||
|
||||
(DEFMACRO WITH-READER-ENVIRONMENT (ENV . BODY)
|
||||
`((CL:LAMBDA (E)
|
||||
(LET ((*PACKAGE* (ffetch (READER-ENVIRONMENT REPACKAGE) of E))
|
||||
(*READTABLE* (ffetch (READER-ENVIRONMENT REREADTABLE) of E))
|
||||
(*READ-BASE* (ffetch (READER-ENVIRONMENT REBASE) of E))
|
||||
(*PRINT-BASE* (ffetch (READER-ENVIRONMENT REBASE) of E)))
|
||||
(*PRINT-BASE* (ffetch (READER-ENVIRONMENT REBASE) of E))
|
||||
(*EXTERNALFORMAT* (ffetch (READER-ENVIRONMENT REFORMAT) of E)))
|
||||
(DECLARE (SPECVARS *EXTERNALFORMAT*))
|
||||
,@BODY))
|
||||
(\DTEST ,ENV 'READER-ENVIRONMENT)))
|
||||
|
||||
(ADDTOVAR SYSSPECVARS *PACKAGE* *READTABLE* *READ-BASE* *PRINT-BASE*)
|
||||
|
||||
(PUTPROPS WITH-READER-ENVIRONMENT INFO EVAL)
|
||||
(PUTPROPS WITH-READER-ENVIRONMENT INFO EVAL)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*)
|
||||
@@ -266,9 +272,9 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQ? *COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _ (CL:FIND-PACKAGE
|
||||
"USER")
|
||||
REREADTABLE _ CMLRDTBL REBASE _ 10))
|
||||
REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :XCCS))
|
||||
|
||||
(PUTPROPS CMLREAD FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS CMLREAD FILETYPE CL:COMPILE-FILE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
@@ -279,56 +285,10 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
CL:LISTEN CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE
|
||||
CL:COPY-READTABLE)
|
||||
)
|
||||
(PRETTYCOMPRINT CMLREADCOMS)
|
||||
|
||||
(RPAQQ CMLREADCOMS [(COMS
|
||||
(* ;; "Misc Common Lisp reader functions")
|
||||
|
||||
(FNS CL:COPY-READTABLE)
|
||||
(FNS CL:READ-LINE CL:READ-CHAR CL:UNREAD-CHAR CL:PEEK-CHAR CL:LISTEN
|
||||
CL:READ-CHAR-NO-HANG CL:CLEAR-INPUT CL:READ-FROM-STRING
|
||||
CL:READ-BYTE CL:WRITE-BYTE)
|
||||
(* ;
|
||||
"must turn off packed version of CLISP infix")
|
||||
(VARS [CLISPCHARS (LDIFFERENCE CLISPCHARS '(- *]
|
||||
(CLISPCHARRAY (MAKEBITTABLE CLISPCHARS))
|
||||
(DWIMINMACROSFLG))
|
||||
(VARIABLES *READ-DEFAULT-FLOAT-FORMAT*)
|
||||
(GLOBALVARS CMLRDTBL READ-LINE-RDTBL))
|
||||
[COMS
|
||||
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
|
||||
|
||||
(RECORDS READER-ENVIRONMENT)
|
||||
(FUNCTIONS WITH-READER-ENVIRONMENT)
|
||||
(ADDVARS (SYSSPECVARS *PACKAGE* *READTABLE* *READ-BASE* *PRINT-BASE*))
|
||||
(PROP INFO WITH-READER-ENVIRONMENT)
|
||||
(GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*)
|
||||
(INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT
|
||||
REPACKAGE _
|
||||
(CL:FIND-PACKAGE
|
||||
"USER")
|
||||
REREADTABLE _ CMLRDTBL
|
||||
REBASE _ 10]
|
||||
(PROP FILETYPE CMLREAD)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT
|
||||
CL:READ-CHAR-NO-HANG CL:PEEK-CHAR CL:UNREAD-CHAR
|
||||
CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE])
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR
|
||||
CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
|
||||
)
|
||||
(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993))
|
||||
(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2481 3466 (CL:COPY-READTABLE 2491 . 3464)) (3467 10087 (CL:READ-LINE 3477 . 4349) (
|
||||
CL:READ-CHAR 4351 . 4901) (CL:UNREAD-CHAR 4903 . 5351) (CL:PEEK-CHAR 5353 . 7337) (CL:LISTEN 7339 .
|
||||
7604) (CL:READ-CHAR-NO-HANG 7606 . 8378) (CL:CLEAR-INPUT 8380 . 8617) (CL:READ-FROM-STRING 8619 . 9374
|
||||
) (CL:READ-BYTE 9376 . 9829) (CL:WRITE-BYTE 9831 . 10085)))))
|
||||
(FILEMAP (NIL (2592 3577 (CL:COPY-READTABLE 2602 . 3575)) (3578 10211 (CL:READ-LINE 3588 . 4460) (
|
||||
CL:READ-CHAR 4462 . 5012) (CL:UNREAD-CHAR 5014 . 5475) (CL:PEEK-CHAR 5477 . 7461) (CL:LISTEN 7463 .
|
||||
7728) (CL:READ-CHAR-NO-HANG 7730 . 8502) (CL:CLEAR-INPUT 8504 . 8741) (CL:READ-FROM-STRING 8743 . 9498
|
||||
) (CL:READ-BYTE 9500 . 9953) (CL:WRITE-BYTE 9955 . 10209)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
523
sources/COMPILE
523
sources/COMPILE
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "27-Jul-90 11:15:42" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>COMPILE.;4| 68945
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 5-Jul-2021 13:46:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COMPILE.;4 77731
|
||||
|
||||
changes to%: (FNS BRECOMPILE)
|
||||
changes to%: (FNS BCOMPL BCOMPL.BODY)
|
||||
|
||||
previous date%: " 8-Jun-90 11:48:47" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>COMPILE.;3|)
|
||||
previous date%: " 5-Jul-2021 09:31:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>COMPILE.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1990, 2021 by Venue & Xerox Corporation.
|
||||
The following program was created in 1984 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
|
||||
@@ -16,11 +18,71 @@ with the terms of said license.
|
||||
|
||||
(PRETTYCOMPRINT COMPILECOMS)
|
||||
|
||||
(RPAQQ COMPILECOMS ((FNS BCOMPL BCOMPL.BODY PRINT-COMPILE-HEADER RESETOPENFILES BCOMPL1A BCOMPL2 BCOMPL3 BLOCK%: BRECOMPILE BRECOMPILE1 BRECOMPILE2 BRECOMPILE3 BLOCKCOMPILE BLOCKCOMPILE1 COMPSET COMPSETREAD COMPSETY COMPSETF RCOMP3 TCOMPL RECOMPILE RECOMP? COMPILE COMPILE1 COMPILE1A SHOULD-BE-DWIMIFIED? COMPILE.FILECHECK COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS) (ADDVARS (NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL) (LINKFNS) (FREEVARS) (SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS GLOBALVARS) (SYSLOCALVARS) (LOCALFREEVARS) (BLKLIBRARY) (RETFNS) (BLKAPPLYFNS) (DONTCOMPILEFNS) (NLAML) (NLAMA) (LAMS) (LAMA)) (INITVARS (SPECVARS T) (LOCALVARS SYSLOCALVARS)) (INITVARS (DWIMIFYCOMPFLG NIL) (COMPILEHEADER "compiled on ") (COMPSETLST (QUOTE (ST F STF S Y N 1 2 NIL T))) (COMPSETKEYLST (QUOTE ((ST "ore and redefine " KEYLST ("" (F . "orget exprs"))) (S . "ame as last time") (F . "ile only") (T . "o terminal") (1) (2) (Y . "es") (N . "o")))) (COMPSETDEFAULTKEYLST (QUOTE ((Y . "es") (N . "o")))) (BCOMPL.SCRATCH (QUOTE {CORE}BCOMPL.SCRATCH)) (RECOMPILEDEFAULT (QUOTE CHANGES)) (COUTFILE T) (SVFLG T) (STRF T) (LSTFIL T) (LCFIL) (LAPFLG T)) (DECLARE%: DONTCOPY (RECORDS COMPFILEDESCR) (MACROS DIGITCHARP) (GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES BYTECOMPFLG COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0 NOFIXFNSLST0 CLISPTRANFLG CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0 LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL DWIMFLG DWIMWAIT)) (P (MOVD? (QUOTE NILL) (QUOTE FILECHANGES)) (CL:PROCLAIM (QUOTE (CL:SPECIAL COMPVARMACROHASH))) (CL:PROCLAIM (QUOTE (GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY)))) (COMS (* ; "COMPILEMODE") (PROP VARTYPE COMPILEMODELST) (FNS COMPILEMODE)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:) (NLAML BCOMPL3) (LAMA)))))
|
||||
(RPAQQ COMPILECOMS
|
||||
[(FNS BCOMPL BCOMPL.BODY PRINT-COMPILE-HEADER RESETOPENFILES BCOMPL1A BCOMPL2 BCOMPL3 BLOCK%:
|
||||
BRECOMPILE BRECOMPILE1 BRECOMPILE2 BRECOMPILE3 BLOCKCOMPILE BLOCKCOMPILE1 COMPSET
|
||||
COMPSETREAD COMPSETY COMPSETF RCOMP3 TCOMPL RECOMPILE RECOMP? COMPILE COMPILE1 COMPILE1A
|
||||
SHOULD-BE-DWIMIFIED? COMPILE.FILECHECK COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS)
|
||||
(ADDVARS (NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1
|
||||
EDITE EDITL)
|
||||
(LINKFNS)
|
||||
(FREEVARS)
|
||||
(SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS
|
||||
GLOBALVARS)
|
||||
(SYSLOCALVARS)
|
||||
(LOCALFREEVARS)
|
||||
(BLKLIBRARY)
|
||||
(RETFNS)
|
||||
(BLKAPPLYFNS)
|
||||
(DONTCOMPILEFNS)
|
||||
(NLAML)
|
||||
(NLAMA)
|
||||
(LAMS)
|
||||
(LAMA))
|
||||
(INITVARS (SPECVARS T)
|
||||
(LOCALVARS SYSLOCALVARS))
|
||||
(INITVARS (DWIMIFYCOMPFLG NIL)
|
||||
(COMPILEHEADER "compiled on ")
|
||||
(COMPSETLST '(ST F STF S Y N 1 2 NIL T))
|
||||
[COMPSETKEYLST '((ST "ore and redefine " KEYLST ("" (F . "orget exprs")))
|
||||
(S . "ame as last time")
|
||||
(F . "ile only")
|
||||
(T . "o terminal")
|
||||
(1)
|
||||
(2)
|
||||
(Y . "es")
|
||||
(N . "o"]
|
||||
[COMPSETDEFAULTKEYLST '((Y . "es")
|
||||
(N . "o"]
|
||||
(BCOMPL.SCRATCH '{CORE}BCOMPL.SCRATCH)
|
||||
(RECOMPILEDEFAULT 'CHANGES)
|
||||
(COUTFILE T)
|
||||
(SVFLG T)
|
||||
(STRF T)
|
||||
(LSTFIL T)
|
||||
(LCFIL)
|
||||
(LAPFLG T))
|
||||
(DECLARE%: DONTCOPY (RECORDS COMPFILEDESCR)
|
||||
(MACROS DIGITCHARP)
|
||||
(GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES
|
||||
BYTECOMPFLG COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0
|
||||
NOFIXFNSLST0 CLISPTRANFLG CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0
|
||||
LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL DWIMFLG DWIMWAIT))
|
||||
[P (MOVD? 'NILL 'FILECHANGES)
|
||||
(CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH))
|
||||
(CL:PROCLAIM '(GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY
|
||||
FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY]
|
||||
(COMS (* ; "COMPILEMODE")
|
||||
(PROP VARTYPE COMPILEMODELST)
|
||||
(FNS COMPILEMODE))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
(ADDVARS (NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:)
|
||||
(NLAML BCOMPL3)
|
||||
(LAMA])
|
||||
(DEFINEQ
|
||||
|
||||
(BCOMPL
|
||||
[LAMBDA (FILES CFILE NOBLOCKSFLG OPTIONSSET) (* ; "Edited 9-Feb-87 16:22 by Pavel")
|
||||
[LAMBDA (FILES CFILE NOBLOCKSFLG OPTIONSSET) (* ; "Edited 5-Jul-2021 13:39 by rmk:")
|
||||
|
||||
(* ;;; "BCOMPL is like TCOMPL, except that it reads in all of FILES before starting any compilations, so that a BLOCK can contain functions in several FILES. BLOCKS are set up using a DECLARE statement of the form")
|
||||
|
||||
@@ -28,29 +90,32 @@ with the terms of said license.
|
||||
|
||||
(* ;;; "where BLKFN1 ... are the functions in the BLOCK, and VAR1 ... are values for ENTRIES, RETFNS, SPECVARS, etc. A variable setting of the form (VAR . list) sets variable to UNION of the list with the variable's top level value. A variable setting of the form (VAR . ATOM) simply sets the variable to that atom, e.g. (NOLINKFLG . T)")
|
||||
|
||||
(RESETLST (LET ((NLAML NLAML)
|
||||
(NLAMA NLAMA)
|
||||
(LAMS LAMS)
|
||||
(LAMA LAMA)
|
||||
(DWIMIFYCOMPFLG DWIMIFYCOMPFLG)
|
||||
(EXPRSLST NIL)
|
||||
(NOFIXVARSLST NOFIXVARSLST)
|
||||
(NOFIXFNSLST NOFIXFNSLST)
|
||||
(*PRINT-ARRAY* T)
|
||||
(*PRINT-LENGTH* NIL)
|
||||
(*PRINT-LEVEL* NIL))
|
||||
(DECLARE (SPECVARS NLAML NLAMA LAMS LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXVARSLST
|
||||
NOFIXFNSLST *PRINT-ARRAY* *PRINT-LEVEL* *PRINT-LENGTH*))
|
||||
(SETQ FILES (RESETOPENFILES FILES))
|
||||
|
||||
(* ;; "Checks that all FILES are there, and if not, attempts spelling correction. Opens them for input, too, and returns the input stream")
|
||||
(RESETLST
|
||||
(LET ((NLAML NLAML)
|
||||
(NLAMA NLAMA)
|
||||
(LAMS LAMS)
|
||||
(LAMA LAMA)
|
||||
(DWIMIFYCOMPFLG DWIMIFYCOMPFLG)
|
||||
(EXPRSLST NIL)
|
||||
(NOFIXVARSLST NOFIXVARSLST)
|
||||
(NOFIXFNSLST NOFIXFNSLST)
|
||||
(*PRINT-ARRAY* T)
|
||||
(*PRINT-LENGTH* NIL)
|
||||
(*PRINT-LEVEL* NIL))
|
||||
(DECLARE (SPECVARS NLAML NLAMA LAMS LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXVARSLST
|
||||
NOFIXFNSLST *PRINT-ARRAY* *PRINT-LEVEL* *PRINT-LENGTH*))
|
||||
|
||||
(BCOMPL.BODY FILES CFILE NOBLOCKSFLG OPTIONSSET])
|
||||
(* ;; "Checks that all FILES are there, and if not, attempts spelling correction. Opens them for input, too, and returns the input stream")
|
||||
|
||||
(BCOMPL.BODY (RESETOPENFILES FILES)
|
||||
CFILE NOBLOCKSFLG OPTIONSSET)))])
|
||||
|
||||
(BCOMPL.BODY
|
||||
[LAMBDA (FILES CFILE NOBLOCKSFLG OPTIONSSET) (* bvm%: "13-Oct-86 17:07")
|
||||
[LAMBDA (STREAMS CFILE NOBLOCKSFLG OPTIONSSET) (* ; "Edited 5-Jul-2021 13:46 by rmk:")
|
||||
|
||||
(* ;;; "FILES is a list of streams. Compile everything on them, dumping to CFILE (default first stream.dcom). NOBLOCKSFLG means TCOMPL instead of BCOMPL. OPTIONSSET is true if the Listing? question has already been asked.")
|
||||
(* ;;; "STREAMS is a list of streams. Compile everything on them, dumping to CFILE (default first stream.dcom). NOBLOCKSFLG means TCOMPL instead of BCOMPL. OPTIONSSET is true if the Listing? question has already been asked.")
|
||||
|
||||
(* ;;; "RMK: Apply each input streams \EXTERNALFORMAT")
|
||||
|
||||
(DECLARE (SPECVARS CFILE))
|
||||
(PROG ((SPECVARS T)
|
||||
@@ -60,78 +125,87 @@ with the terms of said license.
|
||||
(DECLARE (SPECVARS SPECVARS LOCALVARS CHANGES OTHERS FIRST BLOCKS BLKFNS
|
||||
DESTINATIONENV DEFS))
|
||||
[OR OPTIONSSET (COMPSET NIL '(F %
|
||||
] (* ;
|
||||
"OPTIONSSET is T on calls from TCOMPL. In this case, the first COMPSET has already been performed.")
|
||||
] (* ;
|
||||
"OPTIONSSET is T on calls from TCOMPL. In this case, the first COMPSET has already been performed.")
|
||||
(COMPSET (OR CFILE (PACKFILENAME 'HOST [CADR (FMEMB 'HOST (SETQ UNPACKFILE
|
||||
(UNPACKFILENAME (CAR FILES]
|
||||
(UNPACKFILENAME (CAR STREAMS
|
||||
]
|
||||
'DIRECTORY
|
||||
(CADR (FMEMB 'DIRECTORY UNPACKFILE))
|
||||
'NAME
|
||||
(SETQ FILEROOT (CADR (FMEMB 'NAME UNPACKFILE)))
|
||||
'EXTENSION COMPILE.EXT)))
|
||||
|
||||
(* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")
|
||||
(* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")
|
||||
|
||||
[COND
|
||||
(LCFIL (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW]
|
||||
(RESETSAVE NIL (LIST 'BCOMPL3 NIL FILES SCRATCHFILE))
|
||||
(RESETSAVE NIL (LIST 'BCOMPL3 NIL STREAMS SCRATCHFILE))
|
||||
|
||||
(* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")
|
||||
(* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")
|
||||
|
||||
[LET (DFNFLG)
|
||||
|
||||
(* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T. i.e. make BCOMPL1A equivalent to doing a LOADCOMP")
|
||||
(* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T. i.e. make BCOMPL1A equivalent to doing a LOADCOMP")
|
||||
|
||||
(for STREAM in FILES
|
||||
(for STREAM in STREAMS
|
||||
do (RESETLST
|
||||
(RESETSAVE NIL (LIST 'CLOSEF STREAM))
|
||||
(RESETSAVE (INPUT STREAM)) (* ;
|
||||
"Needs to be primary input for some of the filepkg expressions to work")
|
||||
(RESETSAVE (INPUT STREAM)) (* ;
|
||||
"Needs to be primary input for some of the filepkg expressions to work")
|
||||
(WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
|
||||
(until (OR (NULL (SETQ TEM (READ STREAM)))
|
||||
(EQ TEM 'STOP)) do (BCOMPL1A TEM 'DEFAULT
|
||||
'DEFAULT
|
||||
'DEFAULT))))]
|
||||
(EQ TEM 'STOP))
|
||||
do (CL:WHEN (EQ (CAR (LISTP TEM))
|
||||
'DEFINE-FILE-INFO)
|
||||
(\EXTERNALFORMAT STREAM (OR (LISTGET (CDR TEM)
|
||||
:FORMAT)
|
||||
:XCCS)))
|
||||
(BCOMPL1A TEM 'DEFAULT 'DEFAULT 'DEFAULT STREAM))))]
|
||||
(SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS (NCONC [MAPCAR DEFS (FUNCTION (LAMBDA (X)
|
||||
(RCOMP3
|
||||
(CAR X)
|
||||
(CADR X]
|
||||
NOFIXFNSLST)))
|
||||
|
||||
(* ;; "The BCOMPL1 reads in FILES. It returns a list of variables set in the files. The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions. NOFIXFNLST is reset in case there is any dwimifying to be done.")
|
||||
(* ;; "The BCOMPL1 reads in FILES. It returns a list of variables set in the files. The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions. NOFIXFNLST is reset in case there is any dwimifying to be done.")
|
||||
|
||||
(WITH-READER-ENVIRONMENT (OR DESTINATIONENV (SETQ DESTINATIONENV
|
||||
*OLD-INTERLISP-READ-ENVIRONMENT*))
|
||||
(COND
|
||||
(LCFIL (PRINT-COMPILE-HEADER FILES [LIST (COND
|
||||
(NOBLOCKSFLG 'tcompl'd)
|
||||
(T 'bcompl'd]
|
||||
(LCFIL (\EXTERNALFORMAT LCFIL (OR (FETCH (READER-ENVIRONMENT REFORMAT)
|
||||
OF DESTINATIONENV)
|
||||
:XCCS))
|
||||
(PRINT-COMPILE-HEADER STREAMS [LIST (COND
|
||||
(NOBLOCKSFLG 'tcompl'd)
|
||||
(T 'bcompl'd]
|
||||
DESTINATIONENV)))
|
||||
(COND
|
||||
(SCRATCHFILE
|
||||
|
||||
(* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.")
|
||||
(* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.")
|
||||
|
||||
(\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
|
||||
(for X in OTHERS do (PRINT X SCRATCHFILE))
|
||||
(PRINT NIL SCRATCHFILE)
|
||||
(SETQ OTHERS NIL)))
|
||||
[OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILEROOT 'FILETYPE]
|
||||
(* ;
|
||||
"The FILETYPE may have been set during the course of BCOMPL1.")
|
||||
(* ;
|
||||
"The FILETYPE may have been set during the course of BCOMPL1.")
|
||||
[MAPC FIRST (FUNCTION (LAMBDA (X)
|
||||
(PRINT X LCFIL]
|
||||
[PROG (LISPXHIST)
|
||||
(DECLARE (SPECVARS LISPXHIST))
|
||||
|
||||
(* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS. lispxhist rebound bcause no need to save information when compiling from file")
|
||||
(* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS. lispxhist rebound bcause no need to save information when compiling from file")
|
||||
|
||||
(AND NOBLOCKSFLG (GO NOBLOCKLP))
|
||||
BLOCKLP
|
||||
(COND
|
||||
(BLOCKS (BCOMPL2 (CAR BLOCKS))
|
||||
(SETQ BLOCKS (CDR BLOCKS))
|
||||
(GO BLOCKLP))) (* ;
|
||||
"COMPILE other functions. done this way instead of MAPC to release the defs as soon aspossible.")
|
||||
(GO BLOCKLP))) (* ;
|
||||
"COMPILE other functions. done this way instead of MAPC to release the defs as soon aspossible.")
|
||||
NOBLOCKLP
|
||||
(COND
|
||||
(DEFS (AND (NOT (FMEMB (CAAR DEFS)
|
||||
@@ -423,9 +497,240 @@ with the terms of said license.
|
||||
(SETQ BLOCKS (NCONC1 BLOCKS X))))
|
||||
|
||||
(BRECOMPILE
|
||||
(LAMBDA (FILES CFILE FNS NOBLOCKSFLG) (* ; "Edited 6-Jan-89 10:01 by jds") (* ;;; "FNS is a list of functions to be recompiled. The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.") (* ;;; "BRECOMPILE is driven by the source file(s). The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR. Otherwise copy its compiled definition from CFILE. Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied. This corresponds to the case where functions have been deleted from the source file.") (* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.") (* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).") (* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.") (RESETLST (PROG ((*PRINT-ARRAY* T) (*PRINT-LENGTH* NIL) (*PRINT-LEVEL* NIL) (NLAMA NLAMA) (NLAML NLAML) (LAMS LAMS) (LAMA LAMA) (DWIMIFYCOMPFLG DWIMIFYCOMPFLG) (EXPRSLST NIL) (NOFIXFNSLST NOFIXFNSLST) (NOFIXVARSLST NOFIXVARSLST) (BUILDMAPFLG T) (SPECVARS T) (LOCALVARS SYSLOCALVARS) (AUXFILECOM T) CHANGES OTHERS FIRST FILEMAPLST FNLST BLKFNS BLOCKS FILE FILE.COM TEM ADRLST SCRATCHFILE COREOK DESTINATIONENV MSG) (DECLARE (SPECVARS *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG SPECVARS LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS DESTINATIONENV ADRLST FILEMAPLST CFILE FNS FILE)) (COND ((AND (NULL CFILE) (NULL FNS)) (SETQ FNS RECOMPILEDEFAULT))) (RESETSAVE (INPUT)) (SETQ FILES (RESETOPENFILES FILES)) (COND ((SETQ TEM (for FILE in FILES when (NOT (RANDACCESSP FILE)) collect (FULLNAME FILE))) (GO NONRAND))) (SETQ FILE (UNPACKFILENAME (CAR FILES))) (SETQ FILE.COM (PACKFILENAME (QUOTE HOST) (CADR (FMEMB (QUOTE HOST) FILE)) (QUOTE DIRECTORY) (CADR (FMEMB (QUOTE DIRECTORY) FILE)) (QUOTE NAME) (SETQ FILE (CADR (FMEMB (QUOTE NAME) FILE))) (QUOTE EXTENSION) COMPILE.EXT)) (* ;; "Edited by TT (8-June-90 : for fix AR#2999)") (COND ((EQ FNS (QUOTE ALL)) (GO BRECALL))) CFILERETRY (COND ((NLSETQ (SETQ CFILE (OPENSTREAM (OR CFILE FILE.COM) (QUOTE INPUT) (QUOTE OLD) NIL (QUOTE ((TYPE BINARY)))))) (COND ((NOT (RANDACCESSP CFILE)) (SETQ TEM (CLOSEF CFILE)) (GO NONRAND)) ((OR (NULL (SETQ DESTINATIONENV (GET-ENVIRONMENT-AND-FILEMAP (CAR FILES)))) (CL:MULTIPLE-VALUE-BIND (ENV DUMMY START) (\PARSE-FILE-HEADER CFILE) (COND ((OR (NULL ENV) (NOT (EQUAL-READER-ENVIRONMENT ENV DESTINATIONENV))) T) (T (* "Position cfile back to start") (SETFILEPTR CFILE START) NIL)))) (SETQ TEM (CLOSEF CFILE)) (SETQ MSG " has different reader environment than the new file") (GO NONREC))) (GO BREC)) ((OR (AND (EQ AUXFILECOM T) (SETQ AUXFILECOM (SPELLFILE (ROOTFILENAME (OR CFILE FILE.COM)))) (SETQ CFILE AUXFILECOM) (GO CFILERETRY)) (EQ (ASKUSER DWIMWAIT (QUOTE Y) (LIST (OR CFILE FILE.COM) "not found;" " compile all functions on " (FULLNAME (CAR FILES)) (QUOTE "instead"))) (QUOTE Y))) (* ; "Edited by TT(8-June-90 : for Fix AR#8017)") (GO BRECALL)) ((EQ (ASKUSER DWIMWAIT (QUOTE Y) (CONS (QUOTE "Just forget about compiling") (MAPCAR FILES (FUNCTION FULLNAME)))) (QUOTE Y)) (SELECTQ (CAR READBUF) ((ST F STF) (* "E.g. From CLEANUP.") (SETQ READBUF (CDR READBUF))) NIL) (RETFROM (QUOTE BRECOMPILE))) (T (PRIN1 "File to use for CFILE (source of compiled definitions not being recompiled): " T) (SETQ CFILE (READ T T)) (GO CFILERETRY))) BRECALL (SETQQ FNS ALL) (SETQ CFILE NIL) BREC (COMPSET NIL (QUOTE (S T %
|
||||
))) (SETQ LCFIL (OPENSTREAM FILE.COM (QUOTE OUTPUT) (QUOTE NEW) NIL (QUOTE ((TYPE BINARY))))) (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH (QUOTE BOTH) (QUOTE NEW))) (RESETSAVE NIL (LIST (QUOTE BCOMPL3) CFILE FILES SCRATCHFILE)) (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs. Note that this call differs from the call for bcompl in that cfile is also specified. this corresponds to the fact that recompile has an extra file open.") (SETQ COREOK (for X in FILES always (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME X)) (QUOTE FILEDATES))) X) (FMEMB (CDAR (GETPROP TEM (QUOTE FILE))) (QUOTE (LOADFNS T)))))) (SETQ FILEMAPLST (for STREAM in FILES collect (LET ((LDFLG (QUOTE EXPRESSIONS)) (VARLST (QUOTE COMPILING)) DONELST FNLST) (DECLARE (SPECVARS LDFLG VARLST DONELST FNLST)) (* ; "FNLST etc are used free in LOADFNSCAN") (SETFILEPTR STREAM 0) (INPUT STREAM) (* ;; "LOADFNSCAN scans the file, building a map if one not already there. Value is the map. In addition, sets DONELST to a list of all non-defineq expressions.") (CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC) (GET-ENVIRONMENT-AND-FILEMAP STREAM) (DECLARE (CL:SPECIAL FILECREATEDLOC)) (* ; " used by LOADFNSCAN") (WITH-READER-ENVIRONMENT ENV (create COMPFILEDESCR COMPFILESTREAM _ STREAM COMPFILEENV _ ENV COMPFILEMAP _ (LOADFNSCAN MAP) COMPFILEXPRS _ (DREVERSE DONELST))))))) (SETQ FNLST (for DESCR in FILEMAPLST join (for DEFQ in (CDR (fetch COMPFILEMAP of DESCR)) join (for X in (CDDR DEFQ) collect (CAR X))))) (* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL. We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries). fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions. The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.") (for DESCR in FILEMAPLST do (for FORM in (fetch COMPFILEXPRS of DESCR) do (BCOMPL1A FORM (QUOTE DEFAULT) (QUOTE DEFAULT) (QUOTE DEFAULT)))) (* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST. NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.") (SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS FNLST NOFIXFNSLST)) (WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch COMPFILEENV of (CAR FILEMAPLST))) (* ; "Start writing the compiled file. Use environment of one of the source files--usually the only one") (if LCFIL then (PRINT-COMPILE-HEADER FILES (CONS (if NOBLOCKSFLG then (QUOTE recompiled) else (QUOTE brecompiled)) (if (EQ FNS (QUOTE ALL)) then (LIST (QUOTE ALL)) else (CONS (SELECTQ FNS (CHANGES (QUOTE changes%:)) ((EXPRS T) (QUOTE exprs%:)) (QUOTE explicitly%:)) (OR (SUBSET FNLST (FUNCTION (LAMBDA (X) (RECOMP? X FNS)))) (LIST (QUOTE nothing)))))) DESTINATIONENV)) (MAPC FNLST (FUNCTION (LAMBDA (X) (RCOMP3 X (VIRGINFN X))))) (if SCRATCHFILE then (* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.") (for X in OTHERS do (PRINT X SCRATCHFILE)) (PRINT NIL SCRATCHFILE) (SETQ OTHERS NIL)) (for X in (PROGN FIRST) do (PRINT X LCFIL)) (OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB (QUOTE CLISP) (GETPROP FILE (QUOTE FILETYPE))))) (OR (EQ FNS (QUOTE ALL)) (INPUT CFILE)) (if (NOT NOBLOCKSFLG) then (for BLOCK in BLOCKS do (if (NULL (CAR BLOCK)) then (BCOMPL2 BLOCK FILEMAPLST) elseif (for X in BLOCK thereis (AND (LITATOM X) (RECOMP? X FNS))) then (* ; "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.") (BCOMPL2 BLOCK FILEMAPLST COREOK) else (BRECOMPILE1 BLOCK)))) (* ;; "NOBLOCKSFLG is T for calls from RECOMPILE. In this case, even if there were any blocks, ignore them.") (* ; "Now COMPILE rest of functions.") (for X in FNLST do (if (OR (FMEMB X BLKFNS) (FMEMB X DONTCOMPILEFNS)) elseif (RECOMP? X FNS) then (* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.") (COMPILE1 X (CADR (SETQ TEM (BRECOMPILE3 X FILEMAPLST COREOK))) (CADDR TEM)) else (BRECOMPILE1 X T)))) (RETURN (FULLNAME LCFIL)) NONRAND (SETQ MSG " is not RANDACCESSP") NONREC (printout T TEM MSG ", using " (if NOBLOCKSFLG then (QUOTE TCOMPL) else (QUOTE BCOMPL)) " instead." T) (RETURN (BCOMPL.BODY FILES NIL NOBLOCKSFLG)))))
|
||||
)
|
||||
[LAMBDA (FILES CFILE FNS NOBLOCKSFLG) (* ; "Edited 5-Jul-2021 09:28 by rmk:")
|
||||
|
||||
(* ;;; "FNS is a list of functions to be recompiled. The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.")
|
||||
|
||||
(* ;;; "BRECOMPILE is driven by the source file(s). The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR. Otherwise copy its compiled definition from CFILE. Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied. This corresponds to the case where functions have been deleted from the source file.")
|
||||
|
||||
(* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.")
|
||||
|
||||
(* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).")
|
||||
|
||||
(* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.")
|
||||
|
||||
(RESETLST
|
||||
(PROG ((*PRINT-ARRAY* T)
|
||||
(*PRINT-LENGTH* NIL)
|
||||
(*PRINT-LEVEL* NIL)
|
||||
(NLAMA NLAMA)
|
||||
(NLAML NLAML)
|
||||
(LAMS LAMS)
|
||||
(LAMA LAMA)
|
||||
(DWIMIFYCOMPFLG DWIMIFYCOMPFLG)
|
||||
(EXPRSLST NIL)
|
||||
(NOFIXFNSLST NOFIXFNSLST)
|
||||
(NOFIXVARSLST NOFIXVARSLST)
|
||||
(BUILDMAPFLG T)
|
||||
(SPECVARS T)
|
||||
(LOCALVARS SYSLOCALVARS)
|
||||
(AUXFILECOM T)
|
||||
CHANGES OTHERS FIRST FILEMAPLST FNLST BLKFNS BLOCKS FILE FILE.COM TEM ADRLST
|
||||
SCRATCHFILE COREOK DESTINATIONENV MSG)
|
||||
(DECLARE (SPECVARS *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS
|
||||
LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG
|
||||
SPECVARS LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS
|
||||
DESTINATIONENV ADRLST FILEMAPLST CFILE FNS FILE))
|
||||
(COND
|
||||
((AND (NULL CFILE)
|
||||
(NULL FNS))
|
||||
(SETQ FNS RECOMPILEDEFAULT)))
|
||||
(RESETSAVE (INPUT))
|
||||
(SETQ FILES (RESETOPENFILES FILES))
|
||||
(COND
|
||||
((SETQ TEM (for FILE in FILES when (NOT (RANDACCESSP FILE))
|
||||
collect (FULLNAME FILE)))
|
||||
(GO NONRAND)))
|
||||
(SETQ FILE (UNPACKFILENAME (CAR FILES)))
|
||||
(SETQ FILE.COM (PACKFILENAME 'HOST (CADR (FMEMB 'HOST FILE))
|
||||
'DIRECTORY
|
||||
(CADR (FMEMB 'DIRECTORY FILE))
|
||||
'NAME
|
||||
(SETQ FILE (CADR (FMEMB 'NAME FILE)))
|
||||
'EXTENSION COMPILE.EXT))
|
||||
|
||||
(* ;; "Edited by TT (8-June-90 : for fix AR#2999)")
|
||||
|
||||
(COND
|
||||
((EQ FNS 'ALL)
|
||||
(GO BRECALL)))
|
||||
CFILERETRY
|
||||
(COND
|
||||
([NLSETQ (SETQ CFILE (OPENSTREAM (OR CFILE FILE.COM)
|
||||
'INPUT
|
||||
'OLD NIL '((TYPE BINARY]
|
||||
(COND
|
||||
((NOT (RANDACCESSP CFILE))
|
||||
(SETQ TEM (CLOSEF CFILE))
|
||||
(GO NONRAND))
|
||||
([OR [NULL (SETQ DESTINATIONENV (GET-ENVIRONMENT-AND-FILEMAP (CAR FILES]
|
||||
(CL:MULTIPLE-VALUE-BIND (ENV DUMMY START)
|
||||
(\PARSE-FILE-HEADER CFILE)
|
||||
(COND
|
||||
((OR (NULL ENV)
|
||||
(NOT (EQUAL-READER-ENVIRONMENT ENV DESTINATIONENV)))
|
||||
T)
|
||||
(T (* "Position cfile back to start")
|
||||
(SETFILEPTR CFILE START)
|
||||
NIL]
|
||||
(SETQ TEM (CLOSEF CFILE))
|
||||
(SETQ MSG " has different reader environment than the new file")
|
||||
(GO NONREC)))
|
||||
(GO BREC))
|
||||
((OR (AND (EQ AUXFILECOM T)
|
||||
[SETQ AUXFILECOM (SPELLFILE (ROOTFILENAME (OR CFILE FILE.COM]
|
||||
(SETQ CFILE AUXFILECOM)
|
||||
(GO CFILERETRY))
|
||||
(EQ (ASKUSER DWIMWAIT 'Y (LIST (OR CFILE FILE.COM)
|
||||
"not found;" " compile all functions on "
|
||||
(FULLNAME (CAR FILES))
|
||||
'"instead"))
|
||||
'Y)) (* ;
|
||||
"Edited by TT(8-June-90 : for Fix AR#8017)")
|
||||
(GO BRECALL))
|
||||
((EQ [ASKUSER DWIMWAIT 'Y (CONS '"Just forget about compiling"
|
||||
(MAPCAR FILES (FUNCTION FULLNAME]
|
||||
'Y)
|
||||
(SELECTQ (CAR READBUF)
|
||||
((ST F STF) (* "E.g. From CLEANUP.")
|
||||
(SETQ READBUF (CDR READBUF)))
|
||||
NIL)
|
||||
(RETFROM 'BRECOMPILE))
|
||||
(T (PRIN1
|
||||
"File to use for CFILE (source of compiled definitions not being recompiled): "
|
||||
T)
|
||||
(SETQ CFILE (READ T T))
|
||||
(GO CFILERETRY)))
|
||||
BRECALL
|
||||
(SETQQ FNS ALL)
|
||||
(SETQ CFILE NIL)
|
||||
BREC
|
||||
(COMPSET NIL '(S T %
|
||||
))
|
||||
[SETQ LCFIL (OPENSTREAM FILE.COM 'OUTPUT 'NEW NIL '((TYPE BINARY]
|
||||
(SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW))
|
||||
(RESETSAVE NIL (LIST 'BCOMPL3 CFILE FILES SCRATCHFILE))
|
||||
|
||||
(* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs. Note that this call differs from the call for bcompl in that cfile is also specified. this corresponds to the fact that recompile has an extra file open.")
|
||||
|
||||
[SETQ COREOK (for X in FILES
|
||||
always (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME X))
|
||||
'FILEDATES))
|
||||
X)
|
||||
(FMEMB (CDAR (GETPROP TEM 'FILE))
|
||||
'(LOADFNS T]
|
||||
[SETQ FILEMAPLST
|
||||
(for STREAM in FILES
|
||||
collect (LET ((LDFLG 'EXPRESSIONS)
|
||||
(VARLST 'COMPILING)
|
||||
DONELST FNLST)
|
||||
(DECLARE (SPECVARS LDFLG VARLST DONELST FNLST))
|
||||
(* ;
|
||||
"FNLST etc are used free in LOADFNSCAN")
|
||||
(SETFILEPTR STREAM 0)
|
||||
(INPUT STREAM)
|
||||
|
||||
(* ;; "LOADFNSCAN scans the file, building a map if one not already there. Value is the map. In addition, sets DONELST to a list of all non-defineq expressions.")
|
||||
|
||||
(CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC)
|
||||
(GET-ENVIRONMENT-AND-FILEMAP STREAM)
|
||||
(DECLARE (CL:SPECIAL FILECREATEDLOC))
|
||||
(* ; " used by LOADFNSCAN")
|
||||
(WITH-READER-ENVIRONMENT ENV
|
||||
(create COMPFILEDESCR
|
||||
COMPFILESTREAM _ STREAM
|
||||
COMPFILEENV _ ENV
|
||||
COMPFILEMAP _ (LOADFNSCAN MAP)
|
||||
COMPFILEXPRS _ (DREVERSE DONELST)))]
|
||||
[SETQ FNLST (for DESCR in FILEMAPLST
|
||||
join (for DEFQ in (CDR (fetch COMPFILEMAP of DESCR))
|
||||
join (for X in (CDDR DEFQ)
|
||||
collect (CAR X]
|
||||
|
||||
(* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL. We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries). fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions. The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.")
|
||||
|
||||
[for DESCR in FILEMAPLST do (for FORM
|
||||
in (fetch COMPFILEXPRS of DESCR)
|
||||
do (BCOMPL1A FORM 'DEFAULT
|
||||
'DEFAULT
|
||||
'DEFAULT]
|
||||
|
||||
(* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST. NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.")
|
||||
|
||||
(SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS FNLST NOFIXFNSLST))
|
||||
(WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch COMPFILEENV
|
||||
of (CAR FILEMAPLST)))
|
||||
(* ;
|
||||
"Start writing the compiled file. Use environment of one of the source files--usually the only one")
|
||||
(if LCFIL
|
||||
then (\EXTERNALFORMAT LCFIL (OR (LISTGET DESTINATIONENV :FORMAT)
|
||||
:XCCS))
|
||||
(PRINT-COMPILE-HEADER
|
||||
FILES
|
||||
[CONS (if NOBLOCKSFLG
|
||||
then 'recompiled
|
||||
else 'brecompiled)
|
||||
(if (EQ FNS 'ALL)
|
||||
then (LIST 'ALL)
|
||||
else (CONS (SELECTQ FNS
|
||||
(CHANGES 'changes%:)
|
||||
((EXPRS T)
|
||||
'exprs%:)
|
||||
'explicitly%:)
|
||||
(OR [SUBSET FNLST (FUNCTION (LAMBDA (X)
|
||||
(RECOMP? X FNS]
|
||||
(LIST 'nothing]
|
||||
DESTINATIONENV))
|
||||
[MAPC FNLST (FUNCTION (LAMBDA (X)
|
||||
(RCOMP3 X (VIRGINFN X]
|
||||
(if SCRATCHFILE
|
||||
then
|
||||
|
||||
(* ;; "writes others on a scratchfile so space can be freed up. will be copied onto lcfil aftr compilation.")
|
||||
|
||||
(\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
|
||||
(for X in OTHERS do (PRINT X SCRATCHFILE))
|
||||
(PRINT NIL SCRATCHFILE)
|
||||
(SETQ OTHERS NIL))
|
||||
(for X in (PROGN FIRST) do (PRINT X LCFIL))
|
||||
[OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILE 'FILETYPE]
|
||||
(OR (EQ FNS 'ALL)
|
||||
(INPUT CFILE))
|
||||
[if (NOT NOBLOCKSFLG)
|
||||
then (for BLOCK in BLOCKS
|
||||
do (if (NULL (CAR BLOCK))
|
||||
then (BCOMPL2 BLOCK FILEMAPLST)
|
||||
elseif (for X in BLOCK
|
||||
thereis (AND (LITATOM X)
|
||||
(RECOMP? X FNS)))
|
||||
then (* ;
|
||||
"If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.")
|
||||
(BCOMPL2 BLOCK FILEMAPLST COREOK)
|
||||
else (BRECOMPILE1 BLOCK]
|
||||
|
||||
(* ;; "NOBLOCKSFLG is T for calls from RECOMPILE. In this case, even if there were any blocks, ignore them.")
|
||||
(* ; "Now COMPILE rest of functions.")
|
||||
(for X in FNLST
|
||||
do (if (OR (FMEMB X BLKFNS)
|
||||
(FMEMB X DONTCOMPILEFNS))
|
||||
elseif (RECOMP? X FNS)
|
||||
then
|
||||
|
||||
(* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.")
|
||||
|
||||
(COMPILE1 X (CADR (SETQ TEM (BRECOMPILE3 X FILEMAPLST
|
||||
COREOK)))
|
||||
(CADDR TEM))
|
||||
else (BRECOMPILE1 X T))))
|
||||
(RETURN (FULLNAME LCFIL))
|
||||
NONRAND
|
||||
(SETQ MSG " is not RANDACCESSP")
|
||||
NONREC
|
||||
(printout T TEM MSG ", using " (if NOBLOCKSFLG
|
||||
then 'TCOMPL
|
||||
else 'BCOMPL)
|
||||
" instead." T)
|
||||
(RETURN (BCOMPL.BODY FILES NIL NOBLOCKSFLG))))])
|
||||
|
||||
(BRECOMPILE1
|
||||
(LAMBDA (FN/BLOCK NOBLOCKSFLG) (* bvm%: "29-Aug-86 22:41")
|
||||
@@ -1109,63 +1414,73 @@ with the terms of said license.
|
||||
THEN (SETQ GLOBALVARS (UNION A GLOBALVARS])
|
||||
)
|
||||
|
||||
(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL)
|
||||
(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE
|
||||
EDITL)
|
||||
|
||||
(ADDTOVAR LINKFNS)
|
||||
(ADDTOVAR LINKFNS )
|
||||
|
||||
(ADDTOVAR FREEVARS)
|
||||
(ADDTOVAR FREEVARS )
|
||||
|
||||
(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS GLOBALVARS)
|
||||
(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS
|
||||
GLOBALVARS)
|
||||
|
||||
(ADDTOVAR SYSLOCALVARS)
|
||||
(ADDTOVAR SYSLOCALVARS )
|
||||
|
||||
(ADDTOVAR LOCALFREEVARS)
|
||||
(ADDTOVAR LOCALFREEVARS )
|
||||
|
||||
(ADDTOVAR BLKLIBRARY)
|
||||
(ADDTOVAR BLKLIBRARY )
|
||||
|
||||
(ADDTOVAR RETFNS)
|
||||
(ADDTOVAR RETFNS )
|
||||
|
||||
(ADDTOVAR BLKAPPLYFNS)
|
||||
(ADDTOVAR BLKAPPLYFNS )
|
||||
|
||||
(ADDTOVAR DONTCOMPILEFNS)
|
||||
(ADDTOVAR DONTCOMPILEFNS )
|
||||
|
||||
(ADDTOVAR NLAML)
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR NLAMA)
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR LAMS)
|
||||
(ADDTOVAR LAMS )
|
||||
|
||||
(ADDTOVAR LAMA)
|
||||
(ADDTOVAR LAMA )
|
||||
|
||||
(RPAQ? SPECVARS T)
|
||||
(RPAQ? SPECVARS T)
|
||||
|
||||
(RPAQ? LOCALVARS SYSLOCALVARS)
|
||||
(RPAQ? LOCALVARS SYSLOCALVARS)
|
||||
|
||||
(RPAQ? DWIMIFYCOMPFLG NIL)
|
||||
(RPAQ? DWIMIFYCOMPFLG NIL)
|
||||
|
||||
(RPAQ? COMPILEHEADER "compiled on ")
|
||||
(RPAQ? COMPILEHEADER "compiled on ")
|
||||
|
||||
(RPAQ? COMPSETLST (QUOTE (ST F STF S Y N 1 2 NIL T)))
|
||||
(RPAQ? COMPSETLST '(ST F STF S Y N 1 2 NIL T))
|
||||
|
||||
(RPAQ? COMPSETKEYLST (QUOTE ((ST "ore and redefine " KEYLST ("" (F . "orget exprs"))) (S . "ame as last time") (F . "ile only") (T . "o terminal") (1) (2) (Y . "es") (N . "o"))))
|
||||
(RPAQ? COMPSETKEYLST '((ST "ore and redefine " KEYLST ("" (F . "orget exprs")))
|
||||
(S . "ame as last time")
|
||||
(F . "ile only")
|
||||
(T . "o terminal")
|
||||
(1)
|
||||
(2)
|
||||
(Y . "es")
|
||||
(N . "o")))
|
||||
|
||||
(RPAQ? COMPSETDEFAULTKEYLST (QUOTE ((Y . "es") (N . "o"))))
|
||||
(RPAQ? COMPSETDEFAULTKEYLST '((Y . "es")
|
||||
(N . "o")))
|
||||
|
||||
(RPAQ? BCOMPL.SCRATCH (QUOTE {CORE}BCOMPL.SCRATCH))
|
||||
(RPAQ? BCOMPL.SCRATCH '{CORE}BCOMPL.SCRATCH)
|
||||
|
||||
(RPAQ? RECOMPILEDEFAULT (QUOTE CHANGES))
|
||||
(RPAQ? RECOMPILEDEFAULT 'CHANGES)
|
||||
|
||||
(RPAQ? COUTFILE T)
|
||||
(RPAQ? COUTFILE T)
|
||||
|
||||
(RPAQ? SVFLG T)
|
||||
(RPAQ? SVFLG T)
|
||||
|
||||
(RPAQ? STRF T)
|
||||
(RPAQ? STRF T)
|
||||
|
||||
(RPAQ? LSTFIL T)
|
||||
(RPAQ? LSTFIL T)
|
||||
|
||||
(RPAQ? LCFIL)
|
||||
(RPAQ? LCFIL )
|
||||
|
||||
(RPAQ? LAPFLG T)
|
||||
(RPAQ? LAPFLG T)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -1174,27 +1489,33 @@ with the terms of said license.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS DIGITCHARP MACRO (LAMBDA (CHAR) (AND (IGEQ CHAR (CHARCODE 0)) (ILEQ CHAR (CHARCODE 9)))))
|
||||
(PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR)
|
||||
(AND (IGEQ CHAR (CHARCODE 0))
|
||||
(ILEQ CHAR (CHARCODE 9])
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES BYTECOMPFLG COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0 NOFIXFNSLST0 CLISPTRANFLG CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0 LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL DWIMFLG DWIMWAIT)
|
||||
(GLOBALVARS SYSSPECVARS SYSLOCALVARS RECOMPILEDEFAULT COMPILE.EXT NOTCOMPILEDFILES BYTECOMPFLG
|
||||
COMPILEHEADER COMPVERSION BCOMPL.SCRATCH LINKEDFNS NOFIXVARSLST0 NOFIXFNSLST0 CLISPTRANFLG
|
||||
CLISPARRAY COMPSETKEYLST REREADFLG HISTSTR0 LISPXHISTORY COMPSETDEFAULTKEYLST FILERDTBL
|
||||
DWIMFLG DWIMWAIT)
|
||||
)
|
||||
)
|
||||
|
||||
(MOVD? (QUOTE NILL) (QUOTE FILECHANGES))
|
||||
(MOVD? 'NILL 'FILECHANGES)
|
||||
|
||||
(CL:PROCLAIM (QUOTE (CL:SPECIAL COMPVARMACROHASH)))
|
||||
(CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH))
|
||||
|
||||
(CL:PROCLAIM (QUOTE (GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY)))
|
||||
(CL:PROCLAIM '(GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL
|
||||
DWIMFLG DWIMWAIT LISPXHISTORY))
|
||||
|
||||
|
||||
|
||||
(* ; "COMPILEMODE")
|
||||
|
||||
|
||||
(PUTPROPS COMPILEMODELST VARTYPE ALIST)
|
||||
(PUTPROPS COMPILEMODELST VARTYPE ALIST)
|
||||
(DEFINEQ
|
||||
|
||||
(COMPILEMODE
|
||||
@@ -1217,22 +1538,22 @@ with the terms of said license.
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:)
|
||||
(ADDTOVAR NLAMA GLOBALVARS LOCALVARS SPECVARS BLOCK%:)
|
||||
|
||||
(ADDTOVAR NLAML BCOMPL3)
|
||||
(ADDTOVAR NLAML BCOMPL3)
|
||||
|
||||
(ADDTOVAR LAMA)
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990))
|
||||
(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2714 65742 (BCOMPL 2724 . 4466) (BCOMPL.BODY 4468 . 10254) (PRINT-COMPILE-HEADER 10256
|
||||
. 11319) (RESETOPENFILES 11321 . 11674) (BCOMPL1A 11676 . 17689) (BCOMPL2 17691 . 24506) (BCOMPL3
|
||||
24508 . 25857) (BLOCK%: 25859 . 26491) (BRECOMPILE 26493 . 34961) (BRECOMPILE1 34963 . 40815) (
|
||||
BRECOMPILE2 40817 . 41619) (BRECOMPILE3 41621 . 42997) (BLOCKCOMPILE 42999 . 44859) (BLOCKCOMPILE1
|
||||
44861 . 49946) (COMPSET 49948 . 52711) (COMPSETREAD 52713 . 54024) (COMPSETY 54026 . 54150) (COMPSETF
|
||||
54152 . 54318) (RCOMP3 54320 . 56027) (TCOMPL 56029 . 56328) (RECOMPILE 56330 . 56413) (RECOMP? 56415
|
||||
. 56875) (COMPILE 56877 . 58866) (COMPILE1 58868 . 59456) (COMPILE1A 59458 . 61105) (
|
||||
SHOULD-BE-DWIMIFIED? 61107 . 61796) (COMPILE.FILECHECK 61798 . 61944) (COMPEM 61946 . 62670) (GETCFILE
|
||||
62672 . 64403) (SPECVARS 64405 . 64960) (LOCALVARS 64962 . 65536) (GLOBALVARS 65538 . 65740)) (67713
|
||||
68662 (COMPILEMODE 67723 . 68660)))))
|
||||
(FILEMAP (NIL (3770 74020 (BCOMPL 3780 . 5430) (BCOMPL.BODY 5432 . 12011) (PRINT-COMPILE-HEADER 12013
|
||||
. 13076) (RESETOPENFILES 13078 . 13431) (BCOMPL1A 13433 . 19446) (BCOMPL2 19448 . 26263) (BCOMPL3
|
||||
26265 . 27614) (BLOCK%: 27616 . 28248) (BRECOMPILE 28250 . 43239) (BRECOMPILE1 43241 . 49093) (
|
||||
BRECOMPILE2 49095 . 49897) (BRECOMPILE3 49899 . 51275) (BLOCKCOMPILE 51277 . 53137) (BLOCKCOMPILE1
|
||||
53139 . 58224) (COMPSET 58226 . 60989) (COMPSETREAD 60991 . 62302) (COMPSETY 62304 . 62428) (COMPSETF
|
||||
62430 . 62596) (RCOMP3 62598 . 64305) (TCOMPL 64307 . 64606) (RECOMPILE 64608 . 64691) (RECOMP? 64693
|
||||
. 65153) (COMPILE 65155 . 67144) (COMPILE1 67146 . 67734) (COMPILE1A 67736 . 69383) (
|
||||
SHOULD-BE-DWIMIFIED? 69385 . 70074) (COMPILE.FILECHECK 70076 . 70222) (COMPEM 70224 . 70948) (GETCFILE
|
||||
70950 . 72681) (SPECVARS 72683 . 73238) (LOCALVARS 73240 . 73814) (GLOBALVARS 73816 . 74018)) (76481
|
||||
77430 (COMPILEMODE 76491 . 77428)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user