1
0
mirror of synced 2026-04-06 06:12:33 +00:00

Compare commits

...

44 Commits

Author SHA1 Message Date
Larry Masinter
4fed40bb85 Add BROWSERMAX to limit depth of paths graph (#1158)
* Add BROWSERMAX to limit depth of paths graph

* Update Browser to use left-button menu popup to select action
2023-06-30 16:56:54 -07:00
Larry Masinter
3cca8c4940 Fix places where rename of record LINE to XXLINE was incomplete (#1212) 2023-06-30 16:42:07 -07:00
Larry Masinter
b493d98aeb fix GATHER-INFO for compiled code -- globalvars vs.bounc (#1219) 2023-06-18 21:24:23 -07:00
Larry Masinter
beb4a77195 Recompile PRETTY (#1220) 2023-06-17 21:40:34 -07:00
Frank Halasz
e067e02dde Add on:schedule to buildRelease workflow so that Medley builds happen automatically on Mondays at 1am (#1225)
* Add an On:schedule to the build release and docker workflow to build a new release every Monday at 1am

* Add an On:schedule to the build release and docker workflow to build a new release every Monday at 9am UTC (1am or 2am Pacfic time, depending on daylight savings
2023-06-11 13:40:38 -07:00
Larry Masinter
1af56ddaa2 Add .tedit files for Lafite manual and release notes -- PDFs on Google Drive (#1209)
* Add .tedit files for Lafite manual and release notes -- PDFs on Google Drive

* use 'docs' for subfolder name; wliminate dup

* Remove duplicate LAFITEMANUAL-GLOSSARY-CUSTOMER.TEDIT

---------

Co-authored-by: Nick Briggs <nicholas.h.briggs@gmail.com>
2023-05-16 19:30:15 -07:00
Nick Briggs
16dd66a016 Pass --display/-d argument as -display not by setting DISPLAY env variable. (#1213) 2023-05-16 19:28:21 -07:00
Larry Masinter
81b74be043 Another pass on CLOSEALL simplify by calling (OPENP) (#1182)
* Another pass on CLOSEALL simplify by calling (OPENP)

* Put back in checks for CLOSEALL IOMODE USERVISIBLE

* \TERM.OFD and \LINEBUF.OFD are bound, no global

* getting rid of \OPENFILES everywhere

* one more \OPENFILES
2023-05-16 19:02:43 -07:00
Larry Masinter
f8a5d0fbe5 Rewrite code for deciding 'Good morning', 'Good evening' 'You're working late' Y2K (#1208) 2023-05-16 19:00:49 -07:00
Larry Masinter
3e0ec62d27 Prettyfileindex knows about :EDIT-BY (#1205) 2023-05-16 10:06:03 -07:00
Larry Masinter
654675661f Do not set keyboard type without knowing better (#1211) 2023-05-16 10:05:31 -07:00
Larry Masinter
3cb051ea7b Allow (CLOSALL) to work after all (#1164) 2023-04-19 19:47:11 -07:00
Frank Halasz
8bb283e0c4 Merge pull request #1154 from Interlisp/tweak-init2
Tweak INIT: HELPTIME 1 for more break windows; extend font profile
2023-04-19 18:03:08 -07:00
Frank Halasz
6fae5c14e9 Merge branch 'master' into tweak-init2 2023-04-19 17:54:43 -07:00
Frank Halasz
c58ef4ee56 Merge pull request #1161 from Interlisp/minor-usage-tweaks
minor usage tweaks
2023-04-19 17:53:57 -07:00
Frank Halasz
730fc5b678 Merge pull request #1153 from Interlisp/who-line-only
tweak WHO-LINE
2023-04-19 17:46:25 -07:00
Frank Halasz
8d54603329 Merge branch 'master' into who-line-only 2023-04-19 17:45:29 -07:00
Larry Masinter
21ceff5ad9 add internal/MAINTAIN.TXT to explain what MAINTAIN is 2023-04-18 15:21:35 -07:00
Larry Masinter
5a07e6c266 SYSEDIT also sets copyright flag 2023-04-18 15:16:07 -07:00
Larry Masinter
4a09d3a027 Init file set HELPTIME to 1 more break windows; copyright NEVER 2023-04-18 15:15:00 -07:00
Larry Masinter
691563024b Yet another Logo with parameters for substrings. WINDOW.BITMAP move to Window (#1151)
* Yet another Logo with parameters for substrings. WINDOW.BITMAP move to Window

* Added LOGOW.DFASL, so rm LOGOW.LCOM

* LOGOW: Add local variables for most of the hard-coded constants to make it easier to experiment with adjusting said constants.  Adding kerning for substring1.

* LOGOW: Add more kerning options.  Cretaed separate kerned.prin3 function.

* Set default params to Option 8.  Added some top and right margins when placing LOGOW in screen so it doesn't look so squished into the corner.

---------

Co-authored-by: Frank Halasz <frank@halasz.org>
2023-04-18 14:57:41 -07:00
Larry Masinter
0f49e248d3 Tweak INIT: HELPTIME 1 for more break windows; extend font profile 2023-04-13 09:56:16 -07:00
Larry Masinter
54782f5b21 tweak to WHO-LINE: hostname (don't use pup), change dir (don't offer directories that don't exist), package (sort so likely choices are at top) 2023-04-12 22:26:23 -07:00
rmkaplan
d34522d769 GITNFS: Doesn't error if clonepath defaults but is not required (#1123)
If CLONEPATH is NIL, no error if the clone can't be found, just prints a note.  If CLONEPATH is T, will error.
2023-03-30 09:59:27 -07:00
Larry Masinter
c501dc82fb add :EDIT-BY initials to FILECREATED (#1074) 2023-03-24 21:52:44 -07:00
Bill Stumbo
c256a8f411 Merge pull request #1110 from neauoire/patch-1
Changed wiki link to new docs url
2023-03-19 20:44:31 -04:00
Devine Lu Linvega
69dbe43d87 Update README.md 2023-03-19 16:45:17 -07:00
Devine Lu Linvega
989ec5b0b5 Changed wiki link to new docs url 2023-03-19 09:40:25 -07:00
rmkaplan
12b5e90727 GITFNS: Better default directory-finding, better pseudohosts (#1064) (#1065)
* GITFNS:  Better default directory-finding, better pseudohosts  (addresses #1064)

Also updated documentation

* GITFNS:  better error message in GIT-MAKE-PROJECT
2023-02-18 17:19:29 -08:00
Frank Halasz
4b95a8b5d3 Windows installer and medley script for running Medley in Docker on Windows (#1077)
* Update docker file build to use new deb linux installers;  move Dockefile to .github/workflows since its really only useable from the buildDocker.yml workflow

* Fix typo in dockerfile location

* remove extraneous " in >>GITHUB_ENV statements

* Fix handling of TARGETPLATFORM in Dockerfile

* Trying with just one platform

* Fix issues with missing man-db in docker build workflow; added man-db to depends in deb builds for linux

* Sicthed docker from tightvnc to tigervnc to match oio.  This getting the apt package name right.

* Going back to single platform to debug this thing

* Trying with just arm64

* Removing arm/v7 from docker images.  Takes too long to build and just wastes our github actions minutes.  This is assuming its a never used feature since docker is not big on raspberry pis and their ilk.

* Fix typo in control-linux; update build_deb so that files in /usr/local installed by deb are owned by root; add ubuntu user and nano in docker file for dbebugging;  when in draft only create for x86_64 platform

* Fix typo in buildDocker.yml

* Add sudo to docker image; in docker image ensure that all /usr/local/interlisp files are owned by root

* Add securityTypes none to docker entrypoint

* Updated docker base to Ubuntu 22.10 to get fixed xrdp; add xrdp to the docker image; updated user permission in docker image;

* In Dockerfile make xrdp install noninteractive

* Update medley.sh scripts to handle docker case

* Fix a couple of typos

* BuildDcoker: added pulling latest draft release (if any) when this is a draft docker build; removed checkout of medley code cause its not used

* BuildDocker: added medley checkout backin - turns pout its needed by a bunch of actions even though I dont really think they use it

* BuildDocker: moved download assets to use gh instaed of a marketplace action becauase that action could not handle draft releases.

* Tweaking medley.sh and associated tweaks to work Windows via wsl medley and docker

* adding first pass at powershell script for windows docker and wsl

* Tuning how Xvnc, medley, and vncviewer handle the various ways of exiting - eg logout vs closing viewer window.

* Tuning vncviewer launch to make sure that tty works as expected when medley.sh runs in background

* Minor typo fixes and added extra check to use of /run/shm in medley_vnc.sh

* Added SSH_KEY secret to buildReleaseIncDocker workflow

* Gertting the add SSH_KEY secret into orkflows right this time, hopefully

* Adding TERM env variable and setting USER to medley in docker image

* Debugging medley.ps1 and adding a couple of arguments

* Typo in Dockerfile medley

* Synchronizing flag processing and usage for medley.ps1 and medley.sh; refactored medley_args.sh and medley_usage.sh code.

* Adding first pass at windows installer

* Adding first pass an inno setup script for Windows installation

* Update buildLoadup workflow and downloads page for windows installer

* Fix typo in buildLoadup

* BuildLoadup make sure windows runner uses powershell

* Another typo in buildLoadup

* Another typo in buildLoadup; damn those double quotes

* Updating handling of windows installer in buildLoadup, added vncviewer to medley.iss install

* Unknown syntax error in buildLoadup

* Another damn typo from double quotes

* buildLoadup: fixed loadup job outputs

* buidLoadup: fixed bug with COMBINED_RELEASE_TAG; fixed Upload script in windows job to be compatible with actions.script v6.

* buidLoadup: upload win installer adapted to find draft releases as well as full releases

* BuildLoadup: fixing up javascript in actions in windows job to use / instead of \ in pathname

* BuildLoadup: changing win installer update to same action used for other release assets

* Fix windows installer file name; in BuildLoadup move update downl;oad page to the Windows runner because uploading the window-installer changes the release download url, so updating the downloads page must be done after the windows installer upload.; General buildLoadup cleanup

* Run md2html to update downloads page

* Fix typo in build_deb.sh

* Removing some leftover crud in medley_usage.sh

* Fixing up windows installer a bit, mostly cosmetic

* Adding support for WSL1; mostly forcing --vnc and changing how to find open ports and displays since WSL1 networking is different tha WSL2

* Update manual page for new Windows Medley script

* First pass done for man page that incorporates new Windows medley script.  Add Xvnc wait before calling run-medley in case of docker to prevent occasonal missing X windows server error.

* Change buildLoadup to update man page to a draft if this is a draft run.
2023-02-18 06:19:57 -08:00
Frank Halasz
3fa571f798 Fix buildLoadup.yml to craete TARBALL directory if it doesn't exist (#1060) 2023-01-31 00:37:23 -08:00
Frank Halasz
10a598865f Create UNIXUTILS in library to go along with UNIXPRINTER, et al (#1051)
* Create UNIXUTILS file in library with ShellWhich function - linux which command equivalent.  Also move ShellCommand from UNIXPRINT to UNIXUTILS.

* Adding UNIXUTILS to LOADUP-FULL so it gets included in full.sysout

* Change of names from open(er) to browse(r). Refine the browse(r) functions a bit

* Minor bug fixes

* Add (FILES UNIXUTILS) to UNIXPRINTCOMS so that ShellCommand is loaded in case only UNIXPRINT is loaded.  For backward compatibility.
2023-01-30 23:43:10 -08:00
Frank Halasz
f2ef7cc8f6 Installers for Linux: workflow changes and more to support standard Linux installations (#1058)
* Adding LANG environment variable to docker image; adding MAIKO_ and MEDLEY_INSTALLDIR environment variables; Changing /usr/local/bin/run-medley to a symbolic link instead of a shell script

* Added draft input to all workflows, so that can create draft releases as well as regular releases

* Update buildDocker.yml to handle deprecation of set-output and to update versions of actions to handle node 12 to node 16 transition.

* Added scripts and updated github workflows to support creation of deb installers for Linux and WSL

* Fix minor bug in buildLoadup.yml

* First pass implementation of deb installer

* Fixing wget of vncviewer in build_deb.sh

* Fix typo in buildLoadup.yml in call to build_deb.sh

* Multiple small fixes to medley.sh from debugging.  Change postinst script and how its created in build_deb.  Add postrm script in build_deb.

* Reworking vnc portion of Medley.sh - including removing dependency on startx and xinit

* Misc fixes to medley_vnc.sh script; fix creation of postinst and postrm in build_deb.sh

* Cleaning up window geometry amd screen size in medley.sh

* Created apps.sysout loadup with rooms, notecards, clos on top of full.sysout; added plumbing for -apps flag to run-medley to run this syout; created a new init file for this sysout that calls MEDLEYDIR-INIT;  all of this is based on online.sysout

* Create UNIXUTILS file in library with ShellWhich function - linux which command equivalent.  Also move ShellCommand from UNIXPRINT to UNIXUTILS.

* Adding UNIXUTILS to LOADUP-FULL so it gets included in full.sysout

* Change of names from open(er) to browse(r). Refine the browse(r) functions a bit

* Minor bug fixes

* Update Apps.ShowDoc to new ShellBrowsefunction

* Adding apps support into the .github builds;  adding xdg-utils as dependecy in debs

* fixing bug as to where notecards is checked out in BuildLoadup.  Needs to be before loadups so app.sysout can be built

* Added defaulting to Interlisp exec tomedley.sh and APPS-INIT.  Works only in apps.sysout.  Added wlsu package to wsl debs since wlsview is not always installed by defailt.  Fixed Notefiles directories issues in Apps.Init.   Made medley.sh compute medleydir based on where the script is located. Can now work for /usr/lcal/interlisp as well as local directories.

* Added -id - feature to medley.sh so id can be directory mae.  Removed extraneous set -x commands in medley.sh from debugging.  In build_deb.sh changed compression to xz for deb files since debian does not support the zstd compression that ubuntu uses.

* For wsl deb files, make sure wslu package is not 4.0 - which is bad.  Change how we choose an open port and open display in medley_vnc.sh.  Add notecards download to build_deb.sh.  Fix type in medley.sh

* Add (FILES UNIXUTILS) to UNIXPRINTCOMS so that ShellCommand is loaded in case only UNIXPRINT is loaded.  For backward compatibility.

* Moved medley.sh and associates to script/medley dir; fixed up args to medley.sh;  added usage and --help to medley.sh

* Add comprehensive tar files to releases to match deb files for local installs; add --id -- arg to medley.sh

* Remove remaining reference to usr/local/interlisp to ensure local install works

* Fix bug in buildLoadup - couldn't file install tars

* Add medley symbolic linkto loadups, so it comes thru to local install tars

* Fix up error messaging in medley.sh scripts

* Created man page for medley and added it throughout build up, installers, etc.

* Add support for a downloads page on OIO, including creating said page while building a release

* Fix full_release_tag in downloads section of buildLoadup.yml

* Misc fixups on downloads page

* Adding online man page stored on oio static server.

* Fix minor bug in man installation in deb file
2023-01-30 22:19:07 -08:00
Larry Masinter
0c9b539bc4 masterscope extensions doc (internal) + tweak helpsys (#1048) 2023-01-17 22:23:06 -08:00
rmkaplan
b53b6c4ba7 Rmk74 run with pseudohosts (#1017)
* FILEPKG: EDITCALLERS now notices possible new stream after getting filemap

* GITFNS: cdw and cdg commands preserve pseudohost

* SAMEDIR:  match all combinations of truefilename and pseudofilename

* PSEUDOHOSTS:  Bug fix--openstream failure goes thru normal error machinery

* ADIR: Put in stubs for TRUEFILENAME, PSEUDOFILENAME, PSEUDOHOSTP

Also, fix \COPYSYS so it works with pseudhosts
2023-01-16 00:36:39 -08:00
Larry Masinter
e5593ba0dc notify \IDLING.OVER in \IDLE.OUT (#973)
\IDLE.OUT is a backgrround function. For reasons not well understood, sometimes after returning from LOGOUT, the RESETSAVED notify to \IDLING.OVER doesn't happen.
This change insures that it does.
(found during testing of LOGOUT/return from LOGOUT with changing ethernet enalbing)
2022-12-31 08:44:22 -08:00
Larry Masinter
5fea4e6666 loadup-db.sh fix -- don't rely on loadups (#1035) 2022-12-29 19:11:19 -08:00
Larry Masinter
306af20e91 The macroexpansion of UNDOABLY shouldn't depend on runtime rebinding of LISPXHIST (#1023)
The history and undo code was written before the record package; but someone introduced a DEFMACRO UNDOABLY macro to do the work. But cached macroexpansions shouldn't depend on load/run/compile time values.
2022-12-29 18:48:12 -08:00
rmkaplan
bb637c5b73 UNIXCOMM: Eliminated the new shell device in favor of a single shell device (#1034)
Also removed unused functions labeled as "obsolete" after Medley 2
2022-12-23 11:37:23 -08:00
Larry Masinter
7eb12ee68b Revert "Lmm cleanup new shell device (#1006)" (#1033)
This reverts commit 97cb04be46.
2022-12-17 17:22:41 -08:00
Larry Masinter
97cb04be46 Lmm cleanup new shell device (#1006)
* reset defaultexternalformat when returning

* Replace so *SHELL-DEVICE* is default
2022-12-02 20:48:48 -08:00
Frank Halasz
62754015b0 Update Medley build workflow to add clos to release tars and to update various actions to latest versions (#1025)
* Add clos to release tars for Medley.  To ease adding clos to Medley Online.

* Fix buildLoadup.yml to account for the fact that scripts/loadup-all.sh now automatically includes scripts/copy-all.sh.  Was failing due to redundant copying of loadup files.

* Get rid of ::set-output:: in buildLoadup.yml and replace with echo >> .  This is due to that fact that ::set-output:: has been deprecated by Github and will soon cause an error if used in a workflow.

* Update actions/checkout and robinraju/release-downloader to latest versions because versions currently being used relied on Node 12, which has been deprecated.  Newer versions of these actions use Node 16, which is still supported.

* Fix typo in actions/checkout new version number

* Oops.  Node 16 is supported by actions/checkout@v3 not by ...@v2.5.0

* Update AButler/upload-release-assets fron @v2.0 to @v2.0.2 to take care of Node 12 versus Node16 issues caused by Node 12 actions being deprecated by github.

* Fix quoting bugs on conversions from ::set-output:: to

* Try switching to the ncipollo/release-action acgtion in place of using the api to create the release and then the AButler/upload-release-assets action to upload the assets.  This is to solve the failures when try to update a release using the force input parameter.

* Adding step to delete existing release with given tag, if any.  Needed when force parameter is true.

* Fixing typo?

* Typos again?

* Start changing how RELEASE_TAG environment variable is used throughout build_loadup

* Finish changing how RELEASE_TAG environment variable is used throughout build_loadup

* Update abatilo/release-info-action to v1.3.2 to take care of ::set-output:: deprecation

* Add commit to allow testing of release builds

* Fix to Issue#1022 Error during greet

* More fix to Issue#1022.  Turns out need to reset MEDLEYDIR for AFTERMAKESYS as well as at greet time.  Discovered during loadup-online.sh with no greet file.

* Removing AFTERMAKESYS event action from (MEDLEY-INIT-VARS).  Cleaning up a bit the GREET event action in (MEDLEY-INIT-VARS).  Remove issue with MEDLEY-INIT-VARS being called after the user greet file in the AFTERMAKESYS case.
2022-11-26 15:05:45 -08:00
Frank Halasz
9d09033cc4 Fix to Issue#1022 "Error during greet" (#1027)
* Fix to Issue#1022 Error during greet

* More fix to Issue#1022.  Turns out need to reset MEDLEYDIR for AFTERMAKESYS as well as at greet time.  Discovered during loadup-online.sh with no greet file.

* Removing AFTERMAKESYS event action from (MEDLEY-INIT-VARS).  Cleaning up a bit the GREET event action in (MEDLEY-INIT-VARS).  Remove issue with MEDLEY-INIT-VARS being called after the user greet file in the AFTERMAKESYS case.
2022-11-26 11:46:41 -08:00
Nick Briggs
d9c144d966 Allow user override of -title option (#1026) 2022-11-21 13:04:07 -08:00
172 changed files with 8208 additions and 3583 deletions

78
.github/workflows/Dockerfile_medley vendored Normal file
View File

@@ -0,0 +1,78 @@
#*******************************************************************************
#
# Dockerfile to build Medley image from latest Maiko image
# plus latest release tars from github
#
# Copyright 2022-2023 by Interlisp.org
#
# ******************************************************************************
FROM ubuntu:22.10
ARG TARGETPLATFORM
# Handle ARGs, ENV variables, and LABELs
ARG BUILD_DATE=unknown
ARG MEDLEY_RELEASE=unknown
ARG MAIKO_RELEASE=unknown
ARG REPO_OWNER=Interlisp
LABEL name="Medley"
LABEL description="The Medley Interlisp environment"
LABEL url="https://github.com/${REPO_OWNER}/medley"
LABEL build-date=$BUILD_DATE
LABEL medley_release=$MEDLEY_RELEASE
LABEL maiko_release=$MAIKO_RELEASE
ENV MEDLEY_DOCKER_BUILD_DATE=$BUILD_DATE
ENV MEDLEY_RELEASE=$MEDLEY_RELEASE
ENV MAIKO_RELEASE=$MAIKO_RELEASE
ENV LANG=C.UTF-8
# Copy over the release deb files
ADD ./*.deb /tmp
# Install Medley/Maiko and add tightvnc server and xclip to the image
RUN apt-get update \
&& apt-get install -y apt-utils \
&& apt-get install -y tigervnc-standalone-server \
&& apt-get install -y xclip \
&& apt-get install -y man-db \
&& apt-get install -y nano \
&& apt-get install -y sudo \
&& p=$(echo "${TARGETPLATFORM}" | sed -e "s#linux/##") \
&& p=$( \
if [ "$p" = "amd64" ]; \
then echo "x86_64"; \
elif [ "$p" = "arm64" ]; \
then echo "aarch64"; \
elif [ "$p" = "arm/v7" ]; \
then echo "armv7l"; \
else \
echo "x86_64"; \
fi \
) \
&& deb="medley-full-${MEDLEY_RELEASE#medley-}" \
&& deb=${deb}_${MAIKO_RELEASE#maiko-}-linux-${p}.deb \
&& apt-get install -y /tmp/${deb} \
&& chown --recursive root:root /usr/local/interlisp \
&& (if [ -n "$(which unminimize)" ]; then (yes | unminimize); fi)
# "Finalize" image
EXPOSE 5900
RUN adduser --gecos "" medley \
&& adduser --gecos "" ubuntu \
&& adduser medley sudo \
&& adduser ubuntu sudo \
&& (echo 'medley:yeldem' | chpasswd ) \
&& (echo 'ubuntu:utnubu' | chpasswd ) \
&& echo "medley ALL=(ALL) NOPASSWD:ALL" >>/etc/sudoers \
&& echo "ubuntu ALL=(ALL) NOPASSWD:ALL" >>/etc/sudoers \
&& mkdir -p /home/medley/il \
&& chown medley:medley /home/medley/il
ENV TERM=xterm
USER medley
WORKDIR /home/medley
#ENTRYPOINT USER=medley Xvnc -SecurityTypes none -geometry 1280x720 :0 & DISPLAY=:0 medley --full -g 1280x720
ENTRYPOINT /bin/bash

View File

@@ -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,58 +135,61 @@ jobs:
steps:
# Checkout latest commit
- name: Checkout Medley
uses: actions/checkout@v2
uses: actions/checkout@v3
# Find latest release (draft or normal)
# and download its assets
- name: Download linux debs from latest (draft) release
run: |
tag=""
if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
then
tag=$(gh release list | grep Draft | head -n 1 | awk '{ print $3 }')
fi
if [ -z "${tag}" ];
then
tag=$(gh release list | grep Latest | head -n 1 | awk '{ print $3 }')
fi
mkdir -p release_debs
gh release download ${tag} -D release_debs -p '*-linux-*.deb'
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
# Get Maiko and Medley release information from name of deb files
# just downloaded from the Medley latest release
- name: Get info about Miako and Medley releases
id: release_info
run: |
regex="^[^0-9]*\([^_]*\)_\([^-]*-[^-]*\)-\([^-]*\)-\([^.]*\).*\$"
ls -1 release_debs | head -n 1 > debname.tmp
medley_release="medley-$(sed -e "s/${regex}/\1/" debname.tmp)"
maiko_release="maiko-$(sed -e "s/${regex}/\2/" debname.tmp)"
rm -f debname.tmp
echo "MEDLEY_RELEASE=${medley_release}" >> ${GITHUB_ENV}
echo "MAIKO_RELEASE=${maiko_release}" >> ${GITHUB_ENV}
# Set repo env variables
- name: Set repo/docker env variables
id: repo_env
run: |
REPO_NAME=${GITHUB_REPOSITORY#*/}
echo "REPO_NAME=${REPO_NAME}" >> ${GITHUB_ENV}
echo ::set-output name=repo_name::${REPO_NAME}
DOCKER_NAMESPACE=$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')
echo "DOCKER_NAMESPACE=${DOCKER_NAMESPACE}" >> ${GITHUB_ENV}
echo ::set-output name=docker_namespace::${DOCKER_NAMESPACE}
# Get tag of latest Medley release.
- name: Get Medley Release Information
id: release_info
uses: abatilo/release-info-action@v1.3.0
with:
owner: ${{ github.repository_owner }}
repo: medley
# Get asset tars from latest Medley release
- name: Download Release Assets
uses: robinraju/release-downloader@v1.2
with:
repository: ${{ github.repository_owner }}/medley
token: ${{ secrets.GITHUB_TOKEN }}
latest: true
fileName: "*"
out-file-path: "release_tars"
# Get Maiko release information about latest Maiko Docker Image
- name: Get info from latest Maiko image
id: maiko_setup
run: |
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}
# Setup environment variables
- name: Setup Environment Variables
id: setup_env
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}
echo "release_tag=${RELEASE_TAG}" >> ${GITHUB_ENV}
repo_name="${GITHUB_REPOSITORY#*/}"
docker_namespace="$(echo "${{ github.repository_owner }}" | tr '[:upper:]' '[:lower:]')"
docker_image="${docker_namespace}/${repo_name}"
if [ "${{ needs.inputs.outputs.draft }}" = "false" ];
then
docker_tags="${docker_image}:latest,${docker_image}:${MEDLEY_RELEASE#*-}_${MAIKO_RELEASE#*-}"
platforms="linux/amd64,linux/arm64"
else
docker_tags="${docker_image}:draft"
platforms="linux/amd64"
fi
echo "REPO_NAME=${repo_name}" >> ${GITHUB_ENV}
echo "DOCKER_NAMESPACE=${docker_namespace}" >> ${GITHUB_ENV}
echo "DOCKER_IMAGE=${docker_image}" >> ${GITHUB_ENV}
echo "DOCKER_TAGS=${docker_tags}" >> ${GITHUB_ENV}
echo "BUILD_DATE=$(date -u +'%Y-%m-%dT%H:%M:%SZ')" >> ${GITHUB_ENV}
echo "PLATFORMS=${platforms}" >> ${GITHUB_ENV}
#linux/amd64,linux/arm64,linux/arm/v7
# Setup the Docker Machine Emulation environment.
- name: Set up QEMU
@@ -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,21 +213,20 @@ 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: |
BUILD_DATE=${{ steps.setup_env.outputs.build_time }}
RELEASE_TAG=${{ steps.setup_env.outputs.release_tag }}
MAIKO_RELEASE=${{ steps.setup_env.outputs.maiko_release }}
DOCKER_NAMESPACE=${{ steps.repo_env.outputs.docker_namespace }}
BUILD_DATE=${{ env.BUILD_DATE }}
MEDLEY_RELEASE=${{ env.MEDLEY_RELEASE }}
MAIKO_RELEASE=${{ env.MAIKO_RELEASE }}
REPO_OWNER=${{ github.repository_owner }}
context: ./release_tars
file: ./Dockerfile
platforms: linux/amd64,linux/arm64,linux/arm/v7
context: ./release_debs
file: ./.github/workflows/Dockerfile_medley
platforms: ${{ env.PLATFORMS }}
# Push the result to DockerHub
push: true
tags: ${{ steps.setup_env.outputs.docker_tags }}
tags: ${{ env.DOCKER_TAGS }}
######################################################################################
@@ -225,7 +245,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 +261,6 @@ jobs:
- name: Output
id: output
run: |
echo ::set-output name=build_successful::'true'
echo "build_successful='true'" >> ${GITHUB_OUTPUT}
######################################################################################

View File

@@ -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,11 +39,19 @@ 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
type: string
default: 'false'
secrets:
OIO_SSH_KEY:
required: true
defaults:
run:
@@ -54,13 +68,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 +100,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 }}
@@ -95,6 +116,8 @@ jobs:
######################################################################################
#
# Do the loadup
#
@@ -102,6 +125,12 @@ jobs:
runs-on: ubuntu-latest
outputs:
combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }}
medley_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_RELEASE_TAG }}
medley_short_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_SHORT_RELEASE_TAG }}
debs_filename_base: ${{ steps.debs.outputs.DEBS_FILENAME_BASE }}
needs: [inputs, sentry]
if: |
needs.sentry.outputs.release_not_built == 'true'
@@ -110,7 +139,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,75 +147,111 @@ jobs:
# Checkout latest commit
- name: Checkout Medley
uses: actions/checkout@v2
uses: actions/checkout@v3
# Setup release tag
- name: Setup Release Tag
id: tag
uses: ./../actions/release-tag-action
# Setup environment variables
- name: Setup Environment Variables
id: setup_env
run: |
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
# 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
# Setup environment variables & establish job outputs
- name: Setup Environment Variables
run: |
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}
echo "MAIKO_RELEASE_TAG=${{ steps.maiko.outputs.latest_tag }}" >>${GITHUB_ENV}
- name: More Environment Variables
run: |
echo "MEDLEY_SHORT_RELEASE_TAG=${MEDLEY_RELEASE_TAG#medley-}" >>${GITHUB_ENV}
echo "MAIKO_SHORT_RELEASE_TAG=${MAIKO_RELEASE_TAG#maiko-}" >>${GITHUB_ENV}
- name: Even More Environment Variables
run: |
echo "COMBINED_RELEASE_TAG=${MEDLEY_SHORT_RELEASE_TAG}_${MAIKO_SHORT_RELEASE_TAG}" >>${GITHUB_ENV}
- name: Establish job outputs
id: job_outputs
run: |
echo "COMBINED_RELEASE_TAG=${COMBINED_RELEASE_TAG}" >> $GITHUB_OUTPUT;
echo "MEDLEY_RELEASE_TAG=${MEDLEY_RELEASE_TAG}" >> $GITHUB_OUTPUT;
echo "MEDLEY_SHORT_RELEASE_TAG=${MEDLEY_SHORT_RELEASE_TAG}" >> $GITHUB_OUTPUT;
# Setup some needed dirs in workspace
- name: Create work dirs
run: mkdir -p ${TARBALL_DIR}
# 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: "${{ env.MAIKO_RELEASE_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}/${{ env.MAIKO_RELEASE_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
# Install vnc
- 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 \
mkdir -p medley/${TARBALL_DIR}
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 \
mkdir -p medley/${TARBALL_DIR}
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 +262,148 @@ jobs:
medley/lispusers \
medley/sources \
medley/internal
env:
release_tag: ${{ steps.tag.outputs.release_tag }}
- name: "Create release"
uses: "actions/github-script@v5"
# Build the deb files as well as the tgz files
- name: Build .deb files for 3 architectures
id: debs
run: |
cd installers/deb
debs_filename_base=$(./build_deb.sh)
echo "DEBS_FILENAME_BASE=${debs_filename_base}" >> $GITHUB_ENV;
echo "DEBS_FILENAME_BASE=${debs_filename_base}" >> $GITHUB_OUTPUT;
# Push the release up to github releases
- 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 }}
#
# Create the Windows installer, push it up to the release on github and
# update the downloads page on OIO
#
windows_installer:
runs-on: windows-latest
needs: [inputs, sentry, loadup]
if: |
needs.sentry.outputs.release_not_built == 'true'
|| needs.inputs.outputs.force == 'true'
steps:
# Checkout latest commit
- name: Checkout Medley
uses: actions/checkout@v3
# Store the values output from loadup job as environment variables
- name: Environment Variables
shell: powershell
run: |
$crt="${{ needs.loadup.outputs.combined_release_tag }}"
echo "COMBINED_RELEASE_TAG=$crt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
$mrt="${{ needs.loadup.outputs.medley_release_tag }}"
echo "MEDLEY_RELEASE_TAG=$mrt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
$msrt="${{ needs.loadup.outputs.medley_short_release_tag }}"
echo "MEDLEY_SHORT_RELEASE_TAG=$msrt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
$debs="${{ needs.loadup.outputs.debs_filename_base }}"
echo "DEBS_FILENAME_BASE=$debs" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
# Download vnc viewer
- name: Download vncviewer
shell: powershell
run: |
$url = "https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe"
$output = "installers\win\vncviewer64-1.12.0.exe"
(New-Object System.Net.WebClient).DownloadFile($url, $output)
# Run iscc.exe to compile the installer
- name: Compile medley.iss
shell: powershell
run: |
iscc installers\win\medley.iss
$filename="medley-install_${env:COMBINED_RELEASE_TAG}_x64.exe"
echo "INSTALLER_FILENAME=$filename" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append
# Upload windows installer to release
- name: Upload windows installer to release
id: push
uses: ncipollo/release-action@v1
with:
allowUpdates: true
artifacts: installers/win/${{ env.INSTALLER_FILENAME }}
tag: ${{ env.MEDLEY_RELEASE_TAG }}
token: ${{ secrets.GITHUB_TOKEN }}
omitBodyDuringUpdate: true
omitDraftDuringUpdate: true
omitNameDuringUpdate: true
omitPrereleaseDuringUpdate: true
# Install the OpenSSH Client
- name: Install the OpenSSH Client
shell: powershell
run: |
Add-WindowsCapability -Online -Name OpenSSH.Client~~~~0.0.1.0
# Update the downloads page and the man page on OIO
- name: Update the downloads page and the man page to the OIO static page host
shell: bash
run: |
# Figure out filenames
download_url="${{ steps.push.outputs.html_url }}"
download_url="${download_url/\/tag\//\/download\/}"
local_template="installers/downloads_page/medley_downloads.html"
local_filename="medley_downloads.html"
local_manpath="docs/man-page/man_medley.html"
if [ "${{ needs.inputs.outputs.draft }}" = "true" ];
then
remote_filename="draft_downloads"
remote_manname="man_draft.html"
else
remote_filename="${local_filename%.html}"
remote_manname="man_medley.html"
fi
remote_filepath="/srv/oio/static/${remote_filename}"
remote_manpath="/srv/oio/static/${remote_manname}"
# Fill in downloads page template
sed \
-e "s/@@@MEDLEY.SHORT.RELEASE.TAG@@@/${MEDLEY_SHORT_RELEASE_TAG}/g" \
-e "s~@@@DOWNLOAD_URL@@@~${download_url}~g" \
-e "s/@@@DEBS.FILENAME.BASE@@@/${DEBS_FILENAME_BASE}/g" \
-e "s/@@@WINDOWS.INSTALLER.FILENAME@@@/${INSTALLER_FILENAME}/g" \
< "${local_template}" > "${local_filename}"
# Create sftp instruction file
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
# Do the sftp
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 }}
######################################################################################
@@ -244,12 +418,12 @@ jobs:
outputs:
build_successful: ${{ steps.output.outputs.build_successful }}
needs: [inputs, sentry, loadup]
needs: [inputs, sentry, loadup, windows_installer]
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 +439,24 @@ jobs:
- name: Output
id: output
run: |
echo ::set-output name=build_successful::'true'
echo "build_successful='true'" >> $GITHUB_OUTPUT
######################################################################################
# - name: Download the Windows installer created in windows job
# uses: actions/download-artifact@v3
# with:
# name: windows_installer
# path: installers/win
# - name: Rename the Windows installer w/ version tag
# run: |
# maiko_release_tag="${{ steps.maiko.outputs.latest_tag }}"
# combined_release_tag="${MEDLEY_RELEASE_TAG#medley-}_${maiko_release_tag#maiko-}"
# windows_installer_filename="medley_install_${combined_release_tag}_x64.exe"
# cd installers/win
# mv medley_install_vXXXVERSIONXXX_x64.exe "${windows_installer_filename}"
# echo "WINDOWS_INSTALLER_FILENAME=${windows_installer_filename}" >>${GITHUB_ENV}

View File

@@ -18,19 +18,98 @@ name: "Build/Push Release & Docker"
# Run this workflow on ...
on:
schedule:
- cron: '0 9 * * 1'
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 "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
else
echo "draft=false" >> $GITHUB_OUTPUT;
echo "force=false" >> $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 }}
secrets:
OIO_SSH_KEY: ${{ secrets.OIO_SSH_KEY }}
######################################################################################
# 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 }}
######################################################################################

View File

@@ -1,23 +0,0 @@
name: 'Test Docker Login'
# Run this workflow on ...
on:
workflow_dispatch:
defaults:
run:
shell: bash
jobs:
login_test:
runs-on: ubuntu-latest
steps:
- id: only_step
uses: docker/login-action@v1
with:
username: ${{ secrets.DOCKER_USERNAME }}
password: ${{ secrets.DOCKER_PASSWORD }}

6
.gitignore vendored
View File

@@ -10,6 +10,7 @@ loadups/lisp.sysout
loadups/full.sysout
loadups/*.dribble
loadups/whereis.hash
loadups/apps.sysout
# manual cross-reference files
@@ -37,3 +38,8 @@ core
# Mac OS detritus
.DS_Store
*.PS
# nano detritus
*.swp
*.save

View File

@@ -1,54 +0,0 @@
#*******************************************************************************
#
# Dockerfile to build Medley image from latest Maiko image
# plus latest release tars from github
#
# Copyright 2022 by Interlisp.org
#
# ******************************************************************************
ARG DOCKER_NAMESPACE=interlisp
FROM ${DOCKER_NAMESPACE}/maiko:latest
# Add tightvnc server and xclip to the image
RUN apt-get update && apt-get install -y tightvncserver && apt-get install -y xclip
# Handle ARGs, ENV variables, and LABELs
ARG BUILD_DATE=unknown
ARG RELEASE_TAG=unknown
ARG MAIKO_RELEASE=unknown
ARG REPO_OWNER=Interlisp
LABEL name="Medley"
LABEL description="The Medley Interlisp environment"
LABEL url="https://github.com/${REPO_OWNER}/medley"
LABEL build-time=$BUILD_DATE
LABEL release_tag=$RELEASE_TAG
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 DOCKER_NAMESPACE=interlisp
ENV DOCKER_NAMESPACE=${DOCKER_NAMESPACE}
# Copy over the release tars
RUN mkdir -p ${INSTALL_LOCATION}
ADD ./*.tgz ${INSTALL_LOCATION}
# 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}/medley" >> /usr/local/bin/run-medley && \
echo './run-medley "$@"' >> /usr/local/bin/run-medley && \
chmod ugo+x /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

View File

@@ -105,8 +105,7 @@ dump of your system located in your home directory named
specify a specific image to run, Medley restores that image so that
you can continue right where you left off.
* [Using Medley Interlisp](https://github.com/Interlisp/medley/wiki/Using-Medley-Interlisp)
* [Using Medley Interlisp](https://interlisp.org/doc/info/Using.html)
## Naming conventions and directory structure

2
docs/man-page/man2html.sh Executable file
View File

@@ -0,0 +1,2 @@
#!/bin/bash
pandoc --from man --to html < medley.1 > man_medley.html

View File

@@ -0,0 +1,107 @@
<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 Medleys 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. Ignored when when the --vnc flag is set or when running on Windows (Docker) installations.</p>
</dd>
<dt><strong>-d <em>:N</em>, --display <em>:N</em> ** <strong>Not</strong> applicable to Windows (Docker) installations **</strong></dt>
<dd><p>Use X display :N. Defaults to the value of $DISPLAY. This flag is ignored when the --vnc flag is set as well as on Windows (Docker) installations.</p>
</dd>
<dt><strong>-v, --vnc ** <strong>Applicable</strong> only to WSL 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. This flag is always set for WSL1 installations.</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 <em>N</em> 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. On Windows (Docker) installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</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. On Windows (Docker) installations, <em>FILE</em> is specified in the Medley file system, not the host Windows file system.</p>
</dd>
<dt><strong>-x [<em>DIR</em> | -], --logindir [<em>DIR</em> | -] ** <strong>On</strong> Linux and WSL installations **</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>
<dt><strong>-x [<em>DIR</em> | -], --logindir [<em>DIR</em> | -] ** <strong>On</strong> Windows (Docker) installations **</strong></dt>
<dd><p>Map DIR in the Windows host file system to /home/medley/il in the Medley file system (in the Docker container). LOGINDIR is always /home/medley/il from Medleys standpoint. The “-” value is not valid in this case.</p>
</dd>
<dt><strong>-u, --update ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
<dd><p>Before running Medley, do a pull to retrieve the latest interlisp/medley docker image from Docker Hub.</p>
</dd>
<dt><strong>-b, --background ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
<dd><p>Run Medley in background rather than foreground.</p>
</dd>
<dt><strong>-p <em>PORT</em>, --port <em>PORT</em> ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
<dd><p>Use <em>PORT</em> as the port that VNC viewer uses to contact the VNC server within the Docker container. Default is 5900.</p>
</dd>
<dt><strong>-w [<em>DISTRO</em> | -], --wsl [<em>DISTRO</em> | -] ** <strong>Windows</strong> (Docker) installations only **</strong></dt>
<dd><p>Run Medley in the context of the named WSL <em>DISTRO</em> instead of within Docker. If <em>DISTRO</em> is “-”, used the default WSL distro. Equivalent to typing “wsl -d <em>DISTRO</em> medley ...” into a Command or Powershell window.</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). On Windows (Docker) installations, <em>SYSOUT_FILE</em> is specified in the Medley file system, not the host Windows file system.</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: &lt;https://github.com/Interlisp/medley/issues&gt;</p>
<h1>COPYRIGHT</h1>
<p>Copyright(c) 2023 by Interlisp.org</p>

3
docs/man-page/md2man.sh Executable file
View File

@@ -0,0 +1,3 @@
#!/bin/bash
pandoc medley.1.md -s -t man -o medley.1
gzip --stdout medley.1 >medley.1.gz

220
docs/man-page/medley.1 Normal file
View File

@@ -0,0 +1,220 @@
.\" 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.
Ignored when when the \-\-vnc flag is set or when running on Windows
(Docker) installations.
.TP
.B \-d \f[I]:N\f[R], \-\-display \f[I]:N\f[R]\ \ \ \ ** \f[B]Not applicable to Windows (Docker) installations\f[R] **
Use X display :N.
Defaults to the value of $DISPLAY.
This flag is ignored when the \-\-vnc flag is set as well as on Windows
(Docker) installations.
.TP
.B \-v, \-\-vnc\ \ \ \ ** \f[B]Applicable only to WSL installations\f[R] **
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.
This flag is always set for WSL1 installations.
.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 \f[I]N\f[R] 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.
On Windows (Docker) installations, \f[I]FILE\f[R] is specified in the
Medley file system, not the host Windows file system.
.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.
On Windows (Docker) installations, \f[I]FILE\f[R] is specified in the
Medley file system, not the host Windows file system.
.TP
.B \-x [\f[I]DIR\f[R] | \-], \-\-logindir [\f[I]DIR\f[R] | \-]\ \ \ \ ** \f[B]On Linux and WSL installations\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.
.TP
.B \-x [\f[I]DIR\f[R] | \-], \-\-logindir [\f[I]DIR\f[R] | \-]\ \ \ \ ** \f[B]On Windows (Docker) installations\f[R] **
Map DIR in the Windows host file system to /home/medley/il in the Medley
file system (in the Docker container).
LOGINDIR is always /home/medley/il from Medley\[cq]s standpoint.
The \[lq]\-\[rq] value is not valid in this case.
.TP
.B \-u, \-\-update\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
Before running Medley, do a pull to retrieve the latest interlisp/medley
docker image from Docker Hub.
.TP
.B \-b, \-\-background\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
Run Medley in background rather than foreground.
.TP
.B \-p \f[I]PORT\f[R], \-\-port \f[I]PORT\f[R]\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
Use \f[I]PORT\f[R] as the port that VNC viewer uses to contact the VNC
server within the Docker container.
Default is 5900.
.TP
.B \-w [\f[I]DISTRO\f[R] | \-], \-\-wsl [\f[I]DISTRO\f[R] | \-]\ \ \ \ ** \f[B]Windows (Docker) installations only\f[R] **
Run Medley in the context of the named WSL \f[I]DISTRO\f[R] instead of
within Docker.
If \f[I]DISTRO\f[R] is \[lq]\-\[rq], used the default WSL distro.
Equivalent to typing \[lq]wsl \-d \f[I]DISTRO\f[R] medley \&...\[rq]
into a Command or Powershell window.
.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).
On Windows (Docker) installations, \f[I]SYSOUT_FILE\f[R] is specified in
the Medley file system, not the host Windows file system.
.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

Binary file not shown.

184
docs/man-page/medley.1.md Normal file
View File

@@ -0,0 +1,184 @@
% 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
-----
&nbsp;
-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. Ignored when when the \-\-vnc flag is set or when running on Windows (Docker)
installations.
-d *:N*, \-\-display *:N*&nbsp;&nbsp;&nbsp;&nbsp;\*\* **Not applicable to Windows (Docker) installations** \*\*
~ Use X display :N. Defaults to the value of $DISPLAY. This flag is ignored when the \-\-vnc flag is set as
well as on Windows (Docker) installations.
-v, \-\-vnc&nbsp;&nbsp;&nbsp;&nbsp;\*\* **Applicable only to WSL 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. This flag is always set for WSL1 installations.
-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. On Windows (Docker) installations, *FILE* is specified in the Medley file system, not the host Windows file system.
-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. On Windows (Docker) installations, *FILE* is
specified in the Medley file system, not the host Windows file system.
-x \[*DIR* | -], \-\-logindir \[*DIR* | -]&nbsp;&nbsp;&nbsp;&nbsp;\*\* **On Linux and WSL installations** \*\*
: 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.
-x \[*DIR* | -], \-\-logindir \[*DIR* | -]&nbsp;&nbsp;&nbsp;&nbsp;\*\* **On Windows (Docker) installations** \*\*
: Map DIR in the Windows host file system to /home/medley/il in the Medley
file system (in the Docker container). LOGINDIR is always /home/medley/il from Medley's standpoint. The "-" value is not valid in this case.
-u, \-\-update&nbsp;&nbsp;&nbsp;&nbsp;\*\* **Windows (Docker) installations only** \*\*
: Before running Medley, do a pull to retrieve the latest interlisp/medley docker image from Docker Hub.
-b, \-\-background&nbsp;&nbsp;&nbsp;&nbsp;\*\* **Windows (Docker) installations only** \*\*
: Run Medley in background rather than foreground.
-p *PORT*, \-\-port *PORT*&nbsp;&nbsp;&nbsp;&nbsp;\*\* **Windows (Docker) installations only** \*\*
: Use *PORT* as the port that VNC viewer uses to contact the VNC server within the Docker container. Default is 5900.
-w \[*DISTRO* | -], \-\-wsl \[*DISTRO* | -]&nbsp;&nbsp;&nbsp;&nbsp;\*\* **Windows (Docker) installations only** \*\*
: Run Medley in the context of the named WSL *DISTRO* instead of within Docker. If *DISTRO* is "-", used the default WSL distro. Equivalent to typing "wsl -d *DISTRO* medley ..." into a Command or Powershell window.
Other Options
-------------
&nbsp;
*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). On Windows (Docker) installations, *SYSOUT_FILE* is
specified in the Medley file system, not the host Windows file system.
*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
View File

@@ -0,0 +1,4 @@
#!/bin/bash
./md2man.sh
./man2html.sh

2
docs/man-page/showmd.sh Executable file
View File

@@ -0,0 +1,2 @@
#!/bin/bash
pandoc medley.1.md -s -t man | /usr/bin/man -l -

380
greetfiles/APPS-INIT Normal file
View 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

Binary file not shown.

View File

@@ -1,10 +1,13 @@
(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 "13-Apr-2023 09:44:06" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;6 2925
:EDIT-BY "lmm"
:CHANGES-TO (VARS MEDLEYDIR-INITCOMS)
:PREVIOUS-DATE "28-Feb-2022 21:13:20" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
:PREVIOUS-DATE "10-Apr-2023 11:58:07" {DSK}<home>larry>il>medley>greetfiles>MEDLEYDIR-INIT.;5
)
(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
@@ -13,7 +16,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
@@ -21,24 +24,25 @@
(DWIMWAIT 180)
(HELPDEPTH 4)
(HELPTIME 10)
(HELPTIME 1)
(FILING.ENUMERATION.DEPTH 1)
[LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
(UNIX-GETENV "HOME"]
[USERGREETFILES `((,LOGINDIR "INIT" COM)
(,LOGINDIR "INIT"]
(COPYRIGHTFLG 'NEVER)
(COPYRIGHTSRESERVED NIL)
(AUTOBACKTRACEFLG 'ALWAYS)
(MAXLEVEL 30000)
(MAXLOOP 30000))
(FNS INTERLISPMODE)
(ALISTS (FONTDEFS LARGER))))
(ALISTS (FONTDEFS))))
(LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
"")
"/sources/MEDLEYDIR.LCOM"))
(MEDLEY-INIT-VARS)
(MEDLEY-INIT-VARS 'GREET)
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
@@ -48,7 +52,7 @@
(RPAQQ HELPDEPTH 4)
(RPAQQ HELPTIME 10)
(RPAQQ HELPTIME 1)
(RPAQQ FILING.ENUMERATION.DEPTH 1)
@@ -58,6 +62,8 @@
(RPAQ USERGREETFILES `((,LOGINDIR "INIT" COM)
(,LOGINDIR "INIT")))
(RPAQQ COPYRIGHTFLG NEVER)
(RPAQQ COPYRIGHTSRESERVED NIL)
(RPAQQ AUTOBACKTRACEFLG ALWAYS)
@@ -81,44 +87,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 (2051 2876 (INTERLISPMODE 2061 . 2874)))))
STOP

Binary file not shown.

7
installers/deb/.gitignore vendored Normal file
View File

@@ -0,0 +1,7 @@
/tmp
*.deb
*.swp
*.save
/tars
/debs

1
installers/deb/build Symbolic link
View File

@@ -0,0 +1 @@
build_deb.sh

158
installers/deb/build_deb.sh Executable file
View File

@@ -0,0 +1,158 @@
#!/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
# mess with file desscriptors so we get only one line on stdout
# so we can communicate only what we want back to any githib runner
# stash fd 1 in fd 3
exec 3>&1
# make fd 1 (stdout) be the same as stdout
# so none of the std output from this file will be captured by
# $() but it will still be written out to the tty (via stderr)
exec 1>&2
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/")
debs_filename_base="medley-full-${medley_release}_${maiko_release}"
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
#
# Make sure all files are owned by root
#
sudo su <<< "chown --recursive root:root ${il_dir}"
#
# Create tar file for this arch
#
filename="${debs_filename_base}-${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
# send just one line back to github $() construct
# do this by restoring fd 1 to what it was orginally
exec 1>&3
echo "${debs_filename_base}"

View File

@@ -0,0 +1,9 @@
Package: medley-interlisp
Version: 1.0.1
Release: --RELEASE--
Maintainer: info@interlisp.org
Description: Medley Interlisp for Linux
Homepage: https://github.com/interlisp/medley
Architecture: --ARCH--
Depends: man-db, xdg-utils

View 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

View 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
View 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
View 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

View File

@@ -0,0 +1,3 @@
#!/bin/bash
markdown medley_downloads.md > medley_downloads.html

View File

@@ -0,0 +1,45 @@
<ul>
<li><h1>MEDLEY DOWNLOADS</h1>
<ul>
<li><h2>LINUX (including Windows System for Linux)</h2>
<ul>
<li><h3>Standard Installations (for Debian-based distros)</h3>
<ul>
<li><h4>Standard Linux</h4>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
<li><h4>Windows System for Linux</h4>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86_64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86.64 machines</a></p>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.deb">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
</ul></li>
<li><h3>Local Installations (for any Linux distro)</h3>
<ul>
<li><h4>Standard Linux</h4>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines</a></p></li>
<li><h4>Windows System for Linux</h4>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86_64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86_64 machines</a></p>
<p><a href="@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.tgz">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines</a></p></li>
</ul></li>
</ul></li>
<li><h2>WINDOWS 10/11 (Medley runs in a Docker container)</h2>
<p><a href="@@@DOWNLOAD_URL@@@/@@@WINDOWS.INSTALLER.FILENAME@@@">Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines</a></p></li>
</ul></li>
</ul>

View File

@@ -0,0 +1,45 @@
* # MEDLEY DOWNLOADS
* ## LINUX (including Windows System for Linux)
* ### Standard Installations (for Debian-based distros)
* #### Standard Linux
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86\_64.deb)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.deb)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.deb)
* #### Windows System for Linux
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\.64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86\_64.deb)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.deb)
* ### Local Installations (for any Linux distro)
* #### Standard Linux
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-x86\_64.tgz)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-aarch64.tgz)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARMv7 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-linux-armv7l.tgz)
* #### Windows System for Linux
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for x86\_64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-x86\_64.tgz)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/@@@DEBS.FILENAME.BASE@@@-wsl-aarch64.tgz)
* ## WINDOWS 10/11 (Medley runs in a Docker container)
[Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines](@@@DOWNLOAD_URL@@@/@@@WINDOWS.INSTALLER.FILENAME@@@)

3
installers/win/.gitignore vendored Normal file
View File

@@ -0,0 +1,3 @@
medley-install_*.exe
vncviewer*.exe

BIN
installers/win/Medley.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 155 KiB

View File

@@ -0,0 +1,165 @@
; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com)
;
; This program is free software; you can redistribute it and/or modify it under
; the terms of the GNU Lesser General Public License as published by the Free
; Software Foundation; either version 3 of the License, or (at your option) any
; later version.
;
; This program is distributed in the hope that it will be useful, but WITHOUT
; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more
; details.
;
; You should have received a copy of the GNU Lesser General Public License
; along with this program. If not, see https://www.gnu.org/licenses/.
; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script
; demonstrating use of PathMgr.dll.
;
; This script uses PathMgr.dll in the following ways:
; * Copies PathMgr.dll to the target machine (required for uninstall)
; * Defines a task in [Tasks] that should modify the Path
; * Imports the AddDirToPath() DLL function at setup time
; * Imports the RemoveDirFromPath() DLL function at uninstall time
; * Stores task state as custom setting using RegisterPreviousData()
; * Retrieves task state custom setting during setup and uninstall initialize
; * At post install, adds app dir to Path if task selected
; * At uninstall, removes dir from Path if custom setting present
; * Unloads and deletes DLL and removes app dir at uninstall deinitialize
#if Ver < EncodeVer(6,0,0,0)
#error This script requires Inno Setup 6 or later
#endif
[Setup]
AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842}
AppName=EditPath
AppVersion=4.0.4.0
UsePreviousAppDir=false
DefaultDirName={autopf}\EditPath
Uninstallable=true
OutputDir=.
OutputBaseFilename=EditPath_Setup
ArchitecturesInstallIn64BitMode=x64
PrivilegesRequired=none
PrivilegesRequiredOverridesAllowed=dialog
[Files]
; Install PathMgr.dll for use with both setup and uninstall; use
; uninsneveruninstall flag because DeinitializeSetup() will delete after
; unloading the DLL; install the 32-bit version of PathMgr.dll because both
; setup and uninstall executables are 32-bit
Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall
; Other files to install on target system
Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode()
Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode()
Source: "EditPath.md"; DestDir: "{app}"
[Tasks]
Name: modifypath; Description: "&Add to Path"
[Code]
const
MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task
var
PathIsModified: Boolean; // Cache task selection from previous installs
ApplicationUninstalled: Boolean; // Has application been uninstalled?
// Import AddDirToPath() at setup time ('files:' prefix)
function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD;
external 'AddDirToPath@files:PathMgr.dll stdcall setuponly';
// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix)
function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD;
external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly';
// Wrapper for AddDirToPath() DLL function
function AddDirToPath(const DirName: string): DWORD;
var
PathType, AddType: DWORD;
begin
// PathType = 0 - use system Path
// PathType = 1 - use user Path
// AddType = 0 - add to end of Path
// AddType = 1 - add to beginning of Path
if IsAdminInstallMode() then
PathType := 0
else
PathType := 1;
AddType := 0;
result := DLLAddDirToPath(DirName, PathType, AddType);
end;
// Wrapper for RemoveDirFromPath() DLL function
function RemoveDirFromPath(const DirName: string): DWORD;
var
PathType: DWORD;
begin
// PathType = 0 - use system Path
// PathType = 1 - use user Path
if IsAdminInstallMode() then
PathType := 0
else
PathType := 1;
result := DLLRemoveDirFromPath(DirName, PathType);
end;
procedure RegisterPreviousData(PreviousDataKey: Integer);
begin
// Store previous or current task selection as custom user setting
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true');
end;
function InitializeSetup(): Boolean;
begin
result := true;
// Was task selected during a previous install?
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
end;
function InitializeUninstall(): Boolean;
begin
result := true;
// Was task selected during a previous install?
PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true';
ApplicationUninstalled := false;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
// Add app directory to Path at post-install step if task selected
if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then
AddDirToPath(ExpandConstant('{app}'));
end;
end;
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
if CurUninstallStep = usUninstall then
begin
// Remove app directory from path during uninstall if task was selected;
// use variable because we can't use WizardIsTaskSelected() at uninstall
if PathIsModified then
RemoveDirFromPath(ExpandConstant('{app}'));
end
else if CurUninstallStep = usPostUninstall then
begin
ApplicationUninstalled := true;
end;
end;
procedure DeinitializeUninstall();
begin
if ApplicationUninstalled then
begin
// Unload and delete PathMgr.dll and remove app dir when uninstalling
UnloadDLL(ExpandConstant('{app}\PathMgr.dll'));
DeleteFile(ExpandConstant('{app}\PathMgr.dll'));
RemoveDir(ExpandConstant('{app}'));
end;
end;

View File

@@ -0,0 +1,118 @@
# EditPath
EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path.
# Author
Bill Stewart - bstewart at iname dot com
# License
EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details.
# Download
https://github.com/Bill-Stewart/PathMgr/releases/
# Background
The system Path is found in the following location in the Windows registry:
Root: `HKEY_LOCAL_MACHINE`
Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment`
Value name: `Path`
The current user Path is found in the following location in the registry:
Root: `HKEY_CURRENT_USER`
Subkey: `Environment`
Value name: `Path`
In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.)
The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes.
EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`).
# Usage
The following describes the command-line usage for the program. Parameters are case-sensitive.
**EditPath** [_options_] _type_ _action_
You must specify only one of the following _type_ parameters:
| _type_ | Abbreviation | Description
| ------- | ------------ | -----------
| **--system** | **-s** | Specifies the system Path
| **--user** | **-u** | Specifies the user Path
You must specify only one of the following _action_ parameters:
| _action_ | Abbreviation | Description
| -------- | ------------ | -----------
| **--list** | **-l** | Lists directories in Path
| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path
| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path
| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path
The following parameters are optional:
| _options_ | Abbreviation | Description
| --------- | ------------ | -----------
| **--quiet** | **-q** | Suppresses result messages
| **--expand** | **-x** | Expands environment variables (**--list** only)
| **--beginning** | **-b** | Adds to beginning of Path (**--add** only)
# Exit Codes
The following table lists typical exit codes when not using **--test** (**-t**).
| Exit Code | Description
| --------- | -----------
| 0 | No errors
| 2 | The Path value is not present in the registry
| 3 | The specified directory does not exist in the Path
| 5 | Access is denied
| 87 | Incorrect parameter(s)
| 183 | The specified directory already exists in the Path
The following table lists typical exit codes when using **--test** (**-t**).
| Exit Code | Description
| --------- | -----------
| 1 | The specified directory exists in the unexpanded Path
| 2 | The specified directory exists in the expanded Path
| 3 | The specified directory does not exist in the Path
# Remarks
* Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line.
* Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded.
* The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`.
* The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead.
* The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc.
* The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account).
# Examples
1. `EditPath --expand --system --list`
This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`.
2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"`
Adds the specified directory name to the user Path.
3. `EditPath -s -r "C:\Program Files\MyApp\bin"`
Removes the specified directory from the system Path.
4. `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"`
Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path.

View File

@@ -0,0 +1,3 @@
Editpath installed here is extracted from Release 1.04 from https://github.com/Bill-Stewart/PathMgr.

Binary file not shown.

Binary file not shown.

128
installers/win/makeflix.iss Normal file
View File

@@ -0,0 +1,128 @@
; -- makeflix.iss --
; fgh 2016-08-19
#define x86_or_x64 "x86"
#define version "1.0.1"
#if x86_or_x64 == "x86"
#define exe_dir "Win32"
#else
#define exe_dir "x64"
#endif
[Setup]
ArchitecturesAllowed={#x86_or_x64}
AppName=Makeflix
AppVersion={#version}
AppPublisher=Lellan, Inc.
AppPublisherURL=http://www.lellan.com/
AppCopyright=Copyright (C) 2012-2017 Lellan, Inc.
DefaultDirName={pf}\Lellan\Makeflix
DefaultGroupName=Lellan
UninstallDisplayIcon={app}\makeflix.exe
Compression=lzma2
SolidCompression=yes
; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
; done in "64-bit mode" on x64, meaning it should use the native
; 64-bit Program Files directory and the 64-bit view of the registry.
ArchitecturesInstallIn64BitMode=x64
; Source Dir is lellan/toolchain/makeflix/windows
SourceDir="..\"
OutputDir="deploy"
OutputBaseFilename="makeflix_v{#version}_{#x86_or_x64}"
SetupIconFile="..\images\Lellan_Logo_20130221.ico"
LicenseFile="..\deploy\EULA.rtf"
DisableWelcomePage=no
[Files]
Source: "makeflix\{#exe_dir}\Release\makeflix.exe"; DestDir: "{app}"; DestName: "makeflix.exe"; Flags: ignoreversion
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Core.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Gui.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Widgets.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "deploy\DLLs\{#x86_or_x64}\Qt5Network.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "deploy\DLLs\{#x86_or_x64}\platforms\qwindows.dll"; DestDir: "{app}\platforms"; Flags: ignoreversion
Source: "deploy\gstreamer\{#x86_or_x64}\*"; DestDir: "{app}\gstreamer"; Flags: recursesubdirs ignoreversion
Source: "deploy\vc_redist\vc_redist.{#x86_or_x64}.exe"; DestDir: "{tmp}"; Flags: deleteafterinstall
Source: "deploy\bonjour\Bonjour.{#x86_or_x64}.msi"; DestDir: "{tmp}" ; Flags: deleteafterinstall
Source: "..\deploy\Makeflix_Open_Source_Libraries.pdf"; DestDir: "{app}"
[Icons]
Name: "{group}\Makeflix"; Filename: "{app}\makeflix.exe"
Name: "{group}\Uninstall Makeflix"; Filename: "{uninstallexe}"
[Run]
#define VCmsg "Installing Microsoft Visual C++ Redistributable ..."
Filename: "{tmp}\vc_redist{#x86_or_x64}.exe"; StatusMsg: "{#VCmsg}"; Check: not VCinstalled
#define BonjourMsg "Installing Apple Bonjour support ..."
Filename: "msiexec"; Parameters: "/i {tmp}\Bonjour.{#x86_or_x64}.msi"; StatusMsg: "{#BonjourMsg}"; Check: not BonjourInstalled
[Registry]
Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "(Default)"; ValueData: "{app}\makeflix.exe"; Flags: uninsdeletekey
Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "Path"; ValueData: "{app}\gstreamer\bin"; Flags: uninsdeletekey
[Code]
function VCinstalled: Boolean;
// By Michael Weiner <mailto:spam@cogit.net>
// Function for Inno Setup Compiler
// 13 November 2015
// Modified by Frank G Halasz to handle WOW case
// 23 August 2016
// Returns True if Microsoft Visual C++ Redistributable is installed, otherwise False.
// The programmer may set the year of redistributable to find; see below.
var
names: TArrayOfString;
i: Integer;
dName, key, year, platfm: String;
begin
// Year of redistributable to find; leave null to find installation for any year.
year := '2015';
Result := False;
if Is64BitInstallMode then
begin
platfm := 'x64';
key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
end
else if not IsWin64 then
begin
platfm := 'x86';
key := 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
end
else
begin
platfm := 'x86';
key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall';
end;
// Get an array of all of the uninstall subkey names.
if RegGetSubkeyNames(HKEY_LOCAL_MACHINE, key, names) then
// Uninstall subkey names were found.
begin
i := 0
while ((i < GetArrayLength(names)) and (Result = False)) do
// The loop will end as soon as one instance of a Visual C++ redistributable is found.
begin
// For each uninstall subkey, look for a DisplayName value.
// If not found, then the subkey name will be used instead.
if not RegQueryStringValue(HKEY_LOCAL_MACHINE, key + '\' + names[i], 'DisplayName', dName) then
dName := names[i];
// See if the value contains both of the strings below.
Result := (Pos(Trim('Visual C++ ' + year),dName) * Pos('Redistributable',dName) * Pos(platfm, dName) <> 0)
i := i + 1;
end;
end;
end;
function BonjourInstalled: Boolean;
// Returns True if Apple Bonjour is installed, otherwise False.
// Ignores date/version of Bonjour.
begin
Result := False;
// If this key exists, then
// bonjour services must already be installed
if RegKeyExists(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Services\Bonjour Service') then
// Uninstall subkey names were found.
begin
Result := True;
end;
end;

65
installers/win/medley.iss Normal file
View File

@@ -0,0 +1,65 @@
;###############################################################################
;#
;# medley.iss - Inno Setup compiler script for creating a Windows
;# installer for the medley.ps1 powrshell script for
;# running Medley within a docker container on Windows
;#
;# 2023-02-12 Frank Halasz
;#
;# Copyright 2023 Interlisp.org
;#
;###############################################################################
#define x86_or_x64 "x64"
#if GetEnv('COMBINED_RELEASE_TAG') != ""
#define VERSION=GetEnv('COMBINED_RELEASE_TAG')
#else
#define VERSION="local"
#endif
[Setup]
PrivilegesRequired=lowest
ArchitecturesAllowed={#x86_or_x64}
AppName=Medley
AppVersion={#version}
AppPublisher=Interlisp.org
AppPublisherURL=https://interlisp.org/
AppCopyright=Copyright (C) 2023 Interlisp.org
DefaultDirName={localappdata}\Medley\Scripts
DefaultGroupName=Medley
Compression=lzma2
SolidCompression=yes
; "ArchitecturesInstallIn64BitMode=x64" requests that the install be
; done in "64-bit mode" on x64, meaning it should use the native
; 64-bit Program Files directory and the 64-bit view of the registry.
ArchitecturesInstallIn64BitMode=x64
OutputDir="."
OutputBaseFilename="medley-install_{#version}_{#x86_or_x64}"
SetupIconFile="Medley.ico"
DisableWelcomePage=no
MissingRunOnceIdsWarning=no
DisableProgramGroupPage=yes
WizardImageFile=medley_logo.bmp
WizardSmallImageFile=medley_logo_small.bmp
WizardImageStretch=no
UninstallDisplayIcon="{app}\Medley.ico"
[Files]
Source: "..\..\scripts\medley\medley.ps1"; DestDir: "{app}"; DestName: "medley.ps1"; Flags: ignoreversion
Source: "..\..\scripts\medley\medley.cmd"; DestDir: "{app}"; DestName: "medley.cmd"; Flags: ignoreversion
Source: "editpath\x86_64\EditPath.exe"; DestDir: "{app}"; DestName: "EditPath.exe"; Flags: ignoreversion
Source: "Medley.ico"; DestDir: "{app}"; DestName: "Medley.ico"; Flags: ignoreversion
Source: "vncviewer64-1.12.0.exe"; DestDir: "{app}"; DestName: "vncviewer64-1.12.0.exe"; Flags: ignoreversion
[Icons]
Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}"
Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico"
[Run]
Filename: "{app}\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden
[UninstallRun]
Filename: "{app}\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden

Binary file not shown.

After

Width:  |  Height:  |  Size: 53 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

2
internal/MAINTAIN.TXT Normal file
View File

@@ -0,0 +1,2 @@
MAINTAIN -- Network access to the PUP "Grapevine" server, which did
email, distribution lists. Written ~1985 mainly by Bill van Melle.

View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2| 10212
(FILECREATED "23-May-2023 07:10:58" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;12| 10354
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
:CHANGES-TO (FNS GATHER-INFO)
:PREVIOUS-DATE "22-May-2023 22:57:21" |{DSK}<home>larry>il>medley>internal>MEDLEY-UTILS.;11|)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
@@ -15,7 +17,8 @@
(DEFINEQ
(GATHER-INFO
(LAMBDA (PHASE) (* \; "Edited 26-Dec-2021 18:56 by larry")
(LAMBDA (PHASE) (* \; "Edited 22-May-2023 23:59 by lmm")
(* \; "Edited 26-Dec-2021 18:56 by larry")
(* \; "Edited 24-Oct-2021 09:43 by larry")
(SELECTQ PHASE
(ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
@@ -47,7 +50,7 @@
DEFD))
(|for| X |in| DEFINEDFNS |when| (CCODEP X)
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY BOUND-BY SPECIAL-BY GLOBAL-BY)
|as| VAL |in| Y |do| (|for| S |in| VAL
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
(SETQ CALLEDFNS NIL)
@@ -170,7 +173,7 @@
(DRIBBLE))))
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
. 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
9367 . 10187)))))
(FILEMAP (NIL (624 7499 (GATHER-INFO 634 . 6162) (MAKE-FULLER-DB 6164 . 6854) (MEDLEY-FIX-LINKS 6856
. 7253) (MEDLEY-FIX-DATES 7255 . 7497)) (8538 10331 (MAKE-EXPORTS-ALL 8548 . 9507) (MAKE-WHEREIS-HASH
9509 . 10329)))))
STOP

Binary file not shown.

View File

@@ -1,17 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Feb-2022 14:06:19" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;3 26344
(FILECREATED "26-Apr-2023 12:41:36" {DSK}<home>larry>il>medley>library>BROWSER.;6 29801
:CHANGES-TO (VARS BROWSERCOMS)
(FNS GET.BROWSE.PP.WINDOW NUMSPATHS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "25-Mar-94 13:43:20"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>BROWSER.;1)
:CHANGES-TO (FNS BROWSER.LEFTFN NUMSPATHS STBROWSER MSPATHS.DISPATCH BROWSER
BROWSER.WHENFNSCHANGED BRPATHS1 GET.BROWSE.PP.WINDOW
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH)
(VARS BROWSERCOMS BROWSER.BORDERS)
:PREVIOUS-DATE "15-Apr-2023 18:55:36" {DSK}<home>larry>il>medley>library>BROWSER.;1)
(* ; "
Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT BROWSERCOMS)
@@ -20,27 +20,26 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
GRAPHER)
(CONSTANTS (CHANGEDSHADE 8840)))
(FNS NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN GET.BROWSE.PP.WINDOW
GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN DESCRIBEREPAINTFN
BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP REDRAWBROWSEGRAPH STBROWSER)
(FNS MSPATHS.DISPATCH NUMSPATHS BROWSER BROWSER.WHENFNSCHANGED BRPATHS1 BROWSER.LEFTFN
GET.BROWSE.PP.WINDOW GET.BROWSE.DESCRIBE.WINDOW BROWSEPP PPREPAINTFN PPRESHAPEFN
DESCRIBEREPAINTFN BROWSERDESCRIBE BROWSER.MIDDLEFN DEDITPROCESSRUNNINGP
REDRAWBROWSEGRAPH STBROWSER)
(GLOBALRESOURCES BROWSEHASH)
(DECLARE%: DONTCOPY (RECORDS BROWSEWIN PATHSARGS))
[VARS (BROWSERBOXING)
(BROWSERFORMAT)
(BROWSERWINDOWS)
(NODESELECTIONWINDOW)
(PFWINDOW)
(BROWSER.DESCRIBE.WINDOW)
(BrowserPPWindowWidth 750)
(BROWSERFONT '(GACHA 8]
[P (MOVD? 'MSPATHS 'OLDMSPATHS)
(MOVD? 'NILL 'MODERNWINDOW)
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (SELECTQ (SYSTEMTYPE)
(D (BROWSER T))
NIL])
[INITVARS (BROWSER T)
(BROWSERBOXING)
(BROWSERFORMAT)
(BROWSERWINDOWS)
(NODESELECTIONWINDOW)
(PFWINDOW)
(BROWSER.DESCRIBE.WINDOW)
(BrowserPPWindowWidth 750)
(BROWSERMAX 10)
(BROWSERFONT '(GACHA 8]
(P (MOVD? 'NILL 'MODERNWINDOW))
(VARS BROWSER.BORDERS)
(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (BROWSER T])
(FILESLOAD MASTERSCOPE GRAPHER)
(DECLARE%: EVAL@COMPILE DONTCOPY
@@ -58,64 +57,74 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
)
(DEFINEQ
(NUMSPATHS
(MSPATHS.DISPATCH
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
(* ; "Edited 7-Feb-2022 13:57 by rmk")
(* ; "Edited 11-Apr-88 11:08 by jrb:")
(COND
[(AND (WINDOWWORLD)
(* ; "Edited 15-Apr-2023 11:33 by lmm")
(IF (AND (GETD 'NUMSPATHS)
(WINDOWWORLD)
(EQ (OUTPUT)
T))
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
APPLY LAMBDA (X)
(GETPROP X 'AVOID]
(RESETVARS ((MSPRINTFLG))
(AND INVERTED (UPDATECHANGED))
(STBROWSER
[GLOBALRESOURCE
BROWSEHASH
(PROG [X NAMED TEM (UNDONE (MSLISTSET FROM T))
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
(CALLRELATION (PARSERELATION 'CALL]
(DECLARE (SPECVARS SEEN UNDONE GRAPHNODE.LIST))
(CLRHASH SEEN)
(for X in UNDONE do (PUTHASH X (COND
((AND NOTRACE (MSMEMBSET X NOTRACE))
-1)
(T 0))
SEEN)
(OR INVERTED (UPDATEFN X NIL 0)))
[do (COND
(NAMED (PUTHASH (CAR NAMED)
0 SEEN)
[push ROOTS (fetch (GRAPHNODE NODEID)
of (BRPATHS1 (CAR NAMED]
(SETQ NAMED (CDR NAMED)))
(UNDONE [COND
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
SEEN)))
(EQ TEM 0)
(AND (LISTP TEM)
(NULL (CAR TEM]
(PUTHASH (CAR UNDONE)
(LIST NIL)
SEEN)
(SETQ NAMED (LIST (CAR UNDONE]
(SETQ UNDONE (CDR UNDONE)))
(T (RETURN]
(RETURN (LAYOUTFOREST GRAPHNODE.LIST ROOTS BROWSERFORMAT BROWSERBOXING]
(PROG1 (LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE)
(* ;
 "this LIST is actually an 'instance' of PATHSARGS")
]
(T (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
THEN (NUMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING)
ELSE (OLDMSPATHS FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING])
(NUMSPATHS
[LAMBDA (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
(DECLARE (SPECVARS INVERTED GRAPHNODE.LIST)) (* ; "Edited 26-Apr-2023 09:12 by lmm")
(* ; "Edited 15-Apr-2023 18:43 by lmm")
(* ; "Edited 7-Feb-2022 13:57 by rmk")
(* ; "Edited 11-Apr-88 11:08 by jrb:")
[OR AVOIDING (SETQ AVOIDING '(NIL (NIL NIL . FNS)
APPLY LAMBDA (X)
(GETPROP X 'AVOID]
(AND INVERTED (UPDATECHANGED))
(OR DEPTH (SETQ DEPTH BROWSERMAX))
(WITH-RESOURCES BROWSEHASH (PROG [NAMED TEM (UNDONE (MSLISTSET FROM T))
ROOTS GRAPHNODE.LIST (SEEN BROWSEHASH)
(CALLRELATION (PARSERELATION 'CALL]
(DECLARE (SPECVARS SEEN GRAPHNODE.LIST CALLRELATION))
(CLRHASH SEEN)
(for X in UNDONE do (PUTHASH X (COND
((AND NOTRACE (MSMEMBSET
X NOTRACE))
-1)
(T 0))
SEEN)
(OR INVERTED (UPDATEFN X NIL 0)))
[do (COND
(NAMED (PUTHASH (CAR NAMED)
0 SEEN)
(PUSH ROOTS (fetch (GRAPHNODE NODEID)
of (BRPATHS1 (CAR NAMED)
DEPTH)))
(SETQ NAMED (CDR NAMED)))
(UNDONE [COND
([OR (NULL (SETQ TEM (GETHASH (CAR UNDONE)
SEEN)))
(EQ TEM 0)
(AND (LISTP TEM)
(NULL (CAR TEM]
(PUTHASH (CAR UNDONE)
(LIST NIL)
SEEN)
(SETQ NAMED (LIST (CAR UNDONE]
(SETQ UNDONE (CDR UNDONE)))
(T (RETURN]
(RETURN (STBROWSER (LAYOUTGRAPH GRAPHNODE.LIST ROOTS
(APPEND BROWSERFORMAT BROWSERBOXING))
(LIST FROM TO INVERTED AVOIDING SEPARATE NOTRACE
MARKING DEPTH])
(BROWSER
[LAMBDA (DISPLAYFLG) (* rmk%: "16-Dec-83 15:39")
(COND
(DISPLAYFLG (SETQ BROWSERFONT (FONTCREATE BROWSERFONT))
(MOVD 'NUMSPATHS 'MSPATHS))
(T (MOVD 'OLDMSPATHS 'MSPATHS])
[LAMBDA (DISPLAYFLG) (* ; "Edited 15-Apr-2023 14:55 by lmm")
(* rmk%: "16-Dec-83 15:39")
(MOVD? 'MSPATHS 'OLDMSPATHS)
(MOVD 'MSPATHS.DISPATCH 'MSPATHS)
(SETQ BROWSER DISPLAYFLG)
(OR (FONTP BROWSERFONT)
(SETQ BROWSERFONT (FONTCREATE BROWSERFONT)))
(PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC])
(BROWSER.WHENFNSCHANGED
[LAMBDA (FNNAME TYPE REASON) (* DECLARATIONS%: (RECORDS BROWSEWIN))
@@ -134,78 +143,122 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
FNNAME))
(BROWSERDESCRIBE FNNAME BROWSER.DESCRIBE.WINDOW)))
(for X in BROWSERWINDOWS do (COND
((find GRAPHNODE
in (fetch (GRAPH GRAPHNODES)
of (fetch (BROWSEWIN GRAPH)
of X))
suchthat (EQ (fetch (GRAPHNODE NODELABEL)
of GRAPHNODE)
FNNAME))
(COND
((fetch (BROWSEWIN GRAPH) of X)
(DSPFILL NIL CHANGEDSHADE 'PAINT
(fetch (BROWSEWIN WINDOW) of
X))
(WINDOWPROP (fetch (BROWSEWIN WINDOW)
of X)
'BUTTONEVENTFN
(FUNCTION REDRAWBROWSEGRAPH))
(replace (BROWSEWIN GRAPH) of X
with NIL])
((find GRAPHNODE in (fetch (GRAPH GRAPHNODES)
of (fetch (BROWSEWIN GRAPH) of X))
suchthat (EQ (fetch (GRAPHNODE NODELABEL) of GRAPHNODE)
FNNAME))
(COND
((fetch (BROWSEWIN GRAPH) of X)
(DSPFILL NIL CHANGEDSHADE 'PAINT (fetch (BROWSEWIN WINDOW)
of X))
(WINDOWPROP (fetch (BROWSEWIN WINDOW) of X)
'BUTTONEVENTFN
(FUNCTION REDRAWBROWSEGRAPH))
(replace (BROWSEWIN GRAPH) of X with NIL])
(BRPATHS1
[LAMBDA (FROM) (* ; "Edited 11-Apr-88 11:27 by jrb:")
(DECLARE (GLOBALVARS BROWSERFONT))
(PROG (TEM)
[LAMBDA (FROM DEPTH) (* ; "Edited 25-Apr-2023 10:59 by lmm")
(* ; "Edited 11-Apr-88 11:27 by jrb:")
(DECLARE (SPECVARS INVERTED)
(GLOBALVARS BROWSERFONT MISSING.GRAPH.NODEBORDER))
(PROG (TEM ENTRY TOFNS)
(MSPATHS2 FROM)
(COND
((EQ (SETQ TEM (GETHASH FROM SEEN))
-1) (* ;
 "on NOPATHS list - create a node for it with no subs")
 "on NOPATHS list - create a node for it with no subs")
(SETQ TEM (create GRAPHNODE
NODEID _ FROM
NODELABEL _ FROM
NODEFONT _ BROWSERFONT
TONODES _ NIL))
(push GRAPHNODE.LIST TEM)
(PUAH GRAPHNODE.LIST TEM)
(PUTHASH FROM TEM SEEN)
(RETURN TEM))
((NEQ TEM 0) (* ; "already expanded into a list")
(RETURN TEM))
(T (RETURN (PROG ((ENTRY (create GRAPHNODE
NODEID _ FROM
NODELABEL _ FROM
NODEFONT _ BROWSERFONT)))
(push GRAPHNODE.LIST ENTRY)
(PUTHASH FROM ENTRY SEEN)
(replace (GRAPHNODE TONODES) of ENTRY
with (for X
in (for Y
in (COND
((NOT INVERTED)
(GETRELATION FROM CALLRELATION))
(T (GETRELATION FROM CALLRELATION T)
)) when (MSPATHS2 Y)
collect Y) when (SETQ X (BRPATHS1
X))
collect (fetch (GRAPHNODE NODEID) of X)))
(RETURN ENTRY])
(T [SETQ TOFNS (COND
((NOT INVERTED)
(GETRELATION FROM CALLRELATION))
(T (GETRELATION FROM CALLRELATION T]
(SETQ ENTRY (create GRAPHNODE
NODEID _ FROM
NODELABEL _ FROM
NODEFONT _ BROWSERFONT))
(PUSH GRAPHNODE.LIST ENTRY)
(PUTHASH FROM ENTRY SEEN)
(IF (AND TOFNS (<= DEPTH 0))
THEN (REPLACE (GRAPHNODE NODEBORDER) OF ENTRY WITH (CDDR (ASSOC 'ENDOFLINE
BROWSER.BORDERS))
)
(RETURN ENTRY))
(replace (GRAPHNODE TONODES) of ENTRY with (for X
in (for Y in TOFNS
when (MSPATHS2 Y) collect Y)
when (SETQ X (BRPATHS1 X
(- DEPTH 1)))
collect (fetch (GRAPHNODE NODEID)
of X)))
(RETURN ENTRY])
(BROWSER.LEFTFN
[LAMBDA (NODE NWINDOW) (* ; "Edited 31-Mar-87 11:16 by jop")
[LAMBDA (NODE NWINDOW) (* ; "Edited 26-Apr-2023 12:41 by lmm")
(* ; "Edited 31-Mar-87 11:16 by jop")
(* ;
 "function that is applied upon selection of a node.")
(COND
((NULL NODE))
((EQ (fetch NODELABEL of NODE)
(WINDOWPROP (GET.BROWSE.PP.WINDOW)
'FNBROWSED))
(BROWSERDESCRIBE (fetch NODELABEL of NODE)
(GET.BROWSE.DESCRIBE.WINDOW)))
(T (* ;
 "if first time touched, pretty print it.")
(BROWSEPP (fetch NODELABEL of NODE)
(GET.BROWSE.PP.WINDOW])
(PROG (FN SELECTION)
(IF (NULL NODE)
THEN (RETURN)
(MOVEW NWINDOW) (* ;
 " really want to just drag the content around")
(RETURN))
(IF (NULL (SETQ FN (FETCH NODELABEL OF NODE)))
THEN (RETURN))
[SETQ SELECTION (MENU (CREATE MENU
ITEMS _ '(CallsFrom CallsTo Edit Show InspectCode]
(* ;; "Mot implemented: Ignore Avoid")
(DESTRUCTURING-BIND (FROM TO INVERTED AVOIDING SEPARATE NOTRACE MARKING DEPTH)
(FOR BW IN BROWSERWINDOWS WHEN (EQ (FETCH (BROWSEWIN WINDOW) OF BW)
NWINDOW) DO (RETURN (FETCH (BROWSEWIN ARGS)
OF BW))
FINALLY (PROMPTPRINT "No browser window found for" FN)
(RETURN))
(* ;; "Now we have the arguments to MSPATHS .. insert this node?")
(SELECTQ SELECTION
((NIL)
(RETURN))
((CallsFrom CallsTo)
(* ;; "new graph, FN at the root")
(NUMSPATHS (CREATE SENTENCE
SUBJECT _ '(NIL NIL . FNS)
MSPRED _ 'QUOTE
OTHERSTUFF _ (LIST FN))
(IF INVERTED
THEN TO
ELSE FROM)
INVERTED AVOIDING NIL NOTRACE MARKING DEPTH))
NIL
(Ignore (* ; "local ignore"))
(Avoid (* ; " global ignore"))
(Edit (ED FN (IF (HASDEF FN 'FNS)
THEN 'FNS
ELSEIF (HASDEF FN 'FUNCTIONS)
THEN 'FUNCTIONS
ELSE (PROMPTPRINT FN "no definition")
NIL)))
(Show (CL:UNLESS (EQ FN (WINDOWPROP (GET.BROWSE.PP.WINDOW)
'FNBROWSED))
(BROWSEPP FN (GET.BROWSE.PP.WINDOW))))
(Describe (BROWSERDESCRIBE FN (GET.BROWSE.DESCRIBE.WINDOW)))
(InspectCode (IF (NOT (CCODEP FN))
THEN (PROMPTPRINT FN "not compiled")
ELSE (INSPECTCODE FN)))
(HELP])
(GET.BROWSE.PP.WINDOW
[LAMBDA NIL (* ; "Edited 7-Feb-2022 14:01 by rmk")
@@ -253,9 +306,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
BOTTOM])
(PPREPAINTFN
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani")
[LAMBDA (WINDOW REGION RESHAPE) (* ; "Edited 11-Jun-90 14:11 by mitani")
(* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.")
(* ;; "repaints the browser pp window WINDOW. Returns the width of the image so that caller can set the EXTENT.")
(PROG ((FN (WINDOWPROP WINDOW 'FNBROWSED))
(EXTENT (WINDOWPROP WINDOW 'EXTENT))
@@ -265,25 +318,23 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(MOVETOUPPERLEFT WINDOW EXTENT)
(printout WINDOW .FONT DEFAULTFONT)
(COND
((for FPTYPE in MSFNTYPES
when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE FILEPKGNAME)
of FPTYPE)
NIL
'NOERROR))
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME)
of FPTYPE))
(RETURN DEF) finally NIL)
(* ;
 "set up linelength characteristics.")
((for FPTYPE in MSFNTYPES when (SETQ DEF (GETDEF FN (ffetch (MSANALYZABLE
FILEPKGNAME)
of FPTYPE)
NIL
'NOERROR))
do (SETQ FNTYPE (ffetch (MSANALYZABLE FILEPKGNAME) of FPTYPE))
(RETURN DEF) finally NIL) (* ;
 "set up linelength characteristics.")
(RESETLST
(RESETSAVE (OUTPUT WINDOW))
(RESETSAVE (SETREADTABLE T))
(RESETSAVE **COMMENT**FLG)
(if (EQ FNTYPE 'FNS)
then (printout WINDOW "(" .FONT LAMBDAFONT |.P2| FN .FONT
DEFAULTFONT T))
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION
NIL WINDOW))
then (printout WINDOW "(" .FONT LAMBDAFONT .P2 FN .FONT
DEFAULTFONT T))
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL
WINDOW))
WINDOW)
(PRINTDEF DEF (AND (EQ FNTYPE 'FNS)
2)
@@ -291,19 +342,19 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(if (EQ FNTYPE 'FNS)
then (PRIN1 ")" WINDOW)))
(fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)))
(T (* ;
 "set right margin out so wouldn't clip.")
(T (* ;
 "set right margin out so wouldn't clip.")
(DSPRIGHTMARGIN 5000 WINDOW)
(APPLY* (FUNCTION PF*)
FN NIL (GETSTREAM WINDOW))
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION
NIL WINDOW))
(DSPRIGHTMARGIN (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL WINDOW
))
WINDOW)
BrowserPPWindowWidth)))
(T 0])
(PPRESHAPEFN
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
[LAMBDA (WINDOW) (* lmm "20-Jul-84 15:48")
(BROWSEPP (WINDOWPROP WINDOW 'FNBROWSED)
WINDOW])
@@ -314,17 +365,18 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(PROG [(FN (WINDOWPROP WIN 'FNBROWSED))
(EXTENT (WINDOWPROP WIN 'EXTENT]
(COND
(FN (RESETLST (RESETSAVE MSPRINTFLG NIL)
(RESETSAVE (OUTPUT WIN))
(DSPSCROLL 'OFF WIN)
(COND
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
(MSDESCRIBE FN])
(FN (RESETLST
(RESETSAVE MSPRINTFLG NIL)
(RESETSAVE (OUTPUT WIN))
(DSPSCROLL 'OFF WIN)
(COND
(EXTENT (MOVETOUPPERLEFT WIN EXTENT)))
(MSDESCRIBE FN))])
(BROWSERDESCRIBE
[LAMBDA (FN WIN) (* ; "Edited 31-Mar-87 11:15 by jop")
(* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.")
(* ;; "puts the masterscope DESCRIBE information in the window DS. Keeps tracks of which fn so if it changes the window can be updated.")
(WINDOWPROP WIN 'FNBROWSED FN)
(CLEARW WIN)
@@ -337,9 +389,9 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(DSPYPOSITION NIL WIN])
(BROWSER.MIDDLEFN
[LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds")
[LAMBDA (NODE NWINDOW) (* ; "Edited 25-Mar-94 13:25 by jds")
(* ;
 "called when yellow selection from browser. Call display editor on the function.")
 "called when yellow selection from browser. Call display editor on the function.")
(COND
((NULL NODE))
[(THIS.PROCESS) (* ; "processes are running.")
@@ -352,7 +404,7 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
" " "into the Dedit " "window then selecting 'Edit'."))
(T (ADD.PROCESS `(ED ',(fetch NODELABEL of NODE])
((SEDIT SEDIT:SEDIT) (* ;
 "SEdit doesn't have to worry about this stuff")
 "SEdit doesn't have to worry about this stuff")
(ED (fetch NODELABEL of NODE)
':DONTWAIT))
(ED (fetch NODELABEL of NODE]
@@ -360,8 +412,8 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(DEDITPROCESSRUNNINGP
[LAMBDA NIL (* ; "Edited 31-Mar-87 11:27 by jop")
(* ;; "is there a dedit process running?")
(* ;; "is there a dedit process running?")
(AND (EQ (EDITMODE)
'DEDIT)
@@ -369,73 +421,69 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
(REDRAWBROWSEGRAPH
[LAMBDA (WINDOW) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "Edited 15-Apr-2023 16:12 by lmm")
(* ; "Edited 31-Mar-87 11:24 by jop")
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW)
of X)
WINDOW]
(AND WN (APPLY 'NUMSPATHS (fetch (BROWSEWIN ARGS) of WN)))
(* ; "(OR WN (SHOULDNT))")
(PROG [(WN (find X in BROWSERWINDOWS suchthat (EQ (fetch (BROWSEWIN WINDOW) of X)
WINDOW]
(AND WN (APPLY (FUNCTION NUMSPATHS)
(fetch (BROWSEWIN ARGS) of WN))) (* ; "(OR WN (SHOULDNT))")
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION APPLYTOSELECTEDNODE))
(APPLYTOSELECTEDNODE WINDOW])
(STBROWSER
[LAMBDA (GRAPH ARGS) (* DECLARATIONS%: (RECORDS BROWSEWIN))
(* ; "Edited 25-Apr-2023 21:05 by lmm")
(* ; "Edited 31-Mar-87 11:18 by jop")
(* ;; "puts a browser graph for the args FROMFN in a window. If a similar graph is already a window, that window is reused; otherwise a new window is created.")
(WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS
when (EQUAL (fetch (PATHSARGS DISCRIMINANT) of ARGS)
(fetch (PATHSARGS DISCRIMINANT) of (fetch
(BROWSEWIN ARGS)
of W)))
(WINDOWADDPROP (bind TMP for W in BROWSERWINDOWS when (EQUAL (fetch (PATHSARGS DISCRIMINANT)
of ARGS)
(fetch (PATHSARGS DISCRIMINANT)
of (fetch (BROWSEWIN ARGS)
of W)))
do (replace (BROWSEWIN ARGS) of W with ARGS)
(replace (BROWSEWIN GRAPH) of W with GRAPH)
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
(FUNCTION BROWSER.LEFTFN)
(FUNCTION BROWSER.MIDDLEFN))
(RETURN W)
(replace (BROWSEWIN GRAPH) of W with GRAPH)
(SHOWGRAPH GRAPH (SETQ W (fetch (BROWSEWIN WINDOW) of W))
(FUNCTION BROWSER.LEFTFN)
(FUNCTION BROWSER.MIDDLEFN))
(RETURN W)
finally (SETQ W (SHOWGRAPH GRAPH (CONCAT "PATHS"
(COND
((SETQ TMP (fetch
(PATHSARGS FROM)
of ARGS))
(COND
((SETQ TMP (fetch (PATHSARGS FROM)
of ARGS))
(CONCAT (COND
((CADR (CADR TMP))
" FROM ")
(T " TO "))
(CADDDR TMP)))
(T ""))
(COND
((SETQ TMP (fetch (PATHSARGS TO)
of ARGS))
(* ;
 "CADDDR here gets the thing that looks like it might be a function name.")
(CONCAT (COND
((CADR (CADR TMP))
" FROM ")
(T " TO "))
(CADDDR TMP)))
(T ""))
(COND
((SETQ TMP (fetch
(PATHSARGS TO)
of ARGS))
(* ;
 "CADDDR here gets the thing that looks like it might be a function name.")
(CONCAT (COND
((CADR (CADR TMP))
" FROM ")
(T " TO "))
(CADDDR TMP)))
(T "")))
(FUNCTION BROWSER.LEFTFN)
(FUNCTION BROWSER.MIDDLEFN)))
 "CADDDR here gets the thing that looks like it might be a function name.")
(CONCAT (COND
((CADR (CADR TMP))
" FROM ")
(T " TO "))
(CADDDR TMP)))
(T "")))
(FUNCTION BROWSER.LEFTFN)
(FUNCTION BROWSER.MIDDLEFN)))
(push BROWSERWINDOWS
(create BROWSEWIN
ARGS _ ARGS
GRAPH _ GRAPH
WINDOW _ W))
(create BROWSEWIN
ARGS _ ARGS
GRAPH _ GRAPH
WINDOW _ W))
(RETURN W))
'CLOSEFN
(FUNCTION (LAMBDA (WINDOW) (* ;
 "The closing function for browser windows. removes it from BROWSERWINDOWS")
 "The closing function for browser windows. removes it from BROWSERWINDOWS")
(SETQ BROWSERWINDOWS (DREMOVE (for X in BROWSERWINDOWS
when (EQ (fetch (BROWSEWIN WINDOW)
of X)
WINDOW)
do (RETURN X))
of X)
WINDOW) do (RETURN X))
BROWSERWINDOWS])
)
(DECLARE%: DONTCOPY
@@ -457,41 +505,49 @@ Copyright (c) 1983-1984, 1987-1988, 1990, 1993-1994 by Venue & Xerox Corporation
)
)
(RPAQQ BROWSERBOXING NIL)
(RPAQ? BROWSER T)
(RPAQQ BROWSERFORMAT NIL)
(RPAQ? BROWSERBOXING )
(RPAQQ BROWSERWINDOWS NIL)
(RPAQ? BROWSERFORMAT )
(RPAQQ NODESELECTIONWINDOW NIL)
(RPAQ? BROWSERWINDOWS )
(RPAQQ PFWINDOW NIL)
(RPAQ? NODESELECTIONWINDOW )
(RPAQQ BROWSER.DESCRIBE.WINDOW NIL)
(RPAQ? PFWINDOW )
(RPAQQ BrowserPPWindowWidth 750)
(RPAQ? BROWSER.DESCRIBE.WINDOW )
(RPAQQ BROWSERFONT (GACHA 8))
(RPAQ? BrowserPPWindowWidth 750)
(MOVD? 'MSPATHS 'OLDMSPATHS)
(RPAQ? BROWSERMAX 10)
(RPAQ? BROWSERFONT '(GACHA 8))
(MOVD? 'NILL 'MODERNWINDOW)
[PROG [(WC (FILEPKGTYPE 'FNS 'WHENCHANGED]
(OR (MEMB 'BROWSER.WHENFNSCHANGED WC)
(FILEPKGTYPE 'FNS 'WHENCHANGED (CONS 'BROWSER.WHENFNSCHANGED WC]
(RPAQQ BROWSER.BORDERS
((NORMAL "Normal" 2 -1)
(GHOST "Shown elsewhere" 2 8840)
(RECURSIVEGHOST "End of recursive chain" 2 0 -1)
(MERGED "Includes other branches" 4 42405)
(SELFRECURSIVE "Includes self-recursive calls" 2 61375)
(RECURSIVE "Head of recursive chain" 4 28086)
(ENDOFLINE "exceeded depth limit" 6 64510)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS BROWSER.BORDERS BROWSERWINDOWS)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(SELECTQ (SYSTEMTYPE)
(D (BROWSER T))
NIL)
(BROWSER T)
)
(PUTPROPS BROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1987 1988 1990 1993 1994))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2054 25148 (NUMSPATHS 2064 . 5246) (BROWSER 5248 . 5511) (BROWSER.WHENFNSCHANGED 5513
. 7812) (BRPATHS1 7814 . 10080) (BROWSER.LEFTFN 10082 . 10940) (GET.BROWSE.PP.WINDOW 10942 . 11767) (
GET.BROWSE.DESCRIBE.WINDOW 11769 . 12517) (BROWSEPP 12519 . 13393) (PPREPAINTFN 13395 . 16529) (
PPRESHAPEFN 16531 . 16711) (DESCRIBEREPAINTFN 16713 . 17409) (BROWSERDESCRIBE 17411 . 18169) (
BROWSER.MIDDLEFN 18171 . 19478) (DEDITPROCESSRUNNINGP 19480 . 19751) (REDRAWBROWSEGRAPH 19753 . 20516)
(STBROWSER 20518 . 25146)))))
(FILEMAP (NIL (2085 28437 (MSPATHS.DISPATCH 2095 . 2569) (NUMSPATHS 2571 . 6158) (BROWSER 6160 . 6731)
(BROWSER.WHENFNSCHANGED 6733 . 8518) (BRPATHS1 8520 . 11171) (BROWSER.LEFTFN 11173 . 14599) (
GET.BROWSE.PP.WINDOW 14601 . 15426) (GET.BROWSE.DESCRIBE.WINDOW 15428 . 16176) (BROWSEPP 16178 . 17052
) (PPREPAINTFN 17054 . 20180) (PPRESHAPEFN 20182 . 20358) (DESCRIBEREPAINTFN 20360 . 21064) (
BROWSERDESCRIBE 21066 . 21808) (BROWSER.MIDDLEFN 21810 . 23125) (DEDITPROCESSRUNNINGP 23127 . 23382) (
REDRAWBROWSEGRAPH 23384 . 24148) (STBROWSER 24150 . 28435)))))
STOP

Binary file not shown.

BIN
library/BROWSER.TEDIT Normal file

Binary file not shown.

View File

@@ -1,18 +1,21 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-Feb-2021 22:18:06" {DSK}<home>larry>ilisp>medley>library>PRESS.;2 455434Q
changes to%: (VARS PRESSCOMS)
(FILECREATED "10-Apr-2023 07:15:37" {DSK}<home>larry>il>medley>library>PRESS.;2 452576Q
previous date%: "20-Jan-93 14:25:20" {DSK}<home>larry>ilisp>medley>library>PRESS.;1)
:EDIT-BY "lmm"
:CHANGES-TO (VARS PRESSCOMS)
:PREVIOUS-DATE " 5-Feb-2021 22:18:06" {DSK}<home>larry>il>medley>library>PRESS.;1)
(* ; "
Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT PRESSCOMS)
(RPAQQ PRESSCOMS
(RPAQQ PRESSCOMS
[
(* ;;; "PRESS printing support module")
@@ -28,7 +31,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(* ;; "Bitmap printing support")
(FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW WINDOW.BITMAP
(FNS PRESSBITMAP FULLPRESSBITMAP SHOWREGION SHOWPRESSBITMAPREGION PRESSWINDOW
\WRITEPRESSBITMAP)
(* ;; "Basic PRESS data structure output functions")
@@ -101,7 +104,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
ROTATION TITLE)))
((FULLPRESS RAVEN)
(* ;
 "same as PRESS but can scale bitmaps")
 "same as PRESS but can scale bitmaps")
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
@@ -718,19 +721,6 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(\WRITEPRESSBITMAP BITMAP NIL NIL PRSTREAM)
(RETURN (CLOSEF PRSTREAM])
(WINDOW.BITMAP
[LAMBDA (W) (* ; "Edited 12-Jun-90 10:38 by mitani")
(* Returns all of the bitmap of the
 window)
(PROG [BM (REGION (WINDOWPROP W 'REGION]
(CLOSEW W)
(SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(BITBLT (WINDOWPROP W 'IMAGECOVERED)
NIL NIL BM)
(OPENW W)
(RETURN BM])
(\WRITEPRESSBITMAP
[LAMBDA (BITMAP XPOS YPOS SCALEFACTOR CLIPPINGREGION PRSTREAM)
(* ; "Edited 12-Jun-90 10:39 by mitani")
@@ -2344,7 +2334,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(RPAQQ SPRUCEPAPERTOPSCANS 4096)
(RPAQ SPRUCEPAPERTOPMICAS (FIX (FQUOTIENT (FTIMES SPRUCEPAPERTOPSCANS \MicasPerInch)
ScansPerIn)))
ScansPerIn)))
(RPAQ SPRUCEPAPERRIGHTMICAS (FIX (FTIMES 8.5 \MicasPerInch)))
@@ -2427,85 +2417,74 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop
 each page.)
PRHEADINGFONT (* Font to print the heading in)
PRXPOS (* Current X position)
PRYPOS (* Current Y position)
PRFONT (* Current font)
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
(DATATYPE PRESSDATA (PRHEADING (* The string to be printed atop each
 page.)
PRHEADINGFONT (* Font to print the heading in)
PRXPOS (* Current X position)
PRYPOS (* Current Y position)
PRFONT (* Current font)
PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE
PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
(* Page left margin)
(PRBOTTOM WORD) (* Page bottom margin)
(PRRIGHT WORD) (* Page right margin)
(PRTOP WORD) (* Page top margin)
(PRPAGENUM WORD) (* Current Page number)
(PRNEXTFONT# BYTE)
(PRMAXFONTSET BYTE)
(PRPARTSTART INTEGER)
(DLSTARTBYTE INTEGER)
(ELSTARTBYTE INTEGER)
(STARTCHARBYTE INTEGER)
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with
 vector fonts, are we moving to the
 right?)
(VECWASDISPLAYING FLAG)
(PRBOTTOM WORD) (* Page bottom margin)
(PRRIGHT WORD) (* Page right margin)
(PRTOP WORD) (* Page top margin)
(PRPAGENUM WORD) (* Current Page number)
(PRNEXTFONT# BYTE)
(PRMAXFONTSET BYTE)
(PRPARTSTART INTEGER)
(DLSTARTBYTE INTEGER)
(ELSTARTBYTE INTEGER)
(STARTCHARBYTE INTEGER)
(VECMOVINGRIGHT FLAG) (* If we're drawing a curve with
 vector fonts, are we moving to the
 right?)
(VECWASDISPLAYING FLAG)
(* Used during curve/line clipping to remember whether we were on-screen or
 not, so we know when to force a SETXY.)
(* Used during curve/line clipping to remember whether we were on-screen or not,
 so we know when to force a SETXY.)
VECSEGCHARS (* Cache for vector characters while
 we're moving to the left.)
VECCURX (* Current X position within vector
 code, in Dover spots)
VECCURY (* Current Y position with vector
 code, in Dover spots)
PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
(* Says whether we have been
 printing characters inside the
 clipping region)
PRClippingRegion
VECSEGCHARS (* Cache for vector characters while
 we're moving to the left.)
VECCURX (* Current X position within vector
 code, in Dover spots)
VECCURY (* Current Y position with vector
 code, in Dover spots)
PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
(* Says whether we have been printing
 characters inside the clipping region)
PRClippingRegion
(* The edges of the paper, as far as PRESS is concerned.
 Used to protect SPRUCE users who get killed when the image goes off-paper)
 Used to protect SPRUCE users who get killed when the image goes off-paper)
)
PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0
(* We assume that the origin is
 translated to the bottom-left of the
 page region)
PRClippingRegion _ (create REGION
LEFT _ SPRUCEPAPERLEFTMICAS
BOTTOM _ SPRUCEPAPERBOTTOMMICAS
WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS
SPRUCEPAPERLEFTMICAS)
HEIGHT _ 29210)
[ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of
DATUM)
(fetch (PRESSDATA PRLEFT) of DATUM)))
(PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
(fetch (PRESSDATA PRBOTTOM) of DATUM)))
(PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
(PROGN (replace (PRESSDATA XPRPAGEREGION) of
DATUM
with NEWVALUE)
(replace (PRESSDATA PRLEFT) of DATUM
with (fetch (REGION LEFT) of
NEWVALUE
))
(replace (PRESSDATA PRBOTTOM) of DATUM
with (fetch (REGION BOTTOM) of
NEWVALUE))
(replace (PRESSDATA PRRIGHT) of DATUM
with (IPLUS (fetch (REGION LEFT)
of NEWVALUE)
(fetch (REGION WIDTH)
of NEWVALUE)))
(replace (PRESSDATA PRTOP) of DATUM
with (IPLUS (fetch (REGION BOTTOM)
of NEWVALUE)
(fetch (REGION HEIGHT)
of NEWVALUE])
)
PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 (* We assume that the origin is
 translated to the bottom-left of the
 page region)
PRClippingRegion _ (create REGION
LEFT _ SPRUCEPAPERLEFTMICAS
BOTTOM _ SPRUCEPAPERBOTTOMMICAS
WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS
SPRUCEPAPERLEFTMICAS)
HEIGHT _ 29210)
[ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch (PRESSDATA PRRIGHT) of DATUM)
(fetch (PRESSDATA PRLEFT) of DATUM)))
(PRHEIGHT (IDIFFERENCE (fetch (PRESSDATA PRTOP) of DATUM)
(fetch (PRESSDATA PRBOTTOM) of DATUM)))
(PRPAGEREGION (fetch (PRESSDATA XPRPAGEREGION) of DATUM)
(PROGN (replace (PRESSDATA XPRPAGEREGION) of DATUM
with NEWVALUE)
(replace (PRESSDATA PRLEFT) of DATUM
with (fetch (REGION LEFT) of NEWVALUE))
(replace (PRESSDATA PRBOTTOM) of DATUM
with (fetch (REGION BOTTOM) of NEWVALUE))
(replace (PRESSDATA PRRIGHT) of DATUM
with (IPLUS (fetch (REGION LEFT) of NEWVALUE)
(fetch (REGION WIDTH) of NEWVALUE)))
(replace (PRESSDATA PRTOP) of DATUM
with (IPLUS (fetch (REGION BOTTOM) of NEWVALUE)
(fetch (REGION HEIGHT) of NEWVALUE])
(RECORD FONTDIRENTRY (DESCR FONT# FONTSET#))
)
@@ -2596,7 +2575,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(RPAQ? DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 24765))
(RPAQ? PRESSBITMAPREGION (CREATEREGION 1270 1270 (FIX (TIMES 7.5 \MicasPerInch))
(TIMES 10 \MicasPerInch)))
(TIMES 10 \MicasPerInch)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTPAGEREGION)
@@ -2618,7 +2597,7 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
(RPAQQ PRESSOPS
(RPAQQ PRESSOPS
(SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode
ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode
SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode
@@ -2739,65 +2718,64 @@ Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1990, 1993, 2021 by Venu
)
(ADDTOVAR IMAGESTREAMTYPES (PRESS (OPENSTREAM OPENPRSTREAM)
(FONTCREATE \CREATEPRESSFONT)
(CREATECHARSET \CREATECHARSET.PRESS)
(FONTSAVAILABLE \SEARCHPRESSFONTS)))
(FONTCREATE \CREATEPRESSFONT)
(CREATECHARSET \CREATECHARSET.PRESS)
(FONTSAVAILABLE \SEARCHPRESSFONTS)))
(ADDTOVAR PRINTERTYPES
((PRESS SPRUCE PENGUIN DOVER)
(CANPRINT (PRESS))
(STATUS PUP.PRINTER.STATUS)
(PROPERTIES PUP.PRINTER.PROPERTIES)
(SEND EFTP)
(BITMAPSCALE NIL)
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
((FULLPRESS RAVEN)
(ADDTOVAR PRINTERTYPES ((PRESS SPRUCE PENGUIN DOVER)
(CANPRINT (PRESS))
(STATUS PUP.PRINTER.STATUS)
(PROPERTIES PUP.PRINTER.PROPERTIES)
(SEND EFTP)
(BITMAPSCALE NIL)
(BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
((FULLPRESS RAVEN)
(* ;
 "same as PRESS but can scale bitmaps")
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
 "same as PRESS but can scale bitmaps")
(CANPRINT (PRESS))
(STATUS TRUE)
(PROPERTIES NILL)
(SEND EFTP)
(BITMAPSCALE PRESS.BITMAPSCALE)
(BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
(ADDTOVAR PRINTFILETYPES
[PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
NIL 'PRESS)
(CLOSEF? FILE)
PFILE])
(ADDTOVAR PRINTFILETYPES [PRESS (TEST PRESSFILEP)
(EXTENSION (PRESS))
(CONVERSION (TEXT MAKEPRESS TEDIT
(LAMBDA (FILE PFILE FONTS HEADING)
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
NIL 'PRESS)
(CLOSEF? FILE)
PFILE])
(PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q
3711Q 3745Q))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (16032Q 73011Q (\SEARCHPRESSFONTS 16044Q . 20001Q) (\GETPRESSFONTNAMES 20003Q . 26641Q)
(\PRESSFAMILYCODELST 26643Q . 30565Q) (\DECODEPRESSFACEBYTE 30567Q . 33356Q) (\CREATEPRESSFONT 33360Q
. 35625Q) (\CREATECHARSET.PRESS 35627Q . 73007Q)) (73446Q 130434Q (PRESSBITMAP 73460Q . 103062Q) (
FULLPRESSBITMAP 103064Q . 111076Q) (SHOWREGION 111100Q . 112442Q) (SHOWPRESSBITMAPREGION 112444Q .
113106Q) (PRESSWINDOW 113110Q . 117247Q) (WINDOW.BITMAP 117251Q . 120432Q) (\WRITEPRESSBITMAP 120434Q
. 130432Q)) (130532Q 160405Q (\BCPLSOUT.PRESS 130544Q . 131521Q) (\PAGEPAD.PRESS 131523Q . 132760Q) (
\ENTITYEND.PRESS 132762Q . 140256Q) (\PARTEND.PRESS 140260Q . 142645Q) (\ENTITYSTART.PRESS 142647Q .
146260Q) (SETX.PRESS 146262Q . 150115Q) (SETXY.PRESS 150117Q . 153121Q) (SETY.PRESS 153123Q . 154523Q)
(SHOW.PRESS 154525Q . 160403Q)) (160467Q 275304Q (OPENPRSTREAM 160501Q . 165630Q) (\BITBLT.PRESS
165632Q . 170244Q) (\BLTSHADE.PRESS 170246Q . 171701Q) (\SCALEDBITBLT.PRESS 171703Q . 174327Q) (
\BITMAPSIZE.PRESS 174331Q . 175271Q) (\CHARWIDTH.PRESS 175273Q . 177342Q) (\CLOSEF.PRESS 177344Q .
207333Q) (\DRAWLINE.PRESS 207335Q . 210673Q) (\ENDPAGE.PRESS 210675Q . 212145Q) (NEWLINE.PRESS 212147Q
. 213560Q) (NEWPAGE.PRESS 213562Q . 214054Q) (SETUPFONTS.PRESS 214056Q . 217607Q) (\DEFINEFONT.PRESS
217611Q . 221733Q) (\DSPBOTTOMMARGIN.PRESS 221735Q . 222531Q) (\DSPCLIPPINGREGION.PRESS 222533Q .
224125Q) (\DSPFONT.PRESS 224127Q . 231121Q) (\DSPLEFTMARGIN.PRESS 231123Q . 232003Q) (
\DSPLINEFEED.PRESS 232005Q . 233315Q) (\DSPRIGHTMARGIN.PRESS 233317Q . 234202Q) (\DSPSPACEFACTOR.PRESS
234204Q . 235610Q) (\DSPTOPMARGIN.PRESS 235612Q . 236375Q) (\DSPXPOSITION.PRESS 236377Q . 237115Q) (
\DSPYPOSITION.PRESS 237117Q . 237635Q) (\FIXLINELENGTH.PRESS 237637Q . 241734Q) (\OUTCHARFN.PRESS
241736Q . 250772Q) (\SETSPACE.PRESS 250774Q . 252270Q) (\STARTPAGE.PRESS 252272Q . 256633Q) (
\STRINGWIDTH.PRESS 256635Q . 272213Q) (SHOWRECTANGLE.PRESS 272215Q . 272736Q) (
\PRESS.CONVERT.NSCHARACTER 272740Q . 275302Q)) (275344Q 406406Q (\ENDVECRUN 275356Q . 305174Q) (
\VECENCODE 305176Q . 306225Q) (\VECPUT 306227Q . 315655Q) (\VECSKIP 315657Q . 316412Q) (\VECFONTINIT
316414Q . 323537Q) (\DRAWCIRCLE.PRESS 323541Q . 326044Q) (\DRAWARC.PRESS 326046Q . 326637Q) (
\DRAWCURVE.PRESS 326641Q . 334577Q) (\DRAWCURVE.PRESS.LINE 334601Q . 343446Q) (\DRAWELLIPSE.PRESS
343450Q . 347227Q) (\GETBRUSHFONT.PRESS 347231Q . 351133Q) (\PRESSCURVE2 351135Q . 406404Q)) (412244Q
417070Q (\PRESSINIT 412256Q . 417066Q)) (446754Q 452043Q (MAKEPRESS 446766Q . 447272Q) (PRESSFILEP
447274Q . 451051Q) (PRESS.BITMAPSCALE 451053Q . 452041Q)))))
(FILEMAP (NIL (15752Q 72731Q (\SEARCHPRESSFONTS 15764Q . 17721Q) (\GETPRESSFONTNAMES 17723Q . 26561Q)
(\PRESSFAMILYCODELST 26563Q . 30505Q) (\DECODEPRESSFACEBYTE 30507Q . 33276Q) (\CREATEPRESSFONT 33300Q
. 35545Q) (\CREATECHARSET.PRESS 35547Q . 72727Q)) (73366Q 127171Q (PRESSBITMAP 73400Q . 103002Q) (
FULLPRESSBITMAP 103004Q . 111016Q) (SHOWREGION 111020Q . 112362Q) (SHOWPRESSBITMAPREGION 112364Q .
113026Q) (PRESSWINDOW 113030Q . 117167Q) (\WRITEPRESSBITMAP 117171Q . 127167Q)) (127267Q 157142Q (
\BCPLSOUT.PRESS 127301Q . 130256Q) (\PAGEPAD.PRESS 130260Q . 131515Q) (\ENTITYEND.PRESS 131517Q .
137013Q) (\PARTEND.PRESS 137015Q . 141402Q) (\ENTITYSTART.PRESS 141404Q . 145015Q) (SETX.PRESS 145017Q
. 146652Q) (SETXY.PRESS 146654Q . 151656Q) (SETY.PRESS 151660Q . 153260Q) (SHOW.PRESS 153262Q .
157140Q)) (157224Q 274041Q (OPENPRSTREAM 157236Q . 164365Q) (\BITBLT.PRESS 164367Q . 167001Q) (
\BLTSHADE.PRESS 167003Q . 170436Q) (\SCALEDBITBLT.PRESS 170440Q . 173064Q) (\BITMAPSIZE.PRESS 173066Q
. 174026Q) (\CHARWIDTH.PRESS 174030Q . 176077Q) (\CLOSEF.PRESS 176101Q . 206070Q) (\DRAWLINE.PRESS
206072Q . 207430Q) (\ENDPAGE.PRESS 207432Q . 210702Q) (NEWLINE.PRESS 210704Q . 212315Q) (NEWPAGE.PRESS
212317Q . 212611Q) (SETUPFONTS.PRESS 212613Q . 216344Q) (\DEFINEFONT.PRESS 216346Q . 220470Q) (
\DSPBOTTOMMARGIN.PRESS 220472Q . 221266Q) (\DSPCLIPPINGREGION.PRESS 221270Q . 222662Q) (\DSPFONT.PRESS
222664Q . 227656Q) (\DSPLEFTMARGIN.PRESS 227660Q . 230540Q) (\DSPLINEFEED.PRESS 230542Q . 232052Q) (
\DSPRIGHTMARGIN.PRESS 232054Q . 232737Q) (\DSPSPACEFACTOR.PRESS 232741Q . 234345Q) (
\DSPTOPMARGIN.PRESS 234347Q . 235132Q) (\DSPXPOSITION.PRESS 235134Q . 235652Q) (\DSPYPOSITION.PRESS
235654Q . 236372Q) (\FIXLINELENGTH.PRESS 236374Q . 240471Q) (\OUTCHARFN.PRESS 240473Q . 247527Q) (
\SETSPACE.PRESS 247531Q . 251025Q) (\STARTPAGE.PRESS 251027Q . 255370Q) (\STRINGWIDTH.PRESS 255372Q .
270750Q) (SHOWRECTANGLE.PRESS 270752Q . 271473Q) (\PRESS.CONVERT.NSCHARACTER 271475Q . 274037Q)) (
274101Q 405143Q (\ENDVECRUN 274113Q . 303731Q) (\VECENCODE 303733Q . 304762Q) (\VECPUT 304764Q .
314412Q) (\VECSKIP 314414Q . 315147Q) (\VECFONTINIT 315151Q . 322274Q) (\DRAWCIRCLE.PRESS 322276Q .
324601Q) (\DRAWARC.PRESS 324603Q . 325374Q) (\DRAWCURVE.PRESS 325376Q . 333334Q) (
\DRAWCURVE.PRESS.LINE 333336Q . 342203Q) (\DRAWELLIPSE.PRESS 342205Q . 345764Q) (\GETBRUSHFONT.PRESS
345766Q . 347670Q) (\PRESSCURVE2 347672Q . 405141Q)) (410775Q 415621Q (\PRESSINIT 411007Q . 415617Q))
(443570Q 446657Q (MAKEPRESS 443602Q . 444106Q) (PRESSFILEP 444110Q . 445665Q) (PRESS.BITMAPSCALE
445667Q . 446655Q)))))
STOP

Binary file not shown.

View File

@@ -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.

View File

@@ -1,16 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jun-2022 18:22:01" {DSK}<home>larry>medley>library>SYSEDIT.;2 1373
(FILECREATED "17-Apr-2023 14:19:03" {DSK}<home>larry>il>medley>library>SYSEDIT.;2 1238
:EDIT-BY "lmm"
:CHANGES-TO (VARS SYSEDITCOMS)
:PREVIOUS-DATE "28-Sep-2021 10:16:44" {DSK}<home>larry>medley>library>SYSEDIT.;1)
:PREVIOUS-DATE "25-Jun-2022 18:22:01" {DSK}<home>larry>il>medley>library>SYSEDIT.;1)
(* ; "
Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT SYSEDITCOMS)
(RPAQQ SYSEDITCOMS
@@ -22,7 +20,7 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
(CLISPIFTRANFLG T)
(CROSSCOMPILING 'ASK)
(*REPLACE-OLD-EDIT-DATES* NIL)
(COPYRIGHTFLG 'PRESERVE))
(COPYRIGHTFLG 'NEVER))
(P (RESETVARS ((CROSSCOMPILING T))
(FILESLOAD (SOURCE)
EXPORTS.ALL])
@@ -43,12 +41,11 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
(RPAQQ *REPLACE-OLD-EDIT-DATES* NIL)
(RPAQQ COPYRIGHTFLG PRESERVE)
(RPAQQ COPYRIGHTFLG NEVER)
(RESETVARS ((CROSSCOMPILING T))
(FILESLOAD (SOURCE)
EXPORTS.ALL))
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 8-Oct-2022 16:06:36" {DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;2 20352
(FILECREATED "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11 14599
:CHANGES-TO (FNS CREATE-PROCESS-STREAM)
:CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
(VARS UNIXCOMMCOMS)
:PREVIOUS-DATE " 7-Jul-2022 10:42:46"
{DSK}<cygdrive>c>Users>Larry>home>medley>library>UNIXCOMM.;1)
:PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
(* ; "
@@ -25,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")
@@ -36,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)))
@@ -107,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])
@@ -132,49 +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)))
@@ -187,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) (* ;
@@ -240,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))
@@ -280,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)
@@ -297,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))
@@ -323,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
@@ -346,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 (2467 8489 (FORK-SHELL 2477 . 3674) (FORK-UNIX 3676 . 3852) (UNIX-KILL 3854 . 4043) (
UNIX-WRITE 4045 . 4756) (CREATE-SHELL-STREAM 4758 . 6074) (CREATE-PROCESS-STREAM 6076 . 7586) (
UNIXCOMM-AROUNDEXITFN 7588 . 8487)) (8537 13831 (INITIALIZE-NEW-SHELL-DEVICE 8547 . 9946) (
UNIX-GET-NEXT-BUFFER 9948 . 12148) (UNIX-BACKFILEPTR-NEW 12150 . 12629) (UNIX-STREAM-EOFP-NEW 12631 .
13177) (UNIX-STREAM-OUT 13179 . 13435) (UNIX-STREAM-CLOSE 13437 . 13829)) (14087 15952 (
CREATE-UNIX-SOCKET-STREAM 14097 . 14958) (ACCEPT-UNIX-SOCKET-STREAM 14960 . 15950)) (16301 19761 (
UNIX-BACKFILEPTR 16311 . 16809) (UNIX-READ 16811 . 17333) (INITIALIZE-SHELL-DEVICE 17335 . 18355) (
UNIX-STREAM-IN 18357 . 18733) (UNIX-STREAM-EOFP 18735 . 19509) (UNIX-STREAM-PEEK 19511 . 19759)))))
(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.

View File

@@ -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
View 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

Binary file not shown.

View File

@@ -0,0 +1,10 @@
Lafite README
the end-user documentation for Lafite in a PDF is on Google Drive
https://drive.google.com/drive/folders/1Zb2IudbnlzfEK5YzTcEr7k2liclFUquE?usp=sharing
Here (in the GitHub Interlisp/medley repo)
you will find the .TEdit sources that can be used to produce the documentation using ths utility HCFILES on the file MEDLEY-UTILS in the "internal" folder.
For Lafite there are two folders, one with the (latest) documentation and one with release notes.

Binary file not shown.

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

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

Some files were not shown because too many files have changed in this diff Show More