Commit | Line | Data |
---|---|---|
90e37ea3 DC |
1 | (in-package :mewa) |
2 | ||
3 | ||
39f10cc7 DC |
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) => | |
7 | (ITEMS LIST) | |
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).")) | |
12 | ||
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) | |
16 | (last-select-size 0)) | |
17 | (labels ((guess-total-size () | |
18 | (car | |
19 | (apply #'clsql:select | |
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) | |
25 | (append query | |
26 | `(:limit ,(+ size 1) :offset ,(* (- offset 1) size) :flatp t)))) | |
27 | (chunks () | |
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) | |
32 | (setf current-offset | |
33 | (case cmd | |
34 | (:first 1) | |
35 | (:last (chunks)) | |
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))) | |
40 | (ecase cmd | |
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) | |
45 | (nbutlast items)) | |
46 | items)) | |
47 | (:chunks (chunks)) | |
48 | (:chunk-size (when num (setf chunk-size num)) | |
49 | chunk-size) | |
50 | (:offset current-offset) | |
51 | (:have-previous-p (> current-offset 1)) | |
52 | (:have-next-p (> last-select-size chunk-size))))))) | |
53 | ||
54 | (defcomponent range-list (mewa::mewa-list-presentation) | |
55 | ((offset :accessor range-list.offset | |
56 | :initform 0 | |
57 | :backtrack t | |
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. | |
63 | ||
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")) | |
70 | ||
71 | (defmethod range-list.generator :before ((self range-list)) | |
72 | (unless (slot-boundp self 'generator) | |
73 | (create-generator self))) | |
74 | ||
75 | (defmethod create-generator ((self range-list) &rest args) | |
76 | (with-slots (instance generator generator-args window-size offset) | |
77 | self | |
78 | (when args | |
79 | (setf generator-args args)) | |
80 | (setf generator | |
81 | (apply 'make-range-list-generator instance :chunk-size window-size generator-args) | |
82 | offset 0) | |
83 | (funcall generator :offset offset))) | |
84 | ||
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)) | |
88 | ||
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)) | |
92 | ||
93 | (defmethod range-list.fetch-items ((self range-list) op) | |
94 | (prog2 | |
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)))) | |
99 | ||
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))) | |
104 | ||
105 | (defaction scroll-to-page ((self range-list) window-number) | |
106 | (setf (range-list.offset self) window-number) | |
107 | (scroll self :current)) | |
108 | ||
109 | (defmethod present ((self range-list)) | |
110 | (when (zerop (range-list.offset self)) | |
111 | (scroll self :current)) | |
112 | (<:table :class (css-class self) | |
113 | (<:tr | |
114 | (<:td (call-next-method))) | |
115 | (<:tr | |
116 | (<:td | |
117 | (<:table :class "range-list-navigation" | |
118 | (<:tr | |
119 | (<:td | |
120 | (<ucw:a :action (scroll self :first) | |
121 | (<:tt (<:as-html "<<")))) | |
122 | (<:td | |
123 | (if (range-list.have-previous-p self) | |
124 | (<ucw:a :action (scroll self :previous) | |
125 | (<:tt (<:as-html "<"))) | |
126 | (<:tt (<:as-html "<")))) | |
127 | (<:td | |
128 | (if (range-list.have-next-p self) | |
129 | (<ucw:a :action (scroll self :next) | |
130 | (<:tt (<:as-html ">"))) | |
131 | (<:tt (<:as-html ">")))) | |
132 | (<:td | |
133 | (<ucw:a :action (scroll self :last) | |
134 | (<:tt (<:as-html ">>")))))))))) |