(in-package :clog-tools)

(defun on-new-sys-browser (obj &key (search nil))
  (let* ((win (create-gui-window obj :title "System Browser"
                                     :top 40 :left 225
                                     :width 685 :height 530
                                     :client-movement t))
         (panel (create-sys-browser (window-content win))))
    (when search
      (setf (text-value (search-box panel)) search)
      (sys-browser-populate panel))
    (set-on-window-size-done win (lambda (obj)
                                   (declare (ignore obj))
                                   (clog-ace:resize (src-box panel))))))

(defun sys-browser-populate (panel)
  (setf (inner-html (class-box panel)) "")
  (setf (text-value (src-box panel)) "")
  (setf (text-value (doc-box panel)) "")
  (setf (text-value (file-name panel)) "")
  (setf (fname panel) nil)
  (let* ((filter     (text-value (search-box panel)))
         (has-pac    (position #\: filter :test #'equal))
         (class-only (checkedp (class-only panel)))
         (pac        (text-value (package-box panel))))
    (when has-pac
      (setf pac (string-upcase (subseq filter 0 has-pac)))
      (setf (text-value (package-box panel)) pac)
      (unless (equalp (text-value (package-box panel)) pac)
        (setf (text-value (package-box panel)) "All")
        (setf pac "All"))
      (setf filter (subseq filter (+ has-pac 1)))
      (setf (text-value (search-box panel)) filter))
    (cond ((equalp pac "All")
           (setf class-only nil)
           (setf (classes panel) nil)
           (unless (equal filter "")
             (setf (classes panel) (definitions:apropos-definitions
                                    filter
                                    :type (find-symbol
                                           (text-value (type-box panel))
                                           (find-package :definitions))))))
          (t
           (setf (classes panel) (definitions:find-definitions
                                  (text-value (package-box panel))
                                  :package (find-package :key)
                                  :type (find-symbol
                                         (text-value (type-box panel))
                                         (find-package :definitions))))))
    (let ((i 0))
      (dolist (c (classes panel))
        (let ((name (format nil "~A" (definitions:designator c))))
          (if (or (equal filter "")
                  (search filter name :test #'char-equal))
              (if class-only
                  (if (equalp (package-name (definitions:package c))
                              pac)
                      (add-select-option (class-box panel) i
                                         (format nil "~A - ~A"
                                                 name
                                                 (definitions:type c))))
                  (add-select-option (class-box panel) i
                                     (format nil "~A:~A - ~A"
                                             (package-name (definitions:package c))
                                             name
                                             (definitions:type c)))))
          (incf i))))))

(defun sys-browser-select (panel target)
  (let* ((item (nth (parse-integer (text-value (class-box panel))) (classes panel))))
    (setf (fname panel) (getf (definitions:source-location item) :file))
    (setf (text-value (doc-box panel))
          (or (definitions:documentation item)
              "No documentation"))
    (cond ((fname panel)
           (let ((c (read-file (fname panel))))
             (setf (text-value (src-box panel)) c)
             (setf (text-value (pac-box panel)) (get-package-from-string c)))
           (setf (text-value (file-name panel)) (fname panel))
           (setf (disabledp (eval-button panel)) nil)
           (setf (disabledp (eval-sel-button panel)) nil)
           (setf (disabledp (eval-form-button panel)) nil)
           (setf (state panel) nil)
           (let* ((type (type-of item))
                  (name (format nil "~A" (definitions:designator item))))
             (setf name (ppcre:regex-replace-all "\\\\" name "\\x5C\\x5C"))
             (setf name (ppcre:regex-replace-all "\\\(" name "\\x5C("))
             (setf name (ppcre:regex-replace-all "\\\)" name "\\x5C)"))
             (setf name (ppcre:regex-replace-all "\\\*" name "\\x5C*"))
             (js-execute target (format nil "~A.find('~A',{caseSensitive:false,regExp:true})"
                                        (clog-ace::js-ace (src-box panel))
                                        (cond ((eq type 'definitions:generic-function)
                                               (format nil "defgeneric\\\\s+~A" name))
                                              ((eq type 'definitions:method)
                                               (format nil "defmethod\\\\s+~A" name))
                                              ((eq type 'definitions:function)
                                               (format nil "defun\\\\s+~A" name))
                                              ((eq type 'definitions:macro)
                                               (format nil "defmacro\\\\s+~A" name))
                                              ((eq type 'definitions:class)
                                               (format nil "defclass\\\\s+~A" name))
                                              ((eq type 'definitions:compiler-macro)
                                               (format nil "define-compiler-macro\\\\s+~A" name))
                                              ((eq type 'definitions:condition)
                                               (format nil "define-condition\\\\s+~A" name))
                                              ((eq type 'definitions:alien-type)
                                               (format nil "define-alien-type ~A" name))
                                              ((eq type 'definitions:constant)
                                               (format nil "defconstant\\\\s+~A" name))
                                              ((eq type 'definitions:package)
                                               (format nil "defpackage\\\\s+~A" name))
                                              ((eq type 'definitions:special-variable)
                                               (format nil "(defsection|defparameter|defvar)\\\\s+~A" name))
                                              ((eq type 'definitions:vop)
                                               (format nil "define-type-vop\\\\s+~A" name))
                                              ((eq type 'definitions:structure)
                                               (format nil "defstruct\\\\s*\\\\(\\\\s*~A" name))
                                              ((eq type 'definitions:setf-expander)
                                               (format nil "(defsetf|def)\\\\s+~A" name))
                                              ((eq type 'definitions:optimizer)
                                               (format nil "defoptimizer\\\\s*\\\\(\\\\s*~A" name))
                                              ((eq type 'definitions:ir1-convert)
                                               (format nil "def-ir1-translator\\\\s+~A" name))
                                              (t
                                               name))))))
          (t
           (setf (text-value (file-name panel)) "")
           (setf (disabledp (eval-button panel)) t)
           (setf (disabledp (eval-sel-button panel)) t)
           (setf (disabledp (eval-form-button panel)) t)
           (setf (disabledp (save-button panel)) t)
           (setf (state panel) t)
           (setf (text-value (src-box panel)) "No file information")))))