# HG changeset patch # User Steve Losh # Date 1525405375 14400 # Node ID 06972f89d2201d4157467a21c8520ed9cc156edf # Parent 6d47b460c878d87c465b2439bbb2a8a5e8e1ef83 Get something displaying diff -r 6d47b460c878 -r 06972f89d220 src/build.lisp --- 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)) diff -r 6d47b460c878 -r 06972f89d220 src/main.lisp --- 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))))) + diff -r 6d47b460c878 -r 06972f89d220 vendor/make-quickutils.lisp --- 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 diff -r 6d47b460c878 -r 06972f89d220 vendor/quickutils.lisp --- 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 ;;;;