On Thu, Apr 16, 2015 at 07:08:50AM +0200, M. Fioretti wrote:
> On 2015-04-16 03:28, Luis Mochan wrote:
> >>The system is not too
> >polished but serves me fine and has some similarities to gmails label
> >system. If interested, I can share it.
>
> I **am** interested, please do it
Dear Marco,
Please find attached my perl script. You should have the packages
Term::Readline (I use Term::Readline::Gnu) and File::Copy. It takes
two arguments, an action and the name of the file with the message to
edit. The action should be one of menu, edit, append, remove, show,
clean, list (in practive I only use 'edit'). If a change is performed,
the message is replaced by the edited version. To use the programs I
made some mutt macros. The relevant part of my muttrc file is:
############
# labels
# remember original editor.
# Might not be what you want if editor is changed afterwards
set my_editor="$editor"
macro index y "<enter-command>set editor=\"~/.mutt/editlabel.pl edit\"\n\
<tag-prefix><edit><next-undeleted>\
<enter-command>set editor=\"$my_editor\"\n" "Edit labels"
macro index YE "<enter-command>set editor=\"~/.mutt/editlabel.pl edit\"\n\
<tag-prefix><edit><next-undeleted>\
<enter-command>set editor=\"$my_editor\"\n" "Edit labels"
macro index YM "<enter-command>set editor=\"~/.mutt/editlabel.pl menu\"\n\
<tag-prefix><edit><next-undeleted>\
<enter-command>set editor=\"$my_editor\"\n" "Loop over label menu"
macro index YA "<enter-command>set editor=\"~/.mutt/editlabel.pl append\"\n\
<tag-prefix><edit><next-undeleted>\
<enter-command>set editor=\"$my_editor\"\n" "Append labels"
macro index YR "<enter-command>set editor=\"~/.mutt/editlabel.pl remove\"\n\
<tag-prefix><edit><next-undeleted>\
<enter-command>set editor=\"$my_editor\"\n" "Remove labels"
macro index YS "<enter-command>set editor=\"~/.mutt/editlabel.pl show\"\n\
<tag-prefix><edit>\
<enter-command>set editor=\"$my_editor\"\n" "Show labels"
macro index YC "<enter-command>set editor=\"~/.mutt/editlabel.pl clean\"\n\
<tag-prefix><edit><next-undeleted>\
<enter-command>set editor=\"$my_editor\"\n" "Clean labels"
macro index YL "<enter-command>set editor=\"~/.mutt/editlabel.pl list\"\n\
<tag-prefix><edit>\
<enter-command>set editor=\"$my_editor\"\n" "List labels"
macro index YX "<limit>!~h X-Label:<enter>" "Limit to unlabelled"
macro index YY "<limit>~h X-Label:<enter>" "Limit to labelled"
macro index \Cy "<limit>~y " "Limit view to label"
#show labels in index
set index_format="%4C %Z %{%b %d} %-15.15L %?M?(#%03M)&(%5l)? %?y?(%.20Y) ?%s"
#display labels in messages
unignore X-Label:
##############
In practice I only use
YX to display only unlabelled (i.e., unprocessed messages),
YY to only show processed messages (afterwards I use T to tag those
messages and move all of them to mbox)
y to insert/add/modify space separated labels
\Cy to display only messages with a given label
The program has history and completion to ease label edition. To that
end, I use a file .mutt/Xlabels to store all the previously used
labels.
I use this system under debian linux using perl 5.18 (haven't upgraded
it) under perlbrew.
Regards,
Luis
>
> Thanks,
> Marco
> --
> http://mfioretti.com
>
--
o
W. Luis Mochán, | tel:(52)(777)329-1734 /<(*)
Instituto de Ciencias Físicas, UNAM | fax:(52)(777)317-5388 `>/ /\
Apdo. Postal 48-3, 62251 | (*)/\/ \
Cuernavaca, Morelos, México | moc...@fis.unam.mx /\_/\__/
Consider using GnuPrivacyGuard https://www.gnupg.org/
My key: 791EB9EB, C949 3F81 6D9B 1191 9A16 C2DF 5F0A C52B 791E B9EB, yours?
#! /usr/bin/env perl
use strict;
use warnings;
use Fcntl qw(:DEFAULT :flock);
use Term::ReadLine;
use File::Copy;
use locale;
my ($action, $filename)=@ARGV;
my $labelfilename=$ENV{HOME} . "/.mutt/Xlabels";
die "$filename not readable" unless -r $filename;
#die "$labelfilename not readable. Create it." unless -r $labelfilename;
die "strange filename" unless $filename=~m{([^/]*)$};
my $basefilename=$1;
my $tmpfilename="/tmp/editlabels-$basefilename.$$";
my $history="$ENV{HOME}/.editlabelhistory";
my $maxhistory=100; #how many labels to remember in history
my $current=''; #current labels
my %current;
my %previouscurrent;
my %labels;
my %previouslabels;
sysopen LABELS, $labelfilename, O_RDWR|O_CREAT or die "Can't open $labelfilename $!";
flock(LABELS, LOCK_SH)
or die "Can't lock $labelfilename $!"; #puts a shared lock
chomp(my @labels=<LABELS>);
foreach(@labels){ #use %labels to remove duplicates
$labels{$_}++;
}
%previouslabels=%labels;
my $term=new Term::ReadLine 'X-Labels'; # prepare terminal to read labels
my $attribs=$term->Attribs;
$attribs->{completion_entry_function}=
$attribs->{list_completion_function};
$term->using_history;
$term->ReadHistory($history) if -r $history;
my $wrong="";
if($action eq "menu"){
for(;;){
$attribs->{completion_word} =
[qw(append clean edit list remove show quit
Append Clean Edit List Remove Show Quit)];
$action=lc $term->
readline("$wrong Append/Edit/Remove/Show/Clean/List/Quit: ");
$action=~s/ .*$//;
last unless once($action);
}
} else {
once($action);
}
# update labels
unless(comparehash(\%previouslabels, \%labels)){ #if labels changed
flock(LABELS, LOCK_EX)
or die "Can't lock $labelfilename $!"; #puts an exclusive lock
seek(LABELS, 0, 0); truncate(LABELS, 0);
print LABELS join("\n", sort {$a cmp $b} keys %labels), "\n";
}
close(LABELS);
# update history
$term->StifleHistory($maxhistory);
$term->WriteHistory($history) or die "Couldn't write $history $!";
#DONE
sub comparehash { #compares the keys of two hash references.
my ($ha, $hb)=@_;
if ( keys %$ha != keys %$hb) {
return 0; # they don't have the same number of keys;
}
my %cmp = map { $_ => 1 } keys %$ha;
for my $key (keys %$hb) {
last unless exists $cmp{$key};
delete $cmp{$key};
}
return ! %cmp;
}
sub once {
my $action = shift;
$wrong="";
edit(), return 1 if $action eq "edit";
append(), return 1 if $action eq "append";
remove(), return 1 if $action eq "remove";
show(), return 1 if $action eq "show";
clean(), return 1 if $action eq "clean";
list(), return 1 if $action eq "list";
return 0 if $action eq "quit";
$wrong="Wrong action.";
return 1;
}
sub getlabels {
chomp($current = `formail -c -x X-Label < $filename`);
$current=~s/^\s*//;
$current=~s/\s*$//;
my @current = split /,\s*|\s+/, $current;
map {$current{$_}++} @current;
%previouscurrent=%current;
}
sub modifylabels {
# do nothing if labels are the same
return if comparehash(\%previouscurrent, \%current);
my $xlabel="X-Label:";
$xlabel.=" ". join(' ', sort {$a cmp $b} keys %current) if %current;
print "$xlabel\n";
system "formail -I \"$xlabel\" < $filename > $tmpfilename";
move($tmpfilename, $filename)
or die "Couldn't rename $tmpfilename to $filename $!"
}
sub edit {
getlabels();
$attribs->{completion_word} = [keys %labels];
my $input=$term->readline("Edit label(s): ", $current);
my @input=split /\s+/, $input;
%current=(); # empty current labels.
# update labels that don't begin in colon
# colon-keywords are used for label groups
map {$labels{$_}++, $current{$_}++ unless /^\:/} @input;
modifylabels();
}
sub append {
getlabels();
print join(' ', sort {$a cmp $b} keys %current), "\n";
$attribs->{completion_word} = [keys %labels];
my $input=$term->readline("Add label(s): ");
my @input=split /\s+/, $input;
map {$labels{$_}++, $current{$_}++} @input;
modifylabels();
}
sub remove {
getlabels();
print join(' ', sort {$a cmp $b} keys %current), "\n";
$attribs->{completion_word} = [keys %current];
my $input=$term->readline("Remove label(s): ");
my @input=split /\s+/, $input;
map {delete $current{$_}} @input;
modifylabels();
}
sub show {
getlabels();
print join(' ', sort {$a cmp $b} keys %current), "\n";
$term->readline("<Enter> to continue ");
}
sub list {
open(LESS, "| fold -s | less");
print LESS join " ", sort {$a cmp $b} keys %labels;
close(LESS);
}
sub clean {
getlabels();
%current=();
modifylabels();
}
