Compare commits
11 Commits
medley-211
...
medley-211
| Author | SHA1 | Date | |
|---|---|---|---|
|
936bdd84b5 | ||
|
c2915bf5d3 | ||
|
40c10a7841 | ||
|
|
362fac9389 | ||
|
|
db082b37e1 | ||
|
|
c0e020f033 | ||
|
|
9af86df169 | ||
|
|
6c26fe958a | ||
|
|
339bd47107 | ||
|
|
3a04303d93 | ||
|
|
68f1e7efe1 |
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}}
|
||||
13
Dockerfile
13
Dockerfile
@@ -1,19 +1,24 @@
|
||||
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
|
||||
|
||||
@@ -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.
1593
library/FILEBROWSER
1593
library/FILEBROWSER
File diff suppressed because it is too large
Load Diff
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,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 3-Dec-2021 15:45:20"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;19 45997
|
||||
(FILECREATED " 8-Dec-2021 18:25:33"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;29 47473
|
||||
|
||||
changes to%: (VARS EDITINTERFACECOMS)
|
||||
(FNS FIXEDITDATE EDITDATE? EDITDATE)
|
||||
:CHANGES-TO (FNS EDITDATE? EDITDATE)
|
||||
|
||||
previous date%: " 2-Dec-2021 23:20:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;7)
|
||||
:PREVIOUS-DATE " 8-Dec-2021 16:11:23"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;27)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -110,7 +109,7 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(DEFGLOBALVAR XCL::ED-LAST-INFO NIL
|
||||
"used in ED to stash last call info so (ED NIL) will restart last edit")
|
||||
|
||||
(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz")
|
||||
(CL:DEFUN ED (CL::NAME CL::OPTIONS) (* ; "Edited 5-Jul-88 16:03 by woz")
|
||||
|
||||
(* ;;; "Standard Common Lisp editor entry. CLtL say's ED does something reasonable when passed a pathname. We coerce name into something that might be the name of something with an IL:FILES definition, & try to edit that. Then save call info in ED-LAST-INFO, so (ED) will start last edit over again.")
|
||||
|
||||
@@ -630,21 +629,21 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(FIXEDITDATE
|
||||
[LAMBDA (EXPR)
|
||||
|
||||
(* ;; "Edited 3-Dec-2021 15:35 by rmk: Updated to add dates to the initial undated comments that begins with current-editor initials, to provide a kind of dated change-log capability.")
|
||||
(* ; "Edited 3-Dec-2021 15:03 by rmk")
|
||||
(* ;; "Edited 8-Dec-2021 16:11 by rmk: Updated to add dates to the initial undated comments that begins with current-editor initials, to provide a kind of dated change-log capability.")
|
||||
(* ; "Edited 3-Dec-2021 15:03 by rmk")
|
||||
(* ; "Edited 22-Oct-2021 16:58 by rmk:")
|
||||
(* ; "Edited 27-Sep-2018 22:04 by rmk:")
|
||||
(* ; "Edited 31-Mar-2000 17:13 by rmk:")
|
||||
(* ; "Edited 17-Jul-89 11:13 by jtm:")
|
||||
(* ; "18-JUL-78 21:11")
|
||||
|
||||
(* ;; "Inserts or replaces previous edit date. This retains multiple edits (at least one day apart or by different editor) unless *REPLACE-OLD-EDIT-DATES*. Note that the new date doesn't show up within the current SEDIT session, you have to exit and re-edit to see it.")
|
||||
(* ;; "Inserts or replaces previous edit date. This retains multiple edits (at least one day apart or by different editor) unless *REPLACE-OLD-EDIT-DATES*. Note that the new date doesn't show up within the current SEDIT session, you have to exit and re-edit to see it. ")
|
||||
|
||||
(CL:WHEN (AND INITIALS (LISTP EXPR)
|
||||
(LISTP (CDR EXPR)))
|
||||
(PROG (E)
|
||||
|
||||
(* ;; "Normalize out the colon, add it back if needed.")
|
||||
(* ;; "Normalize out the colon, add it back if needed. ")
|
||||
|
||||
(COND
|
||||
((FMEMB (CAR EXPR)
|
||||
@@ -730,26 +729,36 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(IF (STRING.EQUAL INITLS (CADR PARSE))
|
||||
THEN
|
||||
|
||||
(* ;; "This is a previous date with this author. If more than a day later, add a new date. If less than a day, assume we are in essentially the same session, and update (CAR E) to the current time.")
|
||||
(* ;; "Another edit by the same author. If not dated but contains a rest, then upgrade the rest comment with a date Otherwise,If more than a day later, add a new date. If less than a day, assume we are in essentially the same session, and update (CAR E) to the current time.")
|
||||
|
||||
[IF (OR (NULL (CAR PARSE))
|
||||
(IGREATERP (IDIFFERENCE (IDATE)
|
||||
(IDATE (CAR PARSE)))
|
||||
(TIMES 24 3600)))
|
||||
[IF (NULL (CAR PARSE))
|
||||
THEN
|
||||
(* ;; "If no date, must have been %"INITIALS: xxx%" and we definitely want to upgraded to the Edited... format")
|
||||
(* ;; "If no date but %"INITIALS: xxx%", we definitely want to upgraded to the Edited... initials: xxx format")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
|
||||
(/RPLACA E (EDITDATE (CAR E)
|
||||
INITLS
|
||||
(CADDR PARSE)))
|
||||
ELSEIF (IGREATERP (IDIFFERENCE (IDATE)
|
||||
(IDATE (CAR PARSE)))
|
||||
(TIMES 24 3600))
|
||||
THEN
|
||||
(* ;;
|
||||
"If we aren't upgrading, then we don't want to propagate the previous REST.")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS)
|
||||
E)
|
||||
ELSE
|
||||
(* ;; "Same author, within a day. ")
|
||||
(* ;;
|
||||
"Same author, within a day. Just change the date, keep the REST.")
|
||||
|
||||
(/RPLACA E (EDITDATE NIL INITLS (CADDR PARSE]
|
||||
(/RPLACA E (EDITDATE (CAR E)
|
||||
INITLS
|
||||
(CADDR PARSE]
|
||||
ELSE
|
||||
(* ;;
|
||||
"Not a previous date, or not one with this author. Add a new one.")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS (CADDR PARSE))
|
||||
(* ;; "Not a previous date, or not one with this author. Add a new one. If rmk is editing and sees an lmm: rest, we don't want to attribute that rest to rmk in the new one.")
|
||||
|
||||
(/ATTACH (EDITDATE NIL INITLS)
|
||||
E))
|
||||
ELSE
|
||||
(* ;; "Need a new date, didn't even see %"<initials: xxx%"")
|
||||
@@ -759,11 +768,14 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(RETURN EXPR)))])
|
||||
|
||||
(EDITDATE?
|
||||
[LAMBDA (COMMENT RESTOK) (* ; "Edited 3-Dec-2021 14:35 by rmk")
|
||||
[LAMBDA (COMMENT RESTOK) (* ; "Edited 8-Dec-2021 18:24 by rmk")
|
||||
|
||||
(* ;; "Edited 6-Dec-2021 16:04 by rmk: Return will have date/initial, initial/rest, or date/initial/rest. Always an initial and something, or NIL.")
|
||||
(* ; "Edited 4-Dec-2021 10:39 by rmk")
|
||||
|
||||
(* ;;; "This determines whether this is a dated or initialed comment that is potentially reusable in the current context. Unless RESTOK, this only recognizes modern-format configurations of the form %"Edited <date> by <initials>%", and returns a parsed pair (DATE INITIALS).")
|
||||
|
||||
(* ;;; "If RESTOK, this also parses strings with additional stuff after the <initials> (%"Edited by <initials>: xxx%") and strings that appear to begin with initials but don't have a date (<initials>: xxx). In those cases the return is a triple (DATE INITIALS REST), where DATE may be NIL. ")
|
||||
(* ;;; "If RESTOK, this also parses strings with additional stuff after the INITLS (%"Edited by <initials>: xxx%") and strings that appear to begin with initials but don't have a date (<initials>: xxx). In those cases the return is a triple (DATE INITIALS REST), where DATE may be NIL. ")
|
||||
|
||||
(* ;;; "")
|
||||
|
||||
@@ -773,40 +785,55 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(* ;;; "There is no harm in not recognizing prehistoric formats, new dates will always be added on.")
|
||||
|
||||
(LET ((TAIL COMMENT)
|
||||
STRING POS DATE I RESTPOS)
|
||||
STRING BYPOS (IPOS 1)
|
||||
DATE I IENDPOS RESTPOS)
|
||||
(CL:WHEN [AND (EQ COMMENTFLG (CAR (LISTP TAIL)))
|
||||
(MEMB [CAR (LISTP (SETQ TAIL (CDR TAIL]
|
||||
'(; ;; ;;;))
|
||||
(STRINGP (SETQ STRING (CAR (SETQ TAIL (CDR TAIL]
|
||||
(SETQ STRING (CL:STRING-TRIM `(#\Space)
|
||||
STRING))
|
||||
(CL:UNLESS [AND [STREQUAL "Edited " (SUBSTRING STRING 1 8 (CONSTANT (CONCAT]
|
||||
(SETQ POS (STRPOS " by " STRING 9))
|
||||
[IDATE (SETQ DATE (SUBSTRING STRING 9 (SUB1 POS]
|
||||
(SETQ I (SUBSTRING STRING (IPLUS POS 4)
|
||||
(OR (SETQ RESTPOS (STRPOS " " STRING (IPLUS POS 4)))
|
||||
-1]
|
||||
(CL:WHEN [AND [STREQUAL "Edited " (SUBSTRING STRING 1 7 (CONSTANT (CONCAT]
|
||||
(SETQ BYPOS (STRPOS " by " STRING 8))
|
||||
(IDATE (SETQ DATE (CL:STRING-TRIM `(#\Space)
|
||||
(SUBSTRING STRING 8 (SUB1 BYPOS]
|
||||
|
||||
(* ;; "Could be %"<INITIALS>: abc%" to be upgraded with a date")
|
||||
(* ;; "Standard format, initials should be next. ")
|
||||
|
||||
(SETQ RESTPOS (STRPOS " " STRING))
|
||||
(SETQ I (SUBSTRING STRING 1 (SUB1 RESTPOS))))
|
||||
(CL:WHEN (AND I (ILESSP (NCHARS I)
|
||||
12)) (* ;
|
||||
(SETQ IPOS (IPLUS BYPOS 4)))
|
||||
|
||||
(* ;; "Chomp off the next substring--initials?")
|
||||
|
||||
(CL:WHEN (IGREATERP (NCHARS STRING)
|
||||
IPOS)
|
||||
[SETQ IENDPOS (SUB1 (OR (STRPOS " " STRING IPOS)
|
||||
(ADD1 (NCHARS STRING]
|
||||
(SETQ I (SUBSTRING STRING IPOS IENDPOS))
|
||||
(CL:WHEN (ILESSP (NCHARS I)
|
||||
12) (* ;
|
||||
"Sanity check: Initials should be short.")
|
||||
(CL:WHEN (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE I -1)) (* ;
|
||||
"Normalize out the colon in the return")
|
||||
(SETQ I (SUBSTRING I 1 -2)))
|
||||
(IF RESTOK
|
||||
THEN (LIST DATE I (AND RESTPOS (SUBSTRING STRING RESTPOS)))
|
||||
ELSEIF (AND DATE (NOT RESTPOS))
|
||||
THEN (LIST DATE I))))])
|
||||
(CL:WHEN (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE I -1)) (* ; "Normalize out the colon")
|
||||
(SETQ I (SUBSTRING I 1 -2)))
|
||||
(CL:WHEN (SETQ REST (SUBSTRING STRING (ADD1 IENDPOS)))
|
||||
(SETQ REST (CL:STRING-TRIM `(#\Space)
|
||||
REST)))
|
||||
(IF (IGREATERP (NCHARS REST)
|
||||
0)
|
||||
THEN
|
||||
(* ;; "Could be %"<initials>: abc%" to be upgraded with a date")
|
||||
|
||||
(CL:WHEN RESTOK (LIST DATE I REST))
|
||||
ELSEIF DATE
|
||||
THEN
|
||||
(* ;; "If we saw just initials")
|
||||
|
||||
(LIST DATE I)))))])
|
||||
|
||||
(EDITDATE
|
||||
[LAMBDA (OLDDATE INITLS REST)
|
||||
|
||||
(* ;; "Edited 3-Dec-2021 13:17 by rmk: Upgraded to make sure that the comment includes REST")
|
||||
(* ;; "Edited 8-Dec-2021 17:58 by rmk: Upgraded to make sure that the comment includes REST")
|
||||
(* ; " 20-Nov-86 23:23 by Masinter")
|
||||
|
||||
(* ;; "Generates a new date from an old one. Packs : onto INITLS if there is a REST. In the REST case we upgrade a singe semicolon to a double.")
|
||||
@@ -815,7 +842,7 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
" by " INITLS))
|
||||
NEWDATE OLDSEMI)
|
||||
(CL:WHEN REST
|
||||
(SETQ EDITSTRING (CONCAT EDITSTRING ":" REST)))
|
||||
(SETQ EDITSTRING (CONCAT EDITSTRING ": " REST)))
|
||||
(CL:WHEN OLDDATE
|
||||
(SETQ OLDSEMI (CADR OLDDATE)))
|
||||
(SETQ NEWDATE (LIST (CL:IF REST
|
||||
@@ -901,11 +928,11 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS EDITINTERFACE COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4145 10444 (ED 4145 . 10444)) (10446 14422 (INSTALL-PROTOTYPE-DEFN 10446 . 14422)) (
|
||||
14423 31206 (EDITDEF.FNS 14433 . 15769) (EDITF 15771 . 16651) (EDITFB 16653 . 17501) (EDITFNS 17503 .
|
||||
18823) (EDITLOADFNS? 18825 . 22625) (EDITMODE 22627 . 24637) (EDITP 24639 . 25150) (EDITV 25152 .
|
||||
25791) (DC 25793 . 26474) (DF 26476 . 27518) (DP 27520 . 28604) (DV 28606 . 29178) (EDITPROP 29180 .
|
||||
29399) (EF 29401 . 29730) (EP 29732 . 29915) (EV 29917 . 30096) (EDITE 30098 . 30976) (EDITL 30978 .
|
||||
31204)) (31556 45142 (NEW/EDITDATE 31566 . 31788) (FIXEDITDATE 31790 . 39177) (EDITDATE? 39179 . 41888
|
||||
) (EDITDATE 41890 . 43145) (SETINITIALS 43147 . 45140)))))
|
||||
(FILEMAP (NIL (4086 10381 (ED 4086 . 10381)) (10383 14359 (INSTALL-PROTOTYPE-DEFN 10383 . 14359)) (
|
||||
14360 31143 (EDITDEF.FNS 14370 . 15706) (EDITF 15708 . 16588) (EDITFB 16590 . 17438) (EDITFNS 17440 .
|
||||
18760) (EDITLOADFNS? 18762 . 22562) (EDITMODE 22564 . 24574) (EDITP 24576 . 25087) (EDITV 25089 .
|
||||
25728) (DC 25730 . 26411) (DF 26413 . 27455) (DP 27457 . 28541) (DV 28543 . 29115) (EDITPROP 29117 .
|
||||
29336) (EF 29338 . 29667) (EP 29669 . 29852) (EV 29854 . 30033) (EDITE 30035 . 30913) (EDITL 30915 .
|
||||
31141)) (31493 46618 (NEW/EDITDATE 31503 . 31725) (FIXEDITDATE 31727 . 39874) (EDITDATE? 39876 . 43363
|
||||
) (EDITDATE 43365 . 44621) (SETINITIALS 44623 . 46616)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,26 +1,26 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "24-Aug-2021 08:30:09" {DSK}<home>larry>medley>sources>MEDLEYDIR.;10 6764
|
||||
|
||||
changes to%: (VARS MEDLEYDIRCOMS MEDLEY-INIT-VARS)
|
||||
(FNS MEDLEYDIR)
|
||||
(FILECREATED " 2-Dec-2021 20:43:35" {DSK}<home>larry>medley>sources>MEDLEYDIR.;14 6103
|
||||
|
||||
previous date%: "24-Aug-2021 07:57:05" {DSK}<home>larry>medley>sources>MEDLEYDIR.;5)
|
||||
changes to%: (FNS MEDLEYDIR)
|
||||
|
||||
previous date%: " 2-Dec-2021 20:32:45" {DSK}<home>larry>medley>sources>MEDLEYDIR.;12)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEYDIRCOMS)
|
||||
|
||||
(RPAQQ MEDLEYDIRCOMS [
|
||||
(* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)")
|
||||
(RPAQQ MEDLEYDIRCOMS
|
||||
[
|
||||
(* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)")
|
||||
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR)
|
||||
(INITVARS (MEDLEYDIR))
|
||||
(ADDVARS (BEFORESYSOUTFORMS (SETQ MEDLEYDIR))
|
||||
(BEFOREMAKESYSFORMS (SETQ MEDLEYDIR))
|
||||
(AFTERSYSOUTFORMS (MEDLEY-INIT-VARS))
|
||||
(AFTERMAKESYSFORMS (MEDLEY-INIT-VARS)))
|
||||
(VARS MEDLEY-INIT-VARS)
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR
|
||||
MEDLEY-INIT-VARS])
|
||||
(FNS MEDLEY-INIT-VARS MEDLEYDIR)
|
||||
(INITVARS (MEDLEYDIR))
|
||||
(ADDVARS (BEFORESYSOUTFORMS (SETQ MEDLEYDIR))
|
||||
(BEFOREMAKESYSFORMS (SETQ MEDLEYDIR))
|
||||
(AFTERSYSOUTFORMS (MEDLEY-INIT-VARS))
|
||||
(AFTERMAKESYSFORMS (MEDLEY-INIT-VARS)))
|
||||
(VARS MEDLEY-INIT-VARS)
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY (ADDVARS (GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS])
|
||||
|
||||
|
||||
|
||||
@@ -31,7 +31,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(MEDLEY-INIT-VARS
|
||||
[LAMBDA (CLEAR) (* ; "Edited 21-Aug-2021 18:23 by larry")
|
||||
[LAMBDA (CLEAR) (* ;
|
||||
"Edited 21-Aug-2021 18:23 by larry")
|
||||
|
||||
(* ;; "MEDLEY-INIT-VARS has variables that might need to get reset. ")
|
||||
|
||||
@@ -61,7 +62,8 @@
|
||||
NIL])
|
||||
|
||||
(MEDLEYDIR
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 14-Dec-2020 17:12 by larry")
|
||||
[LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ;
|
||||
"Edited 2-Dec-2021 20:23 by kaplan")
|
||||
(DECLARE (GLOBALVARS MEDLEYDIR))
|
||||
(if (NULL DIRNAME)
|
||||
then (if (OR (NOT (BOUNDP 'MEDLEYDIR))
|
||||
@@ -83,10 +85,10 @@
|
||||
else (OR NOERROR (INFILEP FILENAME)
|
||||
(ERROR "No such medley file" FILENAME)))
|
||||
else (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR)
|
||||
DIRNAME))
|
||||
(IF NOERROR
|
||||
THEN NIL
|
||||
ELSE (ERROR "No such medley directory" DIRNAME])
|
||||
DIRNAME ">"))
|
||||
(if NOERROR
|
||||
then NIL
|
||||
else (ERROR "No such medley directory" DIRNAME])
|
||||
)
|
||||
|
||||
(RPAQ? MEDLEYDIR )
|
||||
@@ -99,31 +101,30 @@
|
||||
|
||||
(ADDTOVAR AFTERMAKESYSFORMS (MEDLEY-INIT-VARS))
|
||||
|
||||
(RPAQQ MEDLEY-INIT-VARS ([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers"
|
||||
"internal/library" "greetfiles"
|
||||
"docs/documentation tools"]
|
||||
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
|
||||
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
|
||||
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
|
||||
(IRM.DINFOGRAPH)
|
||||
(DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
|
||||
[LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
[USERGREETFILES `((,LOGINHOST/DIR "INIT" COM)
|
||||
(,LOGINHOST/DIR "INIT"]
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts"
|
||||
"fonts/altofonts" "fonts/big"
|
||||
"fonts/other")
|
||||
NIL NIL T))
|
||||
(POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts")
|
||||
NIL NIL T))
|
||||
(INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts")
|
||||
NIL NIL T))
|
||||
(XCL::*WHERE-IS-CASH-FILES*)))
|
||||
(RPAQQ MEDLEY-INIT-VARS
|
||||
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal/library" "greetfiles"
|
||||
"docs/documentation tools"]
|
||||
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
|
||||
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
|
||||
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
|
||||
(IRM.DINFOGRAPH)
|
||||
(DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES))
|
||||
[LOGINHOST/DIR (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR")
|
||||
(UNIX-GETENV "HOME"]
|
||||
[USERGREETFILES `((,LOGINHOST/DIR "INIT" COM)
|
||||
(,LOGINHOST/DIR "INIT"]
|
||||
(DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts" "fonts/altofonts" "fonts/big"
|
||||
"fonts/other")
|
||||
NIL NIL T))
|
||||
(POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts")
|
||||
NIL NIL T))
|
||||
(INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts")
|
||||
NIL NIL T))
|
||||
(XCL::*WHERE-IS-CASH-FILES*)))
|
||||
(DECLARE%: EVAL@COMPILE DOCOPY
|
||||
|
||||
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1665 4710 (MEDLEY-INIT-VARS 1675 . 3223) (MEDLEYDIR 3225 . 4708)))))
|
||||
(FILEMAP (NIL (1380 4562 (MEDLEY-INIT-VARS 1390 . 3004) (MEDLEYDIR 3006 . 4560)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,15 +1,17 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "SEDIT" ( USE "LISP" "XCL")))
|
||||
(IL:FILECREATED "19-Jan-93 11:17:23" IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;3| 16340
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "SEDIT" ( USE "LISP" "XCL")) READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|previous| IL:|date:| " 5-Jan-93 02:16:37"
|
||||
IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
(IL:FILECREATED " 2-Dec-2021 23:29:30"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-ACCESS.;2| 16200
|
||||
|
||||
IL:|previous| IL:|date:| "19-Jan-93 11:17:23"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-ACCESS.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1988, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1987-1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-ACCESSCOMS)
|
||||
|
||||
(IL:RPAQQ IL:SEDIT-ACCESSCOMS
|
||||
(IL:RPAQQ IL:SEDIT-ACCESSCOMS
|
||||
((IL:PROP IL:FILETYPE IL:SEDIT-ACCESS)
|
||||
(IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-ACCESS)
|
||||
(IL:LOCALVARS . T)
|
||||
@@ -21,11 +23,10 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
EDIT-SELECTION GAP LINE-BLOCK LINE-START LIST-FORMAT OPEN-STRING STRING-ITEM
|
||||
WEAK-LINK)))
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-ACCESS IL:FILETYPE :COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:SEDIT-ACCESS IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-ACCESS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE "SEDIT" (:USE "LISP"
|
||||
"XCL"))))
|
||||
(IL:PUTPROPS IL:SEDIT-ACCESS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE "SEDIT" (:USE "LISP" "XCL"))))
|
||||
(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
|
||||
(IL:LOCALVARS . T)
|
||||
@@ -48,7 +49,7 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
IL:FULLXPOINTER IL:WORD IL:FULLXPOINTER IL:FULLXPOINTER IL:POINTER IL:POINTER
|
||||
IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER
|
||||
IL:POINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:FULLXPOINTER IL:POINTER IL:POINTER
|
||||
IL:POINTER IL:POINTER IL:POINTER)
|
||||
IL:POINTER IL:POINTER IL:POINTER IL:POINTER)
|
||||
'((EDIT-CONTEXT 0 IL:POINTER)
|
||||
(EDIT-CONTEXT 2 IL:POINTER)
|
||||
(EDIT-CONTEXT 4 IL:POINTER)
|
||||
@@ -108,8 +109,9 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
(EDIT-CONTEXT 110 IL:POINTER)
|
||||
(EDIT-CONTEXT 112 IL:POINTER)
|
||||
(EDIT-CONTEXT 114 IL:POINTER)
|
||||
(EDIT-CONTEXT 116 IL:POINTER))
|
||||
'118)
|
||||
(EDIT-CONTEXT 116 IL:POINTER)
|
||||
(EDIT-CONTEXT 118 IL:POINTER))
|
||||
'120)
|
||||
|
||||
(IL:/DECLAREDATATYPE 'EDIT-ENV
|
||||
'(IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER
|
||||
@@ -295,7 +297,7 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
LAST-MOUSE-X LAST-MOUSE-Y LAST-MOUSE-TYPE \\X \\Y \\Z \\T FIRST-BLOCK
|
||||
CURRENT-BLOCK MATCHING? BELOW? VISIBLE? (REPAINT-START IL:FULLXPOINTER)
|
||||
(REPAINT-LINE IL:FULLXPOINTER)
|
||||
REPAINT-X RELINEARIZATION-TIME-STAMP SHIFT-Y SHIFT-DOWN SHIFT-RIGHT))
|
||||
REPAINT-X RELINEARIZATION-TIME-STAMP SHIFT-Y SHIFT-DOWN SHIFT-RIGHT PROPS))
|
||||
|
||||
(IL:DATATYPE EDIT-ENV
|
||||
(PARSE-INFO PARSE-INFO-UNKNOWN USER-DATA DEFAULT-FONT ITALIC-FONT KEYWORD-FONT
|
||||
@@ -305,17 +307,17 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
DEFAULT-CHAR-HANDLER HELP-MENU))
|
||||
|
||||
(IL:DATATYPE EDIT-NODE ((NODE-TYPE IL:FULLXPOINTER)
|
||||
FORMAT UNASSIGNED (SUPER-NODE IL:FULLXPOINTER)
|
||||
(DEPTH IL:WORD)
|
||||
(SUB-NODE-INDEX IL:WORD)
|
||||
STRUCTURE SUB-NODES (LINEAR-THREAD IL:FULLXPOINTER)
|
||||
LINEAR-FORM
|
||||
(START-X IL:WORD)
|
||||
(RIGHT-MARGIN IL:WORD)
|
||||
(PREFERRED-WIDTH IL:WORD)
|
||||
(ACTUAL-WIDTH IL:WORD)
|
||||
(CHANGED? IL:FLAG)
|
||||
INLINE-WIDTH ACTUAL-LLENGTH FIRST-LINE LAST-LINE))
|
||||
FORMAT UNASSIGNED (SUPER-NODE IL:FULLXPOINTER)
|
||||
(DEPTH IL:WORD)
|
||||
(SUB-NODE-INDEX IL:WORD)
|
||||
STRUCTURE SUB-NODES (LINEAR-THREAD IL:FULLXPOINTER)
|
||||
LINEAR-FORM
|
||||
(START-X IL:WORD)
|
||||
(RIGHT-MARGIN IL:WORD)
|
||||
(PREFERRED-WIDTH IL:WORD)
|
||||
(ACTUAL-WIDTH IL:WORD)
|
||||
(CHANGED? IL:FLAG)
|
||||
INLINE-WIDTH ACTUAL-LLENGTH FIRST-LINE LAST-LINE))
|
||||
|
||||
(IL:DATATYPE EDIT-NODE-TYPE
|
||||
(NAME ASSIGN-FORMAT COMPUTE-FORMAT-VALUES LINEARIZE SUB-NODE-CHANGED SET-POINT
|
||||
@@ -324,43 +326,43 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-ACCESS.;2|)
|
||||
CLOSE-NODE))
|
||||
|
||||
(IL:DATATYPE EDIT-POINT ((POINT-NODE IL:FULLXPOINTER)
|
||||
POINT-INDEX POINT-TYPE POINT-X (POINT-LINE IL:FULLXPOINTER)
|
||||
POINT-STRING POINT-OFFSET))
|
||||
POINT-INDEX POINT-TYPE POINT-X (POINT-LINE IL:FULLXPOINTER)
|
||||
POINT-STRING POINT-OFFSET))
|
||||
|
||||
(IL:DATATYPE EDIT-SELECTION ((SELECT-NODE IL:FULLXPOINTER)
|
||||
SELECT-START SELECT-END SELECT-TYPE DELETE-OK? PENDING-DELETE?
|
||||
SELECT-START-X (SELECT-START-LINE IL:FULLXPOINTER)
|
||||
SELECT-END-X
|
||||
(SELECT-END-LINE IL:FULLXPOINTER)
|
||||
SELECT-STRING SELECT-START-OFFSET SELECT-END-OFFSET))
|
||||
SELECT-START SELECT-END SELECT-TYPE DELETE-OK? PENDING-DELETE?
|
||||
SELECT-START-X (SELECT-START-LINE IL:FULLXPOINTER)
|
||||
SELECT-END-X
|
||||
(SELECT-END-LINE IL:FULLXPOINTER)
|
||||
SELECT-STRING SELECT-START-OFFSET SELECT-END-OFFSET))
|
||||
|
||||
(IL:DATATYPE GAP (LINEAR-ITEM))
|
||||
|
||||
(IL:DATATYPE LINE-BLOCK ((BLOCK-START IL:FULLXPOINTER)
|
||||
BLOCK-NEW-X BLOCK-WIDTH NEXT-BLOCK BITS? BLOCK-X BLOCK-BASE-LINE
|
||||
BLOCK-ASCENT BLOCK-DESCENT))
|
||||
BLOCK-NEW-X BLOCK-WIDTH NEXT-BLOCK BITS? BLOCK-X BLOCK-BASE-LINE
|
||||
BLOCK-ASCENT BLOCK-DESCENT))
|
||||
|
||||
(IL:DATATYPE LINE-START ((NEXT-LINE IL:FULLXPOINTER)
|
||||
(PREV-LINE IL:FULLXPOINTER)
|
||||
(NODE IL:FULLXPOINTER)
|
||||
(LINE-ASCENT IL:WORD)
|
||||
(LINE-DESCENT IL:WORD)
|
||||
(LINE-SKIP IL:WORD)
|
||||
(LINE-LENGTH IL:WORD)
|
||||
(INDENT IL:WORD)
|
||||
YCOORD
|
||||
(CACHE-TIME IL:WORD)
|
||||
CACHED-Y
|
||||
(CACHED-ASCENT IL:WORD)
|
||||
(CACHED-DESCENT IL:WORD)))
|
||||
(PREV-LINE IL:FULLXPOINTER)
|
||||
(NODE IL:FULLXPOINTER)
|
||||
(LINE-ASCENT IL:WORD)
|
||||
(LINE-DESCENT IL:WORD)
|
||||
(LINE-SKIP IL:WORD)
|
||||
(LINE-LENGTH IL:WORD)
|
||||
(INDENT IL:WORD)
|
||||
YCOORD
|
||||
(CACHE-TIME IL:WORD)
|
||||
CACHED-Y
|
||||
(CACHED-ASCENT IL:WORD)
|
||||
(CACHED-DESCENT IL:WORD)))
|
||||
|
||||
(IL:DATATYPE LIST-FORMAT (LIST-FORMATS LIST-INLINE? LIST-PFORMAT LIST-MFORMAT LIST-SUBLISTS))
|
||||
|
||||
(IL:RECORD OPEN-STRING (REAL-LENGTH SUBSTRING . BUFFER-STRING))
|
||||
|
||||
(IL:DATATYPE STRING-ITEM (STRING (WIDTH IL:WORD)
|
||||
(FONT IL:FULLXPOINTER)
|
||||
(PRIN-2? IL:FLAG)))
|
||||
(FONT IL:FULLXPOINTER)
|
||||
(PRIN-2? IL:FLAG)))
|
||||
|
||||
(IL:DATATYPE WEAK-LINK ((DESTINATION IL:FULLXPOINTER)))
|
||||
)
|
||||
|
||||
Binary file not shown.
@@ -1,19 +1,19 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)))
|
||||
(IL:FILECREATED "19-Jan-93 11:18:34" IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;3| 50314
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)) READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:RECORDS BROKEN-ATOM EDIT-CONTEXT EDIT-ENV EDIT-NODE EDIT-NODE-TYPE
|
||||
EDIT-POINT EDIT-SELECTION GAP LINE-BLOCK LINE-START LIST-FORMAT
|
||||
OPEN-STRING STRING-ITEM WEAK-LINK)
|
||||
(IL:FILECREATED " 1-Dec-2021 20:02:36"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-DECLS.;2| 48072
|
||||
|
||||
IL:|previous| IL:|date:| " 5-Jan-93 02:19:37"
|
||||
IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
IL:|changes| IL:|to:| (IL:RECORDS EDIT-CONTEXT)
|
||||
|
||||
IL:|previous| IL:|date:| "19-Jan-93 11:18:34"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-DECLS.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1987, 1988, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1987-1988, 1990, 1993 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-DECLSCOMS)
|
||||
|
||||
(IL:RPAQQ IL:SEDIT-DECLSCOMS
|
||||
(IL:RPAQQ IL:SEDIT-DECLSCOMS
|
||||
((IL:PROP IL:FILETYPE IL:SEDIT-DECLS)
|
||||
(IL:PROP IL:MAKEFILE-ENVIRONMENT IL:SEDIT-DECLS)
|
||||
|
||||
@@ -79,11 +79,11 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
(IL:P (IL:|printout| T T "EXPORTS.ALL must be loaded to compile SEdit" T)
|
||||
(IL:|printout| T T "SEDIT-ACCESS must be REMADE NEW if you change a record" T))))
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-DECLS IL:FILETYPE :COMPILE-FILE)
|
||||
(IL:PUTPROPS IL:SEDIT-DECLS IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-DECLS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT (:USE IL:LISP
|
||||
IL:XCL))))
|
||||
(IL:PUTPROPS IL:SEDIT-DECLS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT (:USE IL:LISP IL:XCL)
|
||||
)))
|
||||
|
||||
|
||||
|
||||
@@ -113,7 +113,7 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
LAST-MOUSE-X LAST-MOUSE-Y LAST-MOUSE-TYPE \\X \\Y \\Z \\T FIRST-BLOCK
|
||||
CURRENT-BLOCK MATCHING? BELOW? VISIBLE? (REPAINT-START IL:FULLXPOINTER)
|
||||
(REPAINT-LINE IL:FULLXPOINTER)
|
||||
REPAINT-X RELINEARIZATION-TIME-STAMP SHIFT-Y SHIFT-DOWN SHIFT-RIGHT)
|
||||
REPAINT-X RELINEARIZATION-TIME-STAMP SHIFT-Y SHIFT-DOWN SHIFT-RIGHT PROPS)
|
||||
CHANGED-NODES IL:_ (CONS))
|
||||
|
||||
(IL:DATATYPE EDIT-ENV
|
||||
@@ -124,22 +124,20 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
DEFAULT-CHAR-HANDLER HELP-MENU))
|
||||
|
||||
(IL:DATATYPE EDIT-NODE ((NODE-TYPE IL:FULLXPOINTER)
|
||||
FORMAT UNASSIGNED (SUPER-NODE IL:FULLXPOINTER)
|
||||
(DEPTH IL:WORD)
|
||||
(SUB-NODE-INDEX IL:WORD)
|
||||
STRUCTURE SUB-NODES (LINEAR-THREAD IL:FULLXPOINTER)
|
||||
LINEAR-FORM
|
||||
(START-X IL:WORD)
|
||||
(RIGHT-MARGIN IL:WORD)
|
||||
(PREFERRED-WIDTH IL:WORD)
|
||||
(ACTUAL-WIDTH IL:WORD)
|
||||
(CHANGED? IL:FLAG)
|
||||
INLINE-WIDTH ACTUAL-LLENGTH FIRST-LINE LAST-LINE)
|
||||
(IL:ACCESSFNS (INLINE? (EQ (IL:|fetch| FIRST-LINE IL:|of| IL:DATUM
|
||||
)
|
||||
(IL:|fetch| LAST-LINE IL:|of| IL:DATUM)
|
||||
)))
|
||||
FORMAT IL:_ 'NOT-YET-ASSIGNED)
|
||||
FORMAT UNASSIGNED (SUPER-NODE IL:FULLXPOINTER)
|
||||
(DEPTH IL:WORD)
|
||||
(SUB-NODE-INDEX IL:WORD)
|
||||
STRUCTURE SUB-NODES (LINEAR-THREAD IL:FULLXPOINTER)
|
||||
LINEAR-FORM
|
||||
(START-X IL:WORD)
|
||||
(RIGHT-MARGIN IL:WORD)
|
||||
(PREFERRED-WIDTH IL:WORD)
|
||||
(ACTUAL-WIDTH IL:WORD)
|
||||
(CHANGED? IL:FLAG)
|
||||
INLINE-WIDTH ACTUAL-LLENGTH FIRST-LINE LAST-LINE)
|
||||
(IL:ACCESSFNS (INLINE? (EQ (IL:|fetch| FIRST-LINE IL:|of| IL:DATUM)
|
||||
(IL:|fetch| LAST-LINE IL:|of| IL:DATUM))))
|
||||
FORMAT IL:_ 'NOT-YET-ASSIGNED)
|
||||
|
||||
(IL:DATATYPE EDIT-NODE-TYPE
|
||||
(NAME ASSIGN-FORMAT COMPUTE-FORMAT-VALUES LINEARIZE SUB-NODE-CHANGED SET-POINT
|
||||
@@ -148,89 +146,80 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
CLOSE-NODE))
|
||||
|
||||
(IL:DATATYPE EDIT-POINT ((POINT-NODE IL:FULLXPOINTER)
|
||||
POINT-INDEX POINT-TYPE POINT-X (POINT-LINE IL:FULLXPOINTER)
|
||||
POINT-STRING POINT-OFFSET))
|
||||
POINT-INDEX POINT-TYPE POINT-X (POINT-LINE IL:FULLXPOINTER)
|
||||
POINT-STRING POINT-OFFSET))
|
||||
|
||||
(IL:DATATYPE EDIT-SELECTION ((SELECT-NODE IL:FULLXPOINTER)
|
||||
SELECT-START SELECT-END SELECT-TYPE DELETE-OK? PENDING-DELETE?
|
||||
SELECT-START-X (SELECT-START-LINE IL:FULLXPOINTER)
|
||||
SELECT-END-X
|
||||
(SELECT-END-LINE IL:FULLXPOINTER)
|
||||
SELECT-STRING SELECT-START-OFFSET SELECT-END-OFFSET))
|
||||
SELECT-START SELECT-END SELECT-TYPE DELETE-OK? PENDING-DELETE?
|
||||
SELECT-START-X (SELECT-START-LINE IL:FULLXPOINTER)
|
||||
SELECT-END-X
|
||||
(SELECT-END-LINE IL:FULLXPOINTER)
|
||||
SELECT-STRING SELECT-START-OFFSET SELECT-END-OFFSET))
|
||||
|
||||
(IL:DATATYPE GAP (LINEAR-ITEM))
|
||||
|
||||
(IL:DATATYPE LINE-BLOCK ((BLOCK-START IL:FULLXPOINTER)
|
||||
BLOCK-NEW-X BLOCK-WIDTH NEXT-BLOCK BITS? BLOCK-X BLOCK-BASE-LINE
|
||||
BLOCK-ASCENT BLOCK-DESCENT))
|
||||
BLOCK-NEW-X BLOCK-WIDTH NEXT-BLOCK BITS? BLOCK-X BLOCK-BASE-LINE
|
||||
BLOCK-ASCENT BLOCK-DESCENT))
|
||||
|
||||
(IL:DATATYPE LINE-START ((NEXT-LINE IL:FULLXPOINTER)
|
||||
(PREV-LINE IL:FULLXPOINTER)
|
||||
(NODE IL:FULLXPOINTER)
|
||||
(LINE-ASCENT IL:WORD)
|
||||
(LINE-DESCENT IL:WORD)
|
||||
(LINE-SKIP IL:WORD)
|
||||
(LINE-LENGTH IL:WORD)
|
||||
(INDENT IL:WORD)
|
||||
YCOORD
|
||||
(CACHE-TIME IL:WORD)
|
||||
CACHED-Y
|
||||
(CACHED-ASCENT IL:WORD)
|
||||
(CACHED-DESCENT IL:WORD))
|
||||
(IL:ACCESSFNS (LINE-HEIGHT (IL:IPLUS (IL:FETCH LINE-SKIP IL:OF
|
||||
IL:DATUM)
|
||||
(IL:FETCH LINE-ASCENT IL:OF
|
||||
IL:DATUM)
|
||||
(IL:FETCH LINE-DESCENT IL:OF
|
||||
IL:DATUM))))
|
||||
(IL:ACCESSFNS (BASE-LINE-Y (IL:IDIFFERENCE (IL:ADD1 (IL:FETCH YCOORD
|
||||
IL:OF IL:DATUM
|
||||
))
|
||||
(IL:IPLUS (IL:FETCH LINE-SKIP
|
||||
IL:OF IL:DATUM)
|
||||
(IL:FETCH LINE-ASCENT
|
||||
IL:OF IL:DATUM)))))
|
||||
(IL:ACCESSFNS (NEXT-LINE-Y (IL:IDIFFERENCE (IL:FETCH YCOORD
|
||||
IL:OF IL:DATUM)
|
||||
(IL:FETCH LINE-HEIGHT IL:OF
|
||||
IL:DATUM))))
|
||||
(IL:ACCESSFNS (OLD-TOP (IF (EQ (IL:FETCH CACHE-TIME IL:OF
|
||||
IL:DATUM)
|
||||
(IL:|fetch| RELINEARIZATION-TIME-STAMP
|
||||
IL:|of| CONTEXT))
|
||||
(IL:SUB1 (IL:IPLUS (IL:FETCH CACHED-Y
|
||||
IL:OF IL:DATUM)
|
||||
(IL:FETCH CACHED-ASCENT
|
||||
IL:OF IL:DATUM)))
|
||||
(IL:FETCH YCOORD IL:OF IL:DATUM))))
|
||||
(IL:ACCESSFNS (OLD-BOTTOM (IF (EQ (IL:FETCH CACHE-TIME IL:OF
|
||||
IL:DATUM)
|
||||
(IL:|fetch|
|
||||
RELINEARIZATION-TIME-STAMP
|
||||
IL:|of| CONTEXT))
|
||||
(IL:IDIFFERENCE (IL:FETCH CACHED-Y
|
||||
IL:OF IL:DATUM)
|
||||
(IL:FETCH CACHED-DESCENT
|
||||
IL:OF IL:DATUM))
|
||||
(IL:ADD1 (IL:FETCH NEXT-LINE-Y
|
||||
IL:OF IL:DATUM))))))
|
||||
(PREV-LINE IL:FULLXPOINTER)
|
||||
(NODE IL:FULLXPOINTER)
|
||||
(LINE-ASCENT IL:WORD)
|
||||
(LINE-DESCENT IL:WORD)
|
||||
(LINE-SKIP IL:WORD)
|
||||
(LINE-LENGTH IL:WORD)
|
||||
(INDENT IL:WORD)
|
||||
YCOORD
|
||||
(CACHE-TIME IL:WORD)
|
||||
CACHED-Y
|
||||
(CACHED-ASCENT IL:WORD)
|
||||
(CACHED-DESCENT IL:WORD))
|
||||
(IL:ACCESSFNS (LINE-HEIGHT (IL:IPLUS (IL:FETCH LINE-SKIP IL:OF IL:DATUM)
|
||||
(IL:FETCH LINE-ASCENT IL:OF IL:DATUM)
|
||||
(IL:FETCH LINE-DESCENT IL:OF IL:DATUM))))
|
||||
(IL:ACCESSFNS (BASE-LINE-Y (IL:IDIFFERENCE (IL:ADD1 (IL:FETCH YCOORD
|
||||
IL:OF IL:DATUM))
|
||||
(IL:IPLUS (IL:FETCH LINE-SKIP IL:OF
|
||||
IL:DATUM
|
||||
)
|
||||
(IL:FETCH LINE-ASCENT IL:OF IL:DATUM
|
||||
)))))
|
||||
(IL:ACCESSFNS (NEXT-LINE-Y (IL:IDIFFERENCE (IL:FETCH YCOORD IL:OF IL:DATUM)
|
||||
(IL:FETCH LINE-HEIGHT IL:OF IL:DATUM))))
|
||||
(IL:ACCESSFNS (OLD-TOP (IF (EQ (IL:FETCH CACHE-TIME IL:OF IL:DATUM)
|
||||
(IL:|fetch| RELINEARIZATION-TIME-STAMP
|
||||
IL:|of| CONTEXT))
|
||||
(IL:SUB1 (IL:IPLUS (IL:FETCH CACHED-Y IL:OF
|
||||
IL:DATUM
|
||||
)
|
||||
(IL:FETCH CACHED-ASCENT
|
||||
IL:OF IL:DATUM)))
|
||||
(IL:FETCH YCOORD IL:OF IL:DATUM))))
|
||||
(IL:ACCESSFNS (OLD-BOTTOM (IF (EQ (IL:FETCH CACHE-TIME IL:OF IL:DATUM)
|
||||
(IL:|fetch| RELINEARIZATION-TIME-STAMP
|
||||
IL:|of| CONTEXT))
|
||||
(IL:IDIFFERENCE (IL:FETCH CACHED-Y IL:OF
|
||||
IL:DATUM
|
||||
)
|
||||
(IL:FETCH CACHED-DESCENT IL:OF IL:DATUM)
|
||||
)
|
||||
(IL:ADD1 (IL:FETCH NEXT-LINE-Y IL:OF IL:DATUM)))
|
||||
)))
|
||||
|
||||
(IL:DATATYPE LIST-FORMAT (LIST-FORMATS LIST-INLINE? LIST-PFORMAT LIST-MFORMAT LIST-SUBLISTS)
|
||||
(IL:ACCESSFNS (NON-STANDARD? (NULL (IL:|fetch| LIST-FORMATS
|
||||
IL:|of| IL:DATUM))))
|
||||
(IL:ACCESSFNS (SET-FORMAT-LIST (IL:|fetch| LIST-INLINE? IL:|of|
|
||||
IL:DATUM)))
|
||||
(IL:ACCESSFNS (CFVLIST (IL:|fetch| LIST-PFORMAT IL:|of| IL:DATUM
|
||||
)))
|
||||
(IL:ACCESSFNS (LINEARIZE-LIST (IL:|fetch| LIST-MFORMAT IL:|of|
|
||||
IL:DATUM)))
|
||||
LIST-SUBLISTS IL:_ NIL)
|
||||
(IL:ACCESSFNS (NON-STANDARD? (NULL (IL:|fetch| LIST-FORMATS IL:|of| IL:DATUM
|
||||
))))
|
||||
(IL:ACCESSFNS (SET-FORMAT-LIST (IL:|fetch| LIST-INLINE? IL:|of| IL:DATUM)))
|
||||
(IL:ACCESSFNS (CFVLIST (IL:|fetch| LIST-PFORMAT IL:|of| IL:DATUM)))
|
||||
(IL:ACCESSFNS (LINEARIZE-LIST (IL:|fetch| LIST-MFORMAT IL:|of| IL:DATUM)))
|
||||
LIST-SUBLISTS IL:_ NIL)
|
||||
|
||||
(IL:RECORD OPEN-STRING (REAL-LENGTH SUBSTRING . BUFFER-STRING))
|
||||
|
||||
(IL:DATATYPE STRING-ITEM (STRING (WIDTH IL:WORD)
|
||||
(FONT IL:FULLXPOINTER)
|
||||
(PRIN-2? IL:FLAG)))
|
||||
(FONT IL:FULLXPOINTER)
|
||||
(PRIN-2? IL:FLAG)))
|
||||
|
||||
(IL:DATATYPE WEAK-LINK ((DESTINATION IL:FULLXPOINTER)))
|
||||
)
|
||||
@@ -248,7 +237,7 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
IL:FULLXPOINTER IL:WORD IL:FULLXPOINTER IL:FULLXPOINTER IL:POINTER IL:POINTER
|
||||
IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER
|
||||
IL:POINTER IL:POINTER IL:POINTER IL:FULLXPOINTER IL:FULLXPOINTER IL:POINTER IL:POINTER
|
||||
IL:POINTER IL:POINTER IL:POINTER)
|
||||
IL:POINTER IL:POINTER IL:POINTER IL:POINTER)
|
||||
'((EDIT-CONTEXT 0 IL:POINTER)
|
||||
(EDIT-CONTEXT 2 IL:POINTER)
|
||||
(EDIT-CONTEXT 4 IL:POINTER)
|
||||
@@ -308,8 +297,9 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
(EDIT-CONTEXT 110 IL:POINTER)
|
||||
(EDIT-CONTEXT 112 IL:POINTER)
|
||||
(EDIT-CONTEXT 114 IL:POINTER)
|
||||
(EDIT-CONTEXT 116 IL:POINTER))
|
||||
'118)
|
||||
(EDIT-CONTEXT 116 IL:POINTER)
|
||||
(EDIT-CONTEXT 118 IL:POINTER))
|
||||
'120)
|
||||
|
||||
(IL:/DECLAREDATATYPE 'EDIT-ENV
|
||||
'(IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER IL:POINTER
|
||||
@@ -529,8 +519,8 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
|
||||
(IL:RPAQQ IL:MICASPERPT 35.27778)
|
||||
|
||||
(IL:RPAQQ QUOTE-WRAPPER-LIST (QUOTE QUOTE IL:BQUOTE IL:BQUOTE IL:COMMA IL:\\\, COMMA-AT IL:\\\,@
|
||||
COMMA-DOT IL:\\\,. FUNCTION FUNCTION))
|
||||
(IL:RPAQQ QUOTE-WRAPPER-LIST (QUOTE QUOTE IL:BQUOTE IL:BQUOTE IL:COMMA IL:\\\, COMMA-AT IL:\\\,@
|
||||
COMMA-DOT IL:\\\,. FUNCTION FUNCTION))
|
||||
|
||||
|
||||
(IL:CONSTANTS (EDITOR-NAME "SEdit")
|
||||
@@ -545,11 +535,11 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
|
||||
(IL:DECLARE\: IL:EVAL@COMPILE
|
||||
|
||||
(IL:PUTPROPS GET-PROMPT-WINDOW IL:MACRO ((CONTEXT)
|
||||
(IL:GETPROMPTWINDOW (IL:|fetch| DISPLAY-WINDOW
|
||||
IL:|of| CONTEXT))))
|
||||
(IL:PUTPROPS GET-PROMPT-WINDOW IL:MACRO ((CONTEXT)
|
||||
(IL:GETPROMPTWINDOW (IL:|fetch| DISPLAY-WINDOW IL:|of|
|
||||
CONTEXT))))
|
||||
|
||||
(IL:PUTPROPS EVAL-IN-PROCESS IL:MACRO (NIL (LET* ((PROCESS (IF (EQ (IL:PROCESSPROP (IL:THIS.PROCESS)
|
||||
(IL:PUTPROPS EVAL-IN-PROCESS IL:MACRO (NIL (LET* ((PROCESS (IF (EQ (IL:PROCESSPROP (IL:THIS.PROCESS)
|
||||
'IL:NAME)
|
||||
'IL:MOUSE)
|
||||
(IL:TTY.PROCESS)
|
||||
@@ -562,10 +552,10 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
IL:|of| (CADADR PROCFORM)))
|
||||
(T PROCESS)))))
|
||||
|
||||
(IL:PUTPROPS LOOKUP-COMMAND IL:MACRO ((CHAR TABLE)
|
||||
(IL:PUTPROPS LOOKUP-COMMAND IL:MACRO ((CHAR TABLE)
|
||||
(GETHASH CHAR TABLE)))
|
||||
|
||||
(IL:PUTPROPS QUOTE-WRAPPER IL:MACRO (TYPE (COND
|
||||
(IL:PUTPROPS QUOTE-WRAPPER IL:MACRO (TYPE (COND
|
||||
((AND (IL:LISTP (CAR TYPE))
|
||||
(EQ (CAAR TYPE)
|
||||
'QUOTE))
|
||||
@@ -573,38 +563,33 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
(IL:KWOTE (IL:|for| W IL:|in| (CADAR TYPE)
|
||||
IL:|collect| (IL:LISTGET
|
||||
QUOTE-WRAPPER-LIST
|
||||
W)))
|
||||
W)))
|
||||
(IL:KWOTE (IL:LISTGET QUOTE-WRAPPER-LIST
|
||||
(CADAR TYPE)))))
|
||||
(T `(IL:LISTGET QUOTE-WRAPPER-LIST ,(CAR TYPE))))))
|
||||
|
||||
(IL:PUTPROPS QUOTE-WRAPPER-NAME IL:MACRO ((TYPE)
|
||||
(IL:PUTPROPS QUOTE-WRAPPER-NAME IL:MACRO ((TYPE)
|
||||
(IL:LISTGET (IL:CONSTANT (IL:REVERSE QUOTE-WRAPPER-LIST))
|
||||
TYPE)))
|
||||
|
||||
(IL:PUTPROPS REPAINT-NEW-LINE IL:MACRO (IL:OPENLAMBDA (LINE)
|
||||
(WHEN (IL:ILESSP (IL:|fetch| NEXT-LINE-Y
|
||||
IL:|of| (CAR LINE))
|
||||
(IL:|fetch| WINDOW-TOP IL:|of|
|
||||
CONTEXT))
|
||||
(REPAINT CONTEXT (IL:|fetch| INDENT
|
||||
IL:|of| (CAR LINE))
|
||||
(IL:|fetch| BASE-LINE-Y
|
||||
IL:|of| (CAR LINE))
|
||||
(CDR LINE)
|
||||
(IL:|fetch| LINEAR-POINTER IL:|of|
|
||||
CONTEXT))
|
||||
(WHEN (IL:ILESSP (IL:|fetch| NEXT-LINE-Y
|
||||
IL:|of| (CAR LINE))
|
||||
(IL:|fetch| WINDOW-BOTTOM
|
||||
IL:|of| CONTEXT))
|
||||
(IL:|replace| BELOW? IL:|of| CONTEXT
|
||||
IL:|with| T)))))
|
||||
(IL:PUTPROPS REPAINT-NEW-LINE IL:MACRO (IL:OPENLAMBDA (LINE)
|
||||
(WHEN (IL:ILESSP (IL:|fetch| NEXT-LINE-Y IL:|of|
|
||||
(CAR LINE))
|
||||
(IL:|fetch| WINDOW-TOP IL:|of| CONTEXT))
|
||||
(REPAINT CONTEXT (IL:|fetch| INDENT IL:|of| (CAR LINE))
|
||||
(IL:|fetch| BASE-LINE-Y IL:|of| (CAR LINE))
|
||||
(CDR LINE)
|
||||
(IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT))
|
||||
(WHEN (IL:ILESSP (IL:|fetch| NEXT-LINE-Y
|
||||
IL:|of| (CAR LINE))
|
||||
(IL:|fetch| WINDOW-BOTTOM IL:|of| CONTEXT))
|
||||
(IL:|replace| BELOW? IL:|of| CONTEXT IL:|with|
|
||||
T)))))
|
||||
|
||||
(IL:PUTPROPS RESET-CONTROL-VARIABLES IL:MACRO ((CONTEXT)
|
||||
(IL:PUTPROPS RESET-CONTROL-VARIABLES IL:MACRO ((CONTEXT)
|
||||
(WHEN (COMPILING-POST-KOTO)
|
||||
(IL:SETQ *PACKAGE* (IL:FETCH PACKAGE
|
||||
IL:OF CONTEXT))
|
||||
(IL:SETQ *PACKAGE* (IL:FETCH PACKAGE IL:OF CONTEXT
|
||||
))
|
||||
(IL:SETQ *PRINT-ARRAY* NIL)
|
||||
(IL:SETQ *PRINT-BASE* (IL:FETCH PRINT-BASE
|
||||
IL:OF CONTEXT))
|
||||
@@ -614,7 +599,7 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
(IL:SETQ *PRINT-GENSYM* T)
|
||||
(IL:SETQ *PRINT-RADIX* NIL))))
|
||||
|
||||
(IL:PUTPROPS SELECT-COMMENT-INDENT IL:MACRO ((KEY LEVEL-1-INDENT LEVEL-2-INDENT LEVEL-3-INDENT)
|
||||
(IL:PUTPROPS SELECT-COMMENT-INDENT IL:MACRO ((KEY LEVEL-1-INDENT LEVEL-2-INDENT LEVEL-3-INDENT)
|
||||
(IL:SELECTQ KEY
|
||||
(1 LEVEL-1-INDENT)
|
||||
(2 LEVEL-2-INDENT)
|
||||
@@ -622,34 +607,31 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
LEVEL-3-INDENT)
|
||||
(IL:SHOULDNT "unexpected comment level"))))
|
||||
|
||||
(IL:PUTPROPS SET-COMMENT-POSITIONS IL:MACRO ((COMMENT-START-X COMMENT-INDENT FORM-INDENT PAREN-WIDTH
|
||||
(IL:PUTPROPS SET-COMMENT-POSITIONS IL:MACRO ((COMMENT-START-X COMMENT-INDENT FORM-INDENT PAREN-WIDTH
|
||||
NODE CONTEXT)
|
||||
(COND
|
||||
((IL:IGEQ (IL:IPLUS FORM-INDENT (IL:|fetch|
|
||||
COMMENT-WIDTH
|
||||
IL:|of|
|
||||
CONTEXT))
|
||||
(IL:|fetch| RIGHT-MARGIN IL:|of|
|
||||
NODE))
|
||||
((IL:IGEQ (IL:IPLUS FORM-INDENT (IL:|fetch|
|
||||
COMMENT-WIDTH
|
||||
IL:|of| CONTEXT))
|
||||
(IL:|fetch| RIGHT-MARGIN IL:|of| NODE))
|
||||
(IL:SETQ COMMENT-START-X
|
||||
(IL:IPLUS (IL:|fetch| START-X IL:|of|
|
||||
NODE)
|
||||
(IL:IPLUS (IL:|fetch| START-X IL:|of| NODE)
|
||||
PAREN-WIDTH))
|
||||
(IL:SETQ COMMENT-INDENT COMMENT-START-X))
|
||||
(T (IL:SETQ COMMENT-START-X
|
||||
(IL:IDIFFERENCE (IL:|fetch| RIGHT-MARGIN
|
||||
IL:|of| NODE)
|
||||
(IL:|fetch| COMMENT-WIDTH IL:|of|
|
||||
CONTEXT)))
|
||||
(IL:|fetch| COMMENT-WIDTH IL:|of| CONTEXT)
|
||||
))
|
||||
(IL:SETQ COMMENT-INDENT
|
||||
(IL:IPLUS COMMENT-START-X (IL:|fetch|
|
||||
COMMENT-SEPARATION
|
||||
IL:|of| CONTEXT)
|
||||
))))))
|
||||
IL:|of| CONTEXT)))))
|
||||
))
|
||||
|
||||
(IL:PUTPROPS SET-SELECTION-NOWHERE IL:MACRO ((SELECTION)
|
||||
(IL:|replace| SELECT-NODE IL:|of| SELECTION
|
||||
IL:|with| NIL)))
|
||||
(IL:PUTPROPS SET-SELECTION-NOWHERE IL:MACRO ((SELECTION)
|
||||
(IL:|replace| SELECT-NODE IL:|of| SELECTION IL:|with|
|
||||
NIL)))
|
||||
)
|
||||
|
||||
|
||||
@@ -662,108 +644,99 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
DESTINATION IL:_ ,DEST))
|
||||
(IL:DECLARE\: IL:EVAL@COMPILE
|
||||
|
||||
(IL:PUTPROPS ADVANCE IL:MACRO ((WIDTH)
|
||||
(IL:PUTPROPS ADVANCE IL:MACRO ((WIDTH)
|
||||
(IL:|add| (IL:|fetch| CURRENT-X IL:|of| CONTEXT)
|
||||
WIDTH)))
|
||||
|
||||
(IL:PUTPROPS CLOSE-OPEN-NODE IL:MACRO ((CONTEXT)
|
||||
(IL:PUTPROPS CLOSE-OPEN-NODE IL:MACRO ((CONTEXT)
|
||||
(WHEN (IL:|fetch| OPEN-NODE-CHANGED? IL:|of| CONTEXT)
|
||||
(CLOSE-NODE CONTEXT))))
|
||||
|
||||
(IL:PUTPROPS DEAD-NODE? IL:MACRO ((NODE)
|
||||
(IL:PUTPROPS DEAD-NODE? IL:MACRO ((NODE)
|
||||
(EQ 0 (IL:|fetch| DEPTH IL:|of| NODE))))
|
||||
|
||||
(IL:PUTPROPS END-UNDO-BLOCK IL:MACRO (NIL (COLLECT-UNDO-BLOCK CONTEXT)))
|
||||
(IL:PUTPROPS END-UNDO-BLOCK IL:MACRO (NIL (COLLECT-UNDO-BLOCK CONTEXT)))
|
||||
|
||||
(IL:PUTPROPS ESCAPE-CHAR IL:MACRO ((READ-TABLE)
|
||||
(IL:|fetch| (READTABLEP IL:ESCAPECHAR) IL:|of|
|
||||
(OR READ-TABLE
|
||||
*READTABLE*))))
|
||||
(IL:PUTPROPS ESCAPE-CHAR IL:MACRO ((READ-TABLE)
|
||||
(IL:|fetch| (READTABLEP IL:ESCAPECHAR) IL:|of| (OR READ-TABLE
|
||||
*READTABLE*))))
|
||||
|
||||
(IL:PUTPROPS EQ-POINT-TYPE IL:MACRO ((POINT TYPE)
|
||||
(IL:PUTPROPS EQ-POINT-TYPE IL:MACRO ((POINT TYPE)
|
||||
(LET ((POINTNODE (IL:|fetch| POINT-NODE IL:|of| POINT)))
|
||||
(IF (IL:|type?| EDIT-SELECTION POINTNODE)
|
||||
(EQ (IL:|fetch| NODE-TYPE
|
||||
IL:|of| (IL:|fetch| SELECT-NODE
|
||||
IL:|of| POINTNODE))
|
||||
(EQ (IL:|fetch| NODE-TYPE IL:|of| (IL:|fetch|
|
||||
SELECT-NODE
|
||||
IL:|of| POINTNODE)
|
||||
)
|
||||
TYPE)
|
||||
(EQ (IL:|fetch| NODE-TYPE IL:|of| POINTNODE)
|
||||
TYPE)))))
|
||||
|
||||
(IL:PUTPROPS NEXT-LINEAR IL:MACRO ((CONTEXT ITEM)
|
||||
(AND (IL:LISTP (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT)
|
||||
)
|
||||
(IL:PUTPROPS NEXT-LINEAR IL:MACRO ((CONTEXT ITEM)
|
||||
(AND (IL:LISTP (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT))
|
||||
(EQ (CAR (IL:|fetch| LINEAR-POINTER IL:|of| CONTEXT))
|
||||
ITEM))))
|
||||
|
||||
(IL:PUTPROPS SET-LINEAR IL:MACRO (IL:OPENLAMBDA (CONTEXT NEW-LPTR)
|
||||
(IL:|replace| LINEAR-POINTER IL:|of| CONTEXT
|
||||
IL:|with| NEW-LPTR)
|
||||
(IF (IL:LISTP (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT
|
||||
))
|
||||
(RPLACD (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT)
|
||||
NEW-LPTR)
|
||||
(IL:|replace| LINEAR-FORM
|
||||
IL:|of| (IL:|fetch| LINEAR-PREV IL:|of|
|
||||
CONTEXT)
|
||||
IL:|with| NEW-LPTR))))
|
||||
(IL:PUTPROPS SET-LINEAR IL:MACRO (IL:OPENLAMBDA (CONTEXT NEW-LPTR)
|
||||
(IL:|replace| LINEAR-POINTER IL:|of| CONTEXT IL:|with| NEW-LPTR)
|
||||
(IF (IL:LISTP (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT))
|
||||
(RPLACD (IL:|fetch| LINEAR-PREV IL:|of| CONTEXT)
|
||||
NEW-LPTR)
|
||||
(IL:|replace| LINEAR-FORM IL:|of| (IL:|fetch| LINEAR-PREV
|
||||
IL:|of| CONTEXT)
|
||||
IL:|with| NEW-LPTR))))
|
||||
|
||||
(IL:PUTPROPS START-UNDO-BLOCK IL:MACRO (NIL (IL:|push| (IL:|fetch| UNDO-LIST IL:|of|
|
||||
CONTEXT)
|
||||
(IL:PUTPROPS START-UNDO-BLOCK IL:MACRO (NIL (IL:|push| (IL:|fetch| UNDO-LIST IL:|of| CONTEXT)
|
||||
NIL)))
|
||||
|
||||
(IL:PUTPROPS STEP-LINEAR IL:MACRO ((CONTEXT)
|
||||
(IL:PUTPROPS STEP-LINEAR IL:MACRO ((CONTEXT)
|
||||
(IL:|replace| LINEAR-POINTER IL:|of| CONTEXT
|
||||
IL:|with| (CDR (IL:|replace| LINEAR-PREV IL:|of|
|
||||
CONTEXT
|
||||
IL:|with| (IL:|fetch|
|
||||
LINEAR-POINTER
|
||||
IL:|of| CONTEXT)))))
|
||||
)
|
||||
IL:|with| (CDR (IL:|replace| LINEAR-PREV IL:|of| CONTEXT
|
||||
IL:|with| (IL:|fetch| LINEAR-POINTER
|
||||
IL:|of| CONTEXT))))))
|
||||
|
||||
(IL:PUTPROPS SUBNODE IL:MACRO (X (IF (EQ (CAR X)
|
||||
(IL:PUTPROPS SUBNODE IL:MACRO (X (IF (EQ (CAR X)
|
||||
1)
|
||||
(LIST 'CADR (LIST 'IL:FETCH 'SUB-NODES (CADR X)))
|
||||
(LIST 'CADR (LIST 'IL:NTH (LIST 'IL:FETCH 'SUB-NODES
|
||||
(CADR X))
|
||||
(CAR X))))))
|
||||
|
||||
(IL:PUTPROPS UNDO-BY IL:MACRO (INFO (LIST 'IL:PUSH '(IL:|fetch| UNDO-LIST IL:|of| CONTEXT)
|
||||
(IL:PUTPROPS UNDO-BY IL:MACRO (INFO (LIST 'IL:PUSH '(IL:|fetch| UNDO-LIST IL:|of| CONTEXT)
|
||||
(LIST* 'LIST (IL:KWOTE (CAR INFO))
|
||||
(CDR INFO)))))
|
||||
|
||||
(IL:PUTPROPS ZAP-CLISP-TRANSLATION IL:MACRO ((X)
|
||||
(IL:PUTPROPS ZAP-CLISP-TRANSLATION IL:MACRO ((X)
|
||||
(AND IL:CLISPARRAY (IL:PUTHASH X NIL IL:CLISPARRAY))))
|
||||
|
||||
(IL:PUTPROPS SMASH-USING IL:MACRO (X (IL:|bind| (SRC IL:_ (IF (IL:ATOM (CADDR X))
|
||||
(CADDR X)
|
||||
'$$SOURCE))
|
||||
(IL:PUTPROPS SMASH-USING IL:MACRO (X (IL:|bind| (SRC IL:_ (IF (IL:ATOM (CADDR X))
|
||||
(CADDR X)
|
||||
'$$SOURCE))
|
||||
DEST
|
||||
(DESCR IL:_ (IL:GETDESCRIPTORS (CAR X)))
|
||||
IL:|first| (IL:SETQ DEST
|
||||
(LIST 'IL:REPLACEFIELDVAL (LIST 'QUOTE
|
||||
(CAR DESCR))
|
||||
(CADR X)
|
||||
(LIST 'IL:FETCHFIELD
|
||||
(LIST 'QUOTE (CAR DESCR))
|
||||
SRC)))
|
||||
IL:|first| (IL:SETQ DEST (LIST 'IL:REPLACEFIELDVAL
|
||||
(LIST 'QUOTE (CAR DESCR))
|
||||
(CADR X)
|
||||
(LIST 'IL:FETCHFIELD
|
||||
(LIST 'QUOTE
|
||||
(CAR DESCR))
|
||||
SRC)))
|
||||
(IL:SETQ DESCR (CDR DESCR)) IL:|while| DESCR
|
||||
IL:|do| (IL:SETQ DEST (LIST 'IL:FREPLACEFIELDVAL
|
||||
(LIST 'QUOTE (CAR DESCR))
|
||||
DEST
|
||||
(LIST 'IL:FETCHFIELD
|
||||
(LIST 'QUOTE
|
||||
(CAR DESCR))
|
||||
SRC)))
|
||||
(LIST 'QUOTE (CAR DESCR))
|
||||
DEST
|
||||
(LIST 'IL:FETCHFIELD
|
||||
(LIST 'QUOTE (CAR DESCR))
|
||||
SRC)))
|
||||
(IL:SETQ DESCR (CDR DESCR))
|
||||
IL:|finally| (WHEN (NOT (IL:ATOM (CADDR X)))
|
||||
(IL:SETQ DEST
|
||||
(LIST 'LET (LIST (LIST '$$SOURCE
|
||||
(CADDR X)))
|
||||
DEST)))
|
||||
(IL:SETQ DEST
|
||||
(LIST 'LET (LIST (LIST '$$SOURCE
|
||||
(CADDR X)))
|
||||
DEST)))
|
||||
(RETURN DEST))))
|
||||
|
||||
(IL:PUTPROPS IL:HALF IL:MACRO ((IL:X)
|
||||
(IL:PUTPROPS IL:HALF IL:MACRO ((IL:X)
|
||||
(IL:LRSH IL:X 1)))
|
||||
)
|
||||
|
||||
@@ -775,10 +748,10 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
|
||||
|
||||
(DEFPARAMETER *IL-CL-CONFLICTS*
|
||||
'(IL:*PRINT-STRUCTURE* IL:* IL:APPEND IL:APPLY IL:ASSOC IL:ATOM IL:BLOCK IL:CHARACTER
|
||||
IL:EQUAL IL:ERROR IL:FLOATP IL:FORMAT IL:FUNCTION IL:GETHASH IL:IF IL:LAMBDA IL:LENGTH
|
||||
IL:LISTP IL:MAPCAR IL:NTH IL:NUMBER IL:NUMBERP IL:PRIN1 IL:READ IL:REVERSE IL:SETQ
|
||||
IL:SPACE IL:STRINGP IL:TERPRI))
|
||||
'(IL:*PRINT-STRUCTURE* IL:* IL:APPEND IL:APPLY IL:ASSOC IL:ATOM IL:BLOCK IL:CHARACTER IL:EQUAL
|
||||
IL:ERROR IL:FLOATP IL:FORMAT IL:FUNCTION IL:GETHASH IL:IF IL:LAMBDA IL:LENGTH IL:LISTP
|
||||
IL:MAPCAR IL:NTH IL:NUMBER IL:NUMBERP IL:PRIN1 IL:READ IL:REVERSE IL:SETQ IL:SPACE
|
||||
IL:STRINGP IL:TERPRI))
|
||||
|
||||
(DEFPARAMETER *IL-IMPORTS*
|
||||
'(IL:\" IL:$$ITERATE IL:$$LST1 IL:$$OUT IL:\( IL:*DISPLAY-EDITOR* IL:\, IL:\. IL:.P2
|
||||
@@ -804,12 +777,12 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
IL:EXPR IL:EXTENT IL:FCHARACTER IL:FETCHFIELD IL:FILECREATED IL:FILEMAP IL:FILEPKGFLG
|
||||
IL:FILES IL:FILESLOAD IL:FILETYPE IL:FIND.PROCESS IL:FIXEDITDATE IL:FIXP IL:FIXR IL:FLAG
|
||||
IL:FLAGBITS IL:FLASHWINDOW IL:FLENGTH IL:FM.CHANGELABEL IL:FM.CHANGESTATE
|
||||
IL:FM.DONTRESHAPE IL:FM.EDITITEM IL:FM.GETITEM IL:FM.ITEMPROP IL:FM.RESETMENU IL:FMEMB
|
||||
IL:FM.DONTRESHAPE IL:FM.EDITITEM IL:FM.GETITEM IL:FM.ITEMPROP IL:FM.RESETMENU IL:FMEMB
|
||||
IL:FN IL:FNS IL:FONT IL:FONTCREATE IL:FONTPROP IL:FORM IL:FORWORD IL:FREEMENU
|
||||
IL:FREPLACEFIELDVAL IL:FULLXPOINTER IL:FUNCTIONS IL:GACHA IL:GETD IL:GETDEF
|
||||
IL:GETDESCRIPTORS IL:GETPROMPTWINDOW IL:GETPROP IL:GETPROPLIST IL:GETREGION IL:GETSYNTAX
|
||||
IL:GLOBALVARS IL:GROUP IL:HALF IL:HEIGHT IL:HEIGHTIFWINDOW IL:HELVETICA IL:ICON
|
||||
IL:ICONWINDOW IL:ID IL:IDIFFERENCE IL:IFWORD IL:IGEQ IL:IGREATERP IL:ILEQ IL:ILESSP
|
||||
IL:ICONWINDOW IL:ID IL:IDIFFERENCE IL:IFWORD IL:IGEQ IL:IGREATERP IL:ILEQ IL:ILESSP
|
||||
IL:IMAX IL:IMIN IL:IMINUS IL:IN/SCROLL/BAR? IL:INNERESCQUOTE IL:INFOHOOK IL:INITRECORDS
|
||||
IL:INITVARS IL:INPUT IL:INSIDEP IL:INTERPRESS IL:INVERT IL:IPLUS IL:IQUOTIENT
|
||||
IL:ITALICFONT IL:ITEM IL:ITEMS IL:ITEMWIDTH IL:ITIMES IL:KEYACTION IL:KEYACTIONTABLE
|
||||
@@ -817,10 +790,10 @@ IL:|{DSK}<python>lde>lispcore>sources>SEDIT-DECLS.;2|)
|
||||
IL:LASTMOUSEX IL:LASTMOUSEY IL:LCONC IL:LEFT IL:LEFTBRACKET IL:LEFTPAREN IL:LEQ
|
||||
IL:LINEDELETE IL:LINKS IL:LISTGET IL:LISTPUT IL:LITATOM IL:LOCALCLOSE IL:LOCALVARS IL:LRSH
|
||||
IL:MACRO IL:MACROS IL:MAINWINDOW IL:MAKEFILE-ENVIRONMENT IL:MARKASCHANGED
|
||||
IL:MARKASCHANGEDFNS IL:MASK IL:MAXWIDTH IL:MEMB IL:MENU IL:MENUFONT IL:MENUOFFSET
|
||||
IL:MESS IL:MICASPERPT IL:MIDDLE IL:MKSTRING IL:MOUSE IL:MOUSECONFIRM IL:MOUSESTATE IL:MOVE
|
||||
IL:MOVETO IL:MULTESCAPECHAR IL:MULTIPLE-ESCAPE IL:NAME IL:NCHARS IL:NCONC1 IL:NEQ
|
||||
IL:NILL IL:NLAMBDA IL:NLISTP IL:NLSETQ IL:NOBIND IL:NONE IL:NOTIFY.EVENT IL:NTHCHARCODE
|
||||
IL:MARKASCHANGEDFNS IL:MASK IL:MAXWIDTH IL:MEMB IL:MENU IL:MENUFONT IL:MENUOFFSET IL:MESS
|
||||
IL:MICASPERPT IL:MIDDLE IL:MKSTRING IL:MOUSE IL:MOUSECONFIRM IL:MOUSESTATE IL:MOVE
|
||||
IL:MOVETO IL:MULTESCAPECHAR IL:MULTIPLE-ESCAPE IL:NAME IL:NCHARS IL:NCONC1 IL:NEQ IL:NILL
|
||||
IL:NLAMBDA IL:NLISTP IL:NLSETQ IL:NOBIND IL:NONE IL:NOTIFY.EVENT IL:NTHCHARCODE
|
||||
IL:OBTAIN.MONITORLOCK IL:OFFST IL:OPENLAMBDA IL:OPENSTRINGSTREAM IL:OPENWP IL:P
|
||||
IL:PACKAGEDELIM IL:PAINT IL:POINTER IL:PRETTYCOMPRINT IL:PRIN2 IL:PROCESS IL:PROCESS.APPLY
|
||||
IL:PROCESS.EVAL IL:PROCESS.EVALV IL:PROCESSP IL:PROCESSPROP IL:PROCTYPEAHEAD
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED " 1-Dec-2021 17:38:50"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-EXPORTS.;2| 2883
|
||||
(IL:FILECREATED " 1-Dec-2021 20:41:41"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-EXPORTS.;3| 2921
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-EXPORTSCOMS)
|
||||
|
||||
IL:|previous| IL:|date:| "17-May-90 11:01:36"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-EXPORTS.;1|)
|
||||
IL:|previous| IL:|date:| " 1-Dec-2021 17:38:50"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-EXPORTS.;2|)
|
||||
|
||||
|
||||
; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation.
|
||||
@@ -20,7 +20,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-EXPORTS.;1|)
|
||||
|
||||
(IL:* IL:|;;| "REGION MANAGER")
|
||||
|
||||
(IL:P (EXPORT '(GET-WINDOW-REGION SAVE-WINDOW-REGION GET-WINDOW))
|
||||
(IL:P (EXPORT '(GET-WINDOW-REGION SAVE-WINDOW-REGION GET-WINDOW GET-PROP PUT-PROP))
|
||||
(EXPORT '(KEEP-WINDOW-REGION)))
|
||||
|
||||
(IL:* IL:|;;| "PROGRAMMERS INTERFACE")
|
||||
@@ -55,7 +55,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-EXPORTS.;1|)
|
||||
(IL:* IL:|;;| "REGION MANAGER")
|
||||
|
||||
|
||||
(EXPORT '(GET-WINDOW-REGION SAVE-WINDOW-REGION GET-WINDOW))
|
||||
(EXPORT '(GET-WINDOW-REGION SAVE-WINDOW-REGION GET-WINDOW GET-PROP PUT-PROP))
|
||||
|
||||
(EXPORT '(KEEP-WINDOW-REGION))
|
||||
|
||||
|
||||
Binary file not shown.
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "SEDIT" ( USE "LISP" "XCL")) READTABLE "XCL" BASE 10)
|
||||
|
||||
(IL:FILECREATED " 2-Dec-2021 23:05:22" IL:|{DSK}<home>larry>medley>sources>SEDIT-TOPLEVEL.;2| 36031
|
||||
(IL:FILECREATED " 8-Dec-2021 14:01:58"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-TOPLEVEL.;19| 37986
|
||||
|
||||
:CHANGES-TO (IL:FNS MARKASCHANGEDFN)
|
||||
:CHANGES-TO (IL:FNS GET-WINDOW-REGION)
|
||||
|
||||
:PREVIOUS-DATE " 1-Dec-2021 17:36:47" IL:|{DSK}<home>larry>medley>sources>SEDIT-TOPLEVEL.;1|)
|
||||
:PREVIOUS-DATE " 8-Dec-2021 11:50:57"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SEDIT-TOPLEVEL.;18|)
|
||||
|
||||
|
||||
; Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
@@ -18,7 +20,7 @@
|
||||
(IL:DECLARE\: IL:DONTCOPY IL:DOEVAL@COMPILE (IL:FILES IL:SEDIT-DECLS))
|
||||
(IL:INITVARS CONTEXTS REGIONS)
|
||||
(IL:VARS (IL:*DISPLAY-EDITOR* 'SEDIT))
|
||||
(IL:FNS SEDIT RESET GET-WINDOW-REGION SAVE-WINDOW-REGION GET-WINDOW)
|
||||
(IL:FNS SEDIT RESET GET-WINDOW-REGION SAVE-WINDOW-REGION GET-WINDOW GET-PROP PUT-PROP)
|
||||
(IL:FNS GET-CONTEXT DISINTEGRATE-CONTEXT AWAKE-COMMAND-PROCESS AWAKE-ME MARKASCHANGEDFN
|
||||
NEW-FUNCTION-BODY)
|
||||
(IL:FUNCTIONS QUERY-THROW-AWAY-CHANGES SET-OPTIONS SET-PROPS START-PROCESS)
|
||||
@@ -119,20 +121,35 @@
|
||||
(il:lambda nil (il:* il:\; "Edited 10-Jul-87 08:35 by DCB") (cond (contexts (il:error "Can't reset SEdit while there are open SEdit windows")) (t (create-environments) (reset-formats) t)))
|
||||
)
|
||||
|
||||
(get-window-region
|
||||
(il:lambda (context reason name type) (il:* il:\; "Edited 19-Nov-87 10:18 by DCB") (il:* il:|;;;| "called to get a region for this sedit window. should return the region for the sedit including the prompt window. context is being built and needs a window. the context will have at least the name (IconTitle) and type (EditType) of the object being edited, and can be used as desired to map between contexts and windows. If reason is :CREATE, then this function must return a region. If :EXPAND, then this algorithm returns a region from the stack only if SEDIT.KEEP.WINDOW.REGION is nil, otherwise it returns NIL, telling the window system not to reshape on expansion.") (when (or (eq reason :create) (not keep-window-region)) (or (il:pop regions) (progn (il:|printout| il:promptwindow t "Select region for SEdit window.") (il:getregion 30 20)))))
|
||||
)
|
||||
(GET-WINDOW-REGION
|
||||
(IL:LAMBDA (CONTEXT REASON NAME TYPE)
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"Edited 8-Dec-2021 14:01 by rmk: The :REGION property gives the user directe control")
|
||||
(IL:* IL:\; "Edited 1-Dec-2021 22:51 by rmk:")
|
||||
(IL:* IL:\; "Edited 19-Nov-87 10:18 by DCB")
|
||||
|
||||
(IL:* IL:|;;;| "called to get a region for this sedit window. should return the region for the sedit including the prompt window. context is being built and needs a window. the context will have at least the name (IconTitle) and type (EditType) of the object being edited, and can be used as desired to map between contexts and windows. If reason is :CREATE, then this function must return a region. If :EXPAND, then this algorithm returns a region from the stack only if SEDIT.KEEP.WINDOW.REGION is nil, otherwise it returns NIL, telling the window system not to reshape on expansion.")
|
||||
|
||||
(OR (GET-PROP CONTEXT :REGION)
|
||||
(WHEN (OR (EQ REASON :CREATE)
|
||||
(NOT KEEP-WINDOW-REGION))
|
||||
(OR (IL:POP REGIONS)
|
||||
(PROGN (IL:|printout| IL:PROMPTWINDOW T "Select region for SEdit window.")
|
||||
(IL:GETREGION 30 20)))))))
|
||||
|
||||
(SAVE-WINDOW-REGION
|
||||
(IL:LAMBDA (CONTEXT REASON NAME TYPE REGION) (IL:* IL:\; "Edited 23-Nov-87 17:46 by DCB")
|
||||
(IL:LAMBDA (CONTEXT REASON NAME TYPE REGION) (IL:* IL:\; "Edited 1-Dec-2021 21:13 by rmk:")
|
||||
(IL:* IL:\; "Edited 23-Nov-87 17:46 by DCB")
|
||||
|
||||
(IL:* IL:|;;;| "Release this sedit windows region to be used again. If we're shrinking, KEEP-WINDOW-REGION determines whether to release the region or not. If an icon is being closed, don't release the region because it was handled appropriately when the window as shrunk. remember, we're maintaining regions including the prompt window height, so use WINDOWREGION to get the whole region.")
|
||||
|
||||
(WHEN (OR (EQ REASON :CLOSE)
|
||||
(AND (EQ REASON :SHRINK)
|
||||
(NOT KEEP-WINDOW-REGION)))
|
||||
(IL:|push| REGIONS (OR REGION (IL:WINDOWREGION (IL:|fetch| DISPLAY-WINDOW
|
||||
IL:|of| CONTEXT)))))))
|
||||
(UNLESS (GET-PROP CONTEXT :DONT-KEEP-WINDOW-REGION)
|
||||
(IL:|push| REGIONS (OR REGION (IL:WINDOWREGION (IL:|fetch| DISPLAY-WINDOW IL:|of| CONTEXT
|
||||
))))))))
|
||||
|
||||
(GET-WINDOW
|
||||
(IL:LAMBDA (CONTEXT) (IL:* IL:\; "Edited 25-Nov-2021 23:13 by rmk:")
|
||||
@@ -141,6 +158,23 @@
|
||||
"Returns the current window of CONTEXT, for clients that don't have SEDIT declarations")
|
||||
|
||||
(IL:|fetch| DISPLAY-WINDOW IL:|of| CONTEXT)))
|
||||
|
||||
(GET-PROP
|
||||
(IL:LAMBDA (CONTEXT PROP) (IL:* IL:\; "Edited 1-Dec-2021 21:40 by rmk:")
|
||||
(WHEN (IL:WINDOWP CONTEXT)
|
||||
(SETQ CONTEXT (IL:WINDOWPROP CONTEXT 'EDIT-CONTEXT)))
|
||||
(IL:LISTGET (IL:FETCH (EDIT-CONTEXT PROPS) IL:OF CONTEXT)
|
||||
PROP)))
|
||||
|
||||
(PUT-PROP
|
||||
(IL:LAMBDA (CONTEXT PROP VALUE) (IL:* IL:\; "Edited 1-Dec-2021 21:44 by rmk:")
|
||||
(WHEN (IL:WINDOWP CONTEXT)
|
||||
(SETQ CONTEXT (IL:WINDOWPROP CONTEXT 'EDIT-CONTEXT)))
|
||||
(LET ((PROPS (IL:FETCH (EDIT-CONTEXT PROPS) IL:OF CONTEXT)))
|
||||
(IF PROPS
|
||||
(IL:LISTPUT PROPS PROP VALUE)
|
||||
(IL:REPLACE (EDIT-CONTEXT PROPS) IL:OF CONTEXT IL:WITH (LIST PROP VALUE)))
|
||||
VALUE)))
|
||||
)
|
||||
(IL:DEFINEQ
|
||||
|
||||
@@ -206,10 +240,9 @@
|
||||
)
|
||||
|
||||
(MARKASCHANGEDFN
|
||||
(IL:LAMBDA (NAME TYPE REASON) (IL:* IL:\;
|
||||
"Edited 2-Dec-2021 22:57 by larry")
|
||||
(IL:* IL:\;
|
||||
"Edited 3-Apr-91 15:42 by jds")
|
||||
(IL:LAMBDA (NAME TYPE REASON) (IL:* IL:\; "Edited 8-Dec-2021 11:49 by rmk")
|
||||
(IL:* IL:\; "Edited 2-Dec-2021 22:57 by larry")
|
||||
(IL:* IL:\; "Edited 3-Apr-91 15:42 by jds")
|
||||
|
||||
(IL:* IL:|;;;| "When a managed object is changed, we must check if we have an open edit on it. If so, calling SEdit again, with the fresh definition, will force the update. This is fairly tricky, though. Markaschanged is called as a result of editing a managed definition, so this markaschangedfn could be running in the sedit process under the completion-fn half way through completion. IDEALLY in this case we could say \"i know it changed, i just changed it!\" and ignore this call. BUT FOR NOW (1/14/91) since the manager can change the definition on completion (editdates, for one), we have to notify SEdit. Since calling editdef will restart the sedit process, the completion-fn will not finish, so do the verify-structure here.")
|
||||
|
||||
@@ -231,7 +264,7 @@
|
||||
|
||||
(IL:* IL:|;;| "found a matching context elsewhere")
|
||||
|
||||
(IL:RESETFORM (IL:EDITMODE SEDIT)
|
||||
(IL:RESETFORM (IL:EDITMODE 'SEDIT)
|
||||
(IL:EDITDEF NAME TYPE NIL NIL '(:DONTWAIT))))))))
|
||||
|
||||
(new-function-body
|
||||
@@ -261,10 +294,12 @@
|
||||
OPTIONS
|
||||
(LIST OPTIONS))))
|
||||
|
||||
(DEFUN SET-PROPS (CONTEXT PROPS)
|
||||
(DEFUN SET-PROPS (CONTEXT PROPS) (IL:* IL:\; "Edited 1-Dec-2021 20:10 by rmk:")
|
||||
|
||||
(IL:* IL:|;;;| "go through the PROPS list supplied in the call to SEDIT and store the info in the context. The :NAME and :TYPE props are already handled, because get-context uses this information to find an appropriate context. Grab the current values of the variables that determine reading and printing, and save them in a profile in the context, so that later changes to the globals don't affect existing contexts. ")
|
||||
|
||||
(IL:* IL:|;;;| "RMK: Added ability to store arbitrary properties, in a new PROPS field. Perhaps should filter out the ones that are built-in and interpreted separately, but presumably doesn't matter. The point of this is to allow clients to provide additional information in the call to SEDIT that can be retrieved later (SEDITPROP, like STREAMPROP, WINDOWPROP, etc.) ")
|
||||
|
||||
(IL:REPLACE (EDIT-CONTEXT COMPLETION-FN) IL:OF CONTEXT IL:WITH (OR (IL:LISTGET PROPS
|
||||
:COMPLETION-FN)
|
||||
#'NULL))
|
||||
@@ -289,7 +324,8 @@
|
||||
(OR (IL:LISTGET PROPS
|
||||
:SELECT-INSTANCE
|
||||
)
|
||||
1)))))
|
||||
1))))
|
||||
(IL:REPLACE (EDIT-CONTEXT PROPS) IL:OF CONTEXT IL:WITH PROPS))
|
||||
|
||||
(DEFUN START-PROCESS (CONTEXT)
|
||||
|
||||
@@ -538,16 +574,17 @@
|
||||
(IL:DEFPRINT 'GAP 'PRINT-GAP)
|
||||
(IL:PUTPROPS IL:SEDIT-TOPLEVEL IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (3108 7326 (SEDIT 3121 . 5107) (RESET 5109 . 5310) (GET-WINDOW-REGION 5312 . 6189) (
|
||||
SAVE-WINDOW-REGION 6191 . 7018) (GET-WINDOW 7020 . 7324)) (7327 14295 (GET-CONTEXT 7340 . 9360) (
|
||||
DISINTEGRATE-CONTEXT 9362 . 10088) (AWAKE-COMMAND-PROCESS 10090 . 11683) (AWAKE-ME 11685 . 12068) (
|
||||
MARKASCHANGEDFN 12070 . 14091) (NEW-FUNCTION-BODY 14093 . 14293)) (14297 15280 (
|
||||
QUERY-THROW-AWAY-CHANGES 14297 . 15280)) (15282 16057 (SET-OPTIONS 15282 . 16057)) (16059 18874 (
|
||||
SET-PROPS 16059 . 18874)) (18876 19547 (START-PROCESS 18876 . 19547)) (19863 32840 (SEDITE 19876 .
|
||||
25643) (SEDITL 25645 . 26790) (FN-CHANGED 26792 . 27087) (PROP-CHANGED 27089 . 27226) (PROPLST-CHANGED
|
||||
27228 . 27356) (VAR-CHANGED 27358 . 27470) (ALIST-COMPLETION 27472 . 28283) (COMPLETION 28285 . 29665
|
||||
) (PROPS-COMPLETION 29667 . 30492) (TTYFN 30494 . 32332) (LOCATE-NODE-FROM-EDITCHAIN 32334 . 32838)) (
|
||||
32986 33355 (SMART-TTYFN 32986 . 33355)) (33478 35163 (PRETTY-PRINT 33491 . 34534) (MAP-FONT 34536 .
|
||||
35161)) (35345 35448 (MAKE-BROKEN-ATOM 35345 . 35448)) (35450 35608 (PRINT-BROKEN-ATOM 35450 . 35608))
|
||||
(35610 35694 (MAKE-GAP 35610 . 35694)) (35696 35824 (PRINT-GAP 35696 . 35824)))))
|
||||
(IL:FILEMAP (NIL (3174 8776 (SEDIT 3187 . 5173) (RESET 5175 . 5376) (GET-WINDOW-REGION 5378 . 6676) (
|
||||
SAVE-WINDOW-REGION 6678 . 7692) (GET-WINDOW 7694 . 7998) (GET-PROP 8000 . 8304) (PUT-PROP 8306 . 8774)
|
||||
) (8777 15717 (GET-CONTEXT 8790 . 10810) (DISINTEGRATE-CONTEXT 10812 . 11538) (AWAKE-COMMAND-PROCESS
|
||||
11540 . 13133) (AWAKE-ME 13135 . 13518) (MARKASCHANGEDFN 13520 . 15513) (NEW-FUNCTION-BODY 15515 .
|
||||
15715)) (15719 16702 (QUERY-THROW-AWAY-CHANGES 15719 . 16702)) (16704 17479 (SET-OPTIONS 16704 . 17479
|
||||
)) (17481 20829 (SET-PROPS 17481 . 20829)) (20831 21502 (START-PROCESS 20831 . 21502)) (21818 34795 (
|
||||
SEDITE 21831 . 27598) (SEDITL 27600 . 28745) (FN-CHANGED 28747 . 29042) (PROP-CHANGED 29044 . 29181) (
|
||||
PROPLST-CHANGED 29183 . 29311) (VAR-CHANGED 29313 . 29425) (ALIST-COMPLETION 29427 . 30238) (
|
||||
COMPLETION 30240 . 31620) (PROPS-COMPLETION 31622 . 32447) (TTYFN 32449 . 34287) (
|
||||
LOCATE-NODE-FROM-EDITCHAIN 34289 . 34793)) (34941 35310 (SMART-TTYFN 34941 . 35310)) (35433 37118 (
|
||||
PRETTY-PRINT 35446 . 36489) (MAP-FONT 36491 . 37116)) (37300 37403 (MAKE-BROKEN-ATOM 37300 . 37403)) (
|
||||
37405 37563 (PRINT-BROKEN-ATOM 37405 . 37563)) (37565 37649 (MAKE-GAP 37565 . 37649)) (37651 37779 (
|
||||
PRINT-GAP 37651 . 37779)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user