From c4d21e94152e2ee7152e373d7b8eaa75352a380b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jacek=20TeMPOraL=20Z=C5=82ydach?= <temporal.pl@gmail.com>
Date: Sat, 3 Jun 2017 12:28:30 +0200
Subject: [PATCH] Uncommented dynamic scrollbar update code

+ added background/foreground initargs.

This leads to Lisp Listener demo showing a scroll pane.
---
 silica/gadgets.lisp | 125 ++++++++++++++++++++++----------------------
 silica/medium.lisp  |   4 +-
 2 files changed, 65 insertions(+), 64 deletions(-)

diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index 8708c4e0..15e0a00a 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -845,7 +845,7 @@ The text-field must have the focus before you can call this function."))
 ;; simplified so that it repaints the viewport over the entire region
 ;; taking advantage of the fact that the repainting of overlapping
 ;; children happens after
-#+ignore
+#++really-ignore
 (defmethod repaint-sheet ((sheet viewport) region)
   (let ((region (region-intersection (sheet-region sheet) region)))
     (dolist (child (sheet-children sheet))
@@ -864,76 +864,77 @@ The text-field must have the focus before you can call this function."))
     (bounding-rectangle-width pane) (bounding-rectangle-height pane)))
 
 ;;--- Work on this
-#+++ignore
 (defmethod note-sheet-region-changed :around ((viewport viewport) &key port-did-it)
   #-aclpc (declare (ignore port-did-it))
   (multiple-value-bind (changedp
 			hscroll-bar hscroll-bar-enabled-p
 			vscroll-bar vscroll-bar-enabled-p)
-      (compute-dynamic-scroll-bar-values viewport)
+      (compute-dynamic-scroll-bar-values (viewport-scroller-pane viewport))
     (if changedp
-	 (update-dynamic-scroll-bars
-	  viewport changedp
-	  hscroll-bar hscroll-bar-enabled-p
-	  vscroll-bar vscroll-bar-enabled-p)
+        (update-dynamic-scroll-bars (viewport-scroller-pane viewport)
+                                    changedp
+                                    hscroll-bar
+                                    hscroll-bar-enabled-p
+                                    vscroll-bar
+                                    vscroll-bar-enabled-p)
 	(call-next-method))))
 
 
-;(defun update-dynamic-scroll-bars (scroller changedp
-;				    hscroll-bar hscroll-bar-enabled-p
-;				    vscroll-bar vscroll-bar-enabled-p
-;				    &optional relayout)
-;  (when changedp
-;    (when hscroll-bar
-;      (setf (sheet-enabled-p hscroll-bar) hscroll-bar-enabled-p))
-;    (when vscroll-bar
-;      (setf (sheet-enabled-p vscroll-bar) vscroll-bar-enabled-p))
-;    (when (or (and hscroll-bar (not hscroll-bar-enabled-p))
-;		(and vscroll-bar (not vscroll-bar-enabled-p)))
-;      (let* ((contents (slot-value scroller 'contents))
-;	       (c-extent (viewport-contents-extent
-;			  (pane-viewport contents))))
-;	  (multiple-value-bind (vx vy)
-;	     (window-viewport-position contents)
-;	    (window-set-viewport-position
-;	     contents
-;	     (if (and hscroll-bar (not hscroll-bar-enabled-p))
-;		 (bounding-rectangle-min-x c-extent)
-;		 vx)
-;	     (if (and vscroll-bar (not vscroll-bar-enabled-p))
-;		 (bounding-rectangle-min-y c-extent)
-;		 vy)))))
-;    (clear-space-requirement-caches-in-tree scroller)
-;    (when relayout
-;      ;;--- This is kinda bogus.  If this was a generic scroller then
-;      ;;--- you want to layout the table.
-;      (let ((table (slot-value scroller 'viewport)))
-;	  (multiple-value-bind (width height)
-;	      (bounding-rectangle-size table)
-;	    (allocate-space table width height))))))
-
-;(defun compute-dynamic-scroll-bar-values (scroller)
-;  (let* ((hscroll-bar (scroller-pane-horizontal-scroll-bar scroller))
-;	  (vscroll-bar (scroller-pane-vertical-scroll-bar scroller))
-;	  (scroll-bar-policy (scroller-pane-scroll-bar-policy scroller)))
-;    (if (eq scroll-bar-policy :dynamic)
-;	 (multiple-value-bind (vwidth vheight)
-;	     (bounding-rectangle-size scroller)
-;	   (multiple-value-bind (cwidth cheight)
-;	       (bounding-rectangle-size
-;		 (viewport-contents-extent (slot-value scroller 'viewport)))
-;	     (let ((ohenp (sheet-enabled-p hscroll-bar))
-;		   (ovenp (sheet-enabled-p vscroll-bar))
-;		   (nhenp (> cwidth vwidth))
-;		   (nvenp (> cheight vheight)))
-;	       (values
-;		 (not (and (eq ohenp nhenp)
-;			   (eq ovenp nvenp)))
-;		 (and (not (eq ohenp nhenp)) hscroll-bar)
-;		 nhenp
-;		 (and (not (eq ovenp nvenp)) vscroll-bar)
-;		 nvenp))))
-;	 (values nil nil nil nil nil))))
+(defun update-dynamic-scroll-bars (scroller changedp
+				    hscroll-bar hscroll-bar-enabled-p
+				    vscroll-bar vscroll-bar-enabled-p
+				    &optional relayout)
+ (when changedp
+   (when hscroll-bar
+     (setf (sheet-enabled-p hscroll-bar) hscroll-bar-enabled-p))
+   (when vscroll-bar
+     (setf (sheet-enabled-p vscroll-bar) vscroll-bar-enabled-p))
+   (when (or (and hscroll-bar (not hscroll-bar-enabled-p))
+		(and vscroll-bar (not vscroll-bar-enabled-p)))
+     (let* ((contents (slot-value scroller 'contents))
+	       (c-extent (viewport-contents-extent
+			  (pane-viewport contents))))
+	  (multiple-value-bind (vx vy)
+	     (window-viewport-position contents)
+	    (window-set-viewport-position
+	     contents
+	     (if (and hscroll-bar (not hscroll-bar-enabled-p))
+		 (bounding-rectangle-min-x c-extent)
+		 vx)
+	     (if (and vscroll-bar (not vscroll-bar-enabled-p))
+		 (bounding-rectangle-min-y c-extent)
+		 vy)))))
+   (clear-space-requirement-caches-in-tree scroller)
+   (when relayout
+     ;;--- This is kinda bogus.  If this was a generic scroller then
+     ;;--- you want to layout the table.
+     (let ((table (slot-value scroller 'viewport)))
+	  (multiple-value-bind (width height)
+	      (bounding-rectangle-size table)
+	    (allocate-space table width height))))))
+
+(defun compute-dynamic-scroll-bar-values (scroller)
+  (let* ((hscroll-bar (scroller-pane-horizontal-scroll-bar scroller))
+         (vscroll-bar (scroller-pane-vertical-scroll-bar scroller))
+         (scroll-bar-policy (scroller-pane-scroll-bar-policy scroller)))
+    (if (eq scroll-bar-policy :dynamic)
+        (multiple-value-bind (vwidth vheight)
+            (bounding-rectangle-size scroller)
+          (multiple-value-bind (cwidth cheight)
+              (bounding-rectangle-size
+               (viewport-contents-extent (slot-value scroller 'viewport)))
+            (let ((ohenp (sheet-enabled-p hscroll-bar))
+                  (ovenp (sheet-enabled-p vscroll-bar))
+                  (nhenp (> cwidth vwidth))
+                  (nvenp (> cheight vheight)))
+              (values
+               (not (and (eq ohenp nhenp)
+                         (eq ovenp nvenp)))
+               (and (not (eq ohenp nhenp)) hscroll-bar)
+               nhenp
+               (and (not (eq ovenp nvenp)) vscroll-bar)
+               nvenp))))
+        (values nil nil nil nil nil))))
 
 (defun viewport-contents-extent (viewport)
   (let ((contents (sheet-child viewport)))
diff --git a/silica/medium.lisp b/silica/medium.lisp
index 598788dc..6404e198 100644
--- a/silica/medium.lisp
+++ b/silica/medium.lisp
@@ -105,8 +105,8 @@
 ;; removed out hard-wired white background hack for nt (cim 10/9/96)
 
 (defclass sheet-with-resources-mixin ()
-  ((foreground :initform nil :accessor pane-foreground)
-   (background :initform nil :accessor pane-background)
+  ((foreground :initform nil :initarg :foreground :accessor pane-foreground)
+   (background :initform nil :initarg :background :accessor pane-background)
    (text-style :initform nil :initarg :text-style :accessor pane-text-style)
    (initargs :initform nil :reader sheet-with-resources-initargs)))
   
-- 
GitLab