input contexts: add abstraction for creating and accesing the entry

Previously we had only INPUT-CONTEXT-TYPE; this commit adds INPUT-CONTEXT-CONT
and a constructor MAKE-INPUT-CONTEXT-ENTRY. This improvement is for readibility.

1 files changed, 18 insertions, 13 deletions

diff --git a/Core/clim-core/presentations/typed-input.lisp b/Core/clim-core/presentations/typed-input.lisp
index 3b8db76e..ca455d24 100644
--- a/Core/clim-core/presentations/typed-input.lisp
+++ b/Core/clim-core/presentations/typed-input.lisp
@@ -20,16 +20,21 @@
 (defun input-context-type (context-entry)
   (car context-entry))
 
-;;; Many presentation functions, internal and external, take an input
-;;; context as an argument, but they really only need to look at one
-;;; presentation type.
+(defun input-context-cont (context-entry)
+  (cdr context-entry))
+
+(defun make-input-context-entry (ptype cont)
+  (cons (expand-presentation-type-abbreviation ptype) cont))
+
+;;; Many presentation functions, internal and external, take an input context as
+;;; an argument, but they really only need to look at one presentation type.
 (defun make-fake-input-context (ptype)
-  (list (cons (expand-presentation-type-abbreviation ptype)
-              #'(lambda (object type event options)
-                  (declare (ignore event options))
-                  (error "Fake input context called with object ~S type ~S. ~
-                          This shouldn't happen!"
-                         object type)))))
+  (flet ((input-context-fake-continuation (object type event options)
+           (declare (ignore event options))
+           (error "Fake input context called with object ~S type ~S. ~
+                   This shouldn't happen!"
+                  object type)))
+    (list ptype #'input-context-fake-continuation)))
 
 (defun input-context-wait-test (stream)
   (when-let ((gesture (stream-gesture-available-p stream)))
@@ -37,6 +42,7 @@
       (output-recording-stream-p (event-sheet gesture)))))
 
 (defun input-context-event-handler (stream)
+  (declare (ignore stream))
   (highlight-current-presentation *application-frame* *input-context*))
 
 (defun input-context-button-press-handler (stream button-event)
@@ -45,10 +51,9 @@
                                             (event-sheet button-event)
                                             button-event))
 
-(defun invoke-with-input-context (form-cont case-cont type &key override)
-  (let* ((expanded-type (expand-presentation-type-abbreviation type))
-         (*input-context*
-           (list* (cons expanded-type case-cont)
+(defun invoke-with-input-context (form-cont case-cont ptype &key override)
+  (let* ((*input-context*
+           (list* (make-input-context-entry ptype case-cont)
                   (if override nil *input-context*)))
          (*pointer-button-press-handler* #'input-context-button-press-handler)
          (*input-wait-test* #'input-context-wait-test)