[cl-irc-cvs] r189 - trunk

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Sun Apr 22 08:12:25 UTC 2007


Author: ehuelsmann
Date: Sun Apr 22 04:12:22 2007
New Revision: 189

Modified:
   trunk/protocol.lisp
   trunk/utility.lisp
Log:
Move 2 utility routines.

Modified: trunk/protocol.lisp
==============================================================================
--- trunk/protocol.lisp	(original)
+++ trunk/protocol.lisp	Sun Apr 22 04:12:22 2007
@@ -334,46 +334,6 @@
 (defun read-message-loop (connection)
   (loop while (read-message connection)))
 
-(defun try-decode-line (line external-formats)
-  (loop for external-format in external-formats
-        for decoded = nil
-        for error = nil
-        do (multiple-value-setq (decoded error)
-             (handler-case
-              (flexi-streams:with-input-from-sequence (in line)
-                (let* ((ex-fmt (external-format-fixup external-format))
-                       (flexi (flexi-streams:make-flexi-stream
-                               in
-                               ;; :element-type 'character
-                               :external-format ex-fmt)))
-                  (read-line flexi nil nil)))
-              (flexi-streams:flexi-stream-encoding-error ()
-                  nil)))
-        if decoded
-        do (return decoded)))
-
-(defun read-protocol-line (connection)
-  "Reads a line from the input network stream, returning a
-character array with the input read."
-  (multiple-value-bind
-      (buf buf-len)
-      ;; Note: we cannot use read-line here (or any other
-      ;; character based functions), since they may cause
-      ;; (at this time unwanted) character conversion
-      (read-sequence-until (network-stream connection)
-                           (make-array 1024
-                                       :element-type '(unsigned-byte 8)
-                                       :fill-pointer t)
-                           '(10))
-    (when (< 0 buf-len)
-      (setf (fill-pointer buf)
-            ;; remove all trailing CR and LF characters
-            ;; (This allows non-conforming clients to send CRCRLF
-            ;;  as a line separator too).
-            (or (position-if #'(lambda (x) (member x '(10 13)))
-                             buf :from-end t :end buf-len)
-                buf-len))
-      (try-decode-line buf *default-incoming-external-formats*))))
 
 (defmethod read-irc-message ((connection connection))
   "Read and parse an IRC-message from the `connection'."

Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp	(original)
+++ trunk/utility.lisp	Sun Apr 22 04:12:22 2007
@@ -106,6 +106,24 @@
     (setf (getf (cdr new-format) :eol-style) :crlf)
     new-format))
 
+(defun try-decode-line (line external-formats)
+  (loop for external-format in external-formats
+        for decoded = nil
+        for error = nil
+        do (multiple-value-setq (decoded error)
+             (handler-case
+              (flexi-streams:with-input-from-sequence (in line)
+                (let* ((ex-fmt (external-format-fixup external-format))
+                       (flexi (flexi-streams:make-flexi-stream
+                               in
+                               ;; :element-type 'character
+                               :external-format ex-fmt)))
+                  (read-line flexi nil nil)))
+              (flexi-streams:flexi-stream-encoding-error ()
+                  nil)))
+        if decoded
+        do (return decoded)))
+
 (defun read-byte-no-hang (stream &optional eof-error-p eof-value)
   (declare (optimize (speed 3) (debug 0) (safety 0)))
   (when (listen stream)
@@ -140,6 +158,30 @@
                  (= limit-cur limit-max))
           do (return (values target (1+ targ-cur) nil)))))
 
+(defun read-protocol-line (connection)
+  "Reads a line from the input network stream, returning a
+character array with the input read."
+  (multiple-value-bind
+      (buf buf-len)
+      ;; Note: we cannot use read-line here (or any other
+      ;; character based functions), since they may cause
+      ;; (at this time unwanted) character conversion
+      (read-sequence-until (network-stream connection)
+                           (make-array 1024
+                                       :element-type '(unsigned-byte 8)
+                                       :fill-pointer t)
+                           '(10))
+    (when (< 0 buf-len)
+      (setf (fill-pointer buf)
+            ;; remove all trailing CR and LF characters
+            ;; (This allows non-conforming clients to send CRCRLF
+            ;;  as a line separator too).
+            (or (position-if #'(lambda (x) (member x '(10 13)))
+                             buf :from-end t :end buf-len)
+                buf-len))
+      (try-decode-line buf *default-incoming-external-formats*))))
+
+
 (defun substring (string start &optional end)
   (let* ((end-index (if end end (length string)))
          (seq-len (- end-index start)))



More information about the cl-irc-cvs mailing list