Index: CHANGES.RSE =================================================================== RCS file: CHANGES.RSE diff -N CHANGES.RSE --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ CHANGES.RSE 16 Oct 2003 17:52:29 -0000 1.8 @@ -0,0 +1,25 @@ + + The following changes were made by Ralf S. Engelschall + to the excellent Curses::UI by Maurice Makaay . + + o Make sure that Curses::UI::Listbox draws the selected values in bold + also under "multi" and "radio" options to be consistent in look & + feel with the standard list box. + + o Add support for root->overlapping(1) (default) and + root->overlapping(0) to optimize the redrawing by reducing to + the old and new focused widgets. The default is still to redraw + everything which is necessary to support overlapping windows. + + o Add -reverse option to Curses::UI::TextEditor. + + o Fix reverse rendering for Label demo in demo-widgets. + + o Add -htmltext option to Curses::UI::Widget, corresponding + text_chop(), text_length() and text_draw() functions to + Curses::UI::Common and used the stuff in Curses::UI::Listbox + to allow in-line markup. + + o Fix top-level DESTROY (destructor) function to correctly + shutdown Curses and allow re-initializations. + Index: lib/Curses/UI.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI.pm,v retrieving revision 1.1.1.7 retrieving revision 1.11 diff -u -d -u -d -r1.1.1.7 -r1.11 --- lib/Curses/UI.pm 16 Oct 2003 17:51:37 -0000 1.1.1.7 +++ lib/Curses/UI.pm 16 Oct 2003 17:52:30 -0000 1.11 @@ -70,6 +70,7 @@ -debug => undef, # Turn on debugging mode? -language => undef, # Which language to use? -mouse_support => 1, # Do we want mouse support + -overlapping => 1, # Whether overlapping widgets are supported -color_support => 0, -default_colors=> 1, #user data @@ -114,8 +115,11 @@ DESTROY { my $this = shift; + my $scr = $this->{-canvasscr}; + $scr->delwin() if (defined($scr)); endwin(); $Curses::UI::rootobject = undef; + $Curses::UI::initialized = 0; if ($this->{-clear_on_exit}) { @@ -135,6 +139,7 @@ sub clear_on_exit(;$) { shift()->accessor('-clear_on_exit', shift()) } sub cursor_mode(;$) { shift()->accessor('-cursor_mode', shift()) } sub lang(;$) { shift()->accessor('-language_object', shift()) } +sub overlapping(;$) { shift()->accessor('-overlapping', shift()) } # TODO: document sub debug(;$) Index: lib/Curses/UI/Common.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Common.pm,v retrieving revision 1.1.1.3 retrieving revision 1.3 diff -u -d -u -d -r1.1.1.3 -r1.3 --- lib/Curses/UI/Common.pm 9 Oct 2003 18:09:43 -0000 1.1.1.3 +++ lib/Curses/UI/Common.pm 9 Oct 2003 18:10:02 -0000 1.3 @@ -35,6 +35,9 @@ @EXPORT = qw( keys_to_lowercase text_wrap + text_draw + text_length + text_chop scrlength split_to_lines text_dimension @@ -213,6 +216,125 @@ } return \@wrapped; +} + +sub text_tokenize { + my ($text) = @_; + + my @tokens = (); + while ($text ne '') { + if ($text =~ m/^<\/?[a-zA-Z0-9_]+>/s) { + push(@tokens, $&); + $text = $'; + } + elsif ($text =~ m/^.+?(?=<\/?[a-zA-Z0-9_]+>)/s) { + push(@tokens, $&); + $text = $'; + } + else { + push(@tokens, $text); + last; + } + } + return @tokens; +} + +sub text_draw($$;) +{ + my $this = shift; + my ($y, $x, $text) = @_; + + if ($this->{-htmltext}) { + my @tokens = &text_tokenize($text); + foreach my $token (@tokens) { + if ($token =~ m/^<(standout|reverse|bold|underline|blink|dim)>$/s) { + my $type = $1; + if ($type eq 'standout') { $this->{-canvasscr}->attron(A_STANDOUT); } + elsif ($type eq 'reverse') { $this->{-canvasscr}->attron(A_REVERSE); } + elsif ($type eq 'bold') { $this->{-canvasscr}->attron(A_BOLD); } + elsif ($type eq 'underline') { $this->{-canvasscr}->attron(A_UNDERLINE); } + elsif ($type eq 'blink') { $this->{-canvasscr}->attron(A_BLINK); } + elsif ($type eq 'dim') { $this->{-canvasscr}->attron(A_DIM); } + } + elsif ($token =~ m/^<\/(standout|reverse|bold|underline|blink|dim)>$/s) { + my $type = $1; + if ($type eq 'standout') { $this->{-canvasscr}->attroff(A_STANDOUT); } + elsif ($type eq 'reverse') { $this->{-canvasscr}->attroff(A_REVERSE); } + elsif ($type eq 'bold') { $this->{-canvasscr}->attroff(A_BOLD); } + elsif ($type eq 'underline') { $this->{-canvasscr}->attroff(A_UNDERLINE); } + elsif ($type eq 'blink') { $this->{-canvasscr}->attroff(A_BLINK); } + elsif ($type eq 'dim') { $this->{-canvasscr}->attroff(A_DIM); } + } + else { + $this->{-canvasscr}->addstr($y, $x, $token); + $x += length($token); + } + } + } + else { + $this->{-canvasscr}->addstr($y, $x, $text); + } +} + +sub text_length { + my $this = shift; + my ($text) = @_; + + my $length = 0; + if ($this->{-htmltext}) { + my @tokens = &text_tokenize($text); + foreach my $token (@tokens) { + if ($token !~ m/^<\/?(reverse|bold|underline|blink|dim)>$/s) { + $length += length($token); + } + } + } + else { + $length = length($text); + } + return $length; +} + +sub text_chop { + my $this = shift; + my ($text, $max_length) = @_; + + if ($this->{-htmltext}) { + my @open = (); + my @tokens = &text_tokenize($text); + my $length = 0; + $text = ''; + foreach my $token (@tokens) { + if ($token =~ m/^<(\/?)(reverse|bold|underline|blink|dim)>/s) { + my ($type, $name) = ($1, $2); + if (defined($type) and $type eq '/') { + pop(@open); + } + else { + push(@open, $name); + } + $text .= $token; + } + else { + $text .= $token; + $length += length($token); + if ($length > $max_length) { + $text = substr($text, 0, $max_length); + $text =~ s/.$/\$/; + while (defined($token = pop(@open))) { + $text .= ""; + } + last; + } + } + } + } + else { + if (length($text) > $max_length) { + $text = substr($text, 0, $max_length); + } + } + return $text; } sub text_dimension ($;) Index: lib/Curses/UI/Label.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Label.pm,v retrieving revision 1.1.1.4 retrieving revision 1.6 diff -u -d -u -d -r1.1.1.4 -r1.6 Index: lib/Curses/UI/Listbox.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Listbox.pm,v retrieving revision 1.1.1.5 retrieving revision 1.7 diff -u -d -u -d -r1.1.1.5 -r1.7 --- lib/Curses/UI/Listbox.pm 9 Oct 2003 18:09:41 -0000 1.1.1.5 +++ lib/Curses/UI/Listbox.pm 9 Oct 2003 18:10:02 -0000 1.7 @@ -303,10 +303,7 @@ (($this->{-multi} or $this->{-radio}) ? 4 : 0); # Chop length if needed. - if (($prefix_len + length($label)) > $this->canvaswidth) { - $label = substr($label, 0, ($this->canvaswidth-$prefix_len)); - $label =~ s/.$/\$/; - } + $label = $this->text_chop($label, ($this->canvaswidth-$prefix_len)); # Show current entry in reverse mode and # save cursor position. @@ -318,10 +315,12 @@ } # Show selected element bold. - if (not $this->{-multi} and - not $this->{-radio} and - defined $this->{-selected} and - $this->{-selected} == $i) { + if ( ( not $this->{-multi} + and defined $this->{-selected} + and $this->{-selected} == $i) + or ( $this->{-multi} + and defined $this->{-selected} + and $this->{-selected}->{$i}) ) { $this->{-canvasscr}->attron(A_BOLD); } @@ -332,10 +331,7 @@ ); # Show label - $this->{-canvasscr}->addstr( - $y, $prefix_len, - $label - ); + $this->text_draw($y, $prefix_len, $label); $this->{-canvasscr}->attroff(A_REVERSE); $this->{-canvasscr}->attroff(A_BOLD); Index: lib/Curses/UI/TextEditor.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/TextEditor.pm,v retrieving revision 1.1.1.6 retrieving revision 1.7 diff -u -d -u -d -r1.1.1.6 -r1.7 --- lib/Curses/UI/TextEditor.pm 16 Oct 2003 17:51:38 -0000 1.1.1.6 +++ lib/Curses/UI/TextEditor.pm 16 Oct 2003 17:51:55 -0000 1.7 @@ -151,6 +151,7 @@ -vscrollbar => 0, # show vertical scrollbar -hscrollbar => 0, # show horizontal scrollbar -readonly => 0, # only used as viewer? + -reverse => 0, # show in reverse # Single line options -password => undef, # masquerade chars with given char @@ -456,9 +457,10 @@ # Turn on underlines and fill the screen with lines # if neccessary. - if ($this->{-showlines}) + if ($this->{-showlines} or $this->{-reverse}) { - $this->{-canvasscr}->attron(A_UNDERLINE); + $this->{-canvasscr}->attron(A_UNDERLINE) if ($this->{-showlines});; + $this->{-canvasscr}->attron(A_REVERSE) if ($this->{-reverse}); for my $y (0..$this->canvasheight-1) { $this->{-canvasscr}->addstr($y, 0, " "x($this->canvaswidth)); } @@ -480,9 +482,11 @@ if (defined $this->{-search_highlight} and $this->{-search_highlight} == ($id+$this->{-yscrpos})) { - $this->{-canvasscr}->attron(A_REVERSE); + $this->{-canvasscr}->attron(A_REVERSE) if (not $this->{-reverse}); + $this->{-canvasscr}->attroff(A_REVERSE) if ($this->{-reverse}); } else { - $this->{-canvasscr}->attroff(A_REVERSE); + $this->{-canvasscr}->attroff(A_REVERSE) if (not $this->{-reverse}); + $this->{-canvasscr}->attron(A_REVERSE) if ($this->{-reverse}); } my $l = $this->{-scr_lines}->[$id + $this->{-yscrpos}]; @@ -576,6 +580,7 @@ } $this->{-canvasscr}->attroff(A_UNDERLINE) if $this->{-showlines}; + $this->{-canvasscr}->attroff(A_REVERSE) if $this->{-reverse}; $this->{-canvasscr}->noutrefresh(); doupdate() unless $no_doupdate; return $this; Index: lib/Curses/UI/Widget.pm =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Widget.pm,v retrieving revision 1.1.1.6 retrieving revision 1.9 diff -u -d -u -d -r1.1.1.6 -r1.9 --- lib/Curses/UI/Widget.pm 16 Oct 2003 17:51:38 -0000 1.1.1.6 +++ lib/Curses/UI/Widget.pm 16 Oct 2003 17:52:30 -0000 1.9 @@ -85,6 +85,7 @@ -onblur => undef, # onBlur event handler -intellidraw => 1, # Support intellidraw()? -focusable => 1, # This widget can get focus + -htmltext => 1, # Recognize HTML tags in drawn text #user data -userdata => undef, #user internal data @@ -482,7 +483,7 @@ my $parent = $this->parent; $parent->focus($this) if defined $parent; - $this->draw(1); + $this->draw(1) if ($this->root->overlapping); return $this; } @@ -1017,6 +1018,8 @@ my $show_cursor = $this->{-nocursor} ? 0 : 1; $this->root->cursor_mode($show_cursor); + $this->draw(1) if (not $this->root->overlapping); + return $this; } @@ -1025,6 +1028,7 @@ my $this = shift; $this->{-focus} = 0; $this->run_event('-onblur'); + $this->draw(1) if (not $this->root->overlapping); return $this; } Index: examples/demo-widgets =================================================================== RCS file: /u/rse/wrk/cui/cvs/cui/examples/demo-widgets,v retrieving revision 1.1.1.4 retrieving revision 1.9 diff -u -d -u -d -r1.1.1.4 -r1.9 --- examples/demo-widgets 1 Sep 2003 07:24:37 -0000 1.1.1.4 +++ examples/demo-widgets 16 Oct 2003 17:52:29 -0000 1.9 @@ -1,6 +1,11 @@ -#!/usr/bin/perl -w +#!/usr/lpkg/bin/perl -w use strict; use File::Temp qw( :POSIX ); +use lib "../lib"; + +# make KEY_BTAB (shift-tab) working in XTerm +# and also at the same time enable colors +#$ENV{TERM} = "xterm-vt220" if ($ENV{TERM} eq 'xterm'); my $debug = 0; if (@ARGV and $ARGV[0] eq '-d') { @@ -150,7 +155,7 @@ $w{1}->add(undef,'Label',-text=>"dim font",-y=>5,-dim=>1 ); $w{1}->add(undef,'Label',-text=>"bold font",-y=>7,-bold=>1 ); -$w{1}->add(undef,'Label',-text=>"reversed font",-y=>9,-reversed => 1 ); +$w{1}->add(undef,'Label',-text=>"reversed font",-y=>9,-reverse => 1 ); $w{1}->add(undef,'Label',-text=>"underlined font",-x=>15,-y=>5,-underline=>1 ); $w{1}->add(undef,'Label',-text=>"blinking font",-x=>15,-y=>7,-blink=>1 );