[Query driven ranged item viewer
clinton@unknownlamer.org**20080111201103
 Views subsets of a database using query functions to fetch only the
 needed data
] hunk ./src/web-common.lisp 57
+;; database driven range-view
+;; Fetches current window and such using a query protocol
+(defcomponent database-range-view ()
+  ((offset :initarg :offset
+           :accessor range-view.offset
+           :initform 0
+           :backtrack t)
+   (current-window :initform nil :accessor range-view.current-window)
+   (window-size :accessor range-view.window-size :initform 20
+						 :initarg :window-size)
+   (total-items :accessor range-view.total-items)
+   (reverse :accessor reversep :initform nil :initarg :reverse)))
+
+(defgeneric range-view.window-count (range))
+
+(defgeneric range-view-get-instances (range-view lower upper 
+						 &key limit skip from-end)
+  (:documentation "lower and upper are exclusive limits"))
+
+(defgeneric range-view-total-instances (range-view)
+  (:documentation "Ask the database for the total number of
+  instances. By default this value is cached by
+  range-view.total-items"))
+
+(defmethod initialize-instance :after ((r database-range-view)
+				       &key &allow-other-keys)
+  (setf (range-view.offset r) (range-view.offset r)))
+
+(defmethod range-view.current-window-items ((range database-range-view))
+  (mapcar #'cdr (range-view.current-window range)))
+
+(defmethod range-view.total-items ((range database-range-view))
+  (if (slot-boundp range 'total-items)
+      (slot-value range 'total-items)
+      (setf (slot-value range 'total-items) (range-view-total-instances range))))
+
+(defun range-view-get-forward (range old-offset new-offset)
+  (let ((base-date (awhen (car (last (range-view.current-window-items range)))
+		     (show-date it)))
+	(limit (range-view.window-size range))
+	(skip (if (= new-offset old-offset)
+		  0
+		  (* (range-view.window-size range)
+		     (1- (- new-offset old-offset))))))
+    (if (reversep range)
+	(range-view-get-instances range nil base-date
+	 :from-end t :limit limit :skip skip)
+	(range-view-get-instances range base-date nil
+	 :from-end nil :limit limit :skip skip))))
+
+(defun range-view-get-backward (range old-offset new-offset)
+  (let ((base-date (awhen (car (range-view.current-window-items range))
+		     (show-date it)))
+	(limit (range-view.window-size range))
+	(skip (* (range-view.window-size range)
+		 (1- (- old-offset new-offset)))))
+    (if (reversep range)
+	(range-view-get-instances range base-date nil
+	 :from-end nil :limit limit :skip skip)
+	(range-view-get-instances range nil base-date
+	 :from-end t :limit limit :skip skip))))
+
+(defmethod (setf range-view.offset) :around (new-offset
+					     (range database-range-view))
+  (assert (>= new-offset 0) (new-offset))
+  (let ((old-offset (range-view.offset range)))
+    (call-next-method)
+    (setf
+     (range-view.current-window range)
+     (let ((start (* (range-view.window-size range)
+		     (range-view.offset range))))
+       (cond ;; Need to loop for the following cases when difference > 1
+	 ((>= new-offset old-offset)
+	  (mapcar
+	   (lambda (i) (cons (incf start) i))
+	   (range-view-get-forward range old-offset new-offset)))
+	 ((< new-offset old-offset)
+	  (nreverse
+	   (mapcar (lambda (i) (cons (incf start) i))
+		   (range-view-get-backward range old-offset new-offset))))))))
+  
+  new-offset)
+
+(defmethod range-view.have-previous-p ((range database-range-view))
+  (not (zerop (range-view.offset range))))
+
+(defmethod range-view.have-next-p ((range database-range-view))
+  (let ((base-date (awhen (car (last (range-view.current-window-items range)))
+		     (show-date it))))
+    (if (reversep range)
+	(range-view-get-instances range nil base-date :limit 1 :from-end t)
+	(range-view-get-instances range base-date nil :limit 1))))
+
+(defmethod range-view.window-count ((range database-range-view))
+  (ceiling (1- (/ (range-view.total-items range)
+		  (range-view.window-size range)))))
+
+(defmethod/cc scroll-start ((range database-range-view))
+  (setf (range-view.offset range) 0))
+
+(defmethod/cc scroll-end ((range database-range-view))
+  (setf (range-view.offset range) (range-view.window-count range)))
+
+(defmethod/cc scroll-forward ((range database-range-view) &optional (n 1))
+  (let ((offset (+ n (range-view.offset range))))
+    (if (> offset (range-view.window-count range))
+	(scroll-end range)
+	(setf (range-view.offset range) offset))))
+
+(defmethod/cc scroll-backward ((range database-range-view) &optional (n 1))
+  (let ((offset (- (range-view.offset range) n)))
+    (if (<= offset 0)
+	(scroll-start range)
+	(setf (range-view.offset range) offset))))
+
+(defmethod/cc scroll-to-page ((range database-range-view) &optional (n 1))
+  (cond ((< offset 0) (scroll-start range))
+	((> offset (range-view.window-count range)) (scroll-end range))
+	(t (setf range-view.offset range) n)))
+