Merge branch 'master' of github.com:cisco/chezscheme

original commit: feea4550cc6818b529ceb808c6a31a244a6a227b

LOG

@@ -256,6 +256,15 @@
 - fixed three instances of unchecked mallocs reported by laqrix in
   github issue #77.
     io.c, schlib.c, thread.c
+- continue the profiler's html output refresh: refine the styling
+  (and palette) and update CSUG to match. update the CSUG screenshots
+  to reflect the refined look.
+    s/pdhtml.ss
+    csug/system.stex 
+    csug/canned/profilehtml-orig.png
+    csug/canned/profilehtml.png
+    csug/canned/fatfibhtml-orig.png
+    csug/canned/fatfibhtml.png
 - add unicode support to the expression editor.  entry and display now work
   except that combining characters are not treated correctly for
   line-wrapping.  this addresses github issue #32 and part of issue #81.

csug/system.stex

@@ -1,11 +1,11 @@
 % Copyright 2005-2016 Cisco Systems, Inc.
-% 
+%
 % Licensed under the Apache License, Version 2.0 (the "License");
 % you may not use this file except in compliance with the License.
 % You may 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.
@@ -175,7 +175,7 @@ console error port.
 For non-serious warning conditions, it returns immediately after displaying
 the condition.
 
-For serious or other non-warning conditions, it 
+For serious or other non-warning conditions, it
 saves the condition in the parameter \scheme{debug-condition}, where
 \scheme{debug} (Section~\ref{SECTDEBUGINTERACTIVE}) can retrieve it and
 allow it to be inspected.
@@ -362,7 +362,7 @@ The example below shows how to install a keyboard-interrupt handler
 that resets without invoking the debugger.
 
 \schemedisplay
-(keyboard-interrupt-handler 
+(keyboard-interrupt-handler
   (lambda ()
     (newline (console-output-port))
     (reset)))
@@ -535,7 +535,7 @@ Environments may be provided as optional arguments to \scheme{eval},
 \scheme{expand}, and the procedures that define, assign, or
 reference top-level values.
 
-There are several built-in environments, and new environments can 
+There are several built-in environments, and new environments can
 be created by copying existing environments or selected bindings
 from existing environments.
 
@@ -2231,8 +2231,8 @@ While the compiler produces the same code for optimize levels 0--2,
 user-defined macro transformers can differentiate among the different
 levels if desired.
 
-One way to use optimize levels is on a per-file 
+One way to use optimize levels is on a per-file
-basis, using \index{\scheme{eval-when}}\scheme{eval-when} to force the use of a particular 
+basis, using \index{\scheme{eval-when}}\scheme{eval-when} to force the use of a particular
 optimize level at compile time.
 For example, placing:
 
@@ -2241,9 +2241,9 @@ For example, placing:
 \endschemedisplay
 
 \noindent
-at the front of a file will cause all of the forms in the file to be 
+at the front of a file will cause all of the forms in the file to be
-compiled at optimize level 3 when the file is compiled (using 
+compiled at optimize level 3 when the file is compiled (using
-\index{\scheme{compile-file}}\scheme{compile-file}) but does not affect the optimize level used 
+\index{\scheme{compile-file}}\scheme{compile-file}) but does not affect the optimize level used
 when the file is loaded from source.
 Since \scheme{compile-file} parameterizes \scheme{optimize-level} (see \scheme{parameterize}),
 the above
@@ -2607,7 +2607,7 @@ with the outer unroll limit set to one.
 
 Interesting effects can be had by varying several of these parameters at
 once.
-For example, setting the 
+For example, setting the
 effort and outer unroll limits to large values and the score limit
 to \scheme{1} has the effect of inlining even complex recursive procedures
 whose values turn out to be constant at compile time without risking
@@ -3068,7 +3068,7 @@ three pairs.
 The car of each pair is a background color and the cdr is a foreground
 (text) color.
 Each color must be a string, and each string should contain an HTML
-cascading style sheet (css) color specifier.
+cascading style sheet (CSS) color specifier.
 The first pair is used for unprofiled code, and the second is used
 for unexecuted profiled code.
 The third is used for code that is executed least frequently, the fourth
@@ -3085,17 +3085,17 @@ frequently executed code.
 
 \schemedisplay
 (profile-palette) ;=>
-  #(("black" . "white") ("#666666" . "white")
+  #(("#111111" . "white") ("#607D8B" . "white")
-    ("#A000C8" . "black") ("#8200DC" . "white")
+    ("#9C27B0" . "black") ("#673AB7" . "white")
-    ("#1E3CFF" . "white") ("#00A0FF" . "black")
+    ("#3F51B5" . "white") ("#2196F3" . "black")
-    ("#00D28C" . "black") ("#00DC00" . "black")
+    ("#00BCD4" . "black") ("#4CAF50" . "black")
-    ("#A0E632" . "black") ("#E6DC32" . "black")
+    ("#CDDC39" . "black") ("#FFEB3B" . "black")
-    ("#E6AF2D" . "black") ("#F08228" . "black")
+    ("#FFC107" . "black") ("#FF9800" . "black")
-    ("#FA3C3C" . "white"))
+    ("#F44336" . "white"))
 (profile-palette
  ; set palette with rainbow colors and black text
  ; for all but unprofiled or unexecuted code
-  '#(("black" . "white")      ; black
+  '#(("#000000" . "white")    ; black
      ("#666666" . "white")    ; gray
      ("#8B00FF" . "black")    ; violet
      ("#6600FF" . "black")    ; indigo
@@ -3113,7 +3113,7 @@ frequently executed code.
 \endentryheader
 
 This value of this parameter must be a string or \scheme{#f}.
-If it is a string, the string should contain an HTML cascading style sheet (css)
+If it is a string, the string should contain an HTML cascading style sheet (CSS)
 color specifier.
 If the parameter is set to string, \scheme{profile-dump-html} includes line numbers
 in its html rendering of each source file, using the specified color.
@@ -3137,7 +3137,7 @@ has been executed.
 
 \begin{itemize}
  \item execution count
- \item pathname 
+ \item pathname
  \item beginning file position in characters (inclusive)
  \item ending file position in characters (exclusive)
  \item line number of beginning file position
@@ -4124,7 +4124,7 @@ UTC may be obtained by passing an offset of zero.
 (date->time-utc d) ;=> #<time-utc 1190552850.000000000>
 (define t (make-time 'time-utc 0 1190552850))
 (time-utc->date t) ;=> #<date Sun Sep 23 09:07:30 2007>
-(time-utc->date t 0) ;=> #<date Sun Sep 23 13:07:30 2007> 
+(time-utc->date t 0) ;=> #<date Sun Sep 23 13:07:30 2007>
 \endschemedisplay
 
 %----------------------------------------------------------------------------
@@ -4328,11 +4328,11 @@ statistics into a single \scheme{sstats} record.
 A \scheme{sstats} record has the following fields:
 
 \begin{description}
-\item[\scheme{cpu},] the cpu time consumed, 
+\item[\scheme{cpu},] the cpu time consumed,
-\item[\scheme{real},] the elapsed real time, 
+\item[\scheme{real},] the elapsed real time,
 \item[\scheme{bytes},] the number of bytes allocated,
 \item[\scheme{gc-count},] the number of collections,
-\item[\scheme{gc-cpu},] the cpu time consumed during collections, 
+\item[\scheme{gc-cpu},] the cpu time consumed during collections,
 \item[\scheme{gc-real},] the elapsed real time during collections, and
 \item[\scheme{gc-bytes},] the number of bytes reclaimed by the collector.
 \end{description}
@@ -5021,4 +5021,3 @@ Setting \scheme{subset-mode} to \scheme{system} allows the manipulation
 of various undocumented system variables, data structures, and
 settings.
 It is typically used only for system debugging.
-

s/pdhtml.ss

@@ -746,7 +746,7 @@
                        (newline)
                        (<title> () (html-text "~a" title))
                        (newline)
-                       (display-palette-style palette)
+                       (display-style-with-palette palette)
                        (newline))
                      (newline)
                      (let () body1 body2 ...)
@@ -826,7 +826,7 @@
                               (loop (if bol? (+ n 1) n) (char=? c #\newline))))))
                     (<table> ()
                       (<tr> ()
-                        (<td> ([style (format "color: ~a; text-align: right; padding-right: 1em" color)])
+                        (<td> ([style (format "color: ~a; font-weight: bold; padding-right: 1rem; text-align: right" color)])
                           (<pre> ()
                             (unless (fx= line-count 0)
                               (newline)
@@ -838,6 +838,9 @@
         (with-html-file who palette (filedata-htmlpath fdata) (port-name ip)
           (<body> ([class (color-class 0)])
             (newline)
+            (<h1> ([style "margin-bottom: 1rem"])
+              (html-text "~a" (port-name ip)) (<span> ([style "opacity: 0.5"]) (html-text " on ~a" (date-and-time))))
+            (newline)
             (with-line-numbers
               (<pre> ()
                 (newline)
@@ -867,13 +870,73 @@
       (lambda (ci)
         (format "pc~s" ci)))
 
-    (define (display-palette-style palette)
+    (define (display-style-with-palette palette)
       (<style> ([type "text/css"])
         (newline)
+
+        ;; CSS Reset Styling
+
+        ;; See https://perishablepress.com/a-killer-collection-of-global-css-reset-styles/ for an overview
+        ;; of CSS resets.
+        ;;
+        ;; See http://code.stephenmorley.org/html-and-css/fixing-browsers-broken-monospace-font-handling/
+        ;; for an explanation of "font-family: monospace, monospace;" and the following "font-size: 1rem;".
+        ;;
+        (printf "* {")
+        (printf " border: 0;")
+        (printf " margin: 0;")
+        (printf " outline: 0;")
+        (printf " padding: 0;")
+        (printf " vertical-align: baseline;")
+        (printf " }\n")
+        (printf "code, kbd, pre, samp {")
+        (printf " font-family: monospace, monospace;")
+        (printf " font-size: 1rem;")
+        (printf " }\n")
+        (printf "html {")
+        (printf " -moz-osx-font-smoothing: grayscale;")
+        (printf " -webkit-font-smoothing: antialiased;")
+        (printf " }\n")
+        (printf "table {")
+        (printf " border-collapse: collapse;")
+        (printf " border-spacing: 0;")
+        (printf " }\n")
+
+        ;; CSS Base Styling
+
+        (printf "body {")
+        (printf " padding: 1rem;")
+        (printf " }\n")
+        (printf "h1, h2, h3, h4 {")
+        (printf " line-height: 1.25;")
+        (printf " margin-bottom: 0.5rem;")
+        (printf " }\n")
+        (printf "h1 {")
+        (printf " font-size: 1.296rem;")
+        (printf " }\n")
+        (printf "h2 {")
+        (printf " font-size: 1.215rem;")
+        (printf " }\n")
+        (printf "h3 {")
+        (printf " font-size: 1.138rem;")
+        (printf " }\n")
+        (printf "h4 {")
+        (printf " font-size: 1.067rem;")
+        (printf " }\n")
+        (printf "html {")
+        (printf " font-family: monospace, monospace;")
+        (printf " font-size: 1rem;")
+        (printf " }\n")
+        (printf "p {")
+        (printf " margin-bottom: 1.25rem;")
+        (printf " }\n")
+
+        ;; CSS Profile Styling
+
         (do ([ci 0 (fx+ ci 1)])
             ((fx= ci (vector-length palette)))
           (let ([color (vector-ref palette ci)])
-            (printf ".~a {background-color: ~a; color: ~a; white-space: nowrap}\n"
+            (printf ".~a { background-color: ~a; color: ~a; white-space: nowrap; }\n"
               (color-class ci) (car color) (cdr color))))))
 
     (define (safe-prefix name name*)
@@ -969,18 +1032,17 @@
                (with-html-file who palette (format "~aprofile.html" path-prefix) "Profile Output"
                  (<body> ([class (color-class 0)])
                    (newline)
-                   (<h3> () (html-text "Profile Output"))
+                   (<h1> ([style "margin-bottom: 1rem"])
-                   (newline)
+                     (html-text "Profile Output") (<span> ([style "opacity: 0.5"]) (html-text " on ~a" (date-and-time))))
-                   (<p> () (html-text "~a" (date-and-time)))
                    (newline)
                    (<table> ()
                      (<tr> ()
                        (newline)
                        (<td> ([style "vertical-align: top"])
-                         (<p> ([style "margin-bottom: 0"])
+                         (<h2> ([style "margin-bottom: 0.25rem"])
-                           (<b> () (html-text "Legend:")))
+                           (html-text "Legend"))
                          (newline)
-                         (<table> ([style "margin-left: 1em"])
+                         (<table> ([style "margin-bottom: 1rem"])
                            (newline)
                            (let* ([n (vector-length palette)] [v (make-vector n #f)])
                              (for-each
@@ -1002,37 +1064,35 @@
                                (let ([p (vector-ref v ci)])
                                  (when p
                                    (<tr> ()
-                                     (<td> ([class (color-class ci)])
+                                     (<td> ([class (color-class ci)]
-                                       (nbsp)
+                                            [style "padding: 0.5rem"])
                                        (let ([smin (readable-number (car p))]
                                              [smax (readable-number (cdr p))])
                                          (if (string=? smin smax)
                                              (html-text "executed ~a time~p"
                                                smin (car p))
                                              (html-text "executed ~a-~a times"
-                                               smin smax)))
+                                               smin smax)))))
-                                       (nbsp)))
                                    (newline))))))
                          (newline)
-                         (<p> ([style "margin-bottom: 0"])
+                         (<h2> ([style "margin-bottom: 0.25rem"])
-                           (<b> () (html-text "Files:")))
+                           (html-text "Files"))
                          (newline)
-                         (<table> ([style "margin-left: 1em"])
+                         (<table> ([style "margin-bottom: 1rem"])
                            (newline)
                            (for-each
                              (lambda (fdata)
                                (let ([ip (filedata-ip fdata)])
                                  (<tr> ()
-                                   (<td> ([class (color-class (filedata-ci fdata))])
+                                   (<td> ([class (color-class (filedata-ci fdata))]
-                                     (nbsp)
+                                          [style "padding: 0.5rem"])
                                      (if ip
                                          (<a> ([href (filedata-htmlfn fdata)]
                                                [target (filedata-winid fdata)]
                                                [class (color-class (filedata-ci fdata))])
                                            (html-text "~a" (port-name (filedata-ip fdata))))
                                          (html-text "~a"
-                                           (source-file-descriptor-name (filedata-sfd fdata))))
+                                           (source-file-descriptor-name (filedata-sfd fdata))))))
-                                     (nbsp)))
                                  (newline)
                                  (when ip (display-file who palette fdata))))
                              (sort
@@ -1041,13 +1101,13 @@
                                     (filedata-max-count y)))
                                fdata*))))
                        (newline)
-                       (<td> ([style "width: 10em"]))
+                       (<td> ([style "width: 10rem"]))
                        (newline)
                        (<td> ([style "vertical-align: top"])
-                         (<p> ([style "margin-bottom: 0"])
+                         (<h2> ([style "margin-bottom: 0.25rem"])
-                           (<b> () (html-text "Hot spots:")))
+                           (html-text "Hot Spots"))
                          (newline)
-                         (<table> ([style "margin-left: 1em"])
+                         (<table> ([style "margin-bottom: 1rem"])
                            (newline)
                            (let loop ([entry*
                                        (sort
@@ -1077,8 +1137,8 @@
                                               (= count last-count)
                                               (= line last-line))
                                    (<tr> ()
-                                     (<td> ([class (color-class (entrydata-ci entry))])
+                                     (<td> ([class (color-class (entrydata-ci entry))]
-                                       (nbsp)
+                                            [style "padding: 0.5rem"])
                                        (cond
                                          [(filedata-ip fdata) =>
                                           (lambda (ip)
@@ -1096,8 +1156,7 @@
                                           (html-text "~a char ~s (~:d)"
                                             (source-file-descriptor-name (filedata-sfd fdata))
                                             (entrydata-bfp entry)
-                                            (entrydata-count entry))])
+                                            (entrydata-count entry))])))
-                                       (nbsp)))
                                    (newline))
                                  (loop (cdr entry*) htmlfn count line)))))
                          (newline))
@@ -1110,19 +1169,19 @@
   (set-who! profile-palette
     (make-parameter
      ; color background with appropriate white or black foreground
-      '#(("black"   . "white")  ; black (for unprofiled code)
+      '#(("#111111" . "white")  ; black (for unprofiled code)
-         ("#666666" . "white")  ; gray  (for unexecuted code)
+         ("#607D8B" . "white")  ; gray  (for unexecuted code)
-         ("#A000C8" . "black")  ; purple
+         ("#9C27B0" . "black")  ; purple
-         ("#8200DC" . "white")  ; dark purple
+         ("#673AB7" . "white")  ; dark purple
-         ("#1E3CFF" . "white")  ; dark blue
+         ("#3F51B5" . "white")  ; dark blue
-         ("#00A0FF" . "black")  ; medium blue
+         ("#2196F3" . "black")  ; medium blue
-         ("#00D28C" . "black")  ; aqua
+         ("#00BCD4" . "black")  ; aqua
-         ("#00DC00" . "black")  ; green
+         ("#4CAF50" . "black")  ; green
-         ("#A0E632" . "black")  ; yellow green
+         ("#CDDC39" . "black")  ; yellow green
-         ("#E6DC32" . "black")  ; yellow
+         ("#FFEB3B" . "black")  ; yellow
-         ("#E6AF2D" . "black")  ; darkyellow
+         ("#FFC107" . "black")  ; dark yellow
-         ("#F08228" . "black")  ; orange
+         ("#FF9800" . "black")  ; orange
-         ("#FA3C3C" . "white")) ; red
+         ("#F44336" . "white")) ; red
       (lambda (palette)
         (unless (and (vector? palette)
                      (andmap