mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 10:40:45 -08:00
Code Issues Projects Releases Wiki Activity

normalize tabs when not lisp

Browse source
This commit is contained in:
David Botton 2024-07-04 18:59:01 -04:00
parent 4523916e74
commit f110cdf1e4
3 changed files with 260 additions and 255 deletions
Download patch file Download diff file Expand all files Collapse all files

5
tools/clog-builder-ace.lisp
View file

@ -85,7 +85,8 @@
(clog-ace::js-ace editor) (clog-ace::js-ace editor)
(jquery editor))) (jquery editor)))
;; setup adjust tab key ;; setup adjust tab key
(js-execute editor (when (current-editor-is-lisp app)
(js-execute editor
(format nil (format nil
"~A.commands.addCommand({ "~A.commands.addCommand({
name: 'adjust-tabs', name: 'adjust-tabs',
@ -119,7 +120,7 @@
(if *editor-use-tab-as-tabbify* (if *editor-use-tab-as-tabbify*
"Ctrl-t|Tab" "Ctrl-t|Tab"
"Ctrl-t") "Ctrl-t")
(jquery editor))) (jquery editor))))
(set-on-event-with-data editor "clog-adjust-tabs" (set-on-event-with-data editor "clog-adjust-tabs"
(lambda (obj data) (lambda (obj data)
(declare (ignore obj)) (declare (ignore obj))

506
tools/clog-builder-files.lisp
View file

@ -15,7 +15,7 @@
(if clog-obj (if clog-obj
(alert-toast clog-obj "File Error" (format nil "Error: ~A" condition)) (alert-toast clog-obj "File Error" (format nil "Error: ~A" condition))
(format t "Error: ~A" condition)) (format t "Error: ~A" condition))
nil))) nil)))
(defun write-file (string outfile &key clog-obj (action-if-exists :rename)) (defun write-file (string outfile &key clog-obj (action-if-exists :rename))
"Write local file named OUTFILE" "Write local file named OUTFILE"
@ -70,6 +70,7 @@
lisp-package lisp-package
regex regex
show-find show-find
force-mode
is-console is-console
left top left top
(editor-use-console-for-evals *editor-use-console-for-evals*) (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-saveas (create-gui-menu-item m-file :content "save as.."))
(m-revert (create-gui-menu-item m-file :content "revert")) (m-revert (create-gui-menu-item m-file :content "revert"))
(m-emacs (unless (or (in-clog-popup-p obj) (m-emacs (unless (or (in-clog-popup-p obj)
is-console) is-console)
(create-gui-menu-item m-file :content "open in emacs"))) (create-gui-menu-item m-file :content "open in emacs")))
(m-ntab (unless (or (in-clog-popup-p obj) (m-ntab (unless (or (in-clog-popup-p obj)
is-console) is-console)
(create-gui-menu-item m-file :content "open in new tab"))) (create-gui-menu-item m-file :content "open in new tab")))
(m-edit (create-gui-menu-drop-down menu :content "Edit")) (m-edit (create-gui-menu-drop-down menu :content "Edit"))
(m-undo (create-gui-menu-item m-edit :content "undo (cmd/ctrl-z)")) (m-undo (create-gui-menu-item m-edit :content "undo (cmd/ctrl-z)"))
@ -262,11 +263,6 @@
(clog-ace:resize ace) (clog-ace:resize ace)
(set-geometry status :units "" :width "" :height "20px" (set-geometry status :units "" :width "" :height "20px"
:bottom "0px" :left "0px" :right "0px") :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) (labels ((on-help (obj)
(declare (ignore obj)) (declare (ignore obj))
(alert-dialog win (alert-dialog win
@ -331,6 +327,14 @@
(not (equalp open-file " ")) (not (equalp open-file " "))
(not (equalp open-file ""))) (not (equalp open-file "")))
(open-file-name 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 (when regex
(focus ace) (focus ace)
(js-execute obj (format nil "~A.find('~A',{caseSensitive:false,regExp:true})" (js-execute obj (format nil "~A.find('~A',{caseSensitive:false,regExp:true})"
@ -343,260 +347,260 @@
(declare (ignore obj)) (declare (ignore obj))
(set-is-dirty nil) (set-is-dirty nil)
(open-file-name file-name))) (open-file-name file-name)))
(set-on-input ace (lambda (obj) (set-on-input ace (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(set-is-dirty t))) (set-is-dirty t)))
(set-on-event ace "clog-save-ace" (set-on-event ace "clog-save-ace"
(lambda (obj) (lambda (obj)
(unless (equal file-name "") (unless (equal file-name "")
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name :clog-obj obj) (write-file (text-value ace) file-name :clog-obj obj)
(set-is-dirty nil) (set-is-dirty nil)
(setf last-date (file-write-date file-name)) (setf last-date (file-write-date file-name))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")))) (remove-class btn-save "w3-animate-top"))))
(flet ((save (obj data &key save-as) (flet ((save (obj data &key save-as)
(cond ((or (equal file-name "") (cond ((or (equal file-name "")
(getf data :shift-key) (getf data :shift-key)
save-as) save-as)
(server-file-dialog obj "Save Source As.." (if (equal file-name "") (server-file-dialog obj "Save Source As.." (if (equal file-name "")
(current-project-dir app) (current-project-dir app)
file-name) file-name)
(lambda (fname) (lambda (fname)
(window-focus win) (window-focus win)
(when fname (when fname
(setf file-name fname) (setf file-name fname)
(setf (window-title win) fname) (setf (window-title win) fname)
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) fname :clog-obj obj) (write-file (text-value ace) fname :clog-obj obj)
(set-is-dirty nil) (set-is-dirty nil)
(setf last-date (file-write-date fname)) (setf last-date (file-write-date fname))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")) (remove-class btn-save "w3-animate-top"))
:initial-filename file-name))) :initial-filename file-name)))
(t (t
(cond ((or (not (probe-file file-name)) (cond ((or (not (probe-file file-name))
(eql last-date (file-write-date file-name))) (eql last-date (file-write-date file-name)))
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name :clog-obj obj) (write-file (text-value ace) file-name :clog-obj obj)
(set-is-dirty nil) (set-is-dirty nil)
(setf last-date (file-write-date file-name)) (setf last-date (file-write-date file-name))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top")) (remove-class btn-save "w3-animate-top"))
(t (t
(let ((*default-title-class* *builder-title-class*) (let ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*)) (*default-border-class* *builder-border-class*))
(confirm-dialog obj "File changed on file system. Save?" (confirm-dialog obj "File changed on file system. Save?"
(lambda (result) (lambda (result)
(when result (when result
(add-class btn-save "w3-animate-top") (add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name :clog-obj obj) (write-file (text-value ace) file-name :clog-obj obj)
(set-is-dirty nil) (set-is-dirty nil)
(setf last-date (file-write-date file-name)) (setf last-date (file-write-date file-name))
(sleep .5) (sleep .5)
(remove-class btn-save "w3-animate-top"))))))))))) (remove-class btn-save "w3-animate-top")))))))))))
(when m-emacs (when m-emacs
(set-on-click m-emacs (lambda (obj) (set-on-click m-emacs (lambda (obj)
(when is-dirty (when is-dirty
(save obj nil)) (save obj nil))
(swank:ed-in-emacs file-name) (swank:ed-in-emacs file-name)
(window-close win)))) (window-close win))))
(when m-ntab (when m-ntab
(set-on-click m-ntab (lambda (obj) (set-on-click m-ntab (lambda (obj)
(when is-dirty (when is-dirty
(save obj nil)) (save obj nil))
(window-close win) (window-close win)
(on-open-file-ext obj :open-file file-name)))) (on-open-file-ext obj :open-file file-name))))
(set-on-window-can-close win (set-on-window-can-close win
(lambda (obj) (lambda (obj)
(cond (is-dirty (cond (is-dirty
(let ((*default-title-class* *builder-title-class*) (let ((*default-title-class* *builder-title-class*)
(*default-border-class* *builder-border-class*)) (*default-border-class* *builder-border-class*))
(confirm-dialog obj "Save File?" (confirm-dialog obj "Save File?"
(lambda (result) (lambda (result)
(set-is-dirty nil) (set-is-dirty nil)
(when result (when result
(save obj nil)) (save obj nil))
(window-close win)) (window-close win))
:ok-text "Yes" :cancel-text "No")) :ok-text "Yes" :cancel-text "No"))
nil) nil)
(t (t
t)))) t))))
(set-on-mouse-click btn-save (lambda (obj data) (set-on-mouse-click btn-save (lambda (obj data)
(save obj data))) (save obj data)))
(set-on-click m-saveas (lambda (obj) (set-on-click m-saveas (lambda (obj)
(save obj nil :save-as t))) (save obj nil :save-as t)))
(set-on-click m-save (lambda (obj) (set-on-click m-save (lambda (obj)
(save obj nil)))) (save obj nil))))
(labels ((buf-add () (labels ((buf-add ()
(let ((val (clog-ace:selected-text ace))) (let ((val (clog-ace:selected-text ace)))
(unless (equal val "") (unless (equal val "")
(place-inside-top-of (window-content (copy-history-win app)) (place-inside-top-of (window-content (copy-history-win app))
(create-text-area (window-content (copy-history-win app)) (create-text-area (window-content (copy-history-win app))
:class "w3-input" :class "w3-input"
:value val :value val
:auto-place nil))))) :auto-place nil)))))
(copy () (copy ()
(buf-add) (buf-add)
(clog-ace:clipboard-copy ace)) (clog-ace:clipboard-copy ace))
(cut () (cut ()
(buf-add) (buf-add)
(clog-ace:clipboard-cut ace))) (clog-ace:clipboard-cut ace)))
(set-on-click btn-copy (lambda (obj) (set-on-click btn-copy (lambda (obj)
(declare (ignore obj))
(copy)))
(set-on-click m-copy (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(copy))) (copy)))
(set-on-click m-copy (lambda (obj) (set-on-click btn-cut (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(copy))) (cut)))
(set-on-click btn-cut (lambda (obj) (set-on-click m-cut (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(cut))) (cut))))
(set-on-click m-cut (lambda (obj) (set-on-click btn-paste (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(cut)))) (clog-ace:clipboard-paste ace)))
(set-on-click btn-paste (lambda (obj) (set-on-click m-paste (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:clipboard-paste ace))) (clog-ace:clipboard-paste ace)))
(set-on-click m-paste (lambda (obj) (set-on-click btn-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:clipboard-paste ace))) (clog-ace:execute-command ace "del")))
(set-on-click btn-del (lambda (obj) (set-on-click m-del (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "del"))) (clog-ace:execute-command ace "del")))
(set-on-click m-del (lambda (obj) (set-on-click btn-undo (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "del"))) (clog-ace:execute-command ace "undo")))
(set-on-click btn-undo (lambda (obj) (set-on-click m-undo (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "undo"))) (clog-ace:execute-command ace "undo")))
(set-on-click m-undo (lambda (obj) (set-on-click btn-redo (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "undo"))) (clog-ace:execute-command ace "redo")))
(set-on-click btn-redo (lambda (obj) (set-on-click m-redo (lambda (obj)
(declare (ignore obj)) (declare (ignore obj))
(clog-ace:execute-command ace "redo"))) (clog-ace:execute-command ace "redo")))
(set-on-click m-redo (lambda (obj) (set-on-click m-desc (lambda (obj)
(declare (ignore obj)) (let ((r (make-array '(0) :element-type 'base-char
(clog-ace:execute-command ace "redo"))) :fill-pointer 0 :adjustable t)))
(set-on-click m-desc (lambda (obj) (with-output-to-string (s r)
(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))
(let ((*standard-output* s)) (let ((*standard-output* s))
(indentify:indentify n)))) (describe (find-symbol (string-upcase (clog-ace:selected-text ace))
(js-execute ace (format nil "~A.insert('~A',true)" (string-upcase (text-value pac-line)))))
(clog-ace::js-ace ace) (on-open-file obj :title-class "w3-purple" :title "describe selection"
(escape-string r))) :text r)))))
(set-is-dirty t)))) (set-on-click m-apro (lambda (obj)
(set-on-click m-ppqs (lambda (obj) (let ((r (make-array '(0) :element-type 'base-char
(declare (ignore obj)) :fill-pointer 0 :adjustable t)))
(let ((r (clog-ace:selected-text ace))) (with-output-to-string (s r)
(setf r (ppcre:regex-replace-all "\"" r "\\\"")) (let ((*standard-output* s))
(js-execute ace (format nil "~A.insert('~A',true)" (apropos (clog-ace:selected-text ace)))
(clog-ace::js-ace ace) (on-open-file obj :title-class "w3-purple" :title "apropos selection"
(escape-string r))) :text r)))))
(set-is-dirty t)))) (set-on-click m-brws (lambda (obj)
(labels ((eval-form (obj) (declare (ignore obj))
(let ((p (parse-integer (on-new-sys-browser ace :search (clog-ace:selected-text ace))))
(js-query obj (set-on-click btn-brws (lambda (obj)
(format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);" (declare (ignore obj))
(clog-ace::js-ace ace) (clog-ace:execute-command ace "find-definition")))
(clog-ace::js-ace ace))) (set-on-click m-brwsp (lambda (obj)
:junk-allowed t)) (declare (ignore obj))
(tv (text-value ace)) (clog-ace:execute-command ace "find-definition")))
(lf nil) (set-on-click m-doc (lambda (obj)
(cp 0)) (open-window (window (connection-body obj))
(loop (format nil "http://l1sp.org/search?q=~A"
(setf (values lf cp) (read-from-string tv nil nil :start cp)) (clog-ace:selected-text ace)))))
(unless lf (return nil)) (set-on-click m-pprt (lambda (obj)
(when (> cp p) (return lf))) (declare (ignore obj))
(when lf (clog-ace:execute-command ace "adjust-tabs")))
(let ((result (capture-eval lf (set-on-click m-ppr (lambda (obj)
:capture-console (not editor-use-console-for-evals) (declare (ignore obj))
:capture-result (not editor-use-console-for-evals) (let ((r (make-array '(0) :element-type 'base-char
:clog-obj (connection-body obj) :fill-pointer 0 :adjustable t)))
:eval-in-package (text-value pac-line)))) (with-output-to-string (s r)
(if editor-use-console-for-evals (with-input-from-string (n (text-value ace))
(on-open-console obj) (let ((*standard-output* s))
(on-open-file obj :title-class "w3-blue" :title "form eval" (indentify:indentify n))))
:has-time-out *editor-delay-on-eval-form* :text result)))))) (setf (text-value ace) r)
(eval-selection (obj) (set-is-dirty t))))
(let ((val (clog-ace:selected-text ace))) (set-on-click m-pprs (lambda (obj)
(unless (equal val "") (declare (ignore obj))
(let ((result (capture-eval val :clog-obj obj (let ((r (make-array '(0) :element-type 'base-char
:capture-console (not editor-use-console-for-evals) :fill-pointer 0 :adjustable t)))
:capture-result (not editor-use-console-for-evals) (with-output-to-string (s r)
:eval-in-package (text-value pac-line)))) (with-input-from-string (n (clog-ace:selected-text ace))
(if editor-use-console-for-evals (let ((*standard-output* s))
(on-open-console obj) (indentify:indentify n))))
(on-open-file obj :title-class "w3-blue" :title "selection eval" (js-execute ace (format nil "~A.insert('~A',true)"
:has-time-out *editor-delay-on-eval-sel* :text result)))))) (clog-ace::js-ace ace)
(eval-file (obj) (escape-string r)))
(let ((val (text-value ace))) (set-is-dirty t))))
(unless (equal val "") (set-on-click m-ppqs (lambda (obj)
(let ((result (capture-eval val :clog-obj obj (declare (ignore obj))
:capture-console (not editor-use-console-for-evals) (let ((r (clog-ace:selected-text ace)))
:capture-result (not editor-use-console-for-evals) (setf r (ppcre:regex-replace-all "\"" r "\\\""))
:eval-in-package (text-value pac-line)))) (js-execute ace (format nil "~A.insert('~A',true)"
(if editor-use-console-for-evals (clog-ace::js-ace ace)
(on-open-console obj) (escape-string r)))
(on-open-file obj :title-class "w3-blue" :title "file eval" (set-is-dirty t))))
:has-time-out *editor-delay-on-eval-file* :text result))))))) (labels ((eval-form (obj)
(set-on-click btn-esel (lambda (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))) (eval-selection obj)))
(set-on-click m-esel (lambda (obj) (set-on-click btn-efrm (lambda (obj)
(eval-selection obj))) (eval-form obj)))
(set-on-click btn-efrm (lambda (obj) (set-on-click m-efrm (lambda (obj)
(eval-form obj))) (eval-form obj)))
(set-on-click m-efrm (lambda (obj) (set-on-click btn-test (lambda (obj)
(eval-form obj))) (eval-file obj)))
(set-on-click btn-test (lambda (obj) (set-on-click m-test (lambda (obj)
(eval-file obj))) (eval-file obj))))
(set-on-click m-test (lambda (obj) win)))))
(eval-file obj))))
win)))))

4
tools/clog-builder-panels.lisp
View file

@ -1023,9 +1023,9 @@ not a temporarily attached one when using select-control."
(get-control-list app panel-id)) (get-control-list app panel-id))
result))) result)))
(set-on-click m-html (lambda (obj) (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) (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 "\"" (ppcre:regex-replace-all "\""
(render-html) (render-html)
"\\\""))))) "\\\"")))))