--- a/src/build.lisp Wed May 02 23:17:16 2018 -0400
+++ b/src/build.lisp Thu May 03 23:42:55 2018 -0400
@@ -1,3 +1,6 @@
(ql:quickload :brows)
-(asdf:make :brows)
+(setf deploy:*status-output* nil)
+
+(let ((deploy:*status-output* t))
+ (asdf:make :brows :force t))
--- a/src/main.lisp Wed May 02 23:17:16 2018 -0400
+++ b/src/main.lisp Thu May 03 23:42:55 2018 -0400
@@ -1,4 +1,74 @@
(in-package :brows)
+
+
+(defparameter *regex*
+ (concatenate
+ 'string
+ "(((http|https|ftp|gopher)|mailto):(//)?[^ <>\"\\t]*|(www|ftp)[0-9]?\\.[-a-z0-9.]+)"
+ "[^ .,;\\t\\n\\r<\">\\):]?[^, <>\"\\t]*[^ .,;\\t\\n\\r<\">\\):]"))
+
+(defparameter *urls* nil)
+(defparameter *pos* 0)
+
+
+(defun find-urls (string)
+ (-<> string
+ (ppcre:all-matches-as-strings *regex* <> :sharedp t)
+ (remove-duplicates <> :test #'string-equal)
+ (coerce <> 'vector)))
+
+(defun read-standard-input-into-string ()
+ (with-output-to-string (result)
+ (let* ((buffer-size 4096)
+ (buffer (make-array buffer-size :element-type 'character)))
+ (iterate
+ (for bytes-read = (read-sequence buffer *standard-input*))
+ (write-sequence buffer result :start 0 :end bytes-read)
+ (while (= bytes-read buffer-size))))))
+
+(defun incf-pos (delta)
+ (setf *pos* (clamp 0 (1- (length *urls*))
+ (+ *pos* delta))))
+
+(defun read-input (path)
+ (if (equal "-" path)
+ (read-standard-input-into-string)
+ (read-file-into-string path)))
+
+(defun process-input (input)
+ (find-urls input))
+
+(defun draw (canvas)
+ (boots:clear canvas)
+ (iterate (for row :from 0 :below (boots:height canvas))
+ (for url :in-vector *urls*)
+ (when (= row *pos*)
+ (boots:draw canvas row 0 "-> "))
+ (boots:draw canvas row 3 url)))
+
+(defun init ()
+ (setf *urls* (-<> "-"
+ read-input
+ process-input)))
+
+(defun main ()
+ (iterate
+ (boots:blit)
+ (case (boots:read-event)
+ ((#\Q #\q) (return-from main))
+ ((#\k :up) (incf-pos -1))
+ ((#\j :down) (incf-pos 1)))))
+
+(defmacro catch-and-spew-errors (&body body)
+ `(handler-case (progn ,@body)
+ (t (c) (format t "Error: ~A" c))))
+
(defun toplevel ()
- (princ "hello"))
+ (catch-and-spew-errors
+ (boots:with-boots (:fresh-tty t)
+ (boots:with-layer ()
+ (boots:canvas () #'draw)
+ (init)
+ (main)))))
+
--- a/vendor/make-quickutils.lisp Wed May 02 23:17:16 2018 -0400
+++ b/vendor/make-quickutils.lisp Thu May 03 23:42:55 2018 -0400
@@ -5,6 +5,7 @@
:utilities '(
:compose
+ :read-file-into-string
:curry
:once-only
:rcurry
--- a/vendor/quickutils.lisp Wed May 02 23:17:16 2018 -0400
+++ b/vendor/quickutils.lisp Thu May 03 23:42:55 2018 -0400
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "BROWS.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :READ-FILE-INTO-STRING :CURRY :ONCE-ONLY :RCURRY :SYMB :WITH-GENSYMS) :ensure-package T :package "BROWS.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "BROWS.QUICKUTILS")
@@ -14,7 +14,9 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :COMPOSE :CURRY :ONCE-ONLY :RCURRY
+ :COMPOSE :ONCE-ONLY :WITH-OPEN-FILE*
+ :WITH-INPUT-FROM-FILE
+ :READ-FILE-INTO-STRING :CURRY :RCURRY
:MKSTR :SYMB :STRING-DESIGNATOR
:WITH-GENSYMS))))
(eval-when (:compile-toplevel :load-toplevel :execute)
@@ -70,26 +72,6 @@
,(compose-1 funs))))))
- (defun curry (function &rest arguments)
- "Returns a function that applies `arguments` and the arguments
-it is called with to `function`."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- ;; Using M-V-C we don't need to append the arguments.
- (multiple-value-call fn (values-list arguments) (values-list more)))))
-
- (define-compiler-macro curry (function &rest arguments)
- (let ((curries (make-gensym-list (length arguments) "CURRY"))
- (fun (gensym "FUN")))
- `(let ((,fun (ensure-function ,function))
- ,@(mapcar #'list curries arguments))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest more)
- (apply ,fun ,@curries more)))))
-
-
(defmacro once-only (specs &body forms)
"Evaluates `forms` with symbols specified in `specs` rebound to temporary
variables, ensuring that each initform is evaluated only once.
@@ -129,6 +111,78 @@
,@forms)))))
+ (defmacro with-open-file* ((stream filespec &key direction element-type
+ if-exists if-does-not-exist external-format)
+ &body body)
+ "Just like `with-open-file`, but `nil` values in the keyword arguments mean to use
+the default value specified for `open`."
+ (once-only (direction element-type if-exists if-does-not-exist external-format)
+ `(with-open-stream
+ (,stream (apply #'open ,filespec
+ (append
+ (when ,direction
+ (list :direction ,direction))
+ (when ,element-type
+ (list :element-type ,element-type))
+ (when ,if-exists
+ (list :if-exists ,if-exists))
+ (when ,if-does-not-exist
+ (list :if-does-not-exist ,if-does-not-exist))
+ (when ,external-format
+ (list :external-format ,external-format)))))
+ ,@body)))
+
+
+ (defmacro with-input-from-file ((stream-name file-name &rest args
+ &key (direction nil direction-p)
+ &allow-other-keys)
+ &body body)
+ "Evaluate `body` with `stream-name` to an input stream on the file
+`file-name`. `args` is sent as is to the call to `open` except `external-format`,
+which is only sent to `with-open-file` when it's not `nil`."
+ (declare (ignore direction))
+ (when direction-p
+ (error "Can't specifiy :DIRECTION for WITH-INPUT-FROM-FILE."))
+ `(with-open-file* (,stream-name ,file-name :direction :input ,@args)
+ ,@body))
+
+
+ (defun read-file-into-string (pathname &key (buffer-size 4096) external-format)
+ "Return the contents of the file denoted by `pathname` as a fresh string.
+
+The `external-format` parameter will be passed directly to `with-open-file`
+unless it's `nil`, which means the system default."
+ (with-input-from-file
+ (file-stream pathname :external-format external-format)
+ (let ((*print-pretty* nil))
+ (with-output-to-string (datum)
+ (let ((buffer (make-array buffer-size :element-type 'character)))
+ (loop
+ :for bytes-read = (read-sequence buffer file-stream)
+ :do (write-sequence buffer datum :start 0 :end bytes-read)
+ :while (= bytes-read buffer-size)))))))
+
+
+ (defun curry (function &rest arguments)
+ "Returns a function that applies `arguments` and the arguments
+it is called with to `function`."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (let ((fn (ensure-function function)))
+ (lambda (&rest more)
+ (declare (dynamic-extent more))
+ ;; Using M-V-C we don't need to append the arguments.
+ (multiple-value-call fn (values-list arguments) (values-list more)))))
+
+ (define-compiler-macro curry (function &rest arguments)
+ (let ((curries (make-gensym-list (length arguments) "CURRY"))
+ (fun (gensym "FUN")))
+ `(let ((,fun (ensure-function ,function))
+ ,@(mapcar #'list curries arguments))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest more)
+ (apply ,fun ,@curries more)))))
+
+
(defun rcurry (function &rest arguments)
"Returns a function that applies the arguments it is called
with and `arguments` to `function`."
@@ -200,6 +254,7 @@
`(with-gensyms ,names ,@forms))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose curry once-only rcurry symb with-gensyms with-unique-names)))
+ (export '(compose read-file-into-string curry once-only rcurry symb
+ with-gensyms with-unique-names)))
;;;; END OF quickutils.lisp ;;;;