- (loop
- (skip-whitespace stream)
- (maybe-skip-comments stream)
- (let ((char (peek-char nil stream nil)))
- (cond ((null char)
- (remove-options schema "lisp_package")
- (return-from parse-schema-from-stream schema))
- ((proto-token-char-p char)
- (let ((token (parse-token stream)))
- (cond ((string= token "syntax")
- (parse-proto-syntax stream schema))
- ((string= token "package")
- (parse-proto-package stream schema))
- ((string= token "import")
- (parse-proto-import stream schema))
- ((string= token "option")
- (let* ((option (parse-proto-option stream schema))
- (name (and option (proto-name option)))
- (value (and option (proto-value option))))
- (when (and option (option-name= name "lisp_package"))
- (let ((package (or (find-proto-package value) *protobuf-package*)))
- (setf (proto-lisp-package schema) value)
- (setq *protobuf-package* package)))))
- ((string= token "enum")
- (parse-proto-enum stream schema))
- ((string= token "extend")
- (parse-proto-extend stream schema))
- ((string= token "message")
- (parse-proto-message stream schema))
- ((string= token "service")
- (parse-proto-service stream schema)))))
- (t
- (error "Syntax error at position ~D" (file-position stream))))))))
+ (labels ((ensure-package ()
+ "Find a fallback for our Lisp package if we don't have an obvious one already.
+ * java_package
+ * *package*"
+ (unless *protobuf-package*
+ (let ((java-package (find-option schema "java_package")))
+ (if java-package
+ (set-lisp-package schema java-package)
+ (setq *protobuf-package* *package*)))))
+ (ensure-rpc-package ()
+ (ensure-package)
+ (unless *protobuf-rpc-package*
+ (let ((rpc-package-name (format nil "~A-~A" (package-name *protobuf-package*) 'rpc)))
+ (setq *protobuf-rpc-package*
+ (or (find-proto-package rpc-package-name)
+ (make-package (string-upcase rpc-package-name) :use ())))))))
+ (loop
+ (skip-whitespace stream)
+ (maybe-skip-comments stream)
+ (let ((char (peek-char nil stream nil)))
+ (cond ((null char)
+ (remove-options schema "lisp_package")
+ (resolve-lisp-names schema)
+ (return-from parse-schema-from-stream schema))
+ ((proto-token-char-p char)
+ (let ((token (parse-token stream)))
+ (cond ((string= token "syntax")
+ (parse-proto-syntax stream schema))
+ ((string= token "package")
+ (parse-proto-package stream schema))
+ ((string= token "import")
+ (parse-proto-import stream schema))
+ ((string= token "option")
+ (let* ((option (parse-proto-option stream schema))
+ (name (and option (proto-name option)))
+ (value (and option (proto-value option))))
+ (when (and option (option-name= name "lisp_package"))
+ (set-lisp-package schema value))))
+ ((string= token "enum")
+ (ensure-package)
+ (parse-proto-enum stream schema))
+ ((string= token "extend")
+ (ensure-package)
+ (parse-proto-extend stream schema))
+ ((string= token "message")
+ (ensure-package)
+ (parse-proto-message stream schema))
+ ((string= token "service")
+ (ensure-rpc-package)
+ (parse-proto-service stream schema)))))
+ (t
+ (error "Syntax error at position ~D" (file-position stream)))))))))
+
+(defun set-lisp-package (schema lisp-package-name)
+ "Set the package for generated lisp names of 'schema'."
+ (check-type schema protobuf-schema)
+ (check-type lisp-package-name string)
+ (let ((package (or (find-proto-package lisp-package-name)
+ ;; Try to put symbols into the right package
+ (make-package (string-upcase lisp-package-name) :use ())
+ *protobuf-package*)))
+ (setf (proto-lisp-package schema) lisp-package-name)
+ (setq *protobuf-package* package)))
+
+(defmethod resolve-lisp-names ((schema protobuf-schema))
+ "Recursively resolves Protobuf type names to Lisp type names in the messages and services in 'schema'."
+ (map () #'resolve-lisp-names (proto-messages schema))
+ (map () #'resolve-lisp-names (proto-services schema)))