;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Scrollable Dispels
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xtract/visual-trace/scrollable-dispels.lisp
;;; File Creation Date: 06/23/92 11:42:32
;;; Last Modification Time: 06/23/92 12:26:37
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)


;;;---------------------------------------------------------------------------
;;;
;;; Klasse und Funktionen, um Multi-line-text-dispels zu scrollen
;;;
;;;---------------------------------------------------------------------------

(defcontact scrollable-dispel (dispel)
     ())

;;;
;;; internal scrolling methods for dispels
;;;

(defmethod extent-size ((self scrollable-dispel))
  (values (display-width self)
	  (display-height self)))

(defmethod scroll-to ((self scrollable-dispel) &optional x y)
  (let ((origin (extent-origin self)))
    (multiple-value-bind (new-x new-y) (new-scroll-position self x y)
      (when new-x
	(setf (point-x origin) new-x))
      (when new-y
	(setf (point-y origin) new-y))
      (when (or new-x new-y)
	(update self)))))

(defmethod scroll-relative ((self scrollable-dispel) dx dy)
  (let ((origin (extent-origin self)))
    (multiple-value-bind (new-x new-y) (new-scroll-position self dx dy :relative)
      (when new-x
	(setf (point-x origin) new-x))
      (when new-y
	(setf (point-y origin) new-y))
      (when (or new-x new-y)
	(update self)))))

;;; scrolling is performed by overriding the display-x/y-offset
;;;
(defmethod display-x-offset ((self scrollable-dispel))
  (+ (point-x (extent-origin self)) (x-margin self)))
       

(defmethod display-y-offset ((self scrollable-dispel))
  (+ (point-y (extent-origin self)) (y-margin self)))
  
;;; updating scroll-bars
;;;
(defmethod update :after ((self scrollable-dispel))
  (with-slots (parent) self
    (when (typep parent 'margined-window)
      (update-margins parent 'margin-scroll-bar))))


(defcontact scrollable-multi-line-text-dispel (scrollable-dispel
					       multi-line-text-dispel)
  ())


;;; Identification fuer scrollable-multi-line-text-dispels wird entsprechend den
;;; active-text-dispels auf den Text gesetzt.

(defmethod identification ((self scrollable-multi-line-text-dispel))
  (text self))

(defmethod (setf identification) (value (self scrollable-multi-line-text-dispel))
  (setf (text self) value))



;;; Zeigt immer den letzte (aktuellste) Ausschnitt eines Fensters mit Scrollbars an.

(defmethod scroll-last-screen-full ((self scrollable-dispel))
  (with-slots (height) self
    (multiple-value-bind (extent-width extent-height) (extent-size self)
      (declare (ignore extent-width))
      (scroll-to self nil (min 0 (- height extent-height))))))


(defmethod scroll-last-screen-full ((self scrollable-window-mixin))
  (with-slots (height) self
    (multiple-value-bind (extent-width extent-height) (extent-size self)
      (declare (ignore extent-width))
      (scroll-to self nil (min 0 (- height extent-height))))))




