:accessor proto-messages
:initarg :messages
:initform ())
+ (extenders :type (list-of protobuf-message) ;the set of extended messages
+ :accessor proto-extenders
+ :initarg :extenders
+ :initform ())
(services :type (list-of protobuf-service)
:accessor proto-services
:initarg :services
(declare (ignore initargs))
;; Record this schema under both its Lisp and its Protobufs name
(with-slots (class name) protobuf
- (setf (gethash class *all-protobufs*) protobuf)
- (setf (gethash name *all-protobufs*) protobuf)))
+ (when class
+ (setf (gethash class *all-protobufs*) protobuf))
+ (when name
+ (setf (gethash name *all-protobufs*) protobuf))))
+
+(defmethod make-load-form ((p protobuf) &optional environment)
+ (make-load-form-saving-slots p :environment environment))
(defmethod print-object ((p protobuf) stream)
(print-unreadable-object (p stream :type t :identity t)
returns the protobuf message corresponding to the type."))
(defmethod find-message ((protobuf protobuf) (type symbol))
- (find type (proto-messages protobuf) :key #'proto-class))
+ ;; Extended messages "shadow" non-extended ones
+ (or (find type (proto-extenders protobuf) :key #'proto-class)
+ (find type (proto-messages protobuf) :key #'proto-class)))
(defmethod find-message ((protobuf protobuf) (type class))
(find-message protobuf (class-name type)))
(defmethod find-message ((protobuf protobuf) (type string))
- (find type (proto-messages protobuf) :key #'proto-name :test #'string=))
+ (or (find type (proto-extenders protobuf) :key #'proto-name :test #'string=)
+ (find type (proto-messages protobuf) :key #'proto-name :test #'string=)))
(defgeneric find-enum (protobuf type)
(:documentation
(:documentation
"The model class that represents a Protobufs options, i.e., a keyword/value pair."))
+(defmethod make-load-form ((o protobuf-option) &optional environment)
+ (make-load-form-saving-slots o :environment environment))
+
(defmethod print-object ((o protobuf-option) stream)
(print-unreadable-object (o stream :type t :identity t)
(format stream "~A~@[ = ~S~]" (proto-name o) (proto-value o))))
-(defun cl-user::protobuf-option (stream option colon-p atsign-p)
- (cond (colon-p ;~:/protobuf-option/ -- .proto format
- (format stream "~A~@[ = ~S~]" (proto-name option) (proto-value option)))
- (atsign-p ;~@/protobuf-option/ -- .lisp format
- (format stream "~S ~S" (proto-name option) (proto-value option)))
- (t ;~/protobuf-option/ -- keyword/value format
- (format stream "~(:~A~) ~S" (proto-name option) (proto-value option)))))
-
(defmethod find-option ((protobuf base-protobuf) (name string))
(let ((option (find name (proto-options protobuf) :key #'proto-name :test #'string=)))
(and option (proto-value option))))
(:documentation
"The model class that represents a Protobufs enumeration type."))
+(defmethod make-load-form ((e protobuf-enum) &optional environment)
+ (make-load-form-saving-slots e :environment environment))
+
(defmethod print-object ((e protobuf-enum) stream)
(print-unreadable-object (e stream :type t :identity t)
(format stream "~S~@[ (alias for ~S)~]"
(:documentation
"The model class that represents a Protobufs enumeration value."))
+(defmethod make-load-form ((v protobuf-enum-value) &optional environment)
+ (make-load-form-saving-slots v :environment environment))
+
(defmethod print-object ((v protobuf-enum-value) stream)
(print-unreadable-object (v stream :type t :identity t)
(format stream "~A = ~D"
:accessor proto-messages
:initarg :messages
:initform ())
+ (extenders :type (list-of protobuf-message) ;the set of extended messages
+ :accessor proto-extenders
+ :initarg :extenders
+ :initform ())
(fields :type (list-of protobuf-field) ;the fields
:accessor proto-fields
:initarg :fields
(defmethod initialize-instance :after ((message protobuf-message) &rest initargs)
(declare (ignore initargs))
;; Record this message under just its Lisp class name
- (with-slots (class) message
- (setf (gethash class *all-messages*) message)))
+ (with-slots (class extension-p) message
+ (when (and class (not extension-p))
+ (setf (gethash class *all-messages*) message))))
+
+(defmethod make-load-form ((m protobuf-message) &optional environment)
+ (make-load-form-saving-slots m :environment environment))
(defmethod print-object ((m protobuf-message) stream)
(print-unreadable-object (m stream :type t :identity t)
(proto-class m) (proto-alias-for m))))
(defmethod find-message ((message protobuf-message) (type symbol))
- (or (find type (proto-messages message) :key #'proto-class)
+ ;; Extended messages "shadow" non-extended ones
+ (or (find type (proto-extenders message) :key #'proto-class)
+ (find type (proto-messages message) :key #'proto-class)
(find-message (proto-parent message) type)))
(defmethod find-message ((message protobuf-message) (type class))
(find-message message (class-name type)))
(defmethod find-message ((message protobuf-message) (type string))
- (or (find type (proto-messages message) :key #'proto-name :test #'string=)
+ (or (find type (proto-extenders message) :key #'proto-name :test #'string=)
+ (find type (proto-messages message) :key #'proto-name :test #'string=)
(find-message (proto-parent message) type)))
(defmethod find-enum ((message protobuf-message) type)
:accessor proto-reader ;if it's supplied, it's used instead of 'value'
:initarg :reader
:initform nil)
- (writer :type (or null symbol) ;a writer that is used to set the value
- :accessor proto-writer
+ (writer :type (or null symbol list) ;a writer that is used to set the value
+ :accessor proto-writer ;when it's a list, it's something like '(setf title)'
:initarg :writer
:initform nil)
(default :type (or null string) ;default value, pulled out of the options
(assert (not (<= 19000 (proto-index field) 19999)) ()
"Protobuf field indexes between 19000 and 19999 are not allowed")))
+(defmethod make-load-form ((f protobuf-field) &optional environment)
+ (make-load-form-saving-slots f :environment environment))
+
(defmethod print-object ((f protobuf-field) stream)
(print-unreadable-object (f stream :type t :identity t)
(format stream "~S :: ~S = ~D"
(:documentation
"The model class that represents an extension with a Protobufs message."))
+(defmethod make-load-form ((e protobuf-extension) &optional environment)
+ (make-load-form-saving-slots e :environment environment))
+
(defmethod print-object ((e protobuf-extension) stream)
(print-unreadable-object (e stream :type t :identity t)
(format stream "~D - ~D"
(:documentation
"The model class that represents a Protobufs service."))
+(defmethod make-load-form ((s protobuf-service) &optional environment)
+ (make-load-form-saving-slots s :environment environment))
+
(defmethod print-object ((s protobuf-service) stream)
(print-unreadable-object (s stream :type t :identity t)
(format stream "~A"
(:documentation
"The model class that represents one method with a Protobufs service."))
-(defmethod print-object ((r protobuf-method) stream)
- (print-unreadable-object (r stream :type t :identity t)
+(defmethod make-load-form ((m protobuf-method) &optional environment)
+ (make-load-form-saving-slots m :environment environment))
+
+(defmethod print-object ((m protobuf-method) stream)
+ (print-unreadable-object (m stream :type t :identity t)
(format stream "~S (~S) => (~S)"
- (proto-function r) (proto-input-type r) (proto-output-type r))))
+ (proto-function m) (proto-input-type m) (proto-output-type m))))
;; The 'class' slot really holds the name of the function,
;; so let's give it a better name
projects / cl-protobufs.git / blobdiff