diff --git a/src/kernel_services/cmdline_parameters/cmdline.ml b/src/kernel_services/cmdline_parameters/cmdline.ml index 5a166f93f07e86f6225bc60ab3f9edc10a7d8f23..edd97c2c8a3d0bcfe8f3afd8c4014c74739f91bb 100644 --- a/src/kernel_services/cmdline_parameters/cmdline.ml +++ b/src/kernel_services/cmdline_parameters/cmdline.ml @@ -1072,6 +1072,53 @@ let list_all_plugin_options ~print_invisible = end; raise Exit +(* ************************************************************************* *) +(** {3 Explain} + + Special processing for option "-explain" *) +(* ************************************************************************* *) + +let print_help_for_options option_names = + let messages_to_print = Hashtbl.create 5 in + let option_names = + List.filter (fun o -> o <> "-explain") option_names + in + Log.print_on_output + begin fun fmt -> + List.iter (fun plugin -> + Hashtbl.iter + (fun _gname opts -> + List.iter (fun o -> + if List.mem o.oname option_names then + Hashtbl.replace messages_to_print o.oname (o.argname, o.ohelp) + ) !opts + ) plugin.Plugin.groups + ) (Plugin.all_plugins ()); + Format.fprintf fmt + "[kernel] Explaining command-line options:@."; + List.iter (fun opt_name -> + let (helparg, help) = Hashtbl.find messages_to_print opt_name in + Format.fprintf fmt "@[<v>%s%s@\n %s@]@." opt_name + (if helparg <> "" then " " ^ helparg else helparg) help + ) option_names; + end; + raise Exit + +(* [option_re] allows matching an option and extracting its name, + even when there is a '=', e.g. "-kernel-msg-key=-typing". + It also prevents matching negative numbers, as in "-ulevel -1". *) +let option_re = Str.regexp "-\\([a-zA-Z-][a-zA-Z0-9-]*\\)" +let explain_cmdline () = + let option_names = + List.fold_left (fun acc opt -> + if Str.string_match option_re opt 0 then + let opt_name = Str.matched_string opt in + opt_name :: acc + else acc + ) [] all_options + in + print_help_for_options (List.rev option_names) + (* Local Variables: compile-command: "make -C ../../.." diff --git a/src/kernel_services/cmdline_parameters/cmdline.mli b/src/kernel_services/cmdline_parameters/cmdline.mli index 1d25f445994d2949941459347f478b4c30670d55..db33fb745847cabe9fa7b88dc972026eb8f64eaa 100644 --- a/src/kernel_services/cmdline_parameters/cmdline.mli +++ b/src/kernel_services/cmdline_parameters/cmdline.mli @@ -244,6 +244,8 @@ val list_plugins: unit -> exit @since Phosphorus-20170501-beta1 *) val list_all_plugin_options : print_invisible:bool -> exit +val explain_cmdline : unit -> exit + val plugin_help: string -> exit (** Display the help of the given plug-in (given by its shortname). @since Beryllium-20090601-beta1 *) diff --git a/src/kernel_services/plugin_entry_points/kernel.ml b/src/kernel_services/plugin_entry_points/kernel.ml index 1590e44022fb7b4c9423c25c5137d9f268c5ea17..6e898e102873e5d7050a32f0b0eae1c176fdb816 100644 --- a/src/kernel_services/plugin_entry_points/kernel.ml +++ b/src/kernel_services/plugin_entry_points/kernel.ml @@ -429,6 +429,26 @@ let run_list_all_plugin_options () = else Cmdline.nop let () = Cmdline.run_after_exiting_stage run_list_all_plugin_options +let () = Parameter_customize.set_group help +let () = Parameter_customize.set_cmdline_stage Cmdline.Exiting +let () = Parameter_customize.do_not_journalize () +let () = Parameter_customize.set_negative_option_name "" +module Explain = + False + (struct + let option_name = "-explain" + let help = "prints the help message for each option given in the \ + command line" + let module_name = "Explain" + end) + +let () = + Cmdline.run_after_exiting_stage (fun () -> + if Explain.get () then Cmdline.explain_cmdline () + else Cmdline.nop) +(* This option is processed in a special manner in [Cmdline]. + Nothing to be done here. *) + (* ************************************************************************* *) (** {2 Output Messages} *) (* ************************************************************************* *)