Source file config.ml

open! Oxbow_core
open! Oxbow_layout
include Types.Config

let default_tiling () =
  Params.Tiling.{ scheme = Even; mfact = 0.55; nmaster = 1; dir = Left }
;;

let default_scrolling () =
  Params.Scrolling.
    { align = Visible; default_width = Width_fac.of_float 0.5; offset = 0; dir = Left }
;;

let default_floating () = Params.Floating.{ seed = Pct 50. }
let default_gaps () = Params.Gaps.{ inner = 10; outer = 20 }
let default_overview_gaps = 10

let default_borders () =
  Border.
    { width = 4l
    ; focused = Color.of_string_exn "#7FB4CA"
    ; unfocused = Color.of_string_exn "#727169"
    ; urgent = Color.of_string_exn "#FF5D62"
    ; swallowing = Color.of_string_exn "#98BB6C"
    ; captured = Color.of_string_exn "#957FB8"
    }
;;

let create_tag_data () =
  Data.
    { layout = Tiling
    ; tiling = default_tiling ()
    ; scrolling = default_scrolling ()
    ; floating = default_floating ()
    ; gaps = default_gaps ()
    }
;;

let default () =
  { default_tag_config = create_tag_data ()
  ; default_overview_gaps
  ; borders = default_borders ()
  ; cursor_theme = None
  ; modkey = Wire.Modifiers.mod4
  ; rules = { window = []; input = [] }
  ; spawn = { position = Master; focus = true }
  ; modes = [ Mode.normal; Mode.locked ]
  ; focus_follows_pointer = Not_scrolling
  ; warp_on_focus = false
  ; drag_retile = false
  ; repeat_rate = 50
  ; repeat_delay = 250
  }
;;

let set_focus_follows_pointer (wm : Types.Wm.t) policy =
  wm.config.focus_follows_pointer <- policy
;;

let set_warp_on_focus (wm : Types.Wm.t) warp_on_focus =
  wm.config.warp_on_focus <- warp_on_focus
;;

let set_drag_retile (wm : Types.Wm.t) b = wm.config.drag_retile <- b

let set_border_width (wm : Types.Wm.t) width =
  if width < 0l
  then Error "border width cannot be negative"
  else (
    wm.config.borders.width <- width;
    Schedule.manage ();
    Ok None)
;;

let set_cursor_theme (wm : Types.Wm.t) cursor_theme =
  wm.config.cursor_theme <- cursor_theme
;;

let set_key_repeat (wm : Types.Wm.t) ~rate ~delay =
  wm.config.repeat_rate <- rate;
  wm.config.repeat_delay <- delay
;;

let set_border_color (wm : Types.Wm.t) (border : Border_target.t) color =
  Schedule.manage ();
  match border with
  | Urgent -> wm.config.borders.urgent <- color
  | Focused -> wm.config.borders.focused <- color
  | Unfocused -> wm.config.borders.unfocused <- color
  | Swallowing -> wm.config.borders.swallowing <- color
  | Captured -> wm.config.borders.captured <- color
;;

let set_default_width (td : Data.t) ~delta =
  let f =
    Delta.resolve
      ~add:( +. )
      ~current:(Width_fac.to_float td.scrolling.default_width)
      delta
  in
  td.scrolling.default_width <- Width_fac.of_float f
;;

let set_float_seed (td : Data.t) ~seed = td.floating.seed <- seed
let set_spawn_position (wm : Types.Wm.t) position = wm.config.spawn.position <- position
let set_spawn_focus (wm : Types.Wm.t) b = wm.config.spawn.focus <- b

let copy_tag_data (td : Data.t) =
  Data.
    { layout = td.layout
    ; tiling =
        { scheme = td.tiling.scheme
        ; mfact = td.tiling.mfact
        ; nmaster = td.tiling.nmaster
        ; dir = td.tiling.dir
        }
    ; scrolling =
        { align = td.scrolling.align
        ; default_width = td.scrolling.default_width
        ; offset = td.scrolling.offset
        ; dir = td.scrolling.dir
        }
    ; floating = { seed = td.floating.seed }
    ; gaps = { inner = td.gaps.inner; outer = td.gaps.outer }
    }
;;

let reset_data (data : Data.t) =
  let d = create_tag_data () in
  data.layout <- d.layout;
  data.tiling.scheme <- d.tiling.scheme;
  data.tiling.mfact <- d.tiling.mfact;
  data.tiling.nmaster <- d.tiling.nmaster;
  data.tiling.dir <- d.tiling.dir;
  data.scrolling.align <- d.scrolling.align;
  data.scrolling.default_width <- d.scrolling.default_width;
  data.scrolling.offset <- d.scrolling.offset;
  data.scrolling.dir <- d.scrolling.dir;
  data.floating.seed <- d.floating.seed;
  data.gaps.inner <- d.gaps.inner;
  data.gaps.outer <- d.gaps.outer
;;

let reset (wm : Types.Wm.t) ~all =
  let d = default () in
  reset_data wm.config.default_tag_config;
  wm.config.default_overview_gaps <- d.default_overview_gaps;
  wm.config.borders.width <- d.borders.width;
  wm.config.borders.focused <- d.borders.focused;
  wm.config.borders.unfocused <- d.borders.unfocused;
  wm.config.borders.urgent <- d.borders.urgent;
  wm.config.borders.swallowing <- d.borders.swallowing;
  wm.config.borders.captured <- d.borders.captured;
  wm.config.cursor_theme <- d.cursor_theme;
  wm.config.modkey <- d.modkey;
  wm.config.spawn.position <- d.spawn.position;
  wm.config.spawn.focus <- d.spawn.focus;
  wm.config.focus_follows_pointer <- d.focus_follows_pointer;
  wm.config.warp_on_focus <- d.warp_on_focus;
  wm.config.drag_retile <- d.drag_retile;
  wm.config.repeat_rate <- d.repeat_rate;
  wm.config.repeat_delay <- d.repeat_delay;
  List.iter
    (fun (o : Types.Output.t) ->
       Oxbow_core.Tag.Table.iter reset_data o.tag_data;
       o.overview.gaps <- d.default_overview_gaps)
    wm.outputs;
  if all
  then (
    wm.config.rules.window <- [];
    wm.config.rules.input <- [];
    wm.config.modes <- (default ()).modes;
    List.iter (fun (o : Types.Output.t) -> o.labels <- []) wm.outputs;
    List.iter (fun (w : Types.Window.t) -> w.labels <- []) wm.windows)
;;

let add_window_rule (wm : Types.Wm.t) rule =
  wm.config.rules.window <- wm.config.rules.window @ [ rule ]
;;

let remove_window_rule (wm : Types.Wm.t) index =
  wm.config.rules.window <- List.filteri (fun i _ -> i <> index) wm.config.rules.window
;;

let replace_window_rule (wm : Types.Wm.t) (rule : Window_rule.t) =
  wm.config.rules.window
  <- List.map
       (fun (r : Window_rule.t) ->
          if Window_pattern.equal rule.pattern r.pattern then rule else r)
       wm.config.rules.window
;;

let add_input_rule (wm : Types.Wm.t) rule =
  wm.config.rules.input <- wm.config.rules.input @ [ rule ]
;;

let remove_input_rule (wm : Types.Wm.t) index =
  wm.config.rules.input <- List.filteri (fun i _ -> i <> index) wm.config.rules.input
;;

let replace_input_rule (wm : Types.Wm.t) (rule : Input_rule.t) =
  wm.config.rules.input
  <- List.map
       (fun (r : Input_rule.t) -> if Input_rule.equal r rule then rule else r)
       wm.config.rules.input
;;

let declare_mode (wm : Types.Wm.t) name = wm.config.modes <- wm.config.modes @ [ name ]

let remove_rules (wm : Types.Wm.t) kind indices =
  let length, remove, repr =
    match kind with
    | `Window -> List.length wm.config.rules.window, remove_window_rule, "window"
    | `Input -> List.length wm.config.rules.input, remove_input_rule, "input"
  in
  let in_bounds, out_of_bounds = List.partition (fun i -> i >= 0 && i < length) indices in
  if out_of_bounds <> []
  then (
    let msg =
      let prefix =
        if List.length out_of_bounds > 1
        then Printf.sprintf "no %s rule at the given indices " repr
        else Printf.sprintf "no %s rule at the given index " repr
      in
      prefix ^ (List.map string_of_int out_of_bounds |> String.concat ",")
    in
    Error msg)
  else (
    List.sort_uniq Int.compare in_bounds |> List.rev |> List.iter (remove wm);
    Ok None)
;;

let apply_default_overview_gaps (wm : Types.Wm.t) ~delta =
  let gaps = Delta.resolve ~add:( + ) ~current:wm.config.default_overview_gaps delta in
  wm.config.default_overview_gaps <- max 0 gaps
;;