/[cmucl]/src/pcl/gray-compat.lisp
ViewVC logotype

Contents of /src/pcl/gray-compat.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Fri Mar 19 15:19:03 2010 UTC (4 years, 1 month ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, release-20b-pre1, release-20b-pre2, sparc-tramp-assem-2010-07-19, GIT-CONVERSION, cross-sol-x86-merged, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-08, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, sparc-tramp-assem-branch, cross-sol-x86-branch
Changes since 1.1: +3 -2 lines
Merge intl-branch 2010-03-18 to HEAD.  To build, you need to use
boot-2010-02-1 as the bootstrap file.  You should probably also use
the new -P option for build.sh to generate and update the po files
while building.
1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written by Paul Foley and has been placed in the public
5 ;;; domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/pcl/gray-compat.lisp,v 1.2 2010/03/19 15:19:03 rtoy Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Gray streams compatibility functions for simple-streams
13
14 (in-package "STREAM")
15 (intl:textdomain "cmucl")
16
17 (defvar *enable-gray-compat-warnings* nil)
18
19 (defmacro define-gray-stream-method (name lambda-list &body body)
20 `(defmethod ,name ,lambda-list
21 (when *enable-gray-compat-warnings*
22 (warn _"Called ~S on a simple-stream" ',name))
23 ,@body))
24
25 (define-gray-stream-method ext:stream-advance-to-column ((stream
26 simple-stream)
27 column)
28 (let ((current (charpos stream)))
29 (when current
30 (dotimes (i (- column current))
31 (write-char #\Space stream)))))
32
33 (define-gray-stream-method ext:stream-line-length ((stream simple-stream))
34 nil)
35
36 (define-gray-stream-method ext:stream-file-position ((stream simple-stream)
37 &optional position)
38 (if position
39 (file-position stream position)
40 (file-position stream)))
41
42 (define-gray-stream-method ext:stream-clear-output ((stream simple-stream))
43 (clear-output stream))
44
45 (define-gray-stream-method ext:stream-write-byte ((stream simple-stream)
46 integer)
47 (write-byte integer stream))
48
49 (define-gray-stream-method ext:stream-finish-output ((stream simple-stream))
50 (finish-output stream))
51
52 (define-gray-stream-method ext:stream-listen ((stream simple-stream))
53 (listen stream))
54
55 (define-gray-stream-method ext:stream-write-string ((stream simple-stream)
56 string
57 &optional (start 0) end)
58 (write-string string stream
59 :start start :end (or end (length string))))
60
61 (define-gray-stream-method ext:stream-write-char ((stream simple-stream)
62 character)
63 (write-char character stream))
64
65 (define-gray-stream-method ext:stream-line-column ((stream simple-stream))
66 (charpos stream))
67
68 (define-gray-stream-method ext:stream-file-length ((stream simple-stream))
69 (file-length stream))
70
71 (define-gray-stream-method ext:stream-unread-char ((stream simple-stream)
72 character)
73 (unread-char character stream))
74
75 (define-gray-stream-method ext:stream-read-sequence ((stream simple-stream)
76 seq
77 &optional (start 0) end)
78 (read-sequence seq stream :start start :end end))
79
80 (define-gray-stream-method ext:stream-read-line ((stream simple-stream))
81 (read-line stream nil :eof))
82
83 (define-gray-stream-method ext:stream-peek-char ((stream simple-stream))
84 (peek-char nil stream nil :eof))
85
86 (define-gray-stream-method ext:stream-read-char-no-hang ((stream
87 simple-stream))
88 (read-char-no-hang stream nil :eof))
89
90 (define-gray-stream-method ext:stream-read-char ((stream simple-stream))
91 (read-char stream nil :eof))
92
93 (define-gray-stream-method ext:stream-clear-input ((stream simple-stream))
94 (clear-input stream))
95
96 (define-gray-stream-method ext:stream-start-line-p ((stream simple-stream))
97 (= (charpos stream) 0))
98
99 (define-gray-stream-method ext:stream-terpri ((stream simple-stream))
100 (write-char #\Newline stream))
101
102 (define-gray-stream-method ext:stream-write-sequence ((stream simple-stream)
103 seq
104 &optional (start 0)
105 end)
106 (write-sequence seq stream :start start :end end))
107
108 (define-gray-stream-method ext:stream-fresh-line ((stream simple-stream))
109 (fresh-line stream))
110
111 (define-gray-stream-method ext:stream-read-byte ((stream simple-stream))
112 (read-byte stream nil :eof))
113
114 (define-gray-stream-method ext:stream-force-output ((stream simple-stream))
115 (force-output stream))
116
117 (provide :gray-compat)

  ViewVC Help
Powered by ViewVC 1.1.5