diff --git a/tools/clog-builder-ace.lisp b/tools/clog-builder-ace.lisp index e94c2d9..76bd783 100644 --- a/tools/clog-builder-ace.lisp +++ b/tools/clog-builder-ace.lisp @@ -85,7 +85,8 @@ (clog-ace::js-ace editor) (jquery editor))) ;; setup adjust tab key - (js-execute editor + (when (current-editor-is-lisp app) + (js-execute editor (format nil "~A.commands.addCommand({ name: 'adjust-tabs', @@ -119,7 +120,7 @@ (if *editor-use-tab-as-tabbify* "Ctrl-t|Tab" "Ctrl-t") - (jquery editor))) + (jquery editor)))) (set-on-event-with-data editor "clog-adjust-tabs" (lambda (obj data) (declare (ignore obj)) diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index 7551ffe..8575e86 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -15,7 +15,7 @@ (if clog-obj (alert-toast clog-obj "File Error" (format nil "Error: ~A" condition)) (format t "Error: ~A" condition)) - nil))) + nil))) (defun write-file (string outfile &key clog-obj (action-if-exists :rename)) "Write local file named OUTFILE" @@ -70,6 +70,7 @@ lisp-package regex show-find + force-mode is-console left top (editor-use-console-for-evals *editor-use-console-for-evals*) @@ -116,10 +117,10 @@ (m-saveas (create-gui-menu-item m-file :content "save as..")) (m-revert (create-gui-menu-item m-file :content "revert")) (m-emacs (unless (or (in-clog-popup-p obj) - is-console) + is-console) (create-gui-menu-item m-file :content "open in emacs"))) (m-ntab (unless (or (in-clog-popup-p obj) - is-console) + is-console) (create-gui-menu-item m-file :content "open in new tab"))) (m-edit (create-gui-menu-drop-down menu :content "Edit")) (m-undo (create-gui-menu-item m-edit :content "undo (cmd/ctrl-z)")) @@ -262,11 +263,6 @@ (clog-ace:resize ace) (set-geometry status :units "" :width "" :height "20px" :bottom "0px" :left "0px" :right "0px") - (setup-lisp-ace ace status) - (when is-console - (setf (clog-ace:mode ace) "ace/mode/plain_text") - (clog-ace:set-auto-completion ace nil) - (set-on-change ace nil)) (labels ((on-help (obj) (declare (ignore obj)) (alert-dialog win @@ -331,6 +327,14 @@ (not (equalp open-file " ")) (not (equalp open-file ""))) (open-file-name open-file)) + (when force-mode + (setf (clog-ace:mode ace) force-mode) + (setf (current-editor-is-lisp app) nil)) + (setup-lisp-ace ace status) + (when is-console + (setf (clog-ace:mode ace) "ace/mode/plain_text") + (clog-ace:set-auto-completion ace nil) + (set-on-change ace nil)) (when regex (focus ace) (js-execute obj (format nil "~A.find('~A',{caseSensitive:false,regExp:true})" @@ -343,260 +347,260 @@ (declare (ignore obj)) (set-is-dirty nil) (open-file-name file-name))) - (set-on-input ace (lambda (obj) - (declare (ignore obj)) - (set-is-dirty t))) - (set-on-event ace "clog-save-ace" - (lambda (obj) - (unless (equal file-name "") - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) file-name :clog-obj obj) - (set-is-dirty nil) - (setf last-date (file-write-date file-name)) - (sleep .5) - (remove-class btn-save "w3-animate-top")))) - (flet ((save (obj data &key save-as) - (cond ((or (equal file-name "") - (getf data :shift-key) - save-as) - (server-file-dialog obj "Save Source As.." (if (equal file-name "") - (current-project-dir app) - file-name) - (lambda (fname) - (window-focus win) - (when fname - (setf file-name fname) - (setf (window-title win) fname) - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) fname :clog-obj obj) - (set-is-dirty nil) - (setf last-date (file-write-date fname)) - (sleep .5) - (remove-class btn-save "w3-animate-top")) - :initial-filename file-name))) - (t - (cond ((or (not (probe-file file-name)) - (eql last-date (file-write-date file-name))) - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) file-name :clog-obj obj) - (set-is-dirty nil) - (setf last-date (file-write-date file-name)) - (sleep .5) - (remove-class btn-save "w3-animate-top")) - (t - (let ((*default-title-class* *builder-title-class*) - (*default-border-class* *builder-border-class*)) - (confirm-dialog obj "File changed on file system. Save?" - (lambda (result) - (when result - (add-class btn-save "w3-animate-top") - (write-file (text-value ace) file-name :clog-obj obj) - (set-is-dirty nil) - (setf last-date (file-write-date file-name)) - (sleep .5) - (remove-class btn-save "w3-animate-top"))))))))))) - (when m-emacs - (set-on-click m-emacs (lambda (obj) - (when is-dirty - (save obj nil)) - (swank:ed-in-emacs file-name) - (window-close win)))) - (when m-ntab - (set-on-click m-ntab (lambda (obj) - (when is-dirty - (save obj nil)) - (window-close win) - (on-open-file-ext obj :open-file file-name)))) - (set-on-window-can-close win - (lambda (obj) - (cond (is-dirty - (let ((*default-title-class* *builder-title-class*) - (*default-border-class* *builder-border-class*)) - (confirm-dialog obj "Save File?" - (lambda (result) - (set-is-dirty nil) - (when result - (save obj nil)) - (window-close win)) - :ok-text "Yes" :cancel-text "No")) - nil) - (t - t)))) - (set-on-mouse-click btn-save (lambda (obj data) - (save obj data))) - (set-on-click m-saveas (lambda (obj) - (save obj nil :save-as t))) - (set-on-click m-save (lambda (obj) - (save obj nil)))) - (labels ((buf-add () - (let ((val (clog-ace:selected-text ace))) - (unless (equal val "") - (place-inside-top-of (window-content (copy-history-win app)) - (create-text-area (window-content (copy-history-win app)) - :class "w3-input" - :value val - :auto-place nil))))) - (copy () - (buf-add) - (clog-ace:clipboard-copy ace)) - (cut () - (buf-add) - (clog-ace:clipboard-cut ace))) - (set-on-click btn-copy (lambda (obj) + (set-on-input ace (lambda (obj) + (declare (ignore obj)) + (set-is-dirty t))) + (set-on-event ace "clog-save-ace" + (lambda (obj) + (unless (equal file-name "") + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) file-name :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date file-name)) + (sleep .5) + (remove-class btn-save "w3-animate-top")))) + (flet ((save (obj data &key save-as) + (cond ((or (equal file-name "") + (getf data :shift-key) + save-as) + (server-file-dialog obj "Save Source As.." (if (equal file-name "") + (current-project-dir app) + file-name) + (lambda (fname) + (window-focus win) + (when fname + (setf file-name fname) + (setf (window-title win) fname) + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) fname :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date fname)) + (sleep .5) + (remove-class btn-save "w3-animate-top")) + :initial-filename file-name))) + (t + (cond ((or (not (probe-file file-name)) + (eql last-date (file-write-date file-name))) + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) file-name :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date file-name)) + (sleep .5) + (remove-class btn-save "w3-animate-top")) + (t + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) + (confirm-dialog obj "File changed on file system. Save?" + (lambda (result) + (when result + (add-class btn-save "w3-animate-top") + (write-file (text-value ace) file-name :clog-obj obj) + (set-is-dirty nil) + (setf last-date (file-write-date file-name)) + (sleep .5) + (remove-class btn-save "w3-animate-top"))))))))))) + (when m-emacs + (set-on-click m-emacs (lambda (obj) + (when is-dirty + (save obj nil)) + (swank:ed-in-emacs file-name) + (window-close win)))) + (when m-ntab + (set-on-click m-ntab (lambda (obj) + (when is-dirty + (save obj nil)) + (window-close win) + (on-open-file-ext obj :open-file file-name)))) + (set-on-window-can-close win + (lambda (obj) + (cond (is-dirty + (let ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*)) + (confirm-dialog obj "Save File?" + (lambda (result) + (set-is-dirty nil) + (when result + (save obj nil)) + (window-close win)) + :ok-text "Yes" :cancel-text "No")) + nil) + (t + t)))) + (set-on-mouse-click btn-save (lambda (obj data) + (save obj data))) + (set-on-click m-saveas (lambda (obj) + (save obj nil :save-as t))) + (set-on-click m-save (lambda (obj) + (save obj nil)))) + (labels ((buf-add () + (let ((val (clog-ace:selected-text ace))) + (unless (equal val "") + (place-inside-top-of (window-content (copy-history-win app)) + (create-text-area (window-content (copy-history-win app)) + :class "w3-input" + :value val + :auto-place nil))))) + (copy () + (buf-add) + (clog-ace:clipboard-copy ace)) + (cut () + (buf-add) + (clog-ace:clipboard-cut ace))) + (set-on-click btn-copy (lambda (obj) + (declare (ignore obj)) + (copy))) + (set-on-click m-copy (lambda (obj) (declare (ignore obj)) (copy))) - (set-on-click m-copy (lambda (obj) - (declare (ignore obj)) - (copy))) - (set-on-click btn-cut (lambda (obj) + (set-on-click btn-cut (lambda (obj) + (declare (ignore obj)) + (cut))) + (set-on-click m-cut (lambda (obj) (declare (ignore obj)) - (cut))) - (set-on-click m-cut (lambda (obj) - (declare (ignore obj)) - (cut)))) - (set-on-click btn-paste (lambda (obj) + (cut)))) + (set-on-click btn-paste (lambda (obj) + (declare (ignore obj)) + (clog-ace:clipboard-paste ace))) + (set-on-click m-paste (lambda (obj) (declare (ignore obj)) (clog-ace:clipboard-paste ace))) - (set-on-click m-paste (lambda (obj) - (declare (ignore obj)) - (clog-ace:clipboard-paste ace))) - (set-on-click btn-del (lambda (obj) + (set-on-click btn-del (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "del"))) + (set-on-click m-del (lambda (obj) (declare (ignore obj)) (clog-ace:execute-command ace "del"))) - (set-on-click m-del (lambda (obj) - (declare (ignore obj)) - (clog-ace:execute-command ace "del"))) - (set-on-click btn-undo (lambda (obj) + (set-on-click btn-undo (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "undo"))) + (set-on-click m-undo (lambda (obj) (declare (ignore obj)) (clog-ace:execute-command ace "undo"))) - (set-on-click m-undo (lambda (obj) - (declare (ignore obj)) - (clog-ace:execute-command ace "undo"))) - (set-on-click btn-redo (lambda (obj) + (set-on-click btn-redo (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "redo"))) + (set-on-click m-redo (lambda (obj) (declare (ignore obj)) (clog-ace:execute-command ace "redo"))) - (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-apro (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)) - (apropos (clog-ace:selected-text ace))) - (on-open-file obj :title-class "w3-purple" :title "apropos selection" - :text r))))) - (set-on-click m-brws (lambda (obj) - (declare (ignore obj)) - (on-new-sys-browser ace :search (clog-ace:selected-text ace)))) - (set-on-click btn-brws (lambda (obj) - (declare (ignore obj)) - (clog-ace:execute-command ace "find-definition"))) - (set-on-click m-brwsp (lambda (obj) - (declare (ignore obj)) - (clog-ace:execute-command ace "find-definition"))) - (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-pprt (lambda (obj) - (declare (ignore obj)) - (clog-ace:execute-command ace "adjust-tabs"))) - (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)) - (indentify:indentify n)))) - (setf (text-value ace) r) - (set-is-dirty t)))) - (set-on-click m-pprs (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 (clog-ace:selected-text ace)) + (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)) - (indentify:indentify n)))) - (js-execute ace (format nil "~A.insert('~A',true)" - (clog-ace::js-ace ace) - (escape-string r))) - (set-is-dirty t)))) - (set-on-click m-ppqs (lambda (obj) - (declare (ignore obj)) - (let ((r (clog-ace:selected-text ace))) - (setf r (ppcre:regex-replace-all "\"" r "\\\"")) - (js-execute ace (format nil "~A.insert('~A',true)" - (clog-ace::js-ace ace) - (escape-string r))) - (set-is-dirty t)))) - (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 ace) - (clog-ace::js-ace ace))) - :junk-allowed t)) - (tv (text-value ace)) - (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)))) - (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 ace))) - (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)))) - (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 ace))) - (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)))) - (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 btn-esel (lambda (obj) + (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-apro (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)) + (apropos (clog-ace:selected-text ace))) + (on-open-file obj :title-class "w3-purple" :title "apropos selection" + :text r))))) + (set-on-click m-brws (lambda (obj) + (declare (ignore obj)) + (on-new-sys-browser ace :search (clog-ace:selected-text ace)))) + (set-on-click btn-brws (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "find-definition"))) + (set-on-click m-brwsp (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "find-definition"))) + (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-pprt (lambda (obj) + (declare (ignore obj)) + (clog-ace:execute-command ace "adjust-tabs"))) + (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)) + (indentify:indentify n)))) + (setf (text-value ace) r) + (set-is-dirty t)))) + (set-on-click m-pprs (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 (clog-ace:selected-text ace)) + (let ((*standard-output* s)) + (indentify:indentify n)))) + (js-execute ace (format nil "~A.insert('~A',true)" + (clog-ace::js-ace ace) + (escape-string r))) + (set-is-dirty t)))) + (set-on-click m-ppqs (lambda (obj) + (declare (ignore obj)) + (let ((r (clog-ace:selected-text ace))) + (setf r (ppcre:regex-replace-all "\"" r "\\\"")) + (js-execute ace (format nil "~A.insert('~A',true)" + (clog-ace::js-ace ace) + (escape-string r))) + (set-is-dirty t)))) + (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 ace) + (clog-ace::js-ace ace))) + :junk-allowed t)) + (tv (text-value ace)) + (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)))) + (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 ace))) + (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)))) + (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 ace))) + (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)))) + (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 btn-esel (lambda (obj) + (eval-selection obj))) + (set-on-click m-esel (lambda (obj) (eval-selection obj))) - (set-on-click m-esel (lambda (obj) - (eval-selection obj))) - (set-on-click btn-efrm (lambda (obj) + (set-on-click btn-efrm (lambda (obj) + (eval-form obj))) + (set-on-click m-efrm (lambda (obj) (eval-form obj))) - (set-on-click m-efrm (lambda (obj) - (eval-form obj))) - (set-on-click btn-test (lambda (obj) - (eval-file obj))) - (set-on-click m-test (lambda (obj) - (eval-file obj)))) - win))))) + (set-on-click btn-test (lambda (obj) + (eval-file obj))) + (set-on-click m-test (lambda (obj) + (eval-file obj)))) + win))))) diff --git a/tools/clog-builder-panels.lisp b/tools/clog-builder-panels.lisp index 244dbf5..c8d35c8 100644 --- a/tools/clog-builder-panels.lisp +++ b/tools/clog-builder-panels.lisp @@ -1023,9 +1023,9 @@ not a temporarily attached one when using select-control." (get-control-list app panel-id)) result))) (set-on-click m-html (lambda (obj) - (on-open-file obj :text (render-html)))) + (on-open-file obj :force-mode "ace/mode/html" :text (render-html)))) (set-on-click m-htmlq (lambda (obj) - (on-open-file obj :text + (on-open-file obj :force-mode "ace/mode/html" :text (ppcre:regex-replace-all "\"" (render-html) "\\\"")))))