Tkabber plugins

2015-05-09  Sergei Golovan  <sgolovan@nes.ru>

	* whiteboard/ChangeLog, whiteboard/msgs/de.msg, whiteboard/msgs/es.msg,
	  whiteboard/msgs/nl.msg, whiteboard/msgs/pl.msg,
	  whiteboard/msgs/ro.msg, whiteboard/msgs/ru.msg,
	  whiteboard/msgs/uk.msg, whiteboard/svgrender.tcl,
	  whiteboard/whiteboard.tcl: Reformatted the code.

	* unixkeys/INSTALL, unixkeys/README, unixkeys/TODO,
	  unixkeys/msgs/ru.msg, unixkeys/unixkeys.tcl: Reformatted the code.
	  Bind all events to TEntry also.

	* traffic/traffic.tcl: Adapted the Traffic accounting plugin to the
	  Ttk based interface.

2003-09-01  Alexey Shchepin  <alexey@sevcom.net>

	* whiteboard.tcl: Bugfixes

2003-05-29  Alexey Shchepin  <alexey@sevcom.net>

	* whiteboard.tcl: Support for private whiteboard

# de.msg --
#
#       German messages file for the Tkabber Whiteboard plugin.
#
# Author: Roger Sondermann 15.03.2009

::msgcat::mcset de "%s created: %s"             "%s erstellt von %s"
::msgcat::mcset de "%s moved: %s"               "%s verschoben von %s"
::msgcat::mcset de "%s transformed: %s"         "%s transformiert: %s"
::msgcat::mcset de "%s whiteboard"              "%s 'Whiteboard'"

::msgcat::mcset de "Flip vertically"            "Spiegeln vertikal"
::msgcat::mcset de "FreeHand"                   "Frei-Hand"
::msgcat::mcset de "GIF images"                 "GIF-Bilder"
::msgcat::mcset de "Image"                      "Bild"
::msgcat::mcset de "JPEG images"                "JPEG-Bilder"
::msgcat::mcset de "Line color"                 "Linien-Farbe"
::msgcat::mcset de "Line width: "               "Linien-Breite"
::msgcat::mcset de "Loading image failed: %s." \
        "Laden der Bilder misslungen: %s."
::msgcat::mcset de "Move/Transform"             "Bewegen"
::msgcat::mcset de "OK"                         "OK"
::msgcat::mcset de "PNG images"                 "PNG-Bilder"
::msgcat::mcset de "PolyLine"                   "Linie"
::msgcat::mcset de "Polygon"                    "Polygon"
::msgcat::mcset de "Rectangle"                  "Rechteck"
::msgcat::mcset de "Remove"                     "Entfernen"
::msgcat::mcset de "Rotate 135\u00b0"           "Drehen 135\u00b0"
::msgcat::mcset de "Rotate 180\u00b0"           "Drehen 180\u00b0"
::msgcat::mcset de "Rotate 45\u00b0"            "Drehen 45\u00b0"
::msgcat::mcset de "Rotate 90\u00b0"            "Drehen 90\u00b0"
::msgcat::mcset de "Save..."                    "Speichern..."
::msgcat::mcset de "Show balloons"              "Tooltips"
::msgcat::mcset de "Text color"                 "Text-Farbe"
::msgcat::mcset de "Text font"                  "Schriftart"
::msgcat::mcset de "Text"                       "Text"
::msgcat::mcset de "Whether the Whiteboard plugin is loaded." \
        "'Whiteboard'-Plugin laden."
::msgcat::mcset de "Whiteboard"                 "Whiteboard"

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# es.msg --
#
#       Spanish messages for the Tkabber Whiteboard plugin.
#
# Author: Badlop

::msgcat::mcset es "%s created: %s" "%s creado: %s"
::msgcat::mcset es "%s moved: %s" "%s movido: %s"
::msgcat::mcset es "%s transformed: %s" "%s transforma: %s"
::msgcat::mcset es "%s whiteboard" "Pizarra: %s"

::msgcat::mcset es "Flip vertically" "Girar verticalmente"
::msgcat::mcset es "FreeHand" "Mano alzada"
::msgcat::mcset es "GIF images" "Imágenes GIF"
::msgcat::mcset es "Image" "Imagen"
::msgcat::mcset es "JPEG images" "Imágenes JPEG"
::msgcat::mcset es "Line color" "Color de línea"
::msgcat::mcset es "Line width: " "Ancho de línea: "
::msgcat::mcset es "Loading image failed: %s." \
        "La carga de la imagen ha fallado: %s."
::msgcat::mcset es "Move/Transform" "Mover/Transformar"
::msgcat::mcset es "OK" "Sí"
::msgcat::mcset es "PNG images" "Imágenes PNG"
::msgcat::mcset es "PolyLine" "Polilínea"
::msgcat::mcset es "Polygon" "Polígono"
::msgcat::mcset es "Rectangle" "Rectángulo"
::msgcat::mcset es "Remove" "Borrar"
::msgcat::mcset es "Rotate 135\u00b0" "Rotar 135\u00b0"
::msgcat::mcset es "Rotate 180\u00b0" "Rotar 180\u00b0"
::msgcat::mcset es "Rotate 45\u00b0" "Rotar 45\u00b0"
::msgcat::mcset es "Rotate 90\u00b0" "Rotar 90\u00b0"
::msgcat::mcset es "Save..." "Guardar..."
::msgcat::mcset es "Show balloons" "Mostrar globos"
::msgcat::mcset es "Text color" "Color del texto"
::msgcat::mcset es "Text font" "Fuente del texto"
::msgcat::mcset es "Text" "Texto"
::msgcat::mcset es "Whether the Whiteboard plugin is loaded." \
        "Cargar el plugin Whiteboard."
::msgcat::mcset es "Whiteboard" "Pizarra"

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# nl.msg --
#
#       Dutch messages for the Tkabber Whiteboard plugin.
#
# Author: Sander Devrieze <s.devrieze@pandora.be>

::msgcat::mcset nl "Whiteboard" "Whiteboard"
::msgcat::mcset nl "%s whiteboard" "Whiteboard %s"
::msgcat::mcset nl "PolyLine" "Veelhoek"
::msgcat::mcset nl "FreeHand" "Potlood"
::msgcat::mcset nl "Move" "Verplaatsen"
::msgcat::mcset nl "Clear" "Wissen"
::msgcat::mcset nl "Color" "Kleur"
::msgcat::mcset nl "Text" "Tekst"
::msgcat::mcset nl "Text Color" "Tekstkleur"
::msgcat::mcset nl "Font" "Lettertype"
::msgcat::mcset nl "OK" "OK"
::msgcat::mcset nl "Cancel" "Annuleren"

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# pl.msg --
#
#       Polish messages for the Tkabber Whiteboard plugin.
#
# Author: Irek Chmielowiec <irek.ch@gmail.com>

::msgcat::mcset pl "Whiteboard" "Tablica rysunkowa"
::msgcat::mcset pl "%s whiteboard" "Tablica: %s"
::msgcat::mcset pl "PolyLine" "Linia prosta"
::msgcat::mcset pl "FreeHand" "Linia odręczna"

::msgcat::mcset pl "Rotate 90\u00b0" "Obrót o 90\u00b0"
::msgcat::mcset pl "%s transformed: %s" "Przekształcono %s: %s"
::msgcat::mcset pl "All files" "Wszystkie pliki"
::msgcat::mcset pl "All images" "Wszystkie obrazy"
::msgcat::mcset pl "GIF images" "Obrazy GIF"
::msgcat::mcset pl "Image" "Obraz"
::msgcat::mcset pl "JPEG images" "Obrazy JPEG"
::msgcat::mcset pl "Loading image failed: %s." \
        "Otwarcie obrazu nie powiodło się: %s."
::msgcat::mcset pl "PNG images" "Obrazy PNG"
::msgcat::mcset pl "Whether the Whiteboard plugin is loaded." \
        "Załaduj wtyczkę tablicy rysunkowej."

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# ro.msg --
#
#       Romanian messages for the Tkabber Whiteboard plugin.
#
# Author:

::msgcat::mcset ro "Whiteboard" "Tablă"
::msgcat::mcset ro "%s whiteboard" "Table %s"
::msgcat::mcset ro "PolyLine" "Linie poligonală"
::msgcat::mcset ro "FreeHand" "Mână liberă"
::msgcat::mcset ro "Move" "Mută"
#::msgcat::mcset ro "Remove" "Şterge"
::msgcat::mcset ro "Clear" "Şterge tot"
::msgcat::mcset ro "Color" "Culoare"

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# ru.msg --
#
#       Russian messages for the Tkabber Whiteboard plugin.
#
# Author: Sergei Golovan <sgolovan@nes.ru>

::msgcat::mcset ru "Cancel" "Отменить"
::msgcat::mcset ru "Circle" "Окружность"
::msgcat::mcset ru "Clear" "Очистить"
::msgcat::mcset ru "Enter text" "Введите текст"

::msgcat::mcset ru "Remove" "Удалить"
::msgcat::mcset ru "Rotate 135\u00b0" "Повернуть на 135\u00b0"
::msgcat::mcset ru "Rotate 180\u00b0" "Повернуть на 180\u00b0"
::msgcat::mcset ru "Rotate 45\u00b0" "Повернуть на 45\u00b0"
::msgcat::mcset ru "Rotate 90\u00b0" "Повернуть на 90\u00b0"
::msgcat::mcset ru "Save..." "Сохранить..."
::msgcat::mcset ru "Show balloons" "Показывать подск."
::msgcat::mcset ru "Skew horizontally 10\u00b0" \
        "Скосить горизонтально на 10\u00b0"
::msgcat::mcset ru "Skew horizontally -10\u00b0" \
        "Скосить горизонтально на -10\u00b0"
::msgcat::mcset ru "Skew vertically 10\u00b0" "Скосить вертикально на 10\u00b0"
::msgcat::mcset ru "Skew vertically -10\u00b0" \
        "Скосить вертикально на -10\u00b0"
::msgcat::mcset ru "%s created: %s" "%s создано: %s"
::msgcat::mcset ru "%s moved: %s" "%s перемещено: %s"
::msgcat::mcset ru "%s transformed: %s" "%s трансформировано: %s"
::msgcat::mcset ru "%s whiteboard" "%s доска"
::msgcat::mcset ru "Text color" "Цвет текста"
::msgcat::mcset ru "Text font" "Шрифт текста"
::msgcat::mcset ru "Text" "Текст"
::msgcat::mcset ru "Whiteboard" "Грифельная доска"
::msgcat::mcset ru "All files" "Все файлы"
::msgcat::mcset ru "All images" "Все изображения"
::msgcat::mcset ru "GIF images" "Изображения GIF"
::msgcat::mcset ru "Image" "Изображение"
::msgcat::mcset ru "JPEG images" "Изображения JPEG"
::msgcat::mcset ru "Loading image failed: %s." \
        "Загрузить изображение не удалось: %s"
::msgcat::mcset ru "PNG images" "Изображения PNG"
::msgcat::mcset ru "Whether the Whiteboard plugin is loaded." \
        "Загружено ли расширение 'Грифельная доска'."

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# uk.msg --
#
#       Ukrainian messages for the Tkabber Whiteboard plugin.
#
# Author: Mykola Dzham <levsha@jabber.net.ua>

::msgcat::mcset uk "Whiteboard" "Грифельна дошка"
::msgcat::mcset uk "%s whiteboard" "%s дошка"
::msgcat::mcset uk "PolyLine" "Ламана"
::msgcat::mcset uk "FreeHand" "Крива"
::msgcat::mcset uk "Move" "Перемістити"
::msgcat::mcset uk "Remove" "Видалити"
::msgcat::mcset uk "Clear" "Очистити"
::msgcat::mcset uk "Line color" "Колір лінії"
::msgcat::mcset uk "Text" "Текст"
::msgcat::mcset uk "Text color" "Колір тексту"
::msgcat::mcset uk "Text font" "Шрифт тексту"
::msgcat::mcset uk "Line width: " "Товщина лінії: "
::msgcat::mcset uk "OK" "Продовжити"
::msgcat::mcset uk "Cancel" "Відмінити"

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# svgrender.tcl --
#
#       This file is a part of the Whiteboard plugin for Tkabber
#       XMPP client. It renders a subset of SVG on a Tk canvas.

package require Tk 8.5
catch {package require Img}

namespace eval svg {
    variable Debug 0
}

}

proc svg::parseSVGFile {c xmldata} {
    Debug 2 $xmldata
    ::xmpp::xml::split $xmldata tag xmlns attrs cdata subels

    if {$tag != "svg"} {
        return -code error "Not a SVG file"
    }

    parseSVGItem $c {} {} $xmldata
}

proc svg::parseSVGItem {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    switch -- $tag {
        svg {
            ParseSVG $c $transform $curAttrs $item
        }
        rect {
            ParseRect $c $transform $curAttrs $item
        }
        line {
            ParseLine $c $transform $curAttrs $item
        }
        polyline {
            ParsePolyline $c $transform $curAttrs $item
        }
        polygon {
            ParsePolygon $c $transform $curAttrs $item
        }
        circle {
            ParseCircle $c $transform $curAttrs $item
        }
        ellipse {
            ParseEllipse $c $transform $curAttrs $item
        }
        text {
            ParseText $c $transform $curAttrs $item
        }
        image {
            ParseImage $c $transform $curAttrs $item
        }
        g {
            ParseG $c $transform $curAttrs $attrs $subels
        }
        default {
            Debug 1 Unknown SVG tag '$tag'
            return ""
        }
    }
}

proc svg::ParseSVG {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    foreach subel $subels {
        parseSVGItem $c $transform $curAttrs $subel
    }
    return ""
}

proc svg::ParseG {c transform curAttrs attrs items} {
    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    array set Attrs $curAttrs
    array set Attrs $attrs
    set curAttrs [array get Attrs]

    foreach item $items {
        parseSVGItem $c $transform $curAttrs $item
    }
    return ""
}

proc svg::ParsePolygon {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    set p [TransformPoints $transform [::xmpp::xml::getAttr $attrs points]]

    array set Attrs $curAttrs
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]
    set drawitem line

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        switch -- $attr {
            "" {}
            fill -
            stroke -
            stroke-width -
            stroke-linejoin {
                set Attrs($attr) $val
            }
            default {
                Debug 1 Unknown style attr '$attr'
            }
        }
    }

    if {[info exists Attrs(fill)]} {
        set opts [PolygonOpts]
        set drawitem polygon
    } else {
        set opts [LineOpts]
        set drawitem line
        lappend p [lindex $p 0] [lindex $p 1]
    }

    Debug 2 $drawitem $p $opts
    eval [list $c create $drawitem] $p $opts
}

proc svg::ParseCircle {c transform curAttrs item} {
    variable Unitcircle

    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    array set Attrs $curAttrs
    array set Attrs {cx 0 cy 0 r 0}
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]
    set drawitem circle

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        switch -- $attr {
            "" {}
            cx -
            cy -
            r -
            fill -
            stroke -
            stroke-width {
                set Attrs($attr) $val
            }
            default {
                Debug 1 Unknown style attr '$attr'
            }
        }
    }

    set opts [CircleOpts]

    set points {}
    for {set i 0} {$i < 30} {incr i} {
        set a [expr {3.1415926 * $i / 15}]
        lappend points [expr {$Attrs(cx) + $Attrs(r)*cos($a)}] \
                       [expr {$Attrs(cy) + $Attrs(r)*sin($a)}]
    }

    set points [TransformPoints $transform $points]

    Debug 2 polygon $points $opts
    eval [list $c create polygon $points] $opts
}

proc svg::ParseEllipse {c transform curAttrs item} {
    variable Unitcircle

    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    array set Attrs $curAttrs
    array set Attrs {cx 0 cy 0 rx 0 ry 0}
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]
    set drawitem circle

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        switch -- $attr {
            "" {}
            cx -
            cy -
            rx -
            ry -
            fill -
            stroke -
            stroke-width {
                set Attrs($attr) $val
            }
            default {
                Debug 1 Unknown style attr '$attr'
            }
        }
    }

    set opts [CircleOpts]

    set points {}
    for {set i 0} {$i < 30} {incr i} {
        set a [expr {3.1415926 * $i / 15}]
        lappend points [expr {$Attrs(cx) + $Attrs(rx)*cos($a)}] \
                       [expr {$Attrs(cy) + $Attrs(ry)*sin($a)}]
    }

    set points [TransformPoints $transform $points]

    Debug 2 polygon $points $opts
    eval [list $c create polygon $points] $opts
}

proc svg::ParseLine {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    set x1 [::xmpp::xml::getAttr $attrs x1]
    set y1 [::xmpp::xml::getAttr $attrs y1]
    set x2 [::xmpp::xml::getAttr $attrs x2]
    set y2 [::xmpp::xml::getAttr $attrs y2]

    foreach {x1 y1} [TransformCoord $transform $x1 $y1] break
    foreach {x2 y2} [TransformCoord $transform $x2 $y2] break

    array set Attrs $curAttrs
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]
    set drawitem line

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        switch -- $attr {
            "" {}
            stroke -
            stroke-width -
            stroke-linecap -
            stroke-linejoin {
                set Attrs($attr) $val
            }
            default {
                Debug 1 Unknown style attr '$attr'
            }
        }
    }

    set opts [LineOpts]

    Debug 2 line $x1 $y1 $x2 $y2 $opts
    eval [list $c create line $x1 $y1 $x2 $y2] $opts
}

proc svg::ParseRect {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    set x      [::xmpp::xml::getAttr $attrs x]
    set y      [::xmpp::xml::getAttr $attrs y]
    set width  [::xmpp::xml::getAttr $attrs width]
    set height [::xmpp::xml::getAttr $attrs height]
    set rx     [::xmpp::xml::getAttr $attrs rx]
    set ry     [::xmpp::xml::getAttr $attrs ry]
    if {$rx != ""} {
        Debug 1 Round corners are ignored
    }
    set x2 [expr {$x + $width}]
    set y2 [expr {$y + $height}]

    foreach {xx yy} [TransformCoord $transform $x $y] break
    foreach {xx1 yy1} [TransformCoord $transform $x2 $y] break
    foreach {xx2 yy2} [TransformCoord $transform $x2 $y2] break
    foreach {xx3 yy3} [TransformCoord $transform $x $y2] break

    array set Attrs $curAttrs
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]
    set drawitem line

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        switch -- $attr {
            "" {}
            stroke -
            stroke-width -
            stroke-linejoin {
                set Attrs($attr) $val
            }
            default {
                Debug 1 Unknown style attr '$attr'
            }
        }
    }

    set opts [PolygonOpts]

    Debug 2 polygon $xx $yy $xx1 $yy1 $xx2 $yy2 $xx3 $yy3] $opts
    eval [list $c create polygon $xx $yy $xx1 $yy1 $xx2 $yy2 $xx3 $yy3] $opts
}

proc svg::ParsePolyline {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    set p [TransformPoints $transform [::xmpp::xml::getAttr $attrs points]]

    array set Attrs $curAttrs
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]
    set drawitem line

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        switch -- $attr {
            "" {}
            fill -
            stroke -
            stroke-width -
            stroke-linecap -
            stroke-linejoin {
                set Attrs($attr) $val
            }
            default {
                Debug 1 Unknown style attr '$attr'
            }
        }
    }

    set opts [LineOpts]

    Debug 2 line $p $opts
    eval [list $c create line] $p $opts
}

proc svg::ParseImage {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    set x  [::xmpp::xml::getAttr $attrs x]
    set y  [::xmpp::xml::getAttr $attrs y]

    if {$x == ""} {set x 0}
    if {$y == ""} {set y 0}

    foreach {x y} [TransformCoord $transform $x $y] break

    array set Attrs $curAttrs
    array set Attrs $attrs

    # Works only with BOB data included in the same XMPP stanza
    set cid [::xmpp::xml::getAttr $attrs http://www.w3.org/1999/xlink:href]

    if {[string first cid: $cid] != 0} {
        return
    }

    lassign [::xmpp::bob::get [string range $cid 4 end]] type data

    if {![info exists data] || $data == ""} {
        return ""
    }

    if {[catch {image create photo -data $data} image]} {
        return ""
    }

    bind $c <Destroy> +[list image delete $image]

    set opts [ImageOpts]

    Debug 2 image $x $y -image $image $opts
    eval [list $c create image $x $y -image $image] $opts
}

proc svg::ParseText {c transform curAttrs item} {
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    eval lappend transform \
         [ParseTransform [::xmpp::xml::getAttr $attrs transform]]

    set x  [::xmpp::xml::getAttr $attrs x]
    set y  [::xmpp::xml::getAttr $attrs y]

    if {$x == ""} {set x 0}
    if {$y == ""} {set y 0}

    foreach {x y} [TransformCoord $transform $x $y] break

    array set Attrs $curAttrs
    array set Attrs $attrs
    set styles [split [::xmpp::xml::getAttr $attrs style] \;]

    foreach s $styles {
        foreach {attr val} [split $s :] break
        set attr [string trim $attr]
        set val [string trim $val]
        set Attrs($attr) $val
    }

    set allopts [TextOpts]

    set opts [lindex $allopts 0]
    set fontopts [lindex $allopts 1]
    if {$fontopts != ""} {
        variable app_font
        set fontname [list font $fontopts]
        if {![info exists app_font($fontname)]} {
            # create a font to match the settings
            set app_font($fontname) \
                [eval [list font create $fontname] $fontopts]
        }
        lappend opts -font $app_font($fontname)
    }

    Debug 2 text $x $y -text $cdata $opts
    eval [list $c create text $x $y -text $cdata] $opts
}

proc svg::LineOpts {} {
    upvar Attrs Attrs
    upvar c c
    set opts {-joinstyle miter -capstyle butt}
    foreach {attr val} [array get Attrs] {
        switch -- $attr {
            "" {}
            stroke {lappend opts -fill [color $c $val]}
            stroke-width {lappend opts -width $val}
            stroke-linecap {
                switch -- $val {
                    round {lappend opts -capstyle round}
                    square {lappend opts -capstyle projecting}
                }
            }
            stroke-linejoin {
                switch -- $val {
                    round {lappend opts -joinstyle round}
                    bevel {lappend opts -joinstyle bevel}
                }
            }
            id {lappend opts -tags [list [list id $val]]}
        }
    }
    return $opts
}

proc svg::PolygonOpts {} {
    upvar Attrs Attrs
    upvar c c
    set opts {-joinstyle miter -fill "" -outline ""}
    foreach {attr val} [array get Attrs] {
        switch -- $attr {
            "" {}
            fill {
                if {$val != "" && $val != "none"} {
                    lappend opts -fill [color $c $val]
                }
            }
            stroke {
                if {$val != "" && $val != "none"} {
                    lappend opts -outline [color $c $val]
                }
            }
            stroke-width {lappend opts -width $val}
            stroke-linejoin {
                switch -- $val {
                    round {lappend opts -joinstyle round}
                    bevel {lappend opts -joinstyle bevel}
                }
            }
            id {lappend opts -tags [list [list id $val]]}
        }
    }
    return $opts
}

proc svg::CircleOpts {} {
    upvar Attrs Attrs
    upvar c c
    set opts {-smooth bezier -joinstyle round -fill "" -outline ""}
    foreach {attr val} [array get Attrs] {
        switch -- $attr {
            "" {}
            fill {
                if {$val != "" && $val != "none"} {
                    lappend opts -fill [color $c $val]
                }
            }
            stroke {
                if {$val != "" && $val != "none"} {
                    lappend opts -outline [color $c $val]
                }
            }
            stroke-width {lappend opts -width $val}
            id {lappend opts -tags [list [list id $val]]}
        }
    }
    return $opts
}

proc svg::ImageOpts {} {
    upvar Attrs Attrs
    upvar c c
    set opts {-anchor nw}
    foreach {attr val} [array get Attrs] {
        switch -- $attr {
            id {lappend opts -tags [list [list id $val]]}
        }
    }
    return $opts
}

proc svg::TextOpts {} {
    upvar Attrs Attrs
    upvar c c
    set opts {-anchor w}
    set fontopts {}
    foreach {attr val} [array get Attrs] {
        switch -- $attr {
            "" {}
            fill {lappend opts -fill [color $c $val]}
            font-family      {lappend fontopts -family $val}
            font-size        {lappend fontopts -size $val}
            font-size-adjust { # How to do this in Tk? }
            font-stretch     { # How to do this in Tk? }
            font-style       {        if {[string equal $val italic]
                                     || [string equal $val oblique]} {
                                          lappend fontopts -slant italic
                                }
                             }
            font-variant     { # How to do this in Tk? }
            font-weight      {        if {[string match bold* $val]} {
                                          lappend fontopts -weight bold
                                }
                             }
            text-decoration  {        foreach subval $val {
                                    switch -- $subval {
                                        underline {
                                            lappend fontopts -underline on
                                        }
                                        line-through {
                                            lappend fontopts -overstrike on
                                        }
                                    }
                                 }
                             }
            dx   { # How to do this in Tk? }
            dy   { # How to do this in Tk? }
            id {lappend opts -tags [list [list id $val]]}
        }
    }
    return [list $opts $fontopts]
}


proc svg::TransformPoints {transform raw_points} {
    # SVG spec says coordinate points can be separated by comma or
    # white space or comma-with-white-space
    # string map...    convert , to space
    # regsub...        condense multiple whitespaces to single space
    regsub -all {\s\s*} [string map {, { }} [string trim $raw_points]] \
                { } points_str

    set p {}
    foreach {x y} [split $points_str] {
        eval lappend p [TransformCoord $transform $x $y]
    }
    return $p
}

proc svg::ParseTransform {s} {
    Debug 2 $s

    set t {}
    while {[regexp {(\w+)\s*\(([^\)]*)\)(.*)} $s temp transform param s]} {
        lappend t [list $transform [split $param ", "]]
    }

    Debug 1 $s $t
    return $t
}

proc svg::TransformCoord {transform x y} {
    Debug 2 $transform $x $y

    set matrix [list 1 0 0 1 0 0]

    foreach t $transform {
        foreach {op param} $t break
        switch -- $op/[llength $param] {
            matrix/6 {
                set matrix [Tcompose $matrix $param]
            }
            translate/1 {
                foreach tx $param break
                set matrix [Tcompose $matrix [list 1 0 0 1 $tx 0]]
            }
            translate/2 {
                foreach {tx ty} $param break
                set matrix [Tcompose $matrix [list 1 0 0 1 $tx $ty]]
            }
            scale/1 {
                foreach sx $param break
                set matrix [Tcompose $matrix [list $sx 0 0 $sx 0 0]]
            }
            scale/2 {
                foreach {sx sy} $param break
                set matrix [Tcompose $matrix [list $sx 0 0 $sy 0 0]]
            }
            rotate/1 {
                foreach a $param break
                set a [expr {3.1415926 * $a / 180}]
                set matrix [Tcompose $matrix \
                                [list [expr {cos($a)}]  [expr {sin($a)}] \
                                      [expr {-sin($a)}] [expr {cos($a)}] 0 0]]
            }
            rotate/3 {
                foreach {a cx cy} $param break
                set a [expr {3.1415926 * $a / 180}]
                set matrix [Tcompose $matrix [list 1 0 0 1 $cx $cy]]
                set matrix [Tcompose $matrix \
                                [list [expr {cos($a)}]  [expr {sin($a)}] \
                                      [expr {-sin($a)}] [expr {cos($a)}] 0 0]]
                set matrix [Tcompose $matrix \
                                [list 1 0 0 1 [expr {-$cx}] [expr {-$cy}]]]
            }
            skewX/1 {
                foreach a $param break
                set a [expr {3.1415926 * $a / 180}]
                set matrix [Tcompose $matrix [list 1 0 [expr {tan($a)}] 1 0 0]]
            }
            skewY/1 {
                foreach a $param break
                set a [expr {3.1415926 * $a / 180}]
                set matrix [Tcompose $matrix [list 1 [expr {tan($a)}] 0 1 0 0]]
            }
        }
    }

    return [Tapply $matrix $x $y]
}

proc svg::Tcompose {matrix1 matrix2} {
    Debug 2 [list $matrix1] [list $matrix2]

    return [list $x1 $y1]
}

proc svg::color {c color} {
    Debug 2 $color

    if {[catch {$c create line 0 0 0 0 -fill $color -width 0} id]} {
        return black
    } else {
        $c delete $id
        return $color
    }
}

proc svg::Debug {level args} {
    variable Debug

    if {$Debug >= $level} {
        puts "[lindex [info level -1] 0]: [join $args]"
    }
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et

# whiteboard.tcl --
#
#       This file is a part of the Whiteboard plugin for Tkabber
#       XMPP client. It provides a user interface and communication
#       means.

package require msgcat

namespace eval wb {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered whiteboard]} {
        ::plugins::register whiteboard \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Whiteboard\
                                                        plugin is loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

    set id_base [pid]   ;# used in proc create_id
}

proc wb::load {} {
    hook::add chat_create_user_menu_hook \
              [namespace current]::add_whiteboard_menu_item 47
    hook::add chat_create_conference_menu_hook \
              [namespace current]::add_whiteboard_menu_item 47
    hook::add roster_jid_popup_menu_hook \
              [namespace current]::add_whiteboard_menu_item 47

    hook::add draw_message_hook [namespace current]::handle_wb 1

    variable chats {}
}

proc wb::unload {} {
    hook::remove chat_create_user_menu_hook \
                 [namespace current]::add_whiteboard_menu_item 47
    hook::remove chat_create_conference_menu_hook \
                 [namespace current]::add_whiteboard_menu_item 47
    hook::remove roster_jid_popup_menu_hook \
                 [namespace current]::add_whiteboard_menu_item 47

    hook::remove draw_message_hook [namespace current]::handle_wb 1

    variable chats
    foreach chatid $chats {
        destroy_win [win_id whiteboard $chatid]
    }

    namespace delete ::svg

    foreach var [info vars [namespace current]::*] {
        catch {unset $var}
    }
}

package require base64
catch {package require Img}

uplevel #0 [list source [file join [file dirname [info script]] svgrender.tcl]]

proc wb::add_whiteboard_menu_item {m xlib jid} {
    $m add command -label [::msgcat::mc "Whiteboard"] \
        -command [list [namespace current]::open_wb $xlib $jid -raise 1]
}

proc wb::open_wb {xlib jid args} {
    set raise 0
    foreach {key val} $args {
        switch -- $key {
            -raise { set raise $val }
        }
    }

    set chatid [chat::chatid $xlib $jid]

    set w [win_id whiteboard $chatid]
    if {[winfo exists $w]} {
        if {$raise} {
            raise_win $w
        }
        return
    }

    set jid [chat::get_jid $chatid]

    set title [::msgcat::mc "%s whiteboard" $jid]
    add_win $w -title $title \
               -tabtitle $title \
               -class Whiteboard \
               -raise $raise


    set sw [ScrolledWindow $w.sw]
    pack $sw -side right -fill both -expand yes
    set c [canvas $w.c -background white]
    $sw setwidget $c

    bind $c <Destroy> [namespace code [list clean_wb $chatid]]

    bindscroll $c

    set tb [frame $w.tb]
    pack $tb -side left -fill y

    set tbfreehand \
        [radiobutton $w.tb.freehand -text [::msgcat::mc "FreeHand"] \
                        -variable [namespace current]::tool($chatid) \
                        -value freehand \
                        -anchor w \
                        -command [list [namespace current]::freehand_bind \
                                      $c $chatid]]

    set tbpolyline [radiobutton $w.tb.line -text [::msgcat::mc "PolyLine"] \
                        -variable [namespace current]::tool($chatid) \
                        -value polyline \
                        -anchor w \
                        -command [list [namespace current]::line_bind \
                                       $c $chatid]]
    
    set tbrectangle \
        [radiobutton $w.tb.rectangle -text [::msgcat::mc "Rectangle"] \
                        -variable [namespace current]::tool($chatid) \
                        -value rectangle \
                        -anchor w \
                        -command [list [namespace current]::rectangle_bind \
                                      $c $chatid]]

    set tbpolygon [radiobutton $w.tb.polygon -text [::msgcat::mc "Polygon"] \
                        -variable [namespace current]::tool($chatid) \
                        -value polygon \
                        -anchor w \
                        -command [list [namespace current]::polygon_bind \
                                      $c $chatid]]

    set tbcircle [radiobutton $w.tb.circle -text [::msgcat::mc "Circle"] \
                        -variable [namespace current]::tool($chatid) \
                        -value circle \
                        -anchor w \
                        -command [list [namespace current]::circle_bind \
                                      $c $chatid]]

    set tbimage [radiobutton $w.tb.image -text [::msgcat::mc "Image"] \
                        -variable [namespace current]::tool($chatid) \
                        -value image \
                        -anchor w \
                        -command [list [namespace current]::image_bind \
                                      $c $chatid]]

    set tbtext [radiobutton $w.tb.text -text [::msgcat::mc "Text"] \
                        -variable [namespace current]::tool($chatid) \
                        -value text \
                        -anchor w \
                        -command [list [namespace current]::text_bind \
                                       $c $chatid]]

    set tbmove [radiobutton $w.tb.move -text [::msgcat::mc "Move/Transform"] \
                        -variable [namespace current]::tool($chatid) \
                        -value move \
                        -anchor w \
                        -command [list [namespace current]::move_bind \
                                       $c $chatid]]

    pack $tbfreehand $tbpolyline $tbrectangle $tbpolygon $tbcircle $tbimage \
         $tbtext $tbmove -anchor w -fill x

    button $w.tb.clear -text [::msgcat::mc "Clear"] \
        -command [list [namespace current]::send_clear $chatid]
    pack $w.tb.clear -side bottom -anchor w -fill x

    button $w.tb.save -text [::msgcat::mc "Save..."] \
        -command [list [namespace current]::save_wb $chatid]
    pack $w.tb.save -side bottom -anchor w -fill x

    #frame $w.tb.spacer1 -relief sunken -bd 1 -height 2 -highlightthickness 0
    #pack $w.tb.spacer1 -side bottom -anchor w -fill x -pady 1m

    variable text_set_fr
    set text_set_fr($chatid) $w.tb
    label $w.tb.example_char -text A
    pack $w.tb.example_char -side bottom -fill x

    button $w.tb.seltextcol -text [::msgcat::mc "Text color"] \
        -command [list [namespace current]::select_text_color \
                      $w.tb.seltextcol $w.tb.example_char]
    pack $w.tb.seltextcol -side bottom -anchor w -fill x

    button $w.tb.selfont -text [::msgcat::mc "Text font"] \
        -command [list [namespace current]::select_font \
                      $w.tb.selfont $w.tb.example_char]
    pack $w.tb.selfont -side bottom -anchor w -fill x

    #frame $w.tb.spacer2 -relief sunken -bd 1 -height 2 -highlightthickness 0
    #pack $w.tb.spacer2 -side bottom -anchor w -fill x -pady 1m

    frame $w.tb.fill

    checkbutton $w.tb.dofill -text [::msgcat::mc "Fill"] \
            -variable [namespace current]::dofill
    pack $w.tb.dofill -side left -in $w.tb.fill

    canvas $w.tb.fillcolor -background \#FFFFFF -height 5m -width 5m
    pack $w.tb.fillcolor -side left -padx 3m -in $w.tb.fill

    pack $w.tb.fill -side bottom -anchor w -fill x

    button $w.tb.selfillcol -text [::msgcat::mc "Fill color"] \
        -command [list [namespace current]::select_color \
                      $w.tb.selfillcol $w.tb.fillcolor]
    pack $w.tb.selfillcol -side bottom -anchor w -fill x

    #frame $w.tb.spacer3 -relief sunken -bd 1 -height 2 -highlightthickness 0
    #pack $w.tb.spacer3 -side bottom -anchor w -fill x -pady 1m

    canvas $w.tb.color -background \#000000 -height 0.5c -width 1
    pack $w.tb.color -side bottom

    frame $w.tb.linewidth

    label $w.tb.lwidth -text [::msgcat::mc "Line width: "]
    pack $w.tb.lwidth -side left -in $w.tb.linewidth

    SpinBox $w.tb.width -width 4 -range {1 100} \
        -textvariable [namespace current]::width($chatid)
    pack $w.tb.width -side left -in $w.tb.linewidth

    pack $w.tb.linewidth -side bottom -anchor w -fill x

    button $w.tb.selcol -text [::msgcat::mc "Line color"] \
        -command [list [namespace current]::select_color \
                      $w.tb.selcol $w.tb.color]
    pack $w.tb.selcol -side bottom -anchor w -fill x

    variable balloon
    set balloon($chatid) 1
    checkbutton $w.tb.balloon -text [::msgcat::mc "Show balloons"] \
                              -variable [namespace current]::balloon($chatid)
    pack $w.tb.balloon -side bottom -anchor w -fill x


    $c bind all <Any-Enter>  \
        [list [namespace current]::balloon $chatid $c enter  %X %Y]
    $c bind all <Any-Motion> \
        [list [namespace current]::balloon $chatid $c motion %X %Y]
    $c bind all <Any-Leave>  \
        [list [namespace current]::balloon $chatid $c leave  %X %Y]

    trace variable [namespace current]::width($chatid) w \
        [list [namespace current]::change_width \
             $w.tb.color [namespace current]::width($chatid)]

    variable chats
    lappend chats $chatid

    variable tool
    set tool($chatid) move
    move_bind $c $chatid
}

proc wb::clean_wb {chatid} {
    variable width
    variable tool
    variable balloon
    variable text_set_fr
    variable chats
    variable text_entered

    if {[set idx [lsearch -exact $chats $chatid]] >= 0} {
        set chats [lreplace $chats $idx $idx]
    }

    catch {unset width($chatid)}
    catch {unset tool($chatid)}
    catch {unset balloon($chatid)}
    catch {unset text_set_fr($chatid)}
    catch {unset text_entered($chatid)}
}

proc wb::balloon {chatid c action X Y} {
    variable balloon

    if {!$balloon($chatid)} return

    set id [$c find withtag current]
    set tags {}
    foreach t [$c gettags $id] {
        if {[lindex $t 0] == "time"} {
            lappend tags $t
        }
    }

    set msgs {}
    foreach t [lsort -index 1 -integer $tags] {
        lappend msgs [lindex $t 2]
    }

    balloon::default_balloon $c:$id $action $X $Y -text [join $msgs "\n"]
}

proc wb::select_color {but col} {
    set color [SelectColor::menu $col.color [list below $but] \
                   -color [$col cget -background]]

    if {[string length $color]} {
        $col configure -background $color
    }
}

proc wb::select_font {chatid col} {
    variable app_font
    set font_desc [SelectFont .s -type dialog]

    if {[string length $font_desc] == 0} return

    if {![info exists app_font($font_desc)]} {
        set app_font($font_desc) \
            [eval font create [list $font_desc] [font actual $font_desc]]
    }
    $col configure -font $app_font($font_desc)
}

proc wb::select_text_color {but col} {
    set color [SelectColor::menu $col.color [list below $but] \
                   -color [$col cget -foreground]]

    if {[string length $color]} {
        $col configure -foreground $color
    }
}

proc wb::get_text_color {chatid} {

    $w.tb.color cget -width
}

proc wb::save_wb {chatid} {
    set w [win_id whiteboard $chatid]

    set filepath [tk_getSaveFile -defaultextension .eps \
                                 -filetypes \
                                    {{{Encapsulated PostScript files} *.eps}
                                     {{All files}        *}}]

    if {$filepath == ""} return
    $w.c postscript -file $filepath
}

###############################################################################

proc wb::create_id {} {
    # Unseeded random number is not good enough, because remote clients
    # are likely to produce the same numbers.
    return [rand 10000][clock seconds][set [namespace current]::id_base]
}

proc wb::send_svg {chatid tag {tag2 ""}} {
    if {[chat::is_groupchat $chatid]} {
        set type groupchat
    } else {
        set type chat
    }
    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]

    set xlist [list [::xmpp::xml::create x \
                          -xmlns tkabber:whiteboard \
                          -subelement [::xmpp::xml::create svg \
                                            -xmlns http://www.w3.org/2000/svg \
                                            -subelement $tag]]]
    if {$tag2 != ""} {
        lappend xlist $tag2
    }

    ::xmpp::sendMessage $xlib $jid -type $type -xlist $xlist
}

proc wb::send_clear {chatid} {
    if {[chat::is_groupchat $chatid]} {
        set type groupchat
    } else {
        set type chat
        [win_id whiteboard $chatid].c delete all
    }
    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]
    ::xmpp::sendMessage $xlib $jid -type $type \
        -xlist [list [::xmpp::xml::create x \
                          -xmlns tkabber:whiteboard \
                          -subelement [::xmpp::xml::create clear]]]
}

proc wb::handle_wb {chatid from type body x} {
    set seconds [::xmpp::xml::getAttr [::xmpp::delay::parse $x] seconds]

    foreach xelem $x {
        ::xmpp::xml::split $xelem tag xmlns attrs cdata subels

        if {[string equal $xmlns tkabber:whiteboard]} {
            open_wb [chat::get_xlib $chatid] [chat::get_jid $chatid]
            set w [win_id whiteboard $chatid]
            foreach subel $subels {
                parse_item $chatid $from $seconds $subel
            }
            tab_set_updated $w 1 message

            $w.c configure -scrollregion [$w.c bbox all]
        }
    }
}

proc wb::parse_item {chatid from seconds item} {
    set w [win_id whiteboard $chatid]
    ::xmpp::xml::split $item tag xmlns attrs cdata subels

    switch -- $tag {
        svg {
            foreach subel $subels {
                set id [svg::parseSVGItem $w.c {} {} $subel]
                if {$id != ""} {
                    $w.c addtag [list tag $subel] withtag $id
                    $w.c addtag [time_tag created $from $seconds] withtag $id
                }
            }
        }
        transform {
            set id [::xmpp::xml::getAttr $attrs id]
            set transform [::xmpp::xml::getAttr $attrs transform]
            set transform1 $transform
            set tags [$w.c gettags [list id $id]]
            set child {}
            foreach t $tags {
                if {[lindex $t 0] == "tag"} {
                    set child [lindex $t 1]
                    break
                }
            }
            foreach t $tags {
                if {[lindex $t 0] == "transform"} {
                    set transform "$transform [lindex $t 1]"
                    break
                }
            }
            if {$child != {}} {
                $w.c delete [list id $id]
                set id1 [svg::parseSVGItem $w.c \
                                    [svg::ParseTransform $transform] {} $child]
                if {$id1 != ""} {
                    foreach t $tags {
                        $w.c addtag $t withtag $id1
                    }
                    add_transform_tag $w.c $id $transform1
                    $w.c addtag [time_tag transformed $from $seconds] \
                                withtag $id1
                }
            }
        }
        move {
            set id [::xmpp::xml::getAttr $attrs id]
            set dx [::xmpp::xml::getAttr $attrs dx]
            set dy [::xmpp::xml::getAttr $attrs dy]
            if {![string is double $dx] || $dx == ""} {set dx 0}
            if {![string is double $dy] || $dy == ""} {set dy 0}
            add_transform_tag $w.c $id translate($dx,$dy)
            $w.c addtag [time_tag moved $from $seconds] withtag [list id $id]
            $w.c move [list id $id] $dx $dy
        }
        remove {
            $w.c delete [list id [::xmpp::xml::getAttr $attrs id]]
        }
        clear {
            $w.c delete all
        }
    }
}

###############################################################################

proc wb::add_transform_tag {c id transform} {
    set tags [$c gettags [list id $id]]
    foreach t $tags {
        if {[lindex $t 0] == "transform"} {
            set transform "$transform [lindex $t 1]"
            $c dtag [list id $id] $t
            break
        }
    }
    $c addtag [list transform $transform] withtag [list id $id]
}

proc wb::time_tag {type jid {seconds ""}} {
    set seconds_now [clock seconds]
    set format $::plugins::options(timestamp_format)

    set seconds_day_before \
        [clock scan "-23 hours 59 minutes" -base $seconds_now]
    if {$seconds == ""} {
        set seconds $seconds_now
    }
    if {$seconds <= $seconds_day_before} {
        set format $::plugins::options(delayed_timestamp_format)
    }
    set time [clock format $seconds -format $format]
    switch -- $type {
        created {
            return [list time $seconds \
                         [::msgcat::mc "%s created: %s" $time $jid]]
        }
        moved {
            return [list time $seconds \
                         [::msgcat::mc "%s moved: %s" $time $jid]]
        }
        transformed {
            return [list time $seconds \
                         [::msgcat::mc "%s transformed: %s" $time $jid]]
        }
        default {
            return ""
        }
    }
}

###############################################################################

proc wb::popup_menu {c chatid x y} {
    set m .whiteboard_popup_menu

    if {[winfo exists $m]} {
        destroy $m
    }

    set tags [$c gettags current]
    set id ""
    set tag ""
    foreach t $tags {
        switch -- [lindex $t 0] {
            id {
                set id [lindex $t 1]
            }
            tag {
                ::xmpp::xml::split [lindex $t 1] tag xmlns attrs cdata subels
            }
        }
    }

    menu $m -tearoff 0

    if {![string equal $id ""]} {
        set state normal
        switch -- $tag {
            image - text - "" {
                set state1 disabled
            }
            default {
                set state1 normal
            }
        }
    } else {
        set state disabled
        set state1 disabled
    }

    $m add command -label [::msgcat::mc "Flip horizontally"] \
                   -command [list [namespace current]::flip_h $c $chatid $id] \
                   -state $state1
    $m add command -label [::msgcat::mc "Flip vertically"] \
                   -command [list [namespace current]::flip_v $c $chatid $id] \
                   -state $state1
    $m add command -label [::msgcat::mc "Rotate 45\u00b0"] \
                   -command [list [namespace current]::rotate $c \
                                  $chatid $id -45] \
                   -state $state1
    $m add command -label [::msgcat::mc "Rotate 90\u00b0"] \
                   -command [list [namespace current]::rotate $c \
                                  $chatid $id -90] \
                   -state $state1
    $m add command -label [::msgcat::mc "Rotate 135\u00b0"] \
                   -command [list [namespace current]::rotate $c \
                                  $chatid $id -135] \
                   -state $state1
    $m add command -label [::msgcat::mc "Rotate 180\u00b0"] \
                   -command [list [namespace current]::rotate $c \
                                  $chatid $id -180] \
                   -state $state1
    $m add command -label [::msgcat::mc "Skew horizontally 10\u00b0"] \
                   -command [list [namespace current]::skew $c \
                                  $chatid $id X -10] \
                   -state $state1
    $m add command -label [::msgcat::mc "Skew horizontally -10\u00b0"] \
                   -command [list [namespace current]::skew $c \
                                  $chatid $id X 10] \
                   -state $state1
    $m add command -label [::msgcat::mc "Skew vertically 10\u00b0"] \
                   -command [list [namespace current]::skew $c \
                                  $chatid $id Y 10] \
                   -state $state1
    $m add command -label [::msgcat::mc "Skew vertically -10\u00b0"] \
                   -command [list [namespace current]::skew $c \
                                  $chatid $id Y -10] \
                   -state $state1

    $m add separator

    $m add command -label [::msgcat::mc "Remove"] \
                   -command [list [namespace current]::remove_b1p $c \
                                  $chatid $id] \
                   -state $state

    tk_popup $m $x $y
}

###############################################################################

proc wb::flip_h {c chatid id} {

    transform $c $chatid $id "rotate($angle,$x0,$y0)"
}

proc wb::skew {c chatid id xy angle} {
    lassign [$c bbox [list id $id]] x1 y1 x2 y2
    set x0 [expr {($x1+$x2)/2}]
    set y0 [expr {($y1+$y2)/2}]
    transform $c $chatid $id "translate($x0,$y0) skew${xy}($angle)\
                              translate([expr {-$x0}],[expr {-$y0}])"
}

proc wb::transform {c chatid id transform} {
    set elem [::xmpp::xml::create transform \
                    -attrs [list id $id transform $transform]]

    if {[chat::is_groupchat $chatid]} {
        set type groupchat
    } else {
        set type chat
        set jid [connection_jid [chat::get_xlib $chatid]]
        parse_item $chatid $jid [clock seconds] $elem
    }

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]
    ::xmpp::sendMessage $xlib $jid \
        -type $type \
        -xlist [list [::xmpp::xml::create x \
                          -xmlns tkabber:whiteboard \
                          -subelement $elem]]
}

###############################################################################

###############################################################################
# Line

proc wb::line_bind {c chatid} {
    bind $c <ButtonPress-1> \
        [list [namespace current]::line_b1 [double% $c] \
                                           [double% $chatid] %x %y]
    bind $c <B1-Motion> {}
    bind $c <Motion> [list [namespace current]::line_b1m [double% $c] %x %y]
    bind $c <ButtonRelease-1> {}
    bind $c <<ContextMenu>> [list [namespace current]::line_b3 \
                            [double% $c] [double% $chatid]]
    $c configure -cursor crosshair
}

proc wb::line_b1 {c chatid x y} {
    variable line

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    if {[info exists line(drawed)]} {
        lappend line(coords) $x $y
        catch {$c delete $line(temp)}
        set tag [line_tag ""]
        set line(temp) [svg::parseSVGItem $c {} {} $tag]
    } else {
        set line(drawed) 1
        set line(coords) [list $x $y]
        set line(options) \
            [list stroke-linejoin miter stroke [get_color $chatid]]
        if {[set width [get_width $chatid]] != 1} {
            lappend line(options) stroke-width $width
        }

    }
}

proc wb::line_b1m {c x y} {
    variable line

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    if {[info exists line(drawed)]} {
        set coords $line(coords)
        lappend line(coords) $x $y
        catch {$c delete $line(temp)}
        set tag [line_tag ""]
        set line(temp) [svg::parseSVGItem $c {} {} $tag]
        set line(coords) $coords
    }
}

proc wb::line_b3 {c chatid} {
    variable line

    catch {
        unset line(drawed)

        set id [create_id]
        catch {$c delete $line(temp)}
        set tag [line_tag $id]
        set line(temp) [svg::parseSVGItem $c {} {} $tag]

        if {[chat::is_groupchat $chatid]} {
            $c delete $line(temp)
        } else {
            set jid [connection_jid [chat::get_xlib $chatid]]
            $c addtag [list tag $tag] withtag $line(temp)
            $c addtag [time_tag created $jid] withtag $line(temp)
        }

        send_svg $chatid $tag

        set line(coords) {}
        set line(temp) {}
    }
}

proc wb::line_tag {id} {
    variable line

    set attrs $line(options)
    lappend attrs points $line(coords)
    if {$id != ""} {
        lappend attrs id $id
    }
    return [::xmpp::xml::create polyline -attrs $attrs]
}

###############################################################################

###############################################################################
# Polygon

proc wb::polygon_bind {c chatid} {
    bind $c <ButtonPress-1> \
        [list [namespace current]::polygon_b1 [double% $c] \
                                              [double% $chatid] %x %y]
    bind $c <B1-Motion> {}
    bind $c <Motion> [list [namespace current]::polygon_m [double% $c] %x %y]
    bind $c <ButtonRelease-1> {}
    bind $c <<ContextMenu>> [list [namespace current]::polygon_b3 \
                            [double% $c] [double% $chatid]]
    $c configure -cursor crosshair
}

proc wb::polygon_b1 {c chatid x y} {
    variable polygon
    variable line1
    variable line2
    variable dofill

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    if {[info exists polygon(drawed)]} {
        lappend polygon(coords) $x $y

        catch {$c delete $line1(temp)}
        catch {$c delete $line2(temp)}
        catch {$c delete $polygon(temp)}
        set tag [polygon_tag ""]
        set polygon(temp) [svg::parseSVGItem $c {} {} $tag]
    } else {
        set polygon(drawed) 1
        set polygon(coords) [list $x $y]
        set polygon(line_options) [list -fill [get_color $chatid] \
                               -width [get_width $chatid] \
                               -joinstyle miter]
        set polygon(options) \
            [list stroke-linejoin miter stroke [get_color $chatid]]
        if {[set width [get_width $chatid]] != 1} {
            lappend polygon(options) stroke-width $width
        }
        if {$dofill == 1} {
            lappend polygon(options) fill [get_fill_color $chatid]
        }
    }
}

proc wb::polygon_m {c x y} {
    variable polygon
    variable line1
    variable line2

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    if {[info exists polygon(drawed)]} {
        set x1 [lindex $polygon(coords) 0]
        set y1 [lindex $polygon(coords) 1]
        set xn [lindex $polygon(coords) end-1]
        set yn [lindex $polygon(coords) end]

        catch {$c delete $line1(temp)}
        catch {$c delete $line2(temp)}
        set line1(temp) \
            [eval $c create line $x1 $y1 $x $y $polygon(line_options)]
        set line2(temp) \
            [eval $c create line $xn $yn $x $y $polygon(line_options)]
    }
}

proc wb::polygon_b3 {c chatid} {
    variable polygon
    variable line1
    variable line2
    variable dofill

    catch {
        unset polygon(drawed)

        set id [create_id]
        catch {$c delete $line1(temp)}
        catch {$c delete $line2(temp)}
        catch {$c delete $polygon(temp)}

        set tag [polygon_tag $id]

        if {[llength $polygon(coords)] > 4} {
            set polygon(temp) [svg::parseSVGItem $c {} {} $tag]

            if {[chat::is_groupchat $chatid]} {
                $c delete $polygon(temp)
            } else {
                set jid [connection_jid [chat::get_xlib $chatid]]
                $c addtag [list tag $tag] withtag $polygon(temp)
                $c addtag [time_tag created $jid] withtag $polygon(temp)
            }

            send_svg $chatid $tag
        }
        set polygon(coords) {}
        set polygon(temp) {}
    }
}

proc wb::polygon_tag {id} {
    variable polygon

    set attrs $polygon(options)
    lappend attrs points $polygon(coords)
    if {$id != ""} {
        lappend attrs id $id
    }
    return [::xmpp::xml::create polygon -attrs $attrs]
}

###############################################################################

###############################################################################
# Rectangle

proc wb::rectangle_bind {c chatid} {
    bind $c <ButtonPress-1> \
        [list [namespace current]::rectangle_b1 [double% $c] \
                                                [double% $chatid] %x %y]
    bind $c <B1-Motion> \
        [list [namespace current]::rectangle_b1m [double% $c] %x %y]
    bind $c <Motion> {}
    bind $c <ButtonRelease-1> \
        [list [namespace current]::rectangle_b1r [double% $c] \
                                                 [double% $chatid] %x %y]
    bind $c <<ContextMenu>> {}
    $c configure -cursor crosshair
}

proc wb::rectangle_b1 {c chatid x y} {
    variable rectangle
    variable dofill

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    set rectangle(drawed) 1
    set rectangle(x1) $x
    set rectangle(y1) $y
    set rectangle(options) [list stroke [get_color $chatid]]
    if {$dofill == 1} {
        lappend rectangle(options) fill [get_fill_color $chatid]
    }
    if {[set width [get_width $chatid]] != 1} {
        lappend rectangle(options) stroke-width $width
    }
}

proc wb::rectangle_b1r {c chatid x y} {
    variable rectangle

    if {[info exists rectangle(drawed)]} {
        unset rectangle(drawed)
        set rectangle(x2) [$c canvasx $x]
        set rectangle(y2) [$c canvasy $y]

        set id [create_id]
        set tag [rectangle_tag $id]

        catch {$c delete $rectangle(temp)}
        set rectangle(temp) [svg::parseSVGItem $c {} {} $tag]

        if {[chat::is_groupchat $chatid]} {
            $c delete $rectangle(temp)
        } else {
            set jid [connection_jid [chat::get_xlib $chatid]]
            $c addtag [list tag $tag] withtag $rectangle(temp)
            $c addtag [time_tag created $jid] withtag $rectangle(temp)
        }

        send_svg $chatid $tag

        unset rectangle(x1)
        unset rectangle(x2)
        unset rectangle(y1)
        unset rectangle(y2)
        set rectangle(temp) {}
    }
}

proc wb::rectangle_b1m {c x y} {
    variable rectangle

    if {[info exists rectangle(drawed)]} {
        set rectangle(x2) [$c canvasx $x]
        set rectangle(y2) [$c canvasy $y]

        set tag [rectangle_tag ""]

        catch {$c delete $rectangle(temp)}
        set rectangle(temp) [svg::parseSVGItem $c {} {} $tag]
    }
}

proc wb::rectangle_tag {id} {
    variable rectangle

    set attrs $rectangle(options)
    if {$rectangle(x2) > $rectangle(x1)} {
        lappend attrs x $rectangle(x1) \
                     width [expr {$rectangle(x2) - $rectangle(x1)}]
    } else {
        lappend attrs x $rectangle(x2) \
                     width [expr {$rectangle(x1) - $rectangle(x2)}]
    }
    if {$rectangle(y2) > $rectangle(y1)} {
        lappend attrs y $rectangle(y1) \
                     height [expr {$rectangle(y2) - $rectangle(y1)}]
    } else {
        lappend attrs y $rectangle(y2) \
                     height [expr {$rectangle(y1) - $rectangle(y2)}]
    }
    if {$id != ""} {
        lappend attrs id $id
    }
    return [::xmpp::xml::create rect -attrs $attrs]
}

###############################################################################

###############################################################################
# Circle

proc wb::circle_bind {c chatid} {
    bind $c <ButtonPress-1> \
        [list [namespace current]::circle_b1 [double% $c] \
                                             [double% $chatid] %x %y]
    bind $c <B1-Motion> \
        [list [namespace current]::circle_b1m [double% $c] %x %y]
    bind $c <Motion> {}
    bind $c <ButtonRelease-1> \
        [list [namespace current]::circle_b1r [double% $c] \
                                              [double% $chatid] %x %y]
    bind $c <<ContextMenu>> {}
    $c configure -cursor crosshair
}

proc wb::circle_b1 {c chatid x y} {
    variable circle
    variable dofill

    set cx [$c canvasx $x]
    set cy [$c canvasy $y]

    set circle(drawed) 1
    set circle(cx) $cx
    set circle(cy) $cy
    set circle(options) [list cx $cx cy $cy stroke [get_color $chatid]]
    if {$dofill == 1} {
        lappend circle(options) fill [get_fill_color $chatid]
    }
    if {[set width [get_width $chatid]] != 1} {
        lappend circle(options) stroke-width $width
    }
}

proc wb::circle_b1r {c chatid x y} {
    variable circle

    if {[info exists circle(drawed)]} {
        unset circle(drawed)
        set cx $circle(cx)
        set cy $circle(cy)
        set x [$c canvasx $x]
        set y [$c canvasy $y]
        set r [expr {hypot($cx - $x, $cy - $y)}]

        set id [create_id]
        set tag [circle_tag $id $r]

        catch {$c delete $circle(temp)}
        set circle(temp) [svg::parseSVGItem $c {} {} $tag]

        if {[chat::is_groupchat $chatid]} {
            $c delete $circle(temp)
        } else {
            set jid [connection_jid [chat::get_xlib $chatid]]
            $c addtag [list tag $tag] withtag $circle(temp)
            $c addtag [time_tag created $jid] withtag $circle(temp)
        }

        send_svg $chatid $tag

        unset circle(cx)
        unset circle(cy)
        set circle(temp) {}
    }
}

proc wb::circle_b1m {c x y} {
    variable circle

    if {[info exists circle(drawed)]} {
        set cx $circle(cx)
        set cy $circle(cy)
        set x [$c canvasx $x]
        set y [$c canvasy $y]
        set r [expr hypot($cx - $x, $cy - $y)]

        set tag [circle_tag "" $r]

        catch {$c delete $circle(temp)}
        set circle(temp) [svg::parseSVGItem $c {} {} $tag]
    }
}

proc wb::circle_tag {id r} {
    variable circle

    set attrs $circle(options)
    lappend attrs r $r
    if {$id != ""} {
        lappend attrs id $id
    }
    return [::xmpp::xml::create circle -attrs $attrs]
}

###############################################################################

###############################################################################
# Freehand

proc wb::freehand_bind {c chatid} {
    bind $c <ButtonPress-1> \
        [list [namespace current]::freehand_b1p \
             [double% $c] [double% $chatid] %x %y]
    bind $c <B1-Motion> [list [namespace current]::freehand_b1m \
                             [double% $c] %x %y]
    bind $c <ButtonRelease-1> \
        [list [namespace current]::freehand_b1r [double% $c] [double% $chatid]]
    bind $c <<ContextMenu>> {}
    $c configure -cursor crosshair
}

proc wb::freehand_b1p {c chatid x y} {
    variable line

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    set line(drawed) 1
    set line(coords) [list $x $y]
    set line(options) [list stroke-linejoin round stroke [get_color $chatid]]
    if {[set width [get_width $chatid]] != 1} {
        lappend line(options) stroke-width $width
    }
}

proc wb::freehand_b1m {c x y} {
    variable line

    set x [$c canvasx $x]
    set y [$c canvasy $y]

    if {[info exists line(drawed)]} {
        lappend line(coords) $x $y

        catch {$c delete $line(temp)}
        set tag [freehand_tag ""]
        set line(temp) [svg::parseSVGItem $c {} {} $tag]
    }
}


proc wb::freehand_b1r {c chatid} {
    variable line

    catch {
        unset line(drawed)

        set id [create_id]

        set tag [freehand_tag $id]

        catch {$c delete $line(temp)}
        set line(temp) [svg::parseSVGItem $c {} {} $tag]

        if {[chat::is_groupchat $chatid]} {
            $c delete $line(temp)
        } else {
            set jid [connection_jid [chat::get_xlib $chatid]]
            $c addtag [list tag $tag] withtag $line(temp)
            $c addtag [time_tag created $jid] withtag $line(temp)
        }

        send_svg $chatid $tag

        set line(coords) {}
        set line(temp) {}
    }
}

proc wb::freehand_tag {id} {
    variable line

    set attrs $line(options)
    lappend attrs points $line(coords)
    if {$id != ""} {
        lappend attrs id $id
    }
    return [::xmpp::xml::create polyline -attrs $attrs]
}

###############################################################################

###############################################################################
# Remove

proc wb::remove_b1p {c chatid id} {
    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]
    if {[chat::is_groupchat $chatid]} {
        set type groupchat
    } else {
        set type chat
        $c delete [list id $id]
    }
    if {$id != ""} {
        ::xmpp::sendMessage $xlib $jid \
            -type $type \
            -xlist [list [::xmpp::xml::create x \
                              -xmlns tkabber:whiteboard \
                              -subelement [::xmpp::xml::create remove \
                                                  -attrs [list id $id]]]]
    }
}


###############################################################################

###############################################################################
# Move

proc wb::move_bind {c chatid} {
    bind $c <ButtonPress-1> \
         [list [namespace current]::move_b1p [double% $c] \
                                             [double% $chatid] %x %y]
    bind $c <B1-Motion> \
         [list [namespace current]::move_b1m [double% $c] %x %y]
    bind $c <ButtonRelease-1> \
         [list [namespace current]::move_b1r [double% $c] [double% $chatid]]
    bind $c <<ContextMenu>> \
         [list [namespace current]::popup_menu [double% $c] \
                                               [double% $chatid] %X %Y]
    bind $c <Motion> {}
    $c configure -cursor ""
}

proc wb::move_b1p {c chatid x y} {
    variable move

    set tags [$c gettags current]
    set id ""
    foreach t $tags {
        if {[lindex $t 0] == "id"} {
            set id [lindex $t 1]
            break
        }
    }
    if {$id != ""} {
        set x [$c canvasx $x]
        set y [$c canvasy $y]

        set move(startx) $x
        set move(starty) $y
        set move(lastx) $x
        set move(lasty) $y

        set move(id) $id
        $c configure -cursor hand2
    } else {
        catch {unset move(id)}
    }
}

proc wb::move_b1m {c x y} {
    variable move

    if {[info exists move(id)]} {
        set id $move(id)
        set x [$c canvasx $x]
        set y [$c canvasy $y]

        $c move [list id $id] [expr {$x - $move(lastx)}] \
                              [expr {$y - $move(lasty)}]

        set move(lastx) $x
        set move(lasty) $y
    }
}


proc wb::move_b1r {c chatid} {
    variable move

    if {[info exists move(id)]} {
        set id $move(id)
        set x $move(lastx)
        set y $move(lasty)

        set dx [expr {$x - $move(startx)}]
        set dy [expr {$y - $move(starty)}]

        if {$dx == 0 && $dy == 0} {
            $c configure -cursor ""
            return
        }

        if {[chat::is_groupchat $chatid]} {
            set type groupchat
            $c move [list id $id] [expr {-$dx}] [expr {-$dy}]
        } else {
            set type chat
            set jid [connection_jid [chat::get_xlib $chatid]]
            add_transform_tag $c $id translate($dx,$dy)
            $c addtag [time_tag moved $jid] withtag [list id $id]
        }

        set attrs [list id $id dx $dx dy $dy]

        set xlib [chat::get_xlib $chatid]
        set jid [chat::get_jid $chatid]
        ::xmpp::sendMessage $xlib $jid \
            -type $type \
            -xlist [list [::xmpp::xml::create x \
                              -xmlns tkabber:whiteboard \
                              -subelement [::xmpp::xml::create move \
                                                  -attrs $attrs]]]
        $c configure -cursor ""
    }
}

###############################################################################
# Image

proc wb::image_bind {c chatid} {
    bind $c <ButtonPress-1> {}
    bind $c <B1-Motion> {}
    bind $c <ButtonRelease-1> \
            [list [namespace current]::image_b1 [double% $c] \
                                                [double% $chatid] %x %y]
    bind $c <<ContextMenu>> {}
    $c configure -cursor crosshair
}

proc wb::image_b1 {c chatid x y} {
    variable image_info
    set image_info(x) [$c canvasx $x]
    set image_info(y) [$c canvasy $y]
    set w [win_id whiteboard $chatid]
    if {[catch { package require Img }]} {
        set types [list [list [::msgcat::mc "GIF images"] {.gif}] \
                        [list [::msgcat::mc "All files"] {*}]]
    } else {
        set types \
            [list [list [::msgcat::mc "All images"] {.jpg .jpeg .gif .png}] \
                  [list [::msgcat::mc "JPEG images"] {.jpg .jpeg}] \
                  [list [::msgcat::mc "GIF images"] {.gif}] \
                  [list [::msgcat::mc "PNG images"] {.png}] \
                  [list [::msgcat::mc "All files"] {*}]]
    }

    set filename [tk_getOpenFile -filetypes $types]
    if {$filename == ""} return

    if {[catch {image create photo -file $filename} res]} {
        if {[winfo exists .load_image_error]} {
            destroy .load_image_error
        }
        NonmodalMessageDlg .load_image_error -aspect 50000 -icon error \
                           -message [::msgcat::mc "Loading image failed: %s." \
                                                  $res]
        return
    }

    image delete $res

    set f [open $filename]
    fconfigure $f -translation binary
    set binval [read $f]
    close $f

    binary scan $binval H4 binsig
    switch -- $binsig {
        ffd8 { set type "image/jpeg" }
        4749 { set type "image/gif" }
        8950 { set type "image/png" }
        default { set type "image" }
    }

    set cid [::xmpp::bob::cid $binval]
    set data [::xmpp::bob::data $type $binval -maxage 0]
    
    set id [create_id]
    set attrs [list id $id x $image_info(x) y $image_info(y) \
                    type $type http://www.w3.org/1999/xlink:href cid:$cid]

    set tag [::xmpp::xml::create image -attrs $attrs]

    if {![chat::is_groupchat $chatid]} {
        ::xmpp::bob::cache [list $data]
        set imageid [svg::parseSVGItem $c {} {} $tag]
        set jid [connection_jid [chat::get_xlib $chatid]]
        $c addtag [list tag $tag] withtag $imageid
        $c addtag [time_tag created $jid] withtag $imageid
    }

    send_svg $chatid $tag $data
}

###############################################################################
# Text

proc wb::text_bind {c chatid} {
    bind $c <ButtonPress-1> {}
    bind $c <B1-Motion> {}
    bind $c <ButtonRelease-1> \
            [list [namespace current]::text_b1 [double% $c] \
                                               [double% $chatid] %x %y]
    bind $c <<ContextMenu>> {}
    $c configure -cursor crosshair
}

proc wb::text_b1 {c chatid x y} {
    variable text_info
    set text_info(x) [$c canvasx $x]
    set text_info(y) [$c canvasy $y]
    set w [win_id whiteboard $chatid]
    set wt $w.text_dialog
    if {[winfo exists $wt]} {
        wm deiconify $wt
    } else {
        Dialog $wt -anchor e \
                   -separator yes \
                   -title [::msgcat::mc "Enter text"] \
                   -side bottom \
                   -modal none \
                   -default 0 \
                   -cancel 1
        $wt add -text [::msgcat::mc "OK"] \
            -command [list [namespace current]::text_ok $wt $c $chatid]
        $wt add -text [::msgcat::mc "Cancel"] \
            -command [list [namespace current]::text_cancel $wt $c $chatid]

        set en [entry $wt.text -width 80 \
                    -textvariable [namespace current]::text_entered($chatid)]
        pack $en -side top -in [$wt getframe]
        $wt draw $en
    }
}

proc wb::text_ok {wt c chatid} {
    variable app_font
    variable text_info
    variable text_entered

    set id [create_id]
    set text $text_entered($chatid)

    set attrs [list id $id x $text_info(x) y $text_info(y) \
                   fill [get_text_color $chatid]]
    set font [get_text_font $chatid]
    if {[info exists app_font($font)]} {
        array set font_opt [font configure $font]
        lappend attrs font-size $font_opt(-size) \
                     font-family $font_opt(-family)
        if {$font_opt(-underline) || $font_opt(-overstrike)} {
            set dec {}
            if {$font_opt(-underline)} {
                lappend dec underline
            }
            if {$font_opt(-overstrike)} {
                lappend dec line-through
            }
            lappend attrs text-decoration $dec
        }
        if {[string equal $font_opt(-slant) italic]} {
            lappend attrs font-style italic
        }
        if {[string equal $font_opt(-weight) bold]} {
            lappend attrs font-weight bold
        }
        unset font_opt
    }

    set tag [::xmpp::xml::create text -attrs $attrs -cdata $text]

    if {![chat::is_groupchat $chatid]} {
        set textid [svg::parseSVGItem $c {} {} $tag]
        set jid [connection_jid [chat::get_xlib $chatid]]
        $c addtag [list tag $tag] withtag $textid
        $c addtag [time_tag created $jid] withtag $textid
    }

    send_svg $chatid $tag
    wm withdraw $wt
}

proc wb::text_cancel {wt c chatid} {
    wm withdraw $wt
}


# vim:ft=tcl:ts=8:sw=4:sts=4:et