47 lines
1.3 KiB
Common Lisp
47 lines
1.3 KiB
Common Lisp
;;;; cl-scopes/core/message
|
|
|
|
(defpackage :scopes/core/message
|
|
(:use :common-lisp)
|
|
(:export #:message #:create #:make-message #:simple-message
|
|
#:head #:head-as-list
|
|
#:data #:sender))
|
|
|
|
(in-package :scopes/core/message)
|
|
|
|
;;;; message-head
|
|
|
|
(defclass message-head ()
|
|
((domain)
|
|
(action)
|
|
(class)
|
|
(item)))
|
|
|
|
;;;; message
|
|
|
|
(defclass message ()
|
|
((head :reader head :initarg :head)
|
|
(sender :reader sender :initarg :sender :initform nil)
|
|
(timestamp)
|
|
(data :accessor data :initarg :data :initform nil)))
|
|
|
|
(defun make-message (head-vals &key data sender)
|
|
(create head-vals :data data :sender sender))
|
|
|
|
(defun create (head-vals &key data sender)
|
|
(let ((h (make-instance 'message-head)))
|
|
(dolist (sl '(domain action class item))
|
|
(setf (slot-value h sl) (pop head-vals)))
|
|
(make-instance 'message :head h :data data :sender sender)))
|
|
|
|
(defun simple-message (&rest head-vals)
|
|
(make-message head-vals))
|
|
|
|
(defmethod print-object ((msg message) stream)
|
|
(with-slots (domain action class item) (head msg)
|
|
(format stream
|
|
"<message (~a ~a ~a ~a) ~s <data ~s>>"
|
|
domain action class item (sender msg) (data msg))))
|
|
|
|
(defun head-as-list (msg)
|
|
(with-slots (domain action class item) (head msg)
|
|
(list domain action class item)))
|