Merge pull request #799 from Interlisp/rmk48
Rmk48: Miscellaneous minor updates: TEDITFILE, GITFNS, EXTERNALFORMAT, EDITINTERFACE
This commit is contained in:
rmkaplan
GitHub
commit
c92622e09e
@ -1,10 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Feb-2022 12:43:03" {DSK}<home>larry>medley>library>TEDITFILE.;2 247023
|
||||
(FILECREATED "20-Jun-2022 12:06:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDITFILE.;3 248098
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.CHARLOOKS)
|
||||
:CHANGES-TO (VARS TEDITFILECOMS)
|
||||
(FNS TEDIT.GET.PASSWORD)
|
||||
|
||||
:PREVIOUS-DATE "30-Apr-2021 14:46:41" {DSK}<home>larry>medley>library>TEDITFILE.;1)
|
||||
:PREVIOUS-DATE "20-Feb-2022 12:43:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDITFILE.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -23,7 +26,7 @@ Copyright (c) 1983-1994, 1999-2001, 2021-2022 by Venue & Xerox Corporation.
|
||||
|
||||
(FNS TEDIT.BUILD.PCTB \TEDIT.CONVERT.FOREIGN.FORMAT TEDIT.FORMATTEDFILEP TEDIT.GET
|
||||
TEDIT.PARSE.PAGEFRAMES1 \ARBIN \ATMIN \DWIN \STRINGIN \TEDIT.FORMATTEDP1
|
||||
\TEDIT.SET.WINDOW))
|
||||
\TEDIT.SET.WINDOW TEDIT.GET.PASSWORD))
|
||||
(COMS
|
||||
(* ;; "INCLUDEing a file")
|
||||
|
||||
@ -877,6 +880,24 @@ Copyright (c) 1983-1994, 1999-2001, 2021-2022 by Venue & Xerox Corporation.
|
||||
(PROG1 (CONS (CAR TOWIND)
|
||||
(fetch (TEXTOBJ \WINDOW) of (CAR TOWIND)))
|
||||
(replace (TEXTOBJ \WINDOW) of (CAR TOWIND) with (CDR TOWIND)))])
|
||||
|
||||
(TEDIT.GET.PASSWORD
|
||||
[LAMBDA (FILE LEN) (* ; "Edited 20-Jun-2022 12:04 by rmk")
|
||||
|
||||
(* ;; "Returns the TEDIT password of FILE, if it is a TEDIT formatted file")
|
||||
|
||||
(LET (DESCPTR NPIECES PASSWORD)
|
||||
(CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
|
||||
(CL:UNLESS LEN
|
||||
(SETQ LEN (GETEOFPTR STREAM)))
|
||||
(CL:WHEN (IGREATERP LEN 8)
|
||||
(SETFILEPTR STREAM (IDIFFERENCE LEN 8)) (* ;
|
||||
"Move to start of FILEPTR to descriptions")
|
||||
(SETQ DESCPTR (\DWIN STREAM)) (* ;
|
||||
"Read the file pos of the descriptions")
|
||||
(SETQ NPIECES (\SMALLPIN STREAM))
|
||||
[CAR (MEMB (\SMALLPIN STREAM)
|
||||
'(31415 31416 31417 31418 31419])])
|
||||
)
|
||||
|
||||
|
||||
@ -3657,25 +3678,25 @@ Copyright (c) 1983-1994, 1999-2001, 2021-2022 by Venue & Xerox Corporation.
|
||||
(PUTPROPS TEDITFILE COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1991 1992 1993 1994 1999 2000 2001 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3026 57932 (TEDIT.BUILD.PCTB 3036 . 37489) (\TEDIT.CONVERT.FOREIGN.FORMAT 37491 . 38932
|
||||
) (TEDIT.FORMATTEDFILEP 38934 . 42798) (TEDIT.GET 42800 . 51616) (TEDIT.PARSE.PAGEFRAMES1 51618 .
|
||||
53324) (\ARBIN 53326 . 53947) (\ATMIN 53949 . 54278) (\DWIN 54280 . 54558) (\STRINGIN 54560 . 55157) (
|
||||
\TEDIT.FORMATTEDP1 55159 . 57423) (\TEDIT.SET.WINDOW 57425 . 57930)) (57968 78496 (TEDIT.INCLUDE 57978
|
||||
. 69365) (TEDIT.RAW.INCLUDE 69367 . 78494)) (78530 122770 (TEDIT.PUT 78540 . 88913) (TEDIT.PUT.PCTB
|
||||
88915 . 116506) (\TEDIT.PUTRESET 116508 . 116754) (TEDIT.PUT.PIECE.DESCRIPTOR 116756 . 119219) (
|
||||
\ARBOUT 119221 . 120421) (\ATMOUT 120423 . 120938) (\DWOUT 120940 . 121223) (\STRINGOUT 121225 .
|
||||
121677) (\TEDIT-OPEN-FONT-FILE 121679 . 122768)) (122771 134037 (\TEDIT.GET.CHARLOOKS.LIST 122781 .
|
||||
123186) (\TEDIT.GET.SINGLE.CHARLOOKS 123188 . 126987) (\TEDIT.PUT.CHARLOOKS.LIST 126989 . 128784) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS 128786 . 134035)) (134038 148317 (\TEDIT.GET.PARALOOKS.LIST 134048 .
|
||||
134461) (\TEDIT.GET.SINGLE.PARALOOKS 134463 . 140857) (\TEDIT.PUT.PARALOOKS.LIST 140859 . 141853) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS 141855 . 148315)) (148625 209886 (TEDIT.BUILD.PCTB2 148635 . 161991) (
|
||||
\TEDIT.GET.CHARLOOKS.LIST2 161993 . 162400) (\TEDIT.GET.SINGLE.CHARLOOKS2 162402 . 165314) (
|
||||
\TEDIT.PUT.SINGLE.PARALOOKS2 165316 . 170030) (\TEDIT.PUT.SINGLE.CHARLOOKS2 170032 . 174528) (
|
||||
\TEDIT.GET.PARALOOKS.LIST2 174530 . 174937) (\TEDIT.GET.SINGLE.PARALOOKS2 174939 . 179527) (
|
||||
TEDIT.PUT.PCTB2 179529 . 207190) (\TEDIT.PUT.CHARLOOKS.LIST2 207192 . 208989) (
|
||||
\TEDIT.PUT.PARALOOKS.LIST2 208991 . 209884)) (209963 231087 (TEDIT.BUILD.PCTB1 209973 . 220163) (
|
||||
TEDIT.GET.PAGEFRAMES1 220165 . 220420) (\TEDIT.GET.CHARLOOKS1 220422 . 223972) (\TEDIT.GET.PARALOOKS1
|
||||
223974 . 228555) (TEDIT.GET.OBJECT1 228557 . 231085)) (231147 246853 (TEDIT.BUILD.PCTB0 231157 .
|
||||
236864) (TEDIT.GET.CHARLOOKS0 236866 . 240885) (TEDIT.GET.OBJECT0 240887 . 243415) (
|
||||
TEDIT.GET.PARALOOKS0 243417 . 246851)))))
|
||||
(FILEMAP (NIL (3129 59007 (TEDIT.BUILD.PCTB 3139 . 37592) (\TEDIT.CONVERT.FOREIGN.FORMAT 37594 . 39035
|
||||
) (TEDIT.FORMATTEDFILEP 39037 . 42901) (TEDIT.GET 42903 . 51719) (TEDIT.PARSE.PAGEFRAMES1 51721 .
|
||||
53427) (\ARBIN 53429 . 54050) (\ATMIN 54052 . 54381) (\DWIN 54383 . 54661) (\STRINGIN 54663 . 55260) (
|
||||
\TEDIT.FORMATTEDP1 55262 . 57526) (\TEDIT.SET.WINDOW 57528 . 58033) (TEDIT.GET.PASSWORD 58035 . 59005)
|
||||
) (59043 79571 (TEDIT.INCLUDE 59053 . 70440) (TEDIT.RAW.INCLUDE 70442 . 79569)) (79605 123845 (
|
||||
TEDIT.PUT 79615 . 89988) (TEDIT.PUT.PCTB 89990 . 117581) (\TEDIT.PUTRESET 117583 . 117829) (
|
||||
TEDIT.PUT.PIECE.DESCRIPTOR 117831 . 120294) (\ARBOUT 120296 . 121496) (\ATMOUT 121498 . 122013) (
|
||||
\DWOUT 122015 . 122298) (\STRINGOUT 122300 . 122752) (\TEDIT-OPEN-FONT-FILE 122754 . 123843)) (123846
|
||||
135112 (\TEDIT.GET.CHARLOOKS.LIST 123856 . 124261) (\TEDIT.GET.SINGLE.CHARLOOKS 124263 . 128062) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST 128064 . 129859) (\TEDIT.PUT.SINGLE.CHARLOOKS 129861 . 135110)) (135113
|
||||
149392 (\TEDIT.GET.PARALOOKS.LIST 135123 . 135536) (\TEDIT.GET.SINGLE.PARALOOKS 135538 . 141932) (
|
||||
\TEDIT.PUT.PARALOOKS.LIST 141934 . 142928) (\TEDIT.PUT.SINGLE.PARALOOKS 142930 . 149390)) (149700
|
||||
210961 (TEDIT.BUILD.PCTB2 149710 . 163066) (\TEDIT.GET.CHARLOOKS.LIST2 163068 . 163475) (
|
||||
\TEDIT.GET.SINGLE.CHARLOOKS2 163477 . 166389) (\TEDIT.PUT.SINGLE.PARALOOKS2 166391 . 171105) (
|
||||
\TEDIT.PUT.SINGLE.CHARLOOKS2 171107 . 175603) (\TEDIT.GET.PARALOOKS.LIST2 175605 . 176012) (
|
||||
\TEDIT.GET.SINGLE.PARALOOKS2 176014 . 180602) (TEDIT.PUT.PCTB2 180604 . 208265) (
|
||||
\TEDIT.PUT.CHARLOOKS.LIST2 208267 . 210064) (\TEDIT.PUT.PARALOOKS.LIST2 210066 . 210959)) (211038
|
||||
232162 (TEDIT.BUILD.PCTB1 211048 . 221238) (TEDIT.GET.PAGEFRAMES1 221240 . 221495) (
|
||||
\TEDIT.GET.CHARLOOKS1 221497 . 225047) (\TEDIT.GET.PARALOOKS1 225049 . 229630) (TEDIT.GET.OBJECT1
|
||||
229632 . 232160)) (232222 247928 (TEDIT.BUILD.PCTB0 232232 . 237939) (TEDIT.GET.CHARLOOKS0 237941 .
|
||||
241960) (TEDIT.GET.OBJECT0 241962 . 244490) (TEDIT.GET.PARALOOKS0 244492 . 247926)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 4-Jun-2022 20:44:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;313 100657
|
||||
(FILECREATED "20-Jun-2022 11:09:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;315 100727
|
||||
|
||||
:CHANGES-TO (FNS GIT-BRANCH-DIFF)
|
||||
:CHANGES-TO (VARS GITFNSCOMS)
|
||||
|
||||
:PREVIOUS-DATE "29-May-2022 21:59:23"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;312)
|
||||
:PREVIOUS-DATE " 4-Jun-2022 20:44:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GITFNS.;313)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT GITFNSCOMS)
|
||||
@ -32,7 +32,8 @@
|
||||
fontsold/ clos/ cltl2/)
|
||||
'(greetfiles scripts sources library lispusers))
|
||||
(GIT-MAKE-PROJECT 'NOTECARDS T T '(online/))
|
||||
(GIT-MAKE-PROJECT 'LOOPS T T))
|
||||
(GIT-MAKE-PROJECT 'LOOPS T T)
|
||||
(GIT-MAKE-PROJECT 'TEST T T))
|
||||
|
||||
(* ;; "")
|
||||
|
||||
@ -365,6 +366,8 @@
|
||||
|
||||
(GIT-MAKE-PROJECT 'LOOPS T T)
|
||||
|
||||
(GIT-MAKE-PROJECT 'TEST T T)
|
||||
|
||||
|
||||
|
||||
(* ;; "")
|
||||
@ -1911,28 +1914,28 @@
|
||||
|
||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3384 17231 (GIT-CLONEP 3394 . 4657) (GIT-MAKE-PROJECT 4659 . 12771) (GIT-GET-PROJECT
|
||||
12773 . 14110) (GIT-PROJECT-PATH 14112 . 15156) (FIND-ANCESTOR-DIRECTORY 15158 . 15507) (
|
||||
GIT-FIND-CLONE 15509 . 16590) (GIT-MAINBRANCH 16592 . 16876) (GIT-MAINBRANCH? 16878 . 17229)) (23164
|
||||
25952 (ALLSUBDIRS 23174 . 24460) (MEDLEYSUBDIRS 24462 . 25155) (GITSUBDIRS 25157 . 25950)) (25953
|
||||
30743 (TOGIT 25963 . 27369) (FROMGIT 27371 . 28352) (GIT-DELETE-FILE 28354 . 29200) (
|
||||
MYMEDLEY-DELETE-FILES 29202 . 30741)) (30744 33276 (MYMEDLEYSUBDIR 30754 . 31210) (GITSUBDIR 31212 .
|
||||
31655) (STRIPDIR 31657 . 32028) (STRIPHOST 32030 . 32270) (STRIPNAME 32272 . 33025) (STRIPWHERE 33027
|
||||
. 33274)) (33277 35179 (GFILE4MFILE 33287 . 33650) (MFILE4GFILE 33652 . 34221) (GIT-REPO-FILENAME
|
||||
34223 . 35177)) (35228 43029 (GIT-COMMIT 35238 . 36064) (GIT-PUSH 36066 . 36710) (GIT-PULL 36712 .
|
||||
37324) (GIT-APPROVAL 37326 . 37675) (GIT-GET-FILE 37677 . 40196) (GIT-FILE-EXISTS? 40198 . 41142) (
|
||||
GIT-REMOTE-UPDATE 41144 . 41868) (GIT-REMOTE-ADD 41870 . 42177) (GIT-FILE-DATE 42179 . 43027)) (43059
|
||||
51650 (GIT-BRANCH-DIFF 43069 . 47821) (GIT-COMMIT-DIFFS 47823 . 48267) (GIT-BRANCH-RELATIONS 48269 .
|
||||
51648)) (51695 60630 (GIT-BRANCH-NUM 51705 . 52278) (GIT-CHECKOUT 52280 . 52792) (GIT-WHICH-BRANCH
|
||||
52794 . 53092) (GIT-MAKE-BRANCH 53094 . 54838) (GIT-BRANCHES 54840 . 56331) (GIT-BRANCH-EXISTS? 56333
|
||||
. 57037) (GIT-PICK-BRANCH 57039 . 57367) (GIT-PRC-MENU 57369 . 58997) (GIT-PULL-REQUESTS 58999 .
|
||||
60016) (GIT-SHORT-BRANCH-NAME 60018 . 60309) (GIT-LONG-NAME 60311 . 60628)) (60660 63995 (
|
||||
GIT-MY-CURRENT-BRANCH 60670 . 61040) (GIT-MY-BRANCHP 61042 . 61547) (GIT-MY-NEXT-BRANCH 61549 . 62043)
|
||||
(GIT-MY-BRANCHES 62045 . 63993)) (64041 67993 (GIT-ADD-WORKTREE 64051 . 65535) (GIT-REMOVE-WORKTREE
|
||||
65537 . 66467) (GIT-LIST-WORKTREES 66469 . 67273) (WORKTREEDIR 67275 . 67991)) (68041 97537 (
|
||||
GIT-GET-DIFFERENT-FILES 68051 . 73876) (GIT-BRANCHES-COMPARE-DIRECTORIES 73878 . 79720) (
|
||||
GIT-WORKING-COMPARE-DIRECTORIES 79722 . 84188) (GIT-COMPARE-WORKTREE 84190 . 88063) (GITCDOBJBUTTONFN
|
||||
88065 . 92555) (GIT-CD-LABELFN 92557 . 93639) (GIT-CD-MENUFN 93641 . 95848) (GIT-WORKING-COMPARE-FILES
|
||||
95850 . 96369) (GIT-BRANCHES-COMPARE-FILES 96371 . 97535)) (97607 100590 (CDGITDIR 97617 . 97995) (
|
||||
GIT-COMMAND 97997 . 99583) (GITORIGIN 99585 . 100282) (GIT-INITIALS 100284 . 100588)))))
|
||||
(FILEMAP (NIL (3420 17267 (GIT-CLONEP 3430 . 4693) (GIT-MAKE-PROJECT 4695 . 12807) (GIT-GET-PROJECT
|
||||
12809 . 14146) (GIT-PROJECT-PATH 14148 . 15192) (FIND-ANCESTOR-DIRECTORY 15194 . 15543) (
|
||||
GIT-FIND-CLONE 15545 . 16626) (GIT-MAINBRANCH 16628 . 16912) (GIT-MAINBRANCH? 16914 . 17265)) (23234
|
||||
26022 (ALLSUBDIRS 23244 . 24530) (MEDLEYSUBDIRS 24532 . 25225) (GITSUBDIRS 25227 . 26020)) (26023
|
||||
30813 (TOGIT 26033 . 27439) (FROMGIT 27441 . 28422) (GIT-DELETE-FILE 28424 . 29270) (
|
||||
MYMEDLEY-DELETE-FILES 29272 . 30811)) (30814 33346 (MYMEDLEYSUBDIR 30824 . 31280) (GITSUBDIR 31282 .
|
||||
31725) (STRIPDIR 31727 . 32098) (STRIPHOST 32100 . 32340) (STRIPNAME 32342 . 33095) (STRIPWHERE 33097
|
||||
. 33344)) (33347 35249 (GFILE4MFILE 33357 . 33720) (MFILE4GFILE 33722 . 34291) (GIT-REPO-FILENAME
|
||||
34293 . 35247)) (35298 43099 (GIT-COMMIT 35308 . 36134) (GIT-PUSH 36136 . 36780) (GIT-PULL 36782 .
|
||||
37394) (GIT-APPROVAL 37396 . 37745) (GIT-GET-FILE 37747 . 40266) (GIT-FILE-EXISTS? 40268 . 41212) (
|
||||
GIT-REMOTE-UPDATE 41214 . 41938) (GIT-REMOTE-ADD 41940 . 42247) (GIT-FILE-DATE 42249 . 43097)) (43129
|
||||
51720 (GIT-BRANCH-DIFF 43139 . 47891) (GIT-COMMIT-DIFFS 47893 . 48337) (GIT-BRANCH-RELATIONS 48339 .
|
||||
51718)) (51765 60700 (GIT-BRANCH-NUM 51775 . 52348) (GIT-CHECKOUT 52350 . 52862) (GIT-WHICH-BRANCH
|
||||
52864 . 53162) (GIT-MAKE-BRANCH 53164 . 54908) (GIT-BRANCHES 54910 . 56401) (GIT-BRANCH-EXISTS? 56403
|
||||
. 57107) (GIT-PICK-BRANCH 57109 . 57437) (GIT-PRC-MENU 57439 . 59067) (GIT-PULL-REQUESTS 59069 .
|
||||
60086) (GIT-SHORT-BRANCH-NAME 60088 . 60379) (GIT-LONG-NAME 60381 . 60698)) (60730 64065 (
|
||||
GIT-MY-CURRENT-BRANCH 60740 . 61110) (GIT-MY-BRANCHP 61112 . 61617) (GIT-MY-NEXT-BRANCH 61619 . 62113)
|
||||
(GIT-MY-BRANCHES 62115 . 64063)) (64111 68063 (GIT-ADD-WORKTREE 64121 . 65605) (GIT-REMOVE-WORKTREE
|
||||
65607 . 66537) (GIT-LIST-WORKTREES 66539 . 67343) (WORKTREEDIR 67345 . 68061)) (68111 97607 (
|
||||
GIT-GET-DIFFERENT-FILES 68121 . 73946) (GIT-BRANCHES-COMPARE-DIRECTORIES 73948 . 79790) (
|
||||
GIT-WORKING-COMPARE-DIRECTORIES 79792 . 84258) (GIT-COMPARE-WORKTREE 84260 . 88133) (GITCDOBJBUTTONFN
|
||||
88135 . 92625) (GIT-CD-LABELFN 92627 . 93709) (GIT-CD-MENUFN 93711 . 95918) (GIT-WORKING-COMPARE-FILES
|
||||
95920 . 96439) (GIT-BRANCHES-COMPARE-FILES 96441 . 97605)) (97677 100660 (CDGITDIR 97687 . 98065) (
|
||||
GIT-COMMAND 98067 . 99653) (GITORIGIN 99655 . 100352) (GIT-INITIALS 100354 . 100658)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-May-2022 08:16:23"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;44 47034
|
||||
(FILECREATED "22-Jun-2022 13:32:08"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;45 47672
|
||||
|
||||
:CHANGES-TO (FNS FIXEDITDATE EDITDATE?)
|
||||
:CHANGES-TO (FNS FIXEDITDATE)
|
||||
|
||||
:PREVIOUS-DATE "12-May-2022 23:21:03"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>EDITINTERFACE.;43)
|
||||
:PREVIOUS-DATE "13-May-2022 08:16:23"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EDITINTERFACE.;44)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -629,6 +629,8 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(FIXEDITDATE
|
||||
[LAMBDA (EXPR)
|
||||
|
||||
(* ;; "Edited 22-Jun-2022 13:31 by rmk")
|
||||
|
||||
(* ;; "Edited 13-May-2022 08:11 by rmk")
|
||||
|
||||
(* ;; "Edited 8-May-2022 22:49 by rmk")
|
||||
@ -702,10 +704,10 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
|
||||
(* ;; "E is now the cell that the date will attach to or whose CAR will be updated.")
|
||||
|
||||
[LET (PARSE COMMENTLEVEL (INITLS (CL:IF (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE INITIALS -1))
|
||||
(SUBSTRING INITIALS 1 -2)
|
||||
INITIALS)))
|
||||
[LET (PARSE COMMENTLEVEL ENDINITIALS (INITLS (CL:IF (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE INITIALS -1))
|
||||
(SUBSTRING INITIALS 1 -2)
|
||||
INITIALS)))
|
||||
(IF *REPLACE-OLD-EDIT-DATES*
|
||||
THEN
|
||||
(* ;; "Strip out all previous modern-format edit dates. Since EDITDATE? only recognizes that format, hand editing is needed if prehistoric dates are really not desired. We don't strip out anything with a further comment.")
|
||||
@ -753,12 +755,18 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
(MEMB [CAR (LISTP (SETQ PARSE (CDAR E]
|
||||
'(; ;; ;;;))
|
||||
[STRINGP (SETQ PARSE (CAR (LISTP (CDR PARSE]
|
||||
(STRPOS (CONCAT INITLS ": ")
|
||||
PARSE 1 NIL NIL T))
|
||||
(SETQ ENDINITIALS (STRPOS INITLS PARSE 1 NIL NIL T
|
||||
UPPERCASEARRAY)))
|
||||
THEN
|
||||
(* ;;
|
||||
"Just an ordinary comment in first position, with initials: in front. Upgrade it to an edit date.")
|
||||
|
||||
(SETQ PARSE (CONCAT INITLS (CL:IF (EQ (CHARCODE %:)
|
||||
(NTHCHARCODE PARSE
|
||||
ENDINITIALS))
|
||||
""
|
||||
": ")
|
||||
(SUBSTRING PARSE ENDINITIALS)))
|
||||
(/RPLACA E (EDITDATE (CAR E)
|
||||
NIL PARSE))
|
||||
ELSE
|
||||
@ -941,6 +949,6 @@ Copyright (c) 1986-1988, 1990-1991 by Venue & Xerox Corporation.
|
||||
18767) (EDITLOADFNS? 18769 . 22569) (EDITMODE 22571 . 24581) (EDITP 24583 . 25094) (EDITV 25096 .
|
||||
25735) (DC 25737 . 26418) (DF 26420 . 27462) (DP 27464 . 28548) (DV 28550 . 29122) (EDITPROP 29124 .
|
||||
29343) (EF 29345 . 29674) (EP 29676 . 29859) (EV 29861 . 30040) (EDITE 30042 . 30920) (EDITL 30922 .
|
||||
31148)) (31500 46179 (NEW/EDITDATE 31510 . 31732) (FIXEDITDATE 31734 . 39703) (EDITDATE? 39705 . 42733
|
||||
) (EDITDATE 42735 . 44182) (SETINITIALS 44184 . 46177)))))
|
||||
31148)) (31500 46817 (NEW/EDITDATE 31510 . 31732) (FIXEDITDATE 31734 . 40341) (EDITDATE? 40343 . 43371
|
||||
) (EDITDATE 43373 . 44820) (SETINITIALS 44822 . 46815)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@ -1,18 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "19-Sep-2021 08:59:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;16 31868
|
||||
|
||||
changes to%: (VARS EXTERNALFORMATCOMS)
|
||||
(FILECREATED "22-Jun-2022 11:09:34"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;30 32742
|
||||
|
||||
previous date%: "11-Sep-2021 09:44:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>EXTERNALFORMAT.;15)
|
||||
:CHANGES-TO (FNS \FORMATBYTESTREAM \FORMATBYTESTRING \EXTERNALFORMAT)
|
||||
(RESOURCES \FORMATBYTESTRING.STREAM)
|
||||
(VARS EXTERNALFORMATCOMS)
|
||||
|
||||
:PREVIOUS-DATE "18-Jun-2022 22:04:22"
|
||||
{DSK}<users>kaplan>local>medley3.5>working-medley>sources>EXTERNALFORMAT.;21)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT EXTERNALFORMATCOMS)
|
||||
|
||||
(RPAQQ EXTERNALFORMATCOMS
|
||||
[(COMS (* ;
|
||||
"EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
|
||||
"EXTERNALFORMAT declaration and related functions (originally on FILEIO)")
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (RECORDS EXTERNALFORMAT)))
|
||||
(INITRECORDS EXTERNALFORMAT)
|
||||
(SYSRECORDS EXTERNALFORMAT)
|
||||
@ -22,12 +25,14 @@
|
||||
(INITVARS (*EXTERNALFORMATS* NIL)
|
||||
[*DEFAULT-EXTERNALFORMATS* '((DSK :XCCS]
|
||||
(*DEFAULT-EXTERNALFORMAT* :XCCS)))
|
||||
[COMS
|
||||
(COMS
|
||||
(* ;; "Generic functions not compiled open (originally on LLREAD)")
|
||||
|
||||
(FNS \OUTCHAR \INCCODE \BACKCCODE \BACKCCODE.EOLC \PEEKCCODE \PEEKCCODE.NOEOLC
|
||||
\INCCODE.EOLC \FORMATBYTESTREAM \CHECKEOLC.CRLF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC]
|
||||
\INCCODE.EOLC \FORMATBYTESTREAM \FORMATBYTESTRING \CHECKEOLC.CRLF)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY (EXPORT (MACROS \CHECKEOLC))
|
||||
(RESOURCES \FORMATBYTESTRING.STREAM))
|
||||
(INITRESOURCES \FORMATBYTESTRING.STREAM))
|
||||
(COMS
|
||||
(* ;; "Also from FILEIO, but not clear that this is or ever has been used.")
|
||||
|
||||
@ -41,28 +46,30 @@
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG) (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)))
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) (* ; "If true, the value of EOL field will replace the EOLCONVENTION field of the resulted stream. (Can't test EOL because it is always something)")
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG) (* ; "T if (like XCCS runcodes) the byte encoding of a given character can change by other signals in the file, NIL if every charactercode has a single byte encoding (like UTF-8). ")
|
||||
(INCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and 2 optional arguments, BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(PEEKCCODEFN POINTER) (* ;
|
||||
"Called with three arguments -- STREAM, NOERROR, and EOL")
|
||||
(BACKCCODEFN POINTER) (* ;
|
||||
"Called with STREAM and optional BYTECOUNTVAR and BYTECOUNTVAL")
|
||||
(OUTCHARFN POINTER) (* ;
|
||||
"Called with two arguments -- STREAM and CHARCODE")
|
||||
(NAME POINTER) (* ;
|
||||
"keyword name of this format, provided to \INSTALL.EXTERNALFORMAT")
|
||||
(FORMATBYTESTREAMFN POINTER) (* ; "Function to copy the format state of a given stream to an IO stream that allows formatted byte sequences to be examined")
|
||||
(EF1 POINTER) (* ;
|
||||
"Extra fields for use of particular formats. Possibly to hold standardized translation tables")
|
||||
(EF2 POINTER)
|
||||
(FORMATBYTESTRINGFN POINTER) (* ; "Translates an internal string into a string containing the bytes that represent that string in this format")
|
||||
))
|
||||
)
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
POINTER POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
@ -73,8 +80,9 @@
|
||||
(EXTERNALFORMAT 8 POINTER)
|
||||
(EXTERNALFORMAT 10 POINTER)
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER))
|
||||
'16)
|
||||
(EXTERNALFORMAT 14 POINTER)
|
||||
(EXTERNALFORMAT 16 POINTER))
|
||||
'18)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@ -82,7 +90,7 @@
|
||||
|
||||
(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2)
|
||||
FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER
|
||||
POINTER)
|
||||
POINTER POINTER)
|
||||
'((EXTERNALFORMAT 0 (FLAGBITS . 0))
|
||||
(EXTERNALFORMAT 0 (BITS . 17))
|
||||
(EXTERNALFORMAT 0 (FLAGBITS . 48))
|
||||
@ -93,29 +101,36 @@
|
||||
(EXTERNALFORMAT 8 POINTER)
|
||||
(EXTERNALFORMAT 10 POINTER)
|
||||
(EXTERNALFORMAT 12 POINTER)
|
||||
(EXTERNALFORMAT 14 POINTER))
|
||||
'16)
|
||||
(EXTERNALFORMAT 14 POINTER)
|
||||
(EXTERNALFORMAT 16 POINTER))
|
||||
'18)
|
||||
(ADDTOVAR SYSTEMRECLST
|
||||
|
||||
(DATATYPE EXTERNALFORMAT ((EOLVALID FLAG)
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG)
|
||||
(INCCODEFN POINTER)
|
||||
(PEEKCCODEFN POINTER)
|
||||
(BACKCCODEFN POINTER)
|
||||
(OUTCHARFN POINTER)
|
||||
(NAME POINTER)
|
||||
(FORMATBYTESTREAMFN POINTER)
|
||||
(EF1 POINTER)
|
||||
(EF2 POINTER)))
|
||||
(EOL BITS 2)
|
||||
(UNSTABLE FLAG)
|
||||
(INCCODEFN POINTER)
|
||||
(PEEKCCODEFN POINTER)
|
||||
(BACKCCODEFN POINTER)
|
||||
(OUTCHARFN POINTER)
|
||||
(NAME POINTER)
|
||||
(FORMATBYTESTREAMFN POINTER)
|
||||
(EF1 POINTER)
|
||||
(EF2 POINTER)
|
||||
(FORMATBYTESTRINGFN POINTER)))
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\EXTERNALFORMAT
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME) (* ; "Edited 10-Sep-2021 20:44 by rmk:")
|
||||
(* ; "Edited 26-Feb-91 13:20 by nm")
|
||||
[LAMBDA (STREAM NEWFORMAT/NAME)
|
||||
|
||||
(* ;;; ";;; RMK July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
|
||||
(* ;; "Edited 22-Jun-2022 09:40 by rmk: NEWFORMAT/NAME can be a stream, picks its externalformat")
|
||||
|
||||
(* ;; "Edited 10-Sep-2021 20:44 by rmk:")
|
||||
|
||||
(* ;; "Edited 26-Feb-91 13:20 by nm")
|
||||
|
||||
(* ;;; " July 2020: Added interface for per-device default external format. \DO.PARAMS.AT.OPEN will make that call even if it is not specified from the open. STREAMPROP is fixed to call \EXTERNALFORMAT to set the property EXTERNALFORMAT, to export a user-level way of manipulating this.")
|
||||
|
||||
(* ;;; "")
|
||||
|
||||
@ -128,52 +143,39 @@
|
||||
(* ;;; "The all-device default is in *DEFAULT-EXTERNALFORMAT* or the DEFAULTEXTERNALFORMAT field of the file device. The list currently has priority since that makes it easier for a user without EXPORTS.ALL to systematically override. That may or may not be a useful capability. ")
|
||||
|
||||
(\DTEST STREAM 'STREAM)
|
||||
(SETQ SAVEDNAME (fetch DEVICENAME of (fetch DEVICE of STREAM)))
|
||||
(SETQ SAVEDDEFAULTFORMATNAME (fetch (FDEV DEFAULTEXTERNALFORMAT) of (fetch DEVICE
|
||||
of STREAM)))
|
||||
(SETQ FOUNDFORMAT (FIND-FORMAT SAVEDDEFAULTFORMATNAME T))
|
||||
(CL:WHEN NEWFORMAT/NAME
|
||||
(CL:WHEN (type? READER-ENVIRONMENT NEWFORMAT/NAME)
|
||||
(SETQ NEWFORMAT/NAME (fetch (READER-ENVIRONMENT REFORMAT) of NEWFORMAT/NAME)))
|
||||
[LET (EXTFORMAT)
|
||||
[COND
|
||||
((type? EXTERNALFORMAT NEWFORMAT/NAME)
|
||||
(SETQ EXTFORMAT NEWFORMAT/NAME))
|
||||
(T (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
|
||||
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
|
||||
of (fetch DEVICE of
|
||||
STREAM))
|
||||
*DEFAULT-EXTERNALFORMATS*))
|
||||
(fetch (FDEV DEFAULTEXTERNALFORMAT)
|
||||
of (fetch DEVICE of STREAM))
|
||||
*DEFAULT-EXTERNALFORMAT*)))
|
||||
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
|
||||
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
|
||||
"is not a registered external format name"))
|
||||
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
|
||||
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT]
|
||||
(if (type? EXTERNALFORMAT NEWFORMAT/NAME)
|
||||
then (SETQ EXTFORMAT NEWFORMAT/NAME)
|
||||
elseif (\GETSTREAM NEWFORMAT/NAME NIL T)
|
||||
then (SETQ EXTFORMAT (ffetch (STREAM EXTERNALFORMAT) of NEWFORMAT/NAME))
|
||||
else (CL:WHEN (EQ NEWFORMAT/NAME :DEFAULT)
|
||||
(SETQ NEWFORMAT/NAME (OR (CADR (ASSOC (fetch DEVICENAME
|
||||
of (fetch DEVICE of STREAM))
|
||||
*DEFAULT-EXTERNALFORMATS*))
|
||||
(fetch (FDEV DEFAULTEXTERNALFORMAT)
|
||||
of (fetch DEVICE of STREAM))
|
||||
*DEFAULT-EXTERNALFORMAT*)))
|
||||
(SETQ EXTFORMAT (FIND-FORMAT NEWFORMAT/NAME))
|
||||
(CL:UNLESS EXTFORMAT (ERROR NEWFORMAT/NAME
|
||||
"is not a registered external format name")))
|
||||
(CL:UNLESS (type? EXTERNALFORMAT EXTFORMAT)
|
||||
(ERROR "INVALID EXTERNALFORMAT " EXTFORMAT))
|
||||
(UNINTERRUPTABLY
|
||||
(freplace (STREAM EXTERNALFORMAT) of STREAM with EXTFORMAT)
|
||||
(CL:WHEN (ffetch (EXTERNALFORMAT EOLVALID) of EXTFORMAT)
|
||||
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch
|
||||
(EXTERNALFORMAT
|
||||
EOL) of
|
||||
EXTFORMAT
|
||||
)))
|
||||
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT
|
||||
OUTCHARFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT
|
||||
INCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (
|
||||
EXTERNALFORMAT
|
||||
PEEKCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (
|
||||
EXTERNALFORMAT
|
||||
BACKCCODEFN)
|
||||
of EXTFORMAT)))])
|
||||
(freplace (STREAM EOLCONVENTION) of STREAM with (ffetch (EXTERNALFORMAT EOL)
|
||||
of EXTFORMAT)))
|
||||
(freplace (STREAM OUTCHARFN) of STREAM with (ffetch (EXTERNALFORMAT OUTCHARFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM INCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT INCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM PEEKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT PEEKCCODEFN)
|
||||
of EXTFORMAT))
|
||||
(freplace (STREAM BACKCCODEFN) of STREAM with (ffetch (EXTERNALFORMAT BACKCCODEFN)
|
||||
of EXTFORMAT)))])
|
||||
(ffetch (EXTERNALFORMAT NAME) of (fetch (STREAM EXTERNALFORMAT) of STREAM])
|
||||
|
||||
(MAKE-EXTERNALFORMAT
|
||||
@ -333,7 +335,8 @@
|
||||
STREAM])
|
||||
|
||||
(\BACKCCODE.EOLC
|
||||
[LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 14-Aug-2021 00:27 by rmk:")
|
||||
[LAMBDA (STREAM EOLC BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 18-Jun-2022 18:45 by rmk")
|
||||
(* ; "Edited 14-Aug-2021 00:27 by rmk:")
|
||||
|
||||
(* ;; "If the EOLCONVENTION is CRLF, and the first backup is over an LF encoding, this looks to see whether the preceding bytes encode a CR and if so, backs up over those.")
|
||||
|
||||
@ -348,33 +351,32 @@
|
||||
(PROG1 (CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM)
|
||||
(IF (AND (EQ CRLF.EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM))
|
||||
(EQ (CHARCODE LF)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM)))
|
||||
THEN
|
||||
(SELECTC (OR EOLC (ffetch (STREAM EOLCONVENTION) OF STREAM))
|
||||
((LIST CRLF.EOLC ANY.EOLC 'CRLF 'ANY)
|
||||
(CL:WHEN (EQ (CHARCODE LF)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN) of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM))
|
||||
|
||||
(* ;;
|
||||
"We just backed over an LF in a CRLF file. If we go one more, do we get a CR?")
|
||||
(* ;;
|
||||
"We just backed over an LF with EOLC= CRLF or ANY. If we go one more, do we get a CR?")
|
||||
|
||||
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM
|
||||
)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM)
|
||||
(CL:UNLESS (EQ (CHARCODE CR)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
|
||||
of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM))
|
||||
(CL:WHEN (CL:FUNCALL (OR (ffetch (STREAM BACKCCODEFN) of STREAM)
|
||||
\DEFAULTBACKCCODE)
|
||||
STREAM)
|
||||
(CL:UNLESS (EQ (CHARCODE CR)
|
||||
(CL:FUNCALL (OR (ffetch (STREAM PEEKCCODEFN)
|
||||
of STREAM)
|
||||
\DEFAULTPEEKCCODE)
|
||||
STREAM))
|
||||
|
||||
(* ;; "Not a preceding CR, reread it.")
|
||||
(* ;; "Not a preceding CR, reread it.")
|
||||
|
||||
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM))
|
||||
T)
|
||||
ELSE T))
|
||||
(CL:FUNCALL (OR (ffetch (STREAM INCCODEFN) of STREAM)
|
||||
\DEFAULTINCCODE)
|
||||
STREAM)))))
|
||||
NIL)
|
||||
T)
|
||||
(CL:WHEN BYTECOUNTVAR
|
||||
[SET BYTECOUNTVAR (IPLUS (OR BYTECOUNTVAL (\EVALV1 BYTECOUNTVAR))
|
||||
(IDIFFERENCE STARTPOS (\GETFILEPTR STREAM]))])
|
||||
@ -434,14 +436,15 @@
|
||||
STREAM])
|
||||
|
||||
(\FORMATBYTESTREAM
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 17:26 by rmk:")
|
||||
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 22-Jun-2022 11:09 by rmk")
|
||||
(* ; "Edited 24-Jun-2021 17:26 by rmk:")
|
||||
|
||||
(* ;; "Create or modify a stream that will simulate the current character input/output byte sequences of STREAM. The set up here does what is common to all formats: an IO stream starting with STREAM external format and EOL.")
|
||||
|
||||
(* ;; "If the format has its own FORMATBYTESTREAMFN function, that is applied to copy any other state. (Currently that function is a property of the format, not carried over into a stream field that can be changed dynamically.)")
|
||||
|
||||
(CL:UNLESS (AND (STREAMP BYTESTREAM)
|
||||
(\IOMODEP STREAM 'BOTH))
|
||||
(\IOMODEP BYTESTREAM 'BOTH))
|
||||
(SETQ BYTESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH)))
|
||||
(LET ((FORMAT (FETCH (STREAM EXTERNALFORMAT) OF STREAM))
|
||||
(EOLC (FETCH (STREAM EOLCONVENTION) OF STREAM)))
|
||||
@ -450,13 +453,34 @@
|
||||
(SETQ EOLC (OR (FETCH (EXTERNALFORMAT EOL) OF FORMAT)
|
||||
LF.EOLC)))
|
||||
(REPLACE (STREAM EOLCONVENTION) OF BYTESTREAM WITH EOLC)
|
||||
(SETFILEPTR BYTESTREAM 0)
|
||||
(SETFILEINFO BYTESTREAM 'ENDOFSTREAMOP (FUNCTION NILL))
|
||||
(\SETFILEPTR BYTESTREAM 0)
|
||||
(freplace (STREAM ENDOFSTREAMOP) of BYTESTREAM with (FUNCTION NILL))
|
||||
(CL:WHEN (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
(APPLY* (FETCH (EXTERNALFORMAT FORMATBYTESTREAMFN) OF FORMAT)
|
||||
STREAM BYTESTREAM))
|
||||
BYTESTREAM])
|
||||
|
||||
(\FORMATBYTESTRING
|
||||
[LAMBDA (STREAM STRING) (* ; "Edited 22-Jun-2022 11:07 by rmk")
|
||||
(* ; "Edited 18-Jun-2022 22:04 by rmk")
|
||||
|
||||
(* ;; "Produces a string containing the bytes that would represent STRING on STREAM. Presumably this only makes sense for a stable format")
|
||||
|
||||
(WITH-RESOURCE \FORMATBYTESTRING.STREAM (\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(LET [FSTRING NBYTES (BYTESTRINGFN (FETCH (EXTERNALFORMAT FORMATBYTESTRINGFN)
|
||||
OF (FETCH (STREAM EXTERNALFORMAT) OF STREAM]
|
||||
(IF BYTESTRINGFN
|
||||
THEN (APPLY* BYTESTRINGFN STREAM STRING \FORMATBYTESTRING.STREAM)
|
||||
ELSE (\FORMATBYTESTREAM STREAM \FORMATBYTESTRING.STREAM)
|
||||
(FOR C INSTRING STRING DO (\OUTCHAR \FORMATBYTESTRING.STREAM C))
|
||||
(SETQ NBYTES (\GETFILEPTR \FORMATBYTESTRING.STREAM))
|
||||
(\SETFILEPTR \FORMATBYTESTRING.STREAM 0)
|
||||
(SETQ FSTRING (ALLOCSTRING NBYTES))
|
||||
(FOR I FROM 1 TO NBYTES DO (RPLCHARCODE FSTRING I (\BIN
|
||||
\FORMATBYTESTRING.STREAM
|
||||
)))
|
||||
FSTRING])
|
||||
|
||||
(\CHECKEOLC.CRLF
|
||||
[LAMBDA (STREAM PEEKBINFLG COUNTP) (* ; "Edited 6-Aug-2021 23:30 by rmk:")
|
||||
|
||||
@ -514,32 +538,34 @@
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \CHECKEOLC MACRO [OPENLAMBDA (CH EOLC STRM PEEKBINFLG COUNTP)
|
||||
(COND
|
||||
((EQ EOLC 'NOEOLC)
|
||||
CH)
|
||||
(T (SELCHARQ CH
|
||||
(LF (SELECTC (OR EOLC (FFETCH (STREAM
|
||||
EOLCONVENTION
|
||||
)
|
||||
OF STRM))
|
||||
((LIST LF.EOLC ANY.EOLC)
|
||||
(CHARCODE EOL))
|
||||
(CHARCODE LF)))
|
||||
(CR (SELECTC (OR EOLC (FFETCH (STREAM
|
||||
EOLCONVENTION
|
||||
)
|
||||
OF STRM))
|
||||
(CR.EOLC (CHARCODE EOL))
|
||||
((LIST ANY.EOLC CRLF.EOLC)
|
||||
(\CHECKEOLC.CRLF STRM PEEKBINFLG
|
||||
COUNTP))
|
||||
(CHARCODE CR)))
|
||||
CH])
|
||||
(COND
|
||||
((EQ EOLC 'NOEOLC)
|
||||
CH)
|
||||
(T (SELCHARQ CH
|
||||
(LF (SELECTC (OR EOLC (FFETCH (STREAM EOLCONVENTION)
|
||||
OF STRM))
|
||||
((LIST LF.EOLC ANY.EOLC)
|
||||
(CHARCODE EOL))
|
||||
(CHARCODE LF)))
|
||||
(CR (SELECTC (OR EOLC (FFETCH (STREAM EOLCONVENTION)
|
||||
OF STRM))
|
||||
(CR.EOLC (CHARCODE EOL))
|
||||
((LIST ANY.EOLC CRLF.EOLC)
|
||||
(\CHECKEOLC.CRLF STRM PEEKBINFLG COUNTP))
|
||||
(CHARCODE CR)))
|
||||
CH])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
[PUTDEF '\FORMATBYTESTRING.STREAM 'RESOURCES '(NEW (OPENSTREAM '{NODIRCORE} 'BOTH]
|
||||
)
|
||||
)
|
||||
|
||||
(/SETTOPVAL '\\FORMATBYTESTRING.STREAM.GLOBALRESOURCE NIL)
|
||||
|
||||
|
||||
|
||||
@ -594,11 +620,11 @@
|
||||
(\CREATE.THROUGH.EXTERNALFORMAT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5657 12044 (\EXTERNALFORMAT 5667 . 10729) (MAKE-EXTERNALFORMAT 10731 . 12042)) (12045
|
||||
15158 (\INSTALL.EXTERNALFORMAT 12055 . 13504) (\REMOVE.EXTERNALFORMAT 13506 . 14337) (FIND-FORMAT
|
||||
14339 . 15156)) (15488 27986 (\OUTCHAR 15498 . 16634) (\INCCODE 16636 . 17822) (\BACKCCODE 17824 .
|
||||
18718) (\BACKCCODE.EOLC 18720 . 21483) (\PEEKCCODE 21485 . 21801) (\PEEKCCODE.NOEOLC 21803 . 22065) (
|
||||
\INCCODE.EOLC 22067 . 23926) (\FORMATBYTESTREAM 23928 . 25418) (\CHECKEOLC.CRLF 25420 . 27984)) (29929
|
||||
31772 (\CREATE.THROUGH.EXTERNALFORMAT 29939 . 30741) (\THROUGHIN 30743 . 31163) (\THROUGHBACKCCODE
|
||||
31165 . 31432) (\THROUGHOUTCHARFN 31434 . 31770)))))
|
||||
(FILEMAP (NIL (6250 11540 (\EXTERNALFORMAT 6260 . 10225) (MAKE-EXTERNALFORMAT 10227 . 11538)) (11541
|
||||
14654 (\INSTALL.EXTERNALFORMAT 11551 . 13000) (\REMOVE.EXTERNALFORMAT 13002 . 13833) (FIND-FORMAT
|
||||
13835 . 14652)) (14984 29243 (\OUTCHAR 14994 . 16130) (\INCCODE 16132 . 17318) (\BACKCCODE 17320 .
|
||||
18214) (\BACKCCODE.EOLC 18216 . 21093) (\PEEKCCODE 21095 . 21411) (\PEEKCCODE.NOEOLC 21413 . 21675) (
|
||||
\INCCODE.EOLC 21677 . 23536) (\FORMATBYTESTREAM 23538 . 25171) (\FORMATBYTESTRING 25173 . 26675) (
|
||||
\CHECKEOLC.CRLF 26677 . 29241)) (30803 32646 (\CREATE.THROUGH.EXTERNALFORMAT 30813 . 31615) (
|
||||
\THROUGHIN 31617 . 32037) (\THROUGHBACKCCODE 32039 . 32306) (\THROUGHOUTCHARFN 32308 . 32644)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@ -1,11 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "15-Mar-2022 00:20:04" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;33 13501
|
||||
(FILECREATED "19-Jun-2022 00:02:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>PRINTFN.;34 13484
|
||||
|
||||
:CHANGES-TO (FNS FINDFNDEF)
|
||||
:CHANGES-TO (FNS PFCOPYBYTES)
|
||||
|
||||
:PREVIOUS-DATE "12-Mar-2022 12:52:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;32)
|
||||
:PREVIOUS-DATE "15-Mar-2022 00:20:04"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>PRINTFN.;33)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -153,12 +154,19 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(T FULL])
|
||||
|
||||
(PFCOPYBYTES
|
||||
[LAMBDA (SRCFIL DSTFIL START END NOTERPRI) (* ; "Edited 2-Dec-2021 13:27 by rmk:")
|
||||
(* ; "Edited 8-Oct-2021 00:17 by rmk:")
|
||||
(* ; "Edited 24-Mar-93 14:16 by rmk:")
|
||||
[LAMBDA (SRCFIL DSTFIL START END NOTERPRI)
|
||||
|
||||
(* ;;
|
||||
"Edited 19-Jun-2022 00:01 by rmk: Changed #CHARS to NBYTES, to be clear about what we are counting")
|
||||
|
||||
(* ;; "Edited 2-Dec-2021 13:27 by rmk:")
|
||||
|
||||
(* ;; "Edited 8-Oct-2021 00:17 by rmk:")
|
||||
|
||||
(* ;; "Edited 24-Mar-93 14:16 by rmk:")
|
||||
|
||||
(* ;; "RMK: Added NOTERPRI to at least give caller control over whether a TERPRI is done just in the case of copying the whole file. ")
|
||||
(* lmm "28-Sep-86 14:38")
|
||||
(* lmm "28-Sep-86 14:38")
|
||||
|
||||
(* ;; "RMK: What does FLG do? It isn't referenced. It seems to be passed as the value of PFDEFAULT from PRINTFNDEF, and that variable is initialized to NIL. I'm removing it.")
|
||||
|
||||
@ -170,9 +178,9 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(RESETLST
|
||||
(PROG ((SSTRM (\INSTREAMARG SRCFIL))
|
||||
(DSTRM (\OUTSTREAMARG DSTFIL))
|
||||
FONTARRAY CHARCODE %#CHARS MAXFONT)
|
||||
FONTARRAY CHARCODE NBYTES MAXFONT)
|
||||
(DECLARE (SPECVARS . T)) (* ;
|
||||
"In particular, #CHARS must be a specvar for \INCCODE")
|
||||
"In particular, NBYTES must be a specvar for \INCCODE")
|
||||
(COND
|
||||
((IMAGESTREAMP DSTRM)
|
||||
(SETQ FONTARRAY (FONTMAPARRAY))
|
||||
@ -182,39 +190,39 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
DSTRM))
|
||||
(DSPFONT (ELT FONTARRAY 1)
|
||||
DSTRM)))
|
||||
[SETQ %#CHARS (COND
|
||||
(END (SETFILEPTR SSTRM START)
|
||||
[SETQ NBYTES (COND
|
||||
(END (SETFILEPTR SSTRM START)
|
||||
|
||||
(* ;; "Doesn't call \SETFILEPTR cause START has to be checked")
|
||||
(* ;; "Doesn't call \SETFILEPTR cause START has to be checked")
|
||||
|
||||
(IDIFFERENCE (COND
|
||||
((EQ END -1)
|
||||
(GETEOFPTR SSTRM))
|
||||
(T END))
|
||||
START))
|
||||
(START)
|
||||
(T (* ;
|
||||
(IDIFFERENCE (COND
|
||||
((EQ END -1)
|
||||
(GETEOFPTR SSTRM))
|
||||
(T END))
|
||||
START))
|
||||
(START)
|
||||
(T (* ;
|
||||
"Copy everything from here to the end-of-file")
|
||||
(SETQ START (GETFILEPTR SSTRM))
|
||||
(IDIFFERENCE (GETEOFPTR SSTRM)
|
||||
(GETFILEPTR SSTRM]
|
||||
(SETQ START (GETFILEPTR SSTRM))
|
||||
(IDIFFERENCE (GETEOFPTR SSTRM)
|
||||
(GETFILEPTR SSTRM]
|
||||
(COND
|
||||
((ILEQ %#CHARS 0)
|
||||
((ILEQ NBYTES 0)
|
||||
(RETURN T))) (* ; "Nothing to do")
|
||||
LP (COND
|
||||
((ILEQ %#CHARS 0)
|
||||
((ILEQ NBYTES 0)
|
||||
(CL:WHEN (AND (EQ START 0)
|
||||
(EOFP SSTRM)) (* ;
|
||||
"RMK: We copied the whole file, why should we do a TERPRI")
|
||||
(OR NOTERPRI (TERPRI DSTRM)))
|
||||
(RETURN T)))
|
||||
(SETQ CHARCODE (\INCCODE.EOLC SSTRM ANY.EOLC '%#CHARS %#CHARS))
|
||||
(SETQ CHARCODE (\INCCODE.EOLC SSTRM ANY.EOLC 'NBYTES NBYTES))
|
||||
(IF (EQ CHARCODE (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
|
||||
THEN
|
||||
(* ;;
|
||||
"No EOL check on font character, otherwise we would be limited to 9 fonts")
|
||||
|
||||
(SETQ CHARCODE (\INCCODE SSTRM '%#CHARS %#CHARS))
|
||||
(SETQ CHARCODE (\INCCODE SSTRM 'NBYTES NBYTES))
|
||||
(CL:WHEN (AND (IGEQ MAXFONT CHARCODE)
|
||||
(NEQ CHARCODE 0))
|
||||
(DSPFONT (ELT FONTARRAY CHARCODE)
|
||||
@ -280,6 +288,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1102 11635 (PF 1112 . 3807) (PF* 3809 . 4103) (PRINTFN 4105 . 4675) (PRINTFNDEF 4677 .
|
||||
5860) (FINDFNDEF 5862 . 7234) (PFCOPYBYTES 7236 . 11385) (DISPLAYP 11387 . 11633)))))
|
||||
(FILEMAP (NIL (1115 11618 (PF 1125 . 3820) (PF* 3822 . 4116) (PRINTFN 4118 . 4688) (PRINTFNDEF 4690 .
|
||||
5873) (FINDFNDEF 5875 . 7247) (PFCOPYBYTES 7249 . 11368) (DISPLAYP 11370 . 11616)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user