iRework ~25% of internal code - 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 50d172f78c56c2153f7e964798c6bbbe5ff56dc8	/scm/clic/commit/50d172f78c56c2153f7e964798c6bbbe5ff56dc8.gph	bitreich.org	70
1parent ce56b40eb8ee913c000bdb5287d03227cca10a61	/scm/clic/commit/ce56b40eb8ee913c000bdb5287d03227cca10a61.gph	bitreich.org	70
hAuthor: Solene Rapenne <solene@perso.pw>	URL:mailto:solene@perso.pw	bitreich.org	70
iDate:   Thu,  1 Feb 2018 09:30:30 +0100	Err	bitreich.org	70
i	Err	bitreich.org	70
iRework ~25% of internal code	Err	bitreich.org	70
i	Err	bitreich.org	70
iDiffstat:	Err	bitreich.org	70
i  M clic.lisp                           |     464 +++++++++++++++++--------------	Err	bitreich.org	70
i	Err	bitreich.org	70
i1 file changed, 248 insertions(+), 216 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@@ -48,9 +48,6 @@	Err	bitreich.org	70
i ;;; array of lines of last menu	Err	bitreich.org	70
i (defparameter *previous-buffer* nil)	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-;;; boolean if we are interactive or not	Err	bitreich.org	70
i-(defparameter *not-interactive* nil)	Err	bitreich.org	70
i-	Err	bitreich.org	70
i ;;; a list containing the last viewed pages	Err	bitreich.org	70
i (defparameter *history*   '())	Err	bitreich.org	70
i 	Err	bitreich.org	70
i@@ -124,6 +121,22 @@	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 'reset)))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i+(defmacro easy-socket(&body code)	Err	bitreich.org	70
i+  "avoid duplicated code used for sockets"	Err	bitreich.org	70
i+  `(progn	Err	bitreich.org	70
i+     (let* ((address (sb-bsd-sockets:get-host-by-name host))	Err	bitreich.org	70
i+            (host (car (sb-bsd-sockets:host-ent-addresses address)))	Err	bitreich.org	70
i+            (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+       (sb-bsd-sockets:socket-connect socket host port)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+       ;; we open a stream for input/output	Err	bitreich.org	70
i+       (let ((stream (sb-bsd-sockets:socket-make-stream socket	Err	bitreich.org	70
i+                                                        :input t	Err	bitreich.org	70
i+                                                        :output t	Err	bitreich.org	70
i+                                                        :element-type :default)))	Err	bitreich.org	70
i+         ,@code))))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i (defmacro check(identifier &body code)	Err	bitreich.org	70
i   "Macro to define a new syntax to make 'when' easier for formatted-output function"	Err	bitreich.org	70
i   `(progn (when (string= ,identifier line-type) ,@code)))	Err	bitreich.org	70
i@@ -243,7 +256,30 @@	Err	bitreich.org	70
i                                       "invalid type ~a : ~a" line-type text)	Err	bitreich.org	70
i                               'red))))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-(defun getpage(host port uri &optional (binary nil) (search nil))	Err	bitreich.org	70
i+(defun download-binary(host port uri)	Err	bitreich.org	70
i+  (easy-socket	Err	bitreich.org	70
i+   ;; sending the request to the server	Err	bitreich.org	70
i+   (format stream "~a~a~a" uri #\Return #\Newline)	Err	bitreich.org	70
i+   (force-output stream)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+   ;; save into a file in /tmp	Err	bitreich.org	70
i+   (let* ((filename (subseq uri (1+ (position #\/ uri :from-end t))))	Err	bitreich.org	70
i+          (path (concatenate 'string "/tmp/" filename)))	Err	bitreich.org	70
i+     (with-open-file (output path	Err	bitreich.org	70
i+                             :element-type '(unsigned-byte 8)	Err	bitreich.org	70
i+                             :direction :output :if-exists :supersede)	Err	bitreich.org	70
i+       (let ((buf (make-array 4096 :element-type '(unsigned-byte 8))))	Err	bitreich.org	70
i+         (loop for pos = (read-sequence buf stream)	Err	bitreich.org	70
i+            while (plusp pos)	Err	bitreich.org	70
i+            do	Err	bitreich.org	70
i+              (format t ".")	Err	bitreich.org	70
i+              (force-output)	Err	bitreich.org	70
i+              (write-sequence buf output :end pos)))	Err	bitreich.org	70
i+       (format t "~%File downloaded into ~a (~a bytes)~%" path (file-length output))))))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+(defun getpage(host port uri &optional (search nil))	Err	bitreich.org	70
i   "send a request and store the answer (in *buffer* if text or save a file if binary)"	Err	bitreich.org	70
i 	Err	bitreich.org	70
i   ;; we reset the buffer	Err	bitreich.org	70
i@@ -253,61 +289,21 @@	Err	bitreich.org	70
i                     :initial-element nil	Err	bitreich.org	70
i                     :adjustable t))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-  ;; we prepare informations about the connection	Err	bitreich.org	70
i-  (let* ((address (sb-bsd-sockets:get-host-by-name host))	Err	bitreich.org	70
i-         (host (car (sb-bsd-sockets:host-ent-addresses address)))	Err	bitreich.org	70
i-         (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))	Err	bitreich.org	70
i-         (real-time (get-internal-real-time)))	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-    (sb-bsd-sockets:socket-connect socket host port)	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-    ;; we open a stream for input/output	Err	bitreich.org	70
i-    (let ((stream (sb-bsd-sockets:socket-make-stream socket	Err	bitreich.org	70
i-                                                     :input t	Err	bitreich.org	70
i-                                                     :output t	Err	bitreich.org	70
i-                                                     :element-type :default)))	Err	bitreich.org	70
i-      ;; sending the request to the server	Err	bitreich.org	70
i-      (if search	Err	bitreich.org	70
i-          (progn	Err	bitreich.org	70
i-            (format t "Input : ")	Err	bitreich.org	70
i-            (let ((user-input (read-line nil nil)))	Err	bitreich.org	70
i-              (format stream "~a        ~a~a~a" uri user-input #\Return #\Newline)))	Err	bitreich.org	70
i-          (format stream "~a~a~a" uri #\Return #\Newline))	Err	bitreich.org	70
i-      (force-output stream)	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-      (if binary	Err	bitreich.org	70
i-          ;; binary	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-          ;; in terminal = save the file	Err	bitreich.org	70
i-          ;; not terminal = write to stdio	Err	bitreich.org	70
i-          (if (ttyp)	Err	bitreich.org	70
i-              ;; save into a file in /tmp	Err	bitreich.org	70
i-              (let* ((filename (subseq uri (1+ (position #\/ uri :from-end t))))	Err	bitreich.org	70
i-                     (path (concatenate 'string "/tmp/" filename)))	Err	bitreich.org	70
i-                (with-open-file (output path	Err	bitreich.org	70
i-                                        :element-type '(unsigned-byte 8)	Err	bitreich.org	70
i-                                        :direction :output :if-exists :supersede)	Err	bitreich.org	70
i-                  (let ((buf (make-array 4096 :element-type '(unsigned-byte 8))))	Err	bitreich.org	70
i-                    (loop for pos = (read-sequence buf stream)	Err	bitreich.org	70
i-                       while (plusp pos)	Err	bitreich.org	70
i-                       do	Err	bitreich.org	70
i-                         (format t ".")	Err	bitreich.org	70
i-                         (force-output)	Err	bitreich.org	70
i-                         (write-sequence buf output :end pos)))	Err	bitreich.org	70
i-                  (format t "~%File downloaded into ~a (~a bytes)~%" path (file-length output))))	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-              ;; write to the standard output	Err	bitreich.org	70
i-              (let ((buf (make-array 4096 :element-type '(unsigned-byte 8))))	Err	bitreich.org	70
i-                (loop for pos = (read-sequence buf stream)	Err	bitreich.org	70
i-                   while (plusp pos)	Err	bitreich.org	70
i-                   do	Err	bitreich.org	70
i-                     (write-sequence buf *standard-output* :end pos))))	Err	bitreich.org	70
i-          ;; not binary	Err	bitreich.org	70
i-          ;; for each line we receive we store it in *buffer*	Err	bitreich.org	70
i-          (loop for line = (read-line stream nil nil)	Err	bitreich.org	70
i-             while line	Err	bitreich.org	70
i-             do	Err	bitreich.org	70
i-               (vector-push line *buffer*))))	Err	bitreich.org	70
i+  (let ((real-time (get-internal-real-time)))	Err	bitreich.org	70
i+    ;; we prepare informations about the connection	Err	bitreich.org	70
i+    (easy-socket	Err	bitreich.org	70
i+     ;; sending the request to the server	Err	bitreich.org	70
i+     (if search	Err	bitreich.org	70
i+         (format stream "~a        ~a~a~a" uri search #\Return #\Newline)	Err	bitreich.org	70
i+         (format stream "~a~a~a"       uri #\Return #\Newline))	Err	bitreich.org	70
i+     (force-output stream)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+     ;; not binary	Err	bitreich.org	70
i+     ;; for each line we receive we store it in *buffer*	Err	bitreich.org	70
i+     (loop for line = (read-line stream nil nil)	Err	bitreich.org	70
i+        while line	Err	bitreich.org	70
i+        do	Err	bitreich.org	70
i+          (vector-push line *buffer*)))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i     ;; we store the duration of the connection	Err	bitreich.org	70
i     (setf *duration* (float (/ (- (get-internal-real-time) real-time)	Err	bitreich.org	70
i@@ -340,7 +336,7 @@	Err	bitreich.org	70
i        (when (search text (car (split (subseq line 1) #\Tab)) :test #'char-equal)	Err	bitreich.org	70
i          (vector-push line *buffer*)))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-  (display-buffer "1"))	Err	bitreich.org	70
i+  (display-interactive-menu))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i 	Err	bitreich.org	70
i (defun p()	Err	bitreich.org	70
i@@ -507,146 +503,175 @@	Err	bitreich.org	70
i      (ignore-errors	Err	bitreich.org	70
i        (g (parse-integer input))))))	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+(defun display-interactive-binary-file()	Err	bitreich.org	70
i+  "call xdg-open on the binary file"	Err	bitreich.org	70
i+  (let* ((location (car *history*))	Err	bitreich.org	70
i+         (filename (subseq ;; get the text after last /	Err	bitreich.org	70
i+                    (location-uri location)	Err	bitreich.org	70
i+                    (1+ (position #\/	Err	bitreich.org	70
i+                                  (location-uri location)	Err	bitreich.org	70
i+                                  :from-end t))))	Err	bitreich.org	70
i+         (filepath (concatenate 'string "/tmp/" (or filename "index"))))	Err	bitreich.org	70
i+    (uiop:run-program (list "xdg-open" filepath))))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+(defun display-text-stdout()	Err	bitreich.org	70
i+  "display the buffer to stdout"	Err	bitreich.org	70
i+  (loop for line across *buffer*	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 display-with-pager()	Err	bitreich.org	70
i+  (let* ((uri (location-uri (car *history*)))	Err	bitreich.org	70
i+         (filename (subseq uri (1+ (position #\/ uri :from-end t))))	Err	bitreich.org	70
i+         (path (concatenate 'string "/tmp/" (or filename "index"))))	Err	bitreich.org	70
i+    (with-open-file (output path	Err	bitreich.org	70
i+                            :direction :output	Err	bitreich.org	70
i+                            :if-does-not-exist :create	Err	bitreich.org	70
i+                            :if-exists :supersede)	Err	bitreich.org	70
i+      (loop for line across *buffer*	Err	bitreich.org	70
i+         do	Err	bitreich.org	70
i+           (format output "~a~%" line)))	Err	bitreich.org	70
i+    (uiop:run-program (list (or (uiop:getenv "PAGER") "less") path)	Err	bitreich.org	70
i+                      :input :interactive	Err	bitreich.org	70
i+                      :output :interactive)))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+(defun display-interactive-menu()	Err	bitreich.org	70
i+  "display a menu"	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+    (let ((rows (- (c-termsize) 1))) ; -1 for command bar	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-  ;;;; stdout is a terminal or not ?	Err	bitreich.org	70
i-  (if (ttyp)	Err	bitreich.org	70
i-      ;;;; we are in interactive mode	Err	bitreich.org	70
i-      (cond	Err	bitreich.org	70
i-        ;;;; output is a text file ?	Err	bitreich.org	70
i-        ;;;; call the $PAGER !	Err	bitreich.org	70
i-       ((string= "0" type)	Err	bitreich.org	70
i-                 ;;; generate a string from *buffer* array	Err	bitreich.org	70
i-        (let* ((uri (location-uri (car *history*)))	Err	bitreich.org	70
i-               (filename (subseq uri (1+ (position #\/ uri :from-end t))))	Err	bitreich.org	70
i-               (path (concatenate 'string "/tmp/" filename)))	Err	bitreich.org	70
i-          (with-open-file (output path	Err	bitreich.org	70
i-                                  :direction :output	Err	bitreich.org	70
i-                                  :if-does-not-exist :create	Err	bitreich.org	70
i-                                  :if-exists :supersede)	Err	bitreich.org	70
i-            (loop for line across *buffer*	Err	bitreich.org	70
i-               do	Err	bitreich.org	70
i-                 (format output "~a~%" line)))	Err	bitreich.org	70
i-          (uiop:run-program (list (or (uiop:getenv "PAGER") "less") path)	Err	bitreich.org	70
i-                            :input :interactive	Err	bitreich.org	70
i-                            :output :interactive))	Err	bitreich.org	70
i-         ;; display last menu	Err	bitreich.org	70
i-         (pop *history*)	Err	bitreich.org	70
i-         (when *previous-buffer*	Err	bitreich.org	70
i-           (setf *buffer* (copy-array *previous-buffer*))	Err	bitreich.org	70
i-           (setf *links* (make-hash-table))	Err	bitreich.org	70
i-           (display-buffer "1")))	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-        ;; image	Err	bitreich.org	70
i-        ((or	Err	bitreich.org	70
i-          (string= "I" type)	Err	bitreich.org	70
i-          (string= "9" type))	Err	bitreich.org	70
i-         (let ((location (car *history*)))	Err	bitreich.org	70
i-           (uiop:run-program (list "xdg-open"	Err	bitreich.org	70
i-                                   (concatenate 'string	Err	bitreich.org	70
i-                                                "/tmp/"	Err	bitreich.org	70
i-                                                (subseq ;; get the text after last /	Err	bitreich.org	70
i-                                                 (location-uri location)	Err	bitreich.org	70
i-                                                 (1+ (position #\/	Err	bitreich.org	70
i-                                                               (location-uri location)	Err	bitreich.org	70
i-                                                               :from-end t)))))))	Err	bitreich.org	70
i-         (pop *history*)	Err	bitreich.org	70
i-         (when *previous-buffer*	Err	bitreich.org	70
i-           (setf *buffer* (copy-array *previous-buffer*))	Err	bitreich.org	70
i-           (setf *links* (make-hash-table))	Err	bitreich.org	70
i-           (display-buffer "1")))	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-        ;;;; output is a menu ?	Err	bitreich.org	70
i-        ;;;; display the menu and split it in pages if needed	Err	bitreich.org	70
i-        ((or	Err	bitreich.org	70
i-          (string= "1" type)	Err	bitreich.org	70
i-          (string= "7" type))	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-           (let ((rows (- (c-termsize) 1))) ; -1 for command bar	Err	bitreich.org	70
i-	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-                  (formatted-output 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 'bg-black)	Err	bitreich.org	70
i-                            (get-color 'reset))	Err	bitreich.org	70
i-                    (force-output)	Err	bitreich.org	70
i-                    (let ((first-input (read-char *standard-input* nil nil t)))	Err	bitreich.org	70
i-                      (cond	Err	bitreich.org	70
i-                       ((not first-input)	Err	bitreich.org	70
i-                        (format t "~%") ;; display a newline	Err	bitreich.org	70
i-                        (setf input "x") ;; we exit	Err	bitreich.org	70
i-                        (loop-finish))	Err	bitreich.org	70
i-                       ((char= #\NewLine first-input)	Err	bitreich.org	70
i-                        ;; we hide previous line (prompt)	Err	bitreich.org	70
i-                        (format t "'~C[A~C[K~C" #\Escape #\Escape #\return))	Err	bitreich.org	70
i-                       (t	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-      ;; 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-           (format t "~a~%" line))))	Err	bitreich.org	70
i+           (formatted-output 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 'bg-black)	Err	bitreich.org	70
i+                     (get-color 'reset))	Err	bitreich.org	70
i+             (force-output)	Err	bitreich.org	70
i+             (let ((first-input (read-char *standard-input* nil nil t)))	Err	bitreich.org	70
i+               (cond	Err	bitreich.org	70
i+                 ((not first-input)	Err	bitreich.org	70
i+                  (format t "~%") ;; display a newline	Err	bitreich.org	70
i+                  (setf input "x") ;; we exit	Err	bitreich.org	70
i+                  (loop-finish))	Err	bitreich.org	70
i+                 ((char= #\NewLine first-input)	Err	bitreich.org	70
i+                  ;; we hide previous line (prompt)	Err	bitreich.org	70
i+                  (format t "'~C[A~C[K~C" #\Escape #\Escape #\return))	Err	bitreich.org	70
i+                 (t	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+(defun pipe-text(host port uri)	Err	bitreich.org	70
i+  (getpage host port uri)	Err	bitreich.org	70
i+  (loop for line across *buffer*	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+(defun pipe-binary(host port uri)	Err	bitreich.org	70
i+  (easy-socket	Err	bitreich.org	70
i+   (format stream "~a~a~a" uri #\Return #\Newline)	Err	bitreich.org	70
i+   (force-output stream)	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-  (cond	Err	bitreich.org	70
i+   ;; write to the standard output	Err	bitreich.org	70
i+   (let ((buf (make-array 4096 :element-type '(unsigned-byte 8))))	Err	bitreich.org	70
i+     (loop for pos = (read-sequence buf stream)	Err	bitreich.org	70
i+        while (plusp pos)	Err	bitreich.org	70
i+        do	Err	bitreich.org	70
i+          (write-sequence buf *standard-output* :end pos)))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-    ;; we retrieve text / lines	Err	bitreich.org	70
i-    ;; when type is 1 or 0	Err	bitreich.org	70
i-    ((or	Err	bitreich.org	70
i-      (string= "1" (location-type destination))	Err	bitreich.org	70
i-      (string= "0" (location-type destination)))	Err	bitreich.org	70
i-  	Err	bitreich.org	70
i-     (getpage (location-host destination)	Err	bitreich.org	70
i-              (location-port destination)	Err	bitreich.org	70
i-              (location-uri  destination)))	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-    ((string= "7" (location-type destination))	Err	bitreich.org	70
i-     (getpage (location-host destination)	Err	bitreich.org	70
i-              (location-port destination)	Err	bitreich.org	70
i-              (location-uri  destination)	Err	bitreich.org	70
i-              nil t))	Err	bitreich.org	70
i+(defun pipe-to-stdout(destination)	Err	bitreich.org	70
i+  "fetch data and output to stdout without storing anything"	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+  (if (or	Err	bitreich.org	70
i+       (string= "0" (location-type destination))	Err	bitreich.org	70
i+       (string= "1" (location-type destination))	Err	bitreich.org	70
i+       (string= "7" (location-type destination)))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+      (pipe-text (location-host destination)	Err	bitreich.org	70
i+                 (location-port destination)	Err	bitreich.org	70
i+                 (location-uri  destination))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+      (pipe-binary (location-host destination)	Err	bitreich.org	70
i+                   (location-port destination)	Err	bitreich.org	70
i+                   (location-uri  destination))))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+(defun visit(destination)	Err	bitreich.org	70
i+  "fetch and display content interactively"	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+  (let ((type	Err	bitreich.org	70
i+         (cond	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+           ;; fetch a menu	Err	bitreich.org	70
i+           ((string= "1" (location-type destination))	Err	bitreich.org	70
i+            (getpage (location-host destination)	Err	bitreich.org	70
i+                     (location-port destination)	Err	bitreich.org	70
i+                     (location-uri  destination))	Err	bitreich.org	70
i+            'menu)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+           ;; fetch a text file	Err	bitreich.org	70
i+           ((string= "0" (location-type destination))	Err	bitreich.org	70
i+            (getpage (location-host destination)	Err	bitreich.org	70
i+                     (location-port destination)	Err	bitreich.org	70
i+                     (location-uri  destination))	Err	bitreich.org	70
i+            'text)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+           ;; fetch a menu after search	Err	bitreich.org	70
i+           ((string= "7" (location-type destination))	Err	bitreich.org	70
i+            (format t "Input : ")	Err	bitreich.org	70
i+            (let ((user-input (read-line nil nil)))	Err	bitreich.org	70
i+              (getpage (location-host destination)	Err	bitreich.org	70
i+                       (location-port destination)	Err	bitreich.org	70
i+                       (location-uri  destination)	Err	bitreich.org	70
i+                       user-input))	Err	bitreich.org	70
i+            'menu)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+           ;; if not type 0 1 7 then it's binary	Err	bitreich.org	70
i+           (t	Err	bitreich.org	70
i+            (download-binary (location-host destination)	Err	bitreich.org	70
i+                             (location-port destination)	Err	bitreich.org	70
i+                             (location-uri destination))	Err	bitreich.org	70
i+            'binary))))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+    ;; we reset the links table ONLY if we have a new menu	Err	bitreich.org	70
i+    ;; we also keep the last menu buffer	Err	bitreich.org	70
i+    (when (eql type 'menu)	Err	bitreich.org	70
i+      (setf *previous-buffer* (copy-array *buffer*))	Err	bitreich.org	70
i+      (setf *links* (make-hash-table)))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+    ;; add it to the history !	Err	bitreich.org	70
i+    (push destination *history*)	Err	bitreich.org	70
i+	Err	bitreich.org	70
i+    (if (eql type 'menu)	Err	bitreich.org	70
i+        (display-interactive-menu)	Err	bitreich.org	70
i+        (progn	Err	bitreich.org	70
i+          (if (eql type 'text)	Err	bitreich.org	70
i+              (display-with-pager)	Err	bitreich.org	70
i+              (display-interactive-binary-file))	Err	bitreich.org	70
i+          ;; redraw last menu	Err	bitreich.org	70
i+          ;; we need to get previous buffer and reset links numbering	Err	bitreich.org	70
i+          (pop *history*)	Err	bitreich.org	70
i+          (when *previous-buffer*	Err	bitreich.org	70
i+            (setf *buffer* (copy-array *previous-buffer*))	Err	bitreich.org	70
i+            (setf *links* (make-hash-table))	Err	bitreich.org	70
i+            (display-interactive-menu))))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-    (t	Err	bitreich.org	70
i-     (getpage (location-host destination)	Err	bitreich.org	70
i-              (location-port destination)	Err	bitreich.org	70
i-              (location-uri  destination)	Err	bitreich.org	70
i-              t)))	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-  ;; we reset the links table ONLY if we have a new folder	Err	bitreich.org	70
i-  ;; we also keep the last menu buffer	Err	bitreich.org	70
i-  (when (string= "1" (location-type destination))	Err	bitreich.org	70
i-    (setf *previous-buffer* (copy-array *buffer*))	Err	bitreich.org	70
i-    (setf *links* (make-hash-table)))	Err	bitreich.org	70
i-  	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 (defun display-prompt()	Err	bitreich.org	70
i   (let ((last-page (car *history*)))	Err	bitreich.org	70
i@@ -664,37 +689,44 @@	Err	bitreich.org	70
i 	Err	bitreich.org	70
i   ;; we loop until X or Q is typed	Err	bitreich.org	70
i   (loop for input = (format nil "~a" (read-line nil nil))	Err	bitreich.org	70
i-        while (not (or	Err	bitreich.org	70
i-                    (string= "NIL" input) ;; ^D	Err	bitreich.org	70
i-                    (string= "exit" input)	Err	bitreich.org	70
i-                    (string= "x" input)	Err	bitreich.org	70
i-                    (string= "q" input)))	Err	bitreich.org	70
i-        do	Err	bitreich.org	70
i-        (when (eq 'end (user-input input))	Err	bitreich.org	70
i-          (loop-finish))	Err	bitreich.org	70
i-        (display-prompt)))	Err	bitreich.org	70
i+     while (not (or	Err	bitreich.org	70
i+                 (string= "NIL" input) ;; ^D	Err	bitreich.org	70
i+                 (string= "exit" input)	Err	bitreich.org	70
i+                 (string= "x" input)	Err	bitreich.org	70
i+                 (string= "q" input)))	Err	bitreich.org	70
i+     do	Err	bitreich.org	70
i+       (when (eq 'end (user-input input))	Err	bitreich.org	70
i+         (loop-finish))	Err	bitreich.org	70
i+       (display-prompt)))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i (defun main()	Err	bitreich.org	70
i-  "fetch argument, display page and go to shell if type is 1"	Err	bitreich.org	70
i+  "entry function of clic, we need to determine if the usage is one of	Err	bitreich.org	70
i+  the 3 following cases : interactive, not interactive or	Err	bitreich.org	70
i+  piped. Interactive is the state where the user will browse clic for	Err	bitreich.org	70
i+  multiple content. Not interactive is the case where clic is called	Err	bitreich.org	70
i+  with a parameter not of type 1, so it will fetch the content,	Err	bitreich.org	70
i+  display it and exit and finally, the redirected case where clic will	Err	bitreich.org	70
i+  print to stdout and exit."	Err	bitreich.org	70
i   (let ((destination	Err	bitreich.org	70
i          (let ((argv (get-argv)))	Err	bitreich.org	70
i+           ;; parsing command line parameter	Err	bitreich.org	70
i+           ;; if not empty we use it or we will use a default url	Err	bitreich.org	70
i            (if argv	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 "gopherproject.org" :port 70 :uri "/" :type "1")))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-    ;; if we don't ask a menu, not going interactive	Err	bitreich.org	70
i-    (if (not (string= "1" (location-type destination)))	Err	bitreich.org	70
i-        ;; not interactive	Err	bitreich.org	70
i-        (visit destination)	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-        ;; we continue to the shell if we are in a terminal	Err	bitreich.org	70
i-        (when (ttyp)	Err	bitreich.org	70
i-          (shell))))))	Err	bitreich.org	70
i+    ;; is there an output redirection ?	Err	bitreich.org	70
i+    (if (ttyp)	Err	bitreich.org	70
i+        ;; if we don't ask a menu, not going interactive	Err	bitreich.org	70
i+        (if (not (string= "1" (location-type destination)))	Err	bitreich.org	70
i+            ;; not interactive	Err	bitreich.org	70
i+            (visit destination)	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+              ;; we continue to the shell if we are in a terminal	Err	bitreich.org	70
i+              (shell)))	Err	bitreich.org	70
i+        (pipe-to-stdout destination))))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i ;; we allow ecl to use a new kind of argument	Err	bitreich.org	70
i ;; not sure how it works but that works	Err	bitreich.org	70
.