FUEL: First stab at the debugger: error/restart display and restart invokation.

db4
Jose A. Ortega Ruiz 2008-12-09 02:36:55 +01:00
parent 90cdb6c4f4
commit faa6989fe9
9 changed files with 472 additions and 108 deletions

View File

@ -1,50 +1,70 @@
! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays classes.tuple compiler.units continuations debugger
definitions eval io io.files io.streams.string kernel listener listener.private
make math namespaces parser prettyprint quotations sequences strings
vectors vocabs.loader ;
USING: accessors arrays classes classes.tuple compiler.units
combinators continuations debugger definitions eval help
io io.files io.streams.string kernel lexer listener listener.private
make math namespaces parser prettyprint prettyprint.config
quotations sequences strings source-files vectors vocabs.loader ;
IN: fuel
! <PRIVATE
! Evaluation status:
TUPLE: fuel-status in use ds? ;
TUPLE: fuel-status in use ds? restarts ;
SYMBOL: fuel-status-stack
V{ } clone fuel-status-stack set-global
: push-fuel-status ( -- )
in get use get clone display-stacks? get
fuel-status boa
fuel-status-stack get push ;
: pop-fuel-status ( -- )
fuel-status-stack get empty? [
fuel-status-stack get pop
[ in>> in set ]
[ use>> clone use set ]
[ ds?>> display-stacks? swap [ on ] [ off ] if ] tri
] unless ;
SYMBOL: fuel-eval-result
f clone fuel-eval-result set-global
SYMBOL: fuel-eval-output
f clone fuel-eval-result set-global
! PRIVATE>
SYMBOL: fuel-eval-res-flag
t clone fuel-eval-res-flag set-global
: fuel-eval-restartable? ( -- ? )
fuel-eval-res-flag get-global ; inline
: fuel-eval-restartable ( -- )
t fuel-eval-res-flag set-global ; inline
: fuel-eval-non-restartable ( -- )
f fuel-eval-res-flag set-global ; inline
: push-fuel-status ( -- )
in get use get clone display-stacks? get restarts get-global clone
fuel-status boa
fuel-status-stack get push ;
: pop-fuel-status ( -- )
fuel-status-stack get empty? [
fuel-status-stack get pop {
[ in>> in set ]
[ use>> clone use set ]
[ ds?>> display-stacks? swap [ on ] [ off ] if ]
[
restarts>> fuel-eval-restartable? [ drop ] [
clone restarts set-global
] if
]
} cleave
] unless ;
! Lispy pretty printing
GENERIC: fuel-pprint ( obj -- )
M: object fuel-pprint pprint ;
M: object fuel-pprint pprint ; inline
M: f fuel-pprint drop "nil" write ;
M: f fuel-pprint drop "nil" write ; inline
M: integer fuel-pprint pprint ;
M: integer fuel-pprint pprint ; inline
M: string fuel-pprint pprint ;
M: string fuel-pprint pprint ; inline
M: sequence fuel-pprint
dup empty? [ drop f fuel-pprint ] [
@ -53,12 +73,30 @@ M: sequence fuel-pprint
")" write
] if ;
M: tuple fuel-pprint tuple>array fuel-pprint ;
M: tuple fuel-pprint tuple>array fuel-pprint ; inline
M: continuation fuel-pprint drop "~continuation~" write ;
M: continuation fuel-pprint drop ":continuation" write ; inline
M: restart fuel-pprint name>> fuel-pprint ; inline
SYMBOL: :restarts
: fuel-restarts ( obj -- seq )
compute-restarts :restarts prefix ; inline
M: condition fuel-pprint
[ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
M: source-file-error fuel-pprint
[ file>> ] [ error>> ] bi 2array source-file-error prefix
fuel-pprint ;
M: source-file fuel-pprint path>> fuel-pprint ;
! Evaluation vocabulary
: fuel-eval-set-result ( obj -- )
clone fuel-eval-result set-global ;
clone fuel-eval-result set-global ; inline
: fuel-retort ( -- )
error get
@ -67,7 +105,7 @@ M: continuation fuel-pprint drop "~continuation~" write ;
3array fuel-pprint ;
: fuel-forget-error ( -- )
f error set-global ;
f error set-global ; inline
: (fuel-begin-eval) ( -- )
push-fuel-status
@ -76,23 +114,25 @@ M: continuation fuel-pprint drop "~continuation~" write ;
f fuel-eval-result set-global
f fuel-eval-output set-global ;
: fuel-run-with-output ( quot -- )
with-string-writer fuel-eval-output set-global ; inline
: (fuel-end-eval) ( quot -- )
with-string-writer fuel-eval-output set-global
fuel-retort
pop-fuel-status ;
fuel-run-with-output fuel-retort pop-fuel-status ; inline
: (fuel-eval) ( lines -- )
[ [ parse-lines ] with-compilation-unit call ] curry [ drop ] recover ;
[ [ parse-lines ] with-compilation-unit call ] curry
[ print-error ] recover ; inline
: (fuel-eval-each) ( lines -- )
[ 1vector (fuel-eval) ] each ;
[ 1vector (fuel-eval) ] each ; inline
: (fuel-eval-usings) ( usings -- )
[ "USING: " prepend " ;" append ] map
(fuel-eval-each) fuel-forget-error ;
: (fuel-eval-in) ( in -- )
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ;
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
: fuel-eval-in-context ( lines in usings -- )
(fuel-begin-eval) [
@ -107,15 +147,15 @@ M: continuation fuel-pprint drop "~continuation~" write ;
fuel-retort ;
: fuel-eval ( lines -- )
(fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ;
(fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
: fuel-end-eval ( -- )
[ ] (fuel-end-eval) ;
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
: fuel-get-edit-location ( defspec -- )
where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ] when* ;
: fuel-startup ( -- )
"listener" run ;
: fuel-run-file ( path -- ) run-file ; inline
: fuel-startup ( -- ) "listener" run ; inline
MAIN: fuel-startup

View File

@ -47,18 +47,29 @@ M-x customize-group fuel will show you how many.
Quick key reference
-------------------
(Chords ending in a single letter <x> accept also C-<x> (e.g. C-cC-z is
the same as C-cz)).
* In factor files:
- C-cz : switch to listener
- C-co : cycle between code, tests and docs factor files
- M-. : edit word at point in Emacs
- M-. : edit word at point in Emacs (also in listener)
- C-cr, C-cC-er : eval region
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
- C-M-x, C-cC-ex : eval definition around point
- C-ck, C-cC-ek : compile file
- C-cC-da : toggle autodoc mode
- C-cC-dd : help for word at point
- C-cC-ds : short help word at point
Chords ending in a single letter <x> accept also C-<x> (e.g. C-cC-z is
the same as C-cz).
* In the debugger (it pops up upon eval/compilation errors):
- g : go to error
- <digit> : invoke nth restart
- q : bury buffer

View File

@ -59,6 +59,23 @@ code in the buffer."
:type 'hook
:group 'factor-mode)
;;; Faces:
(fuel-font-lock--define-faces
factor-font-lock font-lock factor-mode
((comment comment "comments")
(constructor type "constructors (<foo>)")
(declaration keyword "declaration words")
(parsing-word keyword "parsing words")
(setter-word function-name "setter words (>>foo)")
(stack-effect comment "stack effect specifications")
(string string "strings")
(symbol variable-name "name of symbol being defined")
(type-name type "type names")
(vocabulary-name constant "vocabulary names")
(word function-name "word, generic or method being defined")))
;;; Syntax table:

234
misc/fuel/fuel-debug.el Normal file
View File

@ -0,0 +1,234 @@
;;; fuel-debug.el -- debugging factor code
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages, fuel, factor
;; Start date: Sun Dec 07, 2008 04:16
;;; Comentary:
;; A mode for displaying the results of run-file and evaluation, with
;; support for restarts.
;;; Code:
(require 'fuel-base)
(require 'fuel-eval)
(require 'fuel-font-lock)
;;; Customization:
(defgroup fuel-debug nil
"Major mode for interaction with the Factor debugger"
:group 'fuel)
(defcustom fuel-debug-mode-hook nil
"Hook run after `fuel-debug-mode' activates"
:group 'fuel-debug
:type 'hook)
(defcustom fuel-debug-show-short-help t
"Whether to show short help on available keys in debugger"
:group 'fuel-debug
:type 'boolean)
(fuel-font-lock--define-faces
fuel-debug-font-lock font-lock fuel-debug
((error warning "highlighting errors")
(line variable-name "line numbers in errors/warnings")
(column variable-name "column numbers in errors/warnings")
(info comment "information headers")
(restart-number warning "restart numbers")
(restart-name function-name "restart names")))
;;; Compilation results buffer:
(defvar fuel-debug--buffer nil)
(make-variable-buffer-local
(defvar fuel-debug--last-ret nil))
(make-variable-buffer-local
(defvar fuel-debug--file nil))
(defun fuel-debug--buffer ()
(or (and (buffer-live-p fuel-debug--buffer) fuel-debug--buffer)
(with-current-buffer
(setq fuel-debug--buffer (get-buffer-create "*fuel dbg*"))
(fuel-debug-mode)
(current-buffer))))
(defun fuel-debug--display-retort (ret &optional success-msg no-pop file)
(let ((err (fuel-eval--retort-error ret))
(inhibit-read-only t))
(with-current-buffer (fuel-debug--buffer)
(erase-buffer)
(when err (insert (format "Error: %S\n\n" (fuel-eval--error-name err))))
(fuel-debug--display-output-1 ret)
(when (and (not err) success-msg)
(message "%s" success-msg)
(insert "\n" success-msg "\n"))
(when err
(fuel-debug--display-restarts err)
(let ((hstr (fuel-debug--help-string err)))
(if fuel-debug-show-short-help
(insert "-----------\n" hstr "\n")
(message "%s" hstr))))
(setq fuel-debug--last-ret ret)
(setq fuel-debug--file file)
(goto-char (point-max)))
(when (and err (not no-pop)) (pop-to-buffer fuel-debug--buffer))))
(defun fuel-debug--display-output-1 (ret)
(let* ((last (fuel-eval--retort-output fuel-debug--last-ret))
(current (fuel-eval--retort-output ret))
(llen (length last))
(clen (length current))
(trail (and last (substring-no-properties last (/ llen 2))))
(p (point)))
(save-excursion (insert current))
(when (and (> clen llen) (> llen 0) (search-forward trail nil t))
(delete-region p (point)))
(goto-char (point-max))))
(defun fuel-debug--display-restarts (err)
(let* ((rs (fuel-eval--error-restarts err))
(rsn (length rs)))
(when rs
(insert "\n\nRestarts:\n\n")
(dotimes (n rsn)
(insert (format ":%s %s\n" (1+ n) (nth n rs))))
(newline))))
(defun fuel-debug--help-string (err)
(format "Press %s%s 'q' to bury buffer"
(if (fuel-eval--error-file err) "g to visit file, " "")
(let ((rsn (length (fuel-eval--error-restarts err))))
(cond ((zerop rsn) "")
((= 1 rsn) "1 to invoke restart, ")
(t (format "1-%s to invoke restarts, " rsn))))))
(defun fuel-debug--buffer-file ()
(with-current-buffer (fuel-debug--buffer)
(or fuel-debug--file
(and fuel-debug--last-ret
(fuel-eval--error-file
(fuel-eval--retort-error fuel-debug--last-ret))))))
(defsubst fuel-debug--buffer-error ()
(fuel-eval--retort-error fuel-debug--last-ret))
(defsubst fuel-debug--buffer-restarts ()
(fuel-eval--error-restarts (fuel-debug--buffer-error)))
;;; Font lock and other pattern matching:
(defconst fuel-debug--error-file-regex "^P\" \\([^\"]+\\)\"")
(defconst fuel-debug--error-line-regex "\\([0-9]+\\):")
(defconst fuel-debug--error-cont-regex "^ +\\(\\^\\)$")
(defconst fuel-debug--error-regex
(format "%s\n%s"
fuel-debug--error-file-regex
fuel-debug--error-line-regex))
(defconst fuel-debug--named-restart-regex
(format "^\\(%s\\) " (regexp-opt '(":warnings" ":errors" ":linkage"))))
(defconst fuel-debug--restart-regex
"^:\\([0-9]+\\) \\(.+\\)")
(defconst fuel-debug--font-lock-keywords
`((,fuel-debug--error-file-regex . 'fuel-debug-font-lock-error)
(,fuel-debug--error-line-regex 1 'fuel-debug-font-lock-line)
(,fuel-debug--error-cont-regex 1 'fuel-debug-font-lock-column)
(,fuel-debug--restart-regex (1 'fuel-debug-font-lock-restart-number)
(2 'fuel-debug-font-lock-restart-name))
(,fuel-debug--named-restart-regex 1 'fuel-debug-font-lock-restart-number)
("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-debug-font-lock-info)
("^Error: " . 'fuel-debug-font-lock-error)))
(defun fuel-debug--font-lock-setup ()
(set (make-local-variable 'font-lock-defaults)
'(fuel-debug--font-lock-keywords t nil nil nil)))
;;; Buffer navigation:
(defun fuel-debug-goto-error ()
(interactive)
(let* ((err (or (fuel-debug--buffer-error)
(error "No errors reported")))
(file (or (fuel-eval--error-file err)
(error "No file associated with error")))
(l/c (fuel-eval--error-line/column err))
(line (or (car l/c) 1))
(col (or (cdr l/c) 0)))
(find-file-other-window file)
(goto-line line)
(forward-char col)))
(defun fuel-debug--read-restart-no ()
(let ((rs (fuel-debug--buffer-restarts)))
(unless rs (error "No restarts available"))
(let* ((rsn (length rs))
(prompt (format "Restart number? (1-%s): " rsn))
(no 0))
(while (or (> (setq no (read-number prompt)) rsn)
(< no 1)))
no)))
(defun fuel-debug-exec-restart (&optional n confirm)
(interactive (list (fuel-debug--read-restart-no)))
(let ((n (or n 1))
(rs (fuel-debug--buffer-restarts)))
(when (zerop (length rs))
(error "No restarts available"))
(when (or (< n 1) (> n (length rs)))
(error "Restart %s not available" n))
(when (or (not confirm)
(y-or-n-p (format "Invoke restart %s? " n)))
(message "Invoking restart %s" n)
(let* ((file (fuel-debug--buffer-file))
(buffer (if file (find-file-noselect file) (current-buffer))))
(with-current-buffer buffer
(fuel-debug--display-retort
(fuel-eval--eval-string/context (format ":%s" n))
(format "Restart %s (%s) successful" n (nth (1- n) rs))))))))
;;; Fuel Debug mode:
(defvar fuel-debug-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map "g" 'fuel-debug-goto-error)
(define-key map "\C-c\C-c" 'fuel-debug-goto-error)
(define-key map "q" 'bury-buffer)
(dotimes (n 9)
(define-key map (vector (+ ?1 n))
`(lambda () (interactive) (fuel-debug-exec-restart ,(1+ n) t))))
map))
(defun fuel-debug-mode ()
"A major mode for displaying Factor's compilation results and
invoking restarts as needed.
\\{fuel-debug-mode-map}"
(interactive)
(kill-all-local-variables)
(setq major-mode 'factor-mode)
(setq mode-name "Fuel Debug")
(use-local-map fuel-debug-mode-map)
(fuel-debug--font-lock-setup)
(setq fuel-debug--file nil)
(setq fuel-debug--last-ret nil)
(toggle-read-only 1)
(run-hooks 'fuel-debug-mode-hook))
(provide 'fuel-debug)
;;; fuel-debug.el ends here

View File

@ -38,7 +38,8 @@
(when (and (> fuel-eval-log-max-length 0)
(> (point) fuel-eval-log-max-length))
(erase-buffer))
(when fuel-eval--log (insert "\n>> " (fuel--shorten-str str 256) "\n"))
(when fuel-eval--log (insert "\n>> " (fuel--shorten-str str 256)))
(newline)
(let ((beg (point)))
(comint-redirect-send-command-to-process str (current-buffer) proc nil t)
(with-current-buffer (process-buffer proc)
@ -58,8 +59,6 @@
(defsubst fuel-eval--retort-p (ret) (listp ret))
(defsubst fuel-eval--error-name (err) (car err))
(defsubst fuel-eval--make-parse-error-retort (str)
(fuel-eval--retort-make 'parse-retort-error nil str))
@ -83,29 +82,60 @@
(defsubst fuel-eval--factor-array (strs)
(format "V{ %S }" (mapconcat 'identity strs " ")))
(defsubst fuel-eval--eval-strings (strs)
(let ((str (format "%s fuel-eval" (fuel-eval--factor-array strs))))
(defsubst fuel-eval--eval-strings (strs &optional no-restart)
(let ((str (format "fuel-eval-%s %s fuel-eval"
(if no-restart "non-restartable" "restartable")
(fuel-eval--factor-array strs))))
(fuel-eval--send/retort str)))
(defsubst fuel-eval--eval-string (str)
(fuel-eval--eval-strings (list str)))
(defsubst fuel-eval--eval-string (str &optional no-restart)
(fuel-eval--eval-strings (list str) no-restart))
(defun fuel-eval--eval-strings/context (strs)
(defun fuel-eval--eval-strings/context (strs &optional no-restart)
(let ((usings (fuel-syntax--usings-update)))
(fuel-eval--send/retort
(format "%s %S %s fuel-eval-in-context"
(format "fuel-eval-%s %s %S %s fuel-eval-in-context"
(if no-restart "non-restartable" "restartable")
(fuel-eval--factor-array strs)
(or fuel-syntax--current-vocab "f")
(if usings (fuel-eval--factor-array usings) "f")))))
(defsubst fuel-eval--eval-string/context (str)
(fuel-eval--eval-strings/context (list str)))
(defsubst fuel-eval--eval-string/context (str &optional no-restart)
(fuel-eval--eval-strings/context (list str) no-restart))
(defun fuel-eval--eval-region/context (begin end)
(defun fuel-eval--eval-region/context (begin end &optional no-restart)
(let ((lines (split-string (buffer-substring-no-properties begin end)
"[\f\n\r\v]+" t)))
(when (> (length lines) 0)
(fuel-eval--eval-strings/context lines))))
(fuel-eval--eval-strings/context lines no-restart))))
;;; Error parsing
(defsubst fuel-eval--error-name (err) (car err))
(defsubst fuel-eval--error-restarts (err)
(cdr (assoc :restarts (fuel-eval--error-name-p err 'condition))))
(defun fuel-eval--error-name-p (err name)
(unless (null err)
(or (and (eq (fuel-eval--error-name err) name) err)
(assoc name err))))
(defsubst fuel-eval--error-file (err)
(nth 1 (fuel-eval--error-name-p err 'source-file-error)))
(defsubst fuel-eval--error-lexer-p (err)
(or (fuel-eval--error-name-p err 'lexer-error)
(fuel-eval--error-name-p (fuel-eval--error-name-p err 'source-file-error)
'lexer-error)))
(defsubst fuel-eval--error-line/column (err)
(let ((err (fuel-eval--error-lexer-p err)))
(cons (nth 1 err) (nth 2 err))))
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
(provide 'fuel-eval)

View File

@ -21,30 +21,23 @@
;;; Faces:
(defmacro fuel-font-lock--face (face def doc)
(let ((face (intern (format "factor-font-lock-%s" (symbol-name face))))
(def (intern (format "font-lock-%s-face" (symbol-name def)))))
(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
(let ((face (intern (format "%s-%s" prefix face)))
(def (intern (format "%s-%s-face" def-prefix def))))
`(defface ,face (face-default-spec ,def)
,(format "Face for %s." doc)
:group 'factor-mode
:group ',group
:group 'faces)))
(defmacro fuel-font-lock--faces-setup ()
(cons 'progn
(mapcar (lambda (f) (cons 'fuel-font-lock--face f))
'((comment comment "comments")
(constructor type "constructors (<foo>)")
(declaration keyword "declaration words")
(parsing-word keyword "parsing words")
(setter-word function-name "setter words (>>foo)")
(stack-effect comment "stack effect specifications")
(string string "strings")
(symbol variable-name "name of symbol being defined")
(type-name type "type names")
(vocabulary-name constant "vocabulary names")
(word function-name "word, generic or method being defined")))))
(fuel-font-lock--faces-setup)
(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
(let ((setup (make-symbol (format "%s--faces-setup" prefix))))
`(progn
(defmacro ,setup ()
(cons 'progn
(mapcar (lambda (f) (append '(fuel-font-lock--make-face
,prefix ,def-prefix ,group) f))
',faces)))
(,setup))))
;;; Font lock:

View File

@ -68,10 +68,11 @@
(defun fuel-help--word-synopsis (&optional word)
(let ((word (or word (fuel-syntax-symbol-at-point)))
(fuel-eval--log nil))
(fuel-eval--log t))
(when word
(let ((ret (fuel-eval--eval-string/context
(format "\\ %s synopsis fuel-eval-set-result" word))))
(format "\\ %s synopsis fuel-eval-set-result" word)
t)))
(when (not (fuel-eval--retort-error ret))
(if fuel-help-minibuffer-font-lock
(fuel-help--font-lock-str (fuel-eval--retort-result ret))
@ -170,7 +171,7 @@ displayed in the minibuffer."
(def (if ask (read-string prompt nil 'fuel-help--history def) def))
(cmd (format "\\ %s %s" def (if see "see" "help")))
(fuel-eval--log nil)
(ret (fuel-eval--eval-string/context cmd))
(ret (fuel-eval--eval-string/context cmd t))
(out (fuel-eval--retort-output ret)))
(if (or (fuel-eval--retort-error ret) (empty-string-p out))
(message "No help for '%s'" def)

View File

@ -59,10 +59,15 @@ buffer."
(error "Could not run factor: %s is not executable" factor))
(unless (file-readable-p image)
(error "Could not run factor: image file %s not readable" image))
(setq fuel-listener-buffer
(make-comint "fuel listener" factor nil "-run=fuel" (format "-i=%s" image)))
(setq fuel-listener-buffer (get-buffer-create "*fuel listener*"))
(with-current-buffer fuel-listener-buffer
(fuel-listener-mode))))
(fuel-listener-mode)
(message "Starting FUEL listener ...")
(comint-exec fuel-listener-buffer "factor"
factor nil `("-run=fuel" ,(format "-i=%s" image)))
(fuel-listener--wait-for-prompt 20)
(fuel-eval--send-string "USE: fuel")
(message "FUEL listener up and running!"))))
(defun fuel-listener--process (&optional start)
(or (and (buffer-live-p fuel-listener-buffer)
@ -74,6 +79,23 @@ buffer."
(setq fuel-eval--default-proc-function 'fuel-listener--process)
;;; Prompt chasing
(defun fuel-listener--wait-for-prompt (&optional timeout)
(let ((proc (get-buffer-process fuel-listener-buffer))
(seen))
(with-current-buffer fuel-listener-buffer
(while (progn (goto-char comint-last-input-end)
(not (or seen
(setq seen
(re-search-forward comint-prompt-regexp nil t))
(not (accept-process-output proc timeout))))))
(goto-char (point-max)))
(unless seen
(pop-to-buffer fuel-listener-buffer)
(error "No prompt found!"))))
;;; Interface: starting fuel listener
@ -94,30 +116,17 @@ buffer."
(defconst fuel-listener--prompt-regex "( [^)]* ) ")
(defun fuel-listener--wait-for-prompt (&optional timeout)
(let ((proc (fuel-listener--process)))
(with-current-buffer fuel-listener-buffer
(goto-char comint-last-input-end)
(while (not (or (re-search-forward comint-prompt-regexp nil t)
(not (accept-process-output proc timeout))))
(goto-char comint-last-input-end))
(goto-char (point-max)))))
(defun fuel-listener--startup ()
(fuel-listener--wait-for-prompt)
(fuel-eval--send-string "USE: fuel")
(message "FUEL listener up and running!"))
(define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
"Major mode for interacting with an inferior Factor listener process.
\\{fuel-listener-mode-map}"
(set (make-local-variable 'comint-prompt-regexp)
fuel-listener--prompt-regex)
(set (make-local-variable 'comint-prompt-read-only) t)
(fuel-listener--startup))
(setq fuel-listener--compilation-begin nil))
;; (define-key fuel-listener-mode-map "\C-w" 'comint-kill-region)
;; (define-key fuel-listener-mode-map "\C-k" 'comint-kill-whole-line)
(define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
(define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
(define-key fuel-listener-mode-map "\C-ck" 'fuel-run-file)
(provide 'fuel-listener)

View File

@ -18,6 +18,7 @@
(require 'fuel-base)
(require 'fuel-syntax)
(require 'fuel-font-lock)
(require 'fuel-debug)
(require 'fuel-help)
(require 'fuel-eval)
(require 'fuel-listener)
@ -37,33 +38,58 @@
;;; User commands
(defun fuel-run-file (&optional arg)
"Sends the current file to Factor for compilation.
With prefix argument, ask for the file to run."
(interactive "P")
(let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t))
(buffer-file-name)))
(file (expand-file-name file))
(buffer (find-file-noselect file))
(cmd (format "%S fuel-run-file" file)))
(when buffer
(with-current-buffer buffer
(fuel-debug--display-retort (fuel-eval--eval-string/context cmd)
(format "%s successfully compiled" file)
nil
file)))))
(defun fuel-eval-region (begin end &optional arg)
"Sends region to Fuel's listener for evaluation.
With prefix, switchs to the listener's buffer afterwards."
Unless called with a prefix, switchs to the compilation results
buffer in case of errors."
(interactive "r\nP")
(let* ((ret (fuel-eval--eval-region/context begin end))
(err (fuel-eval--retort-error ret)))
(message "%s" (or err (fuel--shorten-region begin end 70))))
(when arg (pop-to-buffer fuel-listener-buffer)))
(fuel-debug--display-retort
(fuel-eval--eval-region/context begin end)
(format "%s%s"
(if fuel-syntax--current-vocab
(format "IN: %s " fuel-syntax--current-vocab)
"")
(fuel--shorten-region begin end 70))
arg
(buffer-file-name)))
(defun fuel-eval-extended-region (begin end &optional arg)
"Sends region extended outwards to nearest definitions,
to Fuel's listener for evaluation. With prefix, switchs to the
listener's buffer afterwards."
to Fuel's listener for evaluation.
Unless called with a prefix, switchs to the compilation results
buffer in case of errors."
(interactive "r\nP")
(fuel-eval-region (save-excursion (goto-char begin) (mark-defun) (point))
(save-excursion (goto-char end) (mark-defun) (mark))))
(save-excursion (goto-char end) (mark-defun) (mark))
arg))
(defun fuel-eval-definition (&optional arg)
"Sends definition around point to Fuel's listener for evaluation.
With prefix, switchs to the listener's buffer afterwards."
Unless called with a prefix, switchs to the compilation results
buffer in case of errors."
(interactive "P")
(save-excursion
(mark-defun)
(let* ((begin (point))
(end (mark)))
(unless (< begin end) (error "No evaluable definition around point"))
(fuel-eval-region begin end))))
(fuel-eval-region begin end arg))))
(defun fuel-edit-word-at-point (&optional arg)
"Opens a new window visiting the definition of the word at point.
@ -128,6 +154,9 @@ interacting with a factor listener is at your disposal.
(fuel-mode--key-1 ?z 'run-factor)
(fuel-mode--key-1 ?k 'fuel-run-file)
(fuel-mode--key ?e ?k 'fuel-run-file)
(define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition)
(fuel-mode--key ?e ?x 'fuel-eval-definition)