# uri.tcl
#
# A little support for Uniform Resource Identifiers.
#
# martin hamilton <martin@mrrl.lut.ac.uk>
# &
# John Robert LoVerso <loverso@osf.org>
# Toivo Pedaste <toivo@ucs.uwa.edu.au>
# Fred Douglis <douglis@research.att.com>

proc URI_Init {} {
    global env uri

    if [info exists uri(init)] {
	return
    }

    set uri(init) 1

    Preferences_Add "WWW" \
      "These options control how exmh deals with Uniform Resource
Identifiers, e.g. World-Wide Web URLs.  You can arrange for URLs
embedded in messages to be turned into hyperlinks, and there is an
option to decipher the experimental X-URL (or X-URI) header.  This may be used
by the sender of a message to include contact information, such as
the address of their World-Wide Web homepage.  You can add this
header to your messages by editing compcomps, replcomps and so on." {
	{uri(scanForXURIs) uriScanForXURIs	ON {Scan for X-URL: headers}
"This tells exmh whether to look for X-URL (or X_URI) headers in messages when
you read them."}
	{uri(scanForURIs) uriScanForURIs	OFF {Scan for URLs in messages}
"This tells exmh whether to look for URL in the bodies of messages.
If you turn it on, any URLs it finds will be turned into buttons
which you can click on to launch a viewer application.  NB - this can
slow down message displaying somewhat."}
	{uri(scanLimit) uriScanLimit	1000 {Max lines to scan for URL}
"This limits the number of lines scanned for embedded URLs,
which can run slowly on large messages.  Set to a number of lines,
or to the keyword \"end\" to scan the whole message."}
	{uri(scanSoftLimit) uriScanSoftLimit	1000 {Stop button max lines}
"If the number of lines to scan is more than this soft limit, then
a stop button is displayed so you can terminate URL scanning before
it completes.."}
	{uri(viewer)	uriViewer {CHOICE Mosaic netscape other} {URL Viewer}
"The Mosaic and netscape options attempt to connect to a running
instance of these programs.  The other option lets you define your
own script to display the URL."}
	{uri(viewHtml)	mimeShowHtml OFF {Show text/html immediately}
"If you want to automatically start the URL browser when you
get a text/html MIME part, choose this.  Otherwise you must
ask for the browser to be started for each text/html part."}
	{uri(mosaicApp) uriMosaicApp	{Mosaic} {Mosaic program name}
"This is the application which exmh will launch when you click on the
face of your correspondent, or on a hyperlink in the body of a message.
The varialbe \$xuri gets replaced with the URL."}
	{uri(viewerApp) uriViewerApp	{Mosaic $xuri} {Other URL Viewer}
"This is the application which exmh will launch when you click on the
face of your correspondent, or on a hyperlink in the body of a message.
The varialbe \$xuri gets replaced with the URL."}
	{uri(logOnEnter) uriLogOnEnter	ON	{Show selected URL}
"With 'Show selected URL' enabled exmh will display
the coresponding URL if you move with the mouse on an
activated (looks like a button) X-Face or URL in the
message text.
NOTE: When you change the option you have to rescan your
      current message or read another one to de/active
      the option."}
    }
    if {$uri(viewer) == "xmosaic"} {
	set uri(viewer) Mosaic
    }
}

proc URI_StartViewer {xuri} {
    global uri

    regsub -nocase "URL:" $xuri {} xuri
    string trimright $xuri "."
    Exmh_Status $xuri

    if [regexp {^mailto:(.*)$} $xuri x address] {
	global mhProfile
	# Need to craft template here.
    }
    if [catch {
	switch -- $uri(viewer) {
	    Mosaic	{ Mosaic_Load $xuri}
	    netscape {
		if [ catch { exec netscape -remote openURL($xuri) } tmp ] {
		    if { [ string first "not running on" $tmp ] != -1 } {
		        exec netscape $xuri &
		        Exmh_Status "Starting netscape"
                    }
		}
	    }
	    other {eval exec $uri(viewerApp) &}
	}
    } err] {
	Exmh_Status $err
    }
}

proc URI_OpenSelection {} {
    if [catch {selection get} xuri] {
        return
    }
    URI_StartViewer $xuri
}

proc Hook_MsgShowParseUri {msgPath hmm} {
    global uri exwin mimeHdr faces

    foreach hdr {x-uri x-url} {
	if {[info exists mimeHdr(0=1,hdr,$hdr)] && $uri(scanForXURIs)} {
	    set temp_uri [MsgParseFrom $mimeHdr(0=1,hdr,$hdr)]
	}
    }
    if [info exists temp_uri] {
        regsub -all "\[ \t\n\]" $temp_uri {} temp_uri
        $faces(canvas) configure -relief raised
        bind $faces(canvas) <Button-1> [list URI_StartViewer $temp_uri]
	if $uri(logOnEnter) {
            bind $faces(canvas) <Enter> [list Exmh_Status "X-URL: $temp_uri"]
            bind $faces(canvas) <Leave> [list Exmh_Status " "]
	}
    } else {
	Uri_ClearCurrent
    }

    if !$uri(scanForURIs) {
        return
    }
    URI_ScanMsg $exwin(mtext) $uri(scanLimit)
}
proc Uri_ClearCurrent {} {
    global faces
    $faces(canvas) configure -relief flat
    bind $faces(canvas) <Button-1> {}
    bind $faces(canvas) <Enter> {}
    bind $faces(canvas) <Leave> {}
}

proc Hook_MsgClipParseUri {msgPath t} {
    global uri exwin

    if !$uri(scanForURIs) {
        return
    }
    URI_ScanMsg $t $uri(scanLimit)
}

proc URI_ActiveText { w start end URI} {
    global uri
    # quote percents in URLs because they appear in binding commands
    regsub -all % $URI %% URI
    set id [TextButtonRange $w $start $end [list URI_StartViewer $URI]]
    if $uri(logOnEnter) {
	$w tag bind $id <Any-Enter> [list +Exmh_Status "$URI"]
	$w tag bind $id <Any-Leave> "+Exmh_Status { }"
    }
    update idletasks
    return $id
}

proc URI_ScanMsg { {w {}} {limit end} } {
    global uri exwin
    if {$w == {}} {
	set w $exwin(mtext)
    }
    set x [lindex [$w config -cursor] 4]
    $w config -cursor watch

    set multiline 0
    set grab 0
    set uri(stop) 0
    scan [$w index end] %d lnum
    if {$limit != "end"} {
	if {$limit > $lnum} {
	    set limit $lnum.0
	} else {
	    set limit $limit.0
	}
    }
    if {$lnum > $uri(scanSoftLimit)} {
	set g $w.ustop
	if [winfo exists $g] {
	     destroy $g
	}
	frame $g -bd 4 -relief raised
	set f [frame $g.pad -bd 20]
	set msg [Widget_Message $f msg -text "$lnum Lines to scan" -aspect 1000]
	Widget_AddBut $f stop STOP {set uri(stop) 1}  {top padx 2 pady 2}
	bind $f.stop <Any-Key> {set uri(stop) 1 ; Exmh_Status Stop warn}
	pack $f
	Widget_PlaceDialog $w $g
	tkwait visibility $f.stop
	focus $f.stop
	grab $f.stop
	set grab 1
    }
    Exmh_Debug "URI_ScanMsg $limit"
    for {set i 0} {[$w compare $i.0 < $limit]} {incr i} {
        set begin 0
        set text [$w get $i.0 "$i.0 lineend"] 

	if {$grab && $i && (($i % 20) == 0)} {
	    $msg config -text "Scanned $i of $lnum"
	    update
	}
	if {$uri(stop)} {
	    break
	}
        #######
        # check for unencapsulated URIs by protocol if no < > present
        if {[string first "<" $text] == -1 && [string first ">" $text] == -1} {
	    catch {unset end}
            if {[regexp -indices -nocase \
 "(ftp|http|gopher|nntp|telnet|wais|file|prospero|finger)://\[^ '\"\n\t\)\]+" \
              $text positions] == 1} {
		  Exmh_Debug Regexp1 $positions
                 set end [expr [lindex $positions 1] + 1] 
 
            } elseif {[regexp -indices -nocase \
     "(urn|mailto|news|solo|x500):\[^ \n\t\)\]*\[^ \n\r\)\.\]" \
               $text positions] == 1} {
		  Exmh_Debug Regexp2 $positions
                 set end [expr [lindex $positions 1] + 1] 
            }
 
            if [info exists end] {
                set start [lindex $positions 0]
                set temp_uri [string range $text $start $end]
  
                # people put all sorts of nasty things at the end of URLs
  	        set temp_uri [string trimright $temp_uri "\.'>\""]

		URI_ActiveText $w $i.$start $i.$end $temp_uri
            }
            continue;
        }
 
        ######
        # check for URIs like <protocol: > present
        if {[regexp -indices -nocase \
  "<(ftp|http|gopher|nntp|telnet|wais|file|prospero|finger|urn|mailto|news|solo|x500)://\[^>)\]+" $text positions] == 1} {
	      Exmh_Debug Regexp3 $positions
            set end_marker [expr [lindex $positions 1] + 1] 

            if {[info exists end_marker]} {
                set start_marker [lindex $positions 0]
                incr start_marker
                set temp_uri [string range $text $start_marker $end_marker]
 	 	 
                # people put all sorts of nasty things at the end of URLs
  	        set temp_uri [string trimright $temp_uri "\.'>"]

		URI_ActiveText $w $i.$start_marker $i.$end_marker $temp_uri

                unset start_marker end_marker positions
            }
 	    continue;
 	}
 
        #######
        # match URIs continued from the previous line
        if $multiline {
            set right [string first ">" [string range $text $begin end]]
            if {$right != -1} {
		Exmh_Debug Regexp4 right=$right begin=$begin
                set right [expr $right + $begin]
                set last $i.$right
                regsub -all "\n" [$w get $mstart $last] {} temp_uri

 
		URI_ActiveText $w $mstart $last $temp_uri
 
                set begin $right
	        set multiline 0
            }
	    # note: we will continue to look until a close is found
        }
 
        #######
        # match URIs wholly contained on one line
        if {[regexp -indices -nocase "<(URN|URL|URI)\[: \]\[^>\]+>" \
          [string range $text $begin end] indices] == 1} {
	      Exmh_Debug Regexp5 $indices
            set start [expr $begin + [lindex $indices 0] + 1]
            set end [expr $begin + [lindex $indices 1]]
            set temp_uri [$w get $i.$start $i.$end]
 
	    URI_ActiveText $w $i.$start $i.$end $temp_uri

            set begin [lindex $indices 1]
        }
 
        #######
        # match real HTML links
        if {[regexp -indices -nocase {<a href=([^>]+)>(.*)</a>} \
		[string range $text $begin end] indices i1 i2] == 1} {
	      Exmh_Debug Regexp5 $indices $i1 $i2

            set left [expr $begin + [lindex $i1 0]]
            set right [expr $begin + [lindex $i1 1]]
            set temp_uri [string trim [$w get "$i.$left" "$i.$right"] {"}]

	    $w configure -state normal

	    $w delete $i.[expr $begin + [lindex $i2 1] + 1] \
		    $i.[expr $begin + [lindex $indices 1] + 1]
	    $w delete $i.[expr $begin + [lindex $indices 0]] \
		    $i.[expr $begin + [lindex $i2 0]]

	    $w configure -state disabled

	    set end [expr $begin + [lindex $indices 0] + [lindex $i2 1] - [lindex $i2 0] + 1]
	    URI_ActiveText $w $i.[expr $begin + [lindex $indices 0]] $i.$end $temp_uri

            set begin $end
            $w mark unset left right
        }
 
        #######
        # match the start of a URI which is broken over more than one
        # line - must include <URN or <URL
        if {[regexp -indices -nocase "<(URN|URL)" \
          [string range $text $begin end] indices] == 1} {
	      Exmh_Debug Regexp6 $indices
            set left [expr [lindex $indices 0] + $begin + 1]
            set mstart $i.$left
            set multiline 1
        }
     }
    if {$grab} {
	grab release $g.stop
	Exmh_Focus
	destroy $g
    }

     $w config -cursor $x
 }
