X.P.OrgMode: Only parse actual words

Instead of trying to find a prefix and then killing the rest of the
word, actually see whether it at least fits the pattern.  This means
that

    message +s saturated

will no longer parse as a scheduled item for saturday, while

    message +s satur

still will.
This commit is contained in:
slotThe
2021-06-12 14:04:28 +02:00
parent 5067164d19
commit c1cb3aaa24

View File

@@ -71,22 +71,24 @@ above you can write
> , ("M-C-o", orgPrompt def "TODO" "org/todos.org") > , ("M-C-o", orgPrompt def "TODO" "org/todos.org")
There is also some scheduling and deadline functionality present. They There is also some scheduling and deadline functionality present. They
are initiated by entering @+s@ or @+d@ into the prompt respectively, are initiated by entering @+s@ or @+d@—separated by at least one
followed by a date and a time of day. Any of the following are valid whitespace character on either side—into the prompt respectively,
dates: followed a date and (optionally) a time of day. Any of the following
are valid dates:
- today - tod[ay]
- tomorrow - tom[orrow]
- /any weekday/ - /any weekday/
- /any date of the form DD MM YYYY/ - /any date of the form DD MM YYYY/
In the last case, the month and the year are optional and will be, if In the last case, the month and the year are optional and will be, if
missing, filled out with the current month and year. We disambiguate as missing, filled out with the current month and year. For weekdays, we
early as possible, so a simple @w@ will suffice to mean Wednesday, while also disambiguate as early as possible, so a simple @w@ will suffice to
@s@ will not be enough to say Sunday. Weekdays also always schedule mean Wednesday, while @s@ will not be enough to say Sunday. You can,
into the future, e.g. if today is Monday and you schedule something for however, still write the full word without any troubles. Weekdays also
Monday, you will actually schedule it for the /next/ Monday (the one in always schedule into the future, e.g. if today is Monday and you
seven days). schedule something for Monday, you will actually schedule it for the
/next/ Monday (the one in seven days).
The time is specified in the @HH:MM@ format. The minutes may be The time is specified in the @HH:MM@ format. The minutes may be
omitted, in which case @00@ will be substituted. omitted, in which case @00@ will be substituted.
@@ -357,16 +359,17 @@ pTimeOfDay = lchoice
-- | Parse a 'Date'. -- | Parse a 'Date'.
pDate :: ReadP Date pDate :: ReadP Date
pDate = skipSpaces *> lchoice pDate = skipSpaces *> lchoice
[ Today <$ string "tod" [ pString "tod" "ay" Today
, Tomorrow <$ string "tom" , pString "tom" "orrow" Tomorrow
, Next <$> pNext , Next <$> pNext
, Date <$> pDate1 <++ pDate2 <++ pDate3 , Date <$> pDate1 <++ pDate2 <++ pDate3
] <* munch (/= ' ') <* skipSpaces -- cleanup ] <* skipSpaces -- cleanup
where where
pNext :: ReadP DayOfWeek = lchoice pNext :: ReadP DayOfWeek = lchoice
[ Monday <$ string "m" , Tuesday <$ string "tu", Wednesday <$ string "w" [ pString "m" "onday" Monday , pString "tu" "esday" Tuesday
, Thursday <$ string "th", Friday <$ string "f" , Saturday <$ string "sa" , pString "w" "ednesday" Wednesday, pString "th" "ursday" Thursday
, Sunday <$ string "su" , pString "f" "riday" Friday , pString "sa" "turday" Saturday
, pString "su" "nday" Sunday
] ]
-- XXX: This is really horrible, but I can't see a way to not have -- XXX: This is really horrible, but I can't see a way to not have
@@ -382,13 +385,24 @@ pDate = skipSpaces *> lchoice
pDate' p p' = pDate' p p' =
(,,) <$> pInt (,,) <$> pInt
<*> p (skipSpaces *> lchoice <*> p (skipSpaces *> lchoice
[ 1 <$ string "ja" , 2 <$ string "f" , 3 <$ string "mar" [ pString "ja" "nuary" 1 , pString "f" "ebruary" 2
, 4 <$ string "ap" , 5 <$ string "may", 6 <$ string "jun" , pString "mar" "ch" 3 , pString "ap" "ril" 4
, 7 <$ string "jul", 8 <$ string "au" , 9 <$ string "s" , pString "may" "" 5 , pString "jun" "e" 6
, 10 <$ string "o" , 11 <$ string "n" , 12 <$ string "d" , pString "jul" "y" 7 , pString "au" "gust" 8
, pString "s" "eptember" 9 , pString "o" "ctober" 10
, pString "n" "ovember" 11, pString "d" "ecember" 12
]) ])
<*> p' (skipSpaces *> pInt) <*> p' (skipSpaces *> pInt)
-- | Parse a @start@ and see whether the rest of the word (separated by
-- spaces) fits the @leftover@.
pString :: String -> String -> a -> ReadP a
pString start leftover ret = do
void $ string start
l <- munch (/= ' ')
guard (l `isPrefixOf` leftover)
pure ret
-- | Parse a number. -- | Parse a number.
pInt :: (Read a, Integral a) => ReadP a pInt :: (Read a, Integral a) => ReadP a
pInt = read <$> munch1 isDigit pInt = read <$> munch1 isDigit