diff options
author | defanor <defanor@uberspace.net> | 2017-11-08 13:05:35 +0300 |
---|---|---|
committer | defanor <defanor@uberspace.net> | 2017-11-08 13:05:35 +0300 |
commit | 6ca97c245713ea6ba83a3cd1d3c9873bac6bcd99 (patch) | |
tree | 47c4a8b33bfb51942831951573df5a9d566a73e2 | |
parent | 1d8a5140e3ce03d9fa6b9c63a6621ab3ab64eb4c (diff) |
Denote headings
-rw-r--r-- | Pancake/Printing.hs | 1 | ||||
-rw-r--r-- | Pancake/Rendering.hs | 10 | ||||
-rw-r--r-- | pancake.el | 30 |
3 files changed, 35 insertions, 6 deletions
diff --git a/Pancake/Printing.hs b/Pancake/Printing.hs index 9bc6c81..04d9de6 100644 --- a/Pancake/Printing.hs +++ b/Pancake/Printing.hs @@ -93,6 +93,7 @@ showSexps uri ro = showDenotation :: Denotation -> String showDenotation (Link u) = list ["link", ".", encodeStr $ show u] showDenotation (Math m) = list ["math", ".", encodeStr m] + showDenotation (Heading l) = list ["heading", ".", show l] mergeStyled :: [Styled] -> [Styled] mergeStyled = foldr mergeStyled' [] diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index e88a9ad..0794616 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -37,6 +37,7 @@ data Listing = Bulleted data Denotation = Link URI | Math String + | Heading Int deriving (Show, Eq) -- | A styled string. @@ -339,11 +340,10 @@ renderBlock (P.DefinitionList dl) = in mapM_ renderDefinition dl renderBlock (P.Header level attr i) = do storeAttr attr - strings <- readInlines i - storeLines [[""]] - indented $ map (map (Fg Green) . ([fromString (replicate level '#'), " "] ++) - . map (Bold . Underline)) strings - storeLines [[""]] + indented =<< map (map (Denote (Heading level) . Fg Green) + . ([fromString (replicate level '#'), " "] ++) + . map (Bold . Underline)) + <$> readInlines i renderBlock P.HorizontalRule = do st <- get indented [[Fg Black $ @@ -106,6 +106,10 @@ "A list of pancake browser buffers, used to find a buffer to use by `pancake-browse-url'.") +(defvar pancake-headings '() + "A list of headings with their levels.") +(make-variable-buffer-local 'pancake-headings) + (defvar pancake-process-output "" "Pancake process's stdout collector.") (make-variable-buffer-local 'pancake-process-output) @@ -203,6 +207,11 @@ (make-text-button start (point) 'uri uri 'action #'pancake-button-action)) + (`(denotation (heading . ,level) . ,rest) + (pancake-print-line rest) + (add-to-list 'pancake-headings (cons (line-number-at-pos) level)) + (add-text-properties start (point) + `(display (height ,(1+ (/ 0.5 level)))))) (_ (format "Unexpected element: %S" element)))))) (defun pancake-print-line (line) @@ -229,7 +238,8 @@ ;; further manipulation (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) - (setq pancake-current-uri (alist-get 'uri alist)) + (setq pancake-current-uri (alist-get 'uri alist) + pancake-headings '()) (dolist (line (alist-get 'lines alist)) (pancake-print-line line) (newline)) @@ -320,6 +330,22 @@ (when prev (goto-char prev)))) +(defun pancake-previous-heading () + "Moves cursor to the previous heading." + (interactive) + (let ((line (seq-find (lambda (x) (< x (line-number-at-pos))) + (mapcar 'car pancake-headings)))) + (when line + (goto-line line)))) + +(defun pancake-next-heading () + "Moves cursor to the next heading." + (interactive) + (let ((line (seq-find (lambda (x) (> x (line-number-at-pos))) + (reverse (mapcar 'car pancake-headings))))) + (when line + (goto-line line)))) + (defun pancake-input (string) "Pancake input handler: opens minibuffer for input. Sets the initial contents to STRING, reads the rest, and passes @@ -344,6 +370,8 @@ it to `pancake-process' as input." (define-key map (kbd "<backtab>") 'pancake-previous-button) (define-key map (kbd "C-c C-c") 'pancake-interrupt) (define-key map (kbd "C-c C-u") 'pancake-display-current-uri) + (define-key map (kbd "C-M-e") 'pancake-next-heading) + (define-key map (kbd "C-M-a") 'pancake-previous-heading) (define-key map (kbd "B") 'pancake-go-backward) (define-key map (kbd "F") 'pancake-go-forward) (define-key map (kbd "Q") 'pancake-quit) |