Compare commits
17 Commits
medley-211
...
medley-211
| Author | SHA1 | Date | |
|---|---|---|---|
|
d1fe834e6f | ||
|
c3b5e23cd9 | ||
|
|
9b4976e33f | ||
|
|
31d9473184 | ||
|
bf5689be2a | ||
|
|
08bdd34e69 | ||
|
|
c7a219fd22 | ||
|
|
13cfb9b835 | ||
|
|
b3219c33da | ||
|
|
b0f9f2cce8 | ||
|
1ad92b3dd4 | ||
|
|
588835603c | ||
|
|
df70662f2c | ||
|
|
32461da7eb | ||
|
|
1beba945a2 | ||
|
|
e6cf869a23 | ||
|
|
a6efdb3558 |
@@ -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:
|
||||
91
.github/workflows/buildLoadup.yml
vendored
Normal file
91
.github/workflows/buildLoadup.yml
vendored
Normal file
@@ -0,0 +1,91 @@
|
||||
# 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/
|
||||
tar cfz tmp/$tag-loadups.tgz \
|
||||
loadups/lisp.sysout \
|
||||
loadups/full.sysout \
|
||||
loadups/whereis.hash \
|
||||
library/exports.all \
|
||||
library/RDSYS/ \
|
||||
library/RDSYS.LCOM
|
||||
|
||||
- name: tar part 2
|
||||
run: |
|
||||
tar cfz tmp/$tag-runtime.tgz \
|
||||
--exclude "*~" --exclude "*#*" \
|
||||
docs/dinfo \
|
||||
docs/Documentation\ Tools \
|
||||
greetfiles/SIMPLE-INIT \
|
||||
run-medley \
|
||||
scripts \
|
||||
fonts/displayfonts \
|
||||
fonts/altofonts \
|
||||
fonts/postscriptfonts \
|
||||
library/ \
|
||||
lispusers/ \
|
||||
fonts/big \
|
||||
fonts/other \
|
||||
sources/ \
|
||||
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
16
BUILDING.md
Normal 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.
|
||||
75
README.md
75
README.md
@@ -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
|
||||
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "19-Sep-2021 18:08:05"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>FILEBROWSER.;9| 260675
|
||||
|
||||
|changes| |to:| (FNS FB.EDITCOMMAND.ONEFILE)
|
||||
(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:33:58"
|
||||
|{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.
|
||||
@@ -205,6 +207,7 @@ You specify how many versions to keep.")))
|
||||
FB.SHAPECOMMAND FB.REMOVE.FILE FB.COUNT.FILE.CHANGE FB.SETNEWPATTERN
|
||||
FB.GET.NEWPATTERN FB.OPTIONSCOMMAND))
|
||||
(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)
|
||||
@@ -2253,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")
|
||||
@@ -2307,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))
|
||||
@@ -2317,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")))))))
|
||||
|
||||
@@ -3294,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)))
|
||||
@@ -4202,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 112384 (FB.EDITCOMMAND 102517 . 103318) (
|
||||
FB.EDITCOMMAND.ONEFILE 103320 . 106600) (FB.EDITLISPFILE 106602 . 107641) (FB.BROWSECOMMAND 107643 .
|
||||
112382)) (112385 124178 (FB.FASTSEECOMMAND 112395 . 115845) (FB.FASTSEE.ONEFILE 115847 . 118876) (
|
||||
FB.SEEFULLFN 118878 . 123009) (FB.SEEBUTTONFN 123011 . 124176)) (124179 125925 (FB.LOADCOMMAND 124189
|
||||
. 124696) (FB.COMPILECOMMAND 124698 . 125236) (FB.OPERATE.ON.FILES 125238 . 125923)) (125926 173584 (
|
||||
FB.UPDATECOMMAND 125936 . 126161) (FB.FIX-DIRECTORY-DATES 126163 . 126770) (FB.MAYBE.EXPUNGE 126772 .
|
||||
127767) (FB.UPDATEBROWSERITEMS 127769 . 140984) (FB.DATE 140986 . 141727) (FB.ADJUST.DATE.WIDTH 141729
|
||||
. 144697) (FB.SET.BROWSER.TITLE 144699 . 145556) (FB.MAYBE.WIDEN.NAMES 145558 . 147677) (
|
||||
FB.SET.DEFAULT.NAME.WIDTH 147679 . 149043) (FB.CREATE.FILEBUCKET 149045 . 156265) (
|
||||
FB.CHECK.NAME.LENGTH 156267 . 158688) (FB.ADD.FILEGROUP 158690 . 160217) (FB.INSERT.DIRECTORY 160219
|
||||
. 160457) (FB.MAKE.SUBDIRECTORY.ITEM 160459 . 161868) (FB.ADD.FILE 161870 . 162483) (FB.INSERT.FILE
|
||||
162485 . 165897) (FB.ANALYZE.PATTERN 165899 . 171163) (FB.CANONICALIZE.PATTERN 171165 . 172477) (
|
||||
FB.GETALLFILEINFO 172479 . 173582)) (173585 181744 (FB.SORT.VERSIONS 173595 . 176366) (
|
||||
FB.DECREASING.VERSION 176368 . 177037) (FB.INCREASING.VERSION 177039 . 177660) (
|
||||
FB.NAMES.DECREASING.VERSION 177662 . 178697) (FB.NAMES.INCREASING.VERSION 178699 . 179696) (
|
||||
FB.DECREASING.NUMERIC.ATTR 179698 . 180378) (FB.INCREASING.NUMERIC.ATTR 180380 . 181054) (
|
||||
FB.ALPHABETIC.ATTR 181056 . 181742)) (181745 191587 (FB.SORTCOMMAND 181755 . 188585) (
|
||||
FB.INSERT.SUBDIRECTORIES 188587 . 189384) (FB.GET.SORT.MENU 189386 . 191585)) (191588 207677 (
|
||||
FB.EXPUNGECOMMAND 191598 . 194117) (FB.NEWPATTERNCOMMAND 194119 . 194517) (FB.NEWINFOCOMMAND 194519 .
|
||||
197285) (FB.DEPTHCOMMAND 197287 . 199062) (FB.SHAPECOMMAND 199064 . 202406) (FB.REMOVE.FILE 202408 .
|
||||
204229) (FB.COUNT.FILE.CHANGE 204231 . 205676) (FB.SETNEWPATTERN 205678 . 206848) (FB.GET.NEWPATTERN
|
||||
206850 . 207434) (FB.OPTIONSCOMMAND 207436 . 207675)) (207712 208724 (
|
||||
FB.INFOMENU.SHADEINITIALSELECTIONS 207722 . 208369) (FB.INFO.ITEM.NAMED 208371 . 208722)) (208725
|
||||
218191 (FB.MAKECOUNTERWINDOW 208735 . 210197) (FB.COUNTERW.REDISPLAYFN 210199 . 210786) (
|
||||
FB.UPDATE.COUNTERS 210788 . 212860) (FB.DISPLAY.COUNTERS 212862 . 217922) (FB.COUNTER.STRING 217924 .
|
||||
218189)) (218192 222835 (FB.MAKEHEADINGWINDOW 218202 . 219750) (FB.HEADINGW.REDISPLAYFN 219752 .
|
||||
220018) (FB.HEADINGW.RESHAPEFN 220020 . 220396) (FB.HEADINGW.DISPLAY 220398 . 222833)) (222836 227019
|
||||
(FB.ICONFN 222846 . 223193) (FB.INFOMENU.WHENSELECTEDFN 223195 . 223925) (FB.CLOSEFN 223927 . 225130)
|
||||
(FB.EXPUNGE?.MENU 225132 . 225544) (FB.AFTERCLOSEFN 225546 . 225907) (FB.CLOSE&EXPUNGE 225909 . 227017
|
||||
)) (227020 239078 (FB.HARDCOPY.DIRECTORY 227030 . 237387) (FB.HARDCOPY.PRINT.TITLE 237389 . 237715) (
|
||||
FB.HARDCOPY.MAXWIDTH 237717 . 239076)))))
|
||||
(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.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Sep-2021 22:16:28"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;11 142247
|
||||
(FILECREATED "13-Oct-2021 10:00:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;19 142287
|
||||
|
||||
changes to%: (FNS TEDIT-SEE)
|
||||
|
||||
previous date%: "19-Sep-2021 17:08:56"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;5)
|
||||
previous date%: "11-Oct-2021 14:03:12"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;18)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -330,7 +330,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(RETURN PROC])
|
||||
|
||||
(TEDIT-SEE
|
||||
[LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 29-Sep-2021 22:16 by rmk:")
|
||||
[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:")
|
||||
|
||||
@@ -340,18 +340,18 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
|
||||
(LET ((SEESTREAM STREAM)
|
||||
ENV TSTREAM)
|
||||
TSTREAM)
|
||||
|
||||
(* ;; "No need to fiddle with a TEDIT file")
|
||||
|
||||
(IF (\TEDIT.FORMATTEDP1 STREAM)
|
||||
ELSEIF (SETQ ENV (LISPSOURCEFILEP STREAM))
|
||||
ELSEIF (LISPSOURCEFILEP STREAM)
|
||||
THEN
|
||||
|
||||
(* ;; "Lisp source file")
|
||||
|
||||
(SETFILEINFO STREAM 'FORMAT ENV)
|
||||
(SETQ SEESTREAM (OPENTEXTSTREAM))
|
||||
(DSPFONT DEFAULTFONT SEESTREAM)
|
||||
(COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
|
||||
ELSE
|
||||
|
||||
@@ -360,11 +360,12 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(* ;; "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-EXTERNALFORMAT*))
|
||||
:DEFAULT))
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
(SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
|
||||
(COPYCHARS STREAM SEESTREAM)))
|
||||
[SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL '(READONLY T]
|
||||
[SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL
|
||||
`(READONLY T FONT ,DEFAULTFONT]
|
||||
(WINDOWPROP (WFROMDS TSTREAM)
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM)))
|
||||
@@ -2235,7 +2236,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(* ; "TEDIT Support information")
|
||||
|
||||
|
||||
(RPAQQ TEDITSYSTEMDATE "29-Sep-2021 22:16:28")
|
||||
(RPAQQ TEDITSYSTEMDATE "13-Oct-2021 10:00:40")
|
||||
|
||||
(RPAQ TEDITSUPPORT "TEditSupport.PA")
|
||||
(DEFINEQ
|
||||
@@ -2261,19 +2262,19 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1992 1993 1995 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4329 117413 (\TEDIT2 4339 . 7090) (COERCETEXTOBJ 7092 . 15868) (TEDIT 15870 . 20839) (
|
||||
TEDIT-SEE 20841 . 23089) (TEDIT.CHARWIDTH 23091 . 25115) (TEDIT.COPY 25117 . 33553) (TEDIT.DELETE
|
||||
33555 . 34245) (TEDIT.DO.BLUEPENDINGDELETE 34247 . 37314) (TEDIT.INSERT 37316 . 42846) (TEDIT.KILL
|
||||
42848 . 44405) (TEDIT.MAPLINES 44407 . 45806) (TEDIT.MAPPIECES 45808 . 46764) (TEDIT.MOVE 46766 .
|
||||
56550) (TEDIT.QUIT 56552 . 58552) (TEDIT.STRINGWIDTH 58554 . 59225) (TEDIT.\INSERT 59227 . 61252) (
|
||||
TEXTOBJ 61254 . 62379) (TEXTSTREAM 62381 . 63996) (\TEDIT.INCLUDE 63998 . 67898) (\TEDIT.INSERT.PIECES
|
||||
67900 . 77815) (\TEDIT.MOVE.PIECEMAPFN 77817 . 79896) (\TEDIT.OBJECT.SHOWSEL 79898 . 83527) (
|
||||
\TEDIT.RESTARTFN 83529 . 85524) (\TEDIT.CHARDELETE 85526 . 89488) (\TEDIT.COPY.PIECEMAPFN 89490 .
|
||||
92715) (\TEDIT.DELETE 92717 . 100235) (\TEDIT.DIFFUSE.PARALOOKS 100237 . 103001) (\TEDIT.FOREIGN.COPY?
|
||||
103003 . 106730) (\TEDIT.QUIT 106732 . 109878) (\TEDIT.WORDDELETE 109880 . 114713) (\TEDIT1 114715 .
|
||||
117411)) (117527 117643 (\CREATE.TEDIT.RESTART.MENU 117537 . 117641)) (117742 121431 (PLCHAIN 117752
|
||||
. 118026) (PRINTLINE 118028 . 120792) (SEEFILE 120794 . 121429)) (121472 141115 (TEDIT.INSERT.OBJECT
|
||||
121482 . 130559) (TEDIT.EDIT.OBJECT 130561 . 132817) (TEDIT.FIND.OBJECT 132819 . 133712) (
|
||||
TEDIT.FIND.OBJECT.SUBTREE 133714 . 134520) (TEDIT.PUT.OBJECT 134522 . 136181) (TEDIT.GET.OBJECT 136183
|
||||
. 139382) (TEDIT.OBJECT.CHANGED 139384 . 141113)) (141393 141756 (MAKETEDITFORM 141403 . 141754)))))
|
||||
(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.
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Sep-2021 23:11:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;10 186372
|
||||
|
||||
changes to%: (FNS \TEDIT.SCROLLFN)
|
||||
(FILECREATED "16-Oct-2021 18:52:11"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18 187780
|
||||
|
||||
previous date%: "19-Sep-2021 22:58:18"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;9)
|
||||
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,6 +26,9 @@ 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))
|
||||
@@ -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)
|
||||
@@ -795,17 +808,18 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
'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)
|
||||
@@ -845,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])
|
||||
|
||||
@@ -1366,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@@@@@@@@@@@@@@
|
||||
@@ -1679,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))
|
||||
|
||||
@@ -1705,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.")
|
||||
@@ -2830,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 (7117 93041 (TEDIT.CREATEW 7127 . 8263) (\TEDIT.CREATEW.FROM.REGION 8265 . 9249) (
|
||||
TEDIT.CURSORMOVEDFN 9251 . 19903) (TEDIT.CURSOROUTFN 19905 . 20440) (TEDIT.WINDOW.SETUP 20442 . 22251)
|
||||
(TEDIT.MINIMAL.WINDOW.SETUP 22253 . 30042) (\TEDIT.ACTIVE.WINDOWP 30044 . 31025) (
|
||||
\TEDIT.BUTTONEVENTFN 31027 . 56017) (\TEDIT.WINDOW.OPS 56019 . 59822) (\TEDIT.EXPANDFN 59824 . 60227)
|
||||
(\TEDIT.MAINW 60229 . 61518) (\TEDIT.PRIMARYW 61520 . 62732) (\TEDIT.COPYINSERTFN 62734 . 63705) (
|
||||
\TEDIT.NEWREGIONFN 63707 . 66174) (\TEDIT.SET.WINDOW.EXTENT 66176 . 72278) (\TEDIT.SHRINK.ICONCREATE
|
||||
72280 . 74552) (\TEDIT.SHRINKFN 74554 . 75129) (\TEDIT.SPLITW 75131 . 81232) (\TEDIT.UNSPLITW 81234 .
|
||||
86928) (\TEDIT.WINDOW.SETUP 86930 . 92650) (\SAFE.FIRST 92652 . 93039)) (94187 95094 (TEDITWINDOWP
|
||||
94197 . 95092)) (95131 97627 (TEDIT.GETINPUT 95141 . 97124) (\TEDIT.MAKEFILENAME 97126 . 97625)) (
|
||||
97676 104127 (TEDIT.PROMPTPRINT 97686 . 100590) (TEDIT.PROMPTFLASH 100592 . 102547) (
|
||||
\TEDIT.PROMPT.PAGEFULLFN 102549 . 104125)) (104362 108424 (TEXTSTREAM.TITLE 104372 . 104993) (
|
||||
\TEDIT.ORIGINAL.WINDOW.TITLE 104995 . 107040) (\TEDIT.WINDOW.TITLE 107042 . 107712) (
|
||||
\TEXTSTREAM.FILENAME 107714 . 108422)) (108467 153208 (TEDIT.DEACTIVATE.WINDOW 108477 . 115626) (
|
||||
\TEDIT.REPAINTFN 115628 . 118485) (\TEDIT.RESHAPEFN 118487 . 124107) (\TEDIT.SCROLLFN 124109 . 153206)
|
||||
) (153250 155299 (\TEDIT.PROCIDLEFN 153260 . 154609) (\TEDIT.PROCENTRYFN 154611 . 154904) (
|
||||
\TEDIT.PROCEXITFN 154906 . 155297)) (155378 166378 (\EDIT.DOWNCARET 155388 . 156069) (\EDIT.FLIPCARET
|
||||
156071 . 157606) (TEDIT.FLASHCARET 157608 . 158722) (\EDIT.UPCARET 158724 . 159177) (
|
||||
TEDIT.NORMALIZECARET 159179 . 165130) (\SETCARET 165132 . 166052) (\TEDIT.CARET 166054 . 166376)) (
|
||||
166412 180167 (TEDIT.ADD.MENUITEM 166422 . 168337) (TEDIT.DEFAULT.MENUFN 168339 . 177606) (
|
||||
TEDIT.REMOVE.MENUITEM 177608 . 178609) (\TEDIT.CREATEMENU 178611 . 179064) (\TEDIT.MENU.WHENHELDFN
|
||||
179066 . 179836) (\TEDIT.MENU.WHENSELECTEDFN 179838 . 180165)))))
|
||||
(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.
118
library/TEXTOFD
118
library/TEXTOFD
@@ -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.
Binary file not shown.
File diff suppressed because one or more lines are too long
531
lispusers/DATE
531
lispusers/DATE
@@ -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
|
||||
@@ -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.
@@ -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.
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
152
lispusers/TEDIT-PF-SEE
Normal 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
BIN
lispusers/TEDIT-PF-SEE.LCOM
Normal file
Binary file not shown.
@@ -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.
@@ -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.
|
||||
|
||||
@@ -1,41 +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).
|
||||
|
||||
The medley release comes in two parts:
|
||||
1. The "loadups" (download `$tag-loadups.tgz` below)
|
||||
2. The "runtime" (download `$tag-runtime.tgz` below)
|
||||
|
||||
You won't need the "runtime" if you clone medley; it's just a subset.
|
||||
|
||||
To download both using 'gh' GitHub command line:
|
||||
```
|
||||
gh release download -R Interlisp/medley -p "*"
|
||||
```
|
||||
|
||||
To use (from a shell/terminal window):
|
||||
|
||||
1. Unpack the medley tar file(s)
|
||||
```
|
||||
tar -xvfz $tag-loadups.tgz
|
||||
tar -xvfz $tag-runtime.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).
|
||||
|
||||
|
||||
|
||||
BIN
sources/BSP.LCOM
BIN
sources/BSP.LCOM
Binary file not shown.
@@ -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.
@@ -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.
205
sources/FILEPKG
205
sources/FILEPKG
@@ -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.
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "11-Sep-2021 00:01:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;10 6469
|
||||
|
||||
changes to%: (VARS MAKEINITTYPES 0LISPSET EXPORTFILES)
|
||||
(FILECREATED "17-Oct-2021 13:52:47"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;15 6457
|
||||
|
||||
previous date%: "10-Sep-2021 19:53:14"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;8)
|
||||
changes to%: (VARS EXPORTFILES)
|
||||
|
||||
previous date%: "17-Oct-2021 12:43:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;14)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -71,7 +72,7 @@ Copyright (c) 1981-1990, 1998, 2021 by Xerox Corporation.
|
||||
(MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC LLCHAR
|
||||
LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
|
||||
ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER
|
||||
IMAGEIO PROC XCCS LLREAD PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS))
|
||||
IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS))
|
||||
|
||||
(RPAQQ MAKEINITFILES (MAKEINIT MEM I-NEW))
|
||||
|
||||
|
||||
250
sources/HARDCOPY
250
sources/HARDCOPY
@@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "20-Sep-2021 10:59:58"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;2 103730
|
||||
|
||||
changes to%: (VARS HARDCOPYCOMS)
|
||||
(FILECREATED " 8-Oct-2021 22:23:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;13 103499
|
||||
|
||||
previous date%: " 5-May-2021 19:41:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;1)
|
||||
changes to%: (FNS COPY.TEXT.TO.IMAGE)
|
||||
|
||||
previous date%: " 7-Oct-2021 10:43:32"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>HARDCOPY.;12)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -722,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
|
||||
|
||||
@@ -1088,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 (6176 10360 (HARDCOPY.SOMEHOW 6186 . 7544) (HARDCOPYIMAGEW 7546 . 7698) (
|
||||
HARDCOPYIMAGEW.TOFILE 7700 . 8008) (HARDCOPYIMAGEW.TOPRINTER 8010 . 8675) (HARDCOPYREGION.TOFILE 8677
|
||||
. 8975) (HARDCOPYREGION.TOPRINTER 8977 . 9599) (COPY.WINDOW.TO.BITMAP 9601 . 10358)) (10432 20982 (
|
||||
MakeMenuOfPrinters 10442 . 11667) (PRINTERS.WHENSELECTEDFN 11669 . 13411) (MakeMenuOfImageTypes 13413
|
||||
. 13931) (GetNewPrinterFromUser 13933 . 14361) (PopUpWindowAndGetAtom 14363 . 15748) (
|
||||
PopUpWindowAndGetList 15750 . 17316) (NewPrinter 17318 . 18266) (GetPrinterName 18268 . 18548) (
|
||||
GetImageFile 18550 . 20837) (FetchDefaultPrinter 20839 . 20980)) (21017 21555 (
|
||||
ExtensionForPrintFileType 21027 . 21220) (PRINTFILETYPE.FROM.EXTENSION 21222 . 21553)) (21610 37994 (
|
||||
DEFAULTPRINTER 21620 . 21780) (CAN.PRINT.DIRECTLY 21782 . 21938) (CONVERT.FILE.TO.TYPE.FOR.PRINTER
|
||||
21940 . 22984) (EMPRESS 22986 . 23299) (HARDCOPYW 23301 . 26261) (LISTFILES1 26263 . 26436) (
|
||||
PRINTER.BITMAPFILE 26438 . 26685) (PRINTER.BITMAPSCALE 26687 . 26952) (PRINTER.SCRATCH.FILE 26954 .
|
||||
27077) (PRINTERPROP 27079 . 27262) (PRINTERSTATUS 27264 . 27453) (PRINTERTYPE 27455 . 29764) (
|
||||
PRINTERNAME 29766 . 30068) (PRINTFILEPROP 30070 . 30261) (PRINTFILETYPE 30263 . 32207) (
|
||||
\EXPECTED.FILE.TYPE 32209 . 32991) (SEND.FILE.TO.PRINTER 32993 . 37992)) (37995 42977 (PRINTERDEVICE
|
||||
38005 . 42975)) (43792 51993 (TEXTTOIMAGEFILE 43802 . 45992) (COPY.TEXT.TO.IMAGE 45994 . 51991)) (
|
||||
51994 53129 (\BLTSHADE.GENERICPRINTER 52004 . 53127)) (53257 72009 (MAKEHARDCOPYSTREAM 53267 . 54271)
|
||||
(UNMAKEHARDCOPYSTREAM 54273 . 54957) (HARDCOPYSTREAMTYPE 54959 . 55238) (\CHARWIDTH.HDCPYDISPLAY 55240
|
||||
. 55671) (\DSPFONT.HDCPYDISPLAY 55673 . 57078) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57080 . 57657) (
|
||||
\DSPXPOSITION.HDCPYDISPLAY 57659 . 57920) (\DSPYPOSITION.HDCPYDISPLAY 57922 . 58183) (
|
||||
\STRINGWIDTH.HDCPYDISPLAY 58185 . 58692) (\STRINGWIDTH.HCPYDISPLAYAUX 58694 . 61026) (\HDCPYBLTCHAR
|
||||
61028 . 63563) (\HDCPYDISPLAY.FIX.XPOS 63565 . 63985) (\HDCPYDISPLAY.FIX.YPOS 63987 . 64407) (
|
||||
\HDCPYDISPLAYINIT 64409 . 65186) (\HDCPYDSPPRINTCHAR 65188 . 67348) (\SLOWHDCPYBLTCHAR 67350 . 70853)
|
||||
(\CHANGECHARSET.HDCPYDISPLAY 70855 . 72007)) (72731 103028 (MAKEHARDCOPYMODESTREAM 72741 . 74650) (
|
||||
UNMAKEHARDCOPYMODESTREAM 74652 . 75730) (\BLTSHADE.HCPYMODE 75732 . 76179) (\BITBLT.HCPYMODE 76181 .
|
||||
76803) (\BRUSHCONVERT.HCPYMODE 76805 . 77042) (\CHANGECHARSET.HCPYMODE 77044 . 78811) (
|
||||
\DASHINGCONVERT.HCPYMODE 78813 . 79076) (\CHARWIDTH.HCPYMODE 79078 . 79365) (\DRAWLINE.HCPYMODE 79367
|
||||
. 79679) (\DRAWCURVE.HCPYMODE 79681 . 80110) (\DRAWCIRCLE.HCPYMODE 80112 . 80507) (
|
||||
\DRAWELLIPSE.HCPYMODE 80509 . 81021) (\DSPFONT.HCPYMODE 81023 . 82179) (\DSPLEFTMARGIN.HCPYMODE 82181
|
||||
. 82765) (\DSPLINEFEED.HCPYMODE 82767 . 83177) (\DSPRIGHTMARGIN.HCPYMODE 83179 . 83808) (
|
||||
\DSPSPACEFACTOR.HCPYMODE 83810 . 84331) (\DSPXPOSITION.HCPYMODE 84333 . 84914) (\DSPYPOSITION.HCPYMODE
|
||||
84916 . 85321) (\MOVETO.HCPYMODE 85323 . 85475) (\FONTCREATE.HCPYMODE.PRESS 85477 . 86489) (
|
||||
\CREATECHARSET.HCPYMODE.PRESS 86491 . 87462) (\FONTCREATE.HCPYMODE.INTERPRESS 87464 . 88498) (
|
||||
\CREATECHARSET.HCPYMODE.INTERPRESS 88500 . 89488) (\STRINGWIDTH.HCPYMODE 89490 . 89924) (
|
||||
\HCPYMODEBLTCHAR 89926 . 92895) (\HCPYMODEDISPLAYINIT 92897 . 95828) (\HCPYMODEDSPPRINTCHAR 95830 .
|
||||
98011) (\SLOWHCPYMODEBLTCHAR 98013 . 101527) (\SFFixY.HCPYMODE 101529 . 103026)))))
|
||||
(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.
261
sources/HPRINT
261
sources/HPRINT
@@ -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.
105
sources/INSPECT
105
sources/INSPECT
@@ -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.
102
sources/JAPANESE
102
sources/JAPANESE
@@ -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.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Sep-2021 23:52:49"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;24 13993
|
||||
(FILECREATED "17-Oct-2021 18:00:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;29 13073
|
||||
|
||||
changes to%: (FNS PRINTFNDEF PFCOPYBYTES)
|
||||
changes to%: (VARS PRINTFNCOMS)
|
||||
(FNS PRINTFN)
|
||||
|
||||
previous date%: " 8-Aug-2021 15:15:00"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;17)
|
||||
previous date%: " 8-Oct-2021 00:20:48"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRINTFN.;28)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -17,12 +18,12 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(RPAQQ PRINTFNCOMS
|
||||
[(* * PRINTFN)
|
||||
(FNS PF PF* PMORE PRINTFN PRINTFNDEF FINDFNDEF PFCOPYBYTES DISPLAYP)
|
||||
(INITVARS PFDEFAULT (LASTFNDEF))
|
||||
(FNS PF PF* PRINTFN PRINTFNDEF FINDFNDEF PFCOPYBYTES DISPLAYP)
|
||||
(INITVARS (PFDEFAULT 'PFCOPYBYTES))
|
||||
(DECLARE%: DONTCOPY (MACROS PFPRINCHAR PFOUTCHAR))
|
||||
(P (MOVD? 'COPYBYTES 'PFCOPYBYTES))
|
||||
(USERMACROS PF)
|
||||
(GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
|
||||
(GLOBALVARS **COMMENT**FLG LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA PF* PF)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
@@ -86,21 +87,11 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(APPLY (FUNCTION PF)
|
||||
FN])
|
||||
|
||||
(PMORE
|
||||
[LAMBDA NIL (* lmm " 9-AUG-78 17:21")
|
||||
(* lmm "17-MAY-78 15:38")
|
||||
(PRINTFNDEF (CAR LASTFNDEF)
|
||||
T
|
||||
(CADDR LASTFNDEF)
|
||||
-1
|
||||
(CADDDR LASTFNDEF])
|
||||
|
||||
(PRINTFN
|
||||
[LAMBDA (FN FROMFILE TOFILE) (* lmm "14-Aug-84 14:16")
|
||||
[LAMBDA (FN FROMFILE TOFILE) (* ; "Edited 17-Oct-2021 18:00 by rmk:")
|
||||
(PROG ((LOC (FINDFNDEF FN FROMFILE)))
|
||||
(COND
|
||||
((LISTP LOC)
|
||||
(SETQ LASTFNDEF LOC)
|
||||
(PRINTFNDEF (CAR LOC)
|
||||
TOFILE
|
||||
(CADR LOC)
|
||||
@@ -112,36 +103,29 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(T (printout TOFILE FN " not found on " LOC "." T])
|
||||
|
||||
(PRINTFNDEF
|
||||
[LAMBDA (SRCFIL DSTFIL START END TYPE) (* ; "Edited 28-Sep-2021 23:52 by rmk:")
|
||||
[LAMBDA (SRCFIL DSTFIL START END TYPE) (* ; "Edited 7-Oct-2021 20:51 by rmk:")
|
||||
|
||||
(* ;; "RMK: It wasn't clear what PFDEFAULT was doing, or why. I've assigned it a meaning here: the name of the function to call to print a function on a display stream. Initialized to PFCOPYBYTES")
|
||||
|
||||
(RESETLST
|
||||
(PROG (TEM)
|
||||
[COND
|
||||
((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T))
|
||||
(SETQ DSTFIL TEM))
|
||||
(T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
[COND
|
||||
((SETQ TEM (GETSTREAM SRCFIL 'INPUT T))
|
||||
(RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM)))
|
||||
(SETQ SRCFIL TEM))
|
||||
(T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
(PRIN1 "{from " DSTFIL)
|
||||
(PRIN2 (FULLNAME SRCFIL)
|
||||
DSTFIL T)
|
||||
(PRIN1 "}
|
||||
" DSTFIL))
|
||||
|
||||
(* ;; "RMK: Originally the last test was (EQ TYPE 'MAC). I think this was a typo for MAP, since that argument is set to MAP in FINDFNDEF. If the typo is fixed, we would end up in the COPYBYTES clause, which we don't generally want. So changed it also to a NEQ.")
|
||||
|
||||
(* ;; "PFDEFAULT is passed as the TYPE argument on the call from COPYALLBYTES, basically to force COPYBYTES and not do the format and font translations. It defaults to NIL, not COPYBYTES. I don't understand what this is trying to control. Note that the last argument of PFCOPYBYTES (PFDEFAULT here) is ignored.")
|
||||
|
||||
(COND
|
||||
((OR (NOT (DISPLAYP DSTFIL))
|
||||
(EQ PFDEFAULT 'COPYBYTES)
|
||||
(NEQ TYPE 'MAP))
|
||||
(COPYBYTES SRCFIL DSTFIL START END))
|
||||
(T (PFCOPYBYTES SRCFIL DSTFIL START END PFDEFAULT)))
|
||||
(LET (TEM)
|
||||
[COND
|
||||
((SETQ TEM (GETSTREAM DSTFIL 'OUTPUT T))
|
||||
(SETQ DSTFIL TEM))
|
||||
(T (RESETSAVE (SETQ DSTFIL (OPENSTREAM DSTFIL 'OUTPUT))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
[COND
|
||||
((SETQ TEM (GETSTREAM SRCFIL 'INPUT T))
|
||||
(RESETSAVE NIL (LIST 'SETFILEPTR TEM (GETFILEPTR TEM)))
|
||||
(SETQ SRCFIL TEM))
|
||||
(T (RESETSAVE (SETQ SRCFIL (OPENSTREAM SRCFIL 'INPUT))
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
(PRINTOUT DSTFIL "{from " .P2 (FULLNAME SRCFIL)
|
||||
"}" T))
|
||||
(APPLY* (CL:IF (DISPLAYP DSTFIL)
|
||||
PFDEFAULT
|
||||
(FUNCTION COPYBYTES))
|
||||
SRCFIL DSTFIL START END)
|
||||
(TERPRI DSTFIL))])
|
||||
|
||||
(FINDFNDEF
|
||||
@@ -168,11 +152,11 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(T FULL])
|
||||
|
||||
(PFCOPYBYTES
|
||||
[LAMBDA (SRCFIL DSTFIL START END FLG) (* ; "Edited 28-Sep-2021 23:35 by rmk:")
|
||||
[LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 8-Oct-2021 00:17 by rmk:")
|
||||
(* ; "Edited 24-Mar-93 14:16 by rmk:")
|
||||
(* lmm "28-Sep-86 14:38")
|
||||
|
||||
(* ;; "RMK: What does FLG do? It isn't referenced. It seems to be passed as the value of PFDEFAULT from PRINTFNDEF, and that variable is initialized to NIL. Remove both, eventually?")
|
||||
(* ;; "RMK: What does FLG do? It isn't referenced. It seems to be passed as the value of PFDEFAULT from PRINTFNDEF, and that variable is initialized to NIL. I'm removing it.")
|
||||
|
||||
(* ;; " copy from SRCFIL to DSTFIL, paying attention to font changes. Other stuff about truncating lines gone away. Interprets all possible EOL conventions as EOL. Has to call \INCHAR-\INCCODE macros in order to keep track of character count--READDCODE doesn't do that.")
|
||||
|
||||
@@ -241,9 +225,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(IMAGESTREAMTYPEP STRM 'TEXT])
|
||||
)
|
||||
|
||||
(RPAQ? PFDEFAULT NIL)
|
||||
|
||||
(RPAQ? LASTFNDEF )
|
||||
(RPAQ? PFDEFAULT 'PFCOPYBYTES)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -283,7 +265,7 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(ADDTOVAR EDITCOMSA PF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
|
||||
(GLOBALVARS **COMMENT**FLG LASTWORD PFDEFAULT FILERDTBL USEMAPFLG)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
@@ -295,7 +277,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1134 11871 (PF 1144 . 3839) (PF* 3841 . 4135) (PMORE 4137 . 4456) (PRINTFN 4458 . 5049)
|
||||
(PRINTFNDEF 5051 . 6790) (FINDFNDEF 6792 . 7816) (PFCOPYBYTES 7818 . 11621) (DISPLAYP 11623 . 11869))
|
||||
)))
|
||||
(FILEMAP (NIL (1145 10976 (PF 1155 . 3850) (PF* 3852 . 4146) (PRINTFN 4148 . 4718) (PRINTFNDEF 4720 .
|
||||
5903) (FINDFNDEF 5905 . 6929) (PFCOPYBYTES 6931 . 10726) (DISPLAYP 10728 . 10974)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
sources/SPP.LCOM
BIN
sources/SPP.LCOM
Binary file not shown.
Reference in New Issue
Block a user