(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

(FILECREATED "16-May-90 13:33:00" |{DSK}<usr>local>lde>lispcore>sources>CMLMISCIO.;2|
 4328   

      |changes| |to:|  (VARS CMLMISCIOCOMS)

      |previous| |date:| " 3-Feb-88 10:31:05" |{DSK}<usr>local>lde>lispcore>sources>CMLMISCIO.;1|)


; Copyright (c) 1986, 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT CMLMISCIOCOMS)

(RPAQQ CMLMISCIOCOMS
 (
                          (* |;;| "Random leftover IO functions")


                          
                          (* |;;| 

                "[JDS 2/3/88: Removed FRESH-LINE from here, since it's also in CMLPRINT. AR #9601]")


                          (FUNCTIONS CL:WRITE-STRING WRITE-STRING* CL:Y-OR-N-P CL:YES-OR-NO-P)
                          
                          (* |;;| "Arrange to use the proper compiler")


                          (PROP FILETYPE CMLMISCIO)))



(* |;;| "Random leftover IO functions")





(* |;;| "[JDS 2/3/88: Removed FRESH-LINE from here, since it's also in CMLPRINT. AR #9601]")



(CL:DEFUN CL:WRITE-STRING
 (STRING &OPTIONAL (STREAM *STANDARD-OUTPUT*)
                                     &KEY
                                     (CL::START 0)
                                     CL::END)
   (WRITE-STRING* STRING STREAM CL::START CL::END)
   STRING)

(CL:DEFUN WRITE-STRING*
 (STRING &OPTIONAL (STREAM *STANDARD-OUTPUT*)
                                   (START 0)
                                   END &AUX (STRING-LENGTH (CL:LENGTH STRING)))
   (CL:CHECK-TYPE STRING STRING)
   (CL:WHEN (NULL END)
          (SETQ END STRING-LENGTH))
   (CL:ASSERT (AND (<= 0 START STRING-LENGTH)
                   (<= START END STRING-LENGTH))
          '(START END)
          "Start (~D) or end (~D) argument out of bounds." START END)

   (* |;;| "The following comes mainly from \\PRINSTRING...")


   (LET ((CHARS-TO-PRINT (- END START))
         (STRM (\\GETSTREAM STREAM 'OUTPUT))
         \\THISFILELINELENGTH)
        (DECLARE
 (SPECVARS \\THISFILELINELENGTH))
        (CL:WHEN (CL:PLUSP CHARS-TO-PRINT)
            (.SPACECHECK. STREAM CHARS-TO-PRINT)

            (* |;;| "Essentially (for x instring string do (\\outchar strm x)).")


            (CL:DO ((FATP (|ffetch|
 (STRINGP FATSTRINGP) |of|
 STRING))
                    (BASE (|ffetch|
 (STRINGP BASE) |of|
 STRING))
                    (OFFSET (IPLUS START (|ffetch|
 (STRINGP OFFST) |of|
 STRING))
                           (ADD1 OFFSET))
                    (END (IPLUS END (|ffetch|
 (STRINGP OFFST) |of|
 STRING))))
                   ((>= OFFSET END))
                (\\OUTCHAR STRM (CL:IF FATP
                                    (\\GETBASEFAT BASE OFFSET)
                                    (\\GETBASETHIN BASE OFFSET))))))
   STRING)

(CL:DEFUN CL:Y-OR-N-P
 (&OPTIONAL FORMAT-STRING &REST ARGUMENTS)
   (COND
      (FORMAT-STRING (CL:FRESH-LINE)
             (CL:APPLY (FUNCTION CL:FORMAT)
                    *QUERY-IO* FORMAT-STRING ARGUMENTS)))
   (CL:FLET ((CL::READ-CHAR-NOW NIL (RESETFORM (CONTROL T)
                                           (CL:READ-CHAR *QUERY-IO*))))
          (CL:DO ((CL::RESPONSE (CL::READ-CHAR-NOW)
                         (CL::READ-CHAR-NOW)))
                 ((OR (CL:CHAR-EQUAL CL::RESPONSE #\Y)
                      (CL:CHAR-EQUAL CL::RESPONSE #\N))
                  (CL:FRESH-LINE)
                  (CL:CHAR-EQUAL CL::RESPONSE #\Y))
              (CL:FORMAT *QUERY-IO* "~&Please type either Y or N: "))))

(CL:DEFUN CL:YES-OR-NO-P
 (&OPTIONAL CL::FORMAT-STRING &REST CL::ARGUMENTS)
   (CL:WHEN CL::FORMAT-STRING
       (CL:FRESH-LINE *QUERY-IO*)
       (CL:APPLY #'CL:FORMAT *QUERY-IO* CL::FORMAT-STRING CL::ARGUMENTS))
   (CL:DO ((CL::RESPONSE (CL:READ-LINE *QUERY-IO*)
                  (CL:READ-LINE *QUERY-IO*)))
          ((OR (STRING-EQUAL CL::RESPONSE "YES")
               (STRING-EQUAL CL::RESPONSE "NO"))
           (STRING-EQUAL CL::RESPONSE "YES"))
       (CL:FORMAT *QUERY-IO* "Please type either YES or NO: ")))



(* |;;| "Arrange to use the proper compiler")



(PUTPROPS CMLMISCIO
 FILETYPE
 CL:COMPILE-FILE)
(PUTPROPS CMLMISCIO COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP