- (multiple-value-bind (type pclass packed enums)
- (clos-type-to-protobuf-type (find-slot-definition-type class slot) type-filter enum-filter)
- (let* ((ename (and enums
- (format nil "~A-~A" 'enum (slot-definition-name slot))))
- (enum (and enums
- (let* ((names (mapcar #'enum-name->proto enums))
- (prefix (and (> (length names) 1)
- (subseq (first names)
- 0 (mismatch (first names) (second names))))))
- (when (and prefix (> (length prefix) 2)
- (every #'(lambda (name) (starts-with name prefix)) names))
- (setq names (mapcar #'(lambda (name) (subseq name (length prefix))) names)))
- (make-instance 'protobuf-enum
- :name (class-name->proto ename)
- :class (intern ename (symbol-package (slot-definition-name slot)))
- :values (loop for name in names
- for val in enums
- for index upfrom 1
- collect (make-instance 'protobuf-enum-value
- :name name
- :index index
- :value val))))))
- (reqd (clos-type-to-protobuf-required (find-slot-definition-type class slot) type-filter))
- (field (make-instance 'protobuf-field
- :name (slot-name->proto (slot-definition-name slot))
- :type (if enum (class-name->proto ename) type)
- :class (if enum (intern ename (symbol-package (slot-definition-name slot))) pclass)
- :required reqd
- :index index
- :value (slot-definition-name slot)
- :reader (find-slot-definition-reader class slot)
- :default (clos-init-to-protobuf-default (slot-definition-initform slot) value-filter)
- :packed packed)))
- (values field nil enum)))))
+ (multiple-value-bind (expanded-type unexpanded-type)
+ (find-slot-definition-type class slot)
+ (multiple-value-bind (type pclass packed enums)
+ (clos-type-to-protobuf-type expanded-type type-filter enum-filter)
+ (multiple-value-bind (reqd vectorp)
+ (clos-type-to-protobuf-required (find-slot-definition-type class slot) type-filter)
+ (let* ((ename (and enums
+ (if (and unexpanded-type (symbolp unexpanded-type))
+ (symbol-name unexpanded-type)
+ (format nil "~A-~A" 'enum (slot-definition-name slot)))))
+ (etype (and enums
+ (if (and unexpanded-type (symbolp unexpanded-type))
+ unexpanded-type
+ (intern ename (symbol-package (slot-definition-name slot))))))
+ (enum (and enums
+ (let* ((names (mapcar #'enum-name->proto enums))
+ (prefix (and (> (length names) 1)
+ (subseq (first names)
+ 0 (mismatch (first names) (car (last names)))))))
+ (when (and prefix (> (length prefix) 2)
+ (every #'(lambda (name) (starts-with name prefix)) names))
+ (setq names (mapcar #'(lambda (name) (subseq name (length prefix))) names)))
+ (unless (and unexpanded-type (symbolp unexpanded-type))
+ #+ignore ;this happens constantly, the warning is not useful
+ (protobufs-warn "Use DEFTYPE to define a MEMBER type instead of directly using ~S"
+ expanded-type))
+ (let* ((pname (class-name->proto ename))
+ (enum
+ (make-instance 'protobuf-enum
+ :class etype
+ :name pname
+ :qualified-name (make-qualified-name *protobuf* pname)
+ :parent *protobuf*))
+ (values
+ (loop for name in names
+ for val in enums
+ for index upfrom 0
+ collect (make-instance 'protobuf-enum-value
+ :name name
+ :qualified-name (make-qualified-name enum name)
+ :index index
+ :value val
+ :parent enum))))
+ (setf (proto-values enum) values)
+ enum))))
+ (default (if (slot-definition-initfunction slot)
+ (clos-init-to-protobuf-default
+ (slot-definition-initform slot) expanded-type value-filter)
+ (if (eq reqd :repeated)
+ (if vectorp $empty-vector $empty-list)
+ $empty-default)))
+ (field (make-instance 'protobuf-field
+ :name (slot-name->proto (slot-definition-name slot))
+ :type (if enum (class-name->proto ename) type)
+ :class (if enum etype pclass)
+ :required reqd
+ :index index
+ :value (slot-definition-name slot)
+ :reader (let ((reader (find-slot-definition-reader class slot)))
+ ;; Only use the reader if it is "interesting"
+ (unless (string= (symbol-name reader)
+ (format nil "~A-~A"
+ (class-name class) (slot-definition-name slot)))
+ reader))
+ :default default
+ :packed packed)))
+ (values field nil enum)))))))
+
+(defun list-of-list-of ()
+ (let ((list-of-package (find-package 'list-of)))
+ (and list-of-package (find-symbol (string 'list-of) list-of-package))))