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