(*

Module: Xorg

 Parses /etc/X11/xorg.conf

Authors: Raphael Pinson <raphink@gmail.com>

         Matthew Booth <mbooth@redhat.com>

About: Reference

 This lens tries to keep as close as possible to `man xorg.conf` where

 possible.

The definitions from `man xorg.conf` are put as commentaries for reference

throughout the file. More information can be found in the manual.

About: License

  This file is licensed under the GPL.

About: Lens Usage

  Sample usage of this lens in augtool

    * Get the identifier of the devices with a "Clone" option:

      > match "/files/etc/X11/xorg.conf/Device[Option = 'Clone']/Identifier"

About: Configuration files

  This lens applies to /etc/X11/xorg.conf. See <filter>.

*)

module Xorg =

  autoload xfm

(************************************************************************

 * Group:                 USEFUL PRIMITIVES

 *************************************************************************)

(* Group: Generic primitives *)

(* Variable: eol *)

let eol     = Util.eol

(* Variable: to_eol

 * Match everything from here to eol, cropping whitespace at both ends

 *)

let to_eol  = /[^ \t\n](.*[^ \t\n])?/

(* Variable: indent *)

let indent  = Util.indent

(* Variable: comment *)

let comment = Util.comment

(* Variable: empty *)

let empty   = Util.empty

(* Group: Separators *)

(* Variable: sep_spc *)

let sep_spc = Util.del_ws_spc

(* Variable: sep_dquote *)

let sep_dquote  = Util.del_str "\""

(* Group: Fields and values *)

(* Variable: entries_re

 * This is a list of all patterns which have specific handlers, and should

 * therefore not be matched by the generic handler

 *)

let entries_re  = /([oO]ption|[sS]creen|[iI]nput[dD]evice|[dD]river|[sS]ub[sS]ection|[dD]isplay|[iI]dentifier|[vV]ideo[rR]am|[dD]efault[dD]epth|[dD]evice)/

(* Variable: generic_entry_re *)

let generic_entry_re = /[^# \t\n\/]+/ - entries_re

(* Variable: quoted_string_val *)

let quoted_string_val = del "\"" "\"" . store /[^"\n]+/ . del "\"" "\""

                                              (* " relax, emacs *)

(* Variable: int *)

let int = /[0-9]+/

(************************************************************************

 * Group:                          ENTRIES AND OPTIONS

 *************************************************************************)

(* View: entry_int

 * This matches an entry which takes a single integer for an argument

 *)

let entry_int (canon:string) (re:regexp) =

        [ indent . del re canon . label canon . sep_spc . store int . eol ]

(* View: entry_rgb

 * This matches an entry which takes 3 integers as arguments representing red,

 * green and blue components

 *)

let entry_rgb (canon:string) (re:regexp) =

        [ indent . del re canon . label canon

          . [ label "red"   . sep_spc . store int ]

          . [ label "green" . sep_spc . store int ]

          . [ label "blue"  . sep_spc . store int ]

          . eol ]

(* View: entry_xy

 * This matches an entry which takes 2 integers as arguments representing X and

 * Y coordinates

 *)

let entry_xy (canon:string) (re:regexp) =

        [ indent . del re canon . label canon

          . [ label "x" . sep_spc . store int ]

          . [ label "y" . sep_spc . store int ]

          . eol ]

(* View: entry_str

 * This matches an entry which takes a single quoted string

 *)

let entry_str (canon:string) (re:regexp) =

        [ indent . del re canon . label canon

          . sep_spc . quoted_string_val . eol ]

(* View: entry_generic

 * An entry without a specific handler. Store everything after the keyword,

 * cropping whitespace at both ends.

 *)

let entry_generic  = [ indent . key generic_entry_re

                       . sep_spc . store to_eol . eol ]

(* View: option *)

let option = [ indent . del /[oO]ption/ "Option" . label "Option" . sep_spc

               . quoted_string_val

               . [ label "value" . sep_spc . quoted_string_val ]*

               . eol ]

(* View: screen

 * The Screen entry of ServerLayout

 *)

let screen = [ indent . del /[sS]creen/ "Screen" . label "Screen" . sep_spc

               . [ label "num" . store int . sep_spc ]?

               . quoted_string_val . sep_spc

               . [ label "position" . store to_eol ]

               . eol ]

(* View: input_device *)

let input_device = [ indent . del /[iI]nput[dD]evice/ "InputDevice"

                     . label "InputDevice" . sep_spc . quoted_string_val

                     . [ label "option" . sep_spc . quoted_string_val ]*

                     . eol ]

(* View: driver *)

let driver = entry_str "Driver" /[dD]river/

(* View: identifier *)

let identifier = entry_str "Identifier" /[iI]dentifier/

(* View: videoram *)

let videoram = entry_int "VideoRam" /[vV]ideo[rR]am/

(* View: default_depth *)

let default_depth = entry_int "DefaultDepth" /[dD]efault[dD]epth/

(* View: device *)

let device = entry_str "Device" /[dD]evice/

(************************************************************************

 * Group:                          DISPLAY SUBSECTION

 *************************************************************************)

(* View: display_modes *)

let display_modes = [ indent . del /[mM]odes/ "Modes" . label "Modes"

                      . [ label "mode" . sep_spc . quoted_string_val ]+

                      . eol ]

(*************************************************************************

 * View: display_entry

 *   Known values for entries in the Display subsection

 *

 *   Definition:

 *     > Depth    depth

 *     > FbBpp    bpp

 *     > Weight   red-weight green-weight blue-weight

 *     > Virtual  xdim ydim

 *     > ViewPort x0 y0

 *     > Modes    "mode-name" ...

 *     > Visual   "visual-name"

 *     > Black    red green blue

 *     > White    red green blue

 *     > Options

 *)

let display_entry = entry_int "Depth"    /[dD]epth/ |

                    entry_int "FbBpp"    /[fF]b[bB]pp/ |

                    entry_rgb "Weight"   /[wW]eight/ |

                    entry_xy  "Virtual"  /[vV]irtual/ |

                    entry_xy  "ViewPort" /[vV]iew[pP]ort/ |

                    display_modes |

                    entry_str "Visual"   /[vV]isual/ |

                    entry_rgb "Black"    /[bB]lack/ |

                    entry_rgb "White"    /[wW]hite/ |

                    entry_str "Options"  /[oO]ptions/ |

                    empty |

                    comment

(* View: display *)

let display = [ indent . del "SubSection" "SubSection" . sep_spc

                       . sep_dquote . key "Display" . sep_dquote

                       . eol

                       . display_entry*

                       . indent . del "EndSubSection" "EndSubSection" . eol ]

(************************************************************************

 * Group:                       SECTIONS

 *************************************************************************)

(************************************************************************

 * Variable: section_re

 *   Known values for Section names

 *

 *   Definition:

 *     >   The section names are:

 *     >

 *     >   Files          File pathnames

 *     >   ServerFlags    Server flags

 *     >   Module         Dynamic module loading

 *     >   InputDevice    Input device description

 *     >   Device         Graphics device description

 *     >   VideoAdaptor   Xv video adaptor description

 *     >   Monitor        Monitor description

 *     >   Modes          Video modes descriptions

 *     >   Screen         Screen configuration

 *     >   ServerLayout   Overall layout

 *     >   DRI            DRI-specific configuration

 *     >   Vendor         Vendor-specific configuration

 *************************************************************************)

let section_re = /(Files|ServerFlags|Module|InputDevice|Device|VideoAdaptor|Monitor|Modes|Screen|ServerLayout|DRI|Vendor)/

(************************************************************************

 * Variable: secton_re_obsolete

 *   The  following obsolete section names are still recognised for

 *   compatibility purposes.  In new config files, the InputDevice

 *   section should be used instead.

 *

 *   Definition:

 *     >  Keyboard       Keyboard configuration

 *     >  Pointer        Pointer/mouse configuration

 *************************************************************************)

let section_re_obsolete = /(Keyboard|Pointer)/

(* View: section_entry *)

let section_entry = option |

                    screen |

                    display |

                    input_device |

                    driver |

                    identifier |

                    videoram |

                    default_depth |

                    device |

                    entry_generic |

                    empty | comment

(************************************************************************

 * View: section

 *   A section in xorg.conf

 *

 *   Definition:

 *     > Section  "SectionName"

 *     >    SectionEntry

 *     >    ...

 *     > EndSection

 *************************************************************************)

let section = [ indent . del "Section" "Section"

                       . sep_spc . sep_dquote

                       . key (section_re|section_re_obsolete) . sep_dquote

                       . eol

                .  section_entry*

                . indent . del "EndSection" "EndSection" . eol ]

(*

 * View: lns

 *   The xorg.conf lens

 *)

let lns = ( empty | comment | section )*

(* Variable: filter *)

let filter = (incl "/etc/X11/xorg.conf")

let xfm = transform lns filter