[DG] found this [RE] on http://www.foad.org/~abigail/Perl/url2.html and rewrote it for Tcl.  
'''Holy RE, batman!'''  
It isn't perfect, doesn't match the latest URI spec [http://www.gbiv.com/protocols/uri/rfc/rfc3986.html], 
and needs a good test suite for verification, but watch this page!
----
Just added IPv6 support.  ${hsegment} has a problem picking-up closing parens, 
which is a legal character, but in the following context it is not:  
"See my website (http://www.example.com/) for the answer to life, the universe and everything"
----
'''...Stop the press...'''
A sharp knife clued me in to the joke..  The proc is really a joke.  And the joke was on me.  Here's a
dumb RE, just as I needed it:

 ([^ <\("\?]?)(?:(?:[[:alpha:]]){1}(?:\w)*):(?://)?(\w+(?:[\.:@]\w+)*?)(?:/|@)([^ >\)"\?]*?)

I'll leave the rest in case someone is building an over the top URI parser and wants to turn
off all the non-reporting atoms :)  Have a nice day!
----

 proc makeURI_RE {} {

    set nz_digit	{[[:digit:]]}
    set nz_digits	"(?:$nz_digit+)"
    set digits		{(?:\d+)}
    set space		{(?:%20)}
    set nl		{(?:%0[Aa])}
    set dot		{\.}
    set plus		{\+}
    set qm		{\?}
    set ast		{\*}
    set hex		{[a-fA-F\d]}
    set alpha		{[[:alpha:]]}
    set alphas		"(?:${alpha}+)"
    set alphanum	{[[:alnum:]]}
    set xalphanum	"(?:${alphanum}|%(?:3\\d|\[46\]$hex|\[57\]\[Aa\\d\]))"
    set alphanums	"(?:${alphanum}+)"
    set escape		"(?:%$hex\{2\})"
    set safe		{[$\-_.+]}
    set extra		{[~!*'(),]}
    set unwise		{[{}|\\^[\]`]}
    set punctuation	{[[:punct:]]}
    set reserved	{[;/?:@&=]}
    set uchar		"(?:${alphanum}|${safe}|${extra}|${escape})"
    set xchar		"(?:${alphanum}|${safe}|${extra}|${reserved}|${escape})"

 # URL schemeparts for ip based protocols:
    set user		"(?:(?:${uchar}|\[\;?&=\])*)"
    set password	"(?:(?:${uchar}|\[\;?&=\])*)"
    set hostnumber	"(?:${digits}(?:${dot}${digits}){3})"
    set toplabel	"(?:${alpha}(?:(?:${alphanum}|-)*${alphanum})?)"
    set domainlabel	"(?:${alphanum}(?:(?:${alphanum}|-)*${alphanum})?)"

    # only dotted-4 allowed (maybe I'm being strict)
    set IPv4address	{(?:(?:25[0-5]|2[0-4]\d|[0-1]?\d?\d)(?:\.(25[0-5]|2[0-4]\d|[0-1]?\d?\d)){3})}

    # IPv6, all forms.
    set IPv6full	{(?:(?:[[:xdigit:]]{1,4}:){7}[[:xdigit:]]{1,4})}
    set IPv6hexcomp	{(?:(?:(?:[[:xdigit:]]{1,4}(?::[[:xdigit:]]{1,4})*)?)::((?:[[:xdigit:]]{1,4}(?::[[:xdigit:]]{1,4})*)?))}
    set IPv6hex4dec	{(?:(?:(?:[[:xdigit:]]{1,4}:){6,6})(25[0-5]|2[0-4]\d|[0-1]?\d?\d)(\.(25[0-5]|2[0-4]\d|[0-1]?\d?\d)){3})}
    set IPv6hex4deccomp {(?:(?:(?:[[:xdigit:]]{1,4}(?::[[:xdigit:]]{1,4})*)?)::(?:(?:[[:xdigit:]]{1,4}:)*)(25[0-5]|2[0-4]\d|[0-1]?\d?\d)(\.(25[0-5]|2[0-4]\d|[0-1]?\d?\d)){3})}
    set IPv6address	"(?:${IPv6full}|${IPv6hexcomp}|${IPv6hex4dec}|${IPv6hex4deccomp})"

    set hostname	"(?:(?:${domainlabel}${dot})*${toplabel})"
    set host		"(?:${hostname}|${IPv4address}|(?:\\\[${IPv6address}\\\]))"
    set hostport	"(?:${host}(?::${digits})?)"
    set login		"(?:(?:${user}(?::${password})?@)?${hostport})"

 # The predefined schemes:

 # FTP (see also RFC959)
    set fsegment	"(?:(?:${uchar}|\[?:@&=\])*)"
    set fpath		"(?:${fsegment}(?:/${fsegment})*)"
    set ftpurl		"(?:ftp://${login}(?:/${fpath}(?:;type=\[AIDaid\])?)?)"

 # FILE
    set fileurl		"(?:file://(?:${host}|localhost)?/${fpath})"

 # HTTP  http://www.ietf.org/rfc/rfc2616.txt
    set hsegment	"(?:(?:${uchar}|\[\;:@&=\])*)"
    set search		"(?:(?:${uchar}|\[\;:@&=\])*)"
    set hpath		"(?:${hsegment}(?:/${hsegment})*)"
    set httpurl		"(?:http(?:s?)://${hostport}(?:/${hpath}(?:${qm}${search})?)?)"

 # GOPHER (see also RFC1436)
    set gopher_plus	"(?:${xchar}*)"
    set selector	"(?:${xchar}*)"
    set gtype		${xchar}	
    set gopherurl	[join [list "(?:gopher://${hostport}(?:/${gtype}(?:${selector}(?:%09${search}" \
			"(?:%09${gopher_plus})?)?)?)?)" ] ""]

 # MAILTO (see also RFC822)
    set encoded822addr	"(?:$xchar+)"
    set mailtourl	"(?:mailto:$encoded822addr)"

 # NEWS (see also RFC1036)
    set article		"(?:(?:${uchar}|\[\;/?:&=\])+@${host})"
    set group		"(?:${alpha}(?:${alphanum}|\[_.+-\])*)"
    set grouppart	"(?:${article}|${group}|${ast})"
    set newsurl		"(?:news:${grouppart})"

 # NNTP (see also RFC977)
    set nntpurl		"(?:nntp://${hostport}/${group}(?:/${digits})?)"

 # TELNET
    set telneturl	"(?:telnet://${login}/?)"

 # WAIS (see also RFC1625)
    set wpath		"(?:${uchar}*)"
    set wtype		"(?:${uchar}*)"
    set database	"(?:${uchar}*)"
    set waisdoc		"(?:wais://${hostport}/${database}/${wtype}/${wpath})"
    set waisindex	"(?:wais://${hostport}/${database}${qm}${search})"
    set waisdatabase	"(?:wais://${hostport}/${database})"
 # my $waisurl        =  "(?:${waisdatabase}|${waisindex}|${waisdoc})";
 # Speed up: the 3 types share a common prefix.
    set waisurl		"(?:wais://${hostport}/${database}(?:(?:/${wtype}/${wpath})|${qm}${search})?)"

 # PROSPERO
    set fieldvalue	"(?:(?:${uchar}|\[?:@&\])*)"
    set fieldname	"(?:(?:${uchar}|\[?:@&\])*)"
    set fieldspec	"(?:;${fieldname}=${fieldvalue})"
    set psegment	"(?:(?:${uchar}|\[?:@&=\])*)"
    set ppath		"(?:${psegment}(?:/${psegment})*)"
    set prosperourl	"(?:prospero://${hostport}/${ppath}(?:${fieldspec})*)"

 # LDAP (see also RFC1959)
 # First. import stuff from RFC 1779 (Distinguished Names).
 # We've modified things a bit.
    set dn_separator	"(?:\[\;,\])"
    set dn_optional_space "(?:${nl}?${space}*)"
    set dn_spaced_separator "(?:${dn_optional_space}${dn_separator}${dn_optional_space})"
    set dn_oid		"(?:${digits}(?:${dot}${digits})*)"
    set dn_keychar	"(?:${xalphanum}|${space})"
    set dn_key		"(?:${dn_keychar}+|(?:OID|oid)${dot}${dn_oid})"
    set dn_string	"(?:${uchar}*)"
    set dn_attribute	"(?:(?:${dn_key}${dn_optional_space}=${dn_optional_space})?${dn_string})"
    set dn_name_component "(?:${dn_attribute}(?:${dn_optional_space}${plus}${dn_optional_space}${dn_attribute})*)"
    set dn_name		[join [list "(?:${dn_name_component}(?:${dn_spaced_separator}${dn_name_component})*" \
			"${dn_spaced_separator}?)" ] ""]

 # RFC 1558 defines the filter syntax, but that requires a PDA to recognize.
 # Since that's too powerful for Perl's REs, we allow any char between the
 # parenthesis (which have to be there.)
    set ldap_filter	"(?:\(${xchar}+\))"

 # This is from RFC 1777. It defines an attributetype as an 'OCTET STRING',
 # whatever that is.
    set ldap_attr_type	"(?:${uchar}+)"

 # Now we are at the grammar of RFC 1959.
    set ldap_attr_list	"(?:${ldap_attr_type}(?:,${ldap_attr_type})*)"
    set ldap_attrs	"(?:${ldap_attr_list}?)"

    set ldap_scope	"(?:base|one|sub)"
    set ldapurl		[join [list "(?:ldap://(?:${hostport})?/${dn_name}(?:${qm}${ldap_attrs}" \
			"(?:${qm}${ldap_scope}(?:${qm}${ldap_filter})?)?)?)" ] ""]


 # RFC 2056 defines the format of URLs for the Z39.50 protocol.
    set z_database	"(?:${uchar}+)"
    set z_docid		"(?:${uchar}+)"
    set z_elementset	"(?:${uchar}+)"
    set z_recordsyntax	"(?:${uchar}+)"
    set z_scheme	"(?:z39${dot}50\[rs\])"
    set z39_50url	[join [list "(?:${z_scheme}://${hostport}(?:/(?:${z_database}(?:${plus}" \
			"${z_database})*(?:${qm}${z_docid})?)?(?:\;esn=${z_elementset})?" \
			"(?:\;rs=${z_recordsyntax}(?:${plus}${z_recordsyntax})*)?))" ] ""]

 # RFC 2111 defines the format for cid/mid URLs.
    set url_addr_spec	"(?:(?:${uchar}|\[;?:@&=\])*)"
    set message_id	$url_addr_spec
    set content_id	$url_addr_spec
    set cidurl		"(?:cid:${content_id})"
    set midurl		"(?:mid:${message_id}(?:/${content_id})?)"


 # RFC 2122 defines the Vemmi URLs.
    set vemmi_attr	"(?:(?:${uchar}|\[/?:@&\])*)"
    set vemmi_value	"(?:(?:${uchar}|\[/?:@&\])*)"
    set vemmi_service	"(?:(?:${uchar}|\[/?:@&=\])*)"
    set vemmi_param	"(?:\;${vemmi_attr}=${vemmi_value})"
    set vemmiurl	"(?:vemmi://${hostport}(?:/${vemmi_service}(?:${vemmi_param}*))?)"

 # RFC 2192 for IMAP URLs.
 # Import from RFC 2060.
 # set imap4_astring    ""
 # set imap4_search_key ""
 # set imap4_section_text ""
    set imap4_nz_number	$nz_digits;
    set achar		"(?:${uchar}|\[&=~\])"
    set bchar		"(?:${uchar}|\[&=~:@/\])"
    set enc_auth_type	"(?:${achar}+)"
    set enc_list_mbox	"(?:${bchar}+)"
    set enc_mailbox	"(?:${bchar}+)"
    set enc_search	"(?:${bchar}+)"
    set enc_section	"(?:${bchar}+)"
    set enc_user	"(?:${achar}+)"
    set i_auth		"(?:\;\[Aa\]\[Uu\]\[Tt\]\[Hh\]=(?:${ast}|${enc_auth_type}))";
    set i_list_type	"(?:\[Ll\](?:\[Ii\]\[Ss\]\[Tt\]|\[Ss\]\[Uu\]\[Bb\]))";
    set i_mailboxlist	"(?:${enc_list_mbox}?\;\[Tt\]\[Yy\]\[Pp\]\[Ee\]=${i_list_type})";
    set i_uidvalidity	[join [list "(?:\;\[Uu\]\[Ii\]\[Dd\]\[Vv\]\[Aa\]\[Ll\]\[Ii\]\[Dd\]\[Ii\]" \
			"\[Tt\]\[Yy\]=${imap4_nz_number})" ] ""]
    set i_messagelist	"(?:${enc_mailbox}(?:${qm}${enc_search})?(?:${i_uidvalidity})?)"
    set i_section	"(?:/\;\[Ss\]\[Ee\]\[Cc\]\[Tt\]\[Ii\]\[Oo\]\[Nn\]=${enc_section})"
    set i_uid		"(?:/\;\[Uu\]\[Ii\]\[Dd\]=${imap4_nz_number})"
    set i_messagepart	"(?:${enc_mailbox}(?:${i_uidvalidity})?${i_uid}(?:${i_section})?)"
    set i_command	"(?:${i_mailboxlist}|${i_messagelist}|${i_messagepart})"
    set i_userauth	"(?:(?:${enc_user}(?:${i_auth})?)|(?:${i_auth}(?:${enc_user})?))"
    set i_server	"(?:(?:${i_userauth}@)?${hostport})"
    set imapurl		"(?:imap://${i_server}/(?:$i_command)?)"

 # RFC 2224 for NFS.
    set nfs_mark	{[$-_.!~*'(),]}
    set nfs_unreserved	"(?:${alphanum}|${nfs_mark})"
    set nfs_pchar	"(?:${nfs_unreserved}|${escape}|\[:@&=+\])"
    set nfs_segment	"(?:${nfs_pchar}*)"
    set nfs_path_segs	"(?:${nfs_segment}(?:/${nfs_segment})*)"
    set nfs_url_path	"(?:/?${nfs_path_segs})"
    set nfs_rel_path	"(?:${nfs_path_segs}?)"
    set nfs_abs_path	"(?:/${nfs_rel_path})"
    set nfs_net_path	"(?://${hostport}(?:${nfs_abs_path})?)"
    set nfs_rel_url	"(?:${nfs_net_path}|${nfs_abs_path}|${nfs_rel_path})"
    set nfsurl		"(?:nfs:${nfs_rel_url})"


 # Combining all the different URL formats into a single regex.
    return [join [list $httpurl $ftpurl $newsurl $nntpurl \
		$telneturl $gopherurl $waisurl $mailtourl \
		$fileurl $prosperourl $ldapurl $z39_50url \
		$cidurl $midurl $vemmiurl $imapurl $nfsurl] |]
 }

----
[Category String Processing] - [Regular Expressions] - [Category Internet]