diff options
Diffstat (limited to 'Core/clim-core/presentations/translators.lisp')
| -rw-r--r-- | Core/clim-core/presentations/translators.lisp | 44 |
1 files changed, 39 insertions, 5 deletions
diff --git a/Core/clim-core/presentations/translators.lisp b/Core/clim-core/presentations/translators.lisp index 23cab011..bc044292 100644 --- a/Core/clim-core/presentations/translators.lisp +++ b/Core/clim-core/presentations/translators.lisp @@ -729,6 +729,45 @@ a presentation" :modifier-state 0 :button +pointer-left-button+))) +(defun set-highlighted-presentation + (stream presentation &optional (prefer-pointer-window t)) + (declare (ignore prefer-pointer-window)) + (let* ((frame (pane-frame stream)) + (highl (frame-highlited-presentation frame)) + (highlighted-presentation (car highl)) + (highlighted-stream (cdr highl)) + (same-presentation-p (eq presentation highlighted-presentation)) + (unhighlight-p (and highlighted-presentation (not same-presentation-p))) + (rehighlight-p (and presentation (not same-presentation-p)))) + (flet ((highlight (record sheet state) + (funcall-presentation-generic-function highlight-presentation + (presentation-type record) + record sheet state))) + (when (or unhighlight-p rehighlight-p) + (with-output-recording-options (stream :record nil) + (when unhighlight-p + (highlight highlighted-presentation highlighted-stream :unhighlight)) + (when rehighlight-p + (highlight presentation stream :highlight))) + (setf (frame-highlited-presentation frame) + (and presentation (cons presentation stream)))))) + presentation) + +(defun unhighlight-highlighted-presentation + (stream &optional (prefer-pointer-window t)) + (declare (ignore prefer-pointer-window)) + (when-let* ((frame (pane-frame stream)) + (highl (frame-highlited-presentation frame))) + (setf (frame-highlited-presentation frame) nil) + (destructuring-bind (presentation . stream) highl + (with-output-recording-options (stream :record nil) + (funcall-presentation-generic-function highlight-presentation + (presentation-type presentation) + presentation + stream + :unhighlight)))) + nil) + (defun highlight-current-presentation (frame input-context) (when-let* ((port (port frame)) (port-pointer (port-pointer port)) @@ -741,8 +780,3 @@ a presentation" (when (or prefer-pointer-window (eq stream (pointer-sheet (port-pointer (port frame))))) (highlight-current-presentation frame input-context))) - -;;; FIXME missing functions -;;; -;;; set-highlighted-presentation -;;; unhighlight-highlighted-presentation |