[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/07: doc: Support paren matching via CSS hover.
From: |
guix-commits |
Subject: |
03/07: doc: Support paren matching via CSS hover. |
Date: |
Wed, 25 Sep 2019 09:49:54 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 012c93e916279f7df0e495aa1a73f696de15b80e
Author: Ludovic Courtès <address@hidden>
Date: Wed Sep 25 14:43:46 2019 +0200
doc: Support paren matching via CSS hover.
* doc/build.scm (syntax-highlighted-html)[build](pair-open/close)
(highlights->sxml*): New procedures.
(syntax-highlight): Use 'highlights->sxml*'.
---
doc/build.scm | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 56 insertions(+), 3 deletions(-)
diff --git a/doc/build.scm b/doc/build.scm
index 5bc95d2..b6a921c 100644
--- a/doc/build.scm
+++ b/doc/build.scm
@@ -215,6 +215,58 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo
--html')."
(ice-9 match)
(ice-9 threads))
+ (define (pair-open/close lst)
+ ;; Pair 'open' and 'close' tags produced by 'highlights' and
+ ;; produce nested 'paren' tags instead.
+ (let loop ((lst lst)
+ (level 0)
+ (result '()))
+ (match lst
+ ((('open open) rest ...)
+ (call-with-values
+ (lambda ()
+ (loop rest (+ 1 level) '()))
+ (lambda (inner close rest)
+ (loop rest level
+ (cons `(paren ,level ,open ,inner ,close)
+ result)))))
+ ((('close str) rest ...)
+ (if (> level 0)
+ (values (reverse result) str rest)
+ (begin
+ (format (current-error-port)
+ "warning: extra closing paren; context:~%
~y~%"
+ (reverse result))
+ (loop rest 0 (cons `(close ,str) result)))))
+ ((item rest ...)
+ (loop rest level (cons item result)))
+ (()
+ (when (> level 0)
+ (format (current-error-port)
+ "warning: missing ~a closing parens; context:~%
~y%"
+ level (reverse result)))
+ (values (reverse result) "" '())))))
+
+ (define (highlights->sxml* highlights)
+ ;; Like 'highlights->sxml', but handle nested 'paren tags. This
+ ;; allows for paren matching highlights via appropriate CSS
+ ;; "hover" properties.
+ (define (tag->class tag)
+ (string-append "syntax-" (symbol->string tag)))
+
+ (map (match-lambda
+ ((? string? str) str)
+ (('paren level open (body ...) close)
+ `(span (@ (class ,(string-append "syntax-paren"
+ (number->string
level))))
+ ,open
+ (span (@ (class "syntax-symbol"))
+ ,@(highlights->sxml* body))
+ ,close))
+ ((tag text)
+ `(span (@ (class ,(tag->class tag))) ,text)))
+ highlights))
+
(define entity->string
(match-lambda
("rArr" "⇒")
@@ -252,9 +304,10 @@ its <pre class=\"lisp\"> blocks (as produced by 'makeinfo
--html')."
(href #$syntax-css-url)))))
(('pre ('@ ('class "lisp")) code-snippet ...)
`(pre (@ (class "lisp"))
- ,(highlights->sxml
- (highlight lex-scheme
- (concatenate-snippets code-snippet)))))
+ ,@(highlights->sxml*
+ (pair-open/close
+ (highlight lex-scheme
+ (concatenate-snippets code-snippet))))))
((tag ('@ attributes ...) body ...)
`(,tag (@ ,@attributes) ,@(map syntax-highlight body)))
((tag body ...)
- branch master updated (dd2a832 -> 195854a), guix-commits, 2019/09/25
- 01/07: colors: Add 'dim'., guix-commits, 2019/09/25
- 02/07: pull: Dim the commit ID when displaying news., guix-commits, 2019/09/25
- 04/07: gnu: emacs-exwm: Update to 0.23., guix-commits, 2019/09/25
- 05/07: doc: Fix installing Guix in VM, guix-commits, 2019/09/25
- 06/07: doc: Avoid @verbatiminclude for Scheme snippets., guix-commits, 2019/09/25
- 03/07: doc: Support paren matching via CSS hover.,
guix-commits <=
- 07/07: gnu: Add r-assertable., guix-commits, 2019/09/25