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

extra/fuel/fuel.factor

@@ -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
+USING: accessors arrays classes classes.tuple compiler.units
-definitions eval io io.files io.streams.string kernel listener listener.private
+combinators continuations debugger definitions eval help
-make math namespaces parser prettyprint quotations sequences strings
+io io.files io.streams.string kernel lexer listener listener.private
-vectors vocabs.loader ;
+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-run-with-output fuel-retort pop-fuel-status ; inline
-    fuel-retort
-    pop-fuel-status ;
 
 : (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) ; inline
-    [ ] (fuel-end-eval) ;
 
 : fuel-get-edit-location ( defspec -- )
     where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ] when* ;
 
-: fuel-startup ( -- )
+: fuel-run-file ( path -- ) run-file ; inline
-    "listener" run ;
+
+: fuel-startup ( -- ) "listener" run ; inline
 
 MAIN: fuel-startup

misc/fuel/README

@@ -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
+* In the debugger (it pops up upon eval/compilation errors):
-the same as C-cz).
+
+ - g : go to error
+ - <digit> : invoke nth restart
+ - q : bury buffer
+
+

misc/fuel/factor-mode.el

@@ -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:
 

misc/fuel/fuel-debug.el

@@ -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

misc/fuel/fuel-eval.el

@@ -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)
+(defsubst fuel-eval--eval-strings (strs &optional no-restart)
-  (let ((str (format "%s fuel-eval" (fuel-eval--factor-array strs))))
+  (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)
+(defsubst fuel-eval--eval-string (str &optional no-restart)
-  (fuel-eval--eval-strings (list str)))
+  (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)
+(defsubst fuel-eval--eval-string/context (str &optional no-restart)
-  (fuel-eval--eval-strings/context (list str)))
+  (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)

misc/fuel/fuel-font-lock.el

@@ -21,30 +21,23 @@
 
 ;;; Faces:
 
-(defmacro fuel-font-lock--face (face def doc)
+(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
-  (let ((face (intern (format "factor-font-lock-%s" (symbol-name face))))
+  (let ((face (intern (format "%s-%s" prefix face)))
-        (def (intern (format "font-lock-%s-face" (symbol-name def)))))
+        (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 ()
+(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
-  (cons 'progn
+  (let ((setup (make-symbol (format "%s--faces-setup" prefix))))
-        (mapcar (lambda (f) (cons 'fuel-font-lock--face f))
+  `(progn
-                '((comment comment "comments")
+     (defmacro ,setup ()
-                  (constructor type  "constructors (<foo>)")
+       (cons 'progn
-                  (declaration keyword "declaration words")
+             (mapcar (lambda (f) (append '(fuel-font-lock--make-face
-                  (parsing-word keyword  "parsing words")
+                                      ,prefix ,def-prefix ,group) f))
-                  (setter-word function-name "setter words (>>foo)")
+                     ',faces)))
-                  (stack-effect comment "stack effect specifications")
+     (,setup))))
-                  (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)
 
 
 ;;; Font lock:

misc/fuel/fuel-help.el

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

misc/fuel/fuel-listener.el

@@ -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
+    (setq fuel-listener-buffer (get-buffer-create "*fuel listener*"))
-          (make-comint "fuel listener" factor nil "-run=fuel" (format "-i=%s" image)))
     (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-ch" 'fuel-help)
-;; (define-key fuel-listener-mode-map "\C-k" 'comint-kill-whole-line)
+(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)

misc/fuel/fuel-mode.el

@@ -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))
+  (fuel-debug--display-retort
-         (err (fuel-eval--retort-error ret)))
+   (fuel-eval--eval-region/context begin end)
-    (message "%s" (or err (fuel--shorten-region begin end 70))))
+   (format "%s%s"
-  (when arg (pop-to-buffer fuel-listener-buffer)))
+           (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
+to Fuel's listener for evaluation.
-listener's buffer afterwards."
+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)