--- a/src/main.lisp Sat May 26 14:38:30 2018 -0400
+++ b/src/main.lisp Mon Apr 13 21:23:33 2020 -0400
@@ -23,26 +23,22 @@
(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 clamp (lo v hi)
+ (max lo (min hi v)))
-(defun quit (&optional code)
- #+sbcl (sb-ext:exit :code code)
- #+ccl (ccl:quit code)
- #+abcl (ext:quit :status code)
- #+ecl (ext:quit code)
- #-(or ccl sbcl ecl abcl)
- (error "QUIT not supported on this implementation"))
+(defun incf-pos (delta)
+ (setf *pos* (clamp 0 (+ *pos* delta) (1- (length *urls*)))))
;;;; Actions ------------------------------------------------------------------
-(defclass* (action :conc-name "") ()
- (tty keys thunk))
+(defclass action ()
+ ((tty :initarg :tty :accessor tty)
+ (keys :initarg :keys :accessor keys)
+ (thunk :initarg :thunk :accessor thunk)))
(defun create-action (thunk keys tty)
(let ((action (make-instance 'action :thunk thunk :keys keys :tty tty)))
- (dolist (key (ensure-list keys))
+ (dolist (key (alexandria:ensure-list keys))
(setf (gethash key *actions*) action))))
(defmacro define-action (keys program &key
@@ -56,57 +52,52 @@
,@(if tty
'(:output t :input t)
'()))
- (when ,exit (quit)))
+ (when ,exit (throw 'done nil)))
,keys
,tty))
(defun perform-action (action)
- (when (tty action)
- (charms/ll:endwin))
(funcall (thunk action) (aref *urls* *pos*))
- (when (tty action)
- (boots:blit)))
+ (boots:redraw :full (tty action)))
;;;; Input --------------------------------------------------------------------
(defun find-urls (string)
- (-<> string
- (ppcre:all-matches-as-strings
- *regex* <>
- :sharedp nil) ; ccl can't take non-simple-strings as external program args, because fuck me
- (remove-duplicates <> :test #'string-equal)
- (coerce <> 'vector)))
+ (let ((matches (ppcre:all-matches-as-strings
+ *regex* string
+ ;; ccl can't take non-simple-strings as external program
+ ;; args, because fuck me
+ :sharedp nil)))
+ (coerce (remove-duplicates matches :test #'string-equal) 'vector)))
(defun read-input (path)
(if (equal "-" path)
(read-standard-input-into-string)
- (read-file-into-string path)))
+ (alexandria:read-file-into-string path)))
(defun process-input (input)
(find-urls input))
;;;; UI -----------------------------------------------------------------------
-(defun draw (canvas)
- (boots:clear canvas)
- (boots:draw canvas 0 0 (format nil "brows v~A" *version*))
+(defun draw (pad)
+ (boots:draw pad 0 0 (format nil "brows v~A" *version*))
(iterate
- (for row :from 2 :below (boots:height canvas))
+ (for y :from 2 :below (boots:height pad))
(for url :in-vector *urls* :with-index i)
- (when (= i *pos*)
- (boots:draw canvas row 0 "-> "))
- (boots:draw canvas row 3 url)))
+ (for selected = (= i *pos*))
+ (when selected
+ (boots:draw pad 0 y "-> " (boots:attr :bold t)))
+ (boots:draw pad 3 y url (boots:attr :bold selected))))
(defun init ()
(let ((*package* (find-package :brows)))
(load "~/.browsrc" :if-does-not-exist nil))
- (setf *urls* (-<> "-"
- read-input
- process-input)))
+ (setf *urls* (process-input (read-input "-"))))
(defun main ()
(iterate
- (boots:blit)
+ (boots:redraw)
(for event = (boots:read-event))
(for action = (gethash event *actions*))
(if action
@@ -123,8 +114,11 @@
(defun toplevel ()
(catch-and-spew-errors
- (boots:with-boots (:fresh-tty t)
- (boots:with-layer ()
- (boots:canvas () #'draw)
- (init)
- (main)))))
+ (catch 'done
+ (with-open-file (input "/dev/tty" :direction :input)
+ (with-open-file (output "/dev/tty" :direction :output :if-exists :append)
+ (boots/terminals/ansi:with-ansi-terminal (terminal :input-stream input :output-stream output)
+ (boots:with-screen (screen terminal :root (boots:make-canvas :draw #'draw))
+ (init)
+ (main))))))))
+
--- a/vendor/quickutils.lisp Sat May 26 14:38:30 2018 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,267 +0,0 @@
-;;;; This file was automatically generated by Quickutil.
-;;;; See http://quickutil.org for details.
-
-;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-LIST :ONCE-ONLY :RCURRY :READ-FILE-INTO-STRING :SYMB :WITH-GENSYMS) :ensure-package T :package "BROWS.QUICKUTILS")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (unless (find-package "BROWS.QUICKUTILS")
- (defpackage "BROWS.QUICKUTILS"
- (:documentation "Package that contains Quickutil utility functions.")
- (:use #:cl))))
-
-(in-package "BROWS.QUICKUTILS")
-
-(when (boundp '*utilities*)
- (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :COMPOSE :CURRY :ENSURE-LIST
- :ONCE-ONLY :RCURRY :WITH-OPEN-FILE*
- :WITH-INPUT-FROM-FILE
- :READ-FILE-INTO-STRING :MKSTR :SYMB
- :STRING-DESIGNATOR :WITH-GENSYMS))))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun make-gensym-list (length &optional (x "G"))
- "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
-using the second (optional, defaulting to `\"G\"`) argument."
- (let ((g (if (typep x '(integer 0)) x (string x))))
- (loop repeat length
- collect (gensym g))))
- ) ; eval-when
-(eval-when (:compile-toplevel :load-toplevel :execute)
- ;;; To propagate return type and allow the compiler to eliminate the IF when
- ;;; it is known if the argument is function or not.
- (declaim (inline ensure-function))
-
- (declaim (ftype (function (t) (values function &optional))
- ensure-function))
- (defun ensure-function (function-designator)
- "Returns the function designated by `function-designator`:
-if `function-designator` is a function, it is returned, otherwise
-it must be a function name and its `fdefinition` is returned."
- (if (functionp function-designator)
- function-designator
- (fdefinition function-designator)))
- ) ; eval-when
-
- (defun compose (function &rest more-functions)
- "Returns a function composed of `function` and `more-functions` that applies its ;
-arguments to to each in turn, starting from the rightmost of `more-functions`,
-and then calling the next one with the primary value of the last."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (reduce (lambda (f g)
- (let ((f (ensure-function f))
- (g (ensure-function g)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- (funcall f (apply g arguments)))))
- more-functions
- :initial-value function))
-
- (define-compiler-macro compose (function &rest more-functions)
- (labels ((compose-1 (funs)
- (if (cdr funs)
- `(funcall ,(car funs) ,(compose-1 (cdr funs)))
- `(apply ,(car funs) arguments))))
- (let* ((args (cons function more-functions))
- (funs (make-gensym-list (length args) "COMPOSE")))
- `(let ,(loop for f in funs for arg in args
- collect `(,f (ensure-function ,arg)))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- ,(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)))))
-
-
- (defun ensure-list (list)
- "If `list` is a list, it is returned. Otherwise returns the list designated by `list`."
- (if (listp list)
- list
- (list list)))
-
-
- (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.
-
-Each of `specs` must either be a symbol naming the variable to be rebound, or of
-the form:
-
- (symbol initform)
-
-Bare symbols in `specs` are equivalent to
-
- (symbol symbol)
-
-Example:
-
- (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
- (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
- (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
- (names-and-forms (mapcar (lambda (spec)
- (etypecase spec
- (list
- (destructuring-bind (name form) spec
- (cons name form)))
- (symbol
- (cons spec spec))))
- specs)))
- ;; bind in user-macro
- `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
- gensyms names-and-forms)
- ;; bind in final expansion
- `(let (,,@(mapcar (lambda (g n)
- ``(,,g ,,(cdr n)))
- gensyms names-and-forms))
- ;; bind in user-macro
- ,(let ,(mapcar (lambda (n g) (list (car n) g))
- names-and-forms gensyms)
- ,@forms)))))
-
-
- (defun rcurry (function &rest arguments)
- "Returns a function that applies the arguments it is called
-with and `arguments` to `function`."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- (multiple-value-call fn (values-list more) (values-list arguments)))))
-
-
- (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 mkstr (&rest args)
- "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
-
-Extracted from _On Lisp_, chapter 4."
- (with-output-to-string (s)
- (dolist (a args) (princ a s))))
-
-
- (defun symb (&rest args)
- "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
-
-Extracted from _On Lisp_, chapter 4.
-
-See also: `symbolicate`"
- (values (intern (apply #'mkstr args))))
-
-
- (deftype string-designator ()
- "A string designator type. A string designator is either a string, a symbol,
-or a character."
- `(or symbol string character))
-
-
- (defmacro with-gensyms (names &body forms)
- "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
- `(let ,(mapcar (lambda (name)
- (multiple-value-bind (symbol string)
- (etypecase name
- (symbol
- (values name (symbol-name name)))
- ((cons symbol (cons string-designator null))
- (values (first name) (string (second name)))))
- `(,symbol (gensym ,string))))
- names)
- ,@forms))
-
- (defmacro with-unique-names (names &body forms)
- "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
- (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
- (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
- `(with-gensyms ,names ,@forms))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose curry ensure-list once-only rcurry read-file-into-string
- symb with-gensyms with-unique-names)))
-
-;;;; END OF quickutils.lisp ;;;;