# HG changeset patch # User Steve Losh # Date 1525817945 14400 # Node ID d0a70b5614591075b2b91374424d47327feeb284 # Parent 3ecc82d75817446c71c8e4173c1e425bb137ff1c Add config file, fix up regex diff -r 3ecc82d75817 -r d0a70b561459 package.lisp --- a/package.lisp Fri May 04 21:45:28 2018 -0400 +++ b/package.lisp Tue May 08 18:19:05 2018 -0400 @@ -1,5 +1,5 @@ (defpackage :brows (:use :cl :iterate :losh :brows.quickutils) (:export - :toplevel - )) + :define-action + :toplevel)) diff -r 3ecc82d75817 -r d0a70b561459 src/main.lisp --- a/src/main.lisp Fri May 04 21:45:28 2018 -0400 +++ b/src/main.lisp Tue May 08 18:19:05 2018 -0400 @@ -1,15 +1,16 @@ (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<\">\\):]")) + (ppcre:create-scanner + ; the regex in urlview's docs, with added [] exclusion + "(((http|https|ftp|gopher)|mailto):(//)?[^ \\[\\]<>\"\\t]*|(www|ftp)[0-9]?\\.[-a-z0-9.]+)[^ .,;\\[\\]\\t\\n\\r<\">\\):]?[^, <>\\[\\]\"\\t]*[^ .,;\\[\\]\\t\\n\\r<\">\\):]" + :case-insensitive-mode t)) + (defparameter *urls* nil) (defparameter *log* nil) (defparameter *pos* 0) +(defparameter *actions* (make-hash-table)) (defun find-urls (string) @@ -41,11 +42,16 @@ (defun process-input (input) (find-urls input)) -(defun action-open (url) - (external-program:run "open" (list url))) - -(defun action-w3m (url) - (external-program:run "w3m" (list url) :output t :input t)) +(defmacro define-action (keys program &key + (url 'url) + (arguments `(list ,url)) + tty) + (with-gensyms (action key) + `(let ((,action (lambda (,url) + (external-program:run ,program ,arguments + ,@(if tty '(:output t :input t) '()))))) + (dolist (,key (ensure-list ,keys)) + (setf (gethash ,key *actions*) ,action))))) (defun perform-action (action) (charms/ll:endwin) @@ -64,6 +70,7 @@ (boots:draw canvas row 3 url))) (defun init () + (load "~/.browsrc" :if-does-not-exist nil) (setf *urls* (-<> "-" read-input process-input))) @@ -72,13 +79,14 @@ (iterate (boots:blit) (for event = (boots:read-event)) - (case event - (#\newline (perform-action #'action-open)) - (#\w (perform-action #'action-w3m)) - ((#\Q #\q) (return-from main)) - ((#\k :up) (incf-pos -1)) - ((#\j :down) (incf-pos 1)) - (t (setf *log* event))))) + (for action = (gethash event *actions*)) + (if action + (perform-action action) + (case event + ((#\Q #\q) (return-from main)) + ((#\k :up) (incf-pos -1)) + ((#\j :down) (incf-pos 1)) + (t (setf *log* event)))))) (defmacro catch-and-spew-errors (&body body) `(handler-case (progn ,@body) diff -r 3ecc82d75817 -r d0a70b561459 vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Fri May 04 21:45:28 2018 -0400 +++ b/vendor/make-quickutils.lisp Tue May 08 18:19:05 2018 -0400 @@ -5,10 +5,11 @@ :utilities '( :compose - :read-file-into-string :curry + :ensure-list :once-only :rcurry + :read-file-into-string :symb :with-gensyms diff -r 3ecc82d75817 -r d0a70b561459 vendor/quickutils.lisp --- a/vendor/quickutils.lisp Fri May 04 21:45:28 2018 -0400 +++ b/vendor/quickutils.lisp Tue May 08 18:19:05 2018 -0400 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (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") +;;;; (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") @@ -14,11 +14,11 @@ (when (boundp '*utilities*) (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION - :COMPOSE :ONCE-ONLY :WITH-OPEN-FILE* + :COMPOSE :CURRY :ENSURE-LIST + :ONCE-ONLY :RCURRY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE - :READ-FILE-INTO-STRING :CURRY :RCURRY - :MKSTR :SYMB :STRING-DESIGNATOR - :WITH-GENSYMS)))) + :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`, @@ -72,6 +72,33 @@ ,(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. @@ -111,6 +138,16 @@ ,@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) @@ -163,36 +200,6 @@ :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`." - (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))))) - - (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. @@ -254,7 +261,7 @@ `(with-gensyms ,names ,@forms)) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(compose read-file-into-string curry once-only rcurry symb - with-gensyms with-unique-names))) + (export '(compose curry ensure-list once-only rcurry read-file-into-string + symb with-gensyms with-unique-names))) ;;;; END OF quickutils.lisp ;;;;