;; -*- lexical-binding: t; -*-
;;; ob-term.el --- Evaluation of babel source code blocks in term buffers
;; Copyright 2023 Kai Harries <kai.harries@posteo.de>
;; Inspiration drawn from ob-async, ob-tmux and ob-uart
(provide 'ob-term)
(require 'ob)
(require 'ob-ref)
(require 'ob-comint)
(require 'ob-eval)
(defgroup ob-term nil
  "Evaluation of babel source code blocks in term buffers."
  :group 'org-babel)
(defcustom ob-term-supported-languages
  '((lisp . (:var-assigner (lambda (body vars) body)
             :print-func (lambda (s) (format "(princ \"%s\")" s))))
    (haskell . (:var-assigner (lambda (body vars) body)
                :print-func (lambda (s) (format "putStrLn \"%s\"" s))))
    (sh . (:var-assigner (lambda (body vars) body)
           :print-func (lambda (s) (format "echo \"%s\"" s)))))
  "The languages of babel source code blocks that term
supports.  A list of one entry per language.  Each entry is a
list on its own of a symbol (the language) and a function.  The
function receives the body of the code block and the variables
and should return the updated body."
  :package-version '(ob-term . "0.0.1")
  :group 'ob-term
  :type '(repeat
          (cons
           symbol
           (plist :key-type (symbol :options (:var-assigner :print-func))
                   :value-type function))))
(defvar org-babel-default-header-args:term
  '((:buffer . "*ob-term*")
    (:create . nil)
    (:eol . "\n")
    (:results . "output")
    (:pause . nil))
  "Default arguments for evaluating a term block.")
;; TODO Setting of variables from header
;; TODO tmux
;;;###autoload
(defun ob-term--execute (body params)
  ""
  (let* ((alias (backtrace-frame 2))
         (lang (substring (symbol-name (nth 1 alias)) 23))
         (insert-print (plist-get (alist-get (intern lang) ob-term-supported-languages) :print-func))
         (buffer (cdr (assoc :buffer params)))
         (eol (cdr (assoc :eol params)))
         (pause (cdr (assoc :pause params)))
         (sentinel (ob-term--random-string))
         (silent (or (member "none" (alist-get :result-params params))
                     (member "silent" (alist-get :result-params params)))))
    (if (null (get-buffer buffer))
        (if (cdr (assoc :create params))
            (eval (cdr (assoc :create params)))
          (error "buffer '%s' not found and no create function specified" buffer)))
    (let ((proc (get-buffer-process buffer)))
      (unless silent
        (set-process-filter proc (ob-term--process-filter
                                  (marker-position (process-mark proc))
                                  sentinel
                                  (current-buffer)
                                  proc))))
    (mapc (lambda (line)
            (if pause (sit-for pause))
            (process-send-string buffer (concat line eol)))
          (string-lines (concat
                         body
                         (unless silent
                           (concat
                            "\n"
                            ;; No `sit-for' or `sleep-for' after the below function call, otherwise
                            ;; the sentinel might not be inserted when the process-filter tries to
                            ;; replace it with the result!
                            (funcall insert-print (format "OBST-END-OF-OUTPUT %s" sentinel)))))))
    sentinel))
;;;; Helper functions
(defun ob-term--process-filter (mark sentinel orgbuf proc)
  (let ((orig-filter (process-filter proc)))
    (lambda (proc str)
      (funcall orig-filter proc str)
      (let ((result
             (with-current-buffer (process-buffer proc)
               (save-excursion
                 (when (progn (goto-char (point-max))
                              (search-backward sentinel mark t))
                   (goto-char mark)
                   (let ((start (move-beginning-of-line 1)))
                     (search-forward sentinel)
                     (move-beginning-of-line 1)
                     (buffer-substring start (point))))))))
        (when result
          (with-current-buffer orgbuf
            (save-excursion
              (goto-char (point-min))
              (search-forward sentinel)
              (previous-line 3)
              (org-babel-insert-result result '("replace"))))
          (set-process-filter proc orig-filter))))))
(defun ob-term-term (program &optional buffer-name)
  "Helper function to create a term buffer."
  (let ((buf (make-term (or buffer-name program) program)))
    (with-current-buffer buf
      (term-mode)
      (term-char-mode))
    (display-buffer buf)))
(defun ob-term-serial-term (port speed)
  "Helper function to create a serial-term buffer."
  (cl-letf (((symbol-function 'switch-to-buffer) #'display-buffer))
    (serial-term port speed)))
(defun ob-term--random-string ()
  "Generate a random string."
  (md5 (number-to-string (random))))
(defun ob-term-supported-languages-updated ()
  "Call this function if you have changed the supported languages."
  (interactive)
  (mapc (lambda (x)
          ;; Define function aliases for all supported languages
          (defalias
            (intern (format "org-babel-execute:term:%s" (car x)))
            'ob-term--execute)
          ;; Update `org-src-lang-modes' for syntax highlighting
          (let* ((stb-lang (format "term:%s" (car x)))
                 (cur (assoc stb-lang org-src-lang-modes)))
            (if cur
                (setf (cdr cur) (car x))
              (add-to-list 'org-src-lang-modes (cons stb-lang (car x)))))
          ;; Update `org-babel-default-header-args' for all supported languages
          (let ((sym (intern (format "org-babel-default-header-args:term:%s" (car x)))))
            (if (not (boundp sym))
                (set sym org-babel-default-header-args:term))))
        ob-term-supported-languages))
(ob-term-supported-languages-updated)

* ob-term
** serial term to ulisp
#+header: :create '(ob-term-serial-term "/dev/ttyACM0" 9600)
#+header: :buffer /dev/ttyACM0
#+header: :pause 0.2
#+begin_src term:lisp
  (defun sq (x) (* x x))
  (sq 3)
#+end_src
** bash shell in term-mode
#+header: :create '(ob-term-term "bash" "term-bash")
#+header: :buffer *term-bash*
#+begin_src term:sh :results silent
  PS1="$ "
#+end_src
#+header: :buffer *term-bash*
#+begin_src term:sh
  date
  sleep 1
  date
#+end_src
** ghci in term-mode
#+header: :create '(ob-term-term "ghci")
#+header: :buffer *ghci*
#+begin_src term:haskell
  3 * 3
  4 + 7
#+end_src
** a shell in comint-mode
#+header: :create '(shell)
#+header: :buffer *shell*
#+begin_src term:sh :results silent
  PS1=""
  echo ""
#+end_src
#+header: :buffer *shell*
#+begin_src term:sh
  date
  sleep 3
  date
#+end_src