iAdd support to html link - 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 efe07395e09bc6d6495dd651671c5d48e4a502ee /scm/clic/commit/efe07395e09bc6d6495dd651671c5d48e4a502ee.gph bitreich.org 70 1parent a331d51d084fea91b64c85500a458999fbab23a6 /scm/clic/commit/a331d51d084fea91b64c85500a458999fbab23a6.gph bitreich.org 70 hAuthor: Solene Rapenne URL:mailto:solene@perso.pw bitreich.org 70 iDate: Thu, 28 Dec 2017 16:04:47 +0100 Err bitreich.org 70 i Err bitreich.org 70 iAdd support to html link Err bitreich.org 70 i Err bitreich.org 70 iDiffstat: Err bitreich.org 70 i M clic.lisp | 31 ++++++++++++++++++++++--------- Err bitreich.org 70 i M make-binary.lisp | 1 + Err bitreich.org 70 i Err bitreich.org 70 i2 files changed, 23 insertions(+), 9 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,10 +1,12 @@ 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 (require 'sb-bsd-sockets) Err bitreich.org 70 i #+ecl Err bitreich.org 70 i (require 'sockets)) Err bitreich.org 70 i Err bitreich.org 70 i+ Err bitreich.org 70 i ;;;; C binding to get terminal informations Err bitreich.org 70 i ;;;; SBCL only Err bitreich.org 70 i #+sbcl Err bitreich.org 70 i@@ -38,7 +40,8 @@ Err bitreich.org 70 i ;;;; END C binding Err bitreich.org 70 i Err bitreich.org 70 i ;; structure to store links Err bitreich.org 70 i-(defstruct location host port type uri) Err bitreich.org 70 i+(defstruct location host port type uri Err bitreich.org 70 i+ :predicate) Err bitreich.org 70 i Err bitreich.org 70 i ;;;; BEGIN GLOBAL VARIABLES Err bitreich.org 70 i Err bitreich.org 70 i@@ -82,7 +85,7 @@ Err bitreich.org 70 i Err bitreich.org 70 i (defun get-color(name) (gethash name *colors*)) Err bitreich.org 70 i (add-color 'red 1 31) Err bitreich.org 70 i-(add-color 'white 0 70) Err bitreich.org 70 i+(add-color 'reset 0 70) Err bitreich.org 70 i (add-color 'bg-black 0 40) Err bitreich.org 70 i (add-color 'folder 4 34) Err bitreich.org 70 i (add-color 'green 1 32) Err bitreich.org 70 i@@ -101,9 +104,9 @@ Err bitreich.org 70 i t Err bitreich.org 70 i nil)) Err bitreich.org 70 i Err bitreich.org 70 i-(defun print-with-color(text &optional (color 'white) (line-number nil)) 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 'white))) 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 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@@ -209,9 +212,9 @@ 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- (print-with-color (concatenate 'string Err bitreich.org 70 i- text " " uri) Err bitreich.org 70 i- 'http "url"))) Err bitreich.org 70 i+ (setf (gethash line-number *links*) uri) Err bitreich.org 70 i+ (print-with-color text 'http line-number))) Err bitreich.org 70 i+ Err bitreich.org 70 i ;; unknown type Err bitreich.org 70 i (print-with-color (format nil Err bitreich.org 70 i "invalid type ~a : ~a" line-type text) Err bitreich.org 70 i@@ -252,7 +255,17 @@ 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- (visit destination)))) Err bitreich.org 70 i+ (print destination) Err bitreich.org 70 i+ (cond Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; visit a gopher link Err bitreich.org 70 i+ ((location-p destination) Err bitreich.org 70 i+ (visit destination)) Err bitreich.org 70 i+ Err bitreich.org 70 i+ ;; visit http link Err bitreich.org 70 i+ ((search "URL:" destination) Err bitreich.org 70 i+ (uiop:run-program (list "xdg-open" Err bitreich.org 70 i+ (subseq destination 4)))))))) Err bitreich.org 70 i Err bitreich.org 70 i (defun p() Err bitreich.org 70 i "browse to the previous link" Err bitreich.org 70 i@@ -431,7 +444,7 @@ 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 'white)) 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))) Err bitreich.org 70 i (when (not (char= #\NewLine first-input)) Err bitreich.org 70 1diff --git a/make-binary.lisp b/make-binary.lisp /scm/clic/file/make-binary.lisp.gph bitreich.org 70 i@@ -1,6 +1,7 @@ Err bitreich.org 70 i ;; ecl produces a linked binary to ecl shared library Err bitreich.org 70 i ;; sbcl produces a static binary (~ 10Mb with compression / 70Mb without) Err bitreich.org 70 i Err bitreich.org 70 i+(require 'asdf) Err bitreich.org 70 i #+ecl Err bitreich.org 70 i (require 'cmp) Err bitreich.org 70 i #+ecl Err bitreich.org 70 .