1#!/usr/local/bin/perl 2 3# Copyright (C) 2005-2015 Quentin Sculo <squentin@free.fr> 4# 5# This file is part of Gmusicbrowser. 6# Gmusicbrowser is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License version 3, as 8# published by the Free Software Foundation 9# 10# Gmusicbrowser is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program. If not, see <http://www.gnu.org/licenses/>. 17 18use strict; 19use warnings; 20use utf8; 21 22package main; 23use Gtk2 '-init'; 24use Glib qw/filename_from_unicode filename_to_unicode/; 25use Gtk2::Pango; #for PANGO_WEIGHT_BOLD, PANGO_WEIGHT_NORMAL 26use POSIX qw/setlocale LC_NUMERIC LC_MESSAGES LC_TIME strftime mktime getcwd _exit/; 27use Encode qw/_utf8_on _utf8_off/; 28{no warnings 'redefine'; #some work arounds for old versions of perl-Gtk2 and/or gtk2 29 *filename_to_utf8displayname=\&Glib::filename_display_name if *Glib::filename_display_name{CODE}; 30 *PangoEsc=\&Glib::Markup::escape_text if *Glib::Markup::escape_text{CODE}; #needs perl-Gtk2 version >=1.092 31 *Gtk2::Notebook::set_tab_reorderable= sub {} unless *Gtk2::Notebook::set_tab_reorderable{CODE}; 32 *Gtk2::AboutDialog::set_url_hook= sub {} unless *Gtk2::AboutDialog::set_url_hook{CODE}; #for perl-Gtk2 version <1.080~1.083 33 *Gtk2::Label::set_ellipsize= sub {} unless *Gtk2::Label::set_ellipsize{CODE}; #for perl-Gtk2 version <1.080~1.083 34 *Gtk2::Pango::Layout::set_height= sub {} unless *Gtk2::Pango::Layout::set_height{CODE}; #for perl-Gtk2 version <1.180 pango <1.20 35 *Gtk2::Label::set_line_wrap_mode= sub {} unless *Gtk2::Label::set_line_wrap_mode{CODE}; #for gtk2 version <2.9 or perl-Gtk2 <1.131 36 *Gtk2::Scale::add_mark= sub {} unless *Gtk2::Scale::add_mark{CODE}; #for gtk2 version <2.16 or perl-Gtk2 <1.230 37 *Gtk2::ImageMenuItem::set_always_show_image= sub {} unless *Gtk2::ImageMenuItem::set_always_show_image{CODE};#for gtk2 version <2.16 or perl-Gtk2 <1.230 38 *Gtk2::Widget::set_visible= sub { my ($w,$v)=@_; if ($v) {$w->show} else {$w->hide} } unless *Gtk2::Widget::set_visible{CODE}; #for gtk2 version <2.18 or perl-Gtk2 <1.231 39 unless (*Gtk2::Widget::set_tooltip_text{CODE}) #for Gtk2 version <2.12 40 { my $Tooltips=Gtk2::Tooltips->new; 41 *Gtk2::Widget::set_tooltip_text= sub { $Tooltips->set_tip($_[0],$_[1]); }; 42 *Gtk2::Widget::set_tooltip_markup= sub { my $markup=$_[1]; $markup=~s/<[^>]*>//g; ;$Tooltips->set_tip($_[0],$markup); }; #remove markup 43 *Gtk2::ToolItem::set_tooltip_text= sub { $_[0]->set_tooltip($Tooltips,$_[1],''); }; 44 *Gtk2::ToolItem::set_tooltip_markup= sub { my $markup=$_[1]; $markup=~s/<[^>]*>//g; $_[0]->set_tooltip($Tooltips,$markup,''); }; 45 } 46 my $set_clip_rectangle_orig=\&Gtk2::Gdk::GC::set_clip_rectangle; 47 *Gtk2::Gdk::GC::set_clip_rectangle=sub { &$set_clip_rectangle_orig if $_[1]; } if $Gtk2::VERSION <1.102; #work-around $rect can't be undef in old bindings versions 48 if (eval($POSIX::VERSION)<1.18) #previously, date strings returned by strftime needed to be decoded by the locale encoding 49 { my ($encoding)= setlocale(LC_TIME)=~m#\.([^@]+)#; 50 $encoding='cp'.$encoding if $^O eq 'MSWin32' && $encoding=~m/^\d+$/; 51 if (!Encode::resolve_alias($encoding)) {warn "Can't find dates encoding used for dates, (LC_TIME=".setlocale(LC_TIME)."), dates may have wrong encoding\n";$encoding=undef} 52 *strftime_utf8= sub { $encoding ? Encode::decode($encoding, &strftime) : &strftime; }; 53 } 54} 55use List::Util qw/min max sum first/; 56use File::Copy; 57use Fcntl qw/O_NONBLOCK O_WRONLY O_RDWR SEEK_SET/; 58use Scalar::Util qw/blessed weaken refaddr/; 59use Unicode::Normalize 'NFKD'; #for accent-insensitive sort and search, only used via superlc() 60use Carp; 61$SIG{INT} = \&Carp::confess; 62 63#use constant SLASH => ($^O eq 'MSWin32')? '\\' : '/'; 64use constant SLASH => '/'; #gtk file chooser use '/' in win32 and perl accepts both '/' and '\' 65 66# Find dir containing other files (*.pm & pix/) -> $DATADIR 67use FindBin; 68our $DATADIR; 69BEGIN 70{ my @dirs=( $FindBin::RealBin, 71 join (SLASH,$FindBin::RealBin,'..','share','gmusicbrowser') #FIXME remove, all perl files will be in $FindBin::RealBin, gmusicbrowser.pl symlinked to /usr/bin/gmusibrowser 72 ); 73 ($DATADIR)=grep -e $_.SLASH.'gmusicbrowser_layout.pm', @dirs; 74 die "Can't find folder containing data files, looked in @dirs\n" unless $DATADIR; 75} 76use lib $DATADIR; 77 78use constant 79{ 80 TRUE => 1, 81 FALSE => 0, 82 VERSION => '1.1015', 83 VERSIONSTRING => '1.1.15', 84 PIXPATH => $DATADIR.SLASH.'pix'.SLASH, 85 PROGRAM_NAME => 'gmusicbrowser', 86 87 DRAG_STRING => 0, DRAG_USTRING => 1, DRAG_FILE => 2, 88 DRAG_ID => 3, DRAG_ARTIST => 4, DRAG_ALBUM => 5, 89 DRAG_FILTER => 6, DRAG_MARKUP => 7, 90 91 PI => 4 * atan2(1, 1), #needed for cairo rotation functions 92 KB => 1000, #1024 # bytes in a KB 93}; 94use constant MB => KB()**2; 95 96sub _ ($) {$_[0]} #dummy translation functions 97sub _p ($$) {_($_[1])} 98sub __ { sprintf( ($_[2]>1 ? $_[1] : $_[0]), $_[2]); } 99sub __p {shift;&__} 100sub __np {shift;&__n} 101sub __n { replace_fnumber( ($_[2]>1 ? $_[1] : $_[0]), $_[2]); } 102sub __x { my ($s,%h)=@_; $s=~s/{(\w+)}/$h{$1}/g; $s; } 103sub replace_fnumber { my $s=$_[0]; use locale; $s=~s/%d/format_number($_[1])/e; $s } #replace %d by the formated number, could use sprintf($_[0],$_[1]) instead but would require changing %d to %s 104BEGIN 105{no warnings 'redefine'; 106 my $localedir=$DATADIR; 107 $localedir= $FindBin::RealBin.SLASH.'..'.SLASH.'share' unless -d $localedir.SLASH.'locale'; 108 $localedir.=SLASH.'locale'; 109 my $domain='gmusicbrowser'; 110 eval {require Locale::Messages;}; 111 if ($@) 112 { eval {require Locale::gettext}; 113 if ($@) { warn "neither Locale::Messages, nor Locale::gettext found -> no translations\n"; } 114 elsif ($Locale::gettext::VERSION<1.04) { warn "Needs at least version 1.04 of Locale::gettext, v$Locale::gettext::VERSION found -> no translations\n" } 115 else 116 { warn "Locale::Messages not found, using Locale::gettext instead\n" if $::debug; 117 my $d= eval { Locale::gettext->domain($domain); }; 118 if ($@) { warn "Locale::gettext error : $@\n -> no translations\n"; } 119 else 120 { $d->dir($localedir); 121 *_=sub ($) { $d->get($_[0]); }; 122 *__=sub { sprintf $d->nget(@_),$_[2]; }; 123 *__n=sub { replace_fnumber($d->nget(@_),$_[2]); }; 124 } 125 } 126 } 127 else 128 { Locale::Messages::textdomain($domain); 129 Locale::Messages::bindtextdomain($domain=> $localedir); 130 Locale::Messages::bind_textdomain_codeset($domain=> 'utf-8'); 131 Locale::Messages::bind_textdomain_filter($domain=> \&Locale::Messages::turn_utf_8_on); 132 *_ = \&Locale::Messages::gettext; 133 *_p = \&Locale::Messages::pgettext; 134 *__ =sub { sprintf Locale::Messages::ngettext(@_),$_[2]; }; 135 *__p=sub { sprintf Locale::Messages::npgettext(@_),$_[3];}; 136 *__n =sub { replace_fnumber( Locale::Messages::ngettext(@_),$_[2] );}; 137 *__np=sub { replace_fnumber( Locale::Messages::npgettext(@_),$_[3]);}; 138 } 139} 140 141my $thousandsep; 142BEGIN { $thousandsep= POSIX::localeconv()->{thousands_sep}; } 143sub format_number 144{ my ($d,$f)=@_; 145 use locale; 146 $d= $f ? sprintf($f,$d) : ''.($d+0); # ''.($d+0) to force stringification of the number with the locale 147 return $d unless $d=~s/^(-?\d{4,})//; # $d now contains the fractional part 148 my $i=$1; # integer part 149 $i =~ s/(?<=\d)(?=(?:\d\d\d)+\b)/$thousandsep/g; 150 return $i.$d; 151} 152 153our $QSLASH; #quoted SLASH for use in regex 154 155# %html_entities and decode_html() are only used if HTML::Entities is not found 156my %html_entities= 157( amp => '&', 'lt' => '<', 'gt' => '>', quot => '"', apos => "'", 158 raquo => '»', copy => '©', middot => '·', 159 acirc => 'â', eacute => 'é', egrave => 'è', ecirc => 'ê', 160 agrave=> 'à', ccedil => 'ç', 161); 162sub decode_html 163{ my $s=shift; 164 $s=~s/&(?:#(\d+)|#x([0-9A-F]+)|([a-z]+));/$1 ? chr($1) : $2 ? chr(hex $2) : $html_entities{$3}||'?'/egi; 165 return $s; 166} 167BEGIN 168{ no warnings 'redefine'; 169 eval {require HTML::Entities}; 170 *decode_html= \&HTML::Entities::decode_entities unless $@; 171 $QSLASH=quotemeta SLASH; 172} 173 174sub file_name_is_absolute 175{ my $path=shift; 176 $^O eq 'MSWin32' ? $path=~m#^\w:$QSLASH#o : $path=~m#^$QSLASH#o; 177} 178sub rel2abs 179{ my ($path,$base)=@_; 180 return $path if file_name_is_absolute($path); 181 $base||= POSIX::getcwd; 182 return catfile($base,$path); 183} 184sub catfile 185{ my $path=join SLASH,@_; 186 $path=~s#$QSLASH{2,}#SLASH#goe; 187 return $path; 188} 189sub pathslash 190{ #return catfile($_[0],''); 191 my $path=shift; 192 $path.=SLASH unless $path=~m/$QSLASH$/o; 193 return $path; 194} 195sub simplify_path 196{ my ($path,$end_with_slash)=@_; 197 1 while $path=~s#$QSLASH+[^$QSLASH]+$QSLASH\.\.(?:$QSLASH+|$)#SLASH#oe; 198 return cleanpath($path,$end_with_slash); 199} 200sub cleanpath #remove repeated slashes, /./, and make sure it (does or doesn't) end with a slash 201{ my ($path,$end_with_slash)=@_; 202 $path=~s#$QSLASH\.$QSLASH#SLASH#goe; 203 $path=~s#$QSLASH{2,}#SLASH#goe; 204 $path=~s#$QSLASH$##o; 205 $path.=SLASH if $end_with_slash || $path!~m#$QSLASH#o; # $end_with_slash or root folder 206 return $path; 207} 208sub splitpath 209{ my $path=shift; 210 my $file= $path=~s#$QSLASH+([^$QSLASH]+)$##o ? $1 : ''; 211 $path.=SLASH unless $path=~m#$QSLASH#o; #root folder 212 return $path,$file; 213} 214sub dirname 215{ (&splitpath)[0]; 216} 217sub parentdir 218{ my $path=shift; 219 $path=~s#$QSLASH+$##o; 220 return $path=~m#$QSLASH#o ? dirname($path) : undef; 221} 222sub basename 223{ my $file=shift; 224 return $file=~m#([^$QSLASH]+)$#o ? $1 : ''; 225} 226sub barename #filename without extension 227{ my $file=&basename; 228 my $ext= $file=~s#\.([^.]*)$##o ? $1 : ''; 229 return wantarray ? ($file,$ext) : $file; 230} 231 232our %Alias_ext; #define alternate file extensions (ie: .ogg files treated as .oga files) 233INIT {%Alias_ext=(ogg=> 'oga', m4b=>'m4a');} #needs to be in a INIT block because used in a INIT block in gmusicbrowser_tags.pm 234our @ScanExt= qw/mp3 ogg oga flac mpc ape wv m4a m4b/; 235 236our ($Verbose,$debug); 237our %CmdLine; 238our ($HomeDir,$SaveFile,$FIFOFile,$ImportFile,$DBus_id,$DBus_suffix); 239our $TempDir; 240sub find_gmbrc_file { my @f= map $_[0].$_, '','.gz','.xz'; return wantarray ? (grep { -e $_ } @f) : first { -e $_ } @f } 241my $gmbrc_ext_re= qr/\.gz$|\.xz$/; 242 243# Parse command line 244BEGIN # in a BEGIN block so that commands for a running instance are sent sooner/faster 245{ $DBus_id='org.gmusicbrowser'; $DBus_suffix=''; 246 247 my $default_home= Glib::get_user_config_dir.SLASH.'gmusicbrowser'; 248 if (!-d $default_home && -d (my $old= Glib::get_home_dir.SLASH.'.gmusicbrowser' ) ) 249 { warn "Using folder $old for configuration, you could move it to $default_home to conform to the XDG Base Directory Specification\n"; 250 $default_home=$old; 251 } 252 253my $help=PROGRAM_NAME.' v'.VERSIONSTRING." (c)2005-2015 Quentin Sculo 254options : 255-nocheck: don't check for updated/deleted songs on startup 256-noscan : don't scan folders for songs on startup 257-demo : don't save settings/tags on exit 258-ro : prevent modifying/renaming/deleting song files 259-rotags : prevent modifying tags of music files 260-play : start playing on startup 261-gst0 : prefer gstreamer-0.10 over gstreamer-1.x if both are available 262-nogst : do not load any gstreamer librairies 263-server : send playing song to connected icecast clent 264-port N : listen for connection on port N in icecast server mode 265-verbose: print some info, like the file being played 266-debug : print lots of mostly useless informations, implies -verbose 267-backtrace : print a backtrace for every warning 268-nodbus : do not provide DBus services 269-dbus-id KEY : append .KEY to the DBus service id used by gmusicbrowser (org.gmusicbrowser) 270-nofifo : do not create/use named pipe 271-F FIFO, -fifo FILE : use FIFO as named pipe to receive commands (instead of 'gmusicbrowser.fifo' in default folder) 272-C FILE, -cfg FILE : use FILE as configuration file (instead of 'gmbrc' in default folder), 273 if FILE is a folder, sets the default folder to FILE. 274-l NAME, -layout NAME : Use layout NAME for player window 275+plugin NAME : Enable plugin NAME 276-plugin NAME : Disable plugin NAME 277-noplugins : Disable all plugins 278-searchpath FOLDER : Additional FOLDER to look for plugins and layouts 279-use-gnome-session : Use gnome libraries to save tags/settings on session logout 280-workspace N : move initial window to workspace N (requires Gnome2::Wnck) 281-gzip : force not compressing gmbrc 282+gzip : force compressing gmbrc with gzip 283+xz : force compressing gmbrc with xz 284 285-cmd CMD : add CMD to the list of commands to execute 286-ifnotrunning MODE : change behavior when no running gmusicbrowser instance is found 287 MODE can be one of : 288 * normal (default) : launch a new instance and execute commands 289 * nocmd : launch a new instance but discard commands 290 * abort : do nothing 291-nolaunch : same as : -ifnotrunning abort 292Running instances of gmusicbrowser are detected via the fifo or via DBus. 293To run more than one instance, use a unique fifo and a unique DBus-id, or deactivate them. 294 295Options to change what is done with files/folders passed as arguments (done in running gmusicbrowser if there is one) : 296-playlist : Set them as playlist (default) 297-enqueue : Enqueue them 298-addplaylist : Add them to the playlist 299-insertplaylist : Insert them in the playlist after current song 300-add : Add them to the library 301 302-tagedit FOLDER_OR_FILE ... : Edittag mode 303-listplugin : list the available plugins and exit 304-listcmd : list the available fifo commands and exit 305-listlayout : list the available layouts and exit 306"; 307 unshift @ARGV,'-tagedit' if $0=~m/tagedit/; 308 my (@files,$filescmd,@cmd,$ignore); 309 my $ifnotrunning='normal'; 310 while (defined (my $arg=shift)) 311 { if ($arg eq '-c' || $arg eq '-nocheck') {$CmdLine{nocheck}=1} 312 elsif($arg eq '-s' || $arg eq '-noscan') {$CmdLine{noscan}=1} 313 elsif($arg eq '-demo') {$CmdLine{demo}=1} 314 elsif($arg eq '-play') {$CmdLine{play}=1} 315 elsif($arg eq '-hide') {$CmdLine{hide}=1} 316 elsif($arg eq '-server') {$CmdLine{server}=1} 317 elsif($arg eq '-nodbus') {$CmdLine{noDBus}=1} 318 elsif($arg eq '-nogst') {$CmdLine{nogst}=1} 319 elsif($arg eq '-gst0') {$CmdLine{gst0}=1} #prefer gstreamer-0.10 320 elsif($arg eq '-ro') {$CmdLine{ro}=$CmdLine{rotags}=1} 321 elsif($arg eq '-rotags') {$CmdLine{rotags}=1} 322 elsif($arg eq '-port') {$CmdLine{port}=shift if $ARGV[0]} 323 elsif($arg eq '-verbose') {$Verbose=1} 324 elsif($arg eq '-debug') {$debug=$Verbose=4} 325 elsif($arg eq '-backtrace') { $SIG{ __WARN__ } = \&Carp::cluck; $SIG{ __DIE__ } = \&Carp::confess; } 326 elsif($arg eq '-nofifo') {$FIFOFile=''} 327 elsif($arg eq '-workspace') {$CmdLine{workspace}=shift if defined $ARGV[0]} #requires Gnome2::Wnck 328 elsif($arg eq '-C' || $arg eq '-cfg') {$CmdLine{savefile}=shift if $ARGV[0]} 329 elsif($arg eq '-F' || $arg eq '-fifo') {$FIFOFile=rel2abs(shift) if $ARGV[0]} 330 elsif($arg eq '-l' || $arg eq '-layout') {$CmdLine{layout}=shift if $ARGV[0]} 331 elsif($arg eq '-import') { $ImportFile=rel2abs(shift) if $ARGV[0]} 332 elsif($arg eq '-searchpath') { push @{ $CmdLine{searchpath} },shift if $ARGV[0]} 333 elsif($arg=~m/^([+-])plugin$/) { $CmdLine{plugins}{shift @ARGV}=($1 eq '+') if $ARGV[0]} 334 elsif($arg eq '-noplugins') { $CmdLine{noplugins}=1; delete $CmdLine{plugins}; } 335 elsif($arg=~m/^([+-])gzip$/) { $CmdLine{gzip}= $1 eq '+' ? 'gzip':''} 336 elsif($arg=~m/^([+-])xz$/) { $CmdLine{gzip}= $1 eq '+' ? 'xz':''} 337 elsif($arg eq '-geometry') { $CmdLine{geometry}=shift if $ARGV[0]; } 338 elsif($arg eq '-tagedit') { $CmdLine{tagedit}=1; $ignore=1; last; } 339 elsif($arg eq '-listplugin') { $CmdLine{pluginlist}=1; $ignore=1; last; } 340 elsif($arg eq '-listcmd') { $CmdLine{cmdlist}=1; $ignore=1; last; } 341 elsif($arg eq '-listlayout') { $CmdLine{layoutlist}=1; $ignore=1; last; } 342 elsif($arg eq '-cmd') { push @cmd, shift if $ARGV[0]; } 343 elsif($arg eq '-ifnotrunning') { $ifnotrunning=shift if $ARGV[0]; } 344 elsif($arg eq '-nolaunch') { $ifnotrunning='abort'; } 345 elsif($arg eq '-dbus-id') { if (my $id=shift) { if ($id=~m/^\w+$/) { $DBus_id.= $DBus_suffix='.'.$id; } else { warn "invalid dbus-id '$id', only letters, numbers and _ allowed\n" }; } } 346 elsif($arg eq '-add') { $filescmd='AddToLibrary'; } 347 elsif($arg eq '-playlist') { $filescmd='OpenFiles'; } 348 elsif($arg eq '-enqueue') { $filescmd='EnqueueFiles'; } 349 elsif($arg eq '-addplaylist') { $filescmd='AddFilesToPlaylist'; } 350 elsif($arg eq '-insertplaylist'){ $filescmd='InsertFilesInPlaylist'; } 351 elsif($arg eq '-use-gnome-session'){ $CmdLine{UseGnomeSession}=1; } 352 elsif($arg=~m#^http://# || -e $arg) { push @files,$arg } 353 else 354 { warn "unknown option '$arg'\n" unless $arg=~/^--?h(elp)?$/; 355 print $help; 356 exit; 357 } 358 } 359 unless ($ignore) 360 { # filenames given in the command line 361 if (@files) 362 { for my $f (@files) 363 { unless ($f=~m#^http://#) 364 { $f=rel2abs($f); 365 $f=~s/([^A-Za-z0-9])/sprintf('%%%02X', ord($1))/seg; #FIXME use url_escapeall, but not yet defined 366 } 367 } 368 $filescmd ||= 'OpenFiles'; 369 my $cmd="$filescmd(@files)"; 370 push @cmd, $cmd; 371 } 372 373 # determine $HomeDir $SaveFile $ImportFile and $FIFOFile 374 my $save= delete $CmdLine{savefile}; 375 if (defined $save) 376 { my $isdir= $save=~m#/$#; ## $save is considered a folder if ends with a "/" 377 $save= rel2abs($save); 378 if (-d $save || $isdir) { $HomeDir = $save; } 379 else { $SaveFile= $save; } 380 } 381 warn "using '$HomeDir' folder for saving/setting folder instead of '$default_home'\n" if $debug && $HomeDir; 382 $HomeDir= pathslash(cleanpath($HomeDir || $default_home)); # $HomeDir must end with a slash 383 if (!-d $HomeDir) 384 { warn "Creating folder $HomeDir\n"; 385 my $current=''; 386 for my $dir (split /$QSLASH/o,$HomeDir) 387 { $current.=SLASH.$dir; 388 next if -d $current; 389 die "Can't create folder $HomeDir : $!\n" unless mkdir $current; 390 } 391 } 392 # auto import from old v1.0 tags file if using default savefile, it doesn't exist and old tags file exists 393 if (!$SaveFile && !find_gmbrc_file($HomeDir.'gmbrc') && -e $HomeDir.'tags') { $ImportFile||=$HomeDir.'tags'; } 394 395 $SaveFile||= $HomeDir.'gmbrc'; 396 $FIFOFile= $HomeDir.'gmusicbrowser.fifo' if !defined $FIFOFile && $^O ne 'MSWin32'; 397 398 #check if there is an instance already running 399 my $running; 400 if ($FIFOFile && -p $FIFOFile) 401 { my @c= @cmd ? @cmd : ('Show'); #fallback to "Show" command 402 my $ok=sysopen my$fifofh,$FIFOFile, O_NONBLOCK | O_WRONLY; 403 if ($ok) 404 { print $fifofh "$_\n" and $running=1 for @c; 405 close $fifofh; 406 $running&&= "using '$FIFOFile'"; 407 } 408 else {warn "Found orphaned fifo '$FIFOFile' : previous session wasn't closed properly\n"} 409 } 410 if (!$running && !$CmdLine{noDBus}) 411 { eval {require 'gmusicbrowser_dbus.pm'} 412 || warn "Error loading gmusicbrowser_dbus.pm :\n$@ => controlling gmusicbrowser through DBus won't be possible.\n\n"; 413 eval 414 { my $bus= $GMB::DBus::bus || die; 415 my $service = $bus->get_service($DBus_id) || die; 416 my $object = $service->get_object('/org/gmusicbrowser', 'org.gmusicbrowser') || die; 417 $object->RunCommand($_) for @cmd; 418 }; 419 $running="using DBus id=$DBus_id" unless $@; 420 } 421 if ($running) 422 { warn "Found a running instance ($running)\n"; 423 exit; 424 } 425 else 426 { exit if $ifnotrunning eq 'abort'; 427 @cmd=() if $ifnotrunning eq 'nocmd'; 428 } 429 $CmdLine{runcmd}=\@cmd if @cmd; 430 } 431} 432# end of command line handling 433 434our $HTTP_module; 435our ($Play_package,%PlayPacks); my ($PlayNext_package,$Vol_package); 436BEGIN{ 437require 'gmusicbrowser_songs.pm'; 438require 'gmusicbrowser_tags.pm'; 439require 'gmusicbrowser_layout.pm'; 440require 'gmusicbrowser_list.pm'; 441$HTTP_module= -e $DATADIR.SLASH.'simple_http_wget.pm' && (grep -x $_.SLASH.'wget', split /:/, $ENV{PATH}) ? 'simple_http_wget.pm' : 442 -e $DATADIR.SLASH.'simple_http_AE.pm' && (grep -f $_.SLASH.'AnyEvent'.SLASH.'HTTP.pm', @INC) ? 'simple_http_AE.pm' : 443 'simple_http.pm'; 444#warn "using $HTTP_module for http requests\n"; 445#require $HTTP_module; 446 447 # load gstreamer backend module 448 if (!$CmdLine{nogst}) 449 { my @gst= ('gmusicbrowser_gstreamer-1.x.pm', 'gmusicbrowser_gstreamer-0.10.pm'); 450 my $error; 451 @gst= reverse @gst if $CmdLine{gst0}; 452 { my $file= shift @gst; 453 eval { require $file; }; #each file sets $::PlayPacks{PACKAGENAME} to 1 for each of its included playback packages 454 if ($@) 455 { warn $@ if $::debug; 456 if (@gst) {$error=$@; redo unless $::gstreamer_version} # keep first error message, try next file unless parts already loaded 457 $error=~s/\n.*//s; #only keep first line, others are noise 458 my $error0= "Can't load either gstreamer-1.x (via Glib::Object::Introspection) or gstreamer-0.10 (via GStreamer)"; 459 if (@gst) { $error0= "Error loading gstreamer-$::gstreamer_version" } 460 warn "\n$error0 -> gstreamer output won't be available :\n $error\n\n"; 461 } 462 warn "Using gstreamer-.$::gstreamer_version.\n" if $::debug; 463 } 464 } 465 466 # load non-gstreamer backend modules 467 for my $file (qw/gmusicbrowser_123.pm gmusicbrowser_mplayer.pm gmusicbrowser_mpv.pm gmusicbrowser_server.pm/) 468 { eval { require $file } || warn $@; #each file sets $::PlayPacks{PACKAGENAME} to 1 for each of its included playback packages 469 } 470 471 472 $TempDir= Glib::get_tmp_dir.SLASH; _utf8_off($TempDir); #turn utf8 flag off to not auto-utf8-upgrade other filenames in the same strings 473} 474 475our $CairoOK; 476my ($UseGtk2StatusIcon,$TrayIconAvailable); 477BEGIN 478{ if (*Gtk2::StatusIcon::set_has_tooltip{CODE}) { $TrayIconAvailable= $UseGtk2StatusIcon= 1; } 479 else 480 { eval { require Gtk2::TrayIcon; $TrayIconAvailable=1; }; 481 if ($@) { warn "Gtk2::TrayIcon not found -> tray icon won't be available\n"; } 482 } 483 eval { require Cairo; $CairoOK=1; }; 484 if ($@) { warn "Cairo perl module not found -> transparent windows and other effects won't be available\n"; } 485} 486 487our $Image_ext_re; # = qr/\.(?:jpe?g|png|gif|bmp)$/i; 488BEGIN 489{ my $re=join '|', sort map @{$_->{extensions}}, Gtk2::Gdk::Pixbuf->get_formats; 490 $Image_ext_re=qr/\.(?:$re)$/i; 491} 492our $EmbImage_ext_re= qr/\.(?:mp3|flac|m4a|m4b|ogg|oga)/i; # warning: doesn't force end of string (with a "$") as sometimes needs to include/extract a :\w+ at the end, so need to use it with /$EmbImage_ext_re$/ or /$EmbImage_ext_re(:\w+)?$/ 493 494########## 495 496#our $re_spaces_unlessinbrackets=qr/([^( ]+(?:\(.*?\))?)(?: +|$)/; #breaks "widget1(options with spaces) widget2" in "widget1(options with spaces)" and "widget2" #replaced by ExtractNameAndOptions 497 498my ($browsercmd,$opendircmd); 499 500#changes to %QActions must be followed by a call to Update_QueueActionList() 501# changed : called from Queue or QueueAction changed 502# action : called when queue is empty 503# keep : do not clear mode once empty 504# save : save mode when RememberQueue is on 505# condition : do not show mode if return false 506# order : used to sort modes 507# autofill : indicate that this mode use the maxautofill value 508# can_next : this mode can be use with $NextAction 509our %QActions= 510( '' => {order=>0, short=> _"normal", long=> _"Normal mode", can_next=>1, }, 511 autofill=> {order=>10, icon=>'gtk-refresh', short=> _"autofill", long=> _"Auto-fill queue", changed=>\&QAutoFill, keep=>1,save=>1,autofill=>1, }, 512 'wait' => {order=>20, icon=>'gmb-wait', short=> _"wait for more", long=> _"Wait for more when queue empty", action=>\&Stop, changed=>\&QWaitAutoPlay,keep=>1,save=>1, }, 513 stop => {order=>30, icon=>'gtk-media-stop', short=> _"stop", long=> _"Stop when queue empty", action=>\&Stop, 514 can_next=>1, long_next=>_"Stop after this song", }, 515 quit => {order=>40, icon=>'gtk-quit', short=> _"quit", long=> _"Quit when queue empty", action=>\&Quit, 516 can_next=>1, long_next=>_"Quit after this song"}, 517 turnoff => {order=>50, icon=>'gmb-turnoff', short=> _"turn off", long=> _"Turn off computer when queue empty", action=>sub {Stop(); TurnOff();}, 518 condition=> sub { $::Options{Shutdown_cmd} }, can_next=>1, long_next=>_"Turn off computer after this song"}, 519); 520 521our %StockLabel=( 'gmb-turnoff' => _"Turn Off" ); 522 523our @DRAGTYPES; 524@DRAGTYPES[DRAG_FILE,DRAG_USTRING,DRAG_STRING,DRAG_MARKUP,DRAG_ID,DRAG_ARTIST,DRAG_ALBUM,DRAG_FILTER]= 525( ['text/uri-list'], 526 ['text/plain;charset=utf-8'], 527 ['STRING'], 528 ['markup'], 529 [SongID => 530 { DRAG_FILE, sub { Songs::Map('uri',\@_); }, 531 DRAG_ARTIST, sub { @{Songs::UniqList('artist',\@_,1)}; }, 532 DRAG_ALBUM, sub { @{Songs::UniqList('album',\@_,1)}; }, 533 DRAG_USTRING, sub { (@_==1)? Songs::Display($_[0],'title') : __n("%d song","%d songs",scalar@_) }, 534 #DRAG_STRING, undef, #will use DRAG_USTRING 535 DRAG_STRING, sub { Songs::Map('uri',\@_); }, 536 DRAG_FILTER, sub {Filter->newadd(FALSE,map 'title:~:'.Songs::Get($_,'title'),@_)->{string}}, 537 DRAG_MARKUP, sub { return ReplaceFieldsAndEsc($_[0],_"<b>%t</b>\n<small><small>by</small> %a\n<small>from</small> %l</small>") if @_==1; 538 my $nba=@{Songs::UniqList2('artist',\@_)}; 539 my $artists= ($nba==1)? Songs::DisplayEsc($_[0],'artist') : __("%d artist","%d artists",$nba); 540 __x( _("{songs} by {artists}") . "\n<small>{length}</small>", 541 songs => __n("%d song","%d songs",scalar@_), 542 artists => $artists, 543 'length' => CalcListLength(\@_,'length') 544 )}, 545 }], 546 [Artist => { DRAG_USTRING, sub { (@_<10)? join("\n",@{Songs::Gid_to_Display('artist',\@_)}) : __("%d artist","%d artists",scalar@_) }, 547 #DRAG_STRING, undef, #will use DRAG_USTRING 548 DRAG_STRING, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); }, 549 DRAG_FILE, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); }, 550 DRAG_FILTER, sub { Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->{string} }, 551 DRAG_ID, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('artists',$_),@_)->filter; SortList($l); @$l; }, 552 }], 553 [Album => { DRAG_USTRING, sub { (@_<10)? join("\n",@{Songs::Gid_to_Display('album',\@_)}) : __("%d album","%d albums",scalar@_) }, 554 #DRAG_STRING, undef, #will use DRAG_USTRING 555 DRAG_STRING, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); }, 556 DRAG_FILE, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->filter; SortList($l); Songs::Map('uri',$l); }, 557 DRAG_FILTER, sub { Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->{string} }, 558 DRAG_ID, sub { my $l=Filter->newadd(FALSE,map Songs::MakeFilterFromGID('album',$_),@_)->filter; SortList($l); @$l; }, 559 }], 560 [Filter => 561 { DRAG_USTRING, sub {Filter->new($_[0])->explain}, 562 #DRAG_STRING, undef, #will use DRAG_USTRING 563 DRAG_STRING, sub { my $l=Filter->new($_[0])->filter; SortList($l); Songs::Map('uri',$l); }, 564 DRAG_ID, sub { my $l=Filter->new($_[0])->filter; SortList($l); @$l; }, 565 DRAG_FILE, sub { my $l=Filter->new($_[0])->filter; SortList($l); Songs::Map('uri',$l); }, 566 } 567 ], 568); 569our %DRAGTYPES; 570$DRAGTYPES{$DRAGTYPES[$_][0]}=$_ for DRAG_FILE,DRAG_USTRING,DRAG_STRING,DRAG_ID,DRAG_ARTIST,DRAG_ALBUM,DRAG_FILTER,DRAG_MARKUP; 571 572our @submenuRemove= 573( { label => sub {$_[0]{mode} eq 'Q' ? _"Remove from queue" : $_[0]{mode} eq 'A' ? _"Remove from playlist" : _"Remove from list"}, code => sub { $_[0]{self}->RemoveSelected; }, mode => 'BLQA', istrue=> 'allowremove', }, 574 { label => _"Remove from library", code => sub { SongsRemove($_[0]{IDs}); }, }, 575 { label => _"Remove from disk", code => sub { DeleteFiles($_[0]{IDs}); }, test => sub {!$CmdLine{ro}}, stockicon => 'gtk-delete' }, 576); 577our @submenuQueue= 578( { label => _"Prepend", code => sub { QueueInsert( @{ $_[0]{IDs} } ); }, }, 579 { label => _"Replace", code => sub { ReplaceQueue( @{ $_[0]{IDs} } ); }, }, 580 { label => _"Append", code => sub { Enqueue( @{ $_[0]{IDs} } ); }, }, 581); 582#modes : S:Search, B:Browser, Q:Queue, L:List, P:Playing song in the player window, F:Filter Panels (submenu "x songs") 583our @SongCMenu; 584unshift @SongCMenu, #unshift instead of "=" because the replaygain submenu (and maybe more in the future) has already been added to @::SongCMenu 585( { label => _"Song Properties", code => sub { DialogSongProp (@{ $_[0]{IDs} }); }, onlyone => 'IDs', stockicon => 'gtk-edit' }, 586 { label => _"Songs Properties", code => sub { DialogSongsProp(@{ $_[0]{IDs} }); }, onlymany=> 'IDs', stockicon => 'gtk-edit' }, 587 { label => _"Play Only Selected",code => sub { Select(song => 'first', play => 1, staticlist => $_[0]{IDs} ); }, 588 onlymany => 'IDs', stockicon => 'gtk-media-play'}, 589 { label => _"Play Only Displayed",code => sub { Select(song => 'first', play => 1, staticlist => \@{$_[0]{listIDs}} ); }, 590 test => sub { @{$_[0]{IDs}}<2 }, notmode => 'A', onlymany => 'listIDs', stockicon => 'gtk-media-play' }, 591 { label => _"Append to playlist",code => sub { ::DoActionForList('addplay',$_[0]{IDs}); }, 592 notempty => 'IDs', test => sub { $::ListMode }, }, 593 { label => _"Enqueue Selected", code => sub { Enqueue(@{ $_[0]{IDs} }); }, submenu3=> \@submenuQueue, 594 notempty => 'IDs', notmode => 'QP', stockicon => 'gmb-queue' }, 595 { label => _"Enqueue Displayed", code => sub { Enqueue(@{ $_[0]{listIDs} }); }, 596 empty => 'IDs', notempty=> 'listIDs', notmode => 'QP', stockicon => 'gmb-queue' }, 597 { label => _"Add to list", submenu => \&AddToListMenu, notempty => 'IDs' }, 598 # edit submenu for label-type fields 599 { label => sub { Songs::Field_Edit_string($_[0]{field}); }, notempty => 'IDs', 600 submenu=>sub { LabelEditMenu($_[0]{field},$_[0]{IDs}); }, 601 foreach=>sub { 'field', Songs::FieldList(true=>'editsubmenu',type=>'flags'); }, }, 602 # edit submenu for rating-type fields 603 { label => sub { Songs::Field_Edit_string($_[0]{field}); }, notempty => 'IDs', 604 submenu=>sub { Stars::createmenu($_[0]{field},$_[0]{IDs}); }, 605 foreach=>sub { 'field', Songs::FieldList(true=>'editsubmenu',type=>'rating'); }, }, 606 { label => _"Find songs with the same names", code => sub { SearchSame('title',$_[0]) }, mode => 'B', notempty => 'IDs' }, 607 { label => _"Find songs with same artists", code => sub { SearchSame('artists',$_[0])}, mode => 'B', notempty => 'IDs' }, 608 { label => _"Find songs in same albums", code => sub { SearchSame('album',$_[0]) }, mode => 'B', notempty => 'IDs' }, 609 { label => _"Rename file", code => sub { DialogRename( @{ $_[0]{IDs} }); }, onlyone => 'IDs', test => sub {!$CmdLine{ro}}, }, 610 { label => _"Mass Rename", code => sub { DialogMassRename( @{ $_[0]{IDs} }); }, onlymany=> 'IDs', test => sub {!$CmdLine{ro}}, }, 611 { label => _"Copy", code => sub { CopyMoveFilesDialog($_[0]{IDs},TRUE); }, 612 notempty => 'IDs', stockicon => 'gtk-copy', notmode => 'P' }, 613 { label => _"Move", code => sub { CopyMoveFilesDialog($_[0]{IDs},FALSE); }, 614 notempty => 'IDs', notmode => 'P', test => sub {!$CmdLine{ro}}, }, 615 #{ label => sub {'Remove from '.($_[0]{mode} eq 'Q' ? 'queue' : 'this list')}, code => sub { $_[0]{self}->RemoveSelected; }, stockicon => 'gtk-remove', notempty => 'IDs', mode => 'LQ' }, #FIXME 616 { label => _"Remove", submenu => \@submenuRemove, stockicon => 'gtk-remove', notempty => 'IDs', notmode => 'P' }, 617 { label => _"Re-read tags", code => sub { ReReadTags(@{ $_[0]{IDs} }); }, 618 notempty => 'IDs', notmode => 'P', stockicon => 'gtk-refresh' }, 619 { label => _"Same Title", submenu => sub { ChooseSongsTitle( $_[0]{IDs}[0] ); }, mode => 'P' }, 620 { label => _"Edit Lyrics", code => sub { EditLyrics( $_[0]{IDs}[0] ); }, mode => 'P' }, 621 { label => _"Lookup in google", code => sub { Google( $_[0]{IDs}[0] ); }, mode => 'P' }, 622 { label => _"Open containing folder", code => sub { openfolder( Songs::Get( $_[0]{IDs}[0], 'path') ); }, onlyone => 'IDs' }, 623 { label => _"Queue options", submenu => \@Layout::MenuQueue, mode => 'Q', } 624); 625our @cMenuAA= 626( { label => _"Lock", code => sub { ToggleLock($_[0]{lockfield}); }, check => sub { $::TogLock && $::TogLock eq $_[0]{lockfield}}, mode => 'P', 627 test => sub { $_[0]{field} eq $_[0]{lockfield} || $_[0]{gid} == Songs::Get_gid($::SongID,$_[0]{lockfield}); }, 628 }, 629 { label => _"Lookup in AMG", code => sub { AMGLookup( $_[0]{mainfield}, $_[0]{aaname} ); }, 630 test => sub { $_[0]{mainfield} =~m/^album$|^artist$|^title$/; }, 631 }, 632 { label => _"Filter", code => sub { Select(filter => Songs::MakeFilterFromGID($_[0]{field},$_[0]{gid})); }, stockicon => 'gmb-filter', mode => 'P' }, 633 { label => \&SongsSubMenuTitle, submenu => \&SongsSubMenu, }, 634 { label => sub {$_[0]{mode} eq 'P' ? _"Display Songs" : _"Filter"}, code => \&FilterOnAA, 635 test => sub { GetSonglist( $_[0]{self} ) }, }, 636 { label => _"Set Picture", code => sub { ChooseAAPicture($_[0]{ID},$_[0]{mainfield},$_[0]{gid}); }, 637 stockicon => 'gmb-picture' }, 638); 639 640our @TrayMenu= 641( { label=> sub {$::TogPlay ? _"Pause" : _"Play"}, code => \&PlayPause, stockicon => sub { $::TogPlay ? 'gtk-media-pause' : 'gtk-media-play'; }, id=>'playpause' }, 642 { label=> _"Stop", code => \&Stop, stockicon => 'gtk-media-stop' }, 643 { label=> _"Next", code => \&NextSong, stockicon => 'gtk-media-next', id=>'next', }, 644 { label=> _"Recently played", submenu => sub { my $m=ChooseSongs([GetPrevSongs(8)]); }, stockicon => 'gtk-media-previous' }, 645 { label=> sub {$::TogLock && $::TogLock eq 'first_artist'? _"Unlock Artist" : _"Lock Artist"}, code => sub {ToggleLock('first_artist');} }, 646 { label=> sub {$::TogLock && $::TogLock eq 'album' ? _"Unlock Album" : _"Lock Album"}, code => sub {ToggleLock('album');} }, 647 { label=> _"Windows", code => \&PresentWindow, submenu_ordered_hash =>1, 648 submenu => sub { [map { $_->layout_name => $_ } grep $_->isa('Layout::Window'), Gtk2::Window->list_toplevels]; }, }, 649 { label=> sub { IsWindowVisible($::MainWindow) ? _"Hide": _"Show"}, code => sub { ShowHide(); }, id=>'showhide', }, 650 { label=> _"Fullscreen", code => \&ToggleFullscreenLayout, stockicon => 'gtk-fullscreen' }, 651 { label=> _"Settings", code => 'OpenPref', stockicon => 'gtk-preferences' }, 652 { label=> _"Quit", code => \&Quit, stockicon => 'gtk-quit' }, 653); 654 655our %Artists_split= 656( '\s*&\s*' => "&", 657 '\s*\\+\s*' => "+", 658 '\s*\\|\s*' => "|", 659 '\s*;\s*' => ";", 660 '\s*/\s*' => "/", 661 '\s*,\s+' => ", ", 662 ',?\s+and\s+' => "and", #case-sensitive because the user might want to use "And" in artist names that should NOT be splitted 663 ',?\s+And\s+' => "And", 664 '\s+featuring\s+' => "featuring", 665 '\s+feat\.\s+' => "feat.", 666 '\s+[Vv][Ss]\s+' => "VS", 667); 668our %Artists_from_title= 669( '\(with\s+([^)]+)\)' => "(with X)", 670 '\(feat\.\s+([^)]+)\)' => "(feat. X)", 671 '\(featuring\s+([^)]+)\)' => "(featuring X)", 672); 673 674 675#a few inactive debug functions 676sub red {} 677sub blue {} 678sub callstack {} 679 680sub url_escapeall 681{ my $s=$_[0]; 682 _utf8_off($s); # or "use bytes" ? 683 $s=~s#([^A-Za-z0-9])#sprintf('%%%02X', ord($1))#seg; 684 return $s; 685} 686sub url_escape 687{ my $s=$_[0]; 688 _utf8_off($s); 689 $s=~s#([^/\$_.+!*'(),A-Za-z0-9-])#sprintf('%%%02X',ord($1))#seg; 690 return $s; 691} 692sub decode_url 693{ my $s=$_[0]; 694 return undef unless defined $s; 695 _utf8_off($s); 696 $s=~s#%([0-9A-F]{2})#chr(hex $1)#ieg; 697 return $s; 698} 699 700sub PangoEsc # escape special chars for pango ( & < > ) #replaced by Glib::Markup::escape_text if available 701{ local $_=$_[0]; 702 return '' unless defined; 703 s/&/&/g; s/</</g; s/>/>/g; 704 s/"/"/g; s/'/'/g; # doesn't seem to be needed 705 return $_; 706} 707sub MarkupFormat 708{ my $format=shift; 709 sprintf $format, map PangoEsc($_), @_; 710} 711sub Gtk2::Label::new_with_format 712{ my $class=shift; 713 my $label=Gtk2::Label->new; 714 $label->set_markup( MarkupFormat(@_) ); 715 return $label; 716} 717sub Gtk2::Label::set_markup_with_format 718{ my $label=shift; 719 $label->set_markup( MarkupFormat(@_) ); 720} 721sub Gtk2::Dialog::add_button_custom 722{ my ($dialog,$text,$response_id,%args)=@_; 723 my ($icon,$tip,$secondary)=@args{qw/icon tip secondary/}; 724 my $button= Gtk2::Button->new; 725 $button->set_image( Gtk2::Image->new_from_stock($icon,'menu') ) if $icon; 726 $button->set_label($text); 727 $button->set_use_underline(1); 728 $button->set_tooltip_text($tip) if defined $tip; 729 $dialog->add_action_widget($button,$response_id); 730 if ($secondary) 731 { my $bb=$button->parent; 732 if ($bb && $bb->isa('Gtk2::ButtonBox')) { $bb->set_child_secondary($button,1); } 733 } 734 return $button; 735} 736 737sub Gtk2::Window::force_present #force bringing the window to the current workspace, $win->present does not always do that 738{ my $win=shift; 739 unless ($win->window && ($win->window->get_state >= 'sticky')) { $win->stick; $win->unstick; } 740 $win->present; 741} 742sub IncSuffix # increment a number suffix from a string 743{ $_[0] =~ s/(?<=\D)(\d*)$/sprintf "%0".length($1)."d",($1||1)+1/e; 744} 745sub Ellipsize 746{ my ($string,$max)=@_; 747 return length $string>$max+3 ? substr($string,0,$max)."\x{2026}" : $string; 748} 749sub Clamp 750{ $_[0] > $_[2] ? $_[2] : $_[0] < $_[1] ? $_[1] : $_[0]; 751} 752 753sub CleanupFileName 754{ local $_=$_[0]; 755 s#[[:cntrl:]/:><*?"\\^]##g; 756 s#^[- ]+##g; 757 $_=substr $_,0,255 if length>255; 758 s/[. ]+$//g; 759 return $_; 760} 761sub CleanupDirName 762{ local $_=$_[0]; 763 if ($^O eq 'MSWin32') { s#[[:cntrl:]/:><*?"^]##g; } 764 else { s#[[:cntrl:]:><*?"\\^]##g;} 765 s#^[- ]+##g; 766 $_=substr $_,0,255 if length>255; 767 s/[. ]+$//g; 768 return $_; 769} 770 771sub uniq 772{ my %h; 773 map { $h{$_}++ == 0 ? $_ : () } @_; 774} 775 776sub sort_number_aware #sort (s1 s10 s2) into (s1 s2 s10) 777{ my %h; 778 ($h{$_} = $_) =~ s/(\d+)/"0"x(20-length($1)).$1/ge for @_; #format numbers with at least 20 digits, will fail for numbers with more than 20 digits, but probably not interesting anyway 779 return sort {$h{$a} cmp $h{$b}} @_; 780} 781 782sub superlc ##lowercase, normalize and remove accents/diacritics #not sure how good it is 783{ #test if 8th bit set for any character, if not it's pure ascii and we can just return lc 784 use bytes; # test is much faster in bytes mode 785 return lc $_[0] unless $_[0]=~m/[\x80-\xff]/; # lc in bytes mode 786 no bytes; 787 788 my $s=NFKD($_[0]); 789 $s=~s/\pM//og; #remove Marks (see perlunicode) 790 #$s=Unicode::Normalize::compose($s); #almost never change anything and should not change comparison result anyway; so better leave it out as it's rather costly 791 return lc $s; # lc NOT in bytes mode 792} 793sub superlc_sort 794{ return sort {superlc($a) cmp superlc($b)} @_; 795} 796sub sorted_keys #return keys of $hash sorted by $hash->{$_}{$sort_subkey} or by $hash->{$_} using superlc 797{ my ($hash,$sort_subkey)=@_; 798 if (defined $sort_subkey) 799 { return sort { superlc($hash->{$a}{$sort_subkey}) cmp superlc($hash->{$b}{$sort_subkey}) } keys %$hash; 800 } 801 else 802 { return sort { superlc($hash->{$a}) cmp superlc($hash->{$b}) } keys %$hash; 803 } 804} 805 806sub WordIn #return true if 1st argument is a word in contained in the 2nd argument (space-separated words) 807{ return 1 if first {$_[0] eq $_} split / +/,$_[1]; 808 return 0; 809} 810 811sub OneInCommon #true if at least one string common to both list 812{ my ($l1,$l2)=@_; 813 ($l1,$l2)=($l2,$l1) if @$l1>@$l2; 814 return 0 if @$l1==0; 815 if (@$l1==1) { my $s=$l1->[0]; return defined first {$_ eq $s} @$l2 } 816 my %h; 817 $h{$_}=undef for @$l1; 818 return 1 if defined first { exists $h{$_} } @$l2; 819 return 0; 820} 821 822sub find_common_parent_folder 823{ return unless @_; 824 my @folders= uniq(@_); 825 my $folder=$folders[0]; 826 my $nb=@folders; 827 return $folder if $nb==1; 828 $folder=~s/$QSLASH+$//o; 829 until ($nb==grep m/^\Q$folder\E(?:$QSLASH|$)/, @folders) 830 { $folder='' unless $folder=~m/$QSLASH/o; #for win32 drives 831 last unless $folder=~s/$QSLASH[^$QSLASH]+$//o; 832 } 833 $folder.=SLASH unless $folder=~m/$QSLASH/o; 834 return $folder; 835} 836 837sub ExtractNameAndOptions 838{ local $_=$_[0]; #the passed string is modified unless wantarray 839 my $prefixre=$_[1]; 840 my @res; 841 while ($_ ne '') 842 { s#^\s*##; 843 my $prefix; 844 if ($prefixre) 845 { $prefix=$1 if s/^$prefixre//; 846 } 847 m/[^(\s]*/g; #name in "name(options...)" 848 my $depth=0; 849 $depth=1 if m#\G\(#gc; 850 while ($depth) 851 { m#\G(?:[^()]*[^()\\])?([()])?#gc; #search next () 852 last unless $1; #end of string 853# next if "\\" eq substr($_,pos()-2,1);#escaped () => ignore 854 if ($1 eq '(') {$depth++} 855 else {$depth--} 856 } 857 my $str=substr $_,0,pos,''; 858 $str=~s#\\([()])#$1#g; #unescape () 859 $str=[$str,$prefix] if $prefixre; 860 $_[0]=$_ , return $str unless wantarray; 861 push @res, $str; 862 } 863 return @res; 864} 865sub ParseOptions 866{ local $_=$_[0]; #warn "$_\n"; 867 my %opt; 868 while (m#\G\s*([^= ]+)=\s*#gc) 869 { my $key=$1; 870 if (m#\G(["'])#gc) #quotted 871 { my $q= $1 ; 872 my $v; 873 if (m#\G((?:[^$q\\]|\\.)*)$q#gc) 874 { $v=$1; 875 $v=~s#\\$q#$q#g; 876 } 877 else 878 { print "Can't find end of quote in ".(substr $_,pos()-1)."\n"; 879 } 880 $opt{$key}=$v; 881 m#\G[^,]*(?:,|$)#gc; #skip the rest 882 } 883 else 884 { m#\G([^,]*?)\s*(?:,|$)#gc; 885 $opt{$key}=$1; 886 } 887 } 888 #warn " $_ => $opt{$_}\n" for sort keys %opt; warn "\n"; 889 return \%opt; 890} 891 892sub ReplaceExpr { my $expr=shift; $expr=~s#\\}#}#g; warn "FIXME : ReplaceExpr($expr)"; return ''; } #FIXME 893sub ReplaceExprUsedFields {} #FIXME 894 895our %ReplaceFields; #used in gmusicbrowser_tags for auto-fill FIXME PHASE1 896 #o => 'basefilename', maybe should be usage specific (=>only for renaming) 897 898sub UsedFields 899{ my $s=$_[0]; 900 my @f= grep defined, map $ReplaceFields{$_}, $s=~m/(%[a-zA-Z])/g; 901 push @f, $s=~m#\$([a-zA-Z]\w*)#g; 902 push @f, ReplaceExprUsedFields($_) for $s=~m#\$\{(.*?(?<!\\))}#g; 903 return Songs::Depends(@f); 904} 905sub ReplaceFields 906{ my ($ID,$string,$esc,$special)=@_; 907 $special||={}; 908 my $display= $esc ? ref $esc ? sub { $esc->(Songs::Display(@_)) } : \&Songs::DisplayEsc : \&Songs::Display; 909 $string=~s#(?:\\n|<br>)#\n#g; 910 $string=~s#([%\$]){2}|(%[a-zA-Z]|\$[a-zA-Z\$]\w*)|\$\{(.*?(?<!\\))}# 911 $1 ? $1 : 912 defined $3 ? ReplaceExpr($3) : 913 exists $special->{$2} ? do {my $s=$special->{$2}; ref $s ? $s->($ID,$2) : $s} : 914 do {my $f=$ReplaceFields{$2}; $f ? $display->($ID,$f) : $2} 915 #ge; 916 return $string; 917} 918sub ReplaceFieldsAndEsc 919{ ReplaceFields($_[0],$_[1],1); 920} 921sub ReplaceFieldsForFilename 922{ # use filename_from_unicode for everything but %o (existing filename in unknown encoding), leave %o as is 923 my $f= ReplaceFields( $_[0], filename_from_unicode($_[1]), \&Glib::filename_from_unicode, {"%o"=> sub { Songs::Get($_[0],'barefilename') }, } ); 924 CleanupFileName($f); 925} 926sub MakeReplaceTable 927{ my ($fields,%special)=@_; 928 my $table=Gtk2::Table->new (4, 2, FALSE); 929 my $row=0; my $col=0; 930 for my $letter (split //,$fields) 931 { for my $text ( '%'.$letter, $special{$letter}||Songs::FieldName($ReplaceFields{'%'.$letter}) ) 932 { my $l=Gtk2::Label->new($text); 933 $table->attach($l,$col++,$col,$row,$row+1,'fill','shrink',4,1); 934 $l->set_alignment(0,.5); 935 } 936 if ($col++>3) { $row++; $col=0; } 937 } 938 $table->set_col_spacing(2, 30); 939 my $align=Gtk2::Alignment->new(.5, .5, 0, 0); 940 $align->add($table); 941 return $align; 942} 943sub MakeReplaceText 944{ my ($fields,%special)=@_; 945 my $text=join "\n", map "%$_ : ". ($special{$_}||Songs::FieldName($ReplaceFields{'%'.$_})), split //,$fields; 946 return $text; 947} 948 949our %DATEUNITS= 950( s => [1,_"seconds"], 951 m => [60,_"minutes"], 952 h => [3600,_"hours"], 953 d => [86400,_"days"], 954 w => [604800,_"weeks"], 955 M => [2592000,_"months"], 956 y => [31536000,_"years"], 957); 958our %TIMEUNITS= ( map { $_=>$DATEUNITS{$_} } qw/s m h/); 959our %SIZEUNITS= 960( b => [1,_"bytes"], 961 k => [KB(),_"KB"], 962 m => [MB(),_"MB"], 963); 964 965sub strftime_utf8 966{ utf8::upgrade($_[0]); &strftime; 967} 968 969# english and localized, full and abbreviated, day names 970my %DAYS=( map( { ::superlc(strftime_utf8('%a',0,0,0,1,0,100,$_))=>$_, 971 ::superlc(strftime_utf8('%A',0,0,0,1,0,100,$_))=>$_ 972 } 0..6), sun=>0,mon=>1,tue=>2,wed=>3,thu=>4,fri=>5,sat=>6); 973# english and localized, full and abbreviated, month names 974my %MONTHS=( map( { ::superlc(strftime_utf8('%b',0,0,0,1,$_,100))=>$_+1, 975 ::superlc(strftime_utf8('%B',0,0,0,1,$_,100))=>$_+1 976 } 0..11), jan=>1,feb=>2,mar=>3,apr=>4,may=>5,jun=>6,jul=>7,aug=>8,sep=>9,oct=>10,nov=>11,dec=>12); 977for my $h (\%DAYS,\%MONTHS) #remove "." at the end of some localized day/month names 978{ for my $key (keys %$h) { $h->{$key}= delete $h->{"$key."} if $key=~s/\.$//; } 979} 980sub dates_to_timestamps 981{ my ($dates,$mode)=@_; #mode : 0: begin date, 1: end date, 2: range 982 if ($mode==2 && $dates!~m/\.\./ && $dates=~m/^[^-]*-[^-]*$/) { $dates=~s/-/../; } # no '..' and only one '-' => replace '-' by '..' 983 my ($date1,$range,$date2)=split /(\s*\.\.\s*)/,$dates,2; 984 if ($mode==0) { $date2=0; } 985 elsif ($mode==1) { $date2||=$date1; $date1=0; } 986 elsif ($mode==2) { $date2=$date1 unless $range; } 987 my $end=0; 988 for my $date ($date1,$date2) 989 { if (!$date) {$date='';next} 990 elsif ($date=~m/^\d{9,}$/) {next} #seconds since epoch 991 my $past_step=1; 992 my $past_var; 993 my ($y,$M,$d,$h,$m,$s,$pm); 994 { ($y,$M,$d,$h,$m,$s)= $date=~m#^(\d\d\d\d)(?:[-/.](\d\d?)(?:[-/.](\d\d?)(?:[-T ](\d\d?)(?:[:.](\d\d?)(?:[:.](\d\d?))?)?)?)?)?$# and last; # yyyy/MM/dd hh:mm:ss 995 ($h,$m,$s,$pm)= $date=~m#^(\d\d?)[:](?:(\d\d?)(?:[:](\d\d?))?)?([ap]m?)?$#i and last; #hh:mm:ss or hh:mm or hh: 996 ($d,$M,$y)= $date=~m#^(\d\d?)(?:[-/.](\d\d?)(?:[-/.](\d\d\d\d))?)?$# and last; # dd/MM or dd/MM/yyyy 997 ($M,$y)= $date=~m#^(\d\d?)[-/.](\d\d\d\d)$# and last; # MM/yyyy 998 ($y,$M,$d)= $date=~m#^(\d{4})(\d\d)(\d\d)$# and last; # yyyyMMdd 999 if ($date=~m#^(?:(\d\d?)[-/. ]?)?(\p{Alpha}+)(?:[-/. ]?(\d\d(?:\d\d)?))?$# && (my $month=$MONTHS{::superlc($2)})) # jan or jan99 or 10jan or 10jan12 or jan2012 1000 { ($d,$M,$y)=($1,$month,$3); 1001 last; 1002 } 1003 if (defined(my $wday=$DAYS{::superlc$date})) #name of week day 1004 { my ($now_day,$now_wday)= (localtime)[3,6]; 1005 $d= $now_day - $now_wday + $wday; 1006 $past_step=7; $past_var=3; #remove 7days if in future 1007 last; 1008 } 1009 $date=''; 1010 } 1011 next unless $date; 1012 if (defined $y) 1013 { $y= $y>100 ? $y-=1900 : $y<70 ? $y+100 : $y; #>100 => 4digits year, <70 : 2digits 20xx year, else 2digits 19xx year 1014 } 1015 $M-- if defined $M; 1016 $h+=( $pm=~m/^pm?$/ ? $h!=12 ? 12 : 0 : $h==12 ? -12 : 0 ) if defined $pm && defined $h; 1017 my @now= (localtime)[0..5]; 1018 for ($y,$M,$d,$h,$m,$s) #complete relative dates with current date 1019 { last if defined; 1020 $_= pop @now; 1021 } 1022 $past_var= scalar @now unless defined $past_var; #unit to change if in the future 1023 if ($end) #if end date increment the smallest defined unit (to get the end of day/month/year/hour/min + 1 sec) 1024 { for ($s,$m,$h,$d,$M,$y) 1025 { if (defined) { $_++; last; } 1026 } 1027 } 1028 my @date= ($s||0,$m||0,$h||0,$d||1,$M||0,$y); 1029 $date= ::mktime(@date); 1030 if ($past_var<6 && $date>time) #for relative dates, choose between previous and next match (for example, this year's july or previous year's july) 1031 { $date[$past_var]-= $past_step; 1032 my $date_past= ::mktime(@date); 1033 #use date in the past unless it's an end date and makes more sense relative to the first date 1034 $date= $date_past unless $end && $date1 && $date>$date1 && $date_past<=$date1; 1035 } 1036 $date-- if $end; 1037 } 1038 continue {$end=1} 1039 return $mode==0 ? $date1 : $mode==1 ? $date2 : ($date1,$date2); 1040} 1041 1042sub ConvertTimeLength # convert date/time pattern into nb of seconds 1043{ my ($number,$unit)= $_[0]=~m/^\s*(\d*\.?\d+)\s*([a-zA-Z]*)\s*$/; 1044 return 0 unless $number; 1045 if (my $ref= $DATEUNITS{$unit}) { $number*= $ref->[0] } 1046 elsif ($unit) { warn "ignoring unknown unit '$unit'\n" } 1047 return $number; 1048} 1049sub ConvertTime # convert date pattern into nb of seconds since epoch 1050{ return time - &ConvertTimeLength; 1051} 1052sub ConvertSize 1053{ my ($size,$unit)= $_[0]=~m/^\s*(\d*\.?\d+)\s*([a-zA-Z]*)\s*$/; 1054 return 0 unless $size; 1055 if (my $ref= $SIZEUNITS{lc$unit}) { $size*= $ref->[0] } 1056 elsif ($unit) { warn "ignoring unknown unit '$unit'\n" } 1057 return $size; 1058} 1059 1060#--------------------------------------------------------------- 1061our $DAYNB=int(time/86400)-12417;#number of days since 01 jan 2004 1062 1063our ($Library,$PlaySource);#,@Radio); 1064our (%GlobalBoundKeys,%CustomBoundKeys); 1065 1066our ($SelectedFilter,$PlayFilter); our (%Filters,%FilterWatchers,%Related_FilterWatchers); our %SelID; 1067#our %SavedFilters;our (%SavedSorts,%SavedWRandoms);our %SavedLists; 1068my $SavedListsWatcher; 1069our $ListPlay; 1070our ($TogPlay,$TogLock); 1071our ($RandomMode,$SortFields,$ListMode); 1072our ($SongID,$prevID,$Recent,$RecentPos,$Queue); our $QueueAction=our $NextAction=''; 1073our ($Position,$ChangedID,$ChangedPos,@NextSongs,$NextFileToPlay); 1074our ($MainWindow,$FullscreenWindow); my $OptionsDialog; 1075my $TrayIcon; 1076my %Editing; #used to keep track of opened song properties dialog and lyrics dialog 1077our $PlayTime; 1078our ($StartTime,$StartedAt,$PlayingID, @Played_segments); 1079our $CurrentDir=$ENV{PWD}; 1080$ENV{'PULSE_PROP_media.role'}='music'; # role hint for pulseaudio 1081$ENV{'PULSE_PROP_application.icon_name'}='gmusicbrowser'; # icon hint for pulseaudio, could also use Gtk2::Window->set_default_icon_name 1082 1083our (%ToDo,%TimeOut); 1084my %EventWatchers;#for Save Vol Time Queue Lock Repeat Sort Filter Pos CurSong Playing SavedWRandoms SavedSorts SavedFilters SavedLists Icons Widgets connections 1085# also used for SearchText_ SelectedID_ followed by group id 1086# Picture_#mainfield# 1087 1088my (%Watched,%WatchedFilt); 1089my ($IdleLoop,@ToAdd_Files,@ToAdd_IDsBuffer,@ToScan,%FollowedDirs,%AutoPicChooser); 1090our %Progress; my $ProgressWindowComing; 1091my $ToCheck=GMB::JobIDQueue->new(title => _"Checking songs",); 1092my $ToReRead=GMB::JobIDQueue->new(title => _"Re-reading tags",); 1093my $ToCheckLength=GMB::JobIDQueue->new(title => _"Checking length/bitrate",details => _"for files without a VBR header",); 1094my ($CheckProgress_cb,$ScanProgress_cb,$ProgressNBSongs,$ProgressNBFolders); 1095my %Plugins; 1096my $ScanRegex; 1097 1098my %Encoding_pref; 1099$Encoding_pref{$_}=-2 for qw/null AdobeZdingbat ascii-ctrl dingbats MacDingbats/; #don't use these 1100$Encoding_pref{$_}=-1 for qw/UTF-32BE UTF-32LE/; #these can generate lots of warnings, skip them when trying encodings 1101$Encoding_pref{$_}=2 for qw/utf8 cp1252 iso-8859-15/; #use these first when trying encodings 1102 1103#Default values 1104our %Options= 1105( Layout => 'Lists, Library & Context', 1106 LayoutT => 'full with buttons', 1107 LayoutB => 'Browser', 1108 LayoutF => 'default fullscreen', 1109 LayoutS => 'Search', 1110 IconTheme => '', 1111 MaxAutoFill => 5, 1112 Repeat => 1, 1113 Sort => 'shuffle', #default sort order 1114 Sort_LastOrdered=> 'path file', 1115 Sort_LastSR => 'shuffle', 1116 Sessions => '', 1117 StartCheck => 0, #check if songs have changed on startup 1118 StartScan => 0, #scan @LibraryPath on startup for new songs 1119 FilenameSchema => ['%a - %l - %n - %t','%l - %n - %t','%n-%t','%d%n-%t'], 1120 FolderSchema => ['%A/%l','%A','%A/%Y-%l','%A - %l'], 1121 PlayedMinPercent=> 80, # Threshold to count a song as played in percent 1122 PlayedMinSeconds=> 600, # Threshold to count a song as played in seconds 1123 DefaultRating => 50, 1124# Device => 'default', 1125# amixerSMC => 'PCM', 1126# gst_sink => 'alsa', 1127 use_equalizer => 0, 1128 equalizer => '0:0:0:0:0:0:0:0:0:0', 1129 equalizer_presets => #taken from gstreamer equalizer plugin 1130 { ballad => '4:3.75:2.5:0:-4:-6:-3:0:2.5:9', 1131 classic => '0:0:0:0:0:0:-6:-7:-7:-9.5', 1132 club => '0:0:8:6:5.5:5:3:0:0:0', 1133 dance => '9.6:7:2.5:0:0:-5.6:-7:-7:0:0', 1134 party => '7:7:0:0:0:0:0:0:7:7', 1135 pop => '-1.6:4.5:7:8:5.6:0:-2.5:-2:-1.6:-1.5', 1136 reggae => '0:0:0:-5.5:0:6.5:6.5:0:0:0', 1137 rock => '8:5:-5.5:-8:-3:4:8:11:11:11.5', 1138 ska => '-2.5:-5:-4:0:4:5.5:8:9:11:9', 1139 soft => '5:1.5:0:-2.5:0:4:8:9:11:12', 1140 techno => '8:5.5:0:-5.5:-5:0:8:10:10:9', 1141 "more bass" => '-8:10:10:5.5:1.5:-4:-8:-10:-11:-11', 1142 "more treble" => '-10:-10:-10:-4:2.5:11:12:12:12:12', 1143 "more bass and treble" => '8:5.5:0:-7:-5:1.5:8:11.2:12:12', 1144 }, 1145 equalizer_preamp=> 1, 1146 use_replaygain => 1, 1147 rg_limiter => 1, 1148 rg_preamp => 0, 1149 rg_fallback => 0, 1150 gst_rg_songmenu => 0, 1151 gst_sync_EQpresets=>1, 1152 use_GST_for_server=>1, 1153 Icecast_port => '8000', 1154 UseTray => 1, 1155 CloseToTray => 0, 1156 ShowTipOnSongChange => 0, 1157 TrayTipTimeLength => 3000, #in ms 1158 TAG_use_latin1_if_possible => 1, 1159 TAG_no_desync => 1, 1160 TAG_keep_id3v2_ver => 0, 1161 'TAG_write_id3v2.4' => 0, 1162 TAG_id3v1_encoding => 'iso-8859-1', 1163 AutoRemoveCurrentSong => 0, 1164 LengthCheckMode => 'add', 1165 CustomKeyBindings => {}, 1166 VolumeStep => 10, 1167 DateFormat_history => ['%c 604800 %A %X 86400 Today %X 60 now'], 1168 AlwaysInPlaylist => 1, 1169 PixCacheSize => 60, # in MB 1170 1171 SavedSTGroupings=> 1172 { _"None" => '', 1173 _"Artist & album" => 'artist|simple|album|pic', 1174 _"Album with picture" => 'album|pic', 1175 _"Album" => 'album|simple', 1176 _"Folder" => 'folder|artistalbum', 1177 }, 1178 SavedWRandoms=> 1179 { _"by rating" => 'random:1r0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1', 1180 _"by play count"=> 'random:-1n5', 1181 _"by lastplay" => 'random:1l10', 1182 _"by added" => 'random:-1a50', 1183 _"by lastplay & play count" => 'random:1l10'."\x1D".'-1n5', 1184 _"by lastplay & bootleg" => 'random:1l10'."\x1D".'-.5fbootleg', 1185 }, 1186 SavedSorts=> 1187 { _"Path,File" => 'path file', 1188 _"Date" => 'year', 1189 _"Title" => 'title', 1190 _"Last played" => 'lastplay', 1191 _"Artist,Album,Disc,Track" => 'artist album disc track', 1192 _"Artist,Date,Album,Disc,Track" => 'artist year album disc track', 1193 _"Path,Album,Disc,Track,File" => 'path album disc track file', 1194 _"Shuffled albums" => 'album_shuffle disc track file', 1195 _"Shuffled albums, shuffled tracks" => 'album_shuffle shuffle', 1196 }, 1197); 1198 1199our $GlobalKeyBindings='Insert OpenSearch c-q Quit a-q EnqueueSelected p PlayPause c OpenContext q OpenQueue ca-f ToggleFullscreenLayout F11 ToggleFullscreen'; 1200%GlobalBoundKeys=%{ make_keybindingshash($GlobalKeyBindings) }; 1201 1202 1203sub make_keybindingshash 1204{ my $keybindings=$_[0]; 1205 my @list= ref $keybindings ? %$keybindings : ExtractNameAndOptions($keybindings); 1206 my %h; 1207 while (@list>1) 1208 { my $key=shift @list; 1209 my $cmd=shift @list; 1210 my $priority= $key=~s/^\+//; 1211 my $mod= $key=~s/^([caws]+-)// ? $1 : ''; 1212 $key= lc $key; 1213 $h{$mod.$key}=$cmd; 1214 $h{'+'.$mod.$key}=$cmd if $priority; 1215 } 1216 return \%h; 1217} 1218sub keybinding_longname 1219{ my $key=$_[0]; 1220 return $key unless $key=~s/^([caws]+)-//; 1221 my $mod=$1; 1222 my %h=( c => _p('Keyboard',"Ctrl"), #TRANSLATION: Ctrl key 1223 a => _p('Keyboard',"Alt"), #TRANSLATION: Alt key 1224 w => _p('Keyboard',"Win"), #TRANSLATION: Windows key 1225 s => _p('Keyboard',"Shift"), #TRANSLATION: Shift key 1226 ); 1227 my $name=join '',map $h{$_}, split //,$mod; 1228 return $name.'-'.$key; 1229} 1230 1231our ($NBVolIcons,$NBQueueIcons); our %TrayIcon; 1232my $icon_factory; 1233 1234my %IconsFallbacks= 1235( 'gmb-queue0' => 'gmb-queue', 1236 'gmb-queue-window' => 'gmb-queue', 1237 'gmb-random-album' => 'gmb-random', 1238 'gmb-view-fullscreen'=>'gtk-fullscreen', 1239); 1240 1241sub Find_all_stars #returns a hash used in the combobox of the starprefix option 1242{ my @dirs= ($HomeDir.'icons', PIXPATH); 1243 my %stars=(''=>_"Default"); 1244 for my $dir (@dirs) 1245 { $dir.=SLASH; 1246 opendir my($dh),$dir or next; 1247 my @themes= ('.', grep -d $dir.$_, grep !m/^\./, readdir $dh); 1248 closedir $dh; 1249 for my $theme (@themes) 1250 { opendir my($dh),$dir.$theme or next; 1251 for my $file (grep !m/^\./, readdir $dh) 1252 { next unless $file=~m/^(stars(?:-\w+?[a-z])?)0\.(?:png|svg)$/i; 1253 my $prefix= "$theme/$1"; 1254 my $name= $theme eq '.' ? $1 : $prefix; 1255 $stars{$prefix}=$name; 1256 } 1257 closedir $dh; 1258 } 1259 } 1260 return \%stars; 1261} 1262sub Find_star_pictures 1263{ my $prefix= $_[0] || 'stars'; 1264 unless (file_name_is_absolute($prefix)) 1265 { my @dirs= ($HomeDir.'icons'.SLASH, PIXPATH); 1266 if ($prefix!~m/$QSLASH/o) # only look into theme subdir if $prefix doesn't contain a slash 1267 { unshift @dirs, grep defined, first { -d $_ } map $_.$Options{IconTheme}.SLASH, @dirs; 1268 } 1269 for my $path (@dirs) 1270 { next unless -f $path.$prefix.'0.svg' || -f $path.$prefix.'0.png'; #FIXME extension shouldn't be case-sensitive 1271 $prefix= $path.$prefix; 1272 last; 1273 } 1274 } 1275 my $suffix= (-f $prefix.'0.svg') ? '.svg' : '.png'; #FIXME extension shouldn't be case-sensitive 1276 my @files; 1277 push @files, $prefix.@files.$suffix while -f $prefix.@files.$suffix; 1278 return @files; 1279} 1280 1281sub LoadIcons 1282{ my %icons; 1283 unless (Gtk2::Stock->lookup('gtk-fullscreen')) #for gtk version 2.6 1284 { $icons{'gtk-fullscreen'}=PIXPATH.'fullscreen.png'; 1285 } 1286 1287 #load default icons 1288 opendir my$dh,PIXPATH; 1289 for my $file (grep m/^(?:gmb|plugin)-.*\.(?:png|svg)$/ && -f PIXPATH.$_, readdir $dh) 1290 { my $name=$file; 1291 $name=~s/\.[^.]+$//; 1292 $icons{$name}=PIXPATH.$file; 1293 } 1294 closedir $dh; 1295 1296 #load plugins icons 1297 if (-d (my $dir=$HomeDir.'plugins')) 1298 { opendir my($dh),$dir; 1299 for my $file (grep m/\.(?:png|svg)$/ && -f $dir.SLASH.$_, readdir $dh) 1300 { my $name='plugin-'.$file; 1301 $name=~s/\.[^.]+$//; 1302 $icons{$name}= $dir.SLASH.$file; 1303 } 1304 closedir $dh; 1305 } 1306 1307 my @dirs=($HomeDir.'icons'); 1308 if (my $theme=$Options{IconTheme}) 1309 { my $dir= $HomeDir.'icons'.SLASH.$theme; 1310 $dir=PIXPATH.$theme unless -d $dir; 1311 unshift @dirs,$dir; 1312 } 1313 #load theme icons and customs icons 1314 for my $dir (@dirs) 1315 { next unless -d $dir; 1316 opendir my($dh),$dir; 1317 for my $file (grep m/\.(?:png|svg)$/ && -f $dir.SLASH.$_, readdir $dh) 1318 { my $name=$file; 1319 $name=~s/\.[^.]+$//; 1320 $name=Encode::decode('utf8',::decode_url($name)); 1321 $icons{$name}= $dir.SLASH.$file; 1322 } 1323 closedir $dh; 1324 } 1325 1326 $icons{gmusicbrowser}||= PIXPATH.'gmusicbrowser.svg' unless Gtk2::IconTheme->get_default->get_icon_sizes('gmusicbrowser'); #fallback if no icon named 'gmusicbrowser' is installed 1327 if (my $file=delete $icons{gmusicbrowser}) 1328 { eval { Gtk2::Window->set_default_icon_from_file($file); }; 1329 warn $@ if $@; 1330 } 1331 else { Gtk2::Window->set_default_icon_name('gmusicbrowser'); } 1332 1333 #trayicons 1334 { %TrayIcon=(); 1335 my $prefix= $TrayIcon{'default'}= $icons{trayicon} || PIXPATH.'trayicon.png'; 1336 $prefix=~s/\.[^.]+$//; 1337 for my $key (qw/play pause/) 1338 { ($TrayIcon{$key})= grep -r $_, map "$prefix-$key.$_",qw/png svg/; 1339 } 1340 UpdateTrayIcon(1); 1341 } 1342 1343 $NBVolIcons=0; 1344 $NBVolIcons++ while $icons{'gmb-vol'.$NBVolIcons}; 1345 $NBQueueIcons=0; 1346 $NBQueueIcons++ while $icons{'gmb-queue'.($NBQueueIcons+1)}; 1347 1348 # find rating pictures 1349 for my $field (Songs::FieldList(type=>'rating')) 1350 { my $prefix= $Songs::Def{$field}{starprefix}; 1351 my @stars= Find_star_pictures($prefix); 1352 @stars= Find_star_pictures('stars') unless @stars; 1353 $Songs::Def{$field}{pixbuf}= [ map GMB::Picture::pixbuf($_), @stars ]; 1354 $Songs::Def{$field}{nbpictures}= @stars; 1355 } 1356 1357 $icon_factory->remove_default if $icon_factory; 1358 $icon_factory=Gtk2::IconFactory->new; 1359 $icon_factory->add_default; 1360 for my $stock_id (keys %icons,keys %IconsFallbacks) 1361 { next if $stock_id=~m/^trayicon/; 1362 my %h= ( stock_id => $stock_id ); 1363 #label => $$ref[1], 1364 #modifier => [], 1365 #keyval => $Gtk2::Gdk::Keysyms{L}, 1366 #translation_domain => 'gtk2-perl-example', 1367 if (exists $StockLabel{$stock_id}) { $h{label}=$StockLabel{$stock_id}; } 1368 Gtk2::Stock->add(\%h) unless Gtk2::Stock->lookup($stock_id); 1369 1370 my $icon_set; 1371 if (my $file=$icons{$stock_id}) 1372 { $icon_set= eval {Gtk2::IconSet->new_from_pixbuf( Gtk2::Gdk::Pixbuf->new_from_file($file) )}; 1373 warn $@ if $@; 1374 } 1375 elsif (my $fallback=$IconsFallbacks{$stock_id}) 1376 { $icon_set= $icon_factory->lookup($fallback) || Gtk2::IconFactory->lookup_default($fallback); 1377 } 1378 next unless $icon_set; 1379 $icon_factory->add($stock_id,$icon_set); 1380 } 1381 $_->queue_draw for Gtk2::Window->list_toplevels; 1382 HasChanged('Icons'); 1383} 1384sub GetIconThemesList 1385{ my %themes; 1386 $themes{''}=_"default"; 1387 for my $dir (PIXPATH,$HomeDir.'icons'.SLASH) 1388 { next unless -d $dir; 1389 opendir my($dh),$dir; 1390 $themes{$_}=$_ for grep !m/^\./ && -d $dir.$_, readdir $dh; 1391 closedir $dh; 1392 } 1393 return \%themes; 1394} 1395 1396########## 1397 1398our %Command= #contains sub,description,argument_tip, argument_regex or code returning a widget, or '0' to hide it from the GUI edit dialog 1399( NextSongInPlaylist=> [\&NextSongInPlaylist, _"Next Song In Playlist"], 1400 PrevSongInPlaylist=> [\&PrevSongInPlaylist, _"Previous Song In Playlist"], 1401 NextAlbum => [sub {NextDiff('album')}, _"Next Album",], 1402 NextArtist => [sub {NextDiff('first_artist')}, _"Next Artist",], 1403 NextSong => [\&NextSong, _"Next Song"], 1404 PrevSong => [\&PrevSong, _"Previous Song"], 1405 PlayPause => [\&PlayPause, _"Play/Pause"], 1406 Forward => [\&Forward, _"Forward",_"Number of seconds",qr/^\d+$/], 1407 Rewind => [\&Rewind, _"Rewind",_"Number of seconds",qr/^\d+$/], 1408 Seek => [sub {SkipTo($_[1])}, _"Seek",_"Number of seconds",qr/^-?\d+$/], 1409 Stop => [\&Stop, _"Stop"], 1410 Pause => [sub {Pause() if $TogPlay; }, _"Pause"], 1411 Play => [sub {PlayPause() unless $TogPlay; },_"Play"], 1412 Browser => [\&OpenBrowser, _"Open Browser"], 1413 OpenQueue => [\&EditQueue, _"Open Queue window"], 1414 OpenSearch => [sub { Layout::Window->new($Options{LayoutS}, uniqueid=>'Search'); }, _"Open Search window"], 1415 OpenContext => [\&ContextWindow, _"Open Context window"], 1416 OpenCustom => [sub { Layout::Window->new($_[1]); }, _"Open Custom window",_"Name of layout", sub { TextCombo::Tree->new( Layout::get_layout_list() ); }], 1417 PopupCustom => [sub { PopupLayout($_[1],$_[0]); }, _"Popup Custom window",_"Name of layout", sub { TextCombo::Tree->new( Layout::get_layout_list() ); }], 1418 CloseWindow => [sub { $_[0]->get_toplevel->close_window if $_[0];}, _"Close Window"], 1419 SetPlayerLayout => [sub { SetOption(Layout=>$_[1]); CreateMainWindow(); },_"Set player window layout",_"Name of layout", sub { TextCombo::Tree->new( Layout::get_layout_list('G') ); }, ], 1420 OpenPref => [sub{ PrefDialog($_[1]); }, _"Open Preference window"], 1421 OpenSongProp => [sub { DialogSongProp($SongID) if defined $SongID }, _"Edit Current Song Properties"], 1422 EditSelectedSongsProperties => [sub { my $songlist=GetSonglist($_[0]) or return; my @IDs=$songlist->GetSelectedIDs; DialogSongsProp(@IDs) if @IDs; }, _"Edit selected song properties"], 1423 ShowHide => [sub {ShowHide();}, _"Show/Hide"], 1424 Show => [sub {ShowHide(1);}, _"Show"], 1425 Hide => [sub {ShowHide(0);}, _"Hide"], 1426 Quit => [\&Quit, _"Quit"], 1427 Save => [sub {SaveTags(1)}, _"Save Tags/Options"], 1428 ChangeDisplay => [\&ChangeDisplay, _"Change Display",_"Display (:1 or host:0 for example)",qr/:\d/], 1429 GoToCurrentSong => [\&Layout::GoToCurrentSong, _"Select current song"], 1430 DeleteSelected => [sub { my $songlist=GetSonglist($_[0]) or return; my @IDs=$songlist->GetSelectedIDs; DeleteFiles(\@IDs); }, _"Delete Selected Songs"], 1431 QueueInsertSelected=>[sub { my $songlist=GetSonglist($_[0]) or return; my @IDs=$songlist->GetSelectedIDs; QueueInsert(@IDs); }, _"Insert Selected Songs at the top of the queue"], 1432 EnqueueSelected => [\&Layout::EnqueueSelected, _"Enqueue Selected Songs"], 1433 EnqueueArtist => [sub {EnqueueSame('artist',$SongID)},_"Enqueue Songs from Current Artist"], # or use field 'artists' or 'first_artist' ? 1434 EnqueueAlbum => [sub {EnqueueSame('album',$SongID)}, _"Enqueue Songs from Current Album"], 1435 EnqueueAction => [sub {EnqueueAction($_[1])}, _"Enqueue Action", _"Queue mode" ,sub { TextCombo->new({map {$_ => $QActions{$_}{short}} sort keys %QActions}) }], 1436 SetNextAction => [sub {SetNextAction($_[1])}, _"Set action when song ends", _"Action" ,sub { TextCombo->new({map {$_ => $QActions{$_}{short}} sort grep $QActions{$_}{can_next}, keys %QActions}) }], 1437 ClearQueue => [\&::ClearQueue, _"Clear queue"], 1438 ClearPlaylist => [sub {Select(staticlist=>[])}, _"Clear playlist"], 1439 IncVolume => [sub {ChangeVol('up')}, _"Increase Volume"], 1440 DecVolume => [sub {ChangeVol('down')}, _"Decrease Volume"], 1441 TogMute => [sub {ChangeVol('mute')}, _"Mute/Unmute"], 1442 RunSysCmd => [sub {call_run_system_cmd($_[0],$_[1],0,0)}, 1443 _"Run system command",_("System command")."\n"._("Some variables such as %f (current song filename) are available"),qr/./], 1444 RunShellCmd => [sub {call_run_system_cmd($_[0],$_[1],0,1)}, 1445 _"Run shell command",_("Shell command")."\n"._("Some variables such as %f (current song filename) are available"),qr/./], 1446 RunSysCmdOnSelected => [sub {call_run_system_cmd($_[0],$_[1],1,0)}, 1447 _"Run system command on selected songs",_("System command")."\n"._("Some variables such as %f (current song filename) are available")."\n"._('One command is used per selected songs, unless $files is used, which is replaced by the list of selected files'),qr/./], 1448 RunShellCmdOnSelected => [sub {call_run_system_cmd($_[0],$_[1],1,1)}, 1449 _"Run shell command on selected songs",_("Shell command")."\n"._("Some variables such as %f (current song filename) are available")."\n"._('One command is used per selected songs, unless $files is used, which is replaced by the list of selected files'),qr/./], 1450 RunPerlCode => [sub {eval $_[1]}, _"Run perl code",_"perl code",qr/./], 1451 TogArtistLock => [sub {ToggleLock('first_artist')}, _"Toggle Artist Lock"], 1452 TogAlbumLock => [sub {ToggleLock('album')}, _"Toggle Album Lock"], 1453 TogSongLock => [sub {ToggleLock('fullfilename')}, _"Toggle Song Lock"], 1454 ToggleRandom => [\&ToggleSort, _"Toggle between Random/Shuffle and Ordered"], 1455 Shuffle => [\&Shuffle, _"Shuffle or re-shuffle the playlist"], 1456 SetSongRating => [sub 1457 { return unless defined $SongID && $_[1]=~m/^([-+])?(\d*)$/; 1458 my $r=$2; 1459 if ($1) 1460 { my $step= $r||10; 1461 $step*=-1 if $1 eq '-'; 1462 $r= Songs::Get($SongID, 'ratingnumber') + $step; 1463 } 1464 Songs::Set($SongID, rating=> $r); 1465 }, _"Set Current Song Rating", _("Rating between 0 and 100, or empty for default")."\n"._("Can be relative by using + or -"), qr/^[-+]?\d*$/], 1466 ToggleFullscreen=> [\&Layout::ToggleFullscreen, _"Toggle fullscreen mode"], 1467 ToggleFullscreenLayout=> [\&ToggleFullscreenLayout, _"Toggle the fullscreen layout"], 1468 OpenFiles => [\&OpenFiles, _"Play a list of files", _"url-encoded list of files",0], 1469 AddFilesToPlaylist=> [sub { DoActionForList('addplay',Uris_to_IDs($_[1])); }, _"Add a list of files/folders to the playlist", _"url-encoded list of files/folders",0], 1470 InsertFilesInPlaylist=> [sub { DoActionForList('insertplay',Uris_to_IDs($_[1])); }, _"Insert a list of files/folders at the start of the playlist", _"url-encoded list of files/folders",0], 1471 EnqueueFiles => [sub { DoActionForList('queue',Uris_to_IDs($_[1])); }, _"Enqueue a list of files/folders", _"url-encoded list of files/folders",0], 1472 AddToLibrary => [sub { AddPath(1,split / /,$_[1]); }, _"Add files/folders to library", _"url-encoded list of files/folders",0], 1473 SetFocusOn => [sub { my ($w,$name)=@_;return unless $w; $w=get_layout_widget($w);$w->SetFocusOn($name) if $w;},_"Set focus on a layout widget", _"Widget name",0], 1474 ShowHideWidget => [sub { my ($w,$name)=@_;return unless $w; $w=get_layout_widget($w);$w->ShowHide(split / +/,$name,2) if $w;},_"Show/Hide layout widget(s)", _"|-separated list of widget names",0], 1475 PopupTrayTip => [sub {ShowTraytip($_[1])}, _"Popup Traytip",_"Number of milliseconds",qr/^\d*$/ ], 1476 SetSongLabel => [sub{ Songs::Set($SongID,'+label' => $_[1]); }, _"Add a label to the current song", _"Label",qr/./], 1477 UnsetSongLabel => [sub{ Songs::Set($SongID,'-label' => $_[1]); }, _"Remove a label from the current song", _"Label",qr/./], 1478 ToggleSongLabel => [sub{ Songs::Set($SongID,'^label' => $_[1]); }, _"Toggle a label of the current song", _"Label",qr/./], 1479 PlayListed => [sub{ my $songlist=GetSonglist($_[0]) or return; Select(song => 'first', play => 1, staticlist => $songlist->{array} ); }, _"Play listed songs"], 1480 ClearPlayFilter => [sub {Select(filter => '') if defined $ListMode || !$SelectedFilter->is_empty;}, _"Clear playlist filter"], 1481 MenuPlayFilter => [sub { Layout::FilterMenu(); }, _"Popup playlist filter menu"], 1482 MenuPlayOrder => [sub { Layout::SortMenu(); }, _"Popup playlist order menu"], 1483 MenuQueue => [sub { PopupContextMenu(\@Layout::MenuQueue,{ID=>$SongID, usemenupos=>1}); }, _"Popup queue menu"], 1484 ReloadLayouts => [ \&Layout::InitLayouts, _"Re-load layouts", ], 1485 ChooseSongFromAlbum=> [sub {my $ID= $_[0] ? GetSelID($_[0]) : $::SongID; ChooseSongsFromA( Songs::Get_gid($ID,'album'),nocover=>1 ); }, ], 1486 SetEqualizer => [sub { SetEqualizer(smart=>$_[1]) }, _"Set equalizer", _"pre-set name or 10 numbers between 12 and -12 (-24 for gstreamer) separated by ':', or 0 (for off), or 1 (for on)"], 1487); 1488 1489sub run_command 1490{ my ($self,$cmd)=@_; #self must be a widget or undef 1491 $cmd="$1($2)" if $cmd=~m/^(\w+) (.*)/; 1492 ($cmd, my$arg)= $cmd=~m/^(\w+)(?:\((.*)\))?$/; 1493 warn "executing $cmd($arg) (with self=$self)" if $::debug; 1494 if (my $ref=$Command{$cmd}) { $ref->[0]->($self,$arg); } 1495 else { warn "Unknown command '$cmd' => can't execute '$cmd($arg)'\n" } 1496} 1497 1498sub split_with_quotes 1499{ local $_=shift; 1500 s#\\(.)#$1 eq '"' ? "\\34" : $1 eq "'" ? "\\39" : $1 eq ' ' ? "\\32" : "\\92".$1#ge; 1501 my @w= m/([^"'\s]+|"[^"]+"|'[^']+')/g; 1502 for (@w) #remove quotes and put back unused backslashes 1503 { if (s/^"//) {s/"$//; s#\\39#\\92'#g; s#\\32#\\92 #g;} 1504 elsif (s/^'//) {s/'$//; s#\\34#\\92"#g; s#\\32#\\92 #g;} 1505 } 1506 s#\\(\d\d)#chr $1#ge for @w; 1507 return @w; 1508} 1509 1510sub call_run_system_cmd 1511{ my ($widget,$cmd,$use_selected,$use_shell)=@_; 1512 my @IDs; 1513 if ($use_selected || $cmd=~s#%F\b#\$files#) 1514 { if ($widget and my $songlist=GetSonglist($widget)) { @IDs= $songlist->GetSelectedIDs; } 1515 unless (@IDs) { warn "Not executing '$cmd' because no song is selected in the current window\n"; return } 1516 } 1517 else { @IDs=($SongID) if defined $SongID; } 1518 run_system_cmd($cmd,\@IDs,$use_shell); 1519} 1520sub run_system_cmd 1521{ my ($cmd,$IDs,$use_shell)=@_; 1522 return unless $cmd=~m/\S/; #check if command is empty 1523 my $quotesub= sub { my $s=$_[0]; $s=Encode::encode("utf8",$s) if utf8::is_utf8($s); $use_shell ? quotemeta($s) : $s; }; 1524 my $join= $use_shell ? ' ' : "\x00"; 1525 if (!ref $cmd && !$use_shell) { $cmd=[split_with_quotes($cmd)] } 1526 if (ref $cmd) { ($cmd,my @args)=@$cmd; $cmd=Encode::encode("utf8",$cmd); @args= map $quotesub->($_), @args; $cmd=join $join,$cmd,@args; } 1527 else { $cmd= Encode::encode("utf8",$cmd); } 1528 my (@cmds,$files); 1529 if ($IDs) 1530 { if ($cmd=~m/\$files\b/) { $files= join $join,map $quotesub->(Songs::GetFullFilename($_)),@$IDs; } 1531 if (@$IDs>1 && !$files) { @cmds= map ReplaceFields($_,$cmd,$quotesub), @$IDs; } 1532 else { @cmds=( ReplaceFields($IDs->[0],$cmd,$quotesub, {'$files'=>$files}) ); } 1533 } 1534 else { @cmds=($cmd) } 1535 if ($use_shell) { my $shell= $ENV{SHELL} || 'sh'; @cmds= map [$shell,'-c',$_], @cmds; } 1536 else { @cmds= map [split /\x00/,$_], @cmds; } 1537 forksystem(@cmds); 1538} 1539 1540sub forksystem 1541{ use POSIX ':sys_wait_h'; #for WNOHANG in waitpid 1542 my @cmd=@_; #can be (cmd,arg1,arg2,...) or ([cmd1,arg1,arg2,...],[cmd2,$arg1,arg2,...]) 1543 if (ref $cmd[0] && @cmd==1) { @cmd=@{$cmd[0]}; } #simplify if only 1 command 1544 my $ChildPID=fork; 1545 if (!defined $ChildPID) { warn ::ErrorMessage("forksystem : fork failed : $!"); } 1546 if ($ChildPID==0) #child 1547 { if (ref $cmd[0]) 1548 { system @$_ for @cmd; #execute multiple commands, one at a time, from the child process 1549 } 1550 else { exec @cmd; } #execute one command in the child process 1551 POSIX::_exit(0); 1552 } 1553 while (waitpid(-1, WNOHANG)>0) {} #reap dead children 1554} 1555 1556 1557if ($CmdLine{cmdlist}) 1558{ print "Available commands (for fifo or layouts) :\n"; 1559 my ($max)= sort {$b<=>$a} map length, keys %Command; 1560 for my $cmd (sort keys %Command) 1561 { my $short= $Command{$cmd}[1]; 1562 next unless defined $short; 1563 my $tip= $Command{$cmd}[2] || ''; 1564 if ($tip) { $tip=~s/\n.*//s; $tip=" (argument : $tip)"; } 1565 printf "%-${max}s : %s %s\n", $cmd, $short, $tip; 1566 } 1567 exit; 1568} 1569my $fifofh; 1570if ($FIFOFile) 1571{ if (-e $FIFOFile) { unlink $FIFOFile unless -p $FIFOFile; } 1572 else 1573 { #system('mknod',$FIFOFile,'p'); #can't use mknod to create fifo on freeBSD 1574 system 'mkfifo',$FIFOFile; 1575 } 1576 if (-p $FIFOFile) 1577 { sysopen $fifofh,$FIFOFile, O_NONBLOCK; 1578 #sysopen $fifofh,$FIFOFile, O_NONBLOCK | O_RDWR; 1579 Glib::IO->add_watch(fileno($fifofh),['in','hup'], \&CmdFromFIFO); 1580 } 1581} 1582 1583Glib::set_application_name(PROGRAM_NAME); 1584Gtk2::AboutDialog->set_url_hook(sub {openurl($_[1])}); 1585 1586Edittag_mode(@ARGV) if $CmdLine{tagedit}; 1587 1588#make this a plugin ? don't know if it's possible, it may need to run early 1589my $gnomeclient; 1590if ($CmdLine{UseGnomeSession}) 1591{ eval # use the gnome libraries, if present, to enable some session management 1592 { require Gnome2; 1593 #my $application=Gnome2::Program->init(PROGRAM_NAME, VERSION, 'libgnomeui'); 1594 my $application=Gnome2::Program->init(PROGRAM_NAME, VERSION); 1595 $gnomeclient=Gnome2::Client->master(); 1596 $gnomeclient->signal_connect('die' => sub { Gtk2->main_quit; }); 1597 $gnomeclient->signal_connect(save_yourself => sub { SaveTags(); return 1 }); 1598 #$gnomeclient->set_restart_command($0,'-C',$SaveFile); #FIXME 1599 #$gnomeclient->set_restart_style('if-running'); 1600 }; 1601 if ($@) {warn "Error loading Gnome2.pm => can't use gnome-session :\n $@\n"} 1602} 1603 1604#-------------INIT------------- 1605 1606{ Watch(undef, SongArray => \&SongArray_changed); 1607 Watch(undef, $_ => \&QueueChanged) for qw/QueueAction Queue/; 1608 Watch(undef, $_ => \&QueueUpdateNextSongs) for qw/Playlist Queue Sort Pos QueueAction/; 1609 Watch(undef, $_ => sub { return unless defined $SongID && $TogPlay; HasChanged('PlayingSong'); }) for qw/CurSongID Playing/; 1610 Watch(undef,RecentSongs => sub { UpdateRelatedFilter('Recent'); }); 1611 Watch(undef,NextSongs => sub { UpdateRelatedFilter('Next'); }); 1612 Watch(undef,CurSong => sub { UpdateRelatedFilter('Play'); }); 1613} 1614 1615LoadPlugins(); 1616if ($CmdLine{pluginlist}) { warn "$_ : $Plugins{$_}{name}\n" for sort keys %Plugins; exit; } 1617$SIG{HUP} = 'IGNORE'; 1618ReadSavedTags(); 1619$Options{AutoRemoveCurrentSong}=0 if $CmdLine{demo}; 1620 1621# global Volume and Mute are used only for gstreamer and mplayer in SoftVolume mode 1622our $Volume= $Options{Volume}; 1623$Volume=100 unless defined $Volume; 1624our $Mute= $Options{Volume_mute} || 0; 1625 1626$PlayPacks{$_}= $_->init for keys %PlayPacks; 1627 1628%CustomBoundKeys= %{ make_keybindingshash($Options{CustomKeyBindings}) }; 1629 1630$Options{version}=VERSION; 1631LoadIcons(); 1632 1633{ my $pp=$Options{AudioOut}; 1634 $pp= $Options{use_GST_for_server} ? 'Play_GST_server' : 'Play_Server' if $CmdLine{server}; 1635 for my $p ($pp, qw/Play_GST Play_123 Play_mplayer Play_mpv Play_GST_server Play_Server/) 1636 { next unless $p && $PlayPacks{$p}; 1637 $pp=$p; 1638 last; 1639 } 1640 $Options{AudioOut}||=$pp; 1641 $PlayNext_package=$PlayPacks{$pp}; 1642 SwitchPlayPackage(); 1643} 1644 1645IdleCheck() if $Options{StartCheck} && !$CmdLine{nocheck}; 1646IdleScan() if $Options{StartScan} && !$CmdLine{noscan}; 1647$Options{Icecast_port}=$CmdLine{port} if $CmdLine{port}; 1648 1649#$ListMode=[] if $CmdLine{empty}; 1650 1651$ListPlay=SongArray::PlayList->init; 1652Play() if $CmdLine{play} && !$PlayTime; 1653 1654#SkipTo($PlayTime) if $PlayTime; #gstreamer (how I use it) needs the mainloop running to skip, so this is done after the main window is created 1655 1656Layout::InitLayouts; 1657ActivatePlugin($_,'startup') for grep $Options{'PLUGIN_'.$_}, sort keys %Plugins; 1658Update_QueueActionList(); 1659QueueChanged() if $QueueAction; 1660 1661CreateMainWindow( $CmdLine{layout}||$Options{Layout} ); 1662ShowHide(0) if $CmdLine{hide} || ($Options{StartInTray} && $Options{UseTray} && $TrayIconAvailable); 1663SkipTo($PlayTime) if $PlayTime; #done only now because of gstreamer 1664 1665CreateTrayIcon(); 1666 1667if (my $cmds=delete $CmdLine{runcmd}) { run_command(undef,$_) for @$cmds; } 1668$SIG{TERM} = \&Quit; 1669 1670#-------------------------------------------------------------- 1671Gtk2->main; 1672exit; 1673 1674sub Edittag_mode 1675{ my @dirs=@_; 1676 $Songs::Def{$_}{flags}=~m/w/ || $Songs::Def{$_}{flags}=~s/e// for keys %Songs::Def; #quick hack to remove fields that are not written in the tag from the mass-tagging dialog 1677 FirstTime(); Post_ReadSavedTags(); 1678 LoadIcons(); #for stars edit widget that shouldn't be shown anyway 1679 $Options{LengthCheckMode}='never'; 1680 $_=rel2abs($_) for @dirs; 1681 IdleScan(@dirs); 1682 Gtk2->main_iteration while Gtk2->events_pending; 1683 1684 my $dialog = Gtk2::Dialog->new( _"Editing tags", undef,'modal', 1685 'gtk-save' => 'ok', 1686 'gtk-cancel' => 'none'); 1687 $dialog->signal_connect(destroy => sub {exit}); 1688 $dialog->set_default_size(500, 600); 1689 my $edittag; 1690 if (@$Library==1) 1691 { $edittag=EditTagSimple->new($dialog,$Library->[0]); 1692 $dialog->signal_connect( response => sub 1693 { my ($dialog,$response)=@_; 1694 $edittag->save if $response eq 'ok'; 1695 exit; 1696 }); 1697 } 1698 elsif (@$Library>1) 1699 { $edittag=MassTag->new(@$Library); 1700 $dialog->signal_connect( response => sub 1701 { my ($dialog,$response)=@_; 1702 if ($response eq 'ok') { $edittag->save( sub {exit} ); } 1703 else {exit} 1704 }); 1705 } 1706 else {die "No songs found.\n";} 1707 $dialog->vbox->add($edittag); 1708 $dialog->show_all; 1709 Gtk2->main; 1710} 1711 1712sub ChangeDisplay 1713{ my $display=$_[1]; 1714 my $screen=0; 1715 $screen=$1 if $display=~s/\.(\d+)$//; 1716 $display=Gtk2::Gdk::Display->open($display); 1717 return unless $display && $screen < $display->get_n_screens; 1718 Gtk2::Gdk::DisplayManager->get->set_default_display($display); 1719 $screen=$display->get_screen($screen); 1720 for my $win (Gtk2::Window->list_toplevels) 1721 { $win->set_screen($screen); 1722 } 1723} 1724 1725sub filename_to_utf8displayname #replaced by Glib::filename_display_name if available 1726{ my $utf8name=eval {filename_to_unicode($_[0])}; 1727 if ($@) 1728 { $utf8name=$_[0]; 1729 #$utf8name=~s/[\x80-\xff]/?/gs; #doesn't seem to be needed 1730 } 1731 return $utf8name; 1732} 1733 1734sub get_event_window 1735{ my $widget=shift; 1736 $widget||= Gtk2->get_event_widget(Gtk2->get_current_event); 1737 return find_ancestor($widget,'Gtk2::Window'); 1738} 1739sub get_layout_widget 1740{ find_ancestor($_[0],'Layout'); 1741} 1742sub find_ancestor 1743{ my ($widget,$class)=@_; 1744 until ( $widget->isa($class) ) 1745 { $widget= $widget->isa('Gtk2::Menu')? $widget->get_attach_widget : $widget->parent; 1746 #warn "Can't find ancestor $class of widget $_[0]\n" unless $widget; 1747 return undef unless $widget; 1748 } 1749 return $widget; 1750} 1751 1752sub HVpack 1753{ my ($vertical,@list)=@_; 1754 my $pad=2; 1755 my $end=FALSE; 1756 my $box= $vertical ? Gtk2::VBox->new : Gtk2::HBox->new; 1757 while (@list) 1758 { my $w=shift @list; 1759 next unless defined $w; 1760 my $exp=FALSE; 1761 unless (ref $w) 1762 { if ($w eq 'compact') { $pad=0; $box->set_spacing(0); next } 1763 $exp=$w=~m/_/; 1764 $end=1 if $w=~m/-/; 1765 $pad=$1 if $w=~m/(\d+)/; 1766 $w=shift @list; 1767 next unless $w; 1768 } 1769 if (ref $w eq 'ARRAY') 1770 { $w=HVpack(!$vertical,@$w); 1771 } 1772 if ($end) {$box->pack_end ($w,$exp,$exp,$pad);} 1773 else {$box->pack_start($w,$exp,$exp,$pad);} 1774 } 1775 return $box; 1776} 1777 1778sub Hpack { HVpack(0,@_); } 1779sub Vpack { HVpack(1,@_); } 1780 1781sub new_scrolledwindow 1782{ my ($widget,$shadow)=@_; 1783 my $sw= Gtk2::ScrolledWindow->new; 1784 $sw->set_shadow_type('etched-in') if $shadow; 1785 $sw->set_policy('automatic','automatic'); 1786 $sw->add($widget); 1787 return $sw; 1788} 1789 1790sub IsEventInNotebookTabs 1791{ my ($nb,$event)=@_; 1792 my (@rects)= map $_->allocation, grep $_->mapped, map $nb->get_tab_label($_), $nb->get_children; 1793 my ($bw,$bh)=$nb->get('tab-hborder','tab-vborder'); 1794 my $x1=min(map $_->x,@rects)-$bw; 1795 my $y1=min(map $_->y,@rects)-$bh; 1796 my $x2=max(map $_->x+$_->width,@rects)+$bw; 1797 my $y2=max(map $_->y+$_->height,@rects)+$bh; 1798 my ($x,$y)=$event->window->get_position; 1799 $x+=$event->x; 1800 $y+=$event->y; 1801 #warn "$x1,$y1,$x2,$y2 $x,$y"; 1802 return ($x1<$x && $x2>$x && $y1<$y && $y2>$y); 1803} 1804 1805sub TurnOff 1806{ my $dialog=Gtk2::MessageDialog->new 1807 ( $MainWindow,[qw/modal destroy-with-parent/], 1808 'warning','none','' 1809 ); 1810 $dialog->add_buttons('gtk-cancel' => 2, 'gmb-turnoff'=> 1); 1811 my $sec=21; 1812 my $timer=sub #FIXME can be more than 1 second 1813 { return 0 unless $sec; 1814 if (--$sec) {$dialog->set_markup(::PangoEsc(_("About to turn off the computer in :")."\n".__("%d second","%d seconds",$sec)))} 1815 else { $dialog->response(1); } 1816 return $sec; 1817 }; 1818 Glib::Timeout->add(1000, $timer); 1819 &$timer; #init the timer 1820 $dialog->show_all; 1821 my $ret=$dialog->run; 1822 $dialog->destroy; 1823 $sec=0; 1824 return if $ret==2; 1825 Quit('turnoff'); 1826} 1827sub Quit 1828{ my $turnoff; 1829 $turnoff=1 if $_[0] && $_[0] eq 'turnoff'; 1830 $Options{SavedPlayTime}= $PlayTime if $Options{RememberPlayTime}; 1831 &Stop if defined $TogPlay; 1832 @ToScan=@ToAdd_Files=(); 1833 CloseTrayTip(); 1834 SaveTags(); 1835 HasChanged('Quit'); 1836 unlink $FIFOFile if $FIFOFile; 1837 Gtk2->main_quit; 1838 exec $Options{Shutdown_cmd} if $turnoff && $Options{Shutdown_cmd}; 1839 exit; 1840} 1841 1842sub CmdFromFIFO 1843{ while (my $cmd=<$fifofh>) 1844 { chomp $cmd; 1845 next if $cmd eq ''; 1846 $cmd="$1($2)" if $cmd=~m/^(\w+) (.*)/; 1847 ($cmd, my$arg)= $cmd=~m/^(\w+)(?:\((.*)\))?$/; 1848 #if ($cmd eq 'Print') {print $fifofh "Told to print : $arg\n";return} 1849 if (exists $Command{$cmd}) { Glib::Timeout->add(0, sub { $Command{$cmd}[0]($_[0],$arg); 0;},GetActiveWindow()); warn "fifo:received $cmd\n" if $debug; } 1850 else {warn "fifo:received unknown command : '$cmd'\n"} 1851 } 1852 if (1) #FIXME replace 1 by gtk+ version check once the gtk+ bug is fixed (http://bugzilla.gnome.org/show_bug.cgi?id=321053) 1853 { #work around gtk bug that use 100% cpu after first command : close and reopen fifo 1854 close $fifofh; 1855 sysopen $fifofh,$FIFOFile, O_NONBLOCK; 1856 #sysopen $fifofh,$FIFOFile, O_NONBLOCK | O_RDWR; 1857 1858 Glib::IO->add_watch(fileno($fifofh),['in','hup'], \&CmdFromFIFO); 1859 return 0; #remove previous watcher 1860 } 1861 1; 1862} 1863 1864sub GetActiveWindow 1865{ my ($win)= sort {$b->{last_focused} <=> $a->{last_focused}} grep $_->{last_focused}, Gtk2::Window->list_toplevels; 1866 return $win; 1867} 1868 1869sub SearchPicture # search for file with a relative path among a few folders, used to find pictures used by layouts 1870{ my ($file,@paths)=@_; 1871 return $file if file_name_is_absolute($file); 1872 push @paths, $HomeDir.'layouts', $CmdLine{searchpath}, PIXPATH, $DATADIR.SLASH.'layouts'; #add some default folders 1873 @paths= grep defined, map ref() ? @$_ : $_, @paths; 1874 for (@paths) { $_=dirname($_) if -f; } #replace files by their folder 1875 my $found=first { -f $_.SLASH.$file } @paths; 1876 return cleanpath($found.SLASH.$file) if $found; 1877 warn "Can't find file '$file' (looked in : @paths)\n"; 1878 return undef; 1879} 1880 1881sub FileList 1882{ my ($re,@search)=@_; 1883 my @found; 1884 @search=grep defined, @search; 1885 @search=map ref() ? @$_ : $_, @search; 1886 for my $search (@search) 1887 { if (-f $search) { push @found,$search if $search=~$re; next; } 1888 next unless -d $search; 1889 opendir my($dir),$search; 1890 push @found, map $search.SLASH.$_,sort grep m/$re/, readdir $dir; 1891 close $dir; 1892 } 1893 return grep -f, @found; 1894} 1895sub LoadPlugins 1896{ my @list= FileList( qr/\.p[lm]$/, $DATADIR.SLASH.'plugins', $HomeDir.'plugins', $CmdLine{searchpath} ); 1897 1898 my %loaded; $loaded{$_}= $_->{file} for grep $_->{loaded}, values %Plugins; 1899 for my $file (grep !$loaded{$_}, @list) 1900 { warn "Reading plugin $file\n" if $::debug; 1901 my ($found,$id); 1902 open my$fh,'<:utf8',$file or do {warn "error opening $file : $!\n";next}; 1903 while (my $line=<$fh>) 1904 { if ($line=~m/^=(?:begin |for )?gmbplugin(?: ([A-Za-z]\w*))?/) 1905 { my $id=$1; 1906 my %plug= (version=>0,desc=>'',); 1907 while ($line=<$fh>) 1908 { $line=~s/\s*[\n\r]+$//; 1909 last if $line eq '=cut' || $line eq '=end gmbplugin'; 1910 my ($key,$val)= $line=~m/^\s*(\w+):?\s+(.+)/; 1911 next unless $key; 1912 if ($key eq 'id') { $id=$val } 1913 elsif ($key eq 'desc') 1914 { $plug{desc} .= _($val)."\n"; 1915 } 1916 elsif ($key eq 'author') 1917 { push @{$plug{author}}, $val; 1918 } 1919 else { $plug{$key}=$val; } 1920 } 1921 last unless $id; 1922 last unless $plug{name}; 1923 chomp $plug{desc}; 1924 $plug{file}=$file; 1925 $plug{version}=$1+($2||0)/100+($3||0)/10000 if $plug{version}=~m#(\d+)(?:\.(\d+)(?:\.(\d+)))#; 1926 $plug{$_}=_($plug{$_}) for grep $plug{$_}, qw/name title/; 1927 $found++; 1928 if ($Plugins{$id}) 1929 { last if $Plugins{$id}{loaded} || $Plugins{$id}{version}>=$plug{version}; 1930 } 1931 warn "found plugin $id ($plug{name})\n" if $::debug; 1932 $Plugins{$id}=\%plug; 1933 last; 1934 } 1935 elsif ($line=~m/^\s*[^#\n\r]/) {last} #read until first non-empty and non-comment line 1936 } 1937 close $fh; 1938 warn "No plugin found in $file, maybe it uses an old format\n" unless $found; 1939 } 1940} 1941sub PluginsInit 1942{ if (delete $CmdLine{noplugins}) { $Options{'PLUGIN_'.$_}=0 for keys %Plugins; } 1943 my $h=delete $CmdLine{plugins}; 1944 for my $p (keys %$h) 1945 { if (!$Plugins{$p}) { warn "Unknown plugin $p\n";next } 1946 $Options{'PLUGIN_'.$p}=$h->{$p}; 1947 } 1948 ActivatePlugin($_,'init') for grep $Options{'PLUGIN_'.$_}, sort keys %Plugins; 1949} 1950 1951# $startup can be undef, 'init' or 'startup' 1952# - 'init' when called after loading settings, run Init if defined 1953# - 'startup' when called after the songs are loaded, run Start if defined 1954# - undef when activated by the user, runs Init then Start 1955sub ActivatePlugin 1956{ my ($plugin,$startup)=@_; 1957 my $ref=$Plugins{$plugin}; 1958 if ( $ref->{loaded} || do $ref->{file} ) 1959 { $ref->{loaded}=1; 1960 delete $ref->{error}; 1961 my $package='GMB::Plugin::'.$plugin; 1962 if ($startup && $startup eq 'init') 1963 { if ($package->can('Init')) 1964 { $package->Init; 1965 warn "Plugin $plugin initialized.\n" if $debug; 1966 } 1967 } 1968 else 1969 { $package->Init if !$startup && $package->can('Init'); 1970 $package->Start($startup) if $package->can('Start'); 1971 warn "Plugin $plugin activated.\n" if $debug; 1972 } 1973 $Options{'PLUGIN_'.$plugin}=1; 1974 } 1975 elsif (!$startup || $startup eq 'init') 1976 { warn "plugin $ref->{file} failed : $@\n"; 1977 $ref->{error}=$@; 1978 } 1979} 1980sub DeactivatePlugin 1981{ my $plugin=$_[0]; 1982 my $package='GMB::Plugin::'.$plugin; 1983 delete $Options{'PLUGIN_'.$plugin}; 1984 return unless $Plugins{$plugin}{loaded}; 1985 warn "Plugin $plugin De-activated.\n" if $debug; 1986 $package->Stop if $package->can('Stop'); 1987} 1988sub CheckPluginRequirement 1989{ my $plugin=shift; 1990 my $ref=$Plugins{$plugin}; 1991 my $msg=''; 1992 if (my $req=$ref->{req}) 1993 { my @req; 1994 my @suggest; 1995 while ($req=~m/\bperl\(([\w:]+)(?:\s*,\s*([-\.\w ]+))?\)/ig) 1996 { my ($module,$packages)=($1,$2); 1997 my $file="/$module.pm"; 1998 $file=~s#::#/#g; 1999 if (!grep -f $_.$file, @INC) 2000 { push @req, __x( _"the {name} perl module",name=>$module); 2001 push @suggest, $packages; 2002 } 2003 } 2004 while ($req=~m/\bexec\((\w+)(?:\s*,\s*([-\.\w ]+))?\)/ig) 2005 { my ($exec,$packages)=($1,$2); 2006 if (!grep -x $_.$exec, split /:/, $ENV{PATH}) 2007 { push @req, __x( _"the command {name}",name=>$exec); 2008 push @suggest, $packages; 2009 } 2010 } 2011 while ($req=~m/\bfile\(([-\w\.\/]+)(?:\s*,\s*([-\.\w ]+))?\)/ig) 2012 { my ($file,$packages)=($1,$2); 2013 if (!-r $file) 2014 { push @req, __x( _"the file {name}",name=>$file); 2015 push @suggest, $packages; 2016 } 2017 } 2018 return unless @req; 2019 my $msg= PangoEsc(_"This plugin requires :")."\n\n"; 2020 while (@req) 2021 { my $r=shift @req; 2022 my $packages=shift @suggest; 2023 $packages= $packages ? ("Possible package names providing this :".' '.$packages."\n") : ''; 2024 $msg.= MarkupFormat("- %s\n<small>%s</small>\n", $r, $packages); 2025 } 2026 return $msg; 2027 } 2028} 2029 2030sub ChangeVol 2031{ my $cmd; 2032 if ($_[0] eq 'mute') 2033 { $cmd=$Vol_package->GetMute? 'unmute':'mute' ; 2034 } 2035 else 2036 { $cmd=(ref $_[0])? $_[1]->direction : $_[0]; 2037 if ($Vol_package->GetMute) {$cmd='unmute'} 2038 elsif ($cmd eq 'up') {$cmd="+$Options{VolumeStep}"} 2039 elsif ($cmd eq 'down'){$cmd="-$Options{VolumeStep}"} 2040 } 2041 warn "volume $cmd ...\n" if $debug; 2042 UpdateVol($cmd); 2043 warn "volume $cmd" if $debug; 2044} 2045 2046sub UpdateVol 2047{ $Vol_package->SetVolume($_[0]); 2048} 2049sub GetVol 2050{ $Vol_package->GetVolume; 2051} 2052sub GetMute 2053{ $Vol_package->GetMute; 2054} 2055 2056sub SetEqualizer 2057{ my ($key,$value)=@_; 2058 my ($eq,$preset,$preamp); 2059 my $on_off; 2060 if ($key eq 'smart') #for SetEqualizer command 2061 { if ($value=~m/^[01]$/) { $key='active' } 2062 elsif (exists $::Options{equalizer_presets}{$value}) {$key='preset'} 2063 elsif ($value=~m#^(?:(?:-?\d*\.?\d+):){9}(?:-?\d*\.?\d+)$#) {$key='set'} 2064 else { warn "SetEqualizer: invalid argument : $value\n" } 2065 } 2066 if ($key eq 'active') 2067 { ::SetOption(use_equalizer => $value ? 1 : 0); 2068 $eq= $value ? $::Options{equalizer} : '0:0:0:0:0:0:0:0:0:0'; 2069 $preamp= $value ? $::Options{equalizer_preamp} : 1; 2070 $on_off=1; # set equalizer values and preamp without changing $options 2071 } 2072 elsif ($key eq 'set' && $value=~m#^(?:(?:-?\d*\.?\d+):){9}(?:-?\d*\.?\d+)$#) 2073 { $eq= $value; 2074 $preset=''; 2075 } 2076 elsif ($key eq 'preamp') 2077 { $preamp= $value; 2078 } 2079 elsif ($key eq 'preset' && exists $::Options{equalizer_presets}{$value}) 2080 { $eq= $::Options{equalizer_presets}{$value}; 2081 $preset= $value; 2082 } 2083 elsif ($key eq 'preset_save' && $value=~m/\S/) 2084 { $::Options{equalizer_presets}{$value}= $::Options{equalizer}; 2085 $::Play_package->EQ_Save_Preset($value,$::Options{equalizer}) if $::Play_package->can('EQ_Save_Preset'); 2086 ::HasChanged(Equalizer=>'presetlist'); 2087 $preset= $value; 2088 } 2089 elsif ($key eq 'preset_delete') 2090 { delete $::Options{equalizer_presets}{$value}; 2091 $::Play_package->EQ_Save_Preset($value) if $::Play_package->can('EQ_Save_Preset'); 2092 ::HasChanged(Equalizer=>'presetlist'); 2093 $preset=''; 2094 } 2095 elsif ($key=~m/^[0-9]$/) #$key is band number 0..9 2096 { my @vals= split /:/, $::Options{equalizer}; 2097 $vals[$key]=$value; 2098 ::setlocale(::LC_NUMERIC, 'C'); 2099 $eq= join ':',@vals; 2100 ::setlocale(::LC_NUMERIC, ''); 2101 $preset=''; 2102 } 2103 else {return} 2104 unless ($on_off) 2105 { $::Options{equalizer}= $eq if $eq; 2106 $::Options{equalizer_preamp}= $preamp if defined $preamp; 2107 $::Options{equalizer_preset}= $preset if defined $preset; 2108 } 2109 if ($::Options{use_equalizer} || $on_off) 2110 { $::Play_package->set_equalizer($eq) if $eq && $::Play_package->{EQ}; 2111 $::Play_package->set_equalizer_preamp($preamp) if defined $preamp && $::Play_package->{EQpre}; 2112 } 2113 if ($on_off) 2114 { ::HasChanged(Equalizer=>'active') 2115 } 2116 else 2117 { ::HasChanged(Equalizer=>'values') if $eq; 2118 ::HasChanged(Equalizer=>'preamp') if defined $preamp; 2119 ::HasChanged(Equalizer=>'preset') if defined $preset; 2120 } 2121} 2122sub GetPresets 2123{ return ::superlc_sort(keys %{$::Options{equalizer_presets}}); 2124} 2125 2126sub FirstTime 2127{ #Default filters 2128 $Options{SavedFilters}= 2129 { _"never played" => 'playcount:<:1', 2130 _"50 Most Played" => 'playcount:h:50', 2131 _"50 Last Played" => 'lastplay:h:50', 2132 _"50 Last Added" => 'added:h:50', 2133 _"Played Today" => 'lastplay:<ago:1d', 2134 _"Added Today" => 'added:<ago:1d', 2135 _"played>4" => 'playcount:>:4', 2136 _"not bootleg" => 'label:-~:bootleg', 2137 }; 2138 $_=Filter->new($_) for values %{ $Options{SavedFilters} }; 2139 2140 my @dirs= reverse map $_.SLASH.'gmusicbrowser', Glib::get_system_config_dirs; 2141 for my $dir ($DATADIR,@dirs) 2142 { next unless -r $dir.SLASH.'gmbrc.default'; 2143 open my($fh),'<:utf8', $dir.SLASH.'gmbrc.default'; 2144 my @lines=<$fh>; 2145 close $fh; 2146 chomp @lines; 2147 my $opt={}; 2148 ReadRefFromLines(\@lines,$opt); 2149 %Options= ( %Options, %$opt ); 2150 } 2151 2152 Post_Options_init(); 2153} 2154 2155 2156my %artistsplit_old_to_new= #for versions <= 1.1.5 : to upgrade old ArtistSplit regexp to new default regexp 2157( ' & ' => '\s*&\s*', 2158 ', ' => '\s*,\s+', 2159 ' \\+ ' => '\s*\\+\s*', 2160 '; *' => '\s*;\s*', 2161 ';' => '\s*;\s*', 2162); 2163 2164sub ReadOldSavedTags 2165{ my $fh=$_[0]; 2166 while (<$fh>) 2167 { chomp; last if $_ eq ''; 2168 $Options{$1}=$2 if m/^([^=]+)=(.*)$/; 2169 } 2170 my $oldversion=delete $Options{version} || VERSION; 2171 if ($oldversion<0.9464) {delete $Options{$_} for qw/BrowserTotalMode FilterPane0Page FilterPane0min FilterPane1Page FilterPane1min LCols LSort PlayerWinPos SCols Sticky WSBrowser WSEditQueue paned StickyFilters/;} #cleanup old options 2172 $Options{'123options_mpg321'}=delete $Options{'123options_mp3'}; 2173 $Options{'123options_ogg123'}=delete $Options{'123options_ogg'}; 2174 $Options{'123options_flac123'}=delete $Options{'123options_flac'}; 2175 delete $Options{$_} for qw/Device 123options_mp3 123options_ogg 123options_flac test Diacritic_sort gst_volume Simplehttp_CacheSize/; #cleanup old options 2176 delete $Options{$_} for qw/SavedSongID SavedPlayTime Lock SavedSort/; #don't bother supporting upgrade for these 2177 $Options{CustomKeyBindings}= { ExtractNameAndOptions($Options{CustomKeyBindings}) }; 2178 delete $Options{$_} for grep m/^PLUGIN_MozEmbed/,keys %Options; #for versions <=1.0 2179 delete $Options{$_} for grep m/^PLUGIN_WebContext_Disable/,keys %Options; 2180 delete $Options{$_} for grep m/^Layout(?:LastSeen)?_/, keys %Options; 2181 $Options{WindowSizes}{$_}= join 'x',split / /,delete $Options{"WS$_"} for map m/^WS(.*)/, keys %Options; 2182 delete $Options{RecentFilters}; #don't bother upgrading them 2183 $Options{FilenameSchema}= [split /\x1D/,$Options{FilenameSchema}]; 2184 $Options{FolderSchema}= [split /\x1D/,$Options{FolderSchema}]; 2185 $Options{LibraryPath}= delete $Options{Path}; 2186 $Options{Labels}=delete $Options{Flags} if $oldversion<=0.9571; 2187 $Options{Labels}=[ split "\x1D",$Options{Labels} ] unless ref $Options{Labels}; #for version <1.1.2 2188 $Options{Fields_options}{label}{persistent_values}= delete $Options{Labels}; 2189 $Options{Artists_split_re}= [ map { $artistsplit_old_to_new{$_}||$_ } grep $_ ne '$', split /\|/, delete $Options{ArtistSplit} ]; 2190 $Options{TrayTipDelay}&&=900; 2191 2192 Post_Options_init(); 2193 2194 my $oldID=-1; 2195 no warnings 'utf8'; # to prevent 'utf8 "\xE9" does not map to Unicode' type warnings about path and file which are stored as they are on the filesystem #FIXME find a better way to read lines containing both utf8 and unknown encoding 2196 my ($loadsong)=Songs::MakeLoadSub({},split / /,$Songs::OLD_FIELDS); 2197 my (%IDforAlbum,%IDforArtist); 2198 my @newIDs; SongArray::start_init(); 2199 my $lengthcheck=SongArray->new; 2200 while (<$fh>) 2201 { chomp; last if $_ eq ''; 2202 $oldID++; 2203 next if $_ eq ' '; #deleted entry 2204 s#\\([n\\])#$1 eq "n" ? "\n" : "\\"#ge unless $oldversion<0.9603; 2205 my @song=split "\x1D",$_,-1; 2206 2207 next unless $song[0] && $song[1] && $song[2]; # 0=SONG_FILE 1=SONG_PATH 2=SONG_MODIF 2208 my $album=$song[11]; my $artist=$song[10]; 2209 $song[10]=~s/^<Unknown>$//; #10=SONG_ARTIST 2210 $song[11]=~s/^<Unknown>.*//; #11=SONG_ALBUM 2211 $song[12]=~s#/.*$##; ##12=SONG_DISC 2212 #$song[13]=~s#/.*$##; ##13=SONG_TRACK 2213 for ($song[0],$song[1]) { _utf8_off($_); $_=Songs::filename_escape($_) } # file and path 2214 my $misc= $song[24]||''; #24=SONG_MISSINGSINCE also used for estimatedlength and radio 2215 next if $misc eq 'R'; #skip radios (was never really enabled) 2216 $song[24]=0 unless $misc=~m/^\d+$/; 2217 my $ID= $newIDs[$oldID]= $loadsong->(@song); 2218 $IDforAlbum{$album}=$IDforArtist{$artist}=$ID; 2219 push @$lengthcheck,$ID if $misc eq 'l'; 2220 unless ($misc=~m/^\d+$/ && $misc>0) { push @$Library,$ID }; 2221 } 2222 while (<$fh>) 2223 { chomp; last if $_ eq ''; 2224 my ($key,$p)=split "\x1D"; 2225 next if $p eq ''; 2226 _utf8_off($p); 2227 my $ID=$IDforArtist{$key}; 2228 next unless defined $ID; 2229 my $gid=Songs::Get_gid($ID,'artist'); 2230 Songs::Picture($gid,'artist_picture','set',$p); 2231 } 2232 while (<$fh>) 2233 { chomp; last if $_ eq ''; 2234 my ($key,$p)=split "\x1D"; 2235 next if $p eq ''; 2236 _utf8_off($p); 2237 my $ID=$IDforAlbum{$key}; 2238 next unless defined $ID; 2239 my $gid=Songs::Get_gid($ID,'album'); 2240 Songs::Picture($gid,'album_picture','set',$p); 2241 } 2242 $Options{$_}={} for qw/SavedFilters SavedSorts SavedWRandoms SavedLists SavedSTGroupings/; 2243 while (<$fh>) 2244 { chomp; 2245 my ($key,$val)=split "\x1D",$_,2; 2246 $key=~s/^(.)//; 2247 if ($1 eq 'F') 2248 { $val=~s/((?:^|\x1D)-?)(\d+)?([^0-9()])/$1.(defined $2? Songs::FieldUpgrade($2) : '').":$3:"/ge; 2249 $val=~s/((?:^|\x1D)-?(?:label|genre)):e:(?=\x1D|$)/$1:ecount:0/g; 2250 $val=~s/((?:^|\x1D)-?(?:label|genre)):f:/$1:~:/g; 2251 $Options{SavedFilters}{$key}=Filter->new_from_string($val); 2252 } 2253 elsif ($1 eq 'S') 2254 { $Options{SavedSorts}{$key}=$val; 2255 } 2256 elsif ($1 eq 'R') 2257 { $Options{SavedWRandoms}{$key}=$val; 2258 } 2259 elsif ($1 eq 'L') 2260 { $Options{SavedLists}{$key}= SongArray::Named->new_from_string($val); 2261 } 2262 elsif ($1 eq 'G') 2263 { $Options{SavedSTGroupings}{$key}=$val; 2264 } 2265 } 2266 2267 if (my $f=delete $Options{LastPlayFilter}) 2268 { if ($f=~s/^(filter|savedlist|list) //) 2269 { $Options{LastPlayFilter}= 2270 $1 eq 'filter' ? Filter->new_from_string($f) : 2271 $1 eq 'savedlist' ? $f : 2272 $1 eq 'list' ? SongArray->new_from_string($f): 2273 undef; 2274 } 2275 } 2276 s/^r/random:/ || s/([0-9s]+)(i?)/($1 eq 's' ? 'shuffle' : Songs::FieldUpgrade($1)).($2 ? ':i' : '')/ge 2277 for values %{$Options{SavedSorts}},values %{$Options{SavedWRandoms}},$Options{Sort},$Options{AltSort}; 2278 $Options{Sort_LastOrdered}=$Options{Sort_LastSR}= delete $Options{AltSort}; 2279 if ($Options{Sort}=~m/random|shuffle/) { $Options{Sort_LastSR}=$Options{Sort} } else { $Options{Sort_LastOrdered}=$Options{Sort}||'path file'; } 2280 2281 $Options{SongArray_Recent}= SongArray->new_from_string(delete $Options{RecentIDs}); 2282 SongArray::updateIDs(\@newIDs); 2283 SongArray->new($Library); #done after SongArray::updateIDs because doesn't use old IDs 2284 Songs::Set($_,length_estimated=>1) for @$lengthcheck; 2285 $Options{LengthCheckMode}='add'; 2286} 2287 2288sub Filter_new_from_string_with_upgrade # for versions <=1.1.7 2289{ my @filter=split /\x1D/,$_[1]; 2290 my @new; 2291 for my $f (@filter) 2292 { if ($f=~m/^[()]/) { push @new,$f; next } 2293 my ($field,$cmd,$pat)=split ':',$f,3; 2294 if ($cmd eq 's') {$cmd='si'} 2295 elsif ($cmd eq 'S') {$cmd='s'} 2296 elsif ($cmd eq 'l') { $field='list'; $cmd='e'; } 2297 elsif ($cmd eq 'i') { $pat=~s#([^/\$_.+!*'(),A-Za-z0-9-])#sprintf('%%%02X',ord($1))#seg; } 2298 elsif ($field eq 'rating' && $cmd eq 'e') { $cmd='~'} 2299 elsif ($cmd=~m/^[b<>]$/ && $field=~m/^-?lastplay$|^-?lastskip$|^-?added$|^-?modif$/) 2300 { if ($pat=~m/[a-zA-Z]/) 2301 { $cmd= $cmd eq '<' ? '>ago' : 2302 $cmd eq '>' ? '<ago' : 'bago'; 2303 } 2304 else { $pat=~s/(\d\d\d\d)-(\d\d?)-(\d\d?)/mktime(0,0,0,$3,$2-1,$1-1900)/eg } 2305 } 2306 elsif ($cmd eq 'b') 2307 { my ($n1,$n2)= split / /,$pat; 2308 if ($field=~s/^-//) { push @new, '(|', "$field:<:$n1", "$field:->:$n2",')'; } 2309 else { push @new, '(&', "$field:-<:$n1", "$field:<:$n2" ,')'; } 2310 next 2311 } 2312 $cmd= '-'.$cmd if $field=~s/^-//; 2313 push @new, "$field:$cmd:$pat"; 2314 } 2315 my $string= join "\x1D", @new; 2316 return Filter->new_from_string_real($string); 2317} 2318 2319sub ReadSavedTags #load tags _and_ settings 2320{ my ($fh,$loadfile,$ext)= Open_gmbrc( $ImportFile || $SaveFile,0); 2321 unless ($fh) 2322 { if ($loadfile && -e $loadfile && -s $loadfile) 2323 { die "Can't open '$loadfile', aborting...\n" unless $fh; 2324 } 2325 else 2326 { FirstTime(); 2327 Post_ReadSavedTags(); 2328 return; 2329 } 2330 } 2331 warn "Reading saved tags in $loadfile ...\n"; 2332 $SaveFile.=$1 if $loadfile=~m#($gmbrc_ext_re)# && $SaveFile!~m#$gmbrc_ext_re#; # will use .gz/.xz to save if read from a .gz/.xz gmbrc 2333 2334 setlocale(LC_NUMERIC, 'C'); # so that '.' is used as a decimal separator when converting numbers into strings 2335 # read first line to determine if old version, version >1.1.7 stars with "# gmbrc version=", version <1.1 starts with a letter, else it's version<=1.1.7 (starts with blank or # (for comments) or [ (section name)) 2336 my $firstline=<$fh>; 2337 unless (defined $firstline) { die "Can't read '$loadfile', aborting...\n" } 2338 my $oldversion; 2339 if ($firstline=~m/^#?\s*gmbrc version=(\d+\.\d+)/) { $oldversion=$1 } 2340 elsif ($ext) { die "Can't find gmbrc header in '$loadfile', aborting...\n" } # compressed gmbrc not supported with old versions, because can't seek backward in compressed fh 2341 elsif ($firstline=~m/^\w/) { seek $fh,0,SEEK_SET; ReadOldSavedTags($fh); $oldversion=1 } 2342 else # version <=1.1.7 2343 { seek $fh,0,SEEK_SET; 2344 no warnings qw/redefine once/; 2345 *Filter::new_from_string_real= \&Filter::new_from_string; 2346 *Filter::new_from_string= \&Filter_new_from_string_with_upgrade; 2347 } 2348 if (!$oldversion || $oldversion>1) # version >=1.1 2349 { my %lines; 2350 my $section='HEADER'; 2351 while (<$fh>) 2352 { if (m/^\[([^]]+)\]/) {$section=$1; next} 2353 chomp; 2354 next unless length; 2355 push @{$lines{$section}},$_; 2356 } 2357 close $fh; 2358 unless ($lines{Options}) { warn "Can't find Options section in '$loadfile', it's probably not a gmusicbrowser save file -> aborting\n"; exit 1; } 2359 SongArray::start_init(); #every SongArray read in Options will be updated to new IDs by SongArray::updateIDs later 2360 ReadRefFromLines($lines{Options},\%Options); 2361 $oldversion||=delete $Options{version} || VERSION; # for version <=1.1.7 2362 if ($oldversion>VERSION) { warn "Loading a gmbrc saved with a more recent version of gmusicbrowser, try upgrading gmusicbrowser if there are problems\n"; } 2363 if ($oldversion<1.10091) {delete $Options{$_} for qw/Diacritic_sort gst_volume Simplehttp_CacheSize mplayer_use_replaygain/;} #cleanup old options 2364 if ($oldversion<=1.1011) {delete $Options{$_} for qw/ScanPlayOnly/;} #cleanup old options 2365 $Options{AutoRemoveCurrentSong}= delete $Options{TAG_auto_check_current} if $oldversion<1.1005 && exists $Options{TAG_auto_check_current}; 2366 $Options{PlayedMinPercent}= 100*delete $Options{PlayedPercent} if exists $Options{PlayedPercent}; 2367 if ($Options{ArtistSplit}) # for versions <= 1.1.5 2368 { $Options{Artists_split_re}= [ map { $artistsplit_old_to_new{$_}||$_ } grep $_ ne '$', split /\|/, delete $Options{ArtistSplit} ]; 2369 } 2370 if ($oldversion<1.1007) { for my $re (@{$Options{Artists_split_re}}) { $re='\s*,\s+' if $re eq '\s*,\s*'; } } 2371 if ($oldversion<1.1008) { my $d=$Options{TrayTipDelay}||0; $Options{TrayTipDelay}= $d==1 ? 900 : $d; } 2372 if ($Options{Labels}) { $Options{Fields_options}{label}{persistent_values}= delete $Options{Labels} } 2373 if ($oldversion<=1.1014) { $Options{$_}= delete $Options{"gst_$_"} for qw/equalizer use_equalizer equalizer_preset equalizer_preamp use_replaygain rg_albummode rg_fallback rg_preamp rg_limiter/; } 2374 2375 Post_Options_init(); 2376 2377 my $songs=$lines{Songs}; 2378 my $fields=shift @$songs; 2379 my ($loadsong,$extra_sub)=Songs::MakeLoadSub(\%lines,split /\t/,$fields); 2380 my @newIDs; 2381 while (my $line=shift @$songs) 2382 { my ($oldID,@vals)= split /\t/, $line,-1; 2383 s#\\x([0-9a-fA-F]{2})#chr hex $1#eg for @vals; 2384 $newIDs[$oldID]= $loadsong->(@vals); 2385 } 2386 #load fields properties, like album pictures ... 2387 for my $extra (keys %$extra_sub) 2388 { my $lines=$lines{$extra}; 2389 next unless $lines; 2390 shift @$lines; #my @properties=split / /, shift @$lines; 2391 my $sub=$extra_sub->{$extra}; 2392 while (my $line=shift @$lines) 2393 { my ($key,@vals)= split /\t/, $line,-1; 2394 s#\\x([0-9a-fA-F]{2})#chr hex $1#eg for $key,@vals; 2395 $sub->($key,@vals); 2396 } 2397 } 2398 SongArray::updateIDs(\@newIDs); 2399 if (my $l=delete $Options{SongArray_Estimated}) # for $oldversion<1.1008 2400 { $Recent= SongArray->new; # $Recent is used in SongsChanged() so must exists, will be replaced 2401 Songs::Set($_,length_estimated=>1) for @$l; 2402 $Options{LengthCheckMode}='add'; 2403 } 2404 my $mfilter= $Options{MasterFilterOn} && $Options{MasterFilter} || ''; 2405 my $filter= Filter->newadd(TRUE,'missing:e:0', $mfilter); 2406 $Library=[]; #dummy array to avoid a warning when filtering in the next line 2407 $Library= SongArray->new( $filter->filter_all ); 2408 } 2409 2410 if ($oldversion<=1.1009) 2411 { bless $_,'SongArray::Named' for values %{$Options{SavedLists}}; #named lists now use SongArray::Named instead of plain SongArray 2412 no warnings 'once'; 2413 for my $floatvector ($Songs::Songs_replaygain_track_gain__,$Songs::Songs_replaygain_track_peak__,$Songs::Songs_replaygain_album_gain__,$Songs::Songs_replaygain_album_peak__) 2414 { $floatvector= pack "F*",map $_||"nan", unpack("F*",$floatvector) if $floatvector; # undef is now stored as nan rather than 0, upgrade assuming all 0s were undef 2415 } 2416 } 2417 elsif ($oldversion==1.100901) #fix version 1.1.9.1 mistakenly upgrading by replacing float values of 0 by inf instead of nan 2418 { for my $floatvector ($Songs::Songs_replaygain_track_gain__,$Songs::Songs_replaygain_track_peak__,$Songs::Songs_replaygain_album_gain__,$Songs::Songs_replaygain_album_peak__) 2419 { $floatvector= pack "F*",map {$_!="inf" ? $_ : "nan"} unpack("F*",$floatvector) if $floatvector; } 2420 } 2421 2422 delete $Options{LastPlayFilter} unless $Options{RememberPlayFilter}; 2423 $QueueAction= $Options{QueueAction} || ''; 2424 unless ($Options{RememberQueue}) 2425 { $Options{SongArray_Queue}=undef; 2426 $QueueAction= ''; 2427 } 2428 if ($Options{RememberPlayFilter}) 2429 { $TogLock=$Options{Lock}; 2430 } 2431 if ($Options{RememberPlaySong} && $Options{SavedSongID}) 2432 { $SongID= (delete $Options{SavedSongID})->[0]; } 2433 if ($Options{RememberPlaySong} && $Options{RememberPlayTime}) { $PlayTime=delete $Options{SavedPlayTime}; } 2434 $Options{LibraryPath}||=[]; 2435 $Options{LibraryPath}= [ map url_escape($_), split "\x1D", $Options{LibraryPath}] unless ref $Options{LibraryPath}; #for versions <=1.1.1 2436 &launchIdleLoop; 2437 2438 setlocale(LC_NUMERIC, ''); 2439 warn "Reading saved tags in $loadfile ... done\n"; 2440 Post_ReadSavedTags(); 2441} 2442sub Post_Options_init 2443{ PluginsInit(); 2444 Songs::UpdateFuncs(); 2445} 2446sub Post_ReadSavedTags 2447{ $Library||= SongArray->new; 2448 $Recent= $Options{SongArray_Recent} ||= SongArray->new; 2449 $Queue= $Options{SongArray_Queue} ||= SongArray->new; 2450 $Options{LibraryPath}||=[]; 2451 #CheckLength() if $Options{LengthCheckMode} eq 'add'; 2452} 2453 2454sub Open_gmbrc 2455{ my ($file,$write)=@_; 2456 my $encoding='utf8'; 2457 my ($fh,$ext,@cmd); 2458 if ($write) 2459 { my @cmd; 2460 if ($file=~m#\.gz$#) { $ext='.gz'; @cmd=qw/gzip/; } 2461 elsif ($file=~m#\.xz$#) { $ext='.xz'; @cmd=qw/xz -0/; } 2462 if (@cmd) 2463 { if (findcmd($cmd[0])) 2464 { open $fh,'|-:'.$encoding,"@cmd > \Q$file\E" or warn "Failed opening '$file' for writing (using $cmd[0]) : $!\n"; 2465 } 2466 else { $file=~s#\.xz$|\.gz$##; @cmd=(); warn "Can't find $cmd[0], saving without compression\n"; } 2467 } 2468 if (!@cmd) 2469 { open $fh,'>:'.$encoding,$file or warn "Failed opening '$file' for writing : $!\n"; 2470 $ext=''; 2471 } 2472 return ($fh,$file,$ext); 2473 } 2474 else # open for reading 2475 { unless (-e $file) #if not found as is try with/without .gz/.xz 2476 { $file=~s#$gmbrc_ext_re##; 2477 $file= find_gmbrc_file($file); 2478 } 2479 return unless $file; 2480 if (-z $file) { warn "Warning: save file '$file' is empty\n"; return } 2481 my $cmpr; 2482 if ($file=~m#(\.gz|\.xz)$#) { $cmpr=$ext=$1; } 2483 else 2484 { open $fh,'<',$file or warn "Failed opening '$file' for reading : $!\n"; 2485 $cmpr=$ext=''; 2486 2487 # check if file compressed in spite of not having a .gz/.xz extension 2488 binmode($fh); # need to read binary data, so do not set utf8 layer yet 2489 read $fh,my($header),6; 2490 if ($header =~m#^\x1f\x8b#) { $cmpr='.gz'; } #gzip header : will open it as a .gz file 2491 elsif ($header eq "\xFD7zXZ\x00") { $cmpr='.xz'; } #xz header 2492 else { seek $fh,0,SEEK_SET; binmode($fh,':utf8'); } #no gzip header, rewind, and set utf8 layer 2493 } 2494 if ($cmpr eq '.gz') { @cmd=qw/gzip -cd/; } 2495 elsif ($cmpr eq '.xz') { @cmd=qw/xz -cd/; } 2496 if (@cmd) 2497 { close $fh if $fh; #close compressed files without extension 2498 if (findcmd($cmd[0])) 2499 { open $fh,'-|:'.$encoding,"@cmd \Q$file\E" or warn "Failed opening '$file' for reading (using $cmd[0]) : $!\n"; 2500 } 2501 else { warn "Can't find $cmd[0], you could uncompress '$file' manually\n"; } 2502 } 2503 return ($fh,$file,$ext,$cmpr); 2504 } 2505} 2506 2507sub SaveTags #save tags _and_ settings 2508{ my $fork=shift; #if true, save in a forked process 2509 HasChanged('Save'); 2510 if ($CmdLine{demo}) { warn "-demo option => not saving tags/settings\n" if $Verbose || !$fork; return } 2511 2512 my $ext=''; 2513 my $SaveFile= $SaveFile; #do a local copy to locally remove .gz extension if present 2514 $ext=$1 if $SaveFile=~s#($gmbrc_ext_re)$##; #remove .gz/.xz extension from the copy of $SaveFile, put it in $ext 2515 if (exists $CmdLine{gzip}) { $ext= $CmdLine{gzip} eq 'gzip' ? '.gz' : $CmdLine{gzip} eq 'xz' ? '.xz' : '' } 2516 #else { $ext='.gz' } # use gzip by default 2517 2518 my ($savedir,$savefilename)= splitpath($SaveFile); 2519 unless (-d $savedir) { warn "Creating folder $savedir\n"; mkdir $savedir or warn $!; } 2520 opendir my($dh),$savedir; 2521 unlink $savedir.SLASH.$_ for grep m/^\Q$savefilename\E\.new\.\d+(?:$gmbrc_ext_re)?$/, readdir $dh; #delete old temporary save files 2522 closedir $dh; 2523 2524 if ($fork) 2525 { my $pid= fork; 2526 if (!defined $pid) { $fork=undef; } # error, fallback to saving in current process 2527 elsif ($pid) 2528 { while (waitpid(-1, WNOHANG)>0) {} #reap dead children 2529 return 2530 } 2531 } 2532 2533 setlocale(LC_NUMERIC, 'C'); 2534 $Options{Lock}= $TogLock || ''; 2535 $Options{SavedSongID}= SongArray->new([$SongID]) if $Options{RememberPlaySong} && defined $SongID; 2536 $Options{QueueAction}= $QActions{$QueueAction}{save} ? $QueueAction : ''; 2537 2538 $Options{SavedOn}= time; 2539 2540 my $tooold=0; 2541 my @sessions=split ' ',$Options{Sessions}; 2542 unless (@sessions && $DAYNB==$sessions[0]) 2543 { unshift @sessions,$DAYNB; 2544 $tooold=pop @sessions if @sessions>20; 2545 $Options{Sessions}=join ' ',@sessions; 2546 } 2547 for my $key (keys %{$Options{Layouts}}) #cleanup options for layout that haven't been seen for a while 2548 { my $lastseen=$Options{LayoutsLastSeen}||={}; 2549 if (exists $Layout::Layouts{$key}) { delete $lastseen->{$key}; } 2550 elsif (!$lastseen->{$key}) { $lastseen->{$key}=$DAYNB; } 2551 elsif ($lastseen->{$key}<$tooold) { delete $_->{$key} for $Options{Layouts},$lastseen; } 2552 } 2553 2554 local $SIG{PIPE} = 'DEFAULT'; # default is, for some reason, IGNORE, which causes "gzip: stdout: Broken pipe" after closing $fh when using gzip for unclear reasons 2555 my $error; 2556 (my$fh,my$tempfile,$ext)= Open_gmbrc("$SaveFile.new.$$"."$ext",1); 2557 unless ($fh) { warn "Save aborted\n"; POSIX::_exit(0) if $fork; return; } 2558 warn "Writing tags in $SaveFile$ext ...\n" if $Verbose || !$fork; 2559 2560 print $fh "# gmbrc version=".VERSION." time=".time."\n" or $error||=$!; 2561 2562 my $optionslines=SaveRefToLines(\%Options); 2563 print $fh "[Options]\n$$optionslines\n" or $error||=$!; 2564 2565 my ($savesub,$fields,$extrasub,$extra_subfields)=Songs::MakeSaveSub(); 2566 print $fh "[Songs]\n".join("\t",@$fields)."\n" or $error||=$!; 2567 for my $ID (@{ Songs::AllFilter('missing:-b:1 '.($tooold||1)) }) 2568 { my @vals=$savesub->($ID); 2569 s#([\x00-\x1F\\])#sprintf "\\x%02x",ord $1#eg for @vals; 2570 my $line= join "\t", $ID, @vals; 2571 print $fh $line."\n" or $error||=$!; 2572 } 2573 #save fields properties, like album pictures ... 2574 for my $field (sort keys %$extrasub) 2575 { print $fh "\n[$field]\n$extra_subfields->{$field}\n" or $error||=$!; 2576 my $h= $extrasub->{$field}->(); 2577 for my $key (sort keys %$h) 2578 { my $vals= $h->{$key}; 2579 s#([\x00-\x1F\\])#sprintf "\\x%02x",ord $1#eg for $key,@$vals; 2580 $key=~s#^\[#\\x5b#; #escape leading "[" 2581 my $line= join "\t", @$vals; 2582 next if $line=~m/^\t*$/; 2583 print $fh "$key\t$line\n" or $error||=$!; 2584 } 2585 } 2586 close $fh or $error||=$!; 2587 setlocale(LC_NUMERIC, ''); 2588 if ($error) 2589 { rename $tempfile,$SaveFile.'.error'.$ext; 2590 warn "Writing tags in $SaveFile$ext ... error : $error\n"; 2591 POSIX::_exit(1) if $fork; 2592 return; 2593 } 2594 if ($fork && !-e $tempfile) { POSIX::_exit(0); } #tempfile disappeared, probably deleted by a subsequent save from another process => ignore 2595 my $previous= $SaveFile.$ext; 2596 $previous= find_gmbrc_file($SaveFile) unless -e $previous; 2597 if ($previous) #keep some old files as backup 2598 { { my ($bfh,$previousbak,$ext2,$cmpr)= Open_gmbrc($SaveFile.'.bak'.$ext,0); 2599 last unless $bfh; 2600 local $_; my $date; 2601 while (<$bfh>) { if (m/^SavedOn:\s*(\d+)/) {$date=$1;last} last if m/^\[(?!Options])/} 2602 close $bfh; 2603 last unless $date; 2604 $date=strftime('%Y%m%d',localtime($date)); 2605 if (find_gmbrc_file($SaveFile.'.bak.'.$date)) { unlink $previousbak; last} #remove .bak if already a backup for that day 2606 rename $previousbak, "$SaveFile.bak.$date$ext2" or warn $!; 2607 if (!$cmpr && (!exists $CmdLine{gzip} || $CmdLine{gzip})) #compress old backups unless "-gzip" option is used 2608 { my $cmd= $CmdLine{gzip} || 'xz'; 2609 $cmd= findcmd($cmd,'xz','gzip'); 2610 system($cmd,'-1','-f',"$SaveFile.bak.$date") if $cmd; 2611 } 2612 2613 my @files=FileList(qr/^\Q$savefilename\E\.bak\.\d{8}(?:$gmbrc_ext_re)?$/, $savedir); 2614 last unless @files>5; 2615 splice @files,-5; #keep the 5 newest versions 2616 unlink @files; 2617 } 2618 my $rename= $previous; 2619 $rename=~s#($gmbrc_ext_re?)$#.bak$1#; 2620 rename $previous, $rename or warn $!; 2621 unlink $_ for find_gmbrc_file($SaveFile); #make sure there is no other old gmbrc without .bak, as they could cause confusion 2622 } 2623 rename $tempfile,$SaveFile.$ext or warn $!; 2624 warn "Writing tags in $SaveFile$ext ... done\n" if $Verbose || !$fork; 2625 POSIX::_exit(0) if $fork; 2626} 2627 2628sub ReadRefFromLines # convert a string written by SaveRefToLines to a hash/array # can only read a small subset of YAML 2629{ my ($lines,$return)=@_; 2630 my @todo; 2631 my ($ident,$ref)=(0,$return); 2632 my $parentval; my @objects; 2633 for my $line (@$lines) 2634 { next if $line=~m/^\s*(?:#|$)/; #skip comment or empty line 2635 my ($d,$array,$key,$val)= $line=~m/^(\s*)(?:(-)|(?:("[^"]*"|\S*)\s*:))\s*(.*)$/; 2636 $d= length $d; 2637 if ($parentval) #first value of new array or hash 2638 { next unless $d>=$ident; 2639 push @todo, $ref,$ident; 2640 $ident=$d; 2641 $ref=$$parentval= $array ? [] : {}; 2642 $parentval=undef; 2643 } 2644 elsif ($ident-$d) 2645 { next unless $ident>$d; 2646 while ($ident>$d) { $ident=pop @todo; $ref=pop @todo; } 2647 } 2648 if (!$array && $key=~s/^"//) { $key=~s/"$//; $key=~s#\\x([0-9a-fA-F]{2})#chr hex $1#ge; } 2649 $val=~s/\s+$//; 2650 my $class; 2651 if ($val=~m/^!/) #object 2652 { if ($val=~s/^!([^ !]+)\s*//) {$class=$1} 2653 else { warn "Unsupported value : '$val'\n"; next } 2654 } 2655 if ($val eq '') #array or hash or object as array/hash 2656 { $parentval= $array ? \$ref->[@$ref] : \$ref->{$key}; 2657 push @objects, $class,$parentval if $class; 2658 } 2659 else #scalar or empty array/hash or object as string 2660 { if ($val eq '~') {$val=undef} 2661 elsif ($val=~m/^'(.*)'$/) {$val=$1; $val=~s/''/'/g; } 2662 elsif ($val=~m/^"(.*)"$/) 2663 { $val=$1; 2664 $val=~s/\\"/"/g; 2665 $val=~s#\\x([0-9a-fA-F]{2})#chr hex $1#ge; 2666 } 2667 elsif ($val eq '[]') {$val=[];} 2668 elsif ($val eq '{}') {$val={};} 2669 if ($class) { $val= $class->new_from_string($val); } 2670 if ($array) { push @$ref,$val; } 2671 else { $ref->{$key}=$val; } 2672 } 2673 } 2674 while (@objects) 2675 { my ($class,$ref)= splice @objects,-2; #start with the end -> if object contain other objects they will be created first 2676 $$ref= $class->new_from_string($$ref); 2677 } 2678 return @todo ? $todo[0] : $ref; 2679} 2680 2681 2682sub SaveRefToLines #convert hash/array into a YAML string readable by ReadRefFromLines 2683{ my $ref=$_[0]; 2684 my (@todo,$keylist,$ref_is_array); 2685 my $lines=''; 2686 my $pre=''; 2687 my $depth=0; 2688 if (ref $ref eq 'ARRAY'){ $keylist=0; $ref_is_array=1; } 2689 else { $keylist=[sort keys %$ref]; } 2690 while (1) 2691 { my ($val,$next,$up); 2692 if ($ref_is_array) #ARRAY 2693 { if ($keylist<@$ref) 2694 { $val=$ref->[$keylist++]; 2695 $lines.= $pre.'-'; 2696 $next=$val if ref $val; 2697 } 2698 else {$up=1} 2699 } 2700 else #HASH 2701 { if (@$keylist) 2702 { my $key=shift @$keylist; 2703 $val=$ref->{$key}; 2704 if ($key eq '') {$key='""'} 2705 elsif ($key=~m/[\x00-\x1f\n:# ]/ || $key=~m#^\W#) 2706 { $key=~s/([\x00-\x1f\n"\\])/sprintf "\\x%02x",ord $1/ge; 2707 $key=qq/"$key"/; 2708 } 2709 $lines.= $pre.$key.':'; 2710 $next=$val if ref $val; 2711 } 2712 else {$up=1} 2713 } 2714 if ($next) 2715 { my $is_array= ref $next eq 'ARRAY'; 2716 my $is_string; 2717 if (!$is_array && ref $next ne 'HASH') #save object 2718 { $val=$next->save_to_string; 2719 $lines.= ' !'.ref($next); 2720 if (!ref $val) { $is_string=1 } 2721 else { $next=$val; $is_array= UNIVERSAL::isa($val,"ARRAY") ? 1 : 0; } 2722 } 2723 if (!$is_string) 2724 { if ( $is_array && !@$next) { $lines.=" []\n";next; } 2725 elsif (!$is_array && !keys(%$next)) { $lines.=" {}\n";next; } 2726 $lines.="\n"; 2727 $depth++; 2728 $pre=' 'x$depth; 2729 push @todo,$ref,$ref_is_array,$keylist; 2730 $ref=$next; 2731 $ref_is_array= $is_array; 2732 if ($ref_is_array) { $keylist=0; } 2733 else { $keylist=[sort keys %$ref]; } 2734 next; 2735 } 2736 } 2737 elsif ($up) 2738 { if ($depth) 2739 { $depth--; 2740 $pre=' 'x$depth; 2741 ($ref,$ref_is_array,$keylist)= splice @todo,-3; 2742 next; 2743 } 2744 else {last} 2745 } 2746 if (!defined $val) {$val='~'} 2747 elsif ($val eq '') {$val="''"} 2748 elsif ($val=~m/[\x00-\x1f\n:#]/ || $val=~m#^'#) 2749 { $val=~s/([\x00-\x1f\n"\\])/sprintf "\\x%02x",ord $1/ge; 2750 $val=qq/"$val"/; 2751 } 2752 elsif ($val=~m/^\W/ || $val=~m/\s$/ || $val=~m/^true$|^false$|^null$/i) 2753 { $val=~s/'/''/g; 2754 $val="'$val'"; 2755 } 2756 $lines.= ' '.$val."\n"; 2757 } 2758 return \$lines; 2759} 2760 2761sub SetWSize 2762{ my ($win,$wkey,$default)=@_; 2763 $win->set_role($wkey); 2764 $win->set_name($wkey); 2765 my $prevsize= $Options{WindowSizes}{$wkey} || $default; 2766 $win->resize(split 'x',$prevsize,2) if $prevsize; 2767 $win->signal_connect(unrealize => sub 2768 { $Options{WindowSizes}{$_[1]}=join 'x',$_[0]->get_size; } 2769 ,$wkey); 2770} 2771 2772sub Rewind 2773{ my $sec=$_[1]; 2774 return unless $sec; 2775 $sec=(defined $PlayTime && $PlayTime>$sec)? $PlayTime-$sec : 0; 2776 SkipTo($sec); 2777} 2778sub Forward 2779{ my $sec=$_[1]; 2780 return unless $sec; 2781 $sec+=$PlayTime if defined $PlayTime; 2782 SkipTo($sec); 2783} 2784 2785sub SkipTo 2786{ return unless defined $SongID; 2787 my $sec=shift; 2788 if ($sec && $sec<0) { $sec+= Songs::Get($SongID,'length'); $sec=0 if $sec<0; } 2789 if (defined $PlayingID && defined $PlayTime) # if song already playing 2790 { push @Played_segments, $StartedAt, $PlayTime; 2791 $StartedAt=$sec; 2792 $Play_package->SkipTo($sec); 2793 } 2794 else { Play($sec); } 2795 ::QHasChanged( Seek => $sec ); 2796} 2797 2798sub PlayPause 2799{ if (defined $TogPlay) { Pause()} #paused or playing => resume or pause 2800 else { Play() } #stopped => play 2801} 2802 2803sub Pause 2804{ if ($TogPlay) 2805 { $Play_package->Pause; 2806 $TogPlay=0; 2807 } 2808 elsif (defined $TogPlay) 2809 { $Play_package->Resume; 2810 $TogPlay=1; 2811 } 2812 HasChanged('Playing'); 2813} 2814 2815sub Play 2816{ return unless defined $SongID; 2817 my $sec=shift; 2818 $sec=undef unless $sec && !ref $sec; 2819 &Played if defined $PlayingID; 2820 $StartedAt=$sec||0; 2821 $StartTime=time; 2822 $PlayingID=$SongID; 2823 $Play_package->Play( Songs::GetFullFilename($SongID), $sec); 2824 my $wasplaying=$TogPlay; 2825 $TogPlay=1; 2826 UpdateTime(0); 2827 HasChanged('Playing') unless $wasplaying; 2828} 2829 2830sub ErrorPlay 2831{ my ($error,$details)=@_; 2832 $error= __x( _"Playing error : {error}", error=> $error ); 2833 warn $error."\n"; 2834 return if $Options{IgnorePlayError}; 2835 my $dialog = Gtk2::MessageDialog->new 2836 ( $MainWindow, [qw/modal destroy-with-parent/], 2837 'error','close','%s', 2838 $error 2839 ); 2840 if ($details) 2841 { my $expander=Gtk2::Expander->new(_"Error details"); 2842 $details= Gtk2::Label->new($details); 2843 $details->set_line_wrap(1); 2844 $details->set_selectable(1); 2845 $expander->add($details); 2846 $dialog->vbox->pack_start($expander,0,0,2); 2847 } 2848 $dialog->show_all; 2849 $dialog->run; 2850 $dialog->destroy; 2851 #$dialog->signal_connect( response => sub {$_[0]->destroy}); 2852 $PlayingID=undef; #will avoid counting the song as played or skipped 2853 Stop(); 2854} 2855 2856sub end_of_file_faketime 2857{ UpdateTime( Songs::Get($SongID,'length') ); 2858 end_of_file(); 2859} 2860 2861sub end_of_file 2862{ SwitchPlayPackage() if $PlayNext_package; 2863 &Played; 2864 ResetTime(); 2865 &NextSong if $TogPlay; 2866} 2867 2868sub Stop 2869{ warn "stop\n" if $::debug; 2870 undef $TogPlay; 2871 $Play_package->Stop; 2872 SwitchPlayPackage() if $PlayNext_package; 2873 HasChanged('Playing'); 2874 &Played; 2875 ResetTime(); 2876} 2877 2878sub SwitchPlayPackage 2879{ $Play_package->Close if $Play_package && $Play_package->can('Close'); 2880 $Play_package=$PlayNext_package; 2881 $PlayNext_package=undef; 2882 $Play_package->Open if $Play_package->can('Open'); 2883 $Vol_package=$Play_package; 2884 $Vol_package=$Play_package->VolInit||$Play_package if $Play_package->can('VolInit'); 2885 $Play_package->EQ_Import_Presets if $Play_package->can('EQ_Import_Presets'); 2886 HasChanged('AudioBackend'); 2887 HasChanged('Equalizer','package'); 2888 HasChanged('Vol'); 2889} 2890 2891sub UpdateTime 2892{ return if defined $PlayTime && $_[0] == $PlayTime; 2893 $PlayTime=$_[0]; 2894 HasChanged('Time'); 2895} 2896sub ResetTime 2897{ undef $PlayTime; 2898 HasChanged('Time'); 2899} 2900 2901sub AddToRecent #add song to recently played list 2902{ my $ID=shift; 2903 unless (@$Recent && $Recent->[0]==$ID) 2904 { $Recent->Unshift([$ID]); #FIXME make sure it's not too slow, put in a idle ? 2905 $Recent->Pop if @$Recent>80; # 2906 } 2907} 2908 2909sub Coverage # find number of unique seconds played from a list of start,stop times 2910{ my @segs=@_; 2911 my $sum=0; 2912 while (@segs) 2913 { my ($start,$stop)=splice @segs,0,2; 2914 my $i=0; 2915 my $th=.5; #threshold : ignore differences of less than .5s 2916 while ($i<@segs) 2917 { my $s1=$segs[$i]; 2918 my $s2=$segs[$i+1]; 2919 if ($start-$s1<=$th && $s1-$stop<=$th || $start-$s2<=$th && $s2-$stop<=$th) # segments overlap 2920 { $stop =$s2 if $s2>$stop; 2921 $start=$s1 if $s1<$start; 2922 splice @segs,$i,2; 2923 $i=0; 2924 } 2925 else { $i+=2; } 2926 } 2927 my $length= $stop-$start; 2928 $sum+= $length if $length>$th; 2929 } 2930 return $sum; 2931} 2932 2933sub Played 2934{ return unless defined $PlayingID; 2935 my $ID=$PlayingID; 2936 warn "Played : $ID $StartTime $StartedAt $PlayTime\n" if $debug; 2937 AddToRecent($ID) unless $Options{AddNotPlayedToRecent}; 2938 return unless defined $PlayTime; 2939 push @Played_segments, $StartedAt, $PlayTime; 2940 my $seconds=Coverage(@Played_segments); # a bit overkill :) 2941 2942 my $length= Songs::Get($ID,'length'); 2943 my $coverage_ratio= $length ? $seconds / Songs::Get($ID,'length') : 1; 2944 my $partial= $Options{PlayedMinPercent}/100 > $coverage_ratio && $Options{PlayedMinSeconds} > $seconds; 2945 HasChanged('Played',$ID, !$partial, $StartTime, $seconds, $coverage_ratio, \@Played_segments); 2946 $PlayingID=undef; 2947 @Played_segments=(); 2948 2949 if ($partial) #FIXME maybe only count as a skip if played less than ~20% ? 2950 { my $nb= 1+Songs::Get($ID,'skipcount'); 2951 Songs::Set($ID, skipcount=> $nb, lastskip=> $StartTime, '+skiphistory'=>$StartTime); 2952 } 2953 else 2954 { my $nb= 1+Songs::Get($ID,'playcount'); 2955 Songs::Set($ID, playcount=> $nb, lastplay=> $StartTime, '+playhistory'=>$StartTime); 2956 } 2957} 2958 2959our %PPSQ_Icon; 2960INIT 2961{ %PPSQ_Icon= 2962 ( play => ['gtk-media-play', '<span font_family="Sans">▶</span>'], 2963 pause => ['gtk-media-pause','<span font_family="Sans">▮▮</span>'], 2964 stop => ['gtk-media-stop', '<span font_family="Sans">■</span>'], 2965 ); 2966} 2967sub Get_PPSQ_Icon #for a given ID, returns the Play, Pause, Stop or Queue icon, or undef if none applies 2968{ my ($ID,$notcurrent,$text)=@_; 2969 my $currentsong= !$notcurrent && defined $SongID && $ID==$SongID; 2970 my $status; 2971 if ($currentsong) # playing or paused or stopped 2972 { $status= $TogPlay ? 'play' : 2973 defined $TogPlay ? 'pause': 2974 'stop'; 2975 $status= $PPSQ_Icon{$status}[$text ? 1 : 0]; 2976 } 2977 elsif (@$Queue && $Queue->IsIn($ID)) #queued 2978 { my $n; 2979 if ($NBQueueIcons || $text) 2980 { my $max= $NBQueueIcons||10; 2981 $max= @$Queue unless $max < @$Queue; 2982 $n= first { $Queue->[$_]==$ID } 0..$max-1; 2983 } 2984 if ($text) { $status= defined $n ? "<b>Q<sup><small>".($n+1)."</small></sup></b>" : "<b>Q<sup><small>+</small></sup></b>"; } 2985 else { $status= defined $n ? "gmb-queue".($n+1) : 'gmb-queue0'; } 2986 } 2987 return $status; 2988} 2989 2990sub ClearQueue 2991{ $Queue->Replace(); 2992 #$QueueAction=''; 2993 #HasChanged('QueueAction'); 2994} 2995 2996sub EnqueueSame 2997{ my ($field,$ID)=@_; 2998 my $filter=Songs::MakeFilterFromID($field,$ID); 2999 EnqueueFilter($filter); 3000} 3001sub EnqueueFilter 3002{ my $l=$_[0]->filter; 3003 Enqueue(@$l); 3004} 3005sub Enqueue 3006{ my @l=@_; 3007 SortList(\@l) if @l>1; 3008 @l=grep $_!=$SongID, @l if @l>1 && defined $SongID; 3009 $Queue->Push(\@l); 3010 # ToggleLock($TogLock) if $TogLock; #unset lock 3011} 3012sub QueueInsert 3013{ my @l=@_; 3014 SortList(\@l) if @l>1; 3015 @l=grep $_!=$SongID, @l if @l>1 && defined $SongID; 3016 $Queue->Unshift(\@l); 3017} 3018sub ReplaceQueue 3019{ $Queue->Replace(); 3020 &Enqueue; #keep @_ 3021} 3022sub SetNextAction 3023{ $NextAction=shift; 3024 HasChanged('QueueAction'); 3025} 3026sub EnqueueAction 3027{ $QueueAction=shift; 3028 HasChanged('QueueAction'); 3029} 3030sub QAutoFill 3031{ return unless $QueueAction eq 'autofill'; 3032 my $nb=$Options{MaxAutoFill}-@$Queue; 3033 return unless $nb>0; 3034 # FIXME shuffle list if !$RandomMode instead of using Random ? 3035 my $random= $RandomMode || Random->new('random:',$ListPlay); 3036 my @IDs=$random->Draw($nb,$Queue); 3037 return unless @IDs; 3038 $Queue->Push(\@IDs); 3039} 3040sub QWaitAutoPlay 3041{ return unless $QueueAction eq 'wait'; 3042 return if $TogPlay || !@$Queue; 3043 Select(song => ($Queue->Shift), play=>1); 3044} 3045sub QueueChanged 3046{ if ($QueueAction && $QActions{$QueueAction}) 3047 { my $cb= $QActions{$QueueAction}{changed}; 3048 IdleDo('1_QAuto',10,$cb) if $cb; 3049 } 3050} 3051sub Update_QueueActionList 3052{ if ($QueueAction) #check if current one is still valid 3053 { my $ok; 3054 if (my $prop= $QActions{$QueueAction}) 3055 { my $condition= $prop->{condition}; 3056 $ok=1 if !$condition || $condition->(); 3057 } 3058 EnqueueAction('') unless $ok; 3059 } 3060 QHasChanged('QueueActionList'); 3061} 3062sub List_QueueActions 3063{ my $nextonly=shift; 3064 my @list= grep { !$QActions{$_}{condition} || $QActions{$_}{condition}() } keys %QActions; 3065 if ($nextonly) { @list= grep $QActions{$_}{can_next}, @list; } 3066 return sort {$QActions{$a}{order} <=> $QActions{$b}{order} || $a cmp $b} @list; 3067} 3068 3069sub GetNeighbourSongs 3070{ my $nb=shift; 3071 $ListPlay->UpdateSort if $ToDo{'8_resort_playlist'}; 3072 my $pos=$Position||0; 3073 my $begin=$pos-$nb; 3074 my $end=$pos+$nb; 3075 $begin=0 if $begin<0; 3076 $end=$#$ListPlay if $end>$#$ListPlay; 3077 return @$ListPlay[$begin..$end]; 3078} 3079 3080sub PrevSongInPlaylist 3081{ $ListPlay->UpdateSort if $ToDo{'8_resort_playlist'}; 3082 my $pos=$Position; 3083 if (!defined $pos) { $pos=0; if ($RandomMode) {} } #FIXME PHASE1 in case random 3084 if ($pos==0) 3085 { return unless $Options{Repeat}; 3086 $pos=$#$ListPlay; 3087 } 3088 else { $pos--; } 3089 SetPosition($pos); 3090} 3091sub NextSongInPlaylist 3092{ $ListPlay->UpdateSort if $ToDo{'8_resort_playlist'}; 3093 my $pos=$Position; 3094 if (!defined $pos) { $pos=0; if ($RandomMode) {} } #FIXME PHASE1 in case random 3095 if ($pos==$#$ListPlay) 3096 { return unless $Options{Repeat}; 3097 $pos=0; 3098 } 3099 else { $pos++ } 3100 SetPosition($pos); 3101} 3102 3103sub GetNextSongs ##if no aguments, returns next song and makes the changes assuming it is to become next song (remove it from queue, ...) 3104{ my ($nb,$onlyIDs)=@_; # if $nb is defined : passive query, do not make any change to queue or other things 3105 my $passive= defined $nb ? 1 : 0; 3106 $nb||=1; 3107 my @IDs; 3108 { if ($NextAction) 3109 { push @IDs, ($passive ? $QActions{$NextAction}{short} : $NextAction) unless $onlyIDs; 3110 unless ($passive || $QActions{$NextAction}{keep}) { SetNextAction('') } 3111 last; 3112 } 3113 if (@$Queue) 3114 { unless ($passive) { my $ID=$Queue->Shift; return $ID; } 3115 push @IDs,_"Queue" unless $onlyIDs; 3116 if ($nb>@$Queue) { push @IDs,@$Queue; $nb-=@$Queue; } 3117 else { push @IDs,@$Queue[0..$nb-1]; last; } 3118 } 3119 if ($QueueAction) 3120 { push @IDs, ($passive ? $QActions{$QueueAction}{short} : $QueueAction) unless $onlyIDs; 3121 unless ($passive || $QActions{$QueueAction}{keep}) { EnqueueAction('') } 3122 last; 3123 } 3124 return unless @$ListPlay; 3125 $ListPlay->UpdateSort if $ToDo{'8_resort_playlist'}; 3126 if ($RandomMode) 3127 { push @IDs,_"Random" if $passive && !$onlyIDs; 3128 push @IDs,$RandomMode->Draw($nb,((defined $SongID && @$ListPlay>1)? [$SongID] : undef)); 3129 last; 3130 } 3131 my $pos; 3132 $pos=FindPositionSong( $IDs[-1],$ListPlay ) if @IDs; 3133 $pos= defined $Position ? $Position : -1 unless defined $pos; 3134 if ($pos==-1 && !$ListMode) 3135 { my $ID= @IDs ? $IDs[-1] : $::SongID; 3136 if (defined $ID) 3137 { $ID= Songs::FindNext($ListPlay, $Options{Sort}, $ID); 3138 $pos=FindPositionSong( $ID,$ListPlay ); 3139 $pos=-1 if !defined $pos; 3140 } 3141 } 3142 push @IDs,_"Next" if $passive && !$onlyIDs; 3143 while ($nb) 3144 { if ( $pos+$nb > $#$ListPlay ) 3145 { push @IDs,@$ListPlay[$pos+1..$#$ListPlay]; 3146 last unless $Options{Repeat}; #FIXME repeatlock modes 3147 $nb-=$#$ListPlay-$pos; 3148 $pos=-1; 3149 } 3150 else { push @IDs,@$ListPlay[$pos+1..$pos+$nb]; last; } 3151 } 3152 } 3153 return wantarray ? @IDs : $IDs[0]; 3154} 3155 3156sub PrepNextSongs 3157{ if ($NextAction) { @NextSongs=() } 3158 elsif ($RandomMode) { @NextSongs=@$Queue; $#NextSongs=9 if $#NextSongs>9; } 3159 else 3160 { @NextSongs= GetNextSongs(10,'onlyIDs'); 3161 } 3162 my $nextID=$NextSongs[0]; 3163 $NextFileToPlay= defined $nextID ? Songs::GetFullFilename($nextID) : undef; 3164 warn "Next file to play : $::NextFileToPlay\n" if $::debug; 3165 ::HasChanged('NextSongs'); 3166} 3167sub QueueUpdateNextSongs 3168{ IdleDo('2_PrepNextSongs',100,\&PrepNextSongs); 3169 $NextFileToPlay=undef; @NextSongs=(); 3170} 3171 3172sub GetPrevSongs 3173{ my $nb=shift||1; 3174 my $list=($nb>1)? 1 : 0; 3175 my @IDs; 3176 push @IDs,_"Recently played" if $list; 3177 if ($nb>@$Recent) { push @IDs,@$Recent; } 3178 else { push @IDs,@$Recent[0..$nb-1]; } 3179 return $list ? @IDs : $IDs[0]; 3180} 3181 3182sub PrevSong 3183{ #my $ID=GetPrevSongs(); 3184 return if @$Recent==0; 3185 $RecentPos||=0; 3186 if ($SongID==$Recent->[$RecentPos]) {$RecentPos++} 3187 my $ID=$Recent->[$RecentPos]; 3188 return unless defined $ID; 3189 $RecentPos++; 3190 Select(song => $ID); 3191} 3192sub NextSong 3193{ my $ID=GetNextSongs(); 3194 if (!defined $ID) { Stop(); return; } 3195 if ($ID=~m/^\D/) { my $prop=$QActions{$ID}; $prop->{action}() if $prop && $prop->{action}; return } 3196 my $pos=$Position; 3197 if ( defined $pos && $pos<$#$ListPlay && $ListPlay->[$pos+1]==$ID ) { SetPosition($pos+1); } 3198 else { Select(song => $ID); } 3199} 3200sub NextDiff #go to next song whose $field value is different than current's 3201{ my $field=$_[0]; 3202 if (!defined $SongID) { NextSong(); return} 3203 my $filter= Songs::MakeFilterFromID($field,$SongID)->invert; 3204 if (@$Queue) 3205 { my $list=$filter->filter($Queue); 3206 if (@$list) 3207 { my $ID=$list->[0]; 3208 my $row=first { $Queue->[$_]==$ID } 0..$#$Queue; 3209 $Queue->Remove([0..$row]); 3210 Select(song => $ID); 3211 return 3212 } 3213 else { $Queue->Replace(); } #empty queue if not matching song in it 3214 } 3215 # look at $QueueAction ? #FIXME 3216 my $playlist=$ListPlay; 3217 my $position=$Position||0; 3218 if ($TogLock && $TogLock eq $field) #remove lock on a different field if not found ? 3219 { $playlist=$SelectedFilter->filter; 3220 SortList($playlist) unless $RandomMode; 3221 $position=FindPositionSong($SongID,$playlist); 3222 } 3223 my $list; 3224 if ($RandomMode) { $list= $filter->filter($playlist); } 3225 else 3226 { my @rows=$position..$#$playlist; 3227 push @rows, 0..$position-1 if $Options{Repeat}; 3228 @$list=map $playlist->[$_], @rows; 3229 $list=$filter->filter($list); 3230 } 3231 if (@$list) #there is at least one matching song 3232 { my $ID; 3233 if ($RandomMode) 3234 { ($ID)=Random->OneTimeDraw($RandomMode,$list,1); 3235 } 3236 else { $ID=$list->[0]; } 3237 Select(song => $ID); 3238 } 3239 else { Stop(); } #no matching song found in playlist => Stop (or do nothing ?) 3240} 3241 3242sub ToggleLock 3243{ my ($col,$set)=@_; 3244 if ($set || !$TogLock || $TogLock ne $col) 3245 { $TogLock=$col; 3246 #&ClearQueue; 3247 } 3248 else {undef $TogLock} 3249 $ListPlay->UpdateLock; 3250 HasChanged('Lock'); 3251} 3252 3253sub SetRepeat 3254{ $::Options{Repeat}=$_[0]||0; 3255 ::HasChanged('Repeat'); 3256} 3257 3258sub DoActionForFilter 3259{ my ($action,$filter)=@_; 3260 $filter||= Filter->new; 3261 $action||='play'; 3262 if ($action eq 'play') { Select( filter=>$filter, song=>'first',play=>1 ); } 3263 else { DoActionForList($action,$filter->filter); } 3264} 3265sub DoActionForList 3266{ my ($action,$list)=@_; 3267 return unless ref $list && @$list; 3268 $action||='playlist'; 3269 my @list=@$list; 3270 # actions that don't need/want the list to be sorted (Enqueue will sort it itself) 3271 if ($action eq 'queue') { Enqueue(@list) } 3272 elsif ($action eq 'queueinsert') { QueueInsert(@list) } 3273 elsif ($action eq 'replacequeue') { ReplaceQueue(@list) } 3274 elsif ($action eq 'properties') { DialogSongsProp(@list) } 3275 else 3276 { # actions that need the list to be sorted 3277 SortList(\@list) if @list>1; 3278 if ($action eq 'playlist') { $ListPlay->Replace(\@list); } 3279 elsif ($action eq 'addplay') { $ListPlay->Push(\@list); } 3280 elsif ($action eq 'insertplay') { $ListPlay->InsertAtPosition(\@list); } 3281 else { warn "Unknown action '$action'\n"; } 3282 } 3283} 3284 3285sub SongArray_changed 3286{ my (undef,$songarray,$action,@extra)=@_; 3287 if ($songarray->isa('SongArray::Named')) { Songs::Changed(undef,'list'); } # simulate modifcation of the fake "list" field 3288 if ($songarray==$Queue) 3289 { HasChanged('Queue',$action,@extra); 3290 } 3291 elsif ($songarray==$Recent) { IdleDo('2_RecentSongs',750,\&HasChanged,'RecentSongs'); } 3292 elsif ($songarray==$ListPlay) 3293 { HasChanged('Playlist',$action,@extra); 3294 } 3295} 3296 3297sub ToggleSort 3298{ my $s= ($RandomMode || $Options{Sort}=~m/shuffle/) ? $Options{Sort_LastOrdered} : $Options{Sort_LastSR}; 3299 Select('sort' => $s); 3300} 3301sub Select_sort {Select('sort' => $_[0])} 3302#CHECKME if everything works with sort="", with source with empty Library with !defined $SongID implement row=> or pos=> 3303sub Select #Set filter, sort order, selected song, playing state, staticlist, source 3304{ my %args=@_; 3305#::callstack(@_); 3306 my ($filter,$sort,$song,$staticlist,$pos)=@args{qw/filter sort song staticlist position/}; 3307 $SongID=undef if $song && $song eq 'first'; 3308 $song=undef if $song && $song=~m/\D/; 3309 if (defined $filter) 3310 { if ($song) { $SongID=$song; $ChangedID=$ChangedPos=1; } 3311 $filter= Filter->new($filter) unless ref $filter; 3312 if ($sort) { $ListPlay->SetSortAndFilter($sort,$filter) } 3313 else { $ListPlay->SetFilter($filter); } 3314 } 3315 elsif (defined $sort) { $ListPlay->Sort($sort) } 3316 elsif ($staticlist) 3317 { if (defined $pos) { $Position=$pos; $SongID=$staticlist->[$pos]; $ChangedID=$ChangedPos=1; } 3318 $ListPlay->Replace($staticlist); 3319 } 3320 elsif (defined $song) { $ListPlay->SetID($song) } 3321 elsif (defined $pos) { SetPosition($pos) } 3322 Play() if $args{play} && !$TogPlay; 3323} 3324 3325sub SetPosition 3326{ $Position=shift; 3327 #check within bounds ? 3328 $SongID=$ListPlay->[$Position]; 3329 $ChangedPos=$ChangedID=1; 3330 UpdateCurrentSong(); 3331} 3332sub UpdateCurrentSong 3333{ #my $force=shift; 3334 if ($ChangedID) 3335 { AddToRecent($prevID) if defined $prevID && $Options{AddNotPlayedToRecent}; 3336 $prevID=$SongID; 3337 QHasChanged('CurSongID',$SongID); 3338 QHasChanged('CurSong',$SongID); 3339 ShowTraytip($Options{TrayTipTimeLength}) if $TrayIcon && $Options{ShowTipOnSongChange} && !$FullscreenWindow; 3340 IdleDo('CheckCurrentSong',1000,\&CheckCurrentSong) if defined $SongID; 3341 if (defined $RecentPos && (!defined $SongID || $SongID!=$Recent->[$RecentPos-1])) { $RecentPos=undef } 3342 $ChangedPos=1; 3343 } 3344 if ($ChangedPos) 3345 { if (!defined $SongID || $RandomMode) { $Position=undef; } 3346 elsif (!defined $Position || $ListPlay->[$Position]!=$SongID) 3347 { my $start=$Position; 3348 $start=-1 unless defined $start; 3349 $Position=undef; 3350 for my $i ($start+1..$#$ListPlay, 0..$start-1) {$Position=$i if $ListPlay->[$i]==$SongID} 3351 } 3352 QHasChanged('Pos','song'); 3353 } 3354 # Stop(); if !defined $SongID ??????? 3355 #if ($forceplay) {Play()} 3356 if ($ChangedID) 3357 { if ($TogPlay) {Play()} 3358 elsif (defined $TogPlay) {Stop()} 3359 } 3360 $ChangedID=$ChangedPos=0; 3361} 3362 3363#sub UpdateSongID #CHECKME use -1 instead of undef for Position ??? 3364#{ my ($type,$ID,$force)=@_; 3365#::callstack(@_); 3366# if ($type eq 'position') 3367# { if ($ID!=$Position || $force) { $ChangedPos=1; $Position=$ID; } 3368# $ID=$ListPlay->[$ID]; 3369# } 3370# if (!defined $ID) 3371# { $ChangedID=$ChangedPos=1; 3372# $Position=$SongID=undef; 3373# Stop(); 3374# } 3375# elsif (!defined $SongID || $ID!=$SongID) 3376# { $ChangedID=1; $SongID=$ID; 3377# IdleCheck($SongID) if $Options{TAG_auto_check_current}; 3378# if (defined $RecentPos && (!defined $SongID || $SongID!=$Recent->[$RecentPos-1])) { $RecentPos=undef } 3379# } 3380# if ($RandomMode) { $Position=undef; $ChangedPos=1; } 3381# elsif ($type ne 'position' && (!defined $Position || $ListPlay->[$Position]!=$SongID)) 3382# { my $start=$Position; 3383# $Position=undef; 3384# for my $i ($start+1..$#$ListPlay, 0..$start-1) {$Position=$i if $ListPlay->[$i]==$SongID} 3385# $ChangedPos=1; 3386# } 3387# if ($ChangedID) 3388# { HasChanged('CurSong',$SongID); 3389# ShowTraytip($Options{TrayTipTimeLength}) if $TrayIcon && $Options{ShowTipOnSongChange} && !$FullscreenWindow; 3390# } 3391# if ($ChangedPos) 3392# { HasChanged('Pos','song'); 3393# } 3394# if ( $force || $ChangedID ) 3395# { if ($TogPlay) {Play()} 3396# elsif (defined $TogPlay) {Stop()} 3397# } 3398# $ChangedID=$ChangedPos=0; 3399#} 3400 3401sub IDIsInList 3402{ my ($list,$ID)=@_; 3403 return $list->IsIn($ID) unless ref $list eq 'ARRAY'; 3404 ($list->[$_]==$ID) and return 1 for 0..$#$list; 3405 return 0; 3406} 3407sub FindPositionSong #DELME 3408{ my ($ID,$list)=@_; 3409 return undef unless defined $ID; 3410 for my $i (0..$#$list) {return $i if $list->[$i]==$ID} 3411 return undef; #not found 3412} 3413sub FindFirstInListPlay #Choose a song in @$lref based on sort order, if possible in the current playlist. In sorted order, choose a song after current song 3414{ my $lref=shift; 3415 my $sort=$Options{Sort}; 3416 my $ID; 3417 my %h; 3418 $h{$_}=undef for @$lref; 3419 my @l=grep exists $h{$_}, @$ListPlay; 3420 if ($sort=~m/^random:/) 3421 { $lref=\@l if @l; 3422 ($ID)=Random->OneTimeDraw($sort,$lref,1); 3423 $ID=$lref->[ int(rand(scalar@$lref)) ] unless defined $ID; 3424 } 3425 else 3426 { @l=@$lref unless @l; 3427 push @l,$SongID if defined $SongID && !exists $h{$SongID}; 3428 SortList(\@l); 3429 if (defined $SongID) 3430 { for my $i (0..$#l-1) 3431 { next if $l[$i]!=$SongID; $ID=$l[$i+1]; last; } 3432 } 3433 $ID=$l[0] unless defined $ID; 3434 } 3435 return $ID; 3436} 3437 3438sub Shuffle 3439{ Songs::ReShuffle() if $Options{Sort} eq 'shuffle'; 3440 Select('sort' => 'shuffle'); 3441} 3442 3443sub SortList #sort @$listref according to current sort order, or last ordered sort if no current sort order 3444{ my $listref=shift; 3445 my $sort=$Options{Sort}; 3446 if ($sort=~m/^random:/) 3447 { @$listref=Random->OneTimeDraw($sort,$listref); 3448 } 3449 else # generate custom sort function 3450 { $sort=$Options{Sort_LastOrdered} if $sort eq ''; 3451 Songs::SortList($listref,$sort); 3452 } 3453} 3454 3455sub ExplainSort 3456{ my ($sort,$usename)=@_; 3457 return _"no order" if $sort eq ''; 3458 my $rand= $sort=~m/^random:/; 3459 3460 if ($usename || $rand) 3461 { my $h= $rand ? $Options{SavedWRandoms} : $Options{SavedSorts}; 3462 for my $name (sort keys %$h) 3463 { return $name if $h->{$name} eq $sort; 3464 } 3465 } 3466 if ($rand) { return _"unnamed random mode"; } #describe ? 3467 3468 my @text; 3469 for my $f (split / /,$sort) 3470 { my $field= $f=~s/^-// ? '-' : ''; 3471 my $i= $f=~s/:i$//; 3472 $field.= Songs::FieldName($f); 3473 $field.=_"(case insensitive)" if $i; 3474 push @text,$field; 3475 } 3476 return join ', ',@text; 3477} 3478 3479sub ReReadTags 3480{ my $state=Gtk2->get_current_event_state; 3481 if ( @_ && $state && $state >= ['shift-mask'] ) { $ToCheckLength->add(\@_); } 3482 else 3483 { my $ref= @_ ? \@_ : $Library; 3484 $ToReRead->add($ref); 3485 } 3486 &launchIdleLoop; 3487} 3488sub CheckCurrentSong 3489{ return unless defined $::SongID; 3490 my $lengthcheck= $Options{LengthCheckMode} eq 'current' || $Options{LengthCheckMode} eq 'add' ? 2 : 0; 3491 Songs::ReReadFile($::SongID,$lengthcheck, !$Options{AutoRemoveCurrentSong} ); 3492} 3493sub CheckLength 3494{ my $ref= @_ ? \@_ : Filter->new('length_estimated:e:1')->filter; 3495 $ToCheckLength->add($ref); 3496 &launchIdleLoop; 3497} 3498sub IdleCheck 3499{ my $ref= @_ ? \@_ : $Library; 3500 $ToCheck->add($ref); 3501 &launchIdleLoop; 3502} 3503sub IdleScan 3504{ @_=map decode_url($_), @{$Options{LibraryPath}} unless @_; 3505 push @ToScan,@_; 3506 &launchIdleLoop; 3507} 3508 3509sub IdleDo 3510{ my $task_id=shift; 3511 my $timeout=shift; 3512 $ToDo{$task_id}=\@_; 3513 $TimeOut{$task_id}||=Glib::Timeout->add($timeout,\&DoTask,$task_id) if $timeout; 3514 &launchIdleLoop unless defined $IdleLoop; 3515} 3516sub DoTask 3517{ my $task_id=shift; 3518 delete $TimeOut{$task_id}; 3519 my $aref=delete $ToDo{$task_id}; 3520 if ($aref) 3521 { my $sub=shift @$aref; 3522 $sub->(@$aref); 3523 } 3524 0; 3525} 3526 3527sub launchIdleLoop 3528{ $IdleLoop||=Glib::Idle->add(\&IdleLoop); 3529} 3530 3531sub IdleLoop 3532{ if (@$ToCheck) 3533 { CheckProgress_cb(1) unless $CheckProgress_cb; 3534 Songs::ReReadFile($ToCheck->next); 3535 } 3536 elsif (@$ToReRead) 3537 { CheckProgress_cb(1) unless $CheckProgress_cb; 3538 Songs::ReReadFile($ToReRead->next,1); 3539 } 3540 elsif (@ToAdd_Files) { SongAdd(shift @ToAdd_Files); } 3541 elsif (@ToAdd_IDsBuffer>1000) { SongAdd_now() } 3542 elsif (@ToScan) { $ProgressNBFolders++; ScanFolder(shift @ToScan); } 3543 elsif (@ToAdd_IDsBuffer) { SongAdd_now() } 3544 elsif (%ToDo) { DoTask( (sort keys %ToDo)[0] ); } 3545 elsif (@$ToCheckLength) #to replace estimated length/bitrate by real one(for mp3s without VBR header) 3546 { CheckProgress_cb(1) unless $CheckProgress_cb; 3547 Songs::ReReadFile( $ToCheckLength->next, 3); 3548 } 3549 else 3550 { $ProgressNBFolders=$ProgressNBSongs=0; 3551 undef $Songs::IDFromFile; 3552 undef $Songs::MissingHash; 3553 3554 warn "IdleLoop End\n" if $debug; 3555 undef $IdleLoop; 3556 } 3557 return $IdleLoop; 3558} 3559 3560sub OpenBrowser 3561{ OpenSpecialWindow('Browser'); 3562} 3563sub ContextWindow 3564{ OpenSpecialWindow('Context'); 3565} 3566sub EditQueue 3567{ OpenSpecialWindow('Queue'); 3568} 3569sub OpenSpecialWindow 3570{ my ($type,$toggle)=@_; 3571 my $layout= $type eq 'Browser' ? $Options{LayoutB} : $type; 3572 my $ifexist= $toggle ? 'toggle' : 'present'; 3573 Layout::Window->new($layout, ifexist => $ifexist, uniqueid=>$type); 3574} 3575 3576sub SetFullScreenMode 3577{ ToggleFullscreenLayout() if $_[0] xor $FullscreenWindow; 3578} 3579sub ToggleFullscreenLayout 3580{ if ($FullscreenWindow) 3581 { $FullscreenWindow->close_window; 3582 } 3583 else 3584 { $FullscreenWindow=Layout::Window->new($Options{LayoutF},fullscreen=>1); 3585 $FullscreenWindow->signal_connect(destroy => sub { $FullscreenWindow=undef; }); 3586 if ($Options{StopScreensaver} && findcmd('xdg-screensaver')) 3587 { my $h={ XID => $FullscreenWindow->window->XID}; 3588 my $sub=sub 3589 { my $p=$TogPlay; 3590 $p=0 if $h->{destroy} || !$Options{StopScreensaver}; 3591 if ($p xor $h->{ScreenSaverStopped}) 3592 { my $cmd= $p ? 'suspend' : 'resume'; 3593 $cmd="xdg-screensaver $cmd ".$h->{XID}; 3594 warn $cmd if $debug; 3595 system $cmd; 3596 $h->{ScreenSaverStopped}=$TogPlay; 3597 } 3598 }; 3599 &$sub(); 3600 Watch($h, Playing=> $sub); 3601 $FullscreenWindow->signal_connect(destroy => sub { UnWatch($h,'Playing'); $h->{destroy}=1; &$sub(); }); 3602 } 3603 } 3604 HasChanged('FullScreen',!!$FullscreenWindow); 3605} 3606 3607sub WEditList 3608{ my $name=$_[0]; 3609 my ($window)=grep exists $_->{editing_listname} && $_->{editing_listname} eq $name, Gtk2::Window->list_toplevels; 3610 if ($window) { $window->force_present; return; } 3611 $SongList::Common::EditList=$name; #list that will be used by SongList/SongTree in 'editlist' mode 3612 $window=Layout::Window->new('EditList', 'pos'=>undef); 3613 $SongList::Common::EditList=undef; 3614 $window->{editing_listname}=$name; 3615 Watch($window, SavedLists => sub #close window if the list is deleted, update title if renamed 3616 { my ($window,$name,$info,$newname)=@_; 3617 return if $window->{editing_listname} ne $name; 3618 return unless $info; 3619 my $songlist=$window->{widgets}{SongList}; 3620 if ($info eq 'renamedto') 3621 { $window->set_title( _("Editing list : ").$newname ); 3622 $window->{editing_listname}=$newname; 3623 } 3624 elsif ($info eq 'remove') 3625 { $window->close_window 3626 } 3627 }); 3628 $window->set_title( _("Editing list : ").$name ); 3629} 3630 3631sub CalcListLength #if $return, return formated string (0h00m00s) 3632{ my ($listref,$return)=@_; 3633 my ($size,$sec)=Songs::ListLength($listref); 3634 warn 'ListLength: '.scalar @$listref." Songs, $sec sec, $size bytes\n" if $debug; 3635 $size=sprintf '%.0f',$size/MB(); 3636 my $m=int($sec/60); $sec=sprintf '%02d',$sec%60; 3637 my $h=int($m/60); $m=sprintf '%02d',$m%60; 3638 my $nb=@$listref; 3639 my @values=(hours => format_number($h), min =>$m, sec =>$sec, size => format_number($size)); 3640 my $MB=_"MB"; 3641 if ($return eq 'long') 3642 { my $format= $h? _"{hours} hours {min} min {sec} s" : _"{min} min {sec} s"; 3643 return __n("%d song","%d songs",$nb) .', '. __x($format." ({size} $MB)", @values); 3644 } 3645 elsif ($return eq 'short') 3646 { my $format= $h? _"{hours}h {min}m {sec}s" : _"{min}m {sec}s"; 3647 return __n("%d song","%d songs",$nb) .', '.__x($format." ({size}$MB)", @values); 3648 } 3649 elsif ($return eq 'queue') 3650 { return _"Queue empty" if $nb==0; 3651 my $format= $h? _"{hours}h {min}m {sec}s" : _"{min}m {sec}s"; 3652 return __n("%d song in queue","%d songs in queue",$nb) .' ('. __x($format, @values) . ')'; 3653 } 3654 else 3655 { my $format= $h? _"{hours}h {min}m {sec}s" : _"{min}m {sec}s"; 3656 return __x($format." ({size} $MB)", @values); 3657 } 3658} 3659 3660# http://www.allmusic.com/search/artist/%s artist search 3661# http://www.allmusic.com/search/album/%s album search 3662sub AMGLookup 3663{ my ($col,$key)=@_; 3664 my $opt1= $col eq 'artist' ? 'artist' : 3665 $col eq 'album' ? 'album' : 3666 $col eq 'title' ? 'song' : ''; 3667 return unless $opt1; 3668 my $url='http://www.allmusic.com/search/'.$opt1.'/'; 3669 $key=url_escape($key); 3670 openurl($url.$key); 3671} 3672 3673sub Google 3674{ my $ID=shift; 3675 my $lang=''; 3676 $lang="hl=$1&" if setlocale(LC_MESSAGES)=~m/^([a-z]{2})(?:_|$)/; 3677 my $url='http://google.com/search?'.$lang."q="; 3678 my @q=grep $_ ne '', Songs::Get($ID,qw/title_or_file artist album/); 3679 $url.=url_escape(join('+',@q)); 3680 openurl($url); 3681} 3682sub openurl 3683{ my $url=shift; 3684 if ($^O eq 'MSWin32') { system "start $url"; return } 3685 $browsercmd||=findcmd($Options{OpenUrl},qw/xdg-open gnome-open firefox epiphany konqueror galeon/); 3686 unless ($browsercmd) { ErrorMessage(_"No web browser found."); return } 3687 $url=quotemeta $url; 3688 system "$browsercmd $url &"; #FIXME if xdg-open is used, don't launch with "&" and check error code 3689} 3690sub openfolder 3691{ my $dir=shift; 3692 if ($^O eq 'MSWin32') { system qq(start "$dir"); return } #FIXME if $dir contains " 3693 $opendircmd||=findcmd($Options{OpenFolder},qw/xdg-open gnome-open nautilus konqueror thunar/); 3694 unless ($opendircmd) { ErrorMessage(_"No file browser found."); return } 3695 run_system_cmd([$opendircmd,$dir],undef,1); 3696} 3697sub findcmd 3698{ for my $cmd (grep defined,@_) 3699 { my $exe= (split / /,$cmd)[0]; 3700 next unless grep -x $_.SLASH.$exe, split /:/, $ENV{PATH}; 3701 return $cmd; 3702 } 3703 return undef; 3704} 3705 3706sub ChooseAAPicture 3707{ my ($ID,$col,$key)=@_; 3708 my $path; 3709 if (defined $ID) { $path=Songs::Get($ID,'path'); } 3710 else { $path= AA::GuessBestCommonFolder($col,$key); } 3711 my $title= sprintf(_"Choose picture for '%s'",Songs::Gid_to_Display($col,$key)); 3712 my $file=ChoosePix($path,$title, AAPicture::GetPicture($col,$key)); 3713 AAPicture::SetPicture($col,$key,$file) if defined $file; 3714} 3715 3716sub ChooseSongsTitle #Songs with the same title 3717{ my $ID=$_[0]; 3718 my $filter=Songs::MakeFilterFromID('title',$ID); 3719 my $list= $filter->filter; 3720 return 0 if @$list<2 || @$list>100; #probably a problem if it finds >100 matching songs, and making a menu with a huge number of items is slow 3721 my @list=grep $_!=$ID,@$list; 3722 Songs::SortList(\@list,'artist:i album:i'); 3723 return ChooseSongs( \@list, markup=> __x( _"by {artist} from {album}", artist => "<b>%a</b>", album => "%l")."<i>%V</i>"); #FIXME show version in a better way 3724} 3725 3726sub ChooseSongsFromA #FIXME limit the number of songs if HUGE number of songs (>100-200 ?) 3727{ my ($album,%opt)=@_; 3728 return unless defined $album; 3729 my $list= AA::GetIDs(album=>$album); 3730 Songs::SortList($list,'disc track file'); 3731 if (1 || Songs::Get($list->[0],'disc')) 3732 { my $disc=''; my @list2; 3733 for my $ID (@$list) 3734 { my $d=Songs::Get($ID,'disc'); 3735 if ($d && $d ne $disc) 3736 { push @list2,__x(_"disc {disc}",disc =>$d); 3737 $disc=$d; 3738 if (Songs::FieldEnabled('discname')) 3739 { my $name=Songs::Get($ID,'discname'); 3740 $list2[-1].=" : $name" if length $name; 3741 } 3742 } 3743 push @list2,$ID; 3744 } 3745 $list=\@list2; 3746 } 3747 my $menu = ChooseSongs($list, markup=>'%n %S<small>%V</small>', cb=>$opt{cb}); 3748 $menu->show_all; 3749 unless ($opt{nocover}) 3750 { my $h=$menu->size_request->height; 3751 my $w=$menu->size_request->width; 3752 my $maxwidth= $menu->get_screen->get_width; 3753 my $cols= $menu->{cols}; #array containing the number of entries in each column of the menu 3754 my $nbcols= @$cols; 3755 my $height= max(@$cols); 3756 my $picsize= $w/$nbcols; 3757 if ($maxwidth > $picsize*($nbcols+1)) # check if fits in the screen 3758 { $picsize=200 if $picsize<200 && $maxwidth > 200*($nbcols+1); 3759 #$picsize=$h if $picsize>$h; 3760 if ( my $img= AAPicture::newimg(album=>$album, $picsize) ) 3761 { my $item=Gtk2::MenuItem->new; 3762 $item->add($img); 3763 my $row0=0; 3764 if ($w>$h && $nbcols==1) # if few songs put the cover below 3765 { $nbcols=0; 3766 $row0= $height; 3767 } 3768 $menu->attach($item, $nbcols, $nbcols+1, $row0, $height+1); 3769 $item->signal_connect(enter_notify_event=> sub {1}); 3770 $item->show_all; 3771 } 3772 } 3773 } 3774 3775=old tests for cover 3776 elsif (0) #TEST not used 3777 { my $picsize=$menu->size_request->height; 3778 $picsize=220 if $picsize>220; 3779 if ( my $img= AAPicture::newimg(album=>$album, $picsize) ) 3780 { my $item=Gtk2::MenuItem->new; 3781 $item->add($img); 3782 my $col= @{$menu->{cols}}; 3783 #$menu->attach($item, $col, $col+1, 0, scalar @$list); 3784 $item->show_all; 3785 $menu->signal_connect(size_request => sub {my ($self,$req)=@_;warn $req->width;return if $self->{busy};$self->{busy}=1;my $rw=$self->get_toplevel->size_request->width;$self->get_toplevel->set_size_request($rw+$picsize,-1);$self->{busy}=undef;}); 3786 my $sub=sub {my ($self,$alloc)=@_;warn $alloc->width;return if $self->{done};$alloc->width($alloc->width-$picsize/$col);$self->{done}=1;$self->size_allocate($alloc);}; 3787 $_->signal_connect(size_allocate => $sub) for $menu->get_children; 3788 # $item->signal_connect(size_allocate => sub {my ($self,$alloc)=@_;warn $alloc->width;return if $self->{busy};$self->{busy}=1;my $w=$self->get_toplevel;$w->set_size_request($w->size_request->width-$alloc->width+$picsize+20,-1);$alloc->width($picsize+20);$self->size_allocate($alloc);}); 3789 } 3790 } 3791 elsif ( my $pixbuf= AAPicture::pixbuf(album=>$album,undef,1) ) #TEST not used 3792 { 3793 my $request=$menu->size_request; 3794 my $rwidth=$request->width; 3795 my $rheight=$request->height; 3796 my $w=200; 3797 #$w=500-$rwidth if $rwidth <300; 3798 $w=300-$rwidth if $rwidth <100; 3799 my $h=200; 3800 $h=$rheight if $rheight >$h; 3801 my $r= $pixbuf->get_width / $pixbuf->get_height; 3802 #warn "max $w $h r=$r\n"; 3803 if ($w>$h*$r) {$w=int($h*$r);} 3804 else {$h=int($w/$r);} 3805 my $h2=$rheight; $h2=$h if $h>$h2; 3806 #warn "=> $w $h\n"; 3807 $pixbuf=$pixbuf->scale_simple($w,$h,'bilinear'); 3808# $menu->set_size_request(1000+$rwidth+$w,$h2); 3809 3810# $menu->signal_connect(size_request => sub {my ($self,$req)=@_;warn $req->width;return if $self->{busy};$self->{busy}=1;my $rw=$self->get_toplevel->size_request->width;$self->get_toplevel->set_size_request($rw+$w,-1);$self->{busy}=undef;}); 3811 3812 $menu->signal_connect(size_allocate => sub 3813 { # warn join(' ', $_[1]->values); 3814 my ($self,$alloc)=@_; 3815 return if $self->{picture_added}; 3816 $self->{picture_added}=1; 3817 3818 my $window=$self->parent; 3819 $window->remove($self); 3820 my $hbox=Gtk2::HBox->new(0,0); 3821 my $frame=Gtk2::Frame->new; 3822 my $image=Gtk2::Image->new_from_pixbuf($pixbuf); 3823 $frame->add($image); 3824 $frame->set_shadow_type('out'); 3825 $hbox->pack_start($self,0,0,0); 3826 $hbox->pack_start($frame,1,1,0); 3827 $window->add($hbox); 3828 $hbox->show_all; 3829 #$window->set_size_request($rwidth+$w,$h2); 3830 $self->set_size_request($rwidth,-1); 3831 }); 3832 } 3833=cut 3834 3835 if (defined wantarray) {return $menu} 3836 PopupMenu($menu,usemenupos=>1); 3837} 3838 3839sub ChooseSongs 3840{ my ($IDs,%opt)=@_; 3841 my @IDs=@$IDs; 3842 return unless @IDs; 3843 my $format = $opt{markup} || __x( _"{song} by {artist}", song => "<b>%S</b>%V", artist => "%a"); 3844 my $lcallback= $opt{cb} || sub { Select(song => $_[1]) }; 3845 my $menu = Gtk2::Menu->new; 3846 my $activate_callback=sub 3847 { my $item=shift; 3848 return if $item->get_submenu; 3849 my $ID=$item->{ID}; 3850 if ($item->{middle}) { Enqueue($ID); } 3851 else { $lcallback->($item,$ID); } 3852 }; 3853 my $click_callback=sub 3854 { my ($item,$event)=@_; 3855 if ($event->button == 2) 3856 { $item->{middle}=1; 3857 my $state=Gtk2->get_current_event_state; 3858 if ( $state && ($state >= ['shift-mask'] || $state >= ['control-mask']) ) #keep the menu up if ctrl or shift pressed 3859 { $item->parent->{keep_it_up}=1; $activate_callback->($item); 3860 return 1; 3861 } 3862 } 3863 elsif($event->button == 3) 3864 { my $submenu=BuildMenu(\@SongCMenu,{mode => 'P', IDs=> [$item->{ID}]}); 3865 $submenu->show_all; 3866 $_[0]->set_submenu($submenu); 3867 #$submenu->signal_connect( selection_done => sub {$menu->popdown}); 3868 #$submenu->show_all; 3869 #$submenu->popup(undef,undef,undef,undef,$event->button,$event->time); 3870 return 0; #return 0 so that the item receive the click and popup the submenu 3871 } 3872 return 0; 3873 }; 3874 3875 my $event= Gtk2->get_current_event; 3876 my $screen= $event ? $event->get_screen : Gtk2::Gdk::Screen->get_default; 3877 my $item_sample= Gtk2::ImageMenuItem->new('X'x45); 3878 #my $maxrows=30; my $maxcols=3; 3879 my $maxrows=int(.8*$screen->get_height / $item_sample->size_request->height); 3880 my $maxcols=int(.7*$screen->get_width / $item_sample->size_request->width); 3881 $maxrows=20 if $maxrows<20; 3882 $maxcols=1 if $maxcols<1; 3883 my @columns=(0); 3884 if (@IDs<=$maxrows) 3885 { @columns=(scalar @IDs); 3886 } 3887 else 3888 { #create one column for each disc/category 3889 for my $i (0..$#IDs) 3890 { if ($IDs[$i]!~m/^\d+$/ && $columns[-1]) { push @columns,0 } 3891 $columns[-1]++; 3892 } 3893 my @new=(0); 3894 if (@columns==1) #one column => split it into multiple columns if too big 3895 { my $rows= shift @columns; 3896 my $cols= POSIX::ceil($rows/$maxrows); 3897 $cols=$maxcols if $cols>$maxcols; #currently if too many songs, create taller columns, better for scrolling 3898 my $part= int($rows/$cols); 3899 my $left= $rows % $part; 3900 for my $c (1..$cols) { push @columns, $part+($c<=$left ? 1 : 0); } 3901 } 3902 else #multiple columns => try to combine them 3903 { my $c=0; 3904 my $r= $columns[$c++]; 3905 while ($r) 3906 { if ($new[-1]> 1.2*@IDs/$maxcols){ push @new,0; } 3907 if ($new[-1]+$r<$maxrows*1.1) { $new[-1]+=$r; $r=0 } 3908 elsif ($r<$maxrows*1.1) { push @new,$r; $r=0 } 3909 elsif ($new[-1]<$maxrows-2) { my $part= $maxrows-$new[-1]; $r-=$part; $new[-1]+=$part; } 3910 else { push @new,0; } 3911 $r ||= $columns[$c++]; 3912 } 3913 @columns=@new if @new<=$maxcols; #too many columns => forget trying to combine categories, will use a submenu for each 3914 } 3915 } 3916 3917 if (@columns>$maxcols) #use submenus if too many columns 3918 { my $row=0; 3919 for my $c (@columns) 3920 { my ($title,@songs)= splice @IDs,0,$c; 3921 my $item= Gtk2::MenuItem->new; 3922 my $label=Gtk2::Label->new_with_format("<b>%s</b>", $title); 3923 $label->set_max_width_chars(45); 3924 $label->set_ellipsize('end'); 3925 $item->add($label); 3926 my $submenu= ChooseSongs(\@songs,markup=>$format); 3927 $item->set_submenu($submenu); 3928 $menu->attach($item, 0,1, $row,$row+1); $row++; 3929 } 3930 $menu->{cols}= [scalar @columns]; 3931 } 3932 else 3933 { my $row=0; my $col=0; 3934 for my $ID (@IDs) 3935 { my $label=Gtk2::Label->new; 3936 my $item; 3937 if ($ID=~m/^\d+$/) #songs 3938 { $item=Gtk2::ImageMenuItem->new; 3939 $item->set_always_show_image(1); 3940 $label->set_alignment(0,.5); #left-aligned 3941 $label->set_markup( ReplaceFieldsAndEsc($ID,$format) ); 3942 $item->{ID}=$ID; 3943 $item->signal_connect(activate => $activate_callback); 3944 $item->signal_connect(button_press_event => $click_callback); 3945 $item->signal_connect(button_release_event => sub { return 1 if delete $_[0]->parent->{keep_it_up}; 0; }); 3946 #set_drag($item, source => [::DRAG_ID,sub {::DRAG_ID,$ID}]); 3947 } 3948 else # "title" items 3949 { $item=Gtk2::MenuItem->new; 3950 $label->set_markup_with_format("<b>%s</b>",$ID); 3951 $item->signal_connect(enter_notify_event=> sub {1}); 3952 } 3953 $label->set_max_width_chars(45); 3954 $label->set_ellipsize('end'); 3955 $item->add($label); 3956 $menu->attach($item, $col, $col+1, $row, $row+1); 3957 if (++$row>=$columns[$col]) {$row=0;$col++;} 3958 } 3959 $menu->{cols}= \@columns; 3960 } 3961 3962 my $update_icons= sub 3963 { for my $item ($_[0]->get_children) 3964 { my $ID=$item->{ID}; 3965 next unless defined $ID; 3966 my $icon= Get_PPSQ_Icon($ID) || ''; 3967 next unless $icon || $item->get_image; 3968 $item->set_image( Gtk2::Image->new_from_stock($icon,'menu') ); 3969 } 3970 }; 3971 ::Watch($menu,$_,$update_icons) for qw/CurSongID Playing Queue/; #update queue/playing icon when needed 3972 $update_icons->($menu); 3973 3974 if (defined wantarray) {return $menu} 3975 PopupMenu($menu); 3976} 3977 3978sub PopupAA 3979{ my ($field,%args)=@_; 3980 my ($list,$from,$callback,$format,$widget,$nosort,$nominor,$noalt)=@args{qw/list from cb format widget nosort nominor noalt/}; 3981 return undef unless @$Library; 3982 my $isaa= $field eq 'album' || $field eq 'artist' || $field eq 'artists'; 3983 $format||="%a"; # "<b>%a</b>%Y\n<small>%s <small>%l</small></small>" 3984 3985#### make list of albums/artists 3986 my @keys; 3987 if (defined $list) { @keys=@$list; } 3988 elsif ($isaa && defined $from) 3989 { if ($field eq 'album') 3990 { my %alb; 3991 $from=[$from] unless ref $from; 3992 for my $artist (@$from) 3993 { push @{$alb{$_}},$artist for @{ AA::GetXRef(artists=>$artist) }; } 3994 #{ $alb{$_}=undef for @{ AA::GetXRef(artist=>$artist) }; } 3995 #@keys=keys %alb; 3996 my %art_keys; 3997 while (my($album,$list)=each %alb) 3998 { my $artist=join ' & ',map Songs::Gid_to_Display('artist',$_), @$list; #FIXME PHASE1 3999 push @{$art_keys{$artist}},$album; 4000 } 4001 if (1==keys %art_keys) 4002 { @keys=@{ $art_keys{ (keys %art_keys)[0] } }; 4003 } 4004 else #multiple artists -> create a submenu for each artist 4005 { my $menu=Gtk2::Menu->new; 4006 for my $artist (keys %art_keys) 4007 { my $item=Gtk2::MenuItem->new_with_label($artist); 4008 $item->set_submenu(PopupAA('album', %args, list=> $art_keys{$artist})); 4009 $menu->append($item); 4010 } 4011 if (defined wantarray) {return $menu} 4012 PopupMenu($menu); 4013 return; 4014 } 4015 } 4016 else 4017 { @keys= @{ AA::GetXRef(album=>$from) }; } 4018 } 4019 else { @keys=@{ AA::GetAAList($field) }; } 4020 4021#### callbacks 4022 my $maincallback=sub #jump to first song 4023 { my ($item,$key)=@_; 4024 return if $item->get_submenu; 4025 my $IDs=AA::GetIDs($field,$key); 4026 if ($item->{middle}) { Enqueue(@$IDs); } #enqueue artist/album on middle-click 4027 else 4028 { my $ID=FindFirstInListPlay( $IDs ); 4029 Select(song => $ID); 4030 } 4031 }; 4032 $maincallback= sub { my ($item,$key)=@_; return if $item->get_submenu; $callback->( {menuitem=>$item,field=>$field,key=>$key,filter=>Songs::MakeFilterFromGID($field,$key)} ); } if $callback; 4033 my $songcb= $callback ? sub { my ($item,$ID)=@_; $callback->( {menuitem=>$item,field=>'id',key=>$ID,filter=>Songs::MakeFilterFromID('title',$ID)} ); } : undef; 4034 my $altcallback= $field eq 'album' && !$noalt ? 4035 sub #Albums button-press event : set up a songs submenu on right-click, alternate action on middle-click 4036 { my ($item,$event,$key)=@_; 4037 if ($event->button==3) 4038 { my $submenu=ChooseSongsFromA($key,nocover=>1,cb=>$songcb); 4039 $item->set_submenu($submenu); 4040 } 4041 elsif ($event->button==2) { $item->{middle}=1; } 4042 0; #return 0 so that the item receive the click and popup the submenu 4043 }: 4044 $isaa && !$noalt ? 4045 sub #Artists button-press event : set up an album submenu on right-click, alternate action on middle-click 4046 { my ($item,$event,$key)=@_; 4047 if ($event->button==3) 4048 { my $submenu=PopupAA('album', from=>$key, cb=>$args{cb}); 4049 $item->set_submenu($submenu); 4050 } 4051 elsif ($event->button==2) { $item->{middle}=1; } 4052 0; 4053 }: 4054 sub #not album nor artist 4055 { my ($item,$event,$key)=@_; 4056 if ($event->button==2) { $item->{middle}=1; } 4057 0; 4058 }; 4059 4060 my $event=Gtk2->get_current_event; 4061 my $screen= $widget ? $widget->get_screen : $event ? $event->get_screen : Gtk2::Gdk::Screen->get_default; 4062 my $max= .7*$screen->get_height; 4063 my $maxwidth=.15*$screen->get_width; 4064 #my $minsize=Gtk2::ImageMenuItem->new('')->size_request->height; 4065 4066 my $createAAMenu=sub 4067 { my ($start,$end,$names,$keys)=@_; 4068 my $nb=$end-$start+1; 4069 return unless $nb; 4070 my $cols= $nb<$max/32 ? 1 : $nb<$max/32 ? 2 : 3; 4071 my $rows=int($nb/$cols); 4072 my $size= $max/$rows < 90 ? 32 : $max/$rows < 200 ? 64 : 128; # choose among 3 possible picture sizes, trying to keep the menu height reasonable 4073 my $maxwidth= $cols==1 ? $maxwidth*1.5 : $maxwidth; 4074 my $row=0; my $col=0; 4075 my $menu = Gtk2::Menu->new; 4076 for my $i ($start..$end) 4077 { my $key=$keys->[$i]; 4078 my $item=Gtk2::ImageMenuItem->new; 4079 $item->set_always_show_image(1); # to override /desktop/gnome/interface/menus_have_icons gnome setting 4080 my $label=Gtk2::Label->new; 4081 $label->set_alignment(0,.5); 4082 $label->set_markup( AA::ReplaceFields($key,$format,$field,1) ); 4083 my $req=$label->size_request->width; 4084 if ($label->size_request->width>$maxwidth) { $label->set_size_request($maxwidth,-1); } #FIXME doesn't work as I want, used to force wrapping at a smaller width than default, but result in requesting $maxwidth when the width of the wrapped text may be significantly smaller 4085 $label->set_line_wrap(TRUE); 4086 $item->add($label); 4087 $item->signal_connect(activate => $maincallback,$key); 4088 $item->signal_connect(button_press_event => $altcallback,$key) if $altcallback; 4089 #$menu->append($item); 4090 $menu->attach($item, $col, $col+1, $row, $row+1); if (++$row>$rows) {$row=0;$col++;} 4091 if ($isaa) 4092 { my $img=AAPicture::newimg($field,$key,$size); 4093 $item->set_image($img) if $img; 4094 } 4095 } 4096 return $menu; 4097 }; #end of createAAMenu 4098 4099 my $min= $field eq 'album' ? $Options{AlbumMenu_min} : $isaa ? $Options{ArtistMenu_min} : 0; 4100 $min=0 if $nominor; 4101 my @keys_minor; 4102 if ($min) 4103 { @keys= grep { @{ AA::GetAAList($field,$_) }>$min or push @keys_minor,$_ and 0 } @keys; 4104 if (!@keys) {@keys=@keys_minor; undef @keys_minor;} 4105 } 4106 4107 Songs::sort_gid_by_name($field,\@keys) unless $nosort; 4108 my @names=@{Songs::Gid_to_Display($field,\@keys)}; #convert @keys to list of names 4109 4110 my @common_args= (widget=>$widget, makemenu=>$createAAMenu, cols=>3, height=>32+2); 4111 my $menu=Breakdown_List(\@names, keys=>\@keys, @common_args); 4112 return undef unless $menu; 4113 if (@keys_minor) 4114 { Songs::sort_gid_by_name($field,\@keys_minor) unless $nosort; 4115 my @names=@{Songs::Gid_to_Display($field,\@keys)}; 4116 my $item=Gtk2::MenuItem->new('minor'); #FIXME 4117 my $submenu=Breakdown_List(\@names, keys=>\@keys_minor, @common_args); 4118 $item->set_submenu($submenu); 4119 $menu->append($item); 4120 } 4121 4122 $menu->show_all; 4123 if (defined wantarray) {return $menu} 4124 PopupMenu($menu); 4125} 4126 4127sub Breakdown_List 4128{ my ($names,%options)=@_; 4129 my ($min,$opt,$max,$makemenu,$keys,$widget)=@options{qw/min opt max makemenu keys widget/}; 4130 $widget ||= Gtk2->get_current_event; #used to find current screen 4131 my $screen= $widget ? $widget->get_screen : Gtk2::Gdk::Screen->get_default; # FIXME is that ok for multi-monitors ? 4132 my $maxheight= $screen->get_height; 4133 4134 4135 if (!$min || !$opt || !$max) #find minimum/optimum/maximum number of entries that the menu/submenus should have 4136 { my $height=$options{height}; 4137 if (!$height) { my $dummyitem=Gtk2::MenuItem->new("dummy"); $height=$dummyitem->size_request->height; } 4138 my $maxnb= $maxheight/$height; 4139 $maxnb=10 if $maxnb<10; #probably shouldn't happen, in case number too low assume the screen can fit 10 items 4140 my $cols= $options{cols}||1; 4141 $max= int($maxnb*.8)*($cols**.9); # **9 to reduce max height and optimum height when using columns 4142 $opt= int($maxnb*.65)*($cols**.9); 4143 $min= int($maxnb*.3)*$cols; 4144 } 4145 4146 # short-cut if no need to create sub-menus 4147 if ($#$names<=$max) { return $makemenu ? $makemenu->(0,$#$names,$names,$keys) : [0,$#$names] } 4148 4149 # check if needs more than 1 level of submenus 4150 if ($makemenu && !$options{norecurse}) 4151 { my $dummyitem=Gtk2::MenuItem->new("dummy"); 4152 my $height=$dummyitem->size_request->height; 4153 my $parentopt= .65*$maxheight/$height; 4154 $parentopt=.65*10 if $parentopt<.65*10; #probably shouldn't happen, in case number too low assume the screen can fit 10 items 4155 if ($#$names > $parentopt*$opt) 4156 { my @childarg=(%options,min=>$min,opt=>$opt,max=>$max,makemenu=>$makemenu,norecurse=>1); 4157 $min*=$parentopt; $max*=$parentopt; $opt*=$parentopt; 4158 $makemenu= sub 4159 { my ($start,$end,$names,$keys)=@_; 4160 my @names2=@$names[$start..$end]; 4161 my $keys2; 4162 @$keys2= @$keys[$start..$end] if $keys && @$keys; 4163 Breakdown_List(\@names2,@childarg,keys=>$keys2); 4164 }; 4165 } 4166 } 4167 4168 my @bounds; 4169 for my $start (0..$#$names) 4170 { my $name1= $start==0 ? '' : superlc($names->[$start-1]); 4171 my $name2= superlc($names->[$start]); 4172 my $name3= $start==$#$names ? '' : superlc($names->[$start+1]); 4173 my ($c1,$c3); my $pos=0; 4174 until (defined $c1 && defined $c3) 4175 { my $l2=substr $name2,$pos,1; 4176 unless (defined $c1) 4177 { my $l1=substr $name1,$pos,1; 4178 $c1=substr $name2,0,$pos+1 unless defined $l1 && $l1 eq $l2 && $pos<length $name2; 4179 } 4180 unless (defined $c3) 4181 { my $l3=substr $name3,$pos,1; 4182 $c3=substr $name2,0,$pos+1 unless defined $l3 && $l3 eq $l2 && $pos<length $name2; 4183 } 4184 $pos++; 4185 } 4186 push @bounds,[$c1,$c3]; 4187 } 4188 4189 my @chunk; 4190 my @toobig=(1)x@bounds; 4191 my $len=1; 4192 # calculate size of chunks for a max length of $len and redo with $len++ for chunks too big (>$max) 4193 { my $c=0; 4194 for my $pos (0..$#bounds) 4195 { if (length $bounds[$pos][0]<=$len) {$c=0} else {$c++} 4196 $chunk[$pos]=$c if $toobig[$pos]; 4197 } 4198 $c=0; 4199 for my $pos (reverse 0..$#bounds) 4200 { if ($pos==$#bounds || length $bounds[$pos+1][0]<=$len) {$c=0} else {$c++} 4201 if ($toobig[$pos]) 4202 { $chunk[$pos]+=$c+1; 4203 $toobig[$pos]=0 unless $chunk[$pos]>$max*.4; 4204 } 4205 } 4206 #for my $pos (0..$#bounds) #DEBUG 4207 #{ print "(pos=$pos) $len|| $bounds[$pos][0] $bounds[$pos][1] $chunk[$pos]\n"; 4208 #} 4209 $len++; 4210 redo if grep $_, @toobig; 4211 } 4212 my @breakpoints=(0); my @length=(0); 4213 my $pos=0; 4214 push @bounds,[' ']; #so that $bounds[$pos][0] is defined even for the last iteration of the loop 4215 while ($pos<@chunk) 4216 { my $size=$chunk[$pos]; 4217 $pos+=$size; 4218 push @breakpoints,$pos; 4219 push @length,length $bounds[$pos][0]; 4220 #print "$#length : ".$bounds[$pos-1][1]."->'$bounds[$pos][0]' len=".(length $bounds[$pos][0])." (pos=$pos)\n"; #DEBUG 4221 } 4222# push @breakpoints,$#$names+1; push @length,1; 4223 4224 4225 # find best combination of chunks 4226 # @todo will contain path that need exploring, put in $final when finished, 4227 # as each breakpoint is explored, only the best path is kept among those that used this breakpoint 4228 my @todo= ([0]); #start with breakpoint 0 4229 my $final; 4230 my @bestscore=(0); 4231 while (@todo) 4232 { my $path0=shift @todo; 4233 my $i0= $path0->[-1]; 4234 my $score0= $bestscore[$i0]; 4235 for my $i ($i0+1 .. $#breakpoints) 4236 { my $nb=$breakpoints[$i]-$breakpoints[$i0]; 4237 next if $nb<$min && $i<$#breakpoints; 4238 my $malus= $nb>$max ? 50*($nb-$max)**2 : 4239 $nb<$min ? 20*($min-$nb)**2 : 0; 4240 my $score= $score0 + $length[$i]*200 + abs($nb-$opt) + $malus; 4241 if ($bestscore[$i]) #if a path already used that breakpoint, compare the score 4242 { next if $bestscore[$i]<$score; # ignore the new path if not better 4243 #new path has a better score => remove all paths that used that breakpoint 4244 @todo=grep {!grep $_==$i, @$_} @todo; # could use smart match but deprecated : @todo=grep !($i~~@$_), @todo; 4245 } 4246 $bestscore[$i]=$score; 4247 my $path= [@$path0,$i]; 4248 my $nbafter=$#$names-$breakpoints[$i]+1; 4249 if ($nbafter==0) {$final=$path} else {push @todo,$path} 4250 last if $nb>$max && $nbafter>$min; 4251 } 4252 } 4253 shift @$final; #remove the starting 0 4254 @breakpoints= map $breakpoints[$_], @$final; 4255 #warn "min=$min opt=$opt max=$max\n". "sizes: ".join(',',map $breakpoints[$_]-$breakpoints[$_-1], 1..$#breakpoints)."\n"; 4256 4257 # build @menu result with for each item : start and end position, start and end letters 4258 my @menus; my $start=0; 4259 for my $end (@breakpoints) 4260 { my $c1=$bounds[$start][0]; 4261 my $c2=$bounds[$end-1][1]; 4262 for my $i (0..length($c1)-1) 4263 { my $c2i=substr $c2,$i,1; 4264 if ($c2i eq '') { $c2.=$c2i= superlc(substr $names->[$end-1],$i,1); } 4265 last if substr($c1,$i,1) ne $c2i; 4266 } 4267 push @menus,[$start,$end-1,$c1,$c2]; 4268 $start=$end; 4269 } 4270 4271 return @menus unless $makemenu; 4272 my $menu; 4273 if (@menus>1) 4274 { $menu=Gtk2::Menu->new; 4275 # jump to entry when a letter is pressed 4276 $menu->signal_connect(key_press_event => sub 4277 { my ($menu,$event)=@_; 4278 my $unicode=Gtk2::Gdk->keyval_to_unicode($event->keyval); # 0 if not a character 4279 if ($unicode) 4280 { my $chr=uc chr $unicode; 4281 for my $item ($menu->get_children) 4282 { if ($chr ge uc$item->{start} && $chr le uc$item->{end}) 4283 { $menu->select_item($item); 4284 return 1; 4285 } 4286 } 4287 } 4288 0; 4289 }); 4290 # Build menu items and submenus 4291 for my $ref (@menus) 4292 { my ($start,$end,$c1,$c2)=@$ref; 4293 $c1=ucfirst$c1; $c2=ucfirst$c2; 4294 $c1.='-'.$c2 if $c2 ne $c1; 4295 my $item=Gtk2::MenuItem->new_with_label($c1); 4296 $item->{start}= substr $c1,0,1; 4297 $item->{end}= substr $c2,0,1; 4298 $item->{menuargs}= [$start,$end,$names,$keys]; 4299 # only build submenu when the item is selected 4300 $item->signal_connect(activate => sub 4301 { my $args=delete $_[0]{menuargs}; 4302 return unless $args; 4303 my $submenu= $makemenu->(@$args); 4304 $item->set_submenu($submenu); 4305 $submenu->show_all; 4306 }); 4307 #my $submenu= $makemenu->($start,$end,$names,$keys); 4308 #$item->set_submenu($submenu); 4309 $item->set_submenu(Gtk2::Menu->new); 4310 $menu->append($item); 4311 } 4312 } 4313 elsif (@menus==1) { $menu= $makemenu->(0,$#$names,$names,$keys); } 4314 else {return undef} 4315 4316 return $menu; 4317} 4318 4319sub BuildToolbar 4320{ my ($tbref,%args)=@_; 4321 my $toolbar=Gtk2::Toolbar->new; 4322 $toolbar->set_style( $args{ToolbarStyle}||'both-horiz' ); 4323 $toolbar->set_icon_size( $args{ToolbarSize}||'small-toolbar' ); 4324 $toolbar->{tbref}= $tbref; 4325 $toolbar->{getcontext}= $args{getcontext} || sub {}; 4326 my @update; 4327 for my $i (@$tbref) 4328 { my $toggle= $i->{toggle} || $i->{toggleoption}; 4329 my $item; 4330 if (my $stock=$i->{stockicon}) 4331 { if ($toggle) { $item= Gtk2::ToggleToolButton->new_from_stock($stock); } 4332 else { $item= Gtk2::ToolButton->new_from_stock($stock); } 4333 } 4334 elsif (my $widget=$i->{widget}) 4335 { $widget= $item= $widget->(\%args); 4336 $item= Gtk2::ToolItem->new; 4337 $item->add($widget); 4338 } 4339 next unless $item; 4340 4341 $item->set_is_important(1) if $i->{important}; 4342 my $label= $i->{label}; 4343 $label=$label->(\%args) if ref $label; 4344 $item->set_label($label) if $label && $item->isa('Gtk2::ToolButton'); 4345 my $tip=$i->{tip} || $label; 4346 $tip=$tip->(\%args) if ref $tip; 4347 $item->set_tooltip_text($tip) if $tip; 4348 4349 if ($toggle) 4350 { my $active; 4351 if (ref $toggle) { $active= $toggle->(\%args); } 4352 else 4353 { my ($not,$ref)=ParseKeyPath(\%args,$toggle); 4354 $item->{toggleref}= $ref; 4355 $item->{togglerefnot}= $not; 4356 $active= ($$ref xor $not); 4357 } 4358 $item->set_active(1) if $active; 4359 } 4360 if (my $cb=$i->{cb}) 4361 { my $sub= sub 4362 { my $toolbar=$_[0]->parent; 4363 return if $toolbar->{busy}; 4364 if (my $ref=$_[0]->{toggleref}) { $$ref^=1 } 4365 $cb->({$toolbar->{getcontext}($toolbar)}) 4366 }; 4367 if ($toggle) { $item->signal_connect(toggled => $sub); } 4368 else { $item->signal_connect(clicked => $sub); } 4369 } 4370 $toolbar->insert($item,-1); 4371 if (my $key=$i->{keyid}||="$i") { $toolbar->{$key}=$item; } 4372 } 4373 return $toolbar; 4374} 4375sub UpdateToolbar 4376{ my $toolbar=shift; 4377 my $tbref= $toolbar->{tbref}; 4378 my $args= {$toolbar->{getcontext}->($toolbar)}; 4379 $toolbar->{busy}=1; 4380 for my $i (@$tbref) 4381 { my $key=$i->{keyid}; 4382 my $item=$toolbar->{$key}; 4383 next unless $item; 4384 if (my $ref=$item->{toggleref}) { $item->set_active($$ref xor $item->{togglerefnot}); } 4385 elsif (my $toggle=$i->{toggle}) { $item->set_active( $toggle->($args) ); } 4386 } 4387 delete $toolbar->{busy}; 4388} 4389 4390sub ParseKeyPath 4391{ my ($ref,$keypath)=@_; 4392 my $not= $keypath=~s/^!//; 4393 my @parents= split /\//,$keypath; 4394 my $last=pop @parents; 4395 for my $key (@parents) 4396 { $ref= $ref->{$key}; 4397 if (!ref $ref) { $ref={}; warn "ParseKeyPath error keypath=$keypath invalid\n"; last } 4398 } 4399 return $not, \$ref->{$last}; 4400} 4401 4402sub BuildMenu 4403{ my ($mref,$args,$menu)=@_; 4404 $args ||={}; 4405 $menu ||= Gtk2::Menu->new; #append to menu if menu given as agrument 4406 for my $m (@$mref) 4407 { next if $m->{ignore}; 4408 next if $m->{type} && index($args->{type}, $m->{type})==-1; 4409 next if $m->{mode} && index($m->{mode}, $args->{mode})==-1; 4410 next if $m->{notmode} && index($m->{notmode}, $args->{mode})!=-1; 4411 next if $m->{isdefined} && grep !defined $args->{$_}, split /\s+/,$m->{isdefined}; 4412 #next if $m->{notdefined}&& grep defined $args->{$_}, split /\s+/,$m->{notdefined}; 4413 next if $m->{istrue} && grep !$args->{$_}, split /\s+/,$m->{istrue}; 4414 next if $m->{isfalse} && grep $args->{$_}, split /\s+/,$m->{isfalse}; 4415 next if $m->{empty} && ( $args->{ $m->{empty} } && @{ $args->{ $m->{empty} } }!=0 ); 4416 next if $m->{notempty} && ( !$args->{ $m->{notempty} } || @{ $args->{ $m->{notempty}} }==0 ); 4417 next if $m->{onlyone} && ( !$args->{ $m->{onlyone} } || @{ $args->{ $m->{onlyone} } }!=1 ); 4418 next if $m->{onlymany} && ( !$args->{ $m->{onlymany} } || @{ $args->{ $m->{onlymany}} }<2 ); 4419 next if $m->{test} && !$m->{test}($args); 4420 4421 if (my $mod=$m->{change_input}) { $args={ %$args, @$mod };next } #modify $args for next menu entries 4422 elsif (my $foreach=$m->{foreach} ) 4423 { my ($key,@values)= $foreach->($args); 4424 my %m2= (%$m, foreach=>undef,); 4425 for my $value (@values) 4426 { BuildMenu([\%m2],{%$args,$key,$value,},$menu); 4427 } 4428 next; 4429 } 4430 elsif ( my $include=$m->{include} ) #append items made by $include 4431 { $include= $include->($args,$menu) if ref $include eq 'CODE'; 4432 if (ref $include eq 'ARRAY') { BuildMenu($include,$args,$menu); } 4433 next; 4434 } 4435 elsif ( my $repeat=$m->{repeat} ) 4436 { my @menus= $repeat->($args); 4437 for my $submenu (@menus) 4438 { my ($menuarray,@extra)=@$submenu; 4439 BuildMenu($menuarray,{%$args,@extra},$menu); 4440 } 4441 next; 4442 } 4443 4444 my $label=$m->{label}; 4445 $label=$label->($args) if ref $label; 4446 my $item; 4447 if ($m->{separator}) 4448 { $item=Gtk2::SeparatorMenuItem->new; 4449 } 4450 elsif (my $icon=$m->{stockicon}) 4451 { $item=Gtk2::ImageMenuItem->new($label); 4452 $icon= $icon->($args) if ref $icon; 4453 $item->set_image( Gtk2::Image->new_from_stock($icon,'menu') ); 4454 } 4455 elsif (my $keypath=$m->{toggleoption}) 4456 { $item=Gtk2::CheckMenuItem->new($label); 4457 my ($not,$ref)=ParseKeyPath($args,$keypath); 4458 $item->{toggleref}= $ref; 4459 $item->set_active(1) if $$ref xor $not; 4460 } 4461 elsif ( ($m->{check} || $m->{radio}) && !$m->{submenu}) 4462 { $item=Gtk2::CheckMenuItem->new($label); 4463 my $func= $m->{check} || $m->{radio}; 4464 $item->set_active(1) if $func->($args); 4465 $item->set_draw_as_radio(1) if $m->{radio}; 4466 } 4467 else { $item=Gtk2::MenuItem->new($label); } 4468 4469 if (my $i=$m->{sensitive}) { $item->set_sensitive(0) unless $i->($args) } 4470 if (my $id=$m->{id}) {$item->{id}=$id} 4471 4472 if (my $submenu=$m->{submenu}) 4473 { $submenu=$submenu->($args) if ref $submenu eq 'CODE'; 4474 if ($m->{code}) { $submenu=BuildChoiceMenu($submenu, %$m, args=>$args); } 4475 elsif (ref $submenu eq 'ARRAY') { $submenu=BuildMenuOptional($submenu,$args); } 4476 next unless $submenu; 4477 if (my $append=$m->{append}) #append to submenu 4478 { BuildMenu($append,$args,$submenu); 4479 } 4480 $item->set_submenu($submenu); 4481 } 4482 else 4483 { $item->{code}=$m->{code}; 4484 $item->signal_connect (activate => sub 4485 { my ($self,$args)=@_; 4486 if (my $ref=$self->{toggleref}) { $$ref^=1 } 4487 my $on; $on=$self->get_active if $self->isa('Gtk2::CheckMenuItem'); 4488 if (my $code=$self->{code}) 4489 { if (ref $code) { $code->($args,$on); } 4490 else { run_command(undef,$code); } 4491 } 4492 },$args); 4493 if (my $submenu3=$m->{submenu3}) # set a submenu on right-click 4494 { $submenu3= BuildMenu($submenu3,$args); 4495 $item->signal_connect (button_press_event => sub { my ($item,$event,$submenu3)=@_; return 0 unless $event->button==3; $item->{code}=undef; $item->set_submenu($submenu3); $submenu3->show_all; 0; },$submenu3); 4496 } 4497 elsif (my $code3=$m->{code3}) # alternate action on right-click 4498 { $item->signal_connect (button_press_event => sub { my ($item,$event,$code3)=@_; $item->{code}=$code3 if $event->button==3; 0; }, $code3); 4499 } 4500 } 4501 $menu->append($item); 4502 } 4503 return $menu; 4504} 4505sub BuildMenuOptional 4506{ my $menu= &BuildMenu; 4507 return $menu->get_children ? $menu : undef; 4508} 4509sub PopupContextMenu 4510{ my $args=$_[1]; 4511 my $menu=BuildMenu(@_); 4512 PopupMenu($menu,nomenupos=>!$args->{usemenupos},self=>$args->{self}); 4513} 4514 4515sub PopupMenu 4516{ my ($menu,%args)=@_; 4517 return unless $menu->get_children; 4518 $menu->show_all; 4519 my $event= $args{event} || Gtk2->get_current_event; 4520 my $widget= $args{self} || Gtk2->get_event_widget($event); 4521 $menu->attach_to_widget($widget,undef) if $widget && !$menu->get_attach_widget; 4522 my $posfunction= $args{posfunction}; # usually undef 4523 my $button=my $time=0; 4524 if ($event) 4525 { $time= $event->time; 4526 $button= $event->button if $event->isa('Gtk2::Gdk::Event::Button'); 4527 if (!$posfunction && !$args{nomenupos} && $event->window) 4528 { my ($w,$h)= $event->window->get_size; 4529 $posfunction=\&menupos if $h<300; #ignore the event's widget if too big, widget can be the whole window if coming from a shortcut key, it makes no sense poping-up a menu next to the whole window 4530 } 4531 } 4532 $menu->popup(undef,undef,$posfunction,undef,$button,$time); 4533} 4534sub menupos # function to position popupmenu below clicked widget 4535{ my $event=Gtk2->get_current_event; 4536 my $w=$_[0]->size_request->width; # width of menu to position 4537 my $h=$_[0]->size_request->height; # height of menu to position 4538 my $ymax=$event->get_screen->get_height; # height of the screen 4539 my ($x,$y)=$event->window->get_origin; # position of the clicked widget on the screen 4540 my ($dw,$dy)=$event->window->get_size; # width and height of the clicked widget 4541 if ($dy+$y+$h > $ymax) { $y-=$h; $y=0 if $y<0 } # display above the widget 4542 else { $y+=$dy; } # display below the widget 4543 if ($event->isa('Gtk2::Gdk::Event::Button')) 4544 { if ($w < $dw && $event->x -$w > 100) # if mouse horizontally far from menu, try to position it closer 4545 { my $newx= $event->x - .5*$w; 4546 #$newx= 0 if $newx<0; 4547 $newx= $dw-$w if $newx>$dw-$w; 4548 $x+=$newx; 4549 } 4550 } 4551 return $x,$y; 4552} 4553 4554sub BuildChoiceMenu 4555{ my ($choices,%options)=@_; 4556 my $menu= delete $options{menu} || Gtk2::Menu->new; # append items to an existing menu or create a new menu 4557 my $args= $options{args}; 4558 my $tree= $options{submenu_tree} || $options{tree}; 4559 my $reverse= $options{submenu_reverse} || $options{'reverse'} || $tree; 4560 my $ordered_hash= $options{submenu_ordered_hash} || $options{ordered_hash} || $tree; 4561 my $firstkey= $options{first_key}; #used to put one of the choices on top 4562 my (@labels,@values); 4563 if ($ordered_hash) 4564 { my $i=0; 4565 while ($i<$#$choices) 4566 { push @labels,$choices->[$i++]; push @values,$choices->[$i++]; } 4567 } 4568 elsif (ref $choices eq 'ARRAY') {@labels=@values=@$choices} 4569 else {@labels=keys %$choices; @values=values %$choices;} 4570 if ($reverse) { my @t=@values; @values=@labels; @labels=@t; } 4571 my @order= 0..$#labels; 4572 @order=sort {superlc($labels[$a]) cmp superlc($labels[$b])} @order if ref $choices eq 'HASH' || $tree; 4573 4574 my $selection; 4575 my $smenu_callback=sub 4576 { my $sub=$_[1]; 4577 my $selected= $_[0]{selected}; 4578 if ($selection && $options{return_list}) 4579 { $selection->{$selected} ^=1; 4580 $selected= [sort grep $selection->{$_}, keys %$selection]; 4581 } 4582 $sub->($args, $selected); 4583 }; 4584 my ($check,$radio); 4585 $check= $options{check}($args) if $options{check}; 4586 if (defined $check) 4587 { $selection={}; 4588 if (ref $check) { $selection->{$_}=1 for @$check; } 4589 else 4590 { $radio=1 unless $options{radio_as_checks}; 4591 $selection->{$check}=1; 4592 } 4593 } 4594 for my $i (@order) 4595 { my $label=$labels[$i]; 4596 my $value=$values[$i]; 4597 my $item=Gtk2::MenuItem->new_with_label($label); 4598 if (ref $value && $tree) 4599 { my $submenu= BuildChoiceMenu( $value, %options ); 4600 next unless $submenu; 4601 $item->set_submenu($submenu); 4602 } 4603 else 4604 { if ($selection) 4605 { $item=Gtk2::CheckMenuItem->new_with_label($label); 4606 $item->set_active(1) if $selection->{$value}; 4607 $item->set_draw_as_radio(1) if $radio; 4608 } 4609 $item->{selected}= $value; 4610 $item->signal_connect(activate => $smenu_callback, $options{code} ); 4611 } 4612 $item->child->set_markup( $item->child->get_label ) if $options{submenu_use_markup}; 4613 if (defined $firstkey && $firstkey eq $value) { $menu->prepend($item); } 4614 else { $menu->append($item); } 4615 } 4616 $menu=undef unless @order; #empty submenu 4617 return $menu; 4618} 4619 4620sub set_drag 4621{ my ($widget,%params)=@_; 4622 if (my $dragsrc=$params{source}) 4623 { ( my $type, $widget->{dragsrc} )= @$dragsrc; 4624 $widget->drag_source_set( ['button1-mask'],['copy','move'], 4625 map [ $DRAGTYPES[$_][0], [] , $_ ], $type, 4626 keys %{$DRAGTYPES[$type][1]} ); 4627 $widget->signal_connect(drag_data_get => \&drag_data_get_cb); 4628 $widget->signal_connect(drag_begin => \&drag_begin_cb); 4629 $widget->signal_connect(drag_end => \&drag_end_cb); 4630 } 4631 if (my $dragdest=$params{dest}) 4632 { my @types=@$dragdest; 4633 $widget->{dragdest}= pop @types; 4634 $widget->drag_dest_set( 'all',['copy','move'], 4635 map [ $DRAGTYPES[$_][0], ($_==DRAG_ID ? 'same-app' : []) , $_ ], @types ); 4636 $widget->signal_connect(drag_data_received => \&drag_data_received_cb); 4637 $widget->signal_connect(drag_leave => \&drag_leave_cb); 4638 $widget->signal_connect(drag_motion => $params{motion}) if $params{motion}; $widget->{drag_motion_cb}=$params{motion}; 4639 } 4640} 4641 4642sub drag_begin_cb #create drag icon 4643{ my ($self,$context)=@_;# warn "drag_begin_cb @_"; 4644 $self->signal_stop_emission_by_name('drag_begin'); 4645 $self->{drag_is_source}=1; 4646 my $sub= $self->{dragsrc}; 4647 my ($srcinfo,@values)=&$sub($self); 4648 unless (@values) { $context->abort($context->start_time); return; } #FIXME no data -> should abort the drag 4649 $context->{data}=\@values; 4650 $context->{srcinfo}=$srcinfo; 4651 my $plaintext; 4652 { $sub=$DRAGTYPES[$srcinfo][1]{&DRAG_MARKUP}; 4653 last if $sub; 4654 $plaintext=1; 4655 $sub=$DRAGTYPES[$srcinfo][1]{&DRAG_USTRING}; 4656 last if $sub; 4657 $sub=sub { join "\n",@_ }; 4658 } 4659 my $text=&$sub(@values); 4660 ###### create pixbuf from text 4661 return if !defined $text || $text eq ''; 4662 my $layout=Gtk2::Pango::Layout->new( $self->create_pango_context ); 4663 if ($plaintext) { $layout->set_text($text); } 4664 else { $layout->set_markup($text); } 4665 my $PAD=3; 4666 my ($w,$h)=$layout->get_pixel_size; $w+=$PAD*2; $h+=$PAD*2; 4667 my $pixmap = Gtk2::Gdk::Pixmap->new($self->window,$w,$h,-1); 4668 my $style=$self->style; 4669 $pixmap->draw_rectangle($style->bg_gc('normal'),TRUE,0,0,$w,$h); 4670 $pixmap->draw_rectangle($style->fg_gc('normal'),FALSE,0,0,$w-1,$h-1); 4671 $pixmap->draw_layout( $style->text_gc('normal'), $PAD, $PAD, $layout); 4672 $context->set_icon_pixmap($pixmap->get_colormap,$pixmap,undef,$w/2,$h); 4673 ###### 4674 $self->{drag_begin_cb}($self,$context) if $self->{drag_begin_cb}; 4675} 4676sub drag_end_cb 4677{ shift->{drag_is_source}=undef; 4678} 4679sub drag_leave_cb 4680{ my ($self,$context)=@_; 4681 delete $self->{scroll}; 4682 delete $self->{context}; 4683} 4684 4685sub drag_data_get_cb 4686{ my ($self,$context,$data,$destinfo,$time)=@_; #warn "drag_data_get_cb @_"; 4687 #my $sub= $self->{dragsrc}; 4688 return unless $context->{data}; 4689 my @values=@{ $context->{data} };#my @values=$sub->($self); return unless @values; 4690 my $srcinfo=$context->{srcinfo}; 4691 if ($destinfo != $srcinfo) 4692 { my $convsub=$DRAGTYPES[$srcinfo][1]{$destinfo}; 4693 if ($destinfo==DRAG_STRING) { my $sub=$DRAGTYPES[$srcinfo][1]{DRAG_USTRING()}; $convsub||=sub { map Encode::encode('iso-8859-1',$_), &$sub }; } #not sure of the encoding I should use, it's for app that don't accept 'text/plain;charset=UTF-8', only found/tested with gnome-terminal 4694 @values=$convsub? $convsub->(@values) : (); 4695 } 4696 $data->set($data->target,8, join("\x0d\x0a",@values) ) if @values; 4697} 4698sub drag_data_received_cb 4699{ my ($self,$context,$x,$y,$data,$info,$time)=@_;# warn "drag_data_received_cb @_"; 4700 my $ret=my $del=0; 4701 $self->{dragdest_suggested_action}= $context->suggested_action; #should maybe have been passed in dragdest arguments, but would require editing all existing dragdest functions 4702 if ($data->length >=0 && $data->format==8) 4703 { my @values=split "\x0d\x0a",$data->data; 4704 s#file:/(?!/)#file:///# for @values; #some apps send file:/path instead of file:///path 4705 _utf8_on($_) for @values; 4706 unshift @values,$context->{dest} if $context->{dest} && $context->{dest}[0]==$self; 4707 $self->{dragdest} ($self, $::DRAGTYPES{$data->target->name} , @values); 4708 $ret=1;#$del=1; 4709 } 4710 $context->finish($ret,$del,$time); 4711} 4712 4713sub drag_checkscrolling #check if need scrolling 4714{ my ($self,$context,$y)=@_; 4715 my $yend=$self->get_visible_rect->height; 4716 if ($y<40) {$self->{scroll}=-1} 4717 elsif ($y>$yend-10) {$self->{scroll}=1} 4718 else { delete $self->{scroll};delete $self->{context}; } 4719 if ($self->{scroll}) 4720 { $self->{scrolling}||=Glib::Timeout->add(200, \&drag_scrolling_cb,$self); 4721 $self->{context}||=$context; 4722 } 4723} 4724sub drag_scrolling_cb 4725{ my $self=$_[0]; 4726 if (my $s=$self->{scroll}) 4727 { my ($align,$path)=($s<0)? (.1, $self->get_path_at_pos(0,0)) 4728 : (.9, $self->get_path_at_pos(0,$self->get_visible_rect->height)); 4729 $self->scroll_to_cell($path,undef,::TRUE,$align) if $path; 4730 $self->{drag_motion_cb}( $self,$self->{context}, ($self->window->get_pointer)[1,2], 0 ) if $self->{drag_motion_cb}; 4731 return 1; 4732 } 4733 else 4734 { delete $self->{scrolling}; 4735 return 0; 4736 } 4737} 4738 4739sub set_biscrolling #makes the mouse wheel scroll vertically when the horizontal scrollbar has grab (boutton pressed on the slider) 4740{ my $sw=$_[0]; 4741 if (*Gtk2::ScrolledWindow::get_hscrollbar{CODE}) #needs gtk>=2.8 4742 { my $scrollbar=$sw->get_hscrollbar; 4743 $scrollbar->signal_connect(scroll_event => 4744 sub { return 0 unless $_[0]->has_grab; $_[0]->parent->propagate_event($_[1]);1; }); 4745 #and vice-versa 4746 $scrollbar=$sw->get_vscrollbar; 4747 $scrollbar->signal_connect(scroll_event => 4748 sub { return 0 unless $_[0]->has_grab; $_[0]->parent->get_hscrollbar->propagate_event($_[1]);1; }); 4749 } 4750} 4751 4752sub CreateDir 4753{ my ($path,$win,$errormsg,$abortmsg,$many)=@_; 4754 my $current=''; 4755 for my $dir (split /$QSLASH/o,$path) 4756 { $dir= CleanupFileName($dir); 4757 next if $dir eq '' || $dir eq '.'; 4758 $current.=SLASH.$dir; 4759 next if -d $current; 4760 until (mkdir $current) 4761 { #if (-f $current) { ErrorMessage("Can't create folder '$current' :\na file with that name exists"); return undef } 4762 my $details= __x( _"Can't create folder: {path}", path => filename_to_utf8displayname($current)); 4763 $errormsg||= _"Error creating folder"; 4764 my $ret= Retry_Dialog($!,$errormsg, details=>$details, window=>$win, abortmsg=>$abortmsg, many=>$many); 4765 return $ret unless $ret eq 'retry'; 4766 } 4767 } 4768 return 'ok'; 4769} 4770 4771sub CopyMoveFilesDialog 4772{ my ($IDs,$copy)=@_; 4773 my $msg=$copy ? _"Choose directory to copy files to" 4774 : _"Choose directory to move files to"; 4775 my $newdir=ChooseDir($msg, path=>Songs::Get($IDs->[0],'path').SLASH); 4776 CopyMoveFiles($IDs,copy=>$copy,basedir=>$newdir) if defined $newdir; 4777} 4778 4779#$fnformat=$1 if $dirformat=~s/$QSLASH([^$QSLASH]*%\w[^$QSLASH]*)//o; 4780sub CopyMoveFiles 4781{ my ($IDs,%options)=@_; 4782 my ($copy,$basedir,$dirformat,$fnformat,$parentwindow)= @options{qw/copy basedir dirformat filenameformat parentwindow/}; 4783 return if !$copy && $CmdLine{ro}; 4784 my ($sub,$errormsg0,$abortmsg)= $copy ? (\©,_"Copy failed",_"abort copy") 4785 : (\&move,_"Move failed",_"abort move") ; 4786 my $action=($copy) ? __n("Copying file","Copying %d files",scalar@$IDs) : 4787 __n("Moving file", "Moving %d files", scalar@$IDs) ; 4788 4789 my $dialog = Gtk2::Dialog->new( $action, $parentwindow, [], 4790 'gtk-cancel' => 'none', 4791 ); 4792 my $label=Gtk2::Label->new($action); 4793 my $progressbar=Gtk2::ProgressBar->new; 4794 my $cancel; 4795 my $cancelsub=sub {$cancel=1}; 4796 $dialog->signal_connect( response => $cancelsub); 4797 my $vbox=Gtk2::VBox->new(FALSE, 2); 4798 $dialog->vbox->pack_start($_, FALSE, TRUE, 3) for $label,$progressbar; 4799 $dialog->show_all; 4800 my $done=0; 4801 4802 my ($owrite_all,$skip_all,$createdir_skip_all); 4803COPYNEXTID:for my $ID (@$IDs) 4804 { last if $cancel; 4805 $progressbar->set_fraction($done/@$IDs); 4806 Gtk2->main_iteration while Gtk2->events_pending; 4807 last if $cancel; 4808 $done++; 4809 my $errormsg= $errormsg0; 4810 $errormsg.= " ($done/".@$IDs.')' if @$IDs>1; 4811 my ($olddir,$oldfile)= Songs::Get($ID, qw/path file/); 4812 my $old=$olddir.SLASH.$oldfile; 4813 my $newfile=$oldfile; 4814 my $newdir= $olddir.SLASH; 4815 $dirformat='' unless defined $dirformat; 4816 if ($basedir || $dirformat ne '') 4817 { $newdir=pathfromformat($ID,$dirformat,$basedir); 4818 my $res= $createdir_skip_all; 4819 $res ||= CreateDir($newdir, $dialog, $errormsg, $abortmsg,$done<@$IDs); 4820 $createdir_skip_all=$res if $res eq 'skip_all'; 4821 last if $res eq 'abort'; 4822 next unless $res eq 'ok'; 4823 } 4824 if ($fnformat) 4825 { $newfile=filenamefromformat($ID,$fnformat,1); 4826 next unless defined $newfile; 4827 } 4828 my $new=$newdir.$newfile; 4829 next if $old eq $new; 4830 #warn "from $old\n to $new\n"; 4831 if (-f $new) #if file already exists 4832 { my $ow=$owrite_all; 4833 $ow||=OverwriteDialog($dialog,$new,$done<@$IDs); 4834 $owrite_all=$ow if $ow=~m/all$/; 4835 next if $ow=~m/^no/; 4836 } 4837 until ($sub->($old,$new)) 4838 { my $res= $skip_all; 4839 my $details= join "\n", __x(_"Source: {file}",file=> filename_to_utf8displayname($old)), __x(_"Destination: {file}",file=> filename_to_utf8displayname($new)); 4840 $res ||= Retry_Dialog($!,$errormsg, ID=>$ID, details=> $details, window=>$dialog, abortmsg=>$abortmsg, many=>$done<@$IDs); 4841 if (-f $new && -f $old && ((-s $new) - (-s $old) <0)) { unlink $new } #delete partial copy 4842 $skip_all=$res if $res eq 'skip_all'; 4843 last COPYNEXTID if $res eq 'abort'; 4844 next COPYNEXTID if $res ne 'retry'; 4845 } 4846 unless ($copy) 4847 { $newdir= cleanpath($newdir); 4848 my @modif; 4849 push @modif, path => $newdir if $olddir ne $newdir; 4850 push @modif, file => $newfile if $oldfile ne $newfile; 4851 Songs::Set($ID, @modif); 4852 } 4853 } 4854 $dialog->destroy; 4855} 4856 4857sub ChooseDir 4858{ my ($msg,%opt)=@_; 4859 my ($path,$extrawidget,$remember_key,$multiple,$allowfiles) = @opt{qw/path extrawidget remember_key multiple allowfiles/}; 4860 my $mode= $allowfiles ? 'open' : 'select-folder'; 4861 # there is no mode in Gtk2::FileChooserDialog that let you select both files or folders (Bug #136294), so use Gtk2::FileChooserWidget directly as it doesn't interfere with the ok button (in "open" mode pressing ok in a Gtk2::FileChooserDialog while a folder is selected go inside that folder rather than emiiting the ok response with that folder selected) 4862 my $dialog=Gtk2::Dialog->new($msg,undef,[], 'gtk-ok' => 'ok', 'gtk-cancel' => 'none'); 4863 my $filechooser=Gtk2::FileChooserWidget->new($mode); 4864 $dialog->vbox->add($filechooser); 4865 $dialog->set_border_width(5); # mimick the normal open dialog 4866 $dialog->get_action_area->set_border_width(5); # 4867 $dialog->vbox->set_border_width(5); # 4868 $dialog->vbox->set_spacing(5); # 4869 ::SetWSize($dialog,'ChooseDir','750x580'); 4870 4871 if (ref $allowfiles) { FileChooser_add_filters($filechooser,@$allowfiles); } 4872 4873 if ($remember_key) { $path= $Options{$remember_key}; } 4874 elsif ($path) { $path= url_escape($path); } 4875 $filechooser->set_current_folder_uri("file://".$path) if $path; 4876 $filechooser->set_extra_widget($extrawidget) if $extrawidget; 4877 $filechooser->set_select_multiple(1) if $multiple; 4878 4879 my @paths; 4880 $dialog->show_all; 4881 if ($dialog->run eq 'ok') 4882 { for my $path ($filechooser->get_uris) 4883 { next unless $path=~s#^file://##; 4884 $path=decode_url($path); 4885 next unless -e $path; 4886 next unless $allowfiles or -d $path; 4887 push @paths, $path; 4888 } 4889 } 4890 else {@paths=()} 4891 if ($remember_key) { my $uri=$filechooser->get_current_folder_uri; $uri=~s#^file://##; $Options{$remember_key}= $uri; } 4892 $dialog->destroy; 4893 return @paths if $multiple; 4894 return $paths[0]; 4895} 4896 4897#sub ChooseDir_old 4898#{ my ($msg,$path) = @_; 4899# my $DirSelector=Gtk2::FileSelection->new($msg); 4900# $DirSelector->file_list->set_sensitive(FALSE); 4901# $DirSelector->set_filename(filename_to_utf8displayname($path)) if -d $path; 4902# if ($DirSelector->run eq 'ok') 4903# { $path=filename_from_unicode($DirSelector->get_filename); 4904# $path=undef unless -d $path; 4905# } 4906# else {$path=undef} 4907# $DirSelector->destroy; 4908# return $path; 4909#} 4910 4911sub FileChooser_add_filters 4912{ my ($filechooser,@patterns)=@_; 4913 for my $aref (@patterns) 4914 { my $filter= Gtk2::FileFilter->new; 4915 if ($aref->[1]) { $filter->add_mime_type($_) for split / /,$aref->[1]; } 4916 if ($aref->[2]) { $filter->add_pattern($_) for split / /,$aref->[2]; } 4917 $filter->set_name($aref->[0]); 4918 $filechooser->add_filter($filter); 4919 } 4920} 4921 4922sub ChooseFiles 4923{ my ($text,%opt)=@_; 4924 $text||=_"Choose files"; 4925 my ($extrawidget,$remember_key,$patterns,$multiple,$parent) = @opt{qw/extrawidget remember_key patterns multiple parent/}; 4926 my $dialog=Gtk2::FileChooserDialog->new($text,$parent,'open', 4927 'gtk-ok' => 'ok', 4928 'gtk-cancel' => 'none'); 4929 $dialog->set_extra_widget($extrawidget) if $extrawidget; 4930 $dialog->set_select_multiple(1) if $multiple; 4931 FileChooser_add_filters($dialog,@$patterns); 4932 if ($remember_key) 4933 { my $path= decode_url($Options{$remember_key}); 4934 $dialog->set_current_folder($path); 4935 } 4936 4937 my $response=$dialog->run; 4938 my @files; 4939 if ($response eq 'ok') 4940 { @files=$dialog->get_filenames; 4941 eval { $_=filename_from_unicode($_); } for @files; 4942 _utf8_off($_) for @files;# filenames that failed filename_from_unicode still have their uft8 flag on 4943 } 4944 if ($remember_key) { $Options{$remember_key}= url_escape($dialog->get_current_folder); } 4945 $dialog->destroy; 4946 return @files; 4947} 4948 4949sub ChoosePix 4950{ my ($path,$text,$file,$remember_key)=@_; 4951 $text||=_"Choose Picture"; 4952 my $dialog=Gtk2::FileChooserDialog->new($text,undef,'open', 4953 _"no picture" => 'reject', 4954 'gtk-ok' => 'ok', 4955 'gtk-cancel' => 'none'); 4956 4957 FileChooser_add_filters($dialog, 4958 [_"Pictures and music files",'image/*','*.mp3 *.flac *.m4a *.m4b *.ogg *.oga' ], 4959 [_"Pictures files",'image/*'], 4960 ["Pdf",undef,'*.pdf'], 4961 [_"All files",undef,'*'], 4962 ); 4963 4964 my $preview=Gtk2::VBox->new; 4965 my $label=Gtk2::Label->new; 4966 my $image=Gtk2::Image->new; 4967 my $eventbox=Gtk2::EventBox->new; 4968 $eventbox->add($image); 4969 $eventbox->signal_connect(button_press_event => \&GMB::Picture::pixbox_button_press_cb); 4970 my $max=my $nb=0; my $lastfile; 4971 my $prev= NewIconButton('gtk-go-back', undef, sub { $_[0]->parent->parent->{set_pic}->(-1); }); 4972 my $next= NewIconButton('gtk-go-forward',undef, sub { $_[0]->parent->parent->{set_pic}->(1); }); 4973 my $more= Gtk2::HButtonBox->new; 4974 $more->add($_) for $prev,$next; 4975 $preview->pack_start($_,FALSE,FALSE,2) for $more,$eventbox,$label; 4976 $dialog->set_preview_widget($preview); 4977 #$dialog->set_use_preview_label(FALSE); 4978 $preview->{set_pic}=sub 4979 { my $inc=shift; 4980 $nb+=$inc if $inc; 4981 $nb=0 if $nb<0 || $nb>=$max; 4982 my $file=$lastfile; 4983 $file.=":$nb" if $nb; 4984 GMB::Picture::ScaleImage($image,150,$file); 4985 my $p=$image->{pixbuf}; 4986 if ($p) { $label->set_text($p->get_width.' x '.$p->get_height); } 4987 else { $label->set_text(''); } 4988 $more->set_visible($max>1); 4989 $prev->set_sensitive($nb>0); 4990 $next->set_sensitive($nb<$max-1); 4991 $dialog->set_preview_widget_active($p || $nb); 4992 }; 4993 my $update_preview=sub 4994 { my ($dialog,$file)=@_; 4995 unless ($file) 4996 { $file= $dialog->get_preview_uri; 4997 $file= ($file && $file=~s#^file://##) ? decode_url($file) : undef; 4998 } 4999 unless ($file && -f $file) { $preview->hide; return } 5000 $preview->show; 5001 $max=0; 5002 $nb=0 unless $lastfile && $lastfile eq $file; 5003 $lastfile=$file; 5004 if ($file=~m/$EmbImage_ext_re$/) 5005 { my @pix= FileTag::PixFromMusicFile($file); 5006 $max=@pix; 5007 } 5008 elsif ($file=~m/\.pdf$/i) { $max=GMB::Picture::pdf_pages($file) } 5009 $preview->{set_pic}->(); 5010 }; 5011 $dialog->signal_connect(update_preview => $update_preview); 5012 5013 $preview->show_all; 5014 $more->set_no_show_all(1); 5015 $dialog->set_preview_widget_active(0); 5016 if ($remember_key) { $path= $Options{$remember_key}; } 5017 elsif ($path) { $path= url_escape($path); } 5018 if ($file && $file=~s/:(\w+)$//) { $nb=$1; $lastfile=$file; $nb= FileTag::PixFromMusicFile($file,$nb,1,1)||0 if $nb=~m/\D/; } 5019 if ($file && -f $file) { $dialog->set_filename($file); $update_preview->($dialog,$file); } 5020 elsif ($path) { $dialog->set_current_folder_uri( "file://$path" ); } 5021 5022 my $response=$dialog->run; 5023 my $ret; 5024 if ($response eq 'ok') 5025 { $ret= $dialog->get_uri; 5026 $ret= $ret=~s#^file://## ? $ret=decode_url($ret) : undef; 5027 unless (-e $ret) { warn "can't find $ret\n"; $ret=undef; } 5028 $ret.=":$nb" if $nb; 5029 } 5030 elsif ($response eq 'reject') {$ret='0'} 5031 else {$ret=undef} 5032 if ($remember_key) { my $uri=$dialog->get_current_folder_uri; $uri=~s#^file://##; $Options{$remember_key}= $uri; } 5033 $dialog->destroy; 5034 return $ret; 5035} 5036 5037#sub ChoosePix_old 5038#{ my ($path,$text)=@_; 5039# my $PixSelector=Gtk2::FileSelection->new($text||'Choose Picture'); 5040# $PixSelector->add_button(_"no picture",'reject'); #FIXME add before ok and cancel buttons 5041# my $flist=$PixSelector->file_list; 5042# my $dialog_hbox=$flist->parent->parent->parent; #FIXME 5043# my $previewbox=Gtk2::VBox->new(FALSE,2); 5044# my $frame=Gtk2::Frame->new('Preview'); 5045# my $eventbox=Gtk2::EventBox->new; 5046# my $img=Gtk2::Image->new; 5047# $eventbox->add($img); 5048# $frame->add($eventbox); 5049# $eventbox->signal_connect(button_press_event => \&GMB::Picture::pixbox_button_press_cb); 5050# $frame->set_size_request(155,155); 5051# my $label=Gtk2::Label->new; 5052# $PixSelector->set_filename(filename_to_utf8displayname($path.SLASH)) if $path && -d $path; 5053# $previewbox->pack_start($_,FALSE,FALSE,2) for $frame,$label; 5054# $PixSelector->selection_entry->signal_connect(changed => sub 5055# { my ($file)=$PixSelector->get_selections; 5056# $file=filename_from_unicode($file); 5057# GMB::Picture::ScaleImage($img,150,$file); 5058# my $p=$img->{pixbuf}; 5059# my $text=$p? $p->get_width.' x '.$p->get_height : ''; 5060# $label->set_text($text); 5061# $img->show_all; 5062# }); 5063# $previewbox->show_all; 5064# $dialog_hbox->pack_start($previewbox,FALSE,FALSE,2); 5065# $PixSelector->complete ('*.jpg'); 5066# my $response = $PixSelector->run; 5067# my $ret; 5068# if ($response eq 'ok') 5069# { $ret=filename_from_unicode($PixSelector->get_filename); 5070# #$ret=$PixSelector->get_filename; 5071# unless (-r $ret) { warn "can't read $ret\n"; $ret=undef; } 5072# } 5073# elsif ($response eq 'reject') {$ret='0'} 5074# else {$ret=undef} 5075# $PixSelector->destroy; 5076# return $ret; 5077#} 5078 5079sub ChooseSaveFile 5080{ my ($window,$msg,$path,$file,$widget) = @_; 5081 my $dialog=Gtk2::FileChooserDialog->new($msg,$window,'save', 5082 'gtk-ok' => 'ok', 5083 'gtk-cancel' => 'none', 5084 ); 5085 #$dialog->set_current_folder($path) if defined $path; 5086 $dialog->set_filename($path.SLASH.'*') if defined $path; 5087 $dialog->set_current_name(filename_to_utf8displayname($file)) if defined $file; 5088 $dialog->set_extra_widget($widget) if $widget; 5089 5090 if ($dialog->run eq 'ok') 5091 { $file=$dialog->get_filename; 5092 } 5093 else {$file=undef} 5094 $dialog->destroy; 5095 if (defined $file && -f $file) 5096 { my $res=OverwriteDialog($window,$file); 5097 if ($res ne 'yes') {$file=undef;} 5098 $dialog->destroy; 5099 } 5100 return $file; 5101} 5102 5103sub OverwriteDialog 5104{ my ($window,$file,$multiple)=@_; 5105 my $dialog = Gtk2::MessageDialog->new 5106 ( $window, 5107 [qw/modal destroy-with-parent/], 5108 'warning','yes-no','%s', 5109 __x( _"'{file}' exists. Overwrite ?", file => filename_to_utf8displayname($file) ) 5110 ); 5111 if ($multiple) 5112 { $dialog->add_button(_"yes to all",'1'); 5113 $dialog->add_button(_"no to all",'2'); 5114 } 5115 $dialog->show_all; 5116 my $ret=$dialog->run; 5117 $dialog->destroy; 5118 $ret=2 unless $ret; 5119 $ret= ($ret eq '1') ? 'yesall': 5120 ($ret eq '2') ? 'noall' : 5121 ($ret) ? $ret : 5122 'no'; 5123 return $ret; 5124} 5125 5126my $LastErrorShowDetails; 5127sub Retry_Dialog #returns one of 'retry abort skip skip_all' 5128{ my ($syserr,$summary,%args)=@_; #$summary should say what action lead to this error ie: "Error while writing tag" 5129 my ($details,$window,$abortmsg,$many,$ID)=@args{qw/details window abortmsg many ID/}; 5130 my $dialog = Gtk2::MessageDialog->new($window, [qw/modal destroy-with-parent/], 'error','none','%s', $summary); 5131 $dialog->format_secondary_text("%s",$syserr); 5132 $dialog->set_title($summary); 5133 $dialog->add_button_custom(_"_Retry", 1, icon=>'gtk-refresh'); 5134 $dialog->add_button_custom(_"_Cancel", 2, icon=>'gtk-cancel', tip=>$abortmsg); 5135 $dialog->add_button_custom(_"_Skip", 3, icon=>'gtk-go-forward', tip=>_"Proceed to next item.") if $many; 5136 $dialog->add_button_custom(_"Skip _All", 4, tip=>_"Skip this and any further errors.") if $many; 5137 my $expander; 5138 if ($details) 5139 { my $label= Gtk2::Label->new($details); 5140 $label->set_line_wrap(1); #FIXME making the label resize with the dialog would be nice but complicated with gtk2 5141 $label->set_selectable(1); 5142 $label->set_padding(2,5); 5143 $label->set_alignment(0,.5); 5144 $expander=Gtk2::Expander->new(_"Show more error details"); 5145 $expander->add($label); 5146 $dialog->vbox->add($expander); 5147 $expander->set_expanded( time-($LastErrorShowDetails||0) <6 );#set expanded if recently showed a error dialog that was left expanded 5148 } 5149 $dialog->show_all; 5150 my $ret=$dialog->run; 5151 $LastErrorShowDetails= ($expander->get_expanded ? time : undef) if $expander; 5152 $dialog->destroy; 5153 $ret=0 if $ret!~m/^[1234]$/; 5154 return (qw/abort retry abort skip skip_all/)[$ret]; 5155} 5156 5157sub ErrorMessage 5158{ my ($err,$window)=@_; 5159 warn "$err\n"; 5160 my $dialog = Gtk2::MessageDialog->new 5161 ( $window, 5162 [qw/modal destroy-with-parent/], 5163 'error','close','%s', 5164 $err 5165 ); 5166 $dialog->show_all; 5167 $dialog->run; 5168 $dialog->destroy; 5169} 5170 5171sub EditLyrics 5172{ my $ID=$_[0]; 5173 if (exists $Editing{'L'.$ID}) { $Editing{'L'.$ID}->force_present; return; } 5174 my $lyrics=FileTag::GetLyrics($ID); 5175 $lyrics='' unless defined $lyrics; 5176 $Editing{'L'.$ID}= 5177 EditLyricsDialog(undef,$lyrics,_("Lyrics for ").Songs::Display($ID,'fullfilename'),sub 5178 { delete $Editing{'L'.$ID}; 5179 FileTag::WriteLyrics($ID,$_[0]) if defined $_[0]; 5180 }); 5181} 5182 5183sub EditLyricsDialog 5184{ my ($window,$init,$text,$sub)=@_; 5185 my $dialog = Gtk2::Dialog->new ($text||_"Edit Lyrics", $window,'destroy-with-parent'); 5186 my $bsave=$dialog->add_button('gtk-save' => 'ok'); 5187 $dialog->add_button('gtk-cancel' => 'none'); 5188 $dialog->set_default_response ('ok'); 5189 my $textview=Gtk2::TextView->new; 5190 my $buffer=$textview->get_buffer; 5191 $buffer->set_text($init); 5192 $buffer->signal_connect( changed => sub { $bsave->set_sensitive( $buffer->get_text($buffer->get_bounds,1) ne $init); }); 5193 $bsave->set_sensitive(0); 5194 5195 my $sw= new_scrolledwindow($textview,'etched-in'); 5196 $dialog->vbox->add($sw); 5197 SetWSize($dialog,'Lyrics'); 5198 $dialog->show_all; 5199 $dialog->signal_connect( response => sub 5200 { my ($dialog,$response,$sub)=@_; 5201 my $lyrics; 5202 $lyrics=$buffer->get_text( $buffer->get_bounds, 1) if $response eq 'ok'; 5203 $dialog->destroy; 5204 $sub->($lyrics) if $sub; 5205 },$sub); 5206 return $dialog; 5207} 5208 5209sub DeleteFiles 5210{ return if $CmdLine{ro}; 5211 my $IDs=$_[0]; 5212 return unless @$IDs; 5213 my $text=(@$IDs==1)? "'".Songs::Display($IDs->[0],'file')."'" : __n("%d file","%d files",scalar @$IDs); 5214 my $dialog = Gtk2::MessageDialog->new 5215 ( ::get_event_window(), 5216 'modal', 5217 'warning','cancel','%s', 5218 __x(_("About to delete {files}\nAre you sure ?"), files => $text) 5219 ); 5220 $dialog->add_button("gtk-delete", 2); 5221 $dialog->show_all; 5222 if ('2' eq $dialog->run) 5223 { my $skip_all; 5224 my $done=0; 5225 for my $ID (@$IDs) 5226 { my $f= Songs::GetFullFilename($ID); 5227 unless (unlink $f) 5228 { my $res= $skip_all; 5229 my $errormsg= _"Deletion failed"; 5230 $errormsg.= ' ('.($done+1).'/'.@$IDs.')' if @$IDs>1; 5231 $res ||= ::Retry_Dialog($!,$errormsg, ID=>$ID, details=>__x(_("Failed to delete '{file}'"), file => filename_to_utf8displayname($f)), window=>$dialog, many=>(@$IDs-$done)>1); 5232 $skip_all=$res if $res eq 'skip_all'; 5233 redo if $res eq 'retry'; 5234 last if $res eq 'abort'; 5235 } 5236 $done++; 5237 IdleCheck($ID); 5238 } 5239 } 5240 $dialog->destroy; 5241} 5242 5243sub filenamefromformat 5244{ my ($ID,$format,$ext)=@_; # $format is in utf8 5245 my $s= ReplaceFieldsForFilename($ID,$format); 5246 if ($ext) 5247 { $s= Songs::Get($ID,'barefilename') if $s eq ''; 5248 $s.= '.'.Songs::Get($ID,'extension'); #add extension 5249 } 5250 elsif ($s=~m/^\.\w+$/) #only extension -> base name on song's filename 5251 { $s= Songs::Get($ID,'barefilename').$s; 5252 } 5253 return $s; 5254} 5255sub pathfromformat 5256{ my ($ID,$format,$basefolder,$icase)=@_; # $format is in utf8, $basefolder is a byte string 5257 my $path= defined $basefolder ? $basefolder.SLASH : ''; 5258 if ($format=~s#^([^\$%]*$QSLASH)##) # move constant part of format in path 5259 { my $constant=$1; 5260 $path.= filename_from_unicode($constant); # calling filename_from_unicode directly on $1 causes strange bugs afterward (with perl-Glib-1.222) 5261 } 5262 $path=~s#^~($QSLASH)#$ENV{HOME}$1#o; # replace leading ~/ by homedir 5263 $path= Songs::Get($ID,'path').SLASH.$path if $path!~m#^$QSLASH#o; # use song's path as base for relative paths 5264 $path= simplify_path($path,1); 5265 for my $f0 (split /$QSLASH+/o,$format) 5266 { my $f= ReplaceFieldsForFilename($ID,$f0); 5267 next if $f=~m/^\.\.?$/; 5268 if ($icase && $f0 ne $f) 5269 { $f=ICasePathFile($path,$f); 5270 } 5271 $path.=$f.SLASH; 5272 } 5273 return cleanpath($path,1); 5274} 5275sub pathfilefromformat 5276{ my ($ID,$format,$ext,$icase)=@_; # $format is in utf8 5277 my ($path,$file)= $format=~m/^(?:(.*)$QSLASH)?([^$QSLASH]+)$/o; 5278 #return undef unless $file; 5279 $file='' unless defined $file; 5280 $path='' unless defined $path; 5281 $path=pathfromformat($ID,$path,undef,$icase); 5282 $file=filenamefromformat($ID,$file,$ext); 5283 $file=ICasePathFile($path,$file) if $icase; 5284 return undef unless $file; 5285 return wantarray ? ($path,$file) : $path.$file; 5286} 5287sub ICasePathFile #tries to find an existing file/folder with different case 5288{ my ($path,$folder)=@_; 5289 return $folder unless -e $path; 5290 unless (-e $path.$folder) 5291 { opendir my($d),$path; 5292 my @files=readdir $d; 5293 closedir $d; 5294 my $lc=lc$folder; #or superlc ? 5295 my ($found)=grep $lc eq lc, @files; 5296 $folder=$found if defined $found; 5297 } 5298 return $folder; 5299} 5300sub CaseSensFile #find case-sensitive filename from a case-insensitive filename 5301{ my $file0=shift; 5302 return $file0 if -e $file0; 5303 my $file=''; 5304 for my $f (split /$QSLASH+/o,$file0) 5305 { $f=ICasePathFile( $file||SLASH, $f); 5306 $file.=$f.SLASH; 5307 } 5308 chop $file; #remove last SLASH 5309 return $file; 5310} 5311 5312sub DialogMassRename 5313{ return if $CmdLine{ro}; 5314 my @IDs= uniq(@_); #remove duplicates IDs in @_ => @IDs 5315 Songs::SortList(\@IDs,'path album:i disc track file'); 5316 my $dialog = Gtk2::Dialog->new 5317 (_"Mass Renaming", undef, 5318 [qw/destroy-with-parent/], 5319 'gtk-ok' => 'ok', 5320 'gtk-cancel' => 'none', 5321 ); 5322 $dialog->set_border_width(4); 5323 $dialog->set_default_response('ok'); 5324 SetWSize($dialog,'MassRename','650x550'); 5325 my $table=MakeReplaceTable('talydnAYo'); 5326 my $combo= NewPrefComboText('FilenameSchema'); 5327 my $comboFolder=NewPrefComboText('FolderSchema'); 5328 $combo->child->set_activates_default(TRUE); 5329 my $folders=0; 5330 ### 5331 my $notebook=Gtk2::Notebook->new; 5332 my $store=Gtk2::ListStore->new('Glib::String'); 5333 my $treeview1=Gtk2::TreeView->new($store); 5334 my $treeview2=Gtk2::TreeView->new($store); 5335 my $func1=sub 5336 { my (undef,$cell,$store,$iter)= @_; 5337 my $ID=$store->get($iter,0); 5338 my $text= $folders ? Songs::Display($ID,'fullfilename') : Songs::Display($ID,'file'); 5339 $cell->set(text=>$text); 5340 }; 5341 my $func2=sub 5342 { my (undef,$cell,$store,$iter)=@_; 5343 my $ID=$store->get($iter,0); 5344 my $text=filenamefromformat($ID,$combo->get_active_text,1); 5345 if ($folders) 5346 { my $base= decode_url($Options{BaseFolder}); 5347 my $fmt= $comboFolder->get_active_text; 5348 $text= pathfromformat($ID,$fmt,$base) . $text; 5349 } 5350 $cell->set(text=> filename_to_utf8displayname($text) ); 5351 }; 5352 for ( [$treeview1,_"Old name",$func1], [$treeview2,_"New name",$func2] ) 5353 { my ($tv,$title,$func)=@$_; 5354 $tv->set_headers_visible(FALSE); 5355 my $renderer=Gtk2::CellRendererText->new; 5356 my $col=Gtk2::TreeViewColumn->new_with_attributes($title,$renderer); 5357 $col->set_cell_data_func($renderer, $func); 5358 $col->set_sizing('fixed'); 5359 $col->set_resizable(TRUE); 5360 $tv->append_column($col); 5361 $tv->set('fixed-height-mode' => TRUE); 5362 my $sw= new_scrolledwindow($tv,'etched-in'); 5363 $notebook->append_page($sw,$title); 5364 } 5365 $treeview2->parent->set_vadjustment( $treeview1->parent->get_vadjustment ); #sync vertical scrollbars 5366 #sync selections : 5367 my $busy; 5368 my $syncsel=sub { return if $busy;$busy=1;my $path=$_[0]->get_selected_rows; $_[1]->get_selection->select_path($path);$busy=undef;}; 5369 $treeview1->get_selection->signal_connect(changed => $syncsel,$treeview2); 5370 $treeview2->get_selection->signal_connect(changed => $syncsel,$treeview1); 5371 5372 $store->set( $store->prepend,0, $_ ) for reverse @IDs; # prepend because filling is a bit faster in reverse 5373 5374 my $refresh=sub { $treeview2->queue_draw; }; 5375 $combo->signal_connect(changed => $refresh); 5376 $comboFolder->signal_connect(changed => $refresh); 5377 my $sg1=Gtk2::SizeGroup->new('horizontal'); 5378 my $sg2=Gtk2::SizeGroup->new('horizontal'); 5379 my $entrybase=NewPrefFileEntry('BaseFolder',_("Base Folder :"), folder =>1, cb => $refresh, sizeg1=>$sg1,sizeg2=>$sg2, history_key=>'BaseFolder_history'); 5380 my $labelfolder=Gtk2::Label->new(_"Folder pattern :"); 5381 5382 my $title=Gtk2::Label->new(_"Rename/move files based on these fields :"); 5383 #my $checkfile= Gtk2::CheckButton->new(_"Rename files using this pattern :"); 5384 my $checkfile= Gtk2::Label->new(_"Rename files using this pattern :"); 5385 my $checkfolder=Gtk2::CheckButton->new(_"Move Files to :"); 5386 $sg1->add_widget($labelfolder); 5387 $sg2->add_widget($comboFolder); 5388 my $albox=Gtk2::Alignment->new(0,0,1,1); 5389 $albox->set_padding(0,0,20,0); 5390 $albox->add( Vpack($entrybase,[$labelfolder,$comboFolder]) ); 5391 $checkfolder->signal_connect(toggled => sub {$folders=$_[0]->get_active; $albox->set_sensitive($folders); $treeview1->queue_draw; $treeview2->queue_draw; }); 5392 $albox->set_sensitive($folders); 5393 my $vbox=Vpack ( $title,$table, 5394 [$checkfile,$combo], 5395 $checkfolder, 5396 $albox, 5397 ); 5398 $dialog->vbox->pack_start($vbox,FALSE,FALSE,3); 5399 $dialog->vbox->pack_start($notebook,TRUE,TRUE,5); 5400 5401 $notebook->show_all; 5402 $notebook->set_current_page(1); 5403 $dialog->show_all; 5404 5405 $treeview1->realize; #FIXME without it, scrollbars synchronization doesn't work until treeview1 is displayed (by clicking on the 1st tab) 5406 5407 $dialog->signal_connect( response => sub 5408 { my ($dialog,$response)=@_; 5409 if ($response eq 'ok') 5410 { my $format=$combo->get_active_text; 5411 if ($folders) 5412 { my $base0= my $base= decode_url( $Options{BaseFolder} ); 5413 unless ( defined $base ) { ErrorMessage(_("You must specify a base folder"),$dialog); return } 5414 until ( -d $base ) { last unless $base=parentdir($base); } 5415 unless ( -w $base ) { ErrorMessage(__x(_("Can't write in base folder '{folder}'."), folder => filename_to_utf8displayname($base0)),$dialog); return } 5416 $dialog->set_sensitive(FALSE); 5417 my $folderformat=$comboFolder->get_active_text; 5418 CopyMoveFiles(\@IDs,copy=>FALSE,basedir=>$base0,dirformat=>$folderformat,filenameformat=>$format,parentwindow=>$dialog); 5419 } 5420 elsif ($format) 5421 { $dialog->set_sensitive(FALSE); 5422 CopyMoveFiles(\@IDs,copy=>FALSE,filenameformat=>$format,parentwindow=>$dialog); 5423 } 5424 } 5425 $dialog->destroy; 5426 }); 5427} 5428 5429sub RenameFile 5430{ my ($dir,$old,$newutf8,$window)=@_; 5431 my $new= CleanupFileName(filename_from_unicode($newutf8)); 5432 return unless length $new; 5433 { last if $new eq ''; 5434 last if $old eq $new; 5435 if (-f $dir.SLASH.$new) 5436 { my $res=OverwriteDialog($window,$new); 5437 return unless $res eq 'yes'; 5438 redo; 5439 } 5440 elsif (!rename $dir.SLASH.$old, $dir.SLASH.$new) 5441 { my $res= Retry_Dialog($!,_"Renaming failed", window=>$window, details=> 5442 __x( _"From: {oldname}\nTo: {newname}", oldname => filename_to_utf8displayname($old), 5443 newname => filename_to_utf8displayname($new))); 5444 return unless $res eq 'retry'; 5445 redo; 5446 } 5447 } 5448 return $new; 5449} 5450 5451sub RenameSongFile 5452{ my ($ID,$newutf8,$window)=@_; 5453 my ($dir,$old)= Songs::Get($ID,qw/path file/); 5454 my $new=RenameFile($dir,$old,$newutf8,$window); 5455 Songs::Set($ID, file=> $new) if defined $new; 5456} 5457 5458sub DialogRename 5459{ return if $CmdLine{ro}; 5460 my $ID=$_[0]; 5461 my $dialog = Gtk2::Dialog->new (_"Rename File", undef, [], 5462 'gtk-ok' => 'ok', 5463 'gtk-cancel' => 'none'); 5464 $dialog->set_default_response ('ok'); 5465 my $table=Gtk2::Table->new(4,2); 5466 my $row=0; 5467 for my $col (qw/title artist album disc track/) 5468 { my $val=Songs::Display($ID,$col); 5469 next if ($col eq 'disc' || $col eq 'track') && !$val; 5470 my $lab1=Gtk2::Label->new; 5471 my $lab2=Gtk2::Label->new($val); 5472 $lab1->set_markup_with_format("<b>%s :</b>", Songs::FieldName($col)); 5473 $lab1->set_padding(5,0); 5474 $lab1->set_alignment(1,.5); 5475 $lab2->set_alignment(0,.5); 5476 $lab2->set_line_wrap(1); 5477 $lab2->set_selectable(TRUE); 5478 $table->attach_defaults($lab1,0,1,$row,$row+1); 5479 $table->attach_defaults($lab2,1,2,$row,$row+1); 5480 $row++; 5481 } 5482 my ($name,$ext)= Songs::Display($ID,'barefilename','extension'); 5483 my $entry=Gtk2::Entry->new; 5484 $entry->set_activates_default(TRUE); 5485 $entry->set_text($name); 5486 my $label_ext=Gtk2::Label->new('.'.$ext); 5487 $dialog->vbox->add($table); 5488 $dialog->vbox->add(Hpack('_',$entry,0,$label_ext)); 5489 SetWSize($dialog,'Rename','300x180'); 5490 5491 $dialog->show_all; 5492 $dialog->signal_connect( response => sub 5493 { my ($dialog,$response)=@_; 5494 if ($response eq 'ok') 5495 { my $name=$entry->get_text; 5496 RenameSongFile($ID,"$name.$ext",$dialog) if $name=~m/\S/; 5497 } 5498 $dialog->destroy; 5499 }); 5500} 5501 5502sub GetListOfSavedLists 5503{ return sort { superlc($a) cmp superlc($b) } keys %{$Options{SavedLists}}; 5504} 5505 5506sub AddToListMenu 5507{ my @keys=GetListOfSavedLists(); 5508 return undef unless @keys; 5509 my $IDs=$_[0]{IDs}; 5510 my $menusub=sub {my $key=$_[1]; $Options{SavedLists}{$key}->Push($IDs); }; 5511 5512 my $makemenu=sub 5513 { my ($start,$end,$keys)=@_; 5514 my $menu=Gtk2::Menu->new; 5515 for my $i ($start..$end) 5516 { my $l=$keys->[$i]; 5517 my $item=Gtk2::MenuItem->new_with_label($l); 5518 $item->signal_connect(activate => $menusub,$l); 5519 $menu->append($item); 5520 } 5521 return $menu; 5522 }; 5523 my $menu=Breakdown_List(\@keys, makemenu=>$makemenu); 5524 return $menu; 5525} 5526 5527sub LabelEditMenu 5528{ my ($field,$IDs)= @_; 5529 my ($hash)=Songs::BuildHash($field,$IDs,'name'); 5530 $_= $_==0 ? 0 : 5531 $_==@$IDs ? 1 : 5532 2 5533 for values %$hash; 5534 my $menusub_toggled=sub 5535 { my $f=$_[1]; 5536 if ($_[0]->get_active) { Songs::Set($IDs,"+$field",$f); } 5537 else { Songs::Set($IDs,"-$field",$f); } 5538 }; 5539 my $menu=MakeFlagMenu($field,$menusub_toggled,$hash); 5540 my $item= Gtk2::ImageMenuItem->new(_("Add new label").'...'); 5541 $item->set_image( Gtk2::Image->new_from_stock('gtk-add','menu') ); 5542 $item->signal_connect(activate=>sub { AddNewLabel($field,$IDs); }); 5543 $menu->append($_) for Gtk2::SeparatorMenuItem->new, $item; 5544 return $menu; 5545} 5546 5547sub MakeFlagMenu #FIXME special case for no @keys, maybe a menu with a greyed-out item "no #none#" 5548{ my ($field,$callback,$hash)=@_; 5549 my @keys= @{Songs::ListAll($field)}; 5550 my $makemenu=sub 5551 { my ($start,$end,$keys)=@_; 5552 my $menu=Gtk2::Menu->new; 5553 for my $i ($start..$end) 5554 { my $key=$keys->[$i]; 5555 my $item; 5556 if ($hash) 5557 { $item=Gtk2::CheckMenuItem->new_with_label($key); 5558 my $state= $hash->{$key}||0; 5559 if ($state==1){ $item->set_active(1); } 5560 elsif ($state==2) { $item->set_inconsistent(1); } 5561 $item->signal_connect(toggled => $callback,$key); 5562 } 5563 else 5564 { $item=Gtk2::MenuItem->new_with_label($key); 5565 $item->signal_connect(activate => $callback,$key); 5566 } 5567 $menu->append($item); 5568 } 5569 return $menu; 5570 }; 5571 my $menu=Breakdown_List(\@keys, makemenu=>$makemenu); 5572 return $menu; 5573} 5574 5575sub PopupAAContextMenu 5576{ my $args=$_[0]; 5577 $args->{mainfield}= Songs::MainField($args->{field}); 5578 $args->{lockfield}= $args->{field} eq 'artists' ? 'first_artist' : $args->{field}; 5579 $args->{aaname}= Songs::Gid_to_Get($args->{field},$args->{gid}); 5580 defined wantarray ? BuildMenu(\@cMenuAA, $args) : PopupContextMenu(\@cMenuAA, $args); 5581} 5582 5583sub FilterOnAA 5584{ my ($widget,$field,$gid,$filternb)=@{$_[0]}{qw/self field gid filternb/}; 5585 $filternb=1 unless defined $filternb; 5586 ::SetFilter($widget, Songs::MakeFilterFromGID($field,$gid), $filternb); 5587} 5588sub SearchSame 5589{ my $field=$_[0]; 5590 my ($widget,$IDs,$filternb)=@{$_[1]}{qw/self IDs filternb/}; 5591 $filternb=1 unless defined $filternb; 5592 my $filter=Filter->newadd(FALSE, map Songs::MakeFilterFromID($field,$_), @$IDs); 5593 ::SetFilter($widget,$filter,$filternb); 5594} 5595 5596sub SongsSubMenuTitle 5597{ my $nb=@{ AA::GetIDs($_[0]{field},$_[0]{gid}) }; 5598 return __n("%d song","%d songs",$nb); 5599} 5600sub SongsSubMenu 5601{ my %args=%{$_[0]}; 5602 $args{mode}='S'; 5603 $args{IDs}=\@{ AA::GetIDs($args{field},$args{gid}) }; 5604 BuildMenuOptional(\@SongCMenu,\%args); 5605} 5606 5607sub ArtistContextMenu 5608{ my ($artists,$params)=@_; 5609 $params->{field}='artists'; 5610 if (@$artists==1) { PopupAAContextMenu({%$params,gid=>$artists->[0]}); return; } 5611 my $menu = Gtk2::Menu->new; 5612 for my $ar (@$artists) 5613 { my $name= Songs::Gid_to_Get('artists',$ar); 5614 my $item=Gtk2::MenuItem->new_with_label($name); 5615 my $submenu= PopupAAContextMenu({%$params,gid=>$ar}); 5616 $item->set_submenu($submenu); 5617 $menu->append($item); 5618 } 5619 PopupMenu($menu,nomenupos=>1); 5620} 5621 5622sub DialogSongsProp 5623{ my @IDs=@_; 5624 my $dialog = Gtk2::Dialog->new (_"Edit Multiple Songs Properties", undef, 5625 'destroy-with-parent', 5626 'gtk-save' => 'ok', 5627 'gtk-cancel' => 'none'); 5628 $dialog->set_default_response ('ok'); 5629 my $notebook = Gtk2::Notebook->new; 5630 #$notebook->set_tab_border(4); 5631 #$dialog->vbox->add($notebook); 5632 5633 my $edittag=MassTag->new(@IDs); 5634 $dialog->vbox->add($edittag); 5635 5636 SetWSize($dialog,'MassTag','520x650'); 5637 $dialog->show_all; 5638 5639 $dialog->signal_connect( response => sub 5640 { my ($dialog,$response)=@_; 5641 if ($response eq 'ok') 5642 { $dialog->action_area->set_sensitive(FALSE); 5643 $edittag->save( sub {$dialog->destroy;} ); #the closure will be called when tagging finished #FIXME not very nice 5644 } 5645 else { $dialog->destroy; } 5646 }); 5647} 5648 5649sub DialogSongProp 5650{ my $ID=$_[0]; 5651 if (exists $Editing{$ID}) { $Editing{$ID}->force_present; return; } 5652 my $dialog = Gtk2::Dialog->new (_"Song Properties", undef, []); 5653 my $advanced_button=$dialog->add_button_custom(_("Advanced").'...', 1, icon=>'gtk-edit', tip=>_"Advanced Tag Editing", secondary=>1); 5654 $dialog->add_buttons('gtk-save','ok', 'gtk-cancel','none'); 5655 5656 $dialog->set_default_response ('ok'); 5657 $Editing{$ID}=$dialog; 5658 my $notebook = Gtk2::Notebook->new; 5659 $notebook->set_tab_border(4); 5660 $dialog->vbox->add($notebook); 5661 5662 my $edittag= EditTagSimple->new($ID); 5663 my $editpic= Edit_Embedded_Picture->new($ID); 5664 my $songinfo= Layout::SongInfo->new({ID=>$ID}); 5665 $notebook->append_page( $edittag, Gtk2::Label->new(_"Edit")); 5666 $notebook->append_page( $songinfo, Gtk2::Label->new(_"Info")); 5667 $notebook->append_page( $editpic, Gtk2::Label->new(_"Embedded Pictures")); 5668 5669 $dialog->{update}=sub { $edittag->fill; $editpic->update; }; 5670 5671 SetWSize($dialog,'SongInfo','420x540'); 5672 $dialog->show_all; 5673 5674 $dialog->signal_connect( response => sub 5675 { warn "EditTag response : @_\n" if $debug; 5676 my ($dialog,$response)=@_; 5677 if ($response eq '1') { AdvancedSongProp($dialog,$ID); return; } 5678 if ($response eq 'ok') 5679 { my @set; 5680 push @set, $edittag->get_changes; 5681 push @set, $editpic->get_changes; 5682 Songs::Set($ID,\@set,window=>$dialog) if @set; 5683 } 5684 delete $Editing{$ID}; 5685 $dialog->destroy; 5686 }); 5687} 5688 5689sub AdvancedSongProp 5690{ my ($base_dialog,$ID)=@_; 5691 my $adv_dialog = Gtk2::Dialog->new (_"Advanced Tag Editing", $base_dialog, 5692 [qw/destroy-with-parent/], 5693 'gtk-ok' => 'ok', 5694 'gtk-cancel' => 'none'); 5695 $adv_dialog->set_default_response ('ok'); 5696 my $adv_edit=EditTag->new($adv_dialog,$ID); 5697 unless ($adv_edit) { ::ErrorMessage(_"Can't read file or invalid file"); return } 5698 $adv_dialog->vbox->add($adv_edit); 5699 ::SetWSize($adv_dialog,'AdvTag','540x505'); 5700 $adv_dialog->show_all; 5701 $base_dialog->set_sensitive(0); 5702 $adv_dialog->signal_connect( response => sub 5703 { my ($adv_dialog,$response)=@_; 5704 if ($response eq 'ok') 5705 { $adv_edit->save; 5706 Songs::ReReadFile($ID); 5707 $base_dialog->{update}->(); 5708 } 5709 $base_dialog->set_sensitive(1); 5710 $adv_dialog->destroy; 5711 }); 5712} 5713 5714sub SongsChanged 5715{ warn "SongsChanged @_\n" if $debug; 5716 my ($IDs,$fields)=@_; 5717 Filter::clear_cache(); 5718 if (defined $SongID && (grep $SongID==$_,@$IDs)) # if current song is part of the changed songs 5719 { $ListPlay->UpdateLock if $TogLock && OneInCommon([Songs::Depends($TogLock)],$fields); 5720 HasChanged('CurSong',$SongID); 5721 } 5722 for my $group (keys %SelID) 5723 { HasChangedSelID($group,$SelID{$group}) if grep $SelID{$group}==$_, @$IDs; 5724 } 5725 QHasChanged('NextSongs') if OneInCommon($IDs,\@NextSongs); 5726 QHasChanged('RecentSongs') if OneInCommon($IDs,$Recent); 5727 HasChanged(SongsChanged=>$IDs,$fields); 5728 GMB::ListStore::Field::changed(@$fields); 5729} 5730sub SongAdd #only called from IdleLoop 5731{ my $ID=Songs::New($_[0]); 5732 return unless defined $ID; 5733 push @ToAdd_IDsBuffer,$ID; 5734 $ProgressNBSongs++; 5735 #IdleDo('0_AddIDs',30000,\&SongAdd_now); 5736} 5737sub SongAdd_now 5738{ push @ToAdd_IDsBuffer,@_; 5739 return unless @ToAdd_IDsBuffer; 5740 my @IDs=@ToAdd_IDsBuffer; #FIXME remove IDs already in Library #FIXME check against master filter ? 5741 @ToAdd_IDsBuffer=(); 5742 Filter::clear_cache(); 5743 AA::IDs_Changed(); 5744 $Library->Push(\@IDs); 5745 HasChanged(SongsAdded=>\@IDs); 5746 AutoSelPictures(album=> @{Songs::UniqList(album=>\@IDs)}); 5747} 5748sub SongsRemove 5749{ my $IDs=$_[0]; 5750 Filter::clear_cache(); 5751 for my $ID (@$IDs, map("L$_", @$IDs)) { $::Editing{$ID}->destroy if exists $::Editing{$ID};} 5752 AA::IDs_Changed(); 5753 HasChanged(SongsRemoved=>$IDs); 5754 $RecentPos-- while $RecentPos && $Recent->[$RecentPos-1]!=$SongID; #update RecentPos if needed 5755 Songs::Set($IDs,missing=>$::DAYNB); #FIXME if song in EstimatedLength, set length to 0 ??? 5756} 5757sub UpdateMasterFilter 5758{ SongAdd_now(); #flush waiting list 5759 my @diff; 5760 $diff[$_]=1 for @$Library; 5761 my $mfilter= $Options{MasterFilterOn} && $Options{MasterFilter} || ''; 5762 my $newlist= Filter->newadd(TRUE,'missing:e:0', $mfilter)->filter_all; 5763 $diff[$_]+=2 for @$newlist; 5764 my @toadd= grep $diff[$_]==2, @$newlist; 5765 my @toremove= grep $diff[$_] && $diff[$_]==1, 0..$#diff; 5766 Filter::clear_cache(); 5767 AA::IDs_Changed(); 5768 $Library->Replace($newlist); 5769 HasChanged(SongsHidden=> \@toremove); 5770 HasChanged(SongsAdded=> \@toadd); 5771} 5772 5773 5774our %playlist_file_parsers; 5775INIT 5776{%playlist_file_parsers= 5777 ( m3u => \&m3u_to_files, 5778 pls => \&pls_to_files, 5779 ); 5780} 5781sub m3u_to_files 5782{ my $content=shift; 5783 my @files= grep m#\S# && !m/^\s*#/, split /[\n\r]+/, $content; 5784 s#^\s*## for @files; 5785 return @files; 5786} 5787sub pls_to_files 5788{ my $content=shift; 5789 my @files= grep m/^File\d+=/, split /[\n\r]+/, $content; 5790 s#^File\d+=\s*## for @files; 5791 return @files; 5792} 5793 5794sub Parse_playlist_file #return filenames from playlist files (.m3u, .pls, ...) 5795{ my $pl_file=shift; 5796 my ($basedir,$name)= splitpath($pl_file); 5797 ($name,my $ext)= barename($name); 5798 my $sub= $playlist_file_parsers{lc $ext}; 5799 if (!$sub) { warn "Unsupported playlist format '$name.$ext'\n" } 5800 open my($fh),'<',$pl_file or do {warn "Error reading $pl_file : $!"; return}; 5801 my $content = do { local( $/ ) ; <$fh> } ; 5802 close $fh; 5803 my @list; 5804 for my $file ($sub->($content)) 5805 { if ($file=~s#^file://##) { $file=decode_url($file); } 5806 elsif ($file=~m#^http://#) {next} #ignored for now 5807 #push @list, CaseSensFile( rel2abs($file,$basedir) ); 5808 push @list,$file; 5809 } 5810 if (1) # try hard to find the correct filenames by trying different encodings and case-incensivity 5811 { my @enc= sort { ($Encoding_pref{$b}||0) <=> ($Encoding_pref{$a}||0) } grep {($Encoding_pref{$_}||0) >=0} Encode->encodings(':all'); 5812 for my $enc (@enc) 5813 { my @found; 5814 my @test=@list; 5815 eval { no warnings; 5816 for my $file (@test) 5817 { Encode::from_to($file,$enc, 'UTF-8', Encode::FB_CROAK); 5818 $file &&= CaseSensFile(rel2abs($file,$basedir)); 5819 if ($file && -f $file) { push @found,$file } else {last} 5820 } 5821 }; 5822 if (@found==@list) 5823 { warn "playlist import: using encoding $enc\n" if $::debug; 5824 $Encoding_pref{$enc}||=1; #give some priority to found encoding 5825 return @found; 5826 } 5827 } 5828 } 5829 return map CaseSensFile(rel2abs($_,$basedir)), @list; 5830} 5831 5832sub Import_playlist_file #create saved lists from playlist files (.m3u, .pls, ...) 5833{ my $pl_file=shift; 5834 warn "Importing $pl_file\n" if $Verbose; 5835 my @files=Parse_playlist_file($pl_file); 5836 my @list; my @toadd; 5837 for my $file (@files) 5838 { my $ID=Songs::FindID($file); 5839 #unless (defined $ID) {warn "Can't find file $file in the library\n"; next} 5840 unless (defined $ID) 5841 { $ID=Songs::New($file); 5842 push @toadd,$ID if defined $ID; 5843 } 5844 #unless (defined $ID) {warn "Can't add file $file\n"; next} 5845 next unless defined $ID; 5846 push @list,$ID; 5847 } 5848 SongAdd_now(@toadd) if @toadd; #add IDs to the Library if needed 5849 if (@list) { printf STDERR "$pl_file lists %d files, %d were found, %d were not already in the library\n",scalar @files, scalar @list, scalar @toadd if $Verbose || @files!=@list; } 5850 else { warn "No file from '$pl_file' found in the library\n"; return } 5851 my $name= filename_to_unicode(barename($pl_file)); 5852 $name= _"imported list" unless $name=~m/\S/; 5853 ::IncSuffix($name) while $Options{SavedLists}{$name}; #find a new name 5854 SaveList($name,\@list); 5855} 5856sub Choose_and_import_playlist_files 5857{ my $parentwin= $_[0] && $_[0]->get_toplevel; 5858 my $pattern=join ' ',map "*.$_", sort keys %playlist_file_parsers; 5859 my @files=ChooseFiles(_"Choose playlist files to import", 5860 remember_key=>'LastFolder_playlists', multiple=>1, parent=>$parentwin, 5861 patterns=>[[_"Playlist files",undef,$pattern ]]); 5862 Import_playlist_file($_) for @files; 5863} 5864 5865sub OpenFiles 5866{ my $IDs=Uris_to_IDs($_[1]); 5867 Select(song=>'first',play=>1,staticlist => $IDs) if @$IDs; 5868} 5869 5870sub Uris_to_IDs 5871{ my @urls=split / +/,$_[0]; 5872 #@urls= grep !m#^http://#, @urls; 5873 $_=decode_url($_) for @urls; 5874 my @IDs=FolderToIDs(1,1,@urls); 5875 return \@IDs; 5876} 5877 5878sub FolderToIDs 5879{ my ($add,$recurse,@dirs)=@_; 5880 s#^file://## for @dirs; 5881 @dirs= map cleanpath($_), @dirs; 5882 my @files; 5883 MakeScanRegex() unless $ScanRegex; 5884 my %followeddirs; 5885 while (defined(my $dir=shift @dirs)) 5886 { if (-d $dir) 5887 { # make sure it doesn't look in the same dir twice due to symlinks 5888 my $real= -l $dir ? simplify_path(rel2abs(readlink($dir),parentdir($dir))) : $dir; 5889 next if exists $followeddirs{$real}; 5890 $followeddirs{$real}=undef; 5891 5892 if (opendir my($DIRH),$dir) 5893 { my @list= map $dir.SLASH.$_, grep !m#^\.#, readdir $DIRH; 5894 closedir $DIRH; 5895 push @files, grep -f && m/$ScanRegex/, @list; 5896 push @dirs, grep -d, @list if $recurse; 5897 } 5898 else { warn "Can't open folder $dir : $!\n"; } 5899 } 5900 elsif (-f $dir) 5901 { if ($dir=~m/$ScanRegex/) { push @files,$dir; } 5902 elsif ($dir=~m/\.([^.]*)$/ && $playlist_file_parsers{lc $1}) #playlist files (.m3u, .pls, ...) 5903 { push @files, Parse_playlist_file($dir); 5904 } 5905 } 5906 } 5907 my @IDs; my @toadd; 5908 for my $file (@files) 5909 { my $ID=Songs::FindID($file);# check if missing => check if modified 5910 unless (defined $ID) 5911 { $ID=Songs::New($file); 5912 push @toadd,$ID if defined $ID; 5913 } 5914 push @IDs,$ID if defined $ID; 5915 } 5916 SongAdd_now(@toadd) if $add && @toadd; #add IDs to the Library if needed 5917 return @IDs; 5918} 5919 5920sub MakeScanRegex 5921{ my %ext; $ext{$_}=1 for @ScanExt; 5922 my $ignore= $Options{ScanIgnore} || []; 5923 delete $ext{$_} for @$ignore; 5924 my $re=join '|', sort keys %ext; 5925 warn "Scan regular expression is empty\n" unless $re; 5926 $ScanRegex=qr/\.(?:$re)$/i; 5927} 5928 5929sub ScanFolder 5930{ warn "Scanning : @_\n" if $Verbose; 5931 my $dir=$_[0]; 5932 $dir=~s#^file://##; 5933 $dir=cleanpath($dir); 5934 MakeScanRegex() unless $ScanRegex; 5935 Songs::Build_IDFromFile() unless $Songs::IDFromFile; 5936 $ScanProgress_cb ||= Glib::Timeout->add(500,\&ScanProgress_cb); 5937 my @files; 5938 if (-d $dir) 5939 { if (opendir my($DIRH),$dir) 5940 { @files=readdir $DIRH; 5941 closedir $DIRH; 5942 } 5943 else { warn "ScanFolder: can't open folder $dir : $!\n"; return } 5944 } 5945 elsif (-f $dir) 5946 { ($dir,my $file)=splitpath($dir); 5947 @files=($file) if $file; 5948 } 5949 else {warn "ScanFolder: can't find $dir\n"} 5950 #my @toadd; 5951 for my $file (@files) 5952 { next if $file=~m#^\.#; # skip . .. and hidden files/folders 5953 my $path_file=$dir.SLASH.$file; 5954 #if (-d $path_file) { push @ToScan,$path_file; next; } 5955 if (-d $path_file) 5956 { #next if $notrecursive; 5957 # make sure it doesn't look in the same dir twice due to symlinks 5958 my $real= -l $path_file ? simplify_path(rel2abs(readlink($path_file),$dir)) : $path_file; 5959 next if exists $FollowedDirs{$real}; 5960 $FollowedDirs{$real}=undef; 5961 push @ToScan,$path_file; 5962 next; 5963 } 5964 next unless $file=~$ScanRegex; 5965 #my $ID=Songs::FindID($path_file); 5966 my $ID=$Songs::IDFromFile->{$dir}{$file}; 5967 if (defined $ID) 5968 { next unless Songs::Get($ID,'missing'); 5969 Songs::Set($ID,missing => 0); 5970 $ToReRead->add($ID); #or $ToCheck ? 5971 push @ToAdd_IDsBuffer,$ID; 5972 } 5973 else 5974 { #$ID=Songs::New($path_file); 5975 push @ToAdd_Files, $path_file; 5976 } 5977 } 5978 unless (@ToScan) 5979 { AbortScan(); 5980 } 5981 &launchIdleLoop unless $IdleLoop; 5982} 5983 5984sub CheckProgress_cb 5985{ my $init=$_[0]; 5986 $CheckProgress_cb||=Glib::Timeout->add(500, \&CheckProgress_cb,0); 5987 return if $init; 5988 my @job_id=qw/check reread lengthcheck/; 5989 my $running; 5990 for my $jobarray ($ToCheck,$ToReRead,$ToCheckLength) 5991 { my $id=shift @job_id; 5992 if (@$jobarray) 5993 { ::Progress($id, aborthint=>_"Stop checking", 5994 bartext => '$current / $end', 5995 abortcb => sub { $jobarray->abort; }, 5996 $jobarray->progress, #returns title, details(optional), current, end 5997 ); 5998 $running=1; 5999 } 6000 elsif ($Progress{$id}) { ::Progress($id, abort=>1); } 6001 } 6002 return 1 if $running; 6003 return $CheckProgress_cb=0; 6004} 6005 6006sub AbortScan 6007{ @ToScan=(); undef %FollowedDirs; 6008} 6009sub ScanProgress_cb 6010{ if (@ToScan || @ToAdd_Files) 6011 { my $total= @ToScan + $ProgressNBFolders; 6012 Progress('scan',title => _"Scanning", 6013 details => __n("%d song added","%d songs added", $ProgressNBSongs), 6014 bartext => __n("%d folder","%d folders", $ProgressNBFolders), 6015 current => $ProgressNBFolders, 6016 end =>$total, 6017 abortcb =>\&AbortScan, 6018 aborthint=> _"Stop scanning", 6019 ); 6020 return 1; 6021 } 6022 else 6023 { ::Progress('scan', abort=>1); 6024 return $ScanProgress_cb=0; 6025 } 6026} 6027 6028sub AutoSelPictures 6029{ my ($field,@gids)=@_; 6030 my $ref= $AutoPicChooser{$field} ||= { todo=>[] }; 6031 unshift @{$ref->{todo}}, @gids; 6032 $ref->{idle}||= Glib::Idle->add(\&AutoSelPictures_do_next,$field); 6033 $ref->{timeout}||= Glib::Timeout->add(1000,\&AutoSelPictures_progress_cb,$field); #if @{$ref->{todo}}>10 ?? 6034} 6035sub AutoSelPictures_do_next 6036{ my $field=shift; 6037 my $ref= $AutoPicChooser{$field}; 6038 return 0 unless $ref; 6039 my $gid= shift @{$ref->{todo}}; 6040 AutoSelPicture($field,$gid); 6041 $ref->{done}++; 6042 return 1 if @{$ref->{todo}}; 6043 delete $AutoPicChooser{$field}; 6044 return 0; 6045} 6046sub AutoSelPictures_progress_cb 6047{ my $field=shift; 6048 my $ref= $AutoPicChooser{$field}; 6049 unless ($ref) { Progress('autopic_'.$field, abort=>1); return 0; } 6050 return 0 unless $ref; 6051 my $done= $ref->{done}||0; 6052 Progress('autopic_'.$field, title => _"Selecting pictures", current=> $done, end=> $done+@{$ref->{todo}}, abortcb=> sub { delete $AutoPicChooser{$field}; }, aborthint=> _"Stop selecting pictures", ); 6053 return scalar @{$ref->{todo}}; 6054} 6055 6056sub AutoSelPicture 6057{ my ($field,$gid,$force)=@_; 6058 6059 unless ($force) 6060 # return if picture already set and existing 6061 { my $file= AAPicture::GetPicture($field,$gid); 6062 if (defined $file) 6063 { return unless $file; # file eq '0' => no picture 6064 if ($file=~m/$EmbImage_ext_re(?::\w+)?$/) { return if FileTag::PixFromMusicFile($file,undef,1); } 6065 else { return if -e $file } 6066 } 6067 } 6068 6069 my $IDs= AA::GetIDs($field,$gid); 6070 return unless @$IDs; 6071 6072 my $set; 6073 my %pictures_files; 6074 for my $m (qw/embedded guess/) 6075 { if ($m eq 'embedded') 6076 { my @files= grep m/$EmbImage_ext_re$/, Songs::Map('fullfilename',$IDs); 6077 if (@files) 6078 { $set= first { FileTag::PixFromMusicFile($_,$field,1) && $_ } sort @files; 6079 $set.= ':'.$field if $set; 6080 } 6081 } 6082 elsif ($m eq 'guess') 6083 { warn "Selecting cover for ".Songs::Gid_to_Get($field,$gid)."\n" if $::debug; 6084 6085 my $path= Songs::BuildHash('path', $IDs); 6086 for my $folder (keys %$path) 6087 { my $count_in_folder= AA::Get('id:count','path',$folder); 6088 #warn " removing $folder $count_in_folder != $path->{$folder}\n" if $count_in_folder != $path->{$folder} if $::debug; 6089 delete $path->{$folder} if $count_in_folder != $path->{$folder}; 6090 } 6091 next unless keys %$path; 6092 my $common= find_common_parent_folder(keys %$path); 6093 if (length $common >5) # ignore common parent folder if too short #FIXME compare the depth of $common with others, ignore it if more than 1 or 2 depth diff 6094 { if (!$path->{$common}) 6095 { my $l=Filter->new( 'path:i:'.$common)->filter; 6096 #warn " common=$common ".scalar(@$l)." == ".scalar(@$IDs)." ? \n" if $::debug; 6097 $common=undef if @$l != @$IDs; 6098 } 6099 $path->{$common}= @$IDs if $common; 6100 } 6101 my @folders= sort { $path->{$b} <=> $path->{$a} } keys %$path; 6102 6103 my @words= split / +/, Songs::Gid_to_Get($field,$gid); 6104 tr/0-9A-Za-z//cd for @words; 6105 @words=grep length>2, @words; 6106 6107 my %found; 6108 for my $folder (@folders) 6109 { next unless opendir my($dh), $folder; 6110 for my $file (grep m/$Image_ext_re/, readdir $dh) 6111 { my $score=0; 6112 if ($field eq 'album') { $score+=100 if $file=~m/(?:^|[^a-zA-Z])(?:cover|front|folder|thumb|thumbnail)[^a-zA-Z]/i; } 6113 elsif ( index($file,$field)!=-1 ) { $score+=10 } 6114 #$score-- if $file=~m/\b(?:back|cd|inside|booklet)\b/; 6115 $score++ if $file=~m/\.jpe?g$/; 6116 $score+=10 for grep index($file,$_)!=-1, @words; 6117 $found{ $folder.SLASH.$file }= $score; 6118 warn " $file $score\n" if $::debug; 6119 } 6120 last if %found; #don't look in other folders if found at least a picture 6121 } 6122 ($set)= sort { $found{$b} <=> $found{$a} } keys %found; 6123 } 6124 last if $set; 6125 } 6126 if ($set) { AAPicture::SetPicture($field, $gid, $set); } 6127} 6128 6129 6130sub AboutDialog 6131{ my $dialog=Gtk2::AboutDialog->new; 6132 $dialog->set_version(VERSIONSTRING); 6133 $dialog->set_copyright("Copyright © 2005-2015 Quentin Sculo"); 6134 $dialog->set_logo_icon_name('gmusicbrowser'); 6135 #$dialog->set_comments(); 6136 $dialog->set_license("Released under the GNU General Public Licence version 3\n(http://www.gnu.org/copyleft/gpl.html)"); 6137 $dialog->set_website('http://gmusicbrowser.org'); 6138 $dialog->set_authors('Quentin Sculo <squentin@free.fr>'); 6139 $dialog->set_artists(join "\n", 6140 "svg icon : zeltak", 6141 "tango icon theme : Jean-Philippe Guillemin", 6142 "elementary icon theme : Simon Steinbeiß", 6143 ); 6144 $dialog->set_translator_credits( join "\n", sort 6145 'French : Quentin Sculo, Jonathan Fretin, Frédéric Urbain, Brice Boucard, Hornblende & mgrubert', 6146 'Hungarian : Zsombor', 6147 'Spanish : Martintxo, Juanjo & Elega', 6148 'German : vlad & staubi', 6149 'Polish : Robert Wojewódzki, tizzilzol team', 6150 'Swedish : Olle Sandgren', 6151 'Chinese : jk', 6152 'Czech : Vašek Kovářík', 6153 'Portuguese : Sérgio Marques', 6154 'Portuguese (Brazillian) : Gleriston Sampaio', 6155 'Korean : bluealbum', 6156 'Russian : tin', 6157 'Italian : Michele Giampaolo', 6158 'Dutch : Gijs Timmers', 6159 'Japanese : Sunatomo', 6160 'Serbian : Саша Петровић', 6161 'Finnish : Jiri Grönroos', 6162 'Chinese(Taiwan) : Hiunn-hué', 6163 'Greek : Elias', 6164 'Malay (Malaysia) : abuyop', 6165 'Lithuanian : Moo', 6166 ); 6167 $dialog->signal_connect( response => sub { $_[0]->destroy if $_[1] eq 'cancel'; }); #used to worked without this, see http://mail.gnome.org/archives/gtk-perl-list/2006-November/msg00035.html 6168 $dialog->show_all; 6169} 6170 6171sub PrefDialog 6172{ my $goto= $_[0] || $Options{LastPrefPage} || 'library'; 6173 if ($OptionsDialog) { $OptionsDialog->force_present; } 6174 else 6175 { $OptionsDialog=my $dialog = Gtk2::Dialog->new (_"Settings", undef,[]); 6176 my $about_button=$dialog->add_button('gtk-about',1); 6177 $dialog->add_button('gtk-close','close'); 6178 my $bb=$about_button->parent; 6179 if ($bb && $bb->isa('Gtk2::ButtonBox')) { $bb->set_child_secondary($about_button,1); } 6180 $dialog->set_default_response ('close'); 6181 SetWSize($dialog,'Pref'); 6182 6183 my $notebook = Gtk2::Notebook->new; 6184 for my $pagedef 6185 ( [library=>_"Library", PrefLibrary()], 6186 [audio =>_"Audio", PrefAudio()], 6187 [layouts=>_"Layouts", PrefLayouts()], 6188 [misc =>_"Misc.", PrefMisc()], 6189 [fields =>_"Fields", Songs::PrefFields()], 6190 [plugins=>_"Plugins", PrefPlugins()], 6191 [keys =>_"Keys", PrefKeys()], 6192 [tags =>_"Tags", PrefTags()], 6193 6194 ) 6195 { my ($key,$label,$page)=@$pagedef; 6196 $notebook->append_page( $page, Gtk2::Label->new($label)); 6197 $notebook->{pages}{$key}=$page; 6198 } 6199 $notebook->signal_connect(switch_page=> sub 6200 { my $page=$_[0]->get_nth_page($_[2]); 6201 my $h=$_[0]{pages}; 6202 ($Options{LastPrefPage})=grep $h->{$_}==$page, keys %$h; 6203 }); 6204 $dialog->{notebook}=$notebook; 6205 $dialog->vbox->pack_start($notebook,TRUE,TRUE,4); 6206 6207 $dialog->signal_connect( response => sub 6208 { if ($_[1] eq '1') {AboutDialog();return}; 6209 $OptionsDialog=undef; 6210 $_[0]->destroy; 6211 }); 6212 $dialog->show_all; 6213 } 6214 6215 # turn to $goto page 6216 ($goto,my $arg)= split /:/,$goto,2; 6217 my $notebook= $OptionsDialog->{notebook}; 6218 if (my $page=$notebook->{pages}{$goto}) 6219 { $notebook->set_current_page($notebook->page_num($page)); 6220 if ($arg && $page->{gotofunc}) { $page->{gotofunc}->($arg) } 6221 } 6222} 6223 6224sub PrefKeys 6225{ my $vbox=Gtk2::VBox->new; 6226 my $store=Gtk2::ListStore->new(('Glib::String')x3,'Glib::Uint'); 6227 my $treeview=Gtk2::TreeView->new($store); 6228 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 6229 ( _"Key",Gtk2::CellRendererText->new,text => 0, weight=> 3, 6230 )); 6231 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 6232 ( _"Command",Gtk2::CellRendererText->new,text => 1 6233 )); 6234 my $sw=Gtk2::ScrolledWindow->new; 6235 $sw->set_shadow_type('etched-in'); 6236 $sw->set_policy('never','automatic'); 6237 $sw->add($treeview); 6238 $vbox->add($sw); 6239 6240 my $refresh_sub=sub 6241 { $store->clear; 6242 my $list= $Options{CustomKeyBindings}; 6243 for my $key (sort keys %$list) 6244 { my ($cmd,$arg)= $list->{$key}=~m/^(\w+)(?:\((.*)\))?$/; 6245 $cmd=$Command{$cmd}[1]; 6246 $cmd.="($arg)" if defined $arg; 6247 my $weight= $key=~s/^\+// ? PANGO_WEIGHT_BOLD : PANGO_WEIGHT_NORMAL; 6248 my $longkey=keybinding_longname($key); 6249 $store->set($store->append, 0,$longkey, 1,$cmd, 2,$key, 3,$weight); 6250 } 6251 %CustomBoundKeys=%{ make_keybindingshash($Options{CustomKeyBindings}) }; 6252 }; 6253 6254 my $refresh_sensitive; 6255 my $key_entry=Gtk2::Entry->new; 6256 $key_entry->{key}=''; 6257 $key_entry->set_tooltip_text(_"Press a key or a key combination"); 6258 $key_entry->set_editable(FALSE); 6259 $key_entry->signal_connect(key_press_event => sub 6260 { my ($entry,$event)=@_; 6261 my $keyname=Gtk2::Gdk->keyval_name($event->keyval); 6262 my $mod; #warn $event->state; warn $keyname; 6263 $mod.='c' if $event->state >= 'control-mask'; 6264 $mod.='a' if $event->state >= 'mod1-mask'; 6265 $mod.='w' if $event->state >= 'mod4-mask'; # use 'super-mask' ??? 6266 $mod.='s' if $event->state >= 'shift-mask'; 6267 #warn "mod=$mod"; 6268 if (defined $keyname && !WordIn($keyname,'Shift_L Control_L Alt_L Super_L ISO_Level3_Shift Multi_key Menu Control_R Shift_R')) 6269 { $keyname=$mod.'-'.$keyname if $mod; 6270 $entry->{key}=$keyname; 6271 $keyname=keybinding_longname($keyname); 6272 $entry->set_text($keyname); 6273 &$refresh_sensitive; 6274 } 6275 return 1; 6276 }); 6277 6278 my $combochanged; 6279 my $entry_extra=Gtk2::Alignment->new(.5,.5,1,1); 6280 my $combo=TextCombo->new( {map {$_ => $Command{$_}[1]} 6281 sort {$Command{$a}[1] cmp $Command{$b}[1]} 6282 grep defined $Command{$_}[1] && !defined $Command{$_}[3] || ref $Command{$_}[3], 6283 keys %Command 6284 }); 6285 my $vsg=Gtk2::SizeGroup->new('vertical'); 6286 $vsg->add_widget($_) for $key_entry,$combo; 6287 $combochanged=sub 6288 { my $cmd=$combo->get_value; 6289 my $child=$entry_extra->child; 6290 $entry_extra->remove($child) if $child; 6291 if ($Command{$cmd}[2]) 6292 { $entry_extra->set_tooltip_text($Command{$cmd}[2]); 6293 $child= (ref $Command{$cmd}[3] eq 'CODE')? $Command{$cmd}[3]() : Gtk2::Entry->new; 6294 $child->signal_connect(changed => $refresh_sensitive); 6295 $entry_extra->add( $child ); 6296 $vsg->add_widget($child); 6297 $entry_extra->parent->show_all; 6298 } 6299 else 6300 { $entry_extra->parent->hide; 6301 } 6302 &$refresh_sensitive; 6303 }; 6304 $combo->signal_connect( changed => $combochanged ); 6305 6306 my $priority= Gtk2::CheckButton->new(_"High priority"); 6307 $priority->set_tooltip_text(_"If checked, the shortcut has higher priority than the default shortcut of widgets. Warning: this can make some features inaccessible"); 6308 6309 my $butadd= ::NewIconButton('gtk-add',_"Add shorcut key",sub 6310 { my $cmd=$combo->get_value; 6311 return unless defined $cmd; 6312 my $key=$key_entry->{key}; 6313 return if $key eq ''; 6314 if (my $child=$entry_extra->child) 6315 { my $extra= (ref $child eq 'Gtk2::Entry')? $child->get_text : $child->get_value; 6316 $cmd.="($extra)" if $extra ne ''; 6317 } 6318 delete $Options{CustomKeyBindings}{$_} for $key,"+$key"; 6319 $key= "+$key" if $priority->get_active; 6320 $Options{CustomKeyBindings}{$key}=$cmd; 6321 &$refresh_sub; 6322 }); 6323 my $butrm= ::NewIconButton('gtk-remove',_"Remove",sub 6324 { my $iter=$treeview->get_selection->get_selected; 6325 my $key=$store->get($iter,2); 6326 delete $Options{CustomKeyBindings}{$key}; 6327 &$refresh_sub; 6328 }); 6329 6330 $treeview->get_selection->signal_connect(changed => sub 6331 { $butrm->set_sensitive( $_[0]->count_selected_rows ); 6332 }); 6333 $_->set_sensitive(FALSE) for $butadd,$butrm; 6334 $refresh_sensitive=sub 6335 { my $ok=0; 6336 { last if $key_entry->{key} eq ''; 6337 my $cmd=$combo->get_value; 6338 last unless defined $cmd; 6339 if ($Command{$cmd}[2]) { my $re=$Command{$cmd}[3]; last if $re && ref($re) ne 'CODE' && $entry_extra->child->get_text!~m/$re/; } 6340 $ok=1; 6341 } 6342 $butadd->set_sensitive( $ok ); 6343 }; 6344 6345 6346 $vbox->pack_start( 6347 Vpack([ [ 0, Gtk2::Label->new(_"Key") , $key_entry ], 6348 [ 0, Gtk2::Label->new(_"Command") , $combo ], 6349 '_',[ 0, Gtk2::Label->new(_"Arguments") , $entry_extra ], 6350 ],[$butadd,$butrm,$priority] 6351 ),FALSE,FALSE,2); 6352 &$refresh_sub; 6353 &$combochanged; 6354 6355 return $vbox; 6356} 6357 6358sub PrefPlugins 6359{ LoadPlugins(); 6360 my $hbox=Gtk2::HBox->new; 6361 unless (keys %Plugins) {my $label=Gtk2::Label->new(_"no plugins found"); $hbox->add($label);return $hbox} 6362 my $store=Gtk2::ListStore->new('Glib::String','Glib::String','Glib::Boolean'); 6363 my $treeview=Gtk2::TreeView->new($store); 6364 $treeview->set_headers_visible(FALSE); 6365 my $renderer = Gtk2::CellRendererToggle->new; 6366 my $rightbox=Gtk2::VBox->new; 6367 my $plugtitle=Gtk2::Label->new; 6368 my $plugdesc=Gtk2::Label->new; 6369 $plugdesc->set_line_wrap(1); 6370 $plugtitle->set_justify('center'); 6371 my $plug_box; 6372 my $plugin; 6373 6374 my $sub_update= sub 6375 { return unless $plugin; 6376 my $pref=$Plugins{$plugin}; 6377 if ($plug_box && $plug_box->parent) { $plug_box->parent->remove($plug_box); } 6378 my $title= MarkupFormat('<b>%s</b>', $pref->{title}||$pref->{name} ); 6379 $title.= "\n". MarkupFormat('<small><a href="%s">%s</a></small>', $pref->{url},$pref->{url} ) if $pref->{url}; 6380 if (my $aref=$pref->{author}) 6381 { my ($format,@vars)= ('%s : ', _"by"); 6382 for my $author (@$aref) 6383 { if ($author=~m/(.*?)\s*<([-\w.]+@[-\w.]+)>$/) #format : Name <email@example.com> 6384 { $format.='<a href="mailto:%s">%s</a>, '; 6385 push @vars, $2,$1; 6386 } 6387 else 6388 { $format.='%s, '; 6389 push @vars, $author; 6390 } 6391 } 6392 $format=~s/, $//; 6393 $title.= "\n". MarkupFormat("<small>$format</small>",@vars); 6394 } 6395 $plugtitle->set_markup($title); 6396 $plugdesc->set_text( $pref->{desc} ); 6397 if (my $error=$pref->{error}) 6398 { $plug_box=Gtk2::Label->new; 6399 if (my $req= CheckPluginRequirement($plugin) ) 6400 { $plug_box->set_markup($req); 6401 } 6402 else 6403 { $error=PangoEsc($error); 6404 $error=~s#(\(\@INC contains: .*)#<small>$1</small>#s; 6405 $plug_box->set_markup( MarkupFormat("<b>%s</b>\n", _("Error :")) .$error); 6406 $plug_box->set_line_wrap(1); 6407 } 6408 $plug_box->set_selectable(1); 6409 } 6410 elsif ($pref->{loaded}) 6411 { my $package='GMB::Plugin::'.$plugin; 6412 $plug_box=$package->prefbox; 6413 $plug_box->set_sensitive(0) if $plug_box && !$Options{'PLUGIN_'.$plugin}; 6414 } 6415 else 6416 { $plug_box=Gtk2::Label->new(_"Plugin not loaded"); 6417 } 6418 if ($plug_box) 6419 { $rightbox->add($plug_box); 6420 $plug_box->show_all; 6421 } 6422 }; 6423 6424 $renderer->signal_connect(toggled => sub 6425 { my ($cell, $path_string)=@_; 6426 my $iter=$store->get_iter_from_string($path_string); 6427 my $plugin=$store->get($iter, 0); 6428 my $key='PLUGIN_'.$plugin; 6429 if ($Options{$key}) {DeactivatePlugin($plugin)} 6430 else {ActivatePlugin($plugin)} 6431 &$sub_update; 6432 $store->set ($iter, 2, $Options{$key}); 6433 }); 6434 $treeview->append_column 6435 ( Gtk2::TreeViewColumn->new_with_attributes('on',$renderer,active => 2) 6436 ); 6437 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 6438 ( 'plugin name',Gtk2::CellRendererText->new,text => 1 6439 )); 6440 $store->set($store->append,0,$_,1,$Plugins{$_}{name},2,$Options{'PLUGIN_'.$_}) 6441 for sort {lc$Plugins{$a}{name} cmp lc$Plugins{$b}{name}} keys %Plugins; 6442 #my $plugin; 6443 $treeview->signal_connect(cursor_changed => sub 6444 { my $path=($treeview->get_cursor)[0]; 6445 $plugin=$store->get( $store->get_iter($path), 0); 6446 &$sub_update; 6447 }); 6448 6449 $hbox->{gotofunc}=sub #go to a specific row 6450 { my $plugin=shift; 6451 my $iter= $store->get_iter_first; 6452 while ($iter) 6453 { if (lc($store->get($iter,0)) eq lc$plugin) { $treeview->set_cursor($store->get_path($iter)); last; } 6454 $iter=$store->iter_next($iter); 6455 } 6456 }; 6457 6458 my $sw=Gtk2::ScrolledWindow->new; 6459 $sw->set_shadow_type('etched-in'); 6460 $sw->set_policy('never','automatic'); 6461 $sw->add($treeview); 6462 $hbox->pack_start($sw,FALSE,FALSE,2); 6463 $rightbox->pack_start($plugtitle,FALSE,FALSE,2); 6464 $rightbox->pack_start($plugdesc,FALSE,FALSE,2); 6465 $hbox->add($rightbox); 6466 return $hbox; 6467} 6468sub LogView 6469{ my $store=shift; 6470 my $treeview=Gtk2::TreeView->new($store); 6471 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 6472 ( 'log',Gtk2::CellRendererText->new,text => 0 6473 )); 6474 $treeview->set_headers_visible(FALSE); 6475 return new_scrolledwindow($treeview,'etched-in'); 6476} 6477sub SetDefaultOptions 6478{ my $prefix=shift; 6479 while (my ($key,$val)=splice @_,0,2) 6480 { $Options{$prefix.$key}=$val unless defined $Options{$prefix.$key}; 6481 } 6482} 6483 6484sub PrefAudio 6485{ my $sg1=Gtk2::SizeGroup->new('horizontal'); 6486 my $sg2=Gtk2::SizeGroup->new('horizontal'); 6487 my $gst_string="gstreamer"; 6488 $gst_string.= ' '.$::gstreamer_version if $::gstreamer_version; 6489 my ($radio_gst,$radio_123,$radio_mp,$radio_mpv,$radio_ice)=NewPrefRadio('AudioOut', 6490 [ $gst_string => 'Play_GST', 6491 'mpg123/ogg123/...' => 'Play_123', 6492 mplayer => 'Play_mplayer', 6493 mpv => 'Play_mpv', 6494 _"icecast server" => sub {$Options{use_GST_for_server}? 'Play_GST_server' : 'Play_Server'}, 6495 ], cb=>sub 6496 { my $p=$Options{AudioOut}; 6497 return if $PlayPacks{$p}==$Play_package; 6498 $PlayNext_package=$PlayPacks{$p}; 6499 SwitchPlayPackage() unless defined $PlayTime; 6500 $ScanRegex=undef; 6501 }, markup=> '<b>%s</b>',); 6502 6503 #123 6504 my $vbox_123=Gtk2::VBox->new (FALSE, 2); 6505 my $adv1=PrefAudio_makeadv('Play_123','123'); 6506 $vbox_123->pack_start($_,FALSE,FALSE,2) for $radio_123,$adv1; 6507 6508 #gstreamer 6509 my $vbox_gst=Gtk2::VBox->new (FALSE, 2); 6510 if (exists $PlayPacks{Play_GST}) 6511 { my $hbox2=NewPrefCombo(gst_sink => Play_GST->supported_sinks, text => _"output device :", sizeg1=>$sg1, sizeg2=> $sg2); 6512 my $adv2=PrefAudio_makeadv('Play_GST','gstreamer'); 6513 my $albox=Gtk2::Alignment->new(0,0,1,1); 6514 $albox->set_padding(0,0,15,0); 6515 $albox->add(Vpack($hbox2,$adv2)); 6516 $vbox_gst->pack_start($_,FALSE,FALSE,2) for $radio_gst,$albox; 6517 } 6518 else 6519 { $vbox_gst->pack_start($_,FALSE,FALSE,2) for $radio_gst,Gtk2::Label->new(_"GStreamer module not loaded."); 6520 } 6521 6522 #icecast 6523 my $vbox_ice=Gtk2::VBox->new(FALSE, 2); 6524 $Options{use_GST_for_server}=0 unless $PlayPacks{Play_GST_server}; 6525 my $usegst=NewPrefCheckButton(use_GST_for_server => _"Use gstreamer",cb=>sub {$radio_ice->signal_emit('toggled');}, tip=>_"without gstreamer : one stream per file, one connection at a time\nwith gstreamer : one continuous stream, multiple connection possible"); 6526 my $hbox3=NewPrefEntry('Icecast_port',_"port :"); 6527 my $albox=Gtk2::Alignment->new(0,0,1,1); 6528 $albox->set_padding(0,0,15,0); 6529 $albox->add(Vpack($usegst,$hbox3)); 6530 $vbox_ice->pack_start($_,FALSE,FALSE,2) for $radio_ice,$albox; 6531 6532 #mplayer 6533 my $vbox_mp=Gtk2::VBox->new(FALSE, 2); 6534 my $adv4=PrefAudio_makeadv('Play_mplayer','mplayer'); 6535 $vbox_mp->pack_start($_,FALSE,FALSE,2) for $radio_mp,$adv4; 6536 6537 #mpv 6538 my $vbox_mpv=Gtk2::VBox->new(FALSE, 2); 6539 my $advmpv=PrefAudio_makeadv('Play_mpv','mpv'); 6540 $vbox_mpv->pack_start($_,FALSE,FALSE,2) for $radio_mpv,$advmpv; 6541 6542 $vbox_123->set_sensitive($PlayPacks{Play_123}); 6543 $vbox_gst->set_sensitive($PlayPacks{Play_GST}); 6544 $vbox_ice->set_sensitive($PlayPacks{Play_Server}); 6545 $vbox_mp ->set_sensitive($PlayPacks{Play_mplayer}); 6546 $vbox_mpv->set_sensitive($PlayPacks{Play_mpv}); 6547 $usegst->set_sensitive($PlayPacks{Play_GST_server}); 6548 6549 #equalizer 6550 my $EQbut=Gtk2::Button->new(_"Open Equalizer"); 6551 $EQbut->signal_connect(clicked => sub { OpenSpecialWindow('Equalizer'); }); 6552 my $EQcheck=NewPrefCheckButton(use_equalizer => _"Use Equalizer", watch=>1, cb=>sub { SetEqualizer(active=>$::Options{use_equalizer}); }); 6553 $sg1->add_widget($EQcheck); 6554 $sg2->add_widget($EQbut); 6555 my $EQbox=Hpack($EQcheck,$EQbut); 6556 my $eq_cb= sub { $_[0]->set_sensitive( $Play_package->{EQ} ); }; 6557 Watch($EQcheck, AudioBackend=> $eq_cb ); 6558 $eq_cb->($EQcheck); 6559 6560 #replaygain 6561 my $rg_check= ::NewPrefCheckButton(use_replaygain => _"Use ReplayGain", tip=>_"Normalize volume (the files must have replaygain tags)", cb=>\&Set_replaygain ); 6562 my $rg_cb= sub { $_[0]->set_sensitive( $Play_package->{RG} ); }; 6563 Watch($rg_check, AudioBackend=> $rg_cb ); 6564 $rg_cb->($rg_check); 6565 my $rga_start=Gtk2::Button->new(_"Start ReplayGain analysis"); 6566 $rga_start->set_tooltip_text(_"Analyse and add replaygain tags for all songs that don't have replaygain tags, or incoherent album replaygain tags"); 6567 $rga_start->signal_connect(clicked => \&GMB::GST_ReplayGain::Analyse_full); 6568 $rga_start->set_sensitive($Play_GST::GST_RGA_ok); 6569 my $rg_opt= Gtk2::Button->new(_"ReplayGain options"); 6570 $rg_opt->signal_connect(clicked => \&replaygain_options_dialog); 6571 $sg1->add_widget($rg_check); 6572 $sg2->add_widget($rg_opt); 6573 6574 my $vbox=Vpack( $vbox_gst, Gtk2::HSeparator->new, 6575 $vbox_123, Gtk2::HSeparator->new, 6576 $vbox_mp, Gtk2::HSeparator->new, 6577 $vbox_mpv, Gtk2::HSeparator->new, 6578 $vbox_ice, Gtk2::HSeparator->new, 6579 $EQbox, 6580 [$rg_check,$rg_opt,($Glib::VERSION >= 1.251 ? $rga_start : ())], 6581 NewPrefCheckButton(IgnorePlayError => _"Ignore playback errors", tip=>_"Skip to next song if an error occurs"), 6582 ); 6583 return $vbox; 6584} 6585 6586sub PrefAudio_makeadv 6587{ my ($package,$name)=@_; 6588 $package=$PlayPacks{$package}; 6589 my $hbox=Gtk2::HBox->new(TRUE, 2); 6590 if (1) 6591 { my $label=Gtk2::Label->new; 6592 $label->signal_connect(realize => sub #delay finding supported formats because mplayer is slow 6593 { my @ext; 6594 for my $e (grep !$::Alias_ext{$_}, $package->supported_formats) 6595 { push @ext, join '/', $e, sort grep $::Alias_ext{$_} eq $e,keys %::Alias_ext; 6596 } 6597 my $list=join ' ',sort @ext; 6598 $_[0]->set_markup_with_format('<small>%s</small>', _("supports : ").$list) if $list; 6599 }) if $package; 6600 $hbox->pack_start($label,TRUE,TRUE,4); 6601 } 6602 if (1) 6603 { my $label=Gtk2::Label->new; 6604 $label->set_markup_with_format('<small>%s</small>', _"advanced options"); 6605 my $but=Gtk2::Button->new; 6606 $but->add($label); 6607 $but->set_relief('none'); 6608 $hbox->pack_start($but,TRUE,TRUE,4); 6609 $but->signal_connect(clicked => sub #create dialog 6610 { my $but=$_[0]; 6611 if ($but->{dialog} && !$but->{dialog}{destroyed}) { $but->{dialog}->force_present; return; } 6612 my $d=$but->{dialog}= Gtk2::Dialog->new(__x(_"{outputname} output settings",outputname => $name), undef,[],'gtk-close' => 'close'); 6613 $d->set_default_response('close'); 6614 my $box=$package->AdvancedOptions; 6615 $d->vbox->add($box); 6616 $d->signal_connect( response => sub { $_[0]{destroyed}=1; $_[0]->destroy; }); 6617 $d->show_all; 6618 }); 6619 } 6620 return $hbox; 6621} 6622 6623my $RG_dialog; 6624sub replaygain_options_dialog 6625{ if ($RG_dialog) {$RG_dialog->force_present;return} 6626 $RG_dialog= Gtk2::Dialog->new (_"ReplayGain options", undef, [], 'gtk-close' => 'close'); 6627 $RG_dialog->signal_connect(destroy => sub {$RG_dialog=undef}); 6628 $RG_dialog->signal_connect(response =>sub {$_[0]->destroy}); 6629 my $songmenu=::NewPrefCheckButton(gst_rg_songmenu => _("Show replaygain submenu").($Glib::VERSION >= 1.251 ? '' : ' '._"(unstable)")); 6630 my $albummode=::NewPrefCheckButton(rg_albummode => _"Album mode", cb=>\&Set_replaygain, tip=>_"Use album normalization instead of track normalization"); 6631 my $nolimiter=::NewPrefCheckButton(rg_limiter => _"Hard limiter", cb=>\&Set_replaygain, tip=>_"Used for clipping prevention"); 6632 my $sg1=Gtk2::SizeGroup->new('horizontal'); 6633 my $sg2=Gtk2::SizeGroup->new('horizontal'); 6634 my $preamp= ::NewPrefSpinButton('rg_preamp', -60,60, cb=>\&Set_replaygain, digits=>1, rate=>.1, step=>.1, sizeg1=>$sg1, sizeg2=>$sg2, text=>_"pre-amp : %d dB", tip=>_"Extra gain"); 6635 my $fallback= ::NewPrefSpinButton('rg_fallback', -60,60, cb=>\&Set_replaygain, digits=>1, rate=>.1, step=>.1, sizeg1=>$sg1, sizeg2=>$sg2, text=>_"fallback-gain : %d dB", tip=>_"Gain for songs missing replaygain tags"); 6636 $RG_dialog->vbox->pack_start($_,0,0,2) for $albummode,$preamp,$fallback,$nolimiter,$songmenu; 6637 $RG_dialog->show_all; 6638 6639 $songmenu->set_sensitive( $Play_GST::GST_RGA_ok ); 6640 # nolimiter not available with mplayer 6641 my $nolimiter_update= sub { $_[0]->set_sensitive( $Options{AudioOut} ne 'Play_mplayer'); }; 6642 Watch($nolimiter, AudioBackend=> $nolimiter_update ); 6643 $nolimiter_update->($nolimiter); 6644} 6645sub Set_replaygain { $Play_package->RG_set_options() if $Play_package->can('RG_set_options'); } 6646 6647sub PrefMisc 6648{ #Default rating 6649 my $DefRating=NewPrefSpinButton('DefaultRating',0,100, step=>10, page=>20, text=>_"Default rating : %d %", cb=> sub 6650 { IdleDo('0_DefaultRating',500,\&Songs::UpdateDefaultRating); 6651 }); 6652 6653 my $checkR1=NewPrefCheckButton(RememberPlayFilter => _"Remember last Filter/Playlist between sessions"); 6654 my $checkR3=NewPrefCheckButton( RememberPlayTime => _"Remember playing position between sessions"); 6655 my $checkR2=NewPrefCheckButton( RememberPlaySong => _"Remember playing song between sessions", widget=> $checkR3); 6656 my $checkR4=NewPrefCheckButton( RememberQueue => _"Remember queue between sessions"); 6657 6658 #Proxy 6659 my $ProxyCheck=NewPrefCheckButton(Simplehttp_Proxy => _"Connect through a proxy", 6660 widget=>Hpack( NewPrefEntry(Simplehttp_ProxyHost => _"Proxy host :"), 6661 NewPrefEntry(Simplehttp_ProxyPort => _"port :"), 6662 ) 6663 ); 6664 6665 #xdg-screensaver 6666 my $screensaver=NewPrefCheckButton(StopScreensaver => _"Disable screensaver when fullscreen and playing", tip=>_"requires xdg-screensaver"); 6667 $screensaver->set_sensitive(0) unless findcmd('xdg-screensaver'); 6668 #shutdown 6669 my $shutentry=NewPrefEntry(Shutdown_cmd => _"Shutdown command :", tip => _"Command used when\n'turn off computer when queue empty'\nis selected", cb=> \&Update_QueueActionList); 6670 6671 #artist splitting 6672 my $asplit= NewPrefMultiCombo( Artists_split_re=>\%Artists_split, 6673 text=>_"Split artist names on :", tip=>_"Used for the Artists field", separator=> ' ', 6674 empty=>_"no splitting", cb=>\&Songs::UpdateArtistsRE ); 6675 #artist in title 6676 my $atitle= NewPrefMultiCombo( Artists_title_re=>\%Artists_from_title, 6677 text=>_"Extract guest artist from title :", tip=>_"Used for the Artists field", separator=> ' ', 6678 empty=>_"ignore title", cb=>\&Songs::UpdateArtistsRE ); 6679 6680 #date format 6681 my $dateex= mktime(5,4,3,2,0,(localtime)[5]); 6682 my $datetip= join "\n", _"use standard strftime variables", _"examples :", 6683 map( sprintf("%s : %s",$_,strftime_utf8($_,localtime($dateex))), split(/ *\| */,"%a %b %d %H:%M:%S %Y | %A %B %I:%M:%S %p %Y | %d/%m/%y %H:%M | %X %x | %F %r | %c | %s") ), 6684 '', 6685 _"Additionally this format can be used :\n default number1 format1 number2 format2 ...\n dates more recent than number1 seconds will use format1, ..."; 6686 my $datefmt=NewPrefEntry(DateFormat => _"Date format :", tip => $datetip, history=> 'DateFormat_history'); 6687 #%c 604800 %A %X 86400 Today %X 6688 my $preview= Label::Preview->new 6689 ( event => 'Option', format=> MarkupFormat('<small><i>%s</i></small>', _"example : %s"), 6690 preview => 6691 # sub { Songs::DateString(localtime $dateex)} 6692 sub { my @sec= ($dateex,map time-$_, ($::Options{DateFormat}||'')=~m/(\d+) +/g); 6693 join "\n", '', map Songs::DateString($_), @sec; 6694 } 6695 ); 6696 my $datealign=Gtk2::Alignment->new(0,.5,0,0); 6697 $datealign->add($datefmt); 6698 6699 my $volstep= NewPrefSpinButton('VolumeStep',1,100, step=>1, text=>_"Volume step :", tip=>_"Amount of volume changed by the mouse wheel"); 6700 my $always_in_pl=NewPrefCheckButton(AlwaysInPlaylist => _"Current song must always be in the playlist", tip=> _"- When selecting a song, the playlist filter will be reset if the song is not in it\n- Skip to another song when removing the current song from the playlist"); 6701 my $pixcache= NewPrefSpinButton('PixCacheSize',1,1000, text=>_"Picture cache : %d MB", cb=>\&GMB::Cache::trim); 6702 6703 my $recent_include_not_played= NewPrefCheckButton(AddNotPlayedToRecent => _"Recent songs include skipped songs that haven't been played.", tip=> _"When changing songs, the previous song is added to the recent list even if not played at all."); 6704 6705 my $playedpercent= NewPrefSpinButton('PlayedMinPercent' ,0,100, text=>_"Threshold to count a song as played : %d %"); 6706 my $playedseconds= NewPrefSpinButton('PlayedMinSeconds' ,0,99999,text=>_"or %d seconds"); 6707 6708 my $urlcmd= NewPrefEntry(OpenUrl => _"Command to open urls :", tip => _"Will use system's default if blank", history=> 'OpenUrl_history'); 6709 my $foldercmd= NewPrefEntry(OpenFolder => _"Command to open folders :", tip => _"Will use system's default if blank", history=> 'OpenFolder_history'); 6710 6711 my $vbox= Vpack( $checkR1,$checkR2,$checkR4, $DefRating,$ProxyCheck, $asplit, $atitle, 6712 [0,$datealign,$preview], $screensaver,$shutentry, $always_in_pl, 6713 $recent_include_not_played, $volstep, $pixcache, 6714 [ $playedpercent, $playedseconds ], 6715 $urlcmd, $foldercmd, 6716 ); 6717 my $sw = Gtk2::ScrolledWindow->new; 6718 $sw->set_shadow_type('etched-in'); 6719 $sw->set_policy('never','automatic'); 6720 $sw->add_with_viewport($vbox); 6721 return $sw; 6722} 6723 6724sub PrefLayouts 6725{ my $vbox=Gtk2::VBox->new (FALSE, 2); 6726 6727 #Tray 6728 my $traytiplength=NewPrefSpinButton('TrayTipTimeLength', 0,100000, step=>100, text=>_"Display tray tip for %d ms"); 6729 my $checkT5=NewPrefCheckButton(StartInTray => _"Start in tray"); 6730 my $checkT2=NewPrefCheckButton(CloseToTray => _"Close to tray"); 6731 my $checkT3=NewPrefCheckButton(ShowTipOnSongChange => _"Show tray tip on song change", widget=>$traytiplength); 6732 my $checkT4=NewPrefSpinButton('TrayTipDelay', 0,10000, step=>100, text=> _"Delay before showing tray tip popup on mouse over : %d ms", cb=>\&SetTrayTipDelay); 6733 my $checkT1=NewPrefCheckButton( UseTray => _"Show tray icon", 6734 cb=> sub { &CreateTrayIcon; }, 6735 widget=> Vpack($checkT5,$checkT4,$checkT3) 6736 ); 6737 $checkT1->set_sensitive($TrayIconAvailable); 6738 6739 #layouts 6740 my $sg1=Gtk2::SizeGroup->new('horizontal'); 6741 my $sg2=Gtk2::SizeGroup->new('horizontal'); 6742 my @layouts_combos; 6743 for my $layout ( [ 'Layout', 'G',_"Player window layout :", sub {CreateMainWindow();}, ], 6744 [ 'LayoutB','B',_"Browser window layout :", ], 6745 [ 'LayoutT','T',_"Tray tip window layout :", ], 6746 [ 'LayoutF','F',_"Full screen layout :", ], 6747 [ 'LayoutS','S',_"Search window layout :", ], 6748 ) 6749 { my ($key,$type,$text,$cb)=@$layout; 6750 my $combo= NewPrefLayoutCombo($key,$type,$text,$sg1,$sg2,$cb); 6751 push @layouts_combos, $combo; 6752 } 6753 my $reloadlayouts=Gtk2::Alignment->new(0,.5,0,0); 6754 $reloadlayouts->add( NewIconButton('gtk-refresh',_"Re-load layouts",\&Layout::InitLayouts) ); 6755 6756 #fullscreen button 6757 my $fullbutton=NewPrefCheckButton(AddFullscreenButton => _"Add a fullscreen button", cb=>sub { Layout::WidgetChangedAutoAdd('Fullscreen'); }, tip=>_"Add a fullscreen button to layouts that can accept extra buttons"); 6758 6759 6760 my $icotheme=NewPrefCombo(IconTheme=> GetIconThemesList(), text =>_"Icon theme :", sizeg1=>$sg1,sizeg2=>$sg2, cb => \&LoadIcons); 6761 6762 #packing 6763 $vbox->pack_start($_,FALSE,FALSE,1) for @layouts_combos,$reloadlayouts,$checkT1,$checkT2,$fullbutton,$icotheme; 6764 return $vbox; 6765} 6766 6767sub CreateMainWindow 6768{ my $layout=shift; 6769 $layout=$Options{Layout} unless defined $layout; 6770 $MainWindow->{quitonclose}=0 if $MainWindow; 6771 $MainWindow=Layout::Window->new( $layout, uniqueid=> 'MainWindow', ifexist => 'replace'); 6772 $MainWindow->{quitonclose}=1; 6773} 6774 6775sub PrefTags 6776{ my $vbox=Gtk2::VBox->new (FALSE, 2); 6777 my $warning=Gtk2::Label->new; 6778 $warning->set_markup_with_format('<b>%s</b>', _"Warning : these are advanced options, don't change them unless you know what you are doing."); 6779 $warning->set_line_wrap(1); 6780 my $checkv4=NewPrefCheckButton('TAG_write_id3v2.4',_"Create ID3v2 tags as ID3v2.4", tip=>_"Use ID3v2.4 instead of ID3v2.3 when creating an ID3v2 tag, ID3v2.3 are probably better supported by other softwares"); 6781 my $checklatin1=NewPrefCheckButton(TAG_use_latin1_if_possible => _"Use latin1 encoding if possible in id3v2 tags", tip=>_"the default is utf16 for ID3v2.3 and utf8 for ID3v2.4"); 6782 my $check_unsync=NewPrefCheckButton(TAG_no_desync => _"Do not unsynchronise id3v2 tags", tip=>_"itunes doesn't support unsynchronised tags last time I checked, mostly affect tags with pictures"); 6783 my @Encodings= grep {($Encoding_pref{$_}||0)>=-1} Encode->encodings(':all'); 6784 my $id3v1encoding=NewPrefCombo(TAG_id3v1_encoding => \@Encodings, text => _"Encoding used for id3v1 tags :"); 6785 my $nowrite=NewPrefCheckButton(TAG_nowrite_mode => _"Do not write the tags", tip=>_"Will not write the tags except with the advanced tag editing dialog. The changes will be kept in the library instead.\nWarning, the changes for a song will be lost if the tag is re-read."); 6786 my $noid3v1=NewPrefCheckButton(TAG_id3v1_noautocreate=> _"Do not create an id3v1 tag in mp3 files", tip=>_"Only affect mp3 files that do not already have an id3v1 tag"); 6787 my $updatetags= Gtk2::Button->new(_"Update tags..."); 6788 $updatetags->signal_connect(clicked => \&UpdateTags); 6789 my $updatetags_box= Gtk2::HBox->new(0,0); 6790 $updatetags_box->pack_start($updatetags,FALSE,FALSE,2); 6791 6792 $vbox->pack_start($_,FALSE,FALSE,1) for $warning,$checkv4,$checklatin1,$check_unsync,$id3v1encoding,$noid3v1,$nowrite,$updatetags_box; 6793 return $vbox; 6794} 6795 6796sub UpdateTags 6797{ my $dialog=Gtk2::Dialog->new(_"Update tags", undef, [], 6798 'gtk-ok' => 'ok', 6799 'gtk-cancel' => 'none'); 6800 my $table=Gtk2::Table->new(2,2); 6801 my %checks; 6802 $checks{$_}= Songs::FieldName($_) for Songs::WriteableFields(); 6803 my $rowmax= (keys %checks)/3; #split in 3 columns 6804 my $row=my $col=0; 6805 for my $field (sorted_keys(\%checks)) 6806 { my $check= Gtk2::CheckButton->new( $checks{$field} ); 6807 $checks{$field}=$check; 6808 $table->attach_defaults($check,$col,$col+1,$row,$row+1); 6809 $row++; 6810 if ($row>=$rowmax) {$col++; $row=0} 6811 } 6812 my $label1= Gtk2::Label->new(_"Write value of selected fields in the tags. Useful for fields that were previously not written to tags, to make sure the current value is written."); 6813 my $label2= Gtk2::Label->new(_"Selected songs to update :"); 6814 my $IDs; 6815 $dialog->{label}= my $label3= Gtk2::Label->new(_("Whole library")."\n"._"Drag and drop songs here to replace the selection."); 6816 $label3->set_justify('center'); 6817 $dialog->vbox->pack_start($_,FALSE,FALSE,4) for $label1, $table, $label2, $label3; 6818 $_->set_line_wrap(1) for $label1, $label2, $label3; 6819 $dialog->show_all; 6820 ::set_drag($dialog, dest => [::DRAG_ID,sub { my ($dialog,$type,@IDs)=@_; $IDs=\@IDs; $dialog->{label}->set_text( ::__n('%d song','%d songs',scalar @IDs) ); }]); 6821 6822 $dialog->signal_connect( response => sub 6823 { my ($dialog,$response)=@_; 6824 $IDs||= [@$::Library]; 6825 my @fields= sort grep $checks{$_}->get_active, keys %checks; 6826 if ($response eq 'ok' && @fields && @$IDs) 6827 { $dialog->set_sensitive(0); 6828 my $progressbar = Gtk2::ProgressBar->new; 6829 $dialog->vbox->pack_start($progressbar, 0, 0, 0); 6830 $progressbar->show_all; 6831 Songs::UpdateTags($IDs,\@fields, progress => $progressbar, callback_finish=> sub {$dialog->destroy}); 6832 } 6833 else {$dialog->destroy} 6834 }); 6835} 6836 6837sub AskRenameFolder 6838{ my ($parent,$old)=splitpath($_[0]); 6839 $parent= cleanpath($parent,1); 6840 my $dialog=Gtk2::Dialog->new(_"Rename folder", undef, 6841 [qw/modal destroy-with-parent/], 6842 'gtk-ok' => 'ok', 6843 'gtk-cancel' => 'none'); 6844 $dialog->set_default_response('ok'); 6845 $dialog->set_border_width(3); 6846 my $entry=Gtk2::Entry->new; 6847 $entry->set_activates_default(TRUE); 6848 $entry->set_text( filename_to_utf8displayname($old) ); 6849 $dialog->vbox->pack_start( Gtk2::Label->new(_"Rename this folder to :") ,FALSE,FALSE,1); 6850 $dialog->vbox->pack_start($entry,FALSE,FALSE,1); 6851 $dialog->show_all; 6852 { last unless $dialog->run eq 'ok'; 6853 my $new=$entry->get_text; 6854 last if $new eq ''; 6855 last if $new=~m/$QSLASH/o; #FIXME allow moving folder 6856 $old= $parent.$old.SLASH; 6857 $new= $parent.filename_from_unicode($new).SLASH; 6858 last if $old eq $new; 6859 -d $new and ErrorMessage(__x(_"{folder} already exists",folder=> filename_to_utf8displayname($new) )) and last; #FIXME use an error dialog 6860 rename $old,$new 6861 or ErrorMessage(__x(_"Renaming {oldname}\nto {newname}\nfailed : {error}", 6862 oldname=> filename_to_utf8displayname($old), 6863 newname=> filename_to_utf8displayname($new), 6864 error=>$!)) 6865 and last; #FIXME use an error dialog 6866 UpdateFolderNames($old,$new); 6867 } 6868 $dialog->destroy; 6869} 6870 6871sub MoveFolder #FIXME implement 6872{ my ($parent,$folder)=splitpath($_[0]); 6873 $parent= cleanpath($parent,1); 6874 my $new=ChooseDir(_"Move folder to", path=>$parent); 6875 return unless $new; 6876 my $old=$parent.$folder.SLASH; 6877 $new.=SLASH.$folder.SLASH; 6878# if ( move(filename_from_unicode($old),filename_from_unicode($new)) ) 6879 if (0) #FIXME implement move folders 6880 { UpdateFolderNames($old,$new); 6881 } 6882} 6883 6884sub UpdateFolderNames 6885{ my ($oldpath,$newpath)=@_; 6886 $_=cleanpath($_) for $oldpath,$newpath; 6887 my $filter= 'path:i:'.Songs::filename_escape($oldpath); 6888 utf8::upgrade($filter); #for unclear reasons, it is needed for non-utf8 folder names. Things should be clearer once the filter code is changed to keep patterns in variables, instead of including them in the eval 6889 my $renamed=Songs::AllFilter($filter); 6890 6891 my $pattern=qr/^\Q$oldpath\E/; 6892 my @newpath; 6893 for my $ID (@$renamed) 6894 { my $path= Songs::Get($ID,'path'); 6895 $path=~s/$pattern/$newpath/; 6896 push @newpath,$path; 6897 } 6898 Songs::Set($renamed,'@path'=>\@newpath) if @$renamed; 6899 6900 GMB::Picture::UpdatePixPath($oldpath,$newpath); 6901} 6902 6903sub PrefLibrary 6904{ my $store=Gtk2::ListStore->new('Glib::String','Glib::String'); 6905 my $treeview=Gtk2::TreeView->new($store); 6906 $treeview->set_headers_visible(FALSE); 6907 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 6908 ( _"Folders to search for new songs",Gtk2::CellRendererText->new,'text',1) 6909 ); 6910 my $refresh=sub 6911 { my ($store,$changed_key)=@_; 6912 return if $changed_key && $changed_key ne 'LibraryPath'; 6913 $store->clear; 6914 $store->set($store->append,0,$_,1,filename_to_utf8displayname(decode_url($_))) for sort @{$Options{LibraryPath}}; 6915 }; 6916 $refresh->($store); 6917 Watch($store, Option => $refresh); 6918 ::set_drag($treeview, dest => [::DRAG_FILE,sub 6919 { my ($treeview,$type,@list)=@_; 6920 AddPath(1,@list); 6921 }]); 6922 6923 my $addbut=NewIconButton('gtk-add',_"Add folder", sub { ChooseAddPath(1); }); 6924 my $rmdbut=NewIconButton('gtk-remove',_"Remove"); 6925 6926 my $selection=$treeview->get_selection; 6927 $selection->set_mode('multiple'); 6928 $selection->signal_connect( changed => sub 6929 { my $sel=$_[0]->count_selected_rows; 6930 $rmdbut->set_sensitive($sel); 6931 }); 6932 $rmdbut->set_sensitive(FALSE); 6933 $rmdbut->signal_connect( clicked => sub 6934 { my @rows= $selection->get_selected_rows; 6935 for my $path (@rows) 6936 { my $iter=$store->get_iter($path); 6937 next unless $iter; 6938 my $s= $store->get($iter,0); 6939 @{$Options{LibraryPath}}=grep $_ ne $s, @{$Options{LibraryPath}}; 6940 } 6941 HasChanged(Option=>'LibraryPath'); 6942 }); 6943 6944 my $sw= new_scrolledwindow($treeview,'etched-in'); 6945 my $extensions= NewPrefMultiCombo(ScanIgnore => {map {$_=>$_} @ScanExt}, 6946 text=>_"Ignored file extensions :", tip=>_"Files with these extensions won't be added", empty=>_"none", 6947 cb=>sub {$ScanRegex=undef}, ); 6948 6949 my $CScan=NewPrefCheckButton(StartScan => _"Search for new songs on startup"); 6950 my $CCheck=NewPrefCheckButton(StartCheck => _"Check for updated/deleted songs on startup"); 6951 my $BScan= NewIconButton('gtk-refresh',_"scan now", sub { IdleScan(); }); 6952 my $BCheck=NewIconButton('gtk-refresh',_"check now",sub { IdleCheck(); }); 6953 my $label=Gtk2::Label->new(_"Folders to search for new songs"); 6954 6955 my $reorg=Gtk2::Button->new(_("Reorganize files and folders").'...'); 6956 $reorg->signal_connect( clicked => sub 6957 { return unless @$Library; 6958 DialogMassRename(@$Library); 6959 }); 6960 6961 my $autoremove= NewPrefCheckButton( AutoRemoveCurrentSong => _"Automatically remove current song if not found"); 6962 my $lengthcheck= NewPrefCombo( LengthCheckMode => { never=>_"Never", current=>_"When current song", add=>_"When added", }, 6963 text=> _"Check real length of mp3", 6964 tip => _("mp3 files without a VBR header requires a full scan to check its real length and bitrate")."\n". 6965 _('You can force a check for these files by holding shift when selecting "Re-read tags"') 6966 ); 6967 my $Blengthcheck= NewIconButton('gtk-refresh',_"check length now",sub { CheckLength(); }); 6968 $Blengthcheck->{timeout}= Glib::Timeout->add(1000, \&PrefLibrary_update_checklength_button,$Blengthcheck);#refresh it 1s after creation 6969 Watch($Blengthcheck,$_=> sub { my ($button,$IDs,$fields)=@_; $button->{timeout}||= Glib::Timeout->add(2000, \&PrefLibrary_update_checklength_button,$button) if !$fields || grep($_ eq 'length_estimated', @$fields); } ) for qw/SongsAdded SongsChanged/; #refresh it 2s after a change 6970 6971 my $masterfilter= FilterCombo->new( $Options{MasterFilter}, sub { $Options{MasterFilter}=$_[1]; UpdateMasterFilter(); } ); 6972 my $masterfiltercheck= NewPrefCheckButton( MasterFilterOn=> _"Use a master filter", widget=>$masterfilter, cb=>\&UpdateMasterFilter, horizontal=>1 ); 6973 my $librarysize= Label::Preview->new( 6974 event => 'SongsRemoved SongsHidden SongsAdded', 6975 preview=> sub 6976 { my $listtotal=Filter->new('missing:e:0')->filter_all; 6977 my $lib= scalar @$Library; 6978 my $excl= scalar(@$listtotal)-$lib; 6979 my $s= __n("Library size : %d song","Library size : %d songs",$lib); 6980 $s.= ' '. __n("(%d song excluded)", "(%d songs excluded)",$excl) if $excl; 6981 return $s; 6982 6983 } ); 6984 6985 my $sg1=Gtk2::SizeGroup->new('horizontal'); 6986 $sg1->add_widget($_) for $BScan,$BCheck,$Blengthcheck; 6987 my $vbox=Vpack( 1,$label, 6988 '_',$sw, 6989 [$addbut,$rmdbut,'-',$reorg], 6990 [$CCheck,'-',$BCheck], 6991 [$CScan,'-',$BScan], 6992 $extensions, 6993 $autoremove, 6994 [$lengthcheck,'-',$Blengthcheck], 6995 $masterfiltercheck, 6996 $librarysize, 6997 ); 6998 return $vbox; 6999} 7000sub ChooseAddPath 7001{ my ($addtolibrary,$allowfiles)=@_; 7002 $allowfiles&&= [ [_"Music files", undef, join(' ',map '*.'.$_, sort @ScanExt) ], [_"All files",undef,'*'] ]; 7003 my @dirs=ChooseDir(_"Choose folder to add", remember_key=>'LastFolder_Add', multiple=>1, allowfiles=>$allowfiles); 7004 @dirs=map url_escape($_), @dirs; 7005 AddPath($addtolibrary,@dirs); 7006} 7007sub AddPath 7008{ my ($addtolibrary,@dirs)=@_; 7009 s#^file://## for @dirs; 7010 @dirs= grep !m#^\w+://#, @dirs; 7011 my $changed; 7012 for my $dir (@dirs) 7013 { my $d=cleanpath(decode_url($dir)); 7014 if (!-d $d) { ScanFolder($d); next } 7015 IdleScan($d); 7016 next unless $addtolibrary; 7017 next if (grep $dir eq $_,@{$Options{LibraryPath}}); 7018 push @{$Options{LibraryPath}},$dir; 7019 $changed=1; 7020 } 7021 HasChanged(Option=>'LibraryPath') if $changed; 7022} 7023sub PrefLibrary_update_checklength_button 7024{ my $button=shift; 7025 my $l= Filter->new('length_estimated:e:1')->filter; 7026 $button->set_sensitive(@$l>0); 7027 my $text= @$l ? __n("%d song","%d songs",scalar @$l) : 7028 _"no songs needs checking"; 7029 $button->set_tooltip_text($text); 7030 return $button->{timeout}=0; 7031} 7032 7033sub RemoveLabel #FIXME ? label specific 7034{ my ($field,$gid)=@_; 7035 my $label= Songs::Gid_to_Get($field,$gid); 7036 my $filter= Songs::MakeFilterFromGID($field,$gid); 7037 my $nb= @{ $filter->filter }; 7038 my $persistent_labels= $Options{Fields_options}{$field}{persistent_values}; 7039 my $dialog = Gtk2::MessageDialog->new 7040 ( ::get_event_window(), 7041 [qw/modal destroy-with-parent/], 7042 'warning','ok-cancel', 7043 __n("This label is set for %d song.","This label is set for %d songs.",$nb)."\n". 7044 __x(_"Are you sure you want to delete the '{label}' label ?", label => $label) 7045 ); 7046 my $remove_pers; 7047 if (grep $_ eq $label, @$persistent_labels) 7048 { $remove_pers= Gtk2::CheckButton->new(_"Remove from persistent values"); 7049 $dialog->get_content_area->pack_end($remove_pers,0,0,0); 7050 } 7051 $dialog->show_all; 7052 7053 if ($dialog->run eq 'ok') 7054 { if ($remove_pers && $remove_pers->get_active) 7055 { @$persistent_labels= grep $_ ne $label, @$persistent_labels; 7056 } 7057 my $IDlist= Songs::AllFilter($filter); # use AllFilter to include deleted songs still in DB 7058 Songs::Set($IDlist,'-'.$field,$label); 7059 } 7060 $dialog->destroy; 7061} 7062 7063sub RenameLabel 7064{ my ($field,$gid)=@_; 7065 my $old= Songs::Gid_to_Get($field,$gid); 7066 my $dialog = Gtk2::Dialog->new 7067 ( "",::get_event_window(), 7068 [qw/modal destroy-with-parent/], 7069 'gtk-ok' => 'ok', 7070 'gtk-cancel' => 'cancel' 7071 ); 7072 my $label1= Gtk2::Label->new( __x(_"Rename '{label}'",label=>$old) ); 7073 my $label2= Gtk2::Label->new(_("New name").":"); 7074 my $entry= Gtk2::Entry->new; 7075 $entry->set_text($old); 7076 $dialog->get_content_area->pack_start( Vpack($label1,[$label2,$entry]) ,0,0,0); 7077 $dialog->show_all; 7078 7079 my $ok= $dialog->run eq 'ok'; 7080 my $new= $entry->get_text; 7081 if ($ok && $new!~m/^\s*$/ && $new ne $old) 7082 { my $list= Songs::AllFilter( Songs::MakeFilterFromGID($field,$gid) ); 7083 #rename 7084 Songs::Set($list,'+'.$field,$new,'-'.$field,$old); 7085 #if it was a persistent value, rename it there too 7086 my $persistent_labels= $Options{Fields_options}{$field}{persistent_values}; 7087 if (grep $_ eq $old, @$persistent_labels) 7088 { @$persistent_labels= grep $_ ne $old, @$persistent_labels; 7089 push @$persistent_labels, $new unless grep $_ eq $new, @$persistent_labels; 7090 } 7091 } 7092 $dialog->destroy; 7093} 7094 7095sub AddNewLabel 7096{ my ($field,$IDs)=@_; 7097 my $dialog = Gtk2::Dialog->new 7098 ( "",::get_event_window(), 7099 [qw/modal destroy-with-parent/], 7100 'gtk-ok' => 'ok', 7101 'gtk-cancel' => 'cancel' 7102 ); 7103 my $label= Gtk2::Label->new(_("New label").":"); 7104 my $entry= Gtk2::Entry->new; 7105 GMB::ListStore::Field::setcompletion($entry,$field); 7106 $dialog->get_content_area->pack_start( Hpack($label,$entry) ,0,0,0); 7107 $dialog->show_all; 7108 7109 my $ok= $dialog->run eq 'ok'; 7110 my $new= $entry->get_text; 7111 if ($ok && $new!~m/^\s*$/) 7112 { Songs::Set($IDs,'+'.$field,$new); 7113 } 7114 $dialog->destroy; 7115} 7116 7117sub SetOption 7118{ my ($key,$value)=@_; 7119 $Options{$key}=$value; 7120 HasChanged(Option => $key); 7121} 7122 7123sub NewPrefRadio 7124{ my ($key,$text_val,%opt)=@_; 7125 my $sub=$opt{cb}; 7126 my $init=$Options{$key}; 7127 $init='' unless defined $init; 7128 my $cb=sub 7129 { return unless $_[0]->get_active; 7130 my $val=$_[1]; 7131 $val=&$val if ref $val; 7132 SetOption($key,$val); 7133 &$sub if $sub; 7134 }; 7135 my ($radio,@radios); 7136 my $i=0; 7137 while ($i<$#$text_val) 7138 { my $text= $text_val->[$i++]; 7139 my $val0= $text_val->[$i++]; 7140 push @radios, $radio=Gtk2::RadioButton->new($radio); 7141 my $label=Gtk2::Label->new_with_format($opt{markup}||'%s', $text); 7142 $radio->add($label); 7143 my $val= ref $val0 ? &$val0 : $val0; 7144 $radio->set_active(1) if $val eq $init; 7145 $radio->signal_connect(toggled => $cb,$val0); 7146 } 7147 return @radios; 7148} 7149sub NewPrefCheckButton 7150{ my ($key,$text,%opt)=@_; 7151 my ($sub,$tip,$widget,$horizontal,$sizeg,$toolitem,$watch)=@opt{qw/cb tip widget horizontal sizegroup toolitem watch/}; 7152 my $init= $Options{$key}; 7153 my $check=Gtk2::CheckButton->new($text); 7154 $sizeg->add_widget($check) if $sizeg; 7155 $check->set_active(1) if $init; 7156 Watch($check, Option=> sub { return unless $_[1] eq $key; $_[0]{busy}=1; $_[0]->set_active($Options{$key}); $_[0]{busy}=0; }) if $watch; 7157 $check->signal_connect( toggled => sub 7158 { return if $_[0]{busy}; 7159 my $val= $_[0]->get_active ? 1 : 0; 7160 SetOption($_[1],$val); 7161 $_[0]{dependant_widget}->set_sensitive( $_[0]->get_active ) if $_[0]{dependant_widget}; 7162 &$sub if $sub; 7163 },$key); 7164 $check->set_tooltip_text($tip) if defined $tip; 7165 my $return=$check; 7166 if ($widget) 7167 { if ($horizontal) 7168 { $return=Hpack(0,$check,$widget); 7169 } 7170 else 7171 { my $albox=Gtk2::Alignment->new(0,0,1,1); 7172 $albox->set_padding(0,0,15,0); 7173 $albox->add($widget); 7174 $widget=$albox; 7175 $return=Vpack($check,$albox); 7176 } 7177 ::weaken( $check->{dependant_widget}=$widget ); 7178 $widget->set_sensitive(0) unless $init; 7179 } 7180 elsif ($toolitem) 7181 { my $titem=Gtk2::ToolItem->new; 7182 $titem->add($check); 7183 my $item=Gtk2::CheckMenuItem->new($text); 7184 $item->set_active(1) if $init; 7185 $titem->set_proxy_menu_item($key,$item); 7186 $item->signal_connect(toggled => sub 7187 { return if $_[0]->{busy}; 7188 $check->set_active($_[0]->get_active); 7189 }); 7190 $check->signal_connect( toggled => sub 7191 { my $item=$_[0]->parent->retrieve_proxy_menu_item; 7192 $item->{busy}=1; 7193 $item->set_active($_[0]->get_active); 7194 delete $item->{busy}; 7195 }); 7196 return $titem; 7197 } 7198 return $return; 7199} 7200sub NewPrefEntry 7201{ my ($key,$text,%opt)=@_; 7202 my ($cb,$sg1,$sg2,$tip,$hide,$expand,$history,$width)=@opt{qw/cb sizeg1 sizeg2 tip hide expand history width/}; 7203 my ($widget,$entry); 7204 if ($history) 7205 { $widget=Gtk2::ComboBoxEntry->new_text; 7206 $entry= $widget->child; 7207 my $hist= $Options{$history} || []; 7208 $widget->append_text($_) for @$hist; 7209 $widget->signal_connect( destroy => sub { PrefSaveHistory($history,$_[0]->get_active_text); } ); 7210 } 7211 else { $widget=$entry=Gtk2::Entry->new; } 7212 7213 $entry->set_width_chars($width) if $width; 7214 7215 $sg2->add_widget($widget) if $sg2; 7216 $widget->set_tooltip_text($tip) if defined $tip; 7217 7218 if (defined $text) 7219 { my $box=Gtk2::HBox->new; 7220 my $label=Gtk2::Label->new($text); 7221 $label->set_alignment(0,.5); 7222 $box->pack_start($label,FALSE,FALSE,2); 7223 $box->pack_start($widget,$expand,$expand,2); 7224 $sg1->add_widget($label) if $sg1; 7225 $widget=$box; 7226 } 7227 7228 $entry->set_visibility(0) if $hide; 7229 $entry->set_text($Options{$key}) if defined $Options{$key}; 7230 $entry->signal_connect( changed => sub 7231 { SetOption($_[1], $_[0]->get_text); 7232 &$cb if $cb; 7233 },$key); 7234 return $widget; 7235} 7236 7237sub NewPrefComboText 7238{ my ($key)=@_; 7239 my $combo=Gtk2::ComboBoxEntry->new_text; 7240 my $hist= $Options{$key} || []; 7241 $combo->append_text($_) for @$hist; 7242 $combo->set_active(0); 7243 $combo->signal_connect( destroy => sub { PrefSaveHistory($key,$_[0]->get_active_text); } ); 7244 return $combo; 7245} 7246sub PrefSaveHistory #to be used with NewPrefComboText and NewPrefFileEntry 7247{ my ($key,$newvalue,$max)=@_; 7248 $max||=10; 7249 my $hist= $Options{$key} ||= []; 7250 @$hist= ($newvalue, grep $_ ne $newvalue, @$hist); 7251 $#$hist=$max if $#$hist>$max; 7252} 7253 7254sub NewPrefFileEntry 7255{ my ($key,$text,%opt)=@_; 7256 my ($folder,$sg1,$sg2,$tip,$cb,$key_history)=@opt{qw/folder sizeg1 sizeg2 tip cb history_key/}; 7257 my $label=Gtk2::Label->new($text); 7258 my $widget=my $entry=Gtk2::Entry->new; 7259 if ($key_history) 7260 { $widget=Gtk2::ComboBoxEntry->new_text; 7261 $entry=$widget->child; 7262 my $hist= $Options{$key_history} || []; 7263 $widget->append_text(decode_url($_)) for grep length, @$hist; #won't work with filenames with broken encoding 7264 } 7265 my $button=NewIconButton('gtk-open'); 7266 my $hbox=Gtk2::HBox->new; 7267 my $hbox2=Gtk2::HBox->new(FALSE,0); 7268 $hbox2->pack_start($widget,TRUE,TRUE,0); 7269 $hbox2->pack_start($button,FALSE,FALSE,0); 7270 $hbox->pack_start($_,FALSE,FALSE,2) for $label,$hbox2; 7271 $label->set_alignment(0,.5); 7272 7273 my $enc_warning=Gtk2::Label->new(_"Warning : using a folder with invalid encoding, you should rename it."); 7274 $enc_warning->set_no_show_all(1); 7275 my $vbox=Gtk2::VBox->new(FALSE,0); 7276 $vbox->pack_start($hbox,FALSE,FALSE,0); 7277 $vbox->pack_start($enc_warning,FALSE,FALSE,2); 7278 7279 if ($sg1) { $sg1->add_widget($label); $label->set_alignment(0,.5); } 7280 if ($sg2) { $sg2->add_widget($hbox2); } 7281 7282 $entry->set_tooltip_text($tip) if defined $tip; 7283 if (defined $Options{$key}) 7284 { $entry->set_text(filename_to_utf8displayname(decode_url($Options{$key}))); 7285 $enc_warning->show if url_escape($entry->get_text) ne $Options{$key}; 7286 } 7287 7288 my $busy; 7289 $entry->signal_connect( changed => sub 7290 { return if $busy; 7291 SetOption( $key, url_escape($_[0]->get_text) ); 7292 $enc_warning->hide; 7293 &$cb if $cb; 7294 }); 7295 $button->signal_connect( clicked => sub 7296 { my $file= $folder? ChooseDir($text, path=>$Options{$key}) : undef; 7297 return unless $file; 7298 # could simply $entry->set_text(), but wouldn't work with filenames with broken encoding 7299 SetOption( $key, url_escape($file) ); 7300 $busy=1; $entry->set_text(filename_to_utf8displayname($file)); $busy=undef; 7301 $enc_warning->set_visible( url_escape($entry->get_text) ne $Options{$key} ); 7302 &$cb if $cb; 7303 }); 7304 $entry->signal_connect( destroy => sub { PrefSaveHistory($key_history,url_escape($_[0]->get_text)); } ) if $key_history; 7305 return $vbox; 7306} 7307sub NewPrefSpinButton 7308{ my ($key,$min,$max,%opt)=@_; 7309 my ($text,$text1,$text2,$sg1,$sg2,$tip,$sub,$climb_rate,$digits,$stepinc,$pageinc,$wrap)=@opt{qw/text text1 text2 sizeg1 sizeg2 tip cb rate digits step page wrap/}; #FIXME using text1 and text2 is deprecated and will be removed, use text with %d instead, for example text=>"value : %d seconds" 7310 $stepinc||=1; 7311 $pageinc||=$stepinc*10; 7312 $climb_rate||=1; 7313 $digits||=0; 7314 ($text1,$text2)= split /\s*%d\s*/,$text,2 if $text; 7315 $text1=Gtk2::Label->new($text1) if defined $text1 && $text1 ne ''; 7316 $text2=Gtk2::Label->new($text2) if defined $text2 && $text2 ne ''; 7317 my $adj=Gtk2::Adjustment->new($Options{$key}||=0,$min,$max,$stepinc,$pageinc,0); 7318 my $spin=Gtk2::SpinButton->new($adj,$climb_rate,$digits); 7319 $spin->set_wrap(1) if $wrap; 7320 $adj->signal_connect(value_changed => sub 7321 { SetOption( $_[1], $_[0]->get_value); 7322 &$sub if $sub; 7323 },$key); 7324 $spin->set_tooltip_text($tip) if defined $tip; 7325 if ($sg1 && $text1) { $sg1->add_widget($text1); $text1->set_alignment(0,.5); } 7326 if ($sg2) { $sg2->add_widget($spin); } 7327 if ($text1 or $text2) 7328 { my $hbox=Gtk2::HBox->new; 7329 $hbox->pack_start($_,FALSE,FALSE,2) for grep $_, $text1,$spin,$text2; 7330 return $hbox; 7331 } 7332 return $spin; 7333} 7334 7335sub NewPrefCombo 7336{ my ($key,$list,%opt)=@_; 7337 my ($text,$cb0,$sg1,$sg2,$toolitem,$tree,$tip,$event)=@opt{qw/text cb sizeg1 sizeg2 toolitem tree tip event/}; 7338 my $cb=sub 7339 { SetOption($key,$_[0]->get_value); 7340 &$cb0 if $cb0; 7341 }; 7342 my $class= $tree ? 'TextCombo::Tree' : 'TextCombo'; 7343 my $combo= $class->new( $list, $Options{$key}, $cb, event=>$event ); 7344 my $widget=$combo; 7345 if (defined $text) 7346 { my $label=Gtk2::Label->new($text); 7347 my $hbox=Gtk2::HBox->new; 7348 $hbox->pack_start($_,FALSE,FALSE,2) for $label,$combo; 7349 $sg1->add_widget($label) if $sg1; 7350 $sg2->add_widget($combo) if $sg2; 7351 $label->set_alignment(0,.5); 7352 $widget=$hbox; 7353 } 7354 $widget->set_tooltip_text($tip) if defined $tip; 7355 if (defined $toolitem) 7356 { $widget= $combo->make_toolitem($toolitem,$key,$widget); 7357 } 7358 return $widget; 7359} 7360 7361sub NewPrefLayoutCombo 7362{ my ($key,$type,$text,$sg1,$sg2,$cb)=@_; 7363 my $buildlist= sub { Layout::get_layout_list($type) }; 7364 my $combo= NewPrefCombo($key => $buildlist, text => $text, sizeg1=>$sg1,sizeg2=>$sg2, tree=>1, cb => $cb, event=>'Layouts'); 7365 my $set_tooltip= sub #show layout author in tooltip 7366 { return if $_[1] && $_[1] ne $key; 7367 my $layoutdef= $Layout::Layouts{$Options{$key}}; 7368 my $tip= $layoutdef->{PATH}.$layoutdef->{FILE}.':'.$layoutdef->{LINE}; 7369 if (my $author= $layoutdef->{Author}) { $tip= _("by")." $author\n$tip"; } 7370 $_[0]->set_tooltip_text($tip); 7371 }; 7372 Watch( $combo, Option => $set_tooltip); 7373 $set_tooltip->($combo); 7374 return $combo; 7375} 7376 7377sub NewPrefMultiCombo 7378{ my ($key,$possible_values_hash,%opt)=@_; 7379 my $opthash= $opt{opthash} || \%Options; 7380 my $sep= $opt{separator}|| ', '; 7381 my $display_cb= $opt{display} || sub 7382 { my $values= $opthash->{$key} || []; 7383 return $opt{empty} unless @$values; 7384 return join $sep,map $possible_values_hash->{$_}||=qq("$_"), superlc_sort(@$values); 7385 }; 7386 $display_cb= sub {$opt{display}} if !ref $display_cb; # label in the button is a constant 7387 my $button= Gtk2::Button->new; 7388 7389 my $label_value= Gtk2::Label->new; 7390 $label_value->set_ellipsize($opt{ellipsize}||'none'); 7391 my $hbox=Gtk2::HBox->new(0,0); 7392 $hbox->pack_start($label_value,1,1,2); 7393 $hbox->pack_start($_,0,0,2) for Gtk2::VSeparator->new, Gtk2::Arrow->new('down','none'); 7394 $button->add($hbox); 7395 $label_value->set_text( $display_cb->() ); 7396 7397 my $change_cb=sub 7398 { my $button= $_[0]{button}; 7399 $opthash->{$key}= $_[1]; 7400 $label_value->set_text( $display_cb->() ); 7401 $opt{cb}->() if $opt{cb}; 7402 }; 7403 my $click_cb=sub 7404 { my ($button,$event)=@_; 7405 my $menu=BuildChoiceMenu 7406 ( $possible_values_hash, 7407 check=> sub { $opthash->{$key}||[] }, 7408 code => $change_cb, 7409 'reverse'=>1, return_list=>1, 7410 args => {button=>$button}, 7411 ); 7412 PopupMenu($menu,event=>$event) if $menu; 7413 1; 7414 }; 7415 7416 $button->signal_connect(button_press_event=> \&$click_cb); 7417 my $widget=$button; 7418 if (defined $opt{text}) 7419 { my $hbox0= Gtk2::HBox->new; 7420 my $label= Gtk2::Label->new($opt{text}); 7421 $hbox0->pack_start($_, FALSE, FALSE, 2) for $label,$button; 7422 $widget=$hbox0; 7423 } 7424 $widget->set_tooltip_text($opt{tip}) if $opt{tip}; 7425 return $widget; 7426} 7427 7428sub NewIconButton 7429{ my ($icon,$text,$coderef,$style,$tip)=@_; 7430 my $but=Gtk2::Button->new; 7431 $but->set_relief($style) if $style; 7432 #$but->set_image(Gtk2::Image->new_from_stock($icon,'menu')); 7433 #$but->set_label($text) if $text; 7434# my $widget=Gtk2::Image->new_from_stock($icon,'large-toolbar'); 7435 my $widget=Gtk2::Image->new_from_stock($icon,'menu'); 7436 if ($text) 7437 { my $box=Gtk2::HBox->new(FALSE, 4); 7438 $box->pack_start($_, FALSE, FALSE, 2) for $widget,Gtk2::Label->new($text); 7439 $widget=$box; 7440 } 7441 $but->add($widget); 7442 $but->signal_connect(clicked => $coderef) if $coderef; 7443 $but->set_tooltip_text($tip) if defined $tip; 7444 return $but; 7445} 7446 7447sub EditWeightedRandom 7448{ my ($widget,$sort,$name,$sub)=@_; 7449 my $dialog=GMB::Edit->new($widget,'WRandom',$sort,$name); 7450 return $dialog->Result($sub); 7451} 7452sub EditSortOrder 7453{ my ($widget,$sort,$name,$sub)=@_; 7454 my $dialog=GMB::Edit->new($widget,'Sort',$sort,$name); 7455 return $dialog->Result($sub); 7456} 7457sub EditFilter 7458{ my ($widget,$filter,$name,$sub)=@_; 7459 my $dialog=GMB::Edit->new($widget,'Filter',$filter,$name); 7460 $sub||='' unless wantarray;#FIXME 7461 return $dialog->Result($sub); 7462} 7463sub EditSTGroupings 7464{ my ($widget,$filter,$name,$sub)=@_; 7465 my $dialog=GMB::Edit->new($widget,'STGroupings',$filter,$name); 7466 return $dialog->Result($sub); 7467} 7468 7469sub SaveSFRG 7470{ my ($key,$name,$val,$newname)=@_; 7471 my $saved=$Options{$key}; 7472 if (defined $newname) {$saved->{$newname}=delete $saved->{$name};} 7473 elsif (defined $val) {$saved->{$name}=$val;} 7474 else {delete $saved->{$name};} 7475 HasChanged($key); 7476} 7477sub SaveFilter { SaveSFRG('SavedFilters',@_); } 7478sub SaveList 7479{ my ($name,$val,$newname)=@_; 7480 my $saved=$Options{SavedLists}; 7481 if (defined $newname) 7482 { $saved->{$newname}=delete $saved->{$name}; 7483 HasChanged('SavedLists',$name,'renamedto',$newname); 7484 HasChanged('SavedLists',$newname); 7485 } 7486 elsif (defined $val) 7487 { if (my $songarray= $saved->{$name}) { $songarray->Replace($val); return } 7488 else { $saved->{$name}= SongArray::Named->new_copy($val); HasChanged('SavedLists',$name); } 7489 } 7490 else { delete $saved->{$name}; HasChanged('SavedLists',$name,'remove'); } 7491 Songs::Changed(undef,'list'); # simulate modifcation of the fake "list" field 7492} 7493 7494sub Watch 7495{ my ($object,$key,$sub)=@_; 7496 unless ($object) { push @{$EventWatchers{$key}},$sub; return } #for permanent watch 7497 warn "watch $key $object\n" if $debug; 7498 my $cbkey= 'WatchUpdate_'.$key; # key used to store the callback(s) in the object's hash 7499 if (my $existing=$object->{$cbkey}) # object is watching the event with multiple callbacks 7500 { $object->{$cbkey}= $existing= [$existing] if ref $existing ne 'ARRAY'; 7501 push @$existing, $sub; 7502 } 7503 else 7504 { push @{$EventWatchers{$key}},$object; weaken($EventWatchers{$key}[-1]); 7505 $object->{$cbkey}=$sub; 7506 } 7507 $object->{Watcher_DESTROY}||=$object->signal_connect(destroy => \&UnWatch_all) unless ref $object eq 'HASH' || !$object->isa('Gtk2::Object'); 7508} 7509sub UnWatch # warning: if one object watch the same event with multiple callbacks, all of them will be removed 7510{ my ($object,$key)=@_; 7511 warn "unwatch $key $object\n" if $debug; 7512 @{$EventWatchers{$key}}=grep defined && $_ != $object, @{$EventWatchers{$key}}; 7513 ref $_ ne 'CODE' && weaken($_) for @{$EventWatchers{$key}}; #re-weaken references (the grep above made them strong again) #do not weaken code ref as they might not be linked to anything else and should be permanent 7514 delete $object->{'WatchUpdate_'.$key}; 7515} 7516sub UnWatch_all #for when destructing object (unwatch Watch() AND WatchFilter()) 7517{ my $object=shift; 7518 UnWatch($object,$_) for map m/^WatchUpdate_(.+)/, keys %$object; 7519 UnWatchFilter($object,$_) for map m/^UpdateFilter_(.+)/, keys %$object; 7520} 7521 7522sub QHasChanged 7523{ my ($key,@args)=@_; 7524 IdleDo("1_HasChanged_$key",250,\&HasChanged,$key,@args); 7525} 7526sub HasChanged 7527{ my ($key,@args)=@_; 7528 delete $ToDo{"1_HasChanged_$key"}; 7529 return unless $EventWatchers{$key}; 7530 my @list=@{$EventWatchers{$key}}; 7531 warn "HasChanged $key -> updating @list\n" if $debug; 7532 for my $r ( @list ) 7533 { my ($sub,$o)= ref $r eq 'CODE' ? ($r) : ($r->{'WatchUpdate_'.$key},$r); 7534 next unless $sub; 7535 if (ref $sub eq 'ARRAY') 7536 { $_->($o,@args) for @$sub; 7537 } 7538 else { $sub->($o,@args) } 7539 }; 7540} 7541 7542sub GetSelID 7543{ my $group= ref $_[0] ? $_[0]{group} : $_[0]; 7544 $group=~s/:[\w.]+$//; 7545 return $group=~m/^Next(\d*)$/ ? $NextSongs[($1||0)] : 7546 $group=~m/^Recent(\d*)$/ ? $Recent->[($1||0)] : 7547 $group ne 'Play' ? $SelID{$group} : 7548 $SongID; 7549} 7550sub WatchSelID 7551{ my ($object,$sub,$fields)=@_; #fields are ignored for now 7552 my $group=$object->{group}; 7553 $group=~s/:[\w.]+$//; 7554 my $key= $group=~m/^Next\d*$/ ? 'NextSongs' : $group=~m/^Recent\d*$/ ? 'RecentSongs' : $group ne 'Play' ? 'SelectedID_'.$group : 'CurSong'; 7555 if ($group=~m/^(?:Recent|Next)\d*$/) { my $orig=$sub; $sub=sub { $orig->( $_[0],GetSelID($_[0]) ); }; } #so that $sub gets the ID as argument in the same way as other cases (SelectedID_ and CurSong) 7556 Watch($object,$key,$sub); 7557} 7558sub UnWatchSelID 7559{ my $object=$_[0]; 7560 my $group=$object->{group}; 7561 $group=~s/:[\w.]+$//; 7562 my $key= $group=~m/^Next\d*$/ ? 'NextSongs' : $group=~m/^Recent\d*$/ ? 'RecentSongs' : $group ne 'Play' ? 'SelectedID_'.$group : 'CurSong'; 7563 UnWatch($object,$key); 7564} 7565sub HasChangedSelID 7566{ my ($group,$ID)=@_; 7567 return if $group=~m/:/; 7568 if (defined $ID){ $SelID{$group}=$ID; } 7569 else { delete $SelID{$group}; } 7570 UpdateRelatedFilter($group); 7571 HasChanged('SelectedID_'.$group,$ID,$group); 7572} 7573sub UpdateRelatedFilter 7574{ my $group=shift; 7575 my $re= $group=~m/^(?:Next|Recent)\d*$/ ? qr/^\Q$group\E\d*:(.+)/ : qr/^\Q$group\E:(.+)/; 7576 for my $group0 (keys %Related_FilterWatchers) 7577 { next unless $group0=~m/$re/; 7578 my $filter= Songs::MakeFilterFromID($1,GetSelID($group)); 7579 SetFilter(undef,$filter,1,$group0); 7580 } 7581} 7582 7583#doesn't change the filter, but return the filter that would result for the widget 7584sub SimulateSetFilter 7585{ my ($object,$filter,$level,$group)=@_; 7586 $level=1 unless defined $level; 7587 $group=$object->{group} unless defined $group; 7588 $group=get_layout_widget($object)->{group} unless defined $group; 7589 my $filters= $Filters{$group}||=[]; # $filters->[0] is the sum filter, $filters->[$n+1] is filter for level $n 7590 $filter=Filter->new($filter) unless defined $filter && ref $filter eq 'Filter'; 7591 return Filter->newadd(TRUE, map($filters->[$_], 1..$level), $filter); 7592} 7593sub SetFilter 7594{ my ($object,$filter,$level,$group)=@_; 7595 $level=1 unless defined $level; 7596 $group=$object->{group} unless defined $group; 7597 $group=get_layout_widget($object)->{group} unless defined $group; 7598 my $filters= $Filters{$group}||=[]; # $filters->[0] is the sum filter, $filters->[$n+1] is filter for level $n 7599 $filter=Filter->new($filter) unless defined $filter && ref $filter eq 'Filter'; 7600 $filters->[$level+1]=$filter; #set filter for level $level 7601 $#$filters=$level+1; #set higher level filters to undef by truncating the array 7602 $filters->[0]= Filter->newadd(TRUE, map($filters->[$_], 1..$#$filters) ); #sum filter 7603 AddToFilterHistory( $filters->[0] ); 7604 for my $r ( @{$FilterWatchers{$group}} ) { $r->{'UpdateFilter_'.$group}($r,$Filters{$group}[0],$level,$group) }; 7605 if ($group eq 'Play') { $ListPlay->SetFilter($filters->[0]) } 7606} 7607sub RefreshFilters 7608{ my ($object,$group)=@_; 7609 $group=$object->{group} unless defined $group; 7610 $group=get_layout_widget($object)->{group} unless defined $group; 7611 for my $r ( @{$FilterWatchers{$group}} ) { $r->{'UpdateFilter_'.$group}($r,$Filters{$group}[0],undef,$group) }; 7612} 7613sub AddToFilterHistory 7614{ my $filter=$_[0]; 7615 my $recent=$::Options{RecentFilters}||=[]; 7616 my $string=$filter->{string}; 7617 return if $string eq 'null'; 7618 @$recent=($filter, grep $_->{string} ne $string, @$recent); 7619 pop @$recent if @$recent>20; 7620} 7621sub GetFilter 7622{ my ($object,$nb)=@_; 7623 my $group=$object->{group}; 7624 $group=get_layout_widget($object)->{group} unless defined $group; 7625 return defined $nb ? $Filters{$group}[$nb+1] : $Filters{$group}[0]; 7626} 7627sub GetSonglist 7628{ my $object=$_[0]; 7629 my $layw=get_layout_widget($object); 7630 my $group=$object->{group}; 7631 $group=$layw->{group} if !defined $group && $layw; 7632 return $SongList::Common::Register{$group}; 7633} 7634sub GetSongArray 7635{ my $sl= GetSonglist($_[0]); 7636 return $sl && $sl->{array}; 7637} 7638sub InitFilter 7639{ my $group=shift; 7640 $group=$group->{group} if ref $group; 7641 return if $Filters{$group}[0]; 7642 my $filter; 7643 if ($group=~m/(.+):([\w.]+)$/) 7644 { $filter= Songs::MakeFilterFromID($2,GetSelID($1)); 7645 } 7646 SetFilter(undef,$filter,1,$group); 7647} 7648sub WatchFilter 7649{ my ($object,$group,$sub)=@_; 7650 warn "watch filter $group $object\n" if $debug; 7651 push @{$FilterWatchers{$group}},$object; 7652 $object->{'UpdateFilter_'.$group}=$sub; 7653 if ($group=~m/:[\w.]+$/) 7654 { $Related_FilterWatchers{$group}++; 7655 #$Filters{$group}[0]||=$Filters{$group}[1+1]||= Filter->null; 7656 #$Filters{$group}[0]||=$Filters{$group}[1+1]||=Filter->new; 7657 } 7658 IdleDo('1_init_filter'.$group,0, \&InitFilter, $group); 7659 $object->{Watcher_DESTROY}||=$object->signal_connect(destroy => \&UnWatch_all) unless ref $object eq 'HASH' || !$object->isa('Glib::Object'); 7660} 7661sub UnWatchFilter 7662{ my ($object,$group)=@_; 7663 warn "unwatch filter $group $object\n" if $debug; 7664 if ($group=~m/:[\w.]+$/) 7665 { unless (--$Related_FilterWatchers{$group}) 7666 { delete $Related_FilterWatchers{$group}; 7667 } 7668 } 7669 delete $object->{'UpdateFilter_'.$group}; 7670 my $ref=$FilterWatchers{$group}; 7671 @$ref=grep $_ ne $object, @$ref; 7672 unless (@$ref) 7673 { delete $_->{$group} for \%Filters,\%FilterWatchers; 7674 } 7675} 7676 7677sub Progress 7678{ my $pid=shift; 7679 my $self= {@_}; 7680 if (!defined $pid) #new one 7681 { $pid="$self"; 7682 $Progress{$pid}=$self; 7683 } 7684 elsif (!$Progress{$pid}) 7685 { return if $self->{abort}; 7686 $Progress{$pid}=$self; 7687 } 7688 else #update existing 7689 { $Progress{$pid}{$_}=$self->{$_} for keys %$self; 7690 $Progress{$pid}{partial}=0 if $self->{inc} || exists $self->{current}; 7691 $self= $Progress{$pid}; 7692 } 7693 $self->{end}+=delete $self->{add} if $self->{add}; 7694 $self->{current}++ if delete $self->{inc}; 7695 $self->{fraction}= (($self->{partial}||0) + ($self->{current}||=0)) / ($self->{end}||1); 7696 7697 if (my $w=$self->{widget}) { $w->set_fraction( $self->{fraction} ); } 7698 delete $Progress{$pid} if $self->{abort} or $self->{current}>=$self->{end}; # finished 7699 HasChanged(Progress =>$pid,$Progress{$pid}); 7700 if ( $Progress{$pid} && !$self->{widget} && (!$EventWatchers{Progress} || @{$EventWatchers{Progress}}==0)) #if no widget => create progress window 7701 { #create the progress window only after a short timeout to ignore short jobs 7702 $ProgressWindowComing ||= Glib::Timeout->add(1000, 7703 sub { my $still_progress = grep !$Progress{$_}{widget}, keys %Progress; 7704 my $still_no_widget= !$EventWatchers{Progress} || @{$EventWatchers{Progress}}==0; 7705 Layout::Window->new('Progress') if $still_progress && $still_no_widget; 7706 return $ProgressWindowComing=0; 7707 }); 7708 } 7709 return $pid; 7710} 7711 7712sub PresentWindow 7713{ my $win=$_[1]; 7714 $win->force_present; 7715 $win->set_skip_taskbar_hint(FALSE) unless $win->{skip_taskbar_hint}; 7716} 7717 7718sub PopupLayout 7719{ my ($layout,$widget)=@_; 7720 return if $widget && $widget->{PoppedUpWindow}; 7721 my $popup=Layout::Window::Popup->new($layout,$widget); 7722} 7723 7724sub UpdateTrayIcon 7725{ my $force=shift; 7726 return unless $TrayIcon; 7727 return unless $force || $TrayIcon{play} || $TrayIcon{pause}; 7728 my $state= !defined $TogPlay ? 'default' : $TogPlay ? 'play' : 'pause'; 7729 $state='default' unless $TrayIcon{$state}; 7730 my $pb= $TrayIcon{'PixBuf_'.$state} ||= eval {Gtk2::Gdk::Pixbuf->new_from_file($TrayIcon{$state})}; 7731 my $widget= $TrayIcon->isa('Gtk2::StatusIcon') ? $TrayIcon : $TrayIcon->child->child; 7732 $widget->set_from_pixbuf($pb); 7733} 7734 7735sub Gtk2::StatusIcon::child {$_[0]} 7736 7737sub CreateTrayIcon 7738{ if ($TrayIcon) 7739 { return if $Options{UseTray}; 7740 $TrayIcon->destroy unless $TrayIcon->isa('Gtk2::StatusIcon'); 7741 $TrayIcon=undef; 7742 return; 7743 } 7744 elsif (!$Options{UseTray} || !$TrayIconAvailable) {return} 7745 7746 my $eventbox; 7747 if ($UseGtk2StatusIcon) 7748 { $TrayIcon= $eventbox= Gtk2::StatusIcon->new; 7749 } 7750 else # use Gtk2::TrayIcon 7751 { $TrayIcon= Gtk2::TrayIcon->new(PROGRAM_NAME); 7752 $eventbox=Gtk2::EventBox->new; 7753 $eventbox->set_visible_window(0); 7754 my $img=Gtk2::Image->new; 7755 7756 Glib::Timeout->add(1000,sub {$TrayIcon->{respawn}=1 if $TrayIcon; 0;}); 7757 #recreate Trayicon if it is deleted, for example when the gnome-panel crashed, but only if it has lived >1sec to avoid an endless loop 7758 $TrayIcon->signal_connect(delete_event => sub 7759 { my $respawn=$TrayIcon->{respawn}; 7760 $TrayIcon=undef; 7761 CreateTrayIcon() if $respawn; 7762 0; 7763 }); 7764 $eventbox->add($img); 7765 $TrayIcon->add($eventbox); 7766 Layout::Window::make_transparent($TrayIcon) if $CairoOK; 7767 $TrayIcon->show_all; 7768 } 7769 7770 SetTrayTipDelay(); 7771 Layout::Window::Popup::set_hover($eventbox); 7772 7773 $eventbox->signal_connect(scroll_event => \&::ChangeVol); 7774 $eventbox->signal_connect(button_press_event => sub 7775 { my $b=$_[1]->button; 7776 if ($b==3) { &TrayMenuPopup } 7777 elsif ($b==2) { &PlayPause} 7778 else { ShowHide() } 7779 1; 7780 }); 7781 7782 UpdateTrayIcon(1); 7783 Watch($TrayIcon, Playing=> sub { UpdateTrayIcon(); }); 7784} 7785sub SetTrayTipDelay 7786{ return unless $TrayIcon; 7787 $TrayIcon->child->{hover_delay}= $Options{TrayTipDelay}||1; 7788} 7789sub TrayMenuPopup 7790{ CloseTrayTip(); 7791 $TrayIcon->{block_popup}=1; 7792 my $menu=Gtk2::Menu->new; 7793 $menu->signal_connect( selection_done => sub {$TrayIcon->{block_popup}=undef}); 7794 PopupContextMenu(\@TrayMenu, {usemenupos=>1}, $menu); 7795} 7796sub CloseTrayTip 7797{ return unless $TrayIcon; 7798 my $traytip=$TrayIcon->child->{PoppedUpWindow}; 7799 $traytip->DestroyNow if $traytip; 7800} 7801sub ShowTraytip 7802{ return 0 if !$TrayIcon || $TrayIcon->{block_popup}; 7803 Layout::Window::Popup::Popup($TrayIcon->child,$_[0]); 7804} 7805sub windowpos # function to position window next to clicked widget ($event can be a widget) 7806{ my ($win,$event)=@_; 7807 return (0,0) unless $event; 7808 my $h=$win->size_request->height; # height of window to position 7809 my $w=$win->size_request->width; # width of window to position 7810 my $screen=$event->get_screen; 7811 my ($monitor,$x,$y,$dx,$dy); 7812 if ($event->isa('Gtk2::StatusIcon')) 7813 { ($x,$y,$dx,$dy)=($event->get_geometry)[1]->values; # position and size of statusicon 7814 $monitor=$screen->get_monitor_at_point($x,$y); 7815 } 7816 else 7817 { $monitor=$screen->get_monitor_at_window($event->window); 7818 ($x,$y)=$event->window->get_origin; # position of the clicked widget on the screen 7819 ($dx,$dy)=$event->window->get_size; # width,height of the clicked widget 7820 if ($event->isa('Gtk2::Widget') && $event->no_window) 7821 { (my$x2,my$y2,$dx,$dy)=$event->allocation->values; 7822 $x+=$x2;$y+=$y2; 7823 } 7824 } 7825 my ($xmin,$ymin,$monitorwidth,$monitorheight)=$screen->get_monitor_geometry($monitor)->values; 7826 my $xmax=$xmin + $monitorwidth; 7827 my $ymax=$ymin + $monitorheight; 7828 7829 my $ycenter=0; 7830 if ($x+$dx/2+$w/2 < $xmax && $x+$dx/2-$w/2 >$xmin){ $x-=int($w/2-$dx/2); } # centered 7831 elsif ($x+$dx+$w > $xmax) { $x=max($xmax-$w,$xmin) } # right side 7832 else { $x=$xmin; } # left side 7833 if ($ycenter && $y+$h/2 < $ymax && $y-$h/2 >$ymin){ $y-=int($h/2) } # y center 7834 elsif ($dy+$y+$h > $ymax) { $y=max($y-$h,$ymin) } # display above the widget 7835 else { $y+=$dy; } # display below the widget 7836 return $x,$y; 7837} 7838 7839sub IsWindowVisible 7840{ my $win=shift; 7841 my $visible=!$win->{iconified}; 7842 $visible=0 unless $win->visible; 7843 if ($visible) 7844 { my ($mw,$mh)= $win->get_size; 7845 my ($mx,$my)= $win->get_position; 7846 my $screen=Gtk2::Gdk::Screen->get_default; 7847 $visible=0 if $mx+$mw<0 || $my+$mh<0 || $mx>$screen->get_width || $my>$screen->get_height; 7848 } 7849 return $visible; 7850} 7851sub ShowHide 7852{ my $hide= defined $_[0] ? !$_[0] : IsWindowVisible($MainWindow); 7853 my (@windows)=grep $_->isa('Layout::Window') && $_->{showhide} && $_!=$MainWindow, Gtk2::Window->list_toplevels; 7854 if ($hide) 7855 { #hide 7856 #warn "hiding\n"; 7857 for my $win ($MainWindow,@windows) 7858 { next unless $win; 7859 $win->{saved_position}=join 'x',$win->get_position; 7860 $win->{skip_taskbar_hint}=$win->get_skip_taskbar_hint; 7861 $win->set_skip_taskbar_hint(TRUE); 7862 $win->hide; 7863 } 7864 } 7865 else 7866 { #show 7867 #warn "showing\n"; 7868 my $screen=Gtk2::Gdk::Screen->get_default; 7869 my $scrw=$screen->get_width; 7870 my $scrh=$screen->get_height; 7871 for my $win (@windows,$MainWindow) 7872 { next unless $win; 7873 my ($x,$y)= $win->{saved_position} ? split('x', delete $win->{saved_position}) : $win->get_position; 7874 my ($w,$h)= $win->get_size; 7875 #warn "move($x,$y)\n"; 7876 if ($x+$w<0 || $y+$h<0 || $x>$scrw || $y>$scrh) 7877 { $x%= $scrw; 7878 $y%= $scrh; 7879 } 7880 $win->move($x,$y); 7881 $win->show; 7882 $win->move($x,$y); 7883 $win->deiconify if $win->{iconified}; 7884 $win->set_skip_taskbar_hint(FALSE) unless delete $win->{skip_taskbar_hint}; 7885 #$win->set_opacity($win->{opacity}) if exists $win->{opacity} && $win->{opacity}!=1; #need to re-set it, is it a gtk bug, metacity bug ? 7886 } 7887 $MainWindow->force_present; 7888 } 7889 QHasChanged('Windows'); 7890} 7891 7892package GMB::Edit; 7893use base 'Gtk2::Dialog'; 7894 7895my %refs; 7896 7897INIT 7898{ %refs= 7899 ( Filter => [ _"Filter edition", 'SavedFilters', _"saved filters", 7900 _"name of the new filter", _"save filter as", _"delete selected filter", '600x260'], 7901 Sort => [ _"Sort mode edition", 'SavedSorts', _"saved sort modes", 7902 _"name of the new sort mode", _"save sort mode as", _"delete selected sort mode", '600x320'], 7903 WRandom => [ _"Random mode edition", 'SavedWRandoms', _"saved random modes", 7904 _"name of the new random mode", _"save random mode as", _"delete selected random mode", '600x450'], 7905 STGroupings => [_"SongTree groupings edition", 'SavedSTGroupings', _"saved groupings", 7906 _"name of the new grouping", _"save grouping as", _"delete selected grouping"], 7907 ); 7908} 7909 7910sub new 7911{ my ($class,$window,$type,$init,$name) = @_; 7912 $window=$window->get_toplevel if $window; 7913 my $typedata=$refs{$type}; 7914 my $self = bless Gtk2::Dialog->new( $typedata->[0], $window,[qw/destroy-with-parent/]), $class; 7915 $self->add_button('gtk-cancel' => 'none'); 7916 if (defined $name && $name ne '') 7917 { my $button=::NewIconButton('gtk-save', ::__x( _"save as '{name}'", name => $name) ); 7918 $button->can_default(::TRUE); 7919 $self->add_action_widget( $button,'ok' ); 7920 $self->{save_name}=$name; 7921 } 7922 else 7923 { $self->{save_name_entry}=Gtk2::Entry->new if defined $name; # eq '' 7924 $self->add_button('gtk-ok' => 'ok'); 7925 } 7926 $self->set_default_response('ok'); 7927 $self->set_border_width(3); 7928 7929 $self->{key}=$typedata->[1]; 7930 $self->{hash}=$::Options{$self->{key}}; 7931 ::Watch($self,$self->{key},\&Fill); 7932 7933 if (defined $name) 7934 { if ($name eq '') 7935 { $name=_"noname"; 7936 ::IncSuffix($name) while $self->{hash}{$name}; 7937 } 7938 else { $init=$self->{hash}{$name} unless defined $init; } 7939 } 7940 7941 my $store=Gtk2::ListStore->new('Glib::String'); 7942 my $treeview=Gtk2::TreeView->new($store); 7943# $treeview->set_headers_visible(::FALSE); 7944 my $renderer=Gtk2::CellRendererText->new; 7945 $renderer->signal_connect(edited => \&name_edited_cb,$self); 7946 $renderer->set(editable => 1); 7947 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes 7948 ( $typedata->[2],$renderer,'text',0) 7949 ); 7950 my $sw= ::new_scrolledwindow($treeview,'etched-in'); 7951 my $butrm=::NewIconButton('gtk-remove',_"Remove"); 7952 $treeview->get_selection->signal_connect( changed => sub 7953 { my $sel=$_[0]->count_selected_rows; 7954 $butrm->set_sensitive($sel); 7955 }); 7956 $butrm->set_sensitive(0); 7957 $butrm->signal_connect(clicked => \&Remove_cb,$self); 7958 my $butsave=::NewIconButton('gtk-save'); 7959 my $NameEntry=Gtk2::Entry->new; 7960 $NameEntry->signal_connect(changed => sub { $butsave->set_sensitive(length $_[0]->get_text); }); 7961 $butsave->signal_connect( clicked => sub {$self->Save}); 7962 $NameEntry->signal_connect(activate => sub {$self->Save}); 7963 $butsave->set_sensitive(0); 7964 $NameEntry->set_text($name) if defined $name; 7965 $NameEntry->set_tooltip_text($typedata->[3]); 7966 $butsave ->set_tooltip_text($typedata->[4]); 7967 $butrm ->set_tooltip_text($typedata->[5]); 7968 7969 $self->{entry}=$NameEntry; 7970 $self->{store}=$store; 7971 $self->{treeview}=$treeview; 7972 $self->Fill; 7973 my $package='GMB::Edit::'.$type; 7974 my $editobject=$package->new($self,$init); 7975 $self->vbox->add( ::Hpack( [[0,$NameEntry,$butsave],'_',$sw,$butrm], '_',$editobject) ); 7976 if ($self->{save_name_entry}) { $editobject->pack_start(::Hpack(Gtk2::Label->new('Save as : '),$self->{save_name_entry}), ::FALSE,::FALSE, 2); $self->{save_name_entry}->set_text($name); } 7977 $self->{editobject}=$editobject; 7978 7979 ::SetWSize($self,'Edit'.$type,$typedata->[6]); 7980 $self->show_all; 7981 7982 $treeview->get_selection->unselect_all; 7983 $treeview->signal_connect(cursor_changed => \&cursor_changed_cb,$self); 7984 7985 return $self; 7986} 7987 7988sub name_edited_cb 7989{ my ($cell, $path_string, $newname,$self) = @_; 7990 my $store=$self->{store}; 7991 my $iter=$store->get_iter_from_string($path_string); 7992 my $name=$store->get($iter,0); 7993 #$self->{busy}=1; 7994 ::SaveSFRG($self->{key}, $name, undef,$newname); 7995 #$self->{busy}=undef; 7996 #$store->set($iter, 0, $newname); 7997} 7998 7999sub Remove_cb 8000{ my $self=$_[1]; 8001 my $path=($self->{treeview}->get_cursor)[0]||return; 8002 my $store=$self->{store}; 8003 my $name=$store->get( $store->get_iter($path) ,0); 8004 ::SaveSFRG($self->{key}, $name, undef); 8005} 8006 8007sub Save 8008{ my $self=shift; 8009 my $name=$self->{entry}->get_text; 8010 return unless $name; 8011 my $result=$self->{editobject}->Result; 8012 ::SaveSFRG($self->{key}, $name, $result); 8013} 8014 8015sub Fill 8016{ my $self=shift; 8017 return if $self->{busy}; 8018 my $store=$self->{store}; 8019 $store->clear; 8020 $store->set($store->append,0,$_) for sort keys %{ $self->{hash} }; 8021} 8022 8023sub cursor_changed_cb 8024{ my ($treeview,$self)=@_; 8025 my $store=$self->{store}; 8026 my ($path)=$treeview->get_cursor; 8027 return unless $path; 8028 my $name=$store->get( $store->get_iter($path) ,0); 8029 $self->{entry}->set_text($name); 8030 $self->{editobject}->Set( $self->{hash}{$name} ); 8031} 8032 8033sub Result 8034{ my ($self,$sub)=@_; 8035 if (defined $sub) 8036 { $self->add_button('gtk-apply','apply') if $sub; 8037 $self->signal_connect( response =>sub 8038 { my $ans=$_[1]; 8039 if ($ans eq 'ok' || $ans eq 'apply') 8040 { my $result=$self->{editobject}->Result; 8041 $self->{save_name}=$self->{save_name_entry}->get_text if $self->{save_name_entry}; 8042 ::SaveSFRG($self->{key}, $self->{save_name}, $result) 8043 if $ans eq 'ok' && defined $self->{save_name} && $self->{save_name} ne ''; 8044 $sub->($result) if $sub; 8045 return if $ans eq 'apply'; 8046 } 8047 $self->destroy; 8048 }); 8049 return; 8050 } 8051 my $result; 8052 if ('ok' eq $self->run) #FIXME stop using this, always supply a $sub 8053 { $result=$self->{editobject}->Result; 8054 } 8055 $self->destroy; 8056 return $result; 8057} 8058 8059 8060package GMB::Edit::Filter; 8061use base 'Gtk2::Box'; 8062use constant 8063{ TRUE => 1, FALSE => 0, 8064 C_NAME => 0, C_FILTER => 1, 8065 DEFAULT_FILTER => 'title:si:', 8066}; 8067 8068sub new 8069{ my ($class,$dialog,$init) = @_; 8070 my $self = bless Gtk2::VBox->new, $class; 8071 8072 my $store=Gtk2::TreeStore->new('Glib::String','Glib::Scalar'); 8073 $self->{treeview}= 8074 my $treeview=Gtk2::TreeView->new($store); 8075 $treeview->append_column( Gtk2::TreeViewColumn->new_with_attributes( 8076 _("filters") => Gtk2::CellRendererText->new, 8077 text => C_NAME) ); 8078 my $sw = Gtk2::ScrolledWindow->new; 8079 $sw->set_shadow_type('etched-in'); 8080 $sw->set_policy('never','automatic'); 8081 8082 my $butadd= ::NewIconButton('gtk-add',_"Add"); 8083 my $butadd2=::NewIconButton('gtk-add',_"Add multiple condition"); 8084 my $butrm= ::NewIconButton('gtk-remove',_"Remove"); 8085 $butadd->signal_connect( clicked => \&Add_cb); 8086 $butadd2->signal_connect(clicked => \&Add_cb); 8087 $butrm->signal_connect( clicked => \&Rm_cb ); 8088 $butrm->set_sensitive(FALSE); 8089 $butadd->{filter}= DEFAULT_FILTER; 8090 $butadd2->{filter}="(\x1D".DEFAULT_FILTER."\x1D)"; 8091 8092 $treeview->get_selection->signal_connect( changed => sub 8093 { my $sel=$_[0]->count_selected_rows; 8094 $butrm->set_sensitive($sel); 8095 }); 8096 $self->{fbox}= 8097 my $fbox=Gtk2::EventBox->new; 8098 my $bbox=Gtk2::HButtonBox->new; 8099 $bbox->add($_) for $butadd,$butadd2,$butrm; 8100 $sw->add($treeview); 8101 $self->add($sw); 8102 $self->pack_start($fbox, FALSE, FALSE, 1); 8103 $self->pack_start($bbox, FALSE, FALSE, 1); 8104 8105 $treeview->signal_connect(cursor_changed => \&cursor_changed_cb); 8106 $treeview->signal_connect(key_press_event=> \&key_press_cb); 8107 8108 ::set_drag($treeview, 8109 source=>[::DRAG_FILTER,sub 8110 { my $treeview=$_[0]; 8111 my $self=::find_ancestor($treeview,__PACKAGE__); 8112 my $f=$self->Result( ($treeview->get_cursor)[0] ); 8113 return (::DRAG_FILTER,($f->{string}||undef)); 8114 }], 8115 dest => [::DRAG_FILTER,sub 8116 { my ($treeview,$type,$dest,$filter)=@_; 8117 my $self=::find_ancestor($treeview,__PACKAGE__); 8118 #$self->signal_stop_emission_by_name('drag_data_received'); 8119 return if $treeview->{drag_is_source} && !$store->iter_has_child($store->get_iter_first); 8120 my (undef,$path,$pos)=@$dest; 8121 #warn "-------- $filter,$path,$pos"; 8122 my $rowref_todel; 8123 $rowref_todel=Gtk2::TreeRowReference->new($treeview->get_model,($treeview->get_cursor)[0]) if $treeview->{drag_is_source}; 8124 $self->Set($filter,$path,$pos); 8125 if ($rowref_todel) 8126 { my $path=$rowref_todel->valid ? 8127 $rowref_todel->get_path : $pos=~m/after$/ ? 8128 Gtk2::TreePath->new_from_indices(0,0) : 8129 Gtk2::TreePath->new_from_indices(0,1); 8130 $self->Remove_path($path); 8131 } 8132 }], 8133 motion => sub 8134 { my ($treeview,$context,$x,$y,$time)=@_;# warn "drag_motion_cb @_"; 8135 my $store=$treeview->get_model; 8136 my ($path,$pos)=$treeview->get_dest_row_at_pos($x,$y); 8137 $path||=Gtk2::TreePath->new_first; 8138 $pos||='after'; 8139 8140 if ($treeview->{drag_is_source}) 8141 { my $sourcepath=($treeview->get_cursor)[0]; 8142 if ($sourcepath->is_ancestor($path) || !$sourcepath->compare($path)) 8143 { $treeview->set_drag_dest_row(undef,$pos); 8144 $context->status('default', 0); 8145 return 0; 8146 } 8147 } 8148 8149 my $iter=$store->get_iter($path); 8150 if (!$store->iter_has_child($iter)) { $pos=~s/^into-or-//; } 8151 elsif ($pos!~m/^into-or-/ && !$store->iter_parent($iter)) { $pos='into-or-'.$pos; } 8152 #warn "$pos, ".$self->Result($path,$pos)->{string}; 8153 $context->{dest}=[$treeview,$path,$pos]; 8154 $treeview->set_drag_dest_row($path,$pos); 8155 $context->status(($treeview->{drag_is_source} ? 'move' : 'copy'),0); 8156 return 1; 8157 }); 8158 $self->Set($init); 8159 8160 return $self; 8161} 8162 8163sub Add_cb 8164{ my $button=shift; 8165 my $self= ::find_ancestor($button,__PACKAGE__); 8166 my $path=($self->{treeview}->get_cursor)[0]; 8167 $path||=Gtk2::TreePath->new_first; 8168 $self->Set( $button->{filter}, $path); 8169} 8170sub Rm_cb 8171{ my $self= ::find_ancestor($_[0],__PACKAGE__); 8172 my $treeview=$self->{treeview}; 8173 my ($path)=$treeview->get_cursor; 8174 return unless $path; 8175 my $oldpath=$self->Remove_path($path); 8176 $oldpath->prev or $oldpath->up; 8177 $oldpath=Gtk2::TreePath->new_first unless $oldpath->get_depth; 8178 $treeview->set_cursor($oldpath); 8179} 8180sub Remove_path 8181{ my ($self,$path)=@_; 8182 my $store=$self->{treeview}->get_model; 8183 my $iter=$store->get_iter($path); 8184 my $parent=$store->iter_parent($iter); 8185 while ($parent && $store->iter_n_children($parent)<2) 8186 { my $p=$store->iter_parent($parent); 8187 $iter=$parent; 8188 $parent=$p; 8189 } 8190 my $oldpath=$store->get_path($iter); 8191 $store->remove($iter); 8192 # recreate a default entry if no more entry : 8193 $self->Set(DEFAULT_FILTER) unless $store->get_iter_first; 8194 return $oldpath; 8195} 8196 8197sub key_press_cb 8198{ my ($tv,$event)=@_; 8199 my $key=Gtk2::Gdk->keyval_name( $event->keyval ); 8200 if ($key eq 'Delete') { Rm_cb($tv); return 1 } 8201 return 0; 8202} 8203 8204sub cursor_changed_cb 8205{ my $treeview=shift; 8206 my $self= ::find_ancestor($treeview,__PACKAGE__); 8207 my $fbox=$self->{fbox}; 8208 my $store=$treeview->get_model; 8209 my ($path,$co)=$treeview->get_cursor; 8210 return unless $path; 8211 #warn "row : ",$path->to_string," / col : $co\n"; 8212 $fbox->remove($fbox->child) if $fbox->child; 8213 my $iter=$store->get_iter($path); 8214 my $box; 8215 if ($store->iter_has_child($iter)) 8216 { $box=Gtk2::HBox->new; 8217 my $state=$store->get($iter,C_FILTER); 8218 my $group; 8219 for my $ao ('&','|') 8220 { my $name=($ao eq '&')? _"All of :":_"Any of :"; 8221 my $b=Gtk2::RadioButton->new($group,$name); 8222 $group=$b unless $group; 8223 $b->set_active(1) if $ao eq $state; 8224 $b->signal_connect( toggled => sub 8225 { return unless $_[0]->get_active; 8226 _set_row($store, $iter, $ao); 8227 }); 8228 $box->add($b); 8229 } 8230 } 8231 else 8232 { $box=GMB::FilterBox->new 8233 ( undef, 8234 sub 8235 { warn "filter : @_\n" if $::debug; 8236 my $filter=shift; 8237 _set_row($store, $iter, $filter); 8238 }, 8239 $store->get($iter,C_FILTER), 8240 ); 8241 } 8242 $fbox->add($box); 8243 $fbox->show_all; 8244} 8245 8246sub Set 8247{ my ($self,$filter,$startpath,$startpos)=@_; 8248 $filter=$filter->{string} if ref $filter; 8249 $filter='' if !defined $filter || $filter eq 'null'; 8250 my $treeview=$self->{treeview}; 8251 my $store=$treeview->get_model; 8252 8253 my $iter; 8254 if ($startpath) 8255 { $iter=$store->get_iter($startpath); 8256 my $parent=$store->iter_parent($iter); 8257 if (!$parent && !$store->iter_has_child($iter)) #add a root 8258 { $parent=$store->prepend(undef); 8259 _set_row($store, $parent, '&'); 8260 my $new=$store->append($parent); 8261 $store->set($new,$_,$store->get($iter,$_)) for C_NAME,C_FILTER; 8262 $store->remove($iter); 8263 $iter=$parent; 8264 $startpos='into-or-'.$startpos if $startpos; 8265 } 8266 elsif (!$startpos && !$store->iter_has_child($iter)) 8267 { $iter=$parent; 8268 } 8269 } 8270 else { $store->clear } 8271 8272 my $firstnewpath; 8273 my $createrowsub=sub 8274 { my $iter=shift; 8275 if ($startpos) 8276 { my @args= $startpos=~m/^into/ ? ($iter,undef) : (undef,$iter); 8277 $iter= ($startpos=~m/^into/ xor $startpos=~m/after$/) 8278 ? $store->insert_after(@args) : $store->insert_before(@args); 8279 $startpos=undef; 8280 } 8281 else {$iter=$store->append($iter);} 8282 $firstnewpath||=$store->get_path($iter); 8283 return $iter; 8284 }; 8285 8286 for my $f (split /\x1D/,$filter) 8287 { if ($f eq ')') 8288 { $iter=$store->iter_parent($iter); 8289 } 8290 elsif ($f=~m/^\(/) # '(|' or '(&' 8291 { $iter= $createrowsub->($iter); 8292 my $ao= $f eq '(|' ? '|' : '&'; 8293 _set_row($store, $iter, $ao); 8294 } 8295 else 8296 { next if $f eq ''; 8297 my $leaf= $createrowsub->($iter); 8298 $firstnewpath=$store->get_path($leaf) unless $firstnewpath; 8299 _set_row($store, $leaf, $f); 8300 } 8301 } 8302 unless ($store->get_iter_first) #default filter if no/invalid filter 8303 { _set_row($store, $store->append(undef), DEFAULT_FILTER); 8304 } 8305 8306 $firstnewpath||=Gtk2::TreePath->new_first; 8307 my $path_string=$firstnewpath->to_string; 8308 if ($firstnewpath->get_depth>1) { $firstnewpath->up; $treeview->expand_row($firstnewpath,TRUE); } 8309 else { $treeview->expand_all } 8310 $treeview->set_cursor( Gtk2::TreePath->new($path_string) ); 8311} 8312 8313sub _set_row 8314{ my ($store,$iter,$content)=@_; 8315 my $desc= $content eq '&' ? _"All of :" : 8316 $content eq '|' ? _"Any of :" : 8317 Filter::_explain_element($content) || _("Unknown filter :")." '$content'"; 8318 $store->set($iter, C_NAME,$desc, C_FILTER,$content); 8319} 8320 8321sub Result 8322{ my ($self,$startpath)=@_; 8323 my $store=$self->{treeview}->get_model; 8324 my $filter=''; 8325 my $depth=0; 8326 my $next=$startpath? $store->get_iter($startpath) : $store->get_iter_first; 8327 while (my $iter=$next) 8328 { my $elem=$store->get($iter,C_FILTER); 8329 if ( $next=$store->iter_children($iter) ) 8330 { $filter.="($elem\x1D" unless $store->iter_n_children($iter)<2; 8331 $depth++; 8332 } 8333 else 8334 { $filter.= $elem."\x1D"; 8335 last unless $depth; 8336 $next=$store->iter_next($iter); 8337 } 8338 until ($next) 8339 { last unless $depth and $iter=$store->iter_parent($iter); 8340 $filter.=")\x1D" unless $store->iter_n_children($iter)<2; 8341 $depth--; 8342 last unless $depth; 8343 $next=$store->iter_next($iter); 8344 } 8345 } 8346 warn "filter= $filter\n" if $::debug; 8347 return Filter->new($filter); 8348} 8349 8350package GMB::Edit::Sort; 8351use base 'Gtk2::Box'; 8352use constant { TRUE => 1, FALSE => 0, SENSITIVE => 1, INSENSITIVE => 2, }; 8353sub new 8354{ my ($class,$dialog,$init) = @_; 8355 $init=undef if $init=~m/^random:|^shuffle/; 8356 my $self = bless Gtk2::VBox->new, $class; 8357 8358 $self->{store1}= my $store1=Gtk2::ListStore->new(('Glib::String')x2); 8359 $self->{store2}= my $store2=Gtk2::ListStore->new(('Glib::String')x4); 8360 $self->{treeview1}= my $treeview1=Gtk2::TreeView->new($store1); 8361 $self->{treeview2}= my $treeview2=Gtk2::TreeView->new($store2); 8362 $treeview2->set_reorderable(TRUE); 8363 my $order_column= Gtk2::TreeViewColumn->new_with_attributes( 'Order',Gtk2::CellRendererPixbuf->new,'stock-id',2 ); 8364 $treeview2->append_column($order_column); 8365 my $butadd= ::NewIconButton('gtk-add', _"Add", sub {$self->Add_selected}); 8366 my $butrm= ::NewIconButton('gtk-remove', _"Remove", sub {$self->Del_selected}); 8367 my $butclear= ::NewIconButton('gtk-clear', _"Clear", sub { $self->Set(''); }); 8368 my $butup= ::NewIconButton('gtk-go-up', undef, sub { $self->Move_Selected(1,0); }); 8369 my $butdown= ::NewIconButton('gtk-go-down', undef, sub { $self->Move_Selected(0,0); }); 8370 $self->{butadd}=$butadd; 8371 $self->{butrm}=$butrm; 8372 $self->{butup}=$butup; 8373 $self->{butdown}=$butdown; 8374 8375 my $size_group=Gtk2::SizeGroup->new('horizontal'); 8376 $size_group->add_widget($_) for $butadd,$butrm,$butclear; 8377 8378 $treeview1->get_selection->signal_connect (changed => sub{$self->Buttons_update;}); 8379 $treeview2->get_selection->signal_connect (changed => sub{$self->Buttons_update;}); 8380 $treeview1->signal_connect (row_activated => sub {$self->Add_selected}); 8381 $treeview2->signal_connect (row_activated => sub {$self->Del_selected}); 8382 $treeview2->signal_connect (cursor_changed => \&cursor_changed2_cb,$self); 8383 8384 my $table=Gtk2::Table->new (2, 4, FALSE); 8385 my $col=0; 8386 for ([_"Available",$treeview1,$butadd],[_"Sort order",$treeview2,$butrm,$butclear]) 8387 { my ($label,$tv,@buts)=@$_; 8388 my $lab=Gtk2::Label->new; 8389 $lab->set_markup_with_format('<b>%s</b>',$label); 8390 $tv->set_headers_visible(FALSE); 8391 $tv->append_column( Gtk2::TreeViewColumn->new_with_attributes($label,Gtk2::CellRendererText->new,'text',1) ); 8392 my $sw = Gtk2::ScrolledWindow->new; 8393 $sw->set_shadow_type('etched-in'); 8394 $sw->set_policy('never','automatic'); 8395 $sw->set_size_request(30,200); 8396 $sw->add($tv); 8397 my $row=0; 8398 $table->attach($lab,$col,$col+1,$row++,$row,'fill','shrink',1,1); 8399 $table->attach($sw,$col,$col+1,$row++,$row,'fill','fill',1,1); 8400 $table->attach($_,$col,$col+1,$row++,$row,'expand','shrink',1,1) for @buts; 8401 $col++; 8402 } 8403 #my $case_column= Gtk2::TreeViewColumn->new_with_attributes('Case',Gtk2::CellRendererPixbuf->new,'stock-id',3); 8404 my $caserenderer=Gtk2::CellRendererPixbuf->new; 8405 my $case_column= Gtk2::TreeViewColumn->new_with_attributes('Case',$caserenderer); 8406 $treeview2->append_column($case_column); 8407 $case_column->set_cell_data_func($caserenderer, sub 8408 { my ($column,$cell,$store2,$iter)=@_; 8409 my $i=$store2->get_value($iter,3); 8410 my $stock= !$i ? undef : $i==SENSITIVE ? 'gmb-case_sensitive' : 'gmb-case_insensitive'; 8411 $cell->set(stock_id => $stock); 8412 }); 8413 if (*Gtk2::Widget::set_has_tooltip{CODE}) # since gtk+ 2.12, Gtk2 1.160 8414 { $treeview2->set_has_tooltip(1); 8415 $treeview2->signal_connect(query_tooltip=> sub 8416 { my ($treeview2, $x, $y, $keyb, $tooltip)=@_; 8417 return 0 if $keyb; 8418 my ($path, $column)=$treeview2->get_path_at_pos($x,$y); 8419 return 0 unless $path && $column; 8420 my $store2=$treeview2->get_model; 8421 my $iter=$store2->get_iter($path); 8422 return 0 unless $iter; 8423 my $tip; 8424 if ($column==$case_column) 8425 { my $i=$store2->get_value($iter,3); 8426 $tip= !$i ? undef : $i==SENSITIVE ? _"Case sensitive" : _"Case insensitive"; 8427 } 8428 elsif ($column==$order_column) 8429 { my $o=$store2->get_value($iter,2); 8430 $tip= $o eq 'gtk-sort-ascending' ? _"Ascending order" : _"Descending order"; 8431 } 8432 return 0 unless defined $tip; 8433 $tooltip->set_text($tip); 8434 1; 8435 }); 8436 8437 } 8438 8439 my $vbox=Gtk2::VBox->new (FALSE, 4); 8440 $vbox->pack_start($_,FALSE,TRUE,1) for $butup,$butdown; 8441 $table->attach($vbox,$col,$col+1,1,2,'shrink','expand',1,1); 8442 $self->pack_start($table,TRUE,TRUE,1); 8443 8444 $self->Set($init); 8445 return $self; 8446} 8447 8448sub Set 8449{ my ($self,$list)=@_; 8450 $list='' unless defined $list; 8451 my $store2=$self->{store2}; 8452 $store2->clear; 8453 $self->{nb2}=0; #nb of rows in $store2; 8454 my %cols; 8455 for my $f (split / /,$list) 8456 { my $o=($f=~s/^-//)? 'gtk-sort-descending' : 'gtk-sort-ascending'; 8457 my $i=($f=~s/:i$//)? INSENSITIVE : SENSITIVE; 8458 $i=0 unless Songs::SortICase($f); 8459 my $text= Songs::FieldName($f); 8460 $store2->set($store2->append,0,$f,1,$text,2,$o,3,$i); 8461 $self->{nb2}++; 8462 $cols{$f}=1; 8463 } 8464 8465 my $store1=$self->{store1}; 8466 $store1->clear; 8467 for my $f (sort { Songs::FieldName($a) cmp Songs::FieldName($b) } Songs::SortKeys()) 8468 { next if $cols{$f}; 8469 $store1->set($store1->append,0,$f,1,Songs::FieldName($f)); 8470 } 8471 $self->Buttons_update; 8472} 8473 8474sub cursor_changed2_cb 8475{ my ($treeview2,$self)=@_; 8476 my ($path,$col)=$treeview2->get_cursor; 8477 return unless $path && $col; 8478 my $store2=$self->{store2}; 8479 my $iter=$store2->get_iter($path); 8480 if ($col eq $treeview2->get_column(0)) 8481 { my $o=$store2->get_value($iter,2); 8482 $o=($o eq 'gtk-sort-ascending')? 'gtk-sort-descending' : 'gtk-sort-ascending'; 8483 $store2->set($iter,2,$o); 8484 } 8485 elsif ($col eq $treeview2->get_column(2)) 8486 { my $i=$store2->get_value($iter,3); 8487 return unless $i; 8488 $i= $i==1? INSENSITIVE : SENSITIVE; 8489 $store2->set($iter,3,$i); 8490 } 8491} 8492 8493sub Add_selected 8494{ my $self=shift; 8495 my $path=($self->{treeview1}->get_cursor)[0]||return; 8496 my $store1=$self->{store1}; 8497 my $store2=$self->{store2}; 8498 my $iter=$store1->get_iter($path); 8499 return unless $iter; 8500 my ($f,$v)=$store1->get_value($iter,0,1); 8501 $store1->remove($iter); 8502 my $i=( Songs::SortICase($f) )? INSENSITIVE : 0; #default to case-insensitive 8503 $store2->set($store2->append,0,$f,1,$v,2,'gtk-sort-ascending',3,$i); 8504 $self->{nb2}++; 8505 $self->Buttons_update; 8506} 8507sub Del_selected 8508{ my $self=shift; 8509 my $path=($self->{treeview2}->get_cursor)[0]||return; 8510 my $store1=$self->{store1}; 8511 my $store2=$self->{store2}; 8512 my $iter=$store2->get_iter($path); 8513 my ($f,$v)=$store2->get_value($iter,0,1); 8514 $store2->remove($iter); 8515 $self->{nb2}--; 8516 $store1->set($store1->append,0,$f,1,$v); #FIXME should be inserted in correct order 8517 $self->Buttons_update; 8518} 8519sub Move_Selected 8520{ my ($self,$up,$max)=@_; 8521 my $path=($self->{treeview2}->get_cursor)[0]||return; 8522 my $store2=$self->{store2}; 8523 my $iter=$store2->get_iter($path); 8524 if ($max) 8525 { if ($up) { $store2->move_after($iter,undef); } 8526 else { $store2->move_before($iter,undef);} 8527 return; 8528 } 8529 my $row=$path->to_string; 8530 if ($up) {$row--} else {$row++} 8531 my $iter2=$store2->get_iter_from_string($row)||return; 8532 $store2->swap($iter,$iter2); 8533 $self->Buttons_update; 8534}; 8535 8536 8537sub Buttons_update #update sensitive state of buttons 8538{ my $self=shift; 8539 $self->{butadd}->set_sensitive( $self->{treeview1}->get_selection->count_selected_rows ); 8540 my ($sel)=$self->{treeview2}->get_selection->get_selected_rows; 8541 if ($sel) 8542 { my $row=$sel->to_string; 8543 $self->{butup} ->set_sensitive($row>0); 8544 $self->{butdown}->set_sensitive($row<$self->{nb2}-1); 8545 $self->{butrm} ->set_sensitive(1); 8546 } 8547 else { $self->{$_}->set_sensitive(0) for qw/butrm butup butdown/; } 8548} 8549 8550sub Result 8551{ my $self=shift; 8552 my $store=$self->{store2}; 8553 my $order=''; 8554 my $iter=$store->get_iter_first; 8555 while ($iter) 8556 { my ($f,$o,$i)=$store->get($iter,0,2,3); 8557 $order.='-' if $o eq 'gtk-sort-descending'; 8558 $order.=$f; 8559 $order.=':i' if $i==INSENSITIVE; 8560 $order.=' ' if $iter=$store->iter_next($iter); 8561 } 8562 return $order; 8563} 8564 8565package GMB::Edit::WRandom; 8566use base 'Gtk2::Box'; 8567use constant 8568{ TRUE => 1, FALSE => 0, 8569 NBCOLS => 20, 8570 COLWIDTH => 15, 8571 HHEIGHT => 100, 8572 HWIDTH => 20*15, 8573}; 8574sub new 8575{ my ($class,$dialog,$init) = @_; 8576 my $self = bless Gtk2::VBox->new, $class; 8577 8578 my $table=Gtk2::Table->new (1, 4, FALSE); 8579 my $sw=Gtk2::ScrolledWindow->new; 8580 $sw->set_policy('never','automatic'); 8581 $sw->add_with_viewport($table); 8582 $self->add($sw); 8583 8584 my $addlist=TextCombo->new({map {$_ => $Random::ScoreTypes{$_}{desc}} keys %Random::ScoreTypes}, (keys %Random::ScoreTypes)[0] ); 8585 my $addbut=::NewIconButton('gtk-add',_"Add"); 8586 my $addhbox=Gtk2::HBox->new(FALSE, 8); 8587 $addhbox->pack_start($_,FALSE,FALSE,0) for Gtk2::Label->new(_"Add rule : "), $addlist, $addbut; 8588 8589 my $histogram=Gtk2::DrawingArea->new; 8590 my $histoframe=Gtk2::Frame->new; 8591 my $histoAl=Gtk2::Alignment->new(.5,.5,0,0); 8592 $histoframe->add($histogram); 8593 $histoAl->add($histoframe); 8594 8595 my $LabEx=$self->{example_label}=Gtk2::Label->new; 8596 $self->pack_start($_,FALSE,FALSE,2) for $addhbox,$histoAl,$LabEx; 8597 8598 $histogram->size(HWIDTH,HHEIGHT); 8599 $histogram->signal_connect(expose_event => \&histogram_expose_cb); 8600 $histogram->set_tooltip_text(''); 8601 $histogram->add_events([qw/enter-notify-mask leave-notify-mask/]); 8602 $histogram->signal_connect(enter_notify_event => sub 8603 { $_[0]{timeout}=Glib::Timeout->add(500,\&UpdateTip_timeout,$histogram);0; 8604 }); 8605 $histogram->signal_connect(leave_notify_event => sub { Glib::Source->remove( $_[0]{timeout} );0; }); 8606 8607 $addbut->signal_connect( clicked => sub 8608 { my $type=$addlist->get_value; 8609 $self->AddRow( $Random::ScoreTypes{$type}{default} ); 8610 }); 8611 ::Watch($self, CurSong =>\&UpdateID); 8612 ::Watch($self, SongsChanged =>\&SongsChanged_cb); 8613 ::Watch($self, SongArray =>\&SongArray_cb); 8614 $self->signal_connect( destroy => \&cleanup ); 8615 8616 $self->{histogram}=$histogram; 8617 $self->{table}=$table; 8618 $self->Set($init); 8619 8620 return $self; 8621} 8622 8623sub cleanup 8624{ my $self=shift; 8625 delete $self->{need_redraw}; 8626} 8627 8628sub Set 8629{ my ($self,$sort)=@_; 8630 $sort=~s/^random://; 8631 my $table=$self->{table}; 8632 $table->remove($_) for $table->get_children; 8633 $self->{frames}=[]; 8634 $self->{row}=0; 8635 return unless $sort; 8636 $self->AddRow($_) for split /\x1D/,$sort; 8637} 8638 8639sub Redraw 8640{ my ($self,$queue)=@_; 8641 if ($queue) 8642 { unless ($self->{need_redraw}++) 8643 { Glib::Timeout->add(300, sub 8644 { return 0 unless $self->{need_redraw}; # redraw not needed anymore 8645 return $self->{need_redraw}=1 if --$self->{need_redraw}; 8646 # draw now if no change since last timeout 8647 $self->Redraw; 8648 return 0; 8649 }); 8650 } 8651 return; 8652 } 8653 delete $self->{need_redraw}; 8654 my $histogram=$self->{histogram}; 8655 $histogram->{col}=undef; 8656 my $r=$self->get_random; 8657 my ($tab)= ($histogram->{tab},$self->{sum})= $r->MakeTab(NBCOLS); 8658 $histogram->{max}= (sort { $b <=> $a } @$tab)[0] ||0; 8659 $histogram->queue_draw; 8660 8661 $self->{depend_fields}=$r->fields; 8662 $self->UpdateID; #update examples 8663 8664 0; 8665} 8666sub SongsChanged_cb 8667{ my ($self,$IDs,$fields)=@_; 8668 return if $self->{need_redraw}; 8669 return unless ::OneInCommon($fields,$self->{depend_fields}); 8670 return if $IDs && !@{ $ListPlay->AreIn($IDs) }; 8671 $self->Redraw(1); 8672} 8673sub SongArray_cb 8674{ my ($self,$array,$action)=@_; 8675 return if $self->{need_redraw}; 8676 return unless $array==$ListPlay; 8677 return if grep $action eq $_, qw/mode sort move up down/; 8678 $self->Redraw(1); 8679} 8680 8681sub histogram_expose_cb 8682{ my ($histogram,$event)=@_; 8683 my $max= $histogram->{max}; 8684 return 0 unless $max; 8685 #my $gc = $histogram->style->fg_gc($histogram->state); 8686 my @param=($histogram->window, 'selected', 'out', $event->area, $histogram, undef); 8687 for my $x (0..NBCOLS-1) 8688 { my $y=int(HHEIGHT* ($histogram->{tab}[$x]||0)/$max ); 8689 #$histogram->window->draw_rectangle($gc,TRUE,COLWIDTH*$x,HHEIGHT-$y,COLWIDTH,$y); 8690 $histogram->style->paint_box(@param, COLWIDTH*$x,HHEIGHT-$y,COLWIDTH,$y); 8691 #warn "histogram : $x $y\n"; 8692 } 8693 1; 8694} 8695 8696sub UpdateTip_timeout 8697{ my $histogram=$_[0]; 8698 my ($x,$y)=$histogram->get_pointer;#warn "$x,$y\n"; 8699 return 0 if $x<0; 8700 my $col=int($x/COLWIDTH); 8701 return 1 if $histogram->{col} && $histogram->{col}==$col; 8702 $histogram->{col}=$col; 8703 my $nb=$histogram->{tab}[$col]||0; 8704 my $range=sprintf '%.2f - %.2f',$col/NBCOLS,($col+1)/NBCOLS; 8705 #my $sum=$histogram->get_ancestor('Gtk2::VBox')->{sum}; 8706 #my $prob='between '.join ' and ',map $_? '1 chance in '.sprintf('%.0f',$sum/$_) : 'no chance', $col/NBCOLS,($col+1)/NBCOLS; 8707 $histogram->set_tooltip_text( "$range : ".::__n('%d song','%d songs',$nb) ); 8708 1; 8709} 8710 8711sub AddRow 8712{ my ($self,$params)=@_; 8713 my $table=$self->{table}; 8714 my $row=$self->{row}++; 8715 my $deleted; 8716 my ($inverse,$weight,$type,$extra)=$params=~m/^(-?)(\d*\.?\d+)([a-zA-Z])(.*)$/; 8717 return unless $type; 8718 my $frame=Gtk2::Frame->new( $Random::ScoreTypes{$type}{desc} ); 8719 $frame->{type}=$type; 8720 push @{$self->{frames}},$frame; 8721 $frame->{params}=$params; 8722 my $exlabel=$frame->{label}=Gtk2::Label->new; 8723 $frame->{unit}=$Random::ScoreTypes{$type}{unit}; 8724 $frame->{round}=$Random::ScoreTypes{$type}{round}; 8725 my $button=::NewIconButton('gtk-remove',undef,sub 8726 { my $button=$_[0]; 8727 my $self=::find_ancestor($button,__PACKAGE__); 8728 $frame->{params}=undef; 8729 $_->parent->remove($_) for $button,$frame; 8730 $self->Redraw(1); 8731 },'none'); 8732 $button->set_tooltip_text(_"Remove this rule"); 8733 $table->attach($button,0,1,$row,$row+1,'shrink','shrink',1,1); 8734 $table->attach($frame,1,2,$row,$row+1,['fill','expand'],'shrink',2,4); 8735 $frame->{adj}=my $adj=Gtk2::Adjustment->new ($weight, 0, 1, .01, .05, 0); 8736 my $scale=Gtk2::HScale->new($adj); 8737 $scale->set_digits(2); 8738 $frame->{check}=my $check=Gtk2::CheckButton->new(_"inverse"); 8739 $check->set_active($inverse); 8740 my $hbox=Gtk2::HBox->new; 8741 $hbox->pack_end($exlabel, FALSE, FALSE, 1); 8742 8743 my $extrasub; 8744 my $check_tip; 8745 if ($type eq 'f') 8746 { $check_tip=_"ON less probable if label is set\nOFF more probable if label is set"; 8747 #my $labellist=TextCombo->new(::SortedLabels(),$extra,\&update_frame_cb); 8748 my $labellist= GMB::ListStore::Field::Combo->new('label',$extra,\&update_frame_cb); 8749 $extrasub=sub { $labellist->get_value; }; 8750 #$extrasub=sub {'Bootleg' }; 8751 $hbox->pack_start($labellist, FALSE, FALSE, 1); 8752 } 8753 elsif ($type eq 'g') 8754 { $check_tip=_"ON less probable if genre is set\nOFF more probable if genre is set"; 8755 #my $genrelist=TextCombo->new( ::GetGenresList ,$extra,\&update_frame_cb); 8756 my $genrelist= GMB::ListStore::Field::Combo->new('genre',$extra,\&update_frame_cb); 8757 $extrasub=sub { $genrelist->get_value; }; 8758 $hbox->pack_start($genrelist, FALSE, FALSE, 1); 8759 } 8760 elsif ($type eq 'r') 8761 { $exlabel->parent->remove($exlabel); #remove example to place it in the table 8762 $check_tip=_"ON -> smaller means more probable\nOFF -> bigger means more probable"; 8763 my @l=split /,/,$extra; 8764 @l=(0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1) unless @l==11; 8765 my @adjs; 8766 my $table=Gtk2::Table->new(3,4,FALSE); 8767 my $col=0; my $row=0; 8768 for my $r (0..10) 8769 { my $label=Gtk2::Label->new($r*10); 8770 my $adj=Gtk2::Adjustment->new($l[$r], 0, 1, .01, .1, 0); 8771 my $spin=Gtk2::SpinButton->new($adj, 2, 2); 8772 $table->attach_defaults($label,$col,$col+1,$row,$row+1); 8773 $table->attach_defaults($spin,$col+1,$col+2,$row,$row+1); 8774 $row++; 8775 if ($row>2) {$col+=2; $row=0;} 8776 push @adjs,$adj; 8777 $spin->signal_connect( value_changed => \&update_frame_cb ); 8778 } 8779 $extrasub=sub { join ',',map $_->get_value, @adjs; }; 8780 $exlabel->set_alignment(1,.5); 8781 $table->attach_defaults($exlabel,0,$col+2,$row+1,$row+2); 8782 $hbox->pack_start($table, TRUE, TRUE, 1); 8783 } 8784 else 8785 { $check_tip=_"ON -> smaller means more probable\nOFF -> bigger means more probable"; 8786 my $halflife=$extra; 8787 my $adj=Gtk2::Adjustment->new ($halflife, 0.1, 10000, 1, 10, 0); 8788 my $spin=Gtk2::SpinButton->new($adj, 5, 1); 8789 $hbox->pack_start($_, FALSE, FALSE, 0) 8790 for Gtk2::Label->new(_"half-life : "),$spin, 8791 Gtk2::Label->new( $frame->{unit}||'' ); 8792 $extrasub=sub { $adj->get_value; }; 8793 $spin->signal_connect( value_changed => \&update_frame_cb ); 8794 } 8795 $frame->{extrasub}=$extrasub; 8796 $check->set_tooltip_text($check_tip); 8797 $frame->add( ::Vpack( 8798 '1',[ $check, 8799 Gtk2::VSeparator->new, 8800 Gtk2::Label->new(_"weight :"), 8801 '1_',$scale] 8802 ,$hbox) ); 8803 update_frame_cb($frame); 8804 $scale->signal_connect( value_changed => \&update_frame_cb ); 8805 $check->signal_connect( toggled => \&update_frame_cb ); 8806 $button->show_all; 8807 $frame->show_all; 8808 #warn "new $button $frame\n"; 8809 #$_->signal_connect( destroy => sub {warn "destroy $_[0]\n"}) for $frame,$button; 8810 $_->signal_connect( parent_set => sub {$_[0]->destroy unless $_[0]->parent}) for $frame,$button; #make sure they don't leak 8811} 8812 8813sub update_frame_cb 8814{ my $frame=::find_ancestor($_[0],'Gtk2::Frame'); 8815 my $inverse=$frame->{check}->get_active; 8816 my $weight=$frame->{adj}->get_value; 8817 ::setlocale(::LC_NUMERIC, 'C'); 8818 my $extra= $frame->{extrasub}(); 8819 $frame->{params}=($inverse? '-' : '').$weight.$frame->{type}.$extra; 8820 ::setlocale(::LC_NUMERIC, ''); 8821 _frame_example($frame); 8822 my $self=::find_ancestor($frame,__PACKAGE__); 8823 $self->Redraw(1); 8824} 8825 8826sub _frame_example 8827{ my $frame=shift; 8828 my $p=$frame->{params}; 8829 return unless $p; 8830 $frame->{label}->set_markup_with_format( '<small><i>%s %s</i></small>', _("ex :"), Random->MakeExample($p,$::SongID)) if defined $::SongID; 8831} 8832 8833sub UpdateID 8834{ my $self=shift; 8835 for my $frame (@{$self->{frames}}) 8836 { _frame_example($frame); 8837 } 8838 my $r= $self->get_random; 8839 return unless defined $::SongID; 8840 my $s=$r->CalcScore($::SongID); 8841 my $v= ::format_number($s,'%.3f'); 8842 my $prob; 8843 if ($s) 8844 { $prob=$self->{sum}/$s; 8845 $prob= ::__x( _"1 chance in {probability}", probability => ::format_number($prob, ($prob>=10? '%.0f' : '%.1f') )); 8846 } 8847 else {$prob=_"0 chance"} 8848 $self->{example_label}->set_markup_with_format( '<small><i>%s</i></small>', ::__x( _"example (selected song) : {score} ({chances})", score =>$v, chances => $prob) ); 8849} 8850 8851sub get_string 8852{ join "\x1D",grep defined,map $_->{params}, @{$_[0]{frames}}; 8853} 8854sub get_random 8855{ my $self=shift; 8856 my $string=$self->get_string; 8857 #return Random->new( $string ); 8858 return $self->{randommode} if $self->{randommode} && $self->{randommode}{string} eq $string; 8859 return $self->{randommode}=Random->new( $string ); 8860} 8861 8862sub Result 8863{ my $self=shift; 8864 my $sort='random:'.$self->get_string; 8865 $sort=undef if $sort eq 'r'; 8866 return $sort; 8867} 8868 8869package GMB::FilterBox; 8870use base 'Gtk2::Box'; 8871 8872our (%ENTRYTYPE); 8873 8874INIT 8875{ %ENTRYTYPE= 8876 ( substring=>'GMB::FilterEdit::String', 8877 string => 'GMB::FilterEdit::String', 8878 regexp => 'GMB::FilterEdit::String', 8879 number => 'GMB::FilterEdit::Number', 8880 value => 'GMB::FilterEdit::Number', 8881 date => 'GMB::FilterEdit::Date', 8882 ago => 'GMB::FilterEdit::Number', 8883 fuzzy => 'GMB::FilterEdit::Number', 8884 listname=> 'GMB::FilterEdit::SavedListCombo', 8885 filename=> 'GMB::FilterEdit::Filename', 8886 combostring=> 'GMB::FilterEdit::Combo', 8887 menustring=> 'GMB::FilterEdit::Menu', 8888 ); 8889} 8890 8891sub new 8892{ my ($class,$activatesub,$changesub,$filter,@menu_append)=@_; 8893 my $self = bless Gtk2::HBox->new, $class; 8894 $filter='' if $filter eq 'null'; 8895 my ($field,$set)= split /:/,$filter,2; 8896 my %fieldhash; $fieldhash{$_}= Songs::FieldName($_) for Songs::Fields_with_filter; 8897 my @ordered_field_hash= map { $_,$fieldhash{$_} } ::sorted_keys(\%fieldhash); 8898 if (@menu_append) 8899 { push @ordered_field_hash, '',''; 8900 my $n=0; 8901 while (@menu_append) 8902 { my ($text,$sub)= splice @menu_append,0,2; 8903 my $key= '@ACTION'.$n++; 8904 $self->{$key}= $sub; 8905 push @ordered_field_hash, $key,$text; 8906 } 8907 } 8908 #FIXME add unknown $field ? 8909 my $combo= TextCombo->new( \@ordered_field_hash, $field, \&field_changed_cb, ordered_hash=>1, separator=>1 ); #FIXME should be updated when fields_reset 8910 $self->{fieldcombo}= $combo; 8911 $self->pack_start($combo,0,0,0); 8912 $self->Set(set=>"$field:$set"); 8913 $self->{activatesub}=$activatesub; 8914 $self->{changesub}=$changesub; 8915 return $self; 8916} 8917 8918sub field_changed_cb 8919{ my $self= ::find_ancestor($_[0],__PACKAGE__); 8920 return if $self->{busy}; 8921 my $field= $self->{fieldcombo}->get_value; 8922 if ($field=~m/^@/) #@ACTION 8923 { $self->{$field}->(); 8924 $self->{busy}=1; 8925 $self->{fieldcombo}->set_value($self->{field}); 8926 delete $self->{busy}; 8927 return 8928 } 8929 $self->Set(field=>$field); 8930} 8931sub cmd_changed_cb 8932{ my ($item,$cmd)=@_; 8933 my $self= ::find_ancestor($item,__PACKAGE__); 8934 $self->Set(cmd=>$cmd); 8935} 8936 8937sub Set 8938{ my ($self,$action,$newvalue)=@_; 8939 my %previous; 8940 if (my $w=delete $self->{w_invert}) 8941 { $previous{inv}= $w->get_active; 8942 } 8943 if (my $w=delete $self->{w_pattern}) 8944 { if (ref $w) 8945 { $previous{pattern}= [map $_->Get,@$w]; 8946 $previous{editwidget}= [map ref, @$w]; 8947 } 8948 } 8949 if (my $w=delete $self->{w_icase}) 8950 { $previous{icase}= $w->get_active; 8951 } 8952 $self->remove($_) for grep $_ != $self->{fieldcombo}, $self->get_children; 8953 my ($field,$cmd); 8954 if ($action eq 'field') 8955 { $field=$newvalue; 8956 my $d1= Songs::Field_property($self->{field},'default_filter'); 8957 my $d2= Songs::Field_property($field,'default_filter'); 8958 $cmd= $d1 eq $d2 ? $self->{cmd} : $d2; 8959 } 8960 elsif ($action eq 'cmd') 8961 { $cmd=$newvalue; 8962 $field=$self->{field}; 8963 } 8964 elsif ($action eq 'set') 8965 { %previous=(); 8966 ($field,$cmd)= split /:/,$newvalue,2; 8967 } 8968 else {return} 8969 8970 my $filters= Songs::Field_filter_choices($field); 8971 my $menu= $self->{cmdmenu}=Gtk2::Menu->new; 8972 for my $f (::sorted_keys($filters)) 8973 { my $item= Gtk2::MenuItem->new( $filters->{$f} ); 8974 $item->signal_connect( activate => \&cmd_changed_cb,$f); 8975 $menu->append($item); 8976 } 8977 8978 ($cmd,my $pattern)= split /:/,$cmd,2; 8979 $pattern='' unless defined $pattern; 8980 my ($basecmd,$prop)= Songs::filter_properties($field,"$cmd:$pattern"); 8981 if (!$prop) 8982 { $cmd= Songs::Field_property($field,'default_filter'); 8983 ($basecmd,$prop)= Songs::filter_properties($field,$cmd); 8984 if (!$prop) # shouldn't happen 8985 { warn "error: can't find default filter '$cmd' for field $field\n"; 8986 $prop=['',undef,'']; 8987 $basecmd=$cmd; 8988 } 8989 } 8990 my ($text,undef,$type,%opt)=@$prop; 8991 $opt{field}=$field; 8992 my @type=split / /,$type; 8993 my @pattern= split / /,$pattern,scalar @type; 8994 8995 if (!$opt{noinv}) 8996 { my $button= $self->{w_invert}= Gtk2::ToggleButton->new; 8997 $button->add( Gtk2::Image->new_from_stock('gmb-invert','menu') ); 8998 my $on= $cmd=~s/^-//; 8999 $on= $previous{inv} unless $action eq 'set'; 9000 $button->set_active(1) if $on; 9001 $button->signal_connect(toggled=> \&changed); 9002 $button->set_tooltip_text(_"Invert filter"); 9003 $button->set_relief('none'); 9004 $self->pack_start($button,0,0,0); 9005 } 9006 9007 my $i=0; my $textbutton=0; 9008 for my $part (split /\s*(%s)\s*/,$text) 9009 { if ($part eq '%s') 9010 { my $type= shift @type; 9011 my $opt2= Songs::Field_property($field,'filterpat:'.$type) || []; 9012 my %opt2= (%opt, @$opt2, value_index=>$i++); 9013 my $class= $ENTRYTYPE{$type}; 9014 my $pattern= shift @pattern; 9015 next unless $class; 9016 if ($previous{pattern}) 9017 { my $p= shift @{$previous{pattern}}; 9018 my $t= shift @{$previous{editwidget}} || ''; 9019 $pattern=$p if $t eq $class; 9020 } 9021 $pattern='' unless defined $pattern; 9022 my $widget= $class->new($pattern, \%opt2); 9023 $self->pack_start($widget,0,0,0); 9024 push @{$self->{w_pattern}}, $widget; 9025 if ($opt2{icase} && !$self->{w_icase}) 9026 { my $button= $self->{w_icase}= Gtk2::ToggleButton->new; 9027 $button->add( Gtk2::Image->new_from_stock('gmb-case_sensitive','menu') ); 9028 my $on= $cmd!~s/i$//; 9029 $on= $previous{icase} unless $action eq 'set'; 9030 $button->set_active(1) if $on; 9031 $button->signal_connect(toggled=> \&changed); 9032 $button->set_tooltip_text(_"Case sensitive"); 9033 $button->set_relief('none'); 9034 $self->pack_start($button,0,0,0); 9035 } 9036 } 9037 elsif ($part ne '') 9038 { my $button= Gtk2::Button->new($part); 9039 $button->set_relief('none') if $textbutton++; 9040 $button->signal_connect( button_press_event => \&popup_menu_cb); 9041 $button->signal_connect( clicked => \&popup_menu_cb); 9042 $self->pack_start($button,0,0,0); 9043 } 9044 } 9045 9046 $self->{cmd}=$basecmd; 9047 $self->{field}=$field; 9048 $self->show_all; 9049 $self->changed; 9050} 9051sub Get 9052{ my $self=shift; 9053 my $cmd= $self->{cmd}; 9054 if (my $w=$self->{w_invert}) 9055 { $cmd=~s/^-//; 9056 $cmd= '-'.$cmd if $w->get_active; 9057 } 9058 if (my $w=$self->{w_icase}) 9059 { $cmd=~s/i$//; 9060 $cmd.= 'i' unless $w->get_active; 9061 } 9062 ::setlocale(::LC_NUMERIC, 'C'); 9063 if (my $patterns= $self->{w_pattern}) 9064 { $cmd.= ':'. join(' ',map $_->Get, @$patterns); 9065 } 9066 ::setlocale(::LC_NUMERIC, ''); 9067 my $filter= $self->{field}.':'.$cmd; 9068 return $filter; 9069} 9070 9071sub popup_menu_cb 9072{ my $button=shift; 9073 my $self=::find_ancestor($button,__PACKAGE__); 9074 my $menu= $self->{cmdmenu}; 9075 ::PopupMenu($menu); 9076 0; 9077} 9078 9079sub changed 9080{ my $self=::find_ancestor($_[0],__PACKAGE__); 9081 return unless $self->{changesub}; 9082 $self->{changesub}( $self->Get ); 9083} 9084sub activate 9085{ my $self=::find_ancestor($_[0],__PACKAGE__); 9086 return unless $self->{activatesub}; 9087 $self->{activatesub}( $self->Get ); 9088} 9089 9090package GMB::FilterEdit::String; 9091use base 'Gtk2::Entry'; 9092sub new 9093{ my ($class,$val,$opt)=@_; 9094 my $self= bless Gtk2::Entry->new, $class; 9095 $self->set_text($val); 9096 $self->signal_connect(changed=> \&GMB::FilterBox::changed); 9097 $self->signal_connect(activate=> \&GMB::FilterBox::activate); 9098 GMB::ListStore::Field::setcompletion($self,$opt->{field}) if $opt->{completion}; 9099 return $self; 9100} 9101sub Get 9102{ $_[0]->get_text; 9103} 9104 9105package GMB::FilterEdit::Combo; 9106use base 'GMB::ListStore::Field::Combo'; 9107sub new 9108{ my ($class,$val,$opt)=@_; 9109 my $self= bless GMB::ListStore::Field::Combo->new($opt->{field},$val,\&GMB::FilterBox::changed),$class; 9110 #$self->set_size_request(300,-1); #FIXME limit size 9111 return $self; 9112} 9113sub Get { $_[0]->get_value; } 9114 9115package GMB::FilterEdit::Menu; # alternative to GMB::FilterEdit::Combo that better handle long list of values, and works with album filters 9116use base 'Gtk2::Button'; 9117sub new 9118{ my ($class,$val,$opt)=@_; 9119 my $self= bless Gtk2::Button->new,$class; 9120 $self->{field}=$opt->{field}; 9121 $self->{val}=$val; 9122 $self->signal_connect(button_press_event => sub 9123 { my $self=$_[0]; 9124 ::PopupAA( $self->{field}, cb=> sub { $self->set_gid($_[0]{key}); }, noalt=>1 ); 9125 1; 9126 }); 9127 $self->set_label($val); 9128 return $self; 9129} 9130sub Get { $_[0]{val}; } 9131sub set_gid 9132{ my ($self,$gid)=@_; 9133 my $field= $self->{field}; 9134 #ugly way to get the sgid #FIXME 9135 my $val=Songs::MakeFilterFromGID($field,$gid); 9136 $val=$val->{string}; 9137 $val=~s/^$field:~://; 9138 $self->{val}=$val; 9139 $self->set_label($val); 9140 GMB::FilterBox::changed($self); 9141 GMB::FilterBox::activate($self); 9142} 9143 9144package GMB::FilterEdit::Filename; 9145use base 'Gtk2::Box'; 9146sub new 9147{ my ($class,$val,$opt)=@_; 9148 my $self= bless Gtk2::HBox->new(0,0),$class; 9149 my $entry= $self->{entry}= Gtk2::Entry->new; 9150 my $button= ::NewIconButton('gtk-open'); 9151 $self->pack_start($entry,1,1,0); 9152 $self->pack_start($button,0,0,0); 9153 $self->Set($val); 9154 my $busy; 9155 $entry->signal_connect( changed => sub 9156 { return if $busy; 9157 my $entry=shift; 9158 my $self=$entry->parent; 9159 $self->{value}= ::url_escape($entry->get_text); 9160 GMB::FilterBox::changed($self); 9161 }); 9162 $entry->signal_connect(activate=> \&GMB::FilterBox::activate); 9163 $button->signal_connect( clicked => sub 9164 { my $self=$_[0]->parent; 9165 my $folder= ::ChooseDir(_"Choose a folder", path=>$self->{value}); 9166 return unless $folder; 9167 $busy=1; 9168 $self->Set( ::url_escape($folder) ); 9169 $busy=0; 9170 GMB::FilterBox::changed($self); 9171 GMB::FilterBox::activate($self); 9172 }); 9173 return $self; 9174} 9175sub Set 9176{ my ($self,$folder)= @_; 9177 $self->{entry}->set_text( ::filename_to_utf8displayname(::decode_url($folder)) ); 9178 $self->{value}=$folder; 9179} 9180sub Get { $_[0]{value} } 9181 9182package GMB::FilterEdit::SavedListCombo; 9183use base 'Gtk2::ComboBox'; 9184our @ISA; 9185BEGIN {unshift @ISA,'TextCombo';} 9186sub new 9187{ my ($class,$val,$opt)=@_; 9188 my $self= bless TextCombo->new([keys %{$::Options{SavedLists}}],$val,\&GMB::FilterBox::changed),$class; 9189 ::Watch($self,SavedLists=>\&fill); 9190 return $self; 9191} 9192sub fill { $_[0]->build_store( [keys %{$::Options{SavedLists}}] ); } 9193sub Get { $_[0]->get_value; } 9194 9195package GMB::FilterEdit::Number; 9196use base 'Gtk2::Box'; 9197sub new 9198{ my ($class,$val,$opt)=@_; 9199 my $self= bless Gtk2::HBox->new, $class; 9200 9201 my $max= $opt->{max} || 999999; 9202 my $min= $opt->{min} || $opt->{signed} ? -$max : 0; 9203 my $step= $opt->{step}|| 1; 9204 my $page= $opt->{page}|| $step*10; 9205 my $digits=$opt->{digits}|| 0; 9206 $val= $opt->{default_value}||0 if $val eq ''; 9207 my $unit0; 9208 $unit0= $1 if $val=~s/([a-zA-Z]+)$//; 9209 ::setlocale(::LC_NUMERIC, 'C'); 9210 $val= $val+0; #make sure "." is used as the decimal separator 9211 ::setlocale(::LC_NUMERIC, ''); 9212 my $spin= $self->{spin}= Gtk2::SpinButton->new( Gtk2::Adjustment->new($val, $min, $max, $step, $page, 0) ,1,$digits ); 9213 $spin->set_numeric(1); 9214 $self->pack_start($spin,0,0,0); 9215 9216 if (my $unit=$opt->{unit}) 9217 { my $extra; 9218 if (ref $unit eq 'HASH') 9219 { $unit0 ||= $opt->{default_unit}; 9220 my @ordered_hash= map { $_ => $unit->{$_}[1] } sort { $unit->{$a}[0] <=> $unit->{$b}[0] } keys %$unit; 9221 my $set_digits= sub { $spin->set_digits( $unit->{ $_[0]->get_value }[0]==1 ? 0 : 2 ) }; # no decimals for indivisible units, 2 for others 9222 $extra= $self->{units}= TextCombo->new(\@ordered_hash, $unit0, sub { $set_digits->($_[0]); &GMB::FilterBox::changed}, ordered_hash=>1); 9223 $set_digits->($extra); 9224 $spin->signal_connect(key_press_event => sub #catch letter key-press to change unit 9225 { my $key=Gtk2::Gdk->keyval_name($_[1]->keyval); 9226 if (exists $unit->{$key}) { $extra->set_value($key); return 1 } 9227 0; 9228 }); 9229 } 9230 elsif (ref $unit eq 'CODE') 9231 { my $init= $unit->($val||0, 1); 9232 $extra= Gtk2::Label->new($init); 9233 $self->{unit_code}=$unit; 9234 $spin->signal_connect(value_changed => sub 9235 { my $self=::find_ancestor($_[0],__PACKAGE__); 9236 my $v= $_[0]->get_adjustment->get_value; 9237 $extra->set_text( $self->{unit_code}->($v,1) ); 9238 }); 9239 } 9240 elsif ($unit) { $extra= Gtk2::Label->new($unit); } 9241 $self->pack_start($extra,0,0,0) if $extra; 9242 } 9243 9244 $spin->signal_connect(value_changed => \&GMB::FilterBox::changed); 9245 $spin->signal_connect(activate => \&GMB::FilterBox::activate); 9246 return $self; 9247} 9248sub Get 9249{ my $self=shift; 9250 my $value= $self->{spin}->get_adjustment->get_value; 9251 ::setlocale(::LC_NUMERIC, 'C'); 9252 $value="$value"; #make sure "." is used as the decimal separator 9253 ::setlocale(::LC_NUMERIC, ''); 9254 if (my $u=$self->{units}) 9255 { $value.= $u->get_value; 9256 } 9257 return $value; 9258} 9259 9260package GMB::FilterEdit::Date; 9261use base 'Gtk2::Button'; 9262sub new 9263{ my ($class,$val,$opt)=@_; 9264 my $self= bless Gtk2::Button->new; 9265 $self->{date}= $val || ::mktime( ( $opt->{value_index} ? (59,59,23) : (0,0,0) ), (localtime)[3,4,5]); # default to today 0:00 or today 23:59 9266 $self->set_label( ::strftime_utf8('%c',localtime($self->{date})) ); 9267 $self->signal_connect (clicked => sub 9268 { my $self=shift; 9269 if ($self->{popup}) { $self->destroy_calendar; return; } 9270 $self->popup_calendar; 9271 }); 9272 return $self; 9273} 9274sub Get { $_[0]{date}; } 9275 9276sub destroy_calendar 9277{ if (my $popup=delete $_[0]->{popup}) { $popup->destroy } 9278} 9279sub popup_calendar 9280{ my $self=$_[0]; 9281 my $popup=Gtk2::Window->new(); 9282 $popup->set_decorated(0); 9283 $self->{popup}=$popup; 9284 my $cal=Gtk2::Calendar->new; 9285 $popup->set_modal(::TRUE); 9286 $popup->set_type_hint('dialog'); 9287 $popup->set_transient_for($self->get_toplevel); 9288 my @time=(0,0,0); 9289 if (my $date=$self->{date}) 9290 { my ($s,$m,$h,$d,$M,$y)= localtime($date); 9291 $cal->select_month($M,$y+1900); 9292 $cal->select_day($d); 9293 @time=($h,$m,$s) 9294 } 9295 my $activate_sub= sub 9296 { my ($y,$m,$d)=$_[0]->get_date; 9297 $y-=1900; 9298 my @time= map $_->get_value, reverse @{$_[0]{timeadjs}}; 9299 $self->{date}= ::mktime(@time,$d,$m,$y); 9300 $self->set_label( ::strftime_utf8('%c',@time,$d,$m,$y) ); 9301 $self->destroy_calendar; 9302 GMB::FilterBox::changed($self); 9303 GMB::FilterBox::activate($self); 9304 }; 9305 $cal->signal_connect(day_selected_double_click => $activate_sub); 9306 $cal->signal_connect(key_press_event=>sub { my ($cal,$event)=@_; my $key=Gtk2::Gdk->keyval_name($event->keyval); if (::WordIn($key,'Return KP_Enter')) { $activate_sub->($cal); return 1; } return 0; }); 9307 my $vbox= Gtk2::VBox->new(0,0); 9308 my $hbox= Gtk2::HBox->new(0,0); 9309 $vbox->add($cal); 9310 $vbox->pack_end($hbox,0,0,0); 9311 my $arrow0= Gtk2::Button->new; $arrow0->add( Gtk2::Arrow->new('left','none') ); 9312 my $arrow1= Gtk2::Button->new; $arrow1->add( Gtk2::Arrow->new('right','none') ); 9313 $_->set_relief('none') for $arrow0,$arrow1; 9314 $hbox->pack_start($arrow0,0,0,2); 9315 my @timelabels= (_("Time :"),':',':'); 9316 for my $i (0..2) 9317 { my $adj= Gtk2::Adjustment->new($time[$i], 0, ($i? 59 : 23), 1, ($i? 15 : 8), 0); 9318 my $spin= Gtk2::SpinButton->new($adj,1,0); 9319 $spin->set_numeric(1); 9320 push @{ $cal->{timeadjs} }, $adj; 9321 $hbox->pack_start( Gtk2::Label->new($timelabels[$i]),0,0,2 ); 9322 $hbox->pack_start($spin,0,0,2); 9323 } 9324 $arrow0->signal_connect(clicked=> sub { $_->set_value($_->lower) for @{ $cal->{timeadjs} }; }); 9325 $arrow1->signal_connect(clicked=> sub { $_->set_value($_->upper) for @{ $cal->{timeadjs} }; }); 9326 $hbox->pack_start($arrow1,0,0,2); 9327 my $frame=Gtk2::Frame->new; 9328 $frame->add($vbox); 9329 $frame->set_shadow_type('out'); 9330 $popup->add($frame); 9331 9332 $popup->child->show_all; #needed to calculate position 9333 $popup->child->realize; 9334 $popup->move(::windowpos($popup,$self)); 9335 $popup->show_all; 9336 Gtk2::Gdk->pointer_grab($popup->window, 0, 'button-press-mask', undef, undef,0); 9337 $popup->signal_connect(button_press_event=> sub {unless ($_[1]->window->get_toplevel==$popup->window) {$self->{popup}=undef;$popup->destroy}}); 9338 #$cal->grab_focus; 9339} 9340 9341 9342package GMB::Cache; 9343my %Cache; my $CacheSize; 9344 9345INIT { $CacheSize=0; } 9346 9347sub drop_file #drop a file from the cache 9348{ my $file=shift; 9349 my $re=qr/^(?:\d+:)?\Q$file\E/; 9350 delete $Cache{$_} for grep m/$re/, keys %Cache; 9351} 9352 9353sub trim 9354{ my @list= sort {$Cache{$a}{lastuse} <=> $Cache{$b}{lastuse}} keys %Cache; 9355 my $max= $::Options{PixCacheSize} *::MB() *.9; 9356 warn "Trimming cache\n" if $::debug; 9357 while ($CacheSize> $max) 9358 { my $key=shift @list; 9359 $CacheSize-= (delete $Cache{$key})->{size}; 9360 } 9361} 9362 9363sub add_pb #add pixbuf ref 9364{ my ($key,$pb)=@_; 9365 $pb->{size}= $pb->get_height * $pb->get_rowstride; 9366 add($key,$pb); 9367} 9368sub add 9369{ my ($key,$ref)=@_; 9370 $ref->{lastuse}=time; 9371 $CacheSize+= $ref->{size}; 9372 ::IdleDo('9_CachePurge',undef,\&trim) if $CacheSize > $::Options{PixCacheSize}*::MB(); 9373 $Cache{$key}=$ref; 9374} 9375sub get 9376{ my $key=shift; 9377 my $ref= $Cache{$key}; 9378 $ref->{lastuse}=time if $ref; 9379 return $ref; 9380} 9381 9382 9383package GMB::Picture; 9384our @ArraysOfFiles; #array of filenames that needs updating in case a folder is renamed 9385 9386my ($pdfinfo,$pdftocairo,$gs); 9387our $pdf_ok; 9388INIT 9389{ $pdfinfo= ::findcmd('pdfinfo'); 9390 $pdftocairo= ::findcmd('pdftocairo'); 9391 $pdf_ok= $pdfinfo && ($pdftocairo || ($gs=::findcmd('gs'))); 9392} 9393 9394sub pixbuf 9395{ my ($file,$size,$cacheonly,$anim_ok)=@_; 9396 my $key= defined $size ? $size.':'.$file : $file; 9397 my $pb= GMB::Cache::get($key); 9398 unless ($pb || $cacheonly) 9399 { $pb=load($file,size=>$size,anim_ok=>$anim_ok); 9400 GMB::Cache::add_pb($key,$pb) if $pb && $pb->isa('Gtk2::Gdk::Pixbuf'); #don't bother caching animation 9401 } 9402 return $pb; 9403} 9404 9405sub pdf_pages 9406{ my $file=quotemeta(shift); 9407 my $ref= GMB::Cache::get("$file:pagecount"); 9408 return $ref->{pagecount} if $ref; 9409 my $count=0; 9410 for (qx/$pdfinfo $file/) { if (m/Pages:\s*(\d+)/) {$count=$1;last} } # hiding the warnings messages could be nice 9411 GMB::Cache::add("$file:pagecount", {size=>10,pagecount=>$count} ); # using a ref to cache a number is a lot of overhead :( 9412 return $count; 9413} 9414 9415sub load_data 9416{ load($_[0],raw_data=>1); 9417} 9418sub load 9419{ my ($file,%opt)=@_; #options : size anim_ok raw_data 9420 return unless $file; 9421 9422 my $size= $opt{size}; 9423 my $raw= $opt{raw_data}; #return picture data instead of pixbuf 9424 my $nb= $file=~s/:(\w+)$// ? $1 : undef; #index number for embedded pictures 9425 unless (-e $file) {warn "$file not found\n"; return undef;} 9426 9427 my ($fh,$data); 9428 if ($file=~m/$::EmbImage_ext_re$/) 9429 { $data=FileTag::PixFromMusicFile($file,$nb); 9430 } 9431 elsif ($file=~m/\.pdf$/i && $pdf_ok) 9432 { my $n= 1+($nb||0); 9433 my $res= (!$size || $size>500) ? 300 : $size>100 ? 150 : 75; #default is usually 150, faster but lower quality # use faster/lower quality for thumbnails 9434 my $qfile=quotemeta $file; 9435 #if ($pdftocairo) {open $fh,'-|', "pdftocairo -svg -r 150 -f $n -l $n $qfile -";} # pdftocairo with svg, slower but no temp file 9436 if ($pdftocairo) # should be able to avoid temp file, but bug in pdftocairo (tries to open fd://0.jpg) 9437 { my $tmp= $TempDir.'gmb_pdftocairo'; 9438 # with jpeg, seems slightly slower than tiff, and loss of quality, so use tiff by default 9439 # if $raw_ return jpg version as tiff is way too big 9440 my ($fmt,$ext)= $raw ? ('-jpeg','.jpg') : ('-tiff','.tif'); 9441 system("$pdftocairo $fmt -singlefile -r $res -f $n -l $n $qfile ".quotemeta($tmp)); 9442 $tmp.=$ext; 9443 open $fh,'<',$tmp; 9444 unlink $tmp; 9445 } 9446 elsif ($gs) # usually slower, lower quality, and accents missing in some pdf 9447 { open $fh,'-|', "$gs -q -dQUIET -dSAFER -dBATCH -dNOPAUSE -dNOPROMPT -dMaxBitmap=500000000 -sDEVICE=jpeg -dJPEGQ=95 -r$res"."x$res -dTextAlphaBits=4 -dGraphicsAlphaBits=4 -dFirstPage=$n -dLastPage=$n -sOutputFile=- $qfile"; 9448 } 9449 } 9450 else #eval{Gtk2::Gdk::Pixbuf->new_from_file(filename_to_unicode($file))}; 9451 # work around Gtk2::Gdk::Pixbuf->new_from_file which wants utf8 filename 9452 { open $fh,'<',$file; 9453 } 9454 if ($raw) 9455 { if ($fh) { binmode $fh; my $buf; $data.=$buf while read $fh,$buf,1024*64; close $fh; } 9456 return $data; 9457 } 9458 my $loader= Gtk2::Gdk::PixbufLoader->new; 9459 $loader->signal_connect(size_prepared => \&PixLoader_callback,$size) if $size; 9460 if ($fh) 9461 { binmode $fh; 9462 my $buf; eval {$loader->write($buf) while read $fh,$buf,1024*64;}; 9463 close $fh; 9464 } 9465 elsif (defined $data) { eval { $loader->write($data) }; } 9466 eval {$loader->close;}; 9467 return undef if $@; 9468 if ($opt{anim_ok}) 9469 { my $anim=$loader->get_animation; 9470 return $anim if $anim && !$anim->is_static_image; 9471 } 9472 return $loader->get_pixbuf; 9473} 9474 9475sub load_skinfile 9476{ my ($file,$crop,$resize,$now)=@_; #resize is resizeopt_w_h 9477 my $key= ':'.join ':',$file,$crop,$resize||''; #FIXME remove w or h in resize if not resized in this dimension 9478 my $pixbuf= GMB::Cache::get($key); 9479 unless ($pixbuf) 9480 { return unless $now; 9481 $pixbuf=Skin::_load_skinfile($file,$crop); 9482 $pixbuf=Skin::_resize($pixbuf,split /_/,$resize) if $resize && $pixbuf; 9483 return unless $pixbuf; 9484 GMB::Cache::add_pb($key,$pixbuf); 9485 } 9486 return $pixbuf; 9487} 9488 9489sub RenameFile 9490{ my ($dir,$old,$newutf8,$window)=@_; 9491 my $new= ::RenameFile($dir,$old,$newutf8,$window); 9492 return unless defined $new; 9493 $dir= ::pathslash($dir); #make sure the path ends with SLASH 9494 GMB::Cache::drop_file($dir.$old); 9495 $old=qr/^\Q$dir$old\E$/; 9496 for my $ref (@ArraysOfFiles) {s#$old#$dir$new# for grep $_, @$ref} 9497 return $new; 9498} 9499 9500sub UpdatePixPath 9501{ my ($oldpath,$newpath)=@_; 9502 $_= pathslash($_) for $oldpath,$newpath; #make sure the path ends with SLASH 9503 $oldpath=qr/^\Q$oldpath\E/; 9504 for my $ref (@ArraysOfFiles) {s#$oldpath#$newpath# for grep $_, @$ref} 9505} 9506 9507sub PixLoader_callback 9508{ my ($loader,$w,$h,$max)=@_; 9509 $loader->{w}=$w; 9510 $loader->{h}=$h; 9511 if ($max!~s/^-// or $w>$max or $h>$max) 9512 { my $r=$w/$h; 9513 if ($r>1) {$h=int(($w=$max)/$r);} 9514 else {$w=int(($h=$max)*$r);} 9515 $loader->set_size($w,$h); 9516 } 9517} 9518sub LoadPixData 9519{ my $pixdata=$_[0]; my $size=$_[1]; 9520 my $loader=Gtk2::Gdk::PixbufLoader->new; 9521 $loader->signal_connect(size_prepared => \&PixLoader_callback,$size) if $size; 9522 eval { $loader->write($pixdata); }; 9523 eval { $loader->close; } unless $@; 9524 $loader=undef if $@; 9525 warn "$@\n" if $@ && $debug; 9526 return $loader; 9527} 9528 9529sub Scale_with_ratio 9530{ my ($pix,$w,$h,$q)=@_; 9531 my $ratio0= $w/$h; 9532 my $ratio=$pix->get_width / $pix->get_height; 9533 if ($ratio>$ratio0) {$h=int($w/$ratio);} 9534 elsif ($ratio<$ratio0) {$w=int($h*$ratio);} 9535 $q= $q ? 'bilinear' : 'nearest'; 9536 return $pix->scale_simple($w, $h, $q); 9537} 9538 9539sub ScaleImage 9540{ my ($img,$s,$file)=@_; 9541 $img->{pixbuf}=load($file) if $file; 9542 my $pix=$img->{pixbuf}; 9543 if (!$pix || !$s || $s<16) { $img->set_from_pixbuf(undef); return; } 9544 $img->set_from_pixbuf( Scale_with_ratio($pix,$s,$s,1) ); 9545} 9546 9547sub pixbox_button_press_cb # zoom picture when clicked 9548{ my ($eventbox,$event,$button)=@_; 9549 return 0 if $button && $event->button != $button; 9550 my $pixbuf; 9551 if ($eventbox->{pixdata}) 9552 { my $loader=LoadPixData($eventbox->{pixdata},350); 9553 $pixbuf=$loader->get_pixbuf if $loader; 9554 } 9555 elsif (my $pb=$eventbox->child->{pixbuf}) { $pixbuf= Scale_with_ratio($pb,350,350,1); } 9556 elsif (my $file=$eventbox->child->{filename}) { $pixbuf= pixbuf($file,350); } 9557 return 1 unless $pixbuf; 9558 my $image=Gtk2::Image->new_from_pixbuf($pixbuf); 9559 my $menu=Gtk2::Menu->new; 9560 my $item=Gtk2::MenuItem->new; 9561 $item->add($image); 9562 $menu->append($item); 9563 ::PopupMenu($menu,event=>$event,nomenupos=>1); 9564 1; 9565} 9566 9567 9568package AAPicture; 9569 9570my $watcher; 9571 9572sub GetPicture 9573{ my ($field,$key)=@_; 9574 return Songs::Picture($key,$field,'get'); 9575} 9576sub SetPicture 9577{ my ($field,$key,$file)=@_; 9578 GMB::Cache::drop_file($file); #make sure the cache is up-to-date 9579 Songs::Picture($key,$field,'set',$file); 9580} 9581 9582my @imgqueue; 9583sub newimg 9584{ my ($field,$key,$size)=@_; 9585 my $pb= pixbuf($field,$key,$size); 9586 return Gtk2::Image->new_from_pixbuf($pb) if $pb; # cached 9587 return undef unless defined $pb; # no file 9588 # $pb=0 => file but not cached 9589 9590 my $img=Gtk2::Image->new; 9591 $img->{params}=[$field,$key,$size]; 9592 $img->set_size_request($size,$size); 9593 9594 Glib::Idle->add(\&idle_loadimg_cb) unless @imgqueue; 9595 push @imgqueue,$img; 9596 ::weaken($imgqueue[-1]); #weaken ref so that it won't be loaded after img widget is destroyed 9597 return $img; 9598} 9599sub idle_loadimg_cb 9600{ my $img; 9601 for my $i (0..$#imgqueue) { next unless $imgqueue[$i] && $imgqueue[$i]->mapped; $img=splice @imgqueue,$i,1; last } #prioritize currently mapped images 9602 $img||=shift @imgqueue while @imgqueue && !$img; 9603 if ($img) 9604 { my $pb=pixbuf( @{delete $img->{params}},1 ); 9605 $img->set_from_pixbuf($pb) if $pb; 9606 } 9607 return scalar @imgqueue; #return 0 when finished => disconnect idle cb 9608} 9609 9610sub pixbuf 9611{ my ($field,$key,$size,$now)=@_; 9612 my $file= GetPicture($field,$key); 9613 return undef unless $file; 9614 my $pb=GMB::Picture::pixbuf($file,$size,!$now); 9615 return 0 unless $pb || $now; 9616 return $pb; 9617} 9618 9619sub draw 9620{ my ($window,$x,$y,$field,$key,$size,$now,$gc)=@_; 9621 my $pixbuf=pixbuf($field,$key,$size,$now); 9622 if ($pixbuf) 9623 { my $offy=int(($size-$pixbuf->get_height)/2);#center pic 9624 my $offx=int(($size-$pixbuf->get_width )/2); 9625 $gc||=Gtk2::Gdk::GC->new($window); 9626 $window->draw_pixbuf( $gc, $pixbuf,0,0, $x+$offx, $y+$offy,-1,-1,'none',0,0); 9627 return 1; 9628 } 9629 return $pixbuf; # 0 if exist but not cached, undef if there is no picture for this key 9630} 9631 9632package TextCombo; 9633use base 'Gtk2::ComboBox'; 9634 9635sub new 9636{ my ($class,$list,$init,$sub,%opt) = @_; 9637 my $self= bless Gtk2::ComboBox->new, $class; 9638 my $buildlist; 9639 if (ref $list eq 'CODE') { $buildlist=$list; $list= $buildlist->(); } 9640 my $store=$self->build_store($list,%opt); 9641 $self->set_model($store); 9642 my $renderer=Gtk2::CellRendererText->new; 9643 $self->pack_start($renderer,::TRUE); 9644 $self->add_attribute($renderer, text => 0); 9645 if ($opt{separator}) #rows with empty string in col 1 is separator 9646 { $self->set_row_separator_func(sub { $_[0]->get($_[1],1) eq ''; }); 9647 } 9648 $self->set_cell_data_func($renderer,sub { my (undef,$renderer,$store,$iter)=@_; $renderer->set(sensitive=> ! $store->iter_n_children($iter) ); }) 9649 if $self->get_model->isa('Gtk2::TreeStore'); #hide title of submenus 9650 $self->set_value($init); 9651 $self->set_value(undef) unless $self->get_active_iter; #in case $init was not found 9652 $self->signal_connect( changed => sub { &$sub unless $_[0]{busy}; } ) if $sub; 9653 if ($buildlist && $opt{event}) 9654 { ::Watch( $self, $_, sub { $_[0]->rebuild_store( $buildlist->() ); } ) for split / /,$opt{event}; 9655 } 9656 return $self; 9657} 9658 9659sub rebuild_store 9660{ my $self=shift; 9661 $self->{busy}=1; 9662 my $value= $self->get_value; 9663 $self->build_store(@_); 9664 $self->set_value($value) if defined $value; 9665 delete $self->{busy}; 9666} 9667 9668sub build_store 9669{ my ($self,$list,%opt)=@_; 9670 $self->{ordered_hash}=1 if $opt{ordered_hash}; #when called from rebuild_store, must use same options it got at init => save option 9671 my $store= $self->get_model || Gtk2::ListStore->new('Glib::String','Glib::String'); 9672 $store->clear; 9673 my $names=$list; 9674 if (ref $list eq 'ARRAY' && $self->{ordered_hash}) 9675 { my $i=0; 9676 my $array=$list; 9677 $list=[]; $names=[]; 9678 while ($i<$#$array) 9679 { push @$list,$array->[$i++]; push @$names,$array->[$i++]; 9680 } 9681 } 9682 elsif (ref $list eq 'HASH') 9683 { my $h=$list; 9684 $list=[]; $names=[]; 9685 for my $key (sort {::superlc($h->{$a}) cmp ::superlc($h->{$b})} keys %$h) 9686 { push @$list,$key; 9687 push @$names,$h->{$key} 9688 } 9689 } 9690 for my $i (0..$#$list) 9691 { my $iter= $store->append; 9692 $store->set($iter, 0,$names->[$i], 1,$list->[$i]); 9693 } 9694 return $store; 9695} 9696 9697sub set_value 9698{ my ($self,$value)=@_; 9699 my $store=$self->get_model; 9700 $store->foreach( sub 9701 { my ($store,$path,$iter)=@_; 9702 return 0 if $store->iter_has_child($iter); 9703 if (!defined $value || ($store->get($iter,1) eq $value)) 9704 { $self->set_active_iter($iter); return 1; 9705 } 9706 return 0; 9707 }); 9708} 9709#sub set_value 9710#{ my ($self,$value)=@_; 9711# my $store=$self->get_model; 9712# my $iter=$store->get_iter_first; 9713# while ($iter) 9714# { $self->set_active_iter($iter) if $store->get($iter,1) eq $value; 9715# $iter=$store->iter_next($iter); 9716# } 9717#} 9718sub get_value 9719{ my $self=shift; 9720 my $iter=$self->get_active_iter; 9721 return $iter ? $self->get_model->get($iter,1) : undef; 9722} 9723sub make_toolitem 9724{ my ($self,$desc,$menu_item_id,$widget)=@_; #$self should be contained in $widget (or $widget=undef) 9725 $widget||=$self; 9726 $menu_item_id||="$self"; 9727 my $titem=Gtk2::ToolItem->new; 9728 $titem->add($widget); 9729 $titem->set_tooltip_text($desc); 9730 my $item=Gtk2::MenuItem->new_with_label($desc); 9731 my $menu=Gtk2::Menu->new; 9732 $item->set_submenu($menu); 9733 $titem->set_proxy_menu_item($menu_item_id,$item); 9734 my $radioi; 9735 my $store=$self->get_model; 9736 my $iter=$store->get_iter_first; 9737 while ($iter) 9738 { my ($name,$val)=$store->get($iter,0,1); 9739 $radioi=Gtk2::RadioMenuItem->new_with_label($radioi,$name); 9740 $radioi->{value}=$val; 9741 $menu->append($radioi); 9742 $radioi->signal_connect(activate => sub 9743 { return if $_[0]->parent->{busy}; 9744 $self->set_value( $_[0]{value} ); 9745 }); 9746 $iter=$store->iter_next($iter); 9747 } 9748 $self->signal_connect(changed => sub 9749 { $menu->{busy}=1; 9750 my $value= $self->get_value; 9751 for my $item ($menu->get_children) 9752 { $item->set_active( defined $value && $item->{value} eq $value ); 9753 } 9754 delete $menu->{busy}; 9755 }); 9756 return $titem; 9757} 9758 9759package TextCombo::Tree; 9760use base 'Gtk2::ComboBox'; 9761our @ISA; 9762BEGIN {unshift @ISA,'TextCombo';} 9763 9764sub build_store 9765{ my ($self,$list)=@_; #$list is a list of label,value pairs, where value can be a sublist 9766 my $store= $self->get_model || Gtk2::TreeStore->new('Glib::String','Glib::String'); 9767 $store->clear; 9768 my @todo=(undef,$list); 9769 while (@todo) 9770 { my $parent=shift @todo; 9771 my $list= shift @todo; 9772 for my $i (sort {::superlc($list->[$a]) cmp ::superlc($list->[$b])} map 1+$_*2, 0..int($#$list/2)) 9773 { my $iter= $store->append($parent); 9774 my $key=$list->[$i-1]; 9775 my $name=$list->[$i]; 9776 if (ref $key) { push @todo,$iter,$key; $key=''; } 9777 $store->set($iter, 0,$name, 1,$key); 9778 } 9779 } 9780 return $store; 9781} 9782 9783sub make_toolitem 9784{ warn "TextCombo::Tree : make_toolitem not implemented\n"; #FIXME not needed for now, but could be in the future 9785 return undef; 9786} 9787 9788package FilterCombo; 9789use base 'Gtk2::ComboBox'; 9790 9791sub new 9792{ my ($class,$init,$sub) = @_; 9793 my $store= Gtk2::ListStore->new('Glib::String','Glib::Scalar','Glib::String'); 9794 my $self= bless Gtk2::ComboBox->new($store), $class; 9795 $self->fill_store; 9796 9797 my $renderer=Gtk2::CellRendererPixbuf->new; 9798 $renderer->set_fixed_size( Gtk2::IconSize->lookup('menu') ); 9799 $self->pack_start($renderer,::FALSE); 9800 $self->add_attribute($renderer, 'stock-id' => 2); 9801 9802 $renderer=Gtk2::CellRendererText->new; 9803 $self->pack_start($renderer,::TRUE); 9804 $self->add_attribute($renderer, text => 0); 9805 9806 $self->signal_connect( changed => \&value_changed ); 9807 $self->set_value($init); 9808 $self->{cb}=$sub; 9809 ::Watch($self, 'SavedFilters', \&SavedFilters_changed); 9810 return $self; 9811} 9812 9813sub value_changed 9814{ my $self=shift; 9815 my $iter=$self->get_active_iter; 9816 return unless $iter; 9817 my $value= $self->get_model->get($iter,1); 9818 if (!defined $value) #edit... filter 9819 { my $value=$self->{selected}; 9820 $self->{busy}=1; 9821 $self->set_value($value); 9822 delete $self->{busy}; 9823 ::EditFilter($self->get_toplevel,$value,undef,sub { $self->set_value($_[0]) if $_[0]; }); 9824 return; 9825 } 9826 $self->{selected}=$value; 9827 $self->set_tooltip_text( $value->explain ); #set tooltip to filter description 9828 $self->{cb}->($self,$value) if $self->{cb} && !$self->{busy}; 9829} 9830 9831sub SavedFilters_changed 9832{ my $self=shift; 9833 my $value= $self->get_value; 9834 $self->{busy}=1; 9835 $self->fill_store; 9836 $self->set_value($value); 9837 delete $self->{busy}; 9838} 9839 9840sub fill_store 9841{ my $self=shift; 9842 my $store= $self->get_model; 9843 $store->clear; 9844 $store->set($store->append, 0,_"All songs", 1,Filter->new, 2,'gmb-library'); 9845 my $hash=$Options{SavedFilters}; 9846 my @names= sort {::superlc($a) cmp ::superlc($b)} keys %$hash; 9847 $store->set($store->append, 0,$_, 1,$hash->{$_}) for @names; 9848 $store->set($store->append, 0,_"Edit...", 1,undef, 2,'gtk-preferences'); 9849} 9850 9851sub set_value 9852{ my ($self,$value)=@_; 9853 $value=Filter->new($value) unless ref $value; 9854 my $store=$self->get_model; 9855 my $founditer; 9856 my $iter=$store->get_iter_first; 9857 while ($iter) 9858 { my $v=$store->get($iter,1); 9859 if ( defined $v && $value->are_equal($v) ) 9860 { $founditer=$iter; last; 9861 } 9862 $iter=$store->iter_next($iter); 9863 } 9864 unless ($founditer) 9865 { $founditer= $store->prepend; 9866 $store->set($founditer, 0, _"Unnamed filter", 1,$value) 9867 } 9868 $self->{selected}=$value; 9869 $self->set_active_iter($founditer); 9870} 9871sub get_value 9872{ $_[0]{selected}; 9873} 9874 9875 9876package Label::Preview; 9877use base 'Gtk2::Label'; 9878 9879sub new 9880{ my ($class,%args)=@_; 9881 my $self= bless Gtk2::Label->new, $class; 9882 $self->set_line_wrap(1), $self->set_line_wrap_mode('word-char') if $args{wrap}; 9883 $self->{$_}=$args{$_} for qw/entry preview format empty noescape/; 9884 my ($event,$entry)=@args{qw/event entry/}; 9885 $entry->signal_connect_swapped( changed => \&queue_update, $self) if $entry; 9886 if ($event) { ::Watch($self, $_ => \&queue_update) for split / /,$event; } 9887 $self->update; 9888 return $self; 9889} 9890sub queue_update 9891{ my $self=shift; 9892 $self->{queue_update}||= Glib::Idle->add(\&update,$self) 9893} 9894sub update 9895{ my $self=shift; 9896 my $arg= $self->{entry} ? $self->{entry}->get_text : undef; 9897 my $text=$self->{preview}->($arg); 9898 if (defined $text) 9899 { my $f= $self->{format} || '%s'; 9900 $text= ::PangoEsc($text) unless $self->{noescape}; 9901 $text=sprintf $f, $text; 9902 } 9903 else 9904 { $text= $self->{empty}; 9905 $text='' unless defined $text; 9906 } 9907 $self->set_markup($text); 9908 return $self->{queue_update}=undef; 9909} 9910 9911package GMB::JobIDQueue; 9912my %Presence; 9913my %Properties; 9914my @ArrayList; 9915 9916::Watch(undef, SongsRemoved => \&SongsRemoved_cb); 9917 9918sub new 9919{ my ($package,%properties)=@_; #possible properties keys : title, details(optional) 9920 my $self= bless [],$_[0]; 9921 push @ArrayList, $self; 9922 $Properties{$self}= \%properties; 9923 $Properties{$self}{end}=0; 9924 ::weaken($ArrayList[-1]); 9925 return $self; 9926} 9927 9928sub add 9929{ my $self=shift; 9930 my $IDs= ref $_[0] ? $_[0] : \@_; 9931 $Presence{$self}='' unless @$self; 9932 my @new= grep !vec($Presence{$self},$_,1), @$IDs; #ignore IDs that are already in the list 9933 vec($Presence{$self},$_,1)=1 for @new; 9934 $Properties{$self}{end}+= @new; 9935 push @$self, @new; 9936} 9937 9938sub progress 9939{ my $self=shift; 9940 my $prop= $Properties{$self}; 9941 return current=> ($prop->{end}-scalar(@$self)), %$prop; 9942} 9943 9944sub next 9945{ my $self=shift; 9946 my $ID=shift @$self; 9947 vec($Presence{$self},$ID,1)=0; 9948 $self->abort unless @$self; 9949 return $ID; 9950} 9951 9952sub abort 9953{ my $self=shift; 9954 @$self=(); 9955 delete $Presence{$self}; 9956 $Properties{$self}{end}=0; 9957} 9958 9959sub SongsRemoved_cb 9960{ my $IDs=shift; 9961 my $remove=''; 9962 vec($remove,$_,1)=1 for @$IDs; 9963 for my $self (@ArrayList) 9964 { next unless @$self; 9965 @$self= grep !vec($remove,$_,1), @$self; 9966 vec($Presence{$self},$_,1)=0 for @$IDs; 9967 $self->abort unless @$self; 9968 } 9969} 9970 9971package GMB::DropURI; 9972 9973sub new #params : toplevel, cb, cb_end 9974{ my ($class,%params)=@_; 9975 my $self= bless \%params,$class; 9976 return $self; 9977} 9978 9979sub Add_URI #params : is_move, destpath 9980{ my ($self,%params)=@_; 9981 my $uris= delete $params{uris}; 9982 return if !$params{destpath} || !@$uris; 9983 s/^\s+//, s/\s+$// for @$uris; 9984 push @{$self->{todo}}, $_,\%params for @$uris; 9985 $self->{total}+= @$uris; 9986 ::Progress( 'DropURI_'.$self, add=>scalar(@$uris), abortcb=>sub{$self->Abort}, bartext=> _('file $current/$end')." :", title=>"",); 9987 Glib::Timeout->add(10,sub {$self->Next; 0}); 9988} 9989 9990sub Next 9991{ my $self=shift; 9992 return if $self->{current}; 9993 my $todo= $self->{todo}; 9994 unless (@$todo) 9995 { $self->Abort; 9996 return; 9997 } 9998 my $uri=shift @$todo; 9999 my $params= shift @$todo; 10000 $self->{current}= { %$params, uri=>$uri }; 10001 $self->{done}++; 10002 $self->{left}= @$todo/2; 10003 $uri=~s#^file://##; 10004 $self->{current}{display_uri}= ::filename_to_utf8displayname(::decode_url($uri)); 10005 $self->Start; 10006} 10007 10008sub Start 10009{ my $self=shift; 10010 my $params= $self->{current}; 10011 my $uri= $params->{uri}; 10012 my $display_uri= $params->{display_uri}; 10013 my $destpath= $params->{destpath}; # can be a scalar ref to get downloaded data into it, not currently supported for local files, and only supported for 1 uri 10014 my $progressid= 'DropURI_'.$self; 10015 if ($uri=~s#^file://##) 10016 { my $srcfile= ::decode_url($uri); 10017 my $is_move= $params->{is_move}; 10018 warn "".($is_move ? "Copying" : "Moving")." file '$display_uri' to '$destpath'\n" if $::debug; 10019 ::Progress( $progressid, bartext_append=>$display_uri, title=>($is_move ? _"Moving" : _"Copying")); 10020 my ($srcpath,$basename)= ::splitpath($srcfile); 10021 my $new= ::catfile($destpath,$basename); 10022 if ($srcfile eq $new) { $self->Done; return } # ignore copying file on itself 10023 my ($sub,$errormsg,$abortmsg)= $is_move ? (\&::move,_"Move failed",_"abort move") 10024 : (\&::copy,_"Copy failed",_"abort copy") ; 10025 $errormsg.= sprintf " (%d/%d)",$self->{done},$self->{total} if $self->{total} >1; 10026 if (-f $new) #if file already exists 10027 { my $ow= $self->{owrite_all}; 10028 $ow||=::OverwriteDialog($self->{toplevel},$new,$self->{left}>0); 10029 $self->{owrite_all}=$ow if $ow=~m/all$/; 10030 if ($ow=~m/^no/) { $self->Skip; return } 10031 #overwriting 10032 GMB::Cache::drop_file($new); # mostly for picture files 10033 } 10034 until ($sub->($srcfile,$new)) 10035 { my $res= $self->{skip_all}; 10036 my $details= ::__x(_"Destination: {folder}", folder=> ::filename_to_utf8displayname($destpath))."\n" 10037 .::__x(_"File: {file}", file => ::filename_to_utf8displayname($srcfile)); 10038 $res ||= ::Retry_Dialog($!,$errormsg, details=>$details, window=>$self->{toplevel}, abortmsg=>$abortmsg, many=>$self->{left}>0); 10039 $self->{skip_all}=$res if $res eq 'skip_all'; 10040 if ($res=~m/^skip/) { $self->Done; return } 10041 if ($res eq 'abort') { $self->Abort;return } 10042 } 10043 $self->{newfile}=$new; 10044 $self->Done; 10045 } 10046 else 10047 { unless (eval {require $::HTTP_module}) {warn "Loading $::HTTP_module failed, can't download $display_uri\n"; $self->Done; return} 10048 warn "Downloading '$display_uri' to '$destpath'\n" if $::debug; 10049 ::Progress( $progressid, bartext_append=>$display_uri, title=>_"Downloading"); 10050 $self->{waiting}= Simple_http::get_with_cb(url => $uri, cache=>1, progress=>1, cb => sub { $self->Downloaded(@_); }); 10051 $self->{track_progress} ||= Glib::Timeout->add(200, 10052 sub { if (my $w= $self->{waiting}) { my ($p,$s)=$w->progress; ::Progress( $progressid, partial=>$p ) if defined $p; } 10053 else { $self->{track_progress}=0 } 10054 return $self->{track_progress}; 10055 }); 10056 return 10057 } 10058} 10059 10060sub Downloaded 10061{ my ($self,$content,%content_prop)=@_; 10062 delete $self->{waiting}; 10063 my $type=$content_prop{type}; 10064 my $params= $self->{current}; 10065 my $uri= $params->{uri}; 10066 my $display_uri= $params->{display_uri}; 10067 my $destpath= $params->{destpath}; 10068 unless ($content) 10069 { my $error= $content_prop{error}||''; 10070 my $res= $self->{skip_all}; 10071 $res ||= ::Retry_Dialog($error,_"Download failed.", details=>_("url").': '.$display_uri, window=>$self->{toplevel}, abortmsg=>_"abort", many=>$self->{left}); 10072 $self->{skip_all}=$res if $res eq 'skip_all'; 10073 if ($res eq 'abort') { $self->Abort; } 10074 elsif ($res eq 'retry') { $self->Start; } 10075 else { $self->Done; } # skip or skip_all 10076 return 10077 } 10078 if (ref $destpath) { $$destpath=$content; $self->{newfile}=$destpath; $self->Done; return } 10079 my ($file,$ext); 10080 $uri= ::decode_url($uri); 10081 $uri=~s/\?.*//; 10082 $file= $content_prop{filename}; 10083 $file= '' unless defined $file; 10084 $file= $1 if $file eq '' && $uri=~m#([^/]+)$#; 10085 ($file,$ext)= ::barename(::CleanupFileName($file)); 10086 # if uri doesn't have a file name, try to find a good default name, currently mostly used for pictures, so doesn't try very hard for non-pictures 10087 my $is_pic= $type=~m#^image/(gif|jpeg|png|bmp)# ? $1 : 0; 10088 $ext='' if $is_pic && $ext!~m/^(?:gif|jpe?g|png|bmp)$/; #make sure common picture types have the correct extension 10089 if ($ext eq '') 10090 { $ext= $is_pic ? ($is_pic eq 'jpeg' ? 'jpg' : $is_pic) : 10091 $type=~m#^text/html# ? 'html' : 10092 $type=~m#^text/plain# ? 'txt' : 10093 $type=~m#^application/pdf# ? 'pdf' : 10094 ''; 10095 } 10096 if ($file eq '') 10097 { if ($is_pic) { $file= 'picture00' } #default file name for pictures #FIXME translate ? 10098 else #not a picture and no name, should maybe ask to confirm 10099 { $file= $uri=~m#^w+://([\w.]+)/# ? $1.'00' : 'file00'; 10100 $file=~s/\./_/g; 10101 } 10102 $file= ::CleanupFileName($file); 10103 } 10104 $ext= $ext eq '' ? '' : ".$ext"; 10105 $file= ::catfile($destpath,$file); 10106 # check if existing file is the same 10107 { my $f= $file.$ext; 10108 last unless -e $f; 10109 my $s= -s $f; 10110 last if $s!=length $content; 10111 open my($fh),'<',$f or last; 10112 read $fh,my($buf),$s; 10113 close $fh; 10114 last if $buf ne $content; 10115 warn "File '$f' already exists and has same content, so not writing a new file\n" if $::Verbose; 10116 $self->Done; 10117 return; 10118 } 10119 ::IncSuffix($file) while -e $file.$ext; 10120 $file.=$ext; 10121 10122 { my $fh; 10123 open($fh,'>',$file) && (print $fh $content) && close $fh && last; 10124 my $res= $self->{skip_all}; 10125 $res ||= ::Retry_Dialog($!,_"Error writing downloaded file", details=> ::__x( _"file: {filename}", filename=>$file)."\n". _("url").': '.$display_uri, 10126 window=>$self->{toplevel}, abortmsg=>_"abort", many=>$self->{left}>0 ); 10127 $self->{skip_all}=$res if $res eq 'skip_all'; 10128 if ($res=~m/^skip/) { $self->Done; return } 10129 if ($res eq 'abort') { $self->Abort;return } 10130 redo if $res eq 'retry'; 10131 } 10132 $self->{newfile}= $file; 10133 $self->Done; 10134} 10135sub Done # file done, if no $self->{newfile} it means the file has been skipped 10136{ my $self=shift; 10137 my $current=delete $self->{current}; 10138 ::Progress( 'DropURI_'.$self, inc=>1 ); 10139 10140 if (my $newfile= delete $self->{newfile}) 10141 { warn "Dropped file : $newfile\n" if $::debug; 10142 $self->{cb}($newfile) if $self->{cb}; # $newfile can be a scalar ref if destpath was a scalar ref 10143 } 10144 10145 if (@{$self->{todo}}) { Glib::Timeout->add(10,sub {$self->Next; 0}); } 10146 else {$self->Abort} 10147} 10148sub Abort # GMB::DropURI object must not be used after that 10149{ my $self=shift; 10150 $self->{waiting}->abort if $self->{waiting}; 10151 Glib::Source->remove( $self->{track_progress} ) if $self->{track_progress}; 10152 ::Progress( 'DropURI_'.$self, abort=>1 ); 10153 $self->{cb_end}() if $self->{cb_end}; 10154 %$self=(); # content is emptied to prevent reference cycles (memory leak) 10155} 10156