1# $Id$
2
3namespace eval highlight {
4
5    custom::defgroup Highlight [::msgcat::mc "Groupchat message highlighting plugin options."] \
6	-group Chat \
7	-group {Rich Text}
8
9    custom::defvar options(enable_highlighting) 1 \
10	[::msgcat::mc "Enable highlighting plugin."] \
11	-type boolean -group Highlight \
12	-command [namespace current]::on_state_changed
13
14    custom::defvar options(highlight_nick) 1 \
15	[::msgcat::mc "Highlight current nickname in messages."] \
16	-type boolean -group Highlight
17
18    custom::defvar options(highlight_substrings) {} \
19	[::msgcat::mc "Substrings to highlight in messages."] \
20	-type string -group Highlight
21
22    custom::defvar options(highlight_whole_words) 1 \
23	[::msgcat::mc "Highlight only whole words in messages."] \
24	-type boolean -group Highlight
25}
26
27proc highlight::configure_richtext_widget {w} {
28    # TODO some defaults may be?
29
30    $w tag configure highlight
31}
32
33proc highlight::process_highlights {atLevel accVar} {
34    upvar #$atLevel $accVar chunks
35
36    variable options
37
38    set subs [split $options(highlight_substrings) " "]
39    if {$options(highlight_nick) && [::richtext::property_exists mynick]} {
40	lappend subs [::richtext::property_get mynick]
41    }
42
43    set out {}
44
45    foreach {s type tags} $chunks {
46	if {$type != "text"} {
47	    # pass through
48	    lappend out $s $type $tags
49	    continue
50	}
51
52	set ts 0
53
54	foreach {ms me} [spot_highlights $s $subs] {
55	    # Write out text before current highlight, if any:
56	    if {$ts < $ms} {
57		lappend out [string range $s $ts [expr {$ms - 1}]] $type $tags
58	    }
59	    # Write out current highlight:
60	    lappend out [string range $s $ms $me] highlight $tags
61
62	    set ts [expr {$me + 1}]
63	}
64
65	# Write out text after the last highlight, if any:
66	if {[string length $s] - $ts > 0} {
67	    lappend out [string range $s $ts end] $type $tags
68	}
69    }
70
71    set chunks $out
72}
73
74proc highlight::spot_highlights {s subs} {
75    variable options
76
77    set words [textutil::splitx $s {([\t \r\n]+)}]
78
79    set ind_end 0
80    set stop_ind [string length $s]
81    set ranges {}
82    set found 1
83    while {$found && $ind_end < $stop_ind} {
84	set found 0
85	set ind $ind_end
86	foreach str $subs {
87	    set len [string length $str]
88	    if {$len > 0 && [set match [string first $str $s $ind]] >= 0} {
89		if {!$options(highlight_whole_words) || \
90			(![string is wordchar -strict [string index $s [expr {$match - 1}]]] && \
91			![string is wordchar -strict [string index $s [expr {$match + $len}]]])} {
92		    if {!$found} {
93			set found 1
94			set ind_start $match
95			set ind_end [expr {$match + $len}]
96		    } elseif {$match < $ind_start} {
97			set ind_start $match
98			set ind_end [expr {$match + $len}]
99		    }
100		}
101	    }
102	}
103	if {$found} {
104	    lappend ranges $ind_start [expr {$ind_end - 1}]
105	}
106    }
107
108    return $ranges
109}
110
111proc highlight::render_highlight {w type piece tags} {
112    $w insert end $piece [lfuse $type $tags]
113}
114
115# The following procedure reports highlighting inside URLs too
116proc highlight::check_highlighted_message {vpersonal nick body} {
117    variable options
118    upvar 2 $vpersonal personal
119
120    set subs [split $options(highlight_substrings) " "]
121    if {$options(highlight_nick)} {
122	lappend subs $nick
123    }
124    if {![lempty [spot_highlights $body $subs]]} {
125	set personal 1
126    }
127}
128
129hook::add check_personal_message_hook \
130	  [namespace current]::highlight::check_highlighted_message
131
132proc highlight::on_state_changed {args} {
133    variable options
134
135    ::richtext::entity_state highlight $options(enable_highlighting)
136}
137
138namespace eval highlight {
139    ::richtext::register_entity highlight \
140	-configurator [namespace current]::configure_richtext_widget \
141	-parser [namespace current]::process_highlights \
142	-renderer [namespace current]::render_highlight \
143	-parser-priority 60
144
145    on_state_changed
146}
147
148# vim:ts=8:sw=4:sts=4:noet
149