defs.rkt 5.43 KB
Newer Older
1
#lang racket/base
Robert Ricci's avatar
Robert Ricci committed
2
(require scribble/base)
3
(require scribble/core)
4
(require scribble/decode)
5
(require scribble/manual)
6
(require scribble/private/defaults)
7 8
(require scribble/html-properties)
(require scribble/latex-properties)
9 10
(require racket/class)
(require racket/draw)
11 12
(require racket/system)
(require racket/port)
13
(require racket/vector)
14
(require racket/file)
15 16 17

(provide (all-defined-out))

18
(define main-style
19
  (make-style "main-body"
20 21 22
              (list (js-style-addition "highlight.pack.js")
                    (make-css-addition "highlight-default.css"))))

23
; Check to see if we are building Apt or CloudLab documentation
Gary Wong's avatar
Gary Wong committed
24 25 26 27 28 29
(define tb-mode
  (cond
   ((vector-member "clab" (current-command-line-arguments))
    'clab)
   ((vector-member "pnet" (current-command-line-arguments))
    'pnet)
Gary Wong's avatar
Gary Wong committed
30 31
   ((vector-member "elab" (current-command-line-arguments))
    'elab)
Gary Wong's avatar
Gary Wong committed
32
   (else 'apt)))
33

34
(define (apt?) (if (equal? tb-mode 'apt) #t #f))
35
(define (clab?)  (if (equal? tb-mode 'clab) #t #f))
Gary Wong's avatar
Gary Wong committed
36
(define (pnet?)  (if (equal? tb-mode 'pnet) #t #f))
Gary Wong's avatar
Gary Wong committed
37
(define (elab?)  (if (equal? tb-mode 'elab) #t #f))
38

39 40 41 42 43 44 45 46
; Check to see if we are building for web or PDF; there is probably some
; nicer way to do this by inspecting the scribble/run state directly, but
; I haven't figured it out
(define doc-mode
    (if (vector-member "pdf" (current-command-line-arguments))
      'pdf
      'html))

Gary Wong's avatar
Gary Wong committed
47
(define (apt-vs-clab #:apt [apt-version (list)] #:clab [clab-version (list)] #:pnet [pnet-version (list)] #:elab [elab-version (list)])
Gary Wong's avatar
Gary Wong committed
48 49 50
  (case tb-mode
	('apt apt-version)
	('clab clab-version)
Gary Wong's avatar
Gary Wong committed
51 52
	('pnet pnet-version)
	('elab elab-version)))
53

Gary Wong's avatar
Gary Wong committed
54
(define (apt-vs-clab* #:apt [apt-version ""] #:clab [clab-version ""] #:pnet [pnet-version ""] #:elab [elab-version ""])
Gary Wong's avatar
Gary Wong committed
55 56 57
  (decode-flow (list (case tb-mode
			   ('apt apt-version)
			   ('clab clab-version)
Gary Wong's avatar
Gary Wong committed
58 59
			   ('pnet pnet-version)
			   ('elab elab-version)))))
60

61
(define (apt-only . stuff)
62
  (apt-vs-clab #:apt stuff))
63

64
(define (clab-only . stuff)
65
  (apt-vs-clab #:clab stuff))
66

Gary Wong's avatar
Gary Wong committed
67 68 69
(define (pnet-only . stuff)
  (apt-vs-clab #:pnet stuff))

Gary Wong's avatar
Gary Wong committed
70 71 72
(define (elab-only . stuff)
  (apt-vs-clab #:elab stuff))

73
(define apt-base-url
Gary Wong's avatar
Gary Wong committed
74 75 76
  (case tb-mode
	('apt "https://www.aptlab.net/")
	('clab "https://www.cloudlab.us/")
Gary Wong's avatar
Gary Wong committed
77 78
	('pnet "https://www.phantomnet.org/")
	('elab "https://www.emulab.net/")))
79

80
(define apt-doc-url
Gary Wong's avatar
Gary Wong committed
81 82 83
  (case tb-mode
	('apt "http://docs.aptlab.net/")
	('clab "http://docs.cloudlab.us/")
Gary Wong's avatar
Gary Wong committed
84 85
	('pnet "http://docs.phantomnet.org/")
	('pnet "http://docs.emulab.net/")))
Gary Wong's avatar
Gary Wong committed
86 87 88 89 90

(define forum-url
  (case tb-mode
	('apt "https://groups.google.com/forum/#!forum/apt-users")
	('clab "https://groups.google.com/forum/#!forum/cloudlab-users")
Gary Wong's avatar
Gary Wong committed
91 92
	('pnet "https://groups.google.com/forum/#!forum/phantomnet-users")
	('elab "https://groups.google.com/forum/#!forum/emulab-users")))
Gary Wong's avatar
Gary Wong committed
93 94 95 96

(define tb (lambda () (case tb-mode
			    ('apt "Apt")
			    ('clab "CloudLab")
Gary Wong's avatar
Gary Wong committed
97 98
			    ('pnet "PhantomNet")
			    ('elab "Emulab"))))
99

100 101 102 103
; 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"))))
104

105 106
; Arbitrary width that works reasonably well with the manual class's main
; column width
107 108 109 110 111 112
(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
113

114
(define (TODO . what)
115
  (bold "TODO: " (decode-content what)))
116 117

(define nodetype
118
  (lambda (typename howmany summary . properties)
119 120 121
          (tabular #:style 'boxed #:sep (hspace 3)
                   (cons
                     (list (bold typename)
122
                           (string-append (number->string howmany) " nodes" " (" summary ")"))
123
                     properties))))
124

125
(define (screenshot path)
126 127
  (let* ([aptpath (string-append "screenshots/apt/" path)]
         [clabpath (string-append "screenshots/clab/" path)]
Gary Wong's avatar
Gary Wong committed
128
         [pnetpath (string-append "screenshots/pnet/" path)]
Gary Wong's avatar
Gary Wong committed
129
         [elabpath (string-append "screenshots/elab/" path)]
Gary Wong's avatar
Gary Wong committed
130 131 132 133 134 135 136 137 138
         [fullpath (case tb-mode
			 ('apt aptpath)
			 ('clab
			  (if (file-exists? clabpath)
			      clabpath
			    (cdr (cons (displayln (string-append "WARNING: CloudLab missing screenshot " path)) aptpath))))
			 ('pnet
			  (if (file-exists? pnetpath)
			      pnetpath
Gary Wong's avatar
Gary Wong committed
139 140 141 142 143
			    (cdr (cons (displayln (string-append "WARNING: PhantomNet missing screenshot " path)) aptpath))))
			 ('elab
			  (if (file-exists? elabpath)
			      pnetpath
			    (cdr (cons (displayln (string-append "WARNING: Emulab missing screenshot " path)) aptpath)))))]
144 145
         [b (make-object bitmap% fullpath)]
         [width (send b get-width)]
146
         [scale-factor (* 1.0 (/ screenshot-width width))])
147 148 149
    (list (image #:scale scale-factor fullpath fullpath) (linebreak))))

(define (instructionstep step #:screenshot [screenshot-path #f] . body)
150 151
  (item (bold (decode-content (list step)))
        (linebreak)
152
        (decode-flow body)
153 154
        (if screenshot-path
          (screenshot  screenshot-path)
155
          (void))))
156 157 158

(define (under-construction)
  (bold "This section is under construction"))
159 160 161 162 163

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

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

168 169 170 171 172
(define code-sample-style
  (make-style "code-sample"
              (list (make-css-addition "code-sample.css")
                    (make-tex-addition "code-sample.tex"))))

173
(define (code-sample filename)
174
  (elem #:style code-sample-style (file->string (string-append "code-samples/" filename))))