1# ---------------------------------------------------------------------- 2# Curses::UI::Searchable 3# Curses::UI::SearchEntry 4# 5# (c) 2001-2002 by Maurice Makaay. All rights reserved. 6# This file is part of Curses::UI. Curses::UI is free software. 7# You can redistribute it and/or modify it under the same terms 8# as perl itself. 9# 10# Currently maintained by Marcus Thiesen 11# e-mail: marcus@cpan.thiesenweb.de 12# ---------------------------------------------------------------------- 13 14# TODO: fix dox 15 16# ---------------------------------------------------------------------- 17# SearchEntry package 18# ---------------------------------------------------------------------- 19 20package Curses::UI::SearchEntry; 21 22use Curses; 23use Curses::UI::Widget; # For height_by_windowscrheight() 24use Curses::UI::Common; 25use Curses::UI::Container; 26 27use vars qw( 28 $VERSION 29 @ISA 30); 31 32$VERSION = "1.10"; 33 34@ISA = qw( 35 Curses::UI::ContainerWidget 36); 37 38sub new() 39{ 40 my $class = shift; 41 42 my %userargs = @_; 43 keys_to_lowercase(\%userargs); 44 45 my %args = ( 46 -prompt => '/', # The initial search prompt 47 48 %userargs, 49 50 -x => 0, 51 -y => -1, 52 -width => undef, 53 -border => 0, 54 -sbborder => 0, 55 -showlines => 0, 56 -focus => 0, 57 ); 58 59 # The windowscr height should be 1. 60 $args{-height} = height_by_windowscrheight(1,%args); 61 62 my $this = $class->SUPER::new(%args); 63 64 my $entry = $this->add( 65 'entry', 'TextEntry', 66 -x => 1, 67 -y => 0, 68 -height => 1, 69 -border => 0, 70 -sbborder => 0, 71 -showlines => 0, 72 -width => undef, 73 -intellidraw => 0, 74 ); 75 76 $this->add( 77 'prompt', 'Label', 78 -x => 0, 79 -y => 0, 80 -height => 1, 81 -width => 2, 82 -border => 0, 83 -text => $this->{-prompt}, 84 -intellidraw => 0, 85 ); 86 87 $entry->set_routine('loose-focus', \&entry_loose_focus); 88 89 $this->layout; 90 91 return $this; 92} 93 94sub entry_loose_focus() 95{ 96 my $this = shift; 97 $this->parent->loose_focus; 98} 99 100sub event_keypress($;) 101{ 102 my $this = shift; 103 my $key = shift; 104 105 my $entry = $this->getobj('entry'); 106 if ($entry->{-focus}) { 107 $this->getobj('entry')->event_keypress($key); 108 } else { 109 $this->{-key} = $key; 110 } 111 112 return $this; 113} 114 115sub get() 116{ 117 my $this = shift; 118 $this->getobj('entry')->get; 119} 120 121sub pos(;$) 122{ 123 my $this = shift; 124 my $pos = shift; 125 $this->getobj('entry')->pos($pos); 126} 127 128sub text(;$) 129{ 130 my $this = shift; 131 my $text = shift; 132 $this->getobj('entry')->text($text); 133} 134 135sub prompt(;$) 136{ 137 my $this = shift; 138 my $prompt = shift; 139 if (defined $prompt) 140 { 141 $prompt = substr($prompt, 0, 1); 142 $this->{-prompt} = $prompt; 143 $this->getobj('prompt')->text($prompt); 144 $this->intellidraw; 145 return $this; 146 } else { 147 return $this->{-prompt}; 148 } 149} 150 151# Let Curses::UI->usemodule() believe that this module 152# was already loaded (usemodule() would else try to 153# require the non-existing file). 154# 155$INC{'Curses/UI/SearchEntry.pm'} = $INC{'Curses/UI/Searchable.pm'}; 156 157 158# ---------------------------------------------------------------------- 159# Searchable package 160# ---------------------------------------------------------------------- 161 162package Curses::UI::Searchable; 163 164use strict; 165use Curses; 166use Curses::UI::Common; 167require Exporter; 168 169use vars qw( 170 $VERSION 171 @ISA 172 @EXPORT 173); 174 175$VERSION = '1.10'; 176 177@ISA = qw( 178 Exporter 179); 180 181@EXPORT = qw( 182 search_forward 183 search_backward 184 search 185 search_next 186); 187 188sub search_forward() 189{ 190 my $this = shift; 191 $this->search("/", +1); 192} 193 194sub search_backward() 195{ 196 my $this = shift; 197 $this->search("?", -1); 198} 199 200sub search() 201{ 202 my $this = shift; 203 my $prompt = shift || ':'; 204 my $direction = shift || +1; 205 206 $this->change_canvasheight(-1); 207 $this->draw; 208 209 my $querybox = new Curses::UI::SearchEntry( 210 -parent => $this, 211 -prompt => $prompt, 212 ); 213 214 my $old_cursor_mode = $this->root->cursor_mode; 215 $this->root->cursor_mode(1); 216 $querybox->getobj('entry')->{-focus} = 1; 217 $querybox->draw; 218 $querybox->modalfocus(); 219 $querybox->getobj('entry')->{-focus} = 0; 220 221 my $query = $querybox->get; 222 $querybox->prompt(':'); 223 $querybox->draw; 224 225 my $key; 226 if ($query ne '') 227 { 228 my ($newidx, $wrapped) = 229 $this->search_next($query, $direction); 230 231 KEY: for (;;) 232 { 233 unless (defined $newidx) { 234 $querybox->text('Not found'); 235 } else { 236 $querybox->text($wrapped ? 'Wrapped' : ''); 237 } 238 $querybox->pos(0); 239 $querybox->draw; 240 241 $querybox->{-key} = '-1'; 242 while ($querybox->{-key} eq '-1') { 243 $this->root->do_one_event($querybox); 244 } 245 246 if ($querybox->{-key} eq 'n') { 247 ($newidx, $wrapped) = 248 $this->search_next($query, $direction); 249 } elsif ($querybox->{-key} eq 'N') { 250 ($newidx, $wrapped) = 251 $this->search_next($query, -$direction); 252 } else { 253 last KEY; 254 } 255 } 256 } 257 258 # Restore the screen. 259 $this->root->cursor_mode($old_cursor_mode); 260 $this->change_canvasheight(+1); 261 $this->draw; 262 263 $this->root->feedkey($querybox->{-key}); 264 return $this; 265} 266 267sub search_next($$;) 268{ 269 my $this = shift; 270 my $query = shift; 271 my $direction = shift; 272 $direction = ($direction > 0 ? +1 : -1); 273 $this->search_get($query, $direction); 274} 275 276sub change_canvasheight($;) 277{ 278 my $this = shift; 279 my $change = shift; 280 281 if ($change < 0) 282 { 283 # Change the canvasheight, so we can fit in the searchline. 284 $this->{-sh}--; 285 $this->{-yscrpos}++ 286 if ($this->{-ypos}-$this->{-yscrpos} == $this->canvasheight); 287 } 288 elsif ($change > 0) 289 { 290 # Restore the canvasheight. 291 $this->{-sh}++; 292 my $inscreen = ($this->canvasheight 293 - ($this->number_of_lines 294 - $this->{-yscrpos})); 295 while ($this->{-yscrpos} > 0 and 296 $inscreen < $this->canvasheight) 297 { 298 $this->{-yscrpos}--; 299 $inscreen = ($this->canvasheight 300 - ($this->number_of_lines 301 - $this->{-yscrpos})); 302 } 303 } 304 305 $this->{-search_highlight} = undef; 306 $this->layout_content(); 307} 308 309sub search_get($$;) 310{ 311 my $this = shift; 312 my $query = shift; 313 my $direction = shift || +1; 314 315 my $startpos = $this->{-ypos}; 316 my $offset = 0; 317 my $wrapped = 0; 318 for (;;) 319 { 320 # Find the line position to match. 321 $offset += $direction; 322 my $newpos = $this->{-ypos} + $offset; 323 324 my $last_idx = $this->number_of_lines - 1; 325 326 # Beyond limits? 327 if ($newpos < 0) 328 { 329 $newpos = $last_idx; 330 $offset = $newpos - $this->{-ypos}; 331 $wrapped = 1; 332 } 333 334 if ($newpos > $last_idx) 335 { 336 $newpos = 0; 337 $offset = $newpos - $this->{-ypos}; 338 $wrapped = 1; 339 } 340 341 # Nothing found? 342 return (undef,undef) if $newpos == $startpos; 343 344 if ($this->getline_at_ypos($newpos) =~ /\Q$query/i) 345 { 346 $this->{-ypos} = $newpos; 347 $this->{-search_highlight} = $newpos; 348 $startpos = $newpos; 349 $this->layout_content; 350 $this->draw(1); 351 return $newpos, $wrapped; 352 $wrapped = 0; 353 } 354 } 355} 356 357 358 3591; 360 361 362=pod 363 364=head1 NAME 365 366Curses::UI::Searchable - Add 'less'-like search abilities to a widget 367 368=head1 CLASS HIERARCHY 369 370 Curses::UI::Searchable - base class 371 372 373=head1 SYNOPSIS 374 375 package MyWidget; 376 377 use Curses::UI::Searchable; 378 use vars qw(@ISA); 379 @ISA = qw(Curses::UI::Searchable); 380 381 .... 382 383 sub new () { 384 # Create class instance $this. 385 .... 386 387 $this->set_routine('search-forward', \&search_forward); 388 $this->set_binding('search-forward', '/'); 389 $this->set_routine('search-backward', \&search_backward); 390 $this->set_binding('search-backward', '?'); 391 } 392 393 sub layout_content() { 394 my $this = shift; 395 396 # Layout your widget's content. 397 .... 398 399 return $this; 400 } 401 402 sub number_of_lines() { 403 my $this = shift; 404 405 # Return the number of lines in 406 # the widget's content. 407 return .... 408 } 409 410 sub getline_at_ypos($;) { 411 my $this = shift; 412 my $ypos = shift; 413 414 # Return the content on the line 415 # where ypos = $ypos 416 return .... 417 } 418 419 420=head1 DESCRIPTION 421 422Using Curses::UI::Searchable, you can add 'less'-like 423search capabilities to your widget. 424 425To make your widget searchable using this class, 426your widget should meet the following requirements: 427 428=over 4 429 430=item * B<make it a descendant of Curses::UI::Searchable> 431 432All methods for searching are in Curses::UI::Searchable. 433By making your class a descendant of this class, these 434methods are automatically inherited. 435 436=item * B<-ypos data member> 437 438The current vertical position in the widget should be 439identified by $this->{-ypos}. This y-position is the 440index of the line of content. Here's an example for 441a Listbox widget. 442 443 -ypos 444 | 445 v 446 +------+ 447 0 |One | 448 1 |Two | 449 2 |Three | 450 +------+ 451 452=item * B<method: number_of_lines ( )> 453 454Your widget class should have a method B<number_of_lines>, 455which returns the total number of lines in the widget's 456content. So in the example above, this method would 457return the value 3. 458 459=item * B<method: getline_at_ypos ( YPOS )> 460 461Your widget class should have a method B<getline_at_ypos>, 462which returns the line of content at -ypos YPOS. 463So in the example above, this method would return 464the value "Two" for YPOS = 1. 465 466=item * B<method: layout_content ( )> 467 468The search routines will set the -ypos of your widget if a 469match is found for the given search string. Your B<layout_content> 470routine should make sure that the line of content at -ypos 471will be made visible if the B<draw> method is called. 472 473=item * B<method: draw ( )> 474 475If the search routines find a match, $this->{-search_highlight} 476will be set to the -ypos for the line on which the match 477was found. If no match was found $this->{-search_highlight} 478will be undefined. If you want a matching line to be highlighted, 479in your widget, you can use this data member to do so 480(an example of a widget that uses this option is the 481L<Curses::UI::TextViewer|Curses::UI::TextViewer> widget). 482 483=item * B<bindings for searchroutines> 484 485There are two search routines. These are B<search_forward> and 486B<search_backward>. These have to be called in order to 487display the search prompt. The best way to do this is by 488creating bindings for them. Here's an example which will 489make '/' a forward search and '?' a backward search: 490 491 $this->set_routine('search-forward' , \&search_forward); 492 $this->set_binding('search-forward' , '/'); 493 $this->set_routine('search-backward' , \&search_backward); 494 $this->set_binding('search-backward' , '?'); 495 496=back 497 498 499 500=head1 SEE ALSO 501 502L<Curses::UI|Curses::UI>, 503 504 505 506 507=head1 AUTHOR 508 509Copyright (c) 2001-2002 Maurice Makaay. All rights reserved. 510 511Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de) 512 513 514This package is free software and is provided "as is" without express 515or implied warranty. It may be used, redistributed and/or modified 516under the same terms as perl itself. 517 518