From: Markus Triska Date: Sat, 3 Oct 2020 07:52:46 +0000 (+0200) Subject: ADDED: showterm.el and showterm.pl to draw terms as trees in Emacs X-Git-Tag: v0.9.0~173^2^2~2 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=35a3f2dc91ae2546374fa8aaad1c1be544c992bc;p=scryer-prolog.git ADDED: showterm.el and showterm.pl to draw terms as trees in Emacs --- diff --git a/tools/README.md b/tools/README.md new file mode 100644 index 00000000..b1ad473a --- /dev/null +++ b/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) diff --git a/tools/showterm.el b/tools/showterm.el new file mode 100644 index 00000000..3f38f3d9 --- /dev/null +++ b/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"))))) diff --git a/tools/showterm.pl b/tools/showterm.pl new file mode 100644 index 00000000..3f9ba8d9 --- /dev/null +++ b/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). diff --git a/tools/showterm.png b/tools/showterm.png new file mode 100644 index 00000000..fdc6c677 Binary files /dev/null and b/tools/showterm.png differ