Patch title: Release 93 bulk changes
Abstract:
File: /graphic/browser/tag/text.pli
Key:
    Removed line
    Added line
module "/pliant/language/unsafe.pli"
module "prototype.pli"
module "/pliant/graphic/browser/core.pli"
module "/pliant/language/type/text/str32.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/graphic/browser/xml/helper.pli"
module "/pliant/util/encoding/utf8.pli"
module "/pliant/graphic/vector/font.pli"
module "/pliant/math/transform.pli"
module "/pliant/graphic/misc/float.pli"

# constant standard_font_family "[dq]Nimbus Roman No9 L[dq] regular [dq] Regular[dq] bold [dq] Medium[dq]"
constant standard_font_family "Bitstream Charter"
# constant standard_font_family "[dq]Nimbus Sans L[dq] regular [dq] Regular[dq]"
# constant standard_font_family "Bitstream Charter"
constant standard_font_family "[dq]Nimbus Sans L[dq] regular [dq] Regular[dq]"

# constant fixed_font_family "[dq]Nimbus Mono L[dq] regular [dq] Regular[dq] italic [dq] Oblique[dq]"
constant fixed_font_family "Courier 10 Pitch"
# cconstant fixed_font_family "Courier 10 Pitch"
constant fixed_font_family "[dq]Nimbus Mono L[dq] regular [dq] Regular[dq] italic [dq] Oblique[dq]"


type TextArea
  field Int offset
  field BrowserArea area

method c font_name def -> name
  arg XmlContext c ; arg Str def name
  arg BrowserContext c ; arg Str def name
  if not (def parse (var Str face) any:(var Str options))
    face := def ; options := ""
  var Str regular := options option "regular" Str
  var Str bold := options option "bold" Str " Bold"
  var Str italic := options option "italic" Str " Italic"
  name := face+(shunt (c query "b") bold regular)+(shunt (c query "i") italic "")
  name := face+(shunt (c query "bold") bold regular)+(shunt (c query "italic") italic "")

method c current_font scale color -> f
  arg XmlContext c ; arg_w Float scale ; arg_rw Int color ; arg Link:Font f
  arg BrowserContext c ; arg_w Float scale ; arg_rw Int color ; arg Link:Font f
  f :> font (c font_name (c query "font" "face"))
  if not exists:f
    f :> font (c query "font" "face")
  if not exists:f
    f :> font (c font_name (shunt (c query "tt") fixed_font_family standard_font_family))
    var Str default := shunt (c query "fixed") fixed_font_family standard_font_family
    f :> font (c font_name default)
    if not exists:f
      console "Error: font '"+(c font_name (shunt (c query "tt") fixed_font_family standard_font_family))+"' is missing in your system." eol
  var Str sc := c query "font" "size"
  if (sc parse "+" scale)
    scale := 12*1.25^scale
  eif (sc parse "-" scale)
    scale := 12/1.25^scale
  eif not (sc parse scale)
    scale := 12
  scale *= 25.4/72
  color := html_color (c query "font" "color")
      console "Error: font '"+default+"' is missing in your system." eol
  if not ((c query "font" "size") parse scale)
    scale := 12*25.4/72
  color := c:console browser_color (c query "font" "color")

tag_position ''
  if true
    var Pointer:XmlTree sub :> tree first
    while exists:sub
      tree text += sub text
      var Pointer:XmlTree next :> sub next
      free_xml_node sub
      sub :> next
    tree first :> null map XmlTree
  if text=""
    return
browser_tag_position text
  var Link:Font font :> current_font (var Float scale) (var Int color)
  var Str32 text := utf8_decode attribute:""
  part control
    var Str32 t := html_decode32 (replace text " " " ")
    font bbox t null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    if bx1-bx0<=area_x1-line_x
      x0 := bx0 ; y0 := by0 ; x1 := bx1 ; y1 := by1
      addtoline tree
    font bbox text null undefined (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    if bx1-bx0<=area_x1-line_x or (query "para" "fold")="false"
      area x0 := bx0 ; area y0 := by0 ; area x1 := bx1 ; area y1 := by1
      addtoline node
      if query:"center"
        line_center := true
      return
    area ; var Int n := 0
    var Int start := 0
    while start<text:len
      var Int stop := start
      part cut
        var Int i := ((text stop text:len) search " " text:len-stop)+stop
        var Str32 t := html_decode32 (replace (text start i-start) "&nbsp;" "&#32;")
        font bbox t null bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
        var Int i := stop
        while i<text:len and text:i<>" "
          i += 1
        var Str32 t := text start i-start
        font bbox t null undefined bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
        if bx1-bx0>area_x1-line_x
          leave cut
        while i<text:len and text:i=" "
          i += 1
        stop := i
        if stop<text:len
          restart cut
      if stop=start
        if start=0 and line_x<>area_x0
          newline
          restart control
        eif start=0
          var Str32 t := html_decode32 (replace text "&nbsp;" "&#32;")
          font bbox t null bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
          x0 := bx0 ; y0 := by0 ; x1 := bx1 ; y1 := by1
          addtoline tree
          var Str32 t := utf8_decode attribute:""
          font bbox t null undefined bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
          area x0 := bx0 ; area y0 := by0 ; area x1 := bx1 ; area y1 := by1
          addtoline node
          return
        else
          stop := text len
      var Pointer:XmlTree line :> new_xml_node
      line text := text start stop-start
      tree append line
      var Str32 t := html_decode32 (replace line:text "&nbsp;" "&#32;")
      font bbox t null bx0 by0 bx1 by1 ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      line x0 := bx0 ; line y0 := by0 ; line x1 := bx1 ; line y1 := by1
      addtoline line
      extra := memory_resize extra BrowserArea:size+(n+1)*TextArea:size addressof:node
      var Pointer:TextArea a :> (extra translate BrowserArea 1) map TextArea n
      a offset := stop
      var Str32 t := text start stop-start
      font bbox t null undefined (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      a:area x0 := bx0 ; a:area y0 := by0 ; a:area x1 := bx1 ; a:area y1 := by1
      addtoline a:area
      if query:"center"
        line_center := true
      start := stop
      if start<text:len
      if stop<text:len
        newline
  text := ""
      start := stop
      n += 1
  area x0 := float_max
  area y0 := float_max
  area x1 := float_min
  area y1 := float_min
  for (var Int i) 0 n-1
    var Pointer:TextArea a :> (extra translate BrowserArea 1) map TextArea i
    area x0 := min area:x0 a:area:x0
    area y0 := min area:y0 a:area:y0
    area x1 := max area:x1 a:area:x1
    area y1 := max area:y1 a:area:y1
  for (var Int i) 0 n-1
    var Pointer:TextArea a :> (extra translate BrowserArea 1) map TextArea i
    a:area x0 -= area x0
    a:area y0 -= area y0
    a:area x1 -= area x0
    a:area y1 -= area y0

tag_draw ''
  var Str32 t := html_decode32 (replace text "&nbsp;" "&#32;")
  if t:len>0
browser_tag_draw text
  if node:extra=null
    void
  eif { var Int n := (memory_size:extra-BrowserArea:size)\TextArea:size ; n=0 }
    var Str32 text := utf8_decode attribute:""
    var Link:Font font :> current_font (var Float scale) (var Int color)
    font bbox t null (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    text t font null undefined (transform x0-bx0 y0-by0 scale scale 0 0) addressof:color
  draw_recurse tree
    font bbox text null undefined (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    text text font null undefined (transform area:x0-bx0 area:y0-by0 scale scale 0 0) addressof:color
  else
    var Str32 text := utf8_decode attribute:""
    var Link:Font font :> current_font (var Float scale) (var Int color)
    var Int start := 0
    for (var Int i) 0 n-1
      var Pointer:TextArea a :> (extra translate BrowserArea 1) map TextArea i
      var Int stop := a offset
      var Str32 t := text start stop-start
      font bbox t null undefined (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      text t font null undefined (transform area:x0+a:area:x0-bx0 area:y0+a:area:y0-by0 scale scale 0 0) addressof:color
      start := stop
  draw_recurse node


browser_tag_event text
  if target_id<>""
    return
  if node:extra=null
    void
  eif { var Int n := (memory_size:extra-BrowserArea:size)\TextArea:size ; n=0 }
    var Str32 text := utf8_decode attribute:""
    var Link:Font font :> current_font (var Float scale) (var Int color)
    font bbox text null undefined (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
    target_id := node id
    target_x0 := area x0 ; target_y0 := area y0 ; target_x1 := area x1 ; target_y1 := area y1
    target_index := 0
    while target_index<text:len and (font length (text 0 target_index+1) null)*scale<x-area:x0
      target_index += 1
  else
    var Str32 text := utf8_decode attribute:""
    var Link:Font font :> current_font (var Float scale) (var Int color)
    var Int start := 0
    for (var Int i) 0 n-1
      var Pointer:TextArea a :> (extra translate BrowserArea 1) map TextArea i
      var Int stop := a offset
      var Str32 t := text start stop-start
      font bbox t null undefined (var Float bx0) (var Float by0) (var Float bx1) (var Float by1) ; bx0 *= scale ; by0 *= scale ; bx1 *= scale ; by1 *= scale
      if area:x0+a:area:x0<=x and area:y0+a:area:y0<=y and area:x0+a:area:x0+bx1-bx0>=x and area:y0+a:area:y0+by1-by0>=y
        target_id := node id
        target_x0 := area x0 ; target_y0 := area y0 ; target_x1 := area x1 ; target_y1 := area y1
        target_index := start
        while target_index<stop and (font length (text start target_index-start+1) null)*scale<x-area:x0-a:area:x0
          target_index += 1
      start := stop