Ralf S. Engelschall 23 лет назад
Родитель
Сommit
8b9af2e321
2 измененных файлов с 335 добавлено и 10 удалено
  1. 333 8
      perl-curses/perl-curses.patch
  2. 2 2
      perl-curses/perl-curses.spec

+ 333 - 8
perl-curses/perl-curses.patch

@@ -1,33 +1,254 @@
+Index: CHANGES.RSE
+===================================================================
+RCS file: CHANGES.RSE
+diff -N CHANGES.RSE
+--- /dev/null	Thu Nov 21 21:15:00 2002
++++ /tmp/rse/cvsWYEhjj	Thu Nov 21 21:17:26 2002
+@@ -0,0 +1,19 @@
++
++  The following changes were made by Ralf S. Engelschall <rse@engelschall.com>
++  to the excellent Curses::UI 0.71 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.1
-diff -u -d -u -d -r1.1.1.1 UI.pm
+retrieving revision 1.2
+diff -u -d -u -d -r1.1.1.1 -r1.2
 --- lib/Curses/UI.pm	2002/11/20 15:00:33	1.1.1.1
-+++ lib/Curses/UI.pm	2002/11/20 15:12:54
-@@ -65,6 +65,7 @@
++++ lib/Curses/UI.pm	2002/11/21 18:14:03	1.2
+@@ -65,6 +65,8 @@
          -cursor_mode   => 0,     # What is the current cursor_mode?
  	-debug         => undef, # Turn on debugging mode?
  	-language      => undef, # Which language to use?
 +        -overlapping   => 1,     # Whether overlapping widgets are supported
++        -colors        => 0,     # Whether colors are used
  
          %userargs,
  
-@@ -118,6 +119,7 @@
+@@ -118,6 +120,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(;$)         
+@@ -128,6 +132,58 @@
+ }
+ 
+ # ----------------------------------------------------------------------
++# 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);
++        $Curses::UI::colorpair->{$name} = $n;
++        return $n;
++    }
++}
++
++# ----------------------------------------------------------------------
+ # Window resizing support
+ # ----------------------------------------------------------------------
+ 
+@@ -143,6 +199,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.1
+retrieving revision 1.2
+diff -u -d -u -d -r1.1.1.1 -r1.2
+--- lib/Curses/UI/Label.pm	2002/11/20 15:00:33	1.1.1.1
++++ lib/Curses/UI/Label.pm	2002/11/21 18:14:03	1.2
+@@ -50,6 +50,7 @@
+         -dim             => 0,
+         -blink           => 0,
+         -paddingspaces   => 0,        # Pad text with spaces?
++        -colorpair       => undef,    # Color-pair attribute
+         
+         %userargs,
+         
+@@ -103,6 +104,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($$;)
+ {
+@@ -182,6 +184,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.1
+retrieving revision 1.2
+diff -u -d -u -d -r1.1.1.1 -r1.2
+--- lib/Curses/UI/Listbox.pm	2002/11/20 15:00:33	1.1.1.1
++++ lib/Curses/UI/Listbox.pm	2002/11/21 18:14:03	1.2
+@@ -289,10 +289,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.1
+retrieving revision 1.2
+diff -u -d -u -d -r1.1.1.1 -r1.2
+--- lib/Curses/UI/TextEditor.pm	2002/11/20 15:00:34	1.1.1.1
++++ lib/Curses/UI/TextEditor.pm	2002/11/21 20:13:17	1.2
+@@ -150,6 +150,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
+@@ -450,9 +451,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));
+         }
+@@ -463,9 +465,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}];
+@@ -559,6 +563,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.1
-diff -u -d -u -d -r1.1.1.1 Widget.pm
+retrieving revision 1.2
+diff -u -d -u -d -r1.1.1.1 -r1.2
 --- lib/Curses/UI/Widget.pm	2002/11/20 15:00:33	1.1.1.1
-+++ lib/Curses/UI/Widget.pm	2002/11/20 15:41:37
++++ lib/Curses/UI/Widget.pm	2002/11/21 18:14:03	1.2
 @@ -460,7 +460,7 @@
      my $parent = $this->parent;
      $parent->focus($this) if defined $parent;
@@ -37,7 +258,68 @@ diff -u -d -u -d -r1.1.1.1 Widget.pm
      return $this;
  }
  
-@@ -943,6 +943,8 @@
+@@ -511,6 +511,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)
+@@ -520,10 +521,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(
+                 '|','|','-','-',
+@@ -533,6 +536,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})
+@@ -612,6 +616,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) {
+@@ -620,6 +625,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);
+@@ -677,6 +683,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);
+@@ -684,6 +691,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);
+@@ -943,6 +951,8 @@
      my $show_cursor = $this->{-nocursor} ? 0 : 1;
      $this->root->cursor_mode($show_cursor);
  
@@ -46,7 +328,7 @@ diff -u -d -u -d -r1.1.1.1 Widget.pm
      return $this;
  }
  
-@@ -951,6 +953,7 @@
+@@ -951,6 +961,7 @@
      my $this = shift;
      $this->{-focus} = 0;
      $this->run_event('-onblur');
@@ -54,3 +336,46 @@ diff -u -d -u -d -r1.1.1.1 Widget.pm
      return $this;
  }
  
+Index: examples/demo-widgets
+===================================================================
+RCS file: /u/rse/wrk/cui/cvs/cui/examples/demo-widgets,v
+retrieving revision 1.1.1.1
+retrieving revision 1.4
+diff -u -d -u -d -r1.1.1.1 -r1.4
+--- examples/demo-widgets	2002/11/20 15:00:36	1.1.1.1
++++ examples/demo-widgets	2002/11/21 20:14:59	1.4
+@@ -1,5 +1,10 @@
+-#!/usr/bin/perl -w
++#!/usr/lpkg/bin/perl -w
+ use strict;
++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 +24,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 +155,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

+ 2 - 2
perl-curses/perl-curses.spec

@@ -40,8 +40,8 @@ Packager:     The OpenPKG Project
 Distribution: OpenPKG [BASE]
 Group:        Language
 License:      GPL/Artistic
-Version:      20021120
-Release:      20021120
+Version:      20021121
+Release:      20021121
 
 #   list of sources
 Source0:      http://www.cpan.org/modules/by-module/Curses/Curses-%{V_curses}.tar.gz