1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
# 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
|
