Smalltalk current createPackage: 'Canvas'! Object subclass: #BrowserInterface instanceVariableNames: '' package: 'Canvas'! !BrowserInterface commentStamp! I am platform interface class that tries to use window and jQuery; that is, one for browser environment. ## API self isAvailable. "true if window and jQuery exist". self alert: 'Hey, there is a problem'. self confirm: 'Affirmative?'. self prompt: 'Your name:'. self ajax: #{ 'url' -> '/patch.js'. 'type' -> 'GET'. dataType->'script' }.! !BrowserInterface methodsFor: 'actions'! ajax: anObject ^ jQuery ajax: anObject ! alert: aString ^ window alert: aString ! confirm: aString ^ window confirm: aString ! prompt: aString ^ window prompt: aString ! ! !BrowserInterface methodsFor: 'testing'! isAvailable ! ! BrowserInterface class instanceVariableNames: 'uiWorker ajaxWorker'! Object subclass: #HTMLCanvas instanceVariableNames: 'root' package: 'Canvas'! !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 ! root: aTagBrush root := aTagBrush ! snippet: anElement "Adds clone of anElement, finds [data-snippet=""*""] subelement and returns TagBrush as if that subelement was just added. Rarely needed to use directly, use `html foo` dynamically installed method for a snippet named foo." | clone caret | clone := anElement asJQuery clone. self with: (TagBrush fromJQuery: clone canvas: self). caret := clone find: '[data-snippet="*"]'. caret toArray isEmpty ifTrue: [ caret := clone ]. ^ TagBrush fromJQuery: (caret removeAttr: 'data-snippet') canvas: self ! ! !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 := ('' asJQuery html: '&', aString, ';') text. result size = 1 ifFalse: [ self error: 'Not an HTML entity: ', aString ]. self with: result ! with: anObject ^ self root with: anObject ! ! !HTMLCanvas methodsFor: 'initialization'! initialize super initialize. root ifNil: [ root := TagBrush fromString: 'div' canvas: self ] ! initializeFromJQuery: aJQuery root := TagBrush fromJQuery: aJQuery canvas: self ! ! !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 ^ root addBrush: (StyleTag canvas: self) ! 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 ^ 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' ! ! !HTMLCanvas class methodsFor: 'instance creation'! browserVersion ^ (jQuery at: #browser) version ! isMSIE ^ ((jQuery at: #browser) at: #msie) notNil ! isMozilla ^ ((jQuery at: #browser) at: #mozilla) notNil ! isOpera ^ ((jQuery at: #browser) at: #opera) notNil ! isWebkit ^ ((jQuery at: #browser) at: #webkit) notNil ! onJQuery: aJQuery ^ self basicNew initializeFromJQuery: aJQuery; initialize; yourself ! ! Object subclass: #HTMLSnippet instanceVariableNames: 'snippets' package: 'Canvas'! !HTMLSnippet commentStamp! My sole instance is the registry of html snippets. `HTMLSnippet current` is the public singleton instance. On startup, it scans the document for any html elements with `'data-snippet="foo"'` attribute and takes them off the document, remembering them in the store under the specified name. It also install method #foo into HTMLCanvas dynamically. Every html snippet should mark a 'caret', a place where contents can be inserted, by 'data-snippet="*"' (a special name for caret). For example: `
  • ` defines a list element with a link inside; the link itself is marked as a caret. You can later issue `html menuelement href: '/foo'; with: 'A foo'` to insert the whole snippet and directly manipulate the caret, so it renders: `
  • A foo
  • ` For a self-careting tags (not very useful, but you do not need to fill class etc. you can use `
    ` and in code later do: `html bar with: [ xxx ]` to render `
    ...added by xxx...
    `! !HTMLSnippet methodsFor: 'accessing'! snippetAt: aString ^ self snippets at: aString ! snippets ^ snippets ifNil: [ snippets := #{} ] ! ! !HTMLSnippet methodsFor: 'initialization'! initializeFromJQuery: aJQuery "Finds and takes out all snippets out of aJQuery. Installs it into self." (self snippetsFromJQuery: aJQuery) do: [ :each | self installSnippetFromJQuery: each asJQuery ] ! ! !HTMLSnippet methodsFor: 'method generation'! snippetAt: aString compile: anElement "Method generation for the snippet. The selector is aString, the method block uses anElement" ClassBuilder new installMethod: ([ :htmlReceiver | htmlReceiver snippet: anElement ] currySelf asCompiledMethod: aString) forClass: HTMLCanvas category: '**snippets' ! ! !HTMLSnippet methodsFor: 'private'! snippetsFromJQuery: aJQuery ^ (aJQuery find: '[data-snippet]') toArray ! ! !HTMLSnippet methodsFor: 'snippet installation'! installSnippetFromJQuery: element | name | name := element attr: 'data-snippet'. name = '*' ifFalse: [ ('^\*' asRegexp test: name) ifTrue: [ name := name allButFirst. element attr: 'data-snippet' put: '*' ] ifFalse: [ element removeAttr: 'data-snippet' ]. self snippetAt: name install: (element detach get: 0) ] ! snippetAt: aString install: anElement self snippets at: aString put: anElement. self snippetAt: aString compile: anElement ! ! HTMLSnippet class instanceVariableNames: 'current'! !HTMLSnippet class methodsFor: 'initialization'! ensureCurrent current ifNil: [ current := super new initializeFromJQuery: document asJQuery; yourself ] ! initialize super initialize. self isDOMAvailable ifTrue: [ self ensureCurrent ] ! ! !HTMLSnippet class methodsFor: 'instance creation'! current ^ current ! isDOMAvailable < return typeof document !!== 'undefined' > ! new self shouldNotImplement ! ! Object subclass: #TagBrush instanceVariableNames: 'canvas element' package: 'Canvas'! !TagBrush commentStamp! I am a brush for building a single DOM element (which I hold onto). All tags but `