commit ff293c8e886c8ff3bdfde1fac2b427eb65832003 Author: Mark Hudnall Date: Wed Mar 24 23:03:34 2021 -0700 Initial commit prescient without persistence diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b9fa3c1 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +*.abcl +*.fasl +*.dx32fsl +*.dx64fsl +*.lx32fsl +*.lx64fsl +*.x86f +*~ +.#* diff --git a/README.org b/README.org new file mode 100644 index 0000000..dfe8cfd --- /dev/null +++ b/README.org @@ -0,0 +1,5 @@ +* Stumpwm-Prescient + +** Usage + +** Installation diff --git a/src/main.lisp b/src/main.lisp new file mode 100644 index 0000000..3f6c85c --- /dev/null +++ b/src/main.lisp @@ -0,0 +1,61 @@ +(defpackage stumpwm-prescient + (:use :cl :stumpwm)) +(in-package :stumpwm-prescient) + +(export '(refine-input + remember-candidate)) + +(defvar *persist* nil) +(defvar *history* (make-hash-table :test 'equal)) +(defvar *history-length* 100) +(defvar *frequency* (make-hash-table :test 'equal)) +(defvar *frequency-decay* 0.997) +(defvar *frequency-threshold* 0.05) +(defvar *sort-by-length* t) + +(defun sort-comparator (c1 c2) + (let* ((p1 (gethash c1 *history* *history-length*)) + (p2 (gethash c2 *history* *history-length*))) + (or (< p1 p2) + (and (eq p1 p2) + (let* ((f1 (gethash c1 *frequency* 0)) + (f2 (gethash c2 *frequency* 0))) + (or (> f1 f2) + (and (eq f1 f2) + *sort-by-length* + (< (length c1) + (length c2))))))))) + +(defun sort-candidates (candidates) + (sort candidates 'sort-comparator)) + +(defun refine-input (str candidates) + (let ((candidates (input-refine-regexp str candidates))) + (sort-candidates candidates))) + +(defun remember-candidate (candidate) + (let* ((candidate (string-trim '(#\Space #\Tab #\Newline) candidate)) + (this-pos (gethash candidate *history* *history-length*))) + (maphash + (lambda (other-candidate other-pos) + (cond + ((< other-pos this-pos) + (setf (gethash other-candidate *history*) (1+ other-pos))) + ((or (>= other-pos *history-length*) + (and (= other-pos (1- *history-length*)) + (= this-pos *history-length*))) + (remhash other-candidate *history-length*)))) + *history*) + + (setf (gethash candidate *history*) 0) + + (setf (gethash candidate *frequency*) (1+ (gethash candidate *frequency* 0))) + (maphash + (lambda (cand old-freq) + (let ((new-freq (* old-freq *frequency-decay*))) + (if (< new-freq *frequency-threshold*) + (remhash cand *frequency*) + (setf (gethash cand *frequency*) new-freq)))) + *frequency*))) + +(add-hook *input-candidate-selected-hook* 'remember-candidate) diff --git a/stumpwm-prescient.asd b/stumpwm-prescient.asd new file mode 100644 index 0000000..565f955 --- /dev/null +++ b/stumpwm-prescient.asd @@ -0,0 +1,21 @@ +(defsystem "stumpwm-prescient" + :version "0.1.0" + :author "" + :license "" + :depends-on (:stumpwm) + :components ((:module "src" + :components + ((:file "main")))) + :description "" + :in-order-to ((test-op (test-op "stumpwm-prescient/tests")))) + +(defsystem "stumpwm-prescient/tests" + :author "" + :license "" + :depends-on ("stumpwm-prescient" + "rove") + :components ((:module "tests" + :components + ((:file "main")))) + :description "Test system for stumpwm-prescient" + :perform (test-op (op c) (symbol-call :rove :run c))) diff --git a/tests/main.lisp b/tests/main.lisp new file mode 100644 index 0000000..b449565 --- /dev/null +++ b/tests/main.lisp @@ -0,0 +1,11 @@ +(defpackage stumpwm-prescient/tests/main + (:use :cl + :stumpwm-prescient + :rove)) +(in-package :stumpwm-prescient/tests/main) + +;; NOTE: To run this test file, execute `(asdf:test-system :stumpwm-prescient)' in your Lisp. + +(deftest test-target-1 + (testing "should (= 1 1) to be true" + (ok (= 1 1))))