Changes in perl/lib/BarnOwl.pm [a130fc5:ecd4edf]

File:

• perl/lib/BarnOwl.pm (modified) (10 diffs)

perl/lib/BarnOwl.pm

@@ -5 +5 @@
 
 use base qw(Exporter);
-our @EXPORT_OK = qw(command getcurmsg getnumcols getidletime
+our @EXPORT_OK = qw(command getcurmsg getnumcols getnumlines getidletime
+                    register_idle_watcher unregister_idle_watcher
                     zephyr_getsender zephyr_getrealm zephyr_zwrite
                     zephyr_stylestrip zephyr_smartstrip_user zephyr_getsubs
                     queue_message admin_message
+                    start_edit
                     start_question start_password start_edit_win
                     get_data_dir get_config_dir popless_text popless_ztext
                     error debug
                     create_style getnumcolors wordwrap
+                    message_matches_filter
                     add_dispatch remove_dispatch
                     add_io_dispatch remove_io_dispatch
                     new_command
                     new_variable_int new_variable_bool new_variable_string
+                    new_variable_enum
                     quote redisplay);
 our %EXPORT_TAGS = (all => \@EXPORT_OK);
@@ -43 +47 @@
 
 use List::Util qw(max);
+use Tie::RefHash;
 
 =head1 NAME
@@ -92 +97 @@
 command line, and C<MESSAGE> is the zephyr body to send.
 
+=cut
+
+sub zephyr_zwrite {
+    my ($command, $message) = @_;
+    my $ret = BarnOwl::Internal::zephyr_zwrite($command, $message);
+    die "Error sending zephyr" unless $ret == 0;
+}
+
 =head2 ztext_stylestrip STRING
 
@@ -105 +118 @@
 Enqueue a message in the BarnOwl message list, logging it and
 processing it appropriately. C<MESSAGE> should be an instance of
-BarnOwl::Message or a subclass.  Returns the queued message.  This
-is useful for, e.g., deleting a message from the message list.
+BarnOwl::Message or a subclass.
 
 =head2 admin_message HEADER BODY
@@ -112 +124 @@
 Display a BarnOwl B<Admin> message, with the given header and body.
 
+=head2 start_edit %ARGS
+
+Displays a prompt on the screen and lets the user enter text,
+and calls a callback when the editwin is closed.
+
+C<%ARGS> must contain the following keys:
+
+=over 4
+
+=item prompt
+
+The line to display on the screen
+
+=item type
+
+One of:
+
+=over 4
+
+=item edit_win
+
+Displays the prompt on a line of its own and opens the edit_win.
+
+=item question
+
+Displays prompt on the screen and lets the user enter a line of
+text.
+
+=item password
+
+Like question, but echoes the user's input as C<*>s when they
+input.
+
+=back
+
+=item callback
+
+A Perl subroutine that is called when the user closes the edit_win.
+C<CALLBACK> gets called with two parameters: the text the user entered,
+and a C<SUCCESS> boolean parameter which is false if the user canceled
+the edit_win and true otherwise.
+
+=back
+
 =head2 start_question PROMPT CALLBACK
 
-Displays C<PROMPT> on the screen and lets the user enter a line of
-text, and calls C<CALLBACK>, which must be a perl subroutine
-reference, with the text the user entered
-
 =head2 start_password PROMPT CALLBACK
 
-Like C<start_question>, but echoes the user's input as C<*>s when they
-input.
-
 =head2 start_edit_win PROMPT CALLBACK
 
-Like C<start_question>, but displays C<PROMPT> on a line of its own
-and opens the editwin. If the user cancels the edit win, C<CALLBACK>
-is not invoked.
+Roughly equivalent to C<start_edit> called with the appropriate parameters.
+C<CALLBACK> is only called on success, for compatibility.
+
+These are deprecated wrappers around L<BarnOwl::start_edit>, and should not
+be uesd in new code.
+
+=cut
+
+sub start_edit {
+    my %args = (@_);
+    BarnOwl::Internal::start_edit($args{type}, $args{prompt}, $args{callback});
+}
+
+sub start_question {
+    my ($prompt, $callback) = @_;
+    BarnOwl::start_edit(type => 'question', prompt => $prompt, callback => sub {
+            my ($text, $success) = @_;
+            $callback->($text) if $success;
+        });
+}
+
+sub start_password {
+    my ($prompt, $callback) = @_;
+    BarnOwl::start_edit(type => 'password', prompt => $prompt, callback => sub {
+            my ($text, $success) = @_;
+            $callback->($text) if $success;
+        });
+}
+
+sub start_edit_win {
+    my ($prompt, $callback) = @_;
+    BarnOwl::start_edit(type => 'edit_win', prompt => $prompt, callback => sub {
+            my ($text, $success) = @_;
+            $callback->($text) if $success;
+        });
+}
 
 =head2 get_data_dir
@@ -160 +242 @@
 
 Returns the number of colors this BarnOwl is capable of displaying
+
+=head2 message_matches_filter MESSAGE FILTER_NAME [QUIET = 0]
+
+Returns 1 if C<FILTER_NAME> is the name of a valid filter, and
+C<MESSAGE> matches that filter.  Returns 0 otherwise.  If
+C<QUIET> is false, this method displays an error message if
+if C<FILTER_NAME> does not name a valid filter.
 
 =head2 add_dispatch FD CALLBACK
@@ -259 +348 @@
 our @all_commands;
 
-if(!$configfile && -f $ENV{HOME} . "/.barnowlconf") {
-    $configfile = $ENV{HOME} . "/.barnowlconf";
-}
-$configfile ||= $ENV{HOME}."/.owlconf";
+if(!$configfile) {
+    if (-f get_config_dir() . "/init.pl") {
+        $configfile = get_config_dir() . "/init.pl";
+    } elsif (-f $ENV{HOME} . "/.barnowlconf") {
+        $configfile = $ENV{HOME} . "/.barnowlconf";
+    } else {
+        $configfile = $ENV{HOME}."/.owlconf";
+    }
+}
 
 # populate global variable space for legacy owlconf files
@@ -319 +413 @@
 =head2 new_variable_string NAME [{ARGS}]
 
-Add a new owl variable, either an int, a bool, or a string, with the
+=head2 new_variable_enum NAME [{ARGS}]
+
+Add a new owl variable, either an int, a bool, a string, or an enum with the
 specified name.
 
-ARGS can optionally contain the following keys:
+For new_variable_enum, ARGS is required to contain a validsettings key pointing
+to an array reference. For all four, it can optionally contain the following
+keys:
 
 =over 4
@@ -340 +438 @@
 =back
 
+In addition, new_variable_string optionally accepts a string validsettings
+parameter, in case people want to set it to "<path>".
+
 =cut
 
 sub new_variable_int {
-    unshift @_, \&BarnOwl::Internal::new_variable_int, 0;
-    goto \&_new_variable;
+    my ($name, $args) = @_;
+    my $storage = defined($args->{default}) ? $args->{default} : 0;
+    BarnOwl::new_variable_full($name, {
+            %{$args},
+            get_tostring => sub { "$storage" },
+            set_fromstring => sub {
+                die "Expected integer" unless $_[0] =~ /^-?[0-9]+$/;
+                $storage = 0 + $_[0];
+            },
+            validsettings => "<int>",
+            takes_on_off => 0,
+        });
 }
 
 sub new_variable_bool {
-    unshift @_, \&BarnOwl::Internal::new_variable_bool, 0;
-    goto \&_new_variable;
+    my ($name, $args) = @_;
+    my $storage = defined($args->{default}) ? $args->{default} : 0;
+    BarnOwl::new_variable_full($name, {
+            %{$args},
+            get_tostring => sub { $storage ? "on" : "off" },
+            set_fromstring => sub {
+                die "Valid settings are on/off" unless $_[0] eq "on" || $_[0] eq "off";
+                $storage = $_[0] eq "on";
+            },
+            validsettings => "on,off",
+            takes_on_off => 1,
+        });
 }
 
 sub new_variable_string {
-    unshift @_, \&BarnOwl::Internal::new_variable_string, "";
-    goto \&_new_variable;
-}
-
-sub _new_variable {
-    my $func = shift;
-    my $default_default = shift;
+    my ($name, $args) = @_;
+    my $storage = defined($args->{default}) ? $args->{default} : "";
+    BarnOwl::new_variable_full($name, {
+            # Allow people to override this one if they /reaaally/ want to for
+            # some reason. Though we still reserve the right to interpret this
+            # value in interesting ways for tab-completion purposes.
+            validsettings => "<string>",
+            %{$args},
+            get_tostring => sub { $storage },
+            set_fromstring => sub { $storage = $_[0]; },
+            takes_on_off => 0,
+        });
+}
+
+sub new_variable_enum {
+    my ($name, $args) = @_;
+
+    # Gather the valid settings.
+    die "validsettings is required" unless defined($args->{validsettings});
+    my %valid;
+    map { $valid{$_} = 1 } @{$args->{validsettings}};
+
+    my $storage = (defined($args->{default}) ?
+                   $args->{default} :
+                   $args->{validsettings}->[0]);
+    BarnOwl::new_variable_full($name, {
+            %{$args},
+            get_tostring => sub { $storage },
+            set_fromstring => sub {
+                die "Invalid input" unless $valid{$_[0]};
+                $storage = $_[0];
+            },
+            validsettings => join(",", @{$args->{validsettings}})
+        });
+}
+
+=head2 new_variable_full NAME {ARGS}
+
+Create a variable, in full generality. The keyword arguments have types below:
+
+ get_tostring : ()  -> string
+ set_fromstring : string -> int
+ -- optional --
+ summary : string
+ description : string
+ validsettings : string
+ takes_on_off : int
+
+The get/set functions are required. Note that the caller manages storage for the
+variable. get_tostring/set_fromstring both convert AND store the value.
+set_fromstring dies on failure.
+
+If the variable takes parameters 'on' and 'off' (i.e. is boolean-looking), set
+takes_on_off to 1. This makes :set VAR and :unset VAR work. set_fromstring will
+be called with those arguments.
+
+=cut
+
+sub new_variable_full {
     my $name = shift;
     my $args = shift || {};
     my %args = (
-        summary     => "",
+        summary => "",
         description => "",
-        default     => $default_default,
+        takes_on_off => 0,
+        validsettings => "<string>",
         %{$args});
-    $func->($name, $args{default}, $args{summary}, $args{description});
+
+    die "get_tostring required" unless $args{get_tostring};
+    die "set_fromstring required" unless $args{set_fromstring};
+
+    # Strip off the bogus dummy argument. Aargh perl-Glib.
+    my $get_tostring_fn = sub { $args{get_tostring}->() };
+    my $set_fromstring_fn = sub {
+      my ($dummy, $val) = @_;
+      # Translate from user-supplied die-on-failure callback to expected
+      # non-zero on error. Less of a nuisance than interacting with ERRSV.
+      eval { $args{set_fromstring}->($val) };
+      # TODO: Consider changing B::I::new_variable to expect string|NULL with
+      # string as the error message. That can then be translated to a GError in
+      # owl_variable_set_fromstring. For now the string is ignored.
+      return ($@ ? -1 : 0);
+    };
+
+    BarnOwl::Internal::new_variable($name, $args{summary}, $args{description}, $args{validsettings},
+                                    $args{takes_on_off}, $get_tostring_fn, $set_fromstring_fn, undef);
 }
 
@@ -603 +795 @@
 }
 
+=head3 register_idle_watcher %ARGS
+
+Call a callback whenever the amount of time the user becomes idle or comes
+back from being idle.
+
+You must include the following parameters:
+
+=over 4
+
+=item name
+
+The name given to the idle watcher
+
+=item after
+
+How long the user must be idle, in seconds, before the callback is called.
+If the value is too small, you may have spurious or inaccurate calls.
+(The current lower limit is about 1 second.)
+
+=item callback
+
+The Perl subroutine that gets called when the user has been idle for C<AFTER>
+seconds, or comes back from being idle.  The subroutine is passed one parameter,
+which is true if the user is currently idle, and false otherwise.
+
+=back
+
+This method returns a unique identifier which may be passed to
+L<BarnOwl::unregister_idle_watcher>.
+
+=cut
+
+=head3 unregister_idle_watcher UNIQUE_ID [...]
+
+Removed and returns the idle watcher specified by C<UNIQUE_ID>.
+You may specify multiple unique ids.
+
+=cut
+
+my %idle_watchers;
+tie %idle_watchers, 'Tie::RefHash';
+
+$BarnOwl::Hooks::wakeup->add(sub {
+        foreach my $idle_watcher (values %idle_watchers) {
+            _wakeup_idle_watcher($idle_watcher);
+        }
+    });
+
+sub _wakeup_idle_watcher {
+    my ($idle_watcher, $offset) = @_;
+    $offset = 0 unless defined $offset;
+    # go unidle
+    $idle_watcher->{idle_timer}->stop if $idle_watcher->{idle_timer};
+    undef $idle_watcher->{idle_timer};
+    $idle_watcher->{callback}->(0) if $idle_watcher->{is_idle};
+    $idle_watcher->{is_idle} = 0;
+
+    # queue going idle
+    $idle_watcher->{idle_timer} = BarnOwl::Timer->new({
+        name  => $idle_watcher->{name},
+        after => $idle_watcher->{after} - $offset,
+        cb    => sub {
+            $idle_watcher->{is_idle} = 1;
+            $idle_watcher->{callback}->(1);
+        }
+    });
+}
+
+sub register_idle_watcher {
+    my %args = (@_);
+    $idle_watchers{\%args} = \%args;
+    _wakeup_idle_watcher(\%args, BarnOwl::getidletime); # make sure to queue up the idle/unidle events from this idle watcher
+    return \%args;
+}
+
+sub unregister_idle_watcher {
+    my ($id) = @_;
+    $idle_watchers{$id}->{idle_timer}->stop if $idle_watchers{$id}->{idle_timer};
+    return delete $idle_watchers{$id};
+}
+
 # Stub for owl::startup / BarnOwl::startup, so it isn't bound to the
 # startup command. This may be redefined in a user's configfile.