Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 260 lines (235 sloc) 8.845 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* depends *)
19 module String = BaseString
20
21 type simple_completion =
22 | Nothing
23 | File of string
24 | Dir
25 | Oneof of string list
26 type completion = {params : simple_completion list; stop : bool}
27
28 type spec =
29 | Unit of (unit -> unit)
30 | Bool of (bool -> unit)
31 | Set of bool ref
32 | Clear of bool ref
33 | String of (string -> unit)
34 | Set_string of string ref
35 | Int of (int -> unit)
36 | Set_int of int ref
37 | Float of (float -> unit)
38 | Set_float of float ref
39 | Tuple of spec list
40 | Symbol of string list * (string -> unit)
41 | Rest of (string -> unit)
42 | Complete of spec * completion
43
44 let spec_of_assoc ref_ assoc =
45 Symbol (List.map fst assoc, (fun s -> ref_ := List.assoc s assoc))
46 let spec_opt_of_assoc ref_ assoc =
47 Symbol (List.map fst assoc, (fun s -> ref_ := Some (List.assoc s assoc)))
48 let spec_of_opt_assoc ref_ default assoc =
49 Unit (fun () ->
50 if !Arg.current+1 < Array.length Sys.argv then
51 let s = Sys.argv.(!Arg.current+1) in
52 if s <> "" && s.[0] = '-' then
53 ref_ := default
54 else (
55 try
56 ref_ := List.assoc s assoc;
57 incr Arg.current;
58 with Not_found ->
59 ref_ := default
60 )
61 else
62 ref_ := default
63 )
64
65 let rec convert_spec_to_old_arg = function
66 | Unit x -> Arg.Unit x
67 | Bool x -> Arg.Bool x
68 | Set x -> Arg.Set x
69 | Clear x -> Arg.Clear x
70 | String x -> Arg.String x
71 | Set_string x -> Arg.Set_string x
72 | Int x -> Arg.Int x
73 | Set_int x -> Arg.Set_int x
74 | Float x -> Arg.Float x
75 | Set_float x -> Arg.Set_float x
76 | Tuple x -> Arg.Tuple (List.map convert_spec_to_old_arg x)
77 | Symbol (x,y) -> Arg.Symbol (x,y)
78 | Rest x -> Arg.Rest x
79 | Complete (x,_) -> convert_spec_to_old_arg x
80 let rec convert_spec_from_old_arg = function
81 | Arg.Unit x -> Unit x
82 | Arg.Bool x -> Bool x
83 | Arg.Set x -> Set x
84 | Arg.Clear x -> Clear x
85 | Arg.String x -> String x
86 | Arg.Set_string x -> Set_string x
87 | Arg.Int x -> Int x
88 | Arg.Set_int x -> Set_int x
89 | Arg.Float x -> Float x
90 | Arg.Set_float x -> Set_float x
91 | Arg.Tuple x -> Tuple (List.map convert_spec_from_old_arg x)
92 | Arg.Symbol (x,y) -> Symbol (x,y)
93 | Arg.Rest x -> Rest x
94 let convert_from_old_arg_one (x,spec,y) = (x,convert_spec_from_old_arg spec,y)
95 let convert_to_old_arg_one (x,spec,y) = (x,convert_spec_to_old_arg spec,y)
96 let convert_to_old_arg l = List.map convert_to_old_arg_one l
97 let convert_from_old_arg l = List.map convert_from_old_arg_one l
98
99 (* stdlib's functions *)
100 let parse p = Arg.parse (convert_to_old_arg p)
101 let parse_argv ?current x p = Arg.parse_argv ?current x (convert_to_old_arg p)
102 let usage p = Arg.usage (convert_to_old_arg p)
103 let align p = convert_from_old_arg (Arg.align (convert_to_old_arg p))
104 let current = Arg.current
105 type key = Arg.key
106 type doc = Arg.doc
107 type usage_msg = Arg.usage_msg
108 type anon_fun = Arg.anon_fun
109 exception Help = Arg.Help
110 exception Bad = Arg.Bad
111
112
113 let sort_by_name l = List.stable_sort (fun (x,_,_) (y,_,_) -> compare (x:string) y) l
114 let sort l = (* also makes names unique *)
115 let rec aux acc = function
116 | [] -> List.rev acc
117 | [x] -> List.rev (x :: acc)
118 | ((s1,_,_) as v1) :: ((s2,_,_) :: tl2 as tl) ->
119 if s1 = s2 then (
120 if (try (Sys.getenv "MLSTATE_TESTING") = "0" with Not_found -> true) then
121 Printf.eprintf "Internal warning: The option %s is matched several times in the command line parser.\n%!" s1;
122 (* cannot call omanager from here, nor debugVariables *)
123 aux acc (v1 :: tl2) (* keeping the first one in the list *)
124 ) else
125 aux (v1 :: acc) tl in
126 aux [] (sort_by_name l)
127
128 let merge ({params = l1; stop = b1} as left) {params = l2; stop = b2} =
129 if b1 then left else {params = l1 @ l2; stop = b1 || b2}
130
131 let rec convert_spec = function
132 | Bool _ -> {params = [Oneof ["true";"false"]]; stop = false} (* possibly case insensitive ? *)
133 | Unit _
134 | Set _
135 | Clear _ -> {params = []; stop = false} (* nothing follows *)
136 | String _
137 | Set_string _
138 | Int _
139 | Set_int _
140 | Float _
141 | Set_float _ -> {params = [Nothing]; stop = false} (* no completion possible *)
142 | Tuple specs ->
143 let l = List.map convert_spec specs in
144 List.fold_left merge {params = []; stop = false} l
145 | Symbol (sl,_) -> {params = [Oneof sl]; stop = false}
146 | Rest _ -> {params = []; stop = true}
147 | Complete (_,comp) -> comp
148 let convert_one (key,spec,_) =
149 (key, convert_spec spec)
150 let convert parse =
151 let completion = List.map convert_one parse in
152 List.fold_left (fun completion builtin_option ->
153 if List.mem_assoc builtin_option completion then
154 completion
155 else
156 (builtin_option,{params = []; stop = false}) :: completion) completion ["-help";"--help"]
157
158 let stringify_simple_completion = function
159 | Nothing -> "COMPREPLY=()"
160 | File pattern -> Printf.sprintf "_filedir %s" pattern
161 | Dir -> "_filedir -d"
162 | Oneof sl -> Printf.sprintf "COMPREPLY=($(compgen -W '%s' -- ${cur}))" (String.concat " " sl)
163 let stringify_completion (k,l) =
164 if l = [] then
165 ""
166 else
167 let main,_ =
168 List.fold_left (fun (acc,i) sc ->
169 let acc =
170 if i = 0 then acc ^ Printf.sprintf "
171 if [ \"$n\" -eq %d ]; then
172 %s" (i+1) (stringify_simple_completion sc)
173 else acc ^ Printf.sprintf "
174 elif [ \"$n\" -eq %d ]; then
175 %s" (i+1) (stringify_simple_completion sc) in
176 acc,(i+1)
177 ) ("",0) l in
178 Printf.sprintf "
179 %s)%s
180 else
181 did_something=0
182 fi;;" k main
183
184 (* making sure we have only letters in the name, to avoid function containing wierd chars
185 * (like '/') *)
186 let remove_illegal_chars s =
187 "prefix" ^ Str.global_replace (Str.regexp "[^a-zA-Z]") "" s
188
189 let stringify ?name ?(names=[]) ?(default=File "*") l =
190 let one_name,names =
191 match name,names with
192 | None, [] -> Sys.argv.(0), [Filename.basename Sys.argv.(0)]
193 | None, (h :: _ as l) -> h, l
194 | Some v, l -> v, v :: l in
195 let one_name = remove_illegal_chars one_name in
196 let stops = List.map fst (List.filter (fun (_,{params=_; stop = b}) -> b) l) in
197 let prologue = Printf.sprintf "\
198 # this file was generated by Base.Arg.add_bash_completion
199 # do not modify by hand
200
201 shopt -s extglob
202
203 _%s() {
204 COMPREPLY=()
205 local cur=`_get_cword`
206 " one_name in
207 let check_stop = Printf.sprintf "
208 local latest_minus=$COMP_CWORD
209 local stop=(%s)
210
211 for (( i = 0; i < $COMP_CWORD; i ++ )); do
212 for j in \"${stop[@]}\"; do
213 [ \"${COMP_WORDS[i]}\" = \"$j\" ] && return 0
214 done
215 [[ \"${COMP_WORDS[i]}\" =~ -.* ]] && latest_minus=$i
216 done
217
218 local n=$(( COMP_CWORD - latest_minus ))
219 " (String.concat " " stops) in
220 let complete = Printf.sprintf "
221 local did_something=0
222 if [ \"$n\" -gt 0 ]; then
223 did_something=1
224 case ${COMP_WORDS[latest_minus]} in%s
225 *) did_something=0;;
226 esac
227 fi
228 " (String.concat "" (List.map (fun (k,{params=l;stop=_}) -> stringify_completion (k,l)) l)) in
229 let default_completion = Printf.sprintf "
230 if [ $did_something -eq 0 ]; then
231 case ${cur} in
232 -*) COMPREPLY=($(compgen -W '%s' -- ${cur}));;
233 *) %s;;
234 esac
235 fi
236 " (String.concat " " (List.map fst l))
237 (stringify_simple_completion default) in
238 let epilogue = Printf.sprintf "\
239 }
240
241 complete -F _%s -o filenames %s
242 " one_name (String.concat " " names) in
243 prologue ^ check_stop ^ complete ^ default_completion ^ epilogue
244
245 let generate ?name ?names ?default args =
246 let completion = convert args in
247 let s = stringify ?name ?names ?default completion in
248 let c = open_out "bash_completion" in
249 output_string c s;
250 close_out c
251
252 let rec add_bash_completion ?name ?names ?default args =
253 let rec new_args =
254 ("--bash-completion",
255 Unit (fun () -> generate ?name ?names ?default new_args; exit 0),
256 " Dumps a bash completion in ./bash_completion") :: args in
257 new_args
258
259 let split s = String.split (fun c -> List.mem c [' '; ','; ';']) s
Something went wrong with that request. Please try again.