Commit b79492cb49542b065672325937df8d68055d126d - music123

Recreate license file, moved into Debian subtree by error. Escape minus signs in manpages. Parse options with a more readable case statement. Split extension list once when reading configuration, not for each file name. More error reporting, closed files, exit status reporting. Less dynamic allocations, reinventions of the standard library, duplicate or unused code, dynamic allocations. nicolas.boulenguez 8 years ago

9 changed file(s) with 332 addition(s) and 325 deletion(s). Raw diff Collapse all Expand all

+52

-17

intl.adb less more

26	26	-- executable file might be covered by the GNU Public License. --
27	27	-----------------------------------------------------------------------
28	28
29		with System;
30		with Interfaces.C.Strings; use Interfaces.C.Strings;
	29	with Interfaces.C.Strings;
31	30
32	31	package body Intl is
33	32
	33	use Interfaces.C;
	34	use Interfaces.C.Strings;
34	35
35	36	-------------
36	37	-- Gettext --
37	38	-------------
38	39
39	40	function Gettext (Msg : String) return String is
40		function Internal (Msg : String) return chars_ptr;
	41	function Internal (msgid : in char_array)
	42	return chars_ptr;
41	43	pragma Import (C, Internal, "gettext");
	44	R : constant chars_ptr := Internal (To_C (Msg));
42	45	begin
43		return Value (Internal (Msg & ASCII.NUL));
	46	if R = Null_Ptr then
	47	raise Locale_Error;
	48	end if;
	49	return Value (R);
44	50	end Gettext;
45	51
46	52	--------------

48	54	--------------
49	55
50	56	function Dgettext (Domain : String; Msg : String) return String is
51		function Internal (Domain, Msg : String) return chars_ptr;
	57	function Internal (domainname : in char_array;
	58	msgid : in char_array)
	59	return chars_ptr;
52	60	pragma Import (C, Internal, "dgettext");
	61	R : constant chars_ptr := Internal (To_C (Domain), To_C (Msg));
53	62	begin
54		return Value (Internal (Domain & ASCII.NUL, Msg & ASCII.NUL));
	63	if R = Null_Ptr then
	64	raise Locale_Error;
	65	end if;
	66	return Value (R);
55	67	end Dgettext;
56	68
57	69	---------------

61	73	function Dcgettext
62	74	(Domain : String; Msg : String; Category : Integer) return String
63	75	is
64		function Internal
65		(Domain, Msg : String; Category : Integer) return chars_ptr;
	76	function Internal (domainname : in char_array;
	77	msgid : in char_array;
	78	category : in int)
	79	return chars_ptr;
66	80	pragma Import (C, Internal, "dcgettext");
	81	R : constant chars_ptr := Internal (To_C (Domain), To_C (Msg),
	82	int (Category));
67	83	begin
68		return Value (Internal (Domain & ASCII.NUL, Msg & ASCII.NUL, Category));
	84	if R = Null_Ptr then
	85	raise Locale_Error;
	86	end if;
	87	return Value (R);
69	88	end Dcgettext;
70	89
71	90	-------------------------

73	92	-------------------------
74	93
75	94	function Default_Text_Domain return String is
76		function Internal (Domain : System.Address) return chars_ptr;
	95	function Internal (domainname : in chars_ptr)
	96	return chars_ptr;
77	97	pragma Import (C, Internal, "textdomain");
	98	R : constant chars_ptr := Internal (Null_Ptr);
78	99	begin
79		return Value (Internal (System.Null_Address));
	100	if R = Null_Ptr then
	101	raise Locale_Error;
	102	end if;
	103	return Value (R);
80	104	end Default_Text_Domain;
81	105
82	106	-----------------

84	108	-----------------
85	109
86	110	procedure Text_Domain (Domain : String := "") is
87		procedure Internal (Domain : String);
	111	function Internal (domainname : in char_array)
	112	return chars_ptr;
88	113	pragma Import (C, Internal, "textdomain");
89	114	begin
90		Internal (Domain & ASCII.NUL);
	115	if Internal (To_C (Domain)) = Null_Ptr then
	116	raise Locale_Error;
	117	end if;
91	118	end Text_Domain;
92	119
93	120	----------------------

95	122	----------------------
96	123
97	124	procedure Bind_Text_Domain (Domain : String; Dirname : String) is
98		procedure Internal (Domain, Dirname : String);
	125	function Internal (domainname : in char_array;
	126	dirname : in char_array)
	127	return chars_ptr;
99	128	pragma Import (C, Internal, "bindtextdomain");
100	129	begin
101		Internal (Domain & ASCII.NUL, Dirname & ASCII.NUL);
	130	if Internal (To_C (Domain), To_C (Dirname)) = Null_Ptr then
	131	raise Locale_Error;
	132	end if;
102	133	end Bind_Text_Domain;
103	134
104	135	procedure Set_Locale is
105		procedure Internal (Category : Integer; Locale : String);
	136	function Internal (category : in int;
	137	locale : in char_array)
	138	return chars_ptr;
106	139	pragma Import (C, Internal, "setlocale");
107	140	LC_ALL : constant := 6;
108	141	begin
109		Internal (LC_ALL, "" & ASCII.NUL);
	142	if Internal (LC_ALL, To_C ("")) = Null_Ptr then
	143	raise Locale_Error;
	144	end if;
110	145	end Set_Locale;
111	146
112	147	end Intl;

-0

intl.ads less more

135	135	-- This overrides the default system locale data base.
136	136
137	137	procedure Set_Locale;
	138
	139	Locale_Error : exception;
	140
138	141	end Intl;

+34

-0

license less more

	0	Copyright: Copyright (C) 2001-2009 David Starner <dvdeug@debian.org>
	1	Copyright (C) 2009-2011 Xavier Grave <xavier.grave@ipno.in2p3.fr>
	2	License: Expat
	3	Permission is hereby granted, free of charge, to any person obtaining a
	4	copy of this software and associated documentation files (the "Software"),
	5	to deal in the Software without restriction, including without limitation
	6	the rights to use, copy, modify, merge, publish, distribute, sublicense,
	7	and/or sell copies of the Software, and to permit persons to whom the
	8	Software is furnished to do so, subject to the following conditions:
	9	.
	10	The above copyright notice and this permission notice shall be included in
	11	all copies or substantial portions of the Software.
	12	.
	13	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
	14	IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
	15	FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
	16	THE AUTHOR OR ANY CONTRIBUTERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
	17	OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
	18	ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
	19	DEALINGS IN THE SOFTWARE.
	20
	21	Files: intl.adb intl.ads
	22	Copyright: Copyright (C) 2000 Emmanuel Briot, Joel Brobecker and Arnaud Charlet
	23	License: GPL-2 with GNAT exception
	24	intl.adb and intl.ads are from libgtkada. They are licensed under the
	25	GPL-2, see /usr/share/common-licenses/GPL-2, with the following
	26	exception.
	27	.
	28	As a special exception, if other files instantiate generics from
	29	this unit, or you link this unit with other files to produce an
	30	executable, this unit does not by itself cause the resulting
	31	executable to be covered by the GNU General Public License. This
	32	exception does not however invalidate any other reasons why the
	33	executable file might be covered by the GNU General Public License.

+18

-18

music123.1 less more

5	5	.SH SYNOPSIS
6	6	.B music123
7	7	[
8		.B -hqrvz
	8	.B \-hqrvz
9	9	]
10	10	.I file
11	11	.B ...

18	18	in /etc/music123rc or ~/.music123rc.
19	19
20	20	.SH OPTIONS
21		.IP -h
	21	.IP \-h
22	22	Show command help and exit;
23		.IP -q
	23	.IP \-q
24	24	Quiet mode. No messages are displayed.
25		.IP -r
	25	.IP \-r
26	26	Recurse into directories, instead of ignoring them.
27		.IP -v
	27	.IP \-v
28	28	Display version information and exit.
29		.IP -z
	29	.IP \-z
30	30	Play files in random order.
31		.IP -Z
	31	.IP \-Z
32	32	Play the files randomly and endlessly.
33		.IP -l
	33	.IP \-l
34	34	Loop. \-z \-l differs from \-Z in that \-z \-l will randomize, play
35	35	through the song list (without repetition) in random order once,
36	36	and repeat the songs in that order over and over; \-Z will randomly
37	37	play the songs, without any order, and will possibly play a song
38	38	right after itself.
39		.IP -i
	39	.IP \-i
40	40	Ignore extension case.
41		.IP -L
	41	.IP \-L
42	42	List files and exit.
43		.IP -T
	43	.IP \-T
44	44	Start a task that handle commands, only one command supported : quit,
45	45	using q or Q will quit the application at the end of the current song.
46		.IP -D
	46	.IP \-D
47	47	Set music123 not to delay between songs. (May make music123 harder to
48	48	kill).
49		.IP -d
	49	.IP \-d
50	50	Customize the time music123 delays between songs. \-d takes one argument,
51	51	expressed in seconds, which may have a fractional part.
52		.IP -@
53		Play the files listed in the mandatory argument of -@. Other files can be
	52	.IP \-@
	53	Play the files listed in the mandatory argument of \-@. Other files can be
54	54	added on the command line, and this option can be given several times.
55	55	Note that music123 doesn't yet play URLs.
56		.IP --
	56	.IP \-\-
57	57	End option list.
58	58
59	59	.SH EXAMPLES

66	66
67	67	Play a couple of directories and other songs at random:
68	68	.RS
69		.B music123 -z -r Rock/ test1.ogg Pop/ test4.wav
	69	.B music123 \-z \-r Rock/ test1.ogg Pop/ test4.wav
70	70	.RE
71	71	.PP
72	72

81	81
82	82	.TP
83	83	~/.music123rc
84		Per-user config file to override the system wide settings.
	84	Per\-user config file to override the system wide settings.
85	85	.PP
86	86
87	87	.SH AUTHORS

+61

-73

music123.adb less more

0	0	-- music123 by David Starner <dvdeug@debian.org>
1		-- See debian/copyright
2	1
3	2	with Ada.Command_Line; use Ada.Command_Line;
4		with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
5	3	with Ada.Text_IO;
6	4
7	5	with Support_Routines; use Support_Routines;
8		with Intl; use Intl;
	6	with Intl;
9	7	with Commands;
10	8
11	9	procedure Music123 is
	10	Seeing_Minus_Options : Boolean := True;
12	11	Arg_Num : Positive;
13	12	Option_Task : Boolean := False;
14	13	Option_Quiet : Boolean := False;

23	22	Program_List : Tool_List.Vector;
24	23	Command_Task : Commands.Handler_Task;
25	24
26		function N (Msg : String) return String renames Gettext;
27	25	begin
28		Set_Locale;
29		Text_Domain ("music123");
30		Bind_Text_Domain ("music123", "/usr/share/locale");
31		Version := To_Unbounded_String
32		(Format_String (N ("music123 version %d by David Starner"), "16"));
	26	Intl.Set_Locale;
	27	Intl.Text_Domain ("music123");
	28	Intl.Bind_Text_Domain ("music123", "/usr/share/locale");
33	29
34	30	-- Import conffile first
35	31	Import_Conffile (Program_List);

39	35	Error (N ("No arguments found."));
40	36	raise Noted_Error;
41	37	end if;
	38
42	39	Arg_Num := 1;
43	40	while Arg_Num <= Argument_Count loop
44		if Argument (Arg_Num) = "-h" then
45		Error ("");
46		Set_Exit_Status (Success);
47		return;
48		elsif Argument (Arg_Num) = "-q" then
49		Option_Quiet := True;
50		elsif Argument (Arg_Num) = "-z" then
51		Option_Random := True;
52		elsif Argument (Arg_Num) = "-Z" then
53		Option_Eternal_Random := True;
54		elsif Argument (Arg_Num) = "-l" then
55		Option_Loop := True;
56		elsif Argument (Arg_Num) = "-r" then
57		Option_Recurse := True;
58		elsif Argument (Arg_Num) = "-i" then
59		Option_Ignore_Extension_Case := True;
60		elsif Argument (Arg_Num) = "-v" then
61		Ada.Text_IO.Put (To_String (Version)); Ada.Text_IO.New_Line;
62		Set_Exit_Status (Success);
63		return;
64		elsif Argument (Arg_Num) = "-D" then
65		Delay_Length := 0.0;
66		elsif Argument (Arg_Num) = "-d" then
67		if Arg_Num < Argument_Count then
68		begin
69		Delay_Length := Duration'Value (Argument (Arg_Num + 1));
	41	if Seeing_Minus_Options
	42	and then Argument (Arg_Num)'Length = 2
	43	and then Argument (Arg_Num) (1) = '-'
	44	then
	45	case Argument (Arg_Num) (2) is
	46	when 'h' =>
	47	Error ("");
	48	Set_Exit_Status (Success);
	49	return;
	50	when 'q' => Option_Quiet := True;
	51	when 'z' => Option_Random := True;
	52	when 'Z' => Option_Eternal_Random := True;
	53	when 'l' => Option_Loop := True;
	54	when 'r' => Option_Recurse := True;
	55	when 'i' => Option_Ignore_Extension_Case := True;
	56	when 'v' =>
	57	Ada.Text_IO.Put_Line (Version);
	58	Set_Exit_Status (Success);
	59	return;
	60	when 'D' =>
	61	Delay_Length := 0.0;
	62	when 'd' =>
	63	if Arg_Num >= Argument_Count then
	64	Error (N ("Missing argument for -d."));
	65	raise Noted_Error;
	66	end if;
70	67	Arg_Num := Arg_Num + 1;
71		exception
72		when others =>
73		Error (N ("Bad argument for -d."));
	68	begin
	69	Delay_Length := Duration'Value (Argument (Arg_Num));
	70	exception
	71	when Constraint_Error =>
	72	Error (N ("Bad argument for -d."));
	73	raise Noted_Error;
	74	end;
	75	when 'L' => Option_List_Files_Only := True;
	76	when 'T' => Option_Task := True;
	77	when '-' => Seeing_Minus_Options := False;
	78	when '@' =>
	79	if Arg_Num >= Argument_Count then
	80	Error (N ("Missing argument for -@."));
74	81	raise Noted_Error;
75		end;
76		else
77		Error (N ("Missing argument for -d."));
78		raise Noted_Error;
79		end if;
80		elsif Argument (Arg_Num) = "-@" then
81		if Arg_Num < Argument_Count then
82		Read_Playlist (Argument (Arg_Num + 1), File_List);
83		Arg_Num := Arg_Num + 1;
84		else
85		Error (N ("Missing argument for -@."));
86		raise Noted_Error;
87		end if;
88		elsif Argument (Arg_Num) = "-L" then
89		Option_List_Files_Only := True;
90		elsif Argument (Arg_Num) = "-T" then
91		Option_Task := True;
92		elsif Argument (Arg_Num) = "--" then
93		for I in Arg_Num + 1 .. Argument_Count loop
94		if Check_Filename (Argument (I),
95		Program_List,
96		Option_Ignore_Extension_Case) then
97		File_List.Append (Argument (I));
98		end if;
99		end loop;
100		Arg_Num := Argument_Count + 1;
101		elsif Argument (Arg_Num) (1) = '-' then
102		Error (N ("Unknown argument found."));
103		raise Noted_Error;
	82	end if;
	83	Arg_Num := Arg_Num + 1;
	84	Read_Playlist (Argument (Arg_Num), File_List);
	85	when others =>
	86	Error (N ("Unknown argument found."));
	87	raise Noted_Error;
	88	end case;
	89	elsif Check_Filename (Argument (Arg_Num),
	90	Program_List,
	91	Option_Ignore_Extension_Case)
	92	then
	93	File_List.Append (Argument (Arg_Num));
104	94	else
105		if Check_Filename (Argument (Arg_Num),
106		Program_List,
107		Option_Ignore_Extension_Case) then
108		File_List.Append (Argument (Arg_Num));
109		end if;
	95	Ada.Text_IO.Put_Line ("Ignoring file """ & Argument (Arg_Num) & """");
110	96	end if;
111	97	Arg_Num := Arg_Num + 1;
112	98	end loop;

114	100	Expand_And_Check_Filenames (File_List,
115	101	Option_Recurse,
116	102	Program_List,
117		Option_Ignore_Extension_Case);
	103	Option_Ignore_Extension_Case);
118	104
119	105	if Option_List_Files_Only then
120	106	Display_Songs (File_List);
	107	Set_Exit_Status (Success);
121	108	return;
122	109	end if;
123	110

139	126	Command_Task.Stop;
140	127	end if;
141	128
	129	Set_Exit_Status (Success);
142	130	exception
143	131	when Noted_Error =>
144	132	Set_Exit_Status (Failure);

+18

-18

music123.pl.1 less more

5	5	.SH SK£ADNIA
6	6	.B music123
7	7	[
8		.B -hqrvz
	8	.B \-hqrvz
9	9	]
10	10	.I plik
11	11	.B ...

18	18	im przekazywane s± zawarte w plikach /etc/music123rc lub ~/.music123rc.
19	19
20	20	.SH OPCJE
21		.IP -h
	21	.IP \-h
22	22	Poka¿ pomoc do polecenia i zakoñcz dzia³anie.
23		.IP -q
	23	.IP \-q
24	24	Tryb cichy. ¯adne komunikaty nie s± wy¶wietlane.
25		.IP -r
	25	.IP \-r
26	26	Rekurencyjnie zag³êbiaj siê w katalogi, zamiast je ignorowaæ.
27		.IP -v
	27	.IP \-v
28	28	Poka¿ informacjê o wersji programu i zakoñcz dzia³anie.
29		.IP -z
	29	.IP \-z
30	30	Odtwarzaj pliki w losowej kolejno¶ci.
31		.IP -Z
	31	.IP \-Z
32	32	Odtwarzaj pliki w losowej kolejno¶ci i bez koñca.
33		.IP -l
	33	.IP \-l
34	34	Pêtla. \-z \-l ró¿ni siê od \-Z tym, ¿e \-z \-l najpierw wylosuje
35	35	kolejno¶æ, a nastêpnie bêdzie odtwarza³ pliki w tej¿e kolejno¶ci
36	36	raz po raz; \-Z za¶ odtwarza piosenki w losowej kolejno¶ci
37	37	pozbawionej jakiegokolwiek porz±dku, w zwiazku z czym istnieje
38	38	mo¿liwo¶æ odtworzenia tego samego pliku dwa (lub wiêcej) razy
39	39	pod rz±d.
40		.IP -i
	40	.IP \-i
41	41	Ignore extension case.
42		.IP -L
	42	.IP \-L
43	43	List files and exit.
44		.IP -T
	44	.IP \-T
45	45	Start a task that handle commands, only one command supported : quit,
46	46	using q or Q will quit the application at the end of the current song.
47		.IP -D
	47	.IP \-D
48	48	Nie rób przerw miêdzy piosenkami (mo¿e uczyniæ music123 trudniejszym
49	49	do zabicia)
50		.IP -d
	50	.IP \-d
51	51	Ustawia d³ugo¶æ przerw miêdzy piosenkami. \-d przyjmuje jeden argument,
52	52	wyra¿ony w sekundach. Czas mo¿e zawieraæ czê¶æ u³amkow±.
53		.IP -@
54		Odtwarzaj pliki wymienione w obowi±zkowym argumencie do -@. Inne pliki mog±
	53	.IP \-@
	54	Odtwarzaj pliki wymienione w obowi±zkowym argumencie do \-@. Inne pliki mog±
55	55	byæ dodane z linii poleceñ. Ta opcja mo¿e byæ podana kilkakrotnie. Zauwa¿,
56	56	¿e music123 jeszcze nie odtwarza URLi.
57		.IP --
	57	.IP \-\-
58	58	Koniec listy opcji.
59	59
60	60	.SH PRZYK£ADY

67	67
68	68	Odtwórz losowo parê katalogów i piosenek:
69	69	.RS
70		.B music123 -z -r Rock/ test1.ogg Pop/ test4.wav
	70	.B music123 \-z \-r Rock/ test1.ogg Pop/ test4.wav
71	71	.RE
72	72	.PP
73	73

98	98	.TP
99	99	T³umacze:
100	100	.br
101		Grzegorz Ku¶nierz <konik@v-lo.krakow.pl>
	101	Grzegorz Ku¶nierz <konik@v\-lo.krakow.pl>
102	102	.br

-2

music123rc.conf less more

0	0	# This is the configuration file for music123
1	1	# A list of music playing programs follow for music123 to use
2		# Format is
	2	# Format is
3	3	# tool name_of_program extension1,extension2,... "options to be given before the file name"
4	4
5	5	tool ogg123 ogg,Ogg,OGG ""

14	14
15	15	# mplayer is a little heavy-weight; you might want to add -q to the options
16	16	#tool mplayer ra,wmv ""
17

+129

-187

support_routines.adb less more

0	0	with Ada.Text_IO;
1	1	with Ada.Characters.Latin_1;
2	2	with Ada.Environment_Variables;
3		with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;
4		with Ada.Calendar; use Ada.Calendar;
5		with Ada.Strings.Fixed;
6		with Ada.Characters.Handling;
	3	with Ada.Numerics.Discrete_Random;
	4	with Ada.Numerics.Float_Random;
	5	with Ada.Calendar;
	6	with Ada.Strings.Maps;
	7	with Ada.Strings.Maps.Constants;
7	8	with Ada.Directories;
8
9		with Intl; use Intl;
10	9	with Interfaces.C;
11	10
12	11	with Commands;

18	17	Filename : String;
19	18	Option_Ignore_Extension_Case : Boolean)
20	19	return Tool;
21		function Is_Whitespace (C : Character) return Boolean;
	20
	21	Whitespace : constant Ada.Strings.Maps.Character_Set
	22	:= Ada.Strings.Maps.To_Set (Sequence => (' ', Ada.Characters.Latin_1.HT));
	23
	24	function Split_Comma (Source : in String)
	25	return UString_List.Vector;
22	26	function Home_Directory return String;
23	27	function Shell_Fix (File : String) return String;
24	28	-- end of declarations
25	29
26		function Format_String (Format : String; Insert : String) return String is
27		begin
28		for I in Format'First .. Format'Last - 1 loop
29		if Format (I) = '%' and then Format (I + 1) = 'd' then
30		return Format (Format'First .. I - 1) &
31		Insert & Format (I + 2 .. Format'Last);
32		end if;
33		end loop;
34		return Format; -- XXX Raise exception instead???
35		end Format_String;
36
37	30	procedure Error (Error_String : String) is
38	31	use Ada.Text_IO;
39	32	begin
40		Put (Standard_Error, N ("music123: ") & Error_String);
	33	Put_Line (Standard_Error, N ("music123: ") & Error_String);
	34	Put_Line (Standard_Error, Version);
	35	Put_Line (Standard_Error, N ("usage: music123 [-hqrvz] files ..."));
	36	Put_Line (Standard_Error, N ("-h This help"));
	37	Put_Line (Standard_Error, N ("-q Run quiet"));
	38	Put_Line (Standard_Error, N ("-i Ignore extension case"));
	39	Put_Line (Standard_Error, N ("-L List files and exit"));
	40	Put_Line (Standard_Error, N ("-r Recurse over directories"));
	41	Put_Line (Standard_Error, N ("-v Print the version and exit"));
	42	Put_Line (Standard_Error, N ("-z Randomize the filelist"));
41	43	New_Line (Standard_Error);
42		Put (Standard_Error, To_String (Version));
43		New_Line (Standard_Error);
44		Put (Standard_Error, N ("usage: music123 [-hqrvz] files ..."));
45		New_Line (Standard_Error);
46		Put (Standard_Error, N ("-h This help"));
47		New_Line (Standard_Error);
48		Put (Standard_Error, N ("-q Run quiet"));
49		New_Line (Standard_Error);
50		Put (Standard_Error, N ("-i Ignore extension case"));
51		New_Line (Standard_Error);
52		Put (Standard_Error, N ("-L List files and exit"));
53		New_Line (Standard_Error);
54		Put (Standard_Error, N ("-r Recurse over directories"));
55		New_Line (Standard_Error);
56		Put (Standard_Error, N ("-v Print the version and exit"));
57		New_Line (Standard_Error);
58		Put (Standard_Error, N ("-z Randomize the filelist"));
59		New_Line (Standard_Error);
60		New_Line (Standard_Error);
61		Put (Standard_Error, N ("See the manpage for more options."));
62		New_Line (Standard_Error);
	44	Put_Line (Standard_Error, N ("See the manpage for more options."));
63	45	end Error;
64	46
65	47	No_Home_Directory : exception;

73	55	raise No_Home_Directory;
74	56	end if;
75	57	end Home_Directory;
76
77		function Is_Whitespace (C : Character) return Boolean is
78		begin
79		return (C = ' ') or else (C = Ada.Characters.Latin_1.HT);
80		end Is_Whitespace;
81	58
82	59	procedure Import_Conffile (Program_List : in out Tool_List.Vector)
83	60	is

85	62	Error_String : constant String
86	63	:= N ("Neither /etc/music123rc or ~/.music123rc found. Exiting.");
87	64	Conf_File : File_Type;
88		Pointer_Start, Pointer_End : Natural;
89	65	begin
90	66	Program_List.Clear;
91	67	begin

100	76	raise Noted_Error;
101	77	end;
102	78	end;
103		while (not End_Of_File (Conf_File)) loop
	79	while not End_Of_File (Conf_File) loop
104	80	declare
105	81	Line : constant String := Get_Line (Conf_File);
106		This_Tool : Tool;
	82	use Ada.Strings.Fixed;
	83	P_F, E_F, O_F : Positive;
	84	P_L, E_L, O_L : Natural;
107	85	begin
108		if Line'Length > 4 and
109		then Line (Line'First .. Line'First + 3) = "tool" then
110		Pointer_Start := Line'First + 4;
111		while Is_Whitespace (Line (Pointer_Start)) loop
112		Pointer_Start := Pointer_Start + 1;
113		end loop;
114		Pointer_End := Pointer_Start;
115		while not Is_Whitespace (Line (Pointer_End + 1)) loop
116		Pointer_End := Pointer_End + 1;
117		end loop;
118		This_Tool.Program :=
119		To_Unbounded_String (Line (Pointer_Start .. Pointer_End));
120		Pointer_Start := Pointer_End + 1;
121		while Is_Whitespace (Line (Pointer_Start)) loop
122		Pointer_Start := Pointer_Start + 1;
123		end loop;
124		Pointer_End := Pointer_Start;
125		while not Is_Whitespace (Line (Pointer_End + 1)) loop
126		Pointer_End := Pointer_End + 1;
127		end loop;
128		This_Tool.Extension_List :=
129		To_Unbounded_String (Line (Pointer_Start .. Pointer_End));
130		Pointer_Start := Pointer_End + 1;
131		while Line (Pointer_Start) /= '"' loop
132		Pointer_Start := Pointer_Start + 1;
133		end loop;
134		Pointer_Start := Pointer_Start + 1;
135		Pointer_End := Pointer_Start;
136		while (Line (Pointer_End) /= '"') loop -- " -- Once again!
137		Pointer_End := Pointer_End + 1;
138		end loop;
139		Pointer_End := Pointer_End - 1;
140		This_Tool.Options :=
141		To_Unbounded_String (Line (Pointer_Start .. Pointer_End));
142		Program_List.Append (This_Tool);
	86	if Head (Line, 4) = "tool" then
	87	Find_Token (Source => Line, From => Line'First + 4,
	88	Test => Ada.Strings.Outside, Set => Whitespace,
	89	First => P_F, Last => P_L);
	90	Find_Token (Source => Line, From => P_L + 1,
	91	Test => Ada.Strings.Outside, Set => Whitespace,
	92	First => E_F, Last => E_L);
	93	O_F := Index (Source => Line, From => E_L + 1,
	94	Pattern => """") + 1;
	95	O_L := Index (Source => Line, From => O_F, Pattern => """") - 1;
	96	Program_List.Append
	97	((Program_Length => P_L - P_F + 1,
	98	Program => Line (P_F .. P_L),
	99	Options_Length => O_L - O_F + 1,
	100	Options => Line (O_F .. O_L),
	101	Extension_List => Split_Comma (Line (E_F .. E_L))));
143	102	end if;
144	103	end;
145	104	end loop;
146	105	Close (Conf_File);
	106	exception
	107	when others =>
	108	if Is_Open (Conf_File) then
	109	Close (Conf_File);
	110	end if;
	111	Put_Line ("Warning: unable to parse configuration file.");
	112	raise;
147	113	end Import_Conffile;
148	114
149		Null_Tool : constant Tool := (To_Unbounded_String ("/dev/null"),
150		Null_Unbounded_String,
151		Null_Unbounded_String);
	115	Null_Tool : constant Tool := (Program_Length => 9, Program => "/dev/null",
	116	Options_Length => 0, Options => "",
	117	Extension_List => UString_List.Empty_Vector);
152	118
153	119	function Matched_Extension (Extension_List : in Tool_List.Vector;
154	120	Filename : String;
155	121	Option_Ignore_Extension_Case : Boolean)
156	122	return Tool is
157		Pointer_Start, Pointer_End : Natural;
158		begin
159		for I in Extension_List.First_Index .. Extension_List.Last_Index loop
160		declare
161		Ext_List : constant String :=
162		To_String (Extension_List.Element (I).Extension_List);
163		begin
164		Pointer_Start := Ext_List'First;
165		Pointer_End := Ext_List'First;
166		while Pointer_End < Ext_List'Last loop
167
168		while Pointer_End /= Ext_List'Last and then
169		Ext_List (Pointer_End + 1) /= ',' loop
170		Pointer_End := Pointer_End + 1;
171		end loop;
172		declare
173		Extension_String : constant String :=
174		"." & Ext_List (Pointer_Start .. Pointer_End);
175		begin
176		if Filename'Length > Pointer_End - Pointer_Start + 1 then
177		declare
178		End_File_Name : constant String :=
179		Filename (Filename'Last + Pointer_Start -
180		Pointer_End - 1 .. Filename'Last);
181		use Ada.Characters.Handling;
182		begin
183		if End_File_Name = Extension_String then
184		return Extension_List.Element (I);
185		end if;
186		if Option_Ignore_Extension_Case then
187		if To_Lower (End_File_Name) =
188		To_Lower (Extension_String) then
189		return Extension_List.Element (I);
190		end if;
191		end if;
192		end;
193		end if;
194		end;
195		Pointer_Start := Pointer_End + 2;
196		Pointer_End := Pointer_Start;
197
198		end loop;
199		end;
	123	use Ada.Strings.Fixed;
	124	use Ada.Strings.Maps;
	125	use Ada.Strings.Maps.Constants;
	126	Mapping : constant Character_Mapping
	127	:= (if Option_Ignore_Extension_Case then Lower_Case_Map else Identity);
	128	begin
	129	for This_Tool of Extension_List loop
	130	for Extension of This_Tool.Extension_List loop
	131	if Translate (Tail (Filename, Extension'Length), Mapping)
	132	= Translate (Extension, Mapping)
	133	then
	134	return This_Tool;
	135	end if;
	136	end loop;
200	137	end loop;
201	138	return Null_Tool;
202	139

285	222	end Expand_And_Check_Filenames;
286	223
287	224	procedure Randomize_Names (File_List : in out UString_List.Vector) is
288
	225	use Ada.Calendar;
	226	use Ada.Numerics.Float_Random;
289	227	J : Positive;
290	228	Gen : Generator;
291	229	begin

317	255	end Shell_Fix;
318	256
319	257	procedure Display_Songs (File_List : in UString_List.Vector) is
320		procedure Display_Song (Cursor : UString_List.Cursor);
321		procedure Display_Song (Cursor : UString_List.Cursor) is
322		begin
323		Ada.Text_IO.Put_Line (UString_List.Element (Cursor));
324		end Display_Song;
325		begin
326		UString_List.Iterate (File_List, Display_Song'Access);
	258	begin
	259	for Song of File_List loop
	260	Ada.Text_IO.Put_Line (Song);
	261	end loop;
327	262	end Display_Songs;
328	263
329	264	procedure Play_Songs

337	272	Option_Ignore_Extension_Case : in Boolean
338	273	) is
339	274
340		use Interfaces.C;
341		function System (Command : char_array) return Integer;
342		pragma Import (C, System, "system");
343		procedure Play_A_Song (File_Name : in String;
344		Option_Quiet : in Boolean);
345		procedure Play_A_Song (File_Name : in String;
346		Option_Quiet : in Boolean) is
347		pragma Warnings (Off);
348		System_Result : Integer;
349		pragma Warnings (On);
350		This_Program : Tool;
	275	procedure Play_A_Song (File_Name : in String);
	276	procedure Play_A_Song (File_Name : in String) is
	277	use Interfaces.C;
	278	function System (command : char_array) return int;
	279	pragma Import (C, System, "system");
	280	This_Program : constant Tool := Matched_Extension
	281	(Program_List,
	282	File_Name,
	283	Option_Ignore_Extension_Case);
	284	System_String : constant String :=
	285	This_Program.Program & " " & This_Program.Options & " '"
	286	& Shell_Fix (File_Name) & "'"
	287	& (if Option_Quiet then " > /dev/null 2> /dev/null" else "");
	288	System_Result : constant int := System (To_C (System_String));
351	289	begin
352		This_Program := Matched_Extension (Program_List,
353		File_Name,
354		Option_Ignore_Extension_Case);
355		if Option_Quiet then
356		declare
357		System_String : constant String :=
358		To_String (This_Program.Program & " " &
359		This_Program.Options & " '" &
360		Shell_Fix (File_Name) & "'" &
361		">/dev/null 2>/dev/null");
362		begin
363		System_Result := System (To_C (System_String));
364		end;
365		else
366		declare
367		System_String : constant String :=
368		To_String (This_Program.Program & " " & This_Program.Options &
369		" '" & Shell_Fix (File_Name) & "'");
370		begin
371		System_Result := System (To_C (System_String));
372		end;
	290	if System_Result /= 0 then
	291	Ada.Text_IO.Put_Line ("Command """ & System_String
	292	& """ exited with non zero status ("
	293	& int'Image (System_Result) & ").");
373	294	end if;
374	295	end Play_A_Song;
375	296
376		Gen : Generator;
377	297	begin
378	298	if Option_Eternal_Random then
379		Reset (Gen, Integer (Seconds (Clock) * 10.0));
380	299	declare
381		Len : constant Natural
382		:= File_List.Last_Index - File_List.First_Index + 1;
383		Song_Number : Positive;
	300	subtype S is Integer
	301	range File_List.First_Index .. File_List.Last_Index;
	302	package S_Random is new Ada.Numerics.Discrete_Random (S);
	303	use S_Random;
	304	use Ada.Calendar;
	305	Gen : Generator;
384	306	begin
385		loop
386		Song_Number :=
387		Integer (Float'Floor (Random (Gen) * Float (Len))) + 1;
388		exit when Commands.Repository.Have_To_Quit;
389		Play_A_Song (File_List.Element (Song_Number),
390		Option_Quiet);
	307	Reset (Gen, Integer (Seconds (Clock) * 10.0));
	308	while not Commands.Repository.Have_To_Quit loop
	309	Play_A_Song (File_List.Element (Random (Gen)));
391	310	end loop;
392	311	end;
393	312	end if;

397	316	end if;
398	317
399	318	loop
400		for I in File_List.First_Index .. File_List.Last_Index loop
	319	for Song of File_List loop
401	320	exit when Commands.Repository.Have_To_Quit;
402		Play_A_Song (File_List.Element (I), Option_Quiet);
403		delay (Delay_Length);
	321	Play_A_Song (Song);
	322	delay Delay_Length;
404	323	end loop;
405	324	exit when Commands.Repository.Have_To_Quit;
406	325	exit when not Option_Loop;

419	338	Error (N ("Playlist file not found."));
420	339	raise Noted_Error;
421	340	end;
422		while (not End_Of_File (Playlist)) loop
	341	while not End_Of_File (Playlist) loop
423	342	declare
424	343	Line : constant String :=
425		Ada.Strings.Fixed.Trim (Get_Line (Playlist),
426		Ada.Strings.Both);
	344	Ada.Strings.Fixed.Trim (Get_Line (Playlist), Ada.Strings.Both);
427	345	begin
428	346	if Line /= "" and then Line (1) /= '#' then
429	347	File_List.Append (Line);

431	349	end;
432	350	end loop;
433	351	Close (Playlist);
	352	exception
	353	when others =>
	354	if Is_Open (Playlist) then
	355	Close (Playlist);
	356	end if;
	357	Put_Line ("Warning: unable to parse playlist.");
	358	raise;
434	359	end Read_Playlist;
435	360
	361	function Split_Comma (Source : in String)
	362	return UString_List.Vector is
	363	First : Positive := Source'First;
	364	Comma_Index : Natural;
	365	begin
	366	return Result : UString_List.Vector do
	367	loop
	368	Comma_Index := Ada.Strings.Fixed.Index (Source => Source,
	369	Pattern => ",",
	370	From => First);
	371	exit when Comma_Index = 0;
	372	Result.Append ("." & Source (First .. Comma_Index - 1));
	373	First := Comma_Index + 1;
	374	end loop;
	375	Result.Append ("." & Source (First .. Source'Last));
	376	end return;
	377	end Split_Comma;
	378
436	379	end Support_Routines;
437

+16

-10

support_routines.ads less more

0		with Ada.Containers.Vectors;
1	0	with Ada.Containers.Indefinite_Vectors;
2		with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
	1	with Ada.Strings.Fixed;
	2
3	3	with Intl;
4	4
5	5	package Support_Routines is

10	10
11	11	function N (Msg : String) return String renames Intl.Gettext;
12	12
13		Version : Unbounded_String;
	13	Version_Number : constant String := "16";
	14	Version_Format : constant String
	15	:= N ("music123 version %d by David Starner");
	16	Version : constant String := Ada.Strings.Fixed.Insert
	17	(Source => Version_Format,
	18	Before => Ada.Strings.Fixed.Index (Version_Format, Pattern => "%d"),
	19	New_Item => Version_Number);
14	20
15	21	Noted_Error : exception;
16	22
17		type Tool is record
18		Program : Unbounded_String;
19		Extension_List : Unbounded_String;
20		Options : Unbounded_String;
	23	type Tool
	24	(Program_Length : Natural;
	25	Options_Length : Natural) is record
	26	Program : String (1 .. Program_Length);
	27	Extension_List : UString_List.Vector;
	28	Options : String (1 .. Options_Length);
21	29	end record;
22	30
23		package Tool_List is new Ada.Containers.Vectors (Positive, Tool);
	31	package Tool_List is new Ada.Containers.Indefinite_Vectors (Positive, Tool);
24	32
25		function Format_String (Format : String; Insert : String) return String;
26	33	procedure Error (Error_String : String);
27	34	procedure Import_Conffile (Program_List : in out Tool_List.Vector);
28	35	procedure Expand_And_Check_Filenames

49	56	return Boolean;
50	57
51	58	end Support_Routines;
52