Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/browser/naive/sample/document.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "/pliant/graphic/browser/naive/server.pli"
module "/pliant/graphic/browser/naive/lib/all.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/stream.pli"
module "/pliant/graphic/browser/naive/document.pli"
module "/pliant/graphic/browser/naive/document2.pli"
module "/pliant/language/type/text/str32.pli"
module "/pliant/util/encoding/utf8.pli"


#-------------------------------------------------------------------------
#  IO

method d load filename
  arg_rw BrowserDocument d ; arg Str filename
  (var Stream s) open filename in+safe
  while not s:atend
    var Str l := s readline
    if (l parse word:"tag" (var Str id) (var Str tag))
      d create_node id tag
    eif (l parse word:"attr" (var Str id) (var Str attr) (var Str value))
      var Pointer:BrowserNode n :> d search_node id
      if exists:n
        n attribute attr := value
    eif (l parse word:"stick" (var Str id) _ any:(var Str where) _ (var Str ref))
      var Pointer:BrowserNode n :> d search_node id
      var Pointer:BrowserNode r :> d search_node ref
      if exists:n and exists:r
        d stick n (shunt where="before" stick_before where="after" stick_after where="head" stick_head where="tail" stick_tail (cast undefined Int)) r


method d dump n s
  arg BrowserDocument d ; arg BrowserNode n ; arg_rw Stream s
  s writeline "tag "+(string n:id)+" "+(string n:tag)
  var CBool more := n first_attribute (var Str attr) (var Str value)
  while more
    s writeline "attr "+(string n:id)+" "+string:attr+" "+string:value
    more := n next_attribute (var Str attr) (var Str value)
  each sub n
    d dump sub s
    s writeline "stick "+(string sub:id)+" tail "+(string n:id)

method d save root filename
  arg BrowserDocument d ; arg Str root ; arg Str filename
  (var Stream s) open filename out+safe+mkdir
  var Pointer:BrowserNode n :> d search_node root
  if exists:n
    d dump n s


#-------------------------------------------------------------------------
#  Apply changes both locally and remotely


type DocumentEditorContext
  field Pointer:BrowserConnection connection
  field BrowserDocument d
  field Str filename
  field CBool modified <- false
  field Str action
  field Str cid ; field Int cindex # cursor
  field Str aid ; field Int aindex
  field Str bid ; field Int bindex


method e new_id -> id
  arg_rw DocumentEditorContext e ; arg Str id
  id := generate_id
  

method e node_tag id tag
  arg_rw DocumentEditorContext e ; arg Str id tag
  e:connection node_tag id tag
  e:d create_node id tag
  e modified := true

method e node_attribute id attr value
  arg_rw DocumentEditorContext e ; arg Str id attr value
  var Pointer:BrowserNode n :> e:d search_node id
  if exists:n
    e:connection node_attribute id attr value # FIXME: don't swap with next line
    n attribute attr := value
    e modified := true

method e node_attribute id attr value
  arg_rw DocumentEditorContext e ; arg Str id attr ; arg Str32 value
  e node_attribute id attr utf8_encode:value

method e node_stick id mode ref
  arg_rw DocumentEditorContext e ; arg Str id ; arg Int mode ; arg Str ref
  var Pointer:BrowserNode n :> e:d search_node id
  var Pointer:BrowserNode r :> e:d search_node ref
  if exists:n and exists:r
    e:connection node_stick id (shunt mode=stick_head "head" mode=stick_tail "tail" mode=stick_before "before" mode=stick_after "after" "?") ref
    e:d stick n mode r
    e modified := true

method e node_drop id
  arg_rw DocumentEditorContext e ; arg Str id
  var Pointer:BrowserNode n :> e:d search_node id
  if exists:n
    e:connection node_drop id
    e:d delete_node n
    e modified := true


#-------------------------------------------------------------------------
#  Helper functions


method n safe_id -> id
  arg BrowserNode n ; arg Str id
  if exists:n
    id := n id
  else
    id := ""

method n safe_tag -> t
  arg BrowserNode n ; arg Str t
  if exists:n
    t := n tag
  else
    t := ""

method n text -> t
  arg BrowserNode n ; arg Str32 t
  if n:safe_tag="text"
    t := utf8_decode (n attribute "")
  else
    t := ""


method e node_tag id -> t
  arg DocumentEditorContext e ; arg Str id ; arg Str t
  t := (e:d search_node id) safe_tag

method e node_text id -> t
  arg DocumentEditorContext e ; arg Str id ; arg Str32 t
  t := (e:d search_node id) text

method e 'node_text :=' id t
  arg_rw DocumentEditorContext e ; arg Str id ; arg Str32 t
  var Pointer:BrowserNode n :> e:d search_node id
  if exists:n and n:tag="text"
    e node_attribute id "" t


method n is_wall -> c
  arg BrowserNode n ; arg CBool c
  var Str t := n tag
  c := t="root" or t="para" or t="table" or t="cell"

method e node_wall id -> w
  arg_rw DocumentEditorContext e ; arg Str id ; arg Str w
  var Pointer:BrowserNode n :> e:d search_node id
  if exists:n
    while not n:is_wall
      n :> n parent
    w := n id
  else
    w := "root"


method e node_up id tag -> id2
  arg_rw DocumentEditorContext e ; arg Str id tag id2
  var Pointer:BrowserNode n :> e:d search_node id
  while exists:n and n:tag<>tag
    n :> n parent
  id2 := shunt exists:n n:id ""


method d is_aligned a aindex b bindex -> c
  arg BrowserDocument d ; arg BrowserNode a b ; arg Int aindex bindex ; arg CBool c
  if not exists:a or not exists:b or (addressof a:parent)<>(addressof b:parent)
    return false
  var Pointer:BrowserNode n :> a
  while exists:n and addressof:n<>addressof:b
    n :> n next
  c := exists:n and (addressof:a<>addressof:b or bindex>=aindex)

method e is_aligned aid aindex bid bindex -> c
  arg DocumentEditorContext e ; arg Str aid bid ; arg Int aindex bindex ; arg CBool c
  c := e:d is_aligned (e:d search_node aid) aindex (e:d search_node bid) bindex


method e select_cancel
  arg_rw DocumentEditorContext e
  e aid := "" ; e aindex := undefined
  e bid := "" ; e bindex := undefined


#-------------------------------------------------------------------------
#  Adjust cursor and adapt tree

method d next_node p cross_walls -> n
  arg BrowserDocument d ; arg BrowserNode p ; arg CBool cross_walls ; arg_C BrowserNode n
  n :> p next
  if exists:n
    if not cross_walls and n:is_wall
      n :> null map BrowserNode
      return
    while { var Pointer:BrowserNode t :> n first ; exists t }
      n :> t
      if not cross_walls and n:is_wall
        n :> null map BrowserNode
        return
  else
    n :> p parent
    if exists:n and not cross_walls and n:is_wall
      n :> null map BrowserNode

method d next_text n cross_walls -> p
  arg BrowserDocument d ; arg BrowserNode n ; arg CBool cross_walls ; arg_C BrowserNode p
  p :> d next_node n cross_walls
  while exists:p and p:tag<>"text"
    p :> d next_node p cross_walls
  

method d previous_node n cross_walls -> p
  arg BrowserDocument d ; arg BrowserNode n ; arg CBool cross_walls ; arg_C BrowserNode p
  p :> n previous
  if exists:p
    if not cross_walls and p:is_wall
      p :> null map BrowserNode
      return
    while { var Pointer:BrowserNode t :> p last ; exists t }
      p :> t
      if not cross_walls and p:is_wall
        p :> null map BrowserNode
        return
  else
    p :> n parent
    if exists:p and not cross_walls and p:is_wall
      p :> null map BrowserNode

method d previous_text n cross_walls -> p
  arg BrowserDocument d ; arg BrowserNode n ; arg CBool cross_walls ; arg_C BrowserNode p
  p :> d previous_node n cross_walls
  while exists:p and p:tag<>"text"
    p :> d previous_node p cross_walls
  

method d extend_needed n -> c
  arg BrowserDocument d ; arg BrowserNode n ; arg CBool c
  c := not exists:(d next_text n false) and { var Str t := n attribute "" ; (t (max t:len-1 0) 1)<>"[lf]" }

method e extend_needed id -> c
  arg DocumentEditorContext e ; arg Str id ; arg CBool c
  var Pointer:BrowserNode n :> e:d search_node id
  c := exists:n and (e:d extend_needed n)


method e move id index delta cross_walls -> status
  arg_rw DocumentEditorContext e ; arg_rw Str id ; arg_rw Int index ; arg Int delta ; arg CBool cross_walls ; arg Status status
  implicit e
    index += delta
    part move
      var Pointer:BrowserNode n :> d search_node id
      if not exists:n
        id := "" ; index := undefined ; return failure
      eif n:tag<>"text"
        var Pointer:BrowserNode p :> d next_text n cross_walls
        if exists:p
          id := p id ; restart move
        else
          id := "" ; index := undefined ; return failure
      var Int l := n:text len
      if index<0
        var Pointer:BrowserNode p :> d previous_text n cross_walls
        if exists:p
          id := p id ; index += p:text len ; restart move
        else
          return failure
      if index>=l and (d extend_needed n)
        l += 1
      if index>=l
        var Pointer:BrowserNode p :> d next_text n cross_walls
        if exists:p
          id := p id ; index -= l ; restart move
        else
          return failure
      status := success


method e text_cut id index
  arg_rw DocumentEditorContext e ; arg Str id ; arg Int index
  implicit e
    var Pointer:BrowserNode n :> d search_node id
    if exists:n and n:tag="text"
      var Str32 t := utf8_decode (n attribute "")
      if index>0 and index<t:len
        var Str id2 := new_id
        if aid=n:id and aindex>=index
          aid := id2 ; aindex -= index
        if bid=n:id and bindex>=index # FIXME: using id instead of n:id raises a bug in Pliant code generator
          bid := id2 ; bindex -= index
        if cid=n:id and cindex>=index
          cid := id2 ; cindex -= index
        node_tag id2 "text"
        node_text id2 := t index t:len
        node_stick id2 stick_after n:id
        node_text n:id := t 0 index

method e text_stick id
  arg_rw DocumentEditorContext e ; arg Str id
  implicit e
    var Pointer:BrowserNode n :> d search_node id
    if exists:n and n:tag="text"
      var Pointer:BrowserNode n2 :> n next
      if exists:n2 and n2:tag="text"
        var Int l := n:text len
        if aid=n2:id
          aid := id ; aindex += l
        if bid=n2:id
          bid := id ; bindex += l
        if cid=n2:id
          cid := id ; cindex += l
        node_attribute id "" (n attribute "")+(n2 attribute "")
        node_drop n2:id

  
method e normalise n -> conflict
  arg_rw DocumentEditorContext e ; arg BrowserNode n ; arg CBool conflict
  part recurse
    each sub n
      if (e normalise sub)
        restart recurse
  var Pointer:BrowserNode p :> n first
  while exists:p
    if p:tag="text" and (exists p:next) and p:next:tag="text"
      e text_stick p:id
    else
      p :> p next
  if n:tag="text"
    if (n attribute ""):len=0 and exists:(e:d next_text n false)
      e node_drop n:id
      return true
  eif n:tag="bold" or n:tag="italic"
    if not (exists n:first)
      e node_drop n:id
      return true
  eif n:tag="eol"
    var Str id := e new_id
    e node_tag id "text"
    e node_text id := "[lf]"
    e node_stick id stick_after n:id
    e node_drop n:id
    return true
  conflict := false

method e node_normalise id
  arg_rw DocumentEditorContext e ; arg Str id
  var Pointer:BrowserNode n :> e:d search_node id
  if exists:n
    e normalise n


#-------------------------------------------------------------------------
#  Drive browser


method e node_refresh id
  arg_rw DocumentEditorContext e ; arg Str id
  e:connection window_refresh main

method e focus_set id index delta cross_walls -> status
  arg_rw DocumentEditorContext e ; arg_rw Str id ; arg_rw Int index ; arg Int delta ; arg CBool cross_walls ; arg Status status
  status := e move id index delta cross_walls
  if status=success
    e:connection focus_set "hook" id index ""
    e cid := id ; e cindex := index


#-------------------------------------------------------------------------
#  Edit text attributes


method e text_set_attribute tag -> id2
  arg_rw DocumentEditorContext e ; arg Str tag id2
  implicit e
    id2 := ""
    var Pointer:BrowserNode n :> d search_node aid
    while exists:n
      if n:tag=tag
        return
      n :> n parent
    if (is_aligned aid aindex bid bindex)
      text_cut aid aindex
      text_cut bid bindex
      var Pointer:BrowserNode a :> d search_node aid
      var Pointer:BrowserNode b :> d search_node bid
      id2 := new_id
      node_tag id2 tag
      node_stick id2 stick_before a:id
      var Pointer:BrowserNode n :> a
      while addressof:n<>addressof:b
        var Pointer:BrowserNode nn :> n next
        node_stick n:id stick_tail id2
        n :> nn
        
method e text_cancel_attribute tag
  arg_rw DocumentEditorContext e ; arg Str tag
  implicit e
    var Pointer:BrowserNode n :> d search_node cid
    while exists:n and n:tag<>tag
      n :> n parent
    if not exists:n
      return
    var Pointer:BrowserNode p :> n first
    while exists:p
      var Pointer:BrowserNode p2 :> p next
      node_stick p:id stick_after n:id
      p :> p2
    node_drop n:id

    
method e table_create nx ny
  arg_rw DocumentEditorContext e ; arg Int nx ny
  implicit e
    if nx>0 and ny>0 and nx<=1000 and ny<=1000 and nx*ny<=10000
      text_cut cid cindex
      var Str tid := new_id
      node_tag tid "table"
      node_attribute tid "border" "0.3"
      node_attribute tid "padding" "1"
      for (var Int y) 0 ny-1
        var Str rid := new_id
        node_tag rid "row"
        for (var Int x) 0 nx-1
          var Str did := new_id
          node_tag did "cell"
          var Str eid := new_id
          node_tag eid "text"
          node_text eid := "."
          node_stick eid stick_tail did
          node_stick did stick_tail rid
        node_stick rid stick_tail tid
      node_stick tid stick_before cid
      

#-------------------------------------------------------------------------
#  Main


browser_page "/document/"
  ovar DocumentEditorContext e
  e connection :> connection
  implicit e
    filename := "data:/pliant/sample/document/"+url_subpath+".d"
    d load filename
    if not exists:(d search_node "root")
      d create_node "root" "section"
      var Str id := new_id
      d create_node id "text"
      (d search_node id) attribute "" := "Welcome."
      d stick (d search_node id) stick_tail (d search_node "root")
    window top
      section "parameters"
        void
    window left
      section "menu" dynamic
        button "file" key "alt f"
          section_overwrite "parameters"
            button "save" key "alt s"
              d save "root" filename
              modified := false
              section_replay "menu"
            button "cancel" key "escape"
              section_replay "menu"
        eol
        button "attribute" key "alt a"
          section_overwrite "parameters"
            button "bold" key "alt b"
              text_set_attribute "bold"
              node_normalise "root"
              window_refresh main
            button "regular" key "alt r"
              text_cancel_attribute "bold"
              node_normalise "root"
              window_refresh main
            eol
            button "italic" key "alt i"
              text_set_attribute "italic"
              node_normalise "root"
              window_refresh main
            button "normal" key "alt n"
              text_cancel_attribute "italic"
              node_normalise "root"
              window_refresh main
            eol
            button "center" key "alt c"
              text_set_attribute "center"
              node_normalise "root"
              window_refresh main
            button "left" key "alt l"
              text_cancel_attribute "center"
              node_normalise "root"
              window_refresh main
            eol
            ovar Float size := 12
            input "" size
            text " points "
            button "size" key "alt s"
              if size>=1 and size<=1000
                var Str id := text_set_attribute "font"
                if id<>""
                  e node_attribute id "size" (string size*25.4/72)
                node_normalise "root"
                window_refresh main
            button "cancel size" key "alt c"
              text_cancel_attribute "font"
              node_normalise "root"
              window_refresh main
            eol
            button "cancel" key "escape"
              section_replay "menu"
        eol
        button "table" key "alt t"
          section_overwrite "parameters"
            ovar Int nx := 2 ; ovar Int ny := 2
            input "" nx ; text " columns and "
            input "" ny ; text " rows"
            button "insert table" key "alt t"
              table_create nx ny
              node_normalise "root"
              window_refresh main
            eol
            ovar Float padding := 1
            input "" padding ; text " mm "
            button "padding" key "alt p"
              var Str tid := node_up cid "table"
              if tid<>"" and padding>=0 and padding<1000
                e node_attribute tid "padding" string:padding
              node_normalise "root"
              window_refresh main
            eol
            ovar Str color := "808080"
            input "rgb " color
            button "color" key "alt c"
              var Str tid := node_up cid "cell"
              if tid<>""
                e node_attribute tid "color" color
              node_normalise "root"
              window_refresh main
            eol
            button "cancel" key "escape"
              section_replay "menu"
        eol
        button "exit" key "alt x"
          if modified
            section_overwrite "parameters"
              text "File as been modified, but not saved." ; eol
              button "force to leave" key "alt f"
                url_return
              button "cancel" key "escape"
                section_replay "menu"
          else
            url_return
        section_overwrite "parameters"
          void
    window main
      node "hook"
        hook
          void
        event
          if event="press" and key="button1"
            if (focus_set target_id target_index (shunt (target_options option "right") and extend_needed:target_id and target_index<node_text:target_id:len 1 0) false)=success
              aid := target_id ; aindex := target_index
          eif event="release" and key="button1"
            if (move target_id target_index (shunt (target_options option "right") and extend_needed:target_id and target_index<node_text:target_id:len 2 1) false)=success
              bid := target_id ; bindex := target_index
          if event="character"
            if (move focus_id focus_index 0 false)=success
              if node_tag:focus_id="text"
                var Str32 t := node_text focus_id
                node_text focus_id := (t 0 focus_index)+utf8_decode:key+(t focus_index t:len)
                node_refresh focus_id
                select_cancel
                focus_set focus_id focus_index 1 false
          eif event="press"
            if key="backspace"
              if (move focus_id focus_index -1 false)=success
                if node_tag:focus_id="text"
                  var Str32 t := node_text focus_id
                  node_text focus_id := (t 0 focus_index)+(t focus_index+1 t:len)
                  node_normalise "root"
                  node_refresh focus_id
                  select_cancel
                  focus_set focus_id focus_index 0 false
            eif key="enter"
              if (move focus_id focus_index 0 false)=success
                var Str32 t := node_text focus_id
                node_text focus_id := (t 0 focus_index)+"[lf]"+(t focus_index t:len)
                node_refresh focus_id
                select_cancel
                focus_set focus_id focus_index 1 false
            eif key="left"
              select_cancel
              focus_set focus_id focus_index -1 true
            eif key="right"
              select_cancel
              focus_set focus_id focus_index 1 true
      d dump (d search_node "root") stream
      stream writeline "stick [dq]root[dq] tail [dq]hook[dq]"
      node_normalise "root"