1
0
mirror of synced 2026-03-21 17:02:01 +00:00

Compare commits

..

2 Commits

100 changed files with 5050 additions and 5801 deletions

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2025 10:15:55" {WMEDLEY}<internal>TEDIT-DEBUG.;131 130299
(FILECREATED "16-Dec-2024 20:38:14" {WMEDLEY}<internal>TEDIT-DEBUG.;123 130350
:EDIT-BY rmk
:CHANGES-TO (MACROS DEBUGOUTPUT)
:CHANGES-TO (FNS SP)
:PREVIOUS-DATE " 1-Feb-2025 08:28:14" {WMEDLEY}<internal>TEDIT-DEBUG.;130)
:PREVIOUS-DATE "14-Dec-2024 14:32:20" {WMEDLEY}<internal>TEDIT-DEBUG.;122)
(PRETTYCOMPRINT TEDIT-DEBUGCOMS)
@@ -109,16 +109,14 @@
(fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))])
(GTS
[LAMBDA (ARG NOERROR) (* ; "Edited 1-Feb-2025 08:25 by rmk")
(* ; "Edited 23-Nov-2024 11:38 by rmk")
[LAMBDA (ARG NOERROR) (* ; "Edited 23-Nov-2024 11:38 by rmk")
(* ; "Edited 4-Oct-2024 22:13 by rmk")
(* ; "Edited 21-Sep-2024 21:51 by rmk")
(* ; "Edited 11-Aug-2024 21:53 by rmk")
(CL:UNLESS (AND (TEXTSTREAM LASTTEXTSTREAM T)
(OPENWP (\TEDIT.PRIMARYPANE LASTTEXTSTREAM)))
(SETQ LASTTEXTSTREAM NIL))
(LET* ((TWINDOWS (for W in (OPENWINDOWS) when (WINDOWPROP W 'TEDITCREATED)
unless (WINDOWPROP W 'TEDIT-DEBUG) collect W))
(LET* ((TWINDOWS (for W in (OPENWINDOWS) when (WINDOWPROP W 'TEDITCREATED) collect W))
(TSTREAM (TEXTSTREAM (OR ARG (CL:IF (CDR TWINDOWS)
(WHICHW)
(CAR TWINDOWS)))
@@ -395,16 +393,25 @@
(DEFINEQ
(SP
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 6-Jan-2025 22:18 by rmk")
(* ; "Edited 16-Dec-2024 15:50 by rmk")
[LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 16-Dec-2024 15:50 by rmk")
(* ; "Edited 30-Nov-2024 19:34 by rmk")
(* ; "Edited 26-Nov-2024 20:53 by rmk")
(* ; "Edited 23-Nov-2024 15:35 by rmk")
(* ; "Edited 9-Sep-2024 14:53 by rmk")
(* ; "Edited 1-Sep-2024 00:05 by rmk")
(* ; "Edited 11-Aug-2024 21:06 by rmk")
(* ; "Edited 15-Jun-2024 11:52 by rmk")
(* ; "Edited 21-May-2024 11:29 by rmk")
(* ; "Edited 13-May-2024 12:16 by rmk")
(* ; "Edited 5-May-2024 12:56 by rmk")
(* ; "Edited 29-Apr-2024 12:46 by rmk")
(* ; "Edited 17-Mar-2024 12:58 by rmk")
(* ; "Edited 16-Mar-2024 10:07 by rmk")
(* ; "Edited 11-Jan-2024 22:19 by rmk")
(* ; "Edited 3-Jan-2024 00:41 by rmk")
(* ; "Edited 27-Dec-2023 13:02 by rmk")
(* ; "Edited 25-Nov-2023 10:49 by rmk")
(* ; "Edited 23-Nov-2023 11:47 by rmk")
(* ; "Edited 21-Oct-2023 10:56 by rmk")
(* ;; "PC is the starting piece, NP is the number of pieces including it.")
@@ -415,15 +422,12 @@
PC
(GTO TOBJ)))
WTYPE)
(if OFILE
then (CL:WHEN (MEMB OFILE '(T TEDIT))
(SETQ WTYPE 'SP)
(SETQ OFILE NIL))
elseif (AND NP (LITATOM NP))
then (SETQ WTYPE (CL:IF (EQ NP T)
'SP
NP))
(SETQ NP NIL))
(CL:WHEN (AND NP (LITATOM NP)
(NULL OFILE))
(SETQ WTYPE (CL:IF (EQ NP T)
'SP
NP))
(SETQ NP NIL))
(CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ))
(PRINTOUT T "Document is empty" T)
(RETURN))
@@ -475,9 +479,7 @@
(RETURN PC])
(SL
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 21-Jan-2025 15:39 by rmk")
(* ; "Edited 6-Jan-2025 22:58 by rmk")
(* ; "Edited 7-Dec-2024 16:34 by rmk")
[LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 7-Dec-2024 16:34 by rmk")
(* ; "Edited 3-Dec-2024 10:29 by rmk")
(* ; "Edited 25-Nov-2024 21:42 by rmk")
(* ; "Edited 18-Nov-2024 21:28 by rmk")
@@ -490,13 +492,10 @@
(* ;; "Shows a selection of the lines backing the display in PANE")
(LET (LINES WTYPE PNO)
(if OFILE
then (CL:WHEN (MEMB OFILE '(T TEDIT))
(SETQ WTYPE 'SL)
(SETQ OFILE NIL))
elseif (MEMB LASTLINE '(T TEDIT))
then (SETQ WTYPE 'SL)
(SETQ LASTLINE NIL))
(CL:UNLESS OFILE
(CL:WHEN (EQ LASTLINE T)
(SETQ WTYPE 'SL)
(SETQ LASTLINE NIL)))
(CL:WHEN [AND (type? LINEDESCRIPTOR (CAR (LISTP FIRSTLINE)))
(NULL LASTLINE)
(OR (NULL (CDR FIRSTLINE))
@@ -519,15 +518,11 @@
finally (CL:WHEN (EQ LASTLINE (PANEBOTTOMLINE PANE))
(SHOWLINE (PANESUFFIX PANE)
OFILE TOBJ)))
(TERPRI OFILE)
(CL:WHEN (EQ FIRSTLINE LASTLINE)
(printout OFILE (for L inlines (FGETLD LASTLINE NEXTLINE) sum 1)
" lines below LASTLINE" T T)))
(TERPRI OFILE))
FIRSTLINE])
(SSP
[LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 30-Jan-2025 11:25 by rmk")
(* ; "Edited 26-Nov-2024 20:54 by rmk")
[LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 26-Nov-2024 20:54 by rmk")
(* ; "Edited 3-Mar-2024 12:58 by rmk")
(* ; "Edited 12-Feb-2024 12:33 by rmk")
(* ; "Edited 22-Nov-2023 20:23 by rmk")
@@ -537,13 +532,7 @@
(* ;; "Prints up to NP pieces from SELPIECES.")
(if (TEXTOBJ NP T)
then (SETQ TEXTOBJ (TEXTOBJ NP))
(SETQ NP NIL)
elseif (TEXTOBJ OFILE T)
then (SETQ TEXTOBJ (TEXTOBJ OFILE))
(SETQ OFILE NIL)
else (GTO TEXTOBJ))
(SETQ TEXTOBJ (GTO TEXTOBJ))
(DEBUGOUTPUT OFILE (CL:UNLESS OFILE 'SSP)
(for PC inselpieces SELPIECES as I from 1 to (OR NP 50)
do (PRINTOUT OFILE .I3 I "/")
@@ -1356,8 +1345,7 @@
OSTREAM)))])
(SPPRINT.OBJ
[LAMBDA (OBJ STREAM POS) (* ; "Edited 9-Jan-2025 16:48 by rmk")
(* ; "Edited 6-Oct-2024 20:54 by rmk")
[LAMBDA (OBJ STREAM POS) (* ; "Edited 6-Oct-2024 20:54 by rmk")
(* ; "Edited 29-Sep-2024 14:45 by rmk")
(* ; "Edited 29-Aug-2024 10:44 by rmk")
(* ; "Edited 25-Aug-2024 14:31 by rmk")
@@ -1376,7 +1364,7 @@
(CL:UNLESS [NLSETQ (SELECTQ (IMAGEOBJPROP OBJ 'DISPLAYFN)
(MB.NWAY.DISPLAYFN
(PRINTOUT STREAM (IMAGEOBJPROP OBJ 'IDENTIFIER)
T .TAB (IPLUS POS 2))
":" T .TAB (IPLUS POS 2))
(for SOBJ in (IMAGEOBJPROP OBJ 'SUBOBJECTS)
do (PRINTOUT STREAM (IMAGEOBJPROP SOBJ 'IDENTIFIER)
" ")))
@@ -1895,8 +1883,7 @@
(for R in (fetch (PARA RUNS) of PARA) do (PRUN R BSTR)))])
(PRUN
[LAMBDA (RUN BSTR) (* ; "Edited 2-Jan-2025 10:28 by rmk")
(* ; "Edited 22-Aug-2023 10:59 by rmk")
[LAMBDA (RUN BSTR) (* ; "Edited 22-Aug-2023 10:59 by rmk")
(* ; "Edited 8-Aug-2023 16:47 by rmk")
(* ;; "Shows the characters in RUN, with font information")
@@ -1915,15 +1902,26 @@
(LET (FONT (CL (fetch (RUN RUNLOOKS) of RUN)))
(SETQ FONT (fetch (CHARLOOKS CLFONT) of CL))
(TAB 13 NIL T)
(PRINTOUT T (FONTPROP FONT 'FAMILY)
(FONTPROP FONT 'SIZE)
(CL:IF [EQ 'BOLD (CAR (FONTPROP FONT 'FACE]
'B
"")
(CL:IF [EQ 'ITALIC (CADR (FONTPROP FONT 'FACE]
'I
"")
T))
(if FONT
then (for X in (FONTUNPARSE FONT)
do (if (MEMB X '(MEDIUM BOLD ITALIC REGULAR))
then (PRIN1 (NTHCHAR X 1)
T)
elseif (NUMBERP X)
then (PRINTOUT T " " X " ")
else (PRIN1 X T)))
(TERPRI T)
else (PRINTOUT T (fetch (CHARLOOKS CLNAME) of CL)
" "
(fetch (CHARLOOKS CLSIZE) of CL)
" "
(CL:IF (fetch (CHARLOOKS CLBOLD) of CL)
"B"
"M")
(CL:IF (fetch (CHARLOOKS CLITAL) of CL)
"I"
"R")
T)))
RUN)])
(ADDLINEPOSITIONS
@@ -2335,9 +2333,7 @@
`(PROGN (CL:UNLESS RESETSTATE
[TEDIT OFILE WTYPE NIL
`(READONLY QUIET LEAVETTY T TITLE
,WTYPE]
(WINDOWPROP (WFROMDS OFILE)
'TEDIT-DEBUG T))]
,WTYPE])]
elseif OFILE
then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW))
'(PROGN (CLOSEF? OLDVALUE]
@@ -2430,30 +2426,30 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4852 7411 (GTO 4862 . 5112) (GTS 5114 . 6885) (GTW 6887 . 7043) (GSEL 7045 . 7409)) (
7468 20599 (IPC 7478 . 8982) (ILINES 8984 . 11525) (ISEL 11527 . 12138) (ITS 12140 . 13864) (IPANES
13866 . 14101) (ITL 14103 . 14522) (IHIST 14524 . 17186) (IPCTB 17188 . 17496) (IMB 17498 . 18113) (
ICL 18115 . 18680) (IPL 18682 . 19086) (ICARET 19088 . 19465) (INSPECTPIECES 19467 . 20597)) (20621
55720 (SP 20631 . 25148) (SL 25150 . 28294) (SSP 28296 . 29727) (STL 29729 . 38241) (SPF 38243 . 40542
) (SLF 40544 . 49677) (SHOWLINE 49679 . 53241) (SLL 53243 . 53990) (STBYTES 53992 . 55718)) (55721
61094 (NTHPIECE 55731 . 56863) (NPIECES 56865 . 57730) (NTHPIECECHAR 57732 . 59040) (SELPIECE 59042 .
59484) (PIECENUM 59486 . 60205) (PCBYTES 60207 . 61092)) (61095 63569 (FILEBYTES 61105 . 62529) (
TFILEBYTES 62531 . 63567)) (63570 64892 (TRELMOVE 63580 . 63823) (TSCROLL 63825 . 63991) (TSCROLL*
63993 . 64890)) (64893 67942 (TRY 64903 . 66172) (TEDITCLOSEW 66174 . 66517) (PARALASTWITHOUTEOL 66519
. 67404) (FIXPARALAST 67406 . 67940)) (67943 82273 (SPPRINT 67953 . 74369) (SPPRINT.CHAR 74371 .
75355) (SPPRINT.OBJ 75357 . 78415) (SHOWPIECEBYTES 78417 . 79973) (CHECKPLENGTHS 79975 . 80432) (SBT
80434 . 81423) (COPYPCHAIN 81425 . 82271)) (82274 84335 (POSLINE 82284 . 84333)) (84336 85219 (
PRESPLIT 84346 . 85217)) (85220 86933 (ALLTL 85230 . 86483) (NTHCHARSLOT 86485 . 86931)) (86959 97172
(PLCHAIN 86969 . 87497) (PRINTLINE 87499 . 90489) (SL.GETLINES 90491 . 93784) (CHECKLINES 93786 .
94766) (COLLECTLINES 94768 . 95020) (NTHLINE 95022 . 96027) (HEIGHT 96029 . 96317) (LINEBOTS 96319 .
97170)) (97173 99621 (IPC.DECODEARGS 97183 . 99619)) (99622 100215 (SPF1 99632 . 100213)) (100244
102622 (SLF.FATPLEN 100254 . 101113) (FILEPIECE 101115 . 102620)) (102655 103423 (SELTEDIT 102665 .
103421)) (103493 109105 (PPARA 103503 . 103925) (PRUN 103927 . 105403) (ADDLINEPOSITIONS 105405 .
106832) (SBR 106834 . 107488) (SBC 107490 . 109103)) (109162 113837 (DFOV 109172 . 111642) (OLDWI
111644 . 112019) (DFOV.OLDEST 112021 . 112446) (COMP 112448 . 112643) (DFR 112645 . 113835)) (113838
114871 (DFGV 113848 . 114374) (GDIRECTORIES 114376 . 114869)) (114872 121437 (TTEST 114882 . 119414) (
LTEST 119416 . 120781) (THC 120783 . 121435)) (121751 122443 (SHOWSAFE 121761 . 122441)) (122496
122943 (MYH 122506 . 122941)) (123188 124283 (DFVENUE 123198 . 124077) (VSEE 124079 . 124281)) (124284
124738 (PTT 124294 . 124736)) (125985 128301 (TEDIT-DEBUG 125995 . 128299)) (128302 130038 (TRENAME
128312 . 130036)))))
(FILEMAP (NIL (4840 7227 (GTO 4850 . 5100) (GTS 5102 . 6701) (GTW 6703 . 6859) (GSEL 6861 . 7225)) (
7284 20415 (IPC 7294 . 8798) (ILINES 8800 . 11341) (ISEL 11343 . 11954) (ITS 11956 . 13680) (IPANES
13682 . 13917) (ITL 13919 . 14338) (IHIST 14340 . 17002) (IPCTB 17004 . 17312) (IMB 17314 . 17929) (
ICL 17931 . 18496) (IPL 18498 . 18902) (ICARET 18904 . 19281) (INSPECTPIECES 19283 . 20413)) (20437
55479 (SP 20447 . 25793) (SL 25795 . 28371) (SSP 28373 . 29486) (STL 29488 . 38000) (SPF 38002 . 40301
) (SLF 40303 . 49436) (SHOWLINE 49438 . 53000) (SLL 53002 . 53749) (STBYTES 53751 . 55477)) (55480
60853 (NTHPIECE 55490 . 56622) (NPIECES 56624 . 57489) (NTHPIECECHAR 57491 . 58799) (SELPIECE 58801 .
59243) (PIECENUM 59245 . 59964) (PCBYTES 59966 . 60851)) (60854 63328 (FILEBYTES 60864 . 62288) (
TFILEBYTES 62290 . 63326)) (63329 64651 (TRELMOVE 63339 . 63582) (TSCROLL 63584 . 63750) (TSCROLL*
63752 . 64649)) (64652 67701 (TRY 64662 . 65931) (TEDITCLOSEW 65933 . 66276) (PARALASTWITHOUTEOL 66278
. 67163) (FIXPARALAST 67165 . 67699)) (67702 81927 (SPPRINT 67712 . 74128) (SPPRINT.CHAR 74130 .
75114) (SPPRINT.OBJ 75116 . 78069) (SHOWPIECEBYTES 78071 . 79627) (CHECKPLENGTHS 79629 . 80086) (SBT
80088 . 81077) (COPYPCHAIN 81079 . 81925)) (81928 83989 (POSLINE 81938 . 83987)) (83990 84873 (
PRESPLIT 84000 . 84871)) (84874 86587 (ALLTL 84884 . 86137) (NTHCHARSLOT 86139 . 86585)) (86613 96826
(PLCHAIN 86623 . 87151) (PRINTLINE 87153 . 90143) (SL.GETLINES 90145 . 93438) (CHECKLINES 93440 .
94420) (COLLECTLINES 94422 . 94674) (NTHLINE 94676 . 95681) (HEIGHT 95683 . 95971) (LINEBOTS 95973 .
96824)) (96827 99275 (IPC.DECODEARGS 96837 . 99273)) (99276 99869 (SPF1 99286 . 99867)) (99898 102276
(SLF.FATPLEN 99908 . 100767) (FILEPIECE 100769 . 102274)) (102309 103077 (SELTEDIT 102319 . 103075)) (
103147 109305 (PPARA 103157 . 103579) (PRUN 103581 . 105603) (ADDLINEPOSITIONS 105605 . 107032) (SBR
107034 . 107688) (SBC 107690 . 109303)) (109362 114037 (DFOV 109372 . 111842) (OLDWI 111844 . 112219)
(DFOV.OLDEST 112221 . 112646) (COMP 112648 . 112843) (DFR 112845 . 114035)) (114038 115071 (DFGV
114048 . 114574) (GDIRECTORIES 114576 . 115069)) (115072 121637 (TTEST 115082 . 119614) (LTEST 119616
. 120981) (THC 120983 . 121635)) (121951 122643 (SHOWSAFE 121961 . 122641)) (122696 123143 (MYH
122706 . 123141)) (123388 124483 (DFVENUE 123398 . 124277) (VSEE 124279 . 124481)) (124484 124938 (PTT
124494 . 124936)) (126036 128352 (TEDIT-DEBUG 126046 . 128350)) (128353 130089 (TRENAME 128363 .
130087)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4 34381
(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3 34260
:EDIT-BY rmk
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
:PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
:PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
(PRETTYCOMPRINT IMAGEOBJCOMS)
@@ -674,8 +674,7 @@
(DEFINEQ
(GET.OBJ.FROM.USER
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Dec-2024 19:44 by rmk")
(* ; "Edited 7-Jul-2024 21:04 by rmk")
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Jul-2024 21:04 by rmk")
(* ; "Edited 26-Apr-91 10:54 by jds")
(* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")
@@ -689,7 +688,7 @@
(TEDIT.INSERT TEXTSTREAM VAL))
(LITATOM (* ;
 "Atoms and strings get inserted as text.")
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))))
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)))
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
(T [COND
@@ -770,12 +769,12 @@
(FILESLOAD EDITBITMAP)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT
5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5
20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4
25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
PROMPTFOREVALED 32055 . 34279)))))
(FILEMAP (NIL (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT
5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 (
BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) (
BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5
20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) (
BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4
25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) (
PROMPTFOREVALED 31934 . 34158)))))
STOP

Binary file not shown.

View File

@@ -1,19 +1,22 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Jun-2021 09:05:17" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;6 196680
(FILECREATED "14-Jul-2024 08:42:20" {WMEDLEY}<library>MASTERSCOPE.;28 197707
changes to%: (FNS MSINTERPRETSET)
:EDIT-BY rmk
previous date%: " 9-Jun-2021 23:55:26"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>MASTERSCOPE.;5)
:CHANGES-TO (FNS MSOUTPUT)
:PREVIOUS-DATE " 5-Jul-2024 11:54:48" {WMEDLEY}<library>MASTERSCOPE.;27)
(* ; "
Copyright (c) 1983-1988, 1990, 1993-1994, 2018, 2020-2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT MASTERSCOPECOMS)
(RPAQQ MASTERSCOPECOMS
[
(* ;; "Main file for MASTERSCOPE.")
(* ;; "Main file for MASTERSCOPE.")
(FILES MSPARSE MSANALYZE)
(PROP FILETYPE MASTERSCOPE)
@@ -25,13 +28,13 @@
[COMS (FNS MSFIND MSEDITF MSEDITE EDITGETDEF)
(VARS MSBLIP)
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
(* ;; "List of (FILEPKGTYPE FILEPKGTYPE GETDEF-fn MARKASCHANGED-fn) for types that Masterscope knows how to analyze. LOOPSMS, for example, adds LOOPS constructs to this lists using MSADDANALYZE.")
[INITVARS (MSFNTYPES '((FNS FNS GETDEF]
(COMS (* ; "SCRATCHASH")
(COMS (* ; "SCRATCHASH")
(INITVARS (MSCRATCHASH))
(DECLARE%: DONTCOPY (MACROS SCRATCHASH]
(COMS (* ; "marking changed")
(COMS (* ; "marking changed")
(FNS MSMARKCHANGED CHANGEMACRO CHANGEVAR CHANGEI.S. CHANGERECORD MSNEEDUNSAVE UNSAVEFNS
)
(ADDVARS (COMPILE.TIME.CONSTANTS))
@@ -39,11 +42,11 @@
(INITVARS (CHECKUNSAVEFLG T)
(MSNEEDUNSAVE)))
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS GETWORDTYPE))
(COMS (* ; "interactive routines")
(COMS (* ; "interactive routines")
[VARS * (LIST (LIST 'MASTERSCOPEDATE (DATE (DATEFORMAT NO.TIME]
(ADDVARS (HISTORYCOMS %.))
(FNS %. MASTERSCOPE MASTERSCOPE1 MASTERSCOPEXEC)
(* ; "Interpreting commands")
(* ; "Interpreting commands")
(FNS MSINTERPRETSET MSINTERPA MSGETBLOCKDEC LISTHARD MSMEMBSET MSLISTSET MSHASHLIST
MSHASHLIST1 CHECKPATHS ONFILE)
(FNS MSINTERPRET VERBNOTICELIST MSOUTPUT MSCHECKEMPTY CHECKFORCHANGED MSSOLVE)
@@ -183,9 +186,9 @@
MSFILELST])
(MSSHOWUSE
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS) (* ; "Edited 4-Jul-2024 15:06 by rmk")
(* ;
 "Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
[LAMBDA (SHOWFN SHOWTYPE SHOWSET SHOWEDIT IFCANT EDITCOMS)
(* ;
 "Edited 23-Jun-93 09:40 by sybalsky:mv:envos")
(* ;; "Show/Edit where SHOWFN uses/etc. a pattern.")
@@ -193,7 +196,7 @@
(COND
([OR [CL:MULTIPLE-VALUE-SETQ (DEF REALDEF)
(MSGETDEF SHOWFN (AND (fetch (MSSETPHRASE KNOWN) of SHOWSET)
(fetch (MSSETPHRASE TYPE) of SHOWSET))
(fetch (MSSETPHRASE TYPE) of SHOWSET))
(COND
((EQ SHOWEDIT 'SHOW)
'?)
@@ -205,45 +208,43 @@
(FILE (LOADFNS SHOWFN FILE 'PROP)
(GETPROP SHOWFN 'EXPR]
(* ;
 "was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
 "was (MSGETDEF SHOWFN IFCANT (EQ SHOWEDIT (QUOTE SHOW)))")
(* ;
 "The SHOW command does not need to save")
(MSUPDATEFN1 SHOWFN DEF (LIST SHOWTYPE
[FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
(COND
((MSMEMBSET ITEM SS)
(COND
((NOT ANYFOUND)
(TAB 0 0 T)
(DSPFONT (PROG1 (DSPFONT BOLDFONT)
(PRIN2 SHOWFN)))
(PRIN1 " :
 "The SHOW command does not need to save")
(MSUPDATEFN1 SHOWFN DEF
(LIST SHOWTYPE [FUNCTION (LAMBDA (ITEM SS SE PRNT INCLISP)
(COND
((MSMEMBSET ITEM SS)
(COND
((NOT ANYFOUND)
(TAB 0 0 T)
(PRIN2 SHOWFN)
(PRIN1 " :
")))
(SETQ ANYFOUND
(CONS (CONS PRNT
(AND INCLISP
(NOT (MSFIND INCLISP
PRNT))
INCLISP))
ANYFOUND))
(COND
([AND (EQ SE 'SHOW)
(NOT (FASSOC PRNT (CDR ANYFOUND]
(SETQ ANYFOUND
(CONS (CONS PRNT (AND INCLISP
(NOT (MSFIND INCLISP
PRNT))
INCLISP))
ANYFOUND))
(COND
([AND (EQ SE 'SHOW)
(NOT (FASSOC PRNT (CDR ANYFOUND]
(* ;; "The EDIT command works by collecting a list of the expressions, and then doing a (*ORF* (= . lst1) (= . lst2)) --- if within a CLISP translation (determined by the binding of the INCLISP variable) then want to point at the CLISP if the expression is not actually embedded in the expression")
(SPACES 3)
(LVLPRINT PRNT (OUTPUT)
2)
(COND
((CDAR ANYFOUND)
(SPACES 3)
(LVLPRINT PRNT (OUTPUT)
2)
(COND
((CDAR ANYFOUND)
(* ; "This is under a clisp")
(PRIN1 " {under ")
(LVLPRIN2 INCLISP (OUTPUT)
2)
(PRIN1 "}
(PRIN1 " {under ")
(LVLPRIN2 INCLISP (OUTPUT)
2)
(PRIN1 "}
"]
SHOWSET SHOWEDIT)))
SHOWSET SHOWEDIT)))
(T (printout T "Can't find a definition for " SHOWFN "!" T)
(RETURN)))
(COND
@@ -2402,14 +2403,14 @@
(DECLARE%: EVAL@COMPILE
(PUTPROPS SCRATCHASH MACRO [(ARRAYNAME . FORMS)
([LAMBDA (ARRAYNAME)
(SETQ MSCRATCHASH)
(PROG1 (PROGN . FORMS)
(SETQ MSCRATCHASH ARRAYNAME]
(COND
(MSCRATCHASH (CLRHASH MSCRATCHASH)
MSCRATCHASH)
(T (HASHARRAY 20 (FUNCTION MSREHASH])
([LAMBDA (ARRAYNAME)
(SETQ MSCRATCHASH)
(PROG1 (PROGN . FORMS)
(SETQ MSCRATCHASH ARRAYNAME]
(COND
(MSCRATCHASH (CLRHASH MSCRATCHASH)
MSCRATCHASH)
(T (HASHARRAY 20 (FUNCTION MSREHASH])
)
)
@@ -2568,7 +2569,7 @@
(DECLARE%: EVAL@COMPILE
(PUTPROPS GETWORDTYPE MACRO [(WORD TYPE)
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
(CDR (FASSOC TYPE (GETHASH WORD MSWORDS])
)
)
@@ -2577,7 +2578,7 @@
(* ; "interactive routines")
(RPAQ MASTERSCOPEDATE "14-Jul-2024")
(RPAQ MASTERSCOPEDATE "13-Jun-2021")
(ADDTOVAR HISTORYCOMS %.)
(DEFINEQ
@@ -3526,31 +3527,8 @@
(ERROR!])
(MSOUTPUT
[LAMBDA (FILE) (* ; "Edited 14-Jul-2024 08:41 by rmk")
(* ; "Edited 5-Jul-2024 11:54 by rmk")
(* ; "Edited 12-Jun-90 20:43 by teruuchi")
(LET ((LLENGTH FILELINELENGTH))
[COND
((AND (LITATOM FILE)
(MEMB (U-CASE FILE)
'(TEDIT :TEDIT))
(GETD (FUNCTION TEDIT)))
(* ;; "If no TEDIT, leave the current OUTPUT")
[SETQ FILE (TEXTSTREAM (TEDIT NIL 'Masterscope NIL `(LEAVETTY T TITLE Masterscope FONT
,DEFAULTFONT]
(SETQ LLENGTH T)
(TEDIT.DEFER.UPDATES FILE '(READONLY QUIET))
(RESETSAVE NIL (LIST 'CLOSEF FILE)))
((OPENP FILE 'OUTPUT))
(T (SETQ FILE (OPENSTREAM FILE 'OUTPUT))
(RESETSAVE NIL (LIST 'CLOSEF FILE]
(* ;; "Reset LINELENGTH, output to file. OUTPUT is already RESETSAVE'd.")
(LINELENGTH LLENGTH FILE)
(OUTPUT FILE])
(LAMBDA (FILE) (* ; "Edited 12-Jun-90 20:43 by teruuchi") (* ;; "OUTPUT is already RESETSAVE'd") (COND ((OPENP FILE (QUOTE OUTPUT)) (OUTPUT FILE)) (T (OUTFILE FILE) (SETQ FILE (OUTPUT)) (RESETSAVE NIL (LIST (QUOTE CLOSEF) FILE)))) (* ;; "output to file, reset LINELENGTH") (LINELENGTH FILELINELENGTH))
)
(MSCHECKEMPTY
[LAMBDA NIL (* lmm "20-JAN-79 14:08")
@@ -3643,15 +3621,15 @@
(DECLARE%: EVAL@COMPILE
(RECORD GETHASH (ID HTABLE . BADMARKS)
ID _ 'GETHASH)
ID _ 'GETHASH)
(RECORD INRELATION (ID (INVERTED . HTABLES) . OSET)
ID _ 'INRELATION)
ID _ 'INRELATION)
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH MARKING)
(* CHECKPATHS assumes that this is an
 ASSOCRECORD)
)
(ASSOCRECORD PATHOPTIONS (TO FROM AVOIDING SEPARATE NOTRACE TOPFLG OUTPUT LINELENGTH
MARKING) (* CHECKPATHS assumes that this is
 an ASSOCRECORD)
)
(RECORD MSANALYZABLE (FILEPKGNAME SETNAME GETDEF-FN MARKCHANGED-FN))
)
@@ -3748,37 +3726,39 @@
(ADDTOVAR LAMA MSEDITE MSEDITF)
)
(PUTPROPS MASTERSCOPE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993
1994 2018 2020 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3260 19507 (UPDATEFN 3270 . 4887) (MSGETDEF 4889 . 6295) (MSNOTICEFILE 6297 . 8690) (
MSSHOWUSE 8692 . 14673) (MSUPDATEFN1 14675 . 15363) (MSUPDATE 15365 . 17791) (MSNLAMBDACHECK 17793 .
18675) (MSCOLLECTDATA 18677 . 19505)) (19508 20407 (UPDATECHANGED 19518 . 19881) (UPDATECHANGED1 19883
. 20405)) (20981 21404 (MSCLOSEFILES 20991 . 21402)) (22085 26517 (MSDESCRIBE 22095 . 24883) (
MSDESCRIBE1 24885 . 25948) (FMAPRINT 25950 . 26515)) (26610 27050 (MSPRINTHELPFILE 26620 . 27048)) (
27100 30238 (TEMPLATE 27110 . 28531) (GETTEMPLATE 28533 . 28668) (SETTEMPLATE 28670 . 30236)) (31108
36032 (ADDTEMPLATEWORD 31118 . 31790) (MSADDANALYZE 31792 . 33290) (MSADDMODIFIER 33292 . 34373) (
MSADDRELATION 34375 . 35122) (MSADDTYPE 35124 . 36030)) (37533 42754 (MSMARKCHANGE1 37543 . 38337) (
MSINIT 38339 . 39520) (GETVERBTABLES 39522 . 40075) (MSSTOREDATA 40077 . 41756) (STORETABLE 41758 .
42752)) (44155 49225 (PARSERELATION 44165 . 44765) (PARSERELATION1 44767 . 46222) (GETRELATION 46224
. 47253) (MAPRELATION 47255 . 48389) (TESTRELATION 48391 . 49223)) (49226 50866 (ADDHASH 49236 .
49714) (SUBHASH 49716 . 49944) (MAKEHASH 49946 . 50090) (MSREHASH 50092 . 50545) (EQMEMBHASH 50547 .
50864)) (51205 57420 (MSVBTABLES 51215 . 56994) (MSUSERVBTABLES 56996 . 57418)) (57503 59714 (
BUILDGETRELQ 57513 . 58619) (BUILDTESTRELQ 58621 . 59712)) (59885 60273 (MSERASE 59895 . 60271)) (
60274 64734 (DUMPDATABASE 60284 . 62849) (DUMPDATABASE1 62851 . 63196) (READATABASE 63198 . 64732)) (
65816 94875 (MSCHECKBLOCKS 65826 . 69646) (MSCHECKBLOCK 69648 . 78268) (MSCHECKFNINBLOCK 78270 . 81270
) (MSCHECKBLOCKBASIC 81272 . 83692) (MSCHECKBOUNDFREE 83694 . 85593) (GLOBALVARP 85595 . 85762) (
PRINTERROR 85764 . 88980) (MSCHECKVARS1 88982 . 91935) (UNECCSPEC 91937 . 92215) (NECCSPEC 92217 .
92564) (SPECVARP 92566 . 93093) (SHORTLST 93095 . 93551) (DOERROR 93553 . 94263) (MSMSGPRINT 94265 .
94873)) (96019 110847 (MSPATHS 96029 . 99431) (MSPATHS1 99433 . 103668) (MSPATHS2 103670 . 107080) (
MSONPATH 107082 . 108310) (MSPATHS4 108312 . 109394) (DASHES 109396 . 109922) (DOTABS 109924 . 110165)
(BELOWMARKER 110167 . 110630) (MSPATHSPRINTFN 110632 . 110845)) (111233 114657 (MSFIND 111243 .
111518) (MSEDITF 111520 . 112520) (MSEDITE 112522 . 113559) (EDITGETDEF 113561 . 114655)) (115599
124200 (MSMARKCHANGED 115609 . 117333) (CHANGEMACRO 117335 . 118040) (CHANGEVAR 118042 . 118358) (
CHANGEI.S. 118360 . 119693) (CHANGERECORD 119695 . 120566) (MSNEEDUNSAVE 120568 . 121560) (UNSAVEFNS
121562 . 124198)) (124633 128123 (%. 124643 . 124783) (MASTERSCOPE 124785 . 125311) (MASTERSCOPE1
125313 . 126181) (MASTERSCOPEXEC 126183 . 128121)) (128162 167812 (MSINTERPRETSET 128172 . 156706) (
MSINTERPA 156708 . 157242) (MSGETBLOCKDEC 157244 . 159757) (LISTHARD 159759 . 160977) (MSMEMBSET
160979 . 161124) (MSLISTSET 161126 . 161491) (MSHASHLIST 161493 . 161660) (MSHASHLIST1 161662 . 161988
) (CHECKPATHS 161990 . 162630) (ONFILE 162632 . 167810)) (167813 191885 (MSINTERPRET 167823 . 184676)
(VERBNOTICELIST 184678 . 185788) (MSOUTPUT 185790 . 187013) (MSCHECKEMPTY 187015 . 188219) (
CHECKFORCHANGED 188221 . 188741) (MSSOLVE 188743 . 191883)))))
(FILEMAP (NIL (3419 19188 (UPDATEFN 3429 . 5046) (MSGETDEF 5048 . 6454) (MSNOTICEFILE 6456 . 8849) (
MSSHOWUSE 8851 . 14354) (MSUPDATEFN1 14356 . 15044) (MSUPDATE 15046 . 17472) (MSNLAMBDACHECK 17474 .
18356) (MSCOLLECTDATA 18358 . 19186)) (19189 20088 (UPDATECHANGED 19199 . 19562) (UPDATECHANGED1 19564
. 20086)) (20662 21085 (MSCLOSEFILES 20672 . 21083)) (21766 26198 (MSDESCRIBE 21776 . 24564) (
MSDESCRIBE1 24566 . 25629) (FMAPRINT 25631 . 26196)) (26291 26731 (MSPRINTHELPFILE 26301 . 26729)) (
26781 29919 (TEMPLATE 26791 . 28212) (GETTEMPLATE 28214 . 28349) (SETTEMPLATE 28351 . 29917)) (30789
35713 (ADDTEMPLATEWORD 30799 . 31471) (MSADDANALYZE 31473 . 32971) (MSADDMODIFIER 32973 . 34054) (
MSADDRELATION 34056 . 34803) (MSADDTYPE 34805 . 35711)) (37214 42435 (MSMARKCHANGE1 37224 . 38018) (
MSINIT 38020 . 39201) (GETVERBTABLES 39203 . 39756) (MSSTOREDATA 39758 . 41437) (STORETABLE 41439 .
42433)) (43836 48906 (PARSERELATION 43846 . 44446) (PARSERELATION1 44448 . 45903) (GETRELATION 45905
. 46934) (MAPRELATION 46936 . 48070) (TESTRELATION 48072 . 48904)) (48907 50547 (ADDHASH 48917 .
49395) (SUBHASH 49397 . 49625) (MAKEHASH 49627 . 49771) (MSREHASH 49773 . 50226) (EQMEMBHASH 50228 .
50545)) (50886 57101 (MSVBTABLES 50896 . 56675) (MSUSERVBTABLES 56677 . 57099)) (57184 59395 (
BUILDGETRELQ 57194 . 58300) (BUILDTESTRELQ 58302 . 59393)) (59566 59954 (MSERASE 59576 . 59952)) (
59955 64415 (DUMPDATABASE 59965 . 62530) (DUMPDATABASE1 62532 . 62877) (READATABASE 62879 . 64413)) (
65497 94556 (MSCHECKBLOCKS 65507 . 69327) (MSCHECKBLOCK 69329 . 77949) (MSCHECKFNINBLOCK 77951 . 80951
) (MSCHECKBLOCKBASIC 80953 . 83373) (MSCHECKBOUNDFREE 83375 . 85274) (GLOBALVARP 85276 . 85443) (
PRINTERROR 85445 . 88661) (MSCHECKVARS1 88663 . 91616) (UNECCSPEC 91618 . 91896) (NECCSPEC 91898 .
92245) (SPECVARP 92247 . 92774) (SHORTLST 92776 . 93232) (DOERROR 93234 . 93944) (MSMSGPRINT 93946 .
94554)) (95700 110528 (MSPATHS 95710 . 99112) (MSPATHS1 99114 . 103349) (MSPATHS2 103351 . 106761) (
MSONPATH 106763 . 107991) (MSPATHS4 107993 . 109075) (DASHES 109077 . 109603) (DOTABS 109605 . 109846)
(BELOWMARKER 109848 . 110311) (MSPATHSPRINTFN 110313 . 110526)) (110914 114338 (MSFIND 110924 .
111199) (MSEDITF 111201 . 112201) (MSEDITE 112203 . 113240) (EDITGETDEF 113242 . 114336)) (115344
123945 (MSMARKCHANGED 115354 . 117078) (CHANGEMACRO 117080 . 117785) (CHANGEVAR 117787 . 118103) (
CHANGEI.S. 118105 . 119438) (CHANGERECORD 119440 . 120311) (MSNEEDUNSAVE 120313 . 121305) (UNSAVEFNS
121307 . 123943)) (124386 127876 (%. 124396 . 124536) (MASTERSCOPE 124538 . 125064) (MASTERSCOPE1
125066 . 125934) (MASTERSCOPEXEC 125936 . 127874)) (127915 167565 (MSINTERPRETSET 127925 . 156459) (
MSINTERPA 156461 . 156995) (MSGETBLOCKDEC 156997 . 159510) (LISTHARD 159512 . 160730) (MSMEMBSET
160732 . 160877) (MSLISTSET 160879 . 161244) (MSHASHLIST 161246 . 161413) (MSHASHLIST1 161415 . 161741
) (CHECKPATHS 161743 . 162383) (ONFILE 162385 . 167563)) (167566 190732 (MSINTERPRET 167576 . 184429)
(VERBNOTICELIST 184431 . 185541) (MSOUTPUT 185543 . 185860) (MSCHECKEMPTY 185862 . 187066) (
CHECKFORCHANGED 187068 . 187588) (MSSOLVE 187590 . 190730)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Dec-2024 14:26:23" {WMEDLEY}<library>PDFSTREAM.;60 14292
(FILECREATED "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59 14133
:EDIT-BY rmk
:CHANGES-TO (FNS SEE-PDF)
:CHANGES-TO (VARS PDFSTREAMCOMS)
:PREVIOUS-DATE "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59)
:PREVIOUS-DATE "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56)
(PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -265,14 +265,12 @@
(DEFINEQ
(SEE-PDF
[LAMBDA (PDFFILE) (* ; "Edited 25-Dec-2024 14:25 by rmk")
(* ; "Edited 1-Oct-2023 20:47 by rmk")
[LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk")
(* ; "Edited 26-Sep-2023 16:52 by rmk")
(* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")
(ShellOpen (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
(ERROR "FILE NOT FOUND" PDFFILE])
(ShellOpen (PACKFILENAME 'BODY PDFFILE 'EXTENSION 'PDF])
)
(ADDTOVAR FB.SEE.METHODS (PDFFILEP SEE-PDF))
@@ -285,8 +283,8 @@
thereis (ShellWhich (CAR TEMPLATE])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3255 5869 (PDFFILEP 3265 . 4179) (PDF.HARDCOPYW 4181 . 4779) (PDF.TEXT 4781 . 5498) (
PDF.TEDIT 5500 . 5867)) (6309 13369 (OPEN-PDF-STREAM 6319 . 8455) (CLOSE-PDF-STREAM 8457 . 9744) (
PS-TO-PDF 9746 . 13367)) (13370 13934 (SEE-PDF 13380 . 13932)) (13985 14269 (PDFCONVERTER 13995 .
14267)))))
(FILEMAP (NIL (3262 5876 (PDFFILEP 3272 . 4186) (PDF.HARDCOPYW 4188 . 4786) (PDF.TEXT 4788 . 5505) (
PDF.TEDIT 5507 . 5874)) (6316 13376 (OPEN-PDF-STREAM 6326 . 8462) (CLOSE-PDF-STREAM 8464 . 9751) (
PS-TO-PDF 9753 . 13374)) (13377 13775 (SEE-PDF 13387 . 13773)) (13826 14110 (PDFCONVERTER 13836 .
14108)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

Binary file not shown.

View File

@@ -1,21 +1,18 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Feb-2025 11:37:42" {WMEDLEY}<library>tedit>TEDIT.;742 154343
(FILECREATED "20-Dec-2024 07:51:49" {WMEDLEY}<library>TEDIT>TEDIT.;731 154713
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.INSERT.OBJECT)
(VARS TEDITCOMS)
:CHANGES-TO (FNS \TEDIT.WORD.FIRST)
:PREVIOUS-DATE "31-Jan-2025 09:36:11" {WMEDLEY}<library>tedit>TEDIT.;741)
:PREVIOUS-DATE " 8-Dec-2024 21:39:48" {WMEDLEY}<library>TEDIT>TEDIT.;730)
(PRETTYCOMPRINT TEDITCOMS)
(RPAQQ TEDITCOMS
[(FILES (SYSLOAD)
POSTSCRIPTSTREAM PDFSTREAM)
(COMS (* ; "Loadup stuff")
[(COMS (* ; "Loadup stuff")
(VARS TEDITFILES)
(FNS MAKE-TEDIT-EXPORTS.ALL UPDATE-TEDIT EDIT-TEDIT)
(DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE
@@ -53,7 +50,8 @@
(FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD
TEDIT.OBJECT.CHANGED TEDIT.MAP.OBJECTS \TEDIT.FIRST.OBJPIECE \TEDIT.NEXT.OBJPIECE)
(FILES IMAGEOBJ))
(FNS \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS \TEDIT.CONCAT.INSTALL.HEADINGS)
(FNS \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS \TEDIT.CONCAT.INSTALL.HEADINGS
\TEDIT.DO.BLUEPENDINGDELETE)
(FNS \TEDIT.MOVE.MSG \TEDIT.READONLY)
(FNS TEDIT.NCHARS TEDIT.RPLCHARCODE TEDIT.NTHCHARCODE TEDIT.NTHCHAR \TEDIT.PIECE.NTHCHARCODE)
@@ -80,9 +78,6 @@
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
(EXTENSION (TEDIT])
(FILESLOAD (SYSLOAD)
POSTSCRIPTSTREAM PDFSTREAM)
(* ; "Loadup stuff")
@@ -747,9 +742,7 @@
(DEFINEQ
(TEDIT.INSERT.OBJECT
[LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 2-Feb-2025 11:37 by rmk")
(* ; "Edited 26-Dec-2024 10:13 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
[LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 2-Aug-2024 08:46 by rmk")
(* ; "Edited 30-Jul-2024 22:19 by rmk")
(* ; "Edited 23-Jul-2024 22:20 by rmk")
@@ -812,8 +805,8 @@
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(CL:WHEN (type? SELECTION CH#)
(SETQ CH# (GETSEL CH# CH#)))
(CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE)
(\TEDIT.DELETE TEXTOBJ SEL T))
(\TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) (* ;
 "Do the pending delete, if there is one.")
(CL:WHEN CH#
(\TEDIT.UPDATE.SEL SEL (IMIN CH# (ADD1 (TEXTLEN TEXTOBJ)))
0
@@ -821,7 +814,7 @@
(\TEDIT.FIXSEL SEL TEXTOBJ))
(\TEDIT.INSERT.SELPIECES OBJSELPIECES TEXTOBJ SEL)
(CL:WHEN LOOKS (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS SEL))
(\TEDIT.SCROLL.CARET TSTREAM)
(TEDIT.NORMALIZECARET TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
(TEDIT.EDIT.OBJECT
@@ -1081,6 +1074,22 @@
REGIONFILLMETHOD _ 'HEADING
REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR R))
REGIONSPEC _ (CADR R])])
(\TEDIT.DO.BLUEPENDINGDELETE
[LAMBDA (SEL TEXTOBJ) (* ; "Edited 27-Nov-2024 12:05 by rmk")
(* ; "Edited 9-Mar-2024 11:33 by rmk")
(* ; "Edited 24-Dec-2023 00:01 by rmk")
(* ; "Edited 8-Jul-2023 22:48 by rmk")
(* ; "Edited 4-May-2023 00:05 by rmk")
(* ; "Edited 22-Apr-2023 18:31 by rmk")
(* ; "Edited 29-May-91 18:21 by jds")
(* ;; "Check for blue-pending-delete, and do it if it's there.")
(* ;; "Return T if the deletion was made. For people who need to know")
(CL:WHEN (GETTOBJ TEXTOBJ BLUEPENDINGDELETE)
(\TEDIT.DELETE TEXTOBJ SEL T])
)
(DEFINEQ
@@ -1411,8 +1420,7 @@
(T TSTREAM)))])
(\TEDIT.INSERT
[LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 5-Jan-2025 23:01 by rmk")
(* ; "Edited 28-Nov-2024 09:53 by rmk")
[LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 28-Nov-2024 09:53 by rmk")
(* ; "Edited 25-Nov-2024 22:05 by rmk")
(* ; "Edited 18-Nov-2024 15:53 by rmk")
(* ; "Edited 15-Nov-2024 18:05 by rmk")
@@ -1464,7 +1472,7 @@
(* ;; "It's maybe worth a scan here to see if we can insert the string. This avoids the heavier per-character complexity of \INSERTCH.")
(for CH instring INSERT as NCH# from CARETCHNO
do (\TEDIT.INSERTCH CH NCH# TEXTOBJ (MEMB CH PARACHARS)))
do (\TEDIT.INSERTCH CH NCH# TEXTOBJ PARACHARS))
(SETQ NCHARSADDED (NCHARS INSERT))
else (\TEDIT.INSERTCH INSERT CARETCHNO TEXTOBJ)
(SETQ NCHARSADDED (NCHARS INSERT)))
@@ -2225,9 +2233,7 @@
SPLASTCHAR _ (CAR LAST])
(\TEDIT.PARA.FIRST
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 30-Jan-2025 12:02 by rmk")
(* ; "Edited 11-Jan-2025 00:08 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 19-Jan-2024 10:10 by rmk")
(* ; "Edited 26-Dec-2023 09:14 by rmk")
(* ; "Edited 24-Dec-2023 22:14 by rmk")
@@ -2240,8 +2246,8 @@
else (LET (CHPIECE START-OF-PIECE START)
(DECLARE (SPECVARS START-OF-PIECE))
(if (type? SELPIECES CHNO)
then (SETQ CHPIECE (GETSPC CHNO SPFIRST))
(SETQ START (GETSPC CHNO SPFIRSTCHAR))
then (SETQ CHPIECE (fetch (SELPIECES SPFIRST) of CHNO))
(SETQ START (fetch (SELPIECES SPFIRSTCHAR) of CHNO))
elseif (type? PIECE CHNO)
then (SETQ START (\TEDIT.PCTOCH CHNO TEXTOBJ))
(SETQ CHPIECE CHNO)
@@ -2256,20 +2262,19 @@
(for PC (PLENTOT _ 0) backpieces (AND CHPIECE (PREVPIECE CHPIECE))
when (VISIBLEPIECEP PC) until (PPARALAST PC)
until (AND PROTECTEDNOTOK (GETCLOOKS (PLOOKS PC)
CLPROTECTED)) do (add PLENTOT (PLEN PC))
finally
until (AND PROTECTEDNOTOK (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)))
do (add PLENTOT (PLEN PC)) finally
(* ;; "If the iteration reached the beginning, there is no PREVPIECE. Otherwise, PC is the previous PARALAST, and we have to take its next")
(* ;;
 "We overshot on PC, its NEXT is the winner. If no PC, we hit the text beginning")
(RETURN (CONS (IDIFFERENCE START PLENTOT)
(CL:IF PC
(NEXTPIECE PC)
(\TEDIT.FIRSTPIECE TEXTOBJ))])
(RETURN (CONS (IDIFFERENCE START PLENTOT)
(CL:IF PC
(NEXTPIECE PC)
(\TEDIT.FIRSTPIECE TEXTOBJ))])
(\TEDIT.PARA.LAST
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 31-Jan-2025 09:33 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
[LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 19-Jan-2024 10:37 by rmk")
(* ; "Edited 26-Dec-2023 09:14 by rmk")
(* ; "Edited 24-Dec-2023 22:16 by rmk")
@@ -2283,16 +2288,15 @@
else (LET (CHPIECE START-OF-PIECE END FORMATTED)
(DECLARE (SPECVARS START-OF-PIECE))
(if (type? SELPIECES CHNO)
then (SETQ CHPIECE (GETSPC CHNO SPLAST))
[SETQ END (SUB1 (IDIFFERENCE (GETSPC CHNO SPLASTCHAR)
then (SETQ CHPIECE (fetch (SELPIECES SPLAST) of CHNO))
[SETQ END (SUB1 (IDIFFERENCE (fetch (SELPIECES SPLASTCHAR) of CHNO)
(PLEN CHPIECE]
elseif (type? PIECE CHNO)
then (SETQ CHPIECE CHNO)
(SETQ END (\TEDIT.PCTOCH CHNO TEXTOBJ))
else (SETQ CHPIECE (\TEDIT.CHTOPC (IMIN (CL:IF (type? SELECTION CHNO)
(FGETSEL CHNO CHLAST)
CHNO)
(TEXTLEN TEXTOBJ))
else (SETQ CHPIECE (\TEDIT.CHTOPC (CL:IF (type? SELECTION CHNO)
(SUB1 (FGETSEL CHNO CHLIM))
CHNO)
TEXTOBJ T))
(SETQ END START-OF-PIECE)) (* ; "Find the paragraph's last char")
@@ -2300,8 +2304,7 @@
(for PC (PLENTOT _ 0) inpieces CHPIECE when (VISIBLEPIECEP PC)
do (add PLENTOT (PLEN PC)) repeatuntil (PPARALAST PC)
repeatuntil (AND PROTECTEDNOTOK (FGETCLOOKS (PLOOKS PC)
CLPROTECTED))
repeatuntil (AND PROTECTEDNOTOK (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)))
finally (RETURN (CONS (IMIN (IPLUS END PLENTOT -1)
(FGETTOBJ TEXTOBJ TEXTLEN))
PC])
@@ -2475,7 +2478,7 @@
(* ; "TEDIT Support information")
(RPAQQ TEDITSYSTEMDATE " 2-Feb-2025 11:37:42")
(RPAQQ TEDITSYSTEMDATE "20-Dec-2024 07:51:50")
@@ -2485,27 +2488,28 @@
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
(EXTENSION (TEDIT))))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4627 6569 (MAKE-TEDIT-EXPORTS.ALL 4637 . 5183) (UPDATE-TEDIT 5185 . 5798) (EDIT-TEDIT
5800 . 6567)) (8242 36697 (TEDIT 8252 . 10830) (TEXTSTREAM 10832 . 12752) (TEXTSTREAMP 12754 . 13138)
(TEDITMENUP 13140 . 13906) (COERCETEXTSTREAM 13908 . 18119) (TEDIT.CONCAT 18121 . 21300) (TEDITSTRING
21302 . 22155) (TEDIT-SEE 22157 . 22716) (TEDIT.COPY 22718 . 24863) (TEDIT.DELETE 24865 . 26117) (
TEDIT.INSERT 26119 . 29077) (TEDIT.TERPRI 29079 . 30193) (TEDIT.KILL 30195 . 31111) (TEDIT.QUIT 31113
. 32888) (TEDIT.MOVE 32890 . 33778) (TEDIT.STRINGWIDTH 33780 . 34451) (TEDIT.CHARWIDTH 34453 . 36695)
) (36698 38639 (TEXTOBJ 36708 . 37173) (COERCETEXTOBJ 37175 . 38637)) (40039 41095 (TDRIBBLE 40049 .
41093)) (41136 56240 (TEDIT.INSERT.OBJECT 41146 . 45880) (TEDIT.EDIT.OBJECT 45882 . 48223) (
TEDIT.FIND.OBJECT 48225 . 49733) (TEDIT.FIND.OBJECT.BACKWARD 49735 . 51662) (TEDIT.OBJECT.CHANGED
51664 . 54531) (TEDIT.MAP.OBJECTS 54533 . 55768) (\TEDIT.FIRST.OBJPIECE 55770 . 56003) (
\TEDIT.NEXT.OBJPIECE 56005 . 56238)) (56263 63773 (\TEDIT.CONCAT.PAGEFRAMES 56273 . 61407) (
\TEDIT.GET.PAGE.HEADINGS 61409 . 62438) (\TEDIT.CONCAT.INSTALL.HEADINGS 62440 . 63771)) (63774 67203 (
\TEDIT.MOVE.MSG 63784 . 65865) (\TEDIT.READONLY 65867 . 67201)) (67204 81825 (TEDIT.NCHARS 67214 .
67587) (TEDIT.RPLCHARCODE 67589 . 75389) (TEDIT.NTHCHARCODE 75391 . 77748) (TEDIT.NTHCHAR 77750 .
78008) (\TEDIT.PIECE.NTHCHARCODE 78010 . 81823)) (81871 136253 (\TEDIT1 81881 . 83958) (\TEDIT.INSERT
83960 . 89937) (\TEDIT.MOVE 89939 . 97338) (\TEDIT.COPY 97340 . 101318) (\TEDIT.REPLACE.SELPIECES
101320 . 105300) (\TEDIT.INSERT.SELPIECES 105302 . 108187) (\TEDIT.RESTARTFN 108189 . 110694) (
\TEDIT.CHARDELETE 110696 . 113523) (\TEDIT.COPYPIECE 113525 . 118373) (\TEDIT.APPLY.OBJFN 118375 .
121572) (\TEDIT.DELETE 121574 . 126383) (\TEDIT.DIFFUSE.PARALOOKS 126385 . 128656) (\TEDIT.WORDDELETE
128658 . 130214) (\TEDIT.WORDDELETE.FORWARD 130216 . 131888) (\TEDIT.FINISHEDIT? 131890 . 136251)) (
136254 136913 (\TEDIT.THELP 136264 . 136911)) (136947 144727 (\TEDIT.PARAPIECES 136957 . 138931) (
\TEDIT.PARA.FIRST 138933 . 141800) (\TEDIT.PARA.LAST 141802 . 144725)) (144728 153693 (
\TEDIT.WORD.FIRST 144738 . 149394) (\TEDIT.WORD.LAST 149396 . 153691)))))
(FILEMAP (NIL (4507 6449 (MAKE-TEDIT-EXPORTS.ALL 4517 . 5063) (UPDATE-TEDIT 5065 . 5678) (EDIT-TEDIT
5680 . 6447)) (8122 36577 (TEDIT 8132 . 10710) (TEXTSTREAM 10712 . 12632) (TEXTSTREAMP 12634 . 13018)
(TEDITMENUP 13020 . 13786) (COERCETEXTSTREAM 13788 . 17999) (TEDIT.CONCAT 18001 . 21180) (TEDITSTRING
21182 . 22035) (TEDIT-SEE 22037 . 22596) (TEDIT.COPY 22598 . 24743) (TEDIT.DELETE 24745 . 25997) (
TEDIT.INSERT 25999 . 28957) (TEDIT.TERPRI 28959 . 30073) (TEDIT.KILL 30075 . 30991) (TEDIT.QUIT 30993
. 32768) (TEDIT.MOVE 32770 . 33658) (TEDIT.STRINGWIDTH 33660 . 34331) (TEDIT.CHARWIDTH 34333 . 36575)
) (36578 38519 (TEXTOBJ 36588 . 37053) (COERCETEXTOBJ 37055 . 38517)) (39919 40975 (TDRIBBLE 39929 .
40973)) (41016 55977 (TEDIT.INSERT.OBJECT 41026 . 45617) (TEDIT.EDIT.OBJECT 45619 . 47960) (
TEDIT.FIND.OBJECT 47962 . 49470) (TEDIT.FIND.OBJECT.BACKWARD 49472 . 51399) (TEDIT.OBJECT.CHANGED
51401 . 54268) (TEDIT.MAP.OBJECTS 54270 . 55505) (\TEDIT.FIRST.OBJPIECE 55507 . 55740) (
\TEDIT.NEXT.OBJPIECE 55742 . 55975)) (56000 64557 (\TEDIT.CONCAT.PAGEFRAMES 56010 . 61144) (
\TEDIT.GET.PAGE.HEADINGS 61146 . 62175) (\TEDIT.CONCAT.INSTALL.HEADINGS 62177 . 63508) (
\TEDIT.DO.BLUEPENDINGDELETE 63510 . 64555)) (64558 67987 (\TEDIT.MOVE.MSG 64568 . 66649) (
\TEDIT.READONLY 66651 . 67985)) (67988 82609 (TEDIT.NCHARS 67998 . 68371) (TEDIT.RPLCHARCODE 68373 .
76173) (TEDIT.NTHCHARCODE 76175 . 78532) (TEDIT.NTHCHAR 78534 . 78792) (\TEDIT.PIECE.NTHCHARCODE 78794
. 82607)) (82655 136918 (\TEDIT1 82665 . 84742) (\TEDIT.INSERT 84744 . 90602) (\TEDIT.MOVE 90604 .
98003) (\TEDIT.COPY 98005 . 101983) (\TEDIT.REPLACE.SELPIECES 101985 . 105965) (
\TEDIT.INSERT.SELPIECES 105967 . 108852) (\TEDIT.RESTARTFN 108854 . 111359) (\TEDIT.CHARDELETE 111361
. 114188) (\TEDIT.COPYPIECE 114190 . 119038) (\TEDIT.APPLY.OBJFN 119040 . 122237) (\TEDIT.DELETE
122239 . 127048) (\TEDIT.DIFFUSE.PARALOOKS 127050 . 129321) (\TEDIT.WORDDELETE 129323 . 130879) (
\TEDIT.WORDDELETE.FORWARD 130881 . 132553) (\TEDIT.FINISHEDIT? 132555 . 136916)) (136919 137578 (
\TEDIT.THELP 136929 . 137576)) (137612 145097 (\TEDIT.PARAPIECES 137622 . 139596) (\TEDIT.PARA.FIRST
139598 . 142364) (\TEDIT.PARA.LAST 142366 . 145095)) (145098 154063 (\TEDIT.WORD.FIRST 145108 . 149764
) (\TEDIT.WORD.LAST 149766 . 154061)))))
STOP

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Jan-2025 13:03:46" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;213 124294
(FILECREATED "22-Dec-2024 22:47:22" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;200 119344
:EDIT-BY rmk
:CHANGES-TO (FNS MB.BUTTONEVENTINFN MB.CREATE MB.GET MB.FIELD.CREATE MB.FIELD.PREFIXCREATE)
:CHANGES-TO (FNS MB.3STATE.BUTTONEVENTINFN)
:PREVIOUS-DATE " 9-Jan-2025 16:52:13" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;208)
:PREVIOUS-DATE "20-Dec-2024 22:19:48" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;198)
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
@@ -24,6 +24,7 @@
(FNS MB.BUTTONEVENTINFN MB.DISPLAYFN MB.SETIMAGE MB.SIZEFN MB.WHENOPERATEDONFN
MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MB.CREATE MB.CHANGENAME MB.INIT
MB.TRACK.UNTIL MB.DON'T)
(GLOBALVARS MB.IMAGEFNS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.INIT]
[COMS (* ; "3STATE")
@@ -31,6 +32,7 @@
(FNS MB.3STATE.CREATE MB.3STATE.DISPLAYFN MB.3STATE.SHOWSELFN MB.3STATE.INIT
MB.3STATE.SETSTATEFN MB.3STATE.BUTTONEVENTINFN)
(GLOBALVARS MB.3STATE.IMAGEFNS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.3STATE.INIT]
[COMS (* ; "NWAY")
@@ -40,15 +42,18 @@
MB.NWAY.SELECT MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN
MB.NWAY.INIT MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ
MB.NWAY.SETSTATEFN)
(GLOBALVARS MB.NWAY.IMAGEFNS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT]
[COMS (* ; "TOGGLE")
(FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE
MB.TOGGLE.SETSTATEFN MB.TOGGLE.BUTTONEVENTINFN MB.TOGGLE.WHENOPERATEDONFN)
(GLOBALVARS MB.TOGGLE.IMAGEFNS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.TOGGLE.INIT]
(COMS (* ; "FIELDS")
(FNS MB.FIELD.CREATE MB.FIELD.DISPLAYFN MB.FIELD.IMAGEBOXFN MB.FIELD.PREFIXCREATE
MB.FIELD.SUFFIXCREATE MB.FIELD.INIT MB.FIELD.WHENOPERATEDONFN MB.FIELD.GETSTATEFN
MB.FIELD.SETSTATEFN MB.FIELD.BUTTONEVENTINFN MB.FIELD.SIZEFN MB.FIELD.INSURETYPE)
(GLOBALVARS MB.FIELD.IMAGEFNS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.FIELD.INIT])
@@ -67,8 +72,7 @@
(DEFINEQ
(MB.ADD
[LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES) (* ; "Edited 5-Jan-2025 11:36 by rmk")
(* ; "Edited 22-Oct-2024 09:16 by rmk")
[LAMBDA (MENUDESC MENUTSTREAM WHERE) (* ; "Edited 22-Oct-2024 09:16 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 18-Oct-2024 13:49 by rmk")
(* ; "Edited 6-Oct-2024 15:25 by rmk")
@@ -88,80 +92,73 @@
(* ;; "Returns the textstream character number of the character just after the last inserted character/object.")
(RESETLST
(CL:UNLESS INCREMENTALUPDATES (TEDIT.DEFER.UPDATES MENUTSTREAM))
(for DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL]
[TAB _ (CONCATCODES (CHARCODE (TAB]
(CH# _ (if (NULL WHERE)
then (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ)))
elseif (FIXP WHERE)
else (\ILLEGAL.ARG WHERE))) in MENUDESC declare (SPECVARS CH#)
do (SETQ DESC (MKLIST DESC)) (* ; "MKLIST for EOL/TAB, FIXP")
(SETQ TYPE (CAR DESC))
(SETQ SPEC (CDR DESC))
(SELECTQ TYPE
( (* ; ;; NIL)
(for DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL]
[TAB _ (CONCATCODES (CHARCODE (TAB]
(CH# _ (if (NULL WHERE)
then (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ)))
elseif (FIXP WHERE)
else (\ILLEGAL.ARG WHERE))) in MENUDESC declare (SPECVARS CH#)
do (SETQ DESC (MKLIST DESC)) (* ; "MKLIST for EOL/TAB, FIXP")
(SETQ TYPE (CAR DESC))
(SETQ SPEC (CDR DESC))
(SELECTQ TYPE
( (* ; ;; NIL)
(* ;
 "Ignore comments within menu descriptions")
)
(EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON))
(add CH# 1))
(TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON))
(add CH# 1))
(ACTION (* ; "Hitting calls a function")
(TEDIT.INSERT.OBJECT (MB.CREATE SPEC)
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(3STATE (* ;
)
(EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON))
(add CH# 1))
(TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON))
(add CH# 1))
(ACTION (* ; "Hitting calls a function")
(TEDIT.INSERT.OBJECT (MB.CREATE SPEC)
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(3STATE (* ;
 "3-state button; hitting it changes state among ON, OFF, and NEUTRAL.")
(TEDIT.INSERT.OBJECT (MB.3STATE.CREATE SPEC)
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(TOGGLE (* ;
(TEDIT.INSERT.OBJECT (MB.3STATE.CREATE SPEC)
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(TOGGLE (* ;
 "TOGGLE button; hitting it switches between ON and OFF.")
(TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE SPEC)
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(NWAY (* ;
(TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE SPEC)
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(NWAY (* ;
 "N-way buttons; choosing one turns the others off.")
(SETQ OBJ (MB.NWAY.CREATE SPEC))
(TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(TEXT (* ; "Arbitrary protected text.")
[TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC))
CH#
(CL:IF (CADR (ASSOC 'FONT SPEC))
`(FONT ,(CADR (ASSOC 'FONT SPEC))
PROTECTED ON)
'(PROTECTED ON))]
[add CH# (NCHARS (CADR (ASSOC 'STRING SPEC])
(FIELD (SETQ CH# (MB.FIELD.CREATE SPEC MENUTSTREAM CH#)))
(MENU (* ;
(SETQ OBJ (MB.NWAY.CREATE SPEC))
(TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(TEXT (* ; "Arbitrary protected text.")
[TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC))
CH#
(CL:IF (CADR (ASSOC 'FONT SPEC))
`(FONT ,(CADR (ASSOC 'FONT SPEC))
PROTECTED ON)
'(PROTECTED ON))]
[add CH# (NCHARS (CADR (ASSOC 'STRING SPEC])
(FIELD (SETQ CH# (MB.FIELD.CREATE SPEC MENUTSTREAM CH#)))
(MENU (* ;
 "Real menu, except the selection sticks")
(\TEDIT.THELP "NOT IMPLEMENTED")
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC))
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(if (STRINGP TYPE)
then (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON))
(add CH# (NCHARS TYPE))
elseif (FIXP TYPE)
then (* ; "TYPE spaces")
(TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE))
CH#
'(PROTECTED ON))
(add CH# TYPE)
elseif (LISTP TYPE)
then
(* ;; "Form to be evaluated")
(\TEDIT.THELP "NOT IMPLEMENTED")
(TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC))
MENUTSTREAM CH# '(PROTECTED OFF))
(add CH# 1))
(if (STRINGP TYPE)
then (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON))
(add CH# (NCHARS TYPE))
elseif (FIXP TYPE)
then (* ; "TYPE spaces")
(TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE))
CH#
'(PROTECTED ON))
(add CH# TYPE)
elseif (LISTP TYPE)
then
(* ;; "Form to be evaluated")
(add CH# (EVAL TYPE))
else (\ILLEGAL.ARG DESC))) finally (\TEDIT.SHOWSEL NIL NIL MENUTSTREAM)
(* ;
 "User has to click to get a selection")
(SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ))
SET NIL)
(RETURN CH#)))])
(add CH# (EVAL TYPE))
else (\ILLEGAL.ARG DESC))) finally (RETURN CH#])
(MB.DELETE
[LAMBDA (IDENTIFIERS MENUSTREAM) (* ; "Edited 8-Nov-2024 08:58 by rmk")
@@ -171,8 +168,7 @@
(CAR CHNOS])
(MB.GET
[LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "Edited 11-Jan-2025 20:49 by rmk")
(* ; "Edited 13-Dec-2024 09:24 by rmk")
[LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "Edited 13-Dec-2024 09:24 by rmk")
(* ; "Edited 2-Dec-2024 09:41 by rmk")
(* ; "Edited 7-Nov-2024 22:20 by rmk")
(* ; "Edited 22-Oct-2024 22:02 by rmk")
@@ -255,9 +251,9 @@
(ERROR R " is not a button return"))
finally (CL:UNLESS (CDR RETURNS)
(RETURN (CAR $$VAL)))])
(CL:IF (LISTP IDENTIFIERS)
RESULT
(CADR RESULT))))])
(CL:IF (LITATOM IDENTIFIERS)
(CADR RESULT)
RESULT)))])
(MB.GET.MBARG
[LAMBDA (IDPC MENUSTREAM) (* ; "Edited 17-Dec-2024 11:54 by rmk")
@@ -319,8 +315,6 @@
(MB.BUTTONEVENTINFN
[LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON)
(* ; "Edited 12-Jan-2025 13:03 by rmk")
(* ; "Edited 28-Dec-2024 20:21 by rmk")
(* ; "Edited 22-Aug-2024 16:26 by rmk")
(* ; "Edited 20-Aug-2024 10:04 by rmk")
(* ; "Edited 20-Jul-2024 15:26 by rmk")
@@ -329,10 +323,8 @@
(* ;; "Called when a mouse-button is down inside the object, RELX and RELY are in the objects coordinate system. Decline unless it is a normal left-button selection within the object.")
(TEDIT.PROMPTCLEAR MENUSTREAM)
(if [OR (EQ BUTTON 'RIGHT)
(SHIFTDOWNP 'CTRL)
(SHIFTDOWNP 'SHIFT)
(LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
(OR (ILESSP RELX 0)
(ILESSP RELY 0)
@@ -523,11 +515,7 @@
'INVERT))])
(MB.CREATE
[LAMBDA (SPEC IMAGEFNS) (* ; "Edited 12-Jan-2025 12:35 by rmk")
(* ; "Edited 9-Jan-2025 16:51 by rmk")
(* ; "Edited 6-Jan-2025 00:19 by rmk")
(* ; "Edited 4-Jan-2025 16:29 by rmk")
(* ; "Edited 18-Oct-2024 10:27 by rmk")
[LAMBDA (SPEC IMAGEFNS) (* ; "Edited 18-Oct-2024 10:27 by rmk")
(* ; "Edited 6-Oct-2024 16:59 by rmk")
(* ; "Edited 5-Oct-2024 11:51 by rmk")
(* ; "Edited 29-Sep-2024 14:51 by rmk")
@@ -544,34 +532,25 @@
(* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields. ")
(for S PROP VAL IDENTIFIER LABEL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS
(CADR (ASSOC 'IMAGEFNS SPEC))
MB.IMAGEFNS))) in SPEC
(for S PROP VAL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS (CADR (ASSOC 'IMAGEFNS SPEC))
MB.IMAGEFNS))) in SPEC
eachtime (SETQ PROP (MKATOM (CAR S)))
(SETQ VAL (CADR S)) unless (EQ PROP 'IMAGEFNS)
do (SELECTQ PROP
(FONT [SETQ VAL (FONTCREATE (FONTCREATE VAL NIL NIL NIL 'DISPLAY])
(LABEL (SETQ LABEL (SETQ VAL (MKSTRING VAL))))
(IDENTIFIER (SETQ IDENTIFIER VAL)
(GO $$ITERATE))
((LABEL IDENTIFIER)
(SETQ VAL (MKATOM VAL)))
NIL)
(IMAGEOBJPROP OBJ PROP VAL)
finally (CL:UNLESS (IMAGEOBJPROP OBJ 'FONT)
(IMAGEOBJPROP OBJ 'FONT (FONTCREATE '(HELVETICA 8 BOLD)
NIL NIL NIL 'DISPLAY)))
(if (NULL IDENTIFIER)
then (if LABEL
then [SETQ IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab
#\Newline #\:
)
LABEL]
else (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC)))
elseif (OR (LITATOM IDENTIFIER)
(SMALLP IDENTIFIER))
elseif (STRINGP IDENTIFIER)
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
else (\ILLEGAL.ARG VAL))
(IMAGEOBJPROP OBJ 'IDENTIFIER IDENTIFIER)
(CL:UNLESS (IMAGEOBJPROP OBJ 'IDENTIFIER)
(if (SETQ VAL (IMAGEOBJPROP OBJ 'LABEL))
then [IMAGEOBJPROP OBJ 'IDENTIFIER
(U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline #\:)
VAL]
else (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC))))
(CL:WHEN (IMAGEOBJPROP OBJ 'INITSTATE)
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP OBJ 'INITSTATE)))
(MB.SETIMAGE OBJ)
@@ -590,14 +569,12 @@
(TEDIT.OBJECT.CHANGED TEXTOBJ OBJ])
(MB.INIT
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:49 by rmk")
(* ; "Edited 7-Dec-2024 09:05 by rmk")
[LAMBDA NIL (* ; "Edited 7-Dec-2024 09:05 by rmk")
(* ; "Edited 28-Aug-2024 23:34 by rmk")
(* ; "Edited 24-Aug-2024 11:00 by rmk")
(* ; "Edited 20-Aug-2024 15:23 by rmk")
(* ; "Edited 18-Feb-2024 14:15 by rmk")
(* jds "12-Feb-85 14:32")
(DECLARE (GLOBALVARS MB.IMAGEFNS))
(SETQ MB.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAYFN)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
@@ -634,6 +611,10 @@
(CL:UNLESS (IMAGEOBJPROP OBJ 'DELETABLE)
'DON'T])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MB.IMAGEFNS)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MB.INIT)
@@ -715,8 +696,7 @@
NIL])
(MB.3STATE.INIT
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:49 by rmk")
(* ; "Edited 7-Dec-2024 12:38 by rmk")
[LAMBDA NIL (* ; "Edited 7-Dec-2024 12:38 by rmk")
(* ; "Edited 18-Oct-2024 11:40 by rmk")
(* ; "Edited 25-Aug-2024 23:11 by rmk")
(* ; "Edited 20-Aug-2024 15:36 by rmk")
@@ -724,7 +704,6 @@
(* ;; "Initialize the IMAGEFNS for 3-state menu button IMAGEOBJs")
(DECLARE (GLOBALVARS MB.3STATE.IMAGEFNS))
(SETQ MB.3STATE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.3STATE.DISPLAYFN)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
@@ -799,6 +778,10 @@
(TEDIT.BACKTOMAIN MENUTSTREAM)))
'DON'T])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MB.3STATE.IMAGEFNS)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MB.3STATE.INIT)
@@ -816,9 +799,7 @@
(DEFINEQ
(MB.NWAY.CREATE
[LAMBDA (SPEC) (* ; "Edited 9-Jan-2025 11:38 by rmk")
(* ; "Edited 4-Jan-2025 21:39 by rmk")
(* ; "Edited 20-Dec-2024 22:17 by rmk")
[LAMBDA (SPEC) (* ; "Edited 20-Dec-2024 22:17 by rmk")
(* ; "Edited 22-Oct-2024 00:26 by rmk")
(* ; "Edited 29-Sep-2024 12:43 by rmk")
(* ; "Edited 31-Aug-2024 14:57 by rmk")
@@ -843,11 +824,6 @@
(DONTAPPLY (CADR (ASSOC 'DONTAPPLY SPEC)))
(OBJ (IMAGEOBJCREATE NIL MB.NWAY.IMAGEFNS))
SPACING HEIGHT SUBOBJECTS)
(if (AND IDENTIFIER (LITATOM IDENTIFIER))
elseif (STRINGP IDENTIFIER)
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
else (\ILLEGAL.ARG IDENTIFIER))
(SETQ IDENTIFIER IDENTIFIER)
(SETQ SPACING (STRINGWIDTH " " FONT))
[SETQ HEIGHT (IPLUS 2 (FONTPROP FONT 'HEIGHT]
(CL:UNLESS (LISTP BUTTONS)
@@ -1010,9 +986,7 @@
BOX])
(MB.NWAY.SELECT
[LAMBDA (OBJ SELECTED MENUWINDOW SEL) (* ; "Edited 3-Jan-2025 12:56 by rmk")
(* ; "Edited 1-Jan-2025 12:30 by rmk")
(* ; "Edited 29-Sep-2024 12:44 by rmk")
[LAMBDA (OBJ SELECTED MENUWINDOW SEL) (* ; "Edited 29-Sep-2024 12:44 by rmk")
(* ; "Edited 24-Aug-2024 15:28 by rmk")
(* ; "Edited 20-Aug-2024 15:13 by rmk")
(* ; "Edited 2-Aug-2024 00:28 by rmk")
@@ -1028,37 +1002,29 @@
(CL:WHEN (AND SELECTED (NEQ SELECTED T)
(LITATOM SELECTED))
(SETQ SELECTED (MB.NWAY.FINDSUBOBJ SELECTED OBJ)))
(if (AND NIL (EQ OLDSELECTED SELECTED))
then (IMAGEOBJPROP OBJ 'STATE 'OFF) (* ;
 "Reclicking the current selection turns it off. ")
(IMAGEOBJPROP OBJ 'SELECTED NIL)
(CL:WHEN MENUWINDOW
(BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
(IMAGEOBJPROP OLDSELECTED 'Y)
NIL NIL 'INPUT 'REPLACE))
else (CL:WHEN (AND OLDSELECTED SELECTED) (* ;
(CL:UNLESS (EQ OLDSELECTED SELECTED) (* ; "Reclicking is a no-op. ")
(CL:WHEN (AND OLDSELECTED SELECTED) (* ;
 "Turn the old one off if it's changing")
(IMAGEOBJPROP OLDSELECTED 'STATE 'OFF)
(CL:WHEN MENUWINDOW
(BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
(IMAGEOBJPROP OLDSELECTED 'Y)
NIL NIL 'INPUT 'REPLACE))
(IMAGEOBJPROP OBJ 'STATE NIL)
(IMAGEOBJPROP OBJ 'SELECTED NIL))
(CL:WHEN (AND SELECTED (NEQ T SELECTED)) (* ; "Turn on the new one.")
(IMAGEOBJPROP SELECTED 'STATE 'ON)
(CL:WHEN MENUWINDOW
(BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE)
0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X)
(IMAGEOBJPROP SELECTED 'Y)
NIL NIL 'INVERT 'REPLACE))
(IMAGEOBJPROP OBJ 'SELECTED SELECTED)
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER))
(CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN)
(APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
OBJ SELECTED SEL MENUWINDOW)))])
(IMAGEOBJPROP OLDSELECTED 'STATE 'OFF)
(CL:WHEN MENUWINDOW
(BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE)
0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X)
(IMAGEOBJPROP OLDSELECTED 'Y)
NIL NIL 'INPUT 'REPLACE))
(IMAGEOBJPROP OBJ 'STATE NIL)
(IMAGEOBJPROP OBJ 'SELECTED NIL))
(CL:WHEN (AND SELECTED (NEQ T SELECTED)) (* ; "Turn on the new one.")
(IMAGEOBJPROP SELECTED 'STATE 'ON)
(CL:WHEN MENUWINDOW
(BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE)
0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X)
(IMAGEOBJPROP SELECTED 'Y)
NIL NIL 'INVERT 'REPLACE))
(IMAGEOBJPROP OBJ 'SELECTED SELECTED)
(IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER))
(CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN)
(APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN)
OBJ SELECTED SEL MENUWINDOW))))])
(MB.NWAY.BUTTONEVENTINFN
[LAMBDA (OBJ MENUDS SEL RELX RELY SELWINDOW MENUTSTREAM BUTTON)
@@ -1139,8 +1105,7 @@
NEWOBJ])
(MB.NWAY.INIT
[LAMBDA (BUTTONS FONT INITSTATE) (* ; "Edited 7-Jan-2025 22:50 by rmk")
(* ; "Edited 7-Dec-2024 09:05 by rmk")
[LAMBDA (BUTTONS FONT INITSTATE) (* ; "Edited 7-Dec-2024 09:05 by rmk")
(* ; "Edited 24-Aug-2024 23:11 by rmk")
(* ; "Edited 20-Aug-2024 16:41 by rmk")
(* ; "Edited 11-Aug-2024 17:13 by rmk")
@@ -1148,7 +1113,6 @@
(* ;; "Selection happens in the BUTTEVENTINFN, no WHENOPERATEDONFN")
(DECLARE (GLOBALVARS MB.NWAY.IMAGEFNS))
(SETQ MB.NWAY.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NWAY.DISPLAYFN)
(FUNCTION MB.NWAY.SIZEFN)
(FUNCTION MB.PUTFN)
@@ -1191,8 +1155,7 @@
(RETURN (DREVERSE LINES])
(MB.NWAY.ADDITEM
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 9-Jan-2025 11:38 by rmk")
(* ; "Edited 20-Oct-2024 00:13 by rmk")
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 20-Oct-2024 00:13 by rmk")
(* ; "Edited 29-Sep-2024 12:47 by rmk")
(* ; "Edited 26-Aug-2024 09:36 by rmk")
(* ; "Edited 20-Aug-2024 15:46 by rmk")
@@ -1206,7 +1169,7 @@
(CL:WHEN NEWBUTTON
(LET* [(SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS))
[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,NEWBUTTON)
[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,(U-CASE NEWBUTTON))
(LABEL ,NEWBUTTON)
(FONT ,(IMAGEOBJPROP OBJ 'FONT]
(MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE]
@@ -1267,6 +1230,10 @@
(TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC))
PC])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MB.NWAY.IMAGEFNS)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MB.NWAY.INIT)
@@ -1319,8 +1286,7 @@
(BLTSHADE BLACKSHADE STREAM X Y XSIZE YSIZE 'INVERT))])
(MB.TOGGLE.INIT
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:50 by rmk")
(* ; "Edited 7-Dec-2024 12:33 by rmk")
[LAMBDA NIL (* ; "Edited 7-Dec-2024 12:33 by rmk")
(* ; "Edited 19-Oct-2024 23:21 by rmk")
(* ; "Edited 18-Oct-2024 13:27 by rmk")
(* ; "Edited 6-Oct-2024 23:43 by rmk")
@@ -1328,7 +1294,6 @@
(* ; "Edited 24-Aug-2024 10:56 by rmk")
(* ; "Edited 20-Aug-2024 15:47 by rmk")
(* jds " 9-Feb-86 15:18")
(DECLARE (GLOBALVARS MB.TOGGLE.IMAGEFNS))
(SETQ MB.TOGGLE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.TOGGLE.DISPLAYFN)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
@@ -1453,6 +1418,10 @@
((DESELECTED HIGHLIGHTED UNHIGHLIGHTED))
NIL])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MB.TOGGLE.IMAGEFNS)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MB.TOGGLE.INIT)
@@ -1465,10 +1434,7 @@
(DEFINEQ
(MB.FIELD.CREATE
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 11-Jan-2025 09:59 by rmk")
(* ; "Edited 9-Jan-2025 16:52 by rmk")
(* ; "Edited 5-Jan-2025 12:09 by rmk")
(* ; "Edited 16-Dec-2024 13:33 by rmk")
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Dec-2024 13:33 by rmk")
(* ; "Edited 9-Dec-2024 21:53 by rmk")
(* ; "Edited 4-Dec-2024 15:57 by rmk")
(* ; "Edited 20-Oct-2024 23:43 by rmk")
@@ -1496,24 +1462,22 @@
[FIELDFONT (FONTCREATE (OR (CADR (ASSOC 'FIELDFONT SPEC))
'(HELVETICA 8]
PRE POST FIELDLOOKS PREFIXOBJ SUFFIXOBJ REMAINDER)
(if (NULL IDENTIFIER)
then (if PRELABEL
then [SETQ IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline
#\:)
PRELABEL]
else (ERROR (ERROR "Missing both IDENTIFIER and PRELABEL" SPEC)))
elseif (OR (LITATOM IDENTIFIER)
(SMALLP IDENTIFIER))
elseif (STRINGP IDENTIFIER)
then (SETQ IDENTIFIER (MKATOM IDENTIFIER))
else (\ILLEGAL.ARG IDENTIFIER))
(push SPEC (LIST 'IDENTIFIER IDENTIFIER))
(* ;; "Collect any other properties to put on the prefix")
(SETQ REMAINDER (for S in SPEC unless (MEMB (CAR S)
'(INITSTATE PRELABEL POSTLABEL IDENTIFIER
LABELFONT FIELDFONT)) collect S))
(* ;; "SPEC could specify a prelabel font different from a field font")
(CL:UNLESS IDENTIFIER
(if PRELABEL
then [push SPEC (LIST IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab
#\Newline
#\:)
PRELABEL]
else (ERROR "NO IDENTIFIER FOR FIELD")))
[SETQ PRE `((,FIELDFONT " {"]
(CL:WHEN PRELABEL
(push PRE (LIST LABELFONT PRELABEL)))
@@ -1540,12 +1504,10 @@
(TEDIT.INSERT.OBJECT PREFIXOBJ MENUTSTREAM CH# FIELDFONT)
(add CH# 1)
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Initial entry")
(add CH# (if (EQ 'IMAGEOBJ (CADR (ASSOC 'FIELDTYPE SPEC)))
then [TEDIT.INSERT.OBJECT INITSTATE MENUTSTREAM CH#
`(FONT ,FIELDFONT]
1
else [TEDIT.INSERT MENUTSTREAM INITSTATE CH# `(FONT ,FIELDFONT]
(NCHARS INITSTATE))))
[TEDIT.INSERT MENUTSTREAM (MKSTRING INITSTATE)
CH#
`(FONT ,FIELDFONT]
(add CH# (NCHARS INITSTATE)))
(TEDIT.INSERT.OBJECT SUFFIXOBJ MENUTSTREAM CH# FIELDFONT)
(add CH# 1])
@@ -1585,9 +1547,7 @@
XKERN _ 0])
(MB.FIELD.PREFIXCREATE
[LAMBDA (SPEC PRE FIELDLOOKS) (* ; "Edited 11-Jan-2025 09:58 by rmk")
(* ; "Edited 4-Jan-2025 16:53 by rmk")
(* ; "Edited 9-Dec-2024 21:53 by rmk")
[LAMBDA (SPEC PRE FIELDLOOKS) (* ; "Edited 9-Dec-2024 21:53 by rmk")
(* ; "Edited 7-Dec-2024 09:01 by rmk")
(* ; "Edited 4-Dec-2024 17:48 by rmk")
(* ; "Edited 8-Nov-2024 08:36 by rmk")
@@ -1617,12 +1577,12 @@
(IMAGEOBJPROP OBJ SPEC 'SETSTATEFN (FUNCTION MB.FIELD.SETSTATEFN)))
(IMAGEOBJPROP OBJ 'FIELDLOOKS FIELDLOOKS)
(for S in SPEC unless (MEMB (CAR S)
'(PRELABEL POSTLABEL LABELFONT IDENTIFIER FIELDFONT))
'(PRELABEL POSTLABEL LABELFONT FIELDFONT))
do (IMAGEOBJPROP OBJ (CAR S)
(CADR S)))
(CL:WHEN (AND EMPTYVALUE (EQ INITSTATE (CADR EMPTYVALUE)))
(SETQ INITSTATE '**EMPTY**))
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**))
(CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Can SELECTION be initialized?")
(CL:UNLESS (SELECTQ FIELDTYPE
(NUMBER (NUMBERP INITSTATE))
(SYMBOL (LITATOM INITSTATE))
@@ -1634,12 +1594,9 @@
((TEXT STRING)
(STRINGP INITSTATE))
(IMAGEOBJ (IMAGEOBJP INITSTATE))
(SELECTION (OR (ATOM INITSTATE)
(STRINGP INITSTATE)))
NIL)
(\ILLEGAL.ARG INITSTATE))
(IMAGEOBJPROP OBJ 'INITSTATE INITSTATE))
(IMAGEOBJPROP OBJ 'IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC)))
(IMAGEOBJPROP OBJ 'FIELDPREFIX T)
OBJ])
@@ -1666,8 +1623,7 @@
OBJ])
(MB.FIELD.INIT
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:51 by rmk")
(* ; "Edited 7-Dec-2024 09:05 by rmk")
[LAMBDA NIL (* ; "Edited 7-Dec-2024 09:05 by rmk")
(* ; "Edited 4-Dec-2024 16:09 by rmk")
(* ; "Edited 22-Aug-2024 10:07 by rmk")
(* ; "Edited 20-Aug-2024 16:03 by rmk")
@@ -1677,7 +1633,6 @@
(* ;; "The displayfn is NILL--field prefixes don't display")
(DECLARE (GLOBALVARS MB.FIELD.IMAGEFNS))
(SETQ MB.FIELD.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.FIELD.DISPLAYFN)
(FUNCTION MB.FIELD.IMAGEBOXFN)
(FUNCTION MB.PUTFN)
@@ -1953,30 +1908,34 @@
(\TEDIT.THELP "UNRECOGNIZED FIELD TYPE" FIELDTYPE))
VAL])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MB.FIELD.IMAGEFNS)
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(MB.FIELD.INIT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3287 19809 (MB.ADD 3297 . 9726) (MB.DELETE 9728 . 10102) (MB.GET 10104 . 16874) (
MB.GET.MBARG 16876 . 18545) (TEDITMENU.STREAM 18547 . 19214) (TEDIT.BACKTOMAIN 19216 . 19807)) (19853
39094 (MB.BUTTONEVENTINFN 19863 . 21357) (MB.DISPLAYFN 21359 . 23418) (MB.SETIMAGE 23420 . 24588) (
MB.SIZEFN 24590 . 26138) (MB.WHENOPERATEDONFN 26140 . 28089) (MB.COPYFN 28091 . 28549) (MB.GETFN 28551
. 29512) (MB.PUTFN 29514 . 30614) (MB.SHOWSELFN 30616 . 32125) (MB.CREATE 32127 . 36150) (
MB.CHANGENAME 36152 . 36634) (MB.INIT 36636 . 38097) (MB.TRACK.UNTIL 38099 . 38794) (MB.DON'T 38796 .
39092)) (39256 49246 (MB.3STATE.CREATE 39266 . 40130) (MB.3STATE.DISPLAYFN 40132 . 41118) (
MB.3STATE.SHOWSELFN 41120 . 43431) (MB.3STATE.INIT 43433 . 44844) (MB.3STATE.SETSTATEFN 44846 . 45504)
(MB.3STATE.BUTTONEVENTINFN 45506 . 49244)) (49401 79998 (MB.NWAY.CREATE 49411 . 55382) (
MB.NWAY.DISPLAYFN 55384 . 56247) (MB.NWAY.WHENOPERATEDONFN 56249 . 58439) (MB.NWAY.SIZEFN 58441 .
62377) (MB.NWAY.SELECT 62379 . 65949) (MB.NWAY.BUTTONEVENTINFN 65951 . 69163) (MB.NWAY.NEWMENUBUTTON
69165 . 69877) (MB.NWAY.COPYFN 69879 . 70846) (MB.NWAY.INIT 70848 . 72339) (MB.NWAY.ARRANGEBUTTONS
72341 . 74312) (MB.NWAY.ADDITEM 74314 . 78176) (MB.NWAY.FINDSUBOBJ 78178 . 78692) (MB.NWAY.SETSTATEFN
78694 . 79996)) (80077 91964 (MB.TOGGLE.CREATE 80087 . 81082) (MB.TOGGLE.DISPLAYFN 81084 . 82567) (
MB.TOGGLE.INIT 82569 . 84368) (MB.SET.TOGGLE 84370 . 85571) (MB.TOGGLE.SETSTATEFN 85573 . 86413) (
MB.TOGGLE.BUTTONEVENTINFN 86415 . 90619) (MB.TOGGLE.WHENOPERATEDONFN 90621 . 91962)) (92045 124215 (
MB.FIELD.CREATE 92055 . 97492) (MB.FIELD.DISPLAYFN 97494 . 98285) (MB.FIELD.IMAGEBOXFN 98287 . 99769)
(MB.FIELD.PREFIXCREATE 99771 . 103707) (MB.FIELD.SUFFIXCREATE 103709 . 105369) (MB.FIELD.INIT 105371
. 107138) (MB.FIELD.WHENOPERATEDONFN 107140 . 108411) (MB.FIELD.GETSTATEFN 108413 . 112347) (
MB.FIELD.SETSTATEFN 112349 . 117044) (MB.FIELD.BUTTONEVENTINFN 117046 . 119351) (MB.FIELD.SIZEFN
119353 . 119593) (MB.FIELD.INSURETYPE 119595 . 124213)))))
(FILEMAP (NIL (3459 19034 (MB.ADD 3469 . 9058) (MB.DELETE 9060 . 9434) (MB.GET 9436 . 16099) (
MB.GET.MBARG 16101 . 17770) (TEDITMENU.STREAM 17772 . 18439) (TEDIT.BACKTOMAIN 18441 . 19032)) (19078
36844 (MB.BUTTONEVENTINFN 19088 . 20297) (MB.DISPLAYFN 20299 . 22358) (MB.SETIMAGE 22360 . 23528) (
MB.SIZEFN 23530 . 25078) (MB.WHENOPERATEDONFN 25080 . 27029) (MB.COPYFN 27031 . 27489) (MB.GETFN 27491
. 28452) (MB.PUTFN 28454 . 29554) (MB.SHOWSELFN 29556 . 31065) (MB.CREATE 31067 . 34052) (
MB.CHANGENAME 34054 . 34536) (MB.INIT 34538 . 35847) (MB.TRACK.UNTIL 35849 . 36544) (MB.DON'T 36546 .
36842)) (37069 46900 (MB.3STATE.CREATE 37079 . 37943) (MB.3STATE.DISPLAYFN 37945 . 38931) (
MB.3STATE.SHOWSELFN 38933 . 41244) (MB.3STATE.INIT 41246 . 42498) (MB.3STATE.SETSTATEFN 42500 . 43158)
(MB.3STATE.BUTTONEVENTINFN 43160 . 46898)) (47125 76244 (MB.NWAY.CREATE 47135 . 52645) (
MB.NWAY.DISPLAYFN 52647 . 53510) (MB.NWAY.WHENOPERATEDONFN 53512 . 55702) (MB.NWAY.SIZEFN 55704 .
59640) (MB.NWAY.SELECT 59642 . 62452) (MB.NWAY.BUTTONEVENTINFN 62454 . 65666) (MB.NWAY.NEWMENUBUTTON
65668 . 66380) (MB.NWAY.COPYFN 66382 . 67349) (MB.NWAY.INIT 67351 . 68685) (MB.NWAY.ARRANGEBUTTONS
68687 . 70658) (MB.NWAY.ADDITEM 70660 . 74422) (MB.NWAY.FINDSUBOBJ 74424 . 74938) (MB.NWAY.SETSTATEFN
74940 . 76242)) (76391 88119 (MB.TOGGLE.CREATE 76401 . 77396) (MB.TOGGLE.DISPLAYFN 77398 . 78881) (
MB.TOGGLE.INIT 78883 . 80523) (MB.SET.TOGGLE 80525 . 81726) (MB.TOGGLE.SETSTATEFN 81728 . 82568) (
MB.TOGGLE.BUTTONEVENTINFN 82570 . 86774) (MB.TOGGLE.WHENOPERATEDONFN 86776 . 88117)) (88270 119196 (
MB.FIELD.CREATE 88280 . 93015) (MB.FIELD.DISPLAYFN 93017 . 93808) (MB.FIELD.IMAGEBOXFN 93810 . 95292)
(MB.FIELD.PREFIXCREATE 95294 . 98846) (MB.FIELD.SUFFIXCREATE 98848 . 100508) (MB.FIELD.INIT 100510 .
102119) (MB.FIELD.WHENOPERATEDONFN 102121 . 103392) (MB.FIELD.GETSTATEFN 103394 . 107328) (
MB.FIELD.SETSTATEFN 107330 . 112025) (MB.FIELD.BUTTONEVENTINFN 112027 . 114332) (MB.FIELD.SIZEFN
114334 . 114574) (MB.FIELD.INSURETYPE 114576 . 119194)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Jan-2025 15:03:01" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;595 159113
(FILECREATED "23-Dec-2024 23:02:54" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;592 159471
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.PUT.UTF8.SPLITPIECES)
:CHANGES-TO (FNS TEDIT.PUT TEDIT.PUT.STREAM)
:PREVIOUS-DATE " 7-Jan-2025 12:28:41" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;593)
:PREVIOUS-DATE "16-Dec-2024 11:25:16" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;591)
(PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -1399,8 +1399,7 @@
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE TEXTOBJ])
(\TEDIT.GET.SINGLE.CHARLOOKS
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 2-Jan-2025 11:08 by rmk")
(* ; "Edited 11-Dec-2024 22:59 by rmk")
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 11-Dec-2024 22:59 by rmk")
(* ; "Edited 9-Dec-2024 20:11 by rmk")
(* ; "Edited 13-Aug-2024 08:49 by rmk")
(* ; "Edited 31-Jul-2024 00:04 by rmk")
@@ -1420,7 +1419,7 @@
(PROG* ((LOOKS (create CHARLOOKS))
(FILEPOS (GETFILEPTR FILE))
(LOOKSLEN (\WIN FILE))
FONT NAME SIZE SUPER PROPS STYLESTR BOLD ITALIC)
FONT NAME FACE SIZE SUPER PROPS STYLESTR)
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
(SETQ SUPER (\SMALLPIN FILE)) (* ;
@@ -1429,12 +1428,12 @@
0))
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
(SETQ PROPS (\WIN FILE))
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
(with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS]
[SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS]
[SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
@@ -1443,24 +1442,31 @@
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
[if (LISTP NAME)
then (* ;
(SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD)
'B
'M)
(CL:IF (FGETCLOOKS LOOKS CLITAL)
'I
'R)
'R))
(SETQ FONT (if (LISTP NAME)
then (* ;
 "This was a font class. Restore it.")
(SETQ FONT (FONTCLASS (pop NAME)
NAME)) (* ;
 "But don't maintain original names, for equality testing")
(replace (FONTCLASS FONTCLASSNAME) of FONT with 'TEDIT-FONTCLASS)
(replace (FONTCLASS PRETTYFONT#) of FONT with 0)
else (SETQ FONT (FONTCREATE NAME SIZE (PACK* (CL:IF BOLD
'B
'M)
(CL:IF ITALIC
'I
'R)
'R]
(FONTCLASS (pop NAME)
NAME)
else (FONTCREATE NAME SIZE FACE)))
(FSETCLOOKS LOOKS CLNAME (if (type? FONTCLASS FONT)
then
(* ;;
 "Put the display family in the CLNAME spot. Better than NIL.")
(CL:WHEN [SETQ NAME (FONTCOPY FONT
'(DEVICE DISPLAY NOERROR T]
(FONTPROP NAME 'FAMILY))
else NAME))
(FSETCLOOKS LOOKS CLFONT FONT)
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
(SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
(RETURN LOOKS])
@@ -1923,8 +1929,7 @@
(CHARCODE (EOL LF])])])
(\TEDIT.PUT.UTF8.SPLITPIECES
[LAMBDA (TEXTOBJ) (* ; "Edited 19-Jan-2025 15:02 by rmk")
(* ; "Edited 17-Mar-2024 00:14 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 17-Mar-2024 00:14 by rmk")
(* ; "Edited 3-Feb-2024 14:52 by rmk")
(* ; "Edited 11-Jan-2024 23:29 by rmk")
(* ; "Edited 5-Jan-2024 11:37 by rmk")
@@ -1941,11 +1946,13 @@
(* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.")
(if (EQ I 1)
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
*XCCSTOUNICODE*)))
(FSETPC PC PUTF8BYTESPERCHAR BPC)
(* ;
 "The first character defines the piece")
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
*XCCSTOUNICODE*)))
else (\TEDIT.SPLITPIECE PC (SUB1 I)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))
@@ -1961,9 +1968,11 @@
(for I BPC (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC)
first (\SETFILEPTR PFILE (PFPOS PC))
do (if (EQ I 1)
then [SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
*XCCSTOUNICODE*)))
(FSETPC PC PUTF8BYTESPERCHAR BPC)
elseif [EQ BPC (NUTF8-CODE-BYTES (XTOUCODE (BIN PFILE]
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
*XCCSTOUNICODE*)))
else (\TEDIT.SPLITPIECE PC (SUB1 I)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))
@@ -1978,9 +1987,10 @@
8)
(BIN PFILE)))
(if (EQ I 1)
then (SETQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*))
)
(FSETPC PC PUTF8BYTESPERCHAR BPC)
elseif (EQ BPC (NUTF8-CODE-BYTES (XTOUCODE CH)))
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*)))
else (\TEDIT.SPLITPIECE PC (SUB1 I)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))
@@ -2164,8 +2174,7 @@
(PUTHASH LOOKS I LOOKSHASH])
(\TEDIT.PUT.SINGLE.CHARLOOKS
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 2-Jan-2025 10:43 by rmk")
(* ; "Edited 13-Aug-2024 08:47 by rmk")
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 13-Aug-2024 08:47 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 23:07 by rmk")
(* ; "Edited 21-Dec-2023 23:54 by rmk")
@@ -2213,10 +2222,10 @@
(CL:IF (fetch (CHARLOOKS CLINVERTED) of LOOKS)
1024
0)
(CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
(CL:IF (fetch (CHARLOOKS CLBOLD) of LOOKS)
512
0)
(CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
(CL:IF (fetch (CHARLOOKS CLITAL) of LOOKS)
256
0)
(CL:IF (fetch (CHARLOOKS CLULINE) of LOOKS)
@@ -2502,28 +2511,28 @@
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5017 33942 (TEDIT.GET 5027 . 11036) (TEDIT.FORMATTEDFILEP 11038 . 12354) (
TEDIT.FILEDATE 12356 . 13527) (TEDIT.INCLUDE 13529 . 21440) (TEDIT.RAW.INCLUDE 21442 . 22250) (
TEDIT.PUT 22252 . 30107) (TEDIT.PUT.STREAM 30109 . 33940)) (33943 53140 (\TEDIT.GET.FOREIGN.FILE 33953
. 37138) (\TEDIT.GET.UNFORMATTED.FILE 37140 . 41014) (\TEDIT.GET.FORMATTED.FILE 41016 . 43837) (
\TEDIT.FORMATTEDSTREAMP 43839 . 46739) (\ARBIN 46741 . 47461) (\ATMIN 47463 . 48000) (\DWIN 48002 .
48381) (\STRINGIN 48383 . 49091) (\TEDIT.GET.TRAILER 49093 . 51609) (\TEDIT.CACHEFILE 51611 . 53138))
(53306 66856 (\TEDIT.GET.PIECES3 53316 . 63618) (\TEDIT.GET.IDATE3 63620 . 65015) (
\TEDIT.MAKE.STRINGPIECE 65017 . 66854)) (66857 79232 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66867 . 72983)
(\TEDIT.INTERPRET.XCCS.SHIFTS 72985 . 79230)) (79254 85276 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79264 .
85274)) (85299 93924 (\TEDIT.GET.CHARLOOKS.LIST 85309 . 86040) (\TEDIT.GET.SINGLE.CHARLOOKS 86042 .
90736) (\TEDIT.GET.CHARLOOKS 90738 . 92068) (\TEDIT.GET.PARALOOKS.INDEX 92070 . 92614) (
\TEDIT.GET.CHARLOOKS.INDEX 92616 . 93922)) (93925 101093 (\TEDIT.GET.PARALOOKS.LIST 93935 . 94557) (
\TEDIT.GET.SINGLE.PARALOOKS 94559 . 101091)) (101094 104684 (\TEDIT.GET.OBJECT 101104 . 104682)) (
104746 136623 (\TEDIT.PUT.PCTB 104756 . 114406) (\TEDIT.PUT.PCTB.PIECEDATA 114408 . 117606) (
\TEDIT.PUT.TRAILER 117608 . 118375) (\TEDIT.PUT.PCTB.MERGEABLE 118377 . 121811) (
\TEDIT.PUT.UTF8.SPLITPIECES 121813 . 126515) (\TEDIT.PUT.PCTB.NEXTNEW 126517 . 130784) (
\TEDIT.INSERT.NEWPIECES 130786 . 134221) (\TEDIT.PUTRESET 134223 . 134465) (\ARBOUT 134467 . 135191) (
\ATMOUT 135193 . 135798) (\DWOUT 135800 . 136079) (\STRINGOUT 136081 . 136621)) (136624 148699 (
\TEDIT.PUT.CHARLOOKS.LIST 136634 . 138306) (\TEDIT.PUT.SINGLE.CHARLOOKS 138308 . 144043) (
\TEDIT.PUT.CHARLOOKS 144045 . 145270) (\TEDIT.PUT.CHARLOOKS1 145272 . 146323) (\TEDIT.PUT.OBJECT
146325 . 148697)) (148700 156194 (\TEDIT.PUT.PARALOOKS.LIST 148710 . 149612) (
\TEDIT.PUT.SINGLE.PARALOOKS 149614 . 155053) (\TEDIT.PUT.PARALOOKS 155055 . 156192)) (156289 158883 (
TEDITFROMLISPSOURCE 156299 . 158132) (SHELLSCRIPTP 158134 . 158363) (TEDITFROMSHELLSCRIPT 158365 .
158881)))))
(FILEMAP (NIL (5016 33941 (TEDIT.GET 5026 . 11035) (TEDIT.FORMATTEDFILEP 11037 . 12353) (
TEDIT.FILEDATE 12355 . 13526) (TEDIT.INCLUDE 13528 . 21439) (TEDIT.RAW.INCLUDE 21441 . 22249) (
TEDIT.PUT 22251 . 30106) (TEDIT.PUT.STREAM 30108 . 33939)) (33942 53139 (\TEDIT.GET.FOREIGN.FILE 33952
. 37137) (\TEDIT.GET.UNFORMATTED.FILE 37139 . 41013) (\TEDIT.GET.FORMATTED.FILE 41015 . 43836) (
\TEDIT.FORMATTEDSTREAMP 43838 . 46738) (\ARBIN 46740 . 47460) (\ATMIN 47462 . 47999) (\DWIN 48001 .
48380) (\STRINGIN 48382 . 49090) (\TEDIT.GET.TRAILER 49092 . 51608) (\TEDIT.CACHEFILE 51610 . 53137))
(53305 66855 (\TEDIT.GET.PIECES3 53315 . 63617) (\TEDIT.GET.IDATE3 63619 . 65014) (
\TEDIT.MAKE.STRINGPIECE 65016 . 66853)) (66856 79231 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66866 . 72982)
(\TEDIT.INTERPRET.XCCS.SHIFTS 72984 . 79229)) (79253 85275 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79263 .
85273)) (85298 93989 (\TEDIT.GET.CHARLOOKS.LIST 85308 . 86039) (\TEDIT.GET.SINGLE.CHARLOOKS 86041 .
90801) (\TEDIT.GET.CHARLOOKS 90803 . 92133) (\TEDIT.GET.PARALOOKS.INDEX 92135 . 92679) (
\TEDIT.GET.CHARLOOKS.INDEX 92681 . 93987)) (93990 101158 (\TEDIT.GET.PARALOOKS.LIST 94000 . 94622) (
\TEDIT.GET.SINGLE.PARALOOKS 94624 . 101156)) (101159 104749 (\TEDIT.GET.OBJECT 101169 . 104747)) (
104811 137073 (\TEDIT.PUT.PCTB 104821 . 114471) (\TEDIT.PUT.PCTB.PIECEDATA 114473 . 117671) (
\TEDIT.PUT.TRAILER 117673 . 118440) (\TEDIT.PUT.PCTB.MERGEABLE 118442 . 121876) (
\TEDIT.PUT.UTF8.SPLITPIECES 121878 . 126965) (\TEDIT.PUT.PCTB.NEXTNEW 126967 . 131234) (
\TEDIT.INSERT.NEWPIECES 131236 . 134671) (\TEDIT.PUTRESET 134673 . 134915) (\ARBOUT 134917 . 135641) (
\ATMOUT 135643 . 136248) (\DWOUT 136250 . 136529) (\STRINGOUT 136531 . 137071)) (137074 149057 (
\TEDIT.PUT.CHARLOOKS.LIST 137084 . 138756) (\TEDIT.PUT.SINGLE.CHARLOOKS 138758 . 144401) (
\TEDIT.PUT.CHARLOOKS 144403 . 145628) (\TEDIT.PUT.CHARLOOKS1 145630 . 146681) (\TEDIT.PUT.OBJECT
146683 . 149055)) (149058 156552 (\TEDIT.PUT.PARALOOKS.LIST 149068 . 149970) (
\TEDIT.PUT.SINGLE.PARALOOKS 149972 . 155411) (\TEDIT.PUT.PARALOOKS 155413 . 156550)) (156647 159241 (
TEDITFROMLISPSOURCE 156657 . 158490) (SHELLSCRIPTP 158492 . 158721) (TEDITFROMSHELLSCRIPT 158723 .
159239)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Jan-2025 15:31:33" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;109 40128
(FILECREATED "26-Nov-2024 23:53:32" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;101 38718
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD)
:CHANGES-TO (FNS \TEDIT.KEY.FIND)
:PREVIOUS-DATE "18-Jan-2025 23:38:11" {WMEDLEY}<library>TEDIT>TEDIT-FNKEYS.;108)
:PREVIOUS-DATE "23-Nov-2024 16:29:11" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;100)
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
@@ -442,9 +442,7 @@
(TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T])
(\TEDIT.MANPAGE
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 21:48 by rmk")
(* ; "Edited 29-Dec-2024 08:40 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 26-May-2024 21:53 by rmk")
(* ; "Edited 25-May-2024 14:50 by rmk")
@@ -452,30 +450,15 @@
(CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
'DINFOGRAPH)
(TEDIT.PROMPTCLEAR TSTREAM)
[LET ((KEY (TEDIT.SEL.AS.STRING TSTREAM SEL)))
(if (OR (NULL KEY)
(EQ 0 (NCHARS KEY)))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a man-page key" T T)
else (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL])])
(GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL)))])
(\TEDIT.CALL.ED
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 23:38 by rmk")
(* ; "Edited 29-Dec-2024 08:46 by rmk")
(* ; "Edited 25-May-2024 15:03 by rmk")
(TEDIT.PROMPTCLEAR TSTREAM)
(LET [(SYMBOL (MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
(if (OR (NULL SYMBOL)
(EQ 0 (NCHARS SYMBOL)))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a symbol to edit" T T)
elseif (TYPESOF SYMBOL)
then (ED SYMBOL `(:DONTWAIT :DISPLAY))
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT SYMBOL " has no definitions to edit")
T T])
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-May-2024 15:03 by rmk")
(ED [MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
'(:DONTWAIT])
(\TEDIT.ONECHAR.BACKWARD
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 24-Jan-2025 15:25 by rmk")
(* ; "Edited 21-Nov-2024 20:31 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk")
(* ; "Edited 1-Sep-2024 10:39 by rmk")
(TEXTOBJ! TEXTOBJ)
(SELECTION! SEL)
@@ -483,14 +466,12 @@
(CL:UNLESS (ILEQ PT 1)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL (SUB1 PT)
0
'LEFT)
0)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
(\TEDIT.ONECHAR.FORWARD
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 24-Jan-2025 15:27 by rmk")
(* ; "Edited 21-Nov-2024 20:31 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk")
(* ; "Edited 1-Sep-2024 10:39 by rmk")
(* ;; "Moves caret to a point one character forward.")
@@ -500,8 +481,7 @@
(CL:UNLESS (IGEQ PT (TEXTLEN TEXTOBJ))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL (ADD1 PT)
0
'LEFT)
0)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
)
@@ -730,23 +710,23 @@
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY]
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6251 29984 (\TEDIT.BOLD.SEL.OFF 6261 . 6599) (\TEDIT.BOLD.SEL.ON 6601 . 6929) (
\TEDIT.CENTER.SEL 6931 . 8447) (\TEDIT.CENTER.SEL.REV 8449 . 8745) (\TEDIT.DEFAULTS.CARET 8747 . 9240)
(\TEDIT.DEFAULTSSEL 9242 . 9689) (\TEDIT.SETDEFAULT.FROM.SEL 9691 . 10368) (\TEDIT.KEY.FIND 10370 .
15437) (\TEDIT.KEY.FIND.SEARCHSTRING 15439 . 16579) (\TEDIT.GET.TARGET.STRING 16581 . 18295) (
\TEDIT.KEY.FIND.BACKWARD 18297 . 18602) (\TEDIT.FINDAGAIN.BACKWARD 18604 . 19015) (\TEDIT.FINDAGAIN
19017 . 19308) (\TEDIT.ITALIC.SEL.OFF 19310 . 19562) (\TEDIT.ITALIC.SEL.ON 19564 . 19757) (
\TEDIT.LARGERSEL 19759 . 20047) (\TEDIT.LCASE.SEL 20049 . 21444) (\TEDIT.SHOWCARETLOOKS 21446 . 23046)
(\TEDIT.SMALLERSEL 23048 . 23339) (\TEDIT.SUBSCRIPTSEL 23341 . 23544) (\TEDIT.SUPERSCRIPTSEL 23546 .
23750) (\TEDIT.UCASE.SEL 23752 . 25091) (\TEDIT.UNDERLINE.SEL.OFF 25093 . 25291) (
\TEDIT.UNDERLINE.SEL.ON 25293 . 25489) (\TEDIT.STRIKEOUT.SEL.ON 25491 . 25687) (
\TEDIT.STRIKEOUT.SEL.OFF 25689 . 25887) (\TEDIT.SELECT.ALL 25889 . 26205) (\TEDIT.KEY.SUBSTITUTE 26207
. 26428) (\TEDIT.MANPAGE 26430 . 27677) (\TEDIT.CALL.ED 27679 . 28509) (\TEDIT.ONECHAR.BACKWARD 28511
. 29216) (\TEDIT.ONECHAR.FORWARD 29218 . 29982)) (30056 36567 (\TEDIT.BOLD.CARET.OFF 30066 . 30601) (
\TEDIT.BOLD.CARET.ON 30603 . 31135) (\TEDIT.ITALIC.CARET.OFF 31137 . 31674) (\TEDIT.ITALIC.CARET.ON
31676 . 32219) (\TEDIT.LARGER.CARET 32221 . 32756) (\TEDIT.SMALLER.CARET 32758 . 33295) (
\TEDIT.SUBSCRIPT.CARET 33297 . 33838) (\TEDIT.SUPERSCRIPT.CARET 33840 . 34382) (
\TEDIT.UNDERLINE.CARET.OFF 34384 . 34924) (\TEDIT.UNDERLINE.CARET.ON 34926 . 35464) (
\TEDIT.STRIKEOUT.CARET.OFF 35466 . 36006) (\TEDIT.STRIKEOUT.CARET.ON 36008 . 36565)) (36636 37338 (
\TK.DESCRIBEFONT 36646 . 37336)))))
(FILEMAP (NIL (6220 28574 (\TEDIT.BOLD.SEL.OFF 6230 . 6568) (\TEDIT.BOLD.SEL.ON 6570 . 6898) (
\TEDIT.CENTER.SEL 6900 . 8416) (\TEDIT.CENTER.SEL.REV 8418 . 8714) (\TEDIT.DEFAULTS.CARET 8716 . 9209)
(\TEDIT.DEFAULTSSEL 9211 . 9658) (\TEDIT.SETDEFAULT.FROM.SEL 9660 . 10337) (\TEDIT.KEY.FIND 10339 .
15406) (\TEDIT.KEY.FIND.SEARCHSTRING 15408 . 16548) (\TEDIT.GET.TARGET.STRING 16550 . 18264) (
\TEDIT.KEY.FIND.BACKWARD 18266 . 18571) (\TEDIT.FINDAGAIN.BACKWARD 18573 . 18984) (\TEDIT.FINDAGAIN
18986 . 19277) (\TEDIT.ITALIC.SEL.OFF 19279 . 19531) (\TEDIT.ITALIC.SEL.ON 19533 . 19726) (
\TEDIT.LARGERSEL 19728 . 20016) (\TEDIT.LCASE.SEL 20018 . 21413) (\TEDIT.SHOWCARETLOOKS 21415 . 23015)
(\TEDIT.SMALLERSEL 23017 . 23308) (\TEDIT.SUBSCRIPTSEL 23310 . 23513) (\TEDIT.SUPERSCRIPTSEL 23515 .
23719) (\TEDIT.UCASE.SEL 23721 . 25060) (\TEDIT.UNDERLINE.SEL.OFF 25062 . 25260) (
\TEDIT.UNDERLINE.SEL.ON 25262 . 25458) (\TEDIT.STRIKEOUT.SEL.ON 25460 . 25656) (
\TEDIT.STRIKEOUT.SEL.OFF 25658 . 25856) (\TEDIT.SELECT.ALL 25858 . 26174) (\TEDIT.KEY.SUBSTITUTE 26176
. 26397) (\TEDIT.MANPAGE 26399 . 27155) (\TEDIT.CALL.ED 27157 . 27369) (\TEDIT.ONECHAR.BACKWARD 27371
. 27941) (\TEDIT.ONECHAR.FORWARD 27943 . 28572)) (28646 35157 (\TEDIT.BOLD.CARET.OFF 28656 . 29191) (
\TEDIT.BOLD.CARET.ON 29193 . 29725) (\TEDIT.ITALIC.CARET.OFF 29727 . 30264) (\TEDIT.ITALIC.CARET.ON
30266 . 30809) (\TEDIT.LARGER.CARET 30811 . 31346) (\TEDIT.SMALLER.CARET 31348 . 31885) (
\TEDIT.SUBSCRIPT.CARET 31887 . 32428) (\TEDIT.SUPERSCRIPT.CARET 32430 . 32972) (
\TEDIT.UNDERLINE.CARET.OFF 32974 . 33514) (\TEDIT.UNDERLINE.CARET.ON 33516 . 34054) (
\TEDIT.STRIKEOUT.CARET.OFF 34056 . 34596) (\TEDIT.STRIKEOUT.CARET.ON 34598 . 35155)) (35226 35928 (
\TK.DESCRIBEFONT 35236 . 35926)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Feb-2025 11:32:56" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;220 52908
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219 53094
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.REDO)
:CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO
TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE
\TEDIT.COMPOSITE.EVENT)
(VARS TEDIT-HISTORYCOMS)
(MACROS \TEDIT.HISTORYADD1)
:PREVIOUS-DATE " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219)
:PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
@@ -452,8 +456,7 @@
T])
(TEDIT.REDO
[LAMBDA (TSTREAM) (* ; "Edited 2-Feb-2025 11:28 by rmk")
(* ; "Edited 8-Dec-2024 17:53 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 17:53 by rmk")
(* ; "Edited 27-Nov-2024 23:11 by rmk")
(* ; "Edited 26-Sep-2024 16:49 by rmk")
(* ; "Edited 29-Jul-2024 23:58 by rmk")
@@ -500,10 +503,10 @@
(:UpperCase (* ; "He upper-cased something")
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
(:CharLooks (* ; "It was a character looks change")
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
(\TEDIT.CHANGE.CHARLOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
SEL))
(:ParaLooks (* ; "It was a Paragraph looks change")
(\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
(\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
SEL))
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
@@ -837,14 +840,14 @@
(\TEDIT.THELP 'Redo-composite])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4896 5917 (\TEDIT.HISTORYEVENT.DEFPRINT 4906 . 5915)) (7007 17445 (\TEDIT.HISTORYADD
7017 . 11878) (\TEDIT.HISTORYADD.COMPOSITE 11880 . 12639) (\TEDIT.CUMULATE.EVENTS 12641 . 14235) (
\TEDIT.COMPOSITE.EVENT 14237 . 14973) (\TEDIT.HISTORY.PROP 14975 . 16338) (\TEDIT.HISTORY.EVENT 16340
. 17269) (\TEDIT.POPEVENT 17271 . 17443)) (17498 35437 (TEDIT.UNDO 17508 . 21902) (\TEDIT.UNDO1 21904
. 26116) (TEDIT.REDO 26118 . 32591) (\TEDIT.UNDO.UNDO 32593 . 35435)) (35438 50524 (
\TEDIT.UNDO.INSERT 35448 . 36361) (\TEDIT.UNDO.DELETE 36363 . 37157) (\TEDIT.UNDO.MOVE 37159 . 38748)
(\TEDIT.UNDO.REPLACE 38750 . 39846) (\TEDIT.UNDO.CHARLOOKS 39848 . 44422) (\TEDIT.UNDO.PARALOOKS 44424
. 48656) (\TEDIT.UNDO.PAGELOOKS 48658 . 49067) (\TEDIT.UNDO.COMPOSITE 49069 . 50296) (
\TEDIT.UNDO.REPLACECODE 50298 . 50522)) (50525 52885 (\TEDIT.REDO.INSERT 50535 . 51268) (
\TEDIT.REDO.REPLACE 51270 . 52601) (\TEDIT.REDO.COMPOSITE 52603 . 52883)))))
(FILEMAP (NIL (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD
7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) (
\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635
. 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199
. 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 (
\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934)
(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610
. 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) (
\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) (
\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Jan-2025 12:29:36" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;29 70509
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27 72985
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.CHARLOOKS2 \TEDIT.GET.CHARLOOKS0 \TEDIT.GET.CHARLOOKS1
\TEDIT.PUT.SINGLE.CHARLOOKS2)
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
:PREVIOUS-DATE "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27)
:PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
@@ -276,9 +275,7 @@
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE])
(\TEDIT.GET.SINGLE.CHARLOOKS2
[LAMBDA (FILE) (* ; "Edited 7-Jan-2025 12:29 by rmk")
(* ; "Edited 2-Jan-2025 11:09 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
[LAMBDA (FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 22:53 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 25-Nov-2023 23:22 by rmk")
@@ -286,18 +283,18 @@
(* ; "Edited 30-May-91 20:26 by jds")
(* ; "Read a set of CHARLOOKS from FILE")
(PROG* ((LOOKS (create CHARLOOKS))
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC)
FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR)
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
(SETQ SUPER (\SMALLPIN FILE)) (* ; "Superscripting distance")
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
0))
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
(replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE)
0))
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE))
(SETQ PROPS (\WIN FILE))
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
(with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS]
[SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS]
[SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
@@ -306,6 +303,7 @@
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
[SETQ FONT (COND
((LISTP NAME) (* ;
@@ -314,12 +312,22 @@
NAME))
((AND NAME (NOT (ZEROP SIZE)))
(FONTCREATE NAME SIZE (COND
((AND BOLD ITALIC)
((AND (fetch (CHARLOOKS CLBOLD) of LOOKS)
(fetch (CHARLOOKS CLITAL) of LOOKS))
'BOLDITALIC)
(BOLD 'BOLD)
(ITALIC 'ITALIC]
(FSETCLOOKS LOOKS CLFONT FONT)
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
((fetch (CHARLOOKS CLBOLD) of LOOKS)
'BOLD)
((fetch (CHARLOOKS CLITAL) of LOOKS)
'ITALIC]
(replace (CHARLOOKS CLNAME) of LOOKS
with (if (type? FONTCLASS FONT)
then
(* ;; "Put the display family in the CLNAME spot. Better than NIL.")
(CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T]
(FONTPROP NAME 'FAMILY))
else NAME))
(replace (CHARLOOKS CLFONT) of LOOKS with FONT)
(RETURN LOOKS])
(\TEDIT.PUT.SINGLE.PARALOOKS2
@@ -383,14 +391,13 @@
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
(\TEDIT.PUT.SINGLE.CHARLOOKS2
[LAMBDA (FILE LOOKS) (* ; "Edited 2-Jan-2025 10:51 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
[LAMBDA (FILE LOOKS) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 23:01 by rmk")
(* ; "Edited 19-Dec-2023 10:14 by rmk")
(* ; "Edited 30-May-91 20:26 by jds")
(* ;
 "Put out a single CHARLOOKS description.")
(PROG ((FONT (GETCLOOKS LOOKS CLFONT))
(PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS))
STR LEN)
[COND
((type? FONTCLASS FONT) (* ;
@@ -401,54 +408,68 @@
(\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* ; "The font family")
(\WOUT FILE (OR (FONTPROP FONT 'SIZE)
0)) (* ; "Size of the type, in points")
(\SMALLPOUT FILE (OR (GETCLOOKS LOOKS CLOFFSET)
(\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS)
0)) (* ; "Super/subscripting distance")
(COND
([AND (GETCLOOKS LOOKS CLSTYLE)
(NOT (ZEROP (GETCLOOKS LOOKS CLSTYLE]
(\ARBOUT FILE (GETCLOOKS LOOKS CLSTYLE)))
([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS)
(NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS]
(\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS)))
(T (\WOUT FILE 0)))
(COND
((GETCLOOKS LOOKS CLUSERINFO)
(\ARBOUT FILE (GETCLOOKS LOOKS CLUSERINFO LOOKS)))
((fetch (CHARLOOKS CLUSERINFO) of LOOKS)
(\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS)))
(T (\WOUT FILE 0)))
(\WOUT FILE (LOGOR (CL:IF (GETCLOOKS LOOKS CLLEADER LOOKS)
2048
0)
(CL:IF (GETCLOOKS LOOKS CLINVERTED LOOKS)
1024
0)
(CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
512
0)
(CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
512
0)
(CL:IF (GETCLOOKS LOOKS CLULINE)
128
0)
(CL:IF (GETCLOOKS LOOKS CLOLINE)
64
0)
(CL:IF (GETCLOOKS LOOKS CLSTRIKE)
32
0)
(CL:IF (GETCLOOKS LOOKS CLSMALLCAP)
16
0)
(CL:IF (GETCLOOKS LOOKS CLPROTECTED)
8
0)
(CL:IF (GETCLOOKS LOOKS CLINVISIBLE)
NIL
4
0)
(CL:IF (GETCLOOKS LOOKS CLSELAFTER)
2
0)
(CL:IF (GETCLOOKS LOOKS CLCANCOPY)
1
0)])
(\WOUT FILE (LOGOR (COND
((fetch (CHARLOOKS CLLEADER) of LOOKS)
(* ;
 "Dotted-leader; relevant only to TABs")
2048)
(T 0))
(COND
((fetch (CHARLOOKS CLINVERTED) of LOOKS)
(* ; "Inverse-video")
1024)
(T 0))
(COND
((fetch (CHARLOOKS CLBOLD) of LOOKS)
512)
(T 0))
(COND
((fetch (CHARLOOKS CLITAL) of LOOKS)
256)
(T 0))
(COND
((fetch (CHARLOOKS CLULINE) of LOOKS)
128)
(T 0))
(COND
((fetch (CHARLOOKS CLOLINE) of LOOKS)
64)
(T 0))
(COND
((fetch (CHARLOOKS CLSTRIKE) of LOOKS)
32)
(T 0))
(COND
((fetch (CHARLOOKS CLSMALLCAP) of LOOKS)
16)
(T 0))
(COND
((fetch (CHARLOOKS CLPROTECTED) of LOOKS)
8)
(T 0))
(COND
((fetch (CHARLOOKS CLINVISIBLE) of LOOKS)
NIL 4)
(T 0))
(COND
((fetch (CHARLOOKS CLSELAFTER) of LOOKS)
2)
(T 0))
(COND
((fetch (CHARLOOKS CLCANCOPY) of LOOKS)
1)
(T 0])
(\TEDIT.GET.PARALOOKS.LIST2
[LAMBDA (FILE) (* ; "Edited 19-Dec-2023 10:13 by rmk")
@@ -715,8 +736,7 @@
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST])
(\TEDIT.GET.CHARLOOKS1
[LAMBDA (PC FILE) (* ; "Edited 2-Jan-2025 11:09 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 22:55 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 25-Nov-2023 23:21 by rmk")
@@ -727,9 +747,7 @@
(* ;; "Read a description of PC's CHARLOOKS from FILE. The looks are here stored in PC, not in the TEXTOBJ (uniquify later?)")
(LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC (LOOKS (create
CHARLOOKS))
)
(LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
(FSETPC PC PLOOKS LOOKS)
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
@@ -744,13 +762,13 @@
(FSETPC PC PNEW T))
(CL:UNLESS (ZEROP (BIN FILE)) (* ;
 "There is style or user information to be read")
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
0))
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE)))
(replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE)
0))
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)))
(SETQ PROPS (\WIN FILE))
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
(with CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
@@ -758,22 +776,31 @@
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
[SETQ FONT (COND
((LISTP NAME) (* ;
 "This was a font class. Restore it.")
(FONTCLASS (CONS 0 (CDDR NAME))
'TEDIT-FONTCLASS))
[(AND NAME (NOT (ZEROP SIZE)))
(FONTCLASS (pop NAME)
NAME))
((AND NAME (NOT (ZEROP SIZE)))
(FONTCREATE NAME SIZE (COND
((AND BOLD ITALIC)
((AND (fetch (CHARLOOKS CLBOLD) of LOOKS)
(fetch (CHARLOOKS CLITAL) of LOOKS))
'BOLDITALIC)
(BOLD 'BOLD)
(ITALIC 'ITALIC]
(T (* ; "Should never happen")
(FONTCREATE DEFAULTFONT]
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
(FSETCLOOKS LOOKS CLFONT FONT])
((fetch (CHARLOOKS CLBOLD) of LOOKS)
'BOLD)
((fetch (CHARLOOKS CLITAL) of LOOKS)
'ITALIC]
(replace (CHARLOOKS CLNAME) of LOOKS
with (if (type? FONTCLASS FONT)
then
(* ;; "Put the display family in the CLNAME spot. Better than NIL.")
(CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T]
(FONTPROP NAME 'FAMILY))
else NAME))
(replace (CHARLOOKS CLFONT) of LOOKS with FONT])
(\TEDIT.GET.PARALOOKS1
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:08 by rmk")
@@ -935,17 +962,15 @@
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
(\TEDIT.GET.CHARLOOKS0
[LAMBDA (PC FILE) (* ; "Edited 2-Jan-2025 11:09 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 23:03 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
(* ; "Edited 30-May-91 20:26 by jds")
(* ;
 "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR BOLD ITALIC
(LOOKS (create CHARLOOKS)))
(SETPC PC PLOOKS LOOKS)
(PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS)))
(replace (PIECE PLOOKS) of PC with LOOKS)
(SETQ NAMELEN (\WIN FILE)) (* ;
 "The length of the description which follows")
[SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (BIN FILE]
@@ -960,7 +985,7 @@
(COND
((NOT (ZEROP (BIN FILE))) (* ; "This text is NEW. Mark it so.")
(FSETPC PC PNEW T)))
(replace (PIECE PNEW) of PC with T)))
[COND
((NOT (ZEROP (BIN FILE))) (* ;
 "There is style or user information to be read")
@@ -968,15 +993,15 @@
(SETQ USERSTR (\STRINGIN FILE))
(COND
((NOT (ZEROP (NCHARS STYLESTR))) (* ; "There IS style info")
(FSETCLOOKS LOOKS CLSTYLE (READ STYLESTR)))
(T (FSETCLOOKS LOOKS CLSTYLE 0)))
(replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR)))
(T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0)))
(COND
((NOT (ZEROP (NCHARS USERSTR))) (* ; "There IS user info")
(FSETCLOOKS LOOKS CLUSERINFO (READ USERSTR]
(replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR]
(SETQ PROPS (\WIN FILE))
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
(with CHARLOOKS LOOKS [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
(with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS]
[SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS]
[SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS]
[SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS]
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
@@ -984,18 +1009,22 @@
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
(SETQ FONT (if (AND NAME (NOT (ZEROP SIZE)))
then [FONTCREATE NAME SIZE (COND
((AND BOLD ITALIC ITALIC)
'BOLDITALIC)
(BOLD 'BOLD)
(ITALIC 'ITALIC]
else (* ; "Should never happen")
(FONTCREATE DEFAULTFONT)))
(FSETCLOOKS LOOKS CLFONT FONT)
(FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
(RETURN LOOKS])
(replace (CHARLOOKS CLFONT) of LOOKS with (AND NAME (NOT (ZEROP SIZE))
(FONTCREATE NAME SIZE
(COND
((AND (fetch (CHARLOOKS CLBOLD)
of LOOKS)
(fetch (CHARLOOKS CLITAL)
of LOOKS))
'BOLDITALIC)
((fetch (CHARLOOKS CLBOLD)
of LOOKS)
'BOLD)
((fetch (CHARLOOKS CLITAL)
of LOOKS)
'ITALIC])
(\TEDIT.GET.OBJECT0
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
@@ -1079,14 +1108,14 @@
FMT])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1758 36532 (\TEDIT.GET.PCTB2 1768 . 12063) (\TEDIT.GET.PARALOOKS2 12065 . 12654) (
\TEDIT.GET.CHARLOOKS2 12656 . 13987) (\TEDIT.PARSE.PAGEFRAMES2 13989 . 16728) (
\TEDIT.GET.CHARLOOKS.LIST2 16730 . 17237) (\TEDIT.GET.SINGLE.CHARLOOKS2 17239 . 20450) (
\TEDIT.PUT.SINGLE.PARALOOKS2 20452 . 24569) (\TEDIT.PUT.SINGLE.CHARLOOKS2 24571 . 28281) (
\TEDIT.GET.PARALOOKS.LIST2 28283 . 28790) (\TEDIT.GET.SINGLE.PARALOOKS2 28792 . 33250) (
\TEDIT.PUT.CHARLOOKS.LIST2 33252 . 35331) (\TEDIT.PUT.PARALOOKS.LIST2 35333 . 36530)) (36609 56608 (
\TEDIT.GET.PCTB1 36619 . 43310) (\TEDIT.GET.PAGEFRAMES1 43312 . 43764) (\TEDIT.PARSE.PAGEFRAMES1 43766
. 46419) (\TEDIT.GET.CHARLOOKS1 46421 . 50466) (\TEDIT.GET.PARALOOKS1 50468 . 54874) (
TEDIT.GET.OBJECT1 54876 . 56606)) (56668 70486 (\TEDIT.GET.PCTB0 56678 . 60641) (\TEDIT.GET.CHARLOOKS0
60643 . 64738) (\TEDIT.GET.OBJECT0 64740 . 66799) (\TEDIT.GET.PARALOOKS0 66801 . 70484)))))
(FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) (
\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) (
\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) (
\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) (
\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) (
\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 (
\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203
. 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) (
TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0
62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Jan-2025 23:09:11" {WMEDLEY}<library>tedit>TEDIT-PAGE.;204 131960
(FILECREATED "24-Dec-2024 21:32:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;200 121366
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.FORMATFOLIO \TEDIT.FORMATHEADING \TEDIT.HARDCOPY.PAGEHEADINGS
TEDIT.SINGLE.PAGEFORMAT)
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
:PREVIOUS-DATE " 7-Jan-2025 22:54:12" {WMEDLEY}<library>tedit>TEDIT-PAGE.;203)
:PREVIOUS-DATE "11-Dec-2024 22:39:52" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;198)
(PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -86,11 +85,6 @@
(B5 499 709]
(COMS (* ; "Page numbering option support")
(FNS ROMANNUMERALS))
(COMS (* ; "Page number image obj")
(FNS TEDIT.PAGENO.CREATE \TEDIT.PAGENO.OBJINIT \TEDIT.PAGENO.BUTTONEVENTINFN
\TEDIT.PAGENO.IMAGEBOXFN \TEDIT.PAGENO.DISPLAYFN \TEDIT.PAGENO.GETFN
\TEDIT.PAGENO.PUTFN)
(P (\TEDIT.PAGENO.OBJINIT)))
(COMS
(* ;; "Foot note support")
@@ -313,8 +307,7 @@
(TEDIT.SINGLE.PAGEFORMAT
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
PAGEPROPS PAPERSIZE) (* ; "Edited 10-Jan-2025 11:41 by rmk")
(* ; "Edited 24-Dec-2024 21:20 by rmk")
PAGEPROPS PAPERSIZE) (* ; "Edited 24-Dec-2024 21:20 by rmk")
(* ; "Edited 15-Aug-2024 23:01 by rmk")
(* ; "Edited 6-Aug-2024 12:06 by rmk")
(* ; "Edited 13-Nov-2023 08:59 by rmk")
@@ -356,27 +349,22 @@
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
LEFT))
(CL:WHEN PAGE#S?
(* ;; "This asserts that the page number's region is 4 inches wide. Why? What if the pretext/posttext is longer?")
(SELECTQ (U-CASE PQUAD)
(LEFT (* ;
 "If the page number is flush left, set up the region to start where he specified.")
(SETQ FOLIOLEFT PX))
(RIGHT (* ;
 "If it's flush right, set up the region to END there")
(SETQ FOLIOLEFT (IDIFFERENCE PX (ITIMES 4 PTSPERINCH))))
(SETQ FOLIOLEFT (IDIFFERENCE PX 288)))
((CENTERED CENTER NIL) (* ;
 "Otherwise, center the page number around the point he specifies")
(SETQ FOLIOLEFT (IDIFFERENCE PX (ITIMES 2 PTSPERINCH))))
(SETQ FOLIOLEFT (IDIFFERENCE PX 144)))
(ERROR "Invalid page number alignment" PQUAD))
(* ;; "Note that the folio charlooks is a charlooks spec-list, not a CHARLOOKS. The parse/unparse is just to get the priority union of PFONT with the defaults.")
(* ;; "RMK: Very odd to default here 4 inches and 1/2 for the folio region. ")
(* ;; "PY is described as the baseline of the page numbers, measured from the bottom of the page. So the page numbers and pre/posttext sit above.")
[SETQ SUBREGIONS (LIST (create PAGEREGION
REGIONFILLMETHOD _ 'FOLIO
REGIONSPEC _
@@ -400,7 +388,7 @@
(for HDG LEFT in HEADINGS when (CAR HDG)
collect
(* ;; "Run thru the list of headings, building a box for each. By default the heading's width runs up to the right margin on the page. X/LEFT is the left end of the top line, Y is the %"position of the top line%"--it's YTOP, baseline, or YBOT? But SPECIALX and SPECIALY are described as %"the distances from the lower-left corner of the paper: the lower-left corner of the paragraph's top line is placed at the specified position, so this suggests YBOT.")
(* ;; "Run thru the list of headings, building a box for each. By default, a heading will have the same width right margin as the left margin that was specified.")
(if (AND (NUMBERP (CADR HDG))
(NUMBERP (CADDR HDG)))
@@ -937,9 +925,7 @@
(SETPFS FORMATTINGSTATE CHNO CHNO])
(\TEDIT.FORMATHEADING
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 9-Jan-2025 22:27 by rmk")
(* ; "Edited 3-Jan-2025 14:29 by rmk")
(* ; "Edited 24-Nov-2024 11:46 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 24-Nov-2024 11:46 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 17-Nov-2024 19:10 by rmk")
(* ; "Edited 26-Oct-2024 10:43 by rmk")
@@ -955,26 +941,26 @@
(* ; "Edited 9-May-2023 20:30 by rmk")
(* ; "Edited 9-Oct-90 13:24 by jds")
(* ;; "Grab heading SELPIECES from the FORMATTINGSTATE and use them to fill REGION on a page. Return a list of line descriptors which fill the region. The SELPIECES are constructed by \TEDIT.HARDCOPY.PAGEHEADINGS")
(* ;; "Grab heading pieces from the FORMATTINGSTATE and use them to fill REGION on a page. Return a list of line descriptors which fill the region.")
(LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
(PAGE# (GETPFS FORMATTINGSTATE PAGE#))
HEADINGTEXTOBJ HEADINGSTREAM HEADING)
(DECLARE (SPECVARS PAGE#))
(CL:WHEN [SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
(LISTGET LOCALINFO 'HEADINGTYPE]
HEADINGTEXTOBJ HEADINGSTREAM FORCENEXTPAGE HEADING)
(CL:WHEN [AND (for FORM inside (LISTGET LOCALINFO 'PRECONDITIONS) always (EVAL FORM))
(SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
(LISTGET LOCALINFO 'HEADINGTYPE]
(* ;; "Bind the stream to make sure it isn't collected.")
[SETQ HEADINGSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
`(PARALOOKS ,(PPARALOOKS (GETSPC HEADING SPFIRST]
(SETQ HEADINGTEXTOBJ (GETTSTR HEADINGSTREAM TEXTOBJ))
`(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST)
of HEADING]
(SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of HEADINGSTREAM))
(* ;; "Insert the heading pieces into HEADINGTEXTOBJ")
(\TEDIT.INSERTPIECES (GETSPC HEADING SPFIRST)
(\TEDIT.INSERTPIECES (fetch (SELPIECES SPFIRST) of HEADING)
(\TEDIT.ALIGNEDPIECE 1 HEADINGTEXTOBJ)
HEADINGTEXTOBJ)
@@ -982,24 +968,24 @@
(* ;; "Why is BOTTOM said to be the %"top%" of the region to be filled?")
(bind LINE YBOT FORCENEXTPAGE (BOTTOM _ (fetch (REGION BOTTOM) of REGION))
(TEXTLEN _ (TEXTLEN HEADINGTEXTOBJ))
(CHNO _ 1) while (ILESSP CHNO TEXTLEN) until FORCENEXTPAGE
(bind LINE YBOT (BOTTOM _ (fetch (REGION BOTTOM) of REGION))
(LEN _ (TEXTLEN HEADINGTEXTOBJ))
(CHNO _ 1) while (ILESSP CHNO LEN) until FORCENEXTPAGE
collect
(* ;; "Format the next line from HEADINGTEXTOBJ pieces")
(SETQ LINE (\TEDIT.FORMATLINE HEADINGSTREAM CHNO NIL REGION PRSTREAM
FORMATTINGSTATE))
(SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ HEADINGTEXTOBJ STREAMHINT)
CHNO NIL REGION PRSTREAM FORMATTINGSTATE))
(SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
(FGETLD LINE FORCED-END)))
[SETQ YBOT (if YBOT
then (* ;
(GETLD LINE FORCED-END)))
[SETQ YBOT (COND
(YBOT (* ;
 "Take account of this line's height")
(IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))
else (* ;
(IDIFFERENCE YBOT (FGETLD LINE LHEIGHT)))
(T (* ;
 "First line: position it at the top of the region.")
(IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
(IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
(SETYBOT LINE YBOT)
(SETQ CHNO (FGETLD LINE LCHARLIM)) (* ; "Set the start of the next line")
LINE))])
@@ -1372,9 +1358,7 @@
TEXTOBJ FORMATTINGSTATE FINAL-CHNO)))])
(\TEDIT.FORMATFOLIO
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 9-Jan-2025 21:52 by rmk")
(* ; "Edited 3-Jan-2025 14:28 by rmk")
(* ; "Edited 24-Nov-2024 11:46 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 24-Nov-2024 11:46 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 17-Nov-2024 19:16 by rmk")
(* ; "Edited 26-Oct-2024 10:46 by rmk")
@@ -1394,8 +1378,7 @@
(LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
FOLIOSTREAM PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
(DECLARE (SPECVARS PAGE#))
FOLIOSTREAM FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
(CL:UNLESS (AND (GETPFS FORMATTINGSTATE FIRSTPAGE)
(LISTGET FOLIOINFO 'NOFIRSTPAGE)) (* ;
 "If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
@@ -1421,25 +1404,29 @@
`(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
LOOKS
,(LISTGET FOLIOINFO 'CHARLOOKS]
(SETQ FOLIOTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of FOLIOSTREAM))
(TEDIT.INSERT FOLIOSTREAM (CONCAT PRETEXT PAGE# POSTTEXT)
1 NIL T)
(bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN (GETTSTR FOLIOSTREAM TEXTOBJ)))
(bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ))
(BOTTOM _ (fetch (REGION BOTTOM) of REGION))
(CHNO _ 1) while (ILEQ CHNO TEXTLEN) until FORCENEXTPAGE
collect (SETQ LINE (\TEDIT.FORMATLINE FOLIOSTREAM CHNO NIL REGION PRSTREAM
FORMATTINGSTATE))
collect (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ FOLIOTEXTOBJ STREAMHINT)
CHNO NIL REGION PRSTREAM FORMATTINGSTATE))
(SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
(FGETLD LINE FORCED-END)))
(GETLD LINE FORCED-END)))
(* ; "Format the next possible line")
[SETQ YBOT (if YBOT
then (* ;
 " Take account of this line's height")
(IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))
else (* ;
 "First line: position it at the top of the region.")
(IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
(SETQ CHNO (FGETLD LINE LCHARLIM)) (* ;
 "Keep track of the next character...")
[SETQ YBOT (COND
(YBOT (* ;
 "We're into it; take account of this line's height")
(IDIFFERENCE YBOT (FGETLD LINE LHEIGHT)))
(T (* ;
 "Just starting out; find the line's position with respect to the top of the region to be filled.")
(IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT]
(CL:WHEN (ILESSP YBOT (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT)))
(GO $$ITERATE))
(SETYBOT LINE YBOT) (* ; "This line is still good")
(SETQ CHNO (FGETLD LINE LCHARLIM)) (* ; "Set the start of the next line")
LINE))])
(\TEDIT.FORMAT.FOUNDBOX?
@@ -1509,31 +1496,27 @@
(DEFINEQ
(\TEDIT.HARDCOPY.PAGEHEADINGS
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 12-Jan-2025 17:31 by rmk")
(* ; "Edited 10-Jan-2025 15:42 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 9-May-2023 17:46 by rmk")
(* ; "Edited 7-May-2023 23:45 by rmk")
(* ; "Edited 9-Oct-2022 17:12 by rmk")
(* ;; "This runs thru all the headings starting at CHNO in TEXTOBJ, copying the pieces of the different heading types into SELPIECES in FORMATTINGSTATE, and returning the starting CHNO of the first non-heading piece. ")
(* ;; "This runs thru all the headings starting at CHNO, copying the pieces of the different heading types into FORMATTINGSTATE, and returning the starting CHNO of the first non-heading piece. ")
(CL:UNLESS FORMATTINGSTATE (* ;
 "If it isn't there, we would loose the headings")
(\TEDIT.THELP "NIL FORMATTINGSTATE"))
(bind HEADINGSUBTYPE (PC _ (\TEDIT.CHTOPC CHNO TEXTOBJ))
while (AND PC (EQ 'PAGEHEADING (GETPARA (PPARALOOKS PC)
FMTPARATYPE)))
do (SETQ HEADINGSUBTYPE (GETPARA (PPARALOOKS PC)
FMTPARASUBTYPE))
(for P (START _ CHNO) inpieces PC while (AND (EQ 'PAGEHEADING (GETPARA (PPARALOOKS P)
FMTPARATYPE))
(EQ HEADINGSUBTYPE (GETPARA (PPARALOOKS P)
FMTPARASUBTYPE)))
while [AND PC (EQ 'PAGEHEADING (fetch FMTPARATYPE of (PPARALOOKS PC]
do (SETQ HEADINGSUBTYPE (fetch FMTPARASUBTYPE of (PPARALOOKS PC)))
(for P (START _ CHNO) inpieces PC while [AND (EQ 'PAGEHEADING (fetch FMTPARATYPE
of (PPARALOOKS P)))
(EQ HEADINGSUBTYPE (fetch FMTPARASUBTYPE
of (PPARALOOKS P]
do
(* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the selpieces")
(* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the piecerange")
(add CHNO (PLEN P)) finally (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
HEADINGSUBTYPE
@@ -1544,30 +1527,6 @@
 "Set PC to continue looking for the next headingtype.")
(SETQ PC P)))
(* ;; "For backward compatibility, this uses the information in the pageformat to create SELPIECES covering the pretext, pageno, and posttest, where the pageno is produced by the PAGENO image object. We create a scratch textstream so that we can use the standard TEDIT.INSERT and TEDIT.INSERT.OBJECT, then throw it away. This only happens once, when this heading is encountered, even if the pieces are rendered on multiple pages.")
[LET ((FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
INFOLIST FOLIOSTREAM FOLIOTEXTOBJ)
(* ;; "Have to set the SPECIALX and SPECIALY according to the PX and PY. And PQUAD")
(CL:WHEN FOLIOINFO
(SETQ INFOLIST (LISTGET FOLIOINFO 'FORMATINFO))
[SETQ FOLIOSTREAM (OPENTEXTSTREAM NIL NIL `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
LOOKS
,(LISTGET FOLIOINFO 'CHARLOOKS]
(SETQ FOLIOTEXTOBJ (GETTSTR FOLIOSTREAM TEXTOBJ))
(CL:WHEN (CADR INFOLIST)
(TEDIT.INSERT FOLIOSTREAM (MKSTRING (CADR INFOLIST))))
(TEDIT.INSERT.OBJECT (TEDIT.PAGENO.CREATE (CAR INFOLIST))
FOLIOSTREAM)
(CL:WHEN (CADDR INFOLIST)
(TEDIT.INSERT FOLIOSTREAM (MKSTRING (CADDR INFOLIST))))
(LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
'\TEDIT.PAGENO
(\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES 1 (TEXTLEN FOLIOTEXTOBJ)
FOLIOTEXTOBJ))))]
CHNO])
)
@@ -1891,141 +1850,6 @@
(* ; "Page number image obj")
(DEFINEQ
(TEDIT.PAGENO.CREATE
[LAMBDA (FORMAT) (* ; "Edited 7-Jan-2025 14:14 by rmk")
(* ; "Edited 3-Jan-2025 14:44 by rmk")
(LET ((OBJ (IMAGEOBJCREATE NIL TEDIT.PAGENOOBJ.IMAGEFNS)))
(IMAGEOBJPROP OBJ 'FORMAT (OR FORMAT 'ARABIC))
OBJ])
(\TEDIT.PAGENO.OBJINIT
[LAMBDA NIL (* ; "Edited 7-Jan-2025 22:54 by rmk")
(* ; "Edited 3-Jan-2025 15:01 by rmk")
(* jds " 9-Feb-86 15:17")
(* ;; "Initialize the IMAGEFNS for a page-number image object")
(DECLARE (GLOBALVARS TEDIT.PAGENOOBJ.IMAGEFNS))
(SETQ TEDIT.PAGENOOBJ.IMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEDIT.PAGENO.DISPLAYFN)
(FUNCTION \TEDIT.PAGENO.IMAGEBOXFN)
(FUNCTION \TEDIT.PAGENO.PUTBOXFN)
(FUNCTION \TEDIT.PAGENO.GETFN)
[FUNCTION (LAMBDA (OBJ)
(create IMAGEOBJ copying OBJ]
(FUNCTION \TEDIT.PAGENO.BUTTONEVENTINFN)
'NILL
'NILL
'NILL
'NILL
'NILL NIL 'NILL 'PageNumber])
(\TEDIT.PAGENO.BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)
(* ; "Edited 3-Jan-2025 14:32 by rmk")
(* ; "Edited 14-Aug-93 19:44 by rmk:")
(* ;; "Allow the user to change the page-number printed format.")
(* ;;; "the user has pressed a button inside the bitmap object IMAGEOBJ. Bring up a menu of bitmap edit operations.")
(CL:WHEN (AND (EQ BUTTON 'LEFT)
(EQ OPERATION 'NORMAL))
(LET (FORMAT)
[SETQ FORMAT (MENU (create MENU
ITEMS _ '((Arabic 'ARABIC)
("Lower Roman" 'LOWERROMAN)
(" Upper Roman" 'UPPERROMAN]
(CL:WHEN [AND FORMAT (NEQ FORMAT (IMAGEOBJPROP IMAGEOBJ 'FORMAT]
(IMAGEOBJPROP IMAGEOBJ 'FORMAT FORMAT)
'CHANGED)))])
(\TEDIT.PAGENO.IMAGEBOXFN
[LAMBDA (OBJ IMAGESTREAM) (* ; "Edited 3-Jan-2025 14:30 by rmk")
(* ; "Edited 26-Aug-2024 09:36 by rmk")
(* ; "Edited 3-Aug-2024 13:10 by rmk")
(* ; "Edited 19-Jul-2024 23:26 by rmk")
(* ; "Edited 11-Oct-2022 22:51 by rmk")
(* ; "Edited 4-Oct-2022 11:59 by rmk")
(* ;; "Creates the box for a page number, a place holder on the display, otherwise the properly formatted number. Looks come from the font.")
(* ;;
 "Create the box for a menu button containing LABEL in font FONT on STREAM (NIL means display).")
(DECLARE (USEDFREE PAGE#))
(LET ((FONT (DSPFONT NIL IMAGESTREAM))
(FORMAT (IMAGEOBJPROP OBJ 'FORMAT))
YSIZE XSIZE)
(SETQ YSIZE (FONTPROP FONT 'HEIGHT))
(SETQ XSIZE (STRINGWIDTH (if (DISPLAYSTREAMP IMAGESTREAM)
then (CONCAT "[P#" (SELECTQ FORMAT
(SELECTQ FORMAT
(LOWERROMAN "x")
(UPPERROMAN "X")
(MKSTRING "1")))
"]")
else (SELECTQ FORMAT
(LOWERROMAN (ROMANNUMERALS PAGE#))
(UPPERROMAN (ROMANNUMERALS PAGE# T))
(MKSTRING PAGE#)))
FONT))
(create IMAGEBOX
XSIZE _ XSIZE
YSIZE _ YSIZE
YDESC _ 0
XKERN _ 0])
(\TEDIT.PAGENO.DISPLAYFN
[LAMBDA (OBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM) (* ; "Edited 3-Jan-2025 14:30 by rmk")
(* ; "Edited 26-Aug-2024 09:36 by rmk")
(* ; "Edited 3-Aug-2024 13:10 by rmk")
(* ; "Edited 19-Jul-2024 23:26 by rmk")
(* ; "Edited 11-Oct-2022 22:51 by rmk")
(* ; "Edited 4-Oct-2022 11:59 by rmk")
(* jds "30-Aug-84 11:24")
(* ;; "Display the page number on IMAGESTREAM, a place holder for display, otherwise a formatted number. Looks come from the font.")
(DECLARE (USEDFREE PAGE#))
(LET [(FORMAT (IMAGEOBJPROP OBJ 'FORMAT]
(PRIN3 (if (DISPLAYSTREAMP IMAGESTREAM)
then (CONCAT "[P#" (SELECTQ FORMAT
(SELECTQ FORMAT
(LOWERROMAN "x")
(UPPERROMAN "X")
(MKSTRING "1")))
"]")
else (SELECTQ FORMAT
(LOWERROMAN (ROMANNUMERALS PAGE#))
(UPPERROMAN (ROMANNUMERALS PAGE# T))
(MKSTRING PAGE#)))
IMAGESTREAM])
(\TEDIT.PAGENO.GETFN
[LAMBDA (FILESTREAM) (* ; "Edited 3-Jan-2025 14:13 by rmk")
(LET ((X (READ FILESTREAM (FIND-READTABLE "INTERLISP" T)))
OBJ)
(SETQ OBJ (IMAGEOBJCREATE (CAR X)
PAGENOOBJ.IMAGEFNS))
(replace (IMAGEOBJ IMAGEOBJPLIST) of OBJ with (CDR X))
OBJ])
(\TEDIT.PAGENO.PUTFN
[LAMBDA (OBJ FILESTREAM) (* ; "Edited 3-Jan-2025 15:01 by rmk")
(PRINT (CONS (fetch (IMAGEOBJ OBJECTDATUM) of OBJ)
(fetch (IMAGEOBJ IMAGEOBJPLIST) of OBJ))
FILESTREAM
(FIND-READTABLE "INTERLISP"])
)
(\TEDIT.PAGENO.OBJINIT)
(* ;; "Foot note support")
(DEFINEQ
@@ -2071,18 +1895,15 @@
(RETURN (DREMOVE NIL $$VAL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12253 15865 (\TEDIT.PARSE.PAGEFRAMES 12263 . 14042) (\TEDIT.PUT.PAGEFRAMES 14044 .
14868) (\TEDIT.UNPARSE.PAGEFRAMES 14870 . 15863)) (15928 37826 (TEDIT.SINGLE.PAGEFORMAT 15938 . 26812)
(TEDIT.COMPOUND.PAGEFORMAT 26814 . 27793) (TEDIT.PAGEFORMAT 27795 . 35084) (TEDIT.GET.PAGEFORMAT
35086 . 37824)) (38113 48615 (TEDIT.FORMAT.HARDCOPY 38123 . 48613)) (48702 100270 (\TEDIT.FORMATBOX
48712 . 61815) (\TEDIT.FORMATHEADING 61817 . 66463) (\TEDIT.FORMATPAGE 66465 . 74995) (
\TEDIT.FORMATTEXTBOX 74997 . 90921) (\TEDIT.FORMATFOLIO 90923 . 96240) (\TEDIT.FORMAT.FOUNDBOX? 96242
. 98281) (\TEDIT.SKIP.SPECIALCOND 98283 . 100268)) (100350 104856 (\TEDIT.HARDCOPY.PAGEHEADINGS
100360 . 104854)) (104965 112694 (\TEDIT.HARDCOPY-COLUMN-END 104975 . 112692)) (112739 117680 (
SCALEPAGEUNITS 112749 . 113890) (SCALEPAGEXUNITS 113892 . 114662) (SCALEPAGEYUNITS 114664 . 115435) (
\TEDIT.PAPERHEIGHT 115437 . 116372) (\TEDIT.PAPERWIDTH 116374 . 117678)) (118096 121664 (ROMANNUMERALS
118106 . 121662)) (121703 128969 (TEDIT.PAGENO.CREATE 121713 . 122089) (\TEDIT.PAGENO.OBJINIT 122091
. 123374) (\TEDIT.PAGENO.BUTTONEVENTINFN 123376 . 124442) (\TEDIT.PAGENO.IMAGEBOXFN 124444 . 126594)
(\TEDIT.PAGENO.DISPLAYFN 126596 . 128246) (\TEDIT.PAGENO.GETFN 128248 . 128640) (\TEDIT.PAGENO.PUTFN
128642 . 128967)) (129034 131937 (\TEDIT.FORMAT.FOOTNOTE 129044 . 131935)))))
(FILEMAP (NIL (11801 15413 (\TEDIT.PARSE.PAGEFRAMES 11811 . 13590) (\TEDIT.PUT.PAGEFRAMES 13592 .
14416) (\TEDIT.UNPARSE.PAGEFRAMES 14418 . 15411)) (15476 36629 (TEDIT.SINGLE.PAGEFORMAT 15486 . 25615)
(TEDIT.COMPOUND.PAGEFORMAT 25617 . 26596) (TEDIT.PAGEFORMAT 26598 . 33887) (TEDIT.GET.PAGEFORMAT
33889 . 36627)) (36916 47418 (TEDIT.FORMAT.HARDCOPY 36926 . 47416)) (47505 98986 (\TEDIT.FORMATBOX
47515 . 60618) (\TEDIT.FORMATHEADING 60620 . 65142) (\TEDIT.FORMATPAGE 65144 . 73674) (
\TEDIT.FORMATTEXTBOX 73676 . 89600) (\TEDIT.FORMATFOLIO 89602 . 94956) (\TEDIT.FORMAT.FOUNDBOX? 94958
. 96997) (\TEDIT.SKIP.SPECIALCOND 96999 . 98984)) (99066 101596 (\TEDIT.HARDCOPY.PAGEHEADINGS 99076
. 101594)) (101705 109434 (\TEDIT.HARDCOPY-COLUMN-END 101715 . 109432)) (109479 114420 (
SCALEPAGEUNITS 109489 . 110630) (SCALEPAGEXUNITS 110632 . 111402) (SCALEPAGEYUNITS 111404 . 112175) (
\TEDIT.PAPERHEIGHT 112177 . 113112) (\TEDIT.PAPERWIDTH 113114 . 114418)) (114836 118404 (ROMANNUMERALS
114846 . 118402)) (118440 121343 (\TEDIT.FORMAT.FOOTNOTE 118450 . 121341)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2025 10:36:27" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;850 186125
(FILECREATED "24-Dec-2024 22:16:22" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;845 185725
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.UPDATE.LINES)
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
:PREVIOUS-DATE "21-Jan-2025 16:05:23" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;849)
:PREVIOUS-DATE "19-Dec-2024 11:51:04" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;840)
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -2322,10 +2322,7 @@
1)])
(\TEDIT.UPDATE.LINES
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 1-Feb-2025 10:34 by rmk")
(* ; "Edited 21-Jan-2025 13:25 by rmk")
(* ; "Edited 7-Jan-2025 11:55 by rmk")
(* ; "Edited 7-Dec-2024 21:52 by rmk")
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 7-Dec-2024 21:52 by rmk")
(* ; "Edited 29-Nov-2024 22:56 by rmk")
(* ; "Edited 26-Nov-2024 03:35 by rmk")
(* ; "Edited 22-Nov-2024 17:57 by rmk")
@@ -2356,6 +2353,10 @@
else (CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO 1))
(CL:UNLESS NCHARSCHANGED
(SETQ NCHARSCHANGED (FGETTOBJ TEXTOBJ TEXTLEN)))]
(* ;;
 "If DONTDISPLAY, we ensure lines that are properly formatted and positioned but not displayed.")
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
(for PANE VALIDS LASTVALID NEXTVALID LASTGAPLINE UPPERBITMAPLINES BITMAPLINES inpanes TEXTOBJ
when (SETQ VALIDS (\TEDIT.VALID.LINES PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON
@@ -2366,10 +2367,10 @@
(SETQ LASTVALID (CAR VALIDS))
(SETQ NEXTVALID (CDR VALIDS)) (* ; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.")
[SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TEXTOBJ
(CL:IF NEXTVALID
(SUB1 (FGETLD NEXTVALID LCHAR1))
(TEXTLEN TEXTOBJ))]
(SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID (CL:IF NEXTVALID
(SUB1 (FGETLD NEXTVALID LCHAR1))
(TEXTLEN TEXTOBJ))
PANE TEXTOBJ))
(* ;;
 "The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.")
@@ -2377,15 +2378,9 @@
(LINKLD LASTGAPLINE NEXTVALID)
(if NEXTVALID
then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID))
else (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTGAPLINE))
(* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix")
(CL:WHEN (IGEQ (FGETLD LASTVALID YBOT)
(PANETOP PANE))
(LINKLD (PANEPREFIX PANE)
(FGETLD LASTVALID NEXTLINE)))
(\TEDIT.SHIFTLINES LASTVALID PANE TEXTOBJ BITMAPLINES UPPERBITMAPLINES)))])
else (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTGAPLINE))
(\TEDIT.SHIFTLINES LASTVALID (FGETLD LASTVALID NEXTLINE)
PANE TEXTOBJ BITMAPLINES UPPERBITMAPLINES)))])
(\TEDIT.PANE.CREATELINES
[LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 29-Nov-2024 09:14 by rmk")
@@ -2461,8 +2456,7 @@
SUFFIX])
(\TEDIT.LINES.BELOW
[LAMBDA (PREVLINE PANE TEXTOBJ) (* ; "Edited 21-Jan-2025 13:31 by rmk")
(* ; "Edited 24-Nov-2024 14:57 by rmk")
[LAMBDA (PREVLINE PANE TEXTOBJ) (* ; "Edited 24-Nov-2024 14:57 by rmk")
(* ; "Edited 22-Nov-2024 00:53 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 18-Nov-2024 21:12 by rmk")
@@ -2482,27 +2476,26 @@
(* ; "Edited 15-Mar-2024 19:22 by rmk")
(* ; "Edited 23-Dec-2023 23:38 by rmk")
(* ; "Edited 14-Dec-2023 12:46 by rmk")
(CL:UNLESS PREVLINE
(SETQ PREVLINE (PANEPREFIX PANE)))
(* ;; "Formats and displays lines after PREVLINE down to the one is at least partially visible at the bottom of PANE. Each line is positioned with respect to its predecessor and linked to it. The last visible line is set as the BOTTOMLINE of PANE, PANE's suffix is adjusted to cover the bitmap and all the unseen later characters. Returns the last displayed line.")
(for L NEXT YBOT (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines PREVLINE
(for L NEXT YBOT (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines (OR PREVLINE (PANEPREFIX
PANE))
eachtime (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (FGETLD L LCHARLIM)))
until (FGETLD NEXT LDUMMY) do (SETQ YBOT (\TEDIT.LINE.BOTTOM L NEXT))
(SETYBOT NEXT YBOT)
(CL:WHEN (ILESSP YBOT BOTTOM)
(* ; "Ran off the bottom")
(RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE)
then (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)
(LINKLD L NEXT)
(* ; "Keep NEXT with partial display")
then (LINKLD L NEXT)
(* ; "Keep it with partial display")
(\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)
NEXT
else (* ; "Overshot, throw NEXT away")
else (* ; "Overshot")
L)))
(LINKLD L NEXT)
(CL:WHEN (FGETLD NEXT LDUMMY)
(* ; "Suffix line: end of pane")
(* ; "Suffix line")
(RETURN L))
(\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)
(* ;
@@ -2514,8 +2507,7 @@
(RETURN L])
(\TEDIT.MEASURED.LINES
[LAMBDA (PREVLINE PANE TEXTOBJ LASTCHAR) (* ; "Edited 21-Jan-2025 13:30 by rmk")
(* ; "Edited 7-Dec-2024 16:55 by rmk")
[LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 7-Dec-2024 16:55 by rmk")
(* ; "Edited 1-Dec-2024 11:26 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 18-Nov-2024 20:01 by rmk")
@@ -2530,9 +2522,9 @@
(SETYBOT NEXT YBOT)
(CL:WHEN (ILESSP YBOT PBOTTOM) (* ; "NEXT runs off the bottom")
(RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE)
then (LINKLD L NEXT) (* ; "Keep NEXT with partial display")
then (LINKLD L NEXT) (* ; "Keep it with partial display")
NEXT
else (* ; "Overshot, throw NEXT away")
else (* ; "Overshot")
L)))
(LINKLD L NEXT) (* ; "Keeps the iteration going")
finally
@@ -2543,14 +2535,17 @@
(\TEDIT.VALID.LINES
[LAMBDA (PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON TSTREAM)
(* ; "Edited 21-Jan-2025 15:22 by rmk")
(* ; "Edited 6-Jan-2025 15:19 by rmk")
(* ; "Edited 22-Nov-2024 16:54 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 5-Jul-2024 22:58 by rmk")
(* ; "Edited 4-Jul-2024 10:48 by rmk")
(* ; "Edited 28-Jun-2024 15:27 by rmk")
(* ; "Edited 15-Jun-2024 17:32 by rmk")
(* ; "Edited 12-Jun-2024 23:59 by rmk")
(* ; "Edited 23-May-2024 12:48 by rmk")
(* ; "Edited 20-Apr-2024 22:11 by rmk")
(* ; "Edited 20-Mar-2024 06:46 by rmk")
(* ; "Edited 22-Feb-2024 01:05 by rmk")
(* ; "Edited 3-Nov-2023 12:07 by rmk")
(* ; "Edited 14-Jun-2023 15:55 by rmk")
@@ -2559,18 +2554,18 @@
(* ;; "Called when changes have been made to the document that affect the lines displayed in PANE. Return NIL if the change is not visible in PANE. Otherwise, this divides the lines in PANE into 3 segments:")
(* ;; " 1. a prefix of lines from the top visible line (next of PANEPREFIX) to the LASTVALID line, the line just before the first changed line.")
(* ;; " 1. a prefix of lines from the top visible line (next of PREFIXLINE) to the LASTVALID line, the line just before the first changed line.")
(* ;; " 2. an intermediate sequence of lines that are (or may be) no longer valid because of the change.")
(* ;;
 " 3. a suffix of post-change lines, starting with NEXTVALID, that are known still to be valid.")
 " 3. a suffix of post-chamge lines, starting with NEXTVALID, that are known still to be valid.")
(* ;; "A line is %"valid%" if its line breaking is unaffected by the change and the bits in the screen bitmap that represented it before the change are still correct.")
(* ;; "")
(* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from the prefix line to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID and PREVLINE of NEXTVALID).")
(* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from PREFIXLINE to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID).")
(* ;; "")
@@ -2607,28 +2602,31 @@
(CL:UNLESS SUFFIXLINE
(\TEDIT.THELP "NO SUFFIXLINE")
(RETURN NIL))
(SETQ FIRSTVISIBLECHNO (FGETLD PREFIXLINE LCHARLIM))
(SETQ LASTVISIBLECHNO (SUB1 (FGETLD SUFFIXLINE LCHAR1)))
(CL:WHEN (IGREATERP FIRSTCHANGEDCHNO LASTVISIBLECHNO)
(* ;
 "Change after previously visible lines")
(CL:UNLESS (ILEQ LASTCHANGEDCHNO (TEXTLEN TEXTOBJ))
(* ;
 "Change is after PANE, nothing to do")
(RETURN NIL))
(RETURN NIL)) (* ;
 "Unless adding past the end, nothing to do ")
(* ;; "Adding at the end of the document: insert a new line")
(\TEDIT.INSERTLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO)
SUFFIXLINE))
(SETQ FIRSTVISIBLECHNO (FGETLD PREFIXLINE LCHARLIM))
(SETQ FIRSTCHANGEDLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO))
(LINKLD (FGETLD SUFFIXLINE PREVLINE)
FIRSTCHANGEDLINE)
(LINKLD FIRSTCHANGEDLINE SUFFIXLINE)) (* ;
 "Change is after PANE, nothing to do")
(* ;;; "Change is visible in PANE, there's gotta be a FIRSTCHANGEDLINE")
(SETQ FIRSTCHANGEDLINE (find L inlines (FGETLD PREFIXLINE NEXTLINE)
suchthat (FWITHINLINEP FIRSTCHANGEDCHNO L)))
(CL:UNLESS FIRSTCHANGEDLINE (* ; "Changes are not visible")
(RETURN NIL))
(* ;; "Change is visible in PANE, look for the last valid line (in PANE).")
(* ;; "Updates may be required in lines before the FIRSTCHANGEDLINE, if words jump around.")
(SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTVISIBLECHNO PANE TSTREAM))
(SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM))
(* ;; "Now for the after-change lines")
@@ -2640,21 +2638,19 @@
 "Last changed line is visible, its changes may cause character to shift to or from lower lines.")
(SETQ NEXTVALIDLINE (\TEDIT.NEXTVALIDLINE LASTCHANGEDLINE TSTREAM)))
(CL:WHEN NEXTVALIDLINE
(FSETLD NEXTVALIDLINE PREVLINE NIL)
(CL:WHEN DELTA
(CL:WHEN (AND NEXTVALIDLINE DELTA)
(* ;; "If the modification added or substracted to the number of characters, translate the character positions of the still-valid lines that are visible later than the change. ")
(* ;; "If the modification added or substracted to the number of characters, translate the character positions of the still-valid lines that are visible later than the change. ")
(for L inlines NEXTVALIDLINE do (add (FGETLD L LCHAR1)
DELTA)
(add (FGETLD L LCHARLAST)
DELTA))))
(for L inlines NEXTVALIDLINE do (add (FGETLD L LCHAR1)
DELTA)
(add (FGETLD L LCHARLAST)
DELTA)))
(* ;; "")
(CL:WHEN LASTVALIDLINE
(FSETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop out the now useless lines")
(FSETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop off the now useless lines")
(RETURN (CONS LASTVALIDLINE NEXTVALIDLINE)))])
(\TEDIT.LASTVALIDLINE
@@ -2714,19 +2710,18 @@
PTOP])
(\TEDIT.NEXTVALIDLINE
[LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 21-Jan-2025 15:27 by rmk")
(* ; "Edited 29-Nov-2024 23:31 by rmk")
[LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 29-Nov-2024 23:31 by rmk")
(* ; "Edited 16-Nov-2024 11:00 by rmk")
(* ;; "We know we can stop when we see a forced end-- characters won't move around after that. In the usual case, the forced-end is a also the last line of a paragraph, but we can't just take the first line of the next paragraph because we can't deal here with whatever paragraph leading it might have (and the venue sysout also screwed up in that case).")
(* ;; "So we go for the second line of the next paragraph, if there is one")
(* ;; "So we got for the second line of the next paragraph, if there is one")
(* ;; "The line after a forced end is valid. But maybe we can figure out how to stop sooner?")
(for L inlines LASTCHANGEDLINE when (FGETLD L FORCED-END)
do
(* ;; "A forced end is usually the last line of a paragraph, and its next line is probably valid. But we skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading to worry about.")
(* ;; "If we reach the end of a paragraph, the next line may be the start of the next paragraph. We skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading.")
(CL:WHEN (FGETLD L LSTLN)
(SETQ L (FGETLD L NEXTLINE)))
@@ -2859,21 +2854,21 @@
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (27981 30197 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 27991 . 30195)) (37602 118362 (
\TEDIT.FORMATLINE 37612 . 72352) (\TEDIT.FORMATLINE.SETUP.PARA 72354 . 77177) (
\TEDIT.FORMATLINE.HORIZONTAL 77179 . 81575) (\TEDIT.FORMATLINE.VERTICAL 81577 . 83794) (
\TEDIT.FORMATLINE.JUSTIFY 83796 . 89817) (\TEDIT.FORMATLINE.TABS 89819 . 97619) (\TEDIT.SCALE.TABS
97621 . 98412) (\TEDIT.FORMATLINE.PURGE.SPACES 98414 . 99841) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
99843 . 100744) (\TEDIT.FORMATLINE.EMPTY 100746 . 105432) (\TEDIT.FORMATLINE.UPDATELOOKS 105434 .
111556) (\TEDIT.FORMATLINE.LASTLEGAL 111558 . 115098) (\TEDIT.LINES.ABOVE 115100 . 118360)) (118479
120394 (\TLVALIDATE 118489 . 120392)) (120588 141752 (\TEDIT.DISPLAYLINE 120598 . 134045) (
\TEDIT.DISPLAYLINE.TABS 134047 . 136670) (\TEDIT.LINECACHE 136672 . 137400) (\TEDIT.CREATE.LINECACHE
137402 . 138238) (\TEDIT.BLTCHAR 138240 . 140867) (\TEDIT.DIACRITIC.SHIFT 140869 . 141750)) (142367
186102 (\TEDIT.BACKFORMAT 142377 . 144931) (\TEDIT.PREVIOUS.LINEBREAK 144933 . 147656) (
\TEDIT.UPDATE.LINES 147658 . 152528) (\TEDIT.PANE.CREATELINES 152530 . 155522) (
\TEDIT.SUFFIXLINE.CREATE 155524 . 156899) (\TEDIT.LINES.BELOW 156901 . 161362) (\TEDIT.MEASURED.LINES
161364 . 163264) (\TEDIT.VALID.LINES 163266 . 171527) (\TEDIT.LASTVALIDLINE 171529 . 176351) (
\TEDIT.NEXTVALIDLINE 176353 . 177783) (\TEDIT.CLEARPANE.BELOW.LINE 177785 . 179891) (\TEDIT.INSERTLINE
179893 . 181279) (\TEDIT.LINE.BOTTOM 181281 . 184277) (\TEDIT.SHOW.AT.BOTTOMP 184279 . 185389) (
\TEDIT.SHOW.AT.TOPP 185391 . 186100)))))
(FILEMAP (NIL (27979 30195 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 27989 . 30193)) (37600 118360 (
\TEDIT.FORMATLINE 37610 . 72350) (\TEDIT.FORMATLINE.SETUP.PARA 72352 . 77175) (
\TEDIT.FORMATLINE.HORIZONTAL 77177 . 81573) (\TEDIT.FORMATLINE.VERTICAL 81575 . 83792) (
\TEDIT.FORMATLINE.JUSTIFY 83794 . 89815) (\TEDIT.FORMATLINE.TABS 89817 . 97617) (\TEDIT.SCALE.TABS
97619 . 98410) (\TEDIT.FORMATLINE.PURGE.SPACES 98412 . 99839) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
99841 . 100742) (\TEDIT.FORMATLINE.EMPTY 100744 . 105430) (\TEDIT.FORMATLINE.UPDATELOOKS 105432 .
111554) (\TEDIT.FORMATLINE.LASTLEGAL 111556 . 115096) (\TEDIT.LINES.ABOVE 115098 . 118358)) (118477
120392 (\TLVALIDATE 118487 . 120390)) (120586 141750 (\TEDIT.DISPLAYLINE 120596 . 134043) (
\TEDIT.DISPLAYLINE.TABS 134045 . 136668) (\TEDIT.LINECACHE 136670 . 137398) (\TEDIT.CREATE.LINECACHE
137400 . 138236) (\TEDIT.BLTCHAR 138238 . 140865) (\TEDIT.DIACRITIC.SHIFT 140867 . 141748)) (142365
185702 (\TEDIT.BACKFORMAT 142375 . 144929) (\TEDIT.PREVIOUS.LINEBREAK 144931 . 147654) (
\TEDIT.UPDATE.LINES 147656 . 152101) (\TEDIT.PANE.CREATELINES 152103 . 155095) (
\TEDIT.SUFFIXLINE.CREATE 155097 . 156472) (\TEDIT.LINES.BELOW 156474 . 160836) (\TEDIT.MEASURED.LINES
160838 . 162610) (\TEDIT.VALID.LINES 162612 . 171255) (\TEDIT.LASTVALIDLINE 171257 . 176079) (
\TEDIT.NEXTVALIDLINE 176081 . 177383) (\TEDIT.CLEARPANE.BELOW.LINE 177385 . 179491) (\TEDIT.INSERTLINE
179493 . 180879) (\TEDIT.LINE.BOTTOM 180881 . 183877) (\TEDIT.SHOW.AT.BOTTOMP 183879 . 184989) (
\TEDIT.SHOW.AT.TOPP 184991 . 185700)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 3-Feb-2025 09:32:02" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;645 150146
(FILECREATED "17-Dec-2024 14:29:31" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;638 151180
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.SCAN.LINE)
:CHANGES-TO (FNS \TEDIT.XYTOSEL)
:PREVIOUS-DATE "31-Jan-2025 12:45:17" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;644)
:PREVIOUS-DATE " 6-Dec-2024 12:50:42" {WMEDLEY}<library>TEDIT>TEDIT-SELECTION.;637)
(PRETTYCOMPRINT TEDIT-SELECTIONCOMS)
@@ -570,7 +570,6 @@
(\TEDIT.SCAN.LINE
[LAMBDA (LINE X Y NEWSEL SELOPERATION PANE BUTTON WORDSELFLG)
(* ; "Edited 3-Feb-2025 09:31 by rmk")
(* ; "Edited 6-Dec-2024 11:06 by rmk")
(* ; "Edited 4-Dec-2024 12:06 by rmk")
(* ; "Edited 30-Nov-2024 09:52 by rmk")
@@ -709,17 +708,11 @@
(FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL]
(FSETSEL NEWSEL CHLIM (IPLUS (FGETSEL NEWSEL CH#)
(FGETSEL NEWSEL DCH)))
(FSETSEL NEWSEL POINT (if (FGETLD LINE FORCED-END)
then
(* ;;
 "Always go to the left of an EOL, so caret stays on its line")
'LEFT
elseif [OR PASTRIGHT (EQ MOVED 'BACKWARD)
(AND (IGEQ (CHARW CHARSLOT)
3)
(IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT)
2]
(FSETSEL NEWSEL POINT (if [OR PASTRIGHT (EQ MOVED 'BACKWARD)
(AND (IGEQ (CHARW CHARSLOT)
3)
(IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT)
2]
then
(* ;;
 "Beyond the line, or towards the end of a character that is at least 3 points wide.")
@@ -1714,8 +1707,7 @@
`(PROGN (DSPCLIPPINGREGION OLDVALUE ,DS])
(\TEDIT.OPERATE.OBJECT
[LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "Edited 31-Dec-2024 17:24 by rmk")
(* ; "Edited 1-Dec-2024 11:55 by rmk")
[LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "Edited 1-Dec-2024 11:55 by rmk")
(* ; "Edited 18-Oct-2024 13:44 by rmk")
(* ; "Edited 6-Oct-2024 23:09 by rmk")
(* ; "Edited 27-Aug-2024 10:03 by rmk")
@@ -1743,6 +1735,7 @@
(* ;; "Called from BUTTONEVENTFN.DOOPERATION. Execute once, in PANE. SHOWSEL and FIXSEL do the updates across other panes. This runs in PANE's coordinate system. We can't do it if we can't determine from SEL where OBJ is located in PANE.")
(CL:WHEN (SETQ LINE (\TEDIT.SEL.L1 SEL PANE TEXTOBJ))
(TEDIT.PROMPTCLEAR TSTREAM)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(MOVETO (FGETSEL SEL X0)
(FGETLD LINE YBASE)
@@ -2252,18 +2245,20 @@
(TEDIT.SETSEL
[LAMBDA (TSTREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION)
(* ; "Edited 31-Jan-2025 12:43 by rmk")
(* ; "Edited 19-Jan-2025 08:32 by rmk")
(* ; "Edited 8-Jan-2025 00:20 by rmk")
(* ; "Edited 26-Nov-2024 23:51 by rmk")
(* ; "Edited 30-Jul-2024 23:27 by rmk")
(* ; "Edited 7-Jul-2024 11:18 by rmk")
(* ; "Edited 15-Jun-2024 10:08 by rmk")
(* ; "Edited 23-May-2024 09:13 by rmk")
(* ; "Edited 19-May-2024 00:01 by rmk")
(* ; "Edited 29-Apr-2024 12:39 by rmk")
(* ; "Edited 15-Mar-2024 13:38 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 9-Mar-2024 12:04 by rmk")
(* ; "Edited 22-Sep-2023 18:09 by rmk")
(* ; "Edited 3-Aug-2023 23:12 by rmk")
(* ; "Edited 23-May-2023 16:50 by rmk")
(* ; "Edited 18-Apr-2023 23:54 by rmk")
(* ; "Edited 27-Mar-2023 13:07 by rmk")
(* ; "Edited 30-May-91 23:05 by jds")
@@ -2272,47 +2267,67 @@
(* ;; "For convenience, TSTREAM may be provided as an external selection (with its SELTEXTSTREAM as the actual TSTREAM). That selection is never installed in TSTREAM, to avoid circularity.")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:WHEN (AND LEN (ILESSP LEN 0))
(ERROR "Selection length cannot be negative" LEN))
(LET* ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
(LET* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
(SEL (TEXTSEL TEXTOBJ))
(TEXTLEN (TEXTLEN TEXTOBJ))
PC)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ; "First turn the old sel off.")
[if (type? SELECTION CH#)
then (* ;
 "He gave us a selection; just plug it in")
(\TEDIT.COPYSEL CH# SEL) (* ;
[COND
((type? SELECTION CH#) (* ;
 "He gave use a selection; just plug it in")
(\TEDIT.COPYSEL CH# SEL) (* ;
 "And make sure it can be turned on.")
(SETSEL SEL ONFLG NIL)
else (* ;
(SETSEL SEL ONFLG NIL))
(T (* ;
 "Documentation doesn't allow NIL, but DINFO.SHOWSEL passes it")
(SELECTQ POINT
(LEFT)
(RIGHT)
(NIL (SETQ POINT 'LEFT))
(ERROR POINT "is an illegal POINT")) (* ; "He fed us numbers; use them")
(CL:WHEN (ILESSP CH# 0) (* ; "Negative => from end")
(SETQ CH# (IPLUS 1 TEXTLEN CH#)))
(if (EQ 0 TEXTLEN)
then (\TEDIT.UPDATE.SEL SEL 1 0 'LEFT)
elseif (IGREATERP CH# TEXTLEN)
then (\TEDIT.UPDATE.SEL SEL TEXTLEN 0 'RIGHT)
else [SETQ LEN (IMIN LEN (ADD1 (IDIFFERENCE TEXTLEN CH#]
(\TEDIT.UPDATE.SEL SEL CH# LEN POINT)
(FSETSEL SEL SELOBJ (CL:WHEN (EQ 1 LEN)
(SETQ PC (\TEDIT.CHTOPC (GETSEL SEL CH#)
TEXTOBJ))
(CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC))
(PCONTENTS PC)))]
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE PENDINGDELFLG)
(\TEDIT.SET.SEL.LOOKS SEL OPERATION)
(SELECTQ POINT
(LEFT)
(RIGHT)
(NIL (SETQ POINT 'LEFT))
(ERROR POINT "is an illegal POINT")) (* ; "He fed us numbers; use them")
(SETQ LEN (IMAX 0 (OR LEN 0)))
(CL:WHEN (ILESSP CH# 0)
(SETQ CH# (IPLUS 1 TEXTLEN CH#))) (* ; "Length must be positive")
(SETQ CH# (IMIN (IMAX 1 CH#)
(ADD1 TEXTLEN))) (* ;
 "Starting character. If beyond TEXTLEN, then just after EOF")
(SETSEL SEL CH# CH#)
[SETSEL SEL CHLIM (IMAX CH# (IMIN (IPLUS CH# LEN)
(ADD1 TEXTLEN]
(* ;; "LEN may have been reduced by TEXTLEN")
(SETQ LEN (IDIFFERENCE (GETSEL SEL CHLIM)
(GETSEL SEL CH#)))
(SETSEL SEL DCH LEN)
(SETSEL SEL POINT (if (IGREATERP CH# TEXTLEN)
then 'LEFT
elseif POINT
else 'LEFT)) (* ; "Which side the caret should go on")
(FSETSEL SEL SELOBJ (CL:WHEN (EQ 1 LEN) (* ; "If CH# beyond TEXTLEN, LEN is 0")
(SETQ PC (\TEDIT.CHTOPC (GETSEL SEL CH#)
TEXTOBJ))
(CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC))
(PCONTENTS PC)))]
[COND
[PENDINGDELFLG (* ;
 "This selection is to be a pending-deletion sel.")
(SETTOBJ TEXTOBJ BLUEPENDINGDELETE T) (* ;
 "Warn TEdit that there's a deletion pending")
(\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'PENDINGDEL]
(T (* ;
 "This selection is to be a pending-deletion sel.")
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL]
(SETSEL SEL SET T) (* ;
 "Mark the selection as valid for others to use")
(CL:UNLESS LEAVECARETLOOKS (* ;
 "Set the insertion looks to follow.")
 "And set the insertion looks to follow.")
(SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.GETSEL TSTREAM])
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ;
 "Update the selection's screen location")
(\TEDIT.SHOWSEL SEL T TEXTOBJ) (* ; "Highlight it on the screen")
SEL])
(TEDIT.SHOWSEL
[LAMBDA (TSTREAM ONFLG SEL) (* ; "Edited 7-Jul-2024 11:25 by rmk")
@@ -2371,8 +2386,7 @@
RESULT])
(TEDIT.SEL.AS.SEXPR
[LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "Edited 29-Dec-2024 08:47 by rmk")
(* ; "Edited 29-Apr-2024 10:49 by rmk")
[LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "Edited 29-Apr-2024 10:49 by rmk")
(* ; "Edited 17-Mar-2024 12:05 by rmk")
(* ; "Edited 25-Dec-2023 18:52 by rmk")
(* ; "Edited 9-Jul-2023 09:37 by rmk")
@@ -2385,7 +2399,7 @@
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
[\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (\TEDIT.WORD.FIRST TSTREAM (TEDIT.GETPOINT TSTREAM SEL)
(TEDIT.ATOMBOUND.READTABLE (OR RDTBL *READTABLE*]
(CAR (NLSETQ (READ TSTREAM RDTBL FLG])
(READ TSTREAM RDTBL FLG])
(TEDIT.SELECTALL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Jun-2023 16:58 by rmk")
@@ -2402,25 +2416,25 @@
(ADDTOVAR LAMA TEDIT.SELPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (15578 17399 (\TEDIT.SELECTION.DEFPRINT 15588 . 17397)) (17436 18941 (
\TEDIT.SET.GLOBAL.SELECTIONS 17446 . 18939)) (18942 24811 (\TEDIT.SELECTED.PIECES 18952 . 20472) (
\TEDIT.FIND.PROTECTED.END 20474 . 22143) (\TEDIT.FIND.PROTECTED.START 22145 . 24003) (
\TEDIT.WORD.BOUND 24005 . 24809)) (24945 59336 (\TEDIT.EXTEND.SEL 24955 . 32043) (\TEDIT.SCAN.LINE
32045 . 44125) (\TEDIT.SCAN.LINE.WORD 44127 . 49488) (\TEDIT.XYTOSEL 49490 . 56489) (\TEDIT.REGIONTYPE
56491 . 57510) (\TEDIT.XYTOSEL.INLINEP 57512 . 57967) (\TEDIT.XYTOSEL.LINE 57969 . 59334)) (59337
72499 (\TEDIT.FIXSEL 59347 . 68960) (\TEDIT.CHTOLINEX 68962 . 72497)) (72500 76037 (
\TEDIT.RESET.EXTEND.PENDING.DELETE 72510 . 73483) (\TEDIT.SET.SEL.LOOKS 73485 . 76035)) (76038 92338 (
\TEDIT.SHOWSEL 76048 . 80508) (\TEDIT.SHOWSEL.HILIGHT 80510 . 85131) (\TEDIT.UPDATE.SEL 85133 . 88632)
(\TEDIT.CARETLINE 88634 . 89348) (\TEDIT.SEL.L1 89350 . 89856) (\TEDIT.SEL.LN 89858 . 90364) (
\TEDIT.SEL.DELETEDCHARS 90366 . 92336)) (92339 97045 (\TEDIT.COPYSEL 92349 . 94815) (
\TEDIT.SEL.CHANGED? 94817 . 97043)) (97076 109805 (\TEDIT.SELECT.OBJECT 97086 . 101592) (
\TEDIT.SHOWSEL.OBJECT 101594 . 103756) (\TEDIT.CLIP.OBJECT 103758 . 105762) (\TEDIT.OPERATE.OBJECT
105764 . 109803)) (109833 128062 (\TEDIT.SELPIECES 109843 . 113791) (\TEDIT.SELPIECES.COPY 113793 .
115831) (\TEDIT.SELPIECES.CONCAT 115833 . 117712) (\TEDIT.SELPIECES.CHARTRANSFORM 117714 . 120672) (
\TEDIT.SELPIECES.FROM.STRING 120674 . 125697) (\TEDIT.SELPIECES.TO.STRING 125699 . 128060)) (128115
149977 (TEDIT.XYTOCH 128125 . 130509) (TEDIT.SELPROP 130511 . 134267) (TEDIT.GETPOINT 134269 . 136189)
(TEDIT.GETSEL 136191 . 136925) (TEDIT.GETSEL.PARA 136927 . 137876) (TEDIT.SCANSEL 137878 . 138826) (
TEDIT.SET.SEL.LOOKS 138828 . 140207) (TEDIT.SETSEL 140209 . 144820) (TEDIT.SHOWSEL 144822 . 146102) (
TEDIT.SEL.AS.STRING 146104 . 148355) (TEDIT.SEL.AS.SEXPR 148357 . 149643) (TEDIT.SELECTALL 149645 .
149975)))))
(FILEMAP (NIL (15576 17397 (\TEDIT.SELECTION.DEFPRINT 15586 . 17395)) (17434 18939 (
\TEDIT.SET.GLOBAL.SELECTIONS 17444 . 18937)) (18940 24809 (\TEDIT.SELECTED.PIECES 18950 . 20470) (
\TEDIT.FIND.PROTECTED.END 20472 . 22141) (\TEDIT.FIND.PROTECTED.START 22143 . 24001) (
\TEDIT.WORD.BOUND 24003 . 24807)) (24943 58882 (\TEDIT.EXTEND.SEL 24953 . 32041) (\TEDIT.SCAN.LINE
32043 . 43671) (\TEDIT.SCAN.LINE.WORD 43673 . 49034) (\TEDIT.XYTOSEL 49036 . 56035) (\TEDIT.REGIONTYPE
56037 . 57056) (\TEDIT.XYTOSEL.INLINEP 57058 . 57513) (\TEDIT.XYTOSEL.LINE 57515 . 58880)) (58883
72045 (\TEDIT.FIXSEL 58893 . 68506) (\TEDIT.CHTOLINEX 68508 . 72043)) (72046 75583 (
\TEDIT.RESET.EXTEND.PENDING.DELETE 72056 . 73029) (\TEDIT.SET.SEL.LOOKS 73031 . 75581)) (75584 91884 (
\TEDIT.SHOWSEL 75594 . 80054) (\TEDIT.SHOWSEL.HILIGHT 80056 . 84677) (\TEDIT.UPDATE.SEL 84679 . 88178)
(\TEDIT.CARETLINE 88180 . 88894) (\TEDIT.SEL.L1 88896 . 89402) (\TEDIT.SEL.LN 89404 . 89910) (
\TEDIT.SEL.DELETEDCHARS 89912 . 91882)) (91885 96591 (\TEDIT.COPYSEL 91895 . 94361) (
\TEDIT.SEL.CHANGED? 94363 . 96589)) (96622 109302 (\TEDIT.SELECT.OBJECT 96632 . 101138) (
\TEDIT.SHOWSEL.OBJECT 101140 . 103302) (\TEDIT.CLIP.OBJECT 103304 . 105308) (\TEDIT.OPERATE.OBJECT
105310 . 109300)) (109330 127559 (\TEDIT.SELPIECES 109340 . 113288) (\TEDIT.SELPIECES.COPY 113290 .
115328) (\TEDIT.SELPIECES.CONCAT 115330 . 117209) (\TEDIT.SELPIECES.CHARTRANSFORM 117211 . 120169) (
\TEDIT.SELPIECES.FROM.STRING 120171 . 125194) (\TEDIT.SELPIECES.TO.STRING 125196 . 127557)) (127612
151011 (TEDIT.XYTOCH 127622 . 130006) (TEDIT.SELPROP 130008 . 133764) (TEDIT.GETPOINT 133766 . 135686)
(TEDIT.GETSEL 135688 . 136422) (TEDIT.GETSEL.PARA 136424 . 137373) (TEDIT.SCANSEL 137375 . 138323) (
TEDIT.SET.SEL.LOOKS 138325 . 139704) (TEDIT.SETSEL 139706 . 145976) (TEDIT.SHOWSEL 145978 . 147258) (
TEDIT.SEL.AS.STRING 147260 . 149511) (TEDIT.SEL.AS.SEXPR 149513 . 150677) (TEDIT.SELECTALL 150679 .
151009)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Jan-2025 11:15:51" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;840 173255
(FILECREATED "22-Dec-2024 00:24:17" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;835 172312
:EDIT-BY rmk
:CHANGES-TO (FNS OPENTEXTSTREAM)
:CHANGES-TO (FNS \TEDIT.TEXTPROP)
:PREVIOUS-DATE "12-Jan-2025 12:30:12" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;839)
:PREVIOUS-DATE "20-Dec-2024 12:19:41" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;834)
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -102,7 +102,7 @@
NEXTPIECE (* ; "-> Next piece in this textobj.")
(PREVPIECE FULLXPOINTER) (* ;
 "-> Prior piece in this text object.")
PCHARLOOKS (* ; "Character formatting info ")
PLOOKS (* ; "Character formatting info ")
PBYTESPERCHAR (* ;
 "The number of bytes per character, given that all characters in a piece are the same length.")
(PPARALAST FLAG) (* ; "This piece ends paragraph")
@@ -121,12 +121,10 @@
[ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
(type? IMAGEOBJ (PCONTENTS DATUM))
(PCONTENTS DATUM)))
(PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM)
FAST
(fetch (PIECE PCHARLOOKS) of DATUM))
(STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE)
(PCHARLOOKS (PLOOKS DATUM)
(STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE)
FAST
(freplace (PIECE PCHARLOOKS) of DATUM with NEWVALUE]
(freplace (PIECE PLOOKS) of DATUM with NEWVALUE]
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
(DATATYPE TEXTOBJ
@@ -402,10 +400,10 @@
(ffetch (PIECE PCONTENTS) of PC)))
(PUTPROPS PLOOKS MACRO ((PC)
(ffetch (PIECE PCHARLOOKS) of PC)))
(ffetch (PIECE PLOOKS) of PC)))
(PUTPROPS PCHARLOOKS MACRO ((PC)
(ffetch (PIECE PCHARLOOKS) of PC)))
(PLOOKS PC)))
(PUTPROPS PCHARSET MACRO ((PC)
(ffetch (PIECE PCHARSET) of PC)))
@@ -1227,11 +1225,7 @@
(DEFINEQ
(OPENTEXTSTREAM
[LAMBDA (TEXT WINDOW START/PROPS END PROPS)
(* ;; "Edited 30-Jan-2025 11:15 by rmk")
(* ;; "Edited 10-Jan-2025 11:17 by rmk")
[LAMBDA (TEXT WINDOW START END PROPS)
(* ;; "Edited 21-Nov-2024 00:18 by rmk")
@@ -1293,16 +1287,10 @@
 "Empty string means empty document, not illegal file name")
(SETQ TEXT NIL))
(RESETLST
(LET ((TSTREAM (TEXTSTREAM TEXT T))
TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE START)
(LET ((TSTREAM (TEXTSTREAMP TEXT))
TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE)
(DECLARE (SPECVARS TEDIT.GET.FINISHEDFORMS)) (* ;
 "Undocumented, but available for special-purpose actions specified somewhere below.")
(SETQ START (if (FIXP START/PROPS)
then START/PROPS
elseif (AND (LISTP START/PROPS)
(NOT (LISTP PROPS)))
then (SETQ PROPS START/PROPS)
NIL))
(if TSTREAM
then (SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(CL:WHEN (OR START END) (* ; "Do the end first")
@@ -1357,8 +1345,7 @@
TSTREAM))])
(COPYTEXTSTREAM
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 12-Jan-2025 12:16 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 16-Mar-2024 10:03 by rmk")
(* ; "Edited 16-Jan-2024 12:27 by rmk")
(* ; "Edited 22-Sep-2023 20:48 by rmk")
@@ -1378,13 +1365,10 @@
 "Create an empty textstream into which the pieces can be hammered")
[SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
(SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM))
(for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
do (SETQ NEWPC (\TEDIT.COPYPIECE PC TEXTOBJ NEWTEXTOBJ NIL 'COPY))
(CL:UNLESS NEWPC
(CL:IF (EQ OBJECT.PTYPE (PTYPE PC))
(ERROR "Image object does not allow copying" (POBJ PC))
(ERROR "Piece cannot be copied " PC)))
(\TEDIT.INSERTPIECE NEWPC NIL NEWTEXTOBJ))
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) do (\TEDIT.INSERTPIECE (\TEDIT.COPYPIECE
PC TEXTOBJ NEWTEXTOBJ
NIL 'COPY)
NIL NEWTEXTOBJ))
(FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
(FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
(FSETTOBJ NEWTEXTOBJ FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC))
@@ -1617,8 +1601,7 @@
WINDOW])
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS
[LAMBDA (TEXTOBJ) (* ; "Edited 29-Dec-2024 20:37 by rmk")
(* ; "Edited 20-Dec-2024 11:56 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 20-Dec-2024 11:56 by rmk")
(* ; "Edited 16-Dec-2024 13:14 by rmk")
(* ; "Edited 21-Nov-2024 14:35 by rmk")
(* ; "Edited 29-Aug-2024 09:46 by rmk")
@@ -1637,7 +1620,7 @@
(* ;; "Find the default font for this TEXTOBJ -- either what the guy tells us, the one from TEDIT.DEFAULT.PROPS, or his DEFAULTFONT.")
(SETQ FONT (OR (GETTEXTPROP TEXTOBJ 'FONT)
(FONTCREATE DEFAULTFONT)))
DEFAULTFONT))
(SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'LOOKS))
(SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
(AND (type? CHARLOOKS FONT)
@@ -2856,31 +2839,31 @@
(ADDTOVAR LAMA TEXTPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (36869 67470 (\TEDIT.TEXTBIN 36879 . 47629) (\TEDIT.TEXTPEEKBIN 47631 . 53181) (
\TEDIT.TEXTBACKFILEPTR 53183 . 58856) (\TEDIT.TEXTBOUT 58858 . 63260) (\TEDIT.INSTALL.FILEBUFFER 63262
. 67468)) (68368 72416 (\TEDIT.TEXTOUTCHARFN 68378 . 69934) (\TEDIT.TEXTINCCODEFN 69936 . 70675) (
\TEDIT.TEXTBACKCCODEFN 70677 . 71269) (\TEDIT.TEXTFORMATBYTESTREAM 71271 . 71974) (
\TEDIT.TEXTFORMATBYTESTRING 71976 . 72414)) (72463 83763 (OPENTEXTSTREAM 72473 . 79331) (
COPYTEXTSTREAM 79333 . 82986) (TEDIT.STREAMCHANGEDP 82988 . 83290) (TXTFILE 83292 . 83761)) (83764
113041 (\TEDIT.REOPENTEXTSTREAM 83774 . 85126) (\TEDIT.OPENTEXTSTREAM.PIECES 85128 . 89558) (
\TEDIT.OPENTEXTSTREAM.PROPS 89560 . 90662) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 90664 . 95599) (
\TEDIT.OPENTEXTSTREAM.WINDOW 95601 . 98282) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98284 . 100933) (
\TEDIT.OPENTEXTFILE 100935 . 102648) (\TEDIT.CREATE.TEXTSTREAM 102650 . 103584) (\TEDIT.REOPEN.STREAM
103586 . 105922) (\TEDIT.TEXTINIT 105924 . 113039)) (113079 114267 (\TEDIT.TTYBOUT 113089 . 114265)) (
114385 132762 (\TEDIT.TEXTCLOSEF 114395 . 115719) (\TEDIT.TEXTDSPFONT 115721 . 116691) (
\TEDIT.TEXTEOFP 116693 . 118448) (\TEDIT.TEXTGETEOFPTR 118450 . 118773) (\TEDIT.TEXTSETEOFPTR 118775
. 119865) (\TEDIT.TEXTGETFILEPTR 119867 . 122589) (\TEDIT.TEXTSETFILEINFO 122591 . 123099) (
\TEDIT.TEXTOPENF 123101 . 124032) (\TEDIT.TEXTSETEOF 124034 . 124650) (\TEDIT.TEXTSETFILEPTR 124652 .
126693) (\TEDIT.TEXTDSPXPOSITION 126695 . 127712) (\TEDIT.TEXTDSPYPOSITION 127714 . 128455) (
\TEDIT.TEXTLEFTMARGIN 128457 . 128834) (\TEDIT.TEXTRIGHTMARGIN 128836 . 131911) (
\TEDIT.TEXTDSPCHARWIDTH 131913 . 132217) (\TEDIT.TEXTDSPSTRINGWIDTH 132219 . 132525) (
\TEDIT.TEXTDSPLINEFEED 132527 . 132760)) (133809 154460 (\TEDIT.DELETE.SELPIECES 133819 . 137246) (
\TEDIT.INSERTCH 137248 . 145042) (\TEDIT.INSERTCH.HISTORY 145044 . 148508) (\TEDIT.INSERTEOL 148510 .
150335) (\TEDIT.INSERTCH.INSERTION 150337 . 153174) (\TEDIT.INSERTCH.EXTEND 153176 . 154458)) (154461
155965 (\TEDIT.NEXTCHANGEABLE.CHNO 154471 . 155186) (\TEDIT.LASTCHANGEABLE.CHNO 155188 . 155963)) (
155966 157670 (\SETUPGETCH 155976 . 157668)) (157728 162186 (\TEDIT.INSTALL.PIECE 157738 . 162184)) (
162224 170436 (TEXTPROP 162234 . 162581) (GETTEXTPROP 162583 . 162827) (PUTTEXTPROP 162829 . 163086) (
GETTEXTPROPS 163088 . 163532) (PUTTEXTPROPS 163534 . 164438) (\TEDIT.TEXTPROP 164440 . 170434)) (
170437 172507 (\TEDIT.TEXTOBJ.PROPNAMES 170447 . 171399) (\TEDIT.TEXTOBJ.PROPFETCHFN 171401 . 171917)
(\TEDIT.TEXTOBJ.PROPSTOREFN 171919 . 172505)))))
(FILEMAP (NIL (36657 67258 (\TEDIT.TEXTBIN 36667 . 47417) (\TEDIT.TEXTPEEKBIN 47419 . 52969) (
\TEDIT.TEXTBACKFILEPTR 52971 . 58644) (\TEDIT.TEXTBOUT 58646 . 63048) (\TEDIT.INSTALL.FILEBUFFER 63050
. 67256)) (68156 72204 (\TEDIT.TEXTOUTCHARFN 68166 . 69722) (\TEDIT.TEXTINCCODEFN 69724 . 70463) (
\TEDIT.TEXTBACKCCODEFN 70465 . 71057) (\TEDIT.TEXTFORMATBYTESTREAM 71059 . 71762) (
\TEDIT.TEXTFORMATBYTESTRING 71764 . 72202)) (72251 82942 (OPENTEXTSTREAM 72261 . 78678) (
COPYTEXTSTREAM 78680 . 82165) (TEDIT.STREAMCHANGEDP 82167 . 82469) (TXTFILE 82471 . 82940)) (82943
112098 (\TEDIT.REOPENTEXTSTREAM 82953 . 84305) (\TEDIT.OPENTEXTSTREAM.PIECES 84307 . 88737) (
\TEDIT.OPENTEXTSTREAM.PROPS 88739 . 89841) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 89843 . 94778) (
\TEDIT.OPENTEXTSTREAM.WINDOW 94780 . 97461) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 97463 . 99990) (
\TEDIT.OPENTEXTFILE 99992 . 101705) (\TEDIT.CREATE.TEXTSTREAM 101707 . 102641) (\TEDIT.REOPEN.STREAM
102643 . 104979) (\TEDIT.TEXTINIT 104981 . 112096)) (112136 113324 (\TEDIT.TTYBOUT 112146 . 113322)) (
113442 131819 (\TEDIT.TEXTCLOSEF 113452 . 114776) (\TEDIT.TEXTDSPFONT 114778 . 115748) (
\TEDIT.TEXTEOFP 115750 . 117505) (\TEDIT.TEXTGETEOFPTR 117507 . 117830) (\TEDIT.TEXTSETEOFPTR 117832
. 118922) (\TEDIT.TEXTGETFILEPTR 118924 . 121646) (\TEDIT.TEXTSETFILEINFO 121648 . 122156) (
\TEDIT.TEXTOPENF 122158 . 123089) (\TEDIT.TEXTSETEOF 123091 . 123707) (\TEDIT.TEXTSETFILEPTR 123709 .
125750) (\TEDIT.TEXTDSPXPOSITION 125752 . 126769) (\TEDIT.TEXTDSPYPOSITION 126771 . 127512) (
\TEDIT.TEXTLEFTMARGIN 127514 . 127891) (\TEDIT.TEXTRIGHTMARGIN 127893 . 130968) (
\TEDIT.TEXTDSPCHARWIDTH 130970 . 131274) (\TEDIT.TEXTDSPSTRINGWIDTH 131276 . 131582) (
\TEDIT.TEXTDSPLINEFEED 131584 . 131817)) (132866 153517 (\TEDIT.DELETE.SELPIECES 132876 . 136303) (
\TEDIT.INSERTCH 136305 . 144099) (\TEDIT.INSERTCH.HISTORY 144101 . 147565) (\TEDIT.INSERTEOL 147567 .
149392) (\TEDIT.INSERTCH.INSERTION 149394 . 152231) (\TEDIT.INSERTCH.EXTEND 152233 . 153515)) (153518
155022 (\TEDIT.NEXTCHANGEABLE.CHNO 153528 . 154243) (\TEDIT.LASTCHANGEABLE.CHNO 154245 . 155020)) (
155023 156727 (\SETUPGETCH 155033 . 156725)) (156785 161243 (\TEDIT.INSTALL.PIECE 156795 . 161241)) (
161281 169493 (TEXTPROP 161291 . 161638) (GETTEXTPROP 161640 . 161884) (PUTTEXTPROP 161886 . 162143) (
GETTEXTPROPS 162145 . 162589) (PUTTEXTPROPS 162591 . 163495) (\TEDIT.TEXTPROP 163497 . 169491)) (
169494 171564 (\TEDIT.TEXTOBJ.PROPNAMES 169504 . 170456) (\TEDIT.TEXTOBJ.PROPFETCHFN 170458 . 170974)
(\TEDIT.TEXTOBJ.PROPSTOREFN 170976 . 171562)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Jan-2025 23:45:04" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;166 92474
(FILECREATED "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163 92210
:EDIT-BY rmk
:CHANGES-TO (FNS \TFBRAVO.READ.CHARLOOKS \TFBRAVO.FONT.FROM.CHARLOOKS TEDITFROMBRAVO
\TFBRAVO.USER.CM.LOOKS)
:CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS)
:PREVIOUS-DATE "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163)
:PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;162)
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -171,8 +170,7 @@
(RETURN T])
(TEDITFROMBRAVO
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 2-Jan-2025 22:22 by rmk")
(* ; "Edited 17-Jan-2024 12:11 by rmk")
[LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 17-Jan-2024 12:11 by rmk")
(* ; "Edited 26-Nov-2023 00:29 by rmk")
(* ; "Edited 14-Nov-2023 17:09 by rmk")
(* ; "Edited 22-Sep-2023 08:53 by rmk")
@@ -214,19 +212,17 @@
(* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text")
(CL:UNLESS (AND (EQ 'PROFILE (GETPARA NEXTFMTSPEC FMTPARATYPE))
(CL:UNLESS (AND (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE)
of NEXTFMTSPEC))
(\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA
TEXTOBJ START))
(\TFBRAVO.INSERT.PARA PARA BSTREAM TEXTOBJ))
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
(* ;; "Named tab information is collected in the userinfo fields, but then ignored.")
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
do (SETPARA PARALOOKS FMTUSERINFO NIL))
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
do (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
(\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique")
(for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST)
do (replace (FMTSPEC FMTUSERINFO) of PARALOOKS with NIL))
(for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
do (replace (CHARLOOKS CLUSERINFO) of CHARLOOKS with NIL))
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ)
(TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
(RETURN TEXTSTREAM)))])
@@ -286,16 +282,16 @@
(RETURN USER.CM])
(\TFBRAVO.USER.CM.LOOKS
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 2-Jan-2025 11:06 by rmk")
(* ; "Edited 18-Aug-2023 18:47 by rmk")
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 18-Aug-2023 18:47 by rmk")
(* ; "Edited 16-Aug-2023 21:33 by rmk")
(* ; "Edited 5-Aug-2023 17:15 by rmk")
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST))
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
(SETQ USER.CM.CHARLOOKS (create CHARLOOKS
CLNAME _ (\TFBRAVO.GETFONT 0 BRFAMILY)
CLSIZE _ (\TFBRAVO.GETFONT 0 BRSIZE)
CLOFFSET _ 0))
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS (\TFBRAVO.GETFONT 0 BRFAMILY)
(\TFBRAVO.GETFONT 0 BRSIZE))
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS)
(\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ)
(SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))
(SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ))
@@ -664,8 +660,7 @@
(SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN])
(\TFBRAVO.READ.CHARLOOKS
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 2-Jan-2025 23:44 by rmk")
(* ; "Edited 21-Oct-2024 00:27 by rmk")
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 21-Oct-2024 00:27 by rmk")
(* ; "Edited 9-Sep-2023 21:39 by rmk")
(* ; "Edited 20-Aug-2023 16:15 by rmk")
(* ; "Edited 18-Aug-2023 20:11 by rmk")
@@ -675,39 +670,36 @@
(* ;; "The charlooks trailer (from \ to CR) consists of a sequence of run-looks. Each run-look is a sequence of commands followed by the length of the run. If the first run has no commands (i.e. the \ is followed immediately by a length-number), than the first run gets the USER.CM default looks.")
(bind COMMAND LEN LAST VALUE TABNAMES FAMILY SIZE BOLD ITALIC (NEWCHARLOOKS _
(create CHARLOOKS
using OLDCHARLOOKS))
first [SETQ FAMILY (SETQ SIZE (SETQ BOLD (SETQ ITALIC 'OFF] until (SETQ LEN (\TFBRAVO.READNUM?
BSTREAM))
(bind COMMAND LEN LAST VALUE TABNAMES (NEWCHARLOOKS _ (create CHARLOOKS using OLDCHARLOOKS))
until (SETQ LEN (\TFBRAVO.READNUM? BSTREAM))
do
(* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safer?")
(* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safter?")
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
(s (FSETCLOOKS NEWCHARLOOKS CLSTRIKE T))
(S (FSETCLOOKS NEWCHARLOOKS CLSTRIKE NIL))
(u (FSETCLOOKS NEWCHARLOOKS CLULINE T))
(U (FSETCLOOKS NEWCHARLOOKS CLULINE NIL))
(b (SETQ BOLD T))
(B (SETQ BOLD NIL))
(i (SETQ ITALIC T))
(I (SETQ ITALIC NIL))
(s (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with T))
(S (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with NIL))
(u (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with T))
(U (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with NIL))
(b (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with T))
(B (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with NIL))
(i (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with T))
(I (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with NIL))
(g "Graphic T --unsupported")
(G "Graphic NIL")
(v (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE NIL))
(V (AND NIL (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE T)))
(v (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with NIL))
(V (AND NIL (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with T)))
(t
(* ;; "Collect the named tabs for writerun")
(PUSH TABNAMES (CHARACTER (BIN BSTREAM))))
(f (* ; "Save the fontface until the end")
(SETQ VALUE (CHARACTER (BIN BSTREAM)))
(SETQ SIZE (\TFBRAVO.GETFONT VALUE BRSIZE))
(SETQ FAMILY (\TFBRAVO.GETFONT VALUE BRFAMILY)))
(replace (CHARLOOKS CLSIZE) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRSIZE))
(replace (CHARLOOKS CLNAME) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRFAMILY)))
(o (SETQ VALUE (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Superscript")
(FSETCLOOKS NEWCHARLOOKS CLOFFSET (CL:IF (IGREATERP VALUE 127)
(IDIFFERENCE VALUE 256)
VALUE)))
(replace (CHARLOOKS CLOFFSET) of NEWCHARLOOKS with (CL:IF (IGREATERP VALUE 127)
(IDIFFERENCE VALUE 256)
VALUE)))
(SPACE)
(CR
(* ;; "We hit the trailer-terminating CR, It is either the end-marker for the last run, or a signal that this paragraph has no run-look information. ")
@@ -730,8 +722,8 @@
(* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length")
(FSETCLOOKS NEWCHARLOOKS CLUSERINFO (DREVERSE TABNAMES))
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS FAMILY SIZE BOLD ITALIC)
(replace (CHARLOOKS CLUSERINFO) of NEWCHARLOOKS with (DREVERSE TABNAMES))
(\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS)
(RETURN (create RUN
RUNSTART _ RUNSTART
RUNLENGTH _ LEN
@@ -739,29 +731,22 @@
RUNLAST _ LAST])
(\TFBRAVO.FONT.FROM.CHARLOOKS
[LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC) (* ; "Edited 2-Jan-2025 23:43 by rmk")
(* ; "Edited 1-Aug-2023 13:21 by rmk")
[LAMBDA (CHARLOOKS) (* ; "Edited 1-Aug-2023 13:21 by rmk")
(* ; "Edited 31-May-91 15:26 by jds")
(* ;; "Takes a TEDIT CHARLOOKS with fields filled in (CLNAME = family name) and creates the font to fill it.")
[LET ((OLDFONT (GETCLOOKS CHARLOOKS CLFONT)))
(CL:WHEN (EQ FAMILY 'OFF)
(SETQ FAMILY (FONTPROP OLDFONT 'FAMILY)))
(CL:WHEN (EQ SIZE 'OFF)
(SETQ SIZE (FONTPROP OLDFONT 'SIZE)))
(CL:WHEN (EQ BOLD 'OFF)
[SETQ BOLD (EQ 'BOLD (FONTPROP OLDFONT 'WEIGHT])
(CL:WHEN (EQ ITALIC 'OFF)
[SETQ ITALIC (EQ 'ITALIC (FONTPROP OLDFONT 'SLOPE])
[SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD
'BOLD
'MEDIUM)
(CL:IF ITALIC
'ITALIC
'REGULAR)
'REGULAR]
(SETCLOOKS CHARLOOKS CLNAME (FONTUNPARSE (GETCLOOKS CHARLOOKS CLFONT]
[replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE (fetch (CHARLOOKS CLNAME) of CHARLOOKS)
(fetch (CHARLOOKS CLSIZE) of CHARLOOKS)
(LIST (CL:IF (fetch (CHARLOOKS CLBOLD)
of CHARLOOKS)
'BOLD
'MEDIUM)
(CL:IF (fetch (CHARLOOKS CLITAL)
of CHARLOOKS)
'ITALIC
'REGULAR)
'REGULAR]
CHARLOOKS])
(\TFBRAVO.READNUM?
@@ -1480,18 +1465,18 @@
(AND NIL (\TEDIT.NAMEDTAB.INIT))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6772 13224 (TEDIT.BRAVOFILE? 6782 . 8512) (TEDITFROMBRAVO 8514 . 13222)) (13335 28811 (
\TFBRAVO.GET.USER.CM 13345 . 16155) (\TFBRAVO.USER.CM.LOOKS 16157 . 17364) (\TFBRAVO.READ.USER.CM
17366 . 21936) (\TFBRAVO.INIT.PARALOOKS 21938 . 23924) (\TFBRAVO.INIT.PAGEFORMAT 23926 . 24806) (
\TFBRAVO.GETPARAMS 24808 . 27662) (\TFBRAVO.FIND.LAST.TRAILER 27664 . 28809)) (28853 48956 (
\TFBRAVO.PARSE.PARA 28863 . 32663) (\TFBRAVO.READ.PARALOOKS 32665 . 39087) (\TFBRAVO.CREATE.RUNS 39089
. 40477) (\TFBRAVO.READ.CHARLOOKS 40479 . 45508) (\TFBRAVO.FONT.FROM.CHARLOOKS 45510 . 47057) (
\TFBRAVO.READNUM? 47059 . 48954)) (48993 59744 (\TFBRAVO.HANDLE.HEADING 49003 . 51635) (
\TFBRAVO.PARSE.PROFILE.PARA 51637 . 59742)) (59787 81236 (\TFBRAVO.INSERT.PARA 59797 . 60450) (
\TFBRAVO.INSERT.RUN 60452 . 63649) (\TFBRAVO.SPLIT.PARA 63651 . 70893) (\TFBRAVO.RUN.TABSPEC 70895 .
75541) (\TFBRAVO.INSTALL.PAGEFORMAT 75543 . 81234)) (81237 85380 (\TFBRAVO.ASSERT 81247 . 81777) (
\TEST.CHARACTER.LOOKS 81779 . 83665) (\TEST.PARAGRAPH.LOOKS 83667 . 85378)) (85865 92308 (
\TFBRAVO.ADD.NAMEDTAB 85875 . 89266) (\TFBRAVO.COPY.NAMEDTAB 89268 . 89716) (\TFBRAVO.PUT.NAMEDTAB
89718 . 89998) (\TFBRAVO.GET.NAMEDTAB 90000 . 90377) (\NAMEDTABNYET 90379 . 90539) (\NAMEDTABSIZE
90541 . 91056) (\NAMEDTABPREPRINT 91058 . 91256) (\TEDIT.NAMEDTAB.INIT 91258 . 92306)))))
(FILEMAP (NIL (6681 13063 (TEDIT.BRAVOFILE? 6691 . 8421) (TEDITFROMBRAVO 8423 . 13061)) (13174 28618 (
\TFBRAVO.GET.USER.CM 13184 . 15994) (\TFBRAVO.USER.CM.LOOKS 15996 . 17171) (\TFBRAVO.READ.USER.CM
17173 . 21743) (\TFBRAVO.INIT.PARALOOKS 21745 . 23731) (\TFBRAVO.INIT.PAGEFORMAT 23733 . 24613) (
\TFBRAVO.GETPARAMS 24615 . 27469) (\TFBRAVO.FIND.LAST.TRAILER 27471 . 28616)) (28660 48692 (
\TFBRAVO.PARSE.PARA 28670 . 32470) (\TFBRAVO.READ.PARALOOKS 32472 . 38894) (\TFBRAVO.CREATE.RUNS 38896
. 40284) (\TFBRAVO.READ.CHARLOOKS 40286 . 45422) (\TFBRAVO.FONT.FROM.CHARLOOKS 45424 . 46793) (
\TFBRAVO.READNUM? 46795 . 48690)) (48729 59480 (\TFBRAVO.HANDLE.HEADING 48739 . 51371) (
\TFBRAVO.PARSE.PROFILE.PARA 51373 . 59478)) (59523 80972 (\TFBRAVO.INSERT.PARA 59533 . 60186) (
\TFBRAVO.INSERT.RUN 60188 . 63385) (\TFBRAVO.SPLIT.PARA 63387 . 70629) (\TFBRAVO.RUN.TABSPEC 70631 .
75277) (\TFBRAVO.INSTALL.PAGEFORMAT 75279 . 80970)) (80973 85116 (\TFBRAVO.ASSERT 80983 . 81513) (
\TEST.CHARACTER.LOOKS 81515 . 83401) (\TEST.PARAGRAPH.LOOKS 83403 . 85114)) (85601 92044 (
\TFBRAVO.ADD.NAMEDTAB 85611 . 89002) (\TFBRAVO.COPY.NAMEDTAB 89004 . 89452) (\TFBRAVO.PUT.NAMEDTAB
89454 . 89734) (\TFBRAVO.GET.NAMEDTAB 89736 . 90113) (\NAMEDTABNYET 90115 . 90275) (\NAMEDTABSIZE
90277 . 90792) (\NAMEDTABPREPRINT 90794 . 90992) (\TEDIT.NAMEDTAB.INIT 90994 . 92042)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2025 10:36:25" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;748 231614
(FILECREATED "17-Dec-2024 23:43:52" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;739 230830
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.SHIFTLINES \TEDIT.SCROLLUP \TEDIT.SCROLLDOWN)
:CHANGES-TO (FNS \TEDIT.SHIFTLINES)
:PREVIOUS-DATE " 7-Jan-2025 23:47:15" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;747)
:PREVIOUS-DATE "13-Dec-2024 09:00:10" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;738)
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -18,8 +18,8 @@
(MACROS PANEPROPS PANEPREFIX PANESUFFIX PANETOPLINE
PANECARET PANESTREAM PANETOBJ PANEBOTTOMLINE
\TEDIT.PREFIX.LCHARLIM)
(MACROS PANETOP PANEWIDTH PANELEFT PANERIGHT
PANEBOTTOM PANEHEIGHT PANEREGION)
(MACROS PANETOP PANEWIDTH PANELEFT PANEBOTTOM
PANEHEIGHT PANEREGION)
(I.S.OPRS inpanes backpanes)
(MACROS ALLBUTTONSUP)))
(INITRECORDS TEDITCARET PANEPROPS)
@@ -263,9 +263,6 @@
(PUTPROPS PANELEFT MACRO [(PANE PREG)
(fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE])
(PUTPROPS PANERIGHT MACRO [(PANE PREG)
(fetch (REGION RIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE])
(PUTPROPS PANEBOTTOM MACRO [(PANE PREG)
(fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE])
@@ -1949,8 +1946,7 @@
PROMPTWINDOW])
(TEDIT.PROMPTPRINT
[LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 29-Dec-2024 14:45 by rmk")
(* ; "Edited 26-Nov-2023 10:10 by rmk")
[LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 26-Nov-2023 10:10 by rmk")
(* ; "Edited 10-Sep-2023 00:27 by rmk")
(* ; "Edited 30-Jul-2023 08:52 by rmk")
(* ; "Edited 9-Jul-2023 12:37 by rmk")
@@ -1960,31 +1956,29 @@
(* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.")
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM T))
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
PWINDOW MAINWINDOW)
(if TEXTOBJ
then (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
[SETQ PWINDOW
(CAR (NLSETQ (SELECTQ PWINDOW
(DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
(GETPROMPTWINDOW MAINWINDOW)))
(NIL (CL:WHEN TEXTSTREAM
[GETPROMPTWINDOW MAINWINDOW NIL NIL
(NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]))
PWINDOW]) (* ;
(CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
[SETQ PWINDOW (CAR (NLSETQ (SELECTQ PWINDOW
(DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND)
(GETPROMPTWINDOW MAINWINDOW)))
(NIL (CL:WHEN TEXTSTREAM
[GETPROMPTWINDOW MAINWINDOW NIL NIL
(NOT (GETTEXTPROP TEXTOBJ
'PWINDOW.ON.DEMAND]))
PWINDOW]) (* ;
 "Try to find an editor's prompt window for our message")
(COND
((WINDOWP PWINDOW) (* ;
(COND
((WINDOWP PWINDOW) (* ;
 "We found a window to use. Print the message.")
(CL:WHEN CLEAR? (CLEARW PWINDOW))
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
(PRIN1 MSG PWINDOW))
(T (* ;
(CL:WHEN CLEAR? (CLEARW PWINDOW))
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
(PRIN1 MSG PWINDOW))
(T (* ;
 "Failing all else, use global PROMPTWINDOW.")
(FRESHLINE PROMPTWINDOW)
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
(printout PROMPTWINDOW MSG)))
else (PROMPTPRINT MSG])
(FRESHLINE PROMPTWINDOW)
(CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75))
(printout PROMPTWINDOW MSG])
(TEDIT.PROMPTCLEAR
[LAMBDA (TEXTSTREAM FONT) (* ; "Edited 14-Mar-98 12:52 by rmk:")
@@ -2496,8 +2490,7 @@
(\TEDIT.SCROLLCH.TOP TSTREAM PANE (FGETLD TOPLINE LCHARLAST])
(\TEDIT.SCROLLUP
[LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Feb-2025 10:20 by rmk")
(* ; "Edited 1-Dec-2024 11:32 by rmk")
[LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Dec-2024 11:32 by rmk")
(* ; "Edited 29-Nov-2024 09:14 by rmk")
(* ; "Edited 22-Nov-2024 17:33 by rmk")
(* ; "Edited 21-Nov-2024 15:04 by rmk")
@@ -2567,7 +2560,7 @@
(\TEDIT.SETPANE.TOPLINE PANE NEWTOPLINE NEWPANEYBOT)
(\TEDIT.SHIFTLINES (PANEPREFIX PANE)
PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE NEWTOPLINE)
NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE NEWTOPLINE)
T)
(\TEDIT.SETCARET (TEXTSEL TEXTOBJ)
PANE TEXTOBJ 'ON])
@@ -2602,8 +2595,7 @@
(RETURN (IPLUS NEWBOT (FGETLD NEWTOPLINE LHEIGHT])
(\TEDIT.SCROLLDOWN
[LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Feb-2025 10:20 by rmk")
(* ; "Edited 1-Dec-2024 20:46 by rmk")
[LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Dec-2024 20:46 by rmk")
(* ; "Edited 29-Nov-2024 09:14 by rmk")
(* ; "Edited 22-Nov-2024 17:33 by rmk")
(* ; "Edited 17-Nov-2024 10:13 by rmk")
@@ -2701,7 +2693,7 @@
(* ;; "All needed lines have been constructed and linked, although there may still be some unneeded lines at the bottom. ")
(\TEDIT.SHIFTLINES (PANEPREFIX PANE)
PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE OLDTOPLINE)
NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE OLDTOPLINE)
T)
(\TEDIT.SETCARET (TEXTSEL TEXTOBJ)
PANE TEXTOBJ 'ON])
@@ -2876,8 +2868,7 @@
TOPLINE])
(\TEDIT.SHIFTLINES
[LAMBDA (PREVLINE PANE TEXTOBJ BITMAPLINES SCROLLING) (* ; "Edited 1-Feb-2025 10:22 by rmk")
(* ; "Edited 7-Jan-2025 11:54 by rmk")
[LAMBDA (PREVLINE NEXTLINE PANE TEXTOBJ BITMAPLINES SCROLLING)
(* ; "Edited 17-Dec-2024 23:40 by rmk")
(* ; "Edited 3-Dec-2024 16:08 by rmk")
(* ; "Edited 1-Dec-2024 11:31 by rmk")
@@ -2889,14 +2880,15 @@
(* ;; "BITMAPLINES contains the first and last lines of the currently resuable PANE bitmap. PANE is refilled from the next of PREVLINE to the bottom, using BITMAPLINES and BITBLT to translate the images for lines that are already known. This skips formatting and redisplaying of those lines, but more importantly, it suppresses flicker. ")
(LINKLD PREVLINE NEXTLINE)
(* ;; "Take down the caret, but importantly, don't take down the selection--that would wipe out the bitmap-highlighting that we want to translate.")
(LET ((SEL (TEXTSEL TEXTOBJ))
LASTVISIBLE)
(\TEDIT.SETCARET SEL PANE TEXTOBJ 'OFF)
(if BITMAPLINES
then [LET* ((NEXTLINE (FGETLD PREVLINE NEXTLINE))
(VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT))
then [LET* ((VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT))
(PBOTTOM (PANEBOTTOM PANE))
(BMTOPL (CAR BITMAPLINES))
(BMTOPY (FGETLD BMTOPL YTOP))
@@ -2994,7 +2986,7 @@
(\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ)
(SETQ LASTVISIBLE (\TEDIT.LINES.BELOW PREVLINE PANE TEXTOBJ))
(\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE)
(\TEDIT.FIXSEL NIL TEXTOBJ NIL PANE))
(\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE))
(CL:WHEN SCROLLING
(* ;; "If scrolling up or down, we brute force wipe out whatever is above PREVLINE. If not scrolling, those are the lines from the top to lastvalid that are preserved.")
@@ -3462,8 +3454,7 @@
(UPDATE/MENU/IMAGE MENU])
(TEDIT.DEFAULT.MENUFN
[LAMBDA (PANE) (* ; "Edited 7-Jan-2025 23:46 by rmk")
(* ; "Edited 27-Jul-2024 20:24 by rmk")
[LAMBDA (PANE) (* ; "Edited 27-Jul-2024 20:24 by rmk")
(* ; "Edited 30-Jun-2024 12:38 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 18-May-2024 16:50 by rmk")
@@ -3532,15 +3523,16 @@
(TEDIT.HARDCOPY TEXTOBJ))
(Expanded% Menu (* ;
 "Open the expanded operations menu.")
(\TEDIT.EXPANDEDMENU.START TEXTOBJ))
(\TEDIT.EXPANDED.MENU TEXTOBJ))
(Character% Looks (* ;
 "Open the menu for setting character looks")
(\TEDIT.CHARMENU.START TEXTOBJ))
(\TEDIT.EXPANDEDCHAR.MENU TEXTOBJ))
(Paragraph% Formatting (* ;
 "Open the paragraph formatting menu")
(\TEDIT.PARAMENU.START TEXTOBJ))
(\TEDIT.EXPANDEDPARA.MENU TEXTOBJ))
(Page% Layout (* ; "Open the page-layout menu")
(\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
(\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T
)
(\TEDIT.PRIMARYPANE TEXTOBJ)
"Page Layout Menu" 150 'PAGE))
(CL:WHEN (CAR ITEM) (* ;
@@ -3652,37 +3644,37 @@
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
TEDIT.ICON.TITLE.REGION))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (18448 19344 (TEDIT.DEFER.UPDATES 18458 . 19342)) (19345 42387 (\TEDIT.CREATEW 19355 .
26070) (\TEDIT.WINDOW.SETUP 26072 . 30185) (\TEDIT.MINIMAL.WINDOW.SETUP 30187 . 38389) (
\TEDIT.CLEARPANE 38391 . 39108) (\TEDIT.FILL.PANES 39110 . 42385)) (42388 65102 (\TEDIT.CURSORMOVEDFN
42398 . 47271) (\TEDIT.CURSOROUTFN 47273 . 47718) (\TEDIT.ACTIVE.WINDOWP 47720 . 48771) (
\TEDIT.EXPANDFN 48773 . 49336) (\TEDIT.MAINW 49338 . 50618) (\TEDIT.MAINSTREAM 50620 . 50887) (
\TEDIT.PRIMARYPANE 50889 . 51659) (\TEDIT.PANELIST 51661 . 52157) (\TEDIT.NEWREGIONFN 52159 . 54675) (
\TEDIT.SET.WINDOW.EXTENT 54677 . 59931) (\TEDIT.SHRINK.ICONCREATE 59933 . 62473) (\TEDIT.SHRINKFN
62475 . 62884) (\TEDIT.PANEREGION 62886 . 65100)) (65134 96589 (\TEDIT.BUTTONEVENTFN 65144 . 77697) (
\TEDIT.BUTTONEVENTFN.DOOPERATION 77699 . 84422) (\TEDIT.BUTTONEVENTFN.GETOPERATION 84424 . 86266) (
\TEDIT.BUTTONEVENTFN.CURSEL.INIT 86268 . 89505) (\TEDIT.BUTTONEVENTFN.INACTIVE 89507 . 91849) (
\TEDIT.BUTTONEVENTFN.INTITLE 91851 . 93686) (\TEDIT.COPYINSERTFN 93688 . 94820) (\TEDIT.FOREIGN.COPY
94822 . 96587)) (96590 113699 (\TEDIT.PANE.SPLIT 96600 . 101079) (\TEDIT.SPLITW 101081 . 108540) (
\TEDIT.UNSPLITW 108542 . 112356) (\TEDIT.LINKPANES 112358 . 113121) (\TEDIT.UNLINKPANE 113123 . 113697
)) (115056 115947 (TEDITWINDOWP 115066 . 115945)) (115984 119087 (TEDIT.GETINPUT 115994 . 118437) (
\TEDIT.MAKEFILENAME 118439 . 119085)) (119136 127437 (TEDIT.PROMPTWINDOW 119146 . 119460) (
TEDIT.PROMPTPRINT 119462 . 122089) (TEDIT.PROMPTCLEAR 122091 . 123810) (TEDIT.PROMPTFLASH 123812 .
125744) (\TEDIT.PROMPT.PAGEFULLFN 125746 . 127435)) (127675 136501 (\TEXTSTREAM.TITLE 127685 . 128375)
(\TEDIT.DEFAULT.TITLE 128377 . 130756) (\TEDIT.WINDOW.TITLE 130758 . 132927) (\TEXTSTREAM.FILENAME
132929 . 134599) (\TEDIT.UPDATE.TITLE 134601 . 136499)) (136544 144747 (TEDIT.DEACTIVATE.WINDOW 136554
. 142347) (\TEDIT.RESHAPEFN 142349 . 144519) (\TEDIT.REPAINTFN 144521 . 144745)) (144748 187127 (
\TEDIT.SCROLLFN 144758 . 147003) (\TEDIT.SCROLLCH.TOP 147005 . 149116) (\TEDIT.SCROLLCH.BOTTOM 149118
. 153448) (\TEDIT.SCROLLUP 153450 . 159067) (\TEDIT.TOPLINE.YTOP 159069 . 160738) (\TEDIT.SCROLLDOWN
160740 . 167670) (\TEDIT.SCROLL.CARET 167672 . 170510) (\TEDIT.VISIBLECARETP 170512 . 172806) (
\TEDIT.VISIBLECHARP 172808 . 173899) (\TEDIT.BITMAPLINES 173901 . 177821) (\TEDIT.SETPANE.TOPLINE
177823 . 178614) (\TEDIT.SHIFTLINES 178616 . 187125)) (187128 197997 (\TEDIT.ONSCREEN? 187138 . 191689
) (\TEDIT.ONSCREEN.REGION 191691 . 195342) (\TEDIT.AFTERMOVEFN 195344 . 196241) (OFFSCREENP 196243 .
197995)) (198039 200656 (\TEDIT.PROCIDLEFN 198049 . 199586) (\TEDIT.PROCENTRYFN 199588 . 200033) (
\TEDIT.PROCEXITFN 200035 . 200654)) (200735 213889 (\TEDIT.DOWNCARET 200745 . 201538) (
\TEDIT.FLASHCARET 201540 . 203651) (\TEDIT.UPCARET 203653 . 204757) (TEDIT.NORMALIZECARET 204759 .
207977) (\TEDIT.SETCARET 207979 . 213259) (\TEDIT.CARET 213261 . 213887)) (213923 225584 (
TEDIT.ADD.MENUITEM 213933 . 216224) (TEDIT.DEFAULT.MENUFN 216226 . 222796) (TEDIT.REMOVE.MENUITEM
222798 . 223795) (\TEDIT.CREATEMENU 223797 . 224362) (\TEDIT.MENU.WHENHELDFN 224364 . 225269) (
\TEDIT.MENU.WHENSELECTEDFN 225271 . 225582)))))
(FILEMAP (NIL (18257 19153 (TEDIT.DEFER.UPDATES 18267 . 19151)) (19154 42196 (\TEDIT.CREATEW 19164 .
25879) (\TEDIT.WINDOW.SETUP 25881 . 29994) (\TEDIT.MINIMAL.WINDOW.SETUP 29996 . 38198) (
\TEDIT.CLEARPANE 38200 . 38917) (\TEDIT.FILL.PANES 38919 . 42194)) (42197 64911 (\TEDIT.CURSORMOVEDFN
42207 . 47080) (\TEDIT.CURSOROUTFN 47082 . 47527) (\TEDIT.ACTIVE.WINDOWP 47529 . 48580) (
\TEDIT.EXPANDFN 48582 . 49145) (\TEDIT.MAINW 49147 . 50427) (\TEDIT.MAINSTREAM 50429 . 50696) (
\TEDIT.PRIMARYPANE 50698 . 51468) (\TEDIT.PANELIST 51470 . 51966) (\TEDIT.NEWREGIONFN 51968 . 54484) (
\TEDIT.SET.WINDOW.EXTENT 54486 . 59740) (\TEDIT.SHRINK.ICONCREATE 59742 . 62282) (\TEDIT.SHRINKFN
62284 . 62693) (\TEDIT.PANEREGION 62695 . 64909)) (64943 96398 (\TEDIT.BUTTONEVENTFN 64953 . 77506) (
\TEDIT.BUTTONEVENTFN.DOOPERATION 77508 . 84231) (\TEDIT.BUTTONEVENTFN.GETOPERATION 84233 . 86075) (
\TEDIT.BUTTONEVENTFN.CURSEL.INIT 86077 . 89314) (\TEDIT.BUTTONEVENTFN.INACTIVE 89316 . 91658) (
\TEDIT.BUTTONEVENTFN.INTITLE 91660 . 93495) (\TEDIT.COPYINSERTFN 93497 . 94629) (\TEDIT.FOREIGN.COPY
94631 . 96396)) (96399 113508 (\TEDIT.PANE.SPLIT 96409 . 100888) (\TEDIT.SPLITW 100890 . 108349) (
\TEDIT.UNSPLITW 108351 . 112165) (\TEDIT.LINKPANES 112167 . 112930) (\TEDIT.UNLINKPANE 112932 . 113506
)) (114865 115756 (TEDITWINDOWP 114875 . 115754)) (115793 118896 (TEDIT.GETINPUT 115803 . 118246) (
\TEDIT.MAKEFILENAME 118248 . 118894)) (118945 127055 (TEDIT.PROMPTWINDOW 118955 . 119269) (
TEDIT.PROMPTPRINT 119271 . 121707) (TEDIT.PROMPTCLEAR 121709 . 123428) (TEDIT.PROMPTFLASH 123430 .
125362) (\TEDIT.PROMPT.PAGEFULLFN 125364 . 127053)) (127293 136119 (\TEXTSTREAM.TITLE 127303 . 127993)
(\TEDIT.DEFAULT.TITLE 127995 . 130374) (\TEDIT.WINDOW.TITLE 130376 . 132545) (\TEXTSTREAM.FILENAME
132547 . 134217) (\TEDIT.UPDATE.TITLE 134219 . 136117)) (136162 144365 (TEDIT.DEACTIVATE.WINDOW 136172
. 141965) (\TEDIT.RESHAPEFN 141967 . 144137) (\TEDIT.REPAINTFN 144139 . 144363)) (144366 186365 (
\TEDIT.SCROLLFN 144376 . 146621) (\TEDIT.SCROLLCH.TOP 146623 . 148734) (\TEDIT.SCROLLCH.BOTTOM 148736
. 153066) (\TEDIT.SCROLLUP 153068 . 158587) (\TEDIT.TOPLINE.YTOP 158589 . 160258) (\TEDIT.SCROLLDOWN
160260 . 167092) (\TEDIT.SCROLL.CARET 167094 . 169932) (\TEDIT.VISIBLECARETP 169934 . 172228) (
\TEDIT.VISIBLECHARP 172230 . 173321) (\TEDIT.BITMAPLINES 173323 . 177243) (\TEDIT.SETPANE.TOPLINE
177245 . 178036) (\TEDIT.SHIFTLINES 178038 . 186363)) (186366 197235 (\TEDIT.ONSCREEN? 186376 . 190927
) (\TEDIT.ONSCREEN.REGION 190929 . 194580) (\TEDIT.AFTERMOVEFN 194582 . 195479) (OFFSCREENP 195481 .
197233)) (197277 199894 (\TEDIT.PROCIDLEFN 197287 . 198824) (\TEDIT.PROCENTRYFN 198826 . 199271) (
\TEDIT.PROCEXITFN 199273 . 199892)) (199973 213127 (\TEDIT.DOWNCARET 199983 . 200776) (
\TEDIT.FLASHCARET 200778 . 202889) (\TEDIT.UPCARET 202891 . 203995) (TEDIT.NORMALIZECARET 203997 .
207215) (\TEDIT.SETCARET 207217 . 212497) (\TEDIT.CARET 212499 . 213125)) (213161 224800 (
TEDIT.ADD.MENUITEM 213171 . 215462) (TEDIT.DEFAULT.MENUFN 215464 . 222012) (TEDIT.REMOVE.MENUITEM
222014 . 223011) (\TEDIT.CREATEMENU 223013 . 223578) (\TEDIT.MENU.WHENHELDFN 223580 . 224485) (
\TEDIT.MENU.WHENSELECTEDFN 224487 . 224798)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Jan-2025 12:38:49" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;197 53250
(FILECREATED "14-Dec-2024 11:45:45" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196 52876
:EDIT-BY rmk
:PREVIOUS-DATE "14-Dec-2024 11:45:45" {WMEDLEY}<library>TEDIT>tedit-exports.all;196)
:PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}<library>TEDIT>tedit-exports.all;195)
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
@@ -18,7 +18,7 @@ PRINT))))))))
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
\TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 5-Jan-2025 23:34:12"))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 21:39:48"))
(RPAQQ \BTREEWORDSPERSLOT 4)
(RPAQQ \BTREEMAXCOUNT 8)
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -119,7 +119,7 @@ $$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE
(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
(GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION
TEDIT.DELETESELECTION)
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 1-Jan-2025 12:33:54"))
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 6-Dec-2024 12:50:42"))
(RECORD TAB (TABX . TABKIND))
(RECORD TABSPEC (DEFAULTTAB . TABS))
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
@@ -262,7 +262,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.)
eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.))
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 11:56:35"))
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:31"))
(DATATYPE PIECE ((* ;
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
@@ -270,8 +270,8 @@ repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
PBYTELEN (* ; "Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (* ;
"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.")
NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ;
"-> Prior piece in this text object.") PCHARLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (*
; "The number of bytes per character, given that all characters in a piece are the same length.") (
"-> Prior piece in this text object.") PLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (* ;
"The number of bytes per character, given that all characters in a piece are the same length.") (
PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") (
PNEW FLAG) (* ;
"This text is new here; used by the tentative edit system, and anyone else interested.") (NIL FLAG) (
@@ -280,9 +280,9 @@ PNEW FLAG) (* ;
"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
PLOOKS (STANDARD (fetch (PIECE PCHARLOOKS) of DATUM) FAST (fetch (PIECE PCHARLOOKS) of DATUM)) (
STANDARD (replace (PIECE PCHARLOOKS) of DATUM with NEWVALUE) FAST (freplace (PIECE PCHARLOOKS) of
DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
PCHARLOOKS (PLOOKS DATUM) (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) FAST (freplace (
PIECE PLOOKS) of DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _
TEDIT.DEFAULT.FMTSPEC)
(DATATYPE TEXTOBJ ((* ;;
"This is where TEdit stores its state information, and internal data about the text being edited.")
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
@@ -377,8 +377,8 @@ IMAGEDATA _ NIL)))
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
(PUTPROPS PCHARLOOKS MACRO ((PC) (ffetch (PIECE PCHARLOOKS) of PC)))
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
(PUTPROPS PCHARLOOKS MACRO ((PC) (PLOOKS PC)))
(PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
(PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
(PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
@@ -444,7 +444,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:28:18"))
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:17:20"))
(RPAQQ NONE.TTC 0)
(RPAQQ CHARDELETE.TTC 1)
(RPAQQ WORDDELETE.TTC 2)
@@ -485,15 +485,14 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
\BIN STREAM)) BITSPERWORD)))
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:28:41"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:29:36"))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 23:00:13"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2024 16:09:28"))
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
"The font descriptor for these characters") CLFONTUNPARSE (* ;;
"The font descriptor for these characters") CLNAME (* ;;
"Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
) NIL (* ; "Was CLSIZE. Font size, in points") (NIL FLAG) (* ;
"Was CLITAL: T if the characters are italic, else NIL") (NIL FLAG) (* ;
"Was CLBoldT if the characters are bold, else NIL") (CLULINE FLAG) (* ;
) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") (
CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
"T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ;
"T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ;
"T if the characters are to be struck thru, else nil.") CLOFFSET (* ;
@@ -513,9 +512,7 @@ LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
) (CLMARK FLAG) (* ;;
"Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields)."))
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))) (ACCESSFNS (
CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (CHARLOOKS CLFONTUNPARSE) of DATUM with
NEWVALUE))))
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
(DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ;
"Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ;
@@ -524,8 +521,8 @@ NEWVALUE))))
"Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") LINELEAD (* ;
"Leading between lines, in points. This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented."
) FMTBASETOBASE (* ;
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width")
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width")
QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
"The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ;
"The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)"
@@ -567,7 +564,7 @@ DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEA
(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC))))
(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:34:07"))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46"))
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
@@ -609,8 +606,6 @@ WTEXTSTREAM) of PANE)))))
)))
(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
)
(PUTPROPS PANERIGHT MACRO ((PANE PREG) (fetch (REGION RIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
)))
(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
)))))
(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
@@ -623,8 +618,8 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
$$OUT)))))
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 11:56:24"))
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE " 6-Jan-2025 00:20:34"))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:00:10"))
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:24:22"))
(RPAQQ PTSPERPICA 12)
(RPAQQ PTSPERINCH 72)
(RPAQQ PICASPERINCH 6)
@@ -635,9 +630,9 @@ $$OUT)))))
(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT
PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT
MICASPERINCH PTSPERINCH)))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:36:43"))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2024 21:21:48"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "29-Dec-2024 08:47:57"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "26-Nov-2024 23:53:32"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23"))
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
@@ -683,9 +678,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
(PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
(PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
)
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE " 7-Jan-2025 12:31:19"))
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 22:39:52"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 2-Jan-2025 23:45:04"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50"))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-2025 11:00:54" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;263 131893
(FILECREATED " 1-May-2024 14:53:20" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;260 131326
:EDIT-BY rmk
:CHANGES-TO (VARS COMPAREDIRECTORIESCOMS)
:CHANGES-TO (FNS COMPAREDIRECTORIES)
:PREVIOUS-DATE "23-Dec-2024 23:54:13" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;262)
:PREVIOUS-DATE "26-Mar-2024 21:42:47" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;259)
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
@@ -15,8 +15,6 @@
[
(* ;; "Compare the contents of two directories.")
(FILES (SYSLOAD)
PDFSTREAM)
(FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS COMPAREDIRECTORIES.CANDIDATES
CDENTRIES.SELECT COMPAREDIRECTORIES.INFOS.TYPE MATCHNAME CD.INSURECDVALUE
CD.UPDATEWIDTHS)
@@ -61,9 +59,6 @@
(* ;; "Compare the contents of two directories.")
(FILESLOAD (SYSLOAD)
PDFSTREAM)
(DEFINEQ
(COMPAREDIRECTORIES
@@ -1960,8 +1955,6 @@
(CD-MENUFN
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
(* ;; "Edited 23-Dec-2024 23:53 by rmk")
(* ;; "Edited 21-May-2022 21:59 by rmk")
(* ;; "Edited 27-Feb-2022 12:47 by rmk: FILELABELFN, if provided, can be used to calculate abbreviated labels for the file, for example, to strip off any long common prefixes.")
@@ -1975,64 +1968,52 @@
(* ; "Close the previous ones")
(CLOSEWITH.DOIT WINDOW))
(LET (CHILDREN)
(SETQ CHILDREN
(SELECTQ MENUITEM
(Compare (IF (AND FILE1 FILE2)
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
WINDOW
'REGION))
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(See% left (IF FILE1
THEN (if (PDFFILEP FILE1)
then (SEE-PDF FILE1)
else (TEDIT-SEE FILE1 (RELCREATEREGION
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW
'REGION))
-1)
T)
NIL
(CONCAT "SEE window for " LABEL1)))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
(See% right (IF FILE2
THEN (if (PDFFILEP FILE2)
then (SEE-PDF FILE2)
else (TEDIT-SEE FILE2 (RELCREATEREGION
700 700 'LEFT 'TOP `(,WINDOW 0.5)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW
'REGION))
-1)
NIL)
NIL
(CONCAT "SEE window for " LABEL2)))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
((See See% both)
(IF (PDFFILEP FILE1)
then (SEE-PDF FILE1)
(CL:WHEN (PDFFILEP FILE2)
(SEE-PDF FILE2))
elseif (PDFFILEP FILE2)
then (SEE-PDF FILE2)
else (EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
(IPLUS (FETCH (REGION BOTTOM) OF (WINDOWPROP WINDOW
'REGION))
-1)
NIL))))
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
(|Delete ALL <-|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
(|Delete ALL ->|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
(SHOULDNT)))
(SETQ CHILDREN (SELECTQ MENUITEM
(Compare (IF (AND FILE1 FILE2)
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE
(WINDOWPROP WINDOW 'REGION))
ELSE (FLASHWINDOW T)
(PRIN3 "Only one file" T)))
(See% left (IF FILE1
THEN (TEDIT-SEE FILE1
(RELCREATEREGION
700 700 'RIGHT 'TOP `(,WINDOW 0.5)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
T)
NIL
(CONCAT "SEE window for " LABEL1))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
(See% right (IF FILE2
THEN (TEDIT-SEE FILE2
(RELCREATEREGION
700 700 'LEFT 'TOP `(,WINDOW 0.5)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
NIL)
NIL
(CONCAT "SEE window for " LABEL2))
ELSE (FLASHWINDOW T)
(PRIN3 "No file to print" T)))
((See See% both)
(EXAMINEFILES FILE1 FILE2 LABEL1 LABEL2
(RELCREATEREGION 1400 700 'LEFT 'TOP `(,WINDOW 0.5 -701)
(IPLUS (FETCH (REGION BOTTOM)
OF (WINDOWPROP WINDOW 'REGION))
-1)
NIL)))
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
(|Delete ALL <-|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
(|Delete ALL ->|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
(SHOULDNT)))
(CLOSEWITH CHILDREN WINDOW)
(MOVEWITH CHILDREN WINDOW])
@@ -2221,25 +2202,25 @@
(MOVD? 'NILL 'TEDIT.FILEDATE)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2622 22985 (COMPAREDIRECTORIES 2632 . 7967) (COMPAREDIRECTORIES.INFOS 7969 . 10927) (
COMPAREDIRECTORIES.CANDIDATES 10929 . 14314) (CDENTRIES.SELECT 14316 . 19091) (
COMPAREDIRECTORIES.INFOS.TYPE 19093 . 20219) (MATCHNAME 20221 . 20901) (CD.INSURECDVALUE 20903 . 22517
) (CD.UPDATEWIDTHS 22519 . 22983)) (22986 33608 (CDFILES 22996 . 29010) (CDFILES.MATCH 29012 . 30637)
(CDFILES.PATS 30639 . 33606)) (33609 51430 (CDPRINT 33619 . 36136) (CDPRINT.HEADER 36138 . 37035) (
CDPRINT.LINE 37037 . 40269) (CDPRINT.MAXWIDTHS 40271 . 44386) (CDPRINT.COLHEADERS 44388 . 45673) (
CDPRINT.COLUMNS 45675 . 50795) (CDTEDIT 50797 . 51428)) (51431 60552 (CDMAP 51441 . 52873) (CDENTRY
52875 . 53184) (CDSUBSET 53186 . 54625) (CDMERGE 54627 . 58611) (CDMERGE.COMMON 58613 . 59928) (
CD.SORT 59930 . 60550)) (60553 68091 (BINCOMP 60563 . 64852) (EOLTYPE 64854 . 67416) (EOLTYPE.SHOW
67418 . 68089)) (68619 81146 (FIND-UNCOMPILED-FILES 68629 . 72272) (FIND-UNSOURCED-FILES 72274 . 74658
) (FIND-SOURCE-FILES 74660 . 76398) (FIND-COMPILED-FILES 76400 . 78277) (FIND-UNLOADED-FILES 78279 .
79132) (FIND-LOADED-FILES 79134 . 79562) (FIND-MULTICOMPILED-FILES 79564 . 81144)) (81147 89578 (
CREATED-AS 81157 . 85954) (SOURCE-FOR-COMPILED-P 85956 . 88883) (COMPILE-SOURCE-DATE-DIFF 88885 .
89576)) (89579 100342 (FIX-DIRECTORY-DATES 89589 . 93039) (FIX-EQUIV-DATES 93041 . 94566) (
COPY-COMPARED-FILES 94568 . 96389) (COPY-MISSING-FILES 96391 . 98548) (COMPILED-ON-SAME-SOURCE 98550
. 100340)) (100536 108374 (CDBROWSER 100546 . 104473) (CDBROWSER.STRINGS 104475 . 108372)) (108536
110272 (CD.TABLEITEM 108546 . 108766) (CD.TABLEITEM.PRINTFN 108768 . 108967) (CD.TABLEITEM.COPYFN
108969 . 110027) (CDTABLEBROWSER.HEADING.REPAINTFN 110029 . 110270)) (110273 131399 (
CDTABLEBROWSER.WHENSELECTEDFN 110283 . 110751) (CD.COMMANDSELECTEDFN 110753 . 115854) (CD-MENUFN
115856 . 120638) (CD-COMPARE-FILES 120640 . 123992) (CDBROWSER-COPY 123994 . 127663) (
CDBROWSER-DELETE-FILE 127665 . 130878) (CD-SWAPDIRS 130880 . 131397)))))
(FILEMAP (NIL (2526 22889 (COMPAREDIRECTORIES 2536 . 7871) (COMPAREDIRECTORIES.INFOS 7873 . 10831) (
COMPAREDIRECTORIES.CANDIDATES 10833 . 14218) (CDENTRIES.SELECT 14220 . 18995) (
COMPAREDIRECTORIES.INFOS.TYPE 18997 . 20123) (MATCHNAME 20125 . 20805) (CD.INSURECDVALUE 20807 . 22421
) (CD.UPDATEWIDTHS 22423 . 22887)) (22890 33512 (CDFILES 22900 . 28914) (CDFILES.MATCH 28916 . 30541)
(CDFILES.PATS 30543 . 33510)) (33513 51334 (CDPRINT 33523 . 36040) (CDPRINT.HEADER 36042 . 36939) (
CDPRINT.LINE 36941 . 40173) (CDPRINT.MAXWIDTHS 40175 . 44290) (CDPRINT.COLHEADERS 44292 . 45577) (
CDPRINT.COLUMNS 45579 . 50699) (CDTEDIT 50701 . 51332)) (51335 60456 (CDMAP 51345 . 52777) (CDENTRY
52779 . 53088) (CDSUBSET 53090 . 54529) (CDMERGE 54531 . 58515) (CDMERGE.COMMON 58517 . 59832) (
CD.SORT 59834 . 60454)) (60457 67995 (BINCOMP 60467 . 64756) (EOLTYPE 64758 . 67320) (EOLTYPE.SHOW
67322 . 67993)) (68523 81050 (FIND-UNCOMPILED-FILES 68533 . 72176) (FIND-UNSOURCED-FILES 72178 . 74562
) (FIND-SOURCE-FILES 74564 . 76302) (FIND-COMPILED-FILES 76304 . 78181) (FIND-UNLOADED-FILES 78183 .
79036) (FIND-LOADED-FILES 79038 . 79466) (FIND-MULTICOMPILED-FILES 79468 . 81048)) (81051 89482 (
CREATED-AS 81061 . 85858) (SOURCE-FOR-COMPILED-P 85860 . 88787) (COMPILE-SOURCE-DATE-DIFF 88789 .
89480)) (89483 100246 (FIX-DIRECTORY-DATES 89493 . 92943) (FIX-EQUIV-DATES 92945 . 94470) (
COPY-COMPARED-FILES 94472 . 96293) (COPY-MISSING-FILES 96295 . 98452) (COMPILED-ON-SAME-SOURCE 98454
. 100244)) (100440 108278 (CDBROWSER 100450 . 104377) (CDBROWSER.STRINGS 104379 . 108276)) (108440
110176 (CD.TABLEITEM 108450 . 108670) (CD.TABLEITEM.PRINTFN 108672 . 108871) (CD.TABLEITEM.COPYFN
108873 . 109931) (CDTABLEBROWSER.HEADING.REPAINTFN 109933 . 110174)) (110177 130832 (
CDTABLEBROWSER.WHENSELECTEDFN 110187 . 110655) (CD.COMMANDSELECTEDFN 110657 . 115758) (CD-MENUFN
115760 . 120071) (CD-COMPARE-FILES 120073 . 123425) (CDBROWSER-COPY 123427 . 127096) (
CDBROWSER-DELETE-FILE 127098 . 130311) (CD-SWAPDIRS 130313 . 130830)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-May-2024 13:19:49" {WMEDLEY}<lispusers>DINFO.;14 65819
(FILECREATED "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13 65523
:EDIT-BY rmk
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM DINFO.UPDATE.TEXT.DISPLAY)
:CHANGES-TO (FNS DINFO.OPENTEXTSTREAM)
:PREVIOUS-DATE "11-Apr-2024 08:27:34" {WMEDLEY}<lispusers>DINFO.;13)
:PREVIOUS-DATE "10-Mar-2024 15:38:36" {WMEDLEY}<lispusers>DINFO.;12)
(PRETTYCOMPRINT DINFOCOMS)
@@ -988,18 +988,17 @@
(DEFINEQ
(DINFO.UPDATE.TEXT.DISPLAY
[LAMBDA (GRAPH NODE SEL OFF?) (* ; "Edited 25-May-2024 13:16 by rmk")
(* 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))
(TO (fetch (DINFONODE TOBYTE) of NODE))
(PROPS (APPEND (LIST 'READONLY 'QUIET 'NOTITLE T 'TITLEMENUFN (FUNCTION DINFO.TITLEMENUFN))
(PROPS (APPEND (LIST 'READONLY T 'NOTITLE T 'TITLEMENUFN 'DINFO.TITLEMENUFN)
(fetch (DINFOGRAPH TEXTPROPS) of GRAPH)))
(OLD.TEXTSTREAM (WINDOWPROP (fetch (DINFOGRAPH WINDOW) of GRAPH)
'TEXTSTREAM))
TEXTSTREAM FULLFILENAME) (* ; "Default directory and host.")
TEXTSTREAM FULLFILENAME) (* Default directory and host.)
(if (OR OFF? (NULL FILENAME))
then (OPENTEXTSTREAM (CL:UNLESS OFF? (OPENSTRINGSTREAM "This node has no text"))
WINDOW NIL NIL PROPS)
@@ -1037,8 +1036,7 @@
(PROMPTPRINT "DInfo is busy"])
(DINFO.OPENTEXTSTREAM
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 25-May-2024 13:17 by rmk")
(* ; "Edited 10-Apr-2024 23:46 by rmk")
[LAMBDA (FILE WINDOW FROM TO PROPS) (* ; "Edited 10-Apr-2024 23:46 by rmk")
(* ; "Edited 10-Mar-2024 15:37 by rmk")
(* drc%: "25-Jan-86 18:24")
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW WINDOW))
@@ -1055,8 +1053,7 @@
(CLEARW T)
(CLEARW WINDOW)
[RESETSAVE NIL `(AND RESETSTATE (WINDOWPROP ,WINDOW 'LAST.TEXT NIL]
(PROG1 (TEDIT (OPENTEXTSTREAM FILE NIL FROM TO PROPS)
WINDOW)
(PROG1 (OPENTEXTSTREAM FILE WINDOW FROM TO PROPS)
(replace (DINFOGRAPH LAST.TEXT) of (DINFOGRAPH WINDOW) with THIS.TEXT))])
(DINFO.SHOWSEL
@@ -1113,21 +1110,21 @@
(SETTEMPLATE 'DINFOGRAPHPROP 'MACRO)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4582 6041 (DINFOGRAPHPROP 4582 . 6041)) (7295 24433 (DINFO 7305 . 8919) (DINFO.UPDATE
8921 . 11785) (DINFOGRAPH 11787 . 12205) (DINFO.SPECIAL.UPDATE 12207 . 13905) (DINFO.READ.GRAPH 13907
. 15762) (DINFO.WRITE.GRAPH 15764 . 16854) (DINFO.SELECT.GRAPH 16856 . 17763) (DINFO.DEFAULT.MENU
17765 . 20289) (DINFO.FIND 20291 . 22877) (DINFO.LOOKUP 22879 . 24431)) (24434 27128 (
DINFO.READ.KOTO.GRAPH 24444 . 27126)) (27129 29443 (DINFO.SETUP.WINDOW 27139 . 27820) (DINFO.CLOSEFN
27822 . 28255) (DINFO.SHRINKFN 28257 . 28453) (DINFO.EXPANDFN 28455 . 29012) (DINFO.ICONFN 29014 .
29441)) (29444 40766 (DINFO.ADD.FMENU 29454 . 30549) (DINFO.CREATE.FMENU 30551 . 34578) (
DINFO.FMW.CLOSEFN 34580 . 35425) (DINFO.FMENU.HANDLER 35427 . 36066) (DINFO.UPDATE.FMENU 36068 . 38257
) (DINFO.TOGGLE.MENU 38259 . 38849) (DINFO.TOGGLE.GRAPH 38851 . 39350) (DINFO.TOGGLE.HISTORY 39352 .
39896) (DINFO.TOGGLE.TEXT 39898 . 40764)) (40767 48562 (DINFO.UPDATE.MENU.DISPLAY 40777 . 44898) (
DINFO.UPDATE.FROM.MENU 44900 . 45199) (DINFO.UPDATE.HISTORY 45201 . 47731) (DINFO.HISTORIC.UPDATE
47733 . 48560)) (48563 58892 (DINFO.UPDATE.GRAPH.DISPLAY 48573 . 50025) (DINFO.UPDATE.FROM.GRAPH 50027
. 50503) (DINFO.GET.GRAPH.WINDOW 50505 . 51090) (DINFO.CREATE.GRAPH.WINDOW 51092 . 52209) (
DINFO.SHOWGRAPH 52211 . 53936) (DINFO.INVERT.NODE 53938 . 55326) (DINFO.LAYOUTGRAPH 55328 . 58890)) (
58893 65232 (DINFO.UPDATE.TEXT.DISPLAY 58903 . 60963) (DINFO.TITLEMENUFN 60965 . 62090) (
DINFO.OPENTEXTSTREAM 62092 . 63592) (DINFO.SHOWSEL 63594 . 64327) (DINFO.GET.FILENAME 64329 . 65230)))
(FILEMAP (NIL (4556 6015 (DINFOGRAPHPROP 4556 . 6015)) (7269 24407 (DINFO 7279 . 8893) (DINFO.UPDATE
8895 . 11759) (DINFOGRAPH 11761 . 12179) (DINFO.SPECIAL.UPDATE 12181 . 13879) (DINFO.READ.GRAPH 13881
. 15736) (DINFO.WRITE.GRAPH 15738 . 16828) (DINFO.SELECT.GRAPH 16830 . 17737) (DINFO.DEFAULT.MENU
17739 . 20263) (DINFO.FIND 20265 . 22851) (DINFO.LOOKUP 22853 . 24405)) (24408 27102 (
DINFO.READ.KOTO.GRAPH 24418 . 27100)) (27103 29417 (DINFO.SETUP.WINDOW 27113 . 27794) (DINFO.CLOSEFN
27796 . 28229) (DINFO.SHRINKFN 28231 . 28427) (DINFO.EXPANDFN 28429 . 28986) (DINFO.ICONFN 28988 .
29415)) (29418 40740 (DINFO.ADD.FMENU 29428 . 30523) (DINFO.CREATE.FMENU 30525 . 34552) (
DINFO.FMW.CLOSEFN 34554 . 35399) (DINFO.FMENU.HANDLER 35401 . 36040) (DINFO.UPDATE.FMENU 36042 . 38231
) (DINFO.TOGGLE.MENU 38233 . 38823) (DINFO.TOGGLE.GRAPH 38825 . 39324) (DINFO.TOGGLE.HISTORY 39326 .
39870) (DINFO.TOGGLE.TEXT 39872 . 40738)) (40741 48536 (DINFO.UPDATE.MENU.DISPLAY 40751 . 44872) (
DINFO.UPDATE.FROM.MENU 44874 . 45173) (DINFO.UPDATE.HISTORY 45175 . 47705) (DINFO.HISTORIC.UPDATE
47707 . 48534)) (48537 58866 (DINFO.UPDATE.GRAPH.DISPLAY 48547 . 49999) (DINFO.UPDATE.FROM.GRAPH 50001
. 50477) (DINFO.GET.GRAPH.WINDOW 50479 . 51064) (DINFO.CREATE.GRAPH.WINDOW 51066 . 52183) (
DINFO.SHOWGRAPH 52185 . 53910) (DINFO.INVERT.NODE 53912 . 55300) (DINFO.LAYOUTGRAPH 55302 . 58864)) (
58867 64936 (DINFO.UPDATE.TEXT.DISPLAY 58877 . 60825) (DINFO.TITLEMENUFN 60827 . 61952) (
DINFO.OPENTEXTSTREAM 61954 . 63296) (DINFO.SHOWSEL 63298 . 64031) (DINFO.GET.FILENAME 64033 . 64934)))
))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,13 +1,18 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2025 12:28:41" {DSK}<home>matt>Interlisp>medley>lispusers>EDITFONT.;2 28339
(FILECREATED "12-Jul-2022 14:18:56" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EDITFONT.;10 28741
:EDIT-BY "mth"
:CHANGES-TO (FNS READSTRIKEFONTFILE)
(VARS EDITFONTCOMS)
:CHANGES-TO (VARS EDITFONTCOMS)
:PREVIOUS-DATE "27-Jun-2022 10:59:12"
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>EDITFONT.;5)
:PREVIOUS-DATE "12-Jul-2022 14:18:56" {DSK}<home>matt>Interlisp>medley>lispusers>EDITFONT.;1)
(* ; "
Copyright (c) 1985-1986 by Xerox Corporation.
")
(PRETTYCOMPRINT EDITFONTCOMS)
@@ -21,7 +26,9 @@
COPYFONT READSTRIKEFONTFILE)
(FNS BLANKFONTCREATE EDITFONT)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (BITSPERWORD 16)
(BYTESPERWORD 2))
(BYTESPERWORD 2)
(MAXCODE 255)
(DUMMYINDEX 256))
(FILES (LOADCOMP)
FONT))
(P (EF.INIT))))
@@ -520,9 +527,15 @@
(RPAQQ BYTESPERWORD 2)
(RPAQQ MAXCODE 255)
(RPAQQ DUMMYINDEX 256)
(CONSTANTS (BITSPERWORD 16)
(BYTESPERWORD 2))
(BYTESPERWORD 2)
(MAXCODE 255)
(DUMMYINDEX 256))
)
@@ -531,11 +544,12 @@
)
(EF.INIT)
(PUTPROPS EDITFONT COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1325 25875 (EF.INIT 1335 . 2061) (EF.PROMPT 2063 . 2645) (EF.MESSAGE 2647 . 2859) (
EF.CLOSEFN 2861 . 3388) (EF.CHARITEMS 3390 . 5611) (EF.BUTTONEVENTFN 5613 . 6025) (EF.WHENSELECTEDFN
6027 . 6431) (EF.EDITBM 6433 . 7831) (EF.MIDDLEBUTTONFN 7833 . 8078) (EF.CHANGESIZE 8080 . 9299) (
EF.DELETE 9301 . 10066) (EF.ENTER 10068 . 10899) (EF.REPLACE 10901 . 11764) (EF.SAVE 11766 . 16439) (
EF.BLANK 16441 . 22066) (COPYFONT 22068 . 24508) (READSTRIKEFONTFILE 24510 . 25873)) (25876 28090 (
BLANKFONTCREATE 25886 . 26143) (EDITFONT 26145 . 28088)))))
(FILEMAP (NIL (1567 26117 (EF.INIT 1577 . 2303) (EF.PROMPT 2305 . 2887) (EF.MESSAGE 2889 . 3101) (
EF.CLOSEFN 3103 . 3630) (EF.CHARITEMS 3632 . 5853) (EF.BUTTONEVENTFN 5855 . 6267) (EF.WHENSELECTEDFN
6269 . 6673) (EF.EDITBM 6675 . 8073) (EF.MIDDLEBUTTONFN 8075 . 8320) (EF.CHANGESIZE 8322 . 9541) (
EF.DELETE 9543 . 10308) (EF.ENTER 10310 . 11141) (EF.REPLACE 11143 . 12006) (EF.SAVE 12008 . 16681) (
EF.BLANK 16683 . 22308) (COPYFONT 22310 . 24750) (READSTRIKEFONTFILE 24752 . 26115)) (26118 28332 (
BLANKFONTCREATE 26128 . 26385) (EDITFONT 26387 . 28330)))))
STOP

Binary file not shown.

View File

@@ -1,33 +1,29 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-2025 22:00:44" {WMEDLEY}<lispusers>EXAMINEDEFS.;54 16352
(FILECREATED "13-Oct-2023 11:18:04" {WMEDLEY}<lispusers>EXAMINEDEFS.;48 14244
:EDIT-BY rmk
:CHANGES-TO (FNS EXVV EXV)
(COMMANDS exv)
(VARS EXAMINEDEFSCOMS)
:CHANGES-TO (FNS EXAMINEDEFS TEDITDEF)
:PREVIOUS-DATE "12-Dec-2024 15:09:08" {WMEDLEY}<lispusers>EXAMINEDEFS.;53)
:PREVIOUS-DATE "19-Jul-2023 13:59:26" {WMEDLEY}<lispusers>EXAMINEDEFS.;44)
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF EXVV)
(COMMANDS exv)
(RPAQQ EXAMINEDEFSCOMS ((FNS EXAMINEDEFS EXAMINEFILES TEDITDEF)
(INITVARS (EXAMINEDEFS-PROCESS-LIST)
(EXAMINEWITH 'COMPARETEXT))
(FILES (SYSLOAD)
COMPARETEXT VERSIONDEFS)))
COMPARETEXT)))
(DEFINEQ
(EXAMINEDEFS
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 6-Dec-2024 20:51 by rmk")
(* ; "Edited 13-Oct-2023 11:11 by rmk")
[LAMBDA (NAME TYPE SOURCE1 SOURCE2 TITLE1 TITLE2 REGION) (* ; "Edited 13-Oct-2023 11:11 by rmk")
(* ; "Edited 18-May-2023 22:35 by rmk")
(* ; "Edited 21-Apr-2023 14:42 by rmk")
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given, the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintion, NIL is the existing in-memory definition")
(* ;; "This provides for side-by-side examination of separate but presumably related expressions. The (LISTP) expressions can be provided directly as the definitions SOURCE1 and SOURCE2 or, if NAME is given the copies of the definitions of NAME as TYPE on the two sources are examined. If both SOURCE1 and SOURCE2 are NIL, then SOURCE1 is the existing file defintions, NIL is the existing in-memory definition")
(* ;; "")
@@ -235,49 +231,15 @@
(PRIN3 ")" TSTREAM)
ELSE (PRINTDEF DEF 3 NIL NIL NIL TSTREAM)))
TSTREAM])
(EXVV
[LAMBDA (NAME TYPE FILE VERSION1 VERSION2) (* ; "Edited 20-Jan-2025 21:56 by rmk")
(* ; "Edited 12-Dec-2024 15:09 by rmk")
(* ;; "Compares the definitions of NAME as TYPE on 2 different versions of FILE. TYPE and FILE can be elided, defaulting to NIL and WHEREIS respectively. Versions default to newest.")
(* ;; "If only one version specification, compares with the current (like the EXV command)")
(* ;; "(EXVV 'FOO -1 -2) will compare the newest and second-newest function definitions of FOO.")
(CL:UNLESS (AND (VERSIONP VERSION1)
(VERSIONP VERSION2)) (* ; "Both versions, arguments are good")
(if (VERSIONP TYPE)
then (SETQ VERSION1 TYPE) (* ; "TYPE and FILE are NIL")
(SETQ TYPE NIL)
(CL:WHEN (VERSIONP FILE)
(SETQ VERSION2 FILE)
(SETQ FILE NIL))
elseif (VERSIONP FILE)
then (CL:WHEN (VERSIONP VERSION1) (* ; "Type is good, FILE is NIL")
(SETQ VERSION2 VERSION1))
(SETQ VERSION1 FILE)
(SETQ FILE NIL)))
(CL:UNLESS FILE
(SETQ FILE (OR (CAR (WHEREIS NAME (OR TYPE '(FNS FUNCTIONS))
T))
(ERROR "Can't find " FILE " definition of " NAME))))
(if (AND VERSION1 VERSION2)
then (EXAMINEDEFS NAME TYPE (FINDFILEVERSION FILE VERSION1)
(FINDFILEVERSION FILE VERSION2))
else (EXAMINEDEFS NAME TYPE NIL (FINDFILEVERSION FILE (OR VERSION1 VERSION2 -1])
)
(DEFCOMMAND exv (NAME TYPE FILE VERSION) (EXVV NAME TYPE FILE VERSION))
(RPAQ? EXAMINEDEFS-PROCESS-LIST )
(RPAQ? EXAMINEWITH 'COMPARETEXT)
(FILESLOAD (SYSLOAD)
COMPARETEXT VERSIONDEFS)
COMPARETEXT)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (736 16121 (EXAMINEDEFS 746 . 10675) (EXAMINEFILES 10677 . 12159) (TEDITDEF 12161 .
14327) (EXVV 14329 . 16119)))))
(FILEMAP (NIL (618 14102 (EXAMINEDEFS 628 . 10448) (EXAMINEFILES 10450 . 11932) (TEDITDEF 11934 .
14100)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,26 +1,25 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "29-Apr-87 22:43:49" {ERIS}<LISPUSERS>LYRIC>FONTSAMPLER.;4 7992
(FILECREATED " 3-Feb-2025 20:08:40" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;10 8777
changes to%: (FNS FontSample)
:EDIT-BY "mth"
previous date%: "29-Apr-87 22:41:24" {ERIS}<LISPUSERS>KOTO>FONTSAMPLER.;6)
:CHANGES-TO (FNS FontTable)
:PREVIOUS-DATE " 3-Feb-2025 13:06:38" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;7
)
(* "
Copyright (c) 1985, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT FONTSAMPLERCOMS)
(RPAQQ FONTSAMPLERCOMS
((FNS FontSample FontSampleFaked FontTable)
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FONT))))
(RPAQQ FONTSAMPLERCOMS ((FNS FontSample FontSampleFaked FontTable)
[VARS (*INTERESTING-CHARSETS* '(0 33 34 38 39 238 239 240 241]
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FONT))))
(DEFINEQ
(FontSample
[LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03")
[LAMBDA (Fonts CharacterSets Printer StreamType) (* edited%: "29-Apr-87 22:03")
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
(FontList (if (LISTP Fonts)
else (CONS Fonts)))
@@ -56,119 +55,94 @@
(FontTable
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits)
(* ; "Edited 3-Feb-2025 20:07 by mth")
(* edited%: "29-Apr-87 22:36")
(LET*
((Family (FONTPROP Font 'FAMILY))
(Face (FONTPROP Font 'FACE))
(Size (FONTPROP Font 'SIZE))
(Title (CONCAT " " Size "pt " (L-CASE Family T)
" "
(L-CASE Face T)
" Character set "))
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
'DISPLAY)
(NOT (EQ (IMAGESTREAMTYPE Stream)
'DISPLAY]
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
(FONTPROP Font 'HEIGHT]
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
(printout T Title .I0.8 CharacterSet "Q" T)
(RESETLST
(RESETSAVE (RADIX 8))
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
(FTIMES 10 InchesToPrinterUnits)
Stream)
(DSPFONT TitleFont Stream)
(printout Stream Title .I0.8 CharacterSet)
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
(TIMES -0.4 (FONTHEIGHT TitleFont)))
Stream)
(printout Stream "8")
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as Counter
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
do (MOVETO XPosition YPosition Stream)
(PRIN1 Counter Stream))
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter
from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
do (MOVETO XPosition YPosition Stream)
(PRIN1 Counter Stream)))
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
(TIMES 9.3 InchesToPrinterUnits)
(TIMES 8.0 InchesToPrinterUnits)
(TIMES 9.3 InchesToPrinterUnits)
(DSPSCALE NIL Stream)
'PAINT Stream)
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
(TIMES 9.7 InchesToPrinterUnits)
(TIMES 0.6 InchesToPrinterUnits)
(TIMES 1.25 InchesToPrinterUnits)
(DSPSCALE NIL Stream)
'PAINT Stream)
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
from 0 to 15 bind (CharacterCode _ 0)
do
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter
from 0 to 15
do [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
CharacterCode)))
(MOVETO XPosition YPosition Stream)
(if UseDisplayFontBitmaps
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
(ImWidth (CAR ImSize))
(ImHeight (CDR ImSize)))
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
(FTIMES ImHeight
RelativeDescent))
ImWidth ImHeight 'INPUT 'REPLACE))
else (if (AND (NEQ CharacterCode (CHARCODE FF))
(if (MEMB (IMAGESTREAMTYPE Stream)
'(DISPLAY INTERPRESS))
then (OR (AND (IGREATERP CharacterCode 31)
(ILESSP CharacterCode 127))
(AND (IGREATERP CharacterCode 160)
(ILESSP CharacterCode 255)))
else T))
then (PRINTCCODE CCode Stream]
(SETQ CharacterCode (ADD1 CharacterCode)))
(printout T "."))
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
(FTIMES 0.75 InchesToPrinterUnits)
Stream)
(DSPFONT TitleFont Stream)
(printout Stream Title .I0.8 CharacterSet)
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
(TIMES -0.4 (FONTHEIGHT TitleFont)))
Stream)
(printout Stream "8")
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
'HOST)
'LPT)
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
(FTIMES 0.5 InchesToPrinterUnits)
Stream)
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
'DEVICE)
(FILENAMEFIELD (FULLNAME Stream)
'NAME))
T)
", "
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
(if FormFeed
then (DSPNEWPAGE Stream))
(printout T " done." T])
(LET* ((Family (FONTPROP Font 'FAMILY))
(Face (FONTPROP Font 'FACE))
(Size (FONTPROP Font 'SIZE))
(Title (CONCAT " " Size "pt " (L-CASE Family T)
" "
(L-CASE Face T)
" Character set ")))
(printout T Title |.I0.8| CharacterSet "Q")
(RESETLST (RESETSAVE (RADIX 8))
(for XPosition from (TIMES 0.65 InchesToPrinterUnits) by (TIMES 0.45
InchesToPrinterUnits
) as Counter
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
do (MOVETO XPosition YPosition Stream)
(PRIN1 Counter Stream))
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5
InchesToPrinterUnits)
as Counter from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits
))
do (MOVETO XPosition YPosition Stream)
(PRIN1 Counter Stream)))
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
(TIMES 9.25 InchesToPrinterUnits)
(TIMES 8.0 InchesToPrinterUnits)
(TIMES 9.25 InchesToPrinterUnits)
(DSPSCALE NIL Stream)
'PAINT Stream)
(DRAWLINE (TIMES 0.6 InchesToPrinterUnits)
(TIMES 9.7 InchesToPrinterUnits)
(TIMES 0.6 InchesToPrinterUnits)
(TIMES 1.25 InchesToPrinterUnits)
(DSPSCALE NIL Stream)
'PAINT Stream)
(DSPFONT Font Stream)
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (TIMES -0.5 InchesToPrinterUnits)
as YCounter from 0 to 15 bind (CharacterCode _ 0)
do (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by (TIMES 0.45
InchesToPrinterUnits)
as XCounter from 0 to 15
do (MOVETO XPosition YPosition Stream)
(if (AND (NEQ CharacterCode (CHARCODE FF))
(if (MEMB (IMAGESTREAMTYPE Stream)
'(DISPLAY INTERPRESS))
then (OR (AND (IGREATERP CharacterCode 31)
(ILESSP CharacterCode 127))
(AND (IGREATERP CharacterCode 160)
(ILESSP CharacterCode 255)))
else T))
then (PRINTCCODE (IPLUS (ITIMES CharacterSet 256)
CharacterCode)
Stream))
(SETQ CharacterCode (ADD1 CharacterCode)))
(printout T "."))
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
(FTIMES 0.75 InchesToPrinterUnits)
Stream)
(DSPFONT TitleFont Stream)
(printout Stream Title |.I0.8| CharacterSet)
(DSPYPOSITION (PLUS (DSPYPOSITION NIL Stream)
(TIMES -0.4 (FONTHEIGHT TitleFont)))
Stream)
(printout Stream "8")
[if (EQ (FILENAMEFIELD (FULLNAME Stream)
'HOST)
'LPT)
then (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
(FTIMES 0.5 InchesToPrinterUnits)
Stream)
(printout Stream " on " (L-CASE (OR (FILENAMEFIELD (FULLNAME Stream)
'DEVICE)
(FILENAMEFIELD (FULLNAME Stream)
'NAME))
T)
", "
(GDATE NIL (DATEFORMAT NO.TIME SPACES]
(if FormFeed
then (DSPNEWPAGE Stream))
(printout T " done." T])
)
(RPAQQ *INTERESTING-CHARSETS* (0 33 34 38 39 238 239 240 241))
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
FONT)
)
(PUTPROPS FONTSAMPLER COPYRIGHT ("Xerox Corporation" 1985 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (645 8614 (FontSample 655 . 2106) (FontSampleFaked 2108 . 2917) (FontTable 2919 . 8612))
(FILEMAP (NIL (689 7765 (FontSample 699 . 2154) (FontSampleFaked 2156 . 2965) (FontTable 2967 . 7763))
)))
STOP

Binary file not shown.

View File

@@ -1,12 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jan-2025 19:20:27" {WMEDLEY}<lispusers>GITFNS.;535 133255
(FILECREATED "12-Jun-2024 23:02:26" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;6 133403
:EDIT-BY rmk
:EDIT-BY "mth"
:CHANGES-TO (FNS PRC-COMMAND)
:CHANGES-TO (FNS PRC-COMMAND GIT-BRANCH-RELATIONS GIT-BRANCHES GIT-BRANCH-MENU
GIT-PULL-REQUESTS GIT-PRC-BRANCHES CDGITDIR GIT-COMMAND GITORIGIN
GIT-RESULT-TO-LINES STRIPLOCAL GIT-WHICH-BRANCH GIT-GET-DIFFERENT-FILES
GIT-REMOTE-UPDATE GIT-CHECKOUT GIT-MAKE-BRANCH GIT-MY-BRANCHP
GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES)
:PREVIOUS-DATE "12-Jun-2024 23:02:26" {WMEDLEY}<lispusers>GITFNS.;531)
:PREVIOUS-DATE "10-Jun-2024 18:43:43" {DSK}<home>matt>Interlisp>medley>lispusers>GITFNS.;5)
(PRETTYCOMPRINT GITFNSCOMS)
@@ -535,8 +539,7 @@
(DEFINEQ
(PRC-COMMAND
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 29-Jan-2025 19:19 by rmk")
(* ; "Edited 13-May-2024 18:49 by rmk")
[LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 13-May-2024 18:49 by rmk")
(* ; "Edited 2-May-2024 11:44 by rmk")
(* ; "Edited 1-Apr-2024 20:24 by rmk")
(* ; "Edited 28-Jul-2023 09:03 by rmk")
@@ -573,11 +576,9 @@
(SETQ PRS (for PR FOUND in PRS
when (if (STRING-EQUAL "Interlisp" (fetch PRLOGIN of PR))
then (OR (NULL REMOTEBRANCH)
(STRPOS REMOTEBRANCH (CONCAT "#" (fetch PRNUMBER of PR)
" "
(fetch PRNAME of PR)
" "
(fetch PRDESCRIPTION of PR))
(STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR)
NIL NIL NIL NIL FILEDIRCASEARRAY)
(STRPOS REMOTEBRANCH (fetch PRNAME of PR)
NIL NIL NIL NIL FILEDIRCASEARRAY))
else (CL:UNLESS FOUND
(SETQ FOUND T)
@@ -608,7 +609,7 @@
(RPLACD [OR OLDMENUWINDOW (CAR (push GIT-PRC-MENUS (CONS PROJECT]
MENUWINDOW)
MENUWINDOW
else (GIT-PR-COMPARE (GITORIGIN (fetch PRNAME of (CAR PRS)))
else (GIT-PR-COMPARE (fetch PRNAME of (CAR PRS))
PROJECT))
else (CONCAT "No open " (OR REMOTEBRANCH "")
" pull requests"])
@@ -2425,33 +2426,33 @@
(PUTPROPS GITFNS FILETYPE :TCOMPL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4181 20760 (GIT-CLONEP 4191 . 5519) (GIT-INIT 5521 . 6151) (GIT-MAKE-PROJECT 6153 .
13818) (GIT-GET-PROJECT 13820 . 15745) (GIT-PUT-PROJECT-FIELD 15747 . 17388) (GIT-PROJECT-PATH 17390
. 18434) (FIND-ANCESTOR-DIRECTORY 18436 . 18785) (GIT-FIND-CLONE 18787 . 19868) (GIT-MAINBRANCH 19870
. 20265) (GIT-MAINBRANCH? 20267 . 20758)) (26223 31152 (PRC-COMMAND 26233 . 31150)) (31208 33996 (
ALLSUBDIRS 31218 . 32504) (MEDLEYSUBDIRS 32506 . 33199) (GITSUBDIRS 33201 . 33994)) (33997 38787 (
TOGIT 34007 . 35413) (FROMGIT 35415 . 36396) (GIT-DELETE-FILE 36398 . 37244) (MYMEDLEY-DELETE-FILES
37246 . 38785)) (38788 41791 (MYMEDLEYSUBDIR 38798 . 39254) (GITSUBDIR 39256 . 39699) (STRIPDIR 39701
. 40072) (STRIPHOST 40074 . 40314) (STRIPNAME 40316 . 41069) (STRIPWHERE 41071 . 41789)) (41792 43694
(GFILE4MFILE 41802 . 42165) (MFILE4GFILE 42167 . 42736) (GIT-REPO-FILENAME 42738 . 43692)) (43743
54105 (GIT-COMMIT 43753 . 44579) (GIT-PUSH 44581 . 45341) (GIT-PULL 45343 . 46095) (GIT-APPROVAL 46097
. 46446) (GIT-GET-FILE 46448 . 48470) (GIT-FILE-EXISTS? 48472 . 48746) (GIT-REMOTE-UPDATE 48748 .
49583) (GIT-REMOTE-ADD 49585 . 49892) (GIT-FILE-DATE 49894 . 50941) (GIT-FILE-HISTORY 50943 . 52877) (
GIT-PRINT-FILE-HISTORY 52879 . 53929) (GIT-FETCH 53931 . 54103)) (54135 65255 (GIT-BRANCH-DIFF 54145
. 60892) (GIT-COMMIT-DIFFS 60894 . 61567) (GIT-BRANCH-RELATIONS 61569 . 65253)) (65300 84312 (
GIT-BRANCH-NUM 65310 . 65883) (GIT-CHECKOUT 65885 . 67171) (GIT-WHICH-BRANCH 67173 . 67580) (
GIT-MAKE-BRANCH 67582 . 70161) (GIT-BRANCHES 70163 . 72758) (GIT-BRANCH-EXISTS? 72760 . 73631) (
GIT-PICK-BRANCH 73633 . 74123) (GIT-BRANCH-MENU 74125 . 75006) (GIT-BRANCH-WHENSELECTEDFN 75008 .
77173) (GIT-PULL-REQUESTS 77175 . 80693) (GIT-SHORT-BRANCH-NAME 80695 . 80986) (GIT-LONG-NAME 80988 .
81305) (GIT-PRC-BRANCHES 81307 . 84310)) (84342 87790 (GIT-MY-CURRENT-BRANCH 84352 . 84722) (
GIT-MY-BRANCHP 84724 . 85342) (GIT-MY-NEXT-BRANCH 85344 . 85838) (GIT-MY-BRANCHES 85840 . 87788)) (
87836 91911 (GIT-ADD-WORKTREE 87846 . 89453) (GIT-REMOVE-WORKTREE 89455 . 90385) (GIT-LIST-WORKTREES
90387 . 91191) (WORKTREEDIR 91193 . 91909)) (91959 125093 (GIT-GET-DIFFERENT-FILES 91969 . 98393) (
GIT-BRANCHES-COMPARE-DIRECTORIES 98395 . 105626) (GIT-WORKING-COMPARE-DIRECTORIES 105628 . 111076) (
GIT-COMPARE-WORKTREE 111078 . 115056) (GITCDOBJBUTTONFN 115058 . 119548) (GIT-CD-LABELFN 119550 .
120632) (GIT-CD-MENUFN 120634 . 123074) (GIT-WORKING-COMPARE-FILES 123076 . 123696) (
GIT-BRANCHES-COMPARE-FILES 123698 . 124862) (GIT-PR-COMPARE 124864 . 125091)) (125163 133188 (CDGITDIR
125173 . 125860) (GIT-COMMAND 125862 . 127420) (GITORIGIN 127422 . 128119) (GIT-INITIALS 128121 .
128425) (GIT-COMMAND-TO-FILE 128427 . 131912) (GIT-RESULT-TO-LINES 131914 . 132521) (STRIPLOCAL 132523
. 133186)))))
(FILEMAP (NIL (4636 21215 (GIT-CLONEP 4646 . 5974) (GIT-INIT 5976 . 6606) (GIT-MAKE-PROJECT 6608 .
14273) (GIT-GET-PROJECT 14275 . 16200) (GIT-PUT-PROJECT-FIELD 16202 . 17843) (GIT-PROJECT-PATH 17845
. 18889) (FIND-ANCESTOR-DIRECTORY 18891 . 19240) (GIT-FIND-CLONE 19242 . 20323) (GIT-MAINBRANCH 20325
. 20720) (GIT-MAINBRANCH? 20722 . 21213)) (26678 31300 (PRC-COMMAND 26688 . 31298)) (31356 34144 (
ALLSUBDIRS 31366 . 32652) (MEDLEYSUBDIRS 32654 . 33347) (GITSUBDIRS 33349 . 34142)) (34145 38935 (
TOGIT 34155 . 35561) (FROMGIT 35563 . 36544) (GIT-DELETE-FILE 36546 . 37392) (MYMEDLEY-DELETE-FILES
37394 . 38933)) (38936 41939 (MYMEDLEYSUBDIR 38946 . 39402) (GITSUBDIR 39404 . 39847) (STRIPDIR 39849
. 40220) (STRIPHOST 40222 . 40462) (STRIPNAME 40464 . 41217) (STRIPWHERE 41219 . 41937)) (41940 43842
(GFILE4MFILE 41950 . 42313) (MFILE4GFILE 42315 . 42884) (GIT-REPO-FILENAME 42886 . 43840)) (43891
54253 (GIT-COMMIT 43901 . 44727) (GIT-PUSH 44729 . 45489) (GIT-PULL 45491 . 46243) (GIT-APPROVAL 46245
. 46594) (GIT-GET-FILE 46596 . 48618) (GIT-FILE-EXISTS? 48620 . 48894) (GIT-REMOTE-UPDATE 48896 .
49731) (GIT-REMOTE-ADD 49733 . 50040) (GIT-FILE-DATE 50042 . 51089) (GIT-FILE-HISTORY 51091 . 53025) (
GIT-PRINT-FILE-HISTORY 53027 . 54077) (GIT-FETCH 54079 . 54251)) (54283 65403 (GIT-BRANCH-DIFF 54293
. 61040) (GIT-COMMIT-DIFFS 61042 . 61715) (GIT-BRANCH-RELATIONS 61717 . 65401)) (65448 84460 (
GIT-BRANCH-NUM 65458 . 66031) (GIT-CHECKOUT 66033 . 67319) (GIT-WHICH-BRANCH 67321 . 67728) (
GIT-MAKE-BRANCH 67730 . 70309) (GIT-BRANCHES 70311 . 72906) (GIT-BRANCH-EXISTS? 72908 . 73779) (
GIT-PICK-BRANCH 73781 . 74271) (GIT-BRANCH-MENU 74273 . 75154) (GIT-BRANCH-WHENSELECTEDFN 75156 .
77321) (GIT-PULL-REQUESTS 77323 . 80841) (GIT-SHORT-BRANCH-NAME 80843 . 81134) (GIT-LONG-NAME 81136 .
81453) (GIT-PRC-BRANCHES 81455 . 84458)) (84490 87938 (GIT-MY-CURRENT-BRANCH 84500 . 84870) (
GIT-MY-BRANCHP 84872 . 85490) (GIT-MY-NEXT-BRANCH 85492 . 85986) (GIT-MY-BRANCHES 85988 . 87936)) (
87984 92059 (GIT-ADD-WORKTREE 87994 . 89601) (GIT-REMOVE-WORKTREE 89603 . 90533) (GIT-LIST-WORKTREES
90535 . 91339) (WORKTREEDIR 91341 . 92057)) (92107 125241 (GIT-GET-DIFFERENT-FILES 92117 . 98541) (
GIT-BRANCHES-COMPARE-DIRECTORIES 98543 . 105774) (GIT-WORKING-COMPARE-DIRECTORIES 105776 . 111224) (
GIT-COMPARE-WORKTREE 111226 . 115204) (GITCDOBJBUTTONFN 115206 . 119696) (GIT-CD-LABELFN 119698 .
120780) (GIT-CD-MENUFN 120782 . 123222) (GIT-WORKING-COMPARE-FILES 123224 . 123844) (
GIT-BRANCHES-COMPARE-FILES 123846 . 125010) (GIT-PR-COMPARE 125012 . 125239)) (125311 133336 (CDGITDIR
125321 . 126008) (GIT-COMMAND 126010 . 127568) (GITORIGIN 127570 . 128267) (GIT-INITIALS 128269 .
128573) (GIT-COMMAND-TO-FILE 128575 . 132060) (GIT-RESULT-TO-LINES 132062 . 132669) (STRIPLOCAL 132671
. 133334)))))
STOP

Binary file not shown.

BIN
lispusers/GITFNS.PDF Normal file

Binary file not shown.

View File

@@ -1,239 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Jan-2025 19:34:13" {WMEDLEY}<lispusers>MULTI-ALIST.;15 12223
:EDIT-BY rmk
:CHANGES-TO (FNS MAPMULTI)
:PREVIOUS-DATE "25-Jan-2025 15:04:13" {WMEDLEY}<lispusers>MULTI-ALIST.;14)
(PRETTYCOMPRINT MULTI-ALISTCOMS)
(RPAQQ MULTI-ALISTCOMS
((MACROS GETMULTI PUTMULTI PUTMULTI-D PUTMULTI-NEW PUTMULTI-COUNT PUTMULTI-SUM REMOVEMULTI
REMOVEMULTIALL)
(MACROS FGETMULTI FPUTMULTI FPUTMULTI-D FPUTMULTI-NEW)
(FNS MAPMULTI MAPMULTI1 COLLECTMULTI)
(FNS GETMULTI.EXPAND PUTMULTI.EXPAND REMOVEMULTI.EXPAND)
(MACROS ADDTOMULTI)
(FNS ADDTOMULTI1)
(LOCALVARS . T)))
(DECLARE%: EVAL@COMPILE
(PUTPROPS GETMULTI MACRO (ARGS (GETMULTI.EXPAND 'SASSOC ARGS)))
(PUTPROPS PUTMULTI MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS)))
(PUTPROPS PUTMULTI-D MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS NIL T)))
(PUTPROPS PUTMULTI-NEW MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS)))
(PUTPROPS PUTMULTI-COUNT MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC (APPEND ARGS '(1))
NIL NIL T)))
(PUTPROPS PUTMULTI-SUM MACRO (ARGS (PUTMULTI.EXPAND 'SASSOC ARGS NIL NIL T)))
(PUTPROPS REMOVEMULTI MACRO (ARGS (REMOVEMULTI.EXPAND ARGS)))
(PUTPROPS REMOVEMULTIALL MACRO (ARGS (REMOVEMULTI.EXPAND ARGS T)))
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS FGETMULTI MACRO (ARGS (GETMULTI.EXPAND 'FASSOC ARGS)))
(PUTPROPS FPUTMULTI MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
(PUTPROPS FPUTMULTI-D MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS NIL T)))
(PUTPROPS FPUTMULTI-NEW MACRO (ARGS (PUTMULTI.EXPAND 'FASSOC ARGS)))
)
(DEFINEQ
(MAPMULTI
[LAMBDA (MULTIALIST MAPFN) (* ; "Edited 29-Jan-2025 19:33 by rmk")
(* ; "Edited 25-Jan-2025 14:51 by rmk")
(* ; "Edited 16-Jan-2025 10:32 by rmk")
(* ; "Edited 6-Jan-2020 10:15 by rmk:")
(* ;; "MAPMULTI applies a mapping function of N args to each item in an N-way item in the multi-alist at MULTIALIST. If an item C is inserted by (PUTMULTI FOO A B C), then MAPFN should be a 3 argument function and it will be applied to A B C. The caller is responsible for making sure the arities of the index and the mapfn correspond.")
(DECLARE (SPECVARS MAPFN))
(LET ($$LISTFORARGS$$)
(DECLARE (SPECVARS $$LISTFORARGS$$))
(SETQ $$LISTFORARGS$$ (FOR I FROM 1 TO (NARGS MAPFN) COLLECT NIL))
(MAPMULTI1 MULTIALIST $$LISTFORARGS$$ (NARGS MAPFN])
(MAPMULTI1
[LAMBDA (SUBALIST ARGLIST NREMAINING) (* ; "Edited 25-Jan-2025 15:03 by rmk")
(* ; "Edited 22-Jan-2025 23:42 by rmk")
(* ; "Edited 16-Jan-2025 10:29 by rmk")
(* ; "Edited 6-Jan-2020 10:21 by rmk:")
(DECLARE (USEDFREE $$LISTFORARGS$$ MAPFN))
(if [AND (IGREATERP NREMAINING 1)
(LISTP (CAR (LISTP SUBALIST]
then
(* ;; "Still a list of alists.")
(for SI in SUBALIST do (RPLACA ARGLIST (CAR SI))
(MAPMULTI1 (CDR SI)
(CDR ARGLIST)
(SUB1 NREMAINING)))
else (for ITEM inside SUBALIST do (RPLACA ARGLIST ITEM)
(APPLY MAPFN $$LISTFORARGS$$])
(COLLECTMULTI
[LAMBDA (MULTIALIST MAPFN) (* ; "Edited 25-Jan-2025 15:00 by rmk")
(* ; "Edited 22-Jan-2025 23:44 by rmk")
(* ; "Edited 6-Jan-2020 10:15 by rmk:")
(LET ($$COLLECT)
(DECLARE (SPECVARS $$COLLECT))
(MAPMULTI MULTIALIST MAPFN)
$$COLLECT])
)
(DEFINEQ
(GETMULTI.EXPAND
[LAMBDA (ASSOCFN ARGS) (* ; "Edited 16-Jan-2025 10:27 by rmk")
(* ; "Edited 19-Jul-2020 00:38 by rmk:")
(* ; "Edited 22-Mar-2020 13:21 by rmk:")
(* ; "Edited 27-Feb-2020 13:44 by rmk:")
(* ; "Edited 30-Dec-2019 20:50 by rmk:")
(* ;; "If SUM, returns the value after the last argument, paired with PUTMULTISUM")
(IF (CDR ARGS)
THEN `(LET ($$CELL$$)
(DECLARE (LOCALVARS $$CELL$$))
,@[FOR ATAIL (HEAD _ (CAR ARGS)) ON (CDR ARGS)
COLLECT (PROG1 `[SETQ $$CELL$$ (CDR (,ASSOCFN ,(CAR ATAIL)
,HEAD]
(SETQ HEAD '$$CELL$$))]
$$CELL$$)
ELSE (CAR ARGS])
(PUTMULTI.EXPAND
[LAMBDA (ASSOCFN ARGS ALLOWREPEATS SINGLEVALUE SUM) (* ; "Edited 23-Jan-2025 09:40 by rmk")
(* ; "Edited 16-Jan-2025 10:18 by rmk")
(* ; "Edited 17-Aug-2020 14:09 by rmk:")
(* ;; "If ALLOWREPEATS, doesn't test (MEMBER) for preexisting values, just accumulates")
(* ;; "If SINGLEVALUE, new value smashes out old")
(* ;; "For SUM, the last argument is the increment to be added to the current value, and the incremented value is returned for PUTMULTISUM and for GETMULT")
(* ;; "")
(* ;; "We get the setf method so that any expressions in the form will be evaluated only once.")
(CL:MULTIPLE-VALUE-BIND
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
(CL:GET-SETF-METHOD (CAR ARGS))
(CL:IF (CDR ARGS)
`(LET*
,(FOR VF IN VALFORMS AS TV IN TEMPVARS COLLECT (LIST TV VF))
(DECLARE (LOCALVARS ,@TEMPVARS))
(LET
($$ARG1$$ $$ARG2$$)
(DECLARE (LOCALVARS $$ARG1$$ $$ARG2$$))
,@[FOR ATAIL (HEAD _ ACCESSFORM) ON ARGS WHILE (CDR ATAIL)
JOIN
(IF (AND SUM (NULL (CDDR ATAIL)))
THEN (POP ATAIL)
`[(CL:UNLESS ,HEAD (RPLACD $$ARG1$$ 0))
(SETQ $$ARG2$$ (ADD ,HEAD ,(CAR ATAIL]
ELSE
(PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
,(IF (CDDR ATAIL)
THEN `[SETQ $$ARG1$$ (OR (,ASSOCFN $$ARG2$$ ,HEAD)
(CAR (CL:PUSH (CONS $$ARG2$$)
,HEAD]
ELSEIF ALLOWREPEATS
THEN `(push ,HEAD $$ARG2$$)
ELSEIF SINGLEVALUE
THEN `(RPLACD $$ARG2$$)
ELSE `(OR (MEMBER $$ARG2$$ ,HEAD)
(push ,HEAD $$ARG2$$]
(SETQ HEAD '(CDR $$ARG1$$)))]
$$ARG2$$))
(CAR ARGS))])
(REMOVEMULTI.EXPAND
[LAMBDA (ARGS ALLFLAG) (* ; "Edited 16-Jan-2025 10:34 by rmk")
(* ; "Edited 17-Aug-2020 15:12 by rmk:")
(* ; "Edited 17-May-2020 17:25 by rmk:")
(* ; "Edited 14-Feb-2020 11:24 by rmk:")
(* ; "Edited 25-Dec-2019 09:57 by rmk:")
(* ;; "If ALLFLAG, then all data after the last of ARGS, if any, is removed. That is, if there are 3 keys to the index, and REMOVEMULTIALL is invoked with 2 keys, then it's as if no entries were made for any of the third keys after those first two. In the case of REMOVEMULTIALL, it returns the previous tail.")
(* ;; "No point in distinguishing FASSOC from SASSOC here.")
(CL:MULTIPLE-VALUE-BIND
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
(CL:GET-SETF-METHOD (CAR ARGS))
(CL:IF (CDR ARGS)
`(LET*
,(FOR VF IN VALFORMS AS TV IN TEMPVARS COLLECT (LIST TV VF))
(DECLARE (LOCALVARS ,@TEMPVARS))
(LET
($$ARG1$$ $$ARG2$$)
(DECLARE (LOCALVARS $$ARG1$$ $$ARG2$$))
,@[FOR ATAIL (HEAD _ ACCESSFORM) ON ARGS WHILE (CDR ATAIL)
JOIN (PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
,(IF (CDDR ATAIL)
THEN `(SETQ $$ARG1$$ (SASSOC $$ARG2$$ ,HEAD))
ELSEIF ALLFLAG
THEN `(CL:WHEN (SETQ $$ARG1$$ (SASSOC $$ARG2$$ ,HEAD))
(SETQ $$ARG2$$ (CDR $$ARG1$$))
(RPLACD $$ARG1$$))
ELSE `(AND (SETQ $$ARG2$$ (MEMBER $$ARG2$$ ,HEAD))
(RPLACD $$ARG1$$ (DREMOVE (SETQ $$ARG2$$ (CAR $$ARG2$$))
,HEAD]
(SETQ HEAD '(CDR $$ARG1$$)))]
$$ARG2$$))
(CAR ARGS))])
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS ADDTOMULTI MACRO [ARGS (CL:MULTIPLE-VALUE-BIND
(TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
(CL:GET-SETF-METHOD (CAR ARGS))
`(LET* [,@(FOR VF IN VALFORMS AS TV IN TEMPVARS
COLLECT (LIST TV VF))
($$KEYS ,(CADR ARGS]
(DECLARE (LOCALVARS $$KEYS ,@TEMPVARS))
(COND
[(LISTP $$KEYS)
(CL:UNLESS (SASSOC (CAR $$KEYS)
,ACCESSFORM)
(CL:PUSH (CONS (CAR $$KEYS))
,ACCESSFORM))
(ADDTOMULTI1 ,ACCESSFORM $$KEYS ,(CADDR ARGS]
(T (CL:SETF ,ACCESSFORM ,(CADDR ARGS])
)
(DEFINEQ
(ADDTOMULTI1
[LAMBDA (PLACE KEYS VAL) (* ; "Edited 22-Jan-2025 23:47 by rmk")
(* ; "Edited 17-Aug-2020 15:05 by rmk:")
(* ;; "This allows the keys to be provided in a single list rather than as separate arguments.")
(FOR I (P _ PLACE) IN KEYS DO [SETQ P (OR (SASSOC I P)
(CAR (PUSH (CDR P)
(CONS I] FINALLY (PUSH (CDR P)
VAL))
VAL])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1837 4449 (MAPMULTI 1847 . 2915) (MAPMULTI1 2917 . 3974) (COLLECTMULTI 3976 . 4447)) (
4450 10311 (GETMULTI.EXPAND 4460 . 5581) (PUTMULTI.EXPAND 5583 . 7995) (REMOVEMULTI.EXPAND 7997 .
10309)) (11461 12146 (ADDTOMULTI1 11471 . 12144)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Dec-2024 11:45:23" {WMEDLEY}<library>PSEUDOHOSTS.;177 29713
(FILECREATED " 2-Nov-2023 10:53:30" {WMEDLEY}<lispusers>PSEUDOHOSTS.;160 26843
:EDIT-BY rmk
:CHANGES-TO (FNS TRUEDEVICE)
:CHANGES-TO (FNS PSEUDOHOST)
:PREVIOUS-DATE "25-Dec-2024 07:38:10" {WMEDLEY}<library>PSEUDOHOSTS.;176)
:PREVIOUS-DATE " 1-Oct-2023 20:16:43" {WMEDLEY}<lispusers>PSEUDOHOSTS.;159)
(PRETTYCOMPRINT PSEUDOHOSTSCOMS)
@@ -15,17 +15,16 @@
(
(* ;; "Public entries")
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME)
(FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEFILENAME PSEUDOFILENAME)
(* ;; "Internals")
(FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH)
(FNS CDPSEUDO)
(FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH
OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH
SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (PSEUDOHOST 'LI LOGINHOST/DIR)))
(P (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
(P (PSEUDOHOST 'LI LOGINHOST/DIR)
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
(MOVD 'GETHOSTINFO.PH 'GETHOSTINFO))
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE)
(MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)
@@ -137,14 +136,9 @@
HOST])
(PSEUDOHOSTP
[LAMBDA (HOST) (* ; "Edited 16-Dec-2024 21:15 by rmk")
(* ; "Edited 24-Feb-2022 23:51 by rmk")
[LAMBDA (HOST) (* ; "Edited 24-Feb-2022 23:51 by rmk")
(* ; "Edited 18-Jan-2022 11:29 by rmk")
(LET [(DEV (if (type? FDEV HOST)
then HOST
elseif (type? STREAM HOST)
then (fetch (STREAM DEVICE) of HOST)
else (\GETDEVICEFROMNAME HOST T T]
(LET ((DEV (\GETDEVICEFROMNAME HOST T T)))
(CL:WHEN (AND DEV (type? FDEV (fetch (PHDEVICE TARGETDEV) OF DEV)))
(LIST (FETCH (FDEV DEVICENAME) OF DEV)
(FETCH (PHDEVICE PREFIX)
@@ -157,30 +151,9 @@
(FETCH (PHDEVICE PREFIX) OF DEV])
(TARGETHOST
[LAMBDA (HOST) (* ; "Edited 14-Dec-2024 15:26 by rmk")
(* ; "Edited 12-Dec-2024 16:16 by rmk")
(* ; "Edited 22-Jan-2022 09:00 by rmk")
(if (STREAMP HOST)
then (CL:WHEN (type? FDEV (fetch (PHDEVICE TARGETDEV) of (fetch (STREAM DEVICE) of HOST)))
(fetch (FDEV DEVICENAME) of (fetch (PHDEVICE TARGETDEV) of (fetch (STREAM DEVICE)
of HOST))))
elseif (PSEUDOHOSTP HOST)
then (fetch (FDEV DEVICENAME) of (fetch (PHDEVICE TARGETDEV) of (\GETDEVICEFROMNAME HOST T T])
(TRUEDEVICE
[LAMBDA (X) (* ; "Edited 31-Dec-2024 11:44 by rmk")
(* ; "Edited 25-Dec-2024 07:37 by rmk")
(* ; "Edited 23-Dec-2024 22:56 by rmk")
(* ; "Edited 16-Dec-2024 17:36 by rmk")
(* ; "Edited 12-Dec-2024 14:34 by rmk")
(LET [(DEV (if (type? FDEV X)
then X
elseif (STREAMP X)
then (fetch (STREAM DEVICE) of X)
else (\GETDEVICEFROMNAME X]
(if (type? FDEV (fetch (PHDEVICE TARGETDEV) of DEV))
then (fetch (PHDEVICE TARGETDEV) of DEV)
else DEV])
[LAMBDA (HOST) (* ; "Edited 22-Jan-2022 09:00 by rmk")
(CL:WHEN (PSEUDOHOSTP HOST)
(FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))])
(TRUEFILENAME
[LAMBDA (FILE) (* ; "Edited 1-Oct-2023 20:16 by rmk")
@@ -328,24 +301,6 @@
)
(DEFINEQ
(CDPSEUDO
[LAMBDA (PHOST CDSUFFIX FILEPKG) (* ; "Edited 21-Dec-2024 13:48 by rmk")
(* ; "Edited 6-Feb-2024 15:50 by rmk")
(* ;; "Makes a cd command for PHOST. The command name is %"cd%" followed by the lower-case letters of CDSUFFIX (e.g. cdf for PHOST FOO and CDSUFFIX %"f%".")
(CL:WHEN (AND (SETQ PHOST (CAR (PSEUDOHOSTP PHOST)))
CDSUFFIX)
[LET ((C (PACK* "cd" (L-CASE CDSUFFIX)))
(FILEPKGFLG FILEPKG))
(DECLARE (SPECVARS FILEPKGFLG))
(SETQ PHOST (CONCAT "{" PHOST "}"))
(EVAL `(DEFCOMMAND ,C (SUBDIR) (/CNDIR (CL:IF SUBDIR
(CONCAT ,PHOST "/" SUBDIR)
,PHOST)))])])
)
(DEFINEQ
(OPENFILE.PH
[LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING)
@@ -498,10 +453,8 @@
(SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE)))
RESULT])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(PSEUDOHOST 'LI LOGINHOST/DIR)
)
(MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG)
@@ -562,13 +515,12 @@
EXPORTS.ALL)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1318 12059 (PSEUDOHOST 1328 . 7036) (PSEUDOHOSTP 7038 . 7867) (PSEUDOHOSTS 7869 . 8230)
(TARGETHOST 8232 . 9101) (TRUEDEVICE 9103 . 10059) (TRUEFILENAME 10061 . 11186) (PSEUDOFILENAME 11188
. 12057)) (12087 18102 (EXPAND.PH 12097 . 13350) (CONTRACT.PH 13352 . 16063) (UNSLASHIT 16065 . 17811
) (GETHOSTINFO.PH 17813 . 18100)) (18103 19004 (CDPSEUDO 18113 . 19002)) (19005 27025 (OPENFILE.PH
19015 . 20088) (GETFILENAME.PH 20090 . 20379) (DIRECTORYNAMEP.PH 20381 . 21005) (CLOSEFILE.PH 21007 .
21474) (REOPENFILE.PH 21476 . 22041) (DELETEFILE.PH 22043 . 22327) (OPENP.PH 22329 . 22624) (
UNREGISTERFILE.PH 22626 . 23168) (REGISTERFILE.PH 23170 . 23704) (GENERATEFILES.PH 23706 . 24750) (
GETFILEINFO.PH 24752 . 25054) (SETFILEINFO.PH 25056 . 25255) (NEXTFILEFN.PH 25257 . 25803) (
FILEINFOFN.PH 25805 . 26080) (RENAMEFILE.PH 26082 . 27023)))))
(FILEMAP (NIL (1254 10126 (PSEUDOHOST 1264 . 6972) (PSEUDOHOSTP 6974 . 7487) (PSEUDOHOSTS 7489 . 7850)
(TARGETHOST 7852 . 8126) (TRUEFILENAME 8128 . 9253) (PSEUDOFILENAME 9255 . 10124)) (10154 16169 (
EXPAND.PH 10164 . 11417) (CONTRACT.PH 11419 . 14130) (UNSLASHIT 14132 . 15878) (GETHOSTINFO.PH 15880
. 16167)) (16170 24190 (OPENFILE.PH 16180 . 17253) (GETFILENAME.PH 17255 . 17544) (DIRECTORYNAMEP.PH
17546 . 18170) (CLOSEFILE.PH 18172 . 18639) (REOPENFILE.PH 18641 . 19206) (DELETEFILE.PH 19208 . 19492
) (OPENP.PH 19494 . 19789) (UNREGISTERFILE.PH 19791 . 20333) (REGISTERFILE.PH 20335 . 20869) (
GENERATEFILES.PH 20871 . 21915) (GETFILEINFO.PH 21917 . 22219) (SETFILEINFO.PH 22221 . 22420) (
NEXTFILEFN.PH 22422 . 22968) (FILEINFOFN.PH 22970 . 23245) (RENAMEFILE.PH 23247 . 24188)))))
STOP

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Nov-2024 17:59:00" {WMEDLEY}<lispusers>REGIONMANAGER.;135 42008
(FILECREATED "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134 41230
:EDIT-BY rmk
:CHANGES-TO (FNS \RELCREATEREGION.REF)
:CHANGES-TO (FNS CLOSE-TYPED-W)
:PREVIOUS-DATE "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134)
:PREVIOUS-DATE " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133)
(PRETTYCOMPRINT REGIONMANAGERCOMS)
@@ -446,8 +446,7 @@
(DEFINEQ
(\RELCREATEREGION.REF
[LAMBDA (REF WHICH) (* ; "Edited 25-Nov-2024 17:47 by rmk")
(* ; "Edited 27-Feb-2022 08:43 by rmk")
[LAMBDA (REF WHICH) (* ; "Edited 27-Feb-2022 08:43 by rmk")
(* ; "Edited 23-Jan-2022 20:20 by rmk")
(* ; "Edited 2-Jan-2022 11:01 by rmk")
@@ -475,10 +474,6 @@
'REGION))
(FETCH (REGION BOTTOM) OF (WINDOWPROP (WFROMDS T)
'REGION)))
ELSEIF (REGIONP REF)
THEN (CL:IF (EQ WHICH 'X)
(FETCH (REGION LEFT) OF REF)
(FETCH (REGION BOTTOM) OF REF))
ELSEIF [AND (LISTP REF)
(SETQ ANCHOR (OR (REGIONP (CAR REF))
(AND (WINDOWP (CAR REF))
@@ -515,15 +510,6 @@
(CL:WHEN (CADR SPEC)
(ADD VAL (CADR SPEC)))
VAL
ELSEIF (WINDOWP REF)
THEN (SETQ REF (WINDOWPROP REF 'REGION))
(CL:IF (EQ WHICH 'X)
(FETCH (REGION LEFT) OF REF)
(FETCH (REGION BOTTOM) OF REF))
ELSEIF (POSITIONP REF)
THEN (CL:IF (EQ WHICH 'X)
(FETCH (POSITION XCOORD) OF REF)
(FETCH (POSITION YCOORD) OF REF))
ELSE (\ILLEGAL.ARG REF])
(\RELCREATEREGION.SIZE
@@ -746,11 +732,11 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1622 6740 (SET-TYPED-REGIONS 1632 . 3807) (GRAB-TYPED-REGION 3809 . 4835) (
REGISTER-TYPED-REGION 4837 . 6134) (REGION-TYPE 6136 . 6738)) (6741 14810 (RM-CREATEW 6751 . 8874) (
RM-CLOSEW 8876 . 11894) (RM-GETREGION 11896 . 14045) (CLOSE-TYPED-W 14047 . 14808)) (15453 22932 (
RELCREATEREGION 15463 . 20086) (RELGETREGION 20088 . 22695) (RELCREATEPOSITION 22697 . 22930)) (22933
30508 (\RELCREATEREGION.REF 22943 . 27465) (\RELCREATEREGION.SIZE 27467 . 30506)) (30561 39903 (
RM-ATTACHWINDOW 30571 . 39901)) (39904 41638 (CLOSEWITH 39914 . 40441) (CLOSEWITH.DOIT 40443 . 40723)
(MOVEWITH 40725 . 41248) (MOVEWITH.DOIT 41250 . 41636)))))
(FILEMAP (NIL (1615 6733 (SET-TYPED-REGIONS 1625 . 3800) (GRAB-TYPED-REGION 3802 . 4828) (
REGISTER-TYPED-REGION 4830 . 6127) (REGION-TYPE 6129 . 6731)) (6734 14803 (RM-CREATEW 6744 . 8867) (
RM-CLOSEW 8869 . 11887) (RM-GETREGION 11889 . 14038) (CLOSE-TYPED-W 14040 . 14801)) (15446 22925 (
RELCREATEREGION 15456 . 20079) (RELGETREGION 20081 . 22688) (RELCREATEPOSITION 22690 . 22923)) (22926
29730 (\RELCREATEREGION.REF 22936 . 26687) (\RELCREATEREGION.SIZE 26689 . 29728)) (29783 39125 (
RM-ATTACHWINDOW 29793 . 39123)) (39126 40860 (CLOSEWITH 39136 . 39663) (CLOSEWITH.DOIT 39665 . 39945)
(MOVEWITH 39947 . 40470) (MOVEWITH.DOIT 40472 . 40858)))))
STOP

Binary file not shown.

View File

@@ -1,26 +1,16 @@
Medley REGIONMANAGER
2
4
1
REGIONMANAGER
1
4
By Ron Kaplan
This document created in December 2021, last edited September 2023.
Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications.
Medley REGIONMANAGER 2
4
1
REGIONMANAGER 1
4
By Ron Kaplan This document created in December 2021, last edited September 2023.
Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications.
The REGIONMANAGER package provides simple extensions to the core region and window functions. These are aimed at giving users and application implementors more flexible and systematic control over the specification and reuse of screen regions. It introduces three new notions:
A "typed region" allows the regions of particular applications to be specified, classified, and recycled according to their types.
The size, location, and orientation of a "relative region" is specified with respect to particular screen points and the location of other windows.
A "constellation region" encloses the collection of satellite windows (prompts, menus, etc) that surround the central window of an application.
REGIONMANAGER is innocuous in that explicit user action is required to change the default behavior of any system components.
Typed regions
Typed regions
REGIONMANAGER adds overlay veneers to the core CREATEW, CLOSEW, and GETREGION functions to make it easier to predict and control how different applications arrange their windows on the screen without always needing to respond to a ghost-region prompt.
The REGION/INITREGION arguments may now be region-type atoms in addition to either NIL or particular regions as CREATEW and GETREGION otherwise allow. The type-atom will resolve to a region drawn from a predefined pool of regions associated with that type, if the pool has at least one that is not currently allocated to another window. If the pool has no available regions, then the pool will be enlarged with a region that the user produces from a normal ghost-region prompt, and the type-atom will then resolve to the newly installed region.
A typed-region is marked as "inuse" and therefore unavailable when CREATEW assigns it to a window, and the extended CLOSEW marks it as again available when the window is closed. The region of the most recently closed window will be offered the next time a region of its type is requested.
@@ -44,15 +34,15 @@ Two functions are provided to make it easy to create regions relative and orient
RELCREATEREGION creates a region of dimensions WIDTH and HEIGHT. One of its corners is identified by CORNERX and CORNERY and that corner will be aligned with a reference screen-point determined by REFX and REFY. If ONSCREEN, the WIDTH or HEIGHT will be adjusted with respect to that alignment so that the resulting region is entirely within the screen.
WIDTH and HEIGHT can be given as absolute (natural) numbers or specified relative to the WIDTH and HEIGHT of another region or of the screen. The possibilities are interpreted as follows:
natural number: the number of screen points
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corresponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
region/window/SCREEN/TTY:equivalent to (region/window/SCREEN/TTY 1 0).
list of the form (anchor fraction adjustment), where anchor is a region, window, or an atom SCREEN or TTY. The corresponding dimension of the anchor is mutiplied by fraction and adjustment is added to the result. For example, specifying (<window> .5 -1) results in a WIDTH that is one point smaller than half the width of window's region. Fraction and adjustment default to 1 and 0 respectively.
region/window/SCREEN/TTY: equivalent to (region/window/SCREEN/TTY 1 0).
CORNERX can be LEFT, RIGHT, or NIL=LEFT, CORNERY can be BOTTOM, TOP, or NIL=BOTTOM. If LEFT/TOP are specified, for example, the region will be displayed down and to the right of the reference point. If RIGHT/BOTTOM, then up and to the left.
The reference-point arguments REFX and REFY are interpreted as follows:
NIL: LASTMOUSEX/LASTMOUSEY
natural number: an absolute screen coordinate
(anchor fraction adjustment), or just region/window/SCREEN/TTY. The quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom to produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification (<window> .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region.
If REFX and REFY are positions, then the XCCORD of REFX and the YCOORD of REFY are taken as the absolute values for REFX and REFY respectively. For conveninence, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY.
Also for convenience, if WIDTH is potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call.
(anchor fraction adjustment) or just region/window/SCREEN/TTY: the quantity determined relative to the size of anchor (as above) is added to the anchors left/bottom produce the REFX/REFY coordinate. In this case, fractions specified as LEFT/BOTTOM/NIL are interpreted as 0 and RIGHT/TOP are interpreted as 1. For example, a specification (<window> .4 -2) for REFY will produce a coordinate 2 points below the level that is 40% of the distance between the bottom and top of the window's region.
For convenience, if REFX is a position and REFY is NIL, then the XCOORD and YCOORD of REFX are taken as absolute values for REFX and REFY.
Also for convenience, if WIDTH is a potentially a list of RELCREATEREGION arguments, then the elements of that list are spread out in a recursive call.
(RELGETREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY MINSIZE) [Function]
Calls GETREGION with an initial ghost region as created by RELCREATEREGION. CORNERX and CORNERY determine the ghost region's fixed corner, and the cursor starts at the region's diagonally opposite corner. If MINSIZE is true, then WIDTH and HEIGHT are taken as the minimum sizes of the region, except for adjustments that may be needed to ensure that all corners of the ghost region are initially visible on the screen.
@@ -60,10 +50,10 @@ Calls GETREGION with an initial ghost region as created by RELCREATEREGION. COR
Creates a position with X and Y coordinates specified by REFX and REFY references as above.
Constellation regions
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation, the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fits within the provided region.
Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using the remainder as the region for the central window.
Applications are often set up as a constellation of windows, a central or primary window surrounded by some number of satellites for menus, headers, prompts, and secondary outputs. The main panel of a file browser, for example, displays the list of files, but above it are carefully arranged windows for the column headers, summary information, and prompts, and off to the side is the menu of file browser commands. FILEBROWSER interprets the screen region that the user sweeps out for a new browser as the region for the whole constellation,the smallest region that will enclose the central window and all of its satellites. Similarly, the screen region given to TEDIT and SEDIT is divided between the prompt window and the central editing window, again so that the whole constellation (a pair in these cases) fit within the provided region.
Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window.
An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window.
REGIONMANAGER provides an overlay for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment.
(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function]
This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other windows are attached (e.g. expanded menus) by later user actions.
@@ -78,14 +68,14 @@ Establishes a link between the PARENT window and any number of CHILDREN windows
If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before.
(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))))) 1$4È$È4È$È1 $È$1 È$4È$È4È$È4È$È4È$È1È$1ŠŠ8$1ŠŠ8$JÈ$È PAGEHEADING RUNNINGHEADMODERN
CLASSIC
TERMINALMODERN TERMINALÿüTERMINALÿü
(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 1$4È$È4È$È1 $È$1 È$4È$È4È$È4È$È4È$È1È$1ŠŠ8$1ŠŠ8$JÈ$È PAGEHEADING RUNNINGHEADMODERN
rd(DEFAULTFONT 1 (TERMINAL 12) (TERMINAL 8) (TERMINAL 8) (PDF (TERMINAL 8)) (POSTSCRIPT (TERMINAL 8))) TERMINALMODERN TERMINALÿüTERMINALÿü
TIMESROMAN$  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN
DÈ   }/ ¯[ <01>C×<00>T Û Á1 

; 3o)Ä ž     4 n © o2 V@1 %!  A  &MmIS-g<
; 3o)Ä ž     4 n © o2 V@1 %!  A  &MmIS-f<
3E
"

l /4 v2C ƒ &% "O=  , l¬)9š¥Ç W~ æ& 4!Uh'š2&µ$"&( )MDATE:ie½m3\¨zº

l /3
t2C ƒ "O=  , l¬)9¤Ç S~ æ- 4!Uh'š2&µ$"&( )MDATE:fû+˘

View File

@@ -1,73 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Aug-2024 11:31:37" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;13 3078
:CHANGES-TO (FNS START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS IS-KEY-DOWN? KEY-WINDOW)
(VARS TAB-WINDOWSCOMS)
(PROPS (TAB-WINDOWS :COMPILE-FILE))
:PREVIOUS-DATE " 4-Jun-2024 09:48:34" {DSK}<Users>hjellinek>Projects>IL>TAB-WINDOWS.;1)
(PRETTYCOMPRINT TAB-WINDOWSCOMS)
(RPAQQ TAB-WINDOWSCOMS ((FNS IS-KEY-DOWN? START-TAB-WINDOWS TAB-WINDOWS SHOW-KEYS KEY-WINDOW)
(PROP :COMPILE-FILE TAB-WINDOWS)))
(DEFINEQ
(IS-KEY-DOWN?
[LAMBDA (KEY-NAME KEYS-DOWN)
(for KEY-NAME-LIST in KEYS-DOWN thereis (FMEMB KEY-NAME KEY-NAME-LIST])
(START-TAB-WINDOWS
[LAMBDA (META-KEY-NAME)
(ADD.PROCESS (LIST 'TAB-WINDOWS (KWOTE META-KEY-NAME))
'NAME "Window Tabber" 'RESTARTABLE T])
(TAB-WINDOWS
[LAMBDA (META-KEY-NAME)
(* ;; "When the meta and tab keys go down, TOTOPW the next window in OPENWINDOWS")
(DECLARE (CL:SPECIAL \KEYNAMES))
(LET ((CURRENT-WINDOW NIL)
(OPEN-WINDOWS (OPENWINDOWS)))
(CL:UNWIND-PROTECT
[PROGN (while T
do ([LET ((KEYS-DOWN (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
[if (AND (IS-KEY-DOWN? 'TAB KEYS-DOWN)
(IS-KEY-DOWN? META-KEY-NAME KEYS-DOWN))
then (if CURRENT-WINDOW
then (TOTOPW CURRENT-WINDOW)
(SETQ CURRENT-WINDOW (CADR (FMEMB CURRENT-WINDOW
OPEN-WINDOWS)))
else (SETQ CURRENT-WINDOW (CAR OPEN-WINDOWS]
(if (NOT KEYS-DOWN)
then (SETQ CURRENT-WINDOW NIL)
(SETQ OPEN-WINDOWS (OPENWINDOWS]
(BLOCK 20])])
(SHOW-KEYS
[LAMBDA NIL
(DECLARE (CL:SPECIAL \KEYNAMES))
(LET ((WINDOW (CREATEW NIL "Keys down")))
(WINDOWPROP WINDOW 'PROCESS (THIS.PROCESS))
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
(DEL.PROCESS (WINDOWPROP W 'PROCESS]
(CL:UNWIND-PROTECT
[PROGN (while T do (LET ((DOWN-KEYS (for K in \KEYNAMES when (KEYDOWNP K) collect K)))
(BLOCK 100)
(CLEARW WINDOW)
(COND
(DOWN-KEYS (PRIN1 DOWN-KEYS WINDOW]
(CLOSEW WINDOW))])
(KEY-WINDOW
[LAMBDA NIL
(ADD.PROCESS '(SHOW-KEYS)
'NAME "Showing Keys" 'RESTARTABLE T])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (645 3055 (IS-KEY-DOWN? 655 . 791) (START-TAB-WINDOWS 793 . 950) (TAB-WINDOWS 952 . 2219
) (SHOW-KEYS 2221 . 2939) (KEY-WINDOW 2941 . 3053)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,31 +1,32 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Dec-2024 19:26:20" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;133 11059
(FILECREATED "31-Oct-2024 17:27:44" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;124 10208
:EDIT-BY rmk
:PREVIOUS-DATE " 7-Dec-2024 18:00:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;132)
:CHANGES-TO (VARS TEDIT-PF-SEECOMS)
:PREVIOUS-DATE "31-Oct-2024 17:25:56" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;123)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
(RPAQQ TEDIT-PF-SEECOMS
[(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER)
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(PF-TEDIT
[LAMBDA (FN IFILES VERSION REPRINT) (* ; "Edited 6-Dec-2024 19:15 by rmk")
(* ; "Edited 27-Aug-2024 13:03 by rmk")
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Aug-2024 13:03 by rmk")
(* ; "Edited 27-Mar-2024 23:45 by rmk")
(* ; "Edited 25-Dec-2023 12:24 by rmk")
(* ; "Edited 5-Dec-2023 23:50 by rmk")
@@ -49,32 +50,21 @@
((t T NIL)
(SETQ REPRINT T)
(SETQ FN LASTWORD))
(if (VERSIONP FN)
then (SETQ IFILES (CONS FN))
(SETQ FN LASTWORD)
else (SETQ LASTWORD FN)))
(SETQ LASTWORD FN))
(CL:UNLESS FN (ERROR "No function to print"))
(CL:WHEN (AND (VERSIONP IFILES)
(NULL VERSION))
(SETQ VERSION IFILES)
(SETQ IFILES NIL))
(CL:WHEN (INTERSECTION '(T t)
IFILES)
(SETQ REPRINT T)
[SETQ IFILES (LDIFFERENCE IFILES '(t T])
(CL:UNLESS IFILES
(SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
(WHEREIS FN 'FUNCTIONS T))))
(IF IFILES
(IF [OR IFILES (SETQ IFILES (APPEND (WHEREIS FN 'FNS T)
(WHEREIS FN 'FUNCTIONS T]
THEN (* ; "skip compiled files")
(* ;; "Since we are creating readonly Tedits, try to keep the TTY where it is.")
(FOR IFILE LOC TSTREAM ENV EXPR TFPROP WINDOW INSIDE IFILES
EACHTIME (CL:IF (VERSIONP IFILE)
(SETQ IFILE (FINDFILEVERSION (CAR (WHEREIS FN NIL T))
IFILE))) UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
UNLESS (MEMB (FILENAMEFIELD IFILE 'EXTENSION)
*COMPILED-EXTENSIONS*)
DO (SETQ LOC (FINDFNDEF FN IFILE))
(IF (LISTP LOC)
THEN (SETQ TFPROP (LIST FN (CAR LOC)))
@@ -144,8 +134,7 @@
ELSE (PRINTOUT T FN " has no function definition" T])
(PF-TEDIT-FROM-TEXT
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 5-Dec-2024 22:20 by rmk")
(* ; "Edited 26-Aug-2024 23:13 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 26-Aug-2024 23:13 by rmk")
(* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL.")
@@ -160,27 +149,21 @@
(if (EQ 0 (NCHARS FN))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
elseif FILENAME
then [PF-TEDIT FN (CAR (MEMB (FILENAMEFIELD FILENAME)
(WHEREIS FN NIL T]
then (PF-TEDIT FN FILENAME)
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found")
T])
)
(DEFCOMMAND ts (FILE VERSION WINDOW FORMAT) (CL:WHEN (WINDOWP VERSION)
(SETQ WINDOW VERSION)
(SETQ VERSION -1))
(CL:UNLESS VERSION (SETQ VERSION -1))
(TEDIT-SEE (FINDFILEVERSION (OR (FINDFILE-WITH-EXTENSIONS FILE NIL
'(NIL TEDIT TED TXT TEXT TEX))
(ERROR "FILE NOT FOUND" FILE))
VERSION)
(DEFCOMMAND ts (FILE WINDOW FORMAT)
(TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX))
(ERROR "FILE NOT FOUND" FILE))
(OR WINDOW 'SEE)
FORMAT))
(DEFCOMMAND tf (FN FILE VERSION) (PF-TEDIT FN FILE VERSION))
(DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES))
(FILESLOAD (SYSLOAD)
REGIONMANAGER VERSIONDEFS)
REGIONMANAGER)
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
@@ -198,5 +181,5 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (973 10035 (PF-TEDIT 983 . 8821) (PF-TEDIT-FROM-TEXT 8823 . 10033)))))
(FILEMAP (NIL (1243 9524 (PF-TEDIT 1253 . 8506) (PF-TEDIT-FROM-TEXT 8508 . 9522)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,143 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jan-2025 08:49:34" {WMEDLEY}<lispusers>VERSIONDEFS.;12 5880
:EDIT-BY rmk
:CHANGES-TO (FNS GETVINFO)
:PREVIOUS-DATE "12-Dec-2024 15:07:45" {WMEDLEY}<lispusers>VERSIONDEFS.;11)
(PRETTYCOMPRINT VERSIONDEFSCOMS)
(RPAQQ VERSIONDEFSCOMS [(FNS FINDFILEVERSION GETVINFO VERSIONP)
(FNS EDV DFV)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA DFV EDV)
(NLAML)
(LAMA])
(DEFINEQ
(FINDFILEVERSION
[LAMBDA (FILE VERSION DIRLIST NOERROR) (* ; "Edited 6-Dec-2024 22:12 by rmk")
(* ; "Edited 1-Dec-2024 23:01 by rmk")
(* ; "Edited 4-Oct-2024 15:23 by rmk")
(* ;; "Returns the version of FILE in DIRLIST that correspond to the relative version specifier VERSION. Negative version count backwrd from the newest (=-1), positive count forward from the oldest (=1). F, FIRST,OLDEST are equivalent to 1 (= oldest), N NEWEST are equivalent to -1 (newest).")
(LET (FILES)
(SETQ VERSION (VERSIONP VERSION))
(if (EQ VERSION -1)
then (FINDFILE FILE T DIRLIST)
elseif [SETQ FILES (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST]
then (CAR (if (ILESSP VERSION 0)
then
(* ;; "-2 is the second newest version")
(NTH FILES (IMINUS VERSION))
else
(* ;; "2 is the second oldest")
(NTH (DREVERSE FILES)
VERSION)))
elseif (NOT NOERROR)
then (ERROR (CONCAT "Version " VERSION " of " FILE " not found"])
(GETVINFO
[LAMBDA (NAME TYPE FILE VERSION DIRLIST) (* ; "Edited 27-Jan-2025 08:49 by rmk")
(* ; "Edited 6-Dec-2024 21:37 by rmk")
(* ; "Edited 1-Dec-2024 23:50 by rmk")
(* ;; "Gets the TYPE definition of NAME from version VERSION of FILE, returns the definition after storing it under an annotated name that the filepkg doesn't see. ")
(if (VERSIONP TYPE)
then (SETQ VERSION TYPE)
(SETQ TYPE NIL)
elseif (VERSIONP FILE)
then (SETQ VERSION FILE)
(SETQ FILE NIL))
(CL:UNLESS [OR FILE (SETQ FILE (CAR (WHEREIS NAME TYPE T]
(ERROR (CONCAT "File for " NAME " not found")))
(CL:UNLESS VERSION
(SETQ VERSION 'NEWEST))
(LET ((VFILE (FINDFILEVERSION FILE VERSION DIRLIST))
(CONNECTED (DIRECTORYNAME T T))
DEF VNAME HOST DIR) (* ; "Don't include the whole path if it's the connected one. Perhaps we should create/return both a short name and a long name")
(SETQ DEF (GETDEF NAME TYPE VFILE))
(SETQ HOST (FILENAMEFIELD VFILE 'HOST))
(SETQ DIR (FILENAMEFIELD VFILE 'DIRECTORY))
(CL:WHEN (STRING.EQUAL HOST (FILENAMEFIELD CONNECTED 'HOST))
(SETQ HOST NIL))
(CL:WHEN (STRING.EQUAL DIR (FILENAMEFIELD CONNECTED 'DIRECTORY))
(SETQ DIR NIL))
(SETQ VNAME (PACK* (CL:IF HOST
(CONCAT "{" HOST "}")
"")
(CL:IF DIR
(CONCAT "<" (L-CASE DIR)
">")
"")
NAME ";" (FILENAMEFIELD VFILE 'VERSION)
(SELECTQ VERSION
(1 " (F)")
(-1 " (N)")
"")))
(LIST VNAME TYPE DEF])
(VERSIONP
[LAMBDA (X) (* ; "Edited 6-Dec-2024 20:26 by rmk")
(* ;; "Normalize X if X is a version designator, otherwise NIL")
(SELECTQ X
((F FIRST OLDEST)
1)
((N NEWEST 0)
-1)
(FIXP X])
)
(DEFINEQ
(EDV
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:30 by rmk")
(* ; "Edited 2-Dec-2024 00:14 by rmk")
(SETQ ARGS (MKLIST ARGS))
(PROG ((NAME (POP ARGS))
(TYPE (POP ARGS))
(FILE (POP ARGS))
(VERSION (POP ARGS))
(DIRLIST (POP ARGS))
VINFO)
(SETQ VINFO (GETVINFO NAME TYPE FILE VERSION DIRLIST))
(EDITE (CADDR VINFO)
NIL
(CAR VINFO)
(CADR VINFO)
NIL
'(:DONTWAIT))
(CAR VINFO])
(DFV
[NLAMBDA ARGS (* ; "Edited 6-Dec-2024 21:29 by rmk")
(* ; "Edited 2-Dec-2024 00:08 by rmk")
(SETQ ARGS (MKLIST ARGS))
(APPLY (FUNCTION EDV)
(LIST (POP ARGS)
NIL
(POP ARGS)
(POP ARGS)
(POP ARGS])
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA DFV EDV)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (671 4570 (FINDFILEVERSION 681 . 2128) (GETVINFO 2130 . 4253) (VERSIONP 4255 . 4568)) (
4571 5717 (EDV 4581 . 5281) (DFV 5283 . 5715)))))
STOP

Binary file not shown.

Binary file not shown.

View File

@@ -1,28 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Jan-2025 15:47:23" {WMEDLEY}<lispusers>WHICHKEY.;3 1037
:EDIT-BY rmk
:CHANGES-TO (FNS WHICHKEY)
:PREVIOUS-DATE "23-Jan-2025 15:46:57" {WMEDLEY}<lispusers>WHICHKEY.;2)
(PRETTYCOMPRINT WHICHKEYCOMS)
(RPAQQ WHICHKEYCOMS ((FNS DOWNP WHICHKEY)))
(DEFINEQ
(DOWNP
[LAMBDA (KEYNAME) (* ; "Edited 19-May-2018 20:03 by rmk:")
(PROGN (DISMISS 2000)
(KEYDOWNP KEYNAME])
(WHICHKEY
[LAMBDA (DELAY) (* ; "Edited 23-Jan-2025 15:44 by rmk")
(* ; "Edited 4-Dec-2023 16:04 by rmk")
(* ; "Edited 18-May-2018 13:09 by rmk:")
(PROGN (DISMISS (OR DELAY 3000))
(for X IN \KEYNAMES when (KEYDOWNP (CAR X)) collect X])
)

View File

@@ -1,290 +1,441 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Aug-86 11:35:58" {DANTE}<NEWMAN>LISP>DOCUMENT.;8 16000
(FILECREATED " 1-Feb-2025 08:25:02" {WMEDLEY}<lispusers>document.;27 16813
changes to: (FNS Document.Title Document.Format Document.Create
Document.Begin Document.FileComments
Document.Functions Document.Variables
Document.Things Document.Information
Document.SectionHead
Document.FunctionCommentedP Document.Finish
Document.RunningHead)
(VARS DOCUMENTCOMS)
:EDIT-BY rmk
:CHANGES-TO (FNS Document.FileComments Document.Functions Document.Variables Document.Things
Document.Create Document.Information Document.Format Document.Begin
Document.Title Document.RunningHead Document.SectionHead
Document.FunctionCommentedP)
:PREVIOUS-DATE "30-Jan-2025 11:55:23" {WMEDLEY}<lispusers>document.;19)
previous date: "26-Aug-86 18:18:51" {DSK}<LISPFILES>DOCUMENT.;1
)
(PRETTYCOMPRINT DOCUMENTCOMS)
(RPAQQ DOCUMENTCOMS (
(* ;;; "This program creates documentation for any Lisp package in the style of the Lisp Users documentation. It requires that the code for the package be loaded. It does not completely format the document, but it minimizes the amount of work that the documenter must do. To make most effective use of these functions, each function in the package being documented must have a comment as the first expression in the function after the timestamp. Similarly, the COMS variable of the file should contain a comment (like this one) as the first item in the list. This package was documented using itself.")
(FNS Document.Create Document.Begin Document.FileComments Document.Functions
Document.Variables Document.Things Document.RunningHead Document.Title
Document.Information Document.SectionHead Document.Format
Document.FunctionCommentedP Document.Insert.Comment)))
(* ;;;
"This program creates documentation for any Lisp package in the style of the Lisp Users documentation. It requires that the code for the package be loaded. It does not completely format the document, but it minimizes the amount of work that the documenter must do. To make most effective use of these functions, each function in the package being documented must have a comment as the first expression in the function after the timestamp. Similarly, the COMS variable of the file should contain a comment (like this one) as the first item in the list. This package was documented using itself."
)
(RPAQQ DOCUMENTCOMS ((* * This program creates documentation for any
Lisp package in the style of the Lisp Users
documentation. It requires that the code for
the package be loaded. It does not completely
format the document, but it minimizes the
amount of work that the documenter must do.
To make most effective use of these
functions, each function in the package being
documented must have a comment as the first
expression in the function after the
timestamp. Similarly, the COMS variable of
the file should contain a comment
(like this one)
as the first item in the list. This package
was documented using itself.)
(FNS Document.Create Document.Begin Document.FileComments
Document.Functions Document.Variables Document.Things
Document.Finish Document.RunningHead Document.Title
Document.Information Document.SectionHead Document.Format
Document.FunctionCommentedP)))
(* * This program creates documentation for any Lisp package in the style of the Lisp Users
documentation. It requires that the code for the package be loaded. It does not completely
format the document, but it minimizes the amount of work that the documenter must do. To make
most effective use of these functions, each function in the package being documented must have
a comment as the first expression in the function after the timestamp. Similarly, the COMS
variable of the file should contain a comment (like this one) as the first item in the list.
This package was documented using itself.)
(DEFINEQ
(Document.Create
[LAMBDA (FileName) (* ; "Edited 31-Jan-2025 15:06 by rmk")
(* ; "Edited 10-Jan-2025 11:19 by rmk")
(* Newman "29-Aug-86 10:07")
[LAMBDA (FileName) (* Newman "29-Aug-86 10:07")
(* ;;; "This function builds a document for a loaded file. The document is in the style of the Lisp Library package documentation. The function collects comments from the COMS variable of the file and from the functions in the file. It also collects some information from the Interlisp-D file package. This is the top-level function in the DOCUMENT package.")
(* * This function builds a document for a loaded file. The document is in the style of the Lisp Library package 
documentation. The function collects comments from the COMS variable of the file and from the functions in the 
file. It also collects some information from the Interlisp-D file package. This is the top-level function in the 
ODCUMENT package.)
(if (MEMBER FileName FILELST)
then (RESETLST
[LET ([Stream (OPENTEXTSTREAM NIL NIL '(HISTORY OFF FONT (MODERN 10 MRR]
Pointer)
(SETQ Pointer (Document.Begin FileName Stream))
(Document.FileComments FileName Stream)
(Document.Functions FileName Stream)
(Document.Variables FileName Stream)
(Document.Things FileName Stream 'MACROS 'Macro)
(Document.Things FileName Stream 'RECORDS 'Record)
(Document.Format Stream Pointer)
(TEDIT.SETSEL Stream 1 0 'LEFT)
(TEXTSTREAM (TEDIT Stream NIL NIL '(HISTORY ON])
else (ERROR FileName " not a loaded file."])
(if (MEMBER FileName FILELST)
then (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(LET ((Stream (OPENTEXTSTREAM))
Pointer)
(Document.Begin FileName Stream)
(SETQ Pointer (ADD1 (GETEOFPTR
Stream)))
(Document.FileComments FileName
Stream)
(Document.Functions FileName Stream)
(Document.Variables FileName Stream)
(Document.Things FileName Stream
(QUOTE MACROS)
(QUOTE Macro))
(Document.Things FileName Stream
(QUOTE RECORDS)
(QUOTE Record))
(Document.Finish Stream Pointer)))
else (ERROR FileName " not a loaded file."])
(Document.Begin
[LAMBDA (FileName Stream) (* ; "Edited 31-Jan-2025 14:56 by rmk")
(* Newman "29-Aug-86 10:23")
[LAMBDA (FileName Stream) (* Newman "29-Aug-86 10:23")
(* * This function initializes the begining of the document stream.)
(* ;; "This function initializes the begining of the document stream.")
(Document.RunningHead FileName Stream)
(Document.Title FileName Stream (ADD1 (GETEOFPTR Stream)))
(Document.Information FileName Stream (ADD1 (GETEOFPTR Stream])
(Document.Title FileName Stream (ADD1 (GETEOFPTR Stream)))
(Document.Information FileName Stream (ADD1 (GETEOFPTR Stream]
)
(Document.FileComments
[LAMBDA (FileName Stream) (* ; "Edited 1-Feb-2025 08:24 by rmk")
(* ; "Edited 8-Jan-2025 23:49 by rmk")
(* Newman "29-Aug-86 10:17")
[LAMBDA (FileName Stream) (* Newman "29-Aug-86 10:17")
(* * This function places all comments found in the COMS variable of FileName into Stream. It is intended for use 
in documenting a Lisp code file. Ideally, these commends would be distributed through the documentation as they are
distributed through the COMS variable.)
(* ;; "This function places all comments found in the COMS variable of FileName into Stream. It is intended for use in documenting a Lisp code file. Ideally, these commends would be distributed through the documentation as they are distributed through the COMS variable.")
(Document.SectionHead Stream "INTRODUCTION")
(for Comment in (FILECOMSLST FileName '*) do (Document.Insert.Comment Stream Comment])
(PROMPTPRINT "Collecting File Comments ...")
(for Descriptor in (FILECOMSLST FileName (QUOTE *))
do (printout Stream .PPFTL (REMOVE (QUOTE *)
Descriptor)
T])
(Document.Functions
[LAMBDA (FileName Stream) (* ; "Edited 1-Feb-2025 08:24 by rmk")
(* ; "Edited 8-Jan-2025 14:16 by rmk")
(* ; "Edited 6-Jan-2025 12:15 by rmk")
(* Newman "29-Aug-86 10:25")
[LAMBDA (FileName Stream) (* Newman "29-Aug-86 10:25")
(* * This function documents the Functions on FileName into Stream. It does this by obtaining the function names 
from the file package, using the ARGLIST function to obtain the argument list, and obtainin the initial comment in 
the function if it exists.)
(* ;;; "This function documents the Functions on FileName into Stream. It does this by obtaining the function names from the file package, using the ARGLIST function to obtain the argument list, and obtainin the initial comment in the function if it exists.")
(Document.SectionHead Stream "FUNCTIONS")
(for Function in (FILEFNSLST FileName) do (PRINTOUT Stream .FONT '(MODERN 10 MRR)
"(" Function " " .FONT '(MODERN 10 ITALIC)
(SUBSTRING (MKSTRING (SMARTARGLIST Function T))
2 -2)
.FONT
'(MODERN 10 MRR)
")"
(CHARACTER 9)
"[Function]" T)
(Document.Insert.Comment Stream (
 Document.FunctionCommentedP
Function])
(PROMPTPRINT "Collecting Function Comments ... ")
(for Function in (FILEFNSLST FileName)
do (TEDIT.INSERT Stream (CONCAT "(" Function " ")
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
10
(QUOTE MRR)))
(TEDIT.INSERT Stream (SUBSTRING (MKSTRING
(ARGLIST Function))
2 -2)
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
10
(QUOTE ITALIC)))
(TEDIT.INSERT Stream (CONCAT ") [Function]"
(CHARACTER 13))
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
10
(QUOTE MRR)))
(* * This SETFILEPTR is here because someone leaves the FILEPTR in the wrong place.)
(SETFILEPTR Stream (GETEOFPTR Stream))
(if (Document.FunctionCommentedP Function)
then (printout
Stream .PPVTL
[REMOVE (QUOTE *)
(CADDDR
(OR (GETPROP Function
(QUOTE EXPR))
(GETD Function]
T])
(Document.Variables
[LAMBDA (FileName Stream) (* ; "Edited 1-Feb-2025 08:24 by rmk")
(* ; "Edited 9-Jan-2025 11:49 by rmk")
(* Newman "29-Aug-86 10:28")
[LAMBDA (FileName Stream) (* Newman "29-Aug-86 10:28")
(* This function is intended for use while documenting Lisp code. It collects a list of the variables from 
FileName, and places them in Stream in the format of the Lisp Library Documentation.)
(* ;; "This function is intended for use while documenting Lisp code. It collects a list of the variables from FileName, and places them in Stream in the format of the Lisp Library Documentation.")
(Document.SectionHead Stream "VARIABLES")
(DSPFONT '(MODERN 10 MRR)
Stream)
(for Variable in (FILECOMSLST FileName 'VARS)
do (PRINTOUT Stream Variable " " (CHARACTER 9)
"["
(if (MEMB Variable (FILECOMSLST FileName 'GLOBALVARS))
then "GlobalVar"
elseif (MEMB Variable (FILECOMSLST FileName 'SPECVARS))
then "SpecialVar"
else "Variable")
"]" T])
(PROMPTPRINT "Collecting Variables ...")
(for Variable in (FILECOMSLST FileName (QUOTE VARS))
do (if (MEMBER Variable (FILECOMSLST FileName
(QUOTE GLOBALVARS)
))
then (printout Stream Variable , " [GlobalVar]" T)
elseif (MEMBER Variable (FILECOMSLST FileName
(QUOTE
SPECVARS)))
then (printout Stream Variable , " [SpecialVar]" T)
else (printout Stream Variable , " [Variable]" T])
(Document.Things
[LAMBDA (FileName Stream FilePkgType TypeName) (* ; "Edited 1-Feb-2025 08:24 by rmk")
(* ; "Edited 9-Jan-2025 11:50 by rmk")
(* Newman "29-Aug-86 10:32")
[LAMBDA (FileName Stream FilePkgType TypeName)
(* Newman "29-Aug-86 10:32")
(* ;; "This function is intended for use while documenting Lisp code. It collects a list of items of type TypeName, that are written using the FilePkgType file package command, from FileName, and places them in Stream in the format of the Lisp Library Documentation.")
(* This function is intended for use while documenting Lisp code. It collects a list of items of type TypeName, 
that are written using the FilePkgType file package command, from FileName, and places them in Stream in the format
of the Lisp Library Documentation.)
(if (AND FilePkgType (MEMBER FilePkgType FILEPKGTYPES))
then (if (FILECOMSLST FileName FilePkgType)
then (CL:UNLESS TypeName (SETQ TypeName FilePkgType))
(Document.SectionHead Stream (CONCAT (U-CASE TypeName)
"S"))
(DSPFONT '(MODERN 10 MRR)
Stream)
(for Thing in (FILECOMSLST FileName FilePkgType)
do (PRINTOUT Stream Thing " " (CHARACTER 9)
"[" TypeName "]" T)))
else (ERROR FilePkgType "Bad file package type: "])
(if (AND FilePkgType (MEMBER FilePkgType FILEPKGTYPES))
then (if (FILECOMSLST FileName FilePkgType)
then (Document.SectionHead
Stream
(CONCAT (U-CASE (SETQ TypeName
(OR TypeName
FilePkgType)))
"S"))
(PROMPTPRINT (CONCAT "Collecting "
TypeName " ..."))
(for Thing in (FILECOMSLST FileName
FilePkgType)
do (printout Stream Thing ,
(CONCAT (CHARACTER
9)
"[" TypeName "]")
T)))
else (ERROR FilePkgType "Bad file package type: "])
(Document.Finish
[LAMBDA (Stream Pointer) (* Newman "28-Aug-86 15:22")
(* * This function performs formatting and the like to make the document pretty, and to make the format correct as 
specified.)
(* * Set the selection to cover the non-header portions of the file.)
(TEDIT.SETSEL Stream Pointer (DIFFERENCE (GETEOFPTR Stream)
Pointer)
(QUOTE LEFT))
(* * Eliminate extra spaces)
(bind (Num _ 1) repeatuntil (ZEROP Num)
do (SETQ Num (TEDIT.SUBSTITUTE Stream " " " ")))
(* * Eliminate carriage returns that I think are introduced by printout)
(TEDIT.SUBSTITUTE Stream (CONCAT (CHARACTER 13)
" ")
" ")
(* * For some reason, the paragraph breaks don't work unless this line is here.)
(TEDIT.SUBSTITUTE Stream (MKSTRING (CHARACTER 13))
(MKSTRING (CHARACTER 13)))
(* * Set the page, paragraph, and character looks of the non-header portions of the document.)
(Document.Format Stream)
(* * TEdit the stream so the user can finish the job by hand.)
(TEDIT Stream])
(Document.RunningHead
[LAMBDA (FileName Stream) (* ; "Edited 31-Jan-2025 10:41 by rmk")
(* ; "Edited 9-Jan-2025 16:58 by rmk")
(* Newman "28-Aug-86 15:57")
[LAMBDA (FileName Stream) (* Newman "28-Aug-86 15:57")
(* ;; "This function creates the running header for the document.")
(* * This function creates the running header for the document.)
(PRINTOUT Stream .FONT '(TIMESROMAN 36 BOLD)
"Medley " .FONT '(MODERN 10)
(CHARACTER 9)
FileName T T)
(TEDIT.INSERT.OBJECT (HRULE.CREATE '2)
Stream
(GETEOFPTR Stream))
(TEDIT.PARALOOKS Stream '(TYPE PAGEHEADING SUBTYPE RUNNINGHEAD RIGHTMARGIN 456 LEFTMARGIN 0 TABS
(NIL (456 . RIGHT))
QUAD JUSTIFIED)
0
(TEDIT.NCHARS Stream])
(TEDIT.INSERT Stream "XEROX" 0 (FONTCREATE (QUOTE LOGO)
24))
(TEDIT.INSERT Stream (CONCAT " " (CHARACTER 9)
FileName
(CHARACTER 13)
(CHARACTER 13))
NIL
(FONTCREATE (QUOTE MODERN)
10))
(TEDIT.INSERT.OBJECT (HRULE.CREATE (QUOTE 2))
Stream
(GETEOFPTR Stream))
(TEDIT.PARALOOKS (TEXTOBJ Stream)
(QUOTE (TYPE PAGEHEADING SUBTYPE RUNNINGHEAD
RIGHTMARGIN 456 LEFTMARGIN 0 TABS
(NIL (456 . RIGHT))
QUAD JUSTIFIED))
0
(ADD1 (GETEOFPTR Stream)))
(* * we set the file ptr to be kind to others, as TEDIT.PARALOOKS moves it from the end of the file.)
(SETFILEPTR Stream (GETFILEPTR Stream])
(Document.Title
[LAMBDA (FileName Stream Pointer) (* ; "Edited 31-Jan-2025 14:44 by rmk")
(* Newman "29-Aug-86 11:35")
[LAMBDA (FileName Stream Pointer) (* Newman "29-Aug-86 11:35")
(* ;;; "This function creates the title area of the document consisting of the name of the package being documented in between two lines.")
(* * This function creates the title area of the document consisting of the name of the package being documented in
between two lines.)
(TERPRI Stream)
(* ;; "This TERPRI is here because otherwise the first HRULE in the title becomes a part of the running header. This happens for no apparent reason, and is a mystery to me.")
(TERPRI Stream)
(TEDIT.INSERT.OBJECT (HRULE.CREATE '(5 4 1))
Stream
(ADD1 (TEDIT.NCHARS Stream)))
(SETFILEPTR Stream -1)
(PRINTOUT Stream .FONT '(MODERN 12 BRR)
T FileName T T)
(TEDIT.INSERT.OBJECT (HRULE.CREATE '(1 4 5))
Stream
(GETEOFPTR Stream))
(TEDIT.PARALOOKS Stream
'(TYPE NIL PARALEADING 6 LINELEADING 4 RIGHTMARGIN 312 LEFTMARGIN 138 1STLEFTMARGIN 138
QUAD CENTERED)
Pointer
(TEDIT.NCHARS Stream])
(* This TERPRI is here because otherwise the first HRULE in the title becomes a part of the running header.
This happens for no apparent reason, and is a mystery to me.)
(TEDIT.INSERT.OBJECT (HRULE.CREATE (QUOTE (5 4 1)))
Stream
(ADD1 (GETEOFPTR Stream)))
(TEDIT.INSERT Stream (CONCAT (CHARACTER 13)
FileName
(CHARACTER 13)
(CHARACTER 13))
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
12
(QUOTE BRR)))
(TEDIT.INSERT.OBJECT (HRULE.CREATE (QUOTE (1 4 5)))
Stream
(GETEOFPTR Stream))
(TEDIT.PARALOOKS (TEXTOBJ Stream)
(QUOTE (TYPE NIL PARALEADING 6 LINELEADING 4
RIGHTMARGIN 312 LEFTMARGIN 138
1STLEFTMARGIN 138 QUAD CENTERED))
Pointer
(DIFFERENCE (ADD1 (GETEOFPTR Stream))
Pointer))
(* * This call to SETFILEPTR is here because I believe TEDIT.PARALOOKS does not leave the file pointer at the end 
of the stream as the printout function requires. I believe that if I eliminate all calls to printout, I can 
eliminate all calls to SETFILEPTR. I also believe that PRINTOUT can always be replaced by TEDIT.INSERT.)
(SETFILEPTR Stream (GETEOFPTR Stream])
(Document.Information
[LAMBDA (FileName Stream) (* ; "Edited 31-Jan-2025 15:10 by rmk")
(* Newman "29-Aug-86 10:37")
[LAMBDA (FileName Stream Pointer) (* Newman "29-Aug-86 10:37")
(* ;;; "This function creates the information at the top of the document, including the form for the author's name and a list of other packages necessary to run this package.")
(* * This function creates the information at the top of the document, including the form for the author's name and
a list of other packages necessary to run this package.)
(LET [(Pointer (ADD1 (TEDIT.NCHARS Stream]
(PRINTOUT Stream .FONT '(MODERN 10)
" By: >>Author's Name<< (>>Net Address<<)" T "Documentation created "
(DATE (DATEFORMAT NO.TIME YEAR.LONG SPACES NO.LEADING.SPACES))
T)
(* ;; "LEN of TEDIT.NCHARS is certainly long enough")
(TEDIT.INSERT Stream (CONCAT
" By: >>Author's Name<< (>>Net Address<<)"
(CHARACTER 13)
" "
(SUBSTRING (DATE)
1 9)
(CHARACTER 13))
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
10)
T)
(if (FILECOMSLST FileName (QUOTE FILES))
then (TEDIT.INSERT
Stream
(CONCAT "The following packages are loaded by "
FileName ": "
(SUBSTRING (MKSTRING
(FILECOMSLST FileName
(QUOTE
FILES)))
2 -2)
(CHARACTER 13)
" ")
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
10)
T))
(TEDIT.PARALOOKS (TEXTOBJ Stream)
(QUOTE (RIGHTMARGIN 456 LEFTMARGIN 0
1STLEFTMARGIN 0 QUAD
CENTERED PARALEADING 17))
Pointer
(ADD1 (GETEOFPTR Stream)))
(TEDIT.PARALOOKS Stream '(RIGHTMARGIN 456 LEFTMARGIN 0 1STLEFTMARGIN 0 QUAD CENTERED
PARALEADING 17)
Pointer
(TEDIT.NCHARS Stream))
(SETQ Pointer (ADD1 (TEDIT.NCHARS Stream)))
(CL:WHEN (FILECOMSLST FileName 'FILES)
(PRINTOUT Stream "The following files are loaded by " FileName ": "
(SUBSTRING (MKSTRING (FILECOMSLST FileName 'FILES))
2 -2)
T)
(TEDIT.PARALOOKS Stream '(QUAD LEFT PARALEADING 12)
Pointer
(TEDIT.NCHARS Stream)))
(ADD1 (TEDIT.NCHARS Stream])
(* The following SETFILEPTR exists because TEDIT.PARALOOKS does not leave the file pointer at the end of the file.)
(SETFILEPTR Stream (GETEOFPTR Stream])
(Document.SectionHead
[LAMBDA (Stream String) (* ; "Edited 31-Jan-2025 10:52 by rmk")
(* Newman "29-Aug-86 10:39")
[LAMBDA (Stream String) (* Newman "29-Aug-86 10:39")
(* ;;; "This function is intended to create the bold section headings in Stream that are needed for the Lisp Users document style.")
(* * This function is intended to create the bold section headings in Stream that are needed for the Lisp Users 
document style.)
(PRINTOUT Stream .FONT '(MODERN 10 BRR)
String T .FONT '(MODERN 10])
(TEDIT.INSERT Stream (CONCAT String (CHARACTER 13))
(ADD1 (GETEOFPTR Stream))
(FONTCREATE (QUOTE MODERN)
10
(QUOTE BRR)))
(SETFILEPTR Stream (GETEOFPTR Stream))
(* * The following TEDIT.CARETLOOKS prevents the bolding from continuing past the section heading in some cases.)
(TEDIT.CARETLOOKS Stream (FONTCREATE (QUOTE MODERN)
10
(QUOTE MRR])
(Document.Format
[LAMBDA (Stream Pointer) (* ; "Edited 31-Jan-2025 12:24 by rmk")
(* Newman "29-Aug-86 10:54")
[LAMBDA (Stream) (* Newman "29-Aug-86 10:54")
(* ;;; "This function formats the document. It sets the page layout, font looks, and paragraph formatting for the non-heading part of the stream.")
(* * This function formats the document. It sets the page layout, font looks, and paragraph formatting for all 
selected text.)
(TEDIT.PARALOOKS Stream '(TABS (NIL (0 . RIGHT)
(456 . RIGHT))
LINELEADING 4 PARALEADING 11 RIGHTMARGIN 456 LEFTMARGIN 0
1STLEFTMARGIN 0 QUAD JUSTIFIED)
(ADD1 Pointer)
(SUB1 (DIFFERENCE (TEDIT.NCHARS Stream)
Pointer)))
(TEDIT.PAGEFORMAT Stream (TEDIT.COMPOUND.PAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT
T 26.5 3.0 '(MODERN 10)
'CENTERED 7.0 6.0 8.0 8.0 1 38.0 0
'((RUNNINGHEAD 7.0 62.0))
'PICAS
'(STARTINGPAGE# 1)
'LETTER)
(TEDIT.SINGLE.PAGEFORMAT T 26.5 3.5 '(MODERN 10)
'CENTERED 7.0 6.0 8.0 8.0 1 38.0 0
'((RUNNINGHEAD 7.0 62.0))
'PICAS
'(STARTINGPAGE# 1)
'LETTER)
(TEDIT.SINGLE.PAGEFORMAT T 26.5 3.0 '(MODERN 10)
'CENTERED 7.0 6.0 8.0 8.0 1 38.0 0
'((RUNNINGHEAD 7.0 62.0))
'PICAS
'(STARTINGPAGE# 1)
'LETTER])
(TEDIT.SUBLOOKS Stream (QUOTE (FAMILY GACHA))
(QUOTE (FAMILY MODERN SIZE 10)))
(TEDIT.PARALOOKS (TEXTOBJ Stream)
(QUOTE (TABS (NIL (0 . RIGHT)
(456 . RIGHT))
LINELEADING 4 PARALEADING 11
RIGHTMARGIN 456 LEFTMARGIN 0
1STLEFTMARGIN 0 QUAD JUSTIFIED))
(TEDIT.GETSEL Stream))
(TEDIT.PAGEFORMAT Stream (TEDIT.COMPOUND.PAGEFORMAT
(TEDIT.SINGLE.PAGEFORMAT
T 26.5 3.0 (QUOTE (MODERN 10))
(QUOTE CENTERED)
7.0 6.0 8.0 8.0 1 38.0 0
(QUOTE ((RUNNINGHEAD 7.0 62.0)))
(QUOTE PICAS)
(QUOTE (STARTINGPAGE# 1))
(QUOTE LETTER))
(TEDIT.SINGLE.PAGEFORMAT
T 26.5 3.5 (QUOTE (MODERN 10))
(QUOTE CENTERED)
7.0 6.0 8.0 8.0 1 38.0 0
(QUOTE ((RUNNINGHEAD 7.0 62.0)))
(QUOTE PICAS)
(QUOTE (STARTINGPAGE# 1))
(QUOTE LETTER))
(TEDIT.SINGLE.PAGEFORMAT
T 26.5 3.0 (QUOTE (MODERN 10))
(QUOTE CENTERED)
7.0 6.0 8.0 8.0 1 38.0 0
(QUOTE ((RUNNINGHEAD 7.0 62.0)))
(QUOTE PICAS)
(QUOTE (STARTINGPAGE# 1))
(QUOTE LETTER])
(Document.FunctionCommentedP
[LAMBDA (Function) (* ; "Edited 31-Jan-2025 11:08 by rmk")
(* ; "Edited 8-Jan-2025 21:06 by rmk")
(* Newman "29-Aug-86 10:42")
[LAMBDA (Function) (* Newman "29-Aug-86 10:42")
(* ;; "Finds first comment in a function, skipping old and new format dates.")
(* * This function is intended to tell if a function has an initial comment or not.)
(for X in [CDDR (GETDEF Function NIL NIL '(NOERROR]
unless [OR (EDITDATE? X)
(AND (EQ '* (CAR X))
(IDATE (CADDR X] do (RETURN (CL:IF (EQ '* (CAR X))
X])
(Document.Insert.Comment
[LAMBDA (Stream Comment) (* ; "Edited 9-Jan-2025 16:56 by rmk")
(CL:WHEN (EQ '* (CAR (LISTP Comment)))
(DSPFONT '(MODERN 10 MRR)
Stream)
[if (AND (MEMB (CADR Comment)
'(; ;; ;;;))
(STRINGP (CADDR Comment)))
then (PRIN3 (CADDR Comment)
Stream)
else [SETQ Comment (find TAIL on Comment suchthat (NEQ (CAR TAIL)
'*]
(for TAIL on Comment do (PRIN3 (CAR TAIL)
Stream)
(CL:WHEN (CDR TAIL)
(PRIN3 " " Stream]
(TERPRI Stream))])
(EQUAL (QUOTE *)
(CAR (CADDDR (OR (GETPROP Function (QUOTE EXPR))
(GETD Function)
(ERROR Function
"Not a function: "])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2235 16790 (Document.Create 2245 . 3791) (Document.Begin 3793 . 4283) (
Document.FileComments 4285 . 5068) (Document.Functions 5070 . 6798) (Document.Variables 6800 . 7885) (
Document.Things 7887 . 9199) (Document.RunningHead 9201 . 10101) (Document.Title 10103 . 11195) (
Document.Information 11197 . 12653) (Document.SectionHead 12655 . 13106) (Document.Format 13108 .
15202) (Document.FunctionCommentedP 15204 . 15916) (Document.Insert.Comment 15918 . 16788)))))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2105 15978 (Document.Create 2115 . 3381) (Document.Begin
3383 . 3767) (Document.FileComments 3769 . 4450) (Document.Functions
4452 . 6022) (Document.Variables 6024 . 6914) (Document.Things 6916 .
8000) (Document.Finish 8002 . 9249) (Document.RunningHead 9251 . 10257)
(Document.Title 10259 . 11911) (Document.Information 11913 . 13348) (
Document.SectionHead 13350 . 14077) (Document.Format 14079 . 15572) (
Document.FunctionCommentedP 15574 . 15976)))))
STOP

View File

@@ -1,9 +0,0 @@
#/bin/sh
# $1 is a versioned file name
ver="$1"
base="${ver%%.~[1-9]*~}"
if [ ! -f "$base" ]; then
echo "Orphaned version: $ver but no $base"
fi

View File

@@ -1,15 +0,0 @@
#!/bin/sh
# install checks for repository, meant to run post-checkout
# For now, this just checks for orphaned versions.
rm -f .git/hooks/post-checkout
cp scripts/post-checkout .git/hooks/post-checkout &&
chmod +x .git/hooks/post-checkout &&
echo copy made: &&
ls -l .git/hooks/post-checkout &&
exit 0
exit 1

135
scripts/loadup-app-setup.sh Normal file
View File

@@ -0,0 +1,135 @@
#!to_be_sourced_only
# shellcheck shell=sh
MEDLEY_SCRIPTDIR="$(cd "${MEDLEYDIR}/scripts" && pwd)"
if [ -z "${APP_DIR}" ]
then
export APP_DIR="$(cd "${LOADUP_SCRIPTDIR}/../" && pwd)"
fi
if [ ! -d "${APP_DIR}" ]
then
echo "Error: Cannot find the ${APP_NAME} directory: ${APP_DIR}"
exit 1
fi
if [ -z "${APP_LOADUPSDIR}" ]
then
export APP_LOADUPSDIR="${APP_DIR}/loadups"
fi
if [ ! -d "${APP_LOADUPSDIR}" ]
then
if [ -e "${APP_LOADUPSDIR}" ]
then
echo "Error: the ${APP_NAME} loadups dir (${APP_LOADUPSDIR}) exists, but it is not a directory."
echo "Exiting."
exit 1
else
mkdir -p "${APP_LOADUPSDIR}"
fi
fi
if [ -z "${APP_WORKDIR}" ]
then
export APP_WORKDIR="${APP_LOADUPSDIR}/build"
fi
if [ ! -d "${APP_WORKDIR}" ]
then
if [ -e "${APP_WORKDIR}" ]
then
echo "Error: the ${APP_NAME} loadups work dir (${APP_WORKDIR}) exists, but it is not a directory."
echo "Exiting."
exit 1
else
mkdir -p "${APP_WORKDIR}"
fi
fi
HAS_GIT= [ -f $(which git) ] && [ -x $(which git) ]
export HAS_GIT
git_commit_ID () {
if ${HAS_GIT};
then
# This does NOT indicate if there are any modified files!
COMMIT_ID=$(git -C "$1" rev-parse --short HEAD 2>/dev/null)
fi
}
git_commit_ID "${MEDLEYDIR}"
MEDLEY_COMMIT_ID="${COMMIT_ID}"
export MEDLEY_COMMIT_ID
git_commit_ID "${APP_DIR}"
APP_COMMIT_ID="${COMMIT_ID}"
export APP_COMMIT_ID
scr="-sc 1024x768 -g 1042x790"
geometry=1024x768
touch "${APP_WORKDIR}"/loadup.timestamp
script_name=$(basename "$0" ".sh")
cmfile="${APP_WORKDIR}/${script_name}.cm"
######################################################################
loadup_start () {
echo ">>>>> START ${script_name}"
}
loadup_finish () {
rm -f "${cmfile}"
# 2024-05-05 FGH
# Can't use exit code for now since on MacOS exit codes appear to be inverted
# Will restore once MacOS exit code are figured out
# if [ "${exit_code}" -ne 0 ] || [ ! -f "${LOADUP_WORKDIR}/$1" ]
if [ "${APP_WORKDIR}/$1" -nt "${APP_WORKDIR}"/loadup.timestamp ]
then
echo
echo "..... files copied into loadups ....."
for f in "$@"
do
# shellcheck disable=SC2045,SC2086
for ff in $(ls -1 "${APP_WORKDIR}"/$f);
do
/bin/sh "${MEDLEY_SCRIPTDIR}/cpv" "${ff}" "${APP_LOADUPSDIR}" \
| sed -e "s#${APP_DIR}/##g"
done
done
echo "....................................."
echo
echo "+++++ SUCCESS +++++"
exit_code=0
else
echo "----- FAILURE -----"
exit_code=1
fi
echo "<<<<< END ${script_name}"
echo ""
exit ${exit_code}
}
run_medley () {
/bin/sh "${MEDLEYDIR}/scripts/medley/medley.command" \
--config - \
--id loadup_+ \
--geometry "${geometry}" \
--noscroll \
--logindir "${APP_WORKDIR}" \
--greet "${cmfile}" \
--sysout "$1" \
"$2" "$3" "$4" "$5" "$6" "$7" ;
exit_code=$?
}
######################################################################

190
scripts/loadup-lfg.sh Executable file
View File

@@ -0,0 +1,190 @@
#!/bin/sh
main() {
export APP_DIR="${LFG_DIR}"
export APP_LOADUPSDIR="${LFG_LOADUPSDIR}"
export APP_WORKDIR="${LFG_WORKDIR}"
get_medleydir "$@"
loadup_start
cat >"${cmfile}" <<-"EOF"
"
(PROGN
(IL:MEDLEY-INIT-VARS 'IL:GREET)
(IL:DRIBBLE (IL:PACKFILENAME 'HOST '{DSK} 'DIRECTORY (IL:UNIX-GETENV 'APP_WORKDIR) 'NAME 'lfg.dribble))
(IL:DOFILESLOAD
'((SYSLOAD)
(FROM VALUEOF (IL:PACKFILENAME 'HOST '{DSK} 'DIRECTORY (IL:UNIX-GETENV 'APP_DIR)))
LFG-LOADUP
)
)
(IL:LOADUP-LFG)
(IL:PUTASSOC 'IL:LFG
(LIST (IL:UNIX-GETENV 'MEDLEY_COMMIT_ID))
(CADR (ASSOC 'IL:MEDLEY IL:SYSOUTCOMMITS)))
(IL:PUTASSOC 'IL:LFG (LIST (IL:UNIX-GETENV 'APP_COMMIT_ID)) IL:SYSOUTCOMMITS)
(IL:ENDLOADUP)
(IL:DRIBBLE)
(IL:MAKESYS
(IL:PACKFILENAME 'HOST '{DSK} 'DIRECTORY (IL:UNIX-GETENV 'APP_WORKDIR) 'NAME 'lfg.sysout)
:LFG
)
)
(IL:LOGOUT T)
"
EOF
run_medley "${full_sysout}"
loadup_finish "lfg.sysout" "lfg.dribble"
}
get_medleydir() {
while [ $# -gt 0 ]
do
case "$1" in
-m | -medley | --medley)
export MEDLEYDIR="$2"
if [ -z "$2" ]
then
echo "Error: The -m (-medley, --medley) flag requires a path to a full.sysout file as an argument"
echo "Exiting"
exit 1
fi
shift
;;
*)
echo "Warning unknown argument: $1. Ignored"
;;
esac
shift
done
if [ -z "${MEDLEYDIR}" ]
then
echo "Error: MEDLEYDIR not specified either thru environment variable or thru command line argument"
echo "Exiting"
exit 1
fi
full_sysout="${MEDLEYDIR}/loadups/full.sysout"
if [ ! -f "${full_sysout}" ]
then
echo "Error: cannot find the Medley full.sysout file (${full_sysout})"
echo "It either doesn't exist or is a directory"
echo "Exiting"
exit 1
fi
. "${MEDLEYDIR}/scripts/loadup-app-setup.sh"
}
# shellcheck disable=SC2164,SC2034
if [ -z "${LOADUP_SCRIPTDIR}" ]
then
#
#
# Some functions to determine what directory this script is being executed from
#
#
get_abs_filename() {
# $1 : relative filename
echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
}
# This function taken from
# https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh
rreadlink() (
# Execute this function in a *subshell* to localize variables and the effect of `cd`.
target=$1
fname=
targetDir=
CDPATH=
# Try to make the execution environment as predictable as possible:
# All commands below are invoked via `command`, so we must make sure that `command`
# itself is not redefined as an alias or shell function.
# (Note that command is too inconsistent across shells, so we don't use it.)
# `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have
# an external utility version of it (e.g, Ubuntu).
# `command` bypasses aliases and shell functions and also finds builtins
# in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that
# to happen.
{ \unalias command; \unset -f command; } >/dev/null 2>&1
[ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too.
while :; do # Resolve potential symlinks until the ultimate target is found.
[ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; }
command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path.
fname=$(command basename -- "$target") # Extract filename.
[ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/'
if [ -L "$fname" ]; then
# Extract [next] target path, which may be defined
# *relative* to the symlink's own directory.
# Note: We parse `ls -l` output to find the symlink target
# which is the only POSIX-compliant, albeit somewhat fragile, way.
target=$(command ls -l "$fname")
target=${target#* -> }
continue # Resolve [next] symlink target.
fi
break # Ultimate target reached.
done
targetDir=$(command pwd -P) # Get canonical dir. path
# Output the ultimate target's canonical path.
# Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path.
if [ "$fname" = '.' ]; then
command printf '%s\n' "${targetDir%/}"
elif [ "$fname" = '..' ]; then
# Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied
# AFTER canonicalization.
command printf '%s\n' "$(command dirname -- "${targetDir}")"
else
command printf '%s\n' "${targetDir%/}/$fname"
fi
)
get_script_dir() {
# call this with $0 (from main script) as its (only) parameter
# if you need to preserve cwd, run this is a subshell since
# it can change cwd
# set -x
local_SCRIPT_PATH="$( get_abs_filename "$1" )";
while [ -h "$local_SCRIPT_PATH" ];
do
cd "$( dirname -- "$local_SCRIPT_PATH"; )";
local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )";
done
cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null';
local_SCRIPT_PATH="$( pwd; )";
# set +x
echo "${local_SCRIPT_PATH}"
}
# end of script directory functions
###############################################################################
# figure out the script dir
LOADUP_SCRIPTDIR="$(get_script_dir "$0")"
export LOADUP_SCRIPTDIR
fi
main "$@"

View File

@@ -1,16 +0,0 @@
#!/bin/bash
# Get the parameters
previous_head=$1
new_head=$2
is_branch_checkout=$3
# Print some info
echo "Checkout complete!"
# echo "Previous HEAD: $previous_head"
# echo "New HEAD: $new_head"
# echo "Branch checkout: $is_branch_checkout"
if [[ "$is_branch_checkout" == "1" ]]; then
find . -name "*.~[1-9]*~" -exec ./scripts/find-orphaned-versions.sh {} \;
fi

View File

@@ -1,3 +0,0 @@
#/bin/sh
find . -name "*.~[1-9]*~" -exec if \[ ! -f {}:h \]\; then echo "{}" " with no versionless" \;

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-2025 13:37:28" {DSK}<Users>briggs>Projects>medley>sources>ADIR.;48 70144
(FILECREATED "25-Dec-2024 11:31:30" {MEDLEY}<sources>ADIR.;15 70102
:EDIT-BY "briggs"
:EDIT-BY rmk
:CHANGES-TO (FNS \LOGOUT0 LOGOUT)
:CHANGES-TO (FNS TRUEDEVICE.STUB)
:PREVIOUS-DATE "31-Dec-2024 11:45:01" {DSK}<Users>briggs>Projects>medley>sources>ADIR.;47)
:PREVIOUS-DATE "25-Dec-2024 07:35:38" {MEDLEY}<sources>ADIR.;13)
(PRETTYCOMPRINT ADIRCOMS)
@@ -16,11 +16,12 @@
(FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP
RENAMEFILE SIMPLE.FINDFILE VMEMSIZE \COPYSYS \FLUSHVM \LOGOUT0)
(CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
(FNS TRUEDEVICE.STUB)
(P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T)
(MOVD? 'EVQ 'TRUEFILENAME)
(MOVD? 'EVQ 'PSEUDOFILENAME)
(MOVD? 'NILL 'PSEUDOHOSTP)
(MOVD? '\GETDEVICEFROMNAME 'TRUEDEVICE))
(MOVD? 'TRUEDEVICE.STUB 'TRUEDEVICE))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P
(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM. PATHNAMEP (and pathnames) get defined much later in the loadup.")
@@ -287,11 +288,10 @@
(RETURN T)))])
(\LOGOUT0
[LAMBDA (FAST STATUS) (* ; "Edited 20-Jan-2025 13:34 by briggs")
(* ; "Edited 21-Mar-2021 21:13 by larry")
[LAMBDA (FAST) (* ; "Edited 21-Mar-2021 21:13 by larry")
(OR (AND (NOT FAST)
(\FLUSHVM))
(SUBRCALL LISPFINISH FAST STATUS])
(\FLUSHVM))
(SUBRCALL LISPFINISH FAST])
)
(DECLARE%: EVAL@COMPILE
@@ -300,6 +300,14 @@
(CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
)
(DEFINEQ
(TRUEDEVICE.STUB
[LAMBDA (X) (* ; "Edited 25-Dec-2024 11:31 by rmk")
(if (type? FDEV X)
then X
else (\GETDEVICEFROMNAME X NIL T])
)
(MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T)
@@ -309,7 +317,7 @@
(MOVD? 'NILL 'PSEUDOHOSTP)
(MOVD? '\GETDEVICEFROMNAME 'TRUEDEVICE)
(MOVD? 'TRUEDEVICE.STUB 'TRUEDEVICE)
(DECLARE%: DONTEVAL@LOAD DOCOPY
@@ -1068,17 +1076,16 @@
(DEFINEQ
(LOGOUT
[LAMBDA (FAST STATUS) (* ; "Edited 20-Jan-2025 13:36 by briggs")
(* ; "Edited 15-Mar-2021 11:53 by larry")
[LAMBDA (FAST) (* ; "Edited 15-Mar-2021 11:53 by larry")
(\USEREVENT 'BEFORELOGOUT)
(OR (EQ FAST T)
(\FLUSHVMOK? 'LOGOUT)) (* ;
 "Check that we have a vmem file before allowing LOGOUT")
 "Check that we have a vmem file before allowing LOGOUT")
(\PROCESS.BEFORE.LOGOUT)
(\DEVICEEVENT 'BEFORELOGOUT)
(\SETTOTALTIME) (* ;
 "update the total time that this sysout has been running.")
(\LOGOUT0 FAST STATUS)
 "update the total time that this sysout has been running.")
(\LOGOUT0 FAST)
(* ;; "Must re-establish the state of devices and of previously open files that might have been modified at the EXEC.")
@@ -1282,14 +1289,15 @@
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3225 16052 (DELFILE 3235 . 3396) (FULLNAME 3398 . 3765) (INFILE 3767 . 4026) (INFILEP
4028 . 4163) (IOFILE 4165 . 4416) (OPENFILE 4418 . 4721) (OPENSTREAM 4723 . 9063) (OUTFILE 9065 . 9327
) (OUTFILEP 9329 . 9465) (RENAMEFILE 9467 . 9773) (SIMPLE.FINDFILE 9775 . 10185) (VMEMSIZE 10187 .
10354) (\COPYSYS 10356 . 14647) (\FLUSHVM 14649 . 15721) (\LOGOUT0 15723 . 16050)) (16551 41211 (
UNPACKFILENAME.STRING 16561 . 38397) (\UPF.DIRECTORY 38399 . 41209)) (42739 45045 (UNPACKFILENAME
42749 . 42935) (LASTCHPOS 42937 . 43631) (FILENAMEFIELD 43633 . 43927) (FILENAMEFIELD.STRING 43929 .
44333) (PACKFILENAME 44335 . 44678) (PACKFILENAME.STRING 44680 . 45043)) (59515 60428 (
FILEDIRCASEARRAY 59525 . 60426)) (60595 67903 (LOGOUT 60605 . 61650) (MAKESYS 61652 . 63281) (SYSOUT
63283 . 64835) (SAVEVM 64837 . 65637) (HERALD 65639 . 65799) (INTERPRET.REM.CM 65801 . 67526) (
\USEREVENT 67528 . 67901)) (68085 69812 (USERNAME 68095 . 69051) (SETUSERNAME 69053 . 69810)))))
(FILEMAP (NIL (3201 15904 (DELFILE 3211 . 3372) (FULLNAME 3374 . 3741) (INFILE 3743 . 4002) (INFILEP
4004 . 4139) (IOFILE 4141 . 4392) (OPENFILE 4394 . 4697) (OPENSTREAM 4699 . 9039) (OUTFILE 9041 . 9303
) (OUTFILEP 9305 . 9441) (RENAMEFILE 9443 . 9749) (SIMPLE.FINDFILE 9751 . 10161) (VMEMSIZE 10163 .
10330) (\COPYSYS 10332 . 14623) (\FLUSHVM 14625 . 15697) (\LOGOUT0 15699 . 15902)) (16033 16269 (
TRUEDEVICE.STUB 16043 . 16267)) (16637 41297 (UNPACKFILENAME.STRING 16647 . 38483) (\UPF.DIRECTORY
38485 . 41295)) (42825 45131 (UNPACKFILENAME 42835 . 43021) (LASTCHPOS 43023 . 43717) (FILENAMEFIELD
43719 . 44013) (FILENAMEFIELD.STRING 44015 . 44419) (PACKFILENAME 44421 . 44764) (PACKFILENAME.STRING
44766 . 45129)) (59601 60514 (FILEDIRCASEARRAY 59611 . 60512)) (60681 67861 (LOGOUT 60691 . 61608) (
MAKESYS 61610 . 63239) (SYSOUT 63241 . 64793) (SAVEVM 64795 . 65595) (HERALD 65597 . 65757) (
INTERPRET.REM.CM 65759 . 67484) (\USEREVENT 67486 . 67859)) (68043 69770 (USERNAME 68053 . 69009) (
SETUSERNAME 69011 . 69768)))))
STOP

Binary file not shown.

View File

@@ -1,16 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Jan-2025 13:35:20" {DSK}<home>matt>Interlisp>medley>sources>APUTDQ.;2 10901
(FILECREATED "25-Oct-2022 11:44:17" {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;3 14079
:EDIT-BY "mth"
:CHANGES-TO (FNS ENDLOADUP)
:CHANGES-TO (FNS LOADUP)
:PREVIOUS-DATE "25-Oct-2022 11:44:17" {DSK}<home>matt>Interlisp>medley>sources>APUTDQ.;1)
:PREVIOUS-DATE "25-Oct-2022 11:07:06" {DSK}<home>larry>ilisp>medley>sources>APUTDQ.;2)
(* ; "
Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
Copyright (c) 1981-1988, 1990, 2021-2022 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT APUTDQCOMS)
@@ -77,7 +75,7 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
(*COMPILED-EXTENSIONS* '(DFASL LCOM))
(SYSOUT.EXT 'SYSOUT]
(LOCALVARS . T)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA FAULTEVAL)
(NLAML)
(LAMA])
@@ -134,14 +132,12 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
(DEFINEQ
(LOADUP
[LAMBDA (FILES) (* ; "Edited 16-Jan-2025 13:35 by mth")
(* ; "Edited 12-Mar-2021 00:15 by larry")
(for X in FILES do (if (FMEMB X SYSFILES)
then (PRINTOUT T X " already loaded" T)
else (PRINTOUT T "loading " X T)
(DOFILESLOAD (LIST '(SYSLOAD)
X)))
(SMASHFILECOMS X])
[LAMBDA (FILES) (* ; "Edited 12-Mar-2021 00:15 by larry")
(for X in FILES do (PRINTOUT T "loading " X T)
(OR (FMEMB X SYSFILES)
(DOFILESLOAD (LIST '(SYSLOAD)
X)))
(SMASHFILECOMS X])
(ENDLOADUP
[LAMBDA NIL
@@ -255,6 +251,81 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA FAULTEVAL)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PRETTYCOMPRINT APUTDQCOMS)
(RPAQQ APUTDQCOMS
[
(* ;; " this file contains some dummy definitions of functions whose real implementation is on other files")
(DECLARE%: EVAL@LOAD DONTCOPY (P (PRIN1 "Warning: APUTDQ contains dummy definitions of " T)
(PRIN1
"FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION SMASHFILECOMS"
T)
(PRIN1 "Be careful not to confuse with the real definitions"
T)
(TERPRI T)))
(FNS GREETFILENAME FAULTEVAL FAULTAPPLY ERRORX SET-DOCUMENTATION)
(FNS SMASHFILECOMS SMASHFILECOMSLST)
(INITVARS (DEFAULTREGISTRY)
(USERGREETFILES)
(LOGINHOST/DIR '{DSK}))
(FNS LOADUP ENDLOADUP)
(ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG
UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES
NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION
ADVISEDFNS LISPUSERSDIRECTORIES DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS
INTERPRESSFONTDIRECTORIES))
[DECLARE%: DONTEVAL@LOAD DOCOPY
(* ;; "many of these are obsolete and can be removed, but it is unclear which ones")
(P (DUMMYDEF (ADDSTATS *)
(LISPXWATCH NILL)
(CLBUFS NILL)
(FINDFILE INFILEP)
(FILEMAP *)
(VIRGINFN GETD))
(DUMMYDEF (* QUOTE)
(GETP GETPROP)
(DECLARE QUOTE)
(FRPLNODE2 RPLNODE2)
(DISPLAYTERMP TRUE)
(FRPLACA RPLACA)
(FRPLACD RPLACD)
(MISSPELLED? NILL)
(UNDOSAVE NILL)
(SETLINELENGTH ZERO)
(DOBE NILL)
(RELINK NILL)
(PUT PUTPROP)
(/PUT PUTPROP)))
(ADDVARS (SYSFILES)
(LISPXHISTORY)
(LINKEDFNS))
(VARS (CLEARSTKLST T)
(SYSHASHARRAY (HASHARRAY 50))
(DISPLAYTERMFLG T)
(%#UNDOSAVES)
(NLAMA)
(NLAML)
(LAMS)
(TTYLINELENGTH 82)
(COMPILE.EXT 'LCOM)
(FASL.EXT 'DFASL)
(*COMPILED-EXTENSIONS* '(DFASL LCOM))
(SYSOUT.EXT 'SYSOUT]
(LOCALVARS . T)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
@@ -262,9 +333,9 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
(ADDTOVAR LAMA )
)
(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990
2021 2022 2025))
2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3999 6207 (GREETFILENAME 4009 . 5882) (FAULTEVAL 5884 . 5956) (FAULTAPPLY 5958 . 6044)
(ERRORX 6046 . 6112) (SET-DOCUMENTATION 6114 . 6205)) (6208 7228 (SMASHFILECOMS 6218 . 6560) (
SMASHFILECOMSLST 6562 . 7226)) (7322 8926 (LOADUP 7332 . 7916) (ENDLOADUP 7918 . 8924)))))
(FILEMAP (NIL (3978 6186 (GREETFILENAME 3988 . 5861) (FAULTEVAL 5863 . 5935) (FAULTAPPLY 5937 . 6023)
(ERRORX 6025 . 6091) (SET-DOCUMENTATION 6093 . 6184)) (6187 7207 (SMASHFILECOMS 6197 . 6539) (
SMASHFILECOMSLST 6541 . 7205)) (7301 8744 (LOADUP 7311 . 7734) (ENDLOADUP 7736 . 8742)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2025 12:28:10" {DSK}<home>matt>Interlisp>medley>sources>FONT.;4 191871
(FILECREATED "19-Dec-2024 15:25:17" {WMEDLEY}<sources>FONT.;26 191458
:EDIT-BY "mth"
:EDIT-BY rmk
:CHANGES-TO (VARS FONTCOMS)
(FNS WRITESTRIKEFONTFILE)
:CHANGES-TO (FNS \FGETLEFTKERN)
(VARS FONTCOMS)
(FUNCTIONS \CREATEKERNELEMENT)
:PREVIOUS-DATE "19-Dec-2024 15:25:17" {DSK}<home>matt>Interlisp>medley>sources>FONT.;1)
:PREVIOUS-DATE "19-Dec-2024 11:52:01" {WMEDLEY}<sources>FONT.;18)
(PRETTYCOMPRINT FONTCOMS)
@@ -136,8 +137,6 @@
{dsk}/usr/local/lde/fonts/display/publishing/
]
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MAXCODE 255)
(DUMMYINDEX 256)))
(MACROS \FGETCHARIMAGEWIDTH \GETFONTDESC \SETCHARSETINFO)
(LOCALVARS . T)
(PROP FILETYPE FONT)
@@ -2689,8 +2688,7 @@
(DEFINEQ
(WRITESTRIKEFONTFILE
[LAMBDA (FONT CHARSET FILE) (* ; "Edited 1-Feb-2025 12:27 by mth")
(* ; "Edited 12-Jul-2022 14:36 by rmk")
[LAMBDA (FONT CHARSET FILE) (* ; "Edited 12-Jul-2022 14:36 by rmk")
(* kbr%: "21-Oct-85 15:08")
(* ;
 "Write strike FILE using info in FONT. *")
@@ -3348,18 +3346,6 @@
(RPAQ? DISPLAYFONTDIRECTORIES '({DSK}/USR/LOCAL/LDE/FONTS/DISPLAY/PRESENTATION/
{dsk}/usr/local/lde/fonts/display/publishing/))
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RPAQQ MAXCODE 255)
(RPAQQ DUMMYINDEX 256)
(CONSTANTS (MAXCODE 255)
(DUMMYINDEX 256))
)
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \FGETCHARIMAGEWIDTH MACRO (OPENLAMBDA (FONT CHARCODE)
@@ -3394,31 +3380,31 @@
(ADDTOVAR LAMA FONTCOPY)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8870 18389 (CHARWIDTH 8880 . 9665) (CHARWIDTHY 9667 . 11037) (STRINGWIDTH 11039 . 12132
) (\CHARWIDTH.DISPLAY 12134 . 12547) (\STRINGWIDTH.DISPLAY 12549 . 12973) (\STRINGWIDTH.GENERIC 12975
. 18387)) (18390 24772 (DEFAULTFONT 18400 . 20233) (FONTCLASS 20235 . 22397) (FONTCLASSUNPARSE 22399
. 23298) (FONTCLASSCOMPONENT 23300 . 23809) (SETFONTCLASSCOMPONENT 23811 . 24770)) (25446 38178 (
FONTCREATE 25456 . 34723) (\FONT.SYMBOLMEMB 34725 . 34955) (\FONT.SYMBOLASSOC 34957 . 36115) (
\FONT.COMPARESYMBOL 36117 . 38176)) (38217 42841 (FONTASCENT 38227 . 38395) (FONTDESCENT 38397 . 38666
) (FONTHEIGHT 38668 . 38854) (FONTPROP 38856 . 42299) (\AVGCHARWIDTH 42301 . 42839)) (42888 55527 (
GETCHARBITMAP 42898 . 45788) (PUTCHARBITMAP 45790 . 53847) (MOVECHARBITMAP 53849 . 55525)) (55528
140067 (FONTCOPY 55538 . 60846) (FONTSAVAILABLE 60848 . 66053) (FONTFILEFORMAT 66055 . 67679) (FONTP
67681 . 67980) (FONTUNPARSE 67982 . 70546) (SETFONTDESCRIPTOR 70548 . 72257) (CHARCODEP 72259 . 72620)
(EDITCHAR 72622 . 73051) (\STREAMCHARWIDTH 73053 . 77217) (\UNITWIDTHSVECTOR 77219 . 77582) (
\CREATEDISPLAYFONT 77584 . 78337) (\CREATECHARSET.DISPLAY 78339 . 81255) (\CREATE-REAL-CHARSET.DISPLAY
81257 . 88161) (\BUILDSLUGCSINFO 88163 . 89606) (\SEARCHDISPLAYFONTFILES 89608 . 91541) (
\SEARCHFONTFILES 91543 . 94854) (\FINDFONTFILE 94856 . 96047) (\FONTSYMBOL 96049 . 96699) (
\DEVICESYMBOL 96701 . 97570) (\FONTFACE 97572 . 104762) (\FONTFACE.COLOR 104764 . 111684) (
\FONTFILENAME 111686 . 115101) (\FONTFILENAME.OLD 115103 . 118052) (\FONTFILENAME.NEW 118054 . 120311)
(\FONTINFOFROMFILENAME 120313 . 123427) (\FONTINFOFROMFILENAME.OLD 123429 . 125706) (\GETFONTDESC
125708 . 126099) (\COERCEFONTDESC 126101 . 131486) (\LOOKUPFONT 131488 . 132832) (\LOOKUPFONTSINCORE
132834 . 134907) (\READDISPLAYFONTFILE 134909 . 140065)) (140970 157694 (\READSTRIKEFONTFILE 140980 .
145182) (\SFMAKEBOLD 145184 . 147580) (\SFMAKEITALIC 147582 . 150485) (\SFMAKEROTATEDFONT 150487 .
151888) (\SFROTATECSINFO 151890 . 152527) (\SFROTATEFONTCHARACTERS 152529 . 152909) (
\SFFIXOFFSETSAFTERROTATION 152911 . 155050) (\SFROTATECSINFOOFFSETS 155052 . 156321) (\SFMAKECOLOR
156323 . 157692)) (157695 165057 (WRITESTRIKEFONTFILE 157705 . 161597) (STRIKECSINFO 161599 . 165055))
(165058 166897 (FONTDESCRIPTOR.DEFPRINT 165068 . 166419) (FONTCLASS.DEFPRINT 166421 . 166895)) (
182093 182415 (\CREATEKERNELEMENT 182093 . 182415)) (182417 182545 (\FSETLEFTKERN 182417 . 182545)) (
182671 183718 (\FGETLEFTKERN 182681 . 183716)) (183762 187272 (\CREATECHARSET 183772 . 185523) (
\INSTALLCHARSETINFO 185525 . 187270)) (188427 190179 (\FONTRESETCHARWIDTHS 188437 . 190177)))))
(FILEMAP (NIL (8734 18253 (CHARWIDTH 8744 . 9529) (CHARWIDTHY 9531 . 10901) (STRINGWIDTH 10903 . 11996
) (\CHARWIDTH.DISPLAY 11998 . 12411) (\STRINGWIDTH.DISPLAY 12413 . 12837) (\STRINGWIDTH.GENERIC 12839
. 18251)) (18254 24636 (DEFAULTFONT 18264 . 20097) (FONTCLASS 20099 . 22261) (FONTCLASSUNPARSE 22263
. 23162) (FONTCLASSCOMPONENT 23164 . 23673) (SETFONTCLASSCOMPONENT 23675 . 24634)) (25310 38042 (
FONTCREATE 25320 . 34587) (\FONT.SYMBOLMEMB 34589 . 34819) (\FONT.SYMBOLASSOC 34821 . 35979) (
\FONT.COMPARESYMBOL 35981 . 38040)) (38081 42705 (FONTASCENT 38091 . 38259) (FONTDESCENT 38261 . 38530
) (FONTHEIGHT 38532 . 38718) (FONTPROP 38720 . 42163) (\AVGCHARWIDTH 42165 . 42703)) (42752 55391 (
GETCHARBITMAP 42762 . 45652) (PUTCHARBITMAP 45654 . 53711) (MOVECHARBITMAP 53713 . 55389)) (55392
139931 (FONTCOPY 55402 . 60710) (FONTSAVAILABLE 60712 . 65917) (FONTFILEFORMAT 65919 . 67543) (FONTP
67545 . 67844) (FONTUNPARSE 67846 . 70410) (SETFONTDESCRIPTOR 70412 . 72121) (CHARCODEP 72123 . 72484)
(EDITCHAR 72486 . 72915) (\STREAMCHARWIDTH 72917 . 77081) (\UNITWIDTHSVECTOR 77083 . 77446) (
\CREATEDISPLAYFONT 77448 . 78201) (\CREATECHARSET.DISPLAY 78203 . 81119) (\CREATE-REAL-CHARSET.DISPLAY
81121 . 88025) (\BUILDSLUGCSINFO 88027 . 89470) (\SEARCHDISPLAYFONTFILES 89472 . 91405) (
\SEARCHFONTFILES 91407 . 94718) (\FINDFONTFILE 94720 . 95911) (\FONTSYMBOL 95913 . 96563) (
\DEVICESYMBOL 96565 . 97434) (\FONTFACE 97436 . 104626) (\FONTFACE.COLOR 104628 . 111548) (
\FONTFILENAME 111550 . 114965) (\FONTFILENAME.OLD 114967 . 117916) (\FONTFILENAME.NEW 117918 . 120175)
(\FONTINFOFROMFILENAME 120177 . 123291) (\FONTINFOFROMFILENAME.OLD 123293 . 125570) (\GETFONTDESC
125572 . 125963) (\COERCEFONTDESC 125965 . 131350) (\LOOKUPFONT 131352 . 132696) (\LOOKUPFONTSINCORE
132698 . 134771) (\READDISPLAYFONTFILE 134773 . 139929)) (140834 157558 (\READSTRIKEFONTFILE 140844 .
145046) (\SFMAKEBOLD 145048 . 147444) (\SFMAKEITALIC 147446 . 150349) (\SFMAKEROTATEDFONT 150351 .
151752) (\SFROTATECSINFO 151754 . 152391) (\SFROTATEFONTCHARACTERS 152393 . 152773) (
\SFFIXOFFSETSAFTERROTATION 152775 . 154914) (\SFROTATECSINFOOFFSETS 154916 . 156185) (\SFMAKECOLOR
156187 . 157556)) (157559 164812 (WRITESTRIKEFONTFILE 157569 . 161352) (STRIKECSINFO 161354 . 164810))
(164813 166652 (FONTDESCRIPTOR.DEFPRINT 164823 . 166174) (FONTCLASS.DEFPRINT 166176 . 166650)) (
181848 182170 (\CREATEKERNELEMENT 181848 . 182170)) (182172 182300 (\FSETLEFTKERN 182172 . 182300)) (
182426 183473 (\FGETLEFTKERN 182436 . 183471)) (183517 187027 (\CREATECHARSET 183527 . 185278) (
\INSTALLCHARSETINFO 185280 . 187025)) (188182 189934 (\FONTRESETCHARWIDTHS 188192 . 189932)))))
STOP

Binary file not shown.

View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "14-Jan-2025 13:20:25" |{DSK}<home>matt>Interlisp>medley>sources>HIST.;2| 152217
(FILECREATED "19-Apr-2023 18:58:13" |{DSK}<home>larry>il>medley>sources>HIST.;6| 152088
:EDIT-BY "matt"
:EDIT-BY "lmm"
:CHANGES-TO (FNS GREET0)
:PREVIOUS-DATE "19-Apr-2023 18:58:13" |{DSK}<home>matt>Interlisp>medley>sources>HIST.;1|)
:PREVIOUS-DATE "19-Mar-2023 10:09:08" |{DSK}<home>larry>il>medley>sources>HIST.;1|)
(PRETTYCOMPRINT HISTCOMS)
@@ -2754,8 +2754,7 @@ this sysout is initialized for user " T)
(printout t "error during GREET..." t))))
(GREET0
(LAMBDA NIL (* \; "Edited 14-Jan-2025 13:19 by matt")
(* \; "Edited 19-Apr-2023 18:55 by lmm")
(LAMBDA NIL (* \; "Edited 19-Apr-2023 18:55 by lmm")
(* \; "Edited 19-Mar-2023 09:58 by lmm")
(* |lmm| "28-DEC-82 08:49")
(COND
@@ -2764,7 +2763,7 @@ this sysout is initialized for user " T)
(CL:GET-DECODED-TIME)
(OR (AND (EVENP (LRSH SECONDS 1))
(CDR (SASSOC (CL:FORMAT NIL "~2D-~A" DAY
(CL:NTH (SUB1 MONTH)
(CL:NTH MONTH
'("JAN" "FEB" "MAR" "APR" "MAY"
"JUN" "JUL" "AUG" "SEP"
"OCT" "NOV" "DEC")))
@@ -3039,19 +3038,19 @@ this sysout is initialized for user " T)
(ADDTOVAR LAMA )
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (14257 21002 (PRINTHISTORY 14267 . 16057) (ENTRY# 16059 . 16394) (PRINTHISTORY1 16396 .
19565) (PRINTHISTORY2 19567 . 21000)) (21003 129433 (EVALQT 21013 . 21813) (ENTEREVALQT 21815 . 22370)
(USEREXEC 22372 . 23007) (LISPXREAD 23009 . 24812) (LISPXREADBUF 24814 . 27040) (LISPXREADP 27042 .
27591) (LISPXUNREAD 27593 . 27886) (LISPX 27888 . 63583) (LISPX/ 63585 . 65039) (LISPX/1 65041 . 70327
) (LISPXEVAL 70329 . 70953) (LISPXSTOREVALUE 70955 . 71209) (HISTORYSAVE 71211 . 78495) (LISPXFIND
78497 . 85932) (LISPXGETINPUT 85934 . 86147) (REMEMBER 86149 . 86343) (GETEXPRESSIONFROMEVENTSPEC
86345 . 88455) (LISPXFIND0 88457 . 92731) (LISPXFIND1 92733 . 93161) (HISTORYFIND 93163 . 98737) (
HISTORYFIND1 98739 . 102184) (HISTORYMATCH 102186 . 102261) (VALUEOF 102263 . 103288) (VALUOF 103290
. 104180) (VALUOF-EVENT 104182 . 104587) (LISPXUSE 104589 . 111008) (LISPXUSE0 111010 . 113736) (
LISPXUSE1 113738 . 115363) (LISPXSUBST 115365 . 115785) (LISPXUSEC 115787 . 124028) (LISPXFIX 124030
. 124880) (CHANGESLICE 124882 . 126729) (LISPXSTATE 126731 . 127825) (LISPXTYPEAHEAD 127827 . 129431)
) (137485 140819 (GREET 137495 . 138636) (GREET0 138638 . 140817)) (142421 149597 (LISPXPRINT 142431
. 142995) (LISPXPRIN1 142997 . 143881) (LISPXPRIN2 143883 . 144825) (LISPXPRINTDEF 144827 . 145381) (
LISPXPRINTDEF0 145383 . 145746) (LISPXSPACES 145748 . 146434) (LISPXTERPRI 146436 . 147061) (LISPXTAB
147063 . 147621) (USERLISPXPRINT 147623 . 149023) (LISPXPUT 149025 . 149595)))))
(FILEMAP (NIL (14244 20989 (PRINTHISTORY 14254 . 16044) (ENTRY# 16046 . 16381) (PRINTHISTORY1 16383 .
19552) (PRINTHISTORY2 19554 . 20987)) (20990 129420 (EVALQT 21000 . 21800) (ENTEREVALQT 21802 . 22357)
(USEREXEC 22359 . 22994) (LISPXREAD 22996 . 24799) (LISPXREADBUF 24801 . 27027) (LISPXREADP 27029 .
27578) (LISPXUNREAD 27580 . 27873) (LISPX 27875 . 63570) (LISPX/ 63572 . 65026) (LISPX/1 65028 . 70314
) (LISPXEVAL 70316 . 70940) (LISPXSTOREVALUE 70942 . 71196) (HISTORYSAVE 71198 . 78482) (LISPXFIND
78484 . 85919) (LISPXGETINPUT 85921 . 86134) (REMEMBER 86136 . 86330) (GETEXPRESSIONFROMEVENTSPEC
86332 . 88442) (LISPXFIND0 88444 . 92718) (LISPXFIND1 92720 . 93148) (HISTORYFIND 93150 . 98724) (
HISTORYFIND1 98726 . 102171) (HISTORYMATCH 102173 . 102248) (VALUEOF 102250 . 103275) (VALUOF 103277
. 104167) (VALUOF-EVENT 104169 . 104574) (LISPXUSE 104576 . 110995) (LISPXUSE0 110997 . 113723) (
LISPXUSE1 113725 . 115350) (LISPXSUBST 115352 . 115772) (LISPXUSEC 115774 . 124015) (LISPXFIX 124017
. 124867) (CHANGESLICE 124869 . 126716) (LISPXSTATE 126718 . 127812) (LISPXTYPEAHEAD 127814 . 129418)
) (137472 140690 (GREET 137482 . 138623) (GREET0 138625 . 140688)) (142292 149468 (LISPXPRINT 142302
. 142866) (LISPXPRIN1 142868 . 143752) (LISPXPRIN2 143754 . 144696) (LISPXPRINTDEF 144698 . 145252) (
LISPXPRINTDEF0 145254 . 145617) (LISPXSPACES 145619 . 146305) (LISPXTERPRI 146307 . 146932) (LISPXTAB
146934 . 147492) (USERLISPXPRINT 147494 . 148894) (LISPXPUT 148896 . 149466)))))
STOP

Binary file not shown.

View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Jul-2024 18:28:42" {WMEDLEY}<sources>INSPECT.;33 129220
(FILECREATED " 4-Jul-2024 12:16:52" {WMEDLEY}<sources>INSPECT.;31 126551
:EDIT-BY rmk
:CHANGES-TO (FNS IMAGEOBJ\PROPFETCHFN IMAGEOBJ\PROPSTOREFN)
(VARS INSPECTCOMS)
:CHANGES-TO (VARS INSPECTCOMS)
:PREVIOUS-DATE " 4-Jul-2024 12:16:52" {WMEDLEY}<sources>INSPECT.;31)
:PREVIOUS-DATE " 4-Jul-2024 11:11:46" {WMEDLEY}<sources>INSPECT.;30)
(PRETTYCOMPRINT INSPECTCOMS)
@@ -73,11 +72,6 @@
(FNS WINDOW\INSPECTPROPS WINDOW\PROPFETCHFN WINDOW\PROPSTOREFN)
(ADDVARS (INSPECTMACROS (WINDOW WINDOW\INSPECTPROPS WINDOW\PROPFETCHFN
WINDOW\PROPSTOREFN]
[COMS (* ;
 "Show properties in the main window")
(FNS IMAGEOBJ\INSPECTPROPS IMAGEOBJ\PROPFETCHFN IMAGEOBJ\PROPSTOREFN)
(ADDVARS (INSPECTMACROS (IMAGEOBJ IMAGEOBJ\INSPECTPROPS IMAGEOBJ\PROPFETCHFN
IMAGEOBJ\PROPSTOREFN]
(COMS (* ; "Hunk inspector")
(FNS INSPECT/AS/BLOCKRECORD INSPECT/TYPELESS LIST-ALL-BLOCKRECORDS INSPECT/HUNK
\INSPECT.DATATYPE.RAW.FETCH \INSPECT.FETCH.8 \INSPECT.FETCH.32 \INSPECT.FETCH.CHAR
@@ -2096,53 +2090,6 @@
(* ; "Show properties in the main window")
(DEFINEQ
(IMAGEOBJ\INSPECTPROPS
[LAMBDA (OBJ) (* ; "Edited 16-Jul-2024 15:01 by rmk")
(* ; "Edited 4-Jul-2024 00:03 by rmk")
(* ; "Edited 30-Jun-2024 09:04 by rmk")
(* ;; "Stick the user properties at the end with --PROPS-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.")
(LET ([IFIELDS (REMOVE 'IMAGEOBJPLIST (INSPECTABLEFIELDNAMES (OR (RECLOOK 'IMAGEOBJ)
(SYSRECLOOK1 'IMAGEOBJ]
(PFIELDS (for X in (fetch (IMAGEOBJ IMAGEOBJPLIST) of OBJ) by (CDDR X) collect X)))
(CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS)
(MEMB 'IMAGEOBJ INSPECTDONTSORTFIELDS))
(SETQ PFIELDS (SORT PFIELDS)))
(APPEND IFIELDS (CONS '--PROPS--)
PFIELDS])
(IMAGEOBJ\PROPFETCHFN
[LAMBDA (OBJ PROPNAME) (* ; "Edited 16-Jul-2024 18:25 by rmk")
(* ;; "Keep the main fields up front.")
(* ;;
 "This does not expand out all of the fields of the IMAGEFNS, they could be raised up at the bottom.")
(SELECTQ PROPNAME
(OBJECTDATUM (fetch (IMAGEOBJ OBJECTDATUM) of OBJ))
(IMAGEOBJFNS (fetch (IMAGEOBJ IMAGEOBJFNS) of OBJ))
(--PROPS-- '------)
(IMAGEOBJPROP OBJ PROPNAME])
(IMAGEOBJ\PROPSTOREFN
[LAMBDA (OBJ PROPNAME VALUE) (* ; "Edited 16-Jul-2024 18:27 by rmk")
(* ; "Edited 30-Jun-2024 08:52 by rmk")
(SELECTQ PROPNAME
(--PROPS-- NIL)
(IMAGEOBJFNS (replace (IMAGEOBJ IMAGEOBJFNS) of OBJ with VALUE))
(IMAGEOBJPROP OBJ PROPNAME VALUE])
)
(ADDTOVAR INSPECTMACROS (IMAGEOBJ IMAGEOBJ\INSPECTPROPS IMAGEOBJ\PROPFETCHFN IMAGEOBJ\PROPSTOREFN))
(* ; "Hunk inspector")
(DEFINEQ
@@ -2311,43 +2258,42 @@
("As Character array" '(8 \INSPECT.FETCH.CHAR \INSPECT.STORE.CHAR))
("As Fat Character array" '(16 \INSPECT.FETCH.FATCHAR \INSPECT.STORE.FATCHAR])
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7776 46129 (INSPECTW.CREATE 7786 . 13081) (INSPECTW.REPAINTFN 13083 . 18619) (
INSPECTW.REDISPLAY 18621 . 27493) (\INSPECTW.VALUE.MARGIN 27495 . 27898) (INSPECTW.REPLACE 27900 .
28608) (INSPECTW.SELECTITEM 28610 . 29600) (\INSPECTW.REDISPLAYPROP 29602 . 32032) (INSPECTW.FETCH
32034 . 32457) (INSPECTW.PROPERTIES 32459 . 33100) (DECODE.WINDOW.ARG 33102 . 34830) (
DEFAULT.INSPECTW.PROPCOMMANDFN 34832 . 36860) (DEFAULT.INSPECTW.VALUECOMMANDFN 36862 . 38278) (
DEFAULT.INSPECTW.TITLECOMMANDFN 38280 . 41729) (\SELITEM.FROM.PROPERTY 41731 . 42173) (
\INSPECT.COMPUTE.TITLE 42175 . 43459) (LEVELEDFORM 43461 . 44180) (MAKEWITHINREGION 44182 . 46127)) (
46130 63435 (ITEMW.REPAINTFN 46140 . 47360) (\ITEM.WINDOW.BUTTON.HANDLER 47362 . 47781) (
\ITEM.WINDOW.SELECTION.HANDLER 47783 . 50450) (\INSPECTW.COMMAND.HANDLER 50452 . 54453) (
ITEM.WINDOW.SET.STACK.ARG 54455 . 56659) (REPLACESTKARG 56661 . 57760) (IN/ITEM? 57762 . 58644) (
\ITEMW.DESELECTITEM 58646 . 58910) (\ITEMW.SELECTITEM 58912 . 59174) (\ITEMW.CLEARSELECTION 59176 .
59531) (\ITEMW.FLIPITEM 59533 . 60006) (PRINTANDBOX 60008 . 62517) (PRINTATBOX 62519 . 63036) (
ITEMOFPROPERTYVALUE 63038 . 63433)) (63436 67177 (\ITEM.WINDOW.COPY.HANDLER 63446 . 65303) (
\ITEMW.FLIPCOPY 65305 . 65764) (BKSYSBUF.GENERAL 65766 . 67175)) (67569 92484 (INSPECT 67579 . 72109)
(\APPLYINSPECTMACRO 72111 . 73172) (INSPECT/BITMAP 73174 . 74326) (INSPECT/DATATYPE 74328 . 77842) (
INSPECTABLEFIELDNAMES 77844 . 79177) (REMOVEDUPS 79179 . 79384) (INSPECT/ARRAY 79386 . 80451) (
INSPECT/TOP/LEVEL/LIST 80453 . 81570) (INSPECT/PROPLIST 81572 . 82660) (NONSYSPROPNAMES 82662 . 82958)
(INSPECT/LISTP 82960 . 83399) (ALISTP 83401 . 83610) (PROPLISTP 83612 . 84252) (INSPECT/ALIST 84254
. 84730) (ASSOCGET 84732 . 84943) (/ASSOCPUT 84945 . 85210) (INSPECT/PLIST 85212 . 85696) (
INSPECT/TYPERECORD 85698 . 86055) (INSPECT/AS/RECORD 86057 . 87294) (SELECT.LIST.INSPECTOR 87296 .
89347) (STANDARDEDITE 89349 . 89632) (NTHTOPLEVELELT 89634 . 89950) (SETNTHTOPLEVELELT 89952 . 90712)
(DEDITE 90714 . 90921) (FINDRECDECL 90923 . 91506) (FINDSYSRECDECL 91508 . 91909) (
MAKE-INSPECTOR-PROFILE 91911 . 92296) (CONFIRM-SET 92298 . 92482)) (94308 102522 (INSPECT/ATOM 94318
. 98423) (SELECT.ATOM.ASPECT 98425 . 99569) (INSPECT/AS/FUNCTION 99571 . 101857) (SELECT.FNS.EDITOR
101859 . 102520)) (102563 107988 (INSPECTCODE 102573 . 103725) (\TEDIT.INSPECTCODE 103727 . 105705) (
\INSPECT/CODE/RESHAPEFN 105707 . 107246) (\INSPECT/CODE/REPAINTFN 107248 . 107986)) (108026 109632 (
INSPECT/HARRAYP 108036 . 108784) (HARRAYKEYS 108786 . 109165) (INSPECTW.GETHASH 109167 . 109394) (
INSPECTW.PUTHASH 109396 . 109630)) (109681 115890 (RDTBL\NONOTHERCODES 109691 . 110711) (GETSYNTAXPROP
110713 . 112211) (SETSYNTAXPROP 112213 . 113940) (GETTTBLPROP 113942 . 114860) (SETTTBLPROP 114862 .
115888)) (116395 117845 (WINDOW\INSPECTPROPS 116405 . 117260) (WINDOW\PROPFETCHFN 117262 . 117616) (
WINDOW\PROPSTOREFN 117618 . 117843)) (117994 120023 (IMAGEOBJ\INSPECTPROPS 118004 . 119070) (
IMAGEOBJ\PROPFETCHFN 119072 . 119602) (IMAGEOBJ\PROPSTOREFN 119604 . 120021)) (120160 128802 (
INSPECT/AS/BLOCKRECORD 120170 . 121170) (INSPECT/TYPELESS 121172 . 122563) (LIST-ALL-BLOCKRECORDS
122565 . 122840) (INSPECT/HUNK 122842 . 125445) (\INSPECT.DATATYPE.RAW.FETCH 125447 . 125773) (
\INSPECT.FETCH.8 125775 . 125924) (\INSPECT.FETCH.32 125926 . 126097) (\INSPECT.FETCH.CHAR 126099 .
126262) (\INSPECT.FETCH.FATCHAR 126264 . 126426) (\INSPECT.FETCH.PTR 126428 . 126599) (
\INSPECT.STORE.8 126601 . 126907) (\INSPECT.STORE.16 126909 . 127209) (\INSPECT.STORE.32 127211 .
127646) (\INSPECT.STORE.CHAR 127648 . 127974) (\INSPECT.STORE.FATCHAR 127976 . 128298) (
\INSPECT.STORE.PTR 128300 . 128647) (INSPECT/MAKE/CCODEP 128649 . 128800)))))
(FILEMAP (NIL (7293 45646 (INSPECTW.CREATE 7303 . 12598) (INSPECTW.REPAINTFN 12600 . 18136) (
INSPECTW.REDISPLAY 18138 . 27010) (\INSPECTW.VALUE.MARGIN 27012 . 27415) (INSPECTW.REPLACE 27417 .
28125) (INSPECTW.SELECTITEM 28127 . 29117) (\INSPECTW.REDISPLAYPROP 29119 . 31549) (INSPECTW.FETCH
31551 . 31974) (INSPECTW.PROPERTIES 31976 . 32617) (DECODE.WINDOW.ARG 32619 . 34347) (
DEFAULT.INSPECTW.PROPCOMMANDFN 34349 . 36377) (DEFAULT.INSPECTW.VALUECOMMANDFN 36379 . 37795) (
DEFAULT.INSPECTW.TITLECOMMANDFN 37797 . 41246) (\SELITEM.FROM.PROPERTY 41248 . 41690) (
\INSPECT.COMPUTE.TITLE 41692 . 42976) (LEVELEDFORM 42978 . 43697) (MAKEWITHINREGION 43699 . 45644)) (
45647 62952 (ITEMW.REPAINTFN 45657 . 46877) (\ITEM.WINDOW.BUTTON.HANDLER 46879 . 47298) (
\ITEM.WINDOW.SELECTION.HANDLER 47300 . 49967) (\INSPECTW.COMMAND.HANDLER 49969 . 53970) (
ITEM.WINDOW.SET.STACK.ARG 53972 . 56176) (REPLACESTKARG 56178 . 57277) (IN/ITEM? 57279 . 58161) (
\ITEMW.DESELECTITEM 58163 . 58427) (\ITEMW.SELECTITEM 58429 . 58691) (\ITEMW.CLEARSELECTION 58693 .
59048) (\ITEMW.FLIPITEM 59050 . 59523) (PRINTANDBOX 59525 . 62034) (PRINTATBOX 62036 . 62553) (
ITEMOFPROPERTYVALUE 62555 . 62950)) (62953 66694 (\ITEM.WINDOW.COPY.HANDLER 62963 . 64820) (
\ITEMW.FLIPCOPY 64822 . 65281) (BKSYSBUF.GENERAL 65283 . 66692)) (67086 92001 (INSPECT 67096 . 71626)
(\APPLYINSPECTMACRO 71628 . 72689) (INSPECT/BITMAP 72691 . 73843) (INSPECT/DATATYPE 73845 . 77359) (
INSPECTABLEFIELDNAMES 77361 . 78694) (REMOVEDUPS 78696 . 78901) (INSPECT/ARRAY 78903 . 79968) (
INSPECT/TOP/LEVEL/LIST 79970 . 81087) (INSPECT/PROPLIST 81089 . 82177) (NONSYSPROPNAMES 82179 . 82475)
(INSPECT/LISTP 82477 . 82916) (ALISTP 82918 . 83127) (PROPLISTP 83129 . 83769) (INSPECT/ALIST 83771
. 84247) (ASSOCGET 84249 . 84460) (/ASSOCPUT 84462 . 84727) (INSPECT/PLIST 84729 . 85213) (
INSPECT/TYPERECORD 85215 . 85572) (INSPECT/AS/RECORD 85574 . 86811) (SELECT.LIST.INSPECTOR 86813 .
88864) (STANDARDEDITE 88866 . 89149) (NTHTOPLEVELELT 89151 . 89467) (SETNTHTOPLEVELELT 89469 . 90229)
(DEDITE 90231 . 90438) (FINDRECDECL 90440 . 91023) (FINDSYSRECDECL 91025 . 91426) (
MAKE-INSPECTOR-PROFILE 91428 . 91813) (CONFIRM-SET 91815 . 91999)) (93825 102039 (INSPECT/ATOM 93835
. 97940) (SELECT.ATOM.ASPECT 97942 . 99086) (INSPECT/AS/FUNCTION 99088 . 101374) (SELECT.FNS.EDITOR
101376 . 102037)) (102080 107505 (INSPECTCODE 102090 . 103242) (\TEDIT.INSPECTCODE 103244 . 105222) (
\INSPECT/CODE/RESHAPEFN 105224 . 106763) (\INSPECT/CODE/REPAINTFN 106765 . 107503)) (107543 109149 (
INSPECT/HARRAYP 107553 . 108301) (HARRAYKEYS 108303 . 108682) (INSPECTW.GETHASH 108684 . 108911) (
INSPECTW.PUTHASH 108913 . 109147)) (109198 115407 (RDTBL\NONOTHERCODES 109208 . 110228) (GETSYNTAXPROP
110230 . 111728) (SETSYNTAXPROP 111730 . 113457) (GETTTBLPROP 113459 . 114377) (SETTTBLPROP 114379 .
115405)) (115912 117362 (WINDOW\INSPECTPROPS 115922 . 116777) (WINDOW\PROPFETCHFN 116779 . 117133) (
WINDOW\PROPSTOREFN 117135 . 117360)) (117491 126133 (INSPECT/AS/BLOCKRECORD 117501 . 118501) (
INSPECT/TYPELESS 118503 . 119894) (LIST-ALL-BLOCKRECORDS 119896 . 120171) (INSPECT/HUNK 120173 .
122776) (\INSPECT.DATATYPE.RAW.FETCH 122778 . 123104) (\INSPECT.FETCH.8 123106 . 123255) (
\INSPECT.FETCH.32 123257 . 123428) (\INSPECT.FETCH.CHAR 123430 . 123593) (\INSPECT.FETCH.FATCHAR
123595 . 123757) (\INSPECT.FETCH.PTR 123759 . 123930) (\INSPECT.STORE.8 123932 . 124238) (
\INSPECT.STORE.16 124240 . 124540) (\INSPECT.STORE.32 124542 . 124977) (\INSPECT.STORE.CHAR 124979 .
125305) (\INSPECT.STORE.FATCHAR 125307 . 125629) (\INSPECT.STORE.PTR 125631 . 125978) (
INSPECT/MAKE/CCODEP 125980 . 126131)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -42,7 +42,7 @@
# Any comments or problems, contact <ron.kaplan@post.harvard.edu>
# "353" SYMBOLS3
# "353" UNKNOWN
0xEB21 0x2119 # DOUBLE-STRUCK CAPITAL P
0xEB22 0x210B # SCRIPT CAPITAL H
0xEB23 0x2110 # SCRIPT CAPITAL I
@@ -53,7 +53,7 @@
0xEB28 0x203D # ‽ INTERROBANG
0xEB29 0x2318 # ⌘ PLACE OF INTEREST SIGN
0xEB2B 0x210C # BLACK-LETTER CAPITAL H
0xEB2D 0x1D53D # MATHEMATICAL DOUBLE-STRUCK CAPITAL F
0xEB2D 0x1D53D # 𝔽 MATHEMATICAL DOUBLE-STRUCK CAPITAL F
0xEB2E 0x21C5 # ⇅ UPWARDS ARROW LEFTWARDS OF DOWNWARDS ARROW
0xEB2F 0x21F5 # ⇵ DOWNWARDS ARROW LEFTWARDS OF UPWARDS ARROW
0xEB30 0x21E2 # ⇢ RIGHTWARDS DASHED ARROW

View File

@@ -42,7 +42,7 @@
# Any comments or problems, contact <ron.kaplan@post.harvard.edu>
# "51" RUNIC-GOTHIC
# "51" UNKNOWN
0x2922 0x16A0 # ᚠ RUNIC LETTER FEHU FEOH FE F
0x2924 0x16A2 # ᚢ RUNIC LETTER URUZ UR U
0x2927 0x16A6 # ᚦ RUNIC LETTER THURISAZ THURS THORN
@@ -87,31 +87,31 @@
0x29B5 0x16A3 # ᚣ RUNIC LETTER YR
0x29B6 0x16E0 # ᛠ RUNIC LETTER EAR
0x29B8 0x16E1 # ᛡ RUNIC LETTER IOR
0x29E1 0x10330 # GOTHIC LETTER AHSA
0x29E2 0x10331 # GOTHIC LETTER BAIRKAN
0x29E3 0x10332 # GOTHIC LETTER GIBA
0x29E4 0x10333 # GOTHIC LETTER DAGS
0x29E5 0x10334 # GOTHIC LETTER AIHVUS
0x29E6 0x10335 # GOTHIC LETTER QAIRTHRA
0x29E7 0x10336 # GOTHIC LETTER IUJA
0x29E8 0x10337 # GOTHIC LETTER HAGL
0x29E9 0x10338 # GOTHIC LETTER THIUTH
0x29EA 0x10339 0x0308 # GOTHIC LETTER EIS; COMBINING DIAERESIS
0x29EB 0x10339 # GOTHIC LETTER EIS
0x29EC 0x1033A # GOTHIC LETTER KUSMA
0x29ED 0x1033B # GOTHIC LETTER LAGUS
0x29EE 0x1033C # GOTHIC LETTER MANNA
0x29EF 0x1033D # GOTHIC LETTER NAUTHS
0x29F0 0x1033E # GOTHIC LETTER JER
0x29F1 0x1033F # GOTHIC LETTER URUS
0x29F2 0x10340 # GOTHIC LETTER PAIRTHRA
0x29F3 0x10341 # GOTHIC LETTER NINETY
0x29F4 0x10342 # GOTHIC LETTER RAIDA
0x29F5 0x10343 # GOTHIC LETTER SAUIL
0x29F6 0x10344 # GOTHIC LETTER TEIWS
0x29F7 0x10345 # GOTHIC LETTER WINJA
0x29F8 0x10346 # GOTHIC LETTER FAIHU
0x29F9 0x10347 # GOTHIC LETTER IGGWS
0x29FA 0x10348 # GOTHIC LETTER HWAIR
0x29FB 0x10349 # GOTHIC LETTER OTHAL
0x29FC 0x1034A # GOTHIC LETTER NINE HUNDRED
0x29E1 0x10330 # 𐌰 GOTHIC LETTER AHSA
0x29E2 0x10331 # 𐌱 GOTHIC LETTER BAIRKAN
0x29E3 0x10332 # 𐌲 GOTHIC LETTER GIBA
0x29E4 0x10333 # 𐌳 GOTHIC LETTER DAGS
0x29E5 0x10334 # 𐌴 GOTHIC LETTER AIHVUS
0x29E6 0x10335 # 𐌵 GOTHIC LETTER QAIRTHRA
0x29E7 0x10336 # 𐌶 GOTHIC LETTER IUJA
0x29E8 0x10337 # 𐌷 GOTHIC LETTER HAGL
0x29E9 0x10338 # 𐌸 GOTHIC LETTER THIUTH
0x29EA 0x10339 0x0308 # 𐌹̈ GOTHIC LETTER EIS; COMBINING DIAERESIS
0x29EB 0x10339 # 𐌹 GOTHIC LETTER EIS
0x29EC 0x1033A # 𐌺 GOTHIC LETTER KUSMA
0x29ED 0x1033B # 𐌻 GOTHIC LETTER LAGUS
0x29EE 0x1033C # 𐌼 GOTHIC LETTER MANNA
0x29EF 0x1033D # 𐌽 GOTHIC LETTER NAUTHS
0x29F0 0x1033E # 𐌾 GOTHIC LETTER JER
0x29F1 0x1033F # 𐌿 GOTHIC LETTER URUS
0x29F2 0x10340 # 𐍀 GOTHIC LETTER PAIRTHRA
0x29F3 0x10341 # 𐍁 GOTHIC LETTER NINETY
0x29F4 0x10342 # 𐍂 GOTHIC LETTER RAIDA
0x29F5 0x10343 # 𐍃 GOTHIC LETTER SAUIL
0x29F6 0x10344 # 𐍄 GOTHIC LETTER TEIWS
0x29F7 0x10345 # 𐍅 GOTHIC LETTER WINJA
0x29F8 0x10346 # 𐍆 GOTHIC LETTER FAIHU
0x29F9 0x10347 # 𐍇 GOTHIC LETTER IGGWS
0x29FA 0x10348 # 𐍈 GOTHIC LETTER HWAIR
0x29FB 0x10349 # 𐍉 GOTHIC LETTER OTHAL
0x29FC 0x1034A # 𐍊 GOTHIC LETTER NINE HUNDRED

View File

@@ -1,7 +1,7 @@
#
# Name: XCCS (XC-3-1-1-0) to Unicode
# Unicode version: 3.0
# XCCS charset: 56 DECORATED-RULES
# XCCS charset: 56 UNKNOWN
# Table version: 0.1
# Table format: Format A
# Date: 9-Aug-2021
@@ -42,7 +42,7 @@
# Any comments or problems, contact <ron.kaplan@post.harvard.edu>
# "56" DECORATED-RULES
# "56" UNKNOWN
0x2E21 0x2500 # ─ BOX DRAWINGS LIGHT HORIZONTAL
0x2E22 0x23AF # ⎯ HORIZONTAL LINE EXTENSION
0x2E23 0x2501 # ━ BOX DRAWINGS HEAVY HORIZONTAL

View File

@@ -1,7 +1,7 @@
#
# Name: XCCS (XC-3-1-1-0) to Unicode
# Unicode version: 3.0
# XCCS charset: 57 VERTICAL-JAPANESE
# XCCS charset: 57 UNKNOWN
# Table version: 0.1
# Table format: Format A
# Date: 9-Aug-2021
@@ -42,7 +42,7 @@
# Any comments or problems, contact <ron.kaplan@post.harvard.edu>
# "57" VERTICAL-JAPANESE
# "57" UNKNOWN
0x2F24 0xFE33 # ︳ PRESENTATION FORM FOR VERTICAL LOW LINE
0x2F26 0xFE31 # ︱ PRESENTATION FORM FOR VERTICAL EM DASH
0x2F2B 0x22EE # ⋮ VERTICAL ELLIPSIS