This is a major rework. - clic - Clic is an command line interactive client for gopher written in Common LISP
HTML git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
DIR Log
DIR Files
DIR Refs
DIR Tags
DIR README
DIR LICENSE
---
DIR commit cb7a05e3d9dc9bb1f7c4f894282857ca75efabd0
DIR parent 76bab87e5cb9401fcc55750cb1f720acc5123339
HTML Author: Solene Rapenne <solene@perso.pw>
Date: Sat, 11 Nov 2017 00:30:27 +0000
This is a major rework.
- Sbcl now use a link to "extension.so" to get information about the height of the terminal, ecl default to a hardcoded value.
- Response from server is now buffered instead of being displayed for each line received
- when the display is more than the terminal height, break display loop
- output to file is broken because it currently ask to display next page...
Diffstat:
M Makefile | 10 +++++++---
M TODO | 5 +++--
M clic.lisp | 264 +++++++++++++++++++------------
A extension.c | 8 ++++++++
M make-binary.lisp | 8 ++++++--
M test.lisp | 2 ++
6 files changed, 189 insertions(+), 108 deletions(-)
---
DIR diff --git a/Makefile b/Makefile
@@ -10,12 +10,16 @@ MANDIR = ${PREFIX}/share/man/man1
all: ${BIN}
-${BIN}: clic.lisp
+${BIN}: clic.lisp make-binary.lisp
${LISP} --load make-binary.lisp
-standalone: clic.lisp
+standalone: clic.lisp extension make-binary.lisp
${MAKE} -e LISP=sbcl
+extension: extension.c
+ cc -fPIC -c extension.c
+ ld -shared -o extension.so extension.o
+
install: ${BIN}
@echo installing executable to "${DESTDIR}${PREFIX}/bin"
@mkdir -p "${DESTDIR}${BINDIR}"
@@ -27,7 +31,7 @@ uninstall:
@rm -f "${DESTDIR}${BINDIR}/${BIN}"
clean:
- rm -f "${BIN}" clic.o clic.eclh clic.cxx bookmark-test
+ rm -f "${BIN}" clic.o clic.eclh clic.cxx bookmark-test extension.so
test: clean all
@sh run-test.sh ${LISP}
DIR diff --git a/TODO b/TODO
@@ -8,6 +8,7 @@
* CODE
-- TODO find a better color scheme
+- TODO remove the pagination if using stdout or not in shell
+- TODO make the c-termsize working on ecl
- DONE use CLOS to store data
-- TODO store the whole page and deal with it later (but not if it's not a 0 or 1 type)
+- DONE store the whole page and deal with it later
DIR diff --git a/clic.lisp b/clic.lisp
@@ -5,11 +5,32 @@
#+ecl
(require 'sockets))
+;;;; C binding to get terminal informations
+;;;; SBCL only
+#+sbcl
+(progn
+ (load-shared-object "./extension.so")
+ (declaim (inline termsize))
+ (sb-alien:define-alien-routine "termsize" int)
+ (defun c-termsize ()
+ "return terminal height"
+ (sb-alien:with-alien ((res int (termsize))))))
+
+#+ecl
+(progn
+ "we don't do C binding with ecl"
+ (defun c-termsize()
+ 40))
+;;;; END C binding
+
;; structure to store links
(defstruct location host port type uri)
;;;; BEGIN GLOBAL VARIABLES
+;;; array of lines in buffer
+(defparameter *buffer* nil)
+
;;; a list containing the last viewed pages
(defparameter *history* '())
@@ -82,7 +103,7 @@
"Used to display gopher response with color one line at a time"
(let ((line-type (subseq line 0 1))
(infos (split (subseq line 1) #\Tab)))
-
+
;; see RFC 1436
;; section 3.8
(when (and
@@ -156,72 +177,40 @@
;; I image
(check "I" 'unimplemented)))))
-(defun getpage(host port uri &optional (type "1"))
+
+(defun getpage(host port uri)
"connect and display"
+
+ ;; we reset the buffer
+ (setf *buffer*
+ (make-array 200
+ :fill-pointer 0
+ :initial-element nil
+ :adjustable t))
- (let ((here (make-location :host host :port port :uri uri :type type)))
-
- ;; goes to the history !
- (push here *history*)
+ ;; we prepare informations about the connection
+ (let* ((address (sb-bsd-sockets:get-host-by-name host))
+ (host (car (sb-bsd-sockets:host-ent-addresses address)))
+ (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
- ;; we reset the links table ONLY if we have a new folder
- (when (string= "1" type)
- (setf *links* (make-hash-table)))
-
- (when *offline*
- (ensure-directories-exist (concatenate 'string
- "history/"
- (location-host here)
- "/"
- (location-uri here)
- "/")))
-
+ (sb-bsd-sockets:socket-connect socket host port)
- ;; we prepare informations about the connection
- (let* ((address (sb-bsd-sockets:get-host-by-name host))
- (host (car (sb-bsd-sockets:host-ent-addresses address)))
- (socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)))
+ ;; we open a stream for input/output
+ (let ((stream (sb-bsd-sockets:socket-make-stream socket :input t :output t)))
- (sb-bsd-sockets:socket-connect socket host port)
+ ;; sending the request here
+ ;; if the selector is 1 we omit it
+ (format stream "~a~%" uri)
+ (force-output stream)
- ;; we open a stream for input/output
- (let ((stream (sb-bsd-sockets:socket-make-stream socket :input t :output t)))
-
- ;; sending the request here
- ;; if the selector is 1 we omit it
- (format stream "~a~%" uri)
- (force-output stream)
-
- (let ((save-offline (if *offline*
- (open (concatenate 'string
- "history/"
- (location-host here)
- "/"
- (location-uri here)
- (location-type here))
- :direction :output
- :if-does-not-exist :create
- :if-exists :supersede)
- nil)))
-
- ;; for each line we receive we display it
- (loop for line = (read-line stream nil nil)
- while line do
- (when save-offline
- (format save-offline "~a~%" line))
- (cond
- ((string= "1" type)
- (formatted-output line))
- ((string= "0" type)
- (format t "~a~%" line))))
- (and save-offline (close save-offline)))))))
+ ;; for each line we receive we display it
+ (loop for line = (read-line stream nil nil)
+ while line
+ do
+ (vector-push line *buffer*)))))
+
+
-(defun visit(destination)
- "visit a location"
- (getpage (location-host destination)
- (location-port destination)
- (location-uri destination)
- (location-type destination)))
(defun g(key)
"browse to the N-th link"
@@ -271,7 +260,6 @@
(location-type bookmark)
(location-uri bookmark))
'file line-number))))
-
(defun help-shell()
"show help for the shell"
(format t "number : go to link n~%")
@@ -282,47 +270,7 @@
(format t "help : show this help~%")
(format t "x or q : exit the shell, go back to REPL~%"))
-(defun shell()
- "Shell for user interaction"
- (format t "clic => ")
- (force-output)
- ;; we loop until X or Q is typed
- (loop for user-input = (format nil "~a" (read nil nil))
- while (not (or
- (string= "X" user-input)
- (string= "Q" user-input)))
- do
- (cond
-
- ;; show help
- ((string= "HELP" user-input)
- (help-shell))
-
- ;; bookmark current link
- ((string= "A" user-input)
- (add-bookmark))
-
- ;; show bookmarks
- ((string= "B" user-input)
- (show-bookmarks))
-
- ;; go to previous page
- ((string= "P" user-input)
- (p))
-
- ;; show history
- ((string= "H" user-input)
- (format t "~{~a~%~}" *history*))
-
- ;; follow a link
- (t
- ;; we ignore error in case of bad input
- ;; just do nothing
- (ignore-errors
- (g (parse-integer user-input)))))
- (format t "clic => ")
- (force-output)))
(defun parse-url(url)
"parse a gopher url and return a location"
@@ -364,6 +312,120 @@
#+ecl
(car (last (cdr (si::command-args)))))
+
+
+(defun user-input(input)
+ (cond
+ ;; show help
+ ((string= "HELP" input)
+ (help-shell))
+
+ ;; bookmark current link
+ ((string= "A" input)
+ (add-bookmark))
+
+ ;; show bookmarks
+ ((string= "B" input)
+ (show-bookmarks))
+
+ ;; go to previous page
+ ((string= "P" input)
+ (p))
+
+ ;; exit
+ ((or (string= "X" input)
+ (string= "Q" input))
+ (quit))
+
+
+ ;; show history
+ ((string= "H" input)
+ (format t "~{~a~%~}" *history*))
+
+ ;; follow a link
+ (t
+ ;; we ignore error in case of bad input
+ ;; just do nothing
+ (ignore-errors
+ (g (parse-integer input))))))
+
+(defun display-buffer(type)
+ "display the buffer"
+ (let ((rows (c-termsize)))
+ (let ((input nil))
+ (loop for line across *buffer*
+ counting line into row
+ do
+ (when (= row (- rows 3)) ; -1 for text - 1 for input and -1 for can't remember
+ (setf row 0)
+ (format t "~a------- press enter to next or a shell command ---------~a~%"
+ (get-color 'cyan)
+ (get-color 'white))
+ (let ((first-input (read-char)))
+ (when (not (or (char= #\NewLine first-input)
+ (char= #\Space first-input)))
+ (unread-char first-input)
+ (let ((input-text (format nil "~a" (read))))
+ (setf input input-text)
+ (loop-finish)))))
+ (cond
+ ((string= "1" type)
+ (formatted-output line))
+ ((string= "0" type)
+ (format t "~a~%" line))))
+ (when input
+ (user-input input)))))
+
+(defun visit(destination)
+ "visit a location"
+
+ (getpage (location-host destination)
+ (location-port destination)
+ (location-uri destination))
+
+ ;; we reset the links table ONLY if we have a new folder
+ (when (string= "1" (location-type destination))
+ (setf *links* (make-hash-table)))
+
+ ;; goes to the history !
+ (push destination *history*)
+
+ (display-buffer (location-type destination))
+
+
+ (when *offline*
+ (let ((path (concatenate 'string
+ "history/" (location-host destination)
+ "/" (location-uri destination) "/")))
+ (ensure-directories-exist path)
+
+ (with-open-file
+ (save-offline (concatenate
+ 'string path (location-type destination))
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
+
+ (loop for line in *buffer*
+ while line
+ do
+ (format save-offline "~a~%" line))))))
+
+(defun shell()
+ "Shell for user interaction"
+ (format t "clic => ")
+ (force-output)
+
+ ;; we loop until X or Q is typed
+ (loop for input = (format nil "~a" (read nil nil))
+ while (not (or
+ (string= "X" input)
+ (string= "Q" input)))
+ do
+ (user-input input)
+ (format t "clic => ")
+ (force-output)))
+
(defun main()
"fetch argument, display page and go to shell if type is 1"
(let ((destination
DIR diff --git a/extension.c b/extension.c
@@ -0,0 +1,8 @@
+#include <sys/ioctl.h>
+
+int termsize()
+{
+ struct winsize w;
+ ioctl(0,TIOCGWINSZ, &w);
+ return(w.ws_row);
+}
DIR diff --git a/make-binary.lisp b/make-binary.lisp
@@ -14,10 +14,14 @@
(require 'sb-bsd-sockets)
(sb-ext:disable-debugger)
(load "clic.lisp")
+ #+sb-core-compression
+ (sb-ext:save-lisp-and-die "clic"
+ :executable t
+ :compression 5
+ :toplevel 'main)
+ #-sb-core-compression
(sb-ext:save-lisp-and-die "clic"
:executable t
- #+sb-core-compression
- (values :compression 5)
:toplevel 'main))
(format t "INFO => Compilation done (or at least it should)~%")
DIR diff --git a/test.lisp b/test.lisp
@@ -13,6 +13,7 @@
(g 1)
(add-bookmark)
(getpage "bitreich.org" 70 "/")
+(display-buffer "1")
(g 7) ;; going to radio
(g 1) ;; going back
(g 21) ;; banana !
@@ -25,6 +26,7 @@
(show-bookmarks)
(g 1)
+(print *links*)
(print *history*)
(format t "~%")