| 51 | | new Curses::UI::POE inline_states => { |
| 52 | | _start => sub { |
| 53 | | my ($kernel, $curses, $session) = @_[ KERNEL, HEAP, SESSION ]; |
| 54 | | |
| 55 | | my $servers = $curses->{server} = []; |
| 56 | | |
| 57 | | # /commands |
| 58 | | my $execute; |
| 59 | | $execute = { |
| 60 | | server => sub { |
| 61 | | my ($hostname, $port) = @_[1, 2]; |
| 62 | | |
| 63 | | $hostname ||= "irc.freenode.net"; |
| 64 | | $port ||= 6667; |
| 65 | | |
| 66 | | $kernel->call |
| 67 | | ( $session, write => "status", |
| 68 | | "Connecting to $hostname:$port" ); |
| 69 | | |
| 70 | | unless ($kernel->alias_resolve($hostname)) { |
| 71 | | POE::Component::IRC->spawn( |
| 72 | | alias => $hostname, |
| 73 | | nick => cuserid, |
| 74 | | server => $hostname, |
| 75 | | port => $port, |
| 76 | | username => cuserid, |
| 77 | | ircname => +(getpwnam cuserid)[6], |
| 78 | | ); |
| 79 | | |
| 80 | | unshift @$servers, $hostname; |
| 81 | | |
| 82 | | $kernel->post($hostname, register => "all"); |
| 83 | | } |
| 84 | | else { |
| 85 | | $kernel->post( |
| 86 | | $hostname => connect => { |
| 87 | | Nick => cuserid, |
| 88 | | Server => $hostname, |
| 89 | | Port => $port, |
| 90 | | Username => cuserid, |
| 91 | | Ircname => +(getpwnam cuserid)[6], |
| 92 | | } |
| 93 | | ); |
| 94 | | } |
| 95 | | |
| 96 | | $kernel->yield |
| 97 | | ( window_topic => status => "Status: $hostname" ); |
| 98 | | }, |
| 99 | | |
| 100 | | join => sub { |
| 101 | | my ($chan) = $_[ 1 ]; |
| 102 | | |
| 103 | | if (@$servers) { |
| 104 | | # This is buggered. $server->[$#$server] isn't always what |
| 105 | | # we want. We should probably try to extract it instead |
| 106 | | # and use the @$server list when we are in the status |
| 107 | | # window |
| 108 | | |
| 109 | | $kernel->post($servers->[ACTIVE], join => $chan); |
| 110 | | $kernel->call($session, window_open => "channel", |
| 111 | | "$servers->[ACTIVE] $chan"); |
| 112 | | } |
| 113 | | else { |
| 114 | | $kernel->call |
| 115 | | ( $session, "write", $curses->{window}[ACTIVE], |
| 116 | | "Not connected to any servers?" ); |
| 117 | | } |
| 118 | | }, |
| 119 | | |
| 120 | | part => sub { |
| 121 | | my ($line, $channel) = @_; |
| 122 | | |
| 123 | | unless ($channel) { |
| 124 | | my $active = $curses->{window}[ACTIVE]; |
| 125 | | my $server; |
| 126 | | |
| 127 | | ($server, $channel) = ($active =~ m/(\S+)/g); |
| 128 | | |
| 129 | | $kernel->post($server, part => $channel); |
| 130 | | $kernel->yield(window_close => $active); |
| 131 | | } |
| 132 | | }, |
| 133 | | |
| 134 | | nick => sub { |
| 135 | | my $active = $curses->{window}[ACTIVE]; |
| 136 | | my ($server, $recipient) = ($active =~ m/(\S+)/g); |
| 137 | | |
| 138 | | my $session = $kernel->alias_resolve($server); |
| 139 | | |
| 140 | | unless ($session) { |
| 141 | | $server = $curses->{server}[ACTIVE]; |
| 142 | | $session = $kernel->alias_resolve($server); |
| 143 | | } |
| 144 | | |
| 145 | | my $heap = $session->get_heap; |
| 146 | | $heap->{nick} = $_[1]; |
| 147 | | |
| 148 | | POE::Kernel->yield(write => active => "--- set nick to $_[1]"); |
| 149 | | POE::Kernel->post($server => nick => $_[1]); |
| 150 | | }, |
| 151 | | |
| 152 | | kick => sub { |
| 153 | | POE::Kernel->post(IRC => kick => @_[1..$#_]) |
| 154 | | }, |
| 155 | | |
| 156 | | mode => sub { |
| 157 | | my $mode = "mode "; |
| 158 | | $mode .= join (" ", @_[1..$#_]); |
| 159 | | my $server = ($curses->{window}[ACTIVE] =~ m/^(\S+)/); |
| 160 | | POE::Kernel->post($server => sl => $mode); |
| 161 | | }, |
| 162 | | |
| 163 | | topic => sub { |
| 164 | | my ($topic, $channel) = @_; |
| 165 | | |
| 166 | | my $active = $curses->{window}[ACTIVE]; |
| 167 | | my ($server, $dchannel) = ($active =~ m/(\S+)/g); |
| 168 | | |
| 169 | | if ($server eq "status") { |
| 170 | | $server = $curses->{server}[ACTIVE]; |
| 171 | | } |
| 172 | | |
| 173 | | if (($channel) = ($topic =~ m/^(#\S+)/)) { |
| 174 | | $topic =~ s/^$channel\s*//; |
| 175 | | |
| 176 | | $kernel->post($server => topic => $channel => $topic); |
| 177 | | } |
| 178 | | else { |
| 179 | | $kernel->post($server => topic => $dchannel => $topic); |
| 180 | | } |
| 181 | | }, |
| 182 | | |
| 183 | | msg => sub { |
| 184 | | my ($recipient, $message) = (shift =~ m/(\S+) (.*)/); |
| 185 | | my ($server) = ($curses->{window}[ACTIVE] =~ m/^(\S+)/); |
| 186 | | |
| 187 | | if ($server eq "status") { |
| 188 | | $server = $curses->{server}[ACTIVE]; |
| 189 | | } |
| 190 | | |
| 191 | | POE::Kernel->post($server => privmsg => $recipient, $message); |
| 192 | | }, |
| 193 | | |
| 194 | | quote => sub { |
| 195 | | my ($server) = ($curses->{window}[ACTIVE] =~ m/^(\S+)/); |
| 196 | | |
| 197 | | if ($server eq "status") { |
| 198 | | $server = $curses->{server}[ACTIVE]; |
| 199 | | } |
| 200 | | |
| 201 | | POE::Kernel->post($server => sl => shift); |
| 202 | | }, |
| 203 | | |
| 204 | | me => sub { |
| 205 | | my $active = $curses->{window}[ACTIVE]; |
| 206 | | if ($active eq "status") { |
| 207 | | $kernel->yield(write => $active, |
| 208 | | "Actions are inappropriate in this window"); |
| 209 | | } |
| 210 | | else { |
| 211 | | my ($server, $target) = ($active =~ m/(\S+)/g); |
| 212 | | my $me = $kernel->alias_resolve($server)->get_heap->{nick}; |
| 213 | | my $message = "@_[1 .. $#_]"; |
| 214 | | $kernel->post($server, ctcp => $target, "ACTION $message"); |
| 215 | | $kernel->yield(write => $active, "* $me $message"); |
| 216 | | } |
| 217 | | }, |
| 218 | | |
| 219 | | mode => sub { |
| 220 | | if ((my $window = $curses->{window}[ACTIVE]) ne "status") { |
| 221 | | my ($server, $channel) = ($window =~ m/(\S+) (\S+)/); |
| 222 | | if (($channel =~ m/^\#/) && ($_[1] =~ m/^(\+|-)/)) { |
| 223 | | $kernel->post |
| 224 | | ( $server => mode => $channel, |
| 225 | | join " ", @_[1..$#_] ); |
| 226 | | } |
| 227 | | else { |
| 228 | | $kernel->post |
| 229 | | ( $server => mode => $_[1], |
| 230 | | join " ", @_[2..$#_] ); |
| 231 | | } |
| 232 | | } |
| 233 | | }, |
| 234 | | |
| 235 | | whois => sub { |
| 236 | | my ($server) = ($curses->{window}[ACTIVE] =~ m/^(\S+)/); |
| 237 | | |
| 238 | | if ($server eq "status") { |
| 239 | | $server = $curses->{server}[ACTIVE]; |
| 240 | | } |
| 241 | | |
| 242 | | POE::Kernel->post($server => whois => $_[0]); |
| 243 | | }, |
| 244 | | |
| 245 | | echo => sub { |
| 246 | | my $active = $curses->{window}[ACTIVE]; |
| 247 | | $kernel->call |
| 248 | | ($session, write => $active, join " ", @_[1 .. $#_]); |
| 249 | | }, |
| 250 | | |
| 251 | | query => sub { |
| 252 | | my ($nick) = $_[1]; |
| 253 | | my $active = $curses->{window}[ACTIVE]; |
| 254 | | unless ($active eq "status") { |
| 255 | | my ($server) = ($active =~ m/^(\S+)/); |
| 256 | | $kernel->yield(window_open => query => "$server $nick", |
| 257 | | "Query with $nick"); |
| 258 | | } |
| 259 | | }, |
| 260 | | |
| 261 | | exit => sub { |
| 262 | | my ($message) = @_; |
| 263 | | $message ||= "cuirc $VERSION"; |
| 264 | | |
| 265 | | $kernel->alarm_remove_all; |
| 266 | | |
| 267 | | for my $session (@$servers) { |
| 268 | | $kernel->post($session => quit => $message); |
| 269 | | $kernel->post($session => "unregister", "all"); |
| 270 | | $kernel->post($session => "shutdown"); |
| 271 | | } |
| 272 | | |
| 273 | | $kernel->yield("shutdown"); |
| 274 | | $kernel->yield(write => $curses->{window}[ACTIVE], |
| 275 | | "Goodbye"); |
| 276 | | }, |
| 277 | | |
| 278 | | }; |
| 279 | | |
| 280 | | $execute->{quit} = $execute->{exit}; |
| 281 | | |
| 282 | | my $menu = $curses->add |
| 283 | | ( 'menu','Menubar', |
| 284 | | -fg => "white", |
| 285 | | -bg => "blue", |
| 286 | | -menu => [ |
| 287 | | { -label => 'File', |
| 288 | | -submenu => [ |
| 289 | | { -label => 'Exit ^Q', -value => $execute->{exit} } |
| 290 | | ] |
| 291 | | }, |
| 292 | | { -label => 'Help', |
| 293 | | -submenu => [ |
| 294 | | { -label => 'About cuirc', -value => sub { |
| 295 | | |
| 296 | | shift->root->dialog |
| 297 | | ( -title => "About cuirc", |
| 298 | | -message => <<'ABOUT'); |
| 299 | | Program : Curses::UI::POE IRC Client |
| 300 | | Authors : Scott McCoy (tag@cpan.org) |
| 301 | | Jeff Nettleton (jeffdn@gmail.com) |
| 302 | | |
| 303 | | The sole purpose of this client is to demonstrate |
| 304 | | new Curses::UI::POE features, as well as provide |
| 305 | | an example of how Curses::UI::POE could be used. |
| 306 | | This example was crafted specifically for snl20 |
| 307 | | from #perl, on the freenode network. |
| 308 | | ABOUT |
| 309 | | |
| 310 | | } |
| 311 | | }, |
| 312 | | ] |
| 313 | | }, |
| 314 | | ] |
| 315 | | ); |
| 316 | | |
| 317 | | # Create the screen for the editor. |
| 318 | | |
| 319 | | # There is no need for the editor widget to loose focus, so |
| 320 | | # the "loose-focus" binding is disabled here. This also enables the |
| 321 | | # use of the "TAB" key in the editor, which is nice to have. |
| 322 | | #$editor->clear_binding('loose-focus'); |
| 323 | | |
| 324 | | my $inter = $curses->add ( |
| 325 | | 'input', 'Window', |
| 326 | | -y => -1, |
| 327 | | -width => -1, |
| 328 | | -height => 2 |
| 329 | | ); |
| 330 | | |
| 331 | | my $clock = $inter->add ( |
| 332 | | "clock", 'Label', |
| 333 | | -y => -2, |
| 334 | | -width => -1, |
| 335 | | -reverse => 1, |
| 336 | | -paddingspaces => 1, |
| 337 | | -fg => "blue", |
| 338 | | -bg => "white", |
| 339 | | -text => "", |
| 340 | | ); |
| 341 | | |
| 342 | | my $editor = $inter->add ( |
| 343 | | "editor", 'TextEditor', |
| 344 | | -y => -1, |
| 345 | | -x => 0, |
| 346 | | -width => -1, |
| 347 | | -height => 1, |
| 348 | | -singleline => 1, |
| 349 | | )->focus; |
| 350 | | |
| 351 | | my (%Channel, $Current, @History, $CurCon, $CurrentChannel); |
| 352 | | |
| 353 | | # The indirect method syntax isn't necessarily the best, but it does |
| 354 | | # atleast allow VIM to maintain its indenting with the anonymous code |
| 355 | | # refs. |
| 356 | | set_binding $editor sub { |
| 357 | | my $input = shift; |
| 358 | | my $line = $input->get; |
| 359 | | |
| 360 | | push @History, $line; |
| 361 | | $Current = @History; |
| 362 | | |
| 363 | | $input->text(""); |
| 364 | | |
| 365 | | if (my ($cmd) = ($line =~ m[^/(\w+)])) { |
| 366 | | $cmd = lc $cmd; |
| 367 | | if (defined $execute->{$cmd}) { |
| 368 | | $line =~ s/^\/$cmd\s*//; |
| 369 | | |
| 370 | | $execute->{$cmd}->($line, ($line =~ m[(\S+)]g)); |
| 371 | | } |
| 372 | | else { |
| 373 | | $kernel->yield |
| 374 | | (write => active => "--- $cmd not registered"); |
| 375 | | } |
| 376 | | } |
| 377 | | else { |
| 378 | | my $active = $curses->{window}[ACTIVE]; |
| 379 | | if (my ($server, $target) = ($active =~ m/(\S+) (\S+)/)) { |
| 380 | | # yes that is ugly as sin, I know |
| 381 | | my $me = $kernel->alias_resolve($server)->get_heap->{nick}; |
| 382 | | |
| 383 | | $kernel->post($server => privmsg => $target, $line); |
| 384 | | $kernel->call |
| 385 | | ( $session => write => $active, |
| 386 | | "<$me> $line" ); |
| 387 | | } |
| 388 | | else { |
| 389 | | $kernel->call |
| 390 | | ( $session => write => $active, |
| 391 | | "Not a channel or query?" ); |
| 392 | | } |
| 393 | | } |
| 394 | | }, KEY_ENTER, "\n", "\r"; |
| 395 | | |
| 396 | | set_binding $editor sub { |
| 397 | | my $input = shift; |
| 398 | | |
| 399 | | if (my $text = $input->get) { |
| 400 | | if (my ($lead) = ($text =~ m{^([^/]+)\s*$})) { |
| 401 | | my $active = $curses->{window}[ACTIVE]; |
| 402 | | my $screen = $curses->getobj($active); |
| 403 | | |
| 404 | | if (my $nicklist = $screen->getobj("nicklist")) { |
| 405 | | my $nicks = $nicklist->values; |
| 406 | | my @match = grep m/^(?:@|\%|\+)?\Q$lead\E/i, @$nicks; |
| 407 | | |
| 408 | | if (@match > 1) { |
| 409 | | $curses->status("Multiple Matches: @match"); |
| 410 | | } |
| 411 | | elsif (@match) { |
| 412 | | $match[0] =~ s/^(@|\%|\+)//; |
| 413 | | |
| 414 | | $input->text("$match[0]: "); |
| 415 | | |
| 416 | | $input->cursor_right |
| 417 | | for length($lead)..(length($match[0])+2); |
| 418 | | } |
| 419 | | else { |
| 420 | | $curses->status("No matches for $lead"); |
| 421 | | } |
| 422 | | } |
| 423 | | else { |
| 424 | | $curses->status("$active has no nick list"); |
| 425 | | } |
| 426 | | } |
| 427 | | else { |
| 428 | | $curses->status("No nick to complete: not implemented"); |
| 429 | | } |
| 430 | | } |
| 431 | | else { |
| 432 | | $curses->status("Message last sender not implemented"); |
| 433 | | } |
| 434 | | |
| 435 | | }, "\t"; |
| 436 | | |
| 437 | | set_binding $editor sub { |
| 438 | | shift->text($History[--$Current]) |
| 439 | | }, KEY_UP; |
| 440 | | |
| 441 | | set_binding $editor sub { |
| 442 | | $Current++; |
| 443 | | if ($Current > @History) { |
| 444 | | shift->text ("") |
| 445 | | } |
| 446 | | else { |
| 447 | | shift->text ($History[$Current]) |
| 448 | | } |
| 449 | | }, KEY_DOWN; |
| 450 | | |
| 451 | | set_binding $curses sub { |
| 452 | | unless ((my $key = $curses->get_key(5)) eq "-1") { |
| 453 | | my $window = $curses->{window}; |
| 454 | | |
| 455 | | my $action = { |
| 456 | | n => sub { |
| 457 | | push @$window, shift @$window; |
| 458 | | $curses->getobj($window->[ACTIVE])->focus; |
| 459 | | $editor->focus; |
| 460 | | }, |
| 461 | | p => sub { |
| 462 | | unshift @$window, pop @$window; |
| 463 | | $curses->getobj($window->[ACTIVE])->focus; |
| 464 | | $editor->focus; |
| 465 | | }, |
| 466 | | c => sub { |
| 467 | | my $active = $window->[ACTIVE]; |
| 468 | | |
| 469 | | if ($active =~ m/\S+\s*#\S+$/) { |
| 470 | | $execute->{part}->(); |
| 471 | | } |
| 472 | | else { |
| 473 | | $curses->delete(shift @$window); |
| 474 | | $curses->getobj($window->[ACTIVE])->focus; |
| 475 | | $editor->focus; |
| 476 | | } |
| 477 | | }, |
| 478 | | j => sub { |
| 479 | | $curses->status("Not yet supported"); |
| 480 | | }, |
| 481 | | }; |
| 482 | | |
| 483 | | if ($action->{$key}) { |
| 484 | | $action->{$key}->(); |
| 485 | | } |
| 486 | | } |
| 487 | | }, "\cW"; |
| 488 | | |
| 489 | | set_binding $editor sub { |
| 490 | | push @$servers, shift @$servers; |
| 491 | | $kernel->yield |
| 492 | | ( window_topic => status => "Status: $servers->[ACTIVE]" ); |
| 493 | | |
| 494 | | }, "\cX"; |
| 495 | | |
| 496 | | set_binding $editor sub { |
| 497 | | my $window = $curses->{window}; |
| 498 | | if (my $screen = $curses->getobj($window->[ACTIVE])) { |
| 499 | | my $viewer = $screen->getobj("viewer"); |
| 500 | | $viewer->focus; |
| 501 | | $viewer->cursor_pageup(); |
| 502 | | $editor->focus; |
| 503 | | } |
| 504 | | else { |
| 505 | | $kernel->call($session, write => $curses->{window}[ACTIVE], |
| 506 | | "$window->[ACTIVE] does not exist?!"); |
| 507 | | } |
| 508 | | }, KEY_PPAGE; |
| 509 | | |
| 510 | | set_binding $editor sub { |
| 511 | | my $window = $curses->{window}; |
| 512 | | if (my $screen = $curses->getobj($window->[ACTIVE])) { |
| 513 | | my $viewer = $screen->getobj("viewer"); |
| 514 | | $viewer->focus; |
| 515 | | $viewer->cursor_pagedown(); |
| 516 | | $editor->focus; |
| 517 | | } |
| 518 | | else { |
| 519 | | $kernel->call($session, write => $curses->{window}[ACTIVE], |
| 520 | | "$window->[ACTIVE] does not exist?!"); |
| 521 | | } |
| 522 | | }, KEY_NPAGE; |
| 523 | | |
| 524 | | $curses->draw; |
| 525 | | |
| 526 | | $kernel->yield("window_open", "status", "status", "Status Window"); |
| 527 | | $kernel->yield("clock_update"); |
| 528 | | |
| 529 | | # DRY - All these events go to the status window... |
| 530 | | $kernel->state( "irc_$_" => sub { |
| 531 | | $_[KERNEL]->yield(write => status => $_[ARG1]); |
| 532 | | } ) for qw( 002 003 004 005 250 251 252 253 254 255 265 266 375 324 329 |
| 533 | | 376 ); |
| 534 | | |
| 535 | | # DRY - All these events go to the active window... (whois) |
| 536 | | $kernel->state( "irc_$_" => sub { |
| 537 | | $_[KERNEL]->yield(write => active => $_[ARG1]); |
| 538 | | } ) for qw( 311 312 313 314 315 316 317 318 319 ); |
| 539 | | }, |
| 540 | | |
| 541 | | # ----------------------------------------------------------------------------- |
| 542 | | # Window Management |
| 543 | | |
| 544 | | window_close => sub { |
| 545 | | my ($curses, $name) = @_[ HEAP, ARG0 ]; |
| 546 | | |
| 547 | | if ($curses->{window}[ACTIVE] eq $name) { |
| 548 | | $curses->getobj(shift @{ $curses->{window} })->focus; |
| 549 | | } |
| 550 | | |
| 551 | | $curses->delete($name); |
| 552 | | }, |
| 553 | | |
| 554 | | window_open => sub { |
| 555 | | my ($curses, $type, $name, $topic) = @_[HEAP, ARG0 .. ARG2]; |
| 556 | | my $screen = $curses->add ( |
| 557 | | lc($name), 'Window', |
| 558 | | -padtop => 1, # leave space for the menu |
| 559 | | -padbottom => 2, # leave space for the input/clock |
| 560 | | -border => 0, |
| 561 | | -ipad => 0, |
| 562 | | ); |
| 563 | | |
| 564 | | # We add the editor widget to this screen. |
| 565 | | $screen->add ( |
| 566 | | 'topic', 'Label', |
| 567 | | -y => 0, |
| 568 | | -width => -1, |
| 569 | | -reverse => 1, |
| 570 | | -paddingspaces => 1, |
| 571 | | -text => $topic, |
| 572 | | ); |
| 573 | | |
| 574 | | my $viewer = $screen->add ( |
| 575 | | 'viewer', 'TextViewer', |
| 576 | | -border => 0, |
| 577 | | -pos => -1, |
| 578 | | -sfg => "blue", |
| 579 | | -sbg => "white", |
| 580 | | -padright => ($type eq "channel" ? 11 : 0), |
| 581 | | -padtop => 1, |
| 582 | | -padbottom => 0, |
| 583 | | -showlines => 0, |
| 584 | | -sbborder => 0, |
| 585 | | -vscrollbar => 1, |
| 586 | | -hscrollbar => 0, |
| 587 | | -showhardreturns => 0, |
| 588 | | -wrapping => 0, |
| 589 | | -intellidraw => 1, |
| 590 | | ); |
| 591 | | |
| 592 | | if ($type eq "channel") { |
| 593 | | $screen->add ( |
| 594 | | "nicklist", 'Listbox', |
| 595 | | -x => -1, |
| 596 | | -y => -1, |
| 597 | | -padtop => 1, |
| 598 | | -padbottom => 0, |
| 599 | | -width => 10, |
| 600 | | -radio => 0, |
| 601 | | -intellidraw => 1, |
| 602 | | ); |
| 603 | | } |
| 604 | | |
| 605 | | $screen->{buffer} ||= []; |
| 606 | | @{ $screen->{buffer} }[500] = ""; |
| 607 | | |
| 608 | | { |
| 609 | | no warnings "uninitialized"; |
| 610 | | $viewer->text(join "\n", @{ $screen->{buffer} }); |
| 611 | | } |
| 612 | | |
| 613 | | $viewer->beep_off |
| 614 | | ->cursor_down(undef, 501) |
| 615 | | ->beep_on |
| 616 | | ->intellidraw; |
| 617 | | |
| 618 | | $screen->focus; |
| 619 | | unshift @{ $curses->{window} ||= [] }, lc $name; |
| 620 | | |
| 621 | | $curses->getobj("input")->getobj("editor")->focus; |
| 622 | | }, |
| 623 | | |
| 624 | | window_topic => sub { |
| 625 | | my ($curses, $window, $topic) = @_[ HEAP, ARG0, ARG1 ]; |
| 626 | | my $screen = $curses->getobj(lc $window); |
| 627 | | |
| 628 | | if (my $topic_label = $screen->getobj("topic")) { |
| 629 | | $topic_label->text($topic); |
| 630 | | $topic_label->intellidraw; |
| 631 | | $curses->draw; |
| 632 | | } |
| 633 | | }, |
| 634 | | |
| 635 | | put_buffer => sub { |
| 636 | | my ($curses, $window, $message) = @_[HEAP, ARG0, ARG1]; |
| 637 | | |
| 638 | | if ($window eq "active") { |
| 639 | | $window = $curses->{window}[ACTIVE]; |
| 640 | | } |
| 641 | | |
| 642 | | my $screen = $curses->getobj(lc $window); |
| 643 | | |
| 644 | | unless ($screen) { |
| 645 | | $_[KERNEL]->yield |
| 646 | | ( write => $curses->{window}[ACTIVE], |
| 647 | | "Window $window does not exist?!" ) |
| 648 | | unless $window eq $curses->{window}[ACTIVE]; |
| 649 | | return; |
| 650 | | } |
| 651 | | |
| 652 | | my $buffer = $screen->{buffer}; |
| 653 | | my $viewer = $screen->getobj("viewer"); |
| 654 | | my @format = wrap($message, $viewer->canvaswidth); |
| 655 | | |
| 656 | | splice @$buffer, 0, (scalar @format); |
| 657 | | push @$buffer, @format; |
| 658 | | |
| 659 | | my $xpos = $viewer->getrealxpos; |
| 660 | | |
| 661 | | { |
| 662 | | no warnings "uninitialized"; |
| 663 | | $viewer->text(join "\n", @$buffer); |
| 664 | | } |
| 665 | | |
| 666 | | $viewer->{-xpos} = $xpos; |
| 667 | | |
| 668 | | return $viewer; |
| 669 | | }, |
| 670 | | |
| 671 | | write => sub { |
| 672 | | my ($kernel, $curses, $session, $window, $message) = |
| 673 | | @_[ KERNEL, HEAP, SESSION, ARG0, ARG1 ]; |
| 674 | | |
| 675 | | my $viewer = $kernel->call($session, put_buffer => $window, $message); |
| 676 | | |
| 677 | | if ($viewer) { |
| 678 | | # ugly, maybe wrap should give us hints |
| 679 | | |