diff options
| -rw-r--r-- | Pancake/Printing.hs | 9 | ||||
| -rw-r--r-- | Pancake/Rendering.hs | 15 | ||||
| -rw-r--r-- | pancake.el | 15 |
3 files changed, 36 insertions, 3 deletions
diff --git a/Pancake/Printing.hs b/Pancake/Printing.hs index 66d2606..9bc6c81 100644 --- a/Pancake/Printing.hs +++ b/Pancake/Printing.hs @@ -30,6 +30,12 @@ propertize t (Bold s) = fromMaybe id (getCapability t withBold) $ propertize t s propertize t (Emph s) = fromMaybe id (getCapability t withStandout) $ propertize t s +propertize t (Strikethrough s) = + mconcat [termText "-", propertize t s, termText "-"] +propertize t (Subscript s) = + mconcat [termText "_{", propertize t s, termText "}"] +propertize t (Superscript s) = + mconcat [termText "^{", propertize t s, termText "}"] propertize t (Underline s) = fromMaybe id (getCapability t withUnderline) $ propertize t s propertize t (Denote _ s) = propertize t s @@ -78,6 +84,9 @@ showSexps uri ro = showSexp (Bold s) = list ["style", "bold", showSexp s] showSexp (Underline s) = list ["style", "underline", showSexp s] showSexp (Emph s) = list ["style", "italic", showSexp s] + showSexp (Strikethrough s) = list ["style", "strikethrough", showSexp s] + showSexp (Subscript s) = list ["subscript", showSexp s] + showSexp (Superscript s) = list ["superscript", showSexp s] showSexp (Denote d s) = list [ "denotation" , showDenotation d , showSexp s] diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index 7b219b9..e88a9ad 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -44,6 +44,9 @@ data Styled = Plain String | Underline Styled | Bold Styled | Emph Styled + | Strikethrough Styled + | Subscript Styled + | Superscript Styled | Fg Color Styled | Denote Denotation Styled deriving (Show, Eq) @@ -178,6 +181,9 @@ unstyled = concatMap unstyled' unstyled' (Underline s) = unstyled' s unstyled' (Bold s) = unstyled' s unstyled' (Emph s) = unstyled' s + unstyled' (Strikethrough s) = unstyled' s + unstyled' (Subscript s) = unstyled' s + unstyled' (Superscript s) = unstyled' s unstyled' (Fg _ s) = unstyled' s unstyled' (Denote _ s) = unstyled' s @@ -199,6 +205,9 @@ fitLines maxLen inlineBits = concatMap (map reverse . fitWords [] 0) inlineBits splitStyled (Underline s) = map Underline $ splitStyled s splitStyled (Bold s) = map Bold $ splitStyled s splitStyled (Emph s) = map Emph $ splitStyled s + splitStyled (Strikethrough s) = map Strikethrough $ splitStyled s + splitStyled (Subscript s) = map Subscript $ splitStyled s + splitStyled (Superscript s) = map Superscript $ splitStyled s splitStyled (Fg c s) = map (Fg c) $ splitStyled s splitStyled (Denote d s) = map (Denote d) $ splitStyled s fitWords :: [Styled] -> Int -> [Styled] -> [StyledLine] @@ -248,9 +257,9 @@ readInline (P.Str s) | otherwise = pure [fromString s] readInline (P.Emph s) = concatMap (map Emph) <$> mapM readInline s readInline (P.Strong s) = concatMap (map Bold) <$> mapM readInline s -readInline (P.Strikeout s) = wrappedInlines "-" "-" s -readInline (P.Superscript s) = wrappedInlines "^{" "}" s -readInline (P.Subscript s) = wrappedInlines "_{" "}" s +readInline (P.Strikeout s) = concatMap (map Strikethrough) <$> mapM readInline s +readInline (P.Superscript s) = concatMap (map Superscript) <$> mapM readInline s +readInline (P.Subscript s) = concatMap (map Subscript) <$> mapM readInline s readInline (P.SmallCaps s) = wrappedInlines "\\sc{" "}" s readInline (P.Quoted P.SingleQuote s) = wrappedInlines "‘" "’" s readInline (P.Quoted P.DoubleQuote s) = wrappedInlines "“" "”" s @@ -93,6 +93,11 @@ "Foreground face for white color." :group 'pancake) +(defface pancake-strike-through + '((t :strike-through t)) + "A strike-through face." + :group 'pancake) + (defcustom pancake-command '("pancake" "--embedded") "A command that runs pancake, along with its arguments" :group 'pancake) @@ -178,9 +183,19 @@ (pancake-print-line rest) (add-face-text-property start (point) (pancake-translate-color color 'foreground) t)) + (`(style strikethrough . ,rest) + (pancake-print-line rest) + (add-face-text-property start (point) 'pancake-strike-through t)) (`(style ,face . ,rest) (pancake-print-line rest) (add-face-text-property start (point) face t)) + (`(subscript . ,rest) + (pancake-print-line rest) + (add-text-properties start (point) '(display (height 0.75)))) + (`(superscript . ,rest) + (pancake-print-line rest) + (add-text-properties start (point) '(display ((raise 0.25) + (height 0.75))))) (`(denotation (math . ,formula) . ,rest) (pancake-print-line rest)) (`(denotation (link . ,uri) . ,rest) |