iType I is now supported - 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 f7e9f10ff74b617b12c066771b8637a9abfdc2be	/scm/clic/commit/f7e9f10ff74b617b12c066771b8637a9abfdc2be.gph	bitreich.org	70
1parent a14e99ad9030bfb5141e762542098fe8ea902363	/scm/clic/commit/a14e99ad9030bfb5141e762542098fe8ea902363.gph	bitreich.org	70
hAuthor: Solene Rapenne <solene@perso.pw>	URL:mailto:solene@perso.pw	bitreich.org	70
iDate:   Thu, 28 Dec 2017 18:54:24 +0100	Err	bitreich.org	70
i	Err	bitreich.org	70
iType I is now supported	Err	bitreich.org	70
i	Err	bitreich.org	70
iDiffstat:	Err	bitreich.org	70
i  M clic.lisp                           |     109 +++++++++++++++++++++++--------	Err	bitreich.org	70
i	Err	bitreich.org	70
i1 file changed, 82 insertions(+), 27 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@@ -1,4 +1,4 @@	Err	bitreich.org	70
i-;;;; let's hide the loading	Err	bitreich.org	70
i+;;; let's hide the loading	Err	bitreich.org	70
i (let ((*standard-output* (make-broadcast-stream)))	Err	bitreich.org	70
i   (require 'asdf)	Err	bitreich.org	70
i   #+sbcl	Err	bitreich.org	70
i@@ -19,7 +19,6 @@	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@@ -106,6 +105,16 @@	Err	bitreich.org	70
i       t	Err	bitreich.org	70
i       nil))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i+(defun copy-array(from)	Err	bitreich.org	70
i+  (let ((dest (make-array 200	Err	bitreich.org	70
i+                          :fill-pointer 0	Err	bitreich.org	70
i+                          :initial-element nil	Err	bitreich.org	70
i+                          :adjustable t)))	Err	bitreich.org	70
i+    (loop for element across from	Err	bitreich.org	70
i+       do	Err	bitreich.org	70
i+         (vector-push element dest))	Err	bitreich.org	70
i+    dest))	Err	bitreich.org	70
i+	Err	bitreich.org	70
i (defun print-with-color(text &optional (color 'reset) (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 'reset)))	Err	bitreich.org	70
i@@ -194,7 +203,7 @@	Err	bitreich.org	70
i 	Err	bitreich.org	70
i               ;; 9 Binary	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+                     (print-with-color text 'red line-number))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i               ;; + redundant server	Err	bitreich.org	70
i               (check "+"	Err	bitreich.org	70
i@@ -210,7 +219,9 @@	Err	bitreich.org	70
i 	Err	bitreich.org	70
i               ;; I image	Err	bitreich.org	70
i               (check "I"	Err	bitreich.org	70
i-                     (print-with-color "selector I not implemented" 'red))	Err	bitreich.org	70
i+                     (setf (gethash line-number *links*)	Err	bitreich.org	70
i+                           (make-location :host host :port port :uri uri :type line-type ))	Err	bitreich.org	70
i+                     (print-with-color text 'red line-number))	Err	bitreich.org	70
i 	Err	bitreich.org	70
i               ;; h http link	Err	bitreich.org	70
i               (check "h"	Err	bitreich.org	70
i@@ -222,7 +233,7 @@	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)	Err	bitreich.org	70
i+(defun getpage(host port uri &optional (binary nil))	Err	bitreich.org	70
i   "connect and display"	Err	bitreich.org	70
i 	Err	bitreich.org	70
i   ;; we reset the buffer	Err	bitreich.org	70
i@@ -240,27 +251,41 @@	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 :input t :output t)))	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 	Err	bitreich.org	70
i-      ;; sending the request here	Err	bitreich.org	70
i-      ;; if the selector is 1 we omit it	Err	bitreich.org	70
i+      ;; sending the request to the server	Err	bitreich.org	70
i       (format stream "~a~%" uri)	Err	bitreich.org	70
i       (force-output stream)	Err	bitreich.org	70
i 	Err	bitreich.org	70
i-      ;; save current buffer to display it back if needed	Err	bitreich.org	70
i-      (setf *previous-buffer* *buffer*)	Err	bitreich.org	70
i-	Err	bitreich.org	70
i-      ;; for each line we receive we display it	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+      (if binary	Err	bitreich.org	70
i+          ;; binary	Err	bitreich.org	70
i+          ;; save into a file in $PWD	Err	bitreich.org	70
i+          (with-open-file (output (subseq uri (1+ (position #\/ uri :from-end t)))	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+                   (write-sequence buf output :end pos))))	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 (defun g(key)	Err	bitreich.org	70
i   "browse to the N-th link"	Err	bitreich.org	70
i   (let ((destination (gethash key *links*)))	Err	bitreich.org	70
i     (when destination	Err	bitreich.org	70
i+	Err	bitreich.org	70
i       (cond	Err	bitreich.org	70
i+	Err	bitreich.org	70
i         ;; visit a gopher link (type 0 or 1)	Err	bitreich.org	70
i         ((location-p destination)	Err	bitreich.org	70
i          (visit destination))	Err	bitreich.org	70
i@@ -430,7 +455,6 @@	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-         (pop *history*) ;; it's not a menu, we need to remove it from history	Err	bitreich.org	70
i          ;;; generate a string from *buffer* array	Err	bitreich.org	70
i          (let ((text (string-right-trim ; remove last newline	Err	bitreich.org	70
i                       (string #\Newline)	Err	bitreich.org	70
i@@ -439,16 +463,30 @@	Err	bitreich.org	70
i                                  collect line)))))	Err	bitreich.org	70
i            ;; create input stream used as stdin for $PAGER	Err	bitreich.org	70
i            (let ((input (make-string-input-stream text)))	Err	bitreich.org	70
i-             (uiop:run-program (list #+ecl	Err	bitreich.org	70
i-                                     (si:getenv "PAGER")	Err	bitreich.org	70
i-                                     #+sbcl	Err	bitreich.org	70
i-                                     (sb-unix::posix-getenv "PAGER"))	Err	bitreich.org	70
i+             (uiop:run-program (list (uiop:getenv "PAGER"))	Err	bitreich.org	70
i                                :input input	Err	bitreich.org	70
i                                :output :interactive))	Err	bitreich.org	70
i            ;; display last menu	Err	bitreich.org	70
i-           (setf *buffer* *previous-buffer*)	Err	bitreich.org	70
i+           (pop *history*)	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+        ((string= "I" 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+                                   (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+         (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         ((string= "1" type)	Err	bitreich.org	70
i@@ -494,17 +532,34 @@	Err	bitreich.org	70
i (defun visit(destination)	Err	bitreich.org	70
i   "visit a location"	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+  (cond	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+    (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+  	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+  	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
.