i- new expect file for testing application with coverage report - cleaning whitespace - clic - Clic is an command line interactive client for gopher written in Common LISP Err bitreich.org 70 hgit clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/ URL:git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/ bitreich.org 70 1Log /scm/clic/log.gph bitreich.org 70 1Files /scm/clic/files.gph bitreich.org 70 1Refs /scm/clic/refs.gph bitreich.org 70 1Tags /scm/clic/tag bitreich.org 70 1README /scm/clic/file/README.md.gph bitreich.org 70 1LICENSE /scm/clic/file/LICENSE.gph bitreich.org 70 i--- Err bitreich.org 70 1commit 04f5a2a34e4dcd4f26e89de3dc0dd81032eeda10 /scm/clic/commit/04f5a2a34e4dcd4f26e89de3dc0dd81032eeda10.gph bitreich.org 70 1parent fdffd2e4d1c02050fcf6f441b6e0029d560c1449 /scm/clic/commit/fdffd2e4d1c02050fcf6f441b6e0029d560c1449.gph bitreich.org 70 hAuthor: Solene Rapenne URL:mailto:solene@perso.pw bitreich.org 70 iDate: Thu, 16 Nov 2017 12:11:49 +0000 Err bitreich.org 70 i Err bitreich.org 70 i- new expect file for testing application with coverage report Err bitreich.org 70 i- cleaning whitespace Err bitreich.org 70 i Err bitreich.org 70 iDiffstat: Err bitreich.org 70 i M clic.lisp | 51 ++++++++++++++++++------------- Err bitreich.org 70 i M interactive-test.exp | 26 ++++++++++++++++++-------- Err bitreich.org 70 i Err bitreich.org 70 i2 files changed, 48 insertions(+), 29 deletions(-) Err bitreich.org 70 i--- Err bitreich.org 70 1diff --git a/clic.lisp b/clic.lisp /scm/clic/file/clic.lisp.gph bitreich.org 70 i@@ -22,7 +22,7 @@ Err bitreich.org 70 i #include Err bitreich.org 70 i #include Err bitreich.org 70 i unsigned int getTerminalHeight() { Err bitreich.org 70 i- struct winsize w; Err bitreich.org 70 i+ struct winsize w; Err bitreich.org 70 i return ioctl(1,TIOCGWINSZ,&w)<0?UINT_MAX:w.ws_row;}") Err bitreich.org 70 i (ffi:def-function Err bitreich.org 70 i ("getTerminalHeight" c-termsize) Err bitreich.org 70 i@@ -155,31 +155,31 @@ Err bitreich.org 70 i (print-with-color "selector 5 not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; 6 Unix uuencoded file Err bitreich.org 70 i- (check "6" Err bitreich.org 70 i+ (check "6" Err bitreich.org 70 i (print-with-color "selector 6 not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; 7 Index search server Err bitreich.org 70 i- (check "7" Err bitreich.org 70 i+ (check "7" Err bitreich.org 70 i (print-with-color "selector 7 not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; 8 Telnet session Err bitreich.org 70 i- (check "8" Err bitreich.org 70 i+ (check "8" Err bitreich.org 70 i (print-with-color "selector 8 not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; 9 Binary Err bitreich.org 70 i- (check "9" Err bitreich.org 70 i+ (check "9" Err bitreich.org 70 i (print-with-color "selector 9 not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; + redundant server Err bitreich.org 70 i- (check "+" Err bitreich.org 70 i+ (check "+" Err bitreich.org 70 i (print-with-color "selector + not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; T text based tn3270 session Err bitreich.org 70 i- (check "T" Err bitreich.org 70 i+ (check "T" Err bitreich.org 70 i (print-with-color "selector T not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; g GIF file Err bitreich.org 70 i- (check "g" Err bitreich.org 70 i+ (check "g" Err bitreich.org 70 i (print-with-color "selector g not implemented" 'red)) Err bitreich.org 70 i Err bitreich.org 70 i ;; I image Err bitreich.org 70 i@@ -373,11 +373,23 @@ Err bitreich.org 70 i (defun display-buffer(type) Err bitreich.org 70 i "display the buffer" Err bitreich.org 70 i (let ((rows (c-termsize))) Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; we store the user input outside of the loop Err bitreich.org 70 i+ ;; so if the user doesn't want to scroll Err bitreich.org 70 i+ ;; we break the loop and then execute the command Err bitreich.org 70 i (let ((input nil)) Err bitreich.org 70 i (loop for line across *buffer* Err bitreich.org 70 i counting line into row Err bitreich.org 70 i do Err bitreich.org 70 i- (when (= row (- rows 1)) ; -1 for text displayed Err bitreich.org 70 i+ ;; display lines Err bitreich.org 70 i+ (cond Err bitreich.org 70 i+ ((string= "1" type) Err bitreich.org 70 i+ (formatted-output line)) Err bitreich.org 70 i+ ((string= "0" type) Err bitreich.org 70 i+ (format t "~a~%" line))) Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; split and ask to scroll or to type a command Err bitreich.org 70 i+ (when (= row rows) ; -1 for text displayed Err bitreich.org 70 i (setf row 0) Err bitreich.org 70 i (format t "~a press enter or a shell command ~a : " Err bitreich.org 70 i (get-color 'cyan) Err bitreich.org 70 i@@ -386,14 +398,11 @@ Err bitreich.org 70 i (let ((first-input (read-char))) Err bitreich.org 70 i (when (not (char= #\NewLine first-input)) Err bitreich.org 70 i (unread-char first-input) Err bitreich.org 70 i- (let ((input-text (format nil "~a" (read)))) Err bitreich.org 70 i+ (let ((input-text (format nil "~a" (read-line nil nil)))) Err bitreich.org 70 i (setf input input-text) Err bitreich.org 70 i- (loop-finish))))) Err bitreich.org 70 i- (cond Err bitreich.org 70 i- ((string= "1" type) Err bitreich.org 70 i- (formatted-output line)) Err bitreich.org 70 i- ((string= "0" type) Err bitreich.org 70 i- (format t "~a~%" line)))) Err bitreich.org 70 i+ (loop-finish)))))) Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; in case of shell command, do it Err bitreich.org 70 i (when input Err bitreich.org 70 i (user-input input))))) Err bitreich.org 70 i Err bitreich.org 70 i@@ -411,9 +420,6 @@ Err bitreich.org 70 i ;; goes to the history ! Err bitreich.org 70 i (push destination *history*) Err bitreich.org 70 i Err bitreich.org 70 i- (display-buffer (location-type destination)) Err bitreich.org 70 i- Err bitreich.org 70 i- Err bitreich.org 70 i (when *offline* Err bitreich.org 70 i (let ((path (concatenate 'string Err bitreich.org 70 i "history/" (location-host destination) Err bitreich.org 70 i@@ -427,10 +433,13 @@ Err bitreich.org 70 i :if-does-not-exist :create Err bitreich.org 70 i :if-exists :supersede) Err bitreich.org 70 i Err bitreich.org 70 i- (loop for line in *buffer* Err bitreich.org 70 i+ (loop for line across *buffer* Err bitreich.org 70 i while line Err bitreich.org 70 i do Err bitreich.org 70 i- (format save-offline "~a~%" line)))))) Err bitreich.org 70 i+ (format save-offline "~a~%" line))))) Err bitreich.org 70 i+ Err bitreich.org 70 i+ (display-buffer (location-type destination))) Err bitreich.org 70 i+ Err bitreich.org 70 i Err bitreich.org 70 i (defun shell() Err bitreich.org 70 i "Shell for user interaction" Err bitreich.org 70 1diff --git a/interactive-test.exp b/interactive-test.exp /scm/clic/file/interactive-test.exp.gph bitreich.org 70 i@@ -21,9 +21,14 @@ proc user_input {} { Err bitreich.org 70 i Err bitreich.org 70 i send "19\n" Err bitreich.org 70 i expect " : " Err bitreich.org 70 i+ send "\nr\n" Err bitreich.org 70 i+ expect " : " Err bitreich.org 70 i Err bitreich.org 70 i send "p\n" Err bitreich.org 70 i expect "clic => " Err bitreich.org 70 i+ Err bitreich.org 70 i+ send "r\n" Err bitreich.org 70 i+ expect "clic => " Err bitreich.org 70 i Err bitreich.org 70 i send "h\n" Err bitreich.org 70 i expect "clic => " Err bitreich.org 70 i@@ -61,35 +66,40 @@ expect "* " Err bitreich.org 70 i Err bitreich.org 70 i send "(main)\n" Err bitreich.org 70 i set running [user_input] Err bitreich.org 70 i-send "quit\n" Err bitreich.org 70 i+send "(pop *history*) (p) (r)\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i Err bitreich.org 70 i-send "(main)\n" Err bitreich.org 70 i-expect "clic => " Err bitreich.org 70 i- Err bitreich.org 70 i+send "19\n" Err bitreich.org 70 i+expect " : " Err bitreich.org 70 i send "q\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i Err bitreich.org 70 i-send "(pop *history*) (p) (r)\n" Err bitreich.org 70 i+send "(main)\n" Err bitreich.org 70 i+expect "clic => " Err bitreich.org 70 i+ Err bitreich.org 70 i+send "exit\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i Err bitreich.org 70 i Err bitreich.org 70 i # add an argv to test argv parsing Err bitreich.org 70 i-send "(setf *posix-argv* '(\"sbcl\" \"gopher://bitreich.org/0/usr/\"))\n" Err bitreich.org 70 i+send "(setf *posix-argv* '(\"sbcl\" \"gopher://bitreich.org/0/documents/bitreich-manifesto.md\"))\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i Err bitreich.org 70 i send "(main)\n" Err bitreich.org 70 i+expect " : " Err bitreich.org 70 i+send "q\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i Err bitreich.org 70 i Err bitreich.org 70 i # add an argv to test argv parsing Err bitreich.org 70 i-send "(setf *posix-argv* '(\"sbcl\" \"bitreich.org/0/usr/\"))\n" Err bitreich.org 70 i+send "(setf *posix-argv* '(\"sbcl\" \"bitreich.org/1/usr/solene/\"))\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i send "(main)\n" Err bitreich.org 70 i+expect "clic => " Err bitreich.org 70 i+send "q\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 i Err bitreich.org 70 i Err bitreich.org 70 i- Err bitreich.org 70 i # add an argv to test argv parsing Err bitreich.org 70 i send "(setf *posix-argv* '(\"sbcl\" \"bitreich.org:70/\"))\n" Err bitreich.org 70 i expect "* " Err bitreich.org 70 .