diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_fl_error.cpp | 14 | ||||
| -rw-r--r-- | src/c_fl_error.h | 3 | ||||
| -rw-r--r-- | src/c_fl_file_chooser.cpp | 20 | ||||
| -rw-r--r-- | src/c_fl_file_chooser.h | 3 | ||||
| -rw-r--r-- | src/c_fl_filename.cpp | 127 | ||||
| -rw-r--r-- | src/c_fl_filename.h | 39 | ||||
| -rw-r--r-- | src/fltk-file_choosers.adb | 31 | ||||
| -rw-r--r-- | src/fltk-file_choosers.ads | 7 | ||||
| -rw-r--r-- | src/fltk-filenames.adb | 484 | ||||
| -rw-r--r-- | src/fltk-filenames.ads | 157 |
10 files changed, 878 insertions, 7 deletions
diff --git a/src/c_fl_error.cpp b/src/c_fl_error.cpp index 17c45a0..2b83187 100644 --- a/src/c_fl_error.cpp +++ b/src/c_fl_error.cpp @@ -19,34 +19,34 @@ extern "C" void error_fatal_hook(const char * m); // This is the size used internally in FLTK anyway -const int bsize = 1024; +const int error_bsize = 1024; // Some prep needed to convert vargs to a single char* void warning_hook_prep(const char * m, ...) { va_list args; - char buf[bsize]; + char buf[error_bsize]; va_start(args, m); - vsnprintf(buf, bsize, m, args); + vsnprintf(buf, error_bsize, m, args); va_end(args); error_warning_hook(buf); } void error_hook_prep(const char * m, ...) { va_list args; - char buf[bsize]; + char buf[error_bsize]; va_start(args, m); - vsnprintf(buf, bsize, m, args); + vsnprintf(buf, error_bsize, m, args); va_end(args); error_error_hook(buf); } void fatal_hook_prep(const char * m, ...) { va_list args; - char buf[bsize]; + char buf[error_bsize]; va_start(args, m); - vsnprintf(buf, bsize, m, args); + vsnprintf(buf, error_bsize, m, args); va_end(args); error_fatal_hook(buf); } diff --git a/src/c_fl_error.h b/src/c_fl_error.h index 263a42b..b8ffb00 100644 --- a/src/c_fl_error.h +++ b/src/c_fl_error.h @@ -8,6 +8,9 @@ #define FL_ERROR_GUARD +extern "C" const int error_bsize; + + extern "C" void fl_error_default_warning(const char * m); extern "C" void fl_error_default_error(const char * m); extern "C" void fl_error_default_fatal(const char * m); diff --git a/src/c_fl_file_chooser.cpp b/src/c_fl_file_chooser.cpp index 4cf3e8e..3ca16e2 100644 --- a/src/c_fl_file_chooser.cpp +++ b/src/c_fl_file_chooser.cpp @@ -11,6 +11,26 @@ +// Exports from Ada + +extern "C" int file_chooser_sort_hook(const char * a, const char * b); + + + + +// Some extra setup + +int file_chooser_sort_prehook(struct dirent ** a, struct dirent ** b) { + return file_chooser_sort_hook((*a)->d_name, (*b)->d_name); +} + +void file_chooser_setup_sort_hook() { + Fl_File_Chooser::sort = &file_chooser_sort_prehook; +} + + + + // Flattened C API begins here FILECHOOSER new_fl_file_chooser(const char * n, const char * p, int k, const char * t) { diff --git a/src/c_fl_file_chooser.h b/src/c_fl_file_chooser.h index e5dcf05..17ee63c 100644 --- a/src/c_fl_file_chooser.h +++ b/src/c_fl_file_chooser.h @@ -11,6 +11,9 @@ typedef void* FILECHOOSER; +extern "C" void file_chooser_setup_sort_hook(); + + extern "C" FILECHOOSER new_fl_file_chooser(const char * n, const char * p, int k, const char * t); extern "C" void free_fl_file_chooser(FILECHOOSER f); diff --git a/src/c_fl_filename.cpp b/src/c_fl_filename.cpp new file mode 100644 index 0000000..39af3d1 --- /dev/null +++ b/src/c_fl_filename.cpp @@ -0,0 +1,127 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <FL/filename.H> +#include <string.h> +#include "c_fl_filename.h" + + + + +const int fl_path_max = FL_PATH_MAX; + + + + +void free_filename_file_list(void * l, int n) { + struct dirent ** p = reinterpret_cast<struct dirent **>(l); + fl_filename_free_list(&p, n); +} + +const char * filename_dname(void * l, int n) { + return (reinterpret_cast<struct dirent **>(l)[n])->d_name; +} + + + + +void filename_decode_uri(char *uri) { + fl_decode_uri(uri); +} + +int filename_absolute(char * to, int tolen, const char * from) { + return fl_filename_absolute(to, tolen, from); +} + +int filename_expand(char * to, int tolen, const char * from) { + return fl_filename_expand(to, tolen, from); +} + +const char * filename_ext(const char * buf) { + return fl_filename_ext(buf); +} + +int filename_isdir(const char * name) { + return fl_filename_isdir(name); +} + +int filename_list(const char * d, void * l, void * f) { + return fl_filename_list(d, reinterpret_cast<struct dirent ***>(l), + reinterpret_cast<Fl_File_Sort_F*>(f)); +} + +int filename_match(const char * name, const char * pattern) { + return fl_filename_match(name, pattern); +} + +const char * filename_name(const char * name) { + return fl_filename_name(name); +} + +int filename_relative(char * to, int tolen, const char * from) { + return fl_filename_relative(to, tolen, from); +} + +char * filename_setext(char * to, int tolen, const char * ext) { + return fl_filename_setext(to, tolen, ext); +} + +int filename_open_uri(const char * uri, char * msg, int msglen) { + return fl_open_uri(uri, msg, msglen); +} + + + + +int filename_alphasort(char * a, char * b) { + struct dirent d_aye, d_bee; + d_aye.d_name[0] = '\0'; + strncat (d_aye.d_name, a, 255); + d_bee.d_name[0] = '\0'; + strncat (d_bee.d_name, b, 255); + struct dirent * dp_aye = &d_aye; + struct dirent * dp_bee = &d_bee; + int result = fl_alphasort(&dp_aye, &dp_bee); + return result < 0 ? 0 : result == 0 ? 1 : 2; +} + +int filename_casealphasort(char * a, char * b) { + struct dirent d_aye, d_bee; + d_aye.d_name[0] = '\0'; + strncat (d_aye.d_name, a, 255); + d_bee.d_name[0] = '\0'; + strncat (d_bee.d_name, b, 255); + struct dirent * dp_aye = &d_aye; + struct dirent * dp_bee = &d_bee; + int result = fl_casealphasort(&dp_aye, &dp_bee); + return result < 0 ? 0 : result == 0 ? 1 : 2; +} + +int filename_numericsort(char * a, char * b) { + struct dirent d_aye, d_bee; + d_aye.d_name[0] = '\0'; + strncat (d_aye.d_name, a, 255); + d_bee.d_name[0] = '\0'; + strncat (d_bee.d_name, b, 255); + struct dirent * dp_aye = &d_aye; + struct dirent * dp_bee = &d_bee; + int result = fl_numericsort(&dp_aye, &dp_bee); + return result < 0 ? 0 : result == 0 ? 1 : 2; +} + +int filename_casenumericsort(char * a, char * b) { + struct dirent d_aye, d_bee; + d_aye.d_name[0] = '\0'; + strncat (d_aye.d_name, a, 255); + d_bee.d_name[0] = '\0'; + strncat (d_bee.d_name, b, 255); + struct dirent * dp_aye = &d_aye; + struct dirent * dp_bee = &d_bee; + int result = fl_casenumericsort(&dp_aye, &dp_bee); + return result < 0 ? 0 : result == 0 ? 1 : 2; +} + + diff --git a/src/c_fl_filename.h b/src/c_fl_filename.h new file mode 100644 index 0000000..0839293 --- /dev/null +++ b/src/c_fl_filename.h @@ -0,0 +1,39 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_FILENAME_GUARD +#define FL_FILENAME_GUARD + + +extern "C" const int fl_path_max; + + +extern "C" void free_filename_file_list(void * l, int n); +extern "C" const char * filename_dname(void * l, int n); + + +extern "C" void filename_decode_uri(char *uri); +extern "C" int filename_absolute(char * to, int tolen, const char * from); +extern "C" int filename_expand(char * to, int tolen, const char * from); +extern "C" const char * filename_ext(const char * buf); +extern "C" int filename_isdir(const char * name); +extern "C" int filename_list(const char * d, void * l, void * f); +extern "C" int filename_match(const char * name, const char * pattern); +extern "C" const char * filename_name(const char * name); +extern "C" int filename_relative(char * to, int tolen, const char * from); +extern "C" char * filename_setext(char * to, int tolen, const char * ext); +extern "C" int filename_open_uri(const char * uri, char * msg, int msglen); + + +extern "C" int filename_alphasort(char * a, char * b); +extern "C" int filename_casealphasort(char * a, char * b); +extern "C" int filename_numericsort(char * a, char * b); +extern "C" int filename_casenumericsort(char * a, char * b); + + +#endif + + diff --git a/src/fltk-file_choosers.adb b/src/fltk-file_choosers.adb index 5363c51..db9768c 100644 --- a/src/fltk-file_choosers.adb +++ b/src/fltk-file_choosers.adb @@ -47,6 +47,13 @@ package body FLTK.File_Choosers is + procedure file_chooser_setup_sort_hook; + pragma Import (C, file_chooser_setup_sort_hook, "file_chooser_setup_sort_hook"); + pragma Inline (file_chooser_setup_sort_hook); + + + + function new_fl_file_chooser (N, P : in Interfaces.C.char_array; K : in Interfaces.C.int; @@ -459,6 +466,26 @@ package body FLTK.File_Choosers is + ---------------------- + -- Callback Hooks -- + ---------------------- + + function File_Chooser_Sort_Hook + (A, B : in Interfaces.C.Strings.chars_ptr) + return Interfaces.C.int; + + pragma Export (C, File_Chooser_Sort_Hook, "file_chooser_sort_hook"); + + function File_Chooser_Sort_Hook + (A, B : in Interfaces.C.Strings.chars_ptr) + return Interfaces.C.int is + begin + return Filenames.Comparison'Pos (Sort_Method + (Interfaces.C.Strings.Value (A), + Interfaces.C.Strings.Value (B))) - 1; + end File_Chooser_Sort_Hook; + + procedure File_Chooser_Callback_Hook (C_Addr, User_Data : in Storage.Integer_Address); @@ -1205,6 +1232,10 @@ package body FLTK.File_Choosers is end Is_Visible; +begin + + file_chooser_setup_sort_hook; + end FLTK.File_Choosers; diff --git a/src/fltk-file_choosers.ads b/src/fltk-file_choosers.ads index b350ddc..cea7b36 100644 --- a/src/fltk-file_choosers.ads +++ b/src/fltk-file_choosers.ads @@ -6,6 +6,7 @@ with + FLTK.Filenames, FLTK.Widgets.Buttons.Light.Check; private with @@ -46,6 +47,12 @@ package FLTK.File_Choosers is + Sort_Method : not null FLTK.Filenames.Compare_Function := + FLTK.Filenames.Numeric_Sort'Access; + + + + function New_Button (This : in out File_Chooser) return FLTK.Widgets.Buttons.Button_Reference; diff --git a/src/fltk-filenames.adb b/src/fltk-filenames.adb new file mode 100644 index 0000000..f8f31f0 --- /dev/null +++ b/src/fltk-filenames.adb @@ -0,0 +1,484 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + +use type + + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Filenames is + + + ------------------------ + -- Constants From C -- + ------------------------ + + error_bsize : constant Interfaces.C.int; + pragma Import (C, error_bsize, "error_bsize"); + + + + + ------------------------ + -- Functions From C -- + ------------------------ + + procedure free_filename_file_list + (L : in Storage.Integer_Address; + N : in Interfaces.C.int); + pragma Import (C, free_filename_file_list, "free_filename_file_list"); + pragma Inline (free_filename_file_list); + + function filename_dname + (L : in Storage.Integer_Address; + N : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, filename_dname, "filename_dname"); + pragma Inline (filename_dname); + + + + + procedure filename_decode_uri + (URI : in Interfaces.C.char_array); + pragma Import (C, filename_decode_uri, "filename_decode_uri"); + pragma Inline (filename_decode_uri); + + function filename_absolute + (To : in Interfaces.C.char_array; + Len : in Interfaces.C.int; + From : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_absolute, "filename_absolute"); + pragma Inline (filename_absolute); + + function filename_expand + (To : in Interfaces.C.char_array; + Len : in Interfaces.C.int; + From : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_expand, "filename_expand"); + pragma Inline (filename_expand); + + function filename_ext + (Buf : in Interfaces.C.char_array) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, filename_ext, "filename_ext"); + pragma Inline (filename_ext); + + function filename_isdir + (Name : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_isdir, "filename_isdir"); + pragma Inline (filename_isdir); + + function filename_list + (D : in Interfaces.C.char_array; + L : out Storage.Integer_Address; + F : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, filename_list, "filename_list"); + pragma Inline (filename_list); + + function filename_match + (Name, Pattern : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_match, "filename_match"); + pragma Inline (filename_match); + + function filename_name + (Name : in Interfaces.C.char_array) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, filename_name, "filename_name"); + pragma Inline (filename_name); + + function filename_relative + (To : in Interfaces.C.char_array; + Len : in Interfaces.C.int; + From : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_relative, "filename_relative"); + pragma Inline (filename_relative); + + function filename_setext + (To : in Interfaces.C.char_array; + Len : in Interfaces.C.int; + Ext : in Interfaces.C.char_array) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, filename_setext, "filename_setext"); + pragma Inline (filename_setext); + + function filename_open_uri + (U, M : in Interfaces.C.char_array; + Len : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, filename_open_uri, "filename_open_uri"); + pragma Inline (filename_open_uri); + + + + + function filename_alphasort + (A, B : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_alphasort, "filename_alphasort"); + + function filename_casealphasort + (A, B : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_casealphasort, "filename_casealphasort"); + + function filename_numericsort + (A, B : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_numericsort, "filename_numericsort"); + + function filename_casenumericsort + (A, B : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, filename_casenumericsort, "filename_casenumericsort"); + + + + + ------------------------------ + -- Comparison Subprograms -- + ------------------------------ + + function Alpha_Sort + (A, B : in String) + return Comparison + is + Result : Interfaces.C.int := + filename_alphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); + begin + if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then + raise Internal_FLTK_Error; + else + return Comparison'Val (Result); + end if; + end Alpha_Sort; + + + function Case_Alpha_Sort + (A, B : in String) + return Comparison + is + Result : Interfaces.C.int := + filename_casealphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); + begin + if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then + raise Internal_FLTK_Error; + else + return Comparison'Val (Result); + end if; + end Case_Alpha_Sort; + + + function Numeric_Sort + (A, B : in String) + return Comparison + is + Result : Interfaces.C.int := + filename_numericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); + begin + if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then + raise Internal_FLTK_Error; + else + return Comparison'Val (Result); + end if; + end Numeric_Sort; + + + function Case_Numeric_Sort + (A, B : in String) + return Comparison + is + Result : Interfaces.C.int := + filename_casenumericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); + begin + if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then + raise Internal_FLTK_Error; + else + return Comparison'Val (Result); + end if; + end Case_Numeric_Sort; + + + + + --------------------------- + -- Listing Subprograms -- + --------------------------- + + procedure Finalize + (This : in out File_List) is + begin + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_filename_file_list (This.Void_Ptr, This.Entries); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + function Length + (This : in File_List) + return Natural is + begin + return Natural (This.Entries); + end Length; + + + function Item + (This : in File_List; + Index : in Positive) + return Path_String is + begin + return Interfaces.C.Strings.Value + (filename_dname (This.Void_Ptr, Interfaces.C.int (Index) - 1)); + end Item; + + + + + -------------------- + -- Filename API -- + -------------------- + + function Decode_URI + (URI : in Path_String) + return Path_String + is + C_Ptr : Interfaces.C.char_array := Interfaces.C.To_C (URI); + begin + filename_decode_uri (C_Ptr); + return Interfaces.C.To_Ada (C_Ptr); + end Decode_URI; + + + procedure Open_URI + (URI : in Path_String) + is + Message : Interfaces.C.char_array (1 .. Interfaces.C.size_t (error_bsize)) := + (others => Interfaces.C.char'Val (0)); + Result : Interfaces.C.int := filename_open_uri + (Interfaces.C.To_C (URI), + Message, + error_bsize); + begin + if Result = 0 then + raise Open_URI_Error with "Error: " & Interfaces.C.To_Ada (Message); + elsif Result /= 1 then + raise Internal_FLTK_Error; + end if; + end Open_URI; + + + + + function Absolute + (Name : in Path_String) + return Path_String + is + Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Code : Interfaces.C.int := filename_absolute + (Result, + Interfaces.C.int (Max_Path_Length), + Interfaces.C.To_C (Name)); + begin + return Interfaces.C.To_Ada (Result); + end Absolute; + + + function Absolute + (Name : in Path_String; + Changed : out Boolean) + return Path_String + is + Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Code : Interfaces.C.int := filename_absolute + (Result, + Interfaces.C.int (Max_Path_Length), + Interfaces.C.To_C (Name)); + begin + Changed := Code /= 0; + return Interfaces.C.To_Ada (Result); + end Absolute; + + + function Relative + (Name : in Path_String) + return Path_String + is + Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Code : Interfaces.C.int := filename_relative + (Result, + Interfaces.C.int (Max_Path_Length), + Interfaces.C.To_C (Name)); + begin + return Interfaces.C.To_Ada (Result); + end Relative; + + + function Relative + (Name : in Path_String; + Changed : out Boolean) + return Path_String + is + Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Code : Interfaces.C.int := filename_relative + (Result, + Interfaces.C.int (Max_Path_Length), + Interfaces.C.To_C (Name)); + begin + Changed := Code /= 0; + return Interfaces.C.To_Ada (Result); + end Relative; + + + function Expand + (Name : in Path_String) + return Path_String + is + Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Code : Interfaces.C.int := filename_expand + (Result, + Interfaces.C.int (Max_Path_Length), + Interfaces.C.To_C (Name)); + begin + return Interfaces.C.To_Ada (Result); + end Expand; + + + function Expand + (Name : in Path_String; + Changed : out Boolean) + return Path_String + is + Result : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Code : Interfaces.C.int := filename_expand + (Result, + Interfaces.C.int (Max_Path_Length), + Interfaces.C.To_C (Name)); + begin + Changed := Code /= 0; + return Interfaces.C.To_Ada (Result); + end Expand; + + + + + function Base_Name + (Name : in Path_String) + return Path_String + is + Data : Interfaces.C.char_array := Interfaces.C.To_C (Name); + begin + return Interfaces.C.Strings.Value (filename_name (Data)); + end Base_Name; + + + function Extension + (Name : in Path_String) + return Path_String + is + Data : Interfaces.C.char_array := Interfaces.C.To_C (Name); + Result : Interfaces.C.Strings.chars_ptr := filename_ext (Data); + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Extension; + + + function Set_Extension + (Name : in Path_String; + Suffix : in String) + return Path_String + is + Data : Interfaces.C.char_array (1 .. Interfaces.C.size_t (Max_Path_Length)) := + (others => Interfaces.C.char'Val (0)); + Result : Interfaces.C.Strings.chars_ptr; + begin + Data (1 .. Name'Length) := Interfaces.C.To_C (Name); + Result := filename_setext + (Data, + Data'Length, + Interfaces.C.To_C (Suffix)); + return Interfaces.C.Strings.Value (Result); + end Set_Extension; + + + + + function Is_Directory + (Name : in Path_String) + return Boolean is + begin + return filename_isdir (Interfaces.C.To_C (Name)) /= 0; + end Is_Directory; + + + Current_Sort : Compare_Function; + + function Compare_Hook + (DA, DB : in Storage.Integer_Address) + return Interfaces.C.int; + + pragma Convention (C, Compare_Hook); + + function Compare_Hook + (DA, DB : in Storage.Integer_Address) + return Interfaces.C.int + is + Result : Comparison := Current_Sort + (Interfaces.C.Strings.Value (filename_dname (DA, 0)), + Interfaces.C.Strings.Value (filename_dname (DB, 0))); + begin + return Comparison'Pos (Result) - 1; + end Compare_Hook; + + function Get_Listing + (Name : in Path_String; + Sort : in not null Compare_Function := Numeric_Sort'Access) + return File_List is + begin + Current_Sort := Sort; + return This : File_List do + This.Entries := filename_list + (Interfaces.C.To_C (Name), + This.Void_Ptr, + Storage.To_Integer (Compare_Hook'Address)); + end return; + end Get_Listing; + + + + + function Match + (Input, Pattern : in String) + return Boolean is + begin + return filename_match (Interfaces.C.To_C (Input), Interfaces.C.To_C (Pattern)) /= 0; + end Match; + + +end FLTK.Filenames; + + diff --git a/src/fltk-filenames.ads b/src/fltk-filenames.ads new file mode 100644 index 0000000..2872b8c --- /dev/null +++ b/src/fltk-filenames.ads @@ -0,0 +1,157 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +package FLTK.Filenames is + + + Max_Path_Length : constant Natural; + + subtype Path_String is String + with Dynamic_Predicate => Path_String'Length <= Max_Path_Length; + + + type Comparison is (Lesser, Equal, Greater); + + type Compare_Function is access function + (A, B : in String) + return Comparison; + + function Alpha_Sort + (A, B : in String) + return Comparison; + + function Case_Alpha_Sort + (A, B : in String) + return Comparison; + + function Numeric_Sort + (A, B : in String) + return Comparison; + + function Case_Numeric_Sort + (A, B : in String) + return Comparison; + + + type File_List is new Wrapper with private; + + function Length + (This : in File_List) + return Natural; + + function Item + (This : in File_List; + Index : in Positive) + return Path_String + with Pre => Index in 1 .. This.Length; + + + Open_URI_Error : exception; + + + + + function Decode_URI + (URI : in Path_String) + return Path_String; + + procedure Open_URI + (URI : in Path_String); + + + + + function Absolute + (Name : in Path_String) + return Path_String; + + function Absolute + (Name : in Path_String; + Changed : out Boolean) + return Path_String; + + function Relative + (Name : in Path_String) + return Path_String; + + function Relative + (Name : in Path_String; + Changed : out Boolean) + return Path_String; + + function Expand + (Name : in Path_String) + return Path_String; + + function Expand + (Name : in Path_String; + Changed : out Boolean) + return Path_String; + + + + + function Base_Name + (Name : in Path_String) + return Path_String; + + function Extension + (Name : in Path_String) + return Path_String; + + function Set_Extension + (Name : in Path_String; + Suffix : in String) + return Path_String; + + + + + function Is_Directory + (Name : in Path_String) + return Boolean; + + function Get_Listing + (Name : in Path_String; + Sort : in not null Compare_Function := Numeric_Sort'Access) + return File_List; + + + + + function Match + (Input, Pattern : in String) + return Boolean; + + +private + + + type File_List is new Wrapper with record + Entries : Interfaces.C.int := 0; + end record; + + overriding procedure Finalize + (This : in out File_List); + + + fl_path_max : constant Interfaces.C.int; + pragma Import (C, fl_path_max, "fl_path_max"); + + Max_Path_Length : constant Natural := Natural (fl_path_max); + + + pragma Inline (Length); + pragma Inline (Item); + + pragma Inline (Is_Directory); + + pragma Inline (Match); + + +end FLTK.Filenames; + + |