1
0
mirror of synced 2026-03-26 02:25:53 +00:00

Compare commits

...

84 Commits

Author SHA1 Message Date
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
Nick Briggs
17dd03a358 Use -title rather than -t to specify window title (#1020) 2022-11-14 09:48:21 -08:00
Larry Masinter
382881a068 fix typos EFECT vs EFFECT in templates for CL:WHEN and CL:UNLESS (#1015) 2022-11-02 11:59:39 -07:00
Larry Masinter
d0d952a10d make SETQ and typed in calls undoable (first steps) (#996)
* First steps to make UNDO to work again

* make sure the right SETQ (CL vs IL) is used

* The change surfaced a irritating warning about the variable presumed to be SPECIAL
2022-10-25 15:40:41 -07:00
Larry Masinter
d5d21397d4 another pass at variable initialization after logout savevm sysout makesys (#1003)
This corrects some errors in the handling of initializing variables across SAVEVM, LOGOUT, SYSOUT and MAKESYS.
This is all now handled by MEDLEY-INIT-VARS (function and variable) which is called as an EVENTFN.
BEFOREMAKESYS (invoked by ENDLOADUP) clears the variables to a default setting (all directories are just {DSK}).
The other "BEFORE" events save away the current values of the variables in MEDLEY-INIT-VARS.

In order to get this to work it was necessary to change a hack for deciding where to find EXPORTS.ALL and WHEREIS.HASH. Now  if you do `./scripts/loadup-all.sh` to make a full, lisp sysouts, exports.all and whereis.hash it will still build the sysouts in tmp/ but will also "link" new versions in loadups (and library for exports.all). This replaces the previous hack scanning the sysout name for "tmp/".
MEDLEY-INIT-VARS had been called both by the AROUNDEXITFN and AFTER*FORMS.
2022-10-25 14:43:57 -07:00
Larry Masinter
7a4470ce8b Rework MEDLEYDIR before/after logout to substitute instead of reset (#998)
* Rework MEDLEYDIR before/after logout to substitute instead of reset

* debugging

* working when changing home directory

* fix bug and removed redundtant declarations
2022-10-24 07:10:45 -07:00
Larry Masinter
32ff7b7649 DEFAULTPRINTINGHOST can have list members as per comments (#999) 2022-10-23 23:35:50 -07:00
Nick Briggs
096d860ac8 Update \SENDMESSAGE.RESTARTABLE usage of OPENSTRINGSTREAM (#997)
\SENDMESSAGE.RESTARTABLE unconditionally used OPENSTRINGSTREAM on its
argument, which is not usually a string. Now, only use OPENSTRINGSTREAM
if the argument is a string, otherwise pass it unchanged to TEDIT.
2022-10-16 17:31:14 -07:00
Larry Masinter
418b1df00d run-medley has a -NF option in caps used by loadup, means no fork (#978) 2022-10-13 20:35:37 -07:00
rmkaplan
ba90344080 MODERNIZE: Fix bug in MODERNWINDOW (Issue #972 ) (#976) 2022-10-13 16:08:28 -07:00
Frank Halasz
0eac6efb61 Fix Issue#985 HELPSYS/CLHS.LOOKUP fails when MEDLEYDIR not writeable. (#994) 2022-10-13 10:48:42 -07:00
Larry Masinter
540aff091c When restarting after logout, don't print warning on closed stream (#990) 2022-10-12 12:00:43 -07:00
Larry Masinter
3f244f6cd3 Change SYSTEM-EXTERNALFORMAT to more accurately guess the external format (#987) 2022-10-10 22:29:21 -07:00
Larry Masinter
58557d383a Fix simple typo in UNIXCOMM (#979) 2022-10-10 18:57:26 -07:00
Larry Masinter
882fbacf59 when constructing a stream, it might not have a FDEV -- allow it to print (#984)
* when constructing a stream, it might not have a FDEV -- alow it to print

* Stream with no FDEV just prints as Stream
2022-10-10 18:56:43 -07:00
Frank Halasz
70ce516e0c Merge pull request #983 from Interlisp/save-clhs-index
the hyperspec is static -- don't need to read the index
2022-10-10 00:03:57 -07:00
Larry Masinter
fdb573c761 the hyperspec is static -- don't need to read the index 2022-10-09 16:43:34 -07:00
Larry Masinter
06368f95eb run-medley should not quote patterns in 'case' command, either useless or broken (#977) 2022-10-08 10:04:46 -07:00
Larry Masinter
654ebc359c Temporary workaround until larger fix is done (see issue #768 (#971) 2022-10-07 15:06:32 -07:00
Frank Halasz
4e38802325 Merge pull request #965 from Interlisp/rmk71--upper-case-file-names
COMPAREDIRECTORIES:  upper-case-file-names
2022-10-04 11:32:01 -07:00
rmkaplan
b43b63b287 COMPAREDIRECTORIES: Oops 2022-10-03 12:06:38 -07:00
rmkaplan
016097e8bf COMPAREDIRECTORIES: upper-case-file-names
Plus typo fixes in the TEDIT file.

Note that the MATCHNAME has always been uppercase, and that the directory matching has been filtered using the FILEDIRCASEARRAY
2022-10-03 12:01:16 -07:00
Matt Heffron
99321e7951 Add .gitattributes so *.TEDIT, *.LCOM, *.DFASL, and *.SKETCH are always treated as binary (and the lowercase versions). (#957) 2022-10-03 08:02:30 -07:00
Frank Halasz
8e4fc4ab74 Fix Issue#961: GITFNS - {GMEDLEY} changed by LOGOUT/return from LOGOUT (#962)
* TEDIT-PF-SEE:  typo

* GITFNS:  Typo and better behavior on gwc delete

Message instead of trying to delete NIL

* GITFNS: Fix merge-base in PRC #958

* Fix Medley Issue #961 - {GMEDLEY} changed by LOGOUT/return

Co-authored-by: rmkaplan <ron.kaplan@post.harvard.edu>
2022-10-03 07:59:22 -07:00
rmkaplan
c005cf86bf Rmk70: minor fixups for GITFNS and TEDIT-PF-SEE (#956)
* TEDIT-PF-SEE:  typo

* GITFNS:  Typo and better behavior on gwc delete

Message instead of trying to delete NIL

* GITFNS: Fix merge-base in PRC #958
2022-10-01 13:54:40 -07:00
Larry Masinter
ecc2b22207 IDLE.PROFILE has LOGOUT and SAVEVM options; add some delays in IDLE hacks (#948)
* IFLE.PROFILE has LOGOUT and SAVEVM options; add some delays in IDLE hacks

* add extra delays so the demos work more like intended

* IDLEDEMO loads lispusers with idle hacks

* make sure NOTIFY.EVENT \IDLING.OVER is called

* clean up resetsave

* slow down KINETIC

* Redo logic to minimize diffs with 1992 version

* minor tweaks to \IDLER for making sure mouse doesn't hang
2022-09-28 22:39:31 -07:00
Larry Masinter
d0945f7a5f Update HELPSYS to find CLHS (Common Lisp HyperSpec) and lispusers/library docs (#917)
* Update HELPSYS to find CLHS (Common Lisp HyperSpec) and lispusers/library docs

* restore lost edits; fix package inclusion for XCL and LISP

* mere with previous commit

* try again
2022-09-22 09:01:40 -07:00
Larry Masinter
add65a9397 MANAGER.DFASL errored when loading -- cl:compile-file(manager) now (#945) 2022-09-21 18:03:08 -07:00
Matt Heffron
0474f924a4 This is the Histmenu+Manager+Clipboard branch WITHOUT the changes to Clipboard (since there were issues with conflicting key bindings) (#944) 2022-09-20 07:49:23 -07:00
rmkaplan
a387094eab Rmk68: Fix GITFNS PRC file lists, plus a few minor fixups (#937)
* INSPECT:  Allow optional user-specified tags in window titles to help keep track of multiple instances of the same datatype

* DWIM:  Remove warning about order of evaluation change that happened in 1980

* BREAK-AND-TRACE:  remake to get functions in filemap

* GITFNS, COMPAREDIRECTORIES:  prc file list correlates with github PR web page

* DWIM, DWIMIFY:  Removed WARNUSER and its calls

* INSPECT:  Value of INSPECT is the inspect window
(as IRM says it should be)
2022-09-18 08:10:15 -07:00
Larry Masinter
541a07e09b XORCursorPatch is 1186 only (#938) 2022-09-15 12:56:39 -07:00
Larry Masinter
5ee5482dd2 GETDEF binds variable when getting for edit -- needed by loops rather than a unreliable STKPOS (#926) 2022-09-13 13:22:06 -07:00
Larry Masinter
095beef454 misc lispusers changes -- UNIXYCD, lsee (#889)
* Move cd, ls, pwd to it's own little lispusers (needs documentation)

* add .TXT documentation, also patch lsee script to translate ^ and _ to up and left arrow

* Add document for CONDITIONGRAPH
2022-09-13 12:04:23 -07:00
Larry Masinter
06a7356b00 add IOCHAR to exportfiles and export \CATRANSLATE (#933) 2022-09-11 21:31:58 -07:00
Larry Masinter
147abac04c CL:ROOM no longer errors (#890)
With 4-byte atoms it no longer makes sense to report atom-space separately.
2022-09-05 20:27:08 -07:00
Larry Masinter
56a52af6b9 Revert "IDLE will LOGOUT instead of SAVEVM if ONLINEP (#904)" (#922)
This reverts commit fad70d4947.
2022-08-29 14:53:15 -07:00
Larry Masinter
fad70d4947 IDLE will LOGOUT instead of SAVEVM if ONLINEP (#904)
* IDLE will LOGOUT instead of SAVEVM if ONLINEP
* patched some idle hacks fora  better show
* idle.random chooses an idle program at random among those loaded
2022-08-26 11:27:48 -07:00
Larry Masinter
f4c91ec419 LispUsers art (#914) 2022-08-25 09:02:04 -07:00
Larry Masinter
f5e48847c9 thie problem only shows when you switch EDITMODE but have some SEDIT windows open (#912) 2022-08-24 07:24:08 -07:00
Larry Masinter
b90bf65be9 Move pick to lispusers (#881)
* Make PICK a Lispusers module

* PICK moved to lispusers, HCFILES moved to test repo (currently new/printing)

* redo PICK documentation

* Update documents and projects choices

* more testing and restore lost edits to TEDIT

* fix some typos
2022-08-14 13:25:17 -07:00
Larry Masinter
d379bcc102 Files have been commited to test repo, remove from medley (#878) 2022-08-14 12:14:54 -07:00
rmkaplan
39a7512458 Rmk66: 2 little glitches, plus GITFNS prc dealing better with forking (#887)
* VTCHAT:  Changed name of CHARSET field to avoid ambiguity

Even though field was never referenced

* INSPECT: WHERE argument was passed incorrectly to datatype subfunction

* GITFNS: Better recognition of funny cases (colon) etc

Reconciled with Larry's previous commit

* COMPAREDIRECTORIES:  Bug fix in separate-panel display
2022-08-12 22:01:04 -07:00
Larry Masinter
431d80fb3c Eliminate duplicate declarations for TABLEBROWSER record, remove TABLEBROWSERDECLS file (#877)
* Eliminate duplicate declarations for TABLEBROWSER record, remove TABLEBROWSERDECLS file

* change packages that used to load TABEBROWSERDECLS SOURCE to just LOADCOMP TABLEBROWSER

* make sure full RECORD is saved

* ARCHIVETOOL update of ARCHIVEBROWSER but no docs and looks like PARC-only
2022-08-12 11:23:40 -07:00
Larry Masinter
78b76f6801 GIT-INIT called after return to LOGOUT or SYSOUT etc; add option of making subdirectory to repo (#883) 2022-08-11 10:56:27 -07:00
Larry Masinter
16517cdfc5 Remove bignum test from \INSERTTREE -- was just a debugging aid (#863) 2022-08-10 21:09:12 -07:00
Nick Briggs
902d542121 IBM EGA fonts renamed (#882)
* Added IBM-EGA fixed pitch font files

* move IBM-EGA fonts to file names that will be recognized

Co-authored-by: Matt Heffron <heffron@alumni.caltech.edu>
2022-08-10 20:22:54 -07:00
Tim Bradshaw
c708f2ac55 make /usr/local/bin/medley run the right medley (#885)
welcome @tfeb
2022-08-10 11:12:28 -07:00
Larry Masinter
43e6801341 copying format info to match the ultimate destination doesn't work for displaystreams (#875) 2022-08-09 12:44:35 -07:00
Larry Masinter
27a6063ce9 \RPLPTR when run interpreted doesn't work with large vmem pointers (#866)
* \RPLPTR when run interpreted doesn't work with large vmem pointers

* oops, misread maiko N_OP_rplptr; this is closer

* Make LLNEW UFNs and functions run renamed match maiko interp wrt high 4 bits
2022-07-30 19:22:37 -07:00
Larry Masinter
cd6b64efa2 unsafe.to.modify only warns if redefining compiled with interpreted (or in original UNSAFE.TO.MODIFY.FNS (#852)
* unsafe.to.modify only warns if redefining compiled with interpreted (or in original UNSAFE.TO.MODIFY.FNS

* Add list of functions you said OK to modify
2022-07-26 23:15:27 -07:00
Larry Masinter
222da55f69 Compile color files to allow color imageobj -- even though color doesn't work yet (#864) 2022-07-26 23:12:42 -07:00
rmkaplan
92f85c5957 Rmk64: mainly separate panels for GITFNS display, FILEPOS speed up (#862)
* HRULE:  Add a PREPRINTFN for horizontal rules

Looks better in plaintext files

* GITFNS, COMPAREDIRECTORIES:  Group earler/later in separate segments

GIT-CDBROWSER-SEPARATE-DIRECTIONS defaults to T

* FILEIO: INITVARS rather than VARS for FILING.TYPES

To avoid contamination with values from other files (like LAFITE)

* FILEPKG: SEPRCASE in EDITCALLERS includes comma and quote even if no DWIMIFYCOMPLFG

Also seprate the caseinsensitive UPPERCASEARRAY from the SEPRCASE array

* IOCHAR: Open code the call to \INCCODE.EOLC

About a 30% speed up in the slow (casearray/skip) case.  Eventually macros should be defined for the externalformat interface functions, for now it is nice to be able to trace/break them.

* EXTERNALFORMAT: a little bit of cleanup

particularly around EOLC
2022-07-25 19:12:52 -07:00
255 changed files with 12963 additions and 19536 deletions

9
.gitattributes vendored Normal file
View File

@@ -0,0 +1,9 @@
# Denote all files that are truly binary and should not be modified.
*.tedit binary
*.lcom binary
*.sketch binary
*.dfasl binary
*.TEDIT binary
*.LCOM binary
*.SKETCH binary
*.DFASL binary

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

@@ -19,18 +19,97 @@ name: "Build/Push Release & Docker"
# Run this workflow on ...
on:
workflow_dispatch:
inputs:
draft:
description: "Mark this as a draft release"
type: choice
options:
- 'false'
- 'true'
force:
description: "Force build even if build already successfully completed for this commit"
type: choice
options:
- 'false'
- 'true'
workflow_call:
outputs:
successful:
description: "'True' if medley build completed successully"
value: ${{ jobs.complete.outputs.build_successful }}
inputs:
draft:
description: "Mark this as a draft release"
required: false
type: string
default: 'false'
force:
description: "Force build even if build already successfully completed for this commit"
required: false
type: string
default: 'false'
defaults:
run:
shell: bash
# Jobs that compose this workflow
jobs:
######################################################################################
# Regularize the inputs so they can be referenced the same way whether they are
# the result of a workflow_dispatch or a workflow_call
inputs:
runs-on: ubuntu-latest
outputs:
draft: ${{ steps.one.outputs.draft }}
force: ${{ steps.one.outputs.force }}
steps:
- id: one
run: >
if [ '${{ toJSON(inputs) }}' = 'null' ];
then
echo "workflow_dispatch";
echo "draft=${{ github.event.inputs.draft }}" >> $GITHUB_OUTPUT;
echo "force=${{ github.event.inputs.force }}" >> $GITHUB_OUTPUT;
else
echo "workflow_call";
echo "draft=${{ inputs.draft }}" >> $GITHUB_OUTPUT;
echo "force=${{ inputs.force }}" >> $GITHUB_OUTPUT;
fi
######################################################################################
# Build Loadup
do_release:
needs: inputs
uses: ./.github/workflows/buildLoadup.yml
with:
draft: ${{ needs.inputs.outputs.draft }}
force: ${{ needs.inputs.outputs.force }}
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 }}

7
.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
@@ -36,3 +37,9 @@ 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}" >> /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 -

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

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

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -0,0 +1,10 @@
CONDITIONGRAPH
Currently in internal rather than lispusers, this package shows a graph of "conditions" (Common Lisp error system).
(FILESLOAD CONDITIONGRAPH) to load it.
(GRAPH-CONDITIONS) will display a graph of conditions and their inheritance.
Other possible operations might be determinable by reading the source.

Binary file not shown.

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

View File

@@ -1 +0,0 @@
Running DSKTEST The Disk-file-system test utility 1. Load the file DSKTEST.DCOM from whichever directory & server it is stored on. 2. Type (DSKTEST '{DSK}<LISPFILES>

File diff suppressed because it is too large Load Diff

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

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,25 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;9| 15959
(FILECREATED " 4-Aug-2022 09:50:04" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;2| 10212
:CHANGES-TO (FNS HCFILES)
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
:PREVIOUS-DATE "16-Jul-2022 22:08:34" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;8|)
:PREVIOUS-DATE "17-Jul-2022 12:44:56" |{DSK}<home>larry>medley>internal>MEDLEY-UTILS.;1|)
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
(RPAQQ MEDLEY-UTILSCOMS
((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES PICK)
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)
(* |;;| "hardcopy files")
(FNS HCFILES BADFILE)
(INITVARS (HCFILES)
(BADFILES))
(COMMANDS "pick")))
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
(DEFINEQ
(GATHER-INFO
@@ -130,24 +122,6 @@
(MEDLEY-FIX-DATES
(LAMBDA (DIRS) (* \; "Edited 28-Jan-2021 12:15 by larry")
(|for| X |in| (OR DIRS MEDLEY-FIX-DIRS) |join| (FIX-DIRECTORY-DATES (MEDLEYDIR (PRINT X T))))))
(PICK
(LAMBDA (TYPE CHOICES) (* \; "Edited 25-Jun-2022 16:58 by larry")
(SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
(NIL (PICK (PICK 'ONEOF '(FILE ISSUE PROJECT))))
(ISSUE (LET ((ISSUE (PICK 'ONEOF (OR CHOICES (GIT-COMMAND
"gh issue list -L 5000 -R interlisp/medley | sed 's/\\([0-9]*\\).*/\\1/'"
))))
(STR (OPENTEXTSTREAM)))
(|for| S |in| (GIT-COMMAND (CL:FORMAT NIL "gh issue view ~a" ISSUE))
|do| (CL:FORMAT STR "~a~&" S)
|finally| (TEDIT STR NIL NIL `(READONLY T TITLE ,(CL:FORMAT NIL "Issue #~a"
ISSUE))))))
(DIR (PICK 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
(FILE (PICK 'ONEOF (DIRECTORY (MEDLEYDIR (PICK 'DIR)))))
(PROJECT (PICK 'ONEOF '(CLOS ROOMS LOOPS NOTECARDS ONLINE TEST GITBOOK COMMUNITY ENVOS)))
(ONEOF (CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES)))))
(HELP TYPE "Unknown type"))))
)
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal" "greetfiles" "doctools"))
@@ -195,104 +169,8 @@
(RENAMEFILE HASHFILE (MEDLEYDIR "tmp" "whereis.hash" T))
(DRIBBLE))))
)
(* |;;| "hardcopy files")
(DEFINEQ
(HCFILES
(LAMBDA (TFILE DEST REDOFLG TOPDIRLEN) (* \; "Edited 17-Jul-2022 12:44 by larry")
(* \; "Edited 21-Jun-2022 22:59 by larry")
(* \; "Edited 31-May-2022 09:31 by larry")
(* \; "Edited 20-Feb-2022 12:16 by larry")
(* \; "Edited 21-Aug-2021 20:56 by larry")
(DECLARE (SPECVARS TFILE))
(|if| (NULL TFILE)
|then| (SETQ TFILE MEDLEYDIR))
(COND
((DIRECTORYNAMEP TFILE)
(* |;;| "canonicalize")
(SETQ TFILE (DIRECTORYNAME TFILE))
(OR TOPDIRLEN (SETQ TOPDIRLEN (CL:LENGTH (FILENAMEFIELD.STRING TFILE 'DIRECTORY))))
(CL:UNLESS DEST
(|ShellCommand| (CONCAT "mkdir -p " (UNIX-GETENV "MEDLEYDIR")
"/tmp/psfiles/"))
(SETQ DEST (MEDLEYDIR "tmp/psfiles" NIL T T)))
(* |;;| "first deal with files in this directory")
(FOR EXT IN '("TED*" "SKETCH" "T*XT")
DO (|for| X |in| (DIRECTORY (CONCAT TFILE "*." EXT ";*"))
|do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
(* |;;| " then deal with subdirs ")
(|for| X |in| (DIRECTORY (CONCAT TFILE "*"))
|when| (|for| SKIP |in| '(">." ">dinfo>") |always| (NOT (STRPOS SKIP (L-CASE X))))
|when| (DIRECTORYNAMEP X) |do| (HCFILES X DEST REDOFLG TOPDIRLEN)))
((SETQ TFILE (INFILEP TFILE))
(LET* ((TF (UNPACKFILENAME.STRING TFILE))
(NAME (LISTGET TF 'NAME))
(DIR (LISTGET TF 'DIRECTORY))
(PSFILE (PACKFILENAME.STRING
'EXTENSION
(|if| (EQ REDOFLG 'IP)
|then| "IP"
|else| "PS")
'NAME
(|if| (EQ DEST T)
|then| (* \; "with the tedit file")
NAME
|else| (CONCAT (PACK (SUBST '- '> (UNPACK (SUBSTRING DIR (IPLUS 2 TOPDIRLEN
)
-1))))
"-" NAME))
'HOST
(LISTGET TF 'HOST)
'DIRECTORY
(|if| (EQ DEST T)
|then| DIR
|else| DEST)))
(TEXTSTREAM))
(|if| (AND (NOT REDOFLG)
(INFILEP PSFILE))
|then| (* \; " do nothing")
(PRINTOUT T PSFILE " already there" T)
|elseif| (EQ REDOFLG 'TEST)
|then| (PRINTOUT T TFILE "-> " PSFILE T)
(CLOSEF (OPENTEXTSTREAM TFILE))
ELSEIF (MEMBER TFILE BADFILES)
THEN (PRINTOUT T "Skipping " TFILE " on BADFILES")
|else| (PRINTOUT T "Converting " TFILE " to " PSFILE "...")
(TEDIT.FORMAT.HARDCOPY (SETQ TEXTSTREAM (OPENTEXTSTREAM TFILE))
PSFILE T NIL NIL NIL (|if| (EQ REDOFLG 'IP)
|then| 'INTERPRESS
|else| 'POSTSCRIPT))
(|printout| T " DONE" T)
(CLOSEF? TEXTSTREAM))))
(T (PRINTOUT T "no such file " T)))))
(BADFILE
(LAMBDA NIL (* \; "Edited 22-Jun-2022 09:40 by larry")
(PUSHNEW BADFILES TFILE)
(LET ((STR (OPENSTREAM "BADFILES.TXT" 'APPEND)))
(SETFILEPTR STR -1)
(PRINT TFILE STR)
(CLOSEF STR))
(RETFROM 'HCFILES)))
)
(RPAQ? HCFILES )
(RPAQ? BADFILES )
(DEFCOMMAND "pick" (FIRST . REST) (PICK FIRST REST))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (727 8702 (GATHER-INFO 737 . 6147) (MAKE-FULLER-DB 6149 . 6839) (MEDLEY-FIX-LINKS 6841
. 7238) (MEDLEY-FIX-DATES 7240 . 7482) (PICK 7484 . 8700)) (9741 11534 (MAKE-EXPORTS-ALL 9751 . 10710
) (MAKE-WHEREIS-HASH 10712 . 11532)) (11569 15829 (HCFILES 11579 . 15514) (BADFILE 15516 . 15827)))))
(FILEMAP (NIL (600 7357 (GATHER-INFO 610 . 6020) (MAKE-FULLER-DB 6022 . 6712) (MEDLEY-FIX-LINKS 6714
. 7111) (MEDLEY-FIX-DATES 7113 . 7355)) (8396 10189 (MAKE-EXPORTS-ALL 8406 . 9365) (MAKE-WHEREIS-HASH
9367 . 10187)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -1,105 +0,0 @@
(FILECREATED "24-Mar-86 15:18:14" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;9 4308
changes to: (FNS STARTTEST STOPTEST KILLTEST)
(VARS FLOPPYTESTERCOMS)
previous date: "20-Mar-86 21:06:46" {ERIS}<LISPCORE>SOURCES>FLOPPYTESTER.;5)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FLOPPYTESTERCOMS)
(RPAQQ FLOPPYTESTERCOMS ((* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
(P (LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM)))
(INITVARS (ALLOCATIONSW NIL))
(FNS STARTTEST STOPTEST KILLTEST BLTALLOCS BLTALLOC)))
(* * FLOPPYTESTER -- Runs FILEBANGER on FLOPPY. *)
(LOAD? (QUOTE {ERINYES}<TEST>TOOLS>FILEBANGER.DCOM))
(RPAQ? ALLOCATIONSW NIL)
(DEFINEQ
(STARTTEST
(LAMBDA (N) (* kbr: "24-Mar-86 15:15")
(SETQ STARTTIME (GDATE))
(CNDIR (QUOTE {FLOPPY}))
(FLOPPY.FORMAT (QUOTE TEST))
(DIRECTORY (QUOTE {FLOPPY}*))
(BLTALLOCS)
(for I from 1 to N do (DOFILEBANGER (PACK* (QUOTE {FLOPPY})
(QUOTE TESTFILE)
I)
(RAND 10 30)))))
(STOPTEST
(LAMBDA NIL (* kbr: "24-Mar-86 15:16")
(SETQ STOPTIME (GDATE))
(for P in FILEBANGERS when (NOT (EQ P (THIS.PROCESS))) do (SUSPEND.PROCESS P))))
(KILLTEST
(LAMBDA NIL (* kbr: "22-Mar-86 17:18")
(for P in FILEBANGERS do (DEL.PROCESS P))
(SETQ FILEBANGERS NIL)))
(BLTALLOCS
[LAMBDA NIL (* kbr: "18-Nov-85 12:32")
(* Debugging fn. Puts up a window representation of 
allocations on floppy. *)
(PROG (PIXELS XLENGTH YLENGTH)
(SETQ PIXELS 5)
(SETQ XLENGTH (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
(SETQ YLENGTH \FLOPPY.CYLINDERS)
[COND
((NULL ALLOCATIONSW)
(SETQ ALLOCATIONSW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (ITIMES PIXELS
XLENGTH))
(HEIGHTIFWINDOW (ITIMES PIXELS
YLENGTH)
T)
NIL NIL NIL
"Position FLOPPY ALLOCATIONS window")
"FLOPPY ALLOCATIONS"))
(UNADVISE (QUOTE \PFLOPPY.ALLOCATE))
(ADVISE (QUOTE \PFLOPPY.ALLOCATE)
(QUOTE AFTER)
(QUOTE (COND (!VALUE (BLTALLOC !VALUE]
(BITBLT NIL NIL NIL ALLOCATIONSW NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(for Y from 0 to (SUB1 YLENGTH) do (for X from 0 to (SUB1 XLENGTH)
do (BITMAPBIT ALLOCATIONSW
(ITIMES PIXELS X)
(ITIMES PIXELS Y)
1)))
(for PFALLOC in (fetch (PFLOPPYFDEV PFALLOCS) of \FLOPPYFDEV)
when [NOT (EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE]
do (BLTALLOC PFALLOC])
(BLTALLOC
[LAMBDA (PFALLOC) (* kbr: "18-Nov-85 12:21")
(PROG (SHADE OPSHADE LEFT BOTTOM PIXELS XLENGTH)
(SETQ PIXELS 5)
(SETQ XLENGTH (ITIMES \FLOPPY.TRACKSPERCYLINDER \FLOPPY.SECTORSPERTRACK))
(SETQ SHADE (COND
((EQUAL (fetch (PFALLOC FILENAME) of PFALLOC)
(QUOTE (FREE)))
WHITESHADE)
(T BLACKSHADE)))
(SETQ OPSHADE (IDIFFERENCE BLACKSHADE SHADE))
(for I from (fetch (PFALLOC START) of PFALLOC) to (fetch (PFALLOC END)
of PFALLOC)
do (SETQ LEFT (ITIMES PIXELS (IREMAINDER (SUB1 I)
XLENGTH)))
(SETQ BOTTOM (ITIMES PIXELS (IQUOTIENT (SUB1 I)
XLENGTH)))
(BLTSHADE SHADE ALLOCATIONSW LEFT BOTTOM PIXELS PIXELS (QUOTE REPLACE))
(BLTSHADE OPSHADE ALLOCATIONSW LEFT BOTTOM 1 1 (QUOTE REPLACE])
)
(PUTPROPS FLOPPYTESTER COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (745 4220 (STARTTEST 755 . 1203) (STOPTEST 1205 . 1463) (KILLTEST 1465 . 1665) (
BLTALLOCS 1667 . 3253) (BLTALLOC 3255 . 4218)))))
STOP

View File

@@ -1,242 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "26-Jun-90 19:15:35" |{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;2| 9419
|changes| |to:| (VARS RS232TESTCOMS)
|previous| |date:| "20-Feb-87 00:10:14"
|{DSK}<usr>local>lde>lispcore>internal>library>RS232TEST.;1|)
; Copyright (c) 1987, 1990 by Venue & Xerox Corporation. All rights reserved.
(PRETTYCOMPRINT RS232TESTCOMS)
(RPAQQ RS232TESTCOMS
((FNS RSTEST TESTCLEANUP XMITTEST)
(* |;;|
 "Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
(FNS RS232.TEST RS232.MICROTEST RS232.QUICKTEST RS232.MENU RS232TMENU.SELFN)
(VARS RS232.TEST.MENU.ITEMS)
(* |;;|
 "Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
(FNS TTY.TEST TTY.MICROTEST TTY.QUICKTEST TTY.MENU TTYTMENU.SELFN)))
(DEFINEQ
(rstest
(lambda nil (* \; "Edited 14-Jan-87 16:00 by jds")
(let (oo)
(resetlst (resetsave (setq oo (openstream '{rs232} 'output))
'closef?)
(|for| i |from| 1 |do| (printout oo "Line " i
": 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
\
")
(printout t "Line " i t))))))
(testcleanup
(lambda nil (* \; "Edited 16-Jan-87 09:51 by jds")
(* |;;| "Close the streams used by the rs232 test.")
(and (boundp 'out)
out
(closef? out))
(and (boundp in)
in
(closef? in))))
(XMITTEST
(LAMBDA (BAUDRATE XONXOFF?) (* \; "Edited 19-Feb-87 20:59 by jds")
(* |;;| "Set up the rs232 port at BAUDRATE with XOn-XOff flow control if XONXOFF? is T. Then print forever, lines of text. Show an indication on the screen for each line, so the user can tell if flow control has shut things off.")
(RS232C.INIT BAUDRATE 8 'NONE 1 (COND
(XONXOFF? 'XONXOFF)
(T 'NONE)))
(SETQ OUT (OPENSTREAM '{RS232} 'OUTPUT))
(SETQ IN (OPENSTREAM '{RS232} 'INPUT))
(ERSETQ (FOR I FROM 1 DO (PRINTOUT OUT "Line " I ": 0 1 2 3 4 5 6 7 8 9 0 9 8 7 6 5 4 3 2 1.
\
")
(|printout| T "Line " I T)))
(CLOSEF? OUT)
(CLOSEF? IN)))
)
(* |;;| "Exhaustive test for RS-232 for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
(DEFINEQ
(rs232.test
(lambda nil (* \; "Edited 19-Feb-87 22:43 by jds")
(* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")
(printout t t t "Starting RS-232 port test." t
"Make sure the line monitor is attached to the RS-232 port, "
"and its cable goes to the DCE socket on the monitor." t)
(mouseconfirm)
(printout t "Set the line monitor for: " t)
(|for| bits |in| '(5 6 7 8) |do| (|for| parity |in| '(none odd even)
|do| (|for| stopbits |in| '(1 1.5 2)
|do| (rs232.microtest 9600 bits parity stopbits))))))
(rs232.microtest
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:37 by jds")
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
(printout t bits "bits, " (cond
((eq parity 'none)
"NO")
(t parity))
" parity, " stopbits " stop bits..." t)
(mouseconfirm)
(rs232.quicktest speed bits parity stopbits)))
(rs232.quicktest
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:38 by jds")
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
(rs232c.init speed bits parity stopbits 'none)
(let ((out (openstream '{rs232} 'output)))
(prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
out)
(closef out))))
(rs232.menu
(lambda nil (* \; "Edited 19-Feb-87 22:45 by jds")
(let ((ww (addmenu (|create| menu
menucolumns _ 4
items _ rs232.test.menu.items
whenselectedfn _ (function rs232tmenu.selfn)))))
(windowprop ww 'title "RS-232 Tests"))))
(rs232tmenu.selfn
(lambda (item menu key) (* \; "Edited 19-Feb-87 22:57 by jds")
(* |;;| "Called from the RS-232 test menu")
(let* ((info (cadr item))
(bits (car info))
(parity (cadr info))
(stopbits (caddr info)))
(rs232.quicktest 9600 bits parity stopbits))))
)
(RPAQQ RS232.TEST.MENU.ITEMS
((|5/N/1| (5 NONE 1))
(|6/N/1| (6 NONE 1))
(|7/N/1| (7 NONE 1))
(|8/N/1| (8 NONE 1))
(|5/N/1.5| (5 NONE 1.5))
(|6/N/1.5| (6 NONE 1.5))
(|7/N/1.5| (7 NONE 1.5))
(|8/N/1.5| (8 NONE 1.5))
(|5/N/2| (5 NONE 2))
(|6/N/2| (6 NONE 2))
(|7/N/2| (7 NONE 2))
(|8/N/2| (8 NONE 2))
(|5/O/1| (5 ODD 1))
(|6/O/1| (6 ODD 1))
(|7/O/1| (7 ODD 1))
(|8/O/1| (8 ODD 1))
(|5/O/1.5| (5 ODD 1.5))
(|6/O/1.5| (6 ODD 1.5))
(|7/O/1.5| (7 ODD 1.5))
(|8/O/1.5| (8 ODD 1.5))
(|5/O/2| (5 ODD 2))
(|6/O/2| (6 ODD 2))
(|7/O/2| (7 ODD 2))
(|8/O/2| (8 ODD 2))
(|5/E/1| (5 EVEN 1))
(|6/E/1| (6 EVEN 1))
(|7/E/1| (7 EVEN 1))
(|8/E/1| (8 EVEN 1))
(|5/E/1.5| (5 EVEN 1.5))
(|6/E/1.5| (6 EVEN 1.5))
(|7/E/1.5| (7 EVEN 1.5))
(|8/E/1.5| (8 EVEN 1.5))
(|5/E/2| (5 EVEN 2))
(|6/E/2| (6 EVEN 2))
(|7/E/2| (7 EVEN 2))
(|8/E/2| (8 EVEN 2))))
(* |;;|
"Exhaustive test for the TTY port for 5- 6- 7- and 8-bit chars, with parity NONE, EVEN, and ODD")
(DEFINEQ
(tty.test
(lambda nil (* \; "Edited 19-Feb-87 22:42 by jds")
(* |;;| "Run quickly thru all the possible combinations of RS-232 bit lengths and parities and stop bits for testing sake.")
(printout t t t "Starting TTY port test." t
"Make sure the line monitor is attached to the TTY port, "
"and its cable goes to the DTE socket on the monitor." t)
(mouseconfirm)
(printout t "Set the line monitor for: " t)
(|for| bits |in| '(5 6 7 8) |do| (|for| parity |in| '(none odd even)
|do| (|for| stopbits |in| '(1 1.5 2)
|do| (tty.microtest 9600 bits parity stopbits))))))
(tty.microtest
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:41 by jds")
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
(printout t bits "bits, " (cond
((eq parity 'none)
"NO")
(t parity))
" parity, " stopbits " stop bits..." t)
(mouseconfirm)
(tty.init speed bits parity stopbits)))
(tty.quicktest
(lambda (speed bits parity stopbits) (* \; "Edited 19-Feb-87 22:40 by jds")
(* |;;| "Transmit a short test pattern to the RS232 port at SPEED baud, using BITS-bit characters, with PARITY and STOPBITS.")
(tty.init speed bits parity stopbits 'none)
(let ((out (openstream '{tty} 'output)))
(prin1 (concat "0123 ABC abc " (packc '(1 2 3 255)))
out)
(closef out))))
(tty.menu
(lambda nil (* \; "Edited 19-Feb-87 22:57 by jds")
(let ((ww (addmenu (|create| menu
menucolumns _ 4
items _ rs232.test.menu.items
whenselectedfn _ (function ttytmenu.selfn)))))
(windowprop ww 'title "TTY Tests"))))
(ttytmenu.selfn
(lambda (item menu key) (* \; "Edited 19-Feb-87 22:59 by jds")
(* |;;| "Called from the RS-232 test menu")
(let* ((info (cadr item))
(bits (car info))
(parity (cadr info))
(stopbits (caddr info)))
(tty.quicktest 9600 bits parity stopbits))))
)
(PUTPROPS RS232TEST COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (979 2623 (RSTEST 989 . 1466) (TESTCLEANUP 1468 . 1789) (XMITTEST 1791 . 2621)) (2732
5433 (RS232.TEST 2742 . 3570) (RS232.MICROTEST 3572 . 4151) (RS232.QUICKTEST 4153 . 4640) (RS232.MENU
4642 . 5042) (RS232TMENU.SELFN 5044 . 5431)) (6665 9325 (TTY.TEST 6675 . 7493) (TTY.MICROTEST 7495 .
8061) (TTY.QUICKTEST 8063 . 8543) (TTY.MENU 8545 . 8938) (TTYTMENU.SELFN 8940 . 9323)))))
STOP

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View File

@@ -1 +0,0 @@
12345

Binary file not shown.

View File

@@ -1 +0,0 @@
σγδφβc

Binary file not shown.

Binary file not shown.

View File

@@ -1 +0,0 @@
012345X1245

View File

@@ -1,495 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 3-Jul-2022 14:07:11" 
{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;31 27425
:CHANGES-TO (FNS TFP TFP1)
:PREVIOUS-DATE " 3-Jul-2022 13:32:16"
{DSK}<users>kaplan>local>medley3.5>working-medley>internal>test>filepos>TFP.;27)
(PRETTYCOMPRINT TFPCOMS)
(RPAQQ TFPCOMS
((FNS TFP TFP1 FPC FPCS)
(FNS OLDFILEPOS OLDFFILEPOS)
(FILES FPTESTS)
(ADDVARS (DIRECTORIES {WMEDLEY}<internal>test>filepos>))
(* ;; "Compiling also requires EXPORTS.ALL")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
IOCHAR))))
(DEFINEQ
(TFP
[LAMBDA (TESTNAMES TAGS FN) (* ; "Edited 3-Jul-2022 14:06 by rmk")
(CL:UNLESS TESTNAMES (SETQ TESTNAMES ALLTESTS))
(LET [(TESTS (FOR TN INSIDE TESTNAMES FIRST (PRINTOUT T "Testing")
JOIN (PRINTOUT T " " TN)
(CONS (MKSTRING TN)
(COPY (EVALV TN))) FINALLY (TERPRI T]
(CL:WHEN TAGS
(SETQ TESTS (FOR TEST IN TESTS WHEN (THEREIS TAG INSIDE TAGS
SUCHTHAT (MEMB TAG TEST)) COLLECT TEST)))
(PRINTOUT T (LENGTH TESTS)
" tests" T)
(FOR TEST VAL COMMENT PRINTED IN TESTS EACHTIME (CL:WHEN (STRINGP TEST)
(SETQ COMMENT TEST)
(SETQ PRINTED NIL))
WHEN [AND (LISTP TEST)
(NOT (AND FN (CADDR TEST] UNLESS (EQUAL (CAR TEST)
(SETQ VAL (TFP1 (CADR TEST)
FN)))
COLLECT (CL:WHEN COMMENT
(CL:UNLESS PRINTED (PRINTOUT T COMMENT T)))
(PRINTOUT T 5 VAL " <- " .P2 TEST T)
(CONS VAL TEST])
(TFP1
[LAMBDA (FPARGS FN) (* ; "Edited 3-Jul-2022 14:04 by rmk")
(* ;; "FN is the search function to apply: NIL = FILEPOS, OLDFILEPOS, FFILEPOS. OLDFFILEPOS")
(* ;; "For convenience: NIL -> FILEPOS, OF -> OLDFILEPOS, FF -> FFILEPOS, OFF -> OLDFFILEPOS.")
(* ;; "OLDFILEPOS and OLDFFILEPOS do only a byte searches.")
(* ;;
 "FPARGS is a list of FILEPOS args. CASEARRAY=T means Transparent case array, pushes to FFILEPOS. ")
(* ;; "The file extension gives the format, defaulting to *DEFAULT-EXTERNALFORMAT* = :XCCS")
(SETQ FN (SELECTQ FN
((NIL FILEPOS)
'FILEPOS)
((FF FFILEPOS)
'FFILEPOS)
((OF OLDFILEPOS)
'OLDFILEPOS)
((OFF OLDFFILEPOS)
'OLDFFILEPOS)
(HELP "BAD FN" FN)))
(CL:WHEN (OR (FIXP (CAR FPARGS))
(NULL (CAR FPARGS))
(AND (LISTP (CAR FPARGS))
(FIXP (CAAR FPARGS))
(FIXP (CDAR FPARGS)))
(LISTP (CADR FPARGS)))
(SETQ FPARGS (CADR FPARGS)))
(LET (STREAM VAL PATTERN FILE START END SKIP TAIL CASEARRAY EXT (FORMAT *DEFAULT-EXTERNALFORMAT*)
)
(SETQ PATTERN (EVAL (POP FPARGS))) (* ;
 "So we can do substrings, CHARACTER etc.")
(SETQ FILE (POP FPARGS))
(SETQ START (POP FPARGS))
(SETQ END (POP FPARGS))
(SETQ SKIP (POP FPARGS))
(SETQ TAIL (POP FPARGS))
(SETQ CASEARRAY (POP FPARGS))
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
(CL:WHEN EXT
(CL:WHEN (STRPOS "UTF8" EXT)
(SETQ EXT "UTF-8"))
[SETQ FORMAT (FIND-FORMAT (CL:INTERN EXT 'KEYWORD])
[SETQ STREAM (OPENSTREAM (OR (FINDFILE FILE T)
FILE)
'INPUT NIL `((FORMAT ,FORMAT]
(SETQ CASEARRAY (IF (EQ CASEARRAY T)
THEN (CASEARRAY)
ELSE (EVAL CASEARRAY)))
(SETQ VAL (APPLY* FN PATTERN STREAM START END SKIP TAIL CASEARRAY))
(CLOSEF? STREAM)
VAL])
(FPC
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 29-Jun-2022 21:22 by rmk")
(* ;; "Compare old and new filepos")
(LET (OLD NEW EXT FORMAT)
(CL:UNLESS (STREAMP FILE)
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
(SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
(CL:UNLESS (FIND-FORMAT FORMAT T)
(SETQ FORMAT :XCCS))
(STREAMPROP FILE 'FORMAT FORMAT))
(SETQ OLD (OLDFILEPOS STR FILE START END SKIP TAIL CASEARRAY))
(SETQ NEW (FILEPOS STR FILE START END SKIP TAIL CASEARRAY))
(CLOSEF FILE)
(CL:UNLESS (EQUAL OLD (IF (EQ TAIL 'BOTH)
THEN (CDR NEW)
ELSE NEW))
(HELP (CONCAT "OLD=" (OR OLD "NIL")
" NEW="
(OR NEW "NIL"))))
(LIST OLD NEW])
(FPCS
[LAMBDA (STR FILE START END SKIP TAIL) (* ; "Edited 29-Jun-2022 23:56 by rmk")
(* ; "Edited 28-Jun-2022 22:21 by rmk")
(* ;; "Compare old and new slow filepos")
(LET (FAST SLOW EXT FORMAT)
(CL:UNLESS (STREAMP FILE)
(SETQ EXT (FILENAMEFIELD.STRING FILE 'EXTENSION))
(SETQ FORMAT (CL:INTERN EXT 'KEYWORD))
(CL:UNLESS (FIND-FORMAT FORMAT T)
(SETQ FORMAT :XCCS))
(STREAMPROP FILE 'FORMAT FORMAT))
(SETQ FAST (FILEPOS STR FILE START END SKIP TAIL))
(SETQ SLOW (FILEPOS STR FILE START END SKIP TAIL (CASEARRAY)))
(CLOSEF FILE)
(CL:UNLESS (EQUAL FAST SLOW)
(HELP (CONCAT "FAST=" (OR FAST "NIL")
" SLOW="
(OR SLOW "NIL"))))
(LIST FAST SLOW])
)
(DEFINEQ
(OLDFILEPOS
[LAMBDA (STR FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 27-Jun-2022 23:35 by rmk")
(* ; "Edited 10-Aug-2020 21:44 by rmk:")
(* Pavel "12-Oct-86 15:13")
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
(* ;; "NB: this function now works on non-PAGEMAPPED files. It must use only IO functions that respect that.")
(PROG ((SKIPCHAR (AND SKIP (CHCON1 SKIP)))
[CA (fetch (ARRAYP BASE) of (COND
[CASEARRAY (COND
((AND (ARRAYP CASEARRAY)
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
\ST.BYTE))
CASEARRAY)
(T (CASEARRAY CASEARRAY]
(T \TRANSPARENT]
(STREAM (\GETSTREAM FILE 'INPUT))
CHAR FIRSTCHAR STRBASE STRINDEX PATLEN PATINDEX ORGFILEPTR LASTINDEX STARTBYTE ENDBYTE
BIGENDBYTE STARTSEG ENDSEG)
(CL:WHEN (EQ :UTF-8 (\EXTERNALFORMAT STREAM))
(SETQ STR (XTOUSTRING STR)))
[COND
((LITATOM STR)
(SETQ STRBASE (fetch (LITATOM PNAMEBASE) of STR))
(SETQ STRINDEX 1)
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of STR)))
(T (OR (STRINGP STR)
(SETQ STR (MKSTRING STR)))
(SETQ STRBASE (fetch (STRINGP BASE) of STR))
(SETQ STRINDEX (fetch (STRINGP OFFST) of STR))
(SETQ PATLEN (fetch (STRINGP LENGTH) of STR] (* ;
 "calculate start addr and set file ptr.")
[SETQ STARTBYTE (COND
(START (COND
((NOT (AND (FIXP START)
(IGEQ START 0)))
(LISPERROR "ILLEGAL ARG" START)))
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
(\SETFILEPTR STREAM START)
START)
(T (SETQ ORGFILEPTR (\GETFILEPTR STREAM]
(* ;
 "calculate the character address of the character after the last possible match.")
[SETQ ENDBYTE (ADD1 (COND
((NULL END) (* ; "Default is end of file")
(IDIFFERENCE (\GETEOFPTR STREAM)
PATLEN))
((IGEQ END 0) (* ; "Absolute byte pointer given")
(IMIN END (IDIFFERENCE (\GETEOFPTR STREAM)
PATLEN)))
((IGREATERP PATLEN (IMINUS END))
(* ;
 "END is too far, use eof less length")
(IDIFFERENCE (\GETEOFPTR STREAM)
PATLEN))
(T (IDIFFERENCE (IPLUS (\GETEOFPTR STREAM)
END 1)
PATLEN]
(* ;; "use STARTBYTE and ENDBYTE instead of START and END because vm functions shouldn't change their arguments.")
(COND
((IGEQ STARTBYTE ENDBYTE) (* ; "nothing to search")
(GO FAILED)))
(SETQ LASTINDEX PATLEN)
SKIPLP
(* ;
 "set the first character to FIRSTCHAR, handling leading skips.")
(COND
((EQ LASTINDEX 0) (* ; "null case")
(GO FOUNDIT))
((EQ (SETQ FIRSTCHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE STRINDEX)))
SKIPCHAR) (* ;
 "first character in pattern is skip.")
(SETQ LASTINDEX (SUB1 LASTINDEX))
(\BIN STREAM) (* ; "Move forward a character.")
(add STRINDEX 1)
(add STARTBYTE 1)
(GO SKIPLP)))
(SETQ LASTINDEX (IPLUS LASTINDEX STRINDEX)) (* ;
 "Used for end of pattern check, comparing against current INDEX")
[COND
((SMALLP ENDBYTE)
(SETQ STARTSEG (SETQ ENDSEG 0)))
(T
(* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts. The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary (can get around that here by decrementing everyone, but can't in FFILEPOS). Note that STARTBYTE and ENDBYTE are never actually used as file ptrs, just for counting.")
(SETQ ENDSEG (FOLDLO ENDBYTE FILEPOS.SEGMENT.SIZE))
(SETQ BIGENDBYTE (IMOD ENDBYTE FILEPOS.SEGMENT.SIZE))
(SETQ STARTSEG (FOLDLO STARTBYTE FILEPOS.SEGMENT.SIZE))
(SETQ STARTBYTE (IMOD STARTBYTE FILEPOS.SEGMENT.SIZE))
(SETQ ENDBYTE (COND
((EQ STARTSEG ENDSEG)
BIGENDBYTE)
(T
(* ;; "In different segments, so we'll have to search all the way to the end of this seg; hence, `end' is currently as big as it gets")
FILEPOS.SEGMENT.SIZE]
FIRSTCHARLP
(* ;; "STARTBYTE is the possible beginning of a match. the file ptr of the file is always at STARTBYTE position when the FIRSTCHAR loop is passed.")
(COND
((EQ STARTBYTE ENDBYTE) (* ; "end of this part of search")
(COND
((EQ STARTSEG ENDSEG) (* ; "failed")
(GO FAILED))) (* ;
 "Finished this segment, roll over into new one")
(SETQ STARTBYTE 0) (* ; "= STARTBYTE-FILEPOS.SEGMENT.SIZE")
[COND
((EQ (add STARTSEG 1)
ENDSEG) (* ;
 "Entering final segment, so set ENDBYTE to actual end instead of segment end")
(COND
((EQ (SETQ ENDBYTE BIGENDBYTE)
0)
(GO FAILED]
(GO FIRSTCHARLP))
((NEQ FIRSTCHAR (\GETBASEBYTE CA (\BIN STREAM)))
(add STARTBYTE 1)
(GO FIRSTCHARLP)))
(SETQ PATINDEX STRINDEX)
MATCHLP
(* ;
 "At this point, STR is matched thru offset PATINDEX")
(COND
((EQ (SETQ PATINDEX (ADD1 PATINDEX))
LASTINDEX) (* ; "matched for entire length")
(GO FOUNDIT))
((OR (EQ (SETQ CHAR (\GETBASEBYTE CA (\GETBASEBYTE STRBASE PATINDEX)))
(\GETBASEBYTE CA (\BIN STREAM)))
(EQ CHAR SKIPCHAR)) (* ;
 "Char from file matches char from STR")
(GO MATCHLP))
(T (* ;
 "Match failed, so we have to start again with first char")
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
(IDIFFERENCE PATINDEX STRINDEX)))
(* ;; "Back up over the chars we have just read in trying to match, less one. I.e. go back to one past the previous starting point")
(add STARTBYTE 1)
(GO FIRSTCHARLP)))
FOUNDIT
(* ;
 "set fileptr, adjust for beginning skips and return proper value.")
[COND
((NOT TAIL) (* ;
 "Fileptr wants to be at start of string")
(\SETFILEPTR STREAM (IDIFFERENCE (\GETFILEPTR STREAM)
PATLEN]
(RETURN (\GETFILEPTR STREAM))
FAILED
(* ;
 "return the fileptr to its initial position.")
(\SETFILEPTR STREAM ORGFILEPTR)
(RETURN NIL])
(OLDFFILEPOS
[LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY) (* ; "Edited 10-Aug-2020 21:44 by rmk:")
(* ;; "RMK: Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")
(* Pavel "12-Oct-86 15:20")
(PROG ([STREAM (\GETSTREAM (OR FILE (INPUT]
PATBASE PATOFFSET PATLEN ORGFILEPTR STARTOFFSET ENDOFFSET BIGENDOFFSET STARTSEG ENDSEG EOF
)
(COND
(SKIP (* ; "Slow case--use FILEPOS")
(GO TRYFILEPOS))
((NOT (fetch PAGEMAPPED of (fetch (STREAM DEVICE) of STREAM)))
(* ;
 "This is a non-page-oriented file. Use FILEPOS instead.")
(GO TRYFILEPOS))) (* ;
 "calculate start addr and set file ptr.")
(CL:WHEN (EQ :UTF8 (\EXTERNALFORMAT STREAM))
(SETQ PATTERN (XTOUSTRING PATTERN)))
[COND
((LITATOM PATTERN)
(SETQ PATBASE (fetch (LITATOM PNAMEBASE) of PATTERN))
(SETQ PATOFFSET 1)
(SETQ PATLEN (fetch (LITATOM PNAMELENGTH) of PATTERN)))
(T (OR (STRINGP PATTERN)
(SETQ PATTERN (MKSTRING PATTERN)))
(SETQ PATBASE (fetch (STRINGP BASE) of PATTERN))
(SETQ PATOFFSET (fetch (STRINGP OFFST) of PATTERN))
(SETQ PATLEN (fetch (STRINGP LENGTH) of PATTERN]
(COND
((OR (IGREATERP PATLEN \MAX.PATTERN.SIZE)
(ILESSP PATLEN \MIN.PATTERN.SIZE))
(GO TRYFILEPOS)))
(SETQ ORGFILEPTR (\GETFILEPTR STREAM))
(SETQ STARTOFFSET (IPLUS (COND
(START (COND
((NOT (AND (FIXP START)
(IGEQ START 0)))
(LISPERROR "ILLEGAL ARG" START)))
START)
(T ORGFILEPTR))
(SUB1 PATLEN))) (* ;
 "STARTOFFSET is the address of the character corresponding to the last character of PATTERN.")
(SETQ EOF (\GETEOFPTR STREAM)) (* ;
 "calculate the character address of the character after the last possible match.")
[SETQ ENDOFFSET (COND
((NULL END) (* ; "Default is end of file")
EOF)
(T (IMIN (IPLUS (COND
((ILESSP END 0)
(IPLUS EOF END 1))
(T END))
PATLEN)
EOF]
(* ;; "use STARTOFFSET and ENDOFFSET instead of START and END because vm functions shouldn't change their arguments.")
(COND
((IGEQ STARTOFFSET ENDOFFSET) (* ; "nothing to search")
(RETURN))
((ILESSP (IDIFFERENCE ENDOFFSET STARTOFFSET)
\MIN.SEARCH.LENGTH) (* ;
 "too small to make FFILEPOS worthwhile")
(GO TRYFILEPOS)))
(\SETFILEPTR STREAM STARTOFFSET)
[RETURN (GLOBALRESOURCE
(\FFDELTA1 \FFDELTA2 \FFPATCHAR)
(PROG ((CASE (fetch (ARRAYP BASE)
of (COND
[CASEARRAY (COND
((AND (ARRAYP CASEARRAY)
(EQ (fetch (ARRAYP TYP) of CASEARRAY)
\ST.BYTE))
CASEARRAY)
(T (CASEARRAY CASEARRAY]
(T \TRANSPARENT))))
(DELTA1 (fetch (ARRAYP BASE) of \FFDELTA1))
(DELTA2 (fetch (ARRAYP BASE) of \FFDELTA2))
(PATCHAR (fetch (ARRAYP BASE) of \FFPATCHAR))
(MAXPATINDEX (SUB1 PATLEN))
CHAR CURPATINDEX LASTCHAR INC)
(* ;; "Use Boyer-Moore string search algorithm. Use two auxiliary tables, DELTA1 and DELTA2, to tell how far ahead to move in the file when a partial match fails. DELTA1 contains, for each character code, the distance of that character from the right end of the pattern, or PATLEN if the character does not occur in the pattern. DELTA2 contains, for each character position in the pattern, how far ahead to move such that the partial substring discovered to the right of the position now matches some other substring (to the left) in the pattern. PATCHAR is just PATTERN translated thru CASEARRAY")
(\SETUP.FFILEPOS PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2 CASE)
[COND
((SMALLP ENDOFFSET)
(SETQ STARTSEG (SETQ ENDSEG 0)))
(T
(* ;; "The search will be in the large integers at least part of the time, so split the start and end fileptrs into hi and lo parts. The `segment' size we choose is smaller than 2^16 so that we are still smallp near the boundary. Note that STARTOFFSET and ENDOFFSET are never actually used as file ptrs, just for counting.")
(SETQ ENDSEG (FOLDLO ENDOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ BIGENDOFFSET (MOD ENDOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ STARTSEG (FOLDLO STARTOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ STARTOFFSET (MOD STARTOFFSET FILEPOS.SEGMENT.SIZE))
(SETQ ENDOFFSET (COND
((EQ STARTSEG ENDSEG)
BIGENDOFFSET)
(T
(* ;; "In different segments, so we'll have to search all the way to the end of this seg; hence, `end' is currently as big as it gets")
FILEPOS.SEGMENT.SIZE]
(SETQ LASTCHAR (GETBASEBYTE PATCHAR MAXPATINDEX))
FIRSTCHARLP
(COND
[(IGEQ STARTOFFSET ENDOFFSET) (* ; "End of this chunk")
(COND
((EQ STARTSEG ENDSEG) (* ; "failed")
(GO FAILED))
(T (* ;
 "Finished this segment, roll over into new one")
(add STARTSEG 1)
(SETQ STARTOFFSET (IDIFFERENCE STARTOFFSET FILEPOS.SEGMENT.SIZE))
(COND
((EQ STARTSEG ENDSEG)
(SETQ ENDOFFSET BIGENDOFFSET)))
(GO FIRSTCHARLP]
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
LASTCHAR)
(add STARTOFFSET (SETQ INC (GETBASEBYTE DELTA1 CHAR)))
(OR (EQ INC 1)
(\INCFILEPTR STREAM (SUB1 INC)))
(* ;
 "advance file pointer accordingly (\BIN already advanced it one)")
(GO FIRSTCHARLP)))
(SETQ CURPATINDEX (SUB1 MAXPATINDEX))
MATCHLP
(COND
((ILESSP CURPATINDEX 0)
(GO FOUNDIT)))
(\DECFILEPTR STREAM 2) (* ; "back up to read previous char")
(COND
((NEQ (SETQ CHAR (GETBASEBYTE CASE (\BIN STREAM)))
(GETBASEBYTE PATCHAR CURPATINDEX))
(* ;
 "Mismatch, advance by greater of delta1 and delta2")
(add STARTOFFSET (IDIFFERENCE (SETQ INC (IMAX (GETBASEBYTE DELTA1 CHAR)
(GETBASEBYTE DELTA2
CURPATINDEX)))
(IDIFFERENCE MAXPATINDEX CURPATINDEX)))
(OR (EQ INC 1)
(\INCFILEPTR STREAM (SUB1 INC)))
(GO FIRSTCHARLP)))
(SETQ CURPATINDEX (SUB1 CURPATINDEX))
(GO MATCHLP)
FOUNDIT
(* ;
 "set fileptr, adjust for beginning skips and return proper value.")
(\INCFILEPTR STREAM (COND
(TAIL (* ; "Put fileptr at end of string")
(SUB1 PATLEN))
(T (* ;
 "back up over the last char we looked at, i.e. the first char of string")
-1)))
(RETURN (\GETFILEPTR STREAM))
FAILED
(* ;
 "return the fileptr to its initial position.")
(\SETFILEPTR STREAM ORGFILEPTR)
(RETURN NIL]
TRYFILEPOS
(RETURN (FILEPOS PATTERN STREAM START END SKIP TAIL CASEARRAY])
)
(FILESLOAD FPTESTS)
(ADDTOVAR DIRECTORIES {WMEDLEY}<internal>test>filepos>)
(* ;; "Compiling also requires EXPORTS.ALL")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
IOCHAR)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (759 6571 (TFP 769 . 2219) (TFP1 2221 . 4656) (FPC 4658 . 5619) (FPCS 5621 . 6569)) (
6572 27191 (OLDFILEPOS 6582 . 16284) (OLDFFILEPOS 16286 . 27189)))))
STOP

Binary file not shown.

View File

@@ -1 +0,0 @@
012

View File

@@ -1 +0,0 @@
(HCFILES "{DSK}<home>larry>ilisp>envos>" "{DSK}<home>larry>medley>tmp>psfiles>")

View File

@@ -1,66 +0,0 @@
{DSK}<home>larry>ilisp>envos>xd0e>DOC>PUBS>admin>doc-dirs>ERIS-DOC-WO-LOOPS.TEDIT;2
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley1.2>RS6000>keybaord-layout.tedit;3
{DSK}<home>larry>ilisp>envos>xd0e>DOC>medley2.0>final>ug>APP-D-DIFFERENCES.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>DOC>printers>recommendation.tedit;3
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>1982BUGS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>BRIEFINGBLURB-DRAFT.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>CHAT-GENERIC.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>HELLO.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>IDDESCRIPTION.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>LISPARFIELDS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>NSCHARACTERS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>DOC>SOURCEFILES.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>COLOROBJ.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>internal>library>DSKTEST.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>BOONE-V-COE.TED;1
{DSK}<home>larry>ilisp>envos>xd0e>LISPCORE>notecards>library>NCPLOTCARD.TED;1
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>GC>HAND-AUX>ADVDICT-N-Z.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>Library>TEdit>Hand-Aux>AR10063.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>MISC>test>i>o>Hardcopy>Hand>testfiles>04PARA.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEDELTA.TED;1
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>LAFITEIMPL.TED;1
{DSK}<home>larry>ilisp>envos>xd0e>OTHER>lafite>Doc>Manual>LAFITEMANUAL-INDEXINTERNAL.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>lispusers>2.0>src>EQUATIONEXAMPLES.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>03-SOFTWARE-INSTALLATION.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>05-NOTECARDS-BASICS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>1.2>doc>11-SYSTEM-CARDS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd0e>RELEASE>notecards>2.0>src>library>BOONE-V-COE.TED;1
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDEMO.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>nilsson>intercalc>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>DDLCOLORHAX.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>JELLINEK>graphics>LUCASFILMFORMAT.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>basics>INVOICE.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV-CHOICE.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>genis>FLYER-COV.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDEMO.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>inter-calc>INTERCALCDOCUMENTATION.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>ADVERTS>Cherry-RidgeWFH.TEdit;5
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Adv-Committee>Defns>ADVDEFNS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Board>CALLERLAB-BYLAWCHANGE.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1-NEW-DEFNS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C1DEFNS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>Callerlab>Challenge-Committee>C2DEFNS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>sd>NUMBERART.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-A-M.TEDIT;13
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>ADVDICT-N-Z.TEDIT;9
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-I-R.TEDIT;9
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-S.TEDIT;7
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C1DEFNS-T-Z.TEDIT;9
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-A-E.TEDIT;11
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-F-O.TEDIT;5
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-P-S.TEDIT;6
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>C2DEFNS-T-Z.TEDIT;6
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>DICT-PREFACE.TEDIT;14
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>Dictionaries>leftover-calls.tedit;3
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>top10-87>FRA>ARRANGEMENTS.TEDIT;28
{DSK}<home>larry>ilisp>envos>xd1d>users>sybalsky>venue>ads>aaai>top-rapid-dev.TEdit;4
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>24-STREAMS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>25-IO.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>27-GRAPHICS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>28-WINDOWS.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>29-HARDCOPY.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-ETHERNET.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>30-TERMINAL.TEDIT;1
{DSK}<home>larry>ilisp>envos>xd1d>users>turpin>IRM-3>old>31-ETHERNET.TEDIT;1
{DSK}<home>larry>medley>lispusers>ACE>ACE-MAINTAINERS-NOTES.TEDIT;1
{DSK}<home>larry>medley>lispusers>EQUATIONEXAMPLES.TEDIT;1

View File

@@ -1,546 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-May-2022 12:30:29" 
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>TESTUPF.;1 32843 )
(PRETTYCOMPRINT TESTUPFCOMS)
(RPAQQ TESTUPFCOMS
((COMS (* ; "Original code")
(FNS OLD-UNPACKFILENAME.STRING \UPF.NEXTPOS \UPF.TEMPFILEP)
(DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY UNPACKFILE1)))
(* ;; "Debugging")
(* ;; "DOTTEDNAMES: mismatch intended")
(* ;; "RETURNFAILS: mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped. But original doesn't agree with its own complete analaysis.")
(VARS DOTTEDNAMES TESTS RETURNFAILS)
(FNS TRY TRYALL DT)))
(* ; "Original code")
(DEFINEQ
(OLD-UNPACKFILENAME.STRING
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 25-Jan-2022 17:16 by rmk")
(* ; "Edited 5-Jan-2022 11:03 by rmk")
(* ; "Edited 30-Mar-90 22:37 by nm")
(* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")
(* ;;; "rmk: devices must come before directories.")
(PROG ((POS 1)
(LEN (NCHARS FILE))
TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
(COND
((NULL FILE)
(RETURN NIL))
((OR (LITATOM FILE)
(STRINGP FILE)
(NUMBERP FILE)))
((TYPEP FILE 'PATHNAME)
(RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
[(STREAMP FILE) (* ;
 "For streams, use full name. If anonymous, fake it")
(SETQ FILE (OR (ffetch FULLFILENAME of FILE)
(RETURN (COND
(ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
FILE))
(T (LIST 'NAME FILE]
(T (\ILLEGAL.ARG FILE)))
(COND
((SELCHARQ (NTHCHARCODE FILE 1)
({ (* ; "normal use in Interlisp-D")
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE })
FILE 2)
0))))
(%[ (* ;
 "some Xerox and Arpanet systems use '[' for host")
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE "]")
FILE 2)
0))))
(%( (* ;
 "this is the 'proposed standard' for Xerox servers")
(SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE ")")
FILE 2)
0))))
NIL)
(UNPACKFILE1 'HOST 2 TEM)
[COND
((EQ TEM -1) (* ;
 "Started with the host field delimiter, but there was no corresponding terminating delimiter .")
(* ;
 "I'm not sure why the name is dealt with the host name.")
(RETURN (DREVERSE VAL]
(SETQ POS (IPLUS TEM 2))
[if (EQ OSTYPE T)
then (* ;
 "Use actual host to determine os type")
(SETQ OSTYPE (GETHOSTINFO (CAR VAL)
'OSTYPE]
(SETQ HOSTP T)))
(* ;; "rmk: if there is a colon before the next < or /, then we must be looking at a device. A device appears to end after the last colon, i.e., a device name can have a colon inside it.")
(COND
((AND (SETQ TEM (\UPF.NEXTPOS (CHARCODE (%: < /))
FILE POS))
(EQ (CHARCODE %:)
(NTHCHARCODE FILE TEM))) (* ;
 "all device returned have DEVICE.END on it so that NIL: will work")
(UNPACKFILE1 'DEVICE POS (if CLFLG
then (SUB1 TEM)
else TEM))
(SETQ POS (ADD1 TEM))
(SETQ HOSTP T)))
(COND
((EQ DIRFLG 'RETURN) (* ; "assert that this is a directory; more forgiving about missing trailing delimiter. There are two distinct cases for the missing initial delimiter. If HOST is also specified, it is dealt with as the true %"relative pathname%" by device dependent manner, otherwise it is dealt with following the %"incomplete file names%" convention. In the first case, returns RELATIVEDIRECTORY instead of DIRECTORY and in the second case, returns SUBDIRECTORY.")
(LET ((TYPE 'DIRECTORY)
(START (SELCHARQ (NTHCHARCODE FILE POS)
(NIL (* ; "just host, return")
(RETURN (DREVERSE VAL)))
((/ <) (* ;
 "Started with the initial directory delimiter.")
(ADD1 POS))
POS))
END)
(SETQ END (SELCHARQ (NTHCHARCODE FILE -1)
((/ >)
[COND
((EQ START POS) (* ;
 "Didn't start with a directory delimiter,")
(COND
((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM. This is a subdirectory of the current connected directory")
(SETQ TYPE 'SUBDIRECTORY))
(T (* ; "True %"relative pathname%". The way to deal with it is dependent on the device on which HOST is implemented.")
(SETQ TYPE 'RELATIVEDIRECTORY]
(COND
((EQ LEN POS) (* ;
 "Only the initial directory is specified (i.e. %"{DSK}/%").")
(SETQ START POS)
-1)
(T -2)))
(PROGN [COND
[(EQ START POS) (* ;
 "Both of the initial and trail delimiters are omitted.")
(COND
((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM. This is a subdirectory of the current connected directory")
(SETQ TYPE 'SUBDIRECTORY))
(T (* ; "True %"relative pathname%". The way to deal with it is dependent on the device on which HOST is implemented.")
(SETQ TYPE 'RELATIVEDIRECTORY]
(T (COND
((EQ LEN POS)
(* ;
 "Only the initial directory is specified (i.e. %"{DSK}<%").")
(SETQ START POS]
-1)))
(UNPACKFILE1.DIRECTORY TYPE START END))
(RETURN (DREVERSE VAL)))
((SELCHARQ (NTHCHARCODE FILE POS)
(/ (* ;
 "unix and the 'xerox standard' use / for delimiter")
(* ;
 "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
(SETQ TEM (LASTCHPOS (CHARCODE (/ >))
FILE
(ADD1 POS)))
T)
((< >) (* ;
 "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>. Jericho uses >>")
(* ;
 "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
(SETQ TEM (LASTCHPOS (CHARCODE (> /))
FILE
(ADD1 POS)))
T)
NIL)
(* ;; "allow {DSK}/etc to be a directory specification.")
(if TEM
then (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
(SUB1 TEM))
(SETQ POS (ADD1 TEM))
else
(* ;; "{DSK}/foo: the directory is /, the name is foo")
(UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
(SETQ POS (ADD1 POS)))
(SETQ HOSTP T))
((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
FILE POS)) (* ; " {eris}abc> relative")
(* ;;
 " This is the true %"relative pathname%". Returns RELATIVEDIRECTORY instead of DIRECTORY.")
[COND
((NOT HOSTP) (* ; "%"Incomplete file names%" case.")
(UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
then 'DIRECTORY
else 'SUBDIRECTORY)
POS
(SUB1 TEM)))
(T (* ; "True %"relative pathname%".")
(UNPACKFILE1.DIRECTORY (if (EQ DIRFLG 'FIELD)
then 'DIRECTORY
else 'RELATIVEDIRECTORY)
POS
(SUB1 TEM]
(SETQ POS (ADD1 TEM))
(SETQ HOSTP T)))
(OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
(RETURN (DREVERSE VAL)))
(if (EQ OSTYPE T)
then (* ;
 "There wasn't a host field in the name, so we have no clue")
(SETQ OSTYPE NIL))
NAMELP
(* ;; "At this point, CODE is the TEM'th char of file name. POS is the first character of the field we are currently working on.")
(SELCHARQ CODE
(%. (* ;
 "Note position for later--we only want to deal with the last set of dots")
(if BEYONDNAME
then (* ;
 "no longer of interest (probably a bad name, too)")
elseif FIRSTDOT
then (* ; "We're recording the second dot")
(if SECONDDOT
then (* ;
 "Note only the two most recent dots")
(SETQ FIRSTDOT SECONDDOT))
(SETQ SECONDDOT TEM)
else (SETQ FIRSTDOT TEM)))
((! ; NIL) (* ;
 "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
(if (SELCHARQ CODE
(! (* ;
 "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
(AND OSTYPE (NEQ OSTYPE 'IFS)))
(; (* ; "If we've already parsed the extension, then we have a semi in the middle of the version. Skip it unless it's ;T or ;S")
[AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
NIL)
then (GO NEXTCHAR))
(if FIRSTDOT
then (* ;
 "Have a name and/or extension to parse now")
(if
[AND SECONDDOT
(NOT (if OSTYPE
then (* ;
 "Known OS type must be Tops20 for second dot to mean version")
(EQ OSTYPE 'TOPS20)
else (* ;
 "Unknown OS type, so check that %"version%" is numeric or wildcard")
(AND [for I from (ADD1 SECONDDOT) to (SUB1 TEM)
bind CH
always (OR (DIGITCHARP (SETQ CH (NTHCHARCODE FILE I
)))
(EQ CH (CHARCODE *]
(SELCHARQ CODE
(NIL (* ; "end of file name, ok")
T)
(; (* ;
 "This semi-colon better not be introducing a version")
(\UPF.TEMPFILEP FILE (ADD1 TEM)))
NIL]
then (* ;
 "Second dot is not intoducing a version")
(SETQ FIRSTDOT SECONDDOT)
(SETQ SECONDDOT NIL))
(UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
(SETQ POS (ADD1 (if SECONDDOT
then (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
(SUB1 SECONDDOT))
(SETQ BEYONDEXT T)
SECONDDOT
else FIRSTDOT)))
(SETQ BEYONDNAME T)
(SETQ FIRSTDOT NIL))
(UNPACKFILE1 (COND
((NOT BEYONDNAME)
(SETQQ BEYONDNAME NAME))
((NOT BEYONDEXT)
'EXTENSION)
((AND (EQ BEYONDEXT (CHARCODE ";"))
(\UPF.TEMPFILEP FILE POS)))
(T (* ;
 "Everything after the semi was version")
'VERSION))
POS
(SUB1 TEM))
(if (NULL CODE)
then (* ; "End of string")
(RETURN (DREVERSE VAL)))
(SETQ BEYONDEXT CODE) (* ;
 "Note the character that terminated the name/ext")
(SETQ POS (ADD1 TEM)))
(%' (* ; "Quoter")
(add TEM 1))
NIL)
NEXTCHAR
(SETQ CODE (NTHCHARCODE FILE (add TEM 1)))
(GO NAMELP])
(\UPF.NEXTPOS
[LAMBDA (CHAR STRING POS) (* lmm " 5-Oct-84 18:41")
(bind NCH while (SETQ NCH (NTHCHARCODE STRING POS)) do (COND
((EQMEMB NCH CHAR)
(RETURN POS))
((EQ NCH (CHARCODE %'))
(add POS 1)))
(add POS 1])
(\UPF.TEMPFILEP
[LAMBDA (FILENAME START) (* ; "Edited 6-Jan-88 13:12 by bvm:")
(* ;; "Checks whether START denotes a temporary mark for Twenex filename beginning at START. Returns the appropriate field name if so. Not sure we should parse this junk any more, but this at least localizes it.")
(SELCHARQ (NTHCHARCODE FILENAME START)
((T S) (* ; "Funny temp stuff")
(AND (EQ START (NCHARS FILENAME))
'TEMPORARY))
NIL])
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(PUTPROPS CANONICAL.DIRECTORY MACRO
[OPENLAMBDA (SRCSTRING)
(AND
SRCSTRING
(LET
((LEN (NCHARS SRCSTRING)))
(COND
((EQ LEN 1)
(if (STREQUAL SRCSTRING "/")
then "<"
else SRCSTRING))
(T
(LET*
((FATP (ffetch (STRINGP FATSTRINGP) of SRCSTRING))
(DSTSTRING (ALLOCSTRING LEN NIL NIL (AND FATP T)))
(DSTBASE (ffetch (STRINGP BASE) of DSTSTRING))
(DSTPOS 0)
(NEXTPOS -1))
(if (NOT FATP)
then [for SRCPOS from 1 to LEN bind CODE
first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
(CHARCODE (< / >))) do (add SRCPOS 1))
(if (> SRCPOS LEN)
then (RETURN "<"))
do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
((> /)
(if (> DSTPOS NEXTPOS)
then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
(SETQ NEXTPOS (add DSTPOS 1))))
(%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
(add DSTPOS 1)
(if (NEQ SRCPOS LEN)
then (\PUTBASETHIN DSTBASE DSTPOS
(NTHCHARCODE SRCSTRING (add SRCPOS 1)))
(add DSTPOS 1)))
(PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
(add DSTPOS 1)))
finally (RETURN (if (EQ DSTPOS LEN)
then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
(CHARCODE (> /)))
then (SUBSTRING DSTSTRING 1 -2)
else DSTSTRING)
elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
(CHARCODE (> /)))
then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
else (SUBSTRING DSTSTRING 1 DSTPOS]
else (for SRCPOS from 1 to LEN bind CODE
first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
(CHARCODE (< / >))) do (add SRCPOS 1))
do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
((> /)
(if (> DSTPOS NEXTPOS)
then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
(SETQ NEXTPOS (add DSTPOS 1))))
(%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
(add DSTPOS 1)
(if (NEQ SRCPOS LEN)
then (\PUTBASEFAT DSTBASE DSTPOS (NTHCHARCODE
SRCSTRING
(add SRCPOS 1)))
(add DSTPOS 1)))
(PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
(add DSTPOS 1)))
finally (RETURN (if (EQ DSTPOS LEN)
then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
(CHARCODE (> /)))
then (SUBSTRING DSTSTRING 1 -2)
else DSTSTRING)
elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
(CHARCODE (> /)))
then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
else (SUBSTRING DSTSTRING 1 DSTPOS])
(PUTPROPS UNPACKFILE1.DIRECTORY MACRO [OPENLAMBDA (NAM ST END)
(LET* ((OLDDIR (SUBSTRING FILE ST END))
(NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
(COND
[(NOT ONEFIELDFLG)
(SETQ VAL (CONS (COND
(PACKFLG (AND NEWDIR
(MKATOM NEWDIR)))
(T (OR NEWDIR "")))
(CONS NAM VAL]
((EQMEMB NAM ONEFIELDFLG)
(RETURN (COND
(PACKFLG (AND NEWDIR (MKATOM NEWDIR)))
(T (OR NEWDIR ""])
(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END) (* lmm "22-APR-81 22:21")
(COND
[(NOT ONEFIELDFLG)
(SETQ VAL (CONS (COND
(PACKFLG (SUBATOM FILE ST END))
(T (OR (SUBSTRING FILE ST END)
"")))
(CONS NAM VAL]
((EQMEMB NAM ONEFIELDFLG)
(RETURN (COND
(PACKFLG (SUBATOM FILE ST END))
(T (OR (SUBSTRING FILE ST END)
""])
)
)
(* ;; "Debugging")
(* ;; "DOTTEDNAMES: mismatch intended")
(* ;;
"RETURNFAILS: mismatch with DIRFLG=RETURN, DIRECTORY and SUBDIRECTORY are swapped. But original doesn't agree with its own complete analaysis."
)
(RPAQQ DOTTEDNAMES (".x" ">.git" "x.y.100"))
(RPAQQ TESTS
("*,;" "*.*;*" "*.;" "*.;*" "///abc/x" "/abc.x" "<" "<<<abc" "<<<abc>" "<<<abc>>" "<<<abc>x"
"<<abc" "<<xyz>>>zz" "<<xyz>>>zzz/" "<<xyz>>zz" "<<xyz>zz" "<ABC>" "<XYZ>aa" "<a.b>"
"<a;b>" "<ab;c" "<ab>" "<abc" "<abc*." "<abc.x" "<abc.x;1" "<abc;x" "<abc<<<x"
"<abc<xyz<foo" "<abc<xyz>qrs" "<abc>" "<abc>;1" "<abc>xyz" "<abc>xyz>foo" "<xxx"
"<xy>>zz" "<xyz>>>zzz/" ">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"
"A.B.C" "XXX<yyy" "a;b" "a;b/d" "a;b;c" "a;b;c;d" "aa" "aa;" "aa;NEWEST" "aa;newest"
"aaa" "aaa/bbb" "aaa/bbb/" "aaa/xyz;x;m" "aaa<bbb" "aaa<bbb/" "aaa<xyz>" "aaa>bbb>"
"aaa>xyz.e;m;n" "aaa>xyz>qrs" "abc" "abc...c" "abc///XYZ//" "abc/d" "abc/xyz"
"abc/xyz.qrs" "abc/xyz.qrs;2" "abc:x<qrs>z" "abc<<<XYZ//" "abc<x" "abc<xyz"
"abc<xyz>qq" "abc<xyzqq" "abc>;1" "abc>qr.x" "abc>xy" "abc>xyz" "abc>xyz;2"
"dev:aaa>xyz>qrs" "foo:" "foo:aaa<xyz" "foo:aaa<xyz>" "foo:x<qrs>z" "foo<a:B>" "s;n;b"
"x.y.z;w" "x.y;z" "x;y" "x<abc<xyz>qrs" "x<abc<z" "x<abc>z" "xxx<yyy" "xxx<yyy>"
"xxx<yyy>zzz" "xxx>yyy" "xxx>yyy>" "{ABC}" "{ABC}XXX:" "{DSK}" "{DSK}*.;*" "{DSK}...<a"
"{DSK}<a" "{DSK}xxx<a" "{DSK}xxx<xxx>yyy" "{DSK}xxx>xxx" "{DSK}xxx>yyy"
"{HOST}foo:x<qrs>z" "{HOST}x<qrs>z" "{abc}" "{dsk}foo:aaa>b>.c.e.g;f"
"{dsk}foo:aaa>b>.c.e;f" "{dsk}foo:aaa>b>c.e;f" "{eris}abc>" "{host}abc/xyz;2"
"{host}abc>xyz;2" "{x}abc<xyz>qq" "{x}abc<xyzqq" "<abc<xyz>abc" "<abc<xyz>qrs"
"<abc<xyz>"))
(RPAQQ RETURNFAILS (">" ">>>abc/x" ">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx" ">" ">>>abc/x"
">abc" ">abc;1" ">abc>" ">abc>xyz>foo" ">xxx"))
(DEFINEQ
(TRY
[LAMBDA (FILE ONEFIELDFLG DIRFLG) (* ; "Edited 23-May-2022 12:09 by rmk")
(* ; "Edited 25-Apr-2022 14:15 by rmk")
(* ; "Edited 24-Apr-2022 08:45 by rmk")
(* ; "Edited 21-Apr-2022 15:36 by rmk")
(CL:WHEN (LISTP (CAR (LISTP FILE)))
(SETQ FILE (CAR FILE)))
(LET (ORIG NEW)
(CL:WHEN (LISTP FILE)
(SETQ ONEFIELDFLG (CADR FILE))
(SETQ DIRFLG (CADDR FILE))
(SETQ FILE (CAR FILE)))
(SETQ ORIG (OLD-UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
(SETQ NEW (UNPACKFILENAME.STRING FILE ONEFIELDFLG DIRFLG))
(LIST (LIST FILE ONEFIELDFLG DIRFLG)
(AND (EQUAL ORIG NEW)
'=)
ORIG NEW])
(TRYALL
[LAMBDA (FILES ALLFLAG ONEFIELDFLG DIRFLG) (* ; "Edited 21-Apr-2022 17:56 by rmk")
(* ; "Edited 2-Apr-2022 23:50 by rmk")
(* ; "Edited 31-Mar-2022 22:57 by rmk")
(CL:WHEN (LISTP FILES)
(SETQ FILES (FOR F IN FILES COLLECT (CL:IF (LISTP (CAR (LISTP F)))
(CAR F)
F))))
(FOR FILE INFO (SAME _ 0)
(DIFF _ 0) IN FILES EACHTIME (SETQ INFO (TRY FILE ONEFIELDFLG DIRFLG))
(CL:IF (CADR INFO)
(ADD SAME 1)
(ADD DIFF 1)) UNLESS (AND (CADR INFO)
(NOT ALLFLAG))
COLLECT (PRINTOUT T .P2 (CAAR INFO)
31)
(IF (CADR INFO)
THEN (PRINTOUT T " = " .P2 (CADDR INFO))
(CL:WHEN (OR (CADAR INFO)
(CADDAR INFO))
(PRINTOUT T 60 (CADAR INFO)
%,,
(CADDAR INFO))
(TERPRI T))
ELSE (PRINTOUT T " ~= " -2 "old: " .P2 (CADDR INFO))
(CL:WHEN (OR (CADAR INFO)
(CADDAR INFO))
(PRINTOUT T 60 (CADAR INFO)
%,,
(CADDAR INFO))
(TERPRI T))
(PRINTOUT T 37 "new: " .P2 (CADDDR INFO)
T))
INFO FINALLY (PRINTOUT T SAME " matches, " DIFF " mismatches" T])
(DT
[LAMBDA (STRINGS ALLFLAG) (* ; "Edited 21-Apr-2022 17:53 by rmk")
(* ; "Edited 19-Apr-2022 20:55 by rmk")
(* ;; "Tests the DIRFLG options on STRINGS. If an element of STRINGS is a list, it is assumed to be a (STRING ONEFIELD DIRFLG), STRING is extracted.")
(SETQ STRINGS (FOR S INSIDE STRINGS COLLECT (CL:IF (LISTP S)
(CAR S)
S)))
[AND NIL (FOR ONEFIELD IN '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
JOIN (FOR DIR ORIG NEW SAME IN '(FIELD RETURN)
JOIN (PRINTOUT T T "ONEFIELDFLG = " ONEFIELD -3 "DIRFLG = " DIR T T)
(TRYALL STRINGS ALLFLAG ONEFIELD DIR))
FINALLY (FOR INFO SAME (DIFF _ 0) IN $$VAL DO (CL:IF (CADR INFO)
(ADD SAME 1)
(ADD DIFF 1))
FINALLY (SETQ SAME (IDIFFERENCE (LENGTH STRINGS)
DIFF))
(PRINTOUT T T "Overall: " SAME " matched, " DIFF " mismatched" T]
(TRYALL (FOR S IN STRINGS JOIN (FOR ONEFIELD IN '(NAME DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY)
JOIN (FOR DIR IN '(FIELD RETURN)
COLLECT (LIST S ONEFIELD DIR])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (893 18981 (OLD-UNPACKFILENAME.STRING 903 . 17808) (\UPF.NEXTPOS 17810 . 18396) (
\UPF.TEMPFILEP 18398 . 18979)) (28216 32820 (TRY 28226 . 29192) (TRYALL 29194 . 31111) (DT 31113 .
32818)))))
STOP

View File

@@ -1,23 +0,0 @@
TESTUPF contains functions for testing the new implementation of UNPACKFILENAME.STRING (now in ADIR) and the original definition.
The original definition is also provided here, under the name OLD-UNPACKFILENAME.STRING
TESTUPF also includes some test functions, and some of the strings that I have been testing with.
(TRY FILE ONEDIRFLG DIRFLG)
returns a comparison of the behavior of the original version and the new version in a list of the form
(FILE ONEDIRFLG DIRFLG) MATCH ORIG NEW)
where MATCH is = if ORIG and NEW are EQUAL, otherwise NIL. (For convenience, a list of this form can also be passed in as an argument.)
(TRYALL FILES ALLFLG ONDIRFLG DIRFLG)
applies TRY to each file-string in FILES, prints and reports what it discovers. If ALLFLG, it prints the result on every file, otherwise just the mismatches. Value is a list of TRY values that it printed.
(DT FILES) sets up a call to TRYALL for DIRFLG testing (setting DIRFLG NIL, FIELD, RETURN for each file in FILES).
The variable TESTS has the strings that I have tested against, the variable DOTTEDNAMES has the strings that I intend to be different (.cshrc as NAME, not EXTENSION). The new behavior avoids the bug that (PACKFILENAME.STRING 'EXTENSION "txt "BODY ".bashrc") produces ".txt" instead of ".bashrc.txt".
The variable RETURNFAILS is a list of strings with DIRFLG=RETURN that also don¹t match, in that the DIRECTORY and SUBDIRECTORY classifications are inverted between old and new for strings beginning with ª>". But the old code is inconsistent for these inputs: it returns different classifications of those substrings with or without the RETURN. (I think RETURN is for the case "/Users/kaplan" where the caller knows that the whole thing is a directory, doesn¹t want ªkaplanº to be parsed as a name. Just wants it to be normalized, with host and device stripped off.)

Binary file not shown.

View File

@@ -1,10 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED " 2-Dec-2021 19:33:12" |{DSK}<home>larry>medley>library>FILEBROWSER.;44| 267497
(FILECREATED " 4-Aug-2022 09:32:02" |{DSK}<home>larry>medley>library>FILEBROWSER.;2| 266567
|changes| |to:| (VARS FILEBROWSERCOMS)
:CHANGES-TO (VARS FILEBROWSERCOMS)
|previous| |date:| "23-Nov-2021 12:17:08" |{DSK}<home>larry>medley>library>FILEBROWSER.;39|)
:PREVIOUS-DATE " 2-Dec-2021 19:33:12" |{DSK}<home>larry>medley>library>FILEBROWSER.;1|)
; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
@@ -185,8 +185,7 @@ You specify how many versions to keep.")))
(* \; "Setup")
(FNS FB.STARTUP FB.MAKERIGIDWINDOW)
(FNS FB.PRINTFN FB.COPYFN))
(COMS (* \;
 "commands and major subfunctions")
(COMS (* \; "commands and major subfunctions")
(FNS FB.MENU.WHENSELECTEDFN FB.COMMANDSELECTEDFN FB.SUBITEMP FB.MAKE.BROWSER.BUSY
FB.FINISH.COMMAND FB.HANDLE.ABORT.BUTTON)
(FNS FB.DELETECOMMAND FB.DELVERCOMMAND FB.IS.NOT.SUBDIRECTORY.ITEM FB.DELVER.FILES
@@ -221,8 +220,8 @@ You specify how many versions to keep.")))
(FNS FB.ICONFN FB.INFOMENU.WHENSELECTEDFN FB.CLOSEFN FB.EXPUNGE?.MENU FB.AFTERCLOSEFN
FB.CLOSE&EXPUNGE)
(FNS FB.HARDCOPY.DIRECTORY FB.HARDCOPY.PRINT.TITLE FB.HARDCOPY.MAXWIDTH))
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
TABLEBROWSERDECLS)
(DECLARE\: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
TABLEBROWSER)
(RECORDS INFOFIELD FBFILEDATA FILEBROWSER)
(CONSTANTS FB.MORE.BORDER FB.NULL.VERSION)
(MACROS NULL.VERSIONP NULL.DIRECTORYP EQ.DIRECTORYP NULL.FIELDP)
@@ -276,8 +275,8 @@ You specify how many versions to keep.")))
DOCOPY
(RPAQ? FB.ICONSPEC '(#*(83 70)OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@LOOOOOOOOOOOOOOOOOONF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DCOOOHD@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@DOOOOND@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@D@@@@@D@@@@@BF@@@LH@@@@@GOOOOOL@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@COOOOOH@@@@@BF@@@LH@@@@@B@@@@@H@@@@@BF@@@LH@@@@@A@@@@A@@@@@@BF@@@LH@@@@@@OOOON@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LH@@@@@@@@@@@@@@@@@BF@@@LOOOOOOOOOOOOOOOOOONF@@@L@@@@@@@@@@@@@@@@@@@F@@@L@@@@@@@@@@@@@@@@@@@F@@@OOOOOOOOOOOOOOOOOOOON@@@OOOOOOOOOOOOOOOOOOOON@@@
NIL
(5 5 73 40)))
NIL
(5 5 73 40)))
)
(RPAQ? FB.EXPUNGE?MENU )
@@ -305,9 +304,9 @@ DOCOPY
(RPAQ? FB.DEFAULT.INFO '(SIZE CREATIONDATE AUTHOR))
(APPENDTOVAR FONTVARS (FB.ICONFONT LITTLEFONT)
(FB.BROWSERFONT DEFAULTFONT)
(FB.PROMPTFONT LITTLEFONT)
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
(FB.BROWSERFONT DEFAULTFONT)
(FB.PROMPTFONT LITTLEFONT)
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
@@ -408,27 +407,25 @@ You specify how many versions to keep.")))
))
(RPAQQ FB.VERSION.MENU.ITEMS (("1" 1 "Keep only one version of the files")
("2" 2 "Keep two versions of the files")
("3" 3 "Keep three versions of the files")
("4" 4 "Keep four versions of the files")
("Other" :NUMBER "Select number of versions to keep")))
("2" 2 "Keep two versions of the files")
("3" 3 "Keep three versions of the files")
("4" 4 "Keep four versions of the files")
("Other" :NUMBER "Select number of versions to keep")))
(RPAQQ FB.CLOSE.MENU.ITEMS (("Expunge deleted files" 'EXPUNGE
"Erases all files still marked 'deleted'")
("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
"Erases all files still marked 'deleted'")
("Don't expunge" 'NOEXPUNGE "Proceeds (closes or updates browser) without expunging deleted files.
Your deletions are thus ignored.")))
(RPAQQ FB.DEPTH.MENU.ITEMS (("Global default" :GLOBAL
"Set depth using the global default (FILING.ENUMERATION.DEPTH)"
)
("Infinite" T
"Set depth to infinity, i.e., enumerate all levels of directory"
)
("1" 1
"Set depth using the global default (FILING.ENUMERATION.DEPTH)")
("Infinite" T
"Set depth to infinity, i.e., enumerate all levels of directory")
("1" 1
"Set depth to 1, i.e., enumerate just the top level of the directory"
)
("2" 2 "Set depth to 2")
("Other" :NUMBER "Set depth to some other finite depth")))
)
("2" 2 "Set depth to 2")
("Other" :NUMBER "Set depth to some other finite depth")))
(RPAQQ FB.INFO.MENU.ITEMS
((|Length| LENGTH "Toggles Length display")
@@ -3857,127 +3854,124 @@ then click Recompute"))))
)
(DECLARE\: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
TABLEBROWSERDECLS)
(FILESLOAD (LOADCOMP)
TABLEBROWSER)
(DECLARE\: EVAL@COMPILE
(RECORD INFOFIELD (INFONAME INFOLABEL INFOWIDTH INFOFORMAT INFOPROTOTYPE))
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
(FILEINFO POINTER) (* \; "Plist of attributes")
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
(HASDIRPREFIX FLAG) (* \;
 "True if it has a directory prefix beyond that in common to all the files")
(DIRECTORYFILEP FLAG) (* \;
 "True if the \"file\" in this item is actually a subdirectory")
(SIZE POINTER) (* \; "Size of file, for stats")
(FILEDEPTH BYTE) (* \;
 "Number of levels of subdirectory beneath the main pattern--zero for files at that level")
(SORTVALUE POINTER) (* \;
 "Cached value by which we are sorting the dir.")
(SUBDIREND WORD) (* \;
 "Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
(STARTOFPNAME WORD) (* \;
 "Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
(VERSION WORD) (* \; "Version, or zero if none")
(STARTOFNAME WORD) (* \;
 "Index beyond all directory fields")
DUMMY)
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME
)
OF DATUM)
(FETCH (FBFILEDATA STARTOFPNAME
) OF DATUM)))
(SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA
FILENAME)
OF DATUM)
1
(FETCH (FBFILEDATA SUBDIREND
) OF
DATUM))))))
(DATATYPE FBFILEDATA ((FILENAME POINTER) (* \; "Full name of this file")
(FILEINFO POINTER) (* \; "Plist of attributes")
(VERSIONLESSNAME POINTER) (* \; "FILENAME sans version")
(DIRECTORYP FLAG) (* \; "True if it's a directory line")
(HASDIRPREFIX FLAG) (* \;
 "True if it has a directory prefix beyond that in common to all the files")
(DIRECTORYFILEP FLAG) (* \;
 "True if the \"file\" in this item is actually a subdirectory")
(SIZE POINTER) (* \; "Size of file, for stats")
(FILEDEPTH BYTE) (* \;
 "Number of levels of subdirectory beneath the main pattern--zero for files at that level")
(SORTVALUE POINTER) (* \;
 "Cached value by which we are sorting the dir.")
(SUBDIREND WORD) (* \;
 "Index of last char in subdirectory, or zero if HASDIRPREFIX is false")
(STARTOFPNAME WORD) (* \;
 "Start of name for printing purposes. Same as STARTOFNAME when browser sorted by name")
(VERSION WORD) (* \; "Version, or zero if none")
(STARTOFNAME WORD) (* \;
 "Index beyond all directory fields")
DUMMY)
(ACCESSFNS FBFILEDATA ((PRINTNAME (SUBSTRING (FETCH (FBFILEDATA FILENAME)
OF DATUM)
(FETCH (FBFILEDATA STARTOFPNAME)
OF DATUM)))
(SUBDIRECTORY (SUBSTRING (FETCH (FBFILEDATA FILENAME)
OF DATUM)
1
(FETCH (FBFILEDATA SUBDIREND)
OF DATUM))))))
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
 "True if we don't want separate subdirectory lines -- subdirs then included in name")
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
(SHOWUNDELETED? FLAG) (* \;
 "True if counter window should show `Undeleted' rather than `Total' counts")
(PATTERNPARSED? FLAG) (* \;
 "True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
(SORTBYDATE FLAG) (* \;
 "True if SORTATTRIBUTE is one of the date attributes")
(FBREADY FLAG) (* \; "False while FB is enumerating.")
(ABORTING FLAG) (* \;
 "True if enumeration is being aborted")
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
(FBCOMPUTEDDEPTH BYTE) (* \;
 "Depth at the time we enumerated directory (zero for infinite)")
(FBDISPLAYEDDEPTH BYTE) (* \;
 "Depth we are currently displaying (zero for infinite)")
(TABLEBROWSER POINTER) (* \;
 "Pointer to TABLEBROWSER object controlling the browser")
(BROWSERWINDOW POINTER) (* \; "Main window")
(COUNTERWINDOW POINTER) (* \;
 "Window that counts files, pages, deletions")
(HEADINGWINDOW POINTER) (* \;
 "Window with headings for browser columns")
(INFOMENUW POINTER) (* \;
 "Window containing choices for info to be displayed, or NIL if none yet")
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
(INFODISPLAYED POINTER) (* \;
 "List of attribute specs to be displayed")
(PATTERN POINTER) (* \;
 "Directory pattern being enumerated")
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
(SEEWINDOW POINTER) (* \;
 "Primary window used by FAST SEE command")
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
(SORTBY POINTER) (* \;
 "Sorting function or NIL for default sort")
(NAMESTART WORD) (* \;
 "Index of first character in file name beyond the common prefix shared by all")
(DIRECTORYSTART WORD) (* \;
 "Index of first character of directory in file names")
(INFOSTART WORD) (* \;
 "X position in browser where first col of info is displayed")
(NAMEOVERHEAD WORD) (* \;
 "This plus width of name gives is how much to allow before INFOSTART")
(OVERFLOWSPACING WORD) (* \;
 "Increment between sizes considered for INFOSTART")
(DIGITWIDTH WORD)
(TOTALFILES WORD) (* \;
 "Total number of files, deleted files, pages, deleted pages at the moment")
(DELETEDFILES WORD)
(TOTALPAGES POINTER)
(DELETEDPAGES POINTER)
(PAGECOUNT? POINTER) (* \;
 "True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
(COUNTERPOSITIONS POINTER) (* \;
 "List of pairs (left right) describing regions where the values of the counters are displayed")
(COUNTERPAGESTRING POINTER) (* \;
 "String to print after file/page count")
(OVERFLOWWIDTHS POINTER) (* \;
 "List of (xpos occurrences) describing files whose names exceed default INFOSTART")
(INFOMENUCHOICES POINTER) (* \;
 "Selections user has made in Info window, not necessarily the info currently displayed")
(UPDATEPROC POINTER) (* \;
 "Process doing an Update (Recompute)")
(DEFAULTDIR POINTER) (* \;
 "Default directory for destination of Copy/Rename")
(SORTATTRIBUTE POINTER) (* \;
 "Attribute being sorted on, or NIL if by name")
(SORTMENU POINTER)
(FBLOCK POINTER) (* \;
 "Lock acquired by filebrowser operations")
(SORTINDEX WORD) (* \;
 "Index (zero-based) in file info of the sort attribute")
(SIZEINDEX WORD) (* \; "Index of size attribute")
(FBDEPTH POINTER) (* \;
 "Enumeration depth, or NIL for default")
(ABORTWINDOW POINTER) (* \;
 "Dotted pair of (abortwindow . menuw) for this browser's abort window.")
DUMMY))
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG) (* \;
 "True if we don't want separate subdirectory lines -- subdirs then included in name")
(NSPATTERN? FLAG) (* \; "True if host is an ns host")
(SHOWUNDELETED? FLAG) (* \;
 "True if counter window should show `Undeleted' rather than `Total' counts")
(PATTERNPARSED? FLAG) (* \;
 "True if PREPAREDPATTERN, NAMESTART, DIRECTORYSTART are valid")
(SORTBYDATE FLAG) (* \;
 "True if SORTATTRIBUTE is one of the date attributes")
(FBREADY FLAG) (* \; "False while FB is enumerating.")
(ABORTING FLAG) (* \;
 "True if enumeration is being aborted")
(FIXEDTITLE FLAG) (* \; "True if caller supplied title")
(FBCOMPUTEDDEPTH BYTE) (* \;
 "Depth at the time we enumerated directory (zero for infinite)")
(FBDISPLAYEDDEPTH BYTE) (* \;
 "Depth we are currently displaying (zero for infinite)")
(TABLEBROWSER POINTER) (* \;
 "Pointer to TABLEBROWSER object controlling the browser")
(BROWSERWINDOW POINTER) (* \; "Main window")
(COUNTERWINDOW POINTER) (* \;
 "Window that counts files, pages, deletions")
(HEADINGWINDOW POINTER) (* \;
 "Window with headings for browser columns")
(INFOMENUW POINTER) (* \;
 "Window containing choices for info to be displayed, or NIL if none yet")
(PROMPTWINDOW POINTER) (* \; "GETPROMPTWINDOW BROWSERWINDOW")
(INFODISPLAYED POINTER) (* \;
 "List of attribute specs to be displayed")
(PATTERN POINTER) (* \;
 "Directory pattern being enumerated")
(PREPAREDPATTERN POINTER) (* \; "DIRECTORY.MATCH.SETUP of same")
(SEEWINDOW POINTER) (* \;
 "Primary window used by FAST SEE command")
(BROWSERFONT POINTER) (* \; "Font of BROWSERWINDOW")
(SORTBY POINTER) (* \;
 "Sorting function or NIL for default sort")
(NAMESTART WORD) (* \;
 "Index of first character in file name beyond the common prefix shared by all")
(DIRECTORYSTART WORD) (* \;
 "Index of first character of directory in file names")
(INFOSTART WORD) (* \;
 "X position in browser where first col of info is displayed")
(NAMEOVERHEAD WORD) (* \;
 "This plus width of name gives is how much to allow before INFOSTART")
(OVERFLOWSPACING WORD) (* \;
 "Increment between sizes considered for INFOSTART")
(DIGITWIDTH WORD)
(TOTALFILES WORD) (* \;
 "Total number of files, deleted files, pages, deleted pages at the moment")
(DELETEDFILES WORD)
(TOTALPAGES POINTER)
(DELETEDPAGES POINTER)
(PAGECOUNT? POINTER) (* \;
 "True if INFOCHOICES includes SIZE or LENGTH, so that we can count pages")
(COUNTERPOSITIONS POINTER) (* \;
 "List of pairs (left right) describing regions where the values of the counters are displayed")
(COUNTERPAGESTRING POINTER) (* \;
 "String to print after file/page count")
(OVERFLOWWIDTHS POINTER) (* \;
 "List of (xpos occurrences) describing files whose names exceed default INFOSTART")
(INFOMENUCHOICES POINTER) (* \;
 "Selections user has made in Info window, not necessarily the info currently displayed")
(UPDATEPROC POINTER) (* \;
 "Process doing an Update (Recompute)")
(DEFAULTDIR POINTER) (* \;
 "Default directory for destination of Copy/Rename")
(SORTATTRIBUTE POINTER) (* \;
 "Attribute being sorted on, or NIL if by name")
(SORTMENU POINTER)
(FBLOCK POINTER) (* \;
 "Lock acquired by filebrowser operations")
(SORTINDEX WORD) (* \;
 "Index (zero-based) in file info of the sort attribute")
(SIZEINDEX WORD) (* \; "Index of size attribute")
(FBDEPTH POINTER) (* \;
 "Enumeration depth, or NIL for default")
(ABORTWINDOW POINTER) (* \;
 "Dotted pair of (abortwindow . menuw) for this browser's abort window.")
DUMMY))
)
(/DECLAREDATATYPE 'FBFILEDATA
@@ -4065,25 +4059,24 @@ then click Recompute"))))
(DECLARE\: EVAL@COMPILE
(PUTPROPS NULL.VERSIONP MACRO ((V)
(EQ V 0)))
(EQ V 0)))
(PUTPROPS NULL.DIRECTORYP MACRO ((FILEDATA)
(EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA)
0)))
(EQ (FETCH (FBFILEDATA SUBDIREND) OF FILEDATA)
0)))
(PUTPROPS EQ.DIRECTORYP MACRO (OPENLAMBDA (FD1 FD2)
(STRING-EQUAL (|fetch| (FBFILEDATA FILENAME) |of|
FD1)
(|fetch| (FBFILEDATA FILENAME) |of| FD2)
:END1
(|fetch| (FBFILEDATA SUBDIREND) |of| FD1)
:END2
(|fetch| (FBFILEDATA SUBDIREND) |of| FD2))))
(STRING-EQUAL (|fetch| (FBFILEDATA FILENAME) |of| FD1)
(|fetch| (FBFILEDATA FILENAME) |of| FD2)
:END1
(|fetch| (FBFILEDATA SUBDIREND) |of| FD1)
:END2
(|fetch| (FBFILEDATA SUBDIREND) |of| FD2))))
(PUTPROPS NULL.FIELDP MACRO (OPENLAMBDA (STR)
(OR (NULL STR)
(EQ (NCHARS STR)
0))))
(OR (NULL STR)
(EQ (NCHARS STR)
0))))
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY
@@ -4176,67 +4169,67 @@ then click Recompute"))))
(ADDTOVAR SYSTEMRECLST
(DATATYPE FILEBROWSER ((NOSUBDIRECTORIES FLAG)
(NSPATTERN? FLAG)
(SHOWUNDELETED? FLAG)
(PATTERNPARSED? FLAG)
(SORTBYDATE FLAG)
(FBREADY FLAG)
(ABORTING FLAG)
(FIXEDTITLE FLAG)
(FBCOMPUTEDDEPTH BYTE)
(FBDISPLAYEDDEPTH BYTE)
(TABLEBROWSER POINTER)
(BROWSERWINDOW POINTER)
(COUNTERWINDOW POINTER)
(HEADINGWINDOW POINTER)
(INFOMENUW POINTER)
(PROMPTWINDOW POINTER)
(INFODISPLAYED POINTER)
(PATTERN POINTER)
(PREPAREDPATTERN POINTER)
(SEEWINDOW POINTER)
(BROWSERFONT POINTER)
(SORTBY POINTER)
(NAMESTART WORD)
(DIRECTORYSTART WORD)
(INFOSTART WORD)
(NAMEOVERHEAD WORD)
(OVERFLOWSPACING WORD)
(DIGITWIDTH WORD)
(TOTALFILES WORD)
(DELETEDFILES WORD)
(TOTALPAGES POINTER)
(DELETEDPAGES POINTER)
(PAGECOUNT? POINTER)
(COUNTERPOSITIONS POINTER)
(COUNTERPAGESTRING POINTER)
(OVERFLOWWIDTHS POINTER)
(INFOMENUCHOICES POINTER)
(UPDATEPROC POINTER)
(DEFAULTDIR POINTER)
(SORTATTRIBUTE POINTER)
(SORTMENU POINTER)
(FBLOCK POINTER)
(SORTINDEX WORD)
(SIZEINDEX WORD)
(FBDEPTH POINTER)
(ABORTWINDOW POINTER)
DUMMY))
(NSPATTERN? FLAG)
(SHOWUNDELETED? FLAG)
(PATTERNPARSED? FLAG)
(SORTBYDATE FLAG)
(FBREADY FLAG)
(ABORTING FLAG)
(FIXEDTITLE FLAG)
(FBCOMPUTEDDEPTH BYTE)
(FBDISPLAYEDDEPTH BYTE)
(TABLEBROWSER POINTER)
(BROWSERWINDOW POINTER)
(COUNTERWINDOW POINTER)
(HEADINGWINDOW POINTER)
(INFOMENUW POINTER)
(PROMPTWINDOW POINTER)
(INFODISPLAYED POINTER)
(PATTERN POINTER)
(PREPAREDPATTERN POINTER)
(SEEWINDOW POINTER)
(BROWSERFONT POINTER)
(SORTBY POINTER)
(NAMESTART WORD)
(DIRECTORYSTART WORD)
(INFOSTART WORD)
(NAMEOVERHEAD WORD)
(OVERFLOWSPACING WORD)
(DIGITWIDTH WORD)
(TOTALFILES WORD)
(DELETEDFILES WORD)
(TOTALPAGES POINTER)
(DELETEDPAGES POINTER)
(PAGECOUNT? POINTER)
(COUNTERPOSITIONS POINTER)
(COUNTERPAGESTRING POINTER)
(OVERFLOWWIDTHS POINTER)
(INFOMENUCHOICES POINTER)
(UPDATEPROC POINTER)
(DEFAULTDIR POINTER)
(SORTATTRIBUTE POINTER)
(SORTMENU POINTER)
(FBLOCK POINTER)
(SORTINDEX WORD)
(SIZEINDEX WORD)
(FBDEPTH POINTER)
(ABORTWINDOW POINTER)
DUMMY))
(DATATYPE FBFILEDATA ((FILENAME POINTER)
(FILEINFO POINTER)
(VERSIONLESSNAME POINTER)
(DIRECTORYP FLAG)
(HASDIRPREFIX FLAG)
(DIRECTORYFILEP FLAG)
(SIZE POINTER)
(FILEDEPTH BYTE)
(SORTVALUE POINTER)
(SUBDIREND WORD)
(STARTOFPNAME WORD)
(VERSION WORD)
(STARTOFNAME WORD)
DUMMY))
(FILEINFO POINTER)
(VERSIONLESSNAME POINTER)
(DIRECTORYP FLAG)
(HASDIRPREFIX FLAG)
(DIRECTORYFILEP FLAG)
(SIZE POINTER)
(FILEDEPTH BYTE)
(SORTVALUE POINTER)
(SUBDIREND WORD)
(STARTOFPNAME WORD)
(VERSION WORD)
(STARTOFNAME WORD)
DUMMY))
)
(DECLARE\: DONTEVAL@LOAD DOCOPY
@@ -4244,10 +4237,10 @@ then click Recompute"))))
(ADDTOVAR *ATTACHED-WINDOW-COMMAND-SYNONYMS* (HARDCOPYIMAGEW.TOFILE . HARDCOPYIMAGEW)
(HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
(HARDCOPYIMAGEW.TOPRINTER . HARDCOPYIMAGEW))
(ADDTOVAR |BackgroundMenuCommands| ("FileBrowser" '(FILEBROWSER)
"Opens a filebrowser window; prompts for pattern"))
"Opens a filebrowser window; prompts for pattern"))
(RPAQQ |BackgroundMenu| NIL)
@@ -4263,51 +4256,51 @@ then click Recompute"))))
(PUTPROPS FILEBROWSER COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1991 1993 1994 1999 2000 2001 2021))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (32602 55483 (FB 32612 . 33747) (FB.COPYBINARYCOMMAND 33749 . 34095) (FB.COPYTEXTCOMMAND
34097 . 34439) (FILEBROWSER 34441 . 47547) (FB.TABLEBROWSER 47549 . 47766) (FB.SELECTEDFILES 47768 .
48405) (FB.FETCHFILENAME 48407 . 48799) (FB.DIRECTORYP 48801 . 49195) (FB.PROMPTWPRINT 49197 . 50243)
(FB.PROMPTW.FORMAT 50245 . 50982) (FB.PROMPTFORINPUT 50984 . 53236) (FB.YES-OR-NO-P 53238 . 54272) (
FB.ALLOW.ABORT 54274 . 55128) (\\FB.HARDCOPY.TOFILE.EXTENSION 55130 . 55481)) (55507 56460 (FB.STARTUP
55517 . 56032) (FB.MAKERIGIDWINDOW 56034 . 56458)) (56461 61833 (FB.PRINTFN 56471 . 61624) (FB.COPYFN
61626 . 61831)) (61883 68223 (FB.MENU.WHENSELECTEDFN 61893 . 62251) (FB.COMMANDSELECTEDFN 62253 .
63792) (FB.SUBITEMP 63794 . 64395) (FB.MAKE.BROWSER.BUSY 64397 . 65201) (FB.FINISH.COMMAND 65203 .
67234) (FB.HANDLE.ABORT.BUTTON 67236 . 68221)) (68224 73740 (FB.DELETECOMMAND 68234 . 68515) (
FB.DELVERCOMMAND 68517 . 71710) (FB.IS.NOT.SUBDIRECTORY.ITEM 71712 . 71893) (FB.DELVER.FILES 71895 .
72984) (FB.DELETE.FILE 72986 . 73738)) (73741 75066 (FB.UNDELETECOMMAND 73751 . 74036) (
FB.UNDELETEALLCOMMAND 74038 . 74317) (FB.UNDELETE.FILE 74319 . 75064)) (75067 99248 (FB.COPYCOMMAND
75077 . 75346) (FB.RENAMECOMMAND 75348 . 75623) (FB.COPY/RENAME.COMMAND 75625 . 76548) (
FB.COPY/RENAME.ONE 76550 . 78872) (FB.COPY/RENAME.MANY 78874 . 85094) (FB.MERGE.DIRECTORIES 85096 .
85514) (FB.GREATEST.PREFIX 85516 . 86872) (FB.MAYBE.INSERT.FILE 86874 . 94314) (FB.GET.NEW.FILE.SPEC
94316 . 98147) (FB.CANONICAL.DIRECTORY 98149 . 99246)) (99249 107033 (FB.HARDCOPYCOMMAND 99259 .
100389) (FB.HARDCOPY.TOFILE 100391 . 107031)) (107034 117233 (FB.EDITCOMMAND 107044 . 107911) (
FB.EDITCOMMAND.ONEFILE 107913 . 111317) (FB.EDITLISPFILE 111319 . 112424) (FB.BROWSECOMMAND 112426 .
117231)) (117234 129155 (FB.FASTSEECOMMAND 117244 . 120694) (FB.FASTSEE.ONEFILE 120696 . 123853) (
FB.SEEFULLFN 123855 . 127986) (FB.SEEBUTTONFN 127988 . 129153)) (129156 130902 (FB.LOADCOMMAND 129166
. 129673) (FB.COMPILECOMMAND 129675 . 130213) (FB.OPERATE.ON.FILES 130215 . 130900)) (130903 179088 (
FB.UPDATECOMMAND 130913 . 131138) (FB.FIX-DIRECTORY-DATES 131140 . 132163) (FB.MAYBE.EXPUNGE 132165 .
133226) (FB.UPDATEBROWSERITEMS 133228 . 146443) (FB.DATE 146445 . 147086) (FB.ADJUST.DATE.WIDTH 147088
. 150056) (FB.SET.BROWSER.TITLE 150058 . 151060) (FB.MAYBE.WIDEN.NAMES 151062 . 153181) (
FB.SET.DEFAULT.NAME.WIDTH 153183 . 154547) (FB.CREATE.FILEBUCKET 154549 . 161769) (
FB.CHECK.NAME.LENGTH 161771 . 164192) (FB.ADD.FILEGROUP 164194 . 165721) (FB.INSERT.DIRECTORY 165723
. 165961) (FB.MAKE.SUBDIRECTORY.ITEM 165963 . 167372) (FB.ADD.FILE 167374 . 167987) (FB.INSERT.FILE
167989 . 171401) (FB.ANALYZE.PATTERN 171403 . 176667) (FB.CANONICALIZE.PATTERN 176669 . 177981) (
FB.GETALLFILEINFO 177983 . 179086)) (179089 187248 (FB.SORT.VERSIONS 179099 . 181870) (
FB.DECREASING.VERSION 181872 . 182541) (FB.INCREASING.VERSION 182543 . 183164) (
FB.NAMES.DECREASING.VERSION 183166 . 184201) (FB.NAMES.INCREASING.VERSION 184203 . 185200) (
FB.DECREASING.NUMERIC.ATTR 185202 . 185882) (FB.INCREASING.NUMERIC.ATTR 185884 . 186558) (
FB.ALPHABETIC.ATTR 186560 . 187246)) (187249 197091 (FB.SORTCOMMAND 187259 . 194089) (
FB.INSERT.SUBDIRECTORIES 194091 . 194888) (FB.GET.SORT.MENU 194890 . 197089)) (197092 213313 (
FB.EXPUNGECOMMAND 197102 . 199687) (FB.NEWPATTERNCOMMAND 199689 . 200087) (FB.NEWINFOCOMMAND 200089 .
202921) (FB.DEPTHCOMMAND 202923 . 204698) (FB.SHAPECOMMAND 204700 . 208042) (FB.REMOVE.FILE 208044 .
209865) (FB.COUNT.FILE.CHANGE 209867 . 211312) (FB.SETNEWPATTERN 211314 . 212484) (FB.GET.NEWPATTERN
212486 . 213070) (FB.OPTIONSCOMMAND 213072 . 213311)) (213348 214401 (FB.GETWINDOW 213358 . 214399)) (
214402 215414 (FB.INFOMENU.SHADEINITIALSELECTIONS 214412 . 215059) (FB.INFO.ITEM.NAMED 215061 . 215412
)) (215415 224947 (FB.MAKECOUNTERWINDOW 215425 . 216953) (FB.COUNTERW.REDISPLAYFN 216955 . 217542) (
FB.UPDATE.COUNTERS 217544 . 219616) (FB.DISPLAY.COUNTERS 219618 . 224678) (FB.COUNTER.STRING 224680 .
224945)) (224948 229657 (FB.MAKEHEADINGWINDOW 224958 . 226572) (FB.HEADINGW.REDISPLAYFN 226574 .
226840) (FB.HEADINGW.RESHAPEFN 226842 . 227218) (FB.HEADINGW.DISPLAY 227220 . 229655)) (229658 233841
(FB.ICONFN 229668 . 230015) (FB.INFOMENU.WHENSELECTEDFN 230017 . 230747) (FB.CLOSEFN 230749 . 231952)
(FB.EXPUNGE?.MENU 231954 . 232366) (FB.AFTERCLOSEFN 232368 . 232729) (FB.CLOSE&EXPUNGE 232731 . 233839
)) (233842 245900 (FB.HARDCOPY.DIRECTORY 233852 . 244209) (FB.HARDCOPY.PRINT.TITLE 244211 . 244537) (
FB.HARDCOPY.MAXWIDTH 244539 . 245898)))))
(FILEMAP (NIL (32375 55256 (FB 32385 . 33520) (FB.COPYBINARYCOMMAND 33522 . 33868) (FB.COPYTEXTCOMMAND
33870 . 34212) (FILEBROWSER 34214 . 47320) (FB.TABLEBROWSER 47322 . 47539) (FB.SELECTEDFILES 47541 .
48178) (FB.FETCHFILENAME 48180 . 48572) (FB.DIRECTORYP 48574 . 48968) (FB.PROMPTWPRINT 48970 . 50016)
(FB.PROMPTW.FORMAT 50018 . 50755) (FB.PROMPTFORINPUT 50757 . 53009) (FB.YES-OR-NO-P 53011 . 54045) (
FB.ALLOW.ABORT 54047 . 54901) (\\FB.HARDCOPY.TOFILE.EXTENSION 54903 . 55254)) (55280 56233 (FB.STARTUP
55290 . 55805) (FB.MAKERIGIDWINDOW 55807 . 56231)) (56234 61606 (FB.PRINTFN 56244 . 61397) (FB.COPYFN
61399 . 61604)) (61656 67996 (FB.MENU.WHENSELECTEDFN 61666 . 62024) (FB.COMMANDSELECTEDFN 62026 .
63565) (FB.SUBITEMP 63567 . 64168) (FB.MAKE.BROWSER.BUSY 64170 . 64974) (FB.FINISH.COMMAND 64976 .
67007) (FB.HANDLE.ABORT.BUTTON 67009 . 67994)) (67997 73513 (FB.DELETECOMMAND 68007 . 68288) (
FB.DELVERCOMMAND 68290 . 71483) (FB.IS.NOT.SUBDIRECTORY.ITEM 71485 . 71666) (FB.DELVER.FILES 71668 .
72757) (FB.DELETE.FILE 72759 . 73511)) (73514 74839 (FB.UNDELETECOMMAND 73524 . 73809) (
FB.UNDELETEALLCOMMAND 73811 . 74090) (FB.UNDELETE.FILE 74092 . 74837)) (74840 99021 (FB.COPYCOMMAND
74850 . 75119) (FB.RENAMECOMMAND 75121 . 75396) (FB.COPY/RENAME.COMMAND 75398 . 76321) (
FB.COPY/RENAME.ONE 76323 . 78645) (FB.COPY/RENAME.MANY 78647 . 84867) (FB.MERGE.DIRECTORIES 84869 .
85287) (FB.GREATEST.PREFIX 85289 . 86645) (FB.MAYBE.INSERT.FILE 86647 . 94087) (FB.GET.NEW.FILE.SPEC
94089 . 97920) (FB.CANONICAL.DIRECTORY 97922 . 99019)) (99022 106806 (FB.HARDCOPYCOMMAND 99032 .
100162) (FB.HARDCOPY.TOFILE 100164 . 106804)) (106807 117006 (FB.EDITCOMMAND 106817 . 107684) (
FB.EDITCOMMAND.ONEFILE 107686 . 111090) (FB.EDITLISPFILE 111092 . 112197) (FB.BROWSECOMMAND 112199 .
117004)) (117007 128928 (FB.FASTSEECOMMAND 117017 . 120467) (FB.FASTSEE.ONEFILE 120469 . 123626) (
FB.SEEFULLFN 123628 . 127759) (FB.SEEBUTTONFN 127761 . 128926)) (128929 130675 (FB.LOADCOMMAND 128939
. 129446) (FB.COMPILECOMMAND 129448 . 129986) (FB.OPERATE.ON.FILES 129988 . 130673)) (130676 178861 (
FB.UPDATECOMMAND 130686 . 130911) (FB.FIX-DIRECTORY-DATES 130913 . 131936) (FB.MAYBE.EXPUNGE 131938 .
132999) (FB.UPDATEBROWSERITEMS 133001 . 146216) (FB.DATE 146218 . 146859) (FB.ADJUST.DATE.WIDTH 146861
. 149829) (FB.SET.BROWSER.TITLE 149831 . 150833) (FB.MAYBE.WIDEN.NAMES 150835 . 152954) (
FB.SET.DEFAULT.NAME.WIDTH 152956 . 154320) (FB.CREATE.FILEBUCKET 154322 . 161542) (
FB.CHECK.NAME.LENGTH 161544 . 163965) (FB.ADD.FILEGROUP 163967 . 165494) (FB.INSERT.DIRECTORY 165496
. 165734) (FB.MAKE.SUBDIRECTORY.ITEM 165736 . 167145) (FB.ADD.FILE 167147 . 167760) (FB.INSERT.FILE
167762 . 171174) (FB.ANALYZE.PATTERN 171176 . 176440) (FB.CANONICALIZE.PATTERN 176442 . 177754) (
FB.GETALLFILEINFO 177756 . 178859)) (178862 187021 (FB.SORT.VERSIONS 178872 . 181643) (
FB.DECREASING.VERSION 181645 . 182314) (FB.INCREASING.VERSION 182316 . 182937) (
FB.NAMES.DECREASING.VERSION 182939 . 183974) (FB.NAMES.INCREASING.VERSION 183976 . 184973) (
FB.DECREASING.NUMERIC.ATTR 184975 . 185655) (FB.INCREASING.NUMERIC.ATTR 185657 . 186331) (
FB.ALPHABETIC.ATTR 186333 . 187019)) (187022 196864 (FB.SORTCOMMAND 187032 . 193862) (
FB.INSERT.SUBDIRECTORIES 193864 . 194661) (FB.GET.SORT.MENU 194663 . 196862)) (196865 213086 (
FB.EXPUNGECOMMAND 196875 . 199460) (FB.NEWPATTERNCOMMAND 199462 . 199860) (FB.NEWINFOCOMMAND 199862 .
202694) (FB.DEPTHCOMMAND 202696 . 204471) (FB.SHAPECOMMAND 204473 . 207815) (FB.REMOVE.FILE 207817 .
209638) (FB.COUNT.FILE.CHANGE 209640 . 211085) (FB.SETNEWPATTERN 211087 . 212257) (FB.GET.NEWPATTERN
212259 . 212843) (FB.OPTIONSCOMMAND 212845 . 213084)) (213121 214174 (FB.GETWINDOW 213131 . 214172)) (
214175 215187 (FB.INFOMENU.SHADEINITIALSELECTIONS 214185 . 214832) (FB.INFO.ITEM.NAMED 214834 . 215185
)) (215188 224720 (FB.MAKECOUNTERWINDOW 215198 . 216726) (FB.COUNTERW.REDISPLAYFN 216728 . 217315) (
FB.UPDATE.COUNTERS 217317 . 219389) (FB.DISPLAY.COUNTERS 219391 . 224451) (FB.COUNTER.STRING 224453 .
224718)) (224721 229430 (FB.MAKEHEADINGWINDOW 224731 . 226345) (FB.HEADINGW.REDISPLAYFN 226347 .
226613) (FB.HEADINGW.RESHAPEFN 226615 . 226991) (FB.HEADINGW.DISPLAY 226993 . 229428)) (229431 233614
(FB.ICONFN 229441 . 229788) (FB.INFOMENU.WHENSELECTEDFN 229790 . 230520) (FB.CLOSEFN 230522 . 231725)
(FB.EXPUNGE?.MENU 231727 . 232139) (FB.AFTERCLOSEFN 232141 . 232502) (FB.CLOSE&EXPUNGE 232504 . 233612
)) (233615 245673 (FB.HARDCOPY.DIRECTORY 233625 . 243982) (FB.HARDCOPY.PRINT.TITLE 243984 . 244310) (
FB.HARDCOPY.MAXWIDTH 244312 . 245671)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 8-Oct-92 16:50:21" "{Pele:mv:envos}<LispCore>library>HRULE.;11" 23325
changes to%: (FNS VRULE.CREATE VRULE.GETFN2)
(FILECREATED "25-Jul-2022 15:09:26" {DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;4 23801
previous date%: "29-Sep-92 21:06:13" "{Pele:mv:envos}<LispCore>library>HRULE.;10")
:CHANGES-TO (VARS HRULECOMS)
:PREVIOUS-DATE "25-Jul-2022 15:07:00"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>HRULE.;3)
(* ; "
Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1985, 1990-1992 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT HRULECOMS)
@@ -33,7 +35,10 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION HRULE.WHENOPERATEDONFN)
(FUNCTION NILL]
(FUNCTION (LAMBDA (OBJ)
(CONCAT (CHARACTER (CHARCODE EOL))
(ALLOCSTRING 20 "-")
(CHARACTER (CHARCODE EOL]
[COMS
(* ;; "Vertical rules")
@@ -200,11 +205,11 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
(RPAQ? HRULE.DEFAULT.WIDTH 2)
(RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN
HRULE.COPYFN HRULE.WHENOPERATEDONFN))
(RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN
HRULE.WHENOPERATEDONFN))
(RPAQ HRULE.IMAGEFNS
(IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN)
[IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN)
(FUNCTION HRULE.IMAGEBOXFN)
(FUNCTION HRULE.PUTFN)
(FUNCTION HRULE.GETFN)
@@ -216,7 +221,10 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION HRULE.WHENOPERATEDONFN)
(FUNCTION NILL)))
(FUNCTION (LAMBDA (OBJ)
(CONCAT (CHARACTER (CHARCODE EOL))
(ALLOCSTRING 20 "-")
(CHARACTER (CHARCODE EOL])
@@ -502,12 +510,12 @@ Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights r
(FUNCTION NILL)))
(PUTPROPS HRULE COPYRIGHT ("Venue & Xerox Corporation" 1985 1990 1991 1992))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4225 10404 (HRULE.CREATE 4235 . 5657) (HRULE.DISPLAYFN 5659 . 8228) (HRULE.GETFN 8230
. 8550) (HRULE.IMAGEBOXFN 8552 . 9354) (HRULE.PUTFN 9356 . 9734) (HRULE.COPYFN 9736 . 10200) (
HRULE.WHENOPERATEDONFN 10202 . 10402)) (11107 17312 (VRULE.CREATE 11117 . 13116) (VRULE.DISPLAYFN
13118 . 15312) (VRULE.GETFN 15314 . 15535) (VRULE.GETFN2 15537 . 15873) (VRULE.IMAGEBOXFN 15875 .
16303) (VRULE.PUTFN 16305 . 16703) (VRULE.COPYFN 16705 . 17108) (VRULE.WHENOPERATEDONFN 17110 . 17310)
) (17951 22601 (CROPMARK.CREATE 17961 . 19228) (CROPMARK.DISPLAYFN 19230 . 20730) (CROPMARK.GETFN
20732 . 21026) (CROPMARK.IMAGEBOXFN 21028 . 21729) (CROPMARK.PUTFN 21731 . 22009) (CROPMARK.COPYFN
22011 . 22394) (CROPMARK.WHENOPERATEDONFN 22396 . 22599)))))
(FILEMAP (NIL (4512 10691 (HRULE.CREATE 4522 . 5944) (HRULE.DISPLAYFN 5946 . 8515) (HRULE.GETFN 8517
. 8837) (HRULE.IMAGEBOXFN 8839 . 9641) (HRULE.PUTFN 9643 . 10021) (HRULE.COPYFN 10023 . 10487) (
HRULE.WHENOPERATEDONFN 10489 . 10689)) (11583 17788 (VRULE.CREATE 11593 . 13592) (VRULE.DISPLAYFN
13594 . 15788) (VRULE.GETFN 15790 . 16011) (VRULE.GETFN2 16013 . 16349) (VRULE.IMAGEBOXFN 16351 .
16779) (VRULE.PUTFN 16781 . 17179) (VRULE.COPYFN 17181 . 17584) (VRULE.WHENOPERATEDONFN 17586 . 17786)
) (18427 23077 (CROPMARK.CREATE 18437 . 19704) (CROPMARK.DISPLAYFN 19706 . 21206) (CROPMARK.GETFN
21208 . 21502) (CROPMARK.IMAGEBOXFN 21504 . 22205) (CROPMARK.PUTFN 22207 . 22485) (CROPMARK.COPYFN
22487 . 22870) (CROPMARK.WHENOPERATEDONFN 22872 . 23075)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,22 +1,20 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
(FILECREATED " 2-Nov-2022 10:13:59" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;3| 23999
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
)
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
(VARS MSCOMMONCOMS)
:CHANGES-TO (VARS MSCOMMONCOMS)
(TEMPLATES CL:UNLESS CL:WHEN)
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
:PREVIOUS-DATE "15-Jan-2022 20:17:21" |{DSK}<home>larry>ilisp>medley>library>MSCOMMON.;1|)
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
; Copyright (c) 1988, 1990, 1992, 2022 by Venue & Xerox Corporation.
(PRETTYCOMPRINT MSCOMMONCOMS)
(RPAQQ MSCOMMONCOMS
((PROP FILETYPE MSCOMMON)
(DECLARE\: EVAL@COMPILE (GLOBALVARS USERTEMPLATES MSTEMPLATES))
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
(* |;;| "Templates for CL stuff that need them.")
@@ -89,6 +87,12 @@
(CLRHASH USERTEMPLATES))))
(PUTPROPS MSCOMMON FILETYPE :COMPILE-FILE)
(DECLARE\: EVAL@COMPILE
(DECLARE\: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS USERTEMPLATES MSTEMPLATES)
)
)
(DEFINEQ
(FUNCTIONSMSGETDEF
@@ -470,13 +474,13 @@
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFFECT RETURN))
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFFECT RETURN))
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
:GENSYM :ARRAY))
@@ -552,8 +556,8 @@
(PUTHASH KEY VAL MSTEMPLATES)))
(CLRHASH USERTEMPLATES)
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992 2022))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
VARIABLESMSGETDEF 6733 . 7289)))))
(FILEMAP (NIL (5219 7230 (FUNCTIONSMSGETDEF 5229 . 6197) (FUNCTIONSMSMC 6199 . 6670) (
VARIABLESMSGETDEF 6672 . 7228)))))
STOP

Binary file not shown.

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,11 +1,10 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2022 09:17:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;2 490756
(FILECREATED " 4-Aug-2022 09:58:03" {DSK}<home>larry>medley>library>SKETCH.;2 491064
:CHANGES-TO (FNS SKETCH.PUT)
:CHANGES-TO (FNS SKETCH.COMMANDMENU.ITEMS)
:PREVIOUS-DATE "21-Jan-93 11:59:03"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;1)
:PREVIOUS-DATE " 1-Feb-2022 09:17:12" {DSK}<home>larry>medley>library>SKETCH.;1)
(* ; "
@@ -1358,10 +1357,9 @@ This will be slow for arcs and curves."]
TITLE _ TITLE])
(SKETCH.COMMANDMENU.ITEMS
[LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11")
(* returns a list of the items that are in the sketch command menu.)
[LAMBDA (ADDFIXITEM ELEMENTTYPES VIEWER) (* rrb "24-Sep-86 18:11")
(* returns a list of the items that
 are in the sketch command menu.)
(APPEND '[(Delete SK.DELETE.ELT "Deletes one or more elements from the sketch."
(SUBITEMS ("Delete element(s)" SK.DELETE.ELT
"Deletes one or more elements from the sketch.")
@@ -1388,15 +1386,18 @@ This will be slow for arcs and curves."]
(Combined SK.SET.MOVE.MODE.COMBINED
"MOVE command will move points if a single point is clicked; elements otherwise"
]
'[(Copy SK.COPY.ELT "Copies a piece of the sketch." (SUBITEMS ("Copy elements" SK.COPY.ELT
'[(Copy SK.COPY.ELT "Copies a piece of the sketch." (SUBITEMS ("Copy elements" SK.COPY.ELT
"copies one or more elements of the sketch."
)
("Copy w/2 pt trans"
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
SK.COPY.AND.TWO.PT.TRANSFORM.ELTS
"Copies one or more sketch elements with a two point transformation."
)
("Copy w/3 pt trans"
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
SK.COPY.AND.THREE.PT.TRANSFORM.ELTS
"Copies one or more sketch elements with a three point transformation."
]
'[(Align SK.ALIGN.POINTS.LEFT "Aligns a collection of points with the leftmost one."
@@ -8763,149 +8764,149 @@ Otherwise, type '^'.")
)
(PUTPROPS SKETCH COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (22155 85518 (SKETCH 22165 . 24270) (SKETCH.FROM.A.FILE 24272 . 24587) (SKETCHW.CREATE
24589 . 29163) (SKETCH.RESET 29165 . 30687) (SKETCHW.FIG.CHANGED 30689 . 31029) (SK.WINDOW.TITLE 31031
. 31418) (EDITSLIDE 31420 . 31826) (EDITSKETCH 31828 . 32152) (SK.PUT.ON.FILE 32154 . 33606) (
SK.OUTPUT.FILE.NAME 33608 . 33982) (SKETCH.PUT 33984 . 36882) (SK.GET.FROM.FILE 36884 . 37777) (
SK.INCLUDE.FILE 37779 . 40287) (SK.GET.IMAGEOBJ.FROM.FILE 40289 . 42492) (SKETCH.GET 42494 . 42801) (
ADD.SKETCH.TO.VIEWER 42803 . 45389) (FILENAMELESSVERSION 45391 . 45667) (SK.ADD.ELEMENTS.TO.SKETCH
45669 . 46183) (SKETCH.SET.A.DEFAULT 46185 . 53343) (SK.POPUP.SELECTIONFN 53345 . 53887) (
GETSKETCHWREGION 53889 . 54095) (SK.ADD.ELEMENT 54097 . 55676) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
55678 . 57072) (SK.ELTS.BY.PRIORITY 57074 . 57370) (SK.ORDER.ELEMENTS 57372 . 57639) (
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57641 . 59135) (SK.ADD.ELEMENTS 59137 . 59661) (
SK.CHECK.WHENADDEDFN 59663 . 60393) (SK.APPLY.MENU.COMMAND 60395 . 61193) (SK.DELETE.ELEMENT1 61195 .
62773) (SK.MARK.DIRTY 62775 . 63441) (SK.MARK.UNDIRTY 63443 . 63774) (SK.MENU.AND.RETURN.FIELD 63776
. 64441) (SKETCH.SET.BRUSH.SHAPE 64443 . 65028) (SKETCH.SET.BRUSH.SIZE 65030 . 65536) (
SKETCHW.CLOSEFN 65538 . 67329) (SK.CONFIRM.DESTRUCTION 67331 . 68330) (SKETCHW.OUTFN 68332 . 68596) (
SKETCHW.REOPENFN 68598 . 69010) (MAKE.LOCAL.SKETCH 69012 . 69742) (MAP.SKETCHSPEC.INTO.VIEWER 69744 .
70954) (SKETCHW.REPAINTFN 70956 . 71784) (SKETCHW.REPAINTFN1 71786 . 72725) (SK.DRAWFIGURE.IF 72727 .
73249) (SKETCHW.SCROLLFN 73251 . 77444) (SKETCHW.RESHAPEFN 77446 . 79704) (SK.UPDATE.EVENT.SELECTION
79706 . 81761) (LIGHTGRAYWINDOW 81763 . 81926) (SK.ADD.SPACES 81928 . 82674) (SK.SKETCH.MENU 82676 .
82998) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83000 . 83852) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83854 . 84814)
(SK.RETURN.TTY 84816 . 85184) (SK.TAKE.TTY 85186 . 85516)) (85572 108565 (SKETCH.COMMANDMENU 85582 .
85919) (SKETCH.COMMANDMENU.ITEMS 85921 . 105669) (CREATE.SKETCHW.COMMANDMENU 105671 . 106091) (
SKETCHW.SELECTIONFN 106093 . 107196) (SKETCH.MONITORLOCK 107198 . 107669) (SK.EVAL.AS.PROCESS 107671
. 108284) (SK.EVAL.WITH.LOCK 108286 . 108563)) (108566 116370 (SK.FIX.MENU 108576 . 109670) (
SK.SET.UP.MENUS 109672 . 111973) (SK.INSURE.HAS.MENU 111975 . 112637) (SK.CREATE.STANDARD.MENU 112639
. 113084) (SK.ADD.ITEM.TO.MENU 113086 . 113761) (SK.GET.VIEWER.POPUP.MENU 113763 . 115964) (
SK.CLEAR.POPUP.MENU 115966 . 116368)) (116426 125248 (SKETCH.CREATE 116436 . 117222) (GETSKETCHPROP
117224 . 120281) (PUTSKETCHPROP 120283 . 124215) (CREATE.DEFAULT.SKETCH.CONTEXT 124217 . 125246)) (
125414 148310 (SK.COPY.BUTTONEVENTFN 125424 . 136652) (SK.BUTTONEVENT.MARK 136654 . 137037) (
SK.BUILD.IMAGEOBJ 137039 . 146954) (SK.BUTTONEVENT.OVERP 146956 . 147579) (SK.BUTTONEVENT.SAME.KEYS
147581 . 148308)) (148589 174404 (SK.SEL.AND.CHANGE 148599 . 148891) (SK.CHECK.WHENCHANGEDFN 148893 .
149599) (SK.CHECK.PRECHANGEFN 149601 . 150202) (SK.CHANGE.ELT 150204 . 150396) (SK.CHANGE.THING 150398
. 151649) (SKETCH.CHANGE.ELEMENTS 151651 . 152834) (SK.APPLY.SINGLE.CHANGEFN 152836 . 153409) (
SK.DO.CHANGESPECS 153411 . 155070) (SK.VIEWER.FROM.SKETCH.ARG 155072 . 155514) (SK.DO.CHANGESPEC1
155516 . 157391) (SK.CHANGEFN 157393 . 157973) (SK.READCHANGEFN 157975 . 158434) (SK.DEFAULT.CHANGEFN
158436 . 160908) (CHANGEABLEFIELDITEMS 160910 . 161557) (SK.APPLY.CHANGE.COMMAND 161559 . 162176) (
SK.DO.AND.RECORD.CHANGES 162178 . 163575) (SK.APPLY.CHANGE.COMMAND1 163577 . 165065) (
SK.ELEMENTS.CHANGEFN 165067 . 167391) (READ.POINT.TO.ADD 167393 . 168337) (GLOBAL.KNOT.FROM.LOCAL
168339 . 168799) (SK.ADD.KNOT.TO.ELEMENT 168801 . 169745) (SK.GROUP.CHANGEFN 169747 . 170959) (
SK.GROUP.CHANGEFN1 170961 . 174402)) (174571 188304 (ADD.ELEMENT.TO.SKETCH 174581 . 176287) (
ADD.SKETCH.VIEWER 176289 . 176957) (REMOVE.SKETCH.VIEWER 176959 . 177572) (ALL.SKETCH.VIEWERS 177574
. 177814) (SKETCH.ALL.VIEWERS 177816 . 178076) (VIEWER.BUCKET 178078 . 178229) (ELT.INSIDE.REGION?
178231 . 178558) (ELT.INSIDE.SKWP 178560 . 178851) (SCALE.FROM.SKW 178853 . 179103) (
SK.ADDELT.TO.WINDOW 179105 . 179965) (SK.CALC.REGION.VIEWED 179967 . 180345) (SK.DRAWFIGURE 180347 .
181636) (SK.DRAWFIGURE1 181638 . 182022) (SK.LOCAL.FROM.GLOBAL 182024 . 183259) (SKETCH.REGION.VIEWED
183261 . 185948) (SKETCH.VIEW.FROM.NAME 185950 . 186380) (SK.UPDATE.REGION.VIEWED 186382 . 186774) (
SKETCH.ADD.AND.DISPLAY 186776 . 187184) (SKETCH.ADD.AND.DISPLAY1 187186 . 187624) (SK.ADD.ITEM 187626
. 187958) (SKETCHW.ADD.INSTANCE 187960 . 188302)) (188345 201533 (SK.SEL.AND.DELETE 188355 . 188743)
(SK.ERASE.AND.DELETE.ITEM 188745 . 189164) (REMOVE.ELEMENT.FROM.SKETCH 189166 . 190277) (
SK.DELETE.ELEMENT 190279 . 190837) (SK.DELETE.ELEMENT2 190839 . 191500) (SK.DELETE.KNOT 191502 .
191793) (SK.SEL.AND.DELETE.KNOT 191795 . 192920) (SK.DELETE.ELEMENT.KNOT 192922 . 196129) (
SK.CHECK.WHENDELETEDFN 196131 . 196911) (SK.CHECK.PREEDITFN 196913 . 197397) (
SK.CHECK.END.INITIAL.EDIT 197399 . 197933) (SK.CHECK.WHENPOINTDELETEDFN 197935 . 198731) (SK.ERASE.ELT
198733 . 199069) (SK.DELETE.ELT 199071 . 199446) (SK.DELETE.ITEM 199448 . 199856) (DELFROMTCONC
199858 . 201531)) (201572 215406 (SK.COPY.ELT 201582 . 201952) (SK.SEL.AND.COPY 201954 . 202337) (
SK.COPY.ELEMENTS 202339 . 207967) (SK.ADD.COPY.OF.ELEMENTS 207969 . 209736) (
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209738 . 209978) (SK.COPY.ITEM 209980 . 210777) (SK.INSERT.SKETCH 210779
. 215404)) (215446 245467 (SK.MOVE.ELT 215456 . 215731) (SK.MOVE.ELT.OR.PT 215733 . 216046) (
SK.APPLY.DEFAULT.MOVE 216048 . 216482) (SK.SEL.AND.MOVE 216484 . 217031) (SK.MOVE.ELEMENTS 217033 .
227905) (SKETCH.MOVE.ELEMENTS 227907 . 229838) (SKETCH.COPY.ELEMENTS 229840 . 231887) (
\SKETCH.COPY.ELEMENT 231889 . 232614) (SK.TRANSLATE.ELEMENT 232616 . 233099) (SK.COPY.GLOBAL.ELEMENT
233101 . 233312) (SK.MAKE.ELEMENT.MOVE.ARG 233314 . 233934) (SK.MAKE.ELEMENTS.MOVE.ARG 233936 . 234458
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234460 . 235529) (SK.SHOW.FIG.FROM.INFO 235531 . 235899) (
SK.MOVE.THING 235901 . 236807) (UPDATE.ELEMENT.IN.SKETCH 236809 . 238864) (SK.UPDATE.ELEMENT 238866 .
240425) (SK.UPDATE.ELEMENTS 240427 . 241146) (SK.UPDATE.ELEMENT1 241148 . 245048) (
SK.MOVE.ELEMENT.POINT 245050 . 245465)) (245530 267819 (SK.MOVE.POINTS 245540 . 245827) (
SK.SEL.AND.MOVE.POINTS 245829 . 246134) (SK.DO.MOVE.ELEMENT.POINTS 246136 . 254793) (
SK.MOVE.ITEM.POINTS 254795 . 256466) (SK.TRANSLATEPTSFN 256468 . 256852) (SK.TRANSLATE.POINTS 256854
. 257755) (SK.SELECT.MULTIPLE.POINTS 257757 . 263397) (SK.CONTROL.POINTS.IN.REGION 263399 . 264820) (
SK.ADD.PT.SELECTION 264822 . 265286) (SK.REMOVE.PT.SELECTION 265288 . 265905) (SK.ADD.POINT 265907 .
266530) (SK.ELTS.CONTAINING.PTS 266532 . 267157) (SK.HOTSPOTS.NOT.ON.LIST 267159 . 267817)) (267977
270773 (SK.SET.MOVE.MODE 267987 . 268658) (SK.SET.MOVE.MODE.POINTS 268660 . 268999) (
SK.SET.MOVE.MODE.ELEMENTS 269001 . 269345) (SK.SET.MOVE.MODE.COMBINED 269347 . 269697) (READMOVEMODE
269699 . 270771)) (270774 289529 (SK.ALIGN.POINTS 270784 . 271074) (SK.SEL.AND.ALIGN.POINTS 271076 .
271385) (SK.ALIGN.POINTS.LEFT 271387 . 271690) (SK.ALIGN.POINTS.RIGHT 271692 . 271997) (
SK.ALIGN.POINTS.TOP 271999 . 272300) (SK.ALIGN.POINTS.BOTTOM 272302 . 272609) (
SK.EVEN.SPACE.POINTS.IN.X 272611 . 272931) (SK.EVEN.SPACE.POINTS.IN.Y 272933 . 273253) (
SK.DO.ALIGN.POINTS 273255 . 283877) (SK.NTH.CONTROL.POINT 283879 . 284340) (
SK.GET.SELECTED.ELEMENT.STRUCTURE 284342 . 285008) (SK.CORRESPONDING.CONTROL.PT 285010 . 285564) (
SK.CONTROL.POINT.NUMBER 285566 . 285936) (SK.DO.ALIGN.SETVALUE 285938 . 289527)) (289593 303025 (
SKETCH.CREATE.GROUP 289603 . 290092) (SK.CREATE.GROUP1 290094 . 290641) (SK.UPDATE.GROUP.AFTER.CHANGE
290643 . 291432) (SK.GROUP.ELTS 291434 . 291715) (SK.SEL.AND.GROUP 291717 . 292103) (SK.GROUP.ELEMENTS
292105 . 293754) (SK.UNGROUP.ELT 293756 . 294040) (SK.SEL.AND.UNGROUP 294042 . 295711) (
SK.UNGROUP.ELEMENT 295713 . 296649) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296651 . 297573) (
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297575 . 298586) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298588 .
299928) (SK.UNIONREGIONS 299930 . 302296) (SKETCH.REGION.OF.SKETCH 302298 . 302714) (SK.FLASHREGION
302716 . 303023)) (303026 316497 (INIT.GROUP.ELEMENT 303036 . 303908) (GROUP.DRAWFN 303910 . 304360) (
GROUP.EXPANDFN 304362 . 305925) (GROUP.INSIDEFN 305927 . 306336) (GROUP.REGIONFN 306338 . 306733) (
GROUP.GLOBALREGIONFN 306735 . 307053) (GROUP.TRANSLATEFN 307055 . 309087) (GROUP.TRANSFORMFN 309089 .
312569) (GROUP.READCHANGEFN 312571 . 316495)) (316498 317506 (REGION.CENTER 316508 . 317109) (
REMOVE.LAST 317111 . 317504)) (317559 322666 (SK.MOVE.GROUP.CONTROL.PT 317569 . 317860) (
SK.SEL.AND.MOVE.CONTROL.PT 317862 . 319266) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319268 . 321341) (
SK.READ.NEW.GROUP.CONTROL.PT 321343 . 322664)) (322925 327549 (SK.DO.GROUP 322935 . 324387) (
SK.CHECK.WHENGROUPEDFN 324389 . 325099) (SK.DO.UNGROUP 325101 . 326306) (SK.CHECK.WHENUNGROUPEDFN
326308 . 326895) (SK.GROUP.UNDO 326897 . 327220) (SK.UNGROUP.UNDO 327222 . 327547)) (327790 332712 (
SK.FREEZE.ELTS 327800 . 328084) (SK.SEL.AND.FREEZE 328086 . 328476) (SK.FREEZE.ELEMENTS 328478 .
329029) (SK.UNFREEZE.ELT 329031 . 329320) (SK.SEL.AND.UNFREEZE 329322 . 330858) (SK.UNFREEZE.ELEMENTS
330860 . 331419) (SK.FREEZE.UNDO 331421 . 331666) (SK.UNFREEZE.UNDO 331668 . 331915) (SK.DO.FREEZE
331917 . 332310) (SK.DO.UNFREEZE 332312 . 332710)) (332942 342752 (SKETCH.ELEMENTS.OF.SKETCH 332952 .
333787) (SKETCH.LIST.OF.ELEMENTS 333789 . 334507) (SKETCH.ADD.ELEMENT 334509 . 335584) (
SKETCH.DELETE.ELEMENT 335586 . 337318) (DELFROMGROUPELT 337320 . 338120) (SKETCH.ELEMENT.TYPE 338122
. 338471) (SKETCH.ELEMENT.CHANGED 338473 . 340041) (SK.ELEMENT.CHANGED1 340043 . 340694) (
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340696 . 342750)) (342806 347418 (INSURE.SKETCH 342816 . 345431)
(LOCALSPECS.FROM.VIEWER 345433 . 345793) (SK.LOCAL.ELT.FROM.GLOBALPART 345795 . 346263) (
SKETCH.FROM.VIEWER 346265 . 346499) (INSPECT.SKETCH 346501 . 346826) (ELT.INSIDE.SKETCHWP 346828 .
347101) (SK.INSIDE.REGION 347103 . 347416)) (347419 351749 (MAPSKETCHSPECS 347429 . 348050) (
MAPCOLLECTSKETCHSPECS 348052 . 348801) (MAPSKETCHSPECSUNTIL 348803 . 349611) (MAPGLOBALSKETCHSPECS
349613 . 350314) (MAPGLOBALSKETCHELEMENTS 350316 . 351747)) (351811 377703 (SK.ADD.SELECTION 351821 .
352561) (SK.COPY.INSERTFN 352563 . 356194) (SCREENELEMENTP 356196 . 356669) (SK.ITEM.REGION 356671 .
357158) (SK.ELEMENT.GLOBAL.REGION 357160 . 357688) (SK.LOCAL.ITEMS.IN.REGION 357690 . 359669) (
SK.REGIONFN 359671 . 359993) (SK.GLOBAL.REGIONFN 359995 . 360353) (SK.REMOVE.SELECTION 360355 . 361083
) (SK.SELECT.MULTIPLE.ITEMS 361085 . 371527) (SKETCH.GET.ELEMENTS 371529 . 372952) (SK.PUT.MARKS.UP
372954 . 373293) (SK.TAKE.MARKS.DOWN 373295 . 373634) (SK.TRANSLATE.GLOBALPART 373636 . 375763) (
SK.TRANSLATE.ITEM 375765 . 376692) (SK.TRANSLATEFN 376694 . 376890) (TRANSLATE.SKETCH 376892 . 377701)
) (377969 380876 (SK.INPUT.SCALE 377979 . 378826) (SK.UPDATE.SKETCHCONTEXT 378828 . 379425) (
SK.SET.INPUT.SCALE 379427 . 380076) (SK.SET.INPUT.SCALE.CURRENT 380078 . 380369) (
SK.SET.INPUT.SCALE.VALUE 380371 . 380874)) (380927 382839 (SK.SET.FEEDBACK.MODE 380937 . 382243) (
SK.SET.FEEDBACK.POINT 382245 . 382413) (SK.SET.FEEDBACK.VERBOSE 382415 . 382584) (
SK.SET.FEEDBACK.ALWAYS 382586 . 382837)) (382990 384267 (SKETCH.TITLE 383000 . 383263) (
SK.SHRINK.ICONCREATE 383265 . 384265)) (389957 392771 (READBRUSHSHAPE 389967 . 390426) (READ.FUNCTION
390428 . 390943) (READBRUSHSIZE 390945 . 391403) (READANGLE 391405 . 391897) (READARCDIRECTION 391899
. 392769)) (392772 403183 (SK.CHANGE.DASHING 392782 . 396730) (READ.AND.SAVE.NEW.DASHING 396732 .
398500) (READ.NEW.DASHING 398502 . 400242) (READ.DASHING.CHANGE 400244 . 401719) (SK.CACHE.DASHING
401721 . 402723) (SK.DASHING.LABEL 402725 . 403181)) (403184 406889 (READ.FILLING.CHANGE 403194 .
405175) (SK.CACHE.FILLING 405177 . 405895) (READ.AND.SAVE.NEW.FILLING 405897 . 406495) (
SK.FILLING.LABEL 406497 . 406887)) (407273 443526 (SK.GETGLOBALPOSITION 407283 . 407588) (
SKETCH.TRACK.ELEMENTS 407590 . 411110) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411112 . 411671) (
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411673 . 412065) (MAP.GLOBAL.POSITION.INTO.VIEWER 412067 . 412447) (
SKETCH.TO.VIEWER.POSITION 412449 . 412808) (SKETCH.TRACK.IMAGE 412810 . 413664) (SK.TRACK.IMAGE1
413666 . 415078) (MAP.VIEWER.XY.INTO.GLOBAL 415080 . 416074) (SK.SET.POSITION 416076 . 416412) (
MAP.VIEWER.PT.INTO.GLOBAL 416414 . 417520) (VIEWER.TO.SKETCH.POSITION 417522 . 418157) (
SK.INSURE.SCALE 418159 . 418419) (SKETCH.TO.VIEWER.REGION 418421 . 419227) (VIEWER.TO.SKETCH.REGION
419229 . 419567) (SK.READ.POINT.WITH.FEEDBACK 419569 . 430572) (SKETCH.GET.POSITION 430574 . 432454) (
\CLOBBER.POSITION 432456 . 432904) (NEAREST.HOT.SPOT 432906 . 434434) (GETWREGION 434436 . 435197) (
GET.BITMAP.POSITION 435199 . 435983) (SK.TRACK.BITMAP1 435985 . 443524)) (444095 474981 (
SK.BRING.UP.POSITION.PAD 444105 . 449965) (SK.PAD.READER.POSITION 449967 . 451616) (
SK.POSITION.READER.REPAINTFN 451618 . 453402) (SK.POSITION.PAD.FROM.VIEWER 453404 . 454746) (
SK.INIT.POSITION.NUMBER.PAD.MENU 454748 . 455098) (SK.READ.POSITION.PAD.HANDLER 455100 . 460832) (
DISPLAY.POSITION.READER.TOTAL 460834 . 463132) (POSITION.PAD.READER.HANDLER 463134 . 471177) (
POSITIONPAD.HELDFN 471179 . 472663) (\POSITION.PAD.ADD.DIGIT.MENU 472665 . 474244) (
\POSITION.READER.NUMBERPAD 474246 . 474979)) (476607 479285 (SK.DRAWFN 476617 . 476983) (
SK.TRANSFORMFN 476985 . 477366) (SK.EXPANDFN 477368 . 477645) (SK.INPUT 477647 . 478028) (SK.INSIDEFN
478030 . 478670) (SK.UPDATEFN 478672 . 479283)) (484857 488802 (SK.CHECK.SKETCH.VERSION 484867 .
486107) (SK.INSURE.RECORD.LENGTH 486109 . 487592) (SK.INSURE.HAS.LENGTH 487594 . 488332) (
SK.RECORD.LENGTH 488334 . 488508) (SK.SET.RECORD.LENGTHS 488510 . 488800)) (489543 490430 (
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489553 . 490428)))))
(FILEMAP (NIL (22128 85491 (SKETCH 22138 . 24243) (SKETCH.FROM.A.FILE 24245 . 24560) (SKETCHW.CREATE
24562 . 29136) (SKETCH.RESET 29138 . 30660) (SKETCHW.FIG.CHANGED 30662 . 31002) (SK.WINDOW.TITLE 31004
. 31391) (EDITSLIDE 31393 . 31799) (EDITSKETCH 31801 . 32125) (SK.PUT.ON.FILE 32127 . 33579) (
SK.OUTPUT.FILE.NAME 33581 . 33955) (SKETCH.PUT 33957 . 36855) (SK.GET.FROM.FILE 36857 . 37750) (
SK.INCLUDE.FILE 37752 . 40260) (SK.GET.IMAGEOBJ.FROM.FILE 40262 . 42465) (SKETCH.GET 42467 . 42774) (
ADD.SKETCH.TO.VIEWER 42776 . 45362) (FILENAMELESSVERSION 45364 . 45640) (SK.ADD.ELEMENTS.TO.SKETCH
45642 . 46156) (SKETCH.SET.A.DEFAULT 46158 . 53316) (SK.POPUP.SELECTIONFN 53318 . 53860) (
GETSKETCHWREGION 53862 . 54068) (SK.ADD.ELEMENT 54070 . 55649) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
55651 . 57045) (SK.ELTS.BY.PRIORITY 57047 . 57343) (SK.ORDER.ELEMENTS 57345 . 57612) (
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57614 . 59108) (SK.ADD.ELEMENTS 59110 . 59634) (
SK.CHECK.WHENADDEDFN 59636 . 60366) (SK.APPLY.MENU.COMMAND 60368 . 61166) (SK.DELETE.ELEMENT1 61168 .
62746) (SK.MARK.DIRTY 62748 . 63414) (SK.MARK.UNDIRTY 63416 . 63747) (SK.MENU.AND.RETURN.FIELD 63749
. 64414) (SKETCH.SET.BRUSH.SHAPE 64416 . 65001) (SKETCH.SET.BRUSH.SIZE 65003 . 65509) (
SKETCHW.CLOSEFN 65511 . 67302) (SK.CONFIRM.DESTRUCTION 67304 . 68303) (SKETCHW.OUTFN 68305 . 68569) (
SKETCHW.REOPENFN 68571 . 68983) (MAKE.LOCAL.SKETCH 68985 . 69715) (MAP.SKETCHSPEC.INTO.VIEWER 69717 .
70927) (SKETCHW.REPAINTFN 70929 . 71757) (SKETCHW.REPAINTFN1 71759 . 72698) (SK.DRAWFIGURE.IF 72700 .
73222) (SKETCHW.SCROLLFN 73224 . 77417) (SKETCHW.RESHAPEFN 77419 . 79677) (SK.UPDATE.EVENT.SELECTION
79679 . 81734) (LIGHTGRAYWINDOW 81736 . 81899) (SK.ADD.SPACES 81901 . 82647) (SK.SKETCH.MENU 82649 .
82971) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 82973 . 83825) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83827 . 84787)
(SK.RETURN.TTY 84789 . 85157) (SK.TAKE.TTY 85159 . 85489)) (85545 108873 (SKETCH.COMMANDMENU 85555 .
85892) (SKETCH.COMMANDMENU.ITEMS 85894 . 105977) (CREATE.SKETCHW.COMMANDMENU 105979 . 106399) (
SKETCHW.SELECTIONFN 106401 . 107504) (SKETCH.MONITORLOCK 107506 . 107977) (SK.EVAL.AS.PROCESS 107979
. 108592) (SK.EVAL.WITH.LOCK 108594 . 108871)) (108874 116678 (SK.FIX.MENU 108884 . 109978) (
SK.SET.UP.MENUS 109980 . 112281) (SK.INSURE.HAS.MENU 112283 . 112945) (SK.CREATE.STANDARD.MENU 112947
. 113392) (SK.ADD.ITEM.TO.MENU 113394 . 114069) (SK.GET.VIEWER.POPUP.MENU 114071 . 116272) (
SK.CLEAR.POPUP.MENU 116274 . 116676)) (116734 125556 (SKETCH.CREATE 116744 . 117530) (GETSKETCHPROP
117532 . 120589) (PUTSKETCHPROP 120591 . 124523) (CREATE.DEFAULT.SKETCH.CONTEXT 124525 . 125554)) (
125722 148618 (SK.COPY.BUTTONEVENTFN 125732 . 136960) (SK.BUTTONEVENT.MARK 136962 . 137345) (
SK.BUILD.IMAGEOBJ 137347 . 147262) (SK.BUTTONEVENT.OVERP 147264 . 147887) (SK.BUTTONEVENT.SAME.KEYS
147889 . 148616)) (148897 174712 (SK.SEL.AND.CHANGE 148907 . 149199) (SK.CHECK.WHENCHANGEDFN 149201 .
149907) (SK.CHECK.PRECHANGEFN 149909 . 150510) (SK.CHANGE.ELT 150512 . 150704) (SK.CHANGE.THING 150706
. 151957) (SKETCH.CHANGE.ELEMENTS 151959 . 153142) (SK.APPLY.SINGLE.CHANGEFN 153144 . 153717) (
SK.DO.CHANGESPECS 153719 . 155378) (SK.VIEWER.FROM.SKETCH.ARG 155380 . 155822) (SK.DO.CHANGESPEC1
155824 . 157699) (SK.CHANGEFN 157701 . 158281) (SK.READCHANGEFN 158283 . 158742) (SK.DEFAULT.CHANGEFN
158744 . 161216) (CHANGEABLEFIELDITEMS 161218 . 161865) (SK.APPLY.CHANGE.COMMAND 161867 . 162484) (
SK.DO.AND.RECORD.CHANGES 162486 . 163883) (SK.APPLY.CHANGE.COMMAND1 163885 . 165373) (
SK.ELEMENTS.CHANGEFN 165375 . 167699) (READ.POINT.TO.ADD 167701 . 168645) (GLOBAL.KNOT.FROM.LOCAL
168647 . 169107) (SK.ADD.KNOT.TO.ELEMENT 169109 . 170053) (SK.GROUP.CHANGEFN 170055 . 171267) (
SK.GROUP.CHANGEFN1 171269 . 174710)) (174879 188612 (ADD.ELEMENT.TO.SKETCH 174889 . 176595) (
ADD.SKETCH.VIEWER 176597 . 177265) (REMOVE.SKETCH.VIEWER 177267 . 177880) (ALL.SKETCH.VIEWERS 177882
. 178122) (SKETCH.ALL.VIEWERS 178124 . 178384) (VIEWER.BUCKET 178386 . 178537) (ELT.INSIDE.REGION?
178539 . 178866) (ELT.INSIDE.SKWP 178868 . 179159) (SCALE.FROM.SKW 179161 . 179411) (
SK.ADDELT.TO.WINDOW 179413 . 180273) (SK.CALC.REGION.VIEWED 180275 . 180653) (SK.DRAWFIGURE 180655 .
181944) (SK.DRAWFIGURE1 181946 . 182330) (SK.LOCAL.FROM.GLOBAL 182332 . 183567) (SKETCH.REGION.VIEWED
183569 . 186256) (SKETCH.VIEW.FROM.NAME 186258 . 186688) (SK.UPDATE.REGION.VIEWED 186690 . 187082) (
SKETCH.ADD.AND.DISPLAY 187084 . 187492) (SKETCH.ADD.AND.DISPLAY1 187494 . 187932) (SK.ADD.ITEM 187934
. 188266) (SKETCHW.ADD.INSTANCE 188268 . 188610)) (188653 201841 (SK.SEL.AND.DELETE 188663 . 189051)
(SK.ERASE.AND.DELETE.ITEM 189053 . 189472) (REMOVE.ELEMENT.FROM.SKETCH 189474 . 190585) (
SK.DELETE.ELEMENT 190587 . 191145) (SK.DELETE.ELEMENT2 191147 . 191808) (SK.DELETE.KNOT 191810 .
192101) (SK.SEL.AND.DELETE.KNOT 192103 . 193228) (SK.DELETE.ELEMENT.KNOT 193230 . 196437) (
SK.CHECK.WHENDELETEDFN 196439 . 197219) (SK.CHECK.PREEDITFN 197221 . 197705) (
SK.CHECK.END.INITIAL.EDIT 197707 . 198241) (SK.CHECK.WHENPOINTDELETEDFN 198243 . 199039) (SK.ERASE.ELT
199041 . 199377) (SK.DELETE.ELT 199379 . 199754) (SK.DELETE.ITEM 199756 . 200164) (DELFROMTCONC
200166 . 201839)) (201880 215714 (SK.COPY.ELT 201890 . 202260) (SK.SEL.AND.COPY 202262 . 202645) (
SK.COPY.ELEMENTS 202647 . 208275) (SK.ADD.COPY.OF.ELEMENTS 208277 . 210044) (
SK.GLOBAL.FROM.LOCAL.ELEMENTS 210046 . 210286) (SK.COPY.ITEM 210288 . 211085) (SK.INSERT.SKETCH 211087
. 215712)) (215754 245775 (SK.MOVE.ELT 215764 . 216039) (SK.MOVE.ELT.OR.PT 216041 . 216354) (
SK.APPLY.DEFAULT.MOVE 216356 . 216790) (SK.SEL.AND.MOVE 216792 . 217339) (SK.MOVE.ELEMENTS 217341 .
228213) (SKETCH.MOVE.ELEMENTS 228215 . 230146) (SKETCH.COPY.ELEMENTS 230148 . 232195) (
\SKETCH.COPY.ELEMENT 232197 . 232922) (SK.TRANSLATE.ELEMENT 232924 . 233407) (SK.COPY.GLOBAL.ELEMENT
233409 . 233620) (SK.MAKE.ELEMENT.MOVE.ARG 233622 . 234242) (SK.MAKE.ELEMENTS.MOVE.ARG 234244 . 234766
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234768 . 235837) (SK.SHOW.FIG.FROM.INFO 235839 . 236207) (
SK.MOVE.THING 236209 . 237115) (UPDATE.ELEMENT.IN.SKETCH 237117 . 239172) (SK.UPDATE.ELEMENT 239174 .
240733) (SK.UPDATE.ELEMENTS 240735 . 241454) (SK.UPDATE.ELEMENT1 241456 . 245356) (
SK.MOVE.ELEMENT.POINT 245358 . 245773)) (245838 268127 (SK.MOVE.POINTS 245848 . 246135) (
SK.SEL.AND.MOVE.POINTS 246137 . 246442) (SK.DO.MOVE.ELEMENT.POINTS 246444 . 255101) (
SK.MOVE.ITEM.POINTS 255103 . 256774) (SK.TRANSLATEPTSFN 256776 . 257160) (SK.TRANSLATE.POINTS 257162
. 258063) (SK.SELECT.MULTIPLE.POINTS 258065 . 263705) (SK.CONTROL.POINTS.IN.REGION 263707 . 265128) (
SK.ADD.PT.SELECTION 265130 . 265594) (SK.REMOVE.PT.SELECTION 265596 . 266213) (SK.ADD.POINT 266215 .
266838) (SK.ELTS.CONTAINING.PTS 266840 . 267465) (SK.HOTSPOTS.NOT.ON.LIST 267467 . 268125)) (268285
271081 (SK.SET.MOVE.MODE 268295 . 268966) (SK.SET.MOVE.MODE.POINTS 268968 . 269307) (
SK.SET.MOVE.MODE.ELEMENTS 269309 . 269653) (SK.SET.MOVE.MODE.COMBINED 269655 . 270005) (READMOVEMODE
270007 . 271079)) (271082 289837 (SK.ALIGN.POINTS 271092 . 271382) (SK.SEL.AND.ALIGN.POINTS 271384 .
271693) (SK.ALIGN.POINTS.LEFT 271695 . 271998) (SK.ALIGN.POINTS.RIGHT 272000 . 272305) (
SK.ALIGN.POINTS.TOP 272307 . 272608) (SK.ALIGN.POINTS.BOTTOM 272610 . 272917) (
SK.EVEN.SPACE.POINTS.IN.X 272919 . 273239) (SK.EVEN.SPACE.POINTS.IN.Y 273241 . 273561) (
SK.DO.ALIGN.POINTS 273563 . 284185) (SK.NTH.CONTROL.POINT 284187 . 284648) (
SK.GET.SELECTED.ELEMENT.STRUCTURE 284650 . 285316) (SK.CORRESPONDING.CONTROL.PT 285318 . 285872) (
SK.CONTROL.POINT.NUMBER 285874 . 286244) (SK.DO.ALIGN.SETVALUE 286246 . 289835)) (289901 303333 (
SKETCH.CREATE.GROUP 289911 . 290400) (SK.CREATE.GROUP1 290402 . 290949) (SK.UPDATE.GROUP.AFTER.CHANGE
290951 . 291740) (SK.GROUP.ELTS 291742 . 292023) (SK.SEL.AND.GROUP 292025 . 292411) (SK.GROUP.ELEMENTS
292413 . 294062) (SK.UNGROUP.ELT 294064 . 294348) (SK.SEL.AND.UNGROUP 294350 . 296019) (
SK.UNGROUP.ELEMENT 296021 . 296957) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296959 . 297881) (
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297883 . 298894) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298896 .
300236) (SK.UNIONREGIONS 300238 . 302604) (SKETCH.REGION.OF.SKETCH 302606 . 303022) (SK.FLASHREGION
303024 . 303331)) (303334 316805 (INIT.GROUP.ELEMENT 303344 . 304216) (GROUP.DRAWFN 304218 . 304668) (
GROUP.EXPANDFN 304670 . 306233) (GROUP.INSIDEFN 306235 . 306644) (GROUP.REGIONFN 306646 . 307041) (
GROUP.GLOBALREGIONFN 307043 . 307361) (GROUP.TRANSLATEFN 307363 . 309395) (GROUP.TRANSFORMFN 309397 .
312877) (GROUP.READCHANGEFN 312879 . 316803)) (316806 317814 (REGION.CENTER 316816 . 317417) (
REMOVE.LAST 317419 . 317812)) (317867 322974 (SK.MOVE.GROUP.CONTROL.PT 317877 . 318168) (
SK.SEL.AND.MOVE.CONTROL.PT 318170 . 319574) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319576 . 321649) (
SK.READ.NEW.GROUP.CONTROL.PT 321651 . 322972)) (323233 327857 (SK.DO.GROUP 323243 . 324695) (
SK.CHECK.WHENGROUPEDFN 324697 . 325407) (SK.DO.UNGROUP 325409 . 326614) (SK.CHECK.WHENUNGROUPEDFN
326616 . 327203) (SK.GROUP.UNDO 327205 . 327528) (SK.UNGROUP.UNDO 327530 . 327855)) (328098 333020 (
SK.FREEZE.ELTS 328108 . 328392) (SK.SEL.AND.FREEZE 328394 . 328784) (SK.FREEZE.ELEMENTS 328786 .
329337) (SK.UNFREEZE.ELT 329339 . 329628) (SK.SEL.AND.UNFREEZE 329630 . 331166) (SK.UNFREEZE.ELEMENTS
331168 . 331727) (SK.FREEZE.UNDO 331729 . 331974) (SK.UNFREEZE.UNDO 331976 . 332223) (SK.DO.FREEZE
332225 . 332618) (SK.DO.UNFREEZE 332620 . 333018)) (333250 343060 (SKETCH.ELEMENTS.OF.SKETCH 333260 .
334095) (SKETCH.LIST.OF.ELEMENTS 334097 . 334815) (SKETCH.ADD.ELEMENT 334817 . 335892) (
SKETCH.DELETE.ELEMENT 335894 . 337626) (DELFROMGROUPELT 337628 . 338428) (SKETCH.ELEMENT.TYPE 338430
. 338779) (SKETCH.ELEMENT.CHANGED 338781 . 340349) (SK.ELEMENT.CHANGED1 340351 . 341002) (
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 341004 . 343058)) (343114 347726 (INSURE.SKETCH 343124 . 345739)
(LOCALSPECS.FROM.VIEWER 345741 . 346101) (SK.LOCAL.ELT.FROM.GLOBALPART 346103 . 346571) (
SKETCH.FROM.VIEWER 346573 . 346807) (INSPECT.SKETCH 346809 . 347134) (ELT.INSIDE.SKETCHWP 347136 .
347409) (SK.INSIDE.REGION 347411 . 347724)) (347727 352057 (MAPSKETCHSPECS 347737 . 348358) (
MAPCOLLECTSKETCHSPECS 348360 . 349109) (MAPSKETCHSPECSUNTIL 349111 . 349919) (MAPGLOBALSKETCHSPECS
349921 . 350622) (MAPGLOBALSKETCHELEMENTS 350624 . 352055)) (352119 378011 (SK.ADD.SELECTION 352129 .
352869) (SK.COPY.INSERTFN 352871 . 356502) (SCREENELEMENTP 356504 . 356977) (SK.ITEM.REGION 356979 .
357466) (SK.ELEMENT.GLOBAL.REGION 357468 . 357996) (SK.LOCAL.ITEMS.IN.REGION 357998 . 359977) (
SK.REGIONFN 359979 . 360301) (SK.GLOBAL.REGIONFN 360303 . 360661) (SK.REMOVE.SELECTION 360663 . 361391
) (SK.SELECT.MULTIPLE.ITEMS 361393 . 371835) (SKETCH.GET.ELEMENTS 371837 . 373260) (SK.PUT.MARKS.UP
373262 . 373601) (SK.TAKE.MARKS.DOWN 373603 . 373942) (SK.TRANSLATE.GLOBALPART 373944 . 376071) (
SK.TRANSLATE.ITEM 376073 . 377000) (SK.TRANSLATEFN 377002 . 377198) (TRANSLATE.SKETCH 377200 . 378009)
) (378277 381184 (SK.INPUT.SCALE 378287 . 379134) (SK.UPDATE.SKETCHCONTEXT 379136 . 379733) (
SK.SET.INPUT.SCALE 379735 . 380384) (SK.SET.INPUT.SCALE.CURRENT 380386 . 380677) (
SK.SET.INPUT.SCALE.VALUE 380679 . 381182)) (381235 383147 (SK.SET.FEEDBACK.MODE 381245 . 382551) (
SK.SET.FEEDBACK.POINT 382553 . 382721) (SK.SET.FEEDBACK.VERBOSE 382723 . 382892) (
SK.SET.FEEDBACK.ALWAYS 382894 . 383145)) (383298 384575 (SKETCH.TITLE 383308 . 383571) (
SK.SHRINK.ICONCREATE 383573 . 384573)) (390265 393079 (READBRUSHSHAPE 390275 . 390734) (READ.FUNCTION
390736 . 391251) (READBRUSHSIZE 391253 . 391711) (READANGLE 391713 . 392205) (READARCDIRECTION 392207
. 393077)) (393080 403491 (SK.CHANGE.DASHING 393090 . 397038) (READ.AND.SAVE.NEW.DASHING 397040 .
398808) (READ.NEW.DASHING 398810 . 400550) (READ.DASHING.CHANGE 400552 . 402027) (SK.CACHE.DASHING
402029 . 403031) (SK.DASHING.LABEL 403033 . 403489)) (403492 407197 (READ.FILLING.CHANGE 403502 .
405483) (SK.CACHE.FILLING 405485 . 406203) (READ.AND.SAVE.NEW.FILLING 406205 . 406803) (
SK.FILLING.LABEL 406805 . 407195)) (407581 443834 (SK.GETGLOBALPOSITION 407591 . 407896) (
SKETCH.TRACK.ELEMENTS 407898 . 411418) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411420 . 411979) (
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411981 . 412373) (MAP.GLOBAL.POSITION.INTO.VIEWER 412375 . 412755) (
SKETCH.TO.VIEWER.POSITION 412757 . 413116) (SKETCH.TRACK.IMAGE 413118 . 413972) (SK.TRACK.IMAGE1
413974 . 415386) (MAP.VIEWER.XY.INTO.GLOBAL 415388 . 416382) (SK.SET.POSITION 416384 . 416720) (
MAP.VIEWER.PT.INTO.GLOBAL 416722 . 417828) (VIEWER.TO.SKETCH.POSITION 417830 . 418465) (
SK.INSURE.SCALE 418467 . 418727) (SKETCH.TO.VIEWER.REGION 418729 . 419535) (VIEWER.TO.SKETCH.REGION
419537 . 419875) (SK.READ.POINT.WITH.FEEDBACK 419877 . 430880) (SKETCH.GET.POSITION 430882 . 432762) (
\CLOBBER.POSITION 432764 . 433212) (NEAREST.HOT.SPOT 433214 . 434742) (GETWREGION 434744 . 435505) (
GET.BITMAP.POSITION 435507 . 436291) (SK.TRACK.BITMAP1 436293 . 443832)) (444403 475289 (
SK.BRING.UP.POSITION.PAD 444413 . 450273) (SK.PAD.READER.POSITION 450275 . 451924) (
SK.POSITION.READER.REPAINTFN 451926 . 453710) (SK.POSITION.PAD.FROM.VIEWER 453712 . 455054) (
SK.INIT.POSITION.NUMBER.PAD.MENU 455056 . 455406) (SK.READ.POSITION.PAD.HANDLER 455408 . 461140) (
DISPLAY.POSITION.READER.TOTAL 461142 . 463440) (POSITION.PAD.READER.HANDLER 463442 . 471485) (
POSITIONPAD.HELDFN 471487 . 472971) (\POSITION.PAD.ADD.DIGIT.MENU 472973 . 474552) (
\POSITION.READER.NUMBERPAD 474554 . 475287)) (476915 479593 (SK.DRAWFN 476925 . 477291) (
SK.TRANSFORMFN 477293 . 477674) (SK.EXPANDFN 477676 . 477953) (SK.INPUT 477955 . 478336) (SK.INSIDEFN
478338 . 478978) (SK.UPDATEFN 478980 . 479591)) (485165 489110 (SK.CHECK.SKETCH.VERSION 485175 .
486415) (SK.INSURE.RECORD.LENGTH 486417 . 487900) (SK.INSURE.HAS.LENGTH 487902 . 488640) (
SK.RECORD.LENGTH 488642 . 488816) (SK.SET.RECORD.LENGTHS 488818 . 489108)) (489851 490738 (
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489861 . 490736)))))
STOP

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