diff --git a/gramps-clim2.asd b/gramps-clim2.asd index 2923d050ddcbc16a82c6acb9d6e48be90be52a72..806fd2163912babd78cd9c34696979d3a9e7b443 100644 --- a/gramps-clim2.asd +++ b/gramps-clim2.asd @@ -99,6 +99,7 @@ ;;; based on `clim-utils' (defsystem #:gramps-clim2/utils + :depends-on (#:closer-mop) :components ((:module "utils" :components ((:file "packages") @@ -160,7 +161,10 @@ ;; 'Physical' gadgets (:file "gadgets") (:file "db-border") - (:file "db-scroll"))))) + (:file "db-scroll") + (:file "db-button") + (:file "db-label") + (:file "scroll-pane"))))) #+ (or) (defsystem #:gramps-clim2/homegrown diff --git a/silica/db-box.lisp b/silica/db-box.lisp index c66e3c485321c1c7193fcd87fcfa5621f30fa977..ee10bca33c22012dfe72cca04c6f5f0dcba4e8ce 100644 --- a/silica/db-box.lisp +++ b/silica/db-box.lisp @@ -21,7 +21,7 @@ (defmethod initialize-instance :after ((pane box-pane) &key contents &allow-other-keys) (dolist (child contents) - (etypecase child + (typecase child ;FIXME temporarily changed etypecase to typecase (number) ((member :fill)) (pane (sheet-adopt-child pane child)) @@ -59,40 +59,41 @@ (minor-max most-positive-fixnum) scale) (dolist (entry contents) - (cond ((eq entry :fill) (incf major+ +fill+)) - ((numberp entry) (incf major entry)) - (t - (if (consp entry) - (psetf entry (second entry) - scale (let ((n (first entry))) - (if (numberp n) (float n) n))) - (setf scale 1.0)) - (let ((space-req (apply #'compose-space entry width-or-height))) - (flet ((scale (x) - (if (and (numberp scale) (< x +fill+)) (/ x scale) x))) - (declare (dynamic-extent #'scale)) - (cond ((eq scale :fill) - (incf major+ +fill+) - (incf major (scale (funcall fn-major space-req))) - (incf major- (scale (funcall fn-major- space-req)))) - ((= scale 1.0) - (incf major+ (scale (funcall fn-major+ space-req))) - (incf major (scale (funcall fn-major space-req))) - (incf major- (scale (funcall fn-major- space-req)))) - ((> scale 1.0) - (incf major+ scale) - (incf major scale) - (incf major- scale)) - (t - ;; It is maxf because we use the scaling - ;; to calculate the desired size of the - ;; overall pane - (maxf major+ (scale (funcall fn-major+ space-req))) - (maxf major (scale (funcall fn-major space-req))) - (maxf major- (scale (funcall fn-major- space-req))))) - (setq minor (max minor (funcall fn-minor space-req))) - (maxf minor-min (funcall fn-minor- space-req)) - (minf minor-max (funcall fn-minor+ space-req))))))) + (when entry ;<-- added as a null prevention + (cond ((eq entry :fill) (incf major+ +fill+)) + ((numberp entry) (incf major entry)) + (t + (if (consp entry) + (psetf entry (second entry) + scale (let ((n (first entry))) + (if (numberp n) (float n) n))) + (setf scale 1.0)) + (let ((space-req (apply #'compose-space entry width-or-height))) + (flet ((scale (x) + (if (and (numberp scale) (< x +fill+)) (/ x scale) x))) + (declare (dynamic-extent #'scale)) + (cond ((eq scale :fill) + (incf major+ +fill+) + (incf major (scale (funcall fn-major space-req))) + (incf major- (scale (funcall fn-major- space-req)))) + ((= scale 1.0) + (incf major+ (scale (funcall fn-major+ space-req))) + (incf major (scale (funcall fn-major space-req))) + (incf major- (scale (funcall fn-major- space-req)))) + ((> scale 1.0) + (incf major+ scale) + (incf major scale) + (incf major- scale)) + (t + ;; It is maxf because we use the scaling + ;; to calculate the desired size of the + ;; overall pane + (maxf major+ (scale (funcall fn-major+ space-req))) + (maxf major (scale (funcall fn-major space-req))) + (maxf major- (scale (funcall fn-major- space-req))))) + (setq minor (max minor (funcall fn-minor space-req))) + (maxf minor-min (funcall fn-minor- space-req)) + (minf minor-max (funcall fn-minor+ space-req)))))))) ;;--- These calcs lead to weirdness when fills are involved. ;;--- This looks like a leftover from the time when +/- were relative ;;(setq minor- (max 0 (- minor minor-min))) @@ -173,23 +174,24 @@ (defmethod allocate-space ((box-pane vbox-pane) width height) (with-slots (contents spacing) box-pane (let ((space-requirement - (compose-space box-pane :width width :height height))) + (compose-space box-pane :width width :height height))) (flet ((compose (x) - (cond ((atom x) (compose-space x :width width)) + (cond ((null x) :fill) ;NOTE added as a safeguard for NIL + ((atom x) (compose-space x :width width)) ((eq (car x) :fill) :fill) (t (car x))))) (declare (dynamic-extent #'compose)) (let* ((adjust (* spacing (1- (length (sheet-children box-pane))))) (sizes (allocate-space-to-items - (- height adjust) - (space-requirement+* space-requirement :height (- adjust)) - contents - #'space-requirement-min-height - #'space-requirement-height - #'space-requirement-max-height - #'compose)) - (y 0)) + (- height adjust) + (space-requirement+* space-requirement :height (- adjust)) + contents + #'space-requirement-min-height + #'space-requirement-height + #'space-requirement-max-height + #'compose)) + (y 0)) (mapc #'(lambda (sheet size) (when (or (panep sheet) (and (consp sheet) diff --git a/silica/framem.lisp b/silica/framem.lisp index d2ef53b5c1e6b367f03c0c4a75c5c055cc060552..ee6d8cc85cb5c32c0018cda8aa0665eb04baad1e 100644 --- a/silica/framem.lisp +++ b/silica/framem.lisp @@ -106,8 +106,8 @@ :region (multiple-value-bind (width height) (bounding-rectangle-size top-pane) (make-bounding-rectangle 0 0 width height)) -#-(or aclpc acl86win32) :background #-(or aclpc acl86win32) (frame-background frame) -#-(or aclpc acl86win32) :foreground #-(or aclpc acl86win32) (frame-foreground frame) +#-(or aclpc acl86win32 (and)) :background #-(or aclpc acl86win32 (and)) (frame-background frame) +#-(or aclpc acl86win32 (and)) :foreground #-(or aclpc acl86win32 (and)) (frame-foreground frame) :text-style (frame-text-style frame))))) (sheet-adopt-child (find-graft :port (port frame)) sheet) (setf (frame-top-level-sheet frame) sheet diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp index 66c1a50edc62ceeb4874208ee2d3c81bd3b4f568..8708c4e0dadbf9b5522d0c0548e1dc9d1501aa6d 100644 --- a/silica/gadgets.lisp +++ b/silica/gadgets.lisp @@ -478,13 +478,11 @@ ;;; (defclass push-button - (action-gadget labelled-gadget-mixin) - ((show-as-default :initform nil :initarg :show-as-default - :accessor push-button-show-as-default) - #+(or aclpc acl86win32) - (pattern :initarg :pattern) - #+(or aclpc acl86win32) - (icon-pattern :initarg :icon-pattern))) + (action-gadget labelled-gadget-mixin) + ((show-as-default :initform nil :initarg :show-as-default + :accessor push-button-show-as-default) + (pattern :initarg :pattern) + (icon-pattern :initarg :icon-pattern))) ;;; Toggle button diff --git a/silica/medium.lisp b/silica/medium.lisp index a303dd797c24ab864fe629cf0c6af62f1d3504cd..598788dc767593ee73cee8a75b3a87f1a8d576a1 100644 --- a/silica/medium.lisp +++ b/silica/medium.lisp @@ -107,7 +107,7 @@ (defclass sheet-with-resources-mixin () ((foreground :initform nil :accessor pane-foreground) (background :initform nil :accessor pane-background) - (text-style :initform nil :accessor pane-text-style) + (text-style :initform nil :initarg :text-style :accessor pane-text-style) (initargs :initform nil :reader sheet-with-resources-initargs))) (defmethod initialize-instance :after diff --git a/silica/scroll-pane.lisp b/silica/scroll-pane.lisp index a64f76046d7c0a91605a46b391f5157ddc82b34e..3516fb240c0af5c060fe43820e524146d09a42a1 100644 --- a/silica/scroll-pane.lisp +++ b/silica/scroll-pane.lisp @@ -239,7 +239,7 @@ (:horizontal (- right left)) (:vertical (- bottom top)))))) -(defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation) +(defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) (with-slots (current-size current-value port) scroll-bar (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) @@ -252,7 +252,7 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation) +(defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) (with-slots (current-size current-value port) scroll-bar (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) @@ -265,7 +265,7 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation) +(defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) (with-slots (current-size current-value) scroll-bar (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) @@ -279,7 +279,7 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation) +(defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever) (with-slots (current-size current-value) scroll-bar (with-slots (viewport contents) scroller-pane (let* ((contents-range (contents-range scroller-pane orientation)) @@ -293,11 +293,11 @@ (scroll-bar-value-changed-callback scroll-bar scroller-pane orientation new-value current-size))))) -(defmethod scroll-to-top-callback ((scroll-bar scroll-bar-pane) client id) +(defmethod scroll-to-top-callback ((scroll-bar scroll-bar-pane) client id whatever) (with-slots (current-size current-value) scroll-bar (scroll-bar-value-changed-callback scroll-bar client id 0 current-size))) -(defmethod scroll-to-bottom-callback ((scroll-bar scroll-bar-pane) client id) +(defmethod scroll-to-bottom-callback ((scroll-bar scroll-bar-pane) client id whatever) (with-slots (current-size current-value) scroll-bar (scroll-bar-value-changed-callback scroll-bar client id 1.0 current-size)))