[closure-cvs] CVS closure/src/glisp
dlichteblau
dlichteblau at common-lisp.net
Sun Oct 7 21:44:37 UTC 2007
Update of /project/closure/cvsroot/closure/src/glisp
In directory clnet:/tmp/cvs-serv19989/src/glisp
Modified Files:
package.lisp util.lisp
Log Message:
Move the HTML parser and its dependencies into a separate system.
* INSTALL: Mention the dependency on Closure HTML.
* closure.asd (RUNES): Depend on closure-html. (CLOSURE): Removed
clex, lalr, net/mime, parse. Added renderer/pt.
* resources/resources.lisp: Removed DTD parsing.
* src/glisp/package.lisp: Import gstream symbols from html-glisp
for re-export.
* src/glisp/util.lisp (GSTREAM, USE-CHAR-FOR-BYTE-STREAM-FLAVOUR,
G/READ-BYTE, G/UNREAD-BYTE, G/WRITE-BYTE,
USE-BYTE-FOR-CHAR-STREAM-FLAVOUR, G/READ-CHAR, G/UNREAD-CHAR,
G/WRITE-CHAR, CL-STREAM, G/FINISH-OUTPUT, G/CLOSE, CL-BYTE-STREAM,
G/READ-BYTE-SEQUENCE, G/WRITE-BYTE-SEQUENCE, CL-CHAR-STREAM,
G/WRITE-STRING, G/READ-LINE, G/READ-LINE*, VECTOR-OUTPUT-STREAM,
G/MAKE-VECTOR-OUTPUT-STREAM, CL-BYTE-STREAM->GSTREAM,
CL-CHAR-STREAM->GSTREAM): Removed from this file, because this
code now lives in HTML-GLISP.
* src/gui/gui.lisp s/cl-user::*html-dtd*/closure-html:*html-dtd*.
(*html-dtd*): Removed defvar.
* src/net/package.lisp: Use closure-mime-types.
* src/parse/package.lisp: Removed.
* src/parse/pt.lisp: Removed.
* src/parse/sgml-dtd.lisp: Removed.
* src/parse/sgml-parse.lisp: Removed.
* resources/dtd/DTD-HTML-4.0: Removed.
* resources/dtd/DTD-HTML-4.0-Frameset: Removed.
* resources/dtd/DTD-HTML-4.0-Transitional: Removed.
* resources/dtd/Entities-Latin1: Removed.
* resources/dtd/Entities-Special: Removed.
* resources/dtd/Entities-Symbols: Removed.
* resources/dtd/HTML-3.0: Removed.
* resources/dtd/NETSCAPE-Bookmark-file-1: Removed.
* resources/dtd/catalog: Removed.
--- /project/closure/cvsroot/closure/src/glisp/package.lisp 2007/01/02 13:12:58 1.11
+++ /project/closure/cvsroot/closure/src/glisp/package.lisp 2007/10/07 21:44:37 1.12
@@ -30,6 +30,28 @@
(defpackage "GLISP"
(:use :cl)
+ (:import-from :html-glisp
+ "CL-STREAM"
+ "G/CLOSE"
+ "G/FINISH-OUTPUT"
+ "G/PEEK-CHAR"
+ "G/READ-BYTE"
+ "G/READ-BYTE-SEQUENCE"
+ "G/READ-CHAR"
+ "G/READ-CHAR-SEQUENCE"
+ "G/READ-LINE"
+ "G/READ-LINE*"
+ "G/UNREAD-BYTE"
+ "G/UNREAD-CHAR"
+ "G/WRITE-BYTE"
+ "G/WRITE-BYTE-SEQUENCE"
+ "G/WRITE-CHAR"
+ "G/WRITE-STRING"
+ "GSTREAM"
+ "CL-BYTE-STREAM->GSTREAM"
+ "CL-CHAR-STREAM->GSTREAM"
+ "USE-BYTE-FOR-CHAR-STREAM-FLAVOUR"
+ "USE-CHAR-FOR-BYTE-STREAM-FLAVOUR")
(:export "DEFSUBST"
"G/MAKE-STRING"
"WITH-TIMEOUT"
--- /project/closure/cvsroot/closure/src/glisp/util.lisp 2007/01/07 19:35:08 1.10
+++ /project/closure/cvsroot/closure/src/glisp/util.lisp 2007/10/07 21:44:37 1.11
@@ -321,285 +321,6 @@
;; (predict f nil)
;;
-;;;; -----------------------------------------------------------------------------------------
-;;;; Homebrew stream classes
-;;;;
-
-;; I am really tired of standard Common Lisp streams and thier incompatible implementations.
-
-;; A gstream is an objects with obeys to the following protocol:
-
-;; g/read-byte stream &optional (eof-error-p t) eof-value
-;; g/unread-byte byte stream
-;; g/read-char stream &optional (eof-error-p t) eof-value
-;; g/unread-char char stream
-;; g/write-char char stream
-;; g/write-byte byte stream
-;; g/finish-output stream
-;; g/close stream &key abort
-
-;; Additionally the follwing generic functions are implemented based
-;; on the above protocol and may be reimplemented for any custom
-;; stream class for performance.
-
-;; g/write-string string stream &key start end
-;; g/read-line stream &optional (eof-error-p t) eof-value
-;; g/read-line* stream &optional (eof-error-p t) eof-value
-;; g/read-byte-sequence sequence stream &key start end
-;; g/read-char-sequence sequence stream &key start end
-;; g/write-byte-sequence sequence stream &key start end
-;; g/write-char-sequence sequence stream &key start end
-
-
-;; The following classes exists
-
-;; gstream
-;; use-char-for-byte-stream-flavour
-;; use-byte-for-char-stream-flavour
-;; cl-stream
-;; cl-byte-stream
-;; cl-char-stream
-
-(defclass gstream () ())
-
-;;; use-char-for-byte-stream-flavour
-
-(defclass use-char-for-byte-stream-flavour () ())
-
-(defmethod g/read-byte ((self use-char-for-byte-stream-flavour) &optional (eof-error-p t) eof-value)
- (let ((r (g/read-char self eof-error-p :eof)))
- (if (eq r :eof)
- eof-value
- (char-code r))))
-
-(defmethod g/unread-byte (byte (self use-char-for-byte-stream-flavour))
- (g/unread-char (or (and #+CMU (<= byte char-code-limit) (code-char byte))
- (error "Cannot stuff ~D. into a character." byte))
- self))
-
-(defmethod g/write-byte (byte (self use-char-for-byte-stream-flavour))
- (g/write-char (or (and #+CMU (<= byte char-code-limit) (code-char byte))
- (error "Cannot stuff ~D. into a character." byte))
- self))
-
-;;; use-byte-for-char-stream-flavour
-
-(defclass use-byte-for-char-stream-flavour () ())
-
-(defmethod g/read-char ((self use-byte-for-char-stream-flavour) &optional (eof-error-p t) eof-value)
- (let ((byte (g/read-byte self eof-error-p :eof)))
- (if (eq byte :eof)
- eof-value
- (let ((res (and #+CMU (<= byte char-code-limit) (code-char byte))))
- (or res
- (error "The byte ~D. could not been represented as character in your LISP implementation." byte))))))
-
-(defmethod g/unread-char (char (self use-byte-for-char-stream-flavour))
- (g/unread-byte (char-code char) self))
-
-(defmethod g/write-char (char (self use-byte-for-char-stream-flavour))
- (g/write-byte (char-code char) self))
-
-;;; ------------------------------------------------------------
-;;; Streams made up out of Common Lisp streams
-
-;;; cl-stream
-
-(defclass cl-stream (gstream)
- ((cl-stream :initarg :cl-stream)))
-
-(defmethod g/finish-output ((self cl-stream))
- (with-slots (cl-stream) self
- (finish-output cl-stream)))
-
-(defmethod g/close ((self cl-stream) &key abort)
- (with-slots (cl-stream) self
- (close cl-stream :abort abort)))
-
-;;; cl-byte-stream
-
-(defclass cl-byte-stream (use-byte-for-char-stream-flavour cl-stream)
- ((lookahead :initform nil)))
-
-(defmethod g/read-byte ((self cl-byte-stream) &optional (eof-error-p t) eof-value)
- (with-slots (cl-stream lookahead) self
- (if lookahead
- (prog1 lookahead
- (setf lookahead nil))
- (read-byte cl-stream eof-error-p eof-value))))
-
-(defmethod g/unread-byte (byte (self cl-byte-stream))
- (with-slots (cl-stream lookahead) self
- (if lookahead
- (error "You cannot unread twice.")
- (setf lookahead byte))))
-
-(defmethod g/write-byte (byte (self cl-byte-stream))
- (with-slots (cl-stream) self
- (write-byte byte cl-stream)))
-
-(defmethod g/read-byte-sequence (sequence (input cl-byte-stream) &key (start 0) (end (length sequence)))
- (with-slots (cl-stream) input
- (read-byte-sequence sequence cl-stream :start start :end end)))
-
-(defmethod g/write-byte-sequence (sequence (sink cl-byte-stream) &key (start 0) (end (length sequence)))
- (with-slots (cl-stream) sink
- (cl:write-sequence sequence cl-stream :start start :end end)))
-
-;;; cl-char-stream
-
-(defclass cl-char-stream (use-char-for-byte-stream-flavour cl-stream)
- ())
-
-(defmethod g/read-char ((self cl-char-stream) &optional (eof-error-p t) eof-value)
- (with-slots (cl-stream) self
- (read-char cl-stream eof-error-p eof-value)))
-
-(defmethod g/unread-char (char (self cl-char-stream))
- (with-slots (cl-stream) self
- (unread-char char cl-stream)))
-
-(defmethod g/write-char (char (self cl-char-stream))
- (with-slots (cl-stream) self
- (write-char char cl-stream)))
-
-;;; ------------------------------------------------------------
-;;; General or fall back stream methods
-
-(defmethod g/write-string (string (stream t) &key (start 0) (end (length string)))
- (do ((i start (+ i 1)))
- ((>= i end))
- (g/write-char (char string i) stream)))
-
-(defmethod g/read-line ((stream t) &optional (eof-error-p t) eof-value)
- (let ((res nil))
- (do ((c (g/read-char stream eof-error-p :eof)
- (g/read-char stream nil :eof)))
- ((or (eq c :eof) (char= c #\newline))
- (cond ((eq c :eof)
- (values (if (null res) eof-value (coerce (nreverse res) 'string))
- t))
- (t
- (values (coerce (nreverse res) 'string)
- nil))))
- (push c res))))
-
-(defmethod g/read-line* ((stream t) &optional (eof-error-p t) eof-value)
- ;; Like read-line, but accepts CRNL, NL, CR as line termination
- (let ((res nil))
- (do ((c (g/read-char stream eof-error-p :eof)
- (g/read-char stream nil :eof)))
- ((or (eq c :eof) (char= c #\newline) (char= c #\return))
- (cond ((eq c :eof)
- (values (if (null res) eof-value (coerce (nreverse res) 'string))
- t))
- (t
- (when (char= c #\return)
- (let ((d (g/read-char stream nil :eof)))
- (unless (or (eq d :eof) (char= d #\newline))
- (g/unread-char d stream))))
- (values (coerce (nreverse res) 'string)
- nil))))
- (push c res))))
-
-(defmethod g/read-byte-sequence (sequence (input t) &key (start 0) (end (length sequence)))
- (let ((i start) c)
- (loop
- (when (>= i end)
- (return i))
- (setf c (g/read-byte input nil :eof))
- (when (eq c :eof)
- (return i))
- (setf (elt sequence i) c)
- (incf i))))
-
-(defmethod g/read-char-sequence (sequence (input t) &key (start 0) (end (length sequence)))
- (let ((i start) c)
- (loop
- (when (>= i end)
- (return i))
- (setf c (g/read-char input nil :eof))
- (when (eq c :eof)
- (return i))
- (setf (elt sequence i) c)
- (incf i))))
-
-(defmethod g/write-byte-sequence (sequence (sink t) &key (start 0) (end (length sequence)))
- (do ((i start (+ i 1)))
- ((>= i end) i)
- (g/write-byte (aref sequence i) sink)))
-
-;;; ----------------------------------------------------------------------------------------------------
-;;; Vector streams
-;;;
-
-;; Output
-
-(defclass vector-output-stream (use-byte-for-char-stream-flavour)
- ((buffer :initarg :buffer)))
-
-(defun g/make-vector-output-stream (&key (initial-size 100))
- (make-instance 'vector-output-stream
- :buffer (make-array initial-size :element-type '(unsigned-byte 8)
- :fill-pointer 0
- :adjustable t)))
-
-(defmethod g/close ((self vector-output-stream) &key abort)
- (declare (ignorable self abort))
- nil)
-
-(defmethod g/finish-output ((self vector-output-stream))
- nil)
-
-(defmethod g/write-byte (byte (self vector-output-stream))
- (with-slots (buffer) self
- (vector-push-extend byte buffer 100)))
-
-(defmethod g/write-byte-sequence (sequence (self vector-output-stream) &key (start 0) (end (length sequence)))
- (with-slots (buffer) self
- (adjust-array buffer (+ (length buffer) (- end start)))
- (replace buffer sequence :start1 (length buffer) :start2 start :end2 end)
- (setf (fill-pointer buffer) (+ (length buffer) (- end start)))
- end))
-
-;;; ----------------------------------------------------------------------------------------------------
-;;; Echo streams
-
-#||
-(defclass echo-stream (use-byte-for-char-stream-flavour)
- ((echoed-to :initarg :echoed-to)))
-
-(defun g/make-echo-stream (echoed-to)
- (make-instance 'echo-stream :echoed-to echoed-to))
-||#
-
-#||
-
-Hmm unter PCL geht das nicht ;-(
-
-(defmethod g/read-byte ((stream stream) &optional (eof-error-p t) eof-value)
- (read-byte stream eof-error-p eof-value))
-
-(defmethod g/read-char ((stream stream) &optional (eof-error-p t) eof-value)
- (read-char stream eof-error-p eof-value))
-
-(defmethod g/unread-char (char (stream stream))
- (unread-char char stream))
-
-(defmethod g/write-char (char (stream stream))
- (write-char char stream))
-
-(defmethod g/write-byte (byte (stream stream))
- (write-byte byte stream))
-
-(defmethod g/finish-output ((stream stream))
- (finish-output stream))
-
-(defmethod g/close ((stream stream) &key abort)
- (close stream :abort abort))
-
-||#
-
;;;; ----------------------------------------------------------------------------------------------------
#||
@@ -640,37 +361,6 @@
(setf (row-major-aref res i) (funcall fun (row-major-aref array i))))
res))
-;;----------------------------------------------------------------------------------------------------
-
-(defun g/peek-char (&optional (peek-type nil) (source *standard-input*)
- (eof-error-p T) eof-value)
- (cond ((eq peek-type T)
- (do ((ch (g/read-char source eof-error-p '%the-eof-object%)
- (g/read-char source eof-error-p '%the-eof-object%)))
- ((or (eq ch '%the-eof-object%)
- (not (white-space-p ch)))
- (cond ((eq ch '%the-eof-object%) eof-value)
- (t (g/unread-char ch source) ch)) )))
- ((eq peek-type NIL)
- (let ((ch (g/read-char source eof-error-p '%the-eof-object%)))
- (cond ((eq ch '%the-eof-object%) eof-value)
- (t (g/unread-char ch source)
- ch))))
- ((characterp peek-type)
- (do ((ch (g/read-char source eof-error-p '%the-eof-object%)
- (g/read-char source eof-error-p '%the-eof-object%)))
- ((or (eq ch '%the-eof-object%) (eql ch peek-type))
- (cond ((eq ch '%the-eof-object%) eof-value)
- (t (g/unread-char ch source) ch)) )) ) ))
-
-
-
-(defun cl-byte-stream->gstream (stream)
- (make-instance 'cl-byte-stream :cl-stream stream))
-
-(defun cl-char-stream->gstream (stream)
- (make-instance 'cl-char-stream :cl-stream stream))
-
;;; ----------------------------------------------------------------------------------------------------
(defvar *all-temporary-files* nil
More information about the Closure-cvs
mailing list