ob-gdb.el -- org babel support for interacting with gdb in org-mode

ob-gdb.el

;;; ob-gdb.el --- Babel Functions for Gdb Evaluation -*- lexical-binding: t; -*-

;;; Commentary:

;; Org-Babel support for running gdb

;;; Code:

(require 'org-macs)
(org-assert-version)

(require 'ob)
(require 'org-macs)
(require 'ob-shell)
(require 'cl-lib)

(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)
		  t)
(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)
		  t)
(declare-function orgtbl-to-generic "org-table" (table params))

(defvar org-babel-default-header-args:gdb '())

(defconst org-babel-header-args:gdb
  '((async               . ((yes no))))
  "gdb-specific header arguments.")

(defvar org-babel-gdb-names)

(defconst org-babel-shell-set-prompt-commands
  '(;; Fish has no PS2 equivalent.
    ("fish" . "function fish_prompt\n\techo \"%s\"\nend")
    ;; prompt2 is like PS2 in POSIX shells.
    ("csh" . "set prompt=\"%s\"\nset prompt2=\"\"")
    ;; PROMPT_COMMAND can override PS1 settings.  Disable it.
    ;; Disable PS2 to avoid garbage in multi-line inputs.
    (t . "PROMPT_COMMAND=;PS1=\"%s\";PS2="))
  "Alist assigning shells with their prompt setting command.

Each element of the alist associates a shell type from
`org-babel-shell-names' with a template used to create a command to
change the default prompt.  The template is an argument to `format'
that will be called with a single additional argument: prompt string.

The fallback association template is defined in (t . \"template\")
alist element.")

(defun org-babel-shell-initialize ()
  "Define execution functions associated to shell names.
This function has to be called whenever `org-babel-shell-names'
is modified outside the Customize interface."
  (interactive)
  (dolist (name org-babel-shell-names)
    (let ((fname (intern (concat "org-babel-execute:" name))))
      (defalias fname
        (lambda (body params)
	  (:documentation
           (format "Execute a block of %s commands with Babel." name))
	  (let ((explicit-shell-file-name name)
                (shell-file-name name))
	    (org-babel-execute:shell body params))))
      (put fname 'definition-name 'org-babel-shell-initialize))
    (defalias (intern (concat "org-babel-variable-assignments:" name))
      #'org-babel-variable-assignments:gdb
      (format "Return list of %s statements assigning to the block's \
variables."
	      name))
    (funcall (if (fboundp 'defvar-1) #'defvar-1 #'set) ;Emacs-29
             (intern (concat "org-babel-default-header-args:" name))
             org-babel-default-header-args:shell)
    (funcall (if (fboundp 'defvar-1) #'defvar-1 #'set) ;Emacs-29
             (intern (concat "org-babel-header-args:" name))
             org-babel-header-args:shell)))

(defcustom org-babel-shell-names
  '("sh" "bash" "zsh" "fish" "csh" "ash" "dash" "ksh" "mksh" "posh")
  "List of names of shell supported by babel shell code blocks.
Call `org-babel-shell-initialize' when modifying this variable
outside the Customize interface."
  :group 'org-babel
  :type '(repeat (string :tag "Shell name: "))
  :set (lambda (symbol value)
	 (set-default-toplevel-value symbol value)
	 (org-babel-shell-initialize)))

(defcustom org-babel-shell-results-defaults-to-output t
  "Let shell execution defaults to \":results output\".

When set to t, use \":results output\" when no :results setting
is set.  This is especially useful for inline source blocks.

When set to nil, stick to the convention of using :results value
as the default setting when no :results is set, the \"value\" of
a shell execution being its exit code."
  :group 'org-babel
  :type 'boolean
  :package-version '(Org . "9.4"))

(defun org-babel-execute:gdb (body params)
  "Execute Gdb BODY according to PARAMS.
This function is called by `org-babel-execute-src-block'."
  (let* ((session (org-babel-gdb-initiate-session
		           (cdr (assq :session params))))
	     (stdin (let ((stdin (cdr (assq :stdin params))))
                  (when stdin (org-babel-sh-var-to-string
                               (org-babel-ref-resolve stdin)))))
	     (results-params (cdr (assq :result-params params)))
	     (value-is-exit-status
	      (or (and
	           (equal '("replace") results-params))
	          (member "value" results-params)))
	     (cmdline (cdr (assq :cmdline params)))
         (full-body (concat
		             (org-babel-expand-body:generic
		              body params (org-babel-variable-assignments:gdb params))
		             ;; (when value-is-exit-status
                     ;;   "\necho $?")
                     )))
    (org-babel-reassemble-table
     (org-babel-gdb-evaluate session full-body params stdin cmdline)
     (org-babel-pick-name
      (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
     (org-babel-pick-name
      (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))

(defun org-babel-prep-session:gdb (session params)
  "Prepare SESSION according to the header arguments specified in PARAMS."
  (let* ((session (org-babel-gdb-initiate-session session))
	     (var-lines (org-babel-variable-assignments:gdb params)))
    (org-babel-comint-in-buffer session
      (mapc (lambda (var)
              (insert var) (comint-send-input nil t)
              (org-babel-comint-wait-for-output session))
	        var-lines))
    session))

(defun org-babel-load-session:gdb (session body params)
  "Load BODY into SESSION."
  (save-window-excursion
    (let ((buffer (org-babel-prep-session:gdb session params)))
      (with-current-buffer buffer
        (goto-char (process-mark (get-buffer-process (current-buffer))))
        (insert (org-babel-chomp body)))
      buffer)))


;;; Helper functions
(defun org-babel--variable-assignments:gdb-generic
    (varname values &optional sep hline)
  "Return a list of statements declaring the values as a generic variable."
  (format "set %s = %s" varname (org-babel-sh-var-to-sh values sep hline)))

(defun org-babel-variable-assignments:gdb (params)
  "Return list of shell statements assigning the block's variables."
  (let ((sep (cdr (assq :separator params)))
	    (hline (when (string= "yes" (cdr (assq :hlines params)))
		         (or (cdr (assq :hline-string params))
		             "hline"))))
    (mapcar
     (lambda (pair)
       (org-babel--variable-assignments:gdb-generic
	    (car pair) (cdr pair) sep hline))
     (org-babel--get-vars params))))

(defvar org-babel-gdb-eoe-indicator "echo org_babel_gdb_eoe\\n"
  "String to indicate that evaluation has completed.")
(defvar org-babel-gdb-eoe-output "org_babel_gdb_eoe"
  "String to indicate that evaluation has completed.")
(defvar org-babel-gdb-prompt "(gdb) "
  "String to set prompt in session shell.")

(defun org-babel-gdb-initiate-session (&optional session _params)
  "Initiate a session named SESSION according to PARAMS."
  (when (and session (not (string= session "none")))
    (save-window-excursion
      (or (org-babel-comint-buffer-livep session)
          (progn
            (let ((session-buffer (save-window-excursion
			                        (comint-run "gdb" nil)
			                        (rename-buffer session)
			                        (current-buffer))))
              (message "debug %s" session-buffer)
	          (if (org-babel-comint-buffer-livep session-buffer)
	              (progn
                    (sit-for .25)
                    (with-current-buffer session-buffer
                      (setq-local org-babel-comint-prompt-regexp-old comint-prompt-regexp
                                  comint-prompt-regexp
                                  (concat "^" (regexp-quote org-babel-gdb-prompt)
                                          " *"))
                      (current-buffer)))
	            (sit-for .5)
	            (org-babel-gdb-initiate-session session)))
            ;; Set unique prompt for easier analysis of the output.
            ;; (org-babel-comint-wait-for-output (current-buffer))
            ;; (org-babel-comint-input-command
            ;;  (current-buffer)
            ;;  (format
            ;;   (or (cdr (assoc (file-name-nondirectory shell-file-name)
            ;;                   org-babel-shell-set-prompt-commands))
            ;;       (alist-get t org-babel-shell-set-prompt-commands))
            ;;   org-babel-sh-prompt))
	        ;; Needed for Emacs 23 since the marker is initially
	        ;; undefined and the filter functions try to use it without
	        ;; checking.
	        ;; (set-marker comint-last-output-start (point))
	        )))))

(defun org-babel-gdb-evaluate (session body &optional params stdin cmdline)
  "Pass BODY to the Shell process in BUFFER.
If RESULT-TYPE equals `output' then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals `value' then
return the value of the last statement in BODY."
  (let* ((async (org-babel-comint-use-async params))
	     (results-params (cdr (assq :result-params params)))
	     (value-is-exit-status
	      (or (and
	           (equal '("replace") results-params)
	           (not org-babel-shell-results-defaults-to-output))
	          (member "value" results-params)))
	     (results
	      (cond
	       ((or stdin cmdline)	       ; external shell script w/STDIN
            (user-error "don't support external script execution for our purpose yet."))
	       (session			; session evaluation
            (if async
                (user-error "no time for async as well")
	          (mapconcat
	           #'org-babel-gdb-strip-weird-long-prompt
	           (mapcar
	            #'org-trim
	            (butlast ; Remove eoe indicator
	             (org-babel-comint-with-output
		             (session org-babel-gdb-eoe-output t body)
                   (insert (org-trim body)
                           "\n"
                           org-babel-gdb-eoe-indicator)
		           (comint-send-input nil t))
                 ;; Remove `org-babel-gdb-eoe-indicator' output line.
	             1))
	           "\n")))
	       (t
            (user-error "no gdb session alive")))))
    (when (and results value-is-exit-status)
      (setq results (car (reverse (split-string results "\n" t)))))
    (when results
      (let ((result-params (cdr (assq :result-params params))))
        (org-babel-result-cond result-params
          results
          (let ((tmp-file (org-babel-temp-file "gdb-")))
            (with-temp-file tmp-file (insert results))
            (org-babel-import-elisp-from-file tmp-file)))))))

(defun org-babel-gdb-strip-weird-long-prompt (string)
  "Remove prompt cruft from a string of shell output."
  (while (string-match "^% +[\r\n$]+ *" string)
    (setq string (substring string (match-end 0))))
  string)

(provide 'ob-gdb)

;;; ob-gdb.el ends here

usage example

#+begin_src gdb :session test :results output
file <some binary program that you want to attach to>
#+end_src