diff --git a/parser.lisp b/parser.lisp index 3ef687a7affb7e5c9278a34566e767e6fa1d6655..922c2c605f3f6f01b060711abbcfacb607c07788 100644 --- a/parser.lisp +++ b/parser.lisp @@ -156,7 +156,11 @@ collect ch into string finally (progn (skip-whitespace stream) - (return (coerce string 'string))))) + (if (eql (peek-char nil stream nil) ch0) + ;; If the next character is a quote character, that means + ;; we should go parse another string and concatenate it + (return (strcat (coerce string 'string) (parse-string stream))) + (return (coerce string 'string)))))) (defun unescape-char (stream) "Parse the next \"escaped\" character from the stream." @@ -375,6 +379,14 @@ (parse-string stream)) ((or (digit-char-p ch) (member ch '(#\- #\+ #\.))) (parse-number stream)) + ((eql ch #\{) + (let ((message (find-message (or protobuf *protobuf*) key))) + (if message + ;; We've got a complex message as a value to an option + ;; This only shows up in custom optionss + (parse-text-format message :stream stream :parse-name nil) + ;; Who knows what to do? Skip the value + (skip-field stream)))) (t (kintern (parse-token stream))))) (setq terminator (expect-char stream terminators () "option")) (maybe-skip-comments stream))) diff --git a/printer.lisp b/printer.lisp index 7844ff26c170173c8a43afc2f67ef2296f767cd1..97e19dea91894db125b31a0a5259261d1798c055 100644 --- a/printer.lisp +++ b/printer.lisp @@ -138,27 +138,46 @@ nil))) (defun cl-user::protobuf-option (stream option colon-p atsign-p) - (let ((type (or (second (find (proto-name option) *option-types* :key #'first :test #'string=)) - (proto-type option)))) + (let* ((type (or (second (find (proto-name option) *option-types* :key #'first :test #'string=)) + (proto-type option))) + (value (proto-value option))) (cond (colon-p ;~:/protobuf-option/ -- .proto format (let ((fmt-control (cond ((find (proto-name option) *lisp-options* :key #'first :test #'string=) (case type ((symbol) "(~A)~@[ = ~A~]") ((boolean) "(~A)~@[ = ~(~A~)~]") - (otherwise "(~A)~@[ = ~S~]"))) + (otherwise + (cond ((typep value 'standard-object) + ;; If the value is an instance of some class, + ;; then it must be some sort of complex option, + ;; so print the value using the text format + (setq value + (with-output-to-string (s) + (print-text-format value nil + :stream s :print-name nil :suppress-line-breaks t))) + "(~A)~@[ = ~A~]") + (t + "(~A)~@[ = ~S~]"))))) (t (case type ((symbol) "~A~@[ = ~A~]") ((boolean) "~A~@[ = ~(~A~)~]") - (otherwise "~A~@[ = ~S~]")))))) - (format stream fmt-control (proto-name option) (proto-value option)))) + (otherwise + (cond ((typep value 'standard-object) + (setq value + (with-output-to-string (s) + (print-text-format value nil + :stream s :print-name nil :suppress-line-breaks t))) + "~A~@[ = ~A~]") + (t "~A~@[ = ~S~]")))))))) + (format stream fmt-control (proto-name option) value))) (atsign-p ;~@/protobuf-option/ -- string/value format (let ((fmt-control (if (eq type 'symbol) "~(~S~) ~A" "~(~S~) ~S"))) - (format stream fmt-control (proto-name option) (proto-value option)))) + (format stream fmt-control (proto-name option) value))) (t ;~/protobuf-option/ -- keyword/value format (let ((fmt-control (if (eq type 'symbol) "~(:~A~) ~A" "~(:~A~) ~S"))) - (format stream fmt-control (proto-name option) (proto-value option))))))) + (format stream fmt-control (proto-name option) value)))))) (defun cl-user::source-location (stream location colon-p atsign-p) (declare (ignore colon-p atsign-p)) diff --git a/text-format.lisp b/text-format.lisp index 18af325090a4563b76cc0e2fa8cddfdcd4d918c0..183b1a88d71adcefd7d3d3f182b33d9f4051c3c5 100644 --- a/text-format.lisp +++ b/text-format.lisp @@ -16,7 +16,7 @@ (defvar *suppress-line-breaks* nil "When true, don't generate line breaks in the text format") -(defgeneric print-text-format (object &optional type &key stream suppress-line-breaks) +(defgeneric print-text-format (object &optional type &key stream suppress-line-breaks print-name) (:documentation "Prints the object 'object' of type 'type' onto the stream 'stream' using the textual format. @@ -24,7 +24,7 @@ (defmethod print-text-format (object &optional type &key (stream *standard-output*) - (suppress-line-breaks *suppress-line-breaks*)) + (suppress-line-breaks *suppress-line-breaks*) (print-name t)) (let* ((type (or type (type-of object))) (message (find-message-for-class type))) (assert message () @@ -122,9 +122,11 @@ (print-prim v type field stream (or suppress-line-breaks indent))))))))))))) (declare (dynamic-extent #'do-field)) - (if suppress-line-breaks - (format stream "~A { " (proto-name message)) - (format stream "~&~A {~%" (proto-name message))) + (if print-name + (if suppress-line-breaks + (format stream "~A { " (proto-name message)) + (format stream "~&~A {~%" (proto-name message))) + (format stream "{")) (map () (curry #'do-field object message 0) (proto-fields message)) (if suppress-line-breaks (format stream "}") @@ -175,20 +177,23 @@ ;;; Parse objects that were serialized using the text format -(defgeneric parse-text-format (type &key stream) +(defgeneric parse-text-format (type &key stream parse-name) (:documentation "Parses an object of type 'type' from the stream 'stream' using the textual format.")) -(defmethod parse-text-format ((type symbol) &key (stream *standard-input*)) +(defmethod parse-text-format ((type symbol) + &key (stream *standard-input*) (parse-name t)) (let ((message (find-message-for-class type))) (assert message () "There is no Protobuf message having the type ~S" type) - (parse-text-format message :stream stream))) + (parse-text-format message :stream stream :parse-name parse-name))) -(defmethod parse-text-format ((message protobuf-message) &key (stream *standard-input*)) - (let ((name (parse-token stream))) - (assert (string= name (proto-name message)) () - "The message is not of the expected type ~A" (proto-name message))) +(defmethod parse-text-format ((message protobuf-message) + &key (stream *standard-input*) (parse-name t)) + (when parse-name + (let ((name (parse-token stream))) + (assert (string= name (proto-name message)) () + "The message is not of the expected type ~A" (proto-name message)))) (labels ((deserialize (type trace) (let* ((message (find-message trace type)) (object (and message @@ -286,24 +291,25 @@ (otherwise (parse-signed-int stream))))) (when slot (setf (slot-value object slot) - (funcall (proto-deserializer msg) val)))))))))))))) - (skip-field (stream) - ;; Skip either a token or a balanced {}-pair - (ecase (peek-char nil stream nil) - ((#\:) - (read-char stream) - (skip-whitespace stream) - (parse-token-or-string stream)) - ((#\{) - (let ((depth 0)) - (loop for ch = (read-char stream) - do (cond ((eql ch #\") - (loop for ch0 = (read-char stream) - until (eql ch0 #\"))) - ((eql ch #\{) - (iincf depth)) - ((eql ch #\}) - (idecf depth))) - until (i= depth 0))))))) - (declare (dynamic-extent #'deserialize #'skip-field)) + (funcall (proto-deserializer msg) val))))))))))))))) + (declare (dynamic-extent #'deserialize)) (deserialize (proto-class message) message))) + +(defun skip-field (stream) + "Skip either a token or a balanced {}-pair." + (ecase (peek-char nil stream nil) + ((#\:) + (read-char stream) + (skip-whitespace stream) + (parse-token-or-string stream)) + ((#\{) + (let ((depth 0)) + (loop for ch = (read-char stream) + do (cond ((eql ch #\") + (loop for ch0 = (read-char stream) + until (eql ch0 #\"))) + ((eql ch #\{) + (iincf depth)) + ((eql ch #\}) + (idecf depth))) + until (i= depth 0))))))