Skip to content
Snippets Groups Projects
Commit 83dd87b0 authored by Jacek Złydach's avatar Jacek Złydach
Browse files

Including further silica gadgets.

parent 59eb57b7
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment