Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix VT100 support (again) #4710

Merged
merged 1 commit into from
Jun 11, 2021
Merged

Fix VT100 support (again) #4710

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion master_changes.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -178,7 +178,7 @@ New option/command/subcommand are prefixed with ◈.
* Fix `opam exec` on native Windows when calling cygwin executables [#4588 @AltGr]
* Fix temporary file with a too long name causing errors on Windows [#4590 @AltGr]
* CLI: Add flag deprecation and replacement helper [#4595 @rjbou]
* Win32 Console: fix VT100 support [#3897 @dra27]
* Win32 Console: fix VT100 support [#3897 #4710 @dra27]
* Tidied the opam files [#4620 @dra27]
* Externalise cli versioning tools from `OpamArg` into `OpamArgTools` [#4606 @rjbou]
* Each library defines its own environment variables, that fills the config record [#4606 @rjbou]
Expand Down
51 changes: 28 additions & 23 deletions src/core/opamConsole.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -236,41 +236,45 @@ let acolor_w width c f s =
type win32_color_mode = Shim | VT100 of (unit -> unit)

type _ shim_return =
| Handle : (OpamStubs.handle * win32_color_mode) shim_return
| Handle : (OpamStubs.stdhandle * win32_color_mode) shim_return
| Mode : win32_color_mode shim_return
| Peek : bool shim_return

let force_win32_vt100 hConsoleOutput () =
let mode = OpamStubs.getConsoleMode hConsoleOutput in
(* ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x4 *)
let vt100_on = 0x4 in
if mode land vt100_on = 0 then
OpamStubs.setConsoleMode hConsoleOutput (mode lor vt100_on) |> ignore
let force_win32_vt100 handle () =
try
let hConsoleOutput = OpamStubs.getStdHandle handle in
let mode = OpamStubs.getConsoleMode hConsoleOutput in
(* ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x4 *)
let vt100_on = 0x4 in
if mode land vt100_on = 0 then
OpamStubs.setConsoleMode hConsoleOutput (mode lor vt100_on) |> ignore
with Not_found -> ()

let enable_win32_vt100 ch =
let hConsoleOutput =
OpamStubs.getStdHandle ch
in
try
let hConsoleOutput = OpamStubs.getStdHandle ch in
let mode = OpamStubs.getConsoleMode hConsoleOutput in
(* ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x4 *)
let vt100_on = 0x4 in
if mode land vt100_on <> 0 then
(hConsoleOutput, VT100(force_win32_vt100 hConsoleOutput))
(ch, VT100(force_win32_vt100 ch))
else
if OpamStubs.setConsoleMode hConsoleOutput (mode lor vt100_on) then begin
let restore_console () =
let mode =
OpamStubs.getConsoleMode hConsoleOutput land (lnot vt100_on)
in
OpamStubs.setConsoleMode hConsoleOutput mode |> ignore
try
let hConsoleOutput = OpamStubs.getStdHandle ch in
let mode =
OpamStubs.getConsoleMode hConsoleOutput land (lnot vt100_on)
in
OpamStubs.setConsoleMode hConsoleOutput mode |> ignore
with Not_found -> ()
in
at_exit restore_console;
(hConsoleOutput, VT100(force_win32_vt100 hConsoleOutput))
(ch, VT100(force_win32_vt100 ch))
end else
(hConsoleOutput, Shim)
(ch, Shim)
with Not_found ->
(hConsoleOutput, VT100 ignore)
(ch, VT100 ignore)

let stdout_state = lazy (enable_win32_vt100 OpamStubs.STD_OUTPUT_HANDLE)
let stderr_state = lazy (enable_win32_vt100 OpamStubs.STD_ERROR_HANDLE)
Expand Down Expand Up @@ -324,13 +328,14 @@ let win32_print_message ch msg =
if get_win32_console_shim ch Peek then
Printf.fprintf ocaml_ch "%s%!" msg
else
let (hConsoleOutput, mode) = get_win32_console_shim ch Handle in
let (ch, mode) = get_win32_console_shim ch Handle in
match mode with
| VT100 force ->
force ();
output_string ocaml_ch msg;
flush ocaml_ch
| Shim ->
let hConsoleOutput = OpamStubs.getStdHandle ch in
let {OpamStubs.attributes; _} =
OpamStubs.getConsoleScreenBufferInfo hConsoleOutput
in
Expand Down Expand Up @@ -428,15 +433,15 @@ let carriage_delete_unix _ =
print_string "\r\027[K"

let carriage_delete_windows () =
let (hConsoleOutput, mode) = get_win32_console_shim `stdout Handle in
match mode with
| Shim ->
match get_win32_console_shim `stdout Handle with
| (ch, Shim) ->
let hConsoleOutput = OpamStubs.getStdHandle ch in
let {OpamStubs.size = (w, _); cursorPosition = (_, row); _} =
OpamStubs.getConsoleScreenBufferInfo hConsoleOutput in
Printf.printf "\r%!";
OpamStubs.fillConsoleOutputCharacter hConsoleOutput '\000' w (0, row)
|> ignore
| VT100 force ->
| (_, VT100 force) ->
force ();
carriage_delete_unix ()

Expand Down