File: ParseStyledText.tcl

package info (click to toggle)
coccinella 0.96.20-9
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 13,184 kB
  • sloc: tcl: 124,744; xml: 206; makefile: 66; sh: 62
file content (89 lines) | stat: -rw-r--r-- 2,413 bytes parent folder | download | duplicates (4)
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
#  ParseStyledText.tcl ---
#  
#      This file is part of The Coccinella application. 
#      It implements simplified text font style parsing in messages.
#      
#  Copyright (c) 2005  Mats Bengtsson
#  
#   This program is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#   
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#   
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
#  
# $Id: ParseStyledText.tcl,v 1.8 2007-11-17 07:40:52 matben Exp $

namespace eval ::ParseStyledText {

    component::define ParseStyledText \
      "Simplified text font style parsing: *bold*, /italic/, and _underline_."
}

proc ::ParseStyledText::Init {} {
    
    component::register ParseStyledText

    # Add event hooks.
    ::hooks::register textParseWordHook [namespace code ParseWordHook]
    ::pipes::register htmlParseWordPipe [namespace code ParseWordPipe]
    
    variable parse
    set parse {
	{^\*(.+)\*$}  -weight     bold      tbold
	{^/(.+)/$}    -slant      italic    titalic
	{^_(.+)_$}    -underline  1         tunderline
    }

    variable phtml
    set phtml {
	{^\*(.+)\*$}  {<b>\1</b>}
	{^/(.+)/$}    {<i>\1</i>}
	{^_(.+)_$}    {<u>\1</u>}
    }
}

proc ::ParseStyledText::ParseWordPipe {type jid word} {
    variable phtml
    
    foreach {re sub} $phtml {
	if {[regsub -- $re $word $sub word]} {
	    return $word
	}
    }
    return $word
}

proc ::ParseStyledText::ParseWordHook {type jid w word tagList} {
    variable parse
    
    set handled ""
    foreach {re name value ftag} $parse {
	if {[regexp $re $word m new]} {
	    set font ""
	    foreach tag $tagList {
		set font [$w tag cget $tag -font]
		if {$font ne ""} {
		    break
		}
	    }
	    if {$font ne ""} {
		array set fopts [font actual $font]
		set fopts($name) $value
		$w tag configure $ftag -font [array get fopts]
		$w insert insert $new [concat $tagList $ftag]
	    }
	    set handled stop
	    break
	}
    }
    return $handled
}