4 (defgeneric make-range-list-generator
(instance &key query chunk-size
&allow-other-keys
)
5 (:documentation
"Produced generator must obeys the following interface:
6 GENERATOR (:first|:last|:next|:previous|:current &optional offset) =>
8 GENERATOR :offset &optional (offset integer) => (new-offset integer)
9 GENERATOR :chunk-size (size integer) => (new-chunk-size integer)
10 GENERATOR :chunks => (total-number-of-chunks integer)
11 GENERATOR (:have-previous-p|:have-next-p) => (v boolean)."))
13 (defmethod make-range-list-generator ((instance clsql
:standard-db-object
) &key query
(chunk-size 20) (offset 0))
14 (let ((view-class (class-of instance
))
15 (current-offset offset
)
17 (labels ((guess-total-size ()
20 (clsql:sql-count
(clsql:sql-expression
:attribute
'*))
21 :from
(clsql:sql-expression
:table
(slot-value view-class
'clsql
:view-table
))
22 (append query
'(:flatp t
)))))
23 (select-items (offset size
)
24 (apply #'clsql
:select
(class-name view-class
)
26 `(:limit
,(+ size
1) :offset
,(* (- offset
1) size
) :flatp t
))))
28 (multiple-value-bind (q rem
)
29 (floor (guess-total-size) chunk-size
)
30 (if (zerop rem
) q
(+ q
1)))))
31 (lambda (cmd &optional num
)
36 (:next
(+ 1 current-offset
))
37 (:previous
(max 1 (- current-offset
1)))
38 ((:current
:offset
) (if num
(max 1 num
) current-offset
))
39 (otherwise current-offset
)))
41 ((:first
:last
:next
:previous
:current
)
42 (let ((items (select-items current-offset chunk-size
)))
43 (setf last-select-size
(length items
))
44 (when (> last-select-size chunk-size
)
48 (:chunk-size
(when num
(setf chunk-size num
))
50 (:offset current-offset
)
51 (:have-previous-p
(> current-offset
1))
52 (:have-next-p
(> last-select-size chunk-size
)))))))
54 (defcomponent range-list
(mewa::mewa-list-presentation
)
55 ((offset :accessor range-list.offset
58 :documentation
"Which of the windows we're currently looking at.")
59 (window-size :accessor range-list.window-size
:initform
20 :initarg
:window-size
)
60 (generator :reader range-list.generator
)
61 (generator-args :reader range-list.generator-args
:initarg generator-args
:initform nil
))
62 (:documentation
"Component for showing the user a set of data one \"window\" at a time.
64 The data set is presented one \"window\" at a time with links to
65 the the first, previous, next and last window. Each window shows
66 at most WINDOW-SIZE elements of the data.
67 The GENERATOR is used to get a data to display every time.
68 It is produced by MAKE-RANGE-LIST-GENERATOR as
69 MAKE-RANGE-LIST-GENERATOR INSTANCE :chunk-size WINDOW-SIZE GENERATOR-ARGS"))
71 (defmethod range-list.generator
:before
((self range-list
))
72 (unless (slot-boundp self
'generator
)
73 (create-generator self
)))
75 (defmethod create-generator ((self range-list
) &rest args
)
76 (with-slots (instance generator generator-args window-size offset
)
79 (setf generator-args args
))
81 (apply 'make-range-list-generator instance
:chunk-size window-size generator-args
)
83 (funcall generator
:offset offset
)))
85 (defmethod range-list.have-previous-p
((self range-list
))
86 "Returns true if we have a window before the current one."
87 (funcall (range-list.generator self
) :have-previous-p
))
89 (defmethod range-list.have-next-p
((self range-list
))
90 "Returns true if we have a window after the current one."
91 (funcall (range-list.generator self
) :have-next-p
))
93 (defmethod range-list.fetch-items
((self range-list
) op
)
95 (ecase op
((:first
:last
:current
:next
:previous
) t
))
96 (funcall (range-list.generator self
) op
)
97 (setf (range-list.offset self
)
98 (funcall (range-list.generator self
) :offset
))))
100 (defaction scroll
((self range-list
) op
)
101 (funcall (range-list.generator self
) :offset
(range-list.offset self
))
102 (setf (mewa::instances self
)
103 (range-list.fetch-items self op
)))
105 (defaction scroll-to-page
((self range-list
) window-number
)
106 (setf (range-list.offset self
) window-number
)
107 (scroll self
:current
))
109 (defmethod present ((self range-list
))
110 (when (zerop (range-list.offset self
))
111 (scroll self
:current
))
112 (<:table
:class
(css-class self
)
114 (<:td
(call-next-method)))
117 (<:table
:class
"range-list-navigation"
120 (<ucw
:a
:action
(scroll self
:first
)
121 (<:tt
(<:as-html
"<<"))))
123 (if (range-list.have-previous-p self
)
124 (<ucw
:a
:action
(scroll self
:previous
)
125 (<:tt
(<:as-html
"<")))
126 (<:tt
(<:as-html
"<"))))
128 (if (range-list.have-next-p self
)
129 (<ucw
:a
:action
(scroll self
:next
)
130 (<:tt
(<:as-html
">")))
131 (<:tt
(<:as-html
">"))))
133 (<ucw
:a
:action
(scroll self
:last
)
134 (<:tt
(<:as-html
">>"))))))))))