Compare commits
63 Commits
medley-220
...
medley-230
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
f2ef7cc8f6 | ||
|
|
0c9b539bc4 | ||
|
|
b53b6c4ba7 | ||
|
|
e5593ba0dc | ||
|
|
5fea4e6666 | ||
|
|
306af20e91 | ||
|
|
bb637c5b73 | ||
|
|
7eb12ee68b | ||
|
|
97cb04be46 | ||
|
|
62754015b0 | ||
|
|
9d09033cc4 | ||
|
|
d9c144d966 | ||
|
|
17dd03a358 | ||
|
|
382881a068 | ||
|
|
d0d952a10d | ||
|
|
d5d21397d4 | ||
|
|
7a4470ce8b | ||
|
|
32ff7b7649 | ||
|
|
096d860ac8 | ||
|
|
418b1df00d | ||
|
|
ba90344080 | ||
|
|
0eac6efb61 | ||
|
|
540aff091c | ||
|
|
3f244f6cd3 | ||
|
|
58557d383a | ||
|
|
882fbacf59 | ||
|
|
70ce516e0c | ||
|
|
fdb573c761 | ||
|
|
06368f95eb | ||
|
|
654ebc359c | ||
|
|
4e38802325 | ||
|
|
b43b63b287 | ||
|
|
016097e8bf | ||
|
|
99321e7951 | ||
|
|
8e4fc4ab74 | ||
|
|
c005cf86bf | ||
|
|
ecc2b22207 | ||
|
|
d0945f7a5f | ||
|
|
add65a9397 | ||
|
|
0474f924a4 | ||
|
|
a387094eab | ||
|
|
541a07e09b | ||
|
|
5ee5482dd2 | ||
|
|
095beef454 | ||
|
|
06a7356b00 | ||
|
|
147abac04c | ||
|
|
56a52af6b9 | ||
|
|
fad70d4947 | ||
|
|
f4c91ec419 | ||
|
|
f5e48847c9 | ||
|
|
b90bf65be9 | ||
|
|
d379bcc102 | ||
|
|
39a7512458 | ||
|
|
431d80fb3c | ||
|
|
78b76f6801 | ||
|
|
16517cdfc5 | ||
|
|
902d542121 | ||
|
|
c708f2ac55 | ||
|
|
43e6801341 | ||
|
|
27a6063ce9 | ||
|
|
cd6b64efa2 | ||
|
|
222da55f69 | ||
|
|
92f85c5957 |
9
.gitattributes
vendored
Normal file
9
.gitattributes
vendored
Normal file
@@ -0,0 +1,9 @@
|
||||
# Denote all files that are truly binary and should not be modified.
|
||||
*.tedit binary
|
||||
*.lcom binary
|
||||
*.sketch binary
|
||||
*.dfasl binary
|
||||
*.TEDIT binary
|
||||
*.LCOM binary
|
||||
*.SKETCH binary
|
||||
*.DFASL binary
|
||||
61
.github/workflows/buildDocker.yml
vendored
61
.github/workflows/buildDocker.yml
vendored
@@ -21,6 +21,12 @@ name: 'Build/Push Docker Image'
|
||||
on:
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
type: choice
|
||||
@@ -34,6 +40,11 @@ on:
|
||||
description: "'True' if medley docker build completed successully"
|
||||
value: ${{ jobs.complete.outputs.build_successful }}
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
required: false
|
||||
@@ -60,13 +71,20 @@ jobs:
|
||||
inputs:
|
||||
runs-on: ubuntu-latest
|
||||
outputs:
|
||||
force: ${{ steps.force.outputs.force }}
|
||||
draft: ${{ steps.one.outputs.draft }}
|
||||
force: ${{ steps.one.outputs.force }}
|
||||
steps:
|
||||
- id: force
|
||||
- id: one
|
||||
run: >
|
||||
if [ '${{ toJSON(inputs) }}' = 'null' ];
|
||||
then echo ::set-output name=force::'${{ github.event.inputs.force }}'; echo "workflow_dispatch";
|
||||
else echo ::set-output name=force::'${{ inputs.force }}'; echo "workflow_call";
|
||||
then
|
||||
echo "workflow_dispatch";
|
||||
echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
else
|
||||
echo "workflow_call";
|
||||
echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
fi
|
||||
|
||||
|
||||
@@ -85,7 +103,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -117,7 +135,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout latest commit
|
||||
- name: Checkout Medley
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
|
||||
# Set repo env variables
|
||||
- name: Set repo/docker env variables
|
||||
@@ -125,22 +143,22 @@ jobs:
|
||||
run: |
|
||||
REPO_NAME=${GITHUB_REPOSITORY#*/}
|
||||
echo "REPO_NAME=${REPO_NAME}" >> ${GITHUB_ENV}
|
||||
echo ::set-output name=repo_name::${REPO_NAME}
|
||||
echo "repo_name=${REPO_NAME}" >> ${GITHUB_OUTPUT}
|
||||
DOCKER_NAMESPACE=$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')
|
||||
echo "DOCKER_NAMESPACE=${DOCKER_NAMESPACE}" >> ${GITHUB_ENV}
|
||||
echo ::set-output name=docker_namespace::${DOCKER_NAMESPACE}
|
||||
echo "docker_namespace=${DOCKER_NAMESPACE}" >> ${GITHUB_OUTPUT}
|
||||
|
||||
# Get tag of latest Medley release.
|
||||
- name: Get Medley Release Information
|
||||
id: release_info
|
||||
uses: abatilo/release-info-action@v1.3.0
|
||||
uses: abatilo/release-info-action@v1.3.2
|
||||
with:
|
||||
owner: ${{ github.repository_owner }}
|
||||
repo: medley
|
||||
|
||||
# Get asset tars from latest Medley release
|
||||
- name: Download Release Assets
|
||||
uses: robinraju/release-downloader@v1.2
|
||||
uses: robinraju/release-downloader@v1.7
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/medley
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
@@ -155,7 +173,7 @@ jobs:
|
||||
docker pull ${DOCKER_NAMESPACE}/maiko:latest
|
||||
MAIKO_RELEASE=$(docker run --entrypoint /bin/bash ${DOCKER_NAMESPACE}/maiko:latest -c "echo \${MAIKO_RELEASE}")
|
||||
echo "MAIKO_RELEASE=${MAIKO_RELEASE}" >> ${GITHUB_ENV}
|
||||
echo ::set-output name=maiko_release::${MAIKO_RELEASE}
|
||||
echo "maiko_release=${MAIKO_RELEASE}" >> ${GITHUB_OUTPUT}
|
||||
|
||||
# Setup environment variables
|
||||
- name: Setup Environment Variables
|
||||
@@ -163,11 +181,14 @@ jobs:
|
||||
run: |
|
||||
RELEASE_TAG=${{ steps.release_info.outputs.latest_tag }}
|
||||
DOCKER_IMAGE=${DOCKER_NAMESPACE}/${REPO_NAME}
|
||||
DOCKER_TAGS="${DOCKER_IMAGE}:latest,${DOCKER_IMAGE}:${RELEASE_TAG#*-}_${MAIKO_RELEASE#*-}"
|
||||
echo ::set-output name=docker_tags::${DOCKER_TAGS}
|
||||
echo ::set-output name=docker_image::${DOCKER_IMAGE}
|
||||
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
|
||||
echo ::set-output name=release_tag::${RELEASE_TAG}
|
||||
if [ "${{ needs.inputs.outputs.draft }}" = "false" ];
|
||||
then DOCKER_TAGS="${DOCKER_IMAGE}:latest,${DOCKER_IMAGE}:${RELEASE_TAG#*-}_${MAIKO_RELEASE#*-}"
|
||||
else DOCKER_TAGS="${DOCKER_IMAGE}:draft"
|
||||
fi
|
||||
echo "docker_tags=${DOCKER_TAGS}" >> ${GITHUB_OUTPUT}
|
||||
echo "docker_image=${DOCKER_IMAGE}" >> ${GITHUB_OUTPUT}
|
||||
echo "build_time=$(date -u +'%Y-%m-%dT%H:%M:%SZ')" >> ${GITHUB_OUTPUT}
|
||||
echo "release_tag=${RELEASE_TAG}" >> ${GITHUB_OUTPUT}
|
||||
echo "release_tag=${RELEASE_TAG}" >> ${GITHUB_ENV}
|
||||
|
||||
# Setup the Docker Machine Emulation environment.
|
||||
@@ -183,7 +204,7 @@ jobs:
|
||||
|
||||
# Login into DockerHub - required to store the created image
|
||||
- name: Login to DockerHub
|
||||
uses: docker/login-action@v1
|
||||
uses: docker/login-action@v2
|
||||
with:
|
||||
username: ${{ secrets.DOCKER_USERNAME }}
|
||||
password: ${{ secrets.DOCKER_PASSWORD }}
|
||||
@@ -192,7 +213,7 @@ jobs:
|
||||
# checked out and the release tars just downloaded.
|
||||
# Push the result to Docker Hub
|
||||
- name: Build Docker Image for Push to Docker Hub
|
||||
uses: docker/build-push-action@v2
|
||||
uses: docker/build-push-action@v3
|
||||
with:
|
||||
builder: ${{ steps.buildx.outputs.name }}
|
||||
build-args: |
|
||||
@@ -225,7 +246,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -241,6 +262,6 @@ jobs:
|
||||
- name: Output
|
||||
id: output
|
||||
run: |
|
||||
echo ::set-output name=build_successful::'true'
|
||||
echo "build_successful='true'" >> ${GITHUB_OUTPUT}
|
||||
|
||||
######################################################################################
|
||||
|
||||
180
.github/workflows/buildLoadup.yml
vendored
180
.github/workflows/buildLoadup.yml
vendored
@@ -1,4 +1,4 @@
|
||||
#re*******************************************************************************
|
||||
#*******************************************************************************
|
||||
# buidLoadup.yml
|
||||
#
|
||||
# Interlisp workflow to build Medley release and push it to github. This workflow
|
||||
@@ -10,7 +10,7 @@
|
||||
#
|
||||
# 2022-01-17 Frank Halasz based on an earlier version of buildLoadup for Medley.
|
||||
#
|
||||
# Copyright 2022 by Interlisp.org
|
||||
# Copyright 2022-2023 by Interlisp.org
|
||||
#
|
||||
# ******************************************************************************
|
||||
|
||||
@@ -20,6 +20,12 @@ name: Build/Push Medley Release
|
||||
on:
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
type: choice
|
||||
@@ -33,6 +39,11 @@ on:
|
||||
description: "'True' if medley build completed successully"
|
||||
value: ${{ jobs.complete.outputs.build_successful }}
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
required: false
|
||||
@@ -54,13 +65,20 @@ jobs:
|
||||
inputs:
|
||||
runs-on: ubuntu-latest
|
||||
outputs:
|
||||
force: ${{ steps.force.outputs.force }}
|
||||
draft: ${{ steps.one.outputs.draft }}
|
||||
force: ${{ steps.one.outputs.force }}
|
||||
steps:
|
||||
- id: force
|
||||
- id: one
|
||||
run: >
|
||||
if [ '${{ toJSON(inputs) }}' = 'null' ];
|
||||
then echo ::set-output name=force::'${{ github.event.inputs.force }}'; echo "workflow_dispatch";
|
||||
else echo ::set-output name=force::'${{ inputs.force }}'; echo "workflow_call";
|
||||
then
|
||||
echo "workflow_dispatch";
|
||||
echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
else
|
||||
echo "workflow_call";
|
||||
echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
fi
|
||||
|
||||
|
||||
@@ -79,7 +97,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -110,7 +128,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -118,7 +136,7 @@ jobs:
|
||||
|
||||
# Checkout latest commit
|
||||
- name: Checkout Medley
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
|
||||
# Setup release tag
|
||||
- name: Setup Release Tag
|
||||
@@ -129,64 +147,85 @@ jobs:
|
||||
- name: Setup Environment Variables
|
||||
id: setup_env
|
||||
run: |
|
||||
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
|
||||
echo "build_time=$(date -u +'%Y-%m-%dT%H:%M:%SZ')" >> ${GITHUB_OUTPUT}
|
||||
echo "TARBALL_DIR=installers/deb/tmp/tarballs" >>${GITHUB_ENV}
|
||||
echo "DEBS_DIR=installers/deb/debs" >>${GITHUB_ENV}
|
||||
echo "TARS_DIR=installers/deb/tars" >>${GITHUB_ENV}
|
||||
echo "MEDLEY_RELEASE_TAG=${RELEASE_TAG}" >>${GITHUB_ENV}
|
||||
|
||||
# Setup some needed dirs in workspace
|
||||
- name: Create work dirs
|
||||
run: mkdir -p ${TARBALL_DIR}
|
||||
|
||||
# Get Maiko release information, retrieves the name of the latest
|
||||
# release. Used to download the correct Maiko release
|
||||
- name: Get Maiko Release Information
|
||||
id: latest_version
|
||||
uses: abatilo/release-info-action@v1.3.0
|
||||
id: maiko
|
||||
uses: abatilo/release-info-action@v1.3.2
|
||||
with:
|
||||
owner: ${{ github.repository_owner }}
|
||||
repo: maiko
|
||||
|
||||
# Download Maiko Release Assets
|
||||
- name: Download Release Assets
|
||||
uses: robinraju/release-downloader@v1.2
|
||||
uses: robinraju/release-downloader@v1.6
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/maiko
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
latest: true
|
||||
fileName: "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
|
||||
out-file-path: ${{ env.TARBALL_DIR }}
|
||||
fileName: "${{ steps.maiko.outputs.latest_tag }}-linux.*.tgz"
|
||||
|
||||
- name: Untar Maiko Release
|
||||
- name: Untar Maiko Release for use in loadup
|
||||
run: |
|
||||
tar -xvzf "${{ steps.latest_version.outputs.latest_tag }}-linux.x86_64.tgz"
|
||||
tar -xzf "${TARBALL_DIR}/${{ steps.maiko.outputs.latest_tag }}-linux.x86_64.tgz"
|
||||
|
||||
# Checkout Notecards and tar it in the tarballsdir
|
||||
- name: Checkout Notecards
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/notecards
|
||||
path: ./notecards
|
||||
- run: mv ./notecards ../notecards
|
||||
- name: Tar notecards into tarball dir
|
||||
run: |
|
||||
cd ..
|
||||
tar cfz medley/${TARBALL_DIR}/notecards.tgz notecards
|
||||
|
||||
#
|
||||
- name: Install vnc
|
||||
run: sudo apt-get update && sudo apt-get install -y tightvncserver
|
||||
|
||||
- name: Build Loadout
|
||||
- name: Build Loadup sysouts and databases
|
||||
run: |
|
||||
Xvnc -geometry 1280x720 :0 &
|
||||
export DISPLAY=":0"
|
||||
PATH="$PWD/maiko:$PATH"
|
||||
scripts/loadup-all.sh
|
||||
scripts/loadup-all.sh -apps
|
||||
|
||||
- name: Build loadups release tar
|
||||
run: |
|
||||
cp -p tmp/full.sysout tmp/lisp.sysout tmp/whereis.hash loadups/
|
||||
cp -p tmp/exports.all library/
|
||||
cd ..
|
||||
tar cfz medley/tmp/${release_tag}-loadups.tgz \
|
||||
tar cfz medley/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-loadups.tgz \
|
||||
medley/loadups/lisp.sysout \
|
||||
medley/loadups/full.sysout \
|
||||
medley/loadups/apps.sysout \
|
||||
medley/loadups/whereis.hash \
|
||||
medley/library/exports.all
|
||||
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
|
||||
- name: Build runtime release tar
|
||||
run: |
|
||||
cd ..
|
||||
tar cfz medley/tmp/${release_tag}-runtime.tgz \
|
||||
tar cfz medley/${TARBALL_DIR}/${MEDLEY_RELEASE_TAG}-runtime.tgz \
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
--exclude exports.all \
|
||||
medley/clos \
|
||||
medley/docs/dinfo \
|
||||
medley/docs/man-page/medley.1.gz \
|
||||
medley/doctools \
|
||||
medley/greetfiles \
|
||||
medley/rooms \
|
||||
medley/medley \
|
||||
medley/run-medley \
|
||||
medley/scripts \
|
||||
medley/fonts/displayfonts \
|
||||
@@ -197,39 +236,70 @@ jobs:
|
||||
medley/lispusers \
|
||||
medley/sources \
|
||||
medley/internal
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
|
||||
|
||||
- name: "Create release"
|
||||
uses: "actions/github-script@v5"
|
||||
- name: Build .deb files for 3 architectures
|
||||
run: |
|
||||
cd installers/deb
|
||||
./build_deb.sh
|
||||
|
||||
- name: Delete existing release with same tag (if any)
|
||||
uses: cb80/delrel@latest
|
||||
with:
|
||||
github-token: "${{ secrets.GITHUB_TOKEN }}"
|
||||
script: |
|
||||
try {
|
||||
await github.rest.repos.createRelease({
|
||||
draft: false,
|
||||
generate_release_notes: true,
|
||||
name: process.env.release_tag,
|
||||
owner: context.repo.owner,
|
||||
prerelease: false,
|
||||
repo: context.repo.repo,
|
||||
tag_name: process.env.release_tag,
|
||||
});
|
||||
} catch (error) {
|
||||
core.setFailed(error.message);
|
||||
}
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
tag: ${{ env.MEDLEY_RELEASE_TAG }}
|
||||
continue-on-error: true
|
||||
|
||||
- name: "Upload release assets"
|
||||
uses: AButler/upload-release-assets@v2.0
|
||||
with:
|
||||
files: 'tmp/${{ env.release_tag }}-loadups.tgz;tmp/${{ env.release_tag }}-runtime.tgz'
|
||||
repo-token: ${{ secrets.GITHUB_TOKEN }}
|
||||
release-tag: ${{ env.release_tag }}
|
||||
- name: Push the release
|
||||
id: push_release
|
||||
uses: ncipollo/release-action@v1
|
||||
with:
|
||||
allowUpdates: true
|
||||
artifacts:
|
||||
${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-loadups.tgz,
|
||||
${{ env.TARBALL_DIR }}/${{ env.MEDLEY_RELEASE_TAG }}-runtime.tgz,
|
||||
${{ env.DEBS_DIR }}/*.deb,
|
||||
${{ env.TARS_DIR }}/*.tgz
|
||||
tag: ${{ env.MEDLEY_RELEASE_TAG }}
|
||||
draft: ${{ needs.inputs.outputs.draft }}
|
||||
prerelease: false
|
||||
generateReleaseNotes: true
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
|
||||
- name: Update the downloads page and the man page to the OIO satic page host
|
||||
run: |
|
||||
maiko_release_tag="${{ steps.maiko.outputs.latest_tag }}"
|
||||
medley_short_release_tag="${MEDLEY_RELEASE_TAG#medley-}"
|
||||
full_release_filename="${MEDLEY_RELEASE_TAG/medley/medley-full}_${maiko_release_tag#maiko-}"
|
||||
# Need info about where github stores assets because draft releases are not tagged
|
||||
release_url="${{ steps.push_release.outputs.html_url }}"
|
||||
github_subdir="$( echo "${release_url}" | sed -e "s#^.*/\([^/]\+\)\$#\1#g" )"
|
||||
#
|
||||
local_template="installers/downloads_page/medley_downloads.html"
|
||||
local_filename="medley_downloads.html"
|
||||
if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
|
||||
then
|
||||
remote_filename="draft_downloads"
|
||||
else
|
||||
remote_filename="${local_filename%.html}"
|
||||
fi
|
||||
remote_filepath="/srv/oio/static/${remote_filename}"
|
||||
sed \
|
||||
-e "s/@@@FULL.RELEASE.FILENAME@@@/${full_release_filename}/g" \
|
||||
-e "s/@@@GITHUB.SUBDIR@@@/${github_subdir}/g" \
|
||||
-e "s/@@@MEDLEY.SHORT.RELEASE.TAG@@@/${medley_short_release_tag}/g" \
|
||||
< "${local_template}" > "${local_filename}"
|
||||
local_manpath="docs/man-page/man_medley.html"
|
||||
remote_manpath="/srv/oio/static/man_medley.html"
|
||||
echo "-rm ${remote_filepath}.oldold" > batch
|
||||
echo "-rename ${remote_filepath}.old ${remote_filepath}.oldold" >> batch
|
||||
echo "-rename ${remote_filepath}.html ${remote_filepath}.old" >> batch
|
||||
echo "-put ${local_filename} ${remote_filepath}.html" >> batch
|
||||
echo "-put ${local_manpath} ${remote_manpath}" >> batch
|
||||
eval $(ssh-agent)
|
||||
ssh-add - <<< "${SSH_KEY}"
|
||||
sftp -o StrictHostKeyChecking=no -b batch ubuntu@online.interlisp.org
|
||||
env:
|
||||
release_tag: ${{ steps.tag.outputs.release_tag }}
|
||||
SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
|
||||
|
||||
|
||||
######################################################################################
|
||||
@@ -249,7 +319,7 @@ jobs:
|
||||
steps:
|
||||
# Checkout the actions for this repo owner
|
||||
- name: Checkout Actions
|
||||
uses: actions/checkout@v2
|
||||
uses: actions/checkout@v3
|
||||
with:
|
||||
repository: ${{ github.repository_owner }}/.github
|
||||
path: ./Actions_${{ github.sha }}
|
||||
@@ -265,6 +335,6 @@ jobs:
|
||||
- name: Output
|
||||
id: output
|
||||
run: |
|
||||
echo ::set-output name=build_successful::'true'
|
||||
echo "build_successful='true'" >> $GITHUB_OUTPUT
|
||||
|
||||
######################################################################################
|
||||
|
||||
86
.github/workflows/buildReleaseInclDocker.yml
vendored
86
.github/workflows/buildReleaseInclDocker.yml
vendored
@@ -19,18 +19,96 @@ name: "Build/Push Release & Docker"
|
||||
# Run this workflow on ...
|
||||
on:
|
||||
workflow_dispatch:
|
||||
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
type: choice
|
||||
options:
|
||||
- 'false'
|
||||
- 'true'
|
||||
|
||||
workflow_call:
|
||||
outputs:
|
||||
successful:
|
||||
description: "'True' if medley build completed successully"
|
||||
value: ${{ jobs.complete.outputs.build_successful }}
|
||||
inputs:
|
||||
draft:
|
||||
description: "Mark this as a draft release"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
force:
|
||||
description: "Force build even if build already successfully completed for this commit"
|
||||
required: false
|
||||
type: string
|
||||
default: 'false'
|
||||
|
||||
defaults:
|
||||
run:
|
||||
shell: bash
|
||||
|
||||
|
||||
# Jobs that compose this workflow
|
||||
jobs:
|
||||
|
||||
|
||||
######################################################################################
|
||||
|
||||
# Regularize the inputs so they can be referenced the same way whether they are
|
||||
# the result of a workflow_dispatch or a workflow_call
|
||||
|
||||
inputs:
|
||||
runs-on: ubuntu-latest
|
||||
outputs:
|
||||
draft: ${{ steps.one.outputs.draft }}
|
||||
force: ${{ steps.one.outputs.force }}
|
||||
steps:
|
||||
- id: one
|
||||
run: >
|
||||
if [ '${{ toJSON(inputs) }}' = 'null' ];
|
||||
then
|
||||
echo "workflow_dispatch";
|
||||
echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
else
|
||||
echo "workflow_call";
|
||||
echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
|
||||
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
|
||||
fi
|
||||
|
||||
|
||||
######################################################################################
|
||||
|
||||
|
||||
# Build Loadup
|
||||
do_release:
|
||||
needs: inputs
|
||||
uses: ./.github/workflows/buildLoadup.yml
|
||||
with:
|
||||
draft: ${{ needs.inputs.outputs.draft }}
|
||||
force: ${{ needs.inputs.outputs.force }}
|
||||
|
||||
|
||||
######################################################################################
|
||||
|
||||
# Build Docker Image
|
||||
do_docker:
|
||||
needs: do_release
|
||||
needs: [inputs, do_release]
|
||||
uses: ./.github/workflows/buildDocker.yml
|
||||
with:
|
||||
draft: ${{ needs.inputs.outputs.draft }}
|
||||
force: ${{ needs.inputs.outputs.force }}
|
||||
secrets:
|
||||
DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
|
||||
DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
|
||||
DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }}
|
||||
DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }}
|
||||
|
||||
|
||||
######################################################################################
|
||||
|
||||
|
||||
7
.gitignore
vendored
7
.gitignore
vendored
@@ -10,6 +10,7 @@ loadups/lisp.sysout
|
||||
loadups/full.sysout
|
||||
loadups/*.dribble
|
||||
loadups/whereis.hash
|
||||
loadups/apps.sysout
|
||||
|
||||
# manual cross-reference files
|
||||
|
||||
@@ -36,3 +37,9 @@ core
|
||||
|
||||
# Mac OS detritus
|
||||
.DS_Store
|
||||
*.PS
|
||||
|
||||
# nano detritus
|
||||
*.swp
|
||||
*.save
|
||||
|
||||
|
||||
27
Dockerfile
27
Dockerfile
@@ -3,7 +3,7 @@
|
||||
# Dockerfile to build Medley image from latest Maiko image
|
||||
# plus latest release tars from github
|
||||
#
|
||||
# Copyright 2022 by Interlisp.org
|
||||
# Copyright 2022-2023 by Interlisp.org
|
||||
#
|
||||
# ******************************************************************************
|
||||
|
||||
@@ -29,26 +29,27 @@ LABEL maiko_release=$MAIKO_RELEASE
|
||||
ENV MEDLEY_BUILD_DATE=$BUILD_DATE
|
||||
ENV MEDLEY_RELEASE=$RELEASE_TAG
|
||||
|
||||
ARG INSTALL_LOCATION=/usr/local/interlisp
|
||||
ENV INSTALL_LOCATION=${INSTALL_LOCATION}
|
||||
ARG IL_INSTALLDIR=/usr/local/interlisp
|
||||
ENV IL_INSTALLDIR=${IL_INSTALLDIR}
|
||||
ENV MAIKO_INSTALLDIR=${IL_INSTALLDIR}/maiko
|
||||
ENV MEDLEY_INSTALLDIR=${IL_INSTALLDIR}/medley
|
||||
|
||||
ARG DOCKER_NAMESPACE=interlisp
|
||||
ENV DOCKER_NAMESPACE=${DOCKER_NAMESPACE}
|
||||
|
||||
# Copy over the release tars
|
||||
RUN mkdir -p ${INSTALL_LOCATION}
|
||||
ADD ./*.tgz ${INSTALL_LOCATION}
|
||||
ENV LANG=C.UTF-8
|
||||
|
||||
# Create a run_medley script in /usr/local/bin
|
||||
RUN mkdir -p /usr/local/bin && \
|
||||
echo "#!/bin/bash" > /usr/local/bin/run-medley && \
|
||||
echo "cd ${INSTALL_LOCATION}" >> /usr/local/bin/run-medley && \
|
||||
echo './run-medley "$@"' >> /usr/local/bin/run-medley && \
|
||||
chmod ugo+x /usr/local/bin/run-medley
|
||||
# Copy over the release tars
|
||||
RUN mkdir -p ${IL_INSTALLDIR}
|
||||
ADD ./*.tgz ${IL_INSTALLDIR}
|
||||
|
||||
# Link run_medley script into /usr/local/bin
|
||||
RUN mkdir -p /usr/local/bin && \
|
||||
ln -s ${MEDLEY_INSTALLDIR}/run-medley /usr/local/bin/run-medley
|
||||
|
||||
# "Finalize" image
|
||||
EXPOSE 5900
|
||||
RUN adduser --disabled-password --gecos "" medley
|
||||
USER medley
|
||||
WORKDIR /home/medley
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 ${INSTALL_LOCATION}/medley/run-medley -full -g 1280x720 -sc 1280x720
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 ${MEDELY_INSTALLDIR}/run-medley -full -g 1280x720 -sc 1280x720
|
||||
|
||||
2
docs/man-page/man2html.sh
Executable file
2
docs/man-page/man2html.sh
Executable file
@@ -0,0 +1,2 @@
|
||||
#!/bin/bash
|
||||
pandoc --from man --to html < medley.1 > man_medley.html
|
||||
92
docs/man-page/man_medley.html
Normal file
92
docs/man-page/man_medley.html
Normal file
@@ -0,0 +1,92 @@
|
||||
<h1>NAME</h1>
|
||||
<p><strong>medley</strong> — starts up Medley Interlisp</p>
|
||||
<h1>SYNOPSIS</h1>
|
||||
<p><strong>medley</strong> [ flags ... ] [ <em>SYSOUT_FILE</em> ] [ -- <em>PASS_ON_ARGS</em> ]</p>
|
||||
<h1>DESCRIPTION</h1>
|
||||
<p>Starts Medley Interlisp in a window.</p>
|
||||
<h1>OPTIONS</h1>
|
||||
<p><strong>MEDLEYDIR</strong> is an environment variable set by Medley and used by many of the options described below. MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that is invoked after all symbolic links are resolved. In the standard global installation this will be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and hence MEDLEYDIR is computed on each invocation of medley.</p>
|
||||
<h2>Flags</h2>
|
||||
|
||||
<dl>
|
||||
<dt><strong>-h, --help</strong></dt>
|
||||
<dd><p>Prints out a brief summary of the flags and arguments to medley.</p>
|
||||
</dd>
|
||||
<dt><strong>-z, --man</strong></dt>
|
||||
<dd><p>Show the man page for medley</p>
|
||||
</dd>
|
||||
<dt><strong>-f, --full</strong></dt>
|
||||
<dd><p>Start Medley from the standard “full” sysout. full.sysout includes a complete Interlisp and CommonLisp environment with a standard set of development tools. It does not include any of the applications built using Medley. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
</dd>
|
||||
<dt><strong>-l, --lisp</strong></dt>
|
||||
<dd><p>Start Medley from the standard “lisp” sysout. lisp.sysout only includes the basic Interlisp and CommonLisp environment. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
</dd>
|
||||
<dt><strong>-a, --apps</strong></dt>
|
||||
<dd><p>Start Medley from the standard “apps” sysout. apps.sysout includes everything in full.sysout plus Medley applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley documentation. (See <em>SYSOUT_FILE</em> below for more information on starting sysouts.)</p>
|
||||
</dd>
|
||||
<dt><strong>-e, --interlisp (relevent only when --apps is specified)</strong></dt>
|
||||
<dd><p>Make the initial Exec window within Medley be an Interlisp Exec. Default is to start in an XCL Exec.</p>
|
||||
</dd>
|
||||
<dt><strong>-n, --noscroll</strong></dt>
|
||||
<dd><p>Ordinarily Medley displays scroll bars to enable the user to pan the Medley virtual display within the Medley window. This is true even when the entire virtual display fits within the window. Specifying --noscroll turns off the scroll bars. Note: If --noscroll is specified and the virtual screen is larger than the window, there will be no way to pan to the non-visible parts of the virtual display.</p>
|
||||
</dd>
|
||||
<dt><strong>-g <em>WxH</em>, --geometry <em>WxH</em></strong></dt>
|
||||
<dd><p>Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows geomtery specification with +X+Y is not currently supported). If --geometry is not specified but --screensize is, then the window size will be determined based on the --screensize values and the --noscroll flag. If neither --geometry nor --screensize is provided, then the window size is set to 1440x900 if --noscroll is set and 1462x922 if --noscroll is not set.</p>
|
||||
</dd>
|
||||
<dt><strong>-s <em>WxH</em>, --screensize <em>WxH</em></strong></dt>
|
||||
<dd><p>Sets the size of the virtual display as seen from Medley’s point of view. The Medley window is an unscaled viewport onto this virtual display. If --screensize is not specified but --geometry is, then the virtual display size will be set so that the entire virtual display fits into the given window geometry. If neither --screensize nor --geometry is provided, then the screen size is set to 1440x900.</p>
|
||||
</dd>
|
||||
<dt><strong>-t <em>STRING</em>, --title <em>STRING</em></strong></dt>
|
||||
<dd><p>Use STRING as title of Medley window. Not relevent when the --vnc flag is set.</p>
|
||||
</dd>
|
||||
<dt><strong>-d <em>:N</em>, --display <em>:N</em></strong></dt>
|
||||
<dd><p>Use X display :N. Defaults to the value of $DISPLAY. Not relevant when the --vnc flag is set.</p>
|
||||
</dd>
|
||||
<dt><strong>-v, --vnc (Applicable only to Windows System for Linux installations)</strong></dt>
|
||||
<dd><p>Use a VNC window running on the Windows side instead of an X window. The VNC window will folllow the Windows desktop scaling setting allowing for much more usable Medley on high resolution displays. On WSL, X windows do not scale well.</p>
|
||||
</dd>
|
||||
<dt><strong>-i [<em>ID_STRING</em> | - | --], --id [<em>ID_STRING</em> | - | --]</strong></dt>
|
||||
<dd><p>Use ID_STRING as the id for this run of Medley, iunless ID_STRING is “-” or “--”. If ID_STRING is “-”, then use the basename of $MEDLEYDIR as the id. If ID_STRING is “--”, then use the basename of the parent directory of $MEDLEYDIR as the id. Only one instance of Medley with a given id can run at a time. The id is used to distinguish the virtual memory stores so that multiple instances of Medley can run simultaneously. Default id is “default”.</p>
|
||||
</dd>
|
||||
<dt><strong>-m <em>N</em>, --mem <em>N</em></strong></dt>
|
||||
<dd><p>Set Medley to run in N MB of virtual memory. Defaults to 256MB.</p>
|
||||
</dd>
|
||||
<dt><strong>-p <em>FILE</em>, --vmem <em>FILE</em></strong></dt>
|
||||
<dd><p>Use FILE as the Medley virtual memory (vmem) store. FILE must be writeable by the current user. Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously. The --id flag will not protect against vmem collisions when the --vmem flag is used. Default is to store the vmem in LOGINDIR/vmem/lisp_XXX.virtualmem, where XXX is the id of this Medley run (see --id flag above). See --logindir below for setting of LOGINDIR.</p>
|
||||
</dd>
|
||||
<dt><strong>-r [<em>FILE</em> | -], --greet [<em>FILE</em> | -]</strong></dt>
|
||||
<dd><p>Use FILE as the Medley greetfile, unless FILE is “-” in which case Medley will start up without using a greetfile. The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the --apps flag is used in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.</p>
|
||||
</dd>
|
||||
<dt><strong>-x [<em>DIR</em> | -], --logindir [<em>DIR</em> | -]</strong></dt>
|
||||
<dd><p>use DIR as LOGINDIR in Medley, unless DIR is “-”, in which case use $MEDLEYDIR/logindir. DIR (or $MEDLEYDIR/logindir) must be writeable by the current user. LOGINDIR defaults to $HOME/il. LOGINDIR is used by Medley as the working directory on start-up and where it loads any “personal” initialization file from.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h2>Other Options</h2>
|
||||
|
||||
<dl>
|
||||
<dt><strong><em>SYSOUT_FILE</em></strong></dt>
|
||||
<dd><p>The pathname of the file to use as a sysout for Medley to start from. If SYSOUT_FILE is not provided and none of the flags (--apps, --full, --lisp) is used, then Medley will start from the saved virtual memory file from the previous session with the same ID_STRING as this run. If no such virtual memory file exists, then Medley will start from the standard full.sysout (equivalent to specifying the --full flag).</p>
|
||||
</dd>
|
||||
<dt><strong><em>PASS_ON_ARGS</em></strong></dt>
|
||||
<dd><p>All arguments after the “--” flag, are passed unaltered to lde via run-medley.</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>FILES</h1>
|
||||
<dl>
|
||||
<dt><strong>$HOME/il</strong></dt>
|
||||
<dd><p>Default Medley LOGINDIR</p>
|
||||
</dd>
|
||||
<dt><strong>$HOME/il/vmem/lisp.virtualmem</strong></dt>
|
||||
<dd><p>Default virtual memory file</p>
|
||||
</dd>
|
||||
<dt><strong>$HOME/il/INIT(.LCOM)</strong></dt>
|
||||
<dd><p>Default personal init file</p>
|
||||
</dd>
|
||||
<dt><strong>$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)</strong></dt>
|
||||
<dd><p>Default Medley greetfile</p>
|
||||
</dd>
|
||||
</dl>
|
||||
<h1>BUGS</h1>
|
||||
<p>See GitHub Issues: <https://github.com/Interlisp/medley/issues></p>
|
||||
<h1>COPYRIGHT</h1>
|
||||
<p>Copyright(c) 2023 by Interlisp.org</p>
|
||||
3
docs/man-page/md2man.sh
Executable file
3
docs/man-page/md2man.sh
Executable file
@@ -0,0 +1,3 @@
|
||||
#!/bin/bash
|
||||
pandoc medley.1.md -s -t man -o medley.1
|
||||
gzip --stdout medley.1 >medley.1.gz
|
||||
186
docs/man-page/medley.1
Normal file
186
docs/man-page/medley.1
Normal file
@@ -0,0 +1,186 @@
|
||||
.\" Automatically generated by Pandoc 2.5
|
||||
.\"
|
||||
.ad l
|
||||
.TH "MEDLEY" "1" "" "" "Start Medley Interlisp"
|
||||
.nh \" Turn off hyphenation by default.
|
||||
.SH NAME
|
||||
.PP
|
||||
\f[B]medley\f[R] \[em] starts up Medley Interlisp
|
||||
.SH SYNOPSIS
|
||||
.PP
|
||||
\f[B]medley\f[R] [ flags \&... ] [ \f[I]SYSOUT_FILE\f[R] ] [ \-\-
|
||||
\f[I]PASS_ON_ARGS\f[R] ]
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Starts Medley Interlisp in a window.
|
||||
.SH OPTIONS
|
||||
.PP
|
||||
\f[B]MEDLEYDIR\f[R] is an environment variable set by Medley and used by
|
||||
many of the options described below.
|
||||
MEDLEYDIR is the top level directory of the Medley installation that
|
||||
contains the specific medley script that is invoked after all symbolic
|
||||
links are resolved.
|
||||
In the standard global installation this will be
|
||||
/usr/local/interlisp/medley.
|
||||
But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of medley.
|
||||
.SS Flags
|
||||
.PP
|
||||
\
|
||||
.TP
|
||||
.B \-h, \-\-help
|
||||
Prints out a brief summary of the flags and arguments to medley.
|
||||
.TP
|
||||
.B \-z, \-\-man
|
||||
Show the man page for medley
|
||||
.TP
|
||||
.B \-f, \-\-full
|
||||
Start Medley from the standard \[lq]full\[rq] sysout.
|
||||
full.sysout includes a complete Interlisp and CommonLisp environment
|
||||
with a standard set of development tools.
|
||||
It does not include any of the applications built using Medley.
|
||||
(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
|
||||
sysouts.)
|
||||
.TP
|
||||
.B \-l, \-\-lisp
|
||||
Start Medley from the standard \[lq]lisp\[rq] sysout.
|
||||
lisp.sysout only includes the basic Interlisp and CommonLisp
|
||||
environment.
|
||||
(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
|
||||
sysouts.)
|
||||
.TP
|
||||
.B \-a, \-\-apps
|
||||
Start Medley from the standard \[lq]apps\[rq] sysout.
|
||||
apps.sysout includes everything in full.sysout plus Medley applications
|
||||
including Notecards, Rooms and CLOS.
|
||||
It also includes pre\-installed links to key Medley documentation.
|
||||
(See \f[I]SYSOUT_FILE\f[R] below for more information on starting
|
||||
sysouts.)
|
||||
.TP
|
||||
.B \-e, \-\-interlisp (relevent only when \-\-apps is specified)
|
||||
Make the initial Exec window within Medley be an Interlisp Exec.
|
||||
Default is to start in an XCL Exec.
|
||||
.TP
|
||||
.B \-n, \-\-noscroll
|
||||
Ordinarily Medley displays scroll bars to enable the user to pan the
|
||||
Medley virtual display within the Medley window.
|
||||
This is true even when the entire virtual display fits within the
|
||||
window.
|
||||
Specifying \-\-noscroll turns off the scroll bars.
|
||||
Note: If \-\-noscroll is specified and the virtual screen is larger than
|
||||
the window, there will be no way to pan to the non\-visible parts of the
|
||||
virtual display.
|
||||
.TP
|
||||
.B \-g \f[I]WxH\f[R], \-\-geometry \f[I]WxH\f[R]
|
||||
Sets the size of the X Window (or VNC window) that Medley runs in to be
|
||||
Width x Height.
|
||||
(Full X Windows geomtery specification with +X+Y is not currently
|
||||
supported).
|
||||
If \-\-geometry is not specified but \-\-screensize is, then the window
|
||||
size will be determined based on the \-\-screensize values and the
|
||||
\-\-noscroll flag.
|
||||
If neither \-\-geometry nor \-\-screensize is provided, then the window
|
||||
size is set to 1440x900 if \-\-noscroll is set and 1462x922 if
|
||||
\-\-noscroll is not set.
|
||||
.TP
|
||||
.B \-s \f[I]WxH\f[R], \-\-screensize \f[I]WxH\f[R]
|
||||
Sets the size of the virtual display as seen from Medley\[cq]s point of
|
||||
view.
|
||||
The Medley window is an unscaled viewport onto this virtual display.
|
||||
If \-\-screensize is not specified but \-\-geometry is, then the virtual
|
||||
display size will be set so that the entire virtual display fits into
|
||||
the given window geometry.
|
||||
If neither \-\-screensize nor \-\-geometry is provided, then the screen
|
||||
size is set to 1440x900.
|
||||
.TP
|
||||
.B \-t \f[I]STRING\f[R], \-\-title \f[I]STRING\f[R]
|
||||
Use STRING as title of Medley window.
|
||||
Not relevent when the \-\-vnc flag is set.
|
||||
.TP
|
||||
.B \-d \f[I]:N\f[R], \-\-display \f[I]:N\f[R]
|
||||
Use X display :N.
|
||||
Defaults to the value of $DISPLAY.
|
||||
Not relevant when the \-\-vnc flag is set.
|
||||
.TP
|
||||
.B \-v, \-\-vnc (Applicable only to Windows System for Linux installations)
|
||||
Use a VNC window running on the Windows side instead of an X window.
|
||||
The VNC window will folllow the Windows desktop scaling setting allowing
|
||||
for much more usable Medley on high resolution displays.
|
||||
On WSL, X windows do not scale well.
|
||||
.TP
|
||||
.B \-i [\f[I]ID_STRING\f[R] | \- | \-\-], \-\-id [\f[I]ID_STRING\f[R] | \- | \-\-]
|
||||
Use ID_STRING as the id for this run of Medley, iunless ID_STRING is
|
||||
\[lq]\-\[rq] or \[lq]\-\-\[rq].
|
||||
If ID_STRING is \[lq]\-\[rq], then use the basename of $MEDLEYDIR as the
|
||||
id.
|
||||
If ID_STRING is \[lq]\-\-\[rq], then use the basename of the parent
|
||||
directory of $MEDLEYDIR as the id.
|
||||
Only one instance of Medley with a given id can run at a time.
|
||||
The id is used to distinguish the virtual memory stores so that multiple
|
||||
instances of Medley can run simultaneously.
|
||||
Default id is \[lq]default\[rq].
|
||||
.TP
|
||||
.B \-m \f[I]N\f[R], \-\-mem \f[I]N\f[R]
|
||||
Set Medley to run in N MB of virtual memory.
|
||||
Defaults to 256MB.
|
||||
.TP
|
||||
.B \-p \f[I]FILE\f[R], \-\-vmem \f[I]FILE\f[R]
|
||||
Use FILE as the Medley virtual memory (vmem) store.
|
||||
FILE must be writeable by the current user.
|
||||
Care must be taken not to use the same vmem FILE for two instances of
|
||||
Medley running simultaneously.
|
||||
The \-\-id flag will not protect against vmem collisions when the
|
||||
\-\-vmem flag is used.
|
||||
Default is to store the vmem in LOGINDIR/vmem/lisp_XXX.virtualmem, where
|
||||
XXX is the id of this Medley run (see \-\-id flag above).
|
||||
See \-\-logindir below for setting of LOGINDIR.
|
||||
.TP
|
||||
.B \-r [\f[I]FILE\f[R] | \-], \-\-greet [\f[I]FILE\f[R] | \-]
|
||||
Use FILE as the Medley greetfile, unless FILE is \[lq]\-\[rq] in which
|
||||
case Medley will start up without using a greetfile.
|
||||
The default Medley greetfile is $MEDLEYDIR/greetfiles/MEDLEYDIR\-INIT,
|
||||
except when the \-\-apps flag is used in which case it is
|
||||
$MEDLEYDIR/greetfiles/APPS\-INIT.
|
||||
.TP
|
||||
.B \-x [\f[I]DIR\f[R] | \-], \-\-logindir [\f[I]DIR\f[R] | \-]
|
||||
use DIR as LOGINDIR in Medley, unless DIR is \[lq]\-\[rq], in which case
|
||||
use $MEDLEYDIR/logindir.
|
||||
DIR (or $MEDLEYDIR/logindir) must be writeable by the current user.
|
||||
LOGINDIR defaults to $HOME/il.
|
||||
LOGINDIR is used by Medley as the working directory on start\-up and
|
||||
where it loads any \[lq]personal\[rq] initialization file from.
|
||||
.SS Other Options
|
||||
.PP
|
||||
\
|
||||
.TP
|
||||
.B \f[I]SYSOUT_FILE\f[R]
|
||||
The pathname of the file to use as a sysout for Medley to start from.
|
||||
If SYSOUT_FILE is not provided and none of the flags (\-\-apps,
|
||||
\-\-full, \-\-lisp) is used, then Medley will start from the saved
|
||||
virtual memory file from the previous session with the same ID_STRING as
|
||||
this run.
|
||||
If no such virtual memory file exists, then Medley will start from the
|
||||
standard full.sysout (equivalent to specifying the \-\-full flag).
|
||||
.TP
|
||||
.B \f[I]PASS_ON_ARGS\f[R]
|
||||
All arguments after the \[lq]\-\-\[rq] flag, are passed unaltered to lde
|
||||
via run\-medley.
|
||||
.SH FILES
|
||||
.TP
|
||||
.B $HOME/il
|
||||
Default Medley LOGINDIR
|
||||
.TP
|
||||
.B $HOME/il/vmem/lisp.virtualmem
|
||||
Default virtual memory file
|
||||
.TP
|
||||
.B $HOME/il/INIT(.LCOM)
|
||||
Default personal init file
|
||||
.TP
|
||||
.B $MEDLEYDIR/greetfiles/MEDLEYDIR\-INIT(.LCOM)
|
||||
Default Medley greetfile
|
||||
.SH BUGS
|
||||
.PP
|
||||
See GitHub Issues: <https://github.com/Interlisp/medley/issues>
|
||||
.SH COPYRIGHT
|
||||
.PP
|
||||
Copyright(c) 2023 by Interlisp.org
|
||||
BIN
docs/man-page/medley.1.gz
Normal file
BIN
docs/man-page/medley.1.gz
Normal file
Binary file not shown.
164
docs/man-page/medley.1.md
Normal file
164
docs/man-page/medley.1.md
Normal file
@@ -0,0 +1,164 @@
|
||||
% MEDLEY(1) | Start Medley Interlisp
|
||||
|
||||
---
|
||||
adjusting: l
|
||||
hyphenate: false
|
||||
---
|
||||
|
||||
NAME
|
||||
====
|
||||
|
||||
**medley** — starts up Medley Interlisp
|
||||
|
||||
SYNOPSIS
|
||||
========
|
||||
|
||||
| **medley** \[ flags ... ] \[ *SYSOUT_FILE* ] \[ \-\- *PASS_ON_ARGS* ]
|
||||
|
||||
DESCRIPTION
|
||||
===========
|
||||
|
||||
Starts Medley Interlisp in a window.
|
||||
|
||||
OPTIONS
|
||||
=======
|
||||
|
||||
**MEDLEYDIR** is an environment variable set by Medley and used by many of the options described below.
|
||||
MEDLEYDIR is the top level directory of the Medley installation that contains the specific medley script that
|
||||
is invoked after all symbolic links are resolved. In the standard global installation this will
|
||||
be /usr/local/interlisp/medley. But Medley can be installed in multiple places on any given machine and
|
||||
hence MEDLEYDIR is computed on each invocation of medley.
|
||||
|
||||
|
||||
Flags
|
||||
-----
|
||||
|
||||
|
||||
|
||||
-h, \-\-help
|
||||
: Prints out a brief summary of the flags and arguments to medley.
|
||||
|
||||
-z, \-\-man
|
||||
: Show the man page for medley
|
||||
|
||||
-f, \-\-full
|
||||
: Start Medley from the standard "full" sysout. full.sysout includes a complete Interlisp and CommonLisp environment
|
||||
with a standard set of development tools. It does not include any of the applications built using Medley.
|
||||
(See *SYSOUT_FILE* below for more information on starting sysouts.)
|
||||
|
||||
-l, \-\-lisp
|
||||
: Start Medley from the standard "lisp" sysout. lisp.sysout only includes the basic Interlisp and
|
||||
CommonLisp environment.
|
||||
(See *SYSOUT_FILE* below for more information on starting sysouts.)
|
||||
|
||||
-a, \-\-apps
|
||||
: Start Medley from the standard "apps" sysout. apps.sysout includes everything in full.sysout plus Medley
|
||||
applications including Notecards, Rooms and CLOS. It also includes pre-installed links to key Medley
|
||||
documentation.
|
||||
(See *SYSOUT_FILE* below for more information on starting sysouts.)
|
||||
|
||||
-e, \-\-interlisp (relevent only when \-\-apps is specified)
|
||||
: Make the initial Exec window within Medley be an Interlisp Exec. Default is to start in an XCL Exec.
|
||||
|
||||
-n, \-\-noscroll
|
||||
: Ordinarily Medley displays scroll bars to enable the user to pan the Medley virtual display within the
|
||||
Medley window. This is true even when the entire virtual display fits within the window. Specifying
|
||||
\-\-noscroll turns off the scroll bars. Note: If \-\-noscroll is specified and the virtual screen is larger
|
||||
than the window, there will be no way to pan to the non-visible parts of the virtual display.
|
||||
|
||||
-g *WxH*, \-\-geometry *WxH*
|
||||
: Sets the size of the X Window (or VNC window) that Medley runs in to be Width x Height. (Full X Windows
|
||||
geomtery specification with +X+Y is not currently supported). If \-\-geometry is not specified but \-\-screensize is,
|
||||
then the window size will be determined based on the \-\-screensize values and the \-\-noscroll flag. If neither
|
||||
\-\-geometry nor \-\-screensize is provided, then the window size is set to 1440x900 if \-\-noscroll is set and 1462x922
|
||||
if \-\-noscroll is not set.
|
||||
|
||||
-s *WxH*, \-\-screensize *WxH*
|
||||
: Sets the size of the virtual display as seen from Medley's point of view.
|
||||
The Medley window is an unscaled viewport onto this virtual display. If \-\-screensize is not specified but
|
||||
\-\-geometry is, then the virtual display size will be set so that the entire virtual display fits into the given
|
||||
window geometry. If neither \-\-screensize nor \-\-geometry is provided, then the screen size is set to 1440x900.
|
||||
|
||||
-t *STRING*, \-\-title *STRING*
|
||||
: Use STRING as title of Medley window. Not relevent when the \-\-vnc flag is set.
|
||||
|
||||
-d *:N*, \-\-display *:N*
|
||||
: Use X display :N. Defaults to the value of $DISPLAY. Not relevant when
|
||||
the \-\-vnc flag is set.
|
||||
|
||||
-v, \-\-vnc (Applicable only to Windows System for Linux installations)
|
||||
: Use a VNC window running on the Windows side instead of an X window.
|
||||
The VNC window will folllow the Windows desktop scaling setting allowing
|
||||
for much more usable Medley on high resolution displays. On WSL, X windows
|
||||
do not scale well.
|
||||
|
||||
-i [*ID_STRING* | - | \-\-], \-\-id [*ID_STRING* | - | \-\-]
|
||||
: Use ID_STRING as the id for this run of Medley, iunless ID_STRING is "-" or "\-\-".
|
||||
If ID_STRING is "-", then use the basename of $MEDLEYDIR as the id.
|
||||
If ID_STRING is "\-\-", then use the basename of the parent directory of $MEDLEYDIR as the id.
|
||||
Only one instance of Medley with a given id can run at a time.
|
||||
The id is used to distinguish the virtual memory stores so that multiple
|
||||
instances of Medley can run simultaneously. Default id is "default".
|
||||
|
||||
-m *N*, \-\-mem *N*
|
||||
: Set Medley to run in N MB of virtual memory. Defaults to 256MB.
|
||||
|
||||
-p *FILE*, \-\-vmem *FILE*
|
||||
: Use FILE as the Medley virtual memory (vmem) store. FILE must be writeable by the current user.
|
||||
Care must be taken not to use the same vmem FILE for two instances of Medley running simultaneously.
|
||||
The \-\-id flag will not protect against vmem collisions when the \-\-vmem flag is used.
|
||||
Default is to store the vmem in LOGINDIR/vmem/lisp_XXX.virtualmem, where XXX is the id of this
|
||||
Medley run (see \-\-id flag above). See \-\-logindir below for setting of LOGINDIR.
|
||||
|
||||
-r \[*FILE* | -], \-\-greet \[*FILE* | -]
|
||||
: Use FILE as the Medley greetfile, unless FILE is "-" in which case
|
||||
Medley will start up without using a greetfile. The default Medley greetfile
|
||||
is $MEDLEYDIR/greetfiles/MEDLEYDIR-INIT, except when the \-\-apps flag is used
|
||||
in which case it is $MEDLEYDIR/greetfiles/APPS-INIT.
|
||||
|
||||
-x \[*DIR* | -], \-\-logindir \[*DIR* | -]
|
||||
: use DIR as LOGINDIR in Medley, unless DIR is "-", in which case use
|
||||
\$MEDLEYDIR/logindir. DIR (or \$MEDLEYDIR/logindir) must be writeable by the current user.
|
||||
LOGINDIR defaults to \$HOME/il. LOGINDIR is used by Medley as the working directory on start-up
|
||||
and where it loads any "personal" initialization file from.
|
||||
|
||||
Other Options
|
||||
-------------
|
||||
|
||||
|
||||
*SYSOUT_FILE*
|
||||
: The pathname of the file to use as a sysout for Medley to start from. If SYSOUT_FILE is not
|
||||
provided and none of the flags (\-\-apps, \-\-full, \-\-lisp) is used, then Medley will start from
|
||||
the saved virtual memory file from the previous session with the same ID_STRING as this run.
|
||||
If no such virtual memory file exists, then Medley will start from the standard full.sysout
|
||||
(equivalent to specifying the \-\-full flag).
|
||||
|
||||
*PASS_ON_ARGS*
|
||||
: All arguments after the "\-\-" flag, are passed unaltered to lde via run-medley.
|
||||
|
||||
|
||||
FILES
|
||||
=====
|
||||
|
||||
\$HOME/il
|
||||
: Default Medley LOGINDIR
|
||||
|
||||
\$HOME/il/vmem/lisp.virtualmem
|
||||
: Default virtual memory file
|
||||
|
||||
\$HOME/il/INIT(.LCOM)
|
||||
: Default personal init file
|
||||
|
||||
\$MEDLEYDIR/greetfiles/MEDLEYDIR-INIT(.LCOM)
|
||||
: Default Medley greetfile
|
||||
|
||||
|
||||
BUGS
|
||||
====
|
||||
|
||||
See GitHub Issues: <https://github.com/Interlisp/medley/issues>
|
||||
|
||||
COPYRIGHT
|
||||
=========
|
||||
|
||||
Copyright(c) 2023 by Interlisp.org
|
||||
4
docs/man-page/publish.sh
Executable file
4
docs/man-page/publish.sh
Executable file
@@ -0,0 +1,4 @@
|
||||
#!/bin/bash
|
||||
./md2man.sh
|
||||
./man2html.sh
|
||||
|
||||
2
docs/man-page/showmd.sh
Executable file
2
docs/man-page/showmd.sh
Executable file
@@ -0,0 +1,2 @@
|
||||
#!/bin/bash
|
||||
pandoc medley.1.md -s -t man | /usr/bin/man -l -
|
||||
BIN
fonts/displayfonts/c0/IBM-US14-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM-US14-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBM-US16-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM-US16-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBM14-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM14-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBM16-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBM16-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBMREV14-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBMREV14-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
BIN
fonts/displayfonts/c0/IBMREV16-MRR-C0.DISPLAYFONT
Normal file
BIN
fonts/displayfonts/c0/IBMREV16-MRR-C0.DISPLAYFONT
Normal file
Binary file not shown.
380
greetfiles/APPS-INIT
Normal file
380
greetfiles/APPS-INIT
Normal file
@@ -0,0 +1,380 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Jan-2023 12:44:20" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;9 21022
|
||||
|
||||
:CHANGES-TO (VARS APPS-INITCOMS)
|
||||
(FNS Apps.DoInit)
|
||||
|
||||
:PREVIOUS-DATE "19-Jan-2023 11:57:40" {DSK}<home>frank>il>medley>gmedley>greetfiles>APPS-INIT.;8
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT APPS-INITCOMS)
|
||||
|
||||
(RPAQQ APPS-INITCOMS
|
||||
[(FILES (SYSLOAD)
|
||||
MEDLEYDIR-INIT)
|
||||
(GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
|
||||
(INITVARS (Apps.NotecardsActivated NIL)
|
||||
(Apps.RoomsActivated NIL))
|
||||
(FNS Apps.InitNotecards Apps.DoInit Apps.CreateButtons Apps.CreateLabel Apps.ActivateCLOS
|
||||
Apps.ActivateRooms Apps.ShowDoc XCL-USER::EXEC_INTERLISP)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (Apps.DoInit)))
|
||||
(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY (P (BKSYSBUF " "])
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
MEDLEYDIR-INIT)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS Apps.NotecardsActivated Apps.RoomsActivated)
|
||||
)
|
||||
|
||||
(RPAQ? Apps.NotecardsActivated NIL)
|
||||
|
||||
(RPAQ? Apps.RoomsActivated NIL)
|
||||
(DEFINEQ
|
||||
|
||||
(Apps.InitNotecards
|
||||
[LAMBDA (DoNotRefreshButtons)
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||
(* ; "Edited 19-Jan-2023 11:57 by FGH")
|
||||
(* ; "Edited 7-Dec-2022 11:14 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||
(* ; "Edited 11-Sep-2022 01:09 by fgh")
|
||||
(* ; "Edited 7-Feb-2022 20:22 by tp7")
|
||||
(LET* [[SRCDIR (OR (UNIX-GETENV 'NOTEFILESSRC)
|
||||
(AND (UNIX-GETENV 'NC_INSTALLDIR)
|
||||
(CONCAT (UNIX-GETENV 'NC_INSTALLDIR)
|
||||
"/notefiles"))
|
||||
(LET ((SUBDIR "notecards/notefiles"))
|
||||
(for DIR in (LIST (CONCAT (MEDLEYDIR)
|
||||
SUBDIR)
|
||||
(CONCAT (MEDLEYDIR)
|
||||
"../" SUBDIR)
|
||||
(CONCAT (MEDLEYDIR)
|
||||
"../../" SUBDIR)) thereis (DIRECTORYNAME DIR]
|
||||
(DESTDIR (OR (UNIX-GETENV 'NOTEFILESDIR)
|
||||
(AND (UNIX-GETENV 'MEDLEY_USERDIR)
|
||||
(CONCAT (UNIX-GETENV 'MEDLEY_USERDIR)
|
||||
"/notefiles"))
|
||||
(CONCAT LOGINDIR "notefiles"]
|
||||
[if (AND (NOT (DIRECTORYNAME DESTDIR))
|
||||
(DIRECTORYNAME SRCDIR))
|
||||
then (for NF in (DIRECTORY (CONCAT SRCDIR "/*"))
|
||||
do (COPYFILE NF (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR 'NAME
|
||||
(FILENAMEFIELD NF 'NAME)
|
||||
'EXTENSION
|
||||
(FILENAMEFIELD NF 'EXTENSION)
|
||||
'VERSION
|
||||
(FILENAMEFIELD NF 'VERSION]
|
||||
(LET* ((PW-REGION (WINDOWPROP PROMPTWINDOW 'REGION))
|
||||
(LEFT (IPLUS (fetch (REGION RIGHT) of PW-REGION)
|
||||
20))
|
||||
(BOTTOM (fetch (REGION BOTTOM) of PW-REGION)))
|
||||
(NC.BringUpNoteCardsIcon (create POSITION
|
||||
XCOORD _ LEFT
|
||||
YCOORD _ BOTTOM)))
|
||||
(NC.FileBrowserMenu NC.NoteCardsIconWindow (PACKFILENAME 'HOST "DSK" 'DIRECTORY DESTDIR
|
||||
'NAME "*" 'EXTENSION "notefile")
|
||||
(CREATEREGION 50 (IDIFFERENCE SCREENHEIGHT 700)
|
||||
550 220))
|
||||
(if (NULL (SASSOC 'NoteCards BackgroundMenuCommands))
|
||||
then (PROGN [SETQ BackgroundMenuCommands (APPEND BackgroundMenuCommands
|
||||
(LIST '(NoteCards (
|
||||
NC.BringUpNoteCardsIcon
|
||||
)
|
||||
|
||||
"Bring up the NoteCards control icon."
|
||||
]
|
||||
(SETQ BackgroundMenu NIL)))
|
||||
(SETQ Apps.NotecardsActivated T)
|
||||
(if (NOT DoNotRefreshButtons)
|
||||
then (Apps.CreateButtons])
|
||||
|
||||
(Apps.DoInit
|
||||
[LAMBDA NIL
|
||||
|
||||
(* ;; "Edited 19-Jan-2023 12:43 by FGH")
|
||||
|
||||
(* ;; "Edited 17-Jan-2023 23:23 by FGH")
|
||||
|
||||
(* ;; "Edited 7-Dec-2022 11:14 by FGH")
|
||||
|
||||
(* ;; "Edited 12-Nov-2022 13:57 by FGH")
|
||||
|
||||
(* ;; "Edited 12-Oct-2022 20:23 by fgh")
|
||||
|
||||
(* ;; "Edited 6-Sep-2022 17:22 by fgh")
|
||||
|
||||
(* ;; "Edited 4-Sep-2022 16:44 by larry")
|
||||
|
||||
(* ;; "Edited 18-Mar-2022 18:53 by fgh")
|
||||
|
||||
(* ;; "Edited 17-Dec-2021 22:05 by fgh")
|
||||
|
||||
(PROGN
|
||||
(* ;; " Adjust windows so that the exec window and the prompt window don't overlap")
|
||||
|
||||
[MAPC (OPENWINDOWS)
|
||||
(FUNCTION (LAMBDA (W)
|
||||
(COND
|
||||
((EQ (WINDOWPROP W 'BUTTONEVENTFN)
|
||||
'WHEN-WHO-LINE-SELECTED-FN)
|
||||
(MOVEW W (CAR (WINDOWPROP W 'REGION))
|
||||
(IDIFFERENCE SCREENHEIGHT 18)))
|
||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||
"Prompt Window")
|
||||
(PROGN (MOVEW W (create POSITION
|
||||
XCOORD _ 50
|
||||
YCOORD _ (IDIFFERENCE SCREENHEIGHT 120)))
|
||||
(CLEARW W)))
|
||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||
"Exec (XCL)")
|
||||
(PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)")
|
||||
(MOVEW W (create POSITION
|
||||
XCOORD _ 50
|
||||
YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
|
||||
|
||||
(* ;; " Set up INITIALSLST based on information passed in from the Linux environment")
|
||||
|
||||
[SETQ INITIALSLST (LIST (LIST USERNAME (UNIX-GETENV 'MEDLEY_FIRSTNAME)
|
||||
(UNIX-GETENV 'MEDLEY_INITIALS]
|
||||
(LOAD '{DSK}/usr/local/interlisp/medley/lispusers/HELPSYS.LCOM T)
|
||||
|
||||
(* ;; "change to interlisp exec if required")
|
||||
|
||||
(COND
|
||||
((OR (STRING-EQUAL (UNIX-GETENV 'MEDLEY_EXEC)
|
||||
"inter")
|
||||
(STRING-EQUAL (UNIX-GETENV 'NCO)
|
||||
"true"))
|
||||
(BKSYSBUF "(EXEC_INTERLISP)")))
|
||||
|
||||
(* ;; "Always Activate CLOS")
|
||||
|
||||
(Apps.ActivateCLOS)
|
||||
|
||||
(* ;; " activate Notecards if requested")
|
||||
|
||||
(COND
|
||||
((STRING-EQUAL (UNIX-GETENV 'RUN_NOTECARDS)
|
||||
"true")
|
||||
(Apps.InitNotecards T)))
|
||||
|
||||
(* ;; " activate Rooms if requested")
|
||||
|
||||
(COND
|
||||
((STRING-EQUAL (UNIX-GETENV 'RUN_ROOMS)
|
||||
"true")
|
||||
(Apps.ActivateRooms T)))
|
||||
|
||||
(* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed")
|
||||
|
||||
(Apps.CreateButtons T])
|
||||
|
||||
(Apps.CreateButtons
|
||||
[LAMBDA (DoDocsToo) (* ; "Edited 13-Dec-2022 12:51 by frank")
|
||||
(* ; "Edited 7-Dec-2022 11:28 by FGH")
|
||||
(* ; "Edited 5-Dec-2022 17:31 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:52 by FGH")
|
||||
|
||||
(* ;; " Create buttons for Documentation and to activate Rooms, Notecards ")
|
||||
|
||||
(* ;; "Note: due to bug in DELETE-BUTTON need to create Doc buttons last. This will make sure that the NoteCards/Rooms buttons get properl deleted when they are activated. But the Doc buttons will not necessariy get deleted properly (but then there is never a need for them to be deleted).")
|
||||
|
||||
(LET* ((FEATURES (LIST (LIST Apps.NotecardsActivated '(Apps.InitNotecards)
|
||||
"NOTECARDS")
|
||||
(LIST Apps.RoomsActivated '(Apps.ActivateRooms)
|
||||
"ROOMS")))
|
||||
(FEATURES-LABELS (for FEATURE in FEATURES collect (CADDR FEATURE)))
|
||||
(DOCS (LIST (LIST "https://interlisp.org/docs/medley/orientation/" "BASICS")
|
||||
(LIST "https://interlisp.org/documentation/Medley-Primer.pdf" "PRIMER")
|
||||
(LIST "https://interlisp.org/documentation/IRM.pdf" "MANUAL")
|
||||
(LIST "https://interlisp.org/documentation/notecards_user_guide_v1.2.pdf"
|
||||
"NOTECARDS")
|
||||
(LIST "https://interlisp.org/documentation/ROOMSTECHDESC.pdf" "ROOMS")))
|
||||
(DOCS-LABELS (for DOC in DOCS collect (CADR DOC)))
|
||||
(RIGHTMARGINISH 140)
|
||||
(SECTION1YPOS 225)
|
||||
(YPOSDELTA 55)
|
||||
(SECTION2YPOS (IPLUS SECTION1YPOS (ITIMES (IPLUS (LENGTH DOCS)
|
||||
1)
|
||||
YPOSDELTA)))
|
||||
(BUTTONY-FEATURES SECTION2YPOS)
|
||||
(BUTTONY-DOCS SECTION1YPOS)
|
||||
(FEATURES-REQUIREDP (OR (NOT Apps.RoomsActivated)
|
||||
(NOT Apps.NotecardsActivated)))
|
||||
(IWS NIL)
|
||||
(BUTTONS NIL))
|
||||
|
||||
(* ;; "First remove/re-create feature buttons")
|
||||
|
||||
(for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||
(LIST "ACTIVATE" "FEATURES")) do (CLOSEW W))
|
||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||
'FEATURE)
|
||||
(MEMBER (BUTTON-LABEL B)
|
||||
FEATURES-LABELS)) do (DELETE-BUTTON B))
|
||||
[if FEATURES-REQUIREDP
|
||||
then [SETQ IWS (LIST (Apps.CreateLabel "ACTIVATE" (IDIFFERENCE SCREENWIDTH
|
||||
(IDIFFERENCE RIGHTMARGINISH 50
|
||||
))
|
||||
(IDIFFERENCE SCREENHEIGHT (IDIFFERENCE SECTION2YPOS 20)))
|
||||
(Apps.CreateLabel "FEATURES" (IDIFFERENCE SCREENWIDTH
|
||||
(IDIFFERENCE RIGHTMARGINISH 50
|
||||
))
|
||||
(IDIFFERENCE SCREENHEIGHT SECTION2YPOS]
|
||||
(SETQ BUTTONS (for FEATURE in FEATURES
|
||||
collect (OR (CAR FEATURE)
|
||||
(LET (B)
|
||||
(SETQ BUTTONY-FEATURES (IPLUS BUTTONY-FEATURES
|
||||
YPOSDELTA))
|
||||
[SETQ B (CREATE-BUTTON (CADR FEATURE)
|
||||
(CADDR FEATURE)
|
||||
(create POSITION
|
||||
XCOORD _ (IDIFFERENCE
|
||||
SCREENWIDTH
|
||||
RIGHTMARGINISH)
|
||||
YCOORD _ (IDIFFERENCE
|
||||
SCREENHEIGHT
|
||||
BUTTONY-FEATURES
|
||||
]
|
||||
(WINDOWPROP B 'Apps.BUTTON 'FEATURE)
|
||||
B]
|
||||
|
||||
(* ;; "Then if needed, remove/recreate documentation buttons")
|
||||
|
||||
(if DoDocsToo
|
||||
then (for W in (OPENWINDOWS) when (MEMBER (WINDOWPROP W 'ICONLABEL)
|
||||
(LIST "DOCUMENTATION"))
|
||||
do (CLOSEW W))
|
||||
(for B in *ALL-BUTTONS* when (AND (EQ (WINDOWPROP B 'Apps.BUTTON)
|
||||
'DOC)
|
||||
(MEMBER (BUTTON-LABEL B)
|
||||
DOCS-LABELS)) do (DELETE-BUTTON B))
|
||||
(SETQ IWS (CONS (Apps.CreateLabel "DOCUMENTATION" (IDIFFERENCE SCREENWIDTH
|
||||
(IDIFFERENCE
|
||||
RIGHTMARGINISH 50)
|
||||
)
|
||||
(IDIFFERENCE SCREENHEIGHT SECTION1YPOS))
|
||||
IWS))
|
||||
(SETQ BUTTONS (APPEND (for DOC in DOCS
|
||||
collect (LET (B)
|
||||
(SETQ BUTTONY-DOCS (IPLUS BUTTONY-DOCS
|
||||
YPOSDELTA))
|
||||
[SETQ B (CREATE-BUTTON (LIST 'Apps.ShowDoc
|
||||
(CAR DOC))
|
||||
(CADR DOC)
|
||||
(create POSITION
|
||||
XCOORD _
|
||||
(IDIFFERENCE
|
||||
SCREENWIDTH
|
||||
RIGHTMARGINISH)
|
||||
YCOORD _
|
||||
(IDIFFERENCE
|
||||
SCREENHEIGHT
|
||||
BUTTONY-DOCS]
|
||||
(WINDOWPROP B 'Apps.BUTTON 'DOC)
|
||||
B))
|
||||
BUTTONS)))
|
||||
[for B in BUTTONS do (COND
|
||||
((WINDOWP B)
|
||||
(WINDOWPROP B 'RIGHTBUTTONFN 'NILL)
|
||||
(WINDOWPROP B 'BUTTONEVENTFN (FUNCTION (LAMBDA (BUTTON)
|
||||
(if (LASTMOUSESTATE
|
||||
(ONLY LEFT))
|
||||
then (EXECUTE-BUTTON
|
||||
BUTTON]
|
||||
[for IW in IWS do (COND
|
||||
((WINDOWP IW)
|
||||
(WINDOWPROP IW 'RIGHTBUTTONFN 'NILL]
|
||||
(for B in BUTTONS when (WINDOWP B) collect B])
|
||||
|
||||
(Apps.CreateLabel
|
||||
[LAMBDA (Text CenterX BottomY) (* ; "Edited 5-Dec-2022 16:49 by FGH")
|
||||
(LET* ((DS (DSPCREATE))
|
||||
(FONT (DSPFONT '(HELVETICA 18 BOLD)
|
||||
DS))
|
||||
(SR (STRINGREGION Text DS))
|
||||
(BMW (fetch (REGION WIDTH) of SR))
|
||||
(BMH (IPLUS (fetch (REGION HEIGHT) of SR)
|
||||
(fetch (REGION BOTTOM) of SR)))
|
||||
(BM (BITMAPCREATE BMW BMH))
|
||||
(POS (create POSITION
|
||||
XCOORD _ (IDIFFERENCE CenterX (IQUOTIENT BMW 2))
|
||||
YCOORD _ BottomY))
|
||||
IW)
|
||||
(DSPDESTINATION BM DS)
|
||||
(PRIN1 Text DS)
|
||||
(SETQ IW (ICONW BM BM POS))
|
||||
(WINDOWPROP IW 'ICONLABEL Text)
|
||||
IW])
|
||||
|
||||
(Apps.ActivateCLOS
|
||||
[LAMBDA NIL
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands BackgroundMenu))
|
||||
(* ; "Edited 12-Nov-2022 14:41 by FGH")
|
||||
(if (NULL (SASSOC "CLOS Browse Class" BackgroundMenuCommands))
|
||||
then (PROGN [SETQ BackgroundMenuCommands
|
||||
(APPEND BackgroundMenuCommands
|
||||
(LIST '("CLOS Browse Class" (CLOS-BROWSER::BROWSE-CLASS)
|
||||
"Bring up a class browser."
|
||||
(SUBITEMS (|all in a package| (CLOS-BROWSER::BROWSE-CLASS
|
||||
(
|
||||
CLOS-BROWSER::CLASSES-IN-PACKAGE
|
||||
(
|
||||
CLOS-BROWSER::IN-SELECT-PACKAGE
|
||||
)))
|
||||
|
||||
"Select a package and browse all the classes defined in that package."
|
||||
]
|
||||
(SETQ BackgroundMenu NIL])
|
||||
|
||||
(Apps.ActivateRooms
|
||||
[LAMBDA (DoNotRefreshButtons)
|
||||
(DECLARE (GLOBALVARS BackgroundMenuCommands ROOMS:*SUITE-DIRECTORIES*))
|
||||
(* ; "Edited 7-Dec-2022 11:13 by FGH")
|
||||
(* ; "Edited 12-Nov-2022 14:56 by FGH")
|
||||
(if (NULL (SASSOC "Rooms" BackgroundMenuCommands))
|
||||
then (ROOMS:RESET))
|
||||
(SETQ ROOMS:*SUITE-DIRECTORIES* (CONS (CONCAT (UNIX-GETENV 'MEDLE_USERDIR)
|
||||
"/suites")
|
||||
ROOMS:*SUITE-DIRECTORIES*))
|
||||
(SETQ Apps.RoomsActivated T)
|
||||
(PROMPTPRINT "
|
||||
ROOMS functionality is now available via the Background Menu")
|
||||
(if (NOT DoNotRefreshButtons)
|
||||
then (Apps.CreateButtons])
|
||||
|
||||
(Apps.ShowDoc
|
||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:26 by FGH")
|
||||
(ShellBrowse URL])
|
||||
|
||||
(XCL-USER::EXEC_INTERLISP
|
||||
[LAMBDA NIL (* ; "Edited 18-Mar-2022 18:53 by fgh")
|
||||
(PROGN [MAPC (OPENWINDOWS)
|
||||
(FUNCTION (LAMBDA (W)
|
||||
(COND
|
||||
((STREQUAL (WINDOWPROP W 'TITLE)
|
||||
"Exec (XCL)")
|
||||
(PROGN (WINDOWPROP W 'TITLE "Exec (INTERLISP)")
|
||||
(MOVEW W (create POSITION
|
||||
XCOORD _ 50
|
||||
YCOORD _ (IDIFFERENCE SCREENHEIGHT 460]
|
||||
(XCL:SET-DEFAULT-EXEC-TYPE 'INTERLISP)
|
||||
(XCL:SET-EXEC-TYPE 'INTERLISP])
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(Apps.DoInit)
|
||||
)
|
||||
(DECLARE%: FIRST DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(BKSYSBUF " ")
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1146 20888 (Apps.InitNotecards 1156 . 5018) (Apps.DoInit 5020 . 8119) (
|
||||
Apps.CreateButtons 8121 . 16945) (Apps.CreateLabel 16947 . 17757) (Apps.ActivateCLOS 17759 . 19108) (
|
||||
Apps.ActivateRooms 19110 . 19961) (Apps.ShowDoc 19963 . 20112) (XCL-USER::EXEC_INTERLISP 20114 . 20886
|
||||
)))))
|
||||
STOP
|
||||
BIN
greetfiles/APPS-INIT.LCOM
Normal file
BIN
greetfiles/APPS-INIT.LCOM
Normal file
Binary file not shown.
@@ -1,10 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 9-Mar-2022 11:50:44" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2 4690
|
||||
(FILECREATED "22-Nov-2022 20:59:24" {DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;6 2860
|
||||
|
||||
:CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
|
||||
|
||||
:PREVIOUS-DATE "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
|
||||
:PREVIOUS-DATE "22-Nov-2022 20:42:43"
|
||||
{DSK}<home>frank>il>medley>wmedley>greetfiles>MEDLEYDIR-INIT.;5)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
|
||||
@@ -13,7 +14,7 @@
|
||||
([P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
(MEDLEY-INIT-VARS)
|
||||
(MEDLEY-INIT-VARS 'GREET)
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
|
||||
(FILES BACKGROUND-YIELD)
|
||||
(VARS
|
||||
@@ -38,7 +39,7 @@
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
|
||||
(MEDLEY-INIT-VARS)
|
||||
(MEDLEY-INIT-VARS 'GREET)
|
||||
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
|
||||
|
||||
@@ -81,44 +82,7 @@
|
||||
:PACKAGE "INTERLISP"])
|
||||
)
|
||||
|
||||
(ADDTOVAR FONTDEFS
|
||||
[LARGER (FONTCHANGEFLG . ALL)
|
||||
(FILELINELENGTH . 102)
|
||||
(FONTPROFILE (DEFAULTFONT 1 (GACHA 12)
|
||||
(GACHA 10)
|
||||
(TERMINAL 10)
|
||||
(POSTSCRIPT (TERMINAL 10)))
|
||||
(ITALICFONT 1 (HELVETICA 12 MIR)
|
||||
(GACHA 10 MIR)
|
||||
(MODERN 10 MIR)
|
||||
(POSTSCRIPT (MODERN 10 MIR)))
|
||||
(BOLDFONT 2 (HELVETICA 12 BRR)
|
||||
(HELVETICA 10 BRR)
|
||||
(MODERN 10 BRR)
|
||||
(POSTSCRIPT (HELVETICA 12 BRR)))
|
||||
(LITTLEFONT 3 (HELVETICA 10)
|
||||
(HELVETICA 6 MIR)
|
||||
(MODERN 10 MIR)
|
||||
(POSTSCRIPT (MODERN 10 MIR)))
|
||||
(TINYFONT 6 (GACHA 10)
|
||||
(GACHA 6)
|
||||
(TERMINAL 6)
|
||||
(POSTSCRIPT (TERMINAL 6)))
|
||||
(BIGFONT 4 (HELVETICA 12 BRR)
|
||||
NIL
|
||||
(MODERN 12 BRR)
|
||||
(POSTSCRIPT (MODERN 12 BRR)))
|
||||
(MENUFONT 5 (HELVETICA 12)
|
||||
(HELVETICA 12)
|
||||
(POSTSCRIPT (HELVETICA 12)))
|
||||
(COMMENTFONT 6 (HELVETICA 12)
|
||||
(HELVETICA 10)
|
||||
(MODERN 10)
|
||||
(POSTSCRIPT (MODERN 10)))
|
||||
(TEXTFONT 7 (TIMESROMAN 12)
|
||||
NIL
|
||||
(CLASSIC 12)
|
||||
(POSTSCRIPT (CLASSIC 12])
|
||||
(ADDTOVAR FONTDEFS )
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1949 2774 (INTERLISPMODE 1959 . 2772)))))
|
||||
(FILEMAP (NIL (1986 2811 (INTERLISPMODE 1996 . 2809)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
7
installers/deb/.gitignore
vendored
Normal file
7
installers/deb/.gitignore
vendored
Normal file
@@ -0,0 +1,7 @@
|
||||
/tmp
|
||||
*.deb
|
||||
*.swp
|
||||
*.save
|
||||
/tars
|
||||
/debs
|
||||
|
||||
1
installers/deb/build
Symbolic link
1
installers/deb/build
Symbolic link
@@ -0,0 +1 @@
|
||||
build_deb.sh
|
||||
139
installers/deb/build_deb.sh
Executable file
139
installers/deb/build_deb.sh
Executable file
@@ -0,0 +1,139 @@
|
||||
#!/bin/bash
|
||||
###############################################################################
|
||||
#
|
||||
# build_deb.sh: build .deb files for installing Medley Interlisp on Linux
|
||||
# and WSL
|
||||
#
|
||||
# 2023-01-10 Frank Halasz
|
||||
#
|
||||
# Copyright 2023 by Interlisp.org
|
||||
#
|
||||
###############################################################################
|
||||
# set -x
|
||||
|
||||
tarball_dir=tmp/tarballs
|
||||
|
||||
# Make sure we are in the right directory
|
||||
if [ ! -f ./control-linux ];
|
||||
then
|
||||
echo "Can't find ./control file."
|
||||
echo "Incorrect cwd?"
|
||||
echo "Should be in medley/installers/deb"
|
||||
echo "Exiting"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
# If running as a github action or -t arg, then skip downloading the tarballs
|
||||
if ! [[ -n "${GITHUB_WORKSPACE}" || "$1" = "-t" ]];
|
||||
then
|
||||
# First, make sure gh is available and we are logged in to github
|
||||
if [ -z "$(which gh)" ];
|
||||
then
|
||||
echo "Can't find gh"
|
||||
echo "Exiting."
|
||||
exit 2
|
||||
fi
|
||||
gh auth status 2>&1 | grep --quiet --no-messages "Logged in to github.com"
|
||||
if [ $? -ne 0 ];
|
||||
then
|
||||
echo "Not logged into github."
|
||||
echo "Exiting."
|
||||
exit 3
|
||||
fi
|
||||
# then clear out the ./tmp directory
|
||||
rm -rf ./tmp
|
||||
mkdir ./tmp
|
||||
# then download the maiko and medley tarballs
|
||||
mkdir -p ${tarball_dir}
|
||||
echo "Fetching maiko and medley release tarballs"
|
||||
gh release download --repo interlisp/maiko --dir ${tarball_dir} --pattern "*.tgz"
|
||||
TAG=$(gh release list --repo interlisp/medley | head -n 1 | awk "{print \$1 }")
|
||||
gh release download ${TAG} --repo interlisp/medley --dir ${tarball_dir} --pattern "*.tgz"
|
||||
gh repo clone interlisp/notecards notecards -- --depth 1
|
||||
(cd notecards; git archive --format=tgz --output=../notecards.tgz --prefix=notecards/ main)
|
||||
mv notecards.tgz ${tarball_dir}
|
||||
rm -rf notecards
|
||||
fi
|
||||
|
||||
# Figure out release tags from tarball names
|
||||
pushd ${tarball_dir} >/dev/null 2>/dev/null
|
||||
medley_release=$(echo medley-*-loadups.tgz | sed "s/medley-\(.*\)-loadups.tgz/\1/")
|
||||
maiko_release=$(echo maiko-*-linux.x86_64.tgz | sed "s/maiko-\(.*\)-linux.x86_64.tgz/\1/")
|
||||
popd >/dev/null 2>/dev/null
|
||||
|
||||
|
||||
# For linux and wsl create packages for each arch
|
||||
for wslp in linux wsl
|
||||
do
|
||||
# For each arch create a deb file
|
||||
for arch_base in x86_64^amd64 armv7l^armhf aarch64^arm64
|
||||
do
|
||||
if [[ ${wslp} = wsl && ${arch_base} = armv7l^armhf ]];
|
||||
then
|
||||
continue
|
||||
fi
|
||||
arch=${arch_base%^*}
|
||||
debian_arch=${arch_base#*^}
|
||||
pkg_dir=tmp/pkg/${wslp}-${arch}
|
||||
#
|
||||
# Set up the pkg directories for this arch using the release tarballs
|
||||
#
|
||||
# Copy in the right control file, modifying as needed
|
||||
rm -rf ${pkg_dir}
|
||||
mkdir -p ${pkg_dir}
|
||||
mkdir -p ${pkg_dir}/DEBIAN
|
||||
sed \
|
||||
-e "s/--ARCH--/${debian_arch}/" \
|
||||
-e "s/--RELEASE--/${medley_release}_${maiko_release}/" \
|
||||
<control-${wslp} >${pkg_dir}/DEBIAN/control
|
||||
#
|
||||
il_dir=${pkg_dir}/usr/local/interlisp
|
||||
MEDLEYDIR=${il_dir#${pkg_dir}}/medley
|
||||
# Maiko and Medley files to il_dir (/usr/local/interlisp)
|
||||
mkdir -p ${il_dir}
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/maiko-${maiko_release}-linux.${arch}.tgz"
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/medley-${medley_release}-runtime.tgz"
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/medley-${medley_release}-loadups.tgz"
|
||||
tar -x -z -C ${il_dir} \
|
||||
-f "${tarball_dir}/notecards.tgz"
|
||||
# Copy the medley man page into place
|
||||
man_dir="${pkg_dir}/usr/local/man/man1"
|
||||
mkdir -p "${man_dir}"
|
||||
cp -p "${il_dir}/medley/docs/man-page/medley.1.gz" "${man_dir}"
|
||||
# Configure postinst and postrm scripts and put in place in DEBIAN dir
|
||||
sed -e "s>--MEDLEYDIR-->${MEDLEYDIR}>g" <postinst >${pkg_dir}/DEBIAN/postinst
|
||||
chmod +x ${pkg_dir}/DEBIAN/postinst
|
||||
sed -e "s>--MEDLEYDIR-->${MEDLEYDIR}>g" <postrm >${pkg_dir}/DEBIAN/postrm
|
||||
chmod +x ${pkg_dir}/DEBIAN/postrm
|
||||
# For wsl scripts, include the vncviewer.exe
|
||||
if [[ ${wslp} = wsl && ${arch} = x86_64 ]];
|
||||
then
|
||||
pushd ./tmp >/dev/null
|
||||
rm -rf vncviewer64-1.12.0.exe
|
||||
wget -q https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe
|
||||
popd >/dev/null
|
||||
mkdir -p ${il_dir}/wsl
|
||||
cp -p tmp/vncviewer64-1.12.0.exe ${il_dir}/wsl/vncviewer64-1.12.0.exe
|
||||
fi
|
||||
#
|
||||
# Create tar file for this arch
|
||||
#
|
||||
filename="medley-full-${medley_release}_${maiko_release}-${wslp}-${arch}"
|
||||
mkdir -p tars
|
||||
echo "Creating tar file tars/${filename}.tgz"
|
||||
tar -C ${il_dir} -czf tars/${filename}.tgz .
|
||||
#
|
||||
# Create the deb file for this arch
|
||||
#
|
||||
mkdir -p debs
|
||||
deb_filepath="debs/${filename}.deb"
|
||||
rm -rf "${deb_filepath}"
|
||||
dpkg-deb --build -Zxz "${pkg_dir}" "${deb_filepath}"
|
||||
#
|
||||
done
|
||||
done
|
||||
|
||||
9
installers/deb/control-linux
Normal file
9
installers/deb/control-linux
Normal file
@@ -0,0 +1,9 @@
|
||||
Package: medley-interlisp
|
||||
Version: 1.0.0
|
||||
Release: --RELEASE--
|
||||
Maintainer: info@interlisp.org
|
||||
Description: Medley Interlisp for Linux
|
||||
Homepage: https://github.com/interlisp/medley
|
||||
Architecture: --ARCH--
|
||||
Depends: xdg-utils
|
||||
|
||||
9
installers/deb/control-wsl
Normal file
9
installers/deb/control-wsl
Normal file
@@ -0,0 +1,9 @@
|
||||
Package: medley-interlisp
|
||||
Version: 1.0.0
|
||||
Release: --RELEASE--
|
||||
Maintainer: info@interlisp.org
|
||||
Description: Medley Interlisp for Linux
|
||||
Homepage: https://github.com/interlisp/medley
|
||||
Architecture: --ARCH--
|
||||
Depends: wslu ( >= 4.1 ) | wslu ( << 4.0 ), tigervnc-standalone-server, tigervnc-xorg-extension
|
||||
|
||||
10
installers/deb/debian_wsl.txt
Normal file
10
installers/deb/debian_wsl.txt
Normal file
@@ -0,0 +1,10 @@
|
||||
|
||||
#
|
||||
sudo sed -i s/bullseye/bookworm/ /etc/apt/sources.list
|
||||
sudo apt update
|
||||
sudo apt full-upgrade -y
|
||||
#
|
||||
sudo apt install wget gnupg2 apt-transport-https
|
||||
wget -O - https://pkg.wslutiliti.es/public.key | sudo tee -a /etc/apt/trusted.gpg.d/wslu.asc
|
||||
echo "deb https://pkg.wslutiliti.es/debian bullseye main" | sudo tee -a /etc/apt/sources.list
|
||||
sudo apt update
|
||||
8
installers/deb/postinst
Normal file
8
installers/deb/postinst
Normal file
@@ -0,0 +1,8 @@
|
||||
#!/bin/bash
|
||||
# put linkto medley.sh into /usr/local/bin
|
||||
if [[ $1 = configure && ! -e /usr/local/bin/medley ]];
|
||||
then
|
||||
ln -s --MEDLEYDIR--/scripts/medley/medley.sh /usr/local/bin/medley
|
||||
fi
|
||||
# update the man database
|
||||
mandb
|
||||
9
installers/deb/postrm
Normal file
9
installers/deb/postrm
Normal file
@@ -0,0 +1,9 @@
|
||||
#!/bin/bash
|
||||
if [[ $1 = remove || $1 = purge ]];
|
||||
then
|
||||
if [ "$(realpath /usr/local/bin/medley)" = "--MEDLEYDIR--/scripts/medley.sh" ];
|
||||
then
|
||||
rm -f /usr/local/bin/medley
|
||||
fi
|
||||
fi
|
||||
|
||||
3
installers/downloads_page/md2html.sh
Executable file
3
installers/downloads_page/md2html.sh
Executable file
@@ -0,0 +1,3 @@
|
||||
#!/bin/bash
|
||||
markdown medley_downloads.md > medley_downloads.html
|
||||
|
||||
38
installers/downloads_page/medley_downloads.html
Normal file
38
installers/downloads_page/medley_downloads.html
Normal file
@@ -0,0 +1,38 @@
|
||||
<ul>
|
||||
<li><h1>MEDLEY DOWNLOADS</h1>
|
||||
|
||||
<ul>
|
||||
<li><h2>Standard Installations (for Debian-based distros)</h2>
|
||||
|
||||
<ul>
|
||||
<li><h3>Standard Linux</h3>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
|
||||
<li><h3>Windows System for Linux</h3>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
</ul></li>
|
||||
<li><h2>Local Installations (for any Linux distro)</h2>
|
||||
|
||||
<ul>
|
||||
<li><h3>Standard Linux</h3>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
|
||||
<li><h3>Windows System for Linux</h3>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
|
||||
|
||||
<p><a href="https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
|
||||
</ul></li>
|
||||
</ul></li>
|
||||
</ul>
|
||||
41
installers/downloads_page/medley_downloads.md
Normal file
41
installers/downloads_page/medley_downloads.md
Normal file
@@ -0,0 +1,41 @@
|
||||
* # MEDLEY DOWNLOADS
|
||||
|
||||
* ## Standard Installations (for Debian-based distros)
|
||||
|
||||
* ### Standard Linux
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86\_64.deb)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.deb)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.deb)
|
||||
|
||||
* ### Windows System for Linux
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86\_64.deb)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.deb)
|
||||
|
||||
* ## Local Installations (for any Linux distro)
|
||||
|
||||
* ### Standard Linux
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-x86\_64.tgz)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-aarch64.tgz)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-linux-armv7l.tgz)
|
||||
|
||||
* ### Windows System for Linux
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-x86\_64.tgz)
|
||||
|
||||
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](https://github.com/Interlisp/medley/releases/download/@@@GITHUB.SUBDIR@@@/@@@FULL.RELEASE.FILENAME@@@-wsl-aarch64.tgz)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
2842
internal/COMPTEST
2842
internal/COMPTEST
File diff suppressed because it is too large
Load Diff
Binary file not shown.
10
internal/CONDITIONGRAPH.TXT
Normal file
10
internal/CONDITIONGRAPH.TXT
Normal file
@@ -0,0 +1,10 @@
|
||||
CONDITIONGRAPH
|
||||
|
||||
|
||||
Currently in internal rather than lispusers, this package shows a graph of "conditions" (Common Lisp error system).
|
||||
|
||||
(FILESLOAD CONDITIONGRAPH) to load it.
|
||||
|
||||
(GRAPH-CONDITIONS) will display a graph of conditions and their inheritance.
|
||||
|
||||
Other possible operations might be determinable by reading the source.
|
||||
BIN
internal/DO-TEST
BIN
internal/DO-TEST
Binary file not shown.
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
@@ -1 +0,0 @@
|
||||
Running DSKTEST
The Disk-file-system test utility
1. Load the file DSKTEST.DCOM from whichever directory & server it is stored on.
2. Type
(DSKTEST '{DSK}<LISPFILES>
|
||||
1493
internal/MACROTEST
1493
internal/MACROTEST
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,25 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;9| 15959
|
||||
(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2| 10212
|
||||
|
||||
:CHANGES-TO (FNS HCFILES)
|
||||
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;8|)
|
||||
:PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS
|
||||
((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
|
||||
|
||||
(* |;;| "hardcopy files")
|
||||
|
||||
(FNS HCFILES BADFILE)
|
||||
(INITVARS (HCFILES)
|
||||
(BADFILES))
|
||||
(COMMANDS "pick")))
|
||||
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
@@ -130,24 +122,6 @@
|
||||
(MEDLEY-FIX-DATES
|
||||
(LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry")
|
||||
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T))))))
|
||||
|
||||
(PICK
|
||||
(LAMBDA (TYPE CHOICES) (* \; "Edited 25-Jun-2022 16:58 by larry")
|
||||
(SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
|
||||
(NIL (PICK (PICK 'ONEOF '(FILE ISSUE PROJECT))))
|
||||
(ISSUE (LET ((ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND
|
||||
"gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'"
|
||||
))))
|
||||
(STR (OPENTEXTSTREAM)))
|
||||
(|for| S |in| (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE))
|
||||
|do| (CL:FORMAT STR "~a~&" S)
|
||||
|finally| (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a"
|
||||
ISSUE))))))
|
||||
(DIR (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
|
||||
(FILE (PICK 'ONEOF (DIRECTORY (MEDLEYDIR (PICK 'DIR)))))
|
||||
(PROJECT (PICK 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS)))
|
||||
(ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES)))))
|
||||
(HELP TYPE "Unknown type"))))
|
||||
)
|
||||
|
||||
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
|
||||
@@ -195,104 +169,8 @@
|
||||
(RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T))
|
||||
(DRIBBLE))))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* |;;| "hardcopy files")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(HCFILES
|
||||
(LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 17-Jul-2022 12:44 by larry")
|
||||
(* \; "Edited 21-Jun-2022 22:59 by larry")
|
||||
(* \; "Edited 31-May-2022 09:31 by larry")
|
||||
(* \; "Edited 20-Feb-2022 12:16 by larry")
|
||||
(* \; "Edited 21-Aug-2021 20:56 by larry")
|
||||
(DECLARE (SPECVARS TFILE))
|
||||
(|if| (NULL TFILE)
|
||||
|then| (SETQ TFILE MEDLEYDIR))
|
||||
(COND
|
||||
((DIRECTORYNAMEP TFILE)
|
||||
|
||||
(* |;;| "canonicalize")
|
||||
|
||||
(SETQ TFILE (DIRECTORYNAME TFILE))
|
||||
(OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY))))
|
||||
(CL:UNLESS DEST
|
||||
(|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
|
||||
"/tmp/psfiles/"))
|
||||
(SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
|
||||
|
||||
(* |;;| "first deal with files in this directory")
|
||||
|
||||
(FOR EXT IN '("TED*" "SKETCH" "T*XT")
|
||||
DO (|for| X |in| (DIRECTORY (CONCAT TFILE "*." EXT ";*"))
|
||||
|do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
|
||||
(* |;;| " then deal with subdirs ")
|
||||
|
||||
(|for| X |in| (DIRECTORY (CONCAT TFILE "*"))
|
||||
|when| (|for| SKIP |in| '(">." ">dinfo>") |always| (NOT (STRPOS SKIP (L-CASE X))))
|
||||
|when| (DIRECTORYNAMEP X) |do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
|
||||
((SETQ TFILE (INFILEP TFILE))
|
||||
(LET* ((TF (UNPACKFILENAME.STRING TFILE))
|
||||
(NAME (LISTGET TF 'NAME))
|
||||
(DIR (LISTGET TF 'DIRECTORY))
|
||||
(PSFILE (PACKFILENAME.STRING
|
||||
'EXTENSION
|
||||
(|if| (EQ REDOFLG 'IP)
|
||||
|then| "IP"
|
||||
|else| "PS")
|
||||
'NAME
|
||||
(|if| (EQ DEST T)
|
||||
|then| (* \; "with the tedit file")
|
||||
NAME
|
||||
|else| (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN
|
||||
)
|
||||
-1))))
|
||||
"-" NAME))
|
||||
'HOST
|
||||
(LISTGET TF 'HOST)
|
||||
'DIRECTORY
|
||||
(|if| (EQ DEST T)
|
||||
|then| DIR
|
||||
|else| DEST)))
|
||||
(TEXTSTREAM))
|
||||
(|if| (AND (NOT REDOFLG)
|
||||
(INFILEP PSFILE))
|
||||
|then| (* \; " do nothing")
|
||||
(PRINTOUT T PSFILE " already there" T)
|
||||
|elseif| (EQ REDOFLG 'TEST)
|
||||
|then| (PRINTOUT T TFILE "-> " PSFILE T)
|
||||
(CLOSEF (OPENTEXTSTREAM TFILE))
|
||||
ELSEIF (MEMBER TFILE BADFILES)
|
||||
THEN (PRINTOUT T "Skipping " TFILE " on BADFILES")
|
||||
|else| (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
|
||||
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
|
||||
PSFILE T NIL NIL NIL (|if| (EQ REDOFLG 'IP)
|
||||
|then| 'INTERPRESS
|
||||
|else| 'POSTSCRIPT))
|
||||
(|printout| T " DONE" T)
|
||||
(CLOSEF? TEXTSTREAM))))
|
||||
(T (PRINTOUT T "no such file " T)))))
|
||||
|
||||
(BADFILE
|
||||
(LAMBDA NIL (* \; "Edited 22-Jun-2022 09:40 by larry")
|
||||
(PUSHNEW BADFILES TFILE)
|
||||
(LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
|
||||
(SETFILEPTR STR -1)
|
||||
(PRINT TFILE STR)
|
||||
(CLOSEF STR))
|
||||
(RETFROM 'HCFILES)))
|
||||
)
|
||||
|
||||
(RPAQ? HCFILES )
|
||||
|
||||
(RPAQ? BADFILES )
|
||||
|
||||
(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (727 8702 (GATHER-INFO 737 . 6147) (MAKE-FULLER-DB 6149 . 6839) (MEDLEY-FIX-LINKS 6841
|
||||
. 7238) (MEDLEY-FIX-DATES 7240 . 7482) (PICK 7484 . 8700)) (9741 11534 (MAKE-EXPORTS-ALL 9751 . 10710
|
||||
) (MAKE-WHEREIS-HASH 10712 . 11532)) (11569 15829 (HCFILES 11579 . 15514) (BADFILE 15516 . 15827)))))
|
||||
(FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
|
||||
. 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
|
||||
9367 . 10187)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,105 +0,0 @@
|
||||
(FILECREATED "24-Mar-86 15:18:14" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;9 4308
|
||||
|
||||
changes to: (FNS STARTTEST STOPTEST KILLTEST)
|
||||
(VARS FLOPPYTESTERCOMS)
|
||||
|
||||
previous date: "20-Mar-86 21:06:46" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;5)
|
||||
|
||||
|
||||
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
|
||||
|
||||
(PRETTYCOMPRINT FLOPPYTESTERCOMS)
|
||||
|
||||
(RPAQQ FLOPPYTESTERCOMS ((* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
|
||||
(P (LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM)))
|
||||
(INITVARS (ALLOCATIONSW NIL))
|
||||
(FNS STARTTEST STOPTEST KILLTEST BLTALLOCS BLTALLOC)))
|
||||
(* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
|
||||
|
||||
(LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM))
|
||||
|
||||
(RPAQ? ALLOCATIONSW NIL)
|
||||
(DEFINEQ
|
||||
|
||||
(STARTTEST
|
||||
(LAMBDA (N) (* kbr: "24-Mar-86 15:15")
|
||||
(SETQ STARTTIME (GDATE))
|
||||
(CNDIR (QUOTE {FLOPPY}))
|
||||
(FLOPPY.FORMAT (QUOTE TEST))
|
||||
(DIRECTORY (QUOTE {FLOPPY}*))
|
||||
(BLTALLOCS)
|
||||
(for I from 1 to N do (DOFILEBANGER (PACK* (QUOTE {FLOPPY})
|
||||
(QUOTE TESTFILE)
|
||||
I)
|
||||
(RAND 10 30)))))
|
||||
|
||||
(STOPTEST
|
||||
(LAMBDA NIL (* kbr: "24-Mar-86 15:16")
|
||||
(SETQ STOPTIME (GDATE))
|
||||
(for P in FILEBANGERS when (NOT (EQ P (THIS.PROCESS))) do (SUSPEND.PROCESS P))))
|
||||
|
||||
(KILLTEST
|
||||
(LAMBDA NIL (* kbr: "22-Mar-86 17:18")
|
||||
(for P in FILEBANGERS do (DEL.PROCESS P))
|
||||
(SETQ FILEBANGERS NIL)))
|
||||
|
||||
(BLTALLOCS
|
||||
[LAMBDA NIL (* kbr: "18-Nov-85 12:32")
|
||||
(* Debugging fn. Puts up a window representation of
|
||||
allocations on floppy. *)
|
||||
(PROG (PIXELS XLENGTH YLENGTH)
|
||||
(SETQ PIXELS 5)
|
||||
(SETQ XLENGTH (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
|
||||
(SETQ YLENGTH \FLOPPY.CYLINDERS)
|
||||
[COND
|
||||
((NULL ALLOCATIONSW)
|
||||
(SETQ ALLOCATIONSW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (ITIMES PIXELS
|
||||
XLENGTH))
|
||||
(HEIGHTIFWINDOW (ITIMES PIXELS
|
||||
YLENGTH)
|
||||
T)
|
||||
NIL NIL NIL
|
||||
"Position FLOPPY ALLOCATIONS window")
|
||||
"FLOPPY ALLOCATIONS"))
|
||||
(UNADVISE (QUOTE \PFLOPPY.ALLOCATE))
|
||||
(ADVISE (QUOTE \PFLOPPY.ALLOCATE)
|
||||
(QUOTE AFTER)
|
||||
(QUOTE (COND (!VALUE (BLTALLOC !VALUE]
|
||||
(BITBLT NIL NIL NIL ALLOCATIONSW NIL NIL NIL NIL (QUOTE TEXTURE)
|
||||
(QUOTE REPLACE)
|
||||
WHITESHADE)
|
||||
(for Y from 0 to (SUB1 YLENGTH) do (for X from 0 to (SUB1 XLENGTH)
|
||||
do (BITMAPBIT ALLOCATIONSW
|
||||
(ITIMES PIXELS X)
|
||||
(ITIMES PIXELS Y)
|
||||
1)))
|
||||
(for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
|
||||
when [NOT (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
|
||||
(QUOTE (FREE]
|
||||
do (BLTALLOC PFALLOC])
|
||||
|
||||
(BLTALLOC
|
||||
[LAMBDA (PFALLOC) (* kbr: "18-Nov-85 12:21")
|
||||
(PROG (SHADE OPSHADE LEFT BOTTOM PIXELS XLENGTH)
|
||||
(SETQ PIXELS 5)
|
||||
(SETQ XLENGTH (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
|
||||
(SETQ SHADE (COND
|
||||
((EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
|
||||
(QUOTE (FREE)))
|
||||
WHITESHADE)
|
||||
(T BLACKSHADE)))
|
||||
(SETQ OPSHADE (IDIFFERENCE BLACKSHADE SHADE))
|
||||
(for I from (fetch (PFALLOC START) of PFALLOC) to (fetch (PFALLOC END)
|
||||
of PFALLOC)
|
||||
do (SETQ LEFT (ITIMES PIXELS (IREMAINDER (SUB1 I)
|
||||
XLENGTH)))
|
||||
(SETQ BOTTOM (ITIMES PIXELS (IQUOTIENT (SUB1 I)
|
||||
XLENGTH)))
|
||||
(BLTSHADE SHADE ALLOCATIONSW LEFT BOTTOM PIXELS PIXELS (QUOTE REPLACE))
|
||||
(BLTSHADE OPSHADE ALLOCATIONSW LEFT BOTTOM 1 1 (QUOTE REPLACE])
|
||||
)
|
||||
(PUTPROPS FLOPPYTESTER COPYRIGHT ("Xerox Corporation" 1985 1986))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (745 4220 (STARTTEST 755 . 1203) (STOPTEST 1205 . 1463) (KILLTEST 1465 . 1665) (
|
||||
BLTALLOCS 1667 . 3253) (BLTALLOC 3255 . 4218)))))
|
||||
STOP
|
||||
@@ -1,242 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "26-Jun-90 19:15:35" |{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;2| 9419
|
||||
|
||||
|changes| |to:| (VARS RS232TESTCOMS)
|
||||
|
||||
|previous| |date:| "20-Feb-87 00:10:14"
|
||||
|{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(PRETTYCOMPRINT RS232TESTCOMS)
|
||||
|
||||
(RPAQQ RS232TESTCOMS
|
||||
((FNS RSTEST TESTCLEANUP XMITTEST)
|
||||
|
||||
(* |;;|
|
||||
"Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(FNS RS232.TEST RS232.MICROTEST RS232.QUICKTEST RS232.MENU RS232TMENU.SELFN)
|
||||
(VARS RS232.TEST.MENU.ITEMS)
|
||||
|
||||
(* |;;|
|
||||
"Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(FNS TTY.TEST TTY.MICROTEST TTY.QUICKTEST TTY.MENU TTYTMENU.SELFN)))
|
||||
(DEFINEQ
|
||||
|
||||
(rstest
|
||||
(lambda nil (* \; "Edited 14-Jan-87 16:00 by jds")
|
||||
(let (oo)
|
||||
(resetlst (resetsave (setq oo (openstream '{rs232} 'output))
|
||||
'closef?)
|
||||
(|for| i |from| 1 |do| (printout oo "Line " i
|
||||
": 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
|
||||
\
|
||||
")
|
||||
(printout t "Line " i t))))))
|
||||
|
||||
(testcleanup
|
||||
(lambda nil (* \; "Edited 16-Jan-87 09:51 by jds")
|
||||
|
||||
(* |;;| "Close the streams used by the rs232 test.")
|
||||
|
||||
(and (boundp 'out)
|
||||
out
|
||||
(closef? out))
|
||||
(and (boundp in)
|
||||
in
|
||||
(closef? in))))
|
||||
|
||||
(XMITTEST
|
||||
(LAMBDA (BAUDRATE XONXOFF?) (* \; "Edited 19-Feb-87 20:59 by jds")
|
||||
|
||||
(* |;;| "Set up the rs232 port at BAUDRATE with XOn-XOff flow control if XONXOFF? is T. Then print forever, lines of text. Show an indication on the screen for each line, so the user can tell if flow control has shut things off.")
|
||||
|
||||
(RS232C.INIT BAUDRATE 8 'NONE 1 (COND
|
||||
(XONXOFF? 'XONXOFF)
|
||||
(T 'NONE)))
|
||||
(SETQ OUT (OPENSTREAM '{RS232} 'OUTPUT))
|
||||
(SETQ IN (OPENSTREAM '{RS232} 'INPUT))
|
||||
(ERSETQ (FOR I FROM 1 DO (PRINTOUT OUT "Line " I ": 0 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
|
||||
\
|
||||
")
|
||||
(|printout| T "Line " I T)))
|
||||
(CLOSEF? OUT)
|
||||
(CLOSEF? IN)))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* |;;| "Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(rs232.test
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:43 by jds")
|
||||
|
||||
(* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")
|
||||
|
||||
(printout t t t "Starting RS-232 port test." t
|
||||
"Make sure the line monitor is attached to the RS-232 port, "
|
||||
"and its cable goes to the DCE socket on the monitor." t)
|
||||
(mouseconfirm)
|
||||
(printout t "Set the line monitor for: " t)
|
||||
(|for| bits |in| '(5 6 7 8) |do| (|for| parity |in| '(none odd even)
|
||||
|do| (|for| stopbits |in| '(1 1.5 2)
|
||||
|do| (rs232.microtest 9600 bits parity stopbits))))))
|
||||
|
||||
(rs232.microtest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:37 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(printout t bits "bits, " (cond
|
||||
((eq parity 'none)
|
||||
"NO")
|
||||
(t parity))
|
||||
" parity, " stopbits " stop bits..." t)
|
||||
(mouseconfirm)
|
||||
(rs232.quicktest speed bits parity stopbits)))
|
||||
|
||||
(rs232.quicktest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:38 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(rs232c.init speed bits parity stopbits 'none)
|
||||
(let ((out (openstream '{rs232} 'output)))
|
||||
(prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
|
||||
out)
|
||||
(closef out))))
|
||||
|
||||
(rs232.menu
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:45 by jds")
|
||||
(let ((ww (addmenu (|create| menu
|
||||
menucolumns _ 4
|
||||
items _ rs232.test.menu.items
|
||||
whenselectedfn _ (function rs232tmenu.selfn)))))
|
||||
(windowprop ww 'title "RS-232 Tests"))))
|
||||
|
||||
(rs232tmenu.selfn
|
||||
(lambda (item menu key) (* \; "Edited 19-Feb-87 22:57 by jds")
|
||||
|
||||
(* |;;| "Called from the RS-232 test menu")
|
||||
|
||||
(let* ((info (cadr item))
|
||||
(bits (car info))
|
||||
(parity (cadr info))
|
||||
(stopbits (caddr info)))
|
||||
(rs232.quicktest 9600 bits parity stopbits))))
|
||||
)
|
||||
|
||||
(RPAQQ RS232.TEST.MENU.ITEMS
|
||||
((|5/N/1| (5 NONE 1))
|
||||
(|6/N/1| (6 NONE 1))
|
||||
(|7/N/1| (7 NONE 1))
|
||||
(|8/N/1| (8 NONE 1))
|
||||
(|5/N/1.5| (5 NONE 1.5))
|
||||
(|6/N/1.5| (6 NONE 1.5))
|
||||
(|7/N/1.5| (7 NONE 1.5))
|
||||
(|8/N/1.5| (8 NONE 1.5))
|
||||
(|5/N/2| (5 NONE 2))
|
||||
(|6/N/2| (6 NONE 2))
|
||||
(|7/N/2| (7 NONE 2))
|
||||
(|8/N/2| (8 NONE 2))
|
||||
(|5/O/1| (5 ODD 1))
|
||||
(|6/O/1| (6 ODD 1))
|
||||
(|7/O/1| (7 ODD 1))
|
||||
(|8/O/1| (8 ODD 1))
|
||||
(|5/O/1.5| (5 ODD 1.5))
|
||||
(|6/O/1.5| (6 ODD 1.5))
|
||||
(|7/O/1.5| (7 ODD 1.5))
|
||||
(|8/O/1.5| (8 ODD 1.5))
|
||||
(|5/O/2| (5 ODD 2))
|
||||
(|6/O/2| (6 ODD 2))
|
||||
(|7/O/2| (7 ODD 2))
|
||||
(|8/O/2| (8 ODD 2))
|
||||
(|5/E/1| (5 EVEN 1))
|
||||
(|6/E/1| (6 EVEN 1))
|
||||
(|7/E/1| (7 EVEN 1))
|
||||
(|8/E/1| (8 EVEN 1))
|
||||
(|5/E/1.5| (5 EVEN 1.5))
|
||||
(|6/E/1.5| (6 EVEN 1.5))
|
||||
(|7/E/1.5| (7 EVEN 1.5))
|
||||
(|8/E/1.5| (8 EVEN 1.5))
|
||||
(|5/E/2| (5 EVEN 2))
|
||||
(|6/E/2| (6 EVEN 2))
|
||||
(|7/E/2| (7 EVEN 2))
|
||||
(|8/E/2| (8 EVEN 2))))
|
||||
|
||||
|
||||
|
||||
(* |;;|
|
||||
"Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(tty.test
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:42 by jds")
|
||||
|
||||
(* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")
|
||||
|
||||
(printout t t t "Starting TTY port test." t
|
||||
"Make sure the line monitor is attached to the TTY port, "
|
||||
"and its cable goes to the DTE socket on the monitor." t)
|
||||
(mouseconfirm)
|
||||
(printout t "Set the line monitor for: " t)
|
||||
(|for| bits |in| '(5 6 7 8) |do| (|for| parity |in| '(none odd even)
|
||||
|do| (|for| stopbits |in| '(1 1.5 2)
|
||||
|do| (tty.microtest 9600 bits parity stopbits))))))
|
||||
|
||||
(tty.microtest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:41 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(printout t bits "bits, " (cond
|
||||
((eq parity 'none)
|
||||
"NO")
|
||||
(t parity))
|
||||
" parity, " stopbits " stop bits..." t)
|
||||
(mouseconfirm)
|
||||
(tty.init speed bits parity stopbits)))
|
||||
|
||||
(tty.quicktest
|
||||
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:40 by jds")
|
||||
|
||||
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
|
||||
|
||||
(tty.init speed bits parity stopbits 'none)
|
||||
(let ((out (openstream '{tty} 'output)))
|
||||
(prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
|
||||
out)
|
||||
(closef out))))
|
||||
|
||||
(tty.menu
|
||||
(lambda nil (* \; "Edited 19-Feb-87 22:57 by jds")
|
||||
(let ((ww (addmenu (|create| menu
|
||||
menucolumns _ 4
|
||||
items _ rs232.test.menu.items
|
||||
whenselectedfn _ (function ttytmenu.selfn)))))
|
||||
(windowprop ww 'title "TTY Tests"))))
|
||||
|
||||
(ttytmenu.selfn
|
||||
(lambda (item menu key) (* \; "Edited 19-Feb-87 22:59 by jds")
|
||||
|
||||
(* |;;| "Called from the RS-232 test menu")
|
||||
|
||||
(let* ((info (cadr item))
|
||||
(bits (car info))
|
||||
(parity (cadr info))
|
||||
(stopbits (caddr info)))
|
||||
(tty.quicktest 9600 bits parity stopbits))))
|
||||
)
|
||||
(PUTPROPS RS232TEST COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (979 2623 (RSTEST 989 . 1466) (TESTCLEANUP 1468 . 1789) (XMITTEST 1791 . 2621)) (2732
|
||||
5433 (RS232.TEST 2742 . 3570) (RS232.MICROTEST 3572 . 4151) (RS232.QUICKTEST 4153 . 4640) (RS232.MENU
|
||||
4642 . 5042) (RS232TMENU.SELFN 5044 . 5431)) (6665 9325 (TTY.TEST 6675 . 7493) (TTY.MICROTEST 7495 .
|
||||
8061) (TTY.QUICKTEST 8063 . 8543) (TTY.MENU 8545 . 8938) (TTYTMENU.SELFN 8940 . 9323)))))
|
||||
STOP
|
||||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -1 +0,0 @@
|
||||
12345
|
||||
Binary file not shown.
@@ -1 +0,0 @@
|
||||
aδσγδφβc
|
||||
Binary file not shown.
Binary file not shown.
@@ -1 +0,0 @@
|
||||
012345X1245
|
||||
@@ -1,495 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Jul-2022 14:07:11"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;31 27425
|
||||
|
||||
:CHANGES-TO (FNS TFP TFP1)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 13:32:16"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;27)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TFPCOMS)
|
||||
|
||||
(RPAQQ TFPCOMS
|
||||
((FNS TFP TFP1 FPC FPCS)
|
||||
(FNS OLDFILEPOS OLDFFILEPOS)
|
||||
(FILES FPTESTS)
|
||||
(ADDVARS (DIRECTORIES {WMEDLEY}<internal>test>filepos>))
|
||||
|
||||
(* ;; "Compiling also requires EXPORTS.ALL")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
IOCHAR))))
|
||||
(DEFINEQ
|
||||
|
||||
(TFP
|
||||
[LAMBDA (TESTNAMES TAGS FN) (* ; "Edited 3-Jul-2022 14:06 by rmk")
|
||||
(CL:UNLESS TESTNAMES (SETQ TESTNAMES ALLTESTS))
|
||||
(LET [(TESTS (FOR TN INSIDE TESTNAMES FIRST (PRINTOUT T "Testing")
|
||||
JOIN (PRINTOUT T " " TN)
|
||||
(CONS (MKSTRING TN)
|
||||
(COPY (EVALV TN))) FINALLY (TERPRI T]
|
||||
(CL:WHEN TAGS
|
||||
(SETQ TESTS (FOR TEST IN TESTS WHEN (THEREIS TAG INSIDE TAGS
|
||||
SUCHTHAT (MEMB TAG TEST)) COLLECT TEST)))
|
||||
(PRINTOUT T (LENGTH TESTS)
|
||||
" tests" T)
|
||||
(FOR TEST VAL COMMENT PRINTED IN TESTS EACHTIME (CL:WHEN (STRINGP TEST)
|
||||
(SETQ COMMENT TEST)
|
||||
(SETQ PRINTED NIL))
|
||||
WHEN [AND (LISTP TEST)
|
||||
(NOT (AND FN (CADDR TEST] UNLESS (EQUAL (CAR TEST)
|
||||
(SETQ VAL (TFP1 (CADR TEST)
|
||||
FN)))
|
||||
COLLECT (CL:WHEN COMMENT
|
||||
(CL:UNLESS PRINTED (PRINTOUT T COMMENT T)))
|
||||
(PRINTOUT T 5 VAL " <- " .P2 TEST T)
|
||||
(CONS VAL TEST])
|
||||
|
||||
(TFP1
|
||||
[LAMBDA (FPARGS FN) (* ; "Edited 3-Jul-2022 14:04 by rmk")
|
||||
|
||||
(* ;; "FN is the search function to apply: NIL = FILEPOS, OLDFILEPOS, FFILEPOS. OLDFFILEPOS")
|
||||
|
||||
(* ;; "For convenience: NIL -> FILEPOS, OF -> OLDFILEPOS, FF -> FFILEPOS, OFF -> OLDFFILEPOS.")
|
||||
|
||||
(* ;; "OLDFILEPOS and OLDFFILEPOS do only a byte searches.")
|
||||
|
||||
(* ;;
|
||||
"FPARGS is a list of FILEPOS args. CASEARRAY=T means Transparent case array, pushes to FFILEPOS. ")
|
||||
|
||||
(* ;; "The file extension gives the format, defaulting to *DEFAULT-EXTERNALFORMAT* = :XCCS")
|
||||
|
||||
(SETQ FN (SELECTQ FN
|
||||
((NIL FILEPOS)
|
||||
'FILEPOS)
|
||||
((FF FFILEPOS)
|
||||
'FFILEPOS)
|
||||
((OF OLDFILEPOS)
|
||||
'OLDFILEPOS)
|
||||
((OFF OLDFFILEPOS)
|
||||
'OLDFFILEPOS)
|
||||
(HELP "BAD FN" FN)))
|
||||
(CL:WHEN (OR (FIXP (CAR FPARGS))
|
||||
(NULL (CAR FPARGS))
|
||||
(AND (LISTP (CAR FPARGS))
|
||||
(FIXP (CAAR FPARGS))
|
||||
(FIXP (CDAR FPARGS)))
|
||||
(LISTP (CADR FPARGS)))
|
||||
(SETQ FPARGS (CADR FPARGS)))
|
||||
(LET (STREAM VAL PATTERN FILE START END SKIP TAIL CASEARRAY EXT (FORMAT *DEFAULT-EXTERNALFORMAT*)
|
||||
)
|
||||
(SETQ PATTERN (EVAL (POP FPARGS))) (* ;
|
||||
"So we can do substrings, CHARACTER etc.")
|
||||
(SETQ FILE (POP FPARGS))
|
||||
(SETQ START (POP FPARGS))
|
||||
(SETQ END (POP FPARGS))
|
||||
(SETQ SKIP (POP FPARGS))
|
||||
(SETQ TAIL (POP FPARGS))
|
||||
(SETQ CASEARRAY (POP FPARGS))
|
||||
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
|
||||
(CL:WHEN EXT
|
||||
(CL:WHEN (STRPOS "UTF8" EXT)
|
||||
(SETQ EXT "UTF-8"))
|
||||
[SETQ FORMAT (FIND-FORMAT (CL:INTERN EXT 'KEYWORD])
|
||||
[SETQ STREAM (OPENSTREAM (OR (FINDFILE FILE T)
|
||||
FILE)
|
||||
'INPUT NIL `((FORMAT ,FORMAT]
|
||||
(SETQ CASEARRAY (IF (EQ CASEARRAY T)
|
||||
THEN (CASEARRAY)
|
||||
ELSE (EVAL CASEARRAY)))
|
||||
(SETQ VAL (APPLY* FN PATTERN STREAM START END SKIP TAIL CASEARRAY))
|
||||
(CLOSEF? STREAM)
|
||||
VAL])
|
||||
|
||||
(FPC
|
||||
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 29-Jun-2022 21:22 by rmk")
|
||||
|
||||
(* ;; "Compare old and new filepos")
|
||||
|
||||
(LET (OLD NEW EXT FORMAT)
|
||||
(CL:UNLESS (STREAMP FILE)
|
||||
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
|
||||
(SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
|
||||
(CL:UNLESS (FIND-FORMAT FORMAT T)
|
||||
(SETQ FORMAT :XCCS))
|
||||
(STREAMPROP FILE 'FORMAT FORMAT))
|
||||
(SETQ OLD (OLDFILEPOS STR FILE START END SKIP TAIL CASEARRAY))
|
||||
(SETQ NEW (FILEPOS STR FILE START END SKIP TAIL CASEARRAY))
|
||||
(CLOSEF FILE)
|
||||
(CL:UNLESS (EQUAL OLD (IF (EQ TAIL 'BOTH)
|
||||
THEN (CDR NEW)
|
||||
ELSE NEW))
|
||||
(HELP (CONCAT "OLD=" (OR OLD "NIL")
|
||||
" NEW="
|
||||
(OR NEW "NIL"))))
|
||||
(LIST OLD NEW])
|
||||
|
||||
(FPCS
|
||||
[LAMBDA (STR FILE START END SKIP TAIL) (* ; "Edited 29-Jun-2022 23:56 by rmk")
|
||||
(* ; "Edited 28-Jun-2022 22:21 by rmk")
|
||||
|
||||
(* ;; "Compare old and new slow filepos")
|
||||
|
||||
(LET (FAST SLOW EXT FORMAT)
|
||||
(CL:UNLESS (STREAMP FILE)
|
||||
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
|
||||
(SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
|
||||
(CL:UNLESS (FIND-FORMAT FORMAT T)
|
||||
(SETQ FORMAT :XCCS))
|
||||
(STREAMPROP FILE 'FORMAT FORMAT))
|
||||
(SETQ FAST (FILEPOS STR FILE START END SKIP TAIL))
|
||||
(SETQ SLOW (FILEPOS STR FILE START END SKIP TAIL (CASEARRAY)))
|
||||
(CLOSEF FILE)
|
||||
(CL:UNLESS (EQUAL FAST SLOW)
|
||||
(HELP (CONCAT "FAST=" (OR FAST "NIL")
|
||||
" SLOW="
|
||||
(OR SLOW "NIL"))))
|
||||
(LIST FAST SLOW])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(OLDFILEPOS
|
||||
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 27-Jun-2022 23:35 by rmk")
|
||||
(* ; "Edited 10-Aug-2020 21:44 by rmk:")
|
||||
(* Pavel "12-Oct-86 15:13")
|
||||
|
||||
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
|
||||
|
||||
(* ;; "NB: this function now works on non-PAGEMAPPED files. It must use only IO functions that respect that.")
|
||||
|
||||
(PROG ((SKIPCHAR (AND SKIP (CHCON1 SKIP)))
|
||||
[CA (fetch (ARRAYP BASE) of (COND
|
||||
[CASEARRAY (COND
|
||||
((AND (ARRAYP CASEARRAY)
|
||||
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
|
||||
\ST.BYTE))
|
||||
CASEARRAY)
|
||||
(T (CASEARRAY CASEARRAY]
|
||||
(T \TRANSPARENT]
|
||||
(STREAM (\GETSTREAM FILE 'INPUT))
|
||||
CHAR FIRSTCHAR STRBASE STRINDEX PATLEN PATINDEX ORGFILEPTR LASTINDEX STARTBYTE ENDBYTE
|
||||
BIGENDBYTE STARTSEG ENDSEG)
|
||||
(CL:WHEN (EQ :UTF-8 (\EXTERNALFORMAT STREAM))
|
||||
(SETQ STR (XTOUSTRING STR)))
|
||||
[COND
|
||||
((LITATOM STR)
|
||||
(SETQ STRBASE (fetch (LITATOM PNAMEBASE) of STR))
|
||||
(SETQ STRINDEX 1)
|
||||
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of STR)))
|
||||
(T (OR (STRINGP STR)
|
||||
(SETQ STR (MKSTRING STR)))
|
||||
(SETQ STRBASE (fetch (STRINGP BASE) of STR))
|
||||
(SETQ STRINDEX (fetch (STRINGP OFFST) of STR))
|
||||
(SETQ PATLEN (fetch (STRINGP LENGTH) of STR] (* ;
|
||||
"calculate start addr and set file ptr.")
|
||||
[SETQ STARTBYTE (COND
|
||||
(START (COND
|
||||
((NOT (AND (FIXP START)
|
||||
(IGEQ START 0)))
|
||||
(LISPERROR "ILLEGAL ARG" START)))
|
||||
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
|
||||
(\SETFILEPTR STREAM START)
|
||||
START)
|
||||
(T (SETQ ORGFILEPTR (\GETFILEPTR STREAM]
|
||||
(* ;
|
||||
"calculate the character address of the character after the last possible match.")
|
||||
[SETQ ENDBYTE (ADD1 (COND
|
||||
((NULL END) (* ; "Default is end of file")
|
||||
(IDIFFERENCE (\GETEOFPTR STREAM)
|
||||
PATLEN))
|
||||
((IGEQ END 0) (* ; "Absolute byte pointer given")
|
||||
(IMIN END (IDIFFERENCE (\GETEOFPTR STREAM)
|
||||
PATLEN)))
|
||||
((IGREATERP PATLEN (IMINUS END))
|
||||
(* ;
|
||||
"END is too far, use eof less length")
|
||||
(IDIFFERENCE (\GETEOFPTR STREAM)
|
||||
PATLEN))
|
||||
(T (IDIFFERENCE (IPLUS (\GETEOFPTR STREAM)
|
||||
END 1)
|
||||
PATLEN]
|
||||
|
||||
(* ;; "use STARTBYTE and ENDBYTE instead of START and END because vm functions shouldn't change their arguments.")
|
||||
|
||||
(COND
|
||||
((IGEQ STARTBYTE ENDBYTE) (* ; "nothing to search")
|
||||
(GO FAILED)))
|
||||
(SETQ LASTINDEX PATLEN)
|
||||
SKIPLP
|
||||
(* ;
|
||||
"set the first character to FIRSTCHAR, handling leading skips.")
|
||||
(COND
|
||||
((EQ LASTINDEX 0) (* ; "null case")
|
||||
(GO FOUNDIT))
|
||||
((EQ (SETQ FIRSTCHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE STRINDEX)))
|
||||
SKIPCHAR) (* ;
|
||||
"first character in pattern is skip.")
|
||||
(SETQ LASTINDEX (SUB1 LASTINDEX))
|
||||
(\BIN STREAM) (* ; "Move forward a character.")
|
||||
(add STRINDEX 1)
|
||||
(add STARTBYTE 1)
|
||||
(GO SKIPLP)))
|
||||
(SETQ LASTINDEX (IPLUS LASTINDEX STRINDEX)) (* ;
|
||||
"Used for end of pattern check, comparing against current INDEX")
|
||||
[COND
|
||||
((SMALLP ENDBYTE)
|
||||
(SETQ STARTSEG (SETQ ENDSEG 0)))
|
||||
(T
|
||||
(* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts. The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary (can get around that here by decrementing everyone, but can't in FFILEPOS). Note that STARTBYTE and ENDBYTE are never actually used as file ptrs, just for counting.")
|
||||
|
||||
(SETQ ENDSEG (FOLDLO ENDBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ BIGENDBYTE (IMOD ENDBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTSEG (FOLDLO STARTBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTBYTE (IMOD STARTBYTE FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ ENDBYTE (COND
|
||||
((EQ STARTSEG ENDSEG)
|
||||
BIGENDBYTE)
|
||||
(T
|
||||
|
||||
(* ;; "In different segments, so we'll have to search all the way to the end of this seg; hence, `end' is currently as big as it gets")
|
||||
|
||||
FILEPOS.SEGMENT.SIZE]
|
||||
FIRSTCHARLP
|
||||
|
||||
|
||||
(* ;; "STARTBYTE is the possible beginning of a match. the file ptr of the file is always at STARTBYTE position when the FIRSTCHAR loop is passed.")
|
||||
|
||||
(COND
|
||||
((EQ STARTBYTE ENDBYTE) (* ; "end of this part of search")
|
||||
(COND
|
||||
((EQ STARTSEG ENDSEG) (* ; "failed")
|
||||
(GO FAILED))) (* ;
|
||||
"Finished this segment, roll over into new one")
|
||||
(SETQ STARTBYTE 0) (* ; "= STARTBYTE-FILEPOS.SEGMENT.SIZE")
|
||||
[COND
|
||||
((EQ (add STARTSEG 1)
|
||||
ENDSEG) (* ;
|
||||
"Entering final segment, so set ENDBYTE to actual end instead of segment end")
|
||||
(COND
|
||||
((EQ (SETQ ENDBYTE BIGENDBYTE)
|
||||
0)
|
||||
(GO FAILED]
|
||||
(GO FIRSTCHARLP))
|
||||
((NEQ FIRSTCHAR (\GETBASEBYTE CA (\BIN STREAM)))
|
||||
(add STARTBYTE 1)
|
||||
(GO FIRSTCHARLP)))
|
||||
(SETQ PATINDEX STRINDEX)
|
||||
MATCHLP
|
||||
(* ;
|
||||
"At this point, STR is matched thru offset PATINDEX")
|
||||
(COND
|
||||
((EQ (SETQ PATINDEX (ADD1 PATINDEX))
|
||||
LASTINDEX) (* ; "matched for entire length")
|
||||
(GO FOUNDIT))
|
||||
((OR (EQ (SETQ CHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE PATINDEX)))
|
||||
(\GETBASEBYTE CA (\BIN STREAM)))
|
||||
(EQ CHAR SKIPCHAR)) (* ;
|
||||
"Char from file matches char from STR")
|
||||
(GO MATCHLP))
|
||||
(T (* ;
|
||||
"Match failed, so we have to start again with first char")
|
||||
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
|
||||
(IDIFFERENCE PATINDEX STRINDEX)))
|
||||
|
||||
(* ;; "Back up over the chars we have just read in trying to match, less one. I.e. go back to one past the previous starting point")
|
||||
|
||||
(add STARTBYTE 1)
|
||||
(GO FIRSTCHARLP)))
|
||||
FOUNDIT
|
||||
(* ;
|
||||
"set fileptr, adjust for beginning skips and return proper value.")
|
||||
[COND
|
||||
((NOT TAIL) (* ;
|
||||
"Fileptr wants to be at start of string")
|
||||
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
|
||||
PATLEN]
|
||||
(RETURN (\GETFILEPTR STREAM))
|
||||
FAILED
|
||||
(* ;
|
||||
"return the fileptr to its initial position.")
|
||||
(\SETFILEPTR STREAM ORGFILEPTR)
|
||||
(RETURN NIL])
|
||||
|
||||
(OLDFFILEPOS
|
||||
[LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 10-Aug-2020 21:44 by rmk:")
|
||||
|
||||
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
|
||||
(* Pavel "12-Oct-86 15:20")
|
||||
(PROG ([STREAM (\GETSTREAM (OR FILE (INPUT]
|
||||
PATBASE PATOFFSET PATLEN ORGFILEPTR STARTOFFSET ENDOFFSET BIGENDOFFSET STARTSEG ENDSEG EOF
|
||||
)
|
||||
(COND
|
||||
(SKIP (* ; "Slow case--use FILEPOS")
|
||||
(GO TRYFILEPOS))
|
||||
((NOT (fetch PAGEMAPPED of (fetch (STREAM DEVICE) of STREAM)))
|
||||
(* ;
|
||||
"This is a non-page-oriented file. Use FILEPOS instead.")
|
||||
(GO TRYFILEPOS))) (* ;
|
||||
"calculate start addr and set file ptr.")
|
||||
(CL:WHEN (EQ :UTF8 (\EXTERNALFORMAT STREAM))
|
||||
(SETQ PATTERN (XTOUSTRING PATTERN)))
|
||||
[COND
|
||||
((LITATOM PATTERN)
|
||||
(SETQ PATBASE (fetch (LITATOM PNAMEBASE) of PATTERN))
|
||||
(SETQ PATOFFSET 1)
|
||||
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of PATTERN)))
|
||||
(T (OR (STRINGP PATTERN)
|
||||
(SETQ PATTERN (MKSTRING PATTERN)))
|
||||
(SETQ PATBASE (fetch (STRINGP BASE) of PATTERN))
|
||||
(SETQ PATOFFSET (fetch (STRINGP OFFST) of PATTERN))
|
||||
(SETQ PATLEN (fetch (STRINGP LENGTH) of PATTERN]
|
||||
(COND
|
||||
((OR (IGREATERP PATLEN \MAX.PATTERN.SIZE)
|
||||
(ILESSP PATLEN \MIN.PATTERN.SIZE))
|
||||
(GO TRYFILEPOS)))
|
||||
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
|
||||
(SETQ STARTOFFSET (IPLUS (COND
|
||||
(START (COND
|
||||
((NOT (AND (FIXP START)
|
||||
(IGEQ START 0)))
|
||||
(LISPERROR "ILLEGAL ARG" START)))
|
||||
START)
|
||||
(T ORGFILEPTR))
|
||||
(SUB1 PATLEN))) (* ;
|
||||
"STARTOFFSET is the address of the character corresponding to the last character of PATTERN.")
|
||||
(SETQ EOF (\GETEOFPTR STREAM)) (* ;
|
||||
"calculate the character address of the character after the last possible match.")
|
||||
[SETQ ENDOFFSET (COND
|
||||
((NULL END) (* ; "Default is end of file")
|
||||
EOF)
|
||||
(T (IMIN (IPLUS (COND
|
||||
((ILESSP END 0)
|
||||
(IPLUS EOF END 1))
|
||||
(T END))
|
||||
PATLEN)
|
||||
EOF]
|
||||
|
||||
(* ;; "use STARTOFFSET and ENDOFFSET instead of START and END because vm functions shouldn't change their arguments.")
|
||||
|
||||
(COND
|
||||
((IGEQ STARTOFFSET ENDOFFSET) (* ; "nothing to search")
|
||||
(RETURN))
|
||||
((ILESSP (IDIFFERENCE ENDOFFSET STARTOFFSET)
|
||||
\MIN.SEARCH.LENGTH) (* ;
|
||||
"too small to make FFILEPOS worthwhile")
|
||||
(GO TRYFILEPOS)))
|
||||
(\SETFILEPTR STREAM STARTOFFSET)
|
||||
[RETURN (GLOBALRESOURCE
|
||||
(\FFDELTA1 \FFDELTA2 \FFPATCHAR)
|
||||
(PROG ((CASE (fetch (ARRAYP BASE)
|
||||
of (COND
|
||||
[CASEARRAY (COND
|
||||
((AND (ARRAYP CASEARRAY)
|
||||
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
|
||||
\ST.BYTE))
|
||||
CASEARRAY)
|
||||
(T (CASEARRAY CASEARRAY]
|
||||
(T \TRANSPARENT))))
|
||||
(DELTA1 (fetch (ARRAYP BASE) of \FFDELTA1))
|
||||
(DELTA2 (fetch (ARRAYP BASE) of \FFDELTA2))
|
||||
(PATCHAR (fetch (ARRAYP BASE) of \FFPATCHAR))
|
||||
(MAXPATINDEX (SUB1 PATLEN))
|
||||
CHAR CURPATINDEX LASTCHAR INC)
|
||||
|
||||
(* ;; "Use Boyer-Moore string search algorithm. Use two auxiliary tables, DELTA1 and DELTA2, to tell how far ahead to move in the file when a partial match fails. DELTA1 contains, for each character code, the distance of that character from the right end of the pattern, or PATLEN if the character does not occur in the pattern. DELTA2 contains, for each character position in the pattern, how far ahead to move such that the partial substring discovered to the right of the position now matches some other substring (to the left) in the pattern. PATCHAR is just PATTERN translated thru CASEARRAY")
|
||||
|
||||
(\SETUP.FFILEPOS PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2 CASE)
|
||||
[COND
|
||||
((SMALLP ENDOFFSET)
|
||||
(SETQ STARTSEG (SETQ ENDSEG 0)))
|
||||
(T
|
||||
(* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts. The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary. Note that STARTOFFSET and ENDOFFSET are never actually used as file ptrs, just for counting.")
|
||||
|
||||
(SETQ ENDSEG (FOLDLO ENDOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ BIGENDOFFSET (MOD ENDOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTSEG (FOLDLO STARTOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ STARTOFFSET (MOD STARTOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(SETQ ENDOFFSET (COND
|
||||
((EQ STARTSEG ENDSEG)
|
||||
BIGENDOFFSET)
|
||||
(T
|
||||
|
||||
(* ;; "In different segments, so we'll have to search all the way to the end of this seg; hence, `end' is currently as big as it gets")
|
||||
|
||||
FILEPOS.SEGMENT.SIZE]
|
||||
(SETQ LASTCHAR (GETBASEBYTE PATCHAR MAXPATINDEX))
|
||||
FIRSTCHARLP
|
||||
(COND
|
||||
[(IGEQ STARTOFFSET ENDOFFSET) (* ; "End of this chunk")
|
||||
(COND
|
||||
((EQ STARTSEG ENDSEG) (* ; "failed")
|
||||
(GO FAILED))
|
||||
(T (* ;
|
||||
"Finished this segment, roll over into new one")
|
||||
(add STARTSEG 1)
|
||||
(SETQ STARTOFFSET (IDIFFERENCE STARTOFFSET FILEPOS.SEGMENT.SIZE))
|
||||
(COND
|
||||
((EQ STARTSEG ENDSEG)
|
||||
(SETQ ENDOFFSET BIGENDOFFSET)))
|
||||
(GO FIRSTCHARLP]
|
||||
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
|
||||
LASTCHAR)
|
||||
(add STARTOFFSET (SETQ INC (GETBASEBYTE DELTA1 CHAR)))
|
||||
(OR (EQ INC 1)
|
||||
(\INCFILEPTR STREAM (SUB1 INC)))
|
||||
(* ;
|
||||
"advance file pointer accordingly (\BIN already advanced it one)")
|
||||
(GO FIRSTCHARLP)))
|
||||
(SETQ CURPATINDEX (SUB1 MAXPATINDEX))
|
||||
MATCHLP
|
||||
(COND
|
||||
((ILESSP CURPATINDEX 0)
|
||||
(GO FOUNDIT)))
|
||||
(\DECFILEPTR STREAM 2) (* ; "back up to read previous char")
|
||||
(COND
|
||||
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
|
||||
(GETBASEBYTE PATCHAR CURPATINDEX))
|
||||
(* ;
|
||||
"Mismatch, advance by greater of delta1 and delta2")
|
||||
(add STARTOFFSET (IDIFFERENCE (SETQ INC (IMAX (GETBASEBYTE DELTA1 CHAR)
|
||||
(GETBASEBYTE DELTA2
|
||||
CURPATINDEX)))
|
||||
(IDIFFERENCE MAXPATINDEX CURPATINDEX)))
|
||||
(OR (EQ INC 1)
|
||||
(\INCFILEPTR STREAM (SUB1 INC)))
|
||||
(GO FIRSTCHARLP)))
|
||||
(SETQ CURPATINDEX (SUB1 CURPATINDEX))
|
||||
(GO MATCHLP)
|
||||
FOUNDIT
|
||||
(* ;
|
||||
"set fileptr, adjust for beginning skips and return proper value.")
|
||||
(\INCFILEPTR STREAM (COND
|
||||
(TAIL (* ; "Put fileptr at end of string")
|
||||
(SUB1 PATLEN))
|
||||
(T (* ;
|
||||
"back up over the last char we looked at, i.e. the first char of string")
|
||||
-1)))
|
||||
(RETURN (\GETFILEPTR STREAM))
|
||||
FAILED
|
||||
(* ;
|
||||
"return the fileptr to its initial position.")
|
||||
(\SETFILEPTR STREAM ORGFILEPTR)
|
||||
(RETURN NIL]
|
||||
TRYFILEPOS
|
||||
(RETURN (FILEPOS PATTERN STREAM START END SKIP TAIL CASEARRAY])
|
||||
)
|
||||
|
||||
(FILESLOAD FPTESTS)
|
||||
|
||||
(ADDTOVAR DIRECTORIES {WMEDLEY}<internal>test>filepos>)
|
||||
|
||||
|
||||
|
||||
(* ;; "Compiling also requires EXPORTS.ALL")
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
IOCHAR)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (759 6571 (TFP 769 . 2219) (TFP1 2221 . 4656) (FPC 4658 . 5619) (FPCS 5621 . 6569)) (
|
||||
6572 27191 (OLDFILEPOS 6582 . 16284) (OLDFFILEPOS 16286 . 27189)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1 +0,0 @@
|
||||
012
|
||||
@@ -1 +0,0 @@
|
||||
(HCFILES "{DSK}<home>larry>ilisp>envos>" "{DSK}<home>larry>medley>tmp>psfiles>")
|
||||
@@ -1,66 +0,0 @@
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>PUBS>admin>doc-dirs>ERIS-DOC-WO-LOOPS.TEDIT;2
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley1.2>RS6000>keybaord-layout.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley2.0>final>ug>APP-D-DIFFERENCES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>DOC>printers>recommendation.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>1982BUGS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>BRIEFINGBLURB-DRAFT.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>CHAT-GENERIC.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>HELLO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>IDDESCRIPTION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>LISPARFIELDS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>NSCHARACTERS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>SOURCEFILES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>COLOROBJ.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>DSKTEST.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>BOONE-V-COE.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>NCPLOTCARD.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>GC>HAND-AUX>ADVDICT-N-Z.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>Library>TEdit>Hand-Aux>AR10063.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>i>o>Hardcopy>Hand>testfiles>04PARA.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEDELTA.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEIMPL.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>Manual>LAFITEMANUAL-INDEXINTERNAL.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>lispusers>2.0>src>EQUATIONEXAMPLES.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>03-SOFTWARE-INSTALLATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>05-NOTECARDS-BASICS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>11-SYSTEM-CARDS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>2.0>src>library>BOONE-V-COE.TED;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDEMO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>DDLCOLORHAX.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>LUCASFILMFORMAT.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>basics>INVOICE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV-CHOICE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDEMO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>ADVERTS>Cherry-RidgeWFH.TEdit;5
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Adv-Committee>Defns>ADVDEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Board>CALLERLAB-BYLAWCHANGE.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1-NEW-DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C2DEFNS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>NUMBERART.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-A-M.TEDIT;13
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-N-Z.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-I-R.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-S.TEDIT;7
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-T-Z.TEDIT;9
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-A-E.TEDIT;11
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-F-O.TEDIT;5
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-P-S.TEDIT;6
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-T-Z.TEDIT;6
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>DICT-PREFACE.TEDIT;14
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>leftover-calls.tedit;3
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>FRA>ARRANGEMENTS.TEDIT;28
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>venue>ads>aaai>top-rapid-dev.TEdit;4
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>24-STREAMS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>25-IO.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>27-GRAPHICS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>28-WINDOWS.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>29-HARDCOPY.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-ETHERNET.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-TERMINAL.TEDIT;1
|
||||
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>31-ETHERNET.TEDIT;1
|
||||
{DSK}<home>larry>medley>lispusers>ACE>ACE-MAINTAINERS-NOTES.TEDIT;1
|
||||
{DSK}<home>larry>medley>lispusers>EQUATIONEXAMPLES.TEDIT;1
|
||||
@@ -1,546 +0,0 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "23-May-2022 12:30:29"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TESTUPF.;1 32843 )
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TESTUPFCOMS)
|
||||
|
||||
(RPAQQ TESTUPFCOMS
|
||||
((COMS (* ; "Original code")
|
||||
(FNS OLD-UNPACKFILENAME.STRING \UPF.NEXTPOS \UPF.TEMPFILEP)
|
||||
(DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY UNPACKFILE1)))
|
||||
|
||||
(* ;; "Debugging")
|
||||
|
||||
|
||||
(* ;; "DOTTEDNAMES: mismatch intended")
|
||||
|
||||
|
||||
(* ;; "RETURNFAILS: mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped. But original doesn't agree with its own complete analaysis.")
|
||||
|
||||
(VARS DOTTEDNAMES TESTS RETURNFAILS)
|
||||
(FNS TRY TRYALL DT)))
|
||||
|
||||
|
||||
|
||||
(* ; "Original code")
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(OLD-UNPACKFILENAME.STRING
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 25-Jan-2022 17:16 by rmk")
|
||||
(* ; "Edited 5-Jan-2022 11:03 by rmk")
|
||||
(* ; "Edited 30-Mar-90 22:37 by nm")
|
||||
|
||||
(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")
|
||||
|
||||
(* ;;; "rmk: devices must come before directories.")
|
||||
|
||||
(PROG ((POS 1)
|
||||
(LEN (NCHARS FILE))
|
||||
TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
|
||||
(COND
|
||||
((NULL FILE)
|
||||
(RETURN NIL))
|
||||
((OR (LITATOM FILE)
|
||||
(STRINGP FILE)
|
||||
(NUMBERP FILE)))
|
||||
((TYPEP FILE 'PATHNAME)
|
||||
(RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
|
||||
[(STREAMP FILE) (* ;
|
||||
"For streams, use full name. If anonymous, fake it")
|
||||
(SETQ FILE (OR (ffetch FULLFILENAME of FILE)
|
||||
(RETURN (COND
|
||||
(ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
|
||||
FILE))
|
||||
(T (LIST 'NAME FILE]
|
||||
(T (\ILLEGAL.ARG FILE)))
|
||||
(COND
|
||||
((SELCHARQ (NTHCHARCODE FILE 1)
|
||||
({ (* ; "normal use in Interlisp-D")
|
||||
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE })
|
||||
FILE 2)
|
||||
0))))
|
||||
(%[ (* ;
|
||||
"some Xerox and Arpanet systems use '[' for host")
|
||||
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE "]")
|
||||
FILE 2)
|
||||
0))))
|
||||
(%( (* ;
|
||||
"this is the 'proposed standard' for Xerox servers")
|
||||
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE ")")
|
||||
FILE 2)
|
||||
0))))
|
||||
NIL)
|
||||
(UNPACKFILE1 'HOST 2 TEM)
|
||||
[COND
|
||||
((EQ TEM -1) (* ;
|
||||
"Started with the host field delimiter, but there was no corresponding terminating delimiter .")
|
||||
(* ;
|
||||
"I'm not sure why the name is dealt with the host name.")
|
||||
(RETURN (DREVERSE VAL]
|
||||
(SETQ POS (IPLUS TEM 2))
|
||||
[if (EQ OSTYPE T)
|
||||
then (* ;
|
||||
"Use actual host to determine os type")
|
||||
(SETQ OSTYPE (GETHOSTINFO (CAR VAL)
|
||||
'OSTYPE]
|
||||
(SETQ HOSTP T)))
|
||||
|
||||
(* ;; "rmk: if there is a colon before the next < or /, then we must be looking at a device. A device appears to end after the last colon, i.e., a device name can have a colon inside it.")
|
||||
|
||||
(COND
|
||||
((AND (SETQ TEM (\UPF.NEXTPOS (CHARCODE (%: < /))
|
||||
FILE POS))
|
||||
(EQ (CHARCODE %:)
|
||||
(NTHCHARCODE FILE TEM))) (* ;
|
||||
"all device returned have DEVICE.END on it so that NIL: will work")
|
||||
(UNPACKFILE1 'DEVICE POS (if CLFLG
|
||||
then (SUB1 TEM)
|
||||
else TEM))
|
||||
(SETQ POS (ADD1 TEM))
|
||||
(SETQ HOSTP T)))
|
||||
(COND
|
||||
((EQ DIRFLG 'RETURN) (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter. If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention. In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")
|
||||
(LET ((TYPE 'DIRECTORY)
|
||||
(START (SELCHARQ (NTHCHARCODE FILE POS)
|
||||
(NIL (* ; "just host, return")
|
||||
(RETURN (DREVERSE VAL)))
|
||||
((/ <) (* ;
|
||||
"Started with the initial directory delimiter.")
|
||||
(ADD1 POS))
|
||||
POS))
|
||||
END)
|
||||
(SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
|
||||
((/ >)
|
||||
[COND
|
||||
((EQ START POS) (* ;
|
||||
"Didn't start with a directory delimiter,")
|
||||
(COND
|
||||
((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM. This is a subdirectory of the current connected directory")
|
||||
(SETQ TYPE 'SUBDIRECTORY))
|
||||
(T (* ; "True %"relative pathname%". The way to deal with it is dependent on the device on which HOST is implemented.")
|
||||
(SETQ TYPE 'RELATIVEDIRECTORY]
|
||||
(COND
|
||||
((EQ LEN POS) (* ;
|
||||
"Only the initial directory is specified (i.e. %"{DSK}/%").")
|
||||
(SETQ START POS)
|
||||
-1)
|
||||
(T -2)))
|
||||
(PROGN [COND
|
||||
[(EQ START POS) (* ;
|
||||
"Both of the initial and trail delimiters are omitted.")
|
||||
(COND
|
||||
((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM. This is a subdirectory of the current connected directory")
|
||||
(SETQ TYPE 'SUBDIRECTORY))
|
||||
(T (* ; "True %"relative pathname%". The way to deal with it is dependent on the device on which HOST is implemented.")
|
||||
(SETQ TYPE 'RELATIVEDIRECTORY]
|
||||
(T (COND
|
||||
((EQ LEN POS)
|
||||
(* ;
|
||||
"Only the initial directory is specified (i.e. %"{DSK}<%").")
|
||||
(SETQ START POS]
|
||||
-1)))
|
||||
(UNPACKFILE1.DIRECTORY TYPE START END))
|
||||
(RETURN (DREVERSE VAL)))
|
||||
((SELCHARQ (NTHCHARCODE FILE POS)
|
||||
(/ (* ;
|
||||
"unix and the 'xerox standard' use / for delimiter")
|
||||
(* ;
|
||||
"In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
|
||||
(SETQ TEM (LASTCHPOS (CHARCODE (/ >))
|
||||
FILE
|
||||
(ADD1 POS)))
|
||||
T)
|
||||
((< >) (* ;
|
||||
"Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>. Jericho uses >>")
|
||||
(* ;
|
||||
"In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
|
||||
(SETQ TEM (LASTCHPOS (CHARCODE (> /))
|
||||
FILE
|
||||
(ADD1 POS)))
|
||||
T)
|
||||
NIL)
|
||||
|
||||
(* ;; "allow {DSK}/etc to be a directory specification.")
|
||||
|
||||
(if TEM
|
||||
then (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
|
||||
(SUB1 TEM))
|
||||
(SETQ POS (ADD1 TEM))
|
||||
else
|
||||
(* ;; "{DSK}/foo: the directory is /, the name is foo")
|
||||
|
||||
(UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
|
||||
(SETQ POS (ADD1 POS)))
|
||||
(SETQ HOSTP T))
|
||||
((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
|
||||
FILE POS)) (* ; " {eris}abc> relative")
|
||||
|
||||
(* ;;
|
||||
" This is the true %"relative pathname%". Returns RELATIVEDIRECTORY instead of DIRECTORY.")
|
||||
|
||||
[COND
|
||||
((NOT HOSTP) (* ; "%"Incomplete file names%" case.")
|
||||
(UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
|
||||
then 'DIRECTORY
|
||||
else 'SUBDIRECTORY)
|
||||
POS
|
||||
(SUB1 TEM)))
|
||||
(T (* ; "True %"relative pathname%".")
|
||||
(UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
|
||||
then 'DIRECTORY
|
||||
else 'RELATIVEDIRECTORY)
|
||||
POS
|
||||
(SUB1 TEM]
|
||||
(SETQ POS (ADD1 TEM))
|
||||
(SETQ HOSTP T)))
|
||||
(OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
|
||||
(RETURN (DREVERSE VAL)))
|
||||
(if (EQ OSTYPE T)
|
||||
then (* ;
|
||||
"There wasn't a host field in the name, so we have no clue")
|
||||
(SETQ OSTYPE NIL))
|
||||
NAMELP
|
||||
|
||||
|
||||
(* ;; "At this point, CODE is the TEM'th char of file name. POS is the first character of the field we are currently working on.")
|
||||
|
||||
(SELCHARQ CODE
|
||||
(%. (* ;
|
||||
"Note position for later--we only want to deal with the last set of dots")
|
||||
(if BEYONDNAME
|
||||
then (* ;
|
||||
"no longer of interest (probably a bad name, too)")
|
||||
elseif FIRSTDOT
|
||||
then (* ; "We're recording the second dot")
|
||||
(if SECONDDOT
|
||||
then (* ;
|
||||
"Note only the two most recent dots")
|
||||
(SETQ FIRSTDOT SECONDDOT))
|
||||
(SETQ SECONDDOT TEM)
|
||||
else (SETQ FIRSTDOT TEM)))
|
||||
((! ; NIL) (* ;
|
||||
"SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
|
||||
(if (SELCHARQ CODE
|
||||
(! (* ;
|
||||
"! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
|
||||
(AND OSTYPE (NEQ OSTYPE 'IFS)))
|
||||
(; (* ; "If we've already parsed the extension, then we have a semi in the middle of the version. Skip it unless it's ;T or ;S")
|
||||
[AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
|
||||
NIL)
|
||||
then (GO NEXTCHAR))
|
||||
(if FIRSTDOT
|
||||
then (* ;
|
||||
"Have a name and/or extension to parse now")
|
||||
(if
|
||||
[AND SECONDDOT
|
||||
(NOT (if OSTYPE
|
||||
then (* ;
|
||||
"Known OS type must be Tops20 for second dot to mean version")
|
||||
(EQ OSTYPE 'TOPS20)
|
||||
else (* ;
|
||||
"Unknown OS type, so check that %"version%" is numeric or wildcard")
|
||||
(AND [for I from (ADD1 SECONDDOT) to (SUB1 TEM)
|
||||
bind CH
|
||||
always (OR (DIGITCHARP (SETQ CH (NTHCHARCODE FILE I
|
||||
)))
|
||||
(EQ CH (CHARCODE *]
|
||||
(SELCHARQ CODE
|
||||
(NIL (* ; "end of file name, ok")
|
||||
T)
|
||||
(; (* ;
|
||||
"This semi-colon better not be introducing a version")
|
||||
(\UPF.TEMPFILEP FILE (ADD1 TEM)))
|
||||
NIL]
|
||||
then (* ;
|
||||
"Second dot is not intoducing a version")
|
||||
(SETQ FIRSTDOT SECONDDOT)
|
||||
(SETQ SECONDDOT NIL))
|
||||
(UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
|
||||
(SETQ POS (ADD1 (if SECONDDOT
|
||||
then (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
|
||||
(SUB1 SECONDDOT))
|
||||
(SETQ BEYONDEXT T)
|
||||
SECONDDOT
|
||||
else FIRSTDOT)))
|
||||
(SETQ BEYONDNAME T)
|
||||
(SETQ FIRSTDOT NIL))
|
||||
(UNPACKFILE1 (COND
|
||||
((NOT BEYONDNAME)
|
||||
(SETQQ BEYONDNAME NAME))
|
||||
((NOT BEYONDEXT)
|
||||
'EXTENSION)
|
||||
((AND (EQ BEYONDEXT (CHARCODE ";"))
|
||||
(\UPF.TEMPFILEP FILE POS)))
|
||||
(T (* ;
|
||||
"Everything after the semi was version")
|
||||
'VERSION))
|
||||
POS
|
||||
(SUB1 TEM))
|
||||
(if (NULL CODE)
|
||||
then (* ; "End of string")
|
||||
(RETURN (DREVERSE VAL)))
|
||||
(SETQ BEYONDEXT CODE) (* ;
|
||||
"Note the character that terminated the name/ext")
|
||||
(SETQ POS (ADD1 TEM)))
|
||||
(%' (* ; "Quoter")
|
||||
(add TEM 1))
|
||||
NIL)
|
||||
NEXTCHAR
|
||||
(SETQ CODE (NTHCHARCODE FILE (add TEM 1)))
|
||||
(GO NAMELP])
|
||||
|
||||
(\UPF.NEXTPOS
|
||||
[LAMBDA (CHAR STRING POS) (* lmm " 5-Oct-84 18:41")
|
||||
(bind NCH while (SETQ NCH (NTHCHARCODE STRING POS)) do (COND
|
||||
((EQMEMB NCH CHAR)
|
||||
(RETURN POS))
|
||||
((EQ NCH (CHARCODE %'))
|
||||
(add POS 1)))
|
||||
(add POS 1])
|
||||
|
||||
(\UPF.TEMPFILEP
|
||||
[LAMBDA (FILENAME START) (* ; "Edited 6-Jan-88 13:12 by bvm:")
|
||||
|
||||
(* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START. Returns the appropriate field name if so. Not sure we should parse this junk any more, but this at least localizes it.")
|
||||
|
||||
(SELCHARQ (NTHCHARCODE FILENAME START)
|
||||
((T S) (* ; "Funny temp stuff")
|
||||
(AND (EQ START (NCHARS FILENAME))
|
||||
'TEMPORARY))
|
||||
NIL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS CANONICAL.DIRECTORY MACRO
|
||||
[OPENLAMBDA (SRCSTRING)
|
||||
(AND
|
||||
SRCSTRING
|
||||
(LET
|
||||
((LEN (NCHARS SRCSTRING)))
|
||||
(COND
|
||||
((EQ LEN 1)
|
||||
(if (STREQUAL SRCSTRING "/")
|
||||
then "<"
|
||||
else SRCSTRING))
|
||||
(T
|
||||
(LET*
|
||||
((FATP (ffetch (STRINGP FATSTRINGP) of SRCSTRING))
|
||||
(DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
|
||||
(DSTBASE (ffetch (STRINGP BASE) of DSTSTRING))
|
||||
(DSTPOS 0)
|
||||
(NEXTPOS -1))
|
||||
(if (NOT FATP)
|
||||
then [for SRCPOS from 1 to LEN bind CODE
|
||||
first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
|
||||
(CHARCODE (< / >))) do (add SRCPOS 1))
|
||||
(if (> SRCPOS LEN)
|
||||
then (RETURN "<"))
|
||||
do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
|
||||
((> /)
|
||||
(if (> DSTPOS NEXTPOS)
|
||||
then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
|
||||
(SETQ NEXTPOS (add DSTPOS 1))))
|
||||
(%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)
|
||||
(if (NEQ SRCPOS LEN)
|
||||
then (\PUTBASETHIN DSTBASE DSTPOS
|
||||
(NTHCHARCODE SRCSTRING (add SRCPOS 1)))
|
||||
(add DSTPOS 1)))
|
||||
(PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)))
|
||||
finally (RETURN (if (EQ DSTPOS LEN)
|
||||
then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 -2)
|
||||
else DSTSTRING)
|
||||
elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
|
||||
else (SUBSTRING DSTSTRING 1 DSTPOS]
|
||||
else (for SRCPOS from 1 to LEN bind CODE
|
||||
first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
|
||||
(CHARCODE (< / >))) do (add SRCPOS 1))
|
||||
do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
|
||||
((> /)
|
||||
(if (> DSTPOS NEXTPOS)
|
||||
then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
|
||||
(SETQ NEXTPOS (add DSTPOS 1))))
|
||||
(%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)
|
||||
(if (NEQ SRCPOS LEN)
|
||||
then (\PUTBASEFAT DSTBASE DSTPOS (NTHCHARCODE
|
||||
SRCSTRING
|
||||
(add SRCPOS 1)))
|
||||
(add DSTPOS 1)))
|
||||
(PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
|
||||
(add DSTPOS 1)))
|
||||
finally (RETURN (if (EQ DSTPOS LEN)
|
||||
then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 -2)
|
||||
else DSTSTRING)
|
||||
elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
|
||||
(CHARCODE (> /)))
|
||||
then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
|
||||
else (SUBSTRING DSTSTRING 1 DSTPOS])
|
||||
|
||||
(PUTPROPS UNPACKFILE1.DIRECTORY MACRO [OPENLAMBDA (NAM ST END)
|
||||
(LET* ((OLDDIR (SUBSTRING FILE ST END))
|
||||
(NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
|
||||
(COND
|
||||
[(NOT ONEFIELDFLG)
|
||||
(SETQ VAL (CONS (COND
|
||||
(PACKFLG (AND NEWDIR
|
||||
(MKATOM NEWDIR)))
|
||||
(T (OR NEWDIR "")))
|
||||
(CONS NAM VAL]
|
||||
((EQMEMB NAM ONEFIELDFLG)
|
||||
(RETURN (COND
|
||||
(PACKFLG (AND NEWDIR (MKATOM NEWDIR)))
|
||||
(T (OR NEWDIR ""])
|
||||
|
||||
(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END) (* lmm "22-APR-81 22:21")
|
||||
(COND
|
||||
[(NOT ONEFIELDFLG)
|
||||
(SETQ VAL (CONS (COND
|
||||
(PACKFLG (SUBATOM FILE ST END))
|
||||
(T (OR (SUBSTRING FILE ST END)
|
||||
"")))
|
||||
(CONS NAM VAL]
|
||||
((EQMEMB NAM ONEFIELDFLG)
|
||||
(RETURN (COND
|
||||
(PACKFLG (SUBATOM FILE ST END))
|
||||
(T (OR (SUBSTRING FILE ST END)
|
||||
""])
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;; "Debugging")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;; "DOTTEDNAMES: mismatch intended")
|
||||
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"RETURNFAILS: mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped. But original doesn't agree with its own complete analaysis."
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ DOTTEDNAMES (".x" ">.git" "x.y.100"))
|
||||
|
||||
(RPAQQ TESTS
|
||||
("*,;" "*.*;*" "*.;" "*.;*" "///abc/x" "/abc.x" "<" "<<<abc" "<<<abc>" "<<<abc>>" "<<<abc>x"
|
||||
"<<abc" "<<xyz>>>zz" "<<xyz>>>zzz/" "<<xyz>>zz" "<<xyz>zz" "<ABC>" "<XYZ>aa" "<a.b>"
|
||||
"<a;b>" "<ab;c" "<ab>" "<abc" "<abc*." "<abc.x" "<abc.x;1" "<abc;x" "<abc<<<x"
|
||||
"<abc<xyz<foo" "<abc<xyz>qrs" "<abc>" "<abc>;1" "<abc>xyz" "<abc>xyz>foo" "<xxx"
|
||||
"<xy>>zz" "<xyz>>>zzz/" ">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"
|
||||
"A.B.C" "XXX<yyy" "a;b" "a;b/d" "a;b;c" "a;b;c;d" "aa" "aa;" "aa;NEWEST" "aa;newest"
|
||||
"aaa" "aaa/bbb" "aaa/bbb/" "aaa/xyz;x;m" "aaa<bbb" "aaa<bbb/" "aaa<xyz>" "aaa>bbb>"
|
||||
"aaa>xyz.e;m;n" "aaa>xyz>qrs" "abc" "abc...c" "abc///XYZ//" "abc/d" "abc/xyz"
|
||||
"abc/xyz.qrs" "abc/xyz.qrs;2" "abc:x<qrs>z" "abc<<<XYZ//" "abc<x" "abc<xyz"
|
||||
"abc<xyz>qq" "abc<xyzqq" "abc>;1" "abc>qr.x" "abc>xy" "abc>xyz" "abc>xyz;2"
|
||||
"dev:aaa>xyz>qrs" "foo:" "foo:aaa<xyz" "foo:aaa<xyz>" "foo:x<qrs>z" "foo<a:B>" "s;n;b"
|
||||
"x.y.z;w" "x.y;z" "x;y" "x<abc<xyz>qrs" "x<abc<z" "x<abc>z" "xxx<yyy" "xxx<yyy>"
|
||||
"xxx<yyy>zzz" "xxx>yyy" "xxx>yyy>" "{ABC}" "{ABC}XXX:" "{DSK}" "{DSK}*.;*" "{DSK}...<a"
|
||||
"{DSK}<a" "{DSK}xxx<a" "{DSK}xxx<xxx>yyy" "{DSK}xxx>xxx" "{DSK}xxx>yyy"
|
||||
"{HOST}foo:x<qrs>z" "{HOST}x<qrs>z" "{abc}" "{dsk}foo:aaa>b>.c.e.g;f"
|
||||
"{dsk}foo:aaa>b>.c.e;f" "{dsk}foo:aaa>b>c.e;f" "{eris}abc>" "{host}abc/xyz;2"
|
||||
"{host}abc>xyz;2" "{x}abc<xyz>qq" "{x}abc<xyzqq" "<abc<xyz>abc" "<abc<xyz>qrs"
|
||||
"<abc<xyz>"))
|
||||
|
||||
(RPAQQ RETURNFAILS (">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" ">" ">>>abc/x"
|
||||
">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"))
|
||||
(DEFINEQ
|
||||
|
||||
(TRY
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG) (* ; "Edited 23-May-2022 12:09 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 14:15 by rmk")
|
||||
(* ; "Edited 24-Apr-2022 08:45 by rmk")
|
||||
(* ; "Edited 21-Apr-2022 15:36 by rmk")
|
||||
(CL:WHEN (LISTP (CAR (LISTP FILE)))
|
||||
(SETQ FILE (CAR FILE)))
|
||||
(LET (ORIG NEW)
|
||||
(CL:WHEN (LISTP FILE)
|
||||
(SETQ ONEFIELDFLG (CADR FILE))
|
||||
(SETQ DIRFLG (CADDR FILE))
|
||||
(SETQ FILE (CAR FILE)))
|
||||
(SETQ ORIG (OLD-UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
|
||||
(SETQ NEW (UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
|
||||
(LIST (LIST FILE ONEFIELDFLG DIRFLG)
|
||||
(AND (EQUAL ORIG NEW)
|
||||
'=)
|
||||
ORIG NEW])
|
||||
|
||||
(TRYALL
|
||||
[LAMBDA (FILES ALLFLAG ONEFIELDFLG DIRFLG) (* ; "Edited 21-Apr-2022 17:56 by rmk")
|
||||
(* ; "Edited 2-Apr-2022 23:50 by rmk")
|
||||
(* ; "Edited 31-Mar-2022 22:57 by rmk")
|
||||
(CL:WHEN (LISTP FILES)
|
||||
(SETQ FILES (FOR F IN FILES COLLECT (CL:IF (LISTP (CAR (LISTP F)))
|
||||
(CAR F)
|
||||
F))))
|
||||
(FOR FILE INFO (SAME _ 0)
|
||||
(DIFF _ 0) IN FILES EACHTIME (SETQ INFO (TRY FILE ONEFIELDFLG DIRFLG))
|
||||
(CL:IF (CADR INFO)
|
||||
(ADD SAME 1)
|
||||
(ADD DIFF 1)) UNLESS (AND (CADR INFO)
|
||||
(NOT ALLFLAG))
|
||||
COLLECT (PRINTOUT T .P2 (CAAR INFO)
|
||||
31)
|
||||
(IF (CADR INFO)
|
||||
THEN (PRINTOUT T " = " .P2 (CADDR INFO))
|
||||
(CL:WHEN (OR (CADAR INFO)
|
||||
(CADDAR INFO))
|
||||
(PRINTOUT T 60 (CADAR INFO)
|
||||
%,,
|
||||
(CADDAR INFO))
|
||||
(TERPRI T))
|
||||
ELSE (PRINTOUT T " ~= " -2 "old: " .P2 (CADDR INFO))
|
||||
(CL:WHEN (OR (CADAR INFO)
|
||||
(CADDAR INFO))
|
||||
(PRINTOUT T 60 (CADAR INFO)
|
||||
%,,
|
||||
(CADDAR INFO))
|
||||
(TERPRI T))
|
||||
(PRINTOUT T 37 "new: " .P2 (CADDDR INFO)
|
||||
T))
|
||||
INFO FINALLY (PRINTOUT T SAME " matches, " DIFF " mismatches" T])
|
||||
|
||||
(DT
|
||||
[LAMBDA (STRINGS ALLFLAG) (* ; "Edited 21-Apr-2022 17:53 by rmk")
|
||||
(* ; "Edited 19-Apr-2022 20:55 by rmk")
|
||||
|
||||
(* ;; "Tests the DIRFLG options on STRINGS. If an element of STRINGS is a list, it is assumed to be a (STRING ONEFIELD DIRFLG), STRING is extracted.")
|
||||
|
||||
(SETQ STRINGS (FOR S INSIDE STRINGS COLLECT (CL:IF (LISTP S)
|
||||
(CAR S)
|
||||
S)))
|
||||
[AND NIL (FOR ONEFIELD IN '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
|
||||
JOIN (FOR DIR ORIG NEW SAME IN '(FIELD RETURN)
|
||||
JOIN (PRINTOUT T T "ONEFIELDFLG = " ONEFIELD -3 "DIRFLG = " DIR T T)
|
||||
(TRYALL STRINGS ALLFLAG ONEFIELD DIR))
|
||||
FINALLY (FOR INFO SAME (DIFF _ 0) IN $$VAL DO (CL:IF (CADR INFO)
|
||||
(ADD SAME 1)
|
||||
(ADD DIFF 1))
|
||||
FINALLY (SETQ SAME (IDIFFERENCE (LENGTH STRINGS)
|
||||
DIFF))
|
||||
(PRINTOUT T T "Overall: " SAME " matched, " DIFF " mismatched" T]
|
||||
(TRYALL (FOR S IN STRINGS JOIN (FOR ONEFIELD IN '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
|
||||
JOIN (FOR DIR IN '(FIELD RETURN)
|
||||
COLLECT (LIST S ONEFIELD DIR])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (893 18981 (OLD-UNPACKFILENAME.STRING 903 . 17808) (\UPF.NEXTPOS 17810 . 18396) (
|
||||
\UPF.TEMPFILEP 18398 . 18979)) (28216 32820 (TRY 28226 . 29192) (TRYALL 29194 . 31111) (DT 31113 .
|
||||
32818)))))
|
||||
STOP
|
||||
Binary file not shown.
@@ -1,23 +0,0 @@
|
||||
TESTUPF contains functions for testing the new implementation of UNPACKFILENAME.STRING (now in ADIR) and the original definition.
|
||||
|
||||
The original definition is also provided here, under the name OLD-UNPACKFILENAME.STRING
|
||||
|
||||
TESTUPF also includes some test functions, and some of the strings that I have been testing with.
|
||||
|
||||
(TRY FILE ONEDIRFLG DIRFLG)
|
||||
|
||||
returns a comparison of the behavior of the original version and the new version in a list of the form
|
||||
|
||||
(FILE ONEDIRFLG DIRFLG) MATCH ORIG NEW)
|
||||
|
||||
where MATCH is = if ORIG and NEW are EQUAL, otherwise NIL. (For convenience, a list of this form can also be passed in as an argument.)
|
||||
|
||||
(TRYALL FILES ALLFLG ONDIRFLG DIRFLG)
|
||||
|
||||
applies TRY to each file-string in FILES, prints and reports what it discovers. If ALLFLG, it prints the result on every file, otherwise just the mismatches. Value is a list of TRY values that it printed.
|
||||
|
||||
(DT FILES) sets up a call to TRYALL for DIRFLG testing (setting DIRFLG NIL, FIELD, RETURN for each file in FILES).
|
||||
|
||||
The variable TESTS has the strings that I have tested against, the variable DOTTEDNAMES has the strings that I intend to be different (.cshrc as NAME, not EXTENSION). The new behavior avoids the bug that (PACKFILENAME.STRING 'EXTENSION "txt "BODY ".bashrc") produces ".txt" instead of ".bashrc.txt".
|
||||
|
||||
The variable RETURNFAILS is a list of strings with DIRFLG=RETURN that also don¹t match, in that the DIRECTORY and SUBDIRECTORY classifications are inverted between old and new for strings beginning with ª>". But the old code is inconsistent for these inputs: it returns different classifications of those substrings with or without the RETURN. (I think RETURN is for the case "/Users/kaplan" where the caller knows that the whole thing is a directory, doesn¹t want ªkaplanº to be parsed as a name. Just wants it to be normalized, with host and device stripped off.)
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Dec-2021 19:33:12" |{DSK}<home>larry>medley>library>FILEBROWSER.;44| 267497
|
||||
(FILECREATED " 4-Aug-2022 09:32:02" |{DSK}<home>larry>medley>library>FILEBROWSER.;2| 266567
|
||||
|
||||
|changes| |to:| (VARS FILEBROWSERCOMS)
|
||||
:CHANGES-TO (VARS FILEBROWSERCOMS)
|
||||
|
||||
|previous| |date:| "23-Nov-2021 12:17:08" |{DSK}<home>larry>medley>library>FILEBROWSER.;39|)
|
||||
:PREVIOUS-DATE " 2-Dec-2021 19:33:12" |{DSK}<home>larry>medley>library>FILEBROWSER.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
|
||||
@@ -185,8 +185,7 @@ You specify how many versions to keep.")))
|
||||
(* \; "Setup")
|
||||
(FNS FB.STARTUP FB.MAKERIGIDWINDOW)
|
||||
(FNS FB.PRINTFN FB.COPYFN))
|
||||
(COMS (* \;
|
||||
"commands and major subfunctions")
|
||||
(COMS (* \; "commands and major subfunctions")
|
||||
(FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY
|
||||
FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON)
|
||||
(FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES
|
||||
@@ -221,8 +220,8 @@ You specify how many versions to keep.")))
|
||||
(FNS FB.ICONFN FB.INFOMENU.WHENSELECTEDFN FB.CLOSEFN FB.EXPUNGE?.MENU FB.AFTERCLOSEFN
|
||||
FB.CLOSE&EXPUNGE)
|
||||
(FNS FB.HARDCOPY.DIRECTORY FB.HARDCOPY.PRINT.TITLE FB.HARDCOPY.MAXWIDTH))
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
TABLEBROWSER)
|
||||
(RECORDS INFOFIELD FBFILEDATA FILEBROWSER)
|
||||
(CONSTANTS FB.MORE.BORDER FB.NULL.VERSION)
|
||||
(MACROS NULL.VERSIONP NULL.DIRECTORYP EQ.DIRECTORYP NULL.FIELDP)
|
||||
@@ -276,8 +275,8 @@ You specify how many versions to keep.")))
|
||||
DOCOPY
|
||||
|
||||
(RPAQ? FB.ICONSPEC '(#*(83 70)OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@LOOOOOOOOOOOOOOOOOONF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DCOOOHD@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DOOOOND@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@B@@@@@H@@@@@BF@@@LH@@@@@A@@@@A@@@@@@BF@@@LH@@@@@@OOOON@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LOOOOOOOOOOOOOOOOOONF@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@
|
||||
NIL
|
||||
(5 5 73 40)))
|
||||
NIL
|
||||
(5 5 73 40)))
|
||||
)
|
||||
|
||||
(RPAQ? FB.EXPUNGE?MENU )
|
||||
@@ -305,9 +304,9 @@ DOCOPY
|
||||
(RPAQ? FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR))
|
||||
|
||||
(APPENDTOVAR FONTVARS (FB.ICONFONT LITTLEFONT)
|
||||
(FB.BROWSERFONT DEFAULTFONT)
|
||||
(FB.PROMPTFONT LITTLEFONT)
|
||||
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
|
||||
(FB.BROWSERFONT DEFAULTFONT)
|
||||
(FB.PROMPTFONT LITTLEFONT)
|
||||
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
|
||||
|
||||
|
||||
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
|
||||
@@ -408,27 +407,25 @@ You specify how many versions to keep.")))
|
||||
))
|
||||
|
||||
(RPAQQ FB.VERSION.MENU.ITEMS (("1" 1 "Keep only one version of the files")
|
||||
("2" 2 "Keep two versions of the files")
|
||||
("3" 3 "Keep three versions of the files")
|
||||
("4" 4 "Keep four versions of the files")
|
||||
("Other" :NUMBER "Select number of versions to keep")))
|
||||
("2" 2 "Keep two versions of the files")
|
||||
("3" 3 "Keep three versions of the files")
|
||||
("4" 4 "Keep four versions of the files")
|
||||
("Other" :NUMBER "Select number of versions to keep")))
|
||||
|
||||
(RPAQQ FB.CLOSE.MENU.ITEMS (("Expunge deleted files" 'EXPUNGE
|
||||
"Erases all files still marked 'deleted'")
|
||||
("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
|
||||
"Erases all files still marked 'deleted'")
|
||||
("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
|
||||
Your deletions are thus ignored.")))
|
||||
|
||||
(RPAQQ FB.DEPTH.MENU.ITEMS (("Global default" :GLOBAL
|
||||
"Set depth using the global default (FILING.ENUMERATION.DEPTH)"
|
||||
)
|
||||
("Infinite" T
|
||||
"Set depth to infinity, i.e., enumerate all levels of directory"
|
||||
)
|
||||
("1" 1
|
||||
"Set depth using the global default (FILING.ENUMERATION.DEPTH)")
|
||||
("Infinite" T
|
||||
"Set depth to infinity, i.e., enumerate all levels of directory")
|
||||
("1" 1
|
||||
"Set depth to 1, i.e., enumerate just the top level of the directory"
|
||||
)
|
||||
("2" 2 "Set depth to 2")
|
||||
("Other" :NUMBER "Set depth to some other finite depth")))
|
||||
)
|
||||
("2" 2 "Set depth to 2")
|
||||
("Other" :NUMBER "Set depth to some other finite depth")))
|
||||
|
||||
(RPAQQ FB.INFO.MENU.ITEMS
|
||||
((|Length| LENGTH "Toggles Length display")
|
||||
@@ -3857,127 +3854,124 @@ then click Recompute"))))
|
||||
)
|
||||
(DECLARE\: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(FILESLOAD (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TABLEBROWSER)
|
||||
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(RECORD INFOFIELD (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
|
||||
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
|
||||
(FILEINFO POINTER) (* \; "Plist of attributes")
|
||||
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
|
||||
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
|
||||
(HASDIRPREFIX FLAG) (* \;
|
||||
"True if it has a directory prefix beyond that in common to all the files")
|
||||
(DIRECTORYFILEP FLAG) (* \;
|
||||
"True if the \"file\" in this item is actually a subdirectory")
|
||||
(SIZE POINTER) (* \; "Size of file, for stats")
|
||||
(FILEDEPTH BYTE) (* \;
|
||||
"Number of levels of subdirectory beneath the main pattern--zero for files at that level")
|
||||
(SORTVALUE POINTER) (* \;
|
||||
"Cached value by which we are sorting the dir.")
|
||||
(SUBDIREND WORD) (* \;
|
||||
"Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
|
||||
(STARTOFPNAME WORD) (* \;
|
||||
"Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
|
||||
(VERSION WORD) (* \; "Version, or zero if none")
|
||||
(STARTOFNAME WORD) (* \;
|
||||
"Index beyond all directory fields")
|
||||
DUMMY)
|
||||
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME
|
||||
)
|
||||
OF DATUM)
|
||||
(FETCH (FBFILEDATA STARTOFPNAME
|
||||
) OF DATUM)))
|
||||
(SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA
|
||||
FILENAME)
|
||||
OF DATUM)
|
||||
1
|
||||
(FETCH (FBFILEDATA SUBDIREND
|
||||
) OF
|
||||
DATUM))))))
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
|
||||
(FILEINFO POINTER) (* \; "Plist of attributes")
|
||||
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
|
||||
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
|
||||
(HASDIRPREFIX FLAG) (* \;
|
||||
"True if it has a directory prefix beyond that in common to all the files")
|
||||
(DIRECTORYFILEP FLAG) (* \;
|
||||
"True if the \"file\" in this item is actually a subdirectory")
|
||||
(SIZE POINTER) (* \; "Size of file, for stats")
|
||||
(FILEDEPTH BYTE) (* \;
|
||||
"Number of levels of subdirectory beneath the main pattern--zero for files at that level")
|
||||
(SORTVALUE POINTER) (* \;
|
||||
"Cached value by which we are sorting the dir.")
|
||||
(SUBDIREND WORD) (* \;
|
||||
"Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
|
||||
(STARTOFPNAME WORD) (* \;
|
||||
"Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
|
||||
(VERSION WORD) (* \; "Version, or zero if none")
|
||||
(STARTOFNAME WORD) (* \;
|
||||
"Index beyond all directory fields")
|
||||
DUMMY)
|
||||
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME)
|
||||
OF DATUM)
|
||||
(FETCH (FBFILEDATA STARTOFPNAME)
|
||||
OF DATUM)))
|
||||
(SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA FILENAME)
|
||||
OF DATUM)
|
||||
1
|
||||
(FETCH (FBFILEDATA SUBDIREND)
|
||||
OF DATUM))))))
|
||||
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
|
||||
"True if we don't want separate subdirectory lines -- subdirs then included in name")
|
||||
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
|
||||
(SHOWUNDELETED? FLAG) (* \;
|
||||
"True if counter window should show `Undeleted' rather than `Total' counts")
|
||||
(PATTERNPARSED? FLAG) (* \;
|
||||
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
|
||||
(SORTBYDATE FLAG) (* \;
|
||||
"True if SORTATTRIBUTE is one of the date attributes")
|
||||
(FBREADY FLAG) (* \; "False while FB is enumerating.")
|
||||
(ABORTING FLAG) (* \;
|
||||
"True if enumeration is being aborted")
|
||||
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
|
||||
(FBCOMPUTEDDEPTH BYTE) (* \;
|
||||
"Depth at the time we enumerated directory (zero for infinite)")
|
||||
(FBDISPLAYEDDEPTH BYTE) (* \;
|
||||
"Depth we are currently displaying (zero for infinite)")
|
||||
(TABLEBROWSER POINTER) (* \;
|
||||
"Pointer to TABLEBROWSER object controlling the browser")
|
||||
(BROWSERWINDOW POINTER) (* \; "Main window")
|
||||
(COUNTERWINDOW POINTER) (* \;
|
||||
"Window that counts files, pages, deletions")
|
||||
(HEADINGWINDOW POINTER) (* \;
|
||||
"Window with headings for browser columns")
|
||||
(INFOMENUW POINTER) (* \;
|
||||
"Window containing choices for info to be displayed, or NIL if none yet")
|
||||
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
|
||||
(INFODISPLAYED POINTER) (* \;
|
||||
"List of attribute specs to be displayed")
|
||||
(PATTERN POINTER) (* \;
|
||||
"Directory pattern being enumerated")
|
||||
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
|
||||
(SEEWINDOW POINTER) (* \;
|
||||
"Primary window used by FAST SEE command")
|
||||
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
|
||||
(SORTBY POINTER) (* \;
|
||||
"Sorting function or NIL for default sort")
|
||||
(NAMESTART WORD) (* \;
|
||||
"Index of first character in file name beyond the common prefix shared by all")
|
||||
(DIRECTORYSTART WORD) (* \;
|
||||
"Index of first character of directory in file names")
|
||||
(INFOSTART WORD) (* \;
|
||||
"X position in browser where first col of info is displayed")
|
||||
(NAMEOVERHEAD WORD) (* \;
|
||||
"This plus width of name gives is how much to allow before INFOSTART")
|
||||
(OVERFLOWSPACING WORD) (* \;
|
||||
"Increment between sizes considered for INFOSTART")
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD) (* \;
|
||||
"Total number of files, deleted files, pages, deleted pages at the moment")
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER) (* \;
|
||||
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
|
||||
(COUNTERPOSITIONS POINTER) (* \;
|
||||
"List of pairs (left right) describing regions where the values of the counters are displayed")
|
||||
(COUNTERPAGESTRING POINTER) (* \;
|
||||
"String to print after file/page count")
|
||||
(OVERFLOWWIDTHS POINTER) (* \;
|
||||
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
|
||||
(INFOMENUCHOICES POINTER) (* \;
|
||||
"Selections user has made in Info window, not necessarily the info currently displayed")
|
||||
(UPDATEPROC POINTER) (* \;
|
||||
"Process doing an Update (Recompute)")
|
||||
(DEFAULTDIR POINTER) (* \;
|
||||
"Default directory for destination of Copy/Rename")
|
||||
(SORTATTRIBUTE POINTER) (* \;
|
||||
"Attribute being sorted on, or NIL if by name")
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER) (* \;
|
||||
"Lock acquired by filebrowser operations")
|
||||
(SORTINDEX WORD) (* \;
|
||||
"Index (zero-based) in file info of the sort attribute")
|
||||
(SIZEINDEX WORD) (* \; "Index of size attribute")
|
||||
(FBDEPTH POINTER) (* \;
|
||||
"Enumeration depth, or NIL for default")
|
||||
(ABORTWINDOW POINTER) (* \;
|
||||
"Dotted pair of (abortwindow . menuw) for this browser's abort window.")
|
||||
DUMMY))
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
|
||||
"True if we don't want separate subdirectory lines -- subdirs then included in name")
|
||||
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
|
||||
(SHOWUNDELETED? FLAG) (* \;
|
||||
"True if counter window should show `Undeleted' rather than `Total' counts")
|
||||
(PATTERNPARSED? FLAG) (* \;
|
||||
"True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
|
||||
(SORTBYDATE FLAG) (* \;
|
||||
"True if SORTATTRIBUTE is one of the date attributes")
|
||||
(FBREADY FLAG) (* \; "False while FB is enumerating.")
|
||||
(ABORTING FLAG) (* \;
|
||||
"True if enumeration is being aborted")
|
||||
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
|
||||
(FBCOMPUTEDDEPTH BYTE) (* \;
|
||||
"Depth at the time we enumerated directory (zero for infinite)")
|
||||
(FBDISPLAYEDDEPTH BYTE) (* \;
|
||||
"Depth we are currently displaying (zero for infinite)")
|
||||
(TABLEBROWSER POINTER) (* \;
|
||||
"Pointer to TABLEBROWSER object controlling the browser")
|
||||
(BROWSERWINDOW POINTER) (* \; "Main window")
|
||||
(COUNTERWINDOW POINTER) (* \;
|
||||
"Window that counts files, pages, deletions")
|
||||
(HEADINGWINDOW POINTER) (* \;
|
||||
"Window with headings for browser columns")
|
||||
(INFOMENUW POINTER) (* \;
|
||||
"Window containing choices for info to be displayed, or NIL if none yet")
|
||||
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
|
||||
(INFODISPLAYED POINTER) (* \;
|
||||
"List of attribute specs to be displayed")
|
||||
(PATTERN POINTER) (* \;
|
||||
"Directory pattern being enumerated")
|
||||
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
|
||||
(SEEWINDOW POINTER) (* \;
|
||||
"Primary window used by FAST SEE command")
|
||||
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
|
||||
(SORTBY POINTER) (* \;
|
||||
"Sorting function or NIL for default sort")
|
||||
(NAMESTART WORD) (* \;
|
||||
"Index of first character in file name beyond the common prefix shared by all")
|
||||
(DIRECTORYSTART WORD) (* \;
|
||||
"Index of first character of directory in file names")
|
||||
(INFOSTART WORD) (* \;
|
||||
"X position in browser where first col of info is displayed")
|
||||
(NAMEOVERHEAD WORD) (* \;
|
||||
"This plus width of name gives is how much to allow before INFOSTART")
|
||||
(OVERFLOWSPACING WORD) (* \;
|
||||
"Increment between sizes considered for INFOSTART")
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD) (* \;
|
||||
"Total number of files, deleted files, pages, deleted pages at the moment")
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER) (* \;
|
||||
"True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
|
||||
(COUNTERPOSITIONS POINTER) (* \;
|
||||
"List of pairs (left right) describing regions where the values of the counters are displayed")
|
||||
(COUNTERPAGESTRING POINTER) (* \;
|
||||
"String to print after file/page count")
|
||||
(OVERFLOWWIDTHS POINTER) (* \;
|
||||
"List of (xpos occurrences) describing files whose names exceed default INFOSTART")
|
||||
(INFOMENUCHOICES POINTER) (* \;
|
||||
"Selections user has made in Info window, not necessarily the info currently displayed")
|
||||
(UPDATEPROC POINTER) (* \;
|
||||
"Process doing an Update (Recompute)")
|
||||
(DEFAULTDIR POINTER) (* \;
|
||||
"Default directory for destination of Copy/Rename")
|
||||
(SORTATTRIBUTE POINTER) (* \;
|
||||
"Attribute being sorted on, or NIL if by name")
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER) (* \;
|
||||
"Lock acquired by filebrowser operations")
|
||||
(SORTINDEX WORD) (* \;
|
||||
"Index (zero-based) in file info of the sort attribute")
|
||||
(SIZEINDEX WORD) (* \; "Index of size attribute")
|
||||
(FBDEPTH POINTER) (* \;
|
||||
"Enumeration depth, or NIL for default")
|
||||
(ABORTWINDOW POINTER) (* \;
|
||||
"Dotted pair of (abortwindow . menuw) for this browser's abort window.")
|
||||
DUMMY))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'FBFILEDATA
|
||||
@@ -4065,25 +4059,24 @@ then click Recompute"))))
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS NULL.VERSIONP MACRO ((V)
|
||||
(EQ V 0)))
|
||||
(EQ V 0)))
|
||||
|
||||
(PUTPROPS NULL.DIRECTORYP MACRO ((FILEDATA)
|
||||
(EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA)
|
||||
0)))
|
||||
(EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA)
|
||||
0)))
|
||||
|
||||
(PUTPROPS EQ.DIRECTORYP MACRO (OPENLAMBDA (FD1 FD2)
|
||||
(STRING-EQUAL (|fetch| (FBFILEDATA FILENAME) |of|
|
||||
FD1)
|
||||
(|fetch| (FBFILEDATA FILENAME) |of| FD2)
|
||||
:END1
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD1)
|
||||
:END2
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD2))))
|
||||
(STRING-EQUAL (|fetch| (FBFILEDATA FILENAME) |of| FD1)
|
||||
(|fetch| (FBFILEDATA FILENAME) |of| FD2)
|
||||
:END1
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD1)
|
||||
:END2
|
||||
(|fetch| (FBFILEDATA SUBDIREND) |of| FD2))))
|
||||
|
||||
(PUTPROPS NULL.FIELDP MACRO (OPENLAMBDA (STR)
|
||||
(OR (NULL STR)
|
||||
(EQ (NCHARS STR)
|
||||
0))))
|
||||
(OR (NULL STR)
|
||||
(EQ (NCHARS STR)
|
||||
0))))
|
||||
)
|
||||
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -4176,67 +4169,67 @@ then click Recompute"))))
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG)
|
||||
(NSPATTERN? FLAG)
|
||||
(SHOWUNDELETED? FLAG)
|
||||
(PATTERNPARSED? FLAG)
|
||||
(SORTBYDATE FLAG)
|
||||
(FBREADY FLAG)
|
||||
(ABORTING FLAG)
|
||||
(FIXEDTITLE FLAG)
|
||||
(FBCOMPUTEDDEPTH BYTE)
|
||||
(FBDISPLAYEDDEPTH BYTE)
|
||||
(TABLEBROWSER POINTER)
|
||||
(BROWSERWINDOW POINTER)
|
||||
(COUNTERWINDOW POINTER)
|
||||
(HEADINGWINDOW POINTER)
|
||||
(INFOMENUW POINTER)
|
||||
(PROMPTWINDOW POINTER)
|
||||
(INFODISPLAYED POINTER)
|
||||
(PATTERN POINTER)
|
||||
(PREPAREDPATTERN POINTER)
|
||||
(SEEWINDOW POINTER)
|
||||
(BROWSERFONT POINTER)
|
||||
(SORTBY POINTER)
|
||||
(NAMESTART WORD)
|
||||
(DIRECTORYSTART WORD)
|
||||
(INFOSTART WORD)
|
||||
(NAMEOVERHEAD WORD)
|
||||
(OVERFLOWSPACING WORD)
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD)
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER)
|
||||
(COUNTERPOSITIONS POINTER)
|
||||
(COUNTERPAGESTRING POINTER)
|
||||
(OVERFLOWWIDTHS POINTER)
|
||||
(INFOMENUCHOICES POINTER)
|
||||
(UPDATEPROC POINTER)
|
||||
(DEFAULTDIR POINTER)
|
||||
(SORTATTRIBUTE POINTER)
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER)
|
||||
(SORTINDEX WORD)
|
||||
(SIZEINDEX WORD)
|
||||
(FBDEPTH POINTER)
|
||||
(ABORTWINDOW POINTER)
|
||||
DUMMY))
|
||||
(NSPATTERN? FLAG)
|
||||
(SHOWUNDELETED? FLAG)
|
||||
(PATTERNPARSED? FLAG)
|
||||
(SORTBYDATE FLAG)
|
||||
(FBREADY FLAG)
|
||||
(ABORTING FLAG)
|
||||
(FIXEDTITLE FLAG)
|
||||
(FBCOMPUTEDDEPTH BYTE)
|
||||
(FBDISPLAYEDDEPTH BYTE)
|
||||
(TABLEBROWSER POINTER)
|
||||
(BROWSERWINDOW POINTER)
|
||||
(COUNTERWINDOW POINTER)
|
||||
(HEADINGWINDOW POINTER)
|
||||
(INFOMENUW POINTER)
|
||||
(PROMPTWINDOW POINTER)
|
||||
(INFODISPLAYED POINTER)
|
||||
(PATTERN POINTER)
|
||||
(PREPAREDPATTERN POINTER)
|
||||
(SEEWINDOW POINTER)
|
||||
(BROWSERFONT POINTER)
|
||||
(SORTBY POINTER)
|
||||
(NAMESTART WORD)
|
||||
(DIRECTORYSTART WORD)
|
||||
(INFOSTART WORD)
|
||||
(NAMEOVERHEAD WORD)
|
||||
(OVERFLOWSPACING WORD)
|
||||
(DIGITWIDTH WORD)
|
||||
(TOTALFILES WORD)
|
||||
(DELETEDFILES WORD)
|
||||
(TOTALPAGES POINTER)
|
||||
(DELETEDPAGES POINTER)
|
||||
(PAGECOUNT? POINTER)
|
||||
(COUNTERPOSITIONS POINTER)
|
||||
(COUNTERPAGESTRING POINTER)
|
||||
(OVERFLOWWIDTHS POINTER)
|
||||
(INFOMENUCHOICES POINTER)
|
||||
(UPDATEPROC POINTER)
|
||||
(DEFAULTDIR POINTER)
|
||||
(SORTATTRIBUTE POINTER)
|
||||
(SORTMENU POINTER)
|
||||
(FBLOCK POINTER)
|
||||
(SORTINDEX WORD)
|
||||
(SIZEINDEX WORD)
|
||||
(FBDEPTH POINTER)
|
||||
(ABORTWINDOW POINTER)
|
||||
DUMMY))
|
||||
|
||||
(DATATYPE FBFILEDATA ((FILENAME POINTER)
|
||||
(FILEINFO POINTER)
|
||||
(VERSIONLESSNAME POINTER)
|
||||
(DIRECTORYP FLAG)
|
||||
(HASDIRPREFIX FLAG)
|
||||
(DIRECTORYFILEP FLAG)
|
||||
(SIZE POINTER)
|
||||
(FILEDEPTH BYTE)
|
||||
(SORTVALUE POINTER)
|
||||
(SUBDIREND WORD)
|
||||
(STARTOFPNAME WORD)
|
||||
(VERSION WORD)
|
||||
(STARTOFNAME WORD)
|
||||
DUMMY))
|
||||
(FILEINFO POINTER)
|
||||
(VERSIONLESSNAME POINTER)
|
||||
(DIRECTORYP FLAG)
|
||||
(HASDIRPREFIX FLAG)
|
||||
(DIRECTORYFILEP FLAG)
|
||||
(SIZE POINTER)
|
||||
(FILEDEPTH BYTE)
|
||||
(SORTVALUE POINTER)
|
||||
(SUBDIREND WORD)
|
||||
(STARTOFPNAME WORD)
|
||||
(VERSION WORD)
|
||||
(STARTOFNAME WORD)
|
||||
DUMMY))
|
||||
)
|
||||
(DECLARE\: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
@@ -4244,10 +4237,10 @@ then click Recompute"))))
|
||||
|
||||
|
||||
(ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
|
||||
(HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
|
||||
(HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
|
||||
|
||||
(ADDTOVAR |BackgroundMenuCommands| ("FileBrowser" '(FILEBROWSER)
|
||||
"Opens a filebrowser window; prompts for pattern"))
|
||||
"Opens a filebrowser window; prompts for pattern"))
|
||||
|
||||
|
||||
(RPAQQ |BackgroundMenu| NIL)
|
||||
@@ -4263,51 +4256,51 @@ 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 (32602 55483 (FB 32612 . 33747) (FB.COPYBINARYCOMMAND 33749 . 34095) (FB.COPYTEXTCOMMAND
|
||||
34097 . 34439) (FILEBROWSER 34441 . 47547) (FB.TABLEBROWSER 47549 . 47766) (FB.SELECTEDFILES 47768 .
|
||||
48405) (FB.FETCHFILENAME 48407 . 48799) (FB.DIRECTORYP 48801 . 49195) (FB.PROMPTWPRINT 49197 . 50243)
|
||||
(FB.PROMPTW.FORMAT 50245 . 50982) (FB.PROMPTFORINPUT 50984 . 53236) (FB.YES-OR-NO-P 53238 . 54272) (
|
||||
FB.ALLOW.ABORT 54274 . 55128) (\\FB.HARDCOPY.TOFILE.EXTENSION 55130 . 55481)) (55507 56460 (FB.STARTUP
|
||||
55517 . 56032) (FB.MAKERIGIDWINDOW 56034 . 56458)) (56461 61833 (FB.PRINTFN 56471 . 61624) (FB.COPYFN
|
||||
61626 . 61831)) (61883 68223 (FB.MENU.WHENSELECTEDFN 61893 . 62251) (FB.COMMANDSELECTEDFN 62253 .
|
||||
63792) (FB.SUBITEMP 63794 . 64395) (FB.MAKE.BROWSER.BUSY 64397 . 65201) (FB.FINISH.COMMAND 65203 .
|
||||
67234) (FB.HANDLE.ABORT.BUTTON 67236 . 68221)) (68224 73740 (FB.DELETECOMMAND 68234 . 68515) (
|
||||
FB.DELVERCOMMAND 68517 . 71710) (FB.IS.NOT.SUBDIRECTORY.ITEM 71712 . 71893) (FB.DELVER.FILES 71895 .
|
||||
72984) (FB.DELETE.FILE 72986 . 73738)) (73741 75066 (FB.UNDELETECOMMAND 73751 . 74036) (
|
||||
FB.UNDELETEALLCOMMAND 74038 . 74317) (FB.UNDELETE.FILE 74319 . 75064)) (75067 99248 (FB.COPYCOMMAND
|
||||
75077 . 75346) (FB.RENAMECOMMAND 75348 . 75623) (FB.COPY/RENAME.COMMAND 75625 . 76548) (
|
||||
FB.COPY/RENAME.ONE 76550 . 78872) (FB.COPY/RENAME.MANY 78874 . 85094) (FB.MERGE.DIRECTORIES 85096 .
|
||||
85514) (FB.GREATEST.PREFIX 85516 . 86872) (FB.MAYBE.INSERT.FILE 86874 . 94314) (FB.GET.NEW.FILE.SPEC
|
||||
94316 . 98147) (FB.CANONICAL.DIRECTORY 98149 . 99246)) (99249 107033 (FB.HARDCOPYCOMMAND 99259 .
|
||||
100389) (FB.HARDCOPY.TOFILE 100391 . 107031)) (107034 117233 (FB.EDITCOMMAND 107044 . 107911) (
|
||||
FB.EDITCOMMAND.ONEFILE 107913 . 111317) (FB.EDITLISPFILE 111319 . 112424) (FB.BROWSECOMMAND 112426 .
|
||||
117231)) (117234 129155 (FB.FASTSEECOMMAND 117244 . 120694) (FB.FASTSEE.ONEFILE 120696 . 123853) (
|
||||
FB.SEEFULLFN 123855 . 127986) (FB.SEEBUTTONFN 127988 . 129153)) (129156 130902 (FB.LOADCOMMAND 129166
|
||||
. 129673) (FB.COMPILECOMMAND 129675 . 130213) (FB.OPERATE.ON.FILES 130215 . 130900)) (130903 179088 (
|
||||
FB.UPDATECOMMAND 130913 . 131138) (FB.FIX-DIRECTORY-DATES 131140 . 132163) (FB.MAYBE.EXPUNGE 132165 .
|
||||
133226) (FB.UPDATEBROWSERITEMS 133228 . 146443) (FB.DATE 146445 . 147086) (FB.ADJUST.DATE.WIDTH 147088
|
||||
. 150056) (FB.SET.BROWSER.TITLE 150058 . 151060) (FB.MAYBE.WIDEN.NAMES 151062 . 153181) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 153183 . 154547) (FB.CREATE.FILEBUCKET 154549 . 161769) (
|
||||
FB.CHECK.NAME.LENGTH 161771 . 164192) (FB.ADD.FILEGROUP 164194 . 165721) (FB.INSERT.DIRECTORY 165723
|
||||
. 165961) (FB.MAKE.SUBDIRECTORY.ITEM 165963 . 167372) (FB.ADD.FILE 167374 . 167987) (FB.INSERT.FILE
|
||||
167989 . 171401) (FB.ANALYZE.PATTERN 171403 . 176667) (FB.CANONICALIZE.PATTERN 176669 . 177981) (
|
||||
FB.GETALLFILEINFO 177983 . 179086)) (179089 187248 (FB.SORT.VERSIONS 179099 . 181870) (
|
||||
FB.DECREASING.VERSION 181872 . 182541) (FB.INCREASING.VERSION 182543 . 183164) (
|
||||
FB.NAMES.DECREASING.VERSION 183166 . 184201) (FB.NAMES.INCREASING.VERSION 184203 . 185200) (
|
||||
FB.DECREASING.NUMERIC.ATTR 185202 . 185882) (FB.INCREASING.NUMERIC.ATTR 185884 . 186558) (
|
||||
FB.ALPHABETIC.ATTR 186560 . 187246)) (187249 197091 (FB.SORTCOMMAND 187259 . 194089) (
|
||||
FB.INSERT.SUBDIRECTORIES 194091 . 194888) (FB.GET.SORT.MENU 194890 . 197089)) (197092 213313 (
|
||||
FB.EXPUNGECOMMAND 197102 . 199687) (FB.NEWPATTERNCOMMAND 199689 . 200087) (FB.NEWINFOCOMMAND 200089 .
|
||||
202921) (FB.DEPTHCOMMAND 202923 . 204698) (FB.SHAPECOMMAND 204700 . 208042) (FB.REMOVE.FILE 208044 .
|
||||
209865) (FB.COUNT.FILE.CHANGE 209867 . 211312) (FB.SETNEWPATTERN 211314 . 212484) (FB.GET.NEWPATTERN
|
||||
212486 . 213070) (FB.OPTIONSCOMMAND 213072 . 213311)) (213348 214401 (FB.GETWINDOW 213358 . 214399)) (
|
||||
214402 215414 (FB.INFOMENU.SHADEINITIALSELECTIONS 214412 . 215059) (FB.INFO.ITEM.NAMED 215061 . 215412
|
||||
)) (215415 224947 (FB.MAKECOUNTERWINDOW 215425 . 216953) (FB.COUNTERW.REDISPLAYFN 216955 . 217542) (
|
||||
FB.UPDATE.COUNTERS 217544 . 219616) (FB.DISPLAY.COUNTERS 219618 . 224678) (FB.COUNTER.STRING 224680 .
|
||||
224945)) (224948 229657 (FB.MAKEHEADINGWINDOW 224958 . 226572) (FB.HEADINGW.REDISPLAYFN 226574 .
|
||||
226840) (FB.HEADINGW.RESHAPEFN 226842 . 227218) (FB.HEADINGW.DISPLAY 227220 . 229655)) (229658 233841
|
||||
(FB.ICONFN 229668 . 230015) (FB.INFOMENU.WHENSELECTEDFN 230017 . 230747) (FB.CLOSEFN 230749 . 231952)
|
||||
(FB.EXPUNGE?.MENU 231954 . 232366) (FB.AFTERCLOSEFN 232368 . 232729) (FB.CLOSE&EXPUNGE 232731 . 233839
|
||||
)) (233842 245900 (FB.HARDCOPY.DIRECTORY 233852 . 244209) (FB.HARDCOPY.PRINT.TITLE 244211 . 244537) (
|
||||
FB.HARDCOPY.MAXWIDTH 244539 . 245898)))))
|
||||
(FILEMAP (NIL (32375 55256 (FB 32385 . 33520) (FB.COPYBINARYCOMMAND 33522 . 33868) (FB.COPYTEXTCOMMAND
|
||||
33870 . 34212) (FILEBROWSER 34214 . 47320) (FB.TABLEBROWSER 47322 . 47539) (FB.SELECTEDFILES 47541 .
|
||||
48178) (FB.FETCHFILENAME 48180 . 48572) (FB.DIRECTORYP 48574 . 48968) (FB.PROMPTWPRINT 48970 . 50016)
|
||||
(FB.PROMPTW.FORMAT 50018 . 50755) (FB.PROMPTFORINPUT 50757 . 53009) (FB.YES-OR-NO-P 53011 . 54045) (
|
||||
FB.ALLOW.ABORT 54047 . 54901) (\\FB.HARDCOPY.TOFILE.EXTENSION 54903 . 55254)) (55280 56233 (FB.STARTUP
|
||||
55290 . 55805) (FB.MAKERIGIDWINDOW 55807 . 56231)) (56234 61606 (FB.PRINTFN 56244 . 61397) (FB.COPYFN
|
||||
61399 . 61604)) (61656 67996 (FB.MENU.WHENSELECTEDFN 61666 . 62024) (FB.COMMANDSELECTEDFN 62026 .
|
||||
63565) (FB.SUBITEMP 63567 . 64168) (FB.MAKE.BROWSER.BUSY 64170 . 64974) (FB.FINISH.COMMAND 64976 .
|
||||
67007) (FB.HANDLE.ABORT.BUTTON 67009 . 67994)) (67997 73513 (FB.DELETECOMMAND 68007 . 68288) (
|
||||
FB.DELVERCOMMAND 68290 . 71483) (FB.IS.NOT.SUBDIRECTORY.ITEM 71485 . 71666) (FB.DELVER.FILES 71668 .
|
||||
72757) (FB.DELETE.FILE 72759 . 73511)) (73514 74839 (FB.UNDELETECOMMAND 73524 . 73809) (
|
||||
FB.UNDELETEALLCOMMAND 73811 . 74090) (FB.UNDELETE.FILE 74092 . 74837)) (74840 99021 (FB.COPYCOMMAND
|
||||
74850 . 75119) (FB.RENAMECOMMAND 75121 . 75396) (FB.COPY/RENAME.COMMAND 75398 . 76321) (
|
||||
FB.COPY/RENAME.ONE 76323 . 78645) (FB.COPY/RENAME.MANY 78647 . 84867) (FB.MERGE.DIRECTORIES 84869 .
|
||||
85287) (FB.GREATEST.PREFIX 85289 . 86645) (FB.MAYBE.INSERT.FILE 86647 . 94087) (FB.GET.NEW.FILE.SPEC
|
||||
94089 . 97920) (FB.CANONICAL.DIRECTORY 97922 . 99019)) (99022 106806 (FB.HARDCOPYCOMMAND 99032 .
|
||||
100162) (FB.HARDCOPY.TOFILE 100164 . 106804)) (106807 117006 (FB.EDITCOMMAND 106817 . 107684) (
|
||||
FB.EDITCOMMAND.ONEFILE 107686 . 111090) (FB.EDITLISPFILE 111092 . 112197) (FB.BROWSECOMMAND 112199 .
|
||||
117004)) (117007 128928 (FB.FASTSEECOMMAND 117017 . 120467) (FB.FASTSEE.ONEFILE 120469 . 123626) (
|
||||
FB.SEEFULLFN 123628 . 127759) (FB.SEEBUTTONFN 127761 . 128926)) (128929 130675 (FB.LOADCOMMAND 128939
|
||||
. 129446) (FB.COMPILECOMMAND 129448 . 129986) (FB.OPERATE.ON.FILES 129988 . 130673)) (130676 178861 (
|
||||
FB.UPDATECOMMAND 130686 . 130911) (FB.FIX-DIRECTORY-DATES 130913 . 131936) (FB.MAYBE.EXPUNGE 131938 .
|
||||
132999) (FB.UPDATEBROWSERITEMS 133001 . 146216) (FB.DATE 146218 . 146859) (FB.ADJUST.DATE.WIDTH 146861
|
||||
. 149829) (FB.SET.BROWSER.TITLE 149831 . 150833) (FB.MAYBE.WIDEN.NAMES 150835 . 152954) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 152956 . 154320) (FB.CREATE.FILEBUCKET 154322 . 161542) (
|
||||
FB.CHECK.NAME.LENGTH 161544 . 163965) (FB.ADD.FILEGROUP 163967 . 165494) (FB.INSERT.DIRECTORY 165496
|
||||
. 165734) (FB.MAKE.SUBDIRECTORY.ITEM 165736 . 167145) (FB.ADD.FILE 167147 . 167760) (FB.INSERT.FILE
|
||||
167762 . 171174) (FB.ANALYZE.PATTERN 171176 . 176440) (FB.CANONICALIZE.PATTERN 176442 . 177754) (
|
||||
FB.GETALLFILEINFO 177756 . 178859)) (178862 187021 (FB.SORT.VERSIONS 178872 . 181643) (
|
||||
FB.DECREASING.VERSION 181645 . 182314) (FB.INCREASING.VERSION 182316 . 182937) (
|
||||
FB.NAMES.DECREASING.VERSION 182939 . 183974) (FB.NAMES.INCREASING.VERSION 183976 . 184973) (
|
||||
FB.DECREASING.NUMERIC.ATTR 184975 . 185655) (FB.INCREASING.NUMERIC.ATTR 185657 . 186331) (
|
||||
FB.ALPHABETIC.ATTR 186333 . 187019)) (187022 196864 (FB.SORTCOMMAND 187032 . 193862) (
|
||||
FB.INSERT.SUBDIRECTORIES 193864 . 194661) (FB.GET.SORT.MENU 194663 . 196862)) (196865 213086 (
|
||||
FB.EXPUNGECOMMAND 196875 . 199460) (FB.NEWPATTERNCOMMAND 199462 . 199860) (FB.NEWINFOCOMMAND 199862 .
|
||||
202694) (FB.DEPTHCOMMAND 202696 . 204471) (FB.SHAPECOMMAND 204473 . 207815) (FB.REMOVE.FILE 207817 .
|
||||
209638) (FB.COUNT.FILE.CHANGE 209640 . 211085) (FB.SETNEWPATTERN 211087 . 212257) (FB.GET.NEWPATTERN
|
||||
212259 . 212843) (FB.OPTIONSCOMMAND 212845 . 213084)) (213121 214174 (FB.GETWINDOW 213131 . 214172)) (
|
||||
214175 215187 (FB.INFOMENU.SHADEINITIALSELECTIONS 214185 . 214832) (FB.INFO.ITEM.NAMED 214834 . 215185
|
||||
)) (215188 224720 (FB.MAKECOUNTERWINDOW 215198 . 216726) (FB.COUNTERW.REDISPLAYFN 216728 . 217315) (
|
||||
FB.UPDATE.COUNTERS 217317 . 219389) (FB.DISPLAY.COUNTERS 219391 . 224451) (FB.COUNTER.STRING 224453 .
|
||||
224718)) (224721 229430 (FB.MAKEHEADINGWINDOW 224731 . 226345) (FB.HEADINGW.REDISPLAYFN 226347 .
|
||||
226613) (FB.HEADINGW.RESHAPEFN 226615 . 226991) (FB.HEADINGW.DISPLAY 226993 . 229428)) (229431 233614
|
||||
(FB.ICONFN 229441 . 229788) (FB.INFOMENU.WHENSELECTEDFN 229790 . 230520) (FB.CLOSEFN 230522 . 231725)
|
||||
(FB.EXPUNGE?.MENU 231727 . 232139) (FB.AFTERCLOSEFN 232141 . 232502) (FB.CLOSE&EXPUNGE 232504 . 233612
|
||||
)) (233615 245673 (FB.HARDCOPY.DIRECTORY 233625 . 243982) (FB.HARDCOPY.PRINT.TITLE 243984 . 244310) (
|
||||
FB.HARDCOPY.MAXWIDTH 244312 . 245671)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 8-Oct-92 16:50:21" "{Pele:mv:envos}<LispCore>library>HRULE.;11" 23325
|
||||
|
||||
changes to%: (FNS VRULE.CREATE VRULE.GETFN2)
|
||||
(FILECREATED "25-Jul-2022 15:09:26" {DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;4 23801
|
||||
|
||||
previous date%: "29-Sep-92 21:06:13" "{Pele:mv:envos}<LispCore>library>HRULE.;10")
|
||||
:CHANGES-TO (VARS HRULECOMS)
|
||||
|
||||
:PREVIOUS-DATE "25-Jul-2022 15:07:00"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HRULECOMS)
|
||||
@@ -33,7 +35,10 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION HRULE.WHENOPERATEDONFN)
|
||||
(FUNCTION NILL]
|
||||
(FUNCTION (LAMBDA (OBJ)
|
||||
(CONCAT (CHARACTER (CHARCODE EOL))
|
||||
(ALLOCSTRING 20 "-")
|
||||
(CHARACTER (CHARCODE EOL]
|
||||
[COMS
|
||||
(* ;; "Vertical rules")
|
||||
|
||||
@@ -200,11 +205,11 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
|
||||
(RPAQ? HRULE.DEFAULT.WIDTH 2)
|
||||
|
||||
(RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN
|
||||
HRULE.COPYFN HRULE.WHENOPERATEDONFN))
|
||||
(RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN
|
||||
HRULE.WHENOPERATEDONFN))
|
||||
|
||||
(RPAQ HRULE.IMAGEFNS
|
||||
(IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN)
|
||||
[IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN)
|
||||
(FUNCTION HRULE.IMAGEBOXFN)
|
||||
(FUNCTION HRULE.PUTFN)
|
||||
(FUNCTION HRULE.GETFN)
|
||||
@@ -216,7 +221,10 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION HRULE.WHENOPERATEDONFN)
|
||||
(FUNCTION NILL)))
|
||||
(FUNCTION (LAMBDA (OBJ)
|
||||
(CONCAT (CHARACTER (CHARCODE EOL))
|
||||
(ALLOCSTRING 20 "-")
|
||||
(CHARACTER (CHARCODE EOL])
|
||||
|
||||
|
||||
|
||||
@@ -502,12 +510,12 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
|
||||
(FUNCTION NILL)))
|
||||
(PUTPROPS HRULE COPYRIGHT ("Venue & Xerox Corporation" 1985 1990 1991 1992))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4225 10404 (HRULE.CREATE 4235 . 5657) (HRULE.DISPLAYFN 5659 . 8228) (HRULE.GETFN 8230
|
||||
. 8550) (HRULE.IMAGEBOXFN 8552 . 9354) (HRULE.PUTFN 9356 . 9734) (HRULE.COPYFN 9736 . 10200) (
|
||||
HRULE.WHENOPERATEDONFN 10202 . 10402)) (11107 17312 (VRULE.CREATE 11117 . 13116) (VRULE.DISPLAYFN
|
||||
13118 . 15312) (VRULE.GETFN 15314 . 15535) (VRULE.GETFN2 15537 . 15873) (VRULE.IMAGEBOXFN 15875 .
|
||||
16303) (VRULE.PUTFN 16305 . 16703) (VRULE.COPYFN 16705 . 17108) (VRULE.WHENOPERATEDONFN 17110 . 17310)
|
||||
) (17951 22601 (CROPMARK.CREATE 17961 . 19228) (CROPMARK.DISPLAYFN 19230 . 20730) (CROPMARK.GETFN
|
||||
20732 . 21026) (CROPMARK.IMAGEBOXFN 21028 . 21729) (CROPMARK.PUTFN 21731 . 22009) (CROPMARK.COPYFN
|
||||
22011 . 22394) (CROPMARK.WHENOPERATEDONFN 22396 . 22599)))))
|
||||
(FILEMAP (NIL (4512 10691 (HRULE.CREATE 4522 . 5944) (HRULE.DISPLAYFN 5946 . 8515) (HRULE.GETFN 8517
|
||||
. 8837) (HRULE.IMAGEBOXFN 8839 . 9641) (HRULE.PUTFN 9643 . 10021) (HRULE.COPYFN 10023 . 10487) (
|
||||
HRULE.WHENOPERATEDONFN 10489 . 10689)) (11583 17788 (VRULE.CREATE 11593 . 13592) (VRULE.DISPLAYFN
|
||||
13594 . 15788) (VRULE.GETFN 15790 . 16011) (VRULE.GETFN2 16013 . 16349) (VRULE.IMAGEBOXFN 16351 .
|
||||
16779) (VRULE.PUTFN 16781 . 17179) (VRULE.COPYFN 17181 . 17584) (VRULE.WHENOPERATEDONFN 17586 . 17786)
|
||||
) (18427 23077 (CROPMARK.CREATE 18437 . 19704) (CROPMARK.DISPLAYFN 19706 . 21206) (CROPMARK.GETFN
|
||||
21208 . 21502) (CROPMARK.IMAGEBOXFN 21504 . 22205) (CROPMARK.PUTFN 22207 . 22485) (CROPMARK.COPYFN
|
||||
22487 . 22870) (CROPMARK.WHENOPERATEDONFN 22872 . 23075)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,22 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
|
||||
(FILECREATED " 2-Nov-2022 10:13:59" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;3| 23999
|
||||
|
||||
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
|
||||
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
|
||||
)
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
(VARS MSCOMMONCOMS)
|
||||
:CHANGES-TO (VARS MSCOMMONCOMS)
|
||||
(TEMPLATES CL:UNLESS CL:WHEN)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
|
||||
:PREVIOUS-DATE "15-Jan-2022 20:17:21" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
; Copyright (c) 1988, 1990, 1992, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MSCOMMONCOMS)
|
||||
|
||||
(RPAQQ MSCOMMONCOMS
|
||||
((PROP FILETYPE MSCOMMON)
|
||||
(DECLARE\: EVAL@COMPILE (GLOBALVARS USERTEMPLATES MSTEMPLATES))
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
|
||||
(* |;;| "Templates for CL stuff that need them.")
|
||||
@@ -89,6 +87,12 @@
|
||||
(CLRHASH USERTEMPLATES))))
|
||||
|
||||
(PUTPROPS MSCOMMON FILETYPE :COMPILE-FILE)
|
||||
(DECLARE\: EVAL@COMPILE
|
||||
(DECLARE\: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS USERTEMPLATES MSTEMPLATES)
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(FUNCTIONSMSGETDEF
|
||||
@@ -470,13 +474,13 @@
|
||||
|
||||
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
|
||||
:GENSYM :ARRAY))
|
||||
@@ -552,8 +556,8 @@
|
||||
(PUTHASH KEY VAL MSTEMPLATES)))
|
||||
|
||||
(CLRHASH USERTEMPLATES)
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992 2022))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
|
||||
VARIABLESMSGETDEF 6733 . 7289)))))
|
||||
(FILEMAP (NIL (5219 7230 (FUNCTIONSMSGETDEF 5229 . 6197) (FUNCTIONSMSMC 6199 . 6670) (
|
||||
VARIABLESMSGETDEF 6672 . 7228)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Apr-2022 09:23:16" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SAMEDIR.;3 5583
|
||||
(FILECREATED "31-Oct-2022 13:09:14" {WMEDLEY}<library>SAMEDIR.;4 6221
|
||||
|
||||
:CHANGES-TO (FNS HOST&DIRECTORYFIELD CHECKSAMEDIR)
|
||||
:CHANGES-TO (FNS CHECKSAMEDIR HOST&DIRECTORYFIELD)
|
||||
|
||||
:PREVIOUS-DATE " 1-Sep-2020 11:40:26"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SAMEDIR.;1)
|
||||
:PREVIOUS-DATE "25-Apr-2022 09:23:16" {WMEDLEY}<library>SAMEDIR.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -25,7 +24,8 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(CHECKSAMEDIR
|
||||
[LAMBDA (FILE) (* ; "Edited 25-Apr-2022 09:16 by rmk")
|
||||
[LAMBDA (FILE) (* ; "Edited 31-Oct-2022 13:08 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 09:16 by rmk")
|
||||
(* ; "Edited 1-Sep-2020 11:40 by rmk:")
|
||||
|
||||
(* ;; "Check (a) that we are writing FILE to the same directory we last read/wrote it and (b) that a version newer than the current one has not since appeared.")
|
||||
@@ -44,11 +44,19 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
|
||||
(RETURN)) (* ;
|
||||
"RMK: Use HOST&DIRECTORYFIELD to canonicalize both file and connected directory")
|
||||
[SETQ OKHOST/DIRS (CONS (SETQ HOST/DIR (HOST&DIRECTORYFIELD (DIRECTORYNAME T)))
|
||||
(MKLIST (CDR (ASSOC HOST/DIR MIGRATIONS :TEST 'STRING-EQUAL]
|
||||
(MKLIST (CDR (OR (ASSOC HOST/DIR MIGRATIONS :TEST 'STRING-EQUAL)
|
||||
(ASSOC (TRUEFILENAME HOST/DIR)
|
||||
MIGRATIONS :TEST 'STRING-EQUAL)
|
||||
(ASSOC (PSEUDOFILENAME HOST/DIR)
|
||||
MIGRATIONS :TEST 'STRING-EQUAL]
|
||||
(COND
|
||||
((for OLDFILE in DATES bind HOST DIR never (CL:MEMBER (HOST&DIRECTORYFIELD (CDR OLDFILE)
|
||||
)
|
||||
OKHOST/DIRS :TEST 'STRING-EQUAL))
|
||||
([for OLDFILE in DATES bind HOST DIR
|
||||
never (OR (CL:MEMBER (HOST&DIRECTORYFIELD (CDR OLDFILE))
|
||||
OKHOST/DIRS :TEST 'STRING-EQUAL)
|
||||
(CL:MEMBER (TRUEFILENAME (HOST&DIRECTORYFIELD (CDR OLDFILE)))
|
||||
OKHOST/DIRS :TEST 'STRING-EQUAL)
|
||||
(CL:MEMBER (PSEUDOFILENAME (HOST&DIRECTORYFIELD (CDR OLDFILE)))
|
||||
OKHOST/DIRS :TEST 'STRING-EQUAL]
|
||||
|
||||
(* ;; "The file is going somewhere it has never been before. ")
|
||||
|
||||
@@ -90,11 +98,9 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
|
||||
(SHOULDNT])
|
||||
|
||||
(HOST&DIRECTORYFIELD
|
||||
[LAMBDA (FILENAME) (* ; "Edited 25-Apr-2022 09:22 by rmk")
|
||||
[LAMBDA (FILENAME) (* ; "Edited 31-Oct-2022 13:03 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 09:22 by rmk")
|
||||
(* ; "Edited 15-Apr-2018 19:05 by rmk:")
|
||||
|
||||
(* ;; "Returns the host&dir fields packed together. HOST and device are upper cased")
|
||||
|
||||
(PACKFILENAME.STRING 'DEVICE (U-CASE (FILENAMEFIELD.STRING FILENAME 'DEVICE))
|
||||
'HOST
|
||||
(U-CASE (FILENAMEFIELD.STRING FILENAME 'HOST))
|
||||
@@ -116,5 +122,5 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS SAMEDIR COPYRIGHT ("Venue & Xerox Corporation" 1982 1984 1985 1986 1987 1990 2018 2020))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (802 5200 (CHECKSAMEDIR 812 . 4623) (HOST&DIRECTORYFIELD 4625 . 5198)))))
|
||||
(FILEMAP (NIL (731 5838 (CHECKSAMEDIR 741 . 5249) (HOST&DIRECTORYFIELD 5251 . 5836)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
313
library/SKETCH
313
library/SKETCH
@@ -1,11 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 1-Feb-2022 09:17:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;2 490756
|
||||
(FILECREATED " 4-Aug-2022 09:58:03" {DSK}<home>larry>medley>library>SKETCH.;2 491064
|
||||
|
||||
:CHANGES-TO (FNS SKETCH.PUT)
|
||||
:CHANGES-TO (FNS SKETCH.COMMANDMENU.ITEMS)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-93 11:59:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;1)
|
||||
:PREVIOUS-DATE " 1-Feb-2022 09:17:12" {DSK}<home>larry>medley>library>SKETCH.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -1358,10 +1357,9 @@ This will be slow for arcs and curves."]
|
||||
TITLE _ TITLE])
|
||||
|
||||
(SKETCH.COMMANDMENU.ITEMS
|
||||
[LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11")
|
||||
|
||||
(* returns a list of the items that are in the sketch command menu.)
|
||||
|
||||
[LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11")
|
||||
(* returns a list of the items that
|
||||
are in the sketch command menu.)
|
||||
(APPEND '[(Delete SK.DELETE.ELT "Deletes one or more elements from the sketch."
|
||||
(SUBITEMS ("Delete element(s)" SK.DELETE.ELT
|
||||
"Deletes one or more elements from the sketch.")
|
||||
@@ -1388,15 +1386,18 @@ This will be slow for arcs and curves."]
|
||||
(Combined SK.SET.MOVE.MODE.COMBINED
|
||||
"MOVE command will move points if a single point is clicked; elements otherwise"
|
||||
]
|
||||
'[(Copy SK.COPY.ELT "Copies a piece of the sketch." (SUBITEMS ("Copy elements" SK.COPY.ELT
|
||||
'[(Copy SK.COPY.ELT "Copies a piece of the sketch." (SUBITEMS ("Copy elements" SK.COPY.ELT
|
||||
|
||||
"copies one or more elements of the sketch."
|
||||
)
|
||||
("Copy w/2 pt trans"
|
||||
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
|
||||
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
|
||||
|
||||
"Copies one or more sketch elements with a two point transformation."
|
||||
)
|
||||
("Copy w/3 pt trans"
|
||||
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
|
||||
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
|
||||
|
||||
"Copies one or more sketch elements with a three point transformation."
|
||||
]
|
||||
'[(Align SK.ALIGN.POINTS.LEFT "Aligns a collection of points with the leftmost one."
|
||||
@@ -8763,149 +8764,149 @@ Otherwise, type '^'.")
|
||||
)
|
||||
(PUTPROPS SKETCH COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22155 85518 (SKETCH 22165 . 24270) (SKETCH.FROM.A.FILE 24272 . 24587) (SKETCHW.CREATE
|
||||
24589 . 29163) (SKETCH.RESET 29165 . 30687) (SKETCHW.FIG.CHANGED 30689 . 31029) (SK.WINDOW.TITLE 31031
|
||||
. 31418) (EDITSLIDE 31420 . 31826) (EDITSKETCH 31828 . 32152) (SK.PUT.ON.FILE 32154 . 33606) (
|
||||
SK.OUTPUT.FILE.NAME 33608 . 33982) (SKETCH.PUT 33984 . 36882) (SK.GET.FROM.FILE 36884 . 37777) (
|
||||
SK.INCLUDE.FILE 37779 . 40287) (SK.GET.IMAGEOBJ.FROM.FILE 40289 . 42492) (SKETCH.GET 42494 . 42801) (
|
||||
ADD.SKETCH.TO.VIEWER 42803 . 45389) (FILENAMELESSVERSION 45391 . 45667) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45669 . 46183) (SKETCH.SET.A.DEFAULT 46185 . 53343) (SK.POPUP.SELECTIONFN 53345 . 53887) (
|
||||
GETSKETCHWREGION 53889 . 54095) (SK.ADD.ELEMENT 54097 . 55676) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55678 . 57072) (SK.ELTS.BY.PRIORITY 57074 . 57370) (SK.ORDER.ELEMENTS 57372 . 57639) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57641 . 59135) (SK.ADD.ELEMENTS 59137 . 59661) (
|
||||
SK.CHECK.WHENADDEDFN 59663 . 60393) (SK.APPLY.MENU.COMMAND 60395 . 61193) (SK.DELETE.ELEMENT1 61195 .
|
||||
62773) (SK.MARK.DIRTY 62775 . 63441) (SK.MARK.UNDIRTY 63443 . 63774) (SK.MENU.AND.RETURN.FIELD 63776
|
||||
. 64441) (SKETCH.SET.BRUSH.SHAPE 64443 . 65028) (SKETCH.SET.BRUSH.SIZE 65030 . 65536) (
|
||||
SKETCHW.CLOSEFN 65538 . 67329) (SK.CONFIRM.DESTRUCTION 67331 . 68330) (SKETCHW.OUTFN 68332 . 68596) (
|
||||
SKETCHW.REOPENFN 68598 . 69010) (MAKE.LOCAL.SKETCH 69012 . 69742) (MAP.SKETCHSPEC.INTO.VIEWER 69744 .
|
||||
70954) (SKETCHW.REPAINTFN 70956 . 71784) (SKETCHW.REPAINTFN1 71786 . 72725) (SK.DRAWFIGURE.IF 72727 .
|
||||
73249) (SKETCHW.SCROLLFN 73251 . 77444) (SKETCHW.RESHAPEFN 77446 . 79704) (SK.UPDATE.EVENT.SELECTION
|
||||
79706 . 81761) (LIGHTGRAYWINDOW 81763 . 81926) (SK.ADD.SPACES 81928 . 82674) (SK.SKETCH.MENU 82676 .
|
||||
82998) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83000 . 83852) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83854 . 84814)
|
||||
(SK.RETURN.TTY 84816 . 85184) (SK.TAKE.TTY 85186 . 85516)) (85572 108565 (SKETCH.COMMANDMENU 85582 .
|
||||
85919) (SKETCH.COMMANDMENU.ITEMS 85921 . 105669) (CREATE.SKETCHW.COMMANDMENU 105671 . 106091) (
|
||||
SKETCHW.SELECTIONFN 106093 . 107196) (SKETCH.MONITORLOCK 107198 . 107669) (SK.EVAL.AS.PROCESS 107671
|
||||
. 108284) (SK.EVAL.WITH.LOCK 108286 . 108563)) (108566 116370 (SK.FIX.MENU 108576 . 109670) (
|
||||
SK.SET.UP.MENUS 109672 . 111973) (SK.INSURE.HAS.MENU 111975 . 112637) (SK.CREATE.STANDARD.MENU 112639
|
||||
. 113084) (SK.ADD.ITEM.TO.MENU 113086 . 113761) (SK.GET.VIEWER.POPUP.MENU 113763 . 115964) (
|
||||
SK.CLEAR.POPUP.MENU 115966 . 116368)) (116426 125248 (SKETCH.CREATE 116436 . 117222) (GETSKETCHPROP
|
||||
117224 . 120281) (PUTSKETCHPROP 120283 . 124215) (CREATE.DEFAULT.SKETCH.CONTEXT 124217 . 125246)) (
|
||||
125414 148310 (SK.COPY.BUTTONEVENTFN 125424 . 136652) (SK.BUTTONEVENT.MARK 136654 . 137037) (
|
||||
SK.BUILD.IMAGEOBJ 137039 . 146954) (SK.BUTTONEVENT.OVERP 146956 . 147579) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147581 . 148308)) (148589 174404 (SK.SEL.AND.CHANGE 148599 . 148891) (SK.CHECK.WHENCHANGEDFN 148893 .
|
||||
149599) (SK.CHECK.PRECHANGEFN 149601 . 150202) (SK.CHANGE.ELT 150204 . 150396) (SK.CHANGE.THING 150398
|
||||
. 151649) (SKETCH.CHANGE.ELEMENTS 151651 . 152834) (SK.APPLY.SINGLE.CHANGEFN 152836 . 153409) (
|
||||
SK.DO.CHANGESPECS 153411 . 155070) (SK.VIEWER.FROM.SKETCH.ARG 155072 . 155514) (SK.DO.CHANGESPEC1
|
||||
155516 . 157391) (SK.CHANGEFN 157393 . 157973) (SK.READCHANGEFN 157975 . 158434) (SK.DEFAULT.CHANGEFN
|
||||
158436 . 160908) (CHANGEABLEFIELDITEMS 160910 . 161557) (SK.APPLY.CHANGE.COMMAND 161559 . 162176) (
|
||||
SK.DO.AND.RECORD.CHANGES 162178 . 163575) (SK.APPLY.CHANGE.COMMAND1 163577 . 165065) (
|
||||
SK.ELEMENTS.CHANGEFN 165067 . 167391) (READ.POINT.TO.ADD 167393 . 168337) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168339 . 168799) (SK.ADD.KNOT.TO.ELEMENT 168801 . 169745) (SK.GROUP.CHANGEFN 169747 . 170959) (
|
||||
SK.GROUP.CHANGEFN1 170961 . 174402)) (174571 188304 (ADD.ELEMENT.TO.SKETCH 174581 . 176287) (
|
||||
ADD.SKETCH.VIEWER 176289 . 176957) (REMOVE.SKETCH.VIEWER 176959 . 177572) (ALL.SKETCH.VIEWERS 177574
|
||||
. 177814) (SKETCH.ALL.VIEWERS 177816 . 178076) (VIEWER.BUCKET 178078 . 178229) (ELT.INSIDE.REGION?
|
||||
178231 . 178558) (ELT.INSIDE.SKWP 178560 . 178851) (SCALE.FROM.SKW 178853 . 179103) (
|
||||
SK.ADDELT.TO.WINDOW 179105 . 179965) (SK.CALC.REGION.VIEWED 179967 . 180345) (SK.DRAWFIGURE 180347 .
|
||||
181636) (SK.DRAWFIGURE1 181638 . 182022) (SK.LOCAL.FROM.GLOBAL 182024 . 183259) (SKETCH.REGION.VIEWED
|
||||
183261 . 185948) (SKETCH.VIEW.FROM.NAME 185950 . 186380) (SK.UPDATE.REGION.VIEWED 186382 . 186774) (
|
||||
SKETCH.ADD.AND.DISPLAY 186776 . 187184) (SKETCH.ADD.AND.DISPLAY1 187186 . 187624) (SK.ADD.ITEM 187626
|
||||
. 187958) (SKETCHW.ADD.INSTANCE 187960 . 188302)) (188345 201533 (SK.SEL.AND.DELETE 188355 . 188743)
|
||||
(SK.ERASE.AND.DELETE.ITEM 188745 . 189164) (REMOVE.ELEMENT.FROM.SKETCH 189166 . 190277) (
|
||||
SK.DELETE.ELEMENT 190279 . 190837) (SK.DELETE.ELEMENT2 190839 . 191500) (SK.DELETE.KNOT 191502 .
|
||||
191793) (SK.SEL.AND.DELETE.KNOT 191795 . 192920) (SK.DELETE.ELEMENT.KNOT 192922 . 196129) (
|
||||
SK.CHECK.WHENDELETEDFN 196131 . 196911) (SK.CHECK.PREEDITFN 196913 . 197397) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197399 . 197933) (SK.CHECK.WHENPOINTDELETEDFN 197935 . 198731) (SK.ERASE.ELT
|
||||
198733 . 199069) (SK.DELETE.ELT 199071 . 199446) (SK.DELETE.ITEM 199448 . 199856) (DELFROMTCONC
|
||||
199858 . 201531)) (201572 215406 (SK.COPY.ELT 201582 . 201952) (SK.SEL.AND.COPY 201954 . 202337) (
|
||||
SK.COPY.ELEMENTS 202339 . 207967) (SK.ADD.COPY.OF.ELEMENTS 207969 . 209736) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209738 . 209978) (SK.COPY.ITEM 209980 . 210777) (SK.INSERT.SKETCH 210779
|
||||
. 215404)) (215446 245467 (SK.MOVE.ELT 215456 . 215731) (SK.MOVE.ELT.OR.PT 215733 . 216046) (
|
||||
SK.APPLY.DEFAULT.MOVE 216048 . 216482) (SK.SEL.AND.MOVE 216484 . 217031) (SK.MOVE.ELEMENTS 217033 .
|
||||
227905) (SKETCH.MOVE.ELEMENTS 227907 . 229838) (SKETCH.COPY.ELEMENTS 229840 . 231887) (
|
||||
\SKETCH.COPY.ELEMENT 231889 . 232614) (SK.TRANSLATE.ELEMENT 232616 . 233099) (SK.COPY.GLOBAL.ELEMENT
|
||||
233101 . 233312) (SK.MAKE.ELEMENT.MOVE.ARG 233314 . 233934) (SK.MAKE.ELEMENTS.MOVE.ARG 233936 . 234458
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234460 . 235529) (SK.SHOW.FIG.FROM.INFO 235531 . 235899) (
|
||||
SK.MOVE.THING 235901 . 236807) (UPDATE.ELEMENT.IN.SKETCH 236809 . 238864) (SK.UPDATE.ELEMENT 238866 .
|
||||
240425) (SK.UPDATE.ELEMENTS 240427 . 241146) (SK.UPDATE.ELEMENT1 241148 . 245048) (
|
||||
SK.MOVE.ELEMENT.POINT 245050 . 245465)) (245530 267819 (SK.MOVE.POINTS 245540 . 245827) (
|
||||
SK.SEL.AND.MOVE.POINTS 245829 . 246134) (SK.DO.MOVE.ELEMENT.POINTS 246136 . 254793) (
|
||||
SK.MOVE.ITEM.POINTS 254795 . 256466) (SK.TRANSLATEPTSFN 256468 . 256852) (SK.TRANSLATE.POINTS 256854
|
||||
. 257755) (SK.SELECT.MULTIPLE.POINTS 257757 . 263397) (SK.CONTROL.POINTS.IN.REGION 263399 . 264820) (
|
||||
SK.ADD.PT.SELECTION 264822 . 265286) (SK.REMOVE.PT.SELECTION 265288 . 265905) (SK.ADD.POINT 265907 .
|
||||
266530) (SK.ELTS.CONTAINING.PTS 266532 . 267157) (SK.HOTSPOTS.NOT.ON.LIST 267159 . 267817)) (267977
|
||||
270773 (SK.SET.MOVE.MODE 267987 . 268658) (SK.SET.MOVE.MODE.POINTS 268660 . 268999) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269001 . 269345) (SK.SET.MOVE.MODE.COMBINED 269347 . 269697) (READMOVEMODE
|
||||
269699 . 270771)) (270774 289529 (SK.ALIGN.POINTS 270784 . 271074) (SK.SEL.AND.ALIGN.POINTS 271076 .
|
||||
271385) (SK.ALIGN.POINTS.LEFT 271387 . 271690) (SK.ALIGN.POINTS.RIGHT 271692 . 271997) (
|
||||
SK.ALIGN.POINTS.TOP 271999 . 272300) (SK.ALIGN.POINTS.BOTTOM 272302 . 272609) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272611 . 272931) (SK.EVEN.SPACE.POINTS.IN.Y 272933 . 273253) (
|
||||
SK.DO.ALIGN.POINTS 273255 . 283877) (SK.NTH.CONTROL.POINT 283879 . 284340) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284342 . 285008) (SK.CORRESPONDING.CONTROL.PT 285010 . 285564) (
|
||||
SK.CONTROL.POINT.NUMBER 285566 . 285936) (SK.DO.ALIGN.SETVALUE 285938 . 289527)) (289593 303025 (
|
||||
SKETCH.CREATE.GROUP 289603 . 290092) (SK.CREATE.GROUP1 290094 . 290641) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290643 . 291432) (SK.GROUP.ELTS 291434 . 291715) (SK.SEL.AND.GROUP 291717 . 292103) (SK.GROUP.ELEMENTS
|
||||
292105 . 293754) (SK.UNGROUP.ELT 293756 . 294040) (SK.SEL.AND.UNGROUP 294042 . 295711) (
|
||||
SK.UNGROUP.ELEMENT 295713 . 296649) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296651 . 297573) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297575 . 298586) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298588 .
|
||||
299928) (SK.UNIONREGIONS 299930 . 302296) (SKETCH.REGION.OF.SKETCH 302298 . 302714) (SK.FLASHREGION
|
||||
302716 . 303023)) (303026 316497 (INIT.GROUP.ELEMENT 303036 . 303908) (GROUP.DRAWFN 303910 . 304360) (
|
||||
GROUP.EXPANDFN 304362 . 305925) (GROUP.INSIDEFN 305927 . 306336) (GROUP.REGIONFN 306338 . 306733) (
|
||||
GROUP.GLOBALREGIONFN 306735 . 307053) (GROUP.TRANSLATEFN 307055 . 309087) (GROUP.TRANSFORMFN 309089 .
|
||||
312569) (GROUP.READCHANGEFN 312571 . 316495)) (316498 317506 (REGION.CENTER 316508 . 317109) (
|
||||
REMOVE.LAST 317111 . 317504)) (317559 322666 (SK.MOVE.GROUP.CONTROL.PT 317569 . 317860) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 317862 . 319266) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319268 . 321341) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321343 . 322664)) (322925 327549 (SK.DO.GROUP 322935 . 324387) (
|
||||
SK.CHECK.WHENGROUPEDFN 324389 . 325099) (SK.DO.UNGROUP 325101 . 326306) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326308 . 326895) (SK.GROUP.UNDO 326897 . 327220) (SK.UNGROUP.UNDO 327222 . 327547)) (327790 332712 (
|
||||
SK.FREEZE.ELTS 327800 . 328084) (SK.SEL.AND.FREEZE 328086 . 328476) (SK.FREEZE.ELEMENTS 328478 .
|
||||
329029) (SK.UNFREEZE.ELT 329031 . 329320) (SK.SEL.AND.UNFREEZE 329322 . 330858) (SK.UNFREEZE.ELEMENTS
|
||||
330860 . 331419) (SK.FREEZE.UNDO 331421 . 331666) (SK.UNFREEZE.UNDO 331668 . 331915) (SK.DO.FREEZE
|
||||
331917 . 332310) (SK.DO.UNFREEZE 332312 . 332710)) (332942 342752 (SKETCH.ELEMENTS.OF.SKETCH 332952 .
|
||||
333787) (SKETCH.LIST.OF.ELEMENTS 333789 . 334507) (SKETCH.ADD.ELEMENT 334509 . 335584) (
|
||||
SKETCH.DELETE.ELEMENT 335586 . 337318) (DELFROMGROUPELT 337320 . 338120) (SKETCH.ELEMENT.TYPE 338122
|
||||
. 338471) (SKETCH.ELEMENT.CHANGED 338473 . 340041) (SK.ELEMENT.CHANGED1 340043 . 340694) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340696 . 342750)) (342806 347418 (INSURE.SKETCH 342816 . 345431)
|
||||
(LOCALSPECS.FROM.VIEWER 345433 . 345793) (SK.LOCAL.ELT.FROM.GLOBALPART 345795 . 346263) (
|
||||
SKETCH.FROM.VIEWER 346265 . 346499) (INSPECT.SKETCH 346501 . 346826) (ELT.INSIDE.SKETCHWP 346828 .
|
||||
347101) (SK.INSIDE.REGION 347103 . 347416)) (347419 351749 (MAPSKETCHSPECS 347429 . 348050) (
|
||||
MAPCOLLECTSKETCHSPECS 348052 . 348801) (MAPSKETCHSPECSUNTIL 348803 . 349611) (MAPGLOBALSKETCHSPECS
|
||||
349613 . 350314) (MAPGLOBALSKETCHELEMENTS 350316 . 351747)) (351811 377703 (SK.ADD.SELECTION 351821 .
|
||||
352561) (SK.COPY.INSERTFN 352563 . 356194) (SCREENELEMENTP 356196 . 356669) (SK.ITEM.REGION 356671 .
|
||||
357158) (SK.ELEMENT.GLOBAL.REGION 357160 . 357688) (SK.LOCAL.ITEMS.IN.REGION 357690 . 359669) (
|
||||
SK.REGIONFN 359671 . 359993) (SK.GLOBAL.REGIONFN 359995 . 360353) (SK.REMOVE.SELECTION 360355 . 361083
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361085 . 371527) (SKETCH.GET.ELEMENTS 371529 . 372952) (SK.PUT.MARKS.UP
|
||||
372954 . 373293) (SK.TAKE.MARKS.DOWN 373295 . 373634) (SK.TRANSLATE.GLOBALPART 373636 . 375763) (
|
||||
SK.TRANSLATE.ITEM 375765 . 376692) (SK.TRANSLATEFN 376694 . 376890) (TRANSLATE.SKETCH 376892 . 377701)
|
||||
) (377969 380876 (SK.INPUT.SCALE 377979 . 378826) (SK.UPDATE.SKETCHCONTEXT 378828 . 379425) (
|
||||
SK.SET.INPUT.SCALE 379427 . 380076) (SK.SET.INPUT.SCALE.CURRENT 380078 . 380369) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380371 . 380874)) (380927 382839 (SK.SET.FEEDBACK.MODE 380937 . 382243) (
|
||||
SK.SET.FEEDBACK.POINT 382245 . 382413) (SK.SET.FEEDBACK.VERBOSE 382415 . 382584) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382586 . 382837)) (382990 384267 (SKETCH.TITLE 383000 . 383263) (
|
||||
SK.SHRINK.ICONCREATE 383265 . 384265)) (389957 392771 (READBRUSHSHAPE 389967 . 390426) (READ.FUNCTION
|
||||
390428 . 390943) (READBRUSHSIZE 390945 . 391403) (READANGLE 391405 . 391897) (READARCDIRECTION 391899
|
||||
. 392769)) (392772 403183 (SK.CHANGE.DASHING 392782 . 396730) (READ.AND.SAVE.NEW.DASHING 396732 .
|
||||
398500) (READ.NEW.DASHING 398502 . 400242) (READ.DASHING.CHANGE 400244 . 401719) (SK.CACHE.DASHING
|
||||
401721 . 402723) (SK.DASHING.LABEL 402725 . 403181)) (403184 406889 (READ.FILLING.CHANGE 403194 .
|
||||
405175) (SK.CACHE.FILLING 405177 . 405895) (READ.AND.SAVE.NEW.FILLING 405897 . 406495) (
|
||||
SK.FILLING.LABEL 406497 . 406887)) (407273 443526 (SK.GETGLOBALPOSITION 407283 . 407588) (
|
||||
SKETCH.TRACK.ELEMENTS 407590 . 411110) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411112 . 411671) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411673 . 412065) (MAP.GLOBAL.POSITION.INTO.VIEWER 412067 . 412447) (
|
||||
SKETCH.TO.VIEWER.POSITION 412449 . 412808) (SKETCH.TRACK.IMAGE 412810 . 413664) (SK.TRACK.IMAGE1
|
||||
413666 . 415078) (MAP.VIEWER.XY.INTO.GLOBAL 415080 . 416074) (SK.SET.POSITION 416076 . 416412) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416414 . 417520) (VIEWER.TO.SKETCH.POSITION 417522 . 418157) (
|
||||
SK.INSURE.SCALE 418159 . 418419) (SKETCH.TO.VIEWER.REGION 418421 . 419227) (VIEWER.TO.SKETCH.REGION
|
||||
419229 . 419567) (SK.READ.POINT.WITH.FEEDBACK 419569 . 430572) (SKETCH.GET.POSITION 430574 . 432454) (
|
||||
\CLOBBER.POSITION 432456 . 432904) (NEAREST.HOT.SPOT 432906 . 434434) (GETWREGION 434436 . 435197) (
|
||||
GET.BITMAP.POSITION 435199 . 435983) (SK.TRACK.BITMAP1 435985 . 443524)) (444095 474981 (
|
||||
SK.BRING.UP.POSITION.PAD 444105 . 449965) (SK.PAD.READER.POSITION 449967 . 451616) (
|
||||
SK.POSITION.READER.REPAINTFN 451618 . 453402) (SK.POSITION.PAD.FROM.VIEWER 453404 . 454746) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 454748 . 455098) (SK.READ.POSITION.PAD.HANDLER 455100 . 460832) (
|
||||
DISPLAY.POSITION.READER.TOTAL 460834 . 463132) (POSITION.PAD.READER.HANDLER 463134 . 471177) (
|
||||
POSITIONPAD.HELDFN 471179 . 472663) (\POSITION.PAD.ADD.DIGIT.MENU 472665 . 474244) (
|
||||
\POSITION.READER.NUMBERPAD 474246 . 474979)) (476607 479285 (SK.DRAWFN 476617 . 476983) (
|
||||
SK.TRANSFORMFN 476985 . 477366) (SK.EXPANDFN 477368 . 477645) (SK.INPUT 477647 . 478028) (SK.INSIDEFN
|
||||
478030 . 478670) (SK.UPDATEFN 478672 . 479283)) (484857 488802 (SK.CHECK.SKETCH.VERSION 484867 .
|
||||
486107) (SK.INSURE.RECORD.LENGTH 486109 . 487592) (SK.INSURE.HAS.LENGTH 487594 . 488332) (
|
||||
SK.RECORD.LENGTH 488334 . 488508) (SK.SET.RECORD.LENGTHS 488510 . 488800)) (489543 490430 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489553 . 490428)))))
|
||||
(FILEMAP (NIL (22128 85491 (SKETCH 22138 . 24243) (SKETCH.FROM.A.FILE 24245 . 24560) (SKETCHW.CREATE
|
||||
24562 . 29136) (SKETCH.RESET 29138 . 30660) (SKETCHW.FIG.CHANGED 30662 . 31002) (SK.WINDOW.TITLE 31004
|
||||
. 31391) (EDITSLIDE 31393 . 31799) (EDITSKETCH 31801 . 32125) (SK.PUT.ON.FILE 32127 . 33579) (
|
||||
SK.OUTPUT.FILE.NAME 33581 . 33955) (SKETCH.PUT 33957 . 36855) (SK.GET.FROM.FILE 36857 . 37750) (
|
||||
SK.INCLUDE.FILE 37752 . 40260) (SK.GET.IMAGEOBJ.FROM.FILE 40262 . 42465) (SKETCH.GET 42467 . 42774) (
|
||||
ADD.SKETCH.TO.VIEWER 42776 . 45362) (FILENAMELESSVERSION 45364 . 45640) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45642 . 46156) (SKETCH.SET.A.DEFAULT 46158 . 53316) (SK.POPUP.SELECTIONFN 53318 . 53860) (
|
||||
GETSKETCHWREGION 53862 . 54068) (SK.ADD.ELEMENT 54070 . 55649) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55651 . 57045) (SK.ELTS.BY.PRIORITY 57047 . 57343) (SK.ORDER.ELEMENTS 57345 . 57612) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57614 . 59108) (SK.ADD.ELEMENTS 59110 . 59634) (
|
||||
SK.CHECK.WHENADDEDFN 59636 . 60366) (SK.APPLY.MENU.COMMAND 60368 . 61166) (SK.DELETE.ELEMENT1 61168 .
|
||||
62746) (SK.MARK.DIRTY 62748 . 63414) (SK.MARK.UNDIRTY 63416 . 63747) (SK.MENU.AND.RETURN.FIELD 63749
|
||||
. 64414) (SKETCH.SET.BRUSH.SHAPE 64416 . 65001) (SKETCH.SET.BRUSH.SIZE 65003 . 65509) (
|
||||
SKETCHW.CLOSEFN 65511 . 67302) (SK.CONFIRM.DESTRUCTION 67304 . 68303) (SKETCHW.OUTFN 68305 . 68569) (
|
||||
SKETCHW.REOPENFN 68571 . 68983) (MAKE.LOCAL.SKETCH 68985 . 69715) (MAP.SKETCHSPEC.INTO.VIEWER 69717 .
|
||||
70927) (SKETCHW.REPAINTFN 70929 . 71757) (SKETCHW.REPAINTFN1 71759 . 72698) (SK.DRAWFIGURE.IF 72700 .
|
||||
73222) (SKETCHW.SCROLLFN 73224 . 77417) (SKETCHW.RESHAPEFN 77419 . 79677) (SK.UPDATE.EVENT.SELECTION
|
||||
79679 . 81734) (LIGHTGRAYWINDOW 81736 . 81899) (SK.ADD.SPACES 81901 . 82647) (SK.SKETCH.MENU 82649 .
|
||||
82971) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 82973 . 83825) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83827 . 84787)
|
||||
(SK.RETURN.TTY 84789 . 85157) (SK.TAKE.TTY 85159 . 85489)) (85545 108873 (SKETCH.COMMANDMENU 85555 .
|
||||
85892) (SKETCH.COMMANDMENU.ITEMS 85894 . 105977) (CREATE.SKETCHW.COMMANDMENU 105979 . 106399) (
|
||||
SKETCHW.SELECTIONFN 106401 . 107504) (SKETCH.MONITORLOCK 107506 . 107977) (SK.EVAL.AS.PROCESS 107979
|
||||
. 108592) (SK.EVAL.WITH.LOCK 108594 . 108871)) (108874 116678 (SK.FIX.MENU 108884 . 109978) (
|
||||
SK.SET.UP.MENUS 109980 . 112281) (SK.INSURE.HAS.MENU 112283 . 112945) (SK.CREATE.STANDARD.MENU 112947
|
||||
. 113392) (SK.ADD.ITEM.TO.MENU 113394 . 114069) (SK.GET.VIEWER.POPUP.MENU 114071 . 116272) (
|
||||
SK.CLEAR.POPUP.MENU 116274 . 116676)) (116734 125556 (SKETCH.CREATE 116744 . 117530) (GETSKETCHPROP
|
||||
117532 . 120589) (PUTSKETCHPROP 120591 . 124523) (CREATE.DEFAULT.SKETCH.CONTEXT 124525 . 125554)) (
|
||||
125722 148618 (SK.COPY.BUTTONEVENTFN 125732 . 136960) (SK.BUTTONEVENT.MARK 136962 . 137345) (
|
||||
SK.BUILD.IMAGEOBJ 137347 . 147262) (SK.BUTTONEVENT.OVERP 147264 . 147887) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147889 . 148616)) (148897 174712 (SK.SEL.AND.CHANGE 148907 . 149199) (SK.CHECK.WHENCHANGEDFN 149201 .
|
||||
149907) (SK.CHECK.PRECHANGEFN 149909 . 150510) (SK.CHANGE.ELT 150512 . 150704) (SK.CHANGE.THING 150706
|
||||
. 151957) (SKETCH.CHANGE.ELEMENTS 151959 . 153142) (SK.APPLY.SINGLE.CHANGEFN 153144 . 153717) (
|
||||
SK.DO.CHANGESPECS 153719 . 155378) (SK.VIEWER.FROM.SKETCH.ARG 155380 . 155822) (SK.DO.CHANGESPEC1
|
||||
155824 . 157699) (SK.CHANGEFN 157701 . 158281) (SK.READCHANGEFN 158283 . 158742) (SK.DEFAULT.CHANGEFN
|
||||
158744 . 161216) (CHANGEABLEFIELDITEMS 161218 . 161865) (SK.APPLY.CHANGE.COMMAND 161867 . 162484) (
|
||||
SK.DO.AND.RECORD.CHANGES 162486 . 163883) (SK.APPLY.CHANGE.COMMAND1 163885 . 165373) (
|
||||
SK.ELEMENTS.CHANGEFN 165375 . 167699) (READ.POINT.TO.ADD 167701 . 168645) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168647 . 169107) (SK.ADD.KNOT.TO.ELEMENT 169109 . 170053) (SK.GROUP.CHANGEFN 170055 . 171267) (
|
||||
SK.GROUP.CHANGEFN1 171269 . 174710)) (174879 188612 (ADD.ELEMENT.TO.SKETCH 174889 . 176595) (
|
||||
ADD.SKETCH.VIEWER 176597 . 177265) (REMOVE.SKETCH.VIEWER 177267 . 177880) (ALL.SKETCH.VIEWERS 177882
|
||||
. 178122) (SKETCH.ALL.VIEWERS 178124 . 178384) (VIEWER.BUCKET 178386 . 178537) (ELT.INSIDE.REGION?
|
||||
178539 . 178866) (ELT.INSIDE.SKWP 178868 . 179159) (SCALE.FROM.SKW 179161 . 179411) (
|
||||
SK.ADDELT.TO.WINDOW 179413 . 180273) (SK.CALC.REGION.VIEWED 180275 . 180653) (SK.DRAWFIGURE 180655 .
|
||||
181944) (SK.DRAWFIGURE1 181946 . 182330) (SK.LOCAL.FROM.GLOBAL 182332 . 183567) (SKETCH.REGION.VIEWED
|
||||
183569 . 186256) (SKETCH.VIEW.FROM.NAME 186258 . 186688) (SK.UPDATE.REGION.VIEWED 186690 . 187082) (
|
||||
SKETCH.ADD.AND.DISPLAY 187084 . 187492) (SKETCH.ADD.AND.DISPLAY1 187494 . 187932) (SK.ADD.ITEM 187934
|
||||
. 188266) (SKETCHW.ADD.INSTANCE 188268 . 188610)) (188653 201841 (SK.SEL.AND.DELETE 188663 . 189051)
|
||||
(SK.ERASE.AND.DELETE.ITEM 189053 . 189472) (REMOVE.ELEMENT.FROM.SKETCH 189474 . 190585) (
|
||||
SK.DELETE.ELEMENT 190587 . 191145) (SK.DELETE.ELEMENT2 191147 . 191808) (SK.DELETE.KNOT 191810 .
|
||||
192101) (SK.SEL.AND.DELETE.KNOT 192103 . 193228) (SK.DELETE.ELEMENT.KNOT 193230 . 196437) (
|
||||
SK.CHECK.WHENDELETEDFN 196439 . 197219) (SK.CHECK.PREEDITFN 197221 . 197705) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197707 . 198241) (SK.CHECK.WHENPOINTDELETEDFN 198243 . 199039) (SK.ERASE.ELT
|
||||
199041 . 199377) (SK.DELETE.ELT 199379 . 199754) (SK.DELETE.ITEM 199756 . 200164) (DELFROMTCONC
|
||||
200166 . 201839)) (201880 215714 (SK.COPY.ELT 201890 . 202260) (SK.SEL.AND.COPY 202262 . 202645) (
|
||||
SK.COPY.ELEMENTS 202647 . 208275) (SK.ADD.COPY.OF.ELEMENTS 208277 . 210044) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 210046 . 210286) (SK.COPY.ITEM 210288 . 211085) (SK.INSERT.SKETCH 211087
|
||||
. 215712)) (215754 245775 (SK.MOVE.ELT 215764 . 216039) (SK.MOVE.ELT.OR.PT 216041 . 216354) (
|
||||
SK.APPLY.DEFAULT.MOVE 216356 . 216790) (SK.SEL.AND.MOVE 216792 . 217339) (SK.MOVE.ELEMENTS 217341 .
|
||||
228213) (SKETCH.MOVE.ELEMENTS 228215 . 230146) (SKETCH.COPY.ELEMENTS 230148 . 232195) (
|
||||
\SKETCH.COPY.ELEMENT 232197 . 232922) (SK.TRANSLATE.ELEMENT 232924 . 233407) (SK.COPY.GLOBAL.ELEMENT
|
||||
233409 . 233620) (SK.MAKE.ELEMENT.MOVE.ARG 233622 . 234242) (SK.MAKE.ELEMENTS.MOVE.ARG 234244 . 234766
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234768 . 235837) (SK.SHOW.FIG.FROM.INFO 235839 . 236207) (
|
||||
SK.MOVE.THING 236209 . 237115) (UPDATE.ELEMENT.IN.SKETCH 237117 . 239172) (SK.UPDATE.ELEMENT 239174 .
|
||||
240733) (SK.UPDATE.ELEMENTS 240735 . 241454) (SK.UPDATE.ELEMENT1 241456 . 245356) (
|
||||
SK.MOVE.ELEMENT.POINT 245358 . 245773)) (245838 268127 (SK.MOVE.POINTS 245848 . 246135) (
|
||||
SK.SEL.AND.MOVE.POINTS 246137 . 246442) (SK.DO.MOVE.ELEMENT.POINTS 246444 . 255101) (
|
||||
SK.MOVE.ITEM.POINTS 255103 . 256774) (SK.TRANSLATEPTSFN 256776 . 257160) (SK.TRANSLATE.POINTS 257162
|
||||
. 258063) (SK.SELECT.MULTIPLE.POINTS 258065 . 263705) (SK.CONTROL.POINTS.IN.REGION 263707 . 265128) (
|
||||
SK.ADD.PT.SELECTION 265130 . 265594) (SK.REMOVE.PT.SELECTION 265596 . 266213) (SK.ADD.POINT 266215 .
|
||||
266838) (SK.ELTS.CONTAINING.PTS 266840 . 267465) (SK.HOTSPOTS.NOT.ON.LIST 267467 . 268125)) (268285
|
||||
271081 (SK.SET.MOVE.MODE 268295 . 268966) (SK.SET.MOVE.MODE.POINTS 268968 . 269307) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269309 . 269653) (SK.SET.MOVE.MODE.COMBINED 269655 . 270005) (READMOVEMODE
|
||||
270007 . 271079)) (271082 289837 (SK.ALIGN.POINTS 271092 . 271382) (SK.SEL.AND.ALIGN.POINTS 271384 .
|
||||
271693) (SK.ALIGN.POINTS.LEFT 271695 . 271998) (SK.ALIGN.POINTS.RIGHT 272000 . 272305) (
|
||||
SK.ALIGN.POINTS.TOP 272307 . 272608) (SK.ALIGN.POINTS.BOTTOM 272610 . 272917) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272919 . 273239) (SK.EVEN.SPACE.POINTS.IN.Y 273241 . 273561) (
|
||||
SK.DO.ALIGN.POINTS 273563 . 284185) (SK.NTH.CONTROL.POINT 284187 . 284648) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284650 . 285316) (SK.CORRESPONDING.CONTROL.PT 285318 . 285872) (
|
||||
SK.CONTROL.POINT.NUMBER 285874 . 286244) (SK.DO.ALIGN.SETVALUE 286246 . 289835)) (289901 303333 (
|
||||
SKETCH.CREATE.GROUP 289911 . 290400) (SK.CREATE.GROUP1 290402 . 290949) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290951 . 291740) (SK.GROUP.ELTS 291742 . 292023) (SK.SEL.AND.GROUP 292025 . 292411) (SK.GROUP.ELEMENTS
|
||||
292413 . 294062) (SK.UNGROUP.ELT 294064 . 294348) (SK.SEL.AND.UNGROUP 294350 . 296019) (
|
||||
SK.UNGROUP.ELEMENT 296021 . 296957) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296959 . 297881) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297883 . 298894) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298896 .
|
||||
300236) (SK.UNIONREGIONS 300238 . 302604) (SKETCH.REGION.OF.SKETCH 302606 . 303022) (SK.FLASHREGION
|
||||
303024 . 303331)) (303334 316805 (INIT.GROUP.ELEMENT 303344 . 304216) (GROUP.DRAWFN 304218 . 304668) (
|
||||
GROUP.EXPANDFN 304670 . 306233) (GROUP.INSIDEFN 306235 . 306644) (GROUP.REGIONFN 306646 . 307041) (
|
||||
GROUP.GLOBALREGIONFN 307043 . 307361) (GROUP.TRANSLATEFN 307363 . 309395) (GROUP.TRANSFORMFN 309397 .
|
||||
312877) (GROUP.READCHANGEFN 312879 . 316803)) (316806 317814 (REGION.CENTER 316816 . 317417) (
|
||||
REMOVE.LAST 317419 . 317812)) (317867 322974 (SK.MOVE.GROUP.CONTROL.PT 317877 . 318168) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 318170 . 319574) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319576 . 321649) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321651 . 322972)) (323233 327857 (SK.DO.GROUP 323243 . 324695) (
|
||||
SK.CHECK.WHENGROUPEDFN 324697 . 325407) (SK.DO.UNGROUP 325409 . 326614) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326616 . 327203) (SK.GROUP.UNDO 327205 . 327528) (SK.UNGROUP.UNDO 327530 . 327855)) (328098 333020 (
|
||||
SK.FREEZE.ELTS 328108 . 328392) (SK.SEL.AND.FREEZE 328394 . 328784) (SK.FREEZE.ELEMENTS 328786 .
|
||||
329337) (SK.UNFREEZE.ELT 329339 . 329628) (SK.SEL.AND.UNFREEZE 329630 . 331166) (SK.UNFREEZE.ELEMENTS
|
||||
331168 . 331727) (SK.FREEZE.UNDO 331729 . 331974) (SK.UNFREEZE.UNDO 331976 . 332223) (SK.DO.FREEZE
|
||||
332225 . 332618) (SK.DO.UNFREEZE 332620 . 333018)) (333250 343060 (SKETCH.ELEMENTS.OF.SKETCH 333260 .
|
||||
334095) (SKETCH.LIST.OF.ELEMENTS 334097 . 334815) (SKETCH.ADD.ELEMENT 334817 . 335892) (
|
||||
SKETCH.DELETE.ELEMENT 335894 . 337626) (DELFROMGROUPELT 337628 . 338428) (SKETCH.ELEMENT.TYPE 338430
|
||||
. 338779) (SKETCH.ELEMENT.CHANGED 338781 . 340349) (SK.ELEMENT.CHANGED1 340351 . 341002) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 341004 . 343058)) (343114 347726 (INSURE.SKETCH 343124 . 345739)
|
||||
(LOCALSPECS.FROM.VIEWER 345741 . 346101) (SK.LOCAL.ELT.FROM.GLOBALPART 346103 . 346571) (
|
||||
SKETCH.FROM.VIEWER 346573 . 346807) (INSPECT.SKETCH 346809 . 347134) (ELT.INSIDE.SKETCHWP 347136 .
|
||||
347409) (SK.INSIDE.REGION 347411 . 347724)) (347727 352057 (MAPSKETCHSPECS 347737 . 348358) (
|
||||
MAPCOLLECTSKETCHSPECS 348360 . 349109) (MAPSKETCHSPECSUNTIL 349111 . 349919) (MAPGLOBALSKETCHSPECS
|
||||
349921 . 350622) (MAPGLOBALSKETCHELEMENTS 350624 . 352055)) (352119 378011 (SK.ADD.SELECTION 352129 .
|
||||
352869) (SK.COPY.INSERTFN 352871 . 356502) (SCREENELEMENTP 356504 . 356977) (SK.ITEM.REGION 356979 .
|
||||
357466) (SK.ELEMENT.GLOBAL.REGION 357468 . 357996) (SK.LOCAL.ITEMS.IN.REGION 357998 . 359977) (
|
||||
SK.REGIONFN 359979 . 360301) (SK.GLOBAL.REGIONFN 360303 . 360661) (SK.REMOVE.SELECTION 360663 . 361391
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361393 . 371835) (SKETCH.GET.ELEMENTS 371837 . 373260) (SK.PUT.MARKS.UP
|
||||
373262 . 373601) (SK.TAKE.MARKS.DOWN 373603 . 373942) (SK.TRANSLATE.GLOBALPART 373944 . 376071) (
|
||||
SK.TRANSLATE.ITEM 376073 . 377000) (SK.TRANSLATEFN 377002 . 377198) (TRANSLATE.SKETCH 377200 . 378009)
|
||||
) (378277 381184 (SK.INPUT.SCALE 378287 . 379134) (SK.UPDATE.SKETCHCONTEXT 379136 . 379733) (
|
||||
SK.SET.INPUT.SCALE 379735 . 380384) (SK.SET.INPUT.SCALE.CURRENT 380386 . 380677) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380679 . 381182)) (381235 383147 (SK.SET.FEEDBACK.MODE 381245 . 382551) (
|
||||
SK.SET.FEEDBACK.POINT 382553 . 382721) (SK.SET.FEEDBACK.VERBOSE 382723 . 382892) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382894 . 383145)) (383298 384575 (SKETCH.TITLE 383308 . 383571) (
|
||||
SK.SHRINK.ICONCREATE 383573 . 384573)) (390265 393079 (READBRUSHSHAPE 390275 . 390734) (READ.FUNCTION
|
||||
390736 . 391251) (READBRUSHSIZE 391253 . 391711) (READANGLE 391713 . 392205) (READARCDIRECTION 392207
|
||||
. 393077)) (393080 403491 (SK.CHANGE.DASHING 393090 . 397038) (READ.AND.SAVE.NEW.DASHING 397040 .
|
||||
398808) (READ.NEW.DASHING 398810 . 400550) (READ.DASHING.CHANGE 400552 . 402027) (SK.CACHE.DASHING
|
||||
402029 . 403031) (SK.DASHING.LABEL 403033 . 403489)) (403492 407197 (READ.FILLING.CHANGE 403502 .
|
||||
405483) (SK.CACHE.FILLING 405485 . 406203) (READ.AND.SAVE.NEW.FILLING 406205 . 406803) (
|
||||
SK.FILLING.LABEL 406805 . 407195)) (407581 443834 (SK.GETGLOBALPOSITION 407591 . 407896) (
|
||||
SKETCH.TRACK.ELEMENTS 407898 . 411418) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411420 . 411979) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411981 . 412373) (MAP.GLOBAL.POSITION.INTO.VIEWER 412375 . 412755) (
|
||||
SKETCH.TO.VIEWER.POSITION 412757 . 413116) (SKETCH.TRACK.IMAGE 413118 . 413972) (SK.TRACK.IMAGE1
|
||||
413974 . 415386) (MAP.VIEWER.XY.INTO.GLOBAL 415388 . 416382) (SK.SET.POSITION 416384 . 416720) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416722 . 417828) (VIEWER.TO.SKETCH.POSITION 417830 . 418465) (
|
||||
SK.INSURE.SCALE 418467 . 418727) (SKETCH.TO.VIEWER.REGION 418729 . 419535) (VIEWER.TO.SKETCH.REGION
|
||||
419537 . 419875) (SK.READ.POINT.WITH.FEEDBACK 419877 . 430880) (SKETCH.GET.POSITION 430882 . 432762) (
|
||||
\CLOBBER.POSITION 432764 . 433212) (NEAREST.HOT.SPOT 433214 . 434742) (GETWREGION 434744 . 435505) (
|
||||
GET.BITMAP.POSITION 435507 . 436291) (SK.TRACK.BITMAP1 436293 . 443832)) (444403 475289 (
|
||||
SK.BRING.UP.POSITION.PAD 444413 . 450273) (SK.PAD.READER.POSITION 450275 . 451924) (
|
||||
SK.POSITION.READER.REPAINTFN 451926 . 453710) (SK.POSITION.PAD.FROM.VIEWER 453712 . 455054) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 455056 . 455406) (SK.READ.POSITION.PAD.HANDLER 455408 . 461140) (
|
||||
DISPLAY.POSITION.READER.TOTAL 461142 . 463440) (POSITION.PAD.READER.HANDLER 463442 . 471485) (
|
||||
POSITIONPAD.HELDFN 471487 . 472971) (\POSITION.PAD.ADD.DIGIT.MENU 472973 . 474552) (
|
||||
\POSITION.READER.NUMBERPAD 474554 . 475287)) (476915 479593 (SK.DRAWFN 476925 . 477291) (
|
||||
SK.TRANSFORMFN 477293 . 477674) (SK.EXPANDFN 477676 . 477953) (SK.INPUT 477955 . 478336) (SK.INSIDEFN
|
||||
478338 . 478978) (SK.UPDATEFN 478980 . 479591)) (485165 489110 (SK.CHECK.SKETCH.VERSION 485175 .
|
||||
486415) (SK.INSURE.RECORD.LENGTH 486417 . 487900) (SK.INSURE.HAS.LENGTH 487902 . 488640) (
|
||||
SK.RECORD.LENGTH 488642 . 488816) (SK.SET.RECORD.LENGTHS 488818 . 489108)) (489851 490738 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489861 . 490736)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,9 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Aug-2021 20:49:42" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;2 554230
|
||||
|
||||
changes to%: (FNS \SK.PUT.ARROWHEADS)
|
||||
(FILECREATED " 4-Aug-2022 09:57:43" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;2 554099
|
||||
|
||||
previous date%: "31-Dec-2000 10:58:28" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;1)
|
||||
:CHANGES-TO (FNS CREATE.SKETCH.ELEMENT.TYPE)
|
||||
|
||||
:PREVIOUS-DATE "21-Aug-2021 20:49:42" {DSK}<home>larry>medley>library>SKETCHELEMENTS.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -14,7 +15,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ SKETCHELEMENTSCOMS
|
||||
( (* ;
|
||||
"contains the functions need to implement the sketch basic element types")
|
||||
"contains the functions need to implement the sketch basic element types")
|
||||
(FNS INIT.SKETCH.ELEMENTS CREATE.SKETCH.ELEMENT.TYPE SKETCH.ELEMENT.TYPEP
|
||||
SKETCH.ELEMENT.NAMEP \CURSOR.IN.MIDDLE.MENU)
|
||||
(COMS (* ; "color and filling stuff")
|
||||
@@ -43,9 +44,9 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(CURSORS CIRCLE.CENTER CIRCLE.EDGE)
|
||||
(INITVARS [SK.DEFAULT.BRUSH (CONS 'ROUND (CONS 1 (CONS 'BLACK NIL]
|
||||
(* ;
|
||||
"Original was (create BRUSH BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1 BRUSHCOLOR _ 'BLACK).")
|
||||
"Original was (create BRUSH BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1 BRUSHCOLOR _ 'BLACK).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(SK.DEFAULT.DASHING)
|
||||
(SK.DEFAULT.TEXTURE))
|
||||
(GLOBALVARS SK.DEFAULT.BRUSH SK.DEFAULT.DASHING SK.DEFAULT.TEXTURE))
|
||||
@@ -113,7 +114,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(INITVARS (SK.ARROW.END.MENU)
|
||||
(SK.ARROW.EDIT.MENU)))
|
||||
(COMS (* ;
|
||||
"stuff to support the text element type.")
|
||||
"stuff to support the text element type.")
|
||||
(FNS SKETCH.CREATE.TEXT TEXT.CHANGEFN TEXT.READCHANGEFN \SK.READ.FONT.SIZE1
|
||||
SK.TEXT.ELT.WITH.SAME.FIELDS SK.READFONTFAMILY CLOSE.PROMPT.WINDOW TEXT.DRAWFN
|
||||
TEXT.DRAWFN1 TEXT.INSIDEFN TEXT.EXPANDFN SK.TEXT.LINE.REGIONS
|
||||
@@ -142,7 +143,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(GLOBALVARS SKETCH.TERMTABLE SK.DEFAULT.TEXT.ALIGNMENT INDICATE.TEXT.SHADE \FONTSONFILE
|
||||
SK.HORIZONTAL.STYLES SK.VERTICAL.STYLES))
|
||||
(COMS (* ;
|
||||
"stuff for supporting the TEXTBOX sketch element.")
|
||||
"stuff for supporting the TEXTBOX sketch element.")
|
||||
(FNS SKETCH.CREATE.TEXTBOX SK.COMPUTE.TEXTBOX.REGION.FOR.STRING SK.BREAK.INTO.LINES
|
||||
SK.BRUSH.SIZE SK.TEXTBOX.CREATE SK.TEXTBOX.CREATE1 SK.UPDATE.TEXTBOX.AFTER.CHANGE
|
||||
SK.TEXTBOX.POSITION.IN.BOX TEXTBOX.CHANGEFN TEXTBOX.DRAWFN
|
||||
@@ -153,13 +154,13 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
SK.TEXTBOX.FROM.TEXT ADD.EOLS)
|
||||
(DECLARE%: DONTCOPY (RECORDS LOCALTEXTBOX TEXTBOX))
|
||||
(COMS (* ;
|
||||
"stuff to handle default alignment for text boxes")
|
||||
"stuff to handle default alignment for text boxes")
|
||||
(FNS SK.SET.TEXTBOX.VERT.ALIGN SK.SET.TEXTBOX.HORIZ.ALIGN)
|
||||
(VARS TEXTBOXICON)
|
||||
[INITVARS (SK.DEFAULT.TEXTBOX.ALIGNMENT '(CENTER CENTER]
|
||||
(GLOBALVARS SK.DEFAULT.TEXTBOX.ALIGNMENT)))
|
||||
(COMS (* ;
|
||||
"functions to implement the box sketch element.")
|
||||
"functions to implement the box sketch element.")
|
||||
(FNS SKETCH.CREATE.BOX SK.BOX.DRAWFN BOX.DRAWFN1 KNOTS.OF.REGION SK.DRAWAREABOX
|
||||
SK.DRAWBOX SK.BOX.EXPANDFN SK.BOX.GETREGIONFN BOX.SET.SCALES SK.BOX.INPUTFN
|
||||
SK.BOX.CREATE SK.UPDATE.BOX.AFTER.CHANGE SK.BOX.INSIDEFN SK.BOX.REGIONFN
|
||||
@@ -170,7 +171,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTCOPY (RECORDS BOX LOCALBOX))
|
||||
(UGLYVARS BOXICON))
|
||||
(COMS (* ;
|
||||
"fns for the arc sketch element type")
|
||||
"fns for the arc sketch element type")
|
||||
(FNS SKETCH.CREATE.ARC ARC.DRAWFN ARC.EXPANDFN ARC.INPUTFN SK.INVERT.CIRCLE
|
||||
SK.READ.ARC.ANGLE.POINT SK.SHOW.ARC ARC.CREATE SK.UPDATE.ARC.AFTER.CHANGE
|
||||
ARC.MOVEFN ARC.TRANSLATEPTS ARC.INSIDEFN ARC.REGIONFN ARC.GLOBALREGIONFN
|
||||
@@ -185,7 +186,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(CURSORS ARC.RADIUS.CURSOR ARC.ANGLE.CURSOR CW.ARC.ANGLE.CURSOR CW.ARC.RADIUS.CURSOR)
|
||||
(UGLYVARS ARCICON))
|
||||
(COMS (* ;
|
||||
"property getting and setting stuff")
|
||||
"property getting and setting stuff")
|
||||
(FNS GETSKETCHELEMENTPROP \SK.GET.ARC.ANGLEPT \GETSKETCHELEMENTPROP1 \SK.GET.BRUSH
|
||||
\SK.GET.FILLING \SK.GET.ARROWHEADS \SK.GET.FONT \SK.GET.JUSTIFICATION
|
||||
\SK.GET.DIRECTION \SK.GET.DASHING PUTSKETCHELEMENTPROP \SK.PUT.FILLING
|
||||
@@ -375,7 +376,7 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(CREATE.SKETCH.ELEMENT.TYPE
|
||||
[LAMBDA (SKETCHTYPE LABEL DOCSTR DRAWFN EXPANDFN OBSOLETE CHANGEFN INPUTFN INSIDEFN REGIONFN
|
||||
TRANSLATEFN UPDATEFN READCHANGEFN TRANSFORMFN TRANSLATEPTSFN GLOBALREGIONFN)
|
||||
TRANSLATEFN UPDATEFN READCHANGEFN TRANSFORMFN TRANSLATEPTSFN GLOBALREGIONFN)
|
||||
(* rrb "18-Oct-85 17:18")
|
||||
(* creates a new sketch element type.)
|
||||
(COND
|
||||
@@ -1124,17 +1125,16 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD BRUSH (BRUSHSHAPE BRUSHSIZE BRUSHCOLOR)
|
||||
BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1)
|
||||
BRUSHSHAPE _ 'ROUND BRUSHSIZE _ 1)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD LOCALCIRCLE ((CENTERPOSITION RADIUSPOSITION)
|
||||
LOCALHOTREGION RADIUS LOCALCIRCLEBRUSH LOCALCIRCLEFILLING LOCALCIRCLEDASHING
|
||||
))
|
||||
LOCALHOTREGION RADIUS LOCALCIRCLEBRUSH LOCALCIRCLEFILLING LOCALCIRCLEDASHING))
|
||||
|
||||
(TYPERECORD CIRCLE (CENTERLATLON RADIUSLATLON BRUSH DASHING CIRCLEINITSCALE CIRCLEFILLING
|
||||
CIRCLEREGION))
|
||||
CIRCLEREGION))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -1645,11 +1645,11 @@ Copyright (c) 1985-1987, 1990-1993, 2000, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD LOCALELLIPSE ((ELLIPSECENTER MINORRADIUSPOSITION MAJORRADIUSPOSITION)
|
||||
LOCALHOTREGION SEMIMINORRADIUS SEMIMAJORRADIUS LOCALELLIPSEBRUSH
|
||||
LOCALELLIPSEDASHING LOCALELLIPSEFILLING))
|
||||
LOCALHOTREGION SEMIMINORRADIUS SEMIMAJORRADIUS LOCALELLIPSEBRUSH
|
||||
LOCALELLIPSEDASHING LOCALELLIPSEFILLING))
|
||||
|
||||
(TYPERECORD ELLIPSE (ELLIPSECENTERLATLON SEMIMINORLATLON SEMIMAJORLATLON ORIENTATION BRUSH
|
||||
DASHING ELLIPSEINITSCALE ELLIPSEFILLING ELLIPSEREGION))
|
||||
(TYPERECORD ELLIPSE (ELLIPSECENTERLATLON SEMIMINORLATLON SEMIMAJORLATLON ORIENTATION BRUSH DASHING
|
||||
ELLIPSEINITSCALE ELLIPSEFILLING ELLIPSEREGION))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -2710,14 +2710,14 @@ Click outside the window to stop.")
|
||||
|
||||
(RECORD LOCALCURVE (KNOTS LOCALHOTREGION ARROWHEADPTS LOCALCURVEBRUSH LOCALCURVEDASHING))
|
||||
|
||||
(TYPERECORD OPENCURVE (LATLONKNOTS BRUSH DASHING CURVEARROWHEADS OPENCURVEINITSCALE
|
||||
OPENCURVEREGION OPENCURVEARROWHEADPOINTS))
|
||||
(TYPERECORD OPENCURVE (LATLONKNOTS BRUSH DASHING CURVEARROWHEADS OPENCURVEINITSCALE OPENCURVEREGION
|
||||
OPENCURVEARROWHEADPOINTS))
|
||||
|
||||
(TYPERECORD CLOSEDCURVE (LATLONKNOTS BRUSH DASHING CLOSEDCURVEINITSCALE CLOSEDCURVEFILLING
|
||||
CLOSEDCURVEREGION))
|
||||
CLOSEDCURVEREGION))
|
||||
|
||||
(RECORD LOCALCLOSEDCURVE (LOCALCLOSEDCURVEKNOTS LOCALCLOSEDCURVEHOTREGION LOCALCLOSEDCURVEBRUSH
|
||||
LOCALCLOSEDCURVEFILLING LOCALCLOSEDCURVEDASHING))
|
||||
LOCALCLOSEDCURVEFILLING LOCALCLOSEDCURVEDASHING))
|
||||
|
||||
(RECORD LOCALCLOSEDWIRE (KNOTS LOCALHOTREGION LOCALCLOSEDWIREBRUSH LOCALCLOSEDWIREFILLING))
|
||||
)
|
||||
@@ -4311,11 +4311,11 @@ Click outside the window to stop.")
|
||||
|
||||
(RECORD LOCALWIRE (KNOTS LOCALHOTREGION ARROWHEADPTS LOCALOPENWIREBRUSH LOCALWIREDASHING))
|
||||
|
||||
(TYPERECORD WIRE (LATLONKNOTS BRUSH WIREARROWHEADS OPENWIREDASHING OPENWIREINITSCALE
|
||||
OPENWIREREGION OPENWIREARROWHEADPOINTS))
|
||||
(TYPERECORD WIRE (LATLONKNOTS BRUSH WIREARROWHEADS OPENWIREDASHING OPENWIREINITSCALE OPENWIREREGION
|
||||
OPENWIREARROWHEADPOINTS))
|
||||
|
||||
(TYPERECORD CLOSEDWIRE (LATLONKNOTS BRUSH CLOSEDWIREDASHING CLOSEDWIREINITSCALE CLOSEDWIREFILLING
|
||||
CLOSEDWIREREGION))
|
||||
(TYPERECORD CLOSEDWIRE (LATLONKNOTS BRUSH CLOSEDWIREDASHING CLOSEDWIREINITSCALE CLOSEDWIREFILLING
|
||||
CLOSEDWIREREGION))
|
||||
|
||||
(RECORD LOCALCLOSEDWIRE (KNOTS LOCALHOTREGION LOCALCLOSEDWIREBRUSH LOCALCLOSEDWIREFILLING))
|
||||
)
|
||||
@@ -5743,11 +5743,11 @@ Click outside the window to stop.")
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD TEXT (LOCATIONLATLON LISTOFCHARACTERS INITIALSCALE TEXTSTYLE FONT LISTOFREGIONS
|
||||
TEXTCOLOR))
|
||||
(TYPERECORD TEXT (LOCATIONLATLON LISTOFCHARACTERS INITIALSCALE TEXTSTYLE FONT LISTOFREGIONS TEXTCOLOR
|
||||
))
|
||||
|
||||
(RECORD LOCALTEXT ((DISPLAYPOSITION)
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS))
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS))
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -6985,12 +6985,11 @@ No more font sizes found.")))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD LOCALTEXTBOX ((TEXTBOXLL TEXTBOXUR)
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS
|
||||
LOCALTEXTBOXREGION LOCALTEXTBOXBRUSH LOCALTEXTBOXFILLING
|
||||
LOCALTEXTBOXDASHING))
|
||||
LOCALHOTREGION LINEREGIONS LOCALFONT LOCALLISTOFCHARACTERS LOCALTEXTBOXREGION
|
||||
LOCALTEXTBOXBRUSH LOCALTEXTBOXFILLING LOCALTEXTBOXDASHING))
|
||||
|
||||
(TYPERECORD TEXTBOX (TEXTBOXREGION LISTOFCHARACTERS INITIALSCALE TEXTSTYLE FONT LISTOFREGIONS
|
||||
TEXTCOLOR TEXTBOXBRUSH TEXTBOXDASHING TEXTBOXFILLING))
|
||||
TEXTCOLOR TEXTBOXBRUSH TEXTBOXDASHING TEXTBOXFILLING))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -7822,7 +7821,7 @@ No more font sizes found.")))
|
||||
(TYPERECORD BOX (GLOBALREGION BRUSH BOXDASHING BOXINITSCALE BOXFILLING))
|
||||
|
||||
(RECORD LOCALBOX ((BOXLL BOXUR)
|
||||
LOCALHOTREGION LOCALREGION LOCALBOXBRUSH LOCALBOXFILLING LOCALBOXDASHING))
|
||||
LOCALHOTREGION LOCALREGION LOCALBOXBRUSH LOCALBOXFILLING LOCALBOXDASHING))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -8468,12 +8467,11 @@ No more font sizes found.")))
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(TYPERECORD ARC (ARCCENTERPT ARCRADIUSPT ARCBRUSH ARCDASHING ARCINITSCALE ARCARROWHEADS
|
||||
ARCANGLEPT ARCDIRECTION ARCREGION ARCARROWHEADPOINTS))
|
||||
(TYPERECORD ARC (ARCCENTERPT ARCRADIUSPT ARCBRUSH ARCDASHING ARCINITSCALE ARCARROWHEADS ARCANGLEPT
|
||||
ARCDIRECTION ARCREGION ARCARROWHEADPOINTS))
|
||||
|
||||
(RECORD LOCALARC ((LOCALARCCENTERPT LOCALARCRADIUSPT LOCALARCANGLEPT)
|
||||
LOCALHOTREGION LOCALARCARROWHEADPTS LOCALARCBRUSH LOCALARCKNOTS LOCALARCDASHING
|
||||
))
|
||||
LOCALHOTREGION LOCALARCARROWHEADPTS LOCALARCBRUSH LOCALARCKNOTS LOCALARCDASHING))
|
||||
)
|
||||
)
|
||||
(RPAQ ARC.RADIUS.CURSOR (CURSORCREATE (QUOTE #*(16 16)@@@L@@@D@@@F@@@B@@@C@@LA@@OA@@CMOOOO@@CL@@O@@@L@@@@@@@@@@@@@@@@@
|
||||
@@ -9284,137 +9282,137 @@ No more font sizes found.")))
|
||||
(PUTPROPS SKETCHELEMENTS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1991 1992 1993
|
||||
2000 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (14335 24749 (INIT.SKETCH.ELEMENTS 14345 . 21908) (CREATE.SKETCH.ELEMENT.TYPE 21910 .
|
||||
23436) (SKETCH.ELEMENT.TYPEP 23438 . 23826) (SKETCH.ELEMENT.NAMEP 23828 . 24091) (
|
||||
\CURSOR.IN.MIDDLE.MENU 24093 . 24747)) (24790 25467 (SKETCHINCOLORP 24800 . 25120) (READ.COLOR.CHANGE
|
||||
25122 . 25465)) (25976 28755 (SK.CREATE.DEFAULT.FILLING 25986 . 26287) (SKFILLINGP 26289 . 26922) (
|
||||
SK.INSURE.FILLING 26924 . 28352) (SK.INSURE.COLOR 28354 . 28753)) (28756 34366 (SK.TRANSLATE.MODE
|
||||
28766 . 29548) (SK.CHANGE.FILLING.MODE 29550 . 33133) (READ.FILLING.MODE 33135 . 34364)) (34367 65041
|
||||
(SKETCH.CREATE.CIRCLE 34377 . 35189) (CIRCLE.EXPANDFN 35191 . 38563) (CIRCLE.DRAWFN 38565 . 41566) (
|
||||
\CIRCLE.DRAWFN1 41568 . 44163) (CIRCLE.INPUTFN 44165 . 46014) (SK.UPDATE.CIRCLE.AFTER.CHANGE 46016 .
|
||||
46375) (SK.READ.CIRCLE.POINT 46377 . 46848) (SK.SHOW.CIRCLE 46850 . 47496) (CIRCLE.INSIDEFN 47498 .
|
||||
47763) (CIRCLE.REGIONFN 47765 . 49446) (CIRCLE.GLOBALREGIONFN 49448 . 50966) (CIRCLE.TRANSLATE 50968
|
||||
. 52829) (CIRCLE.READCHANGEFN 52831 . 57447) (CIRCLE.TRANSFORMFN 57449 . 59302) (CIRCLE.TRANSLATEPTS
|
||||
59304 . 60918) (SK.CIRCLE.CREATE 60920 . 61763) (SET.CIRCLE.SCALE 61765 . 62531) (SK.BRUSH.READCHANGE
|
||||
62533 . 65039)) (65042 65771 (SK.INSURE.BRUSH 65052 . 65446) (SK.INSURE.DASHING 65448 . 65769)) (67023
|
||||
96517 (SKETCH.CREATE.ELLIPSE 67033 . 67632) (ELLIPSE.EXPANDFN 67634 . 71246) (ELLIPSE.DRAWFN 71248 .
|
||||
75425) (ELLIPSE.INPUTFN 75427 . 77867) (SK.READ.ELLIPSE.MAJOR.PT 77869 . 78448) (
|
||||
SK.SHOW.ELLIPSE.MAJOR.RADIUS 78450 . 79205) (SK.READ.ELLIPSE.MINOR.PT 79207 . 79900) (
|
||||
SK.SHOW.ELLIPSE.MINOR.RADIUS 79902 . 80734) (ELLIPSE.INSIDEFN 80736 . 81006) (ELLIPSE.CREATE 81008 .
|
||||
82383) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82385 . 82753) (ELLIPSE.REGIONFN 82755 . 84955) (
|
||||
ELLIPSE.GLOBALREGIONFN 84957 . 86770) (ELLIPSE.TRANSLATEFN 86772 . 89318) (ELLIPSE.TRANSFORMFN 89320
|
||||
. 90597) (ELLIPSE.TRANSLATEPTS 90599 . 92640) (MARK.SPOT 92642 . 93893) (DISTANCEBETWEEN 93895 .
|
||||
94490) (SK.DISTANCE.TO 94492 . 94877) (SQUARE 94879 . 94921) (COMPUTE.ELLIPSE.ORIENTATION 94923 .
|
||||
95642) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95644 . 96515)) (97642 138698 (SKETCH.CREATE.OPEN.CURVE
|
||||
97652 . 98205) (OPENCURVE.INPUTFN 98207 . 99075) (SK.CURVE.CREATE 99077 . 100822) (MAXXEXTENT 100824
|
||||
. 101683) (MAXYEXTENT 101685 . 102545) (KNOT.SET.SCALE.FIELD 102547 . 103349) (OPENCURVE.DRAWFN
|
||||
103351 . 104482) (OPENCURVE.EXPANDFN 104484 . 107799) (OPENCURVE.READCHANGEFN 107801 . 111003) (
|
||||
OPENCURVE.TRANSFORMFN 111005 . 113503) (OPENCURVE.TRANSLATEFN 113505 . 113927) (
|
||||
OPENCURVE.TRANSLATEPTSFN 113929 . 115310) (SKETCH.CREATE.CLOSED.CURVE 115312 . 115818) (
|
||||
CLOSEDCURVE.DRAWFN 115820 . 116604) (CLOSEDCURVE.EXPANDFN 116606 . 119719) (CLOSEDCURVE.REGIONFN
|
||||
119721 . 120518) (CLOSEDCURVE.GLOBALREGIONFN 120520 . 121953) (READ.LIST.OF.POINTS 121955 . 123934) (
|
||||
CLOSEDCURVE.INPUTFN 123936 . 124581) (CLOSEDCURVE.READCHANGEFN 124583 . 127478) (
|
||||
CLOSEDCURVE.TRANSFORMFN 127480 . 129280) (CLOSEDCURVE.TRANSLATEPTSFN 129282 . 130627) (INVISIBLEPARTP
|
||||
130629 . 130982) (SHOWSKETCHPOINT 130984 . 131289) (SHOWSKETCHXY 131291 . 131809) (KNOTS.REGIONFN
|
||||
131811 . 132712) (OPENWIRE.GLOBALREGIONFN 132714 . 133578) (CURVE.REGIONFN 133580 . 134521) (
|
||||
OPENCURVE.GLOBALREGIONFN 134523 . 135930) (KNOTS.TRANSLATEFN 135932 . 136975) (REGION.CONTAINING.PTS
|
||||
136977 . 138696)) (138699 160975 (CHANGE.ELTS.BRUSH.SIZE 138709 . 139319) (CHANGE.ELTS.BRUSH 139321 .
|
||||
139838) (CHANGE.ELTS.BRUSH.SHAPE 139840 . 140241) (SK.CHANGE.BRUSH.SHAPE 140243 . 143755) (
|
||||
SK.CHANGE.BRUSH.COLOR 143757 . 148203) (SK.CHANGE.BRUSH.SIZE 148205 . 153163) (SK.CHANGE.ANGLE 153165
|
||||
. 156145) (SK.CHANGE.ARC.DIRECTION 156147 . 158526) (SK.SET.DEFAULT.BRUSH.SIZE 158528 . 159227) (
|
||||
READSIZECHANGE 159229 . 160973)) (160976 162595 (SK.CHANGE.ELEMENT.KNOTS 160986 . 162593)) (162596
|
||||
163243 (SK.INSURE.POINT.LIST 162606 . 163059) (SK.INSURE.POSITION 163061 . 163241)) (164623 196946 (
|
||||
SKETCH.CREATE.WIRE 164633 . 165123) (CLOSEDWIRE.EXPANDFN 165125 . 167813) (KNOTS.INSIDEFN 167815 .
|
||||
168536) (OPEN.WIRE.DRAWFN 168538 . 169130) (WIRE.EXPANDFN 169132 . 172379) (
|
||||
SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172381 . 172902) (OPENWIRE.READCHANGEFN 172904 . 175397) (
|
||||
OPENWIRE.TRANSFORMFN 175399 . 177522) (OPENWIRE.TRANSLATEFN 177524 . 177948) (OPENWIRE.TRANSLATEPTSFN
|
||||
177950 . 179229) (WIRE.INPUTFN 179231 . 180862) (SK.READ.WIRE.POINTS 180864 . 181395) (
|
||||
SK.READ.POINTS.WITH.FEEDBACK 181397 . 184164) (OPENWIRE.FEEDBACKFN 184166 . 184920) (
|
||||
CLOSEDWIRE.FEEDBACKFN 184922 . 186278) (CLOSEDWIRE.REGIONFN 186280 . 187265) (
|
||||
CLOSEDWIRE.GLOBALREGIONFN 187267 . 188319) (SK.WIRE.CREATE 188321 . 190084) (WIRE.ADD.POINT.TO.END
|
||||
190086 . 191002) (READ.ARROW.CHANGE 191004 . 196480) (CHANGE.ELTS.ARROWHEADS 196482 . 196944)) (196947
|
||||
207953 (SKETCH.CREATE.CLOSED.WIRE 196957 . 197518) (CLOSED.WIRE.INPUTFN 197520 . 197875) (
|
||||
CLOSED.WIRE.DRAWFN 197877 . 199922) (CLOSEDWIRE.READCHANGEFN 199924 . 204829) (CLOSEDWIRE.TRANSFORMFN
|
||||
204831 . 206625) (CLOSEDWIRE.TRANSLATEPTSFN 206627 . 207951)) (207954 260660 (SK.EXPAND.ARROWHEADS
|
||||
207964 . 208314) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208316 . 209697) (ARC.ARROWHEAD.POINTS 209699 .
|
||||
210922) (SET.ARC.ARROWHEAD.POINTS 210924 . 211905) (SET.OPENCURVE.ARROWHEAD.POINTS 211907 . 212808) (
|
||||
SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212810 . 214080) (SET.WIRE.ARROWHEAD.POINTS 214082 . 214835) (
|
||||
SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214837 . 216102) (SK.EXPAND.ARROWHEAD 216104 . 217287) (CHANGED.ARROW
|
||||
217289 . 220461) (SK.CHANGE.ARROWHEAD 220463 . 220916) (SK.CHANGE.ARROWHEAD1 220918 . 226173) (
|
||||
SK.CREATE.ARROWHEAD 226175 . 226695) (SK.ARROWHEAD.CREATE 226697 . 228271) (SK.ARROWHEAD.END.TEST
|
||||
228273 . 229197) (READ.ARROWHEAD.END 229199 . 231224) (ARROW.HEAD.POSITIONS 231226 . 233066) (
|
||||
ARROWHEAD.POINTS.LIST 233068 . 237040) (CURVE.ARROWHEAD.POINTS 237042 . 237905) (LEFT.MOST.IS.BEGINP
|
||||
237907 . 238788) (WIRE.ARROWHEAD.POINTS 238790 . 240316) (DRAWARROWHEADS 240318 . 242688) (
|
||||
\SK.DRAW.TRIANGLE.ARROWHEAD 242690 . 244350) (\SK.ENDPT.OF.ARROW 244352 . 246609) (
|
||||
\SK.ADJUST.FOR.ARROWHEADS 246611 . 249116) (SK.SET.ARROWHEAD.LENGTH 249118 . 250262) (
|
||||
SK.SET.ARROWHEAD.ANGLE 250264 . 251360) (SK.SET.ARROWHEAD.TYPE 251362 . 254651) (SK.SET.LINE.ARROWHEAD
|
||||
254653 . 257066) (SK.UPDATE.ARROWHEAD.FORMAT 257068 . 259178) (SK.SET.LINE.LENGTH.MODE 259180 .
|
||||
260658)) (260661 262462 (SK.INSURE.ARROWHEADS 260671 . 261853) (SK.ARROWHEADP 261855 . 262460)) (
|
||||
265266 327592 (SKETCH.CREATE.TEXT 265276 . 265790) (TEXT.CHANGEFN 265792 . 266184) (TEXT.READCHANGEFN
|
||||
266186 . 274257) (\SK.READ.FONT.SIZE1 274259 . 276155) (SK.TEXT.ELT.WITH.SAME.FIELDS 276157 . 277797)
|
||||
(SK.READFONTFAMILY 277799 . 279345) (CLOSE.PROMPT.WINDOW 279347 . 279771) (TEXT.DRAWFN 279773 . 280494
|
||||
) (TEXT.DRAWFN1 280496 . 283998) (TEXT.INSIDEFN 284000 . 284389) (TEXT.EXPANDFN 284391 . 286516) (
|
||||
SK.TEXT.LINE.REGIONS 286518 . 288392) (TEXT.UPDATE.GLOBAL.REGIONS 288394 . 289626) (REL.MOVE.REGION
|
||||
289628 . 290165) (LTEXT.LINE.REGIONS 290167 . 293585) (TEXT.INPUTFN 293587 . 294097) (READ.TEXT 294099
|
||||
. 294847) (TEXT.POSITION.AND.CREATE 294849 . 297160) (CREATE.TEXT.ELEMENT 297162 . 297980) (
|
||||
SK.UPDATE.TEXT.AFTER.CHANGE 297982 . 298384) (SK.TEXT.FROM.TEXTBOX 298386 . 302192) (
|
||||
TEXT.SET.GLOBAL.REGIONS 302194 . 303487) (TEXT.REGIONFN 303489 . 304259) (TEXT.GLOBALREGIONFN 304261
|
||||
. 304949) (TEXT.TRANSLATEFN 304951 . 306266) (TEXT.TRANSFORMFN 306268 . 307391) (TEXT.TRANSLATEPTSFN
|
||||
307393 . 307910) (TEXT.UPDATEFN 307912 . 312568) (SK.CHANGE.TEXT 312570 . 325658) (TEXT.SET.SCALES
|
||||
325660 . 326628) (BREAK.AT.CARRIAGE.RETURNS 326630 . 327590)) (327593 346117 (ADD.KNOWN.SKETCH.FONT
|
||||
327603 . 328594) (SK.PICK.FONT 328596 . 334128) (SK.CHOOSE.TEXT.FONT 334130 . 338078) (SK.NEXTSIZEFONT
|
||||
338080 . 339347) (SK.DECREASING.FONT.LIST 339349 . 341222) (SK.GUESS.FONTSAVAILABLE 341224 . 346115))
|
||||
(346544 360687 (SK.SET.FONT 346554 . 348121) (SK.SET.TEXT.FONT 348123 . 349125) (SK.SET.TEXT.SIZE
|
||||
349127 . 349814) (SK.SET.TEXT.HORIZ.ALIGN 349816 . 351390) (SK.READFONTSIZE 351392 . 353622) (
|
||||
SK.COLLECT.FONT.SIZES 353624 . 356542) (SK.SET.TEXT.VERT.ALIGN 356544 . 358586) (SK.SET.TEXT.LOOKS
|
||||
358588 . 360045) (SK.SET.DEFAULT.TEXT.FACE 360047 . 360685)) (360688 361274 (CREATE.SKETCH.TERMTABLE
|
||||
360698 . 361272)) (361275 363041 (SK.FONT.LIST 361285 . 361611) (SK.INSURE.FONT 361613 . 362135) (
|
||||
SK.INSURE.STYLE 362137 . 362655) (SK.INSURE.TEXT 362657 . 363039)) (363611 420904 (
|
||||
SKETCH.CREATE.TEXTBOX 363621 . 365263) (SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 365265 . 367342) (
|
||||
SK.BREAK.INTO.LINES 367344 . 378530) (SK.BRUSH.SIZE 378532 . 378913) (SK.TEXTBOX.CREATE 378915 .
|
||||
379712) (SK.TEXTBOX.CREATE1 379714 . 380778) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 380780 . 381320) (
|
||||
SK.TEXTBOX.POSITION.IN.BOX 381322 . 383233) (TEXTBOX.CHANGEFN 383235 . 383709) (TEXTBOX.DRAWFN 383711
|
||||
. 385747) (SK.TEXTURE.AROUND.REGIONS 385749 . 391822) (ALL.EMPTY.REGIONS 391824 . 392314) (
|
||||
TEXTBOX.EXPANDFN 392316 . 399472) (TEXTBOX.INPUTFN 399474 . 401087) (TEXTBOX.INSIDEFN 401089 . 401502)
|
||||
(TEXTBOX.REGIONFN 401504 . 402358) (TEXTBOX.GLOBALREGIONFN 402360 . 402688) (
|
||||
TEXTBOX.SET.GLOBAL.REGIONS 402690 . 404021) (TEXTBOX.TRANSLATEFN 404023 . 405864) (
|
||||
TEXTBOX.TRANSLATEPTSFN 405866 . 408649) (TEXTBOX.TRANSFORMFN 408651 . 410319) (TEXTBOX.UPDATEFN 410321
|
||||
. 412214) (TEXTBOX.READCHANGEFN 412216 . 417105) (SK.TEXTBOX.TEXT.POSITION 417107 . 417528) (
|
||||
SK.TEXTBOX.FROM.TEXT 417530 . 420135) (ADD.EOLS 420137 . 420902)) (421472 424973 (
|
||||
SK.SET.TEXTBOX.VERT.ALIGN 421482 . 423362) (SK.SET.TEXTBOX.HORIZ.ALIGN 423364 . 424971)) (425356
|
||||
469831 (SKETCH.CREATE.BOX 425366 . 425849) (SK.BOX.DRAWFN 425851 . 427010) (BOX.DRAWFN1 427012 .
|
||||
429851) (KNOTS.OF.REGION 429853 . 431087) (SK.DRAWAREABOX 431089 . 437690) (SK.DRAWBOX 437692 . 438881
|
||||
) (SK.BOX.EXPANDFN 438883 . 442631) (SK.BOX.GETREGIONFN 442633 . 443819) (BOX.SET.SCALES 443821 .
|
||||
445061) (SK.BOX.INPUTFN 445063 . 446996) (SK.BOX.CREATE 446998 . 447699) (SK.UPDATE.BOX.AFTER.CHANGE
|
||||
447701 . 448212) (SK.BOX.INSIDEFN 448214 . 448604) (SK.BOX.REGIONFN 448606 . 449319) (
|
||||
SK.BOX.GLOBALREGIONFN 449321 . 450059) (SK.BOX.READCHANGEFN 450061 . 453782) (SK.CHANGE.FILLING 453784
|
||||
. 457732) (SK.CHANGE.FILLING.COLOR 457734 . 461390) (SK.BOX.TRANSLATEFN 461392 . 462571) (
|
||||
SK.BOX.TRANSFORMFN 462573 . 463518) (SK.BOX.TRANSLATEPTSFN 463520 . 465888) (UNSCALE.REGION.TO.GRID
|
||||
465890 . 466815) (INCREASEREGION 466817 . 467408) (INSUREREGIONSIZE 467410 . 468581) (EXPANDREGION
|
||||
468583 . 469463) (REGION.FROM.COORDINATES 469465 . 469829)) (470371 496726 (SKETCH.CREATE.ARC 470381
|
||||
. 471190) (ARC.DRAWFN 471192 . 472919) (ARC.EXPANDFN 472921 . 475254) (ARC.INPUTFN 475256 . 479474) (
|
||||
SK.INVERT.CIRCLE 479476 . 480336) (SK.READ.ARC.ANGLE.POINT 480338 . 480845) (SK.SHOW.ARC 480847 .
|
||||
481457) (ARC.CREATE 481459 . 482814) (SK.UPDATE.ARC.AFTER.CHANGE 482816 . 483156) (ARC.MOVEFN 483158
|
||||
. 484741) (ARC.TRANSLATEPTS 484743 . 486628) (ARC.INSIDEFN 486630 . 486880) (ARC.REGIONFN 486882 .
|
||||
488018) (ARC.GLOBALREGIONFN 488020 . 489742) (ARC.TRANSLATE 489744 . 490726) (ARC.TRANSFORMFN 490728
|
||||
. 493678) (ARC.READCHANGEFN 493680 . 496724)) (496727 505806 (SK.COMPUTE.ARC.ANGLE.PT 496737 . 497663
|
||||
) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 497665 . 498658) (SK.COMPUTE.ARC.PTS 498660 . 502232) (
|
||||
SK.SET.ARC.DIRECTION 502234 . 502808) (SK.SET.ARC.DIRECTION.CW 502810 . 502984) (
|
||||
SK.SET.ARC.DIRECTION.CCW 502986 . 503259) (SK.COMPUTE.SLOPE.OF.LINE 503261 . 503753) (
|
||||
SK.CREATE.ARC.USING 503755 . 504992) (SET.ARC.SCALES 504994 . 505804)) (505807 506252 (
|
||||
SK.INSURE.DIRECTION 505817 . 506250)) (507654 553513 (GETSKETCHELEMENTPROP 507664 . 508972) (
|
||||
\SK.GET.ARC.ANGLEPT 508974 . 509535) (\GETSKETCHELEMENTPROP1 509537 . 509791) (\SK.GET.BRUSH 509793 .
|
||||
510717) (\SK.GET.FILLING 510719 . 511817) (\SK.GET.ARROWHEADS 511819 . 512598) (\SK.GET.FONT 512600 .
|
||||
513080) (\SK.GET.JUSTIFICATION 513082 . 513606) (\SK.GET.DIRECTION 513608 . 514085) (\SK.GET.DASHING
|
||||
514087 . 515106) (PUTSKETCHELEMENTPROP 515108 . 517377) (\SK.PUT.FILLING 517379 . 518649) (
|
||||
ADDSKETCHELEMENTPROP 518651 . 519456) (REMOVESKETCHELEMENTPROP 519458 . 520247) (\SK.PUT.FONT 520249
|
||||
. 521063) (\SK.PUT.JUSTIFICATION 521065 . 522076) (\SK.PUT.DIRECTION 522078 . 522685) (
|
||||
\SK.PUT.DASHING 522687 . 524022) (\SK.PUT.BRUSH 524024 . 525943) (\SK.PUT.ARROWHEADS 525945 . 527911)
|
||||
(SK.COPY.ELEMENT.PROPERTY.LIST 527913 . 528489) (SKETCH.UPDATE 528491 . 529221) (SKETCH.UPDATE1 529223
|
||||
. 530511) (\SKELT.GET.SCALE 530513 . 531501) (\SKELT.PUT.SCALE 531503 . 532810) (\SKELT.PUT.DATA
|
||||
532812 . 534609) (SK.REPLACE.TEXT.IN.ELEMENT 534611 . 535564) (\SKELT.GET.DATA 535566 . 536633) (
|
||||
\SK.GET.1STCONTROLPT 536635 . 538147) (\SK.PUT.1STCONTROLPT 538149 . 543622) (\SK.GET.2NDCONTROLPT
|
||||
543624 . 544539) (\SK.PUT.2NDCONTROLPT 544541 . 548729) (\SK.GET.3RDCONTROLPT 548731 . 549609) (
|
||||
\SK.PUT.3RDCONTROLPT 549611 . 553511)) (553514 554095 (LOWERLEFTCORNER 553524 . 553770) (
|
||||
UPPERRIGHTCORNER 553772 . 554093)))))
|
||||
(FILEMAP (NIL (14359 24769 (INIT.SKETCH.ELEMENTS 14369 . 21932) (CREATE.SKETCH.ELEMENT.TYPE 21934 .
|
||||
23456) (SKETCH.ELEMENT.TYPEP 23458 . 23846) (SKETCH.ELEMENT.NAMEP 23848 . 24111) (
|
||||
\CURSOR.IN.MIDDLE.MENU 24113 . 24767)) (24810 25487 (SKETCHINCOLORP 24820 . 25140) (READ.COLOR.CHANGE
|
||||
25142 . 25485)) (25996 28775 (SK.CREATE.DEFAULT.FILLING 26006 . 26307) (SKFILLINGP 26309 . 26942) (
|
||||
SK.INSURE.FILLING 26944 . 28372) (SK.INSURE.COLOR 28374 . 28773)) (28776 34386 (SK.TRANSLATE.MODE
|
||||
28786 . 29568) (SK.CHANGE.FILLING.MODE 29570 . 33153) (READ.FILLING.MODE 33155 . 34384)) (34387 65061
|
||||
(SKETCH.CREATE.CIRCLE 34397 . 35209) (CIRCLE.EXPANDFN 35211 . 38583) (CIRCLE.DRAWFN 38585 . 41586) (
|
||||
\CIRCLE.DRAWFN1 41588 . 44183) (CIRCLE.INPUTFN 44185 . 46034) (SK.UPDATE.CIRCLE.AFTER.CHANGE 46036 .
|
||||
46395) (SK.READ.CIRCLE.POINT 46397 . 46868) (SK.SHOW.CIRCLE 46870 . 47516) (CIRCLE.INSIDEFN 47518 .
|
||||
47783) (CIRCLE.REGIONFN 47785 . 49466) (CIRCLE.GLOBALREGIONFN 49468 . 50986) (CIRCLE.TRANSLATE 50988
|
||||
. 52849) (CIRCLE.READCHANGEFN 52851 . 57467) (CIRCLE.TRANSFORMFN 57469 . 59322) (CIRCLE.TRANSLATEPTS
|
||||
59324 . 60938) (SK.CIRCLE.CREATE 60940 . 61783) (SET.CIRCLE.SCALE 61785 . 62551) (SK.BRUSH.READCHANGE
|
||||
62553 . 65059)) (65062 65791 (SK.INSURE.BRUSH 65072 . 65466) (SK.INSURE.DASHING 65468 . 65789)) (67005
|
||||
96499 (SKETCH.CREATE.ELLIPSE 67015 . 67614) (ELLIPSE.EXPANDFN 67616 . 71228) (ELLIPSE.DRAWFN 71230 .
|
||||
75407) (ELLIPSE.INPUTFN 75409 . 77849) (SK.READ.ELLIPSE.MAJOR.PT 77851 . 78430) (
|
||||
SK.SHOW.ELLIPSE.MAJOR.RADIUS 78432 . 79187) (SK.READ.ELLIPSE.MINOR.PT 79189 . 79882) (
|
||||
SK.SHOW.ELLIPSE.MINOR.RADIUS 79884 . 80716) (ELLIPSE.INSIDEFN 80718 . 80988) (ELLIPSE.CREATE 80990 .
|
||||
82365) (SK.UPDATE.ELLIPSE.AFTER.CHANGE 82367 . 82735) (ELLIPSE.REGIONFN 82737 . 84937) (
|
||||
ELLIPSE.GLOBALREGIONFN 84939 . 86752) (ELLIPSE.TRANSLATEFN 86754 . 89300) (ELLIPSE.TRANSFORMFN 89302
|
||||
. 90579) (ELLIPSE.TRANSLATEPTS 90581 . 92622) (MARK.SPOT 92624 . 93875) (DISTANCEBETWEEN 93877 .
|
||||
94472) (SK.DISTANCE.TO 94474 . 94859) (SQUARE 94861 . 94903) (COMPUTE.ELLIPSE.ORIENTATION 94905 .
|
||||
95624) (SK.COMPUTE.ELLIPSE.MINOR.RADIUS.PT 95626 . 96497)) (97612 138668 (SKETCH.CREATE.OPEN.CURVE
|
||||
97622 . 98175) (OPENCURVE.INPUTFN 98177 . 99045) (SK.CURVE.CREATE 99047 . 100792) (MAXXEXTENT 100794
|
||||
. 101653) (MAXYEXTENT 101655 . 102515) (KNOT.SET.SCALE.FIELD 102517 . 103319) (OPENCURVE.DRAWFN
|
||||
103321 . 104452) (OPENCURVE.EXPANDFN 104454 . 107769) (OPENCURVE.READCHANGEFN 107771 . 110973) (
|
||||
OPENCURVE.TRANSFORMFN 110975 . 113473) (OPENCURVE.TRANSLATEFN 113475 . 113897) (
|
||||
OPENCURVE.TRANSLATEPTSFN 113899 . 115280) (SKETCH.CREATE.CLOSED.CURVE 115282 . 115788) (
|
||||
CLOSEDCURVE.DRAWFN 115790 . 116574) (CLOSEDCURVE.EXPANDFN 116576 . 119689) (CLOSEDCURVE.REGIONFN
|
||||
119691 . 120488) (CLOSEDCURVE.GLOBALREGIONFN 120490 . 121923) (READ.LIST.OF.POINTS 121925 . 123904) (
|
||||
CLOSEDCURVE.INPUTFN 123906 . 124551) (CLOSEDCURVE.READCHANGEFN 124553 . 127448) (
|
||||
CLOSEDCURVE.TRANSFORMFN 127450 . 129250) (CLOSEDCURVE.TRANSLATEPTSFN 129252 . 130597) (INVISIBLEPARTP
|
||||
130599 . 130952) (SHOWSKETCHPOINT 130954 . 131259) (SHOWSKETCHXY 131261 . 131779) (KNOTS.REGIONFN
|
||||
131781 . 132682) (OPENWIRE.GLOBALREGIONFN 132684 . 133548) (CURVE.REGIONFN 133550 . 134491) (
|
||||
OPENCURVE.GLOBALREGIONFN 134493 . 135900) (KNOTS.TRANSLATEFN 135902 . 136945) (REGION.CONTAINING.PTS
|
||||
136947 . 138666)) (138669 160945 (CHANGE.ELTS.BRUSH.SIZE 138679 . 139289) (CHANGE.ELTS.BRUSH 139291 .
|
||||
139808) (CHANGE.ELTS.BRUSH.SHAPE 139810 . 140211) (SK.CHANGE.BRUSH.SHAPE 140213 . 143725) (
|
||||
SK.CHANGE.BRUSH.COLOR 143727 . 148173) (SK.CHANGE.BRUSH.SIZE 148175 . 153133) (SK.CHANGE.ANGLE 153135
|
||||
. 156115) (SK.CHANGE.ARC.DIRECTION 156117 . 158496) (SK.SET.DEFAULT.BRUSH.SIZE 158498 . 159197) (
|
||||
READSIZECHANGE 159199 . 160943)) (160946 162565 (SK.CHANGE.ELEMENT.KNOTS 160956 . 162563)) (162566
|
||||
163213 (SK.INSURE.POINT.LIST 162576 . 163029) (SK.INSURE.POSITION 163031 . 163211)) (164581 196904 (
|
||||
SKETCH.CREATE.WIRE 164591 . 165081) (CLOSEDWIRE.EXPANDFN 165083 . 167771) (KNOTS.INSIDEFN 167773 .
|
||||
168494) (OPEN.WIRE.DRAWFN 168496 . 169088) (WIRE.EXPANDFN 169090 . 172337) (
|
||||
SK.UPDATE.WIRE.ELT.AFTER.CHANGE 172339 . 172860) (OPENWIRE.READCHANGEFN 172862 . 175355) (
|
||||
OPENWIRE.TRANSFORMFN 175357 . 177480) (OPENWIRE.TRANSLATEFN 177482 . 177906) (OPENWIRE.TRANSLATEPTSFN
|
||||
177908 . 179187) (WIRE.INPUTFN 179189 . 180820) (SK.READ.WIRE.POINTS 180822 . 181353) (
|
||||
SK.READ.POINTS.WITH.FEEDBACK 181355 . 184122) (OPENWIRE.FEEDBACKFN 184124 . 184878) (
|
||||
CLOSEDWIRE.FEEDBACKFN 184880 . 186236) (CLOSEDWIRE.REGIONFN 186238 . 187223) (
|
||||
CLOSEDWIRE.GLOBALREGIONFN 187225 . 188277) (SK.WIRE.CREATE 188279 . 190042) (WIRE.ADD.POINT.TO.END
|
||||
190044 . 190960) (READ.ARROW.CHANGE 190962 . 196438) (CHANGE.ELTS.ARROWHEADS 196440 . 196902)) (196905
|
||||
207911 (SKETCH.CREATE.CLOSED.WIRE 196915 . 197476) (CLOSED.WIRE.INPUTFN 197478 . 197833) (
|
||||
CLOSED.WIRE.DRAWFN 197835 . 199880) (CLOSEDWIRE.READCHANGEFN 199882 . 204787) (CLOSEDWIRE.TRANSFORMFN
|
||||
204789 . 206583) (CLOSEDWIRE.TRANSLATEPTSFN 206585 . 207909)) (207912 260618 (SK.EXPAND.ARROWHEADS
|
||||
207922 . 208272) (SK.COMPUTE.ARC.ARROWHEAD.POINTS 208274 . 209655) (ARC.ARROWHEAD.POINTS 209657 .
|
||||
210880) (SET.ARC.ARROWHEAD.POINTS 210882 . 211863) (SET.OPENCURVE.ARROWHEAD.POINTS 211865 . 212766) (
|
||||
SK.COMPUTE.CURVE.ARROWHEAD.POINTS 212768 . 214038) (SET.WIRE.ARROWHEAD.POINTS 214040 . 214793) (
|
||||
SK.COMPUTE.WIRE.ARROWHEAD.POINTS 214795 . 216060) (SK.EXPAND.ARROWHEAD 216062 . 217245) (CHANGED.ARROW
|
||||
217247 . 220419) (SK.CHANGE.ARROWHEAD 220421 . 220874) (SK.CHANGE.ARROWHEAD1 220876 . 226131) (
|
||||
SK.CREATE.ARROWHEAD 226133 . 226653) (SK.ARROWHEAD.CREATE 226655 . 228229) (SK.ARROWHEAD.END.TEST
|
||||
228231 . 229155) (READ.ARROWHEAD.END 229157 . 231182) (ARROW.HEAD.POSITIONS 231184 . 233024) (
|
||||
ARROWHEAD.POINTS.LIST 233026 . 236998) (CURVE.ARROWHEAD.POINTS 237000 . 237863) (LEFT.MOST.IS.BEGINP
|
||||
237865 . 238746) (WIRE.ARROWHEAD.POINTS 238748 . 240274) (DRAWARROWHEADS 240276 . 242646) (
|
||||
\SK.DRAW.TRIANGLE.ARROWHEAD 242648 . 244308) (\SK.ENDPT.OF.ARROW 244310 . 246567) (
|
||||
\SK.ADJUST.FOR.ARROWHEADS 246569 . 249074) (SK.SET.ARROWHEAD.LENGTH 249076 . 250220) (
|
||||
SK.SET.ARROWHEAD.ANGLE 250222 . 251318) (SK.SET.ARROWHEAD.TYPE 251320 . 254609) (SK.SET.LINE.ARROWHEAD
|
||||
254611 . 257024) (SK.UPDATE.ARROWHEAD.FORMAT 257026 . 259136) (SK.SET.LINE.LENGTH.MODE 259138 .
|
||||
260616)) (260619 262420 (SK.INSURE.ARROWHEADS 260629 . 261811) (SK.ARROWHEADP 261813 . 262418)) (
|
||||
265217 327543 (SKETCH.CREATE.TEXT 265227 . 265741) (TEXT.CHANGEFN 265743 . 266135) (TEXT.READCHANGEFN
|
||||
266137 . 274208) (\SK.READ.FONT.SIZE1 274210 . 276106) (SK.TEXT.ELT.WITH.SAME.FIELDS 276108 . 277748)
|
||||
(SK.READFONTFAMILY 277750 . 279296) (CLOSE.PROMPT.WINDOW 279298 . 279722) (TEXT.DRAWFN 279724 . 280445
|
||||
) (TEXT.DRAWFN1 280447 . 283949) (TEXT.INSIDEFN 283951 . 284340) (TEXT.EXPANDFN 284342 . 286467) (
|
||||
SK.TEXT.LINE.REGIONS 286469 . 288343) (TEXT.UPDATE.GLOBAL.REGIONS 288345 . 289577) (REL.MOVE.REGION
|
||||
289579 . 290116) (LTEXT.LINE.REGIONS 290118 . 293536) (TEXT.INPUTFN 293538 . 294048) (READ.TEXT 294050
|
||||
. 294798) (TEXT.POSITION.AND.CREATE 294800 . 297111) (CREATE.TEXT.ELEMENT 297113 . 297931) (
|
||||
SK.UPDATE.TEXT.AFTER.CHANGE 297933 . 298335) (SK.TEXT.FROM.TEXTBOX 298337 . 302143) (
|
||||
TEXT.SET.GLOBAL.REGIONS 302145 . 303438) (TEXT.REGIONFN 303440 . 304210) (TEXT.GLOBALREGIONFN 304212
|
||||
. 304900) (TEXT.TRANSLATEFN 304902 . 306217) (TEXT.TRANSFORMFN 306219 . 307342) (TEXT.TRANSLATEPTSFN
|
||||
307344 . 307861) (TEXT.UPDATEFN 307863 . 312519) (SK.CHANGE.TEXT 312521 . 325609) (TEXT.SET.SCALES
|
||||
325611 . 326579) (BREAK.AT.CARRIAGE.RETURNS 326581 . 327541)) (327544 346068 (ADD.KNOWN.SKETCH.FONT
|
||||
327554 . 328545) (SK.PICK.FONT 328547 . 334079) (SK.CHOOSE.TEXT.FONT 334081 . 338029) (SK.NEXTSIZEFONT
|
||||
338031 . 339298) (SK.DECREASING.FONT.LIST 339300 . 341173) (SK.GUESS.FONTSAVAILABLE 341175 . 346066))
|
||||
(346487 360630 (SK.SET.FONT 346497 . 348064) (SK.SET.TEXT.FONT 348066 . 349068) (SK.SET.TEXT.SIZE
|
||||
349070 . 349757) (SK.SET.TEXT.HORIZ.ALIGN 349759 . 351333) (SK.READFONTSIZE 351335 . 353565) (
|
||||
SK.COLLECT.FONT.SIZES 353567 . 356485) (SK.SET.TEXT.VERT.ALIGN 356487 . 358529) (SK.SET.TEXT.LOOKS
|
||||
358531 . 359988) (SK.SET.DEFAULT.TEXT.FACE 359990 . 360628)) (360631 361217 (CREATE.SKETCH.TERMTABLE
|
||||
360641 . 361215)) (361218 362984 (SK.FONT.LIST 361228 . 361554) (SK.INSURE.FONT 361556 . 362078) (
|
||||
SK.INSURE.STYLE 362080 . 362598) (SK.INSURE.TEXT 362600 . 362982)) (363554 420847 (
|
||||
SKETCH.CREATE.TEXTBOX 363564 . 365206) (SK.COMPUTE.TEXTBOX.REGION.FOR.STRING 365208 . 367285) (
|
||||
SK.BREAK.INTO.LINES 367287 . 378473) (SK.BRUSH.SIZE 378475 . 378856) (SK.TEXTBOX.CREATE 378858 .
|
||||
379655) (SK.TEXTBOX.CREATE1 379657 . 380721) (SK.UPDATE.TEXTBOX.AFTER.CHANGE 380723 . 381263) (
|
||||
SK.TEXTBOX.POSITION.IN.BOX 381265 . 383176) (TEXTBOX.CHANGEFN 383178 . 383652) (TEXTBOX.DRAWFN 383654
|
||||
. 385690) (SK.TEXTURE.AROUND.REGIONS 385692 . 391765) (ALL.EMPTY.REGIONS 391767 . 392257) (
|
||||
TEXTBOX.EXPANDFN 392259 . 399415) (TEXTBOX.INPUTFN 399417 . 401030) (TEXTBOX.INSIDEFN 401032 . 401445)
|
||||
(TEXTBOX.REGIONFN 401447 . 402301) (TEXTBOX.GLOBALREGIONFN 402303 . 402631) (
|
||||
TEXTBOX.SET.GLOBAL.REGIONS 402633 . 403964) (TEXTBOX.TRANSLATEFN 403966 . 405807) (
|
||||
TEXTBOX.TRANSLATEPTSFN 405809 . 408592) (TEXTBOX.TRANSFORMFN 408594 . 410262) (TEXTBOX.UPDATEFN 410264
|
||||
. 412157) (TEXTBOX.READCHANGEFN 412159 . 417048) (SK.TEXTBOX.TEXT.POSITION 417050 . 417471) (
|
||||
SK.TEXTBOX.FROM.TEXT 417473 . 420078) (ADD.EOLS 420080 . 420845)) (421376 424877 (
|
||||
SK.SET.TEXTBOX.VERT.ALIGN 421386 . 423266) (SK.SET.TEXTBOX.HORIZ.ALIGN 423268 . 424875)) (425260
|
||||
469735 (SKETCH.CREATE.BOX 425270 . 425753) (SK.BOX.DRAWFN 425755 . 426914) (BOX.DRAWFN1 426916 .
|
||||
429755) (KNOTS.OF.REGION 429757 . 430991) (SK.DRAWAREABOX 430993 . 437594) (SK.DRAWBOX 437596 . 438785
|
||||
) (SK.BOX.EXPANDFN 438787 . 442535) (SK.BOX.GETREGIONFN 442537 . 443723) (BOX.SET.SCALES 443725 .
|
||||
444965) (SK.BOX.INPUTFN 444967 . 446900) (SK.BOX.CREATE 446902 . 447603) (SK.UPDATE.BOX.AFTER.CHANGE
|
||||
447605 . 448116) (SK.BOX.INSIDEFN 448118 . 448508) (SK.BOX.REGIONFN 448510 . 449223) (
|
||||
SK.BOX.GLOBALREGIONFN 449225 . 449963) (SK.BOX.READCHANGEFN 449965 . 453686) (SK.CHANGE.FILLING 453688
|
||||
. 457636) (SK.CHANGE.FILLING.COLOR 457638 . 461294) (SK.BOX.TRANSLATEFN 461296 . 462475) (
|
||||
SK.BOX.TRANSFORMFN 462477 . 463422) (SK.BOX.TRANSLATEPTSFN 463424 . 465792) (UNSCALE.REGION.TO.GRID
|
||||
465794 . 466719) (INCREASEREGION 466721 . 467312) (INSUREREGIONSIZE 467314 . 468485) (EXPANDREGION
|
||||
468487 . 469367) (REGION.FROM.COORDINATES 469369 . 469733)) (470271 496626 (SKETCH.CREATE.ARC 470281
|
||||
. 471090) (ARC.DRAWFN 471092 . 472819) (ARC.EXPANDFN 472821 . 475154) (ARC.INPUTFN 475156 . 479374) (
|
||||
SK.INVERT.CIRCLE 479376 . 480236) (SK.READ.ARC.ANGLE.POINT 480238 . 480745) (SK.SHOW.ARC 480747 .
|
||||
481357) (ARC.CREATE 481359 . 482714) (SK.UPDATE.ARC.AFTER.CHANGE 482716 . 483056) (ARC.MOVEFN 483058
|
||||
. 484641) (ARC.TRANSLATEPTS 484643 . 486528) (ARC.INSIDEFN 486530 . 486780) (ARC.REGIONFN 486782 .
|
||||
487918) (ARC.GLOBALREGIONFN 487920 . 489642) (ARC.TRANSLATE 489644 . 490626) (ARC.TRANSFORMFN 490628
|
||||
. 493578) (ARC.READCHANGEFN 493580 . 496624)) (496627 505706 (SK.COMPUTE.ARC.ANGLE.PT 496637 . 497563
|
||||
) (SK.COMPUTE.ARC.ANGLE.PT.FROM.ANGLE 497565 . 498558) (SK.COMPUTE.ARC.PTS 498560 . 502132) (
|
||||
SK.SET.ARC.DIRECTION 502134 . 502708) (SK.SET.ARC.DIRECTION.CW 502710 . 502884) (
|
||||
SK.SET.ARC.DIRECTION.CCW 502886 . 503159) (SK.COMPUTE.SLOPE.OF.LINE 503161 . 503653) (
|
||||
SK.CREATE.ARC.USING 503655 . 504892) (SET.ARC.SCALES 504894 . 505704)) (505707 506152 (
|
||||
SK.INSURE.DIRECTION 505717 . 506150)) (507523 553382 (GETSKETCHELEMENTPROP 507533 . 508841) (
|
||||
\SK.GET.ARC.ANGLEPT 508843 . 509404) (\GETSKETCHELEMENTPROP1 509406 . 509660) (\SK.GET.BRUSH 509662 .
|
||||
510586) (\SK.GET.FILLING 510588 . 511686) (\SK.GET.ARROWHEADS 511688 . 512467) (\SK.GET.FONT 512469 .
|
||||
512949) (\SK.GET.JUSTIFICATION 512951 . 513475) (\SK.GET.DIRECTION 513477 . 513954) (\SK.GET.DASHING
|
||||
513956 . 514975) (PUTSKETCHELEMENTPROP 514977 . 517246) (\SK.PUT.FILLING 517248 . 518518) (
|
||||
ADDSKETCHELEMENTPROP 518520 . 519325) (REMOVESKETCHELEMENTPROP 519327 . 520116) (\SK.PUT.FONT 520118
|
||||
. 520932) (\SK.PUT.JUSTIFICATION 520934 . 521945) (\SK.PUT.DIRECTION 521947 . 522554) (
|
||||
\SK.PUT.DASHING 522556 . 523891) (\SK.PUT.BRUSH 523893 . 525812) (\SK.PUT.ARROWHEADS 525814 . 527780)
|
||||
(SK.COPY.ELEMENT.PROPERTY.LIST 527782 . 528358) (SKETCH.UPDATE 528360 . 529090) (SKETCH.UPDATE1 529092
|
||||
. 530380) (\SKELT.GET.SCALE 530382 . 531370) (\SKELT.PUT.SCALE 531372 . 532679) (\SKELT.PUT.DATA
|
||||
532681 . 534478) (SK.REPLACE.TEXT.IN.ELEMENT 534480 . 535433) (\SKELT.GET.DATA 535435 . 536502) (
|
||||
\SK.GET.1STCONTROLPT 536504 . 538016) (\SK.PUT.1STCONTROLPT 538018 . 543491) (\SK.GET.2NDCONTROLPT
|
||||
543493 . 544408) (\SK.PUT.2NDCONTROLPT 544410 . 548598) (\SK.GET.3RDCONTROLPT 548600 . 549478) (
|
||||
\SK.PUT.3RDCONTROLPT 549480 . 553380)) (553383 553964 (LOWERLEFTCORNER 553393 . 553639) (
|
||||
UPPERRIGHTCORNER 553641 . 553962)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,51 +1,51 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Feb-2021 23:02:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TABLEBROWSER.;4 57889
|
||||
|
||||
changes to%: (VARS TABLEBROWSERCOMS)
|
||||
(FILECREATED " 6-Aug-2022 18:06:57" {DSK}<home>larry>medley>library>TABLEBROWSER.;8 63740
|
||||
|
||||
previous date%: " 1-Dec-2018 17:25:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TABLEBROWSER.;3)
|
||||
:CHANGES-TO (VARS TABLEBROWSERCOMS)
|
||||
(RECORDS TABLEBROWSER TABLEITEM)
|
||||
|
||||
:PREVIOUS-DATE " 4-Aug-2022 09:32:17" {DSK}<home>larry>medley>library>TABLEBROWSER.;7)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
Copyright (c) 1985-1988, 1990, 1993-1995, 1999, 2018, 2021-2022 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TABLEBROWSERCOMS)
|
||||
|
||||
(RPAQQ TABLEBROWSERCOMS
|
||||
((COMS (* ; "Entries")
|
||||
((COMS (* ; "Entries")
|
||||
(FNS TB.MAKE.BROWSER TB.REPLACE.ITEMS)
|
||||
(FNS TB.DELETE.ITEM TB.UNDELETE.ITEM TB.INSERT.ITEM TB.REMOVE.ITEM TB.NORMALIZE.ITEM
|
||||
TB.REDISPLAY.ITEMS TB.SELECT.ITEM TB.UNSELECT.ITEM TB.UNSELECT.ALL.ITEMS)
|
||||
(FNS TB.NUMBER.OF.ITEMS TB.NTH.ITEM TB.COLLECT.ITEMS TB.MAP.ITEMS TB.MAP.DELETED.ITEMS
|
||||
TB.MAP.SELECTED.ITEMS TB.FIND.ITEM TB.ITEM.SELECTED? TB.ITEM.DELETED?)
|
||||
(FNS TB.CLEAR.LINE TB.USERDATA TB.WINDOW))
|
||||
(COMS (* ; "Display")
|
||||
(COMS (* ; "Display")
|
||||
(FNS TB.REPAINTFN TB.RESHAPEFN TB.SCROLLFN TB.DISPLAY.LINES TB.PRINT.LINE
|
||||
TB.FIRST.VISIBLE.ITEM# TB.LAST.VISIBLE.ITEM# TB.ITEM.VISIBLE? TB.ITEM.FROM.YCOORD
|
||||
TB.BOTTOM.OF.ITEM TB.SHOW.DELETION TB.SHOW.SELECTION TB.UPDATE.DISPLAY
|
||||
TB.ITEM.UPDATABLE?))
|
||||
(COMS (* ; "Selection")
|
||||
(COMS (* ; "Selection")
|
||||
(FNS TB.BUTTONEVENTFN TB.DO.UNLESS.BUSY TB.DO.ITEM.SELECTION TB.CONTIGUOUS.SELP
|
||||
TB.DECONSIDERRANGE TB.CONSIDERRANGE TB.DESELECTRANGE TB.RECONSIDERRANGE
|
||||
TB.SELECTRANGE TB.UNDOSELECTION TB.FIND.SELECTED.ITEM TB.REV.FIND.SELECTED.ITEM)
|
||||
(FNS TB.COPYBUTTONEVENTFN TB.SHOW.COPY.SELECTION))
|
||||
(COMS (* ; "Misc state change")
|
||||
(COMS (* ; "Misc state change")
|
||||
(FNS TB.BROWSER.BUSY TB.CLOSE/SHRINK TB.CLOSEFN TB.FINISH.CLOSE TB.FLUSH.WINDOW
|
||||
TB.SET.FONT TB.SHRINKFN TB.EXPANDFN TB.FIND.PREVIOUS.TAIL TB.RENUMBER.TAIL))
|
||||
(COMS (* ; "Misc")
|
||||
(COMS (* ; "Misc")
|
||||
(FNS TB.PROCESS)
|
||||
(INITVARS (TB.DELETEDLINEHEIGHT 1))
|
||||
(VARS TB.SELECTION.BITMAP)
|
||||
(CURSORS TB.CROSSCURSOR)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS TB.LEFT.MARGIN)
|
||||
(CONSTANTS * TOCSTATES)
|
||||
(MACROS .COPYKEYDOWNP.)
|
||||
(GLOBALVARS TB.CROSSCURSOR TB.SELECTION.BITMAP TB.DELETEDLINEHEIGHT)
|
||||
(LOCALVARS . T)))
|
||||
(LOCALVARS . T)
|
||||
(RECORDS TABLEBROWSER TABLEITEM)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA TB.USERDATA)))
|
||||
@@ -375,19 +375,23 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(RPAQ TB.CROSSCURSOR (CURSORCREATE (QUOTE #*(16 16)L@@CN@@GG@@NCHALALCH@NG@@GN@@CL@@CL@@GN@@NG@ALCHCHALG@@NN@@GL@@C
|
||||
) (QUOTE NIL) 8 8))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(FILESLOAD (SOURCE)
|
||||
TABLEBROWSERDECLS)
|
||||
(RPAQQ TB.LEFT.MARGIN 8)
|
||||
|
||||
|
||||
(CONSTANTS TB.LEFT.MARGIN)
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ TOCSTATES ((TS.IDLE 0)
|
||||
(TS.REPLACING 1)
|
||||
(TS.ADDING 2)
|
||||
(TS.REMOVING 3)
|
||||
(TS.EXTENDING.HI 4)
|
||||
(TS.EXTENDING.LO 5)
|
||||
(TS.SHRINKING.HI 6)
|
||||
(TS.SHRINKING.LO 7)))
|
||||
(TS.REPLACING 1)
|
||||
(TS.ADDING 2)
|
||||
(TS.REMOVING 3)
|
||||
(TS.EXTENDING.HI 4)
|
||||
(TS.EXTENDING.LO 5)
|
||||
(TS.SHRINKING.HI 6)
|
||||
(TS.SHRINKING.LO 7)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ TS.IDLE 0)
|
||||
@@ -420,8 +424,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
|
||||
(KEYDOWNP 'RSHIFT)
|
||||
(KEYDOWNP 'COPY])
|
||||
(KEYDOWNP 'RSHIFT)
|
||||
(KEYDOWNP 'COPY])
|
||||
)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -433,30 +437,80 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
(DATATYPE TABLEBROWSER ((TBREADY FLAG)
|
||||
(TBHEIGHTEXPLICIT FLAG) (* ;
|
||||
"True if creator set explicit item height or baseline")
|
||||
(TBITEMS POINTER) (* ; "List of items in this browser")
|
||||
(TB#ITEMS WORD) (* ; "Number of items")
|
||||
(TB#DELETED WORD) (* ; "Number of items marked deleted")
|
||||
(TB#LINESPERITEM WORD) (* ;
|
||||
"Number of lines occupied by each item, normally 1 (dunno if any other values work)")
|
||||
(TBFIRSTSELECTEDITEM WORD) (* ;
|
||||
"Number of first selected item. If none selected, is > TB#ITEMS")
|
||||
(TBLASTSELECTEDITEM WORD) (* ;
|
||||
"Number of last selected item. If none selected, is 0")
|
||||
(TBITEMHEIGHT WORD) (* ;
|
||||
"Height of an item, i.e., fontheight*linesperitem")
|
||||
(TBMAXXPOS WORD) (* ;
|
||||
"The largest x-position a user printfn has printed to")
|
||||
(TBFONTHEIGHT WORD) (* ; "Height, ascent, descent of font")
|
||||
(TBFONTASCENT WORD)
|
||||
(TBBASELINE WORD)
|
||||
(TBWINDOW POINTER) (* ;
|
||||
"Pointer to the display window. Need to snap this link when browser is closed")
|
||||
(TBLOCK POINTER) (* ;
|
||||
"Monitor lock guarding some browser operations")
|
||||
(TBUSERDATA POINTER) (* ; "Arbitrary user storage")
|
||||
(TBFONT POINTER) (* ; "Pointer to font used by display")
|
||||
(TBEXTENT POINTER) (* ;
|
||||
"Window's extent, updated as items are added, deleted, or printfn prints farther to right")
|
||||
(TBUPDATEFROMHERE POINTER) (* ;
|
||||
"If changes have occurred while shrunk, this gives the # of first item that needs redisplay")
|
||||
(TBCOLUMNS POINTER) (* ;
|
||||
"Number of columns--not yet implemented")
|
||||
(TBPRINTFN POINTER) (* ;
|
||||
"(Browser Item Window) -- displays Item at current line position in window")
|
||||
(TBCOPYFN POINTER) (* ;
|
||||
"(Browser Item) -- copy selects Item")
|
||||
(TBFONTCHANGEFN POINTER) (* ;
|
||||
"(Browser Window) -- called when tb.set.font changes the font")
|
||||
(TBCLOSEFN POINTER) (* ;
|
||||
"(Browser Window Close/Shrink) -- called when you try to close or shrink window")
|
||||
(TBAFTERCLOSEFN POINTER) (* ;
|
||||
"(Browser Window) -- called to cleanup AFTER a closew")
|
||||
(TBTITLEEVENTFN POINTER) (* ;
|
||||
"(Window Browser) -- handles button event in browser's title")
|
||||
(TBLINETHICKNESS POINTER) (* ;
|
||||
"Thickness of line for deletions (normally 1)")
|
||||
(TBORIGIN POINTER) (* ;
|
||||
"Y position of the top of the first item")
|
||||
(TBTAILHINT POINTER) (* ;
|
||||
"A tail of TBITEMS, used to speed up TB.NTH.ITEM")
|
||||
(TBHEADINGWINDOW POINTER) (* ;
|
||||
"An optional %"header window%" that should be horizontally scrolled in synchrony with this one")
|
||||
(NIL POINTER)))
|
||||
|
||||
(ADDTOVAR LAMA TB.USERDATA)
|
||||
(DATATYPE TABLEITEM ((TISELECTED FLAG)
|
||||
(TIDELETED FLAG)
|
||||
(TIUNDELETABLE FLAG)
|
||||
(TIUNSELECTABLE FLAG)
|
||||
(TIUNCOPYSELECTABLE FLAG)
|
||||
(TIDATA POINTER)
|
||||
(TI# WORD)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEBROWSER
|
||||
'(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD
|
||||
WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)
|
||||
'(FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER)
|
||||
'((TABLEBROWSER 0 (FLAGBITS . 0))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 16))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 32))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 48))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 64))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 80))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 96))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 112))
|
||||
(TABLEBROWSER 2 POINTER)
|
||||
(TABLEBROWSER 1 (BITS . 15))
|
||||
(TABLEBROWSER 0 POINTER)
|
||||
(TABLEBROWSER 2 (BITS . 15))
|
||||
(TABLEBROWSER 3 (BITS . 15))
|
||||
(TABLEBROWSER 4 (BITS . 15))
|
||||
(TABLEBROWSER 5 (BITS . 15))
|
||||
(TABLEBROWSER 6 (BITS . 15))
|
||||
@@ -465,7 +519,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(TABLEBROWSER 9 (BITS . 15))
|
||||
(TABLEBROWSER 10 (BITS . 15))
|
||||
(TABLEBROWSER 11 (BITS . 15))
|
||||
(TABLEBROWSER 12 (BITS . 15))
|
||||
(TABLEBROWSER 12 POINTER)
|
||||
(TABLEBROWSER 14 POINTER)
|
||||
(TABLEBROWSER 16 POINTER)
|
||||
(TABLEBROWSER 18 POINTER)
|
||||
@@ -482,91 +536,139 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1993, 1994, 1995, 1999, 2018, 2021 b
|
||||
(TABLEBROWSER 40 POINTER)
|
||||
(TABLEBROWSER 42 POINTER)
|
||||
(TABLEBROWSER 44 POINTER)
|
||||
(TABLEBROWSER 46 POINTER)
|
||||
(TABLEBROWSER 48 POINTER))
|
||||
'50)
|
||||
(TABLEBROWSER 46 POINTER))
|
||||
'48)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEITEM '(FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD)
|
||||
(/DECLAREDATATYPE 'TABLEITEM '(FLAG FLAG FLAG FLAG FLAG POINTER WORD)
|
||||
'((TABLEITEM 0 (FLAGBITS . 0))
|
||||
(TABLEITEM 0 (FLAGBITS . 16))
|
||||
(TABLEITEM 0 (FLAGBITS . 32))
|
||||
(TABLEITEM 0 (FLAGBITS . 48))
|
||||
(TABLEITEM 0 (FLAGBITS . 64))
|
||||
(TABLEITEM 0 (FLAGBITS . 80))
|
||||
(TABLEITEM 0 (FLAGBITS . 96))
|
||||
(TABLEITEM 0 (FLAGBITS . 112))
|
||||
(TABLEITEM 2 POINTER)
|
||||
(TABLEITEM 1 (BITS . 15))
|
||||
(TABLEITEM 4 (BITS . 15)))
|
||||
'6)
|
||||
(TABLEITEM 1 (BITS . 15)))
|
||||
'4)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
|
||||
(ADDTOVAR NLAML )
|
||||
|
||||
(ADDTOVAR LAMA TB.USERDATA)
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEBROWSER
|
||||
'(FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER POINTER POINTER POINTER)
|
||||
'((TABLEBROWSER 0 (FLAGBITS . 0))
|
||||
(TABLEBROWSER 0 (FLAGBITS . 16))
|
||||
(TABLEBROWSER 0 POINTER)
|
||||
(TABLEBROWSER 2 (BITS . 15))
|
||||
(TABLEBROWSER 3 (BITS . 15))
|
||||
(TABLEBROWSER 4 (BITS . 15))
|
||||
(TABLEBROWSER 5 (BITS . 15))
|
||||
(TABLEBROWSER 6 (BITS . 15))
|
||||
(TABLEBROWSER 7 (BITS . 15))
|
||||
(TABLEBROWSER 8 (BITS . 15))
|
||||
(TABLEBROWSER 9 (BITS . 15))
|
||||
(TABLEBROWSER 10 (BITS . 15))
|
||||
(TABLEBROWSER 11 (BITS . 15))
|
||||
(TABLEBROWSER 12 POINTER)
|
||||
(TABLEBROWSER 14 POINTER)
|
||||
(TABLEBROWSER 16 POINTER)
|
||||
(TABLEBROWSER 18 POINTER)
|
||||
(TABLEBROWSER 20 POINTER)
|
||||
(TABLEBROWSER 22 POINTER)
|
||||
(TABLEBROWSER 24 POINTER)
|
||||
(TABLEBROWSER 26 POINTER)
|
||||
(TABLEBROWSER 28 POINTER)
|
||||
(TABLEBROWSER 30 POINTER)
|
||||
(TABLEBROWSER 32 POINTER)
|
||||
(TABLEBROWSER 34 POINTER)
|
||||
(TABLEBROWSER 36 POINTER)
|
||||
(TABLEBROWSER 38 POINTER)
|
||||
(TABLEBROWSER 40 POINTER)
|
||||
(TABLEBROWSER 42 POINTER)
|
||||
(TABLEBROWSER 44 POINTER)
|
||||
(TABLEBROWSER 46 POINTER))
|
||||
'48)
|
||||
|
||||
(/DECLAREDATATYPE 'TABLEITEM '(FLAG FLAG FLAG FLAG FLAG POINTER WORD)
|
||||
'((TABLEITEM 0 (FLAGBITS . 0))
|
||||
(TABLEITEM 0 (FLAGBITS . 16))
|
||||
(TABLEITEM 0 (FLAGBITS . 32))
|
||||
(TABLEITEM 0 (FLAGBITS . 48))
|
||||
(TABLEITEM 0 (FLAGBITS . 64))
|
||||
(TABLEITEM 2 POINTER)
|
||||
(TABLEITEM 1 (BITS . 15)))
|
||||
'4)
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE TABLEBROWSER ((TBREADY FLAG)
|
||||
(TBHEIGHTEXPLICIT FLAG)
|
||||
(NIL 6 FLAG)
|
||||
(TBITEMS POINTER)
|
||||
(TB#ITEMS WORD)
|
||||
(TB#DELETED WORD)
|
||||
(TB#LINESPERITEM WORD)
|
||||
(TBFIRSTSELECTEDITEM WORD)
|
||||
(TBLASTSELECTEDITEM WORD)
|
||||
(TBITEMHEIGHT WORD)
|
||||
(TBMAXXPOS WORD)
|
||||
(TBFONTHEIGHT WORD)
|
||||
(TBFONTASCENT WORD)
|
||||
(TBBASELINE WORD)
|
||||
(TBWINDOW POINTER)
|
||||
(TBLOCK POINTER)
|
||||
(TBUSERDATA POINTER)
|
||||
(TBFONT POINTER)
|
||||
(TBEXTENT POINTER)
|
||||
(TBUPDATEFROMHERE POINTER)
|
||||
(TBCOLUMNS POINTER)
|
||||
(TBPRINTFN POINTER)
|
||||
(TBCOPYFN POINTER)
|
||||
(TBFONTCHANGEFN POINTER)
|
||||
(TBCLOSEFN POINTER)
|
||||
(TBAFTERCLOSEFN POINTER)
|
||||
(TBTITLEEVENTFN POINTER)
|
||||
(TBLINETHICKNESS POINTER)
|
||||
(TBORIGIN POINTER)
|
||||
(TBTAILHINT POINTER)
|
||||
(TBHEADINGWINDOW POINTER)
|
||||
(NIL POINTER)))
|
||||
(TBHEIGHTEXPLICIT FLAG)
|
||||
(TBITEMS POINTER)
|
||||
(TB#ITEMS WORD)
|
||||
(TB#DELETED WORD)
|
||||
(TB#LINESPERITEM WORD)
|
||||
(TBFIRSTSELECTEDITEM WORD)
|
||||
(TBLASTSELECTEDITEM WORD)
|
||||
(TBITEMHEIGHT WORD)
|
||||
(TBMAXXPOS WORD)
|
||||
(TBFONTHEIGHT WORD)
|
||||
(TBFONTASCENT WORD)
|
||||
(TBBASELINE WORD)
|
||||
(TBWINDOW POINTER)
|
||||
(TBLOCK POINTER)
|
||||
(TBUSERDATA POINTER)
|
||||
(TBFONT POINTER)
|
||||
(TBEXTENT POINTER)
|
||||
(TBUPDATEFROMHERE POINTER)
|
||||
(TBCOLUMNS POINTER)
|
||||
(TBPRINTFN POINTER)
|
||||
(TBCOPYFN POINTER)
|
||||
(TBFONTCHANGEFN POINTER)
|
||||
(TBCLOSEFN POINTER)
|
||||
(TBAFTERCLOSEFN POINTER)
|
||||
(TBTITLEEVENTFN POINTER)
|
||||
(TBLINETHICKNESS POINTER)
|
||||
(TBORIGIN POINTER)
|
||||
(TBTAILHINT POINTER)
|
||||
(TBHEADINGWINDOW POINTER)
|
||||
(NIL POINTER)))
|
||||
|
||||
(DATATYPE TABLEITEM ((TISELECTED FLAG)
|
||||
(TIDELETED FLAG)
|
||||
(TIUNDELETABLE FLAG)
|
||||
(TIUNSELECTABLE FLAG)
|
||||
(TIUNCOPYSELECTABLE FLAG)
|
||||
(NIL 3 FLAG)
|
||||
(TIDATA POINTER)
|
||||
(TI# WORD)
|
||||
(NIL WORD)))
|
||||
(TIDELETED FLAG)
|
||||
(TIUNDELETABLE FLAG)
|
||||
(TIUNSELECTABLE FLAG)
|
||||
(TIUNCOPYSELECTABLE FLAG)
|
||||
(TIDATA POINTER)
|
||||
(TI# WORD)))
|
||||
)
|
||||
(PUTPROPS TABLEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 1994 1995
|
||||
1999 2018 2021))
|
||||
1999 2018 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3214 7565 (TB.MAKE.BROWSER 3224 . 6340) (TB.REPLACE.ITEMS 6342 . 7563)) (7566 16585 (
|
||||
TB.DELETE.ITEM 7576 . 8010) (TB.UNDELETE.ITEM 8012 . 8591) (TB.INSERT.ITEM 8593 . 10600) (
|
||||
TB.REMOVE.ITEM 10602 . 12134) (TB.NORMALIZE.ITEM 12136 . 12849) (TB.REDISPLAY.ITEMS 12851 . 15170) (
|
||||
TB.SELECT.ITEM 15172 . 15477) (TB.UNSELECT.ITEM 15479 . 15834) (TB.UNSELECT.ALL.ITEMS 15836 . 16583))
|
||||
(16586 21112 (TB.NUMBER.OF.ITEMS 16596 . 17078) (TB.NTH.ITEM 17080 . 18154) (TB.COLLECT.ITEMS 18156 .
|
||||
18527) (TB.MAP.ITEMS 18529 . 18893) (TB.MAP.DELETED.ITEMS 18895 . 19342) (TB.MAP.SELECTED.ITEMS 19344
|
||||
. 19951) (TB.FIND.ITEM 19953 . 20826) (TB.ITEM.SELECTED? 20828 . 20969) (TB.ITEM.DELETED? 20971 .
|
||||
21110)) (21113 21954 (TB.CLEAR.LINE 21123 . 21535) (TB.USERDATA 21537 . 21803) (TB.WINDOW 21805 .
|
||||
21952)) (21979 32237 (TB.REPAINTFN 21989 . 22400) (TB.RESHAPEFN 22402 . 23240) (TB.SCROLLFN 23242 .
|
||||
23793) (TB.DISPLAY.LINES 23795 . 25052) (TB.PRINT.LINE 25054 . 25574) (TB.FIRST.VISIBLE.ITEM# 25576 .
|
||||
26013) (TB.LAST.VISIBLE.ITEM# 26015 . 26488) (TB.ITEM.VISIBLE? 26490 . 27010) (TB.ITEM.FROM.YCOORD
|
||||
27012 . 27322) (TB.BOTTOM.OF.ITEM 27324 . 27737) (TB.SHOW.DELETION 27739 . 28361) (TB.SHOW.SELECTION
|
||||
28363 . 29132) (TB.UPDATE.DISPLAY 29134 . 31419) (TB.ITEM.UPDATABLE? 31421 . 32235)) (32264 43677 (
|
||||
TB.BUTTONEVENTFN 32274 . 32733) (TB.DO.UNLESS.BUSY 32735 . 33042) (TB.DO.ITEM.SELECTION 33044 . 39118)
|
||||
(TB.CONTIGUOUS.SELP 39120 . 39487) (TB.DECONSIDERRANGE 39489 . 39857) (TB.CONSIDERRANGE 39859 . 40430
|
||||
) (TB.DESELECTRANGE 40432 . 41494) (TB.RECONSIDERRANGE 41496 . 41994) (TB.SELECTRANGE 41996 . 42936) (
|
||||
TB.UNDOSELECTION 42938 . 43215) (TB.FIND.SELECTED.ITEM 43217 . 43440) (TB.REV.FIND.SELECTED.ITEM 43442
|
||||
. 43675)) (43678 45177 (TB.COPYBUTTONEVENTFN 43688 . 44908) (TB.SHOW.COPY.SELECTION 44910 . 45175)) (
|
||||
45212 51519 (TB.BROWSER.BUSY 45222 . 45339) (TB.CLOSE/SHRINK 45341 . 45973) (TB.CLOSEFN 45975 . 46076)
|
||||
(TB.FINISH.CLOSE 46078 . 46731) (TB.FLUSH.WINDOW 46733 . 47260) (TB.SET.FONT 47262 . 49560) (
|
||||
TB.SHRINKFN 49562 . 49665) (TB.EXPANDFN 49667 . 50432) (TB.FIND.PREVIOUS.TAIL 50434 . 51176) (
|
||||
TB.RENUMBER.TAIL 51178 . 51517)) (51541 51914 (TB.PROCESS 51551 . 51912)))))
|
||||
(FILEMAP (NIL (3194 7545 (TB.MAKE.BROWSER 3204 . 6320) (TB.REPLACE.ITEMS 6322 . 7543)) (7546 16565 (
|
||||
TB.DELETE.ITEM 7556 . 7990) (TB.UNDELETE.ITEM 7992 . 8571) (TB.INSERT.ITEM 8573 . 10580) (
|
||||
TB.REMOVE.ITEM 10582 . 12114) (TB.NORMALIZE.ITEM 12116 . 12829) (TB.REDISPLAY.ITEMS 12831 . 15150) (
|
||||
TB.SELECT.ITEM 15152 . 15457) (TB.UNSELECT.ITEM 15459 . 15814) (TB.UNSELECT.ALL.ITEMS 15816 . 16563))
|
||||
(16566 21092 (TB.NUMBER.OF.ITEMS 16576 . 17058) (TB.NTH.ITEM 17060 . 18134) (TB.COLLECT.ITEMS 18136 .
|
||||
18507) (TB.MAP.ITEMS 18509 . 18873) (TB.MAP.DELETED.ITEMS 18875 . 19322) (TB.MAP.SELECTED.ITEMS 19324
|
||||
. 19931) (TB.FIND.ITEM 19933 . 20806) (TB.ITEM.SELECTED? 20808 . 20949) (TB.ITEM.DELETED? 20951 .
|
||||
21090)) (21093 21934 (TB.CLEAR.LINE 21103 . 21515) (TB.USERDATA 21517 . 21783) (TB.WINDOW 21785 .
|
||||
21932)) (21959 32217 (TB.REPAINTFN 21969 . 22380) (TB.RESHAPEFN 22382 . 23220) (TB.SCROLLFN 23222 .
|
||||
23773) (TB.DISPLAY.LINES 23775 . 25032) (TB.PRINT.LINE 25034 . 25554) (TB.FIRST.VISIBLE.ITEM# 25556 .
|
||||
25993) (TB.LAST.VISIBLE.ITEM# 25995 . 26468) (TB.ITEM.VISIBLE? 26470 . 26990) (TB.ITEM.FROM.YCOORD
|
||||
26992 . 27302) (TB.BOTTOM.OF.ITEM 27304 . 27717) (TB.SHOW.DELETION 27719 . 28341) (TB.SHOW.SELECTION
|
||||
28343 . 29112) (TB.UPDATE.DISPLAY 29114 . 31399) (TB.ITEM.UPDATABLE? 31401 . 32215)) (32244 43657 (
|
||||
TB.BUTTONEVENTFN 32254 . 32713) (TB.DO.UNLESS.BUSY 32715 . 33022) (TB.DO.ITEM.SELECTION 33024 . 39098)
|
||||
(TB.CONTIGUOUS.SELP 39100 . 39467) (TB.DECONSIDERRANGE 39469 . 39837) (TB.CONSIDERRANGE 39839 . 40410
|
||||
) (TB.DESELECTRANGE 40412 . 41474) (TB.RECONSIDERRANGE 41476 . 41974) (TB.SELECTRANGE 41976 . 42916) (
|
||||
TB.UNDOSELECTION 42918 . 43195) (TB.FIND.SELECTED.ITEM 43197 . 43420) (TB.REV.FIND.SELECTED.ITEM 43422
|
||||
. 43655)) (43658 45157 (TB.COPYBUTTONEVENTFN 43668 . 44888) (TB.SHOW.COPY.SELECTION 44890 . 45155)) (
|
||||
45192 51499 (TB.BROWSER.BUSY 45202 . 45319) (TB.CLOSE/SHRINK 45321 . 45953) (TB.CLOSEFN 45955 . 46056)
|
||||
(TB.FINISH.CLOSE 46058 . 46711) (TB.FLUSH.WINDOW 46713 . 47240) (TB.SET.FONT 47242 . 49540) (
|
||||
TB.SHRINKFN 49542 . 49645) (TB.EXPANDFN 49647 . 50412) (TB.FIND.PREVIOUS.TAIL 50414 . 51156) (
|
||||
TB.RENUMBER.TAIL 51158 . 51497)) (51521 51894 (TB.PROCESS 51531 . 51892)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
315
library/UNIXCOMM
315
library/UNIXCOMM
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Jul-2022 10:42:46"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;6 20326
|
||||
(FILECREATED "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11 14599
|
||||
|
||||
:CHANGES-TO (FNS INITIALIZE-NEW-SHELL-DEVICE)
|
||||
:CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
|
||||
(VARS UNIXCOMMCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jul-2022 16:16:31"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>UNIXCOMM.;5)
|
||||
:PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -26,10 +25,10 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(FNS FORK-SHELL FORK-UNIX UNIX-KILL UNIX-WRITE CREATE-SHELL-STREAM
|
||||
CREATE-PROCESS-STREAM UNIXCOMM-AROUNDEXITFN))
|
||||
[COMS (* ; "Operations on the shell device")
|
||||
(FNS INITIALIZE-NEW-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR-NEW
|
||||
UNIX-STREAM-EOFP-NEW UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
|
||||
(GLOBALVARS *NEW-SHELL-DEVICE*)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-NEW-SHELL-DEVICE))
|
||||
(FNS INITIALIZE-SHELL-DEVICE UNIX-GET-NEXT-BUFFER UNIX-BACKFILEPTR UNIX-STREAM-EOFP
|
||||
UNIX-STREAM-OUT UNIX-STREAM-CLOSE)
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE))
|
||||
(ADDVARS (AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN]
|
||||
(COMS (* ;
|
||||
"Stuff for direct manipulation of Unix sockets")
|
||||
@@ -37,14 +36,6 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-CHANNEL)
|
||||
(P (CHECKIMPORTS '(FILEIO LLSUBRS)
|
||||
T)))
|
||||
[COMS
|
||||
(* ;; "Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device")
|
||||
|
||||
(FNS UNIX-BACKFILEPTR UNIX-READ INITIALIZE-SHELL-DEVICE UNIX-STREAM-IN UNIX-STREAM-EOFP
|
||||
UNIX-STREAM-PEEK)
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNIX-PEEKEDCHAR UNIX-LASTCHAR))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITIALIZE-SHELL-DEVICE]
|
||||
(PROP FILETYPE UNIXCOMM)))
|
||||
|
||||
|
||||
@@ -108,24 +99,17 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(RETURN LENGTH-WRITTEN])
|
||||
|
||||
(CREATE-SHELL-STREAM
|
||||
[LAMBDA (TERMTYPE COMMAND) (* ; "Edited 21-May-90 15:39 by jrb:")
|
||||
(LET ((CHAN (FORK-SHELL TERMTYPE COMMAND))
|
||||
(SHELL-DEV (if (SUBRCALL UNIX-HANDLECOMM 8)
|
||||
then (* ;
|
||||
"SUBRCALL tests that this is supported")
|
||||
*NEW-SHELL-DEVICE*
|
||||
else *SHELL-DEVICE*)))
|
||||
[LAMBDA (TERMTYPE COMMAND) (* ; "Edited 11-Oct-2022 09:56 by lmm")
|
||||
(* ; "Edited 21-May-90 15:39 by jrb:")
|
||||
(LET ((CHAN (FORK-SHELL TERMTYPE COMMAND)))
|
||||
(COND
|
||||
(CHAN (LET ((STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ SHELL-DEV)))
|
||||
DEVICE _ *SHELL-DEVICE*)))
|
||||
(CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR)
|
||||
(STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
|
||||
(STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
|
||||
STR])
|
||||
@@ -133,47 +117,38 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(CREATE-PROCESS-STREAM
|
||||
[LAMBDA (COMM)
|
||||
|
||||
(* ;; "Edited 11-Oct-2022 10:05 by lmm")
|
||||
|
||||
(* ;; "Edited 8-Oct-2022 16:04 by lmm")
|
||||
|
||||
(* ;; "Edited 3-Jul-2022 16:04 by rmk: Removed external format here, the device has the environmental defaultg")
|
||||
|
||||
(* ;; "Edited 26-Jun-2022 13:52 by larry")
|
||||
|
||||
(* ;; "Edited 26-Jun-2022 13:31 by lmm - set external format of shell stream to utf-8 ??")
|
||||
|
||||
(* ;; "Edited 21-May-90 15:39 by jrb:")
|
||||
|
||||
(LET* ((SHELL-DEV (if (AND (BOUNDP '*NEW-SHELL-DEVICE)
|
||||
(SUBRCALL UNIX-HANDLECOMM 8))
|
||||
then (* ;
|
||||
"SUBRCALL tests that this is supported")
|
||||
*NEW-SHELL-DEVICE*
|
||||
else *SHELL-DEVICE*))
|
||||
(STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ SHELL-DEV
|
||||
EOLCONVENTION _ LF.EOLC))
|
||||
(CHAN (FORK-UNIX COMM)))
|
||||
(if CHAN
|
||||
then (CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR
|
||||
else NIL])
|
||||
(LET ((CHAN (FORK-UNIX COMM)))
|
||||
(if CHAN
|
||||
then (LET ((STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC)))
|
||||
(CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR])
|
||||
|
||||
(UNIXCOMM-AROUNDEXITFN
|
||||
[LAMBDA (EVENT) (* ; "Edited 2-Jul-90 16:35 by jrb:")
|
||||
[LAMBDA (EVENT) (* ; "Edited 25-Oct-2022 21:20 by lmm")
|
||||
(* ; "Edited 11-Oct-2022 10:07 by lmm")
|
||||
(* ; "Edited 2-Jul-90 16:35 by jrb:")
|
||||
(CASE EVENT
|
||||
((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT) (for STREAM
|
||||
in (fetch (FDEV OPENFILELST)
|
||||
of *SHELL-DEVICE*)
|
||||
do (CLOSEF STREAM)))
|
||||
((AFTERLOGOUT AFTERMAKESYS AFTERSAVEVM AFTERSYSOUT)
|
||||
(for STREAM in (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*) do (CLOSEF STREAM))
|
||||
(REPLACE (FDEV DEFAULTEXTERNALFORMAT) OF *SHELL-DEVICE* WITH (SYSTEM-EXTERNALFORMAT)))
|
||||
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT)
|
||||
|
||||
(* ;;
|
||||
"Make sure any Unix sockets get closed here, so their file system handles get closed as well")
|
||||
(* ;;
|
||||
"Make sure any Unix sockets get closed here, so their file system handles get closed as well")
|
||||
|
||||
(for STREAM in (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
when (EQ -3 (SUBRCALL UNIX-HANDLECOMM 14 (UNIX-CHANNEL STREAM)))
|
||||
@@ -186,25 +161,27 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(INITIALIZE-NEW-SHELL-DEVICE
|
||||
[LAMBDA NIL (* ; "Edited 7-Jul-2022 10:41 by rmk")
|
||||
(* ; "Edited 3-Jul-2022 16:04 by rmk")
|
||||
(* ; "Edited 12-Feb-90 17:00 by bvm")
|
||||
(SETQ *NEW-SHELL-DEVICE* (create FDEV
|
||||
FDBINABLE _ T
|
||||
NODIRECTORIES _ T
|
||||
DEVICENAME _ (FUNCTION UNIX-PTY-NEW)
|
||||
BIN _ (FUNCTION \BUFFERED.BIN)
|
||||
BOUT _ (FUNCTION UNIX-STREAM-OUT)
|
||||
PEEKBIN _ (FUNCTION \BUFFERED.PEEKBIN)
|
||||
CLOSEFILE _ (FUNCTION UNIX-STREAM-CLOSE)
|
||||
GETFILEINFO _ (FUNCTION NILL)
|
||||
SETFILEINFO _ (FUNCTION NILL)
|
||||
EOFP _ (FUNCTION UNIX-STREAM-EOFP-NEW)
|
||||
BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR-NEW)
|
||||
GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
|
||||
BLOCKIN _ (FUNCTION \BUFFERED.BINS)
|
||||
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
|
||||
(INITIALIZE-SHELL-DEVICE
|
||||
[LAMBDA NIL (* ; "Edited 18-Dec-2022 11:53 by rmk")
|
||||
(* ; "Edited 25-Oct-2022 21:54 by lmm")
|
||||
|
||||
(* ;; "only using for holding open list")
|
||||
(* ; "Edited 3-Jul-2022 16:15 by rmk")
|
||||
(* ; "Edited 14-Dec-88 10:45 by bane")
|
||||
(SETQ *SHELL-DEVICE* (create FDEV
|
||||
NODIRECTORIES _ T
|
||||
DEVICENAME _ 'UNIX-PTY
|
||||
BIN _ (FUNCTION \BUFFERED.BIN)
|
||||
BOUT _ (FUNCTION UNIX-STREAM-OUT)
|
||||
PEEKBIN _ (FUNCTION \BUFFERED.PEEKBIN)
|
||||
CLOSEFILE _ (FUNCTION UNIX-STREAM-CLOSE)
|
||||
GETFILEINFO _ (FUNCTION NILL)
|
||||
SETFILEINFO _ (FUNCTION NILL)
|
||||
EOFP _ (FUNCTION UNIX-STREAM-EOFP)
|
||||
BACKFILEPTR _ (FUNCTION UNIX-BACKFILEPTR)
|
||||
GETNEXTBUFFER _ (FUNCTION UNIX-GET-NEXT-BUFFER)
|
||||
BLOCKIN _ (FUNCTION \BUFFERED.BINS)
|
||||
DEFAULTEXTERNALFORMAT _ (SYSTEM-EXTERNALFORMAT])
|
||||
|
||||
(UNIX-GET-NEXT-BUFFER
|
||||
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* ;
|
||||
@@ -239,22 +216,20 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(\EOF.ACTION STREAM])
|
||||
(T (SHOULDNT)))])
|
||||
|
||||
(UNIX-BACKFILEPTR-NEW
|
||||
[LAMBDA (STREAM) (* ;
|
||||
"Edited 13-Jun-90 01:07 by mitani")
|
||||
(UNIX-BACKFILEPTR
|
||||
[LAMBDA (STREAM) (* ; "Edited 13-Jun-90 01:07 by mitani")
|
||||
(COND
|
||||
((AND (fetch (STREAM CBUFPTR) of STREAM)
|
||||
(> (fetch (STREAM COFFSET) of STREAM)
|
||||
0))
|
||||
(add (fetch (STREAM COFFSET) of STREAM)
|
||||
-1))
|
||||
-1))
|
||||
(T (ERROR "Can't back up this unix Stream" STREAM])
|
||||
|
||||
(UNIX-STREAM-EOFP-NEW
|
||||
[LAMBDA (STREAM) (* ;
|
||||
"Edited 13-Jun-90 01:07 by mitani")
|
||||
(UNIX-STREAM-EOFP
|
||||
[LAMBDA (STREAM) (* ; "Edited 13-Jun-90 01:07 by mitani")
|
||||
|
||||
(* ;;; "true if bsp STREAM is at end of file, i.e. is at a mark")
|
||||
(* ;;; "true if bsp STREAM is at end of file, i.e. is at a mark")
|
||||
|
||||
(COND
|
||||
((AND (ffetch (STREAM CBUFPTR) of (\DTEST STREAM 'STREAM))
|
||||
@@ -279,11 +254,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *NEW-SHELL-DEVICE*)
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INITIALIZE-NEW-SHELL-DEVICE)
|
||||
(INITIALIZE-SHELL-DEVICE)
|
||||
|
||||
|
||||
(ADDTOVAR AROUNDEXITFNS UNIXCOMM-AROUNDEXITFN)
|
||||
@@ -296,25 +271,23 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(CREATE-UNIX-SOCKET-STREAM
|
||||
[LAMBDA (PATHNAME) (* ; "Edited 29-May-90 16:23 by jrb:")
|
||||
(LET [(STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *NEW-SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC))
|
||||
(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
|
||||
[LAMBDA (PATHNAME) (* ; "Edited 11-Oct-2022 10:11 by lmm")
|
||||
(* ; "Edited 29-May-90 16:23 by jrb:")
|
||||
(LET [(CHAN (SUBRCALL UNIX-HANDLECOMM 12 (\DTEST PATHNAME 'ONED-ARRAY]
|
||||
(if CHAN
|
||||
then (CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR
|
||||
else NIL])
|
||||
then (LET ((STR (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC)))
|
||||
(CL:SETF (UNIX-CHANNEL STR)
|
||||
CHAN)
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
STR)
|
||||
STR])
|
||||
|
||||
(ACCEPT-UNIX-SOCKET-STREAM
|
||||
[LAMBDA (SOCKSTREAM) (* ; "Edited 29-May-90 16:31 by jrb:")
|
||||
[LAMBDA (SOCKSTREAM) (* ; "Edited 11-Oct-2022 10:12 by lmm")
|
||||
(* ; "Edited 29-May-90 16:31 by jrb:")
|
||||
(LET ((CHAN (UNIX-CHANNEL SOCKSTREAM))
|
||||
NEWCHAN)
|
||||
(SELECTQ (SETQ NEWCHAN (SUBRCALL UNIX-HANDLECOMM 13 CHAN))
|
||||
@@ -322,15 +295,12 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
NEWCHAN)
|
||||
(LET ((NEWSTREAM (create STREAM
|
||||
ACCESS _ 'BOTH
|
||||
DEVICE _ *NEW-SHELL-DEVICE*
|
||||
DEVICE _ *SHELL-DEVICE*
|
||||
EOLCONVENTION _ LF.EOLC)))
|
||||
(CL:SETF (UNIX-CHANNEL NEWSTREAM)
|
||||
NEWCHAN)
|
||||
|
||||
(* ;; "JRB - In a future release, make *SHELL-DEVICE* below SHELL-DEV, or just remove *SHELL-DEVICE* altogether. Must also hack UNIX-STREAM-CLOSE and the aroundexitfn for Unix streams.")
|
||||
|
||||
(push (fetch (FDEV OPENFILELST) of *SHELL-DEVICE*)
|
||||
NEWSTREAM)
|
||||
NEWSTREAM)
|
||||
NEWSTREAM])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -345,122 +315,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
|
||||
T)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* ;;
|
||||
"Obsolete stuff. This is for pre-Medley1.2, where there wasn't support for buffered input on the shell device"
|
||||
)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(UNIX-BACKFILEPTR
|
||||
[LAMBDA (STREAM) (* ; "Edited 14-Dec-88 09:52 by bane")
|
||||
|
||||
(* ;; "The trick here is to use the existing mechanisms for UNIX-PEEKCHAR")
|
||||
|
||||
(COND
|
||||
((UNIX-PEEKEDCHAR STREAM)
|
||||
(ERROR "Can only back up one character" STREAM))
|
||||
((NOT (UNIX-LASTCHAR STREAM))
|
||||
(ERROR "Can't back up past beginning of stream" STREAM))
|
||||
(T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
(UNIX-LASTCHAR STREAM])
|
||||
|
||||
(UNIX-READ
|
||||
[LAMBDA (STREAM NO-ERROR) (* ; "Edited 14-Dec-88 09:18 by bane")
|
||||
(LET* [(CONN (UNIX-CHANNEL STREAM))
|
||||
(CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
|
||||
0]
|
||||
(COND
|
||||
((EQ CH T)
|
||||
NIL)
|
||||
[(EQ CH NIL)
|
||||
(COND
|
||||
(NO-ERROR NIL)
|
||||
(T (\EOF.ACTION STREAM]
|
||||
(T (CL:SETF (UNIX-LASTCHAR STREAM)
|
||||
CH])
|
||||
|
||||
(INITIALIZE-SHELL-DEVICE
|
||||
[LAMBDA NIL (* ; "Edited 3-Jul-2022 16:15 by rmk")
|
||||
(* ; "Edited 14-Dec-88 10:45 by bane")
|
||||
(SETQ *SHELL-DEVICE* (create FDEV
|
||||
NODIRECTORIES _ T
|
||||
DEVICENAME _ 'UNIX-PTY
|
||||
BIN _ 'UNIX-STREAM-IN
|
||||
BOUT _ 'UNIX-STREAM-OUT
|
||||
PEEKBIN _ 'UNIX-STREAM-PEEK
|
||||
CLOSEFILE _ 'UNIX-STREAM-CLOSE
|
||||
GETFILEINFO _ 'NILL
|
||||
SETFILEINFO _ 'NILL
|
||||
EOFP _ 'UNIX-STREAM-EOFP
|
||||
BACKFILEPTR _ 'UNIX-BACKFILEPTR
|
||||
DEFAULTEXTERNALFORMAT _ (AND (STRPOS ".UTF-8" (UNIX-GETENV "LANG"))
|
||||
:UTF-8])
|
||||
|
||||
(UNIX-STREAM-IN
|
||||
[LAMBDA (STREAM) (* ; "Edited 9-May-88 15:05 by ")
|
||||
(LET (CH)
|
||||
(if (SETQ CH (UNIX-PEEKEDCHAR STREAM))
|
||||
then (CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
NIL)
|
||||
else (while (NOT (SETQ CH (UNIX-READ STREAM))) do (BLOCK)))
|
||||
CH])
|
||||
|
||||
(UNIX-STREAM-EOFP
|
||||
[LAMBDA (STREAM) (* ; "Edited 2-Apr-90 11:51 by jds")
|
||||
|
||||
(* ;; "EOFP method for unix-shell streams. Notices when there are chars yet to read and doesn't set EOFP.")
|
||||
|
||||
(AND (NOT (UNIX-PEEKEDCHAR STREAM))
|
||||
(LET* [(CONN (UNIX-CHANNEL STREAM))
|
||||
(CH (AND CONN (SUBRCALL UNIX-HANDLECOMM 2 (\DTEST CONN 'SMALLP)
|
||||
0]
|
||||
(COND
|
||||
((EQ CH T)
|
||||
NIL)
|
||||
((EQ CH NIL)
|
||||
T)
|
||||
(T (CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
CH)
|
||||
(CL:SETF (UNIX-LASTCHAR STREAM)
|
||||
CH)
|
||||
NIL])
|
||||
|
||||
(UNIX-STREAM-PEEK
|
||||
[LAMBDA (STREAM NO-ERROR) (* ; "Edited 24-Jun-88 15:07 by drc:")
|
||||
(OR (UNIX-PEEKEDCHAR STREAM)
|
||||
(CL:SETF (UNIX-PEEKEDCHAR STREAM)
|
||||
(UNIX-READ STREAM NO-ERROR])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS *SHELL-DEVICE*)
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS UNIX-PEEKEDCHAR MACRO ((STR)
|
||||
(FETCH (STREAM F2) OF STR)))
|
||||
|
||||
(PUTPROPS UNIX-LASTCHAR MACRO ((STR)
|
||||
(FETCH (STREAM F3) OF STR)))
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(INITIALIZE-SHELL-DEVICE)
|
||||
)
|
||||
|
||||
(PUTPROPS UNIXCOMM FILETYPE FAKE-COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM FILETYPE COMPILE-FILE)
|
||||
(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2492 8463 (FORK-SHELL 2502 . 3699) (FORK-UNIX 3701 . 3877) (UNIX-KILL 3879 . 4068) (
|
||||
UNIX-WRITE 4070 . 4781) (CREATE-SHELL-STREAM 4783 . 6099) (CREATE-PROCESS-STREAM 6101 . 7560) (
|
||||
UNIXCOMM-AROUNDEXITFN 7562 . 8461)) (8511 13805 (INITIALIZE-NEW-SHELL-DEVICE 8521 . 9920) (
|
||||
UNIX-GET-NEXT-BUFFER 9922 . 12122) (UNIX-BACKFILEPTR-NEW 12124 . 12603) (UNIX-STREAM-EOFP-NEW 12605 .
|
||||
13151) (UNIX-STREAM-OUT 13153 . 13409) (UNIX-STREAM-CLOSE 13411 . 13803)) (14061 15926 (
|
||||
CREATE-UNIX-SOCKET-STREAM 14071 . 14932) (ACCEPT-UNIX-SOCKET-STREAM 14934 . 15924)) (16275 19735 (
|
||||
UNIX-BACKFILEPTR 16285 . 16783) (UNIX-READ 16785 . 17307) (INITIALIZE-SHELL-DEVICE 17309 . 18329) (
|
||||
UNIX-STREAM-IN 18331 . 18707) (UNIX-STREAM-EOFP 18709 . 19483) (UNIX-STREAM-PEEK 19485 . 19733)))))
|
||||
(FILEMAP (NIL (1963 7028 (FORK-SHELL 1973 . 3170) (FORK-UNIX 3172 . 3348) (UNIX-KILL 3350 . 3539) (
|
||||
UNIX-WRITE 3541 . 4252) (CREATE-SHELL-STREAM 4254 . 5138) (CREATE-PROCESS-STREAM 5140 . 5979) (
|
||||
UNIXCOMM-AROUNDEXITFN 5981 . 7026)) (7076 12267 (INITIALIZE-SHELL-DEVICE 7086 . 8514) (
|
||||
UNIX-GET-NEXT-BUFFER 8516 . 10716) (UNIX-BACKFILEPTR 10718 . 11130) (UNIX-STREAM-EOFP 11132 . 11613) (
|
||||
UNIX-STREAM-OUT 11615 . 11871) (UNIX-STREAM-CLOSE 11873 . 12265)) (12515 14221 (
|
||||
CREATE-UNIX-SOCKET-STREAM 12525 . 13331) (ACCEPT-UNIX-SOCKET-STREAM 13333 . 14219)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,27 +1,27 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 4-May-2018 17:18:00"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8 14600
|
||||
|
||||
changes to%: (FNS UnixPrintCommand)
|
||||
(FILECREATED "20-Jan-2023 22:44:05" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;4 13651
|
||||
|
||||
previous date%: "16-Apr-2018 17:25:15"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;7)
|
||||
:CHANGES-TO (VARS UNIXPRINTCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2023 13:28:36" {DSK}<home>frank>il>medley>gmedley>library>UNIXPRINT.;3
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. All rights reserved.
|
||||
Copyright (c) 1990-1993, 1995, 1997, 1999, 2001, 2018, 2023 by Venue.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT UNIXPRINTCOMS)
|
||||
|
||||
(RPAQQ UNIXPRINTCOMS
|
||||
[(FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
|
||||
(FUNCTIONS ShellCommand)
|
||||
[(FILES UNIXUTILS)
|
||||
(FNS InstallUnixPrinter UnixPrint UnixShellQuote UnixTempFile UnixPrintCommand)
|
||||
(INITVARS (UnixPrinterName NIL)
|
||||
(UNIXPRINTSWITCHES " -r -s "))
|
||||
(P
|
||||
(* ;;
|
||||
"(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
|
||||
(* ;;
|
||||
"(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
|
||||
|
||||
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW))
|
||||
(PROP FILETYPE UNIXPRINT)
|
||||
@@ -31,27 +31,29 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
|
||||
(FILESLOAD UNIXUTILS)
|
||||
(DEFINEQ
|
||||
|
||||
(InstallUnixPrinter
|
||||
[LAMBDA (PrinterTypes) (* ; "Edited 8-Feb-97 11:33 by rmk:")
|
||||
[LAMBDA (PrinterTypes) (* ; "Edited 8-Feb-97 11:33 by rmk:")
|
||||
|
||||
(* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")
|
||||
(* ;; "Set up any printers in PrinterTypes (or just Postscript by default) so that they'll be printed using the unix LPR command.")
|
||||
|
||||
(DECLARE (GLOBALVARS PRINTERTYPES))
|
||||
(for type inside (OR PrinterTypes '(POSTSCRIPT))
|
||||
do (for x in PRINTERTYPES when (EQMEMB type (CAR x))
|
||||
do (LET ((PRINTERTYPE type))
|
||||
(PUTASSOC 'SEND (LIST 'UnixPrint)
|
||||
(CDR x])
|
||||
do (LET ((PRINTERTYPE type))
|
||||
(PUTASSOC 'SEND (LIST 'UnixPrint)
|
||||
(CDR x])
|
||||
|
||||
(UnixPrint
|
||||
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 7-Dec-2001 14:55 by rmk:")
|
||||
(* ; "Edited 20-May-92 14:13 by nilsson")
|
||||
[LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 7-Dec-2001 14:55 by rmk:")
|
||||
(* ; "Edited 20-May-92 14:13 by nilsson")
|
||||
|
||||
(* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")
|
||||
(* ;; "Given a print FILE, use the Unix %"lpr%" command to spool it to a printer.")
|
||||
|
||||
(* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")
|
||||
(* ;; "The printer is named by HOST or UnixPrinterName, a Global variable.")
|
||||
|
||||
[LET*
|
||||
((PRINTER (OR HOST UnixPrinterName))
|
||||
@@ -60,9 +62,9 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
(NSIDES (LISTGET PRINTOPTIONS '%#SIDES))
|
||||
(TYPE (PRINTERTYPE PRINTER)))
|
||||
|
||||
(* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")
|
||||
(* ;; "Removed redundant check (we already know it's a PS printer), JDS 2/19/92:")
|
||||
|
||||
(* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype for %" PRINTER %" is not Postscript%"))))")
|
||||
(* ;; "(COND ((NULL TYPE) (ERROR (CONCAT %"Printertype unknown for %" PRINTER))) ((NOT (EQL (U-CASE TYPE) 'POSTSCRIPT)) (ERROR (CONCAT %"Printertype for %" PRINTER %" is not Postscript%"))))")
|
||||
|
||||
[COND
|
||||
((OR (NULL NAME)
|
||||
@@ -76,109 +78,103 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
0)
|
||||
(SETQ NAME "Medley Output"]
|
||||
|
||||
(* ;; "Don't break if you have trouble with preexisting files, e.g. because of protection.")
|
||||
(* ;; "Don't break if you have trouble with preexisting files, e.g. because of protection.")
|
||||
|
||||
(FOR F IN [CAR (NLSETQ (FILDIR (PACKFILENAME 'HOST 'DSK 'EXTENSION '* 'BODY
|
||||
(UnixTempFile 'medleyprint. T]
|
||||
(FOR F IN [CAR (NLSETQ (FILDIR (PACKFILENAME 'HOST 'DSK 'EXTENSION '* 'BODY (UnixTempFile
|
||||
'medleyprint. T]
|
||||
WHEN (CAR (NLSETQ (IGREATERP (DIFFERENCE (IDATE)
|
||||
(GETFILEINFO F 'ICREATIONDATE))
|
||||
120))) DO (NLSETQ (DELFILE F)))
|
||||
(GETFILEINFO F 'ICREATIONDATE))
|
||||
120))) DO (NLSETQ (DELFILE F)))
|
||||
|
||||
(* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by. If we delete immediately, it may happen before lpr has done its thing. ")
|
||||
(* ;; "The temp file's name will be of the form medleyprint.<idate>, so all such files can be found for deletion on a subsequent call after a certain amount of time (2 minutes) has gone by. If we delete immediately, it may happen before lpr has done its thing. ")
|
||||
|
||||
(CL:MULTIPLE-VALUE-BIND
|
||||
(tmpstream tmpname)
|
||||
(UnixTempFile 'medleyprint.)
|
||||
(COND
|
||||
(tmpstream
|
||||
(CL:MULTIPLE-VALUE-BIND (tmpstream tmpname)
|
||||
(UnixTempFile 'medleyprint.)
|
||||
(COND
|
||||
(tmpstream
|
||||
|
||||
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
|
||||
(* ;; "First, copy the lisp file to /tmp so lpr can find it.")
|
||||
|
||||
[CL:WITH-OPEN-STREAM
|
||||
(out tmpstream)
|
||||
(CL:WITH-OPEN-STREAM
|
||||
(in (OPENSTREAM FILE 'INPUT))
|
||||
(printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
|
||||
(COND
|
||||
(PRINTER (CONCAT " '" PRINTER "'"))
|
||||
(T ""))
|
||||
"...")
|
||||
(IF NSIDES
|
||||
THEN
|
||||
|
||||
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
|
||||
[CL:WITH-OPEN-STREAM
|
||||
(out tmpstream)
|
||||
(CL:WITH-OPEN-STREAM
|
||||
(in (OPENSTREAM FILE 'INPUT))
|
||||
(printout PROMPTWINDOW .TAB0 0 "Spooling output to Unix printer"
|
||||
(COND
|
||||
(PRINTER (CONCAT " '" PRINTER "'"))
|
||||
(T ""))
|
||||
"...")
|
||||
(IF NSIDES
|
||||
THEN
|
||||
(* ;; "Have to put magic simplex/duplex stuff in the tmp file itself, after the first line, cause there is no other way to control some duplex printers.")
|
||||
|
||||
(BIND C SAWCR
|
||||
DO (SETQ C (BIN in))
|
||||
(IF (MEMB C (CHARCODE (CR LF)))
|
||||
THEN (BOUT out C)
|
||||
(SETQ SAWCR T)
|
||||
ELSEIF SAWCR
|
||||
THEN
|
||||
(IF (MEMB C (CHARCODE (CR LF)))
|
||||
THEN (BOUT out C)
|
||||
(SETQ SAWCR T)
|
||||
ELSEIF SAWCR
|
||||
THEN
|
||||
(* ;; "First char of 2nd line: nonCR/LF after CR/LF")
|
||||
|
||||
(* ;;
|
||||
"First char of 2nd line: nonCR/LF after CR/LF")
|
||||
(* ;; "Put out simplex header, then print character in C")
|
||||
|
||||
(* ;;
|
||||
"Put out simplex header, then print character in C")
|
||||
(PRINTOUT out "%%BeginSetup" T)
|
||||
(PRINTOUT out "[{" T "%%%%BeginFeature: *Duplex Simplex" T
|
||||
"<< /Duplex " (CL:IF (EQ NSIDES 1)
|
||||
"false"
|
||||
"true")
|
||||
" /Tumble false >> setpagedevice" T
|
||||
"%%%%EndFeature" T "} stopped cleartomark" T)
|
||||
(PRINTOUT out "%%EndSetup" T)
|
||||
(BOUT out C)
|
||||
(COPYCHARS in out (GETFILEPTR in)
|
||||
-1)
|
||||
(RETURN)
|
||||
ELSE (BOUT out C)))
|
||||
ELSE (COPYCHARS in out 0 -1]
|
||||
|
||||
(PRINTOUT out "%%BeginSetup" T)
|
||||
(PRINTOUT out "[{" T
|
||||
"%%%%BeginFeature: *Duplex Simplex" T
|
||||
"<< /Duplex " (CL:IF (EQ NSIDES 1)
|
||||
"false"
|
||||
"true")
|
||||
" /Tumble false >> setpagedevice" T
|
||||
"%%%%EndFeature" T "} stopped cleartomark" T)
|
||||
(PRINTOUT out "%%EndSetup" T)
|
||||
(BOUT out C)
|
||||
(COPYCHARS in out (GETFILEPTR in)
|
||||
-1)
|
||||
(RETURN)
|
||||
ELSE (BOUT out C)))
|
||||
ELSE (COPYCHARS in out 0 -1]
|
||||
(* ;; "Now make Unix print the /tmp file.")
|
||||
|
||||
(* ;; "Now make Unix print the /tmp file.")
|
||||
|
||||
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
|
||||
PROMPTWINDOW)
|
||||
(printout PROMPTWINDOW "done" T))
|
||||
(T (ERROR "Couldn't create unix temp file"]
|
||||
(ShellCommand (UnixPrintCommand PRINTER COPIES NAME tmpname)
|
||||
PROMPTWINDOW)
|
||||
(printout PROMPTWINDOW "done" T))
|
||||
(T (ERROR "Couldn't create unix temp file"))))]
|
||||
T])
|
||||
|
||||
(UnixShellQuote
|
||||
[LAMBDA (STRING)
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-89 21:14 by TAL")
|
||||
(DECLARE (LOCALVARS . T)) (* ; "Edited 19-Apr-89 21:14 by TAL")
|
||||
(LET* ((X (CHCON STRING))
|
||||
(CT X)
|
||||
C FLG)
|
||||
[while (LISTP CT) do (SETQ C (CAR CT))
|
||||
(COND
|
||||
([OR (<= (CHARCODE a)
|
||||
C
|
||||
(CHARCODE z))
|
||||
(<= (CHARCODE A)
|
||||
C
|
||||
(CHARCODE Z))
|
||||
(<= (CHARCODE 0)
|
||||
C
|
||||
(CHARCODE 9))
|
||||
(FMEMB C (CHARCODE (- /]
|
||||
(SETQ CT (CDR CT)))
|
||||
(T (SETQ FLG T)
|
||||
(RPLNODE CT (CHARCODE \)
|
||||
(CONS (COND
|
||||
((FMEMB C (CHARCODE (CR LF)))
|
||||
(CHARCODE SPACE))
|
||||
(T C))
|
||||
(SETQ CT (CDR CT]
|
||||
(COND
|
||||
([OR (<= (CHARCODE a)
|
||||
C
|
||||
(CHARCODE z))
|
||||
(<= (CHARCODE A)
|
||||
C
|
||||
(CHARCODE Z))
|
||||
(<= (CHARCODE 0)
|
||||
C
|
||||
(CHARCODE 9))
|
||||
(FMEMB C (CHARCODE (- /]
|
||||
(SETQ CT (CDR CT)))
|
||||
(T (SETQ FLG T)
|
||||
(RPLNODE CT (CHARCODE \)
|
||||
(CONS (COND
|
||||
((FMEMB C (CHARCODE (CR LF)))
|
||||
(CHARCODE SPACE))
|
||||
(T C))
|
||||
(SETQ CT (CDR CT]
|
||||
(COND
|
||||
(FLG (CONCATCODES X))
|
||||
(T STRING])
|
||||
|
||||
(UnixTempFile
|
||||
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
|
||||
(* ; "Edited 12-Jan-89 19:07 by TAL")
|
||||
[LAMBDA (Prefix DontOpen) (* ; "Edited 28-Apr-93 13:49 by rmk:")
|
||||
(* ; "Edited 12-Jan-89 19:07 by TAL")
|
||||
(LET* ([host (AND (BOUNDP 'FISTempDir)
|
||||
(UNPACKFILENAME.STRING FISTempDir 'HOST]
|
||||
(dir (OR [COND
|
||||
@@ -191,39 +187,35 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
file unix)
|
||||
(COND
|
||||
([for i from 1 to 100
|
||||
thereis (NOT (INFILEP (SETQ file (CONCAT "{UNIX}"
|
||||
(SETQ unix
|
||||
(CONCAT "/" dir "/" str i]
|
||||
thereis (NOT (INFILEP (SETQ file (CONCAT "{UNIX}" (SETQ unix
|
||||
(CONCAT "/" dir "/" str i]
|
||||
(CL:VALUES [COND
|
||||
(DontOpen file)
|
||||
(T
|
||||
(* ;;
|
||||
"Type TEXT seems to be important for Apple LaserWriters at PARC")
|
||||
(* ;; "Type TEXT seems to be important for Apple LaserWriters at PARC")
|
||||
|
||||
(OPENSTREAM file 'OUTPUT NIL '((TYPE TEXT]
|
||||
unix])
|
||||
|
||||
(UnixPrintCommand
|
||||
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
|
||||
(* ;
|
||||
"Edited 20-May-92 14:26 by nilsson")
|
||||
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
|
||||
(* ; "Edited 20-May-92 14:26 by nilsson")
|
||||
|
||||
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
|
||||
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
|
||||
|
||||
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
|
||||
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
|
||||
|
||||
(* ;; "COPIES - how many copies of this job to be printed.")
|
||||
(* ;; "COPIES - how many copies of this job to be printed.")
|
||||
|
||||
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
|
||||
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
|
||||
|
||||
(* ;;
|
||||
"TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
|
||||
(* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
|
||||
|
||||
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
|
||||
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
|
||||
|
||||
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
|
||||
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
|
||||
|
||||
(* ;; "Use raw lpr, let system decide where it is located.")
|
||||
(* ;; "Use raw lpr, let system decide where it is located.")
|
||||
|
||||
(CONCAT "lpr " (COND
|
||||
((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
|
||||
@@ -242,21 +234,12 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
" " TMPNAME])
|
||||
)
|
||||
|
||||
(CL:DEFUN ShellCommand (Cmd &OPTIONAL (Output T))
|
||||
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd))
|
||||
(CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
|
||||
(GO OUT]
|
||||
(CL:LOOP (PRINTCCODE (READCCODE s)
|
||||
Output))
|
||||
OUT))
|
||||
NIL)
|
||||
|
||||
(RPAQ? UnixPrinterName NIL)
|
||||
|
||||
(RPAQ? UNIXPRINTSWITCHES " -r -s ")
|
||||
|
||||
|
||||
(* ;; "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
|
||||
(* ;; "(InstallUnixPrinter) commented out because POSTSCRIPT indirects according to platform")
|
||||
|
||||
|
||||
(PRIN1 "Please feel free to edit UnixPrintCommand." PROMPTWINDOW)
|
||||
@@ -266,26 +249,24 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
(DEFINEQ
|
||||
|
||||
(UnixPrintCommand
|
||||
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
|
||||
(* ;
|
||||
"Edited 20-May-92 14:26 by nilsson")
|
||||
[LAMBDA (PRINTER COPIES NAME TMPNAME) (* ; "Edited 4-May-2018 17:17 by rmk:")
|
||||
(* ; "Edited 20-May-92 14:26 by nilsson")
|
||||
|
||||
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
|
||||
(* ;; "This function is called when the user wants to UNIXPRINT a file. It has to return a string that when sent to a shell prints the file tmpname. In the cub version this should look something like %"/usr/ucb/lpr tmpname%". The arguments to this function are:")
|
||||
|
||||
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
|
||||
(* ;; " PRINTER - the name of the printer. Usually something like lw or plw.")
|
||||
|
||||
(* ;; "COPIES - how many copies of this job to be printed.")
|
||||
(* ;; "COPIES - how many copies of this job to be printed.")
|
||||
|
||||
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
|
||||
(* ;; "NAME - the name of this job. This gets printed on the banner of your job.")
|
||||
|
||||
(* ;;
|
||||
"TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
|
||||
(* ;; "TMPNAME - The name of the temporary file that contains the postscript code for this job. ")
|
||||
|
||||
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
|
||||
(* ;; "Note the clever function UnixShellQuote. It converts any lisp name to a string that is quoted according to /bin/sh syntax")
|
||||
|
||||
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
|
||||
(* ;; "UNIXPRINTSWITCHES makes it easy for other sites to change just the lpr switches.")
|
||||
|
||||
(* ;; "Use raw lpr, let system decide where it is located.")
|
||||
(* ;; "Use raw lpr, let system decide where it is located.")
|
||||
|
||||
(CONCAT "lpr " (COND
|
||||
((AND PRINTER (NEQ 0 (NCHARS PRINTER)))
|
||||
@@ -322,9 +303,9 @@ Copyright (c) 1990, 1991, 1992, 1993, 1995, 1997, 1999, 2001, 2018 by Venue. Al
|
||||
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018))
|
||||
(PUTPROPS UNIXPRINT COPYRIGHT ("Venue" 1990 1991 1992 1993 1995 1997 1999 2001 2018 2023))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1423 11730 (InstallUnixPrinter 1433 . 2041) (UnixPrint 2043 . 7114) (UnixShellQuote
|
||||
7116 . 8670) (UnixTempFile 8672 . 9980) (UnixPrintCommand 9982 . 11728)) (11732 12105 (ShellCommand
|
||||
11732 . 12105)) (12439 14197 (UnixPrintCommand 12449 . 14195)))))
|
||||
(FILEMAP (NIL (1389 11216 (InstallUnixPrinter 1399 . 1991) (UnixPrint 1993 . 6875) (UnixShellQuote
|
||||
6877 . 8306) (UnixTempFile 8308 . 9531) (UnixPrintCommand 9533 . 11214)) (11550 13243 (
|
||||
UnixPrintCommand 11560 . 13241)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
113
library/UNIXUTILS
Normal file
113
library/UNIXUTILS
Normal file
@@ -0,0 +1,113 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "18-Jan-2023 20:36:10" {DSK}<home>frank>il>medley>gmedley>library>UNIXUTILS.;7 5091
|
||||
|
||||
:CHANGES-TO (FNS ShellBrowser ShellBrowse ShellOpen)
|
||||
(VARS UNIXUTILSCOMS)
|
||||
(FUNCTIONS ShellWhich)
|
||||
|
||||
:PREVIOUS-DATE "18-Jan-2023 13:22:28" {DSK}<home>frank>il>medley>gmedley>greetfiles>UNIXUTILS.;1
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||
|
||||
(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser)
|
||||
(INITVARS (ShellBrowser))
|
||||
(FUNCTIONS ShellCommand ShellWhich)
|
||||
(FNS ShellBrowser ShellBrowse)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS ShellBrowser)
|
||||
)
|
||||
|
||||
(RPAQ? ShellBrowser )
|
||||
|
||||
(CL:DEFUN ShellCommand (Cmd &OPTIONAL (Output T))
|
||||
(CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd))
|
||||
(CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s)
|
||||
(GO OUT]
|
||||
(CL:LOOP (PRINTCCODE (READCCODE s)
|
||||
Output))
|
||||
OUT))
|
||||
NIL)
|
||||
|
||||
(CL:DEFUN ShellWhich (Cmd) (* ; "Edited 18-Jan-2023 13:19 by FGH")
|
||||
[CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH))
|
||||
(ShellCommand (CONCAT "which " Cmd)
|
||||
S)
|
||||
(COND
|
||||
((EQ (GETEOFPTR S)
|
||||
0)
|
||||
NIL)
|
||||
(T (SETFILEPTR S 0)
|
||||
(MKSTRING (READ S])
|
||||
(DEFINEQ
|
||||
|
||||
(ShellBrowser
|
||||
[LAMBDA NIL (* ; "Edited 18-Jan-2023 20:30 by FGH")
|
||||
(OR ShellBrowser (SETQ ShellBrowser (LET (CMDPATH)
|
||||
(if (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE")
|
||||
(UNIX-GETENV "PATH")))
|
||||
then
|
||||
(* ;; " MacOS")
|
||||
|
||||
"open"
|
||||
elseif (SETQ CMDPATH (ShellWhich "wslview"))
|
||||
then
|
||||
(* ;; "windows with WSL")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "xdg-open"))
|
||||
then
|
||||
(* ;; "Linux systems with xdg-utils installed ")
|
||||
|
||||
CMDPATH
|
||||
elseif (SETQ CMDPATH (ShellWhich "git"))
|
||||
then
|
||||
(* ;; " Systems with git installed")
|
||||
|
||||
(CONCAT CMDPATH " web--browse")
|
||||
(* ; "")
|
||||
elseif (SETQ CMDPATH (ShellWhich "lynx"))
|
||||
then
|
||||
(* ;; " Systems with lynx installed")
|
||||
|
||||
(LET (CMDPATH2)
|
||||
(if (SETQ CMDPATH2 (ShellWhich "xterm"))
|
||||
then (CONCAT CMDPATH2 " -e " CMDPATH)
|
||||
else (LIST CMDPATH)))
|
||||
else
|
||||
(* ;;
|
||||
" Out of ideas - just return a dummy function")
|
||||
|
||||
"true"])
|
||||
|
||||
(ShellBrowse
|
||||
[LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:32 by FGH")
|
||||
|
||||
(* ;; " Open the web page specified by URL using an external browser via shell call")
|
||||
|
||||
(* ;;
|
||||
" URL must start with http:// or https:// (case ireelevant) or this function will just return NIL.")
|
||||
|
||||
(* ;; " Returns T otherwise.")
|
||||
|
||||
(SETQ URL (MKSTRING URL))
|
||||
(if (OR (EQ (STRPOS "http://" (L-CASE URL))
|
||||
1)
|
||||
(EQ (STRPOS "https://" (L-CASE URL))
|
||||
1))
|
||||
then (LET ((BROWSER (ShellBrowser)))
|
||||
(if (LISTP BROWSER)
|
||||
then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER)
|
||||
" '" URL "'"))
|
||||
else (ShellCommand (CONCAT BROWSER " '" URL "'"
|
||||
" >>/tmp/ShellBrowser-warnings-$$.txt")))
|
||||
T)
|
||||
else NIL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (764 1137 (ShellCommand 764 . 1137)) (1139 1538 (ShellWhich 1139 . 1538)) (1539 5068 (
|
||||
ShellBrowser 1549 . 4072) (ShellBrowse 4074 . 5066)))))
|
||||
STOP
|
||||
BIN
library/UNIXUTILS.DFASL
Normal file
BIN
library/UNIXUTILS.DFASL
Normal file
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Feb-2022 11:10:55" {DSK}<home>larry>medley>library>VTCHAT.;2 21881
|
||||
(FILECREATED " 3-Aug-2022 11:30:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>VTCHAT.;3 21940
|
||||
|
||||
:CHANGES-TO (VARS VTCHATCOMS)
|
||||
:CHANGES-TO (RECORDS VT100SAVE)
|
||||
|
||||
:PREVIOUS-DATE "30-Sep-2021 17:41:51" {DSK}<home>larry>medley>library>VTCHAT.;1)
|
||||
:PREVIOUS-DATE "20-Feb-2022 11:10:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>VTCHAT.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -151,7 +153,7 @@ Copyright (c) 1983-1988, 1990, 1993, 2022 by Venue & Xerox Corporation.
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD VT100SAVE (CURSORPOS CHARATTR CHARSET))
|
||||
(RECORD VT100SAVE (CURSORPOS CHARATTR VTSCHARSET))
|
||||
|
||||
(DATATYPE VT100.STATE ((DINGED FLAG)
|
||||
(EATLF FLAG)
|
||||
@@ -261,10 +263,10 @@ Copyright (c) 1983-1988, 1990, 1993, 2022 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS VTCHAT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1675 9741 (VTCHAT.STATE 1685 . 2195) (VTCHAT.HANDLECHARACTER 2197 . 4771) (
|
||||
VTCHAT.SEQUENCE 4773 . 6316) (VTCHAT.DOCOMMAND 6318 . 9739)) (9742 17253 (VTCHAT.ADDRESS 9752 . 10270)
|
||||
(VTCHAT.REVERSE.INDEX 10272 . 10841) (VTCHAT.ATTRIBUTES 10843 . 11229) (VTCHAT.DECLFONT 11231 . 11500
|
||||
) (VTCHAT.CLEARMODES 11502 . 12005) (VTCHAT.SAVE 12007 . 12746) (VTCHAT.RESTORE 12748 . 13455) (
|
||||
VTCHAT.SETMODE 13457 . 14529) (VTCHAT.SETMARGINS 14531 . 15122) (VTCHAT.REPORT 15124 . 15884) (
|
||||
VTCHAT.STATUS 15886 . 17251)))))
|
||||
(FILEMAP (NIL (1731 9797 (VTCHAT.STATE 1741 . 2251) (VTCHAT.HANDLECHARACTER 2253 . 4827) (
|
||||
VTCHAT.SEQUENCE 4829 . 6372) (VTCHAT.DOCOMMAND 6374 . 9795)) (9798 17309 (VTCHAT.ADDRESS 9808 . 10326)
|
||||
(VTCHAT.REVERSE.INDEX 10328 . 10897) (VTCHAT.ATTRIBUTES 10899 . 11285) (VTCHAT.DECLFONT 11287 . 11556
|
||||
) (VTCHAT.CLEARMODES 11558 . 12061) (VTCHAT.SAVE 12063 . 12802) (VTCHAT.RESTORE 12804 . 13511) (
|
||||
VTCHAT.SETMODE 13513 . 14585) (VTCHAT.SETMARGINS 14587 . 15178) (VTCHAT.REPORT 15180 . 15940) (
|
||||
VTCHAT.STATUS 15942 . 17307)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Feb-2022 12:04:09"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;2 100778
|
||||
(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2 100794
|
||||
|
||||
:CHANGES-TO (FILES LAFITEDECLS)
|
||||
(FNS \SENDMESSAGE.RESTARTABLE \SENDMESSAGE LAFITE.SENDMESSAGE MAKEXXXSUPPORTFORM
|
||||
MAKENEWMESSAGEFORM MAKEANSWERFORM LAFITE.FILL.IN.ANSWER.FORM MAKEFORWARDFORM)
|
||||
:CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
|
||||
|
||||
:PREVIOUS-DATE "30-Sep-2021 22:58:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITESEND.;1)
|
||||
:PREVIOUS-DATE " 7-Feb-2022 12:04:09"
|
||||
{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LAFITESENDCOMS)
|
||||
@@ -529,7 +526,8 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
(RETURN (\SENDMESSAGE.RESTARTABLE FORM TEDITPROPS NIL FORMNAME])
|
||||
|
||||
(\SENDMESSAGE.RESTARTABLE
|
||||
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 7-Feb-2022 11:50 by rmk")
|
||||
[LAMBDA (FORM TEDITPROPS EDITORWINDOW FORMNAME) (* ; "Edited 16-Oct-2022 09:59 by briggs")
|
||||
(* ; "Edited 7-Feb-2022 11:50 by rmk")
|
||||
(* ; "Edited 3-Nov-89 15:06 by bvm")
|
||||
(bind (CURRENTMESSAGE _ FORM)
|
||||
(FIRSTTIME _ T)
|
||||
@@ -558,7 +556,9 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021 by Xerox Corporation.
|
||||
EDITORWINDOW))
|
||||
(push LAFITECURRENTEDITORWINDOWS EDITORWINDOW)
|
||||
(SETQ FIRSTTIME)))
|
||||
[SETQ EDITORRESULT (TEDIT (OPENSTRINGSTREAM FORM)
|
||||
[SETQ EDITORRESULT (TEDIT (CL:IF (STRINGP FORM)
|
||||
(OPENSTRINGSTREAM FORM)
|
||||
FORM)
|
||||
EDITORWINDOW T (APPEND TEDITPROPS (LIST 'FONT LAFITEEDITORFONT]
|
||||
(COND
|
||||
((TTY.PROCESSP) (* ; "give back the keyboard")
|
||||
@@ -1764,31 +1764,31 @@ cc: ~A
|
||||
)
|
||||
)
|
||||
(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000
|
||||
2021))
|
||||
2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5539 28516 (DOLAFITESENDINGCOMMAND 5549 . 6039) (\SENDMESSAGE.INITIATE 6041 . 7980) (
|
||||
\SENDMSG.DELIVER 7982 . 8590) (\SENDMSG.EXIT.TEDIT 8592 . 8963) (\SENDMSG.SAVE.FORM 8965 . 10952) (
|
||||
\LAFITE.HEADER.EOF 10954 . 11247) (\LAFITE.INSERT.REPLYTO 11249 . 11857) (\SENDMSG.REPLYTO 11859 .
|
||||
12418) (\SENDMSG.CHANGE.MODE 12420 . 17996) (\SENDMSG.FIND.FIELD 17998 . 18508) (\SENDMESSAGE.PARSE
|
||||
18510 . 19306) (\LAFITE.PREPARE.SEND 19308 . 22141) (\LAFITE.PREPARE.ERROR 22143 . 23325) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23327 . 25968) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25970 . 26895) (
|
||||
\SENDMESSAGE.MENUPROMPT 26897 . 27760) (\SENDMESSAGE.PROMPT 27762 . 28298) (\SENDMESSAGEFAIL 28300 .
|
||||
28514)) (28517 52962 (\SENDMESSAGE 28527 . 29879) (\SENDMESSAGE.RESTARTABLE 29881 . 34865) (
|
||||
\SENDMESSAGE.CLEANUP 34867 . 35083) (\SENDMESSAGE.MAKEWINDOW 35085 . 41258) (MAKELAFITEDELIVERMENU
|
||||
41260 . 41567) (\LAFITE.CLOSEMSG? 41569 . 42519) (\LAFITE.AFTER.DELIVER 42521 . 45840) (
|
||||
\LAFITE.UNSENT.ICON 45842 . 46152) (\LAFITE.FETCH.SUBJECT 46154 . 46954) (LAFITE.SENDMESSAGE 46956 .
|
||||
47849) (\SENDMESSAGE0 47851 . 50715) (LA.ASSURE.PROMPT.WINDOW 50717 . 51614) (\LAFITE.SEND.FAIL 51616
|
||||
. 52087) (\LAFITE.INVALID.RECIPIENTS 52089 . 52547) (\SENDMESSAGE.ABORT 52549 . 52960)) (52994 62907
|
||||
(\OUTBOX.CREATE 53004 . 54467) (\OUTBOX.RESET 54469 . 54962) (\OUTBOX.CLOSEFN 54964 . 55104) (
|
||||
\OUTBOX.REPAINTFN 55106 . 55769) (\OUTBOX.RESHAPEFN 55771 . 57054) (\OUTBOX.SHADEITEM 57056 . 57729) (
|
||||
\OUTBOX.BUTTONFN 57731 . 60579) (\OUTBOX.DISPLAYLINE 60581 . 61075) (\OUTBOX.ADD.ITEM 61077 . 62905))
|
||||
(63203 79611 (\LAFITE.MESSAGEFORM 63213 . 67556) (MAKELAFITESUPPORTFORM 67558 . 67747) (
|
||||
MAKELISPSUPPORTFORM 67749 . 67915) (MAKEXXXSUPPORTFORM 67917 . 71966) (MAKENEWMESSAGEFORM 71968 .
|
||||
72924) (MAKELAFITEPRIVATEFORMSITEMS 72926 . 73354) (\LAFITE.UNCACHE.MESSAGEFORM 73356 . 73809) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73811 . 74412) (\LAFITE.SELECT.FORM 74414 . 74769) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74771 . 75915) (\LAFITE.READ.FORM 75917 . 78654) (\LAFITE.FIND.TEMPLATE
|
||||
78656 . 79609)) (79635 87366 (\LAFITE.ANSWER 79645 . 80050) (\LAFITE.ANSWER.PROC 80052 . 81946) (
|
||||
MAKEANSWERFORM 81948 . 84478) (LA.PRINT.COMMA.LIST 84480 . 84966) (LAFITE.FILL.IN.ANSWER.FORM 84968 .
|
||||
87364)) (87391 93587 (\LAFITE.FORWARD 87401 . 87809) (\LAFITE.FORWARD.PROC 87811 . 89800) (
|
||||
MAKEFORWARDFORM 89802 . 93585)))))
|
||||
(FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
|
||||
\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
|
||||
\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 .
|
||||
12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE
|
||||
18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
|
||||
\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
|
||||
\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 .
|
||||
28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
|
||||
\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU
|
||||
41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
|
||||
\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 .
|
||||
47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
|
||||
. 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918
|
||||
(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
|
||||
\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
|
||||
\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916))
|
||||
(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
|
||||
MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 .
|
||||
72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
|
||||
\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
|
||||
\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE
|
||||
78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
|
||||
MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 .
|
||||
87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
|
||||
MAKEFORWARDFORM 89813 . 93596)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jul-2022 17:00:01"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PCTREE.;1 27141
|
||||
(FILECREATED "26-Jul-2022 10:35:13" {DSK}<home>larry>medley>library>tedit>TEDIT-PCTREE.;2 26909
|
||||
|
||||
:PREVIOUS-DATE "14-Jul-2022 11:08:10"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-PCTREE.;2)
|
||||
:CHANGES-TO (FNS \INSERTTREE)
|
||||
|
||||
:PREVIOUS-DATE "14-Jul-2022 17:00:01" {DSK}<home>larry>medley>library>tedit>TEDIT-PCTREE.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
|
||||
@@ -168,8 +168,7 @@
|
||||
1))])
|
||||
|
||||
(\INSERTTREE
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV) (* ; "Edited 21-Jun-2022 23:39 by larry")
|
||||
(* ;
|
||||
[LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV) (* ;
|
||||
"Edited 21-Mar-95 15:29 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "inserts NEW in front of OLD in PCNODE. NEW/OLD are either pieces or tree nodes.")
|
||||
@@ -231,8 +230,6 @@
|
||||
(T (\ILLEGAL.ARG NEW)))
|
||||
(SETQ NEWLEN (for I from 0 to NODE-COUNT as ITEM# from 2 by 4
|
||||
sum (\GETBASEFIXP PCNODE ITEM#)))
|
||||
(IF (TYPE? BIGNUM NEWLEN)
|
||||
THEN (HELP NEWLEN " is bignum"))
|
||||
(replace (BTREENODE TOTLEN) of PCNODE with NEWLEN)
|
||||
|
||||
(* ;; " If adding this piece overflows the tree node, split it.")
|
||||
@@ -542,9 +539,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2938 22352 (UPDATEPCNODES 2948 . 3917) (FINDPCNODE 3919 . 4155) (\FIRSTNODE 4157 . 4518
|
||||
) (\DELETETREE 4520 . 6985) (\INSERTTREE 6987 . 11551) (\LASTNODE 11553 . 12090) (\MATCHPCS 12092 .
|
||||
12816) (\SPLITTREE 12818 . 19698) (\TEDIT.UPDATETREE 19700 . 21207) (\TEDIT.PIECE-CHNO 21209 . 21791)
|
||||
(\TEDIT.SET-TOTLEN 21793 . 22350)) (22353 24789 (DISPTREE 22363 . 22819) (TREEGRAPHNODE 22821 . 24787)
|
||||
(FILEMAP (NIL (2918 22120 (UPDATEPCNODES 2928 . 3897) (FINDPCNODE 3899 . 4135) (\FIRSTNODE 4137 . 4498
|
||||
) (\DELETETREE 4500 . 6965) (\INSERTTREE 6967 . 11319) (\LASTNODE 11321 . 11858) (\MATCHPCS 11860 .
|
||||
12584) (\SPLITTREE 12586 . 19466) (\TEDIT.UPDATETREE 19468 . 20975) (\TEDIT.PIECE-CHNO 20977 . 21559)
|
||||
(\TEDIT.SET-TOTLEN 21561 . 22118)) (22121 24557 (DISPTREE 22131 . 22587) (TREEGRAPHNODE 22589 . 24555)
|
||||
))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Jul-2022 08:54:12"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;246 128062
|
||||
(FILECREATED " 3-Oct-2022 12:03:37"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;252 128695
|
||||
|
||||
:CHANGES-TO (FNS CDPRINT.COLUMNS)
|
||||
:CHANGES-TO (FNS CDFILES)
|
||||
|
||||
:PREVIOUS-DATE "17-Jul-2022 11:04:12"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;245)
|
||||
:PREVIOUS-DATE "14-Aug-2022 12:13:45"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>COMPAREDIRECTORIES.;250)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -388,7 +388,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(DEFINEQ
|
||||
|
||||
(CDFILES
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 25-Apr-2022 08:42 by rmk")
|
||||
[LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH)(* ; "Edited 3-Oct-2022 12:03 by rmk")
|
||||
(* ; "Edited 25-Apr-2022 08:42 by rmk")
|
||||
(* ; "Edited 5-Mar-2022 15:05 by rmk")
|
||||
(* ; "Edited 16-Oct-2020 13:42 by rmk:")
|
||||
|
||||
@@ -416,6 +417,7 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(SETQ EXCLUDEDFILES (LDIFFERENCE EXCLUDEDFILES INCLUDEDFILES))
|
||||
(LET ([INCLUDES (CDFILES.PATS (OR INCLUDEDFILES '*.*]
|
||||
(EXCLUDES (AND EXCLUDEDFILES (CDFILES.PATS EXCLUDEDFILES)))
|
||||
(*UPPER-CASE-FILE-NAMES* NIL)
|
||||
HOST ENUMPAT)
|
||||
(SETQ HOST (FILENAMEFIELD.STRING DIR 'HOST))
|
||||
(SETQ DIR (FILENAMEFIELD.STRING DIR 'DIRECTORY))
|
||||
@@ -1707,7 +1709,11 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
BROWSER)])
|
||||
|
||||
(CDBROWSER.STRINGS
|
||||
[LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 22-Feb-2022 18:30 by rmk")
|
||||
[LAMBDA (CDVALUE COLHEADINGS SEPARATEDIRECTIONS) (* ; "Edited 14-Aug-2022 12:13 by rmk")
|
||||
(* ; "Edited 11-Aug-2022 20:23 by rmk")
|
||||
(* ; "Edited 25-Jul-2022 15:31 by rmk")
|
||||
(* ; "Edited 20-Jul-2022 21:14 by rmk")
|
||||
(* ; "Edited 22-Feb-2022 18:30 by rmk")
|
||||
(* ; "Edited 14-Dec-2021 21:03 by rmk")
|
||||
(* ; "Edited 8-Dec-2021 11:22 by rmk")
|
||||
(* ; "Edited 27-Nov-2021 21:37 by rmk:")
|
||||
@@ -1756,7 +1762,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(* ;; "Stick a blank object between")
|
||||
|
||||
(SETQ PAIRS (NCONC (DREVERSE L2R)
|
||||
(LIST "")
|
||||
[COPY '(("")
|
||||
(""]
|
||||
(DREVERSE R2L)))))
|
||||
(CL:WHEN COLHEADERS
|
||||
(PUSH PAIRS (LIST COLHEADERS)))
|
||||
@@ -2150,25 +2157,25 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp
|
||||
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
|
||||
2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2632 22189 (COMPAREDIRECTORIES 2642 . 7475) (COMPAREDIRECTORIES.INFOS 7477 . 10351) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10353 . 13738) (CDENTRIES.SELECT 13740 . 18515) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18517 . 19423) (MATCHNAME 19425 . 20105) (CD.INSURECDVALUE 20107 . 21721
|
||||
) (CD.UPDATEWIDTHS 21723 . 22187)) (22190 31859 (CDFILES 22200 . 27953) (CDFILES.MATCH 27955 . 29580)
|
||||
(CDFILES.PATS 29582 . 31857)) (31860 49681 (CDPRINT 31870 . 34387) (CDPRINT.HEADER 34389 . 35286) (
|
||||
CDPRINT.LINE 35288 . 38520) (CDPRINT.MAXWIDTHS 38522 . 42637) (CDPRINT.COLHEADERS 42639 . 43924) (
|
||||
CDPRINT.COLUMNS 43926 . 49046) (CDTEDIT 49048 . 49679)) (49682 58051 (CDMAP 49692 . 51124) (CDENTRY
|
||||
51126 . 51435) (CDSUBSET 51437 . 52876) (CDMERGE 52878 . 56732) (CDMERGE.COMMON 56734 . 58049)) (58052
|
||||
65590 (BINCOMP 58062 . 62351) (EOLTYPE 62353 . 64915) (EOLTYPE.SHOW 64917 . 65588)) (66118 78645 (
|
||||
FIND-UNCOMPILED-FILES 66128 . 69771) (FIND-UNSOURCED-FILES 69773 . 72157) (FIND-SOURCE-FILES 72159 .
|
||||
73897) (FIND-COMPILED-FILES 73899 . 75776) (FIND-UNLOADED-FILES 75778 . 76631) (FIND-LOADED-FILES
|
||||
76633 . 77061) (FIND-MULTICOMPILED-FILES 77063 . 78643)) (78646 87077 (CREATED-AS 78656 . 83453) (
|
||||
SOURCE-FOR-COMPILED-P 83455 . 86382) (COMPILE-SOURCE-DATE-DIFF 86384 . 87075)) (87078 97384 (
|
||||
FIX-DIRECTORY-DATES 87088 . 90081) (FIX-EQUIV-DATES 90083 . 91608) (COPY-COMPARED-FILES 91610 . 93431)
|
||||
(COPY-MISSING-FILES 93433 . 95590) (COMPILED-ON-SAME-SOURCE 95592 . 97382)) (97578 104924 (CDBROWSER
|
||||
97588 . 101515) (CDBROWSER.STRINGS 101517 . 104922)) (105086 106822 (CD.TABLEITEM 105096 . 105316) (
|
||||
CD.TABLEITEM.PRINTFN 105318 . 105517) (CD.TABLEITEM.COPYFN 105519 . 106577) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 106579 . 106820)) (106823 127478 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
106833 . 107301) (CD.COMMANDSELECTEDFN 107303 . 112404) (CD-MENUFN 112406 . 116717) (CD-COMPARE-FILES
|
||||
116719 . 120071) (CDBROWSER-COPY 120073 . 123742) (CDBROWSER-DELETE-FILE 123744 . 126957) (CD-SWAPDIRS
|
||||
126959 . 127476)))))
|
||||
(FILEMAP (NIL (2624 22181 (COMPAREDIRECTORIES 2634 . 7467) (COMPAREDIRECTORIES.INFOS 7469 . 10343) (
|
||||
COMPAREDIRECTORIES.CANDIDATES 10345 . 13730) (CDENTRIES.SELECT 13732 . 18507) (
|
||||
COMPAREDIRECTORIES.INFOS.TYPE 18509 . 19415) (MATCHNAME 19417 . 20097) (CD.INSURECDVALUE 20099 . 21713
|
||||
) (CD.UPDATEWIDTHS 21715 . 22179)) (22182 32000 (CDFILES 22192 . 28094) (CDFILES.MATCH 28096 . 29721)
|
||||
(CDFILES.PATS 29723 . 31998)) (32001 49822 (CDPRINT 32011 . 34528) (CDPRINT.HEADER 34530 . 35427) (
|
||||
CDPRINT.LINE 35429 . 38661) (CDPRINT.MAXWIDTHS 38663 . 42778) (CDPRINT.COLHEADERS 42780 . 44065) (
|
||||
CDPRINT.COLUMNS 44067 . 49187) (CDTEDIT 49189 . 49820)) (49823 58192 (CDMAP 49833 . 51265) (CDENTRY
|
||||
51267 . 51576) (CDSUBSET 51578 . 53017) (CDMERGE 53019 . 56873) (CDMERGE.COMMON 56875 . 58190)) (58193
|
||||
65731 (BINCOMP 58203 . 62492) (EOLTYPE 62494 . 65056) (EOLTYPE.SHOW 65058 . 65729)) (66259 78786 (
|
||||
FIND-UNCOMPILED-FILES 66269 . 69912) (FIND-UNSOURCED-FILES 69914 . 72298) (FIND-SOURCE-FILES 72300 .
|
||||
74038) (FIND-COMPILED-FILES 74040 . 75917) (FIND-UNLOADED-FILES 75919 . 76772) (FIND-LOADED-FILES
|
||||
76774 . 77202) (FIND-MULTICOMPILED-FILES 77204 . 78784)) (78787 87218 (CREATED-AS 78797 . 83594) (
|
||||
SOURCE-FOR-COMPILED-P 83596 . 86523) (COMPILE-SOURCE-DATE-DIFF 86525 . 87216)) (87219 97525 (
|
||||
FIX-DIRECTORY-DATES 87229 . 90222) (FIX-EQUIV-DATES 90224 . 91749) (COPY-COMPARED-FILES 91751 . 93572)
|
||||
(COPY-MISSING-FILES 93574 . 95731) (COMPILED-ON-SAME-SOURCE 95733 . 97523)) (97719 105557 (CDBROWSER
|
||||
97729 . 101656) (CDBROWSER.STRINGS 101658 . 105555)) (105719 107455 (CD.TABLEITEM 105729 . 105949) (
|
||||
CD.TABLEITEM.PRINTFN 105951 . 106150) (CD.TABLEITEM.COPYFN 106152 . 107210) (
|
||||
CDTABLEBROWSER.HEADING.REPAINTFN 107212 . 107453)) (107456 128111 (CDTABLEBROWSER.WHENSELECTEDFN
|
||||
107466 . 107934) (CD.COMMANDSELECTEDFN 107936 . 113037) (CD-MENUFN 113039 . 117350) (CD-COMPARE-FILES
|
||||
117352 . 120704) (CDBROWSER-COPY 120706 . 124375) (CDBROWSER-DELETE-FILE 124377 . 127590) (CD-SWAPDIRS
|
||||
127592 . 128109)))))
|
||||
STOP
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user