iDetect if stdout is a pipe Default page is gopherproject - 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 3cf6014aab1eadb344f1a3c2271caa995cb43554	/scm/clic/commit/3cf6014aab1eadb344f1a3c2271caa995cb43554.gph	bitreich.org	70
1parent f2fe151427976dd0fa6135c5d313333b31732a47	/scm/clic/commit/f2fe151427976dd0fa6135c5d313333b31732a47.gph	bitreich.org	70
hAuthor: Solene Rapenne <solene@perso.pw>	URL:mailto:solene@perso.pw	bitreich.org	70
iDate:   Thu, 28 Dec 2017 10:59:28 +0100	Err	bitreich.org	70
i	Err	bitreich.org	70
iDetect if stdout is a pipe	Err	bitreich.org	70
iDefault page is gopherproject	Err	bitreich.org	70
i	Err	bitreich.org	70
iDiffstat:	Err	bitreich.org	70
i  M clic.lisp                           |     104 ++++++++++++++++++++-----------	Err	bitreich.org	70
i	Err	bitreich.org	70
i1 file changed, 67 insertions(+), 37 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@@ -10,23 +10,31 @@	Err	bitreich.org	70
i #+sbcl	Err	bitreich.org	70
i (progn	Err	bitreich.org	70
i   (load-shared-object #p"./extension.so")	Err	bitreich.org	70
i+  ;; getTerminalHeight	Err	bitreich.org	70
i   (declaim (inline getTerminalHeight))	Err	bitreich.org	70
i   (sb-alien:define-alien-routine "getTerminalHeight" unsigned-int)	Err	bitreich.org	70
i   (defun c-termsize ()	Err	bitreich.org	70
i     "return terminal height"	Err	bitreich.org	70
i     (sb-alien:with-alien ((res unsigned-int (getTerminalHeight))))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i+	Err	bitreich.org	70
i #+ecl	Err	bitreich.org	70
i (progn	Err	bitreich.org	70
i   (ffi:clines "	Err	bitreich.org	70
i     #include <sys/ioctl.h>	Err	bitreich.org	70
i     #include <limits.h>	Err	bitreich.org	70
i+    #include <unistd.h>	Err	bitreich.org	70
i+    int ttyPredicate() {	Err	bitreich.org	70
i+      return isatty(fileno(stdout)); }	Err	bitreich.org	70
i     unsigned int getTerminalHeight()  {	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-      () :returning :unsigned-int))	Err	bitreich.org	70
i+      () :returning :unsigned-int)	Err	bitreich.org	70
i+  (ffi:def-function	Err	bitreich.org	70
i+      ("ttyPredicate" c-ttyp)	Err	bitreich.org	70
i+      () :returning :int))	Err	bitreich.org	70
i ;;;; END C binding	Err	bitreich.org	70
i 	Err	bitreich.org	70
i ;; structure to store links	Err	bitreich.org	70
i@@ -82,6 +90,16 @@	Err	bitreich.org	70
i (add-color 'http   0 33)	Err	bitreich.org	70
i ;;;; END ANSI colors	Err	bitreich.org	70
i 	Err	bitreich.org	70
i+;;;; is the output interactive or a pipe ?	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+(defun ttyp()	Err	bitreich.org	70
i+  #+sbcl	Err	bitreich.org	70
i+  (interactive-stream-p *standard-output*)	Err	bitreich.org	70
i+  #+ecl	Err	bitreich.org	70
i+  (if (= 1 (c-ttyp))	Err	bitreich.org	70
i+      t	Err	bitreich.org	70
i+      nil))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i (defun print-with-color(text &optional (color 'white) (line-number nil))	Err	bitreich.org	70
i   "Used to display a line with a color"	Err	bitreich.org	70
i   (format t "~3A| ~a~a~a~%" (if line-number line-number "") (get-color color) text (get-color 'white)))	Err	bitreich.org	70
i@@ -374,42 +392,52 @@	Err	bitreich.org	70
i 	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) 1))) ; -1 for command bar	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+  ;; stdout is a terminal or not ?	Err	bitreich.org	70
i+  (if (ttyp)	Err	bitreich.org	70
i+      ;; yes it is	Err	bitreich.org	70
i+      (let ((rows (- (c-termsize) 1))) ; -1 for command bar	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+             ;; 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)	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+                         (get-color  'white))	Err	bitreich.org	70
i+                 (force-output)	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-line nil nil))))	Err	bitreich.org	70
i+                       (setf input input-text)	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+          (if input	Err	bitreich.org	70
i+              (user-input input)	Err	bitreich.org	70
i+              (when (< (length *buffer*) rows)	Err	bitreich.org	70
i+                (dotimes (i (- rows (length *buffer*)))	Err	bitreich.org	70
i+                  (format t "~%"))))))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+      ;; not interactive	Err	bitreich.org	70
i+      ;; display and quit	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-           ;; 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)	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-                     (get-color  'white))	Err	bitreich.org	70
i-             (force-output)	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-line nil nil))))	Err	bitreich.org	70
i-                   (setf input input-text)	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-      (if input	Err	bitreich.org	70
i-          (user-input input)	Err	bitreich.org	70
i-          (when (< (length *buffer*) rows)	Err	bitreich.org	70
i-            (dotimes (i (- rows (length *buffer*)))	Err	bitreich.org	70
i-              (format t "~%")))))))	Err	bitreich.org	70
i+         do	Err	bitreich.org	70
i+           (format t "~a~%" line))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i (defun visit(destination)	Err	bitreich.org	70
i   "visit a location"	Err	bitreich.org	70
i@@ -471,12 +499,14 @@	Err	bitreich.org	70
i                ;; url as argument	Err	bitreich.org	70
i                (parse-url argv)	Err	bitreich.org	70
i                ;; default url	Err	bitreich.org	70
i-               (make-location :host "bitreich.org" :port 70 :uri "/" :type "1")))))	Err	bitreich.org	70
i+               (make-location :host "gopherproject.org" :port 70 :uri "/" :type "1")))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i     ;; if user want to drop from first page we need	Err	bitreich.org	70
i     ;; to look it here	Err	bitreich.org	70
i     (when (not (eq 'end (visit destination)))	Err	bitreich.org	70
i-      (when (string= "1" (location-type destination))	Err	bitreich.org	70
i+      ;; we continue to the shell if the type was 1 and we are in a terminal	Err	bitreich.org	70
i+      (when (and (ttyp)	Err	bitreich.org	70
i+                 (string= "1" (location-type destination)))	Err	bitreich.org	70
i         (shell)))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i ;; we allow ecl to use a new kind of argument	Err	bitreich.org	70
.