modules/FvwmWindowMenu/FvwmWindowMenu.in

   1 #!@PERL@ -w
   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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 # Filter this script to pod2man to get a man page:
  18 #   pod2man -c "Fvwm Module" FvwmWindowMenu | nroff -man | less -e
  19
  20 use 5.004;
  21 use strict;
  22
  23 BEGIN {
  24         use vars qw($prefix $datarootdir $datadir);
  25         $prefix = "@prefix@";
  26         $datarootdir = "@datarootdir@";
  27         $datadir = "@datadir@";
  28 }
  29
  30 use lib "@FVWM_PERLLIBDIR@";
  31 use FVWM::Module;
  32 use General::Parse qw(get_token);
  33
  34 my $module_type = "";
  35 my $module_class = "FVWM::Module";
  36 if ($ARGV[5] && $ARGV[5] eq "-g") {
  37         splice(@ARGV, 5, 1);
  38         eval "use FVWM::Module::Gtk;";
  39         if ($@) {
  40                 print STDERR $@;
  41                 print STDERR "FvwmWindowMenu: Ignoring the -g switch\n";
  42         } else {
  43                 Gtk->init;
  44                 $module_type = "gtk";
  45                 $module_class = "FVWM::Module::Gtk";
  46         }
  47 }
  48
  49 # init the module
  50 # set Debug = 0 for no messages at all
  51 # set Debug = 1 to see messages about window decisions
  52 # set Debug = 2 to see also perllib messages about communication
  53 my $module = new $module_class(
  54         Name => "FvwmWindowMenu",
  55         Mask => M_STRING,
  56         Debug => 0,
  57 );
  58
  59 $module->debug("starting " . $module->name);
  60
  61 my $config_tracker = $module->track('ModuleConfig',
  62         DefaultConfig => {
  63                 OnlyIconified => 'off',
  64                 AllDesks => 'off',
  65                 AllPages => 'off',
  66                 MaxLen => 32,
  67                 MenuName => 'MyMenu',
  68                 MenuStyle => '',
  69                 Debug => 0,
  70                 Function => 'WindowListFunc',
  71                 ItemFormat => '%m%n%t%t(+%x+%y) - Desk %d',
  72                 ShowName => '',
  73                 ShowClass => '',
  74                 ShowResource => '',
  75                 DontShowName => '',
  76                 DontShowClass => '',
  77                 DontShowResource => '',
  78         },
  79 );
  80
  81 my $config = $config_tracker->data;
  82 my $win_tracker = $module->track("WindowList", "!stack icons names winfo");
  83
  84 $module->add_handler(M_STRING, sub {
  85         my ($module, $event) = @_;
  86         my ($action, $args) = get_token($event->_text);
  87         return unless $action;
  88         if ($action =~ /^Post|Menu|Popup$/i) {
  89                 PopupMenu($action, $args);
  90         } elsif ($action =~ /^ShowBar$/i) {
  91                 if ($module_type ne "gtk") {
  92                         $module->debug("Not started with Gtk support", 0);
  93                         return;
  94                 }
  95                 PopupTaskBar();
  96         } else {
  97                 $module->debug("Unknown action $action", 0);
  98         }
  99 });
 100
 101 # does all the work and pops up the menu
 102 sub PopupMenu ($$) {
 103         my ($action, $args) = @_;
 104         my $command = ($action =~ /^Popup$/i ? "Popup" : "Menu");
 105
 106         my @sections;
 107
 108         # loop on list of all windows
 109         my $windows = $win_tracker->data;
 110         while (my ($id, $w) = each %$windows) {
 111                 $module->debug("\twindow: " . $w->{name});
 112
 113                 if ($config->{AllDesks} =~ /off/i &&
 114                         $w->{desk} != $win_tracker->page_info('desk_n'))
 115                 {
 116                         $module->debug("\t\tnot on this desk");
 117                         next;
 118                 }
 119
 120                 if ($config->{AllPages} =~ /off/i &&
 121                         ($w->{page_nx} != $win_tracker->page_info('page_nx') ||
 122                          $w->{page_ny} != $win_tracker->page_info('page_ny')))
 123                 {
 124                         $module->debug("\t\tnot on this page");
 125                         next;
 126                 }
 127
 128                 if ($config->{OnlyIconified} =~ /on/i && !$w->{iconified})
 129                 {
 130                         $module->debug("\t\tnot iconified");
 131                         next;
 132                 }
 133
 134                 my $section = 3;
 135                 if ($config->{ShowName} ne '' &&
 136                         $w->{name} =~ /$config->{ShowName}/i) {
 137                         $section = 0;
 138                 } elsif ($config->{ShowClass} ne '' &&
 139                         $w->{res_class_name} =~ /$config->{ShowClass}/i) {
 140                         $section = 1;
 141                 } elsif ($config->{ShowResource} ne '' &&
 142                         $w->{res_name} =~ /$config->{ShowResource}/i) {
 143                         $section = 2;
 144                 }
 145
 146                 if ($section == 3)
 147                 {
 148                         if (($config->{DontShowName} ne '' &&
 149                                 $w->{name} =~ /$config->{DontShowName}/i) ||
 150                                 ($config->{DontShowClass} ne '' &&
 151                                 $w->{res_class_name} =~ /$config->{DontShowClass}/i) ||
 152                                 ($config->{DontShowResource} ne '' &&
 153                                 $w->{res_name} =~ /$config->{DontShowResource}/i))
 154                         {
 155                                 $module->debug("\t\tin dontshow list");
 156                                 next;
 157                         }
 158                 }
 159                 $module->debug("\t\tadding to section $section");
 160                 AddToSection(\$sections[$section], $id);
 161         }
 162
 163         # tell fvwm to start the menu
 164         $module->send("DestroyMenu recreate $config->{MenuName}");
 165         $module->send("AddToMenu " . $config->{MenuName} . " 'Desk " .
 166                 $win_tracker->page_info('desk_n') . ", Page " .
 167                 $win_tracker->page_info('page_nx') . ' ' .
 168                 $win_tracker->page_info('page_ny') . "' Title");
 169
 170         # now loop on sections sending menu entries to fvwm
 171         while (@sections) {
 172                 my $s = shift @sections;
 173
 174                 if ($s) {
 175                         $module->send($s);
 176                         # add separator after section unless it is the last
 177                         $module->send("+ \"\" Nop") if @sections;
 178                 }
 179         }
 180
 181         # set a menustyle if one given
 182         $module->send("ChangeMenuStyle $config->{MenuStyle} $config->{MenuName}")
 183                 if ($config->{MenuStyle} ne '');
 184
 185         # popup the menu with args we were sent
 186         $module->send("$command $config->{MenuName} $args");
 187 }
 188
 189
 190 # build a line containing the fvwm menu entry for a window
 191 # then add it to the appropriate member of the global array @sections
 192 # args: pointer to section, window id
 193 sub AddToSection ($$) {
 194         my ($s, $id) = @_;
 195
 196         my $format = $config->{ItemFormat};
 197         my $w = $win_tracker->data($id);
 198
 199         # hack: insert __%__ instead of % to avoid bogus substitution later
 200         $format =~ s/%%/__%____%__/g;
 201
 202         # make format string substitutions
 203         $format =~ s/%t/\t/g;
 204         $format =~ s/%n/&Shorten($w->{name})/ge;
 205         $format =~ s/%i/&Shorten($w->{icon_name})/ge;
 206         $format =~ s/%c/&Shorten($w->{res_class_name})/ge;
 207         $format =~ s/%r/&Shorten($w->{res_name})/ge;
 208         $format =~ s/%X/$w->{X}/g;
 209         $format =~ s/%Y/$w->{Y}/g;
 210         $format =~ s/%x/$w->{x}/g;
 211         $format =~ s/%y/$w->{y}/g;
 212         $format =~ s/%d/$w->{desk}/g;
 213
 214         # TODO: doesn't handle EWMH icons yet.
 215         $format =~ s/%m// if ($w->{mini_icon_name} eq 'ewmh_mini_icon');
 216         $format =~ s/%m/__%__$w->{mini_icon_name}__%__/g;
 217
 218         # %M is strange - does anyone really want this behaviour? -- SS.
 219         if ($w->{iconified}) {
 220                 $format =~ s/%M/__%__$w->{mini_icon_name}__%__/g;
 221         } else {
 222                 $format =~ s/%M//g;
 223         }
 224
 225         # now fix __%__ hack
 226         $format =~ s/__%__/%/g;
 227
 228         # escape quotes
 229         $format =~ s/"/\\"/g;
 230
 231         # add the entry to the section
 232         # support two ways for now: window context (new), window id param (old)
 233         $$s .= qq(+ "$format" WindowId $id $config->{Function} $id\n);
 234 }
 235
 236
 237 # shorten a string to given length and append ellipses
 238 sub Shorten ($) {
 239         my ($string) = @_;
 240         my $length = $config->{MaxLen};
 241
 242         my $r = substr($string, 0, $length);
 243         $r .= "..." if length($string) > $length;
 244
 245         # For some special characters, fvwm expects a double sequence to get
 246         # a literal character.
 247         $r =~ s/([*&%^])/$1$1/g;
 248
 249         return $r;
 250 }
 251
 252 sub PopupTaskBar () {
 253         my ($w, $h) = (180, 60);
 254
 255         my $window = new Gtk::Window('toplevel');
 256         $window->set_title("FvwmWindowMenuBar");
 257         $window->set_border_width(5);
 258         $window->set_usize($w, $h);
 259
 260         my $screenW = $win_tracker->page_info('vp_width');
 261         my $screenH = $win_tracker->page_info('vp_height');
 262         $window->set_uposition(($screenW - $w) / 2, ($screenH - $h) / 2);
 263
 264         my $frame = new Gtk::Frame();
 265         $window->add($frame);
 266         $frame->set_shadow_type('etched_out');
 267
 268         my $vbox = new Gtk::VBox();
 269         $frame->add($vbox);
 270
 271         my $label = new Gtk::Label("Nothing interesting yet");
 272         $vbox->add($label);
 273
 274         my $button = new Gtk::Button("Close");
 275         $vbox->add($button);
 276         $button->signal_connect("clicked", sub { $window->destroy; });
 277
 278         $window->show_all;
 279
 280 #       my $win_id = $window->window->XWINDOW();
 281 #       $module->send("Schedule 2000 WindowId $win_id Close");
 282 }
 283
 284 $module->send(
 285         "Style FvwmWindowMenuBar UsePPosition, !Title, !Borders, " .
 286         "StaysOnTop, WindowListSkip, CascadePlacement, SloppyFocus"
 287 ) if $module_type eq "gtk";
 288
 289 $module->event_loop;
 290
 291 1;
 292
 293 __END__
 294
 295 # ----------------------------------------------------------------------------
 296
 297 =head1 NAME
 298
 299 FvwmWindowMenu - open configurable fvwm menu listing current windows
 300
 301 =head1 SYNOPSIS
 302
 303 FvwmWindowMenu should be spawned by fvwm(1) for normal functionality.
 304
 305 Run this module from your StartFunction:
 306
 307     AddToFunc StartFunction
 308     + I Module FvwmWindowMenu
 309
 310 =head1 DESCRIPTION
 311
 312 A substitute for I<fvwm> builtin B<WindowList>, but written in Perl
 313 and easy to customize. Unlike B<FvwmIconMan> or B<FvwmWinList> the
 314 module does not draw its own window, but instead creates an
 315 I<fvwm> menu and asks I<fvwm> to pop it up.
 316
 317 By defining a set of regular expressions, windows may
 318 be sorted into sections based on a regexp matching the window
 319 name, class or resource and included in the menu.
 320
 321 Similarly, another set of regular expressions can be used to exclude
 322 items from the menu.
 323
 324 Any windows not matching an instance of the include or exclude list will
 325 be placed in the last section of the menu.
 326
 327 =head1 USAGE
 328
 329 Run the module, supposedly from StartFunction in I<.fvwm2rc>:
 330
 331     Module FvwmWindowMenu
 332
 333 To actually invoke the menu add something like:
 334
 335     Key Menu A N SendToModule FvwmWindowMenu \
 336         Post Root c c SelectOnRelease Menu
 337
 338 or:
 339
 340     Mouse 2 A N SendToModule FvwmWindowMenu Popup
 341
 342 The additional parameters are any valid B<Menu> command parameters without a
 343 menu name, see L<fvwm>.
 344
 345 Recognized actions are B<Post> (or its alias B<Menu>) and B<Popup>, they
 346 create I<fvwm> menus and invoke them using the corresponding commands
 347 B<Menu> and B<Popup>. If the module was started with "-g" switch, it
 348 additionally supports B<PostBar> (not implemented yet).
 349
 350 Set module options for windows to include (Show) or exclude (DontShow).
 351 The syntax is:
 352
 353     *FvwmWindowMenu: ShowName pattern
 354     *FvwmWindowMenu: ShowClass pattern
 355     *FvwmWindowMenu: ShowResource pattern
 356     *FvwmWindowMenu: DontShowName pattern
 357     *FvwmWindowMenu: DontShowClass pattern
 358     *FvwmWindowMenu: DontShowResource pattern
 359
 360 Pattern is a perl regular expression that will be evaluated in m// context.
 361 See perlre(1).
 362
 363 For example:
 364
 365     *FvwmWindowMenu: ShowResource ^gvim
 366     *FvwmWindowMenu: ShowName Galeon|Navigator|mozilla-bin|Firefox
 367
 368 will define two sections containing respectively browsers, and GVim. A third
 369 section will contain all other windows.
 370
 371 To only include matching windows, add:
 372
 373     *FvwmWindowMenu: DontShowName .*
 374
 375 Similarly:
 376
 377     *FvwmWindowMenu: DontShowName ^Fvwm
 378     *FvwmWindowMenu: DontShowClass Gkrellm
 379
 380 will cause the menu to ignore windows with name beginning with Fvwm
 381 or class gkrellm.
 382
 383 Other options:
 384
 385 =over 4
 386
 387 =item *FvwmWindowMenu: I<OnlyIconified> {on|off}
 388
 389 show only iconified windows
 390
 391 =item *FvwmWindowMenu: I<AllDesks> {on|off}
 392
 393 show windows from all desks
 394
 395 =item *FvwmWindowMenu: I<AllPages> {on|off}
 396
 397 show windows from all pages
 398
 399 =item *FvwmWindowMenu: I<MaxLen> 32
 400
 401 max length in chars of entry
 402
 403 =item *FvwmWindowMenu: I<MenuName> MyMenu
 404
 405 name of menu to popup
 406
 407 =item *FvwmWindowMenu: I<MenuStyle> MyMenuStyle
 408
 409 name of MenuStyle to apply
 410
 411 =item *FvwmWindowMenu: I<Debug> {0,1,2,3}
 412
 413 level of debug info output, 0 means no debug
 414
 415 =item *FvwmWindowMenu: I<Function> MyWindowListFunc
 416
 417 function to invoke on menu entries; defaults to WindowListFunc
 418
 419 =item *FvwmWindowMenu: I<ItemFormat> formatstring
 420
 421 how to format menu entries; substitutions are made as follows:
 422
 423 =over 4
 424
 425 =item %n, %i, %c, %r
 426
 427 the window name, icon name, class or resource
 428
 429 =item %x, %y
 430
 431 the window x or y coordinates w.r.t. the page the window is on.
 432
 433 =item %X, %Y
 434
 435 the window x or y coordinates w.r.t. the desk the window is on.
 436
 437 =item %d
 438
 439 the window desk number
 440
 441 =item %m
 442
 443 the window's mini-icon
 444
 445 =item %M
 446
 447 the window's mini-icon only for iconified windows, otherwise empty
 448
 449 =item %t
 450
 451 a tab
 452
 453 =item %%
 454
 455 a literal %
 456
 457 =back
 458
 459 The format string must be quoted. The default string is
 460 "%m%n%t%t(+%x+%y) - Desk %d".
 461
 462 =back
 463
 464 =head1 MORE EXAMPLES
 465
 466 Fancy binding of the window menu to the right windows key on some keyboards.
 467 Hold this button while navigating using cursor keys, then release it.
 468
 469     CopyMenuStyle * WindowMenu
 470     MenuStyle WindowMenu SelectOnRelease Super_R
 471     *FvwmWindowMenu: MenuStyle WindowMenu
 472
 473     AddToFunc StartFunction I Module FvwmWindowMenu
 474
 475     Key Super_R A A SendToModule FvwmWindowMenu Post Root c c WarpTitle
 476
 477 =head1 AUTHORS
 478
 479 Richard Lister <ric+lister@cns.georgetown.edu>.
 480
 481 Scott Smedley <ss@aao.gov.au>.
 482
 483 Mikhael Goikhman <migo@homemail.com>.
 484
 485 =cut