@@ -0,0 +1,265 @@
; ;; 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" &rest body)
t )
(declare-function org-babel-comint-wait-for-output " ob-comint"
(declare-function org-babel-comint-buffer-livep " ob-comint"
(declare-function org-babel-comint-with-output " ob-comint" &rest body)
t )
(declare-function orgtbl-to-generic " org-table"
(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\t echo \" %s\"\n end"
; ; prompt2 is like PS2 in POSIX shells.
(" csh" . " set prompt=\" %s\"\n set 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:"
(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:"
#'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:"
org-babel-default-header-args:shell)
(funcall (if (fboundp 'defvar-1 ) #'defvar-1 #'set ) ; Emacs-29
(intern (concat " org-babel-header-args:"
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"
(member " value"
(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"
(not org-babel-shell-results-defaults-to-output))
(member " value"
(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 $]+ *"
(setq string (substring string (match-end 0 ))))
string)
(provide 'ob-gdb )
; ;; ob-gdb.el ends here
Inc0n revised this gist