aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Pouar <pouar@pouar.net>2020-09-14 18:48:09 -0500
committerGravatar Pouar <pouar@pouar.net>2020-09-15 09:41:10 -0500
commitf6ada1908e44a5623fc4fb7f151dfd31ae85a3ca (patch)
treeeaa7ce11bc825b1bb84d8713d21ef1e2a1afc3a1
parentget this macro to work in the latest McCLIM (diff)
patch McCLIM bug, revert when this gets fixed
-rw-r--r--core/patches.lisp21
1 files changed, 21 insertions, 0 deletions
diff --git a/core/patches.lisp b/core/patches.lisp
index a7a2ecf..ce24aa9 100644
--- a/core/patches.lisp
+++ b/core/patches.lisp
@@ -8,6 +8,27 @@
(elt expr 5))
(in-package :climi)
+;;; I think it's supposed to use maybe-funcall instead of funcall
+
+(defmethod stream-input-wait ((stream input-stream-kernel) &key timeout input-wait-test)
+ (loop
+ with wait-fun = (and input-wait-test (curry input-wait-test stream))
+ with timeout-time = (and timeout (+ timeout (now)))
+ when (stream-gesture-available-p stream)
+ do (return-from stream-input-wait t)
+ do (multiple-value-bind (available reason)
+ (event-listen-or-wait stream :timeout timeout
+ :wait-function wait-fun)
+ (when (and (null available) (eq reason :timeout))
+ (return-from stream-input-wait (values nil :timeout)))
+ (when-let ((event (event-read-no-hang stream)))
+ (handle-event (event-sheet event) event))
+ (when timeout
+ (setf timeout (compute-decay timeout-time nil)))
+ (when (maybe-funcall input-wait-test stream)
+ (return-from stream-input-wait
+ (values nil :input-wait-test))))))
+
;;; the patch I added that makes the FreeType renderer pick the right defaults seems to make it a lot slower
;;; especially now that McCLIM is no longer caching all the fonts because that doesn't work when *default-text-style*
;;; changes. Cache all the fonts again for the FreeType renderer until this gets much faster upstream