Rmk94 fix checkeolc macro (#1435)

* EXTERNALFORMAT: \CHECKECOLC macro confusedf ANY vs CR EOL convention

* Recompile callers of \CHECKEOLC macro

* If ANY and no CR after LF, return EOL instead of CR

sources/EXTERNALFORMAT

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "10-Oct-2022 18:10:56" 
-{DSK}<cygdrive>c>Users>Larry>home>MEDLEY>SOURCES>EXTERNALFORMAT.;76
 37395  
+
(FILECREATED " 6-Dec-2023 23:57:52" {WMEDLEY}<sources>EXTERNALFORMAT.;82
 37884  
 
-      :CHANGES-TO (FNS SYSTEM-EXTERNALFORMAT)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "24-Jul-2022 14:56:07" 
-{DSK}<cygdrive>c>Users>Larry>home>MEDLEY>SOURCES>EXTERNALFORMAT.;75)
+      :CHANGES-TO (MACROS \CHECKEOLC)
+                  (FNS \CHECKEOLC.CRLF)
+
+      :PREVIOUS-DATE "23-Oct-2023 17:07:12" {WMEDLEY}<sources>EXTERNALFORMAT.;79)
 
 
 (PRETTYCOMPRINT EXTERNALFORMATCOMS)
@@ -519,9 +520,11 @@
                        FSTRING])
 
 (\CHECKEOLC.CRLF

-  [LAMBDA (STREAM PEEKBINFLG COUNTP)
                    (* ; "Edited  6-Aug-2021 23:30 by rmk:")

+  [LAMBDA (STREAM PEEKBINFLG COUNTP EOLC)
                    (* ; "Edited  6-Dec-2023 23:39 by rmk")


+                                                             (* ; "Edited 17-Oct-2023 11:56 by rmk")


+                                                            (* ; "Edited  6-Aug-2021 23:30 by rmk:")

 
-    (* ;; "This is called only when a CR has been read and EOLC is either any or CRLF. This returns EOL if the next code is an LF")

+    (* ;; "This is called only when a CR has been read and EOLC is either ANY or CRLF. This returns EOL if the next code is an LF")

 
     (* ;; "If COUNTP, that sets *BYTECOUNTER* freely with the number of LF bytes.")

 
@@ -530,8 +533,7 @@
          [SETQ CH (COND
                      [PEEKBINFLG 
 
-                            (* ;; 
-
                          "T from PEEKC.  In this case, must leave the fileptr where it was.")

+                            (* ;; "T from PEEKC.  In this case, must leave the fileptr where it was.")

 
                             (* ;; "The CR itself hasn't been read, just peeked.  So here we have to read it, then peek at the next character to see if it is an LF, and then back out the CR")

 
@@ -545,17 +547,20 @@
                                         (PROG1 (\PEEKCCODE
 STREAM T 'NOEOLC)
 
                                             (* ;; 
-
                          "This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")

+
                            "This has to be a call to \PEEKCODE that doesn't itself to the checkeolc")

 
                                             (* ;; 
-
          "LF must be the next char after the CR.  We back up over the CR that \INCCODE just read.")

+
            "LF must be the next char after the CR.  We back up over the CR that \INCCODE just read.")

 
                                             (\BACKCCODE
 STREAM)))]
 
                                 (* ;; "Got the CRLF, it's an EOL")

 
                                 (CHARCODE EOL))
-                               (T (CHARCODE CR]
+                               (T (SELECTC EOLC
+                                      ((LIST ANY.EOLC 'ANY) 
+                                           (CHARCODE EOL))
+                                      (CHARCODE CR]
                      ((EQ (CHARCODE LF)
                           (\PEEKCCODE
 STREAM T 'NOEOLC))
 
@@ -563,12 +568,15 @@
 
                       (IF
 COUNTP
                           THEN
 (LET (NUMLFBYTES)
-                                        (DECLARE
 (SPECVARS NUMLFBYTES))
-                                        (\INCCODE
 STREAM 'NUMLFBYTES 0)
-                                        (ADD
 *BYTECOUNTER* NUMLFBYTES))
+                                    (DECLARE
 (SPECVARS NUMLFBYTES))
+                                    (\INCCODE
 STREAM 'NUMLFBYTES 0)
+                                    (ADD
 *BYTECOUNTER* NUMLFBYTES))
                         ELSE
 (\INCCODE
 STREAM))
                       (CHARCODE EOL))
-                     (T (CHARCODE CR]
+                     (T (SELECTC EOLC
+                            ((LIST ANY.EOLC 'ANY) 
+                                 (CHARCODE EOL))
+                            (CHARCODE CR]
          CH])
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
@@ -581,10 +589,10 @@
                                                (CHARCODE EOL))
                                           (CHARCODE LF)))
                                   (CR (SELECTC (OR EOLC (FFETCH
 (STREAM EOLCONVENTION) OF
 STRM))
-                                          ((LIST CR.EOLC 'ANY) 
+                                          ((LIST CR.EOLC 'CR) 
                                                (CHARCODE EOL))
                                           ((LIST ANY.EOLC CRLF.EOLC 'CRLF 'ANY) 
-                                               (\CHECKEOLC.CRLF
 STRM PEEKBINFLG COUNTP))
+                                               (\CHECKEOLC.CRLF
 STRM PEEKBINFLG COUNTP EOLC))
                                           (CHARCODE CR)))
                                   CH)))
 )
@@ -712,13 +720,13 @@
 (\CREATE.THROUGH.EXTERNALFORMAT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6559 13194 (\EXTERNALFORMAT 6569 . 10347) (MAKE-EXTERNALFORMAT 10349 . 12721) (
-\EXTERNALFORMAT.DEFPRINT 12723 . 13192)) (13195 16236 (\INSTALL.EXTERNALFORMAT 13205 . 14654) (
-\REMOVE.EXTERNALFORMAT 14656 . 15487) (FIND-FORMAT 15489 . 16234)) (16237 16649 (SYSTEM-EXTERNALFORMAT
- 16247 . 16647)) (16998 31818 (\OUTCHAR 17008 . 18225) (\INCCODE 18227 . 19380) (\BACKCCODE 19382 . 
-20951) (\BACKCCODE.EOLC 20953 . 23143) (\PEEKCCODE 23145 . 23470) (\PEEKCCODE.EOLC 23472 . 23851) (
-\INCCODE.EOLC 23853 . 25652) (\FORMATBYTESTREAM 25654 . 27789) (\FORMATBYTESTRING 27791 . 29250) (
-\CHECKEOLC.CRLF 29252 . 31816)) (33096 35332 (\NULLDEVICE 33106 . 35008) (\NULL.OPENFILE 35010 . 35330
-)) (35472 37299 (\CREATE.THROUGH.EXTERNALFORMAT 35482 . 36268) (\THROUGHIN 36270 . 36690) (
-\THROUGHBACKCCODE 36692 . 36959) (\THROUGHOUTCHARFN 36961 . 37297)))))
+  (FILEMAP (NIL (6547 13182 (\EXTERNALFORMAT 6557 . 10335) (MAKE-EXTERNALFORMAT 10337 . 12709) (
+\EXTERNALFORMAT.DEFPRINT 12711 . 13180)) (13183 16224 (\INSTALL.EXTERNALFORMAT 13193 . 14642) (
+\REMOVE.EXTERNALFORMAT 14644 . 15475) (FIND-FORMAT 15477 . 16222)) (16225 16637 (SYSTEM-EXTERNALFORMAT
+ 16235 . 16635)) (16986 32303 (\OUTCHAR 16996 . 18213) (\INCCODE 18215 . 19368) (\BACKCCODE 19370 . 
+20939) (\BACKCCODE.EOLC 20941 . 23131) (\PEEKCCODE 23133 . 23458) (\PEEKCCODE.EOLC 23460 . 23839) (
+\INCCODE.EOLC 23841 . 25640) (\FORMATBYTESTREAM 25642 . 27777) (\FORMATBYTESTRING 27779 . 29238) (
+\CHECKEOLC.CRLF 29240 . 32301)) (33585 35821 (\NULLDEVICE 33595 . 35497) (\NULL.OPENFILE 35499 . 35819
+)) (35961 37788 (\CREATE.THROUGH.EXTERNALFORMAT 35971 . 36757) (\THROUGHIN 36759 . 37179) (
+\THROUGHBACKCCODE 37181 . 37448) (\THROUGHOUTCHARFN 37450 . 37786)))))
 STOP

sources/WINDOWOBJ

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Nov-2023 14:51:52" {WMEDLEY}<sources>WINDOWOBJ.;17
 30975  
+
(FILECREATED " 5-Dec-2023 21:15:38" {WMEDLEY}<sources>WINDOWOBJ.;23
 32078  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS READIMAGEOBJ)
 
-      :PREVIOUS-DATE "29-Nov-2023 14:14:32" {WMEDLEY}<sources>WINDOWOBJ.;15)
+      :PREVIOUS-DATE " 5-Dec-2023 20:44:27" {WMEDLEY}<sources>WINDOWOBJ.;22)
 
 
 (PRETTYCOMPRINT WINDOWOBJCOMS)
@@ -312,11 +312,11 @@
 (READIMAGEOBJ

   [LAMBDA (STREAM GETFN NOERROR DATANBYTES)
 
+    (* ;; "Edited  5-Dec-2023 21:07 by rmk")

+
     (* ;; "Edited 29-Nov-2023 14:51 by rmk")

 
     (* ;; "Edited 18-Mar-2022 21:45 by rmk: Added WHEREIS as a last resort.")

-                                                             (* rrb "18-Mar-86 11:35")

-    (DECLARE
 (SPECVARS UNDERREADIMAGEOBJ))
 
     (* ;; "Reads an IMAGEOBJ, using GETFN.  Verifies that the GETFN is legitimate")

 
@@ -324,55 +324,73 @@
 
     (* ;; "rmk:  I'm not sure that it makes sense for GETFN to be NIL, as 86 code allowed.  Presumably an image object without a GETFN should never have been written.")

 
-    (LET (SUPPORTFILE HYPHENPOS SFNAME (UNDERREADIMAGEOBJ T))
+    (LET (OBJ GETFNFILE GETFNFILENAME HYPHENPOS MAINFILE FAILEDMSG (UNDERREADIMAGEOBJ T))
          (DECLARE
 (SPECVARS UNDERREADIMAGEOBJ))
 
-         (* ;; "Typically,the file containing the GETFN has already been loaded.  If not, it could be the case that the GETFN and its file were pushed on the list for future reference (now), but the file wasn't loaded then. We need to download it.  Or if not there or not there with a file, and we can find the file  containing the GETFN in the WHEREIS database, load that file.")

+         (* ;; "Typically,the file containing the GETFN has already been loaded.  If not, it could be the case that the GETFN and its file were pushed on the list for future reference (now), but the file wasn't loaded then. We need to download it.  We use the WHEREIS database to identify the file containing the GETFN.  If it has a hyphenated name FOO-FIE and it has a sister file that named with just the prefix of the hyphen FOO, then we assume that the GETFN is in an internal file of a larger application FOO application, and we load FOO instead. Presumably that provides the GETFN.")

 
-         (* ;; "If we find the file with the GETFN but that file doesn't also contain the IMAGEFNS variable, we're screwed.  That's why we apply the GETFN under an NLSETQ.  As Plan B, if the getfn is on a file  ...>abc>abc-xyz, and  >abc>abc exists, then we offer to load the putative rootfile instead.  (It would be nice to have UNPACKDIR and PACKDIR functions that map back and forth between a>b>c and (a b c).")

+         (* ;; "Note:  the Prompt message only shows the NAME of the file, not the full path.")

 
-         (* ;; "Note:  the Prompt message only shows the NAME of the file, not the full path")

+         (* ;; "Clean this up if we decide to nuke the MOUSECONFIRM")

 
          (CL:WHEN (AND GETFN (NOT (GETD GETFN))
-                       [SETQ SUPPORTFILE (OR (LISTGET (CDR (ASSOC GETFN IMAGEOBJGETFNS))
-                                                    'FILE)
-                                             (CAR (WHEREIS GETFN 'FNS T))
-                                             (CAR (WHEREIS GETFN 'FUNCTIONS T]
-                       (SETQ SUPPORTFILE (FINDFILE SUPPORTFILE T))
+                       [SETQ GETFNFILENAME (OR (LISTGET (CDR (ASSOC GETFN IMAGEOBJGETFNS))
+                                                      'FILE)
+                                               (CAR (WHEREIS GETFN 'FNS T))
+                                               (CAR (WHEREIS GETFN 'FUNCTIONS T]
+                       [SETQ GETFNFILE (FINDFILE-WITH-EXTENSIONS GETFNFILENAME NIL
+                                              (APPEND *COMPILED-EXTENSIONS* (CONS NIL]
                        (PROG1 T
-                           (CL:WHEN [SETQ HYPHENPOS (STRPOS "-" (SETQ SFNAME (FILENAMEFIELD.STRING
-                                                                              SUPPORTFILE
-                                                                              'NAME]
-                               (SETQ SFNAME (SUBSTRING SFNAME 1 (SUB1 HYPHENPOS)))
-                               (CL:WHEN (AND [STRING.EQUAL SFNAME (SUBSTRING (FILENAMEFIELD.STRING
-                                                                              (TRUEFILENAME 
-                                                                                     SUPPORTFILE)
-                                                                              'DIRECTORY)
-                                                                         (IMINUS (NCHARS SFNAME]
-                                             (INFILEP (PACKFILENAME 'NAME SFNAME 'BODY SUPPORTFILE)))
-                                      (SETQ SUPPORTFILE SFNAME))))
-                       (MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " GETFN 
-                                            ". Shall I load the support file, " SUPPORTFILE "?")
-                              NIL NIL NIL))
-             (DOFILESLOAD (LIST '(SYSLOAD)
-                                SUPPORTFILE)))
-         (COND
-            [(AND GETFN (GETD GETFN)
-                  (CAR (NLSETQ (APPLY* GETFN STREAM]
-            (NOERROR NIL)
-            (T                                               (* ; 
+
+                           (* ;; "Is FOO a sister of FOO-FIE ?")

+
+                           (CL:WHEN (SETQ HYPHENPOS (STRPOS "-" GETFNFILENAME))
+                               [SETQ MAINFILE (FINDFILE-WITH-EXTENSIONS (PACKFILENAME
+                                                                         'NAME
+                                                                         (SUBSTRING GETFNFILENAME 1
+                                                                                (SUB1 HYPHENPOS))
+                                                                         'VERSION NIL 'EXTENSION NIL
+                                                                         'BODY GETFNFILE)
+                                                     NIL
+                                                     (APPEND *COMPILED-EXTENSIONS* (CONS NIL]))
+                       (if
 T
+                           then
 
+                                (* ;; "This makes for an automatic attempt.  If we fail, well...")

+
+                                (PROMPTPRINT "Getting GETFN " GETFN " by loading " (OR MAINFILE 
+                                                                                       GETFNFILE))
+                                T
+                         else
 (MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " GETFN 
+                                                   ". Shall I load the support file, " MAINFILE "?")
+                                     NIL NIL NIL)))
+
+             (* ;; "Hopefully we found the latest compiled versions")

+
+             (CL:WHEN MAINFILE
+                 (DOFILESLOAD (LIST '(SYSLOAD)
+                                    MAINFILE)))
+             (CL:UNLESS (GETD GETFN)                         (* ; 
+
                                                 "Didn't find the GETFN: try the original GETFNFILE.")

+                 (DOFILESLOAD (LIST '(SYSLOAD)
+                                    GETFNFILE))))
+         (if
 (NULL (GETD GETFN))
+             then
 (SETQ FAILEDMSG "Unknown")
+           elseif
 [SETQ OBJ (CAR (NLSETQ (APPLY* GETFN STREAM]
+           else
 (SETQ FAILEDMSG "Error in"))
+         (CL:UNLESS (OR OBJ NOERROR)                         (* ; 
 
                     "Still no support for this kind of IMAGEOBJ.  Encapsulate it in something safe.")

-               (LET [(OBJ (IMAGEOBJCREATE
 NIL (ENCAPSULATEDIMAGEFNS
 GETFN]
-                    (IMAGEOBJPROP
 OBJ 'FILE (FULLNAME STREAM)
-                           STREAM)                           (* ; 
+             (SETQ OBJ (IMAGEOBJCREATE
 NIL (ENCAPSULATEDIMAGEFNS
 GETFN)))
+             (IMAGEOBJPROP
 OBJ 'FILE (FULLNAME STREAM)
+                    STREAM)                                  (* ; 
 
                             "Remember which file it came from so that it could be written back out.")

-                    (IMAGEOBJPROP
 OBJ 'FILEPTR (GETFILEPTR STREAM))
-                                                             (* ; "And where on the file")

-                    (IMAGEOBJPROP
 OBJ 'OBJSIZE DATANBYTES)
-                    (IMAGEOBJPROP
 OBJ 'UNKNOWNGETFN GETFN)   (* ; "And the name of its GETFN")

-                    (AND DATANBYTES (SETFILEPTR STREAM (PLUS (GETFILEPTR STREAM)
-                                                             DATANBYTES)))
-                    OBJ])
+             (IMAGEOBJPROP
 OBJ 'FILEPTR (GETFILEPTR STREAM)) (* ; "And where on the file")

+             (IMAGEOBJPROP
 OBJ 'OBJSIZE DATANBYTES)
+             (IMAGEOBJPROP
 OBJ 'UNKNOWNGETFN GETFN)          (* ; "And the name of its GETFN")

+             (IMAGEOBJPROP
 OBJ 'FAILEDMSG FAILEDMSG)         (* ; "And why it failed")

+             (CL:WHEN DATANBYTES
+                 (SETFILEPTR STREAM (PLUS (GETFILEPTR STREAM)
+                                          DATANBYTES))))
+         OBJ])
 
 (WRITEIMAGEOBJ

   [LAMBDA (IMAGEOBJ STREAM)
                              (* jds "19-Feb-85 09:36")

@@ -460,12 +478,13 @@ Either delete this image object or load its support files." IMAGEOBJ)
       T])
 
 (ENCAPSULATEDOBJ.DISPLAYFN

-  [LAMBDA (OBJ STREAM)
                                   (* jds "19-Feb-85 10:37")

+  [LAMBDA (OBJ STREAM)
                                       (* ; "Edited  5-Dec-2023 12:12 by rmk")

+                                                             (* jds "19-Feb-85 10:37")

 
     (* ;; "Display function for an IMAGEOBJ that has been encapsulated for safety")

 
     (* ;; 
-
 "Displays as a box containing text saying 'Unknown IMAGEOBJ type' , and naming the unknown GETFN.")

+
   "Displays as a box containing text saying 'Unknown IMAGEOBJ type' , and naming the unknown GETFN.")

 
     (LET* ((CURX (DSPXPOSITION NIL STREAM))
            (CURY (DSPYPOSITION NIL STREAM))
@@ -481,7 +500,9 @@ Either delete this image object or load its support files." IMAGEOBJ)
           (RELMOVETO 3 (IPLUS (FONTPROP FONT 'HEIGHT)
                               3)
                  STREAM)
-          (PRIN1 "Unknown IMAGEOBJ type" STREAM)
+          (PRIN1 (OR (IMAGEOBJPROP
 OBJ 'FAILEDMSG "Unknown"))
+                 STREAM)
+          (PRIN1 " IMAGEOBJ" STREAM)
           (MOVETO (IPLUS CURX 3)
                  (IPLUS CURY 3)
                  STREAM)
@@ -498,7 +519,8 @@ Either delete this image object or load its support files." IMAGEOBJ)
           (DSPFONT OLDFONT STREAM])
 
 (ENCAPSULATEDOBJ.IMAGEBOXFN

-  [LAMBDA (IMAGEOBJ STREAM)
                                  (* ; "Edited 29-Nov-2023 12:49 by rmk")

+  [LAMBDA (IMAGEOBJ STREAM)
                                  (* ; "Edited  5-Dec-2023 11:25 by rmk")


+                                                             (* ; "Edited 29-Nov-2023 12:49 by rmk")

                                                              (* jds "19-Feb-85 10:05")

 
     (* ;; "IMAGEOBXFN for an encapsulated IMAGEOBJ.  If the GETFN now exists, another attempt is made to retrieve the underlying object and to use its boxfn.  ")

@@ -516,7 +538,9 @@ Either delete this image object or load its support files." IMAGEOBJ)
                          IMAGEOBJ STREAM)
            else
 (SETQ FONT (FONTCREATE 'HELVETICA 8 'BOLD NIL STREAM))
                 [SETQ HEIGHT (ITIMES 2 (FONTPROP FONT 'HEIGHT]
-                (SETQ WIDTH (IMAX (STRINGWIDTH "Unknown IMAGEOBJ type" FONT)
+                (SETQ WIDTH (IMAX (STRINGWIDTH (CONCAT (OR (IMAGEOBJPROP
 IMAGEOBJ 'FAILEDMSG)
+                                                           "Unknown" " IMAGEOBJ"))
+                                         FONT)
                                   (STRINGWIDTH (CONCAT "GETFN:  " GETFN)
                                          FONT)))
                 (create
 IMAGEBOX
@@ -564,11 +588,11 @@ Either delete this image object or load its support files." IMAGEOBJ)
 (ADDTOVAR LAMA
 IMAGEOBJPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4766 22601 (COPYINSERT 4776 . 6303) (IMAGEBOX 6305 . 6485) (IMAGEFNSCREATE 6487 . 7682)
+  (FILEMAP (NIL (4766 23254 (COPYINSERT 4776 . 6303) (IMAGEBOX 6305 . 6485) (IMAGEFNSCREATE 6487 . 7682)
  (IMAGEFNSP 7684 . 7925) (IMAGEOBJCREATE 7927 . 8472) (IMAGEOBJP 8474 . 8715) (IMAGEOBJPROP 8717 . 
 14609) (\IMAGEUSERPROP 14611 . 15205) (HPRINT.IMAGEOBJ 15207 . 15796) (COPYIMAGEOBJ 15798 . 16541) (
-READIMAGEOBJ 16543 . 21247) (WRITEIMAGEOBJ 21249 . 22599)) (22815 30697 (
-ENCAPSULATEDOBJ.BUTTONEVENTINFN 22825 . 24608) (ENCAPSULATEDOBJ.PUTFN 24610 . 25725) (
-ENCAPSULATEDOBJ.DISPLAYFN 25727 . 27340) (ENCAPSULATEDOBJ.IMAGEBOXFN 27342 . 29258) (
-ENCAPSULATEDIMAGEFNS 29260 . 30695)))))
+READIMAGEOBJ 16543 . 21900) (WRITEIMAGEOBJ 21902 . 23252)) (23468 31800 (
+ENCAPSULATEDOBJ.BUTTONEVENTINFN 23478 . 25261) (ENCAPSULATEDOBJ.PUTFN 25263 . 26378) (
+ENCAPSULATEDOBJ.DISPLAYFN 26380 . 28183) (ENCAPSULATEDOBJ.IMAGEBOXFN 28185 . 30361) (
+ENCAPSULATEDIMAGEFNS 30363 . 31798)))))
 STOP