ADDED: showterm.el and showterm.pl to draw terms as trees in Emacs

tools/README.md

@@ -0,0 +1,31 @@
+# Showterm: Draw Prolog terms as trees in Emacs
+
+To try it, you need the following programs installed:
+
+- [**Scryer Prolog**](https://github.com/mthom/scryer-prolog)
+- `dot` (from Graphviz)
+- `convert` (from ImageMagick)
+
+Copy [`showterm.el`](showterm.el) and [`showterm.pl`](showterm.pl) to
+the same directory, say `~/scryer-prolog/tools/`, and add to your
+`.emacs`:
+
+    (load "~/scryer-prolog/tools/showterm.el")
+
+If necessary, set `scryer-prolog-path` to the Scryer Prolog
+executable by adding to your `.emacs` (adapting as appropriate):
+
+    (setq scryer-prolog-path "/usr/local/bin/scryer-prolog")
+
+The function `showterm` draws the Prolog term in the region as
+a tree. You can invoke it with `M-x showterm RET`, or for example
+by binding it to a key in your `.emacs`, and then pressing
+that key:
+
+    (global-set-key [f12] 'showterm)
+
+Enjoy!
+
+**Screenshot:**
+
+![Showterm example](showterm.png)

tools/showterm.el

@@ -0,0 +1,124 @@
+;;; showterm.el --- Show Prolog terms as trees in Emacs
+
+;; Copyright (C) 2020 Markus Triska (triska@metalevel.at)
+
+;; To try it, you need the following programs installed:
+;;
+;;     - Scryer Prolog
+;;     - `dot' (from Graphviz)
+;;     - `convert' (from ImageMagick)
+;;
+;; Copy showterm.el and showterm.pl to the same directory,
+;; say ~/scryer-prolog/tools/, and add to your .emacs:
+;;
+;;     (load "~/scryer-prolog/tools/showterm.el")
+;;
+;; If necessary, set `scryer-prolog-path' to the Scryer Prolog
+;; executable by adding to your .emacs (adapting as appropriate):
+;;
+;;     (setq scryer-prolog-path "/usr/local/bin/scryer-prolog")
+;;
+;; The function `showterm' draws the Prolog term in the region as a
+;; tree. You can invoke it with M-x showterm RET, or for example by
+;; binding it to a key in your .emacs, and then pressing that key:
+;;
+;;     (global-set-key [f12] 'showterm)
+;;
+;; Enjoy!
+
+(defvar scryer-prolog-path
+  (or (executable-find "scryer-prolog")
+      "~/scryer-prolog/target/release/scryer-prolog")
+  "Path of the Scryer Prolog executable.")
+
+(defvar showterm-pl-file
+  (format "%s%s"
+          (if load-in-progress
+              (file-name-directory load-file-name)
+            default-directory)
+          "showterm.pl")
+  "Path to showterm.pl, used to produce a graph as input for `dot'.")
+
+(defvar showterm-pixel-width 500
+  "Width of the drawn term in pixels.")
+
+(defun showterm (arg)
+  (interactive "p")
+  (unless (use-region-p)
+    (error "no region"))
+  (let* ((from (region-beginning))
+         (to (region-end))
+         (str (buffer-substring-no-properties from to))
+         op-declarations)
+    (save-excursion
+      ;; rudimentary support for op/3 directives.
+      (goto-char (point-min))
+      (while (re-search-forward "^:-[ \t]*\\(op(.*,.*,.*)[ \t]*\\.\\).*$" nil t)
+        (push (match-string 1) op-declarations))
+      (setq op-declarations (reverse op-declarations)))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (let ((proc (start-process "scryer-showterm" (current-buffer)
+                                 scryer-prolog-path
+                                 showterm-pl-file)))
+        (showterm-wait-for-prompt)
+        (while op-declarations
+          (send-string proc (format "%s\n" (pop op-declarations)))
+          (showterm-wait-for-prompt))
+        (send-string proc (concat "dot, halt.\n" str " .\n"))
+        (showterm-wait-for-process proc t)
+        (setq str (buffer-string)))
+      (erase-buffer)
+      (let ((proc (start-process "dot" (current-buffer) "dot"
+                                 "-Gdpi=300"
+                                 "-T" "png")))
+        (send-string proc str)
+        (process-send-eof proc)
+        (showterm-wait-for-process proc)
+        (setq str (buffer-string))
+        (erase-buffer))
+      (let ((proc (let (process-connection-type)
+                    (start-process "convert" (current-buffer)
+                                   "convert"
+                                   "png:-"
+                                   "-gravity" "center"
+                                   "-background" "white"
+                                   "-scale" (format "%dx%d"
+                                                    showterm-pixel-width
+                                                    showterm-pixel-width)
+                                   "-extent" (format "%dx" showterm-pixel-width)
+                                   "png:-"))))
+        (process-send-string proc str)
+        (process-send-eof proc)
+        (showterm-wait-for-process proc))
+      (let ((img (create-image (buffer-string) 'png t))
+            (fit-window-to-buffer-horizontally t)
+            (buf (get-buffer-create "term-tree")))
+        (with-current-buffer buf
+          (erase-buffer)
+          (setq mode-line-format ""
+                cursor-in-non-selected-windows nil)
+          (insert-image img)
+          (insert "\n"))
+        (fit-window-to-buffer (display-buffer-in-side-window buf '((side . right))))))))
+
+
+(defun showterm-wait-for-prompt ()
+  (let ((str (regexp-quote "?- "))
+        seen)
+    (while (not seen)
+      (accept-process-output nil 0.01)
+      (save-excursion
+        (move-beginning-of-line nil)
+        (setq seen (looking-at str))))
+    (erase-buffer)))
+
+(defun showterm-wait-for-process (proc &optional check-for-error)
+  (set-process-sentinel proc (lambda (proc event)))
+  (while (eq (process-status proc) 'run)
+    (accept-process-output nil 0.1)
+    (when check-for-error
+      (goto-char (point-min))
+      (when (looking-at "caught: error(syntax_error")
+        (delete-process proc)
+        (error "Syntax error, term cannot be displayed")))))

tools/showterm.pl

@@ -0,0 +1,117 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Describe a term in GraphViz DOT format.
+   Written September 2020 by Markus Triska (triska@metalevel.at)
+   Part of Scryer Prolog.
+
+   Example:
+
+      ?- dot(a+b).
+      %@ graph G {
+      %@     c [label = "(+)/2", fontname="courier bold"];
+      %@     c -- c1;
+      %@     c1 [label = "a", style=filled, fontname="courier bold", fillcolor=lightcyan];
+      %@     c -- c2;
+      %@     c2 [label = "b", style=filled, fontname="courier bold", fillcolor=lightcyan];
+      %@ }
+      %@    true
+      %@ ;  ...
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- use_module(library(clpz)).
+:- use_module(library(dcgs)).
+:- use_module(library(lists)).
+:- use_module(library(format)).
+:- use_module(library(assoc)).
+:- use_module(library(pairs)).
+:- use_module(library(atts)).
+
+:- attribute named/0.
+
+dot :-
+        read_term(Term, [variables(Vs),variable_names(NVs0)]),
+        maplist(eq_pair, NVs0, NVPairs),
+        pairs_values(NVPairs, NamedVariables),
+        maplist(mark_var_as_named, NamedVariables),
+        list_to_assoc(NVPairs, UsedNames),
+        foldl(name_remaining_variables, Vs, NVs0-UsedNames, NVs-_),
+        dot(Term, NVs).
+
+eq_pair(A=B, A-B).
+
+mark_var_as_named(Var) :-
+        put_atts(Var, named).
+
+name_remaining_variables(Var, NVs0-UsedNames0, NVs-UsedNames) :-
+        (   get_atts(Var, named) ->
+            NVs-UsedNames = NVs0-UsedNames0
+        ;   unused_name(UsedNames0, 0, Name),
+            NVs = [Name=Var|NVs0],
+            put_assoc(Name, UsedNames0, Var, UsedNames)
+        ).
+
+unused_name(UsedNames, N0, Name) :-
+        n_var_name(N0, Name0),
+        (   get_assoc(Name0, UsedNames, _) ->
+            N #= N0 + 1,
+            unused_name(UsedNames, N, Name)
+        ;   Name = Name0
+        ).
+
+n_var_name(N, VarName) :-
+        char_code('A', AC),
+        LN #= N mod 26 + AC,
+        char_code(LC, LN),
+        NN #= N // 26,
+        zcompare(C, NN, 0),
+        varname_(C, NN, LC, VarName).
+
+varname_(=, _, LC, VarName) :-
+        atom_chars(VarName, ['_', LC]).
+varname_(>, NN, LC, VarName) :-
+        number_chars(NN, NNChars),
+        atom_chars(VarName, ['_', LC | NNChars]).
+
+
+dot(Term) :-
+        dot(Term, []).
+
+dot(Term, NVs) :-
+        phrase(term_labels(Term, NVs, 'c'), Ls),
+        phrase(("graph G {\n",
+                dots(Ls),
+                "}\n"), DOT),
+        format("~s", [DOT]).
+
+dots([]) --> [].
+dots([D|Ds]) --> dot_(D), dots(Ds).
+
+dot_(node_label(C, F, A)) -->
+        format_("    ~w [label = \"~q\", fontname=\"courier bold\"];\n", [C,F/A]).
+dot_(connection(A,B)) -->
+        format_("    ~w -- ~w;\n", [A,B]).
+dot_(atomic(C,L)) -->
+        format_("    ~w [label = \"~q\", style=filled, fontname=\"courier bold\", fillcolor=lightcyan];\n", [C,L]).
+dot_(variable(C,L)) -->
+        format_("    ~w [label = \"~w\", shape=box, fontname=\"courier bold\", style=filled, fillcolor=aquamarine];\n", [C,L]).
+
+term_labels(Term, NVs, C0) -->
+        (   { atomic(Term) } -> [atomic(C0, Term)]
+        ;   { var(Term) } ->
+            (   { member(Name=Var, NVs), Var == Term } ->
+                [variable(C0,Name)]
+            ;   [variable(C0,Term)]
+            )
+        ;   { functor(Term, F, A),
+              Term =.. [F|Args] },
+            [node_label(C0, F, A)],
+            all_subterms(Args, NVs, C0, 1)
+        ).
+
+all_subterms([], _, _, _) --> [].
+all_subterms([L|Ls], NVs, C0, N0) -->
+        [connection(C0, C1)],
+        { phrase(format_("~w~w", [C0,N0]), Chars),
+          atom_chars(C1, Chars),
+          N #= N0 + 1 },
+        term_labels(L, NVs, C1),
+        all_subterms(Ls, NVs, C0, N).