| 1 | (in-package :mewa) |
| 2 | |
| 3 | |
| 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 ">>")))))))))) |