+++ /dev/null
-(in-package :lisp-on-lines)
-
-;;;; for when there is nothing left to display.
-(defcomponent empty-page (window-component)
- ())
-
-(defmethod render-on ((res response) (self empty-page))
- "didnt find a thing")
-
-(defcomponent auto-complete ()
- ((input-id :accessor input-id :initform (arnesi:random-string 10 arnesi:+ascii-alphabet+))
- (output-id :accessor output-id :initform (arnesi:random-string 10 arnesi:+ascii-alphabet+))
- (index-id :accessor index-id :initform (arnesi:random-string 10 arnesi:+ascii-alphabet+))
- (client-value :accessor client-value :initform "" :documentation "The string the user has, so far, insterted.")
- (selected-value-index :accessor selected-value-index :initform nil :documentation "The index in value-list of the item selected via Ajax")
- (value-list :accessor value-list :initform '())
- (values-generator :accessor values-generator :initarg :values-generator
- :documentation "Function which, when passed the auto-complete component, returns a list of objects.")
- (as-value :accessor as-value :initarg :as-value
- :documentation "Function which, when passed a value, returns the string to put in the text box.")
- (render :accessor render :initarg :render
- :documentation "Function which, when passed the component and one of the values render it (the value).")
- (input-size :accessor input-size :initarg :input-size :initform 20)
- (submit-on-click-p :accessor submit-on-click-p :initarg :submit-on-click-p :initform t)
- (output-component :accessor output-component :initarg :output-component :initform 'auto-complete-output)))
-
-(defmethod js-on-complete ((l auto-complete))
- `(lambda (transport)
- (setf (slot-value (document.get-element-by-id ,(output-id l))
- 'inner-h-t-m-l)
- transport.response-text)))
-
-(defmacro make-action-url (component action)
- "
-There has got to be something like this buried in UCW somewhere,
-but here's what i use."
- `(ucw::print-uri-to-string
- (compute-url ,component
- :action-id (ucw::make-new-action (ucw::context.current-frame *context*)
- (lambda ()
- (arnesi:with-call/cc
- ,action))))))
-
-(defmethod generate-ajax-request-for-action ((l auto-complete) &key (action-url "index.ucw"))
- `(new
- (*Ajax.*Request
- ,action-url
- (create))))
-
-(defmacro with-ajax-action ((component) &body action)
- `(generate-ajax-request-for-action ,component
- :action-url (make-action-url ,component (progn ,@action))))
-
-
-(defaction call-auto-complete ((self t) auto-complete-id value)
- (let ((auto-complete (get-session-value (intern auto-complete-id))))
- (if auto-complete
- (call-auto-complete-from-output auto-complete auto-complete-id value self)
- (call 'empty-page :message (error "ASD")))))
-
-(defaction call-auto-complete-from-output ((auto-complete auto-complete) auto-complete-id value output)
- (setf (client-value auto-complete) value)
- (let ((self output))
- (call (output-component auto-complete) :auto-complete auto-complete)
- (call 'empty-page :message (error "ASD"))))
-
-
-
-(defmethod js-on-select ((l auto-complete)))
-
-(defmethod render-on ((res response) (l auto-complete))
- ;; session-values are stored in an eql hash table.
- (let ((input-key (intern (input-id l))))
- ;; We are storing the input components in the session,
- ;; keyed on the string that we also use as the id for
- ;; the input field.
-
- (unless (get-session-value input-key)
- (setf (get-session-value input-key) l))
-
- ;; A hidden field to hold the index number selected via javascript
- (<ucw:input :type "hidden"
- :accessor (selected-value-index l)
- :id (index-id l))
- (<ucw:text :accessor (client-value l)
- :id (input-id l) :size (input-size l))
- (<:div :id (output-id l) :class "auto-complete" (<:as-html " ")))
- (let* ((a (make-symbol (format nil "~A-autocompleter" (input-id l))))
- (f (make-symbol (format nil "~A.select-entry-function"a))))
- (<ucw:script
- `(setf ,a
- (new
- (*Ajax.*Autocompleter
- ,(input-id l) ,(output-id l)
- ,(format nil "auto-complete.ucw?&auto-complete-id=~A&~A=~A"
- (input-id l) ucw::+session-parameter-name+
- (ucw::session.id (ucw::context.session ucw::*context*)))
- (create
- :param-name "value"))))
- `(setf ,f (slot-value ,a 'select-entry))
- `(setf (slot-value ,a 'select-entry)
- (lambda ()
- (,f)
- (setf (slot-value (document.get-element-by-id ,(index-id l)) 'value)
- (slot-value ,a 'index))
- ,(js-on-select l)
- )))))
-
-
-(defmethod find-selected-object ((self auto-complete))
- (if (< 0 (length (selected-value-index self)))
- (nth (parse-integer (selected-value-index self))
- (value-list self))))
-
-
-;;;; * auto-complete-ouput
-
-
-(defcomponent auto-complete-output (window-component)
- ((auto-complete :initarg :auto-complete :accessor auto-complete)))
-
-(defmethod render-on ((res response) (output auto-complete-output))
- (let ((auto-complete (auto-complete output)))
- (setf (value-list auto-complete)
- (funcall (values-generator auto-complete) (client-value auto-complete)))
- (<:ul
- :class "auto-complete-list"
- (arnesi:dolist* (value (value-list auto-complete))
- (<:li
- :class "auto-complete-list-item"
- (funcall (render auto-complete) value))))))
-
-
-(defcomponent fkey-auto-complete (auto-complete)
- ())
-
-(defmethod js-on-select ((self fkey-auto-complete))
- (with-ajax-action (self)
- (mewa::sync-foreign-instance (ucw::parent self) (find-selected-object self))))
-
-(defslot-presentation ajax-foreign-key-slot-presentation (mewa::foreign-key-slot-presentation)
- ((search-slots :accessor search-slots :initarg :search-slots :initform nil)
- (live-search
- :accessor live-search
- :component fkey-auto-complete))
- (:type-name ajax-foreign-key))
-
-
-(defmethod shared-initialize :after ((slot ajax-foreign-key-slot-presentation) slots &rest args)
- (let* ((l (live-search slot))
- (slot-name (slot-name slot))
- (instance (instance (ucw::parent slot)))
- (foreign-instance (explode-foreign-key instance slot-name))
- (class-name (class-name
- (class-of foreign-instance))))
- ;; If no search-slots than use the any slots of type string
- (unless (search-slots slot)
- (setf (search-slots slot) (find-slots-of-type foreign-instance)))
-
- (setf (lisp-on-lines::values-generator l)
- (lambda (input)
- (word-search class-name
- (search-slots slot) input)))
-
- (setf (lisp-on-lines::render l)
- (lambda (val)
- (<ucw:render-component
- :component (make-presentation val :type :one-line))))))
-
-
-
-(defmethod present-slot :around ((slot ajax-foreign-key-slot-presentation) instance)
- (setf (mewa::foreign-instance slot)
- (when (presentation-slot-value slot instance)
- (meta-model:explode-foreign-key instance (slot-name slot))))
- (flet ((render () (when (mewa::foreign-instance slot)(call-next-method))))
- (if (slot-boundp slot 'ucw::place)
- (cond
- ((editablep slot)
- (<ucw:render-component :component (live-search slot))
- (<ucw:submit :action (mewa::search-records slot instance) :value "find" :style "display:inline"))
- ((mewa::linkedp slot)
- (<ucw:a :action (mewa::view-instance slot (foreign-instance slot))
- (render)))
- (t
- (render)))
- ;; presentation is used only for rendering
- (render))))
\ No newline at end of file
HCoop / clinton / lisp-on-lines.git / blobdiff