openpkg-packages/perl-curses/perl-curses.patch

Index: CHANGES.RSE
===================================================================
RCS file: CHANGES.RSE
diff -N CHANGES.RSE
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ CHANGES.RSE	14 Apr 2003 10:18:10 -0000
@@ -0,0 +1,27 @@
+
+  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 Add color support.
+
+  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.4
diff -u -d -u -d -r1.1.1.4 UI.pm
--- lib/Curses/UI.pm	27 Apr 2003 18:42:07 -0000	1.1.1.4
+++ lib/Curses/UI.pm	27 Apr 2003 18:43:05 -0000
@@ -67,6 +67,8 @@
 	-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
+        -colors        => 0,     # Whether colors are used
 
         #user data
         -userdata       => undef,    #user internal data
@@ -106,8 +108,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})
     {
@@ -126,6 +131,8 @@
 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()) }
+sub colors(;$)        { shift()->accessor('-colors',          shift()) }
 
 # TODO: document
 sub debug(;$)         
@@ -136,6 +143,61 @@
 }
 
 # ----------------------------------------------------------------------
+# Color support
+# ----------------------------------------------------------------------
+
+$Curses::UI::colorpairs = 0;
+$Curses::UI::colorpair  = {};
+
+sub colorpair ($$;$$)
+{
+    my $this = shift;
+    my ($name, $fg, $bg) = @_;
+    my $colors_name2num = {
+        'black'   => COLOR_BLACK,
+        'red'     => COLOR_RED,
+        'green'   => COLOR_GREEN,
+        'yellow'  => COLOR_YELLOW,
+        'blue'    => COLOR_BLUE,
+        'magenta' => COLOR_MAGENTA,
+        'cyan'    => COLOR_CYAN,
+        'white'   => COLOR_WHITE
+    };
+
+    if (not $this->{-colors}) {
+        return 0;
+    }
+    if (not defined($fg) and not defined($bg)) {
+        return ($Curses::UI::colorpair->{$name} || 0);
+    }
+    else {
+        my $n = $Curses::UI::colorpair->{$name};
+        if (not defined($n)) {
+            $Curses::UI::colorpairs++;
+            $n = $Curses::UI::colorpairs;
+        }
+        $fg = $colors_name2num->{$fg} || 'default';
+        if ($fg eq 'default') {
+            my ($fg_d, $bg_d) = (0, 0);
+            pair_content(0, $fg_d, $bg_d);
+            $fg = $fg_d;
+        }
+        $bg = $colors_name2num->{$bg} || 'default';
+        if ($bg eq 'default') {
+            my ($fg_d, $bg_d) = (0, 0);
+            pair_content(0, $fg_d, $bg_d);
+            $bg = $bg_d;
+        }
+        init_pair($n, $fg, $bg);
+        if ($name eq 'default') {
+            assume_default_colors($fg, $bg);
+        }
+        $Curses::UI::colorpair->{$name} = $n;
+        return $n;
+    }
+}
+
+# ----------------------------------------------------------------------
 # Window resizing support
 # ----------------------------------------------------------------------
 
@@ -151,6 +213,23 @@
     initscr();
     noecho();
     raw();
+
+    # Color support
+    if ($this->{-colors}) {
+        if (has_colors()) {
+            start_color();
+            #my $bg = -1;
+            #use_default_colors();
+            my $bg = COLOR_BLACK;
+            assume_default_colors(COLOR_WHITE, $bg);
+            $Curses::UI::colorpair->{"default"} = 0;
+            $Curses::UI::colorpairs = 1;
+            $this->colorpair('selected', 'default', 'default');
+        }
+        else {
+            $this->{-colors} = 0;
+        }
+    }
 
     # Mouse events if possible
     my $old = 0;
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.2
diff -u -d -u -d -r1.1.1.2 Common.pm
--- lib/Curses/UI/Common.pm	28 Mar 2003 08:22:36 -0000	1.1.1.2
+++ lib/Curses/UI/Common.pm	13 Apr 2003 11:11:53 -0000
@@ -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.2
retrieving revision 1.3
diff -u -d -u -d -r1.1.1.2 -r1.3
--- lib/Curses/UI/Label.pm	28 Mar 2003 08:22:35 -0000	1.1.1.2
+++ lib/Curses/UI/Label.pm	28 Mar 2003 08:24:58 -0000	1.3
@@ -51,6 +51,7 @@
         -dim             => 0,
         -blink           => 0,
         -paddingspaces   => 0,        # Pad text with spaces?
+        -colorpair       => undef,    # Color-pair attribute
         
         %userargs,
         
@@ -104,6 +105,7 @@
 sub underline ($;$) { shift()->set_attribute('-underline', shift()) }
 sub dim ($;$)       { shift()->set_attribute('-dim', shift())       }
 sub blink ($;$)     { shift()->set_attribute('-blink', shift())     }
+sub colorpair ($;$) { shift()->set_attribute('-colorpair', shift()) }
 
 sub set_attribute($$;)
 {
@@ -183,6 +185,7 @@
     $this->{-canvasscr}->attron(A_UNDERLINE) if $this->{-underline};
     $this->{-canvasscr}->attron(A_BLINK)     if $this->{-blink};
     $this->{-canvasscr}->attron(A_DIM)       if $this->{-dim};
+    $this->{-canvasscr}->attron(COLOR_PAIR($this->root->colorpair($this->{-colorpair}))) if $this->{-colorpair};
 
     # Draw the text. Clip it if it is too long.
     my $ypos = 0;
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.3
diff -u -d -u -d -r1.1.1.3 Listbox.pm
--- lib/Curses/UI/Listbox.pm	29 Mar 2003 10:41:56 -0000	1.1.1.3
+++ lib/Curses/UI/Listbox.pm	13 Apr 2003 11:08:27 -0000
@@ -289,10 +289,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.
@@ -304,10 +301,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);
             }
             
@@ -318,10 +317,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.3
retrieving revision 1.4
diff -u -d -u -d -r1.1.1.3 -r1.4
--- lib/Curses/UI/TextEditor.pm	29 Mar 2003 10:41:57 -0000	1.1.1.3
+++ lib/Curses/UI/TextEditor.pm	29 Mar 2003 10:42:44 -0000	1.4
@@ -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
@@ -451,9 +452,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));
         }
@@ -464,9 +466,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}];
@@ -560,6 +564,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.3
diff -u -d -u -d -r1.1.1.3 Widget.pm
--- lib/Curses/UI/Widget.pm	29 Mar 2003 10:41:57 -0000	1.1.1.3
+++ lib/Curses/UI/Widget.pm	13 Apr 2003 11:14:54 -0000
@@ -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
@@ -472,7 +473,7 @@
     my $parent = $this->parent;
     $parent->focus($this) if defined $parent;
 
-    $this->draw(1);
+    $this->draw(1) if ($this->root->overlapping);
     return $this;
 }
 
@@ -523,6 +524,7 @@
         if ($this->{-sbborder})  # Square bracket ([,]) border
         {
         $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
         my $offset = 1;
         $offset++ if $this->{-vscrollbar};
         for my $y (0 .. $this->{-sh}-1)
@@ -532,10 +534,12 @@
             $this->{-borderscr}->addstr($rel_y, $this->{-bw}-$offset, ']');
         }
         $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
         }
         elsif ($this->{-border}) # Normal border
         {
         $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
         if ($this->root->compat) {
             $this->{-borderscr}->border(
                 '|','|','-','-',
@@ -545,6 +549,7 @@
             $this->{-borderscr}->box(ACS_VLINE, ACS_HLINE);
         }
         $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
         
         # Draw a title if needed.
         if (defined $this->{-title})
@@ -628,6 +633,7 @@
         # Draw the base of the scrollbar, in case
         # there is no border.
         $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
         $this->{-borderscr}->move($ypos_min, $xpos);
         $this->{-borderscr}->vline(ACS_VLINE,$scrlen);
         if ($this->root->compat) {
@@ -636,6 +642,7 @@
             $this->{-borderscr}->vline(ACS_VLINE,$scrlen);
         }
         $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
 
         # Should an active region be drawn?
         my $scroll_active = ($this->{-vscrolllen} > $scrlen);
@@ -693,6 +700,7 @@
         # Draw the base of the scrollbar, in case
         # there is no border.
         $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
         $this->{-borderscr}->move($ypos, $xpos_min);
         if ($this->root->compat) {
             $this->{-borderscr}->hline('-',$scrlen);
@@ -700,6 +708,7 @@
             $this->{-borderscr}->hline(ACS_HLINE,$scrlen);
         }
         $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
+        $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
 
         # Should an active region be drawn?
         my $scroll_active = ($this->{-hscrolllen} > $scrlen);
@@ -959,6 +968,8 @@
     my $show_cursor = $this->{-nocursor} ? 0 : 1;
     $this->root->cursor_mode($show_cursor);
 
+    $this->draw(1) if (not $this->root->overlapping);
+
     return $this;
 }
 
@@ -967,6 +978,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.3
diff -u -d -u -d -r1.1.1.3 demo-widgets
--- examples/demo-widgets	27 Apr 2003 18:42:10 -0000	1.1.1.3
+++ examples/demo-widgets	27 Apr 2003 18:43:05 -0000
@@ -1,5 +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') {
@@ -19,7 +25,10 @@
 my $cui = new Curses::UI ( 
     -clear_on_exit => 1, 
     -debug => $debug,
+    -colors => 1,
 );
+$cui->colorpair('selected', 'red', 'default');
+$cui->colorpair('white-on-red', 'white', 'red');
 
 # Demo index
 my $current_demo = 1;
@@ -147,9 +156,10 @@
 
 $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 );
+$w{1}->add(undef,'Label',-text=>"colorized font",-x=>15,-y=>9,-colorpair => 'white-on-red' );
 
 # ----------------------------------------------------------------------
 # Buttons demo