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	29 Mar 2003 10:43:45 -0000	1.6
@@ -0,0 +1,19 @@
+
+  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.
+
Index: lib/Curses/UI.pm
===================================================================
RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI.pm,v
retrieving revision 1.1.1.3
retrieving revision 1.5
diff -u -d -u -d -r1.1.1.3 -r1.5
--- lib/Curses/UI.pm	29 Mar 2003 10:41:56 -0000	1.1.1.3
+++ lib/Curses/UI.pm	29 Mar 2003 10:42:44 -0000	1.5
@@ -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
@@ -126,6 +128,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 +140,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 +210,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/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
retrieving revision 1.4
diff -u -d -u -d -r1.1.1.3 -r1.4
--- lib/Curses/UI/Listbox.pm	29 Mar 2003 10:41:56 -0000	1.1.1.3
+++ lib/Curses/UI/Listbox.pm	29 Mar 2003 10:42:44 -0000	1.4
@@ -304,10 +304,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);
             }
             
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
retrieving revision 1.4
diff -u -d -u -d -r1.1.1.3 -r1.4
--- lib/Curses/UI/Widget.pm	29 Mar 2003 10:41:57 -0000	1.1.1.3
+++ lib/Curses/UI/Widget.pm	29 Mar 2003 10:42:44 -0000	1.4
@@ -472,7 +472,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 +523,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 +533,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 +548,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 +632,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 +641,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 +699,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 +707,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 +967,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 +977,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.2
retrieving revision 1.5
diff -u -d -u -d -r1.1.1.2 -r1.5
--- examples/demo-widgets	29 Mar 2003 10:41:58 -0000	1.1.1.2
+++ examples/demo-widgets	29 Mar 2003 10:42:44 -0000	1.5
@@ -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') {
@@ -22,7 +27,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;
@@ -150,9 +158,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