website: Add "News" page.
* website/www/news.scm: New file. * website/static/base/css/news.css: New file. * website/haunt.scm (with-url-parameters): New macro. (parameterized-procedure, parameterized-theme): New procedures. <top level>: Use 'with-url-parameters' and add blog and atom feed.
This commit is contained in:
Ludovic Courtès
parent
bccda311c2
commit
55c4d5b809
|
|
@ -25,9 +25,12 @@
|
|||
(haunt html)
|
||||
(haunt utils)
|
||||
(haunt builder assets)
|
||||
(haunt builder blog)
|
||||
(haunt builder atom)
|
||||
(ice-9 match)
|
||||
(www)
|
||||
(www utils))
|
||||
(www utils)
|
||||
(www news))
|
||||
|
||||
(define %local-test?
|
||||
;; True when we're testing locally, as opposed to producing things to
|
||||
|
|
@ -39,6 +42,28 @@
|
|||
;; The URLs produced in these pages are only meant for local consumption.
|
||||
(format #t "~%Producing Web pages for local tests *only*!~%~%"))
|
||||
|
||||
(define-syntax-rule (with-url-parameters body ...)
|
||||
"Run BODY in a context where URL parameters honor %LOCAL-TEST?."
|
||||
(parameterize ((current-url-root (if %local-test?
|
||||
""
|
||||
(current-url-root)))
|
||||
(gnu.org-root (if %local-test?
|
||||
"https://www.gnu.org"
|
||||
(gnu.org-root))))
|
||||
body ...))
|
||||
|
||||
(define (parameterized-procedure proc)
|
||||
(lambda args
|
||||
(with-url-parameters
|
||||
(apply proc args))))
|
||||
|
||||
(define (parameterized-theme thm)
|
||||
(theme #:name (theme-name thm)
|
||||
#:layout (parameterized-procedure (theme-layout thm))
|
||||
#:post-template (parameterized-procedure (theme-post-template thm))
|
||||
#:collection-template (parameterized-procedure
|
||||
(theme-collection-template thm))))
|
||||
|
||||
(site #:title "GNU's advanced distro and transactional package manager"
|
||||
#:domain "//www.gnu.org/software/guix"
|
||||
#:default-metadata
|
||||
|
|
@ -49,12 +74,11 @@
|
|||
`(,@(map (match-lambda
|
||||
((file-name contents)
|
||||
(lambda (site posts)
|
||||
(parameterize ((current-url-root (if %local-test?
|
||||
""
|
||||
(current-url-root)))
|
||||
(gnu.org-root (if %local-test?
|
||||
"https://www.gnu.org"
|
||||
(gnu.org-root))))
|
||||
(with-url-parameters
|
||||
(make-page file-name (contents) sxml->html)))))
|
||||
%web-pages)
|
||||
,(blog #:theme (parameterized-theme %news-haunt-theme)
|
||||
#:prefix "news")
|
||||
,(atom-feed #:file-name "news/feed.xml"
|
||||
#:blog-prefix "news")
|
||||
,(static-directory "static")))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,23 @@
|
|||
/*
|
||||
Public domain 2016 Ludovic Courtès <ludo@gnu.org>.
|
||||
All rights waived.
|
||||
*/
|
||||
|
||||
@import url("article.css");
|
||||
|
||||
.example {
|
||||
border-style: none;
|
||||
border-radius: 0.3em;
|
||||
background-color: #F2EFE4;
|
||||
border-width: thin;
|
||||
color: black;
|
||||
font-size: 0.9em;
|
||||
padding: 10px;
|
||||
text-align: left;
|
||||
font-family: fixed-width;
|
||||
}
|
||||
|
||||
.post-about {
|
||||
color: #4D4D4D;
|
||||
font-size: 0.9em;
|
||||
}
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
;;; GuixSD website --- GNU's advanced distro website
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GuixSD website.
|
||||
;;;
|
||||
;;; GuixSD website is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU Affero General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GuixSD website is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU Affero General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU Affero General Public License
|
||||
;;; along with GuixSD website. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (www news)
|
||||
#:use-module (www utils)
|
||||
#:use-module (www shared)
|
||||
#:use-module (haunt site)
|
||||
#:use-module (haunt post)
|
||||
#:use-module (haunt builder blog)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:export (post-url
|
||||
%news-haunt-theme))
|
||||
|
||||
(define (post-url post site)
|
||||
"Return the URL of POST, a Haunt blog post, for SITE."
|
||||
(base-url (string-append "news/" (site-post-slug site post) ".html")))
|
||||
|
||||
(define* (post->sxml post #:key post-uri)
|
||||
"Return the SXML for POST."
|
||||
`(div (h2 (@ (class "title"))
|
||||
,(if post-uri
|
||||
`(a (@ (href ,post-uri))
|
||||
,(post-ref post 'title))
|
||||
(post-ref post 'title)))
|
||||
(div (@ (class "post-about"))
|
||||
,(post-ref post 'author)
|
||||
" — " ,(date->string (post-date post) "~B ~e, ~Y"))
|
||||
(div (@ (class "post-body"))
|
||||
,(post-sxml post))))
|
||||
|
||||
(define (news-page-sxml site title posts prefix)
|
||||
"Return the SXML for the news page of SITE, containing POSTS."
|
||||
`((div (@ (class "news-header"))
|
||||
(h1 "Recent News "
|
||||
(a (@ (href ,(base-url "news/feed.xml")))
|
||||
(img (@ (alt "Atom feed")
|
||||
(src ,(image-url "feed.png")))))))
|
||||
(div (@ (class "post-list"))
|
||||
,@(map (lambda (post)
|
||||
(post->sxml post #:post-uri (post-url post site)))
|
||||
posts))))
|
||||
|
||||
(define (base-layout body)
|
||||
`(html (@ (lang "en"))
|
||||
,(html-page-header "News" #:css "news.css")
|
||||
|
||||
(body
|
||||
,(html-page-description)
|
||||
,(html-page-links)
|
||||
|
||||
(div (@ (id "content-box"))
|
||||
(article ,body))
|
||||
|
||||
,(html-page-footer))))
|
||||
|
||||
(define %news-haunt-theme
|
||||
;; Theme for the rendering of the news pages.
|
||||
(theme #:name "GuixSD"
|
||||
#:layout (lambda (site title body)
|
||||
(base-layout body))
|
||||
#:post-template post->sxml
|
||||
#:collection-template news-page-sxml))
|
||||
Loading…
Reference in New Issue