more opens

This commit is contained in:
David Botton 2024-05-09 14:51:59 -04:00
parent 0accada4b4
commit 798ad3a201
3 changed files with 62 additions and 21 deletions

View file

@ -180,6 +180,19 @@ BOOT-FILE will be used. If BOOT-FILE is nil path is removed."
"Turn on browser console debugging for OBJ's connection." "Turn on browser console debugging for OBJ's connection."
(clog-connection:debug-mode (connection-id obj))) (clog-connection:debug-mode (connection-id obj)))
;;;;;;;;;;;;;;;;;;;;;;;
;; open-file-with-os ;;
;;;;;;;;;;;;;;;;;;;;;;;
(defun open-file-with-os (path)
"Open PATH using OS"
#+windows
(uiop:launch-program (list "explorer.exe" (uiop:native-namestring path)))
#+linux
(uiop:launch-program (list "xdg-open" (uiop:native-namestring path)))
#+darwin
(uiop:launch-program (list "open" (uiop:native-namestring path))))
;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;
;; open-browser ;; ;; open-browser ;;
;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;
@ -187,7 +200,10 @@ BOOT-FILE will be used. If BOOT-FILE is nil path is removed."
(defun open-browser (&key (url (format nil "http://127.0.0.1:~A" *clog-port*))) (defun open-browser (&key (url (format nil "http://127.0.0.1:~A" *clog-port*)))
"Launch on os a web browser on local machine to URL. See OPEN-WINDOW "Launch on os a web browser on local machine to URL. See OPEN-WINDOW
for openning windows on remote machines." for openning windows on remote machines."
(handler-case #+windows
(trivial-open-browser:open-browser url) (uiop:launch-program (list "rundll32" "url.dll,FileProtocolHandler" url))
(error (c) #+linux
(format t "Unable to open browser.~%~%~A" c)))) (uiop:launch-program (list "xdg-open" url))
#+darwin
(uiop:launch-program (list "open" url)))

View file

@ -83,6 +83,7 @@ embedded in a native template application.)"
(is-running-p function) (is-running-p function)
(shutdown function) (shutdown function)
(debug-mode function) (debug-mode function)
(open-file-with-os function)
(open-browser function)) (open-browser function))
(defsection @clog-utilities (:title "CLOG Utilities") (defsection @clog-utilities (:title "CLOG Utilities")

View file

@ -1,28 +1,32 @@
(in-package :clog-tools) (in-package :clog-tools)
(defun project-tree-select (panel item) (defun project-tree-select (panel item &key method)
(unless (equal item "") (unless (equal item "")
(cond ((and (> (length item) 5) (cond ((and (> (length item) 5)
(equal (subseq item (- (length item) 5)) ".clog")) (equal (subseq item (- (length item) 5)) ".clog"))
(if *open-external* (if (or (eq method :tab)
(and (not (eq method :here)) *open-external*))
(on-new-builder-panel-ext panel :open-file item) ;; need ext for both (on-new-builder-panel-ext panel :open-file item) ;; need ext for both
(on-new-builder-panel panel :open-file item))) (on-new-builder-panel panel :open-file item)))
(t (t
(if *open-external* (if (eq method :emacs)
(on-open-file-ext panel :open-file item) (swank:ed-in-emacs item)
(progn (if (or (eq method :tab)
(let ((win (on-open-file panel :open-file item))) (and (not (eq method :here)) *open-external*))
(when *project-tree-sticky-open* (on-open-file-ext panel :open-file item)
(when win (progn
(set-geometry win (let ((win (on-open-file panel :open-file item)))
:top (menu-bar-height win) (when *project-tree-sticky-open*
:left 300 (when win
:height "" :width "" (set-geometry win
:bottom 5 :right 0) :top (menu-bar-height win)
(clog-ace:resize (window-param win)) :left 300
(set-on-window-move win (lambda (obj) :height "" :width ""
(setf (width obj) (width obj)) :bottom 5 :right 0)
(setf (height obj) (height obj))))))))))))) (clog-ace:resize (window-param win))
(set-on-window-move win (lambda (obj)
(setf (width obj) (width obj))
(setf (height obj) (height obj))))))))))))))
(defun on-project-tree (obj &key project) (defun on-project-tree (obj &key project)
(let ((app (connection-data-item obj "builder-app-data"))) (let ((app (connection-data-item obj "builder-app-data")))
@ -123,12 +127,32 @@
:class *builder-window-desktop-class*)) :class *builder-window-desktop-class*))
(title (create-div menu :content disp)) (title (create-div menu :content disp))
(op (create-div menu :content "Open" :class *builder-menu-context-item-class*)) (op (create-div menu :content "Open" :class *builder-menu-context-item-class*))
(oph (create-div menu :content "Open this tab" :class *builder-menu-context-item-class*))
(opt (create-div menu :content "Open new tab" :class *builder-menu-context-item-class*))
(ope (create-div menu :content "Open emacs" :class *builder-menu-context-item-class*))
(opo (create-div menu :content "Open OS default" :class *builder-menu-context-item-class*))
(del (create-div menu :content "Delete" :class *builder-menu-context-item-class*))) (del (create-div menu :content "Delete" :class *builder-menu-context-item-class*)))
(declare (ignore title op)) (declare (ignore title op))
(set-on-click menu (lambda (i) (set-on-click menu (lambda (i)
(declare (ignore i)) (declare (ignore i))
(project-tree-select obj (format nil "~A" item))) (project-tree-select obj (format nil "~A" item)))
:cancel-event t) :cancel-event t)
(set-on-click oph (lambda (i)
(declare (ignore i))
(project-tree-select obj (format nil "~A" item) :method :here))
:cancel-event t)
(set-on-click opt (lambda (i)
(declare (ignore i))
(project-tree-select obj (format nil "~A" item) :method :tab))
:cancel-event t)
(set-on-click ope (lambda (i)
(declare (ignore i))
(project-tree-select obj (format nil "~A" item) :method :emacs))
:cancel-event t)
(set-on-click opo (lambda (i)
(declare (ignore i))
(open-file-with-os item))
:cancel-event t)
(set-on-click del (lambda (i) (set-on-click del (lambda (i)
(confirm-dialog i (format nil "Delete ~A?" disp) (confirm-dialog i (format nil "Delete ~A?" disp)
(lambda (result) (lambda (result)