add describe and documentation

This commit is contained in:
David Botton 2024-03-25 00:00:17 -04:00
parent 3f6812cdff
commit 57798e083d
3 changed files with 40 additions and 8 deletions

View file

@ -71,11 +71,14 @@
(m-cut (create-gui-menu-item m-edit :content "cut"))
(m-del (create-gui-menu-item m-edit :content "delete"))
(m-lisp (create-gui-menu-drop-down menu :content "Lisp"))
(m-efrm (create-gui-menu-item m-lisp :content "Evaluate Form"))
(m-esel (create-gui-menu-item m-lisp :content "Evaluate Selection"))
(m-test (create-gui-menu-item m-lisp :content "Evaluate All"))
(m-efrm (create-gui-menu-item m-lisp :content "evaluate form"))
(m-esel (create-gui-menu-item m-lisp :content "evaluate selection"))
(m-test (create-gui-menu-item m-lisp :content "evaluate all"))
(m-desc (create-gui-menu-item m-lisp :content "describe selection"))
(m-doc (create-gui-menu-item m-lisp :content "documentation on selection"))
(m-ppr (create-gui-menu-item m-lisp :content "pretty print"))
(m-help (create-gui-menu-drop-down menu :content "Help"))
(m-helpk (create-gui-menu-item m-help :content "Keyboard Help"))
(m-helpk (create-gui-menu-item m-help :content "keyboard help"))
(tool-bar (create-div (top-panel box)))
(btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
(btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
@ -218,7 +221,9 @@
(setf last-date (file-write-date file-name))
(sleep .5)
(remove-class btn-save "w3-animate-top"))))
(set-on-click m-emacs (lambda (obj) (swank:ed-in-emacs file-name)))
(set-on-click m-emacs (lambda (obj)
(declare (ignore obj))
(swank:ed-in-emacs file-name)))
(flet ((save (obj data &key save-as)
(cond ((or (equal file-name "")
(getf data :shift-key)
@ -324,6 +329,33 @@
(set-on-click m-redo (lambda (obj)
(declare (ignore obj))
(clog-ace:execute-command ace "redo")))
(set-on-click m-desc (lambda (obj)
(let ((r (make-array '(0) :element-type 'base-char
:fill-pointer 0 :adjustable t)))
(with-output-to-string (s r)
(let ((*standard-output* s))
(describe (find-symbol (string-upcase (clog-ace:selected-text ace))
(string-upcase (text-value pac-line)))))
(on-open-file obj :title-class "w3-purple" :title "describe selection"
:text r)))))
(set-on-click m-doc (lambda (obj)
(open-window (window (connection-body obj))
(format nil "http://l1sp.org/search?q=~A"
(clog-ace:selected-text ace)))))
(set-on-click m-ppr (lambda (obj)
(declare (ignore obj))
(let ((r (make-array '(0) :element-type 'base-char
:fill-pointer 0 :adjustable t)))
(with-output-to-string (s r)
(with-input-from-string (n (text-value ace))
(let ((*standard-output* s)
(*print-case* :downcase))
(loop
(let ((l (read n nil)))
(unless l (return))
(pprint l))))))
(setf (text-value ace) r)
(setf is-dirty t))))
(labels ((eval-form (obj)
(let ((p (parse-integer
(js-query obj

View file

@ -3,7 +3,7 @@
;; Code rendering utlities
(defun render-clog-code (content hide-loc)
"Render panel to clog code and add tp CW window"
"Render panel to clog code and add to window"
(let* ((app (connection-data-item content "builder-app-data"))
(panel-id (html-id content))
(package (attribute content "data-in-package"))

View file

@ -434,7 +434,7 @@ clog-builder window.")
(open-panel
(if (equal open-panel " ")
(setf open-panel nil)
(setf (title (html-document body)) open-panel))
(setf (title (html-document body)) (file-namestring open-panel)))
(cond ((equalp open-ext "t")
(setf open-ext t))
((equalp open-ext "custom")
@ -443,7 +443,7 @@ clog-builder window.")
(open-file
(if (equal open-file " ")
(setf open-file nil)
(setf (title (html-document body)) open-file))
(setf (title (html-document body)) (file-namestring open-file)))
(on-open-file body :open-file open-file :maximized t))
(*start-dir*
(on-dir-win body :dir *start-dir* :top 60 :left 232))