Compare commits
5 Commits
medley-241
...
fgh_lfg-lo
| Author | SHA1 | Date | |
|---|---|---|---|
|
d91176bc90 | ||
|
|
a55246bc59 | ||
|
5b37dd09db | ||
|
|
33a53e47e1 | ||
|
|
db33a50af3 |
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Dec-2024 22:19:48" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;198 119318
|
||||
(FILECREATED "22-Dec-2024 22:47:22" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;200 119344
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS MB.NWAY.CREATE)
|
||||
:CHANGES-TO (FNS MB.3STATE.BUTTONEVENTINFN)
|
||||
|
||||
:PREVIOUS-DATE "18-Dec-2024 14:02:17" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;197)
|
||||
:PREVIOUS-DATE "20-Dec-2024 22:19:48" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;198)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
|
||||
@@ -732,6 +732,7 @@
|
||||
|
||||
(MB.3STATE.BUTTONEVENTINFN
|
||||
[LAMBDA (OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)
|
||||
(* ; "Edited 22-Dec-2024 22:45 by rmk")
|
||||
(* ; "Edited 7-Dec-2024 13:11 by rmk")
|
||||
(* ; "Edited 5-Dec-2024 21:53 by rmk")
|
||||
(* ; "Edited 18-Oct-2024 12:00 by rmk")
|
||||
@@ -750,33 +751,32 @@
|
||||
|
||||
(* ;; "This brings up the display for the next state, tracks the mouse until either it leaves the object or the buttons come up. If the mouse leaves, the original highlighting is restored. Otherwise the state of the obj is advanced to its next state. Either way, we report that the %"selection%" didn't succeed.")
|
||||
|
||||
(if (EQ 'DON'T (MB.BUTTONEVENTINFN OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON))
|
||||
then 'DON'T
|
||||
else (LET [(NEXTSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE)
|
||||
(ON 'OFF)
|
||||
(OFF 'NEUTRAL)
|
||||
(NEUTRAL 'ON)
|
||||
(\TEDIT.THELP "ILLEGAL 3STATE" (IMAGEOBJPROP OBJ 'STATE]
|
||||
(RESETLST
|
||||
(CL:UNLESS (EQ 'DON'T (MB.BUTTONEVENTINFN OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)
|
||||
)
|
||||
(LET [(NEXTSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE)
|
||||
(ON 'OFF)
|
||||
(OFF 'NEUTRAL)
|
||||
(NEUTRAL 'ON)
|
||||
(\TEDIT.THELP "ILLEGAL 3STATE" (IMAGEOBJPROP OBJ 'STATE]
|
||||
(RESETLST
|
||||
|
||||
(* ;;
|
||||
"In case of an error or interrupt, make the display consistent with the state")
|
||||
(* ;; "In case of an error or interrupt, make the display consistent with the state")
|
||||
|
||||
[RESETSAVE NIL `(PROGN (CL:WHEN RESETSTATE
|
||||
(MB.3STATE.SHOWSELFN ,OBJ ,MENUDS (IMAGEOBJPROP
|
||||
,OBJ
|
||||
'STATE)))]
|
||||
(MB.3STATE.SHOWSELFN OBJ MENUDS NEXTSTATE)
|
||||
[if (EQ 'DON'T (MB.TRACK.UNTIL OBJ MENUDS))
|
||||
then (* ; "Mouse moved out of object")
|
||||
(MB.3STATE.SHOWSELFN OBJ MENUDS (IMAGEOBJPROP OBJ 'STATE))
|
||||
else (* ; "Buttons came up: do it")
|
||||
(IMAGEOBJPROP OBJ 'STATE NEXTSTATE)
|
||||
(CL:WHEN (SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN))
|
||||
(APPLY* STATECHANGEFN OBJ NEXTSTATE (fetch (TEXTWINDOW WTEXTSTREAM)
|
||||
of MENUDS)))])
|
||||
(TEDIT.BACKTOMAIN MENUTSTREAM)
|
||||
NIL])
|
||||
[RESETSAVE NIL `(PROGN (CL:WHEN RESETSTATE
|
||||
(MB.3STATE.SHOWSELFN ,OBJ ,MENUDS (IMAGEOBJPROP
|
||||
,OBJ
|
||||
'STATE)))]
|
||||
(MB.3STATE.SHOWSELFN OBJ MENUDS NEXTSTATE)
|
||||
[if (EQ 'DON'T (MB.TRACK.UNTIL OBJ MENUDS))
|
||||
then (* ; "Mouse moved out of object")
|
||||
(MB.3STATE.SHOWSELFN OBJ MENUDS (IMAGEOBJPROP OBJ 'STATE))
|
||||
else (* ; "Buttons came up: do it")
|
||||
(IMAGEOBJPROP OBJ 'STATE NEXTSTATE)
|
||||
(CL:WHEN (SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN))
|
||||
(APPLY* STATECHANGEFN OBJ NEXTSTATE (fetch (TEXTWINDOW WTEXTSTREAM)
|
||||
of MENUDS)))])
|
||||
(TEDIT.BACKTOMAIN MENUTSTREAM)))
|
||||
'DON'T])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1917,25 +1917,25 @@
|
||||
(MB.FIELD.INIT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3448 19023 (MB.ADD 3458 . 9047) (MB.DELETE 9049 . 9423) (MB.GET 9425 . 16088) (
|
||||
MB.GET.MBARG 16090 . 17759) (TEDITMENU.STREAM 17761 . 18428) (TEDIT.BACKTOMAIN 18430 . 19021)) (19067
|
||||
36833 (MB.BUTTONEVENTINFN 19077 . 20286) (MB.DISPLAYFN 20288 . 22347) (MB.SETIMAGE 22349 . 23517) (
|
||||
MB.SIZEFN 23519 . 25067) (MB.WHENOPERATEDONFN 25069 . 27018) (MB.COPYFN 27020 . 27478) (MB.GETFN 27480
|
||||
. 28441) (MB.PUTFN 28443 . 29543) (MB.SHOWSELFN 29545 . 31054) (MB.CREATE 31056 . 34041) (
|
||||
MB.CHANGENAME 34043 . 34525) (MB.INIT 34527 . 35836) (MB.TRACK.UNTIL 35838 . 36533) (MB.DON'T 36535 .
|
||||
36831)) (37058 46874 (MB.3STATE.CREATE 37068 . 37932) (MB.3STATE.DISPLAYFN 37934 . 38920) (
|
||||
MB.3STATE.SHOWSELFN 38922 . 41233) (MB.3STATE.INIT 41235 . 42487) (MB.3STATE.SETSTATEFN 42489 . 43147)
|
||||
(MB.3STATE.BUTTONEVENTINFN 43149 . 46872)) (47099 76218 (MB.NWAY.CREATE 47109 . 52619) (
|
||||
MB.NWAY.DISPLAYFN 52621 . 53484) (MB.NWAY.WHENOPERATEDONFN 53486 . 55676) (MB.NWAY.SIZEFN 55678 .
|
||||
59614) (MB.NWAY.SELECT 59616 . 62426) (MB.NWAY.BUTTONEVENTINFN 62428 . 65640) (MB.NWAY.NEWMENUBUTTON
|
||||
65642 . 66354) (MB.NWAY.COPYFN 66356 . 67323) (MB.NWAY.INIT 67325 . 68659) (MB.NWAY.ARRANGEBUTTONS
|
||||
68661 . 70632) (MB.NWAY.ADDITEM 70634 . 74396) (MB.NWAY.FINDSUBOBJ 74398 . 74912) (MB.NWAY.SETSTATEFN
|
||||
74914 . 76216)) (76365 88093 (MB.TOGGLE.CREATE 76375 . 77370) (MB.TOGGLE.DISPLAYFN 77372 . 78855) (
|
||||
MB.TOGGLE.INIT 78857 . 80497) (MB.SET.TOGGLE 80499 . 81700) (MB.TOGGLE.SETSTATEFN 81702 . 82542) (
|
||||
MB.TOGGLE.BUTTONEVENTINFN 82544 . 86748) (MB.TOGGLE.WHENOPERATEDONFN 86750 . 88091)) (88244 119170 (
|
||||
MB.FIELD.CREATE 88254 . 92989) (MB.FIELD.DISPLAYFN 92991 . 93782) (MB.FIELD.IMAGEBOXFN 93784 . 95266)
|
||||
(MB.FIELD.PREFIXCREATE 95268 . 98820) (MB.FIELD.SUFFIXCREATE 98822 . 100482) (MB.FIELD.INIT 100484 .
|
||||
102093) (MB.FIELD.WHENOPERATEDONFN 102095 . 103366) (MB.FIELD.GETSTATEFN 103368 . 107302) (
|
||||
MB.FIELD.SETSTATEFN 107304 . 111999) (MB.FIELD.BUTTONEVENTINFN 112001 . 114306) (MB.FIELD.SIZEFN
|
||||
114308 . 114548) (MB.FIELD.INSURETYPE 114550 . 119168)))))
|
||||
(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.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-Dec-2024 11:25:16" {WMEDLEY}<library>tedit>TEDIT-FILE.;591 159329
|
||||
(FILECREATED "23-Dec-2024 23:02:54" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;592 159471
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS TEDITFROMSHELLSCRIPT)
|
||||
:CHANGES-TO (FNS TEDIT.PUT TEDIT.PUT.STREAM)
|
||||
|
||||
:PREVIOUS-DATE "15-Dec-2024 11:47:29" {WMEDLEY}<library>tedit>TEDIT-FILE.;590)
|
||||
:PREVIOUS-DATE "16-Dec-2024 11:25:16" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;591)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-FILECOMS)
|
||||
@@ -389,7 +389,8 @@
|
||||
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
|
||||
|
||||
(TEDIT.PUT
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 11-Aug-2024 12:30 by rmk")
|
||||
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 23-Dec-2024 23:02 by rmk")
|
||||
(* ; "Edited 11-Aug-2024 12:30 by rmk")
|
||||
(* ; "Edited 29-Jun-2024 10:31 by rmk")
|
||||
(* ; "Edited 26-Jun-2024 15:46 by rmk")
|
||||
(* ; "Edited 29-Apr-2024 10:12 by rmk")
|
||||
@@ -507,7 +508,8 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done"))
|
||||
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")
|
||||
T)
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@@ -2509,28 +2511,28 @@
|
||||
|
||||
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5010 33799 (TEDIT.GET 5020 . 11029) (TEDIT.FORMATTEDFILEP 11031 . 12347) (
|
||||
TEDIT.FILEDATE 12349 . 13520) (TEDIT.INCLUDE 13522 . 21433) (TEDIT.RAW.INCLUDE 21435 . 22243) (
|
||||
TEDIT.PUT 22245 . 29964) (TEDIT.PUT.STREAM 29966 . 33797)) (33800 52997 (\TEDIT.GET.FOREIGN.FILE 33810
|
||||
. 36995) (\TEDIT.GET.UNFORMATTED.FILE 36997 . 40871) (\TEDIT.GET.FORMATTED.FILE 40873 . 43694) (
|
||||
\TEDIT.FORMATTEDSTREAMP 43696 . 46596) (\ARBIN 46598 . 47318) (\ATMIN 47320 . 47857) (\DWIN 47859 .
|
||||
48238) (\STRINGIN 48240 . 48948) (\TEDIT.GET.TRAILER 48950 . 51466) (\TEDIT.CACHEFILE 51468 . 52995))
|
||||
(53163 66713 (\TEDIT.GET.PIECES3 53173 . 63475) (\TEDIT.GET.IDATE3 63477 . 64872) (
|
||||
\TEDIT.MAKE.STRINGPIECE 64874 . 66711)) (66714 79089 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66724 . 72840)
|
||||
(\TEDIT.INTERPRET.XCCS.SHIFTS 72842 . 79087)) (79111 85133 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79121 .
|
||||
85131)) (85156 93847 (\TEDIT.GET.CHARLOOKS.LIST 85166 . 85897) (\TEDIT.GET.SINGLE.CHARLOOKS 85899 .
|
||||
90659) (\TEDIT.GET.CHARLOOKS 90661 . 91991) (\TEDIT.GET.PARALOOKS.INDEX 91993 . 92537) (
|
||||
\TEDIT.GET.CHARLOOKS.INDEX 92539 . 93845)) (93848 101016 (\TEDIT.GET.PARALOOKS.LIST 93858 . 94480) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS 94482 . 101014)) (101017 104607 (\TEDIT.GET.OBJECT 101027 . 104605)) (
|
||||
104669 136931 (\TEDIT.PUT.PCTB 104679 . 114329) (\TEDIT.PUT.PCTB.PIECEDATA 114331 . 117529) (
|
||||
\TEDIT.PUT.TRAILER 117531 . 118298) (\TEDIT.PUT.PCTB.MERGEABLE 118300 . 121734) (
|
||||
\TEDIT.PUT.UTF8.SPLITPIECES 121736 . 126823) (\TEDIT.PUT.PCTB.NEXTNEW 126825 . 131092) (
|
||||
\TEDIT.INSERT.NEWPIECES 131094 . 134529) (\TEDIT.PUTRESET 134531 . 134773) (\ARBOUT 134775 . 135499) (
|
||||
\ATMOUT 135501 . 136106) (\DWOUT 136108 . 136387) (\STRINGOUT 136389 . 136929)) (136932 148915 (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 136942 . 138614) (\TEDIT.PUT.SINGLE.CHARLOOKS 138616 . 144259) (
|
||||
\TEDIT.PUT.CHARLOOKS 144261 . 145486) (\TEDIT.PUT.CHARLOOKS1 145488 . 146539) (\TEDIT.PUT.OBJECT
|
||||
146541 . 148913)) (148916 156410 (\TEDIT.PUT.PARALOOKS.LIST 148926 . 149828) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 149830 . 155269) (\TEDIT.PUT.PARALOOKS 155271 . 156408)) (156505 159099 (
|
||||
TEDITFROMLISPSOURCE 156515 . 158348) (SHELLSCRIPTP 158350 . 158579) (TEDITFROMSHELLSCRIPT 158581 .
|
||||
159097)))))
|
||||
(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.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "22-Dec-2024 00:24:03" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;425 169589
|
||||
(FILECREATED "24-Dec-2024 21:29:07" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;426 169660
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.OTHER.STATECHANGEFN \TEDIT.OTHER.SELECTFN \TEDIT.CHARMENU.SPEC)
|
||||
:CHANGES-TO (FNS \TEDIT.CHANGE.PAGELOOKS)
|
||||
|
||||
:PREVIOUS-DATE "20-Dec-2024 22:07:54" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;424)
|
||||
:PREVIOUS-DATE "22-Dec-2024 00:24:03" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;425)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-MENUCOMS)
|
||||
@@ -2478,7 +2478,8 @@
|
||||
(TEDIT.BACKTOMAIN MENUSTREAM])
|
||||
|
||||
(\TEDIT.CHANGE.PAGELOOKS
|
||||
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 20-Oct-2024 17:17 by rmk")
|
||||
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 24-Dec-2024 21:28 by rmk")
|
||||
(* ; "Edited 20-Oct-2024 17:17 by rmk")
|
||||
(* ; "Edited 30-Aug-2024 23:43 by rmk")
|
||||
(* ; "Edited 15-Aug-2024 14:48 by rmk")
|
||||
(* ; "Edited 12-Aug-2024 23:34 by rmk")
|
||||
@@ -2487,7 +2488,7 @@
|
||||
(PAGEID (LISTGET PAGELOOKS 'PAGEID))
|
||||
[PAGENOS (STRING.EQUAL 'Yes (LISTGET PAGELOOKS 'PAGENOS]
|
||||
PAGEPROPS)
|
||||
(CL:UNLESS PAGEID
|
||||
(CL:WHEN (EQ 'OFF PAGEID)
|
||||
(TEDIT.PROMPTPRINT MAINTEXTSTREAM "Please specify a page type" T T)
|
||||
(RETURN))
|
||||
(for PLTAIL on PAGELOOKS by (CDDR PLTAIL) do (SELECTQ (CADR PLTAIL)
|
||||
@@ -2657,28 +2658,28 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5405 51363 (DRAWMARGINSCALE 5415 . 8874) (MARGINBAR 8876 . 16001) (MARGINBAR.CREATE
|
||||
16003 . 19422) (MB.MARGINBAR.BUTTONEVENTINFN 19424 . 27092) (MB.MARGINBAR.SELFN.TABS 27094 . 32457) (
|
||||
MB.MARGINBAR.SELFN.TABS.KIND 32459 . 33394) (MARGINBAR.GETSTATEFN 33396 . 37274) (MARGINBAR.SETSTATEFN
|
||||
37276 . 37486) (MARGINBAR.NEUTRALIZE 37488 . 37901) (MARGINBAR.LOOKS 37903 . 41009) (
|
||||
MB.MARGINBAR.SIZEFN 41011 . 41614) (MB.MARGINBAR.DISPLAYFN 41616 . 44677) (MDESCALE 44679 . 45219) (
|
||||
MSCALE 45221 . 45551) (MB.MARGINBAR.SHOWTAB 45553 . 47876) (MB.MARGINBAR.TABTRACK 47878 . 49263) (
|
||||
MARGINBAR.INIT 49265 . 50335) (\TEDIT.FMTSPECTOMARBAR 50337 . 51361)) (52257 58474 (\TEDIT.MENU.START
|
||||
52267 . 57898) (\TEDIT.MENU.BUTTONEVENTFN 57900 . 58472)) (58793 66497 (\TEDIT.MENU.CREATE 58803 .
|
||||
60614) (\TEDIT.MENU.PARSE 60616 . 64305) (\TEDIT.MENU.NEUTRALIZE 64307 . 66160) (
|
||||
\TEDITMENU.RECORD.UNFORMATTED 66162 . 66495)) (66562 87931 (\TEDIT.DEFAULTMENU.CREATE 66572 . 73587) (
|
||||
\TEDIT.EXPANDED.MENU 73589 . 74880) (\TEDIT.DEFAULTMENU.FN 74882 . 78026) (\TEDIT.DEFAULTMENU.ACTIONFN
|
||||
78028 . 87372) (TEDIT.MENUSTREAM 87374 . 87929)) (87993 105320 (\TEDIT.PARAMENU.CREATE 88003 . 96405)
|
||||
(\TEDIT.APPLY.PARALOOKS 96407 . 97295) (\TEDIT.SHOW.PARALOOKS 97297 . 100080) (
|
||||
\TEDIT.EXPANDEDPARA.MENU 100082 . 100856) (\TEDIT.PARAMENU.FILLIN 100858 . 105318)) (105382 132271 (
|
||||
\TEDIT.CHARMENU.CREATE 105392 . 108238) (\TEDIT.CHARMENU.SPEC 108240 . 114395) (\TEDIT.CHARMENU.PARSE
|
||||
114397 . 117565) (\TEDIT.CHARMENU.FILLIN 117567 . 121743) (\TEDIT.SHOW.CHARLOOKS 121745 . 124852) (
|
||||
\TEDIT.EXPANDEDCHAR.MENU 124854 . 125778) (\TEDIT.APPLY.CHARLOOKS 125780 . 126777) (
|
||||
\TEDIT.OFFSETTYPE.STATEFN 126779 . 128742) (\TEDIT.OTHER.STATECHANGEFN 128744 . 130144) (
|
||||
\TEDIT.OTHER.SELECTFN 130146 . 132269)) (132333 163343 (\TEDIT.PAGEMENU.CREATE 132343 . 144389) (
|
||||
\TEDIT.SHOW.PAGELOOKS 144391 . 146186) (\TEDIT.PAGEMENU.FILLIN 146188 . 147738) (
|
||||
\TEDIT.PAGEREGION.UNPARSE 147740 . 156930) (\TEDIT.APPLY.PAGELOOKS 156932 . 158695) (
|
||||
\TEDIT.CHANGE.PAGELOOKS 158697 . 162499) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 162501 . 163341)) (163344
|
||||
169147 (\TEDIT.PAGEMENU.CREATE.HEADINGS 163354 . 166166) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 166168
|
||||
. 167593) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 167595 . 169145)))))
|
||||
(FILEMAP (NIL (5359 51317 (DRAWMARGINSCALE 5369 . 8828) (MARGINBAR 8830 . 15955) (MARGINBAR.CREATE
|
||||
15957 . 19376) (MB.MARGINBAR.BUTTONEVENTINFN 19378 . 27046) (MB.MARGINBAR.SELFN.TABS 27048 . 32411) (
|
||||
MB.MARGINBAR.SELFN.TABS.KIND 32413 . 33348) (MARGINBAR.GETSTATEFN 33350 . 37228) (MARGINBAR.SETSTATEFN
|
||||
37230 . 37440) (MARGINBAR.NEUTRALIZE 37442 . 37855) (MARGINBAR.LOOKS 37857 . 40963) (
|
||||
MB.MARGINBAR.SIZEFN 40965 . 41568) (MB.MARGINBAR.DISPLAYFN 41570 . 44631) (MDESCALE 44633 . 45173) (
|
||||
MSCALE 45175 . 45505) (MB.MARGINBAR.SHOWTAB 45507 . 47830) (MB.MARGINBAR.TABTRACK 47832 . 49217) (
|
||||
MARGINBAR.INIT 49219 . 50289) (\TEDIT.FMTSPECTOMARBAR 50291 . 51315)) (52211 58428 (\TEDIT.MENU.START
|
||||
52221 . 57852) (\TEDIT.MENU.BUTTONEVENTFN 57854 . 58426)) (58747 66451 (\TEDIT.MENU.CREATE 58757 .
|
||||
60568) (\TEDIT.MENU.PARSE 60570 . 64259) (\TEDIT.MENU.NEUTRALIZE 64261 . 66114) (
|
||||
\TEDITMENU.RECORD.UNFORMATTED 66116 . 66449)) (66516 87885 (\TEDIT.DEFAULTMENU.CREATE 66526 . 73541) (
|
||||
\TEDIT.EXPANDED.MENU 73543 . 74834) (\TEDIT.DEFAULTMENU.FN 74836 . 77980) (\TEDIT.DEFAULTMENU.ACTIONFN
|
||||
77982 . 87326) (TEDIT.MENUSTREAM 87328 . 87883)) (87947 105274 (\TEDIT.PARAMENU.CREATE 87957 . 96359)
|
||||
(\TEDIT.APPLY.PARALOOKS 96361 . 97249) (\TEDIT.SHOW.PARALOOKS 97251 . 100034) (
|
||||
\TEDIT.EXPANDEDPARA.MENU 100036 . 100810) (\TEDIT.PARAMENU.FILLIN 100812 . 105272)) (105336 132225 (
|
||||
\TEDIT.CHARMENU.CREATE 105346 . 108192) (\TEDIT.CHARMENU.SPEC 108194 . 114349) (\TEDIT.CHARMENU.PARSE
|
||||
114351 . 117519) (\TEDIT.CHARMENU.FILLIN 117521 . 121697) (\TEDIT.SHOW.CHARLOOKS 121699 . 124806) (
|
||||
\TEDIT.EXPANDEDCHAR.MENU 124808 . 125732) (\TEDIT.APPLY.CHARLOOKS 125734 . 126731) (
|
||||
\TEDIT.OFFSETTYPE.STATEFN 126733 . 128696) (\TEDIT.OTHER.STATECHANGEFN 128698 . 130098) (
|
||||
\TEDIT.OTHER.SELECTFN 130100 . 132223)) (132287 163414 (\TEDIT.PAGEMENU.CREATE 132297 . 144343) (
|
||||
\TEDIT.SHOW.PAGELOOKS 144345 . 146140) (\TEDIT.PAGEMENU.FILLIN 146142 . 147692) (
|
||||
\TEDIT.PAGEREGION.UNPARSE 147694 . 156884) (\TEDIT.APPLY.PAGELOOKS 156886 . 158649) (
|
||||
\TEDIT.CHANGE.PAGELOOKS 158651 . 162570) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 162572 . 163412)) (163415
|
||||
169218 (\TEDIT.PAGEMENU.CREATE.HEADINGS 163425 . 166237) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 166239
|
||||
. 167664) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 167666 . 169216)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "11-Dec-2024 22:39:52" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;198 121611
|
||||
(FILECREATED "24-Dec-2024 21:32:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;200 121366
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-PAGECOMS)
|
||||
(FNS \TEDIT.FORMATPAGE \TEDIT.HARDCOPY.PAGEHEADINGS \TEDIT.FORMATTEXTBOX
|
||||
\TEDIT.HARDCOPY-COLUMN-END)
|
||||
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
|
||||
|
||||
:PREVIOUS-DATE "11-Dec-2024 20:59:29" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;196)
|
||||
:PREVIOUS-DATE "11-Dec-2024 22:39:52" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;198)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-PAGECOMS)
|
||||
@@ -309,7 +307,8 @@
|
||||
|
||||
(TEDIT.SINGLE.PAGEFORMAT
|
||||
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
|
||||
PAGEPROPS PAPERSIZE) (* ; "Edited 15-Aug-2024 23:01 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")
|
||||
(* ; "Edited 10-Aug-2023 08:14 by rmk")
|
||||
@@ -385,29 +384,29 @@
|
||||
FORMATINFO
|
||||
,(LISTGET PAGEPROPS 'FOLIOINFO])
|
||||
(CL:WHEN HEADINGS
|
||||
[SETQ HEADINGREGIONS (for HDG LEFT in HEADINGS
|
||||
collect
|
||||
[SETQ HEADINGREGIONS
|
||||
(for HDG LEFT in HEADINGS when (CAR HDG)
|
||||
collect
|
||||
|
||||
(* ;; "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.")
|
||||
(* ;; "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.")
|
||||
|
||||
(SETQ LEFT (SCALEPAGEXUNITS (CADR HDG)
|
||||
SCALEFACTOR PAPERSIZE LANDSCAPE?))
|
||||
(create PAGEREGION
|
||||
REGIONFILLMETHOD _ 'HEADING
|
||||
REGIONSPEC _ (create REGION
|
||||
LEFT _ LEFT
|
||||
BOTTOM _ (SCALEPAGEYUNITS
|
||||
(CADDR HDG)
|
||||
SCALEFACTOR
|
||||
PAPERSIZE LANDSCAPE?
|
||||
)
|
||||
WIDTH _
|
||||
(IMAX (IDIFFERENCE PAPERWIDTH
|
||||
LEFT)
|
||||
PTSPERINCH)
|
||||
HEIGHT _ (IQUOTIENT PTSPERINCH
|
||||
2))
|
||||
REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR HDG]
|
||||
(if (AND (NUMBERP (CADR HDG))
|
||||
(NUMBERP (CADDR HDG)))
|
||||
then (SETQ LEFT (SCALEPAGEXUNITS (CADR HDG)
|
||||
SCALEFACTOR PAPERSIZE LANDSCAPE?))
|
||||
(create PAGEREGION
|
||||
REGIONFILLMETHOD _ 'HEADING
|
||||
REGIONSPEC _ (create REGION
|
||||
LEFT _ LEFT
|
||||
BOTTOM _ (SCALEPAGEYUNITS (CADDR HDG)
|
||||
SCALEFACTOR PAPERSIZE
|
||||
LANDSCAPE?)
|
||||
WIDTH _ (IMAX (IDIFFERENCE PAPERWIDTH
|
||||
LEFT)
|
||||
PTSPERINCH)
|
||||
HEIGHT _ (IQUOTIENT PTSPERINCH 2))
|
||||
REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR HDG)))
|
||||
else (ERROR (CONCAT "Invalid X/Y position for heading-type " (CAR HDG]
|
||||
(SETQ SUBREGIONS (APPEND SUBREGIONS HEADINGREGIONS)))
|
||||
[COND
|
||||
[(OR (NULL COLS)
|
||||
@@ -1896,15 +1895,15 @@
|
||||
(RETURN (DREMOVE NIL $$VAL])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (11936 15548 (\TEDIT.PARSE.PAGEFRAMES 11946 . 13725) (\TEDIT.PUT.PAGEFRAMES 13727 .
|
||||
14551) (\TEDIT.UNPARSE.PAGEFRAMES 14553 . 15546)) (15611 36874 (TEDIT.SINGLE.PAGEFORMAT 15621 . 25860)
|
||||
(TEDIT.COMPOUND.PAGEFORMAT 25862 . 26841) (TEDIT.PAGEFORMAT 26843 . 34132) (TEDIT.GET.PAGEFORMAT
|
||||
34134 . 36872)) (37161 47663 (TEDIT.FORMAT.HARDCOPY 37171 . 47661)) (47750 99231 (\TEDIT.FORMATBOX
|
||||
47760 . 60863) (\TEDIT.FORMATHEADING 60865 . 65387) (\TEDIT.FORMATPAGE 65389 . 73919) (
|
||||
\TEDIT.FORMATTEXTBOX 73921 . 89845) (\TEDIT.FORMATFOLIO 89847 . 95201) (\TEDIT.FORMAT.FOUNDBOX? 95203
|
||||
. 97242) (\TEDIT.SKIP.SPECIALCOND 97244 . 99229)) (99311 101841 (\TEDIT.HARDCOPY.PAGEHEADINGS 99321
|
||||
. 101839)) (101950 109679 (\TEDIT.HARDCOPY-COLUMN-END 101960 . 109677)) (109724 114665 (
|
||||
SCALEPAGEUNITS 109734 . 110875) (SCALEPAGEXUNITS 110877 . 111647) (SCALEPAGEYUNITS 111649 . 112420) (
|
||||
\TEDIT.PAPERHEIGHT 112422 . 113357) (\TEDIT.PAPERWIDTH 113359 . 114663)) (115081 118649 (ROMANNUMERALS
|
||||
115091 . 118647)) (118685 121588 (\TEDIT.FORMAT.FOOTNOTE 118695 . 121586)))))
|
||||
(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.
@@ -1,13 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Dec-2024 23:51:30" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;839 186344
|
||||
(FILECREATED "24-Dec-2024 22:16:22" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;845 185725
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.FORMATLINE \TEDIT.DISPLAYLINE \TEDIT.FORMATLINE.UPDATELOOKS)
|
||||
(RECORDS LINEDESCRIPTOR)
|
||||
:CHANGES-TO (FNS \TEDIT.FORMATLINE)
|
||||
|
||||
:PREVIOUS-DATE "13-Dec-2024 15:41:40" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;835)
|
||||
:PREVIOUS-DATE "19-Dec-2024 11:51:04" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;840)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||
@@ -688,6 +687,8 @@
|
||||
|
||||
(\TEDIT.FORMATLINE
|
||||
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 24-Dec-2024 22:15 by rmk")
|
||||
(* ; "Edited 23-Dec-2024 19:47 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 23:46 by rmk")
|
||||
(* ; "Edited 12-Dec-2024 15:20 by rmk")
|
||||
(* ; "Edited 9-Dec-2024 21:05 by rmk")
|
||||
@@ -698,20 +699,10 @@
|
||||
(* ; "Edited 2-Sep-2024 16:06 by rmk")
|
||||
(* ; "Edited 27-Aug-2024 18:29 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 18:07 by rmk")
|
||||
(* ; "Edited 29-Jul-2024 23:30 by rmk")
|
||||
(* ; "Edited 28-Jun-2024 21:51 by rmk")
|
||||
(* ; "Edited 25-Jun-2024 15:43 by rmk")
|
||||
(* ; "Edited 13-Jun-2024 17:26 by rmk")
|
||||
(* ; "Edited 21-May-2024 14:45 by rmk")
|
||||
(* ; "Edited 10-May-2024 12:11 by rmk")
|
||||
(* ; "Edited 17-Mar-2024 00:27 by rmk")
|
||||
(* ; "Edited 15-Mar-2024 19:43 by rmk")
|
||||
(* ; "Edited 14-Mar-2024 12:53 by rmk")
|
||||
(* ; "Edited 2-Mar-2024 07:39 by rmk")
|
||||
(* ; "Edited 5-Feb-2024 09:35 by rmk")
|
||||
(* ; "Edited 26-Jan-2024 11:01 by rmk")
|
||||
(* ; "Edited 3-Dec-2023 16:48 by rmk")
|
||||
(* ; "Edited 27-Nov-2023 23:05 by rmk")
|
||||
(* ; "Edited 28-Oct-2023 13:14 by rmk")
|
||||
(* ; "Edited 24-Jul-2023 23:13 by rmk")
|
||||
(* ; "Edited 23-Oct-2022 09:11 by rmk")
|
||||
@@ -822,16 +813,6 @@
|
||||
|
||||
(* ;; "We have the true starting piece and CH#1")
|
||||
|
||||
[if (REGIONP REGION)
|
||||
then (SETQ WMARGIN (ffetch (REGION LEFT) of REGION))
|
||||
(* ;
|
||||
"Presumably hardcopy in different page regions.")
|
||||
(SETQ WIDTH (ffetch (REGION WIDTH) of REGION))
|
||||
else (SETQ WMARGIN \TEDIT.LINEREGION.WIDTH) (* ;
|
||||
"A little more display margin on both sides")
|
||||
(SETQ WIDTH (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT)
|
||||
(UNFOLD WMARGIN 2]
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(SETQ LINETYPE (if (NOT (DISPLAYSTREAMP IMAGESTREAM))
|
||||
@@ -846,6 +827,25 @@
|
||||
|
||||
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
|
||||
(SETQ SCALE (FGETPARA FMTSPEC FMTHARDCOPYSCALE))
|
||||
[if (REGIONP REGION)
|
||||
then (SETQ WMARGIN (ffetch (REGION LEFT) of REGION))
|
||||
(* ;
|
||||
"Presumably hardcopy in different page regions.")
|
||||
(SETQ WIDTH (ffetch (REGION WIDTH) of REGION))
|
||||
else (SETQ WMARGIN \TEDIT.LINEREGION.WIDTH) (* ;
|
||||
"A little more display margin on both sides")
|
||||
(SETQ WIDTH (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT)
|
||||
(UNFOLD WMARGIN 2]
|
||||
(SETQ RIGHTMARGIN (if (ZEROP (FGETPARA FMTSPEC RIGHTMAR))
|
||||
then
|
||||
(* ;; "RIGHTMAR = 0 => follow the window/region's width")
|
||||
|
||||
(CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(ITIMES SCALE WIDTH)
|
||||
WIDTH)
|
||||
else (FGETPARA FMTSPEC RIGHTMAR)))
|
||||
|
||||
(* ;; "Account for first-line indentation from the true left margin (LEFTMAR)")
|
||||
|
||||
(* ;; "This line starts a paragraph if it starts the document or it is at the beginning of a piece just after a last-paragraph piece. This assumes that only visible pieces matter; otherwise, use PREVPIECE.")
|
||||
|
||||
@@ -853,18 +853,9 @@
|
||||
(AND (IEQP CH#1 START-OF-PIECE)
|
||||
(OR (NOT (\PREV.VISIBLE.PIECE PC))
|
||||
(PPARALAST (\PREV.VISIBLE.PIECE PC]
|
||||
|
||||
(* ;; "Account for first-line indentation from the true left margin (LEFTMAR)")
|
||||
|
||||
(SETQ LX1 (CL:IF 1STLN
|
||||
(FGETPARA FMTSPEC 1STLEFTMAR)
|
||||
(FGETPARA FMTSPEC LEFTMAR)))
|
||||
(SETQ RIGHTMARGIN (if (ZEROP (FGETPARA FMTSPEC RIGHTMAR))
|
||||
then
|
||||
(* ;; "RIGHTMAR = 0 => follow the window/region's width")
|
||||
|
||||
WIDTH
|
||||
else (FGETPARA FMTSPEC RIGHTMAR)))
|
||||
(SETQ WIDTH (IDIFFERENCE RIGHTMARGIN LX1))
|
||||
|
||||
(* ;; "")
|
||||
@@ -1717,7 +1708,8 @@
|
||||
LINE])
|
||||
|
||||
(\TEDIT.FORMATLINE.UPDATELOOKS
|
||||
[LAMBDA (TSTREAM PC) (* ; "Edited 13-Dec-2024 17:09 by rmk")
|
||||
[LAMBDA (TSTREAM PC) (* ; "Edited 19-Dec-2024 11:50 by rmk")
|
||||
(* ; "Edited 13-Dec-2024 17:09 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 15:09 by rmk")
|
||||
(* ; "Edited 28-Jul-2024 20:52 by rmk")
|
||||
(* ; "Edited 9-May-2024 10:28 by rmk")
|
||||
@@ -1779,8 +1771,9 @@
|
||||
(CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(* ; "Switch widths to hardcopy")
|
||||
(SETQ FONT (FONTCOPY FONT 'DEVICE IMAGESTREAM)))]
|
||||
(SETQ HASKERN NIL) (* ;
|
||||
"Set to T if FONT contains left-kern information")
|
||||
(SETQ HASKERN (FFETCH (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT))
|
||||
(* ;
|
||||
"T if FONT contains left-kern information")
|
||||
(SETQ UNBREAKABLE (FGETCLOOKS PLOOKS CLUNBREAKABLE))
|
||||
(PUSHCHAR CHARSLOT NIL PLOOKS))
|
||||
else
|
||||
@@ -2861,21 +2854,21 @@
|
||||
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (28071 30287 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 28081 . 30285)) (37692 118979 (
|
||||
\TEDIT.FORMATLINE 37702 . 73174) (\TEDIT.FORMATLINE.SETUP.PARA 73176 . 77999) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 78001 . 82397) (\TEDIT.FORMATLINE.VERTICAL 82399 . 84616) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 84618 . 90639) (\TEDIT.FORMATLINE.TABS 90641 . 98441) (\TEDIT.SCALE.TABS
|
||||
98443 . 99234) (\TEDIT.FORMATLINE.PURGE.SPACES 99236 . 100663) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
100665 . 101566) (\TEDIT.FORMATLINE.EMPTY 101568 . 106254) (\TEDIT.FORMATLINE.UPDATELOOKS 106256 .
|
||||
112173) (\TEDIT.FORMATLINE.LASTLEGAL 112175 . 115715) (\TEDIT.LINES.ABOVE 115717 . 118977)) (119096
|
||||
121011 (\TLVALIDATE 119106 . 121009)) (121205 142369 (\TEDIT.DISPLAYLINE 121215 . 134662) (
|
||||
\TEDIT.DISPLAYLINE.TABS 134664 . 137287) (\TEDIT.LINECACHE 137289 . 138017) (\TEDIT.CREATE.LINECACHE
|
||||
138019 . 138855) (\TEDIT.BLTCHAR 138857 . 141484) (\TEDIT.DIACRITIC.SHIFT 141486 . 142367)) (142984
|
||||
186321 (\TEDIT.BACKFORMAT 142994 . 145548) (\TEDIT.PREVIOUS.LINEBREAK 145550 . 148273) (
|
||||
\TEDIT.UPDATE.LINES 148275 . 152720) (\TEDIT.PANE.CREATELINES 152722 . 155714) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 155716 . 157091) (\TEDIT.LINES.BELOW 157093 . 161455) (\TEDIT.MEASURED.LINES
|
||||
161457 . 163229) (\TEDIT.VALID.LINES 163231 . 171874) (\TEDIT.LASTVALIDLINE 171876 . 176698) (
|
||||
\TEDIT.NEXTVALIDLINE 176700 . 178002) (\TEDIT.CLEARPANE.BELOW.LINE 178004 . 180110) (\TEDIT.INSERTLINE
|
||||
180112 . 181498) (\TEDIT.LINE.BOTTOM 181500 . 184496) (\TEDIT.SHOW.AT.BOTTOMP 184498 . 185608) (
|
||||
\TEDIT.SHOW.AT.TOPP 185610 . 186319)))))
|
||||
(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.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Jan-2024 13:20:30" {WMEDLEY}<lispusers>COMPARETEXT.;133 48539
|
||||
(FILECREATED "17-Dec-2024 20:47:21" {WMEDLEY}<lispusers>COMPARETEXT.;134 48583
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS IMCOMPARE.COLLECT.HASH.CHUNKS)
|
||||
|
||||
:PREVIOUS-DATE "14-Jan-2024 13:11:44" {WMEDLEY}<lispusers>COMPARETEXT.;132)
|
||||
:PREVIOUS-DATE "14-Jan-2024 13:20:30" {WMEDLEY}<lispusers>COMPARETEXT.;133)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT COMPARETEXTCOMS)
|
||||
@@ -291,7 +291,8 @@
|
||||
TITLE TEXTWIDTH TEXTHEIGHT])
|
||||
|
||||
(IMCOMPARE.COLLECT.HASH.CHUNKS
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 14-Jan-2024 13:20 by rmk")
|
||||
[LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 17-Dec-2024 20:46 by rmk")
|
||||
(* ; "Edited 14-Jan-2024 13:20 by rmk")
|
||||
(* ; "Edited 18-Oct-2023 17:45 by rmk")
|
||||
(* ; "Edited 20-Jan-2022 23:09 by rmk")
|
||||
(* ; "Edited 24-Dec-2021 22:30 by rmk")
|
||||
@@ -315,7 +316,6 @@
|
||||
(OPENTEXTSTREAM STREAM NIL NIL NIL
|
||||
`(OBJECTBYTE ,(CHARCODE *]
|
||||
'(PROGN (CLOSEF? OLDVALUE])
|
||||
(SETFILEINFO STREAM 'EOL 'ANY)
|
||||
(CL:UNLESS (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK)
|
||||
|
||||
(* ;;
|
||||
@@ -780,12 +780,12 @@
|
||||
GRAPHER)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1234 40907 (COMPARETEXT 1244 . 2884) (COMPARETEXT.WINDOW 2886 . 6684) (
|
||||
(FILEMAP (NIL (1234 40951 (COMPARETEXT 1244 . 2884) (COMPARETEXT.WINDOW 2886 . 6684) (
|
||||
COMPARETEXT.TSTREAM 6686 . 9907) (COMPARETEXT.SETSEL 9909 . 10814) (CHUNKNODELABEL 10816 . 11937) (
|
||||
IMCOMPARE.BOXNODE 11939 . 12915) (IMCOMPARE.CHUNKS 12917 . 17525) (IMCOMPARE.COLLECT.HASH.CHUNKS 17527
|
||||
. 20676) (IMCOMPARE.DISPLAYGRAPH 20678 . 28757) (IMCOMPARE.HASH 28759 . 33117) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 33119 . 36615) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36617 . 38572) (
|
||||
IMCOMPARE.SHOW.DIST 38574 . 39020) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39022 . 40905)) (40908 47392 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40918 . 43822) (IMCOMPARE.MIDDLEBUTTONFN 43824 . 46940) (IMCOMPARE.COPYBUTTONFN
|
||||
46942 . 47390)) (47445 48136 (TAIL1 47455 . 47809) (TAIL2 47811 . 48134)))))
|
||||
. 20720) (IMCOMPARE.DISPLAYGRAPH 20722 . 28801) (IMCOMPARE.HASH 28803 . 33161) (
|
||||
IMCOMPARE.MERGE.CONNECTED.CHUNKS 33163 . 36659) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 36661 . 38616) (
|
||||
IMCOMPARE.SHOW.DIST 38618 . 39064) (IMCOMPARE.UPDATE.SYMBOL.TABLE 39066 . 40949)) (40952 47436 (
|
||||
IMCOMPARE.LEFTBUTTONFN 40962 . 43866) (IMCOMPARE.MIDDLEBUTTONFN 43868 . 46984) (IMCOMPARE.COPYBUTTONFN
|
||||
46986 . 47434)) (47489 48180 (TAIL1 47499 . 47853) (TAIL2 47855 . 48178)))))
|
||||
STOP
|
||||
|
||||
135
scripts/loadup-app-setup.sh
Normal file
135
scripts/loadup-app-setup.sh
Normal 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
190
scripts/loadup-lfg.sh
Executable 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 "$@"
|
||||
104
sources/ADIR
104
sources/ADIR
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-May-2024 15:54:01" {WMEDLEY}<sources>ADIR.;45 67756
|
||||
(FILECREATED "25-Dec-2024 11:31:30" {MEDLEY}<sources>ADIR.;15 70102
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \UPF.DIRECTORY)
|
||||
:CHANGES-TO (FNS TRUEDEVICE.STUB)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-2024 16:25:09" {WMEDLEY}<sources>ADIR.;44)
|
||||
:PREVIOUS-DATE "25-Dec-2024 07:35:38" {MEDLEY}<sources>ADIR.;13)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
@@ -16,10 +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? 'NILL 'PSEUDOHOSTP)
|
||||
(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.")
|
||||
@@ -197,7 +199,8 @@
|
||||
(fetch (IFPAGE NActivePages) of \InterfacePage])
|
||||
|
||||
(\COPYSYS
|
||||
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 14-Sep-2023 23:19 by rmk")
|
||||
[LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 18-Dec-2024 13:21 by rmk")
|
||||
(* ; "Edited 14-Sep-2023 23:19 by rmk")
|
||||
(* ; "Edited 3-Jul-2023 19:21 by rmk")
|
||||
(* ; "Edited 1-Jul-2023 12:34 by rmk")
|
||||
(* ; "Edited 29-Jun-2023 11:41 by rmk")
|
||||
@@ -241,8 +244,7 @@
|
||||
(SETQ TEMPNAME (COPYFILE (COND
|
||||
(LDEDEST (CONCAT "{DSK}" LDEDEST))
|
||||
(T "{DSK}~/lisp.virtualmem"))
|
||||
TARGETFILE
|
||||
'((TYPE BINARY]
|
||||
TARGETFILE]
|
||||
(COND
|
||||
((NULL VAL) (* ; "Continuing in the current image")
|
||||
(CL:WHEN TARGETFILE (RENAMEFILE TEMPNAME TARGETFILE))
|
||||
@@ -298,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)
|
||||
|
||||
@@ -306,6 +316,8 @@
|
||||
(MOVD? 'EVQ 'PSEUDOFILENAME)
|
||||
|
||||
(MOVD? 'NILL 'PSEUDOHOSTP)
|
||||
|
||||
(MOVD? 'TRUEDEVICE.STUB 'TRUEDEVICE)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
|
||||
@@ -317,7 +329,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(UNPACKFILENAME.STRING
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 4-May-2024 12:45 by rmk")
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 11-May-2024 21:23 by rmk")
|
||||
(* ; "Edited 4-May-2024 12:45 by rmk")
|
||||
(* ; "Edited 9-Mar-2024 10:23 by rmk")
|
||||
(* ; "Edited 13-Nov-2023 20:28 by rmk")
|
||||
(* ; "Edited 28-Apr-2022 11:40 by rmk")
|
||||
@@ -467,29 +480,54 @@
|
||||
THEN
|
||||
(* ;; "DIRECTORY advances over initial duplicate brackets (but DIRSTART could be a subdirectory character instead)")
|
||||
|
||||
(CL:WHEN [AND (EQ DIRSTART (SUB1 $$OFFSET))
|
||||
(FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1 $$OFFSET
|
||||
))
|
||||
(CHARCODE (> / <]
|
||||
(SETQ DIRSTART $$OFFSET))
|
||||
(SETQ C (CHARCODE >))
|
||||
(GO COERCE)
|
||||
(IF (EQ DIRSTART (SUB1 $$OFFSET))
|
||||
THEN (CL:WHEN (FMEMB (\GETBASECHAR $$FATP $$BASE
|
||||
(SUB1 $$OFFSET))
|
||||
(CHARCODE (> / <)))
|
||||
(SETQ DIRSTART $$OFFSET))
|
||||
ELSE
|
||||
(* ;;
|
||||
"< in the middle: DIRTY flushes it, alternative is (\ILLEGAL.ARG FILE)")
|
||||
|
||||
(SETQ DIRDIRTY T))
|
||||
ELSE (SETQ DIRSTART STARTPOS)
|
||||
|
||||
(* ;;
|
||||
"DIRSTART updates for duplicates, but NAME may want all the brackets")
|
||||
|
||||
(SETQ DIRBRKSTART STARTPOS))
|
||||
|
||||
(* ;; "Borrow DIREND code below if we don't want < after the last > to show up as the first character of the name.")
|
||||
|
||||
[SETQ NAMESTART (SETQ NAMEEND (SETQ EXTENSIONSTART (SETQ VERSIONSTART
|
||||
NIL]))
|
||||
((> /) (* ; "Preceding string is for sure a directory that maybe ends here (unless we're already in an extension")
|
||||
(IF DIRSTART
|
||||
THEN
|
||||
(* ;;
|
||||
|
||||
(* ;; "> and / in the middle or end of a directory are essentially equivalent: the directory is dirty unless there is exactly one >. A sequence >//>/ reduces at output to a singleton >. It is also dirty if a single occurence is a slash--that is also canonicalized to a single >.")
|
||||
|
||||
(* ;; "It is not clear yet whether < in the middle should be treated in the same way, or whether that should cause an error.")
|
||||
|
||||
(IF (EQ DIRSTART (SUB1 $$OFFSET))
|
||||
THEN (CL:WHEN (FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1
|
||||
$$OFFSET
|
||||
))
|
||||
(CHARCODE (> / <)))
|
||||
|
||||
(* ;;
|
||||
"Advance over initial duplicate brackets (but DIRSTART could be a subdirectory character)")
|
||||
|
||||
(CL:WHEN [AND (EQ DIRSTART (SUB1 $$OFFSET))
|
||||
(FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1 $$OFFSET))
|
||||
(CHARCODE (> / <]
|
||||
(SETQ DIRSTART $$OFFSET))
|
||||
(SETQ DIRSTART $$OFFSET))
|
||||
ELSEIF (OR (FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1 $$OFFSET))
|
||||
(CHARCODE (> /)))
|
||||
(EQ C (CHARCODE /)))
|
||||
THEN
|
||||
(* ;; "Either extending a sequence, or a single slash.")
|
||||
|
||||
(SETQ DIRDIRTY T))
|
||||
ELSE (SETQ DIRSTART STARTPOS)
|
||||
(SETQ DIRBRKSTART STARTPOS))
|
||||
(IF DIREND
|
||||
@@ -662,7 +700,8 @@
|
||||
(PUSH $$VAL F FVAL])
|
||||
|
||||
(\UPF.DIRECTORY
|
||||
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 6-May-2024 15:53 by rmk")
|
||||
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 11-May-2024 18:55 by rmk")
|
||||
(* ; "Edited 6-May-2024 15:53 by rmk")
|
||||
(* ; "Edited 4-May-2024 16:25 by rmk")
|
||||
(* ; "Edited 8-Mar-2024 23:03 by rmk")
|
||||
(* ; "Edited 28-Apr-2022 09:15 by rmk")
|
||||
@@ -691,15 +730,15 @@
|
||||
DO (ADD DESTPOS 1)
|
||||
(SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF))
|
||||
(SELCHARQ C
|
||||
((> /)
|
||||
((> / <)
|
||||
(\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >))
|
||||
|
||||
(* ;; "Advance past duplicates")
|
||||
|
||||
(FIND I FROM (ADD1 DIROFF) TO DIREND
|
||||
WHILE (FMEMB (\GETBASECHAR $$FATP $$BASE I)
|
||||
(CHARCODE (> /))) FINALLY (SETQ DIROFF
|
||||
(SUB1 I))))
|
||||
(CHARCODE (> / <))) FINALLY (SETQ DIROFF
|
||||
(SUB1 I))))
|
||||
(\PUTBASECHAR $$FATP DESTBASE DESTPOS C))
|
||||
FINALLY (REPLACE (STRINGP LENGTH) OF DEST WITH DESTPOS)
|
||||
(RETURN DEST))
|
||||
@@ -1250,14 +1289,15 @@
|
||||
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3112 15769 (DELFILE 3122 . 3283) (FULLNAME 3285 . 3652) (INFILE 3654 . 3913) (INFILEP
|
||||
3915 . 4050) (IOFILE 4052 . 4303) (OPENFILE 4305 . 4608) (OPENSTREAM 4610 . 8950) (OUTFILE 8952 . 9214
|
||||
) (OUTFILEP 9216 . 9352) (RENAMEFILE 9354 . 9660) (SIMPLE.FINDFILE 9662 . 10072) (VMEMSIZE 10074 .
|
||||
10241) (\COPYSYS 10243 . 14488) (\FLUSHVM 14490 . 15562) (\LOGOUT0 15564 . 15767)) (16227 38951 (
|
||||
UNPACKFILENAME.STRING 16237 . 36252) (\UPF.DIRECTORY 36254 . 38949)) (40479 42785 (UNPACKFILENAME
|
||||
40489 . 40675) (LASTCHPOS 40677 . 41371) (FILENAMEFIELD 41373 . 41667) (FILENAMEFIELD.STRING 41669 .
|
||||
42073) (PACKFILENAME 42075 . 42418) (PACKFILENAME.STRING 42420 . 42783)) (57255 58168 (
|
||||
FILEDIRCASEARRAY 57265 . 58166)) (58335 65515 (LOGOUT 58345 . 59262) (MAKESYS 59264 . 60893) (SYSOUT
|
||||
60895 . 62447) (SAVEVM 62449 . 63249) (HERALD 63251 . 63411) (INTERPRET.REM.CM 63413 . 65138) (
|
||||
\USEREVENT 65140 . 65513)) (65697 67424 (USERNAME 65707 . 66663) (SETUSERNAME 66665 . 67422)))))
|
||||
(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.
247
sources/FILEIO
247
sources/FILEIO
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 8-Dec-2023 15:17:12" {WMEDLEY}<sources>FILEIO.;124 163555
|
||||
(FILECREATED "25-Dec-2024 10:56:37" {WMEDLEY}<sources>FILEIO.;138 166550
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \GENERIC.CHARSET CHARSET ACCESS-CHARSET)
|
||||
:CHANGES-TO (FNS SETFILEINFO \DO.PARAMS.AT.OPEN \RENAMEFILE)
|
||||
|
||||
:PREVIOUS-DATE " 7-Dec-2023 23:54:02" {WMEDLEY}<sources>FILEIO.;121)
|
||||
:PREVIOUS-DATE "18-Dec-2024 21:08:09" {WMEDLEY}<sources>FILEIO.;135)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FILEIOCOMS)
|
||||
@@ -1446,7 +1446,9 @@
|
||||
(GO RETRY])
|
||||
|
||||
(\DO.PARAMS.AT.OPEN
|
||||
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 25-Aug-2023 08:43 by rmk")
|
||||
[LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 25-Dec-2024 10:54 by rmk")
|
||||
(* ; "Edited 15-Jul-2024 22:29 by rmk")
|
||||
(* ; "Edited 25-Aug-2023 08:43 by rmk")
|
||||
(* ; "Edited 6-Jul-2022 00:00 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 09:30 by rmk")
|
||||
(* ; "Edited 14-Dec-2021 16:10 by rmk")
|
||||
@@ -1454,6 +1456,8 @@
|
||||
(* ; "Edited 29-Jun-2021 17:07 by rmk:")
|
||||
(* ; "Edited 5-Oct-92 13:45 by jds")
|
||||
|
||||
(* ;; "RMK: July 2024: Default EOL to ANY on input streams, allow EXTERNAL FORMAT to be a (FORMAT EOL) list so CL:OPEN can get the EOL")
|
||||
|
||||
(* ;; "Does generic parameters when a file/stream is open. Called by \OPENFILE and OPENSTREAM")
|
||||
|
||||
(* ;; "RMK: August 2023: Added PUTSTREAMPROP as last resort.")
|
||||
@@ -1465,31 +1469,60 @@
|
||||
|
||||
(DECLARE (USEDFREE STREAM-AFTER-OPEN-FNS))
|
||||
(\EXTERNALFORMAT STREAM :DEFAULT)
|
||||
(for X ATTR VAL in PARAMETERS do (COND
|
||||
[(LISTP X)
|
||||
(SETQ ATTR (CAR X))
|
||||
(SETQ VAL (CAR (LISTP (CDR X]
|
||||
(T (SETQ ATTR X)
|
||||
(SETQ VAL T)))
|
||||
(SELECTQ ATTR
|
||||
(BUFFERS (SETFILEINFO STREAM 'BUFFERS VAL))
|
||||
(ENDOFSTREAMOP (SETFILEINFO STREAM 'ENDOFSTREAMOP VAL))
|
||||
(CHARSET (CHARSET STREAM VAL))
|
||||
((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT)
|
||||
(\EXTERNALFORMAT STREAM VAL))
|
||||
(CONVHANKAKU (CONVHANKAKU STREAM VAL))
|
||||
((EOL EOLCONVENTION EOLC)
|
||||
(SETFILEINFO STREAM 'EOL VAL))
|
||||
(PUTSTREAMPROP STREAM ATTR VAL)))
|
||||
[for X ATTR VAL EOL in PARAMETERS do [(COND
|
||||
[(LISTP X)
|
||||
(SETQ ATTR (CAR X))
|
||||
(SETQ VAL (CAR (LISTP (CDR X]
|
||||
(T (SETQ ATTR X)
|
||||
(SETQ VAL T)))
|
||||
(SELECTQ ATTR
|
||||
(BUFFERS (SETFILEINFO STREAM 'BUFFERS VAL))
|
||||
(ENDOFSTREAMOP (SETFILEINFO STREAM 'ENDOFSTREAMOP VAL))
|
||||
(CHARSET (CHARSET STREAM VAL))
|
||||
((FORMAT EXTERNALFORMAT :EXTERNAL-FORMAT)
|
||||
|
||||
(* ;;
|
||||
"VAL can be :UTF-8, CR, (UTF:8 CR), i.e. specify either one or both")
|
||||
|
||||
(if (LISTP VAL)
|
||||
then (* ;
|
||||
"VAL could be (:UTF-8 CR) e.g. from CL:OPEN")
|
||||
(\EXTERNALFORMAT STREAM (CAR VAL))
|
||||
(* ;
|
||||
"Can override the EOL of the format")
|
||||
(SETQ EOL (CADR VAL))
|
||||
elseif (SETQ EOL (CAR)
|
||||
VAL)
|
||||
else (\EXTERNALFORMAT STREAM VAL)))
|
||||
(CONVHANKAKU (CONVHANKAKU STREAM VAL))
|
||||
((EOL EOLCONVENTION EOLC)
|
||||
(SETQ EOL VAL] finally
|
||||
|
||||
(* ;;
|
||||
"If not specified, default EOL to ANY--SETFILEINFO checks for output streams")
|
||||
|
||||
(SETFILEINFO STREAM 'EOL
|
||||
(OR EOL 'ANY]
|
||||
(FOR FN IN STREAM-AFTER-OPEN-FNS DO (APPLY* FN STREAM ACCESS PARAMETERS])
|
||||
|
||||
(\RENAMEFILE
|
||||
[LAMBDA (OLDFILE NEWFILE) (* hdj " 7-May-86 12:22")
|
||||
[LAMBDA (OLDFILE NEWFILE) (* ; "Edited 25-Dec-2024 10:14 by rmk")
|
||||
(* ; "Edited 16-Dec-2024 21:07 by rmk")
|
||||
(* hdj " 7-May-86 12:22")
|
||||
(SETQ OLDFILE (\ADD.CONNECTED.DIR OLDFILE))
|
||||
(SETQ NEWFILE (\ADD.CONNECTED.DIR NEWFILE))
|
||||
(LET ((OLD-DEVICE (\GETDEVICEFROMNAME OLDFILE T))
|
||||
(NEW-DEVICE (\GETDEVICEFROMNAME NEWFILE T)))
|
||||
(AND OLD-DEVICE (FDEVOP 'RENAMEFILE OLD-DEVICE OLD-DEVICE OLDFILE NEW-DEVICE NEWFILE])
|
||||
|
||||
(* ;; "\GETDEVICEFROMNAME errors if the devices don't exist")
|
||||
|
||||
(LET ((OLD-DEVICE (TRUEDEVICE OLDFILE))
|
||||
(NEW-DEVICE (TRUEDEVICE NEWFILE))
|
||||
NEWFULLNAME)
|
||||
(CL:WHEN (SETQ NEWFULLNAME (FDEVOP 'RENAMEFILE OLD-DEVICE OLD-DEVICE (TRUEFILENAME OLDFILE)
|
||||
NEW-DEVICE
|
||||
(TRUEFILENAME NEWFILE)))
|
||||
(CL:IF (PSEUDOHOSTP NEWFILE)
|
||||
(PSEUDOFILENAME NEWFULLNAME)
|
||||
NEWFULLNAME))])
|
||||
|
||||
(\REVALIDATEFILE
|
||||
[LAMBDA (STREAM) (* bvm%: "30-DEC-81 17:45")
|
||||
@@ -2250,27 +2283,32 @@ update the map")
|
||||
T])
|
||||
|
||||
(COPYFILE
|
||||
[LAMBDA (FROMFILE TOFILE DESTPARAMETERS SOURCEPARAMETERS)
|
||||
[LAMBDA (FROMFILE TOFILE)
|
||||
|
||||
(* ;;
|
||||
"Edited 8-Jul-2022 10:54 by rmk: Added SOURCEPARAMETERS, in particular to declare external format")
|
||||
(* ;; "Edited 18-Dec-2024 21:07 by rmk")
|
||||
|
||||
(* ;; "Edited 8-Jul-2022 10:41 by rmk")
|
||||
|
||||
(* ;; "Edited 2-Jan-93 13:35 by jds")
|
||||
|
||||
(* ;;; "DESTPARAMETERS is like PARAMETERS arg to OPENSTREAM -- overrides default parameters")
|
||||
|
||||
[AND (DIRECTORYNAMEP (PACKFILENAME 'HOST NIL 'BODY TOFILE)
|
||||
(UNPACKFILENAME TOFILE 'HOST))
|
||||
(SETQ TOFILE (PACKFILENAME 'DIRECTORY TOFILE 'BODY (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FROMFILE]
|
||||
(CL:WHEN (DIRECTORYNAMEP (PACKFILENAME 'HOST NIL 'BODY TOFILE)
|
||||
(UNPACKFILENAME TOFILE 'HOST))
|
||||
(SETQ TOFILE (PACKFILENAME 'DIRECTORY TOFILE 'BODY (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
|
||||
'BODY FROMFILE))))
|
||||
(RESETLST
|
||||
[RESETSAVE [SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT 'OLD `((SEQUENTIAL T)
|
||||
(DON'TCACHE T)
|
||||
,@SOURCEPARAMETERS]
|
||||
'(PROGN (CLOSEF OLDVALUE]
|
||||
(\COPYOPENFILE FROMFILE TOFILE DESTPARAMETERS))])
|
||||
(LET (FROMSTREAM TOSTREAM)
|
||||
[RESETSAVE [SETQ FROMSTREAM (OPENSTREAM FROMFILE 'INPUT 'OLD `((SEQUENTIAL T)
|
||||
(DON'TCACHE T]
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE [SETQ TOSTREAM (OPENSTREAM TOFILE 'OUTPUT 'NEW
|
||||
`((SEQUENTIAL T)
|
||||
(DON'TCACHE T)
|
||||
(CREATIONDATE ,(GETFILEINFO FROMSTREAM 'CREATIONDATE]
|
||||
'(AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE))
|
||||
(DELFILE OLDVALUE]
|
||||
(COPYBYTES FROMSTREAM TOSTREAM)
|
||||
(CLOSEF FROMSTREAM)
|
||||
(CLOSEF TOSTREAM)))])
|
||||
|
||||
(\COPYOPENFILE
|
||||
[LAMBDA (INSTREAM NEWNAME DESTPARAMETERS)
|
||||
@@ -2487,8 +2525,9 @@ update the map")
|
||||
STREAM])
|
||||
|
||||
(SETFILEINFO
|
||||
[LAMBDA (FILE ATTRIB VALUE) (* ; "Edited 19-Dec-2021 09:30 by rmk")
|
||||
(* ; "Edited 29-Jun-2021 17:05 by rmk:")
|
||||
[LAMBDA (FILE ATTRIB VALUE) (* ; "Edited 25-Dec-2024 10:56 by rmk")
|
||||
(* ; "Edited 19-Dec-2021 09:30 by rmk")
|
||||
(* ; "Edited 29-Jun-2021 17:05 by rmk:")
|
||||
(* ; "Edited 11-Dec-95 11:08 by ")
|
||||
(* ; "Edited 27-Mar-89 15:33 by bvm")
|
||||
(LET (FULLNAME DEV)
|
||||
@@ -2503,8 +2542,8 @@ update the map")
|
||||
(CR CR.EOLC)
|
||||
(CRLF CRLF.EOLC)
|
||||
(LF LF.EOLC)
|
||||
(ANY (CL:WHEN (\GETSTREAM FILE
|
||||
'OUTPUT T)
|
||||
(ANY (CL:UNLESS (EQ 'INPUT (\GETACCESS
|
||||
FILE))
|
||||
(ERROR
|
||||
"EOL convention ANY is not allowed for output streams"
|
||||
FILE))
|
||||
@@ -2605,30 +2644,38 @@ update the map")
|
||||
(add OFF 1])
|
||||
|
||||
(\GENERIC.RENAMEFILE
|
||||
[LAMBDA (OLDDEVICE OLDFILE NEWDEVICE NEWFILE) (* ; "Edited 2-Jul-90 16:03 by nm")
|
||||
(if (NOT (FDEVOP 'OPENP OLDDEVICE (FULLNAME OLDFILE)
|
||||
NIL OLDDEVICE))
|
||||
then (RESETLST
|
||||
[RESETSAVE [SETQ OLDFILE (OPENSTREAM OLDFILE 'INPUT 'OLD '((SEQUENTIAL T)
|
||||
DON'TCACHE]
|
||||
'(AND RESETSTATE (CLOSEF? OLDVALUE]
|
||||
[COND
|
||||
((SETQ NEWFILE (\COPYOPENFILE OLDFILE NEWFILE))
|
||||
(if (\DELETEFILE (CLOSEF OLDFILE))
|
||||
then NEWFILE
|
||||
else (CONDITIONS:RESTART-CASE (CL:ERROR
|
||||
'
|
||||
XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE
|
||||
:PATHNAME OLDFILE)
|
||||
(DELETE-DESTINATION NIL :CONDITION
|
||||
XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT
|
||||
"Delete the destination file too." (DELFILE NEWFILE
|
||||
)
|
||||
NIL)
|
||||
(DONT-DELETE-DESTINATION NIL :CONDITION
|
||||
XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT
|
||||
[LAMBDA (OLDDEVICE OLDFILE NEWDEVICE NEWFILE) (* ; "Edited 16-Dec-2024 21:52 by rmk")
|
||||
|
||||
(* ;; "Names and devices are true, not pseudo")
|
||||
(* ; "Edited 2-Jul-90 16:03 by nm")
|
||||
(CL:UNLESS (FDEVOP 'OPENP OLDDEVICE (FULLNAME OLDFILE)
|
||||
NIL OLDDEVICE) (* ; "Can't rename an open file")
|
||||
(RESETLST
|
||||
[LET (INSTREAM OUTSTREAM)
|
||||
[RESETSAVE [SETQ INSTREAM (OPENSTREAM OLDFILE 'INPUT 'OLD '((SEQUENTIAL T)
|
||||
(DON'TCACHE T]
|
||||
'(PROGN (CLOSEF? OLDVALUE]
|
||||
[RESETSAVE [SETQ OUTSTREAM (OPENSTREAM NEWFILE 'OUTPUT 'NEW
|
||||
`((SEQUENTIAL T)
|
||||
(DON'TCACHE T)
|
||||
(CREATIONDATE ,(GETFILEINFO OLDFILE
|
||||
'CREATIONDATE]
|
||||
'(AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE))
|
||||
(DELFILE OLDVALUE]
|
||||
(COPYBYTES INSTREAM OUTSTREAM)
|
||||
(CLOSEF OUTSTREAM)
|
||||
(if (\DELETEFILE (CLOSEF INSTREAM))
|
||||
then (FULLNAME OUTSTREAM)
|
||||
else (CONDITIONS:RESTART-CASE (CL:ERROR 'XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE
|
||||
:PATHNAME OLDFILE)
|
||||
(DELETE-DESTINATION NIL :CONDITION
|
||||
XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT
|
||||
"Delete the destination file too." (DELFILE NEWFILE)
|
||||
NIL)
|
||||
(DONT-DELETE-DESTINATION NIL :CONDITION
|
||||
XCL::FS-RENAMEFILE-SOURCE-COULDNT-DELETE :REPORT
|
||||
"Don't delete the destination file. Just returns the destination filename."
|
||||
NEWFILE])])
|
||||
NEWFILE]))])
|
||||
|
||||
(\GENERIC.OPENP
|
||||
[LAMBDA (FILENAME ACCESS DEVICE) (* hdj " 6-Oct-86 17:07")
|
||||
@@ -3115,39 +3162,39 @@ update the map")
|
||||
(ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (27732 31848 (STREAMPROP 27742 . 28176) (GETSTREAMPROP 28178 . 28927) (PUTSTREAMPROP
|
||||
28929 . 31696) (STREAMP 31698 . 31846)) (31891 35270 (\DEFPRINT.BY.NAME 31901 . 33053) (
|
||||
\STREAM.DEFPRINT 33055 . 34963) (\FDEV.DEFPRINT 34965 . 35268)) (35528 40569 (\GETACCESS 35538 . 35992
|
||||
) (\SETACCESS 35994 . 40567)) (60795 66764 (\DEFINEDEVICE 60805 . 63121) (\GETDEVICEFROMNAME 63123 .
|
||||
63596) (\GETDEVICEFROMHOSTNAME 63598 . 64642) (\REMOVEDEVICE 64644 . 65767) (\REMOVEDEVICE.NAMES 65769
|
||||
. 66762)) (66804 92336 (\CLOSEFILE 66814 . 67639) (\DELETEFILE 67641 . 67935) (\DEVICEEVENT 67937 .
|
||||
69707) (\GENERATEFILES 69709 . 70656) (\GENERATENEXTFILE 70658 . 71309) (\GENERATEFILEINFO 71311 .
|
||||
71772) (\GETFILENAME 71774 . 72163) (\GENERIC.OUTFILEP 72165 . 72635) (\OPENFILE 72637 . 75215) (
|
||||
\DO.PARAMS.AT.OPEN 75217 . 77746) (\RENAMEFILE 77748 . 78172) (\REVALIDATEFILE 78174 . 80776) (
|
||||
\PAGED.REVALIDATEFILELST 80778 . 82336) (\PAGED.REVALIDATEFILES 82338 . 84057) (\PAGED.REVALIDATEFILE
|
||||
84059 . 86342) (\BUFFERED.REVALIDATEFILE 86344 . 88630) (\BUFFERED.REVALIDATEFILELST 88632 . 89816) (
|
||||
\PRINT-REVALIDATION-RESULT 89818 . 90660) (\TRUNCATEFILE 90662 . 91053) (\FILE-CONFLICT 91055 . 92334)
|
||||
) (92372 97035 (\GENERATENOFILES 92382 . 94478) (\NULLFILEGENERATOR 94480 . 94724) (\NOFILESNEXTFILEFN
|
||||
94726 . 96717) (\NOFILESINFOFN 96719 . 97033)) (97154 99062 (\FILE.NOT.OPEN 97164 . 97677) (
|
||||
\FILE.WONT.OPEN 97679 . 98007) (\ILLEGAL.DEVICEOP 98009 . 98291) (\IS.NOT.RANDACCESSP 98293 . 98739) (
|
||||
\STREAM.NOT.OPEN 98741 . 99060)) (99197 101495 (\FDEVINSTANCE 99207 . 101493)) (102697 110071 (CNDIR
|
||||
102707 . 104012) (DIRECTORYNAME 104014 . 108197) (DIRECTORYNAMEP 108199 . 108815) (HOSTNAMEP 108817 .
|
||||
109624) (\ADD.CONNECTED.DIR 109626 . 110069)) (110116 138395 (\BACKFILEPTR 110126 . 110314) (
|
||||
\BACKPEEKBIN 110316 . 110677) (\BACKBIN 110679 . 111030) (BIN 111032 . 111249) (\BIN 111251 . 111528)
|
||||
(\BINS 111530 . 111816) (BOUT 111818 . 112180) (\BOUT 112182 . 112497) (\BOUTS 112499 . 112810) (
|
||||
COPYBYTES 112812 . 116144) (COPYCHARS 116146 . 119812) (COPYFILE 119814 . 120878) (\COPYOPENFILE
|
||||
120880 . 124079) (\INFER.FILE.TYPE 124081 . 125035) (EOFP 125037 . 125334) (FORCEOUTPUT 125336 .
|
||||
125583) (\FLUSH.OPEN.STREAMS 125585 . 125941) (CHARSET 125943 . 127302) (ACCESS-CHARSET 127304 .
|
||||
127832) (GETEOFPTR 127834 . 128084) (GETFILEINFO 128086 . 131279) (\TYPE.FROM.FILETYPE 131281 . 131751
|
||||
) (\FILETYPE.FROM.TYPE 131753 . 131932) (GETFILEPTR 131934 . 132186) (SETFILEINFO 132188 . 136294) (
|
||||
SETFILEPTR 136296 . 138015) (BOUT16 138017 . 138202) (BIN16 138204 . 138393)) (138498 145152 (
|
||||
\GENERIC.BINS 138508 . 138788) (\GENERIC.BOUTS 138790 . 139055) (\GENERIC.RENAMEFILE 139057 . 140888)
|
||||
(\GENERIC.OPENP 140890 . 142205) (\GENERIC.READP 142207 . 143359) (\GENERIC.CHARSET 143361 . 145150))
|
||||
(145153 145492 (\MAP-OPEN-STREAMS 145163 . 145490)) (147347 149427 (\EOF.ACTION 147357 . 147608) (
|
||||
\EOSERROR 147610 . 147803) (\GETEOFPTR 147805 . 147987) (\INCFILEPTR 147989 . 148339) (\PEEKBIN 148341
|
||||
. 148532) (\SETCLOSEDFILELENGTH 148534 . 148868) (\SETEOFPTR 148870 . 149058) (\SETFILEPTR 149060 .
|
||||
149425)) (149428 149970 (\FIXPOUT 149438 . 149738) (\FIXPIN 149740 . 149968)) (149971 150537 (\BOUTEOL
|
||||
149981 . 150535)) (153433 163297 (\BUFFERED.BIN 153443 . 154295) (\BUFFERED.PEEKBIN 154297 . 155079)
|
||||
(\BUFFERED.BOUT 155081 . 155941) (\BUFFERED.BINS 155943 . 159628) (\BUFFERED.BOUTS 159630 . 161431) (
|
||||
\BUFFERED.COPYBYTES 161433 . 163295)))))
|
||||
(FILEMAP (NIL (27735 31851 (STREAMPROP 27745 . 28179) (GETSTREAMPROP 28181 . 28930) (PUTSTREAMPROP
|
||||
28932 . 31699) (STREAMP 31701 . 31849)) (31894 35273 (\DEFPRINT.BY.NAME 31904 . 33056) (
|
||||
\STREAM.DEFPRINT 33058 . 34966) (\FDEV.DEFPRINT 34968 . 35271)) (35531 40572 (\GETACCESS 35541 . 35995
|
||||
) (\SETACCESS 35997 . 40570)) (60798 66767 (\DEFINEDEVICE 60808 . 63124) (\GETDEVICEFROMNAME 63126 .
|
||||
63599) (\GETDEVICEFROMHOSTNAME 63601 . 64645) (\REMOVEDEVICE 64647 . 65770) (\REMOVEDEVICE.NAMES 65772
|
||||
. 66765)) (66807 94538 (\CLOSEFILE 66817 . 67642) (\DELETEFILE 67644 . 67938) (\DEVICEEVENT 67940 .
|
||||
69710) (\GENERATEFILES 69712 . 70659) (\GENERATENEXTFILE 70661 . 71312) (\GENERATEFILEINFO 71314 .
|
||||
71775) (\GETFILENAME 71777 . 72166) (\GENERIC.OUTFILEP 72168 . 72638) (\OPENFILE 72640 . 75218) (
|
||||
\DO.PARAMS.AT.OPEN 75220 . 79416) (\RENAMEFILE 79418 . 80374) (\REVALIDATEFILE 80376 . 82978) (
|
||||
\PAGED.REVALIDATEFILELST 82980 . 84538) (\PAGED.REVALIDATEFILES 84540 . 86259) (\PAGED.REVALIDATEFILE
|
||||
86261 . 88544) (\BUFFERED.REVALIDATEFILE 88546 . 90832) (\BUFFERED.REVALIDATEFILELST 90834 . 92018) (
|
||||
\PRINT-REVALIDATION-RESULT 92020 . 92862) (\TRUNCATEFILE 92864 . 93255) (\FILE-CONFLICT 93257 . 94536)
|
||||
) (94574 99237 (\GENERATENOFILES 94584 . 96680) (\NULLFILEGENERATOR 96682 . 96926) (\NOFILESNEXTFILEFN
|
||||
96928 . 98919) (\NOFILESINFOFN 98921 . 99235)) (99356 101264 (\FILE.NOT.OPEN 99366 . 99879) (
|
||||
\FILE.WONT.OPEN 99881 . 100209) (\ILLEGAL.DEVICEOP 100211 . 100493) (\IS.NOT.RANDACCESSP 100495 .
|
||||
100941) (\STREAM.NOT.OPEN 100943 . 101262)) (101399 103697 (\FDEVINSTANCE 101409 . 103695)) (104899
|
||||
112273 (CNDIR 104909 . 106214) (DIRECTORYNAME 106216 . 110399) (DIRECTORYNAMEP 110401 . 111017) (
|
||||
HOSTNAMEP 111019 . 111826) (\ADD.CONNECTED.DIR 111828 . 112271)) (112318 140973 (\BACKFILEPTR 112328
|
||||
. 112516) (\BACKPEEKBIN 112518 . 112879) (\BACKBIN 112881 . 113232) (BIN 113234 . 113451) (\BIN
|
||||
113453 . 113730) (\BINS 113732 . 114018) (BOUT 114020 . 114382) (\BOUT 114384 . 114699) (\BOUTS 114701
|
||||
. 115012) (COPYBYTES 115014 . 118346) (COPYCHARS 118348 . 122014) (COPYFILE 122016 . 123325) (
|
||||
\COPYOPENFILE 123327 . 126526) (\INFER.FILE.TYPE 126528 . 127482) (EOFP 127484 . 127781) (FORCEOUTPUT
|
||||
127783 . 128030) (\FLUSH.OPEN.STREAMS 128032 . 128388) (CHARSET 128390 . 129749) (ACCESS-CHARSET
|
||||
129751 . 130279) (GETEOFPTR 130281 . 130531) (GETFILEINFO 130533 . 133726) (\TYPE.FROM.FILETYPE 133728
|
||||
. 134198) (\FILETYPE.FROM.TYPE 134200 . 134379) (GETFILEPTR 134381 . 134633) (SETFILEINFO 134635 .
|
||||
138872) (SETFILEPTR 138874 . 140593) (BOUT16 140595 . 140780) (BIN16 140782 . 140971)) (141076 148147
|
||||
(\GENERIC.BINS 141086 . 141366) (\GENERIC.BOUTS 141368 . 141633) (\GENERIC.RENAMEFILE 141635 . 143883)
|
||||
(\GENERIC.OPENP 143885 . 145200) (\GENERIC.READP 145202 . 146354) (\GENERIC.CHARSET 146356 . 148145))
|
||||
(148148 148487 (\MAP-OPEN-STREAMS 148158 . 148485)) (150342 152422 (\EOF.ACTION 150352 . 150603) (
|
||||
\EOSERROR 150605 . 150798) (\GETEOFPTR 150800 . 150982) (\INCFILEPTR 150984 . 151334) (\PEEKBIN 151336
|
||||
. 151527) (\SETCLOSEDFILELENGTH 151529 . 151863) (\SETEOFPTR 151865 . 152053) (\SETFILEPTR 152055 .
|
||||
152420)) (152423 152965 (\FIXPOUT 152433 . 152733) (\FIXPIN 152735 . 152963)) (152966 153532 (\BOUTEOL
|
||||
152976 . 153530)) (156428 166292 (\BUFFERED.BIN 156438 . 157290) (\BUFFERED.PEEKBIN 157292 . 158074)
|
||||
(\BUFFERED.BOUT 158076 . 158936) (\BUFFERED.BINS 158938 . 162623) (\BUFFERED.BOUTS 162625 . 164426) (
|
||||
\BUFFERED.COPYBYTES 164428 . 166290)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
107
sources/FONT
107
sources/FONT
@@ -1,14 +1,14 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "14-Dec-2024 16:52:43" {WMEDLEY}<sources>FONT.;16 190016
|
||||
(FILECREATED "19-Dec-2024 15:25:17" {WMEDLEY}<sources>FONT.;26 191458
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS FONTCOMS)
|
||||
(RECORDS FONTCLASS FONTDESCRIPTOR)
|
||||
(FNS FONTCLASS.DEFPRINT)
|
||||
:CHANGES-TO (FNS \FGETLEFTKERN)
|
||||
(VARS FONTCOMS)
|
||||
(FUNCTIONS \CREATEKERNELEMENT)
|
||||
|
||||
:PREVIOUS-DATE "14-Dec-2024 09:13:44" {WMEDLEY}<sources>FONT.;15)
|
||||
:PREVIOUS-DATE "19-Dec-2024 11:52:01" {WMEDLEY}<sources>FONT.;18)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT FONTCOMS)
|
||||
@@ -94,8 +94,9 @@
|
||||
(MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET \FGETWIDTH
|
||||
\FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH \FGETIMAGEWIDTH \FSETIMAGEWIDTH
|
||||
\GETCHARSETINFO \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR)
|
||||
(FUNCTIONS \CREATEKERNELEMENT \FSETLEFTKERN \FGETLEFTKERN)
|
||||
(FUNCTIONS \CREATEKERNELEMENT \FSETLEFTKERN)
|
||||
(CONSTANTS (\MAXNSCHAR 65535]
|
||||
(FNS \FGETLEFTKERN)
|
||||
(COMS (* ; "NS Character specific code")
|
||||
(FNS \CREATECHARSET \INSTALLCHARSETINFO)
|
||||
(GLOBALVARS DISPLAYFONTCOERCIONS MISSINGDISPLAYFONTCOERCIONS
|
||||
@@ -2870,7 +2871,7 @@
|
||||
(/DECLAREDATATYPE 'FONTDESCRIPTOR
|
||||
'(POINTER POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD
|
||||
SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
|
||||
WORD POINTER POINTER POINTER)
|
||||
WORD POINTER POINTER FLAG POINTER)
|
||||
'((FONTDESCRIPTOR 0 POINTER)
|
||||
(FONTDESCRIPTOR 2 POINTER)
|
||||
(FONTDESCRIPTOR 4 POINTER)
|
||||
@@ -2892,6 +2893,7 @@
|
||||
(FONTDESCRIPTOR 27 (BITS . 15))
|
||||
(FONTDESCRIPTOR 28 POINTER)
|
||||
(FONTDESCRIPTOR 30 POINTER)
|
||||
(FONTDESCRIPTOR 30 (FLAGBITS . 0))
|
||||
(FONTDESCRIPTOR 32 POINTER))
|
||||
'34)
|
||||
|
||||
@@ -2933,6 +2935,7 @@
|
||||
(FONTAVGCHARWIDTH WORD)
|
||||
(FONTIMAGEWIDTHS POINTER)
|
||||
(FONTCHARSETVECTOR POINTER)
|
||||
(FONTHASLEFTKERNS FLAG)
|
||||
(FONTEXTRAFIELD2 POINTER)))
|
||||
|
||||
(DATATYPE CHARSETINFO (WIDTHS OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD)
|
||||
@@ -3006,6 +3009,8 @@
|
||||
"Set in FONTCREATE, used to fix up the linelength when DSPFONT is called")
|
||||
(FONTIMAGEWIDTHS POINTER) (* ; "This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE.")
|
||||
(FONTCHARSETVECTOR POINTER) (* ; "A 256-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset.")
|
||||
(FONTHASLEFTKERNS FLAG) (* ;
|
||||
"T if at least one character set has an entry for left kerns")
|
||||
(FONTEXTRAFIELD2 POINTER))
|
||||
FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)
|
||||
(INIT (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))))
|
||||
@@ -3065,7 +3070,7 @@
|
||||
(/DECLAREDATATYPE 'FONTDESCRIPTOR
|
||||
'(POINTER POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD
|
||||
SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
|
||||
WORD POINTER POINTER POINTER)
|
||||
WORD POINTER POINTER FLAG POINTER)
|
||||
'((FONTDESCRIPTOR 0 POINTER)
|
||||
(FONTDESCRIPTOR 2 POINTER)
|
||||
(FONTDESCRIPTOR 4 POINTER)
|
||||
@@ -3087,6 +3092,7 @@
|
||||
(FONTDESCRIPTOR 27 (BITS . 15))
|
||||
(FONTDESCRIPTOR 28 POINTER)
|
||||
(FONTDESCRIPTOR 30 POINTER)
|
||||
(FONTDESCRIPTOR 30 (FLAGBITS . 0))
|
||||
(FONTDESCRIPTOR 32 POINTER))
|
||||
'34)
|
||||
|
||||
@@ -3164,18 +3170,16 @@
|
||||
T)))
|
||||
)
|
||||
|
||||
(DEFMACRO \CREATEKERNELEMENT ()
|
||||
`(CL:MAKE-ARRAY (IPLUS \MAXTHINCHAR 3)
|
||||
:ELEMENT-TYPE
|
||||
'(SIGNED-BYTE 16)
|
||||
:INITIAL-ELEMENT 0))
|
||||
(DEFMACRO \CREATEKERNELEMENT () (* ; "Edited 19-Dec-2024 12:20 by rmk")
|
||||
`(PROGN (HELP "THIS IS BOGUS, SEE \FGETLEFTKERN")
|
||||
(CL:MAKE-ARRAY (IPLUS \MAXTHINCHAR 3)
|
||||
:ELEMENT-TYPE
|
||||
'(SIGNED-BYTE 16)
|
||||
:INITIAL-ELEMENT 0)))
|
||||
|
||||
(DEFMACRO \FSETLEFTKERN (LEFTKERNBLOCK INDEX KERNVALUE)
|
||||
`(CL:SETF (CL:AREF ,LEFTKERNBLOCK ,INDEX)
|
||||
,KERNVALUE))
|
||||
|
||||
(DEFMACRO \FGETLEFTKERN (LEFTKERNBLOCK CHAR8CODE)
|
||||
`(CL:AREF ,LEFTKERNBLOCK ,CHAR8CODE))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \MAXNSCHAR 65535)
|
||||
@@ -3187,6 +3191,23 @@
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\FGETLEFTKERN
|
||||
[LAMBDA (FONT PREVCHARCODE CHARCODE) (* ; "Edited 19-Dec-2024 15:25 by rmk")
|
||||
|
||||
(* ;; "Returns the kern information for CHARCODE in FONT, given that it is an immediate successor of PREVCHARCODE. Returns 0 if no PREVCHARCODE/CHARCODE kerning is specified. For now, assume that the kerning information is sparse for characters within a character set, stored as a 2-level alist. ")
|
||||
|
||||
(* ;; "If the kerning information for a character is already a FIXP, then it is an offset no matter what the preceding character might be. This appears to be the way at least AC font files are set up.")
|
||||
|
||||
(OR [AND (fetch (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT)
|
||||
(LET [(CHARKERNS (CDR (FASSOC (\GETCHARSETINFO (\CHARSET CHARCODE)
|
||||
FONT T)
|
||||
(\CHAR8CODE CHARCODE]
|
||||
(OR (FIXP CHARKERNS)
|
||||
(CDR (FASSOC PREVCHARCODE CHARKERNS]
|
||||
0])
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -3359,31 +3380,31 @@
|
||||
(ADDTOVAR LAMA FONTCOPY)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8729 18248 (CHARWIDTH 8739 . 9524) (CHARWIDTHY 9526 . 10896) (STRINGWIDTH 10898 . 11991
|
||||
) (\CHARWIDTH.DISPLAY 11993 . 12406) (\STRINGWIDTH.DISPLAY 12408 . 12832) (\STRINGWIDTH.GENERIC 12834
|
||||
. 18246)) (18249 24631 (DEFAULTFONT 18259 . 20092) (FONTCLASS 20094 . 22256) (FONTCLASSUNPARSE 22258
|
||||
. 23157) (FONTCLASSCOMPONENT 23159 . 23668) (SETFONTCLASSCOMPONENT 23670 . 24629)) (25305 38037 (
|
||||
FONTCREATE 25315 . 34582) (\FONT.SYMBOLMEMB 34584 . 34814) (\FONT.SYMBOLASSOC 34816 . 35974) (
|
||||
\FONT.COMPARESYMBOL 35976 . 38035)) (38076 42700 (FONTASCENT 38086 . 38254) (FONTDESCENT 38256 . 38525
|
||||
) (FONTHEIGHT 38527 . 38713) (FONTPROP 38715 . 42158) (\AVGCHARWIDTH 42160 . 42698)) (42747 55386 (
|
||||
GETCHARBITMAP 42757 . 45647) (PUTCHARBITMAP 45649 . 53706) (MOVECHARBITMAP 53708 . 55384)) (55387
|
||||
139926 (FONTCOPY 55397 . 60705) (FONTSAVAILABLE 60707 . 65912) (FONTFILEFORMAT 65914 . 67538) (FONTP
|
||||
67540 . 67839) (FONTUNPARSE 67841 . 70405) (SETFONTDESCRIPTOR 70407 . 72116) (CHARCODEP 72118 . 72479)
|
||||
(EDITCHAR 72481 . 72910) (\STREAMCHARWIDTH 72912 . 77076) (\UNITWIDTHSVECTOR 77078 . 77441) (
|
||||
\CREATEDISPLAYFONT 77443 . 78196) (\CREATECHARSET.DISPLAY 78198 . 81114) (\CREATE-REAL-CHARSET.DISPLAY
|
||||
81116 . 88020) (\BUILDSLUGCSINFO 88022 . 89465) (\SEARCHDISPLAYFONTFILES 89467 . 91400) (
|
||||
\SEARCHFONTFILES 91402 . 94713) (\FINDFONTFILE 94715 . 95906) (\FONTSYMBOL 95908 . 96558) (
|
||||
\DEVICESYMBOL 96560 . 97429) (\FONTFACE 97431 . 104621) (\FONTFACE.COLOR 104623 . 111543) (
|
||||
\FONTFILENAME 111545 . 114960) (\FONTFILENAME.OLD 114962 . 117911) (\FONTFILENAME.NEW 117913 . 120170)
|
||||
(\FONTINFOFROMFILENAME 120172 . 123286) (\FONTINFOFROMFILENAME.OLD 123288 . 125565) (\GETFONTDESC
|
||||
125567 . 125958) (\COERCEFONTDESC 125960 . 131345) (\LOOKUPFONT 131347 . 132691) (\LOOKUPFONTSINCORE
|
||||
132693 . 134766) (\READDISPLAYFONTFILE 134768 . 139924)) (140829 157553 (\READSTRIKEFONTFILE 140839 .
|
||||
145041) (\SFMAKEBOLD 145043 . 147439) (\SFMAKEITALIC 147441 . 150344) (\SFMAKEROTATEDFONT 150346 .
|
||||
151747) (\SFROTATECSINFO 151749 . 152386) (\SFROTATEFONTCHARACTERS 152388 . 152768) (
|
||||
\SFFIXOFFSETSAFTERROTATION 152770 . 154909) (\SFROTATECSINFOOFFSETS 154911 . 156180) (\SFMAKECOLOR
|
||||
156182 . 157551)) (157554 164807 (WRITESTRIKEFONTFILE 157564 . 161347) (STRIKECSINFO 161349 . 164805))
|
||||
(164808 166647 (FONTDESCRIPTOR.DEFPRINT 164818 . 166169) (FONTCLASS.DEFPRINT 166171 . 166645)) (
|
||||
181517 181680 (\CREATEKERNELEMENT 181517 . 181680)) (181682 181810 (\FSETLEFTKERN 181682 . 181810)) (
|
||||
181812 181906 (\FGETLEFTKERN 181812 . 181906)) (182075 185585 (\CREATECHARSET 182085 . 183836) (
|
||||
\INSTALLCHARSETINFO 183838 . 185583)) (186740 188492 (\FONTRESETCHARWIDTHS 186750 . 188490)))))
|
||||
(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.
80
sources/UFS
80
sources/UFS
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "10-Dec-2024 14:53:34" {WMEDLEY}<sources>UFS.;36 78539
|
||||
(FILECREATED "18-Dec-2024 12:52:23" {WMEDLEY}<sources>UFS.;39 79633
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS UFSCOMS)
|
||||
:CHANGES-TO (FNS \UFSRenameFile)
|
||||
|
||||
:PREVIOUS-DATE "16-Sep-2023 09:22:55" {WMEDLEY}<sources>UFS.;33)
|
||||
:PREVIOUS-DATE "16-Sep-2023 09:22:55" {WMEDLEY}<sources>UFS.;38)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT UFSCOMS)
|
||||
@@ -89,6 +89,8 @@
|
||||
(HTML . TEXT)
|
||||
(HTM . TEXT)
|
||||
(TEX . TEXT)
|
||||
(PS . TEXT)
|
||||
(PDF . TEXT)
|
||||
(DCOM . BINARY)
|
||||
(SKETCH . BINARY)
|
||||
(TEDIT . BINARY)
|
||||
@@ -330,8 +332,36 @@
|
||||
)
|
||||
|
||||
(\UFSRenameFile
|
||||
(LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 16-Apr-90 13:46 by nm") (if (NEQ OLD-DEVICE NEW-DEVICE) then (* ;; "Call the generic rename function. ") (LET ((FILE (\GENERIC.RENAMEFILE OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME))) (COND ((AND FILE (EQ \MACHINETYPE \MAIKO) FileTypeConfirmFlg) (* ; "print warnig message") (\UFStoOtherRenameMess OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME))) FILE) else (* ;; "UNIX file system rename.") (LET ((OLDUNIXNAME (\UFS.RECOGNIZE.FILE OLD-NAME (QUOTE OLD) OLD-DEVICE))) (if (AND OLDUNIXNAME (NOT (\UFS.OPENP OLDUNIXNAME OLD-DEVICE))) then (* ; "Old file is found and not open, so proceed") (LET ((NEWUNIXNAME (\UFS.RECOGNIZE.FILE NEW-NAME (QUOTE NEW) NEW-DEVICE)) (ERRNO (CREATECELL \FIXP))) (COND ((\UFSRenameFile-C (\UFS.REMOVE.HOST.FIELD OLDUNIXNAME OLD-DEVICE) (\UFS.REMOVE.HOST.FIELD NEWUNIXNAME NEW-DEVICE) NEW-DEVICE ERRNO) (\UFS.FULLNAME NEWUNIXNAME NEW-DEVICE)) (T (if (EQL (IPLUS ERRNO 0) 18) then (* ; "CrossDeviceError. Should be PARAMETER!") (\GENERIC.RENAMEFILE OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) else (\UFSError (CONCAT OLDUNIXNAME " or " NEWUNIXNAME) ERRNO) NIL))))))))
|
||||
)
|
||||
[LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Dec-2024 12:52 by rmk")
|
||||
(* ; "Edited 16-Apr-90 13:46 by nm")
|
||||
(if (NEQ OLD-DEVICE NEW-DEVICE)
|
||||
then
|
||||
(* ;; "Call the generic rename function. ")
|
||||
|
||||
(\GENERIC.RENAMEFILE OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME)
|
||||
else
|
||||
(* ;; "UNIX file system rename.")
|
||||
|
||||
(LET ((OLDUNIXNAME (\UFS.RECOGNIZE.FILE OLD-NAME 'OLD OLD-DEVICE)))
|
||||
(if (AND OLDUNIXNAME (NOT (\UFS.OPENP OLDUNIXNAME OLD-DEVICE)))
|
||||
then (* ;
|
||||
"Old file is found and not open, so proceed")
|
||||
(LET ((NEWUNIXNAME (\UFS.RECOGNIZE.FILE NEW-NAME 'NEW NEW-DEVICE))
|
||||
(ERRNO (CREATECELL \FIXP)))
|
||||
(COND
|
||||
((\UFSRenameFile-C (\UFS.REMOVE.HOST.FIELD OLDUNIXNAME OLD-DEVICE)
|
||||
(\UFS.REMOVE.HOST.FIELD NEWUNIXNAME NEW-DEVICE)
|
||||
NEW-DEVICE ERRNO)
|
||||
(\UFS.FULLNAME NEWUNIXNAME NEW-DEVICE))
|
||||
(T (if (EQL (IPLUS ERRNO 0)
|
||||
18)
|
||||
then (* ;
|
||||
"CrossDeviceError. Should be PARAMETER!")
|
||||
(\GENERIC.RENAMEFILE OLD-DEVICE OLD-NAME NEW-DEVICE
|
||||
NEW-NAME)
|
||||
else (\UFSError (CONCAT OLDUNIXNAME " or " NEWUNIXNAME)
|
||||
ERRNO)
|
||||
NIL])
|
||||
|
||||
(\UFSReadPages
|
||||
(LAMBDA (stream streamFirstPage buffers) (* ; "Edited 3-Mar-89 14:49 by bvm") (* ;;; "ARG0 -- stream : {stream} data type.") (* ;;; "ARG1 -- streamFirstPage : the 1st page number of file to read.") (* ;;; "ARG2 -- buffers : {VMEMPAGEP} or list of {VMEMPAGEP}. ") (* ; "Write out the buffers to the backing file.") (for buffer inside buffers as streamPageNumber from streamFirstPage bind (fileID _ (fetch (UFSSTREAM FILEID) of stream)) lastStreamPage offset ERRNO first (\UPDATEOF stream) (SETQ lastStreamPage (PLUS (fetch (STREAM EPAGE) of stream) (if (EQ 0 (fetch (STREAM EOFFSET) of stream)) then -1 else 0))) (SETQ ERRNO (CREATECELL \FIXP)) sum (if (LEQ streamPageNumber lastStreamPage) then (OR (\UFSReadPages-C fileID streamPageNumber buffer ERRNO) (\UFSError stream ERRNO) (CL:ERROR (QUOTE XCL:SIMPLE-DEVICE-ERROR) :MESSAGE stream)) (if (EQ streamPageNumber lastStreamPage) then (SETQ offset (fetch (STREAM EOFFSET) of stream)) (if (EQ offset 0) then (SETQ offset BYTESPERPAGE) else (\CLEARBYTES buffer offset (- BYTESPERPAGE offset))) offset else BYTESPERPAGE) else (\CLEARWORDS buffer WORDSPERPAGE) 0)))
|
||||
@@ -795,6 +825,8 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
|
||||
(HTML . TEXT)
|
||||
(HTM . TEXT)
|
||||
(TEX . TEXT)
|
||||
(PS . TEXT)
|
||||
(PDF . TEXT)
|
||||
(DCOM . BINARY)
|
||||
(SKETCH . BINARY)
|
||||
(TEDIT . BINARY)
|
||||
@@ -1152,23 +1184,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (8676 10229 (\UFSCreateDevice 8686 . 9051) (\UFS.CREATE.DEVICE 9053 . 9909) (
|
||||
\UFSOpenDevice 9911 . 10088) (\UFSCloseDevice 10090 . 10227)) (14492 50994 (\UFSOpenFile 14502 . 17796
|
||||
) (\UFS.OPENP 17798 . 18295) (\UFS.RECOGNIZE.FILE 18297 . 19050) (\UFS.DIRECTORY.NAME 19052 . 19795) (
|
||||
\UFSCloseFile 19797 . 21702) (\UFSGetFileName 21704 . 21903) (\UFSDeleteFile 21905 . 22445) (
|
||||
\UFSRenameFile 22447 . 23612) (\UFSReadPages 23614 . 24749) (\UFSWritePages 24751 . 25971) (
|
||||
\UFSTruncateFile 25973 . 27470) (\UFSDirectoryNameP 27472 . 28526) (\UFSEventFn 28528 . 29190) (
|
||||
\UFSGetFileInfo 29192 . 31474) (\UFS.CREATE.PROPS 31476 . 31829) (\UFSSetFileInfo 31831 . 33060) (
|
||||
\UFSGenerateFiles 33062 . 39942) (\UFS.NEXTFILEFN 39944 . 47582) (\UFS.FILEINFOFN 47584 . 49033) (
|
||||
\UFS.VALID.PROPP 49035 . 49327) (\UFS.REGISTER.GFS 49329 . 49584) (\UFS.UNREGISTER.GFS 49586 . 50169)
|
||||
(\UFS.ABORT.DIRECTORY 50171 . 50519) (\UFS.ABORT.CL-DIRECTORY 50521 . 50808) (\UFS.CLEANUP.GFS.TABLE
|
||||
50810 . 50992)) (51029 57713 (\UFSMakeUnixFormatName 51039 . 52060) (\UFSParseNameString 52062 . 52436
|
||||
) (\UFSParse-Directory 52438 . 52979) (\UFS.PARSE.BODY 52981 . 53526) (\UFS.ADJUST.HOST 53528 . 53687)
|
||||
(\UFS.FULLNAME 53689 . 54897) (\UFS.ADD.HOST.FIELD 54899 . 55259) (\UFS.REMOVE.HOST.FIELD 55261 .
|
||||
56931) (\UFS.HANDLE.RELATIVEDIRECTORY 56933 . 57711)) (58529 59142 (CHDIR 58539 . 59140)) (59214 60200
|
||||
(\DEVICEFILE.EOSERROR 59224 . 60198)) (60273 61510 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60283 . 61128)
|
||||
(\UNVISIBLE.FLUSH.OPEN.STREAMS 61130 . 61508)) (61543 63169 (\UFSError 61553 . 63167)) (63213 65628 (
|
||||
\UFSGetFileType 63223 . 63824) (\UFSSetFileType 63826 . 64423) (\UFSeol 64425 . 65626)) (74234 75358 (
|
||||
\UFSGetPrintFileType 74244 . 74656) (\UFSGetFileTypeConfirm 74658 . 75106) (\UFSPrintTypeMenu 75108 .
|
||||
75356)) (75388 78226 (\UFStoOtherCopyMess 75398 . 77076) (\UFStoOtherRenameMess 77078 . 78224)))))
|
||||
(FILEMAP (NIL (8857 10410 (\UFSCreateDevice 8867 . 9232) (\UFS.CREATE.DEVICE 9234 . 10090) (
|
||||
\UFSOpenDevice 10092 . 10269) (\UFSCloseDevice 10271 . 10408)) (14673 52047 (\UFSOpenFile 14683 .
|
||||
17977) (\UFS.OPENP 17979 . 18476) (\UFS.RECOGNIZE.FILE 18478 . 19231) (\UFS.DIRECTORY.NAME 19233 .
|
||||
19976) (\UFSCloseFile 19978 . 21883) (\UFSGetFileName 21885 . 22084) (\UFSDeleteFile 22086 . 22626) (
|
||||
\UFSRenameFile 22628 . 24665) (\UFSReadPages 24667 . 25802) (\UFSWritePages 25804 . 27024) (
|
||||
\UFSTruncateFile 27026 . 28523) (\UFSDirectoryNameP 28525 . 29579) (\UFSEventFn 29581 . 30243) (
|
||||
\UFSGetFileInfo 30245 . 32527) (\UFS.CREATE.PROPS 32529 . 32882) (\UFSSetFileInfo 32884 . 34113) (
|
||||
\UFSGenerateFiles 34115 . 40995) (\UFS.NEXTFILEFN 40997 . 48635) (\UFS.FILEINFOFN 48637 . 50086) (
|
||||
\UFS.VALID.PROPP 50088 . 50380) (\UFS.REGISTER.GFS 50382 . 50637) (\UFS.UNREGISTER.GFS 50639 . 51222)
|
||||
(\UFS.ABORT.DIRECTORY 51224 . 51572) (\UFS.ABORT.CL-DIRECTORY 51574 . 51861) (\UFS.CLEANUP.GFS.TABLE
|
||||
51863 . 52045)) (52082 58766 (\UFSMakeUnixFormatName 52092 . 53113) (\UFSParseNameString 53115 . 53489
|
||||
) (\UFSParse-Directory 53491 . 54032) (\UFS.PARSE.BODY 54034 . 54579) (\UFS.ADJUST.HOST 54581 . 54740)
|
||||
(\UFS.FULLNAME 54742 . 55950) (\UFS.ADD.HOST.FIELD 55952 . 56312) (\UFS.REMOVE.HOST.FIELD 56314 .
|
||||
57984) (\UFS.HANDLE.RELATIVEDIRECTORY 57986 . 58764)) (59582 60195 (CHDIR 59592 . 60193)) (60267 61253
|
||||
(\DEVICEFILE.EOSERROR 60277 . 61251)) (61326 62563 (\UNVISIBLE.PAGED.REVALIDATEFILELST 61336 . 62181)
|
||||
(\UNVISIBLE.FLUSH.OPEN.STREAMS 62183 . 62561)) (62596 64222 (\UFSError 62606 . 64220)) (64266 66681 (
|
||||
\UFSGetFileType 64276 . 64877) (\UFSSetFileType 64879 . 65476) (\UFSeol 65478 . 66679)) (75328 76452 (
|
||||
\UFSGetPrintFileType 75338 . 75750) (\UFSGetFileTypeConfirm 75752 . 76200) (\UFSPrintTypeMenu 76202 .
|
||||
76450)) (76482 79320 (\UFStoOtherCopyMess 76492 . 78170) (\UFStoOtherRenameMess 78172 . 79318)))))
|
||||
STOP
|
||||
|
||||
BIN
sources/UFS.LCOM
BIN
sources/UFS.LCOM
Binary file not shown.
@@ -1417,4 +1417,4 @@
|
||||
65259 62826) (65260 62827) (65262 62829) (65264 62830) (65266 62833) (65267 62831) (65268 62832) (
|
||||
65269 62834) (65270 62835) (65271 62836) (65272 62837) (65273 62838) (65274 62839) (65275 62840) (
|
||||
65276 62841))]
|
||||
[255 ((65292 8484) (65294 8485))]
|
||||
[255 ((65292 8484) (65294 8485) (65533 61639))]
|
||||
|
||||
@@ -1358,9 +1358,10 @@
|
||||
61558 8540) (61559 8541) (61560 8542) (61561 8543) (61608 9227) (61609 9225) (61610 9226) (61611 9228)
|
||||
(61612 9229) (61613 9252) (61616 9216) (61617 8196) (61618 8197) (61619 8198) (61620 8192) (61621
|
||||
8193) (61622 8200) (61623 8200) (61624 8595) (61625 8594) (61626 8628) (61627 8609) (61628 8592) (
|
||||
61629 8629) (61630 10550) (61635 8227) (61636 9679) (61644 42) (61646 59) (61666 10692) (61667 8230) (
|
||||
61668 8594) (61671 57) (61673 42) (61676 43) (61677 45) (61678 46) (61679 44) (61686 947) (61687 1103)
|
||||
(61688 12402) (61689 12459) (61690 28450) (61691 21644) (61692 183) (61693 384) (61694 9251))]
|
||||
61629 8629) (61630 10550) (61635 8227) (61636 9679) (61639 65533) (61644 42) (61646 59) (61666 10692)
|
||||
(61667 8230) (61668 8594) (61671 57) (61673 42) (61676 43) (61677 45) (61678 46) (61679 44) (61686 947
|
||||
) (61687 1103) (61688 12402) (61689 12459) (61690 28450) (61691 21644) (61692 183) (61693 384) (61694
|
||||
9251))]
|
||||
[241 ((61729 192) (61730 193) (61731 194) (61732 195) (61733 256) (61734 258) (61735 196) (61736 197)
|
||||
(61737 260) (61738 262) (61739 264) (61740 266) (61741 199) (61742 268) (61743 270) (61744 200) (61745
|
||||
201) (61746 202) (61747 274) (61748 278) (61749 203) (61750 280) (61751 282) (61752 500) (61753 284)
|
||||
|
||||
@@ -85,6 +85,7 @@
|
||||
0xF0BE 0x2936 # ⤶ ARROW POINTING DOWNWARDS THEN CURVING LEFTWARDS
|
||||
0xF0C3 0x2023 # ‣ TRIANGULAR BULLET
|
||||
0xF0C4 0x25CF # ● BLACK CIRCLE
|
||||
0xF0C7 0xFFFD # REPLACEMENT CHARACTER
|
||||
0xF0CC 0x002A 0x0305 # *̅ ASTERISK; COMBINING OVERLINE
|
||||
0xF0CE 0x003B 0x0305 # ;̅ SEMICOLON; COMBINING OVERLINE
|
||||
0xF0E2 0x29C4 # ⧄ SQUARED RISING DIAGONAL SLASH
|
||||
|
||||
Reference in New Issue
Block a user