Skip to content
This repository
Browse code

[feature] stdlib: added an experimental UI library

Rescued this interesting proposal for an UI library. Although it is very
experimental, I think it's worth of being on master, as a proposal towards a
better UI library. Note: most of the work due to David.
  • Loading branch information...
commit c252d10c3dcbe000dc5ab82741120e42222095ee 1 parent 7409d79
François-Régis Sinot authored
133 stdlib/elvis/button.opa
... ... @@ -0,0 +1,133 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Buttons
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * {1 Simple clickable}
  30 + *
  31 + * Native button.
  32 + */
  33 +
  34 +/**
  35 + * {1 Theming}
  36 + *
  37 + * The button always has classes "mlstate" "elvis" "button"
  38 + * During a click, it also has class "down", otherwise it has class "up"
  39 + * When enabled, it has class "enabled", otherwise it has class "disabled"
  40 + */
  41 +
  42 +type EButton.options = {
  43 + content: xhtml
  44 + is_enabled: bool
  45 +}
  46 +
  47 +type EButton.sources = {
  48 + chosen: Event.source(void)
  49 +}
  50 +@abstract type EButton.implementation = {
  51 + dom: dom
  52 + state_enabled: Client.reference(bool)
  53 +}
  54 +
  55 +type EButton.elvis = Elvis.elvis(EButton.sources, EButton.implementation)
  56 +
  57 +EButton =
  58 +{{
  59 +/**
  60 + * {1 Constructors}
  61 + */
  62 + simple(content:xhtml): EButton.elvis =
  63 + make({is_enabled = true
  64 + content = content})
  65 +
  66 + make(options:EButton.options): EButton.elvis =
  67 + (
  68 + id = "ebutton_{Random.string(32)}"
  69 + dom = Dom.select_id(id)
  70 + chosen_net = Network.empty()
  71 + state_enabled = Client_reference.create(options.is_enabled)
  72 + display(theme) =
  73 + (
  74 + mouse_changed(up) =
  75 + (
  76 + if Client_reference.get(state_enabled) then
  77 + dom = Dom.resolve(dom)
  78 + if up then
  79 + do Dom.remove_class(dom, class_down)
  80 + do Dom.add_class(dom, class_up)
  81 + void
  82 + else
  83 + do Dom.remove_class(dom, class_up)
  84 + do Dom.add_class(dom, class_down)
  85 + void
  86 + )
  87 + theme_classes = Elvis.Theme.get_classes(theme)
  88 + xhtml = <button id={id}
  89 + class="{theme_classes} elvis mlstate button {class_up} {if Client_reference.get(state_enabled) then class_enabled else class_disabled}"
  90 + onclick={_ -> if Client_reference.get(state_enabled) then Network.broadcast({}, chosen_net) else void}
  91 + onmouseup={_ -> mouse_changed({true})}
  92 + onmousedown={_ -> mouse_changed({false})}
  93 + >{
  94 + options.content
  95 + }</button>
  96 + dom = Dom.of_xhtml(xhtml)
  97 + ~{xhtml dom}
  98 + )
  99 + implem = ({
  100 + ~dom
  101 + ~state_enabled
  102 + })
  103 + sources = {
  104 + chosen = (chosen_net)
  105 + }
  106 + Elvis.make(sources, implem, display)
  107 + )
  108 +
  109 +/**
  110 + * {1 Accessors}
  111 + */
  112 + set_enabled(button: EButton.elvis, enabled: bool): void =
  113 + (
  114 + implem = (Elvis.implem(button))
  115 + dom = Dom.resolve(implem.dom)
  116 + state_enabled = implem.state_enabled
  117 + do if enabled != Client_reference.get(state_enabled) then
  118 + if enabled then
  119 + do Dom.remove_class(dom, class_disabled)
  120 + do Dom.add_class(dom, class_enabled)
  121 + void
  122 + else
  123 + do Dom.remove_class(dom, class_enabled)
  124 + do Dom.add_class(dom, class_disabled)
  125 + void
  126 + Client_reference.set(state_enabled, enabled)
  127 + )
  128 +
  129 + @private class_enabled = "enabled"
  130 + @private class_disabled= "disabled"
  131 + @private class_up = "up"
  132 + @private class_down = "down"
  133 +}}
147 stdlib/elvis/clickable.opa
... ... @@ -0,0 +1,147 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Clickables
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * {1 Simple clickable}
  30 + *
  31 + * Wrap an elvis as something clickable.
  32 + */
  33 +
  34 +/**
  35 + * {1 Theming}
  36 + *
  37 + * The clickable always has classes "mlstate" "elvis" "clickable"
  38 + * During a click, it also has class "down", otherwise it has class "up"
  39 + * When enabled, it has class "enabled", otherwise it has class "disabled"
  40 + */
  41 +
  42 +type EClickable.options = {
  43 + content: Elvis.elvis(Elvis.masked, Elvis.masked)
  44 + is_enabled: bool
  45 +}
  46 +
  47 +type EClickable.sources = {
  48 + chosen: Event.source(void)
  49 + //unfocused:Event.source(void)
  50 + dbclick: Event.source(void)
  51 +}
  52 +@abstract type EClickable.implementation = {
  53 + dom: dom
  54 + state_enabled: Client.reference(bool)
  55 +}
  56 +
  57 +type EClickable.elvis = Elvis.elvis(EClickable.sources, EClickable.implementation)
  58 +
  59 +EClickable =
  60 +{{
  61 +/**
  62 + * {1 Constructors}
  63 + */
  64 + simple(content:xhtml): EClickable.elvis =
  65 + make({is_enabled = true
  66 + content = Elvis.pack(ELabel.simple(content))})
  67 +
  68 + make(options:EClickable.options): EClickable.elvis =
  69 + (
  70 + id = "eclickable_{Random.string(32)}"
  71 + dom = Dom.select_id(id)
  72 + chosen_net = Network.empty()
  73 + dbclick_net = Network.empty()
  74 + //unfocused_net = Network.empty()
  75 + state_enabled = Client_reference.create(options.is_enabled)
  76 + display(theme) =
  77 + (
  78 + mouse_changed(up) =
  79 + (
  80 + if Client_reference.get(state_enabled) then
  81 + dom = Dom.resolve(dom)
  82 + if up then
  83 + do Dom.remove_class(dom, class_down)
  84 + do Dom.add_class(dom, class_up)
  85 + void
  86 + else
  87 + do Dom.remove_class(dom, class_up)
  88 + do Dom.add_class(dom, class_down)
  89 + void
  90 + )
  91 + theme_classes = Elvis.Theme.get_classes(theme)
  92 + xhtml = <div id={id}
  93 + class="{theme_classes} elvis mlstate clickable {class_up} {if Client_reference.get(state_enabled) then class_enabled else class_disabled}"
  94 + onclick={_ -> if Client_reference.get(state_enabled) then Network.broadcast({}, chosen_net) else void}
  95 + ondblclick={_ -> if Client_reference.get(state_enabled) then Network.broadcast({}, dbclick_net) else void}
  96 + //onfocusout={_ -> Network.broadcast({}, unfocused_net)}
  97 + onmouseup={_ -> mouse_changed({true})}
  98 + onmousedown={_ -> mouse_changed({false})}>
  99 + <div class="{theme_classes} elvis mlstate clickable_content">{
  100 + Elvis.for_display_in_theme(options.content, theme)
  101 + }</div></div>
  102 + dom = Dom.of_xhtml(xhtml)
  103 + ~{xhtml dom}
  104 + )
  105 + implem = ({
  106 + ~dom
  107 + ~state_enabled
  108 + })
  109 + sources = {
  110 + chosen = (chosen_net)
  111 + dbclick = (dbclick_net)
  112 + //unfocused = (unfocused_net)
  113 + }
  114 + Elvis.make(sources, implem, display)
  115 + )
  116 +
  117 + default_options =
  118 + {
  119 + content = ELabel.simple(<>Nothing to see</>)
  120 + is_enabled = {true}
  121 + }
  122 +/**
  123 + * {1 Accessors}
  124 + */
  125 + set_enabled(clickable: EClickable.elvis, enabled: bool): void =
  126 + (
  127 + implem = (Elvis.implem(clickable))
  128 + dom = Dom.resolve(implem.dom)
  129 + state_enabled = implem.state_enabled
  130 + do if enabled != Client_reference.get(state_enabled) then
  131 + if enabled then
  132 + do Dom.remove_class(dom, class_disabled)
  133 + do Dom.add_class(dom, class_enabled)
  134 + void
  135 + else
  136 + do Dom.remove_class(dom, class_enabled)
  137 + do Dom.add_class(dom, class_disabled)
  138 + void
  139 + Client_reference.set(state_enabled, enabled)
  140 + )
  141 +
  142 + @private class_enabled = "enabled"
  143 + @private class_disabled= "disabled"
  144 + @private class_up = "up"
  145 + @private class_down = "down"
  146 +}}
  147 +
131 stdlib/elvis/completion.opa
... ... @@ -0,0 +1,131 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Completions
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * An input with auto-completion.
  30 + *
  31 + * When users type, a popup menu appears, prompting to choose one value in the menu. Only these values can be accepted (note that the popup menu can
  32 + * be programmed to display the value currently written by the user). Once the value is accepted, it is displayed as a button and the user can restart
  33 + * typing another value, etc.
  34 + */
  35 +
  36 +
  37 +type ECompletion.options('value) =
  38 +{
  39 + welcome_text: string
  40 + accept_multiple_entries: bool
  41 + suggest_completions: string -> list('value)
  42 + display_suggestion: 'value -> xhtml
  43 + display_choice: 'value -> xhtml
  44 + text_suggestion: 'value -> string
  45 +}
  46 +
  47 +type ECompletion.sources('value) =
  48 +{
  49 + added_value: Event.source({new:'value all:list('value)})
  50 + //TODO: added_value
  51 + //TODO: changed_value
  52 +}
  53 +
  54 +@abstract type ECompletion.implem('value) = {}
  55 +
  56 +type ECompletion.elvis('value) = Elvis.elvis(ECompletion.sources('value), ECompletion.implem('value))
  57 +
  58 +ECompletion =
  59 +{{
  60 + make(options: ECompletion.options('value)): ECompletion.elvis('value) =
  61 + (
  62 + //Setup events
  63 + added_value_net = Network.empty()
  64 +
  65 + //Setup UI
  66 + elvis_input = EInput.simple()
  67 + elvis_accepted_list = EList.empty()
  68 + elvis_accepted_panel = EPanel.make({EPanel.default_options with
  69 + children = [Elvis.pack(elvis_accepted_list)]
  70 + classes = ["completion", "choices"]
  71 + })
  72 + elvis_suggestions_list = EList.empty()
  73 + elvis_suggestions_panel = EPanel.make({EPanel.default_options with
  74 + children = [Elvis.pack(elvis_suggestions_list)]
  75 + classes = ["completion", "suggestions"]
  76 + is_visible = {false}
  77 + })
  78 + elvis_panel = EPanel.make({EPanel.default_options with
  79 + classes = ["completion", "root"]
  80 + children = [Elvis.pack(elvis_input), Elvis.pack(elvis_suggestions_panel), Elvis.pack(elvis_accepted_panel)]
  81 + })
  82 +
  83 + //Show/hide suggestions panel
  84 + set_suggestions_visible(visible) =
  85 + (
  86 + EPanel.set_visible(elvis_suggestions_panel, visible)//Note: In the future, we could replace this by an animation
  87 + )
  88 +
  89 + //When value is accepted, show it in [elvis_accepted], store it somewhere, clear [elvis_input], hide [elvis_suggestions_panel]
  90 + on_value_accepted(value) = (
  91 + do set_suggestions_visible({false})
  92 + do EInput.set_text(elvis_input, "", {false})
  93 + elvis_value_for_display = EClickable.simple(options.display_choice(value))
  94 + do EList.add_item(elvis_accepted_list, value, Elvis.pack(elvis_value_for_display))
  95 + //TODO: Store value
  96 + //value_key = Random.int(10000000) //An arbitrary key, used for storage. Big number to avoid collisions.
  97 + //TODO: On single click upon [elvis_value], reselect value/text
  98 + //TODO: On double click upon [elvis_value], remove value
  99 + //TODO: Trigger event
  100 + {}
  101 + )
  102 +
  103 + //When text changes, show/hide suggestions
  104 + on_changing_text(text) = (
  105 + match options.suggest_completions(text) with
  106 + [] -> //Hide suggestions
  107 + do set_suggestions_visible({false})
  108 + void
  109 + | suggestions -> //Show suggestions
  110 + do set_suggestions_visible({true})
  111 + make_suggestion(value) = (
  112 + clickable = EClickable.simple(options.display_suggestion(value))
  113 + _ = Event.callback(Elvis.sources(clickable).chosen, (_ -> on_value_accepted(value)))
  114 + Elvis.pack(clickable)
  115 + )
  116 + elvis_suggestions = List.map(x -> (x, make_suggestion(x)), suggestions)
  117 + do EList.set_items(elvis_suggestions_list, elvis_suggestions)
  118 + void
  119 + )
  120 + _ = Event.callback(Elvis.sources(elvis_input).changing_text, on_changing_text)
  121 +
  122 + //Finish construction
  123 + sources = {
  124 + added_value = (added_value_net)
  125 + }
  126 + implem = {}
  127 + display = elvis_panel.display
  128 + Elvis.make(sources, implem, display)
  129 + )
  130 +}}
  131 +
118 stdlib/elvis/datepicker.opa
... ... @@ -0,0 +1,118 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Binding of the Datepicker Widget
  21 + *
  22 + * @category UI
  23 + * @author François-Régis Sinot, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * {1 Datepicker}
  30 + *
  31 + * Demonstrating how to wrap a widget into an elvis.
  32 + * No support for the "menu-style" datepicker.
  33 + */
  34 +
  35 +import stdlib.widgets.datepicker
  36 +
  37 +/**
  38 + * {1 Theming}
  39 + *
  40 + * The input always has classes "mlstate", "elvis", "datepicker".
  41 + */
  42 +
  43 +/**
  44 + * {1 Sources for this elvis}
  45 + */
  46 +type EDatepicker.sources =
  47 +{
  48 + changed_date: Event.source(Date.date)
  49 +}
  50 +
  51 +type EDatepicker.options =
  52 +{
  53 + initial_date: Date.date
  54 + /* TODO: all options of WDatepicker.config except stylers */
  55 +}
  56 +
  57 +@abstract type EDatepicker.implementation =
  58 +{
  59 + /**
  60 + * Parameters for WDatepicker
  61 + */
  62 + wdatepicker_id: string
  63 + wdatepicker_config: WDatepicker.config
  64 +}
  65 +
  66 +type EDatepicker.elvis = Elvis.elvis(EDatepicker.sources, EDatepicker.implementation)
  67 +
  68 +@client EDatepicker = {{
  69 + /**
  70 + * {2 Constructors}
  71 + */
  72 + simple(initial_date : Date.date): EDatepicker.elvis =
  73 + (
  74 + make({ default_options with ~initial_date})
  75 + )
  76 +
  77 + make(options: EDatepicker.options): EDatepicker.elvis =
  78 + (
  79 + id_datepicker = "edatepicker_{Random.string(32)}"
  80 +
  81 + //Setup sources
  82 + changed_date_net = Network.empty()
  83 +
  84 + //Translate to WDatepicker
  85 + wdatepicker_config = WDatepicker.default_config
  86 +
  87 + display(theme) =
  88 + (
  89 + _theme_name = Elvis.Theme.get_classes(theme) /* TODO: use it */
  90 +
  91 + on_change_date = Network.broadcast(_, changed_date_net)
  92 +
  93 + xhtml = WDatepicker.edit(wdatepicker_config, on_change_date, id_datepicker, options.initial_date)
  94 +
  95 + dom = Dom.of_xhtml(xhtml)
  96 +
  97 + ~{dom xhtml}
  98 + )
  99 + sources : EDatepicker.sources =
  100 + {
  101 + changed_date = (changed_date_net)
  102 + }
  103 + implem : EDatepicker.implementation =
  104 + ({
  105 + wdatepicker_id = id_datepicker
  106 + ~wdatepicker_config
  107 + })
  108 + Elvis.make(sources, implem, display)
  109 + )
  110 +
  111 + /**
  112 + * A default set of options
  113 + */
  114 + default_options: EDatepicker.options =
  115 + {initial_date = Date.epoch
  116 + }
  117 +
  118 +}}
150 stdlib/elvis/elvis.opa
... ... @@ -0,0 +1,150 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * An elvis ("element of vision") is a data structure that can be displayed in the browser screen.
  30 + * Elvises are abstract data structures, characterized by the events they can post (the "sources")
  31 + * and their accessors.
  32 + *
  33 + * ** Relationships between Elvises and Xhtml
  34 + * - elvises are not xhtml (although they are certainly implemented as such)
  35 + * - elvises are not referenced by their ID
  36 + * - for display, elvises are inserted into xhtml
  37 + * - styling, positioning, etc. are done with CSS and selectors, through the indirection of the [Styler] widget
  38 + * - DOM events are used to implement Elvis, but they are low-level informations, not meant to be seen outside the Elvis
  39 + *
  40 + * ** Events
  41 + * - each Elvis publishes a number of [source]s, corresponding the events it can send
  42 + * - a channel or a function can be registered to listen on a [source], and possibly unregistered later
  43 + * - an Elvis MUST NOT listen to its own [source]s
  44 + *
  45 + * ** Implementation guidelines
  46 + * - Each xhtml node in an Elvis should have a class name
  47 + */
  48 +
  49 +/**
  50 + * {1 Standard event names}
  51 + *
  52 + * - [{chosen: void}] -- a button was pressed, an item was selected in a list, etc.
  53 + * - [{value_changed: {old: 'a new:'a}}]
  54 + * - [{value_rejected:{old: 'a rejected:'b}}]
  55 + */
  56 +
  57 +
  58 +@abstract type Elvis.elvis('sources, 'implem) = {
  59 + sources: 'sources /**Sources of events that the elvis can send (e.g. "selected", "value changed", etc.)
  60 + Use this to register event observers (or, possibly, to trigger artificial events).
  61 +
  62 + Note: By design, an elvis MUST NOT register with its own sources.*/
  63 + implem: 'implem /**Anything that may be needed to access the functions of this elvis, e.g. to set content*/
  64 + display: Elvis.theme ->/**Anything required to (re)display the elvis.*/
  65 + {
  66 + xhtml: xhtml /**The xhtml code for the display part of this elvis.*/
  67 + dom: dom /**A {e concrete} [dom] corresponding to [xhtml] page.*/
  68 + }
  69 +}
  70 +@abstract type Elvis.masked = {}
  71 +@abstract type Elvis.theme = list(string)
  72 +
  73 +Elvis = {{
  74 + /**
  75 + * Convert an elvis into something that can be injected on a page
  76 + *
  77 + * Note: Called automatically by magic_to_xhtml
  78 + */
  79 + for_display(elvis: Elvis.elvis(_, _)): xhtml =
  80 + (
  81 + for_display_in_theme(elvis, (["mlstate_default"]))
  82 + )
  83 +
  84 + /**
  85 + * Convert an elvis into something that can be injected on a page
  86 + */
  87 + for_display_in_theme(elvis: Elvis.elvis(_, _), theme: Elvis.theme): xhtml =
  88 + (
  89 + (elvis).display(theme).xhtml
  90 + )
  91 +
  92 + /**
  93 + * Access the event sources of the elvis
  94 + */
  95 + sources(elvis: Elvis.elvis('sources, 'implem)): 'sources =
  96 + (
  97 + (elvis).sources
  98 + )
  99 +
  100 + implem(elvis: Elvis.elvis('sources, 'implem)): 'implem =
  101 + (
  102 + (elvis).implem
  103 + )
  104 +
  105 + /**
  106 + * Construct an Elvis
  107 + */
  108 + make(sources: 'sources, implem: 'implem, display: Elvis.theme -> {xhtml:xhtml; dom:dom}): Elvis.elvis('sources, 'implem) =
  109 + (
  110 + ({~sources ~implem ~display})
  111 + )
  112 +
  113 + /**
  114 + * Existential stuff
  115 + */
  116 + pack(elvis: Elvis.elvis(_, _)): Elvis.elvis(Elvis.masked, Elvis.masked) =
  117 + (
  118 + ({sources=masked implem=masked display=(elvis).display})
  119 + )
  120 +
  121 + pack_sources(elvis: Elvis.elvis(_, 'b)): Elvis.elvis(Elvis.masked, 'b) =
  122 + (
  123 + ({sources=masked implem=(elvis).implem display=(elvis).display})
  124 + )
  125 +
  126 + pack_implem(elvis: Elvis.elvis('a, _)): Elvis.elvis('a, Elvis.masked) =
  127 + (
  128 + ({sources=(elvis).sources implem=masked display=(elvis).display})
  129 + )
  130 +
  131 + masked: Elvis.masked = ({})
  132 +
  133 + Theme =
  134 + {{
  135 + of_classes(classes: list(string)): Elvis.theme =
  136 + (
  137 + (classes)
  138 + )
  139 +
  140 + get_classes(theme: Elvis.theme): string =
  141 + (
  142 + List.to_string_using("", "", " ", (theme))
  143 + )
  144 +
  145 + add_class(class:string, theme: Elvis.theme): Elvis.theme =
  146 + (
  147 + ([class | (theme)])
  148 + )
  149 + }}
  150 +}}
81 stdlib/elvis/event.opa
... ... @@ -0,0 +1,81 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Events
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * {1 General definitions}
  30 + */
  31 +
  32 +@abstract type Event.source('a) = Network.network('a)
  33 +@abstract type Event.observer = (-> void)
  34 +
  35 +Event =
  36 +{{
  37 + Source =
  38 + {{
  39 + /**
  40 + * Create a source that won't ever send anything.
  41 + */
  42 + empty(): Event.source('a) = (Network.empty())
  43 + }}
  44 +
  45 + /**
  46 + * Register to be informed whenever a source produces a new event
  47 + */
  48 + observe(source: Event.source('a), sink: channel('a)): Event.observer =
  49 + (
  50 + do Network.add(sink, (source))
  51 + (-> Network.remove(sink, (source)))
  52 + )
  53 + /**
  54 + * As [observe], but with a function
  55 + */
  56 + callback(source: Event.source('a), sink: 'a -> void): Event.observer =
  57 + (
  58 + observe(source, Session.make({}, (_, msg -> do sink(msg) {unchanged})))
  59 + )
  60 + /**
  61 + * As [callback], but with the function is automatically unregistered once it has been called
  62 + */
  63 + callback_once(source: Event.source('a), sink: 'a -> void): Event.observer =
  64 + (
  65 + c = Session.make({}, (_, msg -> do sink(msg) {stop}))
  66 + observe(source, c)
  67 + )
  68 +
  69 + /**
  70 + * Broadcast an event to all observers
  71 + */
  72 + trigger(source: Event.source('a), event:'a): void =
  73 + (
  74 + Network.broadcast(event, (source))
  75 + )
  76 +
  77 + unobserve(observer: Event.observer): void =
  78 + (
  79 + (observer)()
  80 + )
  81 +}}
371 stdlib/elvis/input.opa
... ... @@ -0,0 +1,371 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Inputs
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * {1 Polymorphic text input}
  30 + *
  31 + * A simple text field, holding a value of polymorphic type.
  32 + *
  33 + * Expected syntactic sugar:
  34 + *
  35 + * <EInput id=#foo default_value="Please enter some text" />
  36 + *
  37 + * Translated into:
  38 + *
  39 + * foo = let()
  40 + * ...
  41 + * bind(foo, EInput.make({EInput.default_options with default_value = "Please enter some text"}))
  42 + */
  43 +
  44 +/**
  45 + * {1 Theming}
  46 + *
  47 + * The input always has classes "mlstate", "elvis", "input".
  48 + * At start, the field also has class "init". This class disappears once the field is modified.
  49 + * When filled with something incorrect, it has class "incorrect". When filled with something correct, it has class "correct".
  50 + * If enabled, it has class "enabled", otherwise "disabled"
  51 + */
  52 +
  53 +/**
  54 + * {1 Sources for this elvis}
  55 + */
  56 +type EInput.sources('value) =
  57 +{
  58 + changed_value: Event.source({old:option('value) new:option('value) text:string})
  59 +
  60 + /**
  61 + * An event sent when the text is being modified.
  62 + * Use this e.g. for auto-completion.
  63 + */
  64 + changing_text: Event.source(string)
  65 + changed_focus: Event.source({received}/{lost})
  66 +}
  67 +
  68 +type EInput.options('value) =
  69 +{
  70 + welcome_text: string
  71 + default_value: option('value)
  72 + value_accept: string -> option('value)
  73 +
  74 + /**
  75 + * Determine how the value should be displayed.
  76 + * Used to initialize the elvis, or when the value is set with [set_value].
  77 + */
  78 + value_display: option('value) -> string
  79 + size_columns: int
  80 + is_enabled: bool
  81 + is_password: bool
  82 +
  83 + unfocus_validates: bool
  84 + newline_validates: bool
  85 + tab_validates: bool
  86 +}
  87 +
  88 +@abstract type EInput.implementation('value) =
  89 +{
  90 + /**
  91 + * A reference to the dom node containing the real input
  92 + */
  93 + dom_input: dom
  94 +
  95 + /**
  96 + * A reference to the dom node containing the welcome pseudo-input
  97 + */
  98 + dom_welcome: dom
  99 + state: Client.reference((string, option('value)))
  100 + options: EInput.options('value)
  101 +}
  102 +
  103 +type EInput.elvis('a) = Elvis.elvis(EInput.sources('a), EInput.implementation('a))
  104 +
  105 +@client EInput = {{
  106 + /**
  107 + * {2 Constructors}
  108 + */
  109 + simple(): EInput.elvis(string) =
  110 + (
  111 + make(default_options)
  112 + )
  113 +
  114 + make(options: EInput.options('a)): EInput.elvis('a) =
  115 + (
  116 + value_accept = options.value_accept
  117 + default_text = options.value_display(options.default_value)
  118 + id_input = "einput_{Random.string(32)}"
  119 + dom_input = Dom.select_id(id_input)
  120 + id_welcome = "einput_welcome_{Random.string(32)}"
  121 + dom_welcome = Dom.select_id(id_welcome)
  122 +
  123 + //Setup sources
  124 + changed_value_net = Network.empty()
  125 + changing_text_net = Network.empty()
  126 + changed_focus_net = Network.empty()
  127 +
  128 + //Handle validation (and UI side effects)
  129 + state = Client_reference.create(("", {none}))
  130 + validator(text:string): void =
  131 + (
  132 + old = Client_reference.get(state)
  133 + if old.f1 != text then
  134 + new = value_accept(text)
  135 + do match new with
  136 + | {none} -> //Value rejected, set class correspondingly
  137 + do Dom.remove_class(dom_input, class_init)
  138 + do Dom.remove_class(dom_input, class_correct)
  139 + do Dom.add_class(dom_input, class_incorrect)
  140 + void
  141 + | {some = _} -> //Value accepted, set class correspondingly
  142 + do Dom.remove_class(dom_input, class_init)
  143 + do Dom.remove_class(dom_input, class_incorrect)
  144 + do Dom.add_class(dom_input, class_correct)
  145 + void
  146 + do Client_reference.set(state, (text, new))
  147 + do Network.broadcast({old=old.f2 ~new ~text}, changed_value_net)
  148 + void
  149 + )
  150 +
  151 + //Propagate information that input is changing
  152 + text = Client_reference.create(default_text)
  153 + input_changed(_) =
  154 + (
  155 + new_text = Dom.get_value(dom_input)
  156 + if new_text != Client_reference.get(text) then
  157 + (
  158 + do Network.broadcast(new_text, changing_text_net)
  159 + do Client_reference.set(text, new_text)
  160 + void
  161 + )
  162 + )
  163 +
  164 +
  165 + display(theme) =
  166 + (
  167 + theme_name = Elvis.Theme.get_classes(theme)
  168 +
  169 + //Handle substitution between a placeholder input containing a welcome text and an input actually used for input
  170 + focus_real_input(enable) =
  171 + (
  172 + if enable then
  173 + (
  174 + do Dom.hide(dom_welcome)
  175 + do Dom.show(dom_input)
  176 + _ = Dom.give_focus(dom_input)
  177 + void
  178 + ) else (
  179 + if Dom.get_value(dom_input) == "" then//No text entered, restore placeholder
  180 + do Dom.hide(dom_input)
  181 + do Dom.show(dom_welcome)
  182 + void
  183 + )
  184 + )
  185 + xhtml = <input id={id_welcome}
  186 + class="{theme_name} mlstate elvis input {class_init} {if options.is_enabled then class_enabled else class_disabled}"
  187 + size={options.size_columns}
  188 + value={options.welcome_text}
  189 + onready={_ -> Dom.set_enabled(dom_welcome, options.is_enabled)}
  190 +
  191 + //Setup substitution
  192 + onfocus={_ -> focus_real_input({true})}
  193 +
  194 + type="text"
  195 + />
  196 + <input id={id_input}
  197 + class="{theme_name} mlstate elvis input {class_init} {if options.is_enabled then class_enabled else class_disabled}"
  198 + size={options.size_columns}
  199 + value={default_text}
  200 + onready={_ -> Dom.set_enabled(dom_input, options.is_enabled)}
  201 +
  202 + //Setup substitution
  203 + style="display:none"
  204 + onblur={_ -> do Network.broadcast({lost}, changed_focus_net); focus_real_input({false})}
  205 + onfocus={_ -> Network.broadcast({received}, changed_focus_net)}
  206 +
  207 + //Setup validation of input
  208 + onchange={_ -> if options.unfocus_validates then validator(Dom.get_value(dom_input))}
  209 + options:onchange="stop_propagation"
  210 + onnewline={_ -> validator(Dom.get_value(dom_input))}
  211 + options:onnewline="stop_propagation"
  212 +
  213 + //Setup input change monitoring
  214 + oninput={input_changed}
  215 + options:oninput="stop_propagation"
  216 + onkeyup={input_changed}
  217 + options:onkeyup="stop_propagation"
  218 + onpaste={input_changed}
  219 + options:onpaste="stop_propagation"
  220 +
  221 + //Setup password
  222 + type={if options.is_password then "password" else "text"}
  223 + />
  224 + dom = Dom.of_xhtml(xhtml)
  225 + ~{dom xhtml}
  226 + )
  227 + sources : EInput.sources('a) =
  228 + {
  229 + changed_value = (changed_value_net)
  230 + changing_text = (changing_text_net)
  231 + changed_focus = (changed_focus_net)
  232 + }
  233 + implem : EInput.implementation('a) =
  234 + ({
  235 + ~dom_input
  236 + ~dom_welcome
  237 + ~state
  238 + ~options
  239 + })
  240 + Elvis.make(sources, implem, display)
  241 + )
  242 +
  243 + /**
  244 + * A default set of options
  245 + */
  246 + default_options: EInput.options(string) =
  247 + {default_value = {none}
  248 + welcome_text = ""
  249 + value_accept = Option.some
  250 + value_display(x) = x?""
  251 + size_columns = 20
  252 + is_enabled = {true}
  253 + is_password = {false}
  254 + unfocus_validates = {true}
  255 + newline_validates = {true}
  256 + tab_validates = {true}
  257 + }
  258 +
  259 + int_options: EInput.options(int) =
  260 + {default_value = {none}
  261 + welcome_text = ""
  262 + value_accept = Parser.try_parse(Rule.integer, _)
  263 + value_display(x)= match x with {none} -> "" | ~{some} -> String.of_int(some)
  264 + size_columns = 20
  265 + is_enabled = {true}
  266 + is_password = {false}
  267 + unfocus_validates = {true}
  268 + newline_validates = {true}
  269 + tab_validates = {true}
  270 + }
  271 +
  272 + password_options: EInput.options(string) =
  273 + {default_value = {none}
  274 + welcome_text = "password"
  275 + value_accept = Option.some
  276 + value_display(x) = x?""
  277 + size_columns = 20
  278 + is_enabled = {true}
  279 + is_password = {true}
  280 + unfocus_validates = {true}
  281 + newline_validates = {true}
  282 + tab_validates = {true}
  283 + }
  284 +
  285 + /**
  286 + * {2 Accessors}
  287 + */
  288 +
  289 + /**
  290 + * Reset the contents of this input
  291 + *
  292 + * @param trigger If true, inform sources of the change, otherwise remain silent.
  293 + */
  294 + reset(einput:EInput.elvis('a), trigger:bool): void =
  295 + (
  296 + implem = (Elvis.implem(einput))
  297 + options = implem.options
  298 + do set_text(einput, options.value_display(options.default_value), false)
  299 + do set_value(einput, options.default_value, trigger)
  300 + void
  301 + )
  302 +
  303 + /**
  304 + * {3 Get/set the polymorphic value behind this input}
  305 + */
  306 + get_value(einput:EInput.elvis('a)): option('a) =
  307 + (
  308 + Client_reference.get((Elvis.implem(einput)).state).f2
  309 + )
  310 + set_value(einput:EInput.elvis('a), value:option('a), trigger:bool): void =
  311 + (
  312 + implem = (Elvis.implem(einput))
  313 + options = implem.options
  314 + dom = Dom.resolve(implem.dom_input)
  315 + old_value = Client_reference.get(implem.state)
  316 + do Client_reference.set(implem.state, (options.value_display(value), value))
  317 + do Dom.set_value(dom, options.value_display(value))
  318 + do if trigger then
  319 + Event.trigger(Elvis.sources(einput).changed_value, {old = old_value.f2 text=options.value_display(value) new = value})
  320 + void
  321 + )
  322 +
  323 + /**
  324 + * {3 Get/set the text of this input}
  325 + */
  326 + get_text(einput: EInput.elvis('a)): string =
  327 + (
  328 + Dom.get_value((Elvis.implem(einput)).dom_input)
  329 + )
  330 + /**
  331 + * @param as_user If true, simulate a user entering new content, updating sources, etc. Otherwise, just update the text.
  332 + */
  333 + set_text(einput:EInput.elvis('a), text:string, as_user:bool): void =
  334 + (
  335 + implem = (Elvis.implem(einput))
  336 + do Dom.set_value(implem.dom_input, text)
  337 + do if as_user then Dom.trigger(implem.dom_input, {change})
  338 + void
  339 + )
  340 +
  341 +
  342 + /**
  343 + * {3 Get/set editability of this input}
  344 + */
  345 + is_editable(einput:EInput.elvis('a)): bool =
  346 + (
  347 + implem = (Elvis.implem(einput))
  348 + Dom.is_enabled(implem.dom_input)
  349 + )
  350 + set_editable(einput:EInput.elvis('a), editable:bool): void =
  351 + (
  352 + implem = (Elvis.implem(einput))
  353 + dom = Dom.resolve(Dom.unsplit([implem.dom_input, implem.dom_welcome]))
  354 + do Dom.set_enabled(dom, editable)
  355 + do if editable then
  356 + do Dom.remove_class(dom, class_disabled)
  357 + do Dom.add_class(dom, class_enabled)
  358 + void
  359 + else
  360 + do Dom.remove_class(dom, class_enabled)
  361 + do Dom.add_class(dom, class_disabled)
  362 + void
  363 + void
  364 + )
  365 +
  366 + @private class_init = "init"
  367 + @private class_correct = "correct"
  368 + @private class_incorrect = "incorrect"
  369 + @private class_enabled = "enabled"
  370 + @private class_disabled = "disabled"
  371 +}}
50 stdlib/elvis/label.opa
... ... @@ -0,0 +1,50 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +
  19 +/**
  20 + * Elvis Labels
  21 + *
  22 + * @category UI
  23 + * @author David Rajchenbach-Teller, 2011
  24 + * @destination PUBLIC
  25 + * @stability EXPERIMENTAL
  26 + */
  27 +
  28 +/**
  29 + * {1 Simple display}
  30 + *
  31 + * Display some xhtml content as an elvis.
  32 + */
  33 +
  34 +type ELabel.sources = {}
  35 +@abstract type ELabel.implementation = {}
  36 +type ELabel.elvis = Elvis.elvis(ELabel.sources, ELabel.implementation)
  37 +
  38 +ELabel =
  39 +{{
  40 + simple(content:xhtml): ELabel.elvis =
  41 + make(_ -> content)
  42 +
  43 + make(content: Elvis.theme -> xhtml): ELabel.elvis =
  44 + display(theme) =
  45 + xhtml = content(theme)
  46 + dom = Dom.of_xhtml(xhtml)
  47 + {~xhtml ~dom}
  48 + Elvis.make(void, (void), display)
  49 +
  50 +}}
172 stdlib/elvis/list.opa
... ... @@ -0,0 +1,172 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.