#!/usr/bin/perl use strict; use warnings; no warnings 'once'; # till I use proper package import/export =pod =head1 NAME screenpager - screenwise pager for Xinerama =head1 SYNOPSIS screenpager [I] display on|off test screenpager [I] move west|east|up|down screenpager [I] new | delete screenpager [I] output screen screenpager [I] page up|down screenpager [I] reset screenpager [--duration=I] [--focus] [--osd=on|off] [--screen=I|west|east|mouse] [--wrap] [I] screenpager --help | --man | --version =head1 DESCRIPTION Screenpager is a screenwise pager for X workstations running Xinerama. It works like a desktop pager, but acts at the level of screens. Instead of paging the desktop as a whole, it can page each screen independently, or move pages from screen to screen. Control is by command. Commands are issued either from the command line; from keystroke or mouse bindings; or from scripts. Screenpager itself is a script, written in Perl. =cut umask 0000; # Masking no bits, not even for non-owners. Anyone may freely overwrite or delete # Screenpager’s temporary files. Else if it were invoked just once by the root user, # thereafter it would die on a permission fault for all others. require Getopt::Long; require Pod::Usage; use lib "$ENV{HOME}/.config", '/etc/xdg'; # for loading config files, more or less per http://www.freedesktop.org/Standards/basedir-spec sub _change_window_state( $$$ ); # ( change, property names, window ) # # Commands the given change ('add', 'remove' or 'toggle') to the named properties (prop1[,prop2]) # of the identified window. Each is a `_NET_WM_STATE…` property, but is named in `wmctrl` form, # such as 'maximized_horz' or 'shaded'. # sub _create_complaint_command_output( $ ); # ( command ) # # Creates a string complaining that output from the command is unrecognized. # sub _extricate_page( $ ); # ( page ) # # Extricates the specified page from its position in the stacking order. The page # ends up solitary (no links with adjacent pages). # # See also _insert_page_above and _insert_page_below. # sub _get_adjacent_page( $$ ); # ( 'up|down', page ) ret$ page|'' # # Returns an adjacent page in the stacking order, up or down from the specified # page. # sub _get_current_desktop(); # ret$ desktop # # Returns the current desktop. # sub _get_current_page(); # ret$ page # # Returns the current page of the focused screen. # sub _set_current_page( $ ); # ( page ) # # Sets the current page. # sub _get_current_windows(); # ret@ # # Returns list of ID's (e.g. 0x140009e) representing all pageable windows contained # in the focused screen; in reverse stacking order, bottom to top. # sub _get_desktop_height(); # ret$ desktop width # # Returns height of desktop # sub _get_desktop_width(); # ret$ desktop width # # Returns width of desktop # sub _get_inter_page_dir(); # ret$ # # Returns the path to the inter-page state directory. Creates the directory if # necessary. Contains files numbered by page ID. # # Contents of each page file are 2 lines linking to adjacent pages, in page stacking # order: # # |'' # |'' # # Garbage may follow, because this file is sometimes written without prior # truncation (e.g. in mode '+<'). # sub _get_intra_page_dir(); # ret$ # # Returns the path to the intra-page state directory. Creates the directory if # necessary. Contains files numbered by page ID. # # Contents of each page file is one line for each swapped out window, in reverse # stacking order, bottom to top. # # # * # # If no windows are swapped out, the file might not exist. # sub _get_screen(); # ret$ # # Returns the active screen. This is either as specified by --screen, or the # default from previous runs. Screens are numbered from 0. # sub _set_screen( $ ); # ( screen ) # # Changes the active screen. # sub _set_default_screen( $ ); # ( screen ) # # Sets the default active screen. The default persists from run to run. # sub _get_screen_dir(); # ret$ # # Returns the path to the screen state-directory. Creates the directory if # necessary. Used for storing screen state. Contains files numbered by screen ID. # # Contents of each screen file is a single line as follows. # # # sub _get_state_dir(); # ret$ # # Returns the path to the state directory. Creates the directory if necessary. Used # primarily for storing short-term state that persists from run to run of # Screenpager. # # Warning: see _lock. # sub _get_swap_desktop(); # ret$ desktop # # Returns desktop to which swapped out windows are sent. # sub _get_swapped_out_windows( $ ); # ( swapped out page ) ret@ its windows # # Returns list of ID's (e.g. 0x140009e) representing all windows contained in the # swapped out page; in reverse stacking order, bottom to top. # sub _get_window_title( $ ); # ( window ) ret$ # # Returns the title of the specified window. # sub _get_window_width( $ ); # ( window ) ret$ # # Returns the width of the specified window. # sub _get_window_x( $ ); # ( window ) ret$ # # Returns the x coordinate of the specified window. # our %_wininfo_x; # # Use 'delete $_wininfo_x{$window}' to clear the cached value, if you know the # window has been moved. # sub _insert_page_above( $ ); # ( page ) # sub _insert_page_below( $ ); # ( page ) # # Inserts the specified page above or below the current page the focused screen. # The page must be solitary (no links with adjacent pages). # # See also _extricate_page. # sub _is_window_fullscreen( $ ); # ( window ) ret$ true|false # # Returns true if the specified window has _NET_WM_STATE_FULLSCREEN. # sub _is_window_maximized_horz( $ ); # ( window ) ret$ true|false # # Returns true if the specified window has _NET_WM_STATE_MAXIMIZED_HORZ. # sub _is_window_maximized_vert( $ ); # ( window ) ret$ true|false # # Returns true if the specified window has _NET_WM_STATE_MAXIMIZED_VERT. # sub _is_window_net_state( $$ ); # ( atom, window ) ret$ true|false # # Returns true if the window's _NET_WM_STATE includes the specified atom. # sub _lock(); # # Sieze the run lock. It is automatically released on exit. # # Used to serialize runs that might otherwise contend for resources (e.g. state # files in _get_state_dir) owing to internal forks or calls from external threads. # Used by all invocations that read or write these resources. # # Caveats: # - unlock before you block # - unlock and re-lock before and after forking; # unless you really want both processes to inherit the lock, per Perl flock() # sub _unlock(); # # Release the run lock. # sub _new_page(); # ret$ page # # Per 'new' argument. # sub _osd( $ ); # ( duration ) # Blocks while the OSD process is running. sub _osd_as_requested_and_exit(); # # Sets the OSD according to --osd, and immediately exits. Never returns. # sub _osd_process_file( $ ); # ( layer name ) ret$ # # Returns the path to the OSD process file for the specified layer. Layer is one of # the $_osd_layer_* constants (see below) that distinguish the separate OSD # functions. The content of the process file identifies the currently running OSD # processes for that layer. For example: # # process 1 ID # process 2 ID # *_osd_layer_main = \'main'; # ' # # Names the main layer, which shows the list of virtual pages contained in the # screen. # *_osd_removal_signal = \2; # INT signal # # Signal sent to display processes, to remove display from screen, e.g. when no # longer up to date. # # [Could simply close it via WM, if it were a managed window. As it is, could xkill # it; which might remove its window faster and solve the 'slow to refresh' problem. # That would require something (xwininfo?) to translate PID into window ID for # xkill. But xkill unlikely to be safe for routine use.] # sub _page( $;$ ); # ( 'up|down', swap out windows? ) ret@ # # Per 'page' argument. Optionally specify 0 to skip swapping out windows. Returns # a list of the windows that were swapped out. # sub _reset(); # # Per 'reset' argument. # sub _reset_if_first_run(); # # Does a 'reset' if this is the first run of the X session; otherwise does nothing. # # Not currently supported. # sub _shift_options(); # # Shifts command line options into %option. # our %option; # ---------------------------------------------------------------------------------------- _shift_options; my $argument = shift; defined $argument or $argument = ''; # prevent warnings # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'delete' ) { =pod =head1 ARGUMENTS =over 8 =item B Deletes the current screen page. Sends a close request to all of its windows. Swaps in the page below, if any, otherwise the page above. =cut _lock; # _reset_if_first_run; defined $option{focus} and _set_default_screen( _get_screen ); my @old_window = _get_current_windows; # before paging any new ones in over top ;) my $page_to_delete = _get_current_page; if( _get_adjacent_page('down', $page_to_delete) ne '' ) { _page( 'down', 0 ); _extricate_page $page_to_delete; } elsif( _get_adjacent_page('up', $page_to_delete) ne '' ) { _page( 'up', 0 ); _extricate_page $page_to_delete; } my $window; my $warn_count = 0; # thus far for $window( @old_window ) # bottom to top in stacking order (cf. _page) { my $command = "wmctrl -i -c $window"; if( system $command ) # fails { $warn_count or warn 'unable to execute: ' . $command; $warn_count++; # silent hereafter next; } } _osd_as_requested_and_exit; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'display' ) { _lock; # _reset_if_first_run; defined $option{focus} and _set_default_screen( _get_screen ); my $sub_argument = shift; defined $sub_argument or $sub_argument = ''; # prevent warnings my $test = shift; defined $test or $test = ''; # prevent warnings if( !$test ) { =pod =item B on|off Deprecated in favour of --osd option. =cut if( $sub_argument eq 'on' || $sub_argument eq 'off' ) { $option{osd} = $sub_argument; # force _osd_as_requested_and_exit; } Pod::Usage::pod2usage( -verbose => 0 ); # and exits } else # test { =pod =item display on|off test Tests whether the on-screen display is on or off. Exits with status 0 for true; 1 for false. Option --duration may be used with the off test, e.g.: C returns true if the display has been off for 13 seconds, or longer. =cut my $true = 0; # for 'test' purposes my $false = 1; my $is_on = ''; # false, till proven otherwise my $osd_process_file = _osd_process_file( $::_osd_layer_main ); if( -f $osd_process_file ) { my $current_osd_process; open PROCESS, "<$osd_process_file" or die $!; # no lock to read, issue non-critical, per _osd_process_file { $current_osd_process = ; close PROCESS; } $current_osd_process and chomp $current_osd_process; $current_osd_process and $is_on = 1; } if( $sub_argument eq 'on' ) { my $result = $false; # till proven otherwise $is_on and $result = $true; exit $result; } if( $sub_argument eq 'off' ) { my $result; my $duration = $option{duration}; if( defined $duration && -f $osd_process_file ) { $duration >= 0 or warn "your --duration=$duration, but should be >= 0,"; # negatives are meaningless here $result = $false; # till proven otherwise if( !$is_on ) { require File::stat; my $display_process_stat = File::stat::stat( $osd_process_file ) or die "$!"; time - $display_process_stat->mtime > $duration and $result = $true; } } else # plain off test { $result = $true; # till proven otherwise $is_on and $result = $false; } exit $result; } Pod::Usage::pod2usage( -verbose => 0 ); # and exits } } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'focus' ) { =pod =item B west|east Sets a new focus screen. Deprecated in favour of the C<--focus> option. =item focus --screen=I|mouse Sets the default screen according to the --screen option. Also deprecated. =cut _lock; # _reset_if_first_run; my $new_screen = _get_screen; # till proven otherwise { my $sub_argument = shift; if( defined $sub_argument ) { use screenpager::Config_1 (); my $east_screen = @screenpager::Config_1::screen - 1; if( $sub_argument eq 'west' ) { --$new_screen; if( $new_screen < 0 ) { if( defined $option{wrap} ) { $new_screen = $east_screen; } else { $new_screen = 0; } } } elsif( $sub_argument eq 'east' ) { ++$new_screen; if( $new_screen > $east_screen ) { if( defined $option{wrap} ) { $new_screen = 0; } else { $new_screen = $east_screen; } } } else { Pod::Usage::pod2usage( -verbose => 0 ); # and exits } } } _set_screen( $new_screen ); _set_default_screen( $new_screen ); _osd_as_requested_and_exit; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'move' ) { =pod =item B west|east|up|down Moves a page: either to an adjacent screen; or up or down in the stacking order. =cut _lock; # _reset_if_first_run; # defined $option{focus} and _set_default_screen( _get_screen ); ## will do it later, because focus may move my $direction = shift; defined $direction or $direction = ''; # prevent warnings # - - - - - - - - - - - - - - - - - - - - - - - - - if( $direction eq 'west' || $direction eq 'east' ) { my $adjacent_screen; # if any # my( $delta_x_left, $delta_x_right ); # depending which edge gap you want to hold constant, betwixt the window and the screen, when moving to different sized screens (but I always use the right, because I don't believe I can control this, given how wmctrl adjusts position on me) (and if the choice depends on edge proximity, as I planned, then I'd have to change window width proportional to new screen size, else the move would not always be reversible, because edge proximity would be screen dependent) my $delta_x_right = 0; # so far { my $screen = _get_screen; require screenpager::Config_1; my $east_screen = @screenpager::Config_1::screen - 1; if( $direction eq 'west' ) { $adjacent_screen = $screen - 1; if( $adjacent_screen < 0 ) { if( defined $option{wrap} ) { $adjacent_screen = $east_screen; } else { undef $adjacent_screen; } } } else # east { $adjacent_screen = $screen + 1; if( $adjacent_screen > $east_screen ) { if( defined $option{wrap} ) { $adjacent_screen = 0; } else { undef $adjacent_screen; } } } if( defined $adjacent_screen ) { if( $adjacent_screen < $screen ) # move west { for( my $s = $screen; $s > $adjacent_screen; --$s ) { my $s_config_HASH = $screenpager::Config_1::screen[$s]; $delta_x_right -= $$s_config_HASH{width}; } } else # move east { for( my $s = $screen + 1; $s <= $adjacent_screen; ++$s ) { my $s_config_HASH = $screenpager::Config_1::screen[$s]; $delta_x_right += $$s_config_HASH{width}; } } } } if( defined $adjacent_screen ) { my $page = _get_current_page; my @window; { if( _get_adjacent_page('down',$page) ne '' ) { @window = _page 'down'; } else { _get_adjacent_page('up',$page) eq '' and _insert_page_above( _new_page ); @window = _page 'up'; } } { my $warn_count = 0; # thus far my $window; foreach $window( @window ) { my $command; my $is_window_fullscreen = _is_window_fullscreen $window; my $is_window_maximized_horz = _is_window_maximized_horz $window; $is_window_fullscreen and _change_window_state # else x translation fails ( 'remove', 'fullscreen', $window ); $is_window_maximized_horz and _change_window_state ( 'remove', 'maximized_horz', $window ); $is_window_fullscreen || $is_window_maximized_horz and delete $_wininfo_x{$window}; # because I just changed it when I changed window state, and I want _get_window_x below to reflect the new (unmaximized) position { my $x = _get_window_x $window; $x += $delta_x_right; $x == -1 and $x = 0; # workaround for wmctrl bug, cannot position at -1, because -1 means 'unchanged' # So I was going to put this in CAVEATS: # "When a page is moved west, # any window bound for screen co-ordinate (-1,y) # will instread end up at (0,y)." # but that's nothing compared with what wmctrl does when windows don't fit. $command = "wmctrl -i -r $window -e 0,$x,-1,-1,-1"; # gravity,x,y,width,height if( system $command ) # fails { $warn_count or warn 'unable to execute: ' . $command; $warn_count++; # silent hereafter } $is_window_fullscreen and _change_window_state # revert to original state ( 'add', 'fullscreen', $window ); $is_window_maximized_horz and _change_window_state ( 'add', 'maximized_horz', $window ); } } } _extricate_page( $page ); _set_screen( $adjacent_screen ); _insert_page_above( $page ); _page 'up'; } defined $option{focus} and _set_default_screen( _get_screen ); } # - - - - - - - - else # move up|down { defined $option{focus} and _set_default_screen( _get_screen ); if( $direction eq 'up' || $direction eq 'down' ) { my $page = _get_current_page; my $next_page = _get_adjacent_page( $direction, $page ); if( $next_page ne '' ) { _extricate_page( $next_page ); if( $direction eq 'up' ) { _insert_page_below( $next_page ); } else # down { _insert_page_above( $next_page ); } } elsif( defined $option{wrap} ) { if( $direction eq 'up' ) # then wrap to bottom { for( ;; ) # move all other pages above this one { my $previous_page = _get_adjacent_page( 'down', $page ); $previous_page eq '' and last; _extricate_page( $previous_page ); _insert_page_above( $previous_page ); } } else # down, so wrap to top { for( ;; ) # move all other pages below this one { my $previous_page = _get_adjacent_page( 'up', $page ); $previous_page eq '' and last; _extricate_page( $previous_page ); _insert_page_below( $previous_page ); } } } } else { Pod::Usage::pod2usage( -verbose => 0 ); # and exits } } # - - - _osd_as_requested_and_exit; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'new' ) { =pod =item B Creates a new screen page. Places it above the current page in stacking order, and swaps it in. =cut _lock; # _reset_if_first_run; defined $option{focus} and _set_default_screen( _get_screen ); my $new_page = _new_page; _insert_page_above $new_page; _page 'up'; _osd_as_requested_and_exit; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'output' ) { =pod =item B screen Outputs the active screen: either as specified in an accompanying screen option (e.g. --screen mouse); or the default in effect from the latest C command. =cut _lock; # _reset_if_first_run; my $object = shift; defined $object or $object = ''; # prevent warnings if( $object eq 'screen' ) { print _get_screen; } else { Pod::Usage::pod2usage( -verbose => 0 ); # and exits } print "\n"; _osd_as_requested_and_exit; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'page' ) { =pod =item B up|down Traverses up or down through the stack of screen pages. The current page is swapped out, and the next one is displayed in its place. =cut _lock; # _reset_if_first_run; defined $option{focus} and _set_default_screen( _get_screen ); my $direction = shift; defined $direction or $direction = ''; # prevent warnings if( $direction eq 'up' || $direction eq 'down' ) { _page $direction; } else { Pod::Usage::pod2usage( -verbose => 0 ); # and exits } _osd_as_requested_and_exit; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq 'reset' ) { =pod =item B Clears all state. Swapped out pages are forgotten; windows in the swap desktop are left there, and ignored. Normally issued at the start of each new X session, e.g. from your F<.xinitrc> file. =cut _lock; _reset; _osd_as_requested_and_exit; } =pod =back =cut # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = if( $argument eq '' && scalar %option ) { _lock; defined $option{focus} and _set_default_screen( _get_screen ); _osd_as_requested_and_exit; } Pod::Usage::pod2usage( -verbose => 0 ); # and exits ##### S u b - B o d y #################################################################### sub _change_window_state( $$$ ) { my $change = shift; my $property_names = shift; my $window = shift; my $command = "wmctrl -i -r $window -b $change,$property_names"; system $command and warn 'unable to execute: ' . $command; } sub _create_complaint_command_output( $ ) { my $command = shift; return "unrecognized output from '$command'"; } sub _extricate_page( $ ) # # Attempt is made (for what it's worth) # to order statements to reduce likelihood of inconsistencies # arising if execution is interrupted. { my $page = shift; my $page_file = _get_inter_page_dir . "/$page"; open FILE, "+<$page_file" or die $!; { $_ = ; chomp $_; my $page_above = $_; $_ = ; chomp $_; my $page_below = $_; seek FILE, 0, 0; if( $page_above ne '' ) { my $page_above_file = _get_inter_page_dir . "/$page_above"; open FILE_ABOVE, "+<$page_above_file" or die $!; { my $page_above_above_line = ; $_ = ; chomp $_; $_ == $page or die "bad page link: $page_file + $page_above_file"; seek FILE_ABOVE, 0, 0; print FILE_ABOVE $page_above_above_line; print FILE_ABOVE $page_below . "\n"; # 1 print FILE "\n"; # 2, unbuckle my shoe (as fast as can do) close FILE_ABOVE; } } else { print FILE "\n"; # 2 (unbuckled, as it began) } if( $page_below ne '' ) { my $page_below_file = _get_inter_page_dir . "/$page_below"; open FILE_BELOW, "+<$page_below_file" or die $!; { $_ = ; chomp $_; $_ == $page or die "bad page link: $page_below_file + $page_file"; my $page_below_below_line = ; seek FILE_BELOW, 0, 0; print FILE "\n"; # 3 print FILE_BELOW $page_above . "\n"; # 4, unbuckle my other shoe (as fast as can do) print FILE_BELOW $page_below_below_line; close FILE_BELOW; } } else { print FILE "\n"; # 3 (unbuckled, as it began) } close FILE; } } sub _get_adjacent_page( $$ ) { my $direction = shift; my $original_page = shift; my $next_page; { my $original_page_file = _get_inter_page_dir . "/$original_page"; open FILE, "<$original_page_file" or die $!; { $_ = ; chomp $_; my $page_above = $_; if( $direction eq 'up' ) { $next_page = $page_above; } else { $direction eq 'down' or die; $_ = ; chomp $_; my $page_below = $_; $next_page = $page_below; } close FILE; } } return $next_page; } sub _get_current_desktop() { my $command = 'xprop -root _NET_CURRENT_DESKTOP'; $_ = `$command`; # e.g. _NET_CURRENT_DESKTOP(CARDINAL) = 0 m'= ([0-9]+)$' or die _create_complaint_command_output $command; my $current_desktop = $1; # e.g. 0 return $current_desktop; } our @_current_page; # cached from all screen files, except kill sub _get_current_page() { my $screen = _get_screen; defined $_current_page[$screen] and return $_current_page[$screen]; # cached my $screen_file = _get_screen_dir . "/$screen"; if( -f $screen_file ) { open FILE, "<$screen_file" or die $!; { $_ = ; chomp; $_current_page[$screen] = $_; close FILE; } } if( !defined $_current_page[$screen] ) # then it's the initial page, yet to be created { _set_current_page( _new_page ); } return $_current_page[$screen]; } sub _set_current_page( $ ) { my $page = shift; my $screen = _get_screen; my $screen_file = _get_screen_dir . "/$screen"; open FILE, ">$screen_file" or die $!; { print FILE $page; close FILE; } $_current_page[$screen] = $page; } sub _get_current_windows() { my $screen = _get_screen; # Calculate screen geometry. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - require screenpager::Config_1; my $screen_x0 = 0; # leftmost column of screen, in desktop space # so far my $s = 0; for(; $s < $screen; ++$s ) { my $s_config_HASH = $screenpager::Config_1::screen[$s]; $screen_x0 += $$s_config_HASH{width}; } my $screen_x1; # rightmost column of screen, in desktop space { my $screen_config_HASH = $screenpager::Config_1::screen[$screen]; $screen_x1 = $screen_x0 + $$screen_config_HASH{width} - 1; } # List all windows. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - require X11::Protocol; my $server = X11::Protocol->new(); my @full_window_list; { my $atom = $server->atom( '_NET_CLIENT_LIST_STACKING' ); my $elements_to_get = 256; # at a time (actual value not critical) my $element_offset = 0; # to start for( ;; ) { my( $value, $type, $format, $bytes_after ) = $server->GetProperty ( $server->root, $atom, 'AnyPropertyType', $element_offset, $elements_to_get ); $format == 32 or die; push @full_window_list, unpack( 'L*', $value ); # push @full_window_list, unpack( 'I*', $value ); $bytes_after or last; $element_offset += $elements_to_get; } } my @window; my $desktop = _get_current_desktop; my $w; FILTER: foreach $w( @full_window_list ) { # Filter by desktop. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - { my $atom = $server->atom( '_NET_WM_DESKTOP' ); my( $value, $type, $format, $bytes_after ); eval { ( $value, $type, $format, $bytes_after ) = $server->GetProperty( $w, $atom, 'AnyPropertyType', 0, 1 ); }; $@ and next FILTER; # protocol error, probably because $w has closed if( $format != 32 ) { # warn "bad format ($format), assume window closed"; next FILTER; } my $w_desktop = unpack 'L', $value; # -1 (or its unsigned equivalent) for windows which appear on all desktops # so we filter those out too $w_desktop == $desktop or next FILTER; } # Filter by window type. # Only normal, top-level windows are pageable. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $command = "xprop -id $w WM_TRANSIENT_FOR"; $_ = `$command`; # e.g. WM_TRANSIENT_FOR(WINDOW): window id # 0xa0010d m'0x[0-9a-f]+$'i and next FILTER; # transient for parent # not pageable # will automatically follow its parent m'none|root'i and next FILTER; # transient for group, per http://www.freedesktop.org/standards/wm-spec/ $command = "xprop -id $w _NET_WM_WINDOW_TYPE"; $_ = `$command`; # e.g. (though result may also be a 'list'): _NET_WM_WINDOW_TYPE(ATOM) = _NET_WM_WINDOW_TYPE_NORMAL ( m'_NET_WM_WINDOW_TYPE.*_NET_WM' # at least one type is defined && !m'_NET_WM_WINDOW_TYPE_NORMAL' ) # and it is not the normal type and next FILTER; # Filter by screen. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $mid_x = _get_window_x($w) + _get_window_width($w) / 2; # rough center column of window ( $mid_x < $screen_x0 || $mid_x > $screen_x1 ) and next FILTER; # - - - push @window, $w; } return @window; } our $_desktop_height; our $_desktop_width; sub _set_desktop_dimensions() { my $command = 'xprop -root _NET_DESKTOP_GEOMETRY'; $_ = `$command`; # e.g. _NET_DESKTOP_GEOMETRY(CARDINAL) = 3584, 1024 m'([0-9]+), ([0-9]+)$' or die _create_complaint_command_output $command; $_desktop_width = $1; # e.g. 3584 $_desktop_height = $2; # e.g. 1024 } sub _get_desktop_height() { our $_desktop_height; defined $_desktop_height or _set_desktop_dimensions(); return $_desktop_height; } sub _get_desktop_width() { our $_desktop_width; defined $_desktop_width or _set_desktop_dimensions(); return $_desktop_width; } sub _get_inter_page_dir() { my $dir = _get_state_dir . '/inter-page'; -d $dir or mkdir $dir or die "$! ($dir)"; return $dir; } sub _get_intra_page_dir() { my $dir = _get_state_dir . '/intra-page'; -d $dir or mkdir $dir or die "$! ($dir)"; return $dir; } sub _get_default_screen(); # ret$ screen sub _get_screen() { my $screen; my $screen_option = $option{screen}; if( defined $screen_option ) { if( $screen_option =~ '^[0-9]+$' ) { $screen = $screen_option; } elsif( $screen_option eq 'west' ) { $screen = _get_default_screen(); --$screen; if( $screen < 0 ) { if( defined $option{wrap} ) { use screenpager::Config_1 (); my $east_screen = @screenpager::Config_1::screen - 1; $screen = $east_screen; } else { $screen = 0; } } } elsif( $screen_option eq 'east' ) { use screenpager::Config_1 (); my $east_screen = @screenpager::Config_1::screen - 1; $screen = _get_default_screen(); ++$screen; if( $screen > $east_screen ) { if( defined $option{wrap} ) { $screen = 0; } else { $screen = $east_screen; } } } elsif( $screen_option eq 'mouse' ) { require Tk; my $dummy_window = Tk::MainWindow->new(); my $mouse_x = $dummy_window->pointerx; $dummy_window->destroy(); require screenpager::Config_1; $screen = -1; # initially my $screen_x1 = -1; # right-most column of screen, in desktop space for( ;; ) { ++$screen; $screen < @screenpager::Config_1::screen or last; my $screen_config_HASH = $screenpager::Config_1::screen[$screen]; $screen_x1 += $$screen_config_HASH{width}; $mouse_x > $screen_x1 or last; } _set_screen( $screen ) # make it constant (despite active window changing as command takes effect) } else { Pod::Usage::pod2usage( -verbose => 0 ); # and exits } } defined $screen or $screen = _get_default_screen; return $screen; } sub _set_screen( $ ) { my $screen = shift; $option{screen} = $screen; } sub _get_screen_focus_file() { return _get_state_dir . '/focused-screen'; } our $_default_screen; # cache of _get_screen_focus_file sub _get_default_screen() { defined $_default_screen and return $_default_screen; # cached require screenpager::Config_1; my $focus_file = _get_screen_focus_file; if( -f $focus_file ) { open FILE, "<$focus_file" or die $!; { $_ = ; chomp $_; $_default_screen = $_; close FILE; } } if( defined $_default_screen ) { my $east_screen = @screenpager::Config_1::screen - 1; $_default_screen > $east_screen and $_default_screen = $east_screen; # failsafe, in case screen count reduced return $_default_screen; } $_default_screen = int( @screenpager::Config_1::screen / 2 ); # default to middle screen return $_default_screen; } sub _set_default_screen( $ ) { my $new_screen = shift; defined $_default_screen && $new_screen == $_default_screen and return; # would be redundant my $focus_file = _get_screen_focus_file; open FILE, ">$focus_file" or die $!; { print FILE $new_screen; close FILE; } $_default_screen = $new_screen; } sub _get_screen_dir() { my $dir = _get_state_dir . '/screen'; -d $dir or mkdir $dir or die "$! ($dir)"; return $dir; } sub _get_state_dir() { my $temp_dir = $screenpager::Config_1::temp_dir; my $dir = $temp_dir . '/.screenpager'; -d $dir or mkdir $dir or die "$! ($dir)"; # chmod 0777, $dir or die "$! ($dir)"; ## Redundant owing to prior `umask 0000` return $dir; } sub _get_swap_desktop() { require screenpager::Config_1; my $swaptop = $screenpager::Config_1::swap_desktop; my $command; $command = 'xprop -root _NET_NUMBER_OF_DESKTOPS'; $_ = `$command`; # e.g. _NET_NUMBER_OF_DESKTOPS(CARDINAL) = 2 /= ([0-9]+)$/ or die _create_complaint_command_output $command; my $desktop_count = $1; # e.g. 2 $swaptop < $desktop_count or die "Config_1.pm error: \$swap_desktop ($swaptop) does not exist"; _get_current_desktop != $swaptop or die "unable to page from this desktop ($swaptop), it's the swap desktop"; return $swaptop; } sub _get_swapped_out_windows( $ ) { my $page = shift; my @window; my $page_file = _get_intra_page_dir . "/$page"; if( -f $page_file ) { open FILE, "<$page_file" or die $!; { while( ) { chomp; push @window, $_; } close FILE; } } return @window; } # cf. /home/mike/system/bin/desk-launch sub _fetch_wininfo( $ ); # ( window ) # # Executes xwinfo for specified window, # and caches various results in %_winfo_*. # (With the execption of %_wininfo_x (q.v.) # none of this state is changed by Screenpager, # so the cache should remain accurate.) # our %_wininfo_title; sub _get_window_title( $ ) { my $window = shift; my $title = $_wininfo_title{$window}; if( !defined $title ) { _fetch_wininfo $window; $title = $_wininfo_title{$window}; } return $title; } our %_wininfo_width; sub _get_window_width( $ ) { my $window = shift; my $width = $_wininfo_width{$window}; if( !defined $width ) { _fetch_wininfo $window; $width = $_wininfo_width{$window}; } return $width; } # our %_wininfo_x; ## declared above, as a special case sub _get_window_x( $ ) { my $window = shift; my $x = $_wininfo_x{$window}; if( !defined $x ) { _fetch_wininfo $window; $x = $_wininfo_x{$window}; } return $x; } sub _insert_page_above( $ ) # # Attempt is made (for what it's worth) # to order statements to reduce likelihood of inconsistencies # arising if execution is interrupted. { my $page = shift; my $page_below = _get_current_page; # above which $page will be inserted $page != $page_below or die; my $page_file = _get_inter_page_dir . "/$page"; open FILE, "+<$page_file" or die $!; { { $_ = ; chomp $_; my $old_page_above = $_; $_ = ; chomp $_; my $old_page_below = $_; !$old_page_above && !$old_page_below or die "cannot insert linked page: $page_file"; seek FILE, 0, 0; } my $page_below_file = _get_inter_page_dir . "/$page_below"; open FILE_BELOW, "+<$page_below_file" or die $!; { $_ = ; chomp $_; my $page_above = $_; my $page_below_below_line = ; seek FILE_BELOW, 0, 0; if( $page_above ne '' ) { my $page_above_file = _get_inter_page_dir . "/$page_above"; open FILE_ABOVE, "+<$page_above_file" or die $!; { my $page_above_above_line = ; $_ = ; chomp $_; my $old_page_above_below = $_; $old_page_above_below == $page_below or die "bad page link: $page_below_file + $page_above_file"; seek FILE_ABOVE, 0, 0; print FILE_ABOVE $page_above_above_line; print FILE_ABOVE $page . "\n"; # 1 print FILE $page_above . "\n"; # 2, buckle my shoe (as fast as can do) close FILE_ABOVE; } } else { print FILE $page_above . "\n"; # 2 no bucklin' to do } print FILE $page_below . "\n"; # 3 print FILE_BELOW $page . "\n"; # 4, buckle my other shoe (as fast as can do) print FILE_BELOW $page_below_below_line; close FILE_BELOW; } close FILE; } } sub _insert_page_below( $ ) { my $page = shift; my $page_above = _get_current_page; # below which $page will be inserted $page != $page_above or die; my $page_file = _get_inter_page_dir . "/$page"; open FILE, "+<$page_file" or die $!; { { $_ = ; chomp $_; my $old_page_above = $_; $_ = ; chomp $_; my $old_page_below = $_; !$old_page_above && !$old_page_below or die "cannot insert linked page: $page_file"; seek FILE, 0, 0; } my $page_above_file = _get_inter_page_dir . "/$page_above"; open FILE_ABOVE, "+<$page_above_file" or die $!; { my $page_above_above_line = ; $_ = ; chomp $_; my $page_below = $_; seek FILE_ABOVE, 0, 0; print FILE_ABOVE $page_above_above_line; print FILE_ABOVE $page . "\n"; # 1 print FILE $page_above . "\n"; # 2, buckle my shoe (as fast as can do) if( $page_below ne '' ) { my $page_below_file = _get_inter_page_dir . "/$page_below"; open FILE_BELOW, "+<$page_below_file" or die $!; { $_ = ; chomp $_; my $old_page_below_above = $_; my $page_below_below_line = ; $old_page_below_above == $page_above or die "bad page link: $page_above_file + $page_below_file"; seek FILE_BELOW, 0, 0; print FILE $page_below . "\n"; # 3 print FILE_BELOW $page . "\n"; # 4, buckle my other shoe (as fast as can do) print FILE_BELOW $page_below_below_line; close FILE_BELOW; } } else { print FILE $page_below . "\n"; # 3 no bucklin' to do } close FILE_ABOVE; } close FILE; } } # cf. /home/mike/system/bin/desk-launch our %_wininfo_is_fullscreen; sub _is_window_fullscreen( $ ) { my $window = shift; my $is_fullscreen = $_wininfo_is_fullscreen{$window}; if( !defined $is_fullscreen ) { _fetch_wininfo $window; $is_fullscreen = $_wininfo_is_fullscreen{$window}; } return $is_fullscreen; } our %_wininfo_is_maximized_horz; sub _is_window_maximized_horz( $ ) { my $window = shift; my $is_maximized_horz = $_wininfo_is_maximized_horz{$window}; if( !defined $is_maximized_horz ) { _fetch_wininfo $window; $is_maximized_horz = $_wininfo_is_maximized_horz{$window}; } return $is_maximized_horz; } our %_wininfo_is_maximized_vert; sub _is_window_maximized_vert( $ ) { my $window = shift; my $is_maximized_vert = $_wininfo_is_maximized_vert{$window}; if( !defined $is_maximized_vert ) { _fetch_wininfo $window; $is_maximized_vert = $_wininfo_is_maximized_vert{$window}; } return $is_maximized_vert; } our %_wininfo_net_wm_state; # e.g. _NET_WM_STATE(ATOM) = _NET_WM_STATE_FULLSCREEN, _NET_WM_STATE_MAXIMIZED_VERT, _OB_WM_STATE_UNDECORATED sub is_window_net_state( $$ ) { my $atom = shift; my $window = shift; my $state = $_wininfo_net_wm_state{$window}; if( !defined $state ) { _fetch_wininfo( $window ); $state = $_wininfo_net_wm_state{$window}; } return $state =~ /\b$atom\b/; } sub _fetch_wininfo( $ ) { my $window = shift; my $command; # Fetch _NET_WM_STATE which may affect interpretation of xwininfo results. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $is_decorated; { $command = "xprop -id $window _NET_WM_STATE"; $_ = `$command`; # e.g. _NET_WM_STATE(ATOM) = _NET_WM_STATE_FULLSCREEN, _NET_WM_STATE_MAXIMIZED_VERT, _OB_WM_STATE_UNDECORATED $_wininfo_net_wm_state{$window} = $_; $is_decorated = $_ !~ m'\b_OB_WM_STATE_UNDECORATED\b'; # only works for Openbox $_wininfo_is_fullscreen{$window} = m'\b_NET_WM_STATE_FULLSCREEN\b'; $_wininfo_is_maximized_horz{$window} = m'\b_NET_WM_STATE_MAXIMIZED_HORZ\b'; $_wininfo_is_maximized_vert{$window} = m'\b_NET_WM_STATE_MAXIMIZED_VERT\b'; } # Fetch size of frame (i.e. window decorations). # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $frame_left = 0; # till proven otherwise my $frame_right = 0; if( $is_decorated && !$_wininfo_is_fullscreen{$window} && !$_wininfo_is_maximized_horz{$window} ) { $command = "xprop -id $window _KDE_NET_WM_FRAME_STRUT"; # non-standard, but no choice $_ = `$command`; # e.g. _KDE_NET_WM_FRAME_STRUT(CARDINAL) = 1, 1, 24, 4 if( m'= ([0-9]+), ([0-9]+), [0-9]+, [0-9]+$' ) { $frame_left = $1; # e.g. 1 $frame_right = $2; # 1 } # else assume it is like gkrellm2, and has no decorations anyway; or window closed } # else no left or right decorations (at least not with Openbox) # Execute xwininfo. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $is_warned = 0; # thus far $command = "xwininfo -id $window -stats"; my $wininfo = `$command`; # e.g. ~20 lines of data including these: # xwininfo: Window id: 0x100001d "Xfe" # Absolute upper-left X: 1591 # Width: 942 { my $title; if( $wininfo =~ m'^ *xwininfo:.*"(.*)"$'m ) { $title = $1; } else # assume window closed # fake results { $title = ''; if( !$is_warned ) { warn _create_complaint_command_output $command; $is_warned = 1; } } $_wininfo_title{$window} = $title; } { my $nominal_width; if( $wininfo =~ m'^ *Width: *([0-9]+)$'m ) { $nominal_width = $1; } else # assume window closed # fake results { $nominal_width = 100; if( !$is_warned ) { warn _create_complaint_command_output $command; $is_warned = 1; } } $_wininfo_width{$window} = $nominal_width + $frame_left + $frame_right; } { my $nominal_x; if( $wininfo =~ m'^ *Absolute upper-left X: *([0-9]+)$'m ) { $nominal_x = $1; } else # assume window closed # fake results { $nominal_x = 0; if( !$is_warned ) { warn _create_complaint_command_output $command; $is_warned = 1; } } $_wininfo_x{$window} = $nominal_x - $frame_left; # can also get this from wininfo's -geometry line, which automatically adjusts for frame width; but it is sometimes reported as a negative offset between the right edges of the window and desktop, and to translate this to a proper x requires knowing the total width, which requires knowing $frame_left etc., so you cannot escape from dependency on non-standard _KDE_NET_WM_FRAME_STRUT } } our $_is_locked = 0; sub _lock() { $_is_locked and warn 'redundant lock'; use Fcntl ':flock'; # for LOCK_* constants my $temp_dir = $screenpager::Config_1::temp_dir; my $lock_file = $temp_dir . '/.screenpager.lock'; # may die here if accompanying mkdir hits parallel first-ever run # the lock file is not put in _get_state_dir, which may subsequently be deleted open LOCK, ">>$lock_file" or die $!; flock LOCK, LOCK_EX; $_is_locked = 1; } END # not called if killed by signal ( but then kernel releases lock anyway, maybe ) { $_is_locked and _unlock; } sub _unlock() { $_is_locked or warn 'redundant unlock'; flock LOCK, LOCK_UN; close LOCK; $_is_locked = 0; } sub _new_page() { my $page = 0; # till proven otherwise my $last_page_created_file = _get_state_dir . '/last-page-created'; if( -f $last_page_created_file ) { open FILE, "<$last_page_created_file" or die $!; { $_ = ; chomp $_; $page = $_ + 1; close FILE; } } open FILE, ">$last_page_created_file" or die $!; { print FILE $page; close FILE; } my $page_file = _get_inter_page_dir . "/$page"; open FILE, ">$page_file" or die $!; { print FILE "\n"; # nothing above print FILE "\n"; # nothing below close FILE; } return $page; } sub _osd_text( $ ) # ( windowARRAY ) ret$ { my $windowARRAY = shift; my @window = sort{ _get_window_x($a) <=> _get_window_x($b) } @$windowARRAY; my $text = ''; # so far my $window; foreach $window( @window ) { my $token; { my $command = "xprop -id $window WM_NAME"; $_ = `$command`; # e.g. WM_NAME(STRING) = "Xfe" # if( m'"[ \-?]*([^ \-?]).*"$' ) ## rather something with a more predictable appearance, and more readable: if( m'".*?(\p{PosixAlpha}).*"$' ) # an ASCII alphabetic character, the first { $token = $1; } else { $token = '?'; } } $text .= $token; $text .= ' '; } if( $text ne '' ) { chop $text; # trailing separator } else { $text = '-'; } return $text; } sub _kill_osd_processes() { my $process_file = _osd_process_file( $::_osd_layer_main ); -f $process_file or return; open PROCESS, "<$process_file" or die $!; { while( my $prior_process = ) { chomp $prior_process; $prior_process or last; # in case of empty line kill( $::_osd_removal_signal, $prior_process ); } close PROCESS; } open PROCESS, ">$process_file" or die $!; # truncate file close PROCESS; } sub _lauch_osd_process( $$;$ ) # ( $command, $lineARRAY, $to_overlay ) { my $command = shift; my $lineARRAY = shift; my $to_overlay = shift; defined $to_overlay or $to_overlay = ''; # prevent warnings # whether to overlay the previous osd, without killing its process my $process_file = _osd_process_file( $::_osd_layer_main ); my $command_exit; my $command_process = open COMMAND, "| $command" or die "fork failure: $!"; { local $SIG{PIPE} = sub { die "pipe broke on '$command'" }; # defines error handler for writes my $open_mode = $to_overlay? '>>': '>'; open PROCESS, "$open_mode$process_file" or die $!; { print PROCESS $command_process; print PROCESS "\n"; close PROCESS; } my $line_count = @$lineARRAY; for( my $l = 0;; ) { print COMMAND @$lineARRAY[$l]; ++$l; $l < $line_count or last; print COMMAND "\n"; # only if there is another line, so honouring $line_count } _unlock; close COMMAND; # blocks till command process finishes $command_exit = $?; _lock; } open PROCESS, "<$process_file" or die $!; { while( my $last_process = ) { chomp $last_process; if( $last_process == $command_process ) # then probably I wrote it { close PROCESS; open PROCESS, ">$process_file" or die $!; # truncate file last; } } close PROCESS; } my $command_exit_status = $command_exit >> 8; $command_exit_status and die "'$command' exit status: $command_exit_status"; my $command_exit_signal = $command_exit & 0xFF; !$command_exit_signal or $command_exit_signal==$::_osd_removal_signal or die "'$command' terminated by signal: $command_exit_signal"; } sub _osd( $ ) { my $seconds = shift; # Compile lines of display text, one per page, in stacking order. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my @line; { use charnames ':full'; my @window = reverse _get_current_windows; # in stacking order # push @line, "\N{EM DASH} " . _osd_text( \@window ) . " \N{EM DASH}"; ## cannot print word sized characters out to a command process, so: push @line, '( ' . _osd_text( \@window ) . ' )'; my $page; for( $page = _get_current_page;; ) { $page = _get_adjacent_page( 'down', $page ); $page eq '' and last; @window = _get_swapped_out_windows( $page ); push @line, _osd_text( \@window ); } for( $page = _get_current_page;; ) { $page = _get_adjacent_page( 'up', $page ); $page eq '' and last; @window = _get_swapped_out_windows( $page ); unshift @line, _osd_text( \@window ); } } # Calculate offsets from desktop center (where osd_cat displays) # to center of screen (where we want it). # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - require screenpager::Config_1; my $screen = _get_screen; my $x_offset = - _get_desktop_width() / 2; # horizontally center on left edge of desktop my $y_offset = - _get_desktop_height() / 2; # vertically on top edge { my $s_config_HASH; for( my $s = 0;; ++$s ) # centers on left edge of $screen { $s_config_HASH = $screenpager::Config_1::screen[$s]; $s == $screen and last; # with $s_config_HASH at active screen $x_offset += $$s_config_HASH{width}; } $x_offset += $$s_config_HASH{ width } / 2; # horizontally center on $screen my $height = $$s_config_HASH{ height }; $y_offset += $height / 2; # vertically $y_offset -= $height / 8; # raised a little (looks better) $y_offset += $$s_config_HASH{ margin_top }; } $x_offset = int( $x_offset ); $y_offset = int( $y_offset ); $y_offset = -$y_offset; # osd_cat's vertical offset progresses upward (reverse of X convention). See # screenpager::Pref_0 fill_colour for list of other oddities with osd_cat. # - - - require screenpager::Pref_0; my $line_count = @line; # must match actual number of lines displayed, for vertical centering and to avoid scrolling the display's viewport my $command = 'osd_cat' . ' --align=centre' . " --colour=$screenpager::Pref_0::display{fill_colour}" . " --delay=$seconds" . " --font='$screenpager::Pref_0::display{font}'" . " --indent=$x_offset" . " --lines=$line_count" . " --offset=$y_offset" . " --outline=$screenpager::Pref_0::display{outline_thickness}" . " --outlinecolour=$screenpager::Pref_0::display{outline_colour}" . ' --pos=middle' ; _kill_osd_processes(); if( $screenpager::Config_1::double_osd ) { _unlock; my $is_original_thread = fork; defined $is_original_thread or die "fork failure: $!"; _lock; _lauch_osd_process( $command, \@line, 1 ); $is_original_thread or exit; # avoid returning twice } else { _lauch_osd_process( $command, \@line ); } } sub _osd_as_requested_and_exit() { my $osd = $option{osd}; defined $osd or exit; if( $osd eq 'on' ) { my $duration = $option{duration}; if( !defined $duration ) { require screenpager::Pref_0; $duration = $screenpager::Pref_0::display{duration}; } $duration >= 1 or warn "your --duration=$duration, but should be >= 1,"; # I do not handle 0 (infinity) yet _unlock; my $is_original_thread = fork; defined $is_original_thread or die "fork failure: $!"; $is_original_thread and exit; # original process exits back to user, so user not blocked by osd # setpriority 0,0, getpriority(0,0) + 4; _lock; _osd $duration; # new process and blocks in here (after unlocking) till osd finished exit; # osd finished, exit without returning to caller of original process } elsif( $osd eq 'off' ) { _kill_osd_processes(); exit; } else { Pod::Usage::pod2usage( -verbose => 0 ); # and exits } } sub _osd_process_file( $ ) { my $layer_name = shift; return _get_state_dir . "/display-process-$layer_name"; } sub _page( $;$ ) { my $direction = shift; my $to_swap_out_windows = shift; defined $to_swap_out_windows or $to_swap_out_windows = 1; my $old_page = _get_current_page; my $new_page = _get_adjacent_page( $direction, $old_page ); if( $new_page eq '' && defined $option{wrap} ) { my $anti_direction; if( $direction eq 'up' ) { $anti_direction = 'down'; } else { $anti_direction = 'up'; } $new_page = _get_adjacent_page( $anti_direction, $old_page ); if( $new_page ne '' ) # then there are other pages { for( ;; ) # find the last one { my $previous_page = _get_adjacent_page( $anti_direction, $new_page ); $previous_page eq '' and last; $new_page = $previous_page; } } } $new_page ne '' or return undef; my $swaptop = _get_swap_desktop; my @old_window; $to_swap_out_windows and @old_window = _get_current_windows; # before swapping new ones in ;) # Swap in # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - { my $desktop = _get_current_desktop; my $warn_count = 0; # thus far my @new_window = _get_swapped_out_windows( $new_page ); for my $window( @new_window ) # bottom to top in stacking order { my $command = "wmctrl -i -r $window -t $desktop"; if( system $command ) # fails { $warn_count or warn 'unable to execute: ' . $command; $warn_count++; # silent hereafter } } for( my $w = $#new_window; $w >= 0; --$w ) # activate the top window { my $window = $new_window[$w]; is_window_net_state( '_NET_WM_STATE_SHADED', $window ) and next; # ignoring shaded ones my $command = "wmctrl -i -a $window"; # activate it if( system $command ) # fails { $warn_count or warn 'unable to execute: ' . $command; $warn_count++; # silent hereafter } last; } my $swap_in_file = _get_intra_page_dir . "/$new_page"; open SWAP_IN, ">$swap_in_file" or die $!; close SWAP_IN; # now emptied (all windows are swapped in) } # Swap out # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - my $swap_out_file = _get_intra_page_dir . "/$old_page"; open SWAP_OUT, ">$swap_out_file" or die $!; { if( $to_swap_out_windows ) { my $warn_count = 0; # thus far for my $window( @old_window ) # bottom to top in stacking order (cf. 'delete') { my $command = "wmctrl -i -r $window -t $swaptop"; if( system $command ) # fails { $warn_count or warn 'unable to execute: ' . $command; $warn_count++; # silent hereafter next; } print SWAP_OUT $window . "\n"; } } close SWAP_OUT; } _set_current_page $new_page; return @old_window; } sub _reset() { # -d _get_state_dir or return; ## redundant, it is created by _get_state_dir as a side-effect my $command = 'rm -r ' . _get_state_dir; system $command and die 'unable to execute: ' . $command; } sub _is_subsequent_run() # ret$ { my $command = 'xprop -root ZELEA_SCREENPAGER'; $_ = `$command`; # e.g. ZELEA_SCREENPAGER(INTEGER) = 1 return m'= [0-9]+$'; # any value at all means subsequent run } sub _reset_if_first_run() { die 'function not supported'; # because it appears the property may be erased after a while, leading to reset in mid-session _is_subsequent_run and return; _reset; my $command = 'xprop -root -f ZELEA_SCREENPAGER 8i -set ZELEA_SCREENPAGER 1'; system $command and die 'unable to execute: ' . $command; _is_subsequent_run or die 'xprop failure'; } sub _shift_options() { my @specification; push @specification, 'display'; =pod =head1 OPTIONS =over 8 =item --B Turns the on-screen display on. Deprecated in favour of C. =cut push @specification, 'duration=i'; =pod =item --B=I Specifies a duration for C<--display=on> or C. =cut push @specification, 'focus'; =pod =item --B Focuses on the active screen. The active screen is specified by an accompanying C<--screen> option, except during a move, when it is always taken as the target screen. It is henceforth the default screen. =cut push @specification, 'help|?'; =pod =item --B Outputs a brief help message and exits. =cut push @specification, 'man'; =pod =item --B Outputs the full manual page and exits. =cut push @specification, 'osd=s'; =pod =item --B=on|off Turns the on-screen display on or off. Once on, its content is fixed. It does not update itself. You may update it explicitly by issuing another C<--osd=on>. Use --duration to specify the duration. Otherwise the default in F applies. =cut push @specification, 'screen=s'; =pod =item --B=I|west|east|mouse Specifies the screen to act on. Screen numbers are zero based. You can also specify a compass direction from the current focus screen, or the keyword 'mouse' which designates the screen the mouse is in. Applies only to the current invocation of Screenpager. Use the C argument to make it persistant. =cut push @specification, 'version'; =pod =item --B Prints the version of Screenpager and exits. =cut push @specification, 'wrap'; =pod =item --B Wraps around screen or page limits during a C, C, or C. So, for example, paging up at the top of the stack takes you straight to the bottom page. =cut Getopt::Long::GetOptions( \%option, @specification ) or Pod::Usage::pod2usage( -verbose => 0 ); # and exits =pod =back =cut defined $option{'help'} and Pod::Usage::pod2usage( -verbose => 1 ); # and exits defined $option{'man'} and Pod::Usage::pod2usage( -verbose => 2 ); # and exits { my $display = $option{'display'}; if( defined $display && !defined $option{'osd'} ) { $option{'osd'} = 'on'; } } if( defined $option{version} ) { print '0.1.3_pre'; =pod =begin Zelea::AutoEditor_Script $L -= 3; # back up past =pod line, above use Zelea::Gentoo::ChangeLog qw( release_lines split_release_line ); my @release_line = release_lines( '/home/mike/project/Screenpager/ChangeLog' ); my( $version, $revision ) = split_release_line( $release_line[0] ); $line[$L] = " print '$version';" =end Zelea::AutoEditor_Script =cut print "\n"; exit; } } __END__ =pod =head1 FILES Configuration is sought at F. User preferences are sought at the following locations, in order of precedence: F<$ENV{'HOME'}/.config/screenpager/Pref_0.pm> and F Uses F, where `TEMP_DIR` is the value of configuration variable `$temp_dir`. Creates temporary files and directories in F. =head1 CAVEATS Does not auto-detect a new X session. You must explicitly issue a C, e.g. in your F<.xinitrc> file. On-screen display is often clipped at the bottom, sometimes self-correcting itself after an unpredictable delay. This is a bug in osd_cat. Try using config option $double_osd as a workaround. On-screen display is sometimes wrong after moving a page west or east, or deleting a page. As a workaround, instead of using the --display option (as in C) try issuing a separate C afterwards, e.g. in the invoking script. Do this after a slight delay, if necessary. =head2 Limitations of West/East Moves Window postions are calculated to hold the east margin of the screen constant. This will not always work well when moving to a smaller screen. Some windows may fit only partially on the new screen, others not at all; depending on size and position of windows. (As a workaround, if screens vary in size, avoid putting narrow windows near the west edge of larger screens.) Window postioning during west/east moves is optimized for Openbox. Using a different window manager with different behaviour may result in minor positioning errors. [Code ref.: C.] Any window that fails to fit within the bounds of its new screen may be arbitrarily repositioned. [Code ref.: C.] =head1 AUTHOR Copyright 2004-2006, 2010-2011 Michael Allan. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Screenpager Software"), to deal in the Screenpager Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Screenpager Software, and to permit persons to whom the Screenpager Software is furnished to do so, subject to the following conditions: The preceding copyright notice and this permission notice shall be included in all copies or substantial portions of the Screenpager Software. THE SCREENPAGER SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SCREENPAGER SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SCREENPAGER SOFTWARE. =cut