json-schema-form.el

;;; json-schema-form.el --- Lean JSON-Schema -> widget.el form generator -*- lexical-binding: t; -*-
;;
;; Self-contained, zero-dependency (built-in only) UI generator for Emacs.
;; - Input:  JSON-Schema as an alist with keyword keys (json-parse-string with :object-type 'alist :array-type 'list :null-object nil is ideal)
;; - Output: Keyword-alist data, suitable for json-serialize.
;;
;; Core design:
;; - Widgets are generated from schema (subset) and validated both live (keystroke-to-color) and on submit.
;; - Validation uses widget :validate functions, plus a buffer-wide after-change hook that re-validates the widget at point.
;;
;; Regex note:
;; - JSON Schema patterns are typically ECMA-262-ish regex. Emacs uses its own regexp flavor.
;; - This implementation uses `string-match-p` directly.
;; - If you want PCRE conversion, inject a converter in `jsf--pattern->elisp-regexp`.
;;
;; Usage:
;;   (require 'json-schema-form)
;;   (json-schema-form-render SCHEMA
;;     (lambda (data)
;;       (message "Submitted: %s" (json-serialize data))))
;;
;; Demo:
;;   M-x json-schema-form-demo
;;
;;; Code:

(require 'widget)
(require 'wid-edit)
(require 'json)

(defgroup json-schema-form nil
  "Render JSON Schema forms using widget.el with live validation."
  :group 'applications)

(defface json-schema-form-invalid-face
  '((((class color) (min-colors 88) (background light)) :background "MistyRose1")
    (((class color) (min-colors 88) (background dark))  :background "firebrick4")
    (t :inverse-video t))
  "Face applied to invalid widgets."
  :group 'json-schema-form)

(defface json-schema-form-valid-face
  '((t :inherit default))
  "Face used to clear invalid highlighting."
  :group 'json-schema-form)

(defcustom json-schema-form-buffer-name "*JSON Schema Form*"
  "Default buffer name for rendered forms."
  :type 'string
  :group 'json-schema-form)

(defcustom json-schema-form-submit-button-text "Submit"
  "Text for the submit button."
  :type 'string
  :group 'json-schema-form)

(defcustom json-schema-form-cancel-button-text "Cancel"
  "Text for the cancel button."
  :type 'string
  :group 'json-schema-form)

(defcustom json-schema-form-field-width 40
  "Default visible width for editable fields."
  :type 'integer
  :group 'json-schema-form)

(defvar-local jsf--root-widget nil)
(defvar-local jsf--schema nil)
(defvar-local jsf--on-submit nil)
(defvar-local jsf--invalid-overlays (make-hash-table :test 'eq))

;;;; Utilities (schema access)

(defun jsf--alist-get (key alist &optional default)
  "Get KEY from keyword-keyed ALIST, else DEFAULT."
  (let ((cell (assq key alist)))
    (if cell (cdr cell) default)))

(defun jsf--schema-type (schema)
  "Return schema :type, or infer for a couple of common shapes."
  (let ((tval (jsf--alist-get :type schema nil)))
    (cond
     ((stringp tval) tval)
     ;; If :enum exists and no :type, assume string.
     ((jsf--alist-get :enum schema nil) "string")
     (t nil))))

(defun jsf--kw (s)
  "Convert property name string S to keyword symbol."
  (intern (concat ":" s)))

(defun jsf--pattern->elisp-regexp (pattern)
  "Convert JSON Schema PATTERN to an Emacs regexp.
Currently a stub: returns PATTERN unchanged.

Hook point for PCRE/ECMA conversion, e.g. pcre2el."
  pattern)

(defun jsf--read-number (s)
  "Parse S into a number. Returns (ok . value)."
  (let ((str (string-trim (or s ""))))
    (if (string-empty-p str)
        (cons nil nil)
      (condition-case _
          (let* ((res (read-from-string str))
                 (val (car res))
                 (pos (cdr res)))
            (if (and (numberp val)
                     ;; Ensure full consumption aside from whitespace.
                     (string-empty-p (string-trim (substring str pos))))
                (cons t val)
              (cons nil nil)))
        (error (cons nil nil))))))

(defun jsf--read-integer (s)
  "Parse S into an integer. Returns (ok . value)."
  (let* ((p (jsf--read-number s)))
    (if (and (car p) (integerp (cdr p)))
        p
      (cons nil nil))))

(defun jsf--range-check (n schema)
  "Return nil if N satisfies numeric constraints in SCHEMA, else a string error."
  (let ((min (jsf--alist-get :minimum schema nil))
        (max (jsf--alist-get :maximum schema nil))
        (emin (jsf--alist-get :exclusiveMinimum schema nil))
        (emax (jsf--alist-get :exclusiveMaximum schema nil)))
    (cond
     ((and (numberp min) (< n min)) (format "Must be >= %s" min))
     ((and (numberp max) (> n max)) (format "Must be <= %s" max))
     ((and (numberp emin) (<= n emin)) (format "Must be > %s" emin))
     ((and (numberp emax) (>= n emax)) (format "Must be < %s" emax))
     (t nil))))

(defun jsf--len-check (s schema)
  "Return nil if S satisfies length constraints in SCHEMA, else a string error."
  (let* ((minl (jsf--alist-get :minLength schema nil))
         (maxl (jsf--alist-get :maxLength schema nil))
         (len (length (or s ""))))
    (cond
     ((and (integerp minl) (< len minl)) (format "Length must be >= %d" minl))
     ((and (integerp maxl) (> len maxl)) (format "Length must be <= %d" maxl))
     (t nil))))

(defun jsf--required-p (prop required-list)
  "Return non-nil if PROP (string) is in REQUIRED-LIST (list of strings)."
  (and (listp required-list) (member prop required-list)))

;;;; Widget highlighting (invalid/valid)

(defun jsf--widget-overlays (w)
  "Return a list of overlays associated with widget W that are safe to face-tweak."
  (let (ovs)
    (dolist (k '(:field-overlay :button-overlay :sample-overlay :doc-overlay :value-overlay))
      (let ((ov (widget-get w k)))
        (when (overlayp ov) (push ov ovs))))
    ;; Fallback: if widget has :from/:to markers, create (and cache) our own overlay.
    (when (null ovs)
      (let ((from (widget-get w :from))
            (to (widget-get w :to)))
        (when (and (markerp from) (markerp to)
                   (<= (marker-position from) (marker-position to)))
          (let ((existing (gethash w jsf--invalid-overlays)))
            (unless (overlayp existing)
              (setq existing (make-overlay from to nil t t))
              (puthash w existing jsf--invalid-overlays))
            (push existing ovs)))))
    ovs))

(defun jsf--set-widget-face (w face)
  "Apply FACE to widget W overlays."
  (dolist (ov (jsf--widget-overlays w))
    (overlay-put ov 'face face)))

(defun jsf--mark-invalid (w)
  "Mark widget W invalid visually."
  (jsf--set-widget-face w 'json-schema-form-invalid-face))

(defun jsf--clear-invalid (w)
  "Clear invalid mark from widget W."
  (jsf--set-widget-face w 'json-schema-form-valid-face))

;;;; Validation primitives (return nil on success; (widget . msg) on failure)

(defun jsf--fail (w msg) (cons w msg))

(defun jsf--validate-integer (w)
  (let* ((schema (widget-get w :jsf-schema))
         (raw (widget-value w))
         (p (jsf--read-integer raw)))
    (cond
     ((not (car p)) (jsf--fail w "Invalid integer"))
     (t (let ((err (jsf--range-check (cdr p) schema)))
          (when err (jsf--fail w err)))))))

(defun jsf--validate-number (w)
  (let* ((schema (widget-get w :jsf-schema))
         (raw (widget-value w))
         (p (jsf--read-number raw)))
    (cond
     ((not (car p)) (jsf--fail w "Invalid number"))
     (t (let ((err (jsf--range-check (cdr p) schema)))
          (when err (jsf--fail w err)))))))

(defun jsf--validate-string-plain (w)
  (let* ((schema (widget-get w :jsf-schema))
         (s (widget-value w))
         (lenerr (jsf--len-check s schema)))
    (or (when lenerr (jsf--fail w lenerr))
        nil)))

(defun jsf--validate-string-regex (w)
  (let* ((schema (widget-get w :jsf-schema))
         (s (widget-value w))
         (pattern (jsf--alist-get :pattern schema nil))
         (re (and (stringp pattern) (jsf--pattern->elisp-regexp pattern))))
    (cond
     ((null re) (jsf--validate-string-plain w))
     ((not (string-match-p re (or s "")))
      (jsf--fail w "Does not match pattern"))
     (t (jsf--validate-string-plain w)))))

(defun jsf--validate-required (w)
  "If W is required (via :jsf-required), ensure non-empty/non-nil."
  (when (widget-get w :jsf-required)
    (let ((v (widget-value w)))
      (cond
       ((null v) (jsf--fail w "Required"))
       ((and (stringp v) (string-empty-p (string-trim v))) (jsf--fail w "Required"))
       (t nil)))))

(defun jsf--validate-array (w)
  "Validate editable-list children recursively."
  (let ((children (widget-get w :children)))
    (catch 'bad
      (dolist (c children)
        (let ((res (jsf--validate-widget-tree c)))
          (when res (throw 'bad res))))
      nil)))

(defun jsf--validate-object (w)
  "Validate group/object children recursively."
  (let ((children (widget-get w :children)))
    (catch 'bad
      (dolist (c children)
        (let ((res (jsf--validate-widget-tree c)))
          (when res (throw 'bad res))))
      nil)))

(defun jsf--validate-const (_w)
  nil)

(defun jsf--validate-widget-tree (w)
  "Validate widget W recursively. Return nil or (widget . msg)."
  (cl-block jsf--validate-widget-tree
    ;; 1) Required check (leaf-level) first.
    (let ((req (jsf--validate-required w)))
      (when req (cl-return-from jsf--validate-widget-tree req)))
    ;; 2) Widget's own validate, if any.
    (let ((vf (widget-get w :jsf-validate-fn)))
      (when (functionp vf)
        (let ((r (funcall vf w)))
          (when r (cl-return-from jsf--validate-widget-tree r)))))
    ;; 3) Recurse through known containers.
    (let ((kind (widget-get w :jsf-kind)))
      (cond
       ((eq kind 'array) (jsf--validate-array w))
       ((eq kind 'object) (jsf--validate-object w))
       (t nil)))))

(defun jsf--apply-live-validation (w)
  "Run validation for W and update faces. Return nil or (widget . msg)."
  (let ((res (jsf--validate-widget-tree w)))
    (if res
        (progn (jsf--mark-invalid (car res)) res)
      (progn (jsf--clear-invalid w) nil))))

;;;; Schema -> widget-spec

(defun jsf--find-first-editable-field (w)
  "Find the first editable field widget within W or its descendants.
Returns the widget with a valid :from marker, or nil."
  (when (widgetp w)
    (let ((from (widget-get w :from)))
      ;; Check if this widget is editable and has a valid :from marker
      (if (and (markerp from)
               (memq (widget-type w) '(editable-field text menu-choice checkbox)))
          w
        ;; Recursively search children
        (let ((children (widget-get w :children))
              found)
          (when (listp children)
            (dolist (c children)
              (unless found
                (setq found (jsf--find-first-editable-field c)))))
          found)))))

(defun jsf--widget-editable-pos (w)
  "Return the position where the user can start typing in widget W.
For editable-field, this is the start of the field overlay.
For other widgets, this is the :from marker position."
  (when (widgetp w)
    (let ((field-ov (widget-get w :field-overlay)))
      (if (overlayp field-ov)
          (overlay-start field-ov)
        (let ((from (widget-get w :from)))
          (when (markerp from)
            (marker-position from)))))))

(defun jsf--insert-button-action-advice (orig-fun widget &optional event)
  "Advice for `widget-insert-button-action' to focus cursor on new field.
When the parent editable-list has :jsf-kind set to 'array, after insertion
we move cursor to the first editable field in the newly created entry."
  (let* ((parent (widget-get widget :parent))
         (is-jsf-array (eq (widget-get parent :jsf-kind) 'array))
         (children-before (when is-jsf-array
                            (copy-sequence (widget-get parent :children)))))
    ;; Call the original function
    (funcall orig-fun widget event)
    ;; If this was a jsf array, find and focus the new child
    (when is-jsf-array
      (let* ((children-after (widget-get parent :children))
             (new-child nil))
        ;; Find child that wasn't in the before list
        (dolist (c children-after)
          (unless (or new-child (memq c children-before))
            (setq new-child c)))
        ;; Navigate to the first editable field in the new child
        (when new-child
          (let ((editable (jsf--find-first-editable-field new-child)))
            (when editable
              (let ((pos (jsf--widget-editable-pos editable)))
                (when pos
                  (goto-char pos))))))))))

;; Install the advice for cursor focus on insert
(advice-add 'widget-insert-button-action :around #'jsf--insert-button-action-advice)

(defun jsf--pos-in-any-form-region-p (pos)
  "Return non-nil if POS is inside any registered inline form's region.
Checks both text property and marker ranges to handle widget redraws."
  (or
   ;; Fast path: check text property
   (get-text-property pos 'jsf-form-id)
   ;; Slow path: check marker ranges (for text that lost properties after widget redraw)
   (and (hash-table-p jsf--inline-forms)
        (catch 'found
          (maphash
           (lambda (_id plist)
             (let ((start (plist-get plist :start))
                   (end (plist-get plist :end)))
               (when (and (markerp start) (markerp end)
                          (marker-buffer start)
                          (eq (marker-buffer start) (current-buffer))
                          (>= pos (marker-position start))
                          (< pos (marker-position end)))
                 (throw 'found t))))
           jsf--inline-forms)
          nil))))

(defun jsf--widget-before-change-advice (orig-fun from to)
  "Advice for `widget-before-change' to allow edits outside form regions.
If the change region (FROM TO) is entirely outside any jsf-form-id region,
skip the widget protection and allow the edit."
  (let ((in-form nil))
    ;; Check if any part of the change region is inside a form
    (when (or (jsf--pos-in-any-form-region-p from)
              (jsf--pos-in-any-form-region-p (max (1- to) from)))
      (setq in-form t))
    ;; If we're in a form region, let widget-before-change do its job
    ;; If we're outside all forms, skip protection entirely
    (if in-form
        (funcall orig-fun from to)
      ;; Allow the edit - do nothing
      nil)))

;; Install the advice for scoped form protection
(advice-add 'widget-before-change :around #'jsf--widget-before-change-advice)

(defun jsf--restore-form-text-properties-in-region (start end id)
  "Restore text properties in region START to END for form ID.
Ensures jsf-form-id and keymap properties cover the entire region."
  ;; Temporarily disable widget protection to allow property changes
  (let ((inhibit-read-only t)
        (inhibit-modification-hooks t))
    (save-excursion
      (goto-char start)
      (while (< (point) end)
        (let ((next-change (next-single-property-change (point) 'jsf-form-id nil end)))
          ;; If current position lacks the property, add it
          (unless (get-text-property (point) 'jsf-form-id)
            (add-text-properties (point) (or next-change end)
                                 (list 'jsf-form-id id
                                       'keymap widget-keymap)))
          (goto-char (or next-change end)))))))

(defun jsf--restore-all-form-properties ()
  "Restore text properties for all inline forms in current buffer.
Called from `post-command-hook' to fix properties after widget redraws."
  (when (and (hash-table-p jsf--inline-forms)
             (> (hash-table-count jsf--inline-forms) 0))
    (condition-case nil
        (maphash
         (lambda (id plist)
           (let ((start (plist-get plist :start))
                 (form-end (plist-get plist :end)))
             (when (and (markerp start) (markerp form-end)
                        (marker-buffer start)
                        (eq (marker-buffer start) (current-buffer)))
               (let ((s (marker-position start))
                     (e (marker-position form-end)))
                 (when (< s e)
                   (jsf--restore-form-text-properties-in-region s e id))))))
         jsf--inline-forms)
      (error nil)))) ; Silently ignore errors to avoid breaking commands

(defun jsf--property-order (properties)
  "Return stable property order from PROPERTIES alist.
PROPERTIES is expected to be an alist of (\"name\" . subschema) pairs."
  (mapcar #'car properties))

(defun schema->widget-spec (schema &optional path required-list)
  "Translate JSON schema (alist) into a widget spec.
PATH is a list of property names (strings) for diagnostics.
REQUIRED-LIST is the object's :required list (strings) when generating child props."
  (let* ((type (jsf--schema-type schema))
         (title (or (jsf--alist-get :title schema nil)
                    (jsf--alist-get :description schema nil)
                    (and path (car (last path)))
                    "field")))
    (pcase type
      ("integer"
       `(editable-field
         :tag ,(format "%s" title)
         :size ,json-schema-form-field-width
         :format "%t: %v\n"
         :jsf-kind leaf
         :jsf-schema ,schema
         :jsf-path ,path
         :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
         :jsf-validate-fn jsf--validate-integer))
      ("number"
       `(editable-field
         :tag ,(format "%s" title)
         :size ,json-schema-form-field-width
         :format "%t: %v\n"
         :jsf-kind leaf
         :jsf-schema ,schema
         :jsf-path ,path
         :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
         :jsf-validate-fn jsf--validate-number))
      ("boolean"
       `(checkbox
         :tag ,(format "%s" title)
         :format "%[%v%] %t\n"
         :jsf-kind leaf
         :jsf-schema ,schema
         :jsf-path ,path
         :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
         :jsf-validate-fn (lambda (_w) nil)))
      ("null"
       `(const
         :tag ,(format "%s" title)
         nil
         :jsf-kind leaf
         :jsf-schema ,schema
         :jsf-path ,path
         :jsf-validate-fn jsf--validate-const))
      ("string"
       (let ((enum (jsf--alist-get :enum schema nil))
             (pattern (jsf--alist-get :pattern schema nil)))
         (cond
          ((and enum (listp enum) (consp enum) (seq-every-p #'stringp enum))
           `(menu-choice
             :tag ,(format "%s" title)
             :format "%t: %[%v%]\n"
             :value ,(car enum)
             :jsf-kind leaf
             :jsf-schema ,schema
             :jsf-path ,path
             :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
             :jsf-validate-fn (lambda (_w) nil)
             ,@(mapcar (lambda (opt) `(item :tag ,opt ,opt)) enum)))
          ((stringp pattern)
           `(editable-field
             :tag ,(format "%s" title)
             :size ,json-schema-form-field-width
             :format "%t: %v\n"
             :jsf-kind leaf
             :jsf-schema ,schema
             :jsf-path ,path
             :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
             :jsf-validate-fn jsf--validate-string-regex))
          (t
           `(editable-field
             :tag ,(format "%s" title)
             :size ,json-schema-form-field-width
             :format "%t: %v\n"
             :jsf-kind leaf
             :jsf-schema ,schema
             :jsf-path ,path
             :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
             :jsf-validate-fn jsf--validate-string-plain)))))

      ("array"
       (let* ((items (jsf--alist-get :items schema nil))
              (child-spec (schema->widget-spec items (append path '("<item>")) nil)))
         `(editable-list
           :tag ,(format "%s" title)
           :format "%t:\n%v%i\n"
           :entry-format "  %i %d %v\n"
           :jsf-kind array
           :jsf-schema ,schema
           :jsf-path ,path
           :value ()
           :jsf-validate-fn (lambda (_w) nil)
           ,child-spec)))
      ("object"
       (let* ((props (jsf--alist-get :properties schema nil))
              (req (jsf--alist-get :required schema nil))
              (prop-names (and (listp props) (jsf--property-order props)))
              (children
               (mapcar
                (lambda (pname)
                  (let ((sub (cdr (assoc pname props))))
                    (schema->widget-spec sub (append path (list pname)) req)))
                prop-names)))
         `(group
           :tag ,(format "%s" title)
           :indent 2
           :format "%t:\n%v"
           :jsf-kind object
           :jsf-schema ,schema
           :jsf-path ,path
           :jsf-validate-fn (lambda (_w) nil)
           ,@children)))
      (_
       ;; Fallback: treat unknown as string.
       `(editable-field
         :tag ,(format "%s" title)
         :size ,json-schema-form-field-width
         :format "%t: %v\n"
         :jsf-kind leaf
         :jsf-schema ,schema
         :jsf-path ,path
         :jsf-required ,(and path (jsf--required-p (car (last path)) required-list))
         :jsf-validate-fn jsf--validate-string-plain)))))

;;;; Data extraction (widget tree -> keyword alist)

(defun jsf--widget->value (w)
  "Convert widget W to a typed value according to its :jsf-schema."
  (unless (widgetp w)
    (error "jsf--widget->value called on non-widget: %S" w))
  (let* ((schema (widget-get w :jsf-schema))
         (type (jsf--schema-type schema))
         (kind (widget-get w :jsf-kind)))
    (cond
     ((eq kind 'object)
      (jsf--gather-object w))
     ((eq kind 'array)
      (jsf--gather-array w))
     ((string= type "integer")
      (cdr (jsf--read-integer (widget-value w))))
     ((string= type "number")
      (cdr (jsf--read-number (widget-value w))))
     ((string= type "boolean")
      (if (widget-value w) t :false))
     ((string= type "null")
      nil)
     (t
      ;; string / fallback
      (let ((val (widget-value w)))
        ;; Trim whitespace from string values
        (if (stringp val)
            (string-trim val)
          val))))))

(defun jsf--gather-object (w)
  "Gather object widget W into a keyword alist."
  (let* ((schema (widget-get w :jsf-schema))
         (props (jsf--alist-get :properties schema nil))
         (children (widget-get w :children))
         (acc nil))
    ;; children order matches properties order; use each child's last path element for the key.
    (dolist (c children)
      (let* ((cpath (widget-get c :jsf-path))
             (pname (car (last cpath))) ; string
             (subschema (and (listp props) (cdr (assoc pname props))))
             (k (and (stringp pname) (jsf--kw pname))))
        (when (and k subschema)
          (push (cons k (jsf--widget->value c)) acc))))
    (nreverse acc)))

(defun jsf--gather-array (w)
  "Gather array widget W into a list."
  (let* ((schema (widget-get w :jsf-schema))
         (items-schema (jsf--alist-get :items schema nil))
         (items-type (jsf--schema-type items-schema))
         (children (widget-get w :children))
         (acc nil))
    (dolist (c children)
      (let ((value nil))
        (cond
         ;; If c is a widget with our metadata, use it directly
         ((and (widgetp c)
               (or (widget-get c :jsf-kind)
                   (widget-get c :jsf-schema)))
          (setq value (jsf--widget->value c)))
         ;; If c is a widget, try to find nested field widget or get value directly
         ((widgetp c)
          (let ((item-children (widget-get c :children))
                found-widget)
            (if (listp item-children)
                ;; Look for nested widget with our metadata
                (dolist (ch item-children)
                  (when (and (widgetp ch)
                             (or (widget-get ch :jsf-kind)
                                 (widget-get ch :jsf-schema))
                             (not found-widget))
                    (setq found-widget ch)))
              ;; No children list, try widget-value directly
              (condition-case nil
                  (setq value (widget-value c))
                (error nil)))
            ;; If we found a nested widget, use it
            (when found-widget
              (setq value (jsf--widget->value found-widget)))
            ;; If we still don't have a value, try widget-value on the item
            (when (null value)
              (condition-case nil
                  (setq value (widget-value c))
                (error nil)))))
         ;; If c is not a widget, it might be a raw value (shouldn't happen normally)
         ((stringp c)
          (setq value c))
         (t nil))
        ;; Process the value according to items schema
        (when value
          (let ((processed-value
                 (cond
                  ;; If value came from jsf--widget->value, it's already processed
                  ((and (not (stringp value))
                        (not (null value)))
                   value)
                  ;; Process string values according to schema
                  ((and items-type (string= items-type "integer"))
                   (let ((parsed (jsf--read-integer (if (stringp value) value (format "%s" value)))))
                     (if (car parsed) (cdr parsed) nil)))
                  ((and items-type (string= items-type "number"))
                   (let ((parsed (jsf--read-number (if (stringp value) value (format "%s" value)))))
                     (if (car parsed) (cdr parsed) nil)))
                  ((stringp value)
                   (string-trim value))
                  (t value))))
            (when processed-value
              (push processed-value acc))))))
    (vconcat (nreverse acc))))

(defun form-gather-data ()
  "Validate all fields and return keyword-alist data from the current form.
On validation failure, signals a user-error."
  (unless (and (boundp 'jsf--root-widget) (widgetp jsf--root-widget))
    (user-error "Not in a JSON Schema Form buffer"))
  (let ((bad (jsf--validate-widget-tree jsf--root-widget)))
    (when bad
      (let ((w (car bad))
            (msg (cdr bad)))
        (jsf--mark-invalid w)
        (let ((from (widget-get w :from)))
          (when (markerp from) (goto-char (marker-position from))))
        (message "%s" msg)
        (user-error "%s" msg))))
  (jsf--widget->value jsf--root-widget))

;;;; Live validation hook

(defun jsf--widget-at-point ()
  "Return a widget at point, preferring the innermost."
  (let ((w (widget-at (point))))
    ;; widget-at can return a "child" object; accept it if it is a widget.
    (when (widgetp w) w)))

(defun jsf--after-change (_beg _end _len)
  "after-change-functions hook for live validation."
  (condition-case err
      (let ((w (jsf--widget-at-point)))
        (when (widgetp w)
          ;; Validate this widget (and its subtree, if any).
          (jsf--apply-live-validation w)))
    (error
     ;; Don't let validation errors break the widget system.
     ;; Just log the error silently.
     (message "Validation error (ignored): %s" (error-message-string err)))))

;;;; Renderer

(defun render-schema-form (schema callback &optional buffer-name)
  "Create a form for SCHEMA in a new buffer and call CALLBACK with gathered data on submit.
SCHEMA must be a keyword-keyed alist JSON schema.
CALLBACK is called with the final keyword alist (typed) on successful submit."
  (let* ((buf (get-buffer-create (or buffer-name json-schema-form-buffer-name)))
         (spec (schema->widget-spec schema nil nil)))
    (with-current-buffer buf
      (let ((inhibit-read-only t))
        (erase-buffer)
        (remove-overlays)
        (kill-all-local-variables)

        (setq-local jsf--schema schema)
        (setq-local jsf--on-submit callback)
        (setq-local jsf--invalid-overlays (make-hash-table :test 'eq))

        (widget-insert "JSON Schema Form\n\n")
        (setq-local jsf--root-widget (widget-create spec))
        (widget-insert "\n")

        (widget-create
         'push-button
         :tag json-schema-form-cancel-button-text
         :help-echo "Cancel and close form"
         :notify (lambda (&rest _)
                   (let ((buf (current-buffer)))
                     (message "Form cancelled")
                     (kill-buffer buf))))
        (widget-insert "  ")
        (widget-create
         'push-button
         :tag json-schema-form-submit-button-text
         :help-echo "Validate and submit"
         :notify (lambda (&rest _)
                   (when (and (boundp 'jsf--root-widget) (widgetp jsf--root-widget))
                     (let ((bad (jsf--validate-widget-tree jsf--root-widget)))
                       (if bad
                           (let ((w (car bad))
                                 (msg (cdr bad)))
                             (jsf--mark-invalid w)
                             (let ((from (widget-get w :from)))
                               (when (markerp from) (goto-char (marker-position from))))
                             (message "Validation failed: %s" msg))
                         ;; Validation succeeded, gather data and call callback
                         (let ((data (jsf--widget->value jsf--root-widget)))
                           (when (functionp jsf--on-submit)
                             (funcall jsf--on-submit data))))))))

        (widget-insert "\n")
        (use-local-map widget-keymap)
        (widget-setup)

        ;; Live validation
        (add-hook 'after-change-functions #'jsf--after-change nil t)

        ;; Initial pass: do not mark everything invalid; only clear.
        (jsf--clear-invalid jsf--root-widget)

        (goto-char (point-min))
        (forward-line 2)))
    (pop-to-buffer buf)))

;;;###autoload
(defun json-schema-form-render (schema callback)
  "Public entrypoint: render SCHEMA and invoke CALLBACK on submit."
  (render-schema-form schema callback))

;;;; Demo

(defun json-schema-form--demo-schema ()
  "Return a small demo schema as a keyword-keyed alist."
  '((:type . "object")
    (:title . "Demo")
    (:required . ("name" "age"))
    (:properties
     . (("name" . ((:type . "string") (:minLength . 1) (:maxLength . 30) (:title . "Name")))
        ("age"  . ((:type . "integer") (:minimum . 0) (:maximum . 130) (:title . "Age")))
        ("email" . ((:type . "string")
                    (:pattern . "^[^@]+@[^@]+\\.[^@]+$")
                    (:title . "Email")))
        ("role" . ((:type . "string")
                   (:enum . ("user" "admin" "operator"))
                   (:title . "Role")))
        ("enabled" . ((:type . "boolean") (:title . "Enabled")))
        ("tags" . ((:type . "array")
                   (:title . "Tags")
                   (:items . ((:type . "string") (:minLength . 1) (:maxLength . 16) (:title . "Tag")))))))))

;;;###autoload
(defun json-schema-form-demo ()
  "Open a demo JSON Schema form."
  (interactive)
  (json-schema-form-render
   (json-schema-form--demo-schema)
   (lambda (data)
     (message "Submitted data: %s" (json-serialize data)))))

(provide 'json-schema-form)
;;; json-schema-form.el ends here



;;;; ---------------------------------------------------------------------------
;;;; Inline rendering extension (multi-form, buffer-local tracking, cleanup, resync)
;;;; Append this block to the end of the previous file.
;;;; ---------------------------------------------------------------------------

;; Buffer-local registry of inline forms: id (string) -> plist
;; Keys in plist:
;;   :id        string
;;   :schema    schema alist
;;   :callback  function
;;   :root      root widget object
;;   :start     marker (region start)
;;   :end       marker (region end)
;;
;; Implementation notes:
;; - Widgets are “text + overlays + widget objects”. If the user deletes the text region manually,
;;   the widget objects may still be referenced by our registry, but they become “orphaned”.
;; - Therefore we maintain a resync/GC pass that drops registry entries whose region is gone.
;; - We also stamp the region with a text property 'jsf-form-id so we can identify forms at point.

(defvar-local jsf--inline-forms (make-hash-table :test 'equal)
  "Buffer-local map of inline form id -> plist metadata.")

(defvar-local jsf--inline-form-counter 0
  "Monotonic counter used to generate per-buffer inline form ids.")

(defvar-local jsf--inline-resync-tick 0
  "Counter for throttling resync in `after-change-functions`.")

(defun jsf--next-inline-form-id ()
  "Return a fresh inline form id string for the current buffer."
  (setq jsf--inline-form-counter (1+ jsf--inline-form-counter))
  (format "jsf-%d" jsf--inline-form-counter))

(defun jsf--marker-live-in-current-buffer-p (m)
  "Non-nil if marker M is live and belongs to the current buffer."
  (and (markerp m)
       (marker-buffer m)
       (eq (marker-buffer m) (current-buffer))))

(defun jsf--safe-marker-pos (m)
  "Return marker position if live; else nil."
  (when (jsf--marker-live-in-current-buffer-p m)
    (marker-position m)))

(defun jsf--form-id-at-point ()
  "Return inline form id at point, or nil."
  (get-text-property (point) 'jsf-form-id))

(defun jsf--widget-walk (w fn)
  "Call FN on widget W and recursively on children."
  (when (widgetp w)
    (funcall fn w)
    (let ((children (widget-get w :children)))
      (when (listp children)
        (dolist (c children)
          (jsf--widget-walk c fn))))))

(defun jsf--form-put (id plist)
  "Store PLIST for inline form ID."
  (puthash id plist jsf--inline-forms))

(defun jsf--form-get (id)
  "Get plist for inline form ID."
  (gethash id jsf--inline-forms))

(defun jsf--form-del (id)
  "Remove inline form ID from registry."
  (remhash id jsf--inline-forms))

(defun jsf--form-region-valid-p (id plist)
  "Non-nil if PLIST's region still looks like it belongs to form ID."
  (let* ((sm (plist-get plist :start))
         (em (plist-get plist :end))
         (s (jsf--safe-marker-pos sm))
         (e (jsf--safe-marker-pos em)))
    (and s e (< s e)
         ;; Ensure at least one location in the supposed region still carries our id.
         (text-property-any s e 'jsf-form-id id))))

(defun jsf-inline-resync ()
  "Drop registry entries whose inline region has been deleted or no longer matches.
This does not modify buffer text; it only cleans internal tracking."
  (when (hash-table-p jsf--inline-forms)
    (let (dead)
      (maphash
       (lambda (id plist)
         (unless (jsf--form-region-valid-p id plist)
           (push id dead)))
       jsf--inline-forms)
      (dolist (id dead)
        ;; Best-effort cleanup of overlays we created for invalid highlighting.
        (let ((plist (jsf--form-get id)))
          (when plist
            (let ((root (plist-get plist :root)))
              (when (widgetp root)
                (jsf--widget-walk
                 root
                 (lambda (w)
                   ;; Remove any cached per-widget overlay we created (fallback overlay).
                   (let ((ov (and (hash-table-p jsf--invalid-overlays)
                                  (gethash w jsf--invalid-overlays))))
                     (when (overlayp ov) (delete-overlay ov))
                     (when (hash-table-p jsf--invalid-overlays)
                       (remhash w jsf--invalid-overlays))))))))))
        (jsf--form-del id))))

(defun jsf--after-change-inline-resync (_beg _end _len)
  "Throttled resync pass for inline forms."
  (condition-case err
      (progn
        (setq jsf--inline-resync-tick (1+ jsf--inline-resync-tick))
        ;; Throttle: every 40 buffer modifications.
        (when (>= jsf--inline-resync-tick 40)
          (setq jsf--inline-resync-tick 0)
          (jsf-inline-resync)))
    (error
     ;; Don't let resync errors break the widget system.
     (message "Resync error (ignored): %s" (error-message-string err)))))

(defun jsf--validate-widget-tree* (root)
  "Validate starting at ROOT. Return nil or (widget . msg)."
  (jsf--validate-widget-tree root))

(defun jsf-form-gather-data (id)
  "Validate and gather data for inline form ID. Returns keyword-alist data.
Signals user-error on validation failure."
  (let ((plist (jsf--form-get id)))
    (unless plist
      (user-error "No inline form with id %s" id))
    (unless (jsf--form-region-valid-p id plist)
      (jsf-inline-resync)
      (user-error "Inline form %s no longer exists in this buffer" id))
    (let* ((root (plist-get plist :root))
           (bad (jsf--validate-widget-tree* root)))
      (when bad
        (let ((w (car bad))
              (msg (cdr bad)))
          (jsf--mark-invalid w)
          (let ((from (widget-get w :from)))
            (when (markerp from) (goto-char (marker-position from))))
          (message "%s" msg)
          (user-error "%s" msg))))
    (jsf--widget->value (plist-get plist :root))))

(defun jsf-inline-destroy (id)
  "Destroy (delete) the inline form with ID from the buffer and registry."
  (let ((plist (jsf--form-get id)))
    (unless plist
      (user-error "No inline form with id %s" id))
    (let* ((sm (plist-get plist :start))
           (em (plist-get plist :end))
           (s (jsf--safe-marker-pos sm))
           (e (jsf--safe-marker-pos em)))
      ;; Delete internal overlays we created for invalid highlighting (best-effort).
      (let ((root (plist-get plist :root)))
        (when (widgetp root)
          (condition-case _err
              (jsf--widget-walk
               root
               (lambda (w)
                 (let ((ov (and (hash-table-p jsf--invalid-overlays)
                                (gethash w jsf--invalid-overlays))))
                   (when (overlayp ov) (delete-overlay ov))
                   (when (hash-table-p jsf--invalid-overlays)
                     (remhash w jsf--invalid-overlays)))))
            (error nil)))) ;; Ignore errors during cleanup
      ;; Delete text region if it still exists.
      (when (and s e (< s e))
        (condition-case _err
            (let ((inhibit-read-only t))
              ;; Remove all overlays in region (includes widget.el overlays).
              (remove-overlays s e)
              (delete-region s e))
          (error nil))) ;; Ignore errors during deletion
      ;; Drop registry entry; markers are allowed to be GC'd.
      (jsf--form-del id))))

(defun jsf-inline-destroy-at-point ()
  "Destroy the inline form at point."
  (interactive)
  (let ((id (jsf--form-id-at-point)))
    (unless id
      (user-error "No inline form at point"))
    (jsf-inline-destroy id)))

(defun jsf-inline-destroy-all ()
  "Destroy all inline forms in the current buffer."
  (interactive)
  (let (ids)
    (maphash (lambda (id _plist) (push id ids)) jsf--inline-forms)
    ;; Delete from bottom to top to reduce marker churn (best effort by start position).
    (setq ids
          (sort ids
                (lambda (a b)
                  (let* ((pa (jsf--form-get a))
                         (pb (jsf--form-get b))
                         (sa (jsf--safe-marker-pos (plist-get pa :start)))
                         (sb (jsf--safe-marker-pos (plist-get pb :start))))
                    (and sa sb (> sa sb))))))
    (dolist (id ids)
      (ignore-errors (jsf-inline-destroy id)))))

(defun jsf-inline-insert (schema callback &optional heading)
  "Insert an inline form for SCHEMA at point; invoke CALLBACK on submit.
Returns the form id string.

This supports multiple insertions per buffer by tracking each form in `jsf--inline-forms`."
  (let* ((id (jsf--next-inline-form-id))
         (spec (schema->widget-spec schema nil nil))
         (start (point-marker))
         root end)
    ;; Ensure live validation + resync are enabled in this buffer.
    (add-hook 'after-change-functions #'jsf--after-change nil t)
    (add-hook 'after-change-functions #'jsf--after-change-inline-resync nil t)
    ;; Use post-command-hook to restore properties after widget redraws
    ;; (widget.el uses inhibit-modification-hooks, so after-change doesn't work)
    (add-hook 'post-command-hook #'jsf--restore-all-form-properties nil t)

    ;; Insert a small header (optional) and then the widget tree.
    (when heading
      (insert (format "%s\n" heading)))
    (insert (format "Form %s\n\n" id))

    (setq root (widget-create spec))
    ;; Stamp all widget objects with the form id (useful for debugging and future routing).
    (jsf--widget-walk root (lambda (w) (widget-put w :jsf-form-id id)))

    (insert "\n")
    (widget-create
     'push-button
     :tag json-schema-form-cancel-button-text
     :help-echo "Cancel and destroy this inline form"
     :notify (lambda (&rest _)
               (message "Form cancelled")
               (jsf-inline-destroy id)))
    (insert "  ")
    (widget-create
     'push-button
     :tag json-schema-form-submit-button-text
     :help-echo "Validate and submit this inline form"
     :notify (lambda (&rest _)
               (let ((plist (jsf--form-get id)))
                 (when plist
                   (let* ((root (plist-get plist :root))
                          (bad (and root (jsf--validate-widget-tree root))))
                     (if bad
                         (let ((w (car bad))
                               (msg (cdr bad)))
                           (jsf--mark-invalid w)
                           (let ((from (widget-get w :from)))
                             (when (markerp from) (goto-char (marker-position from))))
                           (message "Validation failed: %s" msg))
                       ;; Validation succeeded, gather data and call callback
                       (let ((data (jsf--widget->value root)))
                         (when (functionp callback)
                           (funcall callback data)))))))))
    (insert "  ")
    (widget-create
     'push-button
     :tag "Submit and close"
     :help-echo "Validate, submit, and destroy this inline form"
     :notify (lambda (&rest _)
               (let ((plist (jsf--form-get id)))
                 (when plist
                   (let* ((root (plist-get plist :root))
                          (bad (and root (jsf--validate-widget-tree root))))
                     (if bad
                         (let ((w (car bad))
                               (msg (cdr bad)))
                           (jsf--mark-invalid w)
                           (let ((from (widget-get w :from)))
                             (when (markerp from) (goto-char (marker-position from))))
                           (message "Validation failed: %s" msg))
                       ;; Validation succeeded, gather data, call callback, and destroy
                       (let ((data (jsf--widget->value root)))
                         (when (functionp callback)
                           (funcall callback data))
                         ;; Only destroy if we got here (validation succeeded)
                         (jsf-inline-destroy id))))))))
    (insert "\n\n")

    ;; Establish end marker after all inserted material.
    (setq end (point-marker))

    ;; Stamp the entire region with text properties:
    ;; - jsf-form-id: for identification and resync
    ;; - keymap: scoped widget keybindings (only applies within form region)
    ;; Note: We don't use 'read-only here because widget.el manages field editability
    ;; through its own mechanisms (overlays with 'field property).
    (add-text-properties (marker-position start) (marker-position end)
                         (list 'jsf-form-id id
                               'keymap widget-keymap))

    ;; Finalize widget UI (no use-local-map - keymap is scoped via text property).
    (widget-setup)

    ;; Register this form.
    (jsf--form-put id (list :id id :schema schema :callback callback :root root :start start :end end))
    id))

(defun json-schema-form-insert-inline (schema callback)
  "Public entrypoint: insert an inline JSON schema form at point.
Returns the form id."
  (jsf-inline-insert schema callback "JSON Schema Form (inline)"))

;;;###autoload
(defun json-schema-form-demo-inline ()
  "Insert a demo form inline at point."
  (interactive)
  (json-schema-form-insert-inline
   (json-schema-form--demo-schema)
   (lambda (data)
     (message "Inline submitted data: %s" (json-serialize data)))))

;;;; ---------------------------------------------------------------------------
;;;; Behavior explanation (brief, operational)
;;;; ---------------------------------------------------------------------------
;;
;; If the user deletes the widget text region manually:
;; - The widget objects and their :notify closures still exist in memory *only if*
;;   something references them (our registry does); otherwise they become unreachable.
;; - However, with the text gone, there is nothing clickable, so handlers are not invoked.
;; - To avoid stale registry entries, `jsf-inline-resync` drops entries whose stamped
;;   'jsf-form-id region no longer exists.
;;
;; If the user partially deletes / edits the region:
;; - The form remains tracked as long as some text in its region still has 'jsf-form-id = id.
;; - If the id stamp is entirely removed, resync will GC the form state automatically.

As promised and just for fun, I did try to implement it using vui.el. Here are results:

https://gist.github.com/d12frosted/51edb747167c0fa8fcce40fed3338ab2

P.S. it's fully AI generated, I didn't have time to really read the code, so can't guarantee that it's 100% correct. Implementation wise - it took around 5 mins for claude code to implement it plus a few mins more for comments from me. It was also uploaded by claude code 🤷