following macros. For example::
(proto:define-proto color-wheel
- (:package color-wheel
- :documentation "Color wheel example")
+ (:package color-wheel)
(proto:define-message color-wheel
(:conc-name color-wheel-)
(name :type string)
(colors :type (proto:list-of color) :default ()))
(proto:define-message color
- (:conc-name color-
- :documentation "A (named) color")
+ (:conc-name color-)
(name :type (or string null))
(r-value :type integer)
(g-value :type integer)
- (b-value :type integer))
+ (b-value :type integer)
+ (proto:define-extension 1000 max))
+ (proto:define-extends color ()
+ ((opacity 1000) :type (or null integer)))
(proto:define-message get-color-request ()
(wheel :type color-wheel)
(name :type string))
(color :type color))
(proto:define-service color-wheel ()
(get-color (get-color-request color)
- :options ("deadline" "1.0")
- :documentation "Look up a color by name")
+ :options ("deadline" "1.0"))
(add-color (add-color-request color)
- :options ("deadline" "1.0")
- :documentation "Add a new color to the wheel")))
+ :options ("deadline" "1.0"))))
This will create the Protobufs model objects, Lisp classes and enum
types that correspond to the model. The .proto file of the same schema
package color_wheel;
+ import "net/proto2/proto/descriptor.proto"
+
+ extend proto2.MessageOptions {
+ optional string lisp_package = 195801;
+ optional string lisp_name = 195802;
+ optional string lisp_alias = 195803;
+ }
+
message ColorWheel {
required string name = 1;
repeated Color colors = 2;
required int64 rValue = 2;
required int64 gValue = 3;
required int64 bValue = 4;
+ extensions 1000 to max;
+ }
+
+ extends Color {
+ optional int64 opacity = 1000;
}
message GetColorRequest {
:optimize optimize
:documentation documentation))
(*protobuf* protobuf)
- (*protobuf-package* nil))
+ (*protobuf-package* (or (find-package lisp-pkg)
+ (find-package (string-upcase lisp-pkg)))))
(with-collectors ((forms collect-form))
(dolist (msg messages)
(assert (and (listp msg)
(setf (proto-enums protobuf) (nconc (proto-messages protobuf) (list model))))
((define-message define-extends)
(setf (proto-parent model) protobuf)
- (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list model))))
+ (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list model)))
+ (when (proto-extension-p model)
+ (setf (proto-extenders protobuf) (nconc (proto-extenders protobuf) (list model)))))
((define-service)
(setf (proto-services protobuf) (nconc (proto-services protobuf) (list model)))))))
(let ((var (fintern "*~A*" type)))
:alias-for alias-for
:options options
:documentation documentation)))
- (declare (type fixnum index))
(with-collectors ((vals collect-val)
(forms collect-form))
(dolist (val values)
:alias-for alias-for
:conc-name (and conc-name (string conc-name))
:options options
- :documentation documentation)))
- (declare (type fixnum index))
+ :documentation documentation))
+ (*protobuf* message))
(with-collectors ((slots collect-slot)
(forms collect-form))
- (dolist (fld fields)
- (case (car fld)
+ (dolist (field fields)
+ (case (car field)
((define-enum define-message define-extends define-extension)
(destructuring-bind (&optional progn type model definers)
- (macroexpand-1 fld env)
+ (macroexpand-1 field env)
(assert (eq progn 'progn) ()
- "The macroexpansion for ~S failed" fld)
+ "The macroexpansion for ~S failed" field)
(map () #'collect-form definers)
(ecase type
((define-enum)
(setf (proto-enums message) (nconc (proto-messages message) (list model))))
((define-message define-extends)
(setf (proto-parent model) message)
- (setf (proto-messages message) (nconc (proto-messages message) (list model))))
+ (setf (proto-messages message) (nconc (proto-messages message) (list model)))
+ (when (proto-extension-p model)
+ (setf (proto-extenders message) (nconc (proto-extenders message) (list model)))))
((define-extension)
(setf (proto-extensions message) (nconc (proto-extensions message) (list model)))))))
(otherwise
- (when (i= index 18999) ;skip over the restricted range
- (setq index 19999))
- (destructuring-bind (slot &key type (default nil default-p) reader writer name documentation) fld
- (let* ((idx (if (listp slot) (second slot) (iincf index)))
- (slot (if (listp slot) (first slot) slot))
- (reqd (clos-type-to-protobuf-required type))
- (reader (if (eq reader 't)
- (intern (if conc-name (format nil "~A~A" conc-name slot) (symbol-name slot))
- (symbol-package slot))
- reader)))
- (multiple-value-bind (ptype pclass)
- (clos-type-to-protobuf-type type)
- (unless alias-for
- (collect-slot `(,slot :type ,type
- ,@(and reader
- (if writer
- `(:reader ,reader)
- `(:accessor ,reader)))
- ,@(and writer
- `(:writer ,writer))
- :initarg ,(kintern (symbol-name slot))
- ,@(cond ((and (not default-p) (eq reqd :repeated))
- `(:initform ()))
- ((and (not default-p) (eq reqd :optional))
- `(:initform nil))
- (default-p
- `(:initform ,default))))))
- (let ((field (make-instance 'protobuf-field
- :name (or name (slot-name->proto slot))
- :type ptype
- :class pclass
- :required reqd
- :index idx
- :value slot
- :reader reader
- :writer writer
- :default (and default (format nil "~A" default))
- :packed (and (eq reqd :repeated)
- (packed-type-p pclass))
- :documentation documentation)))
- (setf (proto-fields message) (nconc (proto-fields message) (list field))))))))))
+ (multiple-value-bind (field slot idx)
+ (process-field field index :conc-name conc-name :alias-for alias-for)
+ (assert (not (find (proto-index field) (proto-fields message) :key #'proto-index)) ()
+ "The field ~S overlaps with another field in ~S"
+ (proto-value field) (proto-class message))
+ (when slot
+ (collect-slot slot))
+ (setf (proto-fields message) (nconc (proto-fields message) (list field)))
+ (setq index idx)))))
(if alias-for
;; If we've got an alias, define a a type that is the subtype of
;; the Lisp class that typep and subtypep work
(defmacro define-extends (type (&key name options documentation)
&body fields &environment env)
- ;;---*** Handle 'define-extends' here (factor out field "parsing" from above)
- ;;---*** Note that it handles only fields, not nested message or enums
- type name options documentation fields env
- `(progn define-extends nil nil))
+ "Define an extension to the message named 'type'.
+ 'name' can be used to override the defaultly generated Protobufs message name.
+ The body consists only of fields.
+ 'options' is a set of keyword/value pairs, both of which are strings.
+
+ Fields take the form (slot &key type name default reader)
+ 'slot' can be either a symbol giving the field name, or a list whose
+ first element is the slot name and whose second element is the index.
+ 'type' is the type of the slot.
+ 'name' can be used to override the defaultly generated Protobufs field name.
+ 'default' is the default value for the slot.
+ 'reader' is a Lisp slot reader function to use to get the value, instead of
+ using 'slot-value'; this is often used when aliasing an existing class.
+ 'writer' is a Lisp slot writer function to use to set the value."
+ (declare (ignore env))
+ (let* ((name (or name (class-name->proto type)))
+ (options (loop for (key val) on options by #'cddr
+ collect (make-instance 'protobuf-option
+ :name key
+ :value val)))
+ (index 0)
+ (message (find-message *protobuf* name))
+ (conc-name (and message (proto-conc-name message)))
+ (alias-for (and message (proto-alias-for message)))
+ (extends (and message
+ (make-instance 'protobuf-message
+ :class type
+ :name name
+ :parent (proto-parent message)
+ :conc-name conc-name
+ :alias-for alias-for
+ :enums (copy-list (proto-enums message))
+ :messages (copy-list (proto-messages message))
+ :fields (copy-list (proto-fields message))
+ :options (or options (copy-list (proto-options message)))
+ :extension-p t ;this message is an extension
+ :documentation documentation))))
+ (assert message ()
+ "There is no message named ~A to extend" name)
+ (assert (eq type (proto-class message)) ()
+ "The type ~S doesn't match the type of the message being extended ~S"
+ type message)
+ (with-collectors ((forms collect-form))
+ (dolist (field fields)
+ (assert (not (member (car field)
+ '(define-enum define-message define-extends define-extension))) ()
+ "The body of ~S can only contain field definitions" 'define-extends)
+ (multiple-value-bind (field slot idx)
+ (process-field field index :conc-name conc-name :alias-for alias-for)
+ ;;--- Make sure extension field's index is allowable within 'proto-extensions'
+ (assert (not (find (proto-index field) (proto-fields extends) :key #'proto-index)) ()
+ "The field ~S overlaps with another field in ~S"
+ (proto-value field) (proto-class extends))
+ (when slot
+ (let* ((inits (cdr slot))
+ (sname (car slot))
+ (stype (getf inits :type))
+ (reader (or (getf inits :accessor)
+ (getf inits :reader)
+ (intern (if conc-name (format nil "~A~A" conc-name sname) (symbol-name sname))
+ (symbol-package sname))))
+ (writer (or (getf inits :writer) `(setf ,reader)))
+ (default (getf inits :initform)))
+ ;;--- Can we avoid having to use a hash table?
+ (collect-form `(let ((,sname (make-hash-table :test #'eq :weak t)))
+ (defmethod ,reader ((object ,type))
+ (gethash object ,sname ,default))
+ (defmethod ,writer (value (object ,type))
+ (declare (type ,stype value))
+ (setf (gethash object ,sname) value))))
+ ;; This so that (de)serialization works
+ (setf (proto-reader field) reader
+ (proto-writer field) writer)))
+ (setf (proto-extension-p field) t) ;this field is an extension
+ (setf (proto-fields extends) (nconc (proto-fields extends) (list field)))
+ (setq index idx)))
+ `(progn
+ define-extends
+ ,extends
+ ,forms))))
+
+(defun process-field (field index &key conc-name alias-for)
+ "Process one field descriptor within 'define-message' or 'define-extends'.
+ Returns a 'proto-field' object, a CLOS slot form and the incremented field index."
+ (when (i= index 18999) ;skip over the restricted range
+ (setq index 19999))
+ (destructuring-bind (slot &key type (default nil default-p) reader writer name documentation) field
+ (let* ((idx (if (listp slot) (second slot) (iincf index)))
+ (slot (if (listp slot) (first slot) slot))
+ (reqd (clos-type-to-protobuf-required type))
+ (reader (if (eq reader 't)
+ (intern (if conc-name (format nil "~A~A" conc-name slot) (symbol-name slot))
+ (symbol-package slot))
+ reader)))
+ (multiple-value-bind (ptype pclass)
+ (clos-type-to-protobuf-type type)
+ (let ((slot (unless alias-for
+ `(,slot :type ,type
+ ,@(and reader
+ (if writer
+ `(:reader ,reader)
+ `(:accessor ,reader)))
+ ,@(and writer
+ `(:writer ,writer))
+ :initarg ,(kintern (symbol-name slot))
+ ,@(cond ((and (not default-p) (eq reqd :repeated))
+ `(:initform ()))
+ ((and (not default-p) (eq reqd :optional))
+ `(:initform nil))
+ (default-p
+ `(:initform ,default))))))
+ (field (make-instance 'protobuf-field
+ :name (or name (slot-name->proto slot))
+ :type ptype
+ :class pclass
+ :required reqd
+ :index idx
+ :value slot
+ :reader reader
+ :writer writer
+ :default (and default (format nil "~A" default))
+ :packed (and (eq reqd :repeated)
+ (packed-type-p pclass))
+ :documentation documentation)))
+ (values field slot index))))))
(defmacro define-extension (from to)
"Define an extension range within a message.
define-extension
,(make-instance 'protobuf-extension
:from from
- :to to)
+ :to (if (eql to 'max) #.(1- (ash 1 29)) to))
()))
;; Define a service named 'type' with generic functions declared for
(name :type (or string null))
(r-value :type integer)
(g-value :type integer)
- (b-value :type integer))
+ (b-value :type integer)
+ (proto:define-extension 1000 max))
+ (proto:define-extends color ()
+ ((opacity 1000) :type (or null integer)))
(proto:define-message get-color-request ()
(wheel :type color-wheel)
(name :type string))
(proto:write-protobuf *color-wheel* :type :lisp)
(progn ;with-rpc-channel (rpc)
- (let* ((wheel (make-instance 'color-wheel :name "Colors"))
- (color (make-instance 'color :r-value 100 :g-value 0 :b-value 100))
- (request (make-instance 'add-color-request :wheel wheel :color color)))
- #-ignore (print (proto:serialize-object-to-stream request 'add-color-request :stream nil))
- #-ignore (proto:print-text-format request)
- #+stubby (add-color request)))
+ (let* ((wheel (make-instance 'color-wheel :name "Colors"))
+ (color1 (make-instance 'color :r-value 100 :g-value 0 :b-value 100))
+ (rqst1 (make-instance 'add-color-request :wheel wheel :color color1))
+ (color2 (make-instance 'color :r-value 100 :g-value 0 :b-value 100))
+ (rqst2 (make-instance 'add-color-request :wheel wheel :color color2)))
+ (setf (color-opacity color2) 50)
+ #-ignore (let ((ser (proto:serialize-object-to-stream rqst1 'add-color-request :stream nil)))
+ (print ser)
+ (proto:print-text-format rqst1)
+ (proto:print-text-format (proto:deserialize-object 'add-color-request ser)))
+ #-ignore (let ((ser (proto:serialize-object-to-stream rqst2 'add-color-request :stream nil)))
+ (print ser)
+ (proto:print-text-format rqst2)
+ (proto:print-text-format (proto:deserialize-object 'add-color-request ser)))
+ #+stubby (add-color request)
+ #+ignore (add-color request)))
||#
: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))
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
: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))
(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
(setq *protobuf-package* package)))))))
((string= token "enum")
(parse-proto-enum stream protobuf))
- ;;---*** Handle "extends" here
+ ((string= token "extends")
+ (parse-proto-extends stream protobuf))
((string= token "message")
(parse-proto-message stream protobuf))
((string= token "service")
(setf (proto-imports protobuf) (nconc (proto-imports protobuf) (list import)))))
(defun parse-proto-option (stream protobuf &optional (terminator #\;))
- "Parse a Protobufs option from 'stream'.
+ "Parse a Protobufs option line from 'stream'.
Updates the 'protobuf' (or message, service, method) to have the option."
(check-type protobuf (or null base-protobuf))
(let* ((key (prog1 (parse-parenthesized-token stream)
(defun parse-proto-enum (stream protobuf)
- "Parse a Protobufs enum from 'stream'.
+ "Parse a Protobufs 'enum' from 'stream'.
Updates the 'protobuf' or 'protobuf-message' object to have the enum."
(check-type protobuf (or protobuf protobuf-message))
(let* ((name (prog1 (parse-token stream)
(parse-proto-enum-value stream enum name))))))
(defun parse-proto-enum-value (stream enum name)
- "Parse a Protobufs enum vvalue from 'stream'.
+ "Parse a Protobufs enum value from 'stream'.
Updates the 'protobuf-enum' object to have the enum value."
(check-type enum protobuf-enum)
(expect-char stream #\= "enum")
(defun parse-proto-message (stream protobuf)
- "Parse a Protobufs message from 'stream'.
+ "Parse a Protobufs 'message' from 'stream'.
Updates the 'protobuf' or 'protobuf-message' object to have the message."
(check-type protobuf (or protobuf protobuf-message))
(let* ((name (prog1 (parse-token stream)
(message (make-instance 'protobuf-message
:class (proto->class-name name *protobuf-package*)
:name name
- :parent protobuf)))
+ :parent protobuf))
+ (*protobuf* message))
(loop
(let ((token (parse-token stream)))
(when (null token)
(return-from parse-proto-message))
(cond ((string= token "enum")
(parse-proto-enum stream message))
- ;;---*** Handle "extends" here
+ ((string= token "extends")
+ (parse-proto-extends stream message))
((string= token "message")
(parse-proto-message stream message))
((member token '("required" "optional" "repeated") :test #'string=)
(error "Unrecognized token ~A at position ~D"
token (file-position stream))))))))
+(defun parse-proto-extends (stream protobuf)
+ "Parse a Protobufs 'extends' from 'stream'.
+ Updates the 'protobuf' or 'protobuf-message' object to have the message."
+ (check-type protobuf (or protobuf protobuf-message))
+ (let* ((name (prog1 (parse-token stream)
+ (expect-char stream #\{ "extends")
+ (maybe-skip-comments stream)))
+ (message (find-message *protobuf* name))
+ (extends (and message
+ (make-instance 'protobuf-message
+ :class (proto->class-name name *protobuf-package*)
+ :name name
+ :parent (proto-parent message)
+ :conc-name (proto-conc-name message)
+ :alias-for (proto-alias-for message)
+ :enums (copy-list (proto-enums message))
+ :messages (copy-list (proto-messages message))
+ :fields (copy-list (proto-fields message))
+ :extension-p t)))) ;this message is an extension
+ (loop
+ (let ((token (parse-token stream)))
+ (when (null token)
+ (expect-char stream #\} "extends")
+ (maybe-skip-comments stream)
+ (setf (proto-messages protobuf) (nconc (proto-messages protobuf) (list extends)))
+ (setf (proto-extenders protobuf) (nconc (proto-extenders protobuf) (list extends)))
+ (let ((type (find-option extends "lisp_name")))
+ (when type
+ (setf (proto-class extends) (make-lisp-symbol type))))
+ (let ((alias (find-option extends "lisp_alias")))
+ (when alias
+ (setf (proto-alias-for extends) (make-lisp-symbol alias))))
+ (return-from parse-proto-extends))
+ (cond ((member token '("required" "optional" "repeated") :test #'string=)
+ (parse-proto-field stream extends token))
+ ((string= token "option")
+ (parse-proto-option stream extends #\;))
+ (t
+ (error "Unrecognized token ~A at position ~D"
+ token (file-position stream))))))))
+
(defun parse-proto-field (stream message required)
"Parse a Protobufs field from 'stream'.
Updates the 'protobuf-message' object to have the field."
:required (kintern required)
:index idx
:default dflt
- :packed (and packed (string= packed "true")))))
+ :packed (and packed (string= packed "true"))
+ :extension-p (proto-extension-p message))))
+ ;;--- Make sure extension field's index is allowable within 'proto-extensions'
(let ((slot (find-option opts "lisp_name")))
(when slot
(setf (proto-value field) (make-lisp-symbol type))))
(defun parse-proto-service (stream protobuf)
- "Parse a Protobufs service from 'stream'.
+ "Parse a Protobufs 'service' from 'stream'.
Updates the 'protobuf-protobuf' object to have the service."
(check-type protobuf protobuf)
(let* ((name (prog1 (parse-token stream)
token (file-position stream))))))))
(defun parse-proto-method (stream service)
- "Parse a Protobufs enum vvalue from 'stream'.
+ "Parse a Protobufs method from 'stream'.
Updates the 'protobuf-service' object to have the method."
(check-type service protobuf-service)
(let* ((name (parse-token stream))
(dolist (option options)
(format stream "~&~VToption ~:/protobuf-option/;~%"
(+ indentation 2) option))
- (dolist (enum (proto-enums message))
- (write-protobuf-as type enum stream :indentation (+ indentation 2)))
- (dolist (msg (proto-messages message))
- (write-protobuf-as type msg stream :indentation (+ indentation 2)))
- (dolist (field (proto-fields message))
- (write-protobuf-as type field stream :indentation (+ indentation 2)))
- (dolist (extension (proto-extensions message))
- (write-protobuf-as type extension stream :indentation (+ indentation 2)))
+ (cond (extension-p
+ (dolist (field (proto-fields message))
+ (when (proto-extension-p field)
+ (write-protobuf-as type field stream :indentation (+ indentation 2)))))
+ (t
+ (dolist (enum (proto-enums message))
+ (write-protobuf-as type enum stream :indentation (+ indentation 2)))
+ (dolist (msg (proto-messages message))
+ (write-protobuf-as type msg stream :indentation (+ indentation 2)))
+ (dolist (field (proto-fields message))
+ (write-protobuf-as type field stream :indentation (+ indentation 2)))
+ (dolist (extension (proto-extensions message))
+ (write-protobuf-as type extension stream :indentation (+ indentation 2)))))
(format stream "~&~@[~VT~]}~%"
(and (not (zerop indentation)) indentation))))
(with-prefixed-accessors (from to) (proto-extension- extension)
(format stream "~&~@[~VT~]extensions ~D to ~D;~%"
(and (not (zerop indentation)) indentation)
- from to)))
+ from (if (eql to #.(1- (ash 1 29))) "max" to))))
(defmethod write-protobuf-as ((type (eql :proto)) (service protobuf-service) stream
(and (not (zerop indentation)) indentation)
(if extension-p "extends" "message") class)
(let ((other (and name (not (string= name (class-name->proto class))) name)))
- (cond ((or alias-for conc-name documentation)
+ (cond (extension-p
+ (format stream " ()"))
+ ((or alias-for conc-name documentation)
(format stream "~%~@[~VT~](~:[~*~*~;:name ~(~S~)~@[~%~VT~]~]~
~:[~*~*~;:alias-for ~(~S~)~@[~%~VT~]~]~
~:[~*~*~;:conc-name ~(~S~)~@[~%~VT~]~]~
documentation documentation))
(t
(format stream " ()"))))
- (loop for (enum . more) on (proto-enums message) doing
- (write-protobuf-as type enum stream :indentation (+ indentation 2))
- (when more
- (terpri stream)))
- (loop for (msg . more) on (proto-messages message) doing
- (write-protobuf-as type msg stream :indentation (+ indentation 2))
- (when more
- (terpri stream)))
- (loop for (field . more) on (proto-fields message) doing
- (write-protobuf-as type field stream :indentation (+ indentation 2))
- (when more
- (terpri stream)))
- (loop for (extension . more) on (proto-extensions message) doing
- (write-protobuf-as type extension stream :indentation (+ indentation 2))
- (when more
- (terpri stream)))
+ (cond (extension-p
+ (loop for (field . more) on (proto-fields message) doing
+ (when (proto-extension-p field)
+ (write-protobuf-as type field stream :indentation (+ indentation 2))
+ (when more
+ (terpri stream)))))
+ (t
+ (loop for (enum . more) on (proto-enums message) doing
+ (write-protobuf-as type enum stream :indentation (+ indentation 2))
+ (when more
+ (terpri stream)))
+ (loop for (msg . more) on (proto-messages message) doing
+ (write-protobuf-as type msg stream :indentation (+ indentation 2))
+ (when more
+ (terpri stream)))
+ (loop for (field . more) on (proto-fields message) doing
+ (write-protobuf-as type field stream :indentation (+ indentation 2))
+ (when more
+ (terpri stream)))
+ (loop for (extension . more) on (proto-extensions message) doing
+ (write-protobuf-as type extension stream :indentation (+ indentation 2))
+ (when more
+ (terpri stream)))))
(format stream ")")))
(defparameter *protobuf-slot-comment-column* 56)
(with-prefixed-accessors (from to) (proto-extension- extension)
(format stream "~&~@[~VT~](define-extension ~D ~D)"
(and (not (zerop indentation)) indentation)
- from to)))
+ from (if (eql to #.(1- (ash 1 29))) "max" to))))
(defmethod write-protobuf-as ((type (eql :lisp)) (service protobuf-service) stream
"PROTO-ENUMS"
"PROTO-EXTENSION-FROM"
"PROTO-EXTENSION-TO"
- "PROTO-EXTENSION-P"
+ "PROTO-EXTENDERS"
"PROTO-EXTENSIONS"
+ "PROTO-EXTENSION-P"
"PROTO-FIELDS"
"PROTO-FUNCTION"
"PROTO-IMPORTS"
projects / cl-protobufs.git / commitdiff