diff --git a/CHANGES.md b/CHANGES.md index 0de6c869..5f0d3033 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -92,6 +92,12 @@ in case `lineNavigation` can't find a window. This benefits especially users who use `XMonad.Layout.Spacing`. +* `XMonad.Prompt.OrgMode` + + - Added `orgPromptRefile` and `orgPromptRefileTo` for interactive and + targeted refiling of the entered note into some existing tree of + headings, respectively. + ### Other changes ## 0.17.1 (September 3, 2022) diff --git a/XMonad/Prompt/OrgMode.hs b/XMonad/Prompt/OrgMode.hs index d83eb979..37958ca2 100644 --- a/XMonad/Prompt/OrgMode.hs +++ b/XMonad/Prompt/OrgMode.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} -------------------------------------------------------------------- @@ -23,8 +24,8 @@ -- -- It can be used to quickly save TODOs, NOTEs, and the like with the -- additional capability to schedule/deadline a task, add a priority, --- and use the system's clipboard (really: the primary selection) as the --- contents of the note. +-- refile to some existing heading, and use the system's clipboard +-- (really: the primary selection) as the contents of the note. -- -- A blog post highlighting some features of this module can be found -- . @@ -36,6 +37,8 @@ module XMonad.Prompt.OrgMode ( -- * Prompts orgPrompt, -- :: XPConfig -> String -> FilePath -> X () + orgPromptRefile, -- :: XPConfig -> [String] -> String -> FilePath -> X () + orgPromptRefileTo, -- :: XPConfig -> String -> String -> FilePath -> X () orgPromptPrimary, -- :: XPConfig -> String -> FilePath -> X () -- * Types @@ -56,13 +59,16 @@ module XMonad.Prompt.OrgMode ( import XMonad.Prelude -import XMonad (X, io) -import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt) +import XMonad (X, io, whenJust) +import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPromptWithReturn, mkComplFunFromList, ComplFunction) import XMonad.Util.Parser import XMonad.Util.XSelection (getSelection) +import XMonad.Util.Run +import Control.DeepSeq (deepseq) import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian) -import System.IO (IOMode (AppendMode), hPutStrLn, withFile) +import GHC.Natural (Natural) +import System.IO (IOMode (AppendMode, ReadMode), hClose, hGetContents, openFile, withFile) {- $usage @@ -151,6 +157,26 @@ especially useful when you want to quickly save a URL for later and return to whatever you were doing before. See the 'orgPromptPrimary' prompt for that. +Finally, 'orgPromptRefile' and 'orgPromptRefileTo' provide support to +automatically + +the generated item under a heading of choice. For example, binding + +> orgPromptRefile def ["TODO", "DONE", "SOMEDAY"] "TODO" "todos.org" + +to a key will first pop up an ordinary prompt that works exactly like +'orgPrompt', and then query the user for an already existing heading +(with completions) as provided by the @~/todos.org@ file. If that +prompt is cancelled, the heading will appear in the org file as normal +(i.e., at the end of the file); otherwise, it gets refiled under the +selected heading. + +The second argument to 'orgPromptRefile'—in this case, @["TODO", "DONE", +"SOMEDAY"]@—says which keywords you want to have recognised as todo +keywords. This means that they won't be shown in the prompt when +selecting headings. This should probably be at least close to the value +of @org-todo-keywords@. + -} {- TODO @@ -214,6 +240,76 @@ orgPrompt xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg NoClpSupport orgPromptPrimary :: XPConfig -> String -> FilePath -> X () orgPromptPrimary xpc = (void . mkOrgPrompt xpc =<<) .: mkOrgCfg PrimarySelection +-- | Internal type in order to generate a nice prompt in +-- 'orgPromptRefile' and 'orgPromptRefileTo'. +data RefilePrompt = Refile +instance XPrompt RefilePrompt where + showXPrompt :: RefilePrompt -> String + showXPrompt Refile = "Refile note to: " + +-- | Like 'orgPrompt' (which see for the other arguments), but offer to +-- refile the entered note afterwards. +-- +-- Note that refiling is done by shelling out to Emacs, hence an @emacs@ +-- binary must be in @$PATH@. One may customise this by following the +-- instructions in "XMonad.Util.Run#g:EDSL"; more specifically, by +-- changing the 'XMonad.Util.Run.emacs' field of +-- 'XMonad.Util.Run.ProcessConfig'. +orgPromptRefile + :: XPConfig + -> [String] -- ^ List of strings to be treated as todo keywords. + -- Should reflect the value of @org-todo-keywords@. + -> String + -> FilePath + -> X () +orgPromptRefile xpc todoPrefixes str fp = do + orgCfg <- mkOrgCfg NoClpSupport str fp + + -- NOTE: Ideally we would just use System.IO.readFile' here + -- (especially because it also reads everything strictly), but this is + -- only available starting in base 4.15.x. + fileContents <- io $ do + handle <- openFile (orgFile orgCfg) ReadMode + contents <- hGetContents handle + contents <$ (contents `deepseq` hClose handle) + + -- Save the entry as soon as possible. + notCancelled <- mkOrgPrompt xpc orgCfg + when notCancelled $ + -- If the user didn't cancel, try to parse the org file and offer to + -- refile the entry if possible. + whenJust (runParser (pOrgFile todoPrefixes) fileContents) $ \headings -> + mkXPromptWithReturn Refile xpc (completeHeadings headings) pure >>= \case + Nothing -> pure () + Just parent -> refile parent (orgFile orgCfg) + where + completeHeadings :: [Heading] -> ComplFunction + completeHeadings = mkComplFunFromList xpc . map headingText + +-- | Like 'orgPromptRefile', but with a fixed heading for refiling; no +-- prompt will appear to query for a target. +-- +-- Heading names may omit tags, but generally need to be prefixed by the +-- correct todo keywords; e.g., +-- +-- > orgPromptRefileTo def "PROJECT Work" "TODO" "~/todos.org" +-- +-- Will refile the created note @"TODO "@ to the @"PROJECT Work"@ +-- heading, even with the actual name is @"PROJECT Work +-- :work:other_tags:"@. Just entering @"Work"@ will not work, as Emacs +-- doesn't recognise @"PROJECT"@ as an Org keyword by default (i.e. when +-- started in batch-mode). +orgPromptRefileTo + :: XPConfig + -> String -- ^ Heading to refile the entry under. + -> String + -> FilePath + -> X () +orgPromptRefileTo xpc refileHeading str fp = do + orgCfg <- mkOrgCfg NoClpSupport str fp + notCancelled <- mkOrgPrompt xpc orgCfg + when notCancelled $ refile refileHeading (orgFile orgCfg) + -- | Create the actual prompt. Returns 'False' when the input was -- cancelled by the user (by, for example, pressing @Esc@ or @C-g@) and -- 'True' otherwise. @@ -237,6 +333,27 @@ mkOrgPrompt xpc oc@OrgMode{ todoHeader, orgFile, clpSupport } = <=< maybe (pure "") (ppNote clpStr todoHeader) . pInput $ input +------------------------------------------------------------------------ +-- Refiling + +-- | Let Emacs do the refiling, as this seems—and I know how this +-- sounds—more robust than trying to do it ad-hoc in this module. +refile :: String -> FilePath -> X () +refile parent fp = + proc $ inEmacs + >-> asBatch + >-> eval (progn [ findFile fp + , "end-of-buffer" + , "org-refile nil nil" + <> list [ asString parent + , asString fp + , "nil" + , saveExcursion ["org-find-exact-headline-in-buffer" + <> asString parent] + ] + , "save-buffer" + ]) + ------------------------------------------------------------------------ -- Time @@ -377,7 +494,7 @@ ppNote clp todo = \case otherPrio -> " [#" <> show otherPrio <> "] " ------------------------------------------------------------------------ --- Parsing +-- Note parsing -- | Parse the given string into a 'Note'. pInput :: String -> Maybe Note @@ -487,3 +604,40 @@ pNumBetween lo hi = do n <- num n <$ guard (n >= lo && n <= hi) +------------------------------------------------------------------------ +-- File parsing + +data Heading = Heading + { level :: Natural + -- ^ Level of the Org heading; i.e., the number of leading stars. + , todoType :: String + -- ^ Type of the Org heading. This is some todo keyword used as a + -- prefix to mark the heading as such. + , headingText :: String + -- ^ The heading text without its level and prefix keyword. + } + +-- | Naïvely parse an Org file. At this point, only the headings are +-- parsed into a non-nested list (ignoring parent-child relations); no +-- further analysis is done on the individual lines themselves. +pOrgFile :: [String] -> Parser [Heading] +pOrgFile = many . pHeading + +pHeading :: [String] -> Parser Heading +pHeading todoPrefixes = skipSpaces *> do + level <- genericLength <$> munch1 (== '*') <* " " + todoType <- option "" $ do word <- munch1 (/= ' ') <* skipSpaces + guard (word `elem` todoPrefixes) + pure word + headingText <- pLine + void $ many (pLine >>= \line -> guard (isNotHeading line) $> line) -- skip body + pure Heading{..} + +pLine :: Parser String +pLine = munch (/= '\n') <* "\n" + +isNotHeading :: String -> Bool +isNotHeading str = case break (/= '*') str of + ("", _) -> True + (_ , ' ' : _) -> False + _ -> True