perl-curses.patch 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382
  1. Index: CHANGES.RSE
  2. ===================================================================
  3. RCS file: CHANGES.RSE
  4. diff -N CHANGES.RSE
  5. --- /dev/null Thu Nov 21 21:15:00 2002
  6. +++ /tmp/rse/cvsWYEhjj Thu Nov 21 21:17:26 2002
  7. @@ -0,0 +1,19 @@
  8. +
  9. + The following changes were made by Ralf S. Engelschall <rse@engelschall.com>
  10. + to the excellent Curses::UI 0.71 by Maurice Makaay <maurice@gitaar.net>.
  11. +
  12. + o Make sure that Curses::UI::Listbox draws the selected values in bold
  13. + also under "multi" and "radio" options to be consistent in look &
  14. + feel with the standard list box.
  15. +
  16. + o Add support for root->overlapping(1) (default) and
  17. + root->overlapping(0) to optimize the redrawing by reducing to
  18. + the old and new focused widgets. The default is still to redraw
  19. + everything which is necessary to support overlapping windows.
  20. +
  21. + o Add -reverse option to Curses::UI::TextEditor.
  22. +
  23. + o Add color support.
  24. +
  25. + o Fix reverse rendering for Label demo in demo-widgets.
  26. +
  27. Index: lib/Curses/UI.pm
  28. ===================================================================
  29. RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI.pm,v
  30. retrieving revision 1.1.1.1
  31. retrieving revision 1.2
  32. diff -u -d -u -d -r1.1.1.1 -r1.2
  33. --- lib/Curses/UI.pm 2002/11/20 15:00:33 1.1.1.1
  34. +++ lib/Curses/UI.pm 2002/11/21 18:14:03 1.2
  35. @@ -65,6 +65,8 @@
  36. -cursor_mode => 0, # What is the current cursor_mode?
  37. -debug => undef, # Turn on debugging mode?
  38. -language => undef, # Which language to use?
  39. + -overlapping => 1, # Whether overlapping widgets are supported
  40. + -colors => 0, # Whether colors are used
  41. %userargs,
  42. @@ -118,6 +120,8 @@
  43. sub clear_on_exit(;$) { shift()->accessor('-clear_on_exit', shift()) }
  44. sub cursor_mode(;$) { shift()->accessor('-cursor_mode', shift()) }
  45. sub lang(;$) { shift()->accessor('-language_object', shift()) }
  46. +sub overlapping(;$) { shift()->accessor('-overlapping', shift()) }
  47. +sub colors(;$) { shift()->accessor('-colors', shift()) }
  48. # TODO: document
  49. sub debug(;$)
  50. @@ -128,6 +132,58 @@
  51. }
  52. # ----------------------------------------------------------------------
  53. +# Color support
  54. +# ----------------------------------------------------------------------
  55. +
  56. +$Curses::UI::colorpairs = 0;
  57. +$Curses::UI::colorpair = {};
  58. +
  59. +sub colorpair ($$;$$)
  60. +{
  61. + my $this = shift;
  62. + my ($name, $fg, $bg) = @_;
  63. + my $colors_name2num = {
  64. + 'black' => COLOR_BLACK,
  65. + 'red' => COLOR_RED,
  66. + 'green' => COLOR_GREEN,
  67. + 'yellow' => COLOR_YELLOW,
  68. + 'blue' => COLOR_BLUE,
  69. + 'magenta' => COLOR_MAGENTA,
  70. + 'cyan' => COLOR_CYAN,
  71. + 'white' => COLOR_WHITE
  72. + };
  73. +
  74. + if (not $this->{-colors}) {
  75. + return 0;
  76. + }
  77. + if (not defined($fg) and not defined($bg)) {
  78. + return ($Curses::UI::colorpair->{$name} || 0);
  79. + }
  80. + else {
  81. + my $n = $Curses::UI::colorpair->{$name};
  82. + if (not defined($n)) {
  83. + $Curses::UI::colorpairs++;
  84. + $n = $Curses::UI::colorpairs;
  85. + }
  86. + $fg = $colors_name2num->{$fg} || 'default';
  87. + if ($fg eq 'default') {
  88. + my ($fg_d, $bg_d) = (0, 0);
  89. + pair_content(0, $fg_d, $bg_d);
  90. + $fg = $fg_d;
  91. + }
  92. + $bg = $colors_name2num->{$bg} || 'default';
  93. + if ($bg eq 'default') {
  94. + my ($fg_d, $bg_d) = (0, 0);
  95. + pair_content(0, $fg_d, $bg_d);
  96. + $bg = $bg_d;
  97. + }
  98. + init_pair($n, $fg, $bg);
  99. + $Curses::UI::colorpair->{$name} = $n;
  100. + return $n;
  101. + }
  102. +}
  103. +
  104. +# ----------------------------------------------------------------------
  105. # Window resizing support
  106. # ----------------------------------------------------------------------
  107. @@ -143,6 +199,23 @@
  108. initscr();
  109. noecho();
  110. raw();
  111. +
  112. + # Color support
  113. + if ($this->{-colors}) {
  114. + if (has_colors()) {
  115. + start_color();
  116. + #my $bg = -1;
  117. + #use_default_colors();
  118. + my $bg = COLOR_BLACK;
  119. + assume_default_colors(COLOR_WHITE, $bg);
  120. + $Curses::UI::colorpair->{"default"} = 0;
  121. + $Curses::UI::colorpairs = 1;
  122. + $this->colorpair('selected', 'default', 'default');
  123. + }
  124. + else {
  125. + $this->{-colors} = 0;
  126. + }
  127. + }
  128. # Mouse events if possible
  129. my $old = 0;
  130. Index: lib/Curses/UI/Label.pm
  131. ===================================================================
  132. RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Label.pm,v
  133. retrieving revision 1.1.1.1
  134. retrieving revision 1.2
  135. diff -u -d -u -d -r1.1.1.1 -r1.2
  136. --- lib/Curses/UI/Label.pm 2002/11/20 15:00:33 1.1.1.1
  137. +++ lib/Curses/UI/Label.pm 2002/11/21 18:14:03 1.2
  138. @@ -50,6 +50,7 @@
  139. -dim => 0,
  140. -blink => 0,
  141. -paddingspaces => 0, # Pad text with spaces?
  142. + -colorpair => undef, # Color-pair attribute
  143. %userargs,
  144. @@ -103,6 +104,7 @@
  145. sub underline ($;$) { shift()->set_attribute('-underline', shift()) }
  146. sub dim ($;$) { shift()->set_attribute('-dim', shift()) }
  147. sub blink ($;$) { shift()->set_attribute('-blink', shift()) }
  148. +sub colorpair ($;$) { shift()->set_attribute('-colorpair', shift()) }
  149. sub set_attribute($$;)
  150. {
  151. @@ -182,6 +184,7 @@
  152. $this->{-canvasscr}->attron(A_UNDERLINE) if $this->{-underline};
  153. $this->{-canvasscr}->attron(A_BLINK) if $this->{-blink};
  154. $this->{-canvasscr}->attron(A_DIM) if $this->{-dim};
  155. + $this->{-canvasscr}->attron(COLOR_PAIR($this->root->colorpair($this->{-colorpair}))) if $this->{-colorpair};
  156. # Draw the text. Clip it if it is too long.
  157. my $ypos = 0;
  158. Index: lib/Curses/UI/Listbox.pm
  159. ===================================================================
  160. RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Listbox.pm,v
  161. retrieving revision 1.1.1.1
  162. retrieving revision 1.2
  163. diff -u -d -u -d -r1.1.1.1 -r1.2
  164. --- lib/Curses/UI/Listbox.pm 2002/11/20 15:00:33 1.1.1.1
  165. +++ lib/Curses/UI/Listbox.pm 2002/11/21 18:14:03 1.2
  166. @@ -289,10 +289,12 @@
  167. }
  168. # Show selected element bold.
  169. - if (not $this->{-multi} and
  170. - not $this->{-radio} and
  171. - defined $this->{-selected} and
  172. - $this->{-selected} == $i) {
  173. + if ( ( not $this->{-multi}
  174. + and defined $this->{-selected}
  175. + and $this->{-selected} == $i)
  176. + or ( $this->{-multi}
  177. + and defined $this->{-selected}
  178. + and $this->{-selected}->{$i}) ) {
  179. $this->{-canvasscr}->attron(A_BOLD);
  180. }
  181. Index: lib/Curses/UI/TextEditor.pm
  182. ===================================================================
  183. RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/TextEditor.pm,v
  184. retrieving revision 1.1.1.1
  185. retrieving revision 1.2
  186. diff -u -d -u -d -r1.1.1.1 -r1.2
  187. --- lib/Curses/UI/TextEditor.pm 2002/11/20 15:00:34 1.1.1.1
  188. +++ lib/Curses/UI/TextEditor.pm 2002/11/21 20:13:17 1.2
  189. @@ -150,6 +150,7 @@
  190. -vscrollbar => 0, # show vertical scrollbar
  191. -hscrollbar => 0, # show horizontal scrollbar
  192. -readonly => 0, # only used as viewer?
  193. + -reverse => 0, # show in reverse
  194. # Single line options
  195. -password => undef, # masquerade chars with given char
  196. @@ -450,9 +451,10 @@
  197. # Turn on underlines and fill the screen with lines
  198. # if neccessary.
  199. - if ($this->{-showlines})
  200. + if ($this->{-showlines} or $this->{-reverse})
  201. {
  202. - $this->{-canvasscr}->attron(A_UNDERLINE);
  203. + $this->{-canvasscr}->attron(A_UNDERLINE) if ($this->{-showlines});;
  204. + $this->{-canvasscr}->attron(A_REVERSE) if ($this->{-reverse});
  205. for my $y (0..$this->canvasheight-1) {
  206. $this->{-canvasscr}->addstr($y, 0, " "x($this->canvaswidth));
  207. }
  208. @@ -463,9 +465,11 @@
  209. {
  210. if (defined $this->{-search_highlight}
  211. and $this->{-search_highlight} == ($id+$this->{-yscrpos})) {
  212. - $this->{-canvasscr}->attron(A_REVERSE);
  213. + $this->{-canvasscr}->attron(A_REVERSE) if (not $this->{-reverse});
  214. + $this->{-canvasscr}->attroff(A_REVERSE) if ($this->{-reverse});
  215. } else {
  216. - $this->{-canvasscr}->attroff(A_REVERSE);
  217. + $this->{-canvasscr}->attroff(A_REVERSE) if (not $this->{-reverse});
  218. + $this->{-canvasscr}->attron(A_REVERSE) if ($this->{-reverse});
  219. }
  220. my $l = $this->{-scr_lines}->[$id + $this->{-yscrpos}];
  221. @@ -559,6 +563,7 @@
  222. }
  223. $this->{-canvasscr}->attroff(A_UNDERLINE) if $this->{-showlines};
  224. + $this->{-canvasscr}->attroff(A_REVERSE) if $this->{-reverse};
  225. $this->{-canvasscr}->noutrefresh();
  226. doupdate() unless $no_doupdate;
  227. return $this;
  228. Index: lib/Curses/UI/Widget.pm
  229. ===================================================================
  230. RCS file: /u/rse/wrk/cui/cvs/cui/lib/Curses/UI/Widget.pm,v
  231. retrieving revision 1.1.1.1
  232. retrieving revision 1.2
  233. diff -u -d -u -d -r1.1.1.1 -r1.2
  234. --- lib/Curses/UI/Widget.pm 2002/11/20 15:00:33 1.1.1.1
  235. +++ lib/Curses/UI/Widget.pm 2002/11/21 18:14:03 1.2
  236. @@ -460,7 +460,7 @@
  237. my $parent = $this->parent;
  238. $parent->focus($this) if defined $parent;
  239. - $this->draw(1);
  240. + $this->draw(1) if ($this->root->overlapping);
  241. return $this;
  242. }
  243. @@ -511,6 +511,7 @@
  244. if ($this->{-sbborder}) # Square bracket ([,]) border
  245. {
  246. $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
  247. + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  248. my $offset = 1;
  249. $offset++ if $this->{-vscrollbar};
  250. for my $y (0 .. $this->{-sh}-1)
  251. @@ -520,10 +521,12 @@
  252. $this->{-borderscr}->addstr($rel_y, $this->{-bw}-$offset, ']');
  253. }
  254. $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
  255. + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  256. }
  257. elsif ($this->{-border}) # Normal border
  258. {
  259. $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
  260. + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  261. if ($this->root->compat) {
  262. $this->{-borderscr}->border(
  263. '|','|','-','-',
  264. @@ -533,6 +536,7 @@
  265. $this->{-borderscr}->box(ACS_VLINE, ACS_HLINE);
  266. }
  267. $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
  268. + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  269. # Draw a title if needed.
  270. if (defined $this->{-title})
  271. @@ -612,6 +616,7 @@
  272. # Draw the base of the scrollbar, in case
  273. # there is no border.
  274. $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
  275. + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  276. $this->{-borderscr}->move($ypos_min, $xpos);
  277. $this->{-borderscr}->vline(ACS_VLINE,$scrlen);
  278. if ($this->root->compat) {
  279. @@ -620,6 +625,7 @@
  280. $this->{-borderscr}->vline(ACS_VLINE,$scrlen);
  281. }
  282. $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
  283. + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  284. # Should an active region be drawn?
  285. my $scroll_active = ($this->{-vscrolllen} > $scrlen);
  286. @@ -677,6 +683,7 @@
  287. # Draw the base of the scrollbar, in case
  288. # there is no border.
  289. $this->{-borderscr}->attron(A_BOLD) if $this->{-focus};
  290. + $this->{-borderscr}->attron(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  291. $this->{-borderscr}->move($ypos, $xpos_min);
  292. if ($this->root->compat) {
  293. $this->{-borderscr}->hline('-',$scrlen);
  294. @@ -684,6 +691,7 @@
  295. $this->{-borderscr}->hline(ACS_HLINE,$scrlen);
  296. }
  297. $this->{-borderscr}->attroff(A_BOLD) if $this->{-focus};
  298. + $this->{-borderscr}->attroff(COLOR_PAIR($this->root->colorpair('selected'))) if $this->{-focus};
  299. # Should an active region be drawn?
  300. my $scroll_active = ($this->{-hscrolllen} > $scrlen);
  301. @@ -943,6 +951,8 @@
  302. my $show_cursor = $this->{-nocursor} ? 0 : 1;
  303. $this->root->cursor_mode($show_cursor);
  304. + $this->draw(1) if (not $this->root->overlapping);
  305. +
  306. return $this;
  307. }
  308. @@ -951,6 +961,7 @@
  309. my $this = shift;
  310. $this->{-focus} = 0;
  311. $this->run_event('-onblur');
  312. + $this->draw(1) if (not $this->root->overlapping);
  313. return $this;
  314. }
  315. Index: examples/demo-widgets
  316. ===================================================================
  317. RCS file: /u/rse/wrk/cui/cvs/cui/examples/demo-widgets,v
  318. retrieving revision 1.1.1.1
  319. retrieving revision 1.4
  320. diff -u -d -u -d -r1.1.1.1 -r1.4
  321. --- examples/demo-widgets 2002/11/20 15:00:36 1.1.1.1
  322. +++ examples/demo-widgets 2002/11/21 20:14:59 1.4
  323. @@ -1,5 +1,10 @@
  324. -#!/usr/bin/perl -w
  325. +#!/usr/lpkg/bin/perl -w
  326. use strict;
  327. +use lib "../lib";
  328. +
  329. +# make KEY_BTAB (shift-tab) working in XTerm
  330. +# and also at the same time enable colors
  331. +$ENV{TERM} = "xterm-vt220" if ($ENV{TERM} eq 'xterm');
  332. my $debug = 0;
  333. if (@ARGV and $ARGV[0] eq '-d') {
  334. @@ -19,7 +24,10 @@
  335. my $cui = new Curses::UI (
  336. -clear_on_exit => 1,
  337. -debug => $debug,
  338. + -colors => 1,
  339. );
  340. +$cui->colorpair('selected', 'red', 'default');
  341. +$cui->colorpair('white-on-red', 'white', 'red');
  342. # Demo index
  343. my $current_demo = 1;
  344. @@ -147,9 +155,10 @@
  345. $w{1}->add(undef,'Label',-text=>"dim font",-y=>5,-dim=>1 );
  346. $w{1}->add(undef,'Label',-text=>"bold font",-y=>7,-bold=>1 );
  347. -$w{1}->add(undef,'Label',-text=>"reversed font",-y=>9,-reversed => 1 );
  348. +$w{1}->add(undef,'Label',-text=>"reversed font",-y=>9,-reverse => 1 );
  349. $w{1}->add(undef,'Label',-text=>"underlined font",-x=>15,-y=>5,-underline=>1 );
  350. $w{1}->add(undef,'Label',-text=>"blinking font",-x=>15,-y=>7,-blink=>1 );
  351. +$w{1}->add(undef,'Label',-text=>"colorized font",-x=>15,-y=>9,-colorpair => 'white-on-red' );
  352. # ----------------------------------------------------------------------
  353. # Buttons demo