From 5b690d39d1c3ed2af37967fbac5bab03b292cacd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 16 Dec 2021 16:16:30 -0800 Subject: [PATCH 1/4] Delete STREAMDECLS Old bogus file --- lispusers/STREAMDECLS | 220 ------------------------------------------ 1 file changed, 220 deletions(-) delete mode 100644 lispusers/STREAMDECLS diff --git a/lispusers/STREAMDECLS b/lispusers/STREAMDECLS deleted file mode 100644 index fdef7272..00000000 --- a/lispusers/STREAMDECLS +++ /dev/null @@ -1,220 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") -(FILECREATED "10-Sep-87 12:12:37" {DSK}STREAMDECLS.\;1 10202 - - |changes| |to:| (VARS STREAMDECLSCOMS) - (RECORDS STREAM)) - - -(PRETTYCOMPRINT STREAMDECLSCOMS) - -(RPAQQ STREAMDECLSCOMS ((RECORDS STREAM))) -(DECLARE\: EVAL@COMPILE - -(DATATYPE STREAM - ( - - (* |;;| "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now.") - - (COFFSET WORD) (* \; - "Offset in CPPTR of next bin or bout") - - (CBUFSIZE WORD) (* \; - "Offset past last byte in that buffer") - - (BINABLE FLAG) (* \; "BIN punts unless this bit on") - - (BOUTABLE FLAG) (* \; "BOUT punts unless this bit on") - - (EXTENDABLE FLAG) (* \; - "BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512") - - (CBUFDIRTY FLAG) (* \; - "true if BOUT has sullied the current buffer") - - (PEEKEDCHARP FLAG) (* \; - "if true, PEEKEDCHAR contains value of recent call to unread-char") - - (ACCESSBITS BITS 3) (* \; - "What kind of access file is open for (read, write, append)") - - (CBUFPTR POINTER) (* \; "Pointer to current buffer") - - (BYTESIZE BYTE) (* \; - "Byte size of stream, always 8 for now") - - (CHARSET BYTE) (* \; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time") - - (PEEKEDCHAR WORD) (* \; "value of unread-char call") - - (CHARPOSITION WORD) (* \; "Used by POSITION etc.") - - (CBUFMAXSIZE WORD) (* \; - "on output, the size of the physical buffer--can't extend beyond this") - - (* |;;| "-------- Above fields (8 words) potentially known to microcode. --------") - - (NONDEFAULTDATEFLG FLAG) - (REVALIDATEFLG FLAG) - (MULTIBUFFERHINT FLAG) (* \; - "True if stream likes to read and write more than one buffer at a time") - - (USERCLOSEABLE FLAG) (* \; - "Can be closed by CLOSEF; NIL for terminal, dribble...") - - (USERVISIBLE FLAG) (* \; - "Listed by OPENP; NIL for terminal, dribble ...") - - (EOLCONVENTION BITS 2) (* \; "End-of-line convention") - - (NIL FLAG) - (FULLFILENAME POINTER) (* \; - "Name by which file is known to user") - - (DEVICE POINTER) (* \; "FDEV of this guy") - - (VALIDATION POINTER) (* \; - "A number somehow identifying file, used to determine if file has changed in our absence") - - (CPAGE POINTER) (* \; - "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") - - (EPAGE POINTER) - (EOFFSET WORD) (* \; "Page, byte offset of eof") - - (LINELENGTH WORD) (* \; - "LINELENGTH of stream, or -1 for no line length") - - (* |;;| "----Following are device-specific fields----") - - (F1 POINTER) - (F2 POINTER) - (F3 POINTER) - (F4 POINTER) - (F5 POINTER) - (FW6 WORD) - (FW7 WORD) - (FW8 WORD) - (FW9 WORD) - (F10 POINTER) - - (* |;;| "----Following only filled in for open streams----") - - (STRMBINFN POINTER) (* \; - "Either the BIN fn from the FDEV, or a trap") - - (STRMBOUTFN POINTER) (* \; - "Either the BIN fn from the FDEV, or a trap") - - (OUTCHARFN POINTER) - (ENDOFSTREAMOP POINTER) - (OTHERPROPS POINTER) - (IMAGEOPS POINTER) (* \; "Image operations vector") - - (IMAGEDATA POINTER) (* \; - "Image instance variables--format depends on IMAGEOPS value") - - (BUFFS POINTER) (* \; "Buffer chain for pmapped streams") - - (MAXBUFFERS WORD) - (NIL WORD) - (EXTRASTREAMOP POINTER) (* \; - "For use of applications programs, not devices") - - ) - (BLOCKRECORD STREAM ((NIL 2 WORD) - (UCODEFLAGS BITS 5) - - (* |;;| "respecification of access bits:") - - (RANDOMWRITEABLE FLAG) (* \; - "File open for output (access = OUTPUT or BOTH)") - - (APPENDABLE FLAG) (* \; - "File open for append (OUTPUT or APPEND or BOTH)") - - (READABLE FLAG) (* \; - "File open for read (READ or BOTH)") - - (NIL POINTER))) - (ACCESSFNS STREAM ((ACCESS \\GETACCESS \\SETACCESS) - (FULLNAME (OR (|fetch| (STREAM FULLFILENAME) |of| DATUM) - DATUM)) - (NAMEDP (AND (|fetch| (STREAM FULLFILENAME) |of| DATUM) - T)))) - (SYNONYM CBUFPTR (CPPTR)) - USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ |NoBits| CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL - BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE (GLOBALVARS - \\STREAM.DEFAULT.MAXBUFFERS - )) - \\STREAM.DEFAULT.MAXBUFFERS) - CHARPOSITION _ 0 LINELENGTH _ (LET NIL (DECLARE (GLOBALVARS FILELINELENGTH)) - FILELINELENGTH) - OUTCHARFN _ (FUNCTION \\FILEOUTCHARFN) - ENDOFSTREAMOP _ (FUNCTION \\EOSERROR) - IMAGEOPS _ \\NOIMAGEOPS EOLCONVENTION _ (SELECTQ (SYSTEMTYPE) - (D CR.EOLC) - (VAX LF.EOLC) - (JERICHO CRLF.EOLC) - CR.EOLC) - STRMBINFN _ (FUNCTION \\STREAM.NOT.OPEN) - STRMBOUTFN _ (FUNCTION \\STREAM.NOT.OPEN)) -) -(/DECLAREDATATYPE 'STREAM - '(WORD WORD FLAG FLAG FLAG FLAG FLAG (BITS 3) - POINTER BYTE BYTE WORD WORD WORD FLAG FLAG FLAG FLAG FLAG (BITS 2) - FLAG POINTER POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER - POINTER WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER WORD WORD POINTER) - '((STREAM 0 (BITS . 15)) - (STREAM 1 (BITS . 15)) - (STREAM 2 (FLAGBITS . 0)) - (STREAM 2 (FLAGBITS . 16)) - (STREAM 2 (FLAGBITS . 32)) - (STREAM 2 (FLAGBITS . 48)) - (STREAM 2 (FLAGBITS . 64)) - (STREAM 2 (BITS . 82)) - (STREAM 2 POINTER) - (STREAM 4 (BITS . 7)) - (STREAM 4 (BITS . 135)) - (STREAM 5 (BITS . 15)) - (STREAM 6 (BITS . 15)) - (STREAM 7 (BITS . 15)) - (STREAM 8 (FLAGBITS . 0)) - (STREAM 8 (FLAGBITS . 16)) - (STREAM 8 (FLAGBITS . 32)) - (STREAM 8 (FLAGBITS . 48)) - (STREAM 8 (FLAGBITS . 64)) - (STREAM 8 (BITS . 81)) - (STREAM 8 (FLAGBITS . 112)) - (STREAM 8 POINTER) - (STREAM 10 POINTER) - (STREAM 12 POINTER) - (STREAM 14 POINTER) - (STREAM 16 POINTER) - (STREAM 18 (BITS . 15)) - (STREAM 19 (BITS . 15)) - (STREAM 20 POINTER) - (STREAM 22 POINTER) - (STREAM 24 POINTER) - (STREAM 26 POINTER) - (STREAM 28 POINTER) - (STREAM 30 (BITS . 15)) - (STREAM 31 (BITS . 15)) - (STREAM 32 (BITS . 15)) - (STREAM 33 (BITS . 15)) - (STREAM 34 POINTER) - (STREAM 36 POINTER) - (STREAM 38 POINTER) - (STREAM 40 POINTER) - (STREAM 42 POINTER) - (STREAM 44 POINTER) - (STREAM 46 POINTER) - (STREAM 48 POINTER) - (STREAM 50 POINTER) - (STREAM 52 (BITS . 15)) - (STREAM 53 (BITS . 15)) - (STREAM 54 POINTER)) - '56) -(DECLARE\: DONTCOPY - (FILEMAP (NIL))) -STOP From d9e445ad8c17f8a6611c02a7728fe999f4c4bfdd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 16 Dec 2021 20:06:41 -0800 Subject: [PATCH 2/4] TEDIT: added TITLE argument to TEDIT-SEE So caller can provide more informative information (useful in COMPAREDIRECTORIES) --- library/TEDIT | 91 ++++++++++++++++++++++----------------------- library/TEDIT.LCOM | Bin 38905 -> 38924 bytes 2 files changed, 44 insertions(+), 47 deletions(-) diff --git a/library/TEDIT b/library/TEDIT index e4939206..3d3ffcc9 100644 --- a/library/TEDIT +++ b/library/TEDIT @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Oct-2021 10:00:40"  -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDIT.;19 142287 +(FILECREATED "16-Dec-2021 12:34:26" {DSK}kaplan>Local>medley3.5>my-medley>library>TEDIT.;21 142324 - changes to%: (FNS TEDIT-SEE) + :CHANGES-TO (FNS TEDIT-SEE) - previous date%: "11-Oct-2021 14:03:12" -{DSK}kaplan>Local>medley3.5>git-medley>library>TEDIT.;18) + :PREVIOUS-DATE "13-Oct-2021 10:00:40" +{DSK}kaplan>Local>medley3.5>my-medley>library>TEDIT.;20) (* ; " @@ -27,9 +26,9 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP)) (TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU)) (* ; - "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).") + "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).") (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") + "Changed by yabu.fx, for SUNLOADUP without DWIM.") ) (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY TEDIT.DELETE @@ -40,10 +39,10 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. \TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1) (P (MOVD? 'NILL 'OBJECTOUTOFTEDIT)) (* ; - "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.") + "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.") (COMS (FNS \CREATE.TEDIT.RESTART.MENU)) (* ; - "Added by yabu.fx, for SUNLOADUP without DWIM.") + "Added by yabu.fx, for SUNLOADUP without DWIM.") (COMS (* ; "Debugging functions") (FNS PLCHAIN PRINTLINE SEEFILE)) (COMS (* ; "Object-oriented editing") @@ -56,10 +55,10 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA")) (FNS MAKETEDITFORM) (P (ADDTOVAR LAFITESPECIALFORMS ("TEdit Report" 'MAKETEDITFORM - "Report a problem with TEdit")) + "Report a problem with TEdit")) (SETQ LAFITEFORMSMENU NIL))) (COMS (* ; - "LISTFILES Interface, so the system can decide if a file is a TEdit file.") + "LISTFILES Interface, so the system can decide if a file is a TEdit file.") (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1) (EXTENSION (TEDIT]) @@ -330,8 +329,9 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (RETURN PROC]) (TEDIT-SEE - [LAMBDA (FILE WINDOW FORMAT) (* ; "Edited 13-Oct-2021 10:00 by rmk:") - (* ; "Edited 27-Feb-2021 20:07 by rmk:") + [LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 16-Dec-2021 12:33 by rmk") + (* ; "Edited 13-Oct-2021 10:00 by rmk:") + (* ; "Edited 27-Feb-2021 20:07 by rmk:") (* ; "Edited 1-Feb-88 19:00 by bvm:") (* ;; "See FILE in a scrollable READONLY TEDIT window. If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.") @@ -347,28 +347,25 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (IF (\TEDIT.FORMATTEDP1 STREAM) ELSEIF (LISPSOURCEFILEP STREAM) THEN + (* ;; "Lisp source file") - (* ;; "Lisp source file") - - (SETQ SEESTREAM (OPENTEXTSTREAM)) - (DSPFONT DEFAULTFONT SEESTREAM) - (COPY.TEXT.TO.IMAGE STREAM SEESTREAM) + (SETQ SEESTREAM (OPENTEXTSTREAM)) + (DSPFONT DEFAULTFONT SEESTREAM) + (COPY.TEXT.TO.IMAGE STREAM SEESTREAM) ELSE + (* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.") - (* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.") + (* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).") - (* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).") - - (SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8) - :DEFAULT)) - (CL:UNLESS (RANDACCESSP STREAM) - (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) - (COPYCHARS STREAM SEESTREAM))) - [SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL - `(READONLY T FONT ,DEFAULTFONT] - (WINDOWPROP (WFROMDS TSTREAM) + (SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8) + :DEFAULT)) + (CL:UNLESS (RANDACCESSP STREAM) + (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) + (COPYCHARS STREAM SEESTREAM))) + [SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL `(READONLY T FONT ,DEFAULTFONT] + [WINDOWPROP (WFROMDS TSTREAM) 'TITLE - (CONCAT "SEE window for " (FULLNAME STREAM))) + (OR TITLE (CONCAT "SEE window for " (FULLNAME STREAM] (FULLNAME STREAM]) (TEDIT.CHARWIDTH @@ -2236,7 +2233,7 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ; "TEDIT Support information") -(RPAQQ TEDITSYSTEMDATE "13-Oct-2021 10:00:40") +(RPAQQ TEDITSYSTEMDATE "16-Dec-2021 12:34:26") (RPAQ TEDITSUPPORT "TEditSupport.PA") (DEFINEQ @@ -2258,23 +2255,23 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1) - (EXTENSION (TEDIT)))) + (EXTENSION (TEDIT)))) (PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4330 117453 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) ( -TEDIT-SEE 20842 . 23129) (TEDIT.CHARWIDTH 23131 . 25155) (TEDIT.COPY 25157 . 33593) (TEDIT.DELETE -33595 . 34285) (TEDIT.DO.BLUEPENDINGDELETE 34287 . 37354) (TEDIT.INSERT 37356 . 42886) (TEDIT.KILL -42888 . 44445) (TEDIT.MAPLINES 44447 . 45846) (TEDIT.MAPPIECES 45848 . 46804) (TEDIT.MOVE 46806 . -56590) (TEDIT.QUIT 56592 . 58592) (TEDIT.STRINGWIDTH 58594 . 59265) (TEDIT.\INSERT 59267 . 61292) ( -TEXTOBJ 61294 . 62419) (TEXTSTREAM 62421 . 64036) (\TEDIT.INCLUDE 64038 . 67938) (\TEDIT.INSERT.PIECES - 67940 . 77855) (\TEDIT.MOVE.PIECEMAPFN 77857 . 79936) (\TEDIT.OBJECT.SHOWSEL 79938 . 83567) ( -\TEDIT.RESTARTFN 83569 . 85564) (\TEDIT.CHARDELETE 85566 . 89528) (\TEDIT.COPY.PIECEMAPFN 89530 . -92755) (\TEDIT.DELETE 92757 . 100275) (\TEDIT.DIFFUSE.PARALOOKS 100277 . 103041) (\TEDIT.FOREIGN.COPY? - 103043 . 106770) (\TEDIT.QUIT 106772 . 109918) (\TEDIT.WORDDELETE 109920 . 114753) (\TEDIT1 114755 . -117451)) (117567 117683 (\CREATE.TEDIT.RESTART.MENU 117577 . 117681)) (117782 121471 (PLCHAIN 117792 - . 118066) (PRINTLINE 118068 . 120832) (SEEFILE 120834 . 121469)) (121512 141155 (TEDIT.INSERT.OBJECT -121522 . 130599) (TEDIT.EDIT.OBJECT 130601 . 132857) (TEDIT.FIND.OBJECT 132859 . 133752) ( -TEDIT.FIND.OBJECT.SUBTREE 133754 . 134560) (TEDIT.PUT.OBJECT 134562 . 136221) (TEDIT.GET.OBJECT 136223 - . 139422) (TEDIT.OBJECT.CHANGED 139424 . 141153)) (141433 141796 (MAKETEDITFORM 141443 . 141794))))) + (FILEMAP (NIL (4330 117494 (\TEDIT2 4340 . 7091) (COERCETEXTOBJ 7093 . 15869) (TEDIT 15871 . 20840) ( +TEDIT-SEE 20842 . 23170) (TEDIT.CHARWIDTH 23172 . 25196) (TEDIT.COPY 25198 . 33634) (TEDIT.DELETE +33636 . 34326) (TEDIT.DO.BLUEPENDINGDELETE 34328 . 37395) (TEDIT.INSERT 37397 . 42927) (TEDIT.KILL +42929 . 44486) (TEDIT.MAPLINES 44488 . 45887) (TEDIT.MAPPIECES 45889 . 46845) (TEDIT.MOVE 46847 . +56631) (TEDIT.QUIT 56633 . 58633) (TEDIT.STRINGWIDTH 58635 . 59306) (TEDIT.\INSERT 59308 . 61333) ( +TEXTOBJ 61335 . 62460) (TEXTSTREAM 62462 . 64077) (\TEDIT.INCLUDE 64079 . 67979) (\TEDIT.INSERT.PIECES + 67981 . 77896) (\TEDIT.MOVE.PIECEMAPFN 77898 . 79977) (\TEDIT.OBJECT.SHOWSEL 79979 . 83608) ( +\TEDIT.RESTARTFN 83610 . 85605) (\TEDIT.CHARDELETE 85607 . 89569) (\TEDIT.COPY.PIECEMAPFN 89571 . +92796) (\TEDIT.DELETE 92798 . 100316) (\TEDIT.DIFFUSE.PARALOOKS 100318 . 103082) (\TEDIT.FOREIGN.COPY? + 103084 . 106811) (\TEDIT.QUIT 106813 . 109959) (\TEDIT.WORDDELETE 109961 . 114794) (\TEDIT1 114796 . +117492)) (117608 117724 (\CREATE.TEDIT.RESTART.MENU 117618 . 117722)) (117823 121512 (PLCHAIN 117833 + . 118107) (PRINTLINE 118109 . 120873) (SEEFILE 120875 . 121510)) (121553 141196 (TEDIT.INSERT.OBJECT +121563 . 130640) (TEDIT.EDIT.OBJECT 130642 . 132898) (TEDIT.FIND.OBJECT 132900 . 133793) ( +TEDIT.FIND.OBJECT.SUBTREE 133795 . 134601) (TEDIT.PUT.OBJECT 134603 . 136262) (TEDIT.GET.OBJECT 136264 + . 139463) (TEDIT.OBJECT.CHANGED 139465 . 141194)) (141474 141837 (MAKETEDITFORM 141484 . 141835))))) STOP diff --git a/library/TEDIT.LCOM b/library/TEDIT.LCOM index 630abb322521625e2e0bfe0c56dac514fb3cb8b4..dde38748a4b0898768d0540b9c3bc5b7d627c795 100644 GIT binary patch delta 499 zcmaKp!Artm7{=WagB_w$B#_|6EEJjS`?fY+AdI=$Vs6WQYKI^!r6RpZ7fFl+OxBi)KedVDJ*6rcpeV^yY`+hw0cQ5?IQCt-(-7^tO7y-h%tms%BU8%S~ z6#LyyuRARFE>8#T!LUrMibD!}808?1l%Fk(bVbu;GAye`2Nwba85EW3$_r?ee2K5% z;Gjt#z?kp^nD{PES~W%nx0`#<{hgC@^~AhCGPehGO4cUFa-u&7=?7WgKs66MiUqF| z7DPcr5JgQ=HCdg!?rL-EVzJ0Ww;lGn|H(@-pHJmX%QmWYLl2A^eIXg@ldWGLA5}=9 zEQ(46I!Eo3es2Wfa9e|%={6vKu!2IvF!FGE-n$$OFGk;9@tsHf%Z9QhNE(Vfq~_ra zDp7{HS=rPD#0r>D0@JHIdJvCgXjyK}Yvo~K$}G~^szjPJ$@b|Po7I<|vq_R($e~h( zLucQ%8UdgpfZ4QdS9c7+iUfW$_(Aw}&j&0kQ1#qu49Bt*y|D^mN)?*s)I{t}ZEkP* dD}xULG=jJbhdyvSBoWQH`*GYo8(rUx$tT)9YO(+T From 1108a00b90389c062a787efbd2f69caf93ef4451 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 16 Dec 2021 20:09:38 -0800 Subject: [PATCH 3/4] COMPARETEXT: upgraded to externalformat character interface Also cleaned up some crufty code, added FILELABELS argument to give caller more precise control over the column labels. --- lispusers/COMPARETEXT.LCOM | Bin 8347 -> 9013 bytes lispusers/COMPARETEXT.TEDIT | Bin 6144 -> 6425 bytes lispusers/comparetext | 739 ++++++++++++++++-------------------- 3 files changed, 329 insertions(+), 410 deletions(-) diff --git a/lispusers/COMPARETEXT.LCOM b/lispusers/COMPARETEXT.LCOM index b04cd113ee82a1a437454bdaa25809161eff5420..d2088fb8aab3f281d52ecca0e3ecf193bbe29732 100644 GIT binary patch literal 9013 zcmb_iTWlNYb>@uZWLJ$-$(FZkt>OG(whpzhW;w%~s4iR%$)PynaE2y_mSj6+WevTQ zL`#OG?XKGty`VuKTA)dRTwc=cZW5$#mE{%CO|l@6r>0MRC{VliHb9EBMIi(2OMxc+ z{__txLtWf$5n;`lIdkT}p7WjWoPT3Qqh#8~Ov$v28PhH~>~c*nRP=d+MNQi^>XzB4 zMcL)Lp%+~}Zygcm^@hRJ`1IIVjJHsLnrjqUR87wm+p9BLTvPFSE|r-}q@pYqUER8O zf34g0*w!YCvaw$&HY&gRT63qpy>o42<$iZ%^P07_y3)ONukCf)4-!i1+Pw!e;^A6% zZRh?Qq{>@a*>3N)-`Z7vPEAaszhuy#rp_hNpNjVHY_|tJw%@wHz4Nnk%&ZoiYE7>j zO4TeDEhFD_UB@ojYz;#yH7$#U8&eb|%Dk0b4Edx^GSTS|HS?d)Oj#n6)Y5FOP}c2v zqcP(;EOtY$H`tgzC)ZeVaod#r5thmcH15bli zY`w~#2QATa39Z%Yup4&~%it_dv&eTxrO285>k<4NK6&qX%7FCZZ$e7s`K3S~)D^YriWXhbJH05LJ;UFRM`CJL4cSSd+_WnVrp_kWyy5z5 zrDkRsprBUAGG$aOglWUAQ(0E9AmppURE<91D^4h)#)qG0v&^X1ojOZrur0ROuXH@P zPiekFGQ$dvUC>>4ma1l%W!Up>nPmrei3EfD>I^+DI`tylm05r=mLf5}Vrn|YqP1>& zWv9({?zdOh?ml2E?9H`JZ|hBVcWayNcG~PNaEN(pcki~h+ncLx_WJh9{Z5o+vMgFy z+5Ge_6gE9}XKS}Zsyk7ZR9UpS$sy(S&9z@{llhSK00aU*$vaE7Q#6Eia=Q{1BTS0F zD8aS@bxUu!3Vl$5?h(1L*n!E-MC6EE+rLmF8@T>cw8Nd%$g14SdHd%{s*^Og8qrr} z>~12>>PEwGU*%oAn#Xz>b-rT9gjlx(#%13y>Moo0Zy*d$%{LC;@3g+(DI`}ADO|Xq z+IPWWahwUQ#&R|9Sc-@x|8FN%8a1OJItcq}NDL4C#z!KNGjIwr`J34!YHHx5WlRns9mcs4$(@kB_sYSiZq zrD?-|Y+$od6f4wV+02L1inAiH+^8d_&nANV%<->}^^nd6`e`k=Ple|q#&_)7WY`~? zH6BKkAu~y6q2ZsT0G1JWPQkIjL|lc?y^m+f|3x7~-mKT_`ttOcZCXbR|AZz7UcfPr zf&{mH!!FjG21TL<;8U+sXbA@z-w|M+%dk&52Ro3+bLofh`eWRNa<7Cr91Ht+!?0Z*Om%yCdOD00 z&$L=S9*?U6A1xM(`v5t85-^4V5bwj=JOECtiat@{BOqHo&4T5q zY`Ne7o)yyui>_i}IhGO&5#1?E^d8b|For-l8xnG?=QfxLdZrM=WxyHE>=ZvL)etrZ zqa`J!gor*+CrcRcD14vj!#fcx2s9?5O2fR#8Q3t73NbRDSEYwp8THQF_a{j~gog#6 z#|?`=EQbrlfm6Z*j7ghiNPhID<(3>9HZ7MgNs*6|yXo91HzppPEsaPABjsDA5gAwW zc0o`%^3=n3^9Rq<^WLX~;7j7^g3krNNRPiobc-C9ettpl!#u?tJ8*n@uGpm0mH)am z>3P=R>2Y`RacipA^_;1v?>bYz(e)m;&aHQ4Z{e>V``_>pKYr4Bq3FCYQJ-`!jU0^p z=EKO>9d@quaf8cVa$XU#A3Msq)_A$%Os-FLyv5mjKN3N!Gv$2Tw48Itq~pQp>2A&I zc>O=lO8bAU7scEv7Dy<~$9a(^C?@N?7@F={=Pb|<1XOBW!O&%?6+8HhbH$S-S~Ukk ziJItsjQVsYoy${B%zN)lXQ~s7x%G0-i5^^XUhYh_qAk{QF3GJ+J?FCX!e6v5_a6S} zznqt^w4%MeA39g2s#72Ay)Ctp)fePey5}SZeI=X6S9nwJ4oykiEJpx*b=qTc<4SeRzgo+74h|g#uFG*!YUIKc<^A#ROQ}{MIgG>U1EIJou z38Y2*%9D=8t!*#L(onG0Hrr7c1#*~`?G-;SN#KQxf(I+{yrnqETXwFp&dN>)^@%$V z*ia&Ja>70ca|}GCp}0un3AGmqC^-@%p1w8`iAV%o6Q7jJBL}0MacP-cnVj+F{!6(9 za^LS=CHisr6+wdESr{+NOM8C~>yIO2wt#tJ=*f?&B~~z3y_h z#)|`kQSrin&*FIY7VImp3HTI=NjH!_kLGCd>qy}9b&OeO&XRbpFSRv+i)9ao+{BqBF^v`SG+57u0JACx=LihQ@N0-foA8d5T34xAY z-|u{9?>%bcaDSnK-rju}`NQ7vW`F--H&6Q`idO)Vr!_4=iL*wJKe)L0+kM8>(pYPxH%(7U;@{mB>c_+bE9~YR0^rY^%pk`VBs*0$Ovj~*Tf8L&T2*rb-7Wwx+54P^}ExJ*mTa)V?VfV}~@HkhV@mibC?kY6fcK+Bg= z$%D!nfM8#Z13dvq*yx8KZeaX;Fl711Ds_;;33z$Ouc&aY)?Z`dX;@#gNcoCS4!On8 zbKnOge4dgO4>tEZI)Ok=+F0jl2@l@4%d)hLJL#rHE^*7-w>`6a@yQ1p)u-=Ne|=+} z42Vp>S0R;N#T3RgEEK46P9mM}DRkNU8LJ~)%H(A*{72t(c<~D0N;3t4#)7-c3W7<& zXrO`x?u^Z9H0y>x8$=kfD7I6t>K5o~0aaiG8D88Xs50D!VX;i|WIa@_hV&3sg1~VK z*n-vvI(}schN2?L;9c?f(MLBJCErqp?3rJWK-_Tbr|l-7T5^F^DCuyhs+zXq?=9cC zCG468iZvn}O#knv`&V>v|0I8Ko~Vx4N%|e%pv&IB=diBu2-__Kwd*K3_i2X8bjxxI zBGRK0$ZW3AKn5Xh{KT0jNzvg@bV}myTP>vwKGEmtsGl?l3C%1Ianf{WDWO{;0xpz9_IcbS=%J*}gy#Hd)+&^#1Uq$vTnfOPO{6KRY@7J#yYL7=wvwQC*Zv z2F38B2!MQPxB?DADrDQ?Z2SkKC{yNmER6iaL~i6c&hyFIhU(D2$i<%!@rO2rAcF1! z(|q4ECr5kT$$S4c^(}8T z=mL$Q7aBxoJoL~j4~?uT<)pGM5a=T(4p0=&IRI%e_Q1paYLf=0GDNw7MaP+r3KBSs zQ0ifAtuJUcWju=?Yp zLbl)!0rafjThJMgawuW&xZ$6yXmLN^0Gg@&jGA{`HgGIsvn-;{;Futl3=t}TjGwY( z*k?ya_&41CKJ{62B5L>rI_O*5e4VX!-q_sOA&!fa2aQFSx87j)-q_h?JMC_Jb(gJd zqEg@97G-?4x#jT+|Mt!qy;}1FZ&hDXmMGZrU!XFcd6B4J=Mqq@FOkz*1;g~YI_jo7>dhWX;6-!Hw0(> z(kj=0O5H$hxQHZkpeh_Ac;+4h#W4=5jle?SbR^-%bCL;-{a+>|O!wzQqZppbDesR> z2zoT1P(xxmF>WZZ{U#1LF%RzS^ui~kTt-R1!W_43)ae~c{=RApKp9paYcc#!CCB?B zaEYNdTyUCjP(X>eL912~ec})zv}k?|h73;60k9F?cih*O>x6T$=u&%o>n&E;+P=TF cy|TNuwHZZ-z#%w(Qusjvh@V+B&kq&;2Q??1xc~qF literal 8347 zcmb7JZERcTbtbRuEcU8QauhGtJokiMGpdLfUVccF76iN`uf!`}^3vp0^kJu}tV^4e zXwjhLq~1ELE!JNfhAdbE3~LcIz>onOFiMVqHEuwx`?KuVFa(&44g0h1quqwd+x`u$ z_q^x5Brhq+YXqD3z2`medB4ti&c_XA^f{xTPtF;pK4}!@EV@$CwT!K$Oq~Ko!PZNr zQ7#7PN>NMawD~^b#BflIOJjtsXDASfPG%|_lQRiYr)R@6v*Boff`N_3?K`!4#i7PF z1?bl@<=n5oa;MqYtZeMQdb{G(EBB(I_^b8W&YinEmFCW?f`7eP*{yteH}osf2^tPW z)yakRZI(MTtA=M|i2yY#UAY_8_3c}gozKsbkxyIsqE^yFY0JdI>`+!KXG7`iVj)-d z^a?7~wjnyt3m~k3FfL7Vck6X3-`i>2-6b_LS!lc=rVWKc0dm%Nv57#Bszzob>TEO` zc=9>KXVu83-#0~P60sP$d!yY3wuj>`9NWed_dG$t*R)cZ++(rzWgE@%1l?&?-l#S1 z?(nXJ=zyA#yN!|>n~gZ62n20f>D|;X~k@)q|X~xfg;40Vy_f+ zQpqwiLWc@kUZ*e>^rg<*#02^N{EW|cCRsc0!=EM}qk$n~znR@{R5!D$w?qf`E>y?y zSKTzO^=LV!rP5CA=-qbxlC$mqpZYsYYklD$__P??ZiwG6i60iz=H@x^-e!i+h-T{* zW|IqOyX%odU7EYNK3a{%R7ZS4H8Ddlq+-b+H4z~^3o1+`+-Xg9Y4I*C)}=*eJeupO zvKooeyl%TEs;Y^u{P46Zbw;JMi8)~qHpQm|yEt05@o4|68YO@L-vdo`o6u?%JyOCF z`mH5W!(v%Nq)Ujagv*<^vlQ*LFbo*!rSWtjetR_G&;=hW81k&r< zzr0H~YugUpXzW(es#kVq(K|CufnvR~zEh!{JC%*v&3m*?Z-TG!Cf#f_X}4NoW^!sb zZ&sR>?TrfEYOdd@!XSHAk+PNxRz~k?qe|}5p>3c~&>Zxx$8Kt6JH!L#pq&GBsmF3W z)N|6O_>|)Qb4AvY;Nda{#m2Sj0O)}S>VU2Ax&g}$bFI{sio4!!Z0TF`KlxS z>;5cDdELKtw0}9Th{toLq9}PqxzxswAMM(uc22q0`fb=&Bq3Cr5nWZMJvWwt-!iq8 zkkI;2#+aMaOL`%#hxihq$#D;FUN6n-p~XVlDiq*0^i0QR%y^CObgl?xN;$T&!^sYOTGanlZkm&I&7Bg_eq4G*TWtk!A!K1PNhauuUg_E3S z-;tigFwJnTl}g&m#Bjkd2UPR~Kitt*)#C`l#L6txZylPTjE0pY?%B^a#6Jwd49Ck( zQt`8n;0Z4O;mT5K-Csad(JA@6Qo=i_4}S;&CrB; zjDG!GniV6(I&$=0>fju|w>~Ec@5s03-2QL!>u<7aXARdxU8H|vVCd3fj!5eqzgxHgipMn+2`*4WU& z(AW2TU$vgUa9!^s{XIypC$rWwo8whyDRBEI!#~4dIBsf2VUU*Zt(#jlr|NY6L=4pV zb37ZVRlD%Ib_L5){A+aZx^=}-{Cpr5h<@H}{WC1odd9jqZjtlB+3I+;x1zPnZEO7C zvURySzBa!0eA^mR*2db_MQh}fwTtb&$5*V&FRqQZTR*g}j4zCT*m~E$c4gtBvPSKb z=i3qRhVw&B#%ta_RHRS<58KLNfkY-zXip67y_0zd8 zz_6#hgQD^1se_`ism>r+dO2$?NjDOiO3-!THqsG_OhtQbz;~C9s7{!pyS51Yy608J zQUNALVZIa1A>fmQB_o5tN>$_i@8N_C3|c0GV5~?p2+9`Sh>QuqHaXc6O~(-Y7t)$d zQxKcA7R?L{Ndy;O*N`_d8BFMYzo*&AZZT4BxSns;m%7`UEir9kGpY?`ocsJ0EgiC4I979cF0OC zAQ0$6Ul?JrsSEe?DsmG4=!lOoWb}n0W9Z;ac0@WVww=|3^V$3VX(%hLf8m(sffj>d~B4f(Mvd9u}qteGnVi{)B zzwhQw_47yje=22lM%EQ~=oj6gzayA_$#4aHZD4|g&Kj=p2;YBrHt~@hz2|$M)uG+` z6Ri3VIs@L_^SvdOcmEx+xchHCd1+18NA2r!o^QA-!&%?YvX~T$dBwyW_otpDtR)js z8Lu6d07{6%1V;q;D4$ZIicHr{ZiSAE)YJQl`Mj?X;(Y~BbSIeMoVpX|0YklvU7?&n z$31<*JdqYNibZ47WX=IU0eU6TK;|zV49LK?DG71{^FdY->@gdhNE&gb%FqYEC*3j` z0TaNn&z~ova_?Z=P4mCBAUxBgom@ed^#<_y;=Vxcs_x2Cg* z6jX|I3ON*)q!ZG*Q}WTyN>xfh=#o~-ltXjoybSL>`GHvO8;VHt$e;X9btLIu7E$SU zla8|geB0Q6)=<8U+|F;{Kdav#CY2k$*55+ugx;YGzlY$&Q~VcffVSX&zG76>gH_n-$lz+SJoVtpY=6?9)mZGu zPjyiuB2w{g<;1O#MNsbP2M85#-!00DGN&xc0)u5sWC^kr6%lNwk}B#=J?Wj|qNu>~ zp)*2pr59ex9ghgSGhCnnTmoRLS3*^%69WWzhklOOzz}#mH!T*E!sTWVw4<`zormIa z`pTIh(JQ>b=e`2}D;F5WhYs)TBHs4A3$LS!xI4{XVQSmA@CoAX_SOyu%&1f%&R%KU zrQ3IRc4?w8@| z!jT9(N+LNKN{*^S*%hQEsHU#^rLi6S+=72on4>I*JxF~!r{qvu1&HPpB4z~@Z z^_PH0=)|I1QspQ}AWIi5gGKmJdqsTdfqmG=zAX(0OGWMK)j>K+Vn~5aIAMHl(qGfe zq>zB5iufa9nS!RJWdvNz(S0`!L@Tb{pN2>?+BLZgL=_&ok_IsS~gk6J)H|^P?+;UJb!*&*Ru1AP` zhdbOzP;8fr3L&!WtX|?il#f9ctZN+*aoLC0D2zioHkUX~3gTOA+FFEx1BYY-Qq2qm zp`h(KS>7UybvOvn5a`(VxfwcCTq!XK1_R5LX5-70ZZz*Sn(Mo@#x_0y;xo7SiQ@<9 MBYqMPFACKE2kZ`W3j+=Q>Cr%+ z>JxiSThm|cJZ+=R*u@MA4E=NZI?wC3&V8P{@cPg($1hVuPOmr>{ll3Zl;9j>n6KF>ijGQz+W&r!00sL+j+|Ghh24HH?|CnT~{hELN3wJAi A3jhEB delta 466 zcmbPf)L<|{RFaq1gqPQlm)F_fH^4E-HN-U{1jIGrov3Ffp`hWLSe%(xl3Jt};OG#M zT9jX*2UMuJvGp?Z=46)dOq+kQ$8a;VGZ;_)Agn%ltuQyE@#NjYMvO*4z9FN|WEBx@ zP926WhAu`62DZsMBFaFq1`%yWkICyqyeIz_IU>W(z`(!)#0<medley3.5>lispusers>comparetext.;3 39844 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS IMCOMPARE.HASH IMCOMPARE.COLLECT.HASH.CHUNKS) - (VARS COMPARETEXTCOMS) +(FILECREATED "16-Dec-2021 10:57:35"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;13 37426 - previous date%: "18-Nov-93 14:43:00" {DSK}medley3.5>lispusers>comparetext.;1) + :CHANGES-TO (VARS COMPARETEXTCOMS) + (FNS IMCOMPARE.MIDDLEBUTTONFN IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH + IMCOMPARE.FIND.TEDIT.TEXT.OBJECT) + + :PREVIOUS-DATE "15-Dec-2021 17:00:06" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>comparetext.;9) (* ; " -Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. +Copyright (c) 1984-1985, 1993, 1998 by Xerox Corporation. ") (PRETTYCOMPRINT COMPARETEXTCOMS) @@ -22,9 +26,8 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. IMCOMPARE.MERGE.UNCONNECTED.CHUNKS IMCOMPARE.MIDDLEBUTTONFN IMCOMPARE.SHOW.DIST IMCOMPARE.UPDATE.SYMBOL.TABLE) (P (MOVD 'COMPARETEXT 'IMCOMPARE)) - (VARS (IMCOMPARE.LAST.NODE NIL) - (IMCOMPARE.LAST.GRAPH.WINDOW NIL) - (IMCOMPARE.HASH.TYPE.MENU NIL)) + (INITVARS (IMCOMPARE.LAST.NODE NIL) + (IMCOMPARE.LAST.GRAPH.WINDOW NIL)) (RECORDS IMCOMPARE.CHUNK IMCOMPARE.SYMB) (FILES GRAPHER))) (DECLARE%: EVAL@COMPILE @@ -35,44 +38,43 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. (DEFINEQ (COMPARETEXT - [LAMBDA (NEWFILENAME OLDFILENAME HASH.TYPE GRAPH.REGION) + [LAMBDA (NEWFILENAME OLDFILENAME HASH.TYPE GRAPH.REGION FILELABELS) + (* ; "Edited 15-Dec-2021 16:23 by rmk") + (* ; "Edited 13-Dec-2021 12:21 by rmk") + (* ; "Edited 8-Nov-2021 08:44 by rmk:") (* mjs " 8-Jan-84 21:06") - (* Compares the two files, and produces a graph showing their corresponding - chunks. The courseness of the "chunking" is determined by HASH.TYPE, which may - be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. - The file difference graph is displayed at GRAPHREGION. - If GRAPH.REGION = NIL, the user is asked to specify a region. - If GRAPH.REGION = T, a standard region is used.) + (* ;; "Compares the two files, and produces a graph showing their corresponding chunks. The courseness of the 'chunking' is determined by HASH.TYPE, which may be PARA, LINE, or WORD. HASH.TYPE = NIL defaults to PARA. The file difference graph is displayed at GRAPHREGION. If GRAPH.REGION = NIL, the user is asked to specify a region. If GRAPH.REGION = T, a standard region is used.") - (PROG ((NEWFILE (FINDFILE NEWFILENAME T)) - (OLDFILE (FINDFILE OLDFILENAME T))) - (if (AND OLDFILE NEWFILE) - then (* compare the two "chunks" - consisting of the entire text of the - two files) - (IMCOMPARE.CHUNKS (create IMCOMPARE.CHUNK - FILENAME _ NEWFILE - FILEPTR _ 0 - CHUNKLENGTH _ (GETFILEINFO NEWFILE 'LENGTH)) - (create IMCOMPARE.CHUNK - FILENAME _ OLDFILE + (SELECTQ HASH.TYPE + ((PARA LINE WORD)) + (NIL (SETQ HASH.TYPE 'PARA)) + (ERROR (CONCAT "Unrecognize HASHTYPE " HASH.TYPE))) + (LET ((NEWFILE (FINDFILE NEWFILENAME T)) + (OLDFILE (FINDFILE OLDFILENAME T))) + (CL:UNLESS (AND OLDFILE NEWFILE) + (ERROR "Can't find both files" (LIST NEWFILENAME OLDFILENAME))) + (IMCOMPARE.CHUNKS (create IMCOMPARE.CHUNK + FILENAME _ NEWFILE FILEPTR _ 0 - CHUNKLENGTH _ (GETFILEINFO OLDFILE 'LENGTH)) - HASH.TYPE - (if (EQ GRAPH.REGION T) - then (create REGION - LEFT _ 25 - BOTTOM _ 25 - WIDTH _ 500 - HEIGHT _ 150) - elseif GRAPH.REGION - else (CLRPROMPT) - (printout PROMPTWINDOW - "Please specify a window for the file difference graph" T) - (GETREGION))) - else (printout T "Can't find both files: " NEWFILENAME " & " OLDFILENAME - " --- IMCOMPARE aborted" T]) + CHUNKLENGTH _ (GETFILEINFO NEWFILE 'LENGTH)) + (create IMCOMPARE.CHUNK + FILENAME _ OLDFILE + FILEPTR _ 0 + CHUNKLENGTH _ (GETFILEINFO OLDFILE 'LENGTH)) + HASH.TYPE + (if (EQ GRAPH.REGION T) + then (create REGION + LEFT _ 25 + BOTTOM _ 25 + WIDTH _ 500 + HEIGHT _ 150) + elseif GRAPH.REGION + else (CLRPROMPT) + (printout PROMPTWINDOW "Please specify a window for the file difference graph" + T) + (GETREGION)) + FILELABELS]) (IMCOMPARE.BOXNODE [LAMBDA (NODE WINDOW) (* rmk%: "14-Dec-84 13:40") @@ -86,359 +88,279 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. (SETQ IMCOMPARE.LAST.GRAPH.WINDOW WINDOW]) (IMCOMPARE.CHUNKS - [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION) + [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION FILELABELS) + (* ; "Edited 15-Dec-2021 16:28 by rmk") + (* ; "Edited 13-Dec-2021 12:32 by rmk") (* rmk%: " 8-Sep-84 00:06") - (* this is the main text-comparison function. - It compares the text in the two chunks and produces a graph showing how the sub-chunks of the two main - chunks are related. The two main chunks may be in the same file, and the file - may actually be an open Tedit textstream. - The main chunks are broken down according to HASH.TYPE, which may be PARA - , LINE, or WORD. HASH.TYPE = NIL defaults to PARA. - The file difference graph is displayed at GRAPH.REGION.) + (* ;; "This is the main text-comparison function. It compares the text in the two chunks and produces a graph showing how the sub-chunks of the two main chunks are related. The two main chunks may be in the same file, and the file may actually be an open Tedit textstream. The main chunks are broken down according to HASH.TYPE, which may be PARA , LINE, WORD, or PARA. The file difference graph is displayed at GRAPH.REGION.") - (* this text comparison algorithm is originally from the article - "A Technique for Isolating Differences Between Files" by Paul Heckel, in CACM, - V21, %#4, April 1978 --- major difference is that I use lists instead of arrays) + (* ;; "This text comparison algorithm is originally from the article 'A Technique for Isolating Differences Between Files' by Paul Heckel, in CACM, V21, #4, April 1978 --- major difference is that I use lists instead of arrays") - (PROG ((CHUNK.SYMBOL.TABLE (HASHARRAY 500)) - NEWFILE.CHUNK.LIST OLDFILE.CHUNK.LIST) + (* ;; "") - (* * collect lists of chunks from each of the main chunks, dividing them - according to HASH.TYPE) + (* ;; "Collect lists of chunks from each of the main chunks, dividing them according to HASH.TYPE. We start with whole-file chunks to provide the interface that the") - (SETQ NEWFILE.CHUNK.LIST (IMCOMPARE.COLLECT.HASH.CHUNKS NEWFILE.SPEC.CHUNK HASH.TYPE)) - (SETQ OLDFILE.CHUNK.LIST (IMCOMPARE.COLLECT.HASH.CHUNKS OLDFILE.SPEC.CHUNK HASH.TYPE)) + (LET ((CHUNK.SYMBOL.TABLE (HASHARRAY 500)) + (NEWFILE.CHUNK.LIST (IMCOMPARE.COLLECT.HASH.CHUNKS NEWFILE.SPEC.CHUNK HASH.TYPE)) + (OLDFILE.CHUNK.LIST (IMCOMPARE.COLLECT.HASH.CHUNKS OLDFILE.SPEC.CHUNK HASH.TYPE))) - (* * update the chunk symbol table. For each hash value, this table records the - number of "new" chunks with that hash value, the number of "old" chunks with - that value, and a pointer to the place in OLD.CHUNK.LIST .) + (* ;; "Update the chunk symbol table. For each hash value, this table records the number of 'new' chunks with that hash value, the number of 'old' chunks with that value, and a pointer to the place in OLD.CHUNK.LIST .") - (IMCOMPARE.UPDATE.SYMBOL.TABLE NEWFILE.CHUNK.LIST CHUNK.SYMBOL.TABLE NIL) - (IMCOMPARE.UPDATE.SYMBOL.TABLE OLDFILE.CHUNK.LIST CHUNK.SYMBOL.TABLE T) + (IMCOMPARE.UPDATE.SYMBOL.TABLE NEWFILE.CHUNK.LIST CHUNK.SYMBOL.TABLE NIL) + (IMCOMPARE.UPDATE.SYMBOL.TABLE OLDFILE.CHUNK.LIST CHUNK.SYMBOL.TABLE T) - (* * For every new chunk whose hash value matches EXACTLY ONE old chunk's - value, "connect" it to the old chunk by setting the new chunk's OTHERCHUNK - field to point to the appropriate place in the old chunk list . Also, make sure that OTHERCHUNK of the matching old chunk is - non-NIL, so that unconnected old chunks will be merged correctly.) + (* ;; "For every new chunk whose hash value matches EXACTLY ONE old chunk's value, 'connect' it to the old chunk by setting the new chunk's OTHERCHUNK field to point to the appropriate place in the old chunk list . Also, make sure that OTHERCHUNK of the matching old chunk is non-NIL, so that unconnected old chunks will be merged correctly.") - (for NEW.CHUNK in NEWFILE.CHUNK.LIST bind SYMB - do (SETQ SYMB (GETHASH (fetch (IMCOMPARE.CHUNK HASHVALUE) of NEW.CHUNK) - CHUNK.SYMBOL.TABLE)) - (if (AND (EQ 1 (fetch (IMCOMPARE.SYMB NEWCOUNT) of SYMB)) - (EQ 1 (fetch (IMCOMPARE.SYMB OLDCOUNT) of SYMB))) - then (replace (IMCOMPARE.CHUNK OTHERCHUNK) of NEW.CHUNK - with (fetch (IMCOMPARE.SYMB OLDPTR) of SYMB)) - (replace (IMCOMPARE.CHUNK OTHERCHUNK) - of (CAR (fetch (IMCOMPARE.SYMB OLDPTR) of SYMB)) - with T))) + (for NEW.CHUNK in NEWFILE.CHUNK.LIST bind SYMB + do (SETQ SYMB (GETHASH (fetch (IMCOMPARE.CHUNK HASHVALUE) of NEW.CHUNK) + CHUNK.SYMBOL.TABLE)) + (if (AND (EQ 1 (fetch (IMCOMPARE.SYMB NEWCOUNT) of SYMB)) + (EQ 1 (fetch (IMCOMPARE.SYMB OLDCOUNT) of SYMB))) + then (replace (IMCOMPARE.CHUNK OTHERCHUNK) of NEW.CHUNK with (fetch ( + IMCOMPARE.SYMB + OLDPTR) + of SYMB)) + (replace (IMCOMPARE.CHUNK OTHERCHUNK) of (CAR (fetch (IMCOMPARE.SYMB OLDPTR) + of SYMB)) with T))) - (* * merge connected chunks forward) + (* ;; "Merge connected chunks forward") - (IMCOMPARE.MERGE.CONNECTED.CHUNKS NEWFILE.CHUNK.LIST NIL) + (IMCOMPARE.MERGE.CONNECTED.CHUNKS NEWFILE.CHUNK.LIST NIL) - (* * merge connected chunks backwards) + (* ;; "Merge connected chunks backwards") - (SETQ NEWFILE.CHUNK.LIST (DREVERSE NEWFILE.CHUNK.LIST)) - (SETQ OLDFILE.CHUNK.LIST (DREVERSE OLDFILE.CHUNK.LIST)) - (IMCOMPARE.MERGE.CONNECTED.CHUNKS NEWFILE.CHUNK.LIST T) - (SETQ NEWFILE.CHUNK.LIST (DREVERSE NEWFILE.CHUNK.LIST)) - (SETQ OLDFILE.CHUNK.LIST (DREVERSE OLDFILE.CHUNK.LIST)) + (SETQ NEWFILE.CHUNK.LIST (DREVERSE NEWFILE.CHUNK.LIST)) + (SETQ OLDFILE.CHUNK.LIST (DREVERSE OLDFILE.CHUNK.LIST)) + (IMCOMPARE.MERGE.CONNECTED.CHUNKS NEWFILE.CHUNK.LIST T) + (SETQ NEWFILE.CHUNK.LIST (DREVERSE NEWFILE.CHUNK.LIST)) + (SETQ OLDFILE.CHUNK.LIST (DREVERSE OLDFILE.CHUNK.LIST)) - (* * merge unconnected chunks) + (* ;; "Merge unconnected chunks") - (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS NEWFILE.CHUNK.LIST) - (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS OLDFILE.CHUNK.LIST) + (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS NEWFILE.CHUNK.LIST) + (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS OLDFILE.CHUNK.LIST) - (* * now, the file comparison is complete. - Format and display the file difference graph) + (* ;; "The file comparison is complete. Format and display the file difference graph") - (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK - HASH.TYPE GRAPH.REGION NEWFILE.CHUNK.LIST OLDFILE.CHUNK.LIST]) + (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH NEWFILE.SPEC.CHUNK OLDFILE.CHUNK.LIST HASH.TYPE + GRAPH.REGION NEWFILE.CHUNK.LIST OLDFILE.CHUNK.LIST FILELABELS]) (IMCOMPARE.COLLECT.HASH.CHUNKS - [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 23-Dec-98 16:54 by rmk:") - (* mjs " 8-Jan-84 20:57") + [LAMBDA (CHUNK HASH.TYPE) (* ; "Edited 15-Dec-2021 15:40 by rmk") + (* ; "Edited 13-Dec-2021 16:32 by rmk") + (* ; "Edited 23-Dec-98 16:54 by rmk:") + (* mjs " 8-Jan-84 20:57") - (* * returns a list of the chunks in CHUNK as hashed of type HASH.TYPE) +(* ;;; "returns a list of the chunks inside CHUNK as hashed of type HASH.TYPE. Presumably CHUNK is is higher on the ranking PARA > LINE >. WORD. The initial CHUNK covers the whole file, middle-mouse refinement-chunks cover only subsections.") - (LET (STREAM END.OF.CHUNK.PTR CHUNK.LIST) - [SETQ STREAM (OPENSTREAM (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK) - 'INPUT - 'OLD - '((TYPE TEXT] - (SETFILEPTR STREAM (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) - (SETQ END.OF.CHUNK.PTR (IPLUS (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK) - (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK))) - (SETQ CHUNK.LIST (until (IGEQ (GETFILEPTR STREAM) - END.OF.CHUNK.PTR) collect (IMCOMPARE.HASH STREAM - END.OF.CHUNK.PTR - HASH.TYPE))) - (CLOSEF STREAM) - CHUNK.LIST]) + (BIND [STREAM _ (OPENSTREAM (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK) + 'INPUT + 'OLD + '((TYPE TEXT) + (EOLCONVENTION ANY] + (ENDPOS _ (IPLUS (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK) + (fetch (IMCOMPARE.CHUNK CHUNKLENGTH) of CHUNK))) + (FILENAME _ (fetch (IMCOMPARE.CHUNK FILENAME) of CHUNK)) + FIRST (SETFILEPTR STREAM (fetch (IMCOMPARE.CHUNK FILEPTR) of CHUNK)) + WHILE (SETQ CHUNK (IMCOMPARE.HASH STREAM HASH.TYPE ENDPOS FILENAME)) COLLECT CHUNK + FINALLY (CLOSEF STREAM]) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH [LAMBDA (NEWFILE.SPEC.CHUNK OLDFILE.SPEC.CHUNK HASH.TYPE GRAPH.REGION NEWFILE.CHUNK.LIST - OLDFILE.CHUNK.LIST) (* mjs "11-Jul-85 09:10") + OLDFILE.CHUNK.LIST FILELABELS) (* ; "Edited 16-Dec-2021 10:48 by rmk") + (* ; "Edited 13-Dec-2021 12:19 by rmk") + (* mjs "11-Jul-85 09:10") - (* * format and display the graph) +(* ;;; "format and display the graph") - (PROG ((NEWFILENAME (fetch (IMCOMPARE.CHUNK FILENAME) of NEWFILE.SPEC.CHUNK)) - (OLDFILENAME (fetch (IMCOMPARE.CHUNK FILENAME) of OLDFILE.SPEC.CHUNK)) - (OLD.CHUNK.NODE.FROM.NODES NIL) - (BORDERSIZE 1) - GRAPH.WINDOW NEW.CHUNK.NODES OLD.CHUNK.NODES OLD.CHUNK.XCOORD NEW.CHUNK.XCOORD - YCOORD.INCREMENT DIFF.GRAPH) + (LET ((NEWFILENAME (fetch (IMCOMPARE.CHUNK FILENAME) of NEWFILE.SPEC.CHUNK)) + (OLDFILENAME (fetch (IMCOMPARE.CHUNK FILENAME) of OLDFILE.SPEC.CHUNK)) + NEWFILELABEL OLDFILELABEL (OLD.CHUNK.NODE.FROM.NODES NIL) + (BORDERSIZE 1) + GRAPH.WINDOW NEW.CHUNK.NODES OLD.CHUNK.NODES OLD.CHUNK.XCOORD NEW.CHUNK.XCOORD + YCOORD.INCREMENT DIFF.GRAPH) - (* * set up GRAPH.WINDOW. This is done first so you can get the width and - height of strings to be printed in the window.) +(* ;;; "set up GRAPH.WINDOW. This is done first so you can get the width and height of strings to be printed in the window.") - [SETQ GRAPH.WINDOW (CREATEW GRAPH.REGION (CONCAT "Text File Differences, hashed by " - (SELECTQ HASH.TYPE - ((PARA NIL) - "Paragraph") - (LINE "Line") - (WORD "Word") - (SHOULDNT] - (WINDOWPROP GRAPH.WINDOW 'IMPARE.HASH.TYPE HASH.TYPE) - [WINDOWADDPROP GRAPH.WINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW) - (if (EQ WINDOW - IMCOMPARE.LAST.GRAPH.WINDOW) - then (SETQ - IMCOMPARE.LAST.GRAPH.WINDOW - NIL) - (SETQ IMCOMPARE.LAST.NODE NIL] - (SETQ NEW.CHUNK.XCOORD (IQUOTIENT (STRINGWIDTH NEWFILENAME GRAPH.WINDOW) - 2)) - [SETQ OLD.CHUNK.XCOORD (IPLUS NEW.CHUNK.XCOORD (IMAX 100 (IPLUS NEW.CHUNK.XCOORD - (IQUOTIENT (STRINGWIDTH - OLDFILENAME - GRAPH.WINDOW) - 2) - 20] - [SETQ YCOORD.INCREMENT (IMINUS (IPLUS 2 (ITIMES 2 BORDERSIZE) - (fetch (REGION HEIGHT) of (STRINGREGION - NEWFILENAME - GRAPH.WINDOW] + (SETQ NEWFILELABEL (OR (CAR (LISTP FILELABELS)) + NEWFILENAME)) + (SETQ OLDFILELABEL (OR (CADR (LISTP FILELABELS)) + OLDFILENAME)) + [SETQ GRAPH.WINDOW (CREATEW GRAPH.REGION (CONCAT "Text File Differences, hashed by " + (SELECTQ HASH.TYPE + ((PARA NIL) + "Paragraph") + (LINE "Line") + (WORD "Word") + (SHOULDNT] + (WINDOWPROP GRAPH.WINDOW 'IMPARE.HASH.TYPE HASH.TYPE) + [WINDOWADDPROP GRAPH.WINDOW 'CLOSEFN (FUNCTION (LAMBDA (WINDOW) + (if (EQ WINDOW IMCOMPARE.LAST.GRAPH.WINDOW) + then (SETQ IMCOMPARE.LAST.GRAPH.WINDOW + NIL) + (SETQ IMCOMPARE.LAST.NODE NIL] + (SETQ NEW.CHUNK.XCOORD (IQUOTIENT (STRINGWIDTH NEWFILELABEL GRAPH.WINDOW) + 2)) + [SETQ OLD.CHUNK.XCOORD (IPLUS NEW.CHUNK.XCOORD (IMAX 100 (IPLUS NEW.CHUNK.XCOORD + (IQUOTIENT (STRINGWIDTH + OLDFILELABEL + GRAPH.WINDOW) + 2) + 20] + [SETQ YCOORD.INCREMENT (IMINUS (IPLUS 2 (ITIMES 2 BORDERSIZE) + (fetch (REGION HEIGHT) of (STRINGREGION NEWFILELABEL + GRAPH.WINDOW] - (* * collect new-chunk graph nodes, while accumulating - OLD.CHUNK.NODE.FROM.NODES, assoc list from old-chunks to new-chunks) +(* ;;; "collect new-chunk graph nodes, while accumulating OLD.CHUNK.NODE.FROM.NODES, assoc list from old-chunks to new-chunks") - (SETQ NEW.CHUNK.NODES (for NEW.CHUNK in NEWFILE.CHUNK.LIST as Y from - YCOORD.INCREMENT - by YCOORD.INCREMENT bind CORRESPONDING.OLD.CHUNK - collect (SETQ CORRESPONDING.OLD.CHUNK - (CAR (fetch (IMCOMPARE.CHUNK OTHERCHUNK) - of NEW.CHUNK))) - (if CORRESPONDING.OLD.CHUNK - then (SETQ OLD.CHUNK.NODE.FROM.NODES - (CONS (CONS CORRESPONDING.OLD.CHUNK NEW.CHUNK) - OLD.CHUNK.NODE.FROM.NODES))) - (* Start out with 2 point white - border, so we can invert it) - (NODECREATE NEW.CHUNK (IMCOMPARE.LENGTHEN.ATOM - (PACK* (fetch (IMCOMPARE.CHUNK - FILEPTR) - of NEW.CHUNK) - ":" - (fetch (IMCOMPARE.CHUNK - CHUNKLENGTH) - of NEW.CHUNK)) - 12) - (create POSITION - XCOORD _ NEW.CHUNK.XCOORD - YCOORD _ Y) - (if CORRESPONDING.OLD.CHUNK - then (LIST CORRESPONDING.OLD.CHUNK) - else NIL) - NIL DEFAULTFONT -2))) - (SETQ OLD.CHUNK.NODES (for OLD.CHUNK in OLDFILE.CHUNK.LIST as Y from - YCOORD.INCREMENT - by YCOORD.INCREMENT bind CORRESPONDING.NEW.CHUNK - collect (SETQ CORRESPONDING.NEW.CHUNK (CDR (ASSOC OLD.CHUNK + (SETQ NEW.CHUNK.NODES (for NEW.CHUNK in NEWFILE.CHUNK.LIST as Y from YCOORD.INCREMENT + by YCOORD.INCREMENT bind CORRESPONDING.OLD.CHUNK + collect (SETQ CORRESPONDING.OLD.CHUNK (CAR (fetch (IMCOMPARE.CHUNK + OTHERCHUNK) + of NEW.CHUNK))) + (if CORRESPONDING.OLD.CHUNK + then (SETQ OLD.CHUNK.NODE.FROM.NODES + (CONS (CONS CORRESPONDING.OLD.CHUNK NEW.CHUNK) + OLD.CHUNK.NODE.FROM.NODES))) + (* ; + "Start out with 2 point white border, so we can invert it") + (NODECREATE NEW.CHUNK (IMCOMPARE.LENGTHEN.ATOM + (PACK* (fetch (IMCOMPARE.CHUNK FILEPTR + ) of NEW.CHUNK) + ":" + (fetch (IMCOMPARE.CHUNK + CHUNKLENGTH) + of NEW.CHUNK)) + 12) + (create POSITION + XCOORD _ NEW.CHUNK.XCOORD + YCOORD _ Y) + (if CORRESPONDING.OLD.CHUNK + then (LIST CORRESPONDING.OLD.CHUNK) + else NIL) + NIL DEFAULTFONT -2))) + (SETQ OLD.CHUNK.NODES (for OLD.CHUNK in OLDFILE.CHUNK.LIST as Y from YCOORD.INCREMENT + by YCOORD.INCREMENT bind CORRESPONDING.NEW.CHUNK + collect (SETQ CORRESPONDING.NEW.CHUNK (CDR (ASSOC OLD.CHUNK OLD.CHUNK.NODE.FROM.NODES - ))) - (NODECREATE OLD.CHUNK (IMCOMPARE.LENGTHEN.ATOM - (PACK* (fetch (IMCOMPARE.CHUNK - FILEPTR) - of OLD.CHUNK) - ":" - (fetch (IMCOMPARE.CHUNK - CHUNKLENGTH) - of OLD.CHUNK)) - 12 "-") - (create POSITION - XCOORD _ OLD.CHUNK.XCOORD - YCOORD _ Y) - NIL - (if CORRESPONDING.NEW.CHUNK - then (LIST CORRESPONDING.NEW.CHUNK) - else NIL) - DEFAULTFONT -2))) - (SETQ DIFF.GRAPH (create GRAPH - DIRECTEDFLG _ T - SIDESFLG _ T - GRAPHNODES _ - (NCONC (LIST (NODECREATE NEWFILE.SPEC.CHUNK NEWFILENAME - (create POSITION - XCOORD _ NEW.CHUNK.XCOORD - YCOORD _ 0) - NIL NIL DEFAULTFONT -2)) - NEW.CHUNK.NODES - (LIST (NODECREATE OLDFILE.SPEC.CHUNK OLDFILENAME - (create POSITION - XCOORD _ OLD.CHUNK.XCOORD - YCOORD _ 0) - NIL NIL DEFAULTFONT -2)) - OLD.CHUNK.NODES))) - (SHOWGRAPH DIFF.GRAPH GRAPH.WINDOW (FUNCTION IMCOMPARE.LEFTBUTTONFN) - (FUNCTION IMCOMPARE.MIDDLEBUTTONFN) - T NIL]) + ))) + (NODECREATE OLD.CHUNK (IMCOMPARE.LENGTHEN.ATOM + (PACK* (fetch (IMCOMPARE.CHUNK FILEPTR + ) of OLD.CHUNK) + ":" + (fetch (IMCOMPARE.CHUNK + CHUNKLENGTH) + of OLD.CHUNK)) + 12 "-") + (create POSITION + XCOORD _ OLD.CHUNK.XCOORD + YCOORD _ Y) + NIL + (if CORRESPONDING.NEW.CHUNK + then (LIST CORRESPONDING.NEW.CHUNK) + else NIL) + DEFAULTFONT -2))) + (SETQ DIFF.GRAPH (create GRAPH + DIRECTEDFLG _ T + SIDESFLG _ T + GRAPHNODES _ + (NCONC (LIST (NODECREATE NEWFILENAME NEWFILELABEL + (create POSITION + XCOORD _ NEW.CHUNK.XCOORD + YCOORD _ 0) + NIL NIL DEFAULTFONT -2)) + NEW.CHUNK.NODES + (LIST (NODECREATE OLDFILENAME OLDFILELABEL + (create POSITION + XCOORD _ OLD.CHUNK.XCOORD + YCOORD _ 0) + NIL NIL DEFAULTFONT -2)) + OLD.CHUNK.NODES))) + (GRAPHERPROP DIFF.GRAPH 'FILELABELS (LIST NEWFILELABEL OLDFILELABEL)) + (* ; + "So Middle mouse graphs can get the right labels") + (GRAPHERPROP DIFF.GRAPH 'HASH.TYPE HASH.TYPE) + (SHOWGRAPH DIFF.GRAPH GRAPH.WINDOW (FUNCTION IMCOMPARE.LEFTBUTTONFN) + (FUNCTION IMCOMPARE.MIDDLEBUTTONFN) + T NIL]) (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT - [LAMBDA (FILE) (* mjs " 2-Jan-84 16:19") + [LAMBDA (FILE) (* ; "Edited 16-Dec-2021 08:40 by rmk") + (* mjs " 2-Jan-84 16:19") - (* returns the Tedit text object of the first Tedit window which is currently - looking at FILE, if there is one. Returns NIL if none is found.) + (* ;; "returns the Tedit text object of the first Tedit window which is currently looking at FILE, if there is one. Returns NIL if none is found.") - (PROG ((TEDIT.TEXT.OBJECT NIL)) - (for X in (OPENWINDOWS) bind POSS.TOBJ POSS.FILENAME - when (SETQ POSS.TOBJ (WINDOWPROP X 'TEXTOBJ)) repeatuntil TEDIT.TEXT.OBJECT - do (SETQ POSS.FILENAME (FULLNAME (fetch (TEXTOBJ TXTFILE) of POSS.TOBJ))) - (if (EQ FILE POSS.FILENAME) - then (SETQ TEDIT.TEXT.OBJECT POSS.TOBJ))) - (RETURN TEDIT.TEXT.OBJECT]) + (for W in (OPENWINDOWS) bind POSS.TOBJ when [AND (SETQ POSS.TOBJ (WINDOWPROP W 'TEXTOBJ)) + (EQ FILE (FULLNAME (fetch (TEXTOBJ TXTFILE) + of POSS.TOBJ] + unless (TEDIT.STREAMCHANGEDP POSS.TOBJ) do (RETURN POSS.TOBJ]) (IMCOMPARE.HASH - [LAMBDA (STREAM EOF.PTR HASH.TYPE) (* ; "Edited 23-Dec-98 16:58 by rmk:") + [LAMBDA (STREAM HASH.TYPE ENDPOS FULLNAME) (* ; "Edited 15-Dec-2021 15:58 by rmk") + (* ; "Edited 13-Dec-2021 16:35 by rmk") + (* ; "Edited 23-Dec-98 16:58 by rmk:") - (* reads caracters from STREAM and creates a hash value for the "next" "chunk" - A chunk is a paragraph ending in two consecutive CRs , - a line ending in a CR , or a word ending in any white space - character space . In computing the hash value, white space is - ignored. IMCOMPARE.HASH automatically stops before reading char number EOF.PTR - Returns an IMCOMPARE.CHUNK containing the hash value, the file pointer of the - beginning of the chunk, the length of the chunk, and the fullname of the stream) + (* ;; "IMCOMPARE.HASH automatically stops before reading char number EOF.PTR.") - (* Note%: Most of the time in COMPARETEXT is spent reading in and hashing - chunks, so this function was optimizes for speed, at the expense of length) + (* ;; "Returns an IMCOMPARE.CHUNK containing the hash value, the file pointer of the beginning of the chunk, the length of the chunk, and the fullname of the stream") - (PROG ((BEGIN.FILE.PTR (GETFILEPTR STREAM)) - (EOLC (GETFILEINFO STREAM 'EOL)) - (HASHNUM 0) - FILE.PTR C) - (SETQ FILE.PTR BEGIN.FILE.PTR) - (SELECTQ HASH.TYPE - ((NIL PARA) + (* ;; "Note: Most of the time in COMPARETEXT is spent reading in and hashing chunks, so this function was optimizes for speed, at the expense of length") - (* Paragraph chunks end with two consecutive EOL's. - In order to detect this without slowing down the gobbling of normal chars, - LAST.EOL.POS is set to the filepos of the last EOL detected. - This is only checked when another EOL comes along.) + (LET ((STARTPOS (GETFILEPTR STREAM)) + (HASHNUM 0) + C NBYTES) + (DECLARE (SPECVARS NBYTES)) + (SETQ NBYTES (IDIFFERENCE ENDPOS STARTPOS)) (* ; + "\INCCODE counts down. We reach NBYTES only on the chunk") - (PROG ((LAST.EOL.POS -5)) - loop - (if (IGEQ FILE.PTR EOF.PTR) - then (GO return)) - (SETQ FILE.PTR (ADD1 FILE.PTR)) - (SELCHARQ (SETQ C (BIN STREAM)) - (CR + (* ;; "Don't hash on white space") - (* If this is the second consecutive CR, this is the end of the chunk. - Otherwise, reset LAST.EOL.POS) - - (SELECTQ EOLC - (CR (if (IEQP LAST.EOL.POS (SUB1 (GETFILEPTR STREAM))) - then (GO endchunk) - else (SETQ LAST.EOL.POS (GETFILEPTR STREAM)))) - (CRLF (if (IGEQ FILE.PTR EOF.PTR) - then (GO return)) - (SELCHARQ (\PEEKBIN STREAM T) - (LF (SETQ FILE.PTR (ADD1 FILE.PTR)) - (BIN STREAM) - (if (IEQP LAST.EOL.POS (IDIFFERENCE - (GETFILEPTR STREAM) - 2)) - then (GO endchunk) - else (SETQ LAST.EOL.POS (GETFILEPTR STREAM - )))) - NIL)) - NIL)) - (LF [COND - ((EQ EOLC 'LF) - (if (IEQP LAST.EOL.POS (SUB1 (GETFILEPTR STREAM))) - then (GO endchunk) - else (SETQ LAST.EOL.POS (GETFILEPTR STREAM]) - ((SPACE TAB)) - (SETQ HASHNUM (ROT (ROT (ROT (LOGXOR HASHNUM C) - 1 16) - 1 16) - 1 16))) - (GO loop))) - (LINE (* Line chunks end on a single CR.) - (PROG NIL - loop - (if (IGEQ FILE.PTR EOF.PTR) - then (GO return)) - (SETQ FILE.PTR (ADD1 FILE.PTR)) - (SELCHARQ (SETQ C (BIN STREAM)) - (CR (SELECTQ EOLC - (CR (GO endchunk)) - (LF) - (CRLF (if (IGEQ FILE.PTR EOF.PTR) - then (GO return)) - (SELCHARQ (\PEEKBIN STREAM T) - (LF (SETQ FILE.PTR (ADD1 FILE.PTR)) - (BIN STREAM) - (GO endchunk)) - NIL)) - (SHOULDNT))) - (LF (AND (EQ EOLC 'LF) - (GO endchunk))) - ((SPACE TAB)) - (SETQ HASHNUM (ROT (ROT (ROT (LOGXOR HASHNUM C) - 1 16) - 1 16) - 1 16))) - (GO loop))) - (WORD (* word chunks end on any white - space) - (PROG NIL - loop - (if (IGEQ FILE.PTR EOF.PTR) - then (GO return)) - (SETQ FILE.PTR (ADD1 FILE.PTR)) - (SELCHARQ (SETQ C (BIN STREAM)) - ((CR SPACE TAB LF) - (GO endchunk)) - (SETQ HASHNUM (ROT (ROT (ROT (LOGXOR HASHNUM C) - 1 16) - 1 16) - 1 16))) - (GO loop))) - (HELP (CONCAT "Unrecognize HASHTYPE " HASH.TYPE) - " - Should be PARA, LINE, or WORD")) - endchunk - (* flush all white space before next - chunk) - (if (IGEQ FILE.PTR EOF.PTR) - then (GO return)) - (SETQ FILE.PTR (ADD1 FILE.PTR)) - (SELCHARQ (BIN STREAM) - ((CR SPACE TAB LF) - (GO endchunk)) - (PROGN (SETQ FILE.PTR (SUB1 FILE.PTR)) - (SETFILEPTR STREAM FILE.PTR))) - return - (RETURN (create IMCOMPARE.CHUNK - HASHVALUE _ HASHNUM - FILEPTR _ BEGIN.FILE.PTR - CHUNKLENGTH _ (IDIFFERENCE FILE.PTR BEGIN.FILE.PTR) - FILENAME _ (FULLNAME STREAM]) + (CL:WHEN (IGREATERP NBYTES 0) + (SELECTQ HASH.TYPE + (PARA (* ; + "Paragraph chunks end with two consecutive EOL's.") + (BIND EOLSEEN WHILE (IGREATERP NBYTES 0) + DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM NIL 'NBYTES NBYTES)) + (EOL (CL:WHEN EOLSEEN (RETURN)) + (SETQ EOLSEEN T) (* ; "Skip the NIL SETQ below") + (GO $$ITERATE)) + ((SPACE TAB)) + (SETQ HASHNUM (ROT (ROT (ROT (LOGXOR HASHNUM C) + 1 16) + 1 16) + 1 16))) + (SETQ EOLSEEN NIL))) + (LINE (* ; "Line chunks end on EOL.") + [WHILE (IGREATERP NBYTES 0) + DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM NIL 'NBYTES NBYTES)) + (EOL (RETURN)) + ((SPACE TAB)) + (SETQ HASHNUM (ROT (ROT (ROT (LOGXOR HASHNUM C) + 1 16) + 1 16) + 1 16]) + (WORD (* ; + "word chunks end on any white space") + [WHILE (IGREATERP NBYTES 0) + DO (SELECTQ (SETQ C (\INCCODE.EOLC STREAM NIL 'NBYTES NBYTES)) + ((SPACE EOL TAB) + (RETURN)) + (SETQ HASHNUM (ROT (ROT (ROT (LOGXOR HASHNUM C) + 1 16) + 1 16) + 1 16]) + (SHOULDNT)) (* ; + "flush all white space before next chunk") + (WHILE (IGREATERP NBYTES 0) DO (SELCHARQ (\INCCODE.EOLC STREAM NIL 'NBYTES NBYTES) + ((EOL SPACE TAB)) + (RETURN))) + (CREATE IMCOMPARE.CHUNK + HASHVALUE _ HASHNUM + FILEPTR _ STARTPOS + CHUNKLENGTH _ (IDIFFERENCE (GETFILEPTR STREAM) + STARTPOS) + FILENAME _ FULLNAME))]) (IMCOMPARE.LEFTBUTTONFN [LAMBDA (GNODE WINDOW) (* mjs " 2-Apr-85 14:21") @@ -468,19 +390,19 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. else (TEDIT FILE NIL NIL (LIST 'SEL (LIST FILEPTR CHUNKLENGTH]) (IMCOMPARE.LENGTHEN.ATOM - [LAMBDA (X MIN.LENGTH EXTENDER) (* mjs "30-Dec-83 15:11") + [LAMBDA (X MIN.LENGTH EXTENDER) (* ; "Edited 13-Dec-2021 21:18 by rmk") + (* mjs "30-Dec-83 15:11") - (* makes sure that the atom X is at least MIN.LENGTH characters long, by - concatinating the first character of EXTENDER - (or space, if not given) to the front) + (* ;; "makes sure that the atom X is at least MIN.LENGTH characters long, by concatenating the first character of EXTENDER (or space, if not given) to the front") - (PROG ((C (CHCON X))) - (SETQ EXTENDER (if EXTENDER - then (CHCON1 EXTENDER) - else (CHARCODE SPACE))) - (while (ILESSP (LENGTH C) - MIN.LENGTH) do (SETQ C (CONS EXTENDER C))) - (RETURN (PACKC C]) + (IF (ILESSP (NCHARS X) + MIN.LENGTH) + THEN (PACK* (ALLOCSTRING (IDIFFERENCE MIN.LENGTH (NCHARS X)) + (CL:IF EXTENDER + (NTHCHAR EXTENDER 1) + " ")) + X) + ELSE X]) (IMCOMPARE.MERGE.CONNECTED.CHUNKS [LAMBDA (NEW.CHUNK.LIST BACKWARDS.FLG) (* mjs " 6-Jan-84 10:35") @@ -551,45 +473,44 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. (RPLACD CHUNK.LST (CDDR CHUNK.LST]) (IMCOMPARE.MIDDLEBUTTONFN - [LAMBDA (GNODE WINDOW) (* mjs " 6-Jan-84 11:37") + [LAMBDA (GNODE WINDOW) - (* This function is called if the MIDDLE mouse button is pressed over a graph - node. The selected node is IMCOMPARE-ed with the last node selected . The type of hashing used is selected from a - pop-up menu. If none of the hashing types is selected, the current node is - boxed. The pop-up menu is always located a little above the current cursor - position, so a quick double-MIDDLE-click is an easy way to change the current - boxed node.) + (* ;; "Edited 16-Dec-2021 10:55 by rmk: Remove previous HASH.TYPE from the middle mouse menu") + (* ; "Edited 16-Dec-2021 10:51 by rmk") + (* mjs " 6-Jan-84 11:37") + + (* ;; "This function is called if the MIDDLE mouse button is pressed over a graph node. The selected node is IMCOMPARE-ed with the last node selected . The type of hashing used is selected from a pop-up menu. If none of the hashing types is selected, the current node is boxed. The pop-up menu is always located a little above the current cursor position, so a quick double-MIDDLE-click is an easy way to change the current boxed node.") (if GNODE then (PROG (INNER.HASH.TYPE) - (CLRPROMPT) - (printout PROMPTWINDOW "Please select the type of hashing you wish." T) - [SETQ INNER.HASH.TYPE - (MENU (if (type? MENU IMCOMPARE.HASH.TYPE.MENU) - then IMCOMPARE.HASH.TYPE.MENU - else (SETQ IMCOMPARE.HASH.TYPE.MENU - (create MENU - ITEMS _ '(PARA LINE WORD) - MENUOFFSET _ - (create POSITION - XCOORD _ 20 - YCOORD _ -20] - (if (NULL INNER.HASH.TYPE) - then (* if no hash type is selected, just - box the current node and return) - (IMCOMPARE.BOXNODE GNODE WINDOW) - (RETURN)) - (if (NULL IMCOMPARE.LAST.NODE) - then (CLRPROMPT) - (PRIN1 "You must select another graph node first." PROMPTWINDOW) - (RETURN)) - (printout PROMPTWINDOW "Comparing chunks by " INNER.HASH.TYPE T) - (IMCOMPARE.CHUNKS (fetch (GRAPHNODE NODEID) of IMCOMPARE.LAST.NODE - ) - (fetch (GRAPHNODE NODEID) of GNODE) - INNER.HASH.TYPE - (WINDOWPROP WINDOW 'REGION]) + (CLRPROMPT) + (printout PROMPTWINDOW "Please select the type of hashing you wish." T) + [SETQ INNER.HASH.TYPE (MENU (create MENU + ITEMS _ (REMOVE (GRAPHERPROP + (WINDOWPROP WINDOW + 'GRAPH) + 'HASH.TYPE) + '(PARA LINE WORD)) + MENUOFFSET _ + (create POSITION + XCOORD _ 20 + YCOORD _ -20] + (if (NULL INNER.HASH.TYPE) + then (* ; + "if no hash type is selected, just box the current node and return") + (IMCOMPARE.BOXNODE GNODE WINDOW) + (RETURN)) + (if (NULL IMCOMPARE.LAST.NODE) + then (CLRPROMPT) + (PRIN1 "You must select another graph node first." PROMPTWINDOW) + (RETURN)) + (printout PROMPTWINDOW "Comparing chunks by " INNER.HASH.TYPE T) + (IMCOMPARE.CHUNKS (fetch (GRAPHNODE NODEID) of IMCOMPARE.LAST.NODE) + (fetch (GRAPHNODE NODEID) of GNODE) + INNER.HASH.TYPE + (WINDOWPROP WINDOW 'REGION) + (GRAPHERPROP (WINDOWPROP WINDOW 'GRAPH) + 'FILELABELS]) (IMCOMPARE.SHOW.DIST [LAMBDA (LST MAX) (* mjs "30-Dec-83 15:13") @@ -634,15 +555,13 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. (MOVD 'COMPARETEXT 'IMCOMPARE) -(RPAQQ IMCOMPARE.LAST.NODE NIL) +(RPAQ? IMCOMPARE.LAST.NODE NIL) -(RPAQQ IMCOMPARE.LAST.GRAPH.WINDOW NIL) - -(RPAQQ IMCOMPARE.HASH.TYPE.MENU NIL) +(RPAQ? IMCOMPARE.LAST.GRAPH.WINDOW NIL) (DECLARE%: EVAL@COMPILE (RECORD IMCOMPARE.CHUNK (HASHVALUE FILEPTR CHUNKLENGTH FILENAME . OTHERCHUNK) - FILEPTR _ 1 CHUNKLENGTH _ 0) + FILEPTR _ 1 CHUNKLENGTH _ 0) (RECORD IMCOMPARE.SYMB (NEWCOUNT OLDCOUNT . OLDPTR)) ) @@ -650,11 +569,11 @@ Copyright (c) 1984, 1985, 1993, 1998 by Xerox Corporation. All rights reserved. (FILESLOAD GRAPHER) (PUTPROPS COMPARETEXT COPYRIGHT ("Xerox Corporation" 1984 1985 1993 1998)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1365 39345 (COMPARETEXT 1375 . 3770) (IMCOMPARE.BOXNODE 3772 . 4288) (IMCOMPARE.CHUNKS -4290 . 8476) (IMCOMPARE.COLLECT.HASH.CHUNKS 8478 . 9707) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH 9709 - . 18575) (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT 18577 . 19340) (IMCOMPARE.HASH 19342 . 26603) ( -IMCOMPARE.LEFTBUTTONFN 26605 . 28341) (IMCOMPARE.LENGTHEN.ATOM 28343 . 28981) ( -IMCOMPARE.MERGE.CONNECTED.CHUNKS 28983 . 32479) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 32481 . 34436) ( -IMCOMPARE.MIDDLEBUTTONFN 34438 . 37010) (IMCOMPARE.SHOW.DIST 37012 . 37458) ( -IMCOMPARE.UPDATE.SYMBOL.TABLE 37460 . 39343))))) + (FILEMAP (NIL (1433 36973 (COMPARETEXT 1443 . 3693) (IMCOMPARE.BOXNODE 3695 . 4211) (IMCOMPARE.CHUNKS +4213 . 8626) (IMCOMPARE.COLLECT.HASH.CHUNKS 8628 . 10026) (IMCOMPARE.DISPLAY.FILE.DIFFERENCE.GRAPH +10028 . 19004) (IMCOMPARE.FIND.TEDIT.TEXT.OBJECT 19006 . 19780) (IMCOMPARE.HASH 19782 . 23904) ( +IMCOMPARE.LEFTBUTTONFN 23906 . 25642) (IMCOMPARE.LENGTHEN.ATOM 25644 . 26346) ( +IMCOMPARE.MERGE.CONNECTED.CHUNKS 26348 . 29844) (IMCOMPARE.MERGE.UNCONNECTED.CHUNKS 29846 . 31801) ( +IMCOMPARE.MIDDLEBUTTONFN 31803 . 34638) (IMCOMPARE.SHOW.DIST 34640 . 35086) ( +IMCOMPARE.UPDATE.SYMBOL.TABLE 35088 . 36971))))) STOP From cde5c9018d0eabc36e674533167d826ddb97a40f Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 16 Dec 2021 20:11:56 -0800 Subject: [PATCH 4/4] FILEIO: allow EOLCONVENTION ANY for input files Any occurrence of CR, LF, CRLF maps to EOL, to facilitate processing of text files of unknown provenance --- sources/FILEIO | 917 ++++++++++++++++++++++---------------------- sources/FILEIO.LCOM | Bin 45394 -> 45528 bytes 2 files changed, 455 insertions(+), 462 deletions(-) diff --git a/sources/FILEIO b/sources/FILEIO index 0ff8a793..f2452134 100644 --- a/sources/FILEIO +++ b/sources/FILEIO @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Sep-2021 21:02:29"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;99 162362 - changes to%: (VARS FILEIOCOMS) - (RECORDS FDEV) +(FILECREATED "14-Dec-2021 16:10:18" {DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;102 160392 - previous date%: "25-Sep-2021 17:25:04" -{DSK}kaplan>Local>medley3.5>git-medley>sources>FILEIO.;98) + :CHANGES-TO (FNS \DO.PARAMS.AT.OPEN) + + :PREVIOUS-DATE "13-Dec-2021 15:20:15" +{DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;101) (* ; " @@ -44,7 +43,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'STREAM (FUNCTION \STREAM.DEFPRINT)) (DEFPRINT 'FDEV (FUNCTION \FDEV.DEFPRINT] (COMS (* ; - "Needed because of STREAM initialization") + "Needed because of STREAM initialization") (INITVARS (FILELINELENGTH 102) (\STREAM.DEFAULT.MAXBUFFERS 3))) (FNS \GETACCESS \SETACCESS) @@ -211,58 +210,58 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (ADDTOVAR SYSTEMRECLST (DATATYPE STREAM ((COFFSET WORD) - (CBUFSIZE WORD) - (PEEKEDCHARP FLAG) - (ACCESSBITS BITS 3) - (CBUFPTR POINTER) - (BYTESIZE BYTE) - (CHARSET BYTE) - (PEEKEDCHAR WORD) - (CHARPOSITION WORD) - (CBUFMAXSIZE WORD) - (NONDEFAULTDATEFLG FLAG) - (REVALIDATEFLG FLAG) - (MULTIBUFFERHINT FLAG) - (USERCLOSEABLE FLAG) - (FULLFILENAME POINTER) - (BINABLE FLAG) - (BOUTABLE FLAG) - (EXTENDABLE FLAG) - (CBUFDIRTY FLAG) - (DEVICE POINTER) - (USERVISIBLE FLAG) - (EOLCONVENTION BITS 2) - (NIL FLAG) - (VALIDATION POINTER) - (CPAGE POINTER) - (EPAGE POINTER) - (EOFFSET WORD) - (LINELENGTH WORD) - (F1 POINTER) - (F2 POINTER) - (F3 POINTER) - (F4 POINTER) - (F5 POINTER) - (FW6 WORD) - (FW7 WORD) - (FW8 WORD) - (FW9 WORD) - (F10 POINTER) - (STRMBINFN POINTER) - (STRMBOUTFN POINTER) - (OUTCHARFN POINTER) - (ENDOFSTREAMOP POINTER) - (OTHERPROPS POINTER) - (IMAGEOPS POINTER) - (IMAGEDATA POINTER) - (BUFFS POINTER) - (MAXBUFFERS WORD) - (LASTCCODE WORD) - (EXTRASTREAMOP POINTER) - (INCCODEFN POINTER) - (PEEKCCODEFN POINTER) - (BACKCCODEFN POINTER) - (EXTERNALFORMAT POINTER))) + (CBUFSIZE WORD) + (PEEKEDCHARP FLAG) + (ACCESSBITS BITS 3) + (CBUFPTR POINTER) + (BYTESIZE BYTE) + (CHARSET BYTE) + (PEEKEDCHAR WORD) + (CHARPOSITION WORD) + (CBUFMAXSIZE WORD) + (NONDEFAULTDATEFLG FLAG) + (REVALIDATEFLG FLAG) + (MULTIBUFFERHINT FLAG) + (USERCLOSEABLE FLAG) + (FULLFILENAME POINTER) + (BINABLE FLAG) + (BOUTABLE FLAG) + (EXTENDABLE FLAG) + (CBUFDIRTY FLAG) + (DEVICE POINTER) + (USERVISIBLE FLAG) + (EOLCONVENTION BITS 2) + (NIL FLAG) + (VALIDATION POINTER) + (CPAGE POINTER) + (EPAGE POINTER) + (EOFFSET WORD) + (LINELENGTH WORD) + (F1 POINTER) + (F2 POINTER) + (F3 POINTER) + (F4 POINTER) + (F5 POINTER) + (FW6 WORD) + (FW7 WORD) + (FW8 WORD) + (FW9 WORD) + (F10 POINTER) + (STRMBINFN POINTER) + (STRMBOUTFN POINTER) + (OUTCHARFN POINTER) + (ENDOFSTREAMOP POINTER) + (OTHERPROPS POINTER) + (IMAGEOPS POINTER) + (IMAGEDATA POINTER) + (BUFFS POINTER) + (MAXBUFFERS WORD) + (LASTCCODE WORD) + (EXTRASTREAMOP POINTER) + (INCCODEFN POINTER) + (PEEKCCODEFN POINTER) + (BACKCCODEFN POINTER) + (EXTERNALFORMAT POINTER))) ) (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -272,51 +271,51 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (* ;; "First 8 words are fixed for BIN, BOUT opcodes. Used to require length of whole datatype be multiple of 4, but Dolphin dead now.") (COFFSET WORD) (* ; - "Offset in CPPTR of next bin or bout") + "Offset in CPPTR of next bin or bout") (CBUFSIZE WORD) (* ; - "Offset past last byte in that buffer") + "Offset past last byte in that buffer") (PEEKEDCHARP FLAG) (* ; - "if true, PEEKEDCHAR contains value of recent call to unread-char") + "if true, PEEKEDCHAR contains value of recent call to unread-char") (ACCESSBITS BITS 3) (* ; - "What kind of access file is open for (read, write, append)") + "What kind of access file is open for (read, write, append)") (CBUFPTR POINTER) (* ; "Pointer to current buffer") (BYTESIZE BYTE) (* ; - "Byte size of stream, always 8 for now") + "Byte size of stream, always 8 for now") (CHARSET BYTE) (* ; "the current character set for this stream. If 255, stream is not runcoded, so read-char consumes two bytes every time") (PEEKEDCHAR WORD) (* ; "value of unread-char call") (CHARPOSITION WORD) (* ; "Used by POSITION etc.") (CBUFMAXSIZE WORD) (* ; - "on output, the size of the physical buffer--can't extend beyond this") + "on output, the size of the physical buffer--can't extend beyond this") (* ;; "-------- Above fields (8 words) potentially known to microcode. --------") (NONDEFAULTDATEFLG FLAG) (REVALIDATEFLG FLAG) (MULTIBUFFERHINT FLAG) (* ; - "True if stream likes to read and write more than one buffer at a time") + "True if stream likes to read and write more than one buffer at a time") (USERCLOSEABLE FLAG) (* ; - "Can be closed by CLOSEF; NIL for terminal, dribble...") + "Can be closed by CLOSEF; NIL for terminal, dribble...") (FULLFILENAME POINTER) (* ; - "Name by which file is known to user") + "Name by which file is known to user") (BINABLE FLAG) (* ; "BIN punts unless this bit on") (BOUTABLE FLAG) (* ; "BOUT punts unless this bit on") (EXTENDABLE FLAG) (* ; - "BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512") + "BOUT punts when COFFSET ge CBUFFSIZE unless this bit set and COFFSET lt 512") (CBUFDIRTY FLAG) (* ; - "true if BOUT has sullied the current buffer") + "true if BOUT has sullied the current buffer") (DEVICE POINTER) (* ; "FDEV of this guy") (USERVISIBLE FLAG) (* ; - "Listed by OPENP; NIL for terminal, dribble ...") + "Listed by OPENP; NIL for terminal, dribble ...") (EOLCONVENTION BITS 2) (* ; "End-of-line convention") (NIL FLAG) (* ; "Was NOTXCCS.") (VALIDATION POINTER) (* ; - "A number somehow identifying file, used to determine if file has changed in our absence") + "A number somehow identifying file, used to determine if file has changed in our absence") (CPAGE POINTER) (* ; - "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") + "CPAGE,,COFFSET constitutes current file pointer for most randaccess streams") (EPAGE POINTER) (EOFFSET WORD) (* ; "Page, byte offset of eof") (LINELENGTH WORD) (* ; - "LINELENGTH of stream, or -1 for no line length") + "LINELENGTH of stream, or -1 for no line length") (* ;; "----Following are device-specific fields----") @@ -336,25 +335,22 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (* ;; "----Following only filled in for open streams----") (STRMBINFN POINTER) (* ; - "Either the BIN fn from the FDEV, or a trap") + "Either the BIN fn from the FDEV, or a trap") (STRMBOUTFN POINTER) (* ; - "Either the BIN fn from the FDEV, or a trap") + "Either the BIN fn from the FDEV, or a trap") (OUTCHARFN POINTER) (* ; - "Called by \OUTCHAR, the normal character printer.") - (ENDOFSTREAMOP POINTER) (* ; - "Called if EOF and we try to read.") - (OTHERPROPS POINTER) (* ; - "PROP LIST for holding other info.") + "Called by \OUTCHAR, the normal character printer.") + (ENDOFSTREAMOP POINTER) (* ; "Called if EOF and we try to read.") + (OTHERPROPS POINTER) (* ; "PROP LIST for holding other info.") (IMAGEOPS POINTER) (* ; "Image operations vector") (IMAGEDATA POINTER) (* ; - "Image instance variables--format depends on IMAGEOPS value") - (BUFFS POINTER) (* ; - "Buffer chain for pmapped streams") + "Image instance variables--format depends on IMAGEOPS value") + (BUFFS POINTER) (* ; "Buffer chain for pmapped streams") (MAXBUFFERS WORD) (* ; - "Max # of buffers the system will allocate.") + "Max # of buffers the system will allocate.") (LASTCCODE WORD) (* ; "After READ, RATOM, etc, the charcode that will be returned (as a character) by LASTC. If there is none, this field is 65535.") (EXTRASTREAMOP POINTER) (* ; - "For use of applications programs, not devices") + "For use of applications programs, not devices") (INCCODEFN POINTER) (* ; "Set by \EXTERNALFORMAT") (PEEKCCODEFN POINTER) (BACKCCODEFN POINTER) @@ -365,22 +361,21 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (* ;; "respecification of access bits:") (RANDOMWRITEABLE FLAG) (* ; - "File open for output (access = OUTPUT or BOTH)") + "File open for output (access = OUTPUT or BOTH)") (APPENDABLE FLAG) (* ; - "File open for append (OUTPUT or APPEND or BOTH)") - (READABLE FLAG) (* ; - "File open for read (READ or BOTH)") + "File open for append (OUTPUT or APPEND or BOTH)") + (READABLE FLAG) (* ; "File open for read (READ or BOTH)") (NIL POINTER))) (BLOCKRECORD STREAM ((NIL 4 WORD) (NIL BITS 14) (* ;; - "JIS character encoding format specific, overrides CHARSET field.") + "JIS character encoding format specific, overrides CHARSET field.") (IN.KANJIIN FLAG) (* ; - "True if input stream is in Kanji-in mode.") + "True if input stream is in Kanji-in mode.") (OUT.KANJIIN FLAG) (* ; - "True if output stream is in Kanji-in mode.") + "True if output stream is in Kanji-in mode.") )) [ACCESSFNS STREAM ((ACCESS \GETACCESS \SETACCESS) (FULLNAME (OR (fetch (STREAM FULLFILENAME) of DATUM) @@ -391,7 +386,7 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. USERCLOSEABLE _ T USERVISIBLE _ T ACCESSBITS _ NoBits CPAGE _ 0 EPAGE _ 0 BUFFS _ NIL BYTESIZE _ 8 CBUFPTR _ NIL MAXBUFFERS _ (LET NIL (DECLARE (GLOBALVARS \STREAM.DEFAULT.MAXBUFFERS - )) + )) \STREAM.DEFAULT.MAXBUFFERS) CHARPOSITION _ 0 LINELENGTH _ (LET NIL (DECLARE (GLOBALVARS FILELINELENGTH)) FILELINELENGTH) @@ -464,16 +459,15 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. '64) (DECLARE%: EVAL@COMPILE -(PUTPROPS STREAMOP MACRO [ARGS (CONS 'SPREADAPPLY* - (CONS (COND - ((EQ (CAR (LISTP (CAR ARGS))) - 'QUOTE) - (LIST 'fetch (CADAR ARGS) - 'of - (CADR ARGS))) - (T (HELP "STREAMOP - OPNAME not quoted:" ARGS)) - ) - (CDDR ARGS]) +(PUTPROPS STREAMOP MACRO [ARGS (CONS 'SPREADAPPLY* (CONS (COND + ((EQ (CAR (LISTP (CAR ARGS))) + 'QUOTE) + (LIST 'fetch (CADAR ARGS) + 'of + (CADR ARGS))) + (T (HELP "STREAMOP - OPNAME not quoted:" + ARGS))) + (CDDR ARGS]) ) (DECLARE%: EVAL@COMPILE @@ -496,47 +490,47 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (PUTPROPS TestMasked MACRO ((BITS MASK) - (NEQ (LOGAND BITS MASK) - 0))) + (NEQ (LOGAND BITS MASK) + 0))) (PUTPROPS APPENDABLE MACRO ((STREAM) - (TestMasked (fetch ACCESSBITS of STREAM) - AppendBit))) + (TestMasked (fetch ACCESSBITS of STREAM) + AppendBit))) (PUTPROPS APPENDONLY MACRO ((STREAM) - (EQ (fetch ACCESSBITS of STREAM) - AppendBit))) + (EQ (fetch ACCESSBITS of STREAM) + AppendBit))) (PUTPROPS DIRTYABLE MACRO [(STREAM) - (TestMasked (fetch ACCESSBITS of STREAM) - (CONSTANT (LOGOR AppendBit WriteBit]) + (TestMasked (fetch ACCESSBITS of STREAM) + (CONSTANT (LOGOR AppendBit WriteBit]) (PUTPROPS OPENED MACRO ((STREAM) - (NEQ (fetch ACCESSBITS of STREAM) - NoBits))) + (NEQ (fetch ACCESSBITS of STREAM) + NoBits))) (PUTPROPS OVERWRITEABLE MACRO ((STREAM) - (TestMasked (fetch ACCESSBITS of STREAM) - WriteBit))) + (TestMasked (fetch ACCESSBITS of STREAM) + WriteBit))) (PUTPROPS READABLE MACRO ((STREAM) - (TestMasked (fetch ACCESSBITS of STREAM) - ReadBit))) + (TestMasked (fetch ACCESSBITS of STREAM) + ReadBit))) (PUTPROPS READONLY MACRO ((STREAM) - (EQ (fetch ACCESSBITS of STREAM) - ReadBit))) + (EQ (fetch ACCESSBITS of STREAM) + ReadBit))) (PUTPROPS WRITEABLE MACRO [(STREAM) - (OR (OVERWRITEABLE STREAM) - (AND (APPENDABLE STREAM) - (\EOFP STREAM]) + (OR (OVERWRITEABLE STREAM) + (AND (APPENDABLE STREAM) + (\EOFP STREAM]) ) (RPAQQ EOLCONVENTIONS ((CR.EOLC 0) - (LF.EOLC 1) - (CRLF.EOLC 2) - (ANY.EOLC 3))) + (LF.EOLC 1) + (CRLF.EOLC 2) + (ANY.EOLC 3))) (DECLARE%: EVAL@COMPILE (RPAQQ CR.EOLC 0) @@ -773,178 +767,173 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS FDEVOP DMACRO [ARGS (LET ((OPNAME (CAR ARGS)) - (METHOD-DEVICE (CADR ARGS)) - (TAIL (CDDR ARGS))) - (COND - [(AND (LISTP OPNAME) - (EQ (CAR OPNAME) - 'QUOTE)) - `(SPREADAPPLY* (fetch (FDEV ,(CADR OPNAME)) - of ,METHOD-DEVICE) - ,@TAIL] - (T (ERROR "OPNAME not quoted: " OPNAME]) + (METHOD-DEVICE (CADR ARGS)) + (TAIL (CDDR ARGS))) + (COND + [(AND (LISTP OPNAME) + (EQ (CAR OPNAME) + 'QUOTE)) + `(SPREADAPPLY* (fetch (FDEV ,(CADR OPNAME)) + of ,METHOD-DEVICE) + ,@TAIL] + (T (ERROR "OPNAME not quoted: " OPNAME]) (PUTPROPS \RECOGNIZE-HACK DMACRO [ARGS (LET ((NAME (CAR ARGS)) - (RECOG (CADR ARGS)) - (DEVICE (CADDR ARGS))) - `(if (type? STREAM ,NAME) - then ,NAME - else (FDEVOP 'GETFILENAME ,DEVICE - ,NAME - ,RECOG - ,DEVICE]) + (RECOG (CADR ARGS)) + (DEVICE (CADDR ARGS))) + `(if (type? STREAM ,NAME) + then ,NAME + else (FDEVOP 'GETFILENAME ,DEVICE ,NAME ,RECOG + ,DEVICE]) ) (DECLARE%: EVAL@COMPILE -(DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete") - (RANDOMACCESSP FLAG) - (NODIRECTORIES FLAG) - (PAGEMAPPED FLAG) (* ; - "True if i/o handled by pmap routines") - (FDBINABLE FLAG) (* ; - "Copied as a microcode flag for INPUT streams formed on this device") - (FDBOUTABLE FLAG) - (FDEXTENDABLE FLAG) - (BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method") - (DEVICENAME POINTER) (* ; "Identifying name somehow") - (REMOTEP FLAG) (* ; - "true if device not local to machine") - (SUBDIRECTORIES FLAG) (* ; - "true if device has real subdirectories") - (INPUT-INDIRECTED FLAG) (* ; - "True for devices that indirect their input stream. Method INPUTSTREAM fetches it") - (OUTPUT-INDIRECTED FLAG) (* ; - "True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it") - (DEVICEINFO POINTER) (* ; - "arbitrary device-specific info stored here") - (OPENFILELST POINTER) (* ; - "Default place to keep list of streams open on this device") +(DATATYPE FDEV ((RESETABLE FLAG) (* ; "Obsolete") + (RANDOMACCESSP FLAG) + (NODIRECTORIES FLAG) + (PAGEMAPPED FLAG) (* ; + "True if i/o handled by pmap routines") + (FDBINABLE FLAG) (* ; + "Copied as a microcode flag for INPUT streams formed on this device") + (FDBOUTABLE FLAG) + (FDEXTENDABLE FLAG) + (BUFFERED FLAG) (* ; "True implies that the device supports the BIN & BOUT uCode conventions, and implements the GETNEXTBUFFER method") + (DEVICENAME POINTER) (* ; "Identifying name somehow") + (REMOTEP FLAG) (* ; + "true if device not local to machine") + (SUBDIRECTORIES FLAG) (* ; + "true if device has real subdirectories") + (INPUT-INDIRECTED FLAG) (* ; + "True for devices that indirect their input stream. Method INPUTSTREAM fetches it") + (OUTPUT-INDIRECTED FLAG) (* ; + "True for devices that indirect their output stream. Method OUTPUTSTREAM fetches it") + (DEVICEINFO POINTER) (* ; + "arbitrary device-specific info stored here") + (OPENFILELST POINTER) (* ; + "Default place to keep list of streams open on this device") - (* ;; "-----Rest of record consists of device %"methods%"-----") + (* ;; "-----Rest of record consists of device %"methods%"-----") - (* ;; "-----Following fields required of all devices-----") + (* ;; "-----Following fields required of all devices-----") - (HOSTNAMEP POINTER) (* ; "(hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use existing device") - (EVENTFN POINTER) (* ; - "(device event), called before/after logout, sysout, makesys") + (HOSTNAMEP POINTER) (* ; "(hostname {device}) => T if hostname is valid. If device is given, return a FDEV for this {new} host, or T to use existing device") + (EVENTFN POINTER) (* ; + "(device event), called before/after logout, sysout, makesys") - (* ;; - "-----Following fields required of all named devices, e.g., ones that open files-----") + (* ;; + "-----Following fields required of all named devices, e.g., ones that open files-----") - (DIRECTORYNAMEP POINTER) (* ; - "(host/dir) => true if directory exists on host") - (OPENFILE POINTER) (* ; - "(name access recog otherinfo device) => new stream open on this device, or NIL if name not found") - (CLOSEFILE POINTER) (* ; - "(stream) => closes stream, returns it") - (REOPENFILE POINTER) (* ; "(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous") - (GETFILENAME POINTER) (* ; - "(name recog device) => full file name") - (DELETEFILE POINTER) (* ; - "(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST") - (GENERATEFILES POINTER) (* ; "(device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL when finished") - (RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device.") - (OPENP POINTER) (* ; - "(name access dev) => stream if name is open for access, or all open streams if name = NIL") - (REGISTERFILE POINTER) (* ; - "(stream dev) => registers stream on its device") - (UNREGISTERFILE POINTER) (* ; - "(stream dev) => unregisters a stream from its device") - (FREEPAGECOUNT POINTER) (* ; - "(host/dir dev) => # of free pages on host/dir") - (MAKEDIRECTORY POINTER) (* ; "(host/dir dev)") - (CHECKFILENAME POINTER) (* ; - "(name dev) => name if it is well-formed file name for dev") - (HOSTALIVEP POINTER) (* ; - "(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true") - (BREAKCONNECTION POINTER) (* ; - "(host fastp dev) => closes connections to host") + (DIRECTORYNAMEP POINTER) (* ; + "(host/dir) => true if directory exists on host") + (OPENFILE POINTER) (* ; + "(name access recog otherinfo device) => new stream open on this device, or NIL if name not found") + (CLOSEFILE POINTER) (* ; + "(stream) => closes stream, returns it") + (REOPENFILE POINTER) (* ; "(name access recog otherinfo device stream) like openfile, but called after logout to revalidate file, so optionally uses info in old stream to keep this opening like the previous") + (GETFILENAME POINTER) (* ; + "(name recog device) => full file name") + (DELETEFILE POINTER) (* ; + "(name) => deletes file so named, returning name, or NIL on failure. RECOG=OLDEST") + (GENERATEFILES POINTER) (* ; "(device pattern) => generator object for files matching pattern. Car of object is generator function, cdr is arbitrary state. Generator fn returns next file, or NIL when finished") + (RENAMEFILE POINTER) (* ; "(olddevice oldfile newdevice newfile) to rename file on this (olddevice) to a potentially different device.") + (OPENP POINTER) (* ; + "(name access dev) => stream if name is open for access, or all open streams if name = NIL") + (REGISTERFILE POINTER) (* ; + "(stream dev) => registers stream on its device") + (UNREGISTERFILE POINTER) (* ; + "(stream dev) => unregisters a stream from its device") + (FREEPAGECOUNT POINTER) (* ; + "(host/dir dev) => # of free pages on host/dir") + (MAKEDIRECTORY POINTER) (* ; "(host/dir dev)") + (CHECKFILENAME POINTER) (* ; + "(name dev) => name if it is well-formed file name for dev") + (HOSTALIVEP POINTER) (* ; + "(host dev) => true if host is alive, i.e., responsive; only defined if REMOTEP is true") + (BREAKCONNECTION POINTER) (* ; + "(host fastp dev) => closes connections to host") - (* ;; - "-----The following are required methods for operating on open streams-----") + (* ;; "-----The following are required methods for operating on open streams-----") - (BIN POINTER) (* ; "(stream) => next byte of input") - (BOUT POINTER) (* ; - "(stream byte) output byte to stream") - (PEEKBIN POINTER) (* ; - "(stream) => next byte without advancing position in stream") - (NIL POINTER) (* ; - "Was READCHAR, replaced by READCHARCODE") - (NIL POINTER) (* ; - "Was WRITECHAR (stream char) => writes char to stream") - (NIL POINTER) (* ; "Was PEEKCHAR") - (NIL POINTER) (* ; "Was UNREADCHAR") - (READP POINTER) (* ; - "(stream flag) => T if there is input available from stream right now") - (EOFP POINTER) (* ; - "(stream) => T if BIN would signal eof.") - (BLOCKIN POINTER) (* ; - "(stream buffer byteoffset nbytes)") - (BLOCKOUT POINTER) (* ; - "(stream buffer byteoffset nbytes)") - (FORCEOUTPUT POINTER) (* ; - "(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission") - (GETFILEINFO POINTER) (* ; - "(stream/name attribute device) => value of attribute for open stream or name of closed file") - (SETFILEINFO POINTER) (* ; -"(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name") - (CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file.") - (INPUTSTREAM POINTER) (* ; - "(stream) => indirected input stream") - (OUTPUTSTREAM POINTER) (* ; - "(stream) => indirected output stream") + (BIN POINTER) (* ; "(stream) => next byte of input") + (BOUT POINTER) (* ; + "(stream byte) output byte to stream") + (PEEKBIN POINTER) (* ; + "(stream) => next byte without advancing position in stream") + (NIL POINTER) (* ; + "Was READCHAR, replaced by READCHARCODE") + (NIL POINTER) (* ; + "Was WRITECHAR (stream char) => writes char to stream") + (NIL POINTER) (* ; "Was PEEKCHAR") + (NIL POINTER) (* ; "Was UNREADCHAR") + (READP POINTER) (* ; + "(stream flag) => T if there is input available from stream right now") + (EOFP POINTER) (* ; + "(stream) => T if BIN would signal eof.") + (BLOCKIN POINTER) (* ; "(stream buffer byteoffset nbytes)") + (BLOCKOUT POINTER) (* ; "(stream buffer byteoffset nbytes)") + (FORCEOUTPUT POINTER) (* ; + "(stream waitForFinish) flushes out to device anything that is buffered awaiting transmission") + (GETFILEINFO POINTER) (* ; + "(stream/name attribute device) => value of attribute for open stream or name of closed file") + (SETFILEINFO POINTER) (* ; + "(stream/name attribute newvalue device) sets attribute of open stream or closed file of given name") + (CHARSETFN POINTER) (* ; "(stream charset) => access function for the charset slot, for benefit of indirect streams. See IMCHARSET for changing it on a file.") + (INPUTSTREAM POINTER) (* ; + "(stream) => indirected input stream") + (OUTPUTSTREAM POINTER) (* ; + "(stream) => indirected output stream") - (* ;; "-----Following are required of random-access streams-----") + (* ;; "-----Following are required of random-access streams-----") - (GETFILEPTR POINTER) - (GETEOFPTR POINTER) - (SETFILEPTR POINTER) - (BACKFILEPTR POINTER) (* ; "(stream) backs up `fileptr' by one. Stream is only required to be able to do this once, i.e. one-character buffer suffices") - (SETEOFPTR POINTER) (* ; - "(stream length) => truncates or lengthens stream to indicated length") - (LASTC POINTER) (* ; - "Should be possible only if RANDOMACCESSP") + (GETFILEPTR POINTER) + (GETEOFPTR POINTER) + (SETFILEPTR POINTER) + (BACKFILEPTR POINTER) (* ; "(stream) backs up `fileptr' by one. Stream is only required to be able to do this once, i.e. one-character buffer suffices") + (SETEOFPTR POINTER) (* ; + "(stream length) => truncates or lengthens stream to indicated length") + (LASTC POINTER) (* ; + "Should be possible only if RANDOMACCESSP") - (* ;; "-----Following used for buffered streams-----") + (* ;; "-----Following used for buffered streams-----") - (GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg") - (RELEASEBUFFER POINTER) (* ; - "(stream) => Does whatever appropriate when CBUFPTR is released") + (GETNEXTBUFFER POINTER) (* ; "(stream whatfor noerrorflg) => Disposes of current buffer and optionally reads next. whatfor is READ or WRITE. Can cause EOF error unless noerrorflg") + (RELEASEBUFFER POINTER) (* ; + "(stream) => Does whatever appropriate when CBUFPTR is released") - (* ;; "-----Following used for pagemapped streams-----") + (* ;; "-----Following used for pagemapped streams-----") - (READPAGES POINTER) (* ; "(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)") - (WRITEPAGES POINTER) (* ; - "(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream") - (TRUNCATEFILE POINTER) (* ; - "(stream page offset) make stream's eof be at page,offset, discarding anything after it") + (READPAGES POINTER) (* ; "(stream firstpage# buflist) => # of bytes read, starting at firstpage#, reading into buflist, a list of buffers or a single buffer (the usual case)") + (WRITEPAGES POINTER) (* ; + "(stream firstpage# buflist) writes from buflist to stream starting at firstpage# of stream") + (TRUNCATEFILE POINTER) (* ; + "(stream page offset) make stream's eof be at page,offset, discarding anything after it") - (* ;; "-----For window system, argh-----") + (* ;; "-----For window system, argh-----") - (WINDOWOPS POINTER) (* ; "window system operations") - (WINDOWDATA POINTER) (* ; "data for window systems") + (WINDOWOPS POINTER) (* ; "window system operations") + (WINDOWDATA POINTER) (* ; "data for window systems") - (* ;; "-----For any stream (here to not recompile everything)-----") + (* ;; "-----For any stream (here to not recompile everything)-----") - (DEFAULTEXTERNALFORMAT POINTER) (* ; - "Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).") - ) - DIRECTORYNAMEP _ (FUNCTION NILL) - HOSTNAMEP _ (FUNCTION NILL) - READP _ (FUNCTION \GENERIC.READP) - SETFILEPTR _ (FUNCTION \IS.NO.RANDACCESSP) - GETFILEPTR _ (FUNCTION \ILLEGAL.DEVICEOP) - GETEOFPTR _ (FUNCTION \IS.NOT.RANDACCESSP) - EOFP _ (FUNCTION \ILLEGAL.DEVICEOP) - BLOCKIN _ (FUNCTION \GENERIC.BINS) - BLOCKOUT _ (FUNCTION \GENERIC.BOUTS) - RENAMEFILE _ (FUNCTION \GENERIC.RENAMEFILE) - FORCEOUTPUT _ (FUNCTION NILL) - REGISTERFILE _ (FUNCTION NILL) - OPENP _ (FUNCTION NILL) - UNREGISTERFILE _ (FUNCTION NILL) - CHARSETFN _ (FUNCTION \GENERIC.CHARSET) - BREAKCONNECTION _ (FUNCTION NILL)) + (DEFAULTEXTERNALFORMAT POINTER) (* ; + "Was READCHARCODE. Read a character code from the stream (cf BIN for bytes).") + ) + DIRECTORYNAMEP _ (FUNCTION NILL) + HOSTNAMEP _ (FUNCTION NILL) + READP _ (FUNCTION \GENERIC.READP) + SETFILEPTR _ (FUNCTION \IS.NO.RANDACCESSP) + GETFILEPTR _ (FUNCTION \ILLEGAL.DEVICEOP) + GETEOFPTR _ (FUNCTION \IS.NOT.RANDACCESSP) + EOFP _ (FUNCTION \ILLEGAL.DEVICEOP) + BLOCKIN _ (FUNCTION \GENERIC.BINS) + BLOCKOUT _ (FUNCTION \GENERIC.BOUTS) + RENAMEFILE _ (FUNCTION \GENERIC.RENAMEFILE) + FORCEOUTPUT _ (FUNCTION NILL) + REGISTERFILE _ (FUNCTION NILL) + OPENP _ (FUNCTION NILL) + UNREGISTERFILE _ (FUNCTION NILL) + CHARSETFN _ (FUNCTION \GENERIC.CHARSET) + BREAKCONNECTION _ (FUNCTION NILL)) (RECORD FILEGENOBJ (NEXTFILEFN FILEINFOFN . GENFILESTATE)) ) @@ -1101,69 +1090,69 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (ADDTOVAR SYSTEMRECLST (DATATYPE FDEV ((RESETABLE FLAG) - (RANDOMACCESSP FLAG) - (NODIRECTORIES FLAG) - (PAGEMAPPED FLAG) - (FDBINABLE FLAG) - (FDBOUTABLE FLAG) - (FDEXTENDABLE FLAG) - (BUFFERED FLAG) - (DEVICENAME POINTER) - (REMOTEP FLAG) - (SUBDIRECTORIES FLAG) - (INPUT-INDIRECTED FLAG) - (OUTPUT-INDIRECTED FLAG) - (DEVICEINFO POINTER) - (OPENFILELST POINTER) - (HOSTNAMEP POINTER) - (EVENTFN POINTER) - (DIRECTORYNAMEP POINTER) - (OPENFILE POINTER) - (CLOSEFILE POINTER) - (REOPENFILE POINTER) - (GETFILENAME POINTER) - (DELETEFILE POINTER) - (GENERATEFILES POINTER) - (RENAMEFILE POINTER) - (OPENP POINTER) - (REGISTERFILE POINTER) - (UNREGISTERFILE POINTER) - (FREEPAGECOUNT POINTER) - (MAKEDIRECTORY POINTER) - (CHECKFILENAME POINTER) - (HOSTALIVEP POINTER) - (BREAKCONNECTION POINTER) - (BIN POINTER) - (BOUT POINTER) - (PEEKBIN POINTER) - (NIL POINTER) - (NIL POINTER) - (NIL POINTER) - (NIL POINTER) - (READP POINTER) - (EOFP POINTER) - (BLOCKIN POINTER) - (BLOCKOUT POINTER) - (FORCEOUTPUT POINTER) - (GETFILEINFO POINTER) - (SETFILEINFO POINTER) - (CHARSETFN POINTER) - (INPUTSTREAM POINTER) - (OUTPUTSTREAM POINTER) - (GETFILEPTR POINTER) - (GETEOFPTR POINTER) - (SETFILEPTR POINTER) - (BACKFILEPTR POINTER) - (SETEOFPTR POINTER) - (LASTC POINTER) - (GETNEXTBUFFER POINTER) - (RELEASEBUFFER POINTER) - (READPAGES POINTER) - (WRITEPAGES POINTER) - (TRUNCATEFILE POINTER) - (WINDOWOPS POINTER) - (WINDOWDATA POINTER) - (DEFAULTEXTERNALFORMAT POINTER))) + (RANDOMACCESSP FLAG) + (NODIRECTORIES FLAG) + (PAGEMAPPED FLAG) + (FDBINABLE FLAG) + (FDBOUTABLE FLAG) + (FDEXTENDABLE FLAG) + (BUFFERED FLAG) + (DEVICENAME POINTER) + (REMOTEP FLAG) + (SUBDIRECTORIES FLAG) + (INPUT-INDIRECTED FLAG) + (OUTPUT-INDIRECTED FLAG) + (DEVICEINFO POINTER) + (OPENFILELST POINTER) + (HOSTNAMEP POINTER) + (EVENTFN POINTER) + (DIRECTORYNAMEP POINTER) + (OPENFILE POINTER) + (CLOSEFILE POINTER) + (REOPENFILE POINTER) + (GETFILENAME POINTER) + (DELETEFILE POINTER) + (GENERATEFILES POINTER) + (RENAMEFILE POINTER) + (OPENP POINTER) + (REGISTERFILE POINTER) + (UNREGISTERFILE POINTER) + (FREEPAGECOUNT POINTER) + (MAKEDIRECTORY POINTER) + (CHECKFILENAME POINTER) + (HOSTALIVEP POINTER) + (BREAKCONNECTION POINTER) + (BIN POINTER) + (BOUT POINTER) + (PEEKBIN POINTER) + (NIL POINTER) + (NIL POINTER) + (NIL POINTER) + (NIL POINTER) + (READP POINTER) + (EOFP POINTER) + (BLOCKIN POINTER) + (BLOCKOUT POINTER) + (FORCEOUTPUT POINTER) + (GETFILEINFO POINTER) + (SETFILEINFO POINTER) + (CHARSETFN POINTER) + (INPUTSTREAM POINTER) + (OUTPUTSTREAM POINTER) + (GETFILEPTR POINTER) + (GETEOFPTR POINTER) + (SETFILEPTR POINTER) + (BACKFILEPTR POINTER) + (SETEOFPTR POINTER) + (LASTC POINTER) + (GETNEXTBUFFER POINTER) + (RELEASEBUFFER POINTER) + (READPAGES POINTER) + (WRITEPAGES POINTER) + (TRUNCATEFILE POINTER) + (WINDOWOPS POINTER) + (WINDOWDATA POINTER) + (DEFAULTEXTERNALFORMAT POINTER))) ) @@ -1423,40 +1412,47 @@ Copyright (c) 1981-1993, 1999, 2020-2021 by Venue & Xerox Corporation. (GO RETRY]) (\DO.PARAMS.AT.OPEN - [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 29-Jun-2021 17:07 by rmk:") - (* ; "Edited 5-Oct-92 13:45 by jds") + [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 14-Dec-2021 16:10 by rmk") + (* ; "Edited 13-Dec-2021 15:20 by rmk") + (* ; "Edited 29-Jun-2021 17:07 by rmk:") + (* ; "Edited 5-Oct-92 13:45 by jds") - (* ;; "Does generic parameters when a file/stream is open. Called by \OPENFILE and OPENSTREAM") + (* ;; "Does generic parameters when a file/stream is open. Called by \OPENFILE and OPENSTREAM") - (* ;; "RMK July 2020: Make sure that \EXTERNALFORMAT is always called, so that it can implement per-device defaults.") + (* ;; "RMK July 2020: Make sure that \EXTERNALFORMAT is always called, so that it can implement per-device defaults.") - (* ;; - "RMK August 2020: Added hook for user STREAM-AFTER-OPEN-FNS, not global so can be rebound.") + (* ;; + "RMK August 2020: Added hook for user STREAM-AFTER-OPEN-FNS, not global so can be rebound.") (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) - (\EXTERNALFORMAT STREAM VAL)) - (CONVHANKAKU (CONVHANKAKU STREAM VAL)) - ((EOL EOLCONVENTION EOLC) - (replace EOLCONVENTION of STREAM - with (SELECTQ VAL - (CR CR.EOLC) - (LF LF.EOLC) - (CRLF CRLF.EOLC) - (\ILLEGAL.ARG VAL)))) - NIL)) + (\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) + (\EXTERNALFORMAT STREAM VAL)) + (CONVHANKAKU (CONVHANKAKU STREAM VAL)) + ((EOL EOLCONVENTION EOLC) + (replace EOLCONVENTION of STREAM with (SELECTQ VAL + (CR CR.EOLC) + (LF LF.EOLC) + (CRLF CRLF.EOLC) + (ANY (CL:WHEN (\GETSTREAM STREAM + 'OUTPUT T) + (ERROR + "EOL convention ANY not allowed for output streams" + STREAM)) + ANY.EOLC) + (\ILLEGAL.ARG VAL)))) + NIL)) (FOR FN IN STREAM-AFTER-OPEN-FNS DO (APPLY* FN STREAM ACCESS PARAMETERS]) (\RENAMEFILE @@ -1865,21 +1861,18 @@ update the map") (DECLARE%: EVAL@COMPILE (PUTPROPS \INHERITFDEVOP.D MACRO [X (SUBPAIR '(NEWARGS OPNAME . ARGS) - (CONS (SUBST '(fetch DEVICEINFO of FDEV) - 'FDEV - (CDR X)) - X) - '(FUNCTION (LAMBDA ARGS - (FDEVOP 'OPNAME (fetch DEVICEINFO - of FDEV) - . NEWARGS]) + (CONS (SUBST '(fetch DEVICEINFO of FDEV) + 'FDEV + (CDR X)) + X) + '(FUNCTION (LAMBDA ARGS + (FDEVOP 'OPNAME (fetch DEVICEINFO + of FDEV) . NEWARGS]) (PUTPROPS \INHERITFDEVOP.S MACRO [(OPNAME . ARGS) - (FUNCTION (LAMBDA ARGS - (FDEVOP 'OPNAME (fetch DEVICEINFO - of (fetch DEVICE - of STREAM)) - . ARGS]) + (FUNCTION (LAMBDA ARGS + (FDEVOP 'OPNAME (fetch DEVICEINFO + of (fetch DEVICE of STREAM)) . ARGS]) ) (RPAQ? LOGINHOST/DIR '{DSK}) @@ -2633,13 +2626,13 @@ update the map") ) (RPAQQ FILING.TYPES ((BINARY 0) - (DIRECTORY 1) - (TEXT 2) - (SERIALIZED 3) - (INTERPRESS 4361) - (TEDIT 6056) - (FASL 6057) - (LAFITE 6058))) + (DIRECTORY 1) + (TEXT 2) + (SERIALIZED 3) + (INTERPRESS 4361) + (TEDIT 6056) + (FASL 6057) + (LAFITE 6058))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS FILING.TYPES) @@ -2648,24 +2641,24 @@ update the map") (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS \DEVICE-OPEN-STREAMS MACRO [ARGS (LET ((DEVICE (CAR ARGS))) - `(FDEVOP 'OPENP ,DEVICE NIL NIL ,DEVICE]) + `(FDEVOP 'OPENP ,DEVICE NIL NIL ,DEVICE]) (PUTPROPS \CONVERT-PATHNAME DMACRO (OPENLAMBDA (PATHNAME?) - (* ;; - "Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns") + (* ;; + "Coerce pathnames to Interlisp strings, for the benefit of antediluvian Interlisp-D file fns") - (CL:TYPECASE PATHNAME? - (PATHNAME (INTERLISP-NAMESTRING PATHNAME?)) - (T PATHNAME?)))) + (CL:TYPECASE PATHNAME? + (PATHNAME (INTERLISP-NAMESTRING PATHNAME?)) + (T PATHNAME?)))) ) (DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) - `((OPENLAMBDA (STRM) - (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STRM) - STRM - ,NEWVALUE)) - ,STREAM)) + `((OPENLAMBDA (STRM) + (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STRM) + STRM + ,NEWVALUE)) + ,STREAM)) (* "END EXPORTED DEFINITIONS") @@ -2779,51 +2772,51 @@ update the map") (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS \DECFILEPTR MACRO ((STREAM X) - (\INCFILEPTR STREAM (IMINUS X)))) + (\INCFILEPTR STREAM (IMINUS X)))) (PUTPROPS \GETFILEPTR MACRO (OPENLAMBDA (STRM) - (FDEVOP 'GETFILEPTR (fetch DEVICE of STRM) - STRM))) + (FDEVOP 'GETFILEPTR (fetch DEVICE of STRM) + STRM))) (PUTPROPS \SIGNEDWIN MACRO ((STREAM) - (SIGNED (\WIN STREAM) - BITSPERWORD))) + (SIGNED (\WIN STREAM) + BITSPERWORD))) (PUTPROPS \SIGNEDWOUT MACRO ((STREAM N) - (\WOUT STREAM (UNSIGNED N BITSPERWORD)))) + (\WOUT STREAM (UNSIGNED N BITSPERWORD)))) (PUTPROPS \WIN MACRO (OPENLAMBDA (STREAM) - (create WORD - HIBYTE _ (\BIN STREAM) - LOBYTE _ (\BIN STREAM)))) + (create WORD + HIBYTE _ (\BIN STREAM) + LOBYTE _ (\BIN STREAM)))) (PUTPROPS \WOUT MACRO (OPENLAMBDA (STREAM W) - (\BOUT STREAM (fetch HIBYTE of W)) - (\BOUT STREAM (fetch LOBYTE of W)))) + (\BOUT STREAM (fetch HIBYTE of W)) + (\BOUT STREAM (fetch LOBYTE of W)))) (PUTPROPS \BINS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) - (FDEVOP 'BLOCKIN (fetch (STREAM DEVICE) of STRM) - STRM BASE OFF NBYTES))) + (FDEVOP 'BLOCKIN (fetch (STREAM DEVICE) of STRM) + STRM BASE OFF NBYTES))) (PUTPROPS \BOUTS BYTEMACRO (OPENLAMBDA (STRM BASE OFF NBYTES) - (FDEVOP 'BLOCKOUT (fetch (STREAM DEVICE) of STRM) - STRM BASE OFF NBYTES))) + (FDEVOP 'BLOCKOUT (fetch (STREAM DEVICE) of STRM) + STRM BASE OFF NBYTES))) (PUTPROPS \EOFP BYTEMACRO (OPENLAMBDA (STRM) - (FDEVOP 'EOFP (fetch (STREAM DEVICE) of STRM) - STRM))) + (FDEVOP 'EOFP (fetch (STREAM DEVICE) of STRM) + STRM))) (PUTPROPS SIZE.FROM.LENGTH MACRO [LAMBDA (LEN) - (DECLARE (LOCALVARS LEN)) - (AND LEN (FOLDHI LEN BYTESPERPAGE]) + (DECLARE (LOCALVARS LEN)) + (AND LEN (FOLDHI LEN BYTESPERPAGE]) ) (DECLARE%: EVAL@COMPILE (RPAQQ BitsPerByte 8) (RPAQ ByteOffsetSize (SELECTQ (SYSTEMTYPE) - (VAX 10) - 9)) + (VAX 10) + 9)) (RPAQQ WordsPerPage 256) @@ -2843,12 +2836,12 @@ update the map") (DECLARE%: EVAL@COMPILE (ACCESSFNS BYTEPTR ((PAGE (FOLDLO DATUM BYTESPERPAGE)) - (OFFSET (MOD DATUM BYTESPERPAGE))) - (TYPE? (AND (FIXP DATUM) - (IGEQ DATUM 0) - (ILEQ DATUM \MAXFILEPTR))) - (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) - OFFSET))) + (OFFSET (MOD DATUM BYTESPERPAGE))) + (TYPE? (AND (FIXP DATUM) + (IGEQ DATUM 0) + (ILEQ DATUM \MAXFILEPTR))) + (CREATE (IPLUS (UNFOLD PAGE BYTESPERPAGE) + OFFSET))) ) (* "END EXPORTED DEFINITIONS") @@ -3100,40 +3093,40 @@ update the map") (PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (27462 30940 (STREAMPROP 27472 . 27906) (GETSTREAMPROP 27908 . 28377) (PUTSTREAMPROP -28379 . 30788) (STREAMP 30790 . 30938)) (30983 33502 (\DEFPRINT.BY.NAME 30993 . 32145) ( -\STREAM.DEFPRINT 32147 . 33195) (\FDEV.DEFPRINT 33197 . 33500)) (33760 38801 (\GETACCESS 33770 . 34224 -) (\SETACCESS 34226 . 38799)) (59682 65651 (\DEFINEDEVICE 59692 . 62008) (\GETDEVICEFROMNAME 62010 . -62483) (\GETDEVICEFROMHOSTNAME 62485 . 63529) (\REMOVEDEVICE 63531 . 64654) (\REMOVEDEVICE.NAMES 64656 - . 65649)) (65691 90351 (\CLOSEFILE 65701 . 66526) (\DELETEFILE 66528 . 66822) (\DEVICEEVENT 66824 . -68594) (\GENERATEFILES 68596 . 69074) (\GENERATENEXTFILE 69076 . 69727) (\GENERATEFILEINFO 69729 . -70190) (\GETFILENAME 70192 . 70581) (\GENERIC.OUTFILEP 70583 . 71053) (\OPENFILE 71055 . 73633) ( -\DO.PARAMS.AT.OPEN 73635 . 76188) (\RENAMEFILE 76190 . 76614) (\REVALIDATEFILE 76616 . 79218) ( -\PAGED.REVALIDATEFILELST 79220 . 80778) (\PAGED.REVALIDATEFILES 80780 . 82499) (\PAGED.REVALIDATEFILE -82501 . 84784) (\BUFFERED.REVALIDATEFILE 84786 . 87072) (\BUFFERED.REVALIDATEFILELST 87074 . 88258) ( -\PRINT-REVALIDATION-RESULT 88260 . 88675) (\TRUNCATEFILE 88677 . 89068) (\FILE-CONFLICT 89070 . 90349) -) (90387 95050 (\GENERATENOFILES 90397 . 92493) (\NULLFILEGENERATOR 92495 . 92739) (\NOFILESNEXTFILEFN - 92741 . 94732) (\NOFILESINFOFN 94734 . 95048)) (95169 97077 (\FILE.NOT.OPEN 95179 . 95692) ( -\FILE.WONT.OPEN 95694 . 96022) (\ILLEGAL.DEVICEOP 96024 . 96306) (\IS.NOT.RANDACCESSP 96308 . 96754) ( -\STREAM.NOT.OPEN 96756 . 97075)) (97212 99510 (\FDEVINSTANCE 97222 . 99508)) (101060 108434 (CNDIR -101070 . 102375) (DIRECTORYNAME 102377 . 106560) (DIRECTORYNAMEP 106562 . 107178) (HOSTNAMEP 107180 . -107987) (\ADD.CONNECTED.DIR 107989 . 108432)) (108479 135866 (\BACKFILEPTR 108489 . 108677) ( -\BACKPEEKBIN 108679 . 109040) (\BACKBIN 109042 . 109393) (BIN 109395 . 109612) (\BIN 109614 . 109891) -(\BINS 109893 . 110179) (BOUT 110181 . 110543) (\BOUT 110545 . 110860) (\BOUTS 110862 . 111173) ( -COPYBYTES 111175 . 114507) (COPYCHARS 114509 . 118175) (COPYFILE 118177 . 118974) (\COPYOPENFILE -118976 . 122049) (\INFER.FILE.TYPE 122051 . 123005) (EOFP 123007 . 123304) (FORCEOUTPUT 123306 . -123553) (\FLUSH.OPEN.STREAMS 123555 . 123911) (CHARSET 123913 . 125577) (ACCESS-CHARSET 125579 . -125796) (GETEOFPTR 125798 . 126048) (GETFILEINFO 126050 . 129243) (\TYPE.FROM.FILETYPE 129245 . 129715 -) (\FILETYPE.FROM.TYPE 129717 . 129896) (GETFILEPTR 129898 . 130150) (SETFILEINFO 130152 . 133765) ( -SETFILEPTR 133767 . 135486) (BOUT16 135488 . 135673) (BIN16 135675 . 135864)) (135969 141174 ( -\GENERIC.BINS 135979 . 136259) (\GENERIC.BOUTS 136261 . 136526) (\GENERIC.RENAMEFILE 136528 . 138359) -(\GENERIC.OPENP 138361 . 139676) (\GENERIC.READP 139678 . 140719) (\GENERIC.CHARSET 140721 . 141172)) -(141175 141514 (\MAP-OPEN-STREAMS 141185 . 141512)) (143384 145464 (\EOF.ACTION 143394 . 143645) ( -\EOSERROR 143647 . 143840) (\GETEOFPTR 143842 . 144024) (\INCFILEPTR 144026 . 144376) (\PEEKBIN 144378 - . 144569) (\SETCLOSEDFILELENGTH 144571 . 144905) (\SETEOFPTR 144907 . 145095) (\SETFILEPTR 145097 . -145462)) (145465 146007 (\FIXPOUT 145475 . 145775) (\FIXPIN 145777 . 146005)) (146008 146574 (\BOUTEOL - 146018 . 146572)) (149666 159530 (\BUFFERED.BIN 149676 . 150528) (\BUFFERED.PEEKBIN 150530 . 151312) -(\BUFFERED.BOUT 151314 . 152174) (\BUFFERED.BINS 152176 . 155861) (\BUFFERED.BOUTS 155863 . 157664) ( -\BUFFERED.COPYBYTES 157666 . 159528)) (159559 161911 (\NULLDEVICE 159569 . 161587) (\NULL.OPENFILE -161589 . 161909))))) + (FILEMAP (NIL (26864 30342 (STREAMPROP 26874 . 27308) (GETSTREAMPROP 27310 . 27779) (PUTSTREAMPROP +27781 . 30190) (STREAMP 30192 . 30340)) (30385 32904 (\DEFPRINT.BY.NAME 30395 . 31547) ( +\STREAM.DEFPRINT 31549 . 32597) (\FDEV.DEFPRINT 32599 . 32902)) (33162 38203 (\GETACCESS 33172 . 33626 +) (\SETACCESS 33628 . 38201)) (58356 64325 (\DEFINEDEVICE 58366 . 60682) (\GETDEVICEFROMNAME 60684 . +61157) (\GETDEVICEFROMHOSTNAME 61159 . 62203) (\REMOVEDEVICE 62205 . 63328) (\REMOVEDEVICE.NAMES 63330 + . 64323)) (64365 89011 (\CLOSEFILE 64375 . 65200) (\DELETEFILE 65202 . 65496) (\DEVICEEVENT 65498 . +67268) (\GENERATEFILES 67270 . 67748) (\GENERATENEXTFILE 67750 . 68401) (\GENERATEFILEINFO 68403 . +68864) (\GETFILENAME 68866 . 69255) (\GENERIC.OUTFILEP 69257 . 69727) (\OPENFILE 69729 . 72307) ( +\DO.PARAMS.AT.OPEN 72309 . 74848) (\RENAMEFILE 74850 . 75274) (\REVALIDATEFILE 75276 . 77878) ( +\PAGED.REVALIDATEFILELST 77880 . 79438) (\PAGED.REVALIDATEFILES 79440 . 81159) (\PAGED.REVALIDATEFILE +81161 . 83444) (\BUFFERED.REVALIDATEFILE 83446 . 85732) (\BUFFERED.REVALIDATEFILELST 85734 . 86918) ( +\PRINT-REVALIDATION-RESULT 86920 . 87335) (\TRUNCATEFILE 87337 . 87728) (\FILE-CONFLICT 87730 . 89009) +) (89047 93710 (\GENERATENOFILES 89057 . 91153) (\NULLFILEGENERATOR 91155 . 91399) (\NOFILESNEXTFILEFN + 91401 . 93392) (\NOFILESINFOFN 93394 . 93708)) (93829 95737 (\FILE.NOT.OPEN 93839 . 94352) ( +\FILE.WONT.OPEN 94354 . 94682) (\ILLEGAL.DEVICEOP 94684 . 94966) (\IS.NOT.RANDACCESSP 94968 . 95414) ( +\STREAM.NOT.OPEN 95416 . 95735)) (95872 98170 (\FDEVINSTANCE 95882 . 98168)) (99372 106746 (CNDIR +99382 . 100687) (DIRECTORYNAME 100689 . 104872) (DIRECTORYNAMEP 104874 . 105490) (HOSTNAMEP 105492 . +106299) (\ADD.CONNECTED.DIR 106301 . 106744)) (106791 134178 (\BACKFILEPTR 106801 . 106989) ( +\BACKPEEKBIN 106991 . 107352) (\BACKBIN 107354 . 107705) (BIN 107707 . 107924) (\BIN 107926 . 108203) +(\BINS 108205 . 108491) (BOUT 108493 . 108855) (\BOUT 108857 . 109172) (\BOUTS 109174 . 109485) ( +COPYBYTES 109487 . 112819) (COPYCHARS 112821 . 116487) (COPYFILE 116489 . 117286) (\COPYOPENFILE +117288 . 120361) (\INFER.FILE.TYPE 120363 . 121317) (EOFP 121319 . 121616) (FORCEOUTPUT 121618 . +121865) (\FLUSH.OPEN.STREAMS 121867 . 122223) (CHARSET 122225 . 123889) (ACCESS-CHARSET 123891 . +124108) (GETEOFPTR 124110 . 124360) (GETFILEINFO 124362 . 127555) (\TYPE.FROM.FILETYPE 127557 . 128027 +) (\FILETYPE.FROM.TYPE 128029 . 128208) (GETFILEPTR 128210 . 128462) (SETFILEINFO 128464 . 132077) ( +SETFILEPTR 132079 . 133798) (BOUT16 133800 . 133985) (BIN16 133987 . 134176)) (134281 139486 ( +\GENERIC.BINS 134291 . 134571) (\GENERIC.BOUTS 134573 . 134838) (\GENERIC.RENAMEFILE 134840 . 136671) +(\GENERIC.OPENP 136673 . 137988) (\GENERIC.READP 137990 . 139031) (\GENERIC.CHARSET 139033 . 139484)) +(139487 139826 (\MAP-OPEN-STREAMS 139497 . 139824)) (141610 143690 (\EOF.ACTION 141620 . 141871) ( +\EOSERROR 141873 . 142066) (\GETEOFPTR 142068 . 142250) (\INCFILEPTR 142252 . 142602) (\PEEKBIN 142604 + . 142795) (\SETCLOSEDFILELENGTH 142797 . 143131) (\SETEOFPTR 143133 . 143321) (\SETFILEPTR 143323 . +143688)) (143691 144233 (\FIXPOUT 143701 . 144001) (\FIXPIN 144003 . 144231)) (144234 144800 (\BOUTEOL + 144244 . 144798)) (147696 157560 (\BUFFERED.BIN 147706 . 148558) (\BUFFERED.PEEKBIN 148560 . 149342) +(\BUFFERED.BOUT 149344 . 150204) (\BUFFERED.BINS 150206 . 153891) (\BUFFERED.BOUTS 153893 . 155694) ( +\BUFFERED.COPYBYTES 155696 . 157558)) (157589 159941 (\NULLDEVICE 157599 . 159617) (\NULL.OPENFILE +159619 . 159939))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index 053ba1b6f8d42535b6b824cc11590e34d72dc6c2..826ac790df55895c71c0c2dca03f3e3bc72ba04c 100644 GIT binary patch delta 819 zcmaiy&yUhj5XYfJqiEEP7j+XeTUdldn!d;Ho~Y0QwzO<1WR1iG0hJXfLf2o(hSOd= ziS=MKF?;pKx_ajB#puba?!oK+2l`6cghUdXChyJn&3xyR$$bAs{Wzpv=6&9vSdfK` zCh)qD1sX-e*;XTrS&RV1ImB`(Io^s>-DlR0`_c%pI7E^n3rR5!WAf8*chG7W-F~~% zYJ#`*v_BZGb5P5wOo`X{VwvG}MlA^nw0l5{6pIh-ZK_?LssA~t>=nEQJW zi>&e9>cIx}dyR7YEY5$0a-XuQ{%h4Q_g&;WdY_)1(iuD2cYV6qbo95=wB&WPJxBSl z-TUpbsN!Cex^>D%+%de*$YI5DtKVEe(+B1xIhFzYX zwV!r8yV7Yp{(5$0nx{7R|D0&LSKO{Nf1~5cpFekz@_aseaKRPCu@uw_vMfY%yv*=g z4sbLDf~Kh&;79^$IYBS$WQmG^qH)NmN|g*;;-v~8oU-n$Z;T=c)QVoJ=zuW>UbzJr zv5?VZ5l|`#_K{4Gm>et|dnFJEs+=LK7@1v&ub}7!RRI)>+6q}BQnc6(5w1;L&=g)4 zRjtVDfJh(FS`Ac_ggOGWUDhyqk6S&nZS-a+J;Q{0r(--J`*+V6fU#}%w@nzDgI2ve Lqz@hie!ln%enQkd delta 732 zcmZuvzi-n(6!s4UA|N0t0}ND8rVYuE$ajey+f!V}u0tFfId0S;s#GObY8slT4X8*+ zVPHZGfEQR85DQzPs&oDVgv7+ij~OW&0|T7n23p{TyZ65LeeZpzyN_R)4_}z4CYLrU zmae(F>gi?Ru#m0${Ve7&0*sVAuN2U;ZISH+gYY4JWhl#;zev0yNJ;^7usz#2jP^yK6kny%aA}K&WjjYTbnx_e-8#d;wIft-8w{YC%02}n$4 zpug+i3wn3=W{!y9ge6o|u%PgT@Ee_)k78u$fM*zPk@|6prr1)4A}bMXD@nwf?BSUO zZ%lm(Z!O*MUeAitS23x2E@F+TCpX(M{&G^P&XlA57aGGR6hL$AhN;?BwYmlfOVHHUJ>9ic%Lv~r8$(_K&9w|bvIx;32_y$p zl%VdB4^{&t%Ah-zMglYoNI%{7Dvk|Ez!3r{PejMZAPIg?aon2f0peva;!wt*ndCin Q4~k;=Af+9APkny;3s(QXD*ylh