Monday, December 10, 2007

Adding new weblocks type

Note:
For better formatted version of the code mentioned in this text please check:
http://paste.lisp.org/display/52281
http://paste.lisp.org/display/52282

Weblocks supports several built in types for specifying behaviour of slots. The list includes : boolean, member, keyword, us-states & symbol (Dec 11 20007). But if none of those suits your needs you have to write your own.
I needed a slot that will be rendered as textarea tag for entering input, so after a little consultation at the weblocks group I started with coding.
First I created a new file called text.lisp at /cl-weblocks/src/types/ directory, defining a new type called text.

(in-package weblocks)
(export '(text))
(deftype text () 'string)
Than I needed a function that will do the actual rendering of html code. File html-utils.lisp located at /cl-weblocks/src/snippets/ contains functions for rendering various kinds of elements : links, buttons, checkboxes, dropdowns, radio-buttons, & close-buttons (Dec 11 2007]. Unfortunately the functionality I needed, rendering textarea wasn't there. So I added it myself:
;;;html-utils.lisp
(defun render-textarea (name value maxlength rows cols &key id (class "textarea-class"))
"Renders a textarea in a form.
'name' - name of the html control. The name is attributized before being rendered.
'value' - a value on html control. Humanized name is default.
'id' - id of the html control. Default is nil.
maxlength - maximum lentgh of the field
rows - number of rows in textarea
cols - number of columns in textarea
'class' - a class used for styling. By default,
\"textarea\"."
(with-html
(:textarea :name name :id id :maxlength maxlength
:rows rows :cols cols :class class
(cl-who:str (or value ""))
)
)
)

The above code is based around cl-who with-html-output macro. I faced a problem with generating string from my value variable, somehow it vanished from generated string, but that problem was quickly solved with a help from c.l.l. denizens Sohail, Maciej & Alessio. Thank you guys. Afterwards I wrote a test cases in /cl-weblocks/test/snippets/html-utils.lisp. Every bit of code in Weblocks that could be tested is covered by test cases, and after adding yours be sure that you didn't break any of the previous tests.

;; test render-textarea
(deftest-html render-textarea-1
(render-textarea 'name1 'value1 200 4 20 :id 'id1 :class 'class1 )
(:textarea :name "NAME1" :id "ID1" :maxlength 200 :rows 4 :cols 20 :class "CLASS1"
(cl-who:str (princ-to-string 'value1))
)
)


(deftest-html render-textarea-2
(render-textarea 'name2 'value2 200 4 20)
(:textarea :name "NAME2" :maxlength 200 :rows 4 :cols 20 :class "textarea-class"
(cl-who:str (princ-to-string 'value2))
)
)


Back to my text.lisp file I've added several globals that contain default values of rows, columns, length of the input and number of rendered characters. Also I added corresponding generic functions so user could easily override default values:

(defparameter *textarea-rows* 5
"Default number of rows rendered in textarea"
)


(defgeneric textarea-rows (obj slot-name slot-type)
(:documentation
"Must return a maximum length of user input for a given
slot. Default implementation returns the value of
*max-raw-input-length*."
)
)


(defmethod textarea-rows (obj slot-name slot-type)
*textarea-rows*
)


(defparameter *textarea-cols* 20
"Default number of columns rendered in textarea"
)


(defgeneric textarea-cols (obj slot-name slot-type)
(:documentation
"Must return a maximum length of user input for a given
slot. Default implementation returns the value of
*max-raw-input-length*."
)
)


(defmethod textarea-cols (obj slot-name slot-type)
*textarea-cols*
)


(defparameter *text-max-input-length* 200
"Default value of the text type maximum input length"
)


(defparameter *text-max-rendered-characters* 10
"Default value of text maximum characters that will be rendered"
)


(defslotmethod max-raw-slot-input-length (obj slot-name (slot-type (eql 'text)))
" Returns default maximum input length for the text type, override for customization"
*text-max-input-length*
)

Note that everything is commented, weblocks documentations is automatically generated by tinaa so document your code, your effort will be appreciated. The meat of the text type functionality is consisted of three slot methods:
Render-form-value specializes corresponding generic function with text as slot-type argument. It's job is to call render-textarea with appropriate arguments.

(defslotmethod render-form-value (obj slot-name (slot-type (eql 'text)) slot-value &rest
keys &key slot-path intermediate-fields &allow-other-keys
)

"Textarea slotmethod specializes on rendering string into textarea, simigliar code to render-form-value"
(let ((attributized-slot-name (attributize-name (if slot-name slot-name (last-item slot-path))))
(intermediate-value (slot-intermedia-value slot-name intermediate-fields))
)

(render-textarea attributized-slot-name
(if intermediate-value
(cdr intermediate-value)
(apply #'form-print-object obj slot-name
slot-type slot-value keys
)
)

(max-raw-slot-input-length obj slot-name slot-type)
(textarea-rows obj slot-name slot-type)
(textarea-cols obj slot-name slot-type)
)
)
)

Text type will hold large strings, default maximum is 200 characters, if we render all of them in data-view within datagrid & dataform widgets, both of them will become unreadable. That's why I decided to render only 9 characters fallowed by 3 dots. If the string is smaller than 10 characters it'll be rendered completely.

(defslotmethod data-print-object (obj slot-name (slot-type (eql 'text)) slot-value
&rest args
)

"Renders maximum amount of characters allowed for the slot + ... or the full length of the slot if it is smaller than the maximum length allowed"
(format nil (if (< (length slot-value) *text-max-rendered-characters*)
slot-value
(concatenate 'string
(subseq slot-value 0 *text-max-rendered-characters*) "..."
)
)
)
)


The problem with above specilization is that I screwed up my rendering in the form view. The above render-form-value uses form-print-object that uses data-print-object specialized. So if I enter something like "Very long and boring text " in textarea, it'll be rendered as "Very long..." in data view, that's something that I intended. But it will be also rendered like that in form view, and when we try to modify it the string will be cut to only 9 characters fallowed by 3 dots, something that I don't want. Because I want a full text in order to make adjustements. So I used form-print-object specialised in text type to dispatch printing of the string as usual.


(defslotmethod form-print-object (obj slot-name (slot-type (eql 'text)) slot-value
&rest args
)

"Used to dispatch rendering slot-value to data-print-object with (slot-type standard-object)"
(when slot-value
(apply #'data-print-object obj slot-name t slot-value args)
)
)


I've added test cases for the above functions in a new file text.lisp placed in /cl-weblocks/test/types/


(in-package :weblocks-test)

(defclass text-employee ()
((text-slot :initform nil :type text :initarg :text-slot))
)


;;; Create instances for introspection testing
(defparameter *text-joe* (make-instance 'text-employee :text-slot "Joe"))
(defparameter *text-bob* (make-instance 'text-employee :text-slot "Bob"))


(deftest textarea-rows/1
(textarea-rows t t t)
5
)


(deftest textarea-cols/1
(textarea-cols t t t)
20
)


(deftest-html render-form-value/text1
(render-form-value *text-joe* 'text-slot 'text "Joe")
(:textarea :name "text-slot" :maxlength 200 :rows 5 :cols 20 :class "textarea-class"
(cl-who:str "Joe")
)
)


(deftest-html render-form-value/text2
(render-form-value *text-bob* 'text-slot 'text "Bob")
(:textarea :name "text-slot" :maxlength 200 :rows 5 :cols 20 :class "textarea-class"
(cl-who:str "Bob")
)
)


(deftest data-print-object/1
(data-print-object *text-joe* 'text-slot 'text "123456789012345678901234567890")
"1234567890..."
)


(deftest data-print-object/1
(data-print-object *text-joe* 'text-slot 'text "123456789")
"123456789"
)


(deftest form-print-object/1
(form-print-object t 'text-slot 'text "123456789")
"123456789"
)


(deftest form-print-object/1
(form-print-object t 'text-slot 'text "12345678901234567890123456789")
"12345678901234567890123456789"
)


And the final thing was including my new files into corresponding asd files weblocks.asd and weblocks-test.add to enable automatic loading of my new type. My new type is ready for use, you can try it with specifying new slot as :type text .


cheers
Slobodan Blazeski

4 comments:

  1. This is good in how it shows you would add a type but I would make the textarea a clos class and have all the properties as slots, not globals. An app can contain multiple textareas. How do you foresee changing properties of these?

    ReplyDelete
  2. Just imagine you have a class with two text slots and you want text-slot1 to have a 40 rows instead of default five so you will specialize textarea-rows functions
    and the rest is taken care by weblocks.
    See the code at http://paste.lisp.org/display/52312 comment formatting really sucks.

    Slobodan

    ReplyDelete
  3. PRINC-TO-STRING is still redundant, STR in WITH-HTML-OUTPUT expands to PRINC already.

    ReplyDelete
  4. Nice catch but it's only in the test cases so it won't do any harm. I already send the patch to Slava so when he checks the patch and makes the remarks I will fix that, togather with some improper comments.

    thanks for pointing out

    Slobodan

    ReplyDelete

Note: Only a member of this blog may post a comment.