mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
135 lines
7.9 KiB
Common Lisp
135 lines
7.9 KiB
Common Lisp
(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)
|
|
(ignore-errors ; ignore invalid searches
|
|
(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)
|
|
(ignore-errors
|
|
(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"))))))
|