suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'michaellenaghan-master'

Browse Source 
original commit: 503aebf94872e51302f7bca82d963f8a0f501b62
This commit is contained in:
dybvig 2016-05-16 16:25:43 -04:00
commit e27e1fc0a8
1 changed files with 17 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
s/pdhtml.ss
View File

@ -637,8 +637,7 @@
; pseudo tags ; pseudo tags
(define (<doctype>) (define (<doctype>)
(printf "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" (printf "<!DOCTYPE html>\n"))
\"http://www.w3.org/TR/html4/strict.dtd\">\n"))
;;; other helpers ;;; other helpers
(define (html-text-char c) (define (html-text-char c)
@ -748,16 +747,6 @@
(<title> () (html-text "~a" title)) (<title> () (html-text "~a" title))
(newline) (newline)
(display-palette-style palette) (display-palette-style palette)
(newline)
(<script> ([language "javascript"] [type "text/javascript"])
(printf
"<!--\n~
function openInWin(fn,name) {\n~
var w = window.open(fn, name);\n~
w.focus();\n~
return false;\n~
}\n~
-->\n"))
(newline)) (newline))
(newline) (newline)
(let () body1 body2 ...) (let () body1 body2 ...)
@ -836,14 +825,15 @@
(begin (set-port-position! ip 0) n) (begin (set-port-position! ip 0) n)
(loop (if bol? (+ n 1) n) (char=? c #\newline)))))) (loop (if bol? (+ n 1) n) (char=? c #\newline))))))
(<table> () (<table> ()
(<tr> ()
(<td> ([style (format "color: ~a; text-align: right; padding-right: 1em" color)]) (<td> ([style (format "color: ~a; text-align: right; padding-right: 1em" color)])
(<pre> () (<pre> ()
(unless (fx= line-count 0) (unless (fx= line-count 0)
(newline) (newline)
(let loop ([i 1]) (let loop ([i 1])
(<a> ([name (format "line~d" i)]) (html-text "~s\n" i)) (<span> ([id (format "line~d" i)]) (html-text "~s\n" i))
(unless (fx= i line-count) (loop (fx+ i 1))))))) (unless (fx= i line-count) (loop (fx+ i 1)))))))
(<td> () (th))))] (<td> () (th)))))]
[else (th)]))])) [else (th)]))]))
(with-html-file who palette (filedata-htmlpath fdata) (port-name ip) (with-html-file who palette (filedata-htmlpath fdata) (port-name ip)
(<body> ([class (color-class 0)]) (<body> ([class (color-class 0)])
@ -986,7 +976,7 @@
(<table> () (<table> ()
(<tr> () (<tr> ()
(newline) (newline)
(<td> ([valign "top"]) (<td> ([style "vertical-align: top"])
(<p> ([style "margin-bottom: 0"]) (<p> ([style "margin-bottom: 0"])
(<b> () (html-text "Legend:"))) (<b> () (html-text "Legend:")))
(newline) (newline)
@ -1037,9 +1027,7 @@
(nbsp) (nbsp)
(if ip (if ip
(<a> ([href (filedata-htmlfn fdata)] (<a> ([href (filedata-htmlfn fdata)]
[onclick (format "return openInWin('~a', '~a');" [target (filedata-winid fdata)]
(filedata-htmlfn fdata)
(filedata-winid fdata))]
[class (color-class (filedata-ci fdata))]) [class (color-class (filedata-ci fdata))])
(html-text "~a" (port-name (filedata-ip fdata)))) (html-text "~a" (port-name (filedata-ip fdata))))
(html-text "~a" (html-text "~a"
@ -1055,7 +1043,7 @@
(newline) (newline)
(<td> ([style "width: 10em"])) (<td> ([style "width: 10em"]))
(newline) (newline)
(<td> ([valign "top"]) (<td> ([style "vertical-align: top"])
(<p> ([style "margin-bottom: 0"]) (<p> ([style "margin-bottom: 0"])
(<b> () (html-text "Hot spots:"))) (<b> () (html-text "Hot spots:")))
(newline) (newline)
@ -1098,9 +1086,7 @@
(filedata-htmlfn fdata) (filedata-htmlfn fdata)
line)]) line)])
(<a> ([href url] (<a> ([href url]
[onclick (format "return openInWin('~a', '~a');" [target (filedata-winid fdata)]
url
(filedata-winid fdata))]
[style "text-decoration: underline"] [style "text-decoration: underline"]
[class (color-class (entrydata-ci entry))]) [class (color-class (entrydata-ci entry))])
(html-text "~a line ~s (~:d)" (html-text "~a line ~s (~:d)"