X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=7ac17d498cb742fa7857f912341bc389cb9d882b;hp=8a1689be7899a089754b8eb98127cd2f2b4bab94;hb=debbb67bcc0276b5e9793824c4240e3dd5ba83ea;hpb=702b7b803394d5db770b4137bd1d3698d632b227 diff --git a/empire.lisp b/empire.lisp index 8a1689b..7ac17d4 100644 --- a/empire.lisp +++ b/empire.lisp @@ -9,6 +9,8 @@ (defvar *default-empire-server* "localhost") (defvar *default-empire-server-port* 6665) +(defvar *last-active-connection* nil) + (defclass connection () ((user :initarg :user @@ -268,6 +270,7 @@ (let* ((s (network-stream c)) (line (read-line s))) (empire-log:info "~a: < ~a" c line) + (setf *last-active-connection* c) (multiple-value-bind (message type) (parse-server-line line) (let ((handler (lookup-handler type)) (mode (connection-mode c))) @@ -287,6 +290,7 @@ (defgeneric send-message-one (connection string)) (defmethod send-message-one ((c connection) message) (empire-log:info "~a: > ~a" c message) + (setf *last-active-connection* c) (let ((s (network-stream c))) (raw-send-message s message))) @@ -310,38 +314,47 @@ (defmethod handle-data ((m xdump-mode) message) (with-slots (connection phase dump-queue dump-index) m - (if (xdump:parse-line (xdump connection) message) - ;;XXX consider something like a 'pop-mode function - (ccase phase - (:meta-meta - (setf phase :meta-table) - (send-message connection "xdump meta table")) - (:meta-table - (setf phase :table-table) - (send-message connection "xdump table *")) - (:table-table - (setf phase :tables-meta - dump-queue (xdump::table-entries (xdump::get-table "table")) - dump-index 0) - (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue 0))))) - (:tables-meta - (setf phase :tables-content) - (send-message connection (format nil "xdump ~a *" (xdump-data::table-name (aref dump-queue dump-index))))) - (:tables-content - (if (< dump-index (fill-pointer dump-queue)) - (progn (setf phase :tables-meta) - (incf dump-index) - (loop while (and (< dump-index (fill-pointer dump-queue)) - (let ((dump-queue-entry (aref dump-queue dump-index))) - (or (null dump-queue-entry) - (string= "meta" (xdump-data::table-name dump-queue-entry))))) - do (incf dump-index)) - (if (and (<= dump-index (fill-pointer dump-queue)) - (not (null (aref dump-queue dump-index)))) - (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue dump-index)))))) - (set-new-mode (connection-mode connection) 'play-mode))))))) + (xdump:with-parser (xdump connection) + (if (xdump:parse-line (xdump connection) message) + ;;XXX consider something like a 'pop-mode function + (ccase phase + (:meta-meta + (setf phase :meta-table) + (send-message connection "xdump meta table")) + (:meta-table + (setf phase :table-table) + (send-message connection "xdump table *")) + (:table-table + (setf phase :meta-type) + (send-message connection "xdump meta meta-type")) + (:meta-type + (setf phase :type-table) + (send-message connection "xdump meta-type *")) + (:type-table + (setf phase :tables-meta + dump-queue (xdump::table-entries (xdump:table "table")) + dump-index 0) + (send-message connection (format nil "xdump meta ~a" (xdump-data:name (aref dump-queue 0))))) + (:tables-meta + (setf phase :tables-content) + (send-message connection (format nil "xdump ~a *" (xdump-data:name (aref dump-queue dump-index))))) + (:tables-content + (if (< dump-index (fill-pointer dump-queue)) + (progn (setf phase :tables-meta) + (incf dump-index) + (loop while (and (< dump-index (fill-pointer dump-queue)) + (let ((dump-queue-entry (aref dump-queue dump-index))) + (or (null dump-queue-entry) + (string= "meta" + (xdump-data:name dump-queue-entry))))) + do (incf dump-index)) + (if (and (<= dump-index (fill-pointer dump-queue)) + (not (null (aref dump-queue dump-index)))) + (send-message connection (format nil "xdump meta ~a" (xdump-data:name (aref dump-queue dump-index)))))) + (set-new-mode (connection-mode connection) 'play-mode)))))))) (defmethod special-xup ((c connection)) + (setf (xdump c) (xdump:make-parser)) (send-message c "xdump meta meta" :next-mode 'xdump-mode)) (defmethod special-command ((c connection) line)