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	1 Sep 2003 07:33:15 -0000
@@ -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.5
diff -u -d -u -d -r1.1.1.5 UI.pm
--- lib/Curses/UI.pm	1 Sep 2003 07:24:35 -0000	1.1.1.5
+++ lib/Curses/UI.pm	1 Sep 2003 07:33:38 -0000
@@ -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.2
retrieving revision 1.2
diff -u -d -u -d -r1.1.1.2 -r1.2
--- lib/Curses/UI/Common.pm	28 Mar 2003 08:22:36 -0000	1.1.1.2
+++ lib/Curses/UI/Common.pm	1 Sep 2003 07:29:04 -0000	1.2
@@ -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/Listbox.pm
===================================================================
RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Listbox.pm,v
retrieving revision 1.1.1.4
retrieving revision 1.6
diff -u -d -u -d -r1.1.1.4 -r1.6
--- lib/Curses/UI/Listbox.pm	1 Sep 2003 07:24:35 -0000	1.1.1.4
+++ lib/Curses/UI/Listbox.pm	1 Sep 2003 07:29:04 -0000	1.6
@@ -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.4
retrieving revision 1.5
diff -u -d -u -d -r1.1.1.4 -r1.5
--- lib/Curses/UI/TextEditor.pm	1 Sep 2003 07:24:36 -0000	1.1.1.4
+++ lib/Curses/UI/TextEditor.pm	1 Sep 2003 07:27:51 -0000	1.5
@@ -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.4
diff -u -d -u -d -r1.1.1.4 Widget.pm
--- lib/Curses/UI/Widget.pm	1 Sep 2003 07:24:35 -0000	1.1.1.4
+++ lib/Curses/UI/Widget.pm	1 Sep 2003 07:32:21 -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
@@ -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
diff -u -d -u -d -r1.1.1.4 demo-widgets
--- examples/demo-widgets	1 Sep 2003 07:24:37 -0000	1.1.1.4
+++ examples/demo-widgets	1 Sep 2003 07:30:05 -0000
@@ -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 );