new file mode 100755

@@ -0,0 +1,100 @@

+#!/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)))