# HG changeset patch # User Richard Westhaver # Date 1727836148 14400 # Node ID 2e7d93b892a5586e8faee447a53e0ac4b83a06f1 # Parent 517c65b51e6ba01f21353ed587aebc3b085c3041 cli shell tests init diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/bin/homer.lisp --- a/lisp/bin/homer.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/bin/homer.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -186,10 +186,10 @@ :version "0.1.0" :description "user home manager" :thunk 'homer-check - :opts ((:name "level" :global t :description "set the log level" :thunk homer-log-level) - (:name "help" :global t :description "print help" :thunk homer-help) - (:name "version" :global t :description "print version" :thunk homer-version) - (:name "force" :global t :description "use force" :thunk homer-force)) + :opts ((:name "level" :description "set the log level" :thunk homer-log-level) + (:name "help" :description "print help" :thunk homer-help) + (:name "version" :description "print version" :thunk homer-version) + (:name "force" :description "use force" :thunk homer-force)) :cmds ((:name show :thunk homer-show) (:name check :thunk homer-check) (:name push :thunk homer-push) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/bin/organ.lisp --- a/lisp/bin/organ.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/bin/organ.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -37,9 +37,9 @@ :version "0.0.1" :description "org-mode toolbox" :thunk 'organ-describe - :opts ((:name "level" :global t :description "set the log level" :thunk organ-log-level) - (:name "help" :global t :description "print help" :thunk organ-help) - (:name "version" :global t :description "print version" :thunk organ-version) + :opts ((:name "level" :description "set the log level" :thunk organ-log-level) + (:name "help" :description "print help" :thunk organ-help) + (:name "version" :description "print version" :thunk organ-version) ;; (:name "output" :description "output file" :kind file :thunk organ-output) ) :cmds ((:name inspect diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/bin/packy.lisp --- a/lisp/bin/packy.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/bin/packy.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -16,9 +16,9 @@ :version "0.1.0" :description "Universal Package Manager" :thunk 'pk-show - :opts ((:name "level" :global t :description "set the log level" :thunk pk-log-level) - (:name "help" :global t :description "print help" :thunk pk-help) - (:name "version" :global t :description "print version" :thunk pk-version)) + :opts ((:name "level" :description "set the log level" :thunk pk-log-level) + (:name "help" :description "print help" :thunk pk-help) + (:name "version" :description "print version" :thunk pk-version)) :cmds ((:name show :opts (:name "target" :thunk pk-target) :thunk pk-show))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/bin/rdb.lisp --- a/lisp/bin/rdb.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/bin/rdb.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -74,10 +74,10 @@ :version "0.1.0" :thunk 'rdb-show :description "A simple helper for RocksDB." - :opts ((:name "level" :global t :description "set the log level" :thunk rdb-log-level) - (:name "help" :global t :description "print help" :thunk rdb-help) - (:name "version" :global t :description "print version" :thunk rdb-version) - (:name "db" :global t :description "target db" :thunk rdb-target-db :kind dir)) + :opts ((:name "level" :description "set the log level" :thunk rdb-log-level) + (:name "help" :description "print help" :thunk rdb-help) + (:name "version" :description "print version" :thunk rdb-version) + (:name "db" :description "target db" :thunk rdb-target-db :kind dir)) :cmds ((:name new :thunk rdb-new) (:name show @@ -90,9 +90,8 @@ (defmain start-rdb () (let ((*log-level* :info)) (with-cli (*rdb-cli* opts cmds args) () - (do-opts (active-opts *cli* t)) (if (active-cmds *cli*) - (let ((*rdb* (create-db (do-opt (car (find-opts *cli* "db")))))) + (rdb:with-db (*rdb* (create-db (do-opt (car (find-opts *cli* "db"))))) (do-cmd *cli*) - (close-db *rdb*)) + (close-db *rdb*)) (print-help *cli*))))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/bin/skel.lisp --- a/lisp/bin/skel.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/bin/skel.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -245,15 +245,15 @@ ;; :help t :description "A hacker's project compiler." :thunk skc-show - :opts ((:name "help" :global t :description "print this message" + :opts ((:name "help" :description "print this message" :thunk skc-help) - (:name "version" :global t :description "print version" + (:name "version" :description "print version" :thunk skc-version) - (:name "level" :global t :description "set log level (warn,info,debug,trace)" + (:name "level" :description "set log level (warn,info,debug,trace)" :thunk skc-level) - (:name "config" :global t :description "set a custom skel user config" :kind file) - (:name "input" :global t :description "input source" :kind string) - (:name "output" :global t :description "output target" :kind string)) + (:name "config" :description "set a custom skel user config" :kind file) + (:name "input" :description "input source" :kind string) + (:name "output" :description "output target" :kind string)) :cmds ((:name init :description "initialize a skelfile in the current directory" :opts (:name "name" :description "project name" :kind string) @@ -361,6 +361,5 @@ (setq *skel-project* (load-skelfile project)) (setq *skel-path* (sk-src *skel-project*)) (setq cli/shell:*shell-directory* (sk-src *skel-project*)))) - (do-opts *cli* t) (do-cmd *cli*) (debug-opts *cli*)))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/cli/clap/cli.lisp --- a/lisp/lib/cli/clap/cli.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/lib/cli/clap/cli.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -48,7 +48,8 @@ (lambda (x) (etypecase x (string (make-cli-opt :name x)) - (list (apply #'make-cli :opt x)))) + (list (apply #'make-cli :opt x)) + (symbol (make-cli-opt :name (string-downcase (symbol-name x )))))) opts)) (defun make-cmds (cmds) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/cli/cli.asd --- a/lisp/lib/cli/cli.asd Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/lib/cli/cli.asd Tue Oct 01 22:29:08 2024 -0400 @@ -42,5 +42,8 @@ :components ((:module "tests" :components ((:file "pkg") - (:file "clap")))) + (:file "shell") + (:file "ansi") + (:file "clap") + (:file "tools")))) :perform (test-op (o c) (symbol-call :rt :do-tests :cli))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/cli/tests/ansi.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/lib/cli/tests/ansi.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -0,0 +1,199 @@ +;;; ansi.lisp --- ANSI Tests + +;; + +;;; Code: +(in-package :cli/tests) +(in-suite :cli) + +(defun ansi-t01 () + (erase) + (cursor-position 0 0) + (princ "0") + (cursor-position 2 2) + (princ "1") + (cursor-position 5 15) + (princ "test") + (cursor-position 10 15) + (force-output) + (with-input-from-string (in (format nil "test~%~%")) + (let ((a (read-line in))) + (cursor-position 12 15) + (princ a) + (force-output)))) + +(defun ansi-t02 () + (print "normal") + (.sgr 1) + (print "bold") + (.sgr 4) + (print "bold underline") + (.sgr 7) + (print "bold underline reverse") + (.sgr 22) + (print "underline reverse") + (.sgr 24) + (print "reverse") + (.sgr 27) + (print "normal") + (.sgr 1 4 7) + (print "bold underline reverse") + (.sgr 0) + (print "normal") + (force-output)) + +(defun ansi-t03 () + "Display the 256 color palette." + (clear) + (loop for i from 0 to 255 do + (.sgr 48 5 i) + (princ #\space)) + (terpri) + (.sgr 0) + (loop for i from 0 to 255 do + (.sgr 38 5 i) + (princ "X")) + (.sgr 0) + (force-output) + ;; (sleep 3) + (.ris) + (force-output)) + +(defun ansi-t04 () + "Hide and show the cursor." + (princ "Cursor visible:") + (force-output) + ;; (sleep 2) + (terpri) + (princ "Cursor invisible:") + (hide-cursor) + (force-output) + ;; (sleep 2) + (terpri) + (princ "Cursor visible:") + (show-cursor) + (force-output) + ;; (sleep 2) + ) + +(defun ansi-t05 () + "Switch to and back from the alternate screen buffer." + (princ "Normal screen buffer. ") + (force-output) + ;; (sleep 2) + (save-cursor-position) + (use-alternate-screen-buffer) + (clear) + (princ "Alternate screen buffer.") + (force-output) + ;; (sleep 2) + (use-normal-screen-buffer) + (restore-cursor-position) + (princ "Back to Normal screen buffer.") + (force-output) + ;; (sleep 1) + ) + +(defun ansi-t06 () + "Set individual termios flags to enable raw and disable echo mode. + +Enabling raw mode allows read-char to return immediately after a key is pressed. + +In the default cooked mode, the entry has to be confirmed by pressing enter." + (set-tty-mode t :ignbrk nil + :brkint nil + :parmrk nil + :istrip nil + :inlcr nil + :igncr nil + :icrnl nil + :ixon nil + :opost nil + :echo nil + :echonl nil + :icanon nil + :isig nil + :iexten nil + :csize nil + :parenb nil + :vmin 1 + :vtime 0) + (erase) + (cursor-position 1 1) + (force-output) + (let ((a (read-char))) + (cursor-position 10 5) + (princ a) + (force-output)) + + (set-tty-mode t :echo t + :brkint t + :ignpar t + :istrip t + :icrnl t + :ixon t + :opost t + :isig t + :icanon t + :veol 0)) + +(defun ansi-t07 () + "Use combination modes that consist of several individual flags. + +Cooked and raw are opposite modes. Enabling cooked disbles raw and vice versa." + (set-tty-mode t :cooked nil) + (erase) + (cursor-position 1 1) + (force-output) + (let ((a (read-char))) + (cursor-position 3 1) + (princ a) + (force-output)) + (set-tty-mode t :raw nil)) + +(defun ansi-t08 () + "Why doesnt calling the stty utility work?" + (uiop:run-program "stty raw -echo" :ignore-error-status t) + (erase) + (cursor-position 1 1) + (force-output) + (let ((a (read-char))) + (cursor-position 2 1) + (princ a) + (force-output)) + (uiop:run-program "stty -raw echo" :ignore-error-status t)) + +(defun ansi-t09 () + "Query terminal size with ANSI escape sequences." + ;; Put the terminal into raw mode so we can read the "user input" + ;; of the reply char by char + ;; Turn off the echo or the sequence will be displayed + (set-tty-mode t :cooked nil :echo nil) + (save-cursor-position) + ;; Go to the bottom right corner of the terminal by attempting + ;; to go to some high value of row and column + (cursor-position 999 999) + (let (chars) + ;; The terminal returns an escape sequence to the standard input + (device-status-report) + (force-output) + ;; The reply isnt immediately available, the terminal does need + ;; some time to answer + (sleep 0.1) + ;; The reply has to be read as if the user typed an escape sequence + (loop for i = (read-char-no-hang *standard-input* nil) + until (null i) + do (push i chars)) + ;; Put the terminal back into its initial cooked state + (set-tty-mode t :raw nil :echo t) + (restore-cursor-position) + ;; Return the read sequence as a list of characters. + (nreverse chars))) + +(deftest ansi () + (with-input-from-string (in (format nil "~%~%")) + (ansi-t01) + (ansi-t02) + (ansi-t03) + (ansi-t04) + (ansi-t05))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/cli/tests/pkg.lisp --- a/lisp/lib/cli/tests/pkg.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/lib/cli/tests/pkg.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -7,202 +7,9 @@ (:use :cl :std :rt :cli :cli/shell :cli/progress :cli/spark :cli/repl :cli/ansi :cli/prompt :cli/clap :cli/tools/sbcl :dat/sxp)) (in-package :cli/tests) -(declaim (optimize (debug 3) (safety 3))) (defsuite :cli) (in-suite :cli) -(defun ansi-t01 () - (erase) - (cursor-position 0 0) - (princ "0") - (cursor-position 2 2) - (princ "1") - (cursor-position 5 15) - (princ "test") - (cursor-position 10 15) - (force-output) - (with-input-from-string (in (format nil "test~%~%")) - (let ((a (read-line in))) - (cursor-position 12 15) - (princ a) - (force-output)))) - -(defun ansi-t02 () - (print "normal") - (.sgr 1) - (print "bold") - (.sgr 4) - (print "bold underline") - (.sgr 7) - (print "bold underline reverse") - (.sgr 22) - (print "underline reverse") - (.sgr 24) - (print "reverse") - (.sgr 27) - (print "normal") - (.sgr 1 4 7) - (print "bold underline reverse") - (.sgr 0) - (print "normal") - (force-output)) - -(defun ansi-t03 () - "Display the 256 color palette." - (clear) - (loop for i from 0 to 255 do - (.sgr 48 5 i) - (princ #\space)) - (terpri) - (.sgr 0) - (loop for i from 0 to 255 do - (.sgr 38 5 i) - (princ "X")) - (.sgr 0) - (force-output) - ;; (sleep 3) - (.ris) - (force-output)) - -(defun ansi-t04 () - "Hide and show the cursor." - (princ "Cursor visible:") - (force-output) - ;; (sleep 2) - (terpri) - (princ "Cursor invisible:") - (hide-cursor) - (force-output) - ;; (sleep 2) - (terpri) - (princ "Cursor visible:") - (show-cursor) - (force-output) - ;; (sleep 2) - ) - -(defun ansi-t05 () - "Switch to and back from the alternate screen buffer." - (princ "Normal screen buffer. ") - (force-output) - ;; (sleep 2) - (save-cursor-position) - (use-alternate-screen-buffer) - (clear) - (princ "Alternate screen buffer.") - (force-output) - ;; (sleep 2) - (use-normal-screen-buffer) - (restore-cursor-position) - (princ "Back to Normal screen buffer.") - (force-output) - ;; (sleep 1) - ) - -(defun ansi-t06 () - "Set individual termios flags to enable raw and disable echo mode. - -Enabling raw mode allows read-char to return immediately after a key is pressed. - -In the default cooked mode, the entry has to be confirmed by pressing enter." - (set-tty-mode t :ignbrk nil - :brkint nil - :parmrk nil - :istrip nil - :inlcr nil - :igncr nil - :icrnl nil - :ixon nil - :opost nil - :echo nil - :echonl nil - :icanon nil - :isig nil - :iexten nil - :csize nil - :parenb nil - :vmin 1 - :vtime 0) - (erase) - (cursor-position 1 1) - (force-output) - (let ((a (read-char))) - (cursor-position 10 5) - (princ a) - (force-output)) - - (set-tty-mode t :echo t - :brkint t - :ignpar t - :istrip t - :icrnl t - :ixon t - :opost t - :isig t - :icanon t - :veol 0)) - -(defun ansi-t07 () - "Use combination modes that consist of several individual flags. - -Cooked and raw are opposite modes. Enabling cooked disbles raw and vice versa." - (set-tty-mode t :cooked nil) - (erase) - (cursor-position 1 1) - (force-output) - (let ((a (read-char))) - (cursor-position 3 1) - (princ a) - (force-output)) - (set-tty-mode t :raw nil)) - -(defun ansi-t08 () - "Why doesnt calling the stty utility work?" - (uiop:run-program "stty raw -echo" :ignore-error-status t) - (erase) - (cursor-position 1 1) - (force-output) - (let ((a (read-char))) - (cursor-position 2 1) - (princ a) - (force-output)) - (uiop:run-program "stty -raw echo" :ignore-error-status t)) - -(defun ansi-t09 () - "Query terminal size with ANSI escape sequences." - ;; Put the terminal into raw mode so we can read the "user input" - ;; of the reply char by char - ;; Turn off the echo or the sequence will be displayed - (set-tty-mode t :cooked nil :echo nil) - (save-cursor-position) - ;; Go to the bottom right corner of the terminal by attempting - ;; to go to some high value of row and column - (cursor-position 999 999) - (let (chars) - ;; The terminal returns an escape sequence to the standard input - (device-status-report) - (force-output) - ;; The reply isnt immediately available, the terminal does need - ;; some time to answer - (sleep 0.1) - ;; The reply has to be read as if the user typed an escape sequence - (loop for i = (read-char-no-hang *standard-input* nil) - until (null i) - do (push i chars)) - ;; Put the terminal back into its initial cooked state - (set-tty-mode t :raw nil :echo t) - (restore-cursor-position) - ;; Return the read sequence as a list of characters. - (nreverse chars))) - -(deftest ansi () - (with-input-from-string (in (format nil "~%~%")) - (ansi-t01) - (ansi-t02) - (ansi-t03) - (ansi-t04) - (ansi-t05))) - ;; TODO: needs to be compiled outside scope of test - contender for ;; fixture API (defprompt tpfoo :prompt "testing:") diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/cli/tests/shell.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/lib/cli/tests/shell.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -0,0 +1,13 @@ +;;; shell.lisp --- Shell Reader Tests + +;; + +;;; Code: +(in-package :cli/tests) +(in-suite :cli) + +(defparameter *shell-test-fn* #$ls #,*default-pathname-defaults* $#) + +(deftest shell-reader () + (in-readtable :shell) + (is (functionp *shell-test-fn*))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/cli/tests/tools.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/lib/cli/tests/tools.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -0,0 +1,11 @@ +;;; tools.lisp --- Tool Tests + +;; + +;;; Code: +(in-package :cli/tests) +(in-suite :cli) + +(deftest sbcl () + (with-sbcl (:noinform t :quit t) + (print 1))) diff -r 517c65b51e6b -r 2e7d93b892a5 lisp/lib/rdb/macs.lisp --- a/lisp/lib/rdb/macs.lisp Tue Oct 01 21:52:17 2024 -0400 +++ b/lisp/lib/rdb/macs.lisp Tue Oct 01 22:29:08 2024 -0400 @@ -34,14 +34,16 @@ ;; (rocksdb-destroy-db ,opt ,db-path err) ;; when :destroy only (rocksdb-options-destroy ,opt))))) -(defmacro with-db ((db-var db) &body body) +(defmacro with-db ((db-var db &key open close) &body body) "Bind DB-VAR to the database object DB for the lifetime of BODY." `(let ((,db-var ,db)) (handler-bind ((error (lambda (condition) (error 'rdb-error :message (format nil "WITH-DB signaled: ~A" condition))))) - ,@body))) + ,@(when open `(open-db ,db-var)) + ,@(if close `(unwind-protect (progn ,@body) (close ,db-var)) + body)))) ;;; cf (defmacro with-cf ((cf-var cf) &body body)