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