You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

390 lines
14 KiB

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 <rse@engelschall.com>
+ to the excellent Curses::UI by Maurice Makaay <maurice@gitaar.net>.
+
+ 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 .= "</$token>";
+ }
+ 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 );