Author: ehuelsmann Date: Fri Feb 3 16:10:43 2006 New Revision: 30
Modified: usocket/trunk/backend/clisp.lisp usocket/trunk/condition.lisp Log: Implement condition handling for clisp.
Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Fri Feb 3 16:10:43 2006 @@ -25,21 +25,25 @@ (system::simple-os-error (destructuring-bind (&optional usock-err errorp) - (cdr (assoc (car (system::$format-arguments)) - +clisp-error-map+)) + (cdr (assoc (car (simple-condition-format-arguments condition)) + +clisp-error-map+ :test #'member)) (if usock-err (if errorp (error usock-err :socket socket) (signal usock-err :socket socket)) - (error 'usocket-unkown-error + (error 'usocket-unknown-error :socket socket :real-error condition))))))
(defun socket-connect (host port &optional (type :stream)) (declare (ignore type)) - (let ((socket (socket:socket-connect port (host-to-hostname host) - :element-type 'character - :buffered t))) + (let ((socket) + (hostname (host-to-hostname host))) + (with-mapped-conditions (socket) + (setf socket + (socket:socket-connect port hostname + :element-type 'character + :buffered t))) (make-socket :socket socket :stream socket))) ;; the socket is a stream too ;; :host host @@ -47,19 +51,6 @@
(defmethod socket-close ((usocket usocket)) "Close socket." - (close (socket usocket))) - - - -(defun get-host-by-address (address) - (handler-case - (posix:hostent-name - (posix:resolve-host-ipaddr (vector-quad-to-dotted-quad address))) - (condition (condition) (handle-condition condition)))) - -(defun get-hosts-by-name (name) - (handler-case - (mapcar #'dotted-quad-to-vector-quad - (posix:hostent-addr-list (posix:resolve-host-ipaddr name))) - (condition (condition) (handle-condition condition)))) + (with-mapped-conditions (usocket) + (close (socket usocket))))
Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Fri Feb 3 16:10:43 2006 @@ -17,7 +17,9 @@ ;; (real-condition c) (socket c)))))
(define-condition usocket-condition (condition) - () ;;###FIXME: no slots (yet); should at least be the affected usocket... + ((socket :initarg :socket + :accessor :usocket-socket)) + ;;###FIXME: no slots (yet); should at least be the affected usocket... (:documentation ""))
(define-condition usocket-error (usocket-condition error) @@ -72,7 +74,12 @@
(define-condition usocket-unknown-error (usocket-error) ((real-error :initarg :real-error - :accessor usocket-real-error)) + :accessor usocket-real-error) + ;; clisp error wrt its condition system... + ;;it doesn't seem to inherit slots + #+clisp + (socket :initarg :socket + :accessor :usocket-socket)) (:documentation ""))