Type I is now supported - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
(DIR) commit f7e9f10ff74b617b12c066771b8637a9abfdc2be
(DIR) parent a14e99ad9030bfb5141e762542098fe8ea902363
(HTM) Author: Solene Rapenne <solene@perso.pw>
Date: Thu, 28 Dec 2017 18:54:24 +0100
Type I is now supported
Diffstat:
M clic.lisp | 109 +++++++++++++++++++++++--------
1 file changed, 82 insertions(+), 27 deletions(-)
---
(DIR) diff --git a/clic.lisp b/clic.lisp
@@ -1,4 +1,4 @@
-;;;; let's hide the loading
+;;; let's hide the loading
(let ((*standard-output* (make-broadcast-stream)))
(require 'asdf)
#+sbcl
@@ -19,7 +19,6 @@
"return terminal height"
(sb-alien:with-alien ((res unsigned-int (getTerminalHeight))))))
-
#+ecl
(progn
(ffi:clines "
@@ -106,6 +105,16 @@
t
nil))
+(defun copy-array(from)
+ (let ((dest (make-array 200
+ :fill-pointer 0
+ :initial-element nil
+ :adjustable t)))
+ (loop for element across from
+ do
+ (vector-push element dest))
+ dest))
+
(defun print-with-color(text &optional (color 'reset) (line-number nil))
"Used to display a line with a color"
(format t "~3A| ~a~a~a~%" (if line-number line-number "") (get-color color) text (get-color 'reset)))
@@ -194,7 +203,7 @@
;; 9 Binary
(check "9"
- (print-with-color "selector 9 not implemented" 'red))
+ (print-with-color text 'red line-number))
;; + redundant server
(check "+"
@@ -210,7 +219,9 @@
;; I image
(check "I"
- (print-with-color "selector I not implemented" 'red))
+ (setf (gethash line-number *links*)
+ (make-location :host host :port port :uri uri :type line-type ))
+ (print-with-color text 'red line-number))
;; h http link
(check "h"
@@ -222,7 +233,7 @@
"invalid type ~a : ~a" line-type text)
'red))))))
-(defun getpage(host port uri)
+(defun getpage(host port uri &optional (binary nil))
"connect and display"
;; we reset the buffer
@@ -240,27 +251,41 @@
(sb-bsd-sockets:socket-connect socket host port)
;; we open a stream for input/output
- (let ((stream (sb-bsd-sockets:socket-make-stream socket :input t :output t)))
+ (let ((stream (sb-bsd-sockets:socket-make-stream socket
+ :input t
+ :output t
+ :element-type :default)))
- ;; sending the request here
- ;; if the selector is 1 we omit it
+ ;; sending the request to the server
(format stream "~a~%" uri)
(force-output stream)
- ;; save current buffer to display it back if needed
- (setf *previous-buffer* *buffer*)
-
- ;; for each line we receive we display it
- (loop for line = (read-line stream nil nil)
- while line
- do
- (vector-push line *buffer*)))))
+ (if binary
+ ;; binary
+ ;; save into a file in $PWD
+ (with-open-file (output (subseq uri (1+ (position #\/ uri :from-end t)))
+ :element-type '(unsigned-byte 8)
+ :direction :output :if-exists :supersede)
+ (let ((buf (make-array 4096 :element-type '(unsigned-byte 8))))
+ (loop for pos = (read-sequence buf stream)
+ while (plusp pos)
+ do
+ (write-sequence buf output :end pos))))
+
+ ;; not binary
+ ;; for each line we receive we store it in *buffer*
+ (loop for line = (read-line stream nil nil)
+ while line
+ do
+ (vector-push line *buffer*))))))
(defun g(key)
"browse to the N-th link"
(let ((destination (gethash key *links*)))
(when destination
+
(cond
+
;; visit a gopher link (type 0 or 1)
((location-p destination)
(visit destination))
@@ -430,7 +455,6 @@
;;;; output is a text file ?
;;;; call the $PAGER !
((string= "0" type)
- (pop *history*) ;; it's not a menu, we need to remove it from history
;;; generate a string from *buffer* array
(let ((text (string-right-trim ; remove last newline
(string #\Newline)
@@ -439,16 +463,30 @@
collect line)))))
;; create input stream used as stdin for $PAGER
(let ((input (make-string-input-stream text)))
- (uiop:run-program (list #+ecl
- (si:getenv "PAGER")
- #+sbcl
- (sb-unix::posix-getenv "PAGER"))
+ (uiop:run-program (list (uiop:getenv "PAGER"))
:input input
:output :interactive))
;; display last menu
- (setf *buffer* *previous-buffer*)
+ (pop *history*)
+ (setf *buffer* (copy-array *previous-buffer*))
+ (setf *links* (make-hash-table))
(display-buffer "1")))
+ ;; image
+ ((string= "I" type)
+ (let ((location (car *history*)))
+ (uiop:run-program (list "xdg-open"
+ (subseq ;; get the text after last /
+ (location-uri location)
+ (1+ (position #\/
+ (location-uri location)
+ :from-end t))))))
+ (pop *history*)
+ (setf *buffer* (copy-array *previous-buffer*))
+ (setf *links* (make-hash-table))
+ (display-buffer "1"))
+
+
;;;; output is a menu ?
;;;; display the menu and split it in pages if needed
((string= "1" type)
@@ -494,17 +532,34 @@
(defun visit(destination)
"visit a location"
- (getpage (location-host destination)
- (location-port destination)
- (location-uri destination))
+ (cond
+
+ ;; we retrieve text / lines
+ ;; when type is 1 or 0
+ ((or
+ (string= "1" (location-type destination))
+ (string= "0" (location-type destination)))
+
+ (getpage (location-host destination)
+ (location-port destination)
+ (location-uri destination)))
+
+ (t
+ (getpage (location-host destination)
+ (location-port destination)
+ (location-uri destination)
+ t)))
+
;; we reset the links table ONLY if we have a new folder
+ ;; we also keep the last menu buffer
(when (string= "1" (location-type destination))
+ (setf *previous-buffer* (copy-array *buffer*))
(setf *links* (make-hash-table)))
-
+
;; goes to the history !
(push destination *history*)
-
+
(when *offline*
(let ((path (concatenate 'string
"history/" (location-host destination)