Re: [STUMP] [PATCH] Added CCL support to contrib/mpd.lisp

[Adlai C]

Alright, ignore the patch that I mailed here... it didn't include several commits of history, because I had been following the old git repo. I've put a new patch on Github as a pull request, here: https://github.com/sabetts/stumpwm/pull/17

On Sat, Mar 9, 2013 at 1:53 AM, Adlai Chandrasekhar <address@hidden> wrote:

---
 contrib/mpd.lisp | 60 ++++++++++++++++++++++++++++----------------------------
 1 file changed, 30 insertions(+), 30 deletions(-)

diff --git a/contrib/mpd.lisp b/contrib/mpd.lisp
index 6360cba..68438d5 100644
--- a/contrib/mpd.lisp
+++ b/contrib/mpd.lisp
@@ -47,7 +47,7 @@

 ;;; CODE:

-#-(or sbcl clisp) (error "unimplemented")
+#-(or sbcl clisp ccl) (error "unimplemented")

 (in-package :stumpwm)

@@ -107,7 +107,7 @@
 ;;mpd client
 (defparameter *mpd-socket* nil)
 (defparameter *mpd-server*
-  #+clisp
+  #+(or clisp ccl)
   "localhost"
   #+sbcl
   #(127 0 0 1)
@@ -124,12 +124,14 @@

 (defmacro with-mpd-connection (&body body)
   `(if *mpd-socket*
-       (handler-case (progn ,@body)
-                     (error (c) (progn
-                                  (message "Error with mpd connection: ~a" c)
-                                  (setf *mpd-socket* nil)
-                                  (when *mpd-timer*
-                                    (cancel-timer *mpd-timer*)))))
+       (handler-case
+           (progn ,@body)
+         (error (c)
+           (progn
+             (message "Error with mpd connection: ~a" c)
+             (setf *mpd-socket* nil)
+             (when *mpd-timer*
+               (cancel-timer *mpd-timer*)))))
      (message "Error: not connected to mpd")))

 (defun mpd-send (command)
@@ -137,10 +139,12 @@
   (with-mpd-connection
    (#+clisp
     ext:write-char-sequence
-    #+sbcl
+    #+(or sbcl ccl)
     write-sequence
-    (concatenate  'string command (string #\Newline))
-    *mpd-socket*)))
+    (concatenate 'string command (string #\Newline))
+    *mpd-socket*))
+  ;; This doesn't hurt, and on CCL it's necessary:
+  (force-output *mpd-socket*))

 (defun mpd-send-command (cmd)
   (mpd-send cmd)
@@ -181,25 +185,21 @@

 (defun init-mpd-connection ()
   "Connect to mpd server"
-    (setf *mpd-socket*
-          #+clisp
-        (handler-case (socket:socket-connect *mpd-port* *mpd-server*
-                                             :element-type 'character)
-                      ((or system::simple-os-error error)
-                       (err)
-                         (format t  "Error connecting to mpd: ~a~%" err)))
-          #+sbcl
-          (handler-case (let ((s (make-instance 'sb-bsd-sockets:inet-socket
-                                                :type :stream :protocol :tcp)))
-                          (sb-bsd-sockets:socket-connect s *mpd-server*
-                                                         *mpd-port*)
-                          (sb-bsd-sockets:socket-make-stream s
-                                                             :input t
-                                                             :output t
-                                                             :buffering :none))
-                        ((or simple-error error)
-                         (err)
-                       (format t  "Error connecting to mpd: ~a~%" err))))
+  (handler-case
+      (setf *mpd-socket*
+            #+clisp
+            (socket:socket-connect *mpd-port* *mpd-server* :element-type 'character)
+            #+sbcl
+            (let ((s (make-instance 'sb-bsd-sockets:inet-socket
+                                    :type :stream :protocol :tcp)))
+              (sb-bsd-sockets:socket-connect s *mpd-server* *mpd-port*)
+              (sb-bsd-sockets:socket-make-stream s :input t :output t :buffering :none))
+            #+ccl
+            (ccl:make-socket :remote-host *mpd-server*
+                             :remote-port *mpd-port*
+                             :external-format :utf-8))
+    (error (err)
+      (format t  "Error connecting to mpd: ~a~%" err)))
   (when *mpd-socket*
     (when *mpd-timeout*
       (setf *mpd-timer*
--
1.8.1.4