diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-autodoc.el | 10 | ||||
| -rw-r--r-- | elisp/geiser-connection.el | 92 | ||||
| -rw-r--r-- | elisp/geiser-debug.el | 27 | ||||
| -rw-r--r-- | elisp/geiser-impl.el | 5 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 14 |
5 files changed, 106 insertions, 42 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index d0345e0..0d9d863 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -1,6 +1,6 @@ ;; geiser-autodoc.el -- autodoc mode -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -158,11 +158,15 @@ when `geiser-autodoc-display-module-p' is on." ;;; Autodoc function: (make-variable-buffer-local - (defvar geiser-autodoc--inhibit-flag nil)) + (defvar geiser-autodoc--inhibit-function nil)) + +(defsubst geiser-autodoc--inhibit () + (and geiser-autodoc--inhibit-function + (funcall geiser-autodoc--inhibit-function))) (defun geiser-autodoc--eldoc-function () (condition-case e - (and (not geiser-autodoc--inhibit-flag) + (and (not (geiser-autodoc--inhibit)) (geiser-autodoc--autodoc (geiser-syntax--scan-sexps))) (error (format "Autodoc not available (%s)" (error-message-string e))))) diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el index bdac427..f5b5928 100644 --- a/elisp/geiser-connection.el +++ b/elisp/geiser-connection.el @@ -123,23 +123,47 @@ ;;; Connection setup: +(make-variable-buffer-local + (defvar geiser-con--debugging-prompt-regexp nil)) + +(defun geiser-con--is-debugging () + (and geiser-con--debugging-prompt-regexp + comint-last-prompt-overlay + (string-match-p geiser-con--debugging-prompt-regexp + (buffer-substring (overlay-start + comint-last-prompt-overlay) + (overlay-end + comint-last-prompt-overlay))))) (defun geiser-con--cleanup-connection (c) (geiser-con--connection-cancel-timer c)) -(defun geiser-con--setup-connection (buffer prompt-regexp) +(defun geiser-con--setup-connection (buffer + prompt-regexp + &optional debug-prompt-regexp) (with-current-buffer buffer (when geiser-con--connection (geiser-con--cleanup-connection geiser-con--connection)) + (setq geiser-con--debugging-prompt-regexp debug-prompt-regexp) (setq geiser-con--connection (geiser-con--make-connection buffer)) - (geiser-con--setup-comint prompt-regexp) + (geiser-con--setup-comint prompt-regexp debug-prompt-regexp) (geiser-con--connection-start-timer geiser-con--connection) (message "Geiser REPL up and running!"))) -(defun geiser-con--setup-comint (prompt-regexp) - (set (make-local-variable 'comint-redirect-insert-matching-regexp) nil) - (set (make-local-variable 'comint-redirect-finished-regexp) prompt-regexp) - (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t)) +(defun geiser-con--setup-comint (prompt-regexp debug-prompt-regexp) + (set (make-local-variable 'comint-redirect-insert-matching-regexp) + (not (null debug-prompt-regexp))) + (set (make-local-variable 'comint-redirect-finished-regexp) + (if debug-prompt-regexp + (format "\\(%s\\)\\|\\(%s\\)" prompt-regexp debug-prompt-regexp) + prompt-regexp)) + (setq comint-prompt-regexp comint-redirect-finished-regexp) + (add-hook 'comint-redirect-hook 'geiser-con--comint-redirect-hook nil t) + (when debug-prompt-regexp + (add-hook 'comint-redirect-filter-functions + 'geiser-con--debug-watcher + nil + t))) ;;; Requests handling: @@ -149,29 +173,41 @@ (defun geiser-con--comint-buffer-form () (with-current-buffer (geiser-con--comint-buffer) - (condition-case nil - (progn - (goto-char (point-min)) - (re-search-forward "((\\(result\\|error\\)\\>") - (goto-char (match-beginning 0)) - (let ((form (read (current-buffer)))) - (if (listp form) form (error "")))) - (error `((error (key . geiser-con-error)) - (output . ,(buffer-string))))))) + (goto-char (point-max)) + (if (and geiser-con--debugging-prompt-regexp + (re-search-backward geiser-con--debugging-prompt-regexp nil t)) + `((error (key . geiser-debugger)) + (output . ,(buffer-substring (point-min) (point)))) + (condition-case nil + (progn + (goto-char (point-min)) + (re-search-forward "((\\(result\\|error\\)\\>") + (goto-char (match-beginning 0)) + (let ((form (read (current-buffer)))) + (if (listp form) form (error "")))) + (error `((error (key . geiser-con-error)) + (output . ,(buffer-string)))))))) (defun geiser-con--process-next (con) (when (not (geiser-con--connection-current-request con)) (let* ((buffer (geiser-con--connection-buffer con)) + (debug-prompt (with-current-buffer buffer + geiser-con--debugging-prompt-regexp)) (req (geiser-con--connection-pop-request con)) (str (and req (geiser-con--request-string req))) (cbuf (geiser-con--comint-buffer))) (if (not (buffer-live-p buffer)) (geiser-con--connection-cancel-timer con) (when (and buffer req str) - (with-current-buffer cbuf (delete-region (point-min) (point-max))) + (with-current-buffer cbuf + (setq comint-redirect-echo-input nil) + (setq geiser-con--debugging-prompt-regexp debug-prompt) + (delete-region (point-min) (point-max))) (set-buffer buffer) - (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str) - (comint-redirect-send-command (format "%s" str) cbuf nil t)))))) + (if (geiser-con--is-debugging) + (geiser-con--request-deactivate req) + (geiser-log--info "<%s>: %s" (geiser-con--request-id req) str) + (comint-redirect-send-command (format "%s" str) cbuf nil t))))))) (defun geiser-con--process-completed-request (req) (let ((cont (geiser-con--request-continuation req)) @@ -191,10 +227,20 @@ (defun geiser-con--comint-redirect-hook () (if (not geiser-con--connection) (geiser-log--error "No connection in buffer") - (let ((req (geiser-con--connection-current-request geiser-con--connection))) + (let ((req (geiser-con--connection-current-request + geiser-con--connection))) (if (not req) (geiser-log--error "No current request") (geiser-con--process-completed-request req) - (geiser-con--connection-clean-current-request geiser-con--connection))))) + (geiser-con--connection-clean-current-request + geiser-con--connection))))) + +(defun geiser-con--debug-watcher (pstr) + (when (string-match-p geiser-con--debugging-prompt-regexp pstr) + (setq comint-redirect-echo-input t) + (setq pstr (concat (with-current-buffer comint-redirect-output-buffer + (buffer-string)) + pstr))) + pstr) (defadvice comint-redirect-setup (after geiser-con--advice @@ -220,11 +266,15 @@ (defvar geiser-connection-timeout 30000 "Time limit, in msecs, blocking on synchronous evaluation requests") -(defun geiser-con--send-string/wait (buffer/proc str cont &optional timeout sbuf) +(defun geiser-con--send-string/wait (buffer/proc str cont + &optional timeout sbuf) (save-current-buffer (let ((con (geiser-con--get-connection buffer/proc))) (unless (geiser-con--connection-process con) (error geiser-con--error-message)) + (with-current-buffer (geiser-con--connection-buffer con) + (when (geiser-con--is-debugging) + (error "Geiser REPL is in debug mode"))) (let* ((req (geiser-con--send-string buffer/proc str cont sbuf)) (id (and req (geiser-con--request-id req))) (time (or timeout geiser-connection-timeout)) diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 9b31968..b181ef5 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -1,6 +1,6 @@ ;;; geiser-debug.el -- displaying debug information and evaluation results -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -59,18 +59,19 @@ non-null value.") (output (geiser-eval--retort-output ret)) (impl geiser-impl--implementation) (module (geiser-eval--get-module))) - (geiser-debug--with-buffer - (erase-buffer) - (insert what) - (newline 2) - (when res - (insert res) - (newline 2)) - (unless (geiser-debug--display-error impl module key output) - (when err (insert (geiser-eval--error-str err) "\n\n")) - (when output (insert output "\n\n"))) - (goto-char (point-min))) - (when err (geiser-debug--pop-to-buffer)))) + (if (eq key 'geiser-debugger) (switch-to-geiser) + (geiser-debug--with-buffer + (erase-buffer) + (insert what) + (newline 2) + (when res + (insert res) + (newline 2)) + (unless (geiser-debug--display-error impl module key output) + (when err (insert (geiser-eval--error-str err) "\n\n")) + (when output (insert output "\n\n"))) + (goto-char (point-min))) + (when err (geiser-debug--pop-to-buffer))))) (defsubst geiser-debug--wrap-region (str) (format "(begin %s)" str)) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index e870be3..3902b09 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -1,6 +1,6 @@ ;; geiser-impl.el -- generic support for scheme implementations -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -112,7 +112,8 @@ determine its scheme flavour." (add-to-list 'geiser-active-implementations impl)) (defsubst geiser-deactivate-implementation (impl) - (setq geiser-active-implementations (delq impl geiser-active-implementations))) + (setq geiser-active-implementations + (delq impl geiser-active-implementations))) ;;; Defining implementations: diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index da6eca1..9bff115 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -1,6 +1,6 @@ ;;; geiser-repl.el --- Geiser's REPL -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the Modified BSD License. You should @@ -132,6 +132,11 @@ arguments to be used when invoking the scheme binary.") "A variable (or thunk returning a value) giving the regular expression for this implementation's scheme prompt.") +(geiser-impl--define-caller + geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () + "A variable (or thunk returning a value) giving the regular +expression for this implementation's debugging prompt.") + (geiser-impl--define-caller geiser-repl--startup startup () "Function taking no parameters that is called after the REPL has been initialised. All Geiser functionality is available to @@ -143,14 +148,16 @@ you at that point.") (let ((binary (geiser-repl--binary impl)) (args (geiser-repl--arglist impl)) (prompt-rx (geiser-repl--prompt-regexp impl)) + (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl)) (cname (geiser-repl--repl-name impl))) (unless (and binary prompt-rx) (error "Sorry, I don't know how to start a REPL for %s" impl)) (set (make-local-variable 'comint-prompt-regexp) prompt-rx) - (apply 'make-comint-in-buffer `(,cname ,(current-buffer) ,binary nil ,@args)) + (apply 'make-comint-in-buffer + `(,cname ,(current-buffer) ,binary nil ,@args)) (geiser-repl--wait-for-prompt 10000) (geiser-repl--history-setup) - (geiser-con--setup-connection (current-buffer) prompt-rx) + (geiser-con--setup-connection (current-buffer) prompt-rx deb-prompt-rx) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) (geiser-repl--startup impl))) @@ -305,6 +312,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (set-syntax-table scheme-mode-syntax-table) (setq geiser-eval--get-module-function 'geiser-repl--module-function) (when geiser-repl-autodoc-p (geiser-autodoc-mode 1)) + (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging) (geiser-company--setup geiser-repl-company-p) ;; enabling compilation-shell-minor-mode without the annoying highlighter (compilation-setup t)) |