Hi Leslie,
"Leslie P. Polzer" <[email protected]> writes:
[...]
> Assume we're showing items 1-10 gathered from the CLSQL store;
> then we will never filter the rest of the items at all (because
> DATASEQ-DATA
> will only work on the paginated set). This is not how the original
> isearch
> worked and messes with your expectations.
Thanks for your explanation.
I've made a completely rewritten version taking this into account.
Sorry for the code dump, maybe I will have some time to look at it next
week.
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"weblocks" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/weblocks?hl=en
-~----------~----~----~----~------~----~------~--~---
diff -r efc83a14156b pub/stylesheets/layout.css
--- a/pub/stylesheets/layout.css Wed Jul 15 18:01:35 2009 +0200
+++ b/pub/stylesheets/layout.css Fri Aug 14 18:15:51 2009 +0900
@@ -7,19 +7,10 @@
div.page-wrapper
{
- max-width: 70em;
- min-width: 60em;
-
margin: 0 auto;
text-align: left;
}
-/* IE 6 specific hacks (has layout and min-width)*/
-* html div.page-wrapper
-{
- width: 70em;
-}
-
.page-wrapper .page-extra-top-1,
.dialog .dialog-extra-top-1
{
diff -r efc83a14156b src/error-handler.lisp
--- a/src/error-handler.lisp Wed Jul 15 18:01:35 2009 +0200
+++ b/src/error-handler.lisp Fri Aug 14 18:15:51 2009 +0900
@@ -30,9 +30,12 @@
;;; 500 errors deserve special attention
(defun print-trivial-backtrace (c)
- (if (not (nth-value 1 (ignore-errors (asdf:oos 'asdf:load-op :trivial-backtrace))))
- (funcall (find-symbol "PRINT-BACKTRACE" :trivial-backtrace) c :output nil)
- "Please install TRIVIAL-BACKTRACE to get a simple backtrace on your platform."))
+ (symbol-macrolet ((sym (find-symbol "PRINT-BACKTRACE" :trivial-backtrace)))
+ (unless sym
+ (ignore-errors (asdf:oos 'asdf:load-op :trivial-backtrace)))
+ (if sym
+ (funcall sym c :output nil)
+ "Please install TRIVIAL-BACKTRACE to get a simple backtrace on your platform.")))
(defmethod handle-error-condition ((app weblocks-webapp) c)
"Print a pretty platform-specific backtrace if possible;
@@ -49,25 +52,5 @@
(:h2 "Restarts")
(:p "TODO")
(:h2 "Backtrace")
- #-sbcl
- (:pre (esc (format nil "~A" (print-trivial-backtrace c))))
- #+sbcl
- (let ((frames (sb-debug:backtrace-as-list)))
- (htm
- (:table
- (:thead
- (:tr
- (:th "") (:th "Function") (:th "Arguments")))
- (:tbody
- (loop for frame in frames
- for i from (length frames) downto 0
- for parity = (if (oddp i) "odd" "even")
- do (htm
- (:tr :class parity
- (:td :class "frame-number" (esc (format nil "~D" i)))
- (:td :class "frame-call" (:code (esc (format nil "~A" (car frame)))))
- (:td :class "frame-args"
- (:ol
- (dolist (arg (cdr frame))
- (htm (:li (:code (esc (format nil "~A" arg)))))))))))))))))
+ (:pre (esc (format nil "~A" (print-trivial-backtrace c))))))
diff -r efc83a14156b src/utils/isearch.lisp
--- a/src/utils/isearch.lisp Wed Jul 15 18:01:35 2009 +0200
+++ b/src/utils/isearch.lisp Fri Aug 14 18:15:51 2009 +0900
@@ -6,11 +6,11 @@
render-isearch
make-isearch-regex))
-(defparameter *isearch-input-delay* 0.4
+(defparameter *isearch-input-delay* 2
"Delay in seconds after keystrokes a client should wait before it
sends an isearch request.")
-(defparameter *isearch-max-input-length* 80
+(defparameter *isearch-max-input-length* 200
"Maximum input length allowed in an isearch.")
(defun render-isearch (input-name isearch-fn &key value
diff -r efc83a14156b src/versioning.lisp
--- a/src/versioning.lisp Wed Jul 15 18:01:35 2009 +0200
+++ b/src/versioning.lisp Fri Aug 14 18:15:51 2009 +0900
@@ -85,11 +85,14 @@
(defun update-versioned-dependency-path (original-path &optional other-path)
"If the file has been modified, it is copied and renamed with the correct version number in the same directory. If the file has never being modified before, its name is kept the same."
(bordeaux-threads:with-lock-held (*version-dependencies-lock*)
- (let ((mod-record (get-mod-record original-path :versioning-p t)))
- (when (file-modified-p mod-record) (update-mod-record mod-record :versioning-p t))
- (with-slots (last-version) mod-record
- (values (make-versioned-path original-path last-version)
- (make-versioned-path other-path last-version))))))
+ (let ((mod-record (ignore-errors (get-mod-record original-path :versioning-p t))))
+ (cond (mod-record
+ (when (file-modified-p mod-record) (update-mod-record mod-record :versioning-p t))
+ (with-slots (last-version) mod-record
+ (values (make-versioned-path original-path last-version)
+ (make-versioned-path other-path last-version))))
+ (t
+ (values original-path other-path))))))
;;; Dealing with CSS import rules
diff -r efc83a14156b src/widgets/dataseq/dataseq.lisp
--- a/src/widgets/dataseq/dataseq.lisp Wed Jul 15 18:01:35 2009 +0200
+++ b/src/widgets/dataseq/dataseq.lisp Fri Aug 14 18:15:51 2009 +0900
@@ -235,15 +235,20 @@
(dataseq-data-class obj)
(class-name (dataseq-data-class obj)))))))
-;;; Dataset management
-(defun dataseq-data (obj)
- "Returns the items in the sequence. If 'dataseq-on-query' is a
+(defgeneric dataseq-data-range (obj &optional begin end)
+ (:method (obj &optional begin end)
+ (assert (eq (not (and begin end)) (not (or begin end))))
+ (dataseq-unprocessed-data-range obj begin end))
+ (:documentation "Returns a sequence of data between begin and end; if both begin and end are null, then returns all data"))
+
+(defgeneric dataseq-unprocessed-data-range (dataseq &optional begin end)
+ (:documentation "Returns a sequence of data between begin and end unfiltered by any processing; if both begin and end are null, then returns all data"))
+
+(defmethod dataseq-unprocessed-data-range ((obj dataseq) &optional begin end)
+ "Returns the items in the sequence. If 'dataseq-on-query' is a
function designator, calls the function designated by
-'dataseq-on-query'. Otherwise, uses persistent store API."
- (multiple-value-bind (begin end)
- (when (dataseq-allow-pagination-p obj)
- (pagination-page-item-range (dataseq-pagination-widget obj)))
- (if (function-designator-p (dataseq-on-query obj))
+'dataseq-on-query'. Otherwise, uses persistent store API."
+ (if (function-designator-p (dataseq-on-query obj))
(funcall (dataseq-on-query obj)
obj (dataseq-sort obj)
(when (and begin end) (cons begin end)))
@@ -252,9 +257,21 @@
(dataseq-data-class obj)
:order-by (dataseq-sort obj)
:range (when (and begin end) (cons begin end))
- (dataseq-on-query obj)))))
+ (dataseq-on-query obj))))
-(defun dataseq-data-count (obj)
+
+
+;;; Dataset management
+(defun dataseq-data (obj)
+ "Returns the items in the sequence or one page of them if pagination is active"
+ (multiple-value-bind (begin end)
+ (when (dataseq-allow-pagination-p obj)
+ (pagination-page-item-range (dataseq-pagination-widget obj)))
+ (dataseq-data-range obj begin end)))
+
+(defgeneric dataseq-data-count (obj))
+
+(defmethod dataseq-data-count ((obj dataseq))
"Returns the number of items in the sequence."
(if (function-designator-p (dataseq-on-query obj))
(funcall (dataseq-on-query obj)
diff -r efc83a14156b src/widgets/pagination.lisp
--- a/src/widgets/pagination.lisp Wed Jul 15 18:01:35 2009 +0200
+++ b/src/widgets/pagination.lisp Fri Aug 14 18:15:51 2009 +0900
@@ -191,7 +191,7 @@
(ignore-errors
(let ((page (parse-integer page-number)))
(assert (and (>= page 1)
- (<= page (pagination-page-count obj))))
+ (<= page (max 1 (pagination-page-count obj)))))
(setf (pagination-current-page obj) page)
(pagination-call-on-change obj)))
(declare (ignore res))
@@ -204,3 +204,6 @@
(flash (flash-message on-error msg))
(function (funcall on-error msg)))))))
+(defun pagination-reset (obj count)
+ (setf (pagination-total-items obj) count)
+ (pagination-on-go-to-page obj :page-number "1"))
diff -r efc83a14156b weblocks.asd
--- a/weblocks.asd Wed Jul 15 18:01:35 2009 +0200
+++ b/weblocks.asd Fri Aug 14 18:15:51 2009 +0900
@@ -15,7 +15,7 @@
:description "A Common Lisp web framework."
:depends-on (:closer-mop :metatilities :hunchentoot :cl-who :cl-ppcre :cl-json :puri :md5
:cl-fad :fare-matcher :cl-cont :parenscript :anaphora :f-underscore
- :bordeaux-threads :salza2 :trivial-timeout)
+ :bordeaux-threads :salza2 :trivial-timeout #-sbcl :trivial-backtrace)
:components ((:module src
:components (
(:file "package")
@@ -28,7 +28,8 @@
(:file "list")
(:file "uri")
(:file "html")
- (:file "isearch")
+ (:file "isearch"
+ :depends-on ("html"))
(:file "menu"
:depends-on ("html"))
(:file "suggest")
[...]
>> I think MSI might be willing to do a bit of work to get it tidy enough to be
>> included.
>
> That would be great. The current version would need some minor
> beautification, a fix for the problem above and ideally some tests.
One major issue is that if isearch box is marked dirty then when the
ajax call comes back, it will overwrite any further user input. This is
extremely annoying with slow AJAX.
I would like to fix this before tidying up. Maybe the mixin approach is wrong?
[...]
(in-package :weblocks)
(defwidget filtered-dataseq (dataseq)
((filter-string
:initform ""
:accessor filtered-dataseq-filter-string
:documentation "User provided string for filtering")))
(defwidget cached-filtered-dataseq (filtered-dataseq)
((filter-cache-count :initform nil)
(filter-cache-seq :initform nil)))
(defwidget regex-filtered-dataseq (cached-filtered-dataseq)
((scanner :initform nil :accessor filtered-dataseq-scanner
:documentation "regex scanner to filter the view by")
))
(defwidget regex-filtered-datagrid (datagrid regex-filtered-dataseq)
())
(defwidget regex-filtered-gridedit (gridedit regex-filtered-dataseq)
())
(defmethod render-widget-body :before ((obj filtered-dataseq) &rest args)
(declare (ignorable args))
(with-html
(:div :class "search_side" :id "search_ui_id"
(filtered-dataseq-render-search-ui obj))))
(defgeneric filtered-dataseq-update-filter (obj filter)
(:method ((obj dataseq) filter)
(setf (filtered-dataseq-filter-string obj) filter)
(when (dataseq-allow-pagination-p obj)
(pagination-reset (dataseq-pagination-widget obj) (dataseq-data-count
obj)))
(mark-dirty obj)
filter))
(defgeneric cached-filtered-dataseq-update (obj filter))
(defmethod filtered-dataseq-update-filter :before ((obj
cached-filtered-dataseq) filter)
(multiple-value-bind (seq len)
(cached-filtered-dataseq-update obj filter)
(with-slots (filter-cache-count filter-cache-seq)
obj
(setf filter-cache-count len
filter-cache-seq seq))))
(defmethod dataseq-data-range ((obj cached-filtered-dataseq) &optional begin
end)
(with-slots (filter-cache-count filter-cache-seq)
obj
(cond ((not filter-cache-count) (call-next-method))
(t
(if begin
(subseq filter-cache-seq begin end)
filter-cache-seq)))))
(defmethod dataseq-data-count ((obj cached-filtered-dataseq))
(with-slots (filter-cache-count)
obj
(or filter-cache-count (call-next-method))))
(defgeneric filtered-dataseq-render-search-ui (obj &rest args))
(defmethod filtered-dataseq-render-search-ui ((obj filtered-dataseq) &rest args)
(declare (ignorable args))
(let ((sym (gensym "search")))
(render-isearch "filter" (f (&rest args &key filter &allow-other-keys)
(declare (ignore args))
(unless (equal filter
(filtered-dataseq-filter-string obj))
(filtered-dataseq-update-filter obj filter)))
:class (if (not (zerop (length
(filtered-dataseq-filter-string obj))))
"filtered_dataseq_search_filtered"
"filtered_dataseq_search_empty")
:value (filtered-dataseq-filter-string obj)
:input-id sym)
;(send-script (ps* `(.activate ($ ,sym)))) ;why the hell does this not work?
(send-script (format nil "$('~A').focus();" sym))
))
(declaim (inline regex-filtered-dataseq-object-to-string))
(defun regex-filtered-dataseq-object-to-string (dataseq obj)
(let ((view (dataseq-view dataseq)))
(with-output-to-string (s)
(map-view-fields
(lambda (field-info)
(let ((field (field-info-field field-info))
(obj (field-info-object field-info)))
(princ
(print-view-field-value (obtain-view-field-value field obj)
(view-field-presentation field)
field
view
dataseq
obj)
s)
(princ "/" s)))
view
obj))))
(defmethod cached-filtered-dataseq-update ((obj regex-filtered-dataseq) filter)
(let ((scanner
(setf (filtered-dataseq-scanner obj)
(when (not (zerop (length filter)))
(ignore-errors
(cl-ppcre:create-scanner filter :case-insensitive-mode
(notany #'upper-case-p filter)))))))
(when scanner
(let ((seq (dataseq-unprocessed-data-range obj)) (count 0))
(values
(with-standard-io-syntax
(remove-if-not
(lambda (item)
(when (cl-ppcre:all-matches scanner
(regex-filtered-dataseq-object-to-string obj item))
(incf count)))
seq))
count)))))
