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