;; -*- 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 . (:print-func (lambda (s) (format "(princ \"%s\")" s))
             :var-assigner (lambda (body vars) body)))
    (haskell . (:var-assigner (lambda (body vars) body)
                :print-func (lambda (s) (format "putStrLn \"%s\"" s))))
    (sh . (:change-dir (lambda (d) (format "cd '%s'" d))
           :print-func (lambda (s) (format "echo \"%s\"" s))
           :var-assigner (lambda (body vars) body))))
  "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 (:change-dir
                                              :print-func ;; needed for the detecting if a code block is finished
                                              :var-assigner))
                   :value-type function))))

(defvar org-babel-default-header-args:term
  '((:session . "*ob-term*")
    ;; The value of `:create' must be a list of a function and its
    ;; arguments.  As the first argument the buffer-name (from the
    ;; `:session' parameter) will be spliced into the list.  You can
    ;; provide your own function but make sure that they adhere to
    ;; this convention.  See the functions `ob-term-term',
    ;; `ob-term-serial-term' and `ob-term-comint' as an example.
  '((:session . "*ob-term*")
    ;; The value of `:create' must be a list of a function and its
    ;; arguments.  As the first argument the buffer-name (from the
    ;; `:session' parameter) will be spliced into the list.  You can
    ;; provide your own function but make sure that they adhere to
    ;; this convention.  See the functions `ob-term-term',
    ;; `ob-term-serial-term' and `ob-term-comint' as an example.
  '((:session . "*ob-term*")
    ;; The value of `:create' must be a list of a function and its
    ;; arguments.  As the first argument the buffer-name (from the
    ;; `:session' parameter) will be spliced into the list.  You can
    ;; provide your own function but make sure that they adhere to
    ;; this convention.  See the functions `ob-term-term',
    ;; `ob-term-serial-term' and `ob-term-comint' as an example.
    (:create . nil)
    (:eol . "\n")
    (:results . "output")
    ;; Pause between each line the given number of seconds.  The only
    ;; times I needed this is when communicating with ulisp via
    ;; serial-term.
    ;; Pause between each line the given number of seconds.  The only
    ;; times I needed this is when communicating with ulisp via
    ;; serial-term.
    ;; Pause between each line the given number of seconds.  The only
    ;; time I need this is, when communicating with ulisp via
    ;; serial-term.
    (:pause . nil))
  "Default arguments for evaluating a term block.")

;; TODO Setting of variables from header
;;;###autoload
(defun ob-term--execute (body params)
  ""
  (let* ((alias (backtrace-frame 2))
         (lang (substring (symbol-name (nth 1 alias)) 23))
         (insert-chdir (plist-get (alist-get (intern lang) ob-term-supported-languages) :change-dir))
         (insert-print (plist-get (alist-get (intern lang) ob-term-supported-languages) :print-func))
         (buffer (cdr (assoc :session params)))
         (buffer (cdr (assoc :session params)))
         (buffer (cdr (assoc :session params)))
         (dir (cdr (assoc :dir 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))
        (let ((form (cdr (assoc :create params))))
          (if form
              (apply (car form) buffer (cdr form))
            (error "buffer '%s' not found and no create function specified" buffer))))
        (let ((form (cdr (assoc :create params))))
          (if form
              (apply (car form) buffer (cdr form))
            (error "buffer '%s' not found and no create function specified" buffer))))
        (let ((form (cdr (assoc :create params))))
          (if form
              (apply (car form) buffer (cdr form))
            (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
                         (when (and insert-chdir dir) (funcall insert-chdir dir))
                         eol
                         body
                         (unless silent
                           (concat
                            eol
                            ;; 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 (buffer-name program &rest args)
(defun ob-term-term (buffer-name program &rest args)
(defun ob-term-term (buffer-name program &rest args)
  "Helper function to create a term buffer."
  (let ((buf (get-buffer-create buffer-name)))
    (unless (term-check-proc buf)
      (with-current-buffer buf
	(term-mode)
	(term-exec buf buffer-name program nil args)
        (term-char-mode)))
  (let ((buf (get-buffer-create buffer-name)))
    (unless (term-check-proc buf)
      (with-current-buffer buf
	(term-mode)
	(term-exec buf buffer-name program nil args)
        (term-char-mode)))
  (let ((buf (get-buffer-create buffer-name)))
    (unless (term-check-proc buf)
      (with-current-buffer buf
	(term-mode)
	(term-exec buf buffer-name program nil args)
        (term-char-mode)))
    (display-buffer buf)))

(defun ob-term-serial-term (_buffer-name port speed)
(defun ob-term-serial-term (_buffer-name port speed)
(defun ob-term-serial-term (_buffer-name 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-shell (program &optional buffer-name)
  "Helper function to create a comint buffer."
  (cl-letf (((symbol-function 'pop-to-buffer-same-window) #'pop-to-buffer))
    (let ((explicit-shell-file-name program)
          (prevbuf (current-buffer)))
      (shell (or buffer-name (format "*%s*" program)))
      (pop-to-buffer prevbuf))))

(defun ob-term-shell (program &optional buffer-name)
  "Helper function to create a comint buffer."
  (cl-letf (((symbol-function 'pop-to-buffer-same-window) #'pop-to-buffer))
    (let ((explicit-shell-file-name program)
          (prevbuf (current-buffer)))
      (shell (or buffer-name (format "*%s*" program)))
      (pop-to-buffer prevbuf))))

(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)

(defun ob-term-comint (buffer-name program &rest args)
(defun ob-term-comint (buffer-name program &rest args)
(defun ob-term-comint (buffer-name program &rest args)
  "Helper function to create a comint buffer."
  (apply #'make-comint-in-buffer buffer-name buffer-name program nil args)
  (display-buffer buffer-name))
  (apply #'make-comint-in-buffer buffer-name buffer-name program nil args)
  (display-buffer buffer-name))
  (apply #'make-comint-in-buffer buffer-name buffer-name program nil args)
  (display-buffer buffer-name))