add new example 'meshtastic' (WIP!) -- just a proof of concept version

examples/meshtastic/app.asd

@@ -0,0 +1,12 @@
+(defsystem :app
+  :serial t
+  :depends-on (#-depends-loaded :uiop
+               #-depends-loaded :my-cl-protobufs
+               #-depends-loaded :trivial-package-local-nicknames)
+  :components ((:file "lisp/package")
+               (:file "lisp/qt")
+               (:file "lisp/ui-vars")
+               (:file "lisp/radio")
+               (:file "lisp/messages")
+               (:file "lisp/main")))
+

examples/meshtastic/app.pro

@@ -0,0 +1,122 @@
+LISP_FILES = $$files(lisp/*) app.asd make.lisp
+
+android {
+  32bit {
+    ECL = $$(ECL_ANDROID_32)
+  } else {
+    ECL = $$(ECL_ANDROID)
+  }
+  lisp.commands = $$ECL/../ecl-android-host/bin/ecl \
+                  -norc -shell $$PWD/make.lisp
+} else:ios {
+  lisp.commands = $$(ECL_IOS)/../ecl-ios-host/bin/ecl \
+                  -norc -shell $$PWD/make.lisp
+} else:unix {
+  lisp.commands = /usr/local/bin/ecl -shell $$PWD/make.lisp
+} else:win32 {
+  lisp.commands = ecl.exe -shell $$PWD/make.lisp
+}
+
+lisp.input = LISP_FILES
+
+win32:  lisp.output = tmp/app.lib
+!win32: lisp.output = tmp/libapp.a
+
+QMAKE_EXTRA_COMPILERS += lisp
+
+win32:  PRE_TARGETDEPS = tmp/app.lib
+!win32: PRE_TARGETDEPS = tmp/libapp.a
+
+QT          += quick qml bluetooth
+TEMPLATE    = app
+CONFIG      += c++17 no_keywords release
+DEFINES     += DESKTOP_APP INI_LISP INI_ECL_CONTRIB QT_EXTENSION
+INCLUDEPATH = /usr/local/include
+ECL_VERSION = $$lower($$system(ecl -v))
+ECL_VERSION = $$replace(ECL_VERSION, " ", "-")
+LIBS        = -L/usr/local/lib -lecl
+LIBS        += -L/usr/local/lib/$$ECL_VERSION
+LIBS        += -lecl-help -ldeflate -lecl-cdb -lecl-curl -lql-minitar -lsockets
+DESTDIR     = .
+TARGET      = app
+OBJECTS_DIR = tmp
+MOC_DIR     = tmp
+
+linux: LIBS += -L../../../platforms/linux/lib
+macx:  LIBS += -L../../../platforms/macos/lib
+win32: LIBS += -L../../../platforms/windows/lib
+
+win32 {
+  LIBS += -lws2_32
+
+  include(../../src/windows.pri)
+}
+
+android {
+  QT          += androidextras
+  DEFINES     -= DESKTOP_APP
+  INCLUDEPATH = $$ECL/include
+  ECL_VERSION = $$lower($$system($$ECL/../ecl-android-host/bin/ecl -v))
+  ECL_VERSION = $$replace(ECL_VERSION, " ", "-")
+  LIBS        = -L$$ECL/lib -lecl
+  LIBS        += -L$$ECL/lib/$$ECL_VERSION
+  LIBS        += -lecl-help -ldeflate -lecl-cdb -lecl-curl -lql-minitar -lsockets
+  LIBS        += -L../../../platforms/android/lib
+
+  ANDROID_EXTRA_LIBS         += $$ECL/lib/libecl.so
+  ANDROID_PACKAGE_SOURCE_DIR = ../platforms/android
+  ANDROID_MIN_SDK_VERSION    = 21
+  ANDROID_TARGET_SDK_VERSION = 31
+
+  32bit {
+    ANDROID_ABIS = "armeabi-v7a"
+  } else {
+    ANDROID_ABIS = "arm64-v8a"
+  }
+}
+
+ios {
+  DEFINES     -= DESKTOP_APP
+  INCLUDEPATH = $$(ECL_IOS)/include
+  ECL_VERSION = $$lower($$system($ECL_IOS/../ecl-ios-host/bin/ecl -v))
+  ECL_VERSION = $$replace(ECL_VERSION, " ", "-")
+  LIBS        = -L$$(ECL_IOS)/lib -lecl
+  LIBS        += -leclatomic -leclffi -leclgc -leclgmp
+  LIBS        += -L$$(ECL_IOS)/lib/$$ECL_VERSION
+  LIBS        += -lecl-help -ldeflate -lecl-cdb -lecl-curl -lql-minitar -lsockets
+  LIBS        += -L../../../platforms/ios/lib
+
+  QMAKE_INFO_PLIST     = platforms/ios/Info.plist
+  QMAKE_ASSET_CATALOGS += platforms/ios/Assets.xcassets
+
+  launch.files      = platforms/ios/designable.storyboard platforms/img/logo.png
+  QMAKE_BUNDLE_DATA += launch
+}
+
+32bit {
+  LIBS += -llqml32 -llisp32
+} else {
+  LIBS += -llqml -llisp
+}
+
+LIBS        += -Ltmp -lapp
+INCLUDEPATH += ../../../src/cpp
+
+HEADERS += \
+  ../../src/cpp/main.h \
+  cpp/ble.h \
+  cpp/ble_meshtastic.h \
+  cpp/qt.h
+
+SOURCES += \
+  ../../src/cpp/main.cpp \
+  cpp/ble.cpp \
+  cpp/ble_meshtastic.cpp \
+  cpp/qt.cpp
+
+RESOURCES += $$files(qml/*)
+RESOURCES += $$files(i18n/*.qm)
+
+lupdate_only {
+  SOURCES += i18n/tr.h
+}

examples/meshtastic/build-android/.gitignore

@@ -0,0 +1,2 @@
+*
+!.gitignore

examples/meshtastic/build-android/install-run.sh

@@ -0,0 +1,3 @@
+# install/update (keeps app data)
+adb install -r android-build/*.apk
+adb shell am start -n org.qtproject.example.meshtastic/org.qtproject.qt5.android.bindings.QtActivity # Qt5

examples/meshtastic/build-android/log.sh

@@ -0,0 +1,6 @@
+# filter for logcat to show only messages from:
+# * (qlog ...)       in Lisp
+# * console.log(...) in QML
+
+adb logcat -c
+adb logcat -s "[LQML]"

examples/meshtastic/build-ios/.gitignore

@@ -0,0 +1,2 @@
+*
+!.gitignore

examples/meshtastic/build-ios/xcode.sh

@@ -0,0 +1,3 @@
+../../../platforms/ios/cross-compile.sh ../make.lisp
+
+open app.xcodeproj

examples/meshtastic/build/.gitignore

@@ -0,0 +1,2 @@
+*
+!.gitignore

examples/meshtastic/cpp/ble.cpp

@@ -0,0 +1,173 @@
+#include "ble.h"
+#include <QBluetoothAddress>
+#include <QBluetoothDeviceDiscoveryAgent>
+#include <QBluetoothDeviceInfo>
+#include <QBluetoothServiceDiscoveryAgent>
+#include <QList>
+#include <QMetaEnum>
+#include <QTimer>
+#include <QDebug>
+
+BLE::BLE(const QBluetoothUuid& uuid) : mainServiceUuid(uuid) {
+  discoveryAgent = new QBluetoothDeviceDiscoveryAgent();
+  discoveryAgent->setLowEnergyDiscoveryTimeout(5000);
+
+  connect(discoveryAgent, &QBluetoothDeviceDiscoveryAgent::deviceDiscovered,
+          this, &BLE::addDevice);
+  connect(discoveryAgent, QOverload<QBluetoothDeviceDiscoveryAgent::Error>::of(&QBluetoothDeviceDiscoveryAgent::error),
+          this, &BLE::deviceScanError);
+  connect(discoveryAgent, &QBluetoothDeviceDiscoveryAgent::finished, this, &BLE::deviceScanFinished);
+
+  QTimer::singleShot(0, this, &BLE::startDeviceDiscovery);
+}
+
+void BLE::startDeviceDiscovery() {
+  devices.clear();
+  qDebug() << "scanning for devices...";
+  discoveryAgent->start(QBluetoothDeviceDiscoveryAgent::LowEnergyMethod);
+}
+
+void BLE::addDevice(const QBluetoothDeviceInfo& device) {
+  if (deviceFilter(device)) {
+    qDebug() << "device added: " << device.name();
+  }
+}
+
+void BLE::deviceScanFinished() {
+  const QList<QBluetoothDeviceInfo> found = discoveryAgent->discoveredDevices();
+  for (auto device : found) {
+    if (deviceFilter(device)) {
+      devices << device;
+    }
+  }
+  if (devices.isEmpty()) {
+    qDebug() << "no BLE devices found";
+  } else {
+    qDebug() << "device scan done";
+  }
+  QTimer::singleShot(0, this, &BLE::scanServices);
+}
+
+void BLE::scanServices() {
+  if (devices.isEmpty()) {
+    return;
+  }
+  if (!currentDevice.isValid()) {
+    currentDevice = devices.at(0);
+  }
+  services.clear();
+  qDebug() << "connecting to device...";
+  if (controller && (previousAddress != currentDevice.address())) {
+    Q_EMIT deviceDisconnecting();
+    controller->disconnectFromDevice();
+    delete controller;
+    controller = nullptr;
+  }
+
+  if (!controller) {
+    controller = QLowEnergyController::createCentral(currentDevice);
+    connect(controller, &QLowEnergyController::connected,
+            this, &BLE::deviceConnected);
+    connect(controller, QOverload<QLowEnergyController::Error>::of(&QLowEnergyController::error),
+            this, &BLE::errorReceived);
+    connect(controller, &QLowEnergyController::disconnected,
+            this, &BLE::deviceDisconnected);
+    connect(controller, &QLowEnergyController::serviceDiscovered,
+            this, &BLE::addLowEnergyService);
+    connect(controller, &QLowEnergyController::discoveryFinished,
+            this, &BLE::serviceScanDone);
+  }
+
+  controller->connectToDevice();
+  previousAddress = currentDevice.address();
+}
+
+void BLE::setCurrentDevice(const QBluetoothDeviceInfo& device) {
+  if (device != currentDevice) {
+    currentDevice = device;
+    scanned = false;
+    retryScan();
+  }
+}
+
+void BLE::addLowEnergyService(const QBluetoothUuid& serviceUuid) {
+  QLowEnergyService* service = controller->createServiceObject(serviceUuid);
+  if (!service) {
+    qDebug() << "cannot create service for UUID";
+    return;
+  }
+  services << service;
+
+  if (serviceUuid == mainServiceUuid) {
+    mainService = service;
+  }
+}
+
+void BLE::serviceScanDone() {
+  scanned = true;
+  Q_EMIT mainServiceReady();
+  qDebug() << "service scan done";
+}
+
+void BLE::connectToService(const QString& uuid) {
+  QLowEnergyService* service = nullptr;
+  for (auto s: qAsConst(services)) {
+    if (s->serviceUuid().toString() == uuid) {
+      service = s;
+      break;
+    }
+  }
+
+  if (!service) {
+    return;
+  }
+
+  if (service->state() == QLowEnergyService::DiscoveryRequired) {
+    service->discoverDetails();
+    qDebug() << "discovering details...";
+    return;
+  }
+}
+
+void BLE::deviceConnected() {
+  connected = true;
+  controller->discoverServices();
+}
+
+void BLE::retryScan() {
+  if (connected && !scanned) {
+    QTimer::singleShot(0, this, &BLE::scanServices);
+  }
+}
+
+void BLE::errorReceived(QLowEnergyController::Error) {
+  qDebug() << "BLE error: " << controller->errorString();
+  retryScan();
+}
+
+void BLE::disconnectFromDevice() {
+  if (controller->state() != QLowEnergyController::UnconnectedState) {
+    controller->disconnectFromDevice();
+  } else {
+    deviceDisconnected();
+  }
+}
+
+void BLE::deviceDisconnected() {
+  connected = false;
+  qDebug() << "disconnect from device";
+}
+
+void BLE::deviceScanError(QBluetoothDeviceDiscoveryAgent::Error error) {
+  if (error == QBluetoothDeviceDiscoveryAgent::PoweredOffError) {
+    qDebug() << "the Bluetooth adaptor is powered off, power it on before doing discovery";
+  } else if (error == QBluetoothDeviceDiscoveryAgent::InputOutputError) {
+    qDebug() << "writing or reading from the device resulted in an error";
+  } else {
+    static QMetaEnum qme = discoveryAgent->metaObject()->enumerator(
+           discoveryAgent->metaObject()->indexOfEnumerator("Error"));
+    qDebug() << "error: " + QLatin1String(qme.valueToKey(error));
+  }
+  retryScan();
+}
+

examples/meshtastic/cpp/ble.h

@@ -0,0 +1,68 @@
+// inspired by Qt5 example 'lowenergyscanner'
+
+#pragma once
+
+#include <QObject>
+#include <QVariant>
+#include <QList>
+#include <QBluetoothServiceDiscoveryAgent>
+#include <QBluetoothDeviceDiscoveryAgent>
+#include <QLowEnergyController>
+#include <QBluetoothServiceInfo>
+
+class BLE: public QObject {
+  Q_OBJECT
+
+public:
+  BLE(const QBluetoothUuid& = QBluetoothUuid()); // pass 'mainServiceUuid'
+
+  /*** <INTERFACE> **********************************************************/
+
+  // main service and its UUID
+  QLowEnergyService* mainService = nullptr;
+  QBluetoothUuid mainServiceUuid; // see constructor
+
+  // current device
+  QBluetoothDeviceInfo currentDevice; // if not defined, first one discovered
+  QList<QBluetoothDeviceInfo> devices;
+  void setCurrentDevice(const QBluetoothDeviceInfo&);
+
+  // custom device filter (e.g. name filter)
+  virtual bool deviceFilter(const QBluetoothDeviceInfo&) { return true; }
+
+Q_SIGNALS:
+  // notify
+  void mainServiceReady();
+  void deviceDisconnecting();
+
+  /*** </INTERFACE> *********************************************************/
+
+public Q_SLOTS:
+  void startDeviceDiscovery();
+  void scanServices();
+  void connectToService(const QString&);
+  void disconnectFromDevice();
+
+private Q_SLOTS:
+  // QBluetoothDeviceDiscoveryAgent related
+  void addDevice(const QBluetoothDeviceInfo&);
+  void deviceScanFinished();
+  void deviceScanError(QBluetoothDeviceDiscoveryAgent::Error);
+
+  // QLowEnergyController realted
+  void addLowEnergyService(const QBluetoothUuid&);
+  void deviceConnected();
+  void errorReceived(QLowEnergyController::Error);
+  void serviceScanDone();
+  void deviceDisconnected();
+
+private:
+  void retryScan();
+  QBluetoothDeviceDiscoveryAgent* discoveryAgent;
+  QList<QLowEnergyService*> services;
+  QBluetoothAddress previousAddress;
+  QLowEnergyController* controller = nullptr;
+  bool connected = false;
+  bool scanned = false;
+};
+

examples/meshtastic/cpp/ble_meshtastic.cpp

@@ -0,0 +1,157 @@
+#include "ble_meshtastic.h"
+#include <QMetaEnum>
+#include <QTimer>
+
+#ifdef PLUGIN
+  #include <ecl_fun_plugin.h>
+#else
+  #include <ecl_fun.h>
+#endif
+
+// service
+const UUID BLE_ME::uuid_service   = UUID(STR("{6ba1b218-15a8-461f-9fa8-5dcae273eafd}"));
+
+// characteristics
+const UUID BLE_ME::uuid_toRadio   = UUID(STR("{f75c76d2-129e-4dad-a1dd-7866124401e7}"));
+const UUID BLE_ME::uuid_fromRadio = UUID(STR("{2c55e69e-4993-11ed-b878-0242ac120002}"));
+const UUID BLE_ME::uuid_fromNum   = UUID(STR("{ed9da18c-a800-4f66-a670-aa7547e34453}"));
+
+BLE_ME::BLE_ME() : BLE(uuid_service) {
+  connect(this, &BLE::mainServiceReady, this, &BLE_ME::ini);
+  connect(this, &BLE::deviceDisconnecting, this, &BLE_ME::disconnecting);
+
+#ifdef PLUGIN
+  ini_lisp();
+#endif
+}
+
+bool BLE_ME::deviceFilter(const QBluetoothDeviceInfo& info) {
+  return info.name().contains("meshtastic", Qt::CaseInsensitive) &&
+         (info.coreConfigurations() & QBluetoothDeviceInfo::LowEnergyCoreConfiguration);
+}
+
+void BLE_ME::ini() {
+  connect(mainService, &QLowEnergyService::stateChanged,
+          this, &BLE_ME::serviceStateChanged);
+  connect(mainService, &QLowEnergyService::characteristicChanged,
+          this, &BLE_ME::characteristicChanged);
+  connect(mainService, &QLowEnergyService::characteristicRead,
+          this, &BLE_ME::characteristicRead);
+  connect(mainService, &QLowEnergyService::characteristicWritten,
+          this, &BLE_ME::characteristicWritten);
+  connect(mainService, QOverload<QLowEnergyService::ServiceError>::of(&QLowEnergyService::error),
+          this, &BLE_ME::serviceError);
+
+  connect(mainService, &QLowEnergyService::descriptorWritten,
+          [](const QLowEnergyDescriptor&, const QByteArray& value) {
+            qDebug() << "notifications changed:" << value;
+          });
+
+  if (mainService->state() == QLowEnergyService::DiscoveryRequired) {
+    qDebug() << "discovering details...";
+    mainService->discoverDetails();
+  } else {
+    searchCharacteristics();
+  }
+}
+
+void BLE_ME::serviceStateChanged(QLowEnergyService::ServiceState state) {
+  qDebug() << "service state changed:" << state;
+  if (state == QLowEnergyService::ServiceDiscovered) {
+    searchCharacteristics();
+  }
+}
+
+void BLE_ME::searchCharacteristics() {
+  qDebug() << "searching characteristics...";
+  const auto characteristics = mainService->characteristics();
+  for (auto ch : characteristics) {
+    if (ch.isValid()) {
+      if ((ch.properties() & QLowEnergyCharacteristic::Write) &&
+          (ch.uuid() == uuid_toRadio)) {                         // toRadio
+        toRadio = ch;
+        qDebug() << "...found 'toRadio'";
+      }
+      if (ch.properties() & QLowEnergyCharacteristic::Read) {
+        if (ch.uuid() == uuid_fromRadio) {                       // fromRadio
+          fromRadio = ch;
+          qDebug() << "...found 'fromRadio'";
+        } else if (ch.uuid() == uuid_fromNum) {
+          fromNum = ch;
+          qDebug() << "...found 'fromNum'";                      // fromNum
+
+          // enable notifications
+          notifications = ch.descriptor(QBluetoothUuid::ClientCharacteristicConfiguration);
+          if (notifications.isValid()) {
+            qDebug() << "enabling notifications...";
+            mainService->writeDescriptor(notifications, QByteArray::fromHex("0100"));
+          }
+        }
+      }
+    }
+  }
+
+  if (toRadio.isValid() && fromRadio.isValid() && fromNum.isValid()) {
+    ecl_fun("radio:set-ready");
+  }
+}
+
+void BLE_ME::characteristicChanged(const QLowEnergyCharacteristic&,
+                                   const QByteArray& data) {
+  if (!data.isEmpty()) {
+    ecl_fun("radio:received-from-radio", data, "notified");
+  }
+}
+
+void BLE_ME::characteristicRead(const QLowEnergyCharacteristic&,
+                                const QByteArray& data) {
+  if (data.isEmpty()) {
+    ecl_fun("radio:receiving-done");
+  } else {
+    ecl_fun("radio:received-from-radio", data);
+    QTimer::singleShot(0, this, &BLE_ME::read);
+  }
+}
+
+void BLE_ME::characteristicWritten(const QLowEnergyCharacteristic&,
+                                   const QByteArray&) {
+  QTimer::singleShot(0, this, &BLE_ME::read);
+}
+
+void BLE_ME::serviceError(QLowEnergyService::ServiceError error) {
+  static QMetaEnum qme = mainService->metaObject()->enumerator(
+                         mainService->metaObject()->indexOfEnumerator("ServiceError"));
+  qDebug() << "service error:" << QLatin1String(qme.valueToKey(error));
+}
+
+// read/write
+
+void BLE_ME::read() {
+  if ((mainService != nullptr) && fromRadio.isValid()) {
+    // will call 'characteristicRead()' on success
+    mainService->readCharacteristic(fromRadio);
+  } else {
+    qDebug() << "not ready to read";
+  }
+}
+
+void BLE_ME::write(const QByteArray& data) {
+  if ((mainService != nullptr) && toRadio.isValid()) {
+    // will call 'characteristicWritten()' on success
+    mainService->writeCharacteristic(toRadio, data);
+  } else {
+    qDebug() << "not ready to write";
+  }
+}
+
+// on device disconnect
+
+void BLE_ME::disconnecting() {
+  if ((mainService != nullptr) && notifications.isValid()) {
+    // disable notifications
+    mainService->writeDescriptor(notifications, QByteArray::fromHex("0000"));
+  }
+  ecl_fun("radio:set-ready", false);
+  delete mainService; mainService = nullptr;
+}
+

examples/meshtastic/cpp/ble_meshtastic.h

@@ -0,0 +1,39 @@
+#pragma once
+
+#include "ble.h"
+
+#define UUID QBluetoothUuid
+#define STR  QStringLiteral
+
+class BLE_ME : public BLE {
+  Q_OBJECT
+
+public:
+  BLE_ME();
+
+  static const UUID uuid_service;
+  static const UUID uuid_fromRadio;
+  static const UUID uuid_fromNum;
+  static const UUID uuid_toRadio;
+
+  QLowEnergyCharacteristic fromRadio;
+  QLowEnergyCharacteristic fromNum;
+  QLowEnergyCharacteristic toRadio;
+
+  QLowEnergyDescriptor notifications;
+
+  bool deviceFilter(const QBluetoothDeviceInfo&) override;
+  
+  void write(const QByteArray&);
+  void searchCharacteristics();
+
+public Q_SLOTS:
+  void ini();
+  void read();
+  void serviceStateChanged(QLowEnergyService::ServiceState);
+  void characteristicChanged(const QLowEnergyCharacteristic&, const QByteArray&);
+  void characteristicRead(const QLowEnergyCharacteristic&, const QByteArray&);
+  void characteristicWritten(const QLowEnergyCharacteristic&, const QByteArray&);
+  void serviceError(QLowEnergyService::ServiceError);
+  void disconnecting();
+};

examples/meshtastic/cpp/qt.cpp

@@ -0,0 +1,29 @@
+#include "qt.h"
+#include "ble_meshtastic.h"
+#include <QtDebug>
+
+QT_BEGIN_NAMESPACE
+
+QObject* ini() {
+  static QObject* qt = nullptr;
+  if (qt == nullptr) {
+    qt = new QT;
+  }
+  return qt;
+}
+
+QT::QT() : QObject() {
+  ble = new BLE_ME;
+}
+
+QVariant QT::read2() {
+  ble->read();
+  return QVariant();
+}
+
+QVariant QT::write2(const QVariant& bytes) {
+  ble->write(bytes.toByteArray());
+  return QVariant();
+}
+
+QT_END_NAMESPACE

examples/meshtastic/cpp/qt.h

@@ -0,0 +1,30 @@
+#pragma once
+
+#include <QtCore>
+
+#ifdef Q_CC_MSVC
+#define LIB_EXPORT __declspec(dllexport)
+#else
+#define LIB_EXPORT
+#endif
+
+class BLE_ME;
+
+QT_BEGIN_NAMESPACE
+
+extern "C" { LIB_EXPORT QObject* ini(); }
+
+class QT : public QObject {
+  Q_OBJECT
+
+public:
+  // BLE_ME
+  Q_INVOKABLE QVariant read2();
+  Q_INVOKABLE QVariant write2(const QVariant&);
+
+  QT();
+
+  BLE_ME* ble;
+};
+
+QT_END_NAMESPACE

examples/meshtastic/cpp/qt.pro

@@ -0,0 +1,34 @@
+QT          += bluetooth
+TEMPLATE    = lib
+CONFIG      += c++17 plugin release no_keywords
+DEFINES     += PLUGIN
+INCLUDEPATH = /usr/local/include ../../../src/cpp
+LIBS        = -L/usr/local/lib -lecl
+DESTDIR     = ./
+TARGET      = qt
+OBJECTS_DIR = ./tmp/
+MOC_DIR     = ./tmp/
+
+HEADERS += \
+  ble.h \
+  ble_meshtastic.h \
+  qt.h
+
+SOURCES += \
+  ble.cpp \
+  ble_meshtastic.cpp \
+  qt.cpp
+
+linux {
+  LIBS += -L../../../platforms/linux/lib
+}
+
+macx {
+  LIBS += -L../../../platforms/macos/lib
+}
+
+win32 {
+  include(../../../src/windows.pri)
+
+  LIBS += -L../../../platforms/windows/lib
+}

examples/meshtastic/hacks/float-features.diff

@@ -0,0 +1,76 @@
+diff --git a/_float-features.lisp b/float-features.lisp
+index b377c0d..6d56968 100644
+--- a/_float-features.lisp
++++ b/float-features.lisp
+@@ -334,6 +334,8 @@
+   (ext:single-float-to-bits float)
+   #+cmucl
+   (ldb (byte 32 0) (kernel:single-float-bits float))
++  #+ecl
++  (si:single-float-bits float)
+   #+lispworks
+   (let ((v (sys:make-typed-aref-vector 4)))
+     (declare (optimize (speed 3) (float 0) (safety 0)))
+@@ -344,7 +346,7 @@
+   (mezzano.extensions:single-float-to-ieee-binary32 float)
+   #+sbcl
+   (ldb (byte 32 0) (sb-kernel:single-float-bits float))
+-  #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
++  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+   (progn float (error "Implementation not supported.")))
+ 
+ (declaim (ftype (function (T) (unsigned-byte 64)) double-float-bits))
+@@ -364,6 +366,8 @@
+   (ldb (byte 64 0)
+    (logior (kernel:double-float-low-bits float)
+            (ash (kernel:double-float-high-bits float) 32)))
++  #+ecl
++  (si:double-float-bits float)
+   #+lispworks
+   (let ((v (sys:make-typed-aref-vector 8)))
+     (declare (optimize (speed 3) (float 0) (safety 0)))
+@@ -378,7 +382,7 @@
+   (ldb (byte 64 0)
+        (logior (sb-kernel:double-float-low-bits float)
+                (ash (sb-kernel:double-float-high-bits float) 32)))
+-  #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
++  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+   (progn float (error "Implementation not supported.")))
+ 
+ (declaim (ftype (function (T) (unsigned-byte 128)) long-float-bits))
+@@ -447,6 +451,8 @@
+   (flet ((s32 (x)
+            (logior x (- (mask-field (byte 1 31) x))) ))
+     (kernel:make-single-float (s32 bits)))
++  #+ecl
++  (si:bits-single-float bits)
+   #+lispworks
+   (let ((v (sys:make-typed-aref-vector 4)))
+     (declare (optimize speed (float 0) (safety 0)))
+@@ -458,7 +464,7 @@
+   #+sbcl
+   (sb-kernel:make-single-float
+    (sb-c::mask-signed-field 32 (the (unsigned-byte 32) bits)))
+-  #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
++  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+   (progn bits (error "Implementation not supported.")))
+ 
+ (declaim (ftype (function (T) double-float) bits-double-float))
+@@ -477,6 +483,8 @@
+            (logior x (- (mask-field (byte 1 31) x))) ))
+     (kernel:make-double-float (s32 (ldb (byte 32 32) bits))
+                               (ldb (byte 32 0) bits)))
++  #+ecl
++  (si:bits-double-float bits)
+   #+lispworks
+   (let ((v (sys:make-typed-aref-vector 8)))
+     (declare (optimize speed (float 0) (safety 0)))
+@@ -491,7 +499,7 @@
+   (sb-kernel:make-double-float
+    (sb-c::mask-signed-field 32 (ldb (byte 32 32) (the (unsigned-byte 64) bits)))
+    (ldb (byte 32 0) bits))
+-  #-(or abcl allegro ccl clasp cmucl lispworks mezzano sbcl)
++  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+   (progn bits (error "Implementation not supported.")))
+ 
+ (declaim (ftype (function (T) long-float) bits-long-float))

examples/meshtastic/hacks/float-features.lisp

@@ -0,0 +1,508 @@
+#|
+ This file is a part of float-features
+ (c) 2018 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
+ Author: Nicolas Hafner <shinmera@tymoon.eu>
+|#
+
+(defpackage #:float-features
+  (:nicknames #:org.shirakumo.float-features)
+  (:use #:cl)
+  (:export
+   #:short-float-positive-infinity
+   #:short-float-negative-infinity
+   #:short-float-nan
+   #:single-float-positive-infinity
+   #:single-float-negative-infinity
+   #:single-float-nan
+   #:double-float-positive-infinity
+   #:double-float-negative-infinity
+   #:double-float-nan
+   #:long-float-positive-infinity
+   #:long-float-negative-infinity
+   #:long-float-nan
+   #:float-infinity-p
+   #:float-nan-p
+   #:with-float-traps-masked
+   #:short-float-bits
+   #:single-float-bits
+   #:double-float-bits
+   #:long-float-bits
+   #:bits-short-float
+   #:bits-single-float
+   #:bits-double-float
+   #:bits-long-float))
+
+(in-package #:org.shirakumo.float-features)
+
+(defconstant short-float-positive-infinity
+  #+ccl 1S++0
+  #+clasp ext:short-float-positive-infinity
+  #+cmucl extensions:short-float-positive-infinity
+  #+ecl ext:short-float-positive-infinity
+  #+mezzano mezzano.extensions:short-float-positive-infinity
+  #+mkcl ext:short-float-positive-infinity
+  #+sbcl sb-ext:short-float-positive-infinity
+  #+lispworks 1S++0
+  #+allegro (coerce excl:*infinity-single* 'short-float)
+  #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks allegro)
+  most-positive-short-float)
+
+(defconstant short-float-negative-infinity
+  #+ccl -1S++0
+  #+clasp ext:short-float-negative-infinity
+  #+cmucl extensions:short-float-negative-infinity
+  #+ecl ext:short-float-negative-infinity
+  #+mezzano mezzano.extensions:short-float-negative-infinity
+  #+mkcl ext:short-float-negative-infinity
+  #+sbcl sb-ext:short-float-negative-infinity
+  #+lispworks -1S++0
+  #+allegro (coerce excl:*negative-infinity-single* 'short-float)
+  #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks allegro)
+  most-negative-short-float)
+
+(defconstant single-float-positive-infinity
+  #+abcl extensions:single-float-positive-infinity
+  #+allegro excl:*infinity-single*
+  #+ccl 1F++0
+  #+clasp ext:single-float-positive-infinity
+  #+cmucl extensions:single-float-positive-infinity
+  #+ecl ext:single-float-positive-infinity
+  #+mezzano mezzano.extensions:single-float-positive-infinity
+  #+mkcl mkcl:single-float-positive-infinity
+  #+sbcl sb-ext:single-float-positive-infinity
+  #+lispworks 1F++0
+  #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks)
+  most-positive-single-float)
+
+(defconstant single-float-negative-infinity
+  #+abcl extensions:single-float-negative-infinity
+  #+allegro excl:*negative-infinity-single*
+  #+ccl -1F++0
+  #+clasp ext:single-float-negative-infinity
+  #+cmucl extensions:single-float-negative-infinity
+  #+ecl ext:single-float-negative-infinity
+  #+mezzano mezzano.extensions:single-float-negative-infinity
+  #+mkcl mkcl:single-float-negative-infinity
+  #+sbcl sb-ext:single-float-negative-infinity
+  #+lispworks -1F++0
+  #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks)
+  most-negative-single-float)
+
+(defconstant double-float-positive-infinity
+  #+abcl extensions:double-float-positive-infinity
+  #+allegro excl:*infinity-double*
+  #+ccl 1D++0
+  #+clasp ext:double-float-positive-infinity
+  #+cmucl extensions:double-float-positive-infinity
+  #+ecl ext:double-float-positive-infinity
+  #+mezzano mezzano.extensions:double-float-positive-infinity
+  #+mkcl mkcl:double-float-positive-infinity
+  #+sbcl sb-ext:double-float-positive-infinity
+  #+lispworks 1D++0
+  #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks)
+  most-positive-double-float)
+
+(defconstant double-float-negative-infinity
+  #+abcl extensions:double-float-negative-infinity
+  #+allegro excl:*negative-infinity-double*
+  #+ccl -1D++0
+  #+clasp ext:double-float-negative-infinity
+  #+cmucl extensions:double-float-negative-infinity
+  #+ecl ext:double-float-negative-infinity
+  #+mezzano mezzano.extensions:double-float-negative-infinity
+  #+mkcl mkcl:double-float-negative-infinity
+  #+sbcl sb-ext:double-float-negative-infinity
+  #+lispworks -1D++0
+  #-(or abcl allegro ccl clasp cmucl ecl mezzano mkcl sbcl lispworks)
+  most-negative-double-float)
+
+(defconstant long-float-positive-infinity
+  #+ccl 1L++0
+  #+clasp ext:long-float-positive-infinity
+  #+cmucl extensions:long-float-positive-infinity
+  #+ecl ext:long-float-positive-infinity
+  #+mezzano mezzano.extensions:long-float-positive-infinity
+  #+mkcl ext:long-float-positive-infinity
+  #+sbcl sb-ext:long-float-positive-infinity
+  #+lispworks 1L++0
+  #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks)
+  most-positive-long-float)
+
+(defconstant long-float-negative-infinity
+  #+ccl -1L++0
+  #+clasp ext:long-float-negative-infinity
+  #+cmucl extensions:long-float-negative-infinity
+  #+ecl ext:long-float-negative-infinity
+  #+mezzano mezzano.extensions:long-float-negative-infinity
+  #+mkcl ext:long-float-negative-infinity
+  #+sbcl sb-ext:long-float-negative-infinity
+  #+lispworks -1L++0
+  #-(or ccl clasp cmucl ecl mezzano mkcl sbcl lispworks)
+  most-negative-long-float)
+
+(declaim (inline float-infinity-p
+                 float-nan-p))
+
+(defun float-infinity-p (float)
+  #+abcl (system:float-infinity-p float)
+  #+allegro (excl:infinityp float)
+  #+ccl (ccl::infinity-p float)
+  #+clasp (ext:float-infinity-p float)
+  #+cmucl (extensions:float-infinity-p float)
+  #+ecl (ext:float-infinity-p float)
+  #+mezzano (mezzano.extensions:float-infinity-p float)
+  #+sbcl (sb-ext:float-infinity-p float)
+  #-(or abcl allegro ccl clasp cmucl ecl mezzano sbcl)
+  (etypecase float
+    (short-float (or (= float short-float-negative-infinity)
+                     (= float short-float-positive-infinity)))
+    (single-float (or (= float single-float-negative-infinity)
+                      (= float single-float-positive-infinity)))
+    (double-float (or (= float double-float-negative-infinity)
+                      (= float double-float-positive-infinity)))
+    (long-float (or (= float long-float-negative-infinity)
+                    (= float long-float-positive-infinity)))))
+
+(defun float-nan-p (float)
+  #+abcl (system:float-nan-p float)
+  #+allegro (excl:nanp float)
+  #+ccl (and (ccl::nan-or-infinity-p float)
+             (not (ccl::infinity-p float)))
+  #+clasp (ext:float-nan-p float)
+  #+cmucl (extensions:float-nan-p float)
+  #+ecl (ext:float-nan-p float)
+  #+mezzano (mezzano.extensions:float-nan-p float)
+  #+sbcl (sb-ext:float-nan-p float)
+  #+lispworks (sys::nan-p float)
+  #-(or abcl allegro ccl clasp cmucl ecl mezzano sbcl lispworks)
+  (/= float float))
+
+(defun keep (list &rest keeps)
+  (loop for item in list
+        when (find item keeps)
+        collect item))
+
+(defmacro with-float-traps-masked (traps &body body)
+  (let ((traps (etypecase traps
+                 ((eql T) '(:underflow :overflow :inexact :invalid :divide-by-zero :denormalized-operand))
+                 (list traps))))
+    #+abcl
+    (let ((previous (gensym "PREVIOUS")))
+      `(let ((,previous (extensions:get-floating-point-modes)))
+         (unwind-protect
+              (progn
+                (extensions:set-floating-point-modes
+                 :traps ',(keep traps :overflow :underflow))
+                NIL ,@body)
+           (apply #'extensions:set-floating-point-modes ,previous))))
+    #+ccl
+    (let ((previous (gensym "PREVIOUS"))
+          (traps (loop for thing in traps
+                       for trap = (case thing
+                                    (:underflow :underflow)
+                                    (:overflow :overflow)
+                                    (:divide-by-zero :division-by-zero)
+                                    (:invalid :invalid)
+                                    (:inexact :inexact))
+                       when trap collect trap)))
+      `(let ((,previous (ccl:get-fpu-mode)))
+         (unwind-protect
+              (progn
+                (ccl:set-fpu-mode
+                 ,@(loop for trap in traps
+                         collect trap collect NIL))
+                NIL ,@body)
+           (apply #'ccl:set-fpu-mode ,previous))))
+    #+clisp
+    (if (find :underflow)
+        `(ext:without-floating-point-underflow
+           ,@body)
+        `(progn
+           ,@body))
+    #+cmucl
+    `(extensions:with-float-traps-masked #+x86 ,traps #-x86 ,(remove :denormalized-operand traps)
+       ,@body)
+    #+ecl
+    (let ((previous (gensym "PREVIOUS")))
+      `(let ((,previous (si::trap-fpe :last T)))
+         (unwind-protect
+              (progn
+                ,@(loop for trap in traps
+                        for keyword = (case trap
+                                        (:underlow :floating-point-underflow)
+                                        (:overflow :floating-point-overflow)
+                                        (:inexact :floating-point-inexact)
+                                        (:invalid :floating-point-invalid)
+                                        (:divide-by-zero :division-by-zero))
+                        when keyword collect `(si::trap-fpe ,keyword T))
+                NIL ,@body)
+           (si::trap-fpe ,previous NIL))))
+    #+clasp
+     `(ext:with-float-traps-masked ,traps
+       ,@body)
+    #+mezzano
+    (let ((previous (gensym "PREVIOUS"))
+          (traps (loop for thing in traps
+                       for trap = (case thing
+                                    (:underflow :underflow)
+                                    (:overflow :overflow)
+                                    (:divide-by-zero :divide-by-zero)
+                                    (:invalid :invalid-operation)
+                                    (:inexact :precision)
+                                    #+x86-64
+                                    (:denormalized-operand :denormal-operand))
+                       when trap collect trap)))
+      `(let ((,previous (mezzano.runtime::get-fpu-mode)))
+         (unwind-protect
+              (progn
+                (mezzano.runtime::set-fpu-mode
+                 ,@(loop for trap in traps
+                         collect trap collect T))
+                NIL ,@body)
+           (apply #'mezzano.runtime::set-fpu-mode ,previous))))
+    #+sbcl
+    `(sb-int:with-float-traps-masked #+x86 ,traps #-x86 ,(remove :denormalized-operand traps)
+       ,@body)
+    #-(or abcl ccl clasp clisp cmucl ecl mezzano sbcl)
+    (declare (ignore traps))
+    #-(or abcl ccl clasp clisp cmucl ecl mezzano sbcl)
+    `(progn ,@body)))
+
+(declaim (inline short-float-bits
+                 single-float-bits
+                 double-float-bits
+                 long-float-bits
+                 bits-short-float
+                 bits-single-float
+                 bits-double-float
+                 bits-long-float))
+
+(declaim (ftype (function (T) (unsigned-byte 16)) short-float-bits))
+(defun short-float-bits (float)
+  (declare (ignorable float))
+  #+mezzano
+  (mezzano.extensions:short-float-to-ieee-binary16 float)
+  #+(or ecl sbcl cmucl allegro ccl
+        (and 64-bit lispworks))
+  (let* ((bits (single-float-bits float))
+         (sign (ldb (byte 1 31) bits))
+         (exp (- (ldb (byte 8 23) bits) 127))
+         (sig (ldb (byte 23 0) bits)))
+    (cond
+      ((or (eql 0s0 float)
+           (< exp -24))
+       ;;underflow
+       (ash sign 15))
+      ((< exp -14)
+       ;; encode as denormal if possible
+       (logior (ash sign 15)
+               0
+               (ash (ldb (byte 11 13)
+                         (logior (ash 1 23) sig))
+                    (+ exp 14))))
+      ((< exp 16)
+       ;; encode directly
+       (logior (ash sign 15)
+               (ash (+ exp 15) 10)
+               (ash sig -13)))
+      ((zerop sig)
+       ;; infinity
+       (if (zerop sign)
+           #b0111110000000000
+           #b1111110000000000))
+      (t
+       ;;NaN
+       (logior (ash sign 15)
+               (ash #x1f 10)
+               (ldb (byte 10 13) sig)))))
+  ;; clisp short-float is 1+8+16
+  ;; 32bit lispworks 5+ is 1+8+??, lw4 only has double
+  ;; not sure about others?
+  #- (or mezzano ecl sbcl cmucl allegro ccl (and 64-bit lispworks))
+  (progn float (error "Implementation not supported.")))
+
+(declaim (ftype (function (T) (unsigned-byte 32)) single-float-bits))
+(defun single-float-bits (float)
+  #+abcl
+  (ldb (byte 32 0) (system:single-float-bits float))
+  #+allegro
+  (multiple-value-bind (high low) (excl:single-float-to-shorts float)
+    (logior low (ash high 16)))
+  #+ccl
+  (ccl::single-float-bits float)
+  #+clasp
+  (ext:single-float-to-bits float)
+  #+cmucl
+  (ldb (byte 32 0) (kernel:single-float-bits float))
+  #+ecl
+  (si:single-float-bits float)
+  #+lispworks
+  (let ((v (sys:make-typed-aref-vector 4)))
+    (declare (optimize (speed 3) (float 0) (safety 0)))
+    (declare (dynamic-extent v))
+    (setf (sys:typed-aref 'single-float v 0) float)
+    (sys:typed-aref '(unsigned-byte 32) v 0))
+  #+mezzano
+  (mezzano.extensions:single-float-to-ieee-binary32 float)
+  #+sbcl
+  (ldb (byte 32 0) (sb-kernel:single-float-bits float))
+  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+  (progn float (error "Implementation not supported.")))
+
+(declaim (ftype (function (T) (unsigned-byte 64)) double-float-bits))
+(defun double-float-bits (float)
+  #+abcl
+  (logior (system::double-float-low-bits float)
+          (ash (system::double-float-high-bits float) 32))
+  #+allegro
+  (multiple-value-bind (s3 s2 s1 s0) (excl:double-float-to-shorts float)
+    (logior s0 (ash s1 16) (ash s2 32) (ash s3 48)))
+  #+ccl
+  (multiple-value-bind (high low) (ccl::double-float-bits float)
+    (logior low (ash high 32)))
+  #+clasp
+  (ext:double-float-to-bits float)
+  #+cmucl
+  (ldb (byte 64 0)
+   (logior (kernel:double-float-low-bits float)
+           (ash (kernel:double-float-high-bits float) 32)))
+  #+ecl
+  (si:double-float-bits float)
+  #+lispworks
+  (let ((v (sys:make-typed-aref-vector 8)))
+    (declare (optimize (speed 3) (float 0) (safety 0)))
+    (declare (dynamic-extent v))
+    (setf (sys:typed-aref 'double-float v 0) float)
+        #+x86-64 (sys:typed-aref '(unsigned-byte 64) v 0)
+        #-x64-64 (logior (sys:typed-aref '(unsigned-byte 32) v 0)
+                         (ash (sys:typed-aref '(unsigned-byte 32) v 4) 32)))
+  #+mezzano
+  (mezzano.extensions:double-float-to-ieee-binary64 float)
+  #+sbcl
+  (ldb (byte 64 0)
+       (logior (sb-kernel:double-float-low-bits float)
+               (ash (sb-kernel:double-float-high-bits float) 32)))
+  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+  (progn float (error "Implementation not supported.")))
+
+(declaim (ftype (function (T) (unsigned-byte 128)) long-float-bits))
+(defun long-float-bits (float)
+  (declare (ignore float))
+  (error "Implementation not supported."))
+
+(declaim (ftype (function (T) short-float) bits-short-float))
+(defun bits-short-float (bits)
+  (declare (ignorable bits))
+  #+mezzano
+  (mezzano.extensions:ieee-binary16-to-short-float bits)
+  #+ (or ecl sbcl cmucl allegro ccl
+         (and 64-bit lispworks))
+
+  (let ((sign (ldb (byte 1 15) bits))
+        (exp (ldb (byte 5 10) bits))
+        (sig (ldb (byte 10 0) bits)))
+    (if (= exp 31)
+        (cond
+          ((not (zerop sig))
+           ;; NaNs
+           (bits-single-float
+            (logior (ash sign 31)
+                    (ash #xff 23)
+                    ;; store in high-bit to preserve quiet/signalling
+                    (ash sig 13))))
+          ;; infinities
+          ((zerop sign)
+           single-float-positive-infinity)
+          (t
+           single-float-negative-infinity))
+        (cond
+          ((= 0 exp sig)
+           ;; +- 0
+           (if (zerop sign) 0s0 -0s0))
+          ((zerop exp)
+           ;; denormals -> single floats
+           (let ((d (- 11 (integer-length sig))))
+             (setf exp (- -14 d))
+             (setf sig (ldb (byte 11 0) (ash sig (1+ d))))
+             (bits-single-float
+              (logior (ash sign 31)
+                      (ash (+ exp 127) 23)
+                      (ash sig #.(- 23 11))))))
+          (t
+           ;; normal numbers
+           (bits-single-float
+            (logior (ash sign 31)
+                    (ash (+ exp #.(+ 127 -15)) 23)
+                    (ash sig #.(- 23 10))))))))
+    #- (or mezzano ecl sbcl cmucl allegro ccl (and 64-bit lispworks))
+  (progn bits (error "Implementation not supported.")))
+
+(declaim (ftype (function (T) single-float) bits-single-float))
+(defun bits-single-float (bits)
+  #+abcl
+  (system:make-single-float bits)
+  #+allegro
+  (excl:shorts-to-single-float (ldb (byte 16 16) bits) (ldb (byte 16 0) bits))
+  #+ccl
+  (ccl::host-single-float-from-unsigned-byte-32 bits)
+  #+clasp
+  (ext:bits-to-single-float bits)
+  #+cmucl
+  (flet ((s32 (x)
+           (logior x (- (mask-field (byte 1 31) x))) ))
+    (kernel:make-single-float (s32 bits)))
+  #+ecl
+  (si:bits-single-float bits)
+  #+lispworks
+  (let ((v (sys:make-typed-aref-vector 4)))
+    (declare (optimize speed (float 0) (safety 0)))
+    (declare (dynamic-extent v))
+    (setf (sys:typed-aref '(unsigned-byte 32) v 0) bits)
+    (sys:typed-aref 'single-float v 0))
+  #+mezzano
+  (mezzano.extensions:ieee-binary32-to-single-float bits)
+  #+sbcl
+  (sb-kernel:make-single-float
+   (sb-c::mask-signed-field 32 (the (unsigned-byte 32) bits)))
+  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+  (progn bits (error "Implementation not supported.")))
+
+(declaim (ftype (function (T) double-float) bits-double-float))
+(defun bits-double-float (bits)
+  #+abcl
+  (system:make-double-float bits)
+  #+allegro
+  (excl:shorts-to-double-float
+   (ldb (byte 16 48) bits) (ldb (byte 16 32) bits) (ldb (byte 16 16) bits) (ldb (byte 16 0) bits))
+  #+ccl
+  (ccl::double-float-from-bits (ldb (byte 32 32) bits) (ldb (byte 32 0) bits))
+  #+clasp
+  (ext:bits-to-double-float bits)
+  #+cmucl
+  (flet ((s32 (x)
+           (logior x (- (mask-field (byte 1 31) x))) ))
+    (kernel:make-double-float (s32 (ldb (byte 32 32) bits))
+                              (ldb (byte 32 0) bits)))
+  #+ecl
+  (si:bits-double-float bits)
+  #+lispworks
+  (let ((v (sys:make-typed-aref-vector 8)))
+    (declare (optimize speed (float 0) (safety 0)))
+    (declare (dynamic-extent v))
+    #+x86-64 (setf (sys:typed-aref '(unsigned-byte 64) v 0) bits)
+    #-x86-64 (setf (sys:typed-aref '(unsigned-byte 32) v 0) (ldb (byte 32 0) bits)
+                   (sys:typed-aref '(unsigned-byte 32) v 4) (ldb (byte 32 32) bits))
+    (sys:typed-aref 'double-float v 0))
+  #+mezzano
+  (mezzano.extensions:ieee-binary64-to-double-float bits)
+  #+sbcl
+  (sb-kernel:make-double-float
+   (sb-c::mask-signed-field 32 (ldb (byte 32 32) (the (unsigned-byte 64) bits)))
+   (ldb (byte 32 0) bits))
+  #-(or abcl allegro ccl clasp cmucl ecl lispworks mezzano sbcl)
+  (progn bits (error "Implementation not supported.")))
+
+(declaim (ftype (function (T) long-float) bits-long-float))
+(defun bits-long-float (bits)
+  (declare (ignore bits))
+  (error "Implementation not supported."))

examples/meshtastic/hacks/readme.md

@@ -0,0 +1,5 @@
+Before applying this patch, please install latest ECL from development branch
+(as of May 2023).
+
+Just copy **float-features** from Quicklisp under
+`~/quicklisp/local-projects/` and apply patch (or copy `float-features.lisp`).

examples/meshtastic/i18n/readme.md

@@ -0,0 +1,31 @@
+
+Translations
+------------
+
+Wrap all strings which need to be translated in either `(tr "")` (Lisp files)
+or `qsTr("")` (QML files).
+
+* compile app (either desktop or mobile, you may need `touch ../app.asd` to
+  force recompilation of all files); this will generate a dummy file `tr.h`,
+  containing all Lisp strings to translate
+
+* run Qt command `lupdate` (here: Spanish, French) for creating the translation
+  source files from both Lisp and QML strings:
+```
+  lupdate ../app.pro -ts es.ts fr.ts
+```
+* translate all `*.ts` files using **Qt Linguist**
+
+* run Qt command `lrelease` to create compiled translation files:
+```
+  lrelease es.ts fr.ts
+```
+* run respective `qmake` again (destop/mobile) in order to include all `*.qm`
+  files (compiled translations)
+
+* next time you compile the app, the translation files will be included as
+  resources in the executable
+
+Now when you launch the app, the translation file matching your system locale
+setting of your platform (see `QLocale`) will be loaded, see `QTranslator` in
+[main.cpp](../../../src/cpp/main.cpp).

examples/meshtastic/lisp/cl-protobufs/LICENSE

@@ -0,0 +1,23 @@
+The MIT License
+
+Copyright (c) 2012-2020 Google LLC
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use, copy,
+modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.

examples/meshtastic/lisp/cl-protobufs/buffers.lisp

@@ -0,0 +1,890 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+;;; This file provides a stream-like abstraction, a BUFFER, that Protobuf serialization
+;;; logic can use to perform a one-pass traversal of the input object tree such that
+;;; all variable-length pieces are properly length-prefixed but without having to
+;;; precompute lengths. This differs from the C implementation of serialization,
+;;; which (by default) requires a pre-pass to compute the lengths for all constituent
+;;; variable-length pieces such as strings and sub-messages.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defparameter $optimize-buffering *optimize-fast-unsafe*)) ; NOLINT
+
+(deftype array-index ()
+  #+sbcl 'sb-int:index
+  #-sbcl `(integer 0 ,(1- array-total-size-limit)))
+
+;; A BUFFER is a linked list of blocks (vectors) of unsigned-byte.
+;; It can more-or-less be thought of as a string-output-stream that accepts
+;; (UNSIGNED-BYTE n) as the element-type, instead of character, and which
+;; allows replacement of previously written bytes. CONCATENATE-BLOCKS
+;; is the analogous operation to GET-OUTPUT-STREAM-STRING. It produces a
+;; single vector of all bytes that were written.
+;; This structure has subtypes for 8-bit octets and 32-bit words.
+(defstruct (buffer (:constructor nil))
+  ;; The current block
+  (block  nil :type (simple-array * 1))
+  ;; Index into current block at which next element may be written.
+  ;; The block is full when index is equal to (LENGTH BLOCK).
+  (index  0   :type (unsigned-byte 28))
+  ;; The entire list of blocks
+  (chain  nil :type cons)
+  ;; The cons cell whose car is BLOCK. This slot acts primarily
+  ;; to optimize nconc onto CHAIN.  It is not necessarily the last
+  ;; cons in CHAIN, but usually it is.
+  (next   nil :type cons)
+  ;; Zero-based absolute position of the first element of this block in
+  ;; the overall output. Updated only when assigning a new BLOCK.
+  (%block-absolute-start 0 :type array-index))
+
+(defmethod print-object ((self buffer) stream)
+  (print-unreadable-object (self stream :type t :identity t)))
+
+;; BUFFER-SAP is a macro because it makes little sense to write a function
+;; that returns a pointer to something that can go stale on you.
+;; Otherwise any extraction of a SAP from the buffer would be reliable only
+;; within the scope of a WITHOUT-GCING or WITH-PINNED-OBJECTS.
+;; It would work as an inline function, but this forces the right behavior.
+#+sbcl
+(defmacro buffer-sap (buffer)
+  `(sb-sys:vector-sap (buffer-block ,buffer)))
+
+(defun-inline buffer-block-capacity (buffer)
+  (declare (optimize (safety 0)))
+  (length (buffer-block buffer)))
+
+(defun-inline buffer-absolute-position (buffer)
+  (i+ (buffer-%block-absolute-start buffer)
+      (buffer-index buffer)))
+
+(defun make-buffer (constructor block)
+  (let ((chain (list block)))
+    (funcall (the function constructor) block chain chain)))
+
+(deftype octet-type () '(unsigned-byte 8))
+(deftype word-buffer-block-type () '(simple-array (unsigned-byte 32) 1))
+
+(defstruct (word-buffer (:include buffer (block nil :type word-buffer-block-type))
+                        (:constructor %make-word-buffer (block chain next))))
+
+(defun make-word-buffer (size)
+  (declare (array-index size))
+  (make-buffer #'%make-word-buffer
+               (make-array size :element-type '(unsigned-byte 32))))
+
+(defstruct (octet-buffer (:include buffer
+                          (block nil :type (simple-array octet-type 1)))
+                         (:constructor %make-octet-buffer (block chain next)))
+  ;; The collection of backpatches is itself a word buffer
+  (backpatches (make-word-buffer 10))
+  ;; When copying a fixed-size wire-level primitive that crosses a block boundary,
+  ;; use the scratchpad first, then copy two subsequences of octets.
+  (scratchpad (make-array 8 :element-type '(unsigned-byte 8)))
+  (n-gap-bytes 0 :type fixnum)
+  (target nil) ; the destination of these octets, a STREAM typically
+  ;; The BUFFER can also pretend to be stream by implementing CHAR-OUT
+  ;; and STRING-OUT methods. The buffer and stream point to each other.
+  ;; The stream is created only if needed. No support for non-SBCL Lisps.
+  #+sbcl
+  (stream nil :type (or null sb-kernel:ansi-stream))
+  ;; The library does not use this slot, but applications may.
+  ;; Because the structure type gets frozen (below) it is impolite/incorrect
+  ;; to create subtypes of it having additional slots.
+  (userdata))
+
+;; This declaration asserts that there wil not be further descendant types,
+;; and promises to the compiler that TYPEP on the two buffer subtypes
+;; need only be a simple EQ check.
+#+sbcl
+(declaim (sb-ext:freeze-type word-buffer octet-buffer))
+
+(defun make-octet-buffer (size &key userdata target)
+  (declare (array-index size))
+  (let ((b (make-buffer #'%make-octet-buffer
+                        (make-array size :element-type 'octet-type))))
+    (setf (octet-buffer-userdata b) userdata
+          (octet-buffer-target b) target)
+    b))
+
+;; Allocate but do not link in a new block of at least MIN-SIZE, which can be zero
+;; for the default growth rate of 1.5x the previous allocation.
+;; A clever way to make an array of the right kind would be to use introspection
+;; on the TYPE of the CURRENT-BLOCK slot. But clever = slow, so use ETYPECASE instead.
+(defun new-block (buffer min-size)
+  (declare (array-index min-size))
+  ;; For testing the algorithm without growth of buffers - to make it more likely that
+  ;; data will span buffers - the new-capacity could be (max min-size 128) or similar.
+  ;; It must never be smaller than the largest primitive type though.
+  (let* ((old-capacity (buffer-block-capacity buffer))
+         (new-capacity
+          (max min-size
+               (min (+ old-capacity (ash old-capacity 1)) 100000))))
+    (etypecase buffer
+      (word-buffer  (make-array new-capacity :element-type '(unsigned-byte 32)))
+      (octet-buffer (make-array new-capacity :element-type 'octet-type)))))
+
+;; After having ensured sufficient space, the "FAST-" output algorithms can avoid
+;; allocating blocks, but might have to advance the block pointer with ADVANCE-BLOCK.
+;; This gets called exponentially less often as block size is automatically grown,
+;; so dot not benefit from being inlined.
+;; Note that this DOES NOT set the 'current-index' slot to 0.
+(declaim (ftype (function (buffer) (values (simple-array octet-type 1) &optional))
+                advance-block))
+(defun advance-block (buffer)
+  (declare #.$optimize-buffering)
+  ;; this INCF generates 6 instructions instead of 1. wth?
+  (incf (buffer-%block-absolute-start buffer)
+        (length (buffer-block buffer)))
+  (let ((tail (cdr (buffer-next buffer))))
+    (setf (buffer-next buffer) tail
+          (buffer-block buffer) (car tail))))
+
+;; Create a new block such that there will be at least N bytes available in
+;; total across the current and new block, given that BUFFER-ENSURE-SPACE [q.v.]
+;; has already decided there is not presently enough space.
+;; The new block's size is the greater of the defecit or the standard growth
+;; amount. If there is zero space in the current block, the new block is set
+;; as the current block, otherwise it is not.
+;; Return true if all data will fit in the current block; NIL otherwise.
+(declaim (ftype (function (t t) (values t &optional)) %buffer-ensure-space))
+(defun %buffer-ensure-space (buffer n)
+  (declare ((and fixnum unsigned-byte) n) #.$optimize-buffering)
+  (let* ((capacity (buffer-block-capacity buffer))
+         (space-remaining (- capacity (buffer-index buffer)))
+         (defecit (the fixnum (- n space-remaining))))
+    ;; There might already be a next-block. This can happen if previous write asked
+    ;; for more space than existed in the current block, but subsequently didn't
+    ;; use any space in the new block. That block can be smaller than what is
+    ;; needed now, but don't drop it - push a new next-block in front.
+    (unless (and (cdr (buffer-next buffer))
+                 (>= (length (the vector (second (buffer-next buffer)))) defecit))
+      (rplacd (buffer-next buffer)
+              (cons (new-block buffer defecit) (cdr (buffer-next buffer)))))
+    (when (zerop space-remaining)
+      (advance-block buffer)
+      ;; 0 serves as a generalized T, meaining all N bytes fit in one block
+      (setf (buffer-index buffer) 0))))
+
+;; Guarantee that BUFFER has room for at least N more elements (words or octets)
+;; considering its current block and possibly one new block.
+;; If all N elements fit into the current block, return true, else return NIL.
+;; If exactly at the end of a block, the return value will be true because
+;; the next block will contain all N bytes.
+;; This inlined wrapper punts to the general case if available space is inadequate.
+;;
+(defun-inline buffer-ensure-space (buffer n)
+  (declare ((and fixnum unsigned-byte) n) #.$optimize-buffering)
+  (or (>= (- (buffer-block-capacity buffer) (buffer-index buffer)) n)
+      (%buffer-ensure-space buffer n)))
+
+;; A SERIALIZED-PROTOBUF is the result of serializing in the one-pass algorithm
+;; and then squashing out any of the gaps that were left by allocating length
+;; prefixes in their largest possible size but not using all bytes.
+;;
+(defstruct (serialized-protobuf
+             (:constructor make-serialized-protobuf
+                           (blocks total-length final-block-length)))
+  blocks
+  total-length
+  final-block-length)
+(defmethod print-object ((self serialized-protobuf) stream)
+  (declare (stream stream))
+  (print-unreadable-object (self stream :type t)
+    (format stream "~D byte~:P" (serialized-protobuf-total-length self))))
+
+(declaim (ftype (function (t t) (values t &optional))
+                word-out octet-out)
+         (inline word-out))
+
+;; Define OCTET-OUT and WORD-OUT on the respective buffer types.
+(macrolet
+    ((define-emitter (name buffer-type element-type)
+       `(defun ,name (buffer val)
+          (declare (,buffer-type buffer) #.$optimize-buffering)
+          (let* ((block (buffer-block buffer))
+                 (index (buffer-index buffer))
+                 (capacity (length block)))
+            ;; Structure's slot type isn't enough to provide type information
+            ;; because of a later setq.
+            (declare ((simple-array ,element-type 1) block))
+            (when (>= index capacity)
+              (incf (buffer-%block-absolute-start buffer) capacity)
+              (setf block
+                    ;; see if space was pre-allocated
+                    (cond ((cdr (buffer-next buffer))
+                           (pop (buffer-next buffer))
+                           (car (buffer-next buffer)))
+                          (t
+                           (let* ((next (new-block buffer 0))
+                                  (cell (list next)))
+                             (setf (cdr (buffer-next buffer)) cell
+                                   (buffer-next buffer) cell)
+                             next)))
+                    (buffer-block buffer) block
+                    index 0))
+            (setf (aref block index) val
+                  (buffer-index buffer) (1+ index))))))
+  (define-emitter word-out word-buffer (unsigned-byte 32))
+  (define-emitter octet-out octet-buffer octet-type))
+
+(defun %fast-octet-out (buffer val)
+  (let ((block (advance-block buffer)))
+    (setf (aref block 0) val
+          (buffer-index buffer) 1)))
+
+;; Perform OCTET-OUT, but if the current block can hold no more,
+;; assume existence of a pre-made next block.
+(defun-inline fast-octet-out (buffer val)
+  (declare (octet-buffer buffer) #.$optimize-buffering)
+  (let* ((block (buffer-block buffer))
+         (index (buffer-index buffer)))
+    (declare ((simple-array octet-type 1) block))
+    (if (i< index (length block))
+        (setf (aref block index) val (buffer-index buffer) (1+ index))
+        (%fast-octet-out buffer val)))) ; punt
+
+;; Rapidly copy all of OCTETS into BUFFER as if by FAST-OCTET-OUT.
+;; Space must have been ensured so that at most one additional block beyond
+;; the current-block is needed.
+;;
+(defun fast-octets-out (buffer octets
+                        &aux (input-length (length octets)))
+  (declare (octet-buffer buffer) (optimize (safety 0))
+           ((simple-array octet-type 1) octets)
+           ((unsigned-byte 32) input-length))
+  (unless (zerop input-length)
+    (let* ((block (buffer-block buffer))
+           (index (buffer-index buffer))
+           (available-space (- (length block) index)))
+      (declare ((simple-array octet-type 1) block))
+      ;; ENSURE-SPACE always leaves room for at least 1 octet in the current block,
+      ;; and even if it left zero this code would still be correct.
+      (let ((n (min available-space input-length)))
+        (replace block octets :start1 index)
+        (incf index n)
+        (decf input-length n))
+      (when (plusp input-length)
+        ;; There is more input. This can only happen if the block's
+        ;; capacity was reached.
+        ;; The starting index of the source of the copy is the number
+        ;; of bytes that were already written into the first block.
+        (replace (advance-block buffer) octets
+                 :start2 available-space)
+        ;; The ending index in the current block is whatever was just
+        ;; copied, since the starting index for writing was 0.
+        (setq index input-length))
+      (setf (buffer-index buffer) index))))
+
+;; Bind ITER to an iterator over WORD-BUFFER in the manner of standard
+;; WITH-{mumble}-ITERATOR macros. Each time ITER is invoked, the next
+;; buffer element will be returned, or NIL if no more remain.
+(defmacro with-word-buffer-iterator ((iterator-name word-buffer) &body body)
+  (with-gensyms (buffer block more-blocks input-pointer input-limit)
+  `(let* ((,buffer, word-buffer)
+          (,block ,(coerce #() 'word-buffer-block-type))
+          ;; if the current block's index is 0, then no blocks were used at all
+          (,more-blocks (unless (zerop (buffer-index ,buffer))
+                          (buffer-chain ,buffer)))
+          (,input-pointer 0)
+          (,input-limit 0))
+     (declare (word-buffer-block-type ,block)
+              (array-index ,input-pointer ,input-limit))
+     (macrolet
+         ((,iterator-name ()
+            `(locally
+                 (declare (optimize (safety 0)))
+               (when (or (i< ,',input-pointer ,',input-limit)
+                         (when ,',more-blocks
+                           (setq ,',block (pop ,',more-blocks)
+                                 ,',input-limit
+                                 (if ,',more-blocks
+                                     (length ,',block)
+                                     (buffer-index ,',buffer))
+                                 ,',input-pointer 0)))
+                 (aref ,',block (prog1 ,',input-pointer (incf ,',input-pointer)))))))
+       ,@body))))
+
+;; Put blank space into an octet buffer so that later we can go back and
+;; patch a length-prefix in.
+;; Return fives values: absolute stream position, the cons cell pointing
+;; to the block in which the first octet would be written, and the index to
+;; that octet, and a pointer to the block in the buffer of deletions that
+;; will be performed on finalization, and a pointer into that block.
+;; Multiple values avoid consing anything to represent saved buffer locations.
+(declaim (ftype (function (t) (values t t t t t &optional))
+                emit-placeholder))
+(defun emit-placeholder (buffer)
+  (declare #.$optimize-buffering)
+  ;; ABS-POS doesn't change even if BUFFER-ENSURE-SPACE advances a block
+  ;; so the first two bindings are actually order-insensitive,
+  ;; but the capturing of BUFFER-NEXT must occur after ENSURE-SPACE.
+  ;; A length-prefix placeholder reserves 4 octets which is enough to represent
+  ;; a 28-bit integer (the other bit of each octet being the "more-to-go" flag).
+  ;; Given the suggested message size limit of a few megabytes, this is fine.
+  (symbol-macrolet ((reserve-bytes 4))
+    (let ((within-block-p (buffer-ensure-space buffer reserve-bytes))
+          (abs-pos (buffer-absolute-position buffer))
+          (blocks (buffer-next buffer))
+          (index (buffer-index buffer)))
+      (setf (buffer-index buffer)
+            (if within-block-p
+                (+ index reserve-bytes)
+                (let ((available-space (- (buffer-block-capacity buffer) index)))
+                  (advance-block buffer)
+                  (- reserve-bytes available-space))))
+      ;; A place is reserved in the deletion buffer to hold a pointer to
+      ;; the place in the octet buffer that will probably be squeezed out.
+      ;; This is done now, so that indices stored are monotonic.
+      ;; Were that not done, and backpatching recorded deletion markers
+      ;; only at the time of making the patch, the deletion markers would
+      ;; not be in ascending order - they would have a "treelike" appearance
+      ;; based on the order in which submessages were completed.
+      (let ((patch-buffer (octet-buffer-backpatches buffer)))
+        (word-out patch-buffer 0)
+        (values abs-pos blocks index
+                (buffer-block patch-buffer)
+                (1- (buffer-index patch-buffer)))))))
+
+;; Patch VAL into the octet buffer by changing the contents of VAL's block at
+;; the specified indices using 'varint' encoding, and also record a pointer
+;; to the range of octets which were reserved for VAL but not consumed by it.
+;; Return the number of bytes used to store VAL.
+(declaim (ftype (function (t t t t t t t) (values fixnum &optional))
+                backpatch-varint))
+(defun backpatch-varint (val buffer abs-pos blocks index pointer-block pointer-index)
+  (declare #.$optimize-buffering)
+  (declare (type (unsigned-byte 32) val)
+           ((simple-array (unsigned-byte 32) 1) pointer-block)
+           (array-index index pointer-index))
+  (let* ((block (first blocks)) (limit (length block)) (count 0))
+    (declare ((simple-array octet-type 1) block) (fixnum count))
+    ;; Seven bits at a time, least significant bits first
+    (loop do (let ((bits (ildb (byte 7 0) val)))
+               (declare (octet-type bits))
+               (setq val (iash val -7))
+               (when (>= index limit)
+                 ;; This doesn't bother updating LIMIT to its "proper" new value.
+                 ;; It can't possibly be any smaller than a varint.
+                 (setf index 0 block (second blocks)))
+               (setf (aref block index) (ilogior bits (if (i= val 0) 0 128)))
+               (iincf index)
+               (incf count))
+       until (i= val 0))
+    ;; Record the location of the backpatch so that the unused bytes can be
+    ;; squashed out later. This is done even if all 4 bytes were used,
+    ;; because a place was aleady reserved in the word-buffer for this backpatch.
+    (cond ((<= count 4)
+           ;; Encode the deletion using 2 bits for the deletion count (0 .. 3)
+           ;; ORed with the index at which to delete shifted left 2 bits.
+           (let ((gap (i- 4 count)))
+             (setf (aref pointer-block pointer-index)
+                   (ilogior (ash (i+ abs-pos count) 2) gap))
+             (incf (octet-buffer-n-gap-bytes buffer) gap)))
+          ((> count 4)
+           (protobuf-error "Backpatch failure on ~S" buffer)))
+    count))
+
+;; Execute BODY, capturing the state of BUFFER at the start, and *unless* a nonlocal
+;; exit occurs, restore the state of the buffer prior to executing the body
+;; and return no value.
+(defmacro with-bookmark ((buffer) &body body)
+  (with-gensyms (block index next abs-pos)
+    `(let ((,block (buffer-block ,buffer))
+           (,index (buffer-index ,buffer))
+           (,next  (buffer-next  ,buffer))
+           (,abs-pos (buffer-%block-absolute-start ,buffer)))
+       ,@body
+       (setf (buffer-block ,buffer) ,block
+             (buffer-index ,buffer) ,index
+             (buffer-next  ,buffer) ,next
+             (buffer-%block-absolute-start ,buffer) ,abs-pos)
+       (values))))
+
+;; Reserve space for a uint32 prior to the start of a variable-length subsequence
+;; of buffer, and also reserve space in the backpatch buffer to point to the space
+;; in the data buffer where unused reserved bytes should be squashed out.
+(defmacro with-placeholder ((buffer &key position) &body body)
+  (let* ((name "PLACEHOLDER")
+         (abs
+          (or position
+              (make-symbol (concatenate 'string name "-OCTET-POSITION"))))
+         (blocks (make-symbol (concatenate 'string name "-OCTET-BLOCKS")))
+         (index (make-symbol (concatenate 'string name "-OCTET-INDEX")))
+         (pointer-block (make-symbol (concatenate 'string name "-POINTER-BLOCK")))
+         (pointer-index (make-symbol (concatenate 'string name "-POINTER-INDEX"))))
+    `(multiple-value-bind (,abs ,blocks ,index ,pointer-block ,pointer-index)
+         (emit-placeholder ,buffer)
+       (macrolet ((backpatch (value)
+                    `(backpatch-varint ,value
+                                       ,',buffer ,',abs ,',blocks ,',index
+                                       ,',pointer-block ,',pointer-index)))
+         ,@body))))
+
+;; A simple wrapper on REPLACE. This function is used only in one place.
+;; It shouldn't be needed, but small copies using REPLACE are slower than a loop.
+;; It turns out that a foreign call to memmove would be faster for 80 bytes or more.
+(defun-inline fast-replace (destination destination-index
+                            source source-index count)
+  (declare (array-index destination-index count)
+           ((simple-array octet-type 1) destination source))
+  (let ((limit (the array-index (+ destination-index count))))
+    (if (< count 40)
+        (loop (setf (aref destination destination-index) (aref source source-index))
+              (incf source-index)
+              (when (eql (incf destination-index) limit) (return)))
+        (replace destination source
+                 :start1 destination-index :end1 limit
+                 :start2 source-index))))
+
+(defvar **empty-word-buffer** (make-word-buffer 0))
+
+;; Given an octet-buffer BUFFER, squeeze out any octets which "do not exist" in
+;; the virtual octet sequence so they no also longer exist in the physical sequence.
+;; After this operation, BUFFER will be ready for direct consumption, such as
+;; by a client or a compression algorithm or file storage.
+(defun compactify-blocks (buffer)
+  (declare #.$optimize-buffering)
+  ;; OUTPUT and INPUT refer to the same block chain, namely the blocks
+  ;; that currently exist in BUFFER.
+  (let* ((input-block-chain (buffer-chain buffer))
+         (output-block-chain input-block-chain)
+         ;; Output blocks are not popped off the chain until
+         ;; advancing beyond the current block. This way the tail
+         ;; can be smashed to NIL when reaching the end of input.
+         (output-block (car output-block-chain))
+         (output-index 0)
+         ;; Setting INPUT-BLOCK now is only for type-correctness of the
+         ;; initial value. It will be set again immediately before reading
+         (input-block (car input-block-chain))
+         (input-index 0) ; block-relative index
+         (input-position 0) ; absolute
+         (deletion-point 0)
+         (deletion-length 0))
+    (declare ((simple-array octet-type 1) output-block input-block)
+             (array-index output-index input-index input-position))
+    ;; Drop any pre-allocated but unused block in the input chain.
+    (when (cdr (buffer-next buffer))
+      (assert (eq (buffer-block buffer) (car (buffer-next buffer))))
+      (rplacd (buffer-next buffer) nil))
+
+    ;; The reason for deferring this POP 'til after the preceding "drop"
+    ;; is that if there were exactly two input blocks, one used and one not
+    ;; used at all, INPUT-BLOCK-CHAIN should become NIL.
+    (setq input-block (pop input-block-chain))
+    (with-word-buffer-iterator
+       (deletion-point-getter (octet-buffer-backpatches buffer))
+     (labels
+            ((find-next-deletion-point ()
+               ;; If the deletion point is one at which no bytes should be deleted -
+               ;; probably impossible as it means a submessage length took >21 bits
+               ;; (= 4 bytes) to encode - skip until finding somewhere to delete,
+               ;; or else finding that there are no further deletion points.
+               (let ((word (deletion-point-getter)))
+                 (if (not word)
+                     (setq deletion-point most-positive-fixnum deletion-length 0)
+                     (let ((n-bytes (logand (the fixnum word) #b11)))
+                       (if (zerop n-bytes)
+                           (find-next-deletion-point)
+                           (setq deletion-point (ash word -2)
+                                 deletion-length n-bytes))))))
+             (next-output-block ()
+               (setq output-block-chain (cdr output-block-chain)
+                     output-block (car output-block-chain)
+                     output-index 0)
+               (length output-block))
+             (copy-to-output (count)
+               (declare ((and fixnum unsigned-byte) count))
+               (when (zerop count)
+                 (return-from copy-to-output))
+               (let ((space-available (- (length output-block) output-index)))
+                 (declare (array-index count space-available))
+                 ;; See if the output needs to be advanced to the next block.
+                 (when (zerop space-available)
+                   (setq space-available (next-output-block)))
+                 ;; Avoid copying until the earlist point at which bytes need to move.
+                 ;; This rapidly skips over blocks that contain only fixed-length data
+                 ;; provided they are the first blocks in the serialized output.
+                 ;; Not likely, but happens.
+                 (when (and (eq output-block input-block)
+                            (eql output-index input-index))
+                   (incf output-index count)
+                   (incf input-index count)
+                   (return-from copy-to-output))
+                 ;; A chunk of input can span more than one block of output due to
+                 ;; variable-length blocks.
+                 (loop
+                    (let ((stride (min count space-available)))
+                      ;; COUNT and SPACE-AVAILABLE are both positive,
+                      ;; so this will copy at least one octet.
+                      (fast-replace output-block output-index
+                                    input-block input-index stride)
+                      (incf output-index stride)
+                      (incf input-index stride)
+                      (if (eql (decf count stride) 0) (return)))
+                    (when (zerop (setq space-available
+                                       (- (length output-block) output-index)))
+                      (setq space-available (next-output-block))))))
+             (compute-input-block-length ()
+               ;; Only the final block is possibly shorter than its allocated length.
+               ;; The others are as long as allocated, each larger than its predecessor.
+               (if input-block-chain
+                   (length input-block)
+                   (buffer-index buffer))))
+      (declare (inline next-output-block compute-input-block-length))
+      (prog ((block-length (compute-input-block-length))
+             (total-deletion-count 0))
+        (declare (array-index block-length total-deletion-count))
+        tippytop
+        (find-next-deletion-point)
+        top
+        (let* ((remaining-length (- block-length input-index))
+               (n-bytes-to-copy
+                (min remaining-length (- deletion-point input-position))))
+          (copy-to-output n-bytes-to-copy)
+          (incf input-position n-bytes-to-copy)) ; absolute
+        (when (eql input-index block-length)
+          (unless input-block-chain
+            (rplacd output-block-chain nil) ; terminate the list
+            ;; Free the unnecessary word-buffer blocks. Also makes additional calls
+            ;; to COMPACTIFY on this buffer do nothing, which seems reasonable.
+            (setf (octet-buffer-backpatches buffer) **empty-word-buffer**)
+            (return (make-serialized-protobuf
+                     (buffer-chain buffer)
+                     (- input-position total-deletion-count)
+                     output-index)))
+          (setq input-block (pop input-block-chain)
+                block-length (compute-input-block-length)
+                input-index 0)
+          (go top))
+        ;; now we must be at a deletion point
+        (unless (and (= input-position deletion-point) (plusp deletion-length))
+          (protobuf-error "Octet buffer compaction bug"))
+        (let ((remaining-length (- block-length input-index)))
+          (if (>= remaining-length deletion-length)
+              (incf input-index deletion-length) ; easy case
+              ;; Skip remainder of this block and start of one more. Deleted ranges
+              ;; never span more than 2 blocks since deletion-length <= 3
+              ;; and blocks are much larger than 3 octets.
+              (setq input-block (pop input-block-chain)
+                    block-length (compute-input-block-length)
+                    input-index (- deletion-length remaining-length))))
+        (incf input-position deletion-length)
+        (incf total-deletion-count deletion-length)
+        (go tippytop))))))
+
+(defun reset-buffer-chain (buffer chain)
+  "Make BUFFER have CHAIN as its list of octet arrays"
+  (setf (buffer-block buffer) (car chain)
+        (buffer-index buffer) 0
+        (buffer-chain buffer) chain
+        (buffer-next buffer)  chain
+        (buffer-%block-absolute-start buffer) 0)
+  ;; Zero-fill, or not. This should depend on SAFETY and/or DEBUG,
+  ;; but there is no way to discover the current policy
+  ;; without using implementation-specific code.
+  #+nil
+  (dolist (block chain)
+    (fill block 0)))
+
+(defun force-to-stream (buffer)
+  "Write the octets currently in BUFFER to its target stream,
+and rewind BUFFER so that it is empty."
+  ;; Before COMPACTIFY-BLOCKS messes up the chain, copy it.
+  ;; Then compactify and copy to the target stream.
+  (let ((chain (copy-list (buffer-chain buffer)))
+        (backpatch-chain (buffer-chain (octet-buffer-backpatches buffer)))
+        (stream (the stream (octet-buffer-target buffer))))
+    (flet ((out-block (block length)
+             (write-sequence block stream :start 0 :end length)))
+      (declare (dynamic-extent #'out-block))
+      (call-with-each-block #'out-block (compactify-blocks buffer)))
+    (reset-buffer-chain buffer chain)
+    (setf (octet-buffer-n-gap-bytes buffer) 0)
+    ;; Heuristically resize the backpatch buffer, trying to avoid subsequent expansion
+    ;; Ideally we would do this only only on the *next* attempted use of the buffer,
+    ;; but that's not as easy as just sizing up now, even if no further write will occur.
+    ;; The worst-case is when the backpatch buffer is never needed again,
+    ;; but was nonetheless resized to be larger. But that's probably not common.
+    (let ((backpatches (octet-buffer-backpatches buffer)))
+      (reset-buffer-chain
+       backpatches
+       (if (cdr backpatch-chain)
+           (list (new-block backpatches
+                            (loop for block in backpatch-chain
+                                  sum (length block))))
+           backpatch-chain)))))
+
+;; Given either a SERIALIZED-PROTOBUF or a BUFFER, return the concatenation
+;; of all BLOCKS.  You probably don't want to do this on an uncompacted BUFFER.
+;; That usually makes no sense in any scenario other than debugging.
+(defun concatenate-blocks (buffer)
+  (multiple-value-bind (total-length blocks)
+      (etypecase buffer
+        (serialized-protobuf
+         (values (serialized-protobuf-total-length buffer)
+                 (serialized-protobuf-blocks buffer)))
+        (buffer
+         (values (loop for (block . rest) on (buffer-chain buffer)
+                       sum (if rest (length (the (simple-array * 1) block))
+                               (buffer-index buffer))
+                       fixnum)
+                 (buffer-chain buffer))))
+    (declare (array-index total-length))
+    (let ((result (make-array total-length :element-type 'octet-type))
+          (index 0))
+      (declare (array-index index))
+      (dolist (block blocks result)
+        (replace result (the (simple-array octet-type 1) block) :start1 index)
+        (incf index (length (the (simple-array * 1) block)))))))
+
+;; Given a BUFFER or a SERIALIZED-PROTOBUF, call FUNCTION once with each
+;; block, passing it also the effective length of the block.
+(defun call-with-each-block (function buffer)
+  (etypecase buffer
+    (serialized-protobuf
+     (let ((blocks (serialized-protobuf-blocks buffer)))
+       (loop
+         (let ((block (car blocks)))
+           (funcall function block
+                    (if (cdr blocks)
+                        (length (the (simple-array * 1) block))
+                        (serialized-protobuf-final-block-length buffer))))
+         (pop blocks)
+         (if (null blocks) (return)))))
+    (buffer
+     (let ((blocks (buffer-chain buffer)))
+       (loop
+         (let ((block (car blocks)))
+           (funcall function block
+                    (if (cdr blocks)
+                        (length (the (simple-array * 1) block))
+                        (buffer-index buffer))))
+         (pop blocks)
+         (if (null blocks) (return)))))))
+
+;;;
+
+#+sbcl
+(declaim (sb-ext:maybe-inline encode-uint32))
+(macrolet ((define-varint-encoder (name reserve-bytes lisp-type
+                                        &optional (expr 'input))
+               `(progn
+                  (declaim (ftype (function (,lisp-type buffer)
+                                            (values (integer 1 ,(or reserve-bytes 5)) &optional))
+                                  ,name))
+                  (defun ,name (input buffer &aux (val ,expr))
+                    (declare (type ,lisp-type input)
+                             (type (unsigned-byte ,(second lisp-type)) val))
+                    ;; The locally declare gives us optimizations inside the locally
+                    ;; but leaves the typechecking in the function.
+                    (locally
+                        (declare #.$optimize-buffering)
+                      ,@(when reserve-bytes
+                          `((buffer-ensure-space buffer ,reserve-bytes)))
+                      (let ((n 0))
+                        (declare (fixnum n))
+                        (loop (let ((bits (ldb (byte 7 0) val)))
+                                (setq val (ash val -7))
+                                (fast-octet-out buffer
+                                                (ilogior bits (if (i= val 0) 0 128)))
+                                (iincf n))
+                              (when (eql val 0) (return n)))))))))
+
+  (define-varint-encoder encode-uint32 5 (unsigned-byte 32))
+  (define-varint-encoder encode-uint64 10 (unsigned-byte 64))
+
+  ;; It is best to keep all occurrences of (LDB (BYTE 64 0) ...) out of calling code
+  ;; because that forces boxing in many cases, and even it if doesn't create a new bignum,
+  ;; it causes generic arithmetic routines to be used.
+  ;; Hiding the LDB operation inside a primitive encoder is better for efficiency.
+  (define-varint-encoder encode-int64  10 (signed-byte 64)
+    ;; On SBCL the LOGAND compiles to nothing.
+    #+sbcl (logand input sb-vm::most-positive-word)
+    #-sbcl (ldb (byte 64 0) input))
+
+  ;; FAST-ENCODE simply omits the call to ENSURE-SPACE and might not be worth keeping
+  (define-varint-encoder fast-encode-uint32 nil (unsigned-byte 32)))
+
+(define-compiler-macro encode-uint32 (&whole form val buffer)
+  (let (encoded-length)
+    (if (and (typep val 'fixnum) (i<= (setq encoded-length (length32 val)) 2))
+        (let ((low7 (logand val #x7F)))
+          (case encoded-length
+            (1 `(progn (octet-out ,buffer ,low7)
+                       1))
+            (2 `(progn (octet-out2 ,buffer ,(logior #x80 low7) ,(ldb (byte 7 7) val))
+                       2))))
+        form)))
+
+;; For encoding an object tag + wire-type, we can compile-time convert ENCODE-UINT32
+;; into a few OCTET-OUT calls. I'll only do this for 1 and 2-octet writes though,
+;; which is enough for field-indices up to (2^14)-1.
+(defun octet-out2 (buffer first second)
+  (octet-out buffer first)
+  (octet-out buffer second))
+
+;;;
+
+;; A BUFFER does not, in general, interact through a stream interface
+;; (WRITE-BYTE, WRITE-SEQUENCE) however there is some support in SBCL
+;; for treating it as though it were a character output stream.
+;; In general it is faster to use OCTET-OUT, however a stream produces
+;; less garbage if the alternative would be to call WRITE-TO-STRING on
+;; something and serialize the resultant string. The buffer can do this
+;; for you as long as you only write ASCII characters, because the
+;; stream mode does not have a UTF-8 encoder. (It could, but doesn't)
+
+#+sbcl
+(progn
+(defstruct (octet-output-stream
+             (:conc-name octet-stream-)
+             ;; Maybe Todo: supply a BOUT (byte-out) handler function.
+             (:include sb-kernel:ansi-stream
+                       ;; "OUT" is the old slot name, "COUT" is the modern name
+                       (#.(if (find-symbol "ANSI-STREAM-OUT" "SB-KERNEL") 'out 'cout)
+                        #'octet-stream-char-out)
+                       (sout #'octet-stream-string-out))
+             (:constructor make-octet-output-stream (buffer)))
+  ;; How many characters should the character producer be permitted to write
+  ;; before we complain about a protocol error.
+  (space-available 0 :type fixnum)
+  (buffer nil :type octet-buffer))
+
+(defun protocol-error (stream)
+  (protobuf-error "Octet stream protocol error on ~S" stream))
+
+(defun octet-stream-char-out (stream character)
+  ;; A streamified BUFFER accept only ASCII characters (for now).
+  ;; This is more of a sanity-check than a limitation, and it's a mild
+  ;; limitation if that- the ENCODE-STRING protobuf serializer performs
+  ;; encoding and doesn't use its BUFFER as a stream. It uses OCTETS-OUT.
+  (unless (<= (char-code character) 127)
+    (protocol-error stream))
+  (octet-out (octet-stream-buffer stream) (char-code character)))
+
+(defun octet-stream-limited-char-out (stream character)
+  (cond ((or (zerop (octet-stream-space-available stream))
+             (> (char-code character) 127))
+         (protocol-error stream))
+        (t
+         (decf (octet-stream-space-available stream))
+         (octet-out (octet-stream-buffer stream) (char-code character)))))
+
+(macrolet ((ansi-stream-char-out-method (x)
+             `(,(or (find-symbol "ANSI-STREAM-COUT" "SB-KERNEL")
+                    (find-symbol "ANSI-STREAM-OUT" "SB-KERNEL"))
+               ,x)))
+(defun octet-stream-string-out (stream string start end)
+  (declare (string string) (array-index start end))
+  (let ((f (ansi-stream-char-out-method stream)))
+    (sb-kernel:with-array-data ((string string) (start start) (end end))
+      (loop for i fixnum from start below end
+            do (funcall f stream (char string i))))))
+
+(defun %get-buffer-stream (buffer)
+  (or (octet-buffer-stream buffer)
+      (setf (octet-buffer-stream buffer) (make-octet-output-stream buffer))))
+
+(declaim (ftype (function (buffer) (values stream &optional))
+                get-unlimited-buffer-stream get-tiny-buffer-stream)
+         (ftype (function (buffer fixnum) (values stream &optional))
+                get-bounded-buffer-stream))
+
+;; Return a stream that accepts any number of characters.
+;; A placeholder must already have been reserved for the length prefix.
+(defun get-unlimited-buffer-stream (buffer)
+  (let ((stream (%get-buffer-stream buffer)))
+    ;; Setting the space to 0 ensures we can't call the 'limited'
+    ;; char out function without getting an obvious failure.
+    (setf (octet-stream-space-available stream) 0
+          (ansi-stream-char-out-method stream) #'octet-stream-char-out)
+    stream))
+
+;; Return a stream that accepts a tiny string. 1 byte is reserved for the length.
+(defun get-tiny-buffer-stream (buffer)
+  (buffer-ensure-space buffer 128) ; 1 byte prefix, <= 127 string characters
+  (fast-octet-out buffer 0) ; easy way to leave a 1-byte space
+  (let ((stream (%get-buffer-stream buffer)))
+    (setf (octet-stream-space-available stream) 127
+          (ansi-stream-char-out-method stream) #'octet-stream-limited-char-out)
+    stream))
+
+;; Return a stream that accepts a known-length string. The length gets encoded first.
+(defun get-bounded-buffer-stream (buffer n-chars)
+  (encode-uint32 n-chars buffer) ; emit the variable-length length prefix
+  (let ((stream (%get-buffer-stream buffer)))
+    (setf (octet-stream-space-available stream) n-chars
+          (ansi-stream-char-out-method stream) #'octet-stream-limited-char-out)
+    stream))
+)
+
+;; WITH-BUFFER-AS-STREAM binds STREAM to a character output stream that when written to
+;; places ASCII characters into BUFFER. There are three cases, listed here
+;; in order from most efficient to least efficient:
+;; 1. (WITH-BUFFER-AS-STREAM (stream buffer :length n)
+;;    Length specified as an integer N (evaluated at runtime) will encode a prefix of N
+;;    then accept N characters. Writing anything other than exactly N will signal an eror.
+;; 2. (WITH-BUFFER-AS-STREAM (stream buffer :length :TINY)
+;;    Length specified as the literal symbol :TINY will leave a 1-byte gap for a prefix.
+;;    (... :length N) where N runtime evaluates to the keyword :TINY is not legal.
+;;    Between 0 and 127 characters may be written, and the prefix will be modified accordingly.
+;;    An error will be signaled if more than 127 characters are written.
+;; 3. (WITH-BUFFER-AS-STREAM (stream buffer) ...)
+;;    No length specified will leave a 4-byte placeholder for an arbitrary length and
+;;    backpatch it in. This relies on buffer compactification in the same way as does
+;;    writing of an unknown-length submessage.
+
+;; In all cases, non-ASCII characters are rejected.
+;; If TAG is supplied, it is encoded prior to the encoding of the string data.
+;; This macro should be used for effect, not value - its return value is undefined.
+
+(defmacro with-buffer-as-stream ((stream-var buffer &key length (tag nil tag-p))
+                                 &body body &environment env)
+  (with-gensyms (start-pos start-block start-index)
+    `(progn
+       ,@(if tag-p `((encode-uint32 ,tag ,buffer)))
+       ,(cond ((not length) ; most general
+               `(with-placeholder (,buffer :position ,start-pos)
+                  (let ((,stream-var (get-unlimited-buffer-stream ,buffer)))
+                    ,@body)
+                  (backpatch
+                   (i- (buffer-absolute-position ,buffer)
+                       ;; Buffer's absolute pos was marked at the first octet of the
+                       ;; placeholder for the varint.
+                       ;; Actual number of chars written is 4 less than that.
+                       ,start-pos 4))))
+              ((eq length :tiny)
+               `(let ((,stream-var (get-tiny-buffer-stream ,buffer))
+                      (,start-block (octet-buffer-block ,buffer))
+                      (,start-index (1- (buffer-index ,buffer))))
+                  ,@body
+                  (locally
+                      ,@(when (sb-c:policy env (= safety 0))
+                          `((declare (optimize (sb-c::insert-array-bounds-checks 0)))))
+                    (setf (aref ,start-block ,start-index)
+                          (i- 127 (octet-stream-space-available ,stream-var))))))
+              (t
+              `(let ((,stream-var (get-bounded-buffer-stream ,buffer ,length)))
+                 ,@body
+                 ,@(when (sb-c:policy env (> safety 0))
+                     ;; The stream will croak upon trying to write >LENGTH chars.
+                     ;; With safety, ensure *exactly* that many were written.
+                     `((unless (zerop (octet-stream-space-available ,stream-var))
+                         (protocol-error ,stream-var))))))))))
+
+) ; end of #+sbcl (PROGN ...)
+
+;; The portable implementation of WITH-BUFFER-AS-STREAM
+#-sbcl
+(defmacro with-buffer-as-stream ((stream-var buffer &key length) &body body)
+  (declare (ignore length))
+  `(let ((,stream-var (make-string-output-stream)))
+     ,@body
+     (encode-string (get-output-stream-string ,stream-var)
+                    ,buffer)))

examples/meshtastic/lisp/cl-protobufs/conditions.lisp

@@ -0,0 +1,48 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+
+(define-condition protobuf-error (simple-error)
+  ()
+  (:documentation
+   "Supertype of all errors explicitly signaled by cl-protobufs.
+    As a subtype of simple-error this accepts :format-control and
+    :format-argumens init keywords."))
+
+(defun protobuf-error (format-control &rest format-arguments)
+  "Signal a protobuf-error using FORMAT-CONTROL and FORMAT-ARGUMENTS to
+   construct the error message."
+  (error 'protobuf-error
+         :format-control format-control
+         :format-arguments format-arguments))
+
+(define-condition unknown-type (protobuf-error)
+  ()
+  (:documentation
+   "Indicates that a non-protobuf object was encountered where a protobuf type
+    (message,enum, scalar etc.) was expected."))
+
+(define-condition unknown-field-type (unknown-type)
+  ()
+  (:documentation
+   "Indicates that an object that isn't a protocol buffer type was encountered
+    while printing, parsing, serializing, or otherwise processing a protocol
+    buffer object."))
+
+(define-condition unknown-field (protobuf-error)
+  ()
+  (:documentation
+   "An unknown field was encountered when parsing a text proto."))
+
+(defun unknown-field-type (type field object)
+  "Signal an unknown-field-type error for TYPE in relation to FIELD. OBJECT
+   is usually the protobuf message being printed or serialized, or the descriptor
+   being parsed."
+  (error 'unknown-field-type
+         :format-control "unknown field type ~S for field ~S in ~S"
+         :format-arguments (list type field object)))

examples/meshtastic/lisp/cl-protobufs/json.lisp

@@ -0,0 +1,680 @@
+;;; Copyright 2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(defpackage #:cl-protobufs.json
+  (:use #:cl
+        #:cl-protobufs
+        #:cl-protobufs.implementation)
+  ;; Shadow fmt from cl-protobufs text-format.
+  (:shadow #:fmt)
+  (:export #:print-json
+           #:parse-json
+           #:fmt)
+  (:local-nicknames
+   (#:pi #:cl-protobufs.implementation)
+   (#:google #:cl-protobufs.google.protobuf)
+   (#:wkt #:cl-protobufs.well-known-types)))
+
+(in-package #:cl-protobufs.json)
+
+;;; This file implements the protobuf JSON parser and printer.
+;;; The exported symbols are parse-json and print-json.
+
+(defun print-json (object &key (pretty-print-p t) (stream *standard-output*)
+                          (camel-case-p t) (numeric-enums-p nil))
+  "Prints a protocol buffer message to a stream in JSON format. The parameters
+CAMEL-CASE-P and NUMERIC-ENUMS-P implement optional JSON printing options:
+https://developers.google.com/protocol-buffers/docs/proto3#json_options.
+
+Parameters:
+  OBJECT: The protocol buffer message to print.
+  PRETTY-PRINT-P: When true, generate line breaks and other human readable output
+    in the json. When false, replace line breaks with spaces.
+  STREAM: The stream to print to.
+  CAMEL-CASE-P: If true print proto field names in camelCase.
+  NUMERIC-ENUMS-P: If true, use enum numeric values rather than names."
+  (print-json-impl object (when pretty-print-p 0) stream camel-case-p numeric-enums-p
+                   nil))
+
+(defun print-json-impl (object indent stream camel-case-p numeric-enums-p
+                        spliced-p)
+  "Prints a protocol buffer message to a stream in JSON format.
+Parameters:
+  OBJECT: The protocol buffer message to print.
+  INDENT: Indent the output by INDENT spaces. If INDENT is NIL, then the
+    output will not be pretty-printed.
+  STREAM: The stream to print to.
+  CAMEL-CASE-P: If true print proto field names in camelCase.
+  NUMERIC-ENUMS-P: If true, use enum numeric values rather than names.
+  SPLICED-P: Prints a protocol buffer object inside of the printing
+    of another protocol buffer object as if they were spliced
+    together. Currently only happens while printing a well-known-type.
+    This happens because we have to print the well-known-type metadata.
+    Example using Any well known type:
+      {
+        \"url\": \"type.googleapis.com/google.protobuf.Struct\",
+        contained-proto
+      }"
+  (let* ((type (type-of object))
+         (message (find-message-descriptor type :error-p t)))
+    ;; If TYPE has a special JSON mapping, use that.
+    (when (special-json-p type)
+      (print-special-json object type stream indent camel-case-p numeric-enums-p)
+      (return-from print-json-impl))
+    (unless spliced-p
+      (format stream "{")
+      (when indent (format stream "~%")))
+    ;; Boolean that tracks if a field is printed. Used for printing commas
+    ;; correctly. If this object is spliced into an existing JSON object, then
+    ;; a field has been already printed, so always print a comma.
+    (let ((field-printed spliced-p))
+      (dolist (field (proto-fields message))
+        (when (if (eq (slot-value field 'pi::kind) :extends)
+                  (has-extension object (slot-value field 'external-field-name))
+                  (has-field object (slot-value field 'pi::external-field-name)))
+          (let* ((name (if camel-case-p
+                           (pi::proto-json-name field)
+                           (proto-name field)))
+                 (type (proto-class field))
+                 (value
+                   (if (eq (slot-value field 'pi::kind) :extends)
+                       (get-extension object (slot-value field 'pi::external-field-name))
+                       (proto-slot-value object (slot-value field 'pi::external-field-name)))))
+            (if field-printed
+                (format stream ",")
+                (setf field-printed t))
+            (if indent
+                (format stream "~&~V,0T\"~A\": " (+ indent 2) name)
+                (format stream "\"~A\":" name))
+            (if (not (eq (proto-label field) :repeated))
+                (print-field-to-json value type (and indent (+ indent 2))
+                                     stream camel-case-p numeric-enums-p)
+                (let (repeated-printed)
+                  (format stream "[")
+                  (pi::doseq (v value)
+                    (if repeated-printed
+                        (format stream ",")
+                        (setf repeated-printed t))
+                    (when indent (format stream "~&~V,0T" (+ indent 4)))
+                    (print-field-to-json v type (and indent (+ indent 4))
+                                         stream camel-case-p numeric-enums-p))
+                  (if indent
+                      (format stream "~&~V,0T]" (+ indent 2))
+                      (format stream "]")))))))
+      (dolist (oneof (pi::proto-oneofs message))
+        (let* ((oneof-data (slot-value object (pi::oneof-descriptor-internal-name oneof)))
+               (set-field (pi::oneof-set-field oneof-data)))
+          (when set-field
+            (let* ((field-desc (aref (pi::oneof-descriptor-fields oneof) set-field))
+                   (type (proto-class field-desc))
+                   (value (pi::oneof-value oneof-data))
+                   (name (if camel-case-p
+                             (pi::proto-json-name field-desc)
+                             (proto-name field-desc))))
+              (if field-printed
+                  (format stream ",")
+                  (setf field-printed t))
+              (if indent
+                  (format stream "~&~V,0T\"~A\": " (+ indent 2) name)
+                  (format stream "\"~A\":" name))
+              (print-field-to-json value type (and indent (+ indent 2))
+                                   stream camel-case-p numeric-enums-p))))))
+    (if indent
+        (format stream "~&~V,0T}" indent)
+        (format stream "}"))))
+
+(defun print-field-to-json (value type indent stream camel-case-p numeric-enums-p)
+  "Print a field to JSON format.
+
+ Parameters:
+  VALUE: The value held by the field
+  TYPE: The proto-class slot of the field.
+  INDENT: If non-nil, the amount to indent when pretty-printing.
+  STREAM: The stream to print to.
+  CAMEL-CASE-P: Passed recursively to PRINT-JSON.
+  NUMERIC-ENUMS-P: Passed recursively to PRINT-ENUM-TO-JSON and PRINT-JSON."
+  (let ((descriptor (or (find-message-descriptor type)
+                        (find-enum-descriptor type)
+                        (find-map-descriptor type))))
+    (cond
+      ((pi::scalarp type)
+       (print-scalar-to-json value type stream))
+      ((typep descriptor 'pi::message-descriptor)
+       (print-json-impl value indent stream camel-case-p numeric-enums-p nil))
+      ((typep descriptor 'pi::enum-descriptor)
+       (print-enum-to-json value type stream numeric-enums-p))
+      ((typep descriptor 'pi::map-descriptor)
+       (print-map-to-json value descriptor indent
+                          stream camel-case-p numeric-enums-p)))))
+
+(defun print-scalar-to-json (value type stream)
+  "Print scalar VALUE of type TYPE to STREAM."
+  (ecase type
+    ((int32 fixed32 uint32 sfixed32 sint32)
+     (format stream "~D" value))
+    ((int64 fixed64 uint64 sfixed64 sint64)
+     (format stream "\"~D\"" value))
+    ((float double-float)
+     (format stream "~F" value))
+    ((string)
+     (format stream "\"~A\"" value))
+    ((boolean)
+     (format stream "~A" (if value "true" "false")))
+    ((byte-vector)
+     (format stream "\"~A\"" (cl-base64:usb8-array-to-base64-string value)))
+    ((keyword)
+     (format stream "\"~A\"" value))
+    ((symbol)
+     (let ((*package* (find-package "COMMON-LISP")))
+       (format stream "\"~S\"" value)))))
+
+(defun print-enum-to-json (value type stream numeric-enums-p)
+  "Print an enum VALUE of type TYPE to STREAM. If NUMERIC-ENUMS-P, then print the enums value
+rather than its name."
+  (when (eql type 'google:null-value)
+    (format stream "null")
+    (return-from print-enum-to-json))
+  (if numeric-enums-p
+      (format stream "~D" (enum-keyword-to-int type value))
+      (format stream "\"~A\"" (pi::enum-name->proto value))))
+
+(defun print-map-to-json (value map-descriptor indent stream camel-case-p numeric-enums-p)
+  "Print a map type to JSON.
+
+Parameters:
+  VALUE: The hash-table to print.
+  MAP-DESCRIPTOR: The map-descriptor of the map.
+  INDENT: If non-nil, the amount to indent when pretty-printing.
+  STREAM: The stream to print to.
+  CAMEL-CASE-P, NUMERIC-ENUMS-P: passed recursively to PRINT-FIELD-TO-JSON."
+  (format stream "{")
+  (when indent (format stream "~%"))
+  (let ((pair-printed nil))
+    (loop for k being the hash-key of value using (hash-value v)
+          do (if pair-printed
+                 (format stream ",")
+                 (setf pair-printed t))
+             (if indent
+                 (format stream "~&~V,0T\"~A\": " (+ indent 2) k)
+                 (format stream "\"~A\":"  (write-to-string k)))
+             (print-field-to-json v (pi::proto-value-type map-descriptor)
+                                  (and indent (+ indent 2)) stream camel-case-p numeric-enums-p)))
+    (if indent
+        (format stream "~&~V,0T}" indent)
+        (format stream "}")))
+
+;;; Parse objects that were serialized using JSON format.
+
+;;; TODO(cgay): replace all assertions here with something that signals a
+;;; subtype of protobuf-error and shows current stream position.
+
+(defun parse-json (type
+                   &key (stream *standard-input*) ignore-unknown-fields-p)
+  "Parses JSON text into a protobuf messsage of type TYPE.
+
+Parameters:
+  TYPE: The object type as a symbol.
+  STREAM: The stream to read from.
+  IGNORE-UNKNOWN-FIELDS-P: If true, then skip fields which are not defined in the
+    message TYPE descriptor. Otherwise, throw an error."
+  (declare (type symbol type))
+  (let ((message (find-message-descriptor type :error-p t)))
+    (parse-json-impl message stream ignore-unknown-fields-p nil)))
+
+(defun parse-json-impl (msg-desc stream ignore-unknown-fields-p spliced-p)
+  "Parse a JSON formatted message with descriptor MSG-DESC from STREAM. If IGNORE-UNKNOWN-FIELDS-P
+is true, then skip fields which are not defined in MSG-DESC. Otherwise, throw an error. If
+SPLICED-P is true, then do not attempt to parse an opening bracket."
+  (declare (type message-descriptor msg-desc))
+  (let ((object (funcall (pi::get-constructor-name
+                          (or (pi::proto-alias-for msg-desc)
+                              (proto-class msg-desc)))))
+        ;; Repeated slot names, tracks which slots need to be nreversed.
+        (rslots ()))
+    (when (special-json-p (proto-class msg-desc))
+      (return-from parse-json-impl
+        (parse-special-json (proto-class msg-desc)
+                            stream
+                            ignore-unknown-fields-p)))
+    (unless spliced-p
+      (pi::expect-char stream #\{))
+    (loop
+      (let* ((name  (pi::parse-string stream))
+             (field (or (find-field-descriptor msg-desc name)
+                        (find-field-descriptor-by-json-name msg-desc name)))
+             (type  (and field (proto-class field)))
+             (slot  (and field (pi::proto-external-field-name field))))
+        (pi::expect-char stream #\:)
+        (if (null field)
+            ;; If FIELD is null, then we assume that MSG-DESC describes a
+            ;; different version of the proto on the wire which doesn't
+            ;; have FIELD, and continue,
+            (if ignore-unknown-fields-p
+                (skip-json-value stream)
+                (error 'unknown-field-type
+                       :format-control "unknown field ~S encountered in message ~S"
+                       :format-arguments (list name msg-desc)))
+            (let (val error-p null-p)
+              (cond
+                ((eql (peek-char nil stream nil) #\n)
+                 (pi::expect-token-or-string stream "null")
+                 (setf null-p t))
+                ((eq (proto-label field) :repeated)
+                 (pi::expect-char stream #\[)
+                 (loop
+                   (multiple-value-bind (data err)
+                       (parse-value-from-json type :stream stream
+                                                   :ignore-unknown-fields-p ignore-unknown-fields-p)
+                     (if err
+                         (setf error-p t)
+                         (push data val)))
+                   (if (eql (peek-char nil stream nil) #\,)
+                       (pi::expect-char stream #\,)
+                       (return)))
+                 (pi::expect-char stream #\]))
+                (t (multiple-value-setq (val error-p)
+                     (parse-value-from-json type
+                                            :stream stream
+                                            :ignore-unknown-fields-p ignore-unknown-fields-p))))
+              (cond
+                (null-p nil)
+                (error-p
+                 (unknown-field-type type field msg-desc)
+                 (return-from parse-json-impl))
+                ((eq (pi::proto-kind field) :map)
+                 (dolist (pair val)
+                   (setf (gethash (car pair) (proto-slot-value object slot))
+                         (cdr pair))))
+                (t
+                 (when slot
+                   (setf (proto-slot-value object slot) val)
+                   (when (eq (proto-label field) :repeated)
+                     (pushnew slot rslots))))))))
+      (if (eql (peek-char nil stream nil) #\,)
+        (pi::expect-char stream #\,)
+        (progn
+          (pi::expect-char stream #\})
+          (dolist (slot rslots)
+            (setf (proto-slot-value object slot)
+                  (nreverse (proto-slot-value object slot))))
+          (return-from parse-json-impl object))))))
+
+(defun parse-value-from-json (type &key (stream *standard-input*) ignore-unknown-fields-p)
+  "Parse a single JSON value of type TYPE from STREAM. IGNORE-UNKNOWN-FIELDS-P is passed
+   to recursive calls to PARSE-JSON-IMPL."
+  (let ((desc (or (find-message-descriptor type)
+                  (find-enum-descriptor type)
+                  (find-map-descriptor type))))
+    (cond ((pi::scalarp type)
+           (case type
+             ((float) (pi::parse-float stream))
+             ((double-float) (pi::parse-double stream :append-d0 t))
+             ((string) (pi::parse-string stream))
+             ((boolean)
+              (let ((token (pi::parse-token stream)))
+                (cond ((string= token "true") t)
+                      ((string= token "false") nil)
+                      ;; Parsing failed, return T as a second
+                      ;; value to indicate a failure.
+                      (t (values nil t)))))
+             ((byte-vector)
+              (cl-base64:base64-string-to-usb8-array (pi::parse-string stream)))
+             (otherwise
+              (if (eql (peek-char nil stream nil) #\")
+                  (let (ret)
+                    (pi::expect-char stream #\")
+                    (setf ret (pi::parse-signed-int stream))
+                    (pi::expect-char stream #\")
+                    ret)
+                  (pi::parse-signed-int stream)))))
+          ((typep desc 'pi::message-descriptor)
+           (parse-json-impl desc stream ignore-unknown-fields-p nil))
+          ((typep desc 'pi::enum-descriptor)
+           (multiple-value-bind (name type-parsed)
+               (pi::parse-token-or-string stream)
+             ;; special handling for well known enum NullValue.
+             (when (eql type 'google:null-value)
+               (if (string= name "null")
+                   (return-from parse-value-from-json :null-value)
+                   (protobuf-error
+                    "~S is not a valid keyword for well-known enum NullValue" name)))
+             (let ((enum (if (eql type-parsed 'symbol)
+                             ;; If the parsed type is a symbol, then the enum was printed
+                             ;; as an integer. Otherwise, it is a string which names a
+                             ;; keyword.
+                             (find (parse-integer name) (pi::enum-descriptor-values desc)
+                                   :key #'pi::enum-value-descriptor-value)
+                             (find (pi::keywordify name)
+                                   (pi::enum-descriptor-values desc)
+                                   :key #'pi::enum-value-descriptor-name))))
+               (and enum (pi::enum-value-descriptor-name enum)))))
+          ;; In the case of maps, return a list of key-value pairs.
+          ((typep desc 'pi::map-descriptor)
+           (pi::expect-char stream #\{)
+           (loop with pairs = ()
+                 with key-type = (pi::proto-key-type desc)
+                 with val-type = (pi::proto-value-type desc)
+                 for pair = (cons nil nil)
+                 do (setf (car pair)
+                          (if (eql key-type 'string)
+                              (pi::parse-string stream)
+                              (parse-integer (pi::parse-string stream))))
+                    (pi::expect-char stream #\:)
+                    (setf (cdr pair) (parse-value-from-json val-type :stream stream))
+                    (push pair pairs)
+                    (if (eql (peek-char nil stream nil) #\,)
+                        (pi::expect-char stream #\,)
+                        (progn
+                          (pi::expect-char stream #\})
+                          (return pairs)))))
+          (t (values nil t)))))
+
+(defun skip-json-value (stream)
+  "Skip a single JSON value in STREAM. This can
+be either an array, object, or primitive."
+  (pi::skip-whitespace stream)
+  (case (peek-char nil stream nil)
+    ((#\{) (skip-json-object stream))
+    ((#\[) (skip-json-array stream))
+    (t (pi::parse-token-or-string stream))))
+
+(defun skip-json-array (stream)
+  "Skip a JSON array in STREAM."
+  (pi::expect-char stream #\[)
+  (loop do (skip-json-value stream)
+           (if (eql (peek-char nil stream nil) #\,)
+               (pi::expect-char stream #\,)
+               (return)))
+  (pi::skip-whitespace stream)
+  (pi::expect-char stream #\]))
+
+(defun skip-json-object (stream)
+  "Skip a JSON object in STREAM."
+  (pi::expect-char stream #\{)
+  (loop do (pi::parse-string stream)
+           (pi::expect-char stream #\:)
+           (skip-json-value stream)
+           (if (eql (peek-char nil stream nil) #\,)
+               (pi::expect-char stream #\,)
+               (return)))
+  (pi::skip-whitespace stream)
+  (pi::expect-char stream #\}))
+
+(defun find-field-descriptor-by-json-name (msg-desc name)
+  "Return the field-descriptor with json-name NAME in MSG-DESC."
+  (or (find name (proto-fields msg-desc) :key #'pi::proto-json-name :test #'string=)
+      (loop for oneof in (pi::proto-oneofs msg-desc)
+              thereis (find name (pi::oneof-descriptor-fields oneof)
+                            :key #'pi::proto-json-name
+                            :test #'string=))))
+
+;; Special JSON mappings for well known types below
+
+(defun special-json-p (type)
+  "Check if the message TYPE has a special JSON mapping."
+  (member type '(google:any
+                 google:timestamp
+                 google:duration
+                 google:struct
+                 google:value
+                 google:field-mask
+                 google:list-value
+                 google:bool-value
+                 google:string-value
+                 google:bytes-value
+                 google:double-value
+                 google:float-value
+                 google:int32-value
+                 google:int64-value
+                 google:u-int32-value
+                 google:u-int64-value)))
+
+(defun wrapper-message->type (type)
+  "For a well known wrapper type TYPE, return the type being wrapped."
+  (ecase type
+    ((google:bool-value) 'boolean)
+    ((google:string-value) 'string)
+    ((google:bytes-value) 'byte-vector)
+    ((google:double-value) 'double-float)
+    ((google:float-value) 'float)
+    ((google:int32-value) 'int32)
+    ((google:int64-value) 'int64)
+    ((google:u-int32-value) 'uint32)
+    ((google:u-int64-value) 'uint64)))
+
+
+(defun print-special-json (object type stream indent camel-case-p numeric-enums-p)
+  "For an OBJECT whose TYPE is a well-known type, print the object's special JSON mapping
+to STREAM. INDENT, CAMEL-CASE-P, and NUMERIC-ENUMS-P are passed recursively to
+PRINT-JSON-IMPL for any types."
+  (declare (type symbol type))
+  (case type
+    ((google:any)
+     (let ((url (google:any.type-url object))
+           (packed-message (wkt:unpack-any object)))
+       (format stream "{")
+       (if indent
+           (format stream "~&~V,0T\"url\": \"~A\"" (+ indent 2) url)
+           (format stream "\"url\": \"~A\"" url))
+       (if (special-json-p (type-of packed-message))
+           ;; special handling for nested special json mapping within an ANY.
+           (progn
+             (if indent
+                 (format stream ",~&~V,0T\"value\": " (+ indent 2))
+                 (format stream ",\"value\":"))
+             (print-special-json packed-message (type-of packed-message) stream
+                                 (and indent (+ indent 2)) camel-case-p numeric-enums-p)
+             (if indent
+                 (format stream "~&~V,0T}" indent)
+                 (format stream "}")))
+           (print-json-impl packed-message indent stream camel-case-p
+                            numeric-enums-p t))))
+    ((google:timestamp)
+     (let* ((nsec (google:timestamp.nanos object))
+            (timestamp (local-time:unix-to-timestamp
+                        (google:timestamp.seconds object)
+                        :nsec nsec))
+            (prefix '((:year 4) #\- (:month 2) #\- (:day 2) #\T
+                      (:hour 2) #\: (:min 2) #\: (:sec 2)))
+            (suffix '(:gmt-offset-or-z))
+            (format (cond ((= nsec 0) (append prefix suffix))
+                          ((= (mod nsec 1000000) 0) (append prefix '(#\. (:msec 3)) suffix))
+                          ((= (mod nsec 1000) 0) (append prefix '(#\. (:usec 6)) suffix))
+                          (t (append prefix '(#\. (:nsec 9)) suffix)))))
+       (format stream "~S" (local-time:format-timestring
+                            nil timestamp
+                            :format format
+                            :timezone local-time:+utc-zone+))))
+    ((google:duration)
+     (let ((seconds (google:duration.seconds object))
+           (nanos (google:duration.nanos object)))
+       (assert (eql (signum seconds) (signum nanos)))
+       (format stream "\"~D.~V,VDs\"" seconds 9 #\0 (abs nanos))))
+    ((google:field-mask)
+     (let ((paths (google:field-mask.paths object)))
+       (format stream "\"~{~a~^,~}\"" (mapcar (lambda (name)
+                                            (pi::camel-case-but-one name '(#\_)))
+                                              paths))))
+    ((google:struct)
+     (let ((field (pi::%find-field-descriptor (find-message-descriptor type) 'google::%fields)))
+       (print-map-to-json (google:fields object) (find-map-descriptor (proto-class field))
+                          indent stream camel-case-p numeric-enums-p)))
+    ((google:list-value)
+     (format stream "[")
+     (loop for print-comma-p = nil then t
+           for value in (google:values object)
+           do (when print-comma-p (format stream ","))
+              (when indent (format stream "~&~V,0T" (+ 2 indent)))
+              (print-field-to-json value 'google:value (and indent (+ indent 2))
+                                   stream camel-case-p numeric-enums-p))
+     (if indent
+         (format stream "~&~V,0T]" indent)
+         (format stream "]")))
+    ((google:value)
+     (let* ((oneof-data (slot-value object 'google::%kind))
+            ;; The wkt Value consists of a single oneof, so the first oneof in the
+            ;; descriptor's list is the one we are looking for.
+            (oneof-desc (first (pi::proto-oneofs (find-message-descriptor type))))
+            (set-field (pi::oneof-set-field oneof-data)))
+       (assert set-field ()
+               "Message ~S must have a set 'kind' oneof as it has well-known-type 'Value'." object)
+       (let* ((field (aref (pi::oneof-descriptor-fields oneof-desc)
+                           (pi::oneof-set-field oneof-data)))
+              (value (pi::oneof-value oneof-data)))
+         (print-field-to-json value (proto-class field)
+                              indent stream camel-case-p numeric-enums-p))))
+    ;; Otherwise, TYPE is a wrapper type.
+    (t (if object
+           (print-scalar-to-json (google:value object)
+                                 (wrapper-message->type type)
+                                 stream)
+           (format stream "null")))))
+
+(defun parse-special-json (type stream ignore-unknown-fields-p)
+  "Parse a well known type TYPE from STREAM. IGNORE-UNKNOWN-FIELDS-P is passed to recursive
+calls to PARSE-JSON-IMPL."
+  ;; If the stream starts with 'n', then the data is NULL. In which case, return NIL.
+  ;; In all cases except the `Value` well-known-type, we return NIL. However, if TYPE is
+  ;; GOOGLE:VALUE, then we return the wrapper enum that represents null as per the spec.
+  (when (eql (peek-char nil stream nil) #\n)
+    (pi::expect-token-or-string stream "null")
+    (return-from parse-special-json
+      (and (eql type 'google:value)
+           (google:make-value :null-value :null-value))))
+  (case type
+    ((google:any)
+     (pi::expect-char stream #\{)
+     (pi::expect-token-or-string stream "url")
+     (pi::expect-char stream #\:)
+     (let* ((type-url (pi::parse-string stream))
+            (type (wkt::resolve-type-url type-url)))
+       (pi::expect-char stream #\,)
+       (if (not (special-json-p type))
+           ;; Parse the remaining elements in the object into a new message, then pack that message.
+           (wkt:pack-any
+            (parse-json-impl (find-message-descriptor type :error-p t)
+                             stream ignore-unknown-fields-p t))
+           ;; If URL names a well-known-type, then the next element in the object has key "VALUE",
+           ;; and the value is the special JSON format. Parse that and close the object.
+           (let (ret)
+             (pi::expect-token-or-string stream "value")
+             (pi::expect-char stream #\:)
+             (setf ret (parse-special-json type stream ignore-unknown-fields-p))
+             (pi::expect-char stream #\})
+             (wkt:pack-any ret)))))
+
+    ((google:timestamp)
+     (let* ((timestring (pi::parse-string stream))
+            (timestamp (local-time:parse-rfc3339-timestring timestring)))
+       (google:make-timestamp
+        :seconds (local-time:timestamp-to-unix timestamp)
+        :nanos (local-time:nsec-of timestamp))))
+
+    ;; Durations can feasibly have 64-bit seconds place, so parsing a float/double is lossy.
+    ((google:duration)
+     (pi::expect-char stream #\")
+     (let ((seconds (pi::parse-signed-int stream)))
+       (ecase (peek-char nil stream nil)
+         ;; Duration has no decimal component.
+         ((#\s)
+          (pi::expect-char stream #\s)
+          (pi::expect-char stream #\")
+          (google:make-duration :seconds seconds))
+         ((#\.)
+          (pi::expect-char stream #\.)
+          ;; Parse the decimal part of the string, and convert to nanoseconds.
+          (let ((remainder (pi::parse-token stream)))
+            (assert (eql (char remainder (1- (length remainder))) #\s)
+                    nil "Duration string ~S.~A does end with \"s\"" seconds remainder)
+            (pi::expect-char stream #\")
+            (let* ((decimals (subseq remainder 0 (1- (length remainder))))
+                   ;; If there are more than 9 decimal points, trim to length 9.
+                   (decimals (if (< 9 (length decimals))
+                                 (subseq decimals 0 10)
+                                 decimals))
+                   (dec-length (length decimals)))
+              (google:make-duration
+               :seconds seconds
+               ;; Nanoseconds are in the range 0 through 999,999,999. Pad the decimal string
+               ;; with 0s to make the string have total length 9.
+               ;; Lastly, multiply by the sign of SECONDS, as NANOS and and SECONDS must
+               ;; have the same sign.
+               :nanos (* (if (= 0 seconds) 1 (signum seconds))
+                         (parse-integer (concatenate 'string
+                                                     decimals
+                                                     (make-string (- 9 dec-length)
+                                                                  :initial-element #\0)))))))))))
+
+    ;; Field masks are in the form \"camelCasePath1,path2,path3\". We need to first split,
+    ;; then convert to proto field name format (lowercase, separated by underscore).
+    ((google:field-mask)
+     (let ((camel-case-paths (pi::split-string (pi::parse-string stream)
+                                                       :separators '(#\,))))
+       (google:make-field-mask
+        :paths (mapcar (lambda (path) (nstring-downcase (pi::uncamel-case path #\_)))
+                       camel-case-paths))))
+
+    ((google:struct)
+     (pi::expect-char stream #\{)
+     (loop with ret = (google:make-struct)
+           for key = (pi::parse-string stream)
+           do (pi::expect-char stream #\:)
+              (setf (google:struct.fields-gethash key ret)
+                    (parse-special-json 'google:value stream ignore-unknown-fields-p))
+              (if (eql (peek-char nil stream nil) #\,)
+                  (pi::expect-char stream #\,)
+                  (progn
+                    (pi::expect-char stream #\})
+                    (return ret)))))
+
+    ((google:list-value)
+     (pi::expect-char stream #\[)
+     (loop with ret = (google:make-list-value)
+           do (multiple-value-bind (data err)
+                  (parse-value-from-json 'google:value
+                                         :stream stream
+                                         :ignore-unknown-fields-p ignore-unknown-fields-p)
+                (if err
+                    (error "Error while parsing well known type VALUE from JSON format.")
+                    (push data (google:list-value.values ret))))
+              (if (eql (peek-char nil stream nil) #\,)
+                  (pi::expect-char stream #\,)
+                  (progn
+                    (pi::expect-char stream #\])
+                    (return ret)))))
+
+    ((google:value)
+     (case (peek-char nil stream nil)
+       ((#\{) (google:make-value
+               :struct-value (parse-special-json 'google:struct stream ignore-unknown-fields-p)))
+       ((#\[) (google:make-value
+               :list-value (parse-special-json 'google:list-value stream ignore-unknown-fields-p)))
+       ((#\") (google:make-value :string-value (pi::parse-string stream)))
+       ((#\t)
+        (pi::expect-token-or-string stream "true")
+        (google:make-value :bool-value t))
+       ((#\f)
+        (pi::expect-token-or-string stream "false")
+        (google:make-value :bool-value nil))
+       ;; Otherwise, the value has type double.
+       (t (google:make-value :number-value (pi::parse-double stream :append-d0 t)))))
+
+    ;; Otherwise, the well known type is a wrapper type.
+    (t (let ((object (funcall (pi::get-constructor-name type)))
+             (value (parse-value-from-json (wrapper-message->type type) :stream stream)))
+         (setf (google:value object) value)
+         object))))
+
+(defun fmt (stream proto colon-p at-sign-p &optional width &rest other-args)
+  "Format command for protobufs
+   ~/cl-protobufs.json:fmt/ emits a non-pretty-printed protobuf of PROTO to STREAM.
+   ~@/cl-protobufs.json:fmt/ emits a pretty-printed protobuf of PROTO to STREAM.
+   COLON-P and AT-SIGN-P are the usual for format directives.
+   WIDTH and OTHER-ARGS are ignored."
+  (declare (ignore width))
+  (cond (other-args (error "FORMAT directive ~~/cl-protobufs.json:fmt/ takes only one argument."))
+        (colon-p (error "FORMAT directive ~~/cl-protobufs.json:fmt/ does not take colons."))
+        (t (print-json proto :stream stream :pretty-print-p at-sign-p))))

examples/meshtastic/lisp/cl-protobufs/message-api.lisp

@@ -0,0 +1,326 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+(defun object-initialized-p (object message)
+  "Check if OBJECT with proto-message MESSAGE is initialized.
+The definition of initialized is all required-fields are set."
+  (loop for field in (proto-fields message)
+        when (eq (proto-label field) :required)
+          do (when (= (bit (slot-value object '%%is-set)
+                           (proto-field-offset field))
+                      0)
+               (return-from object-initialized-p nil))
+        when (and (member (proto-kind field) '(:message :group :extends))
+                  (or (eq (proto-label field) :repeated)
+                      (= (bit (slot-value object '%%is-set)
+                              (proto-field-offset field))
+                         1)))
+          do (let ((lisp-type (proto-class field))
+                   (field-value (slot-value object (proto-internal-field-name field))))
+               (when (and (not (keywordp lisp-type))
+                          (find-message-descriptor lisp-type))
+                 (doseq (msg (if (eq (proto-label field) :repeated)
+                                 field-value
+                                 (list field-value)))
+                   (unless (object-initialized-p msg (find-message-descriptor lisp-type))
+                     (return-from object-initialized-p nil))))))
+  t)
+
+(defun is-initialized (object)
+  "Returns true if all of the fields of OBJECT are initialized."
+  (let* ((class (type-of object))
+         (desc (find-message-descriptor class :error-p t)))
+    (object-initialized-p object desc)))
+
+(defun map-field-equal (map-1 map-2 map-descriptor exact)
+  "Returns true if two maps with the same map-descriptor are equal.
+Parameters:
+  MAP-1: The first map to compare.
+  MAP-2: The second map to compare.
+  MAP-DESCRIPTOR: The map descriptor for the two maps.
+  EXACT: If true consider the messages to be equal
+only if the same fields have been explicitly set."
+  (and (= (hash-table-count map-1)
+          (hash-table-count map-2))
+
+       (loop for key being the hash-keys of map-1
+               using (hash-value map-1-value)
+             for map-2-value = (gethash key map-2)
+             always
+             (if (or (scalarp (proto-value-type map-descriptor))
+                     (find-enum-descriptor (proto-value-type map-descriptor)))
+                 (scalar-field-equal map-1-value
+                                     map-2-value)
+                 (proto-equal map-1-value
+                              map-2-value
+                              :exact exact)))))
+
+(defun oneof-field-equal (oneof-1 oneof-2 oneof-descriptor exact)
+    "Returns true if two maps with the same map-descriptor are equal.
+Parameters:
+  ONEOF-1: The first oneof to compare.
+  ONEOF-2: The second oneof to compare.
+  ONEOF-DESCRIPTOR: The oneof descriptor for the two oneofs.
+  EXACT: If true consider the messages to be equal
+only if the same fields have been explicitly set."
+  (let ((set-field-1 (oneof-set-field oneof-1))
+        (set-field-2 (oneof-set-field oneof-2)))
+
+    ;; Check if one of the fields aren't set.
+    (unless (and set-field-1 set-field-2)
+      (return-from oneof-field-equal
+        (not (or set-field-1 set-field-2))))
+
+    ;; Check the same field is set.
+    (unless (eql (oneof-set-field oneof-1)
+                 (oneof-set-field oneof-2))
+      (return-from oneof-field-equal nil))
+
+    ;; Check for field equality.
+    (let* ((lisp-type
+            (proto-class
+             (aref (oneof-descriptor-fields oneof-descriptor)
+                   set-field-1))))
+      (if (or (scalarp lisp-type)
+              (find-enum-descriptor lisp-type))
+          (scalar-field-equal (oneof-value oneof-1)
+                              (oneof-value oneof-2))
+          (proto-equal (oneof-value oneof-1)
+                       (oneof-value oneof-2)
+                       :exact exact)))))
+
+(defun non-bool-field-equal (field-1 field-2 field-descriptor exact)
+  "Returns true if two proto-fields which aren't bools or oneofs are equal.
+Parameters:
+  FIELD-1: The first field to compare.
+  FIELD-2: The second field to compare.
+  FIELD-DESCRIPTOR: The field descriptor for the two fields.
+  EXACT: If true consider the messages to be equal
+only if the same fields have been explicitly set."
+  (declare (type field-descriptor field-descriptor))
+  (let ((lisp-type (proto-class field-descriptor)))
+    (assert (not (eql lisp-type 'boolean)))
+
+    (unless (and field-1 field-2)
+      (return-from non-bool-field-equal
+        (not (or field-1 field-2))))
+
+    (when (or (scalarp lisp-type)
+              (find-enum-descriptor lisp-type))
+      (return-from non-bool-field-equal
+        (scalar-field-equal field-1 field-2)))
+
+    (when (eql (proto-kind field-descriptor) :map)
+      (return-from non-bool-field-equal
+        (map-field-equal field-1
+                         field-2
+                         (find-map-descriptor lisp-type)
+                         exact))))
+
+  (if (proto-container field-descriptor)
+      (and (= (length field-1) (length field-2))
+           (every (lambda (x y) (proto-equal x y :exact exact))
+                  field-1 field-2))
+      (proto-equal field-1 field-2 :exact exact)))
+
+(defun scalar-field-equal (object-1 object-2)
+  "Check if two objects with scalar type are equal.
+Parameters:
+  OBJECT-1: The first scalar object.
+  OBJECT-2: The second scalar object."
+  (typecase object-1
+    (string (string= object-1 object-2))
+    (byte-vector (equalp object-1 object-2))
+    ((or list vector)
+     (and (= (length object-1) (length object-2))
+          (every #'scalar-field-equal object-1 object-2)))
+    (t (eql object-1 object-2))))
+
+(defun proto-equal (message-1 message-2 &key exact)
+  "Check if MESSAGE-1 and MESSAGE-2 are the same. By default two messages are equal if calling the
+   getter on each field would retrieve the same value. This means that a message with a field
+   explicitly set to the default value is considered the same as a message with that field not set.
+   If EXACT is true the messages are considered equal only if the same fields have been explicitly
+   set."
+  (let* ((class-1 (type-of message-1))
+         (desc (find-message-descriptor class-1)))
+    (and
+     ;; Check the messages are the same.
+     desc
+     (eq (type-of message-2) class-1)
+
+     ;; Check same fields are set if exact is specified.
+     (or (not exact)
+         (equalp (slot-value message-1 '%%is-set)
+                 (slot-value message-2 '%%is-set)))
+
+     ;; Bool values are stored in a vector.
+     (or (not (slot-exists-p message-1 '%%bool-values))
+         (equalp (slot-value message-1 '%%bool-values)
+                 (slot-value message-2 '%%bool-values)))
+
+     ;; oneofs
+     (loop for oneof in (proto-oneofs desc)
+           for slot-value-1
+             = (slot-value message-1 (oneof-descriptor-internal-name oneof))
+           for slot-value-2
+             = (slot-value message-2 (oneof-descriptor-internal-name oneof))
+           always (oneof-field-equal slot-value-1 slot-value-2 oneof exact))
+
+     ;; regular fields
+     (loop for field in (proto-fields desc)
+           for lisp-type = (proto-class field)
+           for boolp = (eq lisp-type 'boolean)
+           for slot-value-1
+             = (unless boolp
+                 (slot-value message-1 (proto-internal-field-name field)))
+           for slot-value-2
+             = (unless boolp
+                 (slot-value message-2 (proto-internal-field-name field)))
+           always (or boolp
+                      (non-bool-field-equal slot-value-1 slot-value-2 field exact))))))
+
+(defgeneric clear (object)
+  (:documentation
+   "Initialize all fields of OBJECT to their default values."))
+
+(defun-inline has-field (object field)
+  "Check if OBJECT has FIELD set."
+  (funcall (field-accessors-has (get field (type-of object)))
+           object))
+
+(defun-inline clear-field (object field)
+  "Check if OBJECT has FIELD set."
+  (funcall (field-accessors-clear (get field (type-of object)))
+           object))
+
+(defun-inline proto-slot-value (object slot)
+  "Get the value of a field in a protobuf object.
+Parameters:
+  OBJECT: The protobuf object.
+  SLOT: The slot in object to retrieve the value from."
+  (funcall (field-accessors-get (get slot (type-of object)))
+           object))
+
+(defun-inline (setf proto-slot-value) (value object slot)
+    "Set the value of a field in a protobuf object.
+Parameters:
+  VALUE: The new value for the field.
+  OBJECT: The protobuf object.
+  SLOT: The slot in object to retrieve the value from."
+  (funcall (fdefinition (field-accessors-set (get slot (type-of object))))
+           value
+           object))
+
+(defgeneric encoded-field (object field-name)
+  (:documentation
+   "Returns the encoded value of the field FIELD-NAME, or signals
+    protobuf-error if the field doesn't exist. For repeated fields, returns a
+    list of the encoded values, which may contain NILs.")
+  (:method ((object structure-object) slot)
+    (let* ((class (type-of object))
+           (message (find-message-descriptor class :error-p t))
+           (field (find slot (proto-fields message) :key #'proto-external-field-name)))
+      (unless field
+        (let* ((lisp-package (or (symbol-package class)
+                                 (protobuf-error "Lisp package not found for message ~A"
+                                                 (proto-name message))))
+               (lazy-slot (intern (nstring-upcase (format nil "%~A" slot))
+                                  lisp-package)))
+          (setf field (%find-field-descriptor message lazy-slot))
+          (when field
+            (setf slot lazy-slot))))
+      (unless field
+        (protobuf-error "There is no protobuf field with the name ~S" slot))
+      (let ((value (slot-value object (proto-internal-field-name field))))
+        (if (eq (proto-label field) :repeated)
+            (map 'list #'proto-%%bytes value)
+            (proto-%%bytes value))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun merge-from (from-message to-message)
+  "Merge messages.
+Taken from https://github.com/protocolbuffers/protobuf-go/blob/master/proto/merge.go:
+ Populated scalar fields in FROM-MESSAGE are copied to TO-MESSAGE, while populated
+   singular messages in FROM-MESSAGE are merged into TO-MESSAGE by recursively calling Merge.
+ The elements of every list field in FROM-MESSAGE is appended to the corresponded
+   list fields in TO-MESSAGE. The entries of every map field in FROM-MESSAGE is copied into
+   the corresponding map field in TO-MESSAGE, possibly replacing existing entries."
+  (labels ((create-message-of-same-type (message)
+             (let ((class (find-class (type-of message))))
+               (funcall (get-constructor-name
+                         (class-name class)))))
+           (copy-message (message)
+             (let ((new-message (create-message-of-same-type message)))
+               (merge-from message new-message)
+               new-message))
+           (concatenate-repeated-field (from-field to-field field-container field-type field-kind)
+             (if (eq field-container :vector)
+                 (let ((new-vector (make-array `(,(+ (length from-field)
+                                                     (length to-field)))
+                                               :element-type field-type
+                                               :adjustable t
+                                               :fill-pointer (+ (length from-field)
+                                                                (length to-field)))))
+                   (loop for i from 0
+                         for el across to-field
+                         do
+                      (setf (aref new-vector i) el))
+                   (loop for i from (length to-field)
+                         for el across from-field
+                         do
+                      (setf (aref new-vector i)
+                            (if (member field-kind '(:message :group))
+                                (copy-message el)
+                                el)))
+                   new-vector)
+                 (append to-field (mapcar (if (member field-kind '(:message :group))
+                                              #'copy-message
+                                              #'identity)
+                                          from-field)))))
+
+    (let* ((class (type-of from-message))
+           (desc (find-message-descriptor class)))
+      ;; Check the messages are the same.
+      (and desc (eq (type-of to-message) class)
+
+           (loop :for field-desc :in (proto-fields desc)
+                 :for field-name = (proto-external-field-name field-desc)
+                 :for from-field-value = (proto-slot-value from-message field-name)
+                 :when (has-field from-message field-name)
+                   :do
+              (cond
+                ((eq (proto-label field-desc) :repeated)
+                 (setf (proto-slot-value to-message field-name)
+                       (concatenate-repeated-field from-field-value
+                                                   (proto-slot-value to-message field-name)
+                                                   (proto-container field-desc)
+                                                   (proto-type field-desc)
+                                                   (proto-kind field-desc))))
+                ((member (proto-kind field-desc) '(:message :group))
+                 (if (has-field to-message field-name)
+                     (merge-from from-field-value
+                                 (proto-slot-value to-message field-name))
+                     (setf (proto-slot-value to-message field-name)
+                           (copy-message from-field-value))))
+
+                ((eq (proto-kind field-desc) :map)
+                 (loop with map-descriptor = (find-map-descriptor (proto-class field-desc))
+                       with to-hash-map = (proto-slot-value to-message field-name)
+                       for key being the hash-keys of from-field-value
+                         using (hash-value from-value)
+                       do
+                    (setf (gethash key to-hash-map)
+                          (if (eq (proto-value-kind map-descriptor) :message)
+                              (copy-message from-value)
+                              from-value))))
+
+                (t (setf (proto-slot-value to-message field-name)
+                         from-field-value))))))))

examples/meshtastic/lisp/cl-protobufs/model-classes.lisp

@@ -0,0 +1,714 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+;;; Classes to represent the objects in a .proto file.
+
+
+(defvar *file-descriptors* (make-hash-table :test #'equal)
+  "A global table mapping names to file-descriptor objects.")
+
+(defun find-file-descriptor (name)
+  "Find a file-descriptor for the given name. Returns nil if not found.
+Parameters:
+  NAME: A string, symbol, or pathname."
+  (values (gethash name *file-descriptors*)))
+
+(defun add-file-descriptor (pathname symbol)
+  "Register the file-descriptor named by SYMBOL under the key PATHNAME.
+   Intended for use by protoc-gen-cl-pb."
+  (setf (gethash pathname *file-descriptors*) (find-file-descriptor symbol)))
+
+(defstruct message
+  "All protobuf message objects extend this type. Note that some fields that
+   logically belong here, such as %%bool-values, are conditionally added to the
+   generated message defstructs in the `define-message' macro, to avoid using
+   memory for their slots when they're not needed."
+  ;; %%skipped-bytes will contain all of the bytes we couldn't
+  ;; identify when we tried to deserialize a proto but will
+  ;; add to the serialized bytes for the proto if we serialize it.
+  ;; See https://developers.google.com/protocol-buffers/docs/overview#updating
+  (%%skipped-bytes nil :type (or null byte-vector)))
+
+
+;;; Descriptor classes -- These classes taken together represent the contents of a .proto file.
+
+(defclass abstract-descriptor () ()
+  (:documentation
+   "Base class of all protobuf descriptor classes, which describe the contents of .proto files."))
+
+
+;; It would be nice if most of the slots had only reader functions, but
+;; that makes writing the protobuf parser a good deal more complicated.
+(defclass descriptor (abstract-descriptor)
+  ;; The Lisp name for the type of this object.
+  ((class :type symbol
+          :accessor proto-class
+          :initarg :class
+          :initform nil)
+   ;; The (unqualified) protobuf name for this enum, message, etc
+   (name :type (or null string)
+         :reader proto-name
+         :initarg :name
+         :initform nil)
+   ;; The fully qualified name, e.g., "proto2.MessageSet"
+   (qual-name :type string
+              :accessor proto-qualified-name
+              :initarg :qualified-name
+              :initform "")
+   (options :type (list-of option-descriptor)
+            :accessor proto-options
+            :initarg :options
+            :initform ()))
+  (:documentation
+   "Shared attributes for protobuf message descriptors."))
+
+(defun find-qualified-name (name protos
+                            &key (proto-key #'proto-name) (full-key #'proto-qualified-name)
+                                 relative-to)
+  "Find something by its string name, first doing a simple name match,
+   and, if that fails, exhaustively searching qualified names."
+  (declare (ignore relative-to))
+  (or (find name protos :key proto-key :test #'string=)
+      ;;--- This needs more sophisticated search, e.g., relative to current namespace
+      (find name protos :key full-key  :test #'string=)))
+
+
+(defclass file-descriptor (descriptor)
+  ((syntax :type (member :proto2 :proto3 :editions)
+           :accessor proto-syntax
+           :initarg :syntax)
+   (edition :type (or null string)
+            :accessor proto-edition
+            :initarg :edition)
+   (package :type (or null string)
+            :accessor proto-package-name
+            :initarg :package
+            :initform nil)
+   (imports :type (list-of string)      ; the names of schemas to be imported
+            :accessor proto-imports
+            :initarg :imports
+            :initform ()))
+  (:documentation
+   "Model class to describe a protobuf file, sometimes referred to as a schema."))
+
+(defmethod make-load-form ((file-desc file-descriptor) &optional environment)
+  (with-slots (class) file-desc
+    (multiple-value-bind (constructor initializer)
+        (make-load-form-saving-slots file-desc :environment environment)
+      (values `(or (gethash ',class *file-descriptors*) ,constructor)
+              `(unless (gethash ',class *file-descriptors*)
+                 (record-file-descriptor ,file-desc :symbol ',class)
+                 ,initializer)))))
+
+(defun record-file-descriptor (descriptor &key symbol)
+  "Record DESCRIPTOR in the global schema hash table under the key SYMBOL.
+   The generated code also stores the schema in this hash table using the
+   file pathname as the key."
+  (declare (type file-descriptor descriptor))
+  (let ((symbol (or symbol (proto-class descriptor))))
+    (setf (gethash symbol *file-descriptors*) descriptor)))
+
+(defmethod print-object ((file-desc file-descriptor) stream)
+  (if *print-escape*
+      (print-unreadable-object (file-desc stream :type t :identity t)
+        (format stream "~@[~S~]~@[ (package ~A)~]"
+                (proto-class file-desc)
+                (proto-package-name file-desc)))
+      (format stream "~S" (proto-class file-desc))))
+
+;; find-* functions for finding different proto meta-objects
+
+(defvar *messages* (make-hash-table :test 'eq)
+  "Map from the protobuf message name symbol to the message-descriptor instance. If there is an
+'extends' instance this will be the last (largest) defined extended version of the
+message-descriptor.")
+
+(defvar *qualified-messages* (make-hash-table :test 'equal)
+  "Map from the proto-qualified-name of a message (a string) to its Lisp type symbol.")
+
+(defun-inline find-message-descriptor (type &key error-p)
+  "Return the message-descriptor named by TYPE (a symbol), or nil. If ERROR-P
+   is true then signal protobuf-error instead of returning nil."
+  (or (gethash type *messages*)
+      (when error-p
+        (protobuf-error "~S does not name a protobuf message type" type))))
+
+(defun-inline find-message-by-qualified-name (qualified-name &key error-p)
+  "Return the protobuf message symbol named by QUALIFIED-NAME, or nil. For
+   definition of QUALIFIED-NAME see qual-name slot on message-descriptor.
+   If ERROR-P is true then signal protobuf-error instead of returning nil."
+  (or (gethash qualified-name *qualified-messages*)
+      (when error-p
+        (protobuf-error "~S does not name a protobuf message type" qualified-name))))
+
+(defstruct (map-descriptor (:conc-name proto-))
+  "Describes a protobuf map."
+  ;; The Lisp type of the key.
+  (key-type nil)
+  ;; The Lisp type of the value.
+  (value-type nil)
+  (value-kind nil :type (member :scalar :message :enum)))
+
+;; Delete these compatibility shims on next major release.
+(defun-inline map-key-type   (desc) (proto-key-type desc))
+(defun-inline map-value-type (desc) (proto-value-type desc))
+(defun-inline map-value-kind   (desc) (proto-value-kind desc))
+
+(defmethod make-load-form ((m map-descriptor) &optional environment)
+  (make-load-form-saving-slots m :environment environment))
+
+(defvar *map-descriptors* (make-hash-table :test 'eq)
+  "Maps map names (symbols) to map-descriptor instances.")
+
+(defun-inline find-map-descriptor (type)
+  "Return a map-descriptor instance named by TYPE (a symbol)."
+  (gethash type *map-descriptors*))
+
+(defvar *enum-descriptors* (make-hash-table :test 'eq)
+  "Maps enum names (symbols) to enum-descriptor instances.")
+
+(defun-inline find-enum-descriptor (type)
+  "Return a enum-descriptor instance named by TYPE (a symbol)."
+  (gethash type *enum-descriptors*))
+
+
+;; We accept and store any option, but only act on a few: default, packed,
+;; optimize_for, lisp_name, lisp_alias
+(defclass option-descriptor (abstract-descriptor)
+  ;; The name of the option, for example "lisp_name".
+  ((name :type string
+         :reader proto-name
+         :initarg :name)
+   ;; The (untyped) value
+   (value :accessor proto-value
+          :initarg :value
+          :initform nil)
+   ;; Optional Lisp type, one of string, integer, float, symbol (for now).
+   (type :type (or null symbol)
+         :reader proto-type
+         :initarg :type
+         :initform 'string))
+  (:documentation
+   "Model class to describe a protobuf option, i.e., a key/value pair."))
+
+(defmethod make-load-form ((o option-descriptor) &optional environment)
+  (make-load-form-saving-slots o :environment environment))
+
+(defmethod print-object ((o option-descriptor) stream)
+  (if *print-escape*
+      (print-unreadable-object (o stream :type t :identity t)
+        (format stream "~A~@[ = ~S~]" (proto-name o) (proto-value o)))
+      (format stream "~A" (proto-name o))))
+
+(defun make-option (name value &optional (type 'string))
+  (check-type name string)
+  (make-instance 'option-descriptor
+                 :name name :value value :type type))
+
+(defun find-option (desc name)
+  "Given a protobuf descriptor DESC and the NAME of an option, returns the
+   value of the option and its Lisp type, otherwise NIL."
+  (declare (type descriptor desc) (type string name))
+  (let ((option (find name (proto-options desc) :key #'proto-name :test #'option-name=)))
+    (when option
+      (values (proto-value option) (proto-type option)))))
+
+(defgeneric remove-options (descriptor &rest names)
+  (:documentation
+   "Given a protobuf descriptor (schema, message, enum, etc) and a set of option names,
+    remove all of those options from the set of options in the descriptor."))
+
+(defmethod remove-options ((desc descriptor) &rest names)
+  (dolist (name names (proto-options desc))
+    (let ((option (find name (proto-options desc) :key #'proto-name :test #'option-name=)))
+      (when option
+        (setf (proto-options desc) (remove option (proto-options desc)))))))
+
+(defmethod remove-options ((options list) &rest names)
+  (dolist (name names options)
+    (let ((option (find name options :key #'proto-name :test #'option-name=)))
+      (when option
+        ;; This does not side-effect the list of options
+        (setq options (remove option options))))))
+
+(defun option-name= (name1 name2)
+  (let* ((name1  (string name1))
+         (name2  (string name2))
+         (start1 (if (eql (char name1 0) #\() 1 0))
+         (start2 (if (eql (char name2 0) #\() 1 0))
+         (end1   (if (eql (char name1 0) #\() (- (length name1) 1) (length name1)))
+         (end2   (if (eql (char name2 0) #\() (- (length name2) 1) (length name2))))
+    (string= name1 name2 :start1 start1 :end1 end1 :start2 start2 :end2 end2)))
+
+(defstruct enum-descriptor
+  "Describes a protobuf enum."
+  ;; The symbol naming the Lisp type for this enum.
+  (class nil :type symbol)
+  ;; The string naming the protobuf type for this enum.
+  (name nil :type string)
+  ;; The name and integer value of each enum element.
+  (values nil :type (list-of enum-value-descriptor)))
+
+(defmethod make-load-form ((e enum-descriptor) &optional environment)
+  (make-load-form-saving-slots e :environment environment))
+
+(defstruct enum-value-descriptor
+  "The model class that represents a protobuf enum key/value pair."
+  ;; The keyword symbol corresponding to the enum value key.
+  ;; Note that the API uses "keyword-to-int" and "int-to-keyword".
+  ;; Let's make this match that at some point.
+  (name nil :type keyword)
+  (value nil :type sfixed32))
+
+(defmethod make-load-form ((desc enum-value-descriptor) &optional environment)
+  (make-load-form-saving-slots desc :environment environment))
+
+(defun enum-keywords (enum-type)
+  "Returns all keywords that belong to the given ENUM-TYPE."
+  (let ((expansion (type-expand enum-type)))
+    (check-type expansion (cons (eql member) list))
+    (rest expansion)))
+
+;; An object describing a Protobufs message. Confusingly most local variables that hold
+;; instances of this struct are named MESSAGE, but the C API makes it clear that
+;; a Message is not its descriptor.
+;; This would have been far less confusing if it sounded more obviously like a 'descriptor'
+;; and not the contents of the message per se.
+(defclass message-descriptor (descriptor)
+  (
+   ;; Use this if you want to make this message descriptor an alias for an existing Lisp type.
+   (alias :type (or null symbol)
+          :accessor proto-alias-for
+          :initarg :alias-for
+          :initform nil)
+   ;; All fields for this message, including local ones and extended ones.
+   ;; This does NOT include fields that are inside of a oneof. These field descriptors can
+   ;; be accessed via the FIELDS slot in each oneof-descriptor stored in the ONEOFS slot.
+   (fields :type (list-of field-descriptor)
+           :accessor proto-fields
+           :initarg :fields
+           :initform ())
+   ;; A list of all oneof descriptors defined in this message.
+   (oneofs :type (list-of oneof-descriptor)
+           :accessor proto-oneofs
+           :initarg :oneofs
+           :initform ())
+   ;; The FIELDS slot (more or less) as a vector. If the index space is dense,
+   ;; the vector is accessed by field index, otherwise it requires linear scan.
+   ;; TODO(dougk): sparse indices can do better than linear scan.
+   (field-vect :type vector
+               :accessor proto-field-vect)
+   ;; The extended fields defined in this message.
+   (extended-fields :type (list-of field-descriptor)
+                    :accessor proto-extended-fields
+                    :initform ())
+   (extensions :type (list-of extension-descriptor)
+               :accessor proto-extensions
+               :initarg :extensions
+               :initform ())
+   ;; :message is an ordinary message
+   ;; :extends is an 'extends' to an existing message
+   (message-type :type (member :message :extends)
+                 :accessor proto-message-type
+                 :initarg :message-type
+                 :initform :message))
+  (:documentation
+   "Describes a protobuf message."))
+
+(defmethod make-load-form ((msg-desc message-descriptor) &optional environment)
+  (with-slots (class message-type alias) msg-desc
+    (multiple-value-bind (constructor initializer)
+        (make-load-form-saving-slots msg-desc :environment environment)
+      (values (if (eq message-type :extends)
+                constructor
+                `(let ((msg-desc ,constructor))
+                   (record-protobuf-object ',message-type msg-desc :message)
+                   msg-desc))
+              initializer))))
+
+(defmethod print-object ((msg-desc message-descriptor) stream)
+  (if *print-escape*
+    (print-unreadable-object (msg-desc stream :type t :identity t)
+      (format stream "~S~@[ (alias for ~S)~]~@[ (group~*)~]~@[ (extended~*)~]"
+              (proto-class msg-desc)
+              (and (slot-boundp msg-desc 'alias)
+                   (proto-alias-for msg-desc))
+              (and (slot-boundp msg-desc 'message-type)
+                   (eq (proto-message-type msg-desc) :group))
+              (and (slot-boundp msg-desc 'message-type)
+                   (eq (proto-message-type msg-desc) :extends))))
+    (format stream "~S" (proto-class msg-desc))))
+
+;; Extensions protocol
+(defgeneric get-extension (object slot)
+  (:documentation
+   "Returns the value of the extended slot SLOT in OBJECT."))
+
+(defgeneric set-extension (object slot value)
+  (:documentation
+   "Sets the value of the extended slot SLOT to VALUE in OBJECT."))
+
+(defgeneric has-extension (object slot)
+  (:documentation
+   "Returns true iff there is an extended slot named SLOT in OBJECT.")
+  ;; It's an error to call {get,set,clear}-extension on a non-extendable object.
+  (:method ((object standard-object) slot)
+    (declare (ignore slot))
+    nil))
+
+(defgeneric clear-extension (object slot)
+  (:documentation
+   "Clears the value of the extended slot SLOT from OBJECT."))
+
+(defconstant $empty-default 'empty-default
+  "The marker used in 'proto-default' used to indicate that there is no default value.")
+
+;; Describes a field within a message.
+;;--- Support the 'deprecated' option (have serialization ignore such fields?)
+(defclass field-descriptor (descriptor)
+  ;; :group means this is a message-typed field but it should be serialized as
+  ;; a group. What does nil mean here? Needs a comment.
+  ((kind :type (member :message :group :extends :enum :map :scalar nil)
+         :accessor proto-kind
+         :initarg :kind)
+   (type :type (or null symbol)
+         :accessor proto-type
+         :initarg :type)
+   (label :type (member :required :optional :repeated)
+          :accessor proto-label
+          :initarg :label)
+   ;; TODO(cgay): rename to field-number and proto-field-number. Why be coy?
+   (index :type field-number
+          :accessor proto-index
+          :initarg :index)
+   ;; Offset into the is-set bit vector. nil for members of a oneof.
+   (field-offset :type (or null field-number)
+                 :accessor proto-field-offset
+                 :initarg :field-offset)
+   ;; If this field is contained in a oneof, this holds the order of this field
+   ;; as it was defined in the oneof. This slot is nil if and only if the field
+   ;; is not part of a oneof.
+   (oneof-offset :type (or null field-number)
+                 :accessor proto-oneof-offset
+                 :initarg :oneof-offset
+                 :initform nil)
+   ;; The name of the slot holding the field value.
+   ;; TODO(cgay): there's no deep reason we must have internal and external field names. It's a
+   ;; historical artifact that can probably be removed once the QPX protobuf code has been updated.
+   (internal-field-name :type (or null symbol)
+                        :accessor proto-internal-field-name
+                        :initarg :internal-field-name
+                        :initform nil)
+   (external-field-name
+    :type (or null symbol)                ; The Lisp slot holding the value within an object
+    :accessor proto-external-field-name   ; this also serves as the Lisp field name
+    :initarg :external-field-name
+    :initform nil)
+   (json-name                                   ; The key to use when printing this field to JSON.
+    :type string                                ; This is pulled directly from protoc output.
+    :accessor proto-json-name
+    :initarg :json-name)
+   (default :accessor proto-default             ; Default value (untyped), pulled out of the options
+            :initarg :default
+            :initform $empty-default)
+   (packed :type boolean                        ; Packed, pulled out of the options
+           :accessor proto-packed
+           :initarg :packed
+           :initform nil)
+   (container :accessor proto-container         ; If the field is repeated, this specifies the
+              :type (member nil :vector :list)  ; container type. If not, this field is nil.
+              :initarg :container
+              :initform nil)
+   (lazy :type boolean                          ; Lazy, pulled out of the options
+         :accessor proto-lazy-p
+         :initarg :lazy
+         :initform nil)
+   (bool-index :type (or null integer)      ; For non-repeated boolean fields only, the
+               :accessor proto-bool-index   ; index into the bit-vector of boolean field values.
+               :initarg :bool-index
+               :initform nil))
+  (:documentation
+   "The model class that represents one field within a Protobufs message."))
+
+(defmethod initialize-instance :after ((field field-descriptor) &rest initargs)
+  (declare (ignore initargs))
+  (unless (and (plusp (proto-index field))
+               (not (<= 19000 (proto-index field) 19999)))
+    (protobuf-error
+     "Protobuf field indexes must be positive and not between 19000 and 19999 (inclusive)")))
+
+(defmethod make-load-form ((f field-descriptor) &optional environment)
+  (make-load-form-saving-slots f :environment environment))
+
+(defmethod print-object ((f field-descriptor) stream)
+  (if *print-escape*
+      (print-unreadable-object (f stream :type t :identity t)
+        (format stream "~S :: ~S = ~D~@[ (group~*)~]~@[ (extended~*)~]"
+                (proto-internal-field-name f)
+                (proto-class f)
+                (proto-index f)
+                (eq (proto-kind f) :group)
+                (eq (proto-kind f) :extends)))
+      (format stream "~S" (proto-internal-field-name f))))
+
+(defmethod proto-slot ((field field-descriptor))
+  (proto-internal-field-name field))
+
+(defmethod (setf proto-slot) (slot (field field-descriptor))
+  (setf (proto-value field) slot))
+
+(defclass extension-descriptor (abstract-descriptor)
+  ;; The start of the extension range.
+  ((from :type field-number
+         :accessor proto-extension-from
+         :initarg :from)
+   ;; The end of the extension range, inclusive.
+   (to :type field-number
+       :accessor proto-extension-to
+       :initarg :to))
+  (:documentation
+   "The model class that represents an extension range within a protobuf message."))
+
+;;; TODO(cgay): this is unused. Were there plans for it?
+(defvar *extension-descriptors* nil "Extension descriptors.")
+
+(defmethod make-load-form ((e extension-descriptor) &optional environment)
+  (declare (ignore environment))
+  (let ((from (and (slot-boundp e 'from) (proto-extension-from e)))
+        (to (and (slot-boundp e 'to) (proto-extension-to e))))
+    `(or (cdr (assoc '(,from . ,to) *extension-descriptors* :test #'equal))
+         (let ((obj (make-instance 'extension-descriptor
+                                   ,@(and from `(:from ,from))
+                                   ,@(and to `(:to ,to)))))
+           (push (cons '(,from . ,to) obj) *extension-descriptors*)
+           obj))))
+
+(defmethod print-object ((e extension-descriptor) stream)
+  (print-unreadable-object (e stream :type t :identity t)
+    (format stream "~D - ~D"
+            (proto-extension-from e) (proto-extension-to e))))
+
+(defvar *service-descriptors* (make-hash-table)
+  "Maps service names (symbols) to service-descriptor instances.")
+
+(defun find-service-descriptor (name)
+  "Return a service-descriptor instance named by NAME (a symbol)."
+  (gethash name *service-descriptors*))
+
+(defclass service-descriptor (descriptor)
+  ((methods :type (list-of method-descriptor)
+            :accessor proto-methods
+            :initarg :methods
+            :initform ())
+   ;; The pathname of the protobuf the service is defined in.
+   (location :type (or null pathname)
+             :accessor proto-source-location
+             :initarg :source-location
+             :initform nil))
+  (:documentation "Model class to describe a protobuf service."))
+
+(defmethod make-load-form ((s service-descriptor) &optional environment)
+  (make-load-form-saving-slots s :environment environment))
+
+(defmethod print-object ((s service-descriptor) stream)
+  (if *print-escape*
+      (print-unreadable-object (s stream :type t :identity t)
+        (format stream "~S" (proto-name s)))
+      (format stream "~S" (proto-name s))))
+
+(defgeneric find-method-descriptor (service name)
+  (:documentation
+   "Given a protobuf service-descriptor and a method name,
+    returns the protobuf method having that name."))
+
+(defun record-protobuf-object (symbol descriptor type)
+  "Record the protobuf-metaobject DESCRIPTOR named by SYMBOL in the
+hash-table indicated by TYPE. Also sets the default constructor on the symbol
+if we are not in SBCL."
+  ;; No need to record an extension, it's already been recorded
+  (ecase type
+    (:enum (setf (gethash symbol *enum-descriptors*) descriptor))
+    (:message
+     (setf (gethash symbol *messages*) descriptor)
+     #-sbcl
+     (setf (get symbol :default-constructor)
+           (intern (nstring-upcase (format nil "%MAKE-~A" symbol))
+                   (symbol-package symbol)))
+     (when (and (slot-boundp descriptor 'qual-name) (proto-qualified-name descriptor))
+       (setf (gethash (proto-qualified-name descriptor) *qualified-messages*)
+             (proto-class descriptor))))
+    (:map (setf (gethash symbol *map-descriptors*) descriptor))
+    (:service (setf (gethash symbol *service-descriptors*) descriptor))))
+
+(defmethod find-method-descriptor ((service service-descriptor) (name symbol))
+  (find name (proto-methods service) :key #'proto-class))
+
+(defmethod find-method-descriptor ((service service-descriptor) (name string))
+  (find-qualified-name name (proto-methods service)))
+
+(defmethod find-method-descriptor ((service service-descriptor) (index integer))
+  (find index (proto-methods service) :key #'proto-index))
+
+
+(defclass method-descriptor (descriptor)
+  ;; Name of the Stubby service for which this is a method.
+  ((service-name :type string
+                 :accessor proto-service-name
+                 :initarg :service-name)
+   (client-fn :type symbol
+              :accessor proto-client-stub
+              :initarg :client-stub)
+   (server-fn :type symbol
+              :accessor proto-server-stub
+              :initarg :server-stub)
+   ;; TODO(jgodbout): Fix internally and delete.
+   (old-server-fn :type symbol
+                  :accessor proto-old-server-stub
+                  :initarg :old-server-stub)
+   ;; Lisp name of the input parameter, which must be a message or extension.
+   (itype :type symbol
+          :accessor proto-input-type
+          :initarg :input-type)
+   ;; Protobuf name of the input parameter. (Fully qualified?)
+   (iname :type (or null string)
+          :accessor proto-input-name
+          :initarg :input-name
+          :initform nil)
+   (istreaming :type boolean                    ; For stubby4-style streaming.
+               :accessor proto-input-streaming-p
+               :initarg :input-streaming
+               :initform nil)
+   ;; Lisp name of the output parameter, which must be a message or extension.
+   (otype :type symbol
+          :accessor proto-output-type
+          :initarg :output-type)
+   ;; Protobuf name of the output parameter. (Fully qualified?)
+   (oname :type (or null string)
+          :accessor proto-output-name
+          :initarg :output-name
+          :initform nil)
+   (ostreaming :type boolean                    ; For stubby4-style streaming.
+               :accessor proto-output-streaming-p
+               :initarg :output-streaming
+               :initform nil)
+   (stype :type (or symbol null)                ; The Lisp type name of
+          :accessor proto-streams-type          ; the "streams" type.
+          :initarg :streams-type
+          :initform nil)
+   (sname :type (or null string)                ; The Protobufs name of the
+          :accessor proto-streams-name          ; "streams" type.
+          :initarg :streams-name
+          :initform nil)
+   (index :type (unsigned-byte 32)              ; An identifying index for this method.
+          :accessor proto-index                 ; (used by the RPC implementation)
+          :initarg :index))
+  (:documentation
+   "Model class to describe one method in a protobuf service."))
+
+(defmethod make-load-form ((m method-descriptor) &optional environment)
+  (make-load-form-saving-slots m :environment environment))
+
+(defmethod print-object ((m method-descriptor) stream)
+  (if *print-escape*
+    (print-unreadable-object (m stream :type t :identity t)
+      (format stream "~S (~S) => (~S)"
+              (proto-class m)
+              (and (slot-boundp m 'itype) (proto-input-type m))
+              (and (slot-boundp m 'otype) (proto-output-type m))))
+    (format stream "~S" (proto-class m))))
+
+(defstruct oneof
+  "Stores data for a oneof slot."
+  ;; Value of the currently set field in the oneof. Only the one (untyped) slot
+  ;; is needed to store the oneof's current value.
+  (value nil)
+  ;; Indicates which field is set in the oneof. If nil, then nothing is set in
+  ;; the oneof. If a number, say N, then the N-th field in the oneof is set.
+  (set-field nil :type (or null (unsigned-byte 32))))
+
+(defstruct oneof-descriptor
+  "Describes a oneof"
+  ;; Indicates whether the oneof is synthetic. A synthetic oneof is a oneof
+  ;; created by protoc in order to create has-* functions for proto3 optional
+  ;; fields. Special accessors (the clear, has, and case functions) are not
+  ;; created for synthetic oneofs.
+  (synthetic-p nil :type boolean)
+  ;; One field-descriptor for each field in the one-of, in order.
+  (fields nil :type simple-vector)
+  ;; A symbol naming the oneof field.
+  (external-name nil :type symbol)
+  ;; The external name, but with '%' prepended.
+  (internal-name nil :type symbol))
+
+(defmethod make-load-form ((o oneof-descriptor) &optional environment)
+  (make-load-form-saving-slots o :environment environment))
+
+(defun %find-field-descriptor (desc internal-field-name)
+  "Like find-field-descriptor, but looks in DESC for INTERNAL-FIELD-NAME
+   instead of the external field name."
+  (or (find internal-field-name (proto-fields desc)
+            :key #'proto-internal-field-name)
+      (loop for oneof in (proto-oneofs desc)
+              thereis (find internal-field-name (oneof-descriptor-fields oneof)
+                            :key #'proto-internal-field-name))))
+
+;;; TODO(cgay): looks like relative-to is for searching relative to a current
+;;; namespace and isn't implemented yet.
+(defgeneric find-field-descriptor (desc id &optional relative-to)
+  (:documentation
+   "Given a message-descriptor DESC and a field ID, returns the
+   field-descriptor having that ID. ID may be the symbol naming the
+   field, the field name (string), or the field number."))
+
+(defmethod find-field-descriptor ((desc message-descriptor) (name symbol)
+                                  &optional relative-to)
+  (declare (ignore relative-to))
+  (or (find name (proto-fields desc) :key #'proto-external-field-name)
+      (loop for oneof in (proto-oneofs desc)
+              thereis (find name (oneof-descriptor-fields oneof)
+                            :key #'proto-external-field-name))))
+
+(defmethod find-field-descriptor ((desc message-descriptor) (name string)
+                                  &optional relative-to)
+  (or (find-qualified-name name (proto-fields desc)
+                           :relative-to (or relative-to desc))
+      (loop for oneof in (proto-oneofs desc)
+              thereis (find-qualified-name name (oneof-descriptor-fields oneof)
+                                           :relative-to (or relative-to desc)))))
+
+(defmethod find-field-descriptor ((desc message-descriptor) (index integer)
+                                  &optional relative-to)
+  (declare (ignore relative-to))
+  (or (find index (proto-fields desc) :key #'proto-index)
+      (loop for oneof in (proto-oneofs desc)
+              thereis (find index (oneof-descriptor-fields oneof)
+                            :key #'proto-index))))
+
+(defgeneric set-method-do-not-deserialize-input (method)
+  (:documentation
+   "Sets a service METHOD to indicate that its input should not be deserialized prior to calling its
+    server function.")
+  (:method ((method method-descriptor))
+    (setf (proto-input-type method) nil)))
+
+(defgeneric make-qualified-name (parent-desc name)
+  (:documentation
+   "Given a parent file-descriptor or message-descriptor and a name,
+    generate a fully qualified name string for the name."))
+
+(defmethod make-qualified-name ((parent-desc file-descriptor) name)
+  "Make a qualified name for NAME by prepending the package name from PARENT-DESC and a '.'."
+  (let* ((parent-name (proto-package-name parent-desc)))
+    (if parent-name
+        (strcat parent-name "." name)
+        name)))
+
+(defmethod make-qualified-name ((parent-desc message-descriptor) name)
+  "Make a qualified name for NAME by prepending the message name from PARENT-DESC and a '.'."
+  (let* ((parent-qual-name (proto-qualified-name parent-desc)))
+    (strcat parent-qual-name "." name)))

examples/meshtastic/lisp/cl-protobufs/parser.lisp

@@ -0,0 +1,303 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+;;; Text parsing utilities
+
+(defun-inline proto-whitespace-char-p (ch)
+  (declare #.*optimize-fast-unsafe*)
+  (and ch (member ch '(#\space #\tab #\return #\newline))))
+
+(defun-inline proto-hash-char-p (ch)
+  (declare #.*optimize-fast-unsafe*)
+  (and ch (eq ch #\#)))
+
+(defun-inline proto-eol-char-p (ch)
+  (declare #.*optimize-fast-unsafe*)
+  (and ch (member ch '(#\return #\newline))))
+
+(defun-inline proto-token-char-p (ch)
+  (declare #.*optimize-fast-unsafe*)
+  (and ch (or (alpha-char-p ch)
+              (digit-char-p ch)
+              (member ch '(#\_ #\.)))))
+
+(defun skip-whitespace-comments-and-chars (stream &key chars)
+  "Skip all whitespace characters, text-format comments and elements of CHARS
+are coming up in the STREAM."
+  (loop for ch = (peek-char nil stream nil)
+        until (or (null ch)
+                  (and (not (proto-whitespace-char-p ch))
+                       (not (proto-hash-char-p ch))
+                       (not (if (listp chars)
+                                (member ch chars)
+                                (eql ch chars)))))
+        do
+     (if (proto-hash-char-p ch)
+         (read-line stream nil)
+         (read-char stream nil))))
+
+(defun skip-whitespace (stream)
+  "Skip all the whitespace characters that are coming up in the stream."
+  (loop for ch = (peek-char nil stream nil)
+        until (or (null ch) (not (proto-whitespace-char-p ch)))
+        do
+     (read-char stream nil)))
+
+(defun expect-matching-end (stream start-char)
+  "Expect that the starting block element START-CHAR matches the next element
+   in the STREAM which should end the block, signal an error if there's no match.
+   The return value is the character that was eaten."
+  (let ((end-char (peek-char nil stream nil)))
+    (unless (or (and (eq start-char #\{)
+                     (eq end-char #\}))
+                (and (eq start-char #\<)
+                     (eq end-char #\>)))
+      (protobuf-error "Started with ~S ended with ~S at position ~D"
+                      start-char end-char (file-position stream))))
+  (read-char stream))
+
+(defun expect-char (stream char &optional chars within)
+  "Expect to see 'char' as the next character in the stream; signal an error if it's not there.
+   Then skip all of the following whitespace.
+   The return value is the character that was eaten."
+  (let (ch)
+    (if (if (listp char)
+            (member (peek-char nil stream nil) char)
+            (eql (peek-char nil stream nil) char))
+        (setq ch (read-char stream))
+        (protobuf-error "No ~S found~@[ within '~A'~] at position ~D"
+                        char within (file-position stream)))
+    (maybe-skip-chars stream chars)
+    ch))
+
+(defun expect-token-or-string (stream string)
+  "Expect to see STRING as the next string in STREAM, as parsed by PARSE-TOKEN-OR-STRING.
+   Signal an error if not present, and return the parsed string."
+  (let ((str (parse-token-or-string stream)))
+    (skip-whitespace stream)
+    (if (string= str string)
+        str
+        (error "No ~S found at position ~D" string (file-position stream)))))
+
+(defun maybe-skip-chars (stream chars)
+  "Skip some optional characters in the stream,
+   then skip all of the following whitespace."
+  (skip-whitespace-comments-and-chars stream)
+  (when chars
+    (loop
+      (let ((ch (peek-char nil stream nil)))
+        (when (or (null ch) (not (member ch chars)))
+          (skip-whitespace-comments-and-chars stream)
+          (return-from maybe-skip-chars)))
+      (read-char stream))))
+
+
+;;--- Collect the comment so we can attach it to its associated object
+(defun maybe-skip-comments (stream)
+  "If what appears next in the stream is a comment, skip it and any following comments,
+   then skip any following whitespace."
+  (loop
+    (let ((ch (peek-char nil stream nil)))
+      (unless (eql ch #\/)
+        (return-from maybe-skip-comments))
+      (read-char stream)
+      (case (peek-char nil stream nil)
+        ((#\/)
+         (skip-line-comment stream))
+        ((#\*)
+         (skip-block-comment stream))
+        ((nil)
+         (skip-whitespace stream)
+         (return-from maybe-skip-comments))
+        (otherwise
+         (protobuf-error "Found '/' at position ~D to start a comment, but no following '/' or '*'"
+                         (file-position stream)))))))
+
+(defun skip-line-comment (stream)
+  "Skip to the end of a line comment, that is, to the end of the line.
+   Then skip any following whitespace."
+  (loop for ch = (read-char stream nil)
+        until (or (null ch) (proto-eol-char-p ch)))
+  (skip-whitespace stream))
+
+(defun skip-block-comment (stream)
+  "Skip to the end of a block comment, that is, until a '*/' is seen.
+   Then skip any following whitespace."
+  (loop for ch = (read-char stream nil)
+        do (cond ((null ch)
+                  (protobuf-error "Premature end of file while skipping block comment"))
+                 ((and (eql ch #\*)
+                       (eql (peek-char nil stream nil) #\/))
+                  (read-char stream nil)
+                  (return))))
+  (skip-whitespace stream))
+
+
+(defun parse-token (stream &optional additional-chars)
+  "Parse the next token in the stream, then skip following whitespace/comments.
+   The returned value is the token."
+  (maybe-skip-comments stream)
+  (when (let ((ch (peek-char nil stream nil)))
+          (or (proto-token-char-p ch) (member ch additional-chars)))
+    (loop for ch = (read-char stream nil)
+          for ch1 = (peek-char nil stream nil)
+          collect ch into token
+          until (or (null ch1)
+                    (and (not (proto-token-char-p ch1))
+                         (not (member ch1 additional-chars))))
+          finally (progn
+                    (skip-whitespace stream)
+                    (maybe-skip-comments stream)
+                    (return (coerce token 'string))))))
+
+(defun parse-parenthesized-token (stream)
+  "Parse the next token in the stream, then skip the following whitespace.
+   The token might be surrounded by parentheses.
+   The returned value is the token."
+  (let ((left (peek-char nil stream nil)))
+    (when (eql left #\()
+      (read-char stream))
+    (when (proto-token-char-p (peek-char nil stream nil))
+      (loop for ch = (read-char stream nil)
+            for ch1 = (peek-char nil stream nil)
+            collect ch into token
+            until (or (null ch1) (not (proto-token-char-p ch1)))
+            finally (progn
+                      (skip-whitespace stream)
+                      (when (eql left #\()
+                        (expect-char stream #\)))
+                      (return (coerce token 'string)))))))
+
+(defun parse-token-or-string (stream)
+  (if (eql (peek-char nil stream nil) #\")
+    (values (parse-string stream) 'string)
+    (values (parse-token stream) 'symbol)))
+
+(defun parse-string (stream)
+  "Parse the next quoted string in the stream, then skip the following whitespace.
+   The returned value is the string, without the quotation marks."
+  (let ((ch0 (read-char stream nil)))
+    (unless (member ch0 '(#\' #\"))
+      (protobuf-error "Starting string character ~c should be \' or \"." ch0))
+    (loop for ch = (read-char stream nil)
+          until (or (null ch) (char= ch ch0))
+          when (eql ch #\\)
+            do (setq ch (unescape-char stream))
+          collect ch into string
+          finally (progn
+                    (skip-whitespace-comments-and-chars stream)
+                    (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."
+  (let ((ch (read-char stream nil)))
+    (assert (not (null ch)) ()
+            "End of stream reached while reading escaped character")
+    (case ch
+      ((#\x)
+       ;; Two hex digits
+       (let* ((d1 (digit-char-p (read-char stream) 16))
+              (d2 (digit-char-p (read-char stream) 16)))
+         (code-char (+ (* d1 16) d2))))
+      ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+       (if (not (digit-char-p (peek-char nil stream nil)))
+         #\null
+         ;; Three octal digits
+         (let* ((d1 (digit-char-p ch 8))
+                (d2 (digit-char-p (read-char stream) 8))
+                (d3 (digit-char-p (read-char stream) 8)))
+           (code-char (+ (* d1 64) (* d2 8) d3)))))
+      ((#\t) #\tab)
+      ((#\n) #\newline)
+      ((#\r) #\return)
+      ((#\f) #\page)
+      ((#\b) #\backspace)
+      ((#\a) #\bell)
+      ((#\e) #\esc)
+      (otherwise ch))))
+
+(defun escape-char (ch)
+  "The inverse of 'unescape-char', for printing."
+  (if (and (standard-char-p ch) (graphic-char-p ch))
+    ch
+    (case ch
+      ((#\null)      "\\0")
+      ((#\tab)       "\\t")
+      ((#\newline)   "\\n")
+      ((#\return)    "\\r")
+      ((#\page)      "\\f")
+      ((#\backspace) "\\b")
+      ((#\bell)      "\\a")
+      ((#\esc)       "\\e")
+      (otherwise
+       (format nil "\\x~2,'0X" (char-code ch))))))
+
+(defun parse-signed-int (stream)
+  "Parse the next token in the stream as an integer, then skip the following whitespace.
+   The returned value is the integer."
+  (let* ((sign (if (eql (peek-char nil stream nil) #\-)
+                 (progn (read-char stream) -1)
+                 1))
+         (int  (parse-unsigned-int stream)))
+    (* int sign)))
+
+(defun parse-unsigned-int (stream)
+  "Parse the next token in the stream as an integer, then skip the following whitespace.
+   The returned value is the integer."
+  (when (digit-char-p (peek-char nil stream nil))
+    (loop for ch = (read-char stream nil)
+          for ch1 = (peek-char nil stream nil)
+          collect ch into token
+          until (or (null ch1) (and (not (digit-char-p ch1)) (not (eql ch #\x))))
+          finally (progn
+                    (skip-whitespace stream)
+                    (let ((token (coerce token 'string)))
+                      (if (starts-with token "0x")
+                        (let ((*read-base* 16))
+                          (return (parse-integer (subseq token 2))))
+                        (return (parse-integer token))))))))
+
+(defun parse-float (stream)
+  "Parse the next token in the STREAM as a float, then skip the following whitespace.
+   The returned value is the float."
+  (let ((number (parse-number stream)))
+    (when number
+      (coerce number 'float))))
+
+(defun parse-double (stream &key append-d0)
+  "Parse the next token in the STREAM as a double, then skip the following whitespace.
+If APPEND-D0 is true, then append 'd0' to the parsed number before attempting to convert
+to a double. This is necessary in order to parse doubles from the stream which do not
+already have the 'd0' suffix. The returned value is the double-float."
+  (let ((number (parse-number stream :append-d0 append-d0)))
+    (when number
+      (coerce number 'double-float))))
+
+(defun parse-number (stream &key append-d0)
+  "Parse a number from STREAM. If APPEND-D0 is true, append \"d0\"
+to the end of the parsed numerical string."
+  (when (let ((ch (peek-char nil stream nil)))
+          (or (digit-char-p ch) (member ch '(#\- #\+ #\.))))
+    (let ((token (parse-token stream '(#\- #\+ #\.))))
+      (when token
+        (skip-whitespace-comments-and-chars stream)
+        (if append-d0
+            (parse-numeric-string (concatenate 'string token "d0"))
+            (parse-numeric-string token))))))
+
+(defun parse-numeric-string (string)
+  (cond ((starts-with string "0x")
+         (parse-integer (subseq string 2) :radix 16))
+        ((starts-with string "-0x")
+         (- (parse-integer (subseq string 3) :radix 16)))
+        (t
+         (read-from-string string))))

examples/meshtastic/lisp/cl-protobufs/pkgdcl.lisp

@@ -0,0 +1,187 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package "CL-USER")
+
+(defpackage #:cl-protobufs
+  (:use)
+  (:export
+   ;; Base type for all message instances.
+   #:message
+
+   ;; Message field types and related definitions.
+   #:int32
+   #:int64
+   #:uint32
+   #:uint64
+   #:sint32
+   #:sint64
+   #:fixed32
+   #:fixed64
+   #:sfixed32
+   #:sfixed64
+   #:list-of
+   #:vector-of
+   #:byte-vector
+   #:make-byte-vector
+
+   ;; Enumerations
+   #:enum-keywords
+   #:enum-int-to-keyword
+   #:enum-keyword-to-int
+
+   ;; Serialization to/from various formats
+
+   ;; Binary format
+   #:serialize-to-stream
+   #:serialize-to-bytes
+   #:deserialize-from-stream
+   #:deserialize-from-bytes
+   #:make-message-with-bytes
+   #:set-method-do-not-deserialize-input
+
+   ;; JSON
+   #:parse-json
+   #:print-json
+
+   ;; Text format - not well specified, prefer json or binary
+   #:parse-text-format
+   #:print-text-format
+   #:fmt
+
+   ;; Descriptors -- descriptors contain all the information parsed from .proto
+   ;; files and may be looked up by the symbol naming a protobuf message, enum,
+   ;; etc. For most use cases it's not necessary to deal with descriptors
+   ;; directly; just access the protos through the generated code APIs and a
+   ;; few other generic APIs above. The descriptor APIs are mostly intended for
+   ;; writing code that deals with arbitrary protos when the types aren't known
+   ;; in advance.
+
+   #:abstract-descriptor
+   #:descriptor
+   #:enum-descriptor
+   #:enum-value-descriptor
+   #:extension-descriptor
+   #:field-descriptor
+   #:file-descriptor
+   #:map-descriptor
+   #:message-descriptor
+   #:method-descriptor
+   #:option-descriptor
+   #:service-descriptor
+
+   ;; Descriptor lookup
+   #:find-enum-descriptor
+   #:find-field-descriptor
+   #:find-file-descriptor
+   #:find-map-descriptor
+   #:find-message-descriptor
+   #:find-method-descriptor
+   #:find-service-descriptor
+
+   ;; descriptor accessors
+   #:enum-descriptor-class
+   #:enum-descriptor-name
+   #:enum-descriptor-values
+
+   ;; The map-* versions are deprecated, to be removed in release 4.0.
+   #:proto-key-type    #:map-key-type
+   #:proto-value-kind  #:map-value-kind
+   #:proto-value-type  #:map-value-type
+
+   #:oneof-descriptor-fields
+   #:oneof-descriptor-name
+   #:oneof-descriptor-synthetic-p
+   #:proto-class
+   #:proto-client-stub
+   #:proto-container
+   #:proto-default
+   #:proto-edition
+   #:proto-external-field-name
+   #:proto-fields
+   #:proto-imports
+   #:proto-index
+   #:proto-input-name
+   #:proto-input-streaming-p
+   #:proto-input-type
+   #:proto-internal-field-name
+   #:proto-kind
+   #:proto-label
+   #:proto-methods
+   #:proto-name
+   #:proto-oneofs
+   #:proto-options
+   #:proto-output-name
+   #:proto-output-streaming-p
+   #:proto-output-type
+   #:proto-package-name
+   #:proto-qualified-name
+   #:proto-server-stub
+   #:proto-old-server-stub
+   #:proto-service-name
+   #:proto-source-location
+   #:proto-streams-name
+   #:proto-streams-type
+   #:proto-type
+   #:proto-value
+
+   #:find-option                        ; finds an option, not a descriptor
+
+   ;; Conditions
+   #:protobuf-error
+   #:unknown-type
+   #:unknown-field-type
+
+   ;; Extensions
+   #:get-extension
+   #:set-extension
+   #:has-extension
+   #:clear-extension
+
+   ;; The Python "compatibility" API
+   #:is-initialized
+   #:proto-equal
+   #:clear
+   #:has-field
+   #:proto-slot-value
+   #:encoded-field
+   #:merge-from
+
+   ;; For RPC stubs
+   ;; An RPC library supporting the client functions defined in
+   ;; `define-service` should bind these.
+   #:*rpc-call-function*
+   #:*rpc-streaming-client-function*))
+
+(defpackage #:cl-protobufs.implementation
+  (:use :common-lisp :cl-protobufs)
+  (:import-from :alexandria #:define-constant)
+  (:export
+   ;; Exported for use by generated code. These shouldn't be called directly.
+   #:define-schema
+   #:define-enum
+   #:define-map
+   #:define-oneof
+   #:define-message
+   #:define-extend
+   #:define-extension
+   #:define-service
+
+   #:add-file-descriptor
+
+   ;; TODO(cgay): These should be removed or moved to the interface package, as
+   ;; appropriate.
+   #:encode-double
+   #:encode-string
+   #:encode-uint32
+   #:make-deserializer
+   #:make-serializer
+   #:make-tag
+
+   #:serialize-scalar
+
+   ;; For ASDF
+   #:validate-imports))

examples/meshtastic/lisp/cl-protobufs/text-format.lisp

@@ -0,0 +1,379 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+;;; This file implements the protobuf Text Format parser and printer.
+;;; The exported symbols are parse-text-format and print-text-format.
+
+(defun print-text-format (object &key
+                                 (stream *standard-output*)
+                                 (pretty-print-p t))
+    "Prints a protocol buffer message to a stream.
+Parameters:
+  OBJECT: The protocol buffer message to print.
+  STREAM: The stream to print to.
+  PRETTY-PRINT-P: When true, generate line breaks and other human readable output
+    in the text format. When false, replace line breaks with spaces."
+  (print-text-format-impl object :stream stream
+                                 :pretty-print-p pretty-print-p))
+
+(defun print-text-format-impl (object &key
+                                      (indent 0)
+                                      (stream *standard-output*)
+                                      (pretty-print-p t))
+  "Prints a protocol buffer message to a stream.
+Parameters:
+  OBJECT: The protocol buffer message to print.
+  INDENT: Indent the output by INDENT spaces. Only used for pretty-printing.
+  STREAM: The stream to print to.
+  PRETTY-PRINT-P: When true, generate line breaks and other human readable output
+    in the text format. When false, replace line breaks with spaces."
+  (let* ((type (type-of object))
+         (message (find-message-descriptor type :error-p t)))
+    (dolist (field (proto-fields message))
+      (when (if (eq (slot-value field 'kind) :extends)
+                (has-extension object (slot-value field 'external-field-name))
+                (has-field object (slot-value field 'external-field-name)))
+        (let* ((value
+                (if (eq (slot-value field 'kind) :extends)
+                    (get-extension object (slot-value field 'external-field-name))
+                    (proto-slot-value object (slot-value field 'external-field-name)))))
+          (if (eq (proto-label field) :repeated)
+              (doseq (val value)
+                     (print-field val
+                                  (proto-class field)
+                                  (proto-name field)
+                                  :indent indent
+                                  :stream stream
+                                  :pretty-print-p pretty-print-p))
+              (print-field value
+                           (proto-class field)
+                           (proto-name field)
+                           :indent indent
+                           :stream stream
+                           :pretty-print-p pretty-print-p)))))
+    (dolist (oneof (proto-oneofs message))
+      (let* ((oneof-data (slot-value object (oneof-descriptor-internal-name oneof)))
+             (set-field (oneof-set-field oneof-data)))
+        (when set-field
+          (let ((field-desc (aref (oneof-descriptor-fields oneof) set-field)))
+            (print-field (oneof-value oneof-data)
+                         (proto-class field-desc)
+                         (proto-name field-desc)
+                         :indent indent
+                         :stream stream
+                         :pretty-print-p pretty-print-p)))))
+    nil))
+
+(defun print-field (value type name
+                    &key (indent 0) (stream *standard-output*) (pretty-print-p t))
+  "Print the text format of a single field which is not repeated.
+Parameters:
+  VALUE: The value in the field to print.
+  TYPE: The protobuf type to print. This is obtained from
+    the PROTO-CLASS slot in the field-descriptor.
+  NAME: The name of the field. This is printed before the value.
+  INDENT: If supplied, indent the text by INDENT spaces.
+  STREAM: The stream to output to.
+  PRINT-NAME: Whether or not to print the name of the field.
+  PRETTY-PRINT-P: When true, print newlines and indentation."
+  ;; If VALUE is NIL and the type is not boolean, there is nothing to do.
+  (unless (or value (eq type 'boolean) (eq type 'symbol))
+    (return-from print-field nil))
+  (let (desc)
+    (cond
+      ((scalarp type)
+       (print-scalar value type name stream
+                     (and pretty-print-p indent)))
+      ((typep (setq desc (or (find-message-descriptor type)
+                             (find-enum-descriptor type)
+                             (find-map-descriptor type)))
+              'message-descriptor)
+       (print-message-brace t name pretty-print-p indent stream)
+       (print-text-format-impl value :indent (+ indent 2)
+                                     :stream stream
+                                     :pretty-print-p pretty-print-p)
+       (print-message-brace nil name pretty-print-p indent stream))
+      ((typep desc 'enum-descriptor)
+       (print-enum value desc name stream (and pretty-print-p indent)))
+      ((typep desc 'map-descriptor)
+       (loop for k being the hash-keys of value using (hash-value v)
+             do (if pretty-print-p
+                    (format stream "~&~V,0T~A { " indent name)
+                    (format stream "~A { " name))
+                (print-scalar k (proto-key-type desc) "key" stream nil)
+                (print-field v (proto-value-type desc) "value"
+                             :stream stream
+                             :pretty-print-p nil)
+                (format stream "}")
+                (when pretty-print-p
+                  (format stream "~%"))))
+      ;; This case only happens when the user specifies a custom type and
+      ;; doesn't support it above.
+      (t
+       (error 'unknown-type
+              :format-control "unknown type ~S, while printing non-repeated field ~S"
+              :format-arguments (list type name))))))
+
+(defun print-scalar (val type name stream indent)
+  "Print scalar value to stream
+ Parameters:
+  VAL: The data for the value to print.
+  TYPE: The type of val.
+  NAME: The name to print before the value. If nil, then no
+        name will be printed.
+  STREAM: The stream to print to.
+  INDENT: Either a number or nil.
+          - If indent is a number, indent this print
+            by (+ indent 2) and write a newline at
+            the end.
+          - If indent is nil, then do not indent and
+            do not write a newline."
+  (when (or val (eq type 'boolean) (eq type 'symbol))
+    (when indent
+      (format stream "~&~V,0T" indent))
+    (when name
+      (format stream "~A: " name))
+    (ecase type
+      ((int32 uint32 int64 uint64 sint32 sint64 fixed32 sfixed32 fixed64 sfixed64)
+       (format stream "~D" val))
+      ((string)
+       ;; TODO(cgay): This should be the inverse of parse-string.
+       (format stream "\"~A\"" val))
+      ((byte-vector)
+       (format stream "~S" val))
+      ((boolean)
+       (format stream "~A" (if val "true" "false")))
+      ((float double-float)
+       (format stream "~D" val))
+      ;; A few of our homegrown types
+      ((symbol)
+       (format stream "\"~A\"" (lisp-symbol-string val)))
+      ((date time datetime timestamp)
+       (format stream "~D" val)))
+    (if indent
+        (format stream "~%")
+        (format stream " "))))
+
+(defun print-enum (val enum name stream indent)
+  "Print enum to stream
+
+Parameters:
+  VAL: The enum value.
+  ENUM: The enum descriptor.
+  NAME: The name to print before the value. If NIL, no name will be printed.
+  STREAM: The stream to print to.
+  INDENT: Either a number or nil.
+          - If indent is a number, indent this print
+            by (+ indent 2) and write a newline at
+            the end.
+          - If indent is nil, then do not indent and
+            do not write a newline."
+  (when val
+    (when indent
+      (format stream "~&~V,0T" indent))
+    (when name
+      (format stream "~A: " name))
+    (let* ((e (find (keywordify val)
+                    (enum-descriptor-values enum)
+                    :key #'enum-value-descriptor-name))
+           (value (and e (enum-value-descriptor-name e)))
+           (proto-keyword-value (substitute #\_ #\- (string value))))
+      (format stream "~A" proto-keyword-value)
+      (if indent
+          (format stream "~%")
+          (format stream " ")))))
+
+(defun print-message-brace (opening-p name pretty-print-p indent stream)
+  "Print either the opening NAME { or closing }.
+
+Parameters:
+  OPENING-P: Is this an opening or closing brace.
+  NAME: The name to print before the value. If NIL, no name will be printed.
+  PRETTY-PRINT-P: When true, print newlines and indentation.
+  INDENT: A set indentation to print to. Used only for pretty-print.
+  STREAM: The stream to print to."
+  (if opening-p
+      (if pretty-print-p
+          (format stream "~&~V,0T~A {~%" indent name)
+          (format stream "~A { " name))
+      (if pretty-print-p
+          (format stream "~&~V,0T}~%" indent)
+          (format stream "} "))))
+
+;;; Parse objects that were serialized using the text format
+
+(defun parse-text-format (type &key (stream *standard-input*))
+  "Parses an object in stream STREAM of type TYPE written in text format."
+  (declare (type symbol type)
+           (type stream stream))
+  (let ((message (find-message-descriptor type :error-p t)))
+    (parse-text-format-impl message :stream stream)))
+
+;;; TODO(cgay): replace all assertions here with something that signals a
+;;; subtype of protobuf-error and shows current stream position.
+
+(defun parse-text-format-impl
+    (msg-desc &key (stream *standard-input*))
+  "Parse a protobuf message with descriptor MSG-DESC from STREAM. This method
+returns the parsed object."
+  (declare (type message-descriptor msg-desc))
+  (let ((object (funcall (get-constructor-name
+                          (or (proto-alias-for msg-desc)
+                              (proto-class msg-desc)))))
+        ;; Repeated slot names, tracks which slots need to be nreversed.
+        (rslots ()))
+    (loop
+      (skip-whitespace-comments-and-chars stream)
+      (when (or (not (peek-char nil stream nil))
+                (eql (peek-char nil stream nil) #\})
+                (eql (peek-char nil stream nil) #\>))
+        ;; We should respect the order of slots as
+        ;; they were in the message.
+        (dolist (slot rslots)
+          (setf (proto-slot-value object slot)
+                (nreverse (proto-slot-value object slot))))
+        (return-from parse-text-format-impl object))
+      (let* ((name  (parse-token stream))
+             (field (and name (find-field-descriptor msg-desc name)))
+             (type (and field (proto-class field)))
+             (slot  (and field (proto-external-field-name field)))
+             (repeated-p (and field (eql :repeated (proto-label field)))))
+        (if (null field)
+            (error 'unknown-field
+                   :format-control "unknown field ~S, while parsing message of type ~A"
+                   :format-arguments (list name msg-desc))
+            (multiple-value-bind (val error-p)
+                (parse-field type :stream stream :repeated-p repeated-p)
+              (cond
+                (error-p
+                 (unknown-field-type type field msg-desc))
+                (repeated-p
+                 ;; If slot is NIL, then this field doesn't exist in the message
+                 ;; so we skip it.
+                 (when slot
+                   (pushnew slot rslots)
+                   ;; Brief note on val: VAL should be a list.
+                   ;; In the case of repeated symbol slot, we may have
+                   ;; symbol: nil
+                   ;; in which case we want the symbol nil, which happens to
+                   ;; also be a list...  since for a repeated field foo
+                   ;; foo:  # no value defined for foo
+                   ;; is invalid, we aren't going to have collisions.
+                   (if (and (listp val) val)
+                       (dolist (el val)
+                         (push el (proto-slot-value object slot)))
+                       (push val (proto-slot-value object slot)))))
+                ((eq (proto-kind field) :map)
+                 (dolist (pair val)
+                   (setf (gethash (car pair) (proto-slot-value object slot))
+                         (cdr pair))))
+                (t
+                 (when slot
+                   (setf (proto-slot-value object slot) val))))))))))
+
+(defun parse-field (type &key (stream *standard-input*) repeated-p)
+  "Parse data of type TYPE from STREAM. This function returns
+the object parsed. We need to know if hte field is REPEATED-P.
+If the parsing fails, the function will
+return T as a second value."
+  (let ((desc (or (find-message-descriptor type)
+                  (find-enum-descriptor type)
+                  (find-map-descriptor type))))
+    (flet ((parse-message ()
+             (skip-whitespace-comments-and-chars stream)
+             (let ((start-char (expect-char stream '(#\{ #\<))))
+               (prog1
+                   (parse-text-format-impl (find-message-descriptor type) :stream stream)
+                 (skip-whitespace-comments-and-chars stream)
+                 (expect-matching-end stream start-char))))
+           (parse-scalar ()
+             (case type
+               ((float) (parse-float stream))
+               ((double-float) (parse-double stream))
+               ((string) (parse-string stream))
+               ((symbol) (make-lisp-symbol (parse-string stream) t))
+               ((boolean) (let ((token (parse-token stream)))
+                            (cond ((string= token "true") t)
+                                  ((string= token "false") nil)
+                                  ;; Parsing failed, so return T as
+                                  ;; a second value to indicate a
+                                  ;; failure.
+                                  (t (values nil t)))))
+               (otherwise (parse-signed-int stream))))
+           (parse (parse-function)
+             (when (eql (peek-char nil stream nil) #\:)
+               (read-char stream))
+             (skip-whitespace-comments-and-chars stream)
+             (if (and repeated-p
+                      (eq (peek-char nil stream nil) #\[))
+                 (progn
+                   (read-char stream)
+                   (skip-whitespace-comments-and-chars stream :chars #\,)
+                   (let ((element-list (loop until (eq (peek-char nil stream nil) #\])
+                                             collect (funcall parse-function)
+                                             do
+                                          (skip-whitespace-comments-and-chars stream :chars #\,))))
+                     (read-char stream)
+                     element-list))
+                 (funcall parse-function))))
+
+      (cond ((scalarp type)
+             (parse #'parse-scalar))
+            ((typep desc 'message-descriptor)
+             (parse #'parse-message))
+            ((typep desc 'enum-descriptor)
+             (expect-char stream #\:)
+             (let* ((name (parse-token stream))
+                    (enum (find (keywordify name) (enum-descriptor-values desc)
+                                :key #'enum-value-descriptor-name)))
+               (and enum (enum-value-descriptor-name enum))))
+            ((typep desc 'map-descriptor)
+             (let ((key-type (proto-key-type desc))
+                   (val-type (proto-value-type desc)))
+               (flet ((parse-map-entry (key-type val-type stream)
+                        (let (key val)
+                          (expect-char stream #\{)
+                          (assert (string= "key" (parse-token stream)))
+                          (setf key (parse-field key-type :stream stream))
+                          (skip-whitespace-comments-and-chars stream)
+                          (assert (string= "value" (parse-token stream)))
+                          (setf val (parse-field val-type :stream stream))
+                          (skip-whitespace-comments-and-chars stream)
+                          (expect-char stream #\})
+                          (cons key val))))
+                 (case (peek-char nil stream nil)
+                   ((#\:)
+                    (expect-char stream #\:)
+                    (expect-char stream #\[)
+                    (loop
+                        with pairs = ()
+                        do (skip-whitespace-comments-and-chars stream)
+                           (push (parse-map-entry key-type val-type stream)
+                                 pairs)
+                           (if (eql (peek-char nil stream nil) #\,)
+                               (read-char stream)
+                               (progn
+                                 (skip-whitespace-comments-and-chars stream)
+                                 (expect-char stream #\])
+                                 (return pairs)))))
+                   (t
+                    (skip-whitespace-comments-and-chars stream)
+                    (list (parse-map-entry key-type val-type stream)))))))
+            ;; Parsing failed, return t as a second vlaue to indicate failure.
+            (t (values nil t))))))
+
+(defun fmt (stream proto colon-p at-sign-p &optional width &rest other-args)
+  "Format command for protobufs
+   ~/cl-protobufs:fmt/ emits a non-pretty-printed protobuf of PROTO to STREAM.
+   ~@/cl-protobufs:fmt/ emits a pretty-printed protobuf of PROTO to STREAM.
+   COLON-P and AT-SIGN-P are the usual for format directives.
+   WIDTH and OTHER-ARGS  is ignored."
+  (declare (ignore width))
+  (cond (other-args (error "FORMAT directive ~~/cl-protobufs:fmt/ takes only one argument."))
+        (colon-p (error "FORMAT directive ~~/cl-protobufs:fmt/ does not take colons."))
+        (t (print-text-format proto :stream stream :pretty-print-p at-sign-p))))

examples/meshtastic/lisp/cl-protobufs/utilities.lisp

@@ -0,0 +1,642 @@
+;;; Copyright 2012-2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+(in-package #:cl-protobufs.implementation)
+
+
+
+;;; Optimized fixnum arithmetic
+
+;;; By default we optimize select portions of cl-protobufs code that need to be
+;;; very fast by using *optimize-fast-unsafe*. Serialization is the primary
+;;; example. Use (PUSHNEW :DBG *FEATURES*) to turn this off during development.
+;;; Doing so has exposed bugs in the past.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defparameter *optimize-fast-unsafe*
+  #+dbg '(optimize (speed 1) (safety 3) (debug 3))
+  #-dbg '(optimize (speed 3) (safety 0) (debug 0))
+  "Compiler optimization settings for fast, unsafe, hard-to-debug code.")
+
+) ; eval-when
+
+
+(defmacro defun-inline (name arglist &body body)
+  "Define an inline function with NAME, ARGLIST, and BODY."
+  `(progn (declaim (inline ,name))
+          (defun ,name ,arglist ,@body)))
+
+
+(defmacro i+ (&rest fixnums)
+  "Do fixnum addition on FIXNUMS."
+  `(the fixnum (+ ,@(loop for n in fixnums collect `(the fixnum ,n)))))
+
+(defmacro i- (&rest fixnums)
+  "Do fixnum subtraction on FIXNUMS."
+  `(the fixnum (- ,@(loop for n in fixnums collect `(the fixnum ,n)))))
+
+(defmacro i* (&rest fixnums)
+  "Do fixnum multiplication on FIXNUMS."
+  `(the fixnum (* ,@(loop for n in fixnums collect `(the fixnum ,n)))))
+
+(defmacro i= (&rest fixnums)
+  "Check FIXNUMS for equality."
+  `(= ,@(loop for n in fixnums collect `(the fixnum ,n))))
+
+(defmacro i< (&rest fixnums)
+  "Check that FIXNUMS are monotonically increasing left to right."
+  `(< ,@(loop for n in fixnums collect `(the fixnum ,n))))
+
+(defmacro i<= (&rest fixnums)
+  "Check that FIXNUMS are not decreasing, left to right."
+  `(<= ,@(loop for n in fixnums collect `(the fixnum ,n))))
+
+(defmacro i> (&rest fixnums)
+  "Check that FIXNUMS are monotonically decreasing, left to right."
+  `(> ,@(loop for n in fixnums collect `(the fixnum ,n))))
+
+(defmacro i>= (&rest fixnums)
+  "Check that FIXNUMS are not increasing, left to right."
+  `(>= ,@(loop for n in fixnums collect `(the fixnum ,n))))
+
+(defmacro iash (value count)
+  "Shift VALUE left by COUNT places, preserving sign. Negative COUNT shifts right."
+  `(the fixnum (ash (the fixnum ,value) (the fixnum ,count))))
+
+(defmacro ilogior (&rest fixnums)
+  "Return the bit-wise or of FIXNUMS."
+  (if (cdr fixnums)
+      `(the fixnum (logior (the fixnum ,(car fixnums))
+                           ,(if (cddr fixnums)
+                                `(ilogior ,@(cdr fixnums))
+                                `(the fixnum ,(second fixnums)))))
+      `(the fixnum ,(car fixnums))))
+
+(defmacro ilogand (&rest fixnums)
+  "Return the bit-wise and of FIXNUMS."
+  (if (cdr fixnums)
+      `(the fixnum (logand (the fixnum ,(car fixnums))
+                           ,(if (cddr fixnums)
+                                `(ilogand ,@(cdr fixnums))
+                                `(the fixnum ,(second fixnums)))))
+      `(the fixnum ,(car fixnums))))
+
+(define-modify-macro iincf (&optional (delta 1)) i+)
+(define-modify-macro idecf (&optional (delta 1)) i-)
+
+(defmacro ildb (bytespec value)
+  "Extract the specified BYTESPEC from VALUE, and right justify result."
+  `(the fixnum (ldb ,bytespec (the fixnum ,value))))
+
+
+;;; String utilities
+
+(defun starts-with (string prefix)
+  "Returns true if STRING matches PREFIX (case insensitive)."
+  (and (i>= (length string) (length prefix))
+       (string-equal string prefix :end1 (length prefix))
+       prefix))
+
+(defun ends-with (string suffix)
+  "Returns true if STRING matches SUFFIX (case insensitive)."
+  (let ((string-len (length string))
+        (suffix-len (length suffix)))
+    (and (i>= string-len suffix-len)
+         (string-equal string suffix :start1 (i- string-len suffix-len))
+         suffix)))
+
+(defun strcat (&rest strings)
+  "Return the concatenation of STRINGS. If no arguments are passed, the empty string is returned."
+  (declare (dynamic-extent strings))
+  (let ((result (apply #'concatenate 'string strings)))
+    (if (and (not (typep result 'base-string))
+             (every (lambda (x) (typep x 'base-char)) result))
+        (coerce result 'base-string)
+        result)))
+
+(defun camel-case (string &optional (separators '(#\-)))
+  "Convert STRING to camel-case by splitting on any of the SEPARATORS and then joining back together
+   after capitalizing each part.
+   Ex: (camel-case \"camel-case\") => \"CamelCase\""
+  (let ((words (split-string string :separators separators)))
+    (format nil "~{~@(~A~)~}" words)))
+
+(defun camel-case-but-one (string &optional (separators '(#\-)))
+  "Convert STRING to camel-case by splitting on any of the SEPARATORS and then joining back
+   together after capitalizing all except the first part.
+   Ex: (camel-case-but-one \"camel-case\") => \"camelCase\""
+  (let ((words (split-string string :separators separators)))
+    (format nil "~(~A~)~{~@(~A~)~}" (car words) (cdr words))))
+
+
+;; NB: uncamel-case is not reversible, i.e., it is lossy w.r.t. the original name.
+;; (uncamel-case "CamelCase") => "CAMEL-CASE"
+;; (uncamel-case "TCPConnection") => "TCP-CONNECTION"
+;; (uncamel-case "NewTCPConnection") => "NEW-TCP-CONNECTION"
+;; (uncamel-case "new_RPC_LispService") => "NEW-RPC-LISP-SERVICE"
+;; (uncamel-case "RPC_LispServiceRequest_get_request") => "RPC-LISP-SERVICE-REQUEST-GET-REQUEST"
+;; (uncamel-case "TCP2Name3") => "TCP2-NAME3"
+(defun uncamel-case (name &optional (separator #\-))
+  "Convert NAME from camel-case to a SEPARATOR-separated string."
+  ;; We need a whole state machine to get this right
+  (labels ((uncamel (chars state result)
+             (let ((ch (first chars)))
+               (cond ((null chars)
+                      result)
+                     ((upper-case-p ch)
+                      (uncamel (rest chars) 'upper
+                               (case state
+                                 ((upper)
+                                  ;; "TCPConnection" => "TCP-CONNECTION"
+                                  (if (and (second chars) (lower-case-p (second chars)))
+                                      (list* ch separator result)
+                                      (cons ch result)))
+                                 ((lower digit) (list* ch separator result))
+                                 (otherwise (cons ch result)))))
+                     ((lower-case-p ch)
+                      (uncamel (rest chars) 'lower
+                               (cons (char-upcase ch) result)))
+                     ((digit-char-p ch)
+                      (uncamel (rest chars) 'digit
+                               (cons ch result)))
+                     ((or (eql ch #\-) (eql ch #\_))
+                      (uncamel (rest chars) 'dash
+                               (cons #\- result)))
+                     ((eql ch #\.)
+                      (uncamel (rest chars) 'dot
+                               (cons #\. result)))
+                     (t
+                      (protobuf-error "Invalid name character: ~S" ch))))))
+    (strcat (nreverse (uncamel (concatenate 'list name) nil ())))))
+
+(defun split-string (line &key (start 0) (end (length line)) (separators '(#\-)))
+  "Split LINE at each of the characters in SEPARATORS starting at START and ending before END.
+   Returns a list strings, with empty strings removed.
+   Ex: (split-string \"-a-b\") => (\"a\" \"b\")"
+  (unless (i= start end)
+    (loop for this fixnum = start then (i+ next 1)
+          for next fixnum = (or (position-if #'(lambda (ch) (member ch separators)) line
+                                             :start this :end end)
+                                end)
+          for piece = (string-right-trim '(#\space) (subseq line this next))
+          when (not (i= (length piece) 0))
+            collect piece
+          until (i>= next end))))
+
+;;; Managing symbols
+
+(defmacro with-gensyms ((&rest bindings) &body body)
+  "Bind each symbol in BINDINGS to a gensym'd symbol containing its name."
+  `(let ,(mapcar #'(lambda (b) `(,b (gensym ,(string b))))
+          bindings)
+     ,@body))
+
+(defun lisp-symbol-string (symbol)
+  "Returns the string used as the wire format for SYMBOL."
+  (case symbol
+    ((t) "T")
+    ((nil) "NIL")
+    (:t ":T")
+    (:nil ":NIL")
+    (otherwise
+     (if (keywordp symbol)
+         (symbol-name symbol)
+         (format nil "~A:~A"
+                 (let ((package (symbol-package symbol)))
+                   (if package (package-name package) "#"))
+                 (symbol-name symbol))))))
+
+(defun make-lisp-symbol (input-string &optional check-bad-chars)
+  "Intern the symbol described by INPUT-STRING. If INPUT-STRING is
+   \"nil\" or \"t\" then return nil or t. If string has no colon
+   return a keyword symbol.
+   Otherwise, STRING should be of the form 'package:string' and the symbol
+   PACKAGE::STRING is returned.
+   If CHECK-BAD-CHARS is specified, disallow strings with more than one colon
+   or strings that have certain other bad characters."
+  (let ((string (string-upcase input-string)))
+    (cond
+      ((string= string "T") T)
+      ((string= string "NIL") NIL)
+      (t
+       (when check-bad-chars
+         (let* ((bad-chars `(#\' #\\ #\"))
+                (bad-char (find-if #'(lambda (x) (member x bad-chars)) string)))
+           (when bad-char
+             (protobuf-error "Invalid symbol character ~S in ~S" bad-char input-string))))
+       (let ((pos (position #\: string))
+             symbol-name
+             package-name)
+         (if pos
+             (setq symbol-name (subseq string (1+ pos))
+                   package-name (if (= pos 0) "KEYWORD" (subseq string 0 pos)))
+             (setq symbol-name string
+                   package-name "KEYWORD"))
+         (when (and check-bad-chars
+                    (find #\: symbol-name))
+           (protobuf-error "Invalid symbol character ~S in ~S" #\: input-string))
+         (if (string= package-name "#")
+             (make-symbol symbol-name)
+             (let ((package (or (find-package package-name)
+                                (make-package package-name :use ()))))
+               ;; Discard 2nd value from intern so that this function returns only 1 value.
+               (values (intern symbol-name package)))))))))
+
+(defun qualified-symbol-name (symbol)
+  "Return a string representing SYMBOL qualified with its package name."
+  (let* ((*package* (find-package :keyword)))
+    (prin1-to-string symbol)))
+
+(defun fintern (format-string &rest format-args)
+  "Interns a new symbol in the current package. The symbol name is the result of applying #'format
+   to FORMAT-STRING and FORMAT-ARGS."
+  (declare (dynamic-extent format-args))
+  (intern (nstring-upcase (apply #'format nil format-string format-args))))
+
+(defun kintern (format-string &rest format-args)
+  "Interns a new symbol in the keyword package. The symbol name is the result of applying 'format to
+   FORMAT-STRING and FORMAT-ARGS."
+  (declare (dynamic-extent format-args))
+  (intern (nstring-upcase (apply #'format nil format-string format-args)) "KEYWORD"))
+
+(defun keywordify (x)
+  "Given a symbol designator X, returns a keyword symbol whose name is (symbol-name X).
+   If X is nil, returns nil."
+  (check-type x (or string symbol null))
+  (cond ((null x) nil)
+        ((keywordp x) x)
+        ((symbolp x) (keywordify (symbol-name x)))
+        ((zerop (length x)) nil)
+        ((string-not-equal x "nil")
+         (intern (substitute #\- #\_ (string-upcase x)) (find-package "KEYWORD")))))
+
+(defun join-intern (&rest symbols)
+  "Given SYMBOLS, return a symbol made by joining the symbol names with a dot, e.g.
+   SYMBOL1.SYMBOL2.SYMBOL3.  The resulting symbol is interned in the package of the first symbol."
+  (when symbols
+    (intern (format nil "~{~A~^.~}" symbols)
+            (symbol-package (first symbols)))))
+
+;;; Collectors, etc
+
+(defun proto-slot-function-name (proto-type slot function-type)
+  "Create function names for proto fields given their slot name.
+Arguments:
+  PROTO-TYPE: The symbol naming a protobuf message, group, etc.
+  SLOT: The symbol naming a protobuf field.
+  FUNCTION-TYPE: The type of function name to retrieve:
+                 This can be :has, :get, or :clear (for normal fields).
+                 This can also be :map-get or :map-rem for the special map functions.
+                 Finally, it can be :case for the special oneof function."
+  (declare (type symbol proto-type slot)
+           (type (member :has :internal-has :get :clear :map-get :map-rem
+                         :case :push :length-of :nth)
+                 function-type))
+  (let ((f-symbol (ecase function-type
+                    (:has 'has)
+                    (:internal-has '%%has)
+                    (:clear 'clear)
+                    (:get nil)
+                    (:map-get 'gethash)
+                    (:map-rem 'remhash)
+                    (:case 'case)
+                    (:push 'push)
+                    (:length-of 'length-of)
+                    (:nth 'nth))))
+    (cond ((member f-symbol '(gethash remhash case))
+           (intern (nstring-upcase (format nil "~a.~a-~a"
+                                           (symbol-name proto-type)
+                                           (symbol-name slot)
+                                           f-symbol))
+                   (symbol-package proto-type)))
+          (f-symbol
+           (intern (nstring-upcase (format nil "~a.~a-~a"
+                                           (symbol-name proto-type)
+                                           f-symbol
+                                           (symbol-name slot)))
+                   (symbol-package proto-type)))
+          (t
+           (intern (nstring-upcase (format nil "~a.~a"
+                                           (symbol-name proto-type)
+                                           (symbol-name slot)))
+                   (symbol-package proto-type))))))
+
+;;; TODO(cgay): use ace.core.collect when that works on CCL and ABCL.
+(defmacro with-collectors ((&rest collection-descriptions) &body body)
+  "COLLECTION-DESCRIPTIONS is a list of clauses of the form (collection function).
+   The body can call 'function' to add a value to the corresponding 'collection'. Elements are added
+   to the ends of the lists, in constant time. Example:
+     (with-collectors ((numbers collect-number))
+       ... (collect-number n) ...)"
+  (let ((let-bindings  ())
+        (flet-bindings ())
+        (dynamic-extents ())
+        (vobj '#:OBJECT))
+    (dolist (description collection-descriptions)
+      (destructuring-bind (place name) description
+        (let ((vtail (make-symbol (format nil "~A-TAIL" place))))
+          (setq dynamic-extents
+                (nconc dynamic-extents `(#',name)))
+          (setq let-bindings
+                (nconc let-bindings
+                       `((,place ())
+                         (,vtail nil))))
+          (setq flet-bindings
+                (nconc flet-bindings
+                       `((,name (,vobj)
+                                (setq ,vtail (if ,vtail
+                                                 (setf (cdr ,vtail)  (list ,vobj))
+                                                 (setf ,place (list ,vobj)))))))))))
+    `(let (,@let-bindings)
+       (flet (,@flet-bindings)
+         ,@(and dynamic-extents
+                `((declare (dynamic-extent ,@dynamic-extents))))
+         ,@body))))
+
+(defmacro dovector ((var vector &optional result) &body body)
+  "Like DOLIST, but iterates over VECTOR binding VAR to each successive element.
+   Returns RESULT."
+  `(when ,vector
+     (loop for ,var across ,vector
+           do (progn ,@body)
+           finally (return ,result))))
+
+(defmacro doseq ((var sequence &optional result) &body body)
+  "Iterates over SEQUENCE, binding VAR to each element in turn. Uses DOLIST or DOVECTOR depending on
+   the type of the sequence. In optimized code, this turns out to be faster than (map () #'f
+   sequence). Returns RESULT."
+  (with-gensyms (vseq vbody)
+    `(flet ((,vbody (,var) ,@body))
+       (let ((,vseq ,sequence))
+         (if (vectorp ,vseq)
+             (dovector (,var ,vseq ,result)
+               (,vbody ,var))
+             (dolist (,var ,vseq ,result)
+               (,vbody ,var)))))))
+
+
+(defmacro appendf (place tail)
+  "Append TAIL to the list given by PLACE, then set the PLACE to the new list."
+  `(setf ,place (append ,place ,tail)))
+
+
+;;; Types
+
+;; A parameterized list type for repeated fields.  The elements aren't type-checked.
+(deftype list-of (type)
+  (if (eq type nil)         ; a list that cannot have any element (element-type nil) is null
+      'null
+      'list))
+
+;; A parameterized vector type for repeated fields.  The elements aren't type-checked.
+(deftype vector-of (type)
+  (if (eq type nil)         ; an array that cannot have any element (element-type nil) is of size 0
+      '(array * (0))
+      '(array * (*))))      ; a 1-dimensional array of any type
+
+;;; This can't be simple-vector because #() is used as the default in some places. Fix it.
+;;; This corresponds to the :bytes protobuf type.
+(deftype byte-vector () '(array (unsigned-byte 8) (*)))
+
+(defun make-byte-vector (size &key adjustable)
+  "Make a byte vector of length SIZE, optionally ADJUSTABLE."
+  (make-array size :element-type '(unsigned-byte 8)
+                   :adjustable adjustable))
+
+(defconstant +field-number-bits+ 29
+  "Number of bits in a field number.")
+
+(defconstant +max-field-number+ (- (ash 1 +field-number-bits+) 1)
+  "Maximum field number is 2^29 - 1")
+
+(deftype field-number () `(integer 0 ,+max-field-number+))
+
+;; The protobuf integer types
+(deftype    int32 () '(signed-byte 32))
+(deftype    int64 () '(signed-byte 64))
+(deftype   uint32 () '(unsigned-byte 32))
+(deftype   uint64 () '(unsigned-byte 64))
+(deftype   sint32 () '(signed-byte 32))
+(deftype   sint64 () '(signed-byte 64))
+(deftype  fixed32 () '(unsigned-byte 32))
+(deftype  fixed64 () '(unsigned-byte 64))
+(deftype sfixed32 () '(signed-byte 32))
+(deftype sfixed64 () '(signed-byte 64))
+
+(defun fixed-width-integer-type-p (type)
+  "Check whether TYPE can be serialized in a fixed number of bits."
+  (member type '(fixed32 fixed64 sfixed32 sfixed64)))
+
+(defun zigzag-encoded-type-p (type)
+  "Check whether TYPE should be zigzag encoded on the wire."
+  (member type '(sint32 sint64)))
+
+(defun type-expand (type)
+  "Convert TYPE into an equivalent type, removing all references to derived types."
+  #+(or abcl xcl) (system::expand-deftype type)
+  #+allegro (excl:normalize-type type :default type)
+  #+ccl (ccl::type-expand type)
+  #+clisp (ext:type-expand type)
+  #+cmu (kernel:type-expand type)
+  #+(or ecl mkcl) (si::expand-deftype type)
+  #+lispworks (type:expand-user-type type)
+  #+sbcl (sb-ext:typexpand type)
+  #-(or abcl allegro ccl clisp cmu ecl lispworks mkcl sbcl xcl) type)
+
+
+;;; Code generation utilities
+
+(defparameter *proto-name-separators* '(#\- #\_ #\/ #\space)
+  "List of characters to use when splitting Lisp names apart to convert to protobuf names.")
+
+(defparameter *camel-case-field-names* nil
+  "If true, generate camelCase field names, otherwise generate snake_case field names.")
+
+(defun find-proto-package (name)
+  "Find a package named NAME, using various heuristics."
+  (typecase name
+    ((or string symbol)
+     ;; Try looking under the given name and the all-uppercase name.
+     (or (find-package (string name))
+         (find-package (string-upcase (string name)))))
+    (cons
+     ;; If 'name' is a list, it's actually a fully-qualified path.
+     (or (find-proto-package (first name))
+         (find-proto-package (format nil "~{~A~^.~}" name))))))
+
+;; "class-name" -> "ClassName", ("ClassName")
+;; "outer-class.inner-class" -> "InnerClass", ("OuterClass" "InnerClass")
+;;; TODO(cgay): this would be more appropriately named lisp-name->proto-name.
+(defun class-name->proto (lisp-type-name)
+  "Returns the protobuf message or enum name (a string) associated with
+   LISP-TYPE-NAME (a symbol or string)."
+  (let* ((full-path (split-string (string lisp-type-name) :separators '(#\.)))
+         (name-part (first (last full-path))))
+    (remove-if-not #'alphanumericp (camel-case name-part *proto-name-separators*))))
+
+;; "enum-value" -> "ENUM_VALUE", ("ENUM_VALUE")
+;; "class-name.enum-value" -> "ENUM_VALUE", ("ClassName" "ENUM_VALUE")
+(defun enum-name->proto (enum-value-name &optional prefix)
+  "Returns the protobuf enum value name associated with the Lisp ENUM-VALUE-NAME (a string).
+   Strip PREFIX from the returned name, if supplied."
+  (let* ((xs (split-string (string enum-value-name) :separators '(#\.)))
+         (nx (string-upcase (car (last xs))))
+         (nx (if (and prefix (starts-with nx prefix))
+                 (subseq nx (length prefix))
+                 nx))
+         ;; Keep underscores, they are standard separators in Protobufs enum names.
+         (name (remove-if-not #'(lambda (x) (or (alphanumericp x) (eql x #\_)))
+                              (format nil "~{~A~^_~}"
+                                      (split-string nx :separators *proto-name-separators*)))))
+    name))
+
+;; "slot-name" -> "slot_name", ("slot_name") or "slotName", ("slotName")
+;; "class-name.slot-name" -> "Class.slot_name", ("ClassName" "slot_name")
+(defun slot-name->proto (slot-name)
+  "Returns the protobuf field name associated with a Lisp SLOT-NAME (a string)."
+  (let* ((xs (split-string (string slot-name) :separators '(#\.)))
+         (nx (string-downcase (car (last xs))))
+         (name (if *camel-case-field-names*
+                   (remove-if-not #'alphanumericp
+                                  (camel-case-but-one (format nil "~A" nx) *proto-name-separators*))
+                   ;; Keep underscores, they are standard separators in Protobufs field names.
+                   (remove-if-not #'(lambda (x) (or (alphanumericp x) (eql x #\_)))
+                                  (format nil "~{~A~^_~}"
+                                          (split-string nx :separators *proto-name-separators*))))))
+    name))
+
+;; "foo.bar.Baz" -> 'FOO.BAR::BAZ
+;; "foo_bar.bar.Baz" -> 'FOO-BAR.BAR::BAZ
+(defun proto-to-class (proto-name &key (add-cl-protobufs t))
+  "Turn a proto name into a Lisp structure class name.
+Parameters:
+  PROTO-NAME: A proto name will have a package seperated with '.', all
+    in lower case. The class name will be uppercase first, possibility
+    with '.'.
+  ADD-CL-PROTOBUFS: If true prepend 'CL-PROTOBUFS.' to the expected package
+    name found in proto name."
+  (let* ((first-upcase-position
+          (position-if #'upper-case-p proto-name))
+         (name
+          (subseq proto-name first-upcase-position))
+         (package
+          (substitute
+           #\- #\_
+           (string-upcase (subseq proto-name 0
+                                  (1- first-upcase-position))))))
+    (when add-cl-protobufs
+      (setf package (concatenate 'string "CL-PROTOBUFS." package)))
+    (proto->class-name name package)))
+
+;; "ClassName" -> 'class-name
+;; "cl-user.ClassName" -> 'cl-user::class-name
+;; "cl-user.OuterClass.InnerClass" -> 'cl-user::outer-class.inner-class
+(defun proto->class-name (proto-name &optional package)
+  "Returns a Lisp type name (a symbol) for the protobuf message named PROTO-NAME.
+   PROTO-NAME is a dotted string naming a proto message type, e.g., 'package.OuterClass.InnerClass'.
+   If PACKAGE is non-nil and PROTO-NAME doesn't contain any dots the returned symbol is interned
+   into PACKAGE, otherwise an uninterned symbol in the current package is returned."
+  (let* ((full-path
+          (split-string (substitute #\- #\_ (uncamel-case proto-name))
+                        :separators '(#\.)))
+         (top-level (first full-path))
+         (path-from-top (rest full-path))
+         (path-part (butlast full-path))
+         (name-part (last full-path))
+         (pkg1 (when path-from-top (find-proto-package top-level)))
+         ;; TODO(dlroxe) Next line is faithful to original implementation, but
+         ;; TODO(dlroxe) s/path-part/name-part would make more sense to me.
+         (pkgn (when path-from-top (find-proto-package path-part)))
+         (package (or pkg1 pkgn package))
+         (name (nstring-upcase
+                (format nil "~{~A~^.~}" (cond (pkg1 path-from-top)
+                                              (pkgn name-part)
+                                              (t full-path))))))
+    (if package
+        (intern name package)
+        (make-symbol name))))
+
+;; "ENUM_VALUE" -> :enum-value
+;; "cl-user.ENUM_VALUE" -> :enum-value
+;; "cl-user.OuterClass.ENUM_VALUE" -> :enum-value
+(defun proto->enum-name (enum-name)
+  "Returns a Lisp enum value (a keyword symbol) for the protobuf enum value named ENUM-NAME.
+   ENUM-NAME is a dotted string naming a proto enum value, e.g., 'package.OuterClass.ENUM_VALUE'."
+  (let* ((xs (split-string (substitute #\- #\_ (uncamel-case enum-name))
+                           :separators '(#\.)))
+         (pkg1 (and (cdr xs) (find-proto-package (first xs))))
+         (pkgn (and (cdr xs) (find-proto-package (butlast xs)))))
+    (kintern (format nil "~{~A~^.~}" (cond (pkg1 (cdr xs))
+                                           (pkgn (last xs))
+                                           (t xs))))))
+
+;; "slot_name" or "slotName" -> 'slot-name
+;; "cl-user.slot_name" or "cl-user.slotName" -> 'cl-user::slot-name
+;; "cl-user.OuterClass.slot_name" -> 'cl-user::outer-class.slot-name
+;; TODO(cgay): Can package default to *package* now that we've gotten rid of *protobuf-package*?
+;;             What's the use case for returning an uninterned symbol?
+(defun proto->slot-name (field-name &optional package)
+  "Returns a Lisp slot name (a symbol) for the protobuf field named FIELD-NAME.
+   FIELD-NAME is a dotted string naming a proto message field, e.g.,
+   'package.OuterClass.field_name'. If PACKAGE is non-nil and FIELD-NAME doesn't contain any dots
+   the returned symbol is interned into PACKAGE, otherwise an uninterned symbol in the current
+   package is returned."
+  (let* ((xs (split-string (substitute #\- #\_ (uncamel-case field-name))
+                           :separators '(#\.)))
+         (pkg1 (and (cdr xs) (find-proto-package (first xs))))
+         (pkgn (and (cdr xs) (find-proto-package (butlast xs))))
+         (package (or pkg1 pkgn package))
+         (name (nstring-upcase
+                (format nil "~{~A~^.~}" (cond (pkg1 (cdr xs))
+                                              (pkgn (last xs))
+                                              (t xs))))))
+    (if package
+        (intern name package)
+        (make-symbol name))))
+
+(defun scalarp (type)
+  "Returns true if the given protobuf type TYPE is a scalar type. Scalar
+   types are defined by the protobuf documentation. The cl-protobufs specific
+   type `symbol' is included as a scalar type, as it is treated as a synonym
+   to the `string' type. This is because symbols are transmitted as strings,
+   which are scalars, and then converted based on the lisp_type of the field.
+
+   https://developers.google.com/protocol-buffers/docs/proto#scalar "
+  (member type '(double-float float int32 int64 uint32 uint64 sint32
+                 sint32 sint64 fixed32 fixed64 sfixed32 sfixed64
+                 boolean string byte-vector symbol)))
+
+(defun packed-type-p (type)
+  "Returns true if the given protobuf TYPE can use a packed field."
+  (check-type type symbol)
+  (not (null (member type '(int32 int64 uint32 uint64 sint32 sint64
+                            fixed32 fixed64 sfixed32 sfixed64
+                            boolean float double-float)))))
+
+;;; Warnings
+
+(define-condition protobufs-warning (warning simple-condition) ())
+
+(defun protobufs-warn (format-control &rest format-arguments)
+  "Signal a protobufs-warning condition using FORMAT-CONTROL and FORMAT-ARGUMENTS
+   to generate the warning message."
+  (warn 'protobufs-warning              ; NOLINT
+        :format-control format-control
+        :format-arguments format-arguments))
+
+
+#-(or allegro lispworks)
+(defmacro without-redefinition-warnings (() &body body) ; lint: disable=MISSING-DOCUMENTATION
+  `(progn ,@body))
+
+#+allegro
+(defmacro without-redefinition-warnings (() &body body) ; lint: disable=MISSING-DOCUMENTATION
+  `(excl:without-redefinition-warnings ,@body))
+
+#+lispworks
+(defmacro without-redefinition-warnings (() &body body) ; lint: disable=MISSING-DOCUMENTATION
+  `(let ((dspec:*redefinition-action* :quiet)) ,@body))

examples/meshtastic/lisp/cl-protobufs/well-known-types.lisp

@@ -0,0 +1,73 @@
+;;; Copyright 2020 Google LLC
+;;;
+;;; Use of this source code is governed by an MIT-style
+;;; license that can be found in the LICENSE file or at
+;;; https://opensource.org/licenses/MIT.
+
+;;; Functions for working with well known type
+
+(defpackage #:cl-protobufs.well-known-types
+  (:use #:cl
+        #:cl-protobufs)
+  (:local-nicknames (#:pi #:cl-protobufs.implementation))
+  (:export #:unpack-any
+           #:pack-any))
+
+(in-package #:cl-protobufs.well-known-types)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Any
+;;;
+;;; google.protobuf.Any is a protobuf message that contains
+;;; another message in its serialized form along with a type URL
+;;; that may be used to decode the contained message.
+;;;
+;;; Example:
+;;;
+;;; message MessageWithAny {
+;;;  google.protobuf.Any my_field = 1;
+;;; }
+;;;
+;;; message Internal {
+;;;  int64 internal_field = 1;
+;;; }
+;;;
+;;; To make a MessageWithAny containing an Internal message:
+;;;
+;;; (let* ((a (make-message-with-any :my-field
+;;;                                  (pack-any (make-internal
+;;;                                             :internal-field 1))))
+;;;        (ret (unpack-any (message-with-any.my-field a))))
+;;;   (proto-equal ret (make-internal :internal-field 1))) ; => t
+;;;
+;;; The Any .proto file can be found:
+;;; https://github.com/protocolbuffers/protobuf/blob/master/src/google/protobuf/any.proto
+;;;
+
+(defun resolve-type-url (type-url)
+  "Given a string TYPE-URL, find and return the Lisp type that it names. If no
+message is found, signal an error."
+  (assert (find #\/ type-url :from-end t) ()
+          "Could not find / inside of type-url.")
+  (let* ((type-part-of-url (subseq type-url (1+ (position #\/ type-url :from-end t)))))
+    (pi::find-message-by-qualified-name type-part-of-url :error-p t)))
+
+(defun unpack-any (any-message)
+  "Given an Any message decode the contained message and return it.
+  Parameters:
+   ANY-MESSAGE: The message to unpack."
+  (let* ((type (resolve-type-url (cl-protobufs.google.protobuf:any.type-url any-message)))
+         (value (cl-protobufs.google.protobuf:any.value any-message)))
+    (deserialize-from-bytes type (subseq value 0))))
+
+(defun pack-any (message &key (base-url "type.googleapis.com"))
+    "Create an Any message containing MESSAGE.
+Parameters:
+  MESSAGE: The messag to pack.
+  BASE-URL: The base part of the URL without the final '/'."
+  (let* ((m (cl-protobufs:find-message-descriptor (type-of message))))
+    (cl-protobufs.google.protobuf:make-any
+     ;; This should either use a URL library or manually deal with the trailing
+     ;; slash correctly.
+     :type-url (pi::strcat base-url "/" (pi::proto-qualified-name m))
+     :value (serialize-to-bytes message))))

examples/meshtastic/lisp/main.lisp

@@ -0,0 +1,9 @@
+(in-package :app)
+
+(defun ini ()
+  (qt:ini)
+  (msg:load-messages)
+  (q> |visible| ui:*hour-glass* nil) ; shown during Lisp startup
+  (q> |playing| ui:*busy* t))        ; shown during BLE setup
+
+(qlater 'ini)

examples/meshtastic/lisp/messages.lisp

@@ -0,0 +1,44 @@
+(in-package :msg)
+
+(defvar *messages*   nil)
+(defvar *message-id* 0)
+(defvar *states*     '(:not-received :out-there :received))
+
+(defun add-message (message &optional loading)
+  "Adds passed MESSAGE (a PLIST) to both the QML item model and *MESSAGES*.
+  The model keys are:
+  :m-text :m-sender :m-timestamp :m-id :m-ack-state"
+  (qjs |addMessage| ui:*messages* message)
+  (unless loading
+    (push message *messages*)
+    (qlater 'save-messages)))
+
+(defun change-state (state id)
+  (let ((i-state (position state *states*)))
+    (qjs |changeState| ui:*messages*
+         i-state id)
+    (dolist (msg *messages*)
+      (when (eql (getf msg :m-id) id) ; EQL: might be NIL
+        (setf (getf msg :m-ack-state) i-state)
+        (return))))
+  (qlater 'save-messages))
+
+(defvar *file* (merge-pathnames "data/messages.exp"))
+
+(defun load-messages ()
+  "Loads *MESSAGES* which can directly be passed to the QML item model."
+  (when (probe-file *file*)
+    (with-open-file (s *file*)
+      (setf *messages* (read s)))
+    (dolist (msg (reverse *messages*))
+      (setf *message-id* (max (or (getf msg :m-id) 0)
+                              *message-id*))
+      (add-message msg t))))
+
+(defun save-messages ()
+  "Saves *MESSAGES* by simply printing them into a file."
+  (ensure-directories-exist *file*)
+  (with-open-file (s *file* :direction :output :if-exists :supersede)
+    (let ((*print-pretty* nil))
+      (prin1 *messages* s))))
+

examples/meshtastic/lisp/package.lisp

@@ -0,0 +1,38 @@
+(defpackage :app
+  (:use :cl :qml)
+  (:export))
+
+(defpackage :radio
+  (:use :cl :qml)
+  (:local-nicknames (:pr :cl-protobufs)
+                    (:me :cl-protobufs.meshtastic))
+  (:export
+   #:*channels*
+   #:*config-lora*
+   #:*my-node-info*
+   #:*node-infos*
+   #:*primary-channel*
+   #:*reading*
+   #:*ready*
+   #:*received*
+   #:*region*
+   #:*remote-node*
+   #:start-config
+   #:read-radio
+   #:received-from-radio
+   #:receiving-done
+   #:send-message
+   #:send-to-radio
+   #:set-ready))
+
+(defpackage :messages
+  (:nicknames :msg)
+  (:use :cl :qml)
+  (:export
+   #:*messages*
+   #:*message-id*
+   #:*states*
+   #:add-message
+   #:change-state
+   #:load-messages
+   #:save-messages))

examples/meshtastic/lisp/proto/cl-proto/any.lisp

@@ -0,0 +1,39 @@
+;;; any.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'any
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message any
+    ()
+  ;; Fields
+  (type-url
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "typeUrl")
+  (value
+   :index 2 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "value"))
+
+(cl:export '(any
+             type-url
+             value))

examples/meshtastic/lisp/proto/cl-proto/api.lisp

@@ -0,0 +1,89 @@
+;;; api.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'api
+    :syntax :proto3
+
+     :package "google.protobuf"))
+
+;;; Top-Level messages
+
+(pi:define-message api
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (methods
+   :index 2 :type method :kind :message :label (:repeated :list) :json-name "methods")
+  (options
+   :index 3 :type cl-protobufs.google.protobuf::option :kind :message :label (:repeated :list) :json-name "options")
+  (version
+   :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "version")
+  (source-context
+   :index 5 :type cl-protobufs.google.protobuf::source-context :kind :message :label (:optional) :json-name "sourceContext")
+  (mixins
+   :index 6 :type mixin :kind :message :label (:repeated :list) :json-name "mixins")
+  (syntax
+   :index 7 :type cl-protobufs.google.protobuf::syntax :kind :enum :label (:optional) :json-name "syntax" :default :syntax-proto2))
+
+(pi:define-message method
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (request-type-url
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "requestTypeUrl")
+  (request-streaming
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "requestStreaming")
+  (response-type-url
+   :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "responseTypeUrl")
+  (response-streaming
+   :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "responseStreaming")
+  (options
+   :index 6 :type cl-protobufs.google.protobuf::option :kind :message :label (:repeated :list) :json-name "options")
+  (syntax
+   :index 7 :type cl-protobufs.google.protobuf::syntax :kind :enum :label (:optional) :json-name "syntax" :default :syntax-proto2))
+
+(pi:define-message mixin
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (root
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "root"))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:add-file-descriptor #P"api.proto" 'api)
+)
+
+(cl:export '(api
+             method
+             methods
+             mixin
+             mixins
+             name
+             options
+             request-streaming
+             request-type-url
+             response-streaming
+             response-type-url
+             root
+             source-context
+             syntax
+             version))

examples/meshtastic/lisp/proto/cl-proto/descriptor.lisp

@@ -0,0 +1,591 @@
+;;; descriptor.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'descriptor
+    :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message file-descriptor-set
+    ()
+  ;; Fields
+  (file
+   :index 1 :type file-descriptor-proto :kind :message :label (:repeated :list) :json-name "file"))
+
+(pi:define-message file-descriptor-proto
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (package
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "package")
+  (dependency
+   :index 3 :type cl:string :kind :scalar :label (:repeated :list) :json-name "dependency")
+  (public-dependency
+   :index 10 :type cl-protobufs:int32 :kind :scalar :label (:repeated :list) :json-name "publicDependency")
+  (weak-dependency
+   :index 11 :type cl-protobufs:int32 :kind :scalar :label (:repeated :list) :json-name "weakDependency")
+  (message-type
+   :index 4 :type descriptor-proto :kind :message :label (:repeated :list) :json-name "messageType")
+  (enum-type
+   :index 5 :type enum-descriptor-proto :kind :message :label (:repeated :list) :json-name "enumType")
+  (service
+   :index 6 :type service-descriptor-proto :kind :message :label (:repeated :list) :json-name "service")
+  (extension
+   :index 7 :type field-descriptor-proto :kind :message :label (:repeated :list) :json-name "extension")
+  (options
+   :index 8 :type file-options :kind :message :label (:optional) :json-name "options")
+  (source-code-info
+   :index 9 :type source-code-info :kind :message :label (:optional) :json-name "sourceCodeInfo")
+  (syntax
+   :index 12 :type cl:string :kind :scalar :label (:optional) :json-name "syntax"))
+
+(pi:define-message descriptor-proto
+    ()
+  ;; Nested messages
+
+  (pi:define-message descriptor-proto.extension-range
+      ()
+    ;; Fields
+    (start
+     :index 1 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "start")
+    (end
+     :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "end")
+    (options
+     :index 3 :type extension-range-options :kind :message :label (:optional) :json-name "options"))
+
+  (pi:define-message descriptor-proto.reserved-range
+      ()
+    ;; Fields
+    (start
+     :index 1 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "start")
+    (end
+     :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "end"))
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (field
+   :index 2 :type field-descriptor-proto :kind :message :label (:repeated :list) :json-name "field")
+  (extension
+   :index 6 :type field-descriptor-proto :kind :message :label (:repeated :list) :json-name "extension")
+  (nested-type
+   :index 3 :type descriptor-proto :kind :message :label (:repeated :list) :json-name "nestedType")
+  (enum-type
+   :index 4 :type enum-descriptor-proto :kind :message :label (:repeated :list) :json-name "enumType")
+  (extension-range
+   :index 5 :type descriptor-proto.extension-range :kind :message :label (:repeated :list) :json-name "extensionRange")
+  (oneof-decl
+   :index 8 :type oneof-descriptor-proto :kind :message :label (:repeated :list) :json-name "oneofDecl")
+  (options
+   :index 7 :type message-options :kind :message :label (:optional) :json-name "options")
+  (reserved-range
+   :index 9 :type descriptor-proto.reserved-range :kind :message :label (:repeated :list) :json-name "reservedRange")
+  (reserved-name
+   :index 10 :type cl:string :kind :scalar :label (:repeated :list) :json-name "reservedName"))
+
+(pi:define-message extension-range-options
+    ()
+  ;; Fields
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message field-descriptor-proto
+    ()
+  ;; Nested enums
+
+  (pi:define-enum field-descriptor-proto.type
+      ()
+    (:type-double :index 1)
+    (:type-float :index 2)
+    (:type-int64 :index 3)
+    (:type-uint64 :index 4)
+    (:type-int32 :index 5)
+    (:type-fixed64 :index 6)
+    (:type-fixed32 :index 7)
+    (:type-bool :index 8)
+    (:type-string :index 9)
+    (:type-group :index 10)
+    (:type-message :index 11)
+    (:type-bytes :index 12)
+    (:type-uint32 :index 13)
+    (:type-enum :index 14)
+    (:type-sfixed32 :index 15)
+    (:type-sfixed64 :index 16)
+    (:type-sint32 :index 17)
+    (:type-sint64 :index 18))
+
+  (pi:define-enum field-descriptor-proto.label
+      ()
+    (:label-optional :index 1)
+    (:label-required :index 2)
+    (:label-repeated :index 3))
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (number
+   :index 3 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "number")
+  (label
+   :index 4 :type field-descriptor-proto.label :kind :enum :label (:optional) :json-name "label" :default :label-optional)
+  (type
+   :index 5 :type field-descriptor-proto.type :kind :enum :label (:optional) :json-name "type" :default :type-double)
+  (type-name
+   :index 6 :type cl:string :kind :scalar :label (:optional) :json-name "typeName")
+  (extendee
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "extendee")
+  (default-value
+   :index 7 :type cl:string :kind :scalar :label (:optional) :json-name "defaultValue")
+  (oneof-index
+   :index 9 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "oneofIndex")
+  (json-name
+   :index 10 :type cl:string :kind :scalar :label (:optional) :json-name "jsonName")
+  (options
+   :index 8 :type field-options :kind :message :label (:optional) :json-name "options")
+  (proto3-optional
+   :index 17 :type cl:boolean :kind :scalar :label (:optional) :json-name "proto3Optional"))
+
+(pi:define-message oneof-descriptor-proto
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (options
+   :index 2 :type oneof-options :kind :message :label (:optional) :json-name "options"))
+
+(pi:define-message enum-descriptor-proto
+    ()
+  ;; Nested messages
+
+  (pi:define-message enum-descriptor-proto.enum-reserved-range
+      ()
+    ;; Fields
+    (start
+     :index 1 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "start")
+    (end
+     :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "end"))
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (value
+   :index 2 :type enum-value-descriptor-proto :kind :message :label (:repeated :list) :json-name "value")
+  (options
+   :index 3 :type enum-options :kind :message :label (:optional) :json-name "options")
+  (reserved-range
+   :index 4 :type enum-descriptor-proto.enum-reserved-range :kind :message :label (:repeated :list) :json-name "reservedRange")
+  (reserved-name
+   :index 5 :type cl:string :kind :scalar :label (:repeated :list) :json-name "reservedName"))
+
+(pi:define-message enum-value-descriptor-proto
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (number
+   :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "number")
+  (options
+   :index 3 :type enum-value-options :kind :message :label (:optional) :json-name "options"))
+
+(pi:define-message service-descriptor-proto
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (method
+   :index 2 :type method-descriptor-proto :kind :message :label (:repeated :list) :json-name "method")
+  (options
+   :index 3 :type service-options :kind :message :label (:optional) :json-name "options"))
+
+(pi:define-message method-descriptor-proto
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (input-type
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "inputType")
+  (output-type
+   :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "outputType")
+  (options
+   :index 4 :type method-options :kind :message :label (:optional) :json-name "options")
+  (client-streaming
+   :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "clientStreaming" :default cl:nil)
+  (server-streaming
+   :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "serverStreaming" :default cl:nil))
+
+(pi:define-message file-options
+    ()
+  ;; Nested enums
+
+  (pi:define-enum file-options.optimize-mode
+      ()
+    (:speed :index 1)
+    (:code-size :index 2)
+    (:lite-runtime :index 3))
+  ;; Fields
+  (java-package
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "javaPackage")
+  (java-outer-classname
+   :index 8 :type cl:string :kind :scalar :label (:optional) :json-name "javaOuterClassname")
+  (java-multiple-files
+   :index 10 :type cl:boolean :kind :scalar :label (:optional) :json-name "javaMultipleFiles" :default cl:nil)
+  (java-generate-equals-and-hash
+   :index 20 :type cl:boolean :kind :scalar :label (:optional) :json-name "javaGenerateEqualsAndHash")
+  (java-string-check-utf8
+   :index 27 :type cl:boolean :kind :scalar :label (:optional) :json-name "javaStringCheckUtf8" :default cl:nil)
+  (optimize-for
+   :index 9 :type file-options.optimize-mode :kind :enum :label (:optional) :json-name "optimizeFor" :default :speed)
+  (go-package
+   :index 11 :type cl:string :kind :scalar :label (:optional) :json-name "goPackage")
+  (cc-generic-services
+   :index 16 :type cl:boolean :kind :scalar :label (:optional) :json-name "ccGenericServices" :default cl:nil)
+  (java-generic-services
+   :index 17 :type cl:boolean :kind :scalar :label (:optional) :json-name "javaGenericServices" :default cl:nil)
+  (py-generic-services
+   :index 18 :type cl:boolean :kind :scalar :label (:optional) :json-name "pyGenericServices" :default cl:nil)
+  (php-generic-services
+   :index 42 :type cl:boolean :kind :scalar :label (:optional) :json-name "phpGenericServices" :default cl:nil)
+  (deprecated
+   :index 23 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (cc-enable-arenas
+   :index 31 :type cl:boolean :kind :scalar :label (:optional) :json-name "ccEnableArenas" :default cl:t)
+  (objc-class-prefix
+   :index 36 :type cl:string :kind :scalar :label (:optional) :json-name "objcClassPrefix")
+  (csharp-namespace
+   :index 37 :type cl:string :kind :scalar :label (:optional) :json-name "csharpNamespace")
+  (swift-prefix
+   :index 39 :type cl:string :kind :scalar :label (:optional) :json-name "swiftPrefix")
+  (php-class-prefix
+   :index 40 :type cl:string :kind :scalar :label (:optional) :json-name "phpClassPrefix")
+  (php-namespace
+   :index 41 :type cl:string :kind :scalar :label (:optional) :json-name "phpNamespace")
+  (php-metadata-namespace
+   :index 44 :type cl:string :kind :scalar :label (:optional) :json-name "phpMetadataNamespace")
+  (ruby-package
+   :index 45 :type cl:string :kind :scalar :label (:optional) :json-name "rubyPackage")
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message message-options
+    ()
+  ;; Fields
+  (message-set-wire-format
+   :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "messageSetWireFormat" :default cl:nil)
+  (no-standard-descriptor-accessor
+   :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "noStandardDescriptorAccessor" :default cl:nil)
+  (deprecated
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (map-entry
+   :index 7 :type cl:boolean :kind :scalar :label (:optional) :json-name "mapEntry")
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message field-options
+    ()
+  ;; Nested enums
+
+  (pi:define-enum field-options.c-type
+      ()
+    (:string :index 0)
+    (:cord :index 1)
+    (:string-piece :index 2))
+
+  (pi:define-enum field-options.js-type
+      (:name "JSType")
+    (:js-normal :index 0)
+    (:js-string :index 1)
+    (:js-number :index 2))
+  ;; Fields
+  (ctype
+   :index 1 :type field-options.c-type :kind :enum :label (:optional) :json-name "ctype" :default :string)
+  (packed
+   :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "packed")
+  (jstype
+   :index 6 :type field-options.js-type :kind :enum :label (:optional) :json-name "jstype" :default :js-normal)
+  (lazy
+   :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "lazy" :default cl:nil)
+  (deprecated
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (weak
+   :index 10 :type cl:boolean :kind :scalar :label (:optional) :json-name "weak" :default cl:nil)
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message oneof-options
+    ()
+  ;; Fields
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message enum-options
+    ()
+  ;; Fields
+  (allow-alias
+   :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "allowAlias")
+  (deprecated
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message enum-value-options
+    ()
+  ;; Fields
+  (deprecated
+   :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message service-options
+    ()
+  ;; Fields
+  (deprecated
+   :index 33 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message method-options
+    ()
+  ;; Nested enums
+
+  (pi:define-enum method-options.idempotency-level
+      ()
+    (:idempotency-unknown :index 0)
+    (:no-side-effects :index 1)
+    (:idempotent :index 2))
+  ;; Fields
+  (deprecated
+   :index 33 :type cl:boolean :kind :scalar :label (:optional) :json-name "deprecated" :default cl:nil)
+  (idempotency-level
+   :index 34 :type method-options.idempotency-level :kind :enum :label (:optional) :json-name "idempotencyLevel" :default :idempotency-unknown)
+  (uninterpreted-option
+   :index 999 :type uninterpreted-option :kind :message :label (:repeated :list) :json-name "uninterpretedOption")
+  ;; Extension ranges
+  (pi:define-extension 1000 536870911))
+
+(pi:define-message uninterpreted-option
+    ()
+  ;; Nested messages
+
+  (pi:define-message uninterpreted-option.name-part
+      ()
+    ;; Fields
+    (name-part
+     :index 1 :type cl:string :kind :scalar :label (:required) :json-name "namePart")
+    (is-extension
+     :index 2 :type cl:boolean :kind :scalar :label (:required) :json-name "isExtension"))
+  ;; Fields
+  (name
+   :index 2 :type uninterpreted-option.name-part :kind :message :label (:repeated :list) :json-name "name")
+  (identifier-value
+   :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "identifierValue")
+  (positive-int-value
+   :index 4 :type cl-protobufs:uint64 :kind :scalar :label (:optional) :json-name "positiveIntValue")
+  (negative-int-value
+   :index 5 :type cl-protobufs:int64 :kind :scalar :label (:optional) :json-name "negativeIntValue")
+  (double-value
+   :index 6 :type cl:double-float :kind :scalar :label (:optional) :json-name "doubleValue")
+  (string-value
+   :index 7 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "stringValue")
+  (aggregate-value
+   :index 8 :type cl:string :kind :scalar :label (:optional) :json-name "aggregateValue"))
+
+(pi:define-message source-code-info
+    ()
+  ;; Nested messages
+
+  (pi:define-message source-code-info.location
+      ()
+    ;; Fields
+    (path
+     :index 1 :type cl-protobufs:int32 :kind :scalar :label (:repeated :list) :json-name "path" :packed cl:t)
+    (span
+     :index 2 :type cl-protobufs:int32 :kind :scalar :label (:repeated :list) :json-name "span" :packed cl:t)
+    (leading-comments
+     :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "leadingComments")
+    (trailing-comments
+     :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "trailingComments")
+    (leading-detached-comments
+     :index 6 :type cl:string :kind :scalar :label (:repeated :list) :json-name "leadingDetachedComments"))
+  ;; Fields
+  (location
+   :index 1 :type source-code-info.location :kind :message :label (:repeated :list) :json-name "location"))
+
+(pi:define-message generated-code-info
+    ()
+  ;; Nested messages
+
+  (pi:define-message generated-code-info.annotation
+      ()
+    ;; Fields
+    (path
+     :index 1 :type cl-protobufs:int32 :kind :scalar :label (:repeated :list) :json-name "path" :packed cl:t)
+    (source-file
+     :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "sourceFile")
+    (begin
+     :index 3 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "begin")
+    (end
+     :index 4 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "end"))
+  ;; Fields
+  (annotation
+   :index 1 :type generated-code-info.annotation :kind :message :label (:repeated :list) :json-name "annotation"))
+
+
+(cl:export '(aggregate-value
+             allow-alias
+             annotation
+             begin
+             cc-enable-arenas
+             cc-generic-services
+             client-streaming
+             csharp-namespace
+             ctype
+             default-value
+             dependency
+             deprecated
+             descriptor
+             descriptor-proto
+             descriptor-proto.extension-range
+             descriptor-proto.reserved-range
+             double-value
+             end
+             enum-descriptor-proto
+             enum-descriptor-proto.enum-reserved-range
+             enum-options
+             enum-type
+             enum-value-descriptor-proto
+             enum-value-options
+             extendee
+             extension
+             extension-range
+             extension-range-options
+             field
+             field-descriptor-proto
+             field-descriptor-proto.label
+             field-descriptor-proto.label-int-to-keyword
+             field-descriptor-proto.label-keyword-to-int
+             field-descriptor-proto.type
+             field-descriptor-proto.type-int-to-keyword
+             field-descriptor-proto.type-keyword-to-int
+             field-options
+             field-options.c-type
+             field-options.c-type-int-to-keyword
+             field-options.c-type-keyword-to-int
+             field-options.js-type
+             field-options.js-type-int-to-keyword
+             field-options.js-type-keyword-to-int
+             file
+             file-descriptor-proto
+             file-descriptor-set
+             file-options
+             file-options.optimize-mode
+             file-options.optimize-mode-int-to-keyword
+             file-options.optimize-mode-keyword-to-int
+             generated-code-info
+             generated-code-info.annotation
+             go-package
+             idempotency-level
+             identifier-value
+             input-type
+             is-extension
+             java-generate-equals-and-hash
+             java-generic-services
+             java-multiple-files
+             java-outer-classname
+             java-package
+             java-string-check-utf8
+             json-name
+             jstype
+             label
+             lazy
+             leading-comments
+             leading-detached-comments
+             location
+             map-entry
+             message-options
+             message-set-wire-format
+             message-type
+             method
+             method-descriptor-proto
+             method-options
+             method-options.idempotency-level
+             method-options.idempotency-level-int-to-keyword
+             method-options.idempotency-level-keyword-to-int
+             name
+             name-part
+             negative-int-value
+             nested-type
+             no-standard-descriptor-accessor
+             number
+             objc-class-prefix
+             oneof-decl
+             oneof-descriptor-proto
+             oneof-index
+             oneof-options
+             optimize-for
+             options
+             output-type
+             package
+             packed
+             path
+             php-class-prefix
+             php-generic-services
+             php-metadata-namespace
+             php-namespace
+             positive-int-value
+             proto3-optional
+             public-dependency
+             py-generic-services
+             reserved-name
+             reserved-range
+             ruby-package
+             server-streaming
+             service
+             service-descriptor-proto
+             service-options
+             source-code-info
+             source-code-info.location
+             source-file
+             span
+             start
+             string-value
+             swift-prefix
+             syntax
+             trailing-comments
+             type
+             type-name
+             uninterpreted-option
+             uninterpreted-option.name-part
+             value
+             weak
+             weak-dependency))

examples/meshtastic/lisp/proto/cl-proto/duration.lisp

@@ -0,0 +1,40 @@
+;;; duration.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'duration
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message duration
+    ()
+  ;; Fields
+  (seconds
+   :index 1 :type cl-protobufs:int64 :kind :scalar :label (:optional) :json-name "seconds")
+  (nanos
+   :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "nanos"))
+
+
+(cl:export '(duration
+             nanos
+             seconds))

examples/meshtastic/lisp/proto/cl-proto/empty.lisp

@@ -0,0 +1,33 @@
+;;; empty.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'empty
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message empty
+    ())
+
+
+(cl:export '(empty))

examples/meshtastic/lisp/proto/cl-proto/field-mask.lisp

@@ -0,0 +1,38 @@
+;;; field_mask.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'field_mask
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message field-mask
+    ()
+  ;; Fields
+  (paths
+   :index 1 :type cl:string :kind :scalar :label (:repeated :list) :json-name "paths"))
+
+
+(cl:export '(field-mask
+             field_mask
+             paths))

examples/meshtastic/lisp/proto/cl-proto/source-context.lisp

@@ -0,0 +1,38 @@
+;;; source_context.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'source_context
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message source-context
+    ()
+  ;; Fields
+  (file-name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "fileName"))
+
+
+(cl:export '(file-name
+             source-context
+             source_context))

examples/meshtastic/lisp/proto/cl-proto/struct.lisp

@@ -0,0 +1,83 @@
+;;; struct.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'struct
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level enums
+
+(pi:define-enum null-value
+    ()
+  (:null-value :index 0))
+
+;;; Top-Level messages
+
+(pi:define-message struct
+    ()
+  ;; Nested messages
+  ;; Fields
+  (pi:define-map fields
+     :key-type cl:string
+     :value-type value
+     :json-name "fields"
+     :value-kind :message
+     :index 1))
+
+(pi:define-message value
+    ()
+  ;; Fields
+  (pi:define-oneof kind ()
+    (null-value
+     :index 1 :type null-value :kind :enum :label (:optional) :json-name "nullValue" :default :null-value)
+    (number-value
+     :index 2 :type cl:double-float :kind :scalar :label (:optional) :json-name "numberValue")
+    (string-value
+     :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "stringValue")
+    (bool-value
+     :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "boolValue")
+    (struct-value
+     :index 5 :type struct :kind :message :label (:optional) :json-name "structValue")
+    (list-value
+     :index 6 :type list-value :kind :message :label (:optional) :json-name "listValue")))
+
+(pi:define-message list-value
+    ()
+  ;; Fields
+  (values
+   :index 1 :type value :kind :message :label (:repeated :list) :json-name "values"))
+
+
+(cl:export '(bool-value
+             fields
+             key
+             list-value
+             null-value
+             null-value-int-to-keyword
+             null-value-keyword-to-int
+             number-value
+             string-value
+             struct
+             struct-value
+             struct.fields-entry
+             value
+             values))

examples/meshtastic/lisp/proto/cl-proto/timestamp.lisp

@@ -0,0 +1,40 @@
+;;; timestamp.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'timestamp
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message timestamp
+    ()
+  ;; Fields
+  (seconds
+   :index 1 :type cl-protobufs:int64 :kind :scalar :label (:optional) :json-name "seconds")
+  (nanos
+   :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "nanos"))
+
+
+(cl:export '(nanos
+             seconds
+             timestamp))

examples/meshtastic/lisp/proto/cl-proto/type.lisp

@@ -0,0 +1,168 @@
+;;; type.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'type
+    :syntax :proto3
+
+     :package "google.protobuf"))
+     ;;:import '("any.proto"
+     ;;         "source_context.proto")
+
+
+;;; Top-Level enums
+
+(pi:define-enum syntax
+    ()
+  (:syntax-proto2 :index 0)
+  (:syntax-proto3 :index 1))
+
+;;; Top-Level messages
+
+(pi:define-message type
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (fields
+   :index 2 :type field :kind :message :label (:repeated :list) :json-name "fields")
+  (oneofs
+   :index 3 :type cl:string :kind :scalar :label (:repeated :list) :json-name "oneofs")
+  (options
+   :index 4 :type option :kind :message :label (:repeated :list) :json-name "options")
+  (source-context
+   :index 5 :type cl-protobufs.google.protobuf::source-context :kind :message :label (:optional) :json-name "sourceContext")
+  (syntax
+   :index 6 :type syntax :kind :enum :label (:optional) :json-name "syntax" :default :syntax-proto2))
+
+(pi:define-message field
+    ()
+  ;; Nested enums
+
+  (pi:define-enum field.kind
+      ()
+    (:type-unknown :index 0)
+    (:type-double :index 1)
+    (:type-float :index 2)
+    (:type-int64 :index 3)
+    (:type-uint64 :index 4)
+    (:type-int32 :index 5)
+    (:type-fixed64 :index 6)
+    (:type-fixed32 :index 7)
+    (:type-bool :index 8)
+    (:type-string :index 9)
+    (:type-group :index 10)
+    (:type-message :index 11)
+    (:type-bytes :index 12)
+    (:type-uint32 :index 13)
+    (:type-enum :index 14)
+    (:type-sfixed32 :index 15)
+    (:type-sfixed64 :index 16)
+    (:type-sint32 :index 17)
+    (:type-sint64 :index 18))
+
+  (pi:define-enum field.cardinality
+      ()
+    (:cardinality-unknown :index 0)
+    (:cardinality-optional :index 1)
+    (:cardinality-required :index 2)
+    (:cardinality-repeated :index 3))
+  ;; Fields
+  (kind
+   :index 1 :type field.kind :kind :enum :label (:optional) :json-name "kind" :default :type-unknown)
+  (cardinality
+   :index 2 :type field.cardinality :kind :enum :label (:optional) :json-name "cardinality" :default :cardinality-unknown)
+  (number
+   :index 3 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "number")
+  (name
+   :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (type-url
+   :index 6 :type cl:string :kind :scalar :label (:optional) :json-name "typeUrl")
+  (oneof-index
+   :index 7 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "oneofIndex")
+  (packed
+   :index 8 :type cl:boolean :kind :scalar :label (:optional) :json-name "packed")
+  (options
+   :index 9 :type option :kind :message :label (:repeated :list) :json-name "options")
+  (json-name
+   :index 10 :type cl:string :kind :scalar :label (:optional) :json-name "jsonName")
+  (default-value
+   :index 11 :type cl:string :kind :scalar :label (:optional) :json-name "defaultValue"))
+
+(pi:define-message enum
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (enumvalue
+   :index 2 :type enum-value :kind :message :label (:repeated :list) :json-name "enumvalue")
+  (options
+   :index 3 :type option :kind :message :label (:repeated :list) :json-name "options")
+  (source-context
+   :index 4 :type cl-protobufs.google.protobuf::source-context :kind :message :label (:optional) :json-name "sourceContext")
+  (syntax
+   :index 5 :type syntax :kind :enum :label (:optional) :json-name "syntax" :default :syntax-proto2))
+
+(pi:define-message enum-value
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (number
+   :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "number")
+  (options
+   :index 3 :type option :kind :message :label (:repeated :list) :json-name "options"))
+
+(pi:define-message option
+    ()
+  ;; Fields
+  (name
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (value
+   :index 2 :type cl-protobufs.google.protobuf::any :kind :message :label (:optional) :json-name "value"))
+
+
+(cl:export '(cardinality
+             default-value
+             enum
+             enum-value
+             enumvalue
+             field
+             field.cardinality
+             field.cardinality-int-to-keyword
+             field.cardinality-keyword-to-int
+             field.kind
+             field.kind-int-to-keyword
+             field.kind-keyword-to-int
+             fields
+             json-name
+             kind
+             name
+             number
+             oneof-index
+             oneofs
+             option
+             options
+             packed
+             source-context
+             syntax
+             syntax-int-to-keyword
+             syntax-keyword-to-int
+             type
+             type-url
+             value))

examples/meshtastic/lisp/proto/cl-proto/wrappers.lisp

@@ -0,0 +1,94 @@
+;;; wrappers.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+    (cl:defpackage "CL-PROTOBUFS.GOOGLE.PROTOBUF" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.GOOGLE.PROTOBUF")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'wrappers
+    :syntax :proto3
+
+     :package "google.protobuf")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message double-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl:double-float :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message float-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl:float :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message int64-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl-protobufs:int64 :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message u-int64-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl-protobufs:uint64 :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message int32-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message u-int32-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message bool-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message string-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "value"))
+
+(pi:define-message bytes-value
+    ()
+  ;; Fields
+  (value
+   :index 1 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "value"))
+
+
+(cl:export '(bool-value
+             bytes-value
+             double-value
+             float-value
+             int32-value
+             int64-value
+             string-value
+             u-int32-value
+             u-int64-value
+             value
+             wrappers))

examples/meshtastic/lisp/proto/meshtastic/admin.lisp

@@ -0,0 +1,180 @@
+;;; meshtastic/admin.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'admin
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/channel.proto"
+               ;;"meshtastic/config.proto"
+               ;;"meshtastic/mesh.proto"
+               ;;"meshtastic/module_config.proto"
+               ;;"meshtastic/connection_status.proto"
+               ))
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message admin-message
+    ()
+  ;; Nested enums
+
+  (pi:define-enum admin-message.config-type
+      ()
+    (:device-config :index 0)
+    (:position-config :index 1)
+    (:power-config :index 2)
+    (:network-config :index 3)
+    (:display-config :index 4)
+    (:lora-config :index 5)
+    (:bluetooth-config :index 6))
+
+  (pi:define-enum admin-message.module-config-type
+      ()
+    (:mqtt-config :index 0)
+    (:serial-config :index 1)
+    (:extnotif-config :index 2)
+    (:storeforward-config :index 3)
+    (:rangetest-config :index 4)
+    (:telemetry-config :index 5)
+    (:cannedmsg-config :index 6)
+    (:audio-config :index 7)
+    (:remotehardware-config :index 8))
+  ;; Fields
+  (pi:define-oneof payload-variant ()
+    (get-channel-request
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "getChannelRequest")
+    (get-channel-response
+     :index 2 :type cl-protobufs.meshtastic::channel :kind :message :label (:optional) :json-name "getChannelResponse")
+    (get-owner-request
+     :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "getOwnerRequest")
+    (get-owner-response
+     :index 4 :type cl-protobufs.meshtastic::user :kind :message :label (:optional) :json-name "getOwnerResponse")
+    (get-config-request
+     :index 5 :type admin-message.config-type :kind :enum :label (:optional) :json-name "getConfigRequest" :default :device-config)
+    (get-config-response
+     :index 6 :type cl-protobufs.meshtastic::config :kind :message :label (:optional) :json-name "getConfigResponse")
+    (get-module-config-request
+     :index 7 :type admin-message.module-config-type :kind :enum :label (:optional) :json-name "getModuleConfigRequest" :default :mqtt-config)
+    (get-module-config-response
+     :index 8 :type cl-protobufs.meshtastic::module-config :kind :message :label (:optional) :json-name "getModuleConfigResponse")
+    (get-canned-message-module-messages-request
+     :index 10 :type cl:boolean :kind :scalar :label (:optional) :json-name "getCannedMessageModuleMessagesRequest")
+    (get-canned-message-module-messages-response
+     :index 11 :type cl:string :kind :scalar :label (:optional) :json-name "getCannedMessageModuleMessagesResponse")
+    (get-device-metadata-request
+     :index 12 :type cl:boolean :kind :scalar :label (:optional) :json-name "getDeviceMetadataRequest")
+    (get-device-metadata-response
+     :index 13 :type cl-protobufs.meshtastic::device-metadata :kind :message :label (:optional) :json-name "getDeviceMetadataResponse")
+    (get-ringtone-request
+     :index 14 :type cl:boolean :kind :scalar :label (:optional) :json-name "getRingtoneRequest")
+    (get-ringtone-response
+     :index 15 :type cl:string :kind :scalar :label (:optional) :json-name "getRingtoneResponse")
+    (get-device-connection-status-request
+     :index 16 :type cl:boolean :kind :scalar :label (:optional) :json-name "getDeviceConnectionStatusRequest")
+    (get-device-connection-status-response
+     :index 17 :type cl-protobufs.meshtastic::device-connection-status :kind :message :label (:optional) :json-name "getDeviceConnectionStatusResponse")
+    (set-ham-mode
+     :index 18 :type ham-parameters :kind :message :label (:optional) :json-name "setHamMode")
+    (set-owner
+     :index 32 :type cl-protobufs.meshtastic::user :kind :message :label (:optional) :json-name "setOwner")
+    (set-channel
+     :index 33 :type cl-protobufs.meshtastic::channel :kind :message :label (:optional) :json-name "setChannel")
+    (set-config
+     :index 34 :type cl-protobufs.meshtastic::config :kind :message :label (:optional) :json-name "setConfig")
+    (set-module-config
+     :index 35 :type cl-protobufs.meshtastic::module-config :kind :message :label (:optional) :json-name "setModuleConfig")
+    (set-canned-message-module-messages
+     :index 36 :type cl:string :kind :scalar :label (:optional) :json-name "setCannedMessageModuleMessages")
+    (set-ringtone-message
+     :index 37 :type cl:string :kind :scalar :label (:optional) :json-name "setRingtoneMessage")
+    (begin-edit-settings
+     :index 64 :type cl:boolean :kind :scalar :label (:optional) :json-name "beginEditSettings")
+    (commit-edit-settings
+     :index 65 :type cl:boolean :kind :scalar :label (:optional) :json-name "commitEditSettings")
+    (reboot-ota-seconds
+     :index 95 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "rebootOtaSeconds")
+    (exit-simulator
+     :index 96 :type cl:boolean :kind :scalar :label (:optional) :json-name "exitSimulator")
+    (reboot-seconds
+     :index 97 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "rebootSeconds")
+    (shutdown-seconds
+     :index 98 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "shutdownSeconds")
+    (factory-reset
+     :index 99 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "factoryReset")
+    (nodedb-reset
+     :index 100 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "nodedbReset")))
+
+(pi:define-message ham-parameters
+    ()
+  ;; Fields
+  (call-sign
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "callSign")
+  (tx-power
+   :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "txPower")
+  (frequency
+   :index 3 :type cl:float :kind :scalar :label (:optional) :json-name "frequency")
+  (short-name
+   :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "shortName"))
+
+(cl:export '(admin
+             admin-message
+             admin-message.config-type
+             admin-message.config-type-int-to-keyword
+             admin-message.config-type-keyword-to-int
+             admin-message.module-config-type
+             admin-message.module-config-type-int-to-keyword
+             admin-message.module-config-type-keyword-to-int
+             begin-edit-settings
+             call-sign
+             commit-edit-settings
+             exit-simulator
+             factory-reset
+             frequency
+             get-canned-message-module-messages-request
+             get-canned-message-module-messages-response
+             get-channel-request
+             get-channel-response
+             get-config-request
+             get-config-response
+             get-device-connection-status-request
+             get-device-connection-status-response
+             get-device-metadata-request
+             get-device-metadata-response
+             get-module-config-request
+             get-module-config-response
+             get-owner-request
+             get-owner-response
+             get-ringtone-request
+             get-ringtone-response
+             ham-parameters
+             nodedb-reset
+             reboot-ota-seconds
+             reboot-seconds
+             set-canned-message-module-messages
+             set-channel
+             set-config
+             set-ham-mode
+             set-module-config
+             set-owner
+             set-ringtone-message
+             short-name
+             shutdown-seconds
+             tx-power))

examples/meshtastic/lisp/proto/meshtastic/apponly.lisp

@@ -0,0 +1,43 @@
+;;; meshtastic/apponly.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'apponly
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/channel.proto"
+               ;;"meshtastic/config.proto"
+               ))
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message channel-set
+    ()
+  ;; Fields
+  (settings
+   :index 1 :type cl-protobufs.meshtastic::channel-settings :kind :message :label (:repeated :list) :json-name "settings")
+  (lora-config
+   :index 2 :type cl-protobufs.meshtastic::config.lo-ra-config :kind :message :label (:optional) :json-name "loraConfig"))
+
+(cl:export '(apponly
+             channel-set
+             lora-config
+             settings))

examples/meshtastic/lisp/proto/meshtastic/cannedmessages.lisp

@@ -0,0 +1,37 @@
+;;; meshtastic/cannedmessages.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'cannedmessages
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message canned-message-module-config
+    ()
+  ;; Fields
+  (messages
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "messages"))
+
+(cl:export '(canned-message-module-config
+             cannedmessages
+             messages))

examples/meshtastic/lisp/proto/meshtastic/channel.lisp

@@ -0,0 +1,75 @@
+;;; meshtastic/channel.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'channel
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message channel-settings
+    ()
+  ;; Fields
+  (channel-num
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "channelNum")
+  (psk
+   :index 2 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "psk")
+  (name
+   :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (id
+   :index 4 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "id")
+  (uplink-enabled
+   :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "uplinkEnabled")
+  (downlink-enabled
+   :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "downlinkEnabled"))
+
+(pi:define-message channel
+    ()
+  ;; Nested enums
+
+  (pi:define-enum channel.role
+      ()
+    (:disabled :index 0)
+    (:primary :index 1)
+    (:secondary :index 2))
+  ;; Fields
+  (index
+   :index 1 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "index")
+  (settings
+   :index 2 :type channel-settings :kind :message :label (:optional) :json-name "settings")
+  (role
+   :index 3 :type channel.role :kind :enum :label (:optional) :json-name "role" :default :disabled))
+
+(cl:export '(channel
+             channel-num
+             channel-settings
+             channel.role
+             channel.role-int-to-keyword
+             channel.role-keyword-to-int
+             downlink-enabled
+             id
+             index
+             name
+             psk
+             role
+             settings
+             uplink-enabled))

examples/meshtastic/lisp/proto/meshtastic/clientonly.lisp

@@ -0,0 +1,56 @@
+;;; meshtastic/clientonly.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'clientonly
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/localonly.proto"
+               ))
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message device-profile
+    ()
+  ;; Fields
+  (pi:define-oneof -long-name (:synthetic-p t)
+    (long-name
+     :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "longName"))
+  (pi:define-oneof -short-name (:synthetic-p t)
+    (short-name
+     :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "shortName"))
+  (pi:define-oneof -channel-url (:synthetic-p t)
+    (channel-url
+     :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "channelUrl"))
+  (pi:define-oneof -config (:synthetic-p t)
+    (config
+     :index 4 :type cl-protobufs.meshtastic::local-config :kind :message :label (:optional) :json-name "config"))
+  (pi:define-oneof -module-config (:synthetic-p t)
+    (module-config
+     :index 5 :type cl-protobufs.meshtastic::local-module-config :kind :message :label (:optional) :json-name "moduleConfig")))
+
+(cl:export '(channel-url
+             clientonly
+             config
+             device-profile
+             long-name
+             module-config
+             short-name))

examples/meshtastic/lisp/proto/meshtastic/config.lisp

@@ -0,0 +1,436 @@
+;;; meshtastic/config.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'config
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message config
+    ()
+  ;; Nested messages
+
+  (pi:define-message config.device-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum config.device-config.role
+        ()
+      (:client :index 0)
+      (:client-mute :index 1)
+      (:router :index 2)
+      (:router-client :index 3)
+      (:repeater :index 4)
+      (:tracker :index 5)
+      (:sensor :index 6))
+
+    (pi:define-enum config.device-config.rebroadcast-mode
+        ()
+      (:all :index 0)
+      (:all-skip-decoding :index 1)
+      (:local-only :index 2))
+    ;; Fields
+    (role
+     :index 1 :type config.device-config.role :kind :enum :label (:optional) :json-name "role" :default :client)
+    (serial-enabled
+     :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "serialEnabled")
+    (debug-log-enabled
+     :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "debugLogEnabled")
+    (button-gpio
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "buttonGpio")
+    (buzzer-gpio
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "buzzerGpio")
+    (rebroadcast-mode
+     :index 6 :type config.device-config.rebroadcast-mode :kind :enum :label (:optional) :json-name "rebroadcastMode" :default :all)
+    (node-info-broadcast-secs
+     :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "nodeInfoBroadcastSecs")
+    (double-tap-as-button-press
+     :index 8 :type cl:boolean :kind :scalar :label (:optional) :json-name "doubleTapAsButtonPress"))
+
+  (pi:define-message config.position-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum config.position-config.position-flags
+        ()
+      (:unset :index 0)
+      (:altitude :index 1)
+      (:altitude-msl :index 2)
+      (:geoidal-separation :index 4)
+      (:dop :index 8)
+      (:hvdop :index 16)
+      (:satinview :index 32)
+      (:seq-no :index 64)
+      (:timestamp :index 128)
+      (:heading :index 256)
+      (:speed :index 512))
+    ;; Fields
+    (position-broadcast-secs
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "positionBroadcastSecs")
+    (position-broadcast-smart-enabled
+     :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "positionBroadcastSmartEnabled")
+    (fixed-position
+     :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "fixedPosition")
+    (gps-enabled
+     :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "gpsEnabled")
+    (gps-update-interval
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "gpsUpdateInterval")
+    (gps-attempt-time
+     :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "gpsAttemptTime")
+    (position-flags
+     :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "positionFlags")
+    (rx-gpio
+     :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "rxGpio")
+    (tx-gpio
+     :index 9 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "txGpio")
+    (broadcast-smart-minimum-distance
+     :index 10 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "broadcastSmartMinimumDistance")
+    (broadcast-smart-minimum-interval-secs
+     :index 11 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "broadcastSmartMinimumIntervalSecs"))
+
+  (pi:define-message config.power-config
+      ()
+    ;; Fields
+    (is-power-saving
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "isPowerSaving")
+    (on-battery-shutdown-after-secs
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "onBatteryShutdownAfterSecs")
+    (adc-multiplier-override
+     :index 3 :type cl:float :kind :scalar :label (:optional) :json-name "adcMultiplierOverride")
+    (wait-bluetooth-secs
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "waitBluetoothSecs")
+    (mesh-sds-timeout-secs
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "meshSdsTimeoutSecs")
+    (sds-secs
+     :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "sdsSecs")
+    (ls-secs
+     :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "lsSecs")
+    (min-wake-secs
+     :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "minWakeSecs"))
+
+  (pi:define-message config.network-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum config.network-config.address-mode
+        ()
+      (:dhcp :index 0)
+      (:static :index 1))
+    ;; Nested messages
+
+    (pi:define-message config.network-config.ip-v4-config
+        ()
+      ;; Fields
+      (ip
+       :index 1 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "ip")
+      (gateway
+       :index 2 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "gateway")
+      (subnet
+       :index 3 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "subnet")
+      (dns
+       :index 4 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "dns"))
+    ;; Fields
+    (wifi-enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "wifiEnabled")
+    (wifi-ssid
+     :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "wifiSsid")
+    (wifi-psk
+     :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "wifiPsk")
+    (ntp-server
+     :index 5 :type cl:string :kind :scalar :label (:optional) :json-name "ntpServer")
+    (eth-enabled
+     :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "ethEnabled")
+    (address-mode
+     :index 7 :type config.network-config.address-mode :kind :enum :label (:optional) :json-name "addressMode" :default :dhcp)
+    (ipv4-config
+     :index 8 :type config.network-config.ip-v4-config :kind :message :label (:optional) :json-name "ipv4Config")
+    (rsyslog-server
+     :index 9 :type cl:string :kind :scalar :label (:optional) :json-name "rsyslogServer"))
+
+  (pi:define-message config.display-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum config.display-config.gps-coordinate-format
+        ()
+      (:dec :index 0)
+      (:dms :index 1)
+      (:utm :index 2)
+      (:mgrs :index 3)
+      (:olc :index 4)
+      (:osgr :index 5))
+
+    (pi:define-enum config.display-config.display-units
+        ()
+      (:metric :index 0)
+      (:imperial :index 1))
+
+    (pi:define-enum config.display-config.oled-type
+        ()
+      (:oled-auto :index 0)
+      (:oled-ssd1306 :index 1)
+      (:oled-sh1106 :index 2)
+      (:oled-sh1107 :index 3))
+
+    (pi:define-enum config.display-config.display-mode
+        ()
+      (:default :index 0)
+      (:twocolor :index 1)
+      (:inverted :index 2)
+      (:color :index 3))
+    ;; Fields
+    (screen-on-secs
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "screenOnSecs")
+    (gps-format
+     :index 2 :type config.display-config.gps-coordinate-format :kind :enum :label (:optional) :json-name "gpsFormat" :default :dec)
+    (auto-screen-carousel-secs
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "autoScreenCarouselSecs")
+    (compass-north-top
+     :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "compassNorthTop")
+    (flip-screen
+     :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "flipScreen")
+    (units
+     :index 6 :type config.display-config.display-units :kind :enum :label (:optional) :json-name "units" :default :metric)
+    (oled
+     :index 7 :type config.display-config.oled-type :kind :enum :label (:optional) :json-name "oled" :default :oled-auto)
+    (displaymode
+     :index 8 :type config.display-config.display-mode :kind :enum :label (:optional) :json-name "displaymode" :default :default)
+    (heading-bold
+     :index 9 :type cl:boolean :kind :scalar :label (:optional) :json-name "headingBold")
+    (wake-on-tap-or-motion
+     :index 10 :type cl:boolean :kind :scalar :label (:optional) :json-name "wakeOnTapOrMotion"))
+
+  (pi:define-message config.lo-ra-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum config.lo-ra-config.region-code
+        ()
+      (:unset :index 0)
+      (:us :index 1)
+      (:eu-433 :index 2)
+      (:eu-868 :index 3)
+      (:cn :index 4)
+      (:jp :index 5)
+      (:anz :index 6)
+      (:kr :index 7)
+      (:tw :index 8)
+      (:ru :index 9)
+      (:in :index 10)
+      (:nz-865 :index 11)
+      (:th :index 12)
+      (:lora-24 :index 13)
+      (:ua-433 :index 14)
+      (:ua-868 :index 15))
+
+    (pi:define-enum config.lo-ra-config.modem-preset
+        ()
+      (:long-fast :index 0)
+      (:long-slow :index 1)
+      (:very-long-slow :index 2)
+      (:medium-slow :index 3)
+      (:medium-fast :index 4)
+      (:short-slow :index 5)
+      (:short-fast :index 6)
+      (:long-moderate :index 7))
+    ;; Fields
+    (use-preset
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "usePreset")
+    (modem-preset
+     :index 2 :type config.lo-ra-config.modem-preset :kind :enum :label (:optional) :json-name "modemPreset" :default :long-fast)
+    (bandwidth
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "bandwidth")
+    (spread-factor
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "spreadFactor")
+    (coding-rate
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "codingRate")
+    (frequency-offset
+     :index 6 :type cl:float :kind :scalar :label (:optional) :json-name "frequencyOffset")
+    (region
+     :index 7 :type config.lo-ra-config.region-code :kind :enum :label (:optional) :json-name "region" :default :unset)
+    (hop-limit
+     :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "hopLimit")
+    (tx-enabled
+     :index 9 :type cl:boolean :kind :scalar :label (:optional) :json-name "txEnabled")
+    (tx-power
+     :index 10 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "txPower")
+    (channel-num
+     :index 11 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "channelNum")
+    (override-duty-cycle
+     :index 12 :type cl:boolean :kind :scalar :label (:optional) :json-name "overrideDutyCycle")
+    (sx126x-rx-boosted-gain
+     :index 13 :type cl:boolean :kind :scalar :label (:optional) :json-name "sx126xRxBoostedGain")
+    (override-frequency
+     :index 14 :type cl:float :kind :scalar :label (:optional) :json-name "overrideFrequency")
+    (ignore-incoming
+     :index 103 :type cl-protobufs:uint32 :kind :scalar :label (:repeated :list) :json-name "ignoreIncoming"))
+
+  (pi:define-message config.bluetooth-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum config.bluetooth-config.pairing-mode
+        ()
+      (:random-pin :index 0)
+      (:fixed-pin :index 1)
+      (:no-pin :index 2))
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (mode
+     :index 2 :type config.bluetooth-config.pairing-mode :kind :enum :label (:optional) :json-name "mode" :default :random-pin)
+    (fixed-pin
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "fixedPin"))
+  ;; Fields
+  (pi:define-oneof payload-variant ()
+    (device
+     :index 1 :type config.device-config :kind :message :label (:optional) :json-name "device")
+    (position
+     :index 2 :type config.position-config :kind :message :label (:optional) :json-name "position")
+    (power
+     :index 3 :type config.power-config :kind :message :label (:optional) :json-name "power")
+    (network
+     :index 4 :type config.network-config :kind :message :label (:optional) :json-name "network")
+    (display
+     :index 5 :type config.display-config :kind :message :label (:optional) :json-name "display")
+    (lora
+     :index 6 :type config.lo-ra-config :kind :message :label (:optional) :json-name "lora")
+    (bluetooth
+     :index 7 :type config.bluetooth-config :kind :message :label (:optional) :json-name "bluetooth")))
+
+(cl:export '(adc-multiplier-override
+             address-mode
+             auto-screen-carousel-secs
+             bandwidth
+             bluetooth
+             broadcast-smart-minimum-distance
+             broadcast-smart-minimum-interval-secs
+             button-gpio
+             buzzer-gpio
+             channel-num
+             coding-rate
+             compass-north-top
+             config
+             config.bluetooth-config
+             config.bluetooth-config.pairing-mode
+             config.bluetooth-config.pairing-mode-int-to-keyword
+             config.bluetooth-config.pairing-mode-keyword-to-int
+             config.device-config
+             config.device-config.rebroadcast-mode
+             config.device-config.rebroadcast-mode-int-to-keyword
+             config.device-config.rebroadcast-mode-keyword-to-int
+             config.device-config.role
+             config.device-config.role-int-to-keyword
+             config.device-config.role-keyword-to-int
+             config.display-config
+             config.display-config.display-mode
+             config.display-config.display-mode-int-to-keyword
+             config.display-config.display-mode-keyword-to-int
+             config.display-config.display-units
+             config.display-config.display-units-int-to-keyword
+             config.display-config.display-units-keyword-to-int
+             config.display-config.gps-coordinate-format
+             config.display-config.gps-coordinate-format-int-to-keyword
+             config.display-config.gps-coordinate-format-keyword-to-int
+             config.display-config.oled-type
+             config.display-config.oled-type-int-to-keyword
+             config.display-config.oled-type-keyword-to-int
+             config.lo-ra-config
+             config.lo-ra-config.modem-preset
+             config.lo-ra-config.modem-preset-int-to-keyword
+             config.lo-ra-config.modem-preset-keyword-to-int
+             config.lo-ra-config.region-code
+             config.lo-ra-config.region-code-int-to-keyword
+             config.lo-ra-config.region-code-keyword-to-int
+             config.network-config
+             config.network-config.address-mode
+             config.network-config.address-mode-int-to-keyword
+             config.network-config.address-mode-keyword-to-int
+             config.network-config.ip-v4-config
+             config.position-config
+             config.position-config.position-flags
+             config.position-config.position-flags-int-to-keyword
+             config.position-config.position-flags-keyword-to-int
+             config.power-config
+             debug-log-enabled
+             device
+             display
+             displaymode
+             dns
+             double-tap-as-button-press
+             enabled
+             eth-enabled
+             fixed-pin
+             fixed-position
+             flip-screen
+             frequency-offset
+             gateway
+             gps-attempt-time
+             gps-enabled
+             gps-format
+             gps-update-interval
+             heading-bold
+             hop-limit
+             ignore-incoming
+             ip
+             ipv4-config
+             is-power-saving
+             lora
+             ls-secs
+             mesh-sds-timeout-secs
+             min-wake-secs
+             mode
+             modem-preset
+             network
+             node-info-broadcast-secs
+             ntp-server
+             oled
+             on-battery-shutdown-after-secs
+             override-duty-cycle
+             override-frequency
+             position
+             position-broadcast-secs
+             position-broadcast-smart-enabled
+             position-flags
+             power
+             rebroadcast-mode
+             region
+             role
+             rsyslog-server
+             rx-gpio
+             screen-on-secs
+             sds-secs
+             serial-enabled
+             spread-factor
+             subnet
+             sx126x-rx-boosted-gain
+             tx-enabled
+             tx-gpio
+             tx-power
+             units
+             use-preset
+             wait-bluetooth-secs
+             wake-on-tap-or-motion
+             wifi-enabled
+             wifi-psk
+             wifi-ssid))

examples/meshtastic/lisp/proto/meshtastic/connection-status.lisp

@@ -0,0 +1,110 @@
+;;; meshtastic/connection_status.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'connection_status
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message device-connection-status
+    ()
+  ;; Fields
+  (pi:define-oneof -wifi (:synthetic-p t)
+    (wifi
+     :index 1 :type wifi-connection-status :kind :message :label (:optional) :json-name "wifi"))
+  (pi:define-oneof -ethernet (:synthetic-p t)
+    (ethernet
+     :index 2 :type ethernet-connection-status :kind :message :label (:optional) :json-name "ethernet"))
+  (pi:define-oneof -bluetooth (:synthetic-p t)
+    (bluetooth
+     :index 3 :type bluetooth-connection-status :kind :message :label (:optional) :json-name "bluetooth"))
+  (pi:define-oneof -serial (:synthetic-p t)
+    (serial
+     :index 4 :type serial-connection-status :kind :message :label (:optional) :json-name "serial")))
+
+(pi:define-message wifi-connection-status
+    ()
+  ;; Fields
+  (status
+   :index 1 :type network-connection-status :kind :message :label (:optional) :json-name "status")
+  (ssid
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "ssid")
+  (rssi
+   :index 3 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "rssi"))
+
+(pi:define-message ethernet-connection-status
+    ()
+  ;; Fields
+  (status
+   :index 1 :type network-connection-status :kind :message :label (:optional) :json-name "status"))
+
+(pi:define-message network-connection-status
+    ()
+  ;; Fields
+  (ip-address
+   :index 1 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "ipAddress")
+  (is-connected
+   :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "isConnected")
+  (is-mqtt-connected
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "isMqttConnected")
+  (is-syslog-connected
+   :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "isSyslogConnected"))
+
+(pi:define-message bluetooth-connection-status
+    ()
+  ;; Fields
+  (pin
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pin")
+  (rssi
+   :index 2 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "rssi")
+  (is-connected
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "isConnected"))
+
+(pi:define-message serial-connection-status
+    ()
+  ;; Fields
+  (baud
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "baud")
+  (is-connected
+   :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "isConnected"))
+
+(cl:export '(baud
+             bluetooth
+             bluetooth-connection-status
+             connection_status
+             device-connection-status
+             ethernet
+             ethernet-connection-status
+             ip-address
+             is-connected
+             is-mqtt-connected
+             is-syslog-connected
+             network-connection-status
+             pin
+             rssi
+             serial
+             serial-connection-status
+             ssid
+             status
+             wifi
+             wifi-connection-status))

examples/meshtastic/lisp/proto/meshtastic/deviceonly.lisp

@@ -0,0 +1,113 @@
+;;; meshtastic/deviceonly.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'deviceonly
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/channel.proto"
+               ;;"meshtastic/localonly.proto"
+               ;;"meshtastic/mesh.proto"
+               ))
+)
+
+
+;;; Top-Level enums
+
+(pi:define-enum screen-fonts
+    ()
+  (:font-small :index 0)
+  (:font-medium :index 1)
+  (:font-large :index 2))
+
+;;; Top-Level messages
+
+(pi:define-message device-state
+    ()
+  ;; Fields
+  (my-node
+   :index 2 :type cl-protobufs.meshtastic::my-node-info :kind :message :label (:optional) :json-name "myNode")
+  (owner
+   :index 3 :type cl-protobufs.meshtastic::user :kind :message :label (:optional) :json-name "owner")
+  (node-db
+   :index 4 :type cl-protobufs.meshtastic::node-info :kind :message :label (:repeated :list) :json-name "nodeDb")
+  (receive-queue
+   :index 5 :type cl-protobufs.meshtastic::mesh-packet :kind :message :label (:repeated :list) :json-name "receiveQueue")
+  (version
+   :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "version")
+  (rx-text-message
+   :index 7 :type cl-protobufs.meshtastic::mesh-packet :kind :message :label (:optional) :json-name "rxTextMessage")
+  (no-save
+   :index 9 :type cl:boolean :kind :scalar :label (:optional) :json-name "noSave")
+  (did-gps-reset
+   :index 11 :type cl:boolean :kind :scalar :label (:optional) :json-name "didGpsReset"))
+
+(pi:define-message channel-file
+    ()
+  ;; Fields
+  (channels
+   :index 1 :type cl-protobufs.meshtastic::channel :kind :message :label (:repeated :list) :json-name "channels")
+  (version
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "version"))
+
+(pi:define-message oem-store
+    (
+     :name "OEMStore")
+  ;; Fields
+  (oem-icon-width
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "oemIconWidth")
+  (oem-icon-height
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "oemIconHeight")
+  (oem-icon-bits
+   :index 3 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "oemIconBits")
+  (oem-font
+   :index 4 :type screen-fonts :kind :enum :label (:optional) :json-name "oemFont" :default :font-small)
+  (oem-text
+   :index 5 :type cl:string :kind :scalar :label (:optional) :json-name "oemText")
+  (oem-aes-key
+   :index 6 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "oemAesKey")
+  (oem-local-config
+   :index 7 :type cl-protobufs.meshtastic::local-config :kind :message :label (:optional) :json-name "oemLocalConfig")
+  (oem-local-module-config
+   :index 8 :type cl-protobufs.meshtastic::local-module-config :kind :message :label (:optional) :json-name "oemLocalModuleConfig"))
+
+(cl:export '(channel-file
+             channels
+             device-state
+             deviceonly
+             did-gps-reset
+             my-node
+             no-save
+             node-db
+             oem-aes-key
+             oem-font
+             oem-icon-bits
+             oem-icon-height
+             oem-icon-width
+             oem-local-config
+             oem-local-module-config
+             oem-store
+             oem-text
+             owner
+             receive-queue
+             rx-text-message
+             screen-fonts
+             screen-fonts-int-to-keyword
+             screen-fonts-keyword-to-int
+             version))

examples/meshtastic/lisp/proto/meshtastic/localonly.lisp

@@ -0,0 +1,95 @@
+;;; meshtastic/localonly.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'localonly
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/config.proto"
+               ;;"meshtastic/module_config.proto"
+               ))
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message local-config
+    ()
+  ;; Fields
+  (device
+   :index 1 :type cl-protobufs.meshtastic::config.device-config :kind :message :label (:optional) :json-name "device")
+  (position
+   :index 2 :type cl-protobufs.meshtastic::config.position-config :kind :message :label (:optional) :json-name "position")
+  (power
+   :index 3 :type cl-protobufs.meshtastic::config.power-config :kind :message :label (:optional) :json-name "power")
+  (network
+   :index 4 :type cl-protobufs.meshtastic::config.network-config :kind :message :label (:optional) :json-name "network")
+  (display
+   :index 5 :type cl-protobufs.meshtastic::config.display-config :kind :message :label (:optional) :json-name "display")
+  (lora
+   :index 6 :type cl-protobufs.meshtastic::config.lo-ra-config :kind :message :label (:optional) :json-name "lora")
+  (bluetooth
+   :index 7 :type cl-protobufs.meshtastic::config.bluetooth-config :kind :message :label (:optional) :json-name "bluetooth")
+  (version
+   :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "version"))
+
+(pi:define-message local-module-config
+    ()
+  ;; Fields
+  (mqtt
+   :index 1 :type cl-protobufs.meshtastic::module-config.mqtt-config :kind :message :label (:optional) :json-name "mqtt")
+  (serial
+   :index 2 :type cl-protobufs.meshtastic::module-config.serial-config :kind :message :label (:optional) :json-name "serial")
+  (external-notification
+   :index 3 :type cl-protobufs.meshtastic::module-config.external-notification-config :kind :message :label (:optional) :json-name "externalNotification")
+  (store-forward
+   :index 4 :type cl-protobufs.meshtastic::module-config.store-forward-config :kind :message :label (:optional) :json-name "storeForward")
+  (range-test
+   :index 5 :type cl-protobufs.meshtastic::module-config.range-test-config :kind :message :label (:optional) :json-name "rangeTest")
+  (telemetry
+   :index 6 :type cl-protobufs.meshtastic::module-config.telemetry-config :kind :message :label (:optional) :json-name "telemetry")
+  (canned-message
+   :index 7 :type cl-protobufs.meshtastic::module-config.canned-message-config :kind :message :label (:optional) :json-name "cannedMessage")
+  (audio
+   :index 9 :type cl-protobufs.meshtastic::module-config.audio-config :kind :message :label (:optional) :json-name "audio")
+  (remote-hardware
+   :index 10 :type cl-protobufs.meshtastic::module-config.remote-hardware-config :kind :message :label (:optional) :json-name "remoteHardware")
+  (version
+   :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "version"))
+
+(cl:export '(audio
+             bluetooth
+             canned-message
+             device
+             display
+             external-notification
+             local-config
+             local-module-config
+             localonly
+             lora
+             mqtt
+             network
+             position
+             power
+             range-test
+             remote-hardware
+             serial
+             store-forward
+             telemetry
+             version))

examples/meshtastic/lisp/proto/meshtastic/mesh.lisp

@@ -0,0 +1,624 @@
+;;; meshtastic/mesh.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'mesh
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/channel.proto"
+               ;;"meshtastic/config.proto"
+               ;;"meshtastic/module_config.proto"
+               ;;"meshtastic/portnums.proto"
+               ;;"meshtastic/telemetry.proto"
+               ;;"meshtastic/xmodem.proto"
+               ))
+)
+
+
+;;; Top-Level enums
+
+(pi:define-enum hardware-model
+    ()
+  (:unset :index 0)
+  (:tlora-v2 :index 1)
+  (:tlora-v1 :index 2)
+  (:tlora-v2-1-1p6 :index 3)
+  (:tbeam :index 4)
+  (:heltec-v2-0 :index 5)
+  (:tbeam-v0p7 :index 6)
+  (:t-echo :index 7)
+  (:tlora-v1-1p3 :index 8)
+  (:rak4631 :index 9)
+  (:heltec-v2-1 :index 10)
+  (:heltec-v1 :index 11)
+  (:lilygo-tbeam-s3-core :index 12)
+  (:rak11200 :index 13)
+  (:nano-g1 :index 14)
+  (:tlora-v2-1-1p8 :index 15)
+  (:tlora-t3-s3 :index 16)
+  (:nano-g1-explorer :index 17)
+  (:station-g1 :index 25)
+  (:lora-relay-v1 :index 32)
+  (:nrf52840dk :index 33)
+  (:ppr :index 34)
+  (:genieblocks :index 35)
+  (:nrf52-unknown :index 36)
+  (:portduino :index 37)
+  (:android-sim :index 38)
+  (:diy-v1 :index 39)
+  (:nrf52840-pca10059 :index 40)
+  (:dr-dev :index 41)
+  (:m5stack :index 42)
+  (:heltec-v3 :index 43)
+  (:heltec-wsl-v3 :index 44)
+  (:betafpv-2400-tx :index 45)
+  (:betafpv-900-nano-tx :index 46)
+  (:private-hw :index 255))
+
+(pi:define-enum constants
+    ()
+  (:zero :index 0)
+  (:data-payload-len :index 237))
+
+(pi:define-enum critical-error-code
+    ()
+  (:none :index 0)
+  (:tx-watchdog :index 1)
+  (:sleep-enter-wait :index 2)
+  (:no-radio :index 3)
+  (:unspecified :index 4)
+  (:ublox-unit-failed :index 5)
+  (:no-axp192 :index 6)
+  (:invalid-radio-setting :index 7)
+  (:transmit-failed :index 8)
+  (:brownout :index 9)
+  (:sx1262-failure :index 10)
+  (:radio-spi-bug :index 11))
+
+;;; Top-Level messages
+
+(pi:define-message position
+    ()
+  ;; Nested enums
+
+  (pi:define-enum position.loc-source
+      ()
+    (:loc-unset :index 0)
+    (:loc-manual :index 1)
+    (:loc-internal :index 2)
+    (:loc-external :index 3))
+
+  (pi:define-enum position.alt-source
+      ()
+    (:alt-unset :index 0)
+    (:alt-manual :index 1)
+    (:alt-internal :index 2)
+    (:alt-external :index 3)
+    (:alt-barometric :index 4))
+  ;; Fields
+  (latitude-i
+   :index 1 :type cl-protobufs:sfixed32 :kind :scalar :label (:optional) :json-name "latitudeI")
+  (longitude-i
+   :index 2 :type cl-protobufs:sfixed32 :kind :scalar :label (:optional) :json-name "longitudeI")
+  (altitude
+   :index 3 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "altitude")
+  (time
+   :index 4 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "time")
+  (location-source
+   :index 5 :type position.loc-source :kind :enum :label (:optional) :json-name "locationSource" :default :loc-unset)
+  (altitude-source
+   :index 6 :type position.alt-source :kind :enum :label (:optional) :json-name "altitudeSource" :default :alt-unset)
+  (timestamp
+   :index 7 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "timestamp")
+  (timestamp-millis-adjust
+   :index 8 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "timestampMillisAdjust")
+  (altitude-hae
+   :index 9 :type cl-protobufs:sint32 :kind :scalar :label (:optional) :json-name "altitudeHae")
+  (altitude-geoidal-separation
+   :index 10 :type cl-protobufs:sint32 :kind :scalar :label (:optional) :json-name "altitudeGeoidalSeparation")
+  (pdop
+   :index 11 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "PDOP")
+  (hdop
+   :index 12 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "HDOP")
+  (vdop
+   :index 13 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "VDOP")
+  (gps-accuracy
+   :index 14 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "gpsAccuracy")
+  (ground-speed
+   :index 15 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "groundSpeed")
+  (ground-track
+   :index 16 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "groundTrack")
+  (fix-quality
+   :index 17 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "fixQuality")
+  (fix-type
+   :index 18 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "fixType")
+  (sats-in-view
+   :index 19 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "satsInView")
+  (sensor-id
+   :index 20 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "sensorId")
+  (next-update
+   :index 21 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "nextUpdate")
+  (seq-number
+   :index 22 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "seqNumber"))
+
+(pi:define-message user
+    ()
+  ;; Fields
+  (id
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "id")
+  (long-name
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "longName")
+  (short-name
+   :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "shortName")
+  (macaddr
+   :index 4 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "macaddr")
+  (hw-model
+   :index 5 :type hardware-model :kind :enum :label (:optional) :json-name "hwModel" :default :unset)
+  (is-licensed
+   :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "isLicensed"))
+
+(pi:define-message route-discovery
+    ()
+  ;; Fields
+  (route
+   :index 1 :type cl-protobufs:fixed32 :kind :scalar :label (:repeated :list) :json-name "route"))
+
+(pi:define-message routing
+    ()
+  ;; Nested enums
+
+  (pi:define-enum routing.error
+      ()
+    (:none :index 0)
+    (:no-route :index 1)
+    (:got-nak :index 2)
+    (:timeout :index 3)
+    (:no-interface :index 4)
+    (:max-retransmit :index 5)
+    (:no-channel :index 6)
+    (:too-large :index 7)
+    (:no-response :index 8)
+    (:duty-cycle-limit :index 9)
+    (:bad-request :index 32)
+    (:not-authorized :index 33))
+  ;; Fields
+  (pi:define-oneof variant ()
+    (route-request
+     :index 1 :type route-discovery :kind :message :label (:optional) :json-name "routeRequest")
+    (route-reply
+     :index 2 :type route-discovery :kind :message :label (:optional) :json-name "routeReply")
+    (error-reason
+     :index 3 :type routing.error :kind :enum :label (:optional) :json-name "errorReason" :default :none)))
+
+(pi:define-message data
+    ()
+  ;; Fields
+  (portnum
+   :index 1 :type cl-protobufs.meshtastic::port-num :kind :enum :label (:optional) :json-name "portnum" :default :unknown-app)
+  (payload
+   :index 2 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "payload")
+  (want-response
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "wantResponse")
+  (dest
+   :index 4 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "dest")
+  (source
+   :index 5 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "source")
+  (request-id
+   :index 6 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "requestId")
+  (reply-id
+   :index 7 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "replyId")
+  (emoji
+   :index 8 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "emoji"))
+
+(pi:define-message waypoint
+    ()
+  ;; Fields
+  (id
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "id")
+  (latitude-i
+   :index 2 :type cl-protobufs:sfixed32 :kind :scalar :label (:optional) :json-name "latitudeI")
+  (longitude-i
+   :index 3 :type cl-protobufs:sfixed32 :kind :scalar :label (:optional) :json-name "longitudeI")
+  (expire
+   :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "expire")
+  (locked-to
+   :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "lockedTo")
+  (name
+   :index 6 :type cl:string :kind :scalar :label (:optional) :json-name "name")
+  (description
+   :index 7 :type cl:string :kind :scalar :label (:optional) :json-name "description")
+  (icon
+   :index 8 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "icon"))
+
+(pi:define-message mesh-packet
+    ()
+  ;; Nested enums
+
+  (pi:define-enum mesh-packet.priority
+      ()
+    (:unset :index 0)
+    (:min :index 1)
+    (:background :index 10)
+    (:default :index 64)
+    (:reliable :index 70)
+    (:ack :index 120)
+    (:max :index 127))
+
+  (pi:define-enum mesh-packet.delayed
+      ()
+    (:no-delay :index 0)
+    (:delayed-broadcast :index 1)
+    (:delayed-direct :index 2))
+  ;; Fields
+  (pi:define-oneof payload-variant ()
+    (decoded
+     :index 4 :type data :kind :message :label (:optional) :json-name "decoded")
+    (encrypted
+     :index 5 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "encrypted"))
+  (from
+   :index 1 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "from")
+  (to
+   :index 2 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "to")
+  (channel
+   :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "channel")
+  (id
+   :index 6 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "id")
+  (rx-time
+   :index 7 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "rxTime")
+  (rx-snr
+   :index 8 :type cl:float :kind :scalar :label (:optional) :json-name "rxSnr")
+  (hop-limit
+   :index 9 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "hopLimit")
+  (want-ack
+   :index 10 :type cl:boolean :kind :scalar :label (:optional) :json-name "wantAck")
+  (priority
+   :index 11 :type mesh-packet.priority :kind :enum :label (:optional) :json-name "priority" :default :unset)
+  (rx-rssi
+   :index 12 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "rxRssi")
+  (delayed
+   :index 13 :type mesh-packet.delayed :kind :enum :label (:optional) :json-name "delayed" :default :no-delay))
+
+(pi:define-message node-info
+    ()
+  ;; Fields
+  (num
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "num")
+  (user
+   :index 2 :type user :kind :message :label (:optional) :json-name "user")
+  (position
+   :index 3 :type position :kind :message :label (:optional) :json-name "position")
+  (snr
+   :index 4 :type cl:float :kind :scalar :label (:optional) :json-name "snr")
+  (last-heard
+   :index 5 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "lastHeard")
+  (device-metrics
+   :index 6 :type cl-protobufs.meshtastic::device-metrics :kind :message :label (:optional) :json-name "deviceMetrics")
+  (channel
+   :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "channel"))
+
+(pi:define-message my-node-info
+    ()
+  ;; Fields
+  (my-node-num
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "myNodeNum")
+  (has-gps
+   :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "hasGps")
+  (max-channels
+   :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "maxChannels")
+  (firmware-version
+   :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "firmwareVersion")
+  (error-code
+   :index 5 :type critical-error-code :kind :enum :label (:optional) :json-name "errorCode" :default :none)
+  (error-address
+   :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "errorAddress")
+  (error-count
+   :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "errorCount")
+  (reboot-count
+   :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "rebootCount")
+  (bitrate
+   :index 9 :type cl:float :kind :scalar :label (:optional) :json-name "bitrate")
+  (message-timeout-msec
+   :index 10 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "messageTimeoutMsec")
+  (min-app-version
+   :index 11 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "minAppVersion")
+  (air-period-tx
+   :index 12 :type cl-protobufs:uint32 :kind :scalar :label (:repeated :list) :json-name "airPeriodTx")
+  (air-period-rx
+   :index 13 :type cl-protobufs:uint32 :kind :scalar :label (:repeated :list) :json-name "airPeriodRx")
+  (has-wifi
+   :index 14 :type cl:boolean :kind :scalar :label (:optional) :json-name "hasWifi")
+  (channel-utilization
+   :index 15 :type cl:float :kind :scalar :label (:optional) :json-name "channelUtilization")
+  (air-util-tx
+   :index 16 :type cl:float :kind :scalar :label (:optional) :json-name "airUtilTx"))
+
+(pi:define-message log-record
+    ()
+  ;; Nested enums
+
+  (pi:define-enum log-record.level
+      ()
+    (:unset :index 0)
+    (:critical :index 50)
+    (:error :index 40)
+    (:warning :index 30)
+    (:info :index 20)
+    (:debug :index 10)
+    (:trace :index 5))
+  ;; Fields
+  (message
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "message")
+  (time
+   :index 2 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "time")
+  (source
+   :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "source")
+  (level
+   :index 4 :type log-record.level :kind :enum :label (:optional) :json-name "level" :default :unset))
+
+(pi:define-message queue-status
+    ()
+  ;; Fields
+  (res
+   :index 1 :type cl-protobufs:int32 :kind :scalar :label (:optional) :json-name "res")
+  (free
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "free")
+  (maxlen
+   :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "maxlen")
+  (mesh-packet-id
+   :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "meshPacketId"))
+
+(pi:define-message from-radio
+    ()
+  ;; Fields
+  (pi:define-oneof payload-variant ()
+    (packet
+     :index 2 :type mesh-packet :kind :message :label (:optional) :json-name "packet")
+    (my-info
+     :index 3 :type my-node-info :kind :message :label (:optional) :json-name "myInfo")
+    (node-info
+     :index 4 :type node-info :kind :message :label (:optional) :json-name "nodeInfo")
+    (config
+     :index 5 :type cl-protobufs.meshtastic::config :kind :message :label (:optional) :json-name "config")
+    (log-record
+     :index 6 :type log-record :kind :message :label (:optional) :json-name "logRecord")
+    (config-complete-id
+     :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "configCompleteId")
+    (rebooted
+     :index 8 :type cl:boolean :kind :scalar :label (:optional) :json-name "rebooted")
+    (module-config
+     :index 9 :type cl-protobufs.meshtastic::module-config :kind :message :label (:optional) :json-name "moduleConfig")
+    (channel
+     :index 10 :type cl-protobufs.meshtastic::channel :kind :message :label (:optional) :json-name "channel")
+    (queue-status
+     :index 11 :type queue-status :kind :message :label (:optional) :json-name "queueStatus")
+    (xmodem-packet
+     :index 12 :type cl-protobufs.meshtastic::x-modem :kind :message :label (:optional) :json-name "xmodemPacket")
+    (metadata
+     :index 13 :type device-metadata :kind :message :label (:optional) :json-name "metadata"))
+  (id
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "id"))
+
+(pi:define-message to-radio
+    ()
+  ;; Fields
+  (pi:define-oneof payload-variant ()
+    (packet
+     :index 1 :type mesh-packet :kind :message :label (:optional) :json-name "packet")
+    (want-config-id
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "wantConfigId")
+    (disconnect
+     :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "disconnect")
+    (xmodem-packet
+     :index 5 :type cl-protobufs.meshtastic::x-modem :kind :message :label (:optional) :json-name "xmodemPacket")))
+
+(pi:define-message compressed
+    ()
+  ;; Fields
+  (portnum
+   :index 1 :type cl-protobufs.meshtastic::port-num :kind :enum :label (:optional) :json-name "portnum" :default :unknown-app)
+  (data
+   :index 2 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "data"))
+
+(pi:define-message neighbor-info
+    ()
+  ;; Fields
+  (node-id
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "nodeId")
+  (last-sent-by-id
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "lastSentById")
+  (neighbors
+   :index 3 :type neighbor :kind :message :label (:repeated :list) :json-name "neighbors"))
+
+(pi:define-message neighbor
+    ()
+  ;; Fields
+  (node-id
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "nodeId")
+  (snr
+   :index 2 :type cl:float :kind :scalar :label (:optional) :json-name "snr"))
+
+(pi:define-message device-metadata
+    ()
+  ;; Fields
+  (firmware-version
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "firmwareVersion")
+  (device-state-version
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "deviceStateVersion")
+  (can-shutdown
+   :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "canShutdown")
+  (has-wifi
+   :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "hasWifi")
+  (has-bluetooth
+   :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "hasBluetooth")
+  (has-ethernet
+   :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "hasEthernet")
+  (role
+   :index 7 :type cl-protobufs.meshtastic::config.device-config.role :kind :enum :label (:optional) :json-name "role" :default :client)
+  (position-flags
+   :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "positionFlags")
+  (hw-model
+   :index 9 :type hardware-model :kind :enum :label (:optional) :json-name "hwModel" :default :unset))
+
+(cl:export '(air-period-rx
+             air-period-tx
+             air-util-tx
+             altitude
+             altitude-geoidal-separation
+             altitude-hae
+             altitude-source
+             bitrate
+             can-shutdown
+             channel
+             channel-utilization
+             compressed
+             config
+             config-complete-id
+             constants
+             constants-int-to-keyword
+             constants-keyword-to-int
+             critical-error-code
+             critical-error-code-int-to-keyword
+             critical-error-code-keyword-to-int
+             data
+             decoded
+             delayed
+             description
+             dest
+             device-metadata
+             device-metrics
+             device-state-version
+             disconnect
+             emoji
+             encrypted
+             error-address
+             error-code
+             error-count
+             error-reason
+             expire
+             firmware-version
+             fix-quality
+             fix-type
+             free
+             from
+             from-radio
+             gps-accuracy
+             ground-speed
+             ground-track
+             hardware-model
+             hardware-model-int-to-keyword
+             hardware-model-keyword-to-int
+             has-bluetooth
+             has-ethernet
+             has-gps
+             has-wifi
+             hdop
+             hop-limit
+             hw-model
+             icon
+             id
+             is-licensed
+             last-heard
+             last-sent-by-id
+             latitude-i
+             level
+             location-source
+             locked-to
+             log-record
+             log-record.level
+             log-record.level-int-to-keyword
+             log-record.level-keyword-to-int
+             long-name
+             longitude-i
+             macaddr
+             max-channels
+             maxlen
+             mesh
+             mesh-packet
+             mesh-packet-id
+             mesh-packet.delayed
+             mesh-packet.delayed-int-to-keyword
+             mesh-packet.delayed-keyword-to-int
+             mesh-packet.priority
+             mesh-packet.priority-int-to-keyword
+             mesh-packet.priority-keyword-to-int
+             message
+             message-timeout-msec
+             metadata
+             min-app-version
+             module-config
+             my-info
+             my-node-info
+             my-node-num
+             name
+             neighbor
+             neighbor-info
+             neighbors
+             next-update
+             node-id
+             node-info
+             num
+             packet
+             payload
+             pdop
+             portnum
+             position
+             position-flags
+             position.alt-source
+             position.alt-source-int-to-keyword
+             position.alt-source-keyword-to-int
+             position.loc-source
+             position.loc-source-int-to-keyword
+             position.loc-source-keyword-to-int
+             priority
+             queue-status
+             reboot-count
+             rebooted
+             reply-id
+             request-id
+             res
+             role
+             route
+             route-discovery
+             route-reply
+             route-request
+             routing
+             routing.error
+             routing.error-int-to-keyword
+             routing.error-keyword-to-int
+             rx-rssi
+             rx-snr
+             rx-time
+             sats-in-view
+             sensor-id
+             seq-number
+             short-name
+             snr
+             source
+             time
+             timestamp
+             timestamp-millis-adjust
+             to
+             to-radio
+             user
+             vdop
+             want-ack
+             want-config-id
+             want-response
+             waypoint
+             xmodem-packet))

examples/meshtastic/lisp/proto/meshtastic/module-config.lisp

@@ -0,0 +1,357 @@
+;;; meshtastic/module_config.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'module_config
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message module-config
+    ()
+  ;; Nested messages
+
+  (pi:define-message module-config.mqtt-config
+      (
+       :name "MQTTConfig")
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (address
+     :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "address")
+    (username
+     :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "username")
+    (password
+     :index 4 :type cl:string :kind :scalar :label (:optional) :json-name "password")
+    (encryption-enabled
+     :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "encryptionEnabled")
+    (json-enabled
+     :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "jsonEnabled")
+    (tls-enabled
+     :index 7 :type cl:boolean :kind :scalar :label (:optional) :json-name "tlsEnabled")
+    (root
+     :index 8 :type cl:string :kind :scalar :label (:optional) :json-name "root"))
+
+  (pi:define-message module-config.remote-hardware-config
+      ()
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled"))
+
+  (pi:define-message module-config.audio-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum module-config.audio-config.audio-baud
+        (:name "Audio_Baud")
+      (:codec2-default :index 0)
+      (:codec2-3200 :index 1)
+      (:codec2-2400 :index 2)
+      (:codec2-1600 :index 3)
+      (:codec2-1400 :index 4)
+      (:codec2-1300 :index 5)
+      (:codec2-1200 :index 6)
+      (:codec2-700 :index 7)
+      (:codec2-700b :index 8))
+    ;; Fields
+    (codec2-enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "codec2Enabled")
+    (ptt-pin
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pttPin")
+    (bitrate
+     :index 3 :type module-config.audio-config.audio-baud :kind :enum :label (:optional) :json-name "bitrate" :default :codec2-default)
+    (i2s-ws
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "i2sWs")
+    (i2s-sd
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "i2sSd")
+    (i2s-din
+     :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "i2sDin")
+    (i2s-sck
+     :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "i2sSck"))
+
+  (pi:define-message module-config.serial-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum module-config.serial-config.serial-baud
+        (:name "Serial_Baud")
+      (:baud-default :index 0)
+      (:baud-110 :index 1)
+      (:baud-300 :index 2)
+      (:baud-600 :index 3)
+      (:baud-1200 :index 4)
+      (:baud-2400 :index 5)
+      (:baud-4800 :index 6)
+      (:baud-9600 :index 7)
+      (:baud-19200 :index 8)
+      (:baud-38400 :index 9)
+      (:baud-57600 :index 10)
+      (:baud-115200 :index 11)
+      (:baud-230400 :index 12)
+      (:baud-460800 :index 13)
+      (:baud-576000 :index 14)
+      (:baud-921600 :index 15))
+
+    (pi:define-enum module-config.serial-config.serial-mode
+        (:name "Serial_Mode")
+      (:default :index 0)
+      (:simple :index 1)
+      (:proto :index 2)
+      (:textmsg :index 3)
+      (:nmea :index 4))
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (echo
+     :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "echo")
+    (rxd
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "rxd")
+    (txd
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "txd")
+    (baud
+     :index 5 :type module-config.serial-config.serial-baud :kind :enum :label (:optional) :json-name "baud" :default :baud-default)
+    (timeout
+     :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "timeout")
+    (mode
+     :index 7 :type module-config.serial-config.serial-mode :kind :enum :label (:optional) :json-name "mode" :default :default))
+
+  (pi:define-message module-config.external-notification-config
+      ()
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (output-ms
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "outputMs")
+    (output
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "output")
+    (output-vibra
+     :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "outputVibra")
+    (output-buzzer
+     :index 9 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "outputBuzzer")
+    (active
+     :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "active")
+    (alert-message
+     :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "alertMessage")
+    (alert-message-vibra
+     :index 10 :type cl:boolean :kind :scalar :label (:optional) :json-name "alertMessageVibra")
+    (alert-message-buzzer
+     :index 11 :type cl:boolean :kind :scalar :label (:optional) :json-name "alertMessageBuzzer")
+    (alert-bell
+     :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "alertBell")
+    (alert-bell-vibra
+     :index 12 :type cl:boolean :kind :scalar :label (:optional) :json-name "alertBellVibra")
+    (alert-bell-buzzer
+     :index 13 :type cl:boolean :kind :scalar :label (:optional) :json-name "alertBellBuzzer")
+    (use-pwm
+     :index 7 :type cl:boolean :kind :scalar :label (:optional) :json-name "usePwm")
+    (nag-timeout
+     :index 14 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "nagTimeout"))
+
+  (pi:define-message module-config.store-forward-config
+      ()
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (heartbeat
+     :index 2 :type cl:boolean :kind :scalar :label (:optional) :json-name "heartbeat")
+    (records
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "records")
+    (history-return-max
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "historyReturnMax")
+    (history-return-window
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "historyReturnWindow"))
+
+  (pi:define-message module-config.range-test-config
+      ()
+    ;; Fields
+    (enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (sender
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "sender")
+    (save
+     :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "save"))
+
+  (pi:define-message module-config.telemetry-config
+      ()
+    ;; Fields
+    (device-update-interval
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "deviceUpdateInterval")
+    (environment-update-interval
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "environmentUpdateInterval")
+    (environment-measurement-enabled
+     :index 3 :type cl:boolean :kind :scalar :label (:optional) :json-name "environmentMeasurementEnabled")
+    (environment-screen-enabled
+     :index 4 :type cl:boolean :kind :scalar :label (:optional) :json-name "environmentScreenEnabled")
+    (environment-display-fahrenheit
+     :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "environmentDisplayFahrenheit")
+    (air-quality-enabled
+     :index 6 :type cl:boolean :kind :scalar :label (:optional) :json-name "airQualityEnabled")
+    (air-quality-interval
+     :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "airQualityInterval"))
+
+  (pi:define-message module-config.canned-message-config
+      ()
+    ;; Nested enums
+
+    (pi:define-enum module-config.canned-message-config.input-event-char
+        ()
+      (:none :index 0)
+      (:up :index 17)
+      (:down :index 18)
+      (:left :index 19)
+      (:right :index 20)
+      (:select :index 10)
+      (:back :index 27)
+      (:cancel :index 24))
+    ;; Fields
+    (rotary1-enabled
+     :index 1 :type cl:boolean :kind :scalar :label (:optional) :json-name "rotary1Enabled")
+    (inputbroker-pin-a
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "inputbrokerPinA")
+    (inputbroker-pin-b
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "inputbrokerPinB")
+    (inputbroker-pin-press
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "inputbrokerPinPress")
+    (inputbroker-event-cw
+     :index 5 :type module-config.canned-message-config.input-event-char :kind :enum :label (:optional) :json-name "inputbrokerEventCw" :default :none)
+    (inputbroker-event-ccw
+     :index 6 :type module-config.canned-message-config.input-event-char :kind :enum :label (:optional) :json-name "inputbrokerEventCcw" :default :none)
+    (inputbroker-event-press
+     :index 7 :type module-config.canned-message-config.input-event-char :kind :enum :label (:optional) :json-name "inputbrokerEventPress" :default :none)
+    (updown1-enabled
+     :index 8 :type cl:boolean :kind :scalar :label (:optional) :json-name "updown1Enabled")
+    (enabled
+     :index 9 :type cl:boolean :kind :scalar :label (:optional) :json-name "enabled")
+    (allow-input-source
+     :index 10 :type cl:string :kind :scalar :label (:optional) :json-name "allowInputSource")
+    (send-bell
+     :index 11 :type cl:boolean :kind :scalar :label (:optional) :json-name "sendBell"))
+  ;; Fields
+  (pi:define-oneof payload-variant ()
+    (mqtt
+     :index 1 :type module-config.mqtt-config :kind :message :label (:optional) :json-name "mqtt")
+    (serial
+     :index 2 :type module-config.serial-config :kind :message :label (:optional) :json-name "serial")
+    (external-notification
+     :index 3 :type module-config.external-notification-config :kind :message :label (:optional) :json-name "externalNotification")
+    (store-forward
+     :index 4 :type module-config.store-forward-config :kind :message :label (:optional) :json-name "storeForward")
+    (range-test
+     :index 5 :type module-config.range-test-config :kind :message :label (:optional) :json-name "rangeTest")
+    (telemetry
+     :index 6 :type module-config.telemetry-config :kind :message :label (:optional) :json-name "telemetry")
+    (canned-message
+     :index 7 :type module-config.canned-message-config :kind :message :label (:optional) :json-name "cannedMessage")
+    (audio
+     :index 8 :type module-config.audio-config :kind :message :label (:optional) :json-name "audio")
+    (remote-hardware
+     :index 9 :type module-config.remote-hardware-config :kind :message :label (:optional) :json-name "remoteHardware")))
+
+(cl:export '(active
+             address
+             air-quality-enabled
+             air-quality-interval
+             alert-bell
+             alert-bell-buzzer
+             alert-bell-vibra
+             alert-message
+             alert-message-buzzer
+             alert-message-vibra
+             allow-input-source
+             audio
+             baud
+             bitrate
+             canned-message
+             codec2-enabled
+             device-update-interval
+             echo
+             enabled
+             encryption-enabled
+             environment-display-fahrenheit
+             environment-measurement-enabled
+             environment-screen-enabled
+             environment-update-interval
+             external-notification
+             heartbeat
+             history-return-max
+             history-return-window
+             i2s-din
+             i2s-sck
+             i2s-sd
+             i2s-ws
+             inputbroker-event-ccw
+             inputbroker-event-cw
+             inputbroker-event-press
+             inputbroker-pin-a
+             inputbroker-pin-b
+             inputbroker-pin-press
+             json-enabled
+             mode
+             module-config
+             module-config.audio-config
+             module-config.audio-config.audio-baud
+             module-config.audio-config.audio-baud-int-to-keyword
+             module-config.audio-config.audio-baud-keyword-to-int
+             module-config.canned-message-config
+             module-config.canned-message-config.input-event-char
+             module-config.canned-message-config.input-event-char-int-to-keyword
+             module-config.canned-message-config.input-event-char-keyword-to-int
+             module-config.external-notification-config
+             module-config.mqtt-config
+             module-config.range-test-config
+             module-config.remote-hardware-config
+             module-config.serial-config
+             module-config.serial-config.serial-baud
+             module-config.serial-config.serial-baud-int-to-keyword
+             module-config.serial-config.serial-baud-keyword-to-int
+             module-config.serial-config.serial-mode
+             module-config.serial-config.serial-mode-int-to-keyword
+             module-config.serial-config.serial-mode-keyword-to-int
+             module-config.store-forward-config
+             module-config.telemetry-config
+             module_config
+             mqtt
+             nag-timeout
+             output
+             output-buzzer
+             output-ms
+             output-vibra
+             password
+             ptt-pin
+             range-test
+             records
+             remote-hardware
+             root
+             rotary1-enabled
+             rxd
+             save
+             send-bell
+             sender
+             serial
+             store-forward
+             telemetry
+             timeout
+             tls-enabled
+             txd
+             updown1-enabled
+             use-pwm
+             username))

examples/meshtastic/lisp/proto/meshtastic/mqtt.lisp

@@ -0,0 +1,45 @@
+;;; meshtastic/mqtt.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'mqtt
+    :syntax :proto3
+
+     :package "meshtastic"
+     :import '(;;"meshtastic/mesh.proto"
+               ))
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message service-envelope
+    ()
+  ;; Fields
+  (packet
+   :index 1 :type cl-protobufs.meshtastic::mesh-packet :kind :message :label (:optional) :json-name "packet")
+  (channel-id
+   :index 2 :type cl:string :kind :scalar :label (:optional) :json-name "channelId")
+  (gateway-id
+   :index 3 :type cl:string :kind :scalar :label (:optional) :json-name "gatewayId"))
+
+(cl:export '(channel-id
+             gateway-id
+             mqtt
+             packet
+             service-envelope))

examples/meshtastic/lisp/proto/meshtastic/portnums.lisp

@@ -0,0 +1,58 @@
+;;; meshtastic/portnums.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'portnums
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level enums
+
+(pi:define-enum port-num
+    ()
+  (:unknown-app :index 0)
+  (:text-message-app :index 1)
+  (:remote-hardware-app :index 2)
+  (:position-app :index 3)
+  (:nodeinfo-app :index 4)
+  (:routing-app :index 5)
+  (:admin-app :index 6)
+  (:text-message-compressed-app :index 7)
+  (:waypoint-app :index 8)
+  (:audio-app :index 9)
+  (:reply-app :index 32)
+  (:ip-tunnel-app :index 33)
+  (:serial-app :index 64)
+  (:store-forward-app :index 65)
+  (:range-test-app :index 66)
+  (:telemetry-app :index 67)
+  (:zps-app :index 68)
+  (:simulator-app :index 69)
+  (:traceroute-app :index 70)
+  (:neighborinfo-app :index 71)
+  (:private-app :index 256)
+  (:atak-forwarder :index 257)
+  (:max :index 511))
+
+(cl:export '(port-num
+             port-num-int-to-keyword
+             port-num-keyword-to-int
+             portnums))

examples/meshtastic/lisp/proto/meshtastic/remote-hardware.lisp

@@ -0,0 +1,56 @@
+;;; meshtastic/remote_hardware.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'remote_hardware
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message hardware-message
+    ()
+  ;; Nested enums
+
+  (pi:define-enum hardware-message.type
+      ()
+    (:unset :index 0)
+    (:write-gpios :index 1)
+    (:watch-gpios :index 2)
+    (:gpios-changed :index 3)
+    (:read-gpios :index 4)
+    (:read-gpios-reply :index 5))
+  ;; Fields
+  (type
+   :index 1 :type hardware-message.type :kind :enum :label (:optional) :json-name "type" :default :unset)
+  (gpio-mask
+   :index 2 :type cl-protobufs:uint64 :kind :scalar :label (:optional) :json-name "gpioMask")
+  (gpio-value
+   :index 3 :type cl-protobufs:uint64 :kind :scalar :label (:optional) :json-name "gpioValue"))
+
+(cl:export '(gpio-mask
+             gpio-value
+             hardware-message
+             hardware-message.type
+             hardware-message.type-int-to-keyword
+             hardware-message.type-keyword-to-int
+             remote_hardware
+             type))

examples/meshtastic/lisp/proto/meshtastic/rtttl.lisp

@@ -0,0 +1,38 @@
+;;; meshtastic/rtttl.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'rtttl
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message rtttl-config
+    (
+     :name "RTTTLConfig")
+  ;; Fields
+  (ringtone
+   :index 1 :type cl:string :kind :scalar :label (:optional) :json-name "ringtone"))
+
+(cl:export '(ringtone
+             rtttl
+             rtttl-config))

examples/meshtastic/lisp/proto/meshtastic/storeforward.lisp

@@ -0,0 +1,128 @@
+;;; meshtastic/storeforward.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'storeforward
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message store-and-forward
+    ()
+  ;; Nested enums
+
+  (pi:define-enum store-and-forward.request-response
+      ()
+    (:unset :index 0)
+    (:router-error :index 1)
+    (:router-heartbeat :index 2)
+    (:router-ping :index 3)
+    (:router-pong :index 4)
+    (:router-busy :index 5)
+    (:router-history :index 6)
+    (:router-stats :index 7)
+    (:client-error :index 64)
+    (:client-history :index 65)
+    (:client-stats :index 66)
+    (:client-ping :index 67)
+    (:client-pong :index 68)
+    (:client-abort :index 106))
+  ;; Nested messages
+
+  (pi:define-message store-and-forward.statistics
+      ()
+    ;; Fields
+    (messages-total
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "messagesTotal")
+    (messages-saved
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "messagesSaved")
+    (messages-max
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "messagesMax")
+    (up-time
+     :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "upTime")
+    (requests
+     :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "requests")
+    (requests-history
+     :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "requestsHistory")
+    (heartbeat
+     :index 7 :type cl:boolean :kind :scalar :label (:optional) :json-name "heartbeat")
+    (return-max
+     :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "returnMax")
+    (return-window
+     :index 9 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "returnWindow"))
+
+  (pi:define-message store-and-forward.history
+      ()
+    ;; Fields
+    (history-messages
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "historyMessages")
+    (window
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "window")
+    (last-request
+     :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "lastRequest"))
+
+  (pi:define-message store-and-forward.heartbeat
+      ()
+    ;; Fields
+    (period
+     :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "period")
+    (secondary
+     :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "secondary"))
+  ;; Fields
+  (pi:define-oneof variant ()
+    (stats
+     :index 2 :type store-and-forward.statistics :kind :message :label (:optional) :json-name "stats")
+    (history
+     :index 3 :type store-and-forward.history :kind :message :label (:optional) :json-name "history")
+    (heartbeat
+     :index 4 :type store-and-forward.heartbeat :kind :message :label (:optional) :json-name "heartbeat")
+    (empty
+     :index 5 :type cl:boolean :kind :scalar :label (:optional) :json-name "empty"))
+  (rr
+   :index 1 :type store-and-forward.request-response :kind :enum :label (:optional) :json-name "rr" :default :unset))
+
+(cl:export '(empty
+             heartbeat
+             history
+             history-messages
+             last-request
+             messages-max
+             messages-saved
+             messages-total
+             period
+             requests
+             requests-history
+             return-max
+             return-window
+             rr
+             secondary
+             stats
+             store-and-forward
+             store-and-forward.heartbeat
+             store-and-forward.history
+             store-and-forward.request-response
+             store-and-forward.request-response-int-to-keyword
+             store-and-forward.request-response-keyword-to-int
+             store-and-forward.statistics
+             storeforward
+             up-time
+             window))

examples/meshtastic/lisp/proto/meshtastic/telemetry.lisp

@@ -0,0 +1,145 @@
+;;; meshtastic/telemetry.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'telemetry
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level enums
+
+(pi:define-enum telemetry-sensor-type
+    ()
+  (:sensor-unset :index 0)
+  (:bme280 :index 1)
+  (:bme680 :index 2)
+  (:mcp9808 :index 3)
+  (:ina260 :index 4)
+  (:ina219 :index 5)
+  (:bmp280 :index 6)
+  (:shtc3 :index 7)
+  (:lps22 :index 8)
+  (:qmc6310 :index 9)
+  (:qmi8658 :index 10)
+  (:qmc5883l :index 11)
+  (:sht31 :index 12)
+  (:pmsa003i :index 13))
+
+;;; Top-Level messages
+
+(pi:define-message device-metrics
+    ()
+  ;; Fields
+  (battery-level
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "batteryLevel")
+  (voltage
+   :index 2 :type cl:float :kind :scalar :label (:optional) :json-name "voltage")
+  (channel-utilization
+   :index 3 :type cl:float :kind :scalar :label (:optional) :json-name "channelUtilization")
+  (air-util-tx
+   :index 4 :type cl:float :kind :scalar :label (:optional) :json-name "airUtilTx"))
+
+(pi:define-message environment-metrics
+    ()
+  ;; Fields
+  (temperature
+   :index 1 :type cl:float :kind :scalar :label (:optional) :json-name "temperature")
+  (relative-humidity
+   :index 2 :type cl:float :kind :scalar :label (:optional) :json-name "relativeHumidity")
+  (barometric-pressure
+   :index 3 :type cl:float :kind :scalar :label (:optional) :json-name "barometricPressure")
+  (gas-resistance
+   :index 4 :type cl:float :kind :scalar :label (:optional) :json-name "gasResistance")
+  (voltage
+   :index 5 :type cl:float :kind :scalar :label (:optional) :json-name "voltage")
+  (current
+   :index 6 :type cl:float :kind :scalar :label (:optional) :json-name "current"))
+
+(pi:define-message air-quality-metrics
+    ()
+  ;; Fields
+  (pm10-standard
+   :index 1 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pm10Standard")
+  (pm25-standard
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pm25Standard")
+  (pm100-standard
+   :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pm100Standard")
+  (pm10-environmental
+   :index 4 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pm10Environmental")
+  (pm25-environmental
+   :index 5 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pm25Environmental")
+  (pm100-environmental
+   :index 6 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "pm100Environmental")
+  (particles-03um
+   :index 7 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "particles03um")
+  (particles-05um
+   :index 8 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "particles05um")
+  (particles-10um
+   :index 9 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "particles10um")
+  (particles-25um
+   :index 10 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "particles25um")
+  (particles-50um
+   :index 11 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "particles50um")
+  (particles-100um
+   :index 12 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "particles100um"))
+
+(pi:define-message telemetry
+    ()
+  ;; Fields
+  (pi:define-oneof variant ()
+    (device-metrics
+     :index 2 :type device-metrics :kind :message :label (:optional) :json-name "deviceMetrics")
+    (environment-metrics
+     :index 3 :type environment-metrics :kind :message :label (:optional) :json-name "environmentMetrics")
+    (air-quality-metrics
+     :index 4 :type air-quality-metrics :kind :message :label (:optional) :json-name "airQualityMetrics"))
+  (time
+   :index 1 :type cl-protobufs:fixed32 :kind :scalar :label (:optional) :json-name "time"))
+
+(cl:export '(air-quality-metrics
+             air-util-tx
+             barometric-pressure
+             battery-level
+             channel-utilization
+             current
+             device-metrics
+             environment-metrics
+             gas-resistance
+             particles-03um
+             particles-05um
+             particles-100um
+             particles-10um
+             particles-25um
+             particles-50um
+             pm10-environmental
+             pm10-standard
+             pm100-environmental
+             pm100-standard
+             pm25-environmental
+             pm25-standard
+             relative-humidity
+             telemetry
+             telemetry-sensor-type
+             telemetry-sensor-type-int-to-keyword
+             telemetry-sensor-type-keyword-to-int
+             temperature
+             time
+             voltage))

examples/meshtastic/lisp/proto/meshtastic/xmodem.lisp

@@ -0,0 +1,61 @@
+;;; meshtastic/xmodem.proto.lisp
+;;;
+;;; Generated by the protocol buffer compiler. DO NOT EDIT!
+
+(cl:in-package #:common-lisp-user)
+
+#+sbcl
+(cl:progn
+ (cl:eval-when (:compile-toplevel) (sb-ext:restrict-compiler-policy 'cl:debug 0 1))
+ (cl:declaim (cl:optimize (sb-c:store-coverage-data 0))))
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+  (cl:unless (cl:find-package "CL-PROTOBUFS.MESHTASTIC")
+    (cl:defpackage "CL-PROTOBUFS.MESHTASTIC" (:use)
+                   (:local-nicknames (#:pi #:cl-protobufs.implementation)))))
+
+(cl:in-package "CL-PROTOBUFS.MESHTASTIC")
+
+(cl:eval-when (:compile-toplevel :load-toplevel :execute)
+(pi:define-schema 'xmodem
+    :syntax :proto3
+
+     :package "meshtastic")
+)
+
+
+;;; Top-Level messages
+
+(pi:define-message x-modem
+    ()
+  ;; Nested enums
+
+  (pi:define-enum x-modem.control
+      ()
+    (:nul :index 0)
+    (:soh :index 1)
+    (:stx :index 2)
+    (:eot :index 4)
+    (:ack :index 6)
+    (:nak :index 21)
+    (:can :index 24)
+    (:ctrlz :index 26))
+  ;; Fields
+  (control
+   :index 1 :type x-modem.control :kind :enum :label (:optional) :json-name "control" :default :nul)
+  (seq
+   :index 2 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "seq")
+  (crc16
+   :index 3 :type cl-protobufs:uint32 :kind :scalar :label (:optional) :json-name "crc16")
+  (buffer
+   :index 4 :type cl-protobufs:byte-vector :kind :scalar :label (:optional) :json-name "buffer"))
+
+(cl:export '(buffer
+             control
+             crc16
+             seq
+             x-modem
+             x-modem.control
+             x-modem.control-int-to-keyword
+             x-modem.control-keyword-to-int
+             xmodem))

examples/meshtastic/lisp/qml-reload/auto-reload.lisp

@@ -0,0 +1,34 @@
+;;; trivial QML auto reload during development (desktop only), see:
+;;;
+;;;   lqml run.lisp -auto
+
+(in-package :qml-user)
+
+(defvar *dir* *load-truename*)
+
+(defun qml:view-status-changed (status)
+  (when (= 1 status)
+    (load (merge-pathnames "on-reloaded" *dir*))))
+
+(let ((secs 0)
+      files)
+  (defun watch-files ()
+    (flet ((repeat ()
+             (qsingle-shot 500 'watch-files)))
+      (unless files
+        (dolist (file (directory (merge-pathnames "../../qml/**/*.qml" *dir*)))
+          (push file files)))
+      (let ((curr 0))
+        (dolist (file files)
+          (let ((date (file-write-date file)))
+            (unless date ; might be NIL while saving
+              (return-from watch-files (repeat)))
+            (incf curr date)))
+        (when (/= secs curr)
+          (unless (zerop secs)
+            (qml:reload))
+          (setf secs curr)))
+      (repeat))))
+
+(watch-files)
+

examples/meshtastic/lisp/qml-reload/on-reloaded.lisp

@@ -0,0 +1,5 @@
+;;; this file will be loaded every time QML has been reloaded
+
+(in-package :qml-user)
+
+

examples/meshtastic/lisp/qt.lisp

@@ -0,0 +1,19 @@
+(defpackage :qt
+  (:use :cl :qml)
+  (:export
+   #:*ble*
+   #:ini
+   #:read*
+   #:write*))
+
+(in-package :qt)
+
+(defvar *ble* nil)
+
+(defun ini ()
+  (setf *ble*
+        #+qt-plugin (qload-c++ "cpp/qt")
+        #-qt-plugin (qfind-child nil "QT"))
+  (let ((*package* (find-package :qt)))
+    (define-qt-wrappers *ble*)))
+

examples/meshtastic/lisp/radio.lisp

@@ -0,0 +1,184 @@
+(in-package :radio)
+
+(defvar *region* :eu-868) ; Europe 868 MHz
+
+(defvar *primary-channel* nil)
+(defvar *channels*        nil)
+(defvar *my-node-info*    nil)
+(defvar *node-infos*      nil)
+(defvar *config-lora*     nil)
+
+;;; header
+
+(defun lsb (size)
+  (ldb (byte 8 0) size))
+
+(defun msb (size)
+  (ldb (byte 8 8) size))
+
+(defun header (size)
+  (vector #x94 #xc3 (msb size) (lsb size)))
+
+;;; ini/send/receive
+
+(defvar *config-id* 0)
+(defvar *notify-id* nil)
+(defvar *ready*     nil)
+(defvar *reading*   nil)
+(defvar *received*  nil)
+
+(defun to-bytes (list)
+  (make-array (length list)
+              :element-type '(unsigned-byte 8)
+              :initial-contents list))
+
+(defun set-ready (&optional (ready t)) ; called from Qt
+  (setf *ready* ready)
+  (when ready
+    (qlater 'start-config))
+  (values))
+
+(defun start-config ()
+  #+android
+  (ensure-permissions :access-coarse-location) ; needed for BLE
+  (when *ready*
+    (incf *config-id*)
+    (send-to-radio
+     (me:make-to-radio :want-config-id *config-id*))))
+
+(defun send-message (text)
+  "Sends TEXT to radio and adds it to QML item model."
+  (incf msg:*message-id*)
+  (send-to-radio
+   (me:make-to-radio
+    :packet (me:make-mesh-packet
+             :from (me:num *my-node-info*)
+             :to (me:num (first *node-infos*)) ; assumes just 2 radios (for now)
+             :id msg:*message-id*
+             :want-ack t
+             :decoded (me:make-data
+                       :portnum :text-message-app
+                       :payload (babel:string-to-octets text)))))
+  (msg:add-message
+   (list :m-text text
+         :m-sender (me:short-name (me:user *my-node-info*))
+         :m-timestamp (timestamp-to-string)
+         :m-id msg:*message-id*
+         :m-ack-state (position :not-received msg:*states*))))
+
+(defun read-radio ()
+  "Triggers a read on the radio. Will call RECEIVED-FROM-RADIO on success."
+  (qrun* (qt:read* qt:*ble*)))
+
+(defun send-to-radio (to-radio)
+  "Sends passed TO-RADIO, preceded by a header."
+  (pr:print-json to-radio)
+  (let ((bytes (pr:serialize-to-bytes to-radio)))
+    (qrun*
+     (qt:write* qt:*ble* (header (length bytes)))
+     (qt:write* qt:*ble* bytes))))
+
+(defun received-from-radio (bytes &optional notified) ; called from Qt
+  (if notified
+      (progn
+        (setf *notify-id* bytes)
+        (read-radio))
+      (let ((from-radio (pr:deserialize-from-bytes 'me:from-radio bytes)))
+        (setf *reading* t)
+        (pr:print-json from-radio)
+        (push from-radio *received*)))
+  (values))
+
+(defun receiving-done ()
+  (setf *reading* nil)
+  (process-received))
+
+(defun node-to-name (num)
+  (dolist (info *node-infos*)
+    (when (= num (me:num info))
+      (return (me:short-name (me:user info))))))
+
+(defun timestamp-to-string (&optional (secs (get-universal-time)))
+  (multiple-value-bind (_ m h)
+      (decode-universal-time secs)
+    (format nil "~D:~2,'0D" h m)))
+
+(defun process-received ()
+  "Walks *RECEIVED* FROM-RADIOs and saves relevant data."
+  (setf *received* (nreverse *received*))
+  (dolist (struct *received*)
+    (cond ((me:from-radio.has-packet struct)
+           (let* ((packet (me:from-radio.packet struct))
+                  (decoded (me:decoded packet))
+                  (payload (me:payload decoded)))
+             (case (me:portnum decoded)
+               ;; text-message
+               (:text-message-app
+                (msg:add-message
+                 (list :m-text (babel:octets-to-string payload)
+                       :m-sender (node-to-name (me:from packet))
+                       :m-timestamp (timestamp-to-string))))
+               ;; for :m-ack-state (acknowledgement state)
+               (:routing-app
+                (msg:change-state (case (me:routing.error-reason
+                                         (pr:deserialize-from-bytes 'me:routing payload))
+                                    (:none :received))
+                                  (me:request-id decoded))))))
+          ;; my-info
+          ((me:from-radio.has-my-info struct)
+           (setf *my-node-info* (me:my-node-num (me:my-info struct))))
+          ;; node-info
+          ((me:from-radio.has-node-info struct)
+           (let ((info (me:node-info struct)))
+             (if (eql *my-node-info* (me:num info))
+                 (setf *my-node-info* info)
+                 (push info *node-infos*))))
+          ;; channel
+          ((me:from-radio.has-channel struct)
+           (let ((channel (me:channel struct)))
+             (if (eql :primary (me:role channel))
+                 (setf *primary-channel* channel)
+                 (push channel *channels*))))
+          ;; config lora
+          ((me:from-radio.has-config struct)
+           (let ((config (me:config struct)))
+             (when (me:config.has-lora config)
+               (setf *config-lora* (me:lora config)))))
+          ;; config-complete-id
+          ((me:from-radio.has-config-complete-id struct)
+           (when (= *config-id* (me:config-complete-id struct))
+             (qlater 'config-device)
+             (q> |myName| ui:*view*
+                 (me:short-name (me:user *my-node-info*)))
+             (q> |playing| ui:*busy* nil)
+             (qlog :config-complete *config-id*)))))
+  (setf *received* nil))
+
+(defun send-admin (admin-message)
+  (send-to-radio
+   (me:make-to-radio
+    :packet (me:make-mesh-packet
+             :id (incf msg:*message-id*)
+             :want-ack t
+             :decoded (me:make-data
+                       :portnum :admin-app
+                       :payload (pr:serialize-to-bytes admin-message)
+                       :want-response t)))))
+
+(defun config-device ()
+  "Absolut minimum necessary for sending text messages."
+  ;; lora settings
+  (send-admin 
+   (me:make-admin-message
+    :set-config (me:make-config
+                 :lora (me:make-config.lo-ra-config
+                        :use-preset t
+                        :region *region*
+                        :hop-limit 3
+                        :tx-enabled t))))
+  ;; channel settings
+  (send-admin
+   (me:make-admin-message
+    :set-channel (me:make-channel
+                  :settings (me:make-channel-settings :psk (to-bytes (list 1)))
+                  :role :primary))))

examples/meshtastic/lisp/ui-vars.lisp

@@ -0,0 +1,17 @@
+;;; keep sorted to recognize eventual name clashes
+
+(defpackage ui
+  (:use :cl)
+  (:export
+   #:*busy*
+   #:*hour-glass*
+   #:*messages*
+   #:*view*))
+
+(in-package :ui)
+
+(defparameter *busy*       "busy")
+(defparameter *hour-glass* "hour_glass")
+(defparameter *messages*   "messages")
+(defparameter *view*       "view")
+

examples/meshtastic/make.lisp

@@ -0,0 +1,125 @@
+;;; check target
+
+(defvar *32bit* (<= most-positive-fixnum (expt 2 32)))
+
+(let ((arg (first (ext:command-args))))
+  (mapc (lambda (name feature)
+          (when (search name arg)
+            (pushnew feature *features*)))
+        (list "/ecl-android" "/ecl-ios")
+        (list :android :ios)))
+
+#+(or android ios)
+(pushnew :mobile *features*)
+
+;;; copy ECL 'encodings/' (mobile only)
+
+(defun cc (&rest args)
+  (apply 'concatenate 'string args))
+
+#+mobile
+(defvar *assets* #+android "../platforms/android/assets/lib/"
+                 #+ios     "../platforms/ios/assets/Library/")
+
+#+mobile
+(defun shell (command)
+  (ext:run-program "sh" (list "-c" command)))
+
+#+mobile
+(unless (probe-file (cc *assets* "encodings"))
+  (ensure-directories-exist *assets*)
+  (let ((lib (cc (ext:getenv #+android (if *32bit* "ECL_ANDROID_32" "ECL_ANDROID")
+                             #+ios "ECL_IOS")
+                 "/lib/ecl-*/")))
+    (shell (cc "cp -r " lib "encodings " *assets*))))
+
+;;; compile ASDF system
+
+(require :asdf)
+(require :cmp)
+
+(push (merge-pathnames "../")
+      asdf:*central-registry*)
+
+(setf *default-pathname-defaults*
+      (truename (merge-pathnames "../../../"))) ; LQML root
+
+(defvar *current*
+        (let ((name (namestring *load-truename*)))
+          (subseq name
+                  (length (namestring *default-pathname-defaults*))
+                  (1+ (position #\/ name :from-end t)))))
+
+(dolist (file (list "package" "x" "ecl-ext" "ini" "qml")) ; load LQML symbols
+  (load (merge-pathnames file "src/lisp/")))
+
+(progn
+  (defvar cl-user::*tr-path* (truename (cc *current* "i18n/")))
+  (load "src/lisp/tr"))
+
+#-mobile
+(asdf:make-build "app"
+                 :monolithic t
+                 :type :static-library
+                 :move-here (cc *current* "build/tmp/")
+                 :init-name "ini_app")
+
+#+mobile
+(progn
+  (pushnew :interpreter *features*)
+  (defvar *asdf-system*  "app")
+  (defvar *ql-libs*      (cc *current* "ql-libs.lisp"))
+  (defvar *init-name*    "ini_app")
+  (defvar *library-path* (format nil "~Abuild-~A/tmp/"
+                                 *current*
+                                 #+android "android"
+                                 #+ios     "ios"))
+  (defvar *require*      (list :ecl-curl))
+  (load "platforms/shared/make"))
+
+;;; rename lib
+
+(let* ((from #-mobile (cc *current* (format nil "build/tmp/app--all-systems.~A"
+                                            #+msvc "lib"
+                                            #-msvc "a"))
+             #+mobile (cc *library-path* "app--all-systems.a"))
+       (to   #+msvc "app.lib"
+             #-msvc "libapp.a")
+       (to*  #-mobile (cc *current* "build/tmp/" to)
+             #+mobile (cc *library-path* to)))
+  (when (probe-file to*)
+    (delete-file to*))
+  (rename-file from to))
+
+;;; build 'cl-protobufs.fas' (slow on mobile, will be loaded in background)
+
+#|
+#-mobile
+(asdf:make-build "my-cl-protobufs"
+                 :monolithic t
+                 :type :fasl
+                 :move-here (cc *current* "build/tmp/"))
+
+#+mobile
+(progn
+  (pushnew :interpreter *features*)
+  (defvar *asdf-system*  "my-cl-protobufs")
+  (defvar *ql-libs*      (cc *current* "ql-libs.lisp"))
+  (defvar *build-type*   :fasl)
+  (defvar *library-path* (format nil "~Abuild-~A/tmp/"
+                                 *current*
+                                 #+android "android"
+                                 #+ios     "ios"))
+  (load "platforms/shared/make"))
+
+;;; rename lib
+
+(let* ((from #-mobile (cc *current* "build/tmp/my-cl-protobufs--all-systems.fasb")
+             #+mobile (cc *library-path* "my-cl-protobufs--all-systems.fasb"))
+       (to   "cl-protobufs.fas")
+       (to*  #-mobile (cc *current* "build/tmp/" to)
+             #+mobile (cc *library-path* to)))
+  (when (probe-file to*)
+    (delete-file to*))
+  (rename-file from to))
+|#

examples/meshtastic/mkdirs.sh

@@ -0,0 +1,3 @@
+mkdir build
+mkdir build-android
+mkdir build-ios

examples/meshtastic/my-cl-protobufs.asd

@@ -0,0 +1,62 @@
+;;; This is included here because we don't want to depend on the
+;;; 'protoc-gen-cl-pb' executable, so we include the already generated lisp
+;;; files from the proto files of both cl-protobufs and meshtastic.
+;;;
+;;; So, this is just the strict minimum necessary for being able to serialize
+;;; and deserialize meshtastic data.
+
+(defsystem :my-cl-protobufs
+  :serial t
+  :depends-on (:closer-mop
+               :babel
+               :alexandria
+               :trivial-garbage
+               :cl-base64
+               :local-time
+               :float-features)
+  :components ((:file "lisp/cl-protobufs/pkgdcl")
+               (:file "lisp/cl-protobufs/utilities")
+               (:file "lisp/cl-protobufs/model-classes")
+               (:file "lisp/cl-protobufs/conditions")
+               (:file "lisp/cl-protobufs/parser")
+               (:file "lisp/cl-protobufs/define-proto")
+               (:file "lisp/cl-protobufs/buffers")
+               (:file "lisp/cl-protobufs/text-format")
+               (:file "lisp/cl-protobufs/wire-format")
+               ;; cl-proto
+               (:file "lisp/proto/cl-proto/any")
+               (:file "lisp/proto/cl-proto/source-context")
+               (:file "lisp/proto/cl-proto/type")
+               (:file "lisp/proto/cl-proto/api")
+               (:file "lisp/proto/cl-proto/duration")
+               (:file "lisp/proto/cl-proto/empty")
+               (:file "lisp/proto/cl-proto/field-mask")
+               (:file "lisp/proto/cl-proto/struct")
+               (:file "lisp/proto/cl-proto/timestamp")
+               (:file "lisp/proto/cl-proto/wrappers")
+               ;;(:file "lisp/proto/cl-proto/descriptor") ; not used
+               ;; meshtastic
+               (:file "lisp/proto/meshtastic/xmodem")
+               (:file "lisp/proto/meshtastic/telemetry")
+               (:file "lisp/proto/meshtastic/portnums")
+               (:file "lisp/proto/meshtastic/module-config")
+               (:file "lisp/proto/meshtastic/config")
+               (:file "lisp/proto/meshtastic/channel")
+               (:file "lisp/proto/meshtastic/connection-status")
+               (:file "lisp/proto/meshtastic/admin")
+               (:file "lisp/proto/meshtastic/mesh")
+               (:file "lisp/proto/meshtastic/storeforward")
+               (:file "lisp/proto/meshtastic/apponly")
+               (:file "lisp/proto/meshtastic/localonly")
+               (:file "lisp/proto/meshtastic/clientonly")
+               (:file "lisp/proto/meshtastic/deviceonly")
+               (:file "lisp/proto/meshtastic/remote-hardware")
+               (:file "lisp/proto/meshtastic/cannedmessages")
+               (:file "lisp/proto/meshtastic/mqtt")
+               (:file "lisp/proto/meshtastic/rtttl")
+               ;;
+               (:file "lisp/cl-protobufs/serialize")
+               (:file "lisp/cl-protobufs/well-known-types")
+               (:file "lisp/cl-protobufs/message-api")
+               (:file "lisp/cl-protobufs/json")))
+

examples/meshtastic/platforms/android/AndroidManifest.xml

@@ -0,0 +1,81 @@
+<?xml version="1.0"?>
+<manifest package="org.qtproject.example.meshtastic" xmlns:android="http://schemas.android.com/apk/res/android" android:versionName="1.0" android:versionCode="1" android:installLocation="auto">
+    <!-- The following comment will be replaced upon deployment with default permissions based on the dependencies of the application.
+         Remove the comment if you do not require these default permissions. -->
+    <uses-permission android:name="android.permission.INTERNET"/>
+    <uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE"/>
+    <uses-permission android:name="android.permission.BLUETOOTH"/>
+    <uses-permission android:name="android.permission.BLUETOOTH_ADMIN"/>
+    <uses-permission android:name="android.permission.ACCESS_FINE_LOCATION"/>
+    <uses-permission android:name="android.permission.ACCESS_COARSE_LOCATION"/>
+    <uses-permission android:name="android.permission.ACCESS_NETWORK_STATE"/>
+
+    <!-- The following comment will be replaced upon deployment with default features based on the dependencies of the application.
+         Remove the comment if you do not require these default features. -->
+
+
+    <supports-screens android:largeScreens="true" android:normalScreens="true" android:anyDensity="true" android:smallScreens="true"/>
+    <application android:hardwareAccelerated="true" android:name="org.qtproject.qt5.android.bindings.QtApplication" android:label="cl-meshtastic" android:extractNativeLibs="true">
+        <activity android:configChanges="orientation|uiMode|screenLayout|screenSize|smallestScreenSize|layoutDirection|locale|fontScale|keyboard|keyboardHidden|navigation|mcc|mnc|density" android:name="org.qtproject.qt5.android.bindings.QtActivity" android:label="cl-meshtastic" android:screenOrientation="unspecified" android:launchMode="singleTop" android:exported="true">
+            <intent-filter>
+                <action android:name="android.intent.action.MAIN"/>
+                <category android:name="android.intent.category.LAUNCHER"/>
+            </intent-filter>
+            <!-- Application arguments -->
+            <!-- meta-data android:name="android.app.arguments" android:value="arg1 arg2 arg3"/ -->
+            <!-- Application arguments -->
+            <meta-data android:name="android.app.lib_name" android:value="app"/>
+            <meta-data android:name="android.app.qt_sources_resource_id" android:resource="@array/qt_sources"/>
+            <meta-data android:name="android.app.repository" android:value="default"/>
+            <meta-data android:name="android.app.qt_libs_resource_id" android:resource="@array/qt_libs"/>
+            <meta-data android:name="android.app.bundled_libs_resource_id" android:resource="@array/bundled_libs"/>
+            <!-- Deploy Qt libs as part of package -->
+            <meta-data android:name="android.app.bundle_local_qt_libs" android:value="1"/>
+            <!-- Run with local libs -->
+            <meta-data android:name="android.app.use_local_qt_libs" android:value="1"/>
+            <meta-data android:name="android.app.libs_prefix" android:value="/data/local/tmp/qt/"/>
+            <meta-data android:name="android.app.load_local_libs_resource_id" android:resource="@array/load_local_libs"/>
+            <meta-data android:name="android.app.load_local_jars" android:value="jar/QtAndroid.jar:jar/QtAndroidExtras.jar:jar/QtAndroidBluetooth.jar:jar/QtAndroidBearer.jar"/>
+            <meta-data android:name="android.app.static_init_classes" android:value="org.qtproject.qt5.android.bluetooth.QtBluetoothBroadcastReceiver"/>
+            <!-- Used to specify custom system library path to run with local system libs -->
+            <!-- <meta-data android:name="android.app.system_libs_prefix" android:value="/system/lib/"/> -->
+            <!--  Messages maps -->
+            <meta-data android:value="@string/ministro_not_found_msg" android:name="android.app.ministro_not_found_msg"/>
+            <meta-data android:value="@string/ministro_needed_msg" android:name="android.app.ministro_needed_msg"/>
+            <meta-data android:value="@string/fatal_error_msg" android:name="android.app.fatal_error_msg"/>
+            <meta-data android:value="@string/unsupported_android_version" android:name="android.app.unsupported_android_version"/>
+            <!--  Messages maps -->
+            <!-- Splash screen -->
+            <!-- Orientation-specific (portrait/landscape) data is checked first. If not available for current orientation,
+                 then android.app.splash_screen_drawable. For best results, use together with splash_screen_sticky and
+                 use hideSplashScreen() with a fade-out animation from Qt Android Extras to hide the splash screen when you
+                 are done populating your window with content. -->
+            <!-- meta-data android:name="android.app.splash_screen_drawable_portrait" android:resource="@drawable/logo_portrait" / -->
+            <!-- meta-data android:name="android.app.splash_screen_drawable_landscape" android:resource="@drawable/logo_landscape" / -->
+            <!-- meta-data android:name="android.app.splash_screen_drawable" android:resource="@drawable/logo"/ -->
+            <!-- meta-data android:name="android.app.splash_screen_sticky" android:value="true"/ -->
+            <!-- Splash screen -->
+            <!-- Background running -->
+            <!-- Warning: changing this value to true may cause unexpected crashes if the
+                          application still try to draw after
+                          "applicationStateChanged(Qt::ApplicationSuspended)"
+                          signal is sent! -->
+            <meta-data android:name="android.app.background_running" android:value="false"/>
+            <!-- Background running -->
+            <!-- auto screen scale factor -->
+            <meta-data android:name="android.app.auto_screen_scale_factor" android:value="false"/>
+            <!-- auto screen scale factor -->
+            <!-- extract android style -->
+            <!-- available android:values :
+                * default - In most cases this will be the same as "full", but it can also be something else if needed, e.g., for compatibility reasons
+                * full - useful QWidget & Quick Controls 1 apps
+                * minimal - useful for Quick Controls 2 apps, it is much faster than "full"
+                * none - useful for apps that don't use any of the above Qt modules
+                -->
+            <meta-data android:name="android.app.extract_android_style" android:value="default"/>
+            <!-- extract android style -->
+        </activity>
+        <!-- For adding service(s) please check: https://wiki.qt.io/AndroidServices -->
+    </application>
+
+</manifest>

examples/meshtastic/ql-libs.lisp

@@ -0,0 +1,4 @@
+;;; define here how to load eventual, not yet installed dependencies
+;;; (for cross-compiling only)
+;;; e.g. (ql:quickload :alexandria)
+

examples/meshtastic/qml/main.qml

@@ -0,0 +1,197 @@
+import QtQuick 2.15
+import QtQuick.Controls 2.15
+import QtQuick.Window 2.15
+
+Item {
+  id: main
+  objectName: "main"
+  width: 300
+  height: 500
+
+  function availableHeight() {
+    var h = Math.round(Qt.inputMethod.keyboardRectangle.y /
+                       ((Qt.platform.os === "android") ? Screen.devicePixelRatio : 1))
+    return (h === 0) ? main.height : h
+  }
+
+  Rectangle {
+    anchors.fill: parent
+    color: "#e5d8bd"
+  }
+
+  ListView {
+    id: view
+    objectName: "view"
+    width: parent.width
+    height: availableHeight() - rectEdit.height - 3
+    anchors.margins: 3
+    spacing: 3
+    delegate: messageDelegate
+    model: messages
+
+    property string myName
+  }
+
+  ListModel {
+    id: messages
+    objectName: "messages"
+
+    function addMessage(message) {
+      append(message)
+      view.positionViewAtEnd()
+    }
+
+    function changeState(state, id) {
+      for (var i = count - 1; i >= 0; i--) {
+        if (get(i).mId === id) {
+          setProperty(i, "mAckState", state)
+          break
+        }
+      }
+    }
+  }
+
+  Component {
+    id: messageDelegate
+
+    Item {
+      id: delegate
+      width: Math.max(text.contentWidth, rowSender.width + 4 * text.padding) + 2 * text.padding
+      height: text.contentHeight + 2 * text.padding + sender.contentHeight
+
+      Rectangle {
+        anchors.fill: parent
+        color: (mSender === view.myName) ? "#f2f2f2" : "#ffffcc"
+        radius: 12
+        border.width: 0
+        border.color: "#dc1128"
+
+        Row {
+          id: rowSender
+          padding: text.padding
+          spacing: padding
+
+          AnimatedImage {
+            id: semaphore
+            playing: false
+            y: 2
+            width: 8
+            height: width
+            source: "img/semaphore.gif"
+            currentFrame: mAckState
+            visible: (sender.text === view.myName)
+          }
+
+          Text {
+            id: sender
+            font.pixelSize: 10
+            font.bold: true
+            font.family: fontMono.name
+            color: "#8B0000"
+            text: mSender
+          }
+        }
+
+        Text {
+          id: timestamp
+          x: delegate.width - contentWidth - text.padding
+          y: text.padding
+          font.pixelSize: 10
+          font.family: fontText.name
+          color: "#505050"
+          text: mTimestamp
+        }
+
+        Text {
+          id: text
+          y: sender.contentHeight
+          width: main.width
+          padding: 5
+          wrapMode: Text.Wrap
+          font.pixelSize: 18
+          font.family: fontText.name
+          color: "#303030"
+          text: mText
+        }
+      }
+    }
+  }
+
+  Rectangle {
+    id: rectEdit
+    anchors.bottom: parent.bottom
+    width: parent.width
+    height: edit.paintedHeight + 14
+    border.width: 2
+    border.color: edit.focus ? "#228ae3" : "#c0c0c0"
+    radius: 12
+
+    TextArea {
+      id: edit
+      anchors.fill: parent
+      textFormat: TextEdit.PlainText
+      font.pixelSize: 18
+      font.family: fontText.name
+      selectionColor: "#228ae3"
+      selectedTextColor: "white"
+      wrapMode: TextEdit.Wrap
+      textMargin: 0
+      placeholderText: qsTr("message")
+    }
+
+    Image {
+      anchors.right: parent.right
+      anchors.bottom: parent.top
+      anchors.margins: 3
+      width: 38
+      height: width
+      source: "img/send.png"
+      visible: edit.focus
+
+      MouseArea {
+        anchors.fill: parent
+        onClicked: {
+          edit.focus = Qt.NoFocus
+          Lisp.call("radio:send-message", edit.text)
+          edit.clear()
+        }
+      }
+    }
+  }
+
+  // busy image / animation
+
+  Item { // shown while loading app (slow...)
+    anchors.fill: parent
+    objectName: "hour_glass"
+
+    Image {
+      anchors.centerIn: parent
+      source: "img/busy.png"
+    }
+
+    Text {
+      width: parent.width
+      anchors.bottom: parent.bottom
+      anchors.bottomMargin: main.height / 4
+      horizontalAlignment: Text.AlignHCenter
+      font.pixelSize: 20
+      text: qsTr("Loading app...\n(make take a while)")
+    }
+  }
+
+  AnimatedImage { // shown during config
+    objectName: "busy"
+    anchors.centerIn: parent
+    width: 42
+    height: width
+    z: 10
+    source: "img/busy.gif"
+    visible: playing
+    playing: false
+  }
+
+  FontLoader { id: fontText;  source: "fonts/tahoma.ttf" }
+  FontLoader { id: fontMono;  source: "fonts/Hack-Regular.ttf" }
+  FontLoader { id: fontMono2; source: "fonts/Hack-Bold.ttf" }
+}

examples/meshtastic/readme-build.md

@@ -0,0 +1,137 @@
+
+Special requirements
+--------------------
+
+This example requires both latest ECL from development branch (as of May 2023)
+plus the hack described in [hacks](hacks/).
+
+See also notes in [my-cl-protobufs.asd](my-cl-protobufs.asd).
+
+You will also need **uiop** installed under e.g. `~/quicklisp/local-projects/`
+(see ASDF sources).
+
+
+
+Prepare
+-------
+
+If you use Qt versions prior to 5.15, you need to adapt the QML module version
+to your minor Qt version in all files under `qml/`.
+
+Example: Qt5.**12** => import QtQuick 2.**12**.
+
+The version number can be omitted in Qt6.
+
+
+Note
+----
+
+Every Lisp file under `lisp/` and every qml/image/font/whatever file under
+`qml/` is added **automatically** to your Qt project file (both for re-compile
+and adding to resources included in the executable).
+
+So, you only need to **manually** care about the usual ASDF project files in
+`app.asd`.
+
+But -- *of course* -- you still need to run the respective **qmake** command
+every time you add new files to the project, because the automation is all
+defined in `app.pro`.
+
+
+Run desktop
+-----------
+```
+$ lqml run.lisp
+```
+
+
+Build desktop app
+-----------------
+```
+$ cd build
+
+$ qmake ..
+$ make
+```
+
+
+Build android APK
+-----------------
+```
+$ cd build-android
+
+$ qmake-android ..
+$ make apk
+
+$ ./install-run.sh
+```
+Log note: for showing only your own messages, see `log.sh`.
+
+
+
+Build iOS app
+-------------
+
+**Important notes**: the Qt Xcode integration is not perfect, which means: when
+you include asset files (like in example `swank-server`), they may not be
+copied to the build directory, the first time you build the app.
+
+So, it's a good idea to run `qmake-ios` again if there are any startup problems
+of the app (like asset files not found when launching).
+
+The first build after a `qmake-ios` will almost always fail (missing build
+files): don't worry, just run 'Build' (from Xcode) again, and the missing files
+will be created.
+
+You also need to check the console from where you launched `./xcode.sh` for
+eventual errors compiling the Lisp code.
+```
+$ cd build-ios
+
+$ qmake-ios ..
+
+$ ./xcode.sh
+```
+The script above first cross-compiles the Lisp code, then opens **Xcode**.
+
+Please note (important):
+
+* before building the app, go to 'Build Settings' / 'Build Options' and set
+  **Enable Bitcode** to **No**
+
+* if it complains about missing source files when first hitting the 'Run'
+  button, just hit the 'Run' button again (and they will be generated)
+
+* using latest Xcode, it may complain about the 'Legacy Build System'; just go
+  to 'File' / 'Project Settings' and select 'New Build System'
+
+* you only need to run `qmake-ios` again after you added/removed files to the
+  project; after every `qmake-ios`, the above steps need to be repeated
+
+If you cross-compiled ECL for the simulator, it should work there too, but this
+is currently only tested on **Intel**.
+
+Simulator note: to show the virtual keyboard, use `cmd-k`.
+
+
+
+Notes
+-----
+
+You will note that sometimes a change of a single Lisp file won't recompile
+that file on the next `make`; in those cases, just do something like
+`touch ../app.asd` to force recompilation of everything.
+
+For conditions during Qt event processing, a fallback restart is added at
+startup (needed in e.g. Slime).
+
+If you don't want this, define the following in `app.pro`:
+```
+DEFINES += NO_QT_RESTART
+```
+
+
+Translations (i18n)
+-------------------
+
+Please see [i18n/readme](i18n/readme.md).

examples/meshtastic/readme.md

@@ -0,0 +1,75 @@
+
+Info
+----
+
+Please note: this is **WIP!**. It's only a 'proof-of-concept' version.
+
+Eventually it will (hopefully) catch up with the official app versions.
+ 
+
+
+Technical notes
+---------------
+
+This app uses both **BLE** (bluetooth low energy) and the **protobufs**
+serialization library version 3.
+
+For BLE you need to build the plugin in `cpp/` first (written in Qt5).
+
+The cl-protobufs library is included here because the official version doesn't
+work without the C++ plugin installed (which we don't need here). So I made
+some small adaptions and included all generated proto Lisp files in order to be
+independent.
+
+Unfortunately cl-protobufs loads very slowly on mobile (and conses hugely
+during startup). On an older phone and a cold startup this may take up to 30
+seconds. On newer phones and warm startup it should 'only' take around 10
+seconds (which seems acceptable).
+
+You will see a json output of all data sent/received. It simply uses the
+`print-json` convenience function from cl-protobufs.
+
+
+
+Tested
+------
+
+Currently tested on Linux, macOS, android. The macOS version shows an exception
+during BLE ini, but works nevertheless.
+
+The iOS version doesn't currently work yet (WIP).
+
+
+
+How to use cl-meshtastic
+------------------------
+
+You currently need 2 meshtastic radio devices, both should be running before
+you start the app. Both bluetooth and location needs to be enabled (coarse
+location permission is required on android for BLE to work).
+
+Pairing might sometimes require some playing around. If it asks for a PIN and
+your device doesn't have a display (like the RAK starter kit), just use
+`123456`.
+
+On Linux you might need to restart the bluetooth service if you want to pair
+a different device (after already pairing a first one).
+
+
+
+Run
+---
+```
+lqml run.lisp
+```
+Optionally pass `-slime` to start a Swank server, and connect from Emacs with
+`M-x slime-connect`.
+
+During development you can pass `-auto`, which will reload all QML files after
+you made a change to any of them and saved it. For re-initialization after
+reloading, file `lisp/qml-reload/on-reloaded` will be loaded.
+
+Closing the window quits the app. If you try to kill it with `ctrl-c`, you need
+an additional `ctrl-d` to exit from ECL. To quit from Slime, do `(qq)` which is
+short for `(qquit)`.
+

examples/meshtastic/run.lisp

@@ -0,0 +1,38 @@
+(in-package :qml-user)
+
+(pushnew :qt-plugin *features*)
+
+(require :asdf)
+
+(push (merge-pathnames "./")
+      asdf:*central-registry*)
+
+(asdf:load-system :uiop)
+(asdf:load-system :trivial-package-local-nicknames)
+
+;; may take very long on mobile devices
+(time (asdf:load-system :my-cl-protobufs))
+
+(push :depends-loaded *features*)
+
+(asdf:operate 'asdf:load-source-op :app)
+
+(qset *quick-view*
+      |x| 75
+      |y| 75)
+
+(defun option (name)
+  (find name (ext:command-args) :test 'search))
+
+;;; trivial auto reload of all QML files after saving any change
+
+(when (option "-auto")
+  (load "lisp/qml-reload/auto-reload"))
+
+;;; for Slime after copying 'lqml-start-swank.lisp' from LQML sources
+;;; to your Slime directory, which is assumed to be '~/slime/'
+
+(when (option "-slime")
+  (load "~/slime/lqml-start-swank") ; for 'slime-connect' from Emacs
+  (qlater (lambda () (in-package :radio))))
+