Release 1.1.0
[clawsker.git] / clawsker
index 35a2646c989d37ac19b9b00d143c5fe50e1a77dd..0e10937bd8423352be1a522ad921dfb3bc536a8b 100755 (executable)
--- a/clawsker
+++ b/clawsker
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 #
 # Clawsker :: A Claws Mail Tweaker
-# Copyright 2007-2016 Ricardo Mones <ricardo@mones.org>
+# Copyright 2007-2017 Ricardo Mones <ricardo@mones.org>
 #
 # This program is free software: you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -72,6 +72,7 @@ sub _ {
     tab_winpos => _('Windows'),
     tab_accounts => _('Accounts'),
     tab_plugins => _('Plugins'),
+    tab_hotkeys => _('Hotkeys'),
     tab_info => _('Info'),
 
     ab_frame => _('Addressbook'),
@@ -95,9 +96,11 @@ sub _ {
 
     l_oth_use_dlg => _('Use detached address book edit dialogue'),
     h_oth_use_dlg => _('If true use a separate dialogue to edit a person\'s details. Otherwise will use a form embedded in the address book\'s main window.'),
-    l_oth_max_use => _('Maximum memory for message cache (kB)'),
+    l_oth_max_use => _('Maximum memory for message cache'),
+    l_oth_max_use_units => _('kilobytes'),
     h_oth_max_use => _('The maximum amount of memory to use to cache messages, in kilobytes.'),
-    l_oth_min_time => _('Minimun time for cache elements (minutes)'),
+    l_oth_min_time => _('Minimun time for cache elements'),
+    l_oth_min_time_units => _('minutes'),
     h_oth_min_time => _('The minimum time in minutes to keep a cache in memory. Caches more recent than this time will not be freed, even if the memory usage is too high.'),
     l_oth_use_netm => _('Use NetworkManager'),
     h_oth_use_netm => _('Use NetworkManager to switch offline automatically.'),
@@ -144,10 +147,14 @@ sub _ {
     h_gui_zero_char => _('Replaces \'0\' with the given character in Folder List.'),
     l_gui_type_any => _('Editable headers'),
     h_gui_type_any => _('Allows to manually type any value in Compose Window header entries or just select from the available choices in the associated dropdown list.'),
+    l_gui_warn_send_multi => _('Warn when sending to more than'),
+    l_gui_warn_send_multi_units => _('recipients'),
+    h_gui_warn_send_multi => _('Show a warning dialogue when sending to more recipients than specified. Use 0 to disable this check.'),
     l_gui_next_del => _('Select next message on delete'),
     h_gui_next_del => _('When deleting a message, toggles between selecting the next one (newer message) or the previous one (older message).'),
 
-    l_beh_hover_t => _('Drag \'n\' drop hover timeout (ms)'),
+    l_beh_hover_t => _('Drag \'n\' drop hover timeout'),
+    l_beh_hover_t_units => _('milliseconds'),
     h_beh_hover_t => _('Time in milliseconds that will cause a folder tree to expand when the mouse cursor is held over it during drag and drop.'),
     l_beh_dangerous => _('Don\'t confirm deletions (dangerous!)'),
     h_beh_dangerous => _('Don\'t ask for confirmation before definitive deletion of emails.'),
@@ -157,9 +164,11 @@ sub _ {
     h_beh_parts_rw => _('Saves temporary files when opening attachment with write bit set.'),
     l_beh_skip_ssl => _('Don\'t check SSL certificates'),
     h_beh_skip_ssl => _('Disables the verification of SSL certificates.'),
-    l_beh_up_step => _('Progress bar update step (items)'),
+    l_beh_up_step => _('Progress bar update step every'),
+    l_beh_up_step_units => _('items'),
     h_beh_up_step => _('Update stepping in progress bars.'),
-    l_beh_thread_a => _('Maximum age when threading by subject (days)'),
+    l_beh_thread_a => _('Maximum age when threading by subject'),
+    l_beh_thread_a_units => _('days'),
     h_beh_thread_a => _('Number of days to include a message in a thread when using "Thread using subject in addition to standard headers".'),
     l_beh_unsafe_ssl => _('Allow unsafe SSL certificates'),
     h_beh_unsafe_ssl => _('Allows Claws Mail to remember multiple SSL certificates for a given server/port.'),
@@ -217,7 +226,7 @@ sub _ {
     l_col_diff_del => _('Deleted lines'),
     h_col_diff_del => _('Colour for deleted lines in patches.'),
     l_col_diff_hunk => _('Hunk lines'),
-    h_col_diff_hunk => _('Color for hunk headers in patches.'),
+    h_col_diff_hunk => _('Colour for hunk headers in patches.'),
 
     l_win_x => _('X position'),
     h_win_x => _('X coordinate for window\'s top-left corner.'),
@@ -271,6 +280,10 @@ my $ACCOUNTRC = 'accountrc';
 # supported and available plugins lists
 my @PLUGINS = qw(AttRemover GPG ManageSieve Libravatar PerlPlugin);
 my @AVPLUGINS = ();
+# loaded hotkeys from load_menurc
+my $HOTKEYS;
+# current tree selection
+my $SELHOTKEY;
 # loaded icons
 my @APPICONS = ();
 
@@ -292,6 +305,8 @@ use constant PAGE_SPC => 5;
 
 sub version_greater_or_equal {
     my ($version, $refvers) = @_;
+    return TRUE if (length($version) == 0 and length($refvers) >= 0);
+    return FALSE if (length($version) >= 0 and length($refvers) == 0);
     return TRUE if (version->parse($version) >= version->parse($refvers));
     return FALSE;
 }
@@ -391,6 +406,10 @@ sub get_ac_rc_filename {
     return $CONFIGDIR . $ACCOUNTRC;
 }
 
+sub get_menurc_filename {
+    return $CONFIGDIR . "menurc";
+}
+
 sub set_rc_filename {
     my ($fullname) = @_;
     my @parts = split ('/', $fullname);
@@ -507,6 +526,11 @@ sub new_text_box_for_int($$$) {
     my @type = split (/,/, $$hash{$key}[TYPE]);
     push (@type, 0), push (@type, 10000) unless ($#type > 0);
     #
+    my $gunits = undef;
+    if (ref $label eq 'ARRAY') {
+        $gunits = Gtk2::Label->new ($label->[1]);
+        $label = $label->[0];
+    }
     my $glabel = Gtk2::Label->new ($label);
     my $pagei = int (($type[2] - $type[1]) / 10);
     my $gentry = Gtk2::SpinButton->new_with_range ($type[1], $type[2], $pagei);
@@ -521,7 +545,9 @@ sub new_text_box_for_int($$$) {
     set_widget_hint ($gentry, $$hash{$key}[DESC]);
     set_widget_sens ($gentry, $$hash{$key}[CMVER]);
     $glabel->set_sensitive ($gentry->sensitive);
+    $gunits->set_sensitive ($gentry->sensitive) if ($gunits);
     #
+    return new_hbox_spaced_pack ($glabel, $gentry, $gunits) if ($gunits);
     return new_hbox_spaced_pack ($glabel, $gentry);
 }
 
@@ -658,7 +684,7 @@ sub new_subpage_frame {
     ],
     max_use => [
         'cache_max_mem_usage',
-        $xl::s{l_oth_max_use},
+        [ $xl::s{l_oth_max_use}, $xl::s{l_oth_max_use_units} ],
         $xl::s{h_oth_max_use},
         'int,0,262144', # 0 Kb - 256 Mb
         '0.7.8.36',
@@ -666,7 +692,7 @@ sub new_subpage_frame {
     ],
     min_time => [
         'cache_min_keep_time',
-        $xl::s{l_oth_min_time},
+        [ $xl::s{l_oth_min_time}, $xl::s{l_oth_min_time_units} ],
         $xl::s{h_oth_min_time},
         'int,0,120', # 0 minutes - 2 hours
         '0.7.8.36',
@@ -849,6 +875,14 @@ sub new_other_page() {
         '3.12.0.44',
         '0',
     ],
+    warn_send_multi => [
+        'warn_sending_many_recipients_num',
+        [ $xl::s{l_gui_warn_send_multi}, $xl::s{l_gui_warn_send_multi_units} ],
+        $xl::s{h_gui_warn_send_multi},
+        'int,0,1000',
+        '3.14.1.125',
+        '0',
+    ],
     next_del => [
         'next_on_delete',
         $xl::s{l_gui_next_del},
@@ -890,10 +924,12 @@ sub new_gui_page() {
                          $xl::s{mview_frame}, 'not-packed'),
                      FALSE, FALSE, FRAME_SPC);
     $gf->pack_start (new_subpage_frame (
-                         new_hbox_pack (
-                             new_check_button_for (\%pr::gui, 'no_markup', \%HPVALUE),
-                             new_check_button_for (\%pr::gui, 'margin_co', \%HPVALUE),
-                             new_check_button_for (\%pr::gui, 'type_any', \%HPVALUE)),
+                         new_vbox_pack (
+                             new_hbox_pack_compact (
+                                 new_check_button_for (\%pr::gui, 'no_markup', \%HPVALUE),
+                                 new_check_button_for (\%pr::gui, 'margin_co', \%HPVALUE),
+                                 new_check_button_for (\%pr::gui, 'type_any', \%HPVALUE)),
+                             new_text_box_for_int (\%pr::gui, 'warn_send_multi', \%HPVALUE)),
                          $xl::s{compo_frame}, 'not-packed'),
                      FALSE, FALSE, FRAME_SPC);
     $gf->pack_start ($cb_dot_lines, FALSE, FALSE, 0);
@@ -912,7 +948,7 @@ sub new_gui_page() {
 %pr::beh = ( # tweak some behaviour
     hover_t => [
         'hover_timeout',
-        $xl::s{l_beh_hover_t},
+        [ $xl::s{l_beh_hover_t}, $xl::s{l_beh_hover_t_units} ],
         $xl::s{h_beh_hover_t},
         'int,100,3000', # 0.1 seconds - 3 seconds
         '0.0.0',
@@ -952,7 +988,7 @@ sub new_gui_page() {
     ],
     up_step => [
         'statusbar_update_step',
-        $xl::s{l_beh_up_step},
+        [ $xl::s{l_beh_up_step}, $xl::s{l_beh_up_step_units} ],
         $xl::s{h_beh_up_step},
         'int,1,200', # 1 item - 200 items
         '0.0.0',
@@ -960,7 +996,7 @@ sub new_gui_page() {
     ],
     thread_a => [
         'thread_by_subject_max_age',
-        $xl::s{l_beh_thread_a},
+        [ $xl::s{l_beh_thread_a}, $xl::s{l_beh_thread_a_units} ],
         $xl::s{h_beh_thread_a},
         'int,1,30', # 1 day - 30 days
         '0.0.0',
@@ -2089,6 +2125,123 @@ sub new_plugins_page() {
                 $frame{'PerlPlugin'});
 }
 
+use constant {
+    C_LABEL => 0,
+    C_HOTKEY => 1,
+    C_GROUP => 2,
+    C_ACCEL => 3,
+    C_BCOLOR => 4,
+    # cell backgrounds
+    BG_LIGHTER => '#ffffff',
+    BG_DARKER => '#eeeeee'
+};
+
+sub new_hotkeys_list_label {
+    my $renderer = Gtk2::CellRendererText->new ();
+    $renderer->set_property('alignment' => 'left');
+    $renderer->set_property('editable' => FALSE);
+    $renderer->set_property('size-points' => 8);
+    $renderer->set_property('size-set' => TRUE);
+    return $renderer;
+}
+
+sub new_hotkeys_list_hotkey {
+    my $renderer = Gtk2::CellRendererAccel->new ();
+    $renderer->set_property ('accel-mode' => 'gtk');
+    $renderer->set_property ('editable' => TRUE);
+    $renderer->signal_connect ('accel-edited' => sub {
+        my ($w, $path, $key, $mods, $keycode) = @_;
+        my $accel = Gtk2::Accelerator->name ($key, $mods);
+        my ($model, $iter) = $SELHOTKEY->get_selected ();
+        $model->set($iter, C_HOTKEY, "\"$accel\"");
+        my $gkey = $model->get_value ($iter, C_GROUP);
+        my $akey = $model->get_value ($iter, C_ACCEL);
+        my $data = $HOTKEYS->{$gkey}->{$akey};
+        $data->{'key'} = "\"$accel\"";
+        $data->{'enabled'} = TRUE;
+    });
+    $renderer->signal_connect ('accel-cleared' => sub {
+        my ($w, $path) = @_;
+        my ($model, $iter) = $SELHOTKEY->get_selected ();
+        $model->set($iter, C_HOTKEY, "\"\"");
+        my $gkey = $model->get_value ($iter, C_GROUP);
+        my $akey = $model->get_value ($iter, C_ACCEL);
+        my $data = $HOTKEYS->{$gkey}->{$akey};
+        $data->{'key'} = "\"\"";
+        $data->{'enabled'} = FALSE;
+    });
+    return $renderer;
+}
+
+sub new_hotkeys_list {
+    my ($gkey, $group) = @_;
+    my $store = Gtk2::ListStore->new(
+        qw/Glib::String Glib::String Glib::String Glib::String Glib::String/);
+    my $even = FALSE;
+    foreach my $akey (sort keys %$group) {
+        my $iter = $store->append ();
+        my $hotkey = $group->{$akey}->{'key'};
+        my $label = $akey;
+        $label =~ s/[<>]//g; # <rrsyl> and <IMAPFolder> !?
+        my $bgcol = $even ? BG_DARKER: BG_LIGHTER;
+        $store->set ($iter, C_LABEL, $label, C_HOTKEY, $hotkey,
+            C_GROUP, $gkey, C_ACCEL, $akey, C_BCOLOR, $bgcol);
+        $even = not $even;
+    }
+    my $treeview = Gtk2::TreeView->new_with_model ($store);
+    # labels column
+    $treeview->insert_column_with_data_func (
+        0, _("Menu path"), new_hotkeys_list_label (),
+        sub {
+            my ($col, $renderer, $model, $iter, $data) = @_;
+            $renderer->set_property (
+                'text' => $model->get_value ($iter, C_LABEL));
+            $renderer->set_property (
+                'background' => $model->get_value ($iter, C_BCOLOR));
+        }
+    );
+    # hotkeys column
+    $treeview->insert_column_with_data_func (
+        1, _('Hotkey'), new_hotkeys_list_hotkey (),
+        sub {
+            my ($col, $renderer, $model, $iter, $data) = @_;
+            my $hkey = $model->get_value ($iter, C_HOTKEY);
+            $hkey =~ s/\"//g;
+            my ($acckey, $accmod) = Gtk2::Accelerator->parse ($hkey);
+            $renderer->set_property ('accel-key' => $acckey);
+            $renderer->set_property ('accel-mods' => $accmod);
+            $renderer->set_property (
+                'background' => $model->get_value ($iter, C_BCOLOR));
+        }
+    );
+    # callback for saving current selection
+    my $selection = $treeview->get_selection ();
+    $selection->signal_connect ('changed' => sub { $SELHOTKEY = shift });
+    return $treeview;
+}
+
+sub new_hotkeys_page() {
+    my $swin = Gtk2::ScrolledWindow->new ();
+    my $vbox = Gtk2::VBox->new (FALSE, 5);
+    foreach my $gkey (sort keys %$HOTKEYS) {
+        my $group = $HOTKEYS->{$gkey};
+        # group title
+        my $glabel = Gtk2::Label->new ('<b>' . $gkey . '</b>');
+        $glabel->set_use_markup (TRUE);
+        $glabel->set_alignment (0, 0.5);
+        $glabel->set_padding (5, 1);
+        $vbox->pack_start ($glabel, FALSE, FALSE, 0);
+        # group key list
+        my $keylist = new_hotkeys_list ($gkey, $group);
+        $vbox->pack_start ($keylist, FALSE, FALSE, 0);
+    }
+    $swin->set_border_width (5);
+    $swin->set_shadow_type ('none');
+    $swin->set_policy ('automatic', 'always');
+    $swin->add_with_viewport ($vbox);
+    return $swin;
+}
+
 sub new_info_page() {
     my $t0 = Gtk2::Table->new (7, 2, FALSE);
     my $v = get_toolkit_versions ();
@@ -2335,6 +2488,53 @@ sub save_resource {
     close (RCF);
 }
 
+# specific loaders
+sub load_menurc {
+    my $rc = shift;
+    open (RCF, '<:encoding(utf8)', $rc)
+        or die _("Error: opening '{file}' for reading", file => $rc) . ": $!\n";
+    my %groups = ();
+    my $line = 0;
+    while (<RCF>) {
+        chomp;
+        if (/^; \(gtk_accel_path "<([A-Za-z]+)>([^"]+)" ([^\)]+)\)$/) {
+            my %data = ('key' => $3, 'enabled' => FALSE, 'line' => $line);
+            $groups{$1}{$2} = \%data;
+            # say "group -> $1 | path -> $2 | key -> $3";
+        } elsif (/^\(gtk_accel_path "<([A-Za-z]+)>([^"]+)" ([^\)]+)\)$/) {
+            my %data = ('key' => $3, 'enabled' => TRUE, 'line' => $line);
+            $groups{$1}{$2} = \%data;
+            # say "group -> $1 | path -> $2 | key -> $3";
+        }
+        ++$line;
+    }
+    close (RCF);
+    return \%groups;
+}
+
+sub save_menurc {
+    my ($rc, $groups) = @_;
+    my @lines = ();
+    foreach my $gkey (keys %$groups) {
+        my $group = $groups->{$gkey};
+        foreach my $akey (keys %$group) {
+            my $data = $group->{$akey};
+            my $key = $data->{'key'};
+            my $line = $data->{'line'};
+            $lines[$line] = ($data->{'enabled'})? '': '; ';
+            $lines[$line] .= '(gtk_accel_path "<'
+                    . $gkey . '>' . $akey . '" ' . $key . ')';
+        }
+    }
+    open (RCF, '>:utf8', $rc)
+        or die _("Error: opening '{file}' for writing", file => $rc) . ": $!\n";
+    say RCF '; claws-mail GtkAccelMap rc-file         -*- scheme -*-';
+    say RCF '; this file is an automated accelerator map dump';
+    say RCF ';';
+    foreach (@lines) { say RCF $_ if $_ }
+    close (RCF);
+}
+
 # load current status from disc
 sub load_rc_preferences {
     my $rc = get_rc_filename ();
@@ -2370,9 +2570,19 @@ sub load_ac_preferences {
     return TRUE;
 }
 
+sub load_hk_preferences {
+    my $rc = get_menurc_filename ();
+    return FALSE unless check_rc_file ($rc);
+    $HOTKEYS = load_menurc ($rc);
+    return TRUE;
+}
+
 sub load_preferences {
     return FALSE unless check_claws_not_running ();
-    return (load_rc_preferences () and load_ac_preferences ());
+    return (load_rc_preferences ()
+        and load_ac_preferences ()
+        and load_hk_preferences ()
+    );
 }
 
 # save current preferences to disc
@@ -2419,6 +2629,15 @@ sub save_ac_preferences {
     return TRUE;
 }
 
+sub save_hk_preferences {
+    my $rc = get_menurc_filename ();
+    log_message ("Saving hotkey preferences to $rc\n");
+    return FALSE unless check_rc_file ($rc);
+    return FALSE unless check_claws_not_running ();
+    save_menurc ($rc, $HOTKEYS);
+    return TRUE;
+}
+
 # create notebook
 sub new_notebook {
     my $nb = Gtk2::Notebook->new;
@@ -2430,6 +2649,7 @@ sub new_notebook {
     $nb->append_page (new_winpos_page (), $xl::s{tab_winpos});
     $nb->append_page (new_accounts_page (), $xl::s{tab_accounts});
     $nb->append_page (new_plugins_page (), $xl::s{tab_plugins});
+    $nb->append_page (new_hotkeys_page (), $xl::s{tab_hotkeys});
     $nb->append_page (new_info_page (), $xl::s{tab_info});
 
     return $nb;
@@ -2454,7 +2674,7 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program.  If not, see &lt;http://www.gnu.org/licenses/&gt;.";
-    my $year = "2007-2016";
+    my $year = "2007-2017";
     my $holder = "Ricardo Mones &lt;ricardo\@mones.org&gt;";
     my $url = "http://www.claws-mail.org/clawsker.php";
 
@@ -2494,6 +2714,7 @@ sub new_button_box {
     $b_apply->signal_connect (clicked => sub {
         save_preferences ($parent);
         save_ac_preferences ($parent);
+        save_hk_preferences ($parent);
     });
     # $b_undo->signal_connect (clicked => sub { undo_current_changes });
     $b_about->signal_connect (clicked => sub { $adlg->run; $adlg->hide });
@@ -2537,7 +2758,7 @@ exit unless init_hidden_preferences ();
 my $box = Gtk2::VBox->new (FALSE, 5);
 $box->set_border_width(3);
 my $about = new_about_dialog ();
-$box->pack_start (new_notebook (), FALSE, FALSE, 0);
+$box->pack_start (new_notebook (), TRUE, TRUE, 0);
 $box->pack_end (new_button_box ($main_window, $about), FALSE, FALSE, 0);
 $main_window->signal_connect (delete_event => sub { Gtk2->main_quit });
 $main_window->set_title ($xl::s{win_title});