Allow removal of handlers on endpoint and session

Author: xh4

websocket/endpoint.lisp

@@ -47,32 +47,36 @@
 
 ;; TODO: signal error when unknown class options passed
 (defmethod shared-initialize :after ((class endpoint-class) slot-names
-                                      &key on-open on-close on-error on-message session-class &allow-other-keys)
+                                     &key on-open on-close on-error on-message session-class &allow-other-keys)
   (declare (ignore slot-names))
-  (when on-open
-    (let* ((handler (eval (car on-open)))
-           (handler-lambda-list (function-lambda-list handler)))
+  (if-let ((handler (eval (car on-open))))
+    (let ((handler-lambda-list (function-lambda-list handler)))
       (check-open-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'open-handler) handler
-            (slot-value class 'open-handler-lambda-list) handler-lambda-list)))
-  (when on-close
-    (let* ((handler (eval (car on-close)))
-           (handler-lambda-list (function-lambda-list handler)))
+            (slot-value class 'open-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'open-handler) nil
+          (slot-value class 'open-handler-lambda-list) nil))
+  (if-let ((handler (eval (car on-close))))
+    (let ((handler-lambda-list (function-lambda-list handler)))
       (check-close-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'close-handler) handler
-            (slot-value class 'close-handler-lambda-list) handler-lambda-list)))
-  (when on-error
-    (let* ((handler (eval (car on-error)))
-           (handler-lambda-list (function-lambda-list handler)))
+            (slot-value class 'close-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'close-handler) nil
+          (slot-value class 'close-handler-lambda-list) nil))
+  (if-let ((handler (eval (car on-error))))
+    (let ((handler-lambda-list (function-lambda-list handler)))
       (check-error-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'error-handler) handler
-            (slot-value class 'error-handler-lambda-list) handler-lambda-list)))
-  (when on-message
-    (let* ((handler (eval (car on-message)))
-           (handler-lambda-list (function-lambda-list handler)))
+            (slot-value class 'error-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'error-handler) nil
+          (slot-value class 'error-handler-lambda-list) nil))
+  (if-let (handler (eval (car on-message)))
+    (let ((handler-lambda-list (function-lambda-list handler)))
       (check-message-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'message-handler) handler
-            (slot-value class 'message-handler-lambda-list) handler-lambda-list)))
+            (slot-value class 'message-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'message-handler) nil
+          (slot-value class 'message-handler-lambda-list) nil))
   (when session-class
     (setf (slot-value class 'session-class) (eval (car session-class)))))
 

websocket/session.lisp

@@ -56,30 +56,38 @@
                                       &key on-open on-close on-error on-message
                                         &allow-other-keys)
   (declare (ignore slot-names))
-  (when on-open
+  (if on-open
     (let* ((handler (eval (car on-open)))
            (handler-lambda-list (function-lambda-list handler)))
       (check-open-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'open-handler) handler
-            (slot-value class 'open-handler-lambda-list) handler-lambda-list)))
-  (when on-close
+            (slot-value class 'open-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'open-handler) nil
+          (slot-value class 'open-handler-lambda-list) nil))
+  (if on-close
     (let* ((handler (eval (car on-close)))
            (handler-lambda-list (function-lambda-list handler)))
       (check-close-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'close-handler) handler
-            (slot-value class 'close-handler-lambda-list) handler-lambda-list)))
-  (when on-error
+            (slot-value class 'close-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'close-handler) nil
+          (slot-value class 'close-handler-lambda-list) nil))
+  (if on-error
     (let* ((handler (eval (car on-error)))
            (handler-lambda-list (function-lambda-list handler)))
       (check-error-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'error-handler) handler
-            (slot-value class 'error-handler-lambda-list) handler-lambda-list)))
-  (when on-message
+            (slot-value class 'error-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'error-handler) nil
+          (slot-value class 'error-handler-lambda-list) nil))
+  (if on-message
     (let* ((handler (eval (car on-message)))
            (handler-lambda-list (function-lambda-list handler)))
       (check-message-handler-lambda-list handler-lambda-list)
       (setf (slot-value class 'message-handler) handler
-            (slot-value class 'message-handler-lambda-list) handler-lambda-list))))
+            (slot-value class 'message-handler-lambda-list) handler-lambda-list))
+    (setf (slot-value class 'message-handler) nil
+          (slot-value class 'message-handler-lambda-list) nil)))
 
 (defgeneric close-session  (session &optional reason)
   (:method ((session session) &optional reason)