From f948746dd24351891f0a10bb7bfa993e656b289f Mon Sep 17 00:00:00 2001
From: Andrew Davison <andrew.davison@gmail.com>
Date: Tue, 29 Oct 2024 21:54:32 +1000
Subject: [PATCH] Add portrayed(Bool) option to write_term/2-3, re issue #613

---
 src/bif_format.c  |  1 +
 src/bif_streams.c | 45 +++++++++++++++++++++++++++++++++++++++++++++
 src/internal.h    |  1 +
 src/print.c       |  1 +
 4 files changed, 48 insertions(+)

diff --git a/src/bif_format.c b/src/bif_format.c
index 2ad6ebb4..6757f1fa 100644
--- a/src/bif_format.c
+++ b/src/bif_format.c
@@ -571,6 +571,7 @@ bool do_format(query *q, cell *str, pl_idx str_ctx, cell *p1, pl_idx p1_ctx, cel
 			query *q2 = query_create_subquery(q, tmp);
 			start(q2);
 			query_destroy(q2);
+			clear_write_options(q);
 			break;
 		}
 
diff --git a/src/bif_streams.c b/src/bif_streams.c
index 32082621..49dc4d75 100644
--- a/src/bif_streams.c
+++ b/src/bif_streams.c
@@ -2677,6 +2677,18 @@ bool parse_write_params(query *q, cell *c, pl_idx c_ctx, cell **vnames, pl_idx *
 		}
 
 		q->fullstop = !CMP_STRING_TO_CSTR(q, c1, "true");
+	} else if (!CMP_STRING_TO_CSTR(q, c, "portrayed")) {
+		if (is_var(c1)) {
+			throw_error(q, c1, c_ctx, "instantiation_error", "write_option");
+			return false;
+		}
+
+		if (!is_interned(c1) || (CMP_STRING_TO_CSTR(q, c1, "true") && CMP_STRING_TO_CSTR(q, c1, "false"))) {
+			throw_error(q, c, c_ctx, "domain_error", "write_option");
+			return false;
+		}
+
+		q->portrayed = !CMP_STRING_TO_CSTR(q, c1, "true");
 	} else if (!CMP_STRING_TO_CSTR(q, c, "nl")) {
 		if (is_var(c1)) {
 			throw_error(q, c1, c_ctx, "instantiation_error", "write_option");
@@ -2904,6 +2916,22 @@ static bool bif_iso_write_term_2(query *q)
 		return throw_error(q, p2_orig, p2_orig_ctx, "type_error", "list");
 	}
 
+	if (q->portrayed) {
+		cell *c = p1;
+		pl_idx c_ctx = p1_ctx;
+		cell p1[1+c->nbr_cells];
+		make_struct(p1+0, new_atom(q->pl, "$portray"), NULL, 1, c->nbr_cells);
+		dup_cells_by_ref(p1+1, c, c_ctx, c->nbr_cells);
+		cell *tmp = prepare_call(q, NOPREFIX_LEN, p1, q->st.curr_frame, 1);
+		pl_idx nbr_cells = p1->nbr_cells;
+		make_end(tmp+nbr_cells);
+		query *q2 = query_create_subquery(q, tmp);
+		start(q2);
+		query_destroy(q2);
+		clear_write_options(q);
+		return !ferror(str->fp);
+	}
+
 	q->variable_names = vnames;
 	q->variable_names_ctx = vnames_ctx;
 
@@ -2973,6 +3001,23 @@ static bool bif_iso_write_term_3(query *q)
 		return throw_error(q, p2_orig, p2_orig_ctx, "type_error", "list");
 	}
 
+	if (q->portrayed) {
+		cell *c = p1;
+		pl_idx c_ctx = p1_ctx;
+		cell p1[1+1+c->nbr_cells];
+		make_struct(p1+0, new_atom(q->pl, "$portray"), NULL, 2, 1+c->nbr_cells);
+		p1[1] = *pstr;
+		dup_cells_by_ref(p1+2, c, c_ctx, c->nbr_cells);
+		cell *tmp = prepare_call(q, NOPREFIX_LEN, p1, q->st.curr_frame, 1);
+		pl_idx nbr_cells = p1->nbr_cells;
+		make_end(tmp+nbr_cells);
+		query *q2 = query_create_subquery(q, tmp);
+		start(q2);
+		query_destroy(q2);
+		clear_write_options(q);
+		return !ferror(str->fp);
+	}
+
 	q->latest_ctx = p1_ctx;
 	q->variable_names = vnames;
 	q->variable_names_ctx = vnames_ctx;
diff --git a/src/internal.h b/src/internal.h
index 5e9cac9f..5da7ff9e 100644
--- a/src/internal.h
+++ b/src/internal.h
@@ -735,6 +735,7 @@ struct query_ {
 	bool json:1;
 	bool nl:1;
 	bool fullstop:1;
+	bool portrayed:1;
 	bool ignore_ops:1;
 	bool numbervars:1;
 	bool halt:1;
diff --git a/src/print.c b/src/print.c
index 534c4233..741f2d23 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1649,6 +1649,7 @@ void clear_write_options(query *q)
 	q->quoted = 0;
 	q->nl = q->fullstop = q->varnames = q->ignore_ops = false;
 	q->parens = q->numbervars = q->json = q->double_quotes = false;
+	q->portrayed = false;
 	q->last_thing = WAS_OTHER;
 	q->variable_names = NULL;
 	q->cycle_error = false;