[61_7] S7: rework in Scheme

## What
New feature:

![img_v3_02ct_4d5b161e-8121-47db-ab94-a0a62f6e2c0g](https://github.com/user-attachments/assets/e23d14b1-1511-43ec-ada3-2d92a586d4f3)

The other features remains the same with the cpp impl.

## Why
To make it easier to maintain.

## How
+ Open `61_7.tm`
+ Open `Help -> Plugins -> S7 Scheme`

TeXmacs/plugins/s7/packages/code/s7.ts

@@ -39,6 +39,15 @@
       <generic-input|<arg|prompt>|<arg|body>>
     </with>
   </macro>>
+
+  \;
+
+  <assign|s7-result|<\macro|body>
+    <with|ornament-border|0ln|ornament-hpadding|0spc|padding-above|0fn|padding-below|0fn|ornament-color|pastel
+    green|<\ornamented>
+      <arg|body>
+    </ornamented>>
+  </macro>>
 </body>
 
 <initial|<\collection>

TeXmacs/plugins/s7/progs/init-s7.scm

@@ -20,7 +20,8 @@
     (string-append s "\n<EOF>\n")))
 
 (define (s7-launcher)
-  "tm_s7")
+  (string-append "tm_s7" " " (url->system (get-texmacs-path))
+    "/plugins/s7/s7/tm-s7.scm"))
 
 (plugin-configure s7
   (:require (url-exists-in-path? "tm_s7"))

TeXmacs/plugins/s7/s7/texmacs/protocol.scm

@@ -0,0 +1,47 @@
+;
+; Copyright (C) 2024 The S7 SRFI Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(define-library (texmacs protocol)
+(export data-begin data-end data-escape 
+        flush-verbatim flush-prompt flush-scheme)
+(begin
+
+(define (data-begin)
+  (display (integer->char 2)))
+
+(define (data-end)
+  (display (integer->char 5))
+  (flush-output-port))
+
+(define (data-escape)
+  (write (integer->char 27)))
+
+(define (flush-any msg)
+  (data-begin)
+  (display msg)
+  (data-end))
+
+(define (flush-verbatim msg)
+  (flush-any (append "verbatim:" msg)))
+
+(define (flush-scheme msg)
+  (flush-any (append "scheme:" msg)))
+
+(define (flush-prompt msg)
+  (flush-any (append "prompt#" msg)))
+
+) ; end of begin
+) ; end of define-library

TeXmacs/plugins/s7/s7/tm-s7.scm

@@ -0,0 +1,111 @@
+;
+; Copyright (C) 2024 The S7 SRFI Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(set! *load-path*
+  (cons (append (getenv "TEXMACS_PATH") "/plugins/s7/s7")
+        *load-path*))
+
+(import (texmacs protocol))
+
+
+(define (s7-welcome)
+  (flush-prompt "> ")
+  (flush-verbatim
+    (append "S7 Scheme: " (substring (*s7* 'version) 3))))
+
+(define (s7-repl)
+  ; SRFI 1
+  (define (find pred l)
+    (cond ((null? l) #f)
+          ((pred (car l)) (car l)) 
+          (else (find pred (cdr l)))))
+
+  ; SRFI 13
+  (define (string-join l)
+    (cond ((null? l) "")
+          ((= (length l) 1) (car l))
+          (else
+            (append
+              (car l)
+              (string-join (cdr l))))))
+
+  (define (string-prefix? prefix str)
+    (let* ((prefix-len (length prefix))
+           (str-len (length str)))
+      (and (<= prefix-len str-len)
+           (let loop ((i 0))
+             (or (= i prefix-len)
+                 (and (char=? (string-ref prefix i)
+                              (string-ref str i))
+                      (loop (+ i 1))))))))
+
+  (define (s7-read-code)
+    (define (read-code code)
+      (let ((line (read-line)))
+        (if (string=? line "<EOF>\n")
+            code
+            (read-code (append code line)))))
+
+    (read-code ""))
+
+  (define (escape-string str)
+    (string-join
+      (map (lambda (char)
+             (if (char=? char #\")
+                 (string #\\ #\")
+                 (if (char=? char #\\)
+                     (string #\\ #\\)
+                     (string char))))
+           (string->list str))))
+
+  (define (s7-quote s)
+    (append "\"" (escape-string s) "\""))
+
+  (define (build-s7-result obj)
+    (let ((output (object->string obj))
+          (leadings (list "(document" "(math" "(equation*" "(align" "(with" "(graphics")))
+      (if (find (lambda (x) (string-prefix? x output)) leadings)
+          output
+          (append "(s7-result " (s7-quote output) ")"))))
+
+  (define (s7-print obj)
+    (if (eq? obj #<unspecified>)
+      (flush-scheme "")
+      (flush-scheme (build-s7-result obj))))
+
+  (define (eval-and-print code)
+    (catch #t
+      (lambda ()
+        (s7-print (eval-string code (rootlet))))
+      (lambda args
+        (begin
+          (flush-scheme
+            (append "(errput (document "
+              (s7-quote (symbol->string (car args)))
+              (s7-quote (apply format #f (cadr args)))
+              "))"))))))
+
+  (define (read-eval-print)
+    (let ((code (s7-read-code)))
+      (if (string=? code "")
+        #t
+        (eval-and-print code))))
+
+  (begin (read-eval-print)
+         (s7-repl)))
+
+(s7-welcome)
+(s7-repl)

TeXmacs/plugins/s7/src/tm_s7.cpp → TeXmacs/plugins/s7/src/s7.c

@@ -1,19 +1,18 @@
 /* 0-clause BSD */
 
-/* Adapted from repl.c in the s7 official repo */
+/* gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I. -ldl */
 
-#include <iostream>
-#include <sstream>
-#include <unordered_set>
-#include <vector>
-
-using std::cout;
-using std::flush;
-using std::string;
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifndef _MSC_VER
+#include <errno.h>
+#include <unistd.h>
+#endif
 
 #include "s7.h"
 
-string str_r7rs_define_library=
+char* str_r7rs_define_library=
     "(define-macro (define-library libname . body) ; |(lib name)| -> "
     "environment\n"
     "  `(define ,(symbol (object->string libname))\n"
@@ -33,7 +32,7 @@ string str_r7rs_define_library=
     "                         (values)\n"
     "                         entry))\n"
     "                   (curlet))))))\n";
-string str_r7rs_library_filename=
+char* str_r7rs_library_filename=
     "(unless (defined? 'r7rs-import-library-filename)\n"
     "  (define (r7rs-import-library-filename libs)\n"
     "    (when (pair? libs)\n"
@@ -52,7 +51,7 @@ string str_r7rs_library_filename=
     "        (unless (member lib-filename (*s7* 'file-names))\n"
     "          (load lib-filename)))\n"
     "      (r7rs-import-library-filename (cdr libs)))))\n";
-string str_r7rs_import=
+char* str_r7rs_import=
     "(define-macro (import . libs)\n"
     "  `(begin\n"
     "     (r7rs-import-library-filename ',libs)\n"
@@ -114,121 +113,31 @@ string str_r7rs_import=
     "                          (symbol->value sym))))))\n"
     "              libs))))\n";
 
-#define DATA_BEGIN ((char) 2)
-#define DATA_END ((char) 5)
-#define DATA_ESCAPE ((char) 27)
-
-void
-data_begin () {
-  cout << DATA_BEGIN;
-}
-
-void
-data_end () {
-  cout << DATA_END << flush;
-}
-
-void
-flush_scheme (string msg) {
-  data_begin ();
-  cout << "scheme:" << msg;
-  data_end ();
-}
-
-void
-flush_verbatim (string msg) {
-  data_begin ();
-  cout << "verbatim:" << msg;
-  data_end ();
-}
-
-void
-flush_prompt (string prompt) {
-  data_begin ();
-  cout << "prompt#" << prompt;
-  data_end ();
-}
-
-string
-getBeforeSpace (const string& str) {
-  size_t pos= str.find (' ');
-  if (pos == string::npos) {
-    return str;
-  }
-  return str.substr (0, pos);
-}
-
-std::string::size_type
-findBegin (const std::string& s) {
-  std::string::size_type pos= s.find_first_not_of (" \t\n\r\f\v");
-  return (pos == std::string::npos) ? s.length () : pos;
-}
-
-std::string::size_type
-findEnd (const std::string& s) {
-  std::string::size_type pos= s.find_last_not_of (" \t\n\r\f\v");
-  return (pos == std::string::npos) ? 0 : pos + 1;
-}
-
-std::string
-trim (const std::string& s) {
-  std::string::size_type left = findBegin (s);
-  std::string::size_type right= findEnd (s);
-  return s.substr (left, right - left);
-}
-
 int
 main (int argc, char** argv) {
-  std::unordered_set<std::string> scheme_headers= {
-      "(document", "(math", "(equation*", "(align", "(with", "(graphics"};
-
-  std::stringstream welcome;
-  welcome << "S7 Scheme " << S7_VERSION << " (" << S7_DATE << ")\n";
-  flush_verbatim (welcome.str ());
-  flush_prompt ("> ");
-
-  const char*       env_key  = "TEXMACS_PATH";
-  const char*       env_value= getenv (env_key);
-  std::stringstream load_path;
-  load_path << env_value << "/plugins/s7/s7";
-
   s7_scheme* sc;
-  sc= s7_init ();
-  s7_eval_c_string (sc, str_r7rs_define_library.c_str ());
-  s7_eval_c_string (sc, str_r7rs_library_filename.c_str ());
-  s7_eval_c_string (sc, str_r7rs_import.c_str ());
 
-  s7_add_to_load_path (sc, load_path.str ().c_str ());
-
-  while (true) {
-    string first_line;
-    std::getline (std::cin, first_line);
-    std::vector<string> lines;
-    lines.push_back (first_line);
-    std::stringstream ss;
-    string            line= first_line;
-    while (line != "<EOF>") {
-      ss << line << "\n";
-      line= "";
-      std::getline (std::cin, line);
+  sc= s7_init ();
+  s7_eval_c_string (sc, str_r7rs_define_library);
+  s7_eval_c_string (sc, str_r7rs_library_filename);
+  s7_eval_c_string (sc, str_r7rs_import);
+  if (argc >= 2) {
+    if (strcmp (argv[1], "-e") == 0) /* repl -e '(+ 1 2)' */
+    {
+      s7_pointer x;
+      x= s7_eval_c_string (sc, argv[2]);
+      fprintf (stdout, "%s\n", s7_object_to_c_string (sc, x));
+      return (0);
     }
-    s7_pointer x     = s7_eval_c_string (sc, ss.str ().c_str ());
-    string     result= s7_object_to_c_string (sc, x);
-    if (result.size () == 0) {
-      flush_verbatim ("");
+    if (strcmp (argv[1], "--version") == 0) {
+      fprintf (stdout, "s7: %s, %s\n", S7_VERSION, S7_DATE);
+      return (0);
     }
-    else {
-      string trimmed= trim (result);
-      string head   = getBeforeSpace (trimmed);
-      if (trimmed[trimmed.size () - 1] == ')' &&
-          scheme_headers.find (head) != scheme_headers.end ()) {
-        flush_scheme (trimmed);
-      }
-      else {
-        flush_verbatim (result);
-      }
+    errno= 0;
+    if (!s7_load (sc, argv[1])) {
+      fprintf (stderr, "%s: %s\n", strerror (errno), argv[1]);
+      return (2);
     }
   }
-
-  return 0;
+  return (0);
 }