1#!/usr/bin/env perl 2# 3########################################################################## 4# @(#) App::PFM::Screen 0.62 5# 6# Name: App::PFM::Screen 7# Version: 0.62 8# Author: Rene Uittenbogaard 9# Created: 1999-03-14 10# Date: 2012-05-10 11# Requires: Term::ScreenColor 12# 13 14########################################################################## 15 16=pod 17 18=head1 NAME 19 20App::PFM::Screen 21 22=head1 DESCRIPTION 23 24PFM class used for coordinating how all elements are displayed on screen. 25This class extends B<Term::ScreenColor>. 26 27=head1 METHODS 28 29=over 30 31=cut 32 33########################################################################## 34# declarations 35 36package App::PFM::Screen; 37 38use base qw(App::PFM::Abstract Term::ScreenColor Exporter); 39 40use App::PFM::Screen::Listing; 41use App::PFM::Screen::Diskinfo qw(:constants); # imports the LINE_* constants 42use App::PFM::Screen::Frame qw(:constants); # imports the MENU_*, HEADING_* 43 # and FOOTER_* constants 44use App::PFM::Util qw(fitpath max); 45use App::PFM::Event; 46 47use POSIX qw(getcwd); 48 49use strict; 50use locale; 51 52use constant { 53 BRACKETED_PASTE_START => 'kpaste[', 54 BRACKETED_PASTE_END => 'kpaste]', 55 BRACKETED_SCRAP => 'kpaste[]', 56 MOUSE_BUTTON_LEFT => 0, 57 MOUSE_BUTTON_MIDDLE => 1, 58 MOUSE_BUTTON_RIGHT => 2, 59 MOUSE_BUTTON_UP => 3, 60 MOUSE_BUTTON_MOTION => 32, 61 MOUSE_MODIFIER_SHIFT => 4, 62 MOUSE_MODIFIER_META => 8, 63 MOUSE_MODIFIER_CONTROL => 16, 64 MOUSE_WHEEL_UP => 64, 65 MOUSE_WHEEL_DOWN => 65, 66 DEVICE_SPEC_START => '[', 67 DEVICE_SPEC_END => ']', 68 PATH_PHYSICAL => 1, 69 ERRORDELAY => 1, # in seconds (fractions allowed) 70 IMPORTANTDELAY => 2, # extra time for important errors 71 PATHLINE => 1, 72 HEADINGLINE => 2, 73 BASELINE => 3, 74 R_NOP => 0, # no action was required, wait for new key 75 R_STRIDE => 1, # validate cursor position (always done) 76 R_MENU => 2, # reprint the menu 77 R_PATHINFO => 4, # reprint the pathinfo 78 R_HEADINGS => 8, # reprint the headings 79 R_FOOTER => 16, # reprint the footer 80# R_FRAME # R_MENU + R_PATHINFO + R_HEADINGS + R_FOOTER 81 R_DISKINFO => 32, # reprint the disk- and directory info column 82 R_LISTING => 128, # redisplay directory listing 83# R_SCREEN # R_LISTING + R_DISKINFO + R_FRAME 84 R_CLEAR => 512, # clear the screen 85# R_CLRSCR # R_CLEAR + R_SCREEN 86 R_ALTERNATE => 1024, # switch screens according to 'altscreen_mode' 87 R_NEWDIR => 8192, # re-init directory-specific vars 88# R_CHDIR # R_NEWDIR + R_SCREEN + R_STRIDE 89}; 90 91# needs new invocations because of the calculations 92use constant R_FRAME => R_MENU | R_PATHINFO | R_HEADINGS | R_FOOTER; 93use constant R_SCREEN => R_LISTING | R_DISKINFO | R_FRAME; 94use constant R_CLRSCR => R_CLEAR | R_SCREEN; 95use constant R_CHDIR => R_NEWDIR | R_SCREEN | R_STRIDE; 96 97use constant MOUSE_MODIFIER_ANY => 98 MOUSE_MODIFIER_SHIFT | MOUSE_MODIFIER_META | MOUSE_MODIFIER_CONTROL; 99 100use constant PATHESCAPES => [ 101 '%s1 name', 102 '%s2 name.ext', 103 '%s3 curr path', 104 '%s4 mountpoint', 105 '%s5 swap path', 106 '%s6 base path', 107 '%s7 extension', 108 '%s8 selection', 109 '%s9 prev path', 110 '%s0 ln target', 111 '', 112 '%s%s literal %s', 113 '', 114]; 115 116use constant CMDESCAPES => [ 117 '%se editor', 118 '%sE fg editor', 119 '%sp pager', 120 '%sv viewer', 121# '', 122# '{#start}', 123# '{%end}', 124# '{/find/repl}', 125# '{^} toupper', 126# '{,} tolower', 127]; 128 129our %EXPORT_TAGS = ( 130 constants => [ qw( 131 R_NOP 132 R_STRIDE 133 R_MENU 134 R_PATHINFO 135 R_HEADINGS 136 R_FOOTER 137 R_FRAME 138 R_DISKINFO 139 R_LISTING 140 R_SCREEN 141 R_CLEAR 142 R_CLRSCR 143 R_ALTERNATE 144 R_NEWDIR 145 R_CHDIR 146 MOUSE_BUTTON_LEFT 147 MOUSE_BUTTON_MIDDLE 148 MOUSE_BUTTON_RIGHT 149 MOUSE_BUTTON_UP 150 MOUSE_MODIFIER_SHIFT 151 MOUSE_MODIFIER_META 152 MOUSE_MODIFIER_CONTROL 153 MOUSE_MODIFIER_ANY 154 MOUSE_WHEEL_UP 155 MOUSE_WHEEL_DOWN 156 ) ] 157); 158 159our @EXPORT_OK = @{$EXPORT_TAGS{constants}}; 160 161our ($_pfm); 162 163########################################################################## 164# private subs 165 166=item I<_init(App::PFM::Application $pfm [, App::PFM::Config $config ] )> 167 168Called from the constructor. Initializes new instances. Stores the 169application object for later use and instantiates a App::PFM::Screen::Frame 170and App::PFM::Screen::Listing object. 171 172Note that at the time of instantiation, the config file has probably 173not yet been read. 174 175=cut 176 177sub _init { 178 my ($self, $pfm, $config) = @_; 179 $_pfm = $pfm; 180 $self->{_config} = $config; # undefined, see on_after_parse_config 181 $self->{_frame} = App::PFM::Screen::Frame->new( $pfm, $self, $config); 182 $self->{_listing} = App::PFM::Screen::Listing->new( $pfm, $self, $config); 183 $self->{_diskinfo} = App::PFM::Screen::Diskinfo->new($pfm, $self, $config); 184 $self->{_winheight} = 0; 185 $self->{_winwidth} = 0; 186 $self->{_screenheight} = 0; 187 $self->{_screenwidth} = 0; 188 $self->{_deferred_refresh} = 0; 189 $self->{_color_mode} = ''; 190 $self->{_chooser} = undef; 191 $self->{_on_resize} = sub { 192 $self->_catch_resize(); 193 }; 194 $SIG{WINCH} = $self->{_on_resize}; 195 # special key bindings for bracketed paste 196 $self->def_key(BRACKETED_PASTE_START, "\e[200~"); 197 $self->def_key(BRACKETED_PASTE_END, "\e[201~"); 198 # we cannot check the minimum size of the terminal yet, because the 199 # config option 'force_minimum_size' is not yet known. 200 return; 201} 202 203=item I<_catch_resize()> 204 205Catches window resize signals (WINCH). 206 207=cut 208 209sub _catch_resize { 210 my ($self) = @_; 211 $self->{_wasresized} = 1; 212 $SIG{WINCH} = $self->{_on_resize}; 213 return; 214} 215 216########################################################################## 217# constructor, getters and setters 218 219=item I<new(array @args)> 220 221Specific constructor for App::PFM::Screen. Constructs an object based on 222Term::ScreenColor. 223 224=cut 225 226sub new { 227 my ($type, @args) = @_; 228 $type = ref($type) || $type; 229 my $self = Term::ScreenColor->new(); 230 $self->{_event_handlers} = {}; 231 bless($self, $type); 232 $self->_init(@args); 233 return $self; 234} 235 236=item I<screenwidth( [ int $screenwidth ] )> 237 238=item I<screenheight( [ int $screenheight ] )> 239 240Getters/setters for the dimensions of the screen. 241 242=cut 243 244sub screenwidth { 245 my ($self, $value) = @_; 246 $self->{_screenwidth} = $value if defined $value; 247 return $self->{_screenwidth}; 248} 249 250sub screenheight { 251 my ($self, $value) = @_; 252 $self->{_screenheight} = $value if defined $value; 253 return $self->{_screenheight}; 254} 255 256=item I<frame()> 257 258=item I<listing()> 259 260=item I<diskinfo()> 261 262Getters for the App::PFM::Screen::Frame, App::PFM::Screen::Listing 263and App::PFM::Screen::Diskinfo objects. 264 265=cut 266 267sub frame { 268 my ($self) = @_; 269 return $self->{_frame}; 270} 271 272sub listing { 273 my ($self) = @_; 274 return $self->{_listing}; 275} 276 277sub diskinfo { 278 my ($self) = @_; 279 return $self->{_diskinfo}; 280} 281 282=item I<wasresized( [ bool $wasresized ] )> 283 284Getter/setter for the flag that indicates that the window was resized 285and needs to be updated. 286 287=cut 288 289sub wasresized { 290 my ($self, $value) = @_; 291 $self->{_wasresized} = $value if defined $value; 292 return $self->{_wasresized}; 293} 294 295=item I<color_mode( [ string $colormodename ] )> 296 297Getter/setter for the choice of color mode (I<e.g.> 'dark', 'light', 298'ls_colors'). Schedules a screen refresh if the color mode is set. 299 300=cut 301 302sub color_mode { 303 my ($self, $value) = @_; 304 if (defined $value) { 305 $self->{_color_mode} = $value; 306 $self->set_deferred_refresh(R_SCREEN); 307 } 308 return $self->{_color_mode}; 309} 310 311=item I<chooser( [ App:PFM::Browser $chooser ] )> 312 313Getter/setter for a I<chooser> object for which this screen object 314should perform refreshes. This alters the behavior of the refresh() 315method based on the I<chooser>'s SCREENTYPE. 316 317To undefine the I<chooser>, call this method with a zero argument. 318 319=cut 320 321sub chooser { 322 my ($self, $value) = @_; 323 if (ref $value) { 324 $self->{_chooser} = $value; 325 } elsif (defined $value) { 326 $self->{_chooser} = undef; 327 } 328 return $self->{_chooser}; 329} 330 331########################################################################## 332# public subs 333 334=item I<raw_noecho()> 335 336=item I<cooked_echo()> 337 338Sets the terminal to I<raw> or I<cooked> mode. 339 340=cut 341 342sub raw_noecho { 343 my ($self) = @_; 344 $self->raw()->noecho(); 345 return $self; 346} 347 348sub cooked_echo { 349 my ($self) = @_; 350 $self->cooked()->echo(); 351 return $self; 352} 353 354=item I<mouse_enable()> 355 356=item I<mouse_disable()> 357 358Tells the terminal to start/stop receiving information about the mouse. 359 360=cut 361 362sub mouse_enable { 363 my ($self) = @_; 364# print "\e[?1002h"; # cell motion tracking: mouse-down, mouse-up and motion 365# print "\e[?1000h"; # normal tracking : mouse-down, mouse-up 366 print "\e[?9h"; # X10 compatibility : mouse-down only 367 return $self; 368} 369 370sub mouse_disable { 371 my ($self) = @_; 372# print "\e[?1002l"; 373# print "\e[?1000l"; 374 print "\e[?9l"; 375 return $self; 376} 377 378=item I<bracketed_paste_on()> 379 380=item I<bracketed_paste_off()> 381 382Switches bracketed paste mode on and off. Bracketed paste mode is used 383to intercept paste actions when C<pfm> is expecting a single command key. 384 385=cut 386 387sub bracketed_paste_on { 388 my ($self) = @_; 389 print "\e[?2004h"; 390 return $self; 391} 392 393sub bracketed_paste_off { 394 my ($self) = @_; 395 print "\e[?2004l"; 396 return $self; 397} 398 399=item I<alternate_on()> 400 401=item I<alternate_off()> 402 403Switches to alternate terminal screen and back. 404 405=cut 406 407sub alternate_on { 408 my ($self) = @_; 409 print "\e[?47h"; 410 return $self; 411} 412 413sub alternate_off { 414 my ($self) = @_; 415 print "\e[?47l"; 416 return $self; 417} 418 419=item I<getch()> 420 421Overrides the Term::ScreenColor version of getch(). 422If a bracketed paste is received, it is returned as one unit. 423 424=cut 425 426sub getch { 427 my ($self) = @_; 428 my $key = $self->SUPER::getch(); 429 my $buffer = ''; 430 if ($key eq BRACKETED_PASTE_START) { 431 while (1) { 432 $key = $self->SUPER::getch(); 433 last if $key eq BRACKETED_PASTE_END; 434 $buffer .= $key; 435 } 436 # flag that a paste was received 437 $key = BRACKETED_SCRAP; 438 } 439 return wantarray ? ($key, $buffer) : $key; 440} 441 442=item I<calculate_dimensions()> 443 444Calculates the height and width of the screen. 445 446=cut 447 448sub calculate_dimensions { 449 my ($self) = @_; 450 my $newheight = $self->rows(); 451 my $newwidth = $self->cols(); 452 if ($newheight || $newwidth) { 453# $ENV{ROWS} = $newheight; 454# $ENV{COLUMNS} = $newwidth; 455 $self->{_winheight} = $newheight; 456 $self->{_winwidth} = $newwidth; 457 $self->{_screenheight} = $newheight - BASELINE - 2; 458 $self->{_screenwidth} = $newwidth; 459 } 460 return $self; 461} 462 463=item I<check_minimum_size()> 464 465Tests whether the terminal size is smaller than the minimum supported 46624 rows or 80 columns. If so, sends an escape sequence to adjust the 467terminal size. 468 469=cut 470 471sub check_minimum_size { 472 my ($self) = @_; 473 my ($newwidth, $newheight); 474 return if ($self->{_winwidth} >= 80 and $self->{_winheight} >= 24); 475 if ($self->{_config}->{force_minimum_size}) { 476 $newwidth = $self->{_winwidth} < 80 ? 80 : $self->{_winwidth}; 477 $newheight = $self->{_winheight} < 24 ? 24 : $self->{_winheight}; 478 print "\e[8;$newheight;${newwidth}t"; 479 return 1; 480 } 481 return 0; 482} 483 484=item I<fit()> 485 486Recalculates the screen size and adjust the layouts. 487 488=cut 489 490sub fit { 491 my ($self) = @_; 492 $self->resize(); 493 $self->calculate_dimensions(); 494 if ($self->check_minimum_size()) { 495 # the size was smaller than the minimum supported and has been adjusted. 496 $self->resize(); 497 $self->calculate_dimensions(); 498 } 499 $self->listing->makeformatlines(); 500 $self->set_deferred_refresh(R_CLRSCR); # D_FILTER necessary? 501 # History is interested (wants to set terminal object's terminal width) 502 # Browser is interested (wants to validate cursor position) 503 $self->fire(App::PFM::Event->new({ 504 name => 'after_resize_window', 505 type => 'soft', 506 origin => $self, 507 })); 508 return $self; 509} 510 511=item I<handleresize()> 512 513Makes the contents fit on the screen again after a resize. Validates 514the cursor position. 515 516=cut 517 518sub handleresize { 519 my ($self) = @_; 520 $self->{_wasresized} = 0; 521 $self->fit(); 522 return $self; 523} 524 525=item I<pending_input(float $delay)> 526 527Returns a boolean indicating that there is input ready to be processed. 528The delay indicates how long should be waited for input. 529 530=cut 531 532sub pending_input { 533 my ($self, $delay) = @_; 534 my $input_ready = length($self->{IN}) || 535 $self->{_wasresized} || $self->key_pressed($delay); 536 while ($input_ready == -1 and $! == 4) { 537 # 'Interrupted system call' 538 $input_ready = $self->key_pressed(0.1); 539 } 540 return $input_ready; 541} 542 543=item I<get_event()> 544 545Returns an App::PFM::Event object of type B<mouse>, B<key> or B<resize>, 546containing the event that was currently pending (as determined by 547pending_input()). 548 549=cut 550 551sub get_event { 552 my ($self) = @_; 553 # resize event 554 if ($self->{_wasresized}) { 555 $self->{_wasresized} = 0; 556 return App::PFM::Event->new({ 557 name => 'resize_window', 558 origin => $self, 559 type => 'resize', 560 }); 561 } 562 # must be keyboard/mouse/paste input here 563 my ($key, $buffer) = $self->getch(); 564 my $event = App::PFM::Event->new({ 565 name => 'after_receive_user_input', 566 origin => $self, 567 }); 568 # paste event 569 if ($key eq BRACKETED_SCRAP) { 570 $event->{type} = 'paste'; 571 $event->{data} = $buffer; 572 return $event; 573 } 574 # key event 575 if ($key ne 'kmous') { 576 $event->{type} = 'key'; 577 $event->{data} = $key; 578 return $event; 579 } 580 581 # mouse event 582 $event->{type} = 'mouse'; 583 $event->{data} = $key; # 'kmous' 584 585 $self->noecho(); 586 $event->{mousebutton} = ord($self->getch()) - oct(40); 587 $event->{mousecol} = ord($self->getch()) - oct(41); 588 $event->{mouserow} = ord($self->getch()) - oct(41); 589 $self->echo(); 590 591 $event->{mousemodifier} = $event->{mousebutton} & MOUSE_MODIFIER_ANY; 592 $event->{mousebutton} = $event->{mousebutton} & ~MOUSE_MODIFIER_ANY; 593 594 return $event; 595} 596 597=item I<< show_frame(hashref { menu => int $menu_mode, >> 598I<< footer => int $footer_mode, headings => int $heading_mode, >> 599I<< prompt => string $prompt } ) >> 600 601Uses the App::PFM::Screen::Frame object to redisplay the frame. 602 603=cut 604 605sub show_frame { 606 my ($self, $options) = @_; 607 $self->{_frame}->show($options); 608 return $self; 609} 610 611=item I<clear_footer()> 612 613Calls App::PFM::Screen::Frame::clear_footer() and schedules a refresh 614for the footer. 615 616=cut 617 618sub clear_footer { 619 my ($self) = @_; 620 $self->{_frame}->show_footer(FOOTER_NONE); 621 $self->set_deferred_refresh(R_FOOTER); 622 return $self; 623} 624 625=item I<select_next_color(bool $direction)> 626 627Finds the next colorset to use. If I<direction> is true, cycle forward; 628else backward. 629 630=cut 631 632sub select_next_color { 633 my ($self, $direction) = @_; 634 my @colorsetnames = @{$self->{_config}->{colorsetnames}}; 635 my $index = $#colorsetnames; 636 while ($self->{_color_mode} ne $colorsetnames[$index] and $index > 0) { 637 $index--; 638 } 639 if ($direction) { 640 if ($index-- <= 0) { $index = $#colorsetnames } 641 } else { 642 if ($index++ >= $#colorsetnames) { $index = 0 } 643 } 644 $self->{_color_mode} = $colorsetnames[$index]; 645 $self->color_mode($self->{_color_mode}); 646 # Directory is interested (wants to reformat files) 647 # History is interested (wants to set ornaments). 648 $self->fire(App::PFM::Event->new({ 649 name => 'after_set_color_mode', 650 type => 'soft', 651 origin => $self, 652 })); 653 return $self; 654} 655 656=item I<putcentered(string $message)> 657 658Displays a message on the current screen line, horizontally centered. 659 660=cut 661 662sub putcentered { 663 my ($self, $string) = @_; 664 $self->puts(' ' x (($self->{_screenwidth} - length $string)/2) . $string); 665 return $self; 666} 667 668=item I<putmessage(string $message_part1 [, string $message_part2 ... ] )> 669 670Displays a message in the configured message color. 671Accepts an array with message fragments. 672 673=cut 674 675sub putmessage { 676 my ($self, @message) = @_; 677 my $framecolors = $self->{_config}->{framecolors}; 678 if ($framecolors) { 679 $self->putcolored( 680 $framecolors->{$self->{_color_mode}}{message}, 681 join '', @message); 682 } else { 683 $self->puts(join '', @message); 684 } 685 return $self; 686} 687 688=item I<pressanykey()> 689 690Displays a message and waits for a key to be pressed. 691 692=cut 693 694sub pressanykey { 695 my ($self) = @_; 696 $self->putmessage("\r\n*** Hit any key to continue ***"); 697 $self->raw_noecho(); 698 if ($_pfm->browser->mouse_mode && 699 $self->{_config}->{clickiskeypresstoo} 700 ) { 701 $self->mouse_enable(); 702 } else { 703 $self->mouse_disable(); 704 } 705 if ($self->getch() eq 'kmous') { 706 $self->getch(); # discard mouse info: co-ords and button 707 $self->getch(); 708 $self->getch(); 709 }; 710 # the output of the following command should start on a new line. 711 $self->cooked_echo()->puts("\n")->raw_noecho(); 712 $self->mouse_enable() if $_pfm->browser->{mouse_mode}; 713 $self->alternate_on() if $self->{_config}->{altscreen_mode}; 714 $self->handleresize() if $self->{_wasresized}; 715 return $self; 716} 717 718=item I<ok_to_remove_marks()> 719 720Prompts the user for confirmation since they are about to lose 721their marks in the current directory. 722 723=cut 724 725sub ok_to_remove_marks { 726 my ($self) = @_; 727 my $sure; 728 if ($self->{_config}{remove_marks_ok} or 729 $self->{_diskinfo}->mark_info() <= 0) 730 { 731 return 1; 732 } 733 $self->{_diskinfo}->show(); 734 $self->clear_footer() 735 ->at(0,0)->clreol() 736 ->putmessage('OK to remove marks [Y/N]? '); 737 $sure = $self->getch(); 738 $self->set_deferred_refresh(R_FRAME); 739 return ($sure =~ /y/i); 740} 741 742=item I<display_error(string $message_part1 [, string $message_part2 ... ] )> 743 744Displays an error which may be passed as an array with message 745fragments. Waits for a key to be pressed and returns the keypress. 746 747=cut 748 749sub display_error { 750 my $self = shift; 751 $self->putmessage(@_); 752 return $self->error_delay(); 753} 754 755=item I<neat_error(string $message_part1 [, string $message_part2 ... ] )> 756 757Displays an error which may be passed as an array with message 758fragments. Waits for a key to be pressed and returns the keypress. 759Flags screen elements for refreshing. 760 761=cut 762 763sub neat_error { 764 my $self = shift; 765 $self->at(0,0)->clreol()->display_error(@_); 766 if ($_pfm->state->{multiple_mode}) { 767 $self->set_deferred_refresh(R_PATHINFO); 768 } else { 769 $self->set_deferred_refresh(R_FRAME); 770 } 771 return $self; 772} 773 774=item I<error_delay()> 775 776=item I<important_delay()> 777 778Waits for a key to be pressed. Returns the keypress. 779 780=cut 781 782sub error_delay { 783 return $_[0]->key_pressed(ERRORDELAY); 784} 785 786sub important_delay { 787 return $_[0]->key_pressed(IMPORTANTDELAY); 788} 789 790=item I<set_deferred_refresh(int $elements)> 791 792Flags screen elements as 'need to be redrawn'. The B<R_*> constants 793(see below) may be used to indicate which elements should be redrawn. 794 795=cut 796 797sub set_deferred_refresh { 798 my ($self, $elements) = @_; 799 $self->{_deferred_refresh} |= $elements; 800 return $self; 801} 802 803=item I<unset_deferred_refresh(int $elements)> 804 805Flags screen elements as 'do not need to be redrawn'. The B<R_*> 806constants (see below) may be used here. 807 808=cut 809 810sub unset_deferred_refresh { 811 my ($self, $elements) = @_; 812 $self->{_deferred_refresh} &= ~$elements; 813 return $self; 814} 815 816=item I<refresh_headings()> 817 818Redisplays the headings if they have been flagged as 'needs to be redrawn'. 819 820=cut 821 822sub refresh_headings { 823 my ($self) = @_; 824 my $headingtype = HEADING_DISKINFO; 825 if ($self->{_deferred_refresh} & R_HEADINGS) { 826 if ($self->{_chooser}) { 827 $headingtype = $self->{_chooser}->HEADINGTYPE; 828 } 829 $self->{_frame}->show_headings( 830 $_pfm->browser->swap_mode, $headingtype); 831 $self->{_deferred_refresh} &= ~R_HEADINGS; 832 } 833 return $self; 834} 835 836=item I<refresh()> 837 838Redisplays all screen elements that have been flagged as 'need to be redrawn'. 839 840=cut 841 842sub refresh { 843 my ($self) = @_; 844 my $browser = $_pfm->browser; 845 my $chooser = $self->{_chooser}; 846 my $deferred_refresh = $self->{_deferred_refresh}; 847 my $headingtype = HEADING_DISKINFO; 848 my $footertype = undef; 849 my $prompt = $chooser ? $chooser->prompt : undef; 850 851 if ($deferred_refresh & R_ALTERNATE) { 852 if ($self->{_config}->{altscreen_mode}) { 853 $self->alternate_on()->at(0,0); 854 } else { 855 $self->alternate_off()->at(0,0); 856 } 857 } 858 # show frame as soon as possible: this looks better on slow terminals 859 if ($deferred_refresh & R_CLEAR) { 860 $self->clrscr(); 861 } 862 if ($deferred_refresh & R_FRAME) { 863 $self->{_frame}->show({ prompt => $prompt }); 864 } 865 # now in order of severity 866 if ($deferred_refresh & R_NEWDIR) { 867 # it's dangerous to leave multiple_mode on when changing directories 868 # ('autoexitmultiple' is only for leaving it on between commands) 869 $_pfm->state->{multiple_mode} = 0; 870 } 871 872 # refresh the directory, which may request more refreshing 873 $_pfm->state->directory->refresh(); 874 $deferred_refresh = $self->{_deferred_refresh}; 875 876 # refresh the filelisting 877 if ($deferred_refresh & R_STRIDE) { 878 if ($chooser) { 879 $chooser->validate_position(); 880 } else { 881 $browser->position_cursor_fuzzy(); 882 $browser->position_cursor('.') unless defined $browser->currentfile; 883 } 884 } 885 886 # validations may have requested more refreshing 887 $deferred_refresh = $self->{_deferred_refresh}; 888 889 if ($deferred_refresh & R_LISTING) { 890 if ($chooser and $chooser->SCREENTYPE == R_LISTING) { 891 $chooser->list_items(); 892 } else { 893 $self->{_listing}->show(); 894 } 895 } 896 if ($deferred_refresh & R_DISKINFO) { 897 if ($chooser and $chooser->SCREENTYPE == R_DISKINFO) { 898 $chooser->list_items(); 899 } else { 900 $self->{_diskinfo}->show(); 901 } 902 } 903 if ($deferred_refresh & R_MENU) { 904 $self->{_frame}->show_menu_or_prompt({ prompt => $prompt }); 905 } 906 if ($deferred_refresh & R_PATHINFO) { 907 $self->path_info(); 908 } 909 if ($deferred_refresh & R_HEADINGS) { 910 if ($chooser) { 911 $headingtype = $chooser->HEADINGTYPE; 912 } 913 $self->{_frame}->show_headings( 914 $_pfm->browser->swap_mode, $headingtype); 915 } 916 if ($deferred_refresh & R_FOOTER) { 917 if ($chooser) { 918 $footertype = $chooser->FOOTERTYPE; 919 } 920 $self->{_frame}->show_footer($footertype); 921 } 922 $self->{_deferred_refresh} = 0; 923 return $self; 924} 925 926=item I<path_info(bool $physical)> 927 928Redisplays information about the current directory path and the current 929filesystem. If the argument flag I<physical> is set, the physical 930pathname of the current directory is shown. 931 932=cut 933 934sub path_info { 935 my ($self, $physical) = @_; 936 my $directory = $_pfm->state->directory; 937 my $path = $physical ? getcwd() : $directory->path; 938 $self->at(PATHLINE, 0) 939 ->puts($self->pathline($path, $directory->device)); 940 return $self; 941} 942 943=item I<pathline(string $path, string $device [, ref $baselen, ref $ellipssize ] )> 944 945Formats the information about the current directory path and the current 946filesystem. The reference arguments are used by the CommandHandler for 947finding out where in the pathline the mouse was clicked. I<baselen> is 948set to the length of the pathline before the ellipsis string. 949I<ellipssize> is the length of the ellipsis string. 950 951=cut 952 953sub pathline { 954 my ($self, $path, $dev, $p_baselen, $p_ellipssize) = @_; 955 my $normaldevlen = 12; 956 my $actualdevlen = max($normaldevlen, length($dev)); 957 # the three in the next exp is the length of the overflow char plus the '[]' 958 my $maxpathlen = $self->{_screenwidth} - $actualdevlen -3; 959 $dev = $dev . ' 'x max($actualdevlen -length($dev), 0); 960 # fit the path 961 my ($disppath, $spacer, $overflow, $baselen, $ellipssize) = 962 fitpath($path, $maxpathlen); 963 # process the results 964 $$p_baselen = $baselen; 965 $$p_ellipssize = $ellipssize; 966 return $disppath . $spacer 967 . ($overflow ? $self->{_listing}->NAMETOOLONGCHAR : ' ') 968 . DEVICE_SPEC_START . $dev . DEVICE_SPEC_END; 969} 970 971=item I<list_escapes(bool $all)> 972 973List the available escapes; path escapes (B<=1>, B<=2>, I<etc.>) 974and if the I<$all> flag is set, also command escapes (B<=e>, B<=p>, 975B<=v>, I<etc.>). 976 977=cut 978 979sub list_escapes 980{ 981 my ($self, $all) = @_; 982 my $printline = $self->BASELINE; 983 my $infocol = $self->diskinfo->infocol; 984 my $e = $self->{_config}{e}; 985 my @escapes = @{PATHESCAPES()}; 986 my @set; 987 if ($all) { 988 @escapes = (@escapes, @{CMDESCAPES()}); 989 } 990 $self->diskinfo->clearcolumn()->set_deferred_refresh(R_DISKINFO); 991 foreach (@escapes) 992 { 993 @set = ($e) x tr/%//; 994 if ($printline <= $self->BASELINE + $self->screenheight) { 995 $self->at($printline++, $infocol) 996 ->puts(' ' . sprintf($_, @set)); 997 } 998 } 999 return; 1000} 1001 1002=item I<on_after_parse_usecolor(App::PFM::Event $event)> 1003 1004Applies the 'usecolor' config option to the Term::ScreenColor(3pm) object. 1005 1006=cut 1007 1008sub on_after_parse_usecolor { 1009 my ($self, $event) = @_; 1010 $self->colorizable($event->{origin}{usecolor}); 1011 return $self; 1012} 1013 1014=item I<on_after_parse_config(App::PFM::Event $event)> 1015 1016Applies the config settings when the config file has been read and parsed. 1017 1018=cut 1019 1020sub on_after_parse_config { 1021 my ($self, $event) = @_; 1022 my ($keydefs, $lunchboxcolorset, $defaultcolorset, $newcolormode); 1023 # store config 1024 my $pfmrc = $event->{data}; 1025 $self->{_config} = $event->{origin}; 1026 # make cursor very visible 1027 system ('tput', $pfmrc->{cursorveryvisible} ? 'cvvis' : 'cnorm'); 1028 # check minimum size 1029 $self->check_minimum_size(); 1030 # set colorizable 1031 $self->on_after_parse_usecolor($event); 1032 # additional key definitions 'keydef' 1033 $keydefs = $pfmrc->{'keydef[*]'}; 1034 if ($pfmrc->{"keydef[$ENV{TERM}]"}) { 1035 $keydefs .= ':' . $pfmrc->{"keydef[$ENV{TERM}]"}; 1036 } 1037 $keydefs =~ s/(\\e|\^\[)/\e/gi; 1038 # see if we have esc_timeout 1039 if (defined $self->{_config}{esc_timeout}) { 1040 $self->timeout($self->{_config}{esc_timeout}); 1041 } 1042 # there can be no colons (:) in escape sequences 1043 foreach (split /:/, $keydefs) { 1044 /^(\w+)=(.*)/ and $self->def_key($1, $2); 1045 } 1046 # determine color_mode if unset 1047 $lunchboxcolorset = $event->{lunchbox}{colorset}; 1048 if (!defined($lunchboxcolorset)) { 1049 $lunchboxcolorset = ''; 1050 } 1051 $defaultcolorset = $pfmrc->{defaultcolorset}; 1052 $newcolormode = 1053 (length($self->{_color_mode}) 1054 ? $self->{_color_mode} 1055 : defined $self->{_config}{dircolors}{$lunchboxcolorset} 1056 ? $lunchboxcolorset 1057 : (defined($ENV{ANSI_COLORS_DISABLED}) 1058 ? 'off' 1059 : defined $self->{_config}{dircolors}{$defaultcolorset} 1060 ? $defaultcolorset 1061 : (defined $self->{_config}{dircolors}{ls_colors} 1062 ? 'ls_colors' 1063 : $self->{_config}{colorsetnames}[0]))); 1064 # init colorsets 1065 $self->color_mode($newcolormode); 1066 $self->set_deferred_refresh(R_ALTERNATE); 1067 $self->diskinfo->on_after_parse_config($event); 1068 $self->listing->on_after_parse_config($event); 1069 return $self; 1070} 1071 1072=item I<on_shutdown(bool $altscreen_mode [, bool $silent ] )> 1073 1074Called when the application is shutting down. I<altscreen_mode> 1075indicates if the State has used the alternate screen buffer. 1076 1077=cut 1078 1079sub on_shutdown { 1080 my ($self, $altscreen_mode, $silent) = @_; 1081 my $message = 'Goodbye from your Personal File Manager!'; 1082 # reset bracketed paste mode twice: gnome-terminal is shown to have 1083 # different bracketed paste settings for main and alternate screen buffers 1084 $self->cooked_echo() 1085 ->mouse_disable() 1086 ->bracketed_paste_off() 1087 ->alternate_off() 1088 ->bracketed_paste_off(); 1089 system qw(tput cnorm) if $self->{_config}{cursorveryvisible}; 1090 1091 # in silent mode, just reset the terminal to its original state; 1092 # don't clear the screen or print any messages. 1093 return if $silent; 1094 1095 if ($altscreen_mode) { 1096 print "\n"; 1097 } else { 1098 if ($self->{_config}{clsonexit}) { 1099 $self->clrscr(); 1100 } else { 1101 $self->at(0,0)->putcentered($message)->clreol() 1102 ->at(PATHLINE, 0); 1103 } 1104 } 1105 if ($altscreen_mode or !$self->{_config}{clsonexit}) { 1106 $self->at($self->screenheight + BASELINE + 1, 0) 1107 ->clreol(); 1108 } 1109 return $self; 1110} 1111 1112########################################################################## 1113 1114=back 1115 1116=head1 CONSTANTS 1117 1118This package provides the B<R_*> constants which indicate which 1119part of the terminal screen needs to be redrawn. 1120They can be imported with C<use App::PFM::Screen qw(:constants)>. 1121 1122=over 1123 1124=item R_NOP 1125 1126No refresh action is required. 1127 1128=item R_STRIDE 1129 1130The cursor position needs to be validated. 1131 1132=item R_MENU 1133 1134Redisplay the menu. 1135 1136=item R_PATHINFO 1137 1138Redisplay the pathinfo (current directory and current device). 1139 1140=item R_HEADINGS 1141 1142Redisplay the column headings. 1143 1144=item R_FOOTER 1145 1146Redisplay the footer. 1147 1148=item R_FRAME 1149 1150A combination of R_FOOTER, R_HEADINGS, R_PATHINFO and R_MENU. 1151 1152=item R_DISKINFO 1153 1154Redisplay the disk- and directory info column. 1155 1156=item R_LISTING 1157 1158Redisplay the directory listing. 1159 1160=item R_SCREEN 1161 1162A combination of R_LISTING, R_DISKINFO and R_FRAME. 1163 1164=item R_CLEAR 1165 1166Clear the screen. 1167 1168=item R_CLRSCR 1169 1170A combination of R_CLEAR and R_SCREEN. 1171 1172=item R_NEWDIR 1173 1174Reinitialize directory-specific variables. 1175 1176=item R_CHDIR 1177 1178A combination of R_NEWDIR, R_SCREEN and R_STRIDE. 1179 1180=back 1181 1182A refresh need for a screen element may be flagged by providing 1183one or more of these constants to set_deferred_refresh(), I<e.g.> 1184 1185 $screen->set_deferred_refresh(R_MENU | R_FOOTER); 1186 1187The actual refresh will be performed on calling: 1188 1189 $screen->refresh(); 1190 1191This will also reset the refresh flags. 1192 1193=head1 SEE ALSO 1194 1195pfm(1), App::PFM::Screen::Diskinfo(3pm), App::PFM::Screen::Frame(3pm), 1196App::PFM::Screen::Listing(3pm), Term::ScreenColor(3pm). 1197 1198=cut 1199 12001; 1201 1202# vim: set tabstop=4 shiftwidth=4: 1203