commit cb7a05e3d9dc9bb1f7c4f894282857ca75efabd0 Solene Rapenne <solene@perso.pw> 2017-11-11 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...
Makefile | 10 ++- TODO | 5 +- clic.lisp | 264 ++++++++++++++++++++++++++++++++++--------------------- extension.c | 8 ++ make-binary.lisp | 8 +- test.lisp | 2 + 6 files changed, 189 insertions(+), 108 deletions(-)
diff --git a/Makefile b/Makefile index 3ad30a1..1a0990f 100644 --- 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} diff --git a/TODO b/TODO index fcbfef0..6f0c7d9 100644 --- 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 diff --git a/clic.lisp b/clic.lisp index 2566017..9ed8d25 100644 --- 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 diff --git a/extension.c b/extension.c new file mode 100644 index 0000000..9c4c57a --- /dev/null +++ b/extension.c @@ -0,0 +1,8 @@ +#include <sys/ioctl.h> + +int termsize() +{ + struct winsize w; + ioctl(0,TIOCGWINSZ, &w); + return(w.ws_row); +} diff --git a/make-binary.lisp b/make-binary.lisp index 0154d42..25bf46c 100644 --- 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)~%") diff --git a/test.lisp b/test.lisp index 424edc6..1f97d57 100644 --- 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 "~%")