File: wrap.tcl

package info (click to toggle)
libapache2-mod-rivet 2.3.3-1
  • links: PTS
  • area: main
  • in suites: stretch
  • size: 5,156 kB
  • ctags: 1,093
  • sloc: xml: 7,696; tcl: 6,939; ansic: 5,682; sh: 4,862; makefile: 199; sql: 91; lisp: 78
file content (54 lines) | stat: -rw-r--r-- 1,725 bytes parent folder | download | duplicates (2)
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
###
##
## wrap - Split a string on newlines.  For each line, wrap the line at a space
## character to be equal to or shorter than the maximum length value passed.
##
## if a third argument called "-html" is present, the string is put together
## with html <br> line breaks, otherwise it's broken with newlines.
##
## $Id: wrap.tcl 1212149 2011-12-08 21:57:35Z mxmanghi $
##
###

namespace eval ::rivet {

    proc wrap {string maxlen {html ""}} {
        set splitstring {}
        foreach line [split $string "\n"] {
            lappend splitstring [wrapline $line $maxlen $html]
        }
        if {$html == "-html"} {
            return [join $splitstring "<br>"]
        } else {
            return [join $splitstring "\n"]
        }
    }

##
## wrapline -- Given a line and a maximum length and option "-html"
## argument, split the line into multiple lines by splitting on space
## characters and making sure each line is less than maximum length.
##
## If the third argument, "-html", is present, return the result with
## the lines separated by html <br> line breaks, otherwise the lines
## are returned separated by newline characters.
##
    proc wrapline {line maxlen {html ""}} {
        set string [split $line " "]
        set newline [list [lindex $string 0]]
        foreach word [lrange $string 1 end] {
            if {[string length $newline]+[string length $word] > $maxlen} {
                lappend lines [join $newline " "]
                set newline {}
            }
            lappend newline $word
        }
        lappend lines [join $newline " "]
        if {$html == "-html"} {
            return [join $lines <br>]
        } else {
            return [join $lines "\n"]
        }
    }

}