Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv9480
Modified Files: dead-keys.lisp stream-input.lisp Log Message: Removed some code duplication in dead key handling.
--- /project/mcclim/cvsroot/mcclim/dead-keys.lisp 2008/05/01 06:48:23 1.2 +++ /project/mcclim/cvsroot/mcclim/dead-keys.lisp 2008/05/01 07:48:45 1.3 @@ -117,13 +117,12 @@ (defmacro merging-dead-keys ((gesture state) &body body) "Accumulate dead keys and subsequent characters. `Gesture' should be a symbol bound to either a gesture or an input -event. When it has been determined that a sequence of `gesture's -either does or doesn't result in a full gesture, `body' will be -evaluated with `gesture' bound to that gesture. `State' must be a -place, initially NIL, that will contain the state of dead-key -handling, enabling asynchronous use of the macro." +event. `Body' will be evaluated either with the `gesture' binding +unchanged, or with `gesture' bound to the result of merging +preceding dead keys. `State' must be a place, initially NIL, that +will contain the state of dead-key handling, enabling +asynchronous use of the macro." `(flet ((invoke-body (,gesture) - (setf ,state *dead-key-table*) ,@body)) (when (null ,state) (setf ,state *dead-key-table*)) @@ -141,7 +140,10 @@ (characterp ,gesture)) (setf ,state *dead-key-table*)))) (character + (setf ,state *dead-key-table*) (invoke-body value)) (hash-table - (setf ,state value)))) - (invoke-body ,gesture)))) + (setf ,state value) + (invoke-body value)))) + (progn (setf ,state *dead-key-table*) + (invoke-body ,gesture))))) --- /project/mcclim/cvsroot/mcclim/stream-input.lisp 2008/04/30 21:27:48 1.52 +++ /project/mcclim/cvsroot/mcclim/stream-input.lisp 2008/05/01 07:48:45 1.53 @@ -146,37 +146,23 @@ (handler-case (loop with start-time = (get-internal-real-time) with end-time = start-time - for gesture = (call-next-method stream - :timeout (when timeout - (- timeout (/ (- end-time start-time) - internal-time-units-per-second))) - :peek-p peek-p - :input-wait-test input-wait-test - :input-wait-handler input-wait-handler - :pointer-button-press-handler - pointer-button-press-handler) - do (setf end-time (get-internal-real-time) - last-deadie-gesture gesture - last-state state) - do (if (typep gesture '(or keyboard-event character)) - (let ((value (gethash (if (characterp gesture) - gesture - (keyboard-event-key-name gesture)) - state))) - (etypecase value - (null - (cond ((eq state *dead-key-table*) - (return gesture)) - ((or (and (typep gesture 'keyboard-event) - (keyboard-event-character gesture)) - (characterp gesture)) - (setf state *dead-key-table*)))) - (character - (setf state *dead-key-table*) - (return value)) - (hash-table - (return (setf state value))))) - (return gesture))) + do (multiple-value-bind (gesture reason) + (call-next-method stream + :timeout (when timeout + (- timeout (/ (- end-time start-time) + internal-time-units-per-second))) + :peek-p peek-p + :input-wait-test input-wait-test + :input-wait-handler input-wait-handler + :pointer-button-press-handler + pointer-button-press-handler) + (when (null gesture) + (return (values nil reason))) + (setf end-time (get-internal-real-time) + last-deadie-gesture gesture + last-state state) + (merging-dead-keys (gesture state) + (return gesture)))) ;; Policy decision: an abort cancels the current composition. (abort-gesture (c) (setf state *dead-key-table*)