modules/FvwmCommand/scripts/focus-link.pl

   1 #! xPERLx
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16
  17 ####
  18 # NAME
  19 #    focus-link.pl - perl FvwmCommand script
  20 ####
  21 # SYNOPSIS
  22 #    focus-link.pl [-v]
  23 ####
  24 # OPTION
  25 #    -v  show version number and exit.
  26 ####
  27 # DESCRIPTION
  28 #    This is a user programmable window focus script.
  29 #    It requires FvwmCommand version 1.5 or later.
  30 #    FvwmCommandS must be invoked from fvwm prior to this command.
  31 #
  32 #    This script can be invoked from a shell or from .fvwm2rc. For example.
  33 #
  34 #   AddToFunc "InitFunction" "I" Module FvwmBanner
  35 #   + "I" Module        FvwmPager 0 8
  36 #   + "I" Exec    xcb -n 4 -l vertical -g 240x180-0+530 &
  37 #   + "I" Exec sh -c "sleep 2;$HOME/scripts/focus-link.pl & "
  38 #
  39 #    Sleep is used in order to avoid un-necessary reaction during initial
  40 #    window creation. A shell is invoked to avoid fvwm itself sleeps for
  41 #    2 seconds.
  42 #
  43 #    Default behavior is listed below.
  44 #    In order to change the behavior, modify user_function using user
  45 #    functions.
  46 #     1. When a window is opened up, focus the window and move the pointer
  47 #        to it. The parent window regains focus when a window is closed.
  48 #        Parenthood is determined when a window is opened. It is the last
  49 #        focused window with the same X class.
  50 #     2. #1 would not occur to AcroRead opening window.
  51 #     3. #1 would not occur when SkipMapping is set and the window is the
  52 #        only window of its class.
  53 #     4. For Netscape find dialog window, addition to #1, resize the window
  54 #        to 300x150 pixels and move it to East edge of the screen.
  55 #        Download/upload windows will not be focused nor be in focus link
  56 #        list.
  57 #     5. Move appletviewer to NorthWest corner.
  58 #     6. Xterm won't focus back to its parent after closed.
  59 #     7. When a window is de-iconified, focus it and move the pointer.
  60 #
  61 ####
  62 # USER FUNCTIONS
  63 #    These are collection of functions a user can call from programmable
  64 #    section.
  65
  66 #  user function description are comments that start with ##
  67
  68 # change path if necessary
  69 $FVWMCOMMAND = "/usr/X11/lib/X11/fvwm/FvwmCommand";
  70 # if not there, try this
  71 if (! -x $FVWMCOMMAND) {
  72   $FVWMCOMMAND = "$ENV{HOME}/usr/X11/lib/X11/fvwm/FvwmCommand";
  73 }
  74
  75 #********** user configurable function **************************
  76 sub user_function {
  77   if (action_was ("add")) {
  78     # don't do anything to opening window of acrobat reader
  79     return if class_matches ("AcroRead", "splashScreen_popup");
  80
  81     # if skipmapping is specified with 'style' command and
  82     # if the window is the first of its class, then don't focus
  83     if (window_flag('SkipMapping') && no_parent_window()) {
  84       return();
  85     }
  86
  87     # don't focus download/upload window. do not put it in focus link list
  88     if (class_matches ("Netscape", "(Download|upload)")) {
  89       delete_from_list();
  90       return();
  91     }
  92
  93     focus_window();
  94
  95     # move Netscape find dialog to edge
  96     if (class_matches ("Netscape", "find")) {
  97       resize_window ('300p','150p'); # resize before move to be on the edge
  98       move_window ("East");
  99       # move_window ('-0p', '-100p'); # just an example
 100     }
 101     # move appletviewer to corner
 102     move_window ("Northwest") if class_matches ("VendorShell", "AWTapp");
 103
 104     # if you don't want move the pointer, comment out the next line
 105     warp_to_window (50, 50); # center of the window
 106
 107   }elsif (action_was ("destroy")) {
 108     #don't focus back to parent if its xterm
 109     return if (class_matches ("XTerm"));
 110
 111     focus_window (get_parent_window());
 112     # if you don't want move the pointer, comment out the next line
 113     warp_to_window (get_parent_window(), 50, 50);  #center of window
 114
 115   }elsif (action_was ("deiconify")) {
 116     focus_window();
 117
 118   }elsif (action_was ("iconify")) {
 119     #    focus_window (get_parent_window());
 120   }
 121 }
 122
 123 #********** end of user configurable function **************************
 124
 125
 126 init();
 127
 128
 129 #package FvwmFocusLink;
 130 #require Exporter;
 131 #@ISA = qw(Exporter);
 132 #
 133 #@EXPORT = qw( &move_window
 134 #             &resize_window
 135 #             &focus_window
 136 #             &warp_to_window
 137 #             &class_matches
 138 #             &window_flag
 139 #             &resource_matches
 140 #             &action_was
 141 #             &get_parent_window
 142 #             &no_parent_window
 143 #             &delete_from_list
 144 #              &init );
 145 #
 146
 147
 148 #
 149 # user callable functions
 150 #
 151
 152 ###
 153 # move_window [<id>] <direction>
 154 #  or
 155 ###
 156 # move_window [<id>] <x> <y>
 157 #
 158 #    If <id> is prensent in hex format, then move <id> window.
 159 #    Otherwise, move the window in question.
 160 #
 161 #    If <y> is present, move window to <x> <y> in percentage of screen.
 162 #
 163 #    If 'p' is appended to <width> or <height>, it specifies in
 164 #    pixel count. And, if <width'p'> or <height'p'> is lead with '-',
 165 #    it signifies that pixel count from right or bottom edge.
 166 #
 167 #    If <y> does not exist, <dir> must be one of North Northeast East
 168 #    Southeast South Southwest West Northwest to move window to edge.
 169
 170 sub move_window {
 171   my (@a) = @_;
 172   my ($height, $width, $x, $y, $w, $dir);
 173
 174   ($id) = @a;
 175   if ($id =~ /^$HEX$/) {
 176     shift @a;
 177   }else{
 178     $id = $W->{id};
 179   }
 180   return undef if ($id eq $NULLWINDOW || $id eq ''
 181                    || !defined $Window{$id}
 182                    || defined $Window{$id}{destroy} );
 183
 184   ($dir,$y) = @a;
 185
 186   if (defined $y) {
 187     $x = $dir;
 188     if ($x =~ s/^-(.*)p$/$1/) {
 189       ($width) = ($Window{$id}{frame} =~ /width (\d+)/);
 190       $x = $SW - $width - $x . "p";
 191     }
 192     if ($y =~ s/^-(.*)p$/$1/) {
 193       ($height) = ($Window{$id}{frame} =~ /height (\d+)/);
 194       $y = $SH - $height - $y . "p";
 195     }
 196     send_cmd("windowid $id move $x $y", $id, "^$id $ACTPAIR{frame}");
 197
 198   }else{
 199     ($x,$y,$width,$height) =
 200       ($Window{$id}{frame}
 201        =~ /x (-?\d+), y (-?\d+), width (\d+), height (\d+)/);
 202
 203     if ($dir =~ /[Ee]ast/) {
 204       $x = $SW - $width;
 205     }elsif ($dir =~ /[Ww]est/) {
 206       $x = 0;
 207     }
 208     if ($dir =~ /[Nn]orth/) {
 209       $y = 0;
 210     }elsif ($dir =~ /[Ss]outh/) {
 211       $y = $SH - $height;
 212     }
 213
 214     send_cmd("windowid $id move ${x}p ${y}p\n", $id, "^$id $ACTPAIR{frame}");
 215   }
 216   !defined $Window{$id}{'destroy'};
 217 }
 218
 219 ###
 220 # resize_window [<id>] <width> <height>
 221 #
 222 #    Resize window to <width> and <height> in percentage of screen size.
 223 #
 224 #    If <id> is not null, resize <id>. Otherwise resize the
 225 #    window in question.
 226 #
 227 #    Letter 'p' can be appended to <width> and <height> to specify in
 228 #    pixel count.
 229
 230 sub resize_window {
 231   my ($id,$wd,$ht) = @_;
 232   if (!defined $ht) {
 233     $ht = $wd;
 234     $wd = $id;
 235     $id = $W->{id};
 236   }
 237   return undef if ($id eq $NULLWINDOW || $id eq ''
 238                    || !defined $Window{$id}
 239                    || defined $Window{$id}{destroy} );
 240   send_cmd("windowid $id resize $wd $ht\n", $id, "^$id $ACTPAIR{frame}");
 241   !defined $Window{$id}{'destroy'};
 242 }
 243
 244 ###
 245 # focus_window [<id>]
 246 #
 247 #    If <id> is not null, focus on <id>.
 248 #    Otherwise, focus on the window in question.
 249
 250 sub focus_window {
 251   my ($id) = @_;
 252   my ($l);
 253
 254   if (!defined $id) {
 255     $id = $W->{id};
 256   }
 257   return undef if ($id eq $NULLWINDOW || $id eq ''
 258                    || !defined $Window{$id}
 259                    || defined $Window{$id}{destroy} );
 260
 261   send_cmd("windowid $id focus\n");
 262   keep_last_focused ($id);
 263   !defined $Window{$id}{'destroy'};
 264 }
 265
 266 ###
 267 # warp_to_window [<id>] [<x> <y>]
 268 #
 269 #    Move pointer to window.
 270 #
 271 #    If <id> is a window id, warp to <id>.
 272 #    Otherwise, warp to the window in question.
 273 #
 274 #    If <x> and <y> are present, warp to <x> and <y> percentage of window
 275 #    size down and in from the upper left hand corner.
 276 #
 277 #    Letter 'p' can be appended to <width> and <height> to specify in pixel
 278 #    count.
 279
 280 sub warp_to_window {
 281   my (@a) = @_;
 282
 283   my ($id) = @a;
 284   if ($id !~ /^$HEX$/) {
 285     $id = $W->{id};
 286   }else{
 287     shift @a;
 288   }
 289   return undef if ($id eq $NULLWINDOW || $id eq ''
 290                    || !defined $Window{$id}
 291                    || defined $Window{$id}{destroy} );
 292
 293   my ($x, $y) = @a;
 294
 295   # ensure both exists or none
 296   if (!defined $x || !defined $y) {
 297     $x = $y = '';
 298   }
 299   send_cmd ("windowid $id WarpToWindow $x $y");
 300   !defined $Window{$id}{'destroy'};
 301 }
 302
 303 ###
 304 # class_matches <class> [<resource>]
 305 #
 306 #    Check if window class and optional resource match.
 307 #
 308 #    If arg1 is present, and if class matches with <class> and resource
 309 #    matches with <resource>, then return 1.
 310 #
 311 #    If arg1 is not present, and if class matches with <class> then
 312 #    return 1.
 313 #    Otherwise, return null.
 314 sub class_matches {
 315   my($c,$r) = @_;
 316   if (defined $r) {
 317     return $W->{class} =~ /$c/ && $W->{resource} =~ /$r/;
 318   }
 319   return $W->{class} =~ /$c/;
 320 }
 321
 322 ###
 323 # window_flag [<id>] <flag>
 324 #
 325 #    Return 1 if <flag> is true in the window in question.
 326 #    If <id> is not null, check on <id>. Otherwise check on the
 327 #    window in question.
 328 #    <flag> must be a exact match to one of these:
 329 #
 330 #  StartIconic
 331 #  OnTop
 332 #  Sticky
 333 #  WindowListSkip
 334 #  SuppressIcon
 335 #  NoiconTitle
 336 #  Lenience
 337 #  StickyIcon
 338 #  CirculateSkipIcon
 339 #  CirculateSkip
 340 #  ClickToFocus
 341 #  SloppyFocus
 342 #  SkipMapping
 343 #  Handles
 344 #  Title
 345 #  Mapped
 346 #  Iconified
 347 #  Transient
 348 #  Visible
 349 #  IconOurs
 350 #  PixmapOurs
 351 #  ShapedIcon
 352 #  Maximized
 353 #  WmTakeFocus
 354 #  WmDeleteWindow
 355 #  IconMoved
 356 #  IconUnmapped
 357 #  MapPending
 358 #  HintOverride
 359 #  MWMButtons
 360 #  MWMBorders
 361 sub window_flag {
 362   my ($id, $f) = @_;
 363   if (!defined $f) {
 364     $f = $id;
 365     $id = $W->{id};
 366   }
 367
 368   return undef if ($id eq $NULLWINDOW || $id eq '');
 369   return $Window{$id}{$f} eq 'yes';
 370 }
 371
 372 ###
 373 # resource_matches <resource>
 374 #    Check if window resource matches pattern <resource>.
 375 #    If it matches, return 1.
 376 #    Otherwise return null.
 377 sub resource_matches {
 378   my($r) = @_;
 379   return $W->{resource} =~ /$r/;
 380 }
 381
 382 ###
 383 # action_was <action>
 384 #    Check if <action> was taken place.
 385 #
 386 #    <action> must be a exact match to one of these:
 387 #
 388 #  new page
 389 #  new desk
 390 #  add
 391 #  raise
 392 #  lower
 393 #  focus change
 394 #  destroy
 395 #  iconify
 396 #  deiconify
 397 #  windowshade
 398 #  dewindowshade
 399 #  end windowlist
 400 #  icon location
 401 #  end configinfo
 402 #  string
 403 sub action_was {
 404   my ($act) = @_;
 405   return $W->{act} eq $act;
 406 }
 407
 408 ###
 409 # get_parent_window [<id>]
 410 #
 411 #    Return parent window id.
 412 #
 413 #    If <id> is not null, check on <id>. Otherwise check on the
 414 #    window in question.
 415 sub get_parent_window {
 416   my ($id) = @_;
 417   if (!defined $id) {
 418     $id = $W->{id};
 419   }
 420   return $NULLWINDOW if ($id eq $NULLWINDOW || $id eq ''
 421                          || !defined $Window{$id} );
 422
 423   if (defined $Window{$id}{parent}) {
 424     $Window{$id}{parent};
 425   }else{
 426     $NULLWINDOW;  # must be an orphan
 427   }
 428 }
 429
 430 ###
 431 # no_parent_window [<id>]
 432 #
 433 #    Return 1 if no parent window exits.
 434 #
 435 #    If <id> is not null, check on <id>. Otherwise check on the
 436 #    window in question.
 437 sub no_parent_window {
 438   return get_parent_window(@_) eq $NULLWINDOW;
 439 }
 440
 441 ###
 442 # delete_from_list
 443 #
 444 #    Delete the window from link list
 445 sub delete_from_list {
 446   my ($id);
 447   my ($f, $i);
 448
 449   return if $W->{id} eq $NULLWINDOW || $W->{id} eq '';
 450   $id = $W->{id};
 451   $f = $Focus{$W->{class}};
 452   foreach $i (0..1) {
 453     if ($f->[$i] eq $id) {
 454       $f->[$i] = $NULLWINDOW;
 455     }
 456   }
 457   # adopt orphans
 458   foreach $i (keys %Window) {
 459     if ($Window{$i}{parent} eq $id) {
 460       # avoid being parent of itself
 461       if ($Window{$id}{parent} ne $i) {
 462         $Window{$i}{parent} = $Window{$id}{parent};
 463       }else{
 464         $Window{$i}{parent} = $NULLWINDOW;
 465       }
 466     }
 467   }
 468   undef %{$Window{$id}};
 469   delete $Window{$id};
 470 }
 471
 472
 473 #
 474 # Supporting routines
 475 #
 476
 477 # add_to_list
 478 #    Add the window to link list.
 479 #    Link points back to the last focused window among the same class
 480 sub add_to_list {
 481   return if ( $W->{id} eq '' || $W->{id} eq $NULLWINDOW);
 482   if (!defined @{$Focus{$W->{class}}}) {
 483     # no parent listed
 484     $W->{parent} = $NULLWINDOW;
 485     $Focus{$W->{class}}[0] = $NULLWINDOW;
 486   }else{
 487     $W->{parent} = $Focus{$W->{class}}[0];
 488     # can't be parent of itself
 489     if ($W->{parent} eq $W->{id}) {
 490       $W->{parent} = $Focus{$W->{class}}[1];
 491       if ($W->{parent} eq $W->{id}) {
 492         $W->{parent} = $NULLWINDOW;
 493       }
 494     }
 495   }
 496 }
 497
 498
 499 # Send command
 500 # Optionally wait for a keyword to come back
 501 sub send_cmd {
 502   my($cmd,$id,$key)=@_;
 503   my($cid);
 504
 505   $cmd =~ s/\n*$/\n/;           # ensure 1 cr at eol
 506   # ensure not to send command for window already destroyed
 507   if ($cmd =~ /^windowid ($HEX)/) {
 508     $cid = $1;
 509     return if ($cid eq $NULLWINDOW || $cid eq '' ||
 510                !defined $Window{$cid} ||
 511                defined $Window{$cid}{destory} );
 512   }
 513
 514   print FCC     $cmd;
 515   print STDERR  $cmd if $Debug & 2;
 516
 517   # if specified wait  for the keyword
 518   if (defined $key) {
 519     read_message($id,$key);
 520   }
 521 }
 522
 523 # Wait until action defined in $STATUS occure, then call process.
 524 # If a window focused, keep in focus list as the last window
 525 # among the class.
 526 # Create current window info from lines leaded with the same id
 527 # number.
 528 sub next_action {
 529   my ($act, $id);
 530
 531   read_message();
 532
 533   undef ($id);
 534   ($act) = /^\s+(\w+(\s\w+)?)/;  # such as "new page"
 535   if (!$act) {
 536     ($id, $act) = (/^($HEX) ($STATUS)/);
 537   }
 538
 539   #undef $W;
 540   if ($id ne '') {
 541     if ($act eq 'add') {
 542       # create new window info
 543       $Window{"$id"} = {id=>"$id"};
 544     }
 545     $W = $Window{"$id"};
 546     if (defined $ACTPAIR{$act}) {
 547       # multi line action
 548       read_message($id, "$id $ACTPAIR{$act}");
 549     }
 550   } else {
 551     $W = {};
 552   }
 553
 554   $W->{act} = $act;
 555 }
 556
 557 # read message fifo or stack
 558 # if $id is defined and the message is not for $id then
 559 # push it on to the stack and read it again
 560 # if $key is also defined, loop until $key is matched
 561 sub read_message {
 562   my ($id,$key) = @_;
 563   my ($sk);
 564   $sk = 0;
 565   LOOP_ID: {
 566     do {
 567       if ($sk==0 && $#Message >= 0) {
 568         $_ = shift (@Message);
 569       }else{
 570         $_ = <FCM>;
 571         if (/^$/ && eof(FCM)) {
 572           eof_quit()
 573         }
 574       }
 575     } while (/^\s*$/);
 576     if (/^($HEX) ($STATUS)\s*(.*)/ && $1 ne $NULLWINDOW) {
 577       $Window{$1}{$2} = $3;
 578       if ($2 eq 'class') {
 579         $Window{$1}{id} = $1;
 580         $Window{$1}{parent} = $NULLWINDOW;
 581         push (@{$Focus{$3}}, $1);
 582       }
 583     }
 584
 585     # for $id only
 586     if ($id ne '') {
 587       if (!/^$id/) {
 588         push (@Message,$_);
 589         $sk = 1;  # don't read from @Message
 590         redo LOOP_ID;
 591       }
 592       return undef if !defined $Window{$id};
 593       return undef if defined $Window{$id}{destroy};
 594     }
 595
 596     # wait for keyword
 597     if (defined $key && !/$key/) {
 598       $sk = 1;
 599       redo LOOP_ID;
 600     }
 601   }
 602 }
 603
 604 # Keep the last 2 focused windows of each class.
 605 # This allows focus_window and add_to_list to be any order
 606 sub keep_last_focused {
 607   my ($id) = @_;
 608   my ($l);
 609
 610   return undef if ($id eq ''
 611                    || $id eq $NULLWINDOW
 612                    || !defined $Window{$id}
 613                    || defined $Window{$id}{destroy} );
 614
 615
 616   # consider for cases that Focus is not defined yet
 617   if (!defined $Focus{$Window{$id}{class}}) {
 618     @{$Focus{$Window{$id}{class}}} = ($NULLWINDOW);
 619   }
 620   $l = $Focus{$Window{$id}{class}};
 621   if ($l->[0] ne $id) {
 622     # only if changed
 623     unshift (@$l, $id);
 624     splice (@$l,2);
 625   }
 626 }
 627
 628 sub kill_server {
 629   send_cmd ("killme"); # kill FvwmCommandS
 630   close (FCM);
 631   close (FCC);
 632 }
 633
 634 # error. quit.
 635 sub eof_quit {
 636   print STDERR "FCM EOF ";
 637   exit 1;
 638 }
 639
 640 # signal handler
 641 sub sig_quit {
 642   my($sig) = @_;
 643   print STDERR "signal $sig\n";
 644   exit 2;
 645 }
 646
 647 #
 648 # debug
 649 #
 650
 651 # print window list
 652 sub print_list {
 653   my($k, $w);
 654   foreach $k (keys %Window) {
 655     $w = $Window{$k};
 656     print (STDERR "id $w->{id} parent $w->{parent}  " ,
 657            "class $w->{class} \tresource $w->{resource}\n");
 658   }
 659   print STDERR "\n";
 660 }
 661
 662 # print the current list of parents for each class
 663 sub print_focused_list {
 664   my ($k);
 665   local($,);
 666   $, = ";";
 667   foreach $k (keys %Focus) {
 668     print (STDERR "class $k parents @{$Focus{$k}}\n");
 669   }
 670   print STDERR "\n";
 671 }
 672
 673 #
 674 # initialize
 675 #   setup new fifos
 676 #   get screen size - to move
 677 #   get window list
 678 #
 679 #   debug option -d<N>
 680 #         1 to print window info
 681 #         2 to print command sent
 682 #         4 to print focused window list
 683 #         8 to print action
 684 sub init {
 685   my ($count, $type);
 686
 687   $Debug = 0;
 688   if ($ARGV[0] =~ /^-v/) {
 689     print STDERR "focus-link.pl version 2.0\n";
 690     exit;
 691   }
 692   if ($ARGV[0] =~ /^-d(\d+)/) {
 693     $Debug = $1;
 694     shift @ARGV;
 695   }
 696
 697   $SIG{'TTIN'} = "IGNORE";
 698   $SIG{'TTOUT'} = "IGNORE";
 699   $SIG{'QUIT'} = "sig_quit";
 700   $SIG{'INT'} = "sig_quit";
 701   $SIG{'HUP'} = "sig_quit";
 702   $SIG{'PIPE'} = "sig_quit";
 703
 704   $STATUS = '(?:\w+(?:\s\w+)?)';   #status to be captured
 705   # matching pair for some action
 706   %ACTPAIR = ('add'=>'map',
 707               'deiconify'=>'map',
 708               'iconify'=>'lower',
 709               'frame'=>'pixel' );
 710
 711   $HEX = '0x[\da-f]+'; #for regex
 712   $NULLWINDOW = '0x00000000';   # root or invalid window id
 713
 714   $FIFO = "$ENV{'HOME'}/.FCMfocus";
 715
 716   # screen width
 717   if( `xwininfo -root` =~ /Width: (\d+)\s+Height: (\d+)/ ) {
 718     $SW = $1;
 719     $SH = $2;
 720   }else{
 721     # some resonable number  if xwininfo doesn't work
 722     $SW = 1024;
 723     $SH = 786;
 724   }
 725
 726   # start a dedicated server
 727   # start a client monitoring (-m option ) all fvwm transaction (-i3 option )
 728   # unlinking and verifying M FIFO ensures that new FvwmCommand is running
 729   unlink( "${FIFO}M" );
 730   open( FCM, "$main::FVWMCOMMAND -S $FIFO -f $FIFO  -m -i3 </dev/null|" )
 731     || die "FCM $FIFO";
 732   while (! -p "${FIFO}M") {
 733     sleep(1);
 734     if ($count++ > 5) {
 735       die "Can't open ${FIFO}M";
 736     }
 737   }
 738
 739   # send command through the new fifo which is "$FIFO" + "C"
 740   open( FCC, ">${FIFO}C" ) || die "FCC $FIFO" ;
 741
 742   # appearantly, it has to be unbuffered
 743   select( FCC ); $| = 1;
 744   select( STDOUT ); $| = 1;
 745
 746   %Focus = (); # last focused windows for each class
 747   @Message = (); # message queue
 748
 749   %Window = ();
 750
 751   #get current screen info
 752   send_cmd("Send_WindowList\n");
 753
 754 #  while(<FCM>) {
 755 #    last if /^end windowlist/;
 756 #
 757 #    # create window list
 758 #    if (/^($HEX) ($STATUS)\s*(.*)/) {
 759 #      if ($1 ne $NULLWINDOW) {
 760 #       $Window{$1}{$2} = $3;
 761 #       # make focused window list
 762 #       if ($2 eq 'class') {
 763 #         $Window{$1}{id} = $1;
 764 #         $Window{$1}{parent} = $NULLWINDOW;
 765 #         push (@{$Focus{$3}}, $1);
 766 #       }
 767 #      }
 768 #    }
 769 #  }
 770
 771   print_list() if ($Debug & 1);
 772   print_focused_list() if ($Debug & 4);
 773   main_loop();
 774 }
 775
 776 sub main_loop {
 777    while (1) {
 778      next_action ();
 779      $Window{$W->{id}} = $W if $W->{id} ne '';
 780      add_to_list() if action_was("add");
 781      print STDERR "Action $W->{act} $W->{id}\n" if $Debug & 8;
 782      main::user_function();
 783      if ($W->{act} eq 'destroy') {
 784        delete_from_list();
 785      }
 786      if ($W->{act} eq 'focus change') {
 787        keep_last_focused ($W->{id});
 788      }
 789      print_list() if ($Debug & 1 && !action_was("focus change")) ;
 790      print_focused_list() if ($Debug & 4 && !action_was("focus change"));
 791    }
 792 }
 793
 794 END {
 795   kill_server();
 796   print STDERR "end\n";
 797 }
 798
 799 1;
 800
 801 ####
 802 # SEE ALSO
 803 #    FvwmCommand
 804 ####
 805 # AUTHOR
 806 #    Toshi Isogai  isogai@ucsub.colorado.edu