home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / clisp / src / archive / clisp.faslsp.lha / gstream.lsp < prev    next >
Lisp/Scheme  |  1996-04-15  |  5KB  |  144 lines
  1. ;;; generic stream default methods
  2. ;;; Marcus Daniels 16.4.1994
  3.  
  4. (in-package "LISP")
  5. (export '(generic-stream-read-char
  6.           generic-stream-listen
  7.           generic-stream-clear-input
  8.           generic-stream-write-char
  9.           generic-stream-write-string
  10.           generic-stream-finish-output
  11.           generic-stream-force-output
  12.           generic-stream-clear-output
  13.           generic-stream-read-byte
  14.           generic-stream-write-byte
  15.           generic-stream-close
  16.           generic-stream-controller
  17. )        )
  18.  
  19. (in-package "SYSTEM")
  20.  
  21. (clos:defclass generic-stream-controller () ())
  22.  
  23. (clos:defgeneric generic-stream-read-char (controller))
  24. (clos:defgeneric generic-stream-listen (controller))
  25. (clos:defgeneric generic-stream-clear-input (controller))
  26. (clos:defgeneric generic-stream-write-char (controller ch))
  27. (clos:defgeneric generic-stream-write-string (controller string start len))
  28. (clos:defgeneric generic-stream-finish-output (controller))
  29. (clos:defgeneric generic-stream-force-output (controller))
  30. (clos:defgeneric generic-stream-clear-output (controller))
  31. (clos:defgeneric generic-stream-read-byte (controller))
  32. (clos:defgeneric generic-stream-write-byte (controller by))
  33. (clos:defgeneric generic-stream-close (controller))
  34.  
  35. (clos:defmethod generic-stream-read-char ((controller generic-stream-controller))
  36.   (declare (ignore controller))
  37. )
  38.  
  39. (clos:defmethod generic-stream-listen ((controller generic-stream-controller))
  40.   (declare (ignore controller))
  41. )
  42.  
  43. (clos:defmethod generic-stream-clear-input ((controller generic-stream-controller))
  44.   (declare (ignore controller))
  45. )
  46.  
  47. (clos:defmethod generic-stream-write-char ((controller generic-stream-controller) ch)
  48.   (declare (ignore controller ch))
  49. )
  50.  
  51. (clos:defmethod generic-stream-write-string ((controller generic-stream-controller) string start len)
  52.   (dotimes (i len)
  53.     (generic-stream-write-char controller (schar string (+ start i)))
  54. ) )
  55.  
  56. (clos:defmethod generic-stream-finish-output ((controller generic-stream-controller))
  57.   (declare (ignore controller))
  58. )
  59.  
  60. (clos:defmethod generic-stream-force-output ((controller generic-stream-controller))
  61.   (declare (ignore controller))
  62. )
  63.  
  64. (clos:defmethod generic-stream-clear-output ((controller generic-stream-controller))
  65.   (declare (ignore controller))
  66. )
  67.  
  68. (clos:defmethod generic-stream-read-byte ((controller generic-stream-controller))
  69.   (declare (ignore controller))
  70. )
  71.  
  72. (clos:defmethod generic-stream-write-byte ((controller generic-stream-controller) by)
  73.   (declare (ignore controller by))
  74. )
  75.  
  76. (clos:defmethod generic-stream-close ((controller generic-stream-controller))
  77.   (declare (ignore controller))
  78. )
  79.  
  80. #| ;; Example:
  81. ;; Alias streams just perform the required operation on another given stream.
  82. (use-package "CLOS")
  83. (defclass alias-controller (generic-stream-controller)
  84.   ((orig-stream :initarg :orig-stream))
  85. )
  86. (defun make-alias-stream (orig-stream)
  87.   (make-generic-stream
  88.     (make-instance 'alias-controller :orig-stream orig-stream)
  89. ) )
  90. (defmethod generic-stream-read-char ((controller alias-controller))
  91.   (with-slots (orig-stream) controller
  92.     (read-char orig-stream nil nil)
  93. ) )
  94. (defmethod generic-stream-listen ((controller alias-controller))
  95.   (with-slots (orig-stream) controller
  96.     (if (listen orig-stream)
  97.       0 ; something available
  98.       (let ((ch (read-char-no-hang orig-stream nil t)))
  99.         (cond ((eql ch t) -1) ; eof
  100.               ((null ch) +1) ; nothing available, not EOF
  101.               (t (unread-char ch orig-stream) 0) ; something available
  102. ) ) ) ) )
  103. (defmethod generic-stream-clear-input ((controller alias-controller))
  104.   (with-slots (orig-stream) controller
  105.     (clear-input orig-stream)
  106.     t
  107. ) )
  108. (defmethod generic-stream-write-char ((controller alias-controller) ch)
  109.   (with-slots (orig-stream) controller
  110.     (write-char ch orig-stream)
  111. ) )
  112. #| ; not needed, see general method above
  113. (defmethod generic-stream-write-string ((controller alias-controller) string start len)
  114.   (with-slots (orig-stream) controller
  115.     (dotimes (i len)
  116.       (write-char (schar string (+ start i)) orig-stream)
  117. ) ) )
  118. |#
  119. (defmethod generic-stream-finish-output ((controller alias-controller))
  120.   (with-slots (orig-stream) controller
  121.     (finish-output orig-stream)
  122. ) )
  123. (defmethod generic-stream-force-output ((controller alias-controller))
  124.   (with-slots (orig-stream) controller
  125.     (force-output orig-stream)
  126. ) )
  127. (defmethod generic-stream-clear-output ((controller alias-controller))
  128.   (with-slots (orig-stream) controller
  129.     (clear-output orig-stream)
  130. ) )
  131. (defmethod generic-stream-read-byte ((controller alias-controller))
  132.   (with-slots (orig-stream) controller
  133.     (read-byte orig-stream nil nil)
  134. ) )
  135. (defmethod generic-stream-write-byte (i (controller alias-controller))
  136.   (with-slots (orig-stream) controller
  137.     (write-byte i orig-stream)
  138. ) )
  139. (defmethod generic-stream-close ((controller alias-controller))
  140.   ; don't close orig-stream
  141. )
  142. |#
  143.  
  144.