contrib-web/src/Web.st

Smalltalk createPackage: 'Web'!
(Smalltalk packageAt: 'Web' ifAbsent: [ self error: 'Package not created: Web' ]) imports: {'amber/core/Platform-DOM'. 'amber/web/Web-JQuery'}!
Object subclass: #HTMLCanvas
	slots: {#root}
	package: 'Web'!
!HTMLCanvas commentStamp!
I am a canvas for building HTML.

I provide the `#tag:` method to create a `TagBrush` (wrapping a DOM element) and convenience methods in the `tags` protocol.

## API

My instances are used as the argument of the `#renderOn:` method of `Widget` objects.

The `#with:` method is used to compose HTML, nesting tags. `#with:` can take a `TagBrush`, a `String`, a `BlockClosure` or a `Widget` as argument.

## Usage example:

    aCanvas a 
        with: [ aCanvas span with: 'click me' ];
        onClick: [ window alert: 'clicked!!' ]!

!HTMLCanvas methodsFor: 'accessing'!

root
	^ root ifNil: [ root := TagBrush fromString: 'div' canvas: self ]
!

root: aTagBrush
	self deprecatedAPI.
	root := aTagBrush
! !

!HTMLCanvas methodsFor: 'adding'!

entity: aString
	"Adds a character representing html entity, eg.
	html entity: 'copy'
	adds a copyright sign.
	If a name does not represent valid HTML entity, error is raised."
	| result |
	result := (TagBrush fromString: 'span') asDomNode innerHTML: '&', aString, ';'; textContent.
	result size = 1 ifFalse: [ self error: 'Not an HTML entity: ', aString ].
	self with: result
!

root: aTagBrush do: aBlock
	| old |
	old := root.
	root := aTagBrush.
	aBlock value: self.
	root := old
!

with: anObject
	^ self root with: anObject
! !

!HTMLCanvas methodsFor: 'tags'!

a
	^ self tag: 'a'
!

abbr
	^ self tag: 'abbr'
!

address
	^ self tag: 'address'
!

area
	^ self tag: 'area'
!

article
	^ self tag: 'article'
!

aside
	^ self tag: 'aside'
!

audio
	^ self tag: 'audio'
!

base
	^ self tag: 'base'
!

blockquote
	^ self tag: 'blockquote'
!

body
	^ self tag: 'body'
!

br
	^ self tag: 'br'
!

button
	^ self tag: 'button'
!

canvas
	^ self tag: 'canvas'
!

caption
	^ self tag: 'caption'
!

cite
	^ self tag: 'cite'
!

code
	^ self tag: 'code'
!

col
	^ self tag: 'col'
!

colgroup
	^ self tag: 'colgroup'
!

command
	^ self tag: 'command'
!

datalist
	^ self tag: 'datalist'
!

dd
	^ self tag: 'dd'
!

del
	^ self tag: 'del'
!

details
	^ self tag: 'details'
!

div
	^ self tag: 'div'
!

div: aBlock
	^ self div with: aBlock
!

dl
	^ self tag: 'dl'
!

dt
	^ self tag: 'dt'
!

em
	^ self tag: 'em'
!

embed
	^ self tag: 'embed'
!

fieldset
	^ self tag: 'fieldset'
!

figcaption
	^ self tag: 'figcaption'
!

figure
	^ self tag: 'figure'
!

footer
	^ self tag: 'footer'
!

form
	^ self tag: 'form'
!

h1
	^ self tag: 'h1'
!

h1: anObject
	^ self h1 with: anObject
!

h2
	^ self tag: 'h2'
!

h2: anObject
	^ self h2 with: anObject
!

h3
	^ self tag: 'h3'
!

h3: anObject
	^ self h3 with: anObject
!

h4
	^ self tag: 'h4'
!

h4: anObject
	^ self h4 with: anObject
!

h5
	^ self tag: 'h5'
!

h5: anObject
	^ self h5 with: anObject
!

h6
	^ self tag: 'h6'
!

h6: anObject
	^ self h6 with: anObject
!

head
	^ self tag: 'head'
!

header
	^ self tag: 'header'
!

hgroup
	^ self tag: 'hgroup'
!

hr
	^ self tag: 'hr'
!

html
	^ self tag: 'html'
!

iframe
	^ self tag: 'iframe'
!

iframe: aString
	^ self iframe src: aString
!

img
	^ self tag: 'img'
!

img: aString
	^ self img src: aString
!

input
	^ self tag: 'input'
!

label
	^ self tag: 'label'
!

legend
	^ self tag: 'legend'
!

li
	^ self tag: 'li'
!

li: anObject
	^ self li with: anObject
!

link
	^ self tag: 'link'
!

map
	^ self tag: 'map'
!

mark
	^ self tag: 'mark'
!

menu
	^ self tag: 'menu'
!

meta
	^ self tag: 'meta'
!

nav
	^ self tag: 'nav'
!

newTag: aString
	^ TagBrush fromString: aString canvas: self
!

noscript
	^ self tag: 'noscript'
!

object
	^ self tag: 'object'
!

ol
	^ self tag: 'ol'
!

ol: anObject
	^ self ol with: anObject
!

optgroup
	^ self tag: 'optgroup'
!

option
	^ self tag: 'option'
!

output
	^ self tag: 'output'
!

p
	^ self tag: 'p'
!

p: anObject
	^ self p with: anObject
!

param
	^ self tag: 'param'
!

pre
	^ self tag: 'pre'
!

progress
	^ self tag: 'progress'
!

script
	^ self tag: 'script'
!

section
	^ self tag: 'section'
!

select
	^ self tag: 'select'
!

small
	^ self tag: 'small'
!

source
	^ self tag: 'source'
!

span
	^ self tag: 'span'
!

span: anObject
	^ self span with: anObject
!

strong
	^ self tag: 'strong'
!

strong: anObject
	^ self strong with: anObject
!

style
	^ self tag: 'style'
!

style: aString
	^ self style with: aString; yourself
!

sub
	^ self tag: 'sub'
!

summary
	^ self tag: 'summary'
!

sup
	^ self tag: 'sup'
!

table
	^ self tag: 'table'
!

tag: aString
	^ self root addBrush: (self newTag: aString)
!

tbody
	^ self tag: 'tbody'
!

td
	^ self tag: 'td'
!

textarea
	^ self tag: 'textarea'
!

tfoot
	^ self tag: 'tfoot'
!

th
	^ self tag: 'th'
!

thead
	^ self tag: 'thead'
!

time
	^ self tag: 'time'
!

title
	^ self tag: 'title'
!

tr
	^ self tag: 'tr'
!

ul
	^ self tag: 'ul'
!

ul: anObject
	^ self ul with: anObject
!

video
	^ self tag: 'video'
! !

Object subclass: #TagBrush
	slots: {#canvas. #element}
	package: 'Web'!
!TagBrush commentStamp!
I am a brush for building a single DOM element (which I hold onto).

## API

1. Nesting

    Use `#with:` to nest tags. `#with:` can take aString, `TagBrush` instance, a `Widget` or block closure as parameter.

    Example: `aTag with: aString with: aCanvas div`

2. Events

    The `events` protocol contains all methods related to events.

    Example: `aTag onClick: [ window alert: 'clicked' ]`

3. Attributes

    The `attribute` protocol contains methods for attribute manipulation.

    Example: `aTag at: 'value' put: 'hello world'`

4. Raw access and jQuery

    The `#asDomNode` method can be used to access to JavaScript DOM element object.

    Example: `aTag asDomNode cssStyle`

    With 'Web-JQuery' package there is `#asJQuery` to access to the receiver converted into a jQuery object.

    Example: `aTag asJQuery css: 'color' value: 'red'`!

!TagBrush methodsFor: 'accessing'!

element
	^ element
! !

!TagBrush methodsFor: 'adding'!

addBrush: aTagBrush
	self appendChild: aTagBrush asDomNode.
	^ aTagBrush
!

append: anObject
	anObject appendToBrush: self
!

appendBlock: aBlock
	canvas root: self do: aBlock
!

appendChild: anElement
	element appendChild: anElement
!

appendString: aString
	self appendChild: aString asDomNode
!

appendToBrush: aTagBrush
	aTagBrush addBrush: self
!

contents: anObject
	self
	empty;
	append: anObject
!

empty
<inlineJS: '
	var element = $self.element, child;
	while (child = element.firstChild) element.removeChild(child);
'>
!

with: anObject
	self append: anObject
! !

!TagBrush methodsFor: 'attributes'!

accesskey: aString
	self at: 'accesskey' put: aString
!

action: aString
	self at: 'action' put: aString
!

align: aString
	self at: 'align' put: aString
!

alt: aString
	self at: 'alt' put: aString
!

at: aString
	^ self at: aString ifAbsent: [ Collection new errorNotFound ]
!

at: aString ifAbsent: aBlock
	<inlineJS: 'return $self.element.hasAttribute(aString) ? $self.element.getAttribute(aString) : aBlock._value()'>
!

at: aString put: aValue
	<inlineJS: '$self.element.setAttribute(aString, aValue); return aValue'>
!

class: aString
	<inlineJS: '$self.element.className = aString'>
!

cols: aString
	self at: 'cols' put: aString
!

contenteditable: aString
	self at: 'contenteditable' put: aString
!

contextmenu: aString
	self at: 'contextmenu' put: aString
!

draggable: aString
	self at: 'draggable' put: aString
!

for: aString
	self at: 'for' put: aString
!

height: aString
	self at: 'height' put: aString
!

hidden
	self at: 'hidden' put: 'hidden'
!

href: aString
	self at: 'href' put: aString
!

id: aString
	self at: 'id' put: aString
!

media: aString
	self at: 'media' put: aString
!

method: aString
	self at: 'method' put: aString
!

name: aString
	self at: 'name' put: aString
!

placeholder: aString
	self at: 'placeholder' put: aString
!

rel: aString
	self at: 'rel' put: aString
!

removeAt: aString
	<inlineJS: '$self.element.removeAttribute(aString)'>
!

rows: aString
	self at: 'rows' put: aString
!

src: aString
	self at: 'src' put: aString
!

style: aString
	self at: 'style' put: aString
!

tabindex: aNumber
	self at: 'tabindex' put: aNumber
!

target: aString
	self at: 'target' put: aString
!

title: aString
	self at: 'title' put: aString
!

type: aString
	self at: 'type' put: aString
!

valign: aString
	self at: 'valign' put: aString
!

value: aString
	self at: 'value' put: aString
!

width: aString
	self at: 'width' put: aString
! !

!TagBrush methodsFor: 'converting'!

asDomNode
	^ element
! !

!TagBrush methodsFor: 'events'!

onBlur: aBlock
	self onEvent: 'blur' do: aBlock
!

onChange: aBlock
	self onEvent: 'change' do: aBlock
!

onClick: aBlock
	self onEvent: 'click' do: aBlock
!

onDblClick: aBlock
	self onEvent: 'dblclick' do: aBlock
!

onEvent: aString do: aBlock
	self asDomNode addEventListener: aString block: aBlock useCapture: false
!

onFocus: aBlock
	self onEvent: 'focus' do: aBlock
!

onFocusIn: aBlock
	self onEvent: 'focusin' do: aBlock
!

onFocusOut: aBlock
	self onEvent: 'focusout' do: aBlock
!

onKeyDown: aBlock
	self onEvent: 'keydown' do: aBlock
!

onKeyPress: aBlock
	self onEvent: 'keypress' do: aBlock
!

onKeyUp: aBlock
	self onEvent: 'keyup' do: aBlock
!

onMouseDown: aBlock
	self onEvent: 'mousedown' do: aBlock
!

onMouseEnter: aBlock
	self onEvent: 'mouseenter' do: aBlock
!

onMouseLeave: aBlock
	self onEvent: 'mouseleave' do: aBlock
!

onMouseMove: aBlock
	self onEvent: 'mousemove' do: aBlock
!

onMouseOut: aBlock
	self onEvent: 'mouseout' do: aBlock
!

onMouseOver: aBlock
	self onEvent: 'mouseover' do: aBlock
!

onMouseUp: aBlock
	self onEvent: 'mouseup' do: aBlock
!

onSelect: aBlock
	self onEvent: 'select' do: aBlock
!

onSubmit: aBlock
	self onEvent: 'submit' do: aBlock
!

onUnload: aBlock
	self onEvent: 'unload' do: aBlock
! !

!TagBrush methodsFor: 'initialization'!

initializeFromCssSelector: aString canvas: aCanvas
	element := document querySelector: aString.
	canvas := aCanvas
!

initializeFromString: aString canvas: aCanvas
	element := document createElement: aString.
	canvas := aCanvas
! !

!TagBrush class methodsFor: 'instance creation'!

fromCssSelector: aString
	^ self fromCssSelector: aString canvas: HTMLCanvas new
!

fromCssSelector: aString canvas: aCanvas
	^ self new
		initializeFromCssSelector: aString canvas: aCanvas;
		yourself
!

fromString: aString
	^ self fromString: aString canvas: HTMLCanvas new
!

fromString: aString canvas: aCanvas
	^ self new
	initializeFromString: aString canvas: aCanvas;
	yourself
! !

Object subclass: #Widget
	slots: {}
	package: 'Web'!
!Widget commentStamp!
I am a presenter building HTML. Subclasses are typically reusable components.

## API

Use `#renderOn:` to build HTML. (See `HTMLCanvas` and `TagBrush` classes for more about building HTML).

To add a widget to the page, the convenience method `#appendToBrush:` is very useful.

Exemple: 

    Counter new appendToBrush: 'body' asBrush!

!Widget methodsFor: 'adding'!

appendToBrush: aTagBrush
	[ :html | self renderOn: html ] appendToBrush: aTagBrush
! !

!Widget methodsFor: 'rendering'!

renderOn: html
	self
! !

!Widget class methodsFor: 'accessing'!

classTag
	"Returns a tag or general category for this class.
	Typically used to help tools do some reflection.
	Helios, for example, uses this to decide what icon the class should display."
	
	^ 'widget'
! !

!Association methodsFor: '*Web'!

appendToBrush: aTagBrush
	aTagBrush at: self key put: self value
! !

!BlockClosure methodsFor: '*Web'!

appendToBrush: aTagBrush
	aTagBrush appendBlock: self
! !

!Collection methodsFor: '*Web'!

appendToBrush: aTagBrush
	self do: [ :each | aTagBrush append: each ]
! !

!JSObjectProxy methodsFor: '*Web'!

appendToBrush: aTagBrush
	(PlatformDom isDomNode: jsObject)
		ifTrue: [ aTagBrush appendChild: jsObject ]
		ifFalse: [ aTagBrush append: self asString ]
! !

!Object methodsFor: '*Web'!

appendToBrush: aTagBrush
	aTagBrush append: self asString
! !

!String methodsFor: '*Web'!

appendToBrush: aTagBrush
	aTagBrush appendString: self
!

asBrush
	^ TagBrush fromCssSelector: self
! !