clog/tools/clog-builder-search.lisp

(in-package :clog-tools)

(defun on-file-search (obj &key dir search doc-maximize)
  "Open file search"
  (let* ((app (connection-data-item obj "builder-app-data"))
         (*default-title-class*      *builder-title-class*)
         (*default-border-class*     *builder-border-class*)
         (lisp-file t)
         (win (create-gui-window obj :top (+ (menu-bar-height obj) 20)
                                 :left 20
                                 :width 1040 :height 600
                                 :client-movement *client-side-movement*))
         (panel (create-panel-search (window-content win))))
    (set-on-click (create-span (window-icon-area win)
                               :content "- "
                               :auto-place :top)
                  (lambda (obj)
                    (declare (ignore obj))
                    (setf (hiddenp win) t)))
    (set-on-window-size win (lambda (obj)
                              (declare (ignore obj))
                              (clog-ace:resize (preview-ace panel))))
    (setf (place-holder (pac-line panel)) "Current Package")
    (setf (current-editor-is-lisp app) "clog-user")
    (setf (text-value (pac-line panel)) "clog-user")
    (setup-lisp-ace (preview-ace panel) (status-bar panel))
    (setf (text-value (preview-ace panel))
          ";; After search, double click file name to open / single click to preview")
    (set-on-window-focus win
                         (lambda (obj)
                           (declare (ignore obj))
                           (if lisp-file
                               (setf (current-editor-is-lisp app) (text-value (pac-line panel)))
                               (setf (current-editor-is-lisp app) nil))))
    (set-on-input (result-box panel) (lambda (obj)
                                       (let* ((fname (text-value obj))
                                              (regex   (text-value (grep-input panel)))
                                              (c     (read-file fname :report-errors nil)))
                                         (cond ((or (equalp (pathname-type fname) "lisp")
                                                    (equalp (pathname-type fname) "asd"))
                                                 (setf (text-value (pac-line panel)) (get-package-from-string c))
                                                 (setf (current-editor-is-lisp app) (text-value (pac-line panel)))
                                                 (setf lisp-file t)
                                                 (setf (clog-ace:mode (preview-ace panel)) "ace/mode/lisp"))
                                               (t
                                                 (setf lisp-file nil)
                                                 (setf (current-editor-is-lisp app) nil)
                                                 (if (equalp (pathname-type fname) "clog")
                                                     (setf (clog-ace:mode (preview-ace panel)) "ace/mode/html")
                                                     (setf (clog-ace:mode (preview-ace panel))
                                                           (clog-ace:get-mode-from-extension (preview-ace panel) fname)))))
                                         (setf (text-value (preview-ace panel)) c)
                                         (clog-ace:resize (preview-ace panel))
                                         (js-execute obj (format nil "~A.find({regExp:true,needle:'~A',caseSensitive:false})"
                                                                 (clog-ace::js-ace (preview-ace panel)) (escape-string regex)))
                                         (clog-ace:execute-command (preview-ace panel) "find"))
                                       (focus (result-box panel))))
    (flet ((save (obj)
             (let ((fname (text-value (result-box panel))))
               (when (not (equalp fname ""))
                 (write-file (text-value (preview-ace panel)) fname)
                 (alert-toast obj "Save file..." (format nil "Saved ~A" fname) :color-class "w3-green" :time-out 1)))))
      (set-on-click (save-btn panel) #'save)
      (set-on-event  (preview-ace panel) "clog-save-ace" #'save))
    (labels ((eval-form (obj)
               (let ((p  (parse-integer
                           (js-query obj
                                     (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);"
                                             (clog-ace::js-ace (preview-ace panel))
                                             (clog-ace::js-ace (preview-ace panel))))
                           :junk-allowed t))
                     (tv (text-value (preview-ace panel)))
                     (lf nil)
                     (cp 0))
                 (loop
                   (setf (values lf cp) (read-from-string tv nil nil :start cp))
                   (unless lf (return nil))
                   (when (> cp p) (return lf)))
                 (when lf
                   (let ((result (capture-eval lf
                                               :capture-console (not *editor-use-console-for-evals*)
                                               :capture-result  (not *editor-use-console-for-evals*)
                                               :clog-obj (connection-body obj)
                                               :eval-in-package (text-value (pac-line panel)))))
                     (if *editor-use-console-for-evals*
                         (on-open-console obj)
                         (on-open-file obj :title-class "w3-blue" :title "form eval"
                                       :has-time-out *editor-delay-on-eval-form* :text result))))))
             (eval-selection (obj)
               (let ((val (clog-ace:selected-text (pac-line panel))))
                 (unless (equal val "")
                   (let ((result (capture-eval val :clog-obj obj
                                               :capture-console (not *editor-use-console-for-evals*)
                                               :capture-result  (not *editor-use-console-for-evals*)
                                               :eval-in-package (text-value (pac-line panel)))))
                     (if *editor-use-console-for-evals*
                         (on-open-console obj)
                         (on-open-file obj :title-class "w3-blue" :title "selection eval"
                                       :has-time-out *editor-delay-on-eval-sel* :text result))))))
             (eval-file (obj)
               (let ((val (text-value (pac-line panel))))
                 (unless (equal val "")
                   (let ((result (capture-eval val :clog-obj obj
                                               :capture-console (not *editor-use-console-for-evals*)
                                               :capture-result  (not *editor-use-console-for-evals*)
                                               :eval-in-package (text-value (pac-line panel)))))
                     (if *editor-use-console-for-evals*
                         (on-open-console obj)
                         (on-open-file obj :title-class "w3-blue" :title "file eval"
                                       :has-time-out *editor-delay-on-eval-file* :text result)))))))
      (set-on-click (eval-sel-btn panel) (lambda (obj)
                                           (eval-selection obj)))
      (set-on-click (eval-form-btn panel) (lambda (obj)
                                            (eval-form obj)))
      (set-on-click (eval-all-btn panel) (lambda (obj)
                                           (eval-file obj))))
    (unless dir
      (setf dir (if (and (current-project-dir app)
                     (not (equal (current-project-dir app) "")))
                    (current-project-dir app)
                    (uiop:getcwd))))
    (setf (text-value (dir-input panel)) dir)
    (panel-search-dir-change panel (dir-input panel))
    (when doc-maximize
      (window-maximize win))
    (when search
      (setf (text-value (grep-input panel)) search)
      (panel-search-on-click panel nil))))

(defun panel-search-dir-change (panel target)
  (setf (window-title (parent (parent panel)))
        (format nil "Search Project Dir ~A" (text-value target))))

(defun panel-search-on-click (panel target)
  (declare (ignore target))
  (destroy-children (result-box panel))
  (let* ((subdirs (checkedp (subdir-check panel)))
         (nregex  (text-value (name-regex-input panel)))
         (sn      (ppcre:create-scanner nregex :case-insensitive-mode t))
         (regex   (text-value (grep-input panel)))
         (s       (ppcre:create-scanner regex :case-insensitive-mode t)))
    (labels ((do-search (dir prefix)
               (dolist (item (uiop:directory-files dir))
                 (let ((fname (format nil "~A" item)))
                   (when (ppcre:scan sn fname)
                     (let ((c (read-file fname :report-errors nil)))
                       (when (and c
                                  (ppcre:scan s c))
                         (let ((li (create-option (result-box panel)
                                                  :content (format nil "~A~A" prefix (file-namestring item))
                                                  :value fname)))
                           (set-on-double-click li (lambda (obj)
                                                     (declare (ignore obj))
                                                     (on-open-file panel :open-file fname
                                                                   :show-find t
                                                                   :regex regex)))))))))
               (when subdirs
                 (dolist (item (uiop:subdirectories dir))
                   (do-search item (format nil "~A~A/" prefix (first (last (pathname-directory item)))))))))
      (do-search (text-value (dir-input panel)) ""))))