From 39f10cc75a034c84e16bbf521082d1df96673616 Mon Sep 17 00:00:00 2001 From: Drew Crampsie Date: Mon, 11 Jul 2005 15:35:34 -0700 Subject: [PATCH] Added range-list presentation darcs-hash:20050711223534-5417e-9ef75c36171aa779faddeac186113bb3aa511495.gz --- lisp-on-lines.asd | 5 +- src/components/range-list.lisp | 131 +++++++++++++++++++++++++++++++++ 2 files changed, 135 insertions(+), 1 deletion(-) create mode 100644 src/components/range-list.lisp diff --git a/lisp-on-lines.asd b/lisp-on-lines.asd index 89ac0d1..45cf603 100644 --- a/lisp-on-lines.asd +++ b/lisp-on-lines.asd @@ -34,5 +34,8 @@ :depends-on (:ucw :meta-model)) (defsystem :lisp-on-lines - :components ((:static-file "lisp-on-lines.asd")) + :components ((:static-file "lisp-on-lines.asd") + (:module :components + :pathname "src/components/" + :components ((:file "range-list")))) :depends-on (:meta-model :mewa)) diff --git a/src/components/range-list.lisp b/src/components/range-list.lisp new file mode 100644 index 0000000..0e4e28f --- /dev/null +++ b/src/components/range-list.lisp @@ -0,0 +1,131 @@ +(defgeneric make-range-list-generator (instance &key query chunk-size &allow-other-keys) + (:documentation "Produced generator must obeys the following interface: +GENERATOR (:first|:last|:next|:previous|:current &optional offset) => + (ITEMS LIST) +GENERATOR :offset &optional (offset integer) => (new-offset integer) +GENERATOR :chunk-size (size integer) => (new-chunk-size integer) +GENERATOR :chunks => (total-number-of-chunks integer) +GENERATOR (:have-previous-p|:have-next-p) => (v boolean).")) + +(defmethod make-range-list-generator ((instance clsql:standard-db-object) &key query (chunk-size 20) (offset 0)) + (let ((view-class (class-of instance)) + (current-offset offset) + (last-select-size 0)) + (labels ((guess-total-size () + (car + (apply #'clsql:select + (clsql:sql-count (clsql:sql-expression :attribute '*)) + :from (clsql:sql-expression :table (slot-value view-class 'clsql:view-table)) + (append query '(:flatp t))))) + (select-items (offset size) + (apply #'clsql:select (class-name view-class) + (append query + `(:limit ,(+ size 1) :offset ,(* (- offset 1) size) :flatp t)))) + (chunks () + (multiple-value-bind (q rem) + (floor (guess-total-size) chunk-size) + (if (zerop rem) q (+ q 1))))) + (lambda (cmd &optional num) + (setf current-offset + (case cmd + (:first 1) + (:last (chunks)) + (:next (+ 1 current-offset)) + (:previous (max 1 (- current-offset 1))) + ((:current :offset) (if num (max 1 num) current-offset)) + (otherwise current-offset))) + (ecase cmd + ((:first :last :next :previous :current) + (let ((items (select-items current-offset chunk-size))) + (setf last-select-size (length items)) + (when (> last-select-size chunk-size) + (nbutlast items)) + items)) + (:chunks (chunks)) + (:chunk-size (when num (setf chunk-size num)) + chunk-size) + (:offset current-offset) + (:have-previous-p (> current-offset 1)) + (:have-next-p (> last-select-size chunk-size))))))) + +(defcomponent range-list (mewa::mewa-list-presentation) + ((offset :accessor range-list.offset + :initform 0 + :backtrack t + :documentation "Which of the windows we're currently looking at.") + (window-size :accessor range-list.window-size :initform 20 :initarg :window-size) + (generator :reader range-list.generator) + (generator-args :reader range-list.generator-args :initarg generator-args :initform nil)) + (:documentation "Component for showing the user a set of data one \"window\" at a time. + +The data set is presented one \"window\" at a time with links to +the the first, previous, next and last window. Each window shows +at most WINDOW-SIZE elements of the data. +The GENERATOR is used to get a data to display every time. +It is produced by MAKE-RANGE-LIST-GENERATOR as +MAKE-RANGE-LIST-GENERATOR INSTANCE :chunk-size WINDOW-SIZE GENERATOR-ARGS")) + +(defmethod range-list.generator :before ((self range-list)) + (unless (slot-boundp self 'generator) + (create-generator self))) + +(defmethod create-generator ((self range-list) &rest args) + (with-slots (instance generator generator-args window-size offset) + self + (when args + (setf generator-args args)) + (setf generator + (apply 'make-range-list-generator instance :chunk-size window-size generator-args) + offset 0) + (funcall generator :offset offset))) + +(defmethod range-list.have-previous-p ((self range-list)) + "Returns true if we have a window before the current one." + (funcall (range-list.generator self) :have-previous-p)) + +(defmethod range-list.have-next-p ((self range-list)) + "Returns true if we have a window after the current one." + (funcall (range-list.generator self) :have-next-p)) + +(defmethod range-list.fetch-items ((self range-list) op) + (prog2 + (ecase op ((:first :last :current :next :previous) t)) + (funcall (range-list.generator self) op) + (setf (range-list.offset self) + (funcall (range-list.generator self) :offset)))) + +(defaction scroll ((self range-list) op) + (funcall (range-list.generator self) :offset (range-list.offset self)) + (setf (mewa::instances self) + (range-list.fetch-items self op))) + +(defaction scroll-to-page ((self range-list) window-number) + (setf (range-list.offset self) window-number) + (scroll self :current)) + +(defmethod present ((self range-list)) + (when (zerop (range-list.offset self)) + (scroll self :current)) + (<:table :class (css-class self) + (<:tr + (<:td (call-next-method))) + (<:tr + (<:td + (<:table :class "range-list-navigation" + (<:tr + (<:td + ("))) + (<:tt (<:as-html ">")))) + (<:td + (>")))))))))) -- 2.20.1