Merge pull request #773 from aplaice/broken_links_doc

Fix some more broken inter-module docs links
This commit is contained in:
Tony Zorman 2022-11-02 15:50:32 +01:00 committed by GitHub
commit e0d1f177ea
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
35 changed files with 68 additions and 70 deletions

View File

@ -43,8 +43,8 @@ import XMonad.Util.Types
-- > , ((modm, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
--
-- Using "XMonad.Util.EZConfig" syntax, we can easily build keybindings
-- where @M-<arrow-keys>@ moves the currently focused window and
-- @M-S-<arrow-keys>@ resizes it using 'directionMoveWindow' and
-- where @M-\<arrow-keys\>@ moves the currently focused window and
-- @M-S-\<arrow-keys\>@ resizes it using 'directionMoveWindow' and
-- 'directionResizeWindow':
--
-- > [ ("M-" <> m <> k, withFocused $ f i)

View File

@ -12,7 +12,7 @@
-- Adds actions for minimizing and maximizing windows
--
-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your
-- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from
-- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from
-- this module
--
-- Possible keybindings:

View File

@ -75,7 +75,7 @@ getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Re
getScreenIdAndRectangle screen = (W.screen screen, rect) where
rect = screenRect $ W.screenDetail screen
-- | Translate a physical screen index to a "ScreenId"
-- | Translate a physical screen index to a 'ScreenId'
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
let screens = W.current w : W.visible w

View File

@ -44,7 +44,7 @@ import XMonad.Util.EZConfig (readKeySequence)
{- $usage
This module implements Emacs-style prefix argument. The argument
comes in two flavours, "Raw" and "Numeric".
comes in two flavours, 'Raw' and 'Numeric'.
To initiate the "prefix mode" you hit the prefix keybinding (default
C-u). This sets the Raw argument value to 1. Repeatedly hitting this
@ -72,7 +72,7 @@ Binding it in your config
> ((modm, xK_a), withPrefixArgument addMaybeClean)
Hitting MOD-a will add the <file> to the playlist while C-u MOD-a will
Hitting MOD-a will add the @\<file\>@ to the playlist while C-u MOD-a will
clear the playlist and then add the file.
You can of course use an anonymous action, like so:

View File

@ -99,7 +99,7 @@ import Control.Arrow
-- So far floating windows have been treated no differently than tiled windows
-- even though their positions are independent of the stack. Often, yanking
-- floating windows in and out of the workspace will obliterate the stack
-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
-- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is
-- toggled so frequenty and always replaces the master window. That's why the
-- swap functions accept a boolean argument; when @True@ non-focused floating
-- windows will be ignored.

View File

@ -388,7 +388,7 @@ instance RemovableClass MouseBindings [(ButtonMask, Button)] where
MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings
-- | Mouse button bindings to an 'X' actions on a window. Default: see @`man
-- xmonad`@. To make mod-<scrollwheel> switch workspaces:
-- xmonad`@. To make @mod-\<scrollwheel\>@ switch workspaces:
--
-- > import XMonad.Actions.CycleWS (nextWS, prevWS)
-- > ...

View File

@ -96,7 +96,7 @@ import Graphics.X11.Xlib.Extras (Event(..))
--
-- at the top of @myFadeHook@.
--
-- This module is best used with "XMonad.Hooks.MoreManageHelpers", which
-- This module is best used with "XMonad.Hooks.ManageHelpers", which
-- exports a number of Queries that can be used in either @ManageHook@
-- or @FadeHook@.
--
@ -216,7 +216,7 @@ fadeWindowsLogHook h = withWindowSet $ \s -> do
-- | A 'handleEventHook' to handle fading and unfading of newly mapped
-- or unmapped windows; this avoids problems with layouts such as
-- "XMonad.Layout.Full" or "XMonad.Layout.Tabbed". This hook may
-- 'XMonad.Layout.Full' or "XMonad.Layout.Tabbed". This hook may
-- also be useful with "XMonad.Hooks.FadeInactive".
fadeWindowsEventHook :: Event -> X All
fadeWindowsEventHook MapNotifyEvent{} =

View File

@ -212,7 +212,7 @@ import XMonad.Hooks.ManageHelpers (currentWs)
--
-- - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor
-- workspace won't be switched).
-- - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window
-- - I need "XMonad.Hooks.EwmhDesktops" module for enabling window
-- activation.
-- - 'FocusHook' in 'manageHook' will be called /only/ for new windows.
-- - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows.

View File

@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ManageDebug
-- Description : A manageHook and associated logHook for debugging "ManageHooks".
-- Description : A manageHook and associated logHook for debugging ManageHooks.
-- Copyright : (c) Brandon S Allbery KF8NH, 2014
-- License : BSD3-style (see LICENSE)
--
@ -12,7 +12,7 @@
-- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's.
-- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator.
-- Or use @debugManageHookOn@ for a triggerable version, specifying the
-- triggering key sequence in 'XMonad.Util.EZConfig' syntax. Or use the
-- triggering key sequence in "XMonad.Util.EZConfig" syntax. Or use the
-- individual hooks in whatever way you see fit.
--
-----------------------------------------------------------------------------
@ -47,7 +47,7 @@ debugManageHook cf = cf {logHook = manageDebugLogHook <> logHook cf
}
-- | A combinator to add triggerable 'ManageHook' debugging in a single operation.
-- Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press
-- Specify a key sequence as a string in "XMonad.Util.EZConfig" syntax; press
-- this key before opening the window to get just that logged.
debugManageHookOn :: String -> XConfig l -> XConfig l
debugManageHookOn key cf = cf {logHook = manageDebugLogHook <> logHook cf

View File

@ -135,7 +135,7 @@ import XMonad.Util.Parser ( runParser )
-- --< Types >-- {{{
-- | From a list of 'XMonad.Util.EZConfig'-style bindings, generate a
-- | From a list of "XMonad.Util.EZConfig"-style bindings, generate a
-- key representation.
--
-- >>> mkKeysEz [("h", xmessage "Hello, world!")]

View File

@ -12,7 +12,7 @@
-- Sets the WM name to a given string, so that it could be detected using
-- _NET_SUPPORTING_WM_CHECK protocol.
--
-- May be useful for making Java GUI programs work, just set WM name to "LG3D"
-- May be useful for making Java GUI programs work, just set WM name to \"LG3D\"
-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later.
--
-- To your @~\/.xmonad\/xmonad.hs@ file, add the following line:

View File

@ -9,7 +9,7 @@
-- Maintainer : Tony Zorman <soliditsallgood@mailbox.org>
--
-- Flash the names of workspaces name when switching to them. This is a
-- reimplementation of 'XMonad.Layout.ShowWName' as a logHook.
-- reimplementation of "XMonad.Layout.ShowWName" as a logHook.
-----------------------------------------------------------------------------
module XMonad.Hooks.ShowWName (

View File

@ -448,8 +448,8 @@ xmobarRaw :: String -> String
xmobarRaw "" = ""
xmobarRaw s = concat ["<raw=", show $ length s, ":", s, "/>"]
-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
-- the matching tags like </fc>.
-- | Strip xmobar markup, specifically the \<fc\>, \<icon\> and \<action\> tags
-- and the matching tags like \</fc\>.
xmobarStrip :: String -> String
xmobarStrip = converge (xmobarStripTags ["fc","icon","action"])
@ -458,7 +458,7 @@ converge f a = let xs = iterate f a
in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs
xmobarStripTags :: [String] -- ^ tags
-> String -> String -- ^ with all <tag>...</tag> removed
-> String -> String -- ^ with all \<tag\>...\</tag\> removed
xmobarStripTags tags = strip [] where
strip keep [] = keep
strip keep x

View File

@ -242,8 +242,8 @@ data SuppressWhen = Visible -- ^ the window is currently visible
--
-- The interval arguments are in seconds. See the 'minutes' helper.
data RemindWhen = Dont -- ^ triggering once is enough
| Repeatedly Int Interval -- ^ repeat <arg1> times every <arg2> seconds
| Every Interval -- ^ repeat every <arg1> until the urgency hint is cleared
| Repeatedly Int Interval -- ^ repeat \<arg1\> times every \<arg2\> seconds
| Every Interval -- ^ repeat every \<arg1\> until the urgency hint is cleared
deriving (Read, Show)
-- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@.

View File

@ -62,7 +62,7 @@ import System.Posix.Types ( ProcessID )
--
-- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True)
--
-- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layouts.SubLayouts" is used;
-- The variant 'swallowEventHookSub' can be used if a layout from "XMonad.Layout.SubLayouts" is used;
-- instead of swallowing the window it will merge the child window with the parent. (this does not work with floating windows)
--
-- For more information on editing your handleEventHook and key bindings,
@ -98,7 +98,7 @@ handleMapRequestEvent parentQ childQ childWindow action =
return ()
-- | handleEventHook that will merge child windows via
-- "XMonad.Layouts.SubLayouts" when they are opened from another window.
-- "XMonad.Layout.SubLayouts" when they are opened from another window.
swallowEventHookSub
:: Query Bool -- ^ query the parent window has to match for window swallowing to occur.
-- Set this to @return True@ to run swallowing for every parent.

View File

@ -14,7 +14,7 @@
-- Each window is half the height of the previous,
-- except for the last pair of windows.
--
-- Note: Originally based on 'XMonad.Layout.Column' with changes:
-- Note: Originally based on "XMonad.Layout.Column" with changes:
--
-- * Adding/removing windows doesn't resize all other windows.
-- (last window pair exception).

View File

@ -93,7 +93,7 @@ siftUp = sendMessage UpdateBoring >> sendMessage SiftUp
siftDown = sendMessage UpdateBoring >> sendMessage SiftDown
-- | Mark current focused window boring for all layouts.
-- This is useful in combination with the 'XMonad.Actions.CopyWindow' module.
-- This is useful in combination with the "XMonad.Actions.CopyWindow" module.
markBoringEverywhere :: X ()
markBoringEverywhere = withFocused (broadcastMessage . IsBoring)

View File

@ -80,7 +80,7 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
*/* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */**
-- $dpv
-- These combinators combine two layouts using "XMonad.DragPane" in
-- These combinators combine two layouts using "XMonad.Layout.DragPane" in
-- vertical mode.
(*||*),(**||*),(***||*),(****||*), (***||**),(****||***),
@ -100,7 +100,7 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
(*||**) = combineTwo (dragPane Vertical 0.1 (1/3))
-- $dph
-- These combinators combine two layouts using "XMonad.DragPane" in
-- These combinators combine two layouts using "XMonad.Layout.DragPane" in
-- horizontal mode.
(*//*),(**//*),(***//*),(****//*), (***//**),(****//***),

View File

@ -75,7 +75,7 @@ limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a
limitWindows n = ModifiedLayout (LimitWindows FirstN n)
-- | Only display @n@ windows around the focused window. This makes sense with
-- layouts that arrange windows linearily, like 'XMonad.Layout.Layout.Accordion'.
-- layouts that arrange windows linearily, like "XMonad.Layout.Accordion".
limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a
limitSlice n = ModifiedLayout (LimitWindows Slice n)

View File

@ -11,9 +11,9 @@
-- Portability : unportable
--
-- A layout transformer to have a layout respect a given screen
-- geometry. Mostly used with "Decoration" (the Horizontal and the
-- Vertical version will react to SetTheme and change their dimension
-- accordingly.
-- geometry. Mostly used with "XMonad.Layout.Decoration" (the
-- Horizontal and the Vertical version will react to SetTheme and
-- change their dimension accordingly.
-----------------------------------------------------------------------------
module XMonad.Layout.ResizeScreen

View File

@ -16,7 +16,7 @@
-- a main master, which is the original master window;
-- a sub master, the first window of the second pane.
-- This combinator can be nested, and has a good support for using
-- 'XMonad.Layout.Tabbed' as a sublayout.
-- "XMonad.Layout.Tabbed" as a sublayout.
--
-----------------------------------------------------------------------------

View File

@ -97,7 +97,7 @@ notEmpty :: HasCallStack => [a] -> NonEmpty a
notEmpty [] = error "unexpected empty list"
notEmpty (x:xs) = x :| xs
-- | A safe version of 'Graphics.X11.Extras.getWindowAttributes'.
-- | A safe version of 'Graphics.X11.Xlib.Extras.getWindowAttributes'.
safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes)
safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->
xGetWindowAttributes dpy w p >>= \case
@ -199,7 +199,7 @@ regularKeys = map (first (:[]))
allSpecialKeys :: [(String, KeySym)]
allSpecialKeys = functionKeys <> specialKeys <> multimediaKeys
-- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@)
-- | A list pairing function key descriptor strings (e.g. @\"\<F2\>\"@)
-- with the associated KeySyms.
functionKeys :: [(String, KeySym)]
functionKeys = [ ('F' : show n, k)

View File

@ -32,21 +32,21 @@ import qualified Data.List.NonEmpty as NE
-- subsequence is a valid completion; matching is case insensitive. This means
-- that the sequence of typed characters can be obtained from the completion by
-- deleting an appropriate subset of its characters. Example: "spr" matches
-- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the
-- latter: "S.......P.r..........".
-- \"FastSPR\" but also \"SuccinctParallelTrees\" because it's a subsequence of
-- the latter: "S.......P.r..........".
--
-- While this type of inclusiveness is helpful most of the time, it sometimes
-- also produces surprising matches. 'fuzzySort' helps sorting matches by
-- relevance, using a simple heuristic for measuring relevance. The matches are
-- sorted primarily by the length of the substring that contains the query
-- characters and secondarily the starting position of the match. So, if the
-- search string is "spr" and the matches are "FastSPR", "FasterSPR", and
-- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR",
-- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr"
-- within a substring of length 3 ("SPR") while the shortest substring of
-- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length
-- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at
-- position 5 while the match in "FasterSPR" starts at position 7.
-- search string is "spr" and the matches are \"FastSPR\", \"FasterSPR\", and
-- \"SuccinctParallelTrees\", then the order is \"FastSPR\", \"FasterSPR\",
-- \"SuccinctParallelTrees\" because both \"FastSPR\" and \"FasterSPR\" contain
-- "spr" within a substring of length 3 (\"SPR\") while the shortest substring
-- of \"SuccinctParallelTrees\" that matches "spr" is \"SuccinctPar\", which has
-- length 11. \"FastSPR\" is ranked before \"FasterSPR\" because its match
-- starts at position 5 while the match in \"FasterSPR\" starts at position 7.
--
-- To use these functions in an XPrompt, for example, for windowPrompt:
--

View File

@ -88,7 +88,7 @@ manCompl c mans s | s == "" || last s == ' ' = return []
-- | Run a command using shell and return its output.
--
-- XXX Merge into 'XMonad.Util.Run'?
-- XXX Merge into "XMonad.Util.Run"?
--
-- (Ask \"gurus\" whether @evaluate (length ...)@ approach is
-- better\/more idiomatic.)

View File

@ -43,7 +43,7 @@ econst = const . return
-- > , ((modm .|. controlMask, xK_s), sshPrompt def)
--
-- Keep in mind, that if you want to use the completion you have to
-- disable the "HashKnownHosts" option in your ssh_config
-- disable the \"HashKnownHosts\" option in your ssh_config
--
-- For detailed instruction on editing the key binding see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

View File

@ -33,7 +33,7 @@ import Data.List.NonEmpty ((!!), NonEmpty((:|)))
-- $usage
-- You can use this module to implement cycling key-bindings by importing 'XMonad.Util.ActionCycle'
-- You can use this module to implement cycling key-bindings by importing "XMonad.Util.ActionCycle"
--
-- > import XMonad.Util.ActionCycle
--

View File

@ -437,7 +437,7 @@ parseModifier c = (string "M-" $> modMask c)
return $ indexMod (read [n] - 1)
where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]
-- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.
-- | Parse an unmodified basic key, like @\"x\"@, @\"\<F1\>\"@, etc.
parseKey :: Parser KeySym
parseKey = parseSpecial <> parseRegular

View File

@ -9,7 +9,7 @@
-- Stability : unstable
-- Portability : unportable
--
-- 'XMonad.Util.Loggers' for 'XMonad.Util.NamedScratchpad'
-- "XMonad.Util.Loggers" for "XMonad.Util.NamedScratchpad"
--
-----------------------------------------------------------------------------
@ -50,7 +50,7 @@ import qualified XMonad.StackSet as W (allWindows)
-- (This is difficult to change; "minimizing" by moving it back to 'NSP'
-- is even harder.)
-- I hide the 'NamedScratchpad's from the taskbar and use this to track
-- them instead (see 'XMonad.Util.NoTaskbar').
-- them instead (see "XMonad.Util.NoTaskbar").
-- The extension data for tracking NSP windows
newtype NSPTrack = NSPTrack [Maybe Window]

View File

@ -98,7 +98,7 @@ consider the 'ReadP'-based parser
> pLongerSequence = ReadP.char '<' *> ReadP.string "f" <* ReadP.char '>'
> pCombination = pLangle ReadP.+++ pLongerSequence
Parsing the string @"<f>"@ will return
Parsing the string @"\<f\>"@ will return
>>> ReadP.readP_to_S pCombination "<f>"
[("<","f>"),("f","")]

View File

@ -111,9 +111,7 @@ It then all depends on what you want to do:
- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh".
- For an example usage of 'runProcessWithInput' see
"XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu",
"XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions", or
"XMonad.Prompt.WorkspaceDir".
"XMonad.Util.Dmenu", or "XMonad.Prompt.Shell".
- For an example usage of 'runProcessWithInputAndWait' see
"XMonad.Util.Dzen".

View File

@ -9,7 +9,7 @@
-- Stability : unstable
-- Portability : not portable
--
-- A module for spawning a pipe whose "Handle" lives in the Xmonad state.
-- A module for spawning a pipe whose 'Handle' lives in the Xmonad state.
--
-----------------------------------------------------------------------------
@ -55,10 +55,10 @@ newtype NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle }
instance ExtensionClass NamedPipes where
initialValue = NamedPipes Map.empty
-- | When 'spawnNamedPipe' is executed with a command "String" and a name
-- "String" respectively. The command string is spawned with 'spawnPipe' (as
-- long as the name chosen hasn't been used already) and the "Handle" returned
-- is saved in Xmonad's state associated with the name "String".
-- | When 'spawnNamedPipe' is executed with a command 'String' and a name
-- 'String' respectively. The command string is spawned with 'spawnPipe' (as
-- long as the name chosen hasn't been used already) and the 'Handle' returned
-- is saved in Xmonad's state associated with the name 'String'.
spawnNamedPipe :: String -> String -> X ()
spawnNamedPipe cmd name = do
b <- XS.gets (Map.member name . pipeMap)
@ -66,7 +66,7 @@ spawnNamedPipe cmd name = do
h <- spawnPipe cmd
XS.modify (NamedPipes . Map.insert name h . pipeMap)
-- | Attempts to retrieve a "Handle" to a pipe previously stored in Xmonad's
-- | Attempts to retrieve a 'Handle' to a pipe previously stored in Xmonad's
-- state associated with the given string via a call to 'spawnNamedPipe'. If the
-- given string doesn't exist in the map stored in Xmonad's state Nothing is
-- returned.

View File

@ -53,7 +53,7 @@ spawnOnce = doOnce spawn
-- $spawnon
-- These functions combine 'spawnOnce' with their relatives in
-- 'XMonad.Actions.SpawnOn'. You must add 'manageSpawn' to your
-- "XMonad.Actions.SpawnOn". You must add 'manageSpawn' to your
-- @manageHook@ for them to work, as with @SpawnOn@.
-- | Like 'spawnOnce' but launches the application on the given workspace.

View File

@ -26,7 +26,7 @@ import Data.Unique
-- $usage
-- This module can be used to setup a timer to handle deferred events.
-- See 'XMonad.Layout.ShowWName' for an usage example.
-- See "XMonad.Layout.ShowWName" for an usage example.
type TimerId = Int

View File

@ -46,7 +46,7 @@ data Property = Title String
| Or Property Property
| Not Property
| Const Bool
| Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows'
| Tagged String -- ^ Tagged via "XMonad.Actions.TagWindows"
deriving (Read, Show)
infixr 9 `And`
infixr 8 `Or`

View File

@ -33,22 +33,22 @@ import Data.Typeable (typeOf)
--
-- This module have advantage over "XMonad.Actions.TagWindows" in that it
-- hides from you implementation details and provides simple type-safe
-- interface. Main datatype is "StateQuery", which is simple wrapper around
-- "Query", which is instance of MonadState, with 'put' and 'get' are
-- functions to acess data, stored in "Window".
-- interface. Main datatype is 'StateQuery', which is simple wrapper around
-- 'Query', which is instance of MonadState, with 'put' and 'get' are
-- functions to acess data, stored in 'Window'.
--
-- To save some data in window you probably want to do following:
-- > (runStateQuery (put $ Just value) win) :: X ()
-- To retrive it, you can use
-- > (runStateQuery get win) :: X (Maybe YourValueType)
-- "Query" can be promoted to "StateQuery" simply by constructor,
-- 'Query' can be promoted to 'StateQuery' simply by constructor,
-- and reverse is 'getQuery'.
--
-- For example, I use it to have all X applications @russian@ or @dvorak@
-- layout, but emacs have only @us@, to not screw keybindings. Use your
-- imagination!
-- | Wrapper around "Query" with phanom type @s@, representing state, saved in
-- | Wrapper around 'Query' with phantom type @s@, representing state, saved in
-- window.
newtype StateQuery s a = StateQuery {
getQuery :: Query a
@ -57,11 +57,11 @@ newtype StateQuery s a = StateQuery {
packIntoQuery :: (Window -> X a) -> Query a
packIntoQuery = Query . ReaderT
-- | Apply "StateQuery" to "Window".
-- | Apply 'StateQuery' to 'Window'.
runStateQuery :: StateQuery s a -> Window -> X a
runStateQuery = runQuery . getQuery
-- | Lifted to "Query" version of 'catchX'
-- | Lifted to 'Query' version of 'catchX'
catchQuery :: Query a -> Query (Maybe a)
catchQuery q = packIntoQuery $ \win -> userCode $ runQuery q win