[m-rev.] for post-commit review: colouring column groups
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Aug 6 18:10:52 AEST 2008
For post-commit review by Paul.
Zoltan.
Implement the colouring of column groups.
deep_profiler/display.m:
Modify the types representing tables to allow some column groups
to specify that the column classes they represent should affect the
style in which that column is rendered. Refactor the table_header_group
type to avoid representing this information, and the column class,
in a redundant manner.
Avoid abbrevations in some type names and function symbols.
deep_profiler/display_report.m:
Conform to the change in the representation of tables.
Use more consistent variable names.
deep_profiler/html_format.m:
When a table column group's header asks for it, set up the background
colour of the columns in that group so that alternating column groups
have different backgrounds.
Instead of representing the CSS as a single constant string, we
now represent it as a map that we update from a default when we
construct the body of the page.
Implement Paul's review suggestions after my last change.
library/cord.m:
NEWS:
Add a utility predicate for use by the new code.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.492
diff -u -b -r1.492 NEWS
--- NEWS 31 Jul 2008 06:34:47 -0000 1.492
+++ NEWS 6 Aug 2008 08:00:47 -0000
@@ -214,8 +214,8 @@
* We have added the predicates `dir.current_directory',
`dir.relative_path_name_from_components'.
-* We have added the predicates split_last, get_first and get_last to the cord
- module.
+* We have added the predicates split_last, get_first, get_last and
+ cord_list_to_cord to the cord module.
* We have added two predicates that are useful for custom term construction:
construct.find_functor/5
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
Index: deep_profiler/display.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/display.m,v
retrieving revision 1.5
diff -u -b -r1.5 display.m
--- deep_profiler/display.m 6 Aug 2008 03:02:47 -0000 1.5
+++ deep_profiler/display.m 6 Aug 2008 07:36:42 -0000
@@ -29,8 +29,8 @@
:- type display
---> display(
- title :: maybe(string),
- content :: list(display_item)
+ display_title :: maybe(string),
+ display_content :: list(display_item)
).
:- type display_item
@@ -66,36 +66,48 @@
% multiple sub-header cells.
table_num_cols :: int,
- % Header row of table.
+ % The header row of the table.
table_header :: maybe(table_header),
- % The data in table.
+ % The data in the table.
table_rows :: list(table_row)
).
:- type table_header
---> table_header(
- th_cells :: list(table_header_cell)
+ th_groups :: list(table_header_group)
).
-:- type table_header_cell
- ---> table_header_cell(
+:- type table_header_group
+ ---> table_header_group(
% The table contents.
- thc_contents :: table_data,
+ thg_titles :: table_header_group_columns,
% The class may be used by a layout to make decisions
% about how to paint this column.
- thc_class :: table_col_class
- )
- ; table_header_group(
- thg_title :: string,
- thg_subtitles :: list(table_data),
+ thg_class :: table_column_class,
- % The class may be used by a layout to make decisions
- % about how to paint this column.
- thg_class :: table_col_class
+ thg_set_style :: table_set_style
).
+:- type table_header_group_columns
+ ---> table_header_group_single(
+ % The header of the single column in the group.
+ thsc_title :: table_data
+ )
+ ; table_header_group_multi(
+ % The spanning header, which applies to all columns
+ % in the group.
+ thmc_title :: string,
+
+ % The headers of the individual columns in the group.
+ thmc_subtitles :: list(table_data)
+ ).
+
+:- type table_set_style
+ ---> table_set_style
+ ; table_do_not_set_style.
+
:- type table_row
---> table_row(
tr_cells :: list(table_cell)
@@ -114,16 +126,16 @@
---> table_class_plain
; table_class_boxed.
-:- type table_col_class
- ---> table_col_class_allocations
- ; table_col_class_callseqs
- ; table_col_class_memory
- ; table_col_class_no_class
- ; table_col_class_number
- ; table_col_class_ordinal_rank
- ; table_col_class_port_counts
- ; table_col_class_proc
- ; table_col_class_ticks_and_times.
+:- type table_column_class
+ ---> table_column_class_allocations
+ ; table_column_class_callseqs
+ ; table_column_class_memory
+ ; table_column_class_no_class
+ ; table_column_class_number
+ ; table_column_class_ordinal_rank
+ ; table_column_class_port_counts
+ ; table_column_class_proc
+ ; table_column_class_ticks_and_times.
% Table data can be specified by type to allow formatting, for example
% to align decimal points.
@@ -146,6 +158,12 @@
; td_s(string)
; td_t(time).
+:- func make_single_table_header_group(table_data,
+ table_column_class, table_set_style) = table_header_group.
+
+:- func make_multi_table_header_group(string, list(table_data),
+ table_column_class, table_set_style) = table_header_group.
+
%-----------------------------------------------------------------------------%
%
% List specific structures
@@ -185,18 +203,20 @@
% Predicates for working with display structures.
%
- % If given a header, this predicate adds it to the end of the cord
- % and adds the correct number of columns to the column count.
+ % If given a header for a (group of) columns, this predicate adds it
+ % to the end of the cord and adds the correct number of columns
+ % to the column count.
%
-:- pred table_maybe_add_header_col(maybe(table_header_cell)::in,
- cord(table_header_cell)::in, cord(table_header_cell)::out,
+:- pred table_maybe_add_header_group(maybe(table_header_group)::in,
+ cord(table_header_group)::in, cord(table_header_group)::out,
int::in, int::out) is det.
- % Given a header, this predicate adds it to the end of the cord
- % and adds the correct number of columns to the column count.
+ % Given a header for a (group of) columns, this predicate adds it
+ % to the end of the cord and adds the correct number of columns
+ % to the column count.
%
-:- pred table_add_header_col(table_header_cell::in,
- cord(table_header_cell)::in, cord(table_header_cell)::out,
+:- pred table_add_header_group(table_header_group::in,
+ cord(table_header_group)::in, cord(table_header_group)::out,
int::in, int::out) is det.
%-----------------------------------------------------------------------------%
@@ -204,22 +224,41 @@
:- implementation.
+:- import_module assoc_list.
:- import_module int.
+:- import_module pair.
-table_maybe_add_header_col(no, !Cols, !NumCols).
-table_maybe_add_header_col(yes(HeaderCol), !Cols, !NumCols) :-
- table_add_header_col(HeaderCol, !Cols, !NumCols).
+%-----------------------------------------------------------------------------%
+
+make_single_table_header_group(ColumnTitle, ColumnClass, SetStyle) =
+ table_header_group(table_header_group_single(ColumnTitle),
+ ColumnClass, SetStyle).
+
+make_multi_table_header_group(MainTitle, SubTitles, ColumnClass, SetStyle) =
+ table_header_group(table_header_group_multi(MainTitle, SubTitles),
+ ColumnClass, SetStyle).
+
+%-----------------------------------------------------------------------------%
+
+table_maybe_add_header_group(MaybeHeaderGroup, !HeaderGroups, !NumColumns) :-
+ (
+ MaybeHeaderGroup = yes(HeaderGroup),
+ table_add_header_group(HeaderGroup, !HeaderGroups, !NumColumns)
+ ;
+ MaybeHeaderGroup = no
+ ).
-table_add_header_col(Cell, !Cols, !NumCols) :-
+table_add_header_group(HeaderGroup, !HeaderGroups, !NumColumns) :-
+ HeaderGroup = table_header_group(ColumnTitles, _, _),
(
- Cell = table_header_cell(_, _),
- CellCols = 1
+ ColumnTitles = table_header_group_single(_),
+ GroupColumns = 1
;
- Cell = table_header_group(_, SubHeaders, _),
- list.length(SubHeaders, CellCols)
+ ColumnTitles = table_header_group_multi(_, SubTitles),
+ list.length(SubTitles, GroupColumns)
),
- !:Cols = cord.snoc(!.Cols, Cell),
- !:NumCols = !.NumCols + CellCols.
+ !:HeaderGroups = cord.snoc(!.HeaderGroups, HeaderGroup),
+ !:NumColumns = !.NumColumns + GroupColumns.
%-----------------------------------------------------------------------------%
:- end_module display.
Index: deep_profiler/display_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/display_report.m,v
retrieving revision 1.6
diff -u -b -r1.6 display_report.m
--- deep_profiler/display_report.m 6 Aug 2008 03:02:47 -0000 1.6
+++ deep_profiler/display_report.m 6 Aug 2008 07:37:17 -0000
@@ -316,17 +316,19 @@
MainRows = list.map(make_labelled_table_row, MainValues),
MainTable = table(table_class_plain, 2, no, MainRows),
+ MainTableItem = display_table(MainTable),
+
+ CallSitesTitle = "Call site dynamics:",
+ CallSitesTitleItem = display_message(CallSitesTitle),
list.map_foldl(dump_psd_call_site(Prefs), CallSites, CallSitesRowsList,
counter.init(1), _),
list.condense(CallSitesRowsList, CallSitesRows),
- CallSitesTitle = "Call site dynamics:",
- CallSitesTable =
- table(table_class_plain, 2, no, CallSitesRows),
+ CallSitesTable = table(table_class_plain, 2, no, CallSitesRows),
+ CallSitesTableItem = display_table(CallSitesTable),
Display = display(yes(Title),
- [display_table(MainTable), display_message(CallSitesTitle),
- display_table(CallSitesTable)]).
+ [MainTableItem, CallSitesTitleItem, CallSitesTableItem]).
:- pred dump_psd_call_site(preferences::in,
call_site_array_slot::in, list(table_row)::out,
@@ -457,8 +459,7 @@
TableInfo = table_info(table_class_boxed, non_ranked, Prefs, Ordering),
proc_table_header(TableInfo, NumCols, Header),
- perf_table_row(TableInfo, call_site_desc_to_cell,
- RowData, PerfRow, 1, _),
+ perf_table_row(TableInfo, call_site_desc_to_cell, RowData, PerfRow, 1, _),
PerfTable =
table(TableInfo ^ table_class, NumCols, yes(Header), [PerfRow]),
@@ -808,9 +809,9 @@
% Create the table header cell for the timing fields.
%
:- pred proc_table_time_header(table_info::in, fields::in,
- maybe(table_header_cell)::out) is det.
+ maybe(table_header_group)::out) is det.
-proc_table_time_header(TableInfo, Fields, MaybeHeaderCell) :-
+proc_table_time_header(TableInfo, Fields, MaybeHeaderGroup) :-
TimeFields = Fields ^ time_fields,
Self = top_procs_self_link(TableInfo, cost_time),
Time = top_procs_time_link(TableInfo),
@@ -821,7 +822,7 @@
(
TimeFields = no_time,
- MaybeHeaderCell = no
+ MaybeHeaderGroup = no
;
(
TimeFields = ticks,
@@ -849,42 +850,44 @@
[Self, Time, percent_label, SelfPercall,
Total, TotalTime, percent_label, TotalPercall]
),
- MaybeHeaderCell = yes(table_header_group(Title, SubTitles,
- table_col_class_ticks_and_times))
+ HeaderGroup = make_multi_table_header_group(Title, SubTitles,
+ table_column_class_ticks_and_times, table_set_style),
+ MaybeHeaderGroup = yes(HeaderGroup)
).
% Build the ports section of the header if required.
%
:- pred proc_table_ports_header(table_info::in, fields::in,
- maybe(table_header_cell)::out) is det.
+ maybe(table_header_group)::out) is det.
-proc_table_ports_header(TableInfo, Fields, MaybePortsHeader) :-
+proc_table_ports_header(TableInfo, Fields, MaybeHeaderGroup) :-
(
+ Fields ^ port_fields = no_port,
+ MaybeHeaderGroup = no
+ ;
Fields ^ port_fields = port,
Calls = top_procs_make_table_link(TableInfo, "Calls",
cost_calls, self, overall),
Redos = top_procs_make_table_link(TableInfo, "Redos",
cost_redos, self, overall),
- MaybePortsHeader = yes(table_header_group("Port counts",
+ HeaderGroup = make_multi_table_header_group("Port counts",
[Calls, td_s("Exits"), td_s("Fails"), Redos, td_s("Excps")],
- table_col_class_port_counts))
- ;
- Fields ^ port_fields = no_port,
- MaybePortsHeader = no
+ table_column_class_port_counts, table_set_style),
+ MaybeHeaderGroup = yes(HeaderGroup)
).
% Create the table header cell for the call sequence count fields.
%
:- pred proc_table_callseqs_header(table_info::in, fields::in,
- maybe(table_header_cell)::out) is det.
+ maybe(table_header_group)::out) is det.
-proc_table_callseqs_header(TableInfo, Fields, MaybeCallseqsHeader) :-
+proc_table_callseqs_header(TableInfo, Fields, MaybeHeaderGroup) :-
Callseqs = Fields ^ callseqs_fields,
Self = top_procs_self_link(TableInfo, cost_callseqs),
Total = top_procs_total_link(TableInfo, cost_callseqs),
(
Callseqs = no_callseqs,
- MaybeCallseqsHeader = no
+ MaybeHeaderGroup = no
;
(
Callseqs = callseqs,
@@ -899,22 +902,23 @@
[Self, percent_label, SelfPercall,
Total, percent_label, TotalPercall]
),
- MaybeCallseqsHeader = yes(table_header_group("Call sequence numbers",
- SubTitles, table_col_class_callseqs))
+ HeaderGroup = make_multi_table_header_group("Call sequence numbers",
+ SubTitles, table_column_class_callseqs, table_set_style),
+ MaybeHeaderGroup = yes(HeaderGroup)
).
% Build the header for the allocations column group.
%
:- pred proc_table_allocations_header(table_info::in, fields::in,
- maybe(table_header_cell)::out) is det.
+ maybe(table_header_group)::out) is det.
-proc_table_allocations_header(TableInfo, Fields, MaybeHeader) :-
+proc_table_allocations_header(TableInfo, Fields, MaybeHeaderGroup) :-
AllocFields = Fields ^ alloc_fields,
Self = top_procs_self_link(TableInfo, cost_allocs),
Total = top_procs_total_link(TableInfo, cost_allocs),
(
AllocFields = no_alloc,
- MaybeHeader = no
+ MaybeHeaderGroup = no
;
(
AllocFields = alloc,
@@ -929,23 +933,24 @@
[Self, percent_label, SelfPercall,
Total, percent_label, TotalPercall]
),
- MaybeHeader = yes(table_header_group("Memory allocations", SubTitles,
- table_col_class_allocations))
+ HeaderGroup = make_multi_table_header_group("Memory allocations",
+ SubTitles, table_column_class_allocations, table_set_style),
+ MaybeHeaderGroup = yes(HeaderGroup)
).
% Build the header for the memory usage column group.
%
:- pred proc_table_memory_header(table_info::in, fields::in,
- maybe(table_header_cell)::out) is det.
+ maybe(table_header_group)::out) is det.
-proc_table_memory_header(TableInfo, Fields, MaybeHeader) :-
+proc_table_memory_header(TableInfo, Fields, MaybeHeaderGroup) :-
Memory = Fields ^ memory_fields,
Self = top_procs_self_link(TableInfo, cost_words),
Total = top_procs_total_link(TableInfo, cost_words),
Percent = percent_label,
(
Memory = no_memory,
- MaybeHeader = no
+ MaybeHeaderGroup = no
;
(
Memory = memory(Units),
@@ -965,8 +970,9 @@
Units = units_bytes,
Title = "Memory bytes"
),
- MaybeHeader = yes(table_header_group(Title, SubTitles,
- table_col_class_memory))
+ HeaderGroup = make_multi_table_header_group(Title, SubTitles,
+ table_column_class_memory, table_set_style),
+ MaybeHeaderGroup = yes(HeaderGroup)
).
% Build a header for a table of procedures.
@@ -977,37 +983,42 @@
Prefs = TableInfo ^ prefs,
Ranked = TableInfo ^ table_ranked,
Fields = Prefs ^ pref_fields,
+
some [!NumCols, !Cols]
(
!:NumCols = 0,
!:Cols = cord.empty,
+
(
Ranked = ranked,
- RankedHeaderCell =
- table_header_cell(td_s("Rank"), table_col_class_ordinal_rank),
- table_add_header_col(RankedHeaderCell, !Cols, !NumCols)
+ RankedHeaderGroup =
+ make_single_table_header_group(td_s("Rank"),
+ table_column_class_ordinal_rank, table_do_not_set_style),
+ table_add_header_group(RankedHeaderGroup, !Cols, !NumCols)
;
Ranked = non_ranked
),
- ProcHeaderCell =
- table_header_cell(td_s("Procedure"), table_col_class_proc),
- table_add_header_col(ProcHeaderCell, !Cols, !NumCols),
+
+ ProcHeaderGroup =
+ make_single_table_header_group(td_s("Procedure"),
+ table_column_class_proc, table_do_not_set_style),
+ table_add_header_group(ProcHeaderGroup, !Cols, !NumCols),
proc_table_ports_header(TableInfo, Fields, MaybePortsHeader),
- table_maybe_add_header_col(MaybePortsHeader, !Cols, !NumCols),
+ table_maybe_add_header_group(MaybePortsHeader, !Cols, !NumCols),
proc_table_time_header(TableInfo, Fields, MaybeTimeHeader),
- table_maybe_add_header_col(MaybeTimeHeader, !Cols, !NumCols),
+ table_maybe_add_header_group(MaybeTimeHeader, !Cols, !NumCols),
proc_table_callseqs_header(TableInfo, Fields, MaybeCallseqsHeader),
- table_maybe_add_header_col(MaybeCallseqsHeader, !Cols, !NumCols),
+ table_maybe_add_header_group(MaybeCallseqsHeader, !Cols, !NumCols),
proc_table_allocations_header(TableInfo, Fields,
MaybeAllocationsHeader),
- table_maybe_add_header_col(MaybeAllocationsHeader, !Cols, !NumCols),
+ table_maybe_add_header_group(MaybeAllocationsHeader, !Cols, !NumCols),
proc_table_memory_header(TableInfo, Fields, MaybeMemoryHeader),
- table_maybe_add_header_col(MaybeMemoryHeader, !Cols, !NumCols),
+ table_maybe_add_header_group(MaybeMemoryHeader, !Cols, !NumCols),
Header = table_header(cord.list(!.Cols)),
NumCols = !.NumCols
Index: deep_profiler/html_format.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/html_format.m,v
retrieving revision 1.27
diff -u -b -r1.27 html_format.m
--- deep_profiler/html_format.m 6 Aug 2008 03:02:47 -0000 1.27
+++ deep_profiler/html_format.m 6 Aug 2008 07:56:56 -0000
@@ -48,7 +48,7 @@
% profile, for example the name of the Deep.data file to build the URLs
% from.
%
-:- func htmlize_display(deep, display) = html.
+:- func htmlize_display(deep, preferences, display) = html.
%-----------------------------------------------------------------------------%
@@ -172,6 +172,7 @@
:- implementation.
+:- import_module assoc_list.
:- import_module bool.
:- import_module char.
:- import_module exception.
@@ -179,6 +180,7 @@
:- import_module int.
:- import_module map.
:- import_module maybe.
+:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module svmap.
@@ -192,26 +194,43 @@
%-----------------------------------------------------------------------------%
-htmlize_display(Deep, display(MaybeSubTitle, Items)) = HTML :-
+htmlize_display(Deep, Prefs, Display) = HTML :-
+ Display = display(MaybeTitle, Items),
MainTitle = str_to_html("Mercury Deep Profile for ") ++
str_to_html(Deep ^ data_file_name),
(
- MaybeSubTitle = no,
- Title = MainTitle,
+ MaybeTitle = no,
+ HeadTitle = MainTitle,
HeadingHTML = empty_html
;
- MaybeSubTitle = yes(Subtitle),
- SubTitleHTML = str_to_html(Subtitle),
- Title = MainTitle ++ str_to_html(" - ") ++ SubTitleHTML,
- HeadingHTML = wrap_tags("<h3>", "</h3>\n", SubTitleHTML)
+ MaybeTitle = yes(Title),
+ TitleHTML = str_to_html(Title),
+ HeadTitle = MainTitle ++ str_to_html(" - ") ++ TitleHTML,
+ HeadingHTML = wrap_tags("<h3>", "</h3>\n", TitleHTML)
),
- TitleHTML = wrap_tags("<title>", "</title>\n", Title),
+ HeadTitleHTML = wrap_tags("<title>", "</title>\n", HeadTitle),
+
deep_to_http_context(Deep, HTTPContext),
+ StyleControlMap0 = default_style_control_map,
map_join_html(item_to_html("<div>\n", "</div>\n", HTTPContext),
- Items, ItemsHTML),
+ StyleControlMap0, StyleControlMap1, Items, ItemsHTML),
+
+ ColourScheme = Prefs ^ pref_colour,
+ (
+ ColourScheme = colour_column_groups,
+ StyleControlMap = StyleControlMap1
+ ;
+ ColourScheme = colour_none,
+ % Ignore the updates in StyleControlMap1. This works as long as
+ % all such updates implement the colouring of column groups.
+ StyleControlMap = default_style_control_map
+ ),
+
+ StyleHTML = css_style_html(StyleControlMap),
+
HTML = doc_type_html ++
wrap_tags("<html>\n", "</html>\n",
- wrap_tags("<head>\n", "</head>\n", TitleHTML ++ css_style_html) ++
+ wrap_tags("<head>\n", "</head>\n", HeadTitleHTML ++ StyleHTML) ++
wrap_tags("<body>\n", "</body>\n", HeadingHTML ++ ItemsHTML)
).
@@ -222,83 +241,45 @@
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n" ++
"\"http://www.w3.org/TR/html4/strict.dtd\">\n").
-:- func css_style_html = html.
+%-----------------------------------------------------------------------------%
+
+:- func css_style_html(style_control_map) = html.
-css_style_html =
+css_style_html(StyleControlMap) = HTML :-
% XXX This ignores colour_column_groups. We should respect it,
% and process it either here, or when converting table columns to HTML.
- str_to_html("
- <style type=\"text/css\">
- td.allocations
- {
- text-align: right;
- }
- td.callseqs
- {
- text-align: right;
- }
- td.memory
- {
- text-align: right;
- }
- td.number
- {
- text-align: right;
- }
- td.ordinal_rank
- {
- text-align: right;
- }
- td.port_counts
- {
- text-align: right;
- }
- td.proc
- {
- text-align: left;
- }
- td.ticks_and_times
- {
- text-align: right;
- }
- a.control
- {
- margin: 5px;
- text-decoration: none;
- }
- table.plain
- {
- border-style: none;
- }
- table.boxed
- {
- border-width: 1px 1px 1px 1px;
- border-spacing: 2px;
- border-style: outset outset outset outset;
- }
- table.boxed th
- {
- border-width: 1px 1px 1px 1px;
- padding: 3px 3px 3px 3px;
- border-style: inset inset inset inset;
- }
- table.boxed td
- {
- border-width: 1px 1px 1px 1px;
- padding: 3px 3px 3px 3px;
- border-style: inset inset inset inset;
- }
- </style>
-").
+ map.to_assoc_list(StyleControlMap, StyleControls),
+ ControlHTMLs = list.map(style_control_to_html, StyleControls),
+ ControlsHTML = append_htmls(ControlHTMLs),
+ HTML = wrap_tags("<style type=\"text/css\">\n", "</style>\n",
+ ControlsHTML).
+
+:- func style_control_to_html(pair(style_control, style_element_map)) = html.
+
+style_control_to_html(Control - StyleElementMap) = HTML :-
+ Control = style_control(ControlName),
+ StyleElements = map.to_assoc_list(StyleElementMap),
+ ElementHTMLs = list.map(style_element_to_html, StyleElements),
+ ElementsHTML = append_htmls(ElementHTMLs),
+ StartFragment = string.format("\t%s\n\t{\n", [s(ControlName)]),
+ EndFragment = "\t}\n",
+ HTML = wrap_tags(StartFragment, EndFragment, ElementsHTML).
+
+:- func style_element_to_html(pair(style_element, string)) = html.
+
+style_element_to_html(style_element(ElementName) - Value) =
+ str_to_html(string.format("\t\t%s: %s;\n", [s(ElementName), s(Value)])).
%-----------------------------------------------------------------------------%
% Convert a display item into a HTML snippet.
%
-:- func item_to_html(string, string, http_context, display_item) = html.
+:- pred item_to_html(string::in, string::in, http_context::in,
+ style_control_map::in, style_control_map::out,
+ display_item::in, html::out) is det.
-item_to_html(StartTag, EndTag, HTTPContext, Item) = HTML :-
+item_to_html(StartTag, EndTag, HTTPContext, !StyleControlMap, Item, HTML) :-
(
Item = display_message(Message),
HTML = wrap_tags(StartTag, EndTag,
@@ -309,8 +290,8 @@
link_to_html(HTTPContext, DeepLink))
;
Item = display_table(Table),
- HTML = wrap_tags(StartTag, EndTag,
- table_to_html(HTTPContext, Table))
+ table_to_html(HTTPContext, !StyleControlMap, Table, TableHTML),
+ HTML = wrap_tags(StartTag, EndTag, TableHTML)
;
Item = display_list(Class, MaybeTitle, Items),
(
@@ -336,8 +317,8 @@
(
Class = list_class_vertical_bullets,
OutsideStartTag = "<ul>",
- OutsideEndTag = "<ul>\n",
- InnerStartTag = "<li>", % XXX add \n?
+ OutsideEndTag = "</ul>\n",
+ InnerStartTag = "<li>",
InnerEndTag = "</li>\n",
Separator = empty_html
;
@@ -345,19 +326,19 @@
OutsideStartTag = "",
OutsideEndTag = "\n",
InnerStartTag = "",
- InnerEndTag = "", % XXX add \n?
+ InnerEndTag = "\n",
Separator = str_to_html("<br>\n")
;
Class = list_class_horizontal,
OutsideStartTag = "",
OutsideEndTag = "\n",
InnerStartTag = "",
- InnerEndTag = "",
+ InnerEndTag = "\n",
Separator = str_to_html(" ")
),
sep_map_join_html(Separator,
- item_to_html(InnerStartTag, InnerEndTag, HTTPContext), Items,
- InnerItemsHTML),
+ item_to_html(InnerStartTag, InnerEndTag, HTTPContext),
+ !StyleControlMap, Items, InnerItemsHTML),
ItemsHTML = wrap_tags(OutsideStartTag, OutsideEndTag, InnerItemsHTML),
HTML = wrap_tags(StartTag, EndTag,
TitleHTML ++ PostTitleHTML ++ ItemsHTML)
@@ -376,16 +357,18 @@
% A mapping of column numbers to classes.
%
-:- type col_class_map == map(int, string).
+:- type column_class_map == map(int, string).
%-----------------------------------------------------------------------------%
% Create a HTML table entity from the given table description.
%
-:- func table_to_html(http_context, table) = html.
+:- pred table_to_html(http_context::in,
+ style_control_map::in, style_control_map::out,
+ table::in, html::out) is det.
-table_to_html(HTTPContext, Table) = HTML :-
- Table = table(Class, NumCols, MaybeHeader, BodyRows),
+table_to_html(HTTPContext, !StyleControlMap, Table, HTML) :-
+ Table = table(Class, NumColumns, MaybeHeader, BodyRows),
ClassStr = table_class_to_string(Class),
TableStartTag = "<table class=\"" ++ ClassStr ++ "\">\n",
@@ -394,11 +377,12 @@
% Build a header row.
(
MaybeHeader = yes(table_header(THCells)),
- list.foldl3(table_header_num_rows_and_classmap, THCells,
- one_header_row, THNumRows, 0, _, map.init, ClassMap),
+ list.foldl5(table_header_num_rows_and_classmap, THCells,
+ one_header_row, THNumRows, 0, _, map.init, ClassMap,
+ 0, _, !StyleControlMap),
MaybeClassMap = yes(ClassMap),
- map_join_html(table_header_cell_to_html_row_1(HTTPContext, THNumRows),
- THCells, InnerHeaderRowOneHTML),
+ map_join_html(table_header_group_to_html_row_1(HTTPContext, THNumRows),
+ !StyleControlMap, THCells, InnerHeaderRowOneHTML),
HeaderRowOneHTML =
wrap_tags("<tr>", "</tr>\n", InnerHeaderRowOneHTML),
(
@@ -406,13 +390,13 @@
HeaderRowTwoHTML = empty_html
;
THNumRows = two_header_rows,
- map_join_html(table_header_cell_to_html_row_2(HTTPContext),
- THCells, InnerHeaderRowTwoHTML),
+ map_join_html(table_header_group_to_html_row_2(HTTPContext),
+ !StyleControlMap, THCells, InnerHeaderRowTwoHTML),
HeaderRowTwoHTML =
wrap_tags("<tr>", "</tr>\n", InnerHeaderRowTwoHTML)
),
InnerHeaderRowThree =
- string.format("<td colspan=\"%d\"/>", [i(NumCols)]),
+ string.format("<td colspan=\"%d\"/>", [i(NumColumns)]),
HeaderRowThreeHTML =
wrap_tags("<tr>", "</tr>\n", str_to_html(InnerHeaderRowThree)),
HeaderHTML = HeaderRowOneHTML ++ HeaderRowTwoHTML ++ HeaderRowThreeHTML
@@ -423,8 +407,8 @@
),
% Build the table rows.
- map_join_html(table_row_to_html(HTTPContext, MaybeClassMap, NumCols),
- BodyRows, BodyRowsHTML),
+ map_join_html(table_row_to_html(HTTPContext, MaybeClassMap, NumColumns),
+ !StyleControlMap, BodyRows, BodyRowsHTML),
% Construct the table.
HTML = wrap_tags(TableStartTag, TableEndTag, HeaderHTML ++ BodyRowsHTML).
@@ -433,12 +417,15 @@
% Return the HTML entity for a table header cell.
%
-:- func table_header_cell_to_html_row_1(http_context,
- table_header_rows, table_header_cell) = html.
-
-table_header_cell_to_html_row_1(HTTPContext, HeaderNumRows, Cell) = HTML :-
+:- pred table_header_group_to_html_row_1(http_context::in,
+ table_header_rows::in, style_control_map::in, style_control_map::out,
+ table_header_group::in, html::out) is det.
+
+table_header_group_to_html_row_1(HTTPContext, HeaderNumRows, !StyleControlMap,
+ HeaderGroup, HTML) :-
+ HeaderGroup = table_header_group(Titles, ColumnClass, _SetStyle),
(
- Cell = table_header_cell(Contents, Class),
+ Titles = table_header_group_single(Title),
(
HeaderNumRows = one_header_row,
RowSpan = "1"
@@ -446,110 +433,151 @@
HeaderNumRows = two_header_rows,
RowSpan = "2"
),
- ColSpan = "1",
- ContentsHTML = table_data_to_html(HTTPContext, Contents)
+ ColumnSpan = "1",
+ ContentsHTML = table_data_to_html(HTTPContext, Title)
;
- Cell = table_header_group(Title, SubHeaderCells, Class),
+ Titles = table_header_group_multi(MainTitle, SubTitleCells),
RowSpan = "1",
- list.length(SubHeaderCells, NumSubHeaderCells),
- ColSpan = string.int_to_string(NumSubHeaderCells),
- ContentsHTML = str_to_html(Title)
+ list.length(SubTitleCells, NumSubTitleCells),
+ ColumnSpan = string.int_to_string(NumSubTitleCells),
+ ContentsHTML = str_to_html(MainTitle)
),
- table_col_class_to_string(Class, ClassStr),
- StartTag = string.format("<th rowspan=\"%s\" colspan=\"%s\" class=\"%s\">",
- [s(RowSpan), s(ColSpan), s(ClassStr)]),
+ ColumnClassStr = table_column_class_to_string(ColumnClass),
+ StartTag = string.format(
+ "<th rowspan=\"%s\" colspan=\"%s\" class=\"%s\">",
+ [s(RowSpan), s(ColumnSpan), s(ColumnClassStr)]),
EndTag = "</th>\n",
HTML = wrap_tags(StartTag, EndTag, ContentsHTML).
%-----------------------------------------------------------------------------%
-:- func table_header_cell_to_html_row_2(http_context, table_header_cell)
- = html.
-
-table_header_cell_to_html_row_2(HTTPContext, HeaderCell) = HTML :-
+:- pred table_header_group_to_html_row_2(http_context::in,
+ style_control_map::in, style_control_map::out,
+ table_header_group::in, html::out) is det.
+
+table_header_group_to_html_row_2(HTTPContext, !StyleControlMap,
+ HeaderGroup, HTML) :-
+ HeaderGroup = table_header_group(Titles, ColumnClass, _SetStyle),
(
- HeaderCell = table_header_cell(_, _),
+ Titles = table_header_group_single(_),
HTML = empty_html
;
- HeaderCell = table_header_group(_, Cells, Class),
- map_join_html(table_data_to_th_html(HTTPContext, Class), Cells, HTML)
+ Titles = table_header_group_multi(_, SubTitleCells),
+ map_join_html(table_data_to_th_html(HTTPContext, ColumnClass),
+ !StyleControlMap, SubTitleCells, HTML)
).
%-----------------------------------------------------------------------------%
-:- func table_data_to_th_html(http_context, table_col_class, table_data)
- = html.
+:- pred table_data_to_th_html(http_context::in, table_column_class::in,
+ style_control_map::in, style_control_map::out,
+ table_data::in, html::out) is det.
-table_data_to_th_html(HTTPContext, Class, TableData) = HTML :-
- table_col_class_to_string(Class, ClassStr),
+table_data_to_th_html(HTTPContext, ColumnClass, !StyleControlMap,
+ TableData, HTML) :-
+ ColumnClassStr = table_column_class_to_string(ColumnClass),
TableDataHTML = table_data_to_html(HTTPContext, TableData),
- StartTag = string.format("<th class=\"%s\">", [s(ClassStr)]),
+ StartTag = string.format("<th class=\"%s\">", [s(ColumnClassStr)]),
EndTag = "</th>\n",
HTML = wrap_tags(StartTag, EndTag, TableDataHTML).
%-----------------------------------------------------------------------------%
- % Determine how many rows the table header requires, and a map between
- % column numbers and classes. This should be used with foldl3 and
- % takes a number of accumulator values.
+ % Determine how many rows the table header requires, and set up a map
+ % from column numbers to classes. Update the style control map for
+ % table header groups that specify table_set_style.
%
-:- pred table_header_num_rows_and_classmap(table_header_cell::in,
+ % This should be used with list.foldl5.
+ %
+:- pred table_header_num_rows_and_classmap(table_header_group::in,
table_header_rows::in, table_header_rows::out,
- int::in, int::out, col_class_map::in, col_class_map::out) is det.
+ int::in, int::out, column_class_map::in, column_class_map::out,
+ int::in, int::out, style_control_map::in, style_control_map::out) is det.
-table_header_num_rows_and_classmap(Cell, !NumRows, !ColNum, !ClassMap) :-
- (
- Cell = table_header_cell(_, Class),
- table_col_class_to_string(Class, ClassStr),
- svmap.det_insert(!.ColNum, ClassStr, !ClassMap),
- NumSubCols = 1
+table_header_num_rows_and_classmap(HeaderGroup, !NumRows, !ColumnNumber,
+ !ClassMap, !HeaderGroupNumber, !StyleControlMap) :-
+ HeaderGroup = table_header_group(ColumnTitles, ColumnClass, SetStyle),
+ ColumnClassStr = table_column_class_to_string(ColumnClass),
+ (
+ ColumnTitles = table_header_group_single(_),
+ NumSubCols = 1,
+ svmap.det_insert(!.ColumnNumber, ColumnClassStr, !ClassMap)
;
- Cell = table_header_group(_, Subtitles, Class),
- length(Subtitles, NumSubCols),
+ ColumnTitles = table_header_group_multi(_, SubTitles),
+ list.length(SubTitles, NumSubCols),
!:NumRows = two_header_rows,
- table_col_class_to_string(Class, ClassStr),
% fold_up is inclusive of the higher number.
- fold_up(insert_col_classmap(ClassStr),
- !.ColNum, !.ColNum + NumSubCols - 1, !ClassMap)
+ int.fold_up(insert_column_into_classmap(ColumnClassStr),
+ !.ColumnNumber, !.ColumnNumber + NumSubCols - 1, !ClassMap)
),
- !:ColNum = !.ColNum + NumSubCols.
-
-%-----------------------------------------------------------------------------%
+ (
+ SetStyle = table_do_not_set_style
+ ;
+ SetStyle = table_set_style,
+ update_style_control_map(ColumnClass, !.HeaderGroupNumber,
+ !StyleControlMap),
+ !:HeaderGroupNumber = !.HeaderGroupNumber + 1
+ ),
+ !:ColumnNumber = !.ColumnNumber + NumSubCols.
-:- pred insert_col_classmap(string::in, int::in,
- col_class_map::in, col_class_map::out) is det.
+:- pred insert_column_into_classmap(string::in, int::in,
+ column_class_map::in, column_class_map::out) is det.
-insert_col_classmap(Value, Key, !Map) :-
+insert_column_into_classmap(Value, Key, !Map) :-
svmap.det_insert(Key, Value, !Map).
+:- pred update_style_control_map(table_column_class::in, int::in,
+ style_control_map::in, style_control_map::out) is det.
+
+update_style_control_map(ColumnClass, HeaderGroupNumber, !StyleControlMap) :-
+ ColumnClassStr = table_column_class_to_string(ColumnClass),
+ StyleControl = style_control("td." ++ ColumnClassStr),
+ StyleElement = style_element("background"),
+ ( HeaderGroupNumber /\ 1 = 0 ->
+ Colour = "LightGrey"
+ ;
+ Colour = "White"
+ ),
+ ( map.search(!.StyleControlMap, StyleControl, StyleElementMap0) ->
+ map.set(StyleElementMap0, StyleElement, Colour, StyleElementMap),
+ svmap.det_update(StyleControl, StyleElementMap, !StyleControlMap)
+ ;
+ map.det_insert(map.init, StyleElement, Colour, StyleElementMap),
+ svmap.det_insert(StyleControl, StyleElementMap, !StyleControlMap)
+ ).
+
%-----------------------------------------------------------------------------%
% Build a row of a HTML table from the table_row type.
%
-:- func table_row_to_html(http_context, maybe(col_class_map), int, table_row)
- = html.
+:- pred table_row_to_html(http_context::in, maybe(column_class_map)::in,
+ int::in, style_control_map::in, style_control_map::out,
+ table_row::in, html::out) is det.
-table_row_to_html(HTTPContext, MaybeColClassMap, NumCols, TableRow) = HTML :-
+table_row_to_html(HTTPContext, MaybeColClassMap, NumColumns, !StyleControlMap,
+ TableRow, HTML) :-
(
TableRow = table_section_header(Contents),
ContentsHTML = table_data_to_html(HTTPContext, Contents),
- StartTag = string.format("<tr><td colspan=\"%d\">", [i(NumCols)]),
+ StartTag = string.format("<tr><td colspan=\"%d\">", [i(NumColumns)]),
EndTag = "</td></tr>\n",
HTML = wrap_tags(StartTag, EndTag, ContentsHTML)
;
TableRow = table_row(Cells),
map_join_html_count(table_cell_to_html(HTTPContext, MaybeColClassMap),
- 0, Cells, InnerHTML),
+ !StyleControlMap, 0, Cells, InnerHTML),
HTML = wrap_tags("<tr>", "</tr>\n", InnerHTML)
).
%-----------------------------------------------------------------------------%
-:- func table_cell_to_html(http_context, maybe(col_class_map), int, table_cell)
- = html.
+:- pred table_cell_to_html(http_context::in, maybe(column_class_map)::in,
+ style_control_map::in, style_control_map::out,
+ int::in, table_cell::in, html::out) is det.
-table_cell_to_html(HTTPContext, MaybeClassMap, ColNum, Cell) = HTML :-
+table_cell_to_html(HTTPContext, MaybeClassMap, !StyleControlMap, ColumnNum,
+ Cell, HTML) :-
(
Cell = table_empty_cell,
HTML = str_to_html("<td/>")
@@ -557,25 +585,25 @@
Cell = table_cell(CellData),
(
MaybeClassMap = yes(ClassMap),
- ( map.search(ClassMap, ColNum, ClassStrPrime) ->
- ClassStr = ClassStrPrime
+ ( map.search(ClassMap, ColumnNum, ColumnClassStrPrime) ->
+ ColumnClassStr = ColumnClassStrPrime
;
Msg = string.format(
"Class map had no class for col %d, check table structure",
- [i(ColNum)]),
+ [i(ColumnNum)]),
error(Msg)
)
;
MaybeClassMap = no,
- ( table_data_class(CellData, ClassPrime) ->
- Class = ClassPrime
+ ( table_data_class(CellData, ColumnClassPrime) ->
+ ColumnClass = ColumnClassPrime
;
- Class = default_table_col_class
+ ColumnClass = default_table_column_class
),
- table_col_class_to_string(Class, ClassStr)
+ ColumnClassStr = table_column_class_to_string(ColumnClass)
),
CellHTML = table_data_to_html(HTTPContext, CellData),
- StartTag = string.format("<td class=\"%s\">", [s(ClassStr)]),
+ StartTag = string.format("<td class=\"%s\">", [s(ColumnClassStr)]),
EndTag = "</td>\n",
HTML = wrap_tags(StartTag, EndTag, CellHTML)
).
@@ -604,29 +632,30 @@
% class for some data that class is used, otherwise the default class is
% assumed.
%
-:- pred table_data_class(table_data::in, table_col_class::out) is semidet.
+:- pred table_data_class(table_data::in, table_column_class::out) is semidet.
-table_data_class(td_f(_), table_col_class_number).
-table_data_class(td_i(_), table_col_class_number).
-table_data_class(td_m(_, _, _), table_col_class_number).
-table_data_class(td_p(_), table_col_class_number).
-table_data_class(td_t(_), table_col_class_number).
-
-:- func default_table_col_class = table_col_class.
-
-default_table_col_class = table_col_class_no_class.
-
-:- pred table_col_class_to_string(table_col_class::in, string::out) is det.
-
-table_col_class_to_string(table_col_class_allocations, "allocations").
-table_col_class_to_string(table_col_class_callseqs, "callseqs").
-table_col_class_to_string(table_col_class_memory, "memory").
-table_col_class_to_string(table_col_class_no_class, "default").
-table_col_class_to_string(table_col_class_number, "number").
-table_col_class_to_string(table_col_class_ordinal_rank, "ordinal_rank").
-table_col_class_to_string(table_col_class_port_counts, "port_counts").
-table_col_class_to_string(table_col_class_proc, "proc").
-table_col_class_to_string(table_col_class_ticks_and_times, "ticks_and_times").
+table_data_class(td_f(_), table_column_class_number).
+table_data_class(td_i(_), table_column_class_number).
+table_data_class(td_m(_, _, _), table_column_class_number).
+table_data_class(td_p(_), table_column_class_number).
+table_data_class(td_t(_), table_column_class_number).
+
+:- func default_table_column_class = table_column_class.
+
+default_table_column_class = table_column_class_no_class.
+
+:- func table_column_class_to_string(table_column_class) = string.
+
+table_column_class_to_string(table_column_class_no_class) = "default".
+table_column_class_to_string(table_column_class_allocations) = "allocations".
+table_column_class_to_string(table_column_class_callseqs) = "callseqs".
+table_column_class_to_string(table_column_class_memory) = "memory".
+table_column_class_to_string(table_column_class_number) = "number".
+table_column_class_to_string(table_column_class_ordinal_rank) = "ordinal_rank".
+table_column_class_to_string(table_column_class_port_counts) = "port_counts".
+table_column_class_to_string(table_column_class_proc) = "proc".
+table_column_class_to_string(table_column_class_ticks_and_times) =
+ "ticks_and_times".
:- func table_class_to_string(table_class) = string.
@@ -635,6 +664,108 @@
%-----------------------------------------------------------------------------%
+ % A style element is a variable you can set for a given control.
+ % Examples include "text-align" and "background".
+ %
+:- type style_element
+ ---> style_element(string).
+
+ % Maps a style element to its value.
+ %
+:- type style_element_map == map(style_element, string).
+
+ % A style control is a category whose properties can be set independently.
+ % Examples include "td.allocations and "td.callseqs".
+ %
+:- type style_control
+ ---> style_control(string).
+
+ % Maps a style control to the style elements we should use for it.
+ %
+:- type style_control_map == map(style_control, style_element_map).
+
+ % Return the default style control map.
+ %
+:- func default_style_control_map = style_control_map.
+
+default_style_control_map =
+ map.from_assoc_list([
+ ( style_control("td.allocations") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("td.callseqs") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("td.memory") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("td.number") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("td.ordinal_rank") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("td.port_counts") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("td.proc") -
+ map.from_assoc_list([
+ style_element("text-align") - "left"
+ ])
+ ),
+ ( style_control("td.ticks_and_times") -
+ map.from_assoc_list([
+ style_element("text-align") - "right"
+ ])
+ ),
+ ( style_control("a.control") -
+ map.from_assoc_list([
+ style_element("margin") - "5px",
+ style_element("text-decoration") - "none"
+ ])
+ ),
+ ( style_control("table.plain") -
+ map.from_assoc_list([
+ style_element("border-style") - "none"
+ ])
+ ),
+ ( style_control("table.boxed") -
+ map.from_assoc_list([
+ style_element("border-width") - "1px 1px 1px 1px",
+ style_element("border-spacing") - "2px",
+ style_element("border-style") - "outset outset outset outset"
+ ])
+ ),
+ ( style_control("table.boxed th") -
+ map.from_assoc_list([
+ style_element("border-width") - "1px 1px 1px 1px",
+ style_element("padding") - "3px 3px 3px 3px",
+ style_element("border-style") - "inset inset inset inset"
+ ])
+ ),
+ ( style_control("table.boxed td") -
+ map.from_assoc_list([
+ style_element("border-width") - "1px 1px 1px 1px",
+ style_element("padding") - "3px 3px 3px 3px",
+ style_element("border-style") - "inset inset inset inset"
+ ])
+ )
+ ]).
+
+%-----------------------------------------------------------------------------%
+
% Information about the HTTP session. This is used to create HTTP links
% below.
%
@@ -703,6 +834,10 @@
% Generic HTML helper predicates.
%
+:- func append_htmls(list(html)) = html.
+
+append_htmls(HTMLs) = cord_list_to_cord(HTMLs).
+
:- func wrap_tags(string, string, html) = html.
wrap_tags(StartTag, EndTag, InnerHTML) =
@@ -722,63 +857,88 @@
%-----------------------------------------------------------------------------%
- % For each A, compute S = MapFunc(A), and concatenate all Ss.
+ % For each A, MapPred(!StyleControlMap, A, S), and concatenate all Ss.
%
-:- pred map_join_html((func(A) = html)::in, list(A)::in, html::out) is det.
+:- pred map_join_html(
+ pred(style_control_map, style_control_map, A, html)::
+ in(pred(in, out, in, out) is det),
+ style_control_map::in, style_control_map::out,
+ list(A)::in, html::out) is det.
-map_join_html(MapFunc, List, HTML) :-
- sep_map_join_html(empty_html, MapFunc, List, HTML).
+map_join_html(MapPred, !StyleControlMap, List, HTML) :-
+ sep_map_join_html(empty_html, MapPred, !StyleControlMap, List, HTML).
- % For each A, compute S = MapFunc(A), and concatenate all Ss
+ % For each A, MapPred(!StyleControlMap, A, S), and concatenate all Ss
% after putting Separator between them.
%
-:- pred sep_map_join_html(html::in, (func(A) = html)::in,
+:- pred sep_map_join_html(html::in,
+ pred(style_control_map, style_control_map, A, html)::
+ in(pred(in, out, in, out) is det),
+ style_control_map::in, style_control_map::out,
list(A)::in, html::out) is det.
-sep_map_join_html(_, _, [], empty_html).
-sep_map_join_html(Separator, MapFunc, [Head | Tail], HTML) :-
- HeadHTML = MapFunc(Head),
- sep_map_join_html_acc(Separator, MapFunc, Tail, HeadHTML, HTML).
-
-:- pred sep_map_join_html_acc(html::in, (func(A) = html)::in, list(A)::in,
- html::in, html::out) is det.
-
-sep_map_join_html_acc(_, _, [], !HTML).
-sep_map_join_html_acc(Separator, MapFunc, [Head | Tail], !HTML) :-
- HeadHTML = MapFunc(Head),
+sep_map_join_html(_, _, !StyleControlMap, [], empty_html).
+sep_map_join_html(Separator, MapPred, !StyleControlMap, [Head | Tail], HTML) :-
+ MapPred(!StyleControlMap, Head, HeadHTML),
+ sep_map_join_html_acc(Separator, MapPred, !StyleControlMap, Tail,
+ HeadHTML, HTML).
+
+:- pred sep_map_join_html_acc(html::in,
+ pred(style_control_map, style_control_map, A, html)::
+ in(pred(in, out, in, out) is det),
+ style_control_map::in, style_control_map::out,
+ list(A)::in, html::in, html::out) is det.
+
+sep_map_join_html_acc(_, _, !StyleControlMap, [], !HTML).
+sep_map_join_html_acc(Separator, MapPred, !StyleControlMap, [Head | Tail],
+ !HTML) :-
+ MapPred(!StyleControlMap, Head, HeadHTML),
!:HTML = !.HTML ++ Separator ++ HeadHTML,
- sep_map_join_html_acc(Separator, MapFunc, Tail, !HTML).
+ sep_map_join_html_acc(Separator, MapPred, !StyleControlMap, Tail, !HTML).
- % For each A, compute S = MapFunc(N, A), and concatenate all Ss.
+ % For each A, MapPred(!StyleControlMap, N, A, S), and concatenate all Ss.
% N is the ordinal number of the element in the list.
%
-:- pred map_join_html_count((func(int, A) = html)::in, int::in, list(A)::in,
- html::out) is det.
+:- pred map_join_html_count(
+ pred(style_control_map, style_control_map, int, A, html)::
+ in(pred(in, out, in, in, out) is det),
+ style_control_map::in, style_control_map::out,
+ int::in, list(A)::in, html::out) is det.
-map_join_html_count(MapFunc, N, List, HTML) :-
- sep_map_join_html_count(empty_html, MapFunc, N, List, HTML).
+map_join_html_count(MapPred, !StyleControlMap, N, List, HTML) :-
+ sep_map_join_html_count(empty_html, MapPred, !StyleControlMap, N, List,
+ HTML).
- % For each A, compute S = MapFunc(N, A), and concatenate all Ss
+ % For each A, MapPred(!StyleControlMap, N, A, S), and concatenate all Ss
% after putting Separator between them.
% N is the ordinal number of the element in the list.
%
-:- pred sep_map_join_html_count(html::in, (func(int, A) = html)::in,
+:- pred sep_map_join_html_count(html::in,
+ pred(style_control_map, style_control_map, int, A, html)::
+ in(pred(in, out, in, in, out) is det),
+ style_control_map::in, style_control_map::out,
int::in, list(A)::in, html::out) is det.
-sep_map_join_html_count(_, _, _, [], empty_html).
-sep_map_join_html_count(Separator, MapFunc, N, [Head | Tail], HTML) :-
- HeadHTML = MapFunc(N, Head),
- sep_map_join_html_count_acc(Separator, MapFunc, N + 1, Tail,
- HeadHTML, HTML).
-
-:- pred sep_map_join_html_count_acc(html::in, (func(int, A) = html)::in,
+sep_map_join_html_count(_, _, !StyleControlMap, _, [], empty_html).
+sep_map_join_html_count(Separator, MapPred, !StyleControlMap, N,
+ [Head | Tail], HTML) :-
+ MapPred(!StyleControlMap, N, Head, HeadHTML),
+ sep_map_join_html_count_acc(Separator, MapPred, !StyleControlMap, N + 1,
+ Tail, HeadHTML, HTML).
+
+:- pred sep_map_join_html_count_acc(html::in,
+ pred(style_control_map, style_control_map, int, A, html)::
+ in(pred(in, out, in, in, out) is det),
+ style_control_map::in, style_control_map::out,
int::in, list(A)::in, html::in, html::out) is det.
-sep_map_join_html_count_acc(_, _, _, [], !HTML).
-sep_map_join_html_count_acc(Separator, MapFunc, N, [Head | Tail], !HTML) :-
- HeadHTML = MapFunc(N, Head),
+sep_map_join_html_count_acc(_, _, !StyleControlMap, _, [], !HTML).
+sep_map_join_html_count_acc(Separator, MapPred, !StyleControlMap, N,
+ [Head | Tail], !HTML) :-
+ MapPred(!StyleControlMap, N, Head, HeadHTML),
!:HTML = !.HTML ++ Separator ++ HeadHTML,
- sep_map_join_html_count_acc(Separator, MapFunc, N + 1, Tail, !HTML).
+ sep_map_join_html_count_acc(Separator, MapPred, !StyleControlMap, N + 1,
+ Tail, !HTML).
%-----------------------------------------------------------------------------%
%
Index: deep_profiler/query.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/query.m,v
retrieving revision 1.24
diff -u -b -r1.24 query.m
--- deep_profiler/query.m 5 Aug 2008 00:54:18 -0000 1.24
+++ deep_profiler/query.m 6 Aug 2008 07:55:04 -0000
@@ -313,7 +313,7 @@
),
create_report(Cmd, Deep, Report),
Display = report_to_display(Deep, Prefs, Report),
- HTML = htmlize_display(Deep, Display),
+ HTML = htmlize_display(Deep, Prefs, Display),
HTMLStr = html_to_string(HTML).
% Old deep profiler cgi code. This should remain supported until all the deep
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/cord.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/cord.m,v
retrieving revision 1.11
diff -u -b -r1.11 cord.m
--- library/cord.m 23 Nov 2007 07:35:55 -0000 1.11
+++ library/cord.m 6 Aug 2008 02:37:22 -0000
@@ -83,6 +83,10 @@
%
:- func cord(T) ++ cord(T) = cord(T).
+ % Append together a list of cords.
+ %
+:- func cord_list_to_cord(list(cord(T))) = cord(T).
+
% head_tail(C0, X, C) => list(C0) = [X | list(C)]
% not head_tail(C0, _, _) => C0 = empty
% An O(n) operation, although traversing an entire cord with
@@ -228,6 +232,12 @@
%-----------------------------------------------------------------------------%
+cord_list_to_cord([]) = nil.
+cord_list_to_cord([HeadCord | TailCords]) =
+ HeadCord ++ cord_list_to_cord(TailCords).
+
+%-----------------------------------------------------------------------------%
+
head_tail(leaf(X), X, nil).
head_tail(leaves([X | Xs]), X, C ) :-
(
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list