Compare commits
66 Commits
medley-211
...
medley-220
| Author | SHA1 | Date | |
|---|---|---|---|
|
66091a2375 | ||
|
|
fe90ac5f9f | ||
|
|
b791bff070 | ||
|
|
ab8e97ff7b | ||
|
f8e4bbd7cb | ||
|
c7272e78f2 | ||
|
|
f531e89dde | ||
|
|
293c973f1d | ||
|
|
fe62e8e6e2 | ||
|
|
51f0c19ad1 | ||
|
|
1438ddba1f | ||
|
|
ae3851ccf9 | ||
|
|
e3f9a4ca9a | ||
|
|
7966704f1e | ||
|
|
311e4f049c | ||
|
|
e119314a9e | ||
|
|
27d4df45e6 | ||
|
|
312e99b0f4 | ||
|
|
82eaacc542 | ||
|
|
479de87011 | ||
|
|
5445a12b7e | ||
|
|
fadf81012b | ||
|
|
792edfdad5 | ||
|
fd2e5ed93e | ||
|
|
e3e9156452 | ||
|
|
f0feca759b | ||
|
|
5fadc6c083 | ||
|
|
2dcfac5350 | ||
|
|
dcd83c3753 | ||
|
|
cde5c9018d | ||
|
|
1108a00b90 | ||
|
|
d9e445ad8c | ||
|
|
5b690d39d1 | ||
|
2573e4351f | ||
|
|
936bdd84b5 | ||
|
|
c2915bf5d3 | ||
|
|
40c10a7841 | ||
|
|
362fac9389 | ||
|
|
db082b37e1 | ||
|
|
c0e020f033 | ||
|
|
9af86df169 | ||
|
|
6c26fe958a | ||
|
|
339bd47107 | ||
|
|
3a04303d93 | ||
|
|
68f1e7efe1 | ||
|
|
993bdb2e00 | ||
|
7a27c26f01 | ||
|
|
75a031de39 | ||
|
|
7d656006a6 | ||
|
|
1f8c123184 | ||
|
|
50ce484c1b | ||
|
|
e3f043b40d | ||
|
|
945df5fbe8 | ||
|
|
3d8066b7e8 | ||
|
|
b303e0affa | ||
|
|
869b3a2e32 | ||
|
|
f19d9cc5e2 | ||
|
|
237f3aa6bf | ||
|
|
89a8fe183d | ||
|
|
8266980c22 | ||
|
|
c385039c42 | ||
|
|
1ff0018772 | ||
|
|
6611f96702 | ||
|
|
824e0f20b2 | ||
|
|
d479ef2ef9 | ||
|
|
98aa15455e |
8
.github/workflows/buildDocker.yml
vendored
8
.github/workflows/buildDocker.yml
vendored
@@ -50,6 +50,8 @@ jobs:
|
||||
echo ::set-output name=docker_image::${DOCKER_IMAGE}
|
||||
echo ::set-output name=build_time::$(date -u +'%Y-%m-%dT%H:%M:%SZ')
|
||||
echo ::set-output name=version::${VERSION}
|
||||
echo ::set-output name=maiko_release::${MAIKO_RELEASE}
|
||||
echo ::set-output name=medley_release::${MEDLEY_RELEASE}
|
||||
|
||||
# Download Medley Release Assets
|
||||
- name: Download Release Assets
|
||||
@@ -103,4 +105,8 @@ jobs:
|
||||
# Push the created image
|
||||
push: true
|
||||
# tags to assign to the Docker image
|
||||
tags: ${{ steps.prep.outputs.tags }}
|
||||
tags: ${{ steps.prep.outputs.tags }}
|
||||
build-args: |
|
||||
medley_release=${{steps.prep.outputs.medley_release}}
|
||||
maiko_release=${{steps.prep.outputs.maiko_release}}
|
||||
build_date=${{steps.prep.outputs.build_time}}
|
||||
|
||||
2
.github/workflows/buildLoadup.yml
vendored
2
.github/workflows/buildLoadup.yml
vendored
@@ -103,4 +103,4 @@ jobs:
|
||||
tag: ${{ env.tag }}
|
||||
draft: true
|
||||
bodyfile: tmp/release-notes.md
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
token: ${{ secrets.GITHUB_TOKEN }}
|
||||
|
||||
15
Dockerfile
15
Dockerfile
@@ -1,20 +1,25 @@
|
||||
FROM ubuntu:focal
|
||||
ARG BUILD_DATE
|
||||
ARG build_date
|
||||
ARG medley_release
|
||||
ARG maiko_release
|
||||
LABEL name="Medley"
|
||||
# LABEL tags=${tags}
|
||||
LABEL description="The Medley Interlisp environment"
|
||||
LABEL url="https://github.com/Interlisp/medley"
|
||||
LABEL build-time=$BUILD_DATE
|
||||
LABEL build-time=$build_date
|
||||
ENV BUILD_DATE=$build_date
|
||||
ENV MEDLEY_RELEASE=$medley_release
|
||||
ENV MAIKO_RELEASE=$maiko_release
|
||||
|
||||
RUN apt-get update && apt-get install -y tightvncserver
|
||||
|
||||
EXPOSE 5900
|
||||
|
||||
# Copy and uncompress loadup and required source files.
|
||||
ADD *.tgz /app
|
||||
ADD *.tgz /home
|
||||
|
||||
WORKDIR /app/medley
|
||||
WORKDIR /home/medley
|
||||
|
||||
RUN adduser --disabled-password --gecos "" medley
|
||||
USER medley
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 PATH="/app/maiko:$PATH" ./run-medley -full -g 1280x720 -sc 1280x720
|
||||
ENTRYPOINT USER=medley Xvnc -geometry 1280x720 :0 & DISPLAY=:0 PATH="/app/maiko:$PATH" ./run-medley -full -g 1280x720 -sc 1280x720
|
||||
|
||||
@@ -14,7 +14,7 @@ There (soon) will also be Docker containers with the latest, and a way to try ou
|
||||
|
||||
### 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.)
|
||||
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.
|
||||
|
||||
@@ -99,7 +99,7 @@ Or from the Common Lisp prompt with:
|
||||
```
|
||||
(IL:LOGOUT)
|
||||
```
|
||||
When you logout of the system, Medley automatically creates a binary
|
||||
When you log out of the system, Medley automatically creates a binary
|
||||
dump of your system located in your home directory named
|
||||
`lisp.virtualmem`. The next time you run the system, if you don't
|
||||
specify a specific image to run, Medley restores that image so that
|
||||
|
||||
Binary file not shown.
@@ -1,18 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Nov-2021 22:34:49" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;2 2303
|
||||
(FILECREATED " 2-Dec-2021 21:13:55" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;3 2392
|
||||
|
||||
changes to%: (VARS MEDLEYDIR-INITCOMS)
|
||||
(FNS INTERLISPMODE)
|
||||
|
||||
previous date%: "14-Nov-2021 22:10:37" {DSK}<home>larry>medley>greetfiles>medleydir-INIT.;1)
|
||||
previous date%: "14-Nov-2021 22:34:49" {DSK}<home>larry>medley>greetfiles>MEDLEYDIR-INIT.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIR-INITCOMS)
|
||||
|
||||
(RPAQQ MEDLEYDIR-INITCOMS
|
||||
((P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
([P (LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM")))
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
(MEDLEY-INIT-VARS)
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
|
||||
(FILES BACKGROUND-YIELD)
|
||||
(VARS (FILING.ENUMERATION.DEPTH 1)
|
||||
[LOGINDIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
@@ -20,13 +23,16 @@
|
||||
[USERGREETFILES `((,LOGINDIR "INIT" COM)
|
||||
(,LOGINDIR "INIT"]
|
||||
(COPYRIGHTSRESERVED NIL))
|
||||
[P (KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE]
|
||||
(FNS INTERLISPMODE)))
|
||||
|
||||
(LOAD? (CONCAT (OR (UNIX-GETENV "MEDLEYDIR")
|
||||
"")
|
||||
"/sources/MEDLEYDIR.LCOM"))
|
||||
|
||||
(MEDLEY-INIT-VARS)
|
||||
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
|
||||
|
||||
(FILESLOAD BACKGROUND-YIELD)
|
||||
|
||||
(RPAQQ FILING.ENUMERATION.DEPTH 1)
|
||||
@@ -38,8 +44,6 @@
|
||||
(,LOGINDIR "INIT")))
|
||||
|
||||
(RPAQQ COPYRIGHTSRESERVED NIL)
|
||||
|
||||
(KEYACTION 'LOCK '(LOCKTOGGLE . IGNORE))
|
||||
(DEFINEQ
|
||||
|
||||
(INTERLISPMODE
|
||||
@@ -56,5 +60,5 @@
|
||||
:PACKAGE "INTERLISP"])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1455 2280 (INTERLISPMODE 1465 . 2278)))))
|
||||
(FILEMAP (NIL (1544 2369 (INTERLISPMODE 1554 . 2367)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,43 +1,41 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;14| 9472
|
||||
(FILECREATED "26-Dec-2021 18:58:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2| 9049
|
||||
|
||||
|changes| |to:| (VARS MEDLEY-UTILSCOMS)
|
||||
(FNS GATHER-INFO)
|
||||
:CHANGES-TO (FNS GATHER-INFO)
|
||||
|
||||
|previous| |date:| "23-Oct-2021 14:53:16"
|
||||
|{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;2|)
|
||||
:PREVIOUS-DATE "25-Oct-2021 14:54:43" |{DSK}<home>larry>medley>internal>library>MEDLEY-UTILS.;1|
|
||||
)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS ((FNS GATHER-INFO MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
|
||||
(VARS MEDLEY-FIX-DIRS)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH)))
|
||||
(DEFINEQ
|
||||
|
||||
(GATHER-INFO
|
||||
(LAMBDA (PHASE) (* \;
|
||||
"Edited 24-Oct-2021 09:43 by larry")
|
||||
"Edited 26-Dec-2021 18:56 by larry")
|
||||
(* \;
|
||||
"Edited 24-Oct-2021 09:43 by larry")
|
||||
(SELECTQ PHASE
|
||||
(ALL (SETQ SYSFILES (UNION SYSFILES FILELST))
|
||||
(SETQ FILELST NIL)
|
||||
(FILESLOAD (SOURCE)
|
||||
SYSEDIT)
|
||||
(|for| I |from| 1 |to| 4 |do| (GATHER-INFO I)))
|
||||
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD
|
||||
X
|
||||
'NAME)))
|
||||
(ALL (|for| I |from| 0 |to| 4 |do| (GATHER-INFO I)))
|
||||
(0 (SETQ SYSFILES (UNION SYSFILES FILELST))
|
||||
(SETQ FILELST NIL)
|
||||
(FILESLOAD (SOURCE)
|
||||
SYSEDIT))
|
||||
(1 (SETQ LOADEDFILES (|for| X |in| LOADEDFILELST |collect| (FILENAMEFIELD X 'NAME)))
|
||||
(FILESLOAD FILESETS)
|
||||
(SETQ ALLFILESETSFILES (|for| X |in| FILESETS |join| (APPEND (EVAL X))))
|
||||
(SETQ SOURCES (|for| X |in| (DIRECTORY (MEDLEYDIR "sources" "*.*;" T))
|
||||
|when| (NOT (MEMB (FILENAMEFIELD X 'EXTENSION)
|
||||
'(LCOM DFASL TEDIT TXT)))
|
||||
'(LCOM DFASL TEDIT TXT)))
|
||||
|collect| (FILENAMEFIELD X 'NAME))))
|
||||
(-1 (PRINTOUT T " loaded files not in SYSFILES or FILELST: "
|
||||
(|for| X |in| LOADEDFILES |when| (NOT (OR (FMEMB X SYSFILES)
|
||||
(FMEMB X FILELST)))
|
||||
|collect| X)
|
||||
(FMEMB X FILELST))) |collect| X)
|
||||
T)
|
||||
(PRINTOUT T "Sources not loaded: " (CL:SET-DIFFERENCE SOURCES (APPEND ALLFILESETSFILES
|
||||
LOADEDFILES))
|
||||
@@ -52,50 +50,45 @@
|
||||
DEFD))
|
||||
(|for| X |in| DEFINEDFNS |when| (CCODEP X)
|
||||
|do| (LET ((Y (PUTPROP X 'CCC (CALLSCCODE X))))
|
||||
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|
||||
|as| VAL |in| Y
|
||||
|do| (|for| S |in| VAL
|
||||
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
|
||||
(|for| REV |in| '(BLOCK-CALLED-BY CALLED-BY SPECIAL-BY GLOBAL-BY)
|
||||
|as| VAL |in| Y |do| (|for| S |in| VAL
|
||||
|do| (PUTPROP S REV (CONS X (GETPROP S REV)))))))
|
||||
(SETQ CALLEDFNS NIL)
|
||||
(MAPATOMS (FUNCTION (LAMBDA (X)
|
||||
(|if| (AND (NOT (GETD X))
|
||||
(GETPROP X 'CALLED-BY))
|
||||
(GETPROP X 'CALLED-BY))
|
||||
|then| (CL:PUSH X CALLEDFNS))))))
|
||||
(-2 (PRINTOUT T "Functions called and not defined" CALLEDFNS T))
|
||||
(3 (|for| X |in| SYSFILES
|
||||
|do|
|
||||
(LOAD X 'PROP)
|
||||
(PUTPROP X 'CONTENT (READFILE X))
|
||||
(|for| EXR |in| (GETPROP X 'CONTENT)
|
||||
|do| (SELECTQ (CAR EXR)
|
||||
(DEFINEQ (|for| DFN |in| (CDR EXR)
|
||||
|do| (|if| (EQUAL (CADR DFN)
|
||||
(GETPROP (CAR DFN)
|
||||
'EXPR))
|
||||
|then| (PRINTOUT T (CAR DFN)
|
||||
" ")
|
||||
(PUTPROP (CAR DFN)
|
||||
'EXPR
|
||||
(CADR DFN))
|
||||
|else| (PRINTOUT T (CAR DFN)
|
||||
"* "))))
|
||||
NIL)))
|
||||
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP
|
||||
X
|
||||
'CONTENT))))
|
||||
|do| (LOAD X 'PROP)
|
||||
(PUTPROP X 'CONTENT (READFILE X))
|
||||
(|for| EXR |in| (GETPROP X 'CONTENT)
|
||||
|do| (SELECTQ (CAR EXR)
|
||||
(DEFINEQ (|for| DFN |in| (CDR EXR)
|
||||
|do| (|if| (EQUAL (CADR DFN)
|
||||
(GETPROP (CAR DFN)
|
||||
'EXPR))
|
||||
|then| (PRINTOUT T (CAR DFN)
|
||||
" ")
|
||||
(PUTPROP (CAR DFN)
|
||||
'EXPR
|
||||
(CADR DFN))
|
||||
|else| (PRINTOUT T (CAR DFN)
|
||||
"* "))))
|
||||
NIL)))
|
||||
(SETQ ALLCONTENT (|for| X |in| SYSFILES |collect| (CONS X (GETPROP X 'CONTENT))))
|
||||
(* \; " don't edit with SEDIT")
|
||||
(LET (DUPS)
|
||||
(|for| X |in| SYSFILES
|
||||
|do| (|for| FN |in| (FILEFNSLST X)
|
||||
|do| (|if| (GETPROP FN 'WHEREIS)
|
||||
|then| (NCONC1 (GETPROP FN 'WHEREIS)
|
||||
X)
|
||||
(OR (FMEMB FN DUPS)
|
||||
(SETQ DUPS (CONS FN DUPS)))
|
||||
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
|
||||
|do| (|if| (GETPROP FN 'WHEREIS)
|
||||
|then| (NCONC1 (GETPROP FN 'WHEREIS)
|
||||
X)
|
||||
(OR (FMEMB FN DUPS)
|
||||
(SETQ DUPS (CONS FN DUPS)))
|
||||
|else| (PUTPROP FN 'WHEREIS (LIST X)))))
|
||||
(SETQ DUPFNS DUPS))
|
||||
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR))
|
||||
|collect| X)))
|
||||
(SETQ NO-SOURCE (|for| X |in| DEFINEDFNS |when| (NOT (GETPROP X 'EXPR)) |collect| X)))
|
||||
(-3 (PRINTOUT T "Functions compiled but no expr" NO-SOURCE T)
|
||||
(PRINTOUT T "Functions on more than one file: " DUPFNS T))
|
||||
(4 (PRINTOUT T T "STARTING MASTERSCOPE PHASE ON " (DATE)
|
||||
@@ -104,7 +97,7 @@
|
||||
SYSEDIT)
|
||||
(|for| X |in| SYSFILES |do| (MSNOTICEFILE X))
|
||||
(|for| X |in| SYSFILES |do| (PRINTOUT T T "Analyzing " X T)
|
||||
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
|
||||
(MASTERSCOPE `(ANALYZE ON ,(KWOTE X)))))
|
||||
(-4 "No queries yet")
|
||||
(HELP))))
|
||||
|
||||
@@ -124,7 +117,7 @@
|
||||
)
|
||||
|
||||
(RPAQQ MEDLEY-FIX-DIRS ("sources" "library" "lispusers" "internal/library" "greetfiles"
|
||||
"docs>Documentation Tools"))
|
||||
"docs>Documentation Tools"))
|
||||
(DEFINEQ
|
||||
|
||||
(MAKE-EXPORTS-ALL
|
||||
@@ -157,6 +150,6 @@
|
||||
(DRIBBLE))))
|
||||
)
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (618 7420 (GATHER-INFO 628 . 6522) (MEDLEY-FIX-LINKS 6524 . 7047) (MEDLEY-FIX-DATES 7049
|
||||
. 7418)) (7578 9449 (MAKE-EXPORTS-ALL 7588 . 8604) (MAKE-WHEREIS-HASH 8606 . 9447)))))
|
||||
(FILEMAP (NIL (553 7001 (GATHER-INFO 563 . 6103) (MEDLEY-FIX-LINKS 6105 . 6628) (MEDLEY-FIX-DATES 6630
|
||||
. 6999)) (7155 9026 (MAKE-EXPORTS-ALL 7165 . 8181) (MAKE-WHEREIS-HASH 8183 . 9024)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,91 +0,0 @@
|
||||
;; Function To Be Tested: LIST*
|
||||
;;
|
||||
;; Source: Guy L Steele's CLTL
|
||||
;; Section: 15.2 Lists
|
||||
;; Page: 267
|
||||
;;
|
||||
;; Created By: Kelly Roach
|
||||
;;
|
||||
;; Creation Date: June 27,1986
|
||||
;;
|
||||
;; Last Update: June 27,1986
|
||||
;; July 15, 1986 Sye/ create test cases
|
||||
;;
|
||||
;; Filed As: {ERIS}<LISPCORE>CML>TEST>15-2-LIST*.TEST
|
||||
;;
|
||||
;;
|
||||
;; Syntax: (LIST* ARG &REST OTHERS)
|
||||
;;
|
||||
;; Function Description:
|
||||
;; LIST* is like LIST except that the last CONS
|
||||
;; of the constructed list is ``dotted.'' The last argument to LIST*
|
||||
;; is used as the CDR of the last cons constructed;
|
||||
;; this need not be an atom. If it is not an atom,
|
||||
;; then the effect is to add several new elements to the front of a list.
|
||||
;; For example:
|
||||
;;
|
||||
;; (LIST* 'A 'B 'C 'D) => (A B C . D)
|
||||
;; This is like
|
||||
;; (CONS 'A (CONS 'B (CONS 'C 'D)))
|
||||
;; Also:
|
||||
;; (LIST* 'A 'B 'C '(D E F)) => (A B C D E F)
|
||||
;; (LIST* X) = X
|
||||
;;
|
||||
;;
|
||||
;; Argument(s): ARG - anything
|
||||
;; OTHERS - anything
|
||||
;;
|
||||
;; Returns: a dotted list
|
||||
;;
|
||||
(do-test "test list*0 - test case copied from page 267 of CLtL"
|
||||
(and (EQUAL (LIST* 'A 'B 'C 'D) '(A B C . D))
|
||||
(EQUAL (LIST* 'A 'B 'C '(D E F)) '(A B C D E F))
|
||||
(EQUAL (LIST* 'X) 'X)
|
||||
)
|
||||
)
|
||||
|
||||
(do-test "test list*1"
|
||||
(and (equal (list* 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999
|
||||
999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999 999)
|
||||
(append (make-list 48 :initial-element 999) '(999 . 999)))
|
||||
|
||||
(equal (list* "evening" 'sun 'reflected "in Lake" 'Shanti) '("evening" sun reflected "in Lake" . Shanti))
|
||||
)
|
||||
)
|
||||
|
||||
(do-test "test list*2"
|
||||
(equal (list* 1.009 'a (cons 3 4) (funcall #'list* 2.009 #\g "string") (every #'evenp '(2 4 6 8)) (not (or 1 100 1000 0))
|
||||
(apply #'list* 'm 'n 'b '(88)) (list* (+ 2 3) (caddr '(w x y z))) )
|
||||
'(1.009 a (3 . 4) (2.009 #\g . "string") t nil (m n b . 88) 5 . y)))
|
||||
|
||||
(do-test "test list*3"
|
||||
(progn
|
||||
(setq aa '(a b c d e f g h))
|
||||
(equal (list* (last aa) (nth 3 aa) (nthcdr 5 aa) (list* (car aa) (endp aa))
|
||||
(progn 1 2 3 (setq x 1 y 2 z 3))
|
||||
(prog2 (defun fun () "fun1") (fun))
|
||||
(prog1 (setq a 100) (setq a (1+ a)))
|
||||
(progn (defmacro mac () `(list* ,(* 2 2) ,(list-length ()))) (mac)))
|
||||
'( (h) d (f g h) (a . nil) 3 "fun1" 100 4 . 0)) ))
|
||||
|
||||
(do-test "test list*4 - nested list* functions"
|
||||
(and
|
||||
(equal (setq aa (list* (list* (list* (list* (list* (list* (list* (list* (list* (list* 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k)))))))))))
|
||||
'(a b c d e f g h i j . k) )
|
||||
(equal (list* aa aa aa aa aa)
|
||||
'((a b c d e f g h i j . k) (a b c d e f g h i j . k) (a b c d e f g h i j . k) (a b c d e f g h i j . k)
|
||||
a b c d e f g h i j . k) )
|
||||
)
|
||||
)
|
||||
|
||||
(do-test "test list*5 - (list* x) is equivalent to x [page 268]"
|
||||
(and (eq (list* ()) ())
|
||||
(eq (list* 10) 10)
|
||||
(equal (list* '(1)) '(1))
|
||||
(equal (list* (list* (list 2))) '(2))
|
||||
(prog2 (setq a (list* #'-)) (= (funcall a 4 3 2 1) -2))
|
||||
(equal (list* (list (list* 1 2 3) '(4) ) '(5 . "a")) '(((1 2 . 3) (4)) 5 . "a"))
|
||||
)
|
||||
)
|
||||
|
||||
STOP
|
||||
1193
library/FILEBROWSER
1193
library/FILEBROWSER
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -1,10 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED "18-Aug-2021 12:13:11" {DSK}<home>larry>medley>library>MSANALYZE.;5 62745
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS MSPRGMACRO MSFINDP)
|
||||
(VARS MSMACROPROPS)
|
||||
(FILECREATED "26-Dec-2021 10:10:02" {DSK}<home>larry>medley>library>MSANALYZE.;6 62468
|
||||
|
||||
previous date%: "18-Aug-2021 10:56:25" {DSK}<home>larry>medley>library>MSANALYZE.;4)
|
||||
:CHANGES-TO (FNS MSPRGTEMPLATE)
|
||||
|
||||
:PREVIOUS-DATE "18-Aug-2021 12:13:11" {DSK}<home>larry>medley>library>MSANALYZE.;5)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -269,7 +269,7 @@ DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS MSVBNOTICED MACRO [OPENLAMBDA (VERB MOD)
|
||||
(CDR (ASSOC MOD (CDR (ASSOC VERB MS.VERB.TO.NOTICED])
|
||||
(CDR (ASSOC MOD (CDR (ASSOC VERB MS.VERB.TO.NOTICED])
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -752,19 +752,18 @@ DONTCOPY
|
||||
(CDR TEMPLATE])
|
||||
|
||||
(MSPRGTEMPLATE
|
||||
(LAMBDA (PARENT TEMPLATE PARENTCONTEXT) (* lmm "23-Jul-86 00:15")
|
||||
(BLOCK) (*
|
||||
"Masterscope should block every once and a while. This is one place to do it.")
|
||||
[LAMBDA (PARENT TEMPLATE PARENTCONTEXT) (* ; "Edited 26-Dec-2021 10:09 by larry")
|
||||
(* lmm "23-Jul-86 00:15")
|
||||
(PROG ((VARS VARS)
|
||||
TEM)
|
||||
(COND
|
||||
((EQ TEMPLATE 'MACRO)
|
||||
[(EQ TEMPLATE 'MACRO)
|
||||
(COND
|
||||
((SETQ TEM (GETMACROPROP (CAR PARENT)
|
||||
MSMACROPROPS))
|
||||
(MSPRGMACRO PARENT TEM))
|
||||
(T (MSPRGTEMPLATE1 PARENT '(CALL .. EVAL)))))
|
||||
(T (MSPRGTEMPLATE1 PARENT TEMPLATE))))))
|
||||
(T (MSPRGTEMPLATE1 PARENT '(CALL |..| EVAL]
|
||||
(T (MSPRGTEMPLATE1 PARENT TEMPLATE])
|
||||
|
||||
(MSPRGLAMBDA
|
||||
[LAMBDA (EXPR FLG TYPE) (* ; "Edited 3-Jun-88 10:23 by jrb:")
|
||||
@@ -1036,22 +1035,21 @@ DONTCOPY
|
||||
|
||||
(RPAQQ MSRECORDTRANFLG NIL)
|
||||
|
||||
(ADDTOVAR INVISIBLEVARS $$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 $$11 $$12 $$13 $$14 $$15 $$16
|
||||
$$17)
|
||||
(ADDTOVAR INVISIBLEVARS $$1 $$2 $$3 $$4 $$5 $$6 $$7 $$8 $$9 $$10 $$11 $$12 $$13 $$14 $$15 $$16 $$17)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS INCLISP MACRO ((.X.)
|
||||
(COND
|
||||
((AND INCLISP EACHTIME (NOT (MSFINDP INCLISP .X.)))
|
||||
INCLISP)
|
||||
(T .X.))))
|
||||
(COND
|
||||
((AND INCLISP EACHTIME (NOT (MSFINDP INCLISP .X.)))
|
||||
INCLISP)
|
||||
(T .X.))))
|
||||
|
||||
(PUTPROPS LTEMPLATE MACRO [LAMBDA (Y)
|
||||
(DECLARE (LOCALVARS Y))
|
||||
(AND [NEQ T (SETQ Y (OR (GETHASH Y USERTEMPLATES)
|
||||
(GETHASH Y MSTEMPLATES]
|
||||
Y])
|
||||
(DECLARE (LOCALVARS Y))
|
||||
(AND [NEQ T (SETQ Y (OR (GETHASH Y USERTEMPLATES)
|
||||
(GETHASH Y MSTEMPLATES]
|
||||
Y])
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
|
||||
@@ -1265,10 +1263,10 @@ DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
(PUTPROPS LTEMPLATE MACRO [LAMBDA (Y)
|
||||
(DECLARE (LOCALVARS Y))
|
||||
(AND [NEQ T (SETQ Y (OR (GETHASH Y USERTEMPLATES)
|
||||
(GETHASH Y MSTEMPLATES]
|
||||
Y])
|
||||
(DECLARE (LOCALVARS Y))
|
||||
(AND [NEQ T (SETQ Y (OR (GETHASH Y USERTEMPLATES)
|
||||
(GETHASH Y MSTEMPLATES]
|
||||
Y])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -1288,11 +1286,11 @@ DONTCOPY
|
||||
)
|
||||
(PUTPROPS MSANALYZE COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1988 1990 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3820 11339 (VARS 3830 . 3971) (FREEVARS 3973 . 4126) (CALLS 4128 . 10469) (
|
||||
COLLECTFNDATA 10471 . 10850) (CALLS3 10852 . 11337)) (13596 52783 (ALLCALLS 13606 . 14285) (
|
||||
MSINITFNDATA 14287 . 14531) (MSPRGE 14533 . 21607) (MSPRGMACRO 21609 . 22205) (MSPRGCALL 22207 . 22531
|
||||
) (MSBINDVAR 22533 . 23052) (MSPRGRECORD 23054 . 29967) (MSPRGERR 29969 . 30137) (MSPRGTEMPLATE1 30139
|
||||
. 39300) (MSPRGTEMPLATE 39302 . 39982) (MSPRGLAMBDA 39984 . 49579) (MSPRGLST 49581 . 49749) (ADDTO
|
||||
49751 . 50542) (NLAMBDAFNP 50544 . 51296) (MSPRGDWIM 51298 . 52117) (MSDWIMTRAN 52119 . 52781)) (62109
|
||||
62541 (MSFINDP 62119 . 62539)))))
|
||||
(FILEMAP (NIL (3759 11278 (VARS 3769 . 3910) (FREEVARS 3912 . 4065) (CALLS 4067 . 10408) (
|
||||
COLLECTFNDATA 10410 . 10789) (CALLS3 10791 . 11276)) (13527 52635 (ALLCALLS 13537 . 14216) (
|
||||
MSINITFNDATA 14218 . 14462) (MSPRGE 14464 . 21538) (MSPRGMACRO 21540 . 22136) (MSPRGCALL 22138 . 22462
|
||||
) (MSBINDVAR 22464 . 22983) (MSPRGRECORD 22985 . 29898) (MSPRGERR 29900 . 30068) (MSPRGTEMPLATE1 30070
|
||||
. 39231) (MSPRGTEMPLATE 39233 . 39834) (MSPRGLAMBDA 39836 . 49431) (MSPRGLST 49433 . 49601) (ADDTO
|
||||
49603 . 50394) (NLAMBDAFNP 50396 . 51148) (MSPRGDWIM 51150 . 51969) (MSDWIMTRAN 51971 . 52633)) (61832
|
||||
62264 (MSFINDP 61842 . 62262)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED " 4-May-92 13:10:53" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3| 23489
|
||||
|
||||
|changes| |to:| (TEMPLATES CL:DECF CL:INCF CL:PUSH)
|
||||
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
|
||||
|
||||
|previous| |date:| "12-Jun-90 10:17:31" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;2|)
|
||||
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
|
||||
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
|
||||
)
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
(VARS MSCOMMONCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MSCOMMONCOMS)
|
||||
|
||||
@@ -37,8 +42,8 @@
|
||||
CL:STRING-LESSP CL:STRING-NOT-EQUAL CL:STRING-NOT-GREATERP CL:STRING-NOT-LESSP
|
||||
CL:STRING-UPCASE CL:STRING/= CL:STRING< CL:STRING<= CL:STRING= CL:STRING> CL:STRING>=
|
||||
CL:SUBLIS CL:SUBSETP CL:SUBST CL:SUBST-IF CL:SUBST-IF-NOT CL:SUBSTITUTE
|
||||
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:VECTOR-PUSH
|
||||
CL:VECTOR-PUSH-EXTEND WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
|
||||
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:UNLESS CL:VECTOR-PUSH
|
||||
CL:VECTOR-PUSH-EXTEND CL:WHEN WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
|
||||
(P
|
||||
(* |;;| "First tell Masterscope how to find FUNCTIONS and VARIABLES")
|
||||
|
||||
@@ -46,7 +51,7 @@
|
||||
(MSADDANALYZE 'FUNCTIONS 'FUNCTION 'FUNCTIONS 'FUNCTIONSMSGETDEF 'FUNCTIONSMSMC)
|
||||
|
||||
(* |;;|
|
||||
"Then add KEYWORD support. Templates may now contain the following as their last element:")
|
||||
"Then add KEYWORD support. Templates may now contain the following as their last element:")
|
||||
|
||||
|
||||
(* |;;| "... KEYWORDS list of keywords accepted)")
|
||||
@@ -65,7 +70,7 @@
|
||||
(MSADDMODIFIER 'SPECIFY 'KEYWORDS 'KEYSPECIFY)
|
||||
|
||||
(* |;;|
|
||||
"Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
|
||||
"Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
|
||||
|
||||
(MSADDRELATION '(FLET FLETS FLETTING FLET))
|
||||
(MSADDRELATION '(LABEL LABELS LABELLING LABELLED))
|
||||
@@ -87,42 +92,48 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FUNCTIONSMSGETDEF
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
|
||||
(LET ((BODY (REMOVE-COMMENTS (GETDEF NAME 'FUNCTIONS SOURCE OPTIONS))))
|
||||
(AND BODY (SELECTQ (CAR BODY)
|
||||
(DEFMACRO (OR (GETTEMPLATE NAME)
|
||||
(SETTEMPLATE NAME 'MACRO))
|
||||
NIL)
|
||||
(CL:DEFUN
|
||||
(* |;;| "Body is of the form:")
|
||||
(* |;;| "(DEFUN name (args...) bodies...)")
|
||||
(* |;;| "We want to hand Masterscope a massaged form it will understand.")
|
||||
(* |;;| "Which I believe is of this form:")
|
||||
(* |;;| "Body is of the form:")
|
||||
|
||||
`(CL:LAMBDA ,(CADDR BODY) ,@(CDDDR BODY)))
|
||||
(* |;;| "(DEFUN name (args...) bodies...)")
|
||||
|
||||
(* |;;|
|
||||
"We want to hand Masterscope a massaged form it will understand.")
|
||||
|
||||
(* |;;| "Which I believe is of this form:")
|
||||
|
||||
`(CL:LAMBDA ,(CADDR BODY)
|
||||
,@(CDDDR BODY)))
|
||||
NIL)))))
|
||||
|
||||
(FUNCTIONSMSMC
|
||||
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
|
||||
(* |;;| "Trick here is we don't want to mark FUNCTIONS macros as changed because they really don't get analyzed, but we do want to call CHANGEMACRO for them")
|
||||
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
|
||||
|
||||
(* |;;| "Trick here is we don't want to mark FUNCTIONS macros as changed because they really don't get analyzed, but we do want to call CHANGEMACRO for them")
|
||||
|
||||
(|if| (EQ (CAR (GETDEF NAME 'FUNCTIONS NIL '(NOERROR)))
|
||||
'DEFMACRO)
|
||||
'DEFMACRO)
|
||||
|then| (CHANGEMACRO NAME TYPE REASON)
|
||||
NIL
|
||||
|else| T)))
|
||||
|
||||
(VARIABLESMSGETDEF
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
|
||||
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
|
||||
(LET ((BODY (GETDEF NAME 'VARIABLES SOURCE OPTIONS))
|
||||
SPECVARP)
|
||||
(AND BODY
|
||||
|
||||
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
|
||||
|
||||
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
|
||||
|
||||
`(CL:LAMBDA NIL ,(IF (CADDR BODY)
|
||||
THEN `(SETQ ,(CADR BODY) ,(CADDR BODY))))))))
|
||||
THEN `(SETQ ,(CADR BODY)
|
||||
,(CADDR BODY))))))))
|
||||
)
|
||||
|
||||
|
||||
@@ -162,9 +173,9 @@
|
||||
:LOAD :FILE-MANAGER-FORMAT :PROCESS-ENTIRE-FILE))
|
||||
|
||||
(SETTEMPLATE 'CL:COMPILER-LET '(! NIL (BOTH (|..| (IF LISTP (NIL EVAL |..| EFFECT)
|
||||
NIL))
|
||||
NIL))
|
||||
(|..| (IF LISTP ((BOTH BIND COMPILER-LET))
|
||||
(BOTH BIND COMPILER-LET))))
|
||||
(BOTH BIND COMPILER-LET))))
|
||||
|..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:COUNT '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :KEY))
|
||||
@@ -179,10 +190,10 @@
|
||||
|
||||
(SETTEMPLATE 'DECLARE '(|..| (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR))
|
||||
(LOCALVARS '(IF LISTP (|..| LOCALVARS)
|
||||
LOCALVARS))
|
||||
LOCALVARS))
|
||||
((SPECVARS CL:SPECIAL)
|
||||
'(IF LISTP (|..| SPECVARS)
|
||||
SPECVARS))
|
||||
SPECVARS))
|
||||
NIL)))))
|
||||
|
||||
(SETTEMPLATE 'CL:DELETE '(EVAL SMASH KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :COUNT :KEY))
|
||||
@@ -391,7 +402,7 @@
|
||||
(SETTEMPLATE 'CL:REPLACE '(SMASH EVAL KEYWORDS :START1 :END1 :START2 :END2))
|
||||
|
||||
(SETTEMPLATE 'CL:ROTATEF '(|..| (IF (ATOM EXPR)
|
||||
SET SMASH)))
|
||||
SET SMASH)))
|
||||
|
||||
(SETTEMPLATE 'CL:SEARCH '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :KEY :START1 :START2 :END1
|
||||
:END2))
|
||||
@@ -401,7 +412,7 @@
|
||||
(SETTEMPLATE 'CL:SET-EXCLUSIVE-OR '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:SHIFTF '(|..| (IF (ATOM EXPR)
|
||||
SET SMASH)
|
||||
SET SMASH)
|
||||
EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:SORT '(EVAL FUNCTION KEYWORDS :KEY))
|
||||
@@ -459,10 +470,14 @@
|
||||
|
||||
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
|
||||
:GENSYM :ARRAY))
|
||||
|
||||
@@ -539,6 +554,6 @@
|
||||
(CLRHASH USERTEMPLATES)
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (5000 6811 (FUNCTIONSMSGETDEF 5010 . 5804) (FUNCTIONSMSMC 5806 . 6286) (
|
||||
VARIABLESMSGETDEF 6288 . 6809)))))
|
||||
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
|
||||
VARIABLESMSGETDEF 6733 . 7289)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
466
library/SKETCH
466
library/SKETCH
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Jan-93 11:59:03" {DSK}<python>lde>lispcore>library>SKETCH.;3 491018
|
||||
|
||||
changes to%: (FNS SK.BUILD.IMAGEOBJ)
|
||||
(FILECREATED " 1-Feb-2022 09:17:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;2 490756
|
||||
|
||||
previous date%: "20-Jan-93 14:46:57" {DSK}<python>lde>lispcore>library>SKETCH.;2)
|
||||
:CHANGES-TO (FNS SKETCH.PUT)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-93 11:59:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SKETCH.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1988, 1990, 1992-1993 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SKETCHCOMS)
|
||||
@@ -19,8 +21,7 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990, 1992, 1993 by Venue & Xerox Co
|
||||
ALL.SKETCHES))
|
||||
TEDITFLG)
|
||||
|
||||
(* ;;
|
||||
"current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.")
|
||||
(* ;; "current knows about SKETCH TEDIT and NOTECARDS. Everyone else loses.")
|
||||
|
||||
[MAP.PROCESSES (FUNCTION (LAMBDA (PROC PROCNAME PROCFORM)
|
||||
(AND (EQ (CAR PROCFORM)
|
||||
@@ -62,22 +63,22 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SK.CHECK.IMAGEOBJ.WHENDELETEDFN SK.APPLY.IMAGEOBJ.WHENDELETEDFN SK.RETURN.TTY
|
||||
SK.TAKE.TTY)
|
||||
(COMS (* ;
|
||||
"fns for dealing with the sketch menu")
|
||||
"fns for dealing with the sketch menu")
|
||||
(FNS SKETCH.COMMANDMENU SKETCH.COMMANDMENU.ITEMS CREATE.SKETCHW.COMMANDMENU
|
||||
SKETCHW.SELECTIONFN SKETCH.MONITORLOCK SK.EVAL.AS.PROCESS SK.EVAL.WITH.LOCK)
|
||||
(FNS SK.FIX.MENU SK.SET.UP.MENUS SK.INSURE.HAS.MENU SK.CREATE.STANDARD.MENU
|
||||
SK.ADD.ITEM.TO.MENU SK.GET.VIEWER.POPUP.MENU SK.CLEAR.POPUP.MENU))
|
||||
(COMS (* ;
|
||||
"fns for dealing with sketch structures")
|
||||
"fns for dealing with sketch structures")
|
||||
(FNS SKETCH.CREATE GETSKETCHPROP PUTSKETCHPROP CREATE.DEFAULT.SKETCH.CONTEXT)
|
||||
(PROP ARGNAMES SKETCH.CREATE))
|
||||
(COMS (* ;
|
||||
"fns for implementing copy and delete functions under keyboard control.")
|
||||
"fns for implementing copy and delete functions under keyboard control.")
|
||||
(FNS SK.COPY.BUTTONEVENTFN SK.BUTTONEVENT.MARK SK.BUILD.IMAGEOBJ SK.BUTTONEVENT.OVERP
|
||||
SK.BUTTONEVENT.SAME.KEYS)
|
||||
(MACROS .DELETEKEYDOWNP. .MOVEKEYDOWNP.))
|
||||
(COMS (* ;
|
||||
"fns for implementing the CHANGE command.")
|
||||
"fns for implementing the CHANGE command.")
|
||||
(FNS SK.SEL.AND.CHANGE SK.CHECK.WHENCHANGEDFN SK.CHECK.PRECHANGEFN SK.CHANGE.ELT
|
||||
SK.CHANGE.THING SKETCH.CHANGE.ELEMENTS SK.APPLY.SINGLE.CHANGEFN SK.DO.CHANGESPECS
|
||||
SK.VIEWER.FROM.SKETCH.ARG SK.DO.CHANGESPEC1 SK.CHANGEFN SK.READCHANGEFN
|
||||
@@ -109,7 +110,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SK.SHOW.FIG.FROM.INFO SK.MOVE.THING UPDATE.ELEMENT.IN.SKETCH SK.UPDATE.ELEMENT
|
||||
SK.UPDATE.ELEMENTS SK.UPDATE.ELEMENT1 SK.MOVE.ELEMENT.POINT)
|
||||
(* ;
|
||||
"fns for moving points or a collection of pts.")
|
||||
"fns for moving points or a collection of pts.")
|
||||
(FNS SK.MOVE.POINTS SK.SEL.AND.MOVE.POINTS SK.DO.MOVE.ELEMENT.POINTS
|
||||
SK.MOVE.ITEM.POINTS SK.TRANSLATEPTSFN SK.TRANSLATE.POINTS
|
||||
SK.SELECT.MULTIPLE.POINTS SK.CONTROL.POINTS.IN.REGION SK.ADD.PT.SELECTION
|
||||
@@ -124,7 +125,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE SK.CORRESPONDING.CONTROL.PT
|
||||
SK.CONTROL.POINT.NUMBER SK.DO.ALIGN.SETVALUE))
|
||||
(COMS (* ;
|
||||
"stuff for supporting the GROUP sketch element.")
|
||||
"stuff for supporting the GROUP sketch element.")
|
||||
(FNS SKETCH.CREATE.GROUP SK.CREATE.GROUP1 SK.UPDATE.GROUP.AFTER.CHANGE SK.GROUP.ELTS
|
||||
SK.SEL.AND.GROUP SK.GROUP.ELEMENTS SK.UNGROUP.ELT SK.SEL.AND.UNGROUP
|
||||
SK.UNGROUP.ELEMENT SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS
|
||||
@@ -134,17 +135,16 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
GROUP.GLOBALREGIONFN GROUP.TRANSLATEFN GROUP.TRANSFORMFN GROUP.READCHANGEFN)
|
||||
(FNS REGION.CENTER REMOVE.LAST)
|
||||
(* ;
|
||||
"moving the control point of a group")
|
||||
"moving the control point of a group")
|
||||
(FNS SK.MOVE.GROUP.CONTROL.PT SK.SEL.AND.MOVE.CONTROL.PT
|
||||
SK.MOVE.GROUP.ELEMENT.CONTROL.POINT SK.READ.NEW.GROUP.CONTROL.PT)
|
||||
(RECORDS GROUP LOCALGROUP)
|
||||
(COMS (* ;
|
||||
"history and undo stuff for groups")
|
||||
(COMS (* ; "history and undo stuff for groups")
|
||||
(FNS SK.DO.GROUP SK.CHECK.WHENGROUPEDFN SK.DO.UNGROUP SK.CHECK.WHENUNGROUPEDFN
|
||||
SK.GROUP.UNDO SK.UNGROUP.UNDO)
|
||||
(IFPROP EVENTFNS GROUP UNGROUP)))
|
||||
(COMS (* ;
|
||||
"stuff for supporting the freezing of elements")
|
||||
"stuff for supporting the freezing of elements")
|
||||
(FNS SK.FREEZE.ELTS SK.SEL.AND.FREEZE SK.FREEZE.ELEMENTS SK.UNFREEZE.ELT
|
||||
SK.SEL.AND.UNFREEZE SK.UNFREEZE.ELEMENTS SK.FREEZE.UNDO SK.UNFREEZE.UNDO
|
||||
SK.DO.FREEZE SK.DO.UNFREEZE)
|
||||
@@ -154,13 +154,13 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SKETCH.DELETE.ELEMENT DELFROMGROUPELT SKETCH.ELEMENT.TYPE SKETCH.ELEMENT.CHANGED
|
||||
SK.ELEMENT.CHANGED1 SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT))
|
||||
(* ;
|
||||
"utility routines for sketch windows.")
|
||||
"utility routines for sketch windows.")
|
||||
(FNS INSURE.SKETCH LOCALSPECS.FROM.VIEWER SK.LOCAL.ELT.FROM.GLOBALPART SKETCH.FROM.VIEWER
|
||||
INSPECT.SKETCH ELT.INSIDE.SKETCHWP SK.INSIDE.REGION)
|
||||
(FNS MAPSKETCHSPECS MAPCOLLECTSKETCHSPECS MAPSKETCHSPECSUNTIL MAPGLOBALSKETCHSPECS
|
||||
MAPGLOBALSKETCHELEMENTS)
|
||||
(COMS (* ;
|
||||
"multiple selection and copy select functions")
|
||||
"multiple selection and copy select functions")
|
||||
(FNS SK.ADD.SELECTION SK.COPY.INSERTFN SCREENELEMENTP SK.ITEM.REGION
|
||||
SK.ELEMENT.GLOBAL.REGION SK.LOCAL.ITEMS.IN.REGION SK.REGIONFN SK.GLOBAL.REGIONFN
|
||||
SK.REMOVE.SELECTION SK.SELECT.MULTIPLE.ITEMS SKETCH.GET.ELEMENTS SK.PUT.MARKS.UP
|
||||
@@ -169,11 +169,10 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(CONSTANTS (SK.NO.MOVE.DISTANCE 4))
|
||||
(DECLARE%: DONTCOPY (RECORDS SKFIGUREIMAGE)))
|
||||
(COMS (* ;
|
||||
"stuff for changing the input scale")
|
||||
"stuff for changing the input scale")
|
||||
(FNS SK.INPUT.SCALE SK.UPDATE.SKETCHCONTEXT SK.SET.INPUT.SCALE
|
||||
SK.SET.INPUT.SCALE.CURRENT SK.SET.INPUT.SCALE.VALUE))
|
||||
(COMS (* ;
|
||||
"stuff for setting feedback amount")
|
||||
(COMS (* ; "stuff for setting feedback amount")
|
||||
(FNS SK.SET.FEEDBACK.MODE SK.SET.FEEDBACK.POINT SK.SET.FEEDBACK.VERBOSE
|
||||
SK.SET.FEEDBACK.ALWAYS)
|
||||
(INITVARS (SKETCH.VERBOSE.FEEDBACK T))
|
||||
@@ -181,8 +180,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(COMS (* ; "sketch icon support")
|
||||
(FNS SKETCH.TITLE SK.SHRINK.ICONCREATE)
|
||||
(UGLYVARS SKETCH.TITLED.ICON.TEMPLATE))
|
||||
(COMS (* ;
|
||||
"fns for reading in various values")
|
||||
(COMS (* ; "fns for reading in various values")
|
||||
(FNS READBRUSHSHAPE READ.FUNCTION READBRUSHSIZE READANGLE READARCDIRECTION)
|
||||
(FNS SK.CHANGE.DASHING READ.AND.SAVE.NEW.DASHING READ.NEW.DASHING READ.DASHING.CHANGE
|
||||
SK.CACHE.DASHING SK.DASHING.LABEL)
|
||||
@@ -195,8 +193,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(SK.CACHE.FILLING BLACKSHADE)
|
||||
(SK.CACHE.FILLING GRAYSHADE)
|
||||
(SK.CACHE.FILLING HIGHLIGHTSHADE)))
|
||||
(COMS (* ;
|
||||
"stuff for reading input positions")
|
||||
(COMS (* ; "stuff for reading input positions")
|
||||
(FNS SK.GETGLOBALPOSITION SKETCH.TRACK.ELEMENTS SK.PICKOUT.WHOLE.MOVE.ELEMENTS
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER MAP.GLOBAL.POSITION.INTO.VIEWER
|
||||
SKETCH.TO.VIEWER.POSITION SKETCH.TRACK.IMAGE SK.TRACK.IMAGE1
|
||||
@@ -207,7 +204,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
)
|
||||
(RECORDS INPUTPT)
|
||||
(COMS (* ;
|
||||
"stuff to allow reading positions from a number pad")
|
||||
"stuff to allow reading positions from a number pad")
|
||||
(INITVARS (SKETCH.USE.POSITION.PAD NIL))
|
||||
(GLOBALVARS SKETCH.USE.POSITION.PAD)
|
||||
(FNS SK.BRING.UP.POSITION.PAD SK.PAD.READER.POSITION SK.POSITION.READER.REPAINTFN
|
||||
@@ -227,7 +224,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(UGLYVARS SK.SELECTEDMARK SK.LOCATEMARK COPYSELECTIONMARK MOVESELECTIONMARK
|
||||
DELETESELECTIONMARK OTHERCONTROLPOINTMARK)
|
||||
(* ;
|
||||
"accessing functions for the methods of a sketch type.")
|
||||
"accessing functions for the methods of a sketch type.")
|
||||
(FNS SK.DRAWFN SK.TRANSFORMFN SK.EXPANDFN SK.INPUT SK.INSIDEFN SK.UPDATEFN)
|
||||
(INITRECORDS SKETCHTYPE)
|
||||
(DECLARE%: DONTCOPY (RECORDS SCREENELT GLOBALPART COMMONGLOBALPART INDIVIDUALGLOBALPART
|
||||
@@ -253,7 +250,7 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
SKETCHOPS SKETCHELEMENTS SKETCHOBJ
|
||||
SKETCHEDIT))
|
||||
(* ;
|
||||
"recompute the sketch element types because loading SKETCH clobbers the previous ones.")
|
||||
"recompute the sketch element types because loading SKETCH clobbers the previous ones.")
|
||||
(P (INIT.BITMAP.ELEMENT)
|
||||
(INIT.SKETCH.ELEMENTS)
|
||||
(INIT.GROUP.ELEMENT))
|
||||
@@ -265,14 +262,14 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(GLOBALVARS SKETCH.RECORD.LENGTHS)
|
||||
(P (SK.SET.RECORD.LENGTHS)))
|
||||
[COMS (* ;
|
||||
"to correct for a bug in the file package that marks LOADCOMPed file as changed")
|
||||
"to correct for a bug in the file package that marks LOADCOMPed file as changed")
|
||||
(P (UNMARKASCHANGED 'SKETCH 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHELEMENTS 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHOPS 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHEDIT 'FILE)
|
||||
(UNMARKASCHANGED 'SKETCHOBJ 'FILE]
|
||||
(COMS (* ;
|
||||
"add sketch as option to file browser edit command")
|
||||
"add sketch as option to file browser edit command")
|
||||
(FNS SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER)
|
||||
(P (SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER)))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
@@ -449,10 +446,11 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(T (FILENAMELESSVERSION SKETCHFILENAME])
|
||||
|
||||
(SKETCH.PUT
|
||||
[LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 17-Nov-87 17:47 by rrb")
|
||||
|
||||
(* puts the sketch SKETCH on the file named FILENAME.
|
||||
VIEWER if given provides promptwindows and PUTFNs.)
|
||||
[LAMBDA (FILENAME SKETCH VIEWER REGION SCALE GRID) (* ; "Edited 1-Feb-2022 09:17 by rmk")
|
||||
(* ; "Edited 17-Nov-87 17:47 by rrb")
|
||||
|
||||
(* puts the sketch SKETCH on the file named FILENAME.
|
||||
VIEWER if given provides promptwindows and PUTFNs.)
|
||||
|
||||
(PROG (TEXTSTREAM FILESTREAM)
|
||||
[COND
|
||||
@@ -463,14 +461,13 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
(FILESLOAD TEDIT))
|
||||
(T (STATUSPRINT VIEWER "Sketch not saved.")
|
||||
(RETURN NIL]
|
||||
[SETQ TEXTSTREAM (OPENTEXTSTREAM "" NIL NIL NIL (AND VIEWER (LIST 'PUTFN
|
||||
(WINDOWPROP VIEWER
|
||||
'TEDIT.PUTFN)
|
||||
'PROMPTWINDOW
|
||||
(GETPROMPTWINDOW VIEWER]
|
||||
|
||||
(* make a text stream with nothing in it except the sketch.)
|
||||
|
||||
[SETQ TEXTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (AND VIEWER (LIST 'PUTFN
|
||||
(WINDOWPROP VIEWER
|
||||
'TEDIT.PUTFN)
|
||||
'PROMPTWINDOW
|
||||
(GETPROMPTWINDOW VIEWER]
|
||||
(* make a text stream with nothing in
|
||||
it except the sketch.)
|
||||
(TEDIT.INSERT.OBJECT [SKETCH.IMAGEOBJ (INSURE.SKETCH SKETCH)
|
||||
(COND
|
||||
((REGIONP REGION))
|
||||
@@ -482,16 +479,17 @@ To abort loading the new version of Sketch, type '^'."]
|
||||
((NUMBERP GRID))
|
||||
(VIEWER (SK.GRIDFACTOR VIEWER]
|
||||
TEXTSTREAM 1)
|
||||
|
||||
(* set the margins so that if the user hardcopies it directly the margins
|
||||
come out)
|
||||
|
||||
(TEDIT.PARALOOKS TEXTSTREAM '(LEFTMARGIN 0 RIGHTMARGIN 0 QUAD CENTER) 1 1)
|
||||
(* set the margins so that if the user hardcopies it directly the margins come
|
||||
out)
|
||||
|
||||
(TEDIT.PARALOOKS TEXTSTREAM '(LEFTMARGIN 0 RIGHTMARGIN 0 QUAD CENTER)
|
||||
1 1)
|
||||
(TEDIT.PAGEFORMAT TEXTSTREAM (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 0 0 0 0))
|
||||
(* save the stream so that it can be
|
||||
closed.)
|
||||
closed.)
|
||||
(SETQ FILESTREAM (TEDIT.PUT TEXTSTREAM FILENAME)) (* grab the full file name if it is
|
||||
available.)
|
||||
available.)
|
||||
(AND (OPENP FILESTREAM)
|
||||
(SETQ FILENAME (CLOSEF FILESTREAM)))
|
||||
(SK.MARK.UNDIRTY SKETCH)
|
||||
@@ -2345,7 +2343,7 @@ This will be slow for arcs and curves."]
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .DELETEKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'CTRL)
|
||||
(KEYDOWNP 'DELETE])
|
||||
(KEYDOWNP 'DELETE])
|
||||
|
||||
(PUTPROPS .MOVEKEYDOWNP. MACRO (NIL (KEYDOWNP 'MOVE)))
|
||||
)
|
||||
@@ -4546,7 +4544,7 @@ This will be slow for arcs and curves."]
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .SHIFTKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
|
||||
(KEYDOWNP 'RSHIFT])
|
||||
(KEYDOWNP 'RSHIFT])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
@@ -5472,7 +5470,7 @@ This will be slow for arcs and curves."]
|
||||
(TYPERECORD GROUP (GROUPREGION LISTOFGLOBALELTS GROUPCONTROLPOINT))
|
||||
|
||||
(RECORD LOCALGROUP ((GROUPPOSITION)
|
||||
LOCALHOTREGION LOCALGROUPREGION LOCALELEMENTS))
|
||||
LOCALHOTREGION LOCALGROUPREGION LOCALELEMENTS))
|
||||
)
|
||||
|
||||
|
||||
@@ -7782,12 +7780,12 @@ Enter 'Abort' to leave the dashing unchanged.")
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD INPUTPT (INPUT.ONGRID? INPUT.POSITION INPUT.GLOBALPOSITION)
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(OR (NULL (CAR DATUM))
|
||||
(EQ (CAR DATUM)
|
||||
T))
|
||||
(LISTP (CDR DATUM))
|
||||
(POSITIONP (CADR DATUM])
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(OR (NULL (CAR DATUM))
|
||||
(EQ (CAR DATUM)
|
||||
T))
|
||||
(LISTP (CDR DATUM))
|
||||
(POSITIONP (CADR DATUM])
|
||||
)
|
||||
|
||||
|
||||
@@ -8508,14 +8506,14 @@ Otherwise, type '^'.")
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD SCREENELT (LOCALPART . GLOBALPART)
|
||||
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . GOTHERINFO))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
(RECORD LOCALPART (HOTSPOTS LOCALHOTREGION . OTHERLOCALINFO)))
|
||||
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . GOTHERINFO))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
(RECORD LOCALPART (HOTSPOTS LOCALHOTREGION . OTHERLOCALINFO)))
|
||||
|
||||
(RECORD GLOBALPART (COMMONGLOBALPART INDIVIDUALGLOBALPART)
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . RESTOFGLOBALPART))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
(RECORD INDIVIDUALGLOBALPART (GTYPE . RESTOFGLOBALPART))
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST)))
|
||||
|
||||
(RECORD COMMONGLOBALPART (MINSCALE MAXSCALE SKELEMENTPROPLIST))
|
||||
|
||||
@@ -8524,41 +8522,39 @@ Otherwise, type '^'.")
|
||||
(RECORD LOCALPART (HOTSPOTS LOCALHOTREGION . OTHERLOCALINFO))
|
||||
|
||||
(RECORD SKETCH (ALLSKETCHPROPS . SKETCHTCELL)
|
||||
[RECORD ALLSKETCHPROPS (SKETCHKEY SKETCHNAME . SKETCHPROPS)
|
||||
(CREATE (LIST 'SKETCH NIL 'VERSION SKETCH.VERSION 'PRIRANGE
|
||||
(CONS 0 0]
|
||||
[RECORD SKETCHTCELL (SKETCHELTS)
|
||||
(CREATE (CONS SKETCHELTS (LAST SKETCHELTS]
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(LISTP (CAR DATUM))
|
||||
(EQ (CAAR DATUM)
|
||||
'SKETCH])
|
||||
[RECORD ALLSKETCHPROPS (SKETCHKEY SKETCHNAME . SKETCHPROPS)
|
||||
(CREATE (LIST 'SKETCH NIL 'VERSION SKETCH.VERSION 'PRIRANGE (CONS 0 0]
|
||||
[RECORD SKETCHTCELL (SKETCHELTS)
|
||||
(CREATE (CONS SKETCHELTS (LAST SKETCHELTS]
|
||||
[TYPE? (AND (LISTP DATUM)
|
||||
(LISTP (CAR DATUM))
|
||||
(EQ (CAAR DATUM)
|
||||
'SKETCH])
|
||||
|
||||
(DATATYPE SKETCHTYPE (LABEL (* the label if it is non-NIL will
|
||||
be used in the sketch menu.)
|
||||
DOCSTR (* if put in the menu, this is the
|
||||
help string for its item.)
|
||||
DRAWFN EXPANDFN obsolete CHANGEFN INPUTFN INSIDEFN REGIONFN
|
||||
TRANSLATEFN UPDATEFN READCHANGEFN TRANSFORMFN
|
||||
(* fn to transform the control
|
||||
points of an element.
|
||||
takes args Gelt Tranfn trandata.)
|
||||
TRANSLATEPTSFN
|
||||
(DATATYPE SKETCHTYPE (LABEL (* the label if it is non-NIL will be
|
||||
used in the sketch menu.)
|
||||
DOCSTR (* if put in the menu, this is the
|
||||
help string for its item.)
|
||||
DRAWFN EXPANDFN obsolete CHANGEFN INPUTFN INSIDEFN REGIONFN TRANSLATEFN
|
||||
UPDATEFN READCHANGEFN TRANSFORMFN
|
||||
(* fn to transform the control points
|
||||
of an element. takes args Gelt Tranfn
|
||||
trandata.)
|
||||
TRANSLATEPTSFN
|
||||
|
||||
(* fn to move some but not all points of a screen element.
|
||||
Takes args%: LocalSelectedPts GlobalDeltaToTranslate ScreenElt SketchWindow)
|
||||
Takes args%: LocalSelectedPts GlobalDeltaToTranslate ScreenElt SketchWindow)
|
||||
|
||||
GLOBALREGIONFN
|
||||
GLOBALREGIONFN
|
||||
|
||||
(* takes a GLOBAL element and returns the global region it occupies.
|
||||
Note%: this is the only fn that takes a global rather that a local element.)
|
||||
Note%: this is the only fn that takes a global rather that a local element.)
|
||||
|
||||
))
|
||||
))
|
||||
|
||||
(RECORD SKETCHCONTEXT (SKETCHBRUSH SKETCHFONT SKETCHTEXTALIGNMENT SKETCHARROWHEAD SKETCHDASHING
|
||||
SKETCHUSEARROWHEAD SKETCHTEXTBOXALIGNMENT SKETCHFILLING
|
||||
SKETCHLINEMODE SKETCHARCDIRECTION SKETCHMOVEMODE SKETCHINPUTSCALE
|
||||
SKETCHDRAWINGMODE))
|
||||
SKETCHUSEARROWHEAD SKETCHTEXTBOXALIGNMENT SKETCHFILLING SKETCHLINEMODE
|
||||
SKETCHARCDIRECTION SKETCHMOVEMODE SKETCHINPUTSCALE SKETCHDRAWINGMODE))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'SKETCHTYPE
|
||||
@@ -8710,7 +8706,7 @@ Otherwise, type '^'.")
|
||||
(PUTPROPS SK.SET.RECORD.LENGTHS.MACRO MACRO
|
||||
[ARGS (CONS 'LIST (for X in SKETCH.ELEMENT.TYPE.NAMES
|
||||
collect (LIST 'LIST (KWOTE X)
|
||||
(LIST 'LENGTH (LIST 'CREATE X])
|
||||
(LIST 'LENGTH (LIST 'CREATE X])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -8767,149 +8763,149 @@ Otherwise, type '^'.")
|
||||
)
|
||||
(PUTPROPS SKETCH COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (22416 85555 (SKETCH 22426 . 24531) (SKETCH.FROM.A.FILE 24533 . 24848) (SKETCHW.CREATE
|
||||
24850 . 29424) (SKETCH.RESET 29426 . 30948) (SKETCHW.FIG.CHANGED 30950 . 31290) (SK.WINDOW.TITLE 31292
|
||||
. 31679) (EDITSLIDE 31681 . 32087) (EDITSKETCH 32089 . 32413) (SK.PUT.ON.FILE 32415 . 33867) (
|
||||
SK.OUTPUT.FILE.NAME 33869 . 34243) (SKETCH.PUT 34245 . 36919) (SK.GET.FROM.FILE 36921 . 37814) (
|
||||
SK.INCLUDE.FILE 37816 . 40324) (SK.GET.IMAGEOBJ.FROM.FILE 40326 . 42529) (SKETCH.GET 42531 . 42838) (
|
||||
ADD.SKETCH.TO.VIEWER 42840 . 45426) (FILENAMELESSVERSION 45428 . 45704) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45706 . 46220) (SKETCH.SET.A.DEFAULT 46222 . 53380) (SK.POPUP.SELECTIONFN 53382 . 53924) (
|
||||
GETSKETCHWREGION 53926 . 54132) (SK.ADD.ELEMENT 54134 . 55713) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55715 . 57109) (SK.ELTS.BY.PRIORITY 57111 . 57407) (SK.ORDER.ELEMENTS 57409 . 57676) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57678 . 59172) (SK.ADD.ELEMENTS 59174 . 59698) (
|
||||
SK.CHECK.WHENADDEDFN 59700 . 60430) (SK.APPLY.MENU.COMMAND 60432 . 61230) (SK.DELETE.ELEMENT1 61232 .
|
||||
62810) (SK.MARK.DIRTY 62812 . 63478) (SK.MARK.UNDIRTY 63480 . 63811) (SK.MENU.AND.RETURN.FIELD 63813
|
||||
. 64478) (SKETCH.SET.BRUSH.SHAPE 64480 . 65065) (SKETCH.SET.BRUSH.SIZE 65067 . 65573) (
|
||||
SKETCHW.CLOSEFN 65575 . 67366) (SK.CONFIRM.DESTRUCTION 67368 . 68367) (SKETCHW.OUTFN 68369 . 68633) (
|
||||
SKETCHW.REOPENFN 68635 . 69047) (MAKE.LOCAL.SKETCH 69049 . 69779) (MAP.SKETCHSPEC.INTO.VIEWER 69781 .
|
||||
70991) (SKETCHW.REPAINTFN 70993 . 71821) (SKETCHW.REPAINTFN1 71823 . 72762) (SK.DRAWFIGURE.IF 72764 .
|
||||
73286) (SKETCHW.SCROLLFN 73288 . 77481) (SKETCHW.RESHAPEFN 77483 . 79741) (SK.UPDATE.EVENT.SELECTION
|
||||
79743 . 81798) (LIGHTGRAYWINDOW 81800 . 81963) (SK.ADD.SPACES 81965 . 82711) (SK.SKETCH.MENU 82713 .
|
||||
83035) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83037 . 83889) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83891 . 84851)
|
||||
(SK.RETURN.TTY 84853 . 85221) (SK.TAKE.TTY 85223 . 85553)) (85609 108602 (SKETCH.COMMANDMENU 85619 .
|
||||
85956) (SKETCH.COMMANDMENU.ITEMS 85958 . 105706) (CREATE.SKETCHW.COMMANDMENU 105708 . 106128) (
|
||||
SKETCHW.SELECTIONFN 106130 . 107233) (SKETCH.MONITORLOCK 107235 . 107706) (SK.EVAL.AS.PROCESS 107708
|
||||
. 108321) (SK.EVAL.WITH.LOCK 108323 . 108600)) (108603 116407 (SK.FIX.MENU 108613 . 109707) (
|
||||
SK.SET.UP.MENUS 109709 . 112010) (SK.INSURE.HAS.MENU 112012 . 112674) (SK.CREATE.STANDARD.MENU 112676
|
||||
. 113121) (SK.ADD.ITEM.TO.MENU 113123 . 113798) (SK.GET.VIEWER.POPUP.MENU 113800 . 116001) (
|
||||
SK.CLEAR.POPUP.MENU 116003 . 116405)) (116463 125285 (SKETCH.CREATE 116473 . 117259) (GETSKETCHPROP
|
||||
117261 . 120318) (PUTSKETCHPROP 120320 . 124252) (CREATE.DEFAULT.SKETCH.CONTEXT 124254 . 125283)) (
|
||||
125451 148347 (SK.COPY.BUTTONEVENTFN 125461 . 136689) (SK.BUTTONEVENT.MARK 136691 . 137074) (
|
||||
SK.BUILD.IMAGEOBJ 137076 . 146991) (SK.BUTTONEVENT.OVERP 146993 . 147616) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147618 . 148345)) (148634 174449 (SK.SEL.AND.CHANGE 148644 . 148936) (SK.CHECK.WHENCHANGEDFN 148938 .
|
||||
149644) (SK.CHECK.PRECHANGEFN 149646 . 150247) (SK.CHANGE.ELT 150249 . 150441) (SK.CHANGE.THING 150443
|
||||
. 151694) (SKETCH.CHANGE.ELEMENTS 151696 . 152879) (SK.APPLY.SINGLE.CHANGEFN 152881 . 153454) (
|
||||
SK.DO.CHANGESPECS 153456 . 155115) (SK.VIEWER.FROM.SKETCH.ARG 155117 . 155559) (SK.DO.CHANGESPEC1
|
||||
155561 . 157436) (SK.CHANGEFN 157438 . 158018) (SK.READCHANGEFN 158020 . 158479) (SK.DEFAULT.CHANGEFN
|
||||
158481 . 160953) (CHANGEABLEFIELDITEMS 160955 . 161602) (SK.APPLY.CHANGE.COMMAND 161604 . 162221) (
|
||||
SK.DO.AND.RECORD.CHANGES 162223 . 163620) (SK.APPLY.CHANGE.COMMAND1 163622 . 165110) (
|
||||
SK.ELEMENTS.CHANGEFN 165112 . 167436) (READ.POINT.TO.ADD 167438 . 168382) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168384 . 168844) (SK.ADD.KNOT.TO.ELEMENT 168846 . 169790) (SK.GROUP.CHANGEFN 169792 . 171004) (
|
||||
SK.GROUP.CHANGEFN1 171006 . 174447)) (174616 188349 (ADD.ELEMENT.TO.SKETCH 174626 . 176332) (
|
||||
ADD.SKETCH.VIEWER 176334 . 177002) (REMOVE.SKETCH.VIEWER 177004 . 177617) (ALL.SKETCH.VIEWERS 177619
|
||||
. 177859) (SKETCH.ALL.VIEWERS 177861 . 178121) (VIEWER.BUCKET 178123 . 178274) (ELT.INSIDE.REGION?
|
||||
178276 . 178603) (ELT.INSIDE.SKWP 178605 . 178896) (SCALE.FROM.SKW 178898 . 179148) (
|
||||
SK.ADDELT.TO.WINDOW 179150 . 180010) (SK.CALC.REGION.VIEWED 180012 . 180390) (SK.DRAWFIGURE 180392 .
|
||||
181681) (SK.DRAWFIGURE1 181683 . 182067) (SK.LOCAL.FROM.GLOBAL 182069 . 183304) (SKETCH.REGION.VIEWED
|
||||
183306 . 185993) (SKETCH.VIEW.FROM.NAME 185995 . 186425) (SK.UPDATE.REGION.VIEWED 186427 . 186819) (
|
||||
SKETCH.ADD.AND.DISPLAY 186821 . 187229) (SKETCH.ADD.AND.DISPLAY1 187231 . 187669) (SK.ADD.ITEM 187671
|
||||
. 188003) (SKETCHW.ADD.INSTANCE 188005 . 188347)) (188390 201578 (SK.SEL.AND.DELETE 188400 . 188788)
|
||||
(SK.ERASE.AND.DELETE.ITEM 188790 . 189209) (REMOVE.ELEMENT.FROM.SKETCH 189211 . 190322) (
|
||||
SK.DELETE.ELEMENT 190324 . 190882) (SK.DELETE.ELEMENT2 190884 . 191545) (SK.DELETE.KNOT 191547 .
|
||||
191838) (SK.SEL.AND.DELETE.KNOT 191840 . 192965) (SK.DELETE.ELEMENT.KNOT 192967 . 196174) (
|
||||
SK.CHECK.WHENDELETEDFN 196176 . 196956) (SK.CHECK.PREEDITFN 196958 . 197442) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197444 . 197978) (SK.CHECK.WHENPOINTDELETEDFN 197980 . 198776) (SK.ERASE.ELT
|
||||
198778 . 199114) (SK.DELETE.ELT 199116 . 199491) (SK.DELETE.ITEM 199493 . 199901) (DELFROMTCONC
|
||||
199903 . 201576)) (201617 215451 (SK.COPY.ELT 201627 . 201997) (SK.SEL.AND.COPY 201999 . 202382) (
|
||||
SK.COPY.ELEMENTS 202384 . 208012) (SK.ADD.COPY.OF.ELEMENTS 208014 . 209781) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209783 . 210023) (SK.COPY.ITEM 210025 . 210822) (SK.INSERT.SKETCH 210824
|
||||
. 215449)) (215491 245512 (SK.MOVE.ELT 215501 . 215776) (SK.MOVE.ELT.OR.PT 215778 . 216091) (
|
||||
SK.APPLY.DEFAULT.MOVE 216093 . 216527) (SK.SEL.AND.MOVE 216529 . 217076) (SK.MOVE.ELEMENTS 217078 .
|
||||
227950) (SKETCH.MOVE.ELEMENTS 227952 . 229883) (SKETCH.COPY.ELEMENTS 229885 . 231932) (
|
||||
\SKETCH.COPY.ELEMENT 231934 . 232659) (SK.TRANSLATE.ELEMENT 232661 . 233144) (SK.COPY.GLOBAL.ELEMENT
|
||||
233146 . 233357) (SK.MAKE.ELEMENT.MOVE.ARG 233359 . 233979) (SK.MAKE.ELEMENTS.MOVE.ARG 233981 . 234503
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234505 . 235574) (SK.SHOW.FIG.FROM.INFO 235576 . 235944) (
|
||||
SK.MOVE.THING 235946 . 236852) (UPDATE.ELEMENT.IN.SKETCH 236854 . 238909) (SK.UPDATE.ELEMENT 238911 .
|
||||
240470) (SK.UPDATE.ELEMENTS 240472 . 241191) (SK.UPDATE.ELEMENT1 241193 . 245093) (
|
||||
SK.MOVE.ELEMENT.POINT 245095 . 245510)) (245575 267864 (SK.MOVE.POINTS 245585 . 245872) (
|
||||
SK.SEL.AND.MOVE.POINTS 245874 . 246179) (SK.DO.MOVE.ELEMENT.POINTS 246181 . 254838) (
|
||||
SK.MOVE.ITEM.POINTS 254840 . 256511) (SK.TRANSLATEPTSFN 256513 . 256897) (SK.TRANSLATE.POINTS 256899
|
||||
. 257800) (SK.SELECT.MULTIPLE.POINTS 257802 . 263442) (SK.CONTROL.POINTS.IN.REGION 263444 . 264865) (
|
||||
SK.ADD.PT.SELECTION 264867 . 265331) (SK.REMOVE.PT.SELECTION 265333 . 265950) (SK.ADD.POINT 265952 .
|
||||
266575) (SK.ELTS.CONTAINING.PTS 266577 . 267202) (SK.HOTSPOTS.NOT.ON.LIST 267204 . 267862)) (268030
|
||||
270826 (SK.SET.MOVE.MODE 268040 . 268711) (SK.SET.MOVE.MODE.POINTS 268713 . 269052) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269054 . 269398) (SK.SET.MOVE.MODE.COMBINED 269400 . 269750) (READMOVEMODE
|
||||
269752 . 270824)) (270827 289582 (SK.ALIGN.POINTS 270837 . 271127) (SK.SEL.AND.ALIGN.POINTS 271129 .
|
||||
271438) (SK.ALIGN.POINTS.LEFT 271440 . 271743) (SK.ALIGN.POINTS.RIGHT 271745 . 272050) (
|
||||
SK.ALIGN.POINTS.TOP 272052 . 272353) (SK.ALIGN.POINTS.BOTTOM 272355 . 272662) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272664 . 272984) (SK.EVEN.SPACE.POINTS.IN.Y 272986 . 273306) (
|
||||
SK.DO.ALIGN.POINTS 273308 . 283930) (SK.NTH.CONTROL.POINT 283932 . 284393) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284395 . 285061) (SK.CORRESPONDING.CONTROL.PT 285063 . 285617) (
|
||||
SK.CONTROL.POINT.NUMBER 285619 . 285989) (SK.DO.ALIGN.SETVALUE 285991 . 289580)) (289646 303078 (
|
||||
SKETCH.CREATE.GROUP 289656 . 290145) (SK.CREATE.GROUP1 290147 . 290694) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290696 . 291485) (SK.GROUP.ELTS 291487 . 291768) (SK.SEL.AND.GROUP 291770 . 292156) (SK.GROUP.ELEMENTS
|
||||
292158 . 293807) (SK.UNGROUP.ELT 293809 . 294093) (SK.SEL.AND.UNGROUP 294095 . 295764) (
|
||||
SK.UNGROUP.ELEMENT 295766 . 296702) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296704 . 297626) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297628 . 298639) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298641 .
|
||||
299981) (SK.UNIONREGIONS 299983 . 302349) (SKETCH.REGION.OF.SKETCH 302351 . 302767) (SK.FLASHREGION
|
||||
302769 . 303076)) (303079 316550 (INIT.GROUP.ELEMENT 303089 . 303961) (GROUP.DRAWFN 303963 . 304413) (
|
||||
GROUP.EXPANDFN 304415 . 305978) (GROUP.INSIDEFN 305980 . 306389) (GROUP.REGIONFN 306391 . 306786) (
|
||||
GROUP.GLOBALREGIONFN 306788 . 307106) (GROUP.TRANSLATEFN 307108 . 309140) (GROUP.TRANSFORMFN 309142 .
|
||||
312622) (GROUP.READCHANGEFN 312624 . 316548)) (316551 317559 (REGION.CENTER 316561 . 317162) (
|
||||
REMOVE.LAST 317164 . 317557)) (317612 322719 (SK.MOVE.GROUP.CONTROL.PT 317622 . 317913) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 317915 . 319319) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319321 . 321394) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321396 . 322717)) (322982 327606 (SK.DO.GROUP 322992 . 324444) (
|
||||
SK.CHECK.WHENGROUPEDFN 324446 . 325156) (SK.DO.UNGROUP 325158 . 326363) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326365 . 326952) (SK.GROUP.UNDO 326954 . 327277) (SK.UNGROUP.UNDO 327279 . 327604)) (327847 332769 (
|
||||
SK.FREEZE.ELTS 327857 . 328141) (SK.SEL.AND.FREEZE 328143 . 328533) (SK.FREEZE.ELEMENTS 328535 .
|
||||
329086) (SK.UNFREEZE.ELT 329088 . 329377) (SK.SEL.AND.UNFREEZE 329379 . 330915) (SK.UNFREEZE.ELEMENTS
|
||||
330917 . 331476) (SK.FREEZE.UNDO 331478 . 331723) (SK.UNFREEZE.UNDO 331725 . 331972) (SK.DO.FREEZE
|
||||
331974 . 332367) (SK.DO.UNFREEZE 332369 . 332767)) (332999 342809 (SKETCH.ELEMENTS.OF.SKETCH 333009 .
|
||||
333844) (SKETCH.LIST.OF.ELEMENTS 333846 . 334564) (SKETCH.ADD.ELEMENT 334566 . 335641) (
|
||||
SKETCH.DELETE.ELEMENT 335643 . 337375) (DELFROMGROUPELT 337377 . 338177) (SKETCH.ELEMENT.TYPE 338179
|
||||
. 338528) (SKETCH.ELEMENT.CHANGED 338530 . 340098) (SK.ELEMENT.CHANGED1 340100 . 340751) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340753 . 342807)) (342863 347475 (INSURE.SKETCH 342873 . 345488)
|
||||
(LOCALSPECS.FROM.VIEWER 345490 . 345850) (SK.LOCAL.ELT.FROM.GLOBALPART 345852 . 346320) (
|
||||
SKETCH.FROM.VIEWER 346322 . 346556) (INSPECT.SKETCH 346558 . 346883) (ELT.INSIDE.SKETCHWP 346885 .
|
||||
347158) (SK.INSIDE.REGION 347160 . 347473)) (347476 351806 (MAPSKETCHSPECS 347486 . 348107) (
|
||||
MAPCOLLECTSKETCHSPECS 348109 . 348858) (MAPSKETCHSPECSUNTIL 348860 . 349668) (MAPGLOBALSKETCHSPECS
|
||||
349670 . 350371) (MAPGLOBALSKETCHELEMENTS 350373 . 351804)) (351868 377760 (SK.ADD.SELECTION 351878 .
|
||||
352618) (SK.COPY.INSERTFN 352620 . 356251) (SCREENELEMENTP 356253 . 356726) (SK.ITEM.REGION 356728 .
|
||||
357215) (SK.ELEMENT.GLOBAL.REGION 357217 . 357745) (SK.LOCAL.ITEMS.IN.REGION 357747 . 359726) (
|
||||
SK.REGIONFN 359728 . 360050) (SK.GLOBAL.REGIONFN 360052 . 360410) (SK.REMOVE.SELECTION 360412 . 361140
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361142 . 371584) (SKETCH.GET.ELEMENTS 371586 . 373009) (SK.PUT.MARKS.UP
|
||||
373011 . 373350) (SK.TAKE.MARKS.DOWN 373352 . 373691) (SK.TRANSLATE.GLOBALPART 373693 . 375820) (
|
||||
SK.TRANSLATE.ITEM 375822 . 376749) (SK.TRANSLATEFN 376751 . 376947) (TRANSLATE.SKETCH 376949 . 377758)
|
||||
) (378026 380933 (SK.INPUT.SCALE 378036 . 378883) (SK.UPDATE.SKETCHCONTEXT 378885 . 379482) (
|
||||
SK.SET.INPUT.SCALE 379484 . 380133) (SK.SET.INPUT.SCALE.CURRENT 380135 . 380426) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380428 . 380931)) (380984 382896 (SK.SET.FEEDBACK.MODE 380994 . 382300) (
|
||||
SK.SET.FEEDBACK.POINT 382302 . 382470) (SK.SET.FEEDBACK.VERBOSE 382472 . 382641) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382643 . 382894)) (383047 384324 (SKETCH.TITLE 383057 . 383320) (
|
||||
SK.SHRINK.ICONCREATE 383322 . 384322)) (390014 392828 (READBRUSHSHAPE 390024 . 390483) (READ.FUNCTION
|
||||
390485 . 391000) (READBRUSHSIZE 391002 . 391460) (READANGLE 391462 . 391954) (READARCDIRECTION 391956
|
||||
. 392826)) (392829 403240 (SK.CHANGE.DASHING 392839 . 396787) (READ.AND.SAVE.NEW.DASHING 396789 .
|
||||
398557) (READ.NEW.DASHING 398559 . 400299) (READ.DASHING.CHANGE 400301 . 401776) (SK.CACHE.DASHING
|
||||
401778 . 402780) (SK.DASHING.LABEL 402782 . 403238)) (403241 406946 (READ.FILLING.CHANGE 403251 .
|
||||
405232) (SK.CACHE.FILLING 405234 . 405952) (READ.AND.SAVE.NEW.FILLING 405954 . 406552) (
|
||||
SK.FILLING.LABEL 406554 . 406944)) (407330 443583 (SK.GETGLOBALPOSITION 407340 . 407645) (
|
||||
SKETCH.TRACK.ELEMENTS 407647 . 411167) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411169 . 411728) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411730 . 412122) (MAP.GLOBAL.POSITION.INTO.VIEWER 412124 . 412504) (
|
||||
SKETCH.TO.VIEWER.POSITION 412506 . 412865) (SKETCH.TRACK.IMAGE 412867 . 413721) (SK.TRACK.IMAGE1
|
||||
413723 . 415135) (MAP.VIEWER.XY.INTO.GLOBAL 415137 . 416131) (SK.SET.POSITION 416133 . 416469) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416471 . 417577) (VIEWER.TO.SKETCH.POSITION 417579 . 418214) (
|
||||
SK.INSURE.SCALE 418216 . 418476) (SKETCH.TO.VIEWER.REGION 418478 . 419284) (VIEWER.TO.SKETCH.REGION
|
||||
419286 . 419624) (SK.READ.POINT.WITH.FEEDBACK 419626 . 430629) (SKETCH.GET.POSITION 430631 . 432511) (
|
||||
\CLOBBER.POSITION 432513 . 432961) (NEAREST.HOT.SPOT 432963 . 434491) (GETWREGION 434493 . 435254) (
|
||||
GET.BITMAP.POSITION 435256 . 436040) (SK.TRACK.BITMAP1 436042 . 443581)) (444196 475082 (
|
||||
SK.BRING.UP.POSITION.PAD 444206 . 450066) (SK.PAD.READER.POSITION 450068 . 451717) (
|
||||
SK.POSITION.READER.REPAINTFN 451719 . 453503) (SK.POSITION.PAD.FROM.VIEWER 453505 . 454847) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 454849 . 455199) (SK.READ.POSITION.PAD.HANDLER 455201 . 460933) (
|
||||
DISPLAY.POSITION.READER.TOTAL 460935 . 463233) (POSITION.PAD.READER.HANDLER 463235 . 471278) (
|
||||
POSITIONPAD.HELDFN 471280 . 472764) (\POSITION.PAD.ADD.DIGIT.MENU 472766 . 474345) (
|
||||
\POSITION.READER.NUMBERPAD 474347 . 475080)) (476708 479386 (SK.DRAWFN 476718 . 477084) (
|
||||
SK.TRANSFORMFN 477086 . 477467) (SK.EXPANDFN 477469 . 477746) (SK.INPUT 477748 . 478129) (SK.INSIDEFN
|
||||
478131 . 478771) (SK.UPDATEFN 478773 . 479384)) (485115 489060 (SK.CHECK.SKETCH.VERSION 485125 .
|
||||
486365) (SK.INSURE.RECORD.LENGTH 486367 . 487850) (SK.INSURE.HAS.LENGTH 487852 . 488590) (
|
||||
SK.RECORD.LENGTH 488592 . 488766) (SK.SET.RECORD.LENGTHS 488768 . 489058)) (489805 490692 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489815 . 490690)))))
|
||||
(FILEMAP (NIL (22155 85518 (SKETCH 22165 . 24270) (SKETCH.FROM.A.FILE 24272 . 24587) (SKETCHW.CREATE
|
||||
24589 . 29163) (SKETCH.RESET 29165 . 30687) (SKETCHW.FIG.CHANGED 30689 . 31029) (SK.WINDOW.TITLE 31031
|
||||
. 31418) (EDITSLIDE 31420 . 31826) (EDITSKETCH 31828 . 32152) (SK.PUT.ON.FILE 32154 . 33606) (
|
||||
SK.OUTPUT.FILE.NAME 33608 . 33982) (SKETCH.PUT 33984 . 36882) (SK.GET.FROM.FILE 36884 . 37777) (
|
||||
SK.INCLUDE.FILE 37779 . 40287) (SK.GET.IMAGEOBJ.FROM.FILE 40289 . 42492) (SKETCH.GET 42494 . 42801) (
|
||||
ADD.SKETCH.TO.VIEWER 42803 . 45389) (FILENAMELESSVERSION 45391 . 45667) (SK.ADD.ELEMENTS.TO.SKETCH
|
||||
45669 . 46183) (SKETCH.SET.A.DEFAULT 46185 . 53343) (SK.POPUP.SELECTIONFN 53345 . 53887) (
|
||||
GETSKETCHWREGION 53889 . 54095) (SK.ADD.ELEMENT 54097 . 55676) (SK.ADD.PRIORITY.ELEMENT.TO.SKETCH
|
||||
55678 . 57072) (SK.ELTS.BY.PRIORITY 57074 . 57370) (SK.ORDER.ELEMENTS 57372 . 57639) (
|
||||
SK.ADD.PRIORITY.LOCAL.ELEMENT.TO.SKETCH 57641 . 59135) (SK.ADD.ELEMENTS 59137 . 59661) (
|
||||
SK.CHECK.WHENADDEDFN 59663 . 60393) (SK.APPLY.MENU.COMMAND 60395 . 61193) (SK.DELETE.ELEMENT1 61195 .
|
||||
62773) (SK.MARK.DIRTY 62775 . 63441) (SK.MARK.UNDIRTY 63443 . 63774) (SK.MENU.AND.RETURN.FIELD 63776
|
||||
. 64441) (SKETCH.SET.BRUSH.SHAPE 64443 . 65028) (SKETCH.SET.BRUSH.SIZE 65030 . 65536) (
|
||||
SKETCHW.CLOSEFN 65538 . 67329) (SK.CONFIRM.DESTRUCTION 67331 . 68330) (SKETCHW.OUTFN 68332 . 68596) (
|
||||
SKETCHW.REOPENFN 68598 . 69010) (MAKE.LOCAL.SKETCH 69012 . 69742) (MAP.SKETCHSPEC.INTO.VIEWER 69744 .
|
||||
70954) (SKETCHW.REPAINTFN 70956 . 71784) (SKETCHW.REPAINTFN1 71786 . 72725) (SK.DRAWFIGURE.IF 72727 .
|
||||
73249) (SKETCHW.SCROLLFN 73251 . 77444) (SKETCHW.RESHAPEFN 77446 . 79704) (SK.UPDATE.EVENT.SELECTION
|
||||
79706 . 81761) (LIGHTGRAYWINDOW 81763 . 81926) (SK.ADD.SPACES 81928 . 82674) (SK.SKETCH.MENU 82676 .
|
||||
82998) (SK.CHECK.IMAGEOBJ.WHENDELETEDFN 83000 . 83852) (SK.APPLY.IMAGEOBJ.WHENDELETEDFN 83854 . 84814)
|
||||
(SK.RETURN.TTY 84816 . 85184) (SK.TAKE.TTY 85186 . 85516)) (85572 108565 (SKETCH.COMMANDMENU 85582 .
|
||||
85919) (SKETCH.COMMANDMENU.ITEMS 85921 . 105669) (CREATE.SKETCHW.COMMANDMENU 105671 . 106091) (
|
||||
SKETCHW.SELECTIONFN 106093 . 107196) (SKETCH.MONITORLOCK 107198 . 107669) (SK.EVAL.AS.PROCESS 107671
|
||||
. 108284) (SK.EVAL.WITH.LOCK 108286 . 108563)) (108566 116370 (SK.FIX.MENU 108576 . 109670) (
|
||||
SK.SET.UP.MENUS 109672 . 111973) (SK.INSURE.HAS.MENU 111975 . 112637) (SK.CREATE.STANDARD.MENU 112639
|
||||
. 113084) (SK.ADD.ITEM.TO.MENU 113086 . 113761) (SK.GET.VIEWER.POPUP.MENU 113763 . 115964) (
|
||||
SK.CLEAR.POPUP.MENU 115966 . 116368)) (116426 125248 (SKETCH.CREATE 116436 . 117222) (GETSKETCHPROP
|
||||
117224 . 120281) (PUTSKETCHPROP 120283 . 124215) (CREATE.DEFAULT.SKETCH.CONTEXT 124217 . 125246)) (
|
||||
125414 148310 (SK.COPY.BUTTONEVENTFN 125424 . 136652) (SK.BUTTONEVENT.MARK 136654 . 137037) (
|
||||
SK.BUILD.IMAGEOBJ 137039 . 146954) (SK.BUTTONEVENT.OVERP 146956 . 147579) (SK.BUTTONEVENT.SAME.KEYS
|
||||
147581 . 148308)) (148589 174404 (SK.SEL.AND.CHANGE 148599 . 148891) (SK.CHECK.WHENCHANGEDFN 148893 .
|
||||
149599) (SK.CHECK.PRECHANGEFN 149601 . 150202) (SK.CHANGE.ELT 150204 . 150396) (SK.CHANGE.THING 150398
|
||||
. 151649) (SKETCH.CHANGE.ELEMENTS 151651 . 152834) (SK.APPLY.SINGLE.CHANGEFN 152836 . 153409) (
|
||||
SK.DO.CHANGESPECS 153411 . 155070) (SK.VIEWER.FROM.SKETCH.ARG 155072 . 155514) (SK.DO.CHANGESPEC1
|
||||
155516 . 157391) (SK.CHANGEFN 157393 . 157973) (SK.READCHANGEFN 157975 . 158434) (SK.DEFAULT.CHANGEFN
|
||||
158436 . 160908) (CHANGEABLEFIELDITEMS 160910 . 161557) (SK.APPLY.CHANGE.COMMAND 161559 . 162176) (
|
||||
SK.DO.AND.RECORD.CHANGES 162178 . 163575) (SK.APPLY.CHANGE.COMMAND1 163577 . 165065) (
|
||||
SK.ELEMENTS.CHANGEFN 165067 . 167391) (READ.POINT.TO.ADD 167393 . 168337) (GLOBAL.KNOT.FROM.LOCAL
|
||||
168339 . 168799) (SK.ADD.KNOT.TO.ELEMENT 168801 . 169745) (SK.GROUP.CHANGEFN 169747 . 170959) (
|
||||
SK.GROUP.CHANGEFN1 170961 . 174402)) (174571 188304 (ADD.ELEMENT.TO.SKETCH 174581 . 176287) (
|
||||
ADD.SKETCH.VIEWER 176289 . 176957) (REMOVE.SKETCH.VIEWER 176959 . 177572) (ALL.SKETCH.VIEWERS 177574
|
||||
. 177814) (SKETCH.ALL.VIEWERS 177816 . 178076) (VIEWER.BUCKET 178078 . 178229) (ELT.INSIDE.REGION?
|
||||
178231 . 178558) (ELT.INSIDE.SKWP 178560 . 178851) (SCALE.FROM.SKW 178853 . 179103) (
|
||||
SK.ADDELT.TO.WINDOW 179105 . 179965) (SK.CALC.REGION.VIEWED 179967 . 180345) (SK.DRAWFIGURE 180347 .
|
||||
181636) (SK.DRAWFIGURE1 181638 . 182022) (SK.LOCAL.FROM.GLOBAL 182024 . 183259) (SKETCH.REGION.VIEWED
|
||||
183261 . 185948) (SKETCH.VIEW.FROM.NAME 185950 . 186380) (SK.UPDATE.REGION.VIEWED 186382 . 186774) (
|
||||
SKETCH.ADD.AND.DISPLAY 186776 . 187184) (SKETCH.ADD.AND.DISPLAY1 187186 . 187624) (SK.ADD.ITEM 187626
|
||||
. 187958) (SKETCHW.ADD.INSTANCE 187960 . 188302)) (188345 201533 (SK.SEL.AND.DELETE 188355 . 188743)
|
||||
(SK.ERASE.AND.DELETE.ITEM 188745 . 189164) (REMOVE.ELEMENT.FROM.SKETCH 189166 . 190277) (
|
||||
SK.DELETE.ELEMENT 190279 . 190837) (SK.DELETE.ELEMENT2 190839 . 191500) (SK.DELETE.KNOT 191502 .
|
||||
191793) (SK.SEL.AND.DELETE.KNOT 191795 . 192920) (SK.DELETE.ELEMENT.KNOT 192922 . 196129) (
|
||||
SK.CHECK.WHENDELETEDFN 196131 . 196911) (SK.CHECK.PREEDITFN 196913 . 197397) (
|
||||
SK.CHECK.END.INITIAL.EDIT 197399 . 197933) (SK.CHECK.WHENPOINTDELETEDFN 197935 . 198731) (SK.ERASE.ELT
|
||||
198733 . 199069) (SK.DELETE.ELT 199071 . 199446) (SK.DELETE.ITEM 199448 . 199856) (DELFROMTCONC
|
||||
199858 . 201531)) (201572 215406 (SK.COPY.ELT 201582 . 201952) (SK.SEL.AND.COPY 201954 . 202337) (
|
||||
SK.COPY.ELEMENTS 202339 . 207967) (SK.ADD.COPY.OF.ELEMENTS 207969 . 209736) (
|
||||
SK.GLOBAL.FROM.LOCAL.ELEMENTS 209738 . 209978) (SK.COPY.ITEM 209980 . 210777) (SK.INSERT.SKETCH 210779
|
||||
. 215404)) (215446 245467 (SK.MOVE.ELT 215456 . 215731) (SK.MOVE.ELT.OR.PT 215733 . 216046) (
|
||||
SK.APPLY.DEFAULT.MOVE 216048 . 216482) (SK.SEL.AND.MOVE 216484 . 217031) (SK.MOVE.ELEMENTS 217033 .
|
||||
227905) (SKETCH.MOVE.ELEMENTS 227907 . 229838) (SKETCH.COPY.ELEMENTS 229840 . 231887) (
|
||||
\SKETCH.COPY.ELEMENT 231889 . 232614) (SK.TRANSLATE.ELEMENT 232616 . 233099) (SK.COPY.GLOBAL.ELEMENT
|
||||
233101 . 233312) (SK.MAKE.ELEMENT.MOVE.ARG 233314 . 233934) (SK.MAKE.ELEMENTS.MOVE.ARG 233936 . 234458
|
||||
) (SK.MAKE.POINTS.AND.ELEMENTS.MOVE.ARG 234460 . 235529) (SK.SHOW.FIG.FROM.INFO 235531 . 235899) (
|
||||
SK.MOVE.THING 235901 . 236807) (UPDATE.ELEMENT.IN.SKETCH 236809 . 238864) (SK.UPDATE.ELEMENT 238866 .
|
||||
240425) (SK.UPDATE.ELEMENTS 240427 . 241146) (SK.UPDATE.ELEMENT1 241148 . 245048) (
|
||||
SK.MOVE.ELEMENT.POINT 245050 . 245465)) (245530 267819 (SK.MOVE.POINTS 245540 . 245827) (
|
||||
SK.SEL.AND.MOVE.POINTS 245829 . 246134) (SK.DO.MOVE.ELEMENT.POINTS 246136 . 254793) (
|
||||
SK.MOVE.ITEM.POINTS 254795 . 256466) (SK.TRANSLATEPTSFN 256468 . 256852) (SK.TRANSLATE.POINTS 256854
|
||||
. 257755) (SK.SELECT.MULTIPLE.POINTS 257757 . 263397) (SK.CONTROL.POINTS.IN.REGION 263399 . 264820) (
|
||||
SK.ADD.PT.SELECTION 264822 . 265286) (SK.REMOVE.PT.SELECTION 265288 . 265905) (SK.ADD.POINT 265907 .
|
||||
266530) (SK.ELTS.CONTAINING.PTS 266532 . 267157) (SK.HOTSPOTS.NOT.ON.LIST 267159 . 267817)) (267977
|
||||
270773 (SK.SET.MOVE.MODE 267987 . 268658) (SK.SET.MOVE.MODE.POINTS 268660 . 268999) (
|
||||
SK.SET.MOVE.MODE.ELEMENTS 269001 . 269345) (SK.SET.MOVE.MODE.COMBINED 269347 . 269697) (READMOVEMODE
|
||||
269699 . 270771)) (270774 289529 (SK.ALIGN.POINTS 270784 . 271074) (SK.SEL.AND.ALIGN.POINTS 271076 .
|
||||
271385) (SK.ALIGN.POINTS.LEFT 271387 . 271690) (SK.ALIGN.POINTS.RIGHT 271692 . 271997) (
|
||||
SK.ALIGN.POINTS.TOP 271999 . 272300) (SK.ALIGN.POINTS.BOTTOM 272302 . 272609) (
|
||||
SK.EVEN.SPACE.POINTS.IN.X 272611 . 272931) (SK.EVEN.SPACE.POINTS.IN.Y 272933 . 273253) (
|
||||
SK.DO.ALIGN.POINTS 273255 . 283877) (SK.NTH.CONTROL.POINT 283879 . 284340) (
|
||||
SK.GET.SELECTED.ELEMENT.STRUCTURE 284342 . 285008) (SK.CORRESPONDING.CONTROL.PT 285010 . 285564) (
|
||||
SK.CONTROL.POINT.NUMBER 285566 . 285936) (SK.DO.ALIGN.SETVALUE 285938 . 289527)) (289593 303025 (
|
||||
SKETCH.CREATE.GROUP 289603 . 290092) (SK.CREATE.GROUP1 290094 . 290641) (SK.UPDATE.GROUP.AFTER.CHANGE
|
||||
290643 . 291432) (SK.GROUP.ELTS 291434 . 291715) (SK.SEL.AND.GROUP 291717 . 292103) (SK.GROUP.ELEMENTS
|
||||
292105 . 293754) (SK.UNGROUP.ELT 293756 . 294040) (SK.SEL.AND.UNGROUP 294042 . 295711) (
|
||||
SK.UNGROUP.ELEMENT 295713 . 296649) (SK.GLOBAL.REGION.OF.LOCAL.ELEMENTS 296651 . 297573) (
|
||||
SK.LOCAL.REGION.OF.LOCAL.ELEMENTS 297575 . 298586) (SK.GLOBAL.REGION.OF.GLOBAL.ELEMENTS 298588 .
|
||||
299928) (SK.UNIONREGIONS 299930 . 302296) (SKETCH.REGION.OF.SKETCH 302298 . 302714) (SK.FLASHREGION
|
||||
302716 . 303023)) (303026 316497 (INIT.GROUP.ELEMENT 303036 . 303908) (GROUP.DRAWFN 303910 . 304360) (
|
||||
GROUP.EXPANDFN 304362 . 305925) (GROUP.INSIDEFN 305927 . 306336) (GROUP.REGIONFN 306338 . 306733) (
|
||||
GROUP.GLOBALREGIONFN 306735 . 307053) (GROUP.TRANSLATEFN 307055 . 309087) (GROUP.TRANSFORMFN 309089 .
|
||||
312569) (GROUP.READCHANGEFN 312571 . 316495)) (316498 317506 (REGION.CENTER 316508 . 317109) (
|
||||
REMOVE.LAST 317111 . 317504)) (317559 322666 (SK.MOVE.GROUP.CONTROL.PT 317569 . 317860) (
|
||||
SK.SEL.AND.MOVE.CONTROL.PT 317862 . 319266) (SK.MOVE.GROUP.ELEMENT.CONTROL.POINT 319268 . 321341) (
|
||||
SK.READ.NEW.GROUP.CONTROL.PT 321343 . 322664)) (322925 327549 (SK.DO.GROUP 322935 . 324387) (
|
||||
SK.CHECK.WHENGROUPEDFN 324389 . 325099) (SK.DO.UNGROUP 325101 . 326306) (SK.CHECK.WHENUNGROUPEDFN
|
||||
326308 . 326895) (SK.GROUP.UNDO 326897 . 327220) (SK.UNGROUP.UNDO 327222 . 327547)) (327790 332712 (
|
||||
SK.FREEZE.ELTS 327800 . 328084) (SK.SEL.AND.FREEZE 328086 . 328476) (SK.FREEZE.ELEMENTS 328478 .
|
||||
329029) (SK.UNFREEZE.ELT 329031 . 329320) (SK.SEL.AND.UNFREEZE 329322 . 330858) (SK.UNFREEZE.ELEMENTS
|
||||
330860 . 331419) (SK.FREEZE.UNDO 331421 . 331666) (SK.UNFREEZE.UNDO 331668 . 331915) (SK.DO.FREEZE
|
||||
331917 . 332310) (SK.DO.UNFREEZE 332312 . 332710)) (332942 342752 (SKETCH.ELEMENTS.OF.SKETCH 332952 .
|
||||
333787) (SKETCH.LIST.OF.ELEMENTS 333789 . 334507) (SKETCH.ADD.ELEMENT 334509 . 335584) (
|
||||
SKETCH.DELETE.ELEMENT 335586 . 337318) (DELFROMGROUPELT 337320 . 338120) (SKETCH.ELEMENT.TYPE 338122
|
||||
. 338471) (SKETCH.ELEMENT.CHANGED 338473 . 340041) (SK.ELEMENT.CHANGED1 340043 . 340694) (
|
||||
SK.UPDATE.GLOBAL.IMAGE.OBJECT.ELEMENT 340696 . 342750)) (342806 347418 (INSURE.SKETCH 342816 . 345431)
|
||||
(LOCALSPECS.FROM.VIEWER 345433 . 345793) (SK.LOCAL.ELT.FROM.GLOBALPART 345795 . 346263) (
|
||||
SKETCH.FROM.VIEWER 346265 . 346499) (INSPECT.SKETCH 346501 . 346826) (ELT.INSIDE.SKETCHWP 346828 .
|
||||
347101) (SK.INSIDE.REGION 347103 . 347416)) (347419 351749 (MAPSKETCHSPECS 347429 . 348050) (
|
||||
MAPCOLLECTSKETCHSPECS 348052 . 348801) (MAPSKETCHSPECSUNTIL 348803 . 349611) (MAPGLOBALSKETCHSPECS
|
||||
349613 . 350314) (MAPGLOBALSKETCHELEMENTS 350316 . 351747)) (351811 377703 (SK.ADD.SELECTION 351821 .
|
||||
352561) (SK.COPY.INSERTFN 352563 . 356194) (SCREENELEMENTP 356196 . 356669) (SK.ITEM.REGION 356671 .
|
||||
357158) (SK.ELEMENT.GLOBAL.REGION 357160 . 357688) (SK.LOCAL.ITEMS.IN.REGION 357690 . 359669) (
|
||||
SK.REGIONFN 359671 . 359993) (SK.GLOBAL.REGIONFN 359995 . 360353) (SK.REMOVE.SELECTION 360355 . 361083
|
||||
) (SK.SELECT.MULTIPLE.ITEMS 361085 . 371527) (SKETCH.GET.ELEMENTS 371529 . 372952) (SK.PUT.MARKS.UP
|
||||
372954 . 373293) (SK.TAKE.MARKS.DOWN 373295 . 373634) (SK.TRANSLATE.GLOBALPART 373636 . 375763) (
|
||||
SK.TRANSLATE.ITEM 375765 . 376692) (SK.TRANSLATEFN 376694 . 376890) (TRANSLATE.SKETCH 376892 . 377701)
|
||||
) (377969 380876 (SK.INPUT.SCALE 377979 . 378826) (SK.UPDATE.SKETCHCONTEXT 378828 . 379425) (
|
||||
SK.SET.INPUT.SCALE 379427 . 380076) (SK.SET.INPUT.SCALE.CURRENT 380078 . 380369) (
|
||||
SK.SET.INPUT.SCALE.VALUE 380371 . 380874)) (380927 382839 (SK.SET.FEEDBACK.MODE 380937 . 382243) (
|
||||
SK.SET.FEEDBACK.POINT 382245 . 382413) (SK.SET.FEEDBACK.VERBOSE 382415 . 382584) (
|
||||
SK.SET.FEEDBACK.ALWAYS 382586 . 382837)) (382990 384267 (SKETCH.TITLE 383000 . 383263) (
|
||||
SK.SHRINK.ICONCREATE 383265 . 384265)) (389957 392771 (READBRUSHSHAPE 389967 . 390426) (READ.FUNCTION
|
||||
390428 . 390943) (READBRUSHSIZE 390945 . 391403) (READANGLE 391405 . 391897) (READARCDIRECTION 391899
|
||||
. 392769)) (392772 403183 (SK.CHANGE.DASHING 392782 . 396730) (READ.AND.SAVE.NEW.DASHING 396732 .
|
||||
398500) (READ.NEW.DASHING 398502 . 400242) (READ.DASHING.CHANGE 400244 . 401719) (SK.CACHE.DASHING
|
||||
401721 . 402723) (SK.DASHING.LABEL 402725 . 403181)) (403184 406889 (READ.FILLING.CHANGE 403194 .
|
||||
405175) (SK.CACHE.FILLING 405177 . 405895) (READ.AND.SAVE.NEW.FILLING 405897 . 406495) (
|
||||
SK.FILLING.LABEL 406497 . 406887)) (407273 443526 (SK.GETGLOBALPOSITION 407283 . 407588) (
|
||||
SKETCH.TRACK.ELEMENTS 407590 . 411110) (SK.PICKOUT.WHOLE.MOVE.ELEMENTS 411112 . 411671) (
|
||||
MAP.SKETCH.ELEMENTS.INTO.VIEWER 411673 . 412065) (MAP.GLOBAL.POSITION.INTO.VIEWER 412067 . 412447) (
|
||||
SKETCH.TO.VIEWER.POSITION 412449 . 412808) (SKETCH.TRACK.IMAGE 412810 . 413664) (SK.TRACK.IMAGE1
|
||||
413666 . 415078) (MAP.VIEWER.XY.INTO.GLOBAL 415080 . 416074) (SK.SET.POSITION 416076 . 416412) (
|
||||
MAP.VIEWER.PT.INTO.GLOBAL 416414 . 417520) (VIEWER.TO.SKETCH.POSITION 417522 . 418157) (
|
||||
SK.INSURE.SCALE 418159 . 418419) (SKETCH.TO.VIEWER.REGION 418421 . 419227) (VIEWER.TO.SKETCH.REGION
|
||||
419229 . 419567) (SK.READ.POINT.WITH.FEEDBACK 419569 . 430572) (SKETCH.GET.POSITION 430574 . 432454) (
|
||||
\CLOBBER.POSITION 432456 . 432904) (NEAREST.HOT.SPOT 432906 . 434434) (GETWREGION 434436 . 435197) (
|
||||
GET.BITMAP.POSITION 435199 . 435983) (SK.TRACK.BITMAP1 435985 . 443524)) (444095 474981 (
|
||||
SK.BRING.UP.POSITION.PAD 444105 . 449965) (SK.PAD.READER.POSITION 449967 . 451616) (
|
||||
SK.POSITION.READER.REPAINTFN 451618 . 453402) (SK.POSITION.PAD.FROM.VIEWER 453404 . 454746) (
|
||||
SK.INIT.POSITION.NUMBER.PAD.MENU 454748 . 455098) (SK.READ.POSITION.PAD.HANDLER 455100 . 460832) (
|
||||
DISPLAY.POSITION.READER.TOTAL 460834 . 463132) (POSITION.PAD.READER.HANDLER 463134 . 471177) (
|
||||
POSITIONPAD.HELDFN 471179 . 472663) (\POSITION.PAD.ADD.DIGIT.MENU 472665 . 474244) (
|
||||
\POSITION.READER.NUMBERPAD 474246 . 474979)) (476607 479285 (SK.DRAWFN 476617 . 476983) (
|
||||
SK.TRANSFORMFN 476985 . 477366) (SK.EXPANDFN 477368 . 477645) (SK.INPUT 477647 . 478028) (SK.INSIDEFN
|
||||
478030 . 478670) (SK.UPDATEFN 478672 . 479283)) (484857 488802 (SK.CHECK.SKETCH.VERSION 484867 .
|
||||
486107) (SK.INSURE.RECORD.LENGTH 486109 . 487592) (SK.INSURE.HAS.LENGTH 487594 . 488332) (
|
||||
SK.RECORD.LENGTH 488334 . 488508) (SK.SET.RECORD.LENGTHS 488510 . 488800)) (489543 490430 (
|
||||
SK.ADD.EDIT.COMMAND.TO.FILE.BROWSER 489553 . 490428)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
414
library/SPY
414
library/SPY
@@ -1,22 +1,22 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "29-Apr-94 14:13:52" {DSK}<king>export>lispcore>library>SPY.;4 64372
|
||||
|
||||
changes to%: (FILES GRAPHER)
|
||||
(FNS SPY.GRAPH.EDITOR SPY.UPDATE.TITLE SPY.MERGEINFO SPY.MAKEGRAPHNODES SPY.MAX
|
||||
SPY.MERGE SPY.MERGE1 SPY.MERGETREE SPY.NEXT.TREE SPY.SUM SPY.MAKE.TREE
|
||||
SPY.DELETE SPY.DUMP.BUFFER SPY.ORIGINAL SPY.MERGE.CALLEES)
|
||||
(FILECREATED " 4-Jan-2022 14:09:48" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SPY.;2 63314
|
||||
|
||||
previous date%: "28-Apr-94 15:56:32" {DSK}<king>export>lispcore>library>SPY.;3)
|
||||
:CHANGES-TO (VARS SPYCOMS)
|
||||
(FNS SPY.MAKE.TREE)
|
||||
|
||||
:PREVIOUS-DATE "29-Apr-94 14:13:52" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>SPY.;1
|
||||
)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1985, 1987-1988, 1990-1991, 1993-1994 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SPYCOMS)
|
||||
|
||||
(RPAQQ SPYCOMS
|
||||
((VARS SPY.BORDERS SPY.BUFFER.SIZE SPY.FRAGMENTS SPY.NOMERGEFNS SPY.MERGEINFO (SPY.HASH)
|
||||
(RPAQQ SPYCOMS
|
||||
[(VARS SPY.BORDERS SPY.BUFFER.SIZE SPY.FRAGMENTS SPY.NOMERGEFNS SPY.MERGEINFO (SPY.HASH)
|
||||
(SPY.GRAPH.MENU)
|
||||
SPY.SHOW.PERCENTAGES SPY.SMALLGHOSTS SPY.ICON)
|
||||
(INITVARS (SPY.NEXT 0)
|
||||
@@ -42,38 +42,41 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
(MACROS WITH-SPY WITH.SPY)
|
||||
(DECLARE%: DONTCOPY (RECORDS SPYRECORD SPYDATA))
|
||||
(INITRECORDS SPYRECORD)
|
||||
(DECLARE%: DOCOPY DOEVAL@COMPILE (FILES GRAPHER READNUMBER IMAGEOBJ))))
|
||||
(DECLARE%: DOCOPY DOEVAL@COMPILE (FILES GRAPHER READNUMBER IMAGEOBJ))
|
||||
(P (MOVD? 'NILL 'MODERNWINDOW])
|
||||
|
||||
(RPAQQ SPY.BORDERS ((NORMAL "Normal" 2 -1)
|
||||
(GHOST "Shown elsewhere" 2 8840)
|
||||
(RECURSIVEGHOST "End of recursive chain" 2 0 -1)
|
||||
(MERGED "Includes other branches" 4 42405)
|
||||
(SELFRECURSIVE "Includes self-recursive calls" 2 61375)
|
||||
(RECURSIVE "Head of recursive chain" 4 28086)
|
||||
(ENDOFLINE "exceeded depth limit" 6 64510)))
|
||||
(RPAQQ SPY.BORDERS
|
||||
((NORMAL "Normal" 2 -1)
|
||||
(GHOST "Shown elsewhere" 2 8840)
|
||||
(RECURSIVEGHOST "End of recursive chain" 2 0 -1)
|
||||
(MERGED "Includes other branches" 4 42405)
|
||||
(SELFRECURSIVE "Includes self-recursive calls" 2 61375)
|
||||
(RECURSIVE "Head of recursive chain" 4 28086)
|
||||
(ENDOFLINE "exceeded depth limit" 6 64510)))
|
||||
|
||||
(RPAQQ SPY.BUFFER.SIZE 5120)
|
||||
|
||||
(RPAQQ SPY.FRAGMENTS T)
|
||||
|
||||
(RPAQQ SPY.NOMERGEFNS (SI::*UNWIND-PROTECT* CL:EVAL \EVAL-PROGN \INTERPRET-ARGUMENTS \INTERPRETER
|
||||
\INTERPRETER1 ERRORSET \EVAL \EVALFORM APPLY \PROGV EVAL))
|
||||
(RPAQQ SPY.NOMERGEFNS (SI::*UNWIND-PROTECT* CL:EVAL \EVAL-PROGN \INTERPRET-ARGUMENTS \INTERPRETER
|
||||
\INTERPRETER1 ERRORSET \EVAL \EVALFORM APPLY \PROGV EVAL))
|
||||
|
||||
(RPAQQ SPY.MERGEINFO ((EXEC :EXEC)
|
||||
(EXEC-READ-LINE :EXEC)
|
||||
(EXEC-READ :EXEC)
|
||||
(XCL-USER::LEX-DO-EVENT :EXEC)
|
||||
(DO-EVENT :EXEC)
|
||||
(EVAL-INPUT :EXEC)
|
||||
(SI::*UNWIND-PROTECT* :ANY)
|
||||
(\MAKE.PROCESS0 T)
|
||||
(\PROC.REPEATEDLYEVALQT T)
|
||||
(\EVALFORM T :EVAL)
|
||||
(PROGN PROGN :EVAL T)
|
||||
(TTYIN1 TTYIN)
|
||||
(TTBIN TTYIN)
|
||||
(TTWAITFORINPUT TTYIN)
|
||||
(\PROGV :ANY)))
|
||||
(RPAQQ SPY.MERGEINFO
|
||||
((EXEC :EXEC)
|
||||
(EXEC-READ-LINE :EXEC)
|
||||
(EXEC-READ :EXEC)
|
||||
(XCL-USER::LEX-DO-EVENT :EXEC)
|
||||
(DO-EVENT :EXEC)
|
||||
(EVAL-INPUT :EXEC)
|
||||
(SI::*UNWIND-PROTECT* :ANY)
|
||||
(\MAKE.PROCESS0 T)
|
||||
(\PROC.REPEATEDLYEVALQT T)
|
||||
(\EVALFORM T :EVAL)
|
||||
(PROGN PROGN :EVAL T)
|
||||
(TTYIN1 TTYIN)
|
||||
(TTBIN TTYIN)
|
||||
(TTWAITFORINPUT TTYIN)
|
||||
(\PROGV :ANY)))
|
||||
|
||||
(RPAQQ SPY.HASH NIL)
|
||||
|
||||
@@ -102,19 +105,19 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
|
||||
(RPAQ? SPY.TREE )
|
||||
|
||||
(RPAQQ SPYOBJCOMS ((FNS SPYOBJ SPYOBJ.BUTTON SPYOBJ.SAVE SPYOBJ.COPY SPYOBJ.GET SPYOBJ.IMAGEBOX
|
||||
SPYOBJ.DISPLAY SPYOBJ.LABEL SPYOBJ.HEIGHT SPYOBJ.COPYIN SPY.COPYBUTTON
|
||||
SPY.MERGEINFO)
|
||||
[VARS (SPYOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION SPYOBJ.DISPLAY)
|
||||
(FUNCTION SPYOBJ.IMAGEBOX)
|
||||
(FUNCTION SPYOBJ.SAVE)
|
||||
(FUNCTION SPYOBJ.GET)
|
||||
(FUNCTION SPYOBJ.COPY)
|
||||
(FUNCTION SPYOBJ.BUTTON)
|
||||
(FUNCTION SPYOBJ.COPYIN)
|
||||
NIL NIL NIL NIL NIL NIL 'SPYNODE]
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS FX SPYOBJDATA))
|
||||
(INITRECORDS SPYOBJDATA)))
|
||||
(RPAQQ SPYOBJCOMS
|
||||
((FNS SPYOBJ SPYOBJ.BUTTON SPYOBJ.SAVE SPYOBJ.COPY SPYOBJ.GET SPYOBJ.IMAGEBOX SPYOBJ.DISPLAY
|
||||
SPYOBJ.LABEL SPYOBJ.HEIGHT SPYOBJ.COPYIN SPY.COPYBUTTON SPY.MERGEINFO)
|
||||
[VARS (SPYOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION SPYOBJ.DISPLAY)
|
||||
(FUNCTION SPYOBJ.IMAGEBOX)
|
||||
(FUNCTION SPYOBJ.SAVE)
|
||||
(FUNCTION SPYOBJ.GET)
|
||||
(FUNCTION SPYOBJ.COPY)
|
||||
(FUNCTION SPYOBJ.BUTTON)
|
||||
(FUNCTION SPYOBJ.COPYIN)
|
||||
NIL NIL NIL NIL NIL NIL 'SPYNODE]
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS FX SPYOBJDATA))
|
||||
(INITRECORDS SPYOBJDATA)))
|
||||
(DEFINEQ
|
||||
|
||||
(SPYOBJ
|
||||
@@ -176,148 +179,145 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
then '(:INTERPRETER CL:EVAL])
|
||||
)
|
||||
|
||||
(RPAQ SPYOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION SPYOBJ.DISPLAY)
|
||||
(FUNCTION SPYOBJ.IMAGEBOX)
|
||||
(FUNCTION SPYOBJ.SAVE)
|
||||
(FUNCTION SPYOBJ.GET)
|
||||
(FUNCTION SPYOBJ.COPY)
|
||||
(FUNCTION SPYOBJ.BUTTON)
|
||||
(FUNCTION SPYOBJ.COPYIN)
|
||||
NIL NIL NIL NIL NIL NIL 'SPYNODE))
|
||||
(RPAQ SPYOBJ.IMAGEFNS
|
||||
(IMAGEFNSCREATE (FUNCTION SPYOBJ.DISPLAY)
|
||||
(FUNCTION SPYOBJ.IMAGEBOX)
|
||||
(FUNCTION SPYOBJ.SAVE)
|
||||
(FUNCTION SPYOBJ.GET)
|
||||
(FUNCTION SPYOBJ.COPY)
|
||||
(FUNCTION SPYOBJ.BUTTON)
|
||||
(FUNCTION SPYOBJ.COPYIN)
|
||||
NIL NIL NIL NIL NIL NIL 'SPYNODE))
|
||||
(DECLARE%: DONTCOPY DOEVAL@COMPILE
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* ; "frame extension index")
|
||||
(BLOCKRECORD FXBLOCK ((FLAGS BITS 3) (* ; "= \STK.FX")
|
||||
(FAST FLAG)
|
||||
(NIL FLAG)
|
||||
(INCALL FLAG) (* ;
|
||||
"set when fncall microcode has to punt")
|
||||
(VALIDNAMETABLE FLAG)(* ;
|
||||
"if on, NAMETABLE field is filled in. If off, is same as FNHEADER")
|
||||
(NOPUSH FLAG) (* ;
|
||||
"when returning to this frame, don't push a value. Set by interrupt code")
|
||||
(USECNT BITS 8)
|
||||
(%#ALINK WORD) (* ; "low bit is SLOWP")
|
||||
(FNHEADER FULLXPOINTER)
|
||||
(NEXTBLOCK WORD)
|
||||
(PC WORD)
|
||||
(NAMETABLE# FULLXPOINTER)
|
||||
(%#BLINK WORD)
|
||||
(%#CLINK WORD)))
|
||||
(BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
|
||||
(NIL BYTE)
|
||||
(NIL BITS 15) (* ; "most of the bits of #ALINK")
|
||||
(SLOWP FLAG) (* ;
|
||||
"if on, then BLINK and CLINK fields are valid. If off, they are implicit")
|
||||
(NIL FULLXPOINTER 2)
|
||||
(NAMETABHI WORD)
|
||||
(NAMETABLO WORD)))
|
||||
(TYPE? (IEQ (fetch (FX FLAGS) of DATUM)
|
||||
\STK.FX))
|
||||
[ACCESSFNS FX ((NAMETABLE (COND
|
||||
((fetch (FX VALIDNAMETABLE) of DATUM)
|
||||
(fetch (FX NAMETABLE#) of DATUM))
|
||||
(T (fetch (FX FNHEADER) of DATUM)))
|
||||
(PROGN (replace (FX FAST) of DATUM with NIL)
|
||||
(replace (FX NAMETABLE#) of DATUM with
|
||||
NEWVALUE)
|
||||
(replace (FX VALIDNAMETABLE) of DATUM
|
||||
with T)))
|
||||
(FRAMENAME (fetch (FNHEADER FRAMENAME)
|
||||
of (fetch (FX NAMETABLE) of DATUM)))
|
||||
(INVALIDP (EQ DATUM 0)) (* ;
|
||||
"true when A/CLink points at nobody, i.e. FX is bottom of stack")
|
||||
[FASTP (NOT (fetch (FX SLOWP) of DATUM))
|
||||
(PROGN (CHECK (NULL NEWVALUE))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with
|
||||
T]
|
||||
[BLINK (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX DUMMYBF) of DATUM))
|
||||
(T (fetch (FX %#BLINK) of DATUM)))
|
||||
(PROGN (replace (FX %#BLINK) of DATUM with
|
||||
NEWVALUE)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with
|
||||
T]
|
||||
[CLINK (IDIFFERENCE (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX %#ALINK) of DATUM))
|
||||
(T (fetch (FX %#CLINK) of DATUM)))
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN (replace (FX %#CLINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with
|
||||
T]
|
||||
[ALINK (IDIFFERENCE (FLOOR (fetch (FX %#ALINK) of DATUM)
|
||||
WORDSPERCELL)
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM]
|
||||
(replace (FX %#ALINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET
|
||||
(SUB1 WORDSPERCELL]
|
||||
[ACLINK (SHOULDNT)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM]
|
||||
(ACCESSFNS FX ((FXBLOCK (ADDSTACKBASE DATUM))) (* ; "frame extension index")
|
||||
(BLOCKRECORD FXBLOCK ((FLAGS BITS 3) (* ; "= \STK.FX")
|
||||
(FAST FLAG)
|
||||
(NIL FLAG)
|
||||
(INCALL FLAG) (* ;
|
||||
"set when fncall microcode has to punt")
|
||||
(VALIDNAMETABLE FLAG) (* ;
|
||||
"if on, NAMETABLE field is filled in. If off, is same as FNHEADER")
|
||||
(NOPUSH FLAG) (* ;
|
||||
"when returning to this frame, don't push a value. Set by interrupt code")
|
||||
(USECNT BITS 8)
|
||||
(%#ALINK WORD) (* ; "low bit is SLOWP")
|
||||
(FNHEADER FULLXPOINTER)
|
||||
(NEXTBLOCK WORD)
|
||||
(PC WORD)
|
||||
(NAMETABLE# FULLXPOINTER)
|
||||
(%#BLINK WORD)
|
||||
(%#CLINK WORD)))
|
||||
(BLOCKRECORD FXBLOCK ((FLAGBYTE BYTE)
|
||||
(NIL BYTE)
|
||||
(NIL BITS 15) (* ; "most of the bits of #ALINK")
|
||||
(SLOWP FLAG) (* ;
|
||||
"if on, then BLINK and CLINK fields are valid. If off, they are implicit")
|
||||
(NIL FULLXPOINTER 2)
|
||||
(NAMETABHI WORD)
|
||||
(NAMETABLO WORD)))
|
||||
(TYPE? (IEQ (fetch (FX FLAGS) of DATUM)
|
||||
\STK.FX))
|
||||
[ACCESSFNS FX ((NAMETABLE (COND
|
||||
((fetch (FX VALIDNAMETABLE) of DATUM)
|
||||
(fetch (FX NAMETABLE#) of DATUM))
|
||||
(T (fetch (FX FNHEADER) of DATUM)))
|
||||
(PROGN (replace (FX FAST) of DATUM with NIL)
|
||||
(replace (FX NAMETABLE#) of DATUM with NEWVALUE)
|
||||
(replace (FX VALIDNAMETABLE) of DATUM with T)))
|
||||
(FRAMENAME (fetch (FNHEADER FRAMENAME) of (fetch (FX NAMETABLE)
|
||||
of DATUM)))
|
||||
(INVALIDP (EQ DATUM 0)) (* ;
|
||||
"true when A/CLink points at nobody, i.e. FX is bottom of stack")
|
||||
[FASTP (NOT (fetch (FX SLOWP) of DATUM))
|
||||
(PROGN (CHECK (NULL NEWVALUE))
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET))
|
||||
(replace (FX %#ALINK) of DATUM
|
||||
with (IPLUS NEWVALUE \#ALINK.OFFSET
|
||||
(SUB1 WORDSPERCELL]
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[BLINK (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX DUMMYBF) of DATUM))
|
||||
(T (fetch (FX %#BLINK) of DATUM)))
|
||||
(PROGN (replace (FX %#BLINK) of DATUM with NEWVALUE)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[CLINK (IDIFFERENCE (COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(fetch (FX %#ALINK) of DATUM))
|
||||
(T (fetch (FX %#CLINK) of DATUM)))
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN (replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET)
|
||||
)
|
||||
(COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX SLOWP) of DATUM with T]
|
||||
[ALINK (IDIFFERENCE (FLOOR (fetch (FX %#ALINK) of DATUM)
|
||||
WORDSPERCELL)
|
||||
\#ALINK.OFFSET)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM))
|
||||
(replace (FX %#CLINK) of DATUM
|
||||
with (fetch (FX %#ALINK) of DATUM]
|
||||
(replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET
|
||||
(SUB1
|
||||
WORDSPERCELL
|
||||
]
|
||||
[ACLINK (SHOULDNT)
|
||||
(PROGN [COND
|
||||
((fetch (FX FASTP) of DATUM)
|
||||
(replace (FX %#BLINK) of DATUM
|
||||
with (fetch (FX DUMMYBF) of DATUM]
|
||||
(replace (FX %#CLINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET)
|
||||
)
|
||||
(replace (FX %#ALINK) of DATUM with (IPLUS NEWVALUE
|
||||
\#ALINK.OFFSET
|
||||
(SUB1
|
||||
WORDSPERCELL
|
||||
]
|
||||
(* ;
|
||||
"replaces A & C Links at once more efficiently than separately")
|
||||
(DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
|
||||
"replaces A & C Links at once more efficiently than separately")
|
||||
(DUMMYBF (IDIFFERENCE DATUM WORDSPERCELL))
|
||||
|
||||
(* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too.")
|
||||
(* ;; "This is either an actual BF or %"residual%" BF that provides enough BF to find its IVAR slot. This means that when a FX is copied, the cell preceding the FX is copied too.")
|
||||
|
||||
(IVAR (fetch (BF IVAR) of (fetch (FX DUMMYBF)
|
||||
of DATUM)))
|
||||
[CHECKED (AND (type? FX DATUM)
|
||||
(OR (IEQ (fetch (FX DUMMYBF) of DATUM)
|
||||
(fetch (FX BLINK) of DATUM))
|
||||
(AND (fetch (BF RESIDUAL)
|
||||
of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(IEQ (fetch (BF IVAR)
|
||||
of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(fetch (BF IVAR)
|
||||
of (fetch (FX BLINK)
|
||||
of DATUM]
|
||||
(FIRSTPVAR (IPLUS DATUM (fetch (FX FXSIZE) of T)))
|
||||
(IVAR (fetch (BF IVAR) of (fetch (FX DUMMYBF) of DATUM)))
|
||||
[CHECKED (AND (type? FX DATUM)
|
||||
(OR (IEQ (fetch (FX DUMMYBF) of DATUM)
|
||||
(fetch (FX BLINK) of DATUM))
|
||||
(AND (fetch (BF RESIDUAL) of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(IEQ (fetch (BF IVAR) of (fetch (FX DUMMYBF)
|
||||
of DATUM))
|
||||
(fetch (BF IVAR) of (fetch (FX BLINK)
|
||||
of DATUM]
|
||||
(FIRSTPVAR (IPLUS DATUM (fetch (FX FXSIZE) of T)))
|
||||
(* ; "stack offset of PVAR0")
|
||||
(FXSIZE (PROGN 10)) (* ;
|
||||
"fixed overhead from flags thru clink")
|
||||
(PADDING (PROGN 4)) (* ;
|
||||
"doublecell of garbage for microcode use")
|
||||
(FIRSTTEMP (IPLUS (fetch (FX FIRSTPVAR) of DATUM)
|
||||
(fetch (FX NPVARWORDS) of DATUM)
|
||||
(fetch (FX PADDING) of DATUM)))
|
||||
(FXSIZE (PROGN 10)) (* ;
|
||||
"fixed overhead from flags thru clink")
|
||||
(PADDING (PROGN 4)) (* ;
|
||||
"doublecell of garbage for microcode use")
|
||||
(FIRSTTEMP (IPLUS (fetch (FX FIRSTPVAR) of DATUM)
|
||||
(fetch (FX NPVARWORDS) of DATUM)
|
||||
(fetch (FX PADDING) of DATUM)))
|
||||
(* ;
|
||||
"note that NPVARWORDS is obtained from the FNHEADER")
|
||||
(SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM)
|
||||
DATUM])
|
||||
"note that NPVARWORDS is obtained from the FNHEADER")
|
||||
(SIZE (IDIFFERENCE (fetch (FX NEXTBLOCK) of DATUM)
|
||||
DATUM])
|
||||
|
||||
(RECORD SPYOBJDATA (CACHEDLABEL PERCENT LABEL))
|
||||
)
|
||||
@@ -745,7 +745,9 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
", " TOPCOUNT " samples"])
|
||||
|
||||
(SPY.MAKE.TREE
|
||||
[LAMBDA (TREES SPYDATA WINDOW) (* ; "Edited 28-Apr-94 13:59 by sybalsky")
|
||||
[LAMBDA (TREES SPYDATA WINDOW) (* ; "Edited 4-Jan-2022 14:08 by rmk")
|
||||
(* ;
|
||||
"Edited 28-Apr-94 13:59 by sybalsky")
|
||||
(PROG (GRAPH IDS W H THRSH TOPCOUNT (*PACKAGE* (fetch (SPYDATA PACKAGE) of SPYDATA))
|
||||
(*READTABLE* (fetch (SPYDATA READTABLE) of SPYDATA))
|
||||
(*PRINT-CASE* (fetch (SPYDATA PRINT-CASE) of SPYDATA)))
|
||||
@@ -755,8 +757,7 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
(SETQ THRSH (QUOTIENT (TIMES TOPCOUNT (fetch (SPYDATA THRESHOLD) of SPYDATA))
|
||||
100))
|
||||
(SETQ SPY.NODES)
|
||||
(SETQ SPY.TOPNODES (for X in TREES collect (SPY.MAKEGRAPHNODES X THRSH
|
||||
SPYDATA)))
|
||||
(SETQ SPY.TOPNODES (for X in TREES collect (SPY.MAKEGRAPHNODES X THRSH SPYDATA)))
|
||||
(SETQ TITLE (SPY.TITLE (CAR SPY.TOPNODES)
|
||||
TOPCOUNT SPYDATA))
|
||||
(SETQ SPY.WINDOW (SHOWGRAPH (LAYOUTGRAPH (REVERSE SPY.NODES)
|
||||
@@ -773,7 +774,8 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
(WINDOWPROP SPY.WINDOW 'SPYDATA SPYDATA)
|
||||
(WINDOWPROP SPY.WINDOW 'TREES TREES)
|
||||
(WINDOWPROP SPY.WINDOW 'SPYTITLE TITLE)
|
||||
(WINDOWPROP SPY.WINDOW 'TOPCOUNT TOPCOUNT])
|
||||
(WINDOWPROP SPY.WINDOW 'TOPCOUNT TOPCOUNT)
|
||||
(MODERNWINDOW SPY.WINDOW])
|
||||
|
||||
(SPY.UPDATE.TITLE
|
||||
[LAMBDA (W) (* ; "Edited 29-Apr-94 14:03 by sybalsky")
|
||||
@@ -965,23 +967,23 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTPROPS WITH-SPY MACRO ((FORM)
|
||||
(PUTPROPS WITH-SPY MACRO [(FORM)
|
||||
(PROGN (SPY.START)
|
||||
(PROG1 FORM (SPY.END]
|
||||
(PROG1 FORM (SPY.END])
|
||||
|
||||
[PUTPROPS WITH.SPY MACRO ((FORM)
|
||||
(PUTPROPS WITH.SPY MACRO [(FORM)
|
||||
(PROGN (SPY.START)
|
||||
(PROG1 FORM (SPY.END]
|
||||
(PROG1 FORM (SPY.END])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE SPYRECORD (NAME COUNT SUM CALLEES STATUS TREEFROM)
|
||||
STATUS _ 'NORMAL (INIT (DEFPRINT 'SPYRECORD 'SPY.PRINT)))
|
||||
STATUS _ 'NORMAL (INIT (DEFPRINT 'SPYRECORD 'SPY.PRINT)))
|
||||
|
||||
(PROPRECORD SPYDATA (DELETED CUMULATIVE MERGETYPE THRESHOLD SPYMENU DEPTH NOGHOSTS PACKAGE
|
||||
READTABLE PRINT-CASE MERGEINFO PENDING)
|
||||
CUMULATIVE _ T)
|
||||
(PROPRECORD SPYDATA (DELETED CUMULATIVE MERGETYPE THRESHOLD SPYMENU DEPTH NOGHOSTS PACKAGE READTABLE
|
||||
PRINT-CASE MERGEINFO PENDING)
|
||||
CUMULATIVE _ T)
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'SPYRECORD '(POINTER POINTER POINTER POINTER POINTER POINTER)
|
||||
@@ -1010,19 +1012,21 @@ Copyright (c) 1984, 1985, 1987, 1988, 1990, 1991, 1993, 1994 by Venue & Xerox Co
|
||||
|
||||
(FILESLOAD GRAPHER READNUMBER IMAGEOBJ)
|
||||
)
|
||||
|
||||
(MOVD? 'NILL 'MODERNWINDOW)
|
||||
(PUTPROPS SPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1987 1988 1990 1991 1993 1994))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5474 8081 (SPYOBJ 5484 . 5773) (SPYOBJ.BUTTON 5775 . 5885) (SPYOBJ.SAVE 5887 . 6006) (
|
||||
SPYOBJ.COPY 6008 . 6070) (SPYOBJ.GET 6072 . 6201) (SPYOBJ.IMAGEBOX 6203 . 6727) (SPYOBJ.DISPLAY 6729
|
||||
. 7028) (SPYOBJ.LABEL 7030 . 7166) (SPYOBJ.HEIGHT 7168 . 7381) (SPYOBJ.COPYIN 7383 . 7426) (
|
||||
SPY.COPYBUTTON 7428 . 7520) (SPY.MERGEINFO 7522 . 8079)) (19431 60601 (SPY.FIND.TREE 19441 . 19850) (
|
||||
SPY.TOGGLE 19852 . 20042) (SPY.TREE 20044 . 21156) (SPY.LEGEND 21158 . 21508) (SPY.GRAPH.EDITOR 21510
|
||||
. 31075) (SPY.END 31077 . 31319) (SPY.MAKEGRAPHNODES 31321 . 33421) (SPY.MAX 33423 . 34306) (
|
||||
SPY.MERGE 34308 . 35739) (SPY.MERGE1 35741 . 42224) (SPY.MERGETREE 42226 . 45156) (SPY.NEXT.TREE 45158
|
||||
. 45832) (SPY.SUM 45834 . 46523) (SPY.TITLE 46525 . 46742) (SPY.MAKE.TREE 46744 . 48632) (
|
||||
SPY.UPDATE.TITLE 48634 . 51210) (SPY.DELETE 51212 . 51747) (SPY.DRAWBOX 51749 . 52274) (
|
||||
SPY.BUFFER.ENTRY 52276 . 52514) (SPY.BUTTON 52516 . 53085) (SPY.END.ENTRY 53087 . 53167) (SPY.START
|
||||
53169 . 53453) (SPY.INIT 53455 . 53690) (\SPY.INTERRUPT 53692 . 54328) (SPY.DUMP.BUFFER 54330 . 55790)
|
||||
(SPY.START.ENTRY 55792 . 55920) (SPY.ADD.ENTRY 55922 . 56304) (SPY.ORIGINAL 56306 . 57133) (
|
||||
SPY.OVERFLOW 57135 . 57236) (SPY.MERGE.CALLEES 57238 . 60274) (SPY.PRINT 60276 . 60599)))))
|
||||
(FILEMAP (NIL (4753 7360 (SPYOBJ 4763 . 5052) (SPYOBJ.BUTTON 5054 . 5164) (SPYOBJ.SAVE 5166 . 5285) (
|
||||
SPYOBJ.COPY 5287 . 5349) (SPYOBJ.GET 5351 . 5480) (SPYOBJ.IMAGEBOX 5482 . 6006) (SPYOBJ.DISPLAY 6008
|
||||
. 6307) (SPYOBJ.LABEL 6309 . 6445) (SPYOBJ.HEIGHT 6447 . 6660) (SPYOBJ.COPYIN 6662 . 6705) (
|
||||
SPY.COPYBUTTON 6707 . 6799) (SPY.MERGEINFO 6801 . 7358)) (18202 59509 (SPY.FIND.TREE 18212 . 18621) (
|
||||
SPY.TOGGLE 18623 . 18813) (SPY.TREE 18815 . 19927) (SPY.LEGEND 19929 . 20279) (SPY.GRAPH.EDITOR 20281
|
||||
. 29846) (SPY.END 29848 . 30090) (SPY.MAKEGRAPHNODES 30092 . 32192) (SPY.MAX 32194 . 33077) (
|
||||
SPY.MERGE 33079 . 34510) (SPY.MERGE1 34512 . 40995) (SPY.MERGETREE 40997 . 43927) (SPY.NEXT.TREE 43929
|
||||
. 44603) (SPY.SUM 44605 . 45294) (SPY.TITLE 45296 . 45513) (SPY.MAKE.TREE 45515 . 47540) (
|
||||
SPY.UPDATE.TITLE 47542 . 50118) (SPY.DELETE 50120 . 50655) (SPY.DRAWBOX 50657 . 51182) (
|
||||
SPY.BUFFER.ENTRY 51184 . 51422) (SPY.BUTTON 51424 . 51993) (SPY.END.ENTRY 51995 . 52075) (SPY.START
|
||||
52077 . 52361) (SPY.INIT 52363 . 52598) (\SPY.INTERRUPT 52600 . 53236) (SPY.DUMP.BUFFER 53238 . 54698)
|
||||
(SPY.START.ENTRY 54700 . 54828) (SPY.ADD.ENTRY 54830 . 55212) (SPY.ORIGINAL 55214 . 56041) (
|
||||
SPY.OVERFLOW 56043 . 56144) (SPY.MERGE.CALLEES 56146 . 59182) (SPY.PRINT 59184 . 59507)))))
|
||||
STOP
|
||||
|
||||
BIN
library/SPY.LCOM
BIN
library/SPY.LCOM
Binary file not shown.
149
library/TEDIT
149
library/TEDIT
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Oct-2021 10:00:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;19 142287
|
||||
(FILECREATED "30-Dec-2021 20:50:54" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDIT.;30 142870
|
||||
|
||||
changes to%: (FNS TEDIT-SEE)
|
||||
:CHANGES-TO (FNS TEDIT TEDIT-SEE)
|
||||
|
||||
previous date%: "11-Oct-2021 14:03:12"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDIT.;18)
|
||||
:PREVIOUS-DATE "28-Dec-2021 11:02:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDIT.;24)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -27,9 +26,9 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP))
|
||||
(TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU))
|
||||
(* ;
|
||||
"Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")
|
||||
"Original was (CREATE MENU ITEMS _ '(NewEditProcess)).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
)
|
||||
(GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS)
|
||||
(FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE
|
||||
@@ -40,10 +39,10 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
\TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1)
|
||||
(P (MOVD? 'NILL 'OBJECTOUTOFTEDIT))
|
||||
(* ;
|
||||
"HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
|
||||
"HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.")
|
||||
(COMS (FNS \CREATE.TEDIT.RESTART.MENU))
|
||||
(* ;
|
||||
"Added by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
"Added by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
(COMS (* ; "Debugging functions")
|
||||
(FNS PLCHAIN PRINTLINE SEEFILE))
|
||||
(COMS (* ; "Object-oriented editing")
|
||||
@@ -56,10 +55,10 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA"))
|
||||
(FNS MAKETEDITFORM)
|
||||
(P (ADDTOVAR LAFITESPECIALFORMS ("TEdit Report" 'MAKETEDITFORM
|
||||
"Report a problem with TEdit"))
|
||||
"Report a problem with TEdit"))
|
||||
(SETQ LAFITEFORMSMENU NIL)))
|
||||
(COMS (* ;
|
||||
"LISTFILES Interface, so the system can decide if a file is a TEdit file.")
|
||||
"LISTFILES Interface, so the system can decide if a file is a TEdit file.")
|
||||
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
|
||||
(EXTENSION (TEDIT])
|
||||
|
||||
@@ -251,21 +250,29 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
NIL])
|
||||
|
||||
(TEDIT
|
||||
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ; "Edited 11-Jun-99 14:14 by rmk:")
|
||||
(* ; "Edited 11-Jun-99 14:13 by rmk:")
|
||||
(* ; "Edited 11-Jun-99 14:08 by rmk:")
|
||||
(* ; "Edited 3-Jun-88 14:27 by jds")
|
||||
[LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ; "Edited 30-Dec-2021 20:50 by rmk")
|
||||
(* ; "Edited 28-Dec-2021 00:12 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 19:21 by rmk")
|
||||
(* ; "Edited 11-Jun-99 14:14 by rmk:")
|
||||
(* ; "Edited 3-Jun-88 14:27 by jds")
|
||||
|
||||
(* ;; "User entry to the text editor. Takes an optional window to be used for editing")
|
||||
(* ;; "User entry to the text editor. Takes an optional window to be used for editing")
|
||||
|
||||
(* ;; "DONTSPAWN => Don't try to create a new process for this edit.")
|
||||
(* ;; "DONTSPAWN => Don't try to create a new process for this edit.")
|
||||
|
||||
(PROG (PROC TEDITCREATEDWINDOW) (* ;
|
||||
"Include the default properties in the list.")
|
||||
(PROG (PROC TEDITCREATEDWINDOW) (* ;
|
||||
"Include the default properties in the list.")
|
||||
[COND
|
||||
((AND TEXT (ATOM TEXT)) (* ;
|
||||
"Make sure the file exists before trying to open the window.")
|
||||
((AND TEXT (ATOM TEXT)) (* ;
|
||||
"Make sure the file exists before trying to open the window.")
|
||||
(SETQ TEXT (OPENFILE TEXT 'INPUT 'OLD '((TYPE TEXT]
|
||||
(CL:WHEN (AND WINDOW (OR (LITATOM WINDOW)
|
||||
(REGIONP WINDOW)))
|
||||
|
||||
(* ;; "Pass specified and typed regions to TEDIT.CREATEW")
|
||||
|
||||
(PUSH PROPS 'REGION-TYPE WINDOW)
|
||||
(SETQ WINDOW NIL))
|
||||
(RESETLST
|
||||
[RESETSAVE NIL `(AND ,WINDOW (WINDOWPROP ,WINDOW 'TEXTOBJ NIL]
|
||||
(WITH.MONITOR TEDIT.STARTUP.MONITORLOCK
|
||||
@@ -273,7 +280,8 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
((NOT WINDOW)
|
||||
(SETQ TEDITCREATEDWINDOW T)
|
||||
(SETQ WINDOW (COND
|
||||
[(OR (NOT TEDIT.DEFAULT.WINDOW)
|
||||
[(OR (LISTGET PROPS 'REGION-TYPE)
|
||||
(NOT TEDIT.DEFAULT.WINDOW)
|
||||
(\TEDIT.ACTIVE.WINDOWP TEDIT.DEFAULT.WINDOW))
|
||||
(TEDIT.CREATEW (COND
|
||||
((AND TEXT (ATOM TEXT))
|
||||
@@ -289,28 +297,27 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
'REGION)
|
||||
TEXT
|
||||
(APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)))
|
||||
(* ; "Replace the old title")
|
||||
(* ; "Replace the old title")
|
||||
TEDIT.DEFAULT.WINDOW)))
|
||||
|
||||
(* ;;
|
||||
"Mark the newly-created window reserved until the OPENTEXTSTREAM has done its work.")
|
||||
(* ;;
|
||||
"Mark the newly-created window reserved until the OPENTEXTSTREAM has done its work.")
|
||||
|
||||
(* ;;
|
||||
"mark that we created the window so that we know we can update the title, etc.")
|
||||
(* ;;
|
||||
"mark that we created the window so that we know we can update the title, etc.")
|
||||
|
||||
(WINDOWPROP WINDOW 'TEXTOBJ T)))))
|
||||
[SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL (APPEND PROPS '(BEING-EDITED T]
|
||||
(* ;
|
||||
"Connect the editor to the window")
|
||||
(* ; "Connect the editor to the window")
|
||||
(replace (TEXTOBJ TXTEDITING) of (TEXTOBJ TEXT) with T)
|
||||
(* ; "For the moment, mark the document as actively in edit. (so caret flashes when the window is first brought up.)")
|
||||
(* ; "For the moment, mark the document as actively in edit. (so caret flashes when the window is first brought up.)")
|
||||
[COND
|
||||
(TEDITCREATEDWINDOW (TEXTPROP TEXT 'TEDITCREATEDWINDOW 'T]
|
||||
(COND
|
||||
(DONTSPAWN (* ;
|
||||
"Either no processes running, or specifically not to spawn one.")
|
||||
(DONTSPAWN (* ;
|
||||
"Either no processes running, or specifically not to spawn one.")
|
||||
(RETURN (\TEDIT2 TEXT WINDOW T)))
|
||||
(T (* ; "Spawn a process to do the edit.")
|
||||
(T (* ; "Spawn a process to do the edit.")
|
||||
[SETQ PROC (ADD.PROCESS (LIST '\TEDIT2 (KWOTE TEXT)
|
||||
WINDOW NIL)
|
||||
'NAME
|
||||
@@ -324,14 +331,16 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(PROCESSPROP PROC 'WINDOW WINDOW)
|
||||
(COND
|
||||
((NOT (LISTGET (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS))
|
||||
'LEAVETTY)) (* ;
|
||||
"Unless he asked us to leave the tty where it is, TEdit should get it.")
|
||||
'LEAVETTY)) (* ;
|
||||
"Unless he asked us to leave the tty where it is, TEdit should get it.")
|
||||
(TTY.PROCESS PROC)))
|
||||
(RETURN PROC])
|
||||
|
||||
(TEDIT-SEE
|
||||
[LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 13-Oct-2021 10:00 by rmk:")
|
||||
(* ; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
[LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 30-Dec-2021 18:03 by rmk")
|
||||
(* ; "Edited 16-Dec-2021 12:33 by rmk")
|
||||
(* ; "Edited 13-Oct-2021 10:00 by rmk:")
|
||||
(* ; "Edited 27-Feb-2021 20:07 by rmk:")
|
||||
(* ; "Edited 1-Feb-88 19:00 by bvm:")
|
||||
|
||||
(* ;; "See FILE in a scrollable READONLY TEDIT window. If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.")
|
||||
@@ -347,29 +356,27 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(IF (\TEDIT.FORMATTEDP1 STREAM)
|
||||
ELSEIF (LISPSOURCEFILEP STREAM)
|
||||
THEN
|
||||
(* ;; "Lisp source file")
|
||||
|
||||
(* ;; "Lisp source file")
|
||||
|
||||
(SETQ SEESTREAM (OPENTEXTSTREAM))
|
||||
(DSPFONT DEFAULTFONT SEESTREAM)
|
||||
(COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
|
||||
(SETQ SEESTREAM (OPENTEXTSTREAM))
|
||||
(DSPFONT DEFAULTFONT SEESTREAM)
|
||||
(COPY.TEXT.TO.IMAGE STREAM SEESTREAM)
|
||||
ELSE
|
||||
(* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.")
|
||||
|
||||
(* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.")
|
||||
(* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).")
|
||||
|
||||
(* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).")
|
||||
|
||||
(SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8)
|
||||
:DEFAULT))
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
(SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
|
||||
(COPYCHARS STREAM SEESTREAM)))
|
||||
(SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8)
|
||||
:DEFAULT))
|
||||
(CL:UNLESS (RANDACCESSP STREAM)
|
||||
(SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW))
|
||||
(COPYCHARS STREAM SEESTREAM)))
|
||||
[SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL
|
||||
`(READONLY T FONT ,DEFAULTFONT]
|
||||
(WINDOWPROP (WFROMDS TSTREAM)
|
||||
`(READONLY T LEAVETTY T FONT ,DEFAULTFONT]
|
||||
[WINDOWPROP (WFROMDS TSTREAM)
|
||||
'TITLE
|
||||
(CONCAT "SEE window for " (FULLNAME STREAM)))
|
||||
(FULLNAME STREAM])
|
||||
(OR TITLE (CONCAT "SEE window for " (FULLNAME STREAM]
|
||||
TSTREAM])
|
||||
|
||||
(TEDIT.CHARWIDTH
|
||||
[LAMBDA (CH FONT TERMSA) (* jds "22-OCT-83 19:32")
|
||||
@@ -2236,7 +2243,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(* ; "TEDIT Support information")
|
||||
|
||||
|
||||
(RPAQQ TEDITSYSTEMDATE "13-Oct-2021 10:00:40")
|
||||
(RPAQQ TEDITSYSTEMDATE "30-Dec-2021 20:50:54")
|
||||
|
||||
(RPAQ TEDITSUPPORT "TEditSupport.PA")
|
||||
(DEFINEQ
|
||||
@@ -2258,23 +2265,23 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
|
||||
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1)
|
||||
(EXTENSION (TEDIT))))
|
||||
(EXTENSION (TEDIT))))
|
||||
(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 (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)))))
|
||||
(FILEMAP (NIL (4336 118040 (\TEDIT2 4346 . 7097) (COERCETEXTOBJ 7099 . 15875) (TEDIT 15877 . 21230) (
|
||||
TEDIT-SEE 21232 . 23716) (TEDIT.CHARWIDTH 23718 . 25742) (TEDIT.COPY 25744 . 34180) (TEDIT.DELETE
|
||||
34182 . 34872) (TEDIT.DO.BLUEPENDINGDELETE 34874 . 37941) (TEDIT.INSERT 37943 . 43473) (TEDIT.KILL
|
||||
43475 . 45032) (TEDIT.MAPLINES 45034 . 46433) (TEDIT.MAPPIECES 46435 . 47391) (TEDIT.MOVE 47393 .
|
||||
57177) (TEDIT.QUIT 57179 . 59179) (TEDIT.STRINGWIDTH 59181 . 59852) (TEDIT.\INSERT 59854 . 61879) (
|
||||
TEXTOBJ 61881 . 63006) (TEXTSTREAM 63008 . 64623) (\TEDIT.INCLUDE 64625 . 68525) (\TEDIT.INSERT.PIECES
|
||||
68527 . 78442) (\TEDIT.MOVE.PIECEMAPFN 78444 . 80523) (\TEDIT.OBJECT.SHOWSEL 80525 . 84154) (
|
||||
\TEDIT.RESTARTFN 84156 . 86151) (\TEDIT.CHARDELETE 86153 . 90115) (\TEDIT.COPY.PIECEMAPFN 90117 .
|
||||
93342) (\TEDIT.DELETE 93344 . 100862) (\TEDIT.DIFFUSE.PARALOOKS 100864 . 103628) (\TEDIT.FOREIGN.COPY?
|
||||
103630 . 107357) (\TEDIT.QUIT 107359 . 110505) (\TEDIT.WORDDELETE 110507 . 115340) (\TEDIT1 115342 .
|
||||
118038)) (118154 118270 (\CREATE.TEDIT.RESTART.MENU 118164 . 118268)) (118369 122058 (PLCHAIN 118379
|
||||
. 118653) (PRINTLINE 118655 . 121419) (SEEFILE 121421 . 122056)) (122099 141742 (TEDIT.INSERT.OBJECT
|
||||
122109 . 131186) (TEDIT.EDIT.OBJECT 131188 . 133444) (TEDIT.FIND.OBJECT 133446 . 134339) (
|
||||
TEDIT.FIND.OBJECT.SUBTREE 134341 . 135147) (TEDIT.PUT.OBJECT 135149 . 136808) (TEDIT.GET.OBJECT 136810
|
||||
. 140009) (TEDIT.OBJECT.CHANGED 140011 . 141740)) (142020 142383 (MAKETEDITFORM 142030 . 142381)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Sep-2021 15:33:24"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;10 106458
|
||||
|
||||
changes to%: (FNS TEDIT.HARDCOPYFN)
|
||||
(VARS TEDITHCPYCOMS)
|
||||
(FILECREATED "26-Jan-2022 23:03:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITHCPY.;15 106802
|
||||
|
||||
previous date%: "21-Sep-2021 12:54:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITHCPY.;7)
|
||||
:CHANGES-TO (VARS TEDITHCPYCOMS)
|
||||
|
||||
:PREVIOUS-DATE "27-Sep-2021 23:28:48"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITHCPY.;14)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -35,18 +34,18 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
|
||||
(* ;
|
||||
"0.75 inches from bottom, 1 from top")
|
||||
)
|
||||
"0.75 inches from bottom, 1 from top"))
|
||||
[COMS
|
||||
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
|
||||
|
||||
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
|
||||
(P (LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
|
||||
'TEDIT
|
||||
(FUNCTION \TEDIT.HARDCOPY)))
|
||||
[P (LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
|
||||
(COND (IPVALUES (* ;
|
||||
"Only install INTERPRESS printing if INTERPRESS is loaded.")
|
||||
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.HARDCOPY]
|
||||
(P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
|
||||
(COND (PRESSVALUES (* ;
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
[COMS
|
||||
(* ;; "vars for Japanese Line Break")
|
||||
@@ -1568,14 +1567,16 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
PFILE)])
|
||||
)
|
||||
|
||||
(LISTPUT (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES))
|
||||
'TEDIT
|
||||
(FUNCTION \TEDIT.HARDCOPY))
|
||||
[LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
|
||||
(COND
|
||||
(IPVALUES (* ;
|
||||
"Only install INTERPRESS printing if INTERPRESS is loaded.")
|
||||
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.HARDCOPY]
|
||||
|
||||
[LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
|
||||
(COND
|
||||
(PRESSVALUES (* ;
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
"Only install PRESS printing if PRESS is loaded.")
|
||||
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
|
||||
|
||||
|
||||
@@ -1616,11 +1617,11 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(PUTPROPS TEDITHCPY COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3655 100373 (TEDIT.HARDCOPY 3665 . 4916) (TEDIT.HCPYFILE 4918 . 6992) (
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE 6994 . 21139) (\TEDIT.HARDCOPY.FORMATLINE 21141 . 68463) (
|
||||
\DOFORMATTING.HARDCOPY 68465 . 81758) (\TEDIT.HARDCOPY.MODIFYLOOKS 81760 . 84167) (
|
||||
\TEDIT.HCPYLOOKS.UPDATE 84169 . 94777) (\TEDIT.HCPYFMTSPEC 94779 . 99799) (\TEDIT.INTEGER.IMAGEBOX
|
||||
99801 . 100371)) (100462 101546 (\TEDIT.SCALE 100472 . 100766) (\TEDIT.SCALEREGION 100768 . 101544)) (
|
||||
101789 104340 (TEDIT.HARDCOPYFN 101799 . 102704) (\TEDIT.HARDCOPY 102706 . 103615) (
|
||||
\TEDIT.PRESS.HARDCOPY 103617 . 104338)) (105405 106308 (TEDIT-BOOK 105415 . 106306)))))
|
||||
(FILEMAP (NIL (3784 100502 (TEDIT.HARDCOPY 3794 . 5045) (TEDIT.HCPYFILE 5047 . 7121) (
|
||||
\TEDIT.HARDCOPY.DISPLAYLINE 7123 . 21268) (\TEDIT.HARDCOPY.FORMATLINE 21270 . 68592) (
|
||||
\DOFORMATTING.HARDCOPY 68594 . 81887) (\TEDIT.HARDCOPY.MODIFYLOOKS 81889 . 84296) (
|
||||
\TEDIT.HCPYLOOKS.UPDATE 84298 . 94906) (\TEDIT.HCPYFMTSPEC 94908 . 99928) (\TEDIT.INTEGER.IMAGEBOX
|
||||
99930 . 100500)) (100591 101675 (\TEDIT.SCALE 100601 . 100895) (\TEDIT.SCALEREGION 100897 . 101673)) (
|
||||
101918 104469 (TEDIT.HARDCOPYFN 101928 . 102833) (\TEDIT.HARDCOPY 102835 . 103744) (
|
||||
\TEDIT.PRESS.HARDCOPY 103746 . 104467)) (105749 106652 (TEDIT-BOOK 105759 . 106650)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "29-Apr-2021 22:44:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;5 275764
|
||||
|
||||
changes to%: (FNS \TEDIT.MENU.INIT)
|
||||
(FILECREATED "31-Jan-2022 22:54:59" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITMENU.;3 275091
|
||||
|
||||
previous date%: "29-Apr-2021 22:40:33"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITMENU.;4)
|
||||
:CHANGES-TO (FNS \TEXTMENU.DOC.CREATE)
|
||||
|
||||
:PREVIOUS-DATE "26-Oct-2021 08:44:02"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITMENU.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -19,7 +19,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
[COMS (* ; "Simple Menu Button support")
|
||||
[COMS (* ; "Simple Menu Button support")
|
||||
(FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN
|
||||
MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME
|
||||
MBUTTON.FIND.BUTTON MBUTTON.FIND.NEXT.BUTTON MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT
|
||||
@@ -31,13 +31,13 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;;
|
||||
"Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")
|
||||
(* ;;
|
||||
"Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD")
|
||||
|
||||
(FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN
|
||||
MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT]
|
||||
[COMS (* ; "One-of-N Menu button sets")
|
||||
[COMS (* ; "One-of-N Menu button sets")
|
||||
(FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN
|
||||
MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS
|
||||
MB.NWAYBUTTON.ADDITEM)
|
||||
@@ -45,7 +45,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;; "Two-state, toggling menu buttons.")
|
||||
(* ;; "Two-state, toggling menu buttons.")
|
||||
|
||||
(FNS \TEXTMENU.TOGGLE.CREATE \TEXTMENU.TOGGLE.DISPLAY \TEXTMENU.TOGGLE.SHOWSELFN
|
||||
\TEXTMENU.TOGGLE.WHENOPERATEDFN \TEXTMENU.TOGGLEFN \TEXTMENU.TOGGLE.INIT
|
||||
@@ -54,7 +54,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTMENU.TOGGLE.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN]
|
||||
[COMS
|
||||
(* ;; "Margin Setting and display")
|
||||
(* ;; "Margin Setting and display")
|
||||
|
||||
(FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN
|
||||
MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK
|
||||
@@ -66,11 +66,11 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT))
|
||||
(ADDVARS (IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN]
|
||||
(COMS
|
||||
(* ;; "Text menu creation and support")
|
||||
(* ;; "Text menu creation and support")
|
||||
|
||||
(FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN)
|
||||
(BITMAPS TEXTMENUICON TEXTMENUICONMASK))
|
||||
[COMS (* ; "TEdit-specific support")
|
||||
[COMS (* ; "TEdit-specific support")
|
||||
(FNS \TEDITMENU.CREATE \TEDIT.EXPANDED.MENU MB.DEFAULTBUTTON.FN
|
||||
\TEDITMENU.RECORD.UNFORMATTED MB.DEFAULTBUTTON.ACTIONFN)
|
||||
(FNS \TEDIT.CHARLOOKSMENU.CREATE \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.APPLY.BOLDNESS
|
||||
@@ -82,7 +82,7 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
\TEDIT.SHOW.PARALOOKS \TEDIT.NEUTRALIZE.PARALOOKS.MENU \TEDIT.RECORD.TABLEADERS)
|
||||
(FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING
|
||||
TEDIT.UNPARSE.PAGEFORMAT)
|
||||
(COMS (* ; "Initialization Code")
|
||||
(COMS (* ; "Initialization Code")
|
||||
(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU
|
||||
TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC
|
||||
TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC TEDIT.EXPANDED.PAGEMENU)
|
||||
@@ -2067,11 +2067,14 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(\TEXTMENU.START
|
||||
[LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ;
|
||||
[LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ; "Edited 26-Oct-2021 08:43 by rmk:")
|
||||
(* ;
|
||||
"Edited 4-Jun-93 11:59 by sybalsky:mv:envos")
|
||||
|
||||
(* ;; "Create a TEdit-based menu for a given main window.")
|
||||
|
||||
(* ;; "RMK: Add MAX/MINSIZE so menus don't grow vertically when the main window is reshaped. Not sure why HEIGHT is passed in or defaults to 133, but either way, the original window height should persist")
|
||||
|
||||
(PROG ([WREG (COND
|
||||
(MAINWINDOW (WINDOWPROP MAINWINDOW 'REGION))
|
||||
(T (GETREGION]
|
||||
@@ -2104,6 +2107,9 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(* ;
|
||||
"Mark this as a TEDIT MENU window")
|
||||
(ATTACHWINDOW MENUW MAINWINDOW 'TOP 'JUSTIFY 'LOCALCLOSE)
|
||||
[SETQ HEIGHT (FETCH (REGION HEIGHT) OF (WINDOWPROP MENUW 'REGION]
|
||||
(WINDOWPROP MENUW 'MAXSIZE (CONS 64000 HEIGHT))
|
||||
(WINDOWPROP MENUW 'MINSIZE (CONS 0 HEIGHT))
|
||||
(SETQ MENUTEXT MENU)
|
||||
(replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
with T)
|
||||
@@ -2116,155 +2122,141 @@ Copyright (c) 1983-1995, 2021 by Venue & Xerox Corporation.
|
||||
(AND MAINWINDOW (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS])
|
||||
|
||||
(\TEXTMENU.DOC.CREATE
|
||||
[LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 12-Jun-90 19:00 by mitani")
|
||||
[LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 31-Jan-2022 22:48 by rmk")
|
||||
(* ; "Edited 12-Jun-90 19:00 by mitani")
|
||||
|
||||
(* Create the TEXTSTREAM for a menu, given a description.
|
||||
That stream is passed to \TEXTMENU.START to get the menu up on screen)
|
||||
(* Create the TEXTSTREAM for a menu, given a description.
|
||||
That stream is passed to \TEXTMENU.START to get the menu up on screen)
|
||||
|
||||
(PROG ((CH#1 NIL)
|
||||
MENUW MENUTEXT)
|
||||
[SETQ MENUTEXT (OPENTEXTSTREAM "" NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10]
|
||||
[SETQ MENUTEXT (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10]
|
||||
(bind (CH# _ 1)
|
||||
OBJ for DESC in MENUDESC
|
||||
OBJ for DESC in MENUDESC
|
||||
do (SELECTQ (CAR DESC)
|
||||
(* (* This is a comment within a menu
|
||||
description -- Ignore it.))
|
||||
(MB.BUTTON (* A menu button --
|
||||
hitting it calls a function)
|
||||
(TEDIT.INSERT.OBJECT (MBUTTON.CREATE
|
||||
(MKATOM (fetch (MB.BUTTON MBLABEL)
|
||||
of DESC))
|
||||
(fetch (MB.BUTTON MBBUTTONEVENTFN)
|
||||
of DESC)
|
||||
(fetch (MB.BUTTON MBFONT) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.3STATE (* 3-state button;
|
||||
hitting it changes state among ON,
|
||||
OFF, and NEUTRAL.)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.THREESTATEBUTTON
|
||||
(MKATOM (fetch (MB.3STATE MBLABEL)
|
||||
of DESC))
|
||||
(fetch (MB.3STATE MBFONT) of DESC)
|
||||
(fetch (MB.3STATE MBCHANGESTATEFN)
|
||||
of DESC)
|
||||
(fetch (MB.3STATE MBINITSTATE)
|
||||
of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TOGGLE (* TOGGLE button; hitting it
|
||||
switches between ON and OFF.)
|
||||
(TEDIT.INSERT.OBJECT (\TEXTMENU.TOGGLE.CREATE
|
||||
(MKATOM (fetch (MB.TOGGLE MBTEXT)
|
||||
of DESC))
|
||||
(fetch (MB.TOGGLE MBFONT) of DESC)
|
||||
(fetch (MB.TOGGLE MBCHANGESTATEFN)
|
||||
of DESC)
|
||||
(fetch (MB.TOGGLE MBINITSTATE)
|
||||
of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.NWAY (* N-way buttons; choosing one turns
|
||||
the others off.)
|
||||
(SETQ OBJ (MB.CREATE.NWAYBUTTON (fetch (MB.NWAY MBBUTTONS)
|
||||
of DESC)
|
||||
(fetch (MB.NWAY MBFONT) of DESC)
|
||||
(fetch (MB.NWAY MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.NWAY MBINITSTATE) of DESC)
|
||||
(fetch (MB.NWAY MBMAXITEMSPERLINE) of
|
||||
DESC)))
|
||||
(TEDIT.INSERT.OBJECT OBJ MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MENU (* Real menu, except the selection
|
||||
sticks)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.MARGINBAR (* Margin ruler for TEdit formatting)
|
||||
(TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -0.5 -0.5 -39.5 NIL
|
||||
12)
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TEXT (* Arbitrary text, which will be
|
||||
protected from the user.)
|
||||
(TEDIT.INSERT MENUTEXT (fetch (MB.TEXT MBSTRING) of DESC)
|
||||
CH#)
|
||||
[AND (fetch (MB.TEXT MBFONT) of DESC)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
(LIST 'MBFONT (fetch (MB.TEXT MBFONT) of DESC))
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC]
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))
|
||||
(add CH# (NCHARS (fetch (MB.TEXT MBSTRING) of DESC))))
|
||||
(MB.INSERT (* An insertion point, with optional
|
||||
text to put there)
|
||||
(TEDIT.INSERT MENUTEXT " {}" CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH# 4)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON SELECTPOINT ON)
|
||||
(IPLUS CH# 2)
|
||||
1)
|
||||
(OR CH#1 (SETQ CH#1 (IPLUS CH# 3)))
|
||||
[COND
|
||||
((fetch (MB.INSERT MBINITENTRY) of DESC)
|
||||
(* There is an initial entry to be
|
||||
made. Make it)
|
||||
[COND
|
||||
((IMAGEOBJP (fetch (MB.INSERT MBINITENTRY) of
|
||||
DESC))
|
||||
(* It is an imageobj.)
|
||||
(TEDIT.INSERT.OBJECT (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC)
|
||||
MENUTEXT
|
||||
(IPLUS CH# 3)))
|
||||
(T (* It's regular text.)
|
||||
(TEDIT.INSERT MENUTEXT (MKSTRING (fetch (MB.INSERT
|
||||
MBINITENTRY
|
||||
(* (* This is a comment within a menu
|
||||
description -- Ignore it.))
|
||||
(MB.BUTTON (* A menu button -- hitting it calls a
|
||||
function)
|
||||
(TEDIT.INSERT.OBJECT (MBUTTON.CREATE (MKATOM (fetch (MB.BUTTON MBLABEL
|
||||
)
|
||||
of DESC))
|
||||
(IPLUS CH# 3]
|
||||
[TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF SELECTPOINT OFF)
|
||||
(IPLUS CH# 3)
|
||||
(NCHARS (MKSTRING (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC]
|
||||
(add CH# (NCHARS (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC))
|
||||
(fetch (MB.BUTTON MBBUTTONEVENTFN)
|
||||
of DESC)
|
||||
(fetch (MB.BUTTON MBFONT) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.3STATE (* 3-state button; hitting it changes
|
||||
state among ON, OFF, and NEUTRAL.)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.THREESTATEBUTTON
|
||||
(MKATOM (fetch (MB.3STATE MBLABEL) of DESC))
|
||||
(fetch (MB.3STATE MBFONT) of DESC)
|
||||
(fetch (MB.3STATE MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.3STATE MBINITSTATE) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TOGGLE (* TOGGLE button; hitting it switches
|
||||
between ON and OFF.)
|
||||
(TEDIT.INSERT.OBJECT (\TEXTMENU.TOGGLE.CREATE
|
||||
(MKATOM (fetch (MB.TOGGLE MBTEXT) of DESC))
|
||||
(fetch (MB.TOGGLE MBFONT) of DESC)
|
||||
(fetch (MB.TOGGLE MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.TOGGLE MBINITSTATE) of DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.NWAY (* N-way buttons; choosing one turns
|
||||
the others off.)
|
||||
(SETQ OBJ (MB.CREATE.NWAYBUTTON (fetch (MB.NWAY MBBUTTONS) of DESC)
|
||||
(fetch (MB.NWAY MBFONT) of DESC)
|
||||
(fetch (MB.NWAY MBCHANGESTATEFN) of DESC)
|
||||
(fetch (MB.NWAY MBINITSTATE) of DESC)
|
||||
(fetch (MB.NWAY MBMAXITEMSPERLINE) of DESC)))
|
||||
(TEDIT.INSERT.OBJECT OBJ MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MENU (* Real menu, except the selection
|
||||
sticks)
|
||||
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC))
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.MARGINBAR (* Margin ruler for TEdit formatting)
|
||||
(TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -0.5 -0.5 -39.5 NIL 12)
|
||||
MENUTEXT CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF)
|
||||
CH# 1)
|
||||
(add CH# 1))
|
||||
(MB.TEXT (* Arbitrary text, which will be
|
||||
protected from the user.)
|
||||
(TEDIT.INSERT MENUTEXT (fetch (MB.TEXT MBSTRING) of DESC)
|
||||
CH#)
|
||||
[AND (fetch (MB.TEXT MBFONT) of DESC)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
(LIST 'MBFONT (fetch (MB.TEXT MBFONT) of DESC))
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC]
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH#
|
||||
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))
|
||||
(add CH# (NCHARS (fetch (MB.TEXT MBSTRING) of DESC))))
|
||||
(MB.INSERT (* An insertion point, with optional
|
||||
text to put there)
|
||||
(TEDIT.INSERT MENUTEXT " {}" CH#)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON)
|
||||
CH# 4)
|
||||
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED ON SELECTPOINT ON)
|
||||
(IPLUS CH# 2)
|
||||
1)
|
||||
(OR CH#1 (SETQ CH#1 (IPLUS CH# 3)))
|
||||
[COND
|
||||
((fetch (MB.INSERT MBINITENTRY) of DESC)
|
||||
(* There is an initial entry to be
|
||||
made. Make it)
|
||||
[COND
|
||||
((IMAGEOBJP (fetch (MB.INSERT MBINITENTRY) of DESC))
|
||||
(* It is an imageobj.)
|
||||
(TEDIT.INSERT.OBJECT (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC)
|
||||
MENUTEXT
|
||||
(IPLUS CH# 3)))
|
||||
(T (* It's regular text.)
|
||||
(TEDIT.INSERT MENUTEXT (MKSTRING (fetch (MB.INSERT
|
||||
MBINITENTRY)
|
||||
of DESC))
|
||||
(IPLUS CH# 3]
|
||||
[TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
'(PROTECTED OFF SELECTPOINT OFF)
|
||||
(IPLUS CH# 3)
|
||||
(NCHARS (MKSTRING (fetch (MB.INSERT MBINITENTRY)
|
||||
of DESC]
|
||||
(add CH# 4))
|
||||
(\ILLEGAL.ARG DESC)))
|
||||
(replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
|
||||
with T) (* Remember that this is a menu)
|
||||
(add CH# (NCHARS (fetch (MB.INSERT MBINITENTRY) of DESC]
|
||||
(add CH# 4))
|
||||
(\ILLEGAL.ARG DESC)))
|
||||
(replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T)
|
||||
(* Remember that this is a menu)
|
||||
[COND
|
||||
(CH#1 (* We actually inserted some text,
|
||||
so it makes sense to put up a
|
||||
selection)
|
||||
(push (fetch (TEXTOBJ EDITPROPS) of (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of MENUTEXT))
|
||||
(LIST 'SEL CH#1] (* And where the first selection
|
||||
should be.)
|
||||
(CH#1 (* We actually inserted some text, so
|
||||
it makes sense to put up a selection)
|
||||
(push (fetch (TEXTOBJ EDITPROPS) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT))
|
||||
(LIST 'SEL CH#1] (* And where the first selection
|
||||
should be.)
|
||||
(RETURN MENUTEXT])
|
||||
|
||||
(TEXTMENU.CLOSEFN
|
||||
@@ -4502,42 +4494,42 @@ Tab Type: "
|
||||
(PUTPROPS TEDITMENU COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 1995 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6266 33108 (MB.BUTTONEVENTINFN 6276 . 7607) (MB.DISPLAY 7609 . 9977) (MB.SETIMAGE 9979
|
||||
. 10937) (MB.SELFN 10939 . 12354) (MB.SIZEFN 12356 . 13373) (MB.WHENOPERATEDFN 13375 . 13707) (
|
||||
MB.COPYFN 13709 . 14171) (MB.GETFN 14173 . 14781) (MB.PUTFN 14783 . 15560) (MB.SHOWSELFN 15562 . 16534
|
||||
) (MBUTTON.CREATE 16536 . 17820) (MBUTTON.CHANGENAME 17822 . 18217) (MBUTTON.FIND.BUTTON 18219 . 19235
|
||||
) (MBUTTON.FIND.NEXT.BUTTON 19237 . 20632) (MBUTTON.FIND.NEXT.FIELD 20634 . 24348) (MBUTTON.INIT 24350
|
||||
. 25140) (MBUTTON.NEXT.FIELD.AS.NUMBER 25142 . 25495) (MBUTTON.NEXT.FIELD.AS.PIECES 25497 . 25927) (
|
||||
MBUTTON.NEXT.FIELD.AS.TEXT 25929 . 26351) (MBUTTON.NEXT.FIELD.AS.ATOM 26353 . 27226) (
|
||||
MBUTTON.SET.FIELD 27228 . 29284) (MBUTTON.SET.NEXT.FIELD 29286 . 30503) (MBUTTON.SET.NEXT.BUTTON.STATE
|
||||
30505 . 31001) (TEDITMENU.STREAM 31003 . 31612) (\TEDITMENU.SELSCREENER 31614 . 33106)) (33412 43835
|
||||
(MB.CREATE.THREESTATEBUTTON 33422 . 34593) (MB.THREESTATE.DISPLAY 34595 . 37185) (
|
||||
MB.THREESTATE.SHOWSELFN 37187 . 40289) (MB.THREESTATE.WHENOPERATEDFN 40291 . 41670) (
|
||||
MB.THREESTATEBUTTON.FN 41672 . 42769) (THREESTATE.INIT 42771 . 43833)) (43936 63172 (
|
||||
MB.CREATE.NWAYBUTTON 43946 . 47914) (MB.NB.DISPLAYFN 47916 . 50188) (MB.NB.WHENOPERATEDFN 50190 .
|
||||
51222) (MB.NB.SIZEFN 51224 . 54763) (MB.NWAYBUTTON.SELFN 54765 . 56709) (MB.NWAYMENU.NEWBUTTON 56711
|
||||
. 57297) (NWAYBUTTON.INIT 57299 . 58152) (MB.NB.PACKITEMS 58154 . 60151) (MB.NWAYBUTTON.ADDITEM 60153
|
||||
. 63170)) (63426 74074 (\TEXTMENU.TOGGLE.CREATE 63436 . 64837) (\TEXTMENU.TOGGLE.DISPLAY 64839 .
|
||||
67191) (\TEXTMENU.TOGGLE.SHOWSELFN 67193 . 69555) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69557 . 70945) (
|
||||
\TEXTMENU.TOGGLEFN 70947 . 72027) (\TEXTMENU.TOGGLE.INIT 72029 . 72864) (\TEXTMENU.SET.TOGGLE 72866 .
|
||||
74072)) (74326 111698 (DRAWMARGINSCALE 74336 . 77880) (MARGINBAR 77882 . 85252) (MARGINBAR.CREATE
|
||||
85254 . 88164) (MB.MARGINBAR.SELFN 88166 . 100760) (MB.MARGINBAR.SIZEFN 100762 . 101124) (
|
||||
MB.MARGINBAR.DISPLAYFN 101126 . 103811) (MDESCALE 103813 . 104252) (MSCALE 104254 . 104588) (
|
||||
MB.MARGINBAR.SHOWTAB 104590 . 106761) (MB.MARGINBAR.TABTRACK 106763 . 108098) (\TEDIT.TABTYPE.SET
|
||||
108100 . 110807) (MARGINBAR.INIT 110809 . 111696)) (112715 130317 (\TEXTMENU.START 112725 . 115917) (
|
||||
\TEXTMENU.DOC.CREATE 115919 . 127443) (TEXTMENU.CLOSEFN 127445 . 130315)) (130627 150691 (
|
||||
\TEDITMENU.CREATE 130637 . 130937) (\TEDIT.EXPANDED.MENU 130939 . 131643) (MB.DEFAULTBUTTON.FN 131645
|
||||
. 134517) (\TEDITMENU.RECORD.UNFORMATTED 134519 . 134857) (MB.DEFAULTBUTTON.ACTIONFN 134859 . 150689)
|
||||
) (150692 178075 (\TEDIT.CHARLOOKSMENU.CREATE 150702 . 152842) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152844
|
||||
. 153218) (\TEDIT.APPLY.BOLDNESS 153220 . 153505) (\TEDIT.APPLY.CHARLOOKS 153507 . 155438) (
|
||||
\TEDIT.APPLY.OLINE 155440 . 155721) (\TEDIT.SHOW.CHARLOOKS 155723 . 157636) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS 157638 . 158564) (\TEDIT.FILL.IN.CHARLOOKS.MENU 158566 . 166219) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166221 . 169104) (\TEDIT.PARSE.CHARLOOKS.MENU 169106 . 177214) (
|
||||
\TEDIT.APPLY.SLOPE 177216 . 177499) (\TEDIT.APPLY.STRIKEOUT 177501 . 177788) (\TEDIT.APPLY.ULINE
|
||||
177790 . 178073)) (178076 210142 (\TEDITPARAMENU.CREATE 178086 . 178466) (\TEDIT.EXPANDEDPARA.MENU
|
||||
178468 . 178788) (\TEDIT.APPLY.PARALOOKS 178790 . 191020) (\TEDIT.SHOW.PARALOOKS 191022 . 202549) (
|
||||
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 202551 . 208622) (\TEDIT.RECORD.TABLEADERS 208624 . 210140)) (210143
|
||||
248145 (\TEDIT.SHOW.PAGEFORMATTING 210153 . 226693) (\TEDITPAGEMENU.CREATE 226695 . 227738) (
|
||||
\TEDIT.APPLY.PAGEFORMATTING 227740 . 240111) (TEDIT.UNPARSE.PAGEFORMAT 240113 . 248143)) (248450
|
||||
275299 (\TEDIT.MENU.INIT 248460 . 275297)))))
|
||||
(FILEMAP (NIL (6267 33109 (MB.BUTTONEVENTINFN 6277 . 7608) (MB.DISPLAY 7610 . 9978) (MB.SETIMAGE 9980
|
||||
. 10938) (MB.SELFN 10940 . 12355) (MB.SIZEFN 12357 . 13374) (MB.WHENOPERATEDFN 13376 . 13708) (
|
||||
MB.COPYFN 13710 . 14172) (MB.GETFN 14174 . 14782) (MB.PUTFN 14784 . 15561) (MB.SHOWSELFN 15563 . 16535
|
||||
) (MBUTTON.CREATE 16537 . 17821) (MBUTTON.CHANGENAME 17823 . 18218) (MBUTTON.FIND.BUTTON 18220 . 19236
|
||||
) (MBUTTON.FIND.NEXT.BUTTON 19238 . 20633) (MBUTTON.FIND.NEXT.FIELD 20635 . 24349) (MBUTTON.INIT 24351
|
||||
. 25141) (MBUTTON.NEXT.FIELD.AS.NUMBER 25143 . 25496) (MBUTTON.NEXT.FIELD.AS.PIECES 25498 . 25928) (
|
||||
MBUTTON.NEXT.FIELD.AS.TEXT 25930 . 26352) (MBUTTON.NEXT.FIELD.AS.ATOM 26354 . 27227) (
|
||||
MBUTTON.SET.FIELD 27229 . 29285) (MBUTTON.SET.NEXT.FIELD 29287 . 30504) (MBUTTON.SET.NEXT.BUTTON.STATE
|
||||
30506 . 31002) (TEDITMENU.STREAM 31004 . 31613) (\TEDITMENU.SELSCREENER 31615 . 33107)) (33413 43836
|
||||
(MB.CREATE.THREESTATEBUTTON 33423 . 34594) (MB.THREESTATE.DISPLAY 34596 . 37186) (
|
||||
MB.THREESTATE.SHOWSELFN 37188 . 40290) (MB.THREESTATE.WHENOPERATEDFN 40292 . 41671) (
|
||||
MB.THREESTATEBUTTON.FN 41673 . 42770) (THREESTATE.INIT 42772 . 43834)) (43937 63173 (
|
||||
MB.CREATE.NWAYBUTTON 43947 . 47915) (MB.NB.DISPLAYFN 47917 . 50189) (MB.NB.WHENOPERATEDFN 50191 .
|
||||
51223) (MB.NB.SIZEFN 51225 . 54764) (MB.NWAYBUTTON.SELFN 54766 . 56710) (MB.NWAYMENU.NEWBUTTON 56712
|
||||
. 57298) (NWAYBUTTON.INIT 57300 . 58153) (MB.NB.PACKITEMS 58155 . 60152) (MB.NWAYBUTTON.ADDITEM 60154
|
||||
. 63171)) (63427 74075 (\TEXTMENU.TOGGLE.CREATE 63437 . 64838) (\TEXTMENU.TOGGLE.DISPLAY 64840 .
|
||||
67192) (\TEXTMENU.TOGGLE.SHOWSELFN 67194 . 69556) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69558 . 70946) (
|
||||
\TEXTMENU.TOGGLEFN 70948 . 72028) (\TEXTMENU.TOGGLE.INIT 72030 . 72865) (\TEXTMENU.SET.TOGGLE 72867 .
|
||||
74073)) (74327 111699 (DRAWMARGINSCALE 74337 . 77881) (MARGINBAR 77883 . 85253) (MARGINBAR.CREATE
|
||||
85255 . 88165) (MB.MARGINBAR.SELFN 88167 . 100761) (MB.MARGINBAR.SIZEFN 100763 . 101125) (
|
||||
MB.MARGINBAR.DISPLAYFN 101127 . 103812) (MDESCALE 103814 . 104253) (MSCALE 104255 . 104589) (
|
||||
MB.MARGINBAR.SHOWTAB 104591 . 106762) (MB.MARGINBAR.TABTRACK 106764 . 108099) (\TEDIT.TABTYPE.SET
|
||||
108101 . 110808) (MARGINBAR.INIT 110810 . 111697)) (112716 129644 (\TEXTMENU.START 112726 . 116439) (
|
||||
\TEXTMENU.DOC.CREATE 116441 . 126770) (TEXTMENU.CLOSEFN 126772 . 129642)) (129954 150018 (
|
||||
\TEDITMENU.CREATE 129964 . 130264) (\TEDIT.EXPANDED.MENU 130266 . 130970) (MB.DEFAULTBUTTON.FN 130972
|
||||
. 133844) (\TEDITMENU.RECORD.UNFORMATTED 133846 . 134184) (MB.DEFAULTBUTTON.ACTIONFN 134186 . 150016)
|
||||
) (150019 177402 (\TEDIT.CHARLOOKSMENU.CREATE 150029 . 152169) (\TEDIT.EXPANDEDCHARLOOKS.MENU 152171
|
||||
. 152545) (\TEDIT.APPLY.BOLDNESS 152547 . 152832) (\TEDIT.APPLY.CHARLOOKS 152834 . 154765) (
|
||||
\TEDIT.APPLY.OLINE 154767 . 155048) (\TEDIT.SHOW.CHARLOOKS 155050 . 156963) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS 156965 . 157891) (\TEDIT.FILL.IN.CHARLOOKS.MENU 157893 . 165546) (
|
||||
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 165548 . 168431) (\TEDIT.PARSE.CHARLOOKS.MENU 168433 . 176541) (
|
||||
\TEDIT.APPLY.SLOPE 176543 . 176826) (\TEDIT.APPLY.STRIKEOUT 176828 . 177115) (\TEDIT.APPLY.ULINE
|
||||
177117 . 177400)) (177403 209469 (\TEDITPARAMENU.CREATE 177413 . 177793) (\TEDIT.EXPANDEDPARA.MENU
|
||||
177795 . 178115) (\TEDIT.APPLY.PARALOOKS 178117 . 190347) (\TEDIT.SHOW.PARALOOKS 190349 . 201876) (
|
||||
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 201878 . 207949) (\TEDIT.RECORD.TABLEADERS 207951 . 209467)) (209470
|
||||
247472 (\TEDIT.SHOW.PAGEFORMATTING 209480 . 226020) (\TEDITPAGEMENU.CREATE 226022 . 227065) (
|
||||
\TEDIT.APPLY.PAGEFORMATTING 227067 . 239438) (TEDIT.UNPARSE.PAGEFORMAT 239440 . 247470)) (247777
|
||||
274626 (\TEDIT.MENU.INIT 247787 . 274624)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,94 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "25-Aug-94 10:55:28" {DSK}<king>export>lispcore>library>TEDITPAGE.;3 123769
|
||||
|
||||
changes to%: (VARS TEDITPAGECOMS) (FILES TEDITDCL)
|
||||
(FILECREATED "31-Jan-2022 23:33:37" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITPAGE.;2 124691
|
||||
|
||||
previous date%: " 4-Jul-93 00:42:12" {DSK}<king>export>lispcore>library>TEDITPAGE.;2)
|
||||
:CHANGES-TO (FNS TEDIT.FORMATHEADING TEDIT.FORMATFOLIO)
|
||||
|
||||
:PREVIOUS-DATE "25-Aug-94 10:55:28"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITPAGE.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1984-1991, 1993-1994 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TEDITPAGECOMS)
|
||||
|
||||
(RPAQQ TEDITPAGECOMS ((FILES TEDITDCL) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) (FILES (LOADCOMP) TEDITDCL)) (COMS (* ;; "Page-numbering font specification/default") (* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)") (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) (INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (FAMILY MODERN SIZE 10 WEIGHT MEDIUM SLOPE REGULAR))))) (* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.") (INITVARS (*TEDIT-PAGE-BREAKS* NIL))) (VARS (MAXPAGE# 65535) (MINPAGE# 1) (TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL (QUOTE LEFT) 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL (QUOTE RIGHT) 72 72 72 72 NIL 1)))) (COMS (* ;; "Creation, GET, and PUT of page frames.") (FNS TEDIT.GET.PAGEFRAMES TEDIT.PARSE.PAGEFRAMES TEDIT.PUT.PAGEFRAMES TEDIT.UNPARSE.PAGEFRAMES)) (COMS (* ;; "For setting up page layouts") (FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT)) (COMS (* ;; "Perform page layout, based on a regular expression of typed regions.") (FNS TEDIT.FORMAT.HARDCOPY TEDIT.FORMATBOX TEDIT.FORMATHEADING TEDIT.FORMATPAGE TEDIT.FORMATTEXTBOX TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX? TEDIT.SKIP.SPECIALCOND) (* ;; "Aux function to capture page headings during line formatting:") (FNS TEDIT.HARDCOPY.PAGEHEADING) (* ;; " Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):") (FNS TEDIT.HARDCOPY-COLUMN-END)) (COMS (* ;; "Handle varying paper sizes") (FNS SCALEPAGEUNITS SCALEPAGEXUNITS SCALEPAGEYUNITS \TEDIT.PAPERHEIGHT \TEDIT.PAPERWIDTH) (GLOBALVARS TEDIT.PAPER.SIZES) (VARS (TEDIT.PAPER.SIZES (QUOTE ((A0 2384 3370) (A1 1684 2384) (A2 1191 1684) (A3 842 1191) (A4 595 842) (A5 420 595) (B0 2835 4008) (B1 2004 2835) (B2 1417 2004) (B3 1001 1417) (B4 709 1001) (B5 499 709)))))) (COMS (* ; "Page numbering option support") (FNS ROMANNUMERALS)) (COMS (* ;; "Foot note support") (FNS \TEDIT.FORMAT.FOOTNOTE)))
|
||||
)
|
||||
(RPAQQ TEDITPAGECOMS
|
||||
((FILES TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
(COMS
|
||||
(* ;; "Page-numbering font specification/default")
|
||||
|
||||
|
||||
(* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)")
|
||||
|
||||
(GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS)
|
||||
[INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(FAMILY MODERN SIZE
|
||||
10 WEIGHT
|
||||
MEDIUM SLOPE
|
||||
REGULAR]
|
||||
|
||||
(* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.")
|
||||
|
||||
(INITVARS (*TEDIT-PAGE-BREAKS* NIL)))
|
||||
[VARS (MAXPAGE# 65535)
|
||||
(MINPAGE# 1)
|
||||
(TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1
|
||||
)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL
|
||||
1]
|
||||
(COMS
|
||||
(* ;; "Creation, GET, and PUT of page frames.")
|
||||
|
||||
(FNS TEDIT.GET.PAGEFRAMES TEDIT.PARSE.PAGEFRAMES TEDIT.PUT.PAGEFRAMES
|
||||
TEDIT.UNPARSE.PAGEFRAMES))
|
||||
(COMS
|
||||
(* ;; "For setting up page layouts")
|
||||
|
||||
(FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT))
|
||||
(COMS
|
||||
(* ;; "Perform page layout, based on a regular expression of typed regions.")
|
||||
|
||||
(FNS TEDIT.FORMAT.HARDCOPY TEDIT.FORMATBOX TEDIT.FORMATHEADING TEDIT.FORMATPAGE
|
||||
TEDIT.FORMATTEXTBOX TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX?
|
||||
TEDIT.SKIP.SPECIALCOND)
|
||||
|
||||
(* ;; "Aux function to capture page headings during line formatting:")
|
||||
|
||||
(FNS TEDIT.HARDCOPY.PAGEHEADING)
|
||||
|
||||
(* ;;
|
||||
" Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):")
|
||||
|
||||
(FNS TEDIT.HARDCOPY-COLUMN-END))
|
||||
[COMS
|
||||
(* ;; "Handle varying paper sizes")
|
||||
|
||||
(FNS SCALEPAGEUNITS SCALEPAGEXUNITS SCALEPAGEYUNITS \TEDIT.PAPERHEIGHT
|
||||
\TEDIT.PAPERWIDTH)
|
||||
(GLOBALVARS TEDIT.PAPER.SIZES)
|
||||
(VARS (TEDIT.PAPER.SIZES '((A0 2384 3370)
|
||||
(A1 1684 2384)
|
||||
(A2 1191 1684)
|
||||
(A3 842 1191)
|
||||
(A4 595 842)
|
||||
(A5 420 595)
|
||||
(B0 2835 4008)
|
||||
(B1 2004 2835)
|
||||
(B2 1417 2004)
|
||||
(B3 1001 1417)
|
||||
(B4 709 1001)
|
||||
(B5 499 709]
|
||||
(COMS (* ; "Page numbering option support")
|
||||
(FNS ROMANNUMERALS))
|
||||
(COMS
|
||||
(* ;; "Foot note support")
|
||||
|
||||
(FNS \TEDIT.FORMAT.FOOTNOTE))))
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
@@ -26,7 +101,8 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
)
|
||||
|
||||
|
||||
(FILESLOAD (LOADCOMP) TEDITDCL)
|
||||
(FILESLOAD (LOADCOMP)
|
||||
TEDITDCL)
|
||||
)
|
||||
|
||||
|
||||
@@ -43,8 +119,8 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS)
|
||||
)
|
||||
|
||||
(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (QUOTE (FAMILY MODERN SIZE 10 WEIGHT MEDIUM SLOPE REGULAR)))
|
||||
)
|
||||
(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(FAMILY MODERN SIZE 10 WEIGHT MEDIUM
|
||||
SLOPE REGULAR)))
|
||||
|
||||
|
||||
|
||||
@@ -57,8 +133,10 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
|
||||
(RPAQQ MINPAGE# 1)
|
||||
|
||||
(RPAQ TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL (QUOTE LEFT) 72 72 72 72 NIL 1) (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL (QUOTE RIGHT) 72 72 72 72 NIL 1))
|
||||
)
|
||||
(RPAQ TEDIT.PAGE.FRAMES
|
||||
(LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1)
|
||||
(TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1)))
|
||||
|
||||
|
||||
|
||||
@@ -677,25 +755,26 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO])
|
||||
|
||||
(TEDIT.FORMATHEADING
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 9-Oct-90 13:24 by jds")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 31-Jan-2022 23:30 by rmk")
|
||||
(* ; "Edited 9-Oct-90 13:24 by jds")
|
||||
|
||||
(* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.")
|
||||
|
||||
(PROG ((CHNO 1)
|
||||
[REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)
|
||||
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
|
||||
VALUE]
|
||||
VALUE]
|
||||
(LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
|
||||
HEADINGSTREAM HEADINGTEXTOBJ PRECONDITIONS THISLINE LINE YBOT (FORCENEXTPAGE NIL)
|
||||
LINES HEADING)
|
||||
[COND
|
||||
((SETQ PRECONDITIONS (LISTGET LOCALINFO 'PRECONDITIONS))
|
||||
(* ;
|
||||
"There are preconditions for this heading to appear. Check them.")
|
||||
"There are preconditions for this heading to appear. Check them.")
|
||||
(COND
|
||||
((for FORM inside PRECONDITIONS thereis (NOT (EVAL FORM)))
|
||||
(* ;
|
||||
"One of the predicates returned NIL, so don't display this heading.")
|
||||
"One of the predicates returned NIL, so don't display this heading.")
|
||||
(RETURN]
|
||||
(COND
|
||||
([NOT (SETQ HEADING (LISTGET (fetch (PAGEFORMATTINGSTATE PAGEHEADINGS) of
|
||||
@@ -703,23 +782,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
)
|
||||
(LISTGET LOCALINFO 'HEADINGTYPE]
|
||||
(* ;
|
||||
"There's no text for this heading. Punt.")
|
||||
"There's no text for this heading. Punt.")
|
||||
(RETURN)))
|
||||
[SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of (SETQ HEADINGSTREAM (OPENTEXTSTREAM
|
||||
"" NIL NIL NIL
|
||||
(LIST 'PARALOOKS (fetch
|
||||
(PIECE PPARALOOKS)
|
||||
of (CAR HEADING
|
||||
]
|
||||
[SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (SETQ HEADINGSTREAM
|
||||
(OPENTEXTSTREAM
|
||||
NIL NIL NIL NIL
|
||||
(LIST 'PARALOOKS (fetch (PIECE
|
||||
PPARALOOKS
|
||||
)
|
||||
of (CAR HEADING]
|
||||
(\TEDIT.INSERT.PIECES HEADINGTEXTOBJ 1 HEADING)
|
||||
(for PC in HEADING do (add (fetch (TEXTOBJ TEXTLEN) of
|
||||
HEADINGTEXTOBJ
|
||||
)
|
||||
(fetch (PIECE PLEN) of PC)))
|
||||
(SETQ LINES (while (AND (ILESSP CHNO (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ
|
||||
))
|
||||
(NOT FORCENEXTPAGE))
|
||||
(for PC in HEADING do (add (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ)
|
||||
(fetch (PIECE PLEN) of PC)))
|
||||
(SETQ LINES (while (AND (ILESSP CHNO (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ))
|
||||
(NOT FORCENEXTPAGE))
|
||||
collect (SETQ THISLINE (create THISLINE))
|
||||
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE HEADINGTEXTOBJ
|
||||
(fetch (REGION WIDTH) of REGION)
|
||||
@@ -729,36 +805,31 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
PRSTREAM T))
|
||||
(replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE)
|
||||
(* ;
|
||||
"Mark this line as having cached print info.")
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with
|
||||
HEADINGSTREAM
|
||||
) (* ;
|
||||
"And remember the document it came from.")
|
||||
"Mark this line as having cached print info.")
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with HEADINGSTREAM)
|
||||
(* ;
|
||||
"And remember the document it came from.")
|
||||
(add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(* ; "Format the next possible line")
|
||||
[COND
|
||||
[YBOT (* ;
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT)
|
||||
of LINE]
|
||||
(T (* ;
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
(SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION
|
||||
)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE]
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
(SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE]
|
||||
(* ; "This line is good; use it.")
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with YBOT)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
(SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE)))
|
||||
(* ;
|
||||
"Keep track of the next character...")
|
||||
"Keep track of the next character...")
|
||||
LINE))
|
||||
(RETURN LINES])
|
||||
|
||||
@@ -1216,13 +1287,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
FORMATTINGSTATE FINAL-CHNO])
|
||||
|
||||
(TEDIT.FORMATFOLIO
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* ; "Edited 30-May-91 12:51 by jds")
|
||||
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* ; "Edited 31-Jan-2022 23:33 by rmk")
|
||||
(* ; "Edited 30-May-91 12:51 by jds")
|
||||
|
||||
(* ;; "Print a page number (called a %"folio%" in the biz) at the location and with the alignment specified in the REGIONSPEC.")
|
||||
|
||||
(PROG ([REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of REGIONSPEC)
|
||||
collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM)
|
||||
VALUE]
|
||||
VALUE]
|
||||
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of REGIONSPEC))
|
||||
(FORCENEXTPAGE NIL)
|
||||
(CHNO 1)
|
||||
@@ -1233,36 +1305,33 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
TEDIT.DEFAULT.FOLIO.LOOKS))
|
||||
(SETQ NOFIRSTPAGE (LISTGET FOLIOINFO 'NOFIRSTPAGE))
|
||||
(SETQ INFOLIST (LISTGET FOLIOINFO 'FORMATINFO)) (* ;
|
||||
"A LIST OF (FORMAT PRETEXT POSTTEXT)")
|
||||
"A LIST OF (FORMAT PRETEXT POSTTEXT)")
|
||||
(SETQ FOLIOFORMAT (CAR INFOLIST))
|
||||
(SETQ PRETEXT (CADR INFOLIST))
|
||||
(SETQ POSTTEXT (CADDR INFOLIST))
|
||||
[SETQ PAGE# (COND
|
||||
((fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE)
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE
|
||||
)))
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE)))
|
||||
(T (SELECTQ FOLIOFORMAT
|
||||
(LOWERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#)
|
||||
of FORMATTINGSTATE)))
|
||||
of FORMATTINGSTATE)))
|
||||
(UPPERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#)
|
||||
of FORMATTINGSTATE)
|
||||
of FORMATTINGSTATE)
|
||||
T))
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#) of
|
||||
FORMATTINGSTATE
|
||||
]
|
||||
(MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE]
|
||||
[COND
|
||||
(PRETEXT (SETQ PAGE# (CONCAT PRETEXT PAGE#]
|
||||
[COND
|
||||
(POSTTEXT (SETQ PAGE# (CONCAT PAGE# POSTTEXT]
|
||||
[SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM PAGE# NIL NIL NIL
|
||||
(LIST 'PARALOOKS PARALOOKS
|
||||
'LOOKS CHARLOOKS]
|
||||
[SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM (OPENSTRINGSTREAM PAGE#)
|
||||
NIL NIL NIL (LIST 'PARALOOKS PARALOOKS
|
||||
'LOOKS CHARLOOKS]
|
||||
(COND
|
||||
((OR (NOT (fetch (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE))
|
||||
(NOT NOFIRSTPAGE)) (* ;
|
||||
"If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
|
||||
"If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
|
||||
(RETURN (while (AND (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of FOLIOTEXTOBJ))
|
||||
(NOT FORCENEXTPAGE))
|
||||
(NOT FORCENEXTPAGE))
|
||||
collect (SETQ THISLINE (create THISLINE))
|
||||
(SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE FOLIOTEXTOBJ
|
||||
(fetch (REGION WIDTH) of REGION)
|
||||
@@ -1271,41 +1340,36 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
))
|
||||
PRSTREAM))
|
||||
(replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE)
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with
|
||||
FOLIOSTREAM)
|
||||
(replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with FOLIOSTREAM)
|
||||
(add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE)
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(fetch (REGION LEFT) of REGION))
|
||||
(* ; "Format the next possible line")
|
||||
(SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE)))
|
||||
(* ;
|
||||
"Keep track of the next character...")
|
||||
"Keep track of the next character...")
|
||||
[COND
|
||||
[YBOT (* ;
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR
|
||||
LHEIGHT)
|
||||
"We're into it; take account of this line's height")
|
||||
(SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT)
|
||||
of LINE]
|
||||
(T (* ;
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
"Just starting out; find the line's position with respect to the top of the region to be filled.")
|
||||
(SETQ YBOT (SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM)
|
||||
of REGION)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE]
|
||||
(COND
|
||||
((ILESSP YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION
|
||||
)
|
||||
(fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
((ILESSP YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION)
|
||||
(fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
(* ;
|
||||
"This line hangs off the bottom; punt it.")
|
||||
"This line hangs off the bottom; punt it.")
|
||||
NIL)
|
||||
(T (* ; "This line is good; use it.")
|
||||
(replace (LINEDESCRIPTOR YBOT) of LINE with YBOT)
|
||||
(replace (LINEDESCRIPTOR YBASE) of LINE
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT)
|
||||
of LINE)))
|
||||
with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE)))
|
||||
LINE])
|
||||
|
||||
(\TEDIT.FORMAT.FOUNDBOX?
|
||||
@@ -1696,8 +1760,19 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(GLOBALVARS TEDIT.PAPER.SIZES)
|
||||
)
|
||||
|
||||
(RPAQQ TEDIT.PAPER.SIZES ((A0 2384 3370) (A1 1684 2384) (A2 1191 1684) (A3 842 1191) (A4 595 842) (A5 420 595) (B0 2835 4008) (B1 2004 2835) (B2 1417 2004) (B3 1001 1417) (B4 709 1001) (B5 499 709))
|
||||
)
|
||||
(RPAQQ TEDIT.PAPER.SIZES
|
||||
((A0 2384 3370)
|
||||
(A1 1684 2384)
|
||||
(A2 1191 1684)
|
||||
(A3 842 1191)
|
||||
(A4 595 842)
|
||||
(A5 420 595)
|
||||
(B0 2835 4008)
|
||||
(B1 2004 2835)
|
||||
(B2 1417 2004)
|
||||
(B3 1001 1417)
|
||||
(B4 709 1001)
|
||||
(B5 499 709)))
|
||||
|
||||
|
||||
|
||||
@@ -1825,15 +1900,15 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1994 by Venu
|
||||
(PUTPROPS TEDITPAGE COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991
|
||||
1993 1994))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3553 7108 (TEDIT.GET.PAGEFRAMES 3563 . 3915) (TEDIT.PARSE.PAGEFRAMES 3917 . 5620) (
|
||||
TEDIT.PUT.PAGEFRAMES 5622 . 6250) (TEDIT.UNPARSE.PAGEFRAMES 6252 . 7106)) (7154 19997 (
|
||||
TEDIT.SINGLE.PAGEFORMAT 7164 . 17723) (TEDIT.COMPOUND.PAGEFORMAT 17725 . 18351) (TEDIT.PAGEFORMAT
|
||||
18353 . 19995)) (20084 97190 (TEDIT.FORMAT.HARDCOPY 20094 . 31166) (TEDIT.FORMATBOX 31168 . 46475) (
|
||||
TEDIT.FORMATHEADING 46477 . 53053) (TEDIT.FORMATPAGE 53055 . 64626) (TEDIT.FORMATTEXTBOX 64628 . 84946
|
||||
) (TEDIT.FORMATFOLIO 84948 . 91873) (\TEDIT.FORMAT.FOUNDBOX? 91875 . 94064) (TEDIT.SKIP.SPECIALCOND
|
||||
94066 . 97188)) (97270 100471 (TEDIT.HARDCOPY.PAGEHEADING 97280 . 100469)) (100580 110247 (
|
||||
TEDIT.HARDCOPY-COLUMN-END 100590 . 110245)) (110292 115296 (SCALEPAGEUNITS 110302 . 111530) (
|
||||
SCALEPAGEXUNITS 111532 . 112296) (SCALEPAGEYUNITS 112298 . 113063) (\TEDIT.PAPERHEIGHT 113065 . 113994
|
||||
) (\TEDIT.PAPERWIDTH 113996 . 115294)) (115618 119532 (ROMANNUMERALS 115628 . 119530)) (119568 123634
|
||||
(\TEDIT.FORMAT.FOOTNOTE 119578 . 123632)))))
|
||||
(FILEMAP (NIL (5196 8751 (TEDIT.GET.PAGEFRAMES 5206 . 5558) (TEDIT.PARSE.PAGEFRAMES 5560 . 7263) (
|
||||
TEDIT.PUT.PAGEFRAMES 7265 . 7893) (TEDIT.UNPARSE.PAGEFRAMES 7895 . 8749)) (8797 21640 (
|
||||
TEDIT.SINGLE.PAGEFORMAT 8807 . 19366) (TEDIT.COMPOUND.PAGEFORMAT 19368 . 19994) (TEDIT.PAGEFORMAT
|
||||
19996 . 21638)) (21727 98018 (TEDIT.FORMAT.HARDCOPY 21737 . 32809) (TEDIT.FORMATBOX 32811 . 48118) (
|
||||
TEDIT.FORMATHEADING 48120 . 54287) (TEDIT.FORMATPAGE 54289 . 65860) (TEDIT.FORMATTEXTBOX 65862 . 86180
|
||||
) (TEDIT.FORMATFOLIO 86182 . 92701) (\TEDIT.FORMAT.FOUNDBOX? 92703 . 94892) (TEDIT.SKIP.SPECIALCOND
|
||||
94894 . 98016)) (98098 101299 (TEDIT.HARDCOPY.PAGEHEADING 98108 . 101297)) (101408 111075 (
|
||||
TEDIT.HARDCOPY-COLUMN-END 101418 . 111073)) (111120 116124 (SCALEPAGEUNITS 111130 . 112358) (
|
||||
SCALEPAGEXUNITS 112360 . 113124) (SCALEPAGEYUNITS 113126 . 113891) (\TEDIT.PAPERHEIGHT 113893 . 114822
|
||||
) (\TEDIT.PAPERWIDTH 114824 . 116122)) (116540 120454 (ROMANNUMERALS 116550 . 120452)) (120490 124556
|
||||
(\TEDIT.FORMAT.FOOTNOTE 120500 . 124554)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Sep-2021 22:03:57"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.;8 214517
|
||||
(FILECREATED "12-Jan-2022 18:56:46"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITSCREEN.;11 214540
|
||||
|
||||
changes to%: (FNS \DISPLAYLINE)
|
||||
:CHANGES-TO (FNS \SHOWTEXT)
|
||||
|
||||
previous date%: "21-Sep-2021 12:53:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITSCREEN.;7)
|
||||
:PREVIOUS-DATE "12-Jan-2022 18:27:35"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITSCREEN.;10)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -1409,14 +1409,13 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS MI-TEDIT.BLTCHAR MACRO [(CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT
|
||||
CLIPRIGHT)
|
||||
(COND
|
||||
((EQ 'MAIKO (MACHINETYPE))
|
||||
(SUBRCALL TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT))
|
||||
(T (\TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX
|
||||
DISPLAYDATA DDPILOTBBT CLIPRIGHT])
|
||||
(PUTPROPS MI-TEDIT.BLTCHAR MACRO [(CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT)
|
||||
(COND
|
||||
((EQ 'MAIKO (MACHINETYPE))
|
||||
(SUBRCALL TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX DISPLAYDATA
|
||||
DDPILOTBBT CLIPRIGHT))
|
||||
(T (\TEDIT.BLTCHAR CHARCODE DISPLAYSTREAM CURX DISPLAYDATA
|
||||
DDPILOTBBT CLIPRIGHT])
|
||||
)
|
||||
)
|
||||
(DEFINEQ
|
||||
@@ -2212,53 +2211,58 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
(\TEDIT.FIXINSSEL SEL TEXTOBJ CH#1 DCH])
|
||||
|
||||
(\SHOWTEXT
|
||||
[LAMBDA (TEXTOBJ LINES WINDOW) (* ; "Edited 12-Jun-90 19:22 by mitani")
|
||||
(* Fill the editor window with text,
|
||||
starting from the top of the file.)
|
||||
[LAMBDA (TEXTOBJ LINES WINDOW)
|
||||
|
||||
(* ;; "Edited 12-Jan-2022 18:56 by rmk: I took out the WAITINGCURSOR, the resetsave wasn't working for some reason, and it really isn't necessary for modern machines.")
|
||||
|
||||
(* ;; "Edited 12-Jun-90 19:22 by mitani")
|
||||
|
||||
(* ;; "Fill the editor window with text, starting from the top of the file.")
|
||||
|
||||
(COND
|
||||
((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* If there is no edit window, just
|
||||
return.)
|
||||
(PROG (WREG)
|
||||
(SETQ WINDOW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ)))
|
||||
(DSPFILL (PROG1 (DSPCLIPPINGREGION NIL WINDOW) (* For region within a window%:)
|
||||
(* (CREATEREGION (fetch
|
||||
(TEXTOBJ WLEFT) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)
|
||||
(IDIFFERENCE (fetch
|
||||
(TEXTOBJ WRIGHT) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ WLEFT) of TEXTOBJ))
|
||||
(IDIFFERENCE (fetch
|
||||
(TEXTOBJ WTOP) of TEXTOBJ)
|
||||
(fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))))
|
||||
)
|
||||
WHITESHADE
|
||||
'REPLACE WINDOW) (* Clear the window.)
|
||||
(RETURN (RESETLST
|
||||
(RESETSAVE (CURSOR WAITINGCURSOR)) (* Display the hourglass cursor as
|
||||
we work)
|
||||
(SETQ LINES
|
||||
(create LINEDESCRIPTOR
|
||||
YBOT _ (WINDOWPROP WINDOW 'HEIGHT)
|
||||
CHAR1 _ 0
|
||||
CHARLIM _ 0
|
||||
SPACELEFT _ -1
|
||||
RIGHTMARGIN _ (SUB1 (fetch (TEXTOBJ WRIGHT) of TEXTOBJ))
|
||||
NEXTLINE _ NIL
|
||||
CHARTOP _ -1
|
||||
LHEIGHT _ 0
|
||||
LXLIM _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)
|
||||
CR\END _ T
|
||||
ASCENT _ 0
|
||||
DESCENT _ 0
|
||||
LTRUEASCENT _ 0
|
||||
LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC))
|
||||
(* Make sure we have the anchor
|
||||
pseudo-line)
|
||||
(WINDOWPROP WINDOW 'LINES LINES)
|
||||
(\FILLWINDOW (WINDOWPROP WINDOW 'HEIGHT)
|
||||
LINES TEXTOBJ NIL WINDOW) (* Fill the window as usual)
|
||||
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW)
|
||||
LINES)])
|
||||
((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* ;
|
||||
"If there is no edit window, just return.")
|
||||
(PROG1 (PROG (WREG)
|
||||
(SETQ WINDOW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ)))
|
||||
(DSPFILL (PROG1 (DSPCLIPPINGREGION NIL WINDOW)
|
||||
(* ; "For region within a window:")
|
||||
|
||||
(* ;; "(CREATEREGION (fetch (TEXTOBJ WLEFT) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) (fetch (TEXTOBJ WLEFT) of TEXTOBJ)) (IDIFFERENCE (fetch (TEXTOBJ WTOP) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)))")
|
||||
|
||||
)
|
||||
WHITESHADE
|
||||
'REPLACE WINDOW) (* ; "Clear the window.")
|
||||
(RETURN (RESETLST
|
||||
|
||||
(* ;; "RMK: For reasons unknown, the original cursor is not restored when this exits. But there is presumably no need for this waiting indicator in modern times. This only fills lines visible within a window, and machines are really fast.")
|
||||
|
||||
(* ;; "Display the hourglass cursor as we work")
|
||||
|
||||
(AND NIL (RESETSAVE (CURSOR WAITINGCURSOR)))
|
||||
(SETQ LINES
|
||||
(create LINEDESCRIPTOR
|
||||
YBOT _ (WINDOWPROP WINDOW 'HEIGHT)
|
||||
CHAR1 _ 0
|
||||
CHARLIM _ 0
|
||||
SPACELEFT _ -1
|
||||
RIGHTMARGIN _ (SUB1 (fetch (TEXTOBJ WRIGHT) of TEXTOBJ))
|
||||
NEXTLINE _ NIL
|
||||
CHARTOP _ -1
|
||||
LHEIGHT _ 0
|
||||
LXLIM _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)
|
||||
CR\END _ T
|
||||
ASCENT _ 0
|
||||
DESCENT _ 0
|
||||
LTRUEASCENT _ 0
|
||||
LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC))
|
||||
(* ;
|
||||
"Make sure we have the anchor pseudo-line")
|
||||
(WINDOWPROP WINDOW 'LINES LINES)
|
||||
(\FILLWINDOW (WINDOWPROP WINDOW 'HEIGHT)
|
||||
LINES TEXTOBJ NIL WINDOW)
|
||||
(* ; "Fill the window as usual")
|
||||
(\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW)
|
||||
LINES)])
|
||||
|
||||
(\TEDIT.ADJUST.LINES
|
||||
[LAMBDA (TEXTOBJ FIRSTLINE WINDOW LINETOP DY) (* ; "Edited 30-May-91 15:59 by jds")
|
||||
@@ -2979,25 +2983,25 @@ Copyright (c) 1983-1994, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
|
||||
|
||||
(* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115"
|
||||
"41,133" "41,131" "41,127" "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143"
|
||||
"Hira,145" "Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" "Kata,51" "Kata,103"
|
||||
"Kata,143" "Kata,145" "Kata,147" "Kata,156"))) (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132"
|
||||
"41,130" "41,126"))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)))
|
||||
(* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133"
|
||||
"41,131" "41,127" "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143" "Hira,145"
|
||||
"Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" "Kata,51" "Kata,103" "Kata,143"
|
||||
"Kata,145" "Kata,147" "Kata,156"))) (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130"
|
||||
"41,126"))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)))
|
||||
|
||||
(PUTPROPS TEDITSCREEN COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2767 76759 (\FORMATLINE 2777 . 56505) (\TEDIT.NSCHAR.RUN 56507 . 63324) (
|
||||
\TEDIT.PURGE.SPACES 63326 . 63784) (\DOFORMATTING 63786 . 76757)) (76760 98628 (\DISPLAYLINE 76770 .
|
||||
94628) (\TEDIT.LINECACHE 94630 . 95381) (\TEDIT.CREATE.LINECACHE 95383 . 96127) (\TEDIT.BLTCHAR 96129
|
||||
. 98626)) (99342 213797 (TEDIT.CR.UPDATESCREEN 99352 . 100603) (TEDIT.DELETELINE 100605 . 101639) (
|
||||
TEDIT.INSERT.DISPLAYTEXT 101641 . 116880) (TEDIT.INSERT.UPDATESCREEN 116882 . 123634) (
|
||||
TEDIT.UPDATE.SCREEN 123636 . 124854) (\BACKFORMAT 124856 . 129167) (\FILLWINDOW 129169 . 144273) (
|
||||
\FIXDLINES 144275 . 151512) (\FIXILINES 151514 . 159489) (\SHOWTEXT 159491 . 162747) (
|
||||
\TEDIT.ADJUST.LINES 162749 . 170216) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 170218 . 170948) (
|
||||
\TEDIT.CLOSEUPLINES 170950 . 179466) (\TEDIT.COPY.LINEDESCRIPTOR 179468 . 185034) (
|
||||
\TEDIT.FIXCHANGEDLINE 185036 . 196215) (\TEDIT.FIXCHANGEDPART 196217 . 208644) (\TEDIT.INSERTLINE
|
||||
208646 . 209466) (\TEDIT.LINE.LIST 209468 . 209794) (\TEDIT.MARK.LINES.DIRTY 209796 . 211482) (
|
||||
\TEDIT.NEXT.LINE.BOTTOM 211484 . 213795)))))
|
||||
(FILEMAP (NIL (2761 76753 (\FORMATLINE 2771 . 56499) (\TEDIT.NSCHAR.RUN 56501 . 63318) (
|
||||
\TEDIT.PURGE.SPACES 63320 . 63778) (\DOFORMATTING 63780 . 76751)) (76754 98622 (\DISPLAYLINE 76764 .
|
||||
94622) (\TEDIT.LINECACHE 94624 . 95375) (\TEDIT.CREATE.LINECACHE 95377 . 96121) (\TEDIT.BLTCHAR 96123
|
||||
. 98620)) (99237 213820 (TEDIT.CR.UPDATESCREEN 99247 . 100498) (TEDIT.DELETELINE 100500 . 101534) (
|
||||
TEDIT.INSERT.DISPLAYTEXT 101536 . 116775) (TEDIT.INSERT.UPDATESCREEN 116777 . 123529) (
|
||||
TEDIT.UPDATE.SCREEN 123531 . 124749) (\BACKFORMAT 124751 . 129062) (\FILLWINDOW 129064 . 144168) (
|
||||
\FIXDLINES 144170 . 151407) (\FIXILINES 151409 . 159384) (\SHOWTEXT 159386 . 162770) (
|
||||
\TEDIT.ADJUST.LINES 162772 . 170239) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 170241 . 170971) (
|
||||
\TEDIT.CLOSEUPLINES 170973 . 179489) (\TEDIT.COPY.LINEDESCRIPTOR 179491 . 185057) (
|
||||
\TEDIT.FIXCHANGEDLINE 185059 . 196238) (\TEDIT.FIXCHANGEDPART 196240 . 208667) (\TEDIT.INSERTLINE
|
||||
208669 . 209489) (\TEDIT.LINE.LIST 209491 . 209817) (\TEDIT.MARK.LINES.DIRTY 209819 . 211505) (
|
||||
\TEDIT.NEXT.LINE.BOTTOM 211507 . 213818)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Oct-2021 18:52:11"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;18 187780
|
||||
(FILECREATED "21-Jan-2022 23:14:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;32 189300
|
||||
|
||||
changes to%: (FNS TEDIT.DEACTIVATE.WINDOW)
|
||||
:CHANGES-TO (FNS TEDIT.GETINPUT)
|
||||
|
||||
previous date%: "12-Oct-2021 15:10:06"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEDITWINDOW.;17)
|
||||
:PREVIOUS-DATE " 1-Jan-2022 23:55:46"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEDITWINDOW.;31)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -34,7 +34,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(INITVARS (TEDIT.DEFAULT.WINDOW NIL))
|
||||
(GLOBALVARS TEDIT.DEFAULT.WINDOW)
|
||||
(COMS (* ;
|
||||
"User-level %"is this a TEdit window?%" function.")
|
||||
"User-level %"is this a TEdit window?%" function.")
|
||||
(FNS TEDITWINDOWP))
|
||||
(COMS (* ; "User-typein support")
|
||||
(FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME))
|
||||
@@ -51,8 +51,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(COMS (* ; "Process-world interfaces")
|
||||
(FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN))
|
||||
(COMS (INITVARS (\CARETRATE 333))
|
||||
(* ;
|
||||
"Caret handler; stolen from CHAT.")
|
||||
(* ; "Caret handler; stolen from CHAT.")
|
||||
(FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET
|
||||
TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET))
|
||||
[COMS (* ; "Menu interfacing")
|
||||
@@ -89,15 +88,15 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD))
|
||||
[TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]
|
||||
(* ;
|
||||
"Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")
|
||||
"Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
[TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS
|
||||
TEDIT.ICON.TITLE.REGION
|
||||
NIL]
|
||||
(* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).")
|
||||
(* ;
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
"Changed by yabu.fx, for SUNLOADUP without DWIM.")
|
||||
])
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
@@ -119,27 +118,53 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.CREATEW
|
||||
[LAMBDA (PROMPT FILE PROPS) (* jds "23-May-85 15:19")
|
||||
[LAMBDA (PROMPT FILE PROPS) (* ; "Edited 1-Jan-2022 23:54 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 23:00 by rmk")
|
||||
(* ; "Edited 29-Dec-2021 16:35 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 19:21 by rmk")
|
||||
(* ; "Edited 27-Oct-2021 12:25 by rmk:")
|
||||
|
||||
(* ;; "RMK: PROPS are passed to CREATEW and \TEDIT.ORIGINAL.WINDOW.TITLE. .")
|
||||
|
||||
(* ;;
|
||||
"RMK: If PROMPTWINDOW is in PROPS, I don't see how it gets attached to the new Tedit window.")
|
||||
|
||||
(* ;;
|
||||
"Also odd: The argument PROMPT gets printed, but then gets replaced by the property PROMPT")
|
||||
|
||||
(* ;; "Don't set the global TEDIT default window if we have a region property, that must be special purpose.")
|
||||
(* jds "23-May-85 15:19")
|
||||
(CLRPROMPT)
|
||||
(printout PROMPTWINDOW PROMPT T)
|
||||
(PROG ((PROMPT (LISTGET PROPS 'PROMPTWINDOW))
|
||||
(PHEIGHT 0)
|
||||
PWINDOW REGION)
|
||||
[COND
|
||||
((EQ PROMPT 'DON'T))
|
||||
(PROMPT)
|
||||
(T (SETQ PHEIGHT (HEIGHTIFWINDOW (ITIMES (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT)
|
||||
TEDIT.PROMPTWINDOW.HEIGHT 1)
|
||||
(FONTPROP TEDIT.PROMPT.FONT 'HEIGHT]
|
||||
(SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32)))
|
||||
(add (fetch HEIGHT of REGION)
|
||||
(IMINUS PHEIGHT))
|
||||
(SETQ TEDIT.DEFAULT.WINDOW (CREATEW REGION (\TEDIT.ORIGINAL.WINDOW.TITLE FILE)))
|
||||
(CLRPROMPT)
|
||||
(OR PROMPT (GETPROMPTWINDOW TEDIT.DEFAULT.WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT)
|
||||
TEDIT.PROMPTWINDOW.HEIGHT 1)
|
||||
TEDIT.PROMPT.FONT)))
|
||||
TEDIT.DEFAULT.WINDOW])
|
||||
(LET ((PROMPT (LISTGET PROPS 'PROMPTWINDOW))
|
||||
(PHEIGHT 0)
|
||||
REGION
|
||||
(REGIONTYPE (LISTGET PROPS 'REGION-TYPE))
|
||||
WINDOW)
|
||||
|
||||
(* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.")
|
||||
|
||||
[COND
|
||||
((EQ PROMPT 'DON'T))
|
||||
[PROMPT (CL:WHEN (WINDOWP PROMPT) (* ;
|
||||
"RMK: If not a window, PHEIGHT remains 0")
|
||||
(SETQ PHEIGHT (FETCH (REGION HEIGHT) OF (WINDOWREGION PROMPT))))]
|
||||
(T (SETQ PHEIGHT (HEIGHTIFWINDOW (ITIMES (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT)
|
||||
TEDIT.PROMPTWINDOW.HEIGHT 1)
|
||||
(FONTPROP TEDIT.PROMPT.FONT 'HEIGHT]
|
||||
(SETQ REGION (OR (REGIONP REGIONTYPE)
|
||||
(GETREGION 32 (IPLUS PHEIGHT 32)
|
||||
REGIONTYPE)))
|
||||
(add (fetch HEIGHT of REGION)
|
||||
(IMINUS PHEIGHT))
|
||||
(SETQ WINDOW (CREATEW REGION (\TEDIT.ORIGINAL.WINDOW.TITLE FILE NIL PROPS)
|
||||
NIL NIL PROPS))
|
||||
(WINDOWPROP WINDOW 'TEDITCREATED T)
|
||||
(OR PROMPT (GETPROMPTWINDOW WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT)
|
||||
TEDIT.PROMPTWINDOW.HEIGHT 1)
|
||||
TEDIT.PROMPT.FONT))
|
||||
(CL:UNLESS REGIONTYPE (SETQ TEDIT.DEFAULT.WINDOW WINDOW))
|
||||
WINDOW])
|
||||
|
||||
(\TEDIT.CREATEW.FROM.REGION
|
||||
[LAMBDA (REGION FILE PROPS) (* gbn "15-Nov-84 18:04")
|
||||
@@ -1446,7 +1471,7 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
(DEFINEQ
|
||||
|
||||
(TEDIT.GETINPUT
|
||||
[LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST)
|
||||
[LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST) (* ; "Edited 21-Jan-2022 23:14 by rmk")
|
||||
(* ; "Edited 30-May-91 23:34 by jds")
|
||||
|
||||
(* ;; "Ask for input (file names, &c) for TEdit, perhaps with a default.")
|
||||
@@ -1462,20 +1487,20 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
TPROMPT))
|
||||
(COND
|
||||
(TPROMPT (* ;
|
||||
"If it's our own promptwindow, just clear it.")
|
||||
"If it's our own promptwindow, just clear it.")
|
||||
(CLEARW TPROMPT))
|
||||
(T (* ;
|
||||
"If it's the system's window, just move to a new line.")
|
||||
"If it's the system's window, just move to a new line.")
|
||||
(FRESHLINE PROMPTWINDOW)))
|
||||
(RETURN (PROG1 (PROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL (OR TPROMPT PROMPTWINDOW)
|
||||
(RETURN (PROG1 (TTYINPROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL (OR TPROMPT PROMPTWINDOW
|
||||
)
|
||||
NIL
|
||||
'TTY
|
||||
(OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE)))
|
||||
NIL) (* ;
|
||||
"Get what the guy wants to tell us")
|
||||
NIL) (* ; "Get what the guy wants to tell us")
|
||||
(WINDOWPROP (OR TPROMPT PROMPTWINDOW)
|
||||
'PROCESS NIL) (* ;
|
||||
"Now detach the prompt window from its process, to avoid a circularity.")
|
||||
"Now detach the prompt window from its process, to avoid a circularity.")
|
||||
)])
|
||||
|
||||
(\TEDIT.MAKEFILENAME
|
||||
@@ -1627,43 +1652,36 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
""])
|
||||
|
||||
(\TEDIT.ORIGINAL.WINDOW.TITLE
|
||||
[LAMBDA (FILE DIRTY?) (* ; "Edited 24-Aug-2021 23:25 by rmk:")
|
||||
[LAMBDA (FILE DIRTY? PROPS) (* ; "Edited 27-Oct-2021 12:25 by rmk:")
|
||||
(* ; "Edited 24-Aug-2021 23:25 by rmk:")
|
||||
|
||||
(* ;; "Given a file name, derive a title for the TEdit window that is editing it.")
|
||||
(* ;; "Given a file name, derive a title for the TEdit window that is editing it. RMK: Title may be provided in a property")
|
||||
|
||||
(PROG (TITLE)
|
||||
(RETURN (COND
|
||||
((NULL FILE) (* ;
|
||||
"Just calling (TEDIT) should give a 'Text Editor Window'")
|
||||
(CONCAT (COND
|
||||
(DIRTY? "* ")
|
||||
(T ""))
|
||||
(LET (TITLE)
|
||||
[SETQ TITLE (COND
|
||||
((LISTGET PROPS 'TITLE))
|
||||
((NULL FILE) (* ;
|
||||
"Just calling (TEDIT) should give a 'Text Editor Window'")
|
||||
"Text Editor Window")
|
||||
((AND (STRINGP FILE)
|
||||
(ZEROP (NCHARS FILE))) (* ;
|
||||
"So should editing an empty string")
|
||||
"Text Editor Window")
|
||||
((WINDOWP FILE) (* ;
|
||||
"if \TEDIT.WINDOW.SETUP has assigned a title, use it")
|
||||
(OR (WINDOWPROP FILE 'TITLE)
|
||||
"Text Editor Window"))
|
||||
((AND (STRINGP FILE)
|
||||
(ZEROP (NCHARS FILE))) (* ;
|
||||
"So should editing an empty string")
|
||||
(CONCAT (COND
|
||||
(DIRTY? "* ")
|
||||
(T ""))
|
||||
"Text Editor Window"))
|
||||
((WINDOWP FILE)
|
||||
(COND
|
||||
((SETQ TITLE (WINDOWPROP FILE 'TITLE))
|
||||
(* ;
|
||||
"if \TEDIT.WINDOW.SETUP has assigned a title, use it")
|
||||
TITLE)
|
||||
(T "Text Editor Window")))
|
||||
(T (* ;
|
||||
"Strings use the string itself, otherwise grab the full file name.")
|
||||
(CONCAT (COND
|
||||
(DIRTY? "* ")
|
||||
(T ""))
|
||||
"Edit Window for: "
|
||||
(CL:TYPECASE FILE
|
||||
(STRINGP FILE)
|
||||
(STREAM (fetch (STREAM FULLNAME) of FILE))
|
||||
(LITATOM FILE)
|
||||
(T FILE))])
|
||||
(T (* ;
|
||||
"Strings use the string itself, otherwise grab the full file name.")
|
||||
(CONCAT "Edit Window for: " (CL:TYPECASE FILE
|
||||
(STRINGP FILE)
|
||||
(STREAM (fetch (STREAM FULLNAME)
|
||||
of FILE))
|
||||
(LITATOM FILE)
|
||||
(T FILE))]
|
||||
(COND
|
||||
(DIRTY? (CONCAT "* " TITLE))
|
||||
(T TITLE])
|
||||
|
||||
(\TEDIT.WINDOW.TITLE
|
||||
[LAMBDA (TEXTSTREAM NEW.TITLE) (* jds "23-May-85 15:20")
|
||||
@@ -2851,30 +2869,30 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by John Sybalsky & Xerox Corporat
|
||||
|
||||
(RPAQ? TEDIT.ICON.TITLE.REGION [CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL])
|
||||
|
||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION
|
||||
NIL))))
|
||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION NIL))
|
||||
))
|
||||
(PUTPROPS TEDITWINDOW COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986 1987 1988
|
||||
1989 1990 1991 1993 1994 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(FILEMAP (NIL (7221 95655 (TEDIT.CREATEW 7231 . 9985) (\TEDIT.CREATEW.FROM.REGION 9987 . 10971) (
|
||||
TEDIT.CURSORMOVEDFN 10973 . 22359) (TEDIT.CURSOROUTFN 22361 . 22896) (TEDIT.WINDOW.SETUP 22898 . 24707
|
||||
) (TEDIT.MINIMAL.WINDOW.SETUP 24709 . 32498) (\TEDIT.ACTIVE.WINDOWP 32500 . 33481) (
|
||||
\TEDIT.BUTTONEVENTFN 33483 . 58473) (\TEDIT.WINDOW.OPS 58475 . 62436) (\TEDIT.EXPANDFN 62438 . 62841)
|
||||
(\TEDIT.MAINW 62843 . 64132) (\TEDIT.PRIMARYW 64134 . 65346) (\TEDIT.COPYINSERTFN 65348 . 66319) (
|
||||
\TEDIT.NEWREGIONFN 66321 . 68788) (\TEDIT.SET.WINDOW.EXTENT 68790 . 74892) (\TEDIT.SHRINK.ICONCREATE
|
||||
74894 . 77166) (\TEDIT.SHRINKFN 77168 . 77743) (\TEDIT.SPLITW 77745 . 83846) (\TEDIT.UNSPLITW 83848 .
|
||||
89542) (\TEDIT.WINDOW.SETUP 89544 . 95264) (\SAFE.FIRST 95266 . 95653)) (96985 97892 (TEDITWINDOWP
|
||||
96995 . 97890)) (97929 100502 (TEDIT.GETINPUT 97939 . 99999) (\TEDIT.MAKEFILENAME 100001 . 100500)) (
|
||||
100551 107002 (TEDIT.PROMPTPRINT 100561 . 103465) (TEDIT.PROMPTFLASH 103467 . 105422) (
|
||||
\TEDIT.PROMPT.PAGEFULLFN 105424 . 107000)) (107237 111230 (TEXTSTREAM.TITLE 107247 . 107868) (
|
||||
\TEDIT.ORIGINAL.WINDOW.TITLE 107870 . 109846) (\TEDIT.WINDOW.TITLE 109848 . 110518) (
|
||||
\TEXTSTREAM.FILENAME 110520 . 111228)) (111273 156172 (TEDIT.DEACTIVATE.WINDOW 111283 . 118590) (
|
||||
\TEDIT.REPAINTFN 118592 . 121449) (\TEDIT.RESHAPEFN 121451 . 127071) (\TEDIT.SCROLLFN 127073 . 156170)
|
||||
) (156214 158263 (\TEDIT.PROCIDLEFN 156224 . 157573) (\TEDIT.PROCENTRYFN 157575 . 157868) (
|
||||
\TEDIT.PROCEXITFN 157870 . 158261)) (158342 169342 (\EDIT.DOWNCARET 158352 . 159033) (\EDIT.FLIPCARET
|
||||
159035 . 160570) (TEDIT.FLASHCARET 160572 . 161686) (\EDIT.UPCARET 161688 . 162141) (
|
||||
TEDIT.NORMALIZECARET 162143 . 168094) (\SETCARET 168096 . 169016) (\TEDIT.CARET 169018 . 169340)) (
|
||||
169376 183131 (TEDIT.ADD.MENUITEM 169386 . 171301) (TEDIT.DEFAULT.MENUFN 171303 . 180570) (
|
||||
TEDIT.REMOVE.MENUITEM 180572 . 181573) (\TEDIT.CREATEMENU 181575 . 182028) (\TEDIT.MENU.WHENHELDFN
|
||||
182030 . 182800) (\TEDIT.MENU.WHENSELECTEDFN 182802 . 183129)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
213
library/TEXEC
213
library/TEXEC
@@ -1,27 +1,23 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED "30-May-91 19:21:21" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>TEXEC.;5| 197129
|
||||
|
||||
|changes| |to:| (FNS TEXEC.GET TEXEC.INCLUDE TEXEC.FIND.FORWARD TEXEC.FIND.BACKWARD
|
||||
TEDIT.FIND.BACKWARD TEDIT.BASICFIND.BACKWARD TEXEC.FILLBUFFER
|
||||
TEXEC.FILLBUFFER.TCLASS TEXEC.CHSELPENDING TEXEC.FILLBUFFER.WORDDELETE
|
||||
TEXEC.FILLBUFFER.LINEDELETE TEXEC.FLASHCARET TEXEC.NTHBACKCHNUM
|
||||
TEXEC.EOTP TEXEC.INSERTCHAR TEXEC.\\CHDEL1 TEDIT.SCROLL?
|
||||
TEXEC.DISPLAYTEXT \\TEXEC.TEXTBOUT \\TEXEC.TEXTBOUT1 \\TEXEC.TEXTBOUT2
|
||||
\\TEXEC.TEXTBOUT4 \\TEXEC.SELFN)
|
||||
(VARS TEXECCOMS)
|
||||
(FILECREATED " 1-Feb-2022 09:24:13" |{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXEC.;2| 195948
|
||||
|
||||
|previous| |date:| "13-Jun-90 00:19:00" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>TEXEC.;2|)
|
||||
:CHANGES-TO (VARS TEXECCOMS TEXEC.ICON TEXEC.ICON.MASK TEXEC.TITLED.ICON.TEMPLATE)
|
||||
(FNS TEXEC.OPENTEXTSTREAM TEXEC.INCLUDE)
|
||||
|
||||
:PREVIOUS-DATE "30-May-91 19:21:21"
|
||||
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXEC.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1985, 1900, 1986, 1987, 1988, 1989, 1990, 1991 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1985, 1900, 1986-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT TEXECCOMS)
|
||||
|
||||
(RPAQQ TEXECCOMS
|
||||
((COMS (* \;
|
||||
"To support development and compilation")
|
||||
"To support development and compilation")
|
||||
(DECLARE\: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
|
||||
ATERM TEDITDECLS)))
|
||||
ATERM TEDITDCL)))
|
||||
(COMS
|
||||
(* |;;| "THE FILLBUFFER REPLACEMENT CODE")
|
||||
|
||||
@@ -61,7 +57,7 @@
|
||||
(DECLARE\: DONTCOPY EVAL@COMPILE
|
||||
|
||||
(FILESLOAD (LOADCOMP)
|
||||
ATERM TEDITDECLS)
|
||||
ATERM TEDITDCL)
|
||||
)
|
||||
|
||||
|
||||
@@ -160,35 +156,32 @@
|
||||
(GO LP))))
|
||||
|
||||
(TEXEC.OPENTEXTSTREAM
|
||||
(LAMBDA (WINDOW MENUFN) (* \; "Edited 13-Jun-90 00:17 by mitani")
|
||||
(LAMBDA (WINDOW MENUFN) (* \; "Edited 13-Jun-90 00:17 by mitani")
|
||||
|
||||
(* |;;| "Initialize and return TEDIT TEXTSTREAM")
|
||||
(* |;;| "Initialize and return TEDIT TEXTSTREAM")
|
||||
|
||||
(LET* ((TEXSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL (LIST 'TERMTABLE \\PRIMTERMTABLE
|
||||
'PROMPTWINDOW
|
||||
'DON\'T)))
|
||||
(TEXTOBJ (TEXTOBJ TEXSTREAM))
|
||||
(TEXLEN (|fetch| (TEXTOBJ TEXTLEN)
|
||||
TEXTOBJ))) (* \;
|
||||
"force shift select typein to be put in keyboard buffer ")
|
||||
TEXTOBJ))) (* \;
|
||||
"force shift select typein to be put in keyboard buffer ")
|
||||
(|replace| (TEXTOBJ TXTEDITING) |of| TEXTOBJ |with| T)
|
||||
(TEXTPROP TEXSTREAM 'STARTINGEOF TEXLEN)
|
||||
(TEXTPROP TEXSTREAM 'COPYBYBKSYSBUF T) (* \;
|
||||
"forces COPY-SELECT to unread chars into TTY buffer")
|
||||
(TEXTPROP TEXSTREAM 'COPYBYBKSYSBUF T) (* \;
|
||||
"forces COPY-SELECT to unread chars into TTY buffer")
|
||||
(TEXTPROP TEXSTREAM 'SELFN (FUNCTION \\TEXEC.SELFN))
|
||||
(* \;
|
||||
"Limits selection to current input")
|
||||
(* \;
|
||||
"Limits selection to current input")
|
||||
(|replace| (STREAM STRMBOUTFN) |of| TEXSTREAM |with| '\\TEXEC.TEXTBOUT)
|
||||
(|replace| (SELECTION SET) |of| (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ)
|
||||
|with| T)
|
||||
(|replace| (SELECTION SET) |of| (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ) |with| T)
|
||||
(|replace| (SELECTION L1) |of| (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ)
|
||||
|with| (LIST (|fetch| DESC |of| (|fetch| (TEXTOBJ THISLINE) |of|
|
||||
TEXTOBJ))))
|
||||
(* \;
|
||||
"hookup middle button menu instead of TEDIT menu")
|
||||
|with| (LIST (|fetch| DESC |of| (|fetch| (TEXTOBJ THISLINE) |of| TEXTOBJ))))
|
||||
(* \;
|
||||
"hookup middle button menu instead of TEDIT menu")
|
||||
(WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN)
|
||||
(CHANGEFONT (|fetch| (CHARLOOKS CLFONT) |of| (|fetch| (TEXTOBJ CARETLOOKS)
|
||||
|of| TEXTOBJ))
|
||||
(CHANGEFONT (|fetch| (CHARLOOKS CLFONT) |of| (|fetch| (TEXTOBJ CARETLOOKS) |of| TEXTOBJ))
|
||||
TEXSTREAM)
|
||||
TEXSTREAM)))
|
||||
|
||||
@@ -483,30 +476,30 @@
|
||||
(T (TEDIT.PROMPTPRINT TEXTOBJ "[Get aborted.]" T))))))
|
||||
|
||||
(TEXEC.INCLUDE
|
||||
(LAMBDA (STREAM FILE START END) (* \; "Edited 30-May-91 19:17 by jds")
|
||||
(LAMBDA (STREAM FILE START END) (* \; "Edited 30-May-91 19:17 by jds")
|
||||
|
||||
(* |Obtain| \a |file| |name,| |and| |include| |that| |file's| |contents| |at|
|
||||
|the| |place| |where| |the| |caret| |is.|)
|
||||
|the| |place| |where| |the| |caret| |is.|)
|
||||
|
||||
(* |Returns| T |if| |the| |insertion| |happened,| NIL |if| |there| |was| |no|
|
||||
|place| |to| |put| |it.|)
|
||||
|place| |to| |put| |it.|)
|
||||
|
||||
(SETQ STREAM (TEXTOBJ STREAM))
|
||||
(PROG ((SEL (|fetch| (TEXTOBJ SEL) |of| STREAM))
|
||||
PCTB TEXTLEN NFILE NNFILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN PCCOUNT NSTREAM)
|
||||
(COND
|
||||
((|fetch| (SELECTION SET) |of| SEL) (* |There| |is| \a |place| |to| |do|
|
||||
|the| |include.|)
|
||||
((|fetch| (SELECTION SET) |of| SEL) (* |There| |is| \a |place| |to| |do|
|
||||
|the| |include.|)
|
||||
(SETQ NFILE (OR FILE (\\TEDIT.MAKEFILENAME (TEDIT.GETINPUT STREAM
|
||||
"Name of the file to load: "))))
|
||||
(COND
|
||||
((NOT NFILE) (* I\f |no| |file| |was| |given,|
|
||||
|don't| |bother| |INCLUDEing.|)
|
||||
|don't| |bother| |INCLUDEing.|)
|
||||
(TEDIT.PROMPTPRINT STREAM "[Include aborted.]" T)
|
||||
(RETURN))
|
||||
((STREAMP NFILE))
|
||||
((NOT (INFILEP NFILE)) (* |Can't| |find| |the| |file.|
|
||||
|Put| |out| \a |message.|)
|
||||
|Put| |out| \a |message.|)
|
||||
(TEDIT.PROMPTPRINT STREAM "[File not found.]")
|
||||
(RETURN)))
|
||||
(SETQ NNFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT 'NEW))
|
||||
@@ -516,81 +509,78 @@
|
||||
(SETQ WASOPEN T)
|
||||
NFILE)
|
||||
(T (* |Wasn't| |open| --
|
||||
|need| |to| |open| |it| |for|
|
||||
|input...|)
|
||||
|need| |to| |open| |it| |for|
|
||||
|input...|)
|
||||
(OPENFILE NFILE 'INPUT)))) (* |And| |copy| |the| |file-section|
|
||||
|into| |it.|)
|
||||
|into| |it.|)
|
||||
(COPYBYTES NFILE NNFILE (OR START 0)
|
||||
(OR END (GETEOFPTR NFILE)))
|
||||
|
||||
(* |Have| |to| |explicitly| |fill| |in| 0 |and| EOFPTR\, |because| |if| |the|
|
||||
|file| |was| |open| |already,| NIL\s |would| |only| |copy| |from| |current|
|
||||
|fileptr| |to| EOF.)
|
||||
|file| |was| |open| |already,| NIL\s |would| |only| |copy| |from| |current|
|
||||
|fileptr| |to| EOF.)
|
||||
|
||||
(OR WASOPEN (CLOSEF NFILE)) (* I\f |the| |file| |didn't| |come|
|
||||
|to| |use| |open,| |close| |it.|)
|
||||
|to| |use| |open,| |close| |it.|)
|
||||
(CLOSEF NNFILE)
|
||||
(SETQ NFILE NNFILE)
|
||||
(SETQ START (SETQ END NIL)) (* |Then| |pretend| |nothing|
|
||||
|happened.|)
|
||||
(TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* |Delete| |any| |text,| |if|
|
||||
|need| |be|)
|
||||
|happened.|)
|
||||
(TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* |Delete| |any| |text,| |if| |need|
|
||||
|be|)
|
||||
(SETQ TEXTLEN (|fetch| (TEXTOBJ TEXTLEN) |of| STREAM))
|
||||
|
||||
(* W\e |need| |the| |POST-deletion| |text| |length| |for| |later,| |so| |this|
|
||||
|must| |come| |after| |the| |b-p-d.|)
|
||||
|must| |come| |after| |the| |b-p-d.|)
|
||||
|
||||
(\\SHOWSEL SEL NIL NIL) (* |Turn| |off| SEL\s |before| |we|
|
||||
|go| |any| |further|)
|
||||
|go| |any| |further|)
|
||||
(SETQ NFILE (TEXTOBJ (SETQ NSTREAM (OPENTEXTSTREAM (OPENSTREAM NFILE 'INPUT)
|
||||
NIL NIL NIL (LIST 'FONT (
|
||||
\\TEDIT.GET.INSERT.CHARLOOKS
|
||||
STREAM SEL)
|
||||
'PARALOOKS
|
||||
(|fetch| (TEXTOBJ
|
||||
FMTSPEC)
|
||||
(|fetch| (TEXTOBJ FMTSPEC)
|
||||
|of| STREAM))))))
|
||||
(* |Get| \a |textobj| |to|
|
||||
|describe| |the| |include| |source|
|
||||
|file| (|need| NSTREAM |so| |that|
|
||||
|if| |we| |have| |to| |convert| |it|
|
||||
|to| |formatted,| |we| |won't|
|
||||
|have| |lost| |the|
|
||||
|textstream--and| |thus| |smash|
|
||||
|the| |free| |list.|))
|
||||
(* |Get| \a |textobj| |to| |describe|
|
||||
|the| |include| |source| |file|
|
||||
(|need| NSTREAM |so| |that| |if| |we|
|
||||
|have| |to| |convert| |it| |to|
|
||||
|formatted,| |we| |won't| |have|
|
||||
|lost| |the| |textstream--and| |thus|
|
||||
|smash| |the| |free| |list.|))
|
||||
(COND
|
||||
((AND (|fetch| (TEXTOBJ FORMATTEDP) |of| NFILE)
|
||||
(NOT (|fetch| (TEXTOBJ FORMATTEDP) |of| STREAM)))
|
||||
(* I\f |the| |includED| |text| |is|
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
(\\TEDIT.CONVERT.TO.FORMATTED STREAM))
|
||||
((AND (|fetch| (TEXTOBJ FORMATTEDP) |of| STREAM)
|
||||
(NOT (|fetch| (TEXTOBJ FORMATTEDP) |of| NFILE)))
|
||||
|
||||
(* |The| TARGET |document| |is| |formatted,| |but| |the| INCLUDE\d |text|
|
||||
|isn't.| |Better| |format| |it| |before| |completing| |the| |include.|)
|
||||
|isn't.| |Better| |format| |it| |before| |completing| |the| |include.|)
|
||||
|
||||
(\\TEDIT.CONVERT.TO.FORMATTED NFILE)))
|
||||
(SETQ PCTB (|fetch| (TEXTOBJ PCTB) |of| STREAM))
|
||||
(* HERE\, |because| |the|
|
||||
|conversion| |to| |formatted| |will|
|
||||
|lengthen| |the| |pctb|)
|
||||
(* HERE\, |because| |the| |conversion|
|
||||
|to| |formatted| |will| |lengthen|
|
||||
|the| |pctb|)
|
||||
(SETQ INSERTCH# (COND
|
||||
((EQ (|fetch| (SELECTION POINT) |of| SEL)
|
||||
'LEFT)
|
||||
(|fetch| (SELECTION CH#) |of| SEL))
|
||||
(T (|fetch| (SELECTION CHLIM) |of| SEL))))
|
||||
(* |Find| |the| |place| |to| |make|
|
||||
|the| |insertion.|)
|
||||
|the| |insertion.|)
|
||||
(SETQ INSPC# (OR (\\CHTOPCNO INSERTCH# PCTB)
|
||||
(\\EDITELT PCTB |\\PCTBLastPieceOffset|)))
|
||||
(* |Likewise,| |this| |is|
|
||||
|affected| |by| |the|
|
||||
|convert-to-formatted|)
|
||||
(* |Likewise,| |this| |is| |affected|
|
||||
|by| |the| |convert-to-formatted|)
|
||||
(SETQ INSPC (\\EDITELT (|fetch| (TEXTOBJ PCTB) |of| STREAM)
|
||||
(ADD1 INSPC#))) (* |The| |piece| |to| |make| |the|
|
||||
|insertion| |in|)
|
||||
|insertion| |in|)
|
||||
(COND
|
||||
((NEQ INSPC 'LASTPIECE)
|
||||
(COND
|
||||
@@ -600,17 +590,17 @@
|
||||
(|add| INSPC# |\\EltsPerPiece|)
|
||||
(SETQ PCTB (|fetch| (TEXTOBJ PCTB) |of| STREAM))
|
||||
(* |Refresh| |the| PCTB |in| |case|
|
||||
|it| |grew.|)
|
||||
|it| |grew.|)
|
||||
))))
|
||||
(SETQ PCLST (|fetch| (TEXTOBJ PCTB) |of| NFILE))
|
||||
(* A |temporary| |pctb,| |holding|
|
||||
|the| |pieces| |which| |describe|
|
||||
|the| INCLUDE\d |text|)
|
||||
|the| |pieces| |which| |describe|
|
||||
|the| INCLUDE\d |text|)
|
||||
(SETQ LEN (SUB1 (\\EDITELT PCLST (SUB1 (\\EDITELT PCLST |\\PCTBLastPieceOffset|)))))
|
||||
(SETQ PCCOUNT (IDIFFERENCE (SUB1 (\\EDITELT PCLST |\\PCTBLastPieceOffset|))
|
||||
|\\FirstPieceOffset|)) (* |Remember| |how| |many| |slots|
|
||||
|in| |the| PCTB |we| |took| |up|
|
||||
(|i.e.| 2 \x \# |of| |pieces|))
|
||||
|in| |the| PCTB |we| |took| |up|
|
||||
(|i.e.| 2 \x \# |of| |pieces|))
|
||||
(\\TEDIT.INSERT.PIECES STREAM INSERTCH# (SETQ PCLST (\\EDITELT PCLST (ADD1
|
||||
|\\FirstPieceOffset|
|
||||
)))
|
||||
@@ -619,8 +609,8 @@
|
||||
((AND (|fetch| (TEXTOBJ FORMATTEDP) |of| STREAM)
|
||||
(NOT (|fetch| (TEXTOBJ FORMATTEDP) |of| NFILE)))
|
||||
(* I\f |the| |includED| |text| |is|
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
|formatted| |but| |this| |file|
|
||||
|isn't,| |let's| |format| |it!|)
|
||||
(\\TEDIT.CONVERT.TO.FORMATTED STREAM INSERTCH# (IPLUS INSERTCH# LEN))))
|
||||
(\\TEDIT.HISTORYADD STREAM (|create| TEDITHISTORYEVENT
|
||||
THACTION _ '|Include|
|
||||
@@ -628,39 +618,34 @@
|
||||
THLEN _ LEN
|
||||
THFIRSTPIECE _ PCLST))
|
||||
(* |Remember| |that| |we| |did|
|
||||
|this,| |so| |it| |can| |be|
|
||||
|undone.|)
|
||||
|this,| |so| |it| |can| |be| |undone.|)
|
||||
(|replace| (TEXTOBJ TEXTLEN) |of| STREAM |with| (IPLUS TEXTLEN LEN))
|
||||
|
||||
(* |Inserting| |the| |pieces| |didn't| |fix| |up| |things| |like| |the|
|
||||
|length| |of| |the| |document,| |so| |do| |it| |now.|)
|
||||
(* |Inserting| |the| |pieces| |didn't| |fix| |up| |things| |like| |the| |length|
|
||||
|of| |the| |document,| |so| |do| |it| |now.|)
|
||||
|
||||
(AND (|fetch| (TEXTOBJ \\WINDOW) |of| STREAM)
|
||||
(\\FIXILINES STREAM SEL INSERTCH# LEN TEXTLEN))
|
||||
(* |Mark| |any| |changed| |lines|
|
||||
|dirty.|)
|
||||
(|replace| (SELECTION CHLIM) |of| SEL |with| (|replace| (SELECTION
|
||||
CH#)
|
||||
|of| SEL
|
||||
|with| (IPLUS INSERTCH#
|
||||
LEN)))
|
||||
|dirty.|)
|
||||
(|replace| (SELECTION CHLIM) |of| SEL |with| (|replace| (SELECTION CH#) |of| SEL
|
||||
|with| (IPLUS INSERTCH# LEN)))
|
||||
|
||||
(* |Now| |fix| |up| |the| |selection| |to| |be| |at| |the| |end| |of| |the|
|
||||
|included| |text,| |point_left,| |character| |selection| |grain.|)
|
||||
|included| |text,| |point_left,| |character| |selection| |grain.|)
|
||||
|
||||
(|replace| (SELECTION DCH) |of| SEL |with| 0)
|
||||
(|replace| (SELECTION DX) |of| SEL |with| 0)
|
||||
(|replace| (SELECTION POINT) |of| SEL |with| 'LEFT)
|
||||
(* S\o |that| |several| |things|
|
||||
INCLUDED |in| |sequence| |fall| |in|
|
||||
|sequence.|)
|
||||
INCLUDED |in| |sequence| |fall| |in|
|
||||
|sequence.|)
|
||||
(|replace| (SELECTION SELKIND) |of| SEL |with| 'CHAR)
|
||||
(|replace| (SELECTION SELOBJ) |of| SEL |with| NIL)
|
||||
(COND
|
||||
((|fetch| (TEXTOBJ \\WINDOW) |of| STREAM)
|
||||
(* |We're| |displaying;|
|
||||
|update| |the| |display| |and| |the|
|
||||
|selection's| |line| |references|)
|
||||
((|fetch| (TEXTOBJ \\WINDOW) |of| STREAM) (* |We're| |displaying;|
|
||||
|update| |the| |display| |and| |the|
|
||||
|selection's| |line| |references|)
|
||||
(TEDIT.UPDATE.SCREEN STREAM)
|
||||
(\\FIXSEL SEL STREAM)
|
||||
(\\SHOWSEL SEL NIL T)))
|
||||
@@ -671,9 +656,9 @@
|
||||
PCOFF _ 0
|
||||
PCNO _ (IPLUS INSPC# PCCOUNT))
|
||||
STREAM) (* |Set| |the| |fileptr| |to| |the|
|
||||
|end| |of| |the| |insertion.|)
|
||||
(TEDIT.SCROLL? STREAM) (* |Scroll| |the| |end| |into|
|
||||
|view| |if| |necessary|)
|
||||
|end| |of| |the| |insertion.|)
|
||||
(TEDIT.SCROLL? STREAM) (* |Scroll| |the| |end| |into| |view|
|
||||
|if| |necessary|)
|
||||
T)
|
||||
(T (TEDIT.PROMPTPRINT STREAM "Please choose the place for the INCLUDE first." T))))))
|
||||
|
||||
@@ -2845,7 +2830,7 @@
|
||||
)
|
||||
|
||||
(APPENDTOVAR |BackgroundMenuCommands| (TEXEC '(TEXEC)
|
||||
"Starts TEXEC in a new window."))
|
||||
"Starts TEXEC in a new window."))
|
||||
|
||||
(READVARS-FROM-STRINGS '(TEXEC.ICON TEXEC.ICON.MASK TEXEC.TITLED.ICON.TEMPLATE)
|
||||
" ( {(READBITMAP)(64 77
|
||||
@@ -3175,21 +3160,21 @@
|
||||
(RPAQ? TEXEC.BUFFERLIMIT 10000)
|
||||
(PUTPROPS TEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1986 1987 1988 1989 1990 1991))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (3793 183206 (TEXEC.BACKSKREAD 3803 . 8427) (TEXEC.OPENTEXTSTREAM 8429 . 10643) (
|
||||
TEXEC.DEFAULT.MENUFN 10645 . 15199) (TEXEC.DO?CMD 15201 . 20519) (TEXEC.CREATEMENU 20521 . 20979) (
|
||||
TEXEC.GET 20981 . 29816) (TEXEC.INCLUDE 29818 . 43700) (TEXEC.FIND.FORWARD 43702 . 56590) (
|
||||
TEXEC.FIND.BACKWARD 56592 . 70094) (TEDIT.FIND.BACKWARD 70096 . 75573) (TEDIT.BASICFIND.BACKWARD 75575
|
||||
. 80229) (TEXEC.MENU.WHENHELDFN 80231 . 80890) (TEXEC.SHRINK.ICONCREATE 80892 . 83695) (
|
||||
TEXEC.FILLBUFFER 83697 . 100131) (TEXEC.FILLBUFFER.TCLASS 100133 . 106473) (TEXEC.CHSELPENDING 106475
|
||||
. 114965) (TEXEC.FILLBUFFER.CHARDELETE 114967 . 117022) (TEXEC.FILLBUFFER.WORDDELETE 117024 . 122152)
|
||||
(TEXEC.FILLBUFFER.LINEDELETE 122154 . 125036) (TEXEC.PARENCOUNT 125038 . 126427) (TEXEC.PARENMATCH
|
||||
126429 . 127969) (TEXEC.FLASHCARET 127971 . 130630) (TEXEC.TEXTSTREAM.TO.LINEBUF 130632 . 133319) (
|
||||
TEXEC.FIX 133321 . 136490) (TEXEC.NTHBUFCHARBACK 136492 . 137555) (TEXEC.NTHBACKCHNUM 137557 . 138842)
|
||||
(TEXEC.EOTP 138844 . 139577) (TEXEC.GETKEY 139579 . 142495) (TEXEC.INSERTCHAR 142497 . 144798) (
|
||||
TEXEC.DELETE 144800 . 145575) (TEXEC.\\CHDEL1 145577 . 148702) (TEXEC.?EQUAL 148704 . 149753) (
|
||||
TEDIT.SCROLL? 149755 . 154718) (TEXEC.DISPLAYTEXT 154720 . 161495) (\\TEXEC.TEXTBOUT 161497 . 164505)
|
||||
(\\TEXEC.TEXTBOUT1 164507 . 170141) (\\TEXEC.TEXTBOUT2 170143 . 172474) (\\TEXEC.TEXTBOUT3 172476 .
|
||||
173866) (\\TEXEC.TEXTBOUT4 173868 . 175911) (\\TEXEC.SELFN 175913 . 177288) (TEXEC.PRINTARGS 177290 .
|
||||
182253) (TEXEC.PROCENTRYFN 182255 . 182796) (TEXEC.PROCEXITFN 182798 . 183204)) (183266 189641 (TEXEC
|
||||
183276 . 187698) (TTEXEC 187700 . 189639)))))
|
||||
(FILEMAP (NIL (3269 182029 (TEXEC.BACKSKREAD 3279 . 7903) (TEXEC.OPENTEXTSTREAM 7905 . 9963) (
|
||||
TEXEC.DEFAULT.MENUFN 9965 . 14519) (TEXEC.DO?CMD 14521 . 19839) (TEXEC.CREATEMENU 19841 . 20299) (
|
||||
TEXEC.GET 20301 . 29136) (TEXEC.INCLUDE 29138 . 42523) (TEXEC.FIND.FORWARD 42525 . 55413) (
|
||||
TEXEC.FIND.BACKWARD 55415 . 68917) (TEDIT.FIND.BACKWARD 68919 . 74396) (TEDIT.BASICFIND.BACKWARD 74398
|
||||
. 79052) (TEXEC.MENU.WHENHELDFN 79054 . 79713) (TEXEC.SHRINK.ICONCREATE 79715 . 82518) (
|
||||
TEXEC.FILLBUFFER 82520 . 98954) (TEXEC.FILLBUFFER.TCLASS 98956 . 105296) (TEXEC.CHSELPENDING 105298 .
|
||||
113788) (TEXEC.FILLBUFFER.CHARDELETE 113790 . 115845) (TEXEC.FILLBUFFER.WORDDELETE 115847 . 120975) (
|
||||
TEXEC.FILLBUFFER.LINEDELETE 120977 . 123859) (TEXEC.PARENCOUNT 123861 . 125250) (TEXEC.PARENMATCH
|
||||
125252 . 126792) (TEXEC.FLASHCARET 126794 . 129453) (TEXEC.TEXTSTREAM.TO.LINEBUF 129455 . 132142) (
|
||||
TEXEC.FIX 132144 . 135313) (TEXEC.NTHBUFCHARBACK 135315 . 136378) (TEXEC.NTHBACKCHNUM 136380 . 137665)
|
||||
(TEXEC.EOTP 137667 . 138400) (TEXEC.GETKEY 138402 . 141318) (TEXEC.INSERTCHAR 141320 . 143621) (
|
||||
TEXEC.DELETE 143623 . 144398) (TEXEC.\\CHDEL1 144400 . 147525) (TEXEC.?EQUAL 147527 . 148576) (
|
||||
TEDIT.SCROLL? 148578 . 153541) (TEXEC.DISPLAYTEXT 153543 . 160318) (\\TEXEC.TEXTBOUT 160320 . 163328)
|
||||
(\\TEXEC.TEXTBOUT1 163330 . 168964) (\\TEXEC.TEXTBOUT2 168966 . 171297) (\\TEXEC.TEXTBOUT3 171299 .
|
||||
172689) (\\TEXEC.TEXTBOUT4 172691 . 174734) (\\TEXEC.SELFN 174736 . 176111) (TEXEC.PRINTARGS 176113 .
|
||||
181076) (TEXEC.PROCENTRYFN 181078 . 181619) (TEXEC.PROCEXITFN 181621 . 182027)) (182089 188464 (TEXEC
|
||||
182099 . 186521) (TTEXEC 186523 . 188462)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
688
library/TEXTOFD
688
library/TEXTOFD
@@ -1,12 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "12-Oct-2021 15:38:41"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;4 176302
|
||||
(FILECREATED "22-Dec-2021 10:29:27" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;12 182752
|
||||
|
||||
changes to%: (FNS \TEDITOUTCCODEFN)
|
||||
:CHANGES-TO (FNS \TEXTBIN \TEXTPEEKBIN)
|
||||
|
||||
previous date%: " 7-Oct-2021 08:41:13"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TEXTOFD.;3)
|
||||
:PREVIOUS-DATE "22-Dec-2021 10:01:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TEXTOFD.;11)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -31,7 +30,7 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE
|
||||
\INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE))
|
||||
(COMS (* ;
|
||||
"Generic-IO type operations support")
|
||||
"Generic-IO type operations support")
|
||||
(FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR
|
||||
\TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR
|
||||
\TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION
|
||||
@@ -1913,214 +1912,248 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(DEFINEQ
|
||||
|
||||
(\TEXTBIN
|
||||
[LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:33 by jds")
|
||||
[LAMBDA (STREAM)
|
||||
|
||||
(* ;; "Edited 22-Dec-2021 10:29 by rmk: Return value of OBJECTCHAR property for image objecdts")
|
||||
|
||||
(* ;; "Edited 28-Mar-94 15:33 by jds")
|
||||
|
||||
(* ;;; "Do BIN slow case for a text stream")
|
||||
(* ;
|
||||
"NB that PEEKBIN and BACKFILEPTR need to track changes in this code")
|
||||
"NB that PEEKBIN and BACKFILEPTR need to track changes in this code")
|
||||
(DECLARE (LOCALVARS . T))
|
||||
(PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM)
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(LET (BYTE) (* ;
|
||||
"RMK: Capture all return values for any special imageobject coercion")
|
||||
[SETQ BYTE (PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM)
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(* ;
|
||||
"Simple case -- just do the usual BIN")
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) of STREAM
|
||||
)))
|
||||
"Simple case -- just do the usual BIN")
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE)
|
||||
of STREAM)))
|
||||
(* ; "Handle objects specially")
|
||||
(COND
|
||||
((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM))
|
||||
(COND
|
||||
((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM))
|
||||
(* ;
|
||||
"If this object has a substream in it, go to that substream")
|
||||
(add (fetch (STREAM COFFSET) of STREAM)
|
||||
1)
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T
|
||||
(* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.")
|
||||
"If this object has a substream in it, go to that substream")
|
||||
(add (fetch (STREAM COFFSET) of STREAM)
|
||||
1)
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T
|
||||
(* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.")
|
||||
|
||||
(replace (STREAM COFFSET) of STREAM with (fetch (STREAM
|
||||
CBUFSIZE)
|
||||
of STREAM))
|
||||
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
|
||||
(RETURN PO]
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(replace (STREAM COFFSET) of STREAM
|
||||
with (fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
|
||||
(RETURN PO]
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(* ;
|
||||
"This is a 16 bit BIN. grab 2 bytes.")
|
||||
"This is a 16 bit BIN. grab 2 bytes.")
|
||||
(* ;
|
||||
"WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??")
|
||||
(RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(COND
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
"WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??")
|
||||
(RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(COND
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(* ;
|
||||
"This pair of characters doesn't straddle a file page bound. Just grab the next char.")
|
||||
(\PAGEDBIN STREAM))
|
||||
(T (* ;
|
||||
"Need to move to the next page on the backing file. Doing so also grabs the next character.")
|
||||
(\TEDIT.TEXTBIN.NEW.PAGE STREAM T]
|
||||
(T (RETURN (\PAGEDBIN STREAM]
|
||||
(T (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
"This pair of characters doesn't straddle a file page bound. Just grab the next char.")
|
||||
(\PAGEDBIN STREAM))
|
||||
(T (* ;
|
||||
"Need to move to the next page on the backing file. Doing so also grabs the next character.")
|
||||
(\TEDIT.TEXTBIN.NEW.PAGE STREAM T]
|
||||
(T (RETURN (\PAGEDBIN STREAM]
|
||||
(T (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
(* ; "Time for a new piece.")
|
||||
[repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN) of PC)))
|
||||
do (* ;
|
||||
"Skip over any zero-length pieces at the end of the file.")
|
||||
(SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (AND OPC (fetch (PIECE NEXTPIECE)
|
||||
of OPC]
|
||||
(replace (STREAM BINABLE) of STREAM with T)
|
||||
(replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL)
|
||||
[repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN)
|
||||
of PC)))
|
||||
do (* ;
|
||||
"Skip over any zero-length pieces at the end of the file.")
|
||||
(SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (AND OPC (fetch (PIECE NEXTPIECE)
|
||||
of OPC]
|
||||
(replace (STREAM BINABLE) of STREAM with T)
|
||||
(replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL)
|
||||
(* ;
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (* ;
|
||||
"There IS a next piece to move to.")
|
||||
(AND (fetch (TEXTSTREAM LOOKSUPDATEFN) of STREAM)
|
||||
(SETQ NPC (APPLY* (fetch (TEXTSTREAM LOOKSUPDATEFN)
|
||||
of STREAM)
|
||||
STREAM PC))
|
||||
(replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (SETQ PC NPC)))
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (* ; "There IS a next piece to move to.")
|
||||
(AND (fetch (TEXTSTREAM LOOKSUPDATEFN)
|
||||
of STREAM)
|
||||
(SETQ NPC (APPLY* (fetch (TEXTSTREAM
|
||||
LOOKSUPDATEFN
|
||||
)
|
||||
of STREAM)
|
||||
STREAM PC))
|
||||
(replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (SETQ PC NPC)))
|
||||
(* ;
|
||||
"Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.")
|
||||
[COND
|
||||
(NPC (* ;
|
||||
"If we got an NPC, this was taken care of by the LOOKSUPDATEFN")
|
||||
)
|
||||
([AND (SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM]
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS) of
|
||||
SUBSTREAM
|
||||
)))
|
||||
[(NEQ (fetch (PIECE PPARALOOKS) of OPC)
|
||||
(fetch (PIECE PPARALOOKS) of PC))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.PARASTYLES (fetch (PIECE
|
||||
PPARALOOKS
|
||||
)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
((NOT (EQCLOOKS (fetch (PIECE PLOOKS) of PC)
|
||||
(fetch (PIECE PLOOKS) of OPC)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
(COND
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
"Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.")
|
||||
[COND
|
||||
(NPC (* ;
|
||||
"If we got an NPC, this was taken care of by the LOOKSUPDATEFN")
|
||||
)
|
||||
([AND (SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(SETQ SUBSTREAM (IMAGEOBJPROP
|
||||
PO
|
||||
'SUBSTREAM]
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
) of SUBSTREAM
|
||||
))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
CURRENTLOOKS)
|
||||
of SUBSTREAM)))
|
||||
[(NEQ (fetch (PIECE PPARALOOKS) of OPC)
|
||||
(fetch (PIECE PPARALOOKS) of PC))
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (\TEDIT.APPLY.PARASTYLES
|
||||
(fetch (PIECE PPARALOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM with (\TEDIT.APPLY.STYLES
|
||||
(fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
((NOT (EQCLOOKS (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
(fetch (PIECE PLOOKS) of OPC)))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM with (\TEDIT.APPLY.STYLES
|
||||
(fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM]
|
||||
(COND
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
(* ; "This piece lives in a string.")
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PS)
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP
|
||||
0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PS)
|
||||
|
||||
(* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")
|
||||
(* ;
|
||||
"Then actually grab the next character to hand back to the caller.")
|
||||
(\BIN STREAM))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
"Then actually grab the next character to hand back to the caller.")
|
||||
(\BIN STREAM))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
(* ; "This piece lives on a file.")
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PF (fetch (PIECE PFATP) of PC)
|
||||
'PEEKBIN)
|
||||
(\BIN STREAM))
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (STREAM COFFSET) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
|
||||
with 0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
|
||||
CURRENTPARALOOKS
|
||||
) of
|
||||
SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(RETURN PO]
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(T (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(COND
|
||||
((fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PF (fetch (PIECE PFATP)
|
||||
of PC)
|
||||
'PEEKBIN)
|
||||
(\BIN STREAM))
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM
|
||||
with NIL)
|
||||
(COND
|
||||
(SUBSTREAM
|
||||
(* ;
|
||||
"If there's an EOF handler, call it & return the result")
|
||||
(RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM
|
||||
)
|
||||
STREAM)))
|
||||
(T (* ; "Otherwise, return NIL")
|
||||
(RETURN NIL]
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE)
|
||||
of STREAM)))
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM
|
||||
TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (STREAM COFFSET)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM
|
||||
with (fetch (PIECE PLEN)
|
||||
of PC))
|
||||
(freplace (STREAM CBUFSIZE)
|
||||
of STREAM
|
||||
with (fetch (PIECE PLEN)
|
||||
of PC))
|
||||
(freplace (STREAM CPAGE)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG)
|
||||
of STREAM with 0)
|
||||
(replace (TEXTSTREAM
|
||||
CURRENTPARALOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
) of SUBSTREAM
|
||||
))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM with 0)
|
||||
(RETURN PO]
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(T (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(COND
|
||||
((fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
(* ;
|
||||
"If there's an EOF handler, call it & return the result")
|
||||
(RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP)
|
||||
of STREAM)
|
||||
STREAM)))
|
||||
(T (* ; "Otherwise, return NIL")
|
||||
(RETURN NIL]
|
||||
[(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE)
|
||||
of STREAM)))
|
||||
(* ; "This is an object")
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) of
|
||||
SUBSTREAM))
|
||||
(freplace (STREAM COFFSET) of STREAM with 1)
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM with
|
||||
0)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM with
|
||||
1)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM with
|
||||
0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS) of
|
||||
SUBSTREAM
|
||||
))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)
|
||||
(RETURN PO]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM])
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (STREAM COFFSET) of STREAM
|
||||
with 1)
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
|
||||
with 1)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
|
||||
with 0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
) of SUBSTREAM)
|
||||
)
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(RETURN PO]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM]
|
||||
(IF (IMAGEOBJP BYTE)
|
||||
THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM)
|
||||
'OBJECTBYTE)
|
||||
BYTE)
|
||||
ELSE BYTE])
|
||||
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP
|
||||
[LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* ; "Edited 31-May-91 14:21 by jds")
|
||||
@@ -2353,123 +2386,144 @@ Copyright (c) 1983-1991, 1993-1995, 1999-2001, 2021 by John Sybalsky & Xerox Cor
|
||||
(DEFINEQ
|
||||
|
||||
(\TEXTPEEKBIN
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 28-Mar-94 15:34 by jds")
|
||||
[LAMBDA (STREAM NOERRORFLG)
|
||||
|
||||
(* ;; "Edited 22-Dec-2021 10:29 by rmk: Return OBJECTCHAR for image objects, if present")
|
||||
|
||||
(* ;; "Edited 28-Mar-94 15:34 by jds")
|
||||
(* ; "DO PEEKBIN for a text stream")
|
||||
(PROG (CH FILE STR PF PS PC PO SUBSTREAM)
|
||||
(SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(LET (BYTE) (* ;
|
||||
"BYTE to capture all returns for imageobject coercion")
|
||||
[SETQ BYTE (PROG (CH FILE STR PF PS PC PO SUBSTREAM)
|
||||
(SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM))
|
||||
(COND
|
||||
[(ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(fetch (STREAM CBUFSIZE) of STREAM))
|
||||
(* ;
|
||||
"Simple case -- just do the usual PEEKBIN")
|
||||
(COND
|
||||
((AND PC (fetch (PIECE POBJ) of PC))
|
||||
(RETURN (fetch (PIECE POBJ) of PC)))
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(* ;
|
||||
"This is a 16 bit PEEKBIN. Grab two chars...")
|
||||
(RETURN (COND
|
||||
[(\EOFP STREAM)
|
||||
"Simple case -- just do the usual PEEKBIN")
|
||||
(COND
|
||||
(NOERRORFLG NIL)
|
||||
(T (\PEEKBIN STREAM]
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(SUB1 (fetch (STREAM CBUFSIZE) of STREAM)))
|
||||
((AND PC (SETQ PO (fetch (PIECE POBJ) of PC)))
|
||||
(RETURN PO))
|
||||
[(fetch (TEXTSTREAM FATSTREAMP) of STREAM)
|
||||
(* ;
|
||||
"We're sure of staying on the same page. Just grab the characters")
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(\PAGEDPEEKBIN STREAM NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR STREAM)))
|
||||
(T (SETQ PS (fetch (STREAM F1) of STREAM))
|
||||
(replace (STREAM COFFSET) of PS with (fetch
|
||||
(STREAM COFFSET)
|
||||
of STREAM))
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS)
|
||||
256)
|
||||
(\PAGEDPEEKBIN PS NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR PS]
|
||||
(T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG]
|
||||
[PC (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
"This is a 16 bit PEEKBIN. Grab two chars...")
|
||||
(RETURN (COND
|
||||
[(\EOFP STREAM)
|
||||
(COND
|
||||
(NOERRORFLG NIL)
|
||||
(T (\PEEKBIN STREAM]
|
||||
((ILESSP (fetch (STREAM COFFSET) of STREAM)
|
||||
(SUB1 (fetch (STREAM CBUFSIZE) of STREAM)))
|
||||
(* ;
|
||||
"We're sure of staying on the same page. Just grab the characters")
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM)
|
||||
256)
|
||||
(\PAGEDPEEKBIN STREAM NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR STREAM)))
|
||||
(T (SETQ PS (fetch (STREAM F1) of STREAM))
|
||||
(replace (STREAM COFFSET) of PS
|
||||
with (fetch (STREAM COFFSET) of STREAM))
|
||||
(PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS)
|
||||
256)
|
||||
(\PAGEDPEEKBIN PS NOERRORFLG))
|
||||
(\PAGEDBACKFILEPTR PS]
|
||||
(T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG]
|
||||
[PC (* ;
|
||||
"We've either hit a page bound in a file, or a piece bound.")
|
||||
(RETURN (COND
|
||||
[(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM))
|
||||
(* ; "Time for a new piece.")
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (fetch (PIECE NEXTPIECE) of PC)))
|
||||
(SETQ PC (replace (TEXTSTREAM PIECE) of STREAM
|
||||
with (fetch (PIECE NEXTPIECE) of PC)))
|
||||
(* ;
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ) of STREAM)
|
||||
))
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM with NIL)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM COFFSET) of STREAM with 0)
|
||||
(COND
|
||||
(SUBSTREAM (* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM CPAGE) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH) of STREAM
|
||||
with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG) of STREAM
|
||||
with 0)
|
||||
(replace (TEXTSTREAM CURRENTPARALOOKS)
|
||||
of STREAM with (fetch (TEXTSTREAM
|
||||
|
||||
"Move to the next piece in the chain")
|
||||
(COND
|
||||
[PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM
|
||||
with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS
|
||||
)
|
||||
of PC)
|
||||
PC
|
||||
(fetch (TEXTSTREAM TEXTOBJ)
|
||||
of STREAM)))
|
||||
(COND
|
||||
[(SETQ PO (fetch (PIECE POBJ) of PC))
|
||||
(replace (STREAM BINABLE) of STREAM
|
||||
with NIL)
|
||||
(freplace (STREAM CBUFSIZE) of STREAM
|
||||
with (fetch (PIECE PLEN) of PC))
|
||||
(freplace (STREAM COFFSET) of STREAM
|
||||
with 0)
|
||||
(COND
|
||||
(SUBSTREAM
|
||||
(* ;
|
||||
"There is a stream below this one, to feed chars upward.")
|
||||
(\SETUPGETCH 1 (fetch (TEXTSTREAM
|
||||
TEXTOBJ)
|
||||
of SUBSTREAM))
|
||||
(freplace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM
|
||||
with (fetch (PIECE PLEN)
|
||||
of PC))
|
||||
(freplace (STREAM CPAGE)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTCH)
|
||||
of STREAM with 0)
|
||||
(freplace (TEXTSTREAM PCSTARTPG)
|
||||
of STREAM with 0)
|
||||
(replace (TEXTSTREAM
|
||||
CURRENTPARALOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTPARALOOKS
|
||||
)
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS) of
|
||||
STREAM
|
||||
with (fetch (TEXTSTREAM CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT) of STREAM
|
||||
with 0)
|
||||
(RETURN PO]
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
of SUBSTREAM))
|
||||
(replace (TEXTSTREAM CURRENTLOOKS)
|
||||
of STREAM
|
||||
with (fetch (TEXTSTREAM
|
||||
CURRENTLOOKS)
|
||||
of SUBSTREAM))
|
||||
(RETURN (\BIN SUBSTREAM)))
|
||||
(T (replace (TEXTSTREAM CHARSLEFT)
|
||||
of STREAM with 0)
|
||||
(RETURN PO]
|
||||
((SETQ PS (fetch (PIECE PSTR) of PC))
|
||||
(* ; "This piece lives in a string.")
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PS)
|
||||
(\TEDIT.TEXTBIN.STRINGSETUP
|
||||
0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PS)
|
||||
|
||||
(* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.")
|
||||
|
||||
(\PEEKBIN STREAM NOERRORFLG))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
(\PEEKBIN STREAM NOERRORFLG))
|
||||
((SETQ PF (fetch (PIECE PFILE) of PC))
|
||||
(* ; "This piece lives on a file.")
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0 (fetch (PIECE PLEN)
|
||||
of PC)
|
||||
STREAM PF (fetch (PIECE PFATP) of PC)
|
||||
'PEEKBIN NOERRORFLG))
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM])
|
||||
(\TEDIT.TEXTBIN.FILESETUP PC 0
|
||||
(fetch (PIECE PLEN) of PC)
|
||||
STREAM PF (fetch (PIECE PFATP)
|
||||
of PC)
|
||||
'PEEKBIN NOERRORFLG))
|
||||
(T (ERROR "CAN'T GET TO NEXT PIECE"]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM]
|
||||
(T (* ;
|
||||
"Need to move to the next page in a file.")
|
||||
(RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG]
|
||||
(NOERRORFLG (* ;
|
||||
"There are no more pieces. Punt gracefully")
|
||||
(RETURN NIL))
|
||||
(T (* ; "He wants it the hard way.")
|
||||
(APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM)
|
||||
STREAM]
|
||||
(IF (IMAGEOBJP BYTE)
|
||||
THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM)
|
||||
'OBJECTBYTE)
|
||||
BYTE)
|
||||
ELSE BYTE])
|
||||
|
||||
(\TEDIT.PEEKBIN.NEW.PAGE
|
||||
[LAMBDA (STREAM NOERRORFLG) (* ; "Edited 11-Jun-99 15:11 by rmk:")
|
||||
@@ -2667,25 +2721,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 (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
|
||||
(FILEMAP (NIL (2992 53117 (COPYTEXTSTREAM 3002 . 6124) (OPENTEXTSTREAM 6126 . 21003) (REOPENTEXTSTREAM
|
||||
21005 . 21427) (TEDIT.STREAMCHANGEDP 21429 . 21727) (TEXTSTREAMP 21729 . 22043) (TXTFILE 22045 .
|
||||
22490) (\DELETECH 22492 . 33748) (\SETUPGETCH 33750 . 41029) (\TEDIT.REOPEN.STREAM 41031 . 42881) (
|
||||
\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 42883 . 45321) (\TEXTINIT 45323 . 51010) (\TEXTMARK 51012 . 51760) (
|
||||
\TEXTTTYBOUT 51762 . 53115)) (53118 78550 (\INSERTCH 53128 . 76854) (\INSERTCR 76856 . 78548)) (78616
|
||||
98932 (\CHTOPC 78626 . 79815) (\CHTOPCNO 79817 . 81079) (\CLEARPCTB 81081 . 81877) (
|
||||
\CREATEPIECEORSTREAM 81879 . 84853) (\DELETEPIECE 84855 . 85768) (\FINDPIECE 85770 . 86136) (
|
||||
\INSERTPIECE 86138 . 89148) (\MAKEPCTB 89150 . 91065) (\SPLITPIECE 91067 . 98026) (\INSERT.FIRST.PIECE
|
||||
98028 . 98930)) (98984 123222 (\TEXTCLOSEF 98994 . 100221) (\TEXTCLOSEF-SUBTREE 100223 . 100929) (
|
||||
\TEXTDSPFONT 100931 . 101923) (\TEXTEOFP 101925 . 103284) (\TEXTGETEOFPTR 103286 . 103496) (
|
||||
\TEXTGETFILEPTR 103498 . 105561) (\TEXTOPENF 105563 . 106393) (\TEXTOPENF-SUBTREE 106395 . 107196) (
|
||||
\TEXTOUTCHARFN 107198 . 107546) (\TEXTBACKFILEPTR 107548 . 113449) (\TEXTBOUT 113451 . 116799) (
|
||||
\TEDITOUTCCODEFN 116801 . 118067) (\TEXTSETEOF 118069 . 118578) (\TEXTSETFILEPTR 118580 . 119805) (
|
||||
\TEXTDSPXPOSITION 119807 . 120664) (\TEXTDSPYPOSITION 120666 . 121211) (\TEXTLEFTMARGIN 121213 .
|
||||
121696) (\TEXTRIGHTMARGIN 121698 . 122634) (\TEXTDSPCHARWIDTH 122636 . 122874) (\TEXTDSPSTRINGWIDTH
|
||||
122876 . 123116) (\TEXTDSPLINEFEED 123118 . 123220)) (123223 161060 (\TEXTBIN 123233 . 144112) (
|
||||
\TEDIT.TEXTBIN.STRINGSETUP 144114 . 149827) (\TEDIT.TEXTBIN.FILESETUP 149829 . 156215) (
|
||||
\TEDIT.TEXTBIN.NEW.PAGE 156217 . 161058)) (161061 176823 (\TEXTPEEKBIN 161071 . 172564) (
|
||||
\TEDIT.PEEKBIN.NEW.PAGE 172566 . 176821)) (176861 182079 (CGETTEXTPROP 176871 . 177347) (CTEXTPROP
|
||||
177349 . 179693) (GETTEXTPROP 179695 . 180290) (PUTTEXTPROP 180292 . 181617) (TEXTPROP 181619 . 182077
|
||||
)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "13-Jun-2021 09:46:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TFBRAVO.;3 74596
|
||||
|
||||
changes to%: (FNS \TFBRAVO.WRITE.RUN \TFBRAVO.WRITE.RUNS \TFBRAVO.PARSE.PARA)
|
||||
(FILECREATED "31-Jan-2022 23:28:20" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TFBRAVO.;4 74716
|
||||
|
||||
previous date%: "19-Apr-2018 12:19:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>TFBRAVO.;2)
|
||||
:CHANGES-TO (FNS TEDITFROMBRAVO)
|
||||
|
||||
:PREVIOUS-DATE "13-Jun-2021 09:46:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>TFBRAVO.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -20,7 +20,7 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(FILES (LOADCOMP)
|
||||
TEDITDCL))
|
||||
[DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(COMS (* ; "Compile-time needs")
|
||||
(COMS (* ; "Compile-time needs")
|
||||
(RECORDS FONT PARA RUN TFBRAVOPAGEFRAMES)
|
||||
(CONSTANTS (PTSPERINCH 72.27)
|
||||
(DefaultLeftMargin 2540)
|
||||
@@ -50,8 +50,8 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(SETSYNTAX (CHARCODE ^Z)
|
||||
'SEPRCHAR PROFILE.PARA.RDTBL))
|
||||
(GLOBALVARS \NAMEDTAB.IMAGEFNS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE?
|
||||
TEDITFROMBRAVO))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE?
|
||||
TEDITFROMBRAVO))
|
||||
(\NAMEDTAB.INIT])
|
||||
|
||||
(FILESLOAD TEDITDCL)
|
||||
@@ -732,22 +732,22 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
MARGIN.CANDIDATE])
|
||||
|
||||
(TEDITFROMBRAVO
|
||||
[LAMBDA (FILIN USER.CM TEXTSTREAM) (* ; "Edited 13-Jun-90 01:00 by mitani")
|
||||
[LAMBDA (FILIN USER.CM TEXTSTREAM) (* ; "Edited 31-Jan-2022 23:28 by rmk")
|
||||
(* ; "Edited 13-Jun-90 01:00 by mitani")
|
||||
|
||||
(* * Top level entry for conversion from Bravo to a Textstream which is
|
||||
returned)
|
||||
(* * Top level entry for conversion from Bravo to a Textstream which is returned)
|
||||
|
||||
(INFILE FILIN)
|
||||
(PROG (OLDPLOOKS CURRENT.PARAGRAPH USER.CM.ALIST START NEXTPARAPTR TEDITWINDOW TEXTOBJ
|
||||
(NONFEATURES NIL)
|
||||
(SMALLEST.MARGIN MAX.FIXP)
|
||||
(NEWSTREAM (OR TEXTSTREAM (OPENTEXTSTREAM "")))
|
||||
(NEWSTREAM (OR TEXTSTREAM (OPENTEXTSTREAM NIL)))
|
||||
USER.CM.PARALOOKS USER.CM.CHARLOOKS)
|
||||
(DECLARE (SPECVARS NOUT))
|
||||
(SETQ TEXTOBJ (TEXTOBJ NEWSTREAM))
|
||||
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
|
||||
(* read the user.cm file and produce
|
||||
the alist of default values)
|
||||
(* read the user.cm file and produce
|
||||
the alist of default values)
|
||||
(CLOSEF? USER.CM)
|
||||
(SETQ OLDPLOOKS (SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST)))
|
||||
(SETQ USER.CM.CHARLOOKS (\TFBRAVO.INIT.CHARLOOKS))
|
||||
@@ -757,17 +757,17 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN))
|
||||
while (fetch RUNS of CURRENT.PARAGRAPH)
|
||||
do (SETQ NEXTPARAPTR (GETFILEPTR FILIN))
|
||||
(SETFILEPTR FILIN START)
|
||||
(SETQ SMALLEST.MARGIN (\TFBRAVO.WRITE.PARAGRAPH CURRENT.PARAGRAPH
|
||||
FILIN TEXTOBJ SMALLEST.MARGIN))
|
||||
(SETFILEPTR FILIN NEXTPARAPTR)
|
||||
(SETQ OLDPLOOKS (fetch PARALOOKS of CURRENT.PARAGRAPH))
|
||||
(SETQ START (GETFILEPTR FILIN))
|
||||
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN))
|
||||
finally (* (\SHIFT.DOCUMENT
|
||||
(fetch (TEXTOBJ PCTB) of TEXTOBJ)
|
||||
(MINUS SMALLEST.MARGIN)))
|
||||
NIL))
|
||||
(SETFILEPTR FILIN START)
|
||||
(SETQ SMALLEST.MARGIN (\TFBRAVO.WRITE.PARAGRAPH CURRENT.PARAGRAPH FILIN
|
||||
TEXTOBJ SMALLEST.MARGIN))
|
||||
(SETFILEPTR FILIN NEXTPARAPTR)
|
||||
(SETQ OLDPLOOKS (fetch PARALOOKS of CURRENT.PARAGRAPH))
|
||||
(SETQ START (GETFILEPTR FILIN))
|
||||
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN)) finally
|
||||
(* (\SHIFT.DOCUMENT (fetch
|
||||
(TEXTOBJ PCTB) of TEXTOBJ)
|
||||
(MINUS SMALLEST.MARGIN)))
|
||||
NIL))
|
||||
(CLOSEF (INPUT))
|
||||
(\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
|
||||
(RETURN NEWSTREAM])
|
||||
@@ -1327,19 +1327,19 @@ Copyright (c) 1984-1987, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS TFBRAVO COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990 1991 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4259 34161 (\TFBRAVO.FIND.LAST.TRAILER 4269 . 5762) (\TFBRAVO.HANDLE.HEADING 5764 .
|
||||
7642) (\TFBRAVO.INIT.CHARLOOKS 7644 . 8460) (\TFBRAVO.INIT.PAGEFORMAT 8462 . 8940) (
|
||||
\TFBRAVO.INSTALL.PAGEFORMAT 8942 . 13579) (\TFBRAVO.PARSE.PROFILE.PARA 13581 . 22094) (
|
||||
\TFBRAVO.PARSE.PROFILE.VALUE 22096 . 22863) (\TFBRAVO.GET.FONTSIZE 22865 . 23181) (
|
||||
\TFBRAVO.GET.FONTSTYLE 23183 . 23511) (\TFBRAVO.WRITE.RUN 23513 . 24646) (\TFBRAVO.ASSERT 24648 .
|
||||
24960) (\SHIFT.DOCUMENT 24962 . 28838) (\TEDIT.BRAVOFILE? 28840 . 30887) (\TEST.CHARACTER.LOOKS 30889
|
||||
. 32529) (\TEST.PARAGRAPH.LOOKS 32531 . 34159)) (34162 37709 (\TFBRAVO.COPY.NAMEDTAB 34172 . 34531) (
|
||||
\TFBRAVO.PUT.NAMEDTAB 34533 . 34829) (\TFBRAVO.GET.NAMEDTAB 34831 . 35108) (\TFBRAVO.ADD.NAMEDTAB
|
||||
35110 . 36087) (\NAMEDTABNYET 36089 . 36254) (\NAMEDTABSIZE 36256 . 37141) (\NAMEDTAB.INIT 37143 .
|
||||
37707)) (37710 73994 (\TFBRAVO.APPLY.PARALOOKS 37720 . 38751) (TEDITFROMBRAVO 38753 . 41155) (
|
||||
\TFBRAVO.WRITE.PARAGRAPH 41157 . 42179) (\TFBRAVO.WRITE.RUNS 42181 . 42950) (\TFBRAVO.SPREAD.LOOKS
|
||||
42952 . 45924) (\TFBRAVO.PARSE.PARA 45926 . 47923) (\TFBRAVO.INIT.PARALOOKS 47925 . 51249) (
|
||||
\TFBRAVO.READ.PARALOOKS 51251 . 58427) (\TFBRAVO.READ.CHARLOOKS 58429 . 66562) (\TFBRAVO.READ.USER.CM
|
||||
66564 . 69894) (\TFBRAVO.GETPARAMS 69896 . 70725) (\TFBRAVO.PARAMNAMEP 70727 . 71175) (\TFBRAVO.EOLS
|
||||
71177 . 71590) (\TFBRAVO.LCASER 71592 . 72144) (\TFBRAVO.FONT.FROM.CHARLOOKS 72146 . 73992)))))
|
||||
(FILEMAP (NIL (4213 34115 (\TFBRAVO.FIND.LAST.TRAILER 4223 . 5716) (\TFBRAVO.HANDLE.HEADING 5718 .
|
||||
7596) (\TFBRAVO.INIT.CHARLOOKS 7598 . 8414) (\TFBRAVO.INIT.PAGEFORMAT 8416 . 8894) (
|
||||
\TFBRAVO.INSTALL.PAGEFORMAT 8896 . 13533) (\TFBRAVO.PARSE.PROFILE.PARA 13535 . 22048) (
|
||||
\TFBRAVO.PARSE.PROFILE.VALUE 22050 . 22817) (\TFBRAVO.GET.FONTSIZE 22819 . 23135) (
|
||||
\TFBRAVO.GET.FONTSTYLE 23137 . 23465) (\TFBRAVO.WRITE.RUN 23467 . 24600) (\TFBRAVO.ASSERT 24602 .
|
||||
24914) (\SHIFT.DOCUMENT 24916 . 28792) (\TEDIT.BRAVOFILE? 28794 . 30841) (\TEST.CHARACTER.LOOKS 30843
|
||||
. 32483) (\TEST.PARAGRAPH.LOOKS 32485 . 34113)) (34116 37663 (\TFBRAVO.COPY.NAMEDTAB 34126 . 34485) (
|
||||
\TFBRAVO.PUT.NAMEDTAB 34487 . 34783) (\TFBRAVO.GET.NAMEDTAB 34785 . 35062) (\TFBRAVO.ADD.NAMEDTAB
|
||||
35064 . 36041) (\NAMEDTABNYET 36043 . 36208) (\NAMEDTABSIZE 36210 . 37095) (\NAMEDTAB.INIT 37097 .
|
||||
37661)) (37664 74114 (\TFBRAVO.APPLY.PARALOOKS 37674 . 38705) (TEDITFROMBRAVO 38707 . 41275) (
|
||||
\TFBRAVO.WRITE.PARAGRAPH 41277 . 42299) (\TFBRAVO.WRITE.RUNS 42301 . 43070) (\TFBRAVO.SPREAD.LOOKS
|
||||
43072 . 46044) (\TFBRAVO.PARSE.PARA 46046 . 48043) (\TFBRAVO.INIT.PARALOOKS 48045 . 51369) (
|
||||
\TFBRAVO.READ.PARALOOKS 51371 . 58547) (\TFBRAVO.READ.CHARLOOKS 58549 . 66682) (\TFBRAVO.READ.USER.CM
|
||||
66684 . 70014) (\TFBRAVO.GETPARAMS 70016 . 70845) (\TFBRAVO.PARAMNAMEP 70847 . 71295) (\TFBRAVO.EOLS
|
||||
71297 . 71710) (\TFBRAVO.LCASER 71712 . 72264) (\TFBRAVO.FONT.FROM.CHARLOOKS 72266 . 74112)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,20 +1,20 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "21-Aug-90 09:16:22" {DSK}/lisp/ice/lyric/CALENDAR.;4 175016
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS DOREMINDER CIRCLETODAY DAYSIN PRINTMONTH SHOWMOON MDMENUITEMREGION
|
||||
SHOWREMSINMONTH WEEKOF CALLOADFILE)
|
||||
(VARS CALENDARCOMS)
|
||||
(FILECREATED " 1-Feb-2022 17:14:32" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>CALENDAR.;2 173369
|
||||
|
||||
previous date%: "21-Feb-90 15:20:05" {DSK}/lisp/ice/lyric/CALENDAR.;2)
|
||||
:CHANGES-TO (FNS CALTEDITSTRING)
|
||||
|
||||
:PREVIOUS-DATE "21-Aug-90 09:16:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>CALENDAR.;1)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved.
|
||||
(* ; "
|
||||
Copyright (c) 1985-1990 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT CALENDARCOMS)
|
||||
|
||||
(RPAQQ CALENDARCOMS
|
||||
(RPAQQ CALENDARCOMS
|
||||
((VARS (CALCIRCLEDAY)
|
||||
(CALCIRCLEMONTH)
|
||||
(CALENDARVERSION "Calendar Version 2.1")
|
||||
@@ -79,77 +79,69 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
|
||||
|
||||
(RPAQ CALENDARVERSION "Calendar Version 2.1")
|
||||
|
||||
(RPAQQ CALOPTIONSDESC (((TYPE TITLE LABEL Alert%: FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY ID CALALERTFLG LABEL Yes MESSAGE
|
||||
"Reminders will alert you when they fire.")
|
||||
(TYPE NWAY ID CALALERTFLG LABEL No MESSAGE
|
||||
"Reminders will not alert you when they fire."))
|
||||
((TYPE TITLE LABEL "Keep expired rems.:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL Yes MESSAGE
|
||||
"Expired reminders will not be deleted.")
|
||||
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
|
||||
"Reminders are deleted automatically when they fire."))
|
||||
((TYPE TITLE LABEL "Auto. file update:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Always MESSAGE
|
||||
"Update after each reminder is created.")
|
||||
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Shrink MESSAGE
|
||||
"Update only when you shrink a month window.")
|
||||
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Never MESSAGE
|
||||
"No automatic updates - use Update in day browser menu."))
|
||||
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD)
|
||||
MESSAGE
|
||||
"Default alert time offset in minutes: - for before, + for after.")
|
||||
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
|
||||
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD))
|
||||
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
|
||||
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
|
||||
SELECTEDFN CALDOOPTIONS MESSAGE
|
||||
"Puts the selected options into effect and closes this window."))
|
||||
(WINDOWPROPS TITLE "Calendar Options")))
|
||||
(RPAQQ CALOPTIONSDESC
|
||||
(((TYPE TITLE LABEL Alert%: FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY ID CALALERTFLG LABEL Yes MESSAGE "Reminders will alert you when they fire.")
|
||||
(TYPE NWAY ID CALALERTFLG LABEL No MESSAGE "Reminders will not alert you when they fire."))
|
||||
((TYPE TITLE LABEL "Keep expired rems.:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL Yes MESSAGE
|
||||
"Expired reminders will not be deleted.")
|
||||
(TYPE NWAY ID CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
|
||||
"Reminders are deleted automatically when they fire."))
|
||||
((TYPE TITLE LABEL "Auto. file update:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Always MESSAGE
|
||||
"Update after each reminder is created.")
|
||||
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Shrink MESSAGE
|
||||
"Update only when you shrink a month window.")
|
||||
(TYPE NWAY ID CALUPDATEONSHRINKFLG LABEL Never MESSAGE
|
||||
"No automatic updates - use Update in day browser menu."))
|
||||
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD)
|
||||
MESSAGE "Default alert time offset in minutes: - for before, + for after.")
|
||||
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
|
||||
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD))
|
||||
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
|
||||
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
|
||||
SELECTEDFN CALDOOPTIONS MESSAGE
|
||||
"Puts the selected options into effect and closes this window."))
|
||||
(WINDOWPROPS TITLE "Calendar Options")))
|
||||
|
||||
(RPAQQ CALOPTIONSDESCLYRIC ([(GROUP (PROPS ID ALERTGROUP)
|
||||
((TYPE DISPLAY LABEL "Alert:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY COLLECTION CALALERTFLG LABEL Yes MESSAGE
|
||||
"Reminders will alert you when they fire.")
|
||||
(TYPE NWAY COLLECTION CALALERTFLG LABEL No MESSAGE
|
||||
"Reminders will not alert you when they fire."]
|
||||
[(GROUP (PROPS ID XGROUP)
|
||||
((TYPE DISPLAY LABEL "Keep expired rems.:" FONT
|
||||
(HELVETICA 10 BOLD))
|
||||
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL Yes
|
||||
MESSAGE "Expired reminders will not be deleted.")
|
||||
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
|
||||
"Reminders are deleted automatically when they fire."]
|
||||
[(GROUP (PROPS ID UPGROUP)
|
||||
((TYPE DISPLAY LABEL "Auto. file update:" FONT
|
||||
(HELVETICA 10 BOLD))
|
||||
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Always
|
||||
MESSAGE "Update after each reminder is created.")
|
||||
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Shrink
|
||||
MESSAGE "Update only when you shrink a month window.")
|
||||
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Never
|
||||
MESSAGE
|
||||
"No automatic updates - use Update in day browser menu."
|
||||
]
|
||||
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD)
|
||||
MESSAGE
|
||||
"Default alert time offset in minutes: - for before, + for after."
|
||||
)
|
||||
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
|
||||
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD))
|
||||
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
|
||||
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
|
||||
SELECTEDFN CALDOOPTIONS MESSAGE
|
||||
"Puts the selected options into effect and closes this window."
|
||||
))))
|
||||
(RPAQQ CALOPTIONSDESCLYRIC
|
||||
([(GROUP (PROPS ID ALERTGROUP)
|
||||
((TYPE DISPLAY LABEL "Alert:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY COLLECTION CALALERTFLG LABEL Yes MESSAGE
|
||||
"Reminders will alert you when they fire.")
|
||||
(TYPE NWAY COLLECTION CALALERTFLG LABEL No MESSAGE
|
||||
"Reminders will not alert you when they fire."]
|
||||
[(GROUP (PROPS ID XGROUP)
|
||||
((TYPE DISPLAY LABEL "Keep expired rems.:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL Yes MESSAGE
|
||||
"Expired reminders will not be deleted.")
|
||||
(TYPE NWAY COLLECTION CALKEEPEXPIREDREMSFLG LABEL No MESSAGE
|
||||
"Reminders are deleted automatically when they fire."]
|
||||
[(GROUP (PROPS ID UPGROUP)
|
||||
((TYPE DISPLAY LABEL "Auto. file update:" FONT (HELVETICA 10 BOLD))
|
||||
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Always MESSAGE
|
||||
"Update after each reminder is created.")
|
||||
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Shrink MESSAGE
|
||||
"Update only when you shrink a month window.")
|
||||
(TYPE NWAY COLLECTION CALUPDATEONSHRINKFLG LABEL Never MESSAGE
|
||||
"No automatic updates - use Update in day browser menu."]
|
||||
((TYPE EDITSTART LABEL "Alert delta:" ITEMS (CALDEFAULTALERTDELTA)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD)
|
||||
MESSAGE "Default alert time offset in minutes: - for before, + for after.")
|
||||
(TYPE EDIT ID CALDEFAULTALERTDELTA LABEL 0))
|
||||
((TYPE EDITSTART LABEL "Host & dir.:" ITEMS (CALDEFAULTHOST&DIR)
|
||||
FONT
|
||||
(HELVETICA 10 BOLD))
|
||||
(TYPE EDIT ID CALDEFAULTHOST&DIR LABEL ""))
|
||||
((TYPE MOMENTARY LABEL Apply! FONT (HELVETICA 10 BOLD)
|
||||
SELECTEDFN CALDOOPTIONS MESSAGE
|
||||
"Puts the selected options into effect and closes this window."))))
|
||||
|
||||
(RPAQQ LAFITE.AFTER.GETMAIL.FN CALPEEKNEWMAIL)
|
||||
|
||||
@@ -210,7 +202,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
|
||||
(RPAQ? CALTEDITWINDOW )
|
||||
|
||||
(RPAQ? CALTUNE '((750 . 20000)
|
||||
(650 . 20000)))
|
||||
(650 . 20000)))
|
||||
|
||||
(RPAQ? CALUPDATEONSHRINKFLG 'Never)
|
||||
|
||||
@@ -1126,7 +1118,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
|
||||
'Abort])
|
||||
|
||||
(CALTEDITSTRING
|
||||
[LAMBDA (STRING M D YR) (* ; "Edited 14-Oct-88 12:48 by MJD")
|
||||
[LAMBDA (STRING M D YR) (* ; "Edited 1-Feb-2022 17:13 by rmk")
|
||||
(* ; "Edited 14-Oct-88 12:48 by MJD")
|
||||
(* T.Bigham "12-Nov-84 11:03")
|
||||
|
||||
(* ;; "this may not be needed in Carol. In harmony, this makes tedit put the value into the item editor without the confirmation that always pops up when changes have been made without saving the file.")
|
||||
@@ -1136,47 +1129,49 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
|
||||
STREAM)
|
||||
(if (NOT (WINDOWP CALTEDITWINDOW))
|
||||
then (SETQ CALTEDITWINDOW (CREATEW CALREMCREATEREGION "" NIL T))
|
||||
(ATTACHMENU (create MENU
|
||||
ITEMS _ '(Save Abort)
|
||||
ITEMWIDTH _ 199
|
||||
CENTERFLG _ T
|
||||
MENUROWS _ 1
|
||||
MENUFONT _ (FONTCREATE 'HELVETICA 12 'BOLD)
|
||||
MENUBORDERSIZE _ 1
|
||||
WHENSELECTEDFN _ 'CALTEDITEXIT)
|
||||
CALTEDITWINDOW
|
||||
'TOP
|
||||
'LEFT))
|
||||
(ATTACHMENU (create MENU
|
||||
ITEMS _ '(Save Abort)
|
||||
ITEMWIDTH _ 199
|
||||
CENTERFLG _ T
|
||||
MENUROWS _ 1
|
||||
MENUFONT _ (FONTCREATE 'HELVETICA 12 'BOLD)
|
||||
MENUBORDERSIZE _ 1
|
||||
WHENSELECTEDFN _ 'CALTEDITEXIT)
|
||||
CALTEDITWINDOW
|
||||
'TOP
|
||||
'LEFT))
|
||||
(WINDOWPROP CALTEDITWINDOW 'TITLE (CONCAT "Calendar message editor for "
|
||||
(MKSTRING (MONTHNAME M))
|
||||
" " D ", " (MKSTRING YR)))
|
||||
(RETURN (EVAL.IN.TTY.PROCESS
|
||||
`(PROGN [SETQ STREAM (OPENTEXTSTREAM
|
||||
(OR %, STRING (CONCAT "Date: "
|
||||
(GDATE (\PACKDATE ,YR
|
||||
(SUB1 ,M)
|
||||
,D 0 0 0)
|
||||
(DATEFORMAT NO.TIME))
|
||||
(CHARACTER 13)
|
||||
"Title: >>One line<<"
|
||||
(CHARACTER 13)
|
||||
"Event time: >>Time<<"
|
||||
(CHARACTER 13)
|
||||
"Alert time: >>Time<<"
|
||||
(CHARACTER 9)
|
||||
"Alert: >>Yes No<<"
|
||||
(CHARACTER 13)
|
||||
"Duration: >>hh:mm<<"
|
||||
(CHARACTER 13)
|
||||
"Message: >>Any text<<"))
|
||||
NIL NIL NIL '(QUITFN T]
|
||||
(TEDIT.SETSEL STREAM 24 12 NIL T)
|
||||
(SPAWN.MOUSE)
|
||||
[SETQ RESULT (TEDIT STREAM CALTEDITWINDOW T '(QUITFN T]
|
||||
(IF (EQ RESULT 'Abort)
|
||||
THEN NIL
|
||||
ELSE STREAM))
|
||||
T])
|
||||
(RETURN
|
||||
(EVAL.IN.TTY.PROCESS
|
||||
`(PROGN [SETQ STREAM (OPENTEXTSTREAM
|
||||
(OPENSTRINGSTREAM (OR ,STRING
|
||||
(CONCAT "Date: "
|
||||
(GDATE (\PACKDATE ,YR
|
||||
(SUB1 ,M)
|
||||
,D 0 0 0)
|
||||
(DATEFORMAT NO.TIME))
|
||||
(CHARACTER 13)
|
||||
"Title: >>One line<<"
|
||||
(CHARACTER 13)
|
||||
"Event time: >>Time<<"
|
||||
(CHARACTER 13)
|
||||
"Alert time: >>Time<<"
|
||||
(CHARACTER 9)
|
||||
"Alert: >>Yes No<<"
|
||||
(CHARACTER 13)
|
||||
"Duration: >>hh:mm<<"
|
||||
(CHARACTER 13)
|
||||
"Message: >>Any text<<")))
|
||||
NIL NIL NIL '(QUITFN T]
|
||||
(TEDIT.SETSEL STREAM 24 12 NIL T)
|
||||
(SPAWN.MOUSE)
|
||||
[SETQ RESULT (TEDIT STREAM CALTEDITWINDOW T '(QUITFN T]
|
||||
(IF (EQ RESULT 'Abort)
|
||||
THEN NIL
|
||||
ELSE STREAM))
|
||||
T])
|
||||
|
||||
(CALUPDATEFILE
|
||||
[LAMBDA (FILE) (* ; "Edited 24-Oct-88 16:09 by MJD")
|
||||
@@ -3049,28 +3044,28 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All righ
|
||||
FREEMENU TABLEBROWSER)
|
||||
(PUTPROPS CALENDAR COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10435 169896 (CALADDEVENT 10445 . 17549) (CALCREATEREM 17551 . 20144) (CALDELETEREM
|
||||
20146 . 23056) (CALDISPEVENT 23058 . 31241) (CALDOOPTIONS 31243 . 33026) (CALENDAR 33028 . 36102) (
|
||||
CALENDARWATCHER 36104 . 36381) (CALEXTENDSEL 36383 . 38331) (CALLOADFILE 38333 . 48175) (CALMAKEKEY
|
||||
48177 . 48378) (CALMONTHBEF 48380 . 49473) (CALMONTHICONFN 49475 . 49982) (CALMONTHRBF 49984 . 50776)
|
||||
(CALOPTIONMENU 50778 . 53033) (CALPEEKNEWMAIL 53035 . 56226) (CALPRINTREM 56228 . 57846) (CALREMDEF
|
||||
57848 . 58089) (CALTBCLOSEFN 58091 . 58493) (CALTBCOPYFN 58495 . 60863) (CALTBNULLFN 60865 . 61091) (
|
||||
CALTBSELECTEDFN 61093 . 61490) (CALTEDITEXIT 61492 . 61785) (CALTEDITSTRING 61787 . 65215) (
|
||||
CALUPDATEFILE 65217 . 72172) (CALUPDATEINIT 72174 . 75543) (CALYEARICONFN 75545 . 76028) (
|
||||
CALYEARINRANGE 76030 . 76304) (CIRCLETODAY 76306 . 79783) (CLEARDAY 79785 . 81308) (CLOSEMONTH 81310
|
||||
. 81879) (DAYABBR 81881 . 82143) (DAYNAME 82145 . 82338) (DAYOF 82340 . 83372) (DAYPLUS 83374 . 83671
|
||||
) (DAYSIN 83673 . 84505) (DERIVENEWDATE 84507 . 88246) (DOREMINDER 88248 . 92582) (FMNWAYITEM 92584 .
|
||||
92985) (GETREMDEF 92987 . 93299) (INVERTGROUP 93301 . 93569) (LISPDATEDAY 93571 . 93849) (
|
||||
LISPDATEMONTH 93851 . 93999) (LISPDATEYEAR 94001 . 94365) (MDMENUITEMREGION 94367 . 94831) (MENUITEM
|
||||
94833 . 95024) (MENUREGIONITEM 95026 . 95394) (MONTHABBR 95396 . 95573) (MONTHNAME 95575 . 95814) (
|
||||
MONTHNUM 95816 . 96022) (MONTHOFDAYPLUS 96024 . 96252) (MONTHPLUS 96254 . 96559) (MONTHYEARPLUS 96561
|
||||
. 96849) (NEWPARSETIME 96851 . 102502) (NEXTMDISPLAYREGION 102504 . 105075) (PACKDATE 105077 . 105792
|
||||
) (PARSETIME 105794 . 106921) (PICKFONTSIZE 106923 . 107577) (POM 107579 . 110233) (POMDAYS 110235 .
|
||||
111576) (PRINTMONTH 111578 . 115444) (REMINDERSOF 115446 . 116364) (REMINDERTIME 116366 . 116608) (
|
||||
REMINDERTIMELT 116610 . 117309) (REMSINMONTH 117311 . 117500) (REPAINTMONTH 117502 . 117904) (
|
||||
REPAINTYEAR 117906 . 118236) (SAMEDAYAS 118238 . 118641) (SAMEMONTHAS 118643 . 118928) (SCALEBITMAP
|
||||
118930 . 127982) (SHOWDAY 127984 . 136230) (SHOWMONTH 136232 . 156310) (SHOWMONTHSMALL 156312 . 157448
|
||||
) (SHOWMOON 157450 . 160389) (SHOWREMSINDAY 160391 . 161881) (SHOWREMSINMONTH 161883 . 164333) (
|
||||
SHOWYEAR 164335 . 167849) (SHRINKMONTH 167851 . 168277) (SHRINKYEAR 168279 . 168808) (TIMEDREMP 168810
|
||||
. 168934) (TPLUS 168936 . 169470) (WEEKOF 169472 . 169726) (YNCONVERT 169728 . 169894)))))
|
||||
(FILEMAP (NIL (8660 168249 (CALADDEVENT 8670 . 15774) (CALCREATEREM 15776 . 18369) (CALDELETEREM 18371
|
||||
. 21281) (CALDISPEVENT 21283 . 29466) (CALDOOPTIONS 29468 . 31251) (CALENDAR 31253 . 34327) (
|
||||
CALENDARWATCHER 34329 . 34606) (CALEXTENDSEL 34608 . 36556) (CALLOADFILE 36558 . 46400) (CALMAKEKEY
|
||||
46402 . 46603) (CALMONTHBEF 46605 . 47698) (CALMONTHICONFN 47700 . 48207) (CALMONTHRBF 48209 . 49001)
|
||||
(CALOPTIONMENU 49003 . 51258) (CALPEEKNEWMAIL 51260 . 54451) (CALPRINTREM 54453 . 56071) (CALREMDEF
|
||||
56073 . 56314) (CALTBCLOSEFN 56316 . 56718) (CALTBCOPYFN 56720 . 59088) (CALTBNULLFN 59090 . 59316) (
|
||||
CALTBSELECTEDFN 59318 . 59715) (CALTEDITEXIT 59717 . 60010) (CALTEDITSTRING 60012 . 63568) (
|
||||
CALUPDATEFILE 63570 . 70525) (CALUPDATEINIT 70527 . 73896) (CALYEARICONFN 73898 . 74381) (
|
||||
CALYEARINRANGE 74383 . 74657) (CIRCLETODAY 74659 . 78136) (CLEARDAY 78138 . 79661) (CLOSEMONTH 79663
|
||||
. 80232) (DAYABBR 80234 . 80496) (DAYNAME 80498 . 80691) (DAYOF 80693 . 81725) (DAYPLUS 81727 . 82024
|
||||
) (DAYSIN 82026 . 82858) (DERIVENEWDATE 82860 . 86599) (DOREMINDER 86601 . 90935) (FMNWAYITEM 90937 .
|
||||
91338) (GETREMDEF 91340 . 91652) (INVERTGROUP 91654 . 91922) (LISPDATEDAY 91924 . 92202) (
|
||||
LISPDATEMONTH 92204 . 92352) (LISPDATEYEAR 92354 . 92718) (MDMENUITEMREGION 92720 . 93184) (MENUITEM
|
||||
93186 . 93377) (MENUREGIONITEM 93379 . 93747) (MONTHABBR 93749 . 93926) (MONTHNAME 93928 . 94167) (
|
||||
MONTHNUM 94169 . 94375) (MONTHOFDAYPLUS 94377 . 94605) (MONTHPLUS 94607 . 94912) (MONTHYEARPLUS 94914
|
||||
. 95202) (NEWPARSETIME 95204 . 100855) (NEXTMDISPLAYREGION 100857 . 103428) (PACKDATE 103430 . 104145
|
||||
) (PARSETIME 104147 . 105274) (PICKFONTSIZE 105276 . 105930) (POM 105932 . 108586) (POMDAYS 108588 .
|
||||
109929) (PRINTMONTH 109931 . 113797) (REMINDERSOF 113799 . 114717) (REMINDERTIME 114719 . 114961) (
|
||||
REMINDERTIMELT 114963 . 115662) (REMSINMONTH 115664 . 115853) (REPAINTMONTH 115855 . 116257) (
|
||||
REPAINTYEAR 116259 . 116589) (SAMEDAYAS 116591 . 116994) (SAMEMONTHAS 116996 . 117281) (SCALEBITMAP
|
||||
117283 . 126335) (SHOWDAY 126337 . 134583) (SHOWMONTH 134585 . 154663) (SHOWMONTHSMALL 154665 . 155801
|
||||
) (SHOWMOON 155803 . 158742) (SHOWREMSINDAY 158744 . 160234) (SHOWREMSINMONTH 160236 . 162686) (
|
||||
SHOWYEAR 162688 . 166202) (SHRINKMONTH 166204 . 166630) (SHRINKYEAR 166632 . 167161) (TIMEDREMP 167163
|
||||
. 167287) (TPLUS 167289 . 167823) (WEEKOF 167825 . 168079) (YNCONVERT 168081 . 168247)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,43 +1,71 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 5-Sep-2020 19:02:30"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPARESOURCES.;3 20197
|
||||
|
||||
changes to%: (FNS \CS.COMPARE.MASTERS)
|
||||
(FILECREATED "28-Jan-2022 18:22:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;118 41270
|
||||
|
||||
previous date%: "19-Apr-2018 10:50:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPARESOURCES.;2)
|
||||
:CHANGES-TO (FNS CSOBJ.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "28-Jan-2022 17:12:39"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>COMPARESOURCES.;116)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT COMPARESOURCESCOMS)
|
||||
|
||||
(RPAQQ COMPARESOURCESCOMS
|
||||
((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.SORT.DECLARES \CS.SORT.DECLARE1
|
||||
\CS.FILTER.GARBAGE)
|
||||
(FNS \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM \CS.ISRECFORM \CS.ISCOURIERFORM
|
||||
\CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM \CS.PROP.NAME \CS.COMPARE.PROPS
|
||||
\CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS)
|
||||
((FNS COMPARESOURCES \CS.COMPARE.MASTERS \CS.COMPARE.TYPES \CS.EXAMINE \CS.FIXFNS
|
||||
\CS.SORT.DECLARES \CS.SORT.DECLARE1 \CS.FILTER.GARBAGE)
|
||||
(FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM
|
||||
\CS.ISRECFORM \CS.ISCOURIERFORM \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM
|
||||
\CS.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS \CS.ISFPKGCOMFORM
|
||||
\CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO)
|
||||
[COMS (FNS CSOBJ.CREATE CSOBJ.DISPLAYFN CSOBJ.IMAGEBOXFN CSOBJ.BUTTONEVENTINFN
|
||||
CSOBJ.COPYBUTTONEVENTINFN)
|
||||
(INITVARS (COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN
|
||||
NIL NIL NIL 'CSOBJ.BUTTONEVENTINFN
|
||||
'CSOBJ.COPYBUTTONEVENTINFN]
|
||||
(VARS COMPARESOURCETYPES DEFAULT.DECLARE.TAGS)
|
||||
(COMS (FNS CSBROWSER)
|
||||
(INITVARS (COMPARESOURCES-BROWSER-TYPE 'OBJECTWINDOW))
|
||||
(FILES (SYSLOAD)
|
||||
OBJECTWINDOW EXAMINEDEFS REGIONMANAGER))
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CSTYPE)
|
||||
(GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS DEFAULT.DECLARE.TAGS))))
|
||||
(DEFINEQ
|
||||
|
||||
(COMPARESOURCES
|
||||
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 19-Apr-2018 10:49 by rmk:")
|
||||
[LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM) (* ; "Edited 28-Jan-2022 17:10 by rmk")
|
||||
(* ; "Edited 26-Dec-2021 21:32 by rmk")
|
||||
(* ; "Edited 19-Apr-2018 10:49 by rmk:")
|
||||
|
||||
(* ;;; "Compare two lisp source files, reporting differences.")
|
||||
(* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream")
|
||||
|
||||
(DECLARE (SPECVARS FILEX FILEY EXAMINE DIFFERENCES))
|
||||
(PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY)
|
||||
[SETQ FILEX (OR (FINDFILE FILEX T)
|
||||
(RETURN (printout LISTSTREAM FILEX " not found" T]
|
||||
[SETQ FILEY (OR (FINDFILE FILEY T)
|
||||
(RETURN (printout LISTSTREAM FILEY " not found" T]
|
||||
(PROG (DIFFERENCES BODYX BODYY ENVX ENVY DECLAREX DECLAREY DATECOL
|
||||
[INSERTOBJECTS (AND EXAMINE (IF (TEXTSTREAMP LISTSTREAM)
|
||||
THEN 'TEDIT
|
||||
ELSEIF (OBJWINDOWP LISTSTREAM)
|
||||
THEN 'OBJECTWINDOW]
|
||||
(COMPARESTREAM LISTSTREAM)
|
||||
(CONTEXTSTREAM LISTSTREAM)
|
||||
OBJECTS)
|
||||
(DECLARE (SPECVARS INSERTOBJECTS OBJECTABLE))
|
||||
(CL:WHEN INSERTOBJECTS
|
||||
(SETQ COMPARESTREAM (CL:MAKE-STRING-OUTPUT-STREAM))
|
||||
(SETQ CONTEXTSTREAM (CL:MAKE-STRING-OUTPUT-STREAM))
|
||||
(LINELENGTH 65535 COMPARESTREAM) (* ; "Let the receiver do the wrapping")
|
||||
(LINELENGTH 65535 CONTEXTSTREAM))
|
||||
(OR (INFILEP FILEX)
|
||||
(SETQ FILEX (FINDFILE FILEX T))
|
||||
(RETURN (printout CONTEXTSTREAM FILEX " not found" T)))
|
||||
(OR (INFILEP FILEY)
|
||||
(SETQ FILEY (FINDFILE FILEY T))
|
||||
(RETURN (printout CONTEXTSTREAM FILEY " not found" T)))
|
||||
|
||||
(* ;; "Read the two files, throwing out extraneous forms & such:")
|
||||
(* ;; "Read the two files, throwing out extraneous forms & such:")
|
||||
|
||||
(CL:MULTIPLE-VALUE-SETQ (BODYX ENVX)
|
||||
(READFILE FILEX))
|
||||
@@ -45,186 +73,324 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ
|
||||
(CL:MULTIPLE-VALUE-SETQ (BODYY ENVY)
|
||||
(READFILE FILEY))
|
||||
(SETQ BODYY (\CS.FILTER.GARBAGE BODYY))
|
||||
(printout LISTSTREAM "Comparing " FILEX " dated " (GETFILEINFO FILEX 'CREATIONDATE)
|
||||
" and " FILEY " dated " (GETFILEINFO FILEY 'CREATIONDATE)
|
||||
":" T T)
|
||||
[SETQ DATECOL (PLUS 2 (CONSTANT (NCHARS "Comparing"))
|
||||
(IMAX (NCHARS FILEX)
|
||||
(NCHARS FILEY]
|
||||
(printout CONTEXTSTREAM "Comparing " FILEX .TAB0 DATECOL "dated " (GETFILEINFO FILEX
|
||||
'CREATIONDATE)
|
||||
.TAB
|
||||
[SUB1 (CONSTANT (IDIFFERENCE (NCHARS "Comparing ")
|
||||
(NCHARS "and "]
|
||||
" and " FILEY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE)
|
||||
T T)
|
||||
[SETQ DECLAREX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR)
|
||||
'DECLARE%:]
|
||||
'DECLARE%:]
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX DECLAREX))
|
||||
[SETQ DECLAREY (for EXPR in BODYY collect EXPR when (EQ (CAR EXPR)
|
||||
'DECLARE%:]
|
||||
'DECLARE%:]
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY DECLAREY))
|
||||
(WITH-READER-ENVIRONMENT (OR ENVX ENVY (MAKE-READER-ENVIRONMENT))
|
||||
(\CS.COMPARE.MASTERS BODYX BODYY DW? LISTSTREAM)
|
||||
(\CS.COMPARE.MASTERS BODYX BODYY DW?)
|
||||
|
||||
(* ;; "Done with the non-DECLARE: expressions. Now sort what's left according to when it is eval'ed so that we can hopefully further reduce the amount of stuff to compare")
|
||||
(* ;; "Done with the non-DECLARE: expressions. Nw sort what's left according to when it is eval'ed so that we can hopefully further reduce the amount of stuff to compare")
|
||||
|
||||
(SETQ BODYX (\CS.SORT.DECLARES DECLAREX))
|
||||
(SETQ BODYY (\CS.SORT.DECLARES DECLAREY))
|
||||
[SETQ BODYX (APPEND BODYX (for Y in BODYY collect (LIST (CAR Y))
|
||||
unless (SASSOC (CAR Y)
|
||||
BODYX]
|
||||
(* ;
|
||||
"Add placeholders for any declaration types in Y not in X to simplify what follows")
|
||||
BODYX]
|
||||
(* ;
|
||||
"Add placeholders for any declaration types in Y not in X to simplify what follows")
|
||||
[for X in BODYX bind Y TYPE
|
||||
do (SETQ Y (SASSOC (CAR X)
|
||||
BODYY))
|
||||
(SETQ TYPE (CAR X))
|
||||
[SETQ X (LDIFFERENCE (CDR X)
|
||||
(PROG1 (CDR Y)
|
||||
(SETQ Y (LDIFFERENCE (CDR Y)
|
||||
X)))]
|
||||
(COND
|
||||
((OR X Y)
|
||||
(printout LISTSTREAM T "------" [CONS 'DECLARE%: (APPEND (
|
||||
BODYY))
|
||||
(SETQ TYPE (CAR X))
|
||||
(SETQ X (CL:SET-DIFFERENCE (CDR X)
|
||||
(PROG1 (CDR Y)
|
||||
(SETQ Y (CL:SET-DIFFERENCE (CDR Y)
|
||||
X :TEST (FUNCTION EQUALALL))))
|
||||
:TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(COND
|
||||
((OR X Y)
|
||||
(printout CONTEXTSTREAM T "------" [CONS 'DECLARE%: (APPEND (
|
||||
CL:SET-DIFFERENCE
|
||||
TYPE
|
||||
DEFAULT.DECLARE.TAGS
|
||||
)
|
||||
'(--]
|
||||
" forms------" T) (* ;
|
||||
"REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order")
|
||||
(\CS.COMPARE.MASTERS (REVERSE X)
|
||||
(REVERSE Y)
|
||||
DW? LISTSTREAM]
|
||||
(TERPRI LISTSTREAM))
|
||||
" forms------" T) (* ;
|
||||
"REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order")
|
||||
(\CS.COMPARE.MASTERS (REVERSE X)
|
||||
(REVERSE Y)
|
||||
DW?]
|
||||
(TERPRI CONTEXTSTREAM))
|
||||
(SELECTQ INSERTOBJECTS
|
||||
(OBJECTWINDOW (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE (CL:GET-OUTPUT-STREAM-STRING
|
||||
CONTEXTSTREAM))))
|
||||
(SETQ OBJECTS (DREVERSE OBJECTS))
|
||||
(OBJ.ADDMANYTOW LISTSTREAM OBJECTS))
|
||||
(TEDIT (HELP "Don't know about TEDIT"))
|
||||
(NIL)
|
||||
(HELP))
|
||||
(RETURN (OR (REVERSE DIFFERENCES)
|
||||
'SAME])
|
||||
|
||||
(\CS.COMPARE.MASTERS
|
||||
[LAMBDA (BODYX BODYY DW? LISTSTREAM) (* ; "Edited 5-Sep-2020 19:01 by rmk:")
|
||||
(* ; "Edited 15-Apr-88 14:41 by bvm")
|
||||
(LET (FNSX FNSY YTHING XTHING PRED DIFS Y TMP DEFFERS)
|
||||
(DECLARE (USEDFREE DIFFERENCES))
|
||||
[SETQ FNSX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR)
|
||||
'DEFINEQ]
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX FNSX))
|
||||
(SETQ FNSX (for BOD in FNSX join (CDR BOD)))
|
||||
[SETQ FNSY (for EXPR in BODYY collect EXPR when (EQ (CAR EXPR)
|
||||
'DEFINEQ]
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY FNSY))
|
||||
(SETQ FNSY (for BOD in FNSY join (CDR BOD)))
|
||||
[COND
|
||||
((OR FNSX FNSY)
|
||||
(printout LISTSTREAM "---Functions: " T)
|
||||
[COND
|
||||
(DW? (LET ((NOSPELLFLG T))
|
||||
(DECLARE (SPECVARS NOSPELLFLG))
|
||||
(for X in FNSX when (SETQ Y (ASSOC (CAR X)
|
||||
FNSY))
|
||||
do (* ;
|
||||
"Only bother dwimifying the ones that look different")
|
||||
(DWIMIFY (CADR X)
|
||||
T)
|
||||
(DWIMIFY (CADR Y)
|
||||
T]
|
||||
(COND
|
||||
((SETQ DIFS (\CS.COMPARE.TYPES FNSX FNSY NIL [FUNCTION (LAMBDA (X Y STREAM)
|
||||
(COMPARELISTS
|
||||
(CADR X)
|
||||
(CADR Y)
|
||||
STREAM]
|
||||
(FUNCTION CAR)
|
||||
LISTSTREAM))
|
||||
(push DIFFERENCES (CONS 'FNS DIFS]
|
||||
[for TYPE in FILEPKGTYPES when (AND (CL:SYMBOLP TYPE)
|
||||
(SETQ DEFFERS (GET TYPE :DEFINED-BY)))
|
||||
[LAMBDA (BODYX BODYY DW?) (* ; "Edited 18-Jan-2022 22:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 21:05 by rmk")
|
||||
(* ; "Edited 5-Sep-2020 19:01 by rmk:")
|
||||
(* ; "Edited 15-Apr-88 14:41 by bvm")
|
||||
(DECLARE (USEDFREE DIFFERENCES COMPARESTREAM))
|
||||
(LET (YTHING XTHING PRED DIFS TMP)
|
||||
(SETQ BODYX (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODYX)) (* ;
|
||||
"We don't care about editdate comments")
|
||||
(SETQ BODYY (CL:REMOVE-IF (FUNCTION EDITDATE?)
|
||||
BODYY))
|
||||
(SETQ BODYX (\CS.FIXFNS BODYX))
|
||||
(SETQ BODYY (\CS.FIXFNS BODYY))
|
||||
(CL:WHEN (AND (SETQ XTHING (ASSOC 'DEFINE-FILE-INFO BODYX))
|
||||
(SETQ YTHING (ASSOC 'DEFINE-FILE-INFO BODYY))
|
||||
(\CS.COMPARE.DEFINE-FILE-INFO XTHING YTHING))
|
||||
(SETQ BODYX (REMOVE XTHING BODYX))
|
||||
(SETQ BODYY (REMOVE YTHING BODYY)))
|
||||
|
||||
(* ;; "These are for commonlispy definers")
|
||||
|
||||
[for TYPE DEFFERS in FILEPKGTYPES when (AND (CL:SYMBOLP TYPE)
|
||||
(SETQ DEFFERS (GET TYPE :DEFINED-BY)))
|
||||
do
|
||||
(* ;; "handle definer based things")
|
||||
|
||||
(* ;; "handle definer based things")
|
||||
(for DEFFER in DEFFERS do (SETQ XTHING (for X in BODYX collect X
|
||||
when (EQ (CAR X)
|
||||
DEFFER)))
|
||||
(SETQ YTHING (for X in BODYY collect X
|
||||
when (EQ (CAR X)
|
||||
DEFFER)))
|
||||
|
||||
(for DEFFER in DEFFERS
|
||||
do (SETQ XTHING (for X in BODYX collect X
|
||||
when (EQ (CAR X)
|
||||
DEFFER)))
|
||||
(SETQ YTHING (for X in BODYY collect X
|
||||
when (EQ (CAR X)
|
||||
DEFFER)))
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING))
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING))
|
||||
(COND
|
||||
((SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING
|
||||
(CONCAT (OR (CL:DOCUMENTATION TYPE 'DEFINE-TYPES)
|
||||
TYPE)
|
||||
" defined by " DEFFER)
|
||||
NIL
|
||||
(GET DEFFER :DEFINITION-NAME)
|
||||
LISTSTREAM))
|
||||
(COND
|
||||
((SETQ TMP (ASSOC TYPE DIFFERENCES))
|
||||
(NCONC TMP DIFS))
|
||||
(T (push DIFFERENCES (CONS TYPE DIFS]
|
||||
[for TYPE in COMPARESOURCETYPES
|
||||
do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE))
|
||||
(SETQ XTHING (for X in BODYX collect X when (CL:FUNCALL PRED X)))
|
||||
(SETQ YTHING (for X in BODYY collect X when (CL:FUNCALL PRED X)))
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING))
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING))
|
||||
(COND
|
||||
((SETQ DIFS (\CS.COMPARE.TYPES XTHING YTHING
|
||||
(OR (fetch (CSTYPE TITLE) of TYPE)
|
||||
(L-CASE (MKSTRING (fetch (CSTYPE FPKGTYPE)
|
||||
of TYPE))
|
||||
T))
|
||||
(fetch (CSTYPE COMPAREFN) of TYPE)
|
||||
(OR (fetch (CSTYPE IDFN) of TYPE)
|
||||
(FUNCTION CADR))
|
||||
LISTSTREAM))
|
||||
(SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE))
|
||||
(COND
|
||||
((SETQ TMP (ASSOC TYPE DIFFERENCES))
|
||||
(NCONC TMP DIFS))
|
||||
(T (push DIFFERENCES (CONS TYPE DIFS]
|
||||
[SETQ BODYY (LDIFFERENCE BODYY (PROG1 BODYX
|
||||
(SETQ BODYX (LDIFFERENCE BODYX BODYY)))]
|
||||
(* ;; "Take out all of the THINGS we are about to do. ")
|
||||
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(COND
|
||||
((SETQ DIFS (\CS.COMPARE.TYPES
|
||||
XTHING YTHING
|
||||
(CONCAT (OR (CL:DOCUMENTATION TYPE
|
||||
'DEFINE-TYPES)
|
||||
TYPE)
|
||||
" defined by " DEFFER)
|
||||
NIL
|
||||
(GET DEFFER :DEFINITION-NAME)))
|
||||
(COND
|
||||
((SETQ TMP (ASSOC TYPE DIFFERENCES))
|
||||
(NCONC TMP DIFS))
|
||||
(T (push DIFFERENCES (CONS TYPE DIFS]
|
||||
|
||||
(* ;; "These are for other filepkage types, as registered in COMPARESOURCETYPES")
|
||||
|
||||
[for TYPE in COMPARESOURCETYPES do (SETQ PRED (fetch (CSTYPE PREDFN) of TYPE))
|
||||
(SETQ XTHING (for X in BODYX collect X
|
||||
when (CL:FUNCALL PRED X)))
|
||||
(SETQ YTHING (for X in BODYY collect X
|
||||
when (CL:FUNCALL PRED X)))
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE BODYX XTHING :TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY YTHING :TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(COND
|
||||
([SETQ DIFS (\CS.COMPARE.TYPES
|
||||
XTHING YTHING
|
||||
(OR (fetch (CSTYPE TITLE) of TYPE)
|
||||
(MKSTRING (fetch (CSTYPE FPKGTYPE)
|
||||
of TYPE)))
|
||||
(fetch (CSTYPE COMPAREFN) of TYPE)
|
||||
(OR (fetch (CSTYPE IDFN) of TYPE)
|
||||
(FUNCTION CADR]
|
||||
(SETQ TYPE (fetch (CSTYPE FPKGTYPE) of TYPE))
|
||||
(COND
|
||||
((SETQ TMP (ASSOC TYPE DIFFERENCES))
|
||||
(NCONC TMP DIFS))
|
||||
(T (push DIFFERENCES (CONS TYPE DIFS]
|
||||
(SETQ BODYY (CL:SET-DIFFERENCE BODYY (PROG1 BODYX
|
||||
(SETQ BODYX (CL:SET-DIFFERENCE
|
||||
BODYX BODYY :TEST
|
||||
(FUNCTION EQUALALL))))
|
||||
:TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(COND
|
||||
((OR BODYX BODYY)
|
||||
(printout LISTSTREAM T "---Expressions:" T)
|
||||
(printout CONTEXTSTREAM T "---Expressions:" T)
|
||||
(LET ((COMMENTX 0)
|
||||
(COMMENTY 0)
|
||||
EXTRAS) (* ; "Remove comments")
|
||||
[SETQ BODYX (for X in BODYX collect X
|
||||
unless (COND
|
||||
((EQ (CAR X)
|
||||
COMMENTFLG)
|
||||
(add COMMENTX 1)
|
||||
T]
|
||||
[SETQ BODYY (for Y in BODYY collect Y
|
||||
unless (COND
|
||||
((EQ (CAR Y)
|
||||
COMMENTFLG)
|
||||
(add COMMENTY 1)
|
||||
T]
|
||||
(COMMENTY 0)) (* ; "Remove comments")
|
||||
[SETQ BODYX (for X in BODYX collect X unless (COND
|
||||
((EQ (CAR X)
|
||||
COMMENTFLG)
|
||||
(add COMMENTX 1)
|
||||
T]
|
||||
[SETQ BODYY (for Y in BODYY collect Y unless (COND
|
||||
((EQ (CAR Y)
|
||||
COMMENTFLG)
|
||||
(add COMMENTY 1)
|
||||
T]
|
||||
(COND
|
||||
((OR (NEQ COMMENTX 0)
|
||||
(NEQ COMMENTY 0))
|
||||
(printout LISTSTREAM .I1 COMMENTX " comments -> " .I1 COMMENTY " comments." T T
|
||||
)))
|
||||
(printout CONTEXTSTREAM .I1 COMMENTX " comments -> " .I1 COMMENTY " comments."
|
||||
T T)))
|
||||
[COND
|
||||
((SETQ EXTRAS (COND
|
||||
(BODYX (COND
|
||||
(BODYY (COMPARELISTS BODYX BODYY LISTSTREAM)
|
||||
NIL)
|
||||
(T (printout LISTSTREAM "These are not on " FILEY)
|
||||
BODYX)))
|
||||
(BODYY (printout LISTSTREAM "These are not on " FILEX)
|
||||
BODYY)))
|
||||
(printout LISTSTREAM ":" T)
|
||||
(for X in EXTRAS do (LVLPRINT X LISTSTREAM 2 3]
|
||||
[COND
|
||||
((AND (OR BODYX BODYY)
|
||||
(OR (EQ EXAMINE T)
|
||||
(EQMEMB 'MISC EXAMINE)))
|
||||
(IF (EQMEMB 2WINDOWS EXAMINE)
|
||||
THEN (EDITE BODYX)
|
||||
(EDITE BODYY)
|
||||
ELSE (EDITE (LIST BODYX BODYY]
|
||||
[BODYX (COND
|
||||
(BODYY (COMPARELISTS BODYX BODYY COMPARESTREAM)
|
||||
(\CS.EXAMINE BODYX BODYY))
|
||||
(T (printout COMPARESTREAM "These are not on File 2:" T)
|
||||
(FOR X IN BODYX DO (LVLPRINT X COMPARESTREAM 2 3)
|
||||
(\CS.EXAMINE X NIL T]
|
||||
(BODYY (printout COMPARESTREAM "These are not on File 1:" T)
|
||||
(FOR Y IN BODYY DO (LVLPRINT Y COMPARESTREAM 2 3)
|
||||
(\CS.EXAMINE NIL Y T]
|
||||
(OR (ASSOC 'Other DIFFERENCES)
|
||||
(push DIFFERENCES (LIST 'Other '--])
|
||||
|
||||
(\CS.COMPARE.TYPES
|
||||
(LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN LISTSTREAM) (DECLARE (USEDFREE FILEX FILEY EXAMINE)) (* ; "Edited 29-Dec-86 11:49 by jds") (* ;;; "Compare things using COMPAREFN. Deltas -> LISTSTREAM.") (COND ((AND (OR XTHING YTHING) (PROGN (SETQ XTHING (LDIFFERENCE XTHING (PROG1 YTHING (SETQ YTHING (LDIFFERENCE YTHING XTHING))))) (OR XTHING YTHING))) (LET (X Y RESULT NAME) (AND TITLE (printout LISTSTREAM T "---" TITLE ":" T T)) (for TAIL on XTHING do (SETQ NAME (CL:FUNCALL IDFN (SETQ X (CAR TAIL)))) (COND ((NOT (SETQ Y (find Y in YTHING suchthat (EQUAL (CL:FUNCALL IDFN Y) NAME)))) (printout LISTSTREAM |.P2| NAME " is not on " FILEY T) (COND ((OR (EQ EXAMINE T) (EQMEMB (QUOTE NEW) EXAMINE)) (EDITE X)))) (T (printout LISTSTREAM |.P2| NAME ": " T) (COND (COMPAREFN (CL:FUNCALL COMPAREFN X Y LISTSTREAM)) (T (COMPARELISTS X Y LISTSTREAM))) (TERPRI LISTSTREAM) (COND ((OR (EQ EXAMINE T) (EQMEMB (QUOTE OLD) EXAMINE)) (EDITE (LIST X Y)))) (RPLACA (FMEMB Y YTHING)))) (RPLACA TAIL) (push RESULT NAME)) (for Y in (LDIFFERENCE YTHING XTHING) do (printout LISTSTREAM |.P2| (SETQ NAME (CL:FUNCALL IDFN Y)) " is not on " FILEX T) (COND ((OR (EQ EXAMINE T) (EQMEMB (QUOTE NEW) EXAMINE)) (EDITE Y))) (push RESULT NAME)) RESULT))))
|
||||
)
|
||||
[LAMBDA (XTHING YTHING TITLE COMPAREFN IDFN) (* ; "Edited 9-Dec-2021 23:19 by rmk")
|
||||
(* ; "Edited 1-Dec-2021 23:25 by rmk:")
|
||||
(* ; "Edited 30-Nov-2021 23:07 by rmk:")
|
||||
(* ; "Edited 27-Nov-2021 12:32 by rmk:")
|
||||
(* ; "Edited 25-Nov-2021 13:29 by rmk:")
|
||||
(* ; "Edited 29-Dec-86 11:49 by jds")
|
||||
|
||||
(* ;;; "Compare things using COMPAREFN. Deltas -> COMPARESTREAM. Anything that passes the WHEN predicate has a difference somewhere, will produce some output. ")
|
||||
|
||||
(DECLARE (USEDFREE CONTEXTSTREAM COMPARESTREAM))
|
||||
(LET (X Y RESULT NAME)
|
||||
(CL:WHEN (AND (OR XTHING YTHING)
|
||||
(PROGN (SETQ XTHING (CL:SET-DIFFERENCE XTHING
|
||||
(PROG1 YTHING
|
||||
(SETQ YTHING (CL:SET-DIFFERENCE
|
||||
YTHING XTHING :TEST
|
||||
(FUNCTION EQUALALL))))
|
||||
:TEST
|
||||
(FUNCTION EQUALALL)))
|
||||
(OR XTHING YTHING)))
|
||||
DF
|
||||
|
||||
(* ;; "We know we are going to have some output. Strings can go directly onto theCONTEXTSTREAM, and objects may then be inserted.")
|
||||
|
||||
(AND TITLE (printout CONTEXTSTREAM T "---" TITLE ":" T T))
|
||||
(for TAIL on XTHING
|
||||
do [SETQ NAME (CL:FUNCALL IDFN (SETQ X (CAR TAIL]
|
||||
[COND
|
||||
([NOT (SETQ Y (find Y in YTHING suchthat (EQUAL (CL:FUNCALL IDFN Y)
|
||||
NAME]
|
||||
(printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT
|
||||
" is not on File 2" T T)
|
||||
(\CS.EXAMINE X NIL T NAME))
|
||||
(T (printout COMPARESTREAM .FONT BOLDFONT .P2 NAME ":" .FONT DEFAULTFONT T)
|
||||
(COND
|
||||
(COMPAREFN (CL:FUNCALL COMPAREFN X Y COMPARESTREAM))
|
||||
(T (COMPARELISTS X Y COMPARESTREAM)))
|
||||
(\CS.EXAMINE X Y NIL NAME)
|
||||
(RPLACA (FMEMB Y YTHING]
|
||||
(RPLACA TAIL)
|
||||
(push RESULT NAME))
|
||||
(for Y in (CL:SET-DIFFERENCE YTHING XTHING :TEST (FUNCTION EQUALALL))
|
||||
do (SETQ NAME (CL:FUNCALL IDFN Y))
|
||||
(printout COMPARESTREAM .FONT BOLDFONT .P2 NAME .FONT DEFAULTFONT
|
||||
" is not on File 1" T T)
|
||||
(\CS.EXAMINE Y NIL T NAME)
|
||||
(push RESULT NAME))
|
||||
RESULT)])
|
||||
|
||||
(\CS.EXAMINE
|
||||
[LAMBDA (X Y ONLYONE NAME TYPE) (* ; "Edited 24-Dec-2021 22:48 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 22:46 by rmk")
|
||||
(* ; "Edited 9-Dec-2021 23:23 by rmk")
|
||||
(* ; "Edited 4-Dec-2021 16:43 by rmk")
|
||||
(* ; "Edited 2-Dec-2021 15:23 by rmk:")
|
||||
(* ; "Edited 29-Nov-2021 20:37 by rmk:")
|
||||
(* ; "Edited 27-Nov-2021 11:21 by rmk:")
|
||||
(DECLARE (USEDFREE EXAMINE INSERTOBJECTS COMPARESTREAM CONTEXTSTREAM OBJECTS))
|
||||
|
||||
(* ;; "ONLYONE as a flag, because we don't want to test X or Y for NIL, that could be the contrasting value.")
|
||||
|
||||
(* ;; "I don't understand MISC: changed but otherwise unclassified. Does that mean just an unknown type?")
|
||||
|
||||
(* ;; "The only call seemed to be from \CS.COMPARE.MASTERS, where EXTRAS is set to either BODYX or BODYY if the other one is NIL. It may be that that call only happens in the MISC case.")
|
||||
|
||||
(CL:UNLESS NAME (SETQ NAME "from File"))
|
||||
|
||||
(* ;; "Context gets printed to the CONTEXTSTREAM, diffs go to the COMPARESTREAM. If we aren't doing objects, those are the same streams, and the output gets printed in the right order. Nothing to do here.")
|
||||
|
||||
(IF INSERTOBJECTS
|
||||
THEN (SELECTQ INSERTOBJECTS
|
||||
(OBJECTWINDOW [LET (STRING)
|
||||
|
||||
(* ;; "Take out last EOL, let SEPDIST space things out.")
|
||||
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM))
|
||||
(SETQ STRING (CL:GET-OUTPUT-STREAM-STRING CONTEXTSTREAM))
|
||||
(CL:WHEN (EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -1))
|
||||
(SETQ STRING (OR (SUBSTRING STRING 1 -2)
|
||||
"")))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE STRING)))
|
||||
(CL:UNLESS (EQ 0 (GETFILEPTR COMPARESTREAM))
|
||||
(SETQ STRING (CL:GET-OUTPUT-STREAM-STRING COMPARESTREAM))
|
||||
|
||||
(* ;; "Don't know why, but SEPTDIST doesn't work if there if there isn't at least one EOL. Magically, this gets the right appearance and behavior.")
|
||||
|
||||
(CL:WHEN (AND (EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -1))
|
||||
(EQ (CHARCODE EOL)
|
||||
(NTHCHARCODE STRING -2)))
|
||||
(SETQ STRING (OR (SUBSTRING STRING 1 -2)
|
||||
"")))
|
||||
(PUSH OBJECTS (CSOBJ.CREATE STRING
|
||||
(LIST NAME TYPE X Y LABEL1 LABEL2)
|
||||
ONLYONE)))])
|
||||
(TEDIT (HELP "TEDIT NOT IMPLEMENTED"))
|
||||
NIL)
|
||||
ELSEIF (OR (LISTP X)
|
||||
(LISTP Y))
|
||||
THEN (* ;
|
||||
"No point in bringing up an editor on a non-list")
|
||||
(IF ONLYONE
|
||||
THEN (IF (OR (EQMEMB T EXAMINE)
|
||||
(EQMEMB 'NEW EXAMINE))
|
||||
THEN (EDITE (OR X Y)))
|
||||
ELSEIF (OR (EQMEMB T EXAMINE)
|
||||
(EQMEMB 'OLD EXAMINE)
|
||||
(EQMEMB 'MISCC))
|
||||
THEN (IF (EQMEMB '2WINDOWS EXAMINE)
|
||||
THEN (EXAMINEDEFS X Y NAME TYPE)
|
||||
ELSE (EDITE (LIST X Y])
|
||||
|
||||
(\CS.FIXFNS
|
||||
[LAMBDA (BODY DW?) (* ; "Edited 29-Nov-2021 20:42 by rmk:")
|
||||
(* ; "Edited 26-Nov-2021 13:34 by rmk:")
|
||||
|
||||
(* ;; "RMK: Functions are special in that they are grouped under DEFINEQ and they may need dwimifying. We don't want to deal with these idiosyncracies below, so our strategy is to split each multi-fn defineq into a sequence of single-fn defineqs , one for each function, then let it fall through. After dwimifying, things should be standard.")
|
||||
|
||||
(LET (DEFINEQS FNS (NOSPELLFLG T))
|
||||
(DECLARE (SPECVARS NOSPELLFLG))
|
||||
[SETQ DEFINEQS (for EXPR in BODY collect EXPR when (EQ (CAR EXPR)
|
||||
'DEFINEQ]
|
||||
(SETQ BODY (CL:SET-DIFFERENCE BODY DEFINEQS)) (* ;
|
||||
"Remove all the multiple function defineqs, so we can pack on the exploded forms")
|
||||
[SETQ FNS (for DFQ in DEFINEQS join (FOR FN IN (CDR DFQ)
|
||||
COLLECT
|
||||
|
||||
(* ;; "FN is a single (NAME DEF) pair")
|
||||
|
||||
`(DEFINEQ (,@FN]
|
||||
(CL:WHEN DW?
|
||||
(FOR FN IN FNS DO (DWIMIFY (CADADR FN)
|
||||
T)))
|
||||
(SETQ BODY (APPEND FNS BODY])
|
||||
|
||||
(\CS.SORT.DECLARES
|
||||
(LAMBDA (DECLS) (* bvm%: "15-Nov-85 18:58") (* ;;; "Sorts DECLS, a list of (DECLARE: --) expressions, into a set of declarations by tag, returning a list of entries of the form (tags . expressions)") (LET (RESULT) (DECLARE (SPECVARS RESULT)) (for DEC in DECLS do (\CS.SORT.DECLARE1 DEC DEFAULT.DECLARE.TAGS)) RESULT))
|
||||
@@ -240,6 +406,24 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\CS.ISFNFORM
|
||||
[LAMBDA (X) (* ; "Edited 29-Nov-2021 20:34 by rmk:")
|
||||
(* ; "Edited 26-Nov-2021 13:19 by rmk:")
|
||||
(EQ 'DEFINEQ (CAR (LISTP X])
|
||||
|
||||
(\CS.COMPARE.FNS
|
||||
[LAMBDA (DQX DQY STREAM) (* ; "Edited 29-Nov-2021 20:51 by rmk:")
|
||||
|
||||
(* ;; "CADADR is the body")
|
||||
|
||||
(COMPARELISTS (CADADR DQX)
|
||||
(CADADR DQY)
|
||||
STREAM])
|
||||
|
||||
(\CS.FNSID
|
||||
[LAMBDA (DQX) (* ; "Edited 29-Nov-2021 20:50 by rmk:")
|
||||
(CAR (CADR DQX])
|
||||
|
||||
(\CS.ISVARFORM
|
||||
(LAMBDA (X) (* bvm%: "25-Sep-85 12:05") (SELECTQ (CAR X) ((RPAQ RPAQQ RPAQ?) T) NIL)))
|
||||
|
||||
@@ -290,10 +474,142 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ
|
||||
(\CS.COMPARE.FPKGCOMS
|
||||
(LAMBDA (X Y STREAM) (* ; "Edited 29-Dec-86 12:16 by jds") (* * (PUTDEF (QUOTE name) (QUOTE FILEPKGCOMS) (QUOTE stuff))) (COMPARELISTS (CADR (CADDDR X)) (CADR (CADDDR Y)) STREAM))
|
||||
)
|
||||
|
||||
(\CS.COMPARE.DEFINE-FILE-INFO
|
||||
[LAMBDA (DFI1 DFI2) (* ; "Edited 19-Dec-2021 21:02 by rmk")
|
||||
(AND (EQUAL (LISTGET :READTABLE DFI1)
|
||||
(LISTGET :READTABLE DFI2))
|
||||
(EQUAL (LISTGET :PACKAGE DFI1)
|
||||
(LISTGET :PACKAGE DFI2))
|
||||
(EQ (OR (LISTGET :BASE DFI1)
|
||||
10)
|
||||
(OR (LISTGET :BASE DFI2)
|
||||
10))
|
||||
(EQ (OR (LISTGET :FORMAT DFI1)
|
||||
*DEFAULT-EXTERNALFORMAT*)
|
||||
(OR (LISTGET :FORMAT DFI2)
|
||||
*DEFAULT-EXTERNALFORMAT*])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CSOBJ.CREATE
|
||||
[LAMBDA (STRING COMPAREDATA ONLYONE) (* ; "Edited 4-Dec-2021 09:57 by rmk")
|
||||
(* ; "Edited 1-Dec-2021 13:26 by rmk:")
|
||||
(LET ((OBJ (IMAGEOBJCREATE STRING COMPARESOURCES-IMAGEFNS)))
|
||||
(IMAGEOBJPROP OBJ 'COMPAREDATA COMPAREDATA)
|
||||
(IMAGEOBJPROP OBJ 'ONLYONE ONLYONE)
|
||||
OBJ])
|
||||
|
||||
(CSOBJ.DISPLAYFN
|
||||
[LAMBDA (OBJ WINDOW) (* ; "Edited 4-Dec-2021 08:24 by rmk")
|
||||
(* ; "Edited 1-Dec-2021 14:18 by rmk:")
|
||||
(DSPFONT DEFAULTFONT WINDOW)
|
||||
(FOR I C (FONTARRAY _ (FONTMAPARRAY))
|
||||
(STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) FROM 1
|
||||
DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
|
||||
(EOL (TERPRI WINDOW))
|
||||
(NIL (RETURN))
|
||||
(IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
|
||||
THEN (DSPFONT (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1)))
|
||||
WINDOW)
|
||||
ELSE (PRINTCCODE C WINDOW])
|
||||
|
||||
(CSOBJ.IMAGEBOXFN
|
||||
[LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 9-Dec-2021 23:02 by rmk")
|
||||
(* ; "Edited 7-Dec-2021 10:50 by rmk")
|
||||
(* ; "Edited 5-Dec-2021 23:52 by rmk")
|
||||
(* ; "Edited 4-Dec-2021 08:24 by rmk")
|
||||
(* ; "Edited 1-Dec-2021 13:27 by rmk:")
|
||||
|
||||
(* ;; "Calculate the height of each line, and the width of the widest line.")
|
||||
|
||||
(* ;;
|
||||
"Probably ought to compute the max height per line, at every font change, add it at each EOL.")
|
||||
|
||||
(SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
|
||||
(FOR I C (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
|
||||
(FONT _ (FONTCREATE DEFAULTFONT NIL NIL NIL IMAGESTREAM))
|
||||
(HEIGHT _ 0)
|
||||
(LINELENGTH _ 0)
|
||||
(MAXLINELENGTH _ 0)
|
||||
(FONTARRAY _ (FONTMAPARRAY)) FROM 1
|
||||
DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
|
||||
(EOL (ADD HEIGHT (FONTPROP FONT 'HEIGHT))
|
||||
(CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
|
||||
(SETQ MAXLINELENGTH LINELENGTH))
|
||||
(SETQ LINELENGTH 0))
|
||||
(NIL (* ; "end of string")
|
||||
(CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
|
||||
(SETQ MAXLINELENGTH LINELENGTH))
|
||||
(RETURN (CREATE IMAGEBOX
|
||||
XSIZE _ MAXLINELENGTH
|
||||
YSIZE _ HEIGHT
|
||||
YDESC _ (DIFFERENCE HEIGHT (FONTPROP FONT 'HEIGHT))
|
||||
XKERN _ 0)))
|
||||
(IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
|
||||
THEN (SETQ FONT (FONTCREATE (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1)))
|
||||
NIL NIL NIL IMAGESTREAM))
|
||||
ELSE (ADD LINELENGTH (CHARWIDTH C FONT])
|
||||
|
||||
(CSOBJ.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ WINDOW) (* ; "Edited 28-Jan-2022 18:22 by rmk")
|
||||
(* ; "Edited 25-Jan-2022 16:04 by rmk")
|
||||
(* ; "Edited 23-Jan-2022 18:11 by rmk")
|
||||
(LET
|
||||
[(COMPAREDATA (IMAGEOBJPROP OBJ 'COMPAREDATA]
|
||||
(CL:WHEN (AND COMPAREDATA (MOUSESTATE LEFT)
|
||||
(UNTILMOUSESTATE (NOT LEFT)))
|
||||
(LET
|
||||
((NAME (POP COMPAREDATA))
|
||||
(TYPE (POP COMPAREDATA))
|
||||
(DEF1 (POP COMPAREDATA))
|
||||
(DEF2 (POP COMPAREDATA))
|
||||
(TITLE1 (POP COMPAREDATA))
|
||||
(TITLE2 (CAR COMPAREDATA)))
|
||||
|
||||
(* ;; "Move the cursor to just slightly below the current object, so that the edit windows are well aligned. We have to figure out the bottom of the current object, in screen coordinates.")
|
||||
|
||||
[LET ((OBJREGION (OBJ.FIND.REGION WINDOW OBJ)))
|
||||
(\CURSORPOSITION (IPLUS 20 LASTMOUSEX)
|
||||
(IPLUS (IDIFFERENCE (FETCH (REGION BOTTOM) OF OBJREGION)
|
||||
(FETCH (REGION HEIGHT) OF OBJREGION))
|
||||
(FETCH (REGION TOP) OF (WINDOWREGION WINDOW]
|
||||
(LET
|
||||
[EWINDOW (RELPOS (RELCREATEPOSITION `(,WINDOW 0.5)
|
||||
`(,WINDOW 0 -2]
|
||||
(CLOSEWITH.DOIT WINDOW)
|
||||
(SETQ EWINDOW
|
||||
(IF (IMAGEOBJPROP OBJ 'ONLYONE)
|
||||
THEN
|
||||
[SEDIT:GET-WINDOW
|
||||
(SEDIT:SEDIT (OR DEF1 DEF2)
|
||||
`(:REGION ,(RELCREATEREGION 600 (CL:IF (ILESSP (COUNT (OR DEF1 DEF2))
|
||||
100)
|
||||
150
|
||||
400)
|
||||
(CL:IF DEF1
|
||||
'RIGHT
|
||||
'LEFT)
|
||||
'TOP RELPOS NIL T]
|
||||
ELSE (* ; "Spread the arguments")
|
||||
(EXAMINEDEFS NAME TYPE DEF1 DEF2 TITLE1 TITLE2 RELPOS)))
|
||||
(CLOSEWITH EWINDOW WINDOW)
|
||||
(MOVEWITH EWINDOW WINDOW)
|
||||
EWINDOW)))])
|
||||
|
||||
(CSOBJ.COPYBUTTONEVENTINFN
|
||||
[LAMBDA (OBJ WINDOW REGION) (* ; "Edited 3-Jan-2022 08:36 by rmk")
|
||||
(CL:WHEN (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA))
|
||||
[COPYINSERT (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA])])
|
||||
)
|
||||
|
||||
(RPAQ? COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN NIL NIL NIL
|
||||
'CSOBJ.BUTTONEVENTINFN
|
||||
'CSOBJ.COPYBUTTONEVENTINFN))
|
||||
|
||||
(RPAQQ COMPARESOURCETYPES
|
||||
((VARS \CS.ISVARFORM \CS.COMPARE.VARS)
|
||||
((FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID "FNS defined by DEFINEQ")
|
||||
(VARS \CS.ISVARFORM \CS.COMPARE.VARS)
|
||||
(MACROS \CS.ISMACROFORM)
|
||||
(RECORDS \CS.ISRECFORM)
|
||||
(PROPS \CS.ISPROPFORM \CS.COMPARE.PROPS \CS.PROP.NAME "Properties")
|
||||
@@ -303,6 +619,60 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ
|
||||
(FILEPKGCOMS \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS CADADR)))
|
||||
|
||||
(RPAQQ DEFAULT.DECLARE.TAGS (EVAL@LOAD DONTEVAL@COMPILE COPY NOTFIRST))
|
||||
(DEFINEQ
|
||||
|
||||
(CSBROWSER
|
||||
[LAMBDA (FILEX FILEY DW? LABEL1 LABEL2 REGION)
|
||||
|
||||
(* ;; "Edited 24-Jan-2022 23:11 by rmk: EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.")
|
||||
|
||||
(* ;; "If EXAMINE is non-NIL, we run the compare twice. Once to get the TEDIT up as a kind of table of contents, and the second time to run through all of the SEDIT windows.")
|
||||
|
||||
(* ;; "Returns browser window")
|
||||
|
||||
(* ;; "Don't use the INFILEP value, because that might screw with capitalization that the caller prefers. If the file can be found that way, then lower functions will find it.")
|
||||
|
||||
(DECLARE (SPECVARS LABEL1 LABEL2))
|
||||
(OR (INFILEP FILEX)
|
||||
(SETQ FILEX (FINDFILE FILEX NIL DIRECTORIES))
|
||||
(ERROR "FILE NOT FOUND" FILEX))
|
||||
(OR (INFILEP FILEY)
|
||||
(SETQ FILEY (FINDFILE FILEY NIL DIRECTORIES))
|
||||
(ERROR "FILE NOT FOUND" FILEY))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILEX)
|
||||
(ERROR FILEX " is not a Medley source file"))
|
||||
(CL:UNLESS (LISPSOURCEFILEP FILEY)
|
||||
(ERROR FILEX " is not a Medley source file"))
|
||||
(LET [(TITLE (CONCAT "COMPARESOURCES of " (OR LABEL1 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FILEX))
|
||||
" and "
|
||||
(OR LABEL2 (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY FILEY]
|
||||
(SELECTQ COMPARESOURCES-BROWSER-TYPE
|
||||
(OBJECTWINDOW (LET [(WINDOW (OBJ.CREATEW 'VERTICAL REGION TITLE NIL T
|
||||
(FONTPROP DEFAULTFONT 'HEIGHT]
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION T)
|
||||
(GETPROMPTWINDOW WINDOW T)
|
||||
(WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL)
|
||||
(COMPARESOURCES FILEX FILEY '(T 2WINDOWS)
|
||||
DW? WINDOW)
|
||||
(OPENW WINDOW)
|
||||
WINDOW))
|
||||
(TEDIT (LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? TSTREAM)
|
||||
[TEDIT TSTREAM REGION NIL `(READONLY T WINDOWTYPE COMPARESOURCES-TEDIT TITLE
|
||||
,TITLE]
|
||||
(CL:WHEN NIL
|
||||
EXAMINE
|
||||
(COMPARESOURCES FILEX FILEY EXAMINE DW? (OPENSTREAM '{NULL} 'OUTPUT)))
|
||||
(WFROMDS TSTREAM)))
|
||||
(HELP])
|
||||
)
|
||||
|
||||
(RPAQ? COMPARESOURCES-BROWSER-TYPE 'OBJECTWINDOW)
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
OBJECTWINDOW EXAMINEDEFS REGIONMANAGER)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -314,14 +684,18 @@ Copyright (c) 1985, 1986, 1987, 1988, 2018, 2020 by Xerox Corporation. All righ
|
||||
(GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS DEFAULT.DECLARE.TAGS)
|
||||
)
|
||||
)
|
||||
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020))
|
||||
(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1166 16557 (COMPARESOURCES 1176 . 5134) (\CS.COMPARE.MASTERS 5136 . 13057) (
|
||||
\CS.COMPARE.TYPES 13059 . 14308) (\CS.SORT.DECLARES 14310 . 14653) (\CS.SORT.DECLARE1 14655 . 16075) (
|
||||
\CS.FILTER.GARBAGE 16077 . 16555)) (16558 19286 (\CS.ISVARFORM 16568 . 16673) (\CS.COMPARE.VARS 16675
|
||||
. 17337) (\CS.ISMACROFORM 17339 . 17477) (\CS.ISRECFORM 17479 . 17572) (\CS.ISCOURIERFORM 17574 .
|
||||
17674) (\CS.ISTEMPLATEFORM 17676 . 17774) (\CS.COMPARE.TEMPLATES 17776 . 18141) (\CS.ISPROPFORM 18143
|
||||
. 18298) (\CS.PROP.NAME 18300 . 18445) (\CS.COMPARE.PROPS 18447 . 18604) (\CS.ISADDVARFORM 18606 .
|
||||
18699) (\CS.COMPARE.ADDVARS 18701 . 18866) (\CS.ISFPKGCOMFORM 18868 . 19075) (\CS.COMPARE.FPKGCOMS
|
||||
19077 . 19284)))))
|
||||
(FILEMAP (NIL (1850 27174 (COMPARESOURCES 1860 . 7906) (\CS.COMPARE.MASTERS 7908 . 16052) (
|
||||
\CS.COMPARE.TYPES 16054 . 19192) (\CS.EXAMINE 19194 . 23421) (\CS.FIXFNS 23423 . 24925) (
|
||||
\CS.SORT.DECLARES 24927 . 25270) (\CS.SORT.DECLARE1 25272 . 26692) (\CS.FILTER.GARBAGE 26694 . 27172))
|
||||
(27175 31155 (\CS.ISFNFORM 27185 . 27453) (\CS.COMPARE.FNS 27455 . 27697) (\CS.FNSID 27699 . 27843) (
|
||||
\CS.ISVARFORM 27845 . 27950) (\CS.COMPARE.VARS 27952 . 28614) (\CS.ISMACROFORM 28616 . 28754) (
|
||||
\CS.ISRECFORM 28756 . 28849) (\CS.ISCOURIERFORM 28851 . 28951) (\CS.ISTEMPLATEFORM 28953 . 29051) (
|
||||
\CS.COMPARE.TEMPLATES 29053 . 29418) (\CS.ISPROPFORM 29420 . 29575) (\CS.PROP.NAME 29577 . 29722) (
|
||||
\CS.COMPARE.PROPS 29724 . 29881) (\CS.ISADDVARFORM 29883 . 29976) (\CS.COMPARE.ADDVARS 29978 . 30143)
|
||||
(\CS.ISFPKGCOMFORM 30145 . 30352) (\CS.COMPARE.FPKGCOMS 30354 . 30561) (\CS.COMPARE.DEFINE-FILE-INFO
|
||||
30563 . 31153)) (31156 37220 (CSOBJ.CREATE 31166 . 31579) (CSOBJ.DISPLAYFN 31581 . 32334) (
|
||||
CSOBJ.IMAGEBOXFN 32336 . 34497) (CSOBJ.BUTTONEVENTINFN 34499 . 36970) (CSOBJ.COPYBUTTONEVENTINFN 36972
|
||||
. 37218)) (38084 40788 (CSBROWSER 38094 . 40786)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,41 +1,45 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 1-Mar-94 10:43:44" |{IE:PARC:XEROX}<LISPUSERS>MEDLEY>DICTTOOL.;4| 92411
|
||||
|
||||
changes to%: (FILES DICTCLIENT)
|
||||
(VARS DICTTOOLCOMS)
|
||||
(FNS TEdit.SearchMenu)
|
||||
(FILECREATED " 1-Feb-2022 16:42:35" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DICTTOOL.;2 92394
|
||||
|
||||
previous date%: "27-Mar-91 17:20:45" {DSK}<import>medley2.0>lispusers>DICTTOOL.;1)
|
||||
:CHANGES-TO (VARS DICTTOOLCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 1-Mar-94 10:43:44"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DICTTOOL.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1987, 1988, 1989, 1991, 1994 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1986-1989, 1991, 1994 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DICTTOOLCOMS)
|
||||
|
||||
(RPAQQ DICTTOOLCOMS
|
||||
((COMS * DICTTOOLDEPENDENCIES)
|
||||
(FILES ANALYZER (FROM {NFS}<PROJECT>DICTSERVER>LISP>)
|
||||
DICTCLIENT)
|
||||
(FILES ANALYZER)
|
||||
|
||||
(* ;; "1/6/89 jtm: fixed TEdit.PrintDefinition so that SimpleDicts would print their entries in the definition window.")
|
||||
(* ;; "RMK 2022: DICTCLIENT has disappeared")
|
||||
|
||||
(* (FILES (FROM {NFS}<PROJECT>DICTSERVER>LISP>)
|
||||
DICTCLIENT))
|
||||
|
||||
(* ;; "1/6/89 jtm: fixed TEdit.PrintDefinition so that SimpleDicts would print their entries in the definition window.")
|
||||
|
||||
|
||||
(* ;; "1/6/89 jtm: changed TEdit.SetDictionary and DictForStream so that TEdit.DefaultDictionary reflects the default dictionary to use if no other is specified.")
|
||||
(* ;; "1/6/89 jtm: changed TEdit.SetDictionary and DictForStream so that TEdit.DefaultDictionary reflects the default dictionary to use if no other is specified.")
|
||||
|
||||
|
||||
(* ;; "2/28/89 jtm: changed FILES so that DICTCLIENT is loaded from PIGLET.")
|
||||
(* ;; "2/28/89 jtm: changed FILES so that DICTCLIENT is loaded from PIGLET.")
|
||||
|
||||
|
||||
(* ;;
|
||||
"5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.")
|
||||
(* ;;
|
||||
"5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.")
|
||||
|
||||
|
||||
(* ;; "3/27/91 jtm: added TEdit interface to the SearchMenu module")
|
||||
(* ;; "3/27/91 jtm: added TEdit interface to the SearchMenu module")
|
||||
|
||||
|
||||
(* ;; "3/1/94 jtm: changed the loading of DICTCLIENT and SEARCHMENU")
|
||||
(* ;; "3/1/94 jtm: changed the loading of DICTCLIENT and SEARCHMENU")
|
||||
|
||||
(FNS TEDIT.INCLUDESTREAM TEdit.PrintDefinition DictTool.PrintDefinition Dict.PrintDefinition
|
||||
DictTool.GetEntry TEdit.SetDictionary DictForStream DictTool.Dictionaries PARSEBYCOLONS
|
||||
@@ -86,28 +90,36 @@ Copyright (c) 1986, 1987, 1988, 1989, 1991, 1994 by Xerox Corporation. All righ
|
||||
T)
|
||||
(PUTPROP (CAR FILE)
|
||||
'FILEDATES NIL])
|
||||
(* * code to make sure that the right versions of everything are loaded. The P must be executed
|
||||
before any FILES commands.)
|
||||
(* * code to make sure that the right versions of everything are loaded. The P must be executed before
|
||||
any FILES commands.)
|
||||
|
||||
|
||||
(PUTPROPS DICTTOOL DEPENDENCIES ((ANALYZER . " 9-Mar-89 15:24:58")
|
||||
(DICTCLIENT . " 8-Aug-88 16:01:50")))
|
||||
(PUTPROPS DICTTOOL DEPENDENCIES ((ANALYZER . " 9-Mar-89 15:24:58")))
|
||||
|
||||
[for FILE FILEDATE in (GETPROP 'DICTTOOL 'DEPENDENCIES)
|
||||
do [SETQ FILEDATE (CAAR (GETPROP (CAR FILE)
|
||||
'FILEDATES]
|
||||
(COND
|
||||
([AND FILEDATE (CDR FILE)
|
||||
(ILESSP (IDATE FILEDATE)
|
||||
(IDATE (CDR FILE] (* clear FILEDATES to force
|
||||
FILESLOAD to reload the file.)
|
||||
(printout T "Flushing old version of " (CAR FILE)
|
||||
T)
|
||||
(PUTPROP (CAR FILE)
|
||||
'FILEDATES NIL]
|
||||
'FILEDATES]
|
||||
(COND
|
||||
([AND FILEDATE (CDR FILE)
|
||||
(ILESSP (IDATE FILEDATE)
|
||||
(IDATE (CDR FILE] (* clear FILEDATES to force FILESLOAD
|
||||
to reload the file.)
|
||||
(printout T "Flushing old version of " (CAR FILE)
|
||||
T)
|
||||
(PUTPROP (CAR FILE)
|
||||
'FILEDATES NIL]
|
||||
|
||||
(FILESLOAD ANALYZER)
|
||||
|
||||
|
||||
|
||||
(* ;; "RMK 2022: DICTCLIENT has disappeared")
|
||||
|
||||
|
||||
|
||||
|
||||
(* (FILES (FROM {NFS}<PROJECT>DICTSERVER>LISP>) DICTCLIENT))
|
||||
|
||||
(FILESLOAD ANALYZER (FROM {NFS}<PROJECT>DICTSERVER>LISP>)
|
||||
DICTCLIENT)
|
||||
|
||||
|
||||
|
||||
@@ -130,8 +142,7 @@ before any FILES commands.)
|
||||
|
||||
|
||||
|
||||
(* ;; "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows."
|
||||
)
|
||||
(* ;; "5/31/89 jtm: changed Dict.AddCommands to put Dictionary menu item on Lafite display windows.")
|
||||
|
||||
|
||||
|
||||
@@ -1743,27 +1754,27 @@ before any FILES commands.)
|
||||
(q Æ a)))
|
||||
(PUTPROPS DICTTOOL COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989 1991 1994))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (6223 19029 (TEDIT.INCLUDESTREAM 6233 . 6744) (TEdit.PrintDefinition 6746 . 9000) (
|
||||
DictTool.PrintDefinition 9002 . 11539) (Dict.PrintDefinition 11541 . 12504) (DictTool.GetEntry 12506
|
||||
. 12805) (TEdit.SetDictionary 12807 . 14966) (DictForStream 14968 . 15335) (DictTool.Dictionaries
|
||||
15337 . 15491) (PARSEBYCOLONS 15493 . 16542) (PrintPronunciationGuide 16544 . 18015) (
|
||||
ConvertPronunciation 18017 . 19027)) (19030 28623 (TEdit.SearchMenu 19040 . 19270) (TEdit.PrintSearch
|
||||
19272 . 19722) (DictTool.PrintSearch 19724 . 21987) (DictTool.MergeSearch 21989 . 23817) (
|
||||
NerdForStream 23819 . 24129) (TEdit.SetNerd 24131 . 26203) (DictTool.PromptForCutoff 26205 . 26752) (
|
||||
DictTool.PromptForKeywordCutoff 26754 . 27402) (PARSESELECTION 27404 . 28621)) (28624 30679 (
|
||||
TEdit.PrintPhraseSearch 28634 . 29096) (DictTool.PrintPhraseSearch 29098 . 30677)) (30680 35475 (
|
||||
TEdit.PrintSynonyms 30690 . 31019) (REMOVEALL 31021 . 31521) (CONVERTFUNCTIONSTOFORMS 31523 . 32013) (
|
||||
TEdit.PrintNounSynonyms 32015 . 32366) (DictTool.PrintNounSynonyms 32368 . 32552) (
|
||||
DictTool.PrintVerbSynonyms 32554 . 32738) (DictTool.PrintAdjSynonyms 32740 . 32925) (
|
||||
TEdit.PrintVerbSynonyms 32927 . 33269) (TEdit.PrintAdjSynonyms 33271 . 33616) (DictTool.PrintSynonyms
|
||||
33618 . 35473)) (35476 41064 (DictTool.TEditWrapper 35486 . 38724) (Dict.OutputStream 38726 . 40520) (
|
||||
DictTool.PromptStream 40522 . 41062)) (41065 59074 (DictTool.Init 41075 . 42805) (DictTool.Open 42807
|
||||
. 46658) (DictTool.OpenDictionary 46660 . 48555) (DictTool.OpenAnalyzer 48557 . 50740) (
|
||||
DictTool.OpenNerd 50742 . 54106) (Dict.AddCommands 54108 . 58923) (DictTool.Close 58925 . 59072)) (
|
||||
59075 66681 (DictTool.Analyze 59085 . 63133) (DictTool.Analyzers 63135 . 63365) (
|
||||
DictTool.Pronunciation 63367 . 63687) (DictTool.Corrections 63689 . 64055) (DictTool.CountWords 64057
|
||||
. 66679)) (66720 84052 (DictTool.FindWord 66730 . 68741) (DictTool.SubstituteWord 68743 . 78958) (
|
||||
DictTool.CreateConjugationMap 78960 . 81835) (DictTool.FindWordInit 81837 . 84050)) (84053 89855 (
|
||||
LingFns.FindWord 84063 . 87881) (LingFns.Capitalize 87883 . 89495) (LingFns.Capitalization 89497 .
|
||||
89853)))))
|
||||
(FILEMAP (NIL (6206 19012 (TEDIT.INCLUDESTREAM 6216 . 6727) (TEdit.PrintDefinition 6729 . 8983) (
|
||||
DictTool.PrintDefinition 8985 . 11522) (Dict.PrintDefinition 11524 . 12487) (DictTool.GetEntry 12489
|
||||
. 12788) (TEdit.SetDictionary 12790 . 14949) (DictForStream 14951 . 15318) (DictTool.Dictionaries
|
||||
15320 . 15474) (PARSEBYCOLONS 15476 . 16525) (PrintPronunciationGuide 16527 . 17998) (
|
||||
ConvertPronunciation 18000 . 19010)) (19013 28606 (TEdit.SearchMenu 19023 . 19253) (TEdit.PrintSearch
|
||||
19255 . 19705) (DictTool.PrintSearch 19707 . 21970) (DictTool.MergeSearch 21972 . 23800) (
|
||||
NerdForStream 23802 . 24112) (TEdit.SetNerd 24114 . 26186) (DictTool.PromptForCutoff 26188 . 26735) (
|
||||
DictTool.PromptForKeywordCutoff 26737 . 27385) (PARSESELECTION 27387 . 28604)) (28607 30662 (
|
||||
TEdit.PrintPhraseSearch 28617 . 29079) (DictTool.PrintPhraseSearch 29081 . 30660)) (30663 35458 (
|
||||
TEdit.PrintSynonyms 30673 . 31002) (REMOVEALL 31004 . 31504) (CONVERTFUNCTIONSTOFORMS 31506 . 31996) (
|
||||
TEdit.PrintNounSynonyms 31998 . 32349) (DictTool.PrintNounSynonyms 32351 . 32535) (
|
||||
DictTool.PrintVerbSynonyms 32537 . 32721) (DictTool.PrintAdjSynonyms 32723 . 32908) (
|
||||
TEdit.PrintVerbSynonyms 32910 . 33252) (TEdit.PrintAdjSynonyms 33254 . 33599) (DictTool.PrintSynonyms
|
||||
33601 . 35456)) (35459 41047 (DictTool.TEditWrapper 35469 . 38707) (Dict.OutputStream 38709 . 40503) (
|
||||
DictTool.PromptStream 40505 . 41045)) (41048 59057 (DictTool.Init 41058 . 42788) (DictTool.Open 42790
|
||||
. 46641) (DictTool.OpenDictionary 46643 . 48538) (DictTool.OpenAnalyzer 48540 . 50723) (
|
||||
DictTool.OpenNerd 50725 . 54089) (Dict.AddCommands 54091 . 58906) (DictTool.Close 58908 . 59055)) (
|
||||
59058 66664 (DictTool.Analyze 59068 . 63116) (DictTool.Analyzers 63118 . 63348) (
|
||||
DictTool.Pronunciation 63350 . 63670) (DictTool.Corrections 63672 . 64038) (DictTool.CountWords 64040
|
||||
. 66662)) (66703 84035 (DictTool.FindWord 66713 . 68724) (DictTool.SubstituteWord 68726 . 78941) (
|
||||
DictTool.CreateConjugationMap 78943 . 81818) (DictTool.FindWordInit 81820 . 84033)) (84036 89838 (
|
||||
LingFns.FindWord 84046 . 87864) (LingFns.Capitalize 87866 . 89478) (LingFns.Capitalization 89480 .
|
||||
89836)))))
|
||||
STOP
|
||||
|
||||
BIN
lispusers/DICTTOOL.LCOM
Normal file
BIN
lispusers/DICTTOOL.LCOM
Normal file
Binary file not shown.
140
lispusers/DINFO
140
lispusers/DINFO
@@ -1,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "14-Feb-2021 23:11:36"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;5 64800
|
||||
|
||||
changes to%: (VARS DINFOCOMS)
|
||||
(FILECREATED " 3-Feb-2022 11:57:39" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;5 65271
|
||||
|
||||
previous date%: "14-Feb-2021 14:55:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>DINFO.;4)
|
||||
:CHANGES-TO (FNS DINFO.UPDATE.TEXT.DISPLAY)
|
||||
|
||||
:PREVIOUS-DATE "21-Jan-2022 23:16:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>DINFO.;3)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
Copyright (c) 1985-1987, 2020-2021 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DINFOCOMS)
|
||||
@@ -19,24 +19,24 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS DINFOGRAPH DINFONODE)
|
||||
(FUNCTIONS DINFOGRAPHPROP))
|
||||
(INITRECORDS DINFOGRAPH)
|
||||
(FNS (* ; "Primary functions")
|
||||
(FNS (* ; "Primary functions")
|
||||
DINFO DINFO.UPDATE DINFOGRAPH DINFO.SPECIAL.UPDATE DINFO.READ.GRAPH DINFO.WRITE.GRAPH
|
||||
DINFO.SELECT.GRAPH DINFO.DEFAULT.MENU DINFO.FIND DINFO.LOOKUP)
|
||||
(FNS (* ; "Koto compatability")
|
||||
(FNS (* ; "Koto compatability")
|
||||
DINFO.READ.KOTO.GRAPH)
|
||||
(FNS (* ; "Window functions")
|
||||
(FNS (* ; "Window functions")
|
||||
DINFO.SETUP.WINDOW DINFO.CLOSEFN DINFO.SHRINKFN DINFO.EXPANDFN DINFO.ICONFN)
|
||||
(FNS (* ; "FreeMenu functions")
|
||||
(FNS (* ; "FreeMenu functions")
|
||||
DINFO.ADD.FMENU DINFO.CREATE.FMENU DINFO.FMW.CLOSEFN DINFO.FMENU.HANDLER
|
||||
DINFO.UPDATE.FMENU DINFO.TOGGLE.MENU DINFO.TOGGLE.GRAPH DINFO.TOGGLE.HISTORY
|
||||
DINFO.TOGGLE.TEXT)
|
||||
(FNS (* ; "Other menu functions")
|
||||
(FNS (* ; "Other menu functions")
|
||||
DINFO.UPDATE.MENU.DISPLAY DINFO.UPDATE.FROM.MENU DINFO.UPDATE.HISTORY
|
||||
DINFO.HISTORIC.UPDATE)
|
||||
(FNS (* ; "Interface to GRAPHER")
|
||||
(FNS (* ; "Interface to GRAPHER")
|
||||
DINFO.UPDATE.GRAPH.DISPLAY DINFO.UPDATE.FROM.GRAPH DINFO.GET.GRAPH.WINDOW
|
||||
DINFO.CREATE.GRAPH.WINDOW DINFO.SHOWGRAPH DINFO.INVERT.NODE DINFO.LAYOUTGRAPH)
|
||||
(FNS (* ; "Interface to TEdit")
|
||||
(FNS (* ; "Interface to TEdit")
|
||||
DINFO.UPDATE.TEXT.DISPLAY DINFO.TITLEMENUFN DINFO.OPENTEXTSTREAM DINFO.SHOWSEL
|
||||
DINFO.GET.FILENAME)
|
||||
(ADDVARS (BackgroundMenuCommands (DInfo (DINFO.SELECT.GRAPH)
|
||||
@@ -63,7 +63,7 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(SYSTEM))
|
||||
|
||||
(RECORD DINFONODE (ID LABEL FILE FROMBYTE TOBYTE PARENT CHILDREN NEXTNODE PREVIOUSNODE USERDATA)
|
||||
(SYSTEM))
|
||||
(SYSTEM))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'DINFOGRAPH
|
||||
@@ -108,24 +108,20 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(CADR PROP]
|
||||
(IF NEW-VALUE-SUPPLIED
|
||||
THEN [IF REAL-FIELD
|
||||
THEN `(REPLACE (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH
|
||||
WITH ,NEW-VALUE)
|
||||
ELSE `(LET* ((SI::$GRAPH$ ,GRAPH)
|
||||
(SI::$USERDATA$ (FETCH (DINFOGRAPH USERDATA)
|
||||
OF SI::$GRAPH$))
|
||||
(SI::$PROP$ ,PROP)
|
||||
(SI::$NEW-VALUE$ ,NEW-VALUE))
|
||||
(IF (LISTP SI::$USERDATA$)
|
||||
THEN (LISTPUT SI::$USERDATA$ SI::$PROP$
|
||||
SI::$NEW-VALUE$)
|
||||
ELSE (REPLACE (DINFOGRAPH USERDATA) OF
|
||||
SI::$GRAPH$
|
||||
WITH (LIST SI::$PROP$ SI::$NEW-VALUE$))
|
||||
SI::$NEW-VALUE$]
|
||||
THEN `(REPLACE (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH WITH ,NEW-VALUE)
|
||||
ELSE `(LET* ((SI::$GRAPH$ ,GRAPH)
|
||||
(SI::$USERDATA$ (FETCH (DINFOGRAPH USERDATA) OF SI::$GRAPH$))
|
||||
(SI::$PROP$ ,PROP)
|
||||
(SI::$NEW-VALUE$ ,NEW-VALUE))
|
||||
(IF (LISTP SI::$USERDATA$)
|
||||
THEN (LISTPUT SI::$USERDATA$ SI::$PROP$ SI::$NEW-VALUE$)
|
||||
ELSE (REPLACE (DINFOGRAPH USERDATA) OF SI::$GRAPH$
|
||||
WITH (LIST SI::$PROP$ SI::$NEW-VALUE$))
|
||||
SI::$NEW-VALUE$]
|
||||
ELSE (IF REAL-FIELD
|
||||
THEN `(FETCH (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH)
|
||||
ELSE `(LISTGET (FETCH (DINFOGRAPH USERDATA) OF ,GRAPH)
|
||||
,PROP])
|
||||
THEN `(FETCH (DINFOGRAPH ,REAL-FIELD) OF ,GRAPH)
|
||||
ELSE `(LISTGET (FETCH (DINFOGRAPH USERDATA) OF ,GRAPH)
|
||||
,PROP])
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'DINFOGRAPH
|
||||
@@ -375,7 +371,8 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
NIL])
|
||||
|
||||
(DINFO.FIND
|
||||
[LAMBDA (GRAPH BUTTONS) (* drc%: "25-Jan-86 18:23")
|
||||
[LAMBDA (GRAPH BUTTONS) (* ; "Edited 21-Jan-2022 23:15 by rmk")
|
||||
(* drc%: "25-Jan-86 18:23")
|
||||
(LET ((DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH)))
|
||||
(if (NOT (OBTAIN.MONITORLOCK (fetch (DINFOGRAPH MONITORLOCK) of GRAPH)
|
||||
T))
|
||||
@@ -385,8 +382,9 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(TERPRI T)
|
||||
(LET ([STRING (if (AND (FMEMB 'MIDDLE BUTTONS)
|
||||
(fetch (DINFOGRAPH FIND.STRING) of GRAPH))
|
||||
else (PROMPTFORWORD "Find: " (fetch (DINFOGRAPH FIND.STRING)
|
||||
of GRAPH)
|
||||
else (TTYINPROMPTFORWORD "Find: " (fetch (DINFOGRAPH
|
||||
FIND.STRING)
|
||||
of GRAPH)
|
||||
NIL NIL NIL 'TTY (CONSTANT (CHARCODE (EOL ESCAPE
|
||||
LF]
|
||||
(TEXTSTREAM (WINDOWPROP DINFOW 'TEXTSTREAM))
|
||||
@@ -403,11 +401,12 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(NCHARS STRING)
|
||||
'RIGHT T)))
|
||||
else (printout T "not found.")
|
||||
(TEDIT.NORMALIZECARET TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM
|
||||
(TEDIT.NORMALIZECARET TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM
|
||||
0 0])
|
||||
|
||||
(DINFO.LOOKUP
|
||||
[LAMBDA (GRAPH BUTTONS) (* drc%: "25-Jan-86 18:22")
|
||||
[LAMBDA (GRAPH BUTTONS) (* ; "Edited 21-Jan-2022 23:15 by rmk")
|
||||
(* drc%: "25-Jan-86 18:22")
|
||||
(LET
|
||||
((DINFOW (fetch (DINFOGRAPH WINDOW) of GRAPH)))
|
||||
(if (OBTAIN.MONITORLOCK (fetch (DINFOGRAPH MONITORLOCK) of GRAPH)
|
||||
@@ -421,7 +420,7 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(LET* [(OLD.STRING (fetch (DINFOGRAPH LOOKUP.STRING) of GRAPH))
|
||||
(STRING (if (AND OLD.STRING (FMEMB 'MIDDLE BUTTONS))
|
||||
then OLD.STRING
|
||||
else (PROMPTFORWORD "Lookup: " OLD.STRING NIL NIL NIL
|
||||
else (TTYINPROMPTFORWORD "Lookup: " OLD.STRING NIL NIL NIL
|
||||
'TTY
|
||||
(CONSTANT (CHARCODE (EOL ESCAPE LF]
|
||||
(replace (DINFOGRAPH LOOKUP.STRING) of GRAPH with STRING)
|
||||
@@ -539,14 +538,17 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(DINFO.UPDATE.FMENU GRAPH])
|
||||
|
||||
(DINFO.CREATE.FMENU
|
||||
[LAMBDA (GRAPH) (* jow "15-Jul-86 17:39")
|
||||
|
||||
(* * Makes a DInfo FreeMenu for GRAPH)
|
||||
[LAMBDA (GRAPH) (* ; "Edited 25-Oct-2021 23:23 by rmk:")
|
||||
(* jow "15-Jul-86 17:39")
|
||||
|
||||
(* ;;; "Makes a DInfo FreeMenu for GRAPH")
|
||||
|
||||
(* ;; "RMK: Added MINSIZE and MAXSIZE so that the menu doesn't get distorted during reshaping")
|
||||
|
||||
(LET* [(ADD.ITEMS (fetch (DINFOGRAPH FREEMENUITEMS) of GRAPH))
|
||||
(FONT (OR (FONTP (fetch (DINFOGRAPH MENUFONT) of GRAPH))
|
||||
MENUFONT))
|
||||
(FM (FREEMENU `((PROPS FONT %, FONT)
|
||||
[FM (FREEMENU `((PROPS FONT %, FONT)
|
||||
((LABEL Node%: TYPE DISPLAY FONT (HELVETICA 10))
|
||||
(ID NODE LABEL "" TYPE DISPLAY))
|
||||
((LABEL Top! SELECTEDFN DINFO.FMENU.HANDLER FONT (HELVETICA 10 BOLD)
|
||||
@@ -585,8 +587,12 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(HELVETICA 10 BOLD)
|
||||
MESSAGE
|
||||
"Lookup a term in this graph. LEFT for new term, MIDDLE to repeat last."
|
||||
)) ADD.ITEMS]
|
||||
))
|
||||
ADD.ITEMS]
|
||||
(HEIGHT (FETCH (REGION HEIGHT) OF (WINDOWPROP FM 'REGION]
|
||||
(WINDOWPROP FM 'FM.DONTRESHAPE T)
|
||||
(WINDOWPROP FM 'MINSIZE (CONS 0 HEIGHT))
|
||||
(WINDOWPROP FM 'MAXSIZE (CONS 64000 HEIGHT))
|
||||
FM])
|
||||
|
||||
(DINFO.FMW.CLOSEFN
|
||||
@@ -988,7 +994,8 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DINFO.UPDATE.TEXT.DISPLAY
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* drc%: "25-Jan-86 18:18")
|
||||
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 3-Feb-2022 11:50 by rmk")
|
||||
(* drc%: "25-Jan-86 18:18")
|
||||
(LET ((WINDOW (fetch (DINFOGRAPH WINDOW) of GRAPH))
|
||||
(FILENAME (DINFO.GET.FILENAME GRAPH NODE))
|
||||
(FROM (fetch (DINFONODE FROMBYTE) of NODE))
|
||||
@@ -999,17 +1006,15 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
'TEXTSTREAM))
|
||||
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
|
||||
(if (OR OFF? (NULL FILENAME))
|
||||
then (OPENTEXTSTREAM (if OFF?
|
||||
then ""
|
||||
else "This node has no text")
|
||||
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
|
||||
WINDOW NIL NIL PROPS)
|
||||
(replace (DINFOGRAPH LAST.TEXT) of GRAPH with NIL)
|
||||
elseif (SETQ FULLFILENAME (MKATOM (INFILEP FILENAME)))
|
||||
then (SETQ TEXTSTREAM (DINFO.OPENTEXTSTREAM FULLFILENAME WINDOW FROM TO PROPS))
|
||||
(DINFO.SHOWSEL TEXTSTREAM SEL)
|
||||
else (OPENTEXTSTREAM (CONCAT "Sorry, can't find the text for this node."
|
||||
(MKSTRING (CHARACTER (CHARCODE CR)))
|
||||
"Missing file is: " FILENAME)
|
||||
else (OPENTEXTSTREAM (OPENSTRINGSTREAM (CONCAT "Sorry, can't find the text for this node."
|
||||
(MKSTRING (CHARACTER (CHARCODE CR)))
|
||||
"Missing file is: " FILENAME))
|
||||
WINDOW NIL NIL PROPS)
|
||||
(replace (DINFOGRAPH LAST.TEXT) of GRAPH with NIL))
|
||||
(CLOSEF? OLD.TEXTSTREAM)
|
||||
@@ -1087,7 +1092,7 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
)
|
||||
|
||||
(ADDTOVAR BackgroundMenuCommands (DInfo (DINFO.SELECT.GRAPH)
|
||||
"Open a DInfo window for browsing documentation."))
|
||||
"Open a DInfo window for browsing documentation."))
|
||||
|
||||
(RPAQQ BackgroundMenu NIL)
|
||||
|
||||
@@ -1103,27 +1108,28 @@ Copyright (c) 1985, 1986, 1987, 2020, 2021 by Xerox Corporation.
|
||||
(GLOBALVARS DINFO.GRAPH.FILES DINFOMODES DINFO.HISTORY.LENGTH \DINFO.MAX.MENU.LEN)
|
||||
)
|
||||
|
||||
(PUTPROPS DINFO FILETYPE :COMPILE-FILE)
|
||||
(PUTPROPS DINFO FILETYPE :FAKE-COMPILE-FILE)
|
||||
(DECLARE%: DONTCOPY
|
||||
|
||||
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
|
||||
)
|
||||
(PUTPROPS DINFO COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (7732 24558 (DINFO 7742 . 9356) (DINFO.UPDATE 9358 . 12222) (DINFOGRAPH 12224 . 12642) (
|
||||
DINFO.SPECIAL.UPDATE 12644 . 14342) (DINFO.READ.GRAPH 14344 . 16199) (DINFO.WRITE.GRAPH 16201 . 17291)
|
||||
(DINFO.SELECT.GRAPH 17293 . 18200) (DINFO.DEFAULT.MENU 18202 . 20726) (DINFO.FIND 20728 . 23112) (
|
||||
DINFO.LOOKUP 23114 . 24556)) (24559 27253 (DINFO.READ.KOTO.GRAPH 24569 . 27251)) (27254 29568 (
|
||||
DINFO.SETUP.WINDOW 27264 . 27945) (DINFO.CLOSEFN 27947 . 28380) (DINFO.SHRINKFN 28382 . 28578) (
|
||||
DINFO.EXPANDFN 28580 . 29137) (DINFO.ICONFN 29139 . 29566)) (29569 40417 (DINFO.ADD.FMENU 29579 .
|
||||
30674) (DINFO.CREATE.FMENU 30676 . 34213) (DINFO.FMW.CLOSEFN 34215 . 35060) (DINFO.FMENU.HANDLER 35062
|
||||
. 35701) (DINFO.UPDATE.FMENU 35703 . 37908) (DINFO.TOGGLE.MENU 37910 . 38500) (DINFO.TOGGLE.GRAPH
|
||||
38502 . 39001) (DINFO.TOGGLE.HISTORY 39003 . 39547) (DINFO.TOGGLE.TEXT 39549 . 40415)) (40418 48116 (
|
||||
DINFO.UPDATE.MENU.DISPLAY 40428 . 44448) (DINFO.UPDATE.FROM.MENU 44450 . 44749) (DINFO.UPDATE.HISTORY
|
||||
44751 . 47285) (DINFO.HISTORIC.UPDATE 47287 . 48114)) (48117 58283 (DINFO.UPDATE.GRAPH.DISPLAY 48127
|
||||
. 49445) (DINFO.UPDATE.FROM.GRAPH 49447 . 49890) (DINFO.GET.GRAPH.WINDOW 49892 . 50477) (
|
||||
DINFO.CREATE.GRAPH.WINDOW 50479 . 51596) (DINFO.SHOWGRAPH 51598 . 53323) (DINFO.INVERT.NODE 53325 .
|
||||
54713) (DINFO.LAYOUTGRAPH 54715 . 58281)) (58284 64140 (DINFO.UPDATE.TEXT.DISPLAY 58294 . 60155) (
|
||||
DINFO.TITLEMENUFN 60157 . 61282) (DINFO.OPENTEXTSTREAM 61284 . 62500) (DINFO.SHOWSEL 62502 . 63235) (
|
||||
DINFO.GET.FILENAME 63237 . 64138)))))
|
||||
(FILEMAP (NIL (4678 6137 (DINFOGRAPHPROP 4678 . 6137)) (7391 24529 (DINFO 7401 . 9015) (DINFO.UPDATE
|
||||
9017 . 11881) (DINFOGRAPH 11883 . 12301) (DINFO.SPECIAL.UPDATE 12303 . 14001) (DINFO.READ.GRAPH 14003
|
||||
. 15858) (DINFO.WRITE.GRAPH 15860 . 16950) (DINFO.SELECT.GRAPH 16952 . 17859) (DINFO.DEFAULT.MENU
|
||||
17861 . 20385) (DINFO.FIND 20387 . 22973) (DINFO.LOOKUP 22975 . 24527)) (24530 27224 (
|
||||
DINFO.READ.KOTO.GRAPH 24540 . 27222)) (27225 29539 (DINFO.SETUP.WINDOW 27235 . 27916) (DINFO.CLOSEFN
|
||||
27918 . 28351) (DINFO.SHRINKFN 28353 . 28549) (DINFO.EXPANDFN 28551 . 29108) (DINFO.ICONFN 29110 .
|
||||
29537)) (29540 40800 (DINFO.ADD.FMENU 29550 . 30645) (DINFO.CREATE.FMENU 30647 . 34596) (
|
||||
DINFO.FMW.CLOSEFN 34598 . 35443) (DINFO.FMENU.HANDLER 35445 . 36084) (DINFO.UPDATE.FMENU 36086 . 38291
|
||||
) (DINFO.TOGGLE.MENU 38293 . 38883) (DINFO.TOGGLE.GRAPH 38885 . 39384) (DINFO.TOGGLE.HISTORY 39386 .
|
||||
39930) (DINFO.TOGGLE.TEXT 39932 . 40798)) (40801 48499 (DINFO.UPDATE.MENU.DISPLAY 40811 . 44831) (
|
||||
DINFO.UPDATE.FROM.MENU 44833 . 45132) (DINFO.UPDATE.HISTORY 45134 . 47668) (DINFO.HISTORIC.UPDATE
|
||||
47670 . 48497)) (48500 58666 (DINFO.UPDATE.GRAPH.DISPLAY 48510 . 49828) (DINFO.UPDATE.FROM.GRAPH 49830
|
||||
. 50273) (DINFO.GET.GRAPH.WINDOW 50275 . 50860) (DINFO.CREATE.GRAPH.WINDOW 50862 . 51979) (
|
||||
DINFO.SHOWGRAPH 51981 . 53706) (DINFO.INVERT.NODE 53708 . 55096) (DINFO.LAYOUTGRAPH 55098 . 58664)) (
|
||||
58667 64610 (DINFO.UPDATE.TEXT.DISPLAY 58677 . 60625) (DINFO.TITLEMENUFN 60627 . 61752) (
|
||||
DINFO.OPENTEXTSTREAM 61754 . 62970) (DINFO.SHOWSEL 62972 . 63705) (DINFO.GET.FILENAME 63707 . 64608)))
|
||||
))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
204
lispusers/EXAMINEDEFS
Normal file
204
lispusers/EXAMINEDEFS
Normal file
@@ -0,0 +1,204 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "28-Jan-2022 23:36:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;32 11715
|
||||
|
||||
:CHANGES-TO (FNS TEDITDEF)
|
||||
|
||||
:PREVIOUS-DATE "25-Jan-2022 10:20:31"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>EXAMINEDEFS.;31)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||
|
||||
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF)
|
||||
(INITVARS (EXAMINEDEFS-PROCESS-LIST)
|
||||
(EXAMINEWITH 'COMPARETEXT))
|
||||
(FILES (SYSLOAD)
|
||||
COMPARETEXT)))
|
||||
(DEFINEQ
|
||||
|
||||
(EXAMINEDEFS
|
||||
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 23-Jan-2022 17:40 by rmk")
|
||||
(* ; "Edited 18-Jan-2022 22:40 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:29 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:39 by rmk")
|
||||
(* ; "Edited 20-Dec-2021 11:06 by rmk")
|
||||
|
||||
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined.")
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "Examination is in side-by-side attached SEDIT windows if SEDIT is the EDITMODE. You can use SEDIT operations to zoom in on the location of any changes, deleting common stuff for example. But you are always working on a copy, so that changes are safe and ephemeral. This is an examination, not an edit.")
|
||||
|
||||
(CL:UNLESS NAME
|
||||
(CL:UNLESS (LISTP SOURCE1)
|
||||
(ERROR SOURCE1 " cannot be examined"))
|
||||
(CL:UNLESS (LISTP SOURCE2)
|
||||
(ERROR SOURCE2 " cannot be examined")))
|
||||
(CL:UNLESS TYPE
|
||||
(SETQ TYPE 'FNS))
|
||||
|
||||
(* ;; "TITLE1 and TITLE2 are optional strings that will be used to construct the titles of the SEDIT windows. We would like to know where GETDEF got the definition so we can use that, but there isn't an interface that provides that information (extended WHEREIS?)")
|
||||
|
||||
(LET (DEF1 DEF2)
|
||||
(SETQ DEF1 (IF (LISTP SOURCE1)
|
||||
THEN
|
||||
(* ;; "Copy to simulate READONLY")
|
||||
|
||||
(SETQ DEF1 (COPY SOURCE1))
|
||||
ELSEIF (GETDEF NAME TYPE SOURCE1)
|
||||
ELSE (ERROR NAME " not found on " SOURCE1)))
|
||||
(SETQ DEF2 (IF (LISTP SOURCE2)
|
||||
THEN (COPY SOURCE2)
|
||||
ELSEIF (GETDEF NAME TYPE SOURCE2)
|
||||
ELSE (ERROR NAME " not found on " SOURCE2)))
|
||||
(CL:UNLESS TITLE1
|
||||
(SETQ TITLE1 (OR (AND SOURCE1 (LITATOM SOURCE1))
|
||||
"File 1")))
|
||||
(CL:UNLESS TITLE2
|
||||
(SETQ TITLE2 (OR (AND SOURCE2 (LITATOM SOURCE2))
|
||||
"File 2")))
|
||||
(SELECTQ (EDITMODE)
|
||||
(SEDIT:SEDIT
|
||||
(* ;;
|
||||
"A kludge to eliminate dangling SEDIT processes from previous examinations")
|
||||
|
||||
[SETQ EXAMINEDEFS-PROCESS-LIST
|
||||
(FOR PAIR IN EXAMINEDEFS-PROCESS-LIST
|
||||
COLLECT (IF (OPENWP (CAR PAIR))
|
||||
THEN PAIR
|
||||
ELSE (DEL.PROCESS (CDR PAIR))
|
||||
(GO $$ITERATE]
|
||||
|
||||
(* ;; "Set it up for new side-by-side regions that are forgotten when the window is closed. Their shape is usually not that useful for regular edits.")
|
||||
|
||||
(* ;;
|
||||
"Crude suggestions for height, width, position. Suggest shorter window for smaller structures")
|
||||
|
||||
(SELECTQ EXAMINEWITH
|
||||
(SEDIT (CL:UNLESS (REGIONP REGION)
|
||||
(SETQ REGION (GETREGION)))
|
||||
[LET (R1 R2 HALFWIDTH W1 W2)
|
||||
(SETQ HALFWIDTH (IQUOTIENT (FETCH (REGION WIDTH)
|
||||
OF REGION)
|
||||
2))
|
||||
(SETQ R1 (CREATE REGION USING REGION WIDTH _ HALFWIDTH))
|
||||
(SETQ R2 (CREATE REGION USING REGION LEFT _
|
||||
(IPLUS (FETCH (REGION LEFT)
|
||||
OF REGION)
|
||||
HALFWIDTH)
|
||||
WIDTH _ HALFWIDTH))
|
||||
[SETQ W1
|
||||
(SEDIT:GET-WINDOW (SEDIT:SEDIT
|
||||
DEF1
|
||||
`(:NAME ,(CONCAT NAME " from " TITLE1)
|
||||
:REGION
|
||||
,(CREATE REGION
|
||||
USING REGION WIDTH _
|
||||
HALFWIDTH)
|
||||
R1 :DONT-KEEP-WINDOW-REGION T]
|
||||
[SETQ W2
|
||||
(SEDIT:GET-WINDOW (SEDIT:SEDIT
|
||||
DEF2
|
||||
`(:NAME ,(CONCAT NAME " from " TITLE2)
|
||||
:REGION
|
||||
,R2 :DONT-KEEP-WINDOW-REGION T]
|
||||
(ATTACHWINDOW W2 W1 'RIGHT 'JUSTIFY)
|
||||
(MODERNWINDOW W2)
|
||||
|
||||
(* ;;
|
||||
"So we can kill the processes on the next call, if they still exist after the windows are closed.")
|
||||
|
||||
(PUSH EXAMINEDEFS-PROCESS-LIST (CONS W1 (WINDOWPROP
|
||||
W1
|
||||
'PROCESS))
|
||||
(CONS W2 (WINDOWPROP W2 'PROCESS])
|
||||
(COMPARETEXT [LET (COMPARETEXT.ALLCHUNKS CTWINDOW
|
||||
(KEY (LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2)))
|
||||
(DECLARE (SPECVARS COMPARETEXT.ALLCHUNKS))
|
||||
(* ; "Reuse an existing CT graph window")
|
||||
(OR [FIND W IN (OPENWINDOWS)
|
||||
SUCHTHAT (EQUAL KEY (WINDOWPROP W
|
||||
'EXAMINEDEFS]
|
||||
(PROG1 (SETQ CTWINDOW
|
||||
(COMPARETEXT (TEDITDEF NAME DEF1 TYPE)
|
||||
(TEDITDEF NAME DEF2 TYPE)
|
||||
'LINE REGION (LIST TITLE1 TITLE2)
|
||||
(CONCAT "Compare sources of " NAME
|
||||
" as " TYPE)))
|
||||
(WINDOWPROP CTWINDOW 'EXAMINEDEFS
|
||||
(LIST NAME TYPE SOURCE1 SOURCE2 TITLE1
|
||||
TITLE2)))])
|
||||
(SHOULDNT)))
|
||||
(PROGN (EDITE DEF1)
|
||||
(EDITE DEF2])
|
||||
|
||||
(EXAMINEFILES
|
||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 25-Jan-2022 10:08 by rmk")
|
||||
(* ; "Edited 2-Jan-2022 23:15 by rmk")
|
||||
(* ; "Edited 30-Dec-2021 21:49 by rmk")
|
||||
|
||||
(* ;; "We get a region, then split it in half. Should we attach or at least co-move and co-close the 2 windows?")
|
||||
|
||||
(CL:UNLESS REGION
|
||||
(SETQ REGION (GETREGION)))
|
||||
(LIST (TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||
REGION
|
||||
'RIGHT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE1)
|
||||
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
||||
REGION
|
||||
'LEFT
|
||||
'TOP
|
||||
`(,REGION 0.5)
|
||||
(FETCH (REGION TOP) OF REGION))
|
||||
NIL TITLE2])
|
||||
|
||||
(TEDITDEF
|
||||
[LAMBDA (NAME DEF TYPE READERENVIRONMENT) (* ; "Edited 28-Jan-2022 23:36 by rmk")
|
||||
(* ; "Edited 12-Jan-2022 17:27 by rmk")
|
||||
(LET ((TSTREAM (OPENTEXTSTREAM)))
|
||||
(DSPFONT DEFAULTFONT TSTREAM)
|
||||
(SELECTQ (CAR DEF)
|
||||
(DEFINEQ (SETQ DEF (CADR DEF))
|
||||
(PRINTOUT TSTREAM .FONT BOLDFONT .P2 NAME T .FONT DEFAULTFONT 2)
|
||||
(PRINTDEF (CADR DEF)
|
||||
2 T NIL NIL TSTREAM))
|
||||
((DEFMACRO DEFUN) (* ; "Has args after name")
|
||||
(PRINTOUT TSTREAM "(" .P2 (CAR DEF)
|
||||
" " .FONT BOLDFONT .P2 (CADR DEF)
|
||||
.FONT DEFAULTFONT " " .P2 (CADDR DEF)
|
||||
T)
|
||||
(PRINTDEF (CDDDR DEF)
|
||||
3 T T NIL TSTREAM)
|
||||
(PRIN3 ")" TSTREAM))
|
||||
(IF (EQ NAME (CADR DEF))
|
||||
THEN
|
||||
(* ;; "Like RPAQQ, bold the name")
|
||||
|
||||
[PRINTOUT TSTREAM "(" .P2 (CAR DEF)
|
||||
" " .FONT BOLDFONT .P2 (CADR DEF)
|
||||
.FONT DEFAULTFONT T .TAB (IPLUS 2 (NCHARS (CAR DEF]
|
||||
(PRINTDEF (CDDR DEF)
|
||||
(IPLUS 2 (NCHARS (CAR DEF)))
|
||||
T T NIL TSTREAM)
|
||||
(PRIN3 ")" TSTREAM)
|
||||
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
|
||||
TSTREAM])
|
||||
)
|
||||
|
||||
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
|
||||
|
||||
(RPAQ? EXAMINEWITH 'COMPARETEXT)
|
||||
|
||||
(FILESLOAD (SYSLOAD)
|
||||
COMPARETEXT)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (658 11573 (EXAMINEDEFS 668 . 8787) (EXAMINEFILES 8789 . 9984) (TEDITDEF 9986 . 11571)))
|
||||
))
|
||||
STOP
|
||||
BIN
lispusers/EXAMINEDEFS.LCOM
Normal file
BIN
lispusers/EXAMINEDEFS.LCOM
Normal file
Binary file not shown.
BIN
lispusers/EXAMINEDEFS.TEDIT
Normal file
BIN
lispusers/EXAMINEDEFS.TEDIT
Normal file
Binary file not shown.
@@ -1,18 +1,21 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "18-Aug-88 14:32:54" {DSK}<LISPFILES>ANDRE>FM-CREATOR.;12 173736
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (VARS FM-CREATORCOMS)
|
||||
(FILECREATED " 1-Feb-2022 17:09:01"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>FM-CREATOR.;2 171676
|
||||
|
||||
previous date%: "18-Aug-88 14:11:30" {DSK}<LISPFILES>ANDRE>FM-CREATOR.;11)
|
||||
:CHANGES-TO (FNS FMC-EDIT.INFO)
|
||||
|
||||
:PREVIOUS-DATE "18-Aug-88 14:32:54"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>FM-CREATOR.;1)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reserved.
|
||||
(* ; "
|
||||
Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FM-CREATORCOMS)
|
||||
|
||||
(RPAQQ FM-CREATORCOMS
|
||||
(RPAQQ FM-CREATORCOMS
|
||||
((PROP MAKEFILE-ENVIRONMENT FM-CREATOR)
|
||||
(* * FMC items record)
|
||||
(RECORDS FMC-ITEM)
|
||||
@@ -71,13 +74,14 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
|
||||
TITLEREG _ (CREATEREGION 2 2 70 28]
|
||||
(* *)
|
||||
(COMS (P [OR (SASSOC 'FMCreator BackgroundMenuCommands)
|
||||
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
|
||||
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
|
||||
|
||||
"Opens a Free Menu Creator window for use"
|
||||
]
|
||||
(SETQ BackgroundMenu NIL)))
|
||||
(CURSORS MOVINGCURSOR)))
|
||||
|
||||
(PUTPROPS FM-CREATOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(PUTPROPS FM-CREATOR MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(* * FMC items record)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -611,57 +615,66 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
|
||||
(* * FMC macros)
|
||||
|
||||
|
||||
(DEFMACRO FM-GET.ITEM.LABEL (ID.OR.LABEL WINDOW) (LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL
|
||||
WINDOW)
|
||||
''LABEL))
|
||||
(DEFMACRO FM-GET.ITEM.LABEL (ID.OR.LABEL WINDOW)
|
||||
(LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL WINDOW)
|
||||
''LABEL))
|
||||
|
||||
(DEFMACRO FM-GET.ITEM.STATE (ID.OR.LABEL WINDOW)
|
||||
(LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL WINDOW)
|
||||
''STATE))
|
||||
|
||||
(DEFMACRO FM-GET.ITEM.STATE (ID.OR.LABEL WINDOW) (LIST 'FM.ITEMPROP (LIST 'FM.GETITEM ID.OR.LABEL NIL
|
||||
WINDOW)
|
||||
''STATE))
|
||||
(DEFMACRO FMC-CLEAR.REGION (REGION WINDOW)
|
||||
(LIST 'DSPFILL REGION 'WHITESHADE ''REPLACE WINDOW))
|
||||
|
||||
(DEFMACRO FMC-GET.ITEM (ITEM FIELD)
|
||||
(LIST 'fetch `(FMC-ITEM ,FIELD)
|
||||
'of ITEM))
|
||||
|
||||
(DEFMACRO FMC-CLEAR.REGION (REGION WINDOW) (LIST 'DSPFILL REGION 'WHITESHADE ''REPLACE WINDOW))
|
||||
(DEFMACRO FMC-GROUP? (OBJECT)
|
||||
(LIST 'EQ `(FMC-GET.ITEM ,OBJECT TYPE)
|
||||
''GROUP))
|
||||
|
||||
(DEFMACRO FMC-MARK.AS.CHANGED (W)
|
||||
(LIST 'WINDOWPROP W ''FMC.CHANGED T))
|
||||
|
||||
(DEFMACRO FMC-GET.ITEM (ITEM FIELD) (LIST 'fetch `(FMC-ITEM ,FIELD) 'of ITEM))
|
||||
(DEFMACRO FMC-PUT.ITEM (ITEM FIELD VALUE)
|
||||
(LIST 'replace `(FMC-ITEM ,FIELD)
|
||||
'of ITEM 'with VALUE))
|
||||
|
||||
(DEFMACRO GET.REGION.BOTTOM (REGION)
|
||||
(LIST 'fetch '(REGION BOTTOM)
|
||||
'of REGION))
|
||||
|
||||
(DEFMACRO FMC-GROUP? (OBJECT) (LIST 'EQ `(FMC-GET.ITEM ,OBJECT TYPE) ''GROUP))
|
||||
(DEFMACRO GET.REGION.HEIGHT (REGION)
|
||||
(LIST 'fetch '(REGION HEIGHT)
|
||||
'of REGION))
|
||||
|
||||
(DEFMACRO GET.REGION.LEFT (REGION)
|
||||
(LIST 'fetch '(REGION LEFT)
|
||||
'of REGION))
|
||||
|
||||
(DEFMACRO FMC-MARK.AS.CHANGED (W) (LIST 'WINDOWPROP W ''FMC.CHANGED T))
|
||||
(DEFMACRO GET.REGION.WIDTH (REGION)
|
||||
(LIST 'fetch '(REGION WIDTH)
|
||||
'of REGION))
|
||||
|
||||
(DEFMACRO NULLSTR (STR)
|
||||
(LIST 'STREQUAL STR ""))
|
||||
|
||||
(DEFMACRO FMC-PUT.ITEM (ITEM FIELD VALUE) (LIST 'replace `(FMC-ITEM ,FIELD) 'of ITEM 'with VALUE))
|
||||
(DEFMACRO PUT.REGION.BOTTOM (REGION VALUE)
|
||||
(LIST 'replace '(REGION BOTTOM)
|
||||
'of REGION 'with VALUE))
|
||||
|
||||
(DEFMACRO PUT.REGION.HEIGHT (REGION VALUE)
|
||||
(LIST 'replace '(REGION HEIGHT)
|
||||
'of REGION 'with VALUE))
|
||||
|
||||
(DEFMACRO GET.REGION.BOTTOM (REGION) (LIST 'fetch '(REGION BOTTOM) 'of REGION))
|
||||
|
||||
|
||||
(DEFMACRO GET.REGION.HEIGHT (REGION) (LIST 'fetch '(REGION HEIGHT) 'of REGION))
|
||||
|
||||
|
||||
(DEFMACRO GET.REGION.LEFT (REGION) (LIST 'fetch '(REGION LEFT) 'of REGION))
|
||||
|
||||
|
||||
(DEFMACRO GET.REGION.WIDTH (REGION) (LIST 'fetch '(REGION WIDTH) 'of REGION))
|
||||
|
||||
|
||||
(DEFMACRO NULLSTR (STR) (LIST 'STREQUAL STR ""))
|
||||
|
||||
|
||||
(DEFMACRO PUT.REGION.BOTTOM (REGION VALUE) (LIST 'replace '(REGION BOTTOM) 'of REGION 'with VALUE))
|
||||
|
||||
|
||||
(DEFMACRO PUT.REGION.HEIGHT (REGION VALUE) (LIST 'replace '(REGION HEIGHT) 'of REGION 'with VALUE))
|
||||
|
||||
|
||||
(DEFMACRO PUT.REGION.LEFT (REGION VALUE) (LIST 'replace '(REGION LEFT) 'of REGION 'with VALUE))
|
||||
|
||||
|
||||
(DEFMACRO PUT.REGION.WIDTH (REGION VALUE) (LIST 'replace '(REGION WIDTH) 'of REGION 'with VALUE))
|
||||
(DEFMACRO PUT.REGION.LEFT (REGION VALUE)
|
||||
(LIST 'replace '(REGION LEFT)
|
||||
'of REGION 'with VALUE))
|
||||
|
||||
(DEFMACRO PUT.REGION.WIDTH (REGION VALUE)
|
||||
(LIST 'replace '(REGION WIDTH)
|
||||
'of REGION 'with VALUE))
|
||||
(* * Right menu functions)
|
||||
|
||||
(DEFINEQ
|
||||
@@ -1457,160 +1470,146 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
|
||||
(* * Property windows descriptions)
|
||||
|
||||
|
||||
(RPAQQ FMC-IP-DESC ((PROPS FORMAT EXPLICIT)
|
||||
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1
|
||||
FONT (MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-APPLY)
|
||||
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1
|
||||
FONT (MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-SHOW.ITEM)
|
||||
(LABEL NEW TYPE MOMENTARY LEFT 111 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1
|
||||
FONT (MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-NEWITEM)
|
||||
(LABEL TYPE TYPE STATE LEFT -1 BOTTOM 178 FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(MOMENTARY TOGGLE 3STATE STATE NWAY EDIT NUMBER EDITSTART DISPLAY)
|
||||
LINKS
|
||||
(DISPLAY TYPELINK)
|
||||
INITSTATE MOMENTARY)
|
||||
(LABEL MOMENTARY TYPE DISPLAY LEFT 31 BOTTOM 177 ID TYPELINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL LABEL TYPE MOMENTARY LEFT 113 BOTTOM 178 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-GET.LABEL LINKS (EDIT LABELLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 151 BOTTOM 177 ID LABELLINK FONT (MODERN 12 STANDARD)
|
||||
INITSTATE "IIIIMMMMMMMMMMMMMMM")
|
||||
(LABEL ID TYPE EDITSTART LEFT -1 BOTTOM 162 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT IDLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 14 BOTTOM 161 ID IDLINK FONT (MODERN 12 STANDARD)
|
||||
INITSTATE "")
|
||||
(LABEL FONT TYPE DISPLAY LEFT -1 BOTTOM 146 FONT (MODERN 12 ITALIC))
|
||||
(LABEL FAMILY TYPE STATE LEFT 32 BOTTOM 146 ID FAMILY FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(CLASSIC MODERN TERMINAL TITAN GACHA HELVETICA TIMESROMAN)
|
||||
LINKS
|
||||
(DISPLAY FAMILYLINK)
|
||||
INITSTATE GACHA)
|
||||
(LABEL GACHA TYPE DISPLAY LEFT 77 BOTTOM 145 ID FAMILYLINK FONT (MODERN 12
|
||||
(RPAQQ FMC-IP-DESC
|
||||
((PROPS FORMAT EXPLICIT)
|
||||
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
|
||||
(MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-APPLY)
|
||||
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
|
||||
(MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-SHOW.ITEM)
|
||||
(LABEL NEW TYPE MOMENTARY LEFT 111 BOTTOM 195 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
|
||||
(MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-NEWITEM)
|
||||
(LABEL TYPE TYPE STATE LEFT -1 BOTTOM 178 FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(MOMENTARY TOGGLE 3STATE STATE NWAY EDIT NUMBER EDITSTART DISPLAY)
|
||||
LINKS
|
||||
(DISPLAY TYPELINK)
|
||||
INITSTATE MOMENTARY)
|
||||
(LABEL MOMENTARY TYPE DISPLAY LEFT 31 BOTTOM 177 ID TYPELINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL LABEL TYPE MOMENTARY LEFT 113 BOTTOM 178 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-GET.LABEL LINKS (EDIT LABELLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 151 BOTTOM 177 ID LABELLINK FONT (MODERN 12 STANDARD)
|
||||
INITSTATE "IIIIMMMMMMMMMMMMMMM")
|
||||
(LABEL ID TYPE EDITSTART LEFT -1 BOTTOM 162 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT IDLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 14 BOTTOM 161 ID IDLINK FONT (MODERN 12 STANDARD)
|
||||
INITSTATE "")
|
||||
(LABEL FONT TYPE DISPLAY LEFT -1 BOTTOM 146 FONT (MODERN 12 ITALIC))
|
||||
(LABEL FAMILY TYPE STATE LEFT 32 BOTTOM 146 ID FAMILY FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(CLASSIC MODERN TERMINAL TITAN GACHA HELVETICA TIMESROMAN)
|
||||
LINKS
|
||||
(DISPLAY FAMILYLINK)
|
||||
INITSTATE GACHA)
|
||||
(LABEL GACHA TYPE DISPLAY LEFT 77 BOTTOM 145 ID FAMILYLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL SIZE TYPE STATE LEFT 161 BOTTOM 146 ID SIZE FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(6 7 8 9 10 11 12 14 18 24 30 36)
|
||||
LINKS
|
||||
(DISPLAY SIZELINK)
|
||||
INITSTATE 12)
|
||||
(LABEL 10 TYPE DISPLAY LEFT 191 BOTTOM 145 ID SIZELINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL FACE TYPE STATE LEFT 210 BOTTOM 146 ID FACE FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(REGULAR ITALIC BOLD BOLDITALIC)
|
||||
LINKS
|
||||
(DISPLAY FACELINK)
|
||||
INITSTATE BOLDITALIC)
|
||||
(LABEL REGULAR TYPE DISPLAY LEFT 241 BOTTOM 145 ID FACELINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL BOX TYPE STATE LEFT -1 BOTTOM 130 FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(0 1 2 3 4 5 6 7 8 9 10)
|
||||
LINKS
|
||||
(DISPLAY BOXLINK)
|
||||
INITSTATE 0)
|
||||
(LABEL 0 TYPE DISPLAY LEFT 26 BOTTOM 129 ID BOXLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL BOXSHADE TYPE STATE LEFT 40 BOTTOM 130 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 107 BOTTOM 130 ID BOXSHADELINK FONT (MODERN 12 STANDARD)
|
||||
MAXWIDTH 60)
|
||||
(LABEL BACKGROUND TYPE STATE LEFT 176 BOTTOM 130 ID BACKGROUND FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 262 BOTTOM 130 ID BACKGROUNDLINK FONT (MODERN 12 STANDARD)
|
||||
MAXWIDTH 60)
|
||||
(LABEL MENU TYPE STATE LEFT -1 BOTTOM 114 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-GET.MENUPROPS LINKS (DISPLAY MENULINK)
|
||||
INITSTATE "(NIL)")
|
||||
(LABEL "(NIL)" TYPE DISPLAY LEFT 39 BOTTOM 113 ID MENULINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL INITSTATE TYPE STATE LEFT 195 BOTTOM 114 ID INITSTATE FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-GET.INITSTATE LINKS (DISPLAY INITSTATELINK))
|
||||
(LABEL "#NOLABEL#" TYPE DISPLAY LEFT 257 BOTTOM 113 ID INITSTATELINK FONT (MODERN 12 STANDARD
|
||||
))
|
||||
(LABEL CHANGESTATE TYPE STATE LEFT -1 BOTTOM 98 ID CHANGESTATE FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY CHANGESTATELINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 89 BOTTOM 97 ID CHANGESTATELINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL SELECTEDFN TYPE STATE LEFT -1 BOTTOM 81 ID SELECTEDFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY SELECTEDFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 75 BOTTOM 80 ID SELECTEDFNLINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL "DOWNFN" TYPE STATE LEFT -1 BOTTOM 65 ID DOWNFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY DOWNFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 57 BOTTOM 64 ID DOWNFNLINK FONT (MODERN 12
|
||||
STANDARD))
|
||||
(LABEL "HELDFN" TYPE STATE LEFT -1 BOTTOM 49 ID HELDFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY HELDFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 49 BOTTOM 48 ID HELDFNLINK FONT (MODERN 12
|
||||
STANDARD))
|
||||
(LABEL "MOVEDFN" TYPE STATE LEFT -1 BOTTOM 33 ID MOVEDFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY MOVEDFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 62 BOTTOM 32 ID MOVEDFNLINK FONT (MODERN 12
|
||||
STANDARD))
|
||||
(LABEL SIZE TYPE STATE LEFT 161 BOTTOM 146 ID SIZE FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(6 7 8 9 10 11 12 14 18 24 30 36)
|
||||
LINKS
|
||||
(DISPLAY SIZELINK)
|
||||
INITSTATE 12)
|
||||
(LABEL 10 TYPE DISPLAY LEFT 191 BOTTOM 145 ID SIZELINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL FACE TYPE STATE LEFT 210 BOTTOM 146 ID FACE FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(REGULAR ITALIC BOLD BOLDITALIC)
|
||||
LINKS
|
||||
(DISPLAY FACELINK)
|
||||
INITSTATE BOLDITALIC)
|
||||
(LABEL REGULAR TYPE DISPLAY LEFT 241 BOTTOM 145 ID FACELINK FONT (MODERN 12
|
||||
STANDARD)
|
||||
)
|
||||
(LABEL BOX TYPE STATE LEFT -1 BOTTOM 130 FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(0 1 2 3 4 5 6 7 8 9 10)
|
||||
LINKS
|
||||
(DISPLAY BOXLINK)
|
||||
INITSTATE 0)
|
||||
(LABEL 0 TYPE DISPLAY LEFT 26 BOTTOM 129 ID BOXLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL BOXSHADE TYPE STATE LEFT 40 BOTTOM 130 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 107 BOTTOM 130 ID BOXSHADELINK FONT (MODERN 12
|
||||
STANDARD)
|
||||
MAXWIDTH 60)
|
||||
(LABEL BACKGROUND TYPE STATE LEFT 176 BOTTOM 130 ID BACKGROUND FONT
|
||||
(MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 262 BOTTOM 130 ID BACKGROUNDLINK FONT
|
||||
(MODERN 12 STANDARD)
|
||||
MAXWIDTH 60)
|
||||
(LABEL MENU TYPE STATE LEFT -1 BOTTOM 114 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-GET.MENUPROPS LINKS (DISPLAY MENULINK)
|
||||
INITSTATE "(NIL)")
|
||||
(LABEL "(NIL)" TYPE DISPLAY LEFT 39 BOTTOM 113 ID MENULINK FONT (MODERN 12
|
||||
STANDARD))
|
||||
(LABEL INITSTATE TYPE STATE LEFT 195 BOTTOM 114 ID INITSTATE FONT
|
||||
(MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-GET.INITSTATE LINKS (DISPLAY INITSTATELINK))
|
||||
(LABEL "#NOLABEL#" TYPE DISPLAY LEFT 257 BOTTOM 113 ID INITSTATELINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL CHANGESTATE TYPE STATE LEFT -1 BOTTOM 98 ID CHANGESTATE FONT
|
||||
(MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY CHANGESTATELINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 89 BOTTOM 97 ID CHANGESTATELINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL SELECTEDFN TYPE STATE LEFT -1 BOTTOM 81 ID SELECTEDFN FONT
|
||||
(MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY SELECTEDFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 75 BOTTOM 80 ID SELECTEDFNLINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL "DOWNFN" TYPE STATE LEFT -1 BOTTOM 65 ID DOWNFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY DOWNFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 57 BOTTOM 64 ID DOWNFNLINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL "HELDFN" TYPE STATE LEFT -1 BOTTOM 49 ID HELDFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY HELDFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 49 BOTTOM 48 ID HELDFNLINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL "MOVEDFN" TYPE STATE LEFT -1 BOTTOM 33 ID MOVEDFN FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-EDIT.FN LINKS (DISPLAY MOVEDFNLINK)
|
||||
INITSTATE "(FUNCTION NILL)")
|
||||
(LABEL "(FUNCTION NILL)" TYPE DISPLAY LEFT 62 BOTTOM 32 ID MOVEDFNLINK FONT
|
||||
(MODERN 12 STANDARD))
|
||||
(LABEL LINKS TYPE STATE LEFT -1 BOTTOM 16 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-LINKS LINKS (DISPLAY LINKSLINK)
|
||||
INITSTATE "(NIL)")
|
||||
(LABEL "(NIL)" TYPE DISPLAY LEFT 36 BOTTOM 15 ID LINKSLINK FONT (MODERN 12
|
||||
STANDARD))
|
||||
(LABEL "INFINITEWIDTH" TYPE TOGGLE LEFT 239 BOTTOM 16 ID INFINITEWIDTH FONT
|
||||
(MODERN 12 BOLD))
|
||||
(LABEL MESSAGE TYPE EDITSTART LEFT -1 BOTTOM 0 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT MESSAGELINK))
|
||||
(LABEL "" TYPE EDIT LEFT 61 BOTTOM -1 ID MESSAGELINK FONT (MODERN 12 STANDARD)
|
||||
INITSTATE "MMMMMMMMMMMMMMMMMMMMMMMM")))
|
||||
(LABEL LINKS TYPE STATE LEFT -1 BOTTOM 16 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-LINKS LINKS (DISPLAY LINKSLINK)
|
||||
INITSTATE "(NIL)")
|
||||
(LABEL "(NIL)" TYPE DISPLAY LEFT 36 BOTTOM 15 ID LINKSLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL "INFINITEWIDTH" TYPE TOGGLE LEFT 239 BOTTOM 16 ID INFINITEWIDTH FONT (MODERN 12 BOLD))
|
||||
(LABEL MESSAGE TYPE EDITSTART LEFT -1 BOTTOM 0 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT MESSAGELINK))
|
||||
(LABEL "" TYPE EDIT LEFT 61 BOTTOM -1 ID MESSAGELINK FONT (MODERN 12 STANDARD)
|
||||
INITSTATE "MMMMMMMMMMMMMMMMMMMMMMMM")))
|
||||
|
||||
(RPAQQ FMC-GP-DESC ((PROPS FORMAT EXPLICIT)
|
||||
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1
|
||||
FONT (MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-APPLY)
|
||||
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1
|
||||
FONT (MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-SHOW.GROUP)
|
||||
(LABEL "ID" TYPE EDITSTART LEFT 0 BOTTOM 83 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT IDLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 17 BOTTOM 82 ID IDLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL "COLLECTION" TYPE EDITSTART LEFT 0 BOTTOM 67 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT COLLECTIONLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 75 BOTTOM 66 ID COLLECTIONLINK FONT (MODERN 12 STANDARD)
|
||||
)
|
||||
(LABEL "DESELECT" ID DESELECT TYPE TOGGLE LEFT 0 BOTTOM 50 FONT (MODERN 12 BOLD))
|
||||
(LABEL BOX TYPE STATE LEFT 0 BOTTOM 33 FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(1 2 3 4 5 6 7 8 9 10)
|
||||
LINKS
|
||||
(DISPLAY BOXLINK)
|
||||
INITSTATE 1)
|
||||
(LABEL 1 TYPE DISPLAY LEFT 27 BOTTOM 32 ID BOXLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL BOXSHADE TYPE STATE LEFT 0 BOTTOM 16 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 16 ID BOXSHADELINK FONT (MODERN 12 STANDARD
|
||||
)
|
||||
MAXWIDTH 60)
|
||||
(LABEL BACKGROUND TYPE STATE LEFT 0 BOTTOM 0 ID BACKGROUND FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 0 ID BACKGROUNDLINK FONT (MODERN 12
|
||||
STANDARD)
|
||||
MAXWIDTH 60)))
|
||||
(RPAQQ FMC-GP-DESC
|
||||
((PROPS FORMAT EXPLICIT)
|
||||
(LABEL APPLY TYPE MOMENTARY LEFT 0 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
|
||||
(MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-APPLY)
|
||||
(LABEL SHOW TYPE MOMENTARY LEFT 49 BOTTOM 106 BOX 1 BOXSHADE 65535 BOXSPACE 1 FONT
|
||||
(MODERN 14 BOLDITALIC)
|
||||
SELECTEDFN FMC-SHOW.GROUP)
|
||||
(LABEL "ID" TYPE EDITSTART LEFT 0 BOTTOM 83 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT IDLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 17 BOTTOM 82 ID IDLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL "COLLECTION" TYPE EDITSTART LEFT 0 BOTTOM 67 FONT (MODERN 12 BOLD)
|
||||
LINKS
|
||||
(EDIT COLLECTIONLINK))
|
||||
(LABEL "" TYPE EDIT LEFT 75 BOTTOM 66 ID COLLECTIONLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL "DESELECT" ID DESELECT TYPE TOGGLE LEFT 0 BOTTOM 50 FONT (MODERN 12 BOLD))
|
||||
(LABEL BOX TYPE STATE LEFT 0 BOTTOM 33 FONT (MODERN 12 BOLD)
|
||||
MENUITEMS
|
||||
(1 2 3 4 5 6 7 8 9 10)
|
||||
LINKS
|
||||
(DISPLAY BOXLINK)
|
||||
INITSTATE 1)
|
||||
(LABEL 1 TYPE DISPLAY LEFT 27 BOTTOM 32 ID BOXLINK FONT (MODERN 12 STANDARD))
|
||||
(LABEL BOXSHADE TYPE STATE LEFT 0 BOTTOM 16 FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BOXSHADE LINKS (DISPLAY BOXSHADELINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 16 ID BOXSHADELINK FONT (MODERN 12 STANDARD)
|
||||
MAXWIDTH 60)
|
||||
(LABEL BACKGROUND TYPE STATE LEFT 0 BOTTOM 0 ID BACKGROUND FONT (MODERN 12 BOLD)
|
||||
SELECTEDFN FMC-CHOOSE.ITEM.BG LINKS (DISPLAY BACKGROUNDLINK))
|
||||
(LABEL "" TYPE DISPLAY LEFT 86 BOTTOM 0 ID BACKGROUNDLINK FONT (MODERN 12 STANDARD)
|
||||
MAXWIDTH 60)))
|
||||
(* * Creating bitmaps)
|
||||
|
||||
(DEFINEQ
|
||||
@@ -2671,30 +2670,35 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
|
||||
(DEFINEQ
|
||||
|
||||
(FMC-EDIT.INFO
|
||||
[LAMBDA (WINDOW) (* ; "Edited 17-Aug-88 16:57 by A.BLAVIER")
|
||||
|
||||
(* ;; "Create a %"dead%" TEdit window, listing a summary of the items.")
|
||||
[LAMBDA (WINDOW) (* ; "Edited 1-Feb-2022 17:08 by rmk")
|
||||
(* ; "Edited 17-Aug-88 16:57 by A.BLAVIER")
|
||||
|
||||
(* ;; "Create a %"dead%" TEdit window, listing a summary of the items.")
|
||||
|
||||
(LET ((ItemList (WINDOWPROP WINDOW 'ITEMLIST))
|
||||
Stream TEdWindow)
|
||||
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
|
||||
(SETQ Stream (OPENTEXTSTREAM ""))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF Stream))
|
||||
(FMC-PROMPTPRINT "Creating summary ..." WINDOW)
|
||||
(SETCURSOR WAITINGCURSOR)
|
||||
(FMC-SORT.ITEM.LIST ItemList)
|
||||
|
||||
(* ;; "")
|
||||
(RESETLST
|
||||
(RESETSAVE (CURSOR WAITINGCURSOR))
|
||||
(SETQ Stream (OPENTEXTSTREAM NIL))
|
||||
(RESETSAVE NIL (LIST 'CLOSEF Stream))
|
||||
(FMC-PROMPTPRINT "Creating summary ..." WINDOW)
|
||||
(SETCURSOR WAITINGCURSOR)
|
||||
(FMC-SORT.ITEM.LIST ItemList)
|
||||
|
||||
(PRINTOUT Stream .FONT '(MODERN 14 BOLD) "- Free Menu Creator Summary -" T T)
|
||||
(PRINTOUT Stream .FONT '(MODERN 10 REGULAR) (DATE)
|
||||
T T)
|
||||
(for item in ItemList do (FMC-EDIT.INFO.ITEM item Stream 0))
|
||||
(TEDIT.PARALOOKS Stream '(QUAD CENTERED) 1 2)
|
||||
(SETCURSOR DEFAULTCURSOR)
|
||||
(FMC-PROMPTPRINT "Creating summary ... done" WINDOW)
|
||||
(SETQ TEdWindow (CREATEW NIL "FMC Items Summary"))
|
||||
(OPENTEXTSTREAM Stream TEdWindow])
|
||||
(* ;; "")
|
||||
|
||||
(PRINTOUT Stream .FONT '(MODERN 14 BOLD)
|
||||
"- Free Menu Creator Summary -" T T)
|
||||
(PRINTOUT Stream .FONT '(MODERN 10 REGULAR)
|
||||
(DATE)
|
||||
T T)
|
||||
(for item in ItemList do (FMC-EDIT.INFO.ITEM item Stream 0))
|
||||
(TEDIT.PARALOOKS Stream '(QUAD CENTERED)
|
||||
1 2)
|
||||
(SETCURSOR DEFAULTCURSOR)
|
||||
(FMC-PROMPTPRINT "Creating summary ... done" WINDOW)
|
||||
(SETQ TEdWindow (CREATEW NIL "FMC Items Summary"))
|
||||
(OPENTEXTSTREAM Stream TEdWindow))])
|
||||
|
||||
(FMC-EDIT.INFO.ITEM
|
||||
[LAMBDA (ITEM STREAM SPACES) (* ; "Edited 8-Aug-88 17:00 by A.BLAVIER")
|
||||
@@ -3312,42 +3316,52 @@ Copyright (c) 1988 by Rank Xerox France. Author Andre BLAVIER. All rights reser
|
||||
(CREATEREGION 2 2 70 28)))
|
||||
(* *)
|
||||
|
||||
|
||||
[OR (SASSOC 'FMCreator BackgroundMenuCommands)
|
||||
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
|
||||
(NCONC1 BackgroundMenuCommands '(FMCreator '(FMC-CREATE)
|
||||
"Opens a Free Menu Creator window for use"]
|
||||
|
||||
(SETQ BackgroundMenu NIL)
|
||||
(RPAQ MOVINGCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@@A@@@CH@@ED@@A@@@A@@BA@HD@@DOLGND@@DBA@H@A@@@A@@@ED@@CH@@A@@
|
||||
) (QUOTE NIL) 7 7))
|
||||
(PUTPROPS FM-CREATOR COPYRIGHT ("Rank Xerox France. Author Andre BLAVIER" 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4362 15980 (FMC-CREATE 4372 . 10712) (FMC-INSTALL.IP.WINDOW 10714 . 13291) (
|
||||
FMC-INSTALL.GP.WINDOW 13293 . 14616) (FMC-CREATE.SHADE.MENU 14618 . 15281) (FMC-CREATE.SHADE.ITEM
|
||||
15283 . 15978)) (16015 29619 (FMC-BUTTONEVENTFN 16025 . 23020) (FMC-CLOSEFN 23022 . 23823) (
|
||||
FMC-COPYBUTTONEVENTFN 23825 . 24785) (FMC-COPYINSERTFN 24787 . 26407) (FMC-CURSORMOVEDFN 26409 . 27296
|
||||
) (FMC-CURSOROUTFN 27298 . 27459) (FMC-EXPANDFN 27461 . 27741) (FMC-ICONFN 27743 . 28755) (
|
||||
FMC-SHRINKFN 28757 . 29061) (FMC-WINDOWENTRYFN 29063 . 29617)) (31454 35400 (FMC-FIXRIGHTMENU 31464 .
|
||||
33117) (FMC-DORIGHTSELECTION 33119 . 35398)) (35433 42932 (FMC-SELECT.ITEM 35443 . 36551) (
|
||||
FMC-SELECT.LIST 36553 . 36874) (FMC-SELECT.LIST.ITEM 36876 . 37932) (FMC-SELECTALL 37934 . 38328) (
|
||||
FMC-GET.SELECTION 38330 . 40066) (FMC-DESELECT 40068 . 40446) (FMC-DESELECT.ITEM 40448 . 41526) (
|
||||
FMC-DESELECT.LIST 41528 . 41897) (FMC-DESELECT.LIST.ITEM 41899 . 42930)) (42972 71259 (FMC-APPLY 42982
|
||||
. 47323) (FMC-SHOW.ITEM 47325 . 52244) (FMC-SHOW.GROUP 52246 . 54394) (FMC-NEWITEM 54396 . 55927) (
|
||||
FMC-UPDATE.ITEM 55929 . 61952) (FMC-UPDATE.GROUP 61954 . 63772) (FMC-GET.LABEL 63774 . 64522) (
|
||||
FMC-CHOOSE.ITEM.BOXSHADE 64524 . 65106) (FMC-CHOOSE.ITEM.BG 65108 . 65695) (FMC-GET.MENUPROPS 65697 .
|
||||
66591) (FMC-GET.INITSTATE 66593 . 68971) (FMC-EDIT.FN 68973 . 69590) (FMC-LINKS 69592 . 71257)) (81842
|
||||
84551 (FMC-MAKEBITMAP 81852 . 82544) (FMC-COMPOUND.BITMAP 82546 . 84005) (FMC-SNAPBM 84007 . 84549))
|
||||
(84577 95636 (FMC-MOVE.SELECTION 84587 . 88458) (FMC-MOVE.BITMAP 88460 . 92852) (FMC-TRACK.NEW.ITEM
|
||||
92854 . 93904) (FMC-UPDATE.BM.POSITION 93906 . 94629) (FMC-UPDATE.REGION 94631 . 95634)) (95663 108537
|
||||
(FMC-COMPUTE.SHAPE.REGS 95673 . 97851) (FMC-SHAPE 97853 . 106662) (FMC-BOX.NEWREGIONFN 106664 .
|
||||
108106) (FMC-NOBOX.NEWREGIONFN 108108 . 108535)) (108566 110451 (FMC-REDRAW 108576 . 109224) (
|
||||
FMC-REDRAW.ITEM 109226 . 110449)) (110494 113925 (FMC-DELETE 110504 . 111854) (FMC-UNDELETE 111856 .
|
||||
113923)) (113962 117670 (FMC-GROUP 113972 . 116637) (FMC-UNGROUP 116639 . 117668)) (117710 127034 (
|
||||
FMC-ALIGN 117720 . 121191) (FMC-HCENTER 121193 . 123497) (FMC-VCENTER 123499 . 125877) (FMC-REL.MOVE
|
||||
125879 . 127032)) (127071 136665 (FMC-GET 127081 . 129946) (FMC-GET.ONE.OBJECT 129948 . 132185) (
|
||||
FMC-PUT 132187 . 134238) (FMC-PUT.OBJECT 134240 . 136663)) (136697 141636 (FMC-EDIT.INFO 136707 .
|
||||
137943) (FMC-EDIT.INFO.ITEM 137945 . 141634)) (141668 147722 (FMC-HARDCOPY 141678 . 144920) (
|
||||
FMC-HARDCOPY.ITEM 144922 . 147720)) (147764 155916 (FMC-COMPUTE 147774 . 149790) (FMC-COMPUTE.OBJECT
|
||||
149792 . 155914)) (155943 169254 (FMC-CREATE.ITEM.FROM.LIST 155953 . 157160) (FMC-DRAW.BOX 157162 .
|
||||
158498) (FMC-CHOOSE.WINDOW.BG 158500 . 159017) (FMC-DISPLAY.GRID 159019 . 159523) (FMC-SET.GRIDSIZE
|
||||
159525 . 160305) (FMC-FONT->LIST 160307 . 161008) (FMC-LIST->FONT 161010 . 161357) (FMC-SORT.ITEM.LIST
|
||||
161359 . 162401) (FMC-IMPORT 162403 . 168871) (FMC-PROMPTPRINT 168873 . 169252)))))
|
||||
(FILEMAP (NIL (4478 16096 (FMC-CREATE 4488 . 10828) (FMC-INSTALL.IP.WINDOW 10830 . 13407) (
|
||||
FMC-INSTALL.GP.WINDOW 13409 . 14732) (FMC-CREATE.SHADE.MENU 14734 . 15397) (FMC-CREATE.SHADE.ITEM
|
||||
15399 . 16094)) (16131 29735 (FMC-BUTTONEVENTFN 16141 . 23136) (FMC-CLOSEFN 23138 . 23939) (
|
||||
FMC-COPYBUTTONEVENTFN 23941 . 24901) (FMC-COPYINSERTFN 24903 . 26523) (FMC-CURSORMOVEDFN 26525 . 27412
|
||||
) (FMC-CURSOROUTFN 27414 . 27575) (FMC-EXPANDFN 27577 . 27857) (FMC-ICONFN 27859 . 28871) (
|
||||
FMC-SHRINKFN 28873 . 29177) (FMC-WINDOWENTRYFN 29179 . 29733)) (29760 29895 (FM-GET.ITEM.LABEL 29760
|
||||
. 29895)) (29897 30032 (FM-GET.ITEM.STATE 29897 . 30032)) (30034 30136 (FMC-CLEAR.REGION 30034 .
|
||||
30136)) (30138 30232 (FMC-GET.ITEM 30138 . 30232)) (30234 30332 (FMC-GROUP? 30234 . 30332)) (30334
|
||||
30412 (FMC-MARK.AS.CHANGED 30334 . 30412)) (30414 30528 (FMC-PUT.ITEM 30414 . 30528)) (30530 30625 (
|
||||
GET.REGION.BOTTOM 30530 . 30625)) (30627 30722 (GET.REGION.HEIGHT 30627 . 30722)) (30724 30815 (
|
||||
GET.REGION.LEFT 30724 . 30815)) (30817 30910 (GET.REGION.WIDTH 30817 . 30910)) (30912 30967 (NULLSTR
|
||||
30912 . 30967)) (30969 31084 (PUT.REGION.BOTTOM 30969 . 31084)) (31086 31201 (PUT.REGION.HEIGHT 31086
|
||||
. 31201)) (31203 31314 (PUT.REGION.LEFT 31203 . 31314)) (31316 31429 (PUT.REGION.WIDTH 31316 . 31429)
|
||||
) (31463 35409 (FMC-FIXRIGHTMENU 31473 . 33126) (FMC-DORIGHTSELECTION 33128 . 35407)) (35442 42941 (
|
||||
FMC-SELECT.ITEM 35452 . 36560) (FMC-SELECT.LIST 36562 . 36883) (FMC-SELECT.LIST.ITEM 36885 . 37941) (
|
||||
FMC-SELECTALL 37943 . 38337) (FMC-GET.SELECTION 38339 . 40075) (FMC-DESELECT 40077 . 40455) (
|
||||
FMC-DESELECT.ITEM 40457 . 41535) (FMC-DESELECT.LIST 41537 . 41906) (FMC-DESELECT.LIST.ITEM 41908 .
|
||||
42939)) (42981 71268 (FMC-APPLY 42991 . 47332) (FMC-SHOW.ITEM 47334 . 52253) (FMC-SHOW.GROUP 52255 .
|
||||
54403) (FMC-NEWITEM 54405 . 55936) (FMC-UPDATE.ITEM 55938 . 61961) (FMC-UPDATE.GROUP 61963 . 63781) (
|
||||
FMC-GET.LABEL 63783 . 64531) (FMC-CHOOSE.ITEM.BOXSHADE 64533 . 65115) (FMC-CHOOSE.ITEM.BG 65117 .
|
||||
65704) (FMC-GET.MENUPROPS 65706 . 66600) (FMC-GET.INITSTATE 66602 . 68980) (FMC-EDIT.FN 68982 . 69599)
|
||||
(FMC-LINKS 69601 . 71266)) (79657 82366 (FMC-MAKEBITMAP 79667 . 80359) (FMC-COMPOUND.BITMAP 80361 .
|
||||
81820) (FMC-SNAPBM 81822 . 82364)) (82392 93451 (FMC-MOVE.SELECTION 82402 . 86273) (FMC-MOVE.BITMAP
|
||||
86275 . 90667) (FMC-TRACK.NEW.ITEM 90669 . 91719) (FMC-UPDATE.BM.POSITION 91721 . 92444) (
|
||||
FMC-UPDATE.REGION 92446 . 93449)) (93478 106352 (FMC-COMPUTE.SHAPE.REGS 93488 . 95666) (FMC-SHAPE
|
||||
95668 . 104477) (FMC-BOX.NEWREGIONFN 104479 . 105921) (FMC-NOBOX.NEWREGIONFN 105923 . 106350)) (106381
|
||||
108266 (FMC-REDRAW 106391 . 107039) (FMC-REDRAW.ITEM 107041 . 108264)) (108309 111740 (FMC-DELETE
|
||||
108319 . 109669) (FMC-UNDELETE 109671 . 111738)) (111777 115485 (FMC-GROUP 111787 . 114452) (
|
||||
FMC-UNGROUP 114454 . 115483)) (115525 124849 (FMC-ALIGN 115535 . 119006) (FMC-HCENTER 119008 . 121312)
|
||||
(FMC-VCENTER 121314 . 123692) (FMC-REL.MOVE 123694 . 124847)) (124886 134480 (FMC-GET 124896 . 127761
|
||||
) (FMC-GET.ONE.OBJECT 127763 . 130000) (FMC-PUT 130002 . 132053) (FMC-PUT.OBJECT 132055 . 134478)) (
|
||||
134512 139571 (FMC-EDIT.INFO 134522 . 135878) (FMC-EDIT.INFO.ITEM 135880 . 139569)) (139603 145657 (
|
||||
FMC-HARDCOPY 139613 . 142855) (FMC-HARDCOPY.ITEM 142857 . 145655)) (145699 153851 (FMC-COMPUTE 145709
|
||||
. 147725) (FMC-COMPUTE.OBJECT 147727 . 153849)) (153878 167189 (FMC-CREATE.ITEM.FROM.LIST 153888 .
|
||||
155095) (FMC-DRAW.BOX 155097 . 156433) (FMC-CHOOSE.WINDOW.BG 156435 . 156952) (FMC-DISPLAY.GRID 156954
|
||||
. 157458) (FMC-SET.GRIDSIZE 157460 . 158240) (FMC-FONT->LIST 158242 . 158943) (FMC-LIST->FONT 158945
|
||||
. 159292) (FMC-SORT.ITEM.LIST 159294 . 160336) (FMC-IMPORT 160338 . 166806) (FMC-PROMPTPRINT 166808
|
||||
. 167187)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1137
lispusers/GITFNS
Normal file
1137
lispusers/GITFNS
Normal file
File diff suppressed because it is too large
Load Diff
BIN
lispusers/GITFNS.LCOM
Normal file
BIN
lispusers/GITFNS.LCOM
Normal file
Binary file not shown.
BIN
lispusers/GITFNS.TEDIT
Normal file
BIN
lispusers/GITFNS.TEDIT
Normal file
Binary file not shown.
@@ -1,19 +1,21 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "27-Nov-2020 09:47:44" {DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.;4 28861
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS IRM.LOOKUP)
|
||||
(FILECREATED " 3-Feb-2022 12:04:29" {DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>HELPSYS.;2 28963
|
||||
|
||||
previous date%: "27-Nov-2020 08:54:23" {DSK}<home>larry>ilisp>medley>lispusers>HELPSYS.;2)
|
||||
:CHANGES-TO (VARS HELPSYSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "27-Nov-2020 09:47:44"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>HELPSYS.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1985-1987, 2020 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT HELPSYSCOMS)
|
||||
|
||||
(RPAQQ HELPSYSCOMS
|
||||
[(FILES DINFO HASH)
|
||||
((FILES DINFO HASH)
|
||||
(RECORDS IRMREFERENCE)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
|
||||
DINFO HASH))
|
||||
@@ -58,23 +60,25 @@ Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
|
||||
(\IRM.KEYWORDS))
|
||||
(GLOBALVARS \IRM.HASHFILE \IRM.KEYWORDS)
|
||||
(FUNCTIONS \IRM.AROUND-EXIT)
|
||||
(ADDVARS (AROUNDEXITFNS \IRM.AROUND-EXIT])
|
||||
(ADDVARS (AROUNDEXITFNS \IRM.AROUND-EXIT))
|
||||
(PROP (FILETYPE)
|
||||
HELPSYS))))
|
||||
|
||||
(FILESLOAD DINFO HASH)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD IRMREFERENCE
|
||||
(* ;; "A reference to something in the IRM. There is a list of these for each entry in the index of the IRM. Each element of the list corresponds to one of the page references. These lists are stored under the ITEM in a hash file. ")
|
||||
(* ;; "A reference to something in the IRM. There is a list of these for each entry in the index of the IRM. Each element of the list corresponds to one of the page references. These lists are stored under the ITEM in a hash file. ")
|
||||
|
||||
(TYPE (* ; "The type of index entry -- typically a capitalized symbol in IL, eg. il:|Functions|. Yes, it's ugly.")
|
||||
ITEM (* ; "The name indexed")
|
||||
PRIMARYFLG (* ;
|
||||
"True iff this is the primary reference for this name/type")
|
||||
NODE (* ;
|
||||
"The ID of the node in the IRM DInfo graph containing this reference")
|
||||
CH# (* ; "The character number of the beginning of the reference. If unspecified we search for the first existence of NAME in the text of the node.")
|
||||
)
|
||||
(SYSTEM))
|
||||
(TYPE (* ; "The type of index entry -- typically a capitalized symbol in IL, eg. il:|Functions|. Yes, it's ugly.")
|
||||
ITEM (* ; "The name indexed")
|
||||
PRIMARYFLG (* ;
|
||||
"True iff this is the primary reference for this name/type")
|
||||
NODE (* ;
|
||||
"The ID of the node in the IRM DInfo graph containing this reference")
|
||||
CH# (* ; "The character number of the beginning of the reference. If unspecified we search for the first existence of NAME in the text of the node.")
|
||||
)
|
||||
(SYSTEM))
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -352,11 +356,11 @@ Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
|
||||
(RPAQ? IRM.CREF.FONT (FONTCREATE 'MODERN 8 'MRR))
|
||||
|
||||
(RPAQ? \IRM.CREF.IMAGEFNS (IMAGEFNSCREATE (FUNCTION IRM.DISPLAY.CREF)
|
||||
(FUNCTION IRM.CREF.BOX)
|
||||
(FUNCTION IRM.PUT.CREF)
|
||||
(FUNCTION IRM.GET.CREF)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION IRM.CREF.BUTTONEVENTFN)))
|
||||
(FUNCTION IRM.CREF.BOX)
|
||||
(FUNCTION IRM.PUT.CREF)
|
||||
(FUNCTION IRM.GET.CREF)
|
||||
(FUNCTION NILL)
|
||||
(FUNCTION IRM.CREF.BUTTONEVENTFN)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS IRM.CREF.FONT \IRM.CREF.IMAGEFNS)
|
||||
@@ -578,14 +582,16 @@ Copyright (c) 1985, 1986, 1987, 2020 by Xerox Corporation. All rights reserved.
|
||||
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT) (AND \IRM.HASHFILE (CLOSEHASHFILE \IRM.HASHFILE)))))
|
||||
|
||||
(ADDTOVAR AROUNDEXITFNS \IRM.AROUND-EXIT)
|
||||
|
||||
(PUTPROPS HELPSYS FILETYPE :FAKE-COMPILE-FILE)
|
||||
(PUTPROPS HELPSYS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 2020))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4149 8000 (HELPSYS 4159 . 5963) (IRM.LOOKUP 5965 . 7421) (IRM.SMART.LOOKUP 7423 . 7579)
|
||||
(IRM.RESET 7581 . 7998)) (8247 9766 (IRM.GET.DINFOGRAPH 8257 . 9128) (IRM.DISPLAY.REF 9130 . 9764)) (
|
||||
9768 10130 (IRM.LOAD-GRAPH 9768 . 10130)) (10455 16304 (IRM.DISPLAY.CREF 10465 . 12208) (IRM.CREF.BOX
|
||||
12210 . 13037) (IRM.PUT.CREF 13039 . 13264) (IRM.GET.CREF 13266 . 13637) (IRM.CREF.BUTTONEVENTFN 13639
|
||||
. 16302)) (16879 28427 (\IRM.GET.REF 16889 . 19643) (\IRM.SMART.REF 19645 . 21766) (\IRM.CHOOSE.REF
|
||||
21768 . 23114) (\IRM.WILD.REF 23116 . 25858) (\IRM.WILDCARD 25860 . 26238) (\IRM.WILD.MATCH 26240 .
|
||||
27478) (\IRM.GET.HASHFILE 27480 . 27943) (\IRM.GET.KEYWORDS 27945 . 28425)) (28564 28720 (
|
||||
\IRM.AROUND-EXIT 28564 . 28720)))))
|
||||
(FILEMAP (NIL (4215 8066 (HELPSYS 4225 . 6029) (IRM.LOOKUP 6031 . 7487) (IRM.SMART.LOOKUP 7489 . 7645)
|
||||
(IRM.RESET 7647 . 8064)) (8313 9832 (IRM.GET.DINFOGRAPH 8323 . 9194) (IRM.DISPLAY.REF 9196 . 9830)) (
|
||||
9834 10196 (IRM.LOAD-GRAPH 9834 . 10196)) (10521 16370 (IRM.DISPLAY.CREF 10531 . 12274) (IRM.CREF.BOX
|
||||
12276 . 13103) (IRM.PUT.CREF 13105 . 13330) (IRM.GET.CREF 13332 . 13703) (IRM.CREF.BUTTONEVENTFN 13705
|
||||
. 16368)) (16925 28473 (\IRM.GET.REF 16935 . 19689) (\IRM.SMART.REF 19691 . 21812) (\IRM.CHOOSE.REF
|
||||
21814 . 23160) (\IRM.WILD.REF 23162 . 25904) (\IRM.WILDCARD 25906 . 26284) (\IRM.WILD.MATCH 26286 .
|
||||
27524) (\IRM.GET.HASHFILE 27526 . 27989) (\IRM.GET.KEYWORDS 27991 . 28471)) (28610 28766 (
|
||||
\IRM.AROUND-EXIT 28610 . 28766)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,21 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "26-Sep-91 14:35:23" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>IDLEHAX.;2| 22593
|
||||
|
||||
changes to%: (FNS CONNECTPOLYS RANDOMPT KAL.ORAND)
|
||||
(VARS IDLEHAXCOMS)
|
||||
(RECORDS KALFIXP)
|
||||
(FILECREATED "15-Jan-2022 15:31:21" {DSK}<home>larry>medley>lispusers>IDLEHAX.;2 22517
|
||||
|
||||
previous date%: "10-Jun-88 17:50:01" |{PELE:MV:ENVOS}<LISPUSERS>MEDLEY>IDLEHAX.;1|)
|
||||
:CHANGES-TO (FNS CONNECTPOLYS)
|
||||
(VARS IDLEHAXCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Sep-91 14:35:23" {DSK}<home>larry>medley>lispusers>IDLEHAX.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1985-1988, 1991 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT IDLEHAXCOMS)
|
||||
|
||||
(RPAQQ IDLEHAXCOMS
|
||||
([COMS [ADDVARS (IDLE.FUNCTIONS (Lines 'LINES)
|
||||
((COMS [ADDVARS (IDLE.FUNCTIONS (Lines 'LINES)
|
||||
(Warp-Out 'WARP)
|
||||
(Radar 'WALKINGSPOKE)
|
||||
[Triangles (FUNCTION (LAMBDA (W)
|
||||
@@ -28,7 +28,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
|
||||
(Bubbles 'BUBBLES)
|
||||
(Kaleidoscope 'KALDEMO)
|
||||
(Windows 'IDLE-WINDOWS]
|
||||
(VARS (IDLE.DEFAULTFN 'LINES]
|
||||
(VARS (IDLE.DEFAULTFN 'LINES)
|
||||
(POLYGONWAIT3 250)))
|
||||
(COMS (* ; "for drawing polygons")
|
||||
(FNS POLYGONSDEMO POLYGONS CONNECTPOLYS DRAWPOLY1 RANDOMPT)
|
||||
(INITVARS (POLYGONSWINDOW))
|
||||
@@ -74,6 +75,8 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
|
||||
|
||||
(RPAQQ IDLE.DEFAULTFN LINES)
|
||||
|
||||
(RPAQQ POLYGONWAIT3 250)
|
||||
|
||||
|
||||
|
||||
(* ; "for drawing polygons")
|
||||
@@ -89,39 +92,39 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
|
||||
)
|
||||
|
||||
(CONNECTPOLYS
|
||||
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* lmm "30-Jul-85 17:19")
|
||||
[LAMBDA (FROMS TOS NSTEPS W OPERATION) (* ; "Edited 12-Jan-2022 15:22 by larry")
|
||||
(* lmm "30-Jul-85 17:19")
|
||||
(PROG (DIFFS)
|
||||
(CLEARW W)
|
||||
(LINES2 FROMS 3 W OPERATION)
|
||||
(SETQ DIFFS (for FPT in FROMS as TPT in TOS bind DX DY
|
||||
collect (SETQ DX (IQUOTIENT (IDIFFERENCE (fetch XC of TPT)
|
||||
(fetch XC of FPT))
|
||||
POLYGONSTEPS))
|
||||
(fetch XC of FPT))
|
||||
POLYGONSTEPS))
|
||||
(SETQ DY (IQUOTIENT (IDIFFERENCE (fetch YC of TPT)
|
||||
(fetch YC of FPT))
|
||||
POLYGONSTEPS))
|
||||
(replace XC of TPT with (IPLUS (fetch XC of FPT)
|
||||
(ITIMES POLYGONSTEPS DX)))
|
||||
(ITIMES POLYGONSTEPS DX)))
|
||||
(replace YC of TPT with (IPLUS (fetch YC of FPT)
|
||||
(ITIMES POLYGONSTEPS DY)))
|
||||
(ITIMES POLYGONSTEPS DY)))
|
||||
(CONS DX DY)))
|
||||
(LINES2 TOS 3 W OPERATION)
|
||||
(for FPT in FROMS as TPT in TOS do (DRAWLINE (fetch XC of
|
||||
FPT)
|
||||
(fetch YC of FPT)
|
||||
(fetch XC of TPT)
|
||||
(fetch YC of TPT)
|
||||
1 OPERATION W))
|
||||
(for FPT in FROMS as TPT in TOS do (DRAWLINE (fetch XC of FPT)
|
||||
(fetch YC of FPT)
|
||||
(fetch XC of TPT)
|
||||
(fetch YC of TPT)
|
||||
1 OPERATION W))
|
||||
(DISMISS POLYGONWAIT2)
|
||||
(CLEARW W)
|
||||
(for I from 1 to POLYGONSTEPS
|
||||
do (BLOCK)
|
||||
(LINES2 FROMS 1 W OPERATION)
|
||||
(for PT in FROMS as DIF in DIFFS
|
||||
do (add (fetch XC of PT)
|
||||
(CAR DIF))
|
||||
(add (fetch YC of PT)
|
||||
(CDR DIF))) finally (LINES2 FROMS 1 W OPERATION])
|
||||
(for I from 1 to POLYGONSTEPS do (DISMISS POLYGONWAIT3)
|
||||
(LINES2 FROMS 1 W OPERATION)
|
||||
(for PT in FROMS as DIF in DIFFS
|
||||
do (add (fetch XC of PT)
|
||||
(CAR DIF))
|
||||
(add (fetch YC of PT)
|
||||
(CDR DIF)))
|
||||
finally (LINES2 FROMS 1 W OPERATION])
|
||||
|
||||
(DRAWPOLY1
|
||||
(LAMBDA (PTLIST WIDTH OPERATION W NOBLOCK) (* edited%: "19-AUG-83 04:14") (* draws a closed polygon of the points given If OPERATION is not given, use the one from the default DS.) (COND (PTLIST (OR OPERATION (SETQ OPERATION (DSPOPERATION NIL W))) (PROG ((PTS PTLIST)) (while (CDR PTS) do (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CADR PTS)) (fetch YC of (CADR PTS)) WIDTH OPERATION W) (pop PTS) finally (DRAWLINE (fetch XC of (CAR PTS)) (fetch YC of (CAR PTS)) (fetch XC of (CAR PTLIST)) (fetch YC of (CAR PTLIST)) WIDTH OPERATION W))))) (COND (NOBLOCK (ALLOW.BUTTON.EVENTS)) (T (BLOCK))))
|
||||
@@ -151,7 +154,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE NPOINT ((XC XPOINTER)
|
||||
(YC XPOINTER)))
|
||||
(YC XPOINTER)))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'NPOINT '(XPOINTER XPOINTER)
|
||||
@@ -363,7 +366,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
|
||||
(RPAQQ MELT-BLOCK-SIZE 32)
|
||||
|
||||
(ADDTOVAR IDLE.FUNCTIONS ("Melt screen" 'IDLE-MELT)
|
||||
("Slide screen" 'IDLE-SLIDE))
|
||||
("Slide screen" 'IDLE-SLIDE))
|
||||
|
||||
|
||||
|
||||
@@ -382,18 +385,17 @@ Copyright (c) 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights res
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS PERIODIC.BLOCK MACRO [(TIMER)
|
||||
(if (TIMEREXPIRED? TIMER 'TICKS)
|
||||
then (BLOCK)
|
||||
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS
|
||||
'MILLISECONDS])
|
||||
(if (TIMEREXPIRED? TIMER 'TICKS)
|
||||
then (BLOCK)
|
||||
(SETQ TIMER (SETUPTIMER 100 TIMER 'TICKS 'MILLISECONDS])
|
||||
)
|
||||
(PUTPROPS IDLEHAX COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3587 7576 (POLYGONSDEMO 3597 . 3767) (POLYGONS 3769 . 4133) (CONNECTPOLYS 4135 . 6482)
|
||||
(DRAWPOLY1 6484 . 7121) (RANDOMPT 7123 . 7574)) (8217 11199 (KALDEMO 8227 . 9638) (KAL.ADVANCE 9640 .
|
||||
10041) (KAL.SPOTS 10043 . 10384) (KAL.BMS 10386 . 10873) (KAL.ORAND 10875 . 11197)) (11236 12722 (
|
||||
BUBBLES 11246 . 12352) (BUBBLE.CREATE 12354 . 12720)) (12749 13734 (IDLE-WINDOWS 12759 . 13732)) (
|
||||
13769 16040 (LINES 13779 . 14838) (LINES1 14840 . 15250) (LINES2 15252 . 15563) (LINES3 15565 . 16038)
|
||||
) (16100 17313 (WALKINGSPOKE 16110 . 16891) (WARP 16893 . 17311)) (17338 21621 (IDLE-MELT 17348 .
|
||||
19864) (IDLE-SLIDE 19866 . 21619)) (21796 22042 (DEMOWINDOW 21806 . 22040)))))
|
||||
(FILEMAP (NIL (3562 7602 (POLYGONSDEMO 3572 . 3742) (POLYGONS 3744 . 4108) (CONNECTPOLYS 4110 . 6508)
|
||||
(DRAWPOLY1 6510 . 7147) (RANDOMPT 7149 . 7600)) (8239 11221 (KALDEMO 8249 . 9660) (KAL.ADVANCE 9662 .
|
||||
10063) (KAL.SPOTS 10065 . 10406) (KAL.BMS 10408 . 10895) (KAL.ORAND 10897 . 11219)) (11258 12744 (
|
||||
BUBBLES 11268 . 12374) (BUBBLE.CREATE 12376 . 12742)) (12771 13756 (IDLE-WINDOWS 12781 . 13754)) (
|
||||
13791 16062 (LINES 13801 . 14860) (LINES1 14862 . 15272) (LINES2 15274 . 15585) (LINES3 15587 . 16060)
|
||||
) (16122 17335 (WALKINGSPOKE 16132 . 16913) (WARP 16915 . 17333)) (17360 21643 (IDLE-MELT 17370 .
|
||||
19886) (IDLE-SLIDE 19888 . 21641)) (21814 22060 (DEMOWINDOW 21824 . 22058)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
227
lispusers/LIFE
227
lispusers/LIFE
@@ -1,119 +1,156 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
|
||||
(filecreated "20-Aug-88 12:18:43" {erinyes}<lispusers>medley>life.\;5 8231
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
|previous| |date:| " 6-Mar-87 19:11:20" {erinyes}<lispusers>medley>life.\;3)
|
||||
(FILECREATED " 6-Dec-2021 15:21:48" |{DSK}<home>medley>medley>lispusers>LIFE.;3| 9875
|
||||
|
||||
|changes| |to:| (VARS LIFECOMS)
|
||||
(FNS EXPAND.BITMAP.VERTICALLY)
|
||||
|
||||
|previous| |date:| "20-Aug-88 12:18:43" |{DSK}<home>medley>medley>lispusers>LIFE.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1987-1988 by Xerox Corporation.
|
||||
|
||||
(prettycomprint lifecoms)
|
||||
(PRETTYCOMPRINT LIFECOMS)
|
||||
|
||||
(rpaqq lifecoms
|
||||
((functions |Life| |LifeIdle|)
|
||||
(fns expand.bitmap.vertically expand.bitmap.horizontally)
|
||||
(addvars (idle.functions ("Life" '|LifeIdle| nil (subitems ("Single bits" '|LifeIdle|)
|
||||
("Double bits" '(lambda (\w)
|
||||
(RPAQQ LIFECOMS
|
||||
((PROP FILETYPE LIFE)
|
||||
(FUNCTIONS |Life| |LifeIdle|)
|
||||
(FNS EXPAND.BITMAP.VERTICALLY EXPAND.BITMAP.HORIZONTALLY)
|
||||
(ADDVARS (IDLE.FUNCTIONS ("Life" '|LifeIdle| NIL (SUBITEMS ("Single bits" '|LifeIdle|)
|
||||
("Double bits" '(LAMBDA (\w)
|
||||
(|LifeIdle|
|
||||
\w 2)))
|
||||
("Quadruple bits"
|
||||
'(lambda (\w)
|
||||
'(LAMBDA (\w)
|
||||
(|LifeIdle| \w 4)))
|
||||
("Eight bits" '(lambda (\w)
|
||||
("Eight bits" '(LAMBDA (\w)
|
||||
(|LifeIdle|
|
||||
\w 8)))))))))
|
||||
|
||||
(cl:defun |Life| (win &optional (n 1))
|
||||
(let* ((w (windowprop win 'width))
|
||||
(w1 (idifference w n))
|
||||
(h (iquotient (windowprop win 'height)
|
||||
n))
|
||||
(h1 (sub1 h))
|
||||
(a (bitmapcreate w h))
|
||||
(b (bitmapcreate w h))
|
||||
(c (bitmapcreate w h))
|
||||
(d (bitmapcreate w h))
|
||||
(e (bitmapcreate w h))
|
||||
pbt temp)
|
||||
(|if| (neq n 1)
|
||||
|then| (setq temp (bitmapcreate (iquotient w n)
|
||||
h))
|
||||
(setq pbt (|create| pilotbbt))
|
||||
(bitblt win 0 0 temp 0 0)
|
||||
(expand.bitmap.horizontally temp n a pbt)
|
||||
(setq temp (bitmapcreate w (windowprop win 'height)))
|
||||
(bitblt a 0 0 temp 0 0 w h)
|
||||
|else| (bitblt win 0 0 a 0 0 w h))
|
||||
(cl:loop (block)
|
||||
(cl:macrolet ((bitbltbitmap (source sourceleft sourcebottom destination
|
||||
destinationleft destinationbottom width height
|
||||
&optional sourcetype operation)
|
||||
`(\\bitblt.bitmap ,source ,sourceleft ,sourcebottom
|
||||
,destination ,destinationleft ,destinationbottom
|
||||
,width
|
||||
,height
|
||||
,sourcetype
|
||||
,operation nil nil ,sourceleft ,sourcebottom))
|
||||
(shuffle (inhi lo horiz?)
|
||||
`(progn ,@(|if| horiz?
|
||||
|then| `((bitbltbitmap ,inhi n 0 ,lo 0 0 w1 h)
|
||||
(bitbltbitmap ,inhi 0 0 ,lo w1 0 n h)
|
||||
(bitbltbitmap ,inhi 0 0 c n 0 w1 h)
|
||||
(bitbltbitmap ,inhi w1 0 c 0 0 n h))
|
||||
|else| `((bitbltbitmap ,inhi 0 1 ,lo 0 0 w h1)
|
||||
(bitbltbitmap ,inhi 0 0 ,lo 0 h1 w 1)
|
||||
(bitbltbitmap ,inhi 0 0 c 0 1 w h1)
|
||||
(bitbltbitmap ,inhi 0 h1 c 0 0 w 1)))
|
||||
(bitbltbitmap c 0 0 ,lo 0 0 w h 'input 'invert)
|
||||
(bitbltbitmap ,lo 0 0 c 0 0 w h 'input 'erase)
|
||||
(bitbltbitmap ,inhi 0 0 ,lo 0 0 w h 'input 'invert)
|
||||
(bitbltbitmap ,lo 0 0 ,inhi 0 0 w h 'input 'erase)
|
||||
(bitbltbitmap c 0 0 ,inhi 0 0 w h 'input 'paint))))
|
||||
(shuffle a b t)
|
||||
(shuffle b d nil)
|
||||
(shuffle a e nil)
|
||||
(bitbltbitmap d 0 0 c 0 0 w h)
|
||||
(bitbltbitmap b 0 0 c 0 0 w h 'input 'invert)
|
||||
(bitbltbitmap e 0 0 c 0 0 w h 'input 'invert)
|
||||
(|if| (eq n 1)
|
||||
|then| (bitblt win 0 0 d 0 0 w h 'input 'paint)
|
||||
|else| (bitbltbitmap temp 0 0 d 0 0 w h 'input 'paint))
|
||||
(|if| (shiftdownp 'ctrl)
|
||||
|then| (bitbltbitmap d 0 0 a 0 0 w h)
|
||||
|else| (bitbltbitmap b 0 0 e 0 0 w h 'input 'paint)
|
||||
(bitbltbitmap e 0 0 a 0 0 w h 'input 'invert)
|
||||
(bitbltbitmap c 0 0 a 0 0 w h 'input 'erase)
|
||||
(bitbltbitmap d 0 0 a 0 0 w h 'invert 'erase))
|
||||
(|if| (eq n 1)
|
||||
|then| (bitblt a 0 0 win 0 0 w h)
|
||||
|else| (expand.bitmap.vertically a n temp pbt)
|
||||
(bitblt temp 0 0 win 0 0)
|
||||
(bitbltbitmap a 0 0 temp 0 0 w h))))))
|
||||
(PUTPROPS LIFE FILETYPE :COMPILE-FILE)
|
||||
|
||||
(cl:defun |LifeIdle| (\w &optional (\n 1))
|
||||
(bitblt (windowprop \w 'imagecovered)
|
||||
(CL:DEFUN |Life| (WIN &OPTIONAL (N 1))
|
||||
(LET* ((W (WINDOWPROP WIN 'WIDTH))
|
||||
(W1 (IDIFFERENCE W N))
|
||||
(H (IQUOTIENT (WINDOWPROP WIN 'HEIGHT)
|
||||
N))
|
||||
(H1 (SUB1 H))
|
||||
(A (BITMAPCREATE W H))
|
||||
(B (BITMAPCREATE W H))
|
||||
(C (BITMAPCREATE W H))
|
||||
(D (BITMAPCREATE W H))
|
||||
(E (BITMAPCREATE W H))
|
||||
PBT TEMP)
|
||||
(|if| (NEQ N 1)
|
||||
|then| (SETQ TEMP (BITMAPCREATE (IQUOTIENT W N)
|
||||
H))
|
||||
(SETQ PBT (|create| PILOTBBT))
|
||||
(BITBLT WIN 0 0 TEMP 0 0)
|
||||
(EXPAND.BITMAP.HORIZONTALLY TEMP N A PBT)
|
||||
(SETQ TEMP (BITMAPCREATE W (WINDOWPROP WIN 'HEIGHT)))
|
||||
(BITBLT A 0 0 TEMP 0 0 W H)
|
||||
|else| (BITBLT WIN 0 0 A 0 0 W H))
|
||||
(CL:LOOP (BLOCK)
|
||||
(CL:MACROLET ((BITBLTBITMAP (SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION
|
||||
DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT
|
||||
&OPTIONAL SOURCETYPE OPERATION)
|
||||
`(\\BITBLT.BITMAP ,SOURCE ,SOURCELEFT ,SOURCEBOTTOM
|
||||
,DESTINATION ,DESTINATIONLEFT ,DESTINATIONBOTTOM
|
||||
,WIDTH
|
||||
,HEIGHT
|
||||
,SOURCETYPE
|
||||
,OPERATION NIL NIL ,SOURCELEFT ,SOURCEBOTTOM))
|
||||
(SHUFFLE (INHI LO HORIZ?)
|
||||
`(PROGN ,@(|if| HORIZ?
|
||||
|then| `((BITBLTBITMAP ,INHI N 0 ,LO 0 0 W1 H)
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO W1 0 N H)
|
||||
(BITBLTBITMAP ,INHI 0 0 C N 0 W1 H)
|
||||
(BITBLTBITMAP ,INHI W1 0 C 0 0 N H))
|
||||
|else| `((BITBLTBITMAP ,INHI 0 1 ,LO 0 0 W H1)
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO 0 H1 W 1)
|
||||
(BITBLTBITMAP ,INHI 0 0 C 0 1 W H1)
|
||||
(BITBLTBITMAP ,INHI 0 H1 C 0 0 W 1)))
|
||||
(BITBLTBITMAP C 0 0 ,LO 0 0 W H 'INPUT 'INVERT)
|
||||
(BITBLTBITMAP ,LO 0 0 C 0 0 W H 'INPUT 'ERASE)
|
||||
(BITBLTBITMAP ,INHI 0 0 ,LO 0 0 W H 'INPUT 'INVERT)
|
||||
(BITBLTBITMAP ,LO 0 0 ,INHI 0 0 W H 'INPUT 'ERASE)
|
||||
(BITBLTBITMAP C 0 0 ,INHI 0 0 W H 'INPUT 'PAINT))))
|
||||
(SHUFFLE A B T)
|
||||
(SHUFFLE B D NIL)
|
||||
(SHUFFLE A E NIL)
|
||||
(BITBLTBITMAP D 0 0 C 0 0 W H)
|
||||
(BITBLTBITMAP B 0 0 C 0 0 W H 'INPUT 'INVERT)
|
||||
(BITBLTBITMAP E 0 0 C 0 0 W H 'INPUT 'INVERT)
|
||||
(|if| (EQ N 1)
|
||||
|then| (BITBLT WIN 0 0 D 0 0 W H 'INPUT 'PAINT)
|
||||
|else| (BITBLTBITMAP TEMP 0 0 D 0 0 W H 'INPUT 'PAINT))
|
||||
(|if| (SHIFTDOWNP 'CTRL)
|
||||
|then| (BITBLTBITMAP D 0 0 A 0 0 W H)
|
||||
|else| (BITBLTBITMAP B 0 0 E 0 0 W H 'INPUT 'PAINT)
|
||||
(BITBLTBITMAP E 0 0 A 0 0 W H 'INPUT 'INVERT)
|
||||
(BITBLTBITMAP C 0 0 A 0 0 W H 'INPUT 'ERASE)
|
||||
(BITBLTBITMAP D 0 0 A 0 0 W H 'INVERT 'ERASE))
|
||||
(|if| (EQ N 1)
|
||||
|then| (BITBLT A 0 0 WIN 0 0 W H)
|
||||
|else| (EXPAND.BITMAP.VERTICALLY A N TEMP PBT)
|
||||
(BITBLT TEMP 0 0 WIN 0 0)
|
||||
(BITBLTBITMAP A 0 0 TEMP 0 0 W H))))))
|
||||
|
||||
(CL:DEFUN |LifeIdle| (\w &OPTIONAL (\n 1))
|
||||
(BITBLT (WINDOWPROP \w 'IMAGECOVERED)
|
||||
0 0 \w)
|
||||
(|Life| \w \n))
|
||||
(defineq
|
||||
(|Life| \w \n))
|
||||
(DEFINEQ
|
||||
|
||||
(expand.bitmap.vertically
|
||||
(lambda (bitmap m bm2 pbt) (* \; "Edited 6-Mar-87 15:02 by Masinter") (or bm2 (setq bm2 (bitmapcreate (|fetch| bitmapwidth bitmap) (times m (|fetch| bitmapheight bitmap))))) (or pbt (setq pbt (|create| pilotbbt))) (|with| pilotbbt pbt (*) (setq pbtdesthi (|ffetch| |BitMapHiLoc| bm2)) (setq pbtdestlo (|ffetch| |BitMapLoLoc| bm2)) (setq pbtsourcehi (|ffetch| |BitMapHiLoc| bitmap)) (setq pbtsourcelo (|ffetch| |BitMapLoLoc| bitmap)) (setq pbtdestbpl (times 16 m (|ffetch| bitmaprasterwidth bm2))) (setq pbtsourcebpl (times 16 (|ffetch| bitmaprasterwidth bitmap))) (setq pbtsourcebit 0) (setq pbtdestbit 0) (setq pbtflags 16384) (setq pbtheight (|fetch| bitmapheight bitmap)) (setq pbtwidth (|fetch| bitmapwidth bitmap)) (|for| i |from| 0 |while| (lessp i m) |do| (\\pilotbitblt pbt 0) (|add| pbtdestlo (|fetch| bitmaprasterwidth bm2)))) bm2)
|
||||
)
|
||||
(EXPAND.BITMAP.VERTICALLY
|
||||
(LAMBDA (BITMAP M BM2 PBT) (* \;
|
||||
"Edited 6-Dec-2021 15:04 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 14:47 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 13:54 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 13:51 by medley")
|
||||
(* \;
|
||||
"Edited 6-Dec-2021 13:11 by medley")
|
||||
(* \;
|
||||
"Edited 6-Mar-87 15:02 by Masinter")
|
||||
(OR BM2 (SETQ BM2 (BITMAPCREATE (|fetch| BITMAPWIDTH BITMAP)
|
||||
(TIMES M (|fetch| BITMAPHEIGHT BITMAP)))))
|
||||
(OR PBT (SETQ PBT (|create| PILOTBBT)))
|
||||
(|with| PILOTBBT PBT (*)
|
||||
(SETQ PBTDESTHI (|ffetch| |BitMapHiLoc| BM2))
|
||||
(SETQ PBTDESTLO (|ffetch| |BitMapLoLoc| BM2))
|
||||
(SETQ PBTSOURCEHI (|ffetch| |BitMapHiLoc| BITMAP))
|
||||
(SETQ PBTSOURCELO (|ffetch| |BitMapLoLoc| BITMAP))
|
||||
(SETQ PBTDESTBPL (TIMES 16 M (|ffetch| BITMAPRASTERWIDTH BM2)))
|
||||
(SETQ PBTSOURCEBPL (TIMES 16 (|ffetch| BITMAPRASTERWIDTH BITMAP)))
|
||||
(SETQ PBTSOURCEBIT 0)
|
||||
(SETQ PBTDESTBIT 0)
|
||||
(SETQ PBTFLAGS 16384)
|
||||
(SETQ PBTHEIGHT (|fetch| BITMAPHEIGHT BITMAP))
|
||||
(SETQ PBTWIDTH (|fetch| BITMAPWIDTH BITMAP))
|
||||
(|for| I |from| 1 |to| M |do| (\\PILOTBITBLT PBT 0)
|
||||
(|add| PBTDESTLO (|fetch|
|
||||
BITMAPRASTERWIDTH
|
||||
|of| BM2))))
|
||||
BM2))
|
||||
|
||||
(expand.bitmap.horizontally
|
||||
(lambda (bitmap n bm2 pbt) (* \; "Edited 6-Mar-87 17:08 by Masinter") (or bm2 (setq bm2 (bitmapcreate (times n (|fetch| bitmapwidth bitmap)) (|fetch| bitmapheight bitmap)))) (or pbt (setq pbt (|create| pilotbbt))) (let ((sourcebase (|fetch| bitmapbase bitmap)) (destbase (|fetch| bitmapbase bm2))) (|with| pilotbbt pbt (setq pbtdestbpl n) (setq pbtsourcebpl 1) (setq pbtsourcebit 0) (setq pbtflags 16384) (setq pbtwidth 1) (let ((ht (times (|fetch| bitmapwidth bitmap) (|fetch| bitmapheight bitmap)))) (|do| (setq pbtdest destbase) (setq pbtsource sourcebase) (setq pbtheight (min (times 1024 16) ht)) (setq pbtdestbit 0) (|for| i |from| 0 |while| (lessp i n) |do| (\\pilotbitblt pbt 0) (|add| pbtdestbit 1)) (setq ht (- ht (times 1024 16))) (|if| (leq ht 0) |then| (return)) (setq destbase (\\addbase destbase (times n 1024))) (setq sourcebase (\\addbase sourcebase 1024)))))) bm2)
|
||||
)
|
||||
)
|
||||
|
||||
(addtovar idle.functions
|
||||
("Life" '|LifeIdle| nil (subitems ("Single bits" '|LifeIdle|)
|
||||
("Double bits" '(lambda (\w)
|
||||
(ADDTOVAR IDLE.FUNCTIONS
|
||||
("Life" '|LifeIdle| NIL (SUBITEMS ("Single bits" '|LifeIdle|)
|
||||
("Double bits" '(LAMBDA (\w)
|
||||
(|LifeIdle| \w 2)))
|
||||
("Quadruple bits" '(lambda (\w)
|
||||
("Quadruple bits" '(LAMBDA (\w)
|
||||
(|LifeIdle| \w 4)))
|
||||
("Eight bits" '(lambda (\w)
|
||||
("Eight bits" '(LAMBDA (\w)
|
||||
(|LifeIdle| \w 8))))))
|
||||
(putprops life copyright ("Xerox Corporation" 1987 1988))
|
||||
(declare\: dontcopy
|
||||
(filemap (nil (5774 7579 (expand.bitmap.vertically 5784 . 6658) (expand.bitmap.horizontally 6660 .
|
||||
7577)))))
|
||||
stop
|
||||
(PUTPROPS LIFE COPYRIGHT ("Xerox Corporation" 1987 1988))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (1557 5825 (|Life| 1557 . 5825)) (5827 5955 (|LifeIdle| 5827 . 5955)) (5956 9223 (
|
||||
EXPAND.BITMAP.VERTICALLY 5966 . 8302) (EXPAND.BITMAP.HORIZONTALLY 8304 . 9221)))))
|
||||
STOP
|
||||
|
||||
BIN
lispusers/LIFE.DFASL
Normal file
BIN
lispusers/LIFE.DFASL
Normal file
Binary file not shown.
Binary file not shown.
@@ -1,14 +1,16 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "23-Feb-89 13:20:33" |{FS8:PARC:XEROX}<BOBROW>LISP>LOOKUPINFILES.;20| 32443
|
||||
|
||||
changes to%: (FNS Lookup-CacheFile)
|
||||
(VARS LOOKUPINFILESCOMS)
|
||||
(FILECREATED " 1-Feb-2022 17:00:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>LOOKUPINFILES.;2 32247
|
||||
|
||||
previous date%: "23-Feb-89 09:48:41" |{FS8:PARC:XEROX}<BOBROW>LISP>LOOKUPINFILES.;19|)
|
||||
:CHANGES-TO (FNS MakeLookupWindow ShowLookUpString)
|
||||
|
||||
:PREVIOUS-DATE "23-Feb-89 13:20:33"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>LOOKUPINFILES.;1)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1986, 1988, 1989 by Xerox Corporation. All rights reserved.
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1988-1989 by Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LOOKUPINFILESCOMS)
|
||||
@@ -16,7 +18,7 @@ Copyright (c) 1986, 1988, 1989 by Xerox Corporation. All rights reserved.
|
||||
(RPAQQ LOOKUPINFILESCOMS
|
||||
(
|
||||
|
||||
(* ;;; "Fast lookup in files")
|
||||
(* ;;; "Fast lookup in files")
|
||||
|
||||
(LOCALVARS . T)
|
||||
(SPECVARS PROMPTWINDOW)
|
||||
@@ -414,10 +416,11 @@ to close this Lookup window?
|
||||
until (NOT (OPENWP w])
|
||||
|
||||
(MakeLookupWindow
|
||||
[LAMBDA (fileList processName editRegion iconBM iconMask iconPosition iconTitle)
|
||||
(* ; "Edited 25-Jan-89 13:37 by dgb:")
|
||||
[LAMBDA (fileList processName editRegion iconBM iconMask iconPosition iconTitle)
|
||||
(* ; "Edited 1-Feb-2022 16:59 by rmk")
|
||||
(* ; "Edited 25-Jan-89 13:37 by dgb:")
|
||||
|
||||
(* ;; "Compute defaults")
|
||||
(* ;; "Compute defaults")
|
||||
|
||||
(LET [(window (CREATEMENUEDWINDOW (create MENU
|
||||
CENTERFLG _ T
|
||||
@@ -430,20 +433,20 @@ to close this Lookup window?
|
||||
'TOP
|
||||
(OR editRegion LOOKUP-DEFAULT-EDITREGION]
|
||||
|
||||
(* ;;; "Create Menued window with prompt")
|
||||
(* ;;; "Create Menued window with prompt")
|
||||
|
||||
(GETPROMPTWINDOW window 2 '(HELVETICA 12 BOLD))
|
||||
|
||||
(* ;;; "Create icon")
|
||||
(* ;;; "Create icon")
|
||||
|
||||
(Lookup-MakeIconWindow window iconBM iconMask iconPosition iconTitle)
|
||||
|
||||
(* ;;; "Opening starts process, and checks if caching needed")
|
||||
(* ;;; "Opening starts process, and checks if caching needed")
|
||||
|
||||
(WINDOWADDPROP window 'OPENFN (FUNCTION Lookup-WhenOpenedFn))
|
||||
(WINDOWADDPROP window 'EXPANDFN (FUNCTION Lookup-WhenOpenedFn))
|
||||
|
||||
(* ;;; "Shrinking and closing kills the process. ")
|
||||
(* ;;; "Shrinking and closing kills the process. ")
|
||||
|
||||
[WINDOWPROP window 'CLOSEFN (CONS (FUNCTION Lookup-KillProcess)
|
||||
(WINDOWPROP window 'CLOSEFN]
|
||||
@@ -451,72 +454,69 @@ to close this Lookup window?
|
||||
[WINDOWPROP window 'SHRINKFN (CONS (FUNCTION Lookup-KillProcess)
|
||||
(WINDOWPROP window 'SHRINKFN]
|
||||
|
||||
(* ;;; "Fix title menu for this TEDIT window")
|
||||
(* ;;; "Fix title menu for this TEDIT window")
|
||||
|
||||
(OPENTEXTSTREAM "" window NIL NIL '(READONLY T TEDIT.TITLEMENUFN Lookup-TitleMenuFn))
|
||||
(OPENTEXTSTREAM NIL window NIL NIL '(READONLY T TEDIT.TITLEMENUFN Lookup-TitleMenuFn))
|
||||
(WINDOWPROP window 'TEDIT.TITLEMENUFN 'Lookup-TitleMenuFn)
|
||||
|
||||
(* ;;; "Cache FileList in Window")
|
||||
(* ;;; "Cache FileList in Window")
|
||||
|
||||
(WINDOWPROP window 'FileList (MKLIST fileList))
|
||||
|
||||
(* ;;; "Store name for PSW")
|
||||
(* ;;; "Store name for PSW")
|
||||
|
||||
(WINDOWPROP window 'ProcessName (OR processName 'Lookup))
|
||||
|
||||
(* ;;; "This should be default for attached window")
|
||||
(* ;;; "This should be default for attached window")
|
||||
|
||||
(for w1 in (ALLATTACHEDWINDOWS window) do (WINDOWPROP w1 'PASSTOMAINCOMS T)
|
||||
(WINDOWPROP w1 'RIGHTBUTTONFN
|
||||
'NILL))
|
||||
(WINDOWPROP w1 'RIGHTBUTTONFN 'NILL))
|
||||
[ADD.PROCESS `(Lookup-CacheFiles ,window]
|
||||
(SHRINKW window)
|
||||
window])
|
||||
|
||||
(ShowLookUpString
|
||||
[LAMBDA (name-or-string window lst-index start-pos) (* ; "Edited 22-Nov-88 15:10 by dgb:")
|
||||
[LAMBDA (name-or-string window lst-index start-pos) (* ; "Edited 1-Feb-2022 16:59 by rmk")
|
||||
(* ; "Edited 22-Nov-88 15:10 by dgb:")
|
||||
(OR lst-index (SETQ lst-index 1))
|
||||
(OR start-pos (SETQ start-pos 0))
|
||||
(WINDOWPROP window 'searchString name-or-string)
|
||||
(for elt in (NTH (WINDOWPROP window 'CacheForFiles)
|
||||
lst-index) as file-index from lst-index
|
||||
bind pos openStream sel textStream when (SETQ openStream (fetch openStream
|
||||
of elt))
|
||||
lst-index) as file-index from lst-index bind pos openStream sel textStream
|
||||
when (SETQ openStream (fetch openStream of elt))
|
||||
do (if (NOT (OPENP openStream))
|
||||
then (OPENSTREAM openStream 'INPUT)
|
||||
(WINDOWPROP window 'lastFileIndex NIL))
|
||||
(if (SETQ pos (FILEPOS name-or-string openStream start-pos (fetch textLength
|
||||
of elt)
|
||||
NIL NIL UPPERCASEARRAY))
|
||||
then (WINDOWPROP window 'lastEntryIndex pos)
|
||||
(SETQ sel (TEDIT.SETSEL (SETQ textStream (fetch textStream of elt))
|
||||
(ADD1 pos)
|
||||
(NCHARS name-or-string)))
|
||||
[if (EQP file-index (WINDOWPROP window 'lastFileIndex))
|
||||
then (TEDIT.NORMALIZECARET textStream sel)
|
||||
else (WINDOWPROP window 'TITLE (CONCAT "Looking in: "
|
||||
(fetch fileName of elt)))
|
||||
(WINDOWPROP window 'lastFileIndex file-index)
|
||||
(OPENTEXTSTREAM textStream window NIL NIL '(READONLY T]
|
||||
(RETURN (PROG1 (TEDIT.SET.SEL.LOOKS sel 'PENDINGDEL)
|
||||
(TEDIT.SHOWSEL textStream T sel)))
|
||||
else (SETQ start-pos 0)) finally (WINDOWPROP window 'lastFileIndex NIL)
|
||||
(WINDOWPROP window 'lastEntryIndex NIL)
|
||||
(WINDOWPROP window 'TITLE "")
|
||||
(TEDIT.SETSEL (OPENTEXTSTREAM (CONCAT
|
||||
name-or-string
|
||||
" not found.")
|
||||
window NIL NIL
|
||||
'(READONLY T))
|
||||
1
|
||||
(NCHARS name-or-string)
|
||||
'RIGHT T])
|
||||
then (OPENSTREAM openStream 'INPUT)
|
||||
(WINDOWPROP window 'lastFileIndex NIL))
|
||||
(if (SETQ pos (FILEPOS name-or-string openStream start-pos (fetch textLength of elt)
|
||||
NIL NIL UPPERCASEARRAY))
|
||||
then (WINDOWPROP window 'lastEntryIndex pos)
|
||||
(SETQ sel (TEDIT.SETSEL (SETQ textStream (fetch textStream of elt))
|
||||
(ADD1 pos)
|
||||
(NCHARS name-or-string)))
|
||||
[if (EQP file-index (WINDOWPROP window 'lastFileIndex))
|
||||
then (TEDIT.NORMALIZECARET textStream sel)
|
||||
else (WINDOWPROP window 'TITLE (CONCAT "Looking in: " (fetch fileName
|
||||
of elt)))
|
||||
(WINDOWPROP window 'lastFileIndex file-index)
|
||||
(OPENTEXTSTREAM textStream window NIL NIL '(READONLY T]
|
||||
(RETURN (PROG1 (TEDIT.SET.SEL.LOOKS sel 'PENDINGDEL)
|
||||
(TEDIT.SHOWSEL textStream T sel)))
|
||||
else (SETQ start-pos 0)) finally (WINDOWPROP window 'lastFileIndex NIL)
|
||||
(WINDOWPROP window 'lastEntryIndex NIL)
|
||||
(WINDOWPROP window 'TITLE "")
|
||||
(TEDIT.SETSEL (OPENTEXTSTREAM (OPENSTREAMSTRING
|
||||
(CONCAT name-or-string
|
||||
" not found."))
|
||||
window NIL NIL '(READONLY T))
|
||||
1
|
||||
(NCHARS name-or-string)
|
||||
'RIGHT T])
|
||||
)
|
||||
|
||||
(DEFMACRO Lookup-Notify (WINDOW &REST BODY)
|
||||
`(PRINTOUT (OR (OPENWP ,WINDOW)
|
||||
PROMPTWINDOW)
|
||||
. ,BODY))
|
||||
\, BODY))
|
||||
|
||||
(DEFMACRO busy-protect (WINDOW NEW-BUSY-ACTION body-form unwind-form)
|
||||
`(CL:UNLESS (WINDOWPROP ,WINDOW 'BUSYACTION)
|
||||
@@ -554,11 +554,12 @@ to close this Lookup window?
|
||||
)
|
||||
(PUTPROPS LOOKUPINFILES COPYRIGHT ("Xerox Corporation" 1986 1988 1989))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1646 28175 (AddFileToList 1656 . 3004) (DeleteFileFromList 3006 . 4253) (
|
||||
Lookup-CacheFile 4255 . 6155) (Lookup-CacheFiles 6157 . 7720) (Lookup-EditFile 7722 . 8986) (
|
||||
Lookup-KillProcess 8988 . 9569) (Lookup-MakeIconWindow 9571 . 11063) (Lookup-RecacheFile 11065 . 12499
|
||||
) (Lookup-RightbuttonFn 12501 . 13125) (Lookup-CacheFile 13127 . 15027) (Lookup-RightbuttonFn 15029 .
|
||||
15653) (Lookup-StartProcess 15655 . 16371) (Lookup-TitleMenuFn 16373 . 19425) (Lookup-WhenClosedFn
|
||||
19427 . 19745) (Lookup-WhenOpenedFn 19747 . 20061) (LookupAttachedMenu 20063 . 21060) (LookupString
|
||||
21062 . 22675) (MakeLookupWindow 22677 . 25299) (ShowLookUpString 25301 . 28173)))))
|
||||
(FILEMAP (NIL (1645 27979 (AddFileToList 1655 . 3003) (DeleteFileFromList 3005 . 4252) (
|
||||
Lookup-CacheFile 4254 . 6154) (Lookup-CacheFiles 6156 . 7719) (Lookup-EditFile 7721 . 8985) (
|
||||
Lookup-KillProcess 8987 . 9568) (Lookup-MakeIconWindow 9570 . 11062) (Lookup-RecacheFile 11064 . 12498
|
||||
) (Lookup-RightbuttonFn 12500 . 13124) (Lookup-CacheFile 13126 . 15026) (Lookup-RightbuttonFn 15028 .
|
||||
15652) (Lookup-StartProcess 15654 . 16370) (Lookup-TitleMenuFn 16372 . 19424) (Lookup-WhenClosedFn
|
||||
19426 . 19744) (Lookup-WhenOpenedFn 19746 . 20060) (LookupAttachedMenu 20062 . 21059) (LookupString
|
||||
21061 . 22674) (MakeLookupWindow 22676 . 25328) (ShowLookUpString 25330 . 27977)) (27981 28116 (
|
||||
Lookup-Notify 27981 . 28116)) (28118 28624 (busy-protect 28118 . 28624)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
3
lispusers/MIGRATION/DIR.TXT
Normal file
3
lispusers/MIGRATION/DIR.TXT
Normal file
@@ -0,0 +1,3 @@
|
||||
Contains a tool for translating File Manger format Interlisp source
|
||||
files from Medley into Common Lisp text files. The software runs in
|
||||
the Medley system.
|
||||
116
lispusers/MIGRATION/FILEPKGRECORDS
Normal file
116
lispusers/MIGRATION/FILEPKGRECORDS
Normal file
@@ -0,0 +1,116 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(* "
|
||||
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
|
||||
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
|
||||
with the terms of said license.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT FILEPKGRECORDSCOMS)
|
||||
|
||||
(RPAQQ FILEPKGRECORDSCOMS
|
||||
[(COMS (* ;
|
||||
"standard records for accessing file package type/command parts. Exported for PRETTY")
|
||||
(RECORDS * FILEPKGRECORDS)])
|
||||
|
||||
(RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
|
||||
|
||||
(ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM)
|
||||
(UNDOABLE (COND
|
||||
(NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE))
|
||||
(T (/REMPROP DATUM 'ADDTOPRETTYCOM]
|
||||
[DELETE (GETPROP DATUM 'DELFROMPRETTYCOM)
|
||||
(UNDOABLE (COND
|
||||
(NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE))
|
||||
(T (/REMPROP DATUM 'DELFROMPRETTYCOM]
|
||||
[PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE)
|
||||
(UNDOABLE (COND
|
||||
(NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE))
|
||||
(T (/REMPROP DATUM 'PRETTYTYPE]
|
||||
[CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS)
|
||||
(UNDOABLE (COND
|
||||
(NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE))
|
||||
(T (/REMPROP DATUM 'FILEPKGCONTENTS]
|
||||
(MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS]
|
||||
(STANDARD [COND
|
||||
[NEWVALUE (PUTASSOC DATUM NEWVALUE
|
||||
(OR (LISTP (GETTOPVAL
|
||||
'PRETTYDEFMACROS))
|
||||
(SETTOPVAL 'PRETTYDEFMACROS
|
||||
(LIST (LIST DATUM]
|
||||
(T (SETTOPVAL 'PRETTYDEFMACROS
|
||||
(REMOVE (FASSOC DATUM (GETTOPVAL
|
||||
'PRETTYDEFMACROS))
|
||||
(GETTOPVAL 'PRETTYDEFMACROS]
|
||||
UNDOABLE
|
||||
(COND
|
||||
[NEWVALUE (/PUTASSOC DATUM NEWVALUE
|
||||
(OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
|
||||
(/SETTOPVAL 'PRETTYDEFMACROS
|
||||
(LIST (LIST DATUM]
|
||||
(T (/SETTOPVAL 'PRETTYDEFMACROS
|
||||
(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.)
|
||||
(INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE
|
||||
FILEPKGCONTENTS)))
|
||||
|
||||
|
||||
|
||||
(ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED
|
||||
HASDEF EDITDEF FILEGETDEF CANFILEDEF)
|
||||
(ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM))
|
||||
(CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE))
|
||||
)
|
||||
(CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST
|
||||
DATUM)))
|
||||
(STANDARD (SETTOPVAL (CAR (
|
||||
SEARCHPRETTYTYPELST
|
||||
DATUM NEWVALUE)
|
||||
)
|
||||
NEWVALUE)
|
||||
UNDOABLE
|
||||
(/SETTOPVAL (CAR (
|
||||
SEARCHPRETTYTYPELST
|
||||
DATUM NEWVALUE))
|
||||
NEWVALUE)))
|
||||
(DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST
|
||||
DATUM)))
|
||||
(CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST
|
||||
DATUM NEWVALUE))
|
||||
NEWVALUE)))
|
||||
(ALLFIELDS NIL (/SETTOPVAL
|
||||
'PRETTYTYPELST
|
||||
(REMOVE (SEARCHPRETTYTYPELST
|
||||
DATUM)
|
||||
(GETTOPVAL 'PRETTYTYPELST]
|
||||
(* 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
|
||||
'PROPTYPE
|
||||
'FILEPKGCOMS]
|
||||
(ADDTOVAR PRETTYTYPELST))))
|
||||
|
||||
|
||||
(ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP)
|
||||
[ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE)
|
||||
(STANDARD (PUTPROP DATUM 'FILE NEWVALUE)
|
||||
UNDOABLE
|
||||
(/PUTPROP DATUM 'FILE NEWVALUE])
|
||||
|
||||
(RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME))
|
||||
|
||||
(RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED))
|
||||
|
||||
|
||||
|
||||
IL:STOP
|
||||
1
lispusers/MIGRATION/FILEPKGRECORDS.LCOM
Normal file
1
lispusers/MIGRATION/FILEPKGRECORDS.LCOM
Normal file
@@ -0,0 +1 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
805
lispusers/MIGRATION/IL-CONVERT
Normal file
805
lispusers/MIGRATION/IL-CONVERT
Normal file
@@ -0,0 +1,805 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "IL-CONVERT" BASE 10)
|
||||
(IL:FILECREATED "26-Jan-90 10:28:55" IL:|{DSK}/users/welch/migration/IL-CONVERT.;5| 30652
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:IL-CONVERTCOMS)
|
||||
|
||||
IL:|previous| IL:|date:| "25-Jan-90 14:45:43" IL:|{DSK}/users/welch/migration/IL-CONVERT.;4|)
|
||||
|
||||
|
||||
; Copyright (c) 1989, 1990 by ENVOS Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:IL-CONVERTCOMS)
|
||||
|
||||
(IL:RPAQQ IL:IL-CONVERTCOMS
|
||||
((IL:FUNCTIONS IL-DEFCONV)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Used when an Interlisp function is the same as the Common Lisp function of the same name.")
|
||||
|
||||
(IL:FUNCTIONS IL-COPYDEF)
|
||||
|
||||
(IL:* IL:|;;| "Used to define a run-time function (not a converter function).")
|
||||
|
||||
(IL:FUNCTIONS IL-DEFUN IL-DEFVAR)
|
||||
|
||||
(IL:* IL:|;;| "
|
||||
; Creates an external symbol in the IL package.
|
||||
(defmacro il-defsym (name)
|
||||
`(export (intern (symbol-name ',name) *il-package*) *il-package*))
|
||||
|
||||
(defmacro il-import (symbol)
|
||||
`(progn (import ,symbol 'il)
|
||||
(export (find-symbol (symbol-name ,symbol) 'il) 'il)))
|
||||
")
|
||||
|
||||
(IL:FUNCTIONS IL-COPYCONV)
|
||||
|
||||
(IL:* IL:|;;| "Defines a \"Non-conversion\" form for use with things like \\GETBASE.")
|
||||
|
||||
(IL:FUNCTIONS IL-WARNINGFORM)
|
||||
|
||||
(IL:* IL:|;;| "Defines a function (e.g. PROGN-IF-NEEDED) that takes a list and sticks a PROGN (or whatever) at the beginning if the length is not 1. Used to eliminate ugly redundant PROGNs. If the length is 0, returns whatever the form itself returns when given no arguments (e.g. T for AND, NIL for OR).")
|
||||
|
||||
(IL:P
|
||||
(MACROLET ((DEF-*-IF-NEEDED
|
||||
(NAME)
|
||||
(LET ((NAME-STRING (SYMBOL-NAME NAME)))
|
||||
`(DEFUN ,(INTERN (CONCATENATE 'STRING NAME-STRING "-IF-NEEDED"))
|
||||
(ARGS)
|
||||
(CASE (LENGTH ARGS)
|
||||
(0 ,(EVAL `(,NAME)))
|
||||
(1 (FIRST ARGS))
|
||||
(T `(,',NAME ,@ARGS)))))))
|
||||
(DEF-*-IF-NEEDED PROGN)
|
||||
(DEF-*-IF-NEEDED AND)
|
||||
(DEF-*-IF-NEEDED OR)))
|
||||
(IL:STRUCTURES FAKE-SYMBOL SHARP-DOT SHARP-COMMA)
|
||||
|
||||
(IL:* IL:|;;| "Aux function to see whether or not to generate a symbolp check")
|
||||
|
||||
(IL:FUNCTIONS QUOTED-SYMBOL-P)
|
||||
(IL:VARIABLES *ORIGINAL-READTABLE*)
|
||||
(IL:FUNCTIONS OLD-CONVERT-FILE)
|
||||
(IL:P (EXPORT 'CONVERT-FILE))
|
||||
|
||||
(IL:* IL:|;;| "(convert-file \"~/medley/ADISPLAY\" \"adisplay\") (convert-file \"foo1\" \"foo2\") (convert-file \"foo3\" \"foo4\")")
|
||||
|
||||
(IL:P (EXPORT '(READ-EXPORTS WRITE-EXPORTS READ-RECORD-TYPES WRITE-RECORD-TYPES)))
|
||||
(IL:FUNCTIONS READ-EXPORTS)
|
||||
(IL:* IL:\; "Get the symbol list")
|
||||
(IL:FUNCTIONS WRITE-EXPORTS READ-RECORD-TYPES WRITE-RECORD-TYPES READ-HASH-TABLE
|
||||
WRITE-HASH-TABLE)
|
||||
(IL:FUNCTIONS CONVERT-FILE CONVERT-FILECOMS CONVERT-ONE-FILECOM
|
||||
EXPURGATE-EXTRANEOUS-PROGNS REORDER-FILECOMS MAKE-EXPORT-FORM)
|
||||
(IL:VARIABLES *WALKER-TEMPLATES*)
|
||||
(IL:FUNCTIONS GET-WALKER-TEMPLATE WALK-FORM-INTERNAL WALK-TEMPLATE
|
||||
WALK-TEMPLATE-HANDLE-REPEAT WALK-TEMPLATE-HANDLE-REPEAT-1 WALK-REPEAT-EVAL RECONS
|
||||
RELIST RELIST* RELIST-INTERNAL)
|
||||
(IL:VARIABLES *GETVALUE-TRANSLATION* *CURRENT-DEFINITION* *CURRENT-DEFINITION-TYPE*
|
||||
*CURRENT-EXPRESSION* *CURRENT-LOCALS* *FILE-CONTEXT* *WALKER-FIND-PARAMETER-LIST*
|
||||
*WARNINGS-MADE* *PACKAGE-FOR-IL-SYMBOLS* *PACKAGE-FOR-RESULT-FILE*
|
||||
*PARAMETERS-ALWAYS-OPTIONAL* *PROMPT-FOR-UNKNOWN-MACRO-TEMPLATE*
|
||||
*UNKNOWN-MACRO-ACTION* *ALWAYS-INCLUDE-PROPS*)
|
||||
(IL:DECLARE\: IL:DONTCOPY (IL:PROP (IL:MAKEFILE-ENVIRONMENT IL:FILETYPE)
|
||||
IL:IL-CONVERT))))
|
||||
|
||||
(XCL:DEFDEFINER IL-DEFCONV IL:FUNCTIONS (NAME ARGLIST &REST REST)
|
||||
(CHECK-TYPE NAME SYMBOL)
|
||||
(LET ((FN-NAME (FIND-SYMBOL (SYMBOL-NAME NAME)
|
||||
*IL-PACKAGE*)))
|
||||
(IF FN-NAME
|
||||
`(SETF (GET ',FN-NAME 'CONVERT-FORM)
|
||||
#'(LAMBDA ,ARGLIST ,@REST))
|
||||
(PROGN (WARN "No symbol ~:@(~a~) found in IL package." NAME)
|
||||
NIL))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Used when an Interlisp function is the same as the Common Lisp function of the same name.")
|
||||
|
||||
|
||||
(DEFMACRO IL-COPYDEF (NAME &OPTIONAL (NEWNAME NAME))
|
||||
(LET ((SYM (FIND-SYMBOL (SYMBOL-NAME NEWNAME)
|
||||
*IL-PACKAGE*)))
|
||||
(UNLESS SYM (ERROR "No symbol ~:@(~a~) found in IL package." SYM))
|
||||
`(SETF (GET ',SYM 'CONVERT-FORM)
|
||||
#'(LAMBDA (&REST ARGS)
|
||||
(CONS ',NAME (MAPCONVERT ARGS))))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;| "Used to define a run-time function (not a converter function).")
|
||||
|
||||
|
||||
(XCL:DEFDEFINER IL-DEFUN IL:FUNCTIONS (NAME &REST REST)
|
||||
(CHECK-TYPE NAME SYMBOL)
|
||||
(LET* ((NAME-STRING (SYMBOL-NAME NAME))
|
||||
(IL-SYM (INTERN NAME-STRING 'IL))
|
||||
(IL-SYM1 (IF (CHAR/= (ELT NAME-STRING 0)
|
||||
#\/)
|
||||
(INTERN (CONCATENATE 'STRING "/" NAME-STRING)
|
||||
'IL))))
|
||||
`(PROGN (EXPORT ',IL-SYM 'IL)
|
||||
(DEFUN ,IL-SYM ,@REST) (IL:* IL:\;
|
||||
"Also make a version starting with a /")
|
||||
,@(IF IL-SYM1
|
||||
`((EXPORT ',IL-SYM1 'IL)
|
||||
(SETF (SYMBOL-FUNCTION ',IL-SYM1)
|
||||
(SYMBOL-FUNCTION ',IL-SYM)))))))
|
||||
|
||||
(XCL:DEFDEFINER IL-DEFVAR IL:FUNCTIONS (NAME &REST ARGS)
|
||||
(LET ((IL-SYM (INTERN (SYMBOL-NAME NAME)
|
||||
*IL-PACKAGE*)))
|
||||
`(PROGN (EXPORT ',IL-SYM 'IL)
|
||||
(DEFVAR ,IL-SYM ,@(MAPCONVERT ARGS)))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"
|
||||
; Creates an external symbol in the IL package.
|
||||
(defmacro il-defsym (name)
|
||||
`(export (intern (symbol-name ',name) *il-package*) *il-package*))
|
||||
|
||||
(defmacro il-import (symbol)
|
||||
`(progn (import ,symbol 'il)
|
||||
(export (find-symbol (symbol-name ,symbol) 'il) 'il)))
|
||||
")
|
||||
|
||||
|
||||
(DEFMACRO IL-COPYCONV (OLDNAME NEWNAME)
|
||||
(LET* ((OLD-SYM (FIND-SYMBOL (SYMBOL-NAME OLDNAME)
|
||||
*IL-PACKAGE*))
|
||||
(NEW-SYM (FIND-SYMBOL (SYMBOL-NAME NEWNAME)
|
||||
*IL-PACKAGE*)))
|
||||
(UNLESS OLD-SYM (ERROR "No symbol ~:@(~a~) found in IL package." OLD-SYM))
|
||||
(UNLESS NEW-SYM (ERROR "No symbol ~:@(~a~) found in IL package." NEW-SYM))
|
||||
`(SETF (GET ',NEW-SYM 'CONVERT-FORM)
|
||||
#'(LAMBDA (&REST ARGS)
|
||||
(APPLY (GET ',OLD-SYM 'CONVERT-FORM)
|
||||
ARGS)))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;| "Defines a \"Non-conversion\" form for use with things like \\GETBASE.")
|
||||
|
||||
|
||||
(XCL:DEFDEFINER IL-WARNINGFORM IL:FUNCTIONS (NAME &OPTIONAL (TEMPLATE '(NIL REPEAT (EVAL)))
|
||||
(WARN-SWITCH '*WARN-ON-UNTRANSLATABLE-IL-FORM*)
|
||||
)
|
||||
(LET ((FN-NAME (FIND-SYMBOL (SYMBOL-NAME NAME)
|
||||
*IL-PACKAGE*)))
|
||||
(IF FN-NAME
|
||||
`(SETF (GET ',FN-NAME 'CONVERT-FORM)
|
||||
#'(LAMBDA (&REST REST)
|
||||
(DECLARE (SPECIAL ,WARN-SWITCH))
|
||||
(WHEN ,WARN-SWITCH
|
||||
(WARN "Unable to translate a ~a form." ',FN-NAME))
|
||||
(WALK-TEMPLATE (CONS ',FN-NAME REST)
|
||||
',TEMPLATE)))
|
||||
(PROGN (WARN "No symbol ~:@(~a~) found in IL package." NAME)
|
||||
NIL))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Defines a function (e.g. PROGN-IF-NEEDED) that takes a list and sticks a PROGN (or whatever) at the beginning if the length is not 1. Used to eliminate ugly redundant PROGNs. If the length is 0, returns whatever the form itself returns when given no arguments (e.g. T for AND, NIL for OR)."
|
||||
)
|
||||
|
||||
|
||||
(MACROLET ((DEF-*-IF-NEEDED (NAME)
|
||||
(LET ((NAME-STRING (SYMBOL-NAME NAME)))
|
||||
`(DEFUN ,(INTERN (CONCATENATE 'STRING NAME-STRING "-IF-NEEDED")) (ARGS)
|
||||
(CASE (LENGTH ARGS)
|
||||
(0 ,(EVAL `(,NAME)))
|
||||
(1 (FIRST ARGS))
|
||||
(T `(,',NAME ,@ARGS)))))))
|
||||
(DEF-*-IF-NEEDED PROGN)
|
||||
(DEF-*-IF-NEEDED AND)
|
||||
(DEF-*-IF-NEEDED OR))
|
||||
|
||||
(DEFSTRUCT (FAKE-SYMBOL (:CONSTRUCTOR MAKE-FAKE-SYMBOL (NAME))
|
||||
(:PRINT-FUNCTION (LAMBDA (OBJ STREAM DEPTH)
|
||||
(PRINC (FAKE-SYMBOL-NAME OBJ)
|
||||
STREAM))))
|
||||
NAME)
|
||||
|
||||
(DEFSTRUCT (SHARP-DOT (:PRINT-FUNCTION (LAMBDA (SELF STREAM DEPTH)
|
||||
(WRITE-STRING "#." STREAM)
|
||||
(WRITE (SHARP-DOT-CONTENTS SELF)
|
||||
:STREAM STREAM))))
|
||||
CONTENTS)
|
||||
|
||||
(DEFSTRUCT (SHARP-COMMA (:PRINT-FUNCTION (LAMBDA (SELF STREAM DEPTH)
|
||||
(WRITE-STRING "#," STREAM)
|
||||
(WRITE (SHARP-COMMA-CONTENTS SELF)
|
||||
:STREAM STREAM))))
|
||||
CONTENTS)
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;| "Aux function to see whether or not to generate a symbolp check")
|
||||
|
||||
|
||||
(DEFUN QUOTED-SYMBOL-P (X)
|
||||
(AND (CONSP X)
|
||||
(EQ (CAR X)
|
||||
'QUOTE)
|
||||
(SYMBOLP (CADR X))
|
||||
(NULL (CDDR X))))
|
||||
|
||||
(DEFVAR *ORIGINAL-READTABLE* (COPY-READTABLE NIL))
|
||||
|
||||
(DEFUN OLD-CONVERT-FILE (INFILE OUTFILE)
|
||||
(WITH-OPEN-FILE (INSTREAM INFILE)
|
||||
(IF OUTFILE
|
||||
(WITH-OPEN-STREAM (OUTSTREAM (COND
|
||||
((EQ OUTFILE 'T)
|
||||
(MAKE-BROADCAST-STREAM *STANDARD-OUTPUT*))
|
||||
(T (OPEN OUTFILE :DIRECTION :OUTPUT :IF-EXISTS
|
||||
:SUPERSEDE :IF-DOES-NOT-EXIST :CREATE))))
|
||||
(CONVERT-FILE-INTERNAL INSTREAM OUTSTREAM))
|
||||
(CONVERT-FILE-INTERNAL INSTREAM NIL))))
|
||||
|
||||
(EXPORT 'CONVERT-FILE)
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"(convert-file \"~/medley/ADISPLAY\" \"adisplay\") (convert-file \"foo1\" \"foo2\") (convert-file \"foo3\" \"foo4\")"
|
||||
)
|
||||
|
||||
|
||||
(EXPORT '(READ-EXPORTS WRITE-EXPORTS READ-RECORD-TYPES WRITE-RECORD-TYPES))
|
||||
|
||||
(DEFUN READ-EXPORTS (FILE)
|
||||
|
||||
(IL:* IL:|;;| "Read the exported-symbols file if it exists")
|
||||
|
||||
(WITH-OPEN-FILE (STREAM FILE :IF-DOES-NOT-EXIST NIL)
|
||||
(WHEN STREAM
|
||||
(READ STREAM) (IL:* IL:\;
|
||||
"Read the \"(in-package)\" form")
|
||||
(SETQ *EXPORTED-IL-SYMBOLS* (CADADR (READ STREAM))))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:\; "Get the symbol list")
|
||||
|
||||
|
||||
(DEFUN WRITE-EXPORTS (FILE)
|
||||
(WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE :IF-DOES-NOT-EXIST :CREATE)
|
||||
(SETQ *EXPORTED-IL-SYMBOLS* (SORT *EXPORTED-IL-SYMBOLS* #'STRING< :KEY #'SYMBOL-NAME))
|
||||
(LET ((*PACKAGE* *IL-PACKAGE*))
|
||||
(FORMAT STREAM "(lisp:in-package \"IL\")~%(lisp:export '(")
|
||||
(DOLIST (SYM *EXPORTED-IL-SYMBOLS*)
|
||||
(FORMAT STREAM "~% ~s" SYM))
|
||||
(FORMAT STREAM ")~%"))))
|
||||
|
||||
(DEFUN READ-RECORD-TYPES (FILE) (IL:* IL:\;
|
||||
"Read the record-types file if it exists")
|
||||
(WITH-OPEN-FILE (STREAM FILE :IF-DOES-NOT-EXIST NIL)
|
||||
(WHEN STREAM (READ-HASH-TABLE *RECORD-TYPES* STREAM))))
|
||||
|
||||
(DEFUN WRITE-RECORD-TYPES (FILE)
|
||||
(WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :SUPERSEDE :IF-DOES-NOT-EXIST :CREATE)
|
||||
(WRITE-HASH-TABLE *RECORD-TYPES* STREAM)
|
||||
(TERPRI STREAM)))
|
||||
|
||||
(DEFUN READ-HASH-TABLE (HT STREAM &AUX ITEM)
|
||||
(LOOP (WHEN (EQ (SETQ ITEM (READ STREAM NIL 'STOP))
|
||||
'STOP)
|
||||
(RETURN))
|
||||
(SETF (GETHASH (CAR ITEM)
|
||||
HT)
|
||||
(CDR ITEM))))
|
||||
|
||||
(DEFUN WRITE-HASH-TABLE (HT STREAM)
|
||||
(LET* ((COUNT (HASH-TABLE-COUNT HT))
|
||||
(SORTED-TABLE (MAKE-ARRAY COUNT))
|
||||
(I 0))
|
||||
(MAPHASH #'(LAMBDA (KEY VALUE)
|
||||
(SETF (SVREF SORTED-TABLE I)
|
||||
(CONS KEY VALUE))
|
||||
(INCF I))
|
||||
HT)
|
||||
(SORT SORTED-TABLE #'STRING< :KEY #'(LAMBDA (X)
|
||||
(SYMBOL-NAME (CAR X))))
|
||||
(DOTIMES (I COUNT)
|
||||
(PPRINT (SVREF SORTED-TABLE I)
|
||||
STREAM))))
|
||||
|
||||
(DEFUN CONVERT-FILE (FILENAME OUTFILE)
|
||||
(LET* ((REAL-FILENAME (FIND-SYMBOL (STRING FILENAME)
|
||||
(FIND-PACKAGE 'IL)))
|
||||
(COMS (SYMBOL-VALUE (OR (CAAR (GET REAL-FILENAME 'IL:FILE))
|
||||
(ERROR "~a has no FILES definition." FILENAME)))))
|
||||
(IF OUTFILE
|
||||
(WITH-OPEN-STREAM (OUTSTREAM (COND
|
||||
((EQ OUTFILE 'T)
|
||||
(MAKE-BROADCAST-STREAM *STANDARD-OUTPUT*))
|
||||
(T (OPEN OUTFILE :DIRECTION :OUTPUT :IF-EXISTS
|
||||
:SUPERSEDE :IF-DOES-NOT-EXIST :CREATE))))
|
||||
(CONVERT-FILECOMS COMS REAL-FILENAME OUTSTREAM))
|
||||
(CONVERT-FILECOMS COMS REAL-FILENAME NIL))))
|
||||
|
||||
(DEFUN CONVERT-FILECOMS (COMS FILENAME &OPTIONAL OUTSTREAM)
|
||||
(LET ((*EXPORTED-IL-SYMBOLS* NIL)
|
||||
REORDERED-FILECOMS CONVERTED-FILE-LIST)
|
||||
(FORMAT T "~&Processing Forms...~%")
|
||||
(SETQ REORDERED-FILECOMS (REORDER-FILECOMS COMS)
|
||||
CONVERTED-FILE-LIST
|
||||
(EXPURGATE-EXTRANEOUS-PROGNS (MAPCAR 'CONVERT-ONE-FILECOM REORDERED-FILECOMS)))
|
||||
(WHEN OUTSTREAM
|
||||
(FORMAT T "~&Writing output...")
|
||||
(LET* ((MFE (GET FILENAME 'IL:MAKEFILE-ENVIRONMENT))
|
||||
(*PACKAGE* (OR (FIND-PACKAGE (EVAL (GETF MFE :PACKAGE)))
|
||||
*IL-PACKAGE*))
|
||||
(*PRINT-PRETTY* T)
|
||||
(*PRINT-CASE* :DOWNCASE))
|
||||
(WHEN MFE
|
||||
(PRINT '(IN-PACKAGE "INTERLISP" :USE NIL :NICKNAMES '("IL"))
|
||||
OUTSTREAM))
|
||||
(PRINT (IF MFE
|
||||
(LIST 'IN-PACKAGE (GETF MFE ':PACKAGE))
|
||||
'(IN-PACKAGE "INTERLISP" :USE NIL :NICKNAMES '("IL")))
|
||||
OUTSTREAM)
|
||||
(TERPRI OUTSTREAM)
|
||||
(WHEN *EXPORTED-IL-SYMBOLS*
|
||||
(PRINT (MAKE-EXPORT-FORM *EXPORTED-IL-SYMBOLS*)
|
||||
OUTSTREAM)
|
||||
(TERPRI OUTSTREAM))
|
||||
(DOLIST (FORM CONVERTED-FILE-LIST)
|
||||
(WHEN FORM
|
||||
(PRINT FORM OUTSTREAM)
|
||||
(TERPRI OUTSTREAM)))))))
|
||||
|
||||
(DEFUN CONVERT-ONE-FILECOM (COM)
|
||||
(UNLESS (CONSP COM)
|
||||
(ERROR "Invalid filecom: ~s" COM))
|
||||
(LET (
|
||||
(IL:* IL:|;;| "We bind these for the warnings mechanism in case the filecom type is unknown... They'll be rebound lower down.")
|
||||
|
||||
(*CURRENT-EXPRESSION* COM)
|
||||
(*CURRENT-DEFINITION* (CAR COM))
|
||||
(*CURRENT-DEFINITION-TYPE* "Filecom")
|
||||
(*WARNINGS-MADE* NIL)
|
||||
(CONVERTER (GET (CAR COM)
|
||||
'CONVERT-COM))
|
||||
|
||||
(IL:* IL:|;;| "FILEVARS are handled at this level, except in PROP and IFPROP coms.")
|
||||
|
||||
(FILEVAR-P (AND (EQ (SECOND COM)
|
||||
'IL:*)
|
||||
(NOT (MEMBER (FIRST COM)
|
||||
' (IL:* IL:PROP IL:IFPROP))))))
|
||||
(FUNCALL (OR CONVERTER 'CONVERT-UNKNOWN-COM)
|
||||
(IF CONVERTER
|
||||
(IF FILEVAR-P
|
||||
(IL:EVAL (THIRD COM))
|
||||
(CDR COM))
|
||||
COM))))
|
||||
|
||||
(DEFUN EXPURGATE-EXTRANEOUS-PROGNS (FORMS-LIST)
|
||||
(LET (RESULT)
|
||||
(DOLIST (FORM FORMS-LIST)
|
||||
(SETQ RESULT (NCONC RESULT (IF (AND (CONSP FORM)
|
||||
(EQ (CAR FORM)
|
||||
'PROGN))
|
||||
(EXPURGATE-EXTRANEOUS-PROGNS (CDR FORM))
|
||||
(CONS FORM NIL)))))
|
||||
RESULT))
|
||||
|
||||
(DEFUN REORDER-FILECOMS (COMS-LIST)
|
||||
(LET (EARLY-LIST LATE-LIST)
|
||||
(LABELS ((EARLY-P (COM)
|
||||
(AND (CONSP COM)
|
||||
(OR (MEMBER (CAR COM)
|
||||
'(IL:CONSTANTS IL:MACROS))
|
||||
(AND (MEMBER (CAR COM)
|
||||
'(IL:DECLARE\:))
|
||||
(SOME #'EARLY-P (CDR COM)))))))
|
||||
(DOLIST (COM COMS-LIST)
|
||||
(IF (EARLY-P COM)
|
||||
(PUSH COM EARLY-LIST)
|
||||
(PUSH COM LATE-LIST)))
|
||||
(NCONC (NREVERSE EARLY-LIST)
|
||||
(NREVERSE LATE-LIST)))))
|
||||
|
||||
(DEFUN MAKE-EXPORT-FORM (LIST-OF-SYMBOLS)
|
||||
(LET (SORTED)
|
||||
(DOLIST (S LIST-OF-SYMBOLS)
|
||||
(LET ((A (ASSOC (SYMBOL-PACKAGE S)
|
||||
SORTED)))
|
||||
(IF A
|
||||
(PUSH S (CDR A))
|
||||
(PUSH (CONS (SYMBOL-PACKAGE S)
|
||||
(LIST S))
|
||||
SORTED))))
|
||||
(CONS 'PROGN (MAPCAR #'(LAMBDA (P)
|
||||
`(EXPORT (MAPCAR 'INTERN ',(MAPCAR 'STRING (CDR P))
|
||||
',(PACKAGE-NAME (CAR P)))))
|
||||
SORTED))))
|
||||
|
||||
(DEFPARAMETER *WALKER-TEMPLATES*
|
||||
'(BLOCK (NIL NIL REPEAT (EVAL))
|
||||
CATCH
|
||||
(NIL EVAL REPEAT (EVAL))
|
||||
CHECK-TYPE
|
||||
(NIL EVAL REPEAT (NIL))
|
||||
COMPILER-LET
|
||||
(NIL (REPEAT (NIL EVAL))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
DECLARE
|
||||
(REPEAT (NIL))
|
||||
EVAL-WHEN
|
||||
(NIL QUOTE REPEAT (EVAL))
|
||||
FLET
|
||||
(NIL (REPEAT ((NIL BINDING-CONTOUR PARAMETER-LIST REPEAT (EVAL))))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
FUNCTION
|
||||
(NIL CALL)
|
||||
GO
|
||||
(NIL QUOTE)
|
||||
IF
|
||||
(NIL REPEAT (EVAL))
|
||||
LABELS
|
||||
(NIL (REPEAT ((NIL BINDING-CONTOUR PARAMETER-LIST REPEAT (EVAL))))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
LAMBDA
|
||||
(NIL BINDING-CONTOUR PARAMETER-LIST REPEAT (EVAL))
|
||||
LET
|
||||
(NIL BINDING-CONTOUR (REPEAT ((NIL EVAL)))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
LET*
|
||||
(NIL BINDING-CONTOUR (REPEAT ((NIL EVAL)))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
LOCALLY
|
||||
(NIL REPEAT (EVAL))
|
||||
MACROLET
|
||||
(NIL (REPEAT ((NIL NIL REPEAT (EVAL))))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
MULTIPLE-VALUE-CALL
|
||||
(NIL EVAL REPEAT (EVAL))
|
||||
MULTIPLE-VALUE-LIST
|
||||
(NIL EVAL)
|
||||
MULTIPLE-VALUE-PROG1
|
||||
(NIL RETURN REPEAT (EVAL))
|
||||
MULTIPLE-VALUE-SETQ
|
||||
(NIL (REPEAT (SET))
|
||||
EVAL)
|
||||
MULTIPLE-VALUE-BIND
|
||||
(NIL BINDING-CONTOUR (REPEAT (SET))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
IL:NLSETQ
|
||||
(NIL REPEAT (EVAL))
|
||||
PROGN
|
||||
(NIL REPEAT (EVAL))
|
||||
PROGV
|
||||
(NIL EVAL EVAL REPEAT (EVAL))
|
||||
QUOTE
|
||||
(NIL QUOTE)
|
||||
RETURN-FROM
|
||||
(NIL QUOTE REPEAT (RETURN))
|
||||
SETQ
|
||||
(NIL REPEAT (SET EVAL))
|
||||
SETF
|
||||
(NIL REPEAT (SET EVAL))
|
||||
TAGBODY
|
||||
(NIL REPEAT (EVAL))
|
||||
THE
|
||||
(NIL QUOTE EVAL)
|
||||
THROW
|
||||
(NIL EVAL EVAL)
|
||||
UNLESS
|
||||
(NIL REPEAT (EVAL))
|
||||
UNWIND-PROTECT
|
||||
(NIL RETURN REPEAT (EVAL))
|
||||
WHEN
|
||||
(NIL REPEAT (EVAL))
|
||||
DO
|
||||
(NIL BINDING-CONTOUR (REPEAT ((BINDING REPEAT (EVAL))))
|
||||
(EVAL EVAL)
|
||||
REPEAT
|
||||
(EVAL))
|
||||
DO*
|
||||
(NIL BINDING-CONTOUR (REPEAT ((BINDING REPEAT (EVAL))))
|
||||
(EVAL EVAL)
|
||||
REPEAT
|
||||
(EVAL))
|
||||
DOLIST
|
||||
(NIL (NIL EVAL)
|
||||
REPEAT
|
||||
(EVAL))
|
||||
DOTIMES
|
||||
(NIL (NIL EVAL)
|
||||
REPEAT
|
||||
(EVAL))
|
||||
PROG
|
||||
(NIL BINDING-CONTOUR (REPEAT ((BINDING EVAL)))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
PROG*
|
||||
(NIL BINDING-CONTOUR (REPEAT ((BINDING EVAL)))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
COND
|
||||
(NIL REPEAT ((TEST REPEAT (EVAL))))
|
||||
DEFINE-SETF-METHOD
|
||||
(NIL BINDING-CONTOUR PARAMETER-LIST REPEAT (EVAL))
|
||||
DEFUN
|
||||
(NIL NAME BINDING-CONTOUR PARAMETER-LIST REPEAT (EVAL))
|
||||
DEFMACRO
|
||||
(NIL NAME BINDING-CONTOUR PARAMETER-LIST REPEAT (EVAL))
|
||||
CASE
|
||||
(NIL EVAL REPEAT ((NIL REPEAT (EVAL))))
|
||||
ECASE
|
||||
(NIL EVAL REPEAT ((NIL REPEAT (EVAL))))
|
||||
TYPECASE
|
||||
(NIL EVAL REPEAT ((NIL REPEAT (EVAL))))
|
||||
ETYPECASE
|
||||
(NIL EVAL REPEAT ((NIL REPEAT (EVAL))))
|
||||
XCL:DEFDEFINER
|
||||
(NIL NIL NIL NIL REPEAT (EVAL))
|
||||
INCF
|
||||
(NIL EVAL EVAL)
|
||||
DECF
|
||||
(NIL EVAL EVAL)
|
||||
WITH-INPUT-FROM-STRING
|
||||
(NIL (NIL EVAL REPEAT (EVAL))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
WITH-OUTPUT-TO-STRING
|
||||
(NIL (NIL EVAL)
|
||||
REPEAT
|
||||
(EVAL))
|
||||
WITH-OPEN-FILE
|
||||
(NIL (NIL REPEAT (EVAL))
|
||||
REPEAT
|
||||
(EVAL))
|
||||
LOOP
|
||||
(NIL REPEAT (EVAL))
|
||||
POP
|
||||
(NIL EVAL)
|
||||
PUSH
|
||||
(NIL EVAL EVAL)
|
||||
PUSHNEW
|
||||
(NIL EVAL EVAL REPEAT EVAL)))
|
||||
|
||||
(DEFUN GET-WALKER-TEMPLATE (FN)
|
||||
(GETF *WALKER-TEMPLATES* FN NIL))
|
||||
|
||||
(DEFUN WALK-FORM-INTERNAL (FORM &AUX NEWFORM NEWNEWFORM WALK-NO-MORE-P MACROP FN TEMPLATE)
|
||||
(COND
|
||||
((ATOM FORM)
|
||||
(WHEN (AND (SYMBOLP FORM)
|
||||
(NOT (NULL *CURRENT-FREE-REFERENCES*))
|
||||
(NOT (KEYWORDP FORM))
|
||||
(NOT (MEMBER FORM '(T NIL)))
|
||||
(NULL (ASSOC FORM *LOCALS*)))
|
||||
|
||||
(IL:* IL:|;;| "Almost certainly a free ref. Note for later analysis.")
|
||||
|
||||
(PUSHNEW FORM *CURRENT-FREE-REFERENCES*))
|
||||
FORM)
|
||||
((SETQ TEMPLATE (GET-WALKER-TEMPLATE (SETQ FN (CAR FORM))))
|
||||
(IF (SYMBOLP TEMPLATE)
|
||||
(FUNCALL TEMPLATE FORM)
|
||||
(WALK-TEMPLATE FORM TEMPLATE)))
|
||||
((AND (SYMBOLP FN)
|
||||
(OR (GET FN 'CONVERT-FORM)
|
||||
(EQ (CAR (GET FN 'IL:CLISPWORD))
|
||||
'IL:FORWORD)))
|
||||
(CONVERT FORM))
|
||||
((AND (SYMBOLP FN)
|
||||
(MACRO-FUNCTION FN))
|
||||
(LET ((*CURRENT-EXPRESSION* FORM))
|
||||
(WARN "Macro form ~s not translated" FN))
|
||||
FORM)
|
||||
((AND (SYMBOLP FN)
|
||||
(NOT (FBOUNDP FN))
|
||||
(SPECIAL-FORM-P FN))
|
||||
(UNKNOWN-MACRO-FORM FORM))
|
||||
(T
|
||||
(IL:* IL:|;;| "Otherwise, walk the form as if its just a standard ")
|
||||
|
||||
(IL:* IL:|;;| "functioncall using a template for standard function")
|
||||
|
||||
(IL:* IL:|;;| "call.")
|
||||
|
||||
(WALK-TEMPLATE FORM '(CALL REPEAT (EVAL))))))
|
||||
|
||||
(DEFUN WALK-TEMPLATE (FORM TEMPLATE)
|
||||
(IF (ATOM TEMPLATE)
|
||||
(ECASE TEMPLATE
|
||||
((EVAL SET FUNCTION TEST EFFECT RETURN)
|
||||
(WHEN *WALKER-FIND-PARAMETER-LIST*
|
||||
(THROW 'PARAMETER-LIST NIL))
|
||||
(WALK-FORM-INTERNAL FORM))
|
||||
((NIL QUOTE) FORM)
|
||||
((BINDING)
|
||||
|
||||
(IL:* IL:|;;| "This should only appear inside (after) a BINDING-CONTOUR...")
|
||||
|
||||
(WHEN (SYMBOLP FORM)
|
||||
|
||||
(IL:* IL:|;;| "Perhaps this should note if FORM is declared special somehow...")
|
||||
|
||||
(PUSH (CONS FORM ':LOCAL)
|
||||
*LOCALS*)
|
||||
(PUSHNEW FORM *CURRENT-LOCALS*))
|
||||
FORM)
|
||||
((LAMBDA CALL) (COND
|
||||
((SYMBOLP FORM)
|
||||
(UNLESS (NULL *CURRENT-FUNCTION-CALLS*)
|
||||
(PUSHNEW FORM *CURRENT-FUNCTION-CALLS*))
|
||||
FORM)
|
||||
(T
|
||||
(IL:* IL:|;;| "Have we a \"#'foo\" here?")
|
||||
|
||||
(WHEN (AND (CONSP FORM)
|
||||
(EQ (CAR FORM)
|
||||
'FUNCTION)
|
||||
(NULL (CDDR FORM))
|
||||
(SYMBOLP (SECOND FORM)))
|
||||
|
||||
(IL:* IL:|;;| "Record it if we do...")
|
||||
|
||||
(PUSHNEW (SECOND FORM)
|
||||
*CURRENT-FUNCTION-CALLS*))
|
||||
(WALK-FORM-INTERNAL FORM))))
|
||||
((NAME)
|
||||
(WHEN (NULL *CURRENT-FUNCTION-CALLS*)
|
||||
|
||||
(IL:* IL:|;;| "Don't record name in a nested def, if we ever see one.")
|
||||
|
||||
(SETQ *CURRENT-DEFINITION* FORM)
|
||||
(PUSH FORM *CURRENT-FUNCTION-CALLS*)
|
||||
(PUSH FORM *CURRENT-FREE-REFERENCES*))
|
||||
FORM)
|
||||
((PARAMETER) (IF (SYMBOLP FORM)
|
||||
(WALK-TEMPLATE FORM 'BINDING)
|
||||
(WALK-TEMPLATE FORM '(BINDING EVAL REPEAT (BINDING)))))
|
||||
((PARAMETER-LIST)
|
||||
(WHEN *WALKER-FIND-PARAMETER-LIST*
|
||||
|
||||
(IL:* IL:|;;| "Some code-analysis stuff uses this.")
|
||||
|
||||
(THROW 'PARAMETER-LIST FORM))
|
||||
(WALK-TEMPLATE FORM '(REPEAT (PARAMETER)))))
|
||||
(CASE (CAR TEMPLATE)
|
||||
(REPEAT (WALK-TEMPLATE-HANDLE-REPEAT FORM (CDR TEMPLATE)
|
||||
|
||||
(IL:* IL:|;;| "For the case where nothing happens")
|
||||
|
||||
(IL:* IL:|;;| "after the repeat optimize out the")
|
||||
|
||||
(IL:* IL:|;;| "call to length.")
|
||||
|
||||
(IF (NULL (CDDR TEMPLATE))
|
||||
NIL
|
||||
(NTHCDR (- (LENGTH FORM)
|
||||
(LENGTH (CDDR TEMPLATE)))
|
||||
FORM))))
|
||||
(IF (WALK-TEMPLATE FORM (IF (IF (LISTP (CADR TEMPLATE))
|
||||
(EVAL (CADR TEMPLATE))
|
||||
(FUNCALL (CADR TEMPLATE)
|
||||
FORM))
|
||||
(CADDR TEMPLATE)
|
||||
(CADDDR TEMPLATE))))
|
||||
(BINDING-CONTOUR (LET ((*LOCALS* *LOCALS*))
|
||||
(WALK-TEMPLATE FORM (CDR TEMPLATE))))
|
||||
(REMOTE (WALK-TEMPLATE FORM (CADR TEMPLATE)))
|
||||
(WARN
|
||||
(WARN (SECOND TEMPLATE))
|
||||
(IF (NULL (CDDR TEMPLATE))
|
||||
FORM
|
||||
(WALK-TEMPLATE FORM (CDDR TEMPLATE))))
|
||||
(OTHERWISE (COND
|
||||
((ATOM FORM)
|
||||
FORM)
|
||||
(T (RECONS FORM (WALK-TEMPLATE (CAR FORM)
|
||||
(CAR TEMPLATE))
|
||||
(WALK-TEMPLATE (CDR FORM)
|
||||
(CDR TEMPLATE)))))))))
|
||||
|
||||
(DEFUN WALK-TEMPLATE-HANDLE-REPEAT (FORM TEMPLATE STOP-FORM)
|
||||
(IF (EQ FORM STOP-FORM)
|
||||
(WALK-TEMPLATE FORM (CDR TEMPLATE))
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1 FORM TEMPLATE (CAR TEMPLATE)
|
||||
STOP-FORM)))
|
||||
|
||||
(DEFUN WALK-TEMPLATE-HANDLE-REPEAT-1 (FORM TEMPLATE REPEAT-TEMPLATE STOP-FORM)
|
||||
(COND
|
||||
((NULL FORM)
|
||||
NIL)
|
||||
((EQ FORM STOP-FORM)
|
||||
(IF (NULL REPEAT-TEMPLATE)
|
||||
(WALK-TEMPLATE STOP-FORM (CDR TEMPLATE))
|
||||
(ERROR
|
||||
"While handling repeat:
|
||||
~%~Ran into stop while still in repeat template.")))
|
||||
((NULL REPEAT-TEMPLATE)
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1 FORM TEMPLATE (CAR TEMPLATE)
|
||||
STOP-FORM))
|
||||
(T (RECONS FORM (WALK-TEMPLATE (CAR FORM)
|
||||
(CAR REPEAT-TEMPLATE))
|
||||
(WALK-TEMPLATE-HANDLE-REPEAT-1 (CDR FORM)
|
||||
TEMPLATE
|
||||
(CDR REPEAT-TEMPLATE)
|
||||
STOP-FORM)))))
|
||||
|
||||
(DEFUN WALK-REPEAT-EVAL (FORM ENV)
|
||||
(AND FORM (RECONS FORM (WALK-FORM-INTERNAL (CAR FORM))
|
||||
(WALK-REPEAT-EVAL (CDR FORM)))))
|
||||
|
||||
(DEFUN RECONS (X CAR CDR)
|
||||
(IF (OR (NOT (EQ (CAR X)
|
||||
CAR))
|
||||
(NOT (EQ (CDR X)
|
||||
CDR)))
|
||||
(CONS CAR CDR)
|
||||
X))
|
||||
|
||||
(DEFUN RELIST (X &REST ARGS)
|
||||
(RELIST-INTERNAL X ARGS NIL))
|
||||
|
||||
(DEFUN RELIST* (X &REST ARGS)
|
||||
(RELIST-INTERNAL X ARGS 'T))
|
||||
|
||||
(DEFUN RELIST-INTERNAL (X ARGS *P)
|
||||
(IF (NULL (CDR ARGS))
|
||||
(IF *P
|
||||
(CAR ARGS)
|
||||
(LIST (CAR ARGS)))
|
||||
(RECONS X (CAR ARGS)
|
||||
(RELIST-INTERNAL (CDR X)
|
||||
(CDR ARGS)
|
||||
*P))))
|
||||
|
||||
(DEFVAR *GETVALUE-TRANSLATION* :SLOT-VALUE)
|
||||
|
||||
(DEFVAR *CURRENT-DEFINITION*)
|
||||
|
||||
(DEFVAR *CURRENT-DEFINITION-TYPE*)
|
||||
|
||||
(DEFVAR *CURRENT-EXPRESSION*)
|
||||
|
||||
(DEFVAR *CURRENT-LOCALS* NIL)
|
||||
|
||||
(DEFVAR *FILE-CONTEXT* NIL)
|
||||
|
||||
(DEFVAR *WALKER-FIND-PARAMETER-LIST* NIL)
|
||||
|
||||
(DEFVAR *WARNINGS-MADE* NIL)
|
||||
|
||||
(DEFVAR *PACKAGE-FOR-IL-SYMBOLS* NIL)
|
||||
|
||||
(DEFVAR *PACKAGE-FOR-RESULT-FILE* "CL")
|
||||
|
||||
(DEFVAR *PARAMETERS-ALWAYS-OPTIONAL* NIL)
|
||||
|
||||
(DEFVAR *PROMPT-FOR-UNKNOWN-MACRO-TEMPLATE* NIL)
|
||||
|
||||
(DEFVAR *UNKNOWN-MACRO-ACTION* :UM-WARN)
|
||||
|
||||
(DEFVAR *ALWAYS-INCLUDE-PROPS* NIL)
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
|
||||
(IL:PUTPROPS IL:IL-CONVERT IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "IL-CONVERT" :BASE
|
||||
10))
|
||||
|
||||
(IL:PUTPROPS IL:IL-CONVERT IL:FILETYPE :COMPILE-FILE)
|
||||
)
|
||||
(IL:PUTPROPS IL:IL-CONVERT IL:COPYRIGHT ("ENVOS Corporation" 1989 1990))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
IL:STOP
|
||||
1
lispusers/MIGRATION/IL-CONVERT.LCOM
Normal file
1
lispusers/MIGRATION/IL-CONVERT.LCOM
Normal file
File diff suppressed because one or more lines are too long
420
lispusers/MIGRATION/IL-LOOPS
Normal file
420
lispusers/MIGRATION/IL-LOOPS
Normal file
@@ -0,0 +1,420 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "26-Jan-90 10:12:33" {DSK}/users/welch/migration/IL-LOOPS.;8 28689
|
||||
|
||||
changes to%: (FUNCTIONS IL-CONVERT::CONVERT-ONE-CLASS IL-CONVERT::GetValue IL-CONVERT::_Super)
|
||||
|
||||
previous date%: "25-Jan-90 14:14:46" {DSK}/users/welch/migration/IL-LOOPS.;6)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1989, 1990 by Savoir, Inc.. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT IL-LOOPSCOMS)
|
||||
|
||||
(RPAQQ IL-LOOPSCOMS
|
||||
((FUNCTIONS IL-CONVERT::@ IL-CONVERT::_ IL-CONVERT::$ IL-CONVERT::_! IL-CONVERT::_Super
|
||||
IL-CONVERT::_Super? IL-CONVERT::ACTIVE-VALUE-SLOT-SPEC
|
||||
IL-CONVERT::AVSENDSELF-ACCESSOR-WRITER IL-CONVERT::CONVERT-CLASSES
|
||||
IL-CONVERT::CONVERT-METHODS IL-CONVERT::CONVERT-ONE-CLASS
|
||||
IL-CONVERT::CONVERT-ONE-METHOD IL-CONVERT::Class
|
||||
IL-CONVERT::EVERYFETCH-ACCESSOR-WRITER IL-CONVERT::EXPLICIT-FN-ACTIVE-VALUE-SLOT-SPEC
|
||||
IL-CONVERT::FFGETFROMIV-ACCESSOR-WRITER IL-CONVERT::FFSENDSELF-ACCESSOR-WRITER
|
||||
IL-CONVERT::FIRSTFETCH-ACCESSOR-WRITER IL-CONVERT::GETFROMIV-ACCESSOR-WRITER
|
||||
IL-CONVERT::GetValue)
|
||||
(PROP IL-CONVERT::CONVERT-COM CLASSES METHODS)
|
||||
(PROP IL-CONVERT::ACCESSOR-WRITER EveryFetch FFGetFromIV FFSendSelf FirstFetch GetFromIV
|
||||
AVSendSelf)))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::@ (&REST IL-CONVERT::ARGS)
|
||||
(LET [(IL-CONVERT::EXPANSION (Parse@ IL-CONVERT::ARGS
|
||||
'IV]
|
||||
(OR (AND IL-CONVERT::EXPANSION (IL-CONVERT:CONVERT
|
||||
IL-CONVERT::EXPANSION)
|
||||
)
|
||||
(PROGN (CL:WARN "Unrecognizable @ form")
|
||||
IL-CONVERT::*CURRENT-EXPRESSION*))))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::_ (IL-CONVERT::INST IL-CONVERT::METH &REST IL-CONVERT::ARGS)
|
||||
`(,IL-CONVERT::METH ,(IL-CONVERT:CONVERT IL-CONVERT::INST)
|
||||
,.(IL-CONVERT::MAPCONVERT IL-CONVERT::ARGS)))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::$ (IL-CONVERT::NAME)
|
||||
(LET ((IL-CONVERT::REC ($! IL-CONVERT::NAME)))
|
||||
(CL:IF (Class? IL-CONVERT::REC)
|
||||
`[,(IL-CONVERT::MAKE-FAKE-SYMBOL "FIND-CLASS")
|
||||
',(IL-CONVERT:CONVERT IL-CONVERT::NAME]
|
||||
(PROGN (CL:WARN
|
||||
"$ form doesn't refer to a known class"
|
||||
)
|
||||
IL-CONVERT::*CURRENT-EXPRESSION*))))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::_! (IL-CONVERT::INST IL-CONVERT::METH &REST IL-CONVERT::ARGS)
|
||||
`(CL:FUNCALL ,(IL-CONVERT:CONVERT IL-CONVERT::METH)
|
||||
,(IL-CONVERT:CONVERT IL-CONVERT::INST)
|
||||
,.(IL-CONVERT::MAPCONVERT IL-CONVERT::ARGS)))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::_Super (&OPTIONAL IL-CONVERT::OBJ IL-CONVERT::SEL &REST
|
||||
IL-CONVERT::ARGS)
|
||||
(DECLARE (IGNORE IL-CONVERT::OBJ IL-CONVERT::SEL))
|
||||
(CONS (IL-CONVERT::MAKE-FAKE-SYMBOL "CALL-NEXT-METHOD"
|
||||
)
|
||||
(IL-CONVERT::MAPCONVERT IL-CONVERT::ARGS)))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::_Super? (IL-CONVERT::OBJ IL-CONVERT::SEL &REST
|
||||
IL-CONVERT::ARGS)
|
||||
(DECLARE (IGNORE IL-CONVERT::OBJ IL-CONVERT::SEL)
|
||||
)
|
||||
`[AND (,(IL-CONVERT::MAKE-FAKE-SYMBOL "NEXT-METHOD-P"
|
||||
))
|
||||
(,(IL-CONVERT::MAKE-FAKE-SYMBOL
|
||||
"CALL-NEXT-METHOD")
|
||||
,.(IL-CONVERT::MAPCONVERT IL-CONVERT::ARGS])
|
||||
|
||||
(CL:DEFUN IL-CONVERT::ACTIVE-VALUE-SLOT-SPEC (IL-CONVERT::NAME IL-CONVERT::DOC IL-CONVERT::OBJ
|
||||
IL-CONVERT::CLASS-NAME)
|
||||
(DECLARE (CL:DECLARATION CL:VALUES)
|
||||
(CL:VALUES IL-CONVERT::SLOT-SPEC &REST IL-CONVERT::AUX-DEFS))
|
||||
(CASE IL-CONVERT::*GETVALUE-TRANSLATION*
|
||||
(:SLOT-VALUE (LET ((IL-CONVERT::*CURRENT-EXPRESSION* IL-CONVERT::OBJ))
|
||||
(CL:WARN "Active value in SLOT-VALUE GetValue mode")
|
||||
IL-CONVERT::OBJ))
|
||||
(:ACCESSOR (CASE (ClassName IL-CONVERT::OBJ)
|
||||
(ExplicitFnActiveValue (IL-CONVERT::EXPLICIT-FN-ACTIVE-VALUE-SLOT-SPEC
|
||||
IL-CONVERT::NAME IL-CONVERT::DOC IL-CONVERT::OBJ
|
||||
IL-CONVERT::CLASS-NAME))
|
||||
(CL:OTHERWISE
|
||||
[LET* ((IL-CONVERT::GM (GetIt (Class IL-CONVERT::OBJ)
|
||||
'GetWrappedValue NIL 'METHOD))
|
||||
[IL-CONVERT::GMCLASS (CL:SECOND (GETDEF IL-CONVERT::GM 'METHODS]
|
||||
(IL-CONVERT::PM (GetIt (Class IL-CONVERT::OBJ)
|
||||
'PutWrappedValue NIL 'METHOD))
|
||||
(IL-CONVERT::PMCLASS (CL:SECOND (GETDEF IL-CONVERT::PM 'METHODS]
|
||||
(LET ((IL-CONVERT::*CURRENT-EXPRESSION* IL-CONVERT::OBJ))
|
||||
(CL:WARN "Unconvertable ~a in defclass" (ClassName IL-CONVERT::OBJ)))
|
||||
IL-CONVERT::OBJ)))
|
||||
(:ACTIVE-VALUE (LET ((IL-CONVERT::*CURRENT-EXPRESSION* IL-CONVERT::OBJ))
|
||||
(CL:WARN "Active value emulator not written yet")
|
||||
IL-CONVERT::OBJ))))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::AVSENDSELF-ACCESSOR-WRITER (IL-CONVERT::VARNAME IL-CONVERT::SELFVAR
|
||||
IL-CONVERT::LOCALSTATE)
|
||||
[IL-CONVERT:CONVERT `(_ ,IL-CONVERT::SELFVAR ,IL-CONVERT::LOCALSTATE)])
|
||||
|
||||
(CL:DEFUN IL-CONVERT::CONVERT-CLASSES (IL-CONVERT::CS)
|
||||
(IL-CONVERT::MAP-INTO-CONTEXT 'IL-CONVERT::CONVERT-ONE-CLASS IL-CONVERT::CS))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::CONVERT-METHODS (IL-CONVERT::MS)
|
||||
(CONS 'PROGN (IL-CONVERT::MAP-INTO-CONTEXT 'IL-CONVERT::CONVERT-ONE-METHOD IL-CONVERT::MS)))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::CONVERT-ONE-CLASS (IL-CONVERT::C)
|
||||
""
|
||||
[LET*
|
||||
((IL-CONVERT::SRC (_ [OR ($! IL-CONVERT::C)
|
||||
(LET ((IL-CONVERT::*CURRENT-EXPRESSION* IL-CONVERT::C))
|
||||
(CL:WARN "Class not found")
|
||||
(CL:RETURN-FROM IL-CONVERT::CONVERT-ONE-CLASS
|
||||
(LIST '* ';; (CL:FORMAT NIL "Class ~a not found."
|
||||
IL-CONVERT::C]
|
||||
MakeFileSource))
|
||||
(IL-CONVERT::CLASSNAME (IL-CONVERT:CONVERT (CL:SECOND IL-CONVERT::SRC)))
|
||||
(IL-CONVERT::*CURRENT-DEFINITION* IL-CONVERT::CLASSNAME)
|
||||
(IL-CONVERT::*CURRENT-DEFINITION-TYPE* "Class")
|
||||
(IL-CONVERT::*CURRENT-FUNCTION-CALLS* (LIST IL-CONVERT::CLASSNAME))
|
||||
(IL-CONVERT::*CURRENT-FREE-REFERENCES* (LIST IL-CONVERT::CLASSNAME))
|
||||
(IL-CONVERT::ATTRIBUTES (CDDR IL-CONVERT::SRC))
|
||||
(IL-CONVERT::META (CDR (CL:ASSOC 'MetaClass IL-CONVERT::ATTRIBUTES)))
|
||||
(IL-CONVERT::SUPERS (CDR (CL:ASSOC 'Supers IL-CONVERT::ATTRIBUTES)))
|
||||
(IL-CONVERT::CVS (CDR (CL:ASSOC 'ClassVariables IL-CONVERT::ATTRIBUTES)))
|
||||
(IL-CONVERT::IVS (CDR (CL:ASSOC 'InstanceVariables IL-CONVERT::ATTRIBUTES)))
|
||||
IL-CONVERT::PROPS-ALIST IL-CONVERT::AUX-DEFS)
|
||||
(CL:LABELS
|
||||
([IL-CONVERT::LOOPS-CONVERT (IL-CONVERT::X)
|
||||
(COND
|
||||
[(Class? IL-CONVERT::X)
|
||||
`(IL-CONVERT::FIND-CLASS ',(IL-CONVERT:CONVERT (_ IL-CONVERT::X ClassName)]
|
||||
((AnnotatedValue? IL-CONVERT::X)
|
||||
(IL-CONVERT::AV-CONVERT IL-CONVERT::X))
|
||||
((CL:CONSP IL-CONVERT::X)
|
||||
(CL:MAPCAR #'IL-CONVERT::LOOPS-CONVERT IL-CONVERT::X))
|
||||
((Instance? IL-CONVERT::X)
|
||||
(LET ((IL-CONVERT::*CURRENT-EXPRESSION* IL-CONVERT::X))
|
||||
(CL:WARN "Unconvertable LOOPS object in defclass"))
|
||||
IL-CONVERT::X)
|
||||
(T (IL-CONVERT:CONVERT IL-CONVERT::X]
|
||||
(IL-CONVERT::AV-CONVERT (IL-CONVERT::NAME IL-CONVERT::DOC IL-CONVERT::OBJ)
|
||||
(CL:SETQ IL-CONVERT::OBJ (fetch annotatedValue of IL-CONVERT::OBJ))
|
||||
(LET [(CL:VALUES (CL:MULTIPLE-VALUE-LIST (IL-CONVERT::ACTIVE-VALUE-SLOT-SPEC
|
||||
IL-CONVERT::NAME IL-CONVERT::DOC
|
||||
IL-CONVERT::OBJ IL-CONVERT::CLASSNAME]
|
||||
(CL:SETQ IL-CONVERT::AUX-DEFS (NCONC IL-CONVERT::AUX-DEFS (CDR CL:VALUES)))
|
||||
(CAR CL:VALUES)))
|
||||
(IL-CONVERT::PROCESS-IV
|
||||
(IL-CONVERT::SPEC &OPTIONAL IL-CONVERT::ALLOC &AUX IL-CONVERT::DOC)
|
||||
(LET* [(IL-CONVERT::NAME (IL-CONVERT:CONVERT (CL:FIRST IL-CONVERT::SPEC)))
|
||||
(IL-CONVERT::OBJ (CL:SECOND IL-CONVERT::SPEC))
|
||||
(IL-CONVERT::DOC (CL:GETF (CDDR IL-CONVERT::SPEC)
|
||||
'doc))
|
||||
[IL-CONVERT::CONVERSION (CL:IF (type? annotatedValue IL-CONVERT::OBJ)
|
||||
(IL-CONVERT::AV-CONVERT IL-CONVERT::NAME IL-CONVERT::DOC
|
||||
IL-CONVERT::OBJ)
|
||||
`[,IL-CONVERT::NAME
|
||||
,@[AND (CDR IL-CONVERT::SPEC)
|
||||
`(:INITFORM ,(IL-CONVERT::LOOPS-CONVERT
|
||||
IL-CONVERT::OBJ]
|
||||
:INITARG
|
||||
,(CL:INTERN (STRING (CL:FIRST IL-CONVERT::SPEC))
|
||||
*KEYWORD-PACKAGE*)
|
||||
,@[AND IL-CONVERT::ALLOC `(:ALLOCATION
|
||||
,IL-CONVERT::ALLOC]
|
||||
,@(AND IL-CONVERT::DOC `(:DOCUMENTATION ,IL-CONVERT::DOC])
|
||||
]
|
||||
(IL-CONVERT::PROPS (CL:COPY-LIST (CL:IF IL-CONVERT::DOC
|
||||
(AND (CDDR (CDDR IL-CONVERT::SPEC))
|
||||
(CDDR IL-CONVERT::SPEC))
|
||||
(CDDR IL-CONVERT::SPEC))]
|
||||
|
||||
(* ;; "The following (when not quoted) fails to compile, for some reason:")
|
||||
|
||||
'(CL:REMF IL-CONVERT::PROPS 'doc)
|
||||
(CL:WHEN IL-CONVERT::PROPS
|
||||
(CL:PUSH (CONS IL-CONVERT::NAME IL-CONVERT::PROPS)
|
||||
IL-CONVERT::PROPS-ALIST))
|
||||
IL-CONVERT::CONVERSION)))
|
||||
(LET [(IL-CONVERT::FORM `(,(IL-CONVERT::MAKE-FAKE-SYMBOL "DEFCLASS")
|
||||
,IL-CONVERT::CLASSNAME
|
||||
,(IL-CONVERT::MAPCONVERT IL-CONVERT::SUPERS)
|
||||
[,@(CL:REMOVE-IF 'NULL (CL:MAPCAR #'IL-CONVERT::PROCESS-IV
|
||||
IL-CONVERT::IVS))
|
||||
,@(CL:REMOVE-IF 'NULL (for IL-CONVERT::CV in IL-CONVERT::CVS
|
||||
collect (IL-CONVERT::PROCESS-IV
|
||||
IL-CONVERT::CV :CLASS)))
|
||||
,@(AND (OR IL-CONVERT::PROPS-ALIST IL-CONVERT::*ALWAYS-INCLUDE-PROPS*
|
||||
)
|
||||
`(IL-CONVERT::.PROPS-ALIST. :INITFORM '
|
||||
,
|
||||
IL-CONVERT::PROPS-ALIST
|
||||
]
|
||||
,@(CL:UNLESS (EQ (CAR IL-CONVERT::META)
|
||||
'Class)
|
||||
[LET [(IL-CONVERT::*CURRENT-EXPRESSION* (IL-CONVERT:CONVERT
|
||||
(CAR IL-CONVERT::META]
|
||||
(CL:WARN "Metaclass might be incorrect")
|
||||
`(:METACLASS ,IL-CONVERT::*CURRENT-EXPRESSION*])]
|
||||
(CL:IF IL-CONVERT::AUX-DEFS
|
||||
`(PROGN ,IL-CONVERT::FORM ,.IL-CONVERT::AUX-DEFS)
|
||||
IL-CONVERT::FORM)])
|
||||
|
||||
(CL:DEFUN IL-CONVERT::CONVERT-ONE-METHOD (IL-CONVERT::M)
|
||||
(LET* ((IL-CONVERT::METHOD-BODY (\DEFINE-TYPE-GETDEF IL-CONVERT::M 'METHOD-FNS))
|
||||
[IL-CONVERT::METHOD-CLASS (CL:FIRST (CL:FIRST (CL:SECOND IL-CONVERT::METHOD-BODY]
|
||||
[IL-CONVERT::METHOD-SELECTOR (CL:SECOND (CL:FIRST (CL:SECOND IL-CONVERT::METHOD-BODY]
|
||||
(IL-CONVERT::METHOD-ARGS (CDR (CL:SECOND IL-CONVERT::METHOD-BODY)))
|
||||
(IL-CONVERT::METHOD-FNBODY (CDDR IL-CONVERT::METHOD-BODY))
|
||||
(IL-CONVERT::*CURRENT-DEFINITION* IL-CONVERT::M)
|
||||
(IL-CONVERT::*CURRENT-DEFINITION-TYPE* "Function")
|
||||
(IL-CONVERT::*CURRENT-FUNCTION-CALLS* (LIST IL-CONVERT::M))
|
||||
(IL-CONVERT::*CURRENT-FREE-REFERENCES* (LIST IL-CONVERT::M))
|
||||
(IL-CONVERT::*SELF-VARIABLE* (CL:FIRST IL-CONVERT::METHOD-ARGS)))
|
||||
(DECLARE (CL:SPECIAL IL-CONVERT::*SELF-VARIABLE*))
|
||||
(CL:VALUES [CL:MULTIPLE-VALUE-BIND (IL-CONVERT::NEW-VARLST IL-CONVERT::VARNAMES)
|
||||
(IL-CONVERT::EXPAND-VARLIST IL-CONVERT::METHOD-ARGS)
|
||||
[LET ((IL-CONVERT::*LOCALS* (CL:COPY-LIST IL-CONVERT::VARNAMES)))
|
||||
(CL:WHEN (AND (CDR IL-CONVERT::NEW-VARLST)
|
||||
IL-CONVERT::*PARAMETERS-ALWAYS-OPTIONAL*)
|
||||
(CL:PUSH '&OPTIONAL (CDR IL-CONVERT::NEW-VARLST)))]
|
||||
`(,(IL-CONVERT::MAKE-FAKE-SYMBOL 'IL-CONVERT::DEFMETHOD)
|
||||
,IL-CONVERT::METHOD-SELECTOR
|
||||
[(,(CL:FIRST IL-CONVERT::NEW-VARLST)
|
||||
,IL-CONVERT::METHOD-CLASS)
|
||||
,@(CDR IL-CONVERT::NEW-VARLST)
|
||||
,@(AND IL-CONVERT::*ADD-REST-ARG* '(&REST IL-CONVERT::$EXTRA-ARGS$]
|
||||
,.(IL-CONVERT::MAPCONVERT IL-CONVERT::METHOD-FNBODY]
|
||||
(CL:NREVERSE IL-CONVERT::*CURRENT-FUNCTION-CALLS*)
|
||||
(CL:NREVERSE IL-CONVERT::*CURRENT-FREE-REFERENCES*))))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::Class (IL-CONVERT::X)
|
||||
`(,(IL-CONVERT::MAKE-FAKE-SYMBOL 'IL-CONVERT::CLASS-OF)
|
||||
,(IL-CONVERT:CONVERT IL-CONVERT::X)))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::EVERYFETCH-ACCESSOR-WRITER (IL-CONVERT::VARNAME IL-CONVERT::SELFVAR
|
||||
IL-CONVERT::LOCALSTATE)
|
||||
(CL:IF (OR (CL:SYMBOLP IL-CONVERT::LOCALSTATE)
|
||||
(IL-CONVERT::FAKE-SYMBOL-P IL-CONVERT::LOCALSTATE))
|
||||
`(CL:FUNCALL ,(IL-CONVERT:CONVERT IL-CONVERT::LOCALSTATE))
|
||||
(IL-CONVERT:CONVERT IL-CONVERT::LOCALSTATE)))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::EXPLICIT-FN-ACTIVE-VALUE-SLOT-SPEC (IL-CONVERT::NAME IL-CONVERT::DOC
|
||||
IL-CONVERT::OBJ
|
||||
IL-CONVERT::CLASS-NAME)
|
||||
|
||||
(* ;; "Old-style AVs done here. ")
|
||||
|
||||
(LET* ((IL-CONVERT::LS (@ IL-CONVERT::OBJ localState))
|
||||
(IL-CONVERT::GF (@ IL-CONVERT::OBJ getFn))
|
||||
(IL-CONVERT::PF (@ IL-CONVERT::OBJ putFn))
|
||||
(IL-CONVERT::CODEWRITER (GET IL-CONVERT::GF 'IL-CONVERT::ACCESSOR-WRITER))
|
||||
IL-CONVERT::DEFS)
|
||||
|
||||
(* ;; " Write the accessor...")
|
||||
|
||||
(CL:UNLESS IL-CONVERT::CODEWRITER
|
||||
(LET ((IL-CONVERT::*CURRENT-EXPRESSION* (LIST IL-CONVERT::NAME :INITFORM IL-CONVERT::OBJ
|
||||
)))
|
||||
(CL:WARN "No accessor-writer for ~a" IL-CONVERT::GF)
|
||||
(CL:RETURN-FROM IL-CONVERT::EXPLICIT-FN-ACTIVE-VALUE-SLOT-SPEC
|
||||
IL-CONVERT::*CURRENT-EXPRESSION*)))
|
||||
(LET* [(CL:NAMESTRING (CL:IF (IL-CONVERT::FAKE-SYMBOL-P IL-CONVERT::NAME)
|
||||
(IL-CONVERT::FAKE-SYMBOL-NAME IL-CONVERT::NAME)
|
||||
(STRING IL-CONVERT::NAME)))
|
||||
[IL-CONVERT::VARNAME (AND (CL:CONSP IL-CONVERT::CODEWRITER)
|
||||
(CDR IL-CONVERT::CODEWRITER)
|
||||
(IL-CONVERT::MAKE-FAKE-SYMBOL (CL:CONCATENATE 'STRING
|
||||
"!CACHE-FOR-"
|
||||
CL:NAMESTRING]
|
||||
(IL-CONVERT::CODE (CL:FUNCALL (CL:IF (CL:CONSP IL-CONVERT::CODEWRITER)
|
||||
(CAR IL-CONVERT::CODEWRITER)
|
||||
IL-CONVERT::CODEWRITER)
|
||||
IL-CONVERT::VARNAME
|
||||
'self IL-CONVERT::LS))
|
||||
(IL-CONVERT::ACCESSOR (IL-CONVERT::MAKE-FAKE-SYMBOL (CL:CONCATENATE 'STRING
|
||||
"!ACCESSOR-FOR-"
|
||||
CL:NAMESTRING]
|
||||
(CL:PUSH `(,(IL-CONVERT::MAKE-FAKE-SYMBOL "DEFMETHOD")
|
||||
,IL-CONVERT::ACCESSOR
|
||||
((,(IL-CONVERT::MAKE-FAKE-SYMBOL "SELF")
|
||||
,IL-CONVERT::CLASS-NAME))
|
||||
,IL-CONVERT::CODE)
|
||||
IL-CONVERT::DEFS)
|
||||
|
||||
(* ;; "Look at putfn...")
|
||||
|
||||
(CL:UNLESS (CL:MEMBER IL-CONVERT::PF '(ReplaceMe NoUpdatePermitted))
|
||||
(LET [(IL-CONVERT::CODEWRITER (GET IL-CONVERT::PF 'IL-CONVERT::ACCESSOR-WRITER]
|
||||
(CL:UNLESS IL-CONVERT::CODEWRITER
|
||||
(LET ((IL-CONVERT::*CURRENT-EXPRESSION* (LIST IL-CONVERT::NAME :INITFORM
|
||||
IL-CONVERT::OBJ)))
|
||||
(CL:WARN "No accessor-writer for ~a" IL-CONVERT::PF)
|
||||
(CL:RETURN-FROM IL-CONVERT::EXPLICIT-FN-ACTIVE-VALUE-SLOT-SPEC
|
||||
IL-CONVERT::*CURRENT-EXPRESSION*)))
|
||||
(LET ((IL-CONVERT::CODE (CL:FUNCALL IL-CONVERT::CODEWRITER
|
||||
IL-CONVERT::VARNAME 'self IL-CONVERT::LS)))
|
||||
(CL:PUSH `(,(IL-CONVERT::MAKE-FAKE-SYMBOL "DEFMETHOD")
|
||||
(CL:SETF ,IL-CONVERT::ACCESSOR)
|
||||
((self ,IL-CONVERT::CLASS-NAME))
|
||||
,IL-CONVERT::CODE)
|
||||
IL-CONVERT::DEFS))))
|
||||
|
||||
(* ;; "Make slot spec...")
|
||||
|
||||
(CL:APPLY 'CL:VALUES (* ; "values-list* y'might say")
|
||||
[AND IL-CONVERT::VARNAME
|
||||
`(,IL-CONVERT::VARNAME ,@(AND (EQ IL-CONVERT::PF 'ReplaceMe)
|
||||
`(:WRITER (CL:SETF ,IL-CONVERT::ACCESSOR]
|
||||
IL-CONVERT::DEFS))))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::FFGETFROMIV-ACCESSOR-WRITER (IL-CONVERT::VARNAME IL-CONVERT::SELFVAR
|
||||
IL-CONVERT::LOCALSTATE)
|
||||
`(CL:IF (IL-CONVERT::SLOT-BOUNDP ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
(IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
[CL:SETF (IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
(IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::LOCALSTATE]))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::FFSENDSELF-ACCESSOR-WRITER (IL-CONVERT::VARNAME IL-CONVERT::SELFVAR
|
||||
IL-CONVERT::LOCALSTATE)
|
||||
`(CL:IF (IL-CONVERT::SLOT-BOUNDP ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
(IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
[CL:SETF (IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
,(IL-CONVERT:CONVERT `(_ ,IL-CONVERT::SELFVAR ,IL-CONVERT::LOCALSTATE)]))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::FIRSTFETCH-ACCESSOR-WRITER (IL-CONVERT::VARNAME IL-CONVERT::SELFVAR
|
||||
IL-CONVERT::LOCALSTATE)
|
||||
`(CL:IF (IL-CONVERT::SLOT-BOUNDP ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
(IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
(CL:SETF (IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::VARNAME)
|
||||
,(CL:IF (OR (CL:SYMBOLP IL-CONVERT::LOCALSTATE)
|
||||
(IL-CONVERT::FAKE-SYMBOL-P IL-CONVERT::LOCALSTATE))
|
||||
`(CL:FUNCALL ,IL-CONVERT::LOCALSTATE)
|
||||
IL-CONVERT::LOCALSTATE))))
|
||||
|
||||
(CL:DEFUN IL-CONVERT::GETFROMIV-ACCESSOR-WRITER (IL-CONVERT::VARNAME IL-CONVERT::SELFVAR
|
||||
IL-CONVERT::LOCALSTATE)
|
||||
`(IL-CONVERT::SLOT-VALUE ,IL-CONVERT::SELFVAR ',IL-CONVERT::LOCALSTATE))
|
||||
|
||||
(IL-CONVERT::IL-DEFCONV IL-CONVERT::GetValue (IL-CONVERT::INST &OPTIONAL IL-CONVERT::VAR
|
||||
IL-CONVERT::PROP)
|
||||
[COND
|
||||
(IL-CONVERT::PROP (LIST (
|
||||
IL-CONVERT::MAKE-FAKE-SYMBOL
|
||||
"SLOT-PROP-VALUE")
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::INST)
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::VAR)
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::PROP)))
|
||||
[IL-CONVERT::VAR
|
||||
(CL:ECASE IL-CONVERT::*GETVALUE-TRANSLATION*
|
||||
(:SLOT-VALUE (LIST
|
||||
IL-CONVERT::*SLOT-VALUE-FAKESYM*
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::INST)
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::VAR)))
|
||||
(:ACCESSOR
|
||||
(CL:IF (AND (CL:CONSP IL-CONVERT::VAR)
|
||||
(EQ (CAR IL-CONVERT::VAR)
|
||||
'QUOTE))
|
||||
(LIST
|
||||
[IL-CONVERT::MAKE-FAKE-SYMBOL
|
||||
(CL:CONCATENATE
|
||||
'STRING "access-"
|
||||
(LET [(IL-CONVERT::NEWNAME
|
||||
(IL-CONVERT:CONVERT
|
||||
(CL:SECOND IL-CONVERT::VAR
|
||||
]
|
||||
(CL:IF (
|
||||
IL-CONVERT::FAKE-SYMBOL-P
|
||||
IL-CONVERT::NEWNAME)
|
||||
(
|
||||
IL-CONVERT::FAKE-SYMBOL-NAME
|
||||
IL-CONVERT::NEWNAME)
|
||||
(CL:SYMBOL-NAME
|
||||
IL-CONVERT::NEWNAME
|
||||
))]
|
||||
(IL-CONVERT:CONVERT IL-CONVERT::INST
|
||||
))
|
||||
(PROGN (CL:WARN
|
||||
"Unquoted IV spec in :ACCESSOR GetValue mode"
|
||||
)
|
||||
|
||||
IL-CONVERT::*CURRENT-EXPRESSION*
|
||||
)))
|
||||
(:ACTIVE-VALUE (IL-CONVERT::MAKE-FAKE-SYMBOL
|
||||
"ACTIVE-VALUE"
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::INST)
|
||||
(IL-CONVERT:CONVERT
|
||||
IL-CONVERT::VAR))))]
|
||||
(T (IL-CONVERT:CONVERT `(GetValue self
|
||||
,IL-CONVERT::INST])
|
||||
|
||||
(PUTPROPS CLASSES IL-CONVERT::CONVERT-COM IL-CONVERT::CONVERT-CLASSES)
|
||||
|
||||
(PUTPROPS METHODS IL-CONVERT::CONVERT-COM IL-CONVERT::CONVERT-METHODS)
|
||||
|
||||
(PUTPROPS EveryFetch IL-CONVERT::ACCESSOR-WRITER IL-CONVERT::EVERYFETCH-ACCESSOR-WRITER)
|
||||
|
||||
(PUTPROPS FFGetFromIV IL-CONVERT::ACCESSOR-WRITER (IL-CONVERT::FFGETFROMIV-ACCESSOR-WRITER . T))
|
||||
|
||||
(PUTPROPS FFSendSelf IL-CONVERT::ACCESSOR-WRITER (IL-CONVERT::FFSENDSELF-ACCESSOR-WRITER . T))
|
||||
|
||||
(PUTPROPS FirstFetch IL-CONVERT::ACCESSOR-WRITER (IL-CONVERT::FIRSTFETCH-ACCESSOR-WRITER . T))
|
||||
|
||||
(PUTPROPS GetFromIV IL-CONVERT::ACCESSOR-WRITER (IL-CONVERT::FFGETFROMIV-ACCESSOR-WRITER))
|
||||
|
||||
(PUTPROPS AVSendSelf IL-CONVERT::ACCESSOR-WRITER IL-CONVERT::AVSENDSELF-ACCESSOR-WRITER)
|
||||
(PUTPROPS IL-LOOPS COPYRIGHT ("Savoir, Inc." 1989 1990))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
1
lispusers/MIGRATION/IL-LOOPS.LCOM
Normal file
1
lispusers/MIGRATION/IL-LOOPS.LCOM
Normal file
File diff suppressed because one or more lines are too long
214
lispusers/MIGRATION/IL-RECORD
Normal file
214
lispusers/MIGRATION/IL-RECORD
Normal file
@@ -0,0 +1,214 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "IL-CONVERT" READTABLE "XCL")
|
||||
(IL:FILECREATED "14-Sep-89 10:03:02" IL:|{DSK}/python2/aria/migration/interlisp/IL-RECORD.;2| 21305
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS MAKE-RECORD-ACCESSORS |fetch| |replace| |DO-create|)
|
||||
|
||||
IL:|previous| IL:|date:| " 2-Mar-89 13:12:40" IL:|{DSK}/users/eweaver/convert/IL-RECORD.;4|)
|
||||
|
||||
|
||||
; Copyright (c) 1989 by ENVOS Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:IL-RECORDCOMS)
|
||||
|
||||
(IL:RPAQQ IL:IL-RECORDCOMS ((IL:* IL:\| "chapter 8") (IL:VARIABLES *RECORD-TYPES*) (IL:FUNCTIONS ADD-EXPORTS ASSOCRECORD PROPRECORD ATOMRECORD BLOCKRECORD) (IL:FUNCTIONS ARRAYRECORD DEFINE-ARRAYRECORD-STRUCTURE) (IL:* IL:\; " ^'(arrayrecord foo (a b c) b _ 3)") (IL:FUNCTIONS INTERLISP-COMMENT-P) (IL:FUNCTIONS RECORD) (IL:FUNCTIONS TYPERECORD FLATTEN MAKE-RECORD-ACCESSORS DEFINE-RECORD-STRUCTURE) (IL:* IL:\; " ^'(record foo (a b . c) b _ 3) ") (IL:* IL:|;;| "
|
||||
; this version defines a defstruct which is not really the same
|
||||
; as the IL record type.
|
||||
(defun
|
||||
define-record-structure (record-name record-fields named record-tail)
|
||||
(let* ((name-string (symbol-name record-name))
|
||||
(struct-name (intern name-string))
|
||||
(*current-record-name* record-name)
|
||||
(slots nil))
|
||||
(declare (special *current-record-name*))
|
||||
(setq record-fields (make-true-list record-fields))
|
||||
(do ((fields record-fields (rest fields))
|
||||
field)
|
||||
((null fields) (setq slots (nreverse slots)))
|
||||
(setq field (first fields))
|
||||
(cond
|
||||
((null field )
|
||||
(warn \"NIL as record field name not supported\"))
|
||||
((atom field) (push field slots))
|
||||
((eq (first field) '*)) ;Ignore comments
|
||||
(t (setq slots (append (reverse (flatten field)) slots)))))
|
||||
(setf (gethash struct-name *record-types*) slots)
|
||||
(multiple-value-bind
|
||||
(record-tail-forms record-tail-inits)
|
||||
(process-record-tail record-tail)
|
||||
(add-exports
|
||||
`((defstruct
|
||||
,struct-name
|
||||
(:type list)
|
||||
(:named ,named)
|
||||
,@(mapcar
|
||||
#'(lambda (slot &aux pair)
|
||||
(if (setq pair (assoc slot record-tail-inits))
|
||||
`(,slot ,(cdr pair))
|
||||
slot))
|
||||
slots))
|
||||
,@record-tail-forms)))))
|
||||
") (IL:* IL:|;;| "Returns two values: a list of forms to be generated, and a list of (slot . init-form) pairs.") (IL:FUNCTIONS PROCESS-RECORD-TAIL) (IL:* IL:|;;| "Define user-created access functions. It doesn't matter if these fields are part of the structure or not. If so, they will redefine the access functions created by defstruct.") (IL:FUNCTIONS ACCESSFNS) (IL:* IL:|;;| " (convert '(accessfns pilotbbt ((pbtsource foo1 foo2))))") (IL:FUNCTIONS DATATYPE FIELD-TO-SLOT-TYPE /DECLAREDATATYPE FIND-RECORD-TYPE FIND-RECORD-FIELDS |fetch| |replace| TYPE? |create| |DO-create|) (IL:P (IL-COPYCONV |fetch| FETCH) (IL-COPYCONV |fetch| |ffetch|) (IL-COPYCONV |ffetch| FFETCH) (IL-COPYCONV |replace| REPLACE) (IL-COPYCONV |replace| |freplace|) (IL-COPYCONV |freplace| FREPLACE) (IL-COPYCONV TYPE? |type?|) (IL-COPYCONV |create| CREATE)) (IL:PROP (IL:MAKEFILE-ENVIRONMENT IL:FILETYPE) IL:IL-RECORD))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(IL:* IL:\| "chapter 8")
|
||||
|
||||
|
||||
(DEFVAR *RECORD-TYPES* (MAKE-HASH-TABLE :SIZE 100))
|
||||
|
||||
(DEFUN ADD-EXPORTS (FORMS &AUX (EXPORT-LIST NIL)) (DOLIST (FORM FORMS) (AND (CONSP FORM) (MEMBER (FIRST FORM) (QUOTE (DEFUN DEFMACRO)) :TEST (FUNCTION EQ)) (PUSH (SECOND FORM) EXPORT-LIST))) (IF EXPORT-LIST (IL:BQUOTE (PROGN (EXPORT (QUOTE (IL:\\\, (REVERSE EXPORT-LIST)))) (IL:\\\,@ FORMS))) (PROGN-IF-NEEDED FORMS)))
|
||||
|
||||
(IL-DEFCONV ASSOCRECORD (RECORD-NAME RECORD-FIELDS &REST RECORD-TAIL) (DECLARE (IGNORE RECORD-NAME RECORD-FIELDS RECORD-TAIL)) (WARN "ASSOCRECORD not supported") (IL:* IL:|;;| "
|
||||
(setf
|
||||
(gethash record-name *record-types*)
|
||||
(mapcar #'car record-fields))
|
||||
(process-record-tail record-tail)
|
||||
"))
|
||||
|
||||
(IL-DEFCONV PROPRECORD (RECORD-NAME RECORD-FIELDS &REST RECORD-TAIL) (DECLARE (IGNORE RECORD-NAME RECORD-FIELDS RECORD-TAIL)) (WARN "PROPRECORD not supported") (IL:* IL:|;;| "
|
||||
(setf
|
||||
(gethash record-name *record-types*)
|
||||
(do ((fields record-fields (rest (rest fields)))
|
||||
(slots nil))
|
||||
((endp fields) (nreverse slots))
|
||||
(push (first fields) slots))
|
||||
(process-record-tail record-tail))
|
||||
"))
|
||||
|
||||
(IL-DEFCONV ATOMRECORD (RECORD-NAME RECORD-FIELDS &REST RECORD-TAIL) (DECLARE (IGNORE RECORD-NAME RECORD-FIELDS RECORD-TAIL)) (WARN "ATOMRECORD not supported"))
|
||||
|
||||
(IL-DEFCONV BLOCKRECORD (RECORD-NAME RECORD-FIELDS &REST RECORD-TAIL) (DECLARE (IGNORE RECORD-TAIL)) (DECLARE (SPECIAL *ADD-TO-RECORD-DEFN*)) (WARN "BLOCKRECORD not supported") (DO ((FIELDS RECORD-FIELDS (REST FIELDS)) (SLOTS NIL) FIELD) ((ENDP FIELDS) (SETF (GETHASH RECORD-NAME *RECORD-TYPES*) (IF (BOUNDP (QUOTE *ADD-TO-RECORD-DEFN*)) (APPEND (NREVERSE SLOTS) (GETHASH RECORD-NAME *RECORD-TYPES*)) (NREVERSE SLOTS)))) (SETQ FIELD (FIRST FIELDS)) (WHEN (CONSP FIELD) (SETQ FIELD (FIRST FIELD))) (WHEN (AND FIELD (NOT (INTEGERP FIELD))) (PUSH FIELD SLOTS))) NIL)
|
||||
|
||||
(IL-DEFCONV ARRAYRECORD (RECORD-NAME RECORD-FIELDS &REST RECORD-TAIL) (DEFINE-ARRAYRECORD-STRUCTURE RECORD-NAME RECORD-FIELDS RECORD-TAIL))
|
||||
|
||||
(DEFUN DEFINE-ARRAYRECORD-STRUCTURE (RECORD-NAME RECORD-FIELDS RECORD-TAIL) (LET ((*CURRENT-RECORD-NAME* RECORD-NAME)) (DECLARE (SPECIAL *CURRENT-RECORD-NAME*)) (MULTIPLE-VALUE-BIND (RECORD-TAIL-FORMS RECORD-TAIL-INITS) (PROCESS-RECORD-TAIL RECORD-TAIL) (LET ((NAME-STRING (SYMBOL-NAME RECORD-NAME)) (FIELD-FNS NIL) (INITS NIL) (KEYS NIL) CREATE-FN (LENGTH 0)) (DO ((I 0 (1+ I)) (FIELDS RECORD-FIELDS (REST FIELDS)) FIELD) ((ENDP FIELDS) (SETQ FIELD-FNS (NREVERSE FIELD-FNS)) (SETQ INITS (NREVERSE INITS)) (SETQ KEYS (NREVERSE KEYS))) (IL:* IL:|;;| "Define accessor functions. We don't need to define") (IL:* IL:|;;| "setf methods because the accessors are actually") (IL:* IL:|;;| "macros which generate calls to svref, and setf") (IL:* IL:\; "already knows how to handle svref.") (SETQ FIELD (FIRST FIELDS)) (INCF LENGTH) (COND ((INTEGERP FIELD) (INCF I (1- FIELD)) (INCF LENGTH (1- FIELD))) ((NULL FIELD)) (T (PUSH (IL:BQUOTE (DEFMACRO (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) NAME-STRING "-" (SYMBOL-NAME FIELD)))) (X) (IL:\\\, (MAKE-BQ (IL:BQUOTE (SVREF (IL:\\\, (MAKE-MACRO-ARG :ELEMENT (QUOTE X))) (IL:\\\, I))))))) FIELD-FNS) (LET ((SVAR (INTERN (CONCATENATE (QUOTE STRING) (SYMBOL-NAME FIELD) "-SET")))) (PUSH (IL:BQUOTE (WHEN (IL:\\\, SVAR) (SETF (SVREF $X$ (IL:\\\, I)) (IL:\\\, FIELD)))) INITS) (PUSH (IL:BQUOTE ((IL:\\\, FIELD) (IL:\\\, (CDR (ASSOC FIELD RECORD-TAIL-INITS))) (IL:\\\, SVAR))) KEYS))))) (SETQ CREATE-FN (IL:BQUOTE (DEFUN (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "MAKE-" NAME-STRING))) (&KEY (IL:\\\,@ KEYS)) (LET (($X$) (MAKE-ARRAY (IL:\\\, LENGTH))) (IL:\\\,@ INITS) $X$)))) (ADD-EXPORTS (IL:BQUOTE ((IL:\\\, CREATE-FN) (IL:\\\,@ FIELD-FNS) (IL:\\\,@ RECORD-TAIL-FORMS))))))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:\; " ^'(arrayrecord foo (a b c) b _ 3)")
|
||||
|
||||
|
||||
(DEFUN INTERLISP-COMMENT-P (X) (AND (CONSP X) (EQ (FIRST X) (QUOTE *))))
|
||||
|
||||
(IL-DEFCONV RECORD (&REST ARGS) (SETQ ARGS (REMOVE-IF (FUNCTION INTERLISP-COMMENT-P) ARGS)) (DEFINE-RECORD-STRUCTURE (FIRST ARGS) (SECOND ARGS) NIL (REST (REST ARGS))))
|
||||
|
||||
(IL-DEFCONV TYPERECORD (&REST ARGS) (SETQ ARGS (REMOVE-IF (FUNCTION INTERLISP-COMMENT-P) ARGS)) (DEFINE-RECORD-STRUCTURE (FIRST ARGS) (SECOND ARGS) T (REST (REST ARGS))))
|
||||
|
||||
(DEFUN FLATTEN (X) (COND ((CONSP X) (APPEND (FLATTEN (CAR X)) (FLATTEN (CDR X)))) ((NULL X) NIL) (T (CONS X NIL))))
|
||||
|
||||
(DEFUN MAKE-RECORD-ACCESSORS (RECORD-NAME TREE PATH) (COND ((NULL TREE) NIL) ((ATOM TREE) (LET ((ACCESSOR-NAME (INTERN (CONCATENATE (QUOTE STRING) RECORD-NAME "-" (SYMBOL-NAME TREE))))) (IL:BQUOTE ((DEFSETF (IL:\\\, ACCESSOR-NAME) (X) (VAL) (LIST (QUOTE SETF) (IL:\\\, (MAKE-BQ (SUBST (MAKE-MACRO-ARG :ELEMENT (QUOTE X)) T PATH :TEST (FUNCTION EQ)))) VAL)) (DEFMACRO (IL:\\\, ACCESSOR-NAME) (X) (IL:\\\, (MAKE-BQ (SUBST (MAKE-MACRO-ARG :ELEMENT (QUOTE X)) T PATH :TEST (FUNCTION EQ))))))))) ((EQ (CAR TREE) (QUOTE *)) NIL) (T (APPEND (MAKE-RECORD-ACCESSORS RECORD-NAME (CAR TREE) (IL:BQUOTE (CAR (IL:\\\, PATH)))) (MAKE-RECORD-ACCESSORS RECORD-NAME (CDR TREE) (IL:BQUOTE (CDR (IL:\\\, PATH))))))))
|
||||
|
||||
(DEFUN DEFINE-RECORD-STRUCTURE (RECORD-NAME RECORD-FIELDS NAMED RECORD-TAIL) (LET* ((NAME-STRING (SYMBOL-NAME RECORD-NAME)) (STRUCT-NAME (INTERN NAME-STRING)) (*CURRENT-RECORD-NAME* RECORD-NAME) (SLOTS (REMOVE-IF (FUNCTION NULL) (FLATTEN RECORD-FIELDS))) (ACCESSORS (MAKE-RECORD-ACCESSORS NAME-STRING RECORD-FIELDS (IF NAMED (QUOTE (CDR T)) T)))) (DECLARE (SPECIAL *CURRENT-RECORD-NAME*)) (SETF (GETHASH STRUCT-NAME *RECORD-TYPES*) SLOTS) (MULTIPLE-VALUE-BIND (RECORD-TAIL-FORMS RECORD-TAIL-INITS) (PROCESS-RECORD-TAIL RECORD-TAIL) (ADD-EXPORTS (IL:BQUOTE ((DEFUN (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "MAKE-" NAME-STRING))) (&KEY (IL:\\\,@ (MAPCAR (FUNCTION (LAMBDA (SLOT &AUX PAIR) (IF (SETQ PAIR (ASSOC SLOT RECORD-TAIL-INITS :TEST (FUNCTION EQ))) (LIST SLOT (CDR PAIR)) SLOT))) SLOTS))) (IL:\\\, (MAKE-BQ (LET ((FORM (SUBLIS (MAPCAR (FUNCTION (LAMBDA (SLOT) (CONS SLOT (MAKE-MACRO-ARG :ELEMENT SLOT)))) SLOTS) RECORD-FIELDS))) (IF NAMED (CONS RECORD-NAME FORM) FORM))))) (DEFMACRO (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "COPY-" NAME-STRING))) (X) (IL:\\\, (MAKE-BQ (IL:BQUOTE (COPY-TREE (IL:\\\, (MAKE-MACRO-ARG :ELEMENT (QUOTE X)))))))) (IL:\\\,@ ACCESSORS) (IL:\\\,@ RECORD-TAIL-FORMS)))))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:\; " ^'(record foo (a b . c) b _ 3) ")
|
||||
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"
|
||||
; this version defines a defstruct which is not really the same
|
||||
; as the IL record type.
|
||||
(defun
|
||||
define-record-structure (record-name record-fields named record-tail)
|
||||
(let* ((name-string (symbol-name record-name))
|
||||
(struct-name (intern name-string))
|
||||
(*current-record-name* record-name)
|
||||
(slots nil))
|
||||
(declare (special *current-record-name*))
|
||||
(setq record-fields (make-true-list record-fields))
|
||||
(do ((fields record-fields (rest fields))
|
||||
field)
|
||||
((null fields) (setq slots (nreverse slots)))
|
||||
(setq field (first fields))
|
||||
(cond
|
||||
((null field )
|
||||
(warn \"NIL as record field name not supported\"))
|
||||
((atom field) (push field slots))
|
||||
((eq (first field) '*)) ;Ignore comments
|
||||
(t (setq slots (append (reverse (flatten field)) slots)))))
|
||||
(setf (gethash struct-name *record-types*) slots)
|
||||
(multiple-value-bind
|
||||
(record-tail-forms record-tail-inits)
|
||||
(process-record-tail record-tail)
|
||||
(add-exports
|
||||
`((defstruct
|
||||
,struct-name
|
||||
(:type list)
|
||||
(:named ,named)
|
||||
,@(mapcar
|
||||
#'(lambda (slot &aux pair)
|
||||
(if (setq pair (assoc slot record-tail-inits))
|
||||
`(,slot ,(cdr pair))
|
||||
slot))
|
||||
slots))
|
||||
,@record-tail-forms)))))
|
||||
")
|
||||
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Returns two values: a list of forms to be generated, and a list of (slot . init-form) pairs.")
|
||||
|
||||
|
||||
(DEFUN PROCESS-RECORD-TAIL (RECORD-TAIL) (DECLARE (SPECIAL *CURRENT-RECORD-NAME*)) (DO ((SPECS RECORD-TAIL (REST SPECS)) SPEC (FORMS NIL) (INITS NIL)) ((ENDP SPECS) (VALUES FORMS (REVERSE INITS))) (COND ((AND (ATOM (FIRST SPECS)) (REST SPECS) (EQ (SECOND SPECS) (QUOTE IL:_))) (IF (EQ *CURRENT-RECORD-NAME* (FIRST SPECS)) (WARN "implicit CREATE record spec (by assignment to record name) not supported") (PUSH (CONS (FIRST SPECS) (CONVERT (THIRD SPECS))) INITS)) (IL:* IL:|;;| "A \"field-name _ form\" spec is not a list -- it is") (IL:* IL:|;;| "three separate entries in the record-tail.") (POP SPECS) (POP SPECS)) (T (IL:* IL:\; "All others are lists.") (SETQ SPEC (FIRST SPECS)) (CASE (FIRST SPEC) ((IL:CREATE IL:INIT IL:SUBRECORD IL:SYSTEM) (WARN "~:@(~s~) record spec not supported" (FIRST SPEC))) (IL:TYPE? (PUSH (IL:BQUOTE (DEFUN (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) (SYMBOL-NAME *CURRENT-RECORD-NAME*) "-P"))) (DATUM) (LET ((*LOCALS* (ACONS (QUOTE DATUM) :LOCAL *LOCALS*))) (IL:\\\,@ (MAPCONVERT (REST SPEC)))))) FORMS)) ((IL:ACCESSFNS IL:BLOCKRECORD) (LET ((*ADD-TO-RECORD-DEFN* T)) (DECLARE (SPECIAL *ADD-TO-RECORD-DEFN*)) (SETQ FORMS (APPEND FORMS (LIST (CONVERT SPEC)))))) (T (WARN "unknown record spec ~s ignored" SPEC)))))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Define user-created access functions. It doesn't matter if these fields are part of the structure or not. If so, they will redefine the access functions created by defstruct."
|
||||
)
|
||||
|
||||
|
||||
(IL-DEFCONV ACCESSFNS (RECORD-NAME &OPTIONAL RECORD-FIELDS &REST RECORD-TAIL) (DECLARE (SPECIAL *CURRENT-RECORD-NAME*)) (DECLARE (SPECIAL *LOCALS*)) (IL:* IL:|;;| "The manual says the record name is the first argument, but it appears that sometimes it is missing when this is a subdeclaration, so we get it from a special variable which is set while processing the main declaration.") (UNLESS (ATOM RECORD-NAME) (SETQ RECORD-FIELDS RECORD-NAME RECORD-NAME *CURRENT-RECORD-NAME*)) (WHEN) (DO ((FORMS NIL) FIELD FIELD-NAME ACCESSOR-NAME (FIELDS (IF (AND (= (LENGTH RECORD-FIELDS) 2) (ATOM (FIRST RECORD-FIELDS))) (IL:* IL:|;;| "Pidgin single accessfn declaration...") (LIST RECORD-FIELDS) RECORD-FIELDS) (REST FIELDS))) ((ENDP FIELDS) (ADD-EXPORTS (REVERSE FORMS))) (SETQ FIELD (FIRST FIELDS)) (SETQ FIELD-NAME (POP FIELD)) (SETQ ACCESSOR-NAME (INTERN (CONCATENATE (QUOTE STRING) (SYMBOL-NAME RECORD-NAME) "-" (SYMBOL-NAME FIELD-NAME)))) (IL:* IL:\; "Define the accessor function") (WHEN FIELD (IL:* IL:|;;| "Also remember that we know about this field") (PUSH FIELD-NAME (GETHASH RECORD-NAME *RECORD-TYPES*)) (PUSH (IL:BQUOTE (DEFUN (IL:\\\, ACCESSOR-NAME) (DATUM) (IL:\\\, (LET ((*LOCALS* (ACONS (QUOTE DATUM) :LOCAL *LOCALS*))) (CONVERT (POP FIELD)))))) FORMS) (IL:* IL:\; "Define the function to set a new value") (WHEN FIELD (PUSH (IL:BQUOTE (DEFSETF (IL:\\\, ACCESSOR-NAME) (DATUM) (NEWVALUE) (IL:\\\, (LET ((*LOCALS* (ACONS (QUOTE NEWVALUE) :LOCAL (ACONS (QUOTE DATUM) :LOCAL *LOCALS*)))) (CONVERT (POP FIELD)))))) FORMS)))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;| " (convert '(accessfns pilotbbt ((pbtsource foo1 foo2))))")
|
||||
|
||||
|
||||
(IL-DEFCONV DATATYPE (RECORD-NAME RECORD-FIELDS &REST RECORD-TAIL) (LET* ((NAME-STRING (SYMBOL-NAME RECORD-NAME)) (STRUCT-NAME (INTERN NAME-STRING)) (*CURRENT-RECORD-NAME* RECORD-NAME) RECORD-TAIL-FORMS RECORD-TAIL-INITS (SLOTS NIL) (SLOT-DEFNS NIL) (FIELD-TYPES NIL)) (DECLARE (SPECIAL *CURRENT-RECORD-NAME*)) (DO ((FIELDS RECORD-FIELDS (REST FIELDS)) SLOT-NAME FIELD-TYPE FIELD) ((ENDP FIELDS) (SETQ SLOTS (NREVERSE SLOTS))) (SETQ FIELD (FIRST FIELDS)) (SETQ SLOT-NAME (COND ((CONSP FIELD) (CASE (FIRST FIELD) ((NIL) (IL:* IL:|;;| "Some code has field specs like \"(nil 5 word))\"") (WARN "record spec ~s ignored -- NIL not allowed as field name" FIELD) NIL) (IL:* NIL) (IL:* IL:\; "Ignore comments") (T (SETQ FIELD-TYPE (REST FIELD)) (FIRST FIELD)))) (T (SETQ FIELD-TYPE NIL) FIELD))) (WHEN SLOT-NAME (PUSH SLOT-NAME SLOTS) (PUSH FIELD-TYPE FIELD-TYPES))) (IL:* IL:|;;| "Have to set the field names defined here before calling") (IL:* IL:|;;| "process-record-tail since it will add to them.") (SETF (GETHASH STRUCT-NAME *RECORD-TYPES*) SLOTS) (MULTIPLE-VALUE-SETQ (RECORD-TAIL-FORMS RECORD-TAIL-INITS) (PROCESS-RECORD-TAIL RECORD-TAIL)) (IL:* IL:|;;| "This could be changed to a mapcar. Previous definitions of il-defconv") (IL:* IL:|;;| "for some reason did not correctly handle lambda's.") (DO ((SLOTS SLOTS (REST SLOTS)) (FIELD-TYPES FIELD-TYPES (REST FIELD-TYPES)) SLOT-NAME FIELD-TYPE) ((ENDP SLOTS) (SETQ SLOT-DEFNS (NREVERSE SLOT-DEFNS))) (SETQ SLOT-NAME (FIRST SLOTS) FIELD-TYPE (FIRST FIELD-TYPES)) (PUSH (IL:BQUOTE ((IL:\\\, SLOT-NAME) (IL:\\\, (CDR (ASSOC SLOT-NAME RECORD-TAIL-INITS))) :TYPE (IL:\\\, (FIELD-TO-SLOT-TYPE FIELD-TYPE SLOT-NAME)))) SLOT-DEFNS)) (LET ((NAME-STRING (SYMBOL-NAME STRUCT-NAME))) (PROGN-IF-NEEDED (IL:BQUOTE ((EXPORT (QUOTE ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "MAKE-" NAME-STRING))) (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "COPY-" NAME-STRING))) (IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) NAME-STRING "-P"))) (IL:\\\,@ (MAPCAR (FUNCTION (LAMBDA (SLOT) (INTERN (CONCATENATE (QUOTE STRING) NAME-STRING "-" (SYMBOL-NAME SLOT))))) SLOTS))))) (DEFSTRUCT (IL:\\\, STRUCT-NAME) (IL:\\\,@ SLOT-DEFNS)) (IL:\\\,@ RECORD-TAIL-FORMS)))))))
|
||||
|
||||
(DEFUN FIELD-TO-SLOT-TYPE (TYPE &OPTIONAL SLOT-NAME) (IF (NULL TYPE) T (CASE (FIRST TYPE) (INTEGER (QUOTE INTEGER)) ((IL:FIXP IL:SIGNEDWORD) (QUOTE FIXNUM)) ((IL:FLOATING IL:FLOATP) (QUOTE FLOAT)) (IL:FLAG (QUOTE (OR NIL T))) (IL:BITS (IF (<= (1- (EXPT 2 (SECOND TYPE))) MOST-POSITIVE-FIXNUM) (QUOTE FIXNUM) (QUOTE INTEGER))) (BYTE (QUOTE FIXNUM)) (IL:WORD (QUOTE FIXNUM)) ((IL:POINTER IL:XPOINTER IL:FULLPOINTER IL:FULLXPOINTER) T) (T (WARN "Unknown type spec ~:@(~a~)~:[~; for slot ~:*~:@(~a~)~]" (FIRST TYPE) SLOT-NAME) T))))
|
||||
|
||||
(IL-DEFCONV /DECLAREDATATYPE (&REST ARGS) (WARN "/DECLAREDATATYPE ignored") NIL)
|
||||
|
||||
(DEFUN FIND-RECORD-TYPE (FIELDNAME) (LET ((RECORD-TYPES NIL)) (MAPHASH (FUNCTION (LAMBDA (RECORD-NAME FIELDS) (WHEN (MEMBER FIELDNAME FIELDS :TEST (FUNCTION EQ)) (PUSH RECORD-NAME RECORD-TYPES)))) *RECORD-TYPES*) (CASE (LENGTH RECORD-TYPES) (0 (WARN "no record is defined with a field named ~s, using a dummy function XXXXX-~a" FIELDNAME FIELDNAME) (QUOTE XXXXX)) (1 (CAR RECORD-TYPES)) (T (CERROR "use ~a" "~*multiple record types have a field named ~s: ~s" (CAR RECORD-TYPES) FIELDNAME RECORD-TYPES) (CAR RECORD-TYPES)))))
|
||||
|
||||
(DEFUN FIND-RECORD-FIELDS (RECORD-TYPE) (MULTIPLE-VALUE-BIND (RECORD FOUND) (GETHASH RECORD-TYPE *RECORD-TYPES*) (IF FOUND RECORD (PROGN (WARN "no record type ~a, initializations may not be done" RECORD-TYPE) NIL))))
|
||||
|
||||
(IL-DEFCONV |fetch| (FIELD-NAME OF &OPTIONAL X &AUX RECORD-TYPE) (DECLARE (SPECIAL IL:USERRECLST)) (WHEN (NOT (STRING-EQUAL OF "of")) (SETQ X OF)) (IF (CONSP FIELD-NAME) (SETQ RECORD-TYPE (FIRST FIELD-NAME) FIELD-NAME (SECOND FIELD-NAME)) (LET ((M (IL:\\RECORDBLOCK/RECFIELDLOOK IL:USERRECLST FIELD-NAME))) (UNLESS M (WARN "no record is defined with a field named ~s, using a dummy function XXXXX-~a" FIELD-NAME FIELD-NAME)) (UNLESS (NULL (CDR M)) (ERROR "More than one record with ~:@(~a~)." FIELD-NAME)) (SETQ RECORD-TYPE (IF (NULL M) (QUOTE XXXXX) (SECOND (FIRST M)))))) (IL:BQUOTE ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) (SYMBOL-NAME RECORD-TYPE) "-" (SYMBOL-NAME FIELD-NAME)))) (IL:\\\, (CONVERT X)))))
|
||||
|
||||
(IL-DEFCONV |replace| (FIELD-NAME OF X WITH Y &AUX RECORD-TYPE) (COND ((NOT (STRING-EQUAL OF "OF")) (CERROR "Skip this form" "Missing |of| in |replace|") *CURRENT-FORM*) ((NOT (STRING-EQUAL WITH "WITH")) (CERROR "Skip this form" "Missing |with| in |replace|") *CURRENT-FORM*) (T (IF (CONSP FIELD-NAME) (SETQ RECORD-TYPE (FIRST FIELD-NAME) FIELD-NAME (SECOND FIELD-NAME)) (LET ((M (IL:\\RECORDBLOCK/ACCESSDEF FIELD-NAME))) (UNLESS M (WARN "no record is defined with a field named ~s, using a dummy function XXXXX-~a" FIELD-NAME FIELD-NAME)) (UNLESS (NULL (CDR M)) (ERROR "More than one record with ~:@(~a~)." FIELD-NAME)) (SETQ RECORD-TYPE (IF (NULL M) (QUOTE XXXXX) (SECOND (FIRST M)))))) (IL:BQUOTE (SETF ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) (SYMBOL-NAME RECORD-TYPE) "-" (SYMBOL-NAME FIELD-NAME)))) (IL:\\\, (CONVERT X))) (IL:\\\, (CONVERT Y)))))))
|
||||
|
||||
(IL-DEFCONV TYPE? (RECORD-NAME FORM) (IL:BQUOTE ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) (SYMBOL-NAME RECORD-NAME) "-P"))) (IL:\\\, (CONVERT FORM)))))
|
||||
|
||||
(IL-DEFCONV |create| (RECORD-NAME &REST ASSIGNMENTS) (|DO-create| RECORD-NAME ASSIGNMENTS))
|
||||
|
||||
(DEFUN |DO-create| (RECORD-NAME ASSIGNMENTS) (LET ((NAME-STRING (SYMBOL-NAME RECORD-NAME)) (INITS NIL) (SMASHING NIL) (USING NIL) (VAR (MAKE-FAKE-SYMBOL (STRING (GENSYM "G"))))) (DO ((ASSIGNMENTS ASSIGNMENTS (REST ASSIGNMENTS))) ((ENDP ASSIGNMENTS) (SETQ INITS (REVERSE INITS))) (COND ((AND (CONSP (FIRST ASSIGNMENTS)) (STRING-EQUAL (CAAR ASSIGNMENTS) (QUOTE "*")))) ((AND (SYMBOLP (SECOND ASSIGNMENTS)) (STRING-EQUAL (SECOND ASSIGNMENTS) "_")) (PUSH (CONS (FIRST ASSIGNMENTS) (CONVERT (THIRD ASSIGNMENTS))) INITS) (SETQ ASSIGNMENTS (CDDR ASSIGNMENTS))) (T (CASE (FIRST ASSIGNMENTS) ((IL:USING IL:|using|) (SETQ USING (CONVERT (SECOND ASSIGNMENTS)))) ((IL:COPYING IL:|copying|) (WARN "COPYING assignment not supported")) ((IL:REUSING IL:|reusing|) (WARN "REUSING assignment not supported")) ((IL:SMASHING IL:|smashing|) (SETQ SMASHING (CONVERT (SECOND ASSIGNMENTS)))) (T (WARN "unknown assignment ~s" (FIRST ASSIGNMENTS)))) (POP ASSIGNMENTS)))) (COND (USING (IL:BQUOTE (LET (((IL:\\\, VAR) ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "COPY-" NAME-STRING))) (IL:\\\, USING)))) (SETF (IL:\\\,@ (MAPCAN (FUNCTION (LAMBDA (INIT) (LIST (IL:BQUOTE ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) NAME-STRING "-" (SYMBOL-NAME (CAR INIT))))) (IL:\\\, VAR))) (CDR INIT)))) INITS))) (IL:\\\, VAR)))) (SMASHING (IF INITS (IL:BQUOTE (LET (((IL:\\\, VAR) (IL:\\\, SMASHING))) (SETF (IL:\\\,@ (MAPCAN (FUNCTION (LAMBDA (INIT) (LIST (IL:BQUOTE ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) NAME-STRING "-" (SYMBOL-NAME (CAR INIT))))) (IL:\\\, VAR))) (CDR INIT)))) INITS))) (IL:\\\, VAR))) SMASHING)) (T (IL:BQUOTE ((IL:\\\, (INTERN (CONCATENATE (QUOTE STRING) "MAKE-" NAME-STRING))) (IL:\\\,@ (MAPCAN (FUNCTION (LAMBDA (INIT) (IL:BQUOTE ((IL:\\\, (INTERN (STRING (CAR INIT)) (QUOTE KEYWORD))) (IL:\\\, (CDR INIT)))))) INITS))))))))
|
||||
|
||||
(IL-COPYCONV |fetch| FETCH)
|
||||
|
||||
(IL-COPYCONV |fetch| |ffetch|)
|
||||
|
||||
(IL-COPYCONV |ffetch| FFETCH)
|
||||
|
||||
(IL-COPYCONV |replace| REPLACE)
|
||||
|
||||
(IL-COPYCONV |replace| |freplace|)
|
||||
|
||||
(IL-COPYCONV |freplace| FREPLACE)
|
||||
|
||||
(IL-COPYCONV TYPE? |type?|)
|
||||
|
||||
(IL-COPYCONV |create| CREATE)
|
||||
|
||||
(IL:PUTPROPS IL:IL-RECORD IL:MAKEFILE-ENVIRONMENT (:PACKAGE "IL-CONVERT" :READTABLE "XCL"))
|
||||
(IL:PUTPROPS IL:IL-RECORD IL:COPYRIGHT ("ENVOS Corporation" 1989))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
IL:STOP
|
||||
1
lispusers/MIGRATION/IL-RECORD.LCOM
Normal file
1
lispusers/MIGRATION/IL-RECORD.LCOM
Normal file
File diff suppressed because one or more lines are too long
1356
lispusers/MIGRATION/IL-SIM
Normal file
1356
lispusers/MIGRATION/IL-SIM
Normal file
File diff suppressed because one or more lines are too long
1
lispusers/MIGRATION/IL-SIM.LCOM
Normal file
1
lispusers/MIGRATION/IL-SIM.LCOM
Normal file
File diff suppressed because one or more lines are too long
90
lispusers/MIGRATION/IL-STARTUP
Normal file
90
lispusers/MIGRATION/IL-STARTUP
Normal file
@@ -0,0 +1,90 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (LET ((*PACKAGE* *PACKAGE*)) (CL IN-PACKAGE "IL-CONVERT")
|
||||
*PACKAGE*) BASE 10)
|
||||
(IL:FILECREATED "14-Sep-89 10:01:13" IL:|{DSK}/python2/aria/migration/interlisp/IL-STARTUP.;2| 6548
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FUNCTIONS NOTE-EXPORTED-SYMBOL CONVERT)
|
||||
|
||||
IL:|previous| IL:|date:| " 7-Jul-89 16:55:06" IL:|{DSK}/users/eweaver/convert/IL-STARTUP.;17|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1989 by ENVOS Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:IL-STARTUPCOMS)
|
||||
|
||||
(IL:RPAQQ IL:IL-STARTUPCOMS ((IL:* IL:|;;;| "This should be loaded before any other files.") (EVAL-WHEN (LOAD COMPILE EVAL) (IL:VARIABLES *IL-PACKAGE*)) (IL:VARIABLES *IL-SIM-PACKAGE*) (IL:* IL:|;;;| "This funny stuff is for printing backquote forms. ") (IL:STRUCTURES BQ MACRO-ARG) (IL:* IL:|;;;| "") (IL:VARIABLES *CURRENT-CONVERT-FORM* *CURRENT-CONVERT-FUNCTION* *GLOBALS* *LOCALS* *FUNCTION-CALLS* *CURRENT-FUNCTION-CALLS* *CURRENT-FREE-REFERENCES* *EXPORTED-IL-SYMBOLS*) (IL:P (EXPORT (QUOTE CONVERT))) (IL:FUNCTIONS CONVERT MAPCONVERT EXTERN NOTE-EXPORTED-SYMBOL) (IL:FUNCTIONS TRUE-LIST-P) (IL:* IL:\; "true if this is nil or a true list") (IL:* IL:|;;| "make a true list out of a pseudo-list (make-true-list '(A B . C)) => (A B C)") (IL:FUNCTIONS MAKE-TRUE-LIST) (IL:PROP (IL:MAKEFILE-ENVIRONMENT IL:FILETYPE) IL:IL-STARTUP))
|
||||
)
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;;| "This should be loaded before any other files.")
|
||||
|
||||
(EVAL-WHEN (LOAD COMPILE EVAL)
|
||||
|
||||
(DEFVAR *IL-PACKAGE* (FIND-PACKAGE "INTERLISP"))
|
||||
)
|
||||
|
||||
(DEFVAR *IL-SIM-PACKAGE* (MAKE-PACKAGE "IL-SIM" :USE NIL))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;;| "This funny stuff is for printing backquote forms. ")
|
||||
|
||||
|
||||
(DEFSTRUCT (BQ (:TYPE LIST) (:CONSTRUCTOR MAKE-BQ (ELEMENT))) (BQFLAG (QUOTE IL:BQUOTE)) ELEMENT)
|
||||
|
||||
(DEFSTRUCT (MACRO-ARG (:TYPE LIST) (:CONSTRUCTOR MAKE-MACRO-ARG (&KEY ELEMENT APPEND-P (FLAG (IF APPEND-P (QUOTE IL:\\\,@) (QUOTE IL:\\\,)))))) FLAG ELEMENT)
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;;| "")
|
||||
|
||||
|
||||
(DEFVAR *CURRENT-CONVERT-FORM*)
|
||||
|
||||
(DEFVAR *CURRENT-CONVERT-FUNCTION*)
|
||||
|
||||
(DEFVAR *GLOBALS* NIL)
|
||||
|
||||
(DEFVAR *LOCALS* NIL)
|
||||
|
||||
(DEFVAR *FUNCTION-CALLS* NIL)
|
||||
|
||||
(DEFVAR *CURRENT-FUNCTION-CALLS* NIL)
|
||||
|
||||
(DEFVAR *CURRENT-FREE-REFERENCES* NIL)
|
||||
|
||||
(DEFVAR *EXPORTED-IL-SYMBOLS* NIL)
|
||||
|
||||
(EXPORT (QUOTE CONVERT))
|
||||
|
||||
(DEFUN CONVERT (FORM &AUX FN VAR) (IL:BLOCK) (LET ((*CURRENT-EXPRESSION* FORM)) (COND (IL:* IL:|;;| "Forms in which the car is a symbol...") ((AND (CONSP FORM) (ATOM (FIRST FORM))) (COND ((NOT (TRUE-LIST-P FORM)) (LET ((TAIL (CDR (LAST FORM)))) (IL:* IL:|;;| "dotted lists ending in a macro arg are okay.") (IF (AND (SYMBOLP TAIL) (EQ (CDR (ASSOC TAIL *LOCALS*)) :MACRO-ARG)) (LET ((MARG (MAKE-MACRO-ARG :ELEMENT TAIL)) (VAL (COPY-LIST FORM))) (SETF (CDR (LAST VAL)) MARG) VAL) (PROGN (WARN "~s not a list, left as is" FORM) FORM)))) ((LET ((FOO (GET (CAR FORM) (QUOTE IL:CLISPWORD)))) (AND (CONSP FOO) (EQ (CAR FOO) (QUOTE IL:FORWORD)) (NOT (EQ (CAR FORM) (QUOTE DECLARE))))) (CONVERT-ITERATION-STATEMENT (CAR FORM) (CDR FORM))) ((SETQ FN (GET (FIRST FORM) (QUOTE CONVERT-FORM))) (SETQ *CURRENT-CONVERT-FORM* FORM *CURRENT-CONVERT-FUNCTION* FN) (APPLY FN (REST FORM))) ((OR (MACRO-FUNCTION (FIRST FORM)) (SPECIAL-FORM-P (FIRST FORM))) (IL:* IL:|;;| "Use CL code walker for this") (WALK-FORM-INTERNAL FORM)) ((EQ (CHAR (STRING (FIRST FORM)) 0) #\\) (WARN "Untranslatable function ~a" (STRING (FIRST FORM))) FORM) (T (IL:* IL:|;;| "(setq fn (first form) (extern (symbol-name (first form)) *il-package*))") (WHEN *CURRENT-FUNCTION-CALLS* (PUSHNEW FN *CURRENT-FUNCTION-CALLS*)) (NOTE-EXPORTED-SYMBOL (FIRST FORM)) (CONS (FIRST FORM) (MAPCAR (QUOTE CONVERT) (REST FORM)))))) (IL:* IL:|;;| "Forms in which the car is a Lambda...") ((AND (CONSP FORM) (IL:* IL:|;;| "But car is cons") (SYMBOLP (CAAR FORM)) (STRING-EQUAL (CAAR FORM) "LAMBDA")) (CONS (CONVERT (CAR FORM)) (MAPCONVERT (CDR FORM)))) (IL:* IL:|;;| "Other non-atomic forms...") ((CONSP FORM) (WARN "Unknown kind of form ~s, not converted." FORM) FORM) (IL:* IL:|;;| "Atomic forms...") ((NULL FORM) NIL) ((EQ FORM T) T) ((KEYWORDP FORM) FORM) ((SYMBOLP FORM) (IF (SETQ VAR (ASSOC FORM *LOCALS*)) (CASE (CDR VAR) (:LOCAL (CAR VAR)) (:MACRO-ARG (MAKE-MACRO-ARG :ELEMENT (CAR VAR))) (T (ERROR "unexpected value ~s in *LOCALS*" VAR))) (PROGN (NOTE-EXPORTED-SYMBOL FORM) (WHEN *CURRENT-FREE-REFERENCES* (PUSHNEW FORM *CURRENT-FREE-REFERENCES*)) FORM))) (T FORM))))
|
||||
|
||||
(DEFUN MAPCONVERT (FORM-OR-FORMS) (IF (ATOM FORM-OR-FORMS) (CONVERT FORM-OR-FORMS) (DO* ((TAIL FORM-OR-FORMS (CDR TAIL)) (SUBFORM (IF (CONSP TAIL) (CAR TAIL) TAIL) (IF (CONSP TAIL) (CAR TAIL) TAIL)) RESULT) ((ATOM TAIL) (IF (NULL TAIL) (NREVERSE RESULT) (PROGN (SETF (CDR (LAST (SETQ RESULT (NREVERSE RESULT)))) (CONVERT TAIL)) RESULT))) (PUSH (CONVERT SUBFORM) RESULT))))
|
||||
|
||||
(DEFUN EXTERN (STRING &OPTIONAL (PACKAGE *PACKAGE*)) (IL:* (LET ((SYM (INTERN STRING PACKAGE))) (EXPORT SYM PACKAGE) (IF (EQ PACKAGE *IL-PACKAGE*) (PUSHNEW SYM *EXPORTED-IL-SYMBOLS*)) SYM)) (ERROR "Old leftover call to EXTERN!"))
|
||||
|
||||
(DEFUN NOTE-EXPORTED-SYMBOL (SYM &AUX PKG PKGNM) "" (WHEN (NULL (SETQ PKG (SYMBOL-PACKAGE SYM))) (RETURN-FROM NOTE-EXPORTED-SYMBOL SYM)) (WHEN (AND (EQ PKG IL:*INTERLISP-PACKAGE*) (NOT (EQ (FIND-SYMBOL (SYMBOL-NAME SYM) IL:*LISP-PACKAGE*) SYM)) (OR *WARN-FOR-ALL-IL-SYMBOLS* (< (IL:\\LOLOC SYM) (IL:\\LOLOC *WARN-FOR-IL-SYMBOLS-LOWER-THAN-THIS*)))) (LET ((*CURRENT-EXPRESSION* SYM)) (WARN "Use of IL symbol ~a" SYM))) (WHEN (OR (EQ PKG IL:*INTERLISP-PACKAGE*) (AND (NOT (OR (EQ PKG IL:*KEYWORD-PACKAGE*) (EQ PKG IL:*LISP-PACKAGE*))) (MULTIPLE-VALUE-BIND (IGNORE TYPE) (FIND-SYMBOL (SYMBOL-NAME SYM) PKG) (EQ TYPE :EXTERNAL)))) (IF (NULL *FILE-CONTEXT*) (PUSHNEW SYM *EXPORTED-IL-SYMBOLS*) (PUSHNEW SYM (FILE-CONTEXT-EXPORTED-SYMS *FILE-CONTEXT*)))) SYM)
|
||||
|
||||
(DEFUN TRUE-LIST-P (PSEUDO-LIST) (DO ((PL PSEUDO-LIST (CDR PL))) ((NULL PL) T) (IF (ATOM PL) (RETURN NIL))))
|
||||
|
||||
|
||||
|
||||
(IL:* IL:\; "true if this is nil or a true list")
|
||||
|
||||
|
||||
|
||||
|
||||
(IL:* IL:|;;| "make a true list out of a pseudo-list (make-true-list '(A B . C)) => (A B C)")
|
||||
|
||||
|
||||
(DEFUN MAKE-TRUE-LIST (PSEUDO-LIST) (COND ((TRUE-LIST-P PSEUDO-LIST) PSEUDO-LIST) (T (DO ((TRUE-LIST NIL)) ((ATOM PSEUDO-LIST) (NREVERSE (CONS PSEUDO-LIST TRUE-LIST))) (IF (ENDP PSEUDO-LIST) (RETURN (NREVERSE TRUE-LIST))) (PUSH (POP PSEUDO-LIST) TRUE-LIST)))))
|
||||
|
||||
(IL:PUTPROPS IL:IL-STARTUP IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE (LET ((*PACKAGE* *PACKAGE*)) (IN-PACKAGE "IL-CONVERT") *PACKAGE*) :BASE 10)
|
||||
)
|
||||
|
||||
(IL:PUTPROPS IL:IL-STARTUP IL:FILETYPE :COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:IL-STARTUP IL:COPYRIGHT ("ENVOS Corporation" 1989))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
IL:STOP
|
||||
1
lispusers/MIGRATION/IL-STARTUP.LCOM
Normal file
1
lispusers/MIGRATION/IL-STARTUP.LCOM
Normal file
File diff suppressed because one or more lines are too long
25
lispusers/MIGRATION/MIGRATION-TOOL
Normal file
25
lispusers/MIGRATION/MIGRATION-TOOL
Normal file
@@ -0,0 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "IL-CONVERT") READTABLE "XCL")
|
||||
(IL:FILECREATED "26-Jan-90 10:27:59" IL:|{DSK}/users/welch/migration/MIGRATION-TOOL.;2| 1091
|
||||
|
||||
IL:|changes| IL:|to:| (IL:FILES IL:IL-CONVERT)
|
||||
|
||||
IL:|previous| IL:|date:| "11-Aug-89 16:19:28" IL:|{DSK}/users/welch/migration/MIGRATION-TOOL.;1|
|
||||
)
|
||||
|
||||
|
||||
; Copyright (c) 1989, 1990 by ENVOS Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:MIGRATION-TOOLCOMS)
|
||||
|
||||
(IL:RPAQQ IL:MIGRATION-TOOLCOMS ((IL:PROP IL:MAKEFILE-ENVIRONMENT IL:MIGRATION-TOOL)
|
||||
(IL:FILES IL:IL-STARTUP IL:IL-CONVERT IL:IL-SIM IL:IL-RECORD
|
||||
IL:TRANSLATOR-ASSISTANT)))
|
||||
|
||||
(IL:PUTPROPS IL:MIGRATION-TOOL IL:MAKEFILE-ENVIRONMENT (:PACKAGE (XCL:DEFPACKAGE "IL-CONVERT")
|
||||
:READTABLE "XCL"))
|
||||
|
||||
(IL:FILESLOAD IL:IL-STARTUP IL:IL-CONVERT IL:IL-SIM IL:IL-RECORD IL:TRANSLATOR-ASSISTANT)
|
||||
(IL:PUTPROPS IL:MIGRATION-TOOL IL:COPYRIGHT ("ENVOS Corporation" 1989 1990))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
IL:STOP
|
||||
1
lispusers/MIGRATION/MIGRATION-TOOL.LCOM
Normal file
1
lispusers/MIGRATION/MIGRATION-TOOL.LCOM
Normal file
@@ -0,0 +1 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "IL-CONVERT") READTABLE "XCL")
|
||||
242
lispusers/MIGRATION/SEDIT-DECLS
Normal file
242
lispusers/MIGRATION/SEDIT-DECLS
Normal file
File diff suppressed because one or more lines are too long
1
lispusers/MIGRATION/SEDIT-DECLS.LCOM
Normal file
1
lispusers/MIGRATION/SEDIT-DECLS.LCOM
Normal file
File diff suppressed because one or more lines are too long
35
lispusers/MIGRATION/TABLEBROWSERDECLS
Normal file
35
lispusers/MIGRATION/TABLEBROWSERDECLS
Normal file
@@ -0,0 +1,35 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "27-Jan-88 17:04:01" {ERIS}<LISPCORE>LIBRARY>TABLEBROWSERDECLS.;5 5052
|
||||
|
||||
changes to%: (RECORDS TABLEBROWSER)
|
||||
|
||||
previous date%: "18-Oct-85 18:10:50" {ERIS}<LISPCORE>LIBRARY>TABLEBROWSERDECLS.;2)
|
||||
|
||||
|
||||
(* "
|
||||
Copyright (c) 1985, 1988 by Xerox Corporation. All rights reserved.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT TABLEBROWSERDECLSCOMS)
|
||||
|
||||
(RPAQQ TABLEBROWSERDECLSCOMS ((RECORDS TABLEBROWSER TABLEITEM) (CONSTANTS TB.LEFT.MARGIN)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE TABLEBROWSER ((TBREADY FLAG) (TBHEIGHTEXPLICIT FLAG) (* ; "True if creator set explicit item height or baseline") (NIL 6 FLAG) (TBITEMS POINTER) (* ; "List of items in this browser") (TB#ITEMS WORD) (* ; "Number of items") (TB#DELETED WORD) (* ; "Number of items marked deleted") (TB#LINESPERITEM WORD) (* ; "Number of lines occupied by each item, normally 1 (dunno if any other values work)") (TBFIRSTSELECTEDITEM WORD) (* ; "Number of first selected item. If none selected, is > TB#ITEMS") (TBLASTSELECTEDITEM WORD) (* ; "Number of last selected item. If none selected, is 0") (TBITEMHEIGHT WORD) (* ; "Height of an item, i.e., fontheight*linesperitem") (TBMAXXPOS WORD) (* ; "The largest x-position a user printfn has printed to") (TBFONTHEIGHT WORD) (* ; "Height, ascent, descent of font") (TBFONTASCENT WORD) (TBBASELINE WORD) (TBWINDOW POINTER) (* ; "Pointer to the display window. Need to snap this link when browser is closed") (TBLOCK POINTER) (* ; "Monitor lock guarding some browser operations") (TBUSERDATA POINTER) (* ; "Arbitrary user storage") (TBFONT POINTER) (* ; "Pointer to font used by display") (TBEXTENT POINTER) (* ; "Window's extent, updated as items are added, deleted, or printfn prints farther to right") (TBUPDATEFROMHERE POINTER) (* ; "If changes have occurred while shrunk, this gives the # of first item that needs redisplay") (TBCOLUMNS POINTER) (* ; "Number of columns--not yet implemented") (TBPRINTFN POINTER) (* ; "(Browser Item Window) -- displays Item at current line position in window") (TBCOPYFN POINTER) (* ; "(Browser Item) -- copy selects Item") (TBFONTCHANGEFN POINTER) (* ; "(Browser Window) -- called when tb.set.font changes the font") (TBCLOSEFN POINTER) (* ; "(Browser Window Close/Shrink) -- called when you try to close or shrink window") (TBAFTERCLOSEFN POINTER) (* ; "(Browser Window) -- called to cleanup AFTER a closew") (TBTITLEEVENTFN POINTER) (* ; "(Window Browser) -- handles button event in browser's title") (TBLINETHICKNESS POINTER) (* ; "Thickness of line for deletions (normally 1)") (TBORIGIN POINTER) (* ; "Y position of the top of the first item") (TBTAILHINT POINTER) (* ; "A tail of TBITEMS, used to speed up TB.NTH.ITEM") (TBHEADINGWINDOW POINTER) (* ; "An optional %"header window%" that should be horizontally scrolled in synchrony with this one") (NIL POINTER))
|
||||
)
|
||||
|
||||
(DATATYPE TABLEITEM ((TISELECTED FLAG) (TIDELETED FLAG) (TIUNDELETABLE FLAG) (TIUNSELECTABLE FLAG) (TIUNCOPYSELECTABLE FLAG) (NIL 3 FLAG) (TIDATA POINTER) (TI# WORD) (NIL WORD))
|
||||
)
|
||||
)
|
||||
(/DECLAREDATATYPE (QUOTE TABLEBROWSER) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE ((TABLEBROWSER 0 (FLAGBITS . 0)) (TABLEBROWSER 0 (FLAGBITS . 16)) (TABLEBROWSER 0 (FLAGBITS . 32)) (TABLEBROWSER 0 (FLAGBITS . 48)) (TABLEBROWSER 0 (FLAGBITS . 64)) (TABLEBROWSER 0 (FLAGBITS . 80)) (TABLEBROWSER 0 (FLAGBITS . 96)) (TABLEBROWSER 0 (FLAGBITS . 112)) (TABLEBROWSER 0 POINTER) (TABLEBROWSER 2 (BITS . 15)) (TABLEBROWSER 3 (BITS . 15)) (TABLEBROWSER 4 (BITS . 15)) (TABLEBROWSER 5 (BITS . 15)) (TABLEBROWSER 6 (BITS . 15)) (TABLEBROWSER 7 (BITS . 15)) (TABLEBROWSER 8 (BITS . 15)) (TABLEBROWSER 9 (BITS . 15)) (TABLEBROWSER 10 (BITS . 15)) (TABLEBROWSER 11 (BITS . 15)) (TABLEBROWSER 12 POINTER) (TABLEBROWSER 14 POINTER) (TABLEBROWSER 16 POINTER) (TABLEBROWSER 18 POINTER) (TABLEBROWSER 20 POINTER) (TABLEBROWSER 22 POINTER) (TABLEBROWSER 24 POINTER) (TABLEBROWSER 26 POINTER) (TABLEBROWSER 28 POINTER) (TABLEBROWSER 30 POINTER) (TABLEBROWSER 32 POINTER) (TABLEBROWSER 34 POINTER) (TABLEBROWSER 36 POINTER) (TABLEBROWSER 38 POINTER) (TABLEBROWSER 40 POINTER) (TABLEBROWSER 42 POINTER) (TABLEBROWSER 44 POINTER) (TABLEBROWSER 46 POINTER))) (QUOTE 48))
|
||||
(/DECLAREDATATYPE (QUOTE TABLEITEM) (QUOTE (FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER WORD WORD)) (QUOTE ((TABLEITEM 0 (FLAGBITS . 0)) (TABLEITEM 0 (FLAGBITS . 16)) (TABLEITEM 0 (FLAGBITS . 32)) (TABLEITEM 0 (FLAGBITS . 48)) (TABLEITEM 0 (FLAGBITS . 64)) (TABLEITEM 0 (FLAGBITS . 80)) (TABLEITEM 0 (FLAGBITS . 96)) (TABLEITEM 0 (FLAGBITS . 112)) (TABLEITEM 0 POINTER) (TABLEITEM 2 (BITS . 15)) (TABLEITEM 3 (BITS . 15)))) (QUOTE 4))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ TB.LEFT.MARGIN 8)
|
||||
|
||||
(CONSTANTS TB.LEFT.MARGIN)
|
||||
)
|
||||
(PUTPROPS TABLEBROWSERDECLS COPYRIGHT ("Xerox Corporation" 1985 1988))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL)))
|
||||
STOP
|
||||
1
lispusers/MIGRATION/TABLEBROWSERDECLS.LCOM
Normal file
1
lispusers/MIGRATION/TABLEBROWSERDECLS.LCOM
Normal file
File diff suppressed because one or more lines are too long
1646
lispusers/MIGRATION/TRANSLATOR-ASSISTANT
Normal file
1646
lispusers/MIGRATION/TRANSLATOR-ASSISTANT
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Oct-2021 15:42:11"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41 30305
|
||||
(FILECREATED "25-Dec-2021 22:27:41"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39 30532
|
||||
|
||||
changes to%: (FNS MODERNIZED.TB.BUTTONEVENTFN)
|
||||
:CHANGES-TO (FNS MODERN-MENUBUTTONFN)
|
||||
|
||||
previous date%: "16-Oct-2021 15:29:38"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40)
|
||||
:PREVIOUS-DATE "25-Dec-2021 22:20:10"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;38)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MODERNIZECOMS)
|
||||
@@ -216,8 +216,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MODERNWINDOW.BUTTONEVENTFN
|
||||
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
|
||||
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
|
||||
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
|
||||
(* ; "Edited 25-Dec-2021 22:19 by rmk")
|
||||
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
|
||||
|
||||
(* ;; "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.")
|
||||
|
||||
@@ -232,81 +233,78 @@
|
||||
(LET (CORNER ATTACHEDREGION)
|
||||
(IF CORNERREGION
|
||||
THEN
|
||||
(* ;; "Caller tells us whether the corner window has a title.")
|
||||
|
||||
(* ;; "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)))
|
||||
(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)))
|
||||
(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))
|
||||
(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.")
|
||||
|
||||
(* ;; "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)))
|
||||
|
||||
(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.")
|
||||
|
||||
(* ;; "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. ")
|
||||
|
||||
(* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")
|
||||
(SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN))
|
||||
(if [AND CORNER (NOT (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS]
|
||||
then
|
||||
(* ;;
|
||||
"The upper corners may be in the title bar, near the side, so test corners before titlebar.")
|
||||
|
||||
(SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN))
|
||||
(if CORNER
|
||||
then
|
||||
(* ;; "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.")
|
||||
|
||||
(* ;;
|
||||
"The upper corners may be in the title bar, near the side, so test corners before titlebar.")
|
||||
(* ;; "WINDOWREGION includes the attached windows")
|
||||
|
||||
(* ;; "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.")
|
||||
(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)
|
||||
|
||||
(* ;; "WINDOWREGION includes the attached windows")
|
||||
(* ;; "\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.")
|
||||
|
||||
(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.")
|
||||
|
||||
(CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
|
||||
[SETQ STARTINGREGION
|
||||
(GETREGION NIL NIL NIL NIL NIL
|
||||
(SELECTQ CORNER
|
||||
(RIGHTBOTTOM (\CURSORPOSITION RIGHT BOTTOM)
|
||||
(GETMOUSESTATE)
|
||||
(LIST LEFT TOP RIGHT BOTTOM))
|
||||
(LEFTBOTTOM (\CURSORPOSITION LEFT BOTTOM)
|
||||
(GETMOUSESTATE)
|
||||
(LIST RIGHT TOP LEFT BOTTOM))
|
||||
(RIGHTTOP (\CURSORPOSITION RIGHT TOP)
|
||||
(CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
|
||||
[SETQ STARTINGREGION
|
||||
(GETREGION NIL NIL NIL NIL NIL
|
||||
(SELECTQ CORNER
|
||||
(RIGHTBOTTOM (\CURSORPOSITION RIGHT BOTTOM)
|
||||
(GETMOUSESTATE)
|
||||
(LIST LEFT TOP RIGHT BOTTOM))
|
||||
(LEFTBOTTOM (\CURSORPOSITION LEFT BOTTOM)
|
||||
(GETMOUSESTATE)
|
||||
(LIST LEFT BOTTOM RIGHT TOP))
|
||||
(LEFTTOP (\CURSORPOSITION LEFT TOP)
|
||||
(GETMOUSESTATE)
|
||||
(LIST RIGHT BOTTOM LEFT TOP))
|
||||
(SHOULDNT])
|
||||
(SHAPEW (CENTRALWINDOW WINDOW)
|
||||
STARTINGREGION))
|
||||
T
|
||||
elseif (OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION))
|
||||
then (NEARESTCORNER ATTACHEDREGION)
|
||||
(MOVEW (CENTRALWINDOW WINDOW))
|
||||
T
|
||||
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
|
||||
'PREMODERN-BUTTONEVENTFN]
|
||||
then (APPLY* ORIGFUNCTION WINDOW))
|
||||
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
|
||||
'PREMODERN-BUTTONEVENTFN]
|
||||
(LIST RIGHT TOP LEFT BOTTOM))
|
||||
(RIGHTTOP (\CURSORPOSITION RIGHT TOP)
|
||||
(GETMOUSESTATE)
|
||||
(LIST LEFT BOTTOM RIGHT TOP))
|
||||
(LEFTTOP (\CURSORPOSITION LEFT TOP)
|
||||
(GETMOUSESTATE)
|
||||
(LIST RIGHT BOTTOM LEFT TOP))
|
||||
(SHOULDNT])
|
||||
(SHAPEW (CENTRALWINDOW WINDOW)
|
||||
STARTINGREGION))
|
||||
T
|
||||
elseif (AND [NOT (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS]
|
||||
(OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION)))
|
||||
then (NEARESTCORNER ATTACHEDREGION)
|
||||
(MOVEW (CENTRALWINDOW WINDOW))
|
||||
T
|
||||
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])
|
||||
|
||||
(NEARTOP
|
||||
@@ -406,19 +404,21 @@
|
||||
(MODERNWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))])
|
||||
|
||||
(MODERN-MENUBUTTONFN
|
||||
[LAMBDA (WINDOW) (* ; "Edited 23-May-2021 20:37 by rmk:")
|
||||
[LAMBDA (WINDOW) (* ; "Edited 25-Dec-2021 22:26 by rmk")
|
||||
(* ; "Edited 23-May-2021 20:37 by rmk:")
|
||||
|
||||
(* ;; "Replaces the button fn for a Menu window, allowing title clicks to do the move. Sometimes the title isn't in the window, it's in the menu.")
|
||||
(* ;; "Replaces the button fn for a Menu window, allowing title clicks to do the move. Sometimes the title isn't in the window, it's in the menu.")
|
||||
|
||||
(LET (MENU)
|
||||
(IF [AND (MOUSESTATE (ONLY LEFT))
|
||||
(EQ LASTKEYBOARD 0)
|
||||
(OR (WINDOWPROP WINDOW 'TITLE)
|
||||
(AND [NULL (CDR (SETQ MENU (MKLIST (WINDOWPROP WINDOW 'MENU]
|
||||
(TYPE? MENU (SETQ MENU (CAR MENU)))
|
||||
(FETCH (MENU TITLE) OF MENU)))
|
||||
(NEARTOP (WINDOWPROP WINDOW 'REGION)
|
||||
(FONTPROP WindowTitleDisplayStream 'HEIGHT]
|
||||
(IF [AND [NOT (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS]
|
||||
(MOUSESTATE (ONLY LEFT))
|
||||
(EQ LASTKEYBOARD 0)
|
||||
(OR (WINDOWPROP WINDOW 'TITLE)
|
||||
(AND [NULL (CDR (SETQ MENU (MKLIST (WINDOWPROP WINDOW 'MENU]
|
||||
(TYPE? MENU (SETQ MENU (CAR MENU)))
|
||||
(FETCH (MENU TITLE) OF MENU)))
|
||||
(NEARTOP (WINDOWPROP WINDOW 'REGION)
|
||||
(FONTPROP WindowTitleDisplayStream 'HEIGHT]
|
||||
THEN (MOVEW WINDOW)
|
||||
ELSE (MODERN-ORIG-MENUBUTTONFN WINDOW])
|
||||
)
|
||||
@@ -532,7 +532,7 @@
|
||||
|
||||
|
||||
(* (MODERNWINDOW.SETUP
|
||||
(QUOTE ONEDINSPECT.BUTTONEVENTFN)))
|
||||
(QUOTE ONEDINSPECT.BUTTONEVENTFN)))
|
||||
|
||||
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
|
||||
|
||||
@@ -571,7 +571,7 @@
|
||||
|
||||
|
||||
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
|
||||
'WINDOW))
|
||||
'WINDOW))
|
||||
|
||||
|
||||
(* ;; "Table browser and filebrowser)")
|
||||
@@ -612,12 +612,12 @@
|
||||
(ADDTOVAR LAMA MODERN-ADD-EXEC)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(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)))))
|
||||
(FILEMAP (NIL (5122 11399 (MODERNWINDOW 5132 . 6587) (MODERNWINDOW.SETUP 6589 . 9538) (UNMODERNWINDOW
|
||||
9540 . 9934) (MODERNWINDOW.UNSETUP 9936 . 10748) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10750 . 11397)) (
|
||||
11464 21491 (MODERNWINDOW.BUTTONEVENTFN 11474 . 18366) (NEARTOP 18368 . 19296) (NEARESTCORNER 19298 .
|
||||
20177) (INCORNER.REGION 20179 . 21489)) (21549 24021 (MODERN-ADD-EXEC 21559 . 21990) (MODERN-SNAPW
|
||||
21992 . 22535) (TOTOPW.MODERNIZE 22537 . 22965) (MODERN-MENUBUTTONFN 22967 . 24019)) (24022 26451 (
|
||||
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24032 . 24679) (MODERNIZED.TB.BUTTONEVENTFN 24681 . 26449)) (26492
|
||||
28771 (TEDIT.MODERNIZE 26502 . 27316) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27318 . 28440) (TEDIT.SELECTALL
|
||||
28442 . 28769)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1097
lispusers/MTP
1097
lispusers/MTP
File diff suppressed because it is too large
Load Diff
@@ -1,194 +1,190 @@
|
||||
(FILECREATED "22-Aug-86 12:23:34" {CSLI}PS:<SAMI>MULTIPLE-HARDCOPY.;2 8769
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to: (FILEVARS MULTIPLE-HARDCOPYCOMS)
|
||||
(FNS MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY MH.GET.INPUT.FILE MH.GET.PAGE#
|
||||
MH.SET.STARTINGPAGE#)
|
||||
(VARS MULTIPLE-HARDCOPYCOMS)
|
||||
(FILECREATED " 1-Feb-2022 16:50:25"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;2 10662
|
||||
|
||||
previous date: "22-Aug-86 11:37:58" {CSLI}PS:<SAMI>MULTIPLE-HARDCOPY.;1)
|
||||
:CHANGES-TO (FNS TOC)
|
||||
|
||||
:PREVIOUS-DATE "22-Aug-86 12:23:34"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MULTIPLE-HARDCOPYCOMS)
|
||||
|
||||
(RPAQQ MULTIPLE-HARDCOPYCOMS [(FNS MH.GET.INPUT.FILE MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY
|
||||
MH.SET.STARTINGPAGE# MH.GET.PAGE# TOC)
|
||||
(P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (MULTIPLE% HARDCOPY
|
||||
(QUOTE
|
||||
MULTIPLE.HARDCOPY)
|
||||
|
||||
"HARDCOPY A LIST OF FILES."])
|
||||
MH.SET.STARTINGPAGE# MH.GET.PAGE# TOC)
|
||||
(P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(MULTIPLE% HARDCOPY
|
||||
'MULTIPLE.HARDCOPY
|
||||
"HARDCOPY A LIST OF FILES."
|
||||
])
|
||||
(DEFINEQ
|
||||
|
||||
(MH.GET.INPUT.FILE
|
||||
[LAMBDA (FILE) (* edited: "22-Aug-86 12:11")
|
||||
[LAMBDA (FILE) (* edited%: "22-Aug-86 12:11")
|
||||
|
||||
(* Returns the file if the file is accessible or otherwise pesters the unwitting user until an existing file is
|
||||
supplied or nil to abort)
|
||||
(* Returns the file if the file is accessible or otherwise pesters the unwitting
|
||||
user until an existing file is supplied or nil to abort)
|
||||
|
||||
|
||||
(PROG NIL
|
||||
LOOP(OR FILE (RETURN))
|
||||
(AND (INFILEP FILE)
|
||||
(RETURN FILE))
|
||||
(printout T (CONCAT FILE " [not found.] ")
|
||||
T "TYPE ANOTHER INPUT FILE (NIL TO ABORT): ")
|
||||
(SETQ FILE (READ T))
|
||||
(OR FILE (RETURN))
|
||||
(GO LOOP])
|
||||
(PROG NIL
|
||||
LOOP
|
||||
(OR FILE (RETURN))
|
||||
(AND (INFILEP FILE)
|
||||
(RETURN FILE))
|
||||
(printout T (CONCAT FILE " [not found.] ")
|
||||
T "TYPE ANOTHER INPUT FILE (NIL TO ABORT): ")
|
||||
(SETQ FILE (READ T))
|
||||
(OR FILE (RETURN))
|
||||
(GO LOOP])
|
||||
|
||||
(MH.MAKE.GLOSSARY
|
||||
[LAMBDA (FILENAME) (* edited: "22-Aug-86 12:14")
|
||||
[LAMBDA (FILENAME) (* edited%: "22-Aug-86 12:14")
|
||||
|
||||
(* This function relies on the function TOC (written by Nick Briggs) to produce a table of contents.
|
||||
It just takes the TEdit stream returned by TOC and TEDIT.PUTs it to a file.)
|
||||
(* This function relies on the function TOC
|
||||
(written by Nick Briggs) to produce a table of contents.
|
||||
It just takes the TEdit stream returned by TOC and TEDIT.PUTs it to a file.)
|
||||
|
||||
|
||||
(COND
|
||||
((BOUNDP (QUOTE MULTIPLE.HARDCOPY.LIST))
|
||||
(TEDIT.PUT (TOC MULTIPLE.HARDCOPY.LIST)
|
||||
FILENAME))
|
||||
(T (PRINTOUT T "MULTIPLE.HARDCOPY MUST BE RUN FIRST" T])
|
||||
(COND
|
||||
((BOUNDP 'MULTIPLE.HARDCOPY.LIST)
|
||||
(TEDIT.PUT (TOC MULTIPLE.HARDCOPY.LIST)
|
||||
FILENAME))
|
||||
(T (PRINTOUT T "MULTIPLE.HARDCOPY MUST BE RUN FIRST" T])
|
||||
|
||||
(MULTIPLE.HARDCOPY
|
||||
[LAMBDA (STREAM FILELST GLOSSARY.FILE TOFILE? DONTSEND UNFORMATTED? BREAKPAGETITLE SERVER
|
||||
PRINTOPTIONS) (* edited: "22-Aug-86 12:23")
|
||||
|
||||
(* HARDCOPIES all the files in FILELST making sure that the files are numbered consecutively.
|
||||
If STREAM is supplied then it should be a TEdit stream. The intent is that one could set up one's desired page
|
||||
looks in a TEdit window and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page looks.
|
||||
If a STREAM is not given then a fresh TEdit window is started. FILELST should be a list of files to hardcopy in the
|
||||
order that they should be numbered. GLOSSARY.FILE, if given, should be the name of a file. If given then after
|
||||
MULTIPLE.HARDCOPY is done hardcopying it will use the MH.MAKE.GLOSSARY to make a table of contents for the files
|
||||
and save the table of contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created for each
|
||||
file in FILELST that is the same name as the file but with extension IP. If DONTSEND is NON-NIL then the files will
|
||||
not be sent to the printer (this only makes sense if you're creating IP files). If UNFORMATTED? is NON-NIL then the
|
||||
files will be hardcopied without formatting information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as
|
||||
per TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable MULTIPLE.HARDCOPY.LIST which is a useful
|
||||
list of information about this hardcopy process. The list is of the form: (<starting page#> %.
|
||||
<list of pairs>) where each pair is of the form (<name of file> <start page# of file>))
|
||||
PRINTOPTIONS) (* edited%: "22-Aug-86 12:23")
|
||||
|
||||
(* HARDCOPIES all the files in FILELST making sure that the files are numbered
|
||||
consecutively. If STREAM is supplied then it should be a TEdit stream.
|
||||
The intent is that one could set up one's desired page looks in a TEdit window
|
||||
and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page
|
||||
looks. If a STREAM is not given then a fresh TEdit window is started.
|
||||
FILELST should be a list of files to hardcopy in the order that they should be
|
||||
numbered. GLOSSARY.FILE, if given, should be the name of a file.
|
||||
If given then after MULTIPLE.HARDCOPY is done hardcopying it will use the
|
||||
MH.MAKE.GLOSSARY to make a table of contents for the files and save the table of
|
||||
contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created
|
||||
for each file in FILELST that is the same name as the file but with extension IP.
|
||||
If DONTSEND is NON-NIL then the files will not be sent to the printer
|
||||
(this only makes sense if you're creating IP files)%.
|
||||
If UNFORMATTED? is NON-NIL then the files will be hardcopied without formatting
|
||||
information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as per
|
||||
TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable
|
||||
MULTIPLE.HARDCOPY.LIST which is a useful list of information about this hardcopy
|
||||
process. The list is of the form%: (<starting page#> %.
|
||||
<list of pairs>) where each pair is of the form
|
||||
(<name of file> <start page# of file>))
|
||||
|
||||
(PROG* (FRAME LOCALINFO INITIAL.DEFAULTPG PG)
|
||||
(OR FILELST (SETQ FILELST (TTYIN "FILELST TO HARDCOPY>>"))
|
||||
(RETURN (PRINTOUT T "No filelst specified.")))
|
||||
[OR STREAM (SETQ STREAM (TEXTSTREAM (PROCESSPROP (TEDIT (MH.GET.INPUT.FILE
|
||||
(CAR FILELST)))
|
||||
(QUOTE WINDOW]
|
||||
(COND
|
||||
((ATOM FILELST)
|
||||
(SETQ FILELST (LIST FILELST)))
|
||||
(FILELST))
|
||||
(SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM))
|
||||
TEDIT.PAGE.FRAMES))
|
||||
[SETQ LOCALINFO (fetch REGIONLOCALINFO of (COND
|
||||
((LISTP FRAME)
|
||||
(CAR FRAME))
|
||||
(T FRAME]
|
||||
[SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO (QUOTE STARTINGPAGE#))
|
||||
(SUB1 (LISTGET LOCALINFO (QUOTE STARTINGPAGE#]
|
||||
(SETQ PG (OR INITIAL.DEFAULTPG 0))
|
||||
(SETQ MULTIPLE.HARDCOPY.LIST NIL)
|
||||
(ADVISE (QUOTE TEDIT.PROMPTPRINT)
|
||||
(QUOTE BEFORE)
|
||||
(QUOTE (SETQ PG MSG)))
|
||||
[for FILE in FILELST do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE))
|
||||
(OR FILE (RETURN))
|
||||
(PROMPTPRINT "MULTIPLE.HARDCOPY: " (FULLNAME
|
||||
FILE))
|
||||
(TEDIT.GET (TEXTOBJ STREAM)
|
||||
FILE UNFORMATTED?)
|
||||
(replace TXTPAGEFRAMES of (TEXTOBJ STREAM)
|
||||
with FRAME)
|
||||
(MH.SET.STARTINGPAGE# (ADD1 PG)
|
||||
FRAME)
|
||||
(TEDIT.HARDCOPY STREAM
|
||||
(COND
|
||||
(TOFILE? (PACKFILENAME
|
||||
(QUOTE NAME)
|
||||
TOFILE?
|
||||
(QUOTE EXTENSION)
|
||||
(QUOTE IP)))
|
||||
(T NIL))
|
||||
DONTSEND BREAKPAGETITLE SERVER
|
||||
PRINTOPTIONS)
|
||||
(SETQ PG (MKATOM (MH.GET.PAGE# PG)))
|
||||
(SETQ MULTIPLE.HARDCOPY.LIST
|
||||
(NCONC1 MULTIPLE.HARDCOPY.LIST
|
||||
(CONS FILE PG]
|
||||
(UNADVISE TEDIT.PROMPTPRINT)
|
||||
(MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG))
|
||||
FRAME)
|
||||
(RETURN (COND
|
||||
(MULTIPLE.HARDCOPY.LIST (SETQ MULTIPLE.HARDCOPY.LIST
|
||||
(CONS (OR (AND INITIAL.DEFAULTPG (ADD1
|
||||
INITIAL.DEFAULTPG))
|
||||
1)
|
||||
MULTIPLE.HARDCOPY.LIST))
|
||||
(COND
|
||||
(GLOSSARY.FILE (MH.MAKE.GLOSSARY GLOSSARY.FILE)
|
||||
(PRINTOUT T (CONCAT
|
||||
"Glossary file in: "
|
||||
(FULLNAME
|
||||
GLOSSARY.FILE)
|
||||
)
|
||||
T)))
|
||||
MULTIPLE.HARDCOPY.LIST])
|
||||
(OR FILELST (SETQ FILELST (TTYIN "FILELST TO HARDCOPY>>"))
|
||||
(RETURN (PRINTOUT T "No filelst specified.")))
|
||||
[OR STREAM (SETQ STREAM (TEXTSTREAM (PROCESSPROP (TEDIT (MH.GET.INPUT.FILE (CAR FILELST)))
|
||||
'WINDOW]
|
||||
(COND
|
||||
((ATOM FILELST)
|
||||
(SETQ FILELST (LIST FILELST)))
|
||||
(FILELST))
|
||||
(SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM))
|
||||
TEDIT.PAGE.FRAMES))
|
||||
[SETQ LOCALINFO (fetch REGIONLOCALINFO of (COND
|
||||
((LISTP FRAME)
|
||||
(CAR FRAME))
|
||||
(T FRAME]
|
||||
[SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO 'STARTINGPAGE#)
|
||||
(SUB1 (LISTGET LOCALINFO 'STARTINGPAGE#]
|
||||
(SETQ PG (OR INITIAL.DEFAULTPG 0))
|
||||
(SETQ MULTIPLE.HARDCOPY.LIST NIL)
|
||||
(ADVISE 'TEDIT.PROMPTPRINT 'BEFORE '(SETQ PG MSG))
|
||||
[for FILE in FILELST do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE))
|
||||
(OR FILE (RETURN))
|
||||
(PROMPTPRINT "MULTIPLE.HARDCOPY: " (FULLNAME FILE))
|
||||
(TEDIT.GET (TEXTOBJ STREAM)
|
||||
FILE UNFORMATTED?)
|
||||
(replace TXTPAGEFRAMES of (TEXTOBJ STREAM) with FRAME)
|
||||
(MH.SET.STARTINGPAGE# (ADD1 PG)
|
||||
FRAME)
|
||||
(TEDIT.HARDCOPY STREAM (COND
|
||||
(TOFILE? (PACKFILENAME
|
||||
'NAME TOFILE?
|
||||
'EXTENSION
|
||||
'IP))
|
||||
(T NIL))
|
||||
DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS)
|
||||
(SETQ PG (MKATOM (MH.GET.PAGE# PG)))
|
||||
(SETQ MULTIPLE.HARDCOPY.LIST (NCONC1 MULTIPLE.HARDCOPY.LIST
|
||||
(CONS FILE PG]
|
||||
(UNADVISE TEDIT.PROMPTPRINT)
|
||||
(MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG))
|
||||
FRAME)
|
||||
(RETURN (COND
|
||||
(MULTIPLE.HARDCOPY.LIST (SETQ MULTIPLE.HARDCOPY.LIST
|
||||
(CONS (OR (AND INITIAL.DEFAULTPG (ADD1
|
||||
INITIAL.DEFAULTPG
|
||||
))
|
||||
1)
|
||||
MULTIPLE.HARDCOPY.LIST))
|
||||
(COND
|
||||
(GLOSSARY.FILE (MH.MAKE.GLOSSARY GLOSSARY.FILE)
|
||||
(PRINTOUT T (CONCAT "Glossary file in: " (FULLNAME
|
||||
GLOSSARY.FILE)
|
||||
)
|
||||
T)))
|
||||
MULTIPLE.HARDCOPY.LIST])
|
||||
|
||||
(MH.SET.STARTINGPAGE#
|
||||
[LAMBDA (PG# PAGE.FRAMES) (* edited: "22-Aug-86 12:15")
|
||||
(* Sets the starting page of a PAGE.FRAME.)
|
||||
[COND
|
||||
((LISTP PAGE.FRAMES)
|
||||
(SETQ PAGE.FRAMES (CAR PAGE.FRAMES]
|
||||
[LAMBDA (PG# PAGE.FRAMES) (* edited%: "22-Aug-86 12:15")
|
||||
(* Sets the starting page of a
|
||||
PAGE.FRAME.)
|
||||
[COND
|
||||
((LISTP PAGE.FRAMES)
|
||||
(SETQ PAGE.FRAMES (CAR PAGE.FRAMES]
|
||||
(LET ((LOCAL.INFO (fetch REGIONLOCALINFO of PAGE.FRAMES)))
|
||||
(COND
|
||||
(LOCAL.INFO (LISTPUT (fetch REGIONLOCALINFO of PAGE.FRAMES)
|
||||
(QUOTE STARTINGPAGE#)
|
||||
PG#))
|
||||
(T (replace REGIONLOCALINFO of PAGE.FRAMES with (LIST (QUOTE STARTINGPAGE#)
|
||||
PG#])
|
||||
(COND
|
||||
(LOCAL.INFO (LISTPUT (fetch REGIONLOCALINFO of PAGE.FRAMES)
|
||||
'STARTINGPAGE# PG#))
|
||||
(T (replace REGIONLOCALINFO of PAGE.FRAMES with (LIST 'STARTINGPAGE# PG#])
|
||||
|
||||
(MH.GET.PAGE#
|
||||
[LAMBDA (STR) (* edited: "22-Aug-86 12:13")
|
||||
[LAMBDA (STR) (* edited%: "22-Aug-86 12:13")
|
||||
|
||||
(* This is meant to extract a number from a string such as "2pgs done." which is what TEdit prints out when it's
|
||||
finished hardcopying something. This is unfortunately the way this program relies on to extract how many pages a
|
||||
file was hardcopied.)
|
||||
(* This is meant to extract a number from a string such as "2pgs done." which is
|
||||
what TEdit prints out when it's finished hardcopying something.
|
||||
This is unfortunately the way this program relies on to extract how many pages a
|
||||
file was hardcopied.)
|
||||
|
||||
|
||||
(LET ((CH (GNC STR)))
|
||||
(COND
|
||||
((NUMBERP (MKATOM CH))
|
||||
(CONCAT CH (MH.GET.PAGE# STR)))
|
||||
(T ""])
|
||||
(LET ((CH (GNC STR)))
|
||||
(COND
|
||||
((NUMBERP (MKATOM CH))
|
||||
(CONCAT CH (MH.GET.PAGE# STR)))
|
||||
(T ""])
|
||||
|
||||
(TOC
|
||||
[LAMBDA (FILE) (* edited: "22-Aug-86 11:48")
|
||||
(* (* N.H.Briggs " 8-Apr-86 11:23"))
|
||||
[LAMBDA (FILE) (* ; "Edited 1-Feb-2022 16:47 by rmk")
|
||||
(* edited%: "22-Aug-86 11:48")
|
||||
(* (* N.H.Briggs " 8-Apr-86 11:23"))
|
||||
(LET (TOCSTREAM TOCINFO TOCOUTSTREAM STARTPAGE)
|
||||
(if (LISTP FILE)
|
||||
then (SETQ TOCINFO FILE)
|
||||
else [SETQ TOCINFO (READ (SETQ TOCSTREAM (OPENSTREAM FILE (QUOTE INPUT]
|
||||
(CLOSEF TOCSTREAM))
|
||||
(SETQ TOCOUTSTREAM (OPENTEXTSTREAM ""))
|
||||
(SETQ STARTPAGE (CAR TOCINFO))
|
||||
[for TOCENTRY in (CDR TOCINFO)
|
||||
do (TEDIT.INSERT TOCOUTSTREAM (FILENAMEFIELD (CAR TOCENTRY)
|
||||
(QUOTE NAME)))
|
||||
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE TAB)))
|
||||
(TEDIT.INSERT TOCOUTSTREAM (MKSTRING STARTPAGE))
|
||||
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE CR)))
|
||||
(SETQ STARTPAGE (ADD1 (CDR TOCENTRY]
|
||||
(TEDIT.PARALOOKS TOCOUTSTREAM (QUOTE (TABS (NIL (360 . DOTTEDLEFT))
|
||||
RIGHTMARGIN 456))
|
||||
1
|
||||
(GETEOFPTR TOCOUTSTREAM))
|
||||
TOCOUTSTREAM])
|
||||
(if (LISTP FILE)
|
||||
then (SETQ TOCINFO FILE)
|
||||
else [SETQ TOCINFO (READ (SETQ TOCSTREAM (OPENSTREAM FILE 'INPUT]
|
||||
(CLOSEF TOCSTREAM))
|
||||
(SETQ TOCOUTSTREAM (OPENTEXTSTREAM NIL))
|
||||
(SETQ STARTPAGE (CAR TOCINFO))
|
||||
[for TOCENTRY in (CDR TOCINFO) do (TEDIT.INSERT TOCOUTSTREAM (FILENAMEFIELD (CAR TOCENTRY)
|
||||
'NAME))
|
||||
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE TAB)))
|
||||
(TEDIT.INSERT TOCOUTSTREAM (MKSTRING STARTPAGE))
|
||||
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE CR)))
|
||||
(SETQ STARTPAGE (ADD1 (CDR TOCENTRY]
|
||||
(TEDIT.PARALOOKS TOCOUTSTREAM '(TABS (NIL (360 . DOTTEDLEFT))
|
||||
RIGHTMARGIN 456)
|
||||
1
|
||||
(GETEOFPTR TOCOUTSTREAM))
|
||||
TOCOUTSTREAM])
|
||||
)
|
||||
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (MULTIPLE% HARDCOPY (QUOTE MULTIPLE.HARDCOPY)
|
||||
"HARDCOPY A LIST OF FILES.")))
|
||||
(DECLARE: DONTCOPY
|
||||
(FILEMAP (NIL (717 8614 (MH.GET.INPUT.FILE 727 . 1306) (MH.MAKE.GLOSSARY 1308 . 1825) (
|
||||
MULTIPLE.HARDCOPY 1827 . 6270) (MH.SET.STARTINGPAGE# 6272 . 6917) (MH.GET.PAGE# 6919 . 7454) (TOC 7456
|
||||
. 8612)))))
|
||||
|
||||
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(MULTIPLE% HARDCOPY 'MULTIPLE.HARDCOPY
|
||||
"HARDCOPY A LIST OF FILES."))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (925 10481 (MH.GET.INPUT.FILE 935 . 1531) (MH.MAKE.GLOSSARY 1533 . 2062) (
|
||||
MULTIPLE.HARDCOPY 2064 . 7788) (MH.SET.STARTINGPAGE# 7790 . 8485) (MH.GET.PAGE# 8487 . 9049) (TOC 9051
|
||||
. 10479)))))
|
||||
STOP
|
||||
|
||||
BIN
lispusers/MULTIPLE-HARDCOPY.LCOM
Normal file
BIN
lispusers/MULTIPLE-HARDCOPY.LCOM
Normal file
Binary file not shown.
1501
lispusers/OBJECTWINDOW
Normal file
1501
lispusers/OBJECTWINDOW
Normal file
File diff suppressed because it is too large
Load Diff
BIN
lispusers/OBJECTWINDOW.LCOM
Normal file
BIN
lispusers/OBJECTWINDOW.LCOM
Normal file
Binary file not shown.
BIN
lispusers/OBJECTWINDOW.TEDIT
Normal file
BIN
lispusers/OBJECTWINDOW.TEDIT
Normal file
Binary file not shown.
@@ -1,11 +1,10 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 21:55:15"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>PRETTYFILEINDEX.;5 93788
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
changes to%: (FNS PRETTYFILEINDEX PFI.PRINT.FILECREATED)
|
||||
(FILECREATED "30-Nov-2021 22:12:37" {DSK}<home>larry>medley>lispusers>PRETTYFILEINDEX.;2 94399
|
||||
|
||||
previous date%: " 9-Jul-2021 08:04:40"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>PRETTYFILEINDEX.;4)
|
||||
:CHANGES-TO (FNS PFI.PRINT.FILECREATED)
|
||||
|
||||
:PREVIOUS-DATE " 9-Jul-2021 21:55:15" {DSK}<home>larry>medley>lispusers>PRETTYFILEINDEX.;1)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -16,7 +15,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
|
||||
(RPAQQ PRETTYFILEINDEXCOMS
|
||||
[(COMS
|
||||
(* ;; "Variation on SINGLEFILEINDEX that prettyprints straight to the image stream.")
|
||||
(* ;; "Variation on SINGLEFILEINDEX that prettyprints straight to the image stream.")
|
||||
|
||||
(FNS PFI.NEW.LISTFILES1 PFI.ENQUEUE \PFI.DO.HARDCOPY MAYBE.PRETTYFILEINDEX)
|
||||
(FNS PRETTYFILEINDEX PFI.MAKE.LPT.STREAM PFI.SETUP.TRANSLATIONS PFI.OUTCHARFN
|
||||
@@ -25,25 +24,25 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(FNS PFI.PROCESS.FILE PFI.PASS.COMMENT PFI.HANDLE.EXPR PFI.DEFAULT.HANDLER
|
||||
PFI.PRETTYPRINT PFI.LINES.REMAINING PFI.MAYBE.NEW.PAGE PFI.ESTIMATE.SIZE
|
||||
PFI.ESTIMATE.SIZE1))
|
||||
(COMS (* ; "Expression handlers")
|
||||
(COMS (* ; "Expression handlers")
|
||||
(FNS PFI.HANDLE.RPAQQ PFI.HANDLE.DECLARE PFI.HANDLE.EVAL-WHEN PFI.HANDLE.DEFDEFINER
|
||||
PFI.HANDLE.DEFINEQ PFI.PRINT.LAMBDA PFI.PRINT.LAMBDA.BODY PFI.HANDLE.PUTDEF
|
||||
PFI.HANDLE.PUTPROPS PFI.HANDLE./DECLAREDATATYPE PFI.HANDLE.* PFI.PRINT.COMMENTS
|
||||
PFI.HANDLE.FILEMAP PFI.HANDLE.PACKAGE))
|
||||
(COMS (* ; "Previewers")
|
||||
(COMS (* ; "Previewers")
|
||||
(FNS PFI.PREVIEW.DECLARE PFI.PREVIEW.DEFINEQ))
|
||||
(COMS (* ; "Printing the index")
|
||||
(COMS (* ; "Printing the index")
|
||||
(FNS PFI.PRINT.INDEX PFI.CONDENSE.INDEX PFI.SORT.INDICES PFI.COMPUTE.INDEX.SHAPE
|
||||
PFI.PRINT.INDICES PFI.CENTER.PRINT PFI.INDEX.BREAK PFI.LOOKUP.NAME)
|
||||
(FNS PFI.ADD.TO.INDEX PFI.VARNAME PFI.CONSTANTNAMES))
|
||||
(COMS (* ; "Combined listings")
|
||||
(COMS (* ; "Combined listings")
|
||||
(FNS MULTIFILEINDEX MULTIFILEINDEX1 PFI.PRINT.MULTI.INDEX PFI.CHOOSE.BEST
|
||||
PFI.MERGE.INDICES))
|
||||
(COMS (* ;
|
||||
"Hooks for seeing files pretty elsewhere")
|
||||
(COMS (* ;
|
||||
"Hooks for seeing files pretty elsewhere")
|
||||
(FNS PFI.MAYBE.SEE.PRETTY PFI.MAYBE.PP.DEFINITION)
|
||||
(INITVARS (*PRINT-PRETTY-FROM-FILES* T)))
|
||||
(COMS (* ; "Bitmap hack")
|
||||
(COMS (* ; "Bitmap hack")
|
||||
(FNS PFI.PRINT.BITMAP)
|
||||
(INITVARS (*PRINT-PRETTY-BITMAPS* T)))
|
||||
(INITVARS [*PFI-PRINTOPTIONS* '(REGION (72 54 504 702]
|
||||
@@ -57,8 +56,8 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
then *INTERLISP-PACKAGE* else
|
||||
*KEYWORD-PACKAGE*)))
|
||||
|
||||
(* ;;
|
||||
"Properties of definers changed between Lyric and Medley (yech).")
|
||||
(* ;;
|
||||
"Properties of definers changed between Lyric and Medley (yech).")
|
||||
|
||||
(MAPCAR '("DEFINER-FOR" "DEFINED-BY" "DEFINITION-NAME")
|
||||
(FUNCTION CL:INTERN]
|
||||
@@ -66,7 +65,7 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(\PFI.PROCESSLOCK (CREATE.MONITORLOCK "PRETTYFILEINDEX"))
|
||||
(\PFI.PROCESS))
|
||||
(COMS
|
||||
(* ;; "These are just in case our afternewpagefn escapes our dynamic context. *PFI-TITLE* being NIL means we're outside prettyfileindex")
|
||||
(* ;; "These are just in case our afternewpagefn escapes our dynamic context. *PFI-TITLE* being NIL means we're outside prettyfileindex")
|
||||
|
||||
(INITVARS (*PFI-TITLE*)
|
||||
(*PFI-PAGE-COUNT* 0)))
|
||||
@@ -102,8 +101,8 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(*PFI-PROPERTIES* (COPYRIGHT)
|
||||
(READVICE ADVICE))
|
||||
(*PFI-FILTERS* (VARIABLES . CONSTANTS)))
|
||||
(COMS (* ;
|
||||
"Prettyprint augmentation to mimic system makefile dumping")
|
||||
(COMS (* ;
|
||||
"Prettyprint augmentation to mimic system makefile dumping")
|
||||
(FNS PUTPROPS.PRETTYPRINT RPAQX.PRETTYPRINT COURIERPROGRAM.PRETTYPRINT
|
||||
MAYBE.PRETTYPRINT.BOLD)
|
||||
(ALISTS (PRETTYPRINTMACROS RPAQ RPAQQ RPAQ? ADDTOVAR PUTPROPS COURIERPROGRAM)))
|
||||
@@ -119,8 +118,8 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(GLOBALVARS \PFI.PROCESS.COMMANDS \PFI.PROCESSLOCK \PFI.PROCESS NOTLISTEDFILES
|
||||
MACROPROPS CLISPRECORDTYPES PROMPTWINDOW *PFI-DEFINER-PROPS*
|
||||
*COMMON-LISP-READ-ENVIRONMENT*))
|
||||
[DECLARE%: EVAL@COMPILE DOCOPY (* ;
|
||||
"Public variables to declare special")
|
||||
[DECLARE%: EVAL@COMPILE DOCOPY (* ;
|
||||
"Public variables to declare special")
|
||||
(P (CL:PROCLAIM '(CL:SPECIAL *PFI-TYPES* *PFI-HANDLERS* *PFI-PREVIEWERS*
|
||||
*PFI-DONT-SPAWN* *PFI-PROPERTIES* *PFI-FILTERS*
|
||||
*PRINT-PRETTY-FROM-FILES* *PRINT-PRETTY-BITMAPS*
|
||||
@@ -130,24 +129,24 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(P (OR (GETD 'CODEWRAPPER.PRETTYPRINT)
|
||||
(FILESLOAD (SYSLOAD)
|
||||
DEFINERPRINT))
|
||||
(* ;
|
||||
"Get prettyprinter fixes if running in old sysout")
|
||||
(* ;
|
||||
"Get prettyprinter fixes if running in old sysout")
|
||||
(MOVD? [PROG ((SYMS '("OLDLISTFILES1" "LISTFILES1-ORIGINAL"))
|
||||
S)
|
||||
(* ;
|
||||
"Look for LISTFILES1. These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")
|
||||
(* ;
|
||||
"Look for LISTFILES1. These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")
|
||||
LP
|
||||
(COND [(AND (SETQ S (CL:FIND-SYMBOL (CAR SYMS)))
|
||||
(GETD S))
|
||||
(RETURN (PROG1 S
|
||||
(COND ((SETQ S (CL:FIND-SYMBOL "MAYBE-PP-CODE-FILE"
|
||||
))
|
||||
(* ; "Also fix SEE")
|
||||
(* ; "Also fix SEE")
|
||||
(MOVD 'PFI.MAYBE.SEE.PRETTY S NIL T))))]
|
||||
((SETQ SYMS (CDR SYMS))
|
||||
(GO LP))
|
||||
(T (* ;
|
||||
"Neither one loaded, take original")
|
||||
(T (* ;
|
||||
"Neither one loaded, take original")
|
||||
(RETURN 'LISTFILES1]
|
||||
'PFI.ORIGINAL.LISTFILES1 NIL T)
|
||||
(MOVD 'PFI.NEW.LISTFILES1 'LISTFILES1 NIL T)
|
||||
@@ -459,12 +458,17 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(PFI.PRINT.FILECREATED
|
||||
[LAMBDA (EXPR ENV) (* ; "Edited 9-Jul-2021 07:59 by rmk:")
|
||||
[LAMBDA (EXPR ENV) (* ;
|
||||
"Edited 30-Nov-2021 22:08 by larry")
|
||||
(* ;
|
||||
"Edited 30-Nov-2021 21:40 by larry")
|
||||
(* ;
|
||||
"Edited 9-Jul-2021 07:59 by rmk:")
|
||||
|
||||
(* ;; "Display the FILECREATED expression and environment prettily")
|
||||
(* ;; "Display the FILECREATED expression and environment prettily")
|
||||
|
||||
(* ;;
|
||||
"Form is (FILECREATED date filename filemaploc changes to: changes previous date: date filename)")
|
||||
(* ;;
|
||||
"Form is (FILECREATED date filename filemaploc changes to: changes previous date: date filename)")
|
||||
|
||||
(pop EXPR)
|
||||
(CHANGEFONT ITALICFONT)
|
||||
@@ -477,34 +481,41 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
STRWIDTHS]
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "File created:")
|
||||
TABSTOP) (* ; "File created:")
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" " .FONT LAMBDAFONT (pop EXPR)
|
||||
T T) (* ; "date and file name")
|
||||
T T) (* ; "date and file name")
|
||||
(if (OR (NULL (CAR EXPR))
|
||||
(FIXP (CAR EXPR)))
|
||||
then (* ; "Skip over filemaploc")
|
||||
then (* ; "Skip over filemaploc")
|
||||
(pop EXPR))
|
||||
(if (EQ (CAR EXPR)
|
||||
'changes)
|
||||
then (* ; "handle %"Changes to:%"")
|
||||
(if (SELECTQ (CAR EXPR)
|
||||
(changes (SETQ EXPR (CDR EXPR))
|
||||
T)
|
||||
(:CHANGES-TO T)
|
||||
NIL)
|
||||
then (* ; "handle %"Changes to:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDDR EXPR))
|
||||
(SETQ EXPR (CDR EXPR))
|
||||
(PRINTDEF (while (LISTP (CAR EXPR)) collect (pop EXPR))
|
||||
T NIL T)
|
||||
(TERPRI)
|
||||
(TERPRI)
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
(if (EQ (CAR EXPR)
|
||||
'previous)
|
||||
then (* ; "Handle %"Previous date:%"")
|
||||
(if (SELECTQ (CAR EXPR)
|
||||
(previous (SETQ EXPR (CDR EXPR))
|
||||
T)
|
||||
(:PREVIOUS-DATE
|
||||
T)
|
||||
NIL)
|
||||
then (* ; "Handle %"Previous date:%"")
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(SETQ EXPR (CDDR EXPR))
|
||||
(SETQ EXPR (CDR EXPR))
|
||||
(PRINTOUT NIL (pop EXPR)
|
||||
" "
|
||||
(pop EXPR)
|
||||
@@ -512,25 +523,25 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
else (pop STRINGS)
|
||||
(pop STRWIDTHS))
|
||||
|
||||
(* ;; "Show environment")
|
||||
(* ;; "Show environment")
|
||||
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Read table")
|
||||
TABSTOP) (* ; "Read table")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :READTABLE)
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Package")
|
||||
TABSTOP) (* ; "Package")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :PACKAGE)
|
||||
(if (NEQ *PRINT-BASE* 10)
|
||||
then (PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP)
|
||||
(PFI.PRINT.ENVIRONMENT ENV :BASE)
|
||||
ELSE (pop STRINGS))
|
||||
else (pop STRINGS))
|
||||
(PFI.PRINT.TO.TAB (pop STRINGS)
|
||||
(pop STRWIDTHS)
|
||||
TABSTOP) (* ; "Format")
|
||||
TABSTOP) (* ; "Format")
|
||||
(PFI.PRINT.ENVIRONMENT ENV :FORMAT])
|
||||
|
||||
(PFI.PRINT.TO.TAB
|
||||
@@ -819,8 +830,8 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
then *INTERLISP-PACKAGE* else *KEYWORD-PACKAGE*))
|
||||
)
|
||||
|
||||
(* ;;
|
||||
"Properties of definers changed between Lyric and Medley (yech).")
|
||||
(* ;;
|
||||
"Properties of definers changed between Lyric and Medley (yech).")
|
||||
|
||||
(MAPCAR '("DEFINER-FOR" "DEFINED-BY" "DEFINITION-NAME")
|
||||
(FUNCTION CL:INTERN))))
|
||||
@@ -948,24 +959,24 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
(FILESLOAD (SYSLOAD)
|
||||
DEFINERPRINT))
|
||||
|
||||
(* ;
|
||||
"Get prettyprinter fixes if running in old sysout")
|
||||
(* ;
|
||||
"Get prettyprinter fixes if running in old sysout")
|
||||
|
||||
(MOVD? [PROG ((SYMS '("OLDLISTFILES1" "LISTFILES1-ORIGINAL"))
|
||||
S) (* ;
|
||||
"Look for LISTFILES1. These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")
|
||||
S) (* ;
|
||||
"Look for LISTFILES1. These two names are where SINGLEFILEINDEX and PP-CODE-FILE stash it.")
|
||||
LP (COND
|
||||
[(AND (SETQ S (CL:FIND-SYMBOL (CAR SYMS)))
|
||||
(GETD S))
|
||||
(RETURN (PROG1 S
|
||||
(COND
|
||||
((SETQ S (CL:FIND-SYMBOL "MAYBE-PP-CODE-FILE"))
|
||||
(* ; "Also fix SEE")
|
||||
(* ; "Also fix SEE")
|
||||
(MOVD 'PFI.MAYBE.SEE.PRETTY S NIL T))))]
|
||||
((SETQ SYMS (CDR SYMS))
|
||||
(GO LP))
|
||||
(T (* ;
|
||||
"Neither one loaded, take original")
|
||||
(T (* ;
|
||||
"Neither one loaded, take original")
|
||||
(RETURN 'LISTFILES1]
|
||||
'PFI.ORIGINAL.LISTFILES1 NIL T)
|
||||
|
||||
@@ -983,28 +994,28 @@ Copyright (c) 1988, 1992-1993, 1999, 2021 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS PRETTYFILEINDEX COPYRIGHT ("Xerox Corporation" 1988 1992 1993 1999 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (10148 12383 (PFI.NEW.LISTFILES1 10158 . 10652) (PFI.ENQUEUE 10654 . 11278) (
|
||||
\PFI.DO.HARDCOPY 11280 . 11866) (MAYBE.PRETTYFILEINDEX 11868 . 12381)) (12384 35298 (PRETTYFILEINDEX
|
||||
12394 . 26826) (PFI.MAKE.LPT.STREAM 26828 . 29879) (PFI.SETUP.TRANSLATIONS 29881 . 31395) (
|
||||
PFI.OUTCHARFN 31397 . 33371) (PFI.COLLECT.DEFINERS 33373 . 34185) (PFI.AFTER.NEW.PAGE 34187 . 35296))
|
||||
(35299 40558 (PFI.PRINT.FILECREATED 35309 . 38825) (PFI.PRINT.TO.TAB 38827 . 39192) (
|
||||
PFI.PRINT.ENVIRONMENT 39194 . 40556)) (40559 47743 (PFI.PROCESS.FILE 40569 . 41799) (PFI.PASS.COMMENT
|
||||
41801 . 42771) (PFI.HANDLE.EXPR 42773 . 43440) (PFI.DEFAULT.HANDLER 43442 . 45495) (PFI.PRETTYPRINT
|
||||
45497 . 45832) (PFI.LINES.REMAINING 45834 . 46161) (PFI.MAYBE.NEW.PAGE 46163 . 46666) (
|
||||
PFI.ESTIMATE.SIZE 46668 . 47199) (PFI.ESTIMATE.SIZE1 47201 . 47741)) (47780 57267 (PFI.HANDLE.RPAQQ
|
||||
47790 . 49198) (PFI.HANDLE.DECLARE 49200 . 50139) (PFI.HANDLE.EVAL-WHEN 50141 . 50624) (
|
||||
PFI.HANDLE.DEFDEFINER 50626 . 51916) (PFI.HANDLE.DEFINEQ 51918 . 52162) (PFI.PRINT.LAMBDA 52164 .
|
||||
52502) (PFI.PRINT.LAMBDA.BODY 52504 . 52839) (PFI.HANDLE.PUTDEF 52841 . 53338) (PFI.HANDLE.PUTPROPS
|
||||
53340 . 53955) (PFI.HANDLE./DECLAREDATATYPE 53957 . 54504) (PFI.HANDLE.* 54506 . 55768) (
|
||||
PFI.PRINT.COMMENTS 55770 . 56670) (PFI.HANDLE.FILEMAP 56672 . 56960) (PFI.HANDLE.PACKAGE 56962 . 57265
|
||||
)) (57295 58287 (PFI.PREVIEW.DECLARE 57305 . 57967) (PFI.PREVIEW.DEFINEQ 57969 . 58285)) (58323 69311
|
||||
(PFI.PRINT.INDEX 58333 . 59184) (PFI.CONDENSE.INDEX 59186 . 60993) (PFI.SORT.INDICES 60995 . 62134) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 62136 . 63600) (PFI.PRINT.INDICES 63602 . 68144) (PFI.CENTER.PRINT 68146 .
|
||||
68716) (PFI.INDEX.BREAK 68718 . 69176) (PFI.LOOKUP.NAME 69178 . 69309)) (69312 70543 (PFI.ADD.TO.INDEX
|
||||
69322 . 69832) (PFI.VARNAME 69834 . 70244) (PFI.CONSTANTNAMES 70246 . 70541)) (70578 78891 (
|
||||
MULTIFILEINDEX 70588 . 71384) (MULTIFILEINDEX1 71386 . 72842) (PFI.PRINT.MULTI.INDEX 72844 . 77947) (
|
||||
PFI.CHOOSE.BEST 77949 . 78176) (PFI.MERGE.INDICES 78178 . 78889)) (78948 80566 (PFI.MAYBE.SEE.PRETTY
|
||||
78958 . 79888) (PFI.MAYBE.PP.DEFINITION 79890 . 80564)) (80636 84471 (PFI.PRINT.BITMAP 80646 . 84469))
|
||||
(87316 90430 (PUTPROPS.PRETTYPRINT 87326 . 88737) (RPAQX.PRETTYPRINT 88739 . 89464) (
|
||||
COURIERPROGRAM.PRETTYPRINT 89466 . 90166) (MAYBE.PRETTYPRINT.BOLD 90168 . 90428)))))
|
||||
(FILEMAP (NIL (10070 12305 (PFI.NEW.LISTFILES1 10080 . 10574) (PFI.ENQUEUE 10576 . 11200) (
|
||||
\PFI.DO.HARDCOPY 11202 . 11788) (MAYBE.PRETTYFILEINDEX 11790 . 12303)) (12306 35220 (PRETTYFILEINDEX
|
||||
12316 . 26748) (PFI.MAKE.LPT.STREAM 26750 . 29801) (PFI.SETUP.TRANSLATIONS 29803 . 31317) (
|
||||
PFI.OUTCHARFN 31319 . 33293) (PFI.COLLECT.DEFINERS 33295 . 34107) (PFI.AFTER.NEW.PAGE 34109 . 35218))
|
||||
(35221 41169 (PFI.PRINT.FILECREATED 35231 . 39436) (PFI.PRINT.TO.TAB 39438 . 39803) (
|
||||
PFI.PRINT.ENVIRONMENT 39805 . 41167)) (41170 48354 (PFI.PROCESS.FILE 41180 . 42410) (PFI.PASS.COMMENT
|
||||
42412 . 43382) (PFI.HANDLE.EXPR 43384 . 44051) (PFI.DEFAULT.HANDLER 44053 . 46106) (PFI.PRETTYPRINT
|
||||
46108 . 46443) (PFI.LINES.REMAINING 46445 . 46772) (PFI.MAYBE.NEW.PAGE 46774 . 47277) (
|
||||
PFI.ESTIMATE.SIZE 47279 . 47810) (PFI.ESTIMATE.SIZE1 47812 . 48352)) (48391 57878 (PFI.HANDLE.RPAQQ
|
||||
48401 . 49809) (PFI.HANDLE.DECLARE 49811 . 50750) (PFI.HANDLE.EVAL-WHEN 50752 . 51235) (
|
||||
PFI.HANDLE.DEFDEFINER 51237 . 52527) (PFI.HANDLE.DEFINEQ 52529 . 52773) (PFI.PRINT.LAMBDA 52775 .
|
||||
53113) (PFI.PRINT.LAMBDA.BODY 53115 . 53450) (PFI.HANDLE.PUTDEF 53452 . 53949) (PFI.HANDLE.PUTPROPS
|
||||
53951 . 54566) (PFI.HANDLE./DECLAREDATATYPE 54568 . 55115) (PFI.HANDLE.* 55117 . 56379) (
|
||||
PFI.PRINT.COMMENTS 56381 . 57281) (PFI.HANDLE.FILEMAP 57283 . 57571) (PFI.HANDLE.PACKAGE 57573 . 57876
|
||||
)) (57906 58898 (PFI.PREVIEW.DECLARE 57916 . 58578) (PFI.PREVIEW.DEFINEQ 58580 . 58896)) (58934 69922
|
||||
(PFI.PRINT.INDEX 58944 . 59795) (PFI.CONDENSE.INDEX 59797 . 61604) (PFI.SORT.INDICES 61606 . 62745) (
|
||||
PFI.COMPUTE.INDEX.SHAPE 62747 . 64211) (PFI.PRINT.INDICES 64213 . 68755) (PFI.CENTER.PRINT 68757 .
|
||||
69327) (PFI.INDEX.BREAK 69329 . 69787) (PFI.LOOKUP.NAME 69789 . 69920)) (69923 71154 (PFI.ADD.TO.INDEX
|
||||
69933 . 70443) (PFI.VARNAME 70445 . 70855) (PFI.CONSTANTNAMES 70857 . 71152)) (71189 79502 (
|
||||
MULTIFILEINDEX 71199 . 71995) (MULTIFILEINDEX1 71997 . 73453) (PFI.PRINT.MULTI.INDEX 73455 . 78558) (
|
||||
PFI.CHOOSE.BEST 78560 . 78787) (PFI.MERGE.INDICES 78789 . 79500)) (79559 81177 (PFI.MAYBE.SEE.PRETTY
|
||||
79569 . 80499) (PFI.MAYBE.PP.DEFINITION 80501 . 81175)) (81247 85082 (PFI.PRINT.BITMAP 81257 . 85080))
|
||||
(87927 91041 (PUTPROPS.PRETTYPRINT 87937 . 89348) (RPAQX.PRETTYPRINT 89350 . 90075) (
|
||||
COURIERPROGRAM.PRETTYPRINT 90077 . 90777) (MAYBE.PRETTYPRINT.BOLD 90779 . 91039)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user