[nongnu] elpa/sweeprolog a9d0eb222f 2/4: ADDED: command to pipe output of Prolog goals to Emacs buffers

[ELPA Syncer]

branch: elpa/sweeprolog
commit a9d0eb222f6efc128d1280db0669820d061b5149
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    ADDED: command to pipe output of Prolog goals to Emacs buffers
    
    * sweep.c (sweep_open_channel(), sweep_fd_open()): new helper
    functions for obtaining Prolog streams from Emacs pipe buffers.
    * sweep.pl (sweep_async_goal/2, sweep_interrupt_async_goal/2): new
    predicates.
    * sweeprolog.el (sweeprolog-async-goal): new command, executes a goal
    in a separate thread and redirects its output to a buffer with mode..
    (sweeprolog-async-goal-output-mode): new major mode, derived from
    Compilation mode.
    (sweeprolog-mode-map, sweeprolog-prefix-map, sweeprolog-menu): bind
    sweeprolog-async-goal.
    * README.org (Executing Prolog Asynchronously): new manual section.
---
 README.org    | 40 ++++++++++++++++++++++++
 sweep.c       | 32 ++++++++++++++++++++
 sweep.pl      | 32 +++++++++++++++++++-
 sweeprolog.el | 97 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 200 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index 8713530ec9..a93aa3001d 100644
--- a/README.org
+++ b/README.org
@@ -1844,6 +1844,45 @@ In ~sweeprolog-mode~ buffers, you can invoke
 goal at point (if any) as the "future history" for the goal prompt,
 which you can access with ~M-n~ in the minibuffer.
 
+* Executing Prolog Asynchronously
+:PROPERTIES:
+:CUSTOM_ID: async-query
+:DESCRIPTION: Running goals in seperate threads, redirecting their output to 
Emacs buffers
+:ALT_TITLE: Async Queries
+:END:
+
+#+CINDEX: async queries
+#+CINDEX: query asynchronously
+#+CINDEX: Sweep Async Output mode
+Sweep provides a facility for executing Prolog goals in separate
+threads and capturing their output in Emacs buffers as it is produced.
+You can use this for running queries without blocking Emacs.
+
+- Key: C-c C-& (sweeprolog-async-goal) :: Execute a Prolog goal
+  asynchronously and display its output in a dedicated buffer.
+
+The command ~M-x sweeprolog-async-goal~, bound to ~C-c C-&~ in
+~sweeprolog-mode~ buffers, prompts for a Prolog goal and executes it in
+a new Prolog thread, redirecting its output and error streams to an
+Emacs buffer that gets updated asynchronously.
+
+This is similar in nature to running asynchronous shell commands with
+the standard ~M-&~ (~async-shell-command~) or ~M-x compile~, expect that
+~sweeprolog-async-goal~ runs a Prolog goal instead of a shell command.
+For more information about these commands see [[info:emacs#Single 
Shell][Single Shell]] and
+[[info:emacs#Compilation][Compilation]] in the Emacs manual.
+
+The output buffer that ~sweeprolog-async-goal~ creates uses a dedicated
+mode called /Sweep Async Output mode/.  This mode is derived from the
+standard Compilation mode, it provides all of the usual commands
+documented in [[info:emacs#Compilation Mode][Compilation Mode]].  Notably, you 
can run the same query
+again by typing ~g~ (~sweeprolog-async-goal-restart~) in the output
+buffer.  To interrupt the goal running in the current output buffer,
+press ~C-c C-k~ (~kill-compilation~).
+
+_Compatibility note_: asynchronous queries use pipe processes that
+require Emacs 28 or later and SWI-Prolog 9.1.4 or later.
+
 * Finding Prolog code
 :PROPERTIES:
 :CUSTOM_ID: finding-prolog-code
@@ -1957,6 +1996,7 @@ The full list of keybindings in ~sweeprolog-prefix-map~ 
is given below:
 | ~p~   | ~sweeprolog-find-predicate~            | [[*Finding Prolog 
code][Finding Prolog Code]]               |
 | ~q~   | ~sweeprolog-top-level-send-goal~       | 
[[#top-level-send-goal][Sending Goals to the Top-level]]    |
 | ~t~   | ~sweeprolog-top-level~                 | [[#prolog-top-level][The 
Prolog Top-level]]              |
+| ~&~   | ~sweeprolog-async-goal~                | [[#async-query][Executing 
Prolog Asynchronously]]   |
 
 * Examining Prolog messages
 :PROPERTIES:
diff --git a/sweep.c b/sweep.c
index d83396bcd5..decb8208f7 100644
--- a/sweep.c
+++ b/sweep.c
@@ -387,6 +387,17 @@ sweep_cut_query(emacs_env *env, ptrdiff_t nargs, 
emacs_value *args, void *data)
   }
 }
 
+#if defined EMACS_MAJOR_VERSION && EMACS_MAJOR_VERSION >= 28
+emacs_value
+sweep_open_channel(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
+{
+  if (nargs == 1) {
+    return env->make_integer(env, env->open_channel(env, args[0]));
+  }
+  return enil(env);
+}
+#endif
+
 emacs_value
 sweep_next_solution(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
 {
@@ -474,6 +485,19 @@ sweep_open_query(emacs_env *env, ptrdiff_t nargs, 
emacs_value *args, void *data)
   return r;
 }
 
+static foreign_t
+sweep_fd_open(term_t f, term_t o) {
+  IOSTREAM *w;
+  int fd = -1;
+
+  if (PL_get_integer(f, &fd) &&
+      (w = Sfdopen(fd, "w")) &&
+      PL_unify_stream(o, w))
+    return TRUE;
+
+  return FALSE;
+}
+
 static foreign_t
 sweep_funcall0(term_t f, term_t v) {
   char * string = NULL;
@@ -552,6 +576,7 @@ sweep_initialize(emacs_env *env, ptrdiff_t nargs, 
emacs_value *args, void *data)
 
   PL_register_foreign("sweep_funcall", 3, sweep_funcall1, 0);
   PL_register_foreign("sweep_funcall", 2, sweep_funcall0, 0);
+  PL_register_foreign("sweep_fd_open", 2, sweep_fd_open,  0);
 
   r = PL_initialise(nargs, argv);
 
@@ -675,6 +700,13 @@ This function drops the current instantiation of the query 
variables.",
   emacs_value args_cleanup[] = {symbol_cleanup, func_cleanup};
   env->funcall (env, env->intern (env, "defalias"), 2, args_cleanup);
 
+#if defined EMACS_MAJOR_VERSION && EMACS_MAJOR_VERSION >= 28
+  emacs_value symbol_open_channel = env->intern (env, 
"sweeprolog-open-channel");
+  emacs_value func_open_channel = env->make_function (env, 1, 1, 
sweep_open_channel, "Open channel.", NULL);
+  emacs_value args_open_channel[] = {symbol_open_channel, func_open_channel};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_open_channel);
+#endif
+
   provide(env, "sweep-module");
 
   return 0;
diff --git a/sweep.pl b/sweep.pl
index 7cfb80bac8..302f9fea0b 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -76,7 +76,9 @@
             sweep_current_functors/2,
             sweep_term_search/2,
             sweep_terms_at_point/2,
-            sweep_predicate_dependencies/2
+            sweep_predicate_dependencies/2,
+            sweep_async_goal/2,
+            sweep_interrupt_async_goal/2
           ]).
 
 :- use_module(library(pldoc)).
@@ -1154,3 +1156,31 @@ sweep_predicate_dependencies([To0|From0], Deps) :-
                           term_string(PI0, PI)
                       ),
           Deps).
+
+sweep_async_goal([GoalString|FD], TId) :-
+    term_string(Goal, GoalString),
+    random_between(1, 1024, Cookie),
+    thread_self(Self),
+    thread_create(sweep_start_async_goal(Self, Cookie, Goal, FD), T,
+                  [detached(true)]),
+    at_halt((   is_thread(T),
+                thread_property(T, status(running))
+            ->  thread_signal(T, thread_exit(0)),
+                thread_join(T, _)
+            ;   true
+            )),
+    thread_get_message(sweep_async_goal_started(Cookie)),
+    thread_property(T, id(TId)).
+
+sweep_start_async_goal(Caller, Cookie, Goal, FD) :-
+    thread_send_message(Caller, sweep_async_goal_started(Cookie)),
+    setup_call_cleanup((   sweep_fd_open(FD, Out),
+                           set_prolog_IO(current_input, Out, Out)
+                       ),
+                       once(Goal),
+                       (   format("~nSweep async goal finished~n"),
+                           close(Out)
+                       )).
+
+sweep_interrupt_async_goal(TId, TId) :-
+    thread_signal(TId, throw(interrupted)).
diff --git a/sweeprolog.el b/sweeprolog.el
index 33aa182852..7b1d08da3c 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -409,6 +409,7 @@ token via its `help-echo' text property."
                 (if (fboundp 'flymake-show-buffer-diagnostics)  ;; Flymake 
1.2.1+
                     #'sweeprolog-show-diagnostics
                   #'flymake-show-diagnostics-buffer))
+    (define-key map (kbd "C-c C-&") #'sweeprolog-async-goal)
     (define-key map (kbd "C-M-^")   #'kill-backward-up-list)
     (define-key map (kbd "C-M-m")   #'sweeprolog-insert-term-dwim)
     (define-key map (kbd "M-p")     #'sweeprolog-backward-predicate)
@@ -466,6 +467,7 @@ token via its `help-echo' text property."
     (define-key map "p" #'sweeprolog-find-predicate)
     (define-key map "q" #'sweeprolog-top-level-send-goal)
     (define-key map "t" #'sweeprolog-top-level)
+    (define-key map "&" #'sweeprolog-async-goal)
     map)
   "Keymap for `sweeprolog' global commands.")
 
@@ -517,6 +519,7 @@ token via its `help-echo' text property."
                            sweeprolog-top-level-thread-id)))
                   (buffer-list)) ]
     [ "Send Goal to Top-level" sweeprolog-top-level-send-goal t ]
+    [ "Run Async Goal" sweeprolog-async-goal t ]
     [ "Open Top-level Menu" sweeprolog-list-top-levels t ]
     "--"
     [ "Describe Predicate" sweeprolog-describe-predicate t ]
@@ -5361,6 +5364,100 @@ the position for which the menu is created.")
   menu)
 
 
+
+;;;; Async Prolog Queries
+
+(defvar-local sweeprolog-async-goal-thread-id nil
+  "Prolog thread running the async goal of the current buffer.")
+
+(defvar-local sweeprolog-async-goal-current-goal nil
+  "Prolog async goal of the current buffer.")
+
+(defun sweeprolog-async-goal-interrupt (proc &optional _group)
+  "Interrupt async Prolog goal associated with process PROC."
+  (with-current-buffer (process-buffer proc)
+    (sweeprolog--query-once "sweep" "sweep_interrupt_async_goal"
+                            sweeprolog-async-goal-thread-id)))
+
+(defun sweeprolog-async-goal-filter (proc string)
+  "Process filter function for async Prolog queries.
+
+Deletes PROC if STRING contains an end of output marker string."
+  (internal-default-process-filter proc string)
+  (when (string-match (rx "Sweep async goal finished")
+                      string)
+    (sit-for 1)
+    (delete-process proc)))
+
+(defun sweeprolog-async-goal-start (goal &optional buffer)
+  "Start async Prolog goal GOAL and direct its output to BUFFER."
+  (setq buffer (or buffer (current-buffer)))
+  (sweeprolog-ensure-initialized)
+  (if (fboundp 'sweeprolog-open-channel)
+      (let* ((proc (make-pipe-process
+                    :name (concat "?- " goal)
+                    :buffer buffer
+                    :filter #'sweeprolog-async-goal-filter))
+             (fd (sweeprolog-open-channel proc)))
+        (sweeprolog--query-once "sweep" "sweep_async_goal"
+                                (cons goal fd)))
+    (error "Async queries require Emacs 28 and SWI-Prolog 9.1.4 or later")))
+
+(defun sweeprolog-async-goal-restart ()
+  "Restart async Prolog goal in the current buffer."
+  (interactive "" sweeprolog-async-goal-output-mode)
+  (when-let ((proc (get-buffer-process (current-buffer))))
+    (if (process-live-p proc)
+        (if (yes-or-no-p "A goal is running; kill it? ")
+            (condition-case ()
+                (progn
+                  (interrupt-process proc)
+                  (sit-for 1)
+                  (delete-process proc))
+              (error nil))
+          (error "Cannot have two processes in `%s' at once"
+                 (buffer-name)))))
+  (setq sweeprolog-async-goal-thread-id
+        (sweeprolog-async-goal-start
+         sweeprolog-async-goal-current-goal)))
+
+(defvar sweeprolog-async-goal-output-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map compilation-mode-map)
+    (define-key map (kbd "g") #'sweeprolog-async-goal-restart)
+    map)
+  "Keymap used by `sweeprolog-async-goal-output-mode'.")
+
+(define-compilation-mode sweeprolog-async-goal-output-mode
+  "Sweep Async Output"
+  "Major mode for viewing the output of async Prolog queries."
+  (add-hook 'interrupt-process-functions
+            #'sweeprolog-async-goal-interrupt nil t)
+  (add-hook 'kill-buffer-hook
+            (lambda ()
+              (when-let ((proc (get-buffer-process (current-buffer))))
+                (when (and (process-live-p proc)
+                           sweeprolog-async-goal-thread-id)
+                  (condition-case _
+                      (sweeprolog--query-once "sweep" 
"sweep_interrupt_async_goal"
+                                              sweeprolog-async-goal-thread-id)
+                    (prolog-exception nil)))))
+            nil t))
+
+;;;###autoload
+(defun sweeprolog-async-goal (goal)
+  "Execute GOAL and display its output in a buffer asynchronously."
+  (interactive (list (sweeprolog-read-goal "[async] ?- ")))
+  (let* ((buffer-name (generate-new-buffer-name
+                       (format "*Async Output for %s*" goal)))
+         (buffer (get-buffer-create buffer-name))
+         (tid (sweeprolog-async-goal-start goal buffer)))
+    (with-current-buffer buffer
+      (sweeprolog-async-goal-output-mode)
+      (setq sweeprolog-async-goal-thread-id     tid
+            sweeprolog-async-goal-current-goal goal))
+    (display-buffer buffer)))
+
 ;;;; Footer
 
 (provide 'sweeprolog)