defs.rkt 2.4 KB
Newer Older
Robert Ricci's avatar
Robert Ricci committed
1
#lang racket/base
Robert Ricci's avatar
Robert Ricci committed
2
(require scribble/base)
3 4 5
(require scribble/decode)
(require racket/class)
(require racket/draw)
6 7
(require racket/system)
(require racket/port)
8
(require racket/vector)
Robert Ricci's avatar
Robert Ricci committed
9 10 11

(provide (all-defined-out))

12 13 14 15 16 17
; Check to see if we are building Apt or CloudLab documentation
(define tb-mode 
  (if (vector-member "cloudlab" (current-command-line-arguments))
    'cloudlab
    'apt))

18 19 20
(define (apt?) (if (equal? tb-mode 'apt) #t #f))
(define (cl?)  (if (equal? tb-mode 'cloudlab) #t #f))

21
(define (apt-vs-cl #:apt [apt-version ""] #:cl [cl-version ""])
22 23 24 25 26
  (if (apt?)
    apt-version
    cl-version))

(define (apt-only stuff)
27
  (apt-vs-cl #:apt stuff #:cl ""))
28 29

(define (cl-only stuff)
30
  (apt-vs-cl #:cl stuff #:apt ""))
31

32 33 34 35 36 37
(define apt-base-url
  (if (cl?)
    "https://www.cloudlab.us"
    "https://www.aptlab.net/"))

(define tb (lambda () (if (cl?) "CloudLab" "Apt")))
38

39 40 41 42
; We want the 'version' to be the date of the most recent commit
(define apt-version
  (with-output-to-string
    (lambda () (system "git show -s --date=short --format='%cd (%h)' HEAD"))))
43

44 45
; Arbitrary width that works reasonably well with the manual class's main
; column width
46 47 48 49 50 51
(define screenshot-width 650)

(define apturl
  (case-lambda
    [() apt-base-url]
    [(page) (string-append apt-base-url page)]))
Robert Ricci's avatar
Robert Ricci committed
52

53
(define (TODO . what)
54
  (bold "TODO: " (decode-content what)))
55 56 57 58 59 60 61 62

(define nodetype
  (lambda (typename howmany . properties)
          (tabular #:style 'boxed #:sep (hspace 3)
                   (cons
                     (list (bold typename)
                           (string-append (number->string howmany) " nodes"))
                     properties))))
63

64 65 66 67 68 69 70 71
(define (screenshot path)
  (let* ([fullpath (string-append "screenshots/" path)]
         [b (make-object bitmap% fullpath)]
         [width (send b get-width)]
         [scale-factor (/ screenshot-width width)])
    (list (image #:scale scale-factor fullpath fullpath) (linebreak))))

(define (instructionstep step #:screenshot [screenshot-path #f] . body)
72 73
  (item (bold (decode-content (list step)))
        (linebreak)
74 75
        (if screenshot-path
          (screenshot  screenshot-path)
76 77
          (void))
        (decode-content body)))
78 79 80

(define (under-construction)
  (bold "This section is under construction"))
81 82 83 84 85

(define (future-work tag)
  (margin-note "There are planned features relating to this section: see \""
               (secref tag)
               "\" for more details."))
86 87 88

(define (ssh)
  (tt "ssh"))