Compare commits
21 Commits
nightly-21
...
nightly-21
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
25c397ccdf | ||
|
|
b18d16b807 | ||
|
|
9b7df4a022 | ||
|
|
4efe2f93af | ||
|
|
4fac4e3e96 | ||
|
|
966b837351 | ||
|
|
dac0acd0d5 | ||
|
|
105b0d1f3a | ||
|
|
10e3916e7e | ||
|
|
2cf33cebcf | ||
|
|
d40aeffdc7 | ||
|
|
6f9cafc578 | ||
|
|
a781751832 | ||
|
|
d5b26c1352 | ||
|
|
0a5ff04393 | ||
|
|
a946a90ef8 | ||
|
|
66fa5e42cf | ||
|
|
05df858e55 | ||
|
|
f64f8bbb87 | ||
|
|
2388f730ca | ||
|
|
607d9ab2e7 |
82
.github/workflows/build.yml
vendored
Normal file
82
.github/workflows/build.yml
vendored
Normal file
@@ -0,0 +1,82 @@
|
||||
# based on https://blog.oddbit.com/post/2020-09-25-building-multi-architecture-im/
|
||||
---
|
||||
# Interlisp workflow to build Docker Image that support multiple architectures
|
||||
name: 'Build Medley Docker image'
|
||||
|
||||
# Run this workflow on push to master
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- master
|
||||
|
||||
# Jobs that compose this workflow
|
||||
jobs:
|
||||
# Job to build the docker image
|
||||
docker:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
# Checkout the branch
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
|
||||
# Setup needed environment variables
|
||||
- name: Prepare
|
||||
id: prep
|
||||
run: |
|
||||
DOCKER_IMAGE=interlisp/${GITHUB_REPOSITORY#*/}
|
||||
VERSION=latest
|
||||
SHORTREF=${GITHUB_SHA::8}
|
||||
|
||||
# If this is git tag, use the tag name as a docker tag
|
||||
if [[ $GITHUB_REF == refs/tags/* ]]; then
|
||||
VERSION=${GITHUB_REF#refs/tags/v}
|
||||
fi
|
||||
TAGS="${DOCKER_IMAGE}:${VERSION},${DOCKER_IMAGE}:${SHORTREF}"
|
||||
|
||||
# If the VERSION looks like a version number, assume that
|
||||
# this is the most recent version of the image and also
|
||||
# tag it 'latest'.
|
||||
if [[ $VERSION =~ ^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$ ]]; then
|
||||
TAGS="$TAGS,${DOCKER_IMAGE}:latest"
|
||||
fi
|
||||
|
||||
# Set output parameters.
|
||||
echo ::set-output name=tags::${TAGS}
|
||||
echo ::set-output name=docker_image::${DOCKER_IMAGE}
|
||||
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
|
||||
|
||||
# Setup Docker Machine Emulation environment
|
||||
- name: Set up QEMU
|
||||
uses: docker/setup-qemu-action@master
|
||||
with:
|
||||
platforms: all
|
||||
|
||||
# Setup Docker Buildx function
|
||||
- name: Set up Docker Buildx
|
||||
id: buildx
|
||||
uses: docker/setup-buildx-action@master
|
||||
|
||||
# Login to DockerHub - required to store the image
|
||||
- name: Login to DockerHub
|
||||
if: github.event_name != 'pull_request'
|
||||
uses: docker/login-action@v1
|
||||
with:
|
||||
username: ${{ secrets.DOCKER_USERNAME }}
|
||||
password: ${{ secrets.DOCKER_PASSWORD }}
|
||||
|
||||
# Start the Docker Build using the Dockerfilein the repository
|
||||
- name: Build
|
||||
uses: docker/build-push-action@v2
|
||||
with:
|
||||
builder: ${{ steps.buildx.outputs.name }}
|
||||
context: .
|
||||
file: ./Dockerfile
|
||||
# Platforms
|
||||
# linux/amd64 -- Standard x86_64
|
||||
# linux/arm64 -- Apple M1
|
||||
# linux/arm/v7 -- Raspberry pi
|
||||
platforms: linux/amd64,linux/arm64,linux/arm/v7
|
||||
# Push the created image
|
||||
push: true
|
||||
# tags to assign to the Docker image
|
||||
tags: ${{ steps.prep.outputs.tags }}
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -27,3 +27,4 @@ core
|
||||
|
||||
# set up by install-diff-filter.sh script
|
||||
.gitattributes
|
||||
sources/LLREAD.LCOM.~1~
|
||||
|
||||
29
Dockerfile
29
Dockerfile
@@ -1,24 +1,19 @@
|
||||
FROM ubuntu:focal
|
||||
ENV DEBIAN_FRONTEND=noninteractive
|
||||
FROM interlisp/maiko:latest
|
||||
ARG BUILD_DATE
|
||||
LABEL name="Medley"
|
||||
LABEL description="The Medley Interlisp environment"
|
||||
LABEL url="https://github.com/Interlisp/medley"
|
||||
LABEL build-time=$BUILD_DATE
|
||||
|
||||
RUN apt-get update && apt-get install -y build-essential clang libx11-dev
|
||||
COPY maiko /build/
|
||||
WORKDIR /build/bin
|
||||
RUN rm -rf /build/linux*
|
||||
RUN ./makeright x
|
||||
|
||||
|
||||
FROM ubuntu:focal
|
||||
ENV DEBIAN_FRONTEND=noninteractive
|
||||
RUN apt-get update && apt-get install -y tightvncserver
|
||||
|
||||
EXPOSE 5900
|
||||
|
||||
RUN apt-get update && apt-get install -y tightvncserver
|
||||
RUN mkdir /app
|
||||
WORKDIR /app
|
||||
COPY basics ./
|
||||
COPY --from=0 /build/linux.x86_64/* ./
|
||||
# Need to refine this down to only needed directories.
|
||||
COPY . /app/medley
|
||||
|
||||
WORKDIR /app/medley
|
||||
|
||||
RUN adduser --disabled-password --gecos "" medley
|
||||
USER medley
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1270x720 :0 & DISPLAY=:0 /app/ldex -g 1280x720 full.sysout
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 PATH="/app/maiko:$PATH" ./run-medley -full -g 1280x720 -sc 1280x720
|
||||
0
docs/ReleaseNote/APPENDIXB-SEDIT.pdf
Executable file → Normal file
0
docs/ReleaseNote/APPENDIXB-SEDIT.pdf
Executable file → Normal file
0
docs/ReleaseNote/APPENDIXC-ICONW.pdf
Executable file → Normal file
0
docs/ReleaseNote/APPENDIXC-ICONW.pdf
Executable file → Normal file
0
docs/ReleaseNote/ENVOSCOVERSHEET.pdf
Executable file → Normal file
0
docs/ReleaseNote/ENVOSCOVERSHEET.pdf
Executable file → Normal file
0
docs/ReleaseNote/Indexfinal.pdf
Executable file → Normal file
0
docs/ReleaseNote/Indexfinal.pdf
Executable file → Normal file
0
docs/ReleaseNote/LOT.pdf
Executable file → Normal file
0
docs/ReleaseNote/LOT.pdf
Executable file → Normal file
0
docs/ReleaseNote/PREFACE.pdf
Executable file → Normal file
0
docs/ReleaseNote/PREFACE.pdf
Executable file → Normal file
0
docs/ReleaseNote/PRINTINGSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/PRINTINGSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC4-IRMERRATA.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC4-IRMERRATA.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC7-CLIMPLMNTN.pdf
Executable file → Normal file
0
docs/ReleaseNote/SEC7-CLIMPLMNTN.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABS2L.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABS2L.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSINFOP.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSINFOP.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSLAYOUTL.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSLAYOUTL.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/TABSPEC.pdf
Executable file → Normal file
0
docs/ReleaseNote/TOC.pdf
Executable file → Normal file
0
docs/ReleaseNote/TOC.pdf
Executable file → Normal file
0
docs/ReleaseNote/Titlepage.pdf
Executable file → Normal file
0
docs/ReleaseNote/Titlepage.pdf
Executable file → Normal file
0
docs/ReleaseNote/indexbase.pdf
Executable file → Normal file
0
docs/ReleaseNote/indexbase.pdf
Executable file → Normal file
0
internal/library/DO-TEST.pdf
Executable file → Normal file
0
internal/library/DO-TEST.pdf
Executable file → Normal file
@@ -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.
301
library/RDSYS
301
library/RDSYS
File diff suppressed because one or more lines are too long
Binary file not shown.
Binary file not shown.
@@ -1,13 +1,13 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "12-Jun-90 15:31:15" {DSK}<usr>local>lde>lispcore>library>SYSEDIT.;2 1411
|
||||
(FILECREATED " 6-May-2021 16:22:01" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;6 1312
|
||||
|
||||
changes to%: (VARS SYSEDITCOMS)
|
||||
|
||||
previous date%: " 9-Mar-87 10:53:12" {DSK}<usr>local>lde>lispcore>library>SYSEDIT.;1)
|
||||
previous date%: "12-Jun-90 15:31:15" {DSK}<home>larry>ilisp>medley>library>SYSEDIT.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SYSEDITCOMS)
|
||||
@@ -15,7 +15,6 @@ Copyright (c) 1984, 1987, 1990 by Venue & Xerox Corporation. All rights reserve
|
||||
(RPAQQ SYSEDITCOMS
|
||||
[(VARS (CLISPIFYPRETTYFLG)
|
||||
(MSRECORDTRANFLG T)
|
||||
(MSMACROPROPS COMPILERMACROPROPS)
|
||||
(RECOMPILEDEFAULT 'CHANGES)
|
||||
(CLEANUPOPTIONS '(RC F))
|
||||
(GLOBALVARFLG T)
|
||||
@@ -30,8 +29,6 @@ Copyright (c) 1984, 1987, 1990 by Venue & Xerox Corporation. All rights reserve
|
||||
|
||||
(RPAQQ MSRECORDTRANFLG T)
|
||||
|
||||
(RPAQ MSMACROPROPS COMPILERMACROPROPS)
|
||||
|
||||
(RPAQQ RECOMPILEDEFAULT CHANGES)
|
||||
|
||||
(RPAQQ CLEANUPOPTIONS (RC F))
|
||||
@@ -46,7 +43,7 @@ Copyright (c) 1984, 1987, 1990 by Venue & Xerox Corporation. All rights reserve
|
||||
(DIRECTORIES DIRECTORIES))
|
||||
(FILESLOAD (SOURCE)
|
||||
EXPORTS.ALL))
|
||||
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990))
|
||||
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
|
||||
1371
library/TEDITDCL
1371
library/TEDITDCL
File diff suppressed because it is too large
Load Diff
File diff suppressed because one or more lines are too long
File diff suppressed because it is too large
Load Diff
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-May-2001 11:45:53" {DSK}<project>medley3.5>library>TEDITFILE.;5 245586
|
||||
(FILECREATED "30-Apr-2021 14:46:41"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITFILE.;8 246290
|
||||
|
||||
changes to%: (FNS TEDIT.GET TEDIT.INCLUDE)
|
||||
changes to%: (FNS TEDIT.PUT.PCTB)
|
||||
|
||||
previous date%: "26-Dec-2000 15:18:25" {DSK}<project>medley3.5>library>TEDITFILE.;4)
|
||||
previous date%: "30-Apr-2021 13:43:24"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITFILE.;7)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1999, 2000, 2001 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1983-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITFILECOMS)
|
||||
@@ -83,7 +85,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
|
||||
(TEDIT.BUILD.PCTB
|
||||
[LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS CLEARGET?)
|
||||
(* ; "Edited 11-Jun-99 14:51 by rmk:")
|
||||
(* ; "Edited 29-Apr-2021 22:52 by rmk:")
|
||||
(* ; "Edited 11-Jun-99 14:37 by rmk:")
|
||||
(* ; "Edited 19-Apr-93 13:46 by jds")
|
||||
(* ;
|
||||
@@ -160,10 +162,13 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
|
||||
))
|
||||
(SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END))
|
||||
|
||||
(* ;; "RMK: Domestic EOL is now LF, so changed from CR")
|
||||
|
||||
(COND
|
||||
((AND (NOT PCCOUNT)
|
||||
(NEQ (fetch (STREAM EOLCONVENTION) of TEXT)
|
||||
CR.EOLC))
|
||||
LF.EOLC))
|
||||
|
||||
(* ;; "This is an UNFORMATTED file, and it has a foreign EOL convention. Convert it, and save the converted copy locally.")
|
||||
|
||||
@@ -1348,7 +1353,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(RETURN OFILE])
|
||||
|
||||
(TEDIT.PUT.PCTB
|
||||
[LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 11-Jun-99 15:55 by rmk:")
|
||||
[LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 30-Apr-2021 14:46 by rmk:")
|
||||
(* ; "Edited 19-May-99 21:58 by rmk:")
|
||||
(* ;
|
||||
"Edited 27-May-93 16:00 by sybalsky:mv:envos")
|
||||
@@ -1378,10 +1383,13 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(fetch (PIECE PLOOKS) of PC))
|
||||
(fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ)
|
||||
TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks")
|
||||
|
||||
(* ;; "RMK: CHANGED DEFAULT FROM CR TO LF")
|
||||
|
||||
(COND
|
||||
((NEQ (fetch (STREAM EOLCONVENTION) of OFILE)
|
||||
CR.EOLC) (* ;
|
||||
"This file is on a non-CR host; make a note to cache it")
|
||||
LF.EOLC) (* ;
|
||||
"This file is on a non-LF host; make a note to cache it")
|
||||
(SETQ TRUEFILE OFILE) (* ;
|
||||
"Remember where the file should wind up.")
|
||||
[SETQ OFILE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT]
|
||||
@@ -1604,17 +1612,26 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
((SETQ PSTR (fetch (PIECE PSTR) of PC))
|
||||
(* ;
|
||||
"It's in a string. Just print it.")
|
||||
(COND
|
||||
[(fetch (PIECE PFATP) of PC)
|
||||
(* ;
|
||||
"The string is fat: Copy twice as many bytes as chars.")
|
||||
(for I from 1 to (fetch (PIECE PLEN) of PC)
|
||||
as CH instring PSTR do (\BOUT OFILE (\CHARSET CH))
|
||||
(\BOUT OFILE (\CHAR8CODE CH]
|
||||
(T (* ;
|
||||
"The string is thin. Just copy it to the file.")
|
||||
(for I from 1 to (fetch (PIECE PLEN) of PC)
|
||||
as CH instring PSTR do (\BOUT OFILE CH]
|
||||
|
||||
(* ;;
|
||||
"RMK: BOUT ptimizations would miss external formats and EOL conventions")
|
||||
|
||||
(for I from 1 to (fetch (PIECE PLEN) of PC)
|
||||
as CH instring PSTR do (\OUTCHAR OFILE CH))
|
||||
(* (COND ((fetch (PIECE PFATP) of PC)
|
||||
(* ;
|
||||
"The string is fat: Copy twice as many bytes as chars.")
|
||||
(for I from 1 to (fetch
|
||||
(PIECE PLEN) of PC) as CH instring
|
||||
PSTR do (\BOUT OFILE
|
||||
(\CHARSET CH)) (\BOUT OFILE
|
||||
(\CHAR8CODE CH))))
|
||||
(T (* ;
|
||||
"The string is thin. Just copy it to the file.")
|
||||
(for I from 1 to (fetch
|
||||
(PIECE PLEN) of PC) as CH instring
|
||||
PSTR do (\BOUT OFILE CH)))))
|
||||
]
|
||||
[COND
|
||||
((AND (NOT CACHE)
|
||||
(RANDACCESSP OFILE)) (* ;
|
||||
@@ -3633,27 +3650,27 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(RPLACD TABSPEC TABS])
|
||||
)
|
||||
(PUTPROPS TEDITFILE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 1999 2000 2001))
|
||||
1991 1992 1993 1994 1999 2000 2001 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3099 57926 (TEDIT.BUILD.PCTB 3109 . 37483) (\TEDIT.CONVERT.FOREIGN.FORMAT 37485 . 38926
|
||||
) (TEDIT.FORMATTEDFILEP 38928 . 42792) (TEDIT.GET 42794 . 51610) (TEDIT.PARSE.PAGEFRAMES1 51612 .
|
||||
53318) (\ARBIN 53320 . 53941) (\ATMIN 53943 . 54272) (\DWIN 54274 . 54552) (\STRINGIN 54554 . 55151) (
|
||||
\TEDIT.FORMATTEDP1 55153 . 57417) (\TEDIT.SET.WINDOW 57419 . 57924)) (57962 78490 (TEDIT.INCLUDE 57972
|
||||
. 69359) (TEDIT.RAW.INCLUDE 69361 . 78488)) (78524 122097 (TEDIT.PUT 78534 . 88907) (TEDIT.PUT.PCTB
|
||||
88909 . 115833) (\TEDIT.PUTRESET 115835 . 116081) (TEDIT.PUT.PIECE.DESCRIPTOR 116083 . 118546) (
|
||||
\ARBOUT 118548 . 119748) (\ATMOUT 119750 . 120265) (\DWOUT 120267 . 120550) (\STRINGOUT 120552 .
|
||||
121004) (\TEDIT-OPEN-FONT-FILE 121006 . 122095)) (122098 132610 (\TEDIT.GET.CHARLOOKS.LIST 122108 .
|
||||
122513) (\TEDIT.GET.SINGLE.CHARLOOKS 122515 . 125560) (\TEDIT.PUT.CHARLOOKS.LIST 125562 . 127357) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 127359 . 132608)) (132611 146890 (\TEDIT.GET.PARALOOKS.LIST 132621 .
|
||||
133034) (\TEDIT.GET.SINGLE.PARALOOKS 133036 . 139430) (\TEDIT.PUT.PARALOOKS.LIST 139432 . 140426) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 140428 . 146888)) (147198 208459 (TEDIT.BUILD.PCTB2 147208 . 160564) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 160566 . 160973) (\TEDIT.GET.SINGLE.CHARLOOKS2 160975 . 163887) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 163889 . 168603) (\TEDIT.PUT.SINGLE.CHARLOOKS2 168605 . 173101) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 173103 . 173510) (\TEDIT.GET.SINGLE.PARALOOKS2 173512 . 178100) (
|
||||
TEDIT.PUT.PCTB2 178102 . 205763) (\TEDIT.PUT.CHARLOOKS.LIST2 205765 . 207562) (
|
||||
\TEDIT.PUT.PARALOOKS.LIST2 207564 . 208457)) (208536 229660 (TEDIT.BUILD.PCTB1 208546 . 218736) (
|
||||
TEDIT.GET.PAGEFRAMES1 218738 . 218993) (\TEDIT.GET.CHARLOOKS1 218995 . 222545) (\TEDIT.GET.PARALOOKS1
|
||||
222547 . 227128) (TEDIT.GET.OBJECT1 227130 . 229658)) (229720 245426 (TEDIT.BUILD.PCTB0 229730 .
|
||||
235437) (TEDIT.GET.CHARLOOKS0 235439 . 239458) (TEDIT.GET.OBJECT0 239460 . 241988) (
|
||||
TEDIT.GET.PARALOOKS0 241990 . 245424)))))
|
||||
(FILEMAP (NIL (3052 57958 (TEDIT.BUILD.PCTB 3062 . 37515) (\TEDIT.CONVERT.FOREIGN.FORMAT 37517 . 38958
|
||||
) (TEDIT.FORMATTEDFILEP 38960 . 42824) (TEDIT.GET 42826 . 51642) (TEDIT.PARSE.PAGEFRAMES1 51644 .
|
||||
53350) (\ARBIN 53352 . 53973) (\ATMIN 53975 . 54304) (\DWIN 54306 . 54584) (\STRINGIN 54586 . 55183) (
|
||||
\TEDIT.FORMATTEDP1 55185 . 57449) (\TEDIT.SET.WINDOW 57451 . 57956)) (57994 78522 (TEDIT.INCLUDE 58004
|
||||
. 69391) (TEDIT.RAW.INCLUDE 69393 . 78520)) (78556 122796 (TEDIT.PUT 78566 . 88939) (TEDIT.PUT.PCTB
|
||||
88941 . 116532) (\TEDIT.PUTRESET 116534 . 116780) (TEDIT.PUT.PIECE.DESCRIPTOR 116782 . 119245) (
|
||||
\ARBOUT 119247 . 120447) (\ATMOUT 120449 . 120964) (\DWOUT 120966 . 121249) (\STRINGOUT 121251 .
|
||||
121703) (\TEDIT-OPEN-FONT-FILE 121705 . 122794)) (122797 133309 (\TEDIT.GET.CHARLOOKS.LIST 122807 .
|
||||
123212) (\TEDIT.GET.SINGLE.CHARLOOKS 123214 . 126259) (\TEDIT.PUT.CHARLOOKS.LIST 126261 . 128056) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 128058 . 133307)) (133310 147589 (\TEDIT.GET.PARALOOKS.LIST 133320 .
|
||||
133733) (\TEDIT.GET.SINGLE.PARALOOKS 133735 . 140129) (\TEDIT.PUT.PARALOOKS.LIST 140131 . 141125) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 141127 . 147587)) (147897 209158 (TEDIT.BUILD.PCTB2 147907 . 161263) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 161265 . 161672) (\TEDIT.GET.SINGLE.CHARLOOKS2 161674 . 164586) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 164588 . 169302) (\TEDIT.PUT.SINGLE.CHARLOOKS2 169304 . 173800) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 173802 . 174209) (\TEDIT.GET.SINGLE.PARALOOKS2 174211 . 178799) (
|
||||
TEDIT.PUT.PCTB2 178801 . 206462) (\TEDIT.PUT.CHARLOOKS.LIST2 206464 . 208261) (
|
||||
\TEDIT.PUT.PARALOOKS.LIST2 208263 . 209156)) (209235 230359 (TEDIT.BUILD.PCTB1 209245 . 219435) (
|
||||
TEDIT.GET.PAGEFRAMES1 219437 . 219692) (\TEDIT.GET.CHARLOOKS1 219694 . 223244) (\TEDIT.GET.PARALOOKS1
|
||||
223246 . 227827) (TEDIT.GET.OBJECT1 227829 . 230357)) (230419 246125 (TEDIT.BUILD.PCTB0 230429 .
|
||||
236136) (TEDIT.GET.CHARLOOKS0 236138 . 240157) (TEDIT.GET.OBJECT0 240159 . 242687) (
|
||||
TEDIT.GET.PARALOOKS0 242689 . 246123)))))
|
||||
STOP
|
||||
|
||||
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 " 4-Jan-2021 13:48:43" {DSK}<home>larry>ilisp>medley>library>TEDITMENU.;2 275817
|
||||
(FILECREATED "29-Apr-2021 22:44:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;5 275764
|
||||
|
||||
changes to%: (FNS \TEDIT.MENU.INIT)
|
||||
|
||||
previous date%: "24-Apr-95 12:05:29" {DSK}<home>larry>ilisp>medley>library>TEDITMENU.;1)
|
||||
previous date%: "29-Apr-2021 22:40:33"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;4)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2021 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITMENUCOMS)
|
||||
@@ -17,7 +19,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
[COMS (* ; "Simple Menu Button support")
|
||||
[COMS (* ; "Simple Menu Button support")
|
||||
(FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN
|
||||
MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME
|
||||
MBUTTON.FIND.BUTTON MBUTTON.FIND.NEXT.BUTTON MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT
|
||||
@@ -29,13 +31,13 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;;
|
||||
"Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")
|
||||
(* ;;
|
||||
"Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")
|
||||
|
||||
(FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN
|
||||
MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT]
|
||||
[COMS (* ; "One-of-N Menu button sets")
|
||||
[COMS (* ; "One-of-N Menu button sets")
|
||||
(FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN
|
||||
MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS
|
||||
MB.NWAYBUTTON.ADDITEM)
|
||||
@@ -43,7 +45,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;; "Two-state, toggling menu buttons.")
|
||||
(* ;; "Two-state, toggling menu buttons.")
|
||||
|
||||
(FNS \TEXTMENU.TOGGLE.CREATE \TEXTMENU.TOGGLE.DISPLAY \TEXTMENU.TOGGLE.SHOWSELFN
|
||||
\TEXTMENU.TOGGLE.WHENOPERATEDFN \TEXTMENU.TOGGLEFN \TEXTMENU.TOGGLE.INIT
|
||||
@@ -52,7 +54,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTMENU.TOGGLE.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;; "Margin Setting and display")
|
||||
(* ;; "Margin Setting and display")
|
||||
|
||||
(FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN
|
||||
MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK
|
||||
@@ -64,11 +66,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN]
|
||||
(COMS
|
||||
(* ;; "Text menu creation and support")
|
||||
(* ;; "Text menu creation and support")
|
||||
|
||||
(FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN)
|
||||
(BITMAPS TEXTMENUICON TEXTMENUICONMASK))
|
||||
[COMS (* ; "TEdit-specific support")
|
||||
[COMS (* ; "TEdit-specific support")
|
||||
(FNS \TEDITMENU.CREATE \TEDIT.EXPANDED.MENU MB.DEFAULTBUTTON.FN
|
||||
\TEDITMENU.RECORD.UNFORMATTED MB.DEFAULTBUTTON.ACTIONFN)
|
||||
(FNS \TEDIT.CHARLOOKSMENU.CREATE \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.APPLY.BOLDNESS
|
||||
@@ -80,7 +82,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
\TEDIT.SHOW.PARALOOKS \TEDIT.NEUTRALIZE.PARALOOKS.MENU \TEDIT.RECORD.TABLEADERS)
|
||||
(FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING
|
||||
TEDIT.UNPARSE.PAGEFORMAT)
|
||||
(COMS (* ; "Initialization Code")
|
||||
(COMS (* ; "Initialization Code")
|
||||
(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU
|
||||
TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC
|
||||
TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC TEDIT.EXPANDED.PAGEMENU)
|
||||
@@ -4039,19 +4041,19 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.MENU.INIT
|
||||
[LAMBDA NIL (* ; "Edited 4-Jan-2021 13:36 by larry")
|
||||
(* ; "Edited 30-Mar-94 15:53 by jds")
|
||||
[LAMBDA NIL (* ; "Edited 29-Apr-2021 22:44 by rmk:")
|
||||
(* ; "Edited 30-Mar-94 15:53 by jds")
|
||||
|
||||
(* ;;; "Initialize the descriptions for all TEdit menus")
|
||||
(* ;;; "Initialize the descriptions for all TEdit menus")
|
||||
|
||||
(* ;;; "Divides between the main page layout menu and page-# font submenu")
|
||||
(* ;;; "Divides between the main page layout menu and page-# font submenu")
|
||||
|
||||
(SETQ TEDIT.MENUDIVIDER.SPEC (LIST (create MB.TEXT
|
||||
MBSTRING _ "
|
||||
|
||||
")))
|
||||
|
||||
(* ;;; "The principal expanded menu")
|
||||
(* ;;; "The principal expanded menu")
|
||||
|
||||
(SETQ TEDIT.EXPANDEDMENU.SPEC (LIST (create MB.BUTTON
|
||||
MBLABEL _ "Quit")
|
||||
@@ -4138,7 +4140,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
MBSTRING _ " Message/Phone#:")
|
||||
(create MB.INSERT)))
|
||||
|
||||
(* ;;; "The character-looks (font, etc.) menu")
|
||||
(* ;;; "The character-looks (font, etc.) menu")
|
||||
|
||||
(SETQ TEDIT.CHARLOOKSMENU.SPEC (LIST (create MB.TEXT
|
||||
MBSTRING _ "Props: "
|
||||
@@ -4188,7 +4190,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
MBFONT _ (FONTCREATE 'HELVETICA 8))
|
||||
(create MB.INSERT)))
|
||||
|
||||
(* ;;; "The paragraph-formatting menu (margins, etc.)")
|
||||
(* ;;; "The paragraph-formatting menu (margins, etc.)")
|
||||
|
||||
(SETQ TEDIT.PARAMENU.SPEC (LIST (create MB.BUTTON
|
||||
MBLABEL _ 'APPLY
|
||||
@@ -4217,7 +4219,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
|
||||
MBSTRING _ " type:")
|
||||
(create MB.INSERT)
|
||||
(create MB.TEXT
|
||||
MBSTRING _ "%
|
||||
MBSTRING _ "
|
||||
Line leading:"
|
||||
MBFONT _ (FONTCREATE 'HELVETICA 8))
|
||||
(create MB.INSERT)
|
||||
@@ -4234,7 +4236,7 @@ Line leading:"
|
||||
MBFONT _ (FONTCREATE 'HELVETICA 8))
|
||||
(create MB.INSERT)
|
||||
(create MB.TEXT
|
||||
MBSTRING _ "picas%
|
||||
MBSTRING _ "picas
|
||||
New Page: "
|
||||
MBFONT _ (FONTCREATE 'HELVETICA 8))
|
||||
(create MB.3STATE
|
||||
@@ -4279,7 +4281,7 @@ Tab Type: "
|
||||
MBSTRING _ "
|
||||
")))
|
||||
|
||||
(* ;;; "Page-layout menu for columns, page headings, page numbers, etc.")
|
||||
(* ;;; "Page-layout menu for columns, page headings, page numbers, etc.")
|
||||
|
||||
(SETQ TEDIT.PAGEMENU.SPEC (APPEND (LIST (create MB.BUTTON
|
||||
MBLABEL _ 'APPLY
|
||||
@@ -4342,7 +4344,8 @@ Tab Type: "
|
||||
MBBUTTONS _ '(123 xiv XIV)
|
||||
MBINITSTATE _ '123)
|
||||
(create MB.TEXT
|
||||
MBSTRING _ "%
|
||||
MBSTRING _ "
|
||||
|
||||
")
|
||||
(create MB.TEXT
|
||||
MBSTRING _ "Alignment: ")
|
||||
@@ -4400,7 +4403,7 @@ Tab Type: "
|
||||
MBSTRING _ "Page Headings:"
|
||||
MBFONT _ (FONTCREATE 'HELVETICA 10 'BOLD))
|
||||
(create MB.TEXT
|
||||
MBSTRING _ "%
|
||||
MBSTRING _ "
|
||||
Heading Type:")
|
||||
(create MB.INSERT)
|
||||
(create MB.TEXT
|
||||
@@ -4419,7 +4422,7 @@ Tab Type: "
|
||||
MBSTRING _ " Y:")
|
||||
(create MB.INSERT)
|
||||
(create MB.TEXT
|
||||
MBSTRING _ "%
|
||||
MBSTRING _ "
|
||||
Heading Type:")
|
||||
(create MB.INSERT)
|
||||
(create MB.TEXT
|
||||
@@ -4499,42 +4502,42 @@ Tab Type: "
|
||||
(PUTPROPS TEDITMENU COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 1995 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6319 33161 (MB.BUTTONEVENTINFN 6329 . 7660) (MB.DISPLAY 7662 . 10030) (MB.SETIMAGE
|
||||
10032 . 10990) (MB.SELFN 10992 . 12407) (MB.SIZEFN 12409 . 13426) (MB.WHENOPERATEDFN 13428 . 13760) (
|
||||
MB.COPYFN 13762 . 14224) (MB.GETFN 14226 . 14834) (MB.PUTFN 14836 . 15613) (MB.SHOWSELFN 15615 . 16587
|
||||
) (MBUTTON.CREATE 16589 . 17873) (MBUTTON.CHANGENAME 17875 . 18270) (MBUTTON.FIND.BUTTON 18272 . 19288
|
||||
) (MBUTTON.FIND.NEXT.BUTTON 19290 . 20685) (MBUTTON.FIND.NEXT.FIELD 20687 . 24401) (MBUTTON.INIT 24403
|
||||
. 25193) (MBUTTON.NEXT.FIELD.AS.NUMBER 25195 . 25548) (MBUTTON.NEXT.FIELD.AS.PIECES 25550 . 25980) (
|
||||
MBUTTON.NEXT.FIELD.AS.TEXT 25982 . 26404) (MBUTTON.NEXT.FIELD.AS.ATOM 26406 . 27279) (
|
||||
MBUTTON.SET.FIELD 27281 . 29337) (MBUTTON.SET.NEXT.FIELD 29339 . 30556) (MBUTTON.SET.NEXT.BUTTON.STATE
|
||||
30558 . 31054) (TEDITMENU.STREAM 31056 . 31665) (\TEDITMENU.SELSCREENER 31667 . 33159)) (33465 43888
|
||||
(MB.CREATE.THREESTATEBUTTON 33475 . 34646) (MB.THREESTATE.DISPLAY 34648 . 37238) (
|
||||
MB.THREESTATE.SHOWSELFN 37240 . 40342) (MB.THREESTATE.WHENOPERATEDFN 40344 . 41723) (
|
||||
MB.THREESTATEBUTTON.FN 41725 . 42822) (THREESTATE.INIT 42824 . 43886)) (43989 63225 (
|
||||
MB.CREATE.NWAYBUTTON 43999 . 47967) (MB.NB.DISPLAYFN 47969 . 50241) (MB.NB.WHENOPERATEDFN 50243 .
|
||||
51275) (MB.NB.SIZEFN 51277 . 54816) (MB.NWAYBUTTON.SELFN 54818 . 56762) (MB.NWAYMENU.NEWBUTTON 56764
|
||||
. 57350) (NWAYBUTTON.INIT 57352 . 58205) (MB.NB.PACKITEMS 58207 . 60204) (MB.NWAYBUTTON.ADDITEM 60206
|
||||
. 63223)) (63479 74127 (\TEXTMENU.TOGGLE.CREATE 63489 . 64890) (\TEXTMENU.TOGGLE.DISPLAY 64892 .
|
||||
67244) (\TEXTMENU.TOGGLE.SHOWSELFN 67246 . 69608) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69610 . 70998) (
|
||||
\TEXTMENU.TOGGLEFN 71000 . 72080) (\TEXTMENU.TOGGLE.INIT 72082 . 72917) (\TEXTMENU.SET.TOGGLE 72919 .
|
||||
74125)) (74379 111751 (DRAWMARGINSCALE 74389 . 77933) (MARGINBAR 77935 . 85305) (MARGINBAR.CREATE
|
||||
85307 . 88217) (MB.MARGINBAR.SELFN 88219 . 100813) (MB.MARGINBAR.SIZEFN 100815 . 101177) (
|
||||
MB.MARGINBAR.DISPLAYFN 101179 . 103864) (MDESCALE 103866 . 104305) (MSCALE 104307 . 104641) (
|
||||
MB.MARGINBAR.SHOWTAB 104643 . 106814) (MB.MARGINBAR.TABTRACK 106816 . 108151) (\TEDIT.TABTYPE.SET
|
||||
108153 . 110860) (MARGINBAR.INIT 110862 . 111749)) (112768 130370 (\TEXTMENU.START 112778 . 115970) (
|
||||
\TEXTMENU.DOC.CREATE 115972 . 127496) (TEXTMENU.CLOSEFN 127498 . 130368)) (130680 150744 (
|
||||
\TEDITMENU.CREATE 130690 . 130990) (\TEDIT.EXPANDED.MENU 130992 . 131696) (MB.DEFAULTBUTTON.FN 131698
|
||||
. 134570) (\TEDITMENU.RECORD.UNFORMATTED 134572 . 134910) (MB.DEFAULTBUTTON.ACTIONFN 134912 . 150742)
|
||||
) (150745 178128 (\TEDIT.CHARLOOKSMENU.CREATE 150755 . 152895) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152897
|
||||
. 153271) (\TEDIT.APPLY.BOLDNESS 153273 . 153558) (\TEDIT.APPLY.CHARLOOKS 153560 . 155491) (
|
||||
\TEDIT.APPLY.OLINE 155493 . 155774) (\TEDIT.SHOW.CHARLOOKS 155776 . 157689) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS 157691 . 158617) (\TEDIT.FILL.IN.CHARLOOKS.MENU 158619 . 166272) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166274 . 169157) (\TEDIT.PARSE.CHARLOOKS.MENU 169159 . 177267) (
|
||||
\TEDIT.APPLY.SLOPE 177269 . 177552) (\TEDIT.APPLY.STRIKEOUT 177554 . 177841) (\TEDIT.APPLY.ULINE
|
||||
177843 . 178126)) (178129 210195 (\TEDITPARAMENU.CREATE 178139 . 178519) (\TEDIT.EXPANDEDPARA.MENU
|
||||
178521 . 178841) (\TEDIT.APPLY.PARALOOKS 178843 . 191073) (\TEDIT.SHOW.PARALOOKS 191075 . 202602) (
|
||||
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 202604 . 208675) (\TEDIT.RECORD.TABLEADERS 208677 . 210193)) (210196
|
||||
248198 (\TEDIT.SHOW.PAGEFORMATTING 210206 . 226746) (\TEDITPAGEMENU.CREATE 226748 . 227791) (
|
||||
\TEDIT.APPLY.PAGEFORMATTING 227793 . 240164) (TEDIT.UNPARSE.PAGEFORMAT 240166 . 248196)) (248503
|
||||
275352 (\TEDIT.MENU.INIT 248513 . 275350)))))
|
||||
(FILEMAP (NIL (6266 33108 (MB.BUTTONEVENTINFN 6276 . 7607) (MB.DISPLAY 7609 . 9977) (MB.SETIMAGE 9979
|
||||
. 10937) (MB.SELFN 10939 . 12354) (MB.SIZEFN 12356 . 13373) (MB.WHENOPERATEDFN 13375 . 13707) (
|
||||
MB.COPYFN 13709 . 14171) (MB.GETFN 14173 . 14781) (MB.PUTFN 14783 . 15560) (MB.SHOWSELFN 15562 . 16534
|
||||
) (MBUTTON.CREATE 16536 . 17820) (MBUTTON.CHANGENAME 17822 . 18217) (MBUTTON.FIND.BUTTON 18219 . 19235
|
||||
) (MBUTTON.FIND.NEXT.BUTTON 19237 . 20632) (MBUTTON.FIND.NEXT.FIELD 20634 . 24348) (MBUTTON.INIT 24350
|
||||
. 25140) (MBUTTON.NEXT.FIELD.AS.NUMBER 25142 . 25495) (MBUTTON.NEXT.FIELD.AS.PIECES 25497 . 25927) (
|
||||
MBUTTON.NEXT.FIELD.AS.TEXT 25929 . 26351) (MBUTTON.NEXT.FIELD.AS.ATOM 26353 . 27226) (
|
||||
MBUTTON.SET.FIELD 27228 . 29284) (MBUTTON.SET.NEXT.FIELD 29286 . 30503) (MBUTTON.SET.NEXT.BUTTON.STATE
|
||||
30505 . 31001) (TEDITMENU.STREAM 31003 . 31612) (\TEDITMENU.SELSCREENER 31614 . 33106)) (33412 43835
|
||||
(MB.CREATE.THREESTATEBUTTON 33422 . 34593) (MB.THREESTATE.DISPLAY 34595 . 37185) (
|
||||
MB.THREESTATE.SHOWSELFN 37187 . 40289) (MB.THREESTATE.WHENOPERATEDFN 40291 . 41670) (
|
||||
MB.THREESTATEBUTTON.FN 41672 . 42769) (THREESTATE.INIT 42771 . 43833)) (43936 63172 (
|
||||
MB.CREATE.NWAYBUTTON 43946 . 47914) (MB.NB.DISPLAYFN 47916 . 50188) (MB.NB.WHENOPERATEDFN 50190 .
|
||||
51222) (MB.NB.SIZEFN 51224 . 54763) (MB.NWAYBUTTON.SELFN 54765 . 56709) (MB.NWAYMENU.NEWBUTTON 56711
|
||||
. 57297) (NWAYBUTTON.INIT 57299 . 58152) (MB.NB.PACKITEMS 58154 . 60151) (MB.NWAYBUTTON.ADDITEM 60153
|
||||
. 63170)) (63426 74074 (\TEXTMENU.TOGGLE.CREATE 63436 . 64837) (\TEXTMENU.TOGGLE.DISPLAY 64839 .
|
||||
67191) (\TEXTMENU.TOGGLE.SHOWSELFN 67193 . 69555) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69557 . 70945) (
|
||||
\TEXTMENU.TOGGLEFN 70947 . 72027) (\TEXTMENU.TOGGLE.INIT 72029 . 72864) (\TEXTMENU.SET.TOGGLE 72866 .
|
||||
74072)) (74326 111698 (DRAWMARGINSCALE 74336 . 77880) (MARGINBAR 77882 . 85252) (MARGINBAR.CREATE
|
||||
85254 . 88164) (MB.MARGINBAR.SELFN 88166 . 100760) (MB.MARGINBAR.SIZEFN 100762 . 101124) (
|
||||
MB.MARGINBAR.DISPLAYFN 101126 . 103811) (MDESCALE 103813 . 104252) (MSCALE 104254 . 104588) (
|
||||
MB.MARGINBAR.SHOWTAB 104590 . 106761) (MB.MARGINBAR.TABTRACK 106763 . 108098) (\TEDIT.TABTYPE.SET
|
||||
108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130317 (\TEXTMENU.START 112725 . 115917) (
|
||||
\TEXTMENU.DOC.CREATE 115919 . 127443) (TEXTMENU.CLOSEFN 127445 . 130315)) (130627 150691 (
|
||||
\TEDITMENU.CREATE 130637 . 130937) (\TEDIT.EXPANDED.MENU 130939 . 131643) (MB.DEFAULTBUTTON.FN 131645
|
||||
. 134517) (\TEDITMENU.RECORD.UNFORMATTED 134519 . 134857) (MB.DEFAULTBUTTON.ACTIONFN 134859 . 150689)
|
||||
) (150692 178075 (\TEDIT.CHARLOOKSMENU.CREATE 150702 . 152842) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152844
|
||||
. 153218) (\TEDIT.APPLY.BOLDNESS 153220 . 153505) (\TEDIT.APPLY.CHARLOOKS 153507 . 155438) (
|
||||
\TEDIT.APPLY.OLINE 155440 . 155721) (\TEDIT.SHOW.CHARLOOKS 155723 . 157636) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS 157638 . 158564) (\TEDIT.FILL.IN.CHARLOOKS.MENU 158566 . 166219) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166221 . 169104) (\TEDIT.PARSE.CHARLOOKS.MENU 169106 . 177214) (
|
||||
\TEDIT.APPLY.SLOPE 177216 . 177499) (\TEDIT.APPLY.STRIKEOUT 177501 . 177788) (\TEDIT.APPLY.ULINE
|
||||
177790 . 178073)) (178076 210142 (\TEDITPARAMENU.CREATE 178086 . 178466) (\TEDIT.EXPANDEDPARA.MENU
|
||||
178468 . 178788) (\TEDIT.APPLY.PARALOOKS 178790 . 191020) (\TEDIT.SHOW.PARALOOKS 191022 . 202549) (
|
||||
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 202551 . 208622) (\TEDIT.RECORD.TABLEADERS 208624 . 210140)) (210143
|
||||
248145 (\TEDIT.SHOW.PAGEFORMATTING 210153 . 226693) (\TEDITPAGEMENU.CREATE 226695 . 227738) (
|
||||
\TEDIT.APPLY.PAGEFORMATTING 227740 . 240111) (TEDIT.UNPARSE.PAGEFORMAT 240113 . 248143)) (248450
|
||||
275299 (\TEDIT.MENU.INIT 248460 . 275297)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
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
3827
library/exports.all
3827
library/exports.all
File diff suppressed because it is too large
Load Diff
@@ -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.
File diff suppressed because one or more lines are too long
@@ -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.
File diff suppressed because one or more lines are too long
28667
loadups/full.database
Normal file
28667
loadups/full.database
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,12 +1,12 @@
|
||||
|
||||
Full loadup started at 26-Apr-2021 23:01:47 while connected to
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>
|
||||
Full loadup started at 27-Jul-2021 21:13:36 while connected to
|
||||
{DSK}<home>larry>new>medley>
|
||||
|
||||
loading POSTSCRIPTSTREAM
|
||||
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>sources>INTERPRESS.LCOM;6
|
||||
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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.LCOM;1
|
||||
compiled on 18-May-2018 09:17:04
|
||||
File created 25-Aug-94 10:53:00
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.LCOM;1
|
||||
compiled on 18-May-2018 09:18:38
|
||||
File created 25-Aug-94 13:26:23
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITFILE.LCOM;1
|
||||
compiled on 18-May-2018 09:17:06
|
||||
File created 19-May-2001 11:45:53
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.LCOM;1
|
||||
compiled on 4-Jan-2021 13:48:55
|
||||
File created 4-Jan-2021 13:48:43
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.LCOM;29
|
||||
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}<Users>kaplan>Local>medley3.5>git-medley>library>TABLEBROWSER.LCOM;3
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>GRAPHER.LCOM;2
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>CASH-FILE.DFASL;4
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.LCOM;21
|
||||
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}<Users>kaplan>Local>medley3.5>git-medley>lispusers>ISO8859IO.LCOM;3
|
||||
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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.LCOM;6
|
||||
{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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-medley>library>CLIPBOARD.LCOM;9
|
||||
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}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.LCOM;14
|
||||
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}<Users>kaplan>Local>medley3.5>git-medley>lispusers>PRETTYFILEINDEX.LCOM;2
|
||||
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}<Users>kaplan>Local>medley3.5>git-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}<Users>kaplan>Local>medley3.5>git-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.
1
loadups/makeinit.dribble
Normal file
1
loadups/makeinit.dribble
Normal file
File diff suppressed because one or more lines are too long
File diff suppressed because it is too large
Load Diff
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