# $Id: custom-urls.tcl 1722 2009-03-13 17:03:35Z sergei $
# 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
#
# 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+)?\#?(\d+))\y}
#    set ::plugins::custom-urls::url(tclbug) \
#	[list [string map {bug tclbug} $re] \
#	      "http://sourceforge.net/search/?type_of_search=artifact&group_id=10894&words=%d"]
#    set ::plugins::custom-urls::url(tkbug) \
#	[list [string map {bug tkbug} $re] \
#	      "http://sourceforge.net/search/?type_of_search=artifact&group_id=12997&words=%d"]
#}

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"]

    ::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 digits]} {
	    set type $idx
	    set res 1
	    break
	}
    }
    if {!$res} {
	return false
    }

    lassign $all xs xe

    lassign $digits ds de
    set num [::force_integer [string range $what $ds $de]]

    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:noet
