#!/usr/bin/sbcl --script (load "/home/edwlan/.sbclrc") (ql:quickload :qt) (defpackage jsonview (:use #:cl #:cl-user #:qt)) (in-package jsonview) (named-readtables:in-readtable :qt) (defclass json-view-app () ((json-view :accessor json-view) (json-model :accessor json-model) (json-data :accessor json-data)) (:metaclass qt-class) (:qt-superclass "QWidget")) (defmethod initialize-instance :after ((instance json-view-app) &key) (new instance)) (defun prepare-row (&rest keys) (let ((keys (loop for k in keys collect (if (null k) "NULL" k)))) (loop for k in keys collect (#_new QStandardItem (format nil "~a" k))))) (defun rows-from-alist (alist) (loop for (key . value) in alist collect (prepare-row (format nil "~a" key) (format nil "~a" value)))) (defun mktree-helper (key value root n) (let ((row (if (listp key) (prepare-row (car key) (cdr key)) (prepare-row key))) (root (if (listp key) (let ((nrow (prepare-row (format nil "List Item ~a" n)))) (#_appendRow root nrow) (car nrow)) root))) (#_appendRow root row) (if (listp key) (mktree root value) (mktree (car row) value)))) (defun mktree (root alist) (let ((counter 0)) (loop for item in alist collect (if (listp item) (destructuring-bind (key . value) item (cond ((listp value) (mktree-helper key value root (incf counter))) (t (#_appendRow root (prepare-row key value))))) (#_appendRow root (prepare-row item)))))) (defun add-rows (root rows) (loop for row in rows do (#_appendRow root row))) (defmethod init-ui ((instance json-view-app )) (#_setWindowTitle instance "JSON viewer") (setf (json-view instance) (#_new QTreeView instance) (json-model instance) (#_new QStandardItemModel instance)) (#_setWordWrap (json-view instance) t) (let* ((root (#_invisibleRootItem (json-model instance)))) (mktree root (json-data instance))) (#_setColumnCount (json-model instance) 2) (#_setModel (json-view instance) (json-model instance)) (#_expandAll (json-view instance)) (#_resizeColumnToContents (json-view instance) 0) (let ((grid (#_new QVBoxLayout instance)) (grid1 (#_new QHBoxLayout instance)) (quit-button (#_new QPushButton "&Quit!" instance))) (#_addWidget grid (json-view instance)) (#_addWidget grid1 (#_new QPushButton)) (#_addWidget grid1 (#_new QPushButton)) (#_addWidget grid1 quit-button) (#_addLayout grid grid1) (#_setLayout instance grid) (connect quit-button "clicked()" *qapplication* "quit()") )) (make-qapplication) (ql:quickload :cl-json) (ql:quickload :s-http-client) (let ((app (make-instance 'json-view-app)) (r_json (json:decode-json *standard-input*))) (setf (json-data app) r_json) (init-ui app) (with-main-window (window app)))