Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v diff -u -r1.34 -r1.35 --- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 26 Jan 2004 15:39:46 -0000 1.34 +++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 5 Feb 2004 17:05:43 -0000 1.35 @@ -124,7 +124,6 @@ regsub -all {[ \t]*\n} $text "\n" text # Wrap P's around paragraphs - set text "

$text

" regsub -all {([^\n\s])\n\n([^\n\s])} $text {\1

\2} text # Convert _single_ CRLF's to
's to preserve line breaks @@ -183,6 +182,8 @@ html_fragment {break_soft 0} {break_hard 0} + {ellipsis ""} + {more ""} } { Given an HTML fragment, this procedure will close any tags that have been left open. The optional arguments let you specify that @@ -207,6 +208,12 @@ @param break_hard the number of characters you want the html fragment truncated to. Will truncate, regardless of what tag is currently in action. + @param ellipsis This will get put at the end of the truncated string, if the string was truncated. + However, this counts towards the total string length, so that the returned string + including ellipsis is guaranteed to be shorter than the 'len' provided. + + @param more This will get put at the end of the truncated string, if the string was truncated. + @author Jeff Davis (davis@xarg.net) } { @@ -273,6 +280,18 @@ set nobr_tagptr 0 set nobr_len 0 + if { $break_soft > 0 } { + set break_soft [expr $break_soft - [string length $ellipsis]] + } + if { $break_hard > 0 } { + set break_hard [expr $break_hard - [string length $ellipsis]] + if { $break_soft == 0 } { + set break_soft $break_hard + } + } + + set broken_p 0 + set discard 0 set tagptr -1 @@ -306,6 +325,7 @@ # clip the last word regsub "\[^ \t\n\r]*$" $pretag {} pretag append out [string range $pretag 0 $break_soft] + set broken_p 1 break } elseif { $nobr && [expr [string length $pretag] + $out_len] > $break_hard } { # we are in a nonbreaking tag and are past the hard break @@ -318,6 +338,7 @@ # if zero length result would be the result... set out {} } + set broken_p 1 break } } @@ -419,7 +440,16 @@ # on exit of the look either we parsed it all or we truncated. # we should now walk the stack and close any open tags. - for {set i $tagptr} { $i > -1 } {incr i -1} { + # Chop off extra whitespace at the end + if { $broken_p } { + set end_index [expr [string length $out] -1] + while { $end_index >= 0 && [string is space [string index $out $end_index]] } { + incr end_index -1 + } + set out [string range $out 0 $end_index] + } + + for { set i $tagptr } { $i > -1 } { incr i -1 } { set tag $tagstack($i) # LARS: Only close tags which we aren't supposed to remove @@ -428,6 +458,11 @@ } } + if { $broken_p } { + append out $ellipsis + append out $more + } + return $out } @@ -668,12 +703,14 @@ return "The attribute '$attr_name' is not allowed for $tagname tags" } - if { [regexp {^\s*([^\s:]+):} $attr_value match protocol] } { - if { ![info exists allowed_protocol([string tolower $protocol])] && ![info exists allowed_protocol(*)] } { - return "Your URLs can only use these protocols: [join $allowed_protocols_list ", "]. + if { ![string equal [string tolower $attr_name] "style"] } { + if { [regexp {^\s*([^\s:]+):} $attr_value match protocol] } { + if { ![info exists allowed_protocol([string tolower $protocol])] && ![info exists allowed_protocol(*)] } { + return "Your URLs can only use these protocols: [join $allowed_protocols_list ", "]. You have a '$protocol' protocol in there." - } - } + } + } + } } } } @@ -1226,6 +1263,9 @@ {-from text/plain} {-to text/html} {-maxlen 70} + {-truncate_len 70} + {-ellipsis "..."} + {-more ""} text } { Converts a chunk of text from a variety of formats to either @@ -1262,8 +1302,16 @@

  • text/html
    • - @param maxlen the maximum line width when generating text/plain + @param maxlen The maximum line width when generating text/plain + + @param truncate_len The maximum total length of the output, included ellipsis. + @param ellipsis This will get put at the end of the truncated string, if the string was truncated. + However, this counts towards the total string length, so that the returned string + including ellipsis is guaranteed to be shorter than the 'truncate_len' provided. + + @param more This will get put at the end of the truncated string, if the string was truncated. + @author Lars Pind (lars@pinds.com) @creation-date 19 July 2000 } { @@ -1297,7 +1345,7 @@ set text [ad_enhanced_text_to_html $text] } text/plain { - set text [ad_enhanced_text_to_plain_text -- $text] + set text [ad_enhanced_text_to_plain_text -maxlen $maxlen -- $text] } } } @@ -1324,7 +1372,7 @@ text/html { switch $to { text/html { - set text [util_close_html_tags $text] + # Handled below } text/plain { set text [ad_html_to_text -maxlen $maxlen -- $text] @@ -1333,6 +1381,16 @@ } } + # Handle closing of HTML tags, truncation + switch $to { + text/html { + set text [util_close_html_tags $text $truncate_len $truncate_len $ellipsis $more] + } + text/plain { + set text [string_truncate -ellipsis $ellipsis -more $more -len $truncate_len -- $text] + } + } + return $text } @@ -1343,7 +1401,7 @@ @author Lars Pind (lars@pinds.com) @creation-date 2003-01-27 } { - return [ad_text_to_html -no_quote -includes_html -- [util_close_html_tags $text]] + return [ad_text_to_html -no_quote -includes_html -- $text] } ad_proc -public ad_enhanced_text_to_plain_text { @@ -1437,42 +1495,58 @@ ad_proc -public string_truncate { {-len 200} - {-format html} - {-no_format:boolean} {-ellipsis "..."} + {-more ""} string } { Truncates a string to len characters (defaults to the - parameter TruncateDescriptionLength), adding an ellipsis (...) if the + parameter TruncateDescriptionLength), adding the string provided in the ellipsis parameter if the string was truncated. If format is html (default), any open HTML tags are closed. Otherwise, it's converted to text using ad_html_to_text. + The length of the resulting string, including the ellipsis, is guaranteed to be within the len specified. + Should always be called as string_truncate [-flags ...] -- string - since otherwise strings which start with a - will treated as missing arguments. + since otherwise strings which start with a - will treated as switches, and will cause an error. - @param len The lenght to truncate to. Defaults to parameter TruncateDescriptionLength. - @param format html or text. - @param no_format causes hyperlink tags not to get listed at the end of the output. - @param string The string to truncate. + @param len The lenght to truncate to. If zero, no truncation will occur. + + @param ellipsis This will get put at the end of the truncated string, if the string was truncated. + However, this counts towards the total string length, so that the returned string + including ellipsis is guaranteed to be shorter than the 'len' provided. + + @param more This will get put at the end of the truncated string, if the string was truncated. + + @param string The string to truncate. + @return The truncated string, with HTML tags cloosed or converted to text, depending on format. @author Lars Pind (lars@pinds.com) @creation-date September 8, 2002 } { - if { [string length $string] > $len } { - set string "[string range $string 0 [expr $len-[string length $ellipsis]-1]]$ellipsis" - } - - if { [string equal $format "html"] && !$no_format_p } { - set string [util_close_html_tags $string] - } else { - if { $no_format_p } { - set string [ad_html_to_text -no_format -- $string] - } else { - set string [ad_html_to_text -- $string] - } + if { $len > 0 } { + if { [string length $string] > $len } { + set end_index [expr $len-[string length $ellipsis]-1] + + # Back up to the nearest whitespace + if { ![string is space [string index $string [expr $end_index + 1]]] } { + while { $end_index >= 0 && ![string is space [string index $string $end_index]] } { + incr end_index -1 + } + } + + # Chop off extra whitespace at the end + while { $end_index >= 0 && [string is space [string index $string $end_index]] } { + incr end_index -1 + } + + set string [string range $string 0 $end_index] + + append string $ellipsis + append string $more + } } return $string } Index: openacs-4/packages/acs-tcl/tcl/test/html-conversion-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/html-conversion-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-tcl/tcl/test/html-conversion-procs.tcl 26 Jan 2004 15:39:46 -0000 1.3 +++ openacs-4/packages/acs-tcl/tcl/test/html-conversion-procs.tcl 5 Feb 2004 17:05:43 -0000 1.4 @@ -55,4 +55,88 @@ } { set html "An Link" aa_true "href is allowed for A tags" [string equal [ad_html_security_check $html] ""] -} \ No newline at end of file +} + +aa_register_case util_close_html_tags { + Tests closing HTML tags. +} { + aa_equals "" [util_close_html_tags "Foobar"] "Foobar" + + aa_equals "" [util_close_html_tags "Foobar"] "Foobar" + + aa_equals "" [util_close_html_tags "Foobar is a very long word"] "Foobar is a very long word" + + aa_equals "" [util_close_html_tags "Foobar is a very long word" 15] "Foobar is a" + + aa_equals "" [util_close_html_tags "Foobar is a very long word" 0 20 "..."] "Foobar is a very..." +} + + +aa_register_case ad_html_text_convert { + Testing ad_html_text_convert. +} { + #---------------------------------------------------------------------- + # text/enhanced + #---------------------------------------------------------------------- + + set string "What?\nNever mind, buddy" + + aa_equals "" [ad_html_text_convert -from "text/enhanced" -to "text/html" -truncate_len 14 -- $string] \ + [ad_enhanced_text_to_html "What?\nNever..."] + + # The string is longer in plaintext, because the "_" symbol to denote italics is counted as well. + aa_equals "" [ad_html_text_convert -from "text/enhanced" -to "text/plain" -truncate_len 15 -- $string] "What?\n_Never..." + + #---------------------------------------------------------------------- + # text/plain + #---------------------------------------------------------------------- + + set string "What?\nNever mind, buddy" + + aa_equals "" [ad_html_text_convert -from "text/plain" -to "text/html" -truncate_len 14 -- $string] \ + [ad_text_to_html "What?\nNever..."] + + aa_equals "" [ad_html_text_convert -from "text/plain" -to "text/plain" -truncate_len 14 -- $string] \ + "What?\nNever..." + + #---------------------------------------------------------------------- + # text/fixed-width + #---------------------------------------------------------------------- + + set string "What?\nNever mind, buddy" + + aa_equals "" [ad_html_text_convert -from "text/fixed-width" -to "text/html" -truncate_len 14 -- $string] \ + "
    What?\nNever
    ..." + + aa_equals "" [ad_html_text_convert -from "text/fixed-width" -to "text/plain" -truncate_len 14 -- $string] \ + "What?\nNever..." + + + #---------------------------------------------------------------------- + # text/html + #---------------------------------------------------------------------- + + set string "What?
    Never mind, buddy" + + aa_equals "" [ad_html_text_convert -from "text/html" -to "text/html" -truncate_len 14 -- $string] \ + "What?
    Never..." + + aa_equals "" [ad_html_text_convert -from "text/html" -to "text/plain" -truncate_len 15 -- $string] \ + "What?\n_Never..." + + +} + +aa_register_case string_truncate { + Testing string truncation +} { + aa_equals "" [string_truncate -len 5 -ellipsis "" -- "foobar greble"] "" + aa_equals "" [string_truncate -len 6 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 7 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 8 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 9 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 10 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 11 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 12 -ellipsis "" -- "foobar greble"] "foobar" + aa_equals "" [string_truncate -len 13 -ellipsis "" -- "foobar greble"] "foobar greble" +}