Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv4992
Modified Files: package.lisp panes.lisp Log Message: I like my scroll bars left, Hefner wants them right. So I made it tweakable. Default is right though.
CLIM-EXTENSIONS:*DEFAULT-VERTICAL-SCROLL-BAR-POSITION* New variable^Wparameter intented to be settable by the user.
VERTICAL-SCROLL-BAR-POSITION slot of SCROLLER-PANE :VERTICAL-SCROLL-BAR-POSITION init arg of SCROLLER-PANE New.
(ALLOCATE-SPACE SCROLLER-PANE T T) Use it. Do not use *SCROLLBAR-THICKNESS*, but rely on the space requirements of the scroll bars.
--- /project/mcclim/cvsroot/mcclim/package.lisp 2009/08/01 16:10:32 1.71 +++ /project/mcclim/cvsroot/mcclim/package.lisp 2009/08/01 21:27:13 1.72 @@ -1973,7 +1973,8 @@
#:define-bitmap-file-reader #:unsupported-bitmap-format - #:bitmap-format)) + #:bitmap-format + #:*default-vertical-scroll-bar-position*))
;;; Symbols that must be defined by a backend. ;;; --- /project/mcclim/cvsroot/mcclim/panes.lisp 2009/06/03 20:33:16 1.195 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2009/08/01 21:27:13 1.196 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA.
-;;; $Id: panes.lisp,v 1.195 2009/06/03 20:33:16 ahefner Exp $ +;;; $Id: panes.lisp,v 1.196 2009/08/01 21:27:13 gbaumann Exp $
(in-package :clim-internals)
@@ -1929,6 +1929,13 @@
(defparameter *scrollbar-thickness* 17)
+(defvar clim-extensions:*default-vertical-scroll-bar-position* + :right + "Default for the :VERTICAL-SCROLL-BAR-POSITION init arg of a + SCROLLER-PANE. Set it to :LEFT to have the vertical scroll bar of a + SCROLLER-PANE appear on the ergonomic left hand side, or leave set to + :RIGHT to have it on the distant right hand side of the scroller.") + (defclass scroller-pane (composite-pane) ((scroll-bar :type scroll-bar-spec ; (member t :vertical :horizontal nil) ;; ### Note: I added NIL here, so that the application @@ -1951,7 +1958,13 @@ (vscrollbar :initform nil) (hscrollbar :initform nil) (suggested-width :initform 300 :initarg :suggested-width) - (suggested-height :initform 300 :initarg :suggested-height)) + (suggested-height :initform 300 :initarg :suggested-height) + (vertical-scroll-bar-position + :initform clim-extensions:*default-vertical-scroll-bar-position* + :initarg :vertical-scroll-bar-position + :type (member :left :right) + :documentation "Whether to put the vertical scroll bar on the left hand or + right hand side of the scroller pane.")) (:default-initargs :x-spacing 4 :y-spacing 4)) @@ -2028,23 +2041,29 @@ (make-space-requirement))))
(defmethod allocate-space ((pane scroller-pane) width height) - (with-slots (viewport vscrollbar hscrollbar x-spacing y-spacing) pane - (let ((viewport-width (if vscrollbar (- width *scrollbar-thickness*) width)) - (viewport-height (if hscrollbar (- height *scrollbar-thickness*) height))) - + (with-slots (viewport vscrollbar hscrollbar x-spacing y-spacing vertical-scroll-bar-position) pane + (let* ((vsbar-width (if vscrollbar (space-requirement-width (compose-space vscrollbar)) 0)) + (hsbar-height (if hscrollbar (space-requirement-height (compose-space hscrollbar)) 0)) + (viewport-width (- width vsbar-width)) + (viewport-height (- height hsbar-height))) (when vscrollbar - (setf (sheet-transformation vscrollbar) - (make-translation-transformation (- width *scrollbar-thickness*) 0)) + (move-sheet vscrollbar + (ecase vertical-scroll-bar-position + (:left 0) + (:right (- width vsbar-width))) + 0) (allocate-space vscrollbar - *scrollbar-thickness* - (if hscrollbar (- height *scrollbar-thickness*) height))) + vsbar-width + (- height hsbar-height))) (when hscrollbar (move-sheet hscrollbar - 0 + (ecase vertical-scroll-bar-position + (:left vsbar-width) + (:right 0)) (- height *scrollbar-thickness*)) (allocate-space hscrollbar - (if vscrollbar (- width *scrollbar-thickness*) width) - *scrollbar-thickness*)) + (- width vsbar-width) + hsbar-height)) ;; ;; Recalculate the gadget-values of the scrollbars ;; @@ -2073,10 +2092,12 @@ max)))) (setf (scroll-bar-values hscrollbar) (values min max ts val)))) (when viewport - (setf (sheet-transformation viewport) - (make-translation-transformation - (+ x-spacing 0) - (+ y-spacing 0))) + (move-sheet viewport + (+ x-spacing + (ecase vertical-scroll-bar-position + (:left vsbar-width) + (:right 0))) + (+ y-spacing 0)) (allocate-space viewport (- viewport-width (* 2 x-spacing)) (- viewport-height (* 2 y-spacing)))))))
-
gbaumann