# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1586827413 14400
# Node ID 1d2776f7fa4a369c3adef135ca459d6d06cd0278
# Parent  0a3160c5895ca900f9b20039b3e1bec58f4b4aa8
Update to latest version of boots, get it building again

diff -r 0a3160c5895c -r 1d2776f7fa4a Makefile
--- a/Makefile	Sat May 26 14:38:30 2018 -0400
+++ b/Makefile	Mon Apr 13 21:23:33 2020 -0400
@@ -1,10 +1,6 @@
 .PHONY: vendor clean binary-sbcl binary-ccl binary
 
-# Vendor ----------------------------------------------------------------------
-vendor/quickutils.lisp: vendor/make-quickutils.lisp
-	cd vendor && sbcl --noinform --load make-quickutils.lisp  --eval '(quit)'
-
-vendor: vendor/quickutils.lisp
+all: bin/brows
 
 # Clean -----------------------------------------------------------------------
 clean:
@@ -24,5 +20,6 @@
 
 binary: binary-sbcl
 
-bin/brows: $(lisps) $(assets) Makefile
+bin/brows: $(lisps) Makefile
 	make binary-sbcl
+	mv brows bin
diff -r 0a3160c5895c -r 1d2776f7fa4a brows.asd
--- a/brows.asd	Sat May 26 14:38:30 2018 -0400
+++ b/brows.asd	Mon Apr 13 21:23:33 2020 -0400
@@ -10,24 +10,13 @@
 
                :boots
                :cl-ppcre
-               :deploy
                :external-program
                :iterate
-               :losh
 
                )
 
-  :defsystem-depends-on (:deploy)
-  :build-operation "deploy-op"
-  :build-pathname "brows"
-  :entry-point "brows:toplevel"
-
   :serial t
   :components
-  ((:module "vendor" :serial t
-    :components ((:file "quickutils-package")
-                 (:file "quickutils")))
-   (:file "package")
-   (:module "src" :serial t
-    :components
-    ((:file "main")))))
+  ((:module "src" :serial t :components
+    ((:file "package")
+     (:file "main")))))
diff -r 0a3160c5895c -r 1d2776f7fa4a package.lisp
--- a/package.lisp	Sat May 26 14:38:30 2018 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,5 +0,0 @@
-(defpackage :brows
-  (:use :cl :iterate :losh :brows.quickutils)
-  (:export
-    :define-action
-    :toplevel))
diff -r 0a3160c5895c -r 1d2776f7fa4a src/build.lisp
--- a/src/build.lisp	Sat May 26 14:38:30 2018 -0400
+++ b/src/build.lisp	Mon Apr 13 21:23:33 2020 -0400
@@ -1,6 +1,23 @@
 (ql:quickload :brows)
 
-(setf deploy:*status-output* nil)
+#+sbcl
+(progn
+  (sb-ext:gc :full t)
+  (sb-ext:save-lisp-and-die
+    "brows"
+    :executable t
+    :compression nil
+    :toplevel #'brows:toplevel
+    :save-runtime-options t))
 
-(let ((deploy:*status-output* t))
-  (asdf:make :brows :force t))
+#+ccl
+(progn
+  (ccl:gc)
+  (ccl:save-application
+    "brows"
+    :toplevel-function #'brows:toplevel
+    :purify t
+    :prepend-kernel t))
+
+#-(or sbcl ccl)
+(error "Don't know how to build in this implementation.")
diff -r 0a3160c5895c -r 1d2776f7fa4a src/main.lisp
--- 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))))))))
+
diff -r 0a3160c5895c -r 1d2776f7fa4a src/package.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/package.lisp	Mon Apr 13 21:23:33 2020 -0400
@@ -0,0 +1,5 @@
+(defpackage :brows
+  (:use :cl :iterate)
+  (:export
+    :define-action
+    :toplevel))
diff -r 0a3160c5895c -r 1d2776f7fa4a vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Sat May 26 14:38:30 2018 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-(ql:quickload 'quickutil)
-
-(qtlc:save-utils-as
-  "quickutils.lisp"
-  :utilities '(
-
-               :compose
-               :curry
-               :ensure-list
-               :once-only
-               :rcurry
-               :read-file-into-string
-               :symb
-               :with-gensyms
-
-               )
-  :package "BROWS.QUICKUTILS")
diff -r 0a3160c5895c -r 1d2776f7fa4a vendor/quickutils-package.lisp
--- a/vendor/quickutils-package.lisp	Sat May 26 14:38:30 2018 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-(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")
-
-;; need to define this here so sbcl will shut the hell up about it being
-;; undefined when compiling quickutils.lisp.  computers are trash.
-(defparameter *utilities* nil)
-
diff -r 0a3160c5895c -r 1d2776f7fa4a vendor/quickutils.lisp
--- 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 ;;;;