;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.59
;;; Reason:
;;;  string-input-streams are now more useful.  They now accept all these operations:
;;;  	     :close
;;;  	     :tyi :any-tyi
;;;  	     :tyipeek
;;;  	     :untyi
;;;  	     :pointer :get-string-index
;;;  	     :set-pointer
;;;  	     :which-operations
;;; Written 20-Oct-87 12:18:19 by naha at site LMI Cambridge
;;; while running on Love from band 2
;;; with Experimental System 123.49, Experimental Local-File 73.0, Experimental FILE-Server 22.0, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.13, SDU ROM 102.



; From file DJ: L.IO; QIO.LISP#229 at 20-Oct-87 12:18:20
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; QIO  "

(defun make-string-input-stream (string &optional (start 0) end)
  "Return a stream from which one can read the characters of STRING, or some substring of it.
START and END are indices specifying a substring of STRING;
they default to 0 and NIL (NIL for END means the end of STRING)."
  (let ((pointer start)
	(end (or end (string-length string))))
    (lambda (operation &rest args)
      (labels ((next-char ()
		 (if (empty-p)
		     nil
		   (prog1 (aref string pointer)
			  (incf pointer))))
	       (empty-p ()
		 (>= pointer end))
	       (operation-SET-POINTER (new-pointer)
		 (setq pointer new-pointer))
	       (operation-LINE-IN (&optional leader)
		 (do ((start-pointer pointer)
			end-pointer c)
		     (end-pointer
		       (cond ((eq leader t)
			      (substring string start-pointer end-pointer))
			     ((null leader)
			      (make-array (- end-pointer start-pointer)
					     :displaced-to string
					     :displaced-index-offset start-pointer
					     :type art-string))
			     ((numberp leader)
			      (let ((v (make-array (- end-pointer start-pointer)
						      :type art-string
						      :leader-length leader)))
				(copy-array-portion string start-pointer end-pointer v 0 end-pointer)
				v)) ))
		   (setq c (next-char))
		   (cond ((null c)
			  (setq end-pointer pointer))
			 ((char-equal #\return (character c))
			  (setq end-pointer (1- pointer))))
		   )) )
	(case operation
	  ((:close))
	  ((:tyi :any-tyi)
	   (next-char))
	  ((:tyipeek)
	   (aref string pointer))
	  ((:untyi)
	   (decf pointer))
	  ((:pointer :get-string-index)
	   pointer)
	  ((:set-pointer)
	   (apply #'operation-set-pointer args))
	  ((:line-in)
	   (apply #'operation-line-in args))
	  ((:which-operations)
	   '(:close
	     :tyi :any-tyi
	     :tyipeek
	     :untyi
	     :pointer :get-string-index
	     :set-pointer
	     :which-operations)))))))

))