(require :ltk)
(in-package :ltk-user)
(defun show-symbols (package-designator)
  (with-ltk ()
    (let* ((package (find-package package-designator))
           (symbols nil)
           (rows nil)
           (top (make-instance 'frame))
           (tree (make-instance 'treeview
                                :master top
                                :columns "{1 2 3 4}"
                                ))
           (sc (make-instance 'scrollbar :master top))
           ;; font-width should be calculated...
           (font-width 10))

      (macrolet
          ((sort-col (accessor up down)
             `(let ((up t))
                (lambda ()
                  (dolist (item (setf rows
                                      (stable-sort rows
                                                   (if up ,up ,down)
                                                   :key ,accessor)))
                    (treeview-move tree (car item)))
                  (setf up (not up))))))
        (treeview-heading tree :#0
                          :text "name"
                          :command (sort-col #'first #'string< #'string>))
        (treeview-heading tree 1
                          :text "attrs"
                          :command (sort-col #'second #'string< #'string>))
        (treeview-column tree 1 :width (* 5 font-width))
        
        (treeview-heading tree 2
                          :text "#plist"
                          :command (sort-col #'third #'< #'>))
        (treeview-column tree 2 :width (* 5 font-width))
        
        (treeview-heading tree 3
                          :text "status"
                          :command (sort-col #'fourth #'string< #'string>))
        (treeview-column tree 3 :width (* 9 font-width))
      
        (treeview-heading tree 4
                          :text "package"
                          :command (sort-col #'fifth #'string< #'string>)))
      
      (configure tree "yscrollcommand" (format nil "~A set" (widget-path sc)))
      (configure sc "command" (format nil "~A yview" (widget-path tree)))
      (pack top :side :left :fill :both :expand t)
      (pack tree :side :left :fill :both :expand t)
      (pack sc :side :left :fill :y :expand nil)

      ;; guard against do-sybmols processing the same symbol multiple times (allowed behavior)
      (do-symbols (symbol package)
        (pushnew symbol symbols :test #'eq))
      (dolist (symbol (reverse symbols))
        (let* ((name (symbol-name symbol))
               (pack (symbol-package symbol))
               (pname (package-name pack))
               (values (list (concatenate
                              'string
                              (when (boundp symbol)
                                (if (constantp symbol)
                                    "c"
                                    "b"))
                              (when (fboundp symbol)
                                (let ((mods (concatenate
                                             'string
                                             (when (macro-function symbol) "m")
                                             (when (special-operator-p symbol) "o"))))
                                  (if (string= mods "")
                                      "f"
                                      mods)))
                              (when (keywordp symbol) "k")
                              ;; this one is problematic
                              ;;(when (compiler-macro-function name) "M")
                              )
               (length (symbol-plist symbol))
               ;; status
               (second (multiple-value-list (find-symbol name package)))
               pname)))
          (push (cons name values) rows)
          (treeview-insert tree
                           :id name
                           :text name
                           :values values))))))