summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2016-08-19 21:44:30 -0400
committerDavid Thompson <dthompson2@worcester.edu>2016-08-19 21:44:30 -0400
commit4f9918dd9d50474d1c0872abd65488813c43ee3c (patch)
treec3aaa44b997ee6111428da6102e8838fe0221303
parent5438b4758200f64a0a1d658444931aa05016bb37 (diff)
Handle videos and source code highlighting in Markdown posts.
-rw-r--r--css/dthompson.css7
-rw-r--r--haunt.scm159
-rw-r--r--posts/guile-2d-frp.md4
-rw-r--r--videos/guile-2d-frp-demo.webmbin0 -> 10133426 bytes
4 files changed, 149 insertions, 21 deletions
diff --git a/css/dthompson.css b/css/dthompson.css
index 3fbc63e..40e63e7 100644
--- a/css/dthompson.css
+++ b/css/dthompson.css
@@ -171,6 +171,13 @@ footer {
border-radius: 4px;
}
+.post video {
+ display: block;
+ margin: 0 auto;
+ padding: 0px;
+ max-width: 100%;
+}
+
.caption {
text-align: center;
margin: 0;
diff --git a/haunt.scm b/haunt.scm
index 2a089a5..447f36a 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -31,12 +31,16 @@
(haunt reader commonmark)
(haunt site)
(haunt utils)
+ (commonmark)
(syntax-highlight)
(syntax-highlight scheme)
+ (syntax-highlight xml)
+ (syntax-highlight c)
(sxml match)
(sxml transform)
(texinfo)
(texinfo html)
+ (srfi srfi-1)
(srfi srfi-19)
(ice-9 rdelim)
(ice-9 regex)
@@ -163,28 +167,54 @@ free culture works available under the " ,%cc-by-sa-link " license.")
(let ((line (read-line port)))
(match:substring (regexp-exec rx line) 1)))))
-(define (maybe-highlight-code source)
- (call-with-input-string source
- (lambda (port)
- (let ((lang (string->symbol (parse-lang port))))
- (if lang
- (highlights->sxml
- (highlight (match lang
- ('scheme lex-scheme)
- ('xml lex-xml))
- port))
- source)))))
+(define (maybe-highlight-code lang source)
+ (let ((lexer (match lang
+ ('scheme lex-scheme)
+ ('xml lex-xml)
+ ('c lex-c)
+ (_ #f))))
+ (if lexer
+ (highlights->sxml (highlight lexer source))
+ source)))
(define (sxml-identity . args) args)
(define (highlight-code . tree)
(sxml-match tree
- ((pre (@ . ,attrs) ,source)
- `(pre (@ ,@attrs)
- ,(maybe-highlight-code source)))))
+ ((code (@ (class ,class) . ,attrs) ,source)
+ (let ((lang (string->symbol
+ (string-drop class (string-length "language-")))))
+ `(code (@ ,@attrs)
+ ,(maybe-highlight-code lang source))))
+ (,other other)))
(define (highlight-scheme code)
- `(pre ,(highlights->sxml (highlight lex-scheme code))))
+ `(pre (code ,(highlights->sxml (highlight lex-scheme code)))))
+
+(define (media-hackery . tree)
+ (sxml-match tree
+ ((img (@ (src ,src) . ,attrs) . ,body)
+ (if (string-suffix? ".webm" src)
+ `(video (@ (src ,src) (controls "true"),@attrs) ,@body)
+ tree))))
+
+(define %commonmark-rules
+ `((code . ,highlight-code)
+ (img . ,media-hackery)
+ (*text* . ,(lambda (tag str) str))
+ (*default* . ,sxml-identity)))
+
+(define (post-process-commonmark sxml)
+ (pre-post-order sxml %commonmark-rules))
+
+(define commonmark-reader*
+ (make-reader (make-file-extension-matcher "md")
+ (lambda (file)
+ (call-with-input-file file
+ (lambda (port)
+ (values (read-metadata-headers port)
+ (post-process-commonmark
+ (commonmark->sxml port))))))))
(define (static-page title file-name body)
(lambda (site posts)
@@ -242,7 +272,7 @@ system. The official repository is hosted at "
(h3 "Anonymous clone")
(pre "git clone " ,url)))
(h2 "Community")
- (p "Real-time discussion for Guile-SDL2 can be found on the "
+ (p "Real-time discussion for " ,name " can be found on the "
(code "#guile")
" channel on the Freenode IRC network.")
(h2 "Contributing")
@@ -278,7 +308,7 @@ at "
`((h1 "Projects")
(p ,(anchor "Guile-SDL2" "projects/guile-sdl2.html")
" β€” SDL2 bindings for Guile Scheme")
- (p ,(anchor "Haunt" "projects/haunt.html")
+ (p ,(anchor "Haunt" "https://haunt.dthompson.us")
" β€” Functional, hackable static site generator")
(p ,(anchor "Shroud" "projects/shroud.html")
" β€” GPG-based password manager")
@@ -380,12 +410,102 @@ following modules:")
("0.1.1" ,(date 2016 01 01))
("0.1.0" ,(date 2015 12 22)))))
+(define shroud-page
+ (project-page
+ #:name "Shroud"
+ #:file-name "shroud.html"
+ #:repo "shroud"
+ #:description
+ `((p "Shroud is a simple secret manager with a command line interface.")
+ (p "The password database is stored as a Scheme s-expression
+and encrypted with a "
+ ,(anchor "GnuPG" "https://gnupg.org")
+ " key. Secrets consist of an arbitrary number of key/value
+pairs, making Shroud suitable for more than just password storage.
+For copying and pasting secrets into web browsers and other graphical
+applications, there is xclip integration."))
+ #:requirements '("GNU Guile >= 2.0.9"
+ "GnuPG >= 1.4"
+ "GNU Make"
+ "GNU pkg-config"
+ ("optional: xclip is needed for the "
+ (code "-c")
+ " flag of "
+ (code "shroud show")
+ " to work"))
+ #:usage
+ `((p "First, create a " (code ".shroud")
+ " file in your home directory to hold your
+configuration settings. All you really need to set here is your GPG
+user ID i.e. your email address:")
+ ,(highlight-scheme
+ "'((user-id . \"foo@example.com\"))")
+ (p "The "
+ (code ".shroud")
+ " file is Scheme source code, so any expression that evaluates
+to an alist of valid configuration settings is usable by Shroud.")
+ (p "Once Shroud is configured, try out the following commands to
+get a feel for how things work:")
+ (pre
+ "# Add a new secret:
+shroud hide bank-account username=foobar password=hackme
+
+# Edit an existing secret:
+shroud hide --edit bank-account password=hackmepls
+
+# List all secrets:
+shroud list
+
+# Show all key/value pairs for a saved secret:
+shroud show bank-account
+
+# Show a single value in a secret:
+shroud show bank-account password
+
+# Copy a password directly to X clipboard:
+shroud show -c bank-account password
+
+# Delete a secret:
+shroud remove bank-account")
+ (p "Happy shrouding!"))
+ #:license "GNU GPLv3+"
+ #:releases
+ `(("0.1.1" ,(date 2015 10 01))
+ ("0.1.0" ,(date 2015 09 29)))))
+
+(define srt2vtt-page
+ (project-page
+ #:name "srt2vtt"
+ #:file-name "srt2vtt.html"
+ #:repo "srt2vtt"
+ #:description
+ `((p "Convert SRT formatted subtitles to WebVTT format for use with
+the HTML5 "
+ (code "<track>") " tag."))
+ #:requirements '("GNU Guile >= 2.0.5")
+ #:usage
+ `((pre
+ "$ srt2vtt --help
+Usage: srt2vtt [OPTIONS]
+Convert SubRip formatted subtitles to WebVTT format.
+
+ -h, --help display this help and exit
+ -v, --version display version and exit
+ -i, --input=FILE-NAME read input from FILE-NAME
+ -o, --output=FILE-NAME write output to FILE-NAME")
+ (p "If " (code "--input")
+ " or " (code "--output")
+ " is ommitted, read from stdin or stdout, respectively."))
+ #:license "GNU GPLv3+"
+ #:releases
+ `(("0.1" ,(date 2015 02 7)))))
+
(site #:title "dthompson"
#:domain "dthompson.us"
#:default-metadata
'((author . "David Thompson")
(email . "davet@gnu.org"))
- #:readers (list commonmark-reader)
+ #:readers (list commonmark-reader*)
#:builders (list (blog #:theme dthompson-theme #:collections %collections)
(atom-feed)
(atom-feeds-by-tag)
@@ -393,8 +513,11 @@ following modules:")
projects-page
sly-page
guile-sdl2-page
+ shroud-page
+ srt2vtt-page
(static-directory "css")
(static-directory "fonts")
(static-directory "images")
+ (static-directory "videos")
(static-directory "src")
(static-directory "manuals")))
diff --git a/posts/guile-2d-frp.md b/posts/guile-2d-frp.md
index 7dedbbb..1970e73 100644
--- a/posts/guile-2d-frp.md
+++ b/posts/guile-2d-frp.md
@@ -55,9 +55,7 @@ focus on more important things.
I think it’s helpful to see FRP in action to really appreciate the
magic. So, check out this screencast!
- <video src="/videos/guile-2d-frp-demo.webm"
- style="width:640px;height:360px;" controls>
- </video>
+![](/videos/guile-2d-frp-demo.webm)
To see all of the juicy implementation details, check out the
[git repository](https://gitorious.org/sly/sly/source/sly/signal.scm).
diff --git a/videos/guile-2d-frp-demo.webm b/videos/guile-2d-frp-demo.webm
new file mode 100644
index 0000000..ee1d939
--- /dev/null
+++ b/videos/guile-2d-frp-demo.webm
Binary files differ