# custom-urls.tcl --
#
#       Custom URL Processing -- converts some strings into clickable URLs.
#
# Predefined examples include:
# 1) XEP links:
#    xep-0013 or jep-0013 or jep-13 or xep-13 or jep13 or xep13 ->
#        http://www.xmpp.org/extensions/xep-0013.html
# 2) RFC links:
#    rfc-1111 -> http://tools.ietf.org/html/rfc1111
# 3) Debian BTS links:
#    bug-345678 or #345678 ->
#        http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=345678
# 4) Tkabber wiki links:
#    wiki:en/Main_Page ->
#        http://chiselapp.com/user/sgolovan/repository/tkabber-wiki/doc/tip/wiki/en/Main_Page.md
# 5) Tkabber tickets or check-ins:
#    [3cd34577a3] ->
#        http://chiselapp.com/user/sgolovan/repository/tkabber/info/3cd34577a3
#
# Matching is case insensitive.
#
# To define your own custom numbered URL add its definition (similar to URLs
# below) to postload section of Tkabber config file. Note that the number must
# match the second regexp match variable, and the whole link must match the
# first match variable, so look closely at (?:) modifiers in the examples.
# Also, note that the plugin uses extended regexp syntax.
#
# Example for config.tcl:
#
#proc postload {} {
#    set re {\y(bug(?:-|\s+)?\#?([0-9a-f]+))\y}
#    set ::plugins::custom-urls::url(tclbug) \
#       [list [string map {bug tclbug} $re] \
#             "http://core.tcl.tk/tcl/tktview?name=%s"]
#    set ::plugins::custom-urls::url(tkbug) \
#       [list [string map {bug tkbug} $re] \
#             "http://core.tcl.tk/tk/tktview?name=%s"]
#}

package require msgcat

namespace eval custom-urls {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

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

    variable url
    array set url {}
}

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

proc custom-urls::load {} {
    variable url

    set url(xep)    [list {\y((?:jep|xep)(?:-|\s+)?(\d+))\y} \
                          "http://www.xmpp.org/extensions/xep-%04d.html"]
    set url(rfc)    [list {\y(rfc(?:-|\s+)?(\d+))\y} \
                          "http://tools.ietf.org/html/rfc%d"]
    set url(debbug) [list {(?:^|\s)((?:(?:bug(?:-|\s+)?\#?)|\#)(\d+))\y} \
                          "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%d"]
    set url(wiki)   [list {\y(wiki:([\w/]+)((?:\#[-._\w]+)?))\y} \
                          "https://chiselapp.com/user/sgolovan/repository/tkabber-wiki/doc/tip/wiki/%s.md%s"]
    set url(artifact) [list {(\[([0-9a-f]{4,40})\])} \
                          "https://chiselapp.com/user/sgolovan/repository/tkabber/info/%s"]

    ::richtext::register_entity custom-url \
            -parser [namespace current]::process_urls \
            -parser-priority 55

    ::richtext::entity_state custom-url 1
}

proc custom-urls::unload {} {
    variable url

    ::richtext::unregister_entity custom-url

    array unset url
}

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

# This proc actually uses "url" rich text entity and relies on its
# ability to render "titled" URLs.
proc custom-urls::process_urls {atLevel accName} {
    upvar #$atLevel $accName chunks

    set out {}

    foreach {s type tags} $chunks {
        if {$type != "text"} {
            # pass through
            lappend out $s $type $tags
            continue
        }

        set ix 0; set xs 0; set xe 0; set num {}

        while {[spot_url $s $ix xs xe t num]} {
            if {$xs - $ix > 0} {
                # dump chunk before URL
                lappend out [string range $s $ix [expr {$xs - 1}]] $type $tags
            }

            set text [string range $s $xs $xe]
            set url [make_url $text $t $num]

            lappend out $url url $tags
            ::richtext::property_update url:title,$url $text

            set ix [expr {$xe + 1}]

        }

        if {[string length $s] - $ix > 0} {
            # dump chunk after URL
            lappend out [string range $s $ix end] $type $tags
        }
    }

    set chunks $out
}

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

proc custom-urls::spot_url {what at startVar endVar typeVar numVar} {
    variable url
    upvar 1 $startVar xs $endVar xe $typeVar type $numVar num

    set res 0
    foreach idx [array names url] {
        if {[regexp -expanded -nocase -indices -start $at -- \
                    [lindex $url($idx) 0] $what -> all \
                    match(1) match(2) match(3) match(4)]} {
            set type $idx
            set res 1
            break
        }
    }
    if {!$res} {
        return false
    }

    lassign $all xs xe

    set num {}
    for {set i 1} {$i <= 4} {incr i} {
        lassign $match($i) ds de
        set str [string range $what $ds $de]
        if {[regexp {^\d+$} $str]} {
            lappend num [::force_integer $str]
        } else {
            lappend num $str
        }
    }

    return true
}

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

proc custom-urls::make_url {text type num} {
    variable url

    if {[catch {set curl [format [lindex $url($type) 1] {*}$num]}]} {
        return ""
    } else {
        return $curl
    }
}

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