#lang racket/base
;; Copyright (c) 2018 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
;; You may also obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; Author contact information:
;; joel@jdueck.net
;; https://joeldueck.com
;; -------------------------------------------------------------------------
;; Convenience/helper functions for this project’s Scribble documentation
(require scribble/core
scribble/manual/lang
scribble/html-properties
(only-in net/uri-codec uri-encode))
(provide (all-defined-out))
(define repo-url/ "https://thelocalyarn.com/cgi-bin/yarncode/")
;; Link to a ticket on the Fossil repository by specifying the ticket ID.
;; The "_parent" target breaks out of the iframe used by the Fossil repo web UI.
(define (ticket id-str)
(hyperlink (string-append repo-url/ "tktview?name=" id-str)
"ticket "
(tt id-str)
#:style (style #f (list (attributes '((target . "_parent")))))))
;; Link to a wiki page on the Fossil repository by specifying the title
(define (wiki title)
(hyperlink (string-append repo-url/ "wiki?name=" (uri-encode title))
title
#:style (style #f (list (attributes '((target . "_parent")))))))
;; Link somewhere outside these docs or Racket docs. The `_blank` target opens in a new tab.
(define (ext-link url-str . elems)
(keyword-apply hyperlink '(#:style) (list (style #f (list (attributes '((target . "_blank"))))))
url-str
elems))
;; Link to show contents of the latest checked-in version of a file
;; (or a file listing if a directory was specified)
(define (repo-file filename)
(hyperlink (string-append repo-url/ "file/" filename)
(tt filename)
#:style (style #f (list (attributes '((target . "_parent")))))))
(define (responsive-retina-image img-path)
(image img-path
#:scale 0.5
#:style (style #f (list (attributes '((style . "max-width:100%;height:auto;")))))))
