1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
6(*                                                                        *)
7(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16(** Operations on file names. *)
17
18val current_dir_name : string
19(** The conventional name for the current directory (e.g. [.] in Unix). *)
20
21val parent_dir_name : string
22(** The conventional name for the parent of the current directory
23   (e.g. [..] in Unix). *)
24
25val dir_sep : string
26(** The directory separator (e.g. [/] in Unix). @since 3.11.2 *)
27
28val concat : string -> string -> string
29(** [concat dir file] returns a file name that designates file
30   [file] in directory [dir]. *)
31
32val is_relative : string -> bool
33(** Return [true] if the file name is relative to the current
34   directory, [false] if it is absolute (i.e. in Unix, starts
35   with [/]). *)
36
37val is_implicit : string -> bool
38(** Return [true] if the file name is relative and does not start
39   with an explicit reference to the current directory ([./] or
40   [../] in Unix), [false] if it starts with an explicit reference
41   to the root directory or the current directory. *)
42
43val check_suffix : string -> string -> bool
44(** [check_suffix name suff] returns [true] if the filename [name]
45   ends with the suffix [suff]. *)
46
47val chop_suffix : string -> string -> string
48(** [chop_suffix name suff] removes the suffix [suff] from
49   the filename [name]. The behavior is undefined if [name] does not
50   end with the suffix [suff]. *)
51
52val extension : string -> string
53(** [extension name] is the shortest suffix [ext] of [name0] where:
54
55    - [name0] is the longest suffix of [name] that does not
56      contain a directory separator;
57    - [ext] starts with a period;
58    - [ext] is preceded by at least one non-period character
59      in [name0].
60
61    If such a suffix does not exist, [extension name] is the empty
62    string.
63
64    @since 4.04
65*)
66
67val remove_extension : string -> string
68(** Return the given file name without its extension, as defined
69    in {!Filename.extension}. If the extension is empty, the function
70    returns the given file name.
71
72    The following invariant holds for any file name [s]:
73
74    [remove_extension s ^ extension s = s]
75
76    @since 4.04
77*)
78
79val chop_extension : string -> string
80(** Same as {!Filename.remove_extension}, but raise [Invalid_argument]
81    if the given name has an empty extension. *)
82
83
84val basename : string -> string
85(** Split a file name into directory name / base file name.
86   If [name] is a valid file name, then [concat (dirname name) (basename name)]
87   returns a file name which is equivalent to [name]. Moreover,
88   after setting the current directory to [dirname name] (with {!Sys.chdir}),
89   references to [basename name] (which is a relative file name)
90   designate the same file as [name] before the call to {!Sys.chdir}.
91
92   This function conforms to the specification of POSIX.1-2008 for the
93   [basename] utility. *)
94
95val dirname : string -> string
96(** See {!Filename.basename}.
97   This function conforms to the specification of POSIX.1-2008 for the
98   [dirname] utility. *)
99
100val temp_file : ?temp_dir: string -> string -> string -> string
101(** [temp_file prefix suffix] returns the name of a
102   fresh temporary file in the temporary directory.
103   The base name of the temporary file is formed by concatenating
104   [prefix], then a suitably chosen integer number, then [suffix].
105   The optional argument [temp_dir] indicates the temporary directory
106   to use, defaulting to the current result of {!Filename.get_temp_dir_name}.
107   The temporary file is created empty, with permissions [0o600]
108   (readable and writable only by the file owner).  The file is
109   guaranteed to be different from any other file that existed when
110   [temp_file] was called.
111   Raise [Sys_error] if the file could not be created.
112   @before 3.11.2 no ?temp_dir optional argument
113*)
114
115val open_temp_file :
116      ?mode: open_flag list -> ?perms: int -> ?temp_dir: string -> string ->
117      string -> string * out_channel
118(** Same as {!Filename.temp_file}, but returns both the name of a fresh
119   temporary file, and an output channel opened (atomically) on
120   this file.  This function is more secure than [temp_file]: there
121   is no risk that the temporary file will be modified (e.g. replaced
122   by a symbolic link) before the program opens it.  The optional argument
123   [mode] is a list of additional flags to control the opening of the file.
124   It can contain one or several of [Open_append], [Open_binary],
125   and [Open_text].  The default is [[Open_text]] (open in text mode). The
126   file is created with permissions [perms] (defaults to readable and
127   writable only by the file owner, [0o600]).
128
129   @raise Sys_error if the file could not be opened.
130   @before 4.03.0 no ?perms optional argument
131   @before 3.11.2 no ?temp_dir optional argument
132*)
133
134val get_temp_dir_name : unit -> string
135(** The name of the temporary directory:
136    Under Unix, the value of the [TMPDIR] environment variable, or "/tmp"
137    if the variable is not set.
138    Under Windows, the value of the [TEMP] environment variable, or "."
139    if the variable is not set.
140    The temporary directory can be changed with {!Filename.set_temp_dir_name}.
141    @since 4.00.0
142*)
143
144val set_temp_dir_name : string -> unit
145(** Change the temporary directory returned by {!Filename.get_temp_dir_name}
146    and used by {!Filename.temp_file} and {!Filename.open_temp_file}.
147    @since 4.00.0
148*)
149
150val temp_dir_name : string
151  [@@ocaml.deprecated "Use Filename.get_temp_dir_name instead"]
152(** The name of the initial temporary directory:
153    Under Unix, the value of the [TMPDIR] environment variable, or "/tmp"
154    if the variable is not set.
155    Under Windows, the value of the [TEMP] environment variable, or "."
156    if the variable is not set.
157    @deprecated You should use {!Filename.get_temp_dir_name} instead.
158    @since 3.09.1
159*)
160
161val quote : string -> string
162(** Return a quoted version of a file name, suitable for use as
163    one argument in a command line, escaping all meta-characters.
164    Warning: under Windows, the output is only suitable for use
165    with programs that follow the standard Windows quoting
166    conventions.
167 *)
168