Commits

David Krentzlin committed 965b151

simplified commands

  • Participants
  • Parent commits 99a34fe

Comments (0)

Files changed (4)

File mira.core/#README.md#

-## What is MIRA?
-
-
-## Testing
-
-Make sure you have loaded the system like so:
-
-     > (ql:quickload :mira.core)
-
-Then run test-system like so:
-
-     > (asdf:test-system :mira.core)
-
-That's it :)
-

File mira.core/.#README.md

-certainty@dantien.3288:1330766913

File mira.core/README.md

      > (asdf:test-system :mira.core)
 
 That's it :)
+

File mira.core/src/processor.lisp

 
 ;; every processor can define commands that
 ;; are related to that processors. This way
-;; the logic to processor commands from users
+;; the logic to process commands from users
 ;; can be used by all processors
 
 @export
 		  :initform  "basic-processor"
 		  :reader id
 		  :allocation :class)
-   (commands      :documentation "Commands that are associated with this processors"
-                  :initform (make-instance '<command-collection>))
    (documentation :documentation "Describe what your processor does"
 		  :initarg :documentation
 		  :initform "No documentation available"
 		  :allocation :class)))
 
 @export
+(defclass <commands-mixin> ()
+  (commands      :documentation "Commands that are associated with this processor"
+                 :initform (make-instance '<command-collection>)))
+
+@export
 (defun answer (&rest arguments)
   (and *current-answer-function*
        (apply *current-answer-function* arguments)))
 (defgeneric process-message (processor message skip-following quit)
   (:documentation "Actually process the message")
   (:method ((processor <processor>) (message <message>) skip-following quit)
-    (unwind-protect
-       t
-      (let* ((ident (sender-identity message))
-             (input (data message))
-             (self  (string-downcase (self processor)))
-             (commands (commands processor))
-             (*current-processor* processor)
-             (*current-kernel* (slot-value processor 'kernel))
-             (*current-answer-function*
-              (lambda (result &key (channels) (sender-id) (receiver (sender message)))
-                (funcall
-                 #'skip-following
-                 (make-instance '<message>
-                                :receiver receiver
-                                :data result
-                                :sender-identity sender-id
-                                :generator-id (slot-value message 'mira.core.message::generator-id)
-                                :tag (tag message))))))
+    (let* ((ident (sender-identity message))
+           (input (data message))
+           (self  (string-downcase (self processor)))
+           (commands (commands processor))
+           (*current-processor* processor)
+           (*current-kernel* (slot-value processor 'kernel))
+           (*current-answer-function*
+            (lambda (result &key (channels) (sender-id) (receiver (sender message)))
+              (funcall
+               #'skip-following
+               (make-instance '<message>
+                              :receiver receiver
+                              :data result
+                              :sender-identity sender-id
+                              :generator-id (slot-value message 'mira.core.message::generator-id)
+                              :tag (tag message))))))
       
-        (when (command-syntax? input self)
-          (multiple-value-bind (command arguments) (destructure-command (strip-sender input))
-            (let ((cmd (find-command commands ident)))
-              (case cmd
-                ((:access-denied) (answer *access-denied-message*))
-                ((nil) ())
-                (t (apply-command cmd arguments message quit skip-following kernel)))))))
-      
-      (setf *current-answer-function* nil))))
+      (when (command-syntax? input self)
+        (multiple-value-bind (command arguments) (destructure-command (strip-sender input))
+          (let ((cmd (find-command commands ident)))
+            (case cmd
+              ((:access-denied) (answer *access-denied-message*))
+              ((nil) nil)
+              (t (apply-command cmd arguments message quit skip-following kernel)))))))))
 
 (defgeneric apply-command (command argument-string message quit skip)
   (:documentation "Applies the command to the given input")
 
 @export
 (defgeneric add-command (proc command-name command)
-  (:method ((proc <processor>) command-name (command <command>))
+  (:method ((proc <commands-mixin>) command-name (command <command>))
     (add-command (commands proc) command-name command)))
 
 @export
 (defmethod get-command ((collection <command-collection>) name)
   (gethash (sring-downcase (string name)) collection))
 
+@export 
+(defgeneric setup-commands (processor)
+  (:documentation "Template method to be implemented by every processor that wants to use commands"))
+
+
+(defmethod initialize-instance :after ((processor <commands-mixin>) &rest args)
+  (declare (ignore args))
+  (setup-commands processor))
+
 ;;
-;; (defcommand <processor-echo> 0 (echo (content &key (foo  1))
+;;
+;; (defmethod setup-commands ((proc <my-procssor>))
+;;   (defcommand proc 0 (echo (content &key (foo  1))
 ;;                           (do-sth-with content)))))
 
-;; (defusage <processor-echo> echo
-;;   :banner "echo content"
-;;   (foo :required "Sets the frooble")
-;;   (bar :optional "Set the barble")
+;;   (defusage proc echo
+;;     :banner "echo content"
+;;     (foo :required "Sets the frooble")
+;;     (bar :optional "Set the barble"))
 ;;
 ;;
 ;;   Usage: echo content [options]
     `(labels ((,closure (lambda (&rest arguments)
                           (destructuring-bind (,@command-lambda-list) arguments
                             ,@body))))
-       (defmethod initialize-instance :after ((processor  ,proc) &rest args)
-         (declare (ignore args))
-         (add-command processor
-                      (string ',command-name)
-                      (make-instance '<command>
-                                     :required-access-level ,level
-                                     :body ,closure))))))
+       (add-command ,proc
+                    (string ',command-name)
+                    (make-instance '<command>
+                                   :required-access-level ,level
+                                   :body ,closure)))))
 
 @export
 (defmacro defusage (processor command-name banner &rest options)
-  `(defmethod add-command :after ((processor ,processor) cmd-name cmd)
+  `(defmethod add-command :after ((eql ,processor) cmd-name cmd)
      (when (equal? (string ',command-name) (string cmd-name))
        (with-slots (usage help) ,cmd
          (setf usage banner)