tab adjust

This commit is contained in:
David Botton 2024-04-17 12:25:38 -04:00
parent fd2afcefd9
commit 1faedda116
5 changed files with 286 additions and 14 deletions

2
clog.asd vendored
View file

@ -16,6 +16,7 @@
#:bordeaux-threads #:trivial-open-browser #:parse-float #:quri #:bordeaux-threads #:trivial-open-browser #:parse-float #:quri
#:lack-middleware-static #:lack-request #:lack-util-writer-stream #:lack-middleware-static #:lack-request #:lack-util-writer-stream
#:trivial-gray-streams #:closer-mop #:mgl-pax #:cl-template #:atomics #:trivial-gray-streams #:closer-mop #:mgl-pax #:cl-template #:atomics
#:cl-indentify
#:sqlite #:cl-dbi #:cl-pass #-(or mswindows win32 cormanlisp) #:cl-isaac) #:sqlite #:cl-dbi #:cl-pass #-(or mswindows win32 cormanlisp) #:cl-isaac)
:components ((:module "static-files" :components ((:module "static-files"
:components ((:static-file "js/boot.js"))) :components ((:static-file "js/boot.js")))
@ -96,6 +97,7 @@
(:file "clog-builder-repl") (:file "clog-builder-repl")
(:file "clog-builder-shell") (:file "clog-builder-shell")
(:file "clog-builder-images") (:file "clog-builder-images")
(:file "preferences-tabs")
;; clog-builder panels (post-render) ;; clog-builder panels (post-render)
(:file "panel-clog-templates") (:file "panel-clog-templates")
(:file "panel-image-to-data") (:file "panel-image-to-data")

View file

@ -116,12 +116,13 @@
(m-efrm (create-gui-menu-item m-lisp :content "evaluate form (cmd/alt-[)")) (m-efrm (create-gui-menu-item m-lisp :content "evaluate form (cmd/alt-[)"))
(m-esel (create-gui-menu-item m-lisp :content "evaluate selection")) (m-esel (create-gui-menu-item m-lisp :content "evaluate selection"))
(m-test (create-gui-menu-item m-lisp :content "evaluate all")) (m-test (create-gui-menu-item m-lisp :content "evaluate all"))
(m-brwsp (create-gui-menu-item m-lisp :content "systen browse at point")) (m-brwsp (create-gui-menu-item m-lisp :content "system browse at point"))
(m-brws (create-gui-menu-item m-lisp :content "systen browse selection")) (m-brws (create-gui-menu-item m-lisp :content "system browse selection"))
(m-desc (create-gui-menu-item m-lisp :content "describe selection")) (m-desc (create-gui-menu-item m-lisp :content "describe selection"))
(m-doc (create-gui-menu-item m-lisp :content "documentation on selection")) (m-doc (create-gui-menu-item m-lisp :content "documentation on selection"))
(m-apro (create-gui-menu-item m-lisp :content "apropos on selection")) (m-apro (create-gui-menu-item m-lisp :content "apropos on selection"))
(m-ppr (create-gui-menu-item m-lisp :content "pretty print")) (m-ppr (create-gui-menu-item m-lisp :content "adjust tabs file"))
(m-pprs (create-gui-menu-item m-lisp :content "adjust tabs selection"))
(m-help (create-gui-menu-drop-down menu :content "Help")) (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) :class title-class)) (tool-bar (create-div (top-panel box) :class title-class))
@ -434,14 +435,22 @@
:fill-pointer 0 :adjustable t))) :fill-pointer 0 :adjustable t)))
(with-output-to-string (s r) (with-output-to-string (s r)
(with-input-from-string (n (text-value ace)) (with-input-from-string (n (text-value ace))
(let ((*standard-output* s) (let ((*standard-output* s))
(*print-case* :downcase)) (indentify:indentify n))))
(loop
(let ((l (read n nil)))
(unless l (return))
(pprint l))))))
(setf (text-value ace) r) (setf (text-value ace) r)
(setf is-dirty t)))) (setf 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)))
(setf is-dirty t))))
(labels ((eval-form (obj) (labels ((eval-form (obj)
(let ((p (parse-integer (let ((p (parse-integer
(js-query obj (js-query obj

View file

@ -52,6 +52,7 @@
;; Panel Builder ;; Panel Builder
(defparameter *builder-render-right-margin* 80) (defparameter *builder-render-right-margin* 80)
(defparameter *builder-render-case* :downcase)
;; Builder Look and Feel ;; Builder Look and Feel

View file

@ -308,6 +308,10 @@ clog-builder window.")
(defun on-new-builder (body) (defun on-new-builder (body)
"Launch instance of the CLOG Builder" "Launch instance of the CLOG Builder"
(set-html-on-close body "Connection Lost") (set-html-on-close body "Connection Lost")
(indentify:load-templates +common-lisp-templates+
+asdf-templates+
+uiop-templates+
+alexandria-templates+)
(let ((app (make-instance 'builder-app-data)) (let ((app (make-instance 'builder-app-data))
(*menu-bar-class* *builder-menu-bar-class*) (*menu-bar-class* *builder-menu-bar-class*)
(*menu-bar-drop-down-class* *builder-menu-bar-drop-down-class*) (*menu-bar-drop-down-class* *builder-menu-bar-drop-down-class*)
@ -353,16 +357,16 @@ clog-builder window.")
(declare (ignore obj)) (declare (ignore obj))
(setf *open-external* (not *open-external*)) (setf *open-external* (not *open-external*))
(setf (text-value exter) (exter-text))))) (setf (text-value exter) (exter-text)))))
(create-gui-menu-item file :content "New CLOG Panel Editor" :on-click
(lambda (obj)
(if *open-external*
(on-new-builder-panel-ext obj)
(on-new-builder-panel obj))))
(create-gui-menu-item file :content "New Source Editor" :on-click (create-gui-menu-item file :content "New Source Editor" :on-click
(lambda (obj) (lambda (obj)
(if *open-external* (if *open-external*
(on-open-file-ext obj) (on-open-file-ext obj)
(on-open-file obj)))) (on-open-file obj))))
(create-gui-menu-item file :content "New CLOG Panel Editor" :on-click
(lambda (obj)
(if *open-external*
(on-new-builder-panel-ext obj)
(on-new-builder-panel obj))))
(create-gui-menu-item file :content "New CLOG Panel Popup Editor" :on-click 'on-new-builder-page) (create-gui-menu-item file :content "New CLOG Panel Popup Editor" :on-click 'on-new-builder-page)
(create-gui-menu-item file :content "New HTML Panel Popup Editor" :on-click 'on-new-builder-basic-page) (create-gui-menu-item file :content "New HTML Panel Popup Editor" :on-click 'on-new-builder-basic-page)
(create-gui-menu-item file :content "New Custom Boot Panel External Editor" :on-click 'on-new-builder-custom-page)) (create-gui-menu-item file :content "New Custom Boot Panel External Editor" :on-click 'on-new-builder-custom-page))

256
tools/preferences-tabs.lisp Normal file
View file

@ -0,0 +1,256 @@
(in-package :clog-tools)
; Primary count zero is the default so no need to include those.
(defparameter +common-lisp-templates+
'((assert :count 2 :sub (nil nil
(:style :list)
nil))
(block :count 1)
(case :count 1 :sub (nil nil (:count 0)))
(catch :count 1)
(ccase :count 1 :sub (nil nil (:count 0)))
(cond :count 0 :sub (nil (:count 0)))
(ctypecase :count 1 :sub (nil nil (:count 0)))
(defclass :count 2 :sub (nil nil
(:style :list)
(:style :list :sub ((:count 0)))
(:count 0)))
(defconstant :count 1)
(defgeneric :count 2 :sub (nil nil
(:style :list)
nil))
(define-compiler-macro :count 2 :sub (nil nil
(:style :list)
nil))
(define-condition :count 2 :sub (nil nil
(:style :list)
(:style :list :sub ((:count 0)))
(:count 0)))
(define-method-combination :count 1)
(define-modify-macro :count 2 :sub (nil nil
(:style :list)
nil))
(define-setf-expander :count 2 :sub (nil nil
(:style :list)
nil))
(define-symbol-macro :count 1)
(defmacro :count 2 :sub (nil nil
(:style :list)
nil))
(defmethod :count 2 :ignore (:before :after :around) :sub ((:style :list)
(:style :list)
nil))
(defpackage :count 1)
(defparameter :count 1)
(defsetf :count 2) ; primary is actually 2-3
(defstruct :count 1 :sub (nil
(:count 0)
nil))
(deftype :count 2 :sub (nil nil
(:style :list)
nil))
(defun :count 2 :sub (nil nil
(:style :list)
nil))
(defvar :count 1)
(destructuring-bind :count 2 :sub (nil nil
(:style :list)
nil))
(do-all-symbols :style :tag :count 1 :sub (nil
(:count 0)
nil))
(do :style :tag :count 2 :sub (nil
(:style :list :sub ((:count 0)))
(:count 0)
nil))
(do* :style :tag :count 2 :sub (nil
(:style :list :sub ((:count 0)))
(:count 0)
nil))
(do-external-symbols :style :tag :count 1 :sub (nil
(:count 0)
nil))
(dolist :style :tag :count 1 :sub (nil
(:count 0)
nil))
(do-symbols :style :tag :count 1 :sub (nil
(:count 0)
nil))
(dotimes :style :tag :count 1 :sub (nil
(:count 0)
nil))
(ecase :count 1 :sub (nil nil
(:count 0)))
(etypecase :count 1 :sub (nil nil
(:count 0)))
(eval-when :count 1)
(flet :count 1 :sub (nil
(:style :list :sub ((:count 1)))
nil))
(handler-bind :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
(handler-case :count 1 :sub (nil nil
(:count 1 :style :tag)))
(if :count 3 :sub (nil
(:style :list :sub ((:count 0)))
nil))
(:import-from :count 1)
(labels :count 1 :sub (nil
(:style :list :sub ((:count 1)))
nil))
(lambda :count 1 :sub (nil
(:style :list)
nil))
(let :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
(let* :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
(loop :count 0)
(macrolet :count 1 :sub (nil
(:style :list :sub ((:count 1)))
nil))
(multiple-value-bind :count 2 :sub (nil
(:style :list)
nil nil))
(prog :style :tag :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
(prog* :style :tag :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
(progv :count 2)
(prog1 :style :tag :count 2 :sub (nil
(:style :list :sub ((:count 0)))
(:count 0)
nil))
(quote :count 0 :sub (nil
(:style :quote)))
(:shadowing-import-from :count 1)
(tagbody :style :tag :count 0)
(typecase :count 1 :sub (nil nil
(:count 0)))
(unless :count 1)
(unwind-protect :count 1)
(when :count 1)
(with-accessors :count 2 :sub (nil
(:style :list)
nil))
(with-compilation-unit :count 1 :sub (nil
(:style :list)
nil))
(with-condition-restarts :count 2)
(with-hash-table-iterator :count 1 :sub (nil
(:count 0)
nil))
(with-input-from-string :count 1 :sub (nil
(:count 0)
nil))
(with-open-file :count 1 :sub (nil
(:count 0)
nil))
(with-open-stream :count 1 :sub (nil
(:count 0)
nil))
(with-output-to-string :count 1 :sub (nil
(:count 0)
nil))
(with-package-iterator :count 1 :sub (nil
(:count 0)
nil))
(with-simple-restart :count 1 :sub (nil
(:count 0)
nil))
(with-slots :count 2 :sub (nil
(:style :list)
nil))))
(defparameter +asdf-templates+
'(("defsystem" :count 1)))
(defparameter +uiop-templates+
'(("while-collecting" :count 1 :sub (nil
(:style :list)
nil))
("with-current-directory" :count 1 :sub (nil
(:style :list)
nil))
("with-deprecation" :count 1 :sub (nil
(:style :list)
nil))
("with-enough-pathname" :count 1 :sub (nil
(:count 1)
nil))
("with-fatal-condition-handler" :count 1 :sub (nil
(:style :list)
nil))
("with-input" :count 1 :sub (nil
(:count 1)
nil))
("with-muffled-compiler-conditions" :count 1 :sub (nil
(:style :list)
nil))
("with-muffled-conditions" :count 1 :sub (nil
(:style :list)
nil))
("with-muffled-loader-conditions" :count 1 :sub (nil
(:style :list)
nil))
("with-null-input" :count 1 :sub (nil
(:count 1)
nil))
("with-null-output" :count 1 :sub (nil
(:count 1)
nil))
("with-output" :count 1 :sub (nil
(:count 1)
nil))
("with-safe-io-syntax" :count 1 :sub (nil
(:style :list)
nil))
("with-saved-deferred-warnings" :count 1 :sub (nil
(:count 1)
nil))
("with-staging-pathname" :count 1 :sub (nil
(:count 1)
nil))
("with-temporary-file" :count 1 :sub (nil
(:count 1)
nil))
("with-upgradability" :count 1 :sub (nil
(:style :list)
nil))))
(defparameter +alexandria-templates+
'(("cswitch" :count 1 :sub (nil nil
(:count 0)))
("destructuring-case" :count 1 :sub (nil nil
(:count 0)))
("destructuring-ccase" :count 1 :sub (nil nil
(:count 0)))
("destructuring-ecase" :count 1 :sub (nil nil
(:count 0)))
("eswitch" :count 1 :sub (nil nil
(:count 0)))
("if-let" :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
("named-lambda" :count 2 :sub (nil nil
(:style :list) nil))
("once-only" :count 1 :sub (nil
(:style :list) nil))
("switch" :count 1 :sub (nil nil
(:count 0)))
("when-let" :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
("when-let*" :count 1 :sub (nil
(:style :list :sub ((:count 0)))
nil))
("with-gensyms" :count 1 :sub (nil
(:style :list)
nil))
("with-unique-names" :count 1 :sub (nil
(:style :list)))))