1
0
mirror of synced 2026-03-15 14:47:09 +00:00

Compare commits

..

52 Commits

Author SHA1 Message Date
Bill Stumbo
b67cf5ae09 Update build (#538)
* Build loadup (#1)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Build loadup (#2)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Build loadup (#3)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Cleanup

* Build loadup (#4)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Cleanup

* Build loadup (#5)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Cleanup

* Move sysouts to correct location

* Set root directory to medley
2021-10-22 22:11:08 -07:00
Larry Masinter
d1fe834e6f Move material from 'release-notes' to README (#526)
* Move material from 'release-notes' to README

* Remove extra junk files from Lispusers DATE and PLAINTEXTSTREAM

* Update README instructions per feedback; add a BUILDING readme
2021-10-21 23:19:37 -07:00
rmkaplan
c3b5e23cd9 Eliminate implicit calls to \FILEOUTCHARFN (#529)
* Eliminate implicit calls to \FILEOUTCHARFN

Also, update DATE to modern readtable (don't know what it does), add LLETHER to EXPORTFILES in FILESETS (may also need the file that exports pup records).

* Further fixups for EXPORTFILES

also fixing/compiling PLAINTEXTSTREAM

* Remove garbage files DATE and PLAINTEXTSTREAM from checkin

Co-authored-by: Larry Masinter <LMM@acm.org>
2021-10-21 16:25:16 -07:00
Larry Masinter
9b4976e33f merging PRINTFN 2021-10-21 12:51:16 -07:00
rmkaplan
31d9473184 Better control of modern windows (#527)
* MODERNIZE, FILEBROWSER: Better control of modern windows

Also fixed Y2K bug in FILEBROWSER, updated COMPAREDIRECTORIES and WHEELSCROLL documentation.  MODERNWINDOWS allows separate specification of the hot-corner region and the top margin for siphoning off left-button clicks

* MODERNIZE.LCOM: didn't get included
2021-10-21 10:02:43 -07:00
Bill Stumbo
bf5689be2a Build loadup (#534)
* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Build loadup (#1)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Build loadup (#2)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Cleanup

* Build loadup (#3)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Cleanup

* Move sysouts to correct location

* Build loadup (#4)

* Add new GitHub action to create medley release

* Update to manual trigger with release name as input

* Cleanup

* Cleanup
2021-10-21 10:00:28 -07:00
rmkaplan
08bdd34e69 Tedit readonly files, cleanup filesets printfn (#532)
* FILESETS, TEDITWINDOW, TEDIT-PF-SEE

Add DTDECLARE to EXPORTFILES, fix TEDIT so that READONLY windows and processes are collected

* PRINTFN:  Eliminate PMORE
2021-10-21 09:56:36 -07:00
Larry Masinter
c7a219fd22 Use COPYCHARS instead of COPYBYTES when HPRINT is copying from NODIRCORE buffer (#506)
* Use COPYCHARS instead of COPYBYTES when HPRINT is copying from NODIRCORE buffer

* Change HPRINT of non-random-access files to use FORMAT of ultimate destination
2021-10-21 09:50:15 -07:00
rmkaplan
13cfb9b835 FILEPKG: MAKEFILE now takes format identifer (e.g. :UTF-8) in its options list (#524) 2021-10-15 11:28:51 -07:00
rmkaplan
b3219c33da Merge pull request #521 from Interlisp/Improve-TEDIT-interaction-with-MODERNIZE
Improve tedit interaction with modernize
2021-10-14 15:58:30 -07:00
rmkaplan
b0f9f2cce8 Merge pull request #523 from Interlisp/Lispusers-packages-modernize,-thinfiles,-tedit=pf=see
Lispusers packages modernize, thinfiles, tedit=pf=see
2021-10-14 15:57:32 -07:00
rmkaplan
1ad92b3dd4 TEDIT: TEDIT_SEE sets initial DEFAULTFONT for Lisp source files 2021-10-13 10:20:12 -07:00
rmkaplan
588835603c lispusers/TEDIT-PF-SEE: Explicitly give up TTY process on close
I'm not sure  why the READONLY TEDIT-SEE windows get the TTY process, that may be the underlying problem.  But at least here I now make sure that the if the window is the tty process on closing, it gives it back to the exec.  Otherwise, the window pops back up if there is input (even wheel scroll interrupts) before the user clicks somewhere else
2021-10-12 22:35:58 -07:00
rmkaplan
df70662f2c INSPECT: INSPECTCODE starts with DEFAULTFONT (presumably fixed pitch) 2021-10-12 17:22:43 -07:00
rmkaplan
32461da7eb Lispusers packages: MODERNIZE, THINFILES TEDIT-PF-SEE (new)
MODERNIZE interacts better with TEDIT split windows, THINFILES works better on filenames, not just extensions.  TEDIT-PF is new: provides commands tpf and ts for doing PFCOPYBYTES or SEE to scrollable read-only TEDIT windows, also functions for remembering and reusing the regions of windows of particular types.
2021-10-12 17:22:21 -07:00
rmkaplan
1beba945a2 PRINTFN DEXEC CMLEXEC: Cleanup PFCOPYBYTES interface
Removed unused FLG argument in PFCOPYBYTES, tried to make sense of PFDEFAULT (in preparation for TEDIT-PF. CMLEXEC just to upgrade the filemap
2021-10-12 17:20:18 -07:00
rmkaplan
e6cf869a23 Update HARDCOPY.LCOM
Forgot to include in TEDIT commit
2021-10-12 17:17:19 -07:00
rmkaplan
a6efdb3558 TEDIT fixes for format and window-splitting
Introduced an external format (:TEDIT) for Tedit, initialized TEXTOFD to use it.  Parmeterized the window split-window region to stop confusions with modernwindows.  TEDIT-SEE starts out the defaultfont for non-Tedit-format files. Restored git-lost edits to COPY.TEXT.TO.IMAGE
2021-10-12 17:16:44 -07:00
rmkaplan
e222743f74 Update lsee for UTF-8 (#518)
* Update lsee for UTF-8

Change less -R to less -r

* Minor cleanup for typo at end of script.

Co-authored-by: Nick Briggs <nicholas.h.briggs@gmail.com>
2021-10-08 23:25:31 -07:00
rmkaplan
ea0f303988 Merge pull request #505 from Interlisp/Externalformat-collected-in-a-separate-file
Externalformat collected in a separate file
2021-10-07 07:41:01 -07:00
rmkaplan
b85084ce31 LLREAD and LLREAD.LCOM: restore unversioned files 2021-10-05 19:46:07 -07:00
Larry Masinter
e39943fdcc Merge pull request #509 from Interlisp/run-medley-noscroll
Add -noscroll option to run-medley; turns off scollbars
2021-10-04 16:27:03 -07:00
Larry Masinter
a4370ae57d Put -noscroll first in usage at head 2021-10-04 15:03:49 -07:00
rmkaplan
cbfdfd6dab Merge branch 'master' into Externalformat-collected-in-a-separate-file 2021-10-01 23:13:12 -07:00
Larry Masinter
84bf09394e Merge pull request #513 from Interlisp/LAFITE-CR-to-LF
Lafite cr to lf
2021-10-01 18:57:53 -07:00
Nick Briggs
a92bce555f Fix long-standing error wherein VTCHAT.STATUS attempts to BOUT a string (#510)
In replying to a request for the cursor position, the VTCHAT.STATUS
code attempted to construct the escape-sequence response passing a
string representing the X (and Y) coordinate as text to BOUT rather
than using PRIN1.
2021-10-01 15:57:00 -07:00
Nick Briggs
ae26c3c9fa Replace chat via "rlogin" with chat via "ssh" (#512)
Modern systems are unlikely to be configured with "rlogin" access,
remote login, if available, is likely to be via "ssh", so use that.
2021-10-01 15:55:46 -07:00
rmkaplan
09fec6ac56 Add FILESETS back
For some reason, in going back and forth, the hard link between the versioned and the unversioned got lost, and the unversioned was effectively deleted.  I did a copyfile to get things back in order
2021-10-01 12:22:02 -07:00
rmkaplan
625a5a839c Convert UNICODE to LF
Don't know why it reverted.  Just a MAKEFILE NEW and recompile
2021-10-01 09:03:00 -07:00
rmkaplan
f28a7a6278 Move UNIXMAIL.* and MAILSCAVENGE.TEDIT to library/lafite 2021-10-01 08:20:38 -07:00
rmkaplan
9f85f4e17e Convert LAFITE files to LF
They missed the previous global conversion since they were in a subdirectory.  The only actual change is in LAFITETEDIT, it had the wrong name for the TEDITDCL file
2021-09-30 23:16:45 -07:00
Larry Masinter
1380722e55 Add -noscroll option to run-medley; turns off scollbars 2021-09-30 17:22:19 -07:00
rmkaplan
d6173b5269 Revert "HARDCOPY: COPY.TEXT.TO.IMAGE had Unicode-incompatible end-of-file shortcut"
This reverts commit 65a2d8000e.
2021-09-30 13:39:10 -07:00
rmkaplan
1d8fa0301d TEDIT: TEDIT-SEE treats FORMAT better for plain-text files 2021-09-29 22:27:18 -07:00
rmkaplan
65a2d8000e HARDCOPY: COPY.TEXT.TO.IMAGE had Unicode-incompatible end-of-file shortcut
Also used byte and not character-code operation in CRLF check
2021-09-29 22:26:11 -07:00
rmkaplan
388d54b713 TEDITSCREEN: Cleanup \DISPLAYLINE
Test argument validity at top so ffetch can be used consistently.  Remove unused variables, and move some other variable bindings to their proper scope
2021-09-29 22:23:45 -07:00
rmkaplan
f58936e762 PRINTFN: Fix typo, add comments 2021-09-29 10:11:31 -07:00
Larry Masinter
63904f754c two variables COPYRIGHTFLG and *REPLACE-OLD-EDIT-DATES* set for Lispcore developers (#504)
* two variables COPYRIGHTFLG and *REPLACE-OLD-EDIT-DATES* set for Lispcore developers

* COPYRIGHTFLG = PRESERVE
2021-09-28 10:21:57 -07:00
rmkaplan
2dabe594f3 Merge branch 'master' into Externalformat-collected-in-a-separate-file 2021-09-27 14:19:55 -07:00
rmkaplan
0462c1aa5e TEDITSCREEN, TEDITHCPY: Remove absolute NS charcodes (#494)
* TEDITSCREEN, TEDITHCPY: Remove absolute NS charcodes

Also eliminated \MAIKO.DISPLAYLINE.  Git got twisted up between branches, stuck in <<<< in some files, I think I unscrambled it.  (Had to copy TEDIT again separately).  Still says TEDITHCPY.LCOM is conflicted, even though I have completely TCOMPLed it.  Git sucks.

* Trying to fix master incompatibilities
2021-09-27 14:16:49 -07:00
rmkaplan
1d4c9ed6ee BOOTSTRAP: PRINT-READER-ENVIRONMENT puts out an extra EOL
To separate the DEFINE-FILE-INFO  header from the actual contents, when using TEDIT-SEE (in Medley) or lsee
2021-09-27 10:28:50 -07:00
rmkaplan
6b66665e9d BOOTSTRAP: Read initial DEFINE-FILE-INFO as a string, not an atom
If it is ead with RATOM, then e.g. LISPSOURCEFILEP gives an error if the first line of the file begins with something like (Author:
2021-09-26 23:41:52 -07:00
rmkaplan
db3ca49564 Localize external format implementation in new EXTERNALFORMAT file
Pieces moved from FILEIO and LLREAD, EXTERNALFORMAT added to FILESETS
2021-09-25 22:48:04 -07:00
rmkaplan
c89ac61d34 IMAGEIO: Separate construction of :DISPLAY external format
Defaults for 4/8/24 bit display FDEV's
2021-09-25 22:47:16 -07:00
rmkaplan
9b7464d966 MULTI-COMPILE: Just MAKEFILE-NEW to get better filemap 2021-09-25 22:40:25 -07:00
Larry Masinter
5a9bc56628 Ignore #\( #\{ patterns in 'smart' argnames when showing stack frames (#475) 2021-09-23 13:01:07 -07:00
rmkaplan
205223c9b1 Merge pull request #490 from Interlisp/TEDIT-SEE
TEDIT + FILEBROWSER:  Add function TEDIT-SEE, call from FILEBROWSER
2021-09-21 15:13:36 -07:00
Larry Masinter
ccc776608d Add Lispusers BACKGROUND-YIELD to call new subr (#488)
* Add Lispusers BACKGROUND-YIELD to call new subr

* Make BACKGROUND-YIELD a variable
2021-09-20 15:06:40 -07:00
Larry Masinter
25617e383a Add to medley release a tar of loadups-only, for those who want that (#465)
* Add to medley release a tar of loadups-only, for those who want that

* separate pieces (loadups+runtime) with 'don't need runtime if cloned'
2021-09-20 15:04:07 -07:00
rmkaplan
5e6eb4b424 HARDCOPY, TEDITHCPY: fix #491
INITVAR for PRINTFILETYPES, fix the coms for the Interpress option in TEDITHCPY

(This branch is accumulating little TEDIT glitches)
2021-09-20 11:17:55 -07:00
rmkaplan
7175669633 TEDITWINDOW: Ensure TOTOPW in tedit buttoneventfn and scrollfn #492 2021-09-20 07:36:01 -07:00
rmkaplan
21088d3eff TEDIT + FILEBROWSER: Add function TEDIT-SEE, call from FILEBROWSER 2021-09-19 19:10:18 -07:00
109 changed files with 15152 additions and 5121 deletions

View File

@@ -1,7 +1,7 @@
# based on https://blog.oddbit.com/post/2020-09-25-building-multi-architecture-im/
---
# Interlisp workflow to build Docker Image that support multiple architectures
name: 'Build Medley Docker image'
name: Build Medley Docker image
# Run this workflow on push to master
on:

93
.github/workflows/buildLoadup.yml vendored Normal file
View File

@@ -0,0 +1,93 @@
# Interlisp workflow to build Medley release
name: Build Medley Release
# Run this workflow on push to master
on:
workflow_dispatch:
inputs:
tag:
description: 'Release Tag'
# Jobs that compose this workflow
jobs:
# Build Loadup
loadup:
runs-on: ubuntu-latest
steps:
- name: Set release tag if currently undefined
if: ${{ github.event.inputs.tag == null }}
run: |
echo "tag=medley-`date +%y%m%d`" >> $GITHUB_ENV
- name: Set release tag to input value
if: ${{ github.event.inputs.tag != null }}
run: |
echo "tag=${{ github.event.inputs.tag }}" >> $GITHUB_ENV
- name: Checkout Medley
uses: actions/checkout@v2
- name: Get the latest Maiko Release
uses: actions/checkout@v2
with:
repository: interlisp/maiko
path: maiko
- name: install compiler
run: sudo apt-get update && sudo apt-get install -y make clang libx11-dev gcc x11vnc xvfb
- name: install vnc
run: sudo apt-get install -y tightvncserver
- name: Compile Maiko
working-directory: maiko/bin
run: ./makeright x && ./makeright init
- name: Build Loadout
run: pwd && Xvnc -once -geometry 1280x720 :0 & DISPLAY=:0 PATH="/maiko:$PATH" scripts/loadup-all.sh
- name: Build release tar get libs
run: |
cp -p tmp/full.sysout tmp/lisp.sysout tmp/*.dribble tmp/whereis.hash loadups/
cp -p tmp/exports.all tmp/RDSYS tmp/RDSYS.LCOM library/
cd ..
tar cfz medley/tmp/$tag-loadups.tgz \
medley/loadups/lisp.sysout \
medley/loadups/full.sysout \
medley/loadups/whereis.hash \
medley/library/exports.all \
medley/library/RDSYS/ \
medley/library/RDSYS.LCOM
- name: tar part 2
run: |
cd ..
tar cfz medley/tmp/$tag-runtime.tgz \
--exclude "*~" --exclude "*#*" \
medley/docs/dinfo \
medley/docs/Documentation\ Tools \
medley/greetfiles/SIMPLE-INIT \
medley/run-medley \
medley/scripts \
medley/fonts/displayfonts \
medley/fonts/altofonts \
medley/fonts/postscriptfonts \
medley/library/ \
medley/lispusers/ \
medley/fonts/big \
medley/fonts/other \
medley/sources/ \
medley/internal/library
- name: Release notes
run: |
sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md &&
ls tmp && env
- name: push the release
uses: ncipollo/release-action@v1.8.10
with:
artifacts: tmp/${{ env.tag }}-loadups.tgz,tmp/${{ env.tag }}-runtime.tgz
tag: ${{ env.tag }}
bodyfile: tmp/release-notes.md
token: ${{ secrets.GITHUB_TOKEN }}

16
BUILDING.md Normal file
View File

@@ -0,0 +1,16 @@
# How to build a medley release
Originally done only with shell scripts:
./scripts/loadup-all.sh
./scripts/loadup-and-release.sh
# Using github actions
In the github medley repository (Interlisp/medley) go to the Actions tab.
It should list the available github actions, select the bottom one, Build Medley Release.
In the middle of the screen there's a box labeled workflow runs.
There should be a row in it that states 'This workflow has a workflow_dispatch event trigger' with a drop down menu (it really looks more like a button) on the right side labeled 'Run workflow'. Select that and you'll get a form allowing you to select the branch (I've only used Master) and enter the release name. Enter a name or leave it empty and press the green 'Run workflow' button. The workflow should queue up and run.

View File

@@ -1,26 +1,72 @@
# Medley
This repository is for the Lisp environment of [Medley Interlisp](https://Interlisp.org).
We've made great process in sorting out what we have (some dusty corners notwithstanding), but there's quite a bit more work to do. Please report problems!
See the [Medley Interlisp Wiki](https://github.com/Interlisp/medley/wiki/) for an overview and pointers to available documentation.
See [Medley Interlisp Wiki](https://github.com/Interlisp/medley/wiki/) for an overview, and other pointers.
A sub-project is [Interlisp/maiko](https://github.com/Interlisp/maiko), which is the implementation (in C) of the Medley virtual machine.
A sub-project is [Interlisp/maiko](https://github.com/Interlisp/maiko), which is the implementation (in C) of the Medley virtual machine.
## Using releases
There currently are separate releases of medley and maiko; get the latest version of each.
There (soon) will also be Docker containers with the latest, and a way to try out Medley in the cloud (without installing).
## Instructions for Building and Running
### Getting releases
Get the Maiko release [here](https://github.com/Interlisp/maiko/releases). You'll need the one corresponding to your operating system and processor (for Windows with WSL or Intel linux, use `linux.x86_64`; for Macs use `darwin.x86_64` for Intel and `darwin.aarch64` for M1.)
Or, build your own maiko (the binaries `lde` `ldex` and `ldeinit`.) We can build for other OS arch pairs depending on what is available for GitHub actions.
The medley release comes in two parts, found [here](https://github.com/Interlisp/medley/releases)
1. The "loadups" (download `medley-`YYMMDD`-loadups.tgz`)
2. The "runtime" (download `medley-`YYMMDD`-runtime.tgz`)
You don't need the "runtime" if you've cloned this (medley) repo.
If you happen to have the 'gh' GitHub command line installed you can download both using
```
gh release download -R Interlisp/medley -p "*"
```
but otherwise just click on the link(s) to the parts you need.
### Unpacking releases
From a shell/terminal window:
1. Choose where you want to install medley and maiko.
Unpack the medley loadups file
* `cd ` ~parent~
* `tar -xvfz medley-`YYMMDD`-loadups.tgz`
2. Unpack the medley runtime OR clone the Medley repo
(the "medley runtime" is just a subset of the whole repo)
* `tar -xvfz medley-`YYMMDD`-runtime.tgz`
OR
```
git clone https://github.com/Interlisp/medley
```
3. Unpack the maiko file for your operating system and CPU type, e.g.,
```
tar -xvfz maiko-210823.linux.x86_64.tgz
```
3. This should leave you with two directories, `medley` and `maiko`.
### Setting up X
Medley Interlisp needs an X-Server to manage its display. Most Linux desktops have one. There are a number of free open source X-servers for windows. Mac users should head over to [XQuartz.org](https://xquartz.org/releases) -- be sure to pick a version if you have a newer Mac.
Medley Interlisp currently needs an X-Server to manage its display. Most Linux desktops have one. Windows 11 with WSL includes an X-Server. For Windows 10 with WSL2, there are a number of open-source X servers; for example vcxsrv.
Mac users should get [XQuartz from XQuartz.org](https://xquartz.org/releases).
Medley manages the display entirely, doesn't use X fonts and manages it's own window system.
If you have a high-resolution display, note that much of the graphics was designed for a low-resolution display, so an X-server that does "pixel doublilng" is best. (E.g., Raspberry Pi does pixel doubling on 4K displays.) It also presumes you have a 3-button mouse; the scroll-wheel on some mice act as one with some difficulty.) XQuartz Preferences/Input has "Emulate three button mouse" option.
### Running Medley Interlisp
The `run-medley` script in this repo sets up some convenient defaults. Running Medley can be done by typing:
@@ -35,9 +81,6 @@ Or, if you wish to start Medley up with a different SYSOUT:
$ cd medley
$ ./run-medley <SYSOUT-file-name>
```
Once the system comes up, give it a few seconds to initialize.
The first time the system is run it loads the system image that comes
with the system. When you exit the system (or "do a `SaveVM`" menu
option) the state of your machine is saved in a file named
@@ -73,8 +116,12 @@ files. A .TEDIT or .TXT file is probably documentation
for the package of same name, at least in the library,
internal/library, lispusers.
The current repo has both Lisp sources and compiled .LCOM and .DFASL
files, because some files don't compile in a vanilla lisp.sysout .
files.
Each directory should have a README.md, but briefly
@@ -85,9 +132,7 @@ Each directory should have a README.md, but briefly
- library -- packages that were supported (30 years ago)
- lispusers -- packages that were only half supported (ditto)
- loadups -- has sysouts and other builds
- patches -- for cases where reloading doesn't wor
- scripts -- some scripts for fixing up things
- sunloadup -- support information for making a new lisp.sysout from scratch
- sources -- sources for Interlisp and Common Lisp implementations
- unicode -- data files for support of XCCS to and from Unicode mappings

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Nov-94 16:28:04" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;4| 37236
(FILECREATED "25-Sep-2021 21:28:08" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>internal>library>MULTI-COMPILE.;2| 37172
|changes| |to:| (VARS MULTI-COMPILECOMS)
(FNS FIND-UNCOMPILED-FILES)
|previous| |date:| " 9-Sep-94 13:03:19" |{DSK}<lispcore>internal>library>MULTI-COMPILE.;3|)
|previous| |date:| "16-Nov-94 16:28:04"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>internal>library>MULTI-COMPILE.;1|)
; Copyright (c) 1988, 1990, 1991, 1992, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
; Copyright (c) 1988, 1990-1994, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT MULTI-COMPILECOMS)
@@ -601,12 +600,12 @@
(ADDTOVAR LAMA FIX-FILES)
)
(PUTPROPS MULTI-COMPILE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1991 1992 1993 1994))
(PUTPROPS MULTI-COMPILE COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1991 1992 1993 1994 2021))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (7131 8389 (FIND-UNCOMPILED-FILES 7141 . 8387)) (8461 19787 (NEWERDCOMS? 8471 . 12445) (
NEWERSOURCES? 12447 . 16359) (SETUP-FOR-RECOMPILE 16361 . 18749) (SMASH-OPCODES 18751 . 19269) (
GET-DIRECTORY-LISTING 19271 . 19568) (GET-OPEN-FILES 19570 . 19785)) (31690 36610 (FIX-FILES 31700 .
34497) (FIX-FILE 34499 . 35090) (FIX-COPYRIGHT 35092 . 35319) (FIX-FILE-COPYRIGHT 35321 . 35481) (
QUALIFY-FIELDS 35483 . 36022) (FIX-TEDIT 36024 . 36330) (FIX-DOCS 36332 . 36608)) (36735 36917 (CLFIX
36745 . 36915)))))
(FILEMAP (NIL (2676 6156 (BIGCOMP 2676 . 6156)) (6289 7061 (FIND-ALL-SOURCE-FILES 6289 . 7061)) (7062
8320 (FIND-UNCOMPILED-FILES 7072 . 8318)) (8392 19718 (NEWERDCOMS? 8402 . 12376) (NEWERSOURCES? 12378
. 16290) (SETUP-FOR-RECOMPILE 16292 . 18680) (SMASH-OPCODES 18682 . 19200) (GET-DIRECTORY-LISTING
19202 . 19499) (GET-OPEN-FILES 19501 . 19716)) (31621 36541 (FIX-FILES 31631 . 34428) (FIX-FILE 34430
. 35021) (FIX-COPYRIGHT 35023 . 35250) (FIX-FILE-COPYRIGHT 35252 . 35412) (QUALIFY-FIELDS 35414 .
35953) (FIX-TEDIT 35955 . 36261) (FIX-DOCS 36263 . 36539)) (36666 36848 (CLFIX 36676 . 36846)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "21-Aug-2021 23:33:58" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9| 263236
|changes| |to:| (FNS FB.FIX-DIRECTORY-DATES)
(FILECREATED "16-Oct-2021 15:04:31" 
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;13| 261677
|previous| |date:| "21-Aug-2021 23:08:34"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;7|)
|changes| |to:| (VARS FILEBROWSERCOMS)
(FNS FB.GETWINDOW FB.SET.BROWSER.TITLE FB.DATE)
|previous| |date:| "19-Sep-2021 18:08:05"
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;10|)
; Copyright (c) 1983-1991, 1993-1994, 1999-2001, 2021 by Venue & Xerox Corporation.
@@ -22,11 +24,11 @@
(TERPRI T))))
(FILES ATTACHEDWINDOW ICONW TABLEBROWSER)
(P
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
(MOVD? 'NILL 'TOTOPW.MODERNIZE))
(* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")
(* |;;| "JDS 11/94 FB.ICONSPEC is now an INITVAR so we can create smaller ones in profiles for, e.g., laptops.")
(INITVARS (FB.EXPUNGE?MENU)
(FB.BROWSERFONT DEFAULTFONT)
@@ -45,7 +47,7 @@
(FB.PROMPTFONT LITTLEFONT)
(FB.BROWSER.DIRECTORY.FONT BOLDFONT)))
(P
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
(FONTSET (FONTSET)))
(ADDVARS (CACHEDMENUS FB.EXPUNGE?MENU))
@@ -170,16 +172,16 @@ You specify how many versions to keep.")))
(VARS FB.VERSION.MENU.ITEMS FB.CLOSE.MENU.ITEMS FB.DEPTH.MENU.ITEMS FB.INFO.MENU.ITEMS
FB.DEFAULT.NAME.WIDTH FB.INFO.FIELDS FB.INFOSHADE FB.ITEMUNSELECTEDSHADE
FB.ITEMSELECTEDSHADE))
(COMS (* \; "Entries")
(COMS (* \; "Entries")
(COMMANDS "fb")
(FNS FB FB.COPYBINARYCOMMAND FB.COPYTEXTCOMMAND FILEBROWSER FB.TABLEBROWSER
FB.SELECTEDFILES FB.FETCHFILENAME FB.DIRECTORYP FB.PROMPTWPRINT FB.PROMPTW.FORMAT
FB.PROMPTFORINPUT FB.YES-OR-NO-P FB.ALLOW.ABORT \\FB.HARDCOPY.TOFILE.EXTENSION)
(* \; "Setup")
(* \; "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
@@ -204,7 +206,8 @@ You specify how many versions to keep.")))
(FNS FB.EXPUNGECOMMAND FB.NEWPATTERNCOMMAND FB.NEWINFOCOMMAND FB.DEPTHCOMMAND
FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN
FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
(COMS (* \; "window functions")
(COMS (* \; "window functions")
(FNS FB.GETWINDOW)
(FNS FB.INFOMENU.SHADEINITIALSELECTIONS FB.INFO.ITEM.NAMED)
(FNS FB.MAKECOUNTERWINDOW FB.COUNTERW.REDISPLAYFN FB.UPDATE.COUNTERS
FB.DISPLAY.COUNTERS FB.COUNTER.STRING)
@@ -253,7 +256,7 @@ You specify how many versions to keep.")))
(FILESLOAD ATTACHEDWINDOW ICONW TABLEBROWSER)
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
(* |;;| "Set up for MODERNIZE windows, whether or not MODERNIZE is pre-loaded")
(MOVD? 'NILL 'TOTOPW.MODERNIZE)
@@ -295,7 +298,7 @@ You specify how many versions to keep.")))
(FB.BROWSER.DIRECTORY.FONT BOLDFONT))
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
(* |;;| "FONTSET fills in the variables in FONTVARS for us, so do it.")
(FONTSET (FONTSET))
@@ -1684,84 +1687,49 @@ Your deletions are thus ignored.")))
ELSE (FB.FASTSEECOMMAND BROWSER KEY ITEM MENU)))))
(FB.EDITCOMMAND.ONEFILE
(LAMBDA (BROWSER FILE OPTION ITEM MENU) (* \; "Edited 8-Aug-2021 11:16 by rmk:")
(* \; "Edited 27-Feb-2021 20:07 by rmk:")
(* \; "Edited 1-Feb-88 19:00 by bvm:")
(LAMBDA (BROWSER FILE OPTION ITEM MENU) (* \; "Edited 19-Sep-2021 18:07 by rmk:")
(* \; "Edited 27-Feb-2021 20:07 by rmk:")
(* \; "Edited 1-Feb-88 19:00 by bvm:")
(* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists. If OPTION is READONLY, we don't want to edit, just view. If FILE is a lisp sourcefile, we execute the font changes by COPY.TEXT.TO.IMAGE.")
(* |;;| "Called when we know that FILE is a file, not a directory, and that TEDIT exists. If OPTION is READONLY, we don't want to edit, just view. .")
(* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region. We don't factor it to the top because we want to do whatever heavy lifting (copying files) before. Don't factor to the end because then it is too late--the TEDIT window was up and then buried. (If TEDIT had a don'topen option, we could set things up, then change the shade, then open. We could also do the manufactured title on the window before it shows.")
(* |;;| "We clear the shade stuff here because we don't want the FB to come up on top of our see/edit region. Don't factor to the end because then it is too late--the TEDIT window was up and then buried. (If TEDIT had a don'topen option, we could set things up, then change the shade, then open. We could also do the manufactured title on the window before it shows.")
(CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR))
(CL:MULTIPLE-VALUE-BIND
(IGNORE CONDITION)
(IGNORE-ERRORS
(LET ((ENV (LISPSOURCEFILEP FILE)))
(IF ENV
THEN (SELECTQ OPTION
((LISP NIL TEDIT)
(* |;;|
"Asks to load prop and edits the coms. We really don't want to use a text editor on a source file.")
(CL:UNLESS OPTION (SETQ OPTION FB.DEFAULT.EDITOR)) (* \; "Default editor is TEDIT. ")
(* |;;| "The FUNCALL at the bottom is concerning.")
(* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that. That way, the FB window won't pop up on top.")
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
(FB.EDITLISPFILE FILE BROWSER))
(READONLY (* \; "READONLY on call from SEE")
(CL:WITH-OPEN-FILE
(STREAM FILE :DIRECTION :INPUT)
(LET ((NSTR (OPENTEXTSTREAM)))
(\\EXTERNALFORMAT STREAM ENV)
(COPY.TEXT.TO.IMAGE STREAM NSTR)
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
(* |;;| "Unshade the item before we create the TEDIT window, and tell FB.FINISH.COMMAND that we did that. That way, the FB window won't pop up on top.")
(* |;;| "The particular item may be a subitem of the EDIT or SEE menu item, in which case we want to unshade that too. Seems a little bruteforce")
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM
(CL:UNLESS (MEMBER ITEM (FETCH (MENU ITEMS) OF MENU))
(FOR I IN (FETCH (MENU ITEMS) OF MENU)
WHEN (MEMBER ITEM (CDR (SASSOC 'SUBITEMS I))) DO (SHADEITEM I MENU
FB.ITEMUNSELECTEDSHADE)
(PUTMENUPROP MENU 'ITEMSHADE
(CONS I
FB.ITEMUNSELECTEDSHADE
))
(WINDOWPROP (WFROMDS (TEXTSTREAM
(TEDIT NSTR NIL NIL
'(READONLY T))))
'TITLE
(CONCAT "SEE window for " (FULLNAME STREAM))))))
(CL:FUNCALL OPTION (MKATOM FILE)))
ELSE (SELECTQ OPTION
(READONLY
))))
(CL:MULTIPLE-VALUE-BIND (IGNORE CONDITION)
(IGNORE-ERRORS (SELECTQ OPTION
(READONLY (TEDIT-SEE FILE))
(LISP (* \;
"Original code allowed OPTION=NIL in thie branch, but NIL should have been coerced to TEDIT above.")
(* |;;| "From SEE command. We want to be able to scroll around in the content, can't do that if it isn't random access. So in that case we do a secret NODIRCORE copy and look at that.")
(* |;;| "Asks to load prop and edits the coms, presumably with SEDIT. We really don't want to use a text editor on a source file.")
(CL:WITH-OPEN-FILE
(STREAM FILE :DIRECTION :INPUT)
(LET ((NSTR))
(CL:UNLESS (RANDACCESSP STREAM)
(SETQ NSTR (OPENSTREAM
'{NODIRCORE}
'BOTH
'NEW NIL (LIST (LIST 'TYPE
(GETFILEINFO
STREAM
'TYPE)))))
(COPYBYTES STREAM NSTR))
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM
FB.ITEMUNSELECTEDSHADE))
(WINDOWPROP (WFROMDS (TEXTSTREAM (TEDIT (OR NSTR STREAM)
NIL NIL
'(READONLY T))))
'TITLE
(CONCAT "SEE window for " (FULLNAME STREAM))))))
((TEDIT NIL)
(SHADEITEM ITEM MENU FB.ITEMUNSELECTEDSHADE)
(PUTMENUPROP MENU 'ITEMSHADE (CONS ITEM FB.ITEMUNSELECTEDSHADE))
(TEDIT (MKATOM FILE)))
(LISP (FB.PROMPTW.FORMAT BROWSER
"Failed because not a Lisp source file"))
(CL:FUNCALL OPTION (MKATOM FILE))))))
(|if| CONDITION
|then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))
(IF (LISPSOURCEFILEP FILE)
THEN (FB.EDITLISPFILE FILE BROWSER)
ELSE (FB.PROMPTW.FORMAT BROWSER
"Failed because not a Lisp source file")))
(PROGN
(* |;;| "Might just be a call to TEDIT (if OPTION = TEDIT)")
(CL:FUNCALL OPTION (MKATOM FILE)))))
(|if| CONDITION
|then| (FB.PROMPTW.FORMAT BROWSER "Failed because ~A" CONDITION)))))
(FB.EDITLISPFILE
(LAMBDA (FILE BROWSER) (* \; "Edited 21-Feb-2021 17:29 by rmk:")
@@ -2288,21 +2256,15 @@ Do you want to expunge them first?")
(FB.DISPLAY.COUNTERS BROWSER)))))
(FB.DATE
(LAMBDA NIL (* \; "Edited 21-Jan-88 18:40 by bvm")
(LET ((DT (DATE (DATEFORMAT DAY.OF.WEEK DAY.SHORT NO.SECONDS))))
(LAMBDA NIL (* \; "Edited 16-Oct-2021 14:06 by rmk:")
(* |;;|
 "DT is in the form \"dd-mon-yy hh:mm (day)\". Turn it into \"hh:mm day dd-mon-yy\".")
(* |;;| "RMK: Tried to decode and rearrange with Y2K error. Now just pass it through. It used to include the short day of week, that seems silly. It is today's date...or at least the date of the last recompute")
(CONCAT (SUBSTRING DT 11 16)
(SUBSTRING DT 18 20)
" "
(SUBSTRING DT (|if| (EQ (CHCON1 DT)
(CHARCODE SPACE))
|then| (* \; "Trim leading space from date")
2
|else| 1)
9)))))
(* |;;| "(DATEFORMAT NO.LEADING.SPACES NO.SECONDS DAY.OF.WEEK DAY.SHORT)")
(* |;;| "I think this only goes in the title bar, which is perhaps odd in itself.")
(DATE (DATEFORMAT NO.LEADING.SPACES NO.SECONDS))))
(FB.ADJUST.DATE.WIDTH
(LAMBDA (BROWSER INFOWANTED) (* \; "Edited 30-Aug-94 19:40 by jds")
@@ -2342,9 +2304,11 @@ Do you want to expunge them first?")
|finally| (RETURN RESULT))))
(FB.SET.BROWSER.TITLE
(LAMBDA (BROWSER TIME) (* \; "Edited 21-Jan-88 18:37 by bvm")
(LAMBDA (BROWSER TIME) (* \; "Edited 16-Oct-2021 14:10 by rmk:")
(* |;;| "(Re)display the title on BROWSER's window. If Time is supplied, it is the time at which the enumeration happened, and we include it in the title. Title is not changed if user supplied own title.")
(* |;;| "(Re)display the title on BROWSER's window. If Time is supplied, it is the time at which the enumeration happened, and we include it in the title. Title is not changed if user supplied own title.")
(* |;;| "RMK: Move the date over a bit, so that path stands out")
(COND
((NOT (|fetch| (FILEBROWSER FIXEDTITLE) |of| BROWSER))
@@ -2352,7 +2316,7 @@ Do you want to expunge them first?")
'TITLE
(|if| TIME
|then| (CONCAT (|fetch| (FILEBROWSER PATTERN) |of| BROWSER)
" at " TIME)
" at " TIME)
|else| (CONCAT (|fetch| (FILEBROWSER PATTERN) |of| BROWSER)
" browser")))))))
@@ -3329,6 +3293,25 @@ then click Recompute"))))
(DEFINEQ
(FB.GETWINDOW
(LAMBDA (WINDOW WHICH) (* \; "Edited 16-Oct-2021 15:02 by rmk:")
(* |;;| "Closed function to get at filebrowser attached windows by type, without need record declarations at runtime. Helps MODERNIZE get the right regions.")
(LET* ((FBWINDOW (CENTRALWINDOW WINDOW))
(FILEBROWSER (WINDOWPROP FBWINDOW 'FILEBROWSER)))
(CL:WHEN FILEBROWSER
(SELECTQ WHICH
(HEADING (FETCH (FILEBROWSER HEADINGWINDOW) OF FILEBROWSER))
(COUNTER (FETCH (FILEBROWSER COUNTERWINDOW) OF FILEBROWSER))
(BROWSER FBWINDOW)
(PROMPT (FETCH (FILEBROWSER PROMPTWINDOW) OF FILEBROWSER))
(COMMAND (FIND W IN (WINDOWPROP FBWINDOW 'ATTACHEDWINDOWS)
SUCHTHAT (EQ 'MENUBUTTONFN (WINDOWPROP W 'BUTTONEVENTFN))))
NIL)))))
)
(DEFINEQ
(FB.INFOMENU.SHADEINITIALSELECTIONS
(LAMBDA (MENUWINDOW INITIALSELECTIONS) (* \; "Edited 21-Jan-88 18:36 by bvm")
(LET* ((MENU (CAR (WINDOWPROP MENUWINDOW 'MENU)))
@@ -3838,26 +3821,26 @@ then click Recompute"))))
(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")
(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
)
@@ -3872,85 +3855,85 @@ then click Recompute"))))
) 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")
(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")
(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")
(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.")
(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))
)
@@ -4237,51 +4220,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 (28618 51254 (FB 28628 . 29584) (FB.COPYBINARYCOMMAND 29586 . 29932) (FB.COPYTEXTCOMMAND
29934 . 30276) (FILEBROWSER 30278 . 43384) (FB.TABLEBROWSER 43386 . 43603) (FB.SELECTEDFILES 43605 .
44242) (FB.FETCHFILENAME 44244 . 44636) (FB.DIRECTORYP 44638 . 44966) (FB.PROMPTWPRINT 44968 . 46014)
(FB.PROMPTW.FORMAT 46016 . 46753) (FB.PROMPTFORINPUT 46755 . 49007) (FB.YES-OR-NO-P 49009 . 50043) (
FB.ALLOW.ABORT 50045 . 50899) (\\FB.HARDCOPY.TOFILE.EXTENSION 50901 . 51252)) (51278 52231 (FB.STARTUP
51288 . 51803) (FB.MAKERIGIDWINDOW 51805 . 52229)) (52232 57604 (FB.PRINTFN 52242 . 57395) (FB.COPYFN
57397 . 57602)) (57654 63696 (FB.MENU.WHENSELECTEDFN 57664 . 58022) (FB.COMMANDSELECTEDFN 58024 .
59563) (FB.SUBITEMP 59565 . 60000) (FB.MAKE.BROWSER.BUSY 60002 . 60740) (FB.FINISH.COMMAND 60742 .
62707) (FB.HANDLE.ABORT.BUTTON 62709 . 63694)) (63697 69213 (FB.DELETECOMMAND 63707 . 63988) (
FB.DELVERCOMMAND 63990 . 67183) (FB.IS.NOT.SUBDIRECTORY.ITEM 67185 . 67366) (FB.DELVER.FILES 67368 .
68457) (FB.DELETE.FILE 68459 . 69211)) (69214 70539 (FB.UNDELETECOMMAND 69224 . 69509) (
FB.UNDELETEALLCOMMAND 69511 . 69790) (FB.UNDELETE.FILE 69792 . 70537)) (70540 94721 (FB.COPYCOMMAND
70550 . 70819) (FB.RENAMECOMMAND 70821 . 71096) (FB.COPY/RENAME.COMMAND 71098 . 72021) (
FB.COPY/RENAME.ONE 72023 . 74345) (FB.COPY/RENAME.MANY 74347 . 80567) (FB.MERGE.DIRECTORIES 80569 .
80987) (FB.GREATEST.PREFIX 80989 . 82345) (FB.MAYBE.INSERT.FILE 82347 . 89787) (FB.GET.NEW.FILE.SPEC
89789 . 93620) (FB.CANONICAL.DIRECTORY 93622 . 94719)) (94722 102506 (FB.HARDCOPYCOMMAND 94732 . 95862
) (FB.HARDCOPY.TOFILE 95864 . 102504)) (102507 114945 (FB.EDITCOMMAND 102517 . 103318) (
FB.EDITCOMMAND.ONEFILE 103320 . 109161) (FB.EDITLISPFILE 109163 . 110202) (FB.BROWSECOMMAND 110204 .
114943)) (114946 126739 (FB.FASTSEECOMMAND 114956 . 118406) (FB.FASTSEE.ONEFILE 118408 . 121437) (
FB.SEEFULLFN 121439 . 125570) (FB.SEEBUTTONFN 125572 . 126737)) (126740 128486 (FB.LOADCOMMAND 126750
. 127257) (FB.COMPILECOMMAND 127259 . 127797) (FB.OPERATE.ON.FILES 127799 . 128484)) (128487 176145 (
FB.UPDATECOMMAND 128497 . 128722) (FB.FIX-DIRECTORY-DATES 128724 . 129331) (FB.MAYBE.EXPUNGE 129333 .
130328) (FB.UPDATEBROWSERITEMS 130330 . 143545) (FB.DATE 143547 . 144288) (FB.ADJUST.DATE.WIDTH 144290
. 147258) (FB.SET.BROWSER.TITLE 147260 . 148117) (FB.MAYBE.WIDEN.NAMES 148119 . 150238) (
FB.SET.DEFAULT.NAME.WIDTH 150240 . 151604) (FB.CREATE.FILEBUCKET 151606 . 158826) (
FB.CHECK.NAME.LENGTH 158828 . 161249) (FB.ADD.FILEGROUP 161251 . 162778) (FB.INSERT.DIRECTORY 162780
. 163018) (FB.MAKE.SUBDIRECTORY.ITEM 163020 . 164429) (FB.ADD.FILE 164431 . 165044) (FB.INSERT.FILE
165046 . 168458) (FB.ANALYZE.PATTERN 168460 . 173724) (FB.CANONICALIZE.PATTERN 173726 . 175038) (
FB.GETALLFILEINFO 175040 . 176143)) (176146 184305 (FB.SORT.VERSIONS 176156 . 178927) (
FB.DECREASING.VERSION 178929 . 179598) (FB.INCREASING.VERSION 179600 . 180221) (
FB.NAMES.DECREASING.VERSION 180223 . 181258) (FB.NAMES.INCREASING.VERSION 181260 . 182257) (
FB.DECREASING.NUMERIC.ATTR 182259 . 182939) (FB.INCREASING.NUMERIC.ATTR 182941 . 183615) (
FB.ALPHABETIC.ATTR 183617 . 184303)) (184306 194148 (FB.SORTCOMMAND 184316 . 191146) (
FB.INSERT.SUBDIRECTORIES 191148 . 191945) (FB.GET.SORT.MENU 191947 . 194146)) (194149 210238 (
FB.EXPUNGECOMMAND 194159 . 196678) (FB.NEWPATTERNCOMMAND 196680 . 197078) (FB.NEWINFOCOMMAND 197080 .
199846) (FB.DEPTHCOMMAND 199848 . 201623) (FB.SHAPECOMMAND 201625 . 204967) (FB.REMOVE.FILE 204969 .
206790) (FB.COUNT.FILE.CHANGE 206792 . 208237) (FB.SETNEWPATTERN 208239 . 209409) (FB.GET.NEWPATTERN
209411 . 209995) (FB.OPTIONSCOMMAND 209997 . 210236)) (210273 211285 (
FB.INFOMENU.SHADEINITIALSELECTIONS 210283 . 210930) (FB.INFO.ITEM.NAMED 210932 . 211283)) (211286
220752 (FB.MAKECOUNTERWINDOW 211296 . 212758) (FB.COUNTERW.REDISPLAYFN 212760 . 213347) (
FB.UPDATE.COUNTERS 213349 . 215421) (FB.DISPLAY.COUNTERS 215423 . 220483) (FB.COUNTER.STRING 220485 .
220750)) (220753 225396 (FB.MAKEHEADINGWINDOW 220763 . 222311) (FB.HEADINGW.REDISPLAYFN 222313 .
222579) (FB.HEADINGW.RESHAPEFN 222581 . 222957) (FB.HEADINGW.DISPLAY 222959 . 225394)) (225397 229580
(FB.ICONFN 225407 . 225754) (FB.INFOMENU.WHENSELECTEDFN 225756 . 226486) (FB.CLOSEFN 226488 . 227691)
(FB.EXPUNGE?.MENU 227693 . 228105) (FB.AFTERCLOSEFN 228107 . 228468) (FB.CLOSE&EXPUNGE 228470 . 229578
)) (229581 241639 (FB.HARDCOPY.DIRECTORY 229591 . 239948) (FB.HARDCOPY.PRINT.TITLE 239950 . 240276) (
FB.HARDCOPY.MAXWIDTH 240278 . 241637)))))
(FILEMAP (NIL (28719 51355 (FB 28729 . 29685) (FB.COPYBINARYCOMMAND 29687 . 30033) (FB.COPYTEXTCOMMAND
30035 . 30377) (FILEBROWSER 30379 . 43485) (FB.TABLEBROWSER 43487 . 43704) (FB.SELECTEDFILES 43706 .
44343) (FB.FETCHFILENAME 44345 . 44737) (FB.DIRECTORYP 44739 . 45067) (FB.PROMPTWPRINT 45069 . 46115)
(FB.PROMPTW.FORMAT 46117 . 46854) (FB.PROMPTFORINPUT 46856 . 49108) (FB.YES-OR-NO-P 49110 . 50144) (
FB.ALLOW.ABORT 50146 . 51000) (\\FB.HARDCOPY.TOFILE.EXTENSION 51002 . 51353)) (51379 52332 (FB.STARTUP
51389 . 51904) (FB.MAKERIGIDWINDOW 51906 . 52330)) (52333 57705 (FB.PRINTFN 52343 . 57496) (FB.COPYFN
57498 . 57703)) (57755 63797 (FB.MENU.WHENSELECTEDFN 57765 . 58123) (FB.COMMANDSELECTEDFN 58125 .
59664) (FB.SUBITEMP 59666 . 60101) (FB.MAKE.BROWSER.BUSY 60103 . 60841) (FB.FINISH.COMMAND 60843 .
62808) (FB.HANDLE.ABORT.BUTTON 62810 . 63795)) (63798 69314 (FB.DELETECOMMAND 63808 . 64089) (
FB.DELVERCOMMAND 64091 . 67284) (FB.IS.NOT.SUBDIRECTORY.ITEM 67286 . 67467) (FB.DELVER.FILES 67469 .
68558) (FB.DELETE.FILE 68560 . 69312)) (69315 70640 (FB.UNDELETECOMMAND 69325 . 69610) (
FB.UNDELETEALLCOMMAND 69612 . 69891) (FB.UNDELETE.FILE 69893 . 70638)) (70641 94822 (FB.COPYCOMMAND
70651 . 70920) (FB.RENAMECOMMAND 70922 . 71197) (FB.COPY/RENAME.COMMAND 71199 . 72122) (
FB.COPY/RENAME.ONE 72124 . 74446) (FB.COPY/RENAME.MANY 74448 . 80668) (FB.MERGE.DIRECTORIES 80670 .
81088) (FB.GREATEST.PREFIX 81090 . 82446) (FB.MAYBE.INSERT.FILE 82448 . 89888) (FB.GET.NEW.FILE.SPEC
89890 . 93721) (FB.CANONICAL.DIRECTORY 93723 . 94820)) (94823 102607 (FB.HARDCOPYCOMMAND 94833 . 95963
) (FB.HARDCOPY.TOFILE 95965 . 102605)) (102608 112485 (FB.EDITCOMMAND 102618 . 103419) (
FB.EDITCOMMAND.ONEFILE 103421 . 106701) (FB.EDITLISPFILE 106703 . 107742) (FB.BROWSECOMMAND 107744 .
112483)) (112486 124279 (FB.FASTSEECOMMAND 112496 . 115946) (FB.FASTSEE.ONEFILE 115948 . 118977) (
FB.SEEFULLFN 118979 . 123110) (FB.SEEBUTTONFN 123112 . 124277)) (124280 126026 (FB.LOADCOMMAND 124290
. 124797) (FB.COMPILECOMMAND 124799 . 125337) (FB.OPERATE.ON.FILES 125339 . 126024)) (126027 173598 (
FB.UPDATECOMMAND 126037 . 126262) (FB.FIX-DIRECTORY-DATES 126264 . 126871) (FB.MAYBE.EXPUNGE 126873 .
127868) (FB.UPDATEBROWSERITEMS 127870 . 141085) (FB.DATE 141087 . 141662) (FB.ADJUST.DATE.WIDTH 141664
. 144632) (FB.SET.BROWSER.TITLE 144634 . 145570) (FB.MAYBE.WIDEN.NAMES 145572 . 147691) (
FB.SET.DEFAULT.NAME.WIDTH 147693 . 149057) (FB.CREATE.FILEBUCKET 149059 . 156279) (
FB.CHECK.NAME.LENGTH 156281 . 158702) (FB.ADD.FILEGROUP 158704 . 160231) (FB.INSERT.DIRECTORY 160233
. 160471) (FB.MAKE.SUBDIRECTORY.ITEM 160473 . 161882) (FB.ADD.FILE 161884 . 162497) (FB.INSERT.FILE
162499 . 165911) (FB.ANALYZE.PATTERN 165913 . 171177) (FB.CANONICALIZE.PATTERN 171179 . 172491) (
FB.GETALLFILEINFO 172493 . 173596)) (173599 181758 (FB.SORT.VERSIONS 173609 . 176380) (
FB.DECREASING.VERSION 176382 . 177051) (FB.INCREASING.VERSION 177053 . 177674) (
FB.NAMES.DECREASING.VERSION 177676 . 178711) (FB.NAMES.INCREASING.VERSION 178713 . 179710) (
FB.DECREASING.NUMERIC.ATTR 179712 . 180392) (FB.INCREASING.NUMERIC.ATTR 180394 . 181068) (
FB.ALPHABETIC.ATTR 181070 . 181756)) (181759 191601 (FB.SORTCOMMAND 181769 . 188599) (
FB.INSERT.SUBDIRECTORIES 188601 . 189398) (FB.GET.SORT.MENU 189400 . 191599)) (191602 207691 (
FB.EXPUNGECOMMAND 191612 . 194131) (FB.NEWPATTERNCOMMAND 194133 . 194531) (FB.NEWINFOCOMMAND 194533 .
197299) (FB.DEPTHCOMMAND 197301 . 199076) (FB.SHAPECOMMAND 199078 . 202420) (FB.REMOVE.FILE 202422 .
204243) (FB.COUNT.FILE.CHANGE 204245 . 205690) (FB.SETNEWPATTERN 205692 . 206862) (FB.GET.NEWPATTERN
206864 . 207448) (FB.OPTIONSCOMMAND 207450 . 207689)) (207726 208713 (FB.GETWINDOW 207736 . 208711)) (
208714 209726 (FB.INFOMENU.SHADEINITIALSELECTIONS 208724 . 209371) (FB.INFO.ITEM.NAMED 209373 . 209724
)) (209727 219193 (FB.MAKECOUNTERWINDOW 209737 . 211199) (FB.COUNTERW.REDISPLAYFN 211201 . 211788) (
FB.UPDATE.COUNTERS 211790 . 213862) (FB.DISPLAY.COUNTERS 213864 . 218924) (FB.COUNTER.STRING 218926 .
219191)) (219194 223837 (FB.MAKEHEADINGWINDOW 219204 . 220752) (FB.HEADINGW.REDISPLAYFN 220754 .
221020) (FB.HEADINGW.RESHAPEFN 221022 . 221398) (FB.HEADINGW.DISPLAY 221400 . 223835)) (223838 228021
(FB.ICONFN 223848 . 224195) (FB.INFOMENU.WHENSELECTEDFN 224197 . 224927) (FB.CLOSEFN 224929 . 226132)
(FB.EXPUNGE?.MENU 226134 . 226546) (FB.AFTERCLOSEFN 226548 . 226909) (FB.CLOSE&EXPUNGE 226911 . 228019
)) (228022 240080 (FB.HARDCOPY.DIRECTORY 228032 . 238389) (FB.HARDCOPY.PRINT.TITLE 238391 . 238717) (
FB.HARDCOPY.MAXWIDTH 238719 . 240078)))))
STOP

Binary file not shown.

View File

@@ -1,9 +1,9 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Aug-2021 16:04:42" {DSK}<home>larry>medley>library>SYSEDIT.;3 1146
(FILECREATED "28-Sep-2021 10:16:44" {DSK}<home>larry>medley>library>SYSEDIT.;3 1307
changes to%: (VARS SYSEDITCOMS)
previous date%: " 6-Aug-2021 07:35:16" {DSK}<home>larry>medley>library>SYSEDIT.;1)
previous date%: "24-Sep-2021 20:52:26" {DSK}<home>larry>medley>library>SYSEDIT.;2)
(* ; "
@@ -19,7 +19,9 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
(GLOBALVARFLG T)
(CLISPIFTRANFLG T)
(CROSSCOMPILING 'ASK)
(DFNFLG 'PROP))
(DFNFLG 'PROP)
(*REPLACE-OLD-EDIT-DATES* NIL)
(COPYRIGHTFLG 'PRESERVE))
(P (RESETVARS ((CROSSCOMPILING T))
(LOAD? 'EXPORTS.ALL])
@@ -37,6 +39,10 @@ Copyright (c) 1984, 1987, 1990, 2021 by Venue & Xerox Corporation.
(RPAQQ DFNFLG PROP)
(RPAQQ *REPLACE-OLD-EDIT-DATES* NIL)
(RPAQQ COPYRIGHTFLG PRESERVE)
(RESETVARS ((CROSSCOMPILING T))
(LOAD? 'EXPORTS.ALL))
(PUTPROPS SYSEDIT COPYRIGHT ("Venue & Xerox Corporation" 1984 1987 1990 2021))

View File

@@ -1,14 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Apr-2018 12:22:03" {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;2 140045
changes to%: (VARS TEDITCOMS)
(FILECREATED "13-Oct-2021 10:00:40" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;19 142287
previous date%: "21-Jun-99 20:00:16"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.;1)
changes to%: (FNS TEDIT-SEE)
previous date%: "11-Oct-2021 14:03:12"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;18)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 1999, 2018 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT TEDITCOMS)
@@ -24,40 +26,40 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
(TEDIT.DEFAULT.PROPS NIL)
(TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP))
(TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU))
(* ;
 "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
(* ;
 "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
)
(GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE
TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES TEDIT.MAPPIECES
TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM \TEDIT.INCLUDE
\TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL \TEDIT.RESTARTFN
\TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS
\TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
(P (MOVD? 'NILL 'OBJECTOUTOFTEDIT))
(* ;
 "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
(* ;
 "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
(COMS (FNS \CREATE.TEDIT.RESTART.MENU))
(* ;
 "Added by yabu.fx, for SUNLOADUP without DWIM.")
(COMS (* ; "Debugging functions")
(* ;
 "Added by yabu.fx, for SUNLOADUP without DWIM.")
(COMS (* ; "Debugging functions")
(FNS PLCHAIN PRINTLINE SEEFILE))
(COMS (* ; "Object-oriented editing")
(COMS (* ; "Object-oriented editing")
(FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.SUBTREE
TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED))
(FILES TEDITFIND TEDITHISTORY TEDITFILE TEDITWINDOW TEDITSELECTION IMAGEOBJ TFBRAVO TEDITHCPY
TEDITPAGE TEDITMENU TEDITFNKEYS)
(COMS (* ; "TEDIT Support information")
(COMS (* ; "TEDIT Support information")
(E (SETQ TEDITSYSTEMDATE (DATE)))
(VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA"))
(FNS MAKETEDITFORM)
(P (ADDTOVAR LAFITESPECIALFORMS ("TEdit Report" 'MAKETEDITFORM
"Report a problem with TEdit"))
(SETQ LAFITEFORMSMENU NIL)))
(COMS (* ;
 "LISTFILES Interface, so the system can decide if a file is a TEdit file.")
(COMS (* ;
 "LISTFILES Interface, so the system can decide if a file is a TEdit file.")
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
(EXTENSION (TEDIT])
@@ -327,6 +329,48 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
(TTY.PROCESS PROC)))
(RETURN PROC])
(TEDIT-SEE
[LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 13-Oct-2021 10:00 by rmk:")
(* ; "Edited 27-Feb-2021 20:07 by rmk:")
(* ; "Edited 1-Feb-88 19:00 by bvm:")
(* ;; "See FILE in a scrollable READONLY TEDIT window. If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.")
(* ;; "FORMAT for text files defaults to :UTF-8 if present, otherwise *DEFAULT-EXTERNALFORMAT*")
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
(LET ((SEESTREAM STREAM)
TSTREAM)
(* ;; "No need to fiddle with a TEDIT file")
(IF (\TEDIT.FORMATTEDP1 STREAM)
ELSEIF (LISPSOURCEFILEP STREAM)
THEN
(* ;; "Lisp source file")
(SETQ SEESTREAM (OPENTEXTSTREAM))
(DSPFONT DEFAULTFONT SEESTREAM)
(COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
ELSE
(* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.")
(* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).")
(SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8)
:DEFAULT))
(CL:UNLESS (RANDACCESSP STREAM)
(SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
(COPYCHARS STREAM SEESTREAM)))
[SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL
`(READONLY T FONT ,DEFAULTFONT]
(WINDOWPROP (WFROMDS TSTREAM)
'TITLE
(CONCAT "SEE window for " (FULLNAME STREAM)))
(FULLNAME STREAM])
(TEDIT.CHARWIDTH
[LAMBDA (CH FONT TERMSA) (* jds "22-OCT-83 19:32")
@@ -2192,7 +2236,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
(* ; "TEDIT Support information")
(RPAQQ TEDITSYSTEMDATE "19-Apr-2018 12:22:04")
(RPAQQ TEDITSYSTEMDATE "13-Oct-2021 10:00:40")
(RPAQ TEDITSUPPORT "TEditSupport.PA")
(DEFINEQ
@@ -2216,21 +2260,21 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993,
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
(EXTENSION (TEDIT))))
(PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
1992 1993 1995 1999 2018))
1992 1993 1995 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4382 115216 (\TEDIT2 4392 . 7143) (COERCETEXTOBJ 7145 . 15921) (TEDIT 15923 . 20892) (
TEDIT.CHARWIDTH 20894 . 22918) (TEDIT.COPY 22920 . 31356) (TEDIT.DELETE 31358 . 32048) (
TEDIT.DO.BLUEPENDINGDELETE 32050 . 35117) (TEDIT.INSERT 35119 . 40649) (TEDIT.KILL 40651 . 42208) (
TEDIT.MAPLINES 42210 . 43609) (TEDIT.MAPPIECES 43611 . 44567) (TEDIT.MOVE 44569 . 54353) (TEDIT.QUIT
54355 . 56355) (TEDIT.STRINGWIDTH 56357 . 57028) (TEDIT.\INSERT 57030 . 59055) (TEXTOBJ 59057 . 60182)
(TEXTSTREAM 60184 . 61799) (\TEDIT.INCLUDE 61801 . 65701) (\TEDIT.INSERT.PIECES 65703 . 75618) (
\TEDIT.MOVE.PIECEMAPFN 75620 . 77699) (\TEDIT.OBJECT.SHOWSEL 77701 . 81330) (\TEDIT.RESTARTFN 81332 .
83327) (\TEDIT.CHARDELETE 83329 . 87291) (\TEDIT.COPY.PIECEMAPFN 87293 . 90518) (\TEDIT.DELETE 90520
. 98038) (\TEDIT.DIFFUSE.PARALOOKS 98040 . 100804) (\TEDIT.FOREIGN.COPY? 100806 . 104533) (
\TEDIT.QUIT 104535 . 107681) (\TEDIT.WORDDELETE 107683 . 112516) (\TEDIT1 112518 . 115214)) (115330
115446 (\CREATE.TEDIT.RESTART.MENU 115340 . 115444)) (115545 119234 (PLCHAIN 115555 . 115829) (
PRINTLINE 115831 . 118595) (SEEFILE 118597 . 119232)) (119275 138918 (TEDIT.INSERT.OBJECT 119285 .
128362) (TEDIT.EDIT.OBJECT 128364 . 130620) (TEDIT.FIND.OBJECT 130622 . 131515) (
TEDIT.FIND.OBJECT.SUBTREE 131517 . 132323) (TEDIT.PUT.OBJECT 132325 . 133984) (TEDIT.GET.OBJECT 133986
. 137185) (TEDIT.OBJECT.CHANGED 137187 . 138916)) (139196 139559 (MAKETEDITFORM 139206 . 139557)))))
(FILEMAP (NIL (4330 117453 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) (
TEDIT-SEE 20842 . 23129) (TEDIT.CHARWIDTH 23131 . 25155) (TEDIT.COPY 25157 . 33593) (TEDIT.DELETE
33595 . 34285) (TEDIT.DO.BLUEPENDINGDELETE 34287 . 37354) (TEDIT.INSERT 37356 . 42886) (TEDIT.KILL
42888 . 44445) (TEDIT.MAPLINES 44447 . 45846) (TEDIT.MAPPIECES 45848 . 46804) (TEDIT.MOVE 46806 .
56590) (TEDIT.QUIT 56592 . 58592) (TEDIT.STRINGWIDTH 58594 . 59265) (TEDIT.\INSERT 59267 . 61292) (
TEXTOBJ 61294 . 62419) (TEXTSTREAM 62421 . 64036) (\TEDIT.INCLUDE 64038 . 67938) (\TEDIT.INSERT.PIECES
67940 . 77855) (\TEDIT.MOVE.PIECEMAPFN 77857 . 79936) (\TEDIT.OBJECT.SHOWSEL 79938 . 83567) (
\TEDIT.RESTARTFN 83569 . 85564) (\TEDIT.CHARDELETE 85566 . 89528) (\TEDIT.COPY.PIECEMAPFN 89530 .
92755) (\TEDIT.DELETE 92757 . 100275) (\TEDIT.DIFFUSE.PARALOOKS 100277 . 103041) (\TEDIT.FOREIGN.COPY?
103043 . 106770) (\TEDIT.QUIT 106772 . 109918) (\TEDIT.WORDDELETE 109920 . 114753) (\TEDIT1 114755 .
117451)) (117567 117683 (\CREATE.TEDIT.RESTART.MENU 117577 . 117681)) (117782 121471 (PLCHAIN 117792
. 118066) (PRINTLINE 118068 . 120832) (SEEFILE 120834 . 121469)) (121512 141155 (TEDIT.INSERT.OBJECT
121522 . 130599) (TEDIT.EDIT.OBJECT 130601 . 132857) (TEDIT.FIND.OBJECT 132859 . 133752) (
TEDIT.FIND.OBJECT.SUBTREE 133754 . 134560) (TEDIT.PUT.OBJECT 134562 . 136221) (TEDIT.GET.OBJECT 136223
. 139422) (TEDIT.OBJECT.CHANGED 139424 . 141153)) (141433 141796 (MAKETEDITFORM 141443 . 141794)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

View File

@@ -1,9 +1,9 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "30-Apr-2021 17:26:58" ("compiled on "
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "29-Apr-2021 09:48:40" brecompiled
exprs%: nothing in "Medley Full Sysout 30-Apr-2021 ..." dated "30-Apr-2021 14:49:58")
(FILECREATED "30-Apr-2021 17:26:17" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2
86155 previous date%: "25-Aug-94 10:53:00"
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Sep-2021 12:53:57" ("compiled on "
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2) "20-Sep-2021 11:14:12" brecompiled
exprs%: nothing in "FULL 20-Sep-2021 ..." dated "20-Sep-2021 11:14:18")
(FILECREATED "21-Sep-2021 12:53:57" {DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;2
86549 changes to%: (VARS TEDITDCLCOMS) previous date%: "30-Apr-2021 17:26:17"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITDCL.;1)
(PRETTYCOMPRINT TEDITDCLCOMS)
(RPAQQ TEDITDCLCOMS ((* ;;;
@@ -38,7 +38,9 @@ WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (REDO.TTC 5) (UNDO.TTC 6)
8) (EXPAND.TTC 9) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))) (DECLARE%: EVAL@COMPILE DONTCOPY
(CONSTANTS (MSPACE 153) (NSPACE 152) (THINSPACE 159) (FIGSPACE 154))) (* ;; "FROM TEDITWINDOW") (
DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITCARET)) (INITRECORDS TEDITCARET) (* ;;
"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;;; "THE END") (COMS (* ;;
"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;; "FROM TEDITHCPY and TEDITSCREEN") (DECLARE%:
EVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) (* ;;; "THE END") (
COMS (* ;;
"Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character "
) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NOTBEFORE.LB 1) (* ;
"Must not break before this character (e.g. Japanese right-paren)") (NOTAFTER.LB 2) (* ;

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jun-2021 12:35:45" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;2 105754
(FILECREATED "21-Sep-2021 15:33:24" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;10 106458
changes to%: (FNS \TEDIT.HARDCOPY.FORMATLINE)
changes to%: (FNS TEDIT.HARDCOPYFN)
(VARS TEDITHCPYCOMS)
previous date%: "25-Aug-94 10:54:07"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;1)
previous date%: "21-Sep-2021 12:54:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;7)
(* ; "
@@ -20,43 +21,48 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
(FILES (LOADCOMP)
TEDITDCL))
(COMS
(* ;; "Generic interface functions and common code")
(* ;; "Generic interface functions and common code")
(FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
\TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS
\TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX))
(COMS
(* ;; "Functions for scaling distances and regions as needed during hardcopy.")
(* ;; "Functions for scaling distances and regions as needed during hardcopy.")
(FNS \TEDIT.SCALE \TEDIT.SCALEREGION))
(COMS
(* ;; "PRESS-specific code")
(* ;; "PRESS-specific code")
(VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
(* ;
 "0.75 inches from bottom, 1 from top")
(* ;
 "0.75 inches from bottom, 1 from top")
)
[COMS
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
(P (LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
'TEDIT
(FUNCTION \TEDIT.HARDCOPY)))
(P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
(COND (PRESSVALUES (* ;
 "Only install PRESS printing if PRESS is loaded.")
(COND (PRESSVALUES (* ;
 "Only install PRESS printing if PRESS is loaded.")
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
(COMS
(* ;; "vars for Japanese Line Break")
[COMS
(* ;; "vars for Japanese Line Break")
[VARS (TEDIT.DONT.BREAK.CHARS '(8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251
9253 9255 9257 9283 9315 9317 9319 9326 9505 9507
9509 9511 9513 9539 9571 9573 9575 9582))
(TEDIT.DONT.LAST.CHARS '(8524 8538 8536 8534]
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))
(INITVARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74"
"41,115" "41,133" "41,131" "41,127"
"Hira,41" "Hira,43" "Hira,45"
"Hira,47" "Hira,51" "Hira,103"
"Hira,143" "Hira,145" "Hira,147"
"Hira,156" "Kata,41" "Kata,43"
"Kata,45" "Kata,47" "Kata,51"
"Kata,103" "Kata,143" "Kata,145"
"Kata,147" "Kata,156")))
(TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126"]
(COMS
(* ;; "Support for hardcopying several files as one document")
(* ;; "Support for hardcopying several files as one document")
(FNS TEDIT-BOOK))))
@@ -1512,22 +1518,22 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
(DEFINEQ
(TEDIT.HARDCOPYFN
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 12-Jun-90 18:35 by mitani")
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 21-Sep-2021 15:33 by rmk:")
(* ;;
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
(* ;;
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
(PROG ((TEXTOBJ (TEXTOBJ WINDOW))
(TEXTSTREAM (TEXTSTREAM WINDOW)))
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
(RESETLST
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
'(AND (\TEDIT.MARKINACTIVE OLDVALUE]
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with 'Hardcopy)
(TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))) (* ; "Build the hardcopy")
])
(* ; "Build the hardcopy")
(TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))])
(\TEDIT.HARDCOPY
[LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:35 by mitani")
@@ -1568,8 +1574,8 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
[LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
(COND
(PRESSVALUES (* ;
 "Only install PRESS printing if PRESS is loaded.")
(PRESSVALUES (* ;
 "Only install PRESS printing if PRESS is loaded.")
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
@@ -1577,15 +1583,13 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
(* ;; "vars for Japanese Line Break")
(RPAQQ TEDIT.DONT.BREAK.CHARS (8482 8483 8491 8492 8508 8525 8539 8537 8535 9249 9251 9253 9255
9257 9283 9315 9317 9319 9326 9505 9507 9509 9511 9513 9539
9571 9573 9575 9582))
(RPAQ? TEDIT.DONT.BREAK.CHARS
(CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133" "41,131" "41,127"
"Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143"
"Hira,145" "Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47"
"Kata,51" "Kata,103" "Kata,143" "Kata,145" "Kata,147" "Kata,156")))
(RPAQQ TEDIT.DONT.LAST.CHARS (8524 8538 8536 8534))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
)
(RPAQ? TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126")))
@@ -1612,11 +1616,11 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
(PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1991 1992 1993 1994 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3088 99806 (TEDIT.HARDCOPY 3098 . 4349) (TEDIT.HCPYFILE 4351 . 6425) (
\TEDIT.HARDCOPY.DISPLAYLINE 6427 . 20572) (\TEDIT.HARDCOPY.FORMATLINE 20574 . 67896) (
\DOFORMATTING.HARDCOPY 67898 . 81191) (\TEDIT.HARDCOPY.MODIFYLOOKS 81193 . 83600) (
\TEDIT.HCPYLOOKS.UPDATE 83602 . 94210) (\TEDIT.HCPYFMTSPEC 94212 . 99232) (\TEDIT.INTEGER.IMAGEBOX
99234 . 99804)) (99895 100979 (\TEDIT.SCALE 99905 . 100199) (\TEDIT.SCALEREGION 100201 . 100977)) (
101222 103719 (TEDIT.HARDCOPYFN 101232 . 102083) (\TEDIT.HARDCOPY 102085 . 102994) (
\TEDIT.PRESS.HARDCOPY 102996 . 103717)) (104701 105604 (TEDIT-BOOK 104711 . 105602)))))
(FILEMAP (NIL (3655 100373 (TEDIT.HARDCOPY 3665 . 4916) (TEDIT.HCPYFILE 4918 . 6992) (
\TEDIT.HARDCOPY.DISPLAYLINE 6994 . 21139) (\TEDIT.HARDCOPY.FORMATLINE 21141 . 68463) (
\DOFORMATTING.HARDCOPY 68465 . 81758) (\TEDIT.HARDCOPY.MODIFYLOOKS 81760 . 84167) (
\TEDIT.HCPYLOOKS.UPDATE 84169 . 94777) (\TEDIT.HCPYFMTSPEC 94779 . 99799) (\TEDIT.INTEGER.IMAGEBOX
99801 . 100371)) (100462 101546 (\TEDIT.SCALE 100472 . 100766) (\TEDIT.SCALEREGION 100768 . 101544)) (
101789 104340 (TEDIT.HARDCOPYFN 101799 . 102704) (\TEDIT.HARDCOPY 102706 . 103615) (
\TEDIT.PRESS.HARDCOPY 103617 . 104338)) (105405 106308 (TEDIT-BOOK 105415 . 106306)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Aug-2021 23:30:39" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;3 185251
changes to%: (FNS \TEDIT.BUTTONEVENTFN TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE)
(FILECREATED "16-Oct-2021 18:52:11" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18 187780
previous date%: "21-Jun-99 20:00:42"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;1)
changes to%: (FNS TEDIT.DEACTIVATE.WINDOW)
previous date%: "12-Oct-2021 15:10:06"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;17)
(* ; "
@@ -25,33 +26,36 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
\TEDIT.WINDOW.OPS \TEDIT.EXPANDFN \TEDIT.MAINW \TEDIT.PRIMARYW \TEDIT.COPYINSERTFN
\TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN
\TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.WINDOW.SETUP \SAFE.FIRST)
(INITVARS (\TEDIT.OP.WIDTH 12)
(\TEDIT.OP.BOTTOM 12))
(DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM))
(CURSORS BXCARET BXHICARET TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR
\TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR)
(INITVARS (TEDIT.DEFAULT.WINDOW NIL))
(GLOBALVARS TEDIT.DEFAULT.WINDOW)
(COMS (* ;
 "User-level %"is this a TEdit window?%" function.")
(COMS (* ;
 "User-level %"is this a TEdit window?%" function.")
(FNS TEDITWINDOWP))
(COMS (* ; "User-typein support")
(COMS (* ; "User-typein support")
(FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME))
(COMS (* ; "Attached Prompt window support.")
(COMS (* ; "Attached Prompt window support.")
(FNS TEDIT.PROMPTPRINT TEDIT.PROMPTFLASH \TEDIT.PROMPT.PAGEFULLFN)
(INITVARS (TEDIT.PROMPT.FONT (FONTCREATE 'GACHA 10))
(TEDIT.PROMPTWINDOW.HEIGHT NIL))
(GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT))
(COMS (* ; "Title creation and update")
(COMS (* ; "Title creation and update")
(FNS TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE \TEDIT.WINDOW.TITLE
\TEXTSTREAM.FILENAME))
(COMS (* ; "Screen updating utilities")
(COMS (* ; "Screen updating utilities")
(FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.REPAINTFN \TEDIT.RESHAPEFN \TEDIT.SCROLLFN))
(COMS (* ; "Process-world interfaces")
(COMS (* ; "Process-world interfaces")
(FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN))
(COMS (INITVARS (\CARETRATE 333))
(* ;
 "Caret handler; stolen from CHAT.")
(* ;
 "Caret handler; stolen from CHAT.")
(FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET
TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET))
[COMS (* ; "Menu interfacing")
[COMS (* ; "Menu interfacing")
(FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU
\TEDIT.MENU.WHENHELDFN \TEDIT.MENU.WHENSELECTEDFN)
(GLOBALVARS TEDIT.DEFAULT.MENU)
@@ -79,21 +83,21 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
'(TEdit '(TEDIT)
"Opens a TEdit window for use."]
(SETQ BackgroundMenu NIL]
(COMS (* ; "titled icon info")
(COMS (* ; "titled icon info")
(FILES ICONW)
(BITMAPS TEDITICON TEDITMASK)
(INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD))
[TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]
(* ;
 "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
(* ;
 "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
[TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS
TEDIT.ICON.TITLE.REGION
NIL]
(* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
(* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")
(* ;
 "Changed by yabu.fx, for SUNLOADUP without DWIM.")
])
(FILESLOAD TEDITDCL)
@@ -156,7 +160,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
TEDIT.DEFAULT.WINDOW])
(TEDIT.CURSORMOVEDFN
[LAMBDA (W) (* ; "Edited 30-May-91 23:39 by jds")
[LAMBDA (W) (* ; "Edited 12-Oct-2021 13:14 by rmk:")
(* Watch the mouse and change the cursor to reflect the region of the window
 it's in (line select, window split eventually?))
@@ -187,13 +191,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
of LINE]
(SELECTQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ)
(TEXT [COND
((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT)
of TEXTOBJ)
8)))
((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT)
of TEXTOBJ)
\TEDIT.OP.WIDTH)))
(IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)
\TEDIT.OP.BOTTOM)))
(* ;; "The region to the right of text, for splitting operations.")
(CURSOR \TEDIT.SPLITCURSOR)
(replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'WINDOW)
(replace LEFT of CURSORREG with LEFT)
(replace WIDTH of CURSORREG with 8))
(replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH))
([ILESSP X (SETQ LEFT
(OR [AND LINE (COND
((fetch (FMTSPEC FMTHARDCOPY)
@@ -221,13 +230,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
of TEXTOBJ)
(IPLUS LEFT 8])
(LINE (COND
((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT)
of TEXTOBJ)
8)))
((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT)
of TEXTOBJ)
\TEDIT.OP.WIDTH)))
(IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)
\TEDIT.OP.BOTTOM)))
(CURSOR \TEDIT.SPLITCURSOR)
(replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'WINDOW)
(replace LEFT of CURSORREG with LEFT)
(replace WIDTH of CURSORREG with 8))
(replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH))
[[IGEQ X (SETQ LEFT (OR [AND LINE (COND
((fetch (FMTSPEC FMTHARDCOPY)
of (fetch (
@@ -256,13 +267,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(T (replace LEFT of CURSORREG with 0)
(replace WIDTH of CURSORREG with LEFT))))
(WINDOW (COND
((IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT)
of TEXTOBJ)
8)))
((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT)
of TEXTOBJ)
\TEDIT.OP.WIDTH)))
(IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)
\TEDIT.OP.BOTTOM)))
(replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with
'WINDOW)
(replace LEFT of CURSORREG with LEFT)
(replace WIDTH of CURSORREG with 8))
(replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH))
([IGEQ X (SETQ LEFT
(OR [AND LINE (COND
((fetch (FMTSPEC FMTHARDCOPY)
@@ -454,355 +467,359 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(PROCESSP (WINDOWPROP W 'PROCESS])
(\TEDIT.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 24-Aug-2021 23:30 by rmk:")
[LAMBDA (W STREAM) (* ; "Edited 19-Sep-2021 22:58 by rmk:")
(* ;; "Handle button events for a TEdit window")
(* ;; "Handle button events for a TEdit window. If no button is down, we got control on button-up transition, so ignore it.")
(AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
(PROG* ((OSEL NIL)
(SEL NIL)
[TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
(DS (WINDOWPROP W 'DSP))
USERFN
(GLOBALSEL TEDIT.SELECTION)
(X (LASTMOUSEX W))
(Y (LASTMOUSEY W))
(CLIPREGION (DSPCLIPPINGREGION NIL W))
(SELOPERATION 'NORMAL)
(SELFN (TEXTPROP TEXTOBJ 'SELFN))
(EXTENDFLG NIL)
(OLDX -32000)
(OLDY -32000)
SELFINALFN PROC NOSEL)
(COND
((NOT (MOUSESTATE (OR LEFT MIDDLE RIGHT))) (* ;
 "No button is down -- we got control on button-up transition, so ignore it.")
(RETURN))
(TEDIT.SELPENDING (* ;
 "There is already a selection in progress. Don't allow another to interfere.")
(RETURN)))
(replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0)
(* ;
 "Mark the user-visible scratch selection fresh, so changes can be detected...")
(COND
[[OR (NOT TEXTOBJ)
(fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
(AND (NOT (WINDOWPROP W 'PROCESS))
(NOT (TEXTPROP TEXTOBJ 'READONLY))
(NOT (SHIFTDOWNP 'SHIFT))
(NOT (SHIFTDOWNP 'CTRL))
(NOT (SHIFTDOWNP 'META))
(NOT (KEYDOWNP 'MOVE))
(NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.")
(TOTOPW W)
(COND
((\TEDIT.MOUSESTATE RIGHT) (* ;
 "Right button gets the window command menu")
(DOWINDOWCOM W))
((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
(NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
[NOT (PROCESSP (WINDOWPROP W 'PROCESS]
(\TEDIT.MOUSESTATE MIDDLE)) (* ;
 "Middle button on a dead window gives a menu for re-starting TEDIT")
(COND
((EQ (MENU TEDIT.RESTART.MENU)
'NewEditProcess)
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
(TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
W]
[(IGREATERP Y (fetch TOP of CLIPREGION))
(* ;
 "It's not inside the window's REAL region, so call on a menu.")
(TOTOPW W)
(TOTOPW W)
(* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.")
(* ;; "RMK: 2021/9 TOTOPW was in (almost) all the conditional branches, I moved it up so that it always happens, even if the click is perhaps in a menu. There were cases where a second click in the window was needed to bring it above an overlapping window that it was under. I think perhaps it was because the mouse button may not have been seen as down on the first click, so it would return before it raised the window. But that was really bizarre--maybe the click was to see what was obscured by the overlapping window.")
(* ;; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")
(CL:WHEN (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
(NOT TEDIT.SELPENDING))
(COND
((\TEDIT.MOUSESTATE RIGHT)
(DOWINDOWCOM W))
((MOUSESTATE (OR LEFT MIDDLE))
(AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
(NEQ USERFN 'DON'T)
(ADD.PROCESS (LIST USERFN (KWOTE W]
((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ)
'WINDOW)) (* ;
 "We're in the window-ops region of the window. Do a window split or something")
(\TEDIT.WINDOW.OPS TEXTOBJ W))
((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
(* ;
 "Usual case -- he's really selecting something. And there's nothing else going on now.")
(TOTOPW W) (* ;
 "Move the editing window to the top, so he can select wherever he wants.")
(\CARET.DOWN) (* ;
 "Make sure the caret isn't being displayed.")
(RESETLST
(RESETSAVE TEDIT.SELPENDING TEXTOBJ)
(* ;; "(RMK: old comment): Bail out if the mouse isn't down or there is a pending selection--don't want another selection to interfere.")
(* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.")
(AND STREAM (SETQ STREAM (TEXTOBJ STREAM)))
[LET* ((OSEL NIL)
(SEL NIL)
[TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ]
(DS (WINDOWPROP W 'DSP))
USERFN
(GLOBALSEL TEDIT.SELECTION)
(X (LASTMOUSEX W))
(Y (LASTMOUSEY W))
(CLIPREGION (DSPCLIPPINGREGION NIL W))
(SELOPERATION 'NORMAL)
(SELFN (TEXTPROP TEXTOBJ 'SELFN))
(EXTENDFLG NIL)
(OLDX -32000)
(OLDY -32000)
SELFINALFN PROC NOSEL)
(replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0)
(* ;
 "Mark the user-visible scratch selection fresh, so changes can be detected...")
(COND
[[OR (NOT TEXTOBJ)
(fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
(AND (NOT (WINDOWPROP W 'PROCESS))
(NOT (TEXTPROP TEXTOBJ 'READONLY))
(NOT (SHIFTDOWNP 'SHIFT))
(NOT (SHIFTDOWNP 'CTRL))
(NOT (SHIFTDOWNP 'META))
(NOT (KEYDOWNP 'MOVE))
(NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.")
(COND
((\TEDIT.MOUSESTATE RIGHT) (* ;
 "Right button gets the window command menu")
(DOWINDOWCOM W))
((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY))
(NOT (TEXTPROP TEXTOBJ 'SELECTONLY))
[NOT (PROCESSP (WINDOWPROP W 'PROCESS]
(\TEDIT.MOUSESTATE MIDDLE)) (* ;
 "Middle button on a dead window gives a menu for re-starting TEDIT")
(COND
((EQ (MENU TEDIT.RESTART.MENU)
'NewEditProcess)
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL)
(TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
W]
[(IGREATERP Y (fetch TOP of CLIPREGION))
(* ;
 "It's not inside the window's REAL region, so call on a menu.")
(RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
do (replace TCCARET of CARET with (\CARET.CREATE
BXHICARET)))
(LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ)))
(* ;
 "Then make the caret be the special, tall one so he can see it.")
(COND
((KEYDOWNP 'COPY) (* ;
 "In a read-only document, you can only copy.")
(SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPY))
((AND (KEYDOWNP 'MOVE)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ;
 "The MOVE key is down, so set MOVE mode.")
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
(SETQ SELOPERATION 'MOVE))
[(SHIFTDOWNP 'SHIFT) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(COND
((AND (SHIFTDOWNP 'CTRL)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ; "CTRL-SHIFT select means MOVE.")
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
(SETQ SELOPERATION 'MOVE))
(T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPY]
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down , do a copylooks selection")
(SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPYLOOKS))
((AND (SHIFTDOWNP 'CTRL)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ;
 "He's holding the control key down; note the fact.")
(\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
NIL NIL)
(SETQ GLOBALSEL TEDIT.DELETESELECTION)
[COND
((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL)
of TEXTOBJ))
(* ;
 "There's a pending delete selection. Use it, and turn off the existing normal selection.")
)
(T (* ;
 "No existing delete selection. Use the normal selection as a starting point.")
(\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ]
(replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ)
with NIL)
(* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.")
(* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")
(* ;; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))")
(SETQ OSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
(SETQ SELOPERATION 'DELETE)
(TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL))
(T (SETQ OSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL)
(* ; "Reset the pending-delete flag.")
))
(\COPYSEL OSEL GLOBALSEL)
(bind (OSELOP _ SELOPERATION)
while [OR (SHIFTDOWNP 'SHIFT)
(SHIFTDOWNP 'CTRL)
(SHIFTDOWNP 'META)
(KEYDOWNP 'MOVE)
(KEYDOWNP 'COPY)
(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
do (* ;
 "Poll the selection & display its current state")
[COND
((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
(* ;
 "No mouse buttons are down; don't try anything.")
(SETQ OLDX -32000) (* ;
 "However, remember that pushing a mouse button is a change of status that we should notice.")
)
((KEYDOWNP 'MOVE) (* ;
 "the MOVE key is down; mark this selection for MOVE.")
(SETQ SELOPERATION 'MOVE))
[(OR (SHIFTDOWNP 'SHIFT)
(KEYDOWNP 'COPY)) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(COND
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding down both ctrl and shift -- do a move.")
(SETQ SELOPERATION 'MOVE))
(T (* ;
 "Just the SHIFT key. It's a COPY")
(SETQ SELOPERATION 'COPY]
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down; note the fact.")
(SETQ SELOPERATION 'COPYLOOKS))
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding only the CTRL key -- mark the selection for deletion.")
(SETQ SELOPERATION 'DELETE))
(T (* ;
 "No key being held down; revert to normal selection.")
(SETQ SELOPERATION 'NORMAL]
(COND
[(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
[NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
(NEQ OSELOP SELOPERATION))
(INSIDEP CLIPREGION X Y))
(COND
((\TEDIT.MOUSESTATE RIGHT)
(DOWINDOWCOM W))
((MOUSESTATE (OR LEFT MIDDLE))
(AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN))
(NEQ USERFN 'DON'T)
(ADD.PROCESS (LIST USERFN (KWOTE W]
((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ)
'WINDOW)) (* ;
 "We're in the window-ops region of the window. Do a window split or something")
(\TEDIT.WINDOW.OPS TEXTOBJ W))
((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)))
(* ;
 "Usual case -- he's really selecting something. And there's nothing else going on now.")
(\CARET.DOWN) (* ;
 "Make sure the caret isn't being displayed.")
(RESETLST
(RESETSAVE TEDIT.SELPENDING TEXTOBJ)
(* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")
(* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.")
(* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")
(RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
do (replace TCCARET of CARET with (\CARET.CREATE
BXHICARET)))
(LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ)))
(* ;
 "Then make the caret be the special, tall one so he can see it.")
(COND
((KEYDOWNP 'COPY) (* ;
 "In a read-only document, you can only copy.")
(SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPY))
((AND (KEYDOWNP 'MOVE)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ;
 "The MOVE key is down, so set MOVE mode.")
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
(SETQ SELOPERATION 'MOVE))
[(SHIFTDOWNP 'SHIFT) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(COND
((AND (SHIFTDOWNP 'CTRL)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ; "CTRL-SHIFT select means MOVE.")
(SETQ GLOBALSEL TEDIT.MOVESELECTION)
(SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))
(SETQ SELOPERATION 'MOVE))
(T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPY]
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down , do a copylooks selection")
(SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION)
(SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))
(SETQ SELOPERATION 'COPYLOOKS))
((AND (SHIFTDOWNP 'CTRL)
(NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)))
(* ;
 "He's holding the control key down; note the fact.")
(\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
NIL NIL)
(SETQ GLOBALSEL TEDIT.DELETESELECTION)
[COND
((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL)
of TEXTOBJ))
(* ;
 "There's a pending delete selection. Use it, and turn off the existing normal selection.")
)
(T (* ;
 "No existing delete selection. Use the normal selection as a starting point.")
(\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
(fetch (TEXTOBJ DELETESEL) of TEXTOBJ]
(replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ
) with NIL)
(SETQ OLDX X)
(SETQ OLDY Y)
[COND
((\TEDIT.MOUSESTATE LEFT) (* ;
 "Left button is character selection")
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
MOUSEREGION
)
of TEXTOBJ)
NIL SELOPERATION W))
(SETQ EXTENDFLG NIL))
((\TEDIT.MOUSESTATE MIDDLE)
(* ; "Middle button is word selection")
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
MOUSEREGION
)
of TEXTOBJ)
T SELOPERATION W))
(SETQ EXTENDFLG NIL))
[(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections")
(COND
((NEQ SELOPERATION OSELOP)
(* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.")
(* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")
(\COPYSEL OSEL GLOBALSEL)))
(COND
((fetch (SELECTION SET) of GLOBALSEL)
(AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
'NORMAL)
(SETQ SELOPERATION 'PENDINGDEL)
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ
with T)) (* ;
 "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")
(SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ
SELOPERATION W))
(SETQ EXTENDFLG T]
(T (* ;
 "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")
(\COPYSEL OSEL GLOBALSEL)
(* ;
 "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")
(AND SEL (replace (SELECTION SET) of SEL with
NIL]
[COND
((AND SEL (fetch (SELECTION SET) of SEL)
SELFN) (* ;
 "The selection was set, but there's a SELFN that has veto authority")
(COND
((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
'DON'T) (* ;
 "The selfn vetoed this selection, so mark it un-set.")
(replace (SELECTION SET) of SEL with NIL]
(COND
((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
(* ;
 "Something interesting about the selection changed. We have to re-display its image.")
(COND
((OR (EQ SELOPERATION 'NORMAL)
(EQ SELOPERATION 'PENDINGDEL))
(* ;
 "For a normal selection, set the 'window last selected in' for the TEXTOBJ")
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ with
W)))
(SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP
SELOPERATION EXTENDFLG))
(SETQ OSELOP SELOPERATION))
([AND OSEL (fetch (SELECTION SET) of OSEL)
(EQ (fetch (SELECTION SELKIND) of OSEL)
'VOLATILE)
(OR (NOT SEL)
(NOT (fetch (SELECTION SET) of SEL]
(* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.")
(\SHOWSEL OSEL NIL NIL)
(replace (SELECTION SET) of OSEL with NIL]
((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
(* ;
 "If he moves to the scroll bar, let him scroll without trouble")
(SCROLL.HANDLER W)))
(BLOCK) (* ; "Give other processes a chance")
(GETMOUSESTATE) (* ; "And get the new mouse info")
(TEDIT.CURSORMOVEDFN W))
(\COPYSEL OSEL GLOBALSEL)
(COND
((fetch (SELECTION SET) of OSEL)
(* ;
 "Only if a selection REALLY got made should we do this....")
(SELECTQ SELOPERATION
(COPY (* ;
 "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")
(SETQ TEDIT.COPY.PENDING T)
(replace (SELECTION SET) of OSEL with NIL)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(\TEDIT.FOREIGN.COPY? GLOBALSEL)
(* ;
 "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")
)
(COPYLOOKS (* ; "A COPYLOOKS selection")
(SETQ TEDIT.COPYLOOKS.PENDING T)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(replace (SELECTION SET) of OSEL with NIL))
(MOVE (* ;
 "A MOVE selection -- set the flag to signal the TEdit command loop,")
(SETQ TEDIT.MOVE.PENDING T) (* ;
 "And turn off OSEL, to avoid spurious highlighting")
(replace (SELECTION SET) of OSEL with NIL))
(DELETE (SETQ TEDIT.DEL.PENDING T)
(replace (SELECTION SET) of OSEL with NIL)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(SETQ OSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))
(SETQ SELOPERATION 'DELETE)
(TEDIT.SET.SEL.LOOKS OSEL 'DELETE)
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL))
(T (SETQ OSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL)
(* ; "Reset the pending-delete flag.")
))
(\COPYSEL OSEL GLOBALSEL)
(bind (OSELOP _ SELOPERATION)
while [OR (SHIFTDOWNP 'SHIFT)
(SHIFTDOWNP 'CTRL)
(SHIFTDOWNP 'META)
(KEYDOWNP 'MOVE)
(KEYDOWNP 'COPY)
(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7]
do (* ;
 "Poll the selection & display its current state")
[COND
((ZEROP (LOGAND LASTMOUSEBUTTONS 7))
(* ;
 "No mouse buttons are down; don't try anything.")
(SETQ OLDX -32000) (* ;
 "However, remember that pushing a mouse button is a change of status that we should notice.")
)
(NORMAL (* ;
 "This is a normal selection; set the caret looks")
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
NIL)))
(AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
(* ;
 "Give a user exit routine control, perhaps for logging of selections.")
(for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
do (OR (fetch TCUP of CARET)
(\EDIT.FLIPCARET CARET T))))
(AND OSEL (fetch (SELECTION SET) of OSEL)
(fetch (SELECTION SELOBJ) of OSEL)
(SETQ SELFINALFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of OSEL)
'WHENOPERATEDONFN))
(APPLY* SELFINALFN (fetch (SELECTION SELOBJ) of OSEL)
(WINDOWPROP W 'DSP)
'SELECTED OSEL (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])
((KEYDOWNP 'MOVE) (* ;
 "the MOVE key is down; mark this selection for MOVE.")
(SETQ SELOPERATION 'MOVE))
[(OR (SHIFTDOWNP 'SHIFT)
(KEYDOWNP 'COPY)) (* ;
 "the SHIFT key is down; mark this selection for COPY or MOVE.")
(COND
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding down both ctrl and shift -- do a move.")
(SETQ SELOPERATION 'MOVE))
(T (* ;
 "Just the SHIFT key. It's a COPY")
(SETQ SELOPERATION 'COPY]
((SHIFTDOWNP 'META) (* ;
 "He's holding the meta key down; note the fact.")
(SETQ SELOPERATION 'COPYLOOKS))
((SHIFTDOWNP 'CTRL) (* ;
 "He's holding only the CTRL key -- mark the selection for deletion.")
(SETQ SELOPERATION 'DELETE))
(T (* ;
 "No key being held down; revert to normal selection.")
(SETQ SELOPERATION 'NORMAL]
(COND
[(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS]
[NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS]
(NEQ OSELOP SELOPERATION))
(INSIDEP CLIPREGION X Y))
(* ;; "Only do selection if (1) the mouse is inside the window proper and (2) the mouse has moved, or the kind of selection has changed")
(* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)")
(SETQ OLDX X)
(SETQ OLDY Y)
[COND
((\TEDIT.MOUSESTATE LEFT)
(* ;
 "Left button is character selection")
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
MOUSEREGION
)
of TEXTOBJ)
NIL SELOPERATION W))
(SETQ EXTENDFLG NIL))
((\TEDIT.MOUSESTATE MIDDLE)
(* ; "Middle button is word selection")
(SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ
MOUSEREGION
)
of TEXTOBJ)
T SELOPERATION W))
(SETQ EXTENDFLG NIL))
[(\TEDIT.MOUSESTATE RIGHT)
(* ; "RIght button extends selections")
(COND
((NEQ SELOPERATION OSELOP)
(* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.")
(\COPYSEL OSEL GLOBALSEL)))
(COND
((fetch (SELECTION SET) of GLOBALSEL)
(AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION
'NORMAL)
(SETQ SELOPERATION 'PENDINGDEL)
(replace (TEXTOBJ BLUEPENDINGDELETE) of
TEXTOBJ
with T))
(* ;
 "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.")
(SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ
SELOPERATION W))
(SETQ EXTENDFLG T]
(T (* ;
 "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection")
(\COPYSEL OSEL GLOBALSEL)
(* ;
 "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below")
(AND SEL (replace (SELECTION SET) of SEL
with NIL]
[COND
((AND SEL (fetch (SELECTION SET) of SEL)
SELFN) (* ;
 "The selection was set, but there's a SELFN that has veto authority")
(COND
((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE)
'DON'T) (* ;
 "The selfn vetoed this selection, so mark it un-set.")
(replace (SELECTION SET) of SEL with NIL]
(COND
((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION)
(* ;
 "Something interesting about the selection changed. We have to re-display its image.")
(COND
((OR (EQ SELOPERATION 'NORMAL)
(EQ SELOPERATION 'PENDINGDEL))
(* ;
 "For a normal selection, set the 'window last selected in' for the TEXTOBJ")
(replace (TEXTOBJ SELWINDOW) of TEXTOBJ
with W)))
(SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP
SELOPERATION EXTENDFLG))
(SETQ OSELOP SELOPERATION))
([AND OSEL (fetch (SELECTION SET) of OSEL)
(EQ (fetch (SELECTION SELKIND) of OSEL)
'VOLATILE)
(OR (NOT SEL)
(NOT (fetch (SELECTION SET) of SEL]
(* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.")
(\SHOWSEL OSEL NIL NIL)
(replace (SELECTION SET) of OSEL with NIL]
((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY)
(* ;
 "If he moves to the scroll bar, let him scroll without trouble")
(SCROLL.HANDLER W)))
(BLOCK) (* ; "Give other processes a chance")
(GETMOUSESTATE) (* ; "And get the new mouse info")
(TEDIT.CURSORMOVEDFN W))
(\COPYSEL OSEL GLOBALSEL)
(COND
((fetch (SELECTION SET) of OSEL)
(* ;
 "Only if a selection REALLY got made should we do this....")
(SELECTQ SELOPERATION
(COPY (* ;
 "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window")
(SETQ TEDIT.COPY.PENDING T)
(replace (SELECTION SET) of OSEL with NIL)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(\TEDIT.FOREIGN.COPY? GLOBALSEL)
(* ;
 "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.")
)
(COPYLOOKS (* ; "A COPYLOOKS selection")
(SETQ TEDIT.COPYLOOKS.PENDING T)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(replace (SELECTION SET) of OSEL with NIL))
(MOVE (* ;
 "A MOVE selection -- set the flag to signal the TEdit command loop,")
(SETQ TEDIT.MOVE.PENDING T)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
(replace (SELECTION SET) of OSEL with NIL))
(DELETE (SETQ TEDIT.DEL.PENDING T)
(replace (SELECTION SET) of OSEL with NIL)
(* ;
 "And turn off OSEL, to avoid spurious highlighting")
)
(NORMAL (* ;
 "This is a normal selection; set the caret looks")
(replace (TEXTOBJ CARETLOOKS) of TEXTOBJ
with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL)))
NIL)))
(AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL))
(* ;
 "Give a user exit routine control, perhaps for logging of selections.")
(for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ)
do (OR (fetch TCUP of CARET)
(\EDIT.FLIPCARET CARET T))))
(AND OSEL (fetch (SELECTION SET) of OSEL)
(fetch (SELECTION SELOBJ) of OSEL)
(SETQ SELFINALFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of OSEL)
'WHENOPERATEDONFN))
(APPLY* SELFINALFN (fetch (SELECTION SELOBJ) of OSEL)
(WINDOWPROP W 'DSP)
'SELECTED OSEL (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])])
(\TEDIT.WINDOW.OPS
[LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 30-May-91 23:33 by jds")
[LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 12-Oct-2021 15:01 by rmk:")
(* ;;; "Do window operations for TEdit, e.g., splitting a window, moving the split location, or unsplitting.")
(PROG ([WINDOWOPREGION (create REGION
LEFT _ (DIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)
8)
BOTTOM _ 0
WIDTH _ 8
HEIGHT _ (fetch HEIGHT of (WINDOWPROP WINDOWTOSPLIT
'REGION]
\TEDIT.OP.WIDTH)
BOTTOM _ \TEDIT.OP.BOTTOM
WIDTH _ \TEDIT.OP.WIDTH
HEIGHT _ (fetch (REGION HEIGHT) of (WINDOWPROP
WINDOWTOSPLIT
'REGION]
Y OPERATION)
[while [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
(INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT)
@@ -842,7 +859,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(\TEDIT.UNSPLITW WINDOWTOSPLIT))
(MOVE (* ;
 "Moving the divider between two panes.")
(TEDIT.PROMPTPRINT TEXTOBJ "Can't move the split point yet." T))
(TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T))
(SHOULDNT)))
(T (CURSOR T])
@@ -1363,6 +1380,16 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(CAR LIST.OR.ATOM))
(T LIST.OR.ATOM])
)
(RPAQ? \TEDIT.OP.WIDTH 12)
(RPAQ? \TEDIT.OP.BOTTOM 12)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM)
)
)
(RPAQ BXCARET (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@CH@@CH@@FL@@FL@@LF@@
) (QUOTE NIL) 3 4))
(RPAQ BXHICARET (CURSORCREATE (QUOTE #*(16 16)A@@@A@@@A@@@A@@@A@@@A@@@A@@@A@@@CH@@GL@@FL@@LF@@HB@@@@@@@@@@@@@@
@@ -1676,12 +1703,13 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(DEFINEQ
(TEDIT.DEACTIVATE.WINDOW
[LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 30-May-91 23:34 by jds")
[LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 16-Oct-2021 18:51 by rmk:")
(* ;; "Deactivate the various button fns for this window")
(PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ] (* ;
 "Can't be a call to TEXTOBJ, since window may NOT have a textobj on it.")
(replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T)
[COND
((AND TEXTOBJ (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ))
@@ -1702,6 +1730,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(RETURN 'DON'T]
(COND
([AND TEXTOBJ (OR FORCEFLG (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)
(fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)
(NOT (PROCESSP (WINDOWPROP W 'PROCESS]
(* ;
 "Only do this if it's a TEdit window, and has been QUIT out of.")
@@ -1922,9 +1951,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
])
(\TEDIT.SCROLLFN
[LAMBDA (W DX DY) (* ; "Edited 31-May-91 13:32 by jds")
[LAMBDA (W DX DY) (* ; "Edited 19-Sep-2021 23:10 by rmk:")
(* Handle scrolling of the edit
 window)
(TOTOPW W)
(PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
(PRIORCR 0)
SELWASON SHIFTEDSELWASON MOVESELWASON DELETESELWASON (WREG (DSPCLIPPINGREGION
@@ -2826,25 +2856,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
(PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988
1989 1990 1991 1993 1994 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7165 91937 (TEDIT.CREATEW 7175 . 8311) (\TEDIT.CREATEW.FROM.REGION 8313 . 9297) (
TEDIT.CURSORMOVEDFN 9299 . 19951) (TEDIT.CURSOROUTFN 19953 . 20488) (TEDIT.WINDOW.SETUP 20490 . 22299)
(TEDIT.MINIMAL.WINDOW.SETUP 22301 . 30090) (\TEDIT.ACTIVE.WINDOWP 30092 . 31073) (
\TEDIT.BUTTONEVENTFN 31075 . 54913) (\TEDIT.WINDOW.OPS 54915 . 58718) (\TEDIT.EXPANDFN 58720 . 59123)
(\TEDIT.MAINW 59125 . 60414) (\TEDIT.PRIMARYW 60416 . 61628) (\TEDIT.COPYINSERTFN 61630 . 62601) (
\TEDIT.NEWREGIONFN 62603 . 65070) (\TEDIT.SET.WINDOW.EXTENT 65072 . 71174) (\TEDIT.SHRINK.ICONCREATE
71176 . 73448) (\TEDIT.SHRINKFN 73450 . 74025) (\TEDIT.SPLITW 74027 . 80128) (\TEDIT.UNSPLITW 80130 .
85824) (\TEDIT.WINDOW.SETUP 85826 . 91546) (\SAFE.FIRST 91548 . 91935)) (93083 93990 (TEDITWINDOWP
93093 . 93988)) (94027 96523 (TEDIT.GETINPUT 94037 . 96020) (\TEDIT.MAKEFILENAME 96022 . 96521)) (
96572 103023 (TEDIT.PROMPTPRINT 96582 . 99486) (TEDIT.PROMPTFLASH 99488 . 101443) (
\TEDIT.PROMPT.PAGEFULLFN 101445 . 103021)) (103258 107320 (TEXTSTREAM.TITLE 103268 . 103889) (
\TEDIT.ORIGINAL.WINDOW.TITLE 103891 . 105936) (\TEDIT.WINDOW.TITLE 105938 . 106608) (
\TEXTSTREAM.FILENAME 106610 . 107318)) (107363 152087 (TEDIT.DEACTIVATE.WINDOW 107373 . 114522) (
\TEDIT.REPAINTFN 114524 . 117381) (\TEDIT.RESHAPEFN 117383 . 123003) (\TEDIT.SCROLLFN 123005 . 152085)
) (152129 154178 (\TEDIT.PROCIDLEFN 152139 . 153488) (\TEDIT.PROCENTRYFN 153490 . 153783) (
\TEDIT.PROCEXITFN 153785 . 154176)) (154257 165257 (\EDIT.DOWNCARET 154267 . 154948) (\EDIT.FLIPCARET
154950 . 156485) (TEDIT.FLASHCARET 156487 . 157601) (\EDIT.UPCARET 157603 . 158056) (
TEDIT.NORMALIZECARET 158058 . 164009) (\SETCARET 164011 . 164931) (\TEDIT.CARET 164933 . 165255)) (
165291 179046 (TEDIT.ADD.MENUITEM 165301 . 167216) (TEDIT.DEFAULT.MENUFN 167218 . 176485) (
TEDIT.REMOVE.MENUITEM 176487 . 177488) (\TEDIT.CREATEMENU 177490 . 177943) (\TEDIT.MENU.WHENHELDFN
177945 . 178715) (\TEDIT.MENU.WHENSELECTEDFN 178717 . 179044)))))
(FILEMAP (NIL (7291 94107 (TEDIT.CREATEW 7301 . 8437) (\TEDIT.CREATEW.FROM.REGION 8439 . 9423) (
TEDIT.CURSORMOVEDFN 9425 . 20811) (TEDIT.CURSOROUTFN 20813 . 21348) (TEDIT.WINDOW.SETUP 21350 . 23159)
(TEDIT.MINIMAL.WINDOW.SETUP 23161 . 30950) (\TEDIT.ACTIVE.WINDOWP 30952 . 31933) (
\TEDIT.BUTTONEVENTFN 31935 . 56925) (\TEDIT.WINDOW.OPS 56927 . 60888) (\TEDIT.EXPANDFN 60890 . 61293)
(\TEDIT.MAINW 61295 . 62584) (\TEDIT.PRIMARYW 62586 . 63798) (\TEDIT.COPYINSERTFN 63800 . 64771) (
\TEDIT.NEWREGIONFN 64773 . 67240) (\TEDIT.SET.WINDOW.EXTENT 67242 . 73344) (\TEDIT.SHRINK.ICONCREATE
73346 . 75618) (\TEDIT.SHRINKFN 75620 . 76195) (\TEDIT.SPLITW 76197 . 82298) (\TEDIT.UNSPLITW 82300 .
87994) (\TEDIT.WINDOW.SETUP 87996 . 93716) (\SAFE.FIRST 93718 . 94105)) (95437 96344 (TEDITWINDOWP
95447 . 96342)) (96381 98877 (TEDIT.GETINPUT 96391 . 98374) (\TEDIT.MAKEFILENAME 98376 . 98875)) (
98926 105377 (TEDIT.PROMPTPRINT 98936 . 101840) (TEDIT.PROMPTFLASH 101842 . 103797) (
\TEDIT.PROMPT.PAGEFULLFN 103799 . 105375)) (105612 109674 (TEXTSTREAM.TITLE 105622 . 106243) (
\TEDIT.ORIGINAL.WINDOW.TITLE 106245 . 108290) (\TEDIT.WINDOW.TITLE 108292 . 108962) (
\TEXTSTREAM.FILENAME 108964 . 109672)) (109717 154616 (TEDIT.DEACTIVATE.WINDOW 109727 . 117034) (
\TEDIT.REPAINTFN 117036 . 119893) (\TEDIT.RESHAPEFN 119895 . 125515) (\TEDIT.SCROLLFN 125517 . 154614)
) (154658 156707 (\TEDIT.PROCIDLEFN 154668 . 156017) (\TEDIT.PROCENTRYFN 156019 . 156312) (
\TEDIT.PROCEXITFN 156314 . 156705)) (156786 167786 (\EDIT.DOWNCARET 156796 . 157477) (\EDIT.FLIPCARET
157479 . 159014) (TEDIT.FLASHCARET 159016 . 160130) (\EDIT.UPCARET 160132 . 160585) (
TEDIT.NORMALIZECARET 160587 . 166538) (\SETCARET 166540 . 167460) (\TEDIT.CARET 167462 . 167784)) (
167820 181575 (TEDIT.ADD.MENUITEM 167830 . 169745) (TEDIT.DEFAULT.MENUFN 169747 . 179014) (
TEDIT.REMOVE.MENUITEM 179016 . 180017) (\TEDIT.CREATEMENU 180019 . 180472) (\TEDIT.MENU.WHENHELDFN
180474 . 181244) (\TEDIT.MENU.WHENSELECTEDFN 181246 . 181573)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-May-2021 10:18:06" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;4 176139
changes to%: (FNS \TEXTINIT)
(FILECREATED "12-Oct-2021 15:38:41" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;4 176302
previous date%: "11-Feb-2001 12:06:42"
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>library>TEXTOFD.;2)
changes to%: (FNS \TEDITOUTCCODEFN)
previous date%: " 7-Oct-2021 08:41:13"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;3)
(* ; "
@@ -25,24 +26,24 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(FNS \INSERTCH \INSERTCR)
(COMS
(* ;;; "Functions to manipulate the Piece Table (PCTB)")
(* ;;; "Functions to manipulate the Piece Table (PCTB)")
(FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE
\INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE))
(COMS (* ;
 "Generic-IO type operations support")
(COMS (* ;
 "Generic-IO type operations support")
(FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR
\TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR
\TEXTBOUT \TEDITOUTCHARFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION
\TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION
\TEXTDSPYPOSITION \TEXTLEFTMARGIN \TEXTRIGHTMARGIN \TEXTDSPCHARWIDTH
\TEXTDSPSTRINGWIDTH \TEXTDSPLINEFEED)
(FNS \TEXTBIN \TEDIT.TEXTBIN.STRINGSETUP \TEDIT.TEXTBIN.FILESETUP
\TEDIT.TEXTBIN.NEW.PAGE)
(FNS \TEXTPEEKBIN \TEDIT.PEEKBIN.NEW.PAGE))
(COMS (* ; "Support for TEXTPROP")
(COMS (* ; "Support for TEXTPROP")
(FNS CGETTEXTPROP CTEXTPROP GETTEXTPROP PUTTEXTPROP TEXTPROP))
[COMS
(* ;; "Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXTOFD multiple times (as, e.g., in development)")
(* ;; "Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXTOFD multiple times (as, e.g., in development)")
(INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN]
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT)))
@@ -676,29 +677,29 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(RETURN PC])
(\TEXTINIT
[LAMBDA NIL (* ; "Edited 6-May-2021 10:17 by rmk:")
(* ;
 "Create the FDEV and STREAM prototypes for TEXT streams.")
[LAMBDA NIL (* ; "Edited 7-Oct-2021 08:40 by rmk:")
(* ;
 "Create the FDEV and STREAM prototypes for TEXT streams.")
(* ;; "TEXT streams make use of the following STREAM fields:")
(* ;; "TEXT streams make use of the following STREAM fields:")
(* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")
(* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")
(* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")
(* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))")
(* ;; "F2 (* # chars left in piece at end of underlying file's page)")
(* ;; "F2 (* # chars left in piece at end of underlying file's page)")
(* ;; "F3 (* The TEXTOBJ for this stream)")
(* ;; "F3 (* The TEXTOBJ for this stream)")
(* ;; "F4")
(* ;; "F4")
(* ;; "F5 (* The PIECE we're currently inside)")
(* ;; "F5 (* The PIECE we're currently inside)")
(* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")
(* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)")
(* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")
(* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)")
(* ;; "(FW8 WORD)")
(* ;; "(FW8 WORD)")
(SETQ \TEXTIMAGEOPS (create IMAGEOPS
IMAGETYPE _ 'TEXT
@@ -745,6 +746,9 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
FDEXTENDABLE _ NIL
TRUNCATEFILE _ (FUNCTION NILL)
WRITEPAGES _ (FUNCTION NILL)))
(* ;; "The prototypical Text stream")
(SETQ \TEXTOFD
(create STREAM
BINABLE _ T
@@ -761,10 +765,16 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
FW7 _ 0
MAXBUFFERS _ 10
IMAGEOPS _ \TEXTIMAGEOPS
IMAGEDATA _ (create TEXTIMAGEDATA)
OUTCHARFN _ (FUNCTION \TEDITOUTCHARFN))) (* ; "The prototypical Text stream")
IMAGEDATA _ (create TEXTIMAGEDATA)))
(* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")
(* ;; "Maybe more functions later?")
(MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN)
NIL
'CR)
(\EXTERNALFORMAT \TEXTOFD :TEDIT)
(* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.")
(CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
(FUNCTION (LAMBDA (CONDITION)
@@ -772,8 +782,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(COND
[(AND (BOUNDP 'ERRORPOS)
(TEXTSTREAMP STREAM))
(* ;
 "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")
(* ;
 "This happened in the error handler, and it happened to a TEdit stream, so try the fix:")
(LET ((XCL::RESULT (REOPENTEXTSTREAM STREAM)))
(CL:WHEN XCL::RESULT
(ENVAPPLY (STKNAME ERRORPOS)
@@ -781,8 +791,8 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(STKNTH -1 ERRORPOS ERRORPOS)
ERRORPOS T T))]
(*TEDIT-OLD-STREAM-ERROR-HANDLER*
(* ;
 "Some other kind of stream, so punt to the old handler (if there is one):")
(* ;
 "Some other kind of stream, so punt to the old handler (if there is one):")
(APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION])
(\TEXTMARK
@@ -1782,10 +1792,10 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
(freplace (TEXTSTREAM REALFILE) of STREAM with NIL])
(\TEDITOUTCHARFN
[LAMBDA (STREAM CHARCODE) (* ; "Edited 31-May-91 14:19 by jds")
(\TEDITOUTCCODEFN
[LAMBDA (STREAM CHARCODE) (* ; "Edited 12-Oct-2021 15:38 by rmk:")
(* ;; "OUTCHARFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes. BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.")
(* ;; "OUTCCODEFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes (via \TEXTBOUT). BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.")
(COND
((EQ CHARCODE (CHARCODE EOL))
@@ -2657,25 +2667,25 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
(PUTPROPS TEXTOFD COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989
1990 1991 1993 1994 1995 1999 2000 2001 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2982 52971 (COPYTEXTSTREAM 2992 . 6114) (OPENTEXTSTREAM 6116 . 20993) (REOPENTEXTSTREAM
20995 . 21417) (TEDIT.STREAMCHANGEDP 21419 . 21717) (TEXTSTREAMP 21719 . 22033) (TXTFILE 22035 .
22480) (\DELETECH 22482 . 33738) (\SETUPGETCH 33740 . 41019) (\TEDIT.REOPEN.STREAM 41021 . 42871) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42873 . 45311) (\TEXTINIT 45313 . 50864) (\TEXTMARK 50866 . 51614) (
\TEXTTTYBOUT 51616 . 52969)) (52972 78404 (\INSERTCH 52982 . 76708) (\INSERTCR 76710 . 78402)) (78470
98786 (\CHTOPC 78480 . 79669) (\CHTOPCNO 79671 . 80933) (\CLEARPCTB 80935 . 81731) (
\CREATEPIECEORSTREAM 81733 . 84707) (\DELETEPIECE 84709 . 85622) (\FINDPIECE 85624 . 85990) (
\INSERTPIECE 85992 . 89002) (\MAKEPCTB 89004 . 90919) (\SPLITPIECE 90921 . 97880) (\INSERT.FIRST.PIECE
97882 . 98784)) (98838 123056 (\TEXTCLOSEF 98848 . 100075) (\TEXTCLOSEF-SUBTREE 100077 . 100783) (
\TEXTDSPFONT 100785 . 101777) (\TEXTEOFP 101779 . 103138) (\TEXTGETEOFPTR 103140 . 103350) (
\TEXTGETFILEPTR 103352 . 105415) (\TEXTOPENF 105417 . 106247) (\TEXTOPENF-SUBTREE 106249 . 107050) (
\TEXTOUTCHARFN 107052 . 107400) (\TEXTBACKFILEPTR 107402 . 113303) (\TEXTBOUT 113305 . 116653) (
\TEDITOUTCHARFN 116655 . 117901) (\TEXTSETEOF 117903 . 118412) (\TEXTSETFILEPTR 118414 . 119639) (
\TEXTDSPXPOSITION 119641 . 120498) (\TEXTDSPYPOSITION 120500 . 121045) (\TEXTLEFTMARGIN 121047 .
121530) (\TEXTRIGHTMARGIN 121532 . 122468) (\TEXTDSPCHARWIDTH 122470 . 122708) (\TEXTDSPSTRINGWIDTH
122710 . 122950) (\TEXTDSPLINEFEED 122952 . 123054)) (123057 156801 (\TEXTBIN 123067 . 139853) (
\TEDIT.TEXTBIN.STRINGSETUP 139855 . 145568) (\TEDIT.TEXTBIN.FILESETUP 145570 . 151956) (
\TEDIT.TEXTBIN.NEW.PAGE 151958 . 156799)) (156802 170210 (\TEXTPEEKBIN 156812 . 165951) (
\TEDIT.PEEKBIN.NEW.PAGE 165953 . 170208)) (170248 175466 (CGETTEXTPROP 170258 . 170734) (CTEXTPROP
170736 . 173080) (GETTEXTPROP 173082 . 173677) (PUTTEXTPROP 173679 . 175004) (TEXTPROP 175006 . 175464
(FILEMAP (NIL (2989 53114 (COPYTEXTSTREAM 2999 . 6121) (OPENTEXTSTREAM 6123 . 21000) (REOPENTEXTSTREAM
21002 . 21424) (TEDIT.STREAMCHANGEDP 21426 . 21724) (TEXTSTREAMP 21726 . 22040) (TXTFILE 22042 .
22487) (\DELETECH 22489 . 33745) (\SETUPGETCH 33747 . 41026) (\TEDIT.REOPEN.STREAM 41028 . 42878) (
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42880 . 45318) (\TEXTINIT 45320 . 51007) (\TEXTMARK 51009 . 51757) (
\TEXTTTYBOUT 51759 . 53112)) (53115 78547 (\INSERTCH 53125 . 76851) (\INSERTCR 76853 . 78545)) (78613
98929 (\CHTOPC 78623 . 79812) (\CHTOPCNO 79814 . 81076) (\CLEARPCTB 81078 . 81874) (
\CREATEPIECEORSTREAM 81876 . 84850) (\DELETEPIECE 84852 . 85765) (\FINDPIECE 85767 . 86133) (
\INSERTPIECE 86135 . 89145) (\MAKEPCTB 89147 . 91062) (\SPLITPIECE 91064 . 98023) (\INSERT.FIRST.PIECE
98025 . 98927)) (98981 123219 (\TEXTCLOSEF 98991 . 100218) (\TEXTCLOSEF-SUBTREE 100220 . 100926) (
\TEXTDSPFONT 100928 . 101920) (\TEXTEOFP 101922 . 103281) (\TEXTGETEOFPTR 103283 . 103493) (
\TEXTGETFILEPTR 103495 . 105558) (\TEXTOPENF 105560 . 106390) (\TEXTOPENF-SUBTREE 106392 . 107193) (
\TEXTOUTCHARFN 107195 . 107543) (\TEXTBACKFILEPTR 107545 . 113446) (\TEXTBOUT 113448 . 116796) (
\TEDITOUTCCODEFN 116798 . 118064) (\TEXTSETEOF 118066 . 118575) (\TEXTSETFILEPTR 118577 . 119802) (
\TEXTDSPXPOSITION 119804 . 120661) (\TEXTDSPYPOSITION 120663 . 121208) (\TEXTLEFTMARGIN 121210 .
121693) (\TEXTRIGHTMARGIN 121695 . 122631) (\TEXTDSPCHARWIDTH 122633 . 122871) (\TEXTDSPSTRINGWIDTH
122873 . 123113) (\TEXTDSPLINEFEED 123115 . 123217)) (123220 156964 (\TEXTBIN 123230 . 140016) (
\TEDIT.TEXTBIN.STRINGSETUP 140018 . 145731) (\TEDIT.TEXTBIN.FILESETUP 145733 . 152119) (
\TEDIT.TEXTBIN.NEW.PAGE 152121 . 156962)) (156965 170373 (\TEXTPEEKBIN 156975 . 166114) (
\TEDIT.PEEKBIN.NEW.PAGE 166116 . 170371)) (170411 175629 (CGETTEXTPROP 170421 . 170897) (CTEXTPROP
170899 . 173243) (GETTEXTPROP 173245 . 173840) (PUTTEXTPROP 173842 . 175167) (TEXTPROP 175169 . 175627
)))))
STOP

Binary file not shown.

View File

@@ -1,18 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Aug-2021 13:13:04" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193 64903
(FILECREATED "30-Sep-2021 16:03:18" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;194 64783
changes to%: (FNS MAKE-UNICODE-TRANSLATION-TABLES)
previous date%: " 8-Aug-2021 13:10:17"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;192)
previous date%: "21-Aug-2021 13:13:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>UNICODE.;193)
(PRETTYCOMPRINT UNICODECOMS)
(RPAQQ UNICODECOMS
[(COMS
(* ;; "External formats")
(* ;; "External formats")
(FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN)
(FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16.BACKCCODEFN)
@@ -25,14 +23,14 @@
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE))
(FNS XTOUCODE UTOXCODE))
[COMS
(* ;; "Unicode mapping files")
(* ;; "Unicode mapping files")
(FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING
WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER WRITE-UNICODE-MAPPING-FILENAME
)
(VARS XCCS-SET-NAMES)
(* ;; "Automate dumping of a documentation prefix")
(* ;; "Automate dumping of a documentation prefix")
[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MISSINGCODE (CL:PARSE-INTEGER "FFFE"
:RADIX 16))
@@ -43,7 +41,7 @@
(P (PUSHNEW UNICODEDIRECTORIES (PACK* (UNIX-GETENV "MEDLEYDIR")
'/unicode/xerox/]
(COMS
(* ;; "Set up translation tables for UTF8 and UTFBE external formats")
(* ;; "Set up translation tables for UTF8 and UTFBE external formats")
(FNS MAKE-UNICODE-TRANSLATION-TABLES)
[INITVARS (DEFAULT-XCCS-CHARSETS '(LATIN SYMBOLS1 SYMBOLS2 EXTENDED-LATIN FORMS
@@ -63,7 +61,7 @@
"NOTE: UNICODE requires EXPORTS.ALL for compilation"
T)))
(* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")
(* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter")
(CONSTANTS (TRANSLATION-SEGMENT-SIZE 128)
(MAX-ALIST-LENGTH 10)
@@ -78,13 +76,13 @@
(DEFINEQ
(UTF8.OUTCHARFN
[LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:02 by rmk:")
(* ; "Edited 17-Aug-2020 08:45 by rmk:")
(* ; "Edited 30-Jan-2020 23:08 by rmk:")
[LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:02 by rmk:")
(* ; "Edited 17-Aug-2020 08:45 by rmk:")
(* ; "Edited 30-Jan-2020 23:08 by rmk:")
(* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")
(* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")
(* ;; "Print UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.")
(* ;; "Print UTF8 sequence for CHARCODE. Do not do XCCS to Unicode translation if RAW.")
(IF (EQ CHARCODE (CHARCODE EOL))
THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
@@ -97,13 +95,13 @@
DO (IF (ILESSP C 128)
THEN (\BOUT STREAM C)
ELSEIF (ILESSP C 2048)
THEN (* ; "x800")
THEN (* ; "x800")
(\BOUT STREAM (LOGOR (LLSH 3 6)
(LRSH C 6)))
(\BOUT STREAM (LOGOR (LLSH 2 6)
(LOADBYTE C 0 6)))
ELSEIF (ILESSP C 65536)
THEN (* ; "x10000")
THEN (* ; "x10000")
(\BOUT STREAM (LOGOR (LLSH 7 5)
(LRSH C 12)))
(\BOUT STREAM (LOGOR (LLSH 2 6)
@@ -111,7 +109,7 @@
(\BOUT STREAM (LOGOR (LLSH 2 6)
(LOADBYTE C 0 6)))
ELSEIF (ILESSP C 2097152)
THEN (* ; "x200000")
THEN (* ; "x200000")
(\BOUT STREAM (LOGOR (LLSH 15 4)
(LRSH C 18)))
(\BOUT STREAM (LOGOR (LLSH 2 6)
@@ -123,29 +121,29 @@
ELSE (ERROR "CHARCODE too big for UTF8" C])
(UTF8.INCCODEFN
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:02 by rmk:")
(* ; "Edited 6-Aug-2020 17:13 by rmk:")
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:02 by rmk:")
(* ; "Edited 6-Aug-2020 17:13 by rmk:")
(* ;; "Do not do UNICODE to XCSS translation if RAW.")
(* ;; "Do not do UNICODE to XCSS translation if RAW.")
(* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")
(* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")
(DECLARE (USEDFREE *BYTECOUNTER*))
(LET (BYTE1 BYTE2 BYTE3 BYTE4 CODE (COUNT 1))
(SETQ BYTE1 (\BIN STREAM))
(* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1")
(* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1")
(CL:WHEN (SMALLP BYTE1)
[SETQ CODE (IF (ILESSP BYTE1 128)
THEN
(* ;;
 "Test first: Ascii is the common case. EOL requires its own translation")
(* ;;
 "Test first: Ascii is the common case. EOL requires its own translation")
(SELCHARQ BYTE1
(CR (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM)
(CR.EOLC (* ; "Also eq BYTE1")
(CR.EOLC (* ; "Also eq BYTE1")
(CHARCODE EOL))
(CRLF.EOLC (IF (EQ (CHARCODE LF)
(\PEEKBIN STREAM T))
@@ -160,7 +158,7 @@
BYTE1))
BYTE1)
ELSEIF (IGEQ BYTE1 (LLSH 15 4))
THEN (* ; "4 bytes")
THEN (* ; "4 bytes")
(SETQ BYTE2 (\BIN STREAM))
(CL:WHEN (OR (NOT (SMALLP BYTE2))
(ILESSP BYTE2 128))
@@ -182,7 +180,7 @@
6)
(LOADBYTE BYTE4 0 6))
ELSEIF (IGEQ BYTE1 (LLSH 7 5))
THEN (* ; "3 bytes")
THEN (* ; "3 bytes")
(SETQ BYTE2 (\BIN STREAM))
(CL:WHEN (OR (NOT (SMALLP BYTE2))
(ILESSP BYTE2 128))
@@ -197,7 +195,7 @@
(LLSH (LOADBYTE BYTE2 0 6)
6)
(LOADBYTE BYTE3 0 6))
ELSE (* ; "Must be 2 bytes")
ELSE (* ; "Must be 2 bytes")
(SETQ COUNT 2)
(SETQ BYTE2 (\BIN STREAM))
(CL:WHEN (OR (NOT (SMALLP BYTE2))
@@ -211,12 +209,97 @@
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
CODE])
(UTF8.PEEKCCODEFN
(UTF8.PEEKCCODEFN
[LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:53 by rmk:")
(* ;; "Modeled this after \EUCPEEK on LLREAD. In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0. Returns NIL if NOERROR and either invalid UTF8 or end of file.")
(* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")
(* ;; "Do not do UNICODE to XCCS translation if RAW")
(PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE)
(SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
(* ;; "Distinguish on header bytex")
(CL:UNLESS BYTE1 (RETURN NIL))
[IF (ILESSP BYTE1 128)
THEN
(* ;;
 "Test first: Ascii is the common case. No need to back up, since we peeked.")
(SETQ CODE BYTE1)
ELSEIF (IGEQ BYTE1 (LLSH 15 4))
THEN (* ; "4 bytes")
(\BIN STREAM)
(CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
(IGEQ BYTE2 128))
(\BACKFILEPTR STREAM)
(OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
(RETURN CODE))
(\BIN STREAM)
(CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR))
(IGEQ BYTE3 128))
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
(OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
(RETURN CODE))
(\BIN STREAM)
(SETQ BYTE4 (\PEEKBIN STREAM NOERROR)) (* ;
 "PEEK the last, no need to back it up")
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
(IF (AND BYTE4 (IGEQ BYTE4 128))
THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3)
18)
(LLSH (LOADBYTE BYTE2 0 6)
12)
(LLSH (LOADBYTE BYTE3 0 6)
6)
(LOADBYTE BYTE4 0 6)))
ELSEIF NOERROR
ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4)))
ELSEIF (IGEQ BYTE1 (LLSH 7 5))
THEN (* ; "3 bytes")
(\BIN STREAM)
(CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
(IGEQ BYTE2 128))
(\BACKFILEPTR STREAM)
(OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2)))
(RETURN CODE))
(\BIN STREAM)
(SETQ BYTE3 (\PEEKBIN STREAM NOERROR))
(\BACKFILEPTR STREAM)
(\BACKFILEPTR STREAM)
(IF (AND BYTE3 (IGEQ BYTE3 128))
THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4)
12)
(LLSH (LOADBYTE BYTE2 0 6)
6)
(LOADBYTE BYTE3 0 6)))
ELSEIF NOERROR
ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3)))
ELSE (* ; "Must be 2 bytes")
(\BIN STREAM)
(SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
(\BACKFILEPTR STREAM)
(IF (AND BYTE2 (IGEQ BYTE2 128))
THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
6)
(LOADBYTE BYTE2 0 6)))
ELSEIF NOERROR
ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2]
(CL:WHEN (AND CODE (NOT RAW))
(SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
(RETURN CODE])
(\UTF8.BACKCCODEFN
(* ;; "Modeled this after \EUCPEEK on LLREAD. In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0. Returns NIL if NOERROR and either invalid UTF8 or end of file.")
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:04 by rmk:")
(* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, just return COUNT")
(DECLARE (USEDFREE *BYTECOUNTER*))
(BIND (C _ 0) WHILE (CL:WHEN (\BACKFILEPTR STREAM)
@@ -228,12 +311,12 @@
(DEFINEQ
(UTF16BE.OUTCHARFN
(* ;;
[LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:09 by rmk:")
(* ; "Edited 30-Jan-2020 23:08 by rmk:")
(* ;; "PRINT UTF16 sequence for CHARCODE. Do not do XCCS to UNICODE translation if RAW.")
ELSEIF (IGEQ BYTE1 (LLSH 15 4))
(* ;; "Not sure about EOL conversion if truly %"raw%"")
(IF (EQ CHARCODE (CHARCODE EOL))
THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0)
@@ -245,10 +328,10 @@
DO (\WOUT STREAM C])
(UTF16BE.INCCODEFN
(\BACKFILEPTR STREAM)
[LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:05 by rmk:")
(RETURN CODE))
(\BIN STREAM)
(* ;;
 "Do not do UNICODE to XCCS translation if RAW. Test for SMALLPin case of funky EOF behavior")
(DECLARE (USEDFREE *BYTECOUNTER*))
(LET (CODE BYTE1 BYTE2 COUNT)
@@ -264,14 +347,37 @@
CODE
ELSE (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
ELSEIF (IGEQ BYTE1 (LLSH 7 5))
(UTF16BE.PEEKCCODEFN
[LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:58 by rmk:")
(* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")
(* ;; "Do not do UNICODE to XCCS translation if RAW")
(LET (BYTE1 BYTE2 CODE)
(SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
(IF BYTE1
THEN (\BIN STREAM)
(SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
(\BACKFILEPTR STREAM)
(IF BYTE2
THEN (SETQ CODE (LOGOR (LLSH BYTE1 8)
BYTE2))
(CL:IF RAW
CODE
(UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
ELSEIF NOERROR
THEN NIL)
ELSEIF NOERROR
THEN NIL
ELSE (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
(\UTF16.BACKCCODEFN
(CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR))
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:07 by rmk:")
(\BACKFILEPTR STREAM)
(* ;; "\BACKFILEPTR is NIL at beginning of FILE, do nothing.")
(RETURN CODE))
(* ;; "Common for big-ending and little-ending")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
@@ -285,11 +391,11 @@
(DEFINEQ
(MAKE-UNICODE-FORMATS
(\BIN STREAM)
[LAMBDA (EXTERNALEOL) (* ; "Edited 6-Aug-2021 16:08 by rmk:")
(\BACKFILEPTR STREAM)
(* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")
THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5)
(* ;; "The EXTERNALEOL specifies the EOLCONVENTION of the stream, particularly to produce output files with the desired convention. On input the macro \CHECKEOLC (LLREAD) coerces only that coding to the internal EOL, which is a mistake.")
(MAKE-EXTERNALFORMAT :UTF-8 (FUNCTION UTF8.INCCODEFN)
(FUNCTION UTF8.PEEKCCODEFN)
@@ -325,11 +431,11 @@
(DEFINEQ
(UNICODE.UNMAPPED
CHARCODE
[LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 11-Aug-2020 20:23 by rmk:")
DO (\WOUT STREAM C])
(* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODED has no fast mapping in TRANSLATION-TABLE.")
(UTF16BE.INCCODEFN
(* ;; "We return an existing entry in the hash array of the table. If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.")
(LET ((FORWARD (CL:SVREF TRANSLATION-TABLE N-TRANSLATION-SEGMENTS))
INVERSE NEXTCODE)
@@ -349,9 +455,9 @@
(DEFINEQ
(XCCS-UTF8-AFTER-OPEN
(UTF16BE.PEEKCCODEFN
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 13-Aug-2020 11:54 by rmk:")
(* ;; "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF8.")
(CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
[EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM)
@@ -379,11 +485,11 @@
(DEFINEQ
(XTOUCODE
(* ;; "Common for big-ending and little-ending")
[LAMBDA (XCCSCODE) (* ; "Edited 9-Aug-2020 09:04 by rmk:")
(UNICODE.TRANSLATE XCCSCODE *XCCSTOUNICODE*])
(UTOXCODE
(IF (\BACKFILEPTR STREAM)
[LAMBDA (UNICODE) (* ; "Edited 9-Aug-2020 09:04 by rmk:")
(UNICODE.TRANSLATE UNICODE *UNICODETOXCCS*])
)
@@ -394,9 +500,8 @@
(DEFINEQ
(READ-UNICODE-MAPPING-FILENAMES
(* ;; "RAW formats do not do XCCS/Unicode translation, just deal with the byte encoding.")
[LAMBDA (FILESPEC) (* ; "Edited 5-Aug-2020 15:59 by kaplan")
(* ; "Edited 4-Aug-2020 17:31 by rmk:")
(FOR F X CSI INSIDE FILESPEC
COLLECT (IF (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT)
T UNICODEDIRECTORIES)
@@ -412,24 +517,24 @@
ELSE F])
(READ-UNICODE-MAPPING
(MAKE-EXTERNALFORMAT :UTF-16BE (FUNCTION UTF16BE.INCCODEFN)
[LAMBDA (FILESPEC NOPRINT NOERROR) (* ; "Edited 3-Jul-2021 13:37 by rmk:")
(FUNCTION \UTF16.BACKCCODEFN)
(* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format. Comments prefixed by # and")
NIL EXTERNALEOL)
(* ;; " Column 1: Input hex code in the format 0xXXXX")
(UTF16BE.INCCODEFN STREAM COUNTP T]
(* ;; " Column 2: Corresponding Unicode code-sequence in the format")
(UTF16BE.PEEKCCODEFN STREAM NOERROR T]
(* ;; " 0xXXXX ... 0xYYYY")
[FUNCTION (LAMBDA (STREAM CHARCODE)
(UTF16BE.OUTCHARFN STREAM CHARCODE T]
(* ;;
 " Column 3: (after #) Character name in some mapping files, utf-8 character")
)
(* ;; " for XCCS mapping files")
(MAKE-UNICODE-FORMATS EXTERNALEOL)
(* ;; "")
(ADDTOVAR *DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8))
(* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")
(FOR FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] IN (
 READ-UNICODE-MAPPING-FILENAMES
@@ -461,18 +566,18 @@
(NTHCHARCODE LINE START])
(WRITE-UNICODE-MAPPING
(CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM)))
[LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 16-Aug-2020 16:56 by rmk:")
'EXTENSION]
(* ;; "Writes a symbol unicode mapping file. Mapping is a list of (XCCS-code Unicode) pairs, which may contain codes in multiple character sets.")
(STREAMPROP STREAM 'EXTERNALFORMAT :UTF8))])
(* ;; "If FILE is NIL, it defaults to a name XCCS- followed by the octal character sets in the mapping, in the unicode/XEROX directory.")
(DECLARE%: EVAL@COMPILE DONTCOPY
(* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab># Unicode-char")
(PUTPROPS UNICODE.TRANSLATE MACRO [OPENLAMBDA (CODE TRANSLATION-TABLE)
(* ;;
 "If INCLUDECHARSETS=T then the mappings are split up into separate per-character set files.")
TRANSLATION-SHIFT
(* ;; "Otherwise, all and only mappings included in thos charsets are included in a single output file--an implicit subset.")
(IF (AND (EQ INCLUDECHARSETS T)
(NULL FILE))
@@ -513,15 +618,15 @@
" # "
(SELECTC FIRSTRIGHTC
(UNDEFINEDCODE
(CADR CSI))
(* ;; "FFFF")
"UNDEFINED")
(MISSINGCODE
ELSE F])
(* ;; "FFFE")
"MISSING")
(IF (ILESSP FIRSTRIGHTC 32)
THEN (* ; "Control chars")
[CONCAT "^" (CHARACTER (IPLUS FIRSTRIGHTC
(CHARCODE @]
ELSE (CHARACTER FIRSTRIGHTC)))
@@ -535,13 +640,13 @@
NIL])
(WRITE-UNICODE-INCLUDED
(* ;; "")
[LAMBDA (MAPPING INCLUDECHARSETS) (* ; "Edited 4-Aug-2020 17:47 by rmk:")
(* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")
(* ;; "CSETINFO is a list of (num string name) for each included character set.")
(LET (CHARSETS CSETINFO RANGES ICSETS IMAPPING)
FILESPEC)
(* ;; "Normalize the INCLUDECHARSETS, then reduce MAPPING to the included mappings")
[SETQ ICSETS (FOR C POS KNOWN INSIDE (OR INCLUDECHARSETS (FOR CSI IN
XCCS-SET-NAMES
@@ -569,13 +674,13 @@
ICSETS))
COLLECT
[LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 16-Aug-2020 16:56 by rmk:")
(* ;; "The attested subset of INCLUDED")
(CL:UNLESS (MEMB CSI CSETINFO)
(PUSH CSETINFO CSI))
M))
(* ;; "The output lines are of the form x0XXX<tab>x0UUUU<tab># Unicode-char")
(* ;; "Sort as numbers, not octal strings, then group into consecutive ranges")
(SETQ CSETINFO (SORT CSETINFO T))
[SETQ RANGES (FOR CTAIL C START END ON (FOR CSI IN CSETINFO
@@ -587,7 +692,7 @@
COLLECT (SETQ CTAIL (CDR CTAIL))
(SETQ END (CAR CTAIL]
MAPPING
(* ;; "Split out groups of less than 3. But if a range exhaustively covers a known subset (like JIS), replace by the name")
[SETQ RANGES (FOR R STR KNOWN LAST IN RANGES
JOIN (SETQ LAST (CAR (LAST R)))
@@ -607,9 +712,9 @@
(CL:VALUES IMAPPING CSETINFO RANGES])
(WRITE-UNICODE-MAPPING-HEADER
(CL:UNLESS (EQ CSET (LRSH LEFTC 8))
[LAMBDA (STREAM CSETINFO RANGES) (* ; "Edited 4-Aug-2020 17:38 by rmk:")
(SETQ CSI (ASSOC CSET CSETINFO))
(* ;; "Writes the standard per-file header information")
(FOR LINE IN UNICODE-MAPPING-HEADER
DO (PRINTOUT STREAM "#" 2)
@@ -620,7 +725,7 @@
THEN (PRINTOUT STREAM "s:" -4)
(FOR R IN RANGES DO (PRINTOUT STREAM R " "))
(TERPRI STREAM)
(UNDEFINEDCODE
ELSE (* ; "Singleton")
(PRINTOUT STREAM ": " -4 (CADAR CSETINFO)
" "
(CADDAR CSETINFO)))
@@ -632,7 +737,7 @@
(TERPRI STREAM])
(WRITE-UNICODE-MAPPING-FILENAME
ELSE (CHARACTER FIRSTRIGHTC)))
[LAMBDA (FILE CSETINFO RANGES) (* ; "Edited 4-Aug-2020 19:34 by rmk:")
(PACKFILENAME 'BODY [OR FILE (CONCATLIST
(CONS 'XCCS- (IF (CDR CSETINFO)
THEN (FOR RTAIL R ON RANGES
@@ -736,53 +841,53 @@
(DEFINEQ
(MAKE-UNICODE-TRANSLATION-TABLES
(PRINTOUT STREAM LINE T)))
(TERPRI STREAM])
[LAMBDA (MAPPING LTORVAR RTOLVAR) (* ; "Edited 21-Aug-2021 13:12 by rmk:")
(* ; "Edited 17-Aug-2020 08:46 by rmk:")
(WRITE-UNICODE-MAPPING-FILENAME
(* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.")
(PACKFILENAME 'BODY [OR FILE (CONCATLIST
(* ;; "This produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).")
THEN (FOR RTAIL R ON RANGES
(* ;; "")
(SETQ R
(* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme. But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.")
(LIST (CAR R)
(* ;; " ")
(CDR R))
(* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code. An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes). The latter is used to save space for sparsely populated character sets.")
(CL:IF (CDR RTAIL)
(* ;; "")
R)
(* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping. Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.")
"="
(* ;; "")
'DIRECTORY
(* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).")
'EXTENSION
(* ;; "")
)
(* ;;
 "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")
(("0" LATIN)
(* ;; "")
("42" SYMBOLS2)
(* ;; "For the convenience of not having to deal with the multiple values, if LTORVAR or RTOLVAR are given, they are set to the constructed arrays before return.")
("44" HIRAGANA)
(* ;; "")
(LET ((LTORARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS)
:INITIAL-ELEMENT NIL))
(RTOLARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS)
:INITIAL-ELEMENT NIL)))
("341" HEBREW)
(* ;; "The left-to-right direction (into Unicode). We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte). The second loop converts long alists into arrays.")
[FOR M LEFTC RBASE RCODES IN MAPPING EACHTIME (SETQ RCODES (CDR M))
(SETQ RBASE (CAR RCODES))
UNLESS (IGEQ RBASE MISSINGCODE) DO (SETQ LEFTC (CAR M))
("360" LIGATURES)
("361" ACCENTED-LATIN)
(* ;;
 "(CDR RCODES) contains combiners on the base")
(CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
(CL:IF (CDR RCODES)
@@ -796,7 +901,7 @@
MAX-ALIST-LENGTH)
DO
(* ;; "Leave it alone if the alist is short")
(SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
(FOR P IN (CL:SVREF LTORARRAY I)
@@ -806,17 +911,17 @@
(CL:SETF (CL:SVREF LTORARRAY I)
CSA))
DATE " Author: Ron Kaplan <Ron.Kaplan@post.harvard.edu>" ""
(* ;; "")
"XC1-3-3-0, 1987) into Unicode 3.0. standard codes. That is the version of"
(* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.")
(FOR M LEFTC RBASE RCOMBINERS PREV IN MAPPING EACHTIME (SETQ RBASE (CADR M))
(SETQ RCOMBINERS (CDDR M))
UNLESS (OR (IGEQ RBASE MISSINGCODE)
RCOMBINERS) DO
" Unicode character itself (since the Unicode character names"
" are not available)"
(* ;;
 "Have we already seen an explicit mapping from right to left?")
(SETQ LEFTC (CAR M))
[SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK)
@@ -838,7 +943,7 @@
MAX-ALIST-LENGTH)
DO
(* ;; "Long list, make an array")
(SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE :INITIAL-ELEMENT NIL))
(FOR P IN (CL:SVREF RTOLARRAY I)
@@ -848,9 +953,9 @@
(CL:SETF (CL:SVREF RTOLARRAY I)
CSA))
(* ;; "")
(* ;; "Allocate the hash arrays for future out-of-map codes. We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.")
(CL:SETF (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)
(LIST (HASHARRAY 10)
@@ -863,14 +968,14 @@
(CHARCODE.DECODE "U+F8FF")
(CHARCODE.DECODE "U+E000")))
(* ;; "")
(* ;; "Now put in the inverse unmapped hash arrays")
(CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS))
(CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
(CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS))
(CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS))
 "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF")
(* ;; "")
(CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY))
(CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY))
@@ -892,11 +997,11 @@
(DEFINEQ
(HEXSTRING
(CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK)
(CL:IF (CDR RCODES)
[LAMBDA (N WIDTH) (* ; "Edited 23-Jul-2020 08:28 by rmk:")
(* ; "Edited 20-Dec-93 17:51 by rmk:")
RBASE))
(CL:SVREF LTORARRAY (LRSH LEFTC
(* ;;
 "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")
(CL:UNLESS (FIXP N)
(SETQ N (CHARCODE.DECODE N)))
@@ -915,21 +1020,21 @@
STR])
(UTF8HEXSTRING
[LAMBDA (CHARCODE) (* ; "Edited 10-Aug-2020 08:33 by rmk:")
(* ;; "Utility to produces the UTF8 hexstring representing CODE")
(HEXSTRING (IF (ILESSP CHARCODE 128)
THEN CHARCODE
ELSEIF (ILESSP CHARCODE 2048)
THEN (* ; "x800")
(LOGOR (LLSH (LOGOR (LLSH 3 6)
(LRSH CHARCODE 6))
8)
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSEIF (ILESSP CHARCODE 65536)
TRANSLATION-SHIFT
THEN (* ; "x10000")
(LOGOR (LLSH (LOGOR (LLSH 7 5)
(LRSH CHARCODE 12))
16)
@@ -939,7 +1044,7 @@
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSEIF (ILESSP CHARCODE 2097152)
LEFTC)
THEN (* ; "x200000")
(LOGOR (LLSH (LOGOR (LLSH 15 4)
(LRSH CHARCODE 18))
24)
@@ -954,27 +1059,27 @@
ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE])
(NUTF8CODEBYTES
CSA))
[LAMBDA (N) (* ; "Edited 10-Aug-2020 12:35 by rmk:")
(* ;; "")
(* ;; "Returns the number of bytes needed to encode N in UTF8, ")
(IF (ILESSP N 128)
THEN 1
ELSEIF (ILESSP N 2048)
(LIST (HASHARRAY 10)
THEN (* ; "x800")
4
ELSEIF (ILESSP N 65536)
(CHARCODE.DECODE "5,0")))
THEN (* ; "x10000")
3
ELSEIF (ILESSP N 2097152)
(CHARCODE.DECODE "U+E000")
THEN (* ; "x200000")
2
ELSE (SHOULDNT])
(NUTF8STRINGBYTES
[LAMBDA (STRING RAWFLG) (* ; "Edited 10-Aug-2020 09:06 by rmk:")
(CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS))
(* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ")
(FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE STRING I))
SUM (NUTF8CODEBYTES (CL:IF RAWFLG
@@ -982,11 +1087,11 @@
(XTOUCODE C))])
(XTOUSTRING
(LIST LTORARRAY RTOLARRAY])
[LAMBDA (XCCSSTRING RAWFLG) (* ; "Edited 10-Aug-2020 21:42 by rmk:")
(* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING. Applies the XCCSTOUNICODE translation unless RAWFLG. ")
ACCENTED-LATIN GREEK))
(* ;; "The resulting string will not be readable inside Medley.")
(LET [(USTR (ALLOCSTRING (NUTF8STRINGBYTES XCCSSTRING RAWFLG]
(FOR I CHARCODE (SINDEX _ 0) FROM 1 WHILE (SETQ CHARCODE (NTHCHARCODE XCCSSTRING
@@ -997,7 +1102,7 @@
THEN (RPLCHARCODE USTR (ADD SINDEX 1)
CHARCODE)
ELSEIF (ILESSP CHARCODE 2048)
(DEFINEQ
THEN (* ; "x800")
(RPLCHARCODE USTR (ADD SINDEX 1)
(LOGOR (LLSH 3 6)
(LRSH CHARCODE 6)))
@@ -1005,7 +1110,7 @@
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSEIF (ILESSP CHARCODE 65536)
THEN (* ; "x10000")
(RPLCHARCODE USTR (ADD SINDEX 1)
(LOGOR (LLSH 7 5)
(LRSH CHARCODE 12)))
@@ -1016,7 +1121,7 @@
(LOGOR (LLSH 2 6)
(LOADBYTE CHARCODE 0 6)))
ELSEIF (ILESSP CHARCODE 2097152)
THEN (+ CHAR (CHARCODE 0))
THEN (* ; "x200000")
(RPLCHARCODE USTR (ADD SINDEX 1)
(LOGOR (LLSH 15 4)
(LRSH CHARCODE 18)))
@@ -1033,9 +1138,9 @@
USTR])
(XCCSSTRING
8)
[LAMBDA (CODE) (* ; "Edited 13-Aug-2020 12:16 by rmk:")
(LOADBYTE CHARCODE 0 6)))
(* ;; "Returns XCCS character representation of string %"cset,char%"")
(CL:UNLESS (FIXP CODE)
(SETQ CODE (CHCON1 CODE)))
@@ -1046,14 +1151,14 @@
(DEFINEQ
(SHOWCHARS
ELSEIF (ILESSP CHARCODE 2097152)
[LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 1-Aug-2020 09:27 by rmk:")
(RESETFORM (DSPFONT (OR FONT '(CLASSIC 12))
T)
(CL:WHEN (AND (SMALLP FROMCHAR)
(NOT TOCHAR))
(LOADBYTE CHARCODE 12 6))
16)
(* ;;
 "If a small number, assume it's an octal (in decimal) character set, no need for string quotes")
(SETQ TOCHAR (CONCAT FROMCHAR "," 376))
(SETQ FROMCHAR (CONCAT FROMCHAR "," 41)))
@@ -1100,15 +1205,15 @@
)
)
(DECLARE%: DONTCOPY
(SETQ CHARCODE (XTOUCODE CHARCODE)))
(IF (ILESSP CHARCODE 128)
THEN (RPLCHARCODE USTR (ADD SINDEX 1)
CHARCODE)
ELSEIF (ILESSP CHARCODE 2048)
THEN (* ; "x800")
(RPLCHARCODE USTR (ADD SINDEX 1)
(LOGOR (LLSH 3 6)
(LRSH CHARCODE 6)))
(RPLCHARCODE USTR (ADD SINDEX 1)
(LOGOR (LLSH 2 6)
(FILEMAP (NIL (4046 17726 (UTF8.OUTCHARFN 4056 . 6887) (UTF8.INCCODEFN 6889 . 12379) (UTF8.PEEKCCODEFN
12381 . 17155) (\UTF8.BACKCCODEFN 17157 . 17724)) (17727 21053 (UTF16BE.OUTCHARFN 17737 . 18561) (
UTF16BE.INCCODEFN 18563 . 19462) (UTF16BE.PEEKCCODEFN 19464 . 20535) (\UTF16.BACKCCODEFN 20537 . 21051
)) (21083 22891 (MAKE-UNICODE-FORMATS 21093 . 22889)) (22988 24294 (UNICODE.UNMAPPED 22998 . 24292)) (
24295 24831 (XCCS-UTF8-AFTER-OPEN 24305 . 24829)) (25901 26250 (XTOUCODE 25911 . 26079) (UTOXCODE
26081 . 26248)) (26290 42412 (READ-UNICODE-MAPPING-FILENAMES 26300 . 27401) (READ-UNICODE-MAPPING
27403 . 30701) (WRITE-UNICODE-MAPPING 30703 . 34920) (WRITE-UNICODE-INCLUDED 34922 . 39644) (
WRITE-UNICODE-MAPPING-HEADER 39646 . 40878) (WRITE-UNICODE-MAPPING-FILENAME 40880 . 42410)) (45749
54228 (MAKE-UNICODE-TRANSLATION-TABLES 45759 . 54226)) (54649 62553 (HEXSTRING 54659 . 55820) (
UTF8HEXSTRING 55822 . 58027) (NUTF8CODEBYTES 58029 . 58692) (NUTF8STRINGBYTES 58694 . 59175) (
XTOUSTRING 59177 . 62188) (XCCSSTRING 62190 . 62551)) (62554 64023 (SHOWCHARS 62564 . 64021)))))
STOP

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,18 +1,27 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "16-Feb-90 17:00:31" "{piglet/n}<piglet>vanmelle>lispusers>UNIXTELNET;11" 3551
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 19:23:57" {DSK}<Users>briggs>Projects>medley>library>UNIXTELNET.;2 3970
changes to%: (VARS UNIXTELNETCOMS) (FNS UNIX-TCPCHAT.INIT UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.GET.LOGIN)
changes to%: (FNS UNIX-TCPCHAT.OPEN)
previous date%: "30-Jan-90 17:47:34" "{piglet/n}<piglet>vanmelle>lispusers>UNIXTELNET;7")
previous date%: "16-Feb-90 17:00:31" {DSK}<Users>briggs>Projects>medley>library>UNIXTELNET.;1
)
(* "
Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1989-1990 by Xerox Corporation.
")
(PRETTYCOMPRINT UNIXTELNETCOMS)
(RPAQQ UNIXTELNETCOMS ((FNS UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.GET.LOGIN UNIX-TCPCHAT.INIT) (INITVARS (CHAT.LOGINS) (CHAT.LOGINS.MENU)) (GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU) (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD) UNIXCHAT) (ADDVARS (AROUNDEXITFNS UNIX-TCPCHAT.INIT)) (P (UNIX-TCPCHAT.INIT)))))
(RPAQQ UNIXTELNETCOMS
[(FNS UNIX-TCPCHAT.HOST.FILTER UNIX-TCPCHAT.OPEN UNIX-TCPCHAT.GET.LOGIN UNIX-TCPCHAT.INIT)
(INITVARS (CHAT.LOGINS)
(CHAT.LOGINS.MENU))
(GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU)
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
UNIXCHAT)
(ADDVARS (AROUNDEXITFNS UNIX-TCPCHAT.INIT))
(P (UNIX-TCPCHAT.INIT])
(DEFINEQ
(UNIX-TCPCHAT.HOST.FILTER
@@ -20,8 +29,20 @@ Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved.
)
(UNIX-TCPCHAT.OPEN
(LAMBDA (HOST TERMTYPE LOGOPTION) (* ; "Edited 14-Feb-90 18:36 by bvm") (* ;; "For use on Maiko: chat to HOST by using rlogin in a shell window.") (LET (NAME STR) (if (AND (OR (NEQ LOGOPTION (QUOTE NONE)) (SETQ NAME (UNIX-TCPCHAT.GET.LOGIN HOST))) (SETQ STR (CREATE-SHELL-STREAM TERMTYPE (CL:FORMAT NIL "exec rlogin ~@[-l ~A ~]~A" NAME HOST)))) then (STREAMPROP STR (QUOTE SENDSCREENPARAMS) (FUNCTION UNIX.SENDSCREENPARAMS)) (STREAMPROP STR (QUOTE SETDISPLAYTYPE) (FUNCTION UNIX.SETDISPLAYTYPE)) (LIST STR STR (QUOTE LOGOPTION) (QUOTE NONE)))))
)
[LAMBDA (HOST TERMTYPE LOGOPTION) (* ;
 "Edited 30-Sep-2021 19:23 by briggs")
(* ; "Edited 14-Feb-90 18:36 by bvm")
(* ;; "For use on Maiko: chat to HOST by using ssh in a shell window.")
(LET (NAME STR)
(if [AND (OR (NEQ LOGOPTION 'NONE)
(SETQ NAME (UNIX-TCPCHAT.GET.LOGIN HOST)))
(SETQ STR (CREATE-SHELL-STREAM TERMTYPE (CL:FORMAT NIL "exec ssh ~@[-l ~A ~]~A"
NAME HOST]
then (STREAMPROP STR 'SENDSCREENPARAMS (FUNCTION UNIX.SENDSCREENPARAMS))
(STREAMPROP STR 'SETDISPLAYTYPE (FUNCTION UNIX.SETDISPLAYTYPE))
(LIST STR STR 'LOGOPTION 'NONE])
(UNIX-TCPCHAT.GET.LOGIN
(LAMBDA (HOST) (* ; "Edited 15-Feb-90 11:28 by bvm") (LET (NAME) (if (OR (NULL CHAT.LOGINS) (EQ (SETQ NAME (MENU (OR CHAT.LOGINS.MENU (SETQ CHAT.LOGINS.MENU (create MENU ITEMS _ (APPEND CHAT.LOGINS (QUOTE (("**other**" T "Prompts for a name to login as")))) CENTERFLG _ T TITLE _ "Log in as:"))))) T)) then (* ; "Prompt for a name") (if (SETQ NAME (CHAT.PROMPT.FOR.INPUT (CL:FORMAT NIL "Log in to ~A as user: " HOST) NIL 16)) then (SETQ CHAT.LOGINS (SORT (CONS NAME CHAT.LOGINS) (FUNCTION UALPHORDER))) (SETQ CHAT.LOGINS.MENU NIL))) NAME))
@@ -32,25 +53,26 @@ Copyright (c) 1989, 1990 by Xerox Corporation. All rights reserved.
)
)
(RPAQ? CHAT.LOGINS)
(RPAQ? CHAT.LOGINS )
(RPAQ? CHAT.LOGINS.MENU)
(RPAQ? CHAT.LOGINS.MENU )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CHAT.LOGINS CHAT.LOGINS.MENU)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(FILESLOAD (SYSLOAD) UNIXCHAT)
(FILESLOAD (SYSLOAD)
UNIXCHAT)
(ADDTOVAR AROUNDEXITFNS UNIX-TCPCHAT.INIT)
(ADDTOVAR AROUNDEXITFNS UNIX-TCPCHAT.INIT)
(UNIX-TCPCHAT.INIT)
(UNIX-TCPCHAT.INIT)
)
(PUTPROPS UNIXTELNET COPYRIGHT ("Xerox Corporation" 1989 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (836 3203 (UNIX-TCPCHAT.HOST.FILTER 846 . 1353) (UNIX-TCPCHAT.OPEN 1355 . 1924) (
UNIX-TCPCHAT.GET.LOGIN 1926 . 2495) (UNIX-TCPCHAT.INIT 2497 . 3201)))))
(FILEMAP (NIL (872 3597 (UNIX-TCPCHAT.HOST.FILTER 882 . 1389) (UNIX-TCPCHAT.OPEN 1391 . 2318) (
UNIX-TCPCHAT.GET.LOGIN 2320 . 2889) (UNIX-TCPCHAT.INIT 2891 . 3595)))))
STOP

Binary file not shown.

View File

@@ -1,40 +1,37 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-93 15:06:01" {DSK}<python>lde>lispcore>library>VTCHAT.;2 21782
(FILECREATED "30-Sep-2021 17:41:51" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;4 21924
changes to%: (RECORDS VT100SAVE VT100.STATE)
changes to%: (FNS VTCHAT.STATUS)
previous date%: "13-Jun-90 01:22:35" {DSK}<python>lde>lispcore>library>VTCHAT.;1)
previous date%: "20-Jan-93 15:06:01" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;3)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1983-1988, 1990, 1993 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT VTCHATCOMS)
(RPAQQ VTCHATCOMS [
(* ;; "VT100 emulator")
(RPAQQ VTCHATCOMS
[
(* ;; "VT100 emulator")
(FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
(FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT
VTCHAT.CLEARMODES VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE
VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
(INITVARS (VTCHAT.DEBUGGING.FLG)
(VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
(GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT
VTCHAT.TERM.IDENTITY.STRING)
(ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(FILES (LOADCOMP)
CHATDECLS)
(RECORDS VT100SAVE VT100.STATE))
(INITRECORDS VT100.STATE)
(SYSRECORDS VT100.STATE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
VT100KP)
(ADDVARS (CHAT.DISPLAYTYPES (
"Replace this string with NIL to prefer vt100"
NIL VT100])
(FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
(FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT VTCHAT.CLEARMODES
VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
(INITVARS (VTCHAT.DEBUGGING.FLG)
(VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
(GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT VTCHAT.TERM.IDENTITY.STRING)
(ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(FILES (LOADCOMP)
CHATDECLS)
(RECORDS VT100SAVE VT100.STATE))
(INITRECORDS VT100.STATE)
(SYSRECORDS VT100.STATE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
VT100KP)
(ADDVARS (CHAT.DISPLAYTYPES ("Replace this string with NIL to prefer vt100" NIL VT100])
@@ -101,8 +98,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
)
(VTCHAT.STATUS
(LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ; "Edited 18-Dec-86 15:16 by amd") (* ;; "Returns VT100 status info") (LET ((OUTSTREAM (ffetch (CHAT.STATE OUTSTREAM) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE))))) (SELECTQ TYPE (5 (* ; "Host wants device status") (PRIN1 "" OUTSTREAM)) (6 (* ; "Host wants cursor coords") (BOUT OUTSTREAM (CHARCODE ESC)) (BOUT OUTSTREAM (CHARCODE %[)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE YPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE ;)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE XPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE R))) NIL) (FORCEOUTPUT OUTSTREAM)))
)
[LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ;
 "Edited 30-Sep-2021 17:30 by briggs")
(* ; "Edited 18-Dec-86 15:16 by amd")
(* ;; "Returns VT100 status info")
(LET [(OUTSTREAM (ffetch (CHAT.STATE OUTSTREAM) of (\DTEST CHAT.STATE 'CHAT.STATE]
(SELECTQ TYPE
(5 (* ; "Host wants device status")
(PRIN1 "" OUTSTREAM))
(6 (* ; "Host wants cursor coords")
(BOUT OUTSTREAM (CHARCODE ESC))
(BOUT OUTSTREAM (CHARCODE %[))
(PRIN1 (ADD1 (IQUOTIENT (ffetch (CHAT.STATE YPOS) of CHAT.STATE)
(ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE)))
OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE ;))
(PRIN1 (ADD1 (IQUOTIENT (ffetch (CHAT.STATE XPOS) of CHAT.STATE)
(ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE)))
OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE R)))
NIL)
(FORCEOUTPUT OUTSTREAM])
)
(RPAQ? VTCHAT.DEBUGGING.FLG )
@@ -236,10 +254,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
)
(PUTPROPS VTCHAT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1995 10061 (VTCHAT.STATE 2005 . 2515) (VTCHAT.HANDLECHARACTER 2517 . 5091) (
VTCHAT.SEQUENCE 5093 . 6636) (VTCHAT.DOCOMMAND 6638 . 10059)) (10062 16968 (VTCHAT.ADDRESS 10072 .
10590) (VTCHAT.REVERSE.INDEX 10592 . 11161) (VTCHAT.ATTRIBUTES 11163 . 11549) (VTCHAT.DECLFONT 11551
. 11820) (VTCHAT.CLEARMODES 11822 . 12325) (VTCHAT.SAVE 12327 . 13066) (VTCHAT.RESTORE 13068 . 13775)
(VTCHAT.SETMODE 13777 . 14849) (VTCHAT.SETMARGINS 14851 . 15442) (VTCHAT.REPORT 15444 . 16204) (
VTCHAT.STATUS 16206 . 16966)))))
(FILEMAP (NIL (1532 9598 (VTCHAT.STATE 1542 . 2052) (VTCHAT.HANDLECHARACTER 2054 . 4628) (
VTCHAT.SEQUENCE 4630 . 6173) (VTCHAT.DOCOMMAND 6175 . 9596)) (9599 17110 (VTCHAT.ADDRESS 9609 . 10127)
(VTCHAT.REVERSE.INDEX 10129 . 10698) (VTCHAT.ATTRIBUTES 10700 . 11086) (VTCHAT.DECLFONT 11088 . 11357
) (VTCHAT.CLEARMODES 11359 . 11862) (VTCHAT.SAVE 11864 . 12603) (VTCHAT.RESTORE 12605 . 13312) (
VTCHAT.SETMODE 13314 . 14386) (VTCHAT.SETMARGINS 14388 . 14979) (VTCHAT.REPORT 14981 . 15741) (
VTCHAT.STATUS 15743 . 17108)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Jun-2021 19:17:01" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4 71992
(FILECREATED "30-Sep-2021 22:59:08" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;5 71956
changes to%: (FNS \LAFITE.EOF)
(FILES LAFITEDECLS)
changes to%: (FILES LAFITEDECLS)
previous date%: "22-Aug-94 13:00:22"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;2)
previous date%: "24-Jun-2021 19:17:01"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4)
(* ; "
@@ -75,19 +74,19 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
(LAFITE.PERSONAL.VARS LAFITEDEFAULTHOST&DIR LAFITE.SIGNATURE))
(FNS LAFITE.AROUNDEXIT \LAFITE.MARK.FOLDERS.OBSOLETE \LAFITE.CHECK.FOLDERS
\LAFITE.ASSURE.FOLDER.READY \LAFITE.AFTERLOGIN))
(COMS (* ; "misc utilities")
(COMS (* ; "misc utilities")
(FNS LA.RESETSHADE LA.MENU.ITEM NTHMESSAGE \LAFITE.MAKE.MSGARRAY
\LAFITE.ADDMESSAGES.TO.ARRAY \MAILFOLDER.DEFPRINT \LAFITEMSG.DEFPRINT
LA.POSITION.FROM.REGION MAILFOLDERBUSY)
(CURSORS LA.CROSSCURSOR)
(* ; "Low level file functions")
(* ; "Low level file functions")
(FNS TOCFILENAME DELETEMAILFOLDER \LAFITE.OPEN.FOLDER \LAFITE.REPORT.FILE.WONT.OPEN
\LAFITE.FOLDER.CHANGED \LAFITE.REBROWSE.FOLDER \LAFITE.FOLDER.CHANGED.MENU
\LAFITE.SET.FOLDER.STREAM \LAFITE.OPENSTREAM \LAFITE.CREATE.MENU \LAFITE.EOF
\LAFITE.CLOSE.FOLDER)
(FNS \LAFITE.DESCRIBE.FOLDER))
(COMS (* ;
 "Make is easy to load new versions of Lafite")
(COMS (* ;
 "Make is easy to load new versions of Lafite")
(FNS LOAD-LAFITE)
(VARS LAFITEFILES))
[DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
@@ -102,14 +101,14 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
(FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL
LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
(P * (PROGN LAFITE.PROCLAMATIONS))
(* ;
 "Proclaim user interface variables. Value is on LAFITEDECLS")
(* ;
 "Proclaim user interface variables. Value is on LAFITEDECLS")
(P (\LAFITE.GLOBAL.INIT)
(COND ((EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSCHARPATCH)
(* ;
 "Patch to horrid Lyric NS chars bug")
(* ;
 "Patch to horrid Lyric NS chars bug")
(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
@@ -117,7 +116,7 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
(RPAQQ LAFITEVERSION# 10)
(RPAQQ LAFITESYSTEMDATE "24-Jun-2021 19:17:01")
(RPAQQ LAFITESYSTEMDATE "30-Sep-2021 22:59:08")
(DEFINEQ
(LAFITE
@@ -277,8 +276,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
DEFAULTFONT)
(CHARWIDTH (CHARCODE "W")
DEFAULTFONT))
(* ;
 "Yes, user has not changed default to a variable width font")
(* ;
 "Yes, user has not changed default to a variable width font")
DEFAULTFONT)
(T (FONTCREATE '(GACHA 10]
(LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
@@ -317,8 +316,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
DEFAULTFONT)
(CHARWIDTH (CHARCODE "W")
DEFAULTFONT))
(* ;
 "Yes, user has not changed default to a variable width font")
(* ;
 "Yes, user has not changed default to a variable width font")
DEFAULTFONT)
(T (FONTCREATE '(GACHA 10])
@@ -864,8 +863,8 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(COND
((EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSCHARPATCH) (* ;
 "Patch to horrid Lyric NS chars bug")
NSCHARPATCH) (* ;
 "Patch to horrid Lyric NS chars bug")
(MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)))
)
(DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -879,28 +878,28 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985
1986 1987 1988 1989 1993 1994 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7140 22186 (LAFITE 7150 . 8461) (LAFITE.ON.FROM.BACKGROUND 8463 . 8834) (\LAFITE.OFF
8836 . 9220) (\LAFITE.START.PROC 9222 . 10998) (LAFITE.COMPUTE.CACHED.VARS 11000 . 13702) (
\LAFITE.PROCESS 13704 . 14070) (\LAFITE.START.ABORT 14072 . 14264) (\LAFITE.QUIT 14266 . 14508) (
\LAFITE.RESTART 14510 . 14643) (\LAFITE.SUBQUIT 14645 . 15943) (\LAFITE.QUIT.PROC 15945 . 18681) (
\LAFITEDEFAULTHOST&DIR 18683 . 19493) (LAFITEDEFAULTHOST&DIR 19495 . 19665) (MAKELAFITECOMMANDWINDOW
19667 . 21306) (EXTRACTMENUCOMMAND 21308 . 21556) (DOMAINLAFITECOMMAND 21558 . 21707) (
LAFITE.TOGGLE.SERVER.TRACE 21709 . 22184)) (22261 25229 (LAFITEMODE 22271 . 22751) (\LAFITE.INFER.MODE
22753 . 23106) (\LAFITE.SHOW.MODE 23108 . 23345) (\LAFITE.MODE.TITLE 23347 . 23632) (
LAFITE.SHOW.MODE.P 23634 . 23875) (LAFITE.ALL.MODES.P 23877 . 24220) (SET.LAFITE.MODE.INTERACTIVELY
24222 . 24804) (\LAFITE.COMPUTE.MODE.COMMANDS 24806 . 25227)) (26079 27835 (\LAFITE.LOGIN 26089 .
26471) (\LAFITE.LOGIN.NORESTART 26473 . 26579) (LAFITE.PROMPT.FOR.LOGIN 26581 . 27600) (
\LAFITE.REAUTHENTICATE 27602 . 27833)) (35346 38788 (LAFITE.AROUNDEXIT 35356 . 35894) (
\LAFITE.MARK.FOLDERS.OBSOLETE 35896 . 36812) (\LAFITE.CHECK.FOLDERS 36814 . 37213) (
\LAFITE.ASSURE.FOLDER.READY 37215 . 37625) (\LAFITE.AFTERLOGIN 37627 . 38786)) (38820 41758 (
LA.RESETSHADE 38830 . 39208) (LA.MENU.ITEM 39210 . 39628) (NTHMESSAGE 39630 . 39713) (
\LAFITE.MAKE.MSGARRAY 39715 . 40145) (\LAFITE.ADDMESSAGES.TO.ARRAY 40147 . 40728) (
\MAILFOLDER.DEFPRINT 40730 . 40977) (\LAFITEMSG.DEFPRINT 40979 . 41141) (LA.POSITION.FROM.REGION 41143
. 41620) (MAILFOLDERBUSY 41622 . 41756)) (41936 58324 (TOCFILENAME 41946 . 42377) (DELETEMAILFOLDER
42379 . 42899) (\LAFITE.OPEN.FOLDER 42901 . 47516) (\LAFITE.REPORT.FILE.WONT.OPEN 47518 . 48242) (
\LAFITE.FOLDER.CHANGED 48244 . 50648) (\LAFITE.REBROWSE.FOLDER 50650 . 53615) (
\LAFITE.FOLDER.CHANGED.MENU 53617 . 54540) (\LAFITE.SET.FOLDER.STREAM 54542 . 55236) (
\LAFITE.OPENSTREAM 55238 . 55777) (\LAFITE.CREATE.MENU 55779 . 56132) (\LAFITE.EOF 56134 . 57476) (
\LAFITE.CLOSE.FOLDER 57478 . 58322)) (58325 58909 (\LAFITE.DESCRIBE.FOLDER 58335 . 58907)) (58970
60076 (LOAD-LAFITE 58980 . 60074)) (67787 69064 (\LAFITE.GLOBAL.INIT 67797 . 69062)))))
(FILEMAP (NIL (7104 22150 (LAFITE 7114 . 8425) (LAFITE.ON.FROM.BACKGROUND 8427 . 8798) (\LAFITE.OFF
8800 . 9184) (\LAFITE.START.PROC 9186 . 10962) (LAFITE.COMPUTE.CACHED.VARS 10964 . 13666) (
\LAFITE.PROCESS 13668 . 14034) (\LAFITE.START.ABORT 14036 . 14228) (\LAFITE.QUIT 14230 . 14472) (
\LAFITE.RESTART 14474 . 14607) (\LAFITE.SUBQUIT 14609 . 15907) (\LAFITE.QUIT.PROC 15909 . 18645) (
\LAFITEDEFAULTHOST&DIR 18647 . 19457) (LAFITEDEFAULTHOST&DIR 19459 . 19629) (MAKELAFITECOMMANDWINDOW
19631 . 21270) (EXTRACTMENUCOMMAND 21272 . 21520) (DOMAINLAFITECOMMAND 21522 . 21671) (
LAFITE.TOGGLE.SERVER.TRACE 21673 . 22148)) (22225 25193 (LAFITEMODE 22235 . 22715) (\LAFITE.INFER.MODE
22717 . 23070) (\LAFITE.SHOW.MODE 23072 . 23309) (\LAFITE.MODE.TITLE 23311 . 23596) (
LAFITE.SHOW.MODE.P 23598 . 23839) (LAFITE.ALL.MODES.P 23841 . 24184) (SET.LAFITE.MODE.INTERACTIVELY
24186 . 24768) (\LAFITE.COMPUTE.MODE.COMMANDS 24770 . 25191)) (26043 27799 (\LAFITE.LOGIN 26053 .
26435) (\LAFITE.LOGIN.NORESTART 26437 . 26543) (LAFITE.PROMPT.FOR.LOGIN 26545 . 27564) (
\LAFITE.REAUTHENTICATE 27566 . 27797)) (35310 38752 (LAFITE.AROUNDEXIT 35320 . 35858) (
\LAFITE.MARK.FOLDERS.OBSOLETE 35860 . 36776) (\LAFITE.CHECK.FOLDERS 36778 . 37177) (
\LAFITE.ASSURE.FOLDER.READY 37179 . 37589) (\LAFITE.AFTERLOGIN 37591 . 38750)) (38784 41722 (
LA.RESETSHADE 38794 . 39172) (LA.MENU.ITEM 39174 . 39592) (NTHMESSAGE 39594 . 39677) (
\LAFITE.MAKE.MSGARRAY 39679 . 40109) (\LAFITE.ADDMESSAGES.TO.ARRAY 40111 . 40692) (
\MAILFOLDER.DEFPRINT 40694 . 40941) (\LAFITEMSG.DEFPRINT 40943 . 41105) (LA.POSITION.FROM.REGION 41107
. 41584) (MAILFOLDERBUSY 41586 . 41720)) (41900 58288 (TOCFILENAME 41910 . 42341) (DELETEMAILFOLDER
42343 . 42863) (\LAFITE.OPEN.FOLDER 42865 . 47480) (\LAFITE.REPORT.FILE.WONT.OPEN 47482 . 48206) (
\LAFITE.FOLDER.CHANGED 48208 . 50612) (\LAFITE.REBROWSE.FOLDER 50614 . 53579) (
\LAFITE.FOLDER.CHANGED.MENU 53581 . 54504) (\LAFITE.SET.FOLDER.STREAM 54506 . 55200) (
\LAFITE.OPENSTREAM 55202 . 55741) (\LAFITE.CREATE.MENU 55743 . 56096) (\LAFITE.EOF 56098 . 57440) (
\LAFITE.CLOSE.FOLDER 57442 . 58286)) (58289 58873 (\LAFITE.DESCRIBE.FOLDER 58299 . 58871)) (58934
60040 (LOAD-LAFITE 58944 . 60038)) (67751 69028 (\LAFITE.GLOBAL.INIT 67761 . 69026)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

View File

@@ -1,47 +1,45 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 3-Jun-92 10:10:41" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;2 15951
(FILECREATED "30-Sep-2021 23:01:05" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;2 14882
previous date%: "15-Jun-90 16:06:40" {DSK}<usr>local>users>welch>lisp>lafite>LAFITEFIND.;1)
changes to%: (FILES LAFITEDECLS)
previous date%: " 3-Jun-92 10:10:41"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;1)
(* ; "
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT LAFITEFINDCOMS)
(RPAQQ LAFITEFINDCOMS ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD
\LAFITE.GO.TO.FIRST \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST
\LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT \LAFITE.DO.FIND
\LAFITE.FIND.START)
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS
LAFITEFINDTYPEMENU LAFITEFINDAREAMENU LAFITEEXTRAMENU
LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
(FILES (SOURCE)
LAFITEDECLS)
(LOCALVARS . T))
(INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
(VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
(ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND
"Search mail for something")
["Find Related" '\LAFITE.FIND.RELATED
"Find all messages from here on in reply to this message"
(SUBITEMS ("Find Related Forward"
'\LAFITE.FIND.RELATED)
("Find Related Backward"
'\LAFITE.FIND.RELATED.BACKWARD]
("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search"
)
("Go to #" '\LAFITE.GO.TO.INTERACTIVE
"Scroll to and select a specific message by number."
(SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST
"Scroll to and select first message."
)
("Go to Last" '\LAFITE.GO.TO.LAST
"Scroll to and select last message."]
(LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
(VARS (\LAFITE.LAST.SEARCH))))
(RPAQQ LAFITEFINDCOMS
((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST
\LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT
\LAFITE.DO.FIND \LAFITE.FIND.START)
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS SEARCHSTATE)
(GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU
LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
(FILES (SOURCE)
LAFITEDECLS)
(LOCALVARS . T))
(INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
(VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
(ADDVARS [LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND "Search mail for something")
["Find Related" '\LAFITE.FIND.RELATED
"Find all messages from here on in reply to this message"
(SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
("Find Related Backward" '\LAFITE.FIND.RELATED.BACKWARD]
("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
("Go to #" '\LAFITE.GO.TO.INTERACTIVE
"Scroll to and select a specific message by number."
(SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST
"Scroll to and select first message.")
("Go to Last" '\LAFITE.GO.TO.LAST
"Scroll to and select last message."]
(LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU))
(VARS (\LAFITE.LAST.SEARCH))))
(DEFINEQ
(\LAFITE.FIND
@@ -147,45 +145,47 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992 by Venue & Xerox Corporat
(RPAQ? LAFITEFINDAREAMENU NIL)
(RPAQQ LAFITEFINDAREAMENUITEMS ((From 'From "Search From: field for string (or To: if from self)"
)
(Subject 'Subject "Search Subject: field for string")
(Body 'Body "Search message bodies for string")
(Mark 'Mark "Search for messages with specified mark character")
(Related 'Related
"Search for a message with same Subject, modulo Re:")))
(RPAQQ LAFITEFINDAREAMENUITEMS
((From 'From "Search From: field for string (or To: if from self)")
(Subject 'Subject "Search Subject: field for string")
(Body 'Body "Search message bodies for string")
(Mark 'Mark "Search for messages with specified mark character")
(Related 'Related "Search for a message with same Subject, modulo Re:")))
(RPAQQ LAFITEFINDTYPEMENUITEMS (("Find Next One" '(FORWARD ONE)
"Search forward from selected message")
("Find Next All" '(FORWARD ALL)
"Search forward from selected message")
("Find Previous One" '(BACKWARD ONE)
"Search backward from selected message")
("Find Previous All" '(BACKWARD ALL)
"Search backward from selected message")))
(RPAQQ LAFITEFINDTYPEMENUITEMS
(("Find Next One" '(FORWARD ONE)
"Search forward from selected message")
("Find Next All" '(FORWARD ALL)
"Search forward from selected message")
("Find Previous One" '(BACKWARD ONE)
"Search backward from selected message")
("Find Previous All" '(BACKWARD ALL)
"Search backward from selected message")))
(ADDTOVAR LAFITEEXTRAMENUITEMS ("Find" '\LAFITE.FIND "Search mail for something")
["Find Related" '\LAFITE.FIND.RELATED
"Find all messages from here on in reply to this message"
(SUBITEMS ("Find Related Forward" '\LAFITE.FIND.RELATED)
("Find Related Backward"
'\LAFITE.FIND.RELATED.BACKWARD]
("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
("Go to #" '\LAFITE.GO.TO.INTERACTIVE
"Scroll to and select a specific message by number."
(SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST
"Scroll to and select first message.")
("Go to Last" '\LAFITE.GO.TO.LAST
"Scroll to and select last message."))))
(ADDTOVAR LAFITEEXTRAMENUITEMS
("Find" '\LAFITE.FIND "Search mail for something")
["Find Related" '\LAFITE.FIND.RELATED
"Find all messages from here on in reply to this message" (SUBITEMS
("Find Related Forward"
'\LAFITE.FIND.RELATED)
("Find Related Backward"
'
\LAFITE.FIND.RELATED.BACKWARD
]
("Find Again" '\LAFITE.FIND.AGAIN "Repeat previous search")
("Go to #" '\LAFITE.GO.TO.INTERACTIVE "Scroll to and select a specific message by number."
(SUBITEMS ("Go to First" '\LAFITE.GO.TO.FIRST "Scroll to and select first message.")
("Go to Last" '\LAFITE.GO.TO.LAST "Scroll to and select last message."))))
(ADDTOVAR LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
(RPAQQ \LAFITE.LAST.SEARCH NIL)
(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992))
(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3089 12861 (\LAFITE.FIND 3099 . 4131) (\LAFITE.FIND.RELATED 4133 . 4798) (
\LAFITE.FIND.RELATED.BACKWARD 4800 . 4936) (\LAFITE.GO.TO.FIRST 4938 . 5105) (
\LAFITE.GO.TO.INTERACTIVE 5107 . 5719) (\LAFITE.GO.TO.LAST 5721 . 5929) (\LAFITE.FIND.AGAIN 5931 .
6513) (\LAFITE.FIND.PROMPT 6515 . 8637) (\LAFITE.DO.FIND 8639 . 11790) (\LAFITE.FIND.START 11792 .
12859)))))
(FILEMAP (NIL (2309 12081 (\LAFITE.FIND 2319 . 3351) (\LAFITE.FIND.RELATED 3353 . 4018) (
\LAFITE.FIND.RELATED.BACKWARD 4020 . 4156) (\LAFITE.GO.TO.FIRST 4158 . 4325) (
\LAFITE.GO.TO.INTERACTIVE 4327 . 4939) (\LAFITE.GO.TO.LAST 4941 . 5149) (\LAFITE.FIND.AGAIN 5151 .
5733) (\LAFITE.FIND.PROMPT 5735 . 7857) (\LAFITE.DO.FIND 7859 . 11010) (\LAFITE.FIND.START 11012 .
12079)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

View File

@@ -1,19 +1,334 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 7-Feb-95 13:10:22" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;2 12117
changes to%: (VARS LAFITESORTCOMS)
previous date%: " 7-Oct-89 14:07:49" {DSK}<lispcore>lafite>parc-94>LAFITESORT.;1)
(* ; "
Copyright (c) 1989, 1995 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LAFITESORTCOMS)
(RPAQQ LAFITESORTCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS))
(FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY
LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Sep-2021 22:58:58" 
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1 19675
previous date%: " 7-Feb-95 13:10:22"
{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1)
(* ; "
Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITESORTCOMS)
(RPAQQ LAFITESORTCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
LAFITEDECLS))
(FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY
LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER
\LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION)
[APPENDVARS (LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
(SUBITEMS ("Sort Entire Folder"
'\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
)
("Sort Selected Range"
'\LAFITE.SORT.BY.DATE.REGION
"Sort only the messages between the first and last selected messages."
]
(COMS (* ; "Date hax")
(FNS GDATE1-6)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS \4YearsDays)
(GLOBALVARS \TimeZoneComp \DayLightSavings])
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
LAFITEDECLS)
)
(DEFINEQ
(LAFITE.ASSURE.DATE.FIELDS
[LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 5-May-89 15:46 by bvm")
(* ;; "Assure that messages FIRST# thru LAST# have IDATE fields. FIRST# & LAST# default.")
(for I from (OR FIRST# 1) to (OR LAST# (fetch (MAILFOLDER %#OFMESSAGES)
of FOLDER))
bind (STREAM _ (\LAFITE.OPEN.FOLDER FOLDER 'INPUT :ABORT))
(MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER))
(FAILURECNT _ 0)
(MISSING _ 0)
MSG ID PREV DATEFAILURE DATEFETCHED BABBLED
do [if (fetch (LAFITEMSG DATEFETCHED?) of (SETQ MSG (NTHMESSAGE MESSAGES I)))
then (* ; "Ok")
(if (NOT (fetch (LAFITEMSG DATEKNOWN?) of MSG))
then (add FAILURECNT 1))
else (if (NOT BABBLED)
then (* ; "Tell user what's taking so long")
(LAB.PROMPTPRINT FOLDER "Collecting dates... ")
(SETQ BABBLED T))
(if (FIXP (SETQ ID (LAFITE.PARSE.HEADER STREAM \LAPARSE.DATEFIELD
(fetch (LAFITEMSG START) of MSG)
(fetch (LAFITEMSG END) of MSG)
T)))
then (replace (LAFITEMSG IDATE) of MSG with ID)
(replace (LAFITEMSG DATEKNOWN?) of MSG with T)
(replace (LAFITEMSG DATEFETCHED?) of MSG with T)
(replace (LAFITEMSG DATE) of MSG with NIL)
(* ;
 "So it will be regenerated in canonical form")
(OR DATEFETCHED (SETQ DATEFETCHED I))
else (replace (LAFITEMSG DATEKNOWN?) of MSG with NIL)
(if LAFITEDEBUGFLG
then (LAB.FORMAT FOLDER
" ~:[Date missing for~;Could not parse date of~] msg ~D. "
ID I))
(add FAILURECNT 1)
(if (NULL ID)
then (add MISSING 1))
(if [AND (> I 1)
(fetch (LAFITEMSG DATEFETCHED?)
of (SETQ PREV (NTHMESSAGE MESSAGES (SUB1 I]
then (* ;
 "Guess that message i has date just after i-1")
(replace (LAFITEMSG IDATE) of MSG
with (ADD1 (fetch (LAFITEMSG IDATE) of PREV)))
(replace (LAFITEMSG DATEFETCHED?) of MSG with
T)
else (SETQ DATEFAILURE I]
finally (if (AND DATEFETCHED (< DATEFETCHED (fetch (MAILFOLDER TOCLASTMESSAGE#)
of FOLDER)))
then (* ;
 "Assure that the toc will be rewritten at least this far back so that we save the dates.")
(replace (MAILFOLDER TOCLASTMESSAGE#) of FOLDER with
DATEFETCHED
))
(COND
([AND DATEFAILURE (NOT (for I from (ADD1 (OR FIRST# 1))
to (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)
when (fetch (LAFITEMSG DATEFETCHED?)
of (SETQ MSG (NTHMESSAGE MESSAGES I)))
do (* ; "Got a date later on")
(SETQ ID (fetch (LAFITEMSG IDATE) of MSG))
(for J from DATEFAILURE
to (OR FIRST# 1) by -1
do (* ;
 "Store guess dates for first message(s)")
(replace (LAFITEMSG IDATE)
of (SETQ MSG (NTHMESSAGE MESSAGES J))
with (add ID -1))
(replace (LAFITEMSG DATEFETCHED?)
of MSG with T))
(RETURN T]
(LAB.PROMPTPRINT FOLDER "Could not parse dates of ANY messages in this file."))
((> FAILURECNT 0)
(LAB.FORMAT FOLDER (if (< MISSING FAILURECNT)
then
" Note: Could not parse date field of ~D of these messages."
else " Note: Missing date field for ~D of these messages.")
FAILURECNT])
(LAFITE.PARSE.DATE.FIELD
[LAMBDA (STREAM) (* ; "Edited 5-May-89 12:52 by bvm")
(LET* ((DATESTR (LAFITE.READ.TO.EOL STREAM))
(ID (IDATE DATESTR)))
(if [AND ID (> ID (CONSTANT (IDATE "1-jan-70 1200"]
then (* ; "Plausible date. Test is for those silly senders who didn't get the date set and have messages reading %"31-dec-00 ...%"")
ID
else (CONCAT (OR (SUBSTRING DATESTR 1 6 DATESTR)
DATESTR)
"?"])
(LAFITE.PARSE.DATE.FIELD.ONLY
[LAMBDA (STREAM)
(DECLARE (USEDFREE PARSERESULT)) (* ; "Edited 26-Apr-89 14:35 by bvm")
(SETQ PARSERESULT (LAFITE.PARSE.DATE.FIELD STREAM])
(LAFITE.SORT.BY.DATE
[LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 26-Apr-89 15:32 by bvm")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER)
(LAFITE.ASSURE.DATE.FIELDS FOLDER FIRST# LAST#)
(LAFITE.SORT.MESSAGES FOLDER (FUNCTION LAFITEMSG.DATE.ORDER)
FIRST# LAST#))])
(LAFITE.SORT.MESSAGES
[LAMBDA (FOLDER COMPAREFN FIRST# LAST#) (* ; "Edited 7-Oct-89 14:03 by bvm")
(WITH.MONITOR (fetch (MAILFOLDER FOLDERLOCK) of FOLDER)
(OR FIRST# (SETQ FIRST# 1))
(OR LAST# (SETQ LAST# (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)))
(LAB.PROMPTPRINT FOLDER "Sorting... ")
(LET* ((MESSAGES (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of FOLDER))
(SORTED (CL:STABLE-SORT (for I from FIRST# to LAST#
collect (NTHMESSAGE MESSAGES I))
COMPAREFN)))
(while (AND SORTED (EQ (fetch (LAFITEMSG %#) of (CAR SORTED))
FIRST#)) do (* ;
 "Skip over the initial prefix of in-order messages")
(add FIRST# 1)
(SETQ SORTED (CDR SORTED)))
(if (NULL SORTED)
then (LAB.PROMPTPRINT FOLDER "already in order")
else (replace (MAILFOLDER FOLDEROUTOFORDER) of FOLDER with T)
(if (< FIRST# (fetch (MAILFOLDER FIRSTCHANGEDMESSAGE) of FOLDER))
then (replace (MAILFOLDER FIRSTCHANGEDMESSAGE) of FOLDER
with FIRST#))
(UNINTERRUPTABLY
(for MSG in SORTED as I from FIRST#
do (replace (LAFITEMSG %#) of MSG with I)
(SETA MESSAGES I MSG)))
[LET ((FIRSTSEL (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER))
(LASTSEL (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER)))
(if (>= LASTSEL FIRSTSEL)
then (if (AND (>= FIRSTSEL FIRST#)
(<= FIRSTSEL LAST#))
then (* ;
 "Start of selection was inside here, have to recompute its number")
(replace (MAILFOLDER FIRSTSELECTEDMESSAGE)
of FOLDER with (LAB.FIND.SELECTED.MSG
FOLDER FIRST# LAST#)))
(if (AND (>= LASTSEL FIRST#)
(<= LASTSEL LAST#))
then (* ;
 "End of selection was inside here, have to recompute its number")
(replace (MAILFOLDER LASTSELECTEDMESSAGE)
of FOLDER with (LAB.REV.FIND.SELECTED.MSG
FOLDER FIRST# LAST#]
(LAB.DISPLAYLINES FOLDER FIRST# LAST# NIL T)
(LAB.PROMPTPRINT FOLDER "done"))))])
(LAFITEMSG.DATE.ORDER
[LAMBDA (X Y) (* ; "Edited 26-Apr-89 14:53 by bvm")
(* ;; "True if msg X has older date than msg Y. Since date field is stored as an unboxed 32-bit integer, we open code %"<%" here to avoid boxing.")
(LET [(HIDIFF (- (LOGXOR (fetch (LAFITEMSG IDATEHI) of X)
32768)
(LOGXOR (fetch (LAFITEMSG IDATEHI) of Y)
32768]
(* ;; "HIDIFF is unsigned difference of high words")
(OR (< HIDIFF 0)
(AND (EQ HIDIFF 0)
(< (fetch (LAFITEMSG IDATELO) of X)
(fetch (LAFITEMSG IDATELO) of Y])
(\LAFITE.SORT.BY.DATE.INTERACTIVE
[LAMBDA (FOLDER FIRST# LAST#) (* ; "Edited 3-May-89 18:38 by bvm")
(if (LAB.MOUSECONFIRM FOLDER "Click LEFT to confirm sorting ~D messages by date"
(if LAST#
then (ADD1 (- LAST# FIRST#))
else (fetch (MAILFOLDER %#OFMESSAGES) of FOLDER)))
then (\LAFITE.PROCESS `(,(FUNCTION LAFITE.SORT.BY.DATE)
',FOLDER
',FIRST#
',LAST#)
"LafiteSort"])
(\LAFITE.SORT.BY.DATE.REGION
[LAMBDA (FOLDER) (* ; "Edited 28-Apr-89 16:23 by bvm")
(LET ((FIRST# (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of FOLDER))
(LAST# (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of FOLDER)))
(if (> LAST# FIRST#)
then (\LAFITE.SORT.BY.DATE.INTERACTIVE FOLDER FIRST# LAST#)
else (LAB.FORMAT FOLDER "There is ~:[no~;only one~] message selected."
(EQ LAST# FIRST#])
)
(APPENDTOVAR LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
(SUBITEMS ("Sort Entire Folder"
'\LAFITE.SORT.BY.DATE.INTERACTIVE
"Sort all the messages in this folder by their Date: fields."
)
("Sort Selected Range"
'\LAFITE.SORT.BY.DATE.REGION
"Sort only the messages between the first and last selected messages."
))))
(* ; "Date hax")
(DEFINEQ
(GDATE1-6
[LAMBDA (D) (* ; "Edited 26-Apr-89 15:24 by bvm")
(* ;; "Return a string containing the day and month given in internal date D.")
(* ;; "This is an optimization by source code simplification of (SUBSTRING (GDATE IDT) 1 6)")
(PROG ((CHECKDLS \DayLightSavings)
[DQ (IQUOTIENT (LRSH (LISP.TO.ALTO.DATE D)
1)
(CONSTANT (IQUOTIENT (TIMES 60 60)
2]
HR DAY4 YDAY WDAY YEAR4 TOTALDAYS DLS) (* ;
 "DQ is number of hours since day 0, getting us past the sign bit problem.")
(* ;; "Now we can adjust to the current time zone. Since this might cause DQ to go negative, first add in 4 years worth of hours, making the base date be Jan 1, 1897")
(SETQ HR (IREMAINDER (SETQ DQ (- (+ DQ (CONSTANT (ITIMES 24 \4YearsDays)))
\TimeZoneComp))
24))
(SETQ TOTALDAYS (IQUOTIENT DQ 24))
DTLOOP
(SETQ DAY4 (IREMAINDER TOTALDAYS \4YearsDays)) (* ;
 "DAY4 = number of days since last leap year day 0")
[SETQ DAY4 (+ DAY4 (CDR (\DTSCAN DAY4 '((789 . 3)
(424 . 2)
(59 . 1)
(0 . 0] (* ;
 "pretend every year is a leap year, adding one for days after Feb 28")
(SETQ YEAR4 (IQUOTIENT TOTALDAYS \4YearsDays)) (* ;
 "YEAR4 = number of years til that last leap year / 4")
(SETQ YDAY (IREMAINDER DAY4 366)) (* ;
 "YDAY is the ordinal day in the year (jan 1 = zero)")
(SETQ WDAY (IREMAINDER (+ TOTALDAYS 3)
7))
[COND
((AND CHECKDLS (SETQ DLS (\ISDST? YDAY HR WDAY)))
(* ;; "This date is during daylight savings, so add 1 hour. Third arg is day of the week, which we determine by taking days mod 7 plus offset. Monday = zero in this scheme. Jan 1 1897 was actually a Friday (not Thursday=3), but we're cheating--1900 was not a leap year")
(COND
((> (SETQ HR (ADD1 HR))
23)
(* ;; "overflowed into the next day. This case is too hard (we might have overflowed the month, for example), so just go back and recompute")
(SETQ TOTALDAYS (ADD1 TOTALDAYS))
(SETQ HR 0)
(SETQ CHECKDLS NIL)
(GO DTLOOP]
(RETURN (LET* [[MONTH (\DTSCAN YDAY '((335 . "Dec")
(305 . "Nov")
(274 . "Oct")
(244 . "Sep")
(213 . "Aug")
(182 . "Jul")
(152 . "Jun")
(121 . "May")
(91 . "Apr")
(60 . "Mar")
(31 . "Feb")
(0 . "Jan"]
[DAY (ADD1 (- YDAY (CAR MONTH]
(RESULT (CONCAT " " (CDR MONTH]
(\RPLRIGHT RESULT 2 DAY 1)
RESULT])
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQQ \4YearsDays 1461)
(CONSTANTS \4YearsDays)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TimeZoneComp \DayLightSavings)
)
)
(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989 1995 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2020 14676 (LAFITE.ASSURE.DATE.FIELDS 2030 . 8127) (LAFITE.PARSE.DATE.FIELD 8129 . 8766
) (LAFITE.PARSE.DATE.FIELD.ONLY 8768 . 8983) (LAFITE.SORT.BY.DATE 8985 . 9345) (LAFITE.SORT.MESSAGES
9347 . 12737) (LAFITEMSG.DATE.ORDER 12739 . 13487) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13489 . 14133) (
\LAFITE.SORT.BY.DATE.REGION 14135 . 14674)) (15566 19381 (GDATE1-6 15576 . 19379)))))
STOP

Binary file not shown.

View File

@@ -1,14 +1,18 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-May-92 11:28:47" {DSK}<project>medley2.0>library>lafitetedit.;7 12308
(FILECREATED "30-Sep-2021 23:07:55" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITETEDIT.;3 12516
changes to%: (FNS TEDIT.ASSURE.NO.BACKING.FILE)
(VARS LAFITETEDITCOMS)
changes to%: (VARS LAFITETEDITCOMS)
(FNS LA.ADJUST.FORMATTING LA.SKIP.LOOKS.LIST LA.DETACH.TEDIT LA.TEDIT.INCLUDE
LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
(FILES LAFITEDECLS)
previous date%: "29-Apr-92 13:30:23" {DSK}<project>medley2.0>library>lafitetedit.;5)
previous date%: "30-Sep-2021 22:59:28"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITETEDIT.;2)
(* ; "
Copyright (c) 1988, 1990, 1992 by Xerox Corporation. All rights reserved.
Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT LAFITETEDITCOMS)
@@ -21,10 +25,10 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation. All rights reserved.
LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE)
(DECLARE%: EVAL@COMPILE DONTCOPY
(* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING. Can't just do (FILES (SOURCE) TEDITDECLS), because there is a compiled version that is already loaded that isn't enough.")
(* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING. Can't just do (FILES (SOURCE) TEDITDCL), because there is a compiled version that is already loaded that isn't enough.")
(P (CL:UNLESS (GET 'TEDITDECLS 'FILE)
(FILESLOAD TEDITDECLS)))
(P (CL:UNLESS (GET 'TEDITDCL 'FILE)
(FILESLOAD TEDITDCL)))
(FILES (SOURCE)
LAFITEDECLS)
(GLOBALVARS *TEDIT-FILE-READTABLE*)
@@ -181,8 +185,8 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation. All rights reserved.
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(CL:UNLESS (GET 'TEDITDECLS 'FILE)
(FILESLOAD TEDITDECLS))
(CL:UNLESS (GET 'TEDITDCL 'FILE)
(FILESLOAD TEDITDCL))
(FILESLOAD (SOURCE)
@@ -198,9 +202,9 @@ Copyright (c) 1988, 1990, 1992 by Xerox Corporation. All rights reserved.
(LOCALVARS . T)
)
)
(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992))
(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1342 11940 (LA.ADJUST.FORMATTING 1352 . 7488) (LA.SKIP.LOOKS.LIST 7490 . 8064) (
LA.DETACH.TEDIT 8066 . 8431) (LA.TEDIT.INCLUDE 8433 . 8922) (LA.WINDOW.FROM.TEXTSTREAM 8924 . 9370) (
TEDIT.ASSURE.NO.BACKING.FILE 9372 . 11938)))))
(FILEMAP (NIL (1549 12147 (LA.ADJUST.FORMATTING 1559 . 7695) (LA.SKIP.LOOKS.LIST 7697 . 8271) (
LA.DETACH.TEDIT 8273 . 8638) (LA.TEDIT.INCLUDE 8640 . 9129) (LA.WINDOW.FROM.TEXTSTREAM 9131 . 9577) (
TEDIT.ASSURE.NO.BACKING.FILE 9579 . 12145)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long

Binary file not shown.

1390
library/lafite/UNIXMAIL Normal file

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -0,0 +1,50 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Sep-2021 11:37:28" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;3 1644
changes to%: (FNS BACKGROUND-YIELD)
(VARS BACKGROUND-YIELDCOMS)
previous date%: "19-Sep-2021 13:37:10" {DSK}<home>larry>medley>lispusers>BACKGROUND-YIELD.;1)
(PRETTYCOMPRINT BACKGROUND-YIELDCOMS)
(RPAQQ BACKGROUND-YIELDCOMS (
(* ;;
 " Add a call to BACKGROUNDFNS to yield when not otherwise busy")
(FNS BACKGROUND-YIELD INIT-YIELD)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT-YIELD T)))
(VARS BACKGROUND-YIELD)))
(* ;; " Add a call to BACKGROUNDFNS to yield when not otherwise busy")
(DEFINEQ
(BACKGROUND-YIELD
[LAMBDA NIL (* ; "Edited 20-Sep-2021 11:37 by larry")
(IF (FIXP BACKGROUND-YIELD)
THEN (SUBRCALL YIELD BACKGROUND-YIELD)
(SUBRCALL CAUSE-INTERRUPT])
(INIT-YIELD
[LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry")
(SETQ BACKGROUNDFNS (REMOVE 'BACKGROUND-YIELD BACKGROUNDFNS))
(if [AND ONP (CCODEP (GETD 'BACKGROUND-YIELD]
then
(* ;; " add to end")
(SETQ BACKGROUNDFNS (APPEND BACKGROUNDFNS '(BACKGROUND-YIELD])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(INIT-YIELD T)
)
(RPAQQ BACKGROUND-YIELD 8333330)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (879 1528 (BACKGROUND-YIELD 889 . 1144) (INIT-YIELD 1146 . 1526)))))
STOP

Binary file not shown.

File diff suppressed because one or more lines are too long

View File

@@ -1,531 +0,0 @@
(FILECREATED "18-Feb-87 15:42:27" {SUMEX-AIM}PS:<TMAX.SOURCES>DATE.;4 19668
previous date: "17-Feb-87 14:29:37" {SUMEX-AIM}<GILMURRAY.LISP>DATE.;7)
(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
(PRETTYCOMPRINT DATECOMS)
(RPAQQ DATECOMS ((* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(FNS DATEOBJ DATEOBJP DATE.DISPLAYFN DATE.IMAGEBOXFN CURRENT.DISPLAY.FONT DATE.PUTFN
DATE.GETFN DATE.BUTTONEVENTINFN DATES.TEMPLATE AMPM DATES.MENU.APPLY
DATES.MENU.WHENSELECTEDFN DATES.SET FINDDAY FINDHOUR FINDMONTH FINDTIME FINDYEAR NUMP
WHICHDATE)
(RECORDS DATEOBJ STREAM FONTCLASS)))
(* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(DEFINEQ
(DATEOBJ
(LAMBDA (TEMPLATE) (* fsg "23-Jul-86 09:53")
(* Create an instance of a date imageobj.
A dateobj is also defined as a record with a 
datestring field. *)
(LET* ((TEMPLATE.TYPE (OR TEMPLATE '(M D Y F)))
(DATEANDTIME (MKSTRING (DATE)))
(DISPLAYDATE (MKSTRING (DATES.TEMPLATE DATEANDTIME TEMPLATE.TYPE)))
(NEWOBJ (IMAGEOBJCREATE (create DATEOBJ
DATESTRING _ DATEANDTIME
DISPLAY.DATE _ DISPLAYDATE
TEMPLATE.DATE _ TEMPLATE.TYPE)
(IMAGEFNSCREATE (FUNCTION DATE.DISPLAYFN)
(FUNCTION DATE.IMAGEBOXFN)
(FUNCTION DATE.PUTFN)
(FUNCTION DATE.GETFN)
(FUNCTION NILL)
(FUNCTION DATE.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))))
(* By convention, every image object will have a type 
property associated with it that will facilitate 
imageobj mapping in a TEdit file.)
(IMAGEOBJPROP NEWOBJ 'TYPE
'DATEOBJ)
NEWOBJ)))
(DATEOBJP
(LAMBDA (IMOBJ) (* ss: "24-Jun-85 16:33")
(* Tests an imageobj to see if it is a date imageobject. By convention, testing functions for an imageobject will 
be named (CONCAT <type of imageobj> "P"))
(AND IMOBJ (EQ (IMAGEOBJPROP IMOBJ 'TYPE)
'DATEOBJ))))
(DATE.DISPLAYFN
(LAMBDA (OBJ STREAM STREAMTYPE HOSTSTREAM) (* fsg "17-Feb-87 09:28")
(* * Display function for date imageobjs.)
(PRIN1 (fetch DISPLAY.DATE of (fetch OBJECTDATUM of OBJ))
STREAM)))
(DATE.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* fsg "15-Feb-87 14:05")
(* * Return the ImageBox for the date string. The size is determined by the stream's current font.)
(DSPFONT (CURRENT.DISPLAY.FONT STREAM)
STREAM)
(create IMAGEBOX
XSIZE _(STRINGWIDTH (fetch DISPLAY.DATE of (fetch OBJECTDATUM of OBJ))
STREAM)
YSIZE _(FONTPROP STREAM 'HEIGHT)
YDESC _(FONTPROP STREAM 'DESCENT)
XKERN _ 0)))
(CURRENT.DISPLAY.FONT
(LAMBDA (STREAM) (* fsg "17-Feb-87 10:19")
(* * Return the current font. This function is here instead of TMAX because the DATE code is also used in the 
LetterHead code.)
(LET ((CURRENT.FONT (fetch CLFONT of (with TEXTSTREAM
(TEXTSTREAM (CAR (fetch \WINDOW
of TEXTOBJ)))
CURRENTLOOKS))))
(COND
((TYPENAMEP CURRENT.FONT 'FONTDESCRIPTOR)
CURRENT.FONT)
((TYPENAMEP CURRENT.FONT 'FONTCLASS)
(fetch DISPLAYFD of CURRENT.FONT))
(T (SHOULDNT "Can't get current font"))))))
(DATE.PUTFN
(LAMBDA (DATEOBJ STREAM) (* fsg " 4-Feb-87 09:40")
(PRIN2 (LIST 'Date
(fetch (DATEOBJ TEMPLATE.DATE) of (fetch OBJECTDATUM of DATEOBJ)))
STREAM)))
(DATE.GETFN
(LAMBDA (STREAM) (* fsg " 4-Feb-87 09:42")
(OR (WINDOWPROP (PROCESSPROP (THIS.PROCESS)
'WINDOW)
'IMAGEOBJ.MENUW)
(AND (FGETD 'TSP.FMMENU)
(TSP.FMMENU (TEXTSTREAM (PROCESSPROP (THIS.PROCESS)
'WINDOW)))))
(APPLY 'DATEOBJ
(CDR (READ STREAM)))))
(DATE.BUTTONEVENTINFN
(LAMBDA (DATEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
(* fsg "26-Jan-87 10:06")
(AND (MOUSESTATE MIDDLE)
(LET ((DATE.MENU (create MENU
TITLE _ "Date Menu"
ITEMS _ '((Month% Day,% Year (DATES.TEMPLATE DATE
'(M D Y F))
"Insert current date as %"March 8, 1952%"")
(Month/Day/Year (DATES.TEMPLATE DATE '(M D Y A))
"Insert current date as %"3/8/52%"")
(Day% Month,% Year (DATES.TEMPLATE DATE
'(D M Y F))
"Insert current date as %"8 March, 1952%"")
(Day/Month/Year (DATES.TEMPLATE DATE '(D M Y A))
"Insert current date as %"8/3/52%"")
(Time (DATES.TEMPLATE DATE '(T F))
"Insert current time as %"four thirty p.m.%"")
(Numbered% Time (DATES.TEMPLATE DATE '(T A))
"Insert current time as %"4:30 p.m.%"")
(Military% Time (DATES.TEMPLATE DATE '(T E))
"Insert current time as %"16:30%""))
WHENSELECTEDFN _(FUNCTION DATES.MENU.WHENSELECTEDFN))))
(PUTMENUPROP DATE.MENU 'IMAGEOBJ
DATEOBJ)
(MENU DATE.MENU)
'CHANGED))))
(DATES.TEMPLATE
(LAMBDA (DATE TEMPLATE) (* fsg "24-Jul-86 14:43")
(* * comment)
(COND
(TEMPLATE (LET ((VERSION (if (EQUAL (LAST TEMPLATE)
'(A))
then 'ABBREV
else (if (EQUAL (LAST TEMPLATE)
'(F))
then 'FULL
else 'EURO)))
(FUNCLST '((D FINDDAY)
(M FINDMONTH)
(Y FINDYEAR))))
(COND
((EQ (CAR TEMPLATE)
T)
(FINDTIME DATE VERSION))
(T (LET ((CH (if (EQ VERSION 'ABBREV)
then "/"
else " ")))
(CONCAT (APPLY (CADR (ASSOC (CAR TEMPLATE)
FUNCLST))
(LIST DATE VERSION))
CH
(APPLY (CADR (ASSOC (CADR TEMPLATE)
FUNCLST))
(LIST DATE VERSION))
(if (EQUAL CH " ")
then ", "
else CH)
(APPLY (CADR (ASSOC (CADDR TEMPLATE)
FUNCLST))
(LIST DATE VERSION))))))))
(DATE))))
(AMPM
(LAMBDA (HOUR)
(if (OR (LESSP (MKATOM HOUR)
12)
(EQUAL (MKATOM HOUR)
24))
then "a.m."
else "p.m.")))
(DATES.MENU.APPLY
(LAMBDA (ITEM MENU) (* fsg "31-Jul-86 10:18")
(* This function serves the purpose of calculating the stream and the editing window from information stored on the
window containing the menu. It then applies the appropiate function for each ITEM in the menu*)
(SETQ ITEM (COND
((ATOM ITEM)
ITEM)
(T (CAR ITEM))))
(LET* ((DATE.RECORD (fetch OBJECTDATUM of (GETMENUPROP MENU 'IMAGEOBJ)))
(DATE (fetch DATESTRING of DATE.RECORD)))
(COND
((fetch ITEMS of MENU)
(LET ((FUNCALL (CADR (ASSOC ITEM (fetch ITEMS of MENU)))))
(replace DISPLAY.DATE of DATE.RECORD with (EVAL FUNCALL))
(replace TEMPLATE.DATE of DATE.RECORD with (CADAR (LAST FUNCALL)))))))))
(DATES.MENU.WHENSELECTEDFN
(LAMBDA (ITEM MENU MB) (* fsg "28-Jul-86 14:57")
(COND
((OR (EQ MB 'LEFT)
(EQ MB 'MIDDLE))
(DATES.MENU.APPLY ITEM MENU)))))
(DATES.SET
(LAMBDA (PROPERTY VALUE)
(WINDOWPROP (CREATEW)
PROPERTY VALUE)
VALUE))
(FINDDAY
(LAMBDA (OLDDATE VERSION) (* shw: " 1-Jul-85 11:28")
(MKATOM (if (NUMP (SUBSTRING OLDDATE 1 2))
then (SUBSTRING OLDDATE 1 2)
else (SUBSTRING OLDDATE 2 2)))))
(FINDHOUR
(LAMBDA (HOUR) (* ss: " 8-Feb-86 17:49")
(COND
((LESSP (MKATOM HOUR)
13)
(COND
((LESSP (MKATOM HOUR)
10)
(MKSTRING (CADR (UNPACK HOUR))))
(T HOUR)))
(T (MKSTRING (SELECTQ (MKATOM HOUR)
(13 1)
(14 2)
(15 3)
(16 4)
(17 5)
(18 6)
(19 7)
(20 8)
(21 9)
(22 10)
(23 11)
(24 12)
NIL))))))
(FINDMONTH
(LAMBDA (OLDDATE VERSION) (* shw: " 1-Jul-85 11:38")
(PROG ((DATES '((Jan 1 January)
(Feb 2 February)
(Mar 3 March)
(Apr 4 April)
(May 5 May)
(Jun 6 June)
(Jul 7 July)
(Aug 8 August)
(Sep 9 September)
(Oct 10 October)
(Nov 11 November)
(Dec 12 December)))
(OUTPUT NIL))
(if (EQ VERSION 'ABBREV)
then (SETQ OUTPUT (CAR (CDR (ASSOC (MKATOM (SUBSTRING OLDDATE 4 6))
DATES))))
else (SETQ OUTPUT (CAR (CDDR (ASSOC (MKATOM (SUBSTRING OLDDATE 4 6))
DATES)))))
(RETURN OUTPUT))))
(FINDTIME
(LAMBDA (OLDDATE VERSION) (* shw: "24-Jul-85 15:39")
(LET ((HOUR (SUBSTRING OLDDATE 11 12))
(MINUTES (SUBSTRING OLDDATE 14 15)))
(if (EQUAL VERSION 'ABBREV)
then (CONCAT (FINDHOUR HOUR)
":" MINUTES " " (AMPM HOUR))
else (if (EQUAL VERSION 'EURO)
then (SUBSTRING OLDDATE 11 15)
else (CONCAT (SELECTQ (if (LESSP (MKATOM MINUTES)
46)
then (MKATOM (FINDHOUR HOUR))
else (PLUS 1 (MKATOM (FINDHOUR HOUR))))
(1 "one")
(2 "two")
(3 "three")
(4 "four")
(5 "five")
(6 "six")
(7 "seven")
(8 "eight")
(9 "nine")
(10 "ten")
(11 "eleven")
(12 "twelve")
NIL)
" "
(if (AND (GREATERP (MKATOM MINUTES)
15)
(LESSP (MKATOM MINUTES)
45))
then "thirty"
else "o'clock")
" "
(if (AND (GREATERP (MKATOM MINUTES)
44)
(EQUAL (FINDHOUR HOUR)
"11"))
then (if (EQUAL (AMPM HOUR)
"a.m.")
then "p.m."
else "a.m.")
else (AMPM HOUR))))))))
(FINDYEAR
(LAMBDA (OLDDATE VERSION) (* shw: " 1-Jul-85 11:31")
(if (EQ VERSION 'ABBREV)
then (MKATOM (SUBSTRING OLDDATE 8 9))
else (MKATOM (CONCAT "19" (SUBSTRING OLDDATE 8 9))))))
(NUMP
(LAMBDA (N) (* edited: " 4-Apr-86 17:55")
(* changed)
(NOT (NULL (NUMBERP (MKATOM N))))))
(WHICHDATE
(LAMBDA (VAR1 VAR2 YEAR OLDDATE VERSION) (* edited " 1-Jan-00 00:00")
(* * comment)
(PROG (DIVIDER)
(SETQ DIVIDER (if (EQ VERSION 'ABBREV)
then "/"
else " "))
(RETURN (MKATOM (CONCAT (APPLY VAR1 (LIST OLDDATE VERSION))
DIVIDER
(APPLY VAR2 (LIST OLDDATE VERSION))
DIVIDER
(APPLY YEAR (LIST OLDDATE VERSION))))))))
)
[DECLARE: EVAL@COMPILE
(RECORD DATEOBJ (DATESTRING DISPLAY.DATE TEMPLATE.DATE))
(DATATYPE STREAM ( (* First 4 words are fixed for BIN, BOUT opcodes.
Length of whole datatype is multiple of 4, so 
quad-aligned)
(COFFSET WORD) (* Offset in CPPTR of next bin or bout)
(CBUFSIZE WORD) (* Offset past last byte in that buffer)
(BINABLE FLAG) (* BIN punts unless this bit on)
(BOUTABLE FLAG) (* BOUT punts unless this bit on)
(EXTENDABLE FLAG) (* BOUT punts when COFFSET ge CBUFFSIZE unless this 
bit set and COFFSET lt 512)
(NIL BITS 5)
(CBUFPTR POINTER) (* Pointer to current buffer)
(NONDEFAULTDATEFLG FLAG)
(REVALIDATEFLG FLAG)
(MULTIBUFFERHINT FLAG) (* True if stream likes to read and write more than 
one buffer at a time)
(USERCLOSEABLE FLAG) (* Can be closed by CLOSEF;
NIL for terminal, dribble...)
(USERVISIBLE FLAG) (* Listed by OPENP; NIL for terminal, dribble ...)
(ACCESSBITS BITS 3) (* What kind of access file is open for 
(read, write, append))
(FULLFILENAME POINTER) (* Name by which file is known to user)
(DEVICE POINTER) (* FDEV of this guy)
(VALIDATION POINTER) (* A number somehow identifying file, used to 
determine if file has changed in our absence)
(EPAGE WORD)
(EOFFSET WORD) (* Page, byte offset of eof)
(* Following are device-specific fields)
(F1 POINTER)
(F2 POINTER)
(F3 POINTER)
(F4 POINTER)
(F5 POINTER)
(FW6 WORD)
(FW7 WORD) (* Following only filled in for open streams)
(BYTESIZE BYTE)
(BUFFS POINTER)
(CPAGE WORD)
(FW8 WORD)
(MAXBUFFERS WORD)
(CHARPOSITION WORD) (* Used by POSITION etc.)
(DIRTYBITS WORD)
(LINELENGTH WORD)
(EOLCONVENTION BITS 2) (* End-of-line convention)
(CBUFDIRTY FLAG)
(NIL BITS 5)
(OUTCHARFN POINTER)
(ENDOFSTREAMOP POINTER) (* For use of applications programs, not devices)
(OTHERPROPS POINTER)
(IMAGEOPS POINTER) (* Image operations vector)
(IMAGEDATA POINTER) (* Image instance variables--format depends on 
IMAGEOPS value)
(EXTRASTREAMOP POINTER)
(STRMBINFN POINTER) (* Either the BIN fn from the FDEV, or a trap)
(STRMBOUTFN POINTER) (* Either the BIN fn from the FDEV, or a trap)
(CBUFMAXSIZE WORD)
(FW9 WORD)
(F10 POINTER) (* the current character set for this stream.
gbn 4-2-85)
(CHARSET BYTE))
(BLOCKRECORD STREAM ((NIL 2 WORD)
(UCODEFLAGS BYTE)
(NIL POINTER)))
(ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS)
(FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM)
DATUM))
(NAMEDP (AND (fetch (STREAM FULLFILENAME) of DATUM)
T))))
(SYNONYM CBUFPTR (CPPTR))
USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ NoBits BUFFS _ NIL BYTESIZE _ 8
CBUFPTR _ NIL MAXBUFFERS _(PROGN (DECLARE (GLOBALVARS
\STREAM.DEFAULT.MAXBUFFERS))
\STREAM.DEFAULT.MAXBUFFERS)
CHARPOSITION _ 0 LINELENGTH _(PROGN (DECLARE (GLOBALVARS FILELINELENGTH))
FILELINELENGTH)
OUTCHARFN _(FUNCTION \FILEOUTCHARFN)
ENDOFSTREAMOP _(FUNCTION \EOSERROR)
IMAGEOPS _ \NOIMAGEOPS EOLCONVENTION _(SELECTQ (SYSTEMTYPE)
(D CR.EOLC)
(VAX LF.EOLC)
(JERICHO CRLF.EOLC)
CR.EOLC)
STRMBINFN _(FUNCTION \STREAM.NOT.OPEN)
STRMBOUTFN _(FUNCTION \STREAM.NOT.OPEN))
(DATATYPE FONTCLASS ((PRETTYFONT# BYTE)
DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
]
(/DECLAREDATATYPE 'STREAM
'(WORD WORD FLAG FLAG FLAG (BITS 5)
POINTER FLAG FLAG FLAG FLAG FLAG (BITS 3)
POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER
WORD WORD BYTE POINTER WORD WORD WORD WORD WORD WORD (BITS 2)
FLAG
(BITS 5)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD
POINTER BYTE)
'((STREAM 0 (BITS . 15))
(STREAM 1 (BITS . 15))
(STREAM 2 (FLAGBITS . 0))
(STREAM 2 (FLAGBITS . 16))
(STREAM 2 (FLAGBITS . 32))
(STREAM 2 (BITS . 52))
(STREAM 2 POINTER)
(STREAM 4 (FLAGBITS . 0))
(STREAM 4 (FLAGBITS . 16))
(STREAM 4 (FLAGBITS . 32))
(STREAM 4 (FLAGBITS . 48))
(STREAM 4 (FLAGBITS . 64))
(STREAM 4 (BITS . 82))
(STREAM 4 POINTER)
(STREAM 6 POINTER)
(STREAM 8 POINTER)
(STREAM 10 (BITS . 15))
(STREAM 11 (BITS . 15))
(STREAM 12 POINTER)
(STREAM 14 POINTER)
(STREAM 16 POINTER)
(STREAM 18 POINTER)
(STREAM 20 POINTER)
(STREAM 22 (BITS . 15))
(STREAM 23 (BITS . 15))
(STREAM 20 (BITS . 7))
(STREAM 24 POINTER)
(STREAM 26 (BITS . 15))
(STREAM 27 (BITS . 15))
(STREAM 28 (BITS . 15))
(STREAM 29 (BITS . 15))
(STREAM 30 (BITS . 15))
(STREAM 31 (BITS . 15))
(STREAM 24 (BITS . 1))
(STREAM 24 (FLAGBITS . 32))
(STREAM 24 (BITS . 52))
(STREAM 32 POINTER)
(STREAM 34 POINTER)
(STREAM 36 POINTER)
(STREAM 38 POINTER)
(STREAM 40 POINTER)
(STREAM 42 POINTER)
(STREAM 44 POINTER)
(STREAM 46 POINTER)
(STREAM 48 (BITS . 15))
(STREAM 49 (BITS . 15))
(STREAM 50 POINTER)
(STREAM 50 (BITS . 7)))
'52)
(/DECLAREDATATYPE 'FONTCLASS
'(BYTE POINTER POINTER POINTER POINTER POINTER)
'((FONTCLASS 0 (BITS . 7))
(FONTCLASS 0 POINTER)
(FONTCLASS 2 POINTER)
(FONTCLASS 4 POINTER)
(FONTCLASS 6 POINTER)
(FONTCLASS 8 POINTER))
'10)
(PUTPROPS DATE COPYRIGHT ("Leland Stanford Junior University" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (850 12872 (DATEOBJ 862 . 2359) (DATEOBJP 2363 . 2736) (DATE.DISPLAYFN 2740 . 3015) (
DATE.IMAGEBOXFN 3019 . 3575) (CURRENT.DISPLAY.FONT 3579 . 4284) (DATE.PUTFN 4288 . 4541) (DATE.GETFN
4545 . 4956) (DATE.BUTTONEVENTINFN 4960 . 6275) (DATES.TEMPLATE 6279 . 7439) (AMPM 7443 . 7615) (
DATES.MENU.APPLY 7619 . 8538) (DATES.MENU.WHENSELECTEDFN 8542 . 8780) (DATES.SET 8784 . 8895) (FINDDAY
8899 . 9154) (FINDHOUR 9158 . 9662) (FINDMONTH 9666 . 10427) (FINDTIME 10431 . 11846) (FINDYEAR 11850
. 12124) (NUMP 12128 . 12368) (WHICHDATE 12372 . 12869)))))
STOP

View File

@@ -1,92 +1,95 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 8-Jul-2021 23:33:42" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;16 23978
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS MODERNWINDOW)
(FILECREATED "16-Oct-2021 15:42:11" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41 30305
previous date%: " 3-Jul-2021 10:32:03"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;15)
changes to%: (FNS MODERNIZED.TB.BUTTONEVENTFN)
previous date%: "16-Oct-2021 15:29:38"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40)
(PRETTYCOMPRINT MODERNIZECOMS)
(RPAQQ MODERNIZECOMS
[
(* ;; "Externals")
(* ;; "Externals")
(COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP)
(COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP
\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(INITVARS (MODERN-WINDOW-MARGIN 25)))
(* ;; "Internals")
(* ;; "Internals")
[COMS (FNS MODERNWINDOW.BUTTONEVENTFN NEARTOP NEARESTCORNER INCORNER.REGION)
(* ;; "Behavior for some known window creators")
(* ;; "Behavior for some known window creators")
(FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN)
(FNS \MODERNIZED.FREEMENU.BUTTONEVENTFN MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Add some Meta commands")
(* ;; "Add some Meta commands")
(FNS TEDIT.MODERNIZE TEDIT.SELECTALL)
(FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN TEDIT.SELECTALL)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P
(* ;; "Tedit")
(* ;; "Tedit")
(MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
(TEDIT.MODERNIZE)
(* ;; "Inspector")
(* ;; "Inspector")
(MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
(* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
(* ;; "Freemenu")
(* ;; "File browser")
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN)
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN
'\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(* ;; "SEDIT")
(* ;; "SEDIT")
(MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
(* ;; "Debugger")
(* ;; "Debugger")
(MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
(* ;; "Snap")
(* ;; "Snap")
(MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW)
(* ;; "New execs")
(* ;; "New execs")
(MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC)
(* ;; "Existing exec of the load")
(* ;; "Existing exec of the load")
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
'WINDOW))
(* ;; "Table browser (for filebrowser)")
(* ;; "Table browser and filebrowser)")
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN)
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN
'MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Grapher")
(* ;; "Grapher")
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE)
(* ;; "Sketch")
(* ;; "Sketch")
(MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)
(* ;; "Promptwindow")
(* ;; "Promptwindow")
(MODERNWINDOW PROMPTWINDOW T)
(* ;;
 "Menus: Move only and only with title clicks")
(* ;; "Menus: Move only with title clicks")
(MODERNWINDOW.SETUP 'MENUBUTTONFN
'MODERN-MENUBUTTONFN]
@@ -191,6 +194,17 @@
PKGNAME))
(CL:WHEN (GETD RENAMEDORIG)
(MOVD RENAMEDORIG ORIGFN])
(\MODERNIZED.FREEMENU.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 15:15 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
NIL NIL (WINDOWPROP (CENTRALWINDOW W)
'REGION)
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
)
(RPAQ? MODERN-WINDOW-MARGIN 25)
@@ -202,39 +216,67 @@
(DEFINEQ
(MODERNWINDOW.BUTTONEVENTFN
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION)(* ; "Edited 24-Jun-2021 14:49 by rmk:")
(IF (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0))
THEN (TOTOPW WINDOW)
(LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION))
(ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW]
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
(* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.")
(* ;; "WINDOW is the window that received the click and that should be passed through to the original function, if we don't pick it off here.")
(* ;; "This is particularly the case of FILEBROWSER windows, where the the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")
(* ;; "However, that window may be an auxiliary window (an attached menu? or a lower split-pane in Tedit) whose region and title intuitively should not be used to control shaping and moving behavior. That behavior is determined by the CORNERREGION and TITLED parameters.")
(SETQ TOPMARGIN (IF (WINDOWPROP WINDOW 'TOPMARGIN)
ELSEIF (WINDOWPROP WINDOW 'TITLE)
THEN (FONTPROP WindowTitleDisplayStream 'HEIGHT)
ELSE MODERN-WINDOW-MARGIN))
(SETQ CORNER (INCORNER.REGION MAINREGION TOPMARGIN))
(IF CORNER
THEN
(* ;; "If CORNERREGION is given, we know that there are two windows in play. In that case also TOPMARGIN tells us the hotband at the top of the cornerregion where the move/shaping click is recognized, T to mean that it has an ordinary title bar. .")
(* ;;
 "The upper corners may be in the title bar, near the side, so test corners before titlebar.")
(* ;; "For windows without a top margin, the shape/move region is MODERN-WINDOW-MARGIN points below the top, in the clipping region of the window. ")
(* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")
(* ;; "Not sure about using MODERN-WINDOW-MARGIN for the top region of an untitle window. Maybe it should be 2 times the border width in that case, and the MODERN-WINDOW-MARGIN separately defines the rectangle that constitutes a corner.")
(* ;; "WINDOWREGION includes the attached windows")
(LET (CORNER ATTACHEDREGION)
(IF CORNERREGION
THEN
(LET ((LEFT (FETCH LEFT OF ATTACHEDREGION))
(RIGHT (FETCH RIGHT OF ATTACHEDREGION))
(TOP (FETCH TOP OF ATTACHEDREGION))
(BOTTOM (FETCH BOTTOM OF ATTACHEDREGION))
(* ;; "Caller tells us whether the corner window has a title.")
(CL:UNLESS (FIXP TOPMARGIN)
(SETQ TOPMARGIN (if TOPMARGIN
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
ELSE (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION))
(* ; "WINDOW is the corner window")
(SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN)
elseif (WINDOWPROP WINDOW 'TITLE)
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
(if (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0)
(INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY))
then
(* ;; "INSIDE? check because we may be called by a click in WINDOW that is outside the corner region, we just pass it through.")
(TOTOPW WINDOW)
(SETQ ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW)))
(* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.")
(* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")
(SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN))
(if CORNER
then
(* ;;
 "The upper corners may be in the title bar, near the side, so test corners before titlebar.")
(* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")
(* ;; "WINDOWREGION includes the attached windows")
(LET ((LEFT (fetch (REGION LEFT) of ATTACHEDREGION))
(RIGHT (fetch (REGION RIGHT) of ATTACHEDREGION))
(TOP (fetch (REGION TOP) of ATTACHEDREGION))
(BOTTOM (fetch (REGION BOTTOM) of ATTACHEDREGION))
STARTINGREGION)
(* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")
(* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")
(CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
[SETQ STARTINGREGION
@@ -253,35 +295,32 @@
(GETMOUSESTATE)
(LIST RIGHT BOTTOM LEFT TOP))
(SHOULDNT])
(SHAPEW (CL:IF (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
(WINDOWPROP WINDOW 'MAINWINDOW)
WINDOW)
(SHAPEW (CENTRALWINDOW WINDOW)
STARTINGREGION))
T
ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN TITLEPROPORTION))
THEN (NEARESTCORNER ATTACHEDREGION)
(MOVEW (CL:IF (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS))
(WINDOWPROP WINDOW 'MAINWINDOW)
WINDOW))
elseif (OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION))
then (NEARESTCORNER ATTACHEDREGION)
(MOVEW (CENTRALWINDOW WINDOW))
T
ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
'PREMODERN-BUTTONEVENTFN]
THEN (APPLY* ORIGFUNCTION WINDOW)))
ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
THEN (APPLY* ORIGFUNCTION WINDOW])
then (APPLY* ORIGFUNCTION WINDOW))
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
'PREMODERN-BUTTONEVENTFN]
then (APPLY* ORIGFUNCTION WINDOW])
(NEARTOP
[LAMBDA (MAINREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 24-Jun-2021 14:51 by rmk:")
[LAMBDA (CORNERREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 13-Oct-2021 21:28 by rmk:")
(* ;; "True if the MOUSEY is near the top of MAINREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
(* ;; "True if the MOUSEY is near the top of CORNERREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
(* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")
(* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")
(AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION)
(AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF CORNERREGION)
TOPMARGIN))
(OR (NOT TITLEPROPORTION)
(LET ((WIDTH (FETCH WIDTH of MAINREGION))
(LEFT (FETCH LEFT OF MAINREGION)))
(LET ((WIDTH (FETCH WIDTH of CORNERREGION))
(LEFT (FETCH LEFT OF CORNERREGION)))
(OR (ILESSP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH TITLEPROPORTION)))
(IGREATERP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH (DIFFERENCE 1 TITLEPROPORTION])
@@ -303,25 +342,25 @@
(FETCH TOP OF REGION))])
(INCORNER.REGION
[LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 22-Feb-2021 16:27 by rmk:")
[LAMBDA (CORNERREGION TOPMARGIN) (* ; "Edited 13-Oct-2021 15:04 by rmk:")
(* ;; "MAINREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")
(* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")
(* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")
(* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")
(IF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF MAINREGION)))
(IF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF CORNERREGION)))
MODERN-WINDOW-MARGIN)
THEN (IF (NEARTOP MAINREGION TOPMARGIN)
THEN (IF (NEARTOP CORNERREGION TOPMARGIN)
THEN 'LEFTTOP
ELSEIF (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH BOTTOM
OF MAINREGION)))
OF CORNERREGION)))
THEN 'LEFTBOTTOM)
ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF MAINREGION)))
ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF CORNERREGION)))
MODERN-WINDOW-MARGIN)
THEN (IF (NEARTOP MAINREGION TOPMARGIN)
THEN (IF (NEARTOP CORNERREGION TOPMARGIN)
THEN 'RIGHTTOP
ELSEIF (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (FETCH BOTTOM
OF MAINREGION)))
OF CORNERREGION)))
THEN 'RIGHTBOTTOM])
)
@@ -383,6 +422,44 @@
THEN (MOVEW WINDOW)
ELSE (MODERN-ORIG-MENUBUTTONFN WINDOW])
)
(DEFINEQ
(\MODERNIZED.FREEMENU.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 15:15 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
NIL NIL (WINDOWPROP (CENTRALWINDOW W)
'REGION)
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
(MODERNIZED.TB.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 16-Oct-2021 15:40 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(LET ((CW (CENTRALWINDOW W))
CORNERREG TOPMARGIN)
(CL:WHEN (WINDOWPROP CW 'FILEBROWSER)
[SETQ CORNERREG (UNIONREGIONS (WINDOWPROP (FB.GETWINDOW CW 'HEADING)
'REGION)
(WINDOWPROP (FB.GETWINDOW CW 'COUNTER)
'REGION)
(WINDOWPROP (FB.GETWINDOW CW 'BROWSER)
'REGION]
[SETQ TOPMARGIN (IPLUS (FETCH (REGION HEIGHT) OF (WINDOWPROP (FB.GETWINDOW
CW
'HEADING)
'REGION))
(FETCH (REGION HEIGHT) OF (WINDOWPROP (FB.GETWINDOW
CW
'COUNTER)
'REGION])
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-TB.BUTTONEVENTFN)
NIL NIL CORNERREG TOPMARGIN])
)
@@ -391,10 +468,12 @@
(DEFINEQ
(TEDIT.MODERNIZE
[LAMBDA NIL (* ; "Edited 24-Jun-2021 20:54 by rmk:")
[LAMBDA NIL (* ; "Edited 11-Oct-2021 15:02 by rmk:")
(MODERNWINDOW.SETUP (FUNCTION \TEDIT.BUTTONEVENTFN)
(FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN))
(CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN)
(* ;; "All")
(* ;; "All")
(TEDIT.SETFUNCTION (CHARCODE "Meta,a")
(FUNCTION TEDIT.SELECTALL)
@@ -403,7 +482,7 @@
(FUNCTION TEDIT.SELECTALL)
TEDIT.READTABLE)
(* ;; "Quit")
(* ;; "Quit")
(TEDIT.SETFUNCTION (CHARCODE "Meta,q")
(FUNCTION TEDIT.QUIT)
@@ -412,6 +491,21 @@
(FUNCTION TEDIT.QUIT)
TEDIT.READTABLE))])
(\MODERNIZED.TEDIT.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 21:43 by rmk:")
(* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")
(* ;; "We pass the pain that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
NIL NIL [APPLY (FUNCTION UNIONREGIONS)
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE
'REGION)
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
(TEDIT.SELECTALL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:")
(LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS]
@@ -422,91 +516,89 @@
(DECLARE%: DONTEVAL@LOAD DOCOPY
(* ;; "Tedit")
(* ;; "Tedit")
(MODERNWINDOW.SETUP '\TEDIT.BUTTONEVENTFN)
(TEDIT.MODERNIZE)
(* ;; "Inspector")
(* ;; "Inspector")
(MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
(* (MODERNWINDOW.SETUP
 (QUOTE ONEDINSPECT.BUTTONEVENTFN)))
(* (MODERNWINDOW.SETUP
 (QUOTE ONEDINSPECT.BUTTONEVENTFN)))
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
(* ;; "Freemenu")
(* ;; "File browser")
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN)
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN '\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(* ;; "SEDIT")
(* ;; "SEDIT")
(MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
(* ;; "Debugger")
(* ;; "Debugger")
(MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
(* ;; "Snap")
(* ;; "Snap")
(MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW)
(* ;; "New execs")
(* ;; "New execs")
(MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC)
(* ;; "Existing exec of the load")
(* ;; "Existing exec of the load")
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
'WINDOW))
(* ;; "Table browser (for filebrowser)")
(* ;; "Table browser and filebrowser)")
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN)
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN 'MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Grapher")
(* ;; "Grapher")
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE)
(* ;; "Sketch")
(* ;; "Sketch")
(MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)
(* ;; "Promptwindow")
(* ;; "Promptwindow")
(MODERNWINDOW PROMPTWINDOW T)
(* ;; "Menus: Move only and only with title clicks")
(* ;; "Menus: Move only with title clicks")
(MODERNWINDOW.SETUP 'MENUBUTTONFN 'MODERN-MENUBUTTONFN)
@@ -520,10 +612,12 @@
(ADDTOVAR LAMA MODERN-ADD-EXEC)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4933 10561 (MODERNWINDOW 4943 . 6398) (MODERNWINDOW.SETUP 6400 . 9349) (UNMODERNWINDOW
9351 . 9745) (MODERNWINDOW.UNSETUP 9747 . 10559)) (10626 18766 (MODERNWINDOW.BUTTONEVENTFN 10636 .
15663) (NEARTOP 15665 . 16585) (NEARESTCORNER 16587 . 17466) (INCORNER.REGION 17468 . 18764)) (18824
21146 (MODERN-ADD-EXEC 18834 . 19265) (MODERN-SNAPW 19267 . 19810) (TOTOPW.MODERNIZE 19812 . 20240) (
MODERN-MENUBUTTONFN 20242 . 21144)) (21187 22227 (TEDIT.MODERNIZE 21197 . 21896) (TEDIT.SELECTALL
21898 . 22225)))))
(FILEMAP (NIL (5135 11412 (MODERNWINDOW 5145 . 6600) (MODERNWINDOW.SETUP 6602 . 9551) (UNMODERNWINDOW
9553 . 9947) (MODERNWINDOW.UNSETUP 9949 . 10761) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10763 . 11410)) (
11477 21412 (MODERNWINDOW.BUTTONEVENTFN 11487 . 18287) (NEARTOP 18289 . 19217) (NEARESTCORNER 19219 .
20098) (INCORNER.REGION 20100 . 21410)) (21470 23792 (MODERN-ADD-EXEC 21480 . 21911) (MODERN-SNAPW
21913 . 22456) (TOTOPW.MODERNIZE 22458 . 22886) (MODERN-MENUBUTTONFN 22888 . 23790)) (23793 26222 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 23803 . 24450) (MODERNIZED.TB.BUTTONEVENTFN 24452 . 26220)) (26263
28542 (TEDIT.MODERNIZE 26273 . 27087) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27089 . 28211) (TEDIT.SELECTALL
28213 . 28540)))))
STOP

Binary file not shown.

View File

@@ -30,7 +30,7 @@ When the package is loaded, this behavior is installed for the following kinds o
The function MODERNWINDOW.SETUP establishes the new behavior for classes of windows:
(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE)
(MODERNWINDOW.SETUP ORIGFN MODERNWINDOWFN ANYWHERE TITLEPROPORTION)
ORIGFN is either the name of the BUTTONEVENTFN for a class of windows (e.g. \TEDIT.BUTTONEVENTFN for Tedit windows) or it is a function that creates windows of a particulate kind (e.g. SNAPW or ADD-EXEC).
@@ -60,7 +60,7 @@ Provided these capabilities are already loaded, the following window classes are
If it is not known or it is inconvenient to systematically upgrade a button function or a window-creation function, the new behavior can be provided after a particular window has been created, by invoking
(MODERNWINDOW WINDOW ANYWHERE)
(MODERNWINDOW WINDOW ANYWHERE TITLEPROPORTION)
This saves the windows existing BUTTONEVENTFN as a window property PREMODERN-BUTTONEVENTFN, and installs a simple stub function in its place.
@@ -70,7 +70,9 @@ If things go awry:
(UNMODERNWINDOW WINDOW) restores a modernized window (via MACWINDOW) to its original state.
Known issue: Clicking at the bottom-right corner of Tedit windows sometimes doesn't catch the new behavior--there seems to be a conflict with Tedit's window-splitting conventions. Clicking a little further into the window seems more reliable.
Known issues:
Clicking at the bottom of an EXEC window running TTYIN is effective only when the input line is empty.

View File

@@ -1,282 +0,0 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-Jan-98 09:49:00" {DSK}<project>medley2.0>lispusers>PLAINTEXTSTREAM.;48 16624
changes to%: (FNS WRITEPLAINTEXTPAGE PLAINTEXTOUTCHARFN OPENPLAINTEXTSTREAM CLEARPLAINTEXTPAGE
MAKEPLAINTEXTPAGE)
(MACROS PLAINTEXTPARAM)
(VARS PLAINTEXTSTREAMCOMS)
(RECORDS PLAINTEXTIMAGEDATA)
previous date%: "11-Jan-98 23:04:10" {DSK}<project>medley2.0>lispusers>PLAINTEXTSTREAM.;29)
(* ; "
Copyright (c) 1998 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PLAINTEXTSTREAMCOMS)
(RPAQQ PLAINTEXTSTREAMCOMS
[(ADDVARS (DEFAULTFILETYPELIST (PLAINTEXT . TEXT)
(PT . TEXT)))
(FNS OPENPLAINTEXTSTREAM PLAINTEXTOUTCHARFN PLAINTEXT.TEDIT PLAINTEXT.TEXT)
(FNS WRITEPLAINTEXTPAGE)
(MACROS PLAINTEXTPARAM)
(RECORDS PLAINTEXTIMAGEDATA)
[ADDVARS [PRINTFILETYPES (PLAINTEXT (EXTENSION (PT PLAINTEXT]
(IMAGESTREAMTYPES (PLAINTEXT (OPENSTREAM OPENPLAINTEXTSTREAM)
(FONTCREATE \CREATEDISPLAYFONT)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
(CREATECHARSET \CREATECHARSET.DISPLAY]
(DECLARE%: EVAL@COMPILE DONTCOPY (P [OR (RECLOOK 'STREAM)
(EVAL (SYSRECLOOK1 'STREAM]
(OR (RECLOOK 'IMAGEOPS)
(EVAL (SYSRECLOOK1 'IMAGEOPS])
(ADDTOVAR DEFAULTFILETYPELIST (PLAINTEXT . TEXT)
(PT . TEXT))
(DEFINEQ
(OPENPLAINTEXTSTREAM
[LAMBDA (FILE OPTIONS) (* ; "Edited 15-Jan-98 00:04 by rmk:")
(* ;; "Assert that scale is one, so that display fonts etc. can be used.")
(LET [(STREAM (OPENSTREAM FILE 'OUTPUT NIL '((SEQUENTIAL T]
(REPLACE (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION PLAINTEXTOUTCHARFN))
[REPLACE (STREAM IMAGEDATA) OF STREAM
WITH (CREATE PLAINTEXTIMAGEDATA
PTPAGE _ (CL:MAKE-ARRAY (ADD1 (TIMES 72 11))
:INITIAL-ELEMENT NIL)
PTXPOSITION _ 0
PTYPOSITION _ (TIMES 72 11)
PTRIGHTMARGIN _ (FIX (TIMES 8.5 72))
PTLEFTMARGIN _ 0
PTCLIPPINGREGION _ (CREATE REGION
LEFT _ 0
BOTTOM _ 0
WIDTH _ (FIX (TIMES 8.5 72))
HEIGHT _ (TIMES 72 11]
[REPLACE (STREAM IMAGEOPS) OF STREAM
WITH (CREATE IMAGEOPS USING (FETCH (STREAM IMAGEOPS) OF STREAM)
IMAGETYPE _ 'PLAINTEXT IMFONT _
[FUNCTION (LAMBDA (STREAM FONT)
(CL:WHEN FONT
[PLAINTEXTPARAM
PTLINEFEED
(IMINUS (FONTPROP FONT 'HEIGHT])
(PLAINTEXTPARAM PTFONT FONT]
IMCLIPPINGREGION _
[FUNCTION (LAMBDA (STREAM REGION)
(CL:WHEN (AND REGION
(NOT (TYPE? REGION
REGION)))
(\ILLEGAL.ARG REGION))
(PLAINTEXTPARAM PTCLIPPINGREGION REGION]
IMXPOSITION _ [FUNCTION (LAMBDA (STREAM POS)
(PLAINTEXTPARAM PTXPOSITION
POS T]
IMYPOSITION _ [FUNCTION (LAMBDA (STREAM POS)
(PLAINTEXTPARAM PTYPOSITION
POS T]
IMMOVETO _ [FUNCTION (LAMBDA (STREAM X Y)
(PLAINTEXTPARAM PTXPOSITION X
T)
(PLAINTEXTPARAM PTYPOSITION Y
T]
IMLEFTMARGIN _ [FUNCTION (LAMBDA (STREAM M)
(PLAINTEXTPARAM
PTLEFTMARGIN M T]
IMRIGHTMARGIN _ [FUNCTION (LAMBDA (STREAM M)
(PLAINTEXTPARAM
PTRIGHTMARGIN M T]
IMLINEFEED _ [FUNCTION (LAMBDA (STREAM DY)
(PLAINTEXTPARAM PTLINEFEED
DY T]
IMSPACEFACTOR _ [FUNCTION (LAMBDA NIL 1]
IMFONTCREATE _ 'DISPLAY IMSTRINGWIDTH _
[FUNCTION (LAMBDA (STREAM STR RDTBL)
(STRINGWIDTH STR
(FETCH PTFONT
OF (FETCH (STREAM
IMAGEDATA)
OF STREAM))
RDTBL RDTBL]
IMCHARWIDTH _ [FUNCTION (LAMBDA (STREAM CHARCODE)
(CHARWIDTH
CHARCODE
(FETCH PTFONT
OF
(FETCH (STREAM
IMAGEDATA)
OF STREAM]
IMCLOSEFN _ (FUNCTION WRITEPLAINTEXTPAGE)
IMCHARSET _ [FUNCTION (LAMBDA (STREAM CHARSET)
(* ;; "If we had another illegal character set value, then we could simply fix it so that the character set didn't match anything, which would cause the character set shift to be put out on the next character")
(COND
((\IOMODEP STREAM
'OUTPUT T)
(\BOUT STREAM
NSCHARSETSHIFT)
(COND
((EQ CHARSET T)
(\BOUT STREAM
NSCHARSETSHIFT
)
(\BOUT STREAM 0))
(T (\BOUT STREAM
CHARSET]
IMDRAWPOLYGON _ (FUNCTION NILL)
IMDRAWPOINT _ (FUNCTION NILL)
IMSCALE _ (FUNCTION (LAMBDA NIL 1]
(DSPFONT '(GACHA 10)
STREAM)
STREAM])
(PLAINTEXTOUTCHARFN
[LAMBDA (STREAM CHARCODE) (* ; "Edited 15-Jan-98 00:06 by rmk:")
(* ;; "Put character data in PAGE entry indexed by current yposition")
(LET ((IMDATA (FETCH IMAGEDATA OF STREAM)))
(SELCHARQ CHARCODE
(CR
(* ;; "Set parameters but don't output--that means we can do lots of moving around, up and down, and still come out OK.")
(REPLACE PTXPOSITION OF IMDATA WITH 0)
(ADD (FETCH PTYPOSITION OF IMDATA)
(FETCH PTLINEFEED OF IMDATA)))
(FORM (WRITEPLAINTEXTPAGE STREAM)
(BOUT STREAM (CHARCODE FORM))
(REPLACE PTXPOSITION OF IMDATA WITH 0)
(REPLACE PTYPOSITION OF IMDATA WITH (TIMES 72 11)))
(LF (ADD (FETCH PTYPOSITION OF IMDATA)
(FETCH PTLINEFEED OF IMDATA)))
(CL:PUSH [LIST (FETCH PTXPOSITION OF IMDATA)
CHARCODE
(ADD (FETCH PTXPOSITION OF IMDATA)
(CHARWIDTH CHARCODE (FETCH PTFONT OF IMDATA]
(CL:SVREF (FETCH PTPAGE OF IMDATA)
(FETCH PTYPOSITION OF IMDATA])
(PLAINTEXT.TEDIT
[LAMBDA (FILE PTFILE) (* ; "Edited 8-Jan-98 06:17 by rmk:")
(* ; "Edited 18-Sep-91 18:16 by jds")
(* ;; "Make a plaintext file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.")
[COND
((STRINGP FILE)
(SETQ FILE (MKATOM FILE]
(SETQ FILE (OPENTEXTSTREAM FILE))
(TEDIT.FORMAT.HARDCOPY FILE PTFILE T NIL NIL NIL 'PLAINTEXT)
PTFILE])
(PLAINTEXT.TEXT
[LAMBDA (FILE PTFILE FONTS HEADING TABS) (* ; "Edited 8-Jan-98 06:20 by rmk:")
(* ;;
"The effect of this should be to throw away font change characters and coerce characters to ISO8859")
(TEXTTOIMAGEFILE FILE PTFILE 'PLAINTEXT FONTS HEADING TABS])
)
(DEFINEQ
(WRITEPLAINTEXTPAGE
[LAMBDA (STREAM) (* ; "Edited 15-Jan-98 09:48 by rmk:")
(LET [(PAGE (FETCH PTPAGE OF (FETCH IMAGEDATA OF STREAM]
(* ;;
 "Have to run through y-positions indexed backwards, since have to print higher positions first.")
(FOR YPOS LINE LASTYPOS DIFF (DLF _ (FONTPROP DEFAULTFONT 'HEIGHT))
(DSP _ (CHARWIDTH (CHARCODE SPACE)
DEFAULTFONT)) FROM (SUB1 (CL:ARRAY-DIMENSION PAGE 0)) TO 0
BY -1 FIRST (SETQ LASTYPOS YPOS) WHEN (SETQ LINE (CL:SVREF PAGE YPOS))
DO (SETQ DIFF (- LASTYPOS YPOS))
(CL:WHEN (IGREATERP DIFF DLF) (* ; "Distance is more than a line")
(* ;;
 "Start at 2 because one was already put out at the end of the previous line")
(FOR I FROM 2 TO (IQUOTIENT DIFF DLF)
DO (BOUT STREAM (CHARCODE CR))))
(SORT LINE T) (* ; "To print from left to right")
(FOR C (LASTX _ 0) IN LINE
DO (SETQ DIFF (- (POP C)
LASTX))
(CL:WHEN (IGREATERP DIFF DSP) (* ; "Distance is more than a space")
(FOR I FROM 1 TO (IQUOTIENT DIFF DLF)
DO (BOUT STREAM (CHARCODE SPACE))))
[IF (ILEQ (CAR C)
127)
THEN (BOUT STREAM (CAR C))
ELSE
(* ;; "Should coerce to ISO8859. If get something below 256, use it. Otherwise, try to print charactername")
(LET (STRING)
(SETQ STRING (SELCHARQ (CAR C)
(phi "phi")
(MEMBEROF "memb")
(UC-SIGMA "Sigma")
(46,123 "Pi")
(357,147 "o")
NIL))
(IF STRING
THEN (BOUT STREAM (CHARCODE \))
(FOR I C FROM 1
WHILE (SETQ C (NTHCHARCODE STRING I))
DO (BOUT STREAM C))
(BOUT STREAM (CHARCODE \))
ELSE (BOUT STREAM (CHARCODE ~]
(SETQ LASTX (CADR C)))
(\FILEOUTCHARFN STREAM (CHARCODE CR))
(SETQ LASTYPOS YPOS)
(* ;; "Now clear the entry")
(CL:SETF (CL:SVREF PAGE YPOS)
NIL])
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS PLAINTEXTPARAM MACRO
[(PNAME PVAL NUMBERPFLAG)
(PROG1 (FETCH PNAME OF (FETCH (STREAM IMAGEDATA) OF STREAM))
[LET ((PV PVAL))
(CL:WHEN PV
(REPLACE PNAME OF (FETCH (STREAM IMAGEDATA) OF STREAM)
WITH (COND
('NUMBERPFLAG (OR (NUMBERP PV)
(\ILLEGAL.ARG PV)))
(T PV))))])])
)
(DECLARE%: EVAL@COMPILE
(RECORD PLAINTEXTIMAGEDATA (PTPAGE PTXPOSITION PTYPOSITION PTFONT PTLINEFEED PTRIGHTMARGIN
PTLEFTMARGIN PTCLIPPINGREGION))
)
(ADDTOVAR PRINTFILETYPES (PLAINTEXT (EXTENSION (PT PLAINTEXT))))
(ADDTOVAR IMAGESTREAMTYPES (PLAINTEXT (OPENSTREAM OPENPLAINTEXTSTREAM)
(FONTCREATE \CREATEDISPLAYFONT)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
(CREATECHARSET \CREATECHARSET.DISPLAY)))
(DECLARE%: EVAL@COMPILE DONTCOPY
[OR (RECLOOK 'STREAM)
(EVAL (SYSRECLOOK1 'STREAM]
[OR (RECLOOK 'IMAGEOPS)
(EVAL (SYSRECLOOK1 'IMAGEOPS]
)
(PUTPROPS PLAINTEXTSTREAM COPYRIGHT ("Xerox Corporation" 1998))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1746 11976 (OPENPLAINTEXTSTREAM 1756 . 9644) (PLAINTEXTOUTCHARFN 9646 . 11087) (
PLAINTEXT.TEDIT 11089 . 11661) (PLAINTEXT.TEXT 11663 . 11974)) (11977 15294 (WRITEPLAINTEXTPAGE 11987
. 15292)))))
STOP

152
lispusers/TEDIT-PF-SEE Normal file
View File

@@ -0,0 +1,152 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Oct-2021 19:23:40" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;32 7178
changes to%: (FNS CLOSE-TYPED-WINDOW)
previous date%: "12-Oct-2021 22:31:01"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>TEDIT-PF-SEE.;31)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
(RPAQQ TEDIT-PF-SEECOMS
[(FNS SEE-TEDIT PF-TEDIT)
(COMS (FNS GET-TYPED-WINDOW CLOSE-TYPED-WINDOW)
(INITVARS (TYPED-WINDOWS)))
(COMMANDS ts tpf)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(SEE-TEDIT
[LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 11-Oct-2021 08:51 by rmk:")
(SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
(ERROR "FILE NOT FOUND" FILE)))
(TEDIT-SEE FILE (GET-TYPED-WINDOW (OR WINDOW 'SEE-TEDIT)
(CONCAT "SEE window for " FILE))
FORMAT)
FILE])
(PF-TEDIT
[LAMBDA (FN IFILES) (* ; "Edited 12-Oct-2021 15:22 by rmk:")
(* ;; "PF* to a read-only TEDIT window. First argument is the function name, second if given is the input file.")
(CL:WHEN (LISTP FN)
(SETQ FN (CAR FN)))
(IF FN
THEN (* ; "FN name specified; use it.")
(SETQ LASTWORD FN)
ELSE (* ; "Not specified, use LASTWORD")
(SETQ FN LASTWORD))
(IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
(WHEREIS FN 'FUNCTIONS T]
THEN (* ; "skip compiled files")
(FOR IFILE LOC TSTREAM ENV INSIDE IFILES
UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
DO (SETQ LOC (FINDFNDEF FN IFILE))
(IF (LISTP LOC)
THEN [CL:WITH-OPEN-FILE (ISTREAM (POP LOC)
:DIRECTION :INPUT)
(SETQ ENV (LISPSOURCEFILEP ISTREAM))
(SETFILEINFO ISTREAM 'FORMAT ENV)
(SETQ TSTREAM (OPENTEXTSTREAM))
(DSPFONT DEFAULTFONT TSTREAM)
(PRINT-READER-ENVIRONMENT ENV TSTREAM)
(PFCOPYBYTES ISTREAM TSTREAM (POP LOC)
(POP LOC))
(TERPRI TSTREAM)
(SETQ TSTREAM (TEDIT TSTREAM (GET-TYPED-WINDOW
'PF-TEDIT
(CONCAT FN " from "
(FULLNAME ISTREAM)))
NIL
'(READONLY T]
ELSEIF (EQ LOC 'FILE.NOT.FOUND)
THEN (printout T "file " IFILE " not found." T)
ELSE (printout T FN " not found on " LOC "." T)))
ELSE (PRINTOUT T FN " has no function definition" T])
)
(DEFINEQ
(GET-TYPED-WINDOW
[LAMBDA (WINDOWTYPE TITLE NOOPENFLG) (* ; "Edited 11-Oct-2021 10:06 by rmk:")
(* ;; "WINDOWTYPE=T means always create a new window. If a WINDOW, then reuse it.")
(* ;; "Otherwise, create a window of type WINDOWTYPE, using a previously specified region if one is available.")
(LET (WINDOW REGION WLIST)
[IF (OR (EQ WINDOWTYPE T)
(SETQ WINDOW (WINDOWP WINDOWTYPE)))
THEN (SETQ WINDOWTYPE NIL)
ELSE [SETQ WLIST (OR (ASSOC WINDOWTYPE TYPED-WINDOWS)
(CAR (PUSH TYPED-WINDOWS (CONS WINDOWTYPE]
(SETQ REGION (FIND X IN (CDR WLIST) SUCHTHAT (TYPE? REGION X]
(CL:UNLESS WINDOW
(* ;; "Make sure we have a titlebar and promptwindow")
(SETQ WINDOW (CREATEW REGION "" NIL NOOPENFLG))
(GETPROMPTWINDOW WINDOW)
(* ;;
 "Replace the region on WLIST with the window, so we can maintan a likely preference order.")
(IF REGION
THEN (DSUBST WINDOW REGION WLIST)
ELSE (NCONC1 WLIST WINDOW)))
(CL:WHEN TITLE
(WINDOWPROP WINDOW 'TITLE TITLE))
(CL:WHEN WINDOWTYPE
(WINDOWPROP WINDOW 'WINDOWTYPE WINDOWTYPE)
(WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CLOSE-TYPED-WINDOW)))
WINDOW])
(CLOSE-TYPED-WINDOW
[LAMBDA (WINDOW ALL) (* ; "Edited 16-Oct-2021 19:23 by rmk:")
(* ;; "Puts the region of WINDOW back on the region list for its type, for later reuse. If ALL, closes all windows of the type of WINDOW (and recursively puts their regions also on the list).")
(CL:WHEN (OPENWP WINDOW)
[LET [(WINDOWTYPE (WINDOWPROP WINDOW 'WINDOWTYPE]
(CL:WHEN WINDOWTYPE
(IF ALL
THEN (FOR W IN (OPENWINDOWS) WHEN (EQ WINDOWTYPE
(WINDOWPROP W 'WINDOWTYPE)
)
UNLESS (EQ W WINDOW) DO (CLOSEW W))
ELSE
(* ;; "This may no longer be needed, now that TEDIT removes the process for READONLY windows just as for ordinary edit windows.")
(AND NIL (CL:WHEN (TTY.PROCESSP (WINDOWPROP WINDOW 'PROCESS))
(* ;
 "Otherwise, the window pops up if you don't click away")
(TTY.PROCESS T)))
(DSUBST (WINDOWPROP WINDOW 'REGION)
WINDOW TYPED-WINDOWS)))])
WINDOW])
)
(RPAQ? TYPED-WINDOWS )
(DEFCOMMAND ts (FILE WINDOW FORMAT) (SEE-TEDIT FILE WINDOW FORMAT))
(DEFCOMMAND tpf (FN IFILES) (PF-TEDIT FN IFILES))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (843 3913 (SEE-TEDIT 853 . 1263) (PF-TEDIT 1265 . 3911)) (3914 6866 (GET-TYPED-WINDOW
3924 . 5397) (CLOSE-TYPED-WINDOW 5399 . 6864)))))
STOP

BIN
lispusers/TEDIT-PF-SEE.LCOM Normal file

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Aug-2021 20:46:55" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;5 8653
changes to%: (FNS FB.THINCOMMAND)
(FILECREATED " 9-Oct-2021 00:35:17" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;11 8621
previous date%: " 8-Aug-2021 15:05:08"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;4)
changes to%: (FNS FB.THINP)
previous date%: " 7-Oct-2021 12:40:24"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;8)
(* ; "
@@ -14,16 +15,16 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
(PRETTYCOMPRINT THINFILESCOMS)
(RPAQQ THINFILESCOMS [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FILEBROWSER))
(FNS FB.THINCOMMAND FB.THINP)
(INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
'(SYSOUT DCOM DATABASE LCOM DFASL MCOM
MFASL DRIBBLE]
(THINNAMES NIL))
(APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND
(RPAQQ THINFILESCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FILEBROWSER))
(FNS FB.THINCOMMAND FB.THINP)
(INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
'(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE]
(THINNAMES NIL))
(APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND
"Delvers non-source files and removes all but the last source file of each day."
])
])
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
@@ -116,29 +117,33 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
(FB.PROMPTWPRINT FBROWSER T "Done, " NDELETED " files marked for deletion."])
(FB.THINP
[LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)
(* ; "Edited 8-Aug-2021 15:05 by rmk:")
[LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)
(* ; "Edited 9-Oct-2021 00:35 by rmk:")
(SETQ FILENAME (U-CASE FILENAME))
(COND
((FMEMB (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION))
THINEXTENSIONS) (* ;
 "always delver files that can be reconstructed from the source.")
T)
((AND THINNAMES (EQMEMB (U-CASE (FILENAMEFIELD FILENAME 'NAME))
THINNAMES))
T)
(OLDESTVERSION? (* ;
 "don't delete the oldest version of source files.")
[(OR (EQMEMB (FILENAMEFIELD FILENAME 'EXTENSION)
THINEXTENSIONS)
(FIND TN (FN _ (FILENAMEFIELD FILENAME 'NAME))
(FE _ (FILENAMEFIELD FILENAME 'EXTENSION)) INSIDE THINNAMES
SUCHTHAT
(* ;; "Separate extractions because period for null extension is confusing")
(AND (EQ FN (FILENAMEFIELD TN 'NAME))
(EQ FE (FILENAMEFIELD TN 'EXTENSION]
(OLDESTVERSION? (* ;
 "don't delete the oldest version of source files.")
NIL)
((ILESSP AGE ONEDAY) (* ;
 "don't delete anything written within 24 hours.")
((ILESSP AGE ONEDAY) (* ;
 "don't delete anything written within 24 hours.")
NIL)
((ILESSP (ITIMES DELTATIMESTAMP 3)
ONEDAY) (* ;
 "delete anything that occurs on the same day as something else (except for the first day)")
ONEDAY) (* ;
 "delete anything that occurs on the same day as something else (except for the first day)")
T)
((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30))
(* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")
(* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")
T])
)
@@ -153,5 +158,5 @@ Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
))
(PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1297 8184 (FB.THINCOMMAND 1307 . 6808) (FB.THINP 6810 . 8182)))))
(FILEMAP (NIL (1106 8152 (FB.THINCOMMAND 1116 . 6617) (FB.THINP 6619 . 8150)))))
STOP

Binary file not shown.

View File

@@ -2,7 +2,7 @@ lispusers/WHEELSCROLL
Written by Ron Kaplan, February 2021.
This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving fingers on a track pad.
This small file adds the ability to scroll (scrollable) windows by rotating the wheel on a wheel mouse or by moving (2?) fingers on a track pad.
The capability is enabled when WHEELSCROLL.LCOM is loaded.
@@ -13,11 +13,13 @@ It is toggled on and off by
The scrolling speed is controlled by the variable
WHEELSCROLLDELTA (initially 20)
The number of points to scroll for each click of the wheel. Higher values give faster scrolling. A negative value reverses the scrolling direction.
The number of points to scroll for each click of the wheel. Higher values give faster scrolling. A negative value reverses the scrolling direction.
Implementation:
Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down. (ENABLEWHEELSCROLL T) modifies the keyaction table that maps these to characters 520 and 521, and those characters are defined as interrupts that invoke the scrolling action. (ENABLEWHEELSCROLL NIL) causes PAD1 and PAD2 to be ignored.
Lisp receives a key transition on PAD1 or PAD2 for vertical scrolling when the wheel rotates and no other keys are down. (ENABLEWHEELSCROLL T) modifies the keyaction table so that it maps these transitions to characters 156 and 157. Those characters are defined as interrupts that invoke the vertical scrolling action. For horizontal scrolling sideways pushes of a wheel (if it has that) produce transitions on PAD4 and PAD5, which map to interrupt-characters 158 and 159. (156-159 are the highest right-panel characters of character-set 0 that correspond to left-panel control characters, so typically have no other conflicting meaning.)
(ENABLEWHEELSCROLL NIL) causes PAD1, PAD2, PAD4, and PAD5 to be ignored.
Current negative features:
@@ -25,4 +27,4 @@ Current negative features:
We need to develop a strategy, either in Lisp, Maiko, or X, to discriminate intended middle-button pushes from intended scrolling. This is not an issue for track-pad scrolling.
2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the Tedit window may scroll.
2. When the wheel is rotated over a window that partially occludes a Tedit window with a caret blinking in its unoccluded region, both the target window and the partially obscured Tedit window may scroll.

View File

@@ -1,29 +1,6 @@
There are separate releases of medley and maiko.
Just get the latest version of each.
Alternatively, you can pick up the medley release, and build your own maiko.
Get the Maiko release [here](https://github.com/Interlisp/maiko/releases).
To use (from a shell/terminal window):
1. Unpack the medley tar file
```
tar -xvfz $tag.tgz
```
2. Unpack the maiko file for your operating system and CPU type,e.g.,
```
tar -xvfz maiko-210823.linux.x86_64.tgz
```
3. This should leave you with two directories, `medley` and `maiko`.
Then you can
```
cd medley
./run-medley -full
```
See the [Medley README](https://github.com/Interlisp/medley#readme)for
information on how to set up to use Medley.
DELETE THIS PARAGRAPH and replace it with a description of what changed since the last release (using the GitHub web ui).

View File

@@ -1,7 +1,8 @@
#!/bin/sh
# Run Medley
#
# Syntax: run-medley [--dimensions WIDTHxHEIGHT] # sets both -g -sc
# Syntax: run-medley [-noscroll] #turn off scrollbars
# [--dimensions WIDTHxHEIGHT] # sets both -g -sc
# [-g WIDTHxHEIGHT]
# [-sc WIDTHxHEIGHT]
# [--display X_DISPLAY] # defaults to $DISPLAY or :0
@@ -38,6 +39,8 @@ fi
prog="lde"
passthrough_args=""
mem="-m 256"
scroll=22
noscroll=""
if [ -z "$LDEDESTSYSOUT" ] ; then
if [ -z "$LOGINDIR" ] ; then
@@ -65,19 +68,24 @@ while [ "$#" -ne 0 ]; do
mkdir -p $MEDLEYDIR/tmp/logindir
export HOME=$MEDLEYDIR/tmp/logindir
export LOGINDIR=$MEDLEYDIR/tmp/logindir
export LDEINIT="$MEDLEYDIR/greetfiles/NOGREET"
;;
"-greet" | "--greet")
export LDEINIT="$2"
shift
;;
"-noscroll")
scroll=0
noscroll="-noscroll"
;;
"--dimensions" | "-dimensions")
sw=`expr "$2" : "\([0-9]*\)x[0-9]*$"`
sh=`expr "$2" : "[0-9]*x\([0-9]*\)$"`
if [ -n "$sw" -a -n "$sh" ] ; then
sw=$(( (31+$sw)/32*32 ))
gw=$(( 22+$sw ))
gh=$(( 22+$sh ))
gw=$(( $scroll+$sw ))
gh=$(( $scroll+$sh ))
geometry="-g ${gw}x${gh}"
screensize="-sc ${sw}x${sh}"
fi
@@ -180,11 +188,11 @@ if ! command -v "$prog" > /dev/null 2>&1; then
fi
fi
echo "running: $prog $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
echo "running: $prog $noscroll $geometry $screensize $mem $passthrough_args $LDESRCESYSOUT"
echo "greet: $LDEINIT"
export INMEDLEY=1
"$prog" $geometry $screensize $mem -t "Medley Interlisp" $passthrough_args "$LDESRCESYSOUT"
"$prog" $noscroll $geometry $screensize $mem -t "Medley Interlisp" $passthrough_args "$LDESRCESYSOUT"

View File

@@ -17,4 +17,4 @@ tr '\r' '\n' < $1 | \
-e 's///g'\
-e 's///g'\
-e 's//:/g' \
| less -R
| less -r

View File

@@ -1,4 +1,5 @@
#!/bin/sh
export MEDLEYDIR=`pwd`
if [ ! -x run-medley ] ; then
echo run from MEDLEYDIR
@@ -13,18 +14,24 @@ fi
cd ..
echo making medley zip $tag
echo making $tag-loadups.tgz
tar cfz medley/tmp/$tag.tgz \
tar cfz medley/tmp/$tag-loadups.tgz \
medley/loadups/lisp.sysout \
medley/loadups/full.sysout \
medley/loadups/whereis.hash \
medley/library/exports.all \
medley/library/RDSYS medley/library/RDSYS.LCOM
echo making $tag-runtime.tgz
tar cfz medley/tmp/$tag-runtime.tgz \
--exclude "*~" --exclude "*#*" \
medley/docs/dinfo \
medley/docs/Documentation\ Tools \
medley/greetfiles/SIMPLE-INIT \
medley/run-medley \
medley/scripts \
medley/loadups/lisp.sysout \
medley/loadups/full.sysout \
medley/loadups/whereis.hash \
medley/fonts/displayfonts medley/fonts/altofonts \
medley/fonts/postscriptfonts \
medley/library/ \
@@ -33,12 +40,13 @@ tar cfz medley/tmp/$tag.tgz \
medley/sources/ \
medley/internal/library \
cd medley
echo making release
sed s/'$tag'/$tag/g < release-notes.md > tmp/release-notes.md
gh release create $tag -F tmp/release-notes.md -p -t $tag
echo uploaded $tag.tgz
gh release upload $tag tmp/$tag.tgz --clobber
echo uploading
gh release upload $tag tmp/$tag-loadups.tgz tmp/$tag-runtime.tgz --clobber

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Aug-2021 00:08:39" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58 47657
(FILECREATED "27-Sep-2021 10:25:31" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;60 47698
changes to%: (FNS \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT)
changes to%: (FNS PRINT-READER-ENVIRONMENT READ-READER-ENVIRONMENT)
previous date%: "15-Aug-2021 21:21:35"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;57)
previous date%: "17-Aug-2021 00:08:39"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58)
(* ; "
@@ -15,14 +15,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT BOOTSTRAPCOMS)
(RPAQQ BOOTSTRAPCOMS
[(COMS (* ; "Some basic fns. Note that several are redefined later. E.g., RPAQQ et al real definitions are on UNDO")
[(COMS (* ; "Some basic fns. Note that several are redefined later. E.g., RPAQQ et al real definitions are on UNDO")
(FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? SELECTQ SELECTQ1 NCONC1 PUTPROP
PROPNAMES ADDPROP REMPROP MEMB CLOSEF?))
(COMS (* ;
 "Need these in order to load even compiled files SYSLOAD")
(COMS (* ;
 "Need these in order to load even compiled files SYSLOAD")
(FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD
PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME))
[COMS (* ; "For DEFINE-FILE-INFO")
[COMS (* ; "For DEFINE-FILE-INFO")
(FNS DEFINE-FILE-INFO \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT
READ-READER-ENVIRONMENT MAKE-DEFINE-FILE-INFO-ENV)
(INITVARS (*DEFINE-FILE-INFO-ENV* (MAKE-DEFINE-FILE-INFO-ENV]
@@ -76,7 +76,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(AND (CCODEP 'BOOTSTRAP-NAMEFIELD)
(PUTD 'BOOTSTRAP-NAMEFIELD]
(P (RADIX 10)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY (* ; "eventually imported from FASL")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (* ; "eventually imported from FASL")
(CONSTANTS FASL:SIGNATURE))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DEFINE-FILE-INFO DECLARE%: PUTPROPS FILECREATED SELECTQ)
@@ -784,9 +784,9 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
REREADTABLEFORM _ READTABLEFORM])
(PRINT-READER-ENVIRONMENT
[LAMBDA (ENV STREAM) (* ; "Edited 16-Aug-2021 23:51 by rmk:")
[LAMBDA (ENV STREAM) (* ; "Edited 27-Sep-2021 10:24 by rmk:")
(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")
(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")
(CL:UNLESS (EQUAL-READER-ENVIRONMENT ENV *OLD-INTERLISP-READ-ENVIRONMENT*)
(LET ((*PACKAGE* *INTERLISP-PACKAGE*)
@@ -807,14 +807,15 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
,@(CL:UNLESS (EQ :XCCS (FETCH REFORMAT OF ENV))
`(:FORMAT ,(FETCH REFORMAT OF ENV)))]
STREAM
(FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*))))])
(FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*))
(TERPRI STREAM)))])
(READ-READER-ENVIRONMENT
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 30-Jul-2021 09:58 by rmk:")
[LAMBDA (STREAM DEFAULTENV RETURNFORM) (* ; "Edited 26-Sep-2021 23:31 by rmk:")
(* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")
(* ;; "Starting environment is the old interlisp file, just for the seprchar scans.")
(* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")
(* ;; "RETURNFORM=T means return the DEFINE-FILE-INFO as a second value, for READFILE")
(CL:UNLESS DEFAULTENV (SETQ DEFAULTENV *OLD-INTERLISP-READ-ENVIRONMENT*))
(LET ((START (GETFILEPTR STREAM))
@@ -825,32 +826,32 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
)))
(DECLARE (SPECVARS *READTABLE*))
(SELCHARQ (SKIPSEPRCODES STREAM)
(";" (* ; "Assume it's a common lisp file")
(";" (* ; "Assume it's a common lisp file")
(\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
*COMMON-LISP-READ-ENVIRONMENT*
))
*COMMON-LISP-READ-ENVIRONMENT*)
("(" (\EXTERNALFORMAT STREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF
*DEFINE-FILE-INFO-ENV*
)) (* ;
 "Should we reset the format if we fail?")
)) (* ;
 "Should we reset the format if we fail?")
(READCCODE STREAM)
(WITH-READER-ENVIRONMENT *DEFINE-FILE-INFO-ENV*
(IF (EQ 'DEFINE-FILE-INFO (RATOM STREAM))
(IF (STREQUAL "DEFINE-FILE-INFO" (RSTRING STREAM))
THEN
(* ;;
 "After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
(* ;;
 "After the \DO-DEFINE-FILE-INFO, we have the new environment and we have set the new format.")
[SETQ ENV (\DO-DEFINE-FILE-INFO STREAM (SETQ ARGS
(CL:READ-DELIMITED-LIST
(CHARCODE ")")
STREAM]
ELSE (* ; "Hope we are RANDACCESSP")
ELSE (* ; "Hope we are RANDACCESSP")
(SETFILEPTR STREAM START))
(* ;;
 "If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
(* ;;
 "If we didn't see ARGS, then we didn't see a DEFINE-FILE-INFO, no form to return.")
(CL:IF (AND RETURNFORM ARGS)
(CL:VALUES ENV (CONS 'DEFINE-FILE-INFO ARGS))
@@ -981,13 +982,13 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4748 14420 (GETPROP 4758 . 5330) (SETATOMVAL 5332 . 5461) (RPAQQ 5463 . 5516) (RPAQ
5518 . 5830) (RPAQ? 5832 . 6202) (MOVD 6204 . 8068) (MOVD? 8070 . 8500) (SELECTQ 8502 . 8689) (
SELECTQ1 8691 . 9033) (NCONC1 9035 . 9231) (PUTPROP 9233 . 10717) (PROPNAMES 10719 . 10910) (ADDPROP
10912 . 12975) (REMPROP 12977 . 13831) (MEMB 13833 . 14092) (CLOSEF? 14094 . 14418)) (14493 35057 (
LOAD 14503 . 15672) (\LOAD-STREAM 15674 . 28748) (FILECREATED 28750 . 30168) (FILECREATED1 30170 .
31278) (PRETTYCOMPRINT 31280 . 31765) (BOOTSTRAP-NAMEFIELD 31767 . 32727) (PUTPROPS 32729 . 33097) (
DECLARE%: 33099 . 33231) (DECLARE%:1 33233 . 34105) (ROOTFILENAME 34107 . 35055)) (35095 45489 (
DEFINE-FILE-INFO 35105 . 35540) (\DO-DEFINE-FILE-INFO 35542 . 39888) (PRINT-READER-ENVIRONMENT 39890
. 41443) (READ-READER-ENVIRONMENT 41445 . 44211) (MAKE-DEFINE-FILE-INFO-ENV 44213 . 45487)))))
(FILEMAP (NIL (4751 14423 (GETPROP 4761 . 5333) (SETATOMVAL 5335 . 5464) (RPAQQ 5466 . 5519) (RPAQ
5521 . 5833) (RPAQ? 5835 . 6205) (MOVD 6207 . 8071) (MOVD? 8073 . 8503) (SELECTQ 8505 . 8692) (
SELECTQ1 8694 . 9036) (NCONC1 9038 . 9234) (PUTPROP 9236 . 10720) (PROPNAMES 10722 . 10913) (ADDPROP
10915 . 12978) (REMPROP 12980 . 13834) (MEMB 13836 . 14095) (CLOSEF? 14097 . 14421)) (14496 35060 (
LOAD 14506 . 15675) (\LOAD-STREAM 15677 . 28751) (FILECREATED 28753 . 30171) (FILECREATED1 30173 .
31281) (PRETTYCOMPRINT 31283 . 31768) (BOOTSTRAP-NAMEFIELD 31770 . 32730) (PUTPROPS 32732 . 33100) (
DECLARE%: 33102 . 33234) (DECLARE%:1 33236 . 34108) (ROOTFILENAME 34110 . 35058)) (35098 45530 (
DEFINE-FILE-INFO 35108 . 35543) (\DO-DEFINE-FILE-INFO 35545 . 39891) (PRINT-READER-ENVIRONMENT 39893
. 41475) (READ-READER-ENVIRONMENT 41477 . 44252) (MAKE-DEFINE-FILE-INFO-ENV 44254 . 45528)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,13 +1,14 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "21-Jan-93 11:16:01" {DSK}<python>lde>lispcore>sources>CMLEXEC.;2 92477
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FUNCTIONS ADD-EXEC)
(FILECREATED " 8-Oct-2021 10:51:35" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLEXEC.;2 92464
previous date%: "25-Jun-91 12:22:29" {DSK}<python>lde>lispcore>sources>CMLEXEC.;1)
previous date%: "21-Jan-93 11:16:01"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLEXEC.;1)
(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991, 1993 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1985-1988, 1990-1991, 1993, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLEXECCOMS)
@@ -1748,13 +1749,24 @@ Copyright (c) 1985, 1986, 1987, 1988, 1990, 1991, 1993 by Venue & Xerox Corporat
(ADDTOVAR LAMA )
)
(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993))
(PUTPROPS CMLEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (33304 34258 (COPY-CIRCLE 33314 . 34256)) (34336 37641 (EXEC-READ 34346 . 37507) (DIR
37509 . 37639)) (39903 67037 (DO-APPLY-EVENT 39913 . 40475) (DO-HISTORY-SEARCH 40477 . 41934) (
EVAL-INPUT 41936 . 47365) (EVENTS-INPUT 47367 . 48745) (EXEC-PRIN1 48747 . 48923) (EXEC-VALUE-OF 48925
. 49264) (GET-NEXT-HISTORY-EVENT 49266 . 50761) (HISTORY-ADD-TO-SPELLING-LISTS 50763 . 51751) (
HISTORY-NTH 51753 . 52503) (PRINT-HISTORY 52505 . 53126) (FIND-HISTORY-EVENTS 53128 . 58189) (
PRINT-EVENT 58191 . 62412) (PRINT-EVENT-PROMPT 62414 . 63618) (PROCESS-EXEC-ID 63620 . 64565) (
SEARCH-FOR-EVENT-NUMBER 64567 . 65195) (\PICK.EVALQT 65197 . 65708) (LISPXREPRINT 65710 . 67035)))))
(FILEMAP (NIL (3978 4383 (XCL::EXEC-CLOSEFN 3978 . 4383)) (4385 4721 (XCL::EXEC-SHRINKFN 4385 . 4721))
(4723 4963 (XCL::SETUP-EXEC-WINDOW 4723 . 4963)) (4965 5211 (XCL::EXEC-TITLE-FUNCTION 4965 . 5211)) (
5213 8519 (FIX-FORM 5213 . 8519)) (8521 8641 (XCL::GET-PROCESS-PROFILE 8521 . 8641)) (8643 8924 (
XCL::SAVE-CURRENT-EXEC-PROFILE 8643 . 8924)) (8926 9216 (XCL::SETF-GET-PROCESS-PROFILE 8926 . 9216)) (
9218 9785 (XCL:SET-EXEC-TYPE 9218 . 9785)) (9787 9869 (XCL:SET-DEFAULT-EXEC-TYPE 9787 . 9869)) (9871
10282 (XCL::ENTER-EXEC-FUNCTION 9871 . 10282)) (10357 16750 (DO-EVENT 10357 . 16750)) (16752 23543 (
EXEC 16752 . 23543)) (23545 24886 (EXEC-EVAL 23545 . 24886)) (24888 25619 (PRINT-ALL-DOCUMENTATION
24888 . 25619)) (25621 26063 (PRINT-DOCUMENTATION 25621 . 26063)) (26146 27230 (ADD-EXEC 26146 . 27230
)) (27232 30828 (EXEC-READ-LINE 27232 . 30828)) (30899 31385 (FIND-EXEC-COMMAND 30899 . 31385)) (31387
33285 (CIRCLAR-COPYER 31387 . 33285)) (33286 34240 (COPY-CIRCLE 33296 . 34238)) (34318 37623 (
EXEC-READ 34328 . 37489) (DIR 37491 . 37621)) (39885 67019 (DO-APPLY-EVENT 39895 . 40457) (
DO-HISTORY-SEARCH 40459 . 41916) (EVAL-INPUT 41918 . 47347) (EVENTS-INPUT 47349 . 48727) (EXEC-PRIN1
48729 . 48905) (EXEC-VALUE-OF 48907 . 49246) (GET-NEXT-HISTORY-EVENT 49248 . 50743) (
HISTORY-ADD-TO-SPELLING-LISTS 50745 . 51733) (HISTORY-NTH 51735 . 52485) (PRINT-HISTORY 52487 . 53108)
(FIND-HISTORY-EVENTS 53110 . 58171) (PRINT-EVENT 58173 . 62394) (PRINT-EVENT-PROMPT 62396 . 63600) (
PROCESS-EXEC-ID 63602 . 64547) (SEARCH-FOR-EVENT-NUMBER 64549 . 65177) (\PICK.EVALQT 65179 . 65690) (
LISPXREPRINT 65692 . 67017)) (68199 68298 (EXEC-PRINT 68199 . 68298)) (68300 68565 (EXEC-FORMAT 68300
. 68565)))))
STOP

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@@ -1,14 +1,14 @@
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "DEBUGGER" (PREFIX-NAME "DBG") (NICKNAMES "DBG")) READTABLE
"XCL" BASE 10)
(IL:FILECREATED "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2| 84311
(IL:FILECREATED "12-Sep-2021 15:59:37" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;2| 84797
IL:|changes| IL:|to:| (IL:FUNCTIONS STACK-FRAME-PROPERTIES)
IL:|previous| IL:|date:| "16-Aug-91 17:38:56" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
IL:|previous| IL:|date:| "11-Sep-2021 12:57:01" IL:|{DSK}<home>larry>medley>sources>DEBUGGER.;1|
)
; Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
; Copyright (c) 1986-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
(IL:PRETTYCOMPRINT IL:DEBUGGERCOMS)
@@ -1204,13 +1204,23 @@
IL:COLLECT (PROGN (IL:|while| (IL:FMEMB (SETF ARGNAME (POP ARGLIST))
LAMBDA-LIST-KEYWORDS)
IL:|do| (SETF MODE ARGNAME))
(IL:* IL:|;;| " STKARGNAME returns symbol if bound special")
(LIST (OR (IL:STKARGNAME I POS)
(IL:* IL:\; "special")
(IF (CASE MODE
(COND
((CHARACTERP ARGNAME)
(IL:* IL:|;;|
 "for special forms might start with #\\( or #\\{")
(SETQ ARGLIST NIL)
(FORMAT NIL "arg ~D" (- I 1)))
((CASE MODE
((NIL &OPTIONAL) ARGNAME)
(T NIL))
(STRING ARGNAME)
(FORMAT NIL "arg ~D" (- I 1))))
(STRING ARGNAME))
(T (FORMAT NIL "arg ~D" (- I 1)))))
I))))
,@(LET ((SLOTS (IL:BIND ARGNAME (NOVALUE IL:_ "no such value") IL:FOR PVAR IL:FROM
0
@@ -1541,29 +1551,29 @@
(IL:ADDTOVAR IL:LAMA IL:WBREAK)
)
(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
(IL:PUTPROPS XCL:DEBUGGER IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2021))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL (4639 6450 (XCL:ENTER-DEBUGGER-P 4639 . 6450)) (6452 13574 (XCL:DEBUGGER 6452 . 13574
)) (13576 13890 (EMERGENCY-PANIC-LOOP 13576 . 13890)) (13892 15347 (IL:FIND-DEBUGGER-ENTRY-FRAME 13892
. 15347)) (15349 16038 (PRINT-ENTRY-MESSAGE 15349 . 16038)) (16040 16341 (SIMPLE-REPORT-CONDITION
16040 . 16341)) (16343 18083 (XCL::INTERESTING-FRAME-P 16343 . 18083)) (18668 18955 (IL:WBREAK 18681
. 18953)) (19068 20177 (REUSE-CURRENT-WINDOW 19068 . 20177)) (20179 21483 (CREATE-DEBUGGER-WINDOW
20179 . 21483)) (21485 22437 (SET-UP-DEBUGGER-WINDOW 21485 . 22437)) (22439 23454 (
CLOSE-DEBUGGER-WINDOW 22439 . 23454)) (23456 23942 (RELEASE-DEBUGGER-WINDOW 23456 . 23942)) (23944
24881 (NEAR-BY-REGION 23944 . 24881)) (24883 25993 (DEBUGGER-BUTTON-EVENT 24883 . 25993)) (25995 26932
(DEBUGGER-MENU-HELP 25995 . 26932)) (31872 33690 (DEBUGGER-EVAL 31872 . 33690)) (33692 38041 (
FIND-DEBUGGER-STACK-FRAME 33692 . 38041)) (38043 38782 (FIND-NAMED-STACK-POSITION 38043 . 38782)) (
38784 39416 (FIND-ORIGINAL-NAME-AND-DEFINITION 38784 . 39416)) (39418 39552 (STKPTR-CCODE 39418 .
39552)) (42143 47005 (IL:BAKTRACE 42156 . 44940) (IL:BAKTRACE1 44942 . 47003)) (47841 54770 (
ATTACH-BACKTRACE-MENU 47841 . 54770)) (54772 57983 (REGION-NEXT-TO 54772 . 57983)) (57985 59428 (
BACKTRACE-MENU-BUTTONEVENTFN 57985 . 59428)) (59430 63704 (BACKTRACE-ITEM-SELECTED 59430 . 63704)) (
63706 67543 (STACK-FRAME-PROPERTIES 63706 . 67543)) (67545 68555 (STACK-FRAME-FETCHFN 67545 . 68555))
(68557 69744 (STACK-FRAME-STOREFN 68557 . 69744)) (69746 70321 (STACK-FRAME-VALUE-COMMAND 69746 .
70321)) (70323 70733 (STACK-FRAME-PROPERTY 70323 . 70733)) (70735 72720 (MAKE-FRAME-INSPECT-WINDOW
70735 . 72720)) (72722 72919 (%RELEASE-STACK-DATUM 72722 . 72919)) (72921 73627 (PRINT-BACKTRACE 72921
. 73627)) (76856 76950 (EXIT-DEBUGGER 76856 . 76950)) (76952 77271 (INVOKE-ESCAPE-FROM-MENU 76952 .
77271)) (77273 78696 (ESCAPE-FROM-DEBUGGER 77273 . 78696)) (78698 79076 (MENU-FROM-ESCAPE-LIST 78698
. 79076)) (79078 80237 (KEYLIST-FROM-ESCAPE-LIST 79078 . 80237)) (80239 81247 (COLLECT-ACTIVE-ESCAPES
80239 . 81247)) (81249 81618 (IL:FIND-LEXICAL-ENVIRONMENT 81249 . 81618)) (81619 83585 (
IL:FIND-STACK-FRAME 81632 . 83583)))))
(IL:FILEMAP (NIL (4647 6458 (XCL:ENTER-DEBUGGER-P 4647 . 6458)) (6460 13582 (XCL:DEBUGGER 6460 . 13582
)) (13584 13898 (EMERGENCY-PANIC-LOOP 13584 . 13898)) (13900 15355 (IL:FIND-DEBUGGER-ENTRY-FRAME 13900
. 15355)) (15357 16046 (PRINT-ENTRY-MESSAGE 15357 . 16046)) (16048 16349 (SIMPLE-REPORT-CONDITION
16048 . 16349)) (16351 18091 (XCL::INTERESTING-FRAME-P 16351 . 18091)) (18676 18963 (IL:WBREAK 18689
. 18961)) (19076 20185 (REUSE-CURRENT-WINDOW 19076 . 20185)) (20187 21491 (CREATE-DEBUGGER-WINDOW
20187 . 21491)) (21493 22445 (SET-UP-DEBUGGER-WINDOW 21493 . 22445)) (22447 23462 (
CLOSE-DEBUGGER-WINDOW 22447 . 23462)) (23464 23950 (RELEASE-DEBUGGER-WINDOW 23464 . 23950)) (23952
24889 (NEAR-BY-REGION 23952 . 24889)) (24891 26001 (DEBUGGER-BUTTON-EVENT 24891 . 26001)) (26003 26940
(DEBUGGER-MENU-HELP 26003 . 26940)) (31880 33698 (DEBUGGER-EVAL 31880 . 33698)) (33700 38049 (
FIND-DEBUGGER-STACK-FRAME 33700 . 38049)) (38051 38790 (FIND-NAMED-STACK-POSITION 38051 . 38790)) (
38792 39424 (FIND-ORIGINAL-NAME-AND-DEFINITION 38792 . 39424)) (39426 39560 (STKPTR-CCODE 39426 .
39560)) (42151 47013 (IL:BAKTRACE 42164 . 44948) (IL:BAKTRACE1 44950 . 47011)) (47849 54778 (
ATTACH-BACKTRACE-MENU 47849 . 54778)) (54780 57991 (REGION-NEXT-TO 54780 . 57991)) (57993 59436 (
BACKTRACE-MENU-BUTTONEVENTFN 57993 . 59436)) (59438 63712 (BACKTRACE-ITEM-SELECTED 59438 . 63712)) (
63714 68024 (STACK-FRAME-PROPERTIES 63714 . 68024)) (68026 69036 (STACK-FRAME-FETCHFN 68026 . 69036))
(69038 70225 (STACK-FRAME-STOREFN 69038 . 70225)) (70227 70802 (STACK-FRAME-VALUE-COMMAND 70227 .
70802)) (70804 71214 (STACK-FRAME-PROPERTY 70804 . 71214)) (71216 73201 (MAKE-FRAME-INSPECT-WINDOW
71216 . 73201)) (73203 73400 (%RELEASE-STACK-DATUM 73203 . 73400)) (73402 74108 (PRINT-BACKTRACE 73402
. 74108)) (77337 77431 (EXIT-DEBUGGER 77337 . 77431)) (77433 77752 (INVOKE-ESCAPE-FROM-MENU 77433 .
77752)) (77754 79177 (ESCAPE-FROM-DEBUGGER 77754 . 79177)) (79179 79557 (MENU-FROM-ESCAPE-LIST 79179
. 79557)) (79559 80718 (KEYLIST-FROM-ESCAPE-LIST 79559 . 80718)) (80720 81728 (COLLECT-ACTIVE-ESCAPES
80720 . 81728)) (81730 82099 (IL:FIND-LEXICAL-ENVIRONMENT 81730 . 82099)) (82100 84066 (
IL:FIND-STACK-FRAME 82113 . 84064)))))
IL:STOP

Binary file not shown.

View File

@@ -1,14 +1,15 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "13-Aug-2020 12:36:18" {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.;10 5477
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (VARS DEXECCOMS)
(FILECREATED " 7-Oct-2021 14:29:56" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>DEXEC.;4 5554
previous date%: "13-Aug-2020 12:31:18"
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.;9)
changes to%: (FNS SEE* COPYALLBYTES)
previous date%: "13-Aug-2020 12:36:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>DEXEC.;1)
(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1990, 2018, 2020 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1982-1986, 1990, 2018, 2020-2021 by Venue & Xerox Corporation.
The following program was created in 1982 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
@@ -20,7 +21,7 @@ with the terms of said license.
(RPAQQ DEXECCOMS
[
(* ;;; "Has to come after ADISPLAY and CMLEXEC.")
(* ;;; "Has to come after ADISPLAY and CMLEXEC.")
(COMMANDS "see" "see*" "ty" "type")
(INITVARS (/LAST.CONNECTED.DIRECTORY LOGINHOST/DIR))
@@ -74,22 +75,24 @@ with the terms of said license.
(CNDIR HOST/DIR])
(COPYALLBYTES
[LAMBDA (FROMFILE TOFILE BYTESIZE EXTERNALFORMAT) (* ; "Edited 11-Aug-2020 20:35 by rmk:")
(* bvm%: "29-Jan-86 19:50")
[LAMBDA (FROMFILE TOFILE BYTESIZE FORMAT) (* ; "Edited 7-Oct-2021 13:15 by rmk:")
(* bvm%: "29-Jan-86 19:50")
(* ;; "RMK: Removed PFDEFAULT arg to PFCOPYBYTES. Probably should remove BYTESIZE test")
(RESETLST
[PROG (INF OUTF PTR)
[COND
(FROMFILE [RESETSAVE NIL (LIST 'CLOSEF (SETQ INF (OPENSTREAM
FROMFILE
'INPUT NIL
`((EXTERNALFORMAT ,EXTERNALFORMAT)
)
`((EXTERNALFORMAT ,FORMAT))
BYTESIZE]
(OR (EQ (GETFILEPTR INF)
0)
(SETFILEPTR INF 0)))
(T (SETQ INF (INPUT] (* close the files only if I opened
 them)
(T (SETQ INF (INPUT] (* close the files only if I opened
 them)
[COND
((NULL TOFILE)
(SETQ OUTF (OUTPUT)))
@@ -98,7 +101,7 @@ with the terms of said license.
(COND
((AND (NULL BYTESIZE)
(DISPLAYP OUTF))
(PFCOPYBYTES INF OUTF NIL NIL PFDEFAULT))
(PFCOPYBYTES INF OUTF))
(T (COPYBYTES INF OUTF])])
(SEE
@@ -110,11 +113,14 @@ with the terms of said license.
(CADDR LINE))))
(SEE*
[NLAMBDA LINE (* ; "Edited 1-May-2018 10:22 by rmk:")
[NLAMBDA LINE (* ; "Edited 7-Oct-2021 14:29 by rmk:")
(* ;; "RMK: RESETVARS because **COMMENT**FLG is global")
(SETQ LINE (NLAMBDA.ARGS LINE))
(LET ((**COMMENT**FLG NIL))
(APPLY (FUNCTION SEE)
LINE])
(RESETVARS (**COMMENT**FLG)
(APPLY (FUNCTION SEE)
LINE])
)
(RPAQ SAVINGCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@FDJ@HJJ@LJJ@BNJLJJD@LJD@@@@@@JDN@KEB@KE@@JMF@JMB@JEL@@@@@@@@
) (QUOTE NIL) 0 15))
@@ -136,8 +142,9 @@ with the terms of said license.
(ADDTOVAR LAMA )
)
(PUTPROPS DEXEC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990 2018 2020))
(PUTPROPS DEXEC COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1990 2018 2020 2021)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2246 4697 (/CNDIR 2256 . 2693) (COPYALLBYTES 2695 . 4211) (SEE 4213 . 4457) (SEE* 4459
. 4695)))))
(FILEMAP (NIL (2230 4768 (/CNDIR 2240 . 2677) (COPYALLBYTES 2679 . 4203) (SEE 4205 . 4449) (SEE* 4451
. 4766)))))
STOP

Binary file not shown.

604
sources/EXTERNALFORMAT Normal file
View File

@@ -0,0 +1,604 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Sep-2021 08:59:42" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;16 31868
changes to%: (VARS EXTERNALFORMATCOMS)
previous date%: "11-Sep-2021 09:44:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;15)
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
(RPAQQ EXTERNALFORMATCOMS
[(COMS (* ;
 "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
(INITRECORDS EXTERNALFORMAT)
(SYSRECORDS EXTERNALFORMAT)
(FNS \EXTERNALFORMAT MAKE-EXTERNALFORMAT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT)
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(INITVARS (*EXTERNALFORMATS* NIL)
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
[COMS
(* ;; "Generic functions not compiled open (originally on LLREAD)")
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC
\INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC]
(COMS
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
(FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE \THROUGHOUTCHARFN)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT])
(* ; "EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
(EOL BITS 2)
(UNSTABLE FLAG) (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")
(INCCODEFN POINTER) (* ;
 "Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
(PEEKCCODEFN POINTER) (* ;
 "Called with three arguments -- STREAM, NOERROR, and EOL")
(BACKCCODEFN POINTER) (* ;
 "Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
(OUTCHARFN POINTER) (* ;
 "Called with two arguments -- STREAM and CHARCODE")
(NAME POINTER) (* ;
 "keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
(EF1 POINTER) (* ;
 "Extra fields for use of particular formats. Possibly to hold standardized translation tables")
(EF2 POINTER)))
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (FLAGBITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(* "END EXPORTED DEFINITIONS")
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (FLAGBITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(ADDTOVAR SYSTEMRECLST
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
(EOL BITS 2)
(UNSTABLE FLAG)
(INCCODEFN POINTER)
(PEEKCCODEFN POINTER)
(BACKCCODEFN POINTER)
(OUTCHARFN POINTER)
(NAME POINTER)
(FORMATBYTESTREAMFN POINTER)
(EF1 POINTER)
(EF2 POINTER)))
)
(DEFINEQ
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 10-Sep-2021 20:44 by rmk:")
(* ; "Edited 26-Feb-91 13:20 by nm")
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
(* ;;; "")
(* ;;; "If NEWFORMAT/NAME is nil, just returns the current external format name of STREAM. If NEWFORMAT/NAME is supplied and it is or names an external format, then the external format of STREAM is set to that format.")
(* ;;; "")
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
(\DTEST STREAM 'STREAM)
(SETQ SAVEDNAME (fetch DEVICENAME of (fetch DEVICE of STREAM)))
(SETQ SAVEDDEFAULTFORMATNAME (fetch (FDEV DEFAULTEXTERNALFORMAT) of (fetch DEVICE
of STREAM)))
(SETQ FOUNDFORMAT (FIND-FORMAT SAVEDDEFAULTFORMATNAME T))
(CL:WHEN NEWFORMAT/NAME
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
[LET (EXTFORMAT)
[COND
((type? EXTERNALFORMAT NEWFORMAT/NAME)
(SETQ EXTFORMAT NEWFORMAT/NAME))
(T (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
of (fetch DEVICE of
STREAM))
*DEFAULT-EXTERNALFORMATS*))
(fetch (FDEV DEFAULTEXTERNALFORMAT)
of (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMAT*)))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
"is not a registered external format name"))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
(UNINTERRUPTABLY
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch
(EXTERNALFORMAT
EOL) of
EXTFORMAT
)))
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT
OUTCHARFN)
of EXTFORMAT))
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
INCCODEFN)
of EXTFORMAT))
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
PEEKCCODEFN)
of EXTFORMAT))
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
BACKCCODEFN)
of EXTFORMAT)))])
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE)
(* ; "Edited 10-Sep-2021 19:47 by rmk:")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
((LIST 'CR CR.EOLC)
CR.EOLC)
((LIST 'CRLF CRLF.EOLC)
CRLF.EOLC)
(NIL)
(SHOULDNT)))
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC)
UNSTABLE _ UNSTABLE])
)
(DEFINEQ
(\INSTALL.EXTERNALFORMAT
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-Aug-2021 14:22 by rmk:")
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
(* ;;; "For backward compatibility, the first argument can be a NAME with the second argument being the format. If so, the NAME must match the name inside the format")
(LET (NAME)
(IF EXTERNALFORMAT
THEN
(* ;; "Backwards compatibility")
(SETQ NAME (MKATOM EXTFORMAT/NAME))
(IF (EQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT))
ELSEIF (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)
THEN (ERROR "Mismatch of specified name and name of the external format")
ELSE (REPLACE (EXTERNALFORMAT NAME) OF EXTERNALFORMAT WITH
NAME))
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
THEN (\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
EXTERNALFORMAT])
(\REMOVE.EXTERNALFORMAT
[LAMBDA (NAME/EXTFORMAT) (* ; "Edited 5-May-2021 15:42 by rmk:")
(* ;;; "Deregisters external format EXTERNALFORMAT .")
(SETQ NAME/EXTFORMAT (IF (TYPE? EXTERNALFORMAT NAME/EXTFORMAT)
THEN (FETCH (EXTERNALFORMAT NAME) OF NAME/EXTFORMAT)
ELSE (MKATOM NAME/EXTFORMAT)))
(SETQ *EXTERNALFORMATS* (DREMOVE (FIND EF IN *EXTERNALFORMATS*
SUCHTHAT (EQ NAME/EXTFORMAT (FETCH (EXTERNALFORMAT
NAME)
OF EF)))
*EXTERNALFORMATS*])
(FIND-FORMAT
[LAMBDA (NAME NOERROR) (* ; "Edited 7-Aug-2021 09:29 by rmk:")
(IF (TYPE? EXTERNALFORMAT NAME)
THEN NAME
ELSE (SETQ NAME (MKATOM NAME)) (* ;
 "The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (
EXTERNALFORMAT
NAME)
OF EF)))
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(RPAQ? *EXTERNALFORMATS* NIL)
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
(* ;; "Generic functions not compiled open (originally on LLREAD)")
(DEFINEQ
(\OUTCHAR
[LAMBDA (STREAM CODE) (* ; "Edited 10-Aug-2021 10:29 by rmk:")
(* ;; "We can't do the EOL stuff here because we don't know whether BOUTs are legit.")
(* ;; "Maybe the implementation function does something else, like move the X and Y positions. At best we could convert the EOL into either CR or LF, or into a CR-LF sequence that we pass by two calls to the lower implementation function.")
(* ;; "")
(* ;; "This would make CHARPOSITION generic:")
(* (FREPLACE (STREAM CHARPOSITION)
 OF STREAM WITH (CL:IF
 (EQ CODE (CHARCODE EOL)) 0
 (IPLUS16 1 (FFETCH
 (STREAM CHARPOSITION) OF STREAM)))))
(CL:FUNCALL (OR (ffetch (STREAM OUTCHARFN) of STREAM)
\DEFAULTOUTCHAR)
STREAM CODE)
CODE])
(\INCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 7-Aug-2021 00:11 by rmk:")
(* ;; "Calling functions pass the name of the BYTECOUNTVAR, or NIL. If non-NIL, implementing functions are required to SETQ *BYTECOUNTER* to the number of bytes read (positive) or backed up (negative).")
(* ;; "Caller must bind BYTECOUNTVAR as a SPECVAR. BYTECOUNTVAL can be passed as the current value of BYTECOUNTVAR, to save a call to \EVALV1.")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM
'*BYTECOUNTER*)
(SET BYTECOUNTVAR (IDIFFERENCE (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM])
(\BACKCCODE
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:26 by rmk:")
(* ;;
"Format function returns T if the backup succeed, NIL otherwise (e.g at the beginning of the file)")
(IF BYTECOUNTVAR
THEN [LET ((*BYTECOUNTER* 0))
(DECLARE (SPECVARS *BYTECOUNTER*))
(PROG1 (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM T)
(SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
*BYTECOUNTER*)))]
ELSE (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM])
(\BACKCCODE.EOLC
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:27 by rmk:")
(* ;; "If the EOLCONVENTION is CRLF, and the first backup is over an LF encoding, this looks to see whether the preceding bytes encode a CR and if so, backs up over those.")
(* ;; "Within this we operate at the external-format implementation level.")
(* ;; "Counting is unusual in general (mostly just COPYCHARS and PFCOPYBYTES) , and counting while backing up is even rarer. So for simplicity here we just count by looking at the byte pointer.")
(LET [(STARTPOS (CL:WHEN BYTECOUNTVAR (\GETFILEPTR STREAM]
(* ;; "In almost all cases, we just execute the first backup")
(PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
\DEFAULTBACKCCODE)
STREAM)
(IF (AND (EQ CRLF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM))
(EQ (CHARCODE LF)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
STREAM)))
THEN
(* ;;
 "We just backed over an LF in a CRLF file. If we go one more, do we get a CR?")
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM
)
\DEFAULTBACKCCODE)
STREAM)
(CL:UNLESS (EQ (CHARCODE CR)
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
of STREAM)
\DEFAULTPEEKCCODE)
STREAM))
(* ;; "Not a preceding CR, reread it.")
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM))
T)
ELSE T))
(CL:WHEN BYTECOUNTVAR
[SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
(\PEEKCCODE
[LAMBDA (STREAM NOERROR EOL) (* ; "Edited 14-Jun-2021 12:40 by rmk:")
(\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
STREAM NOERROR)
EOL STREAM T])
(\PEEKCCODE.NOEOLC
[LAMBDA (STREAM NOERROR) (* ; "Edited 27-Jun-2021 23:26 by rmk:")
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
\DEFAULTPEEKCCODE)
STREAM NOERROR])
(\INCCODE.EOLC
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 8-Aug-2021 14:52 by rmk:")
(* ;;
 "EOL conversion around essentially a copy of \INCCODE but avoids the extra function call.")
(* ;; " EOLC of NIL means all patterns go to EOL")
(IF BYTECOUNTVAR
THEN [LET (*BYTECOUNTER* CODE)
(DECLARE (SPECVARS *BYTECOUNTER*))
(* ;; "The INCCODEFN first sets *BYTECOUNTER*")
(CL:UNLESS BYTECOUNTVAL
(SETQ BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR)))
(SETQ CODE (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM T))
(* ;; "Update according to the number of first-char (CR or LF) bytes")
(SETQ BYTECOUNTVAL (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*))
(SETQ *BYTECOUNTER* 0)
(* ;;
 "*BYTECOUNTER* will now be reset to the number of LF-after-CR bytes, if any")
(PROG1 (\CHECKEOLC CODE (OR EOLC (FFETCH (STREAM EOLCONVENTION)
OF STREAM))
STREAM NIL T)
(* ;; "Post the results")
(SET BYTECOUNTVAR (IDIFFERENCE BYTECOUNTVAL *BYTECOUNTER*)))]
ELSE (\CHECKEOLC (CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
\DEFAULTINCCODE)
STREAM)
(OR EOLC (FFETCH (STREAM EOLCONVENTION) OF STREAM))
STREAM])
(\FORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 17:26 by rmk:")
(* ;; "Create or modify a stream that will simulate the current character input/output byte sequences of STREAM. The set up here does what is common to all formats: an IO stream starting with STREAM external format and EOL.")
(* ;; "If the format has its own FORMATBYTESTREAMFN function, that is applied to copy any other state. (Currently that function is a property of the format, not carried over into a stream field that can be changed dynamically.)")
(CL:UNLESS (AND (STREAMP BYTESTREAM)
(\IOMODEP STREAM 'BOTH))
(SETQ BYTESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH)))
(LET ((FORMAT (FETCH (STREAM EXTERNALFORMAT) OF STREAM))
(EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)))
(\EXTERNALFORMAT BYTESTREAM FORMAT)
(CL:WHEN (EQ EOLC ANY.EOLC)
(SETQ EOLC (OR (FETCH (EXTERNALFORMAT EOL) OF FORMAT)
LF.EOLC)))
(REPLACE (STREAM EOLCONVENTION) OF BYTESTREAM WITH EOLC)
(SETFILEPTR BYTESTREAM 0)
(SETFILEINFO BYTESTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
(CL:WHEN (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
(APPLY* (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
STREAM BYTESTREAM))
BYTESTREAM])
(\CHECKEOLC.CRLF
[LAMBDA (STREAM PEEKBINFLG COUNTP) (* ; "Edited 6-Aug-2021 23:30 by rmk:")
(* ;; "This is called only when a CR has been read and EOLC is either any or CRLF. This returns EOL if the next code is an LF")
(* ;; "If COUNTP, that sets *BYTECOUNTER* freely with the number of LF bytes.")
(DECLARE (USEDFREE *BYTECOUNTER*))
(LET (CH)
[SETQ CH (COND
[PEEKBINFLG
(* ;;
 "T from PEEKC. In this case, must leave the fileptr where it was.")
(* ;; "The CR itself hasn't been read, just peeked. So here we have to read it, then peek at the next character to see if it is an LF, and then back out the CR")
(COND
([EQ (CHARCODE LF)
(UNINTERRUPTABLY
(* ;; " Since we are going to \BACKCCODE back the peeked character, we don't need to update the counter variable")
(\INCCODE STREAM)
(PROG1 (\PEEKCCODE STREAM T 'NOEOLC)
(* ;;
 "This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")
(* ;;
 "LF must be the next char after the CR. We back up over the CR that \INCCODE just read.")
(\BACKCCODE STREAM)))]
(* ;; "Got the CRLF, it's an EOL")
(CHARCODE EOL))
(T (CHARCODE CR]
((EQ (CHARCODE LF)
(\PEEKCCODE STREAM T 'NOEOLC))
(* ;; "Since we aren't peeking, the CR has actually been read, and we are entitled to read the LF that we just peeked at.")
(IF COUNTP
THEN (LET (NUMLFBYTES)
(DECLARE (SPECVARS NUMLFBYTES))
(\INCCODE STREAM 'NUMLFBYTES 0)
(ADD *BYTECOUNTER* NUMLFBYTES))
ELSE (\INCCODE STREAM))
(CHARCODE EOL))
(T (CHARCODE CR]
CH])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP)
(COND
((EQ EOLC 'NOEOLC)
CH)
(T (SELCHARQ CH
(LF (SELECTC (OR EOLC (FFETCH (STREAM
EOLCONVENTION
)
OF STRM))
((LIST LF.EOLC ANY.EOLC)
(CHARCODE EOL))
(CHARCODE LF)))
(CR (SELECTC (OR EOLC (FFETCH (STREAM
EOLCONVENTION
)
OF STRM))
(CR.EOLC (CHARCODE EOL))
((LIST ANY.EOLC CRLF.EOLC)
(\CHECKEOLC.CRLF STRM PEEKBINFLG
COUNTP))
(CHARCODE CR)))
CH])
)
(* "END EXPORTED DEFINITIONS")
)
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
(DEFINEQ
(\CREATE.THROUGH.EXTERNALFORMAT
[LAMBDA NIL (* ; "Edited 23-Jun-2021 13:34 by rmk:")
(* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :THROUGH as its name. EOL is adjusted to CR so as not to do any eol conversion on this stream.")
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT
NAME _ :THROUGH
INCCODEFN _ (FUNCTION \THROUGHIN)
PEEKCCODEFN _ (FUNCTION \PEEKBIN)
BACKCCODEFN _ (FUNCTION \THROUGHBACKCCODE)
OUTCHARFN _ (FUNCTION \THROUGHOUTCHARFN)
EOL _ CR.EOLC])
(\THROUGHIN
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
(* ;;; "If COUNTP is non-NIL, the byte counter is always set to 1.")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
(\BIN STREAM])
(\THROUGHBACKCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
T)])
(\THROUGHOUTCHARFN
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
(* ;;; "Encoder for THROUGH format.")
(COND
((> CHARCODE 255)
(\BOUT OUTSTREAM (\CHARSET CHARCODE))
(\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))
(T (\BOUT OUTSTREAM CHARCODE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5657 12044 (\EXTERNALFORMAT 5667 . 10729) (MAKE-EXTERNALFORMAT 10731 . 12042)) (12045
15158 (\INSTALL.EXTERNALFORMAT 12055 . 13504) (\REMOVE.EXTERNALFORMAT 13506 . 14337) (FIND-FORMAT
14339 . 15156)) (15488 27986 (\OUTCHAR 15498 . 16634) (\INCCODE 16636 . 17822) (\BACKCCODE 17824 .
18718) (\BACKCCODE.EOLC 18720 . 21483) (\PEEKCCODE 21485 . 21801) (\PEEKCCODE.NOEOLC 21803 . 22065) (
\INCCODE.EOLC 22067 . 23926) (\FORMATBYTESTREAM 23928 . 25418) (\CHECKEOLC.CRLF 25420 . 27984)) (29929
31772 (\CREATE.THROUGH.EXTERNALFORMAT 29939 . 30741) (\THROUGHIN 30743 . 31163) (\THROUGHBACKCCODE
31165 . 31432) (\THROUGHOUTCHARFN 31434 . 31770)))))
STOP

BIN
sources/EXTERNALFORMAT.LCOM Normal file

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Sep-2021 15:54:14" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;92 178421
(FILECREATED "25-Sep-2021 21:02:29" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;99 162362
changes to%: (RECORDS FDEV)
changes to%: (VARS FILEIOCOMS)
(RECORDS FDEV)
previous date%: "13-Aug-2021 18:39:18"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;91)
previous date%: "25-Sep-2021 17:25:04"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEIO.;98)
(* ; "
@@ -51,20 +52,6 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(RECORDS FDEV FILEGENOBJ)))
(INITRECORDS FDEV)
(SYSRECORDS FDEV))
[COMS (* ;
 "EXTERNALFORMAT declaration and related functions")
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
(FNS MAKE-EXTERNALFORMAT)
(INITRECORDS EXTERNALFORMAT)
(SYSRECORDS EXTERNALFORMAT)
(FNS \INSTALL.EXTERNALFORMAT \REMOVE.EXTERNALFORMAT FIND-FORMAT \EXTERNALFORMAT)
(INITVARS [*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
(*EXTERNALFORMATS* NIL))
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
(EXPORT (INITVARS (*DEFAULT-EXTERNALFORMAT* :XCCS)))
(COMS (FNS \CREATE.THROUGH.EXTERNALFORMAT \THROUGHIN \THROUGHBACKCCODE
\THROUGHOUTCHARFN)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.THROUGH.EXTERNALFORMAT]
(COMS (* ; "Device operations")
(FNS \DEFINEDEVICE \GETDEVICEFROMNAME \GETDEVICEFROMHOSTNAME \REMOVEDEVICE
\REMOVEDEVICE.NAMES)
@@ -573,9 +560,9 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(DEFINEQ
(STREAMPROP
[LAMBDA X (* rda%: "22-Aug-84 14:24")
[LAMBDA X (* rda%: "22-Aug-84 14:24")
(* ;; "general top level entry for both fetching and setting stream properties.")
(* ;; "general top level entry for both fetching and setting stream properties.")
(COND
((IGREATERP X 2)
@@ -588,24 +575,24 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(T (\ILLEGAL.ARG NIL])
(GETSTREAMPROP
[LAMBDA (STREAM PROP) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:17")
[LAMBDA (STREAM PROP) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:17")
(SELECTQ PROP
((FORMAT EXTERNALFORMAT)
(\EXTERNALFORMAT STREAM))
(\EXTERNALFORMAT STREAM))
(ENDOFSTREAMOP (FETCH (STREAM ENDOFSTREAMOP) OF STREAM))
(LISTGET (fetch (STREAM OTHERPROPS) of STREAM)
PROP])
(PUTSTREAMPROP
[LAMBDA (STREAM PROP VALUE) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:11")
[LAMBDA (STREAM PROP VALUE) (* ; "Edited 29-Jun-2021 17:06 by rmk:")
(* rda%: "22-Aug-84 16:11")
(SELECTQ PROP
((FORMAT EXTERNALFORMAT)
(* ;; "Return the old name (=VALUE), not the format datum. Better design: the format should have it's name, and not have name as a separate property.")
(* ;; "Return the old name (=VALUE), not the format datum. Better design: the format should have it's name, and not have name as a separate property.")
(PROG1 (\EXTERNALFORMAT STREAM NIL)
(AND VALUE (\EXTERNALFORMAT STREAM VALUE))))
(PROG1 (\EXTERNALFORMAT STREAM NIL)
(AND VALUE (\EXTERNALFORMAT STREAM VALUE))))
(ENDOFSTREAMOP (PROG1 (fetch (STREAM ENDOFSTREAMOP) of STREAM)
(replace (STREAM ENDOFSTREAMOP) of STREAM with VALUE)))
(PROG ((OLDDATA (fetch OTHERPROPS of STREAM))
@@ -614,7 +601,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(OLDDATA (SETQ OLDVALUE (LISTGET OLDDATA PROP))
[COND
(VALUE (LISTPUT OLDDATA PROP VALUE))
(OLDVALUE (* ; "Remove the property")
(OLDVALUE (* ; "Remove the property")
(COND
((EQ (CAR OLDDATA)
PROP)
@@ -629,7 +616,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
OLDVALUE)
(VALUE (replace OTHERPROPS of STREAM with (LIST PROP
VALUE))
(* ; "know old value is NIL")
(* ; "know old value is NIL")
NIL])
(STREAMP
@@ -957,8 +944,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
OPENP _ (FUNCTION NILL)
UNREGISTERFILE _ (FUNCTION NILL)
CHARSETFN _ (FUNCTION \GENERIC.CHARSET)
BREAKCONNECTION _ (FUNCTION NILL)
DEFAULTEXTERNALFORMAT _ *DEFAULT-EXTERNALFORMAT*)
BREAKCONNECTION _ (FUNCTION NILL))
(RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE))
)
@@ -1182,288 +1168,6 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation.
(* ; "EXTERNALFORMAT declaration and related functions")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
(EOL BITS 2)
(NIL BITS 1)
(INCCODEFN POINTER) (* ;
 "Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
(PEEKCCODEFN POINTER) (* ;
 "Called with three arguments -- STREAM, NOERROR, and EOL")
(BACKCCODEFN POINTER) (* ;
 "Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
(OUTCHARFN POINTER) (* ;
 "Called with two arguments -- STREAM and CHARCODE")
(NAME POINTER) (* ;
 "keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
(EF1 POINTER) (* ;
 "Extra fields for use of particular formats. Possibly to hold standardized translation tables")
(EF2 POINTER)))
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
(BITS 1)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (BITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(* "END EXPORTED DEFINITIONS")
)
(DEFINEQ
(MAKE-EXTERNALFORMAT
[LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL)
(* ; "Edited 1-Aug-2021 23:13 by rmk:")
(* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL")
(SETQ EOL (SELECTC EOL
((LIST 'LF LF.EOLC)
LF.EOLC)
((LIST 'CR CR.EOLC)
CR.EOLC)
((LIST 'CRLF CRLF.EOLC)
CRLF.EOLC)
(NIL)
(SHOULDNT)))
(\INSTALL.EXTERNALFORMAT (CREATE EXTERNALFORMAT
NAME _ NAME
INCCODEFN _ INCCODEFN
PEEKCCODEFN _ PEEKCCODEFN
BACKCCODEFN _ BACKCCODEFN
OUTCHARFN _ OUTCHARFN
FORMATBYTESTREAMFN _ FORMATBYTESTREAMFN
EOLVALID _ EOL
EOL _ (OR EOL LF.EOLC])
)
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
(BITS 1)
POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
(EXTERNALFORMAT 0 (BITS . 17))
(EXTERNALFORMAT 0 (BITS . 48))
(EXTERNALFORMAT 0 POINTER)
(EXTERNALFORMAT 2 POINTER)
(EXTERNALFORMAT 4 POINTER)
(EXTERNALFORMAT 6 POINTER)
(EXTERNALFORMAT 8 POINTER)
(EXTERNALFORMAT 10 POINTER)
(EXTERNALFORMAT 12 POINTER)
(EXTERNALFORMAT 14 POINTER))
'16)
(ADDTOVAR SYSTEMRECLST
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
(EOL BITS 2)
(NIL BITS 1)
(INCCODEFN POINTER)
(PEEKCCODEFN POINTER)
(BACKCCODEFN POINTER)
(OUTCHARFN POINTER)
(NAME POINTER)
(FORMATBYTESTREAMFN POINTER)
(EF1 POINTER)
(EF2 POINTER)))
)
(DEFINEQ
(\INSTALL.EXTERNALFORMAT
[LAMBDA (EXTFORMAT/NAME EXTERNALFORMAT) (* ; "Edited 5-Aug-2021 14:22 by rmk:")
(* ;;; "Register an instance of the datatype EXTERNALFORMAT.")
(* ;;; "For backward compatibility, the first argument can be a NAME with the second argument being the format. If so, the NAME must match the name inside the format")
(LET (NAME)
(IF EXTERNALFORMAT
THEN
(* ;; "Backwards compatibility")
(SETQ NAME (MKATOM EXTFORMAT/NAME))
(IF (EQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT))
ELSEIF (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)
THEN (ERROR "Mismatch of specified name and name of the external format")
ELSE (REPLACE (EXTERNALFORMAT NAME) OF EXTERNALFORMAT WITH
NAME))
ELSE (SETQ EXTERNALFORMAT EXTFORMAT/NAME)
(SETQ NAME (FETCH (EXTERNALFORMAT NAME) OF EXTERNALFORMAT)))
(IF (type? EXTERNALFORMAT EXTERNALFORMAT)
THEN (\REMOVE.EXTERNALFORMAT NAME)
(push *EXTERNALFORMATS* EXTERNALFORMAT)
ELSE (ERROR "INVALID EXTERNALFORMAT " EXTERNALFORMAT))
EXTERNALFORMAT])
(\REMOVE.EXTERNALFORMAT
[LAMBDA (NAME/EXTFORMAT) (* ; "Edited 5-May-2021 15:42 by rmk:")
(* ;;; "Deregisters external format EXTERNALFORMAT .")
(SETQ NAME/EXTFORMAT (IF (TYPE? EXTERNALFORMAT NAME/EXTFORMAT)
THEN (FETCH (EXTERNALFORMAT NAME) OF NAME/EXTFORMAT)
ELSE (MKATOM NAME/EXTFORMAT)))
(SETQ *EXTERNALFORMATS* (DREMOVE (FIND EF IN *EXTERNALFORMATS*
SUCHTHAT (EQ NAME/EXTFORMAT (FETCH (EXTERNALFORMAT
NAME)
OF EF)))
*EXTERNALFORMATS*])
(FIND-FORMAT
[LAMBDA (NAME NOERROR) (* ; "Edited 7-Aug-2021 09:29 by rmk:")
(IF (TYPE? EXTERNALFORMAT NAME)
THEN NAME
ELSE (SETQ NAME (MKATOM NAME)) (* ;
 "The EQMEMB allows for synonyms, the first of which should be canonical. E.g. (:UTF-8 :UTF8)")
(OR (FIND EF IN *EXTERNALFORMATS* SUCHTHAT (EQ NAME (FETCH (
EXTERNALFORMAT
NAME)
OF EF)))
(CL:UNLESS NOERROR (ERROR NAME "is not an external format"])
(\EXTERNALFORMAT
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 8-Aug-2021 14:30 by rmk:")
(* ; "Edited 26-Feb-91 13:20 by nm")
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
(* ;;; "")
(* ;;; "If NEWFORMAT/NAME is nil, just returns the current external format name of STREAM. If NEWFORMAT/NAME is supplied and it is or names an external format, then the external format of STREAM is set to that format.")
(* ;;; "")
(* ;;; ":DEFAULT means the default external format for STREAM's filedevice")
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
(\DTEST STREAM 'STREAM)
(CL:WHEN NEWFORMAT/NAME
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
[LET (EXTFORMAT)
[COND
((type? EXTERNALFORMAT NEWFORMAT/NAME)
(SETQ EXTFORMAT NEWFORMAT/NAME))
(T (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
of (fetch DEVICE of
STREAM))
*DEFAULT-EXTERNALFORMATS*))
(fetch (FDEV DEFAULTEXTERNALFORMAT)
of (fetch DEVICE of STREAM))
*DEFAULT-EXTERNALFORMAT*)))
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
"is not a registered external format name"))
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
(UNINTERRUPTABLY
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch
(EXTERNALFORMAT
EOL) of
EXTFORMAT
)))
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT
OUTCHARFN)
of EXTFORMAT))
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
INCCODEFN)
of EXTFORMAT))
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
PEEKCCODEFN)
of EXTFORMAT))
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (
EXTERNALFORMAT
BACKCCODEFN)
of EXTFORMAT)))])
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
)
(RPAQ? *DEFAULT-EXTERNALFORMATS* '((DSK :XCCS)))
(RPAQ? *EXTERNALFORMATS* NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
)
(* "FOLLOWING DEFINITIONS EXPORTED")
(RPAQ? *DEFAULT-EXTERNALFORMAT* :XCCS)
(* "END EXPORTED DEFINITIONS")
(DEFINEQ
(\CREATE.THROUGH.EXTERNALFORMAT
[LAMBDA NIL (* ; "Edited 23-Jun-2021 13:34 by rmk:")
(* ;;; "Create an instance of EXTERNALFORMAT datatype and install it with :THROUGH as its name. EOL is adjusted to CR so as not to do any eol conversion on this stream.")
(\INSTALL.EXTERNALFORMAT (create EXTERNALFORMAT
NAME _ :THROUGH
INCCODEFN _ (FUNCTION \THROUGHIN)
PEEKCCODEFN _ (FUNCTION \PEEKBIN)
BACKCCODEFN _ (FUNCTION \THROUGHBACKCCODE)
OUTCHARFN _ (FUNCTION \THROUGHOUTCHARFN)
EOL _ CR.EOLC])
(\THROUGHIN
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:13 by rmk:")
(* ;;; "Read in a single byte from STREAM and returns it without any character conversion, just through as if.")
(* ;;; "If COUNTP is non-NIL, the byte counter is always set to 1.")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1))
(\BIN STREAM])
(\THROUGHBACKCCODE
[LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 16:14 by rmk:")
(DECLARE (USEDFREE *BYTECOUNTER*))
(CL:WHEN (\BACKFILEPTR STREAM)
(CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
T)])
(\THROUGHOUTCHARFN
[LAMBDA (OUTSTREAM CHARCODE) (* ; "Edited 26-Feb-91 13:44 by nm")
(* ;;; "Encoder for THROUGH format.")
(COND
((> CHARCODE 255)
(\BOUT OUTSTREAM (\CHARSET CHARCODE))
(\BOUT OUTSTREAM (\CHAR8CODE CHARCODE)))
(T (\BOUT OUTSTREAM CHARCODE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\CREATE.THROUGH.EXTERNALFORMAT)
)
(* ; "Device operations")
(DEFINEQ
@@ -3396,44 +3100,40 @@ update the map")
(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989
1990 1991 1992 1993 1999 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (28396 31886 (STREAMPROP 28406 . 28840) (GETSTREAMPROP 28842 . 29315) (PUTSTREAMPROP
29317 . 31734) (STREAMP 31736 . 31884)) (31929 34448 (\DEFPRINT.BY.NAME 31939 . 33091) (
\STREAM.DEFPRINT 33093 . 34141) (\FDEV.DEFPRINT 34143 . 34446)) (34706 39747 (\GETACCESS 34716 . 35170
) (\SETACCESS 35172 . 39745)) (63132 64385 (MAKE-EXTERNALFORMAT 63142 . 64383)) (65618 73447 (
\INSTALL.EXTERNALFORMAT 65628 . 67077) (\REMOVE.EXTERNALFORMAT 67079 . 67910) (FIND-FORMAT 67912 .
68729) (\EXTERNALFORMAT 68731 . 73445)) (73770 75633 (\CREATE.THROUGH.EXTERNALFORMAT 73780 . 74582) (
\THROUGHIN 74584 . 75008) (\THROUGHBACKCCODE 75010 . 75281) (\THROUGHOUTCHARFN 75283 . 75631)) (75741
81710 (\DEFINEDEVICE 75751 . 78067) (\GETDEVICEFROMNAME 78069 . 78542) (\GETDEVICEFROMHOSTNAME 78544
. 79588) (\REMOVEDEVICE 79590 . 80713) (\REMOVEDEVICE.NAMES 80715 . 81708)) (81750 106410 (\CLOSEFILE
81760 . 82585) (\DELETEFILE 82587 . 82881) (\DEVICEEVENT 82883 . 84653) (\GENERATEFILES 84655 . 85133
) (\GENERATENEXTFILE 85135 . 85786) (\GENERATEFILEINFO 85788 . 86249) (\GETFILENAME 86251 . 86640) (
\GENERIC.OUTFILEP 86642 . 87112) (\OPENFILE 87114 . 89692) (\DO.PARAMS.AT.OPEN 89694 . 92247) (
\RENAMEFILE 92249 . 92673) (\REVALIDATEFILE 92675 . 95277) (\PAGED.REVALIDATEFILELST 95279 . 96837) (
\PAGED.REVALIDATEFILES 96839 . 98558) (\PAGED.REVALIDATEFILE 98560 . 100843) (\BUFFERED.REVALIDATEFILE
100845 . 103131) (\BUFFERED.REVALIDATEFILELST 103133 . 104317) (\PRINT-REVALIDATION-RESULT 104319 .
104734) (\TRUNCATEFILE 104736 . 105127) (\FILE-CONFLICT 105129 . 106408)) (106446 111109 (
\GENERATENOFILES 106456 . 108552) (\NULLFILEGENERATOR 108554 . 108798) (\NOFILESNEXTFILEFN 108800 .
110791) (\NOFILESINFOFN 110793 . 111107)) (111228 113136 (\FILE.NOT.OPEN 111238 . 111751) (
\FILE.WONT.OPEN 111753 . 112081) (\ILLEGAL.DEVICEOP 112083 . 112365) (\IS.NOT.RANDACCESSP 112367 .
112813) (\STREAM.NOT.OPEN 112815 . 113134)) (113271 115569 (\FDEVINSTANCE 113281 . 115567)) (117119
124493 (CNDIR 117129 . 118434) (DIRECTORYNAME 118436 . 122619) (DIRECTORYNAMEP 122621 . 123237) (
HOSTNAMEP 123239 . 124046) (\ADD.CONNECTED.DIR 124048 . 124491)) (124538 151925 (\BACKFILEPTR 124548
. 124736) (\BACKPEEKBIN 124738 . 125099) (\BACKBIN 125101 . 125452) (BIN 125454 . 125671) (\BIN
125673 . 125950) (\BINS 125952 . 126238) (BOUT 126240 . 126602) (\BOUT 126604 . 126919) (\BOUTS 126921
. 127232) (COPYBYTES 127234 . 130566) (COPYCHARS 130568 . 134234) (COPYFILE 134236 . 135033) (
\COPYOPENFILE 135035 . 138108) (\INFER.FILE.TYPE 138110 . 139064) (EOFP 139066 . 139363) (FORCEOUTPUT
139365 . 139612) (\FLUSH.OPEN.STREAMS 139614 . 139970) (CHARSET 139972 . 141636) (ACCESS-CHARSET
141638 . 141855) (GETEOFPTR 141857 . 142107) (GETFILEINFO 142109 . 145302) (\TYPE.FROM.FILETYPE 145304
. 145774) (\FILETYPE.FROM.TYPE 145776 . 145955) (GETFILEPTR 145957 . 146209) (SETFILEINFO 146211 .
149824) (SETFILEPTR 149826 . 151545) (BOUT16 151547 . 151732) (BIN16 151734 . 151923)) (152028 157233
(\GENERIC.BINS 152038 . 152318) (\GENERIC.BOUTS 152320 . 152585) (\GENERIC.RENAMEFILE 152587 . 154418)
(\GENERIC.OPENP 154420 . 155735) (\GENERIC.READP 155737 . 156778) (\GENERIC.CHARSET 156780 . 157231))
(157234 157573 (\MAP-OPEN-STREAMS 157244 . 157571)) (159443 161523 (\EOF.ACTION 159453 . 159704) (
\EOSERROR 159706 . 159899) (\GETEOFPTR 159901 . 160083) (\INCFILEPTR 160085 . 160435) (\PEEKBIN 160437
. 160628) (\SETCLOSEDFILELENGTH 160630 . 160964) (\SETEOFPTR 160966 . 161154) (\SETFILEPTR 161156 .
161521)) (161524 162066 (\FIXPOUT 161534 . 161834) (\FIXPIN 161836 . 162064)) (162067 162633 (\BOUTEOL
162077 . 162631)) (165725 175589 (\BUFFERED.BIN 165735 . 166587) (\BUFFERED.PEEKBIN 166589 . 167371)
(\BUFFERED.BOUT 167373 . 168233) (\BUFFERED.BINS 168235 . 171920) (\BUFFERED.BOUTS 171922 . 173723) (
\BUFFERED.COPYBYTES 173725 . 175587)) (175618 177970 (\NULLDEVICE 175628 . 177646) (\NULL.OPENFILE
177648 . 177968)))))
(FILEMAP (NIL (27462 30940 (STREAMPROP 27472 . 27906) (GETSTREAMPROP 27908 . 28377) (PUTSTREAMPROP
28379 . 30788) (STREAMP 30790 . 30938)) (30983 33502 (\DEFPRINT.BY.NAME 30993 . 32145) (
\STREAM.DEFPRINT 32147 . 33195) (\FDEV.DEFPRINT 33197 . 33500)) (33760 38801 (\GETACCESS 33770 . 34224
) (\SETACCESS 34226 . 38799)) (59682 65651 (\DEFINEDEVICE 59692 . 62008) (\GETDEVICEFROMNAME 62010 .
62483) (\GETDEVICEFROMHOSTNAME 62485 . 63529) (\REMOVEDEVICE 63531 . 64654) (\REMOVEDEVICE.NAMES 64656
. 65649)) (65691 90351 (\CLOSEFILE 65701 . 66526) (\DELETEFILE 66528 . 66822) (\DEVICEEVENT 66824 .
68594) (\GENERATEFILES 68596 . 69074) (\GENERATENEXTFILE 69076 . 69727) (\GENERATEFILEINFO 69729 .
70190) (\GETFILENAME 70192 . 70581) (\GENERIC.OUTFILEP 70583 . 71053) (\OPENFILE 71055 . 73633) (
\DO.PARAMS.AT.OPEN 73635 . 76188) (\RENAMEFILE 76190 . 76614) (\REVALIDATEFILE 76616 . 79218) (
\PAGED.REVALIDATEFILELST 79220 . 80778) (\PAGED.REVALIDATEFILES 80780 . 82499) (\PAGED.REVALIDATEFILE
82501 . 84784) (\BUFFERED.REVALIDATEFILE 84786 . 87072) (\BUFFERED.REVALIDATEFILELST 87074 . 88258) (
\PRINT-REVALIDATION-RESULT 88260 . 88675) (\TRUNCATEFILE 88677 . 89068) (\FILE-CONFLICT 89070 . 90349)
) (90387 95050 (\GENERATENOFILES 90397 . 92493) (\NULLFILEGENERATOR 92495 . 92739) (\NOFILESNEXTFILEFN
92741 . 94732) (\NOFILESINFOFN 94734 . 95048)) (95169 97077 (\FILE.NOT.OPEN 95179 . 95692) (
\FILE.WONT.OPEN 95694 . 96022) (\ILLEGAL.DEVICEOP 96024 . 96306) (\IS.NOT.RANDACCESSP 96308 . 96754) (
\STREAM.NOT.OPEN 96756 . 97075)) (97212 99510 (\FDEVINSTANCE 97222 . 99508)) (101060 108434 (CNDIR
101070 . 102375) (DIRECTORYNAME 102377 . 106560) (DIRECTORYNAMEP 106562 . 107178) (HOSTNAMEP 107180 .
107987) (\ADD.CONNECTED.DIR 107989 . 108432)) (108479 135866 (\BACKFILEPTR 108489 . 108677) (
\BACKPEEKBIN 108679 . 109040) (\BACKBIN 109042 . 109393) (BIN 109395 . 109612) (\BIN 109614 . 109891)
(\BINS 109893 . 110179) (BOUT 110181 . 110543) (\BOUT 110545 . 110860) (\BOUTS 110862 . 111173) (
COPYBYTES 111175 . 114507) (COPYCHARS 114509 . 118175) (COPYFILE 118177 . 118974) (\COPYOPENFILE
118976 . 122049) (\INFER.FILE.TYPE 122051 . 123005) (EOFP 123007 . 123304) (FORCEOUTPUT 123306 .
123553) (\FLUSH.OPEN.STREAMS 123555 . 123911) (CHARSET 123913 . 125577) (ACCESS-CHARSET 125579 .
125796) (GETEOFPTR 125798 . 126048) (GETFILEINFO 126050 . 129243) (\TYPE.FROM.FILETYPE 129245 . 129715
) (\FILETYPE.FROM.TYPE 129717 . 129896) (GETFILEPTR 129898 . 130150) (SETFILEINFO 130152 . 133765) (
SETFILEPTR 133767 . 135486) (BOUT16 135488 . 135673) (BIN16 135675 . 135864)) (135969 141174 (
\GENERIC.BINS 135979 . 136259) (\GENERIC.BOUTS 136261 . 136526) (\GENERIC.RENAMEFILE 136528 . 138359)
(\GENERIC.OPENP 138361 . 139676) (\GENERIC.READP 139678 . 140719) (\GENERIC.CHARSET 140721 . 141172))
(141175 141514 (\MAP-OPEN-STREAMS 141185 . 141512)) (143384 145464 (\EOF.ACTION 143394 . 143645) (
\EOSERROR 143647 . 143840) (\GETEOFPTR 143842 . 144024) (\INCFILEPTR 144026 . 144376) (\PEEKBIN 144378
. 144569) (\SETCLOSEDFILELENGTH 144571 . 144905) (\SETEOFPTR 144907 . 145095) (\SETFILEPTR 145097 .
145462)) (145465 146007 (\FIXPOUT 145475 . 145775) (\FIXPIN 145777 . 146005)) (146008 146574 (\BOUTEOL
146018 . 146572)) (149666 159530 (\BUFFERED.BIN 149676 . 150528) (\BUFFERED.PEEKBIN 150530 . 151312)
(\BUFFERED.BOUT 151314 . 152174) (\BUFFERED.BINS 152176 . 155861) (\BUFFERED.BOUTS 155863 . 157664) (
\BUFFERED.COPYBYTES 157666 . 159528)) (159559 161911 (\NULLDEVICE 159569 . 161587) (\NULL.OPENFILE
161589 . 161909)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Aug-2021 16:42:18" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;6 284495
changes to%: (FNS GATHEREXPORTS)
(FILECREATED "10-Oct-2021 20:36:54" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;10 284821
previous date%: " 3-Jul-2021 11:08:42"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;5)
changes to%: (FNS MAKEFILE)
previous date%: " 8-Oct-2021 23:56:39"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILEPKG.;9)
(* ; "
@@ -19,15 +20,15 @@ with the terms of said license.
(PRETTYCOMPRINT FILEPKGCOMS)
(RPAQQ FILEPKGCOMS
[(COMS (* ;
 "standard records for accessing file package type/command parts. Exported for PRETTY")
[(COMS (* ;
 "standard records for accessing file package type/command parts. Exported for PRETTY")
(VARS FILEPKGTYPEPROPS)
(EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS)))
(FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS)
(INITRECORDS * FILEPKGRECORDS))
[DECLARE%: EVAL@COMPILE DOCOPY
(* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")
(* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")
(P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES
PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS
@@ -36,7 +37,7 @@ with the terms of said license.
NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS]
(INITVARS (MSDATABASELST))
[COMS
(* ;; "making, adding, listing, compiling files")
(* ;; "making, adding, listing, compiling files")
(FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES
FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE
@@ -58,14 +59,14 @@ with the terms of said license.
(INITVARS (MAKEFILEREMAKEFLG T)
(CLEANUPOPTIONS '(RC]
(COMS
(* ;; "scanning file coms")
(* ;; "scanning file coms")
(FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS
FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM
INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN
IFCDECLARE INFILEPAIRS INFILECOMSMACRO))
(COMS
(* ;; "adding to a file")
(* ;; "adding to a file")
(FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM
ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM)
@@ -73,28 +74,28 @@ with the terms of said license.
(ADDVARS (MARKASCHANGEDFNS))
(FNS MERGEINSERT MERGEINSERT1)
(* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")
(* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")
(FNS ADDTOFILEKEYLST)
(INITVARS (ADDTOFILEKEYLST (ADDTOFILEKEYLST))
(LASTFILE)))
(COMS
(* ;; "deleting an item from a file")
(* ;; "deleting an item from a file")
(FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE)
(P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)
(MOVD? 'MOVETOFILE 'MOVEITEM NIL T))
(ADDVARS (SYSPROPS PROPTYPE VARTYPE)))
[COMS (* ;
 "functions for doing things and marking them changed and auxiliary functions")
[COMS (* ;
 "functions for doing things and marking them changed and auxiliary functions")
(FNS SAVEPUT)
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
(CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT]
(FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS)
(ADDVARS (LISPXFNS (PUT . SAVEPUT)
(PUTPROP . SAVEPUT]
(COMS (* ;
 "sub-functions for file package commands & types")
(COMS (* ;
 "sub-functions for file package commands & types")
(FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED
MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS
PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS
@@ -107,24 +108,24 @@ with the terms of said license.
(PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS
LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS
PRETTYPRINTYPEMACROS USERMACROS))
(COMS (* ;
 "Define the commands below AFTER the various properties have been established.")
(COMS (* ;
 "Define the commands below AFTER the various properties have been established.")
(USERMACROS M))
(COMS (* ; "GETDEF methods")
(COMS (* ; "GETDEF methods")
(FNS RENAME CHANGECALLERS)
(FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE
GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF
DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
(INITVARS (WHEREIS.HASH)))
(* ; "Must come after PUTDEF")
(* ; "Must come after PUTDEF")
(FNS FIXEDITDATE EDITDATE?)
(* ;
 "Edit date support for all kinds of definers (from PARC 6/10/92)")
(* ;
 "Edit date support for all kinds of definers (from PARC 6/10/92)")
[VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
(EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
(COMS
(* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")
(* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")
(FNS FILEPKGCOM FILEPKGTYPE)
(PROP ARGNAMES FILEPKGCOM)
@@ -137,24 +138,24 @@ with the terms of said license.
(ADDVARS (SHADOW-TYPES (FUNCTIONS FNS)
(VARIABLES VARS CONSTANTS)))
(INITVARS (SAVEDDEFS))
(COMS (* ; "EDITCALLERS")
(COMS (* ; "EDITCALLERS")
(FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN)
(FNS SEPRCASE)
[INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL]
(INITVARS (SEPRCASEARRAYS)
(CLISPCASEARRAYS))
(P (MOVD? 'INFILEP 'FINDFILE)
(* ; "or else from SPELLFILE"))
(* ; "or else from SPELLFILE"))
(BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
(NOLINKFNS LOADFROM)))
(GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS))
(COMS (* ; "EXPORT")
(COMS (* ; "EXPORT")
(FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS)
(FILEPKGCOMS EXPORT)
[INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")
(ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"]
(GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM))
(COMS (* ; "for GAINSPACE")
(COMS (* ; "for GAINSPACE")
(FNS CLEARFILEPKG)
[ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
((Y "es")
@@ -254,11 +255,11 @@ with the terms of said license.
(REMOVE (FASSOC DATUM (GETTOPVAL
'PRETTYDEFMACROS))
(GETTOPVAL 'PRETTYDEFMACROS]
(* Not an atom record cause want
 REMPROP on NILs.)
(* NOTE%: PRETTCOM on PRETTY has
 open-coded access to the MACRO
 property.)
(* Not an atom record cause want
 REMPROP on NILs.)
(* NOTE%: PRETTCOM on PRETTY has
 open-coded access to the MACRO
 property.)
(INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE
FILEPKGCONTENTS)))
@@ -289,8 +290,8 @@ with the terms of said license.
(REMOVE (SEARCHPRETTYTYPELST
DATUM)
(GETTOPVAL 'PRETTYTYPELST]
(* NOTE%: PRETTYCOM on PRETTY has
 open-coded access to GETDEF property)
(* NOTE%: PRETTYCOM on PRETTY has
 open-coded access to GETDEF property)
(INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
(MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
(PUT X
@@ -455,31 +456,35 @@ with the terms of said license.
(RETURN FILE])
(MAKEFILE
[LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 3-Jul-2021 11:03 by rmk:")
(* ; "Edited 29-Jun-2021 17:24 by rmk:")
[LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 10-Oct-2021 20:36 by rmk:")
(* ; "Edited 29-Jun-2021 17:24 by rmk:")
(* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.")
(* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL; LIST means list the FILE; RC means RECOMPILE, C means COMPILEL; --- for C AND RC assume ST unless next option is F.")
(* ;; "RMK: OPTIONS can specify external format, either as a pair like (FORMAT :UTF-8) or just :UTF-8 where (FIND-FORMAT :UTF-8) is non NIL.")
[SETQ OPTIONS (FOR OPT INSIDE OPTIONS COLLECT (CL:IF (FIND-FORMAT OPT T)
(LIST 'FORMAT OPT))]
(PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS]
PRETTYFLG))
(*PRINT-BASE* (if (EQ *PRINT-BASE* 8)
then 8
else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments")
else (* ; "make sure radix is either 8 or 10, because all others don't read in like they print. Maybe obsolete now with makefile environments")
10))
FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE)))
(DECLARE (CL:SPECIAL PRETTYFLG))
(SETQ FILE (CAR Z)) (* ;
 "Necessary because FILE might have been misspelled.")
(SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")
(SETQ FILE (CAR Z)) (* ;
 "Necessary because FILE might have been misspelled.")
(SETQ ROOTNAME (CADR Z)) (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")
(SETQ FILEPROP (CDDR Z))
(UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")
(UPDATEFILES) (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")
(SETQ CHANGES (fetch TOBEDUMPED of FILEPROP))
(SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME)))
(SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE))
LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP))
(NULL FILEDATES))
then (* ;
 "File has never been loaded and never dumped i.e. user just set up COMS in core")
then (* ;
 "File has never been loaded and never dumped i.e. user just set up COMS in core")
elseif [OR (EQMEMB 'NEW OPTIONS)
(AND (NULL MAKEFILEREMAKEFLG)
(NOT (MEMB 'REMAKE OPTIONS]
@@ -500,14 +505,14 @@ with the terms of said license.
T)
(COND
((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ")
'Y) (* ;
 "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")
'Y) (* ;
 "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")
(GO OUT)))
(/replace LOADTYPE of FILEPROP with NIL)))
(SETQ SOURCEFILE NIL)
(SETQ REPRINTFNS NIL)
elseif SOURCEFILE
then (* ; "source file given")
then (* ; "source file given")
elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T))
(EQUAL (FILEDATE SOURCEFILE)
(fetch FILEDATE of (CAR FILEDATES]
@@ -527,7 +532,7 @@ with the terms of said license.
(fetch FILEDATE of (CADR FILEDATES]
then
(* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")
(* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")
(SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP)
(fetch FILECHANGES of ROOTNAME)))
@@ -545,8 +550,8 @@ with the terms of said license.
(GO LP0))
(COND
((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP)
(LOADCOMP (* ;
 "only loaded via LOADCOMP. Need to do LOADFROM")
(LOADCOMP (* ;
 "only loaded via LOADCOMP. Need to do LOADFROM")
(LIST 'N SOURCEFILE "was loaded with LOADCOMP"
'- "LOADFROM it to obtain VARS/COMS"))
(Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%:
@@ -569,23 +574,23 @@ with the terms of said license.
(A "bort MAKEFILE
"]
(Y (SELECTQ (fetch LOADTYPE of FILEPROP)
(LOADCOMP (* ;
 "file was never actually loaded, just loadcomped. thus no filecoms")
(LOADCOMP (* ;
 "file was never actually loaded, just loadcomped. thus no filecoms")
(LOADFROM SOURCEFILE))
(Compiled
(* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")
(* ;; "This is going to be a remake. If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")
(LOADVARS 'DONTCOPY SOURCEFILE)
(/replace LOADTYPE of FILEPROP with 'COMPILED)
(* ; "So wont have to be done again.")
(* ; "So wont have to be done again.")
(* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")
(* ;; "These are the only DECLARE:'s that are not also on the compiled file. Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE: Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")
)
((loadfns compiled)
(* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")
(* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")
(LOADVARS T SOURCEFILE))
NIL))
@@ -4789,7 +4794,7 @@ compiling " T)
(MOVD? 'INFILEP 'FINDFILE)
(* ; "or else from SPELLFILE")
(* ; "or else from SPELLFILE")
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
@@ -5036,46 +5041,46 @@ compiling " T)
(PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989
1990 1991 1992 1993 1995 2018 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (20621 22326 (SEARCHPRETTYTYPELST 20631 . 21610) (PRETTYDEFMACROS 21612 . 22070) (
FILEPKGCOMPROPS 22072 . 22324)) (23128 57617 (CLEANUP 23138 . 24526) (COMPILEFILES 24528 . 24804) (
COMPILEFILES0 24806 . 25526) (CONTINUEDIT 25528 . 26948) (MAKEFILE 26950 . 38958) (FILECHANGES 38960
. 41295) (FILEPKG.MERGECHANGES 41297 . 42120) (FILEPKG.CHANGEDFNS 42122 . 42434) (MAKEFILE1 42436 .
46663) (COMPILE-FILE? 46665 . 48222) (MAKEFILES 48224 . 49917) (ADDFILE 49919 . 52440) (ADDFILE0 52442
. 56578) (LISTFILES 56580 . 57615)) (58313 93553 (FILEPKGCHANGES 58323 . 59673) (GETFILEPKGTYPE 59675
. 62748) (MARKASCHANGED 62750 . 64387) (FILECOMS 64389 . 64773) (WHEREIS 64775 . 66195) (
SMASHFILECOMS 66197 . 66432) (FILEFNSLST 66434 . 66596) (FILECOMSLST 66598 . 67082) (UPDATEFILES 67084
. 72384) (INFILECOMS? 72386 . 74289) (INFILECOMTAIL 74291 . 75431) (INFILECOMS 75433 . 75594) (
INFILECOM 75596 . 85805) (INFILECOMSVALS 85807 . 86134) (INFILECOMSVAL 86136 . 87138) (INFILECOMSPROP
87140 . 87969) (IFCPROPS 87971 . 89232) (IFCEXPRTYPE 89234 . 89745) (IFCPROPSCAN 89747 . 90800) (
IFCDECLARE 90802 . 92113) (INFILEPAIRS 92115 . 92447) (INFILECOMSMACRO 92449 . 93551)) (93588 125008 (
FILES? 93598 . 95791) (FILES?1 95793 . 96491) (FILES?PRINTLST 96493 . 97275) (ADDTOFILES? 97277 .
108323) (ADDTOFILE 108325 . 109241) (WHATIS 109243 . 111219) (ADDTOCOMS 111221 . 112865) (ADDTOCOM
112867 . 119414) (ADDTOCOM1 119416 . 120587) (ADDNEWCOM 120589 . 121639) (MAKENEWCOM 121641 . 123484)
(DEFAULTMAKENEWCOM 123486 . 125006)) (125078 127895 (MERGEINSERT 125088 . 127431) (MERGEINSERT1 127433
. 127893)) (128049 129406 (ADDTOFILEKEYLST 128059 . 129404)) (129523 140435 (DELFROMFILES 129533 .
130383) (DELFROMCOMS 130385 . 132064) (DELFROMCOM 132066 . 137934) (DELFROMCOM1 137936 . 138733) (
REMOVEITEM 138735 . 139609) (MOVETOFILE 139611 . 140433)) (140649 143018 (SAVEPUT 140659 . 143016)) (
143143 151467 (UNMARKASCHANGED 143153 . 144861) (PREEDITFN 144863 . 147374) (POSTEDITPROPS 147376 .
149877) (POSTEDITALISTS 149879 . 151465)) (151616 172170 (ALISTS.GETDEF 151626 . 152005) (
ALISTS.WHENCHANGED 152007 . 152651) (CLEARCLISPARRAY 152653 . 153827) (EXPRESSIONS.WHENCHANGED 153829
. 154203) (MAKEALISTCOMS 154205 . 155278) (MAKEFILESCOMS 155280 . 156717) (MAKELISPXMACROSCOMS 156719
. 158737) (MAKEPROPSCOMS 158739 . 159437) (MAKEUSERMACROSCOMS 159439 . 161239) (PROPS.WHENCHANGED
161241 . 161862) (FILEGETDEF.LISPXMACROS 161864 . 163306) (FILEGETDEF.ALISTS 163308 . 163927) (
FILEGETDEF.RECORDS 163929 . 164860) (FILEGETDEF.PROPS 164862 . 165654) (FILEGETDEF.MACROS 165656 .
166716) (FILEGETDEF.VARS 166718 . 167134) (FILEGETDEF.FNS 167136 . 168500) (FILEPKGCOMS.PUTDEF 168502
. 170942) (FILES.PUTDEF 170944 . 171901) (VARS.PUTDEF 171903 . 172046) (FILES.WHENCHANGED 172048 .
172168)) (174192 181625 (RENAME 174202 . 175603) (CHANGECALLERS 175605 . 181623)) (181626 229574 (
SHOWDEF 181636 . 182429) (COPYDEF 182431 . 184905) (GETDEF 184907 . 187183) (GETDEFCOM 187185 . 188151
) (GETDEFCOM0 188153 . 189499) (GETDEFCURRENT 189501 . 195921) (GETDEFERR 195923 . 197224) (
GETDEFFROMFILE 197226 . 201506) (GETDEFSAVED 201508 . 202612) (PUTDEF 202614 . 203317) (EDITDEF 203319
. 204296) (DEFAULT.EDITDEF 204298 . 207134) (EDITDEF.FILES 207136 . 207337) (LOADDEF 207339 . 207515)
(DWIMDEF 207517 . 208371) (DELDEF 208373 . 211387) (DELFROMLIST 211389 . 211893) (HASDEF 211895 .
218217) (GETFILEDEF 218219 . 218741) (SAVEDEF 218743 . 220402) (UNSAVEDEF 220404 . 221300) (
COMPAREDEFS 221302 . 224604) (COMPARE 224606 . 225310) (TYPESOF 225312 . 229572)) (229641 234684 (
FIXEDITDATE 229651 . 233154) (EDITDATE? 233156 . 234682)) (235103 243874 (FILEPKGCOM 235113 . 240046)
(FILEPKGTYPE 240048 . 243872)) (255911 270843 (FINDCALLERS 255921 . 256436) (EDITCALLERS 256438 .
264348) (EDITFROMFILE 264350 . 270158) (FINDATS 270160 . 270432) (LOOKIN 270434 . 270841)) (270844
272571 (SEPRCASE 270854 . 272569)) (273088 278645 (IMPORTFILE 273098 . 274072) (IMPORTEVAL 274074 .
274954) (IMPORTFILESCAN 274956 . 275377) (CHECKIMPORTS 275379 . 276715) (GATHEREXPORTS 276717 . 278055
) (\DUMPEXPORTS 278057 . 278643)) (278983 281191 (CLEARFILEPKG 278993 . 281189)))))
(FILEMAP (NIL (20618 22323 (SEARCHPRETTYTYPELST 20628 . 21607) (PRETTYDEFMACROS 21609 . 22067) (
FILEPKGCOMPROPS 22069 . 22321)) (23125 57943 (CLEANUP 23135 . 24523) (COMPILEFILES 24525 . 24801) (
COMPILEFILES0 24803 . 25523) (CONTINUEDIT 25525 . 26945) (MAKEFILE 26947 . 39284) (FILECHANGES 39286
. 41621) (FILEPKG.MERGECHANGES 41623 . 42446) (FILEPKG.CHANGEDFNS 42448 . 42760) (MAKEFILE1 42762 .
46989) (COMPILE-FILE? 46991 . 48548) (MAKEFILES 48550 . 50243) (ADDFILE 50245 . 52766) (ADDFILE0 52768
. 56904) (LISTFILES 56906 . 57941)) (58639 93879 (FILEPKGCHANGES 58649 . 59999) (GETFILEPKGTYPE 60001
. 63074) (MARKASCHANGED 63076 . 64713) (FILECOMS 64715 . 65099) (WHEREIS 65101 . 66521) (
SMASHFILECOMS 66523 . 66758) (FILEFNSLST 66760 . 66922) (FILECOMSLST 66924 . 67408) (UPDATEFILES 67410
. 72710) (INFILECOMS? 72712 . 74615) (INFILECOMTAIL 74617 . 75757) (INFILECOMS 75759 . 75920) (
INFILECOM 75922 . 86131) (INFILECOMSVALS 86133 . 86460) (INFILECOMSVAL 86462 . 87464) (INFILECOMSPROP
87466 . 88295) (IFCPROPS 88297 . 89558) (IFCEXPRTYPE 89560 . 90071) (IFCPROPSCAN 90073 . 91126) (
IFCDECLARE 91128 . 92439) (INFILEPAIRS 92441 . 92773) (INFILECOMSMACRO 92775 . 93877)) (93914 125334 (
FILES? 93924 . 96117) (FILES?1 96119 . 96817) (FILES?PRINTLST 96819 . 97601) (ADDTOFILES? 97603 .
108649) (ADDTOFILE 108651 . 109567) (WHATIS 109569 . 111545) (ADDTOCOMS 111547 . 113191) (ADDTOCOM
113193 . 119740) (ADDTOCOM1 119742 . 120913) (ADDNEWCOM 120915 . 121965) (MAKENEWCOM 121967 . 123810)
(DEFAULTMAKENEWCOM 123812 . 125332)) (125404 128221 (MERGEINSERT 125414 . 127757) (MERGEINSERT1 127759
. 128219)) (128375 129732 (ADDTOFILEKEYLST 128385 . 129730)) (129849 140761 (DELFROMFILES 129859 .
130709) (DELFROMCOMS 130711 . 132390) (DELFROMCOM 132392 . 138260) (DELFROMCOM1 138262 . 139059) (
REMOVEITEM 139061 . 139935) (MOVETOFILE 139937 . 140759)) (140975 143344 (SAVEPUT 140985 . 143342)) (
143469 151793 (UNMARKASCHANGED 143479 . 145187) (PREEDITFN 145189 . 147700) (POSTEDITPROPS 147702 .
150203) (POSTEDITALISTS 150205 . 151791)) (151942 172496 (ALISTS.GETDEF 151952 . 152331) (
ALISTS.WHENCHANGED 152333 . 152977) (CLEARCLISPARRAY 152979 . 154153) (EXPRESSIONS.WHENCHANGED 154155
. 154529) (MAKEALISTCOMS 154531 . 155604) (MAKEFILESCOMS 155606 . 157043) (MAKELISPXMACROSCOMS 157045
. 159063) (MAKEPROPSCOMS 159065 . 159763) (MAKEUSERMACROSCOMS 159765 . 161565) (PROPS.WHENCHANGED
161567 . 162188) (FILEGETDEF.LISPXMACROS 162190 . 163632) (FILEGETDEF.ALISTS 163634 . 164253) (
FILEGETDEF.RECORDS 164255 . 165186) (FILEGETDEF.PROPS 165188 . 165980) (FILEGETDEF.MACROS 165982 .
167042) (FILEGETDEF.VARS 167044 . 167460) (FILEGETDEF.FNS 167462 . 168826) (FILEPKGCOMS.PUTDEF 168828
. 171268) (FILES.PUTDEF 171270 . 172227) (VARS.PUTDEF 172229 . 172372) (FILES.WHENCHANGED 172374 .
172494)) (174518 181951 (RENAME 174528 . 175929) (CHANGECALLERS 175931 . 181949)) (181952 229900 (
SHOWDEF 181962 . 182755) (COPYDEF 182757 . 185231) (GETDEF 185233 . 187509) (GETDEFCOM 187511 . 188477
) (GETDEFCOM0 188479 . 189825) (GETDEFCURRENT 189827 . 196247) (GETDEFERR 196249 . 197550) (
GETDEFFROMFILE 197552 . 201832) (GETDEFSAVED 201834 . 202938) (PUTDEF 202940 . 203643) (EDITDEF 203645
. 204622) (DEFAULT.EDITDEF 204624 . 207460) (EDITDEF.FILES 207462 . 207663) (LOADDEF 207665 . 207841)
(DWIMDEF 207843 . 208697) (DELDEF 208699 . 211713) (DELFROMLIST 211715 . 212219) (HASDEF 212221 .
218543) (GETFILEDEF 218545 . 219067) (SAVEDEF 219069 . 220728) (UNSAVEDEF 220730 . 221626) (
COMPAREDEFS 221628 . 224930) (COMPARE 224932 . 225636) (TYPESOF 225638 . 229898)) (229967 235010 (
FIXEDITDATE 229977 . 233480) (EDITDATE? 233482 . 235008)) (235429 244200 (FILEPKGCOM 235439 . 240372)
(FILEPKGTYPE 240374 . 244198)) (256237 271169 (FINDCALLERS 256247 . 256762) (EDITCALLERS 256764 .
264674) (EDITFROMFILE 264676 . 270484) (FINDATS 270486 . 270758) (LOOKIN 270760 . 271167)) (271170
272897 (SEPRCASE 271180 . 272895)) (273414 278971 (IMPORTFILE 273424 . 274398) (IMPORTEVAL 274400 .
275280) (IMPORTFILESCAN 275282 . 275703) (CHECKIMPORTS 275705 . 277041) (GATHEREXPORTS 277043 . 278381
) (\DUMPEXPORTS 278383 . 278969)) (279309 281517 (CLEARFILEPKG 279319 . 281515)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Jun-2021 10:21:40" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;6 6395
changes to%: (VARS 0LISPSET)
(FILECREATED "17-Oct-2021 13:52:47" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;15 6457
previous date%: "19-Jun-2021 12:13:31"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;5)
changes to%: (VARS EXPORTFILES)
previous date%: "17-Oct-2021 12:43:39"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;14)
(* ; "
@@ -17,13 +18,13 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
(RPAQQ FILESETSCOMS
(
(* ;;; "contains all of the lists of files which are used in various ways")
(* ;;; "contains all of the lists of files which are used in various ways")
(* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel")
(* ;; "I took out the EXPORT of the filesets because it led to inconsistency when one had loaded ABC. -- Pavel")
(* ;; "The file with the default EXTERNALFORMAT should come right after FILEIO, and particularly before ATERM.")
(* ;; "The file with the default EXTERNALFORMAT should come right after FILEIO, and particularly before ATERM.")
(VARS * FILESETS)
(VARS EXPORTFILES)
@@ -51,10 +52,10 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
(RPAQQ FILESETS (0LISPSET 1LISPSET 2LISPSET 3LISPSET))
(RPAQQ 0LISPSET (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO IMAGEIO LLBASIC LLGC
LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS
LLARITH LLFLOAT LLBIGNUM LLREAD XCCS LLCHAR LLSTK LLDATATYPE IOCHAR LLKEY
LLTIMER))
(RPAQQ 0LISPSET (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO EXTERNALFORMAT
IMAGEIO LLBASIC LLGC LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME
SETF-RUNTIME CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD XCCS LLCHAR
LLSTK LLDATATYPE IOCHAR LLKEY LLTIMER))
(RPAQQ 1LISPSET
(ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC
@@ -69,17 +70,17 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
(RPAQQ EXPORTFILES
(MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR
LLSTK PMAP LLGC ATBL FILEIO LLARITH LLFLOAT FONT LLKEY LLDISPLAY ADISPLAY AINTERRUPT
RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER IMAGEIO PROC XCCS
LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS))
LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER
IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS))
(RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW))
(RPAQQ MAKEINITTYPES
((NIL INIT (0 1)
2LISPSET 1600)
(SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO LLBASIC LLGC LLINTERP LLARITH LLREAD
LLCHAR TINYPATCH))
(SMALLINIT SMALLINIT (LLFAULT LLSUBRS LLNEW FILEIO EXTERNALFORMAT LLBASIC LLGC LLINTERP
LLARITH LLREAD LLCHAR TINYPATCH))
(MACROTEST MACROTEST ((MACROTEST)
0 1)
2LISPSET)
@@ -114,7 +115,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
(COMSNAME . RDCOMS)
(EXTRACOMS
(* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)")
(* ;; "YOU MUST REMAKE THIS FILE using (DORENAME 'R) (after CONNing to library) whenever the SYSOUT layout changes in LLPARAMS (e.g., if MDSTypeTable moves)")
(FILES VMEM)
(VARS RDVALS RDPTRS)

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 5-May-2021 19:41:55" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>sources>HARDCOPY.;9 103663
(FILECREATED " 8-Oct-2021 22:23:49" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;13 103499
changes to%: (FNS COPY.TEXT.TO.IMAGE)
previous date%: "16-Apr-2018 22:15:08"
{DSK}<Users>kaplan>Local>medley3.5>git-medley2>sources>HARDCOPY.;8)
previous date%: " 7-Oct-2021 10:43:32"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;12)
(* ; "
@@ -15,46 +16,47 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(PRETTYCOMPRINT HARDCOPYCOMS)
(RPAQQ HARDCOPYCOMS
[(COMS (* ; "exported functionality")
[(COMS (* ; "exported functionality")
(FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER
HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER COPY.WINDOW.TO.BITMAP)
(* ; "user interface jazz")
(* ; "user interface jazz")
(INITVARS (ChangeDefaultPrinter))
(FNS MakeMenuOfPrinters PRINTERS.WHENSELECTEDFN MakeMenuOfImageTypes
GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter
GetPrinterName GetImageFile FetchDefaultPrinter)
(* ; "filename diddlers")
(* ; "filename diddlers")
(FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
(COMS (* ;
 "Interface for PRINTERS and IMAGEFILES")
(COMS (* ;
 "Interface for PRINTERS and IMAGEFILES")
(FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS
HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE
PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE
\EXPECTED.FILE.TYPE SEND.FILE.TO.PRINTER)
(FNS PRINTERDEVICE)
[DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT]
(P (* ; "for backward compatibility")
(P (* ; "for backward compatibility")
(MOVD? 'NILL 'PRINTERMODE))
(INITVARS (DEFAULTPRINTINGHOST)
(DEFAULTPRINTERTYPE 'INTERPRESS)
(EMPRESS.SCRATCH)
(EMPRESS#SIDES T))
(EMPRESS#SIDES T)
(PRINTFILETYPES NIL))
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES
PRINTFILETYPES))
(COMS (* ;
 "Converting text files to imagestreams")
(COMS (* ;
 "Converting text files to imagestreams")
(INITVARS (TEXTDEFAULTTABS (LIST 20320))
(TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
(* ;
 "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
(* ;
 "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches")
(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
(FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
(COMS (FNS \BLTSHADE.GENERICPRINTER)
(* ;
 "hack for printers that can't really BLTSHADE")
(* ;
 "hack for printers that can't really BLTSHADE")
)
[COMS (* ;
 "stuff to support hardcopy streams on the display.")
[COMS (* ;
 "stuff to support hardcopy streams on the display.")
(FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY
\DSPFONT.HDCPYDISPLAY \DSPRIGHTMARGIN.HDCPYDISPLAY \DSPXPOSITION.HDCPYDISPLAY
\DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \STRINGWIDTH.HCPYDISPLAYAUX
@@ -65,8 +67,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(IMICASPERPT 35]
(DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
[COMS (* ;
 "Stuff to support MICA-unit hardcopy streams on the display")
[COMS (* ;
 "Stuff to support MICA-unit hardcopy streams on the display")
(FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE
\BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE
\DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE
@@ -649,7 +651,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(PRINTERDEVICE 'LPT)
)
(* ; "for backward compatibility")
(* ; "for backward compatibility")
(MOVD? 'NILL 'PRINTERMODE)
@@ -660,6 +662,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(RPAQ? EMPRESS.SCRATCH )
(RPAQ? EMPRESS#SIDES T)
(RPAQ? PRINTFILETYPES NIL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES)
@@ -719,105 +723,100 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(CLOSEF IMAGESTREAM])])
(COPY.TEXT.TO.IMAGE
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 5-May-2021 19:41 by rmk:")
(* ; "Edited 10-Apr-95 21:23 by rmk:")
[LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 8-Oct-2021 22:23 by rmk:")
(* ; "Edited 10-Apr-95 21:23 by rmk:")
(* ;; "Copy text to an image stream, obeying PSPOOL control characters")
(* ;; "Copy text to an image stream, obeying PSPOOL control characters")
(LET*
((IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
[(IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
(RIGHTMAR (DSPRIGHTMARGIN NIL IMAGESTREAM))
(FONTARRAY (FONTMAPARRAY FONTS))
(MAXFONT (ARRAYSIZE FONTARRAY))
(INSTRM (GETSTREAM INFILE 'INPUT))
DEFAULTTAB C FC)
(replace (STREAM ENDOFSTREAMOP) of INSTRM with (FUNCTION ZERO))
(do
(COND
((AND [EQ 0 (LOGAND 255 (SETQ C (\INCCODE INSTRM]
(EOFP INSTRM))
(RETURN))
((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
RIGHTMAR)) (* ;
 "Not to walk off the right edge of the paper")
(TERPRI IMAGESTREAM)))
(COND
([> C (CONSTANT (APPLY (FUNCTION MAX)
(CHARCODE (^F CR LF ^L TAB NULL]
(\OUTCHAR IMAGESTREAM C))
(T
(SELCHARQ C
(^F (* ; "Font shift")
DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP]
(* ;;
 "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")
(* ;;
"RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch")
(DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
1)
IMAGESTREAM)
[SELCHARQ (SETQ FC (\INCCODE INSTRM))
(^T (* ; "tab to absolute pos.")
(COND
((EQ 0 (SETQ FC (\INCCODE INSTRM)))
(\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(\OUTCHAR IMAGESTREAM (CHARCODE ^T))
(AND (\EOFP INSTRM)
(RETURN))
(\OUTCHAR IMAGESTREAM FC))
(T
(SETFILEINFO INSTRM 'ENDOFSTREAMOP (FUNCTION NILL))
[while (SETQ C (\INCCODE INSTRM))
do
(COND
((AND RIGHTMAR (> (DSPXPOSITION NIL IMAGESTREAM)
RIGHTMAR)) (* ;
 "Not to walk off the right edge of the paper")
(TERPRI IMAGESTREAM)))
(COND
([> C (CONSTANT (APPLY (FUNCTION MAX)
(CHARCODE (^F CR LF ^L TAB]
(\OUTCHAR IMAGESTREAM C))
(T
(SELCHARQ C
(^F (* ; "Font shift")
(* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale")
(* ;;
 "For FX-XP-9 printer:SETXY interpress command to avoid printer's BUG(Take)")
[SETQ FC
(IF TABS
THEN (OR (CAR (NTH TABS FC))
(ERROR "Undefined absolute tab number" FC))
ELSE (TIMES FC
(OR DEFAULTTAB
(SETQ DEFAULTTAB
(TIMES 8 (CHARWIDTH (CHARCODE SPACE)
(FONTCREATE (ELT FONTARRAY
1)
NIL NIL NIL
IMAGESTREAM]
(DSPXPOSITION FC IMAGESTREAM))))
(NULL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(AND (\EOFP INSTRM)
(RETURN))
(\OUTCHAR IMAGESTREAM FC) (* ; "EOS after ^F")
)
(COND
((AND (>= MAXFONT FC)
(NEQ FC 0))
(DSPFONT (ELT FONTARRAY FC)
IMAGESTREAM))
(T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(\OUTCHAR IMAGESTREAM C])
(CR
(* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text. Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file as a carriage-return. But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously. Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, which is to treat all instances of CR, CRLF, and LF as end-of-line.")
(DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM)
1)
IMAGESTREAM)
[SELCHARQ (SETQ FC (\INCCODE INSTRM))
(^T (* ; "tab to absolute pos.")
(CL:UNLESS (SETQ FC (\INCCODE INSTRM))
(\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(\OUTCHAR IMAGESTREAM (CHARCODE ^T))
(RETURN))
(TERPRI IMAGESTREAM)
(COND
((EQ (CHARCODE LF)
(\PEEKBIN INSTRM T))
(BIN INSTRM))))
(TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
(TAB.WIDTH (TIMES (CHARWIDTH (CHARCODE SPACE)
IMAGESTREAM)
8))
(CURRENT.X (- (DSPXPOSITION NIL IMAGESTREAM)
LEFTMARGIN))
(CURRENT.STOP (- CURRENT.X (REMAINDER CURRENT.X TAB.WIDTH]
(NLSETQ (RELMOVETO (- (+ CURRENT.STOP TAB.WIDTH)
CURRENT.X)
0 IMAGESTREAM)))
(\OUTCHAR IMAGESTREAM C)))
(LF (* ; "See comment at CR")
(TERPRI IMAGESTREAM))
(NULL (AND (EOFP INSTRM)
(RETURN))
(\OUTCHAR IMAGESTREAM C))
(\OUTCHAR IMAGESTREAM C])
(* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale")
[SETQ FC
(IF TABS
THEN (OR (CAR (NTH TABS FC))
(ERROR "Undefined absolute tab number" FC))
ELSE (TIMES FC (OR DEFAULTTAB
(SETQ DEFAULTTAB
(TIMES 8 (CHARWIDTH (CHARCODE SPACE)
(FONTCREATE (ELT FONTARRAY 1
)
NIL NIL NIL
IMAGESTREAM]
(DSPXPOSITION FC IMAGESTREAM))
(NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(* ; "EOS after ^F")
(RETURN))
(COND
((AND (>= MAXFONT FC)
(NEQ FC 0))
(DSPFONT (ELT FONTARRAY FC)
IMAGESTREAM))
(T (\OUTCHAR IMAGESTREAM (CHARCODE ^F))
(\OUTCHAR IMAGESTREAM FC])
(CR
(* ;; "Assumes that CR and possibly following LF denote a single EOL, independent of the EOL convention and independent of whether the file was opened binary or text. Originally, this function tried to discriminate, treating an LF in a CR-mode file as a line-feed and a CR in an LF file
as a carriage-return. But these formatting effects cannot be guaranteed across text-file transfers (which is all that it makes sense to print), so it is silly to take them seriously. Given that just this information can be lost in text-mode file transfers, we make adopt here the 99%% correct solution, wh
ich is to treat all instances of CR, CRLF, and LF as end-of-line.")
(COND
((EQ (CHARCODE LF)
(\PEEKCCODE.NOEOLC INSTRM T))
(\INCCODE INSTRM)))
(TERPRI IMAGESTREAM))
(LF (* ; "Isolatedx LF, see comment at CR")
(TERPRI IMAGESTREAM))
(TAB (OR (LET* [(LEFTMARGIN (DSPLEFTMARGIN NIL IMAGESTREAM))
(TAB.WIDTH (TIMES (CHARWIDTH (CHARCODE SPACE)
IMAGESTREAM)
8))
(CURRENT.X (- (DSPXPOSITION NIL IMAGESTREAM)
LEFTMARGIN))
(CURRENT.STOP (- CURRENT.X (REMAINDER CURRENT.X TAB.WIDTH]
(NLSETQ (RELMOVETO (- (+ CURRENT.STOP TAB.WIDTH)
CURRENT.X)
0 IMAGESTREAM)))
(\OUTCHAR IMAGESTREAM C)))
(\OUTCHAR IMAGESTREAM C]
(SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP])
)
(DEFINEQ
@@ -1085,39 +1084,39 @@ Copyright (c) 1984-1993, 1999, 2018, 2021 by Venue & Xerox Corporation.
(PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992
1993 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6141 10325 (HARDCOPY.SOMEHOW 6151 . 7509) (HARDCOPYIMAGEW 7511 . 7663) (
HARDCOPYIMAGEW.TOFILE 7665 . 7973) (HARDCOPYIMAGEW.TOPRINTER 7975 . 8640) (HARDCOPYREGION.TOFILE 8642
. 8940) (HARDCOPYREGION.TOPRINTER 8942 . 9564) (COPY.WINDOW.TO.BITMAP 9566 . 10323)) (10397 20947 (
MakeMenuOfPrinters 10407 . 11632) (PRINTERS.WHENSELECTEDFN 11634 . 13376) (MakeMenuOfImageTypes 13378
. 13896) (GetNewPrinterFromUser 13898 . 14326) (PopUpWindowAndGetAtom 14328 . 15713) (
PopUpWindowAndGetList 15715 . 17281) (NewPrinter 17283 . 18231) (GetPrinterName 18233 . 18513) (
GetImageFile 18515 . 20802) (FetchDefaultPrinter 20804 . 20945)) (20982 21520 (
ExtensionForPrintFileType 20992 . 21185) (PRINTFILETYPE.FROM.EXTENSION 21187 . 21518)) (21575 37959 (
DEFAULTPRINTER 21585 . 21745) (CAN.PRINT.DIRECTLY 21747 . 21903) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
21905 . 22949) (EMPRESS 22951 . 23264) (HARDCOPYW 23266 . 26226) (LISTFILES1 26228 . 26401) (
PRINTER.BITMAPFILE 26403 . 26650) (PRINTER.BITMAPSCALE 26652 . 26917) (PRINTER.SCRATCH.FILE 26919 .
27042) (PRINTERPROP 27044 . 27227) (PRINTERSTATUS 27229 . 27418) (PRINTERTYPE 27420 . 29729) (
PRINTERNAME 29731 . 30033) (PRINTFILEPROP 30035 . 30226) (PRINTFILETYPE 30228 . 32172) (
\EXPECTED.FILE.TYPE 32174 . 32956) (SEND.FILE.TO.PRINTER 32958 . 37957)) (37960 42942 (PRINTERDEVICE
37970 . 42940)) (43725 51926 (TEXTTOIMAGEFILE 43735 . 45925) (COPY.TEXT.TO.IMAGE 45927 . 51924)) (
51927 53062 (\BLTSHADE.GENERICPRINTER 51937 . 53060)) (53190 71942 (MAKEHARDCOPYSTREAM 53200 . 54204)
(UNMAKEHARDCOPYSTREAM 54206 . 54890) (HARDCOPYSTREAMTYPE 54892 . 55171) (\CHARWIDTH.HDCPYDISPLAY 55173
. 55604) (\DSPFONT.HDCPYDISPLAY 55606 . 57011) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57013 . 57590) (
\DSPXPOSITION.HDCPYDISPLAY 57592 . 57853) (\DSPYPOSITION.HDCPYDISPLAY 57855 . 58116) (
\STRINGWIDTH.HDCPYDISPLAY 58118 . 58625) (\STRINGWIDTH.HCPYDISPLAYAUX 58627 . 60959) (\HDCPYBLTCHAR
60961 . 63496) (\HDCPYDISPLAY.FIX.XPOS 63498 . 63918) (\HDCPYDISPLAY.FIX.YPOS 63920 . 64340) (
\HDCPYDISPLAYINIT 64342 . 65119) (\HDCPYDSPPRINTCHAR 65121 . 67281) (\SLOWHDCPYBLTCHAR 67283 . 70786)
(\CHANGECHARSET.HDCPYDISPLAY 70788 . 71940)) (72664 102961 (MAKEHARDCOPYMODESTREAM 72674 . 74583) (
UNMAKEHARDCOPYMODESTREAM 74585 . 75663) (\BLTSHADE.HCPYMODE 75665 . 76112) (\BITBLT.HCPYMODE 76114 .
76736) (\BRUSHCONVERT.HCPYMODE 76738 . 76975) (\CHANGECHARSET.HCPYMODE 76977 . 78744) (
\DASHINGCONVERT.HCPYMODE 78746 . 79009) (\CHARWIDTH.HCPYMODE 79011 . 79298) (\DRAWLINE.HCPYMODE 79300
. 79612) (\DRAWCURVE.HCPYMODE 79614 . 80043) (\DRAWCIRCLE.HCPYMODE 80045 . 80440) (
\DRAWELLIPSE.HCPYMODE 80442 . 80954) (\DSPFONT.HCPYMODE 80956 . 82112) (\DSPLEFTMARGIN.HCPYMODE 82114
. 82698) (\DSPLINEFEED.HCPYMODE 82700 . 83110) (\DSPRIGHTMARGIN.HCPYMODE 83112 . 83741) (
\DSPSPACEFACTOR.HCPYMODE 83743 . 84264) (\DSPXPOSITION.HCPYMODE 84266 . 84847) (\DSPYPOSITION.HCPYMODE
84849 . 85254) (\MOVETO.HCPYMODE 85256 . 85408) (\FONTCREATE.HCPYMODE.PRESS 85410 . 86422) (
\CREATECHARSET.HCPYMODE.PRESS 86424 . 87395) (\FONTCREATE.HCPYMODE.INTERPRESS 87397 . 88431) (
\CREATECHARSET.HCPYMODE.INTERPRESS 88433 . 89421) (\STRINGWIDTH.HCPYMODE 89423 . 89857) (
\HCPYMODEBLTCHAR 89859 . 92828) (\HCPYMODEDISPLAYINIT 92830 . 95761) (\HCPYMODEDSPPRINTCHAR 95763 .
97944) (\SLOWHCPYMODEBLTCHAR 97946 . 101460) (\SFFixY.HCPYMODE 101462 . 102959)))))
(FILEMAP (NIL (6184 10368 (HARDCOPY.SOMEHOW 6194 . 7552) (HARDCOPYIMAGEW 7554 . 7706) (
HARDCOPYIMAGEW.TOFILE 7708 . 8016) (HARDCOPYIMAGEW.TOPRINTER 8018 . 8683) (HARDCOPYREGION.TOFILE 8685
. 8983) (HARDCOPYREGION.TOPRINTER 8985 . 9607) (COPY.WINDOW.TO.BITMAP 9609 . 10366)) (10440 20990 (
MakeMenuOfPrinters 10450 . 11675) (PRINTERS.WHENSELECTEDFN 11677 . 13419) (MakeMenuOfImageTypes 13421
. 13939) (GetNewPrinterFromUser 13941 . 14369) (PopUpWindowAndGetAtom 14371 . 15756) (
PopUpWindowAndGetList 15758 . 17324) (NewPrinter 17326 . 18274) (GetPrinterName 18276 . 18556) (
GetImageFile 18558 . 20845) (FetchDefaultPrinter 20847 . 20988)) (21025 21563 (
ExtensionForPrintFileType 21035 . 21228) (PRINTFILETYPE.FROM.EXTENSION 21230 . 21561)) (21618 38002 (
DEFAULTPRINTER 21628 . 21788) (CAN.PRINT.DIRECTLY 21790 . 21946) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
21948 . 22992) (EMPRESS 22994 . 23307) (HARDCOPYW 23309 . 26269) (LISTFILES1 26271 . 26444) (
PRINTER.BITMAPFILE 26446 . 26693) (PRINTER.BITMAPSCALE 26695 . 26960) (PRINTER.SCRATCH.FILE 26962 .
27085) (PRINTERPROP 27087 . 27270) (PRINTERSTATUS 27272 . 27461) (PRINTERTYPE 27463 . 29772) (
PRINTERNAME 29774 . 30076) (PRINTFILEPROP 30078 . 30269) (PRINTFILETYPE 30271 . 32215) (
\EXPECTED.FILE.TYPE 32217 . 32999) (SEND.FILE.TO.PRINTER 33001 . 38000)) (38003 42985 (PRINTERDEVICE
38013 . 42983)) (43800 51762 (TEXTTOIMAGEFILE 43810 . 46000) (COPY.TEXT.TO.IMAGE 46002 . 51760)) (
51763 52898 (\BLTSHADE.GENERICPRINTER 51773 . 52896)) (53026 71778 (MAKEHARDCOPYSTREAM 53036 . 54040)
(UNMAKEHARDCOPYSTREAM 54042 . 54726) (HARDCOPYSTREAMTYPE 54728 . 55007) (\CHARWIDTH.HDCPYDISPLAY 55009
. 55440) (\DSPFONT.HDCPYDISPLAY 55442 . 56847) (\DSPRIGHTMARGIN.HDCPYDISPLAY 56849 . 57426) (
\DSPXPOSITION.HDCPYDISPLAY 57428 . 57689) (\DSPYPOSITION.HDCPYDISPLAY 57691 . 57952) (
\STRINGWIDTH.HDCPYDISPLAY 57954 . 58461) (\STRINGWIDTH.HCPYDISPLAYAUX 58463 . 60795) (\HDCPYBLTCHAR
60797 . 63332) (\HDCPYDISPLAY.FIX.XPOS 63334 . 63754) (\HDCPYDISPLAY.FIX.YPOS 63756 . 64176) (
\HDCPYDISPLAYINIT 64178 . 64955) (\HDCPYDSPPRINTCHAR 64957 . 67117) (\SLOWHDCPYBLTCHAR 67119 . 70622)
(\CHANGECHARSET.HDCPYDISPLAY 70624 . 71776)) (72500 102797 (MAKEHARDCOPYMODESTREAM 72510 . 74419) (
UNMAKEHARDCOPYMODESTREAM 74421 . 75499) (\BLTSHADE.HCPYMODE 75501 . 75948) (\BITBLT.HCPYMODE 75950 .
76572) (\BRUSHCONVERT.HCPYMODE 76574 . 76811) (\CHANGECHARSET.HCPYMODE 76813 . 78580) (
\DASHINGCONVERT.HCPYMODE 78582 . 78845) (\CHARWIDTH.HCPYMODE 78847 . 79134) (\DRAWLINE.HCPYMODE 79136
. 79448) (\DRAWCURVE.HCPYMODE 79450 . 79879) (\DRAWCIRCLE.HCPYMODE 79881 . 80276) (
\DRAWELLIPSE.HCPYMODE 80278 . 80790) (\DSPFONT.HCPYMODE 80792 . 81948) (\DSPLEFTMARGIN.HCPYMODE 81950
. 82534) (\DSPLINEFEED.HCPYMODE 82536 . 82946) (\DSPRIGHTMARGIN.HCPYMODE 82948 . 83577) (
\DSPSPACEFACTOR.HCPYMODE 83579 . 84100) (\DSPXPOSITION.HCPYMODE 84102 . 84683) (\DSPYPOSITION.HCPYMODE
84685 . 85090) (\MOVETO.HCPYMODE 85092 . 85244) (\FONTCREATE.HCPYMODE.PRESS 85246 . 86258) (
\CREATECHARSET.HCPYMODE.PRESS 86260 . 87231) (\FONTCREATE.HCPYMODE.INTERPRESS 87233 . 88267) (
\CREATECHARSET.HCPYMODE.INTERPRESS 88269 . 89257) (\STRINGWIDTH.HCPYMODE 89259 . 89693) (
\HCPYMODEBLTCHAR 89695 . 92664) (\HCPYMODEDISPLAYINIT 92666 . 95597) (\HCPYMODEDSPPRINTCHAR 95599 .
97780) (\SLOWHCPYMODEBLTCHAR 97782 . 101296) (\SFFixY.HCPYMODE 101298 . 102795)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,20 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Apr-2021 14:45:00" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HPRINT.;2 57689
previous date%: " 9-Oct-94 13:07:03"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HPRINT.;1)
(FILECREATED "17-Oct-2021 13:54:11" {DSK}<home>larry>medley>sources>HPRINT.;2 59850
changes to%: (VARS HPRINTCOMS)
(FNS MAKEHVPRETTYCOMS READVARS HPRINT0 READVAR-FROM-STRING READVARS-FROM-STRING
HPRINT-TO-STRING HPRINT-TO-STRINGS HPRINT HPRINT1 HPRINTEND RPTPRINT RPTEND
RPTPUT HPRINTSP HPERR HVFWDCDREAD HVBAKREAD HVREADCHECKGETFN HVREADEND
HVRPTREAD HVFWDREAD HREAD HPINITRDTBL HVREADERR HPRINSP COPYALL
\COPYDATATYPE HCOPYALL HCOPYALL1 EQUALALL EQUALHASH)
(FILEPKGCOMS HORRIBLEVARS UGLYVARS)
previous date%: "28-Sep-2021 10:44:11" {DSK}<home>larry>medley>sources>HPRINT.;1)
(* ; "
Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation.
Copyright (c) 1982-1988, 1990-1991, 1993-1994 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT HPRINTCOMS)
@@ -66,16 +73,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(DEFINEQ
(MAKEHVPRETTYCOMS
[NLAMBDA (VARS NO-CIRCLE-FLAG) (* ; "Edited 9-Sep-87 16:52 by amd")
(* "The old code" (HPINITRDTBL)
 (for X in VARS do (OR
 (LITATOM X) (ERROR X
 "invalid in HORRIBLEVARS" T)))
 (LIST (LIST (QUOTE P)
 (CONS (FUNCTION READVARS) VARS))
 (LIST (QUOTE E) (CONS
 (QUOTE HPRINT0) (if NO-CIRCLE-FLAG
 then (CONS 0 VARS) else VARS)))))
[NLAMBDA (VARS NO-CIRCLE-FLAG) (* ; "Edited 9-Sep-87 16:52 by amd")
(* "The old code" (HPINITRDTBL)
 (for X in VARS do (OR
 (LITATOM X) (ERROR X
 "invalid in HORRIBLEVARS" T)))
 (LIST (LIST (QUOTE P)
 (CONS (FUNCTION READVARS) VARS))
 (LIST (QUOTE E) (CONS
 (QUOTE HPRINT0) (if NO-CIRCLE-FLAG
 then (CONS 0 VARS) else VARS)))))
(HPINITRDTBL)
(for X in VARS do (if (NOT (LITATOM X))
then (ERROR X "not a symbol in HORRIBLEVARS" T)))
@@ -83,7 +90,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
NO-CIRCLE-FLAG])
(READVARS
[NLAMBDA VARS (* lmm%: " 4-JAN-77 23:32:43")
[NLAMBDA VARS (* lmm%: " 4-JAN-77 23:32:43")
(HPINITRDTBL)
(PROG (BACKREFS (BACKREFCNT 0)
DATATYPESEEN)
@@ -97,7 +104,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(HVREADERR])
(HPRINT0
[NLAMBDA VARS (* lmm%: 30-JAN-76 7 36)
[NLAMBDA VARS (* lmm%: 30-JAN-76 7 36)
(HPRINT (for X in (COND
((EQ (CAR VARS)
0)
@@ -131,10 +138,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(DEFINEQ
(READVAR-FROM-STRING
[LAMBDA (SYMBOL HPRINT-STRING) (* ; "Edited 10-Feb-87 16:39 by Pavel")
[LAMBDA (SYMBOL HPRINT-STRING) (* ; "Edited 10-Feb-87 16:39 by Pavel")
(CL:WITH-INPUT-FROM-STRING (STREAM HPRINT-STRING)
(* ;; "")
(* ;; "")
(HPINITRDTBL)
(PROG (BACKREFS (BACKREFCNT 0)
@@ -143,17 +150,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
T])
(READVARS-FROM-STRING
[LAMBDA (SYMBOLS HPRINT-STRING) (* ; "Edited 9-Sep-87 18:22 by amd")
[LAMBDA (SYMBOLS HPRINT-STRING) (* ; "Edited 9-Sep-87 18:22 by amd")
(CL:WITH-INPUT-FROM-STRING (STREAM HPRINT-STRING)
(READVARS-FROM-STREAM SYMBOLS STREAM])
(HPRINT-TO-STRING
[LAMBDA (VALUE NO-CIRCLE-FLAG) (* ; "Edited 9-Sep-87 16:21 by amd")
[LAMBDA (VALUE NO-CIRCLE-FLAG) (* ; "Edited 9-Sep-87 16:21 by amd")
(CL:WITH-OUTPUT-TO-STRING (S)
(HPRINT VALUE S NO-CIRCLE-FLAG])
(HPRINT-TO-STRINGS
[LAMBDA (VALUE NO-CIRCLE-FLAG) (* ; "Edited 5-Feb-88 14:42 by amd")
[LAMBDA (VALUE NO-CIRCLE-FLAG) (* ; "Edited 5-Feb-88 14:42 by amd")
(XCL:WITH-COLLECTION
(XCL:COLLECT (CL:WITH-OUTPUT-TO-STRING
(S)
@@ -181,14 +188,32 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(DEFINEQ
(HPRINT
[LAMBDA (EXPR FILE UNCIRCULAR DATATYPESEEN) (* ; "Edited 10-Feb-87 15:52 by Pavel")
[LAMBDA (EXPR FILE UNCIRCULAR DATATYPESEEN)
(DECLARE (SPECVARS DATATYPESEEN UNCIRCULAR)) (* ;
 "Edited 17-Oct-2021 13:06 by larry")
(* ;
 "Edited 17-Oct-2021 13:02 by larry")
(* ;
 "Edited 17-Oct-2021 12:52 by larry")
(* ;
 "Edited 17-Oct-2021 12:46 by larry")
(* ;
 "Edited 17-Oct-2021 12:42 by larry")
(* ;
 "Edited 17-Oct-2021 12:42 by larry")
(* ;
 "Edited 17-Oct-2021 12:41 by larry")
(* ;
 "Edited 17-Oct-2021 12:39 by larry")
(* ; "Edited 10-Feb-87 15:52 by Pavel")
(RESETLST
(PROG (BACKREFS (CELLCOUNT 0)
SIZE
(U UNCIRCULAR))
(DECLARE (SPECVARS BACKREFS CELLCOUNT U))
(RESETSAVE (RADIX 10))
[COND
(UNCIRCULAR (* ; "Won't need the hash array"))
(UNCIRCULAR (* ; "Won't need the hash array"))
([OR (HARRAYP HPRINTHASHARRAY)
(HARRAYP (CAR (LISTP HPRINTHASHARRAY]
(CLRHASH HPRINTHASHARRAY))
@@ -201,28 +226,29 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
((RANDACCESSP (OUTPUT))
(HPRINT1 EXPR)
(HPRINTEND))
(T (* ;
 "If the byte pointer cannot be reset, want to output to temp file and copy it back")
(LET* ((STREAM (OPENSTREAM "{NoDirCore}" 'OUTPUT))
(*STANDARD-OUTPUT* STREAM))
(CL:UNWIND-PROTECT
(PROGN (HPRINT1 EXPR)
(HPRINTEND)
(CL:CLOSE STREAM)
(OPENSTREAM STREAM 'INPUT)
(COPYBYTES STREAM FILE))
(CL:CLOSE STREAM))]
(T (* ;
 "If the byte pointer cannot be reset, want to output to temp file and copy it back")
(LET [(NDC (OPENSTREAM "{NODIRCORE}" 'BOTH 'NEW
`((FORMAT ,(STREAMPROP *STANDARD-OUTPUT* 'FORMAT]
(CL:UNWIND-PROTECT
[LET ((OS *STANDARD-OUTPUT*)
(*STANDARD-OUTPUT* NDC))
(HPRINT1 EXPR)
(HPRINTEND)
(COPYCHARS NDC OS 0 (PROG1 (GETFILEPTR NDC)
(SETFILEPTR NDC 0]
(CL:CLOSE NDC))]
(TERPRI)))])
(HPRINT1
[LAMBDA (X CDRFLG NOMACROSFLG NOSPFLG) (* ; "Edited 26-Apr-91 13:39 by jds")
[LAMBDA (X CDRFLG NOMACROSFLG NOSPFLG) (* ; "Edited 26-Apr-91 13:39 by jds")
(* ;; "Print the potentially self-referential structure EXPR; if CDRFLG then this is the CDR part of a list")
(* ;; "Print the potentially self-referential structure EXPR; if CDRFLG then this is the CDR part of a list")
(PROG (LASTSEEN HERE TYPE SIZE)
(SELECTQ (SETQ TYPE (TYPENAME X))
((SMALLP LITATOM NEW-ATOM) (* ;
 "Atom, small number, are just directly printed")
((SMALLP LITATOM NEW-ATOM) (* ;
 "Atom, small number, are just directly printed")
[RETURN (COND
[CDRFLG (COND
(X (PRIN1 " . ")
@@ -234,7 +260,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
[(SETQ LASTSEEN (AND (NOT U)
(GETHASH X HPRINTHASHARRAY)))
(* ;; "Seen before --- Hash value is either byte position of first place seen (negative if CDR pointer) or (bytepos-of-expression . byte-positions-of-backrefs)")
(* ;; "Seen before --- Hash value is either byte position of first place seen (negative if CDR pointer) or (bytepos-of-expression . byte-positions-of-backrefs)")
(AND CDRFLG (PRIN1 " . "))
(PRIN1 (CONSTANT HPFILLSTRING))
@@ -242,17 +268,17 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
[PROG ((CN CELLCOUNT))
(while (IGREATERP CN 0) do (PRIN3 (FCHARACTER (CONSTANT HPFILLCHAR)))
(* ;; "HPFILLCHAR is 0; there is still a problem in the system of dumping and reading back in (CHARACTER 0)")
(* ;; "HPFILLCHAR is 0; there is still a problem in the system of dumping and reading back in (CHARACTER 0)")
(SETQ CN (IQUOTIENT CN 10]
(COND
((NLISTP LASTSEEN) (* ; "Seen only once before")
((NLISTP LASTSEEN) (* ; "Seen only once before")
(PUTHASH X (CAR (SETQ BACKREFS (CONS (LIST LASTSEEN HERE)
BACKREFS)))
HPRINTHASHARRAY)
NIL)
(T (* ;
 "Seen at least once before --- Add this place to the list")
(T (* ;
 "Seen at least once before --- Add this place to the list")
(FRPLACD LASTSEEN (CONS HERE (CDR LASTSEEN]
(T
(AND CDRFLG (NLISTP X)
@@ -267,8 +293,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
HPRINTHASHARRAY)
(SETN CELLCOUNT (ADD1 CELLCOUNT)))
((NOT NOSPFLG)
(SPACES 1))) (* ;
 "Now, finally get around to printing the thing --- leave space for macro char")
(SPACES 1))) (* ;
 "Now, finally get around to printing the thing --- leave space for macro char")
(COND
[(LISTP X)
(COND
@@ -291,8 +317,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(HPRINTENDSTR]
(T
(SELECTQ TYPE
((STRINGP FLOATP FIXP) (* ;
 "string, floating point or number")
((STRINGP FLOATP FIXP) (* ;
 "string, floating point or number")
(PRIN2 X))
(ARRAYP (PROG ((SIZE (ARRAYSIZE X))
(RPTCNT 0)
@@ -322,7 +348,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
[PRIN2 (LIST SIZ (HARRAYPROP X 'OVERFLOW]
(SPACES 1)
(SELECTQ (SYSTEMTYPE)
((TENEX TOPS20) (* ; "bug in Interlisp-10 MAPHASH")
((TENEX TOPS20) (* ; "bug in Interlisp-10 MAPHASH")
[COND
((ILESSP (GCTRP)
SIZ)
@@ -339,8 +365,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(HPRINTSP (CAR VALS))
(SETQ VALS (CDR VALS)))
(HPRINTENDSTR)))
(READTABLEP (* ;
 "should dump the READMACROS flag too --- doesn't now and won't until READMACROS takes a RDTBL arg")
(READTABLEP (* ;
 "should dump the READMACROS flag too --- doesn't now and won't until READMACROS takes a RDTBL arg")
(PROG ((RPTCNT 0)
(RPTLAST (CONS)))
(HPRINTSTRING D)
@@ -384,7 +410,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(SETQ TYPE (DELETECONTROL PR NIL X]
(HPRINSP PR)
(HPRINSP TYPE]
(PRIN2) (* ; "end with a NIL")
(PRIN2) (* ; "end with a NIL")
(HPRINTENDSTR))
(VAG (HPRINTSTRING %#)
(PRIN2 (LOC X))
@@ -415,7 +441,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(T (HPERR "cannot print this item" X])
(HPRINTEND
[LAMBDA NIL (* lmm%: "29-NOV-76 16:11:02")
[LAMBDA NIL (* lmm%: "29-NOV-76 16:11:02")
(PROG [(HERE (GETFILEPTR (OUTPUT]
[SORT BACKREFS (FUNCTION (LAMBDA (X Y)
(ILESSP (ABS (CAR X))
@@ -445,12 +471,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(SETQ RPTCNT 1])
(RPTEND
[LAMBDA NIL (* lmm%: "29-NOV-76 16:11:40")
[LAMBDA NIL (* lmm%: "29-NOV-76 16:11:40")
(RPTPUT RPTCNT RPTLAST)
(HPRINTENDSTR])
(RPTPUT
[LAMBDA (CNT ITEM FLAG) (* lmm "11-SEP-78 03:22")
[LAMBDA (CNT ITEM FLAG) (* lmm "11-SEP-78 03:22")
(COND
[(AND (ILESSP CNT 4)
(OR FLAG (LITATOM ITEM)
@@ -481,8 +507,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(HVFWDCDREAD
[LAMBDA (FILE RDTBL TCONCPTR)
(* Do setq so that if the READ adds things to the BACKREF list, it will still
 be correct)
(* Do setq so that if the READ adds things to the BACKREF list, it will still
 be correct)
(TCONC TCONCPTR NIL)
(SETQ BACKREFCNT (ADD1 BACKREFCNT))
@@ -493,20 +519,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
TCONCPTR])
(HVBAKREAD
[LAMBDA (FILE RDTBL BKRF) (* rrb "18-Mar-86 15:40")
[LAMBDA (FILE RDTBL BKRF) (* rrb "18-Mar-86 15:40")
(PROG (HV HV1 HV2 HV3 (RPTCNT 0)
RPTVAL READVAL)
READLP
(SKIPSEPRS FILE RDTBL)
(SELECTQ (SETQ HV (READC FILE))
(} (* ;
 "Empty printout from false start for HPRINTMACRO. Next char should be { and be default")
(} (* ;
 "Empty printout from false start for HPRINTMACRO. Next char should be { and be default")
(SKIPSEPRS FILE RDTBL)
(COND
((EQ '{ (READC FILE))
(GO READLP))
(T (HVREADERR))))
(H (* ; "Hash array")
(H (* ; "Hash array")
[SETQ READVAL (COND
((EQ (SKIPSEPRS FILE RDTBL)
'%()
@@ -519,7 +545,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(PUTHASH (READ FILE RDTBL)
HV READVAL)))
(HVREADEND FILE RDTBL))
((A Y) (* ; "array")
((A Y) (* ; "array")
[SETQ READVAL (ARRAY (SETQ HV1 (READ FILE RDTBL))
(SETQ HV2 (READ FILE RDTBL))
NIL
@@ -537,11 +563,11 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(for I from (ADD1 HV2) to HV1
do (SETD READVAL I (HVRPTREAD FILE RDTBL]
(HVREADEND FILE RDTBL))
(($ ~) (* ; "DATATYPE")
(($ ~) (* ; "DATATYPE")
(SETQ HV1 (RATOM FILE RDTBL))
[COND
((EQ HV '~) (* ;
 "This should be a previously known datatype not specified in file")
((EQ HV '~) (* ;
 "This should be a previously known datatype not specified in file")
(SETQ HV2 (GETDESCRIPTORS HV1)))
([NOT (SETQ HV2 (CDR (FASSOC HV1 DATATYPESEEN]
(SETQ HV2 (READ FILE RDTBL))
@@ -556,21 +582,21 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(AND BKRF (FRPLACA BKRF READVAL))
(for X in HV2 do (REPLACEFIELD X READVAL (HVRPTREAD FILE RDTBL)))
(HVREADEND FILE RDTBL))
(R (* ; "repeat")
(R (* ; "repeat")
(AND BKRF (HVREADERR))
(RETURN HPRPTSTRING))
(%# (* ; "Kludge for (VAG smallnumber)")
(%# (* ; "Kludge for (VAG smallnumber)")
(RETURN (PROG1 (VAG (RATOM FILE RDTBL))
(HVREADEND FILE RDTBL))))
(! (* ; "! --- value cell")
(! (* ; "! --- value cell")
(RETURN (AT2VC (RATOM FILE RDTBL))))
(D (* ; "READTABLEP")
(D (* ; "READTABLEP")
(SETQ READVAL (COPYREADTABLE 'ORIG))
(AND BKRF (FRPLACA BKRF READVAL))
(for I in (READ FILE RDTBL) do (SETSYNTAX I (HVRPTREAD FILE RDTBL)
READVAL))
(HVREADEND FILE RDTBL))
(T (* ; "TERMTABLEP")
(T (* ; "TERMTABLEP")
(SETQ READVAL (COPYTERMTABLE 'ORIG))
(AND BKRF (FRPLACA BKRF READVAL))
(while (SETQ HV (RATOM FILE RDTBL))
@@ -592,10 +618,10 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(NOECHO (DELETECONTROL 'NOECHO NIL READVAL))
(HVREADERR)))
(HVREADEND FILE RDTBL))
((0 1 2 3 4 5 6 7 8 9) (* ;
 "immediately followed by a number")
(AND BKRF (HVREADERR)) (* ;
 "BACK REFERENCE --- shouldn't be forward reference as well")
((0 1 2 3 4 5 6 7 8 9) (* ;
 "immediately followed by a number")
(AND BKRF (HVREADERR)) (* ;
 "BACK REFERENCE --- shouldn't be forward reference as well")
(SETQ HV2 HV)
(while (SMALLP (SETQ HV (READC FILE))) do (SETQ HV2
(IPLUS (ITIMES HV2 10)
@@ -603,20 +629,20 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(RETURN (OR [CAR (FNTH BACKREFS (ADD1 (IDIFFERENCE BACKREFCNT HV2]
(HVREADERR))))
(%(
(* ;; "form that should be evaluated with its first argument replaced with the file being read. This is the case that handle IMAGEOBJs.")
(* ;; "form that should be evaluated with its first argument replaced with the file being read. This is the case that handle IMAGEOBJs.")
(SETQ READVAL
(PROG1 [APPLY (HVREADCHECKGETFN (READ FILE RDTBL))
(CONS FILE (PROGN
(* ;; "dump the first argument which is a dummy so that the call that is on the file looks like a realy call.")
(* ;; "dump the first argument which is a dummy so that the call that is on the file looks like a realy call.")
(CDR (until (PROGN (SKIPSEPRS FILE RDTBL)
(EQ (PEEKC FILE)
'%)))
collect (EVAL (READ FILE RDTBL))
finally
(* ; "read the closing (QUOTE ))")
(* ; "read the closing (QUOTE ))")
(RATOM FILE RDTBL]
(HVREADEND FILE RDTBL)))
(AND BKRF (FRPLACA BKRF READVAL))
@@ -627,26 +653,26 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(RETURN READVAL])
(HVREADCHECKGETFN
[LAMBDA (FN) (* ; "Edited 27-Jan-87 19:41 by rrb")
[LAMBDA (FN) (* ; "Edited 27-Jan-87 19:41 by rrb")
(* ;;
 "if in the context of reading an image object, make sure the get function is a known one.")
(* ;;
 "if in the context of reading an image object, make sure the get function is a known one.")
(COND
((EQ FN 'READIMAGEOBJ) (* ; "common case")
((EQ FN 'READIMAGEOBJ) (* ; "common case")
FN)
[(AND (BOUNDP UNDERREADIMAGEOBJ)
(EQ UNDERREADIMAGEOBJ T)) (* ;
 "This is an HREAD that came from an Image object and hence needs to be safe.")
(EQ UNDERREADIMAGEOBJ T)) (* ;
 "This is an HREAD that came from an Image object and hence needs to be safe.")
(PROG NIL
LP (COND
((OR (MEMB FN HPRINTREADFNS)
(ASSOC FN IMAGEOBJGETFNS))
(RETURN FN))
((NOT (GETD FN)) (* ;
 "headed for an undefined function error anyway")
(\LISPERROR FN 46 T) (* ;
 "user may have loaded a package during the break.")
((NOT (GETD FN)) (* ;
 "headed for an undefined function error anyway")
(\LISPERROR FN 46 T) (* ;
 "user may have loaded a package during the break.")
(GO LP))
((MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " FN ". " FN
" is NOT registered. Should I use it anyway?")
@@ -656,13 +682,13 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(T FN])
(HVREADEND
[LAMBDA (FILE RDTBL) (* lmm "21-APR-82 11:25")
[LAMBDA (FILE RDTBL) (* lmm "21-APR-82 11:25")
(bind CHAR until (EQ (SETQ CHAR (CHCON1 (READC FILE)))
(CONSTANT HPFINALCHAR)) do (OR (SYNTAXP CHAR 'SEPR RDTBL)
(HVREADERR])
(HVRPTREAD
[LAMBDA (FILE RDTBL) (* lmm " 2-APR-82 23:26")
[LAMBDA (FILE RDTBL) (* lmm " 2-APR-82 23:26")
(PROG NIL
LOOP
(COND
@@ -678,7 +704,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(T (RETURN RPTVAL])
(HVFWDREAD
[LAMBDA (FILE RDTBL) (* lmm%: "29-NOV-76 15:56:19")
[LAMBDA (FILE RDTBL) (* lmm%: "29-NOV-76 15:56:19")
(PROG (CH VAL)
(SETQ BACKREFCNT (ADD1 BACKREFCNT))
(SETQ BACKREFS (CONS NIL BACKREFS))
@@ -700,7 +726,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(T (RETURN (CAR (FRPLACA BACKREFS (READ FILE RDTBL])
(HREAD
[LAMBDA (FILE) (* lmm%: 19 MAY 75 315)
[LAMBDA (FILE) (* lmm%: 19 MAY 75 315)
(PROG [BACKREFS (BACKREFCNT 0)
DATATYPESEEN
(FILE (INPUT (INPUT FILE]
@@ -709,7 +735,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(RETURN (READ FILE HPRINTRDTBL])
(HPINITRDTBL
[LAMBDA NIL (* lmm " 5-JAN-78 23:23")
[LAMBDA NIL (* lmm " 5-JAN-78 23:23")
(COND
([NOT (READTABLEP (GETATOMVAL 'HPRINTRDTBL]
(PROG [(RDTBL (COPYREADTABLE 'ORIG]
@@ -735,14 +761,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(OR M2 '(in HREAD])
(HPRINSP
[LAMBDA (X) (* lmm%: "29-NOV-76 17:41:47")
[LAMBDA (X) (* lmm%: "29-NOV-76 17:41:47")
(PRIN2 X)
(SPACES 1])
)
(DEFINEQ
(COPYALL
[LAMBDA (X) (* ; "Edited 9-Oct-94 13:06 by jds")
[LAMBDA (X) (* ; "Edited 9-Oct-94 13:06 by jds")
(COND
((LISTP X)
(PROG [TAIL (VAL (LIST (COPYALL (CAR X]
@@ -767,7 +793,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(STRINGP (CONCAT X))
(FLOATP (FPLUS X))
(FIXP (IPLUS X))
(HARRAYP (* ; "Hash array")
(HARRAYP (* ; "Hash array")
(PROG [(NH (HASHARRAY (HARRAYSIZE X)
(HARRAYPROP X 'OVERFLOW]
(DECLARE (SPECVARS NH))
@@ -788,7 +814,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(add ORIG 1)))])
(BITMAP (BITMAPCOPY X))
(CURSOR
(* ;; "For cursors, must preserve EQ-ness of MASK & IMAGE, to avoid trouble with SOFTCURSOR code being missing.(COPY")
(* ;; "For cursors, must preserve EQ-ness of MASK & IMAGE, to avoid trouble with SOFTCURSOR code being missing.(COPY")
(LET* [(IM (BITMAPCOPY (FETCH (CURSOR CUIMAGE) OF X)))
(NEW (CURSORCREATE IM [COND
@@ -810,7 +836,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(\COPYDATATYPE X])
(\COPYDATATYPE
[LAMBDA (X) (* lmm "21-Apr-85 15:29")
[LAMBDA (X) (* lmm "21-Apr-85 15:29")
(LET* ((NTYP (NTYPX X))
(DTD (\GETDTD NTYP))
(PTRS (fetch DTDPTRS of DTD))
@@ -824,7 +850,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
else (\BLT NEW X (fetch DTDSIZE of DTD))))])
(HCOPYALL
[LAMBDA (X) (* rmk%: " 3-Jan-84 13:16")
[LAMBDA (X) (* rmk%: " 3-Jan-84 13:16")
[COND
([OR (HARRAYP HPRINTHASHARRAY)
(HARRAYP (CAR (LISTP HPRINTHASHARRAY]
@@ -833,7 +859,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(HCOPYALL1 X])
(HCOPYALL1
[LAMBDA (X) (* bvm%: " 7-Feb-85 21:25")
[LAMBDA (X) (* bvm%: " 7-Feb-85 21:25")
(COND
((OR (LITATOM X)
(SMALLP X))
@@ -859,7 +885,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(ARRAYP (PROG ((SIZE (ARRAYSIZE X))
(TYP (ARRAYTYP X))
(ORIG (ARRAYORIG X)))
(* ; "Regular array")
(* ; "Regular array")
(PUTHASH X (SETQ NEW (ARRAY SIZE TYP NIL ORIG))
HPRINTHASHARRAY)
(FRPTQ SIZE (SETA NEW ORIG
@@ -895,13 +921,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(DEFINEQ
(EQUALALL
[LAMBDA (X Y) (* ; "Edited 26-Apr-2021 14:34 by rmk:")
[LAMBDA (X Y) (* ;
 "Edited 26-Apr-2021 14:34 by rmk:")
(OR (EQ X Y)
(PROG ((TY (TYPENAME Y))
TEM)
(RETURN (AND (EQ TY (TYPENAME X))
(SELECTQ TY
((LITATOM NEW-ATOM SMALLP) (* ; "not eq, so not equal")
((LITATOM NEW-ATOM SMALLP) (* ; "not eq, so not equal")
NIL)
(FIXP (IEQP X Y))
(FLOATP (EQP X Y))
@@ -920,7 +947,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
always (EQUALALL (ELT X I)
(ELT Y I])
((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY)
(* ; "RMK: Added CL arrays")
(* ; "RMK: Added CL arrays")
[AND (EQUAL (CL:ARRAY-DIMENSIONS X)
(CL:ARRAY-DIMENSIONS Y))
(EQUAL (CL:ARRAY-ELEMENT-TYPE X)
@@ -973,9 +1000,9 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(EQUALHASH
[LAMBDA (AR1 AR2)
(DECLARE (SPECVARS AR1 AR2)) (* rmk%: "26-Dec-83 13:33")
(* ;
 "What does it mean for two hash arrays to be EQUAL?")
(DECLARE (SPECVARS AR1 AR2)) (* rmk%: "26-Dec-83 13:33")
(* ;
 "What does it mean for two hash arrays to be EQUAL?")
[PROG (UNMATCHED)
(OR (EQUAL (HARRAYPROP AR1 'OVERFLOW)
(HARRAYPROP AR2 'OVERFLOW))
@@ -1109,16 +1136,16 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2021 by Venue & Xerox Corporation
(ADDTOVAR LAMA )
)
(PUTPROPS HPRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1993 1994 2021))
1993 1994))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3661 6199 (MAKEHVPRETTYCOMS 3671 . 4958) (READVARS 4960 . 5526) (HPRINT0 5528 . 6197))
(6201 6534 (READVARS-FROM-STRINGS 6201 . 6534)) (6536 6923 (READVARS-FROM-STREAM 6536 . 6923)) (6924
8852 (READVAR-FROM-STRING 6934 . 7340) (READVARS-FROM-STRING 7342 . 7578) (HPRINT-TO-STRING 7580 .
7786) (HPRINT-TO-STRINGS 7788 . 8850)) (9663 37895 (HPRINT 9673 . 11303) (HPRINT1 11305 . 22807) (
HPRINTEND 22809 . 23845) (RPTPRINT 23847 . 24085) (RPTEND 24087 . 24246) (RPTPUT 24248 . 24746) (
HPRINTSP 24748 . 24812) (HPERR 24814 . 24911) (HVFWDCDREAD 24913 . 25292) (HVBAKREAD 25294 . 33339) (
HVREADCHECKGETFN 33341 . 34740) (HVREADEND 34742 . 35094) (HVRPTREAD 35096 . 35622) (HVFWDREAD 35624
. 36478) (HREAD 36480 . 36802) (HPINITRDTBL 36804 . 37638) (HVREADERR 37640 . 37753) (HPRINSP 37755
. 37893)) (37896 46778 (COPYALL 37906 . 41809) (\COPYDATATYPE 41811 . 42500) (HCOPYALL 42502 . 42812)
(HCOPYALL1 42814 . 46776)) (46779 54061 (EQUALALL 46789 . 52382) (EQUALHASH 52384 . 54059)))))
(FILEMAP (NIL (4174 6712 (MAKEHVPRETTYCOMS 4184 . 5471) (READVARS 5473 . 6039) (HPRINT0 6041 . 6710))
(6714 7047 (READVARS-FROM-STRINGS 6714 . 7047)) (7049 7436 (READVARS-FROM-STREAM 7049 . 7436)) (7437
9365 (READVAR-FROM-STRING 7447 . 7853) (READVARS-FROM-STRING 7855 . 8091) (HPRINT-TO-STRING 8093 .
8299) (HPRINT-TO-STRINGS 8301 . 9363)) (10176 39996 (HPRINT 10186 . 13404) (HPRINT1 13406 . 24908) (
HPRINTEND 24910 . 25946) (RPTPRINT 25948 . 26186) (RPTEND 26188 . 26347) (RPTPUT 26349 . 26847) (
HPRINTSP 26849 . 26913) (HPERR 26915 . 27012) (HVFWDCDREAD 27014 . 27393) (HVBAKREAD 27395 . 35440) (
HVREADCHECKGETFN 35442 . 36841) (HVREADEND 36843 . 37195) (HVRPTREAD 37197 . 37723) (HVFWDREAD 37725
. 38579) (HREAD 38581 . 38903) (HPINITRDTBL 38905 . 39739) (HVREADERR 39741 . 39854) (HPRINSP 39856
. 39994)) (39997 48879 (COPYALL 40007 . 43910) (\COPYDATATYPE 43912 . 44601) (HCOPYALL 44603 . 44913)
(HCOPYALL1 44915 . 48877)) (48880 56227 (EQUALALL 48890 . 54548) (EQUALHASH 54550 . 56225)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 2-Aug-2021 19:41:35" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;4 79616
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Sep-2021 20:58:07" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;4 79783
changes to%: (FNS \DISPLAYINIT)
changes to%: (VARS IMAGEIOCOMS)
(FNS \DISPLAYINIT \4DISPLAYINIT \8DISPLAYINIT \24DISPLAYINIT)
previous date%: "28-Jun-99 16:33:59"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;1)
previous date%: " 2-Aug-2021 19:41:35"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>IMAGEIO.;2)
(* ; "
@@ -27,7 +28,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
(FNS \DRAWPOINT.GENERIC \DRAWPOLYGON.GENERIC \DRAWCIRCLE.GENERIC \DRAWELLIPSE.GENERIC)
(FNS \IMAGEIOINIT \NOIMAGE.DSPFONT \UNIMPIMAGEOP)
[COMS
(* ;; "stuff to support the checking and defaulting of arguments in the device independent drawing functions.")
(* ;; "stuff to support the checking and defaulting of arguments in the device independent drawing functions.")
(FNS INSURE.BRUSH BRUSHP \POSSIBLECOLOR NEGSHADE)
(DECLARE%: DONTCOPY EVAL@COMPILE (RESOURCES SYSTEMBRUSH))
@@ -42,7 +43,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
(SYSRECORDS IMAGEOPS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\IMAGEIOINIT)))
[COMS
(* ;; "Implementation of display stream resident `files.' Done here cause it might matter that the display device get defined early so that its event fn will be evaluated as the last thing before logout")
(* ;; "Implementation of display stream resident `files.' Done here cause it might matter that the display device get defined early so that its event fn will be evaluated as the last thing before logout")
(INITVARS (\COLORDISPLAYSTREAMTYPES '(4DISPLAY 8DISPLAY 24DISPLAY))
(\DISPLAYSTREAMTYPES (CONS 'DISPLAY \COLORDISPLAYSTREAMTYPES)))
@@ -1170,11 +1171,11 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
NIL])
(\DISPLAYINIT
[LAMBDA NIL (* ; "Edited 2-Aug-2021 19:41 by rmk:")
[LAMBDA NIL (* ; "Edited 25-Sep-2021 20:57 by rmk:")
(* ;; "Initializes global variables for the Display device")
(* ;; "Initializes global variables for the Display device")
(* ;; "Display Streams are referred to only by themselves so they do not need directory operations. Most of the fields in the DisplayDevice are empty to avoid something bad happening.")
(* ;; "Display Streams are referred to only by themselves so they do not need directory operations. Most of the fields in the DisplayDevice are empty to avoid something bad happening.")
(DECLARE (GLOBALVARS DisplayFDEV \DISPLAYIMAGEOPS \DisplayDeviceMethods \DisplayDeviceData))
(SETQ \DisplayDeviceMethods (create WSOPS))
@@ -1186,6 +1187,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
BOTTOM _ 0
WIDTH _ 1024
HEIGHT _ 808)))
(MAKE-EXTERNALFORMAT :DISPLAY NIL NIL NIL (FUNCTION \DSPPRINTCHAR)
NIL CR.EOLC)
(SETQ \DISPLAYIMAGEOPS (create IMAGEOPS
IMAGETYPE _ 'DISPLAY
IMFONT _ (FUNCTION \DSPFONT.DISPLAY)
@@ -1252,13 +1255,11 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
WINDOWOPS _ \DisplayDeviceMethods
WINDOWDATA _ \DisplayDeviceData
DEVICEINFO _ (create DISPLAYSTATE)
DEFAULTEXTERNALFORMAT _ (MAKE-EXTERNALFORMAT :DISPLAY NIL NIL NIL
(FUNCTION \DSPPRINTCHAR)
NIL CR.EOLC)))
DEFAULTEXTERNALFORMAT _ :DISPLAY))
(\DEFINEDEVICE 'LFDISPLAY DisplayFDEV])
(\4DISPLAYINIT
[LAMBDA NIL (* ; "Edited 22-Apr-94 15:17 by sybalsky")
[LAMBDA NIL (* ; "Edited 25-Sep-2021 18:42 by rmk:")
(DECLARE (GLOBALVARS \4DISPLAYIMAGEOPS \4DISPLAYFDEV))
(SETQ \4DISPLAYIMAGEOPS (create IMAGEOPS
IMAGETYPE _ '4DISPLAY
@@ -1322,11 +1323,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
BLOCKIN _ (FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
DEVICEINFO _ (create DISPLAYSTATE)
WINDOWOPS _ NIL))
WINDOWOPS _ NIL
DEFAULTEXTERNALFORMAT _ :DISPLAY))
(\DEFINEDEVICE NIL \4DISPLAYFDEV])
(\8DISPLAYINIT
[LAMBDA NIL (* ; "Edited 22-Apr-94 15:18 by sybalsky")
[LAMBDA NIL (* ; "Edited 25-Sep-2021 18:43 by rmk:")
(DECLARE (GLOBALVARS \8DISPLAYIMAGEOPS \8DISPLAYFDEV))
(SETQ \8DISPLAYIMAGEOPS (create IMAGEOPS
IMAGETYPE _ '8DISPLAY
@@ -1390,11 +1392,12 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
BLOCKIN _ (FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
DEVICEINFO _ (create DISPLAYSTATE)
WINDOWOPS _ NIL))
WINDOWOPS _ NIL
DEFAULTEXTERNALFORMAT _ :DISPLAY))
(\DEFINEDEVICE NIL \8DISPLAYFDEV])
(\24DISPLAYINIT
[LAMBDA NIL (* ; "Edited 22-Apr-94 15:18 by sybalsky")
[LAMBDA NIL (* ; "Edited 25-Sep-2021 18:44 by rmk:")
(DECLARE (GLOBALVARS \24DISPLAYIMAGEOPS \24DISPLAYFDEV))
(SETQ \24DISPLAYIMAGEOPS (create IMAGEOPS
IMAGETYPE _ '24DISPLAY
@@ -1458,7 +1461,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
BLOCKIN _ (FUNCTION \ILLEGAL.DEVICEOP)
BLOCKOUT _ (FUNCTION \NONPAGEDBOUTS)
DEVICEINFO _ (create DISPLAYSTATE)
WINDOWOPS _ NIL))
WINDOWOPS _ NIL
DEFAULTEXTERNALFORMAT _ :DISPLAY))
(\DEFINEDEVICE NIL \24DISPLAYFDEV])
(\DISPLAYSTREAMTYPEBPP
@@ -1509,24 +1513,24 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation.
(PUTPROPS IMAGEIO COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
1993 1994 1999 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3353 12110 (IMAGESTREAMP 3363 . 4195) (IMAGESTREAMTYPE 4197 . 4410) (IMAGESTREAMTYPEP
4412 . 5047) (OPENIMAGESTREAM 5049 . 10003) (\GOOD.DASHLST 10005 . 12108)) (12145 14442 (
DRAWDASHEDLINE 12155 . 14440)) (14443 21783 (DSPBACKCOLOR 14453 . 14825) (DSPBOTTOMMARGIN 14827 .
15212) (DSPCOLOR 15214 . 15578) (DSPCLIPPINGREGION 15580 . 16285) (DSPRESET 16287 . 16567) (DSPFONT
16569 . 16933) (DSPLEFTMARGIN 16935 . 17316) (DSPLINEFEED 17318 . 17618) (DSPOPERATION 17620 . 17997)
(DSPRIGHTMARGIN 17999 . 18382) (DSPTOPMARGIN 18384 . 18763) (DSPSCALE 18765 . 19132) (DSPSPACEFACTOR
19134 . 19527) (DSPXPOSITION 19529 . 19834) (DSPYPOSITION 19836 . 20141) (DSPROTATE 20143 . 20438) (
DSPPUSHSTATE 20440 . 20686) (DSPPOPSTATE 20688 . 20931) (DSPDEFAULTSTATE 20933 . 21185) (DSPSCALE2
21187 . 21478) (DSPTRANSLATE 21480 . 21781)) (21784 30585 (DSPNEWPAGE 21794 . 22486) (DRAWBETWEEN
22488 . 23190) (DRAWCIRCLE 23192 . 23688) (DRAWARC 23690 . 24207) (DRAWCURVE 24209 . 24886) (
DRAWELLIPSE 24888 . 25674) (DRAWLINE 25676 . 26066) (DRAWPOLYGON 26068 . 26523) (DRAWPOINT 26525 .
26944) (FILLPOLYGON 26946 . 27512) (DRAWTO 27514 . 27932) (FILLCIRCLE 27934 . 28157) (MOVETO 28159 .
28523) (RELDRAWTO 28525 . 29442) (BITMAPIMAGESIZE 29444 . 29615) (SCALEDBITBLT 29617 . 30583)) (30586
37625 (\DRAWPOINT.GENERIC 30596 . 30943) (\DRAWPOLYGON.GENERIC 30945 . 33253) (\DRAWCIRCLE.GENERIC
33255 . 34913) (\DRAWELLIPSE.GENERIC 34915 . 37623)) (37626 43012 (\IMAGEIOINIT 37636 . 41769) (
\NOIMAGE.DSPFONT 41771 . 42846) (\UNIMPIMAGEOP 42848 . 43010)) (43135 46259 (INSURE.BRUSH 43145 .
44519) (BRUSHP 44521 . 45311) (\POSSIBLECOLOR 45313 . 45864) (NEGSHADE 45866 . 46257)) (46815 47499 (
DASHINGP 46825 . 47155) (INSURE.DASHING 47157 . 47497)) (57980 78429 (\DisplayEventFn 57990 . 58500) (
\DISPLAYINIT 58502 . 64181) (\4DISPLAYINIT 64183 . 68820) (\8DISPLAYINIT 68822 . 73461) (
\24DISPLAYINIT 73463 . 78170) (\DISPLAYSTREAMTYPEBPP 78172 . 78427)))))
(FILEMAP (NIL (3423 12180 (IMAGESTREAMP 3433 . 4265) (IMAGESTREAMTYPE 4267 . 4480) (IMAGESTREAMTYPEP
4482 . 5117) (OPENIMAGESTREAM 5119 . 10073) (\GOOD.DASHLST 10075 . 12178)) (12215 14512 (
DRAWDASHEDLINE 12225 . 14510)) (14513 21853 (DSPBACKCOLOR 14523 . 14895) (DSPBOTTOMMARGIN 14897 .
15282) (DSPCOLOR 15284 . 15648) (DSPCLIPPINGREGION 15650 . 16355) (DSPRESET 16357 . 16637) (DSPFONT
16639 . 17003) (DSPLEFTMARGIN 17005 . 17386) (DSPLINEFEED 17388 . 17688) (DSPOPERATION 17690 . 18067)
(DSPRIGHTMARGIN 18069 . 18452) (DSPTOPMARGIN 18454 . 18833) (DSPSCALE 18835 . 19202) (DSPSPACEFACTOR
19204 . 19597) (DSPXPOSITION 19599 . 19904) (DSPYPOSITION 19906 . 20211) (DSPROTATE 20213 . 20508) (
DSPPUSHSTATE 20510 . 20756) (DSPPOPSTATE 20758 . 21001) (DSPDEFAULTSTATE 21003 . 21255) (DSPSCALE2
21257 . 21548) (DSPTRANSLATE 21550 . 21851)) (21854 30655 (DSPNEWPAGE 21864 . 22556) (DRAWBETWEEN
22558 . 23260) (DRAWCIRCLE 23262 . 23758) (DRAWARC 23760 . 24277) (DRAWCURVE 24279 . 24956) (
DRAWELLIPSE 24958 . 25744) (DRAWLINE 25746 . 26136) (DRAWPOLYGON 26138 . 26593) (DRAWPOINT 26595 .
27014) (FILLPOLYGON 27016 . 27582) (DRAWTO 27584 . 28002) (FILLCIRCLE 28004 . 28227) (MOVETO 28229 .
28593) (RELDRAWTO 28595 . 29512) (BITMAPIMAGESIZE 29514 . 29685) (SCALEDBITBLT 29687 . 30653)) (30656
37695 (\DRAWPOINT.GENERIC 30666 . 31013) (\DRAWPOLYGON.GENERIC 31015 . 33323) (\DRAWCIRCLE.GENERIC
33325 . 34983) (\DRAWELLIPSE.GENERIC 34985 . 37693)) (37696 43082 (\IMAGEIOINIT 37706 . 41839) (
\NOIMAGE.DSPFONT 41841 . 42916) (\UNIMPIMAGEOP 42918 . 43080)) (43205 46329 (INSURE.BRUSH 43215 .
44589) (BRUSHP 44591 . 45381) (\POSSIBLECOLOR 45383 . 45934) (NEGSHADE 45936 . 46327)) (46885 47569 (
DASHINGP 46895 . 47225) (INSURE.DASHING 47227 . 47567)) (58050 78596 (\DisplayEventFn 58060 . 58570) (
\DISPLAYINIT 58572 . 64155) (\4DISPLAYINIT 64157 . 68858) (\8DISPLAYINIT 68860 . 73563) (
\24DISPLAYINIT 73565 . 78337) (\DISPLAYSTREAMTYPEBPP 78339 . 78594)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "10-Jul-2021 20:31:23" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;10 119111
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS RDTBL\NONOTHERCODES)
(FILECREATED "11-Oct-2021 14:04:22" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;11 119118
previous date%: "10-Jul-2021 20:20:35"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;9)
changes to%: (FNS \TEDIT.INSPECTCODE)
previous date%: "10-Jul-2021 20:31:23"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INSPECT.;10)
(* ; "
@@ -16,7 +17,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
(RPAQQ INSPECTCOMS
[(COMS
(* ;; "functions to implement an item window. An ITEM window is a window that contains SELECTABLEITEMS. An item from the window is selected using the left button. The middle button will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum. It is used by the inspector.")
(* ;; "functions to implement an item window. An ITEM window is a window that contains SELECTABLEITEMS. An item from the window is selected using the left button. The middle button will then bring up a menu of commands that can be applyed to the selected item. An INSPECTW is a special type of ITEMW that maintains properties and their values for a datum. It is used by the inspector.")
(FNS INSPECTW.CREATE INSPECTW.REPAINTFN INSPECTW.REDISPLAY \INSPECTW.VALUE.MARGIN
INSPECTW.REPLACE INSPECTW.SELECTITEM \INSPECTW.REDISPLAYPROP INSPECTW.FETCH
@@ -33,7 +34,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
(MAXINSPECTCDRLEVEL 50)
MinSpaceBetweenProperyAndValue MaxInspectorPropertyValueWidth MaxValueLeftMargin
PropertyLeftMargin))
(COMS (* ; "functions for the inspector")
(COMS (* ; "functions for the inspector")
(FNS INSPECT \APPLYINSPECTMACRO INSPECT/BITMAP INSPECT/DATATYPE INSPECTABLEFIELDNAMES
REMOVEDUPS INSPECT/ARRAY INSPECT/TOP/LEVEL/LIST INSPECT/PROPLIST NONSYSPROPNAMES
INSPECT/LISTP ALISTP PROPLISTP INSPECT/ALIST ASSOCGET /ASSOCPUT INSPECT/PLIST
@@ -51,16 +52,16 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
(MaxInspectorWindowHeight 606))
(VARS INSPECTPRINTLEVEL)
(* ;; "To deal with profiles in spawned processes")
(* ;; "To deal with profiles in spawned processes")
(MACROS EVAL.AS.PROCESS.WITH.PROFILE WITH-INSPECTOR-ENV))
(COMS (* ; "Atom inspector")
(COMS (* ; "Atom inspector")
(FNS INSPECT/ATOM SELECT.ATOM.ASPECT INSPECT/AS/FUNCTION SELECT.FNS.EDITOR))
(COMS (* ; "Compiled code inspector")
(COMS (* ; "Compiled code inspector")
(FNS INSPECTCODE \TEDIT.INSPECTCODE \INSPECT/CODE/RESHAPEFN \INSPECT/CODE/REPAINTFN))
(COMS (* ; "Hash table inspector")
(COMS (* ; "Hash table inspector")
(FNS INSPECT/HARRAYP HARRAYKEYS INSPECTW.GETHASH INSPECTW.PUTHASH))
[COMS (* ; "Readtable, termtable inspectors")
[COMS (* ; "Readtable, termtable inspectors")
(FNS RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP GETTTBLPROP SETTTBLPROP)
(ADDVARS (INSPECTMACROS (READTABLEP RDTBL\NONOTHERCODES GETSYNTAXPROP SETSYNTAXPROP)
(TERMTABLEP (CHARDELETE WORDDELETE LINEDELETE RETYPE CTRLV EOL RAISE
@@ -69,7 +70,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
28 29 30 31)
GETTTBLPROP SETTTBLPROP]
(COMS (* ; "Hunk inspector")
(COMS (* ; "Hunk inspector")
(FNS INSPECT/AS/BLOCKRECORD INSPECT/TYPELESS LIST-ALL-BLOCKRECORDS INSPECT/HUNK
\INSPECT.DATATYPE.RAW.FETCH \INSPECT.FETCH.8 \INSPECT.FETCH.32 \INSPECT.FETCH.CHAR
\INSPECT.FETCH.FATCHAR \INSPECT.FETCH.PTR \INSPECT.STORE.8 \INSPECT.STORE.16
@@ -1720,7 +1721,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
(\INSPECT/CODE/RESHAPEFN WINDOW])
(\TEDIT.INSPECTCODE
[LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 3-Feb-87 16:56 by jop")
[LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER) (* ; "Edited 11-Oct-2021 14:04 by rmk:")
(PROG ((STREAM (OPENSTREAM '{NODIRCORE} 'BOTH))
WINDOW SEL)
(APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE))
@@ -1737,7 +1738,7 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
(fetch (COMPILED-CLOSURE
FRAMENAME)
of FN]
NIL NIL '(READONLY T PROMPTWINDOW DON'T]
NIL NIL `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT]
(COND
((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1)))
(* ; "Highlight location of PC")
@@ -2146,40 +2147,40 @@ Copyright (c) 1982-1987, 1990-1991, 1993, 1995, 1999, 2018, 2021 by Venue & Xero
(PUTPROPS INSPECT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1991 1993
1995 1999 2018 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6999 42727 (INSPECTW.CREATE 7009 . 11764) (INSPECTW.REPAINTFN 11766 . 17302) (
INSPECTW.REDISPLAY 17304 . 26176) (\INSPECTW.VALUE.MARGIN 26178 . 26581) (INSPECTW.REPLACE 26583 .
27291) (INSPECTW.SELECTITEM 27293 . 28283) (\INSPECTW.REDISPLAYPROP 28285 . 30715) (INSPECTW.FETCH
30717 . 31140) (INSPECTW.PROPERTIES 31142 . 31783) (DECODE.WINDOW.ARG 31785 . 33513) (
DEFAULT.INSPECTW.PROPCOMMANDFN 33515 . 35533) (DEFAULT.INSPECTW.VALUECOMMANDFN 35535 . 36793) (
DEFAULT.INSPECTW.TITLECOMMANDFN 36795 . 38485) (\SELITEM.FROM.PROPERTY 38487 . 38929) (
\INSPECT.COMPUTE.TITLE 38931 . 40057) (LEVELEDFORM 40059 . 40778) (MAKEWITHINREGION 40780 . 42725)) (
42728 60029 (ITEMW.REPAINTFN 42738 . 43958) (\ITEM.WINDOW.BUTTON.HANDLER 43960 . 44375) (
\ITEM.WINDOW.SELECTION.HANDLER 44377 . 47044) (\INSPECTW.COMMAND.HANDLER 47046 . 51047) (
ITEM.WINDOW.SET.STACK.ARG 51049 . 53253) (REPLACESTKARG 53255 . 54354) (IN/ITEM? 54356 . 55238) (
\ITEMW.DESELECTITEM 55240 . 55504) (\ITEMW.SELECTITEM 55506 . 55768) (\ITEMW.CLEARSELECTION 55770 .
56125) (\ITEMW.FLIPITEM 56127 . 56600) (PRINTANDBOX 56602 . 59111) (PRINTATBOX 59113 . 59630) (
ITEMOFPROPERTYVALUE 59632 . 60027)) (60030 63635 (\ITEM.WINDOW.COPY.HANDLER 60040 . 61761) (
\ITEMW.FLIPCOPY 61763 . 62222) (BKSYSBUF.GENERAL 62224 . 63633)) (64027 86502 (INSPECT 64037 . 68300)
(\APPLYINSPECTMACRO 68302 . 69284) (INSPECT/BITMAP 69286 . 70321) (INSPECT/DATATYPE 70323 . 73566) (
INSPECTABLEFIELDNAMES 73568 . 74089) (REMOVEDUPS 74091 . 74296) (INSPECT/ARRAY 74298 . 75335) (
INSPECT/TOP/LEVEL/LIST 75337 . 76296) (INSPECT/PROPLIST 76298 . 77273) (NONSYSPROPNAMES 77275 . 77571)
(INSPECT/LISTP 77573 . 77895) (ALISTP 77897 . 78106) (PROPLISTP 78108 . 78748) (INSPECT/ALIST 78750
. 79105) (ASSOCGET 79107 . 79318) (/ASSOCPUT 79320 . 79585) (INSPECT/PLIST 79587 . 79950) (
INSPECT/TYPERECORD 79952 . 80192) (INSPECT/AS/RECORD 80194 . 81318) (SELECT.LIST.INSPECTOR 81320 .
83365) (STANDARDEDITE 83367 . 83650) (NTHTOPLEVELELT 83652 . 83968) (SETNTHTOPLEVELELT 83970 . 84730)
(DEDITE 84732 . 84939) (FINDRECDECL 84941 . 85524) (FINDSYSRECDECL 85526 . 85927) (
MAKE-INSPECTOR-PROFILE 85929 . 86314) (CONFIRM-SET 86316 . 86500)) (88396 96485 (INSPECT/ATOM 88406 .
92386) (SELECT.ATOM.ASPECT 92388 . 93532) (INSPECT/AS/FUNCTION 93534 . 95820) (SELECT.FNS.EDITOR 95822
. 96483)) (96526 101925 (INSPECTCODE 96536 . 97682) (\TEDIT.INSPECTCODE 97684 . 99642) (
\INSPECT/CODE/RESHAPEFN 99644 . 101183) (\INSPECT/CODE/REPAINTFN 101185 . 101923)) (101963 103448 (
INSPECT/HARRAYP 101973 . 102600) (HARRAYKEYS 102602 . 102981) (INSPECTW.GETHASH 102983 . 103210) (
INSPECTW.PUTHASH 103212 . 103446)) (103497 109706 (RDTBL\NONOTHERCODES 103507 . 104527) (GETSYNTAXPROP
104529 . 106027) (SETSYNTAXPROP 106029 . 107756) (GETTTBLPROP 107758 . 108676) (SETTTBLPROP 108678 .
109704)) (110185 118568 (INSPECT/AS/BLOCKRECORD 110195 . 111078) (INSPECT/TYPELESS 111080 . 112326) (
LIST-ALL-BLOCKRECORDS 112328 . 112603) (INSPECT/HUNK 112605 . 115211) (\INSPECT.DATATYPE.RAW.FETCH
115213 . 115539) (\INSPECT.FETCH.8 115541 . 115690) (\INSPECT.FETCH.32 115692 . 115863) (
\INSPECT.FETCH.CHAR 115865 . 116028) (\INSPECT.FETCH.FATCHAR 116030 . 116192) (\INSPECT.FETCH.PTR
116194 . 116365) (\INSPECT.STORE.8 116367 . 116673) (\INSPECT.STORE.16 116675 . 116975) (
\INSPECT.STORE.32 116977 . 117412) (\INSPECT.STORE.CHAR 117414 . 117740) (\INSPECT.STORE.FATCHAR
117742 . 118064) (\INSPECT.STORE.PTR 118066 . 118413) (INSPECT/MAKE/CCODEP 118415 . 118566)))))
(FILEMAP (NIL (6986 42714 (INSPECTW.CREATE 6996 . 11751) (INSPECTW.REPAINTFN 11753 . 17289) (
INSPECTW.REDISPLAY 17291 . 26163) (\INSPECTW.VALUE.MARGIN 26165 . 26568) (INSPECTW.REPLACE 26570 .
27278) (INSPECTW.SELECTITEM 27280 . 28270) (\INSPECTW.REDISPLAYPROP 28272 . 30702) (INSPECTW.FETCH
30704 . 31127) (INSPECTW.PROPERTIES 31129 . 31770) (DECODE.WINDOW.ARG 31772 . 33500) (
DEFAULT.INSPECTW.PROPCOMMANDFN 33502 . 35520) (DEFAULT.INSPECTW.VALUECOMMANDFN 35522 . 36780) (
DEFAULT.INSPECTW.TITLECOMMANDFN 36782 . 38472) (\SELITEM.FROM.PROPERTY 38474 . 38916) (
\INSPECT.COMPUTE.TITLE 38918 . 40044) (LEVELEDFORM 40046 . 40765) (MAKEWITHINREGION 40767 . 42712)) (
42715 60016 (ITEMW.REPAINTFN 42725 . 43945) (\ITEM.WINDOW.BUTTON.HANDLER 43947 . 44362) (
\ITEM.WINDOW.SELECTION.HANDLER 44364 . 47031) (\INSPECTW.COMMAND.HANDLER 47033 . 51034) (
ITEM.WINDOW.SET.STACK.ARG 51036 . 53240) (REPLACESTKARG 53242 . 54341) (IN/ITEM? 54343 . 55225) (
\ITEMW.DESELECTITEM 55227 . 55491) (\ITEMW.SELECTITEM 55493 . 55755) (\ITEMW.CLEARSELECTION 55757 .
56112) (\ITEMW.FLIPITEM 56114 . 56587) (PRINTANDBOX 56589 . 59098) (PRINTATBOX 59100 . 59617) (
ITEMOFPROPERTYVALUE 59619 . 60014)) (60017 63622 (\ITEM.WINDOW.COPY.HANDLER 60027 . 61748) (
\ITEMW.FLIPCOPY 61750 . 62209) (BKSYSBUF.GENERAL 62211 . 63620)) (64014 86489 (INSPECT 64024 . 68287)
(\APPLYINSPECTMACRO 68289 . 69271) (INSPECT/BITMAP 69273 . 70308) (INSPECT/DATATYPE 70310 . 73553) (
INSPECTABLEFIELDNAMES 73555 . 74076) (REMOVEDUPS 74078 . 74283) (INSPECT/ARRAY 74285 . 75322) (
INSPECT/TOP/LEVEL/LIST 75324 . 76283) (INSPECT/PROPLIST 76285 . 77260) (NONSYSPROPNAMES 77262 . 77558)
(INSPECT/LISTP 77560 . 77882) (ALISTP 77884 . 78093) (PROPLISTP 78095 . 78735) (INSPECT/ALIST 78737
. 79092) (ASSOCGET 79094 . 79305) (/ASSOCPUT 79307 . 79572) (INSPECT/PLIST 79574 . 79937) (
INSPECT/TYPERECORD 79939 . 80179) (INSPECT/AS/RECORD 80181 . 81305) (SELECT.LIST.INSPECTOR 81307 .
83352) (STANDARDEDITE 83354 . 83637) (NTHTOPLEVELELT 83639 . 83955) (SETNTHTOPLEVELELT 83957 . 84717)
(DEDITE 84719 . 84926) (FINDRECDECL 84928 . 85511) (FINDSYSRECDECL 85513 . 85914) (
MAKE-INSPECTOR-PROFILE 85916 . 86301) (CONFIRM-SET 86303 . 86487)) (88383 96472 (INSPECT/ATOM 88393 .
92373) (SELECT.ATOM.ASPECT 92375 . 93519) (INSPECT/AS/FUNCTION 93521 . 95807) (SELECT.FNS.EDITOR 95809
. 96470)) (96513 101932 (INSPECTCODE 96523 . 97669) (\TEDIT.INSPECTCODE 97671 . 99649) (
\INSPECT/CODE/RESHAPEFN 99651 . 101190) (\INSPECT/CODE/REPAINTFN 101192 . 101930)) (101970 103455 (
INSPECT/HARRAYP 101980 . 102607) (HARRAYKEYS 102609 . 102988) (INSPECTW.GETHASH 102990 . 103217) (
INSPECTW.PUTHASH 103219 . 103453)) (103504 109713 (RDTBL\NONOTHERCODES 103514 . 104534) (GETSYNTAXPROP
104536 . 106034) (SETSYNTAXPROP 106036 . 107763) (GETTTBLPROP 107765 . 108683) (SETTTBLPROP 108685 .
109711)) (110192 118575 (INSPECT/AS/BLOCKRECORD 110202 . 111085) (INSPECT/TYPELESS 111087 . 112333) (
LIST-ALL-BLOCKRECORDS 112335 . 112610) (INSPECT/HUNK 112612 . 115218) (\INSPECT.DATATYPE.RAW.FETCH
115220 . 115546) (\INSPECT.FETCH.8 115548 . 115697) (\INSPECT.FETCH.32 115699 . 115870) (
\INSPECT.FETCH.CHAR 115872 . 116035) (\INSPECT.FETCH.FATCHAR 116037 . 116199) (\INSPECT.FETCH.PTR
116201 . 116372) (\INSPECT.STORE.8 116374 . 116680) (\INSPECT.STORE.16 116682 . 116982) (
\INSPECT.STORE.32 116984 . 117419) (\INSPECT.STORE.CHAR 117421 . 117747) (\INSPECT.STORE.FATCHAR
117749 . 118071) (\INSPECT.STORE.PTR 118073 . 118420) (INSPECT/MAKE/CCODEP 118422 . 118573)))))
STOP

Binary file not shown.

View File

@@ -1,18 +1,19 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 8-Aug-2021 13:28:16" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17 62025
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN)
(FILECREATED "17-Oct-2021 13:54:52" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;18 61702
previous date%: " 6-Aug-2021 17:07:29"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;16)
changes to%: (VARS JAPANESECOMS)
previous date%: " 8-Aug-2021 13:28:16"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>JAPANESE.;17)
(PRETTYCOMPRINT JAPANESECOMS)
(RPAQQ JAPANESECOMS
[ (* ; "XCCS to JIS converter")
[COMS (* ; "JIS to XCCS conversion table.")
[ (* ; "XCCS to JIS converter")
[COMS (* ; "JIS to XCCS conversion table.")
(VARS *JIS-TO-XCCS-CONV-NO-FONT-TABLE* *JIS-TO-XCCS-CODE-MAP*
*HANKAKU-TO-ZENKAKU-CODE-MAP*)
(GLOBALVARS *JIS-TO-XCCS-CONV-NO-FONT-TABLE* *JIS-TO-XCCS-CONV-TABLE-LIST*
@@ -22,29 +23,28 @@
*HANKAKU-TO-ZENKAKU-CONV-TABLE* *ZENKAKU-TO-HANKAKU-CONV-TABLE*)
(FNS \MAKE.JIS.TO.XCCS.CONV.TABLE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAKE.JIS.TO.XCCS.CONV.TABLE]
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY (MACROS \CONV.JIS.TO.XCCS \DO.CONV.JIS.TO.XCCS))
(FNS \JISIN \JISPEEK \BACKJISCCODE \SHIFTJISIN \SHIFTJISPEEK \BACKSHIFTJISCCODE \EUCIN
\EUCPEEK \BACKEUCCODE)
(FNS \JISOUTCHARFN \SHIFTJISOUTCHARFN \EUCOUTCHARFN)
[COMS (FNS CONVHANKAKU)
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CONV.XCCS.TO.JIS
\DO.CONV.XCCS.TO.JIS \ASCIIP
\NOT.EQUIVALENT.TO.JIS
\CONV.HANKAKU.TO.ZENKAKUP
\CONV.ZENKAKU.KANA]
(COMS (FNS CONVHANKAKU)
(DECLARE%: DOEVAL@COMPILE DONTCOPY (MACROS \CONV.XCCS.TO.JIS \DO.CONV.XCCS.TO.JIS
\ASCIIP \NOT.EQUIVALENT.TO.JIS
\CONV.HANKAKU.TO.ZENKAKUP \CONV.ZENKAKU.KANA)
))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* ;; "JIS specific macro")
(* ;; "JIS specific macro")
(MACROS \EXTRACT.NO.FONT.CODE \EXTARACT.CONV.TABLE \NOT.EQUIVALENT.TO.XCCS
\EXTRACT.SET \EXTRACT.CODE \CHNAGE.KI.MODE \KIMODEP \HANKAKUP \KANJIP
\NOTGAIJIP \INVALID.TENP \CONV.HANKAKU.KANA \OUTKI \OUTKO)
(* ;; "Shift-JIS specific macro")
(* ;; "Shift-JIS specific macro")
(MACROS \CONV.SJIS.TO.JIS \CONV.JIS.TO.SJIS \SJIS.KANJI.FIRST.BYTEP)
(* ;; "EUC specific macro")
(* ;; "EUC specific macro")
(MACROS \EUC.KANJI.FIRST.BYTEP \GAIJIP \EUC.HANKAKUP))
(FNS \CREATE.JIS.EXTERNALFORMAT \CREATE.SHIFTJIS.EXTERNALFORMAT \CREATE.EUC.EXTERNALFORMAT)
@@ -449,11 +449,11 @@
(\MAKE.JIS.TO.XCCS.CONV.TABLE)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DECLARE%: EVAL@COMPILE
(PUTPROPS \CONV.JIS.TO.XCCS MACRO [OPENLAMBDA (KU TEN)
(* ;;; "Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS.")
(* ;;; "Some character code is not equivalent between JIS and XCCS. In such case, we have to convert the character to corresponding XCCS.")
(COND
((\NOT.EQUIVALENT.TO.XCCS KU)
@@ -464,13 +464,13 @@
(PUTPROPS \DO.CONV.JIS.TO.XCCS MACRO
[(KU TEN)
(* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
(* ;;; " Convert a JIS code divided into KU (high 8 bit) and TEN (low 8 bit) to an corresponding XCCS code.")
(COND
((\INVALID.TENP TEN)
*DEFAULT-NOT-CONVERTED-FAT-CODE*)
(T (SELECTQ KU
((33 34 38) (* ; "1, 2 and 6 KU")
((33 34 38) (* ; "1, 2 and 6 KU")
[LET* ((CONVTABLE (\EXTARACT.CONV.TABLE KU))
(SET (\EXTRACT.SET TEN CONVTABLE))
(CODE (\EXTRACT.CODE TEN CONVTABLE)))
@@ -479,41 +479,38 @@
(LOGOR (UNFOLD SET 256)
CODE))
(T (COND
((EQ CODE 255) (* ; "Not defined in JIS.")
((EQ CODE 255) (* ; "Not defined in JIS.")
*DEFAULT-NOT-CONVERTED-FAT-CODE*)
(T (* ;
 "Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.")
(T (* ;
 "Defined in JIS but the displayable font is not assigned in the corresponding code in XCCS.")
(COND
(*REPLACE-NO-FONT-CODE*
*DEFAULT-NOT-CONVERTED-FAT-CODE*)
(T (\EXTRACT.NO.FONT.CODE (LOGOR (UNFOLD KU 256)
TEN])
(35 (* ; "3 KU")
(* ;
 "Alpha numeric codes are all defined as single byte codes in XCCS.")
(35 (* ; "3 KU")
(* ;
 "Alpha numeric codes are all defined as single byte codes in XCCS.")
TEN)
(40 (* ; "8 KU")
(40 (* ; "8 KU")
(COND
[(< 0 TEN 33)
(COND
(*REPLACE-NO-FONT-CODE* *DEFAULT-NOT-CONVERTED-FAT-CODE*)
(T (\EXTRACT.NO.FONT.CODE (LOGOR KU TEN]
(T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
(116 (* ; "84 KU")
(116 (* ; "84 KU")
(COND
((< 0 TEN 5)
(LOGOR 29952 TEN))
(T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
(117 (* ; "85 KU")
(117 (* ; "85 KU")
(COND
((< 0 TEN 28)
(LOGOR 29696 TEN))
(T *DEFAULT-NOT-CONVERTED-FAT-CODE*)))
*DEFAULT-NOT-CONVERTED-FAT-CODE*])
)
(* "END EXPORTED DEFINITIONS")
)
(DEFINEQ
@@ -1055,11 +1052,11 @@
(ARG ARGS 2))))])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DECLARE%: EVAL@COMPILE
(PUTPROPS \CONV.XCCS.TO.JIS MACRO (OPENLAMBDA (OUTSTREAM CC)
(* ;;; "Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode.")
(* ;;; "Returns JIS code corresponding to XCCS charcode. Handle HANKAKU as well as ZENKAKU. If OUTSTREAM wants to convert ZENKAKUKANA to HANKAKUKANA, do so. Never returns two byte charcode for alpha-numeric character, they are all treated as single byte characode.")
(OR (COND
((\ASCIIP CC)
@@ -1067,8 +1064,8 @@
((\NOT.EQUIVALENT.TO.JIS CC)
(\DO.CONV.XCCS.TO.JIS CC))
((\CONV.HANKAKU.TO.ZENKAKUP OUTSTREAM)
(* ;
 "ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.")
(* ;
 "ZENKAKUKANA comes here, because their charcodes are equiavalent to JIS.")
(\CONV.ZENKAKU.KANA CC))
(T CC))
CC)))
@@ -1104,9 +1101,6 @@
(PUTPROPS \CONV.ZENKAKU.KANA MACRO ((CHAR)
(GETHASH CHAR *ZENKAKU-TO-HANKAKU-CONV-TABLE*)))
)
(* "END EXPORTED DEFINITIONS")
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -1120,7 +1114,7 @@
(PUTPROPS \NOT.EQUIVALENT.TO.XCCS MACRO ((KU)
(* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here.")
(* ;;; " The JIS codes which are not equiavelent to XCCS reside in 1, 2, 3, 6, 8 and 84 KU. Although from 84-5 to 94-94 inclusive are not defined in JIS, that is they are GAIJI, they are also handled here.")
(OR (EQ KU 33)
(EQ KU 34)
@@ -1141,8 +1135,8 @@
(PUTPROPS \CHNAGE.KI.MODE MACRO [OPENLAMBDA (ST INPUTFLG ENTERP)
(* ;;;
"INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.")
(* ;;;
"INPUTFLG is true if \CHNAGE.KI.MODE is called in the context in which ST is an input stream.")
(COND
[INPUTFLG (COND
@@ -1161,7 +1155,7 @@
(PUTPROPS \KIMODEP MACRO [OPENLAMBDA (ST INPUTFLG)
(* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.")
(* ;;; "INPUTFLG is true if \KIMODEP is called in the context in which ST is an input stream.")
(COND
[INPUTFLG (ffetch (STREAM IN.KANJIIN)
@@ -1201,7 +1195,7 @@
(PUTPROPS \CONV.SJIS.TO.JIS MACRO [OPENLAMBDA (HI LO)
(* ;;; "Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively.")
(* ;;; "Convert Shift-JIS to JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of JIS code respectively.")
[SETQ CH1 (IDIFFERENCE HI (COND
((> HI 159)
@@ -1220,7 +1214,7 @@
(PUTPROPS \CONV.JIS.TO.SJIS MACRO [OPENLAMBDA (HI LO)
(* ;;; "Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively.")
(* ;;; "Convert JIS to Shift-JIS. The variable named CH1 and CH2 are set to the converted hight 8 bit and low 8bit of Shift-JIS code respectively.")
[SETQ CH2 (COND
((ODDP HI)
@@ -1313,11 +1307,11 @@
(ADDTOVAR LAMA CONVHANKAKU)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10976 16192 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10986 . 16190)) (19836 45193 (\JISIN 19846 .
26482) (\JISPEEK 26484 . 33110) (\BACKJISCCODE 33112 . 33652) (\SHIFTJISIN 33654 . 35046) (
\SHIFTJISPEEK 35048 . 37154) (\BACKSHIFTJISCCODE 37156 . 37742) (\EUCIN 37744 . 39447) (\EUCPEEK 39449
. 43028) (\BACKEUCCODE 43030 . 45191)) (45194 49042 (\JISOUTCHARFN 45204 . 46614) (\SHIFTJISOUTCHARFN
46616 . 47716) (\EUCOUTCHARFN 47718 . 49040)) (49043 49362 (CONVHANKAKU 49053 . 49360)) (60086 61580
(\CREATE.JIS.EXTERNALFORMAT 60096 . 60484) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60486 . 61189) (
\CREATE.EUC.EXTERNALFORMAT 61191 . 61578)))))
(FILEMAP (NIL (10791 16007 (\MAKE.JIS.TO.XCCS.CONV.TABLE 10801 . 16005)) (19582 44939 (\JISIN 19592 .
26228) (\JISPEEK 26230 . 32856) (\BACKJISCCODE 32858 . 33398) (\SHIFTJISIN 33400 . 34792) (
\SHIFTJISPEEK 34794 . 36900) (\BACKSHIFTJISCCODE 36902 . 37488) (\EUCIN 37490 . 39193) (\EUCPEEK 39195
. 42774) (\BACKEUCCODE 42776 . 44937)) (44940 48788 (\JISOUTCHARFN 44950 . 46360) (\SHIFTJISOUTCHARFN
46362 . 47462) (\EUCOUTCHARFN 47464 . 48786)) (48789 49108 (CONVHANKAKU 48799 . 49106)) (59763 61257
(\CREATE.JIS.EXTERNALFORMAT 59773 . 60161) (\CREATE.SHIFTJIS.EXTERNALFORMAT 60163 . 60866) (
\CREATE.EUC.EXTERNALFORMAT 60868 . 61255)))))
STOP

Binary file not shown.

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