;;; Harmonic Flow web site (define-module (apps base templates components) #:use-module (apps aux lists) #:use-module (apps aux strings) #:use-module (apps aux sxml) #:use-module (apps aux web) #:use-module (apps base types) #:use-module (apps base utils) #:use-module (apps i18n) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (breadcrumbs button-big button-little contact-preview contact->shtml horizontal-line horizontal-separator horizontal-skip link-more link-subtle link-yellow manual-href manual-devel-href manual-link-yellow navbar page-indicator page-selector)) ;;; ;;; Components. ;;; (define (breadcrumbs crumbs) "Return an SHTML nav element representing the breadcrumbs. CRUMBS (list) A non-empty list of objects as defined in (apps base types)." `(nav (@ (class "breadcrumbs")) ,(G_ `(h2 (@ (class "a11y-offset")) "Your location:")) ,(G_ `(a (@ (class "crumb") (href ,(hfweb-url))) "Home")) (span " → ") ,@(separate (crumbs->shtml crumbs) '(span " → ")))) (define (crumbs->shtml crumbs) "Return the list of CRUMBS as list of SHTML a elements. CRUMBS (list) A non-empty list of objects as defined in (apps base types)." (cond ((= (length crumbs) 1) (cons `(a (@ (class "crumb crumb-active") (href ,(crumb-url (first crumbs)))) ,(crumb-label (first crumbs))) '())) (else (cons `(a (@ (class "crumb") (href ,(crumb-url (first crumbs)))) ,(crumb-label (first crumbs))) (crumbs->shtml (rest crumbs)))))) (define* (button-big #:key (label "Button") (url "#") (light #false)) "Return an SHTML a element that looks like a big button. LABEL (string) The text for the button. For example: 'Download!'. URL (string) A URL to use for the href attribute of the a element. If not specified, the value defaults to #. LIGHT (boolean) True if the button is going to be used on a dark background; false otherwise (this is the default)." `(a (@ (class ,(string-append "button-big" (if light " button-light" ""))) (href ,url)) ,label)) (define* (button-little #:key (label "Button") (url "#") (active #false)) "Return an SHTML a element that looks like a little button. LABEL (string) The text for the button. For example: 'Next'. URL (string) A URL to use for the href attribute of the a element. If not specified, the value defaults to #. ACTIVE (boolean) True if the button should be highlighted as active (on)." `(a (@ (class ,(string-append "button-little" (if active " button-little-active" ""))) (href ,url)) ,label)) (define (contact-preview contact) "Return an SHTML preview of the given contact object. CONTACT () A contact object as defined in (apps base types)." `(a (@ (class "item-preview") (href ,(contact-url contact))) (h3 ,(contact-name contact)) (p ,(string-summarize (sxml->string* (match (contact-description contact) ((and multilingual (((? string?) (? string?)) ...)) (let ((code %current-lang)) (match (assoc code multilingual) ((code blurb) blurb) (else (assoc "en" multilingual))))) (blurb blurb))) 30) "…"))) (define (language-tag lang) `(span (@ (class "button-little button-little-active") (style "text-align: center; width: 20px; vertical-align: middle")) ,lang)) (define (contact->shtml contact) "Return an SHTML representation of the given contact object. CONTACT () A contact object as defined in (apps base types)." `(div (@ (class "contact-medium")) (a (@ (href ,(contact-url contact))) (b ,(contact-name contact))) ,(if (string=? (contact-log contact) "") "" `(small " (" ,(G_ `(a (@ (href ,(contact-log contact))) "archive")) ") ")) ;; The description can be a list of language/blurb pairs. ,(match (contact-description contact) ((((? string? languages) blurbs) ...) `(div (@ (id "help-hfweb-mailing-list-description")) ,@(map (lambda (language blurb) `(div (@ (style "display: flex; align-items: center; margin: 0 10px 10px 0")) ,(language-tag language) (div (@ (lang ,language) (style "flex: 1")) ,blurb))) languages blurbs))) (blurb blurb)))) (define* (horizontal-separator #:key (light #false)) "Return an SHTML img element that works as a separator. LIGHT (boolean) True if the separator is going to be used on a dark background; false otherwise (this is the default)." `(img (@ (class "h-separator") ,(if light `(src ,(hfweb-url "static/base/img/h-separator.png")) `(src ,(hfweb-url "static/base/img/h-separator-dark.png"))) (alt "")))) (define (horizontal-skip) "Return SHTML for a small horizontal space." `(span (@ (class "hskip")))) (define (horizontal-line) "Return SHTML for a visible separator to be used in a dropdown menu like a menu item." `(img (@ (class "hline") (src ,(hfweb-url "static/base/img/h-separator.png")) (alt "")))) (define* (link-more #:key (label "More") (url "#") (light #false)) "Return an SHTML a element that looks like a 'more →' link. LABEL (string) The text for the link. For example: 'Read the manual'. URL (string) A URL to use for the href attribute of the a element. If not specified, the value defaults to #. LIGHT (boolean) True if the link is going to be used on a dark background; false otherwise (this is the default)." `(a (@ (class ,(string-append "link-more" (if light " link-more-light" ""))) (href ,url)) ,label)) (define* (link-subtle #:key (label "link") (url "#")) "Return an SHTML a element that does not stand too much on white backgrounds. LABEL (string) The text for the link. For example: 'Additional notes'. URL (string) The URL of the link. If not specified, the value defaults to #." `(a (@ (class "link-subtle") (href ,url)) ,label)) (define* (link-yellow #:key (label "link") (url "#")) "Return a yellow SHTML a element to use on dark backgrounds. LABEL (string) The text for the link. For example: 'read the manual'. URL (string) The URL of the link. If not specified, the value defaults to #." `(a (@ (class "link-yellow") (href ,url)) ,label)) (define (manual-href label manual-lang _1 subpath _2) "Return an HTML a element with its href attribute pointing to the manual. It can be marked for translation as: (G_ (manual-href \"some-text\" (G_ \"en\") (G_ \"Some-section.html\"))) LABEL (string) The content of the a element. MANUAL-LANG (string) The normalized language for the Guix manual as produced by 'doc/build.scm' in the Guix source tree, i.e. \"en\" for the English manual. SUBPATH (string) The same as in the manual-url procedure." ;; The _ arguments are placeholders for args added by G_, cf. i18n-howto.txt. `(a (@ (href ,(manual-url subpath #:language manual-lang))) ,label)) (define (manual-devel-href label manual-lang _1 subpath _2) "Similar to 'manual-href', but link to the development manual." ;; The _ arguments are placeholders for args added by G_, cf. i18n-howto.txt. `(a (@ (href ,(manual-devel-url subpath #:language manual-lang))) ,label)) (define* (manual-link-yellow label manual-lang _1 #:optional (subpath "") _2) "Return a link-yellow component pointing to the manual. It can be used like this: (manual-link-yellow \"some-text\" (G_ \"en\") \"Package-Management.html\") LABEL (string) The label of the link-yellow. MANUAL-LANG (string) The normalized language for the Guix manual as produced by 'doc/build.scm' in the Guix source tree, i.e. \"en\" for the English manual. SUBPATH (string) The same as in the manual-url procedure." ;; The _ arguments are placeholders for args added by G_, cf. i18n-howto.txt. (link-yellow #:label label #:url (manual-url subpath #:language manual-lang))) (define* (menu-dropdown #:key (label "Item") (active-item "") (url "#") (items '())) "Return an SHTML li element representing a dropdown for the navbar. LABEL (string) The text for the dropdown. For example: 'About'. ACTIVE-ITEM (string) A string representing the label of the current active item in the navigation bar. If the values of LABEL and ACTIVE-ITEM are the same, the dropdown is highlighted. URL (string) The URL of the web resource referenced by the dropdown. Any value used for an HTML a element is valid. If not specified, the value defaults to #. ITEMS (list of menu items) A list of menu items as returned by the menu-item procedure in this same module. If not provided, the value defaults to an empty list." (let ((label-hash (number->string (string-hash label)))) `(li (@ (class ,(if (string=? (string-downcase label) (string-downcase active-item)) "menu-item menu-item-active dropdown dropdown-btn" "menu-item dropdown dropdown-btn"))) ,@(let ((id (string-append "visible-dropdown-" label-hash))) `(;; show dropdown when button is checked: (style ,(string-append "#" id ":checked ~ #submenu-" label-hash " { min-width: 150px; width: max-content; /* reset to initial values: */ height: auto; overflow: visible; }")) ;; show uncheck version of button iff button is checked (style ,(string-append "#" id ":checked \ ~ label[for=all-dropdowns-hidden] { display: inline; }")) (style "label[for=all-dropdowns-hidden] { display: none; }") ;; show check version of button iff button is unchecked (style ,(string-append "#" id ":checked ~ label[for=" id "] { display: none; }")) (input (@ (class "menu-hidden-input") (type "radio") (name "dropdown") (id ,id))) (label (@ (for ,id)) ,label) (label (@ (for "all-dropdowns-hidden")) ,label))) (div (@ (class "submenu") (id ,(string-append "submenu-" label-hash))) (div (@ (class "submenu-triangle")) " ") (ul ,@items))))) (define* (menu-item #:key (label "Item") (active-item "") (url "#")) "Return an SHTML li element representing an item for the navbar. LABEL (string) The text for the item. For example: 'About'. ACTIVE-ITEM (string) A string representing the label of the current active item in the navigation bar. If the values of LABEL and ACTIVE-ITEM are the same, the menu item is highlighted. URL (string) The URL of the web resource referenced by the menu item. Any value used for an HTML a element is valid. If not specified, the value defaults to #." `(li (a (@ (class ,(if (string=? (string-downcase label) (string-downcase active-item)) "menu-item menu-item-active" "menu-item")) (href ,url)) ,label))) (define* (navbar #:key (active-item "About")) "Return an SHTML header element with the given ACTIVE ITEM highlighted." `(header (@ (class "navbar")) ;; Branding. (h1 (a (@ (class "branding") (href ,(hfweb-url))) ,(C_ "website menu" `(span (@ (class "a11y-offset")) "Harmonic Flow")))) ;; Menu. (nav (@ (class "menu")) ,(G_ `(h2 (@ (class "a11y-offset")) "website menu:")) (input (@ (class "menu-hidden-input") (type "radio") (name "dropdown") (id "all-dropdowns-hidden"))) (ul ,(C_ "website menu" (menu-item #:label "Overview" #:active-item active-item #:url (hfweb-url))) ,(menu-dropdown #:label (C_ "website menu" "HFGE") #:active-item active-item #:items (list (C_ "website menu" (menu-item #:label "About" #:active-item active-item #:url (hfweb-url "hfge-about/"))) (C_ "website menu" (menu-item #:label "Download" #:active-item active-item #:url (hfweb-url "hfge-download/"))) (C_ "website menu" (menu-item #:label "Git" #:active-item active-item #:url (hfweb-url "hfge-git/"))))) ,(menu-dropdown #:label (C_ "website menu" "Media") #:active-item active-item #:items (list (C_ "website menu" (menu-item #:label "Screenshots" #:active-item active-item #:url (hfweb-url "screenshots/"))))) ,(C_ "website menu" (menu-item #:label "Blog" #:active-item active-item #:url (hfweb-url "blog/"))) ,(menu-dropdown #:label (C_ "website menu" "About") #:active-item active-item #:items (list (C_ "website menu" (menu-item #:label "About Site" #:active-item active-item #:url (hfweb-url "about/"))) (horizontal-line) (C_ "website menu" (menu-item #:label "Contact" #:active-item active-item #:url (hfweb-url "contact/"))))) ,(horizontal-skip))) ;; Menu button. (a (@ (class "menu-btn") (href ,(hfweb-url "menu/"))) ""))) (define (page-indicator page-number total-pages) "Return an SHTML span element in the form 'page X of Y' if there is more than one page. Otherwise, return an empty string. PAGE-NUMBER (number) The number of the page that the user is seeing. TOTAL-PAGES (number) The total number of pages that should be displayed." (if (> total-pages 1) (G_ `(span (@ (class "page-number-indicator")) " (Page " ,(number->string page-number) " of " ,(number->string total-pages) ")")) "")) (define (page-selector pages active-page base-url) "Return an SHTML nav element representing a page selection widget. PAGES (number) The total number of pages that should be displayed. ACTIVE-PAGE (number) The number of the page that should be displayed as active. BASE-URL (string) Absolute URL path to prepend to page numbers. For example: '/en/blog'. This would result in URLs like: '/en/blog/page/N', where N is the number of the page." `(nav (@ (class "page-selector")) (h3 (@ (class "a11y-offset")) ,(G_ (string-append "Page " (number->string active-page) " of " (number->string pages) ". Go to another page: "))) ,(if (> pages 1) (map (lambda (page-number) (list (button-little #:label page-number #:url (url-path-join base-url "page" (number->string page-number) "") #:active (= page-number active-page)) " ")) ; NOTE: Force space for readability in non-CSS browsers. (iota pages 1)) "")))