FUEL debug mode: :warnings &co. retrievable, and some cosmetics.

diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index acaccf5b7868eef1098ceac9a86d0f8be641f627..d9db83b5e35df51e365e48683a87e4d33589d020 100644 (file)
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -104,21 +104,20 @@ M: source-file fuel-pprint path>> fuel-pprint ;
     fuel-eval-output get-global
     3array fuel-pprint ;
 
-: fuel-forget-error ( -- )
-    f error set-global ; inline
+: fuel-forget-error ( -- ) f error set-global ; inline
+: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
+: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
 
 : (fuel-begin-eval) ( -- )
     push-fuel-status
     display-stacks? off
     fuel-forget-error
-    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-forget-result
+    fuel-forget-output ;
 
 : (fuel-end-eval) ( quot -- )
-    fuel-run-with-output fuel-retort pop-fuel-status ; inline
+    with-string-writer fuel-eval-output set-global
+    fuel-retort pop-fuel-status ; inline
 
 : (fuel-eval) ( lines -- )
     [ [ parse-lines ] with-compilation-unit call ] curry
@@ -129,7 +128,7 @@ M: source-file fuel-pprint path>> fuel-pprint ;
 
 : (fuel-eval-usings) ( usings -- )
     [ "USING: " prepend " ;" append ] map
-    (fuel-eval-each) fuel-forget-error ;
+    (fuel-eval-each) fuel-forget-error fuel-forget-output ;
 
 : (fuel-eval-in) ( in -- )
     [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline

diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el
index 1b68f6e79f4bffbadfff8f35427f647579c6f2c6..b3aad7f3dcc1597d967aef5578d75abce6198046 100644 (file)
--- a/misc/fuel/fuel-debug.el
+++ b/misc/fuel/fuel-debug.el
@@ -45,7 +45,42 @@
   (restart-name function-name "restart names")))
 
 \f
-;;; Compilation results buffer:
+;;; Font lock and other pattern matching:
+
+(defconst fuel-debug--compiler-info-alist
+  '((":warnings" . ?w) (":errors" . ?e) (":linkage" . ?l)))
+
+(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--compiler-info-regex
+  (format "^\\(%s\\) "
+          (regexp-opt (mapcar 'car fuel-debug--compiler-info-alist))))
+
+(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--compiler-info-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)))
+
+\f
+;;; Debug buffer:
 
 (defvar fuel-debug--buffer nil)
 
@@ -67,50 +102,63 @@
         (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)
+      (fuel-debug--display-output ret)
+      (delete-blank-lines)
+      (newline)
       (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)))
+        (delete-blank-lines)
+        (newline)
+        (let ((hstr (fuel-debug--help-string err file)))
           (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))))
+      (goto-char (point-max))
+      (when (and err (not no-pop)) (pop-to-buffer fuel-debug--buffer))
+      (not err))))
 
-(defun fuel-debug--display-output-1 (ret)
+(defun fuel-debug--display-output (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))))
+         (err (fuel-eval--retort-error ret))
          (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))))
+    (goto-char (point-max))
+    (when err
+      (insert (format "\nError: %S\n\n" (fuel-eval--error-name err))))))
 
 (defun fuel-debug--display-restarts (err)
   (let* ((rs (fuel-eval--error-restarts err))
          (rsn (length rs)))
     (when rs
-      (insert "\n\nRestarts:\n\n")
+      (insert "Restarts:\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, " "")
+(defun fuel-debug--help-string (err &optional file)
+  (format "Press %s%s%sq bury buffer"
+          (if (or file (fuel-eval--error-file err)) "g go to 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))))))
+                  ((= 1 rsn) "1 invoke restart, ")
+                  (t (format "1-%s invoke restarts, " rsn))))
+          (let ((str ""))
+            (dolist (ci fuel-debug--compiler-info-alist str)
+              (save-excursion
+                (goto-char (point-min))
+                (when (search-forward (car ci) nil t)
+                  (setq str (format "%c %s, %s" (cdr ci) (car ci) str))))))))
 
 (defun fuel-debug--buffer-file ()
   (with-current-buffer (fuel-debug--buffer)
@@ -126,44 +174,13 @@
   (fuel-eval--error-restarts (fuel-debug--buffer-error)))
 
 \f
-;;; 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)))
-\f
 ;;; 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)
+         (file (or (fuel-debug--buffer-file)
                    (error "No file associated with error")))
          (l/c (fuel-eval--error-line/column err))
          (line (or (car l/c) 1))
@@ -200,6 +217,16 @@
            (fuel-eval--eval-string/context (format ":%s" n))
            (format "Restart %s (%s) successful" n (nth (1- n) rs))))))))
 
+(defun fuel-debug-show--compiler-info (info)
+  (save-excursion
+    (goto-char (point-min))
+    (unless (re-search-forward (format "^%s" info) nil t)
+      (error "%s information not available" info))
+    (message "Retrieving %s info ..." info)
+    (unless (fuel-debug--display-retort
+             (fuel-eval--eval-string info) "" (fuel-debug--buffer-file))
+      (error "Sorry, no %s info available" info))))
+
 \f
 ;;; Fuel Debug mode:
 
@@ -208,10 +235,15 @@
     (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 "n" 'next-line)
+    (define-key map "p" 'previous-line)
     (define-key map "q" 'bury-buffer)
     (dotimes (n 9)
       (define-key map (vector (+ ?1 n))
         `(lambda () (interactive) (fuel-debug-exec-restart ,(1+ n) t))))
+    (dolist (ci fuel-debug--compiler-info-alist)
+      (define-key map (vector (cdr ci))
+        `(lambda () (interactive) (fuel-debug-show--compiler-info ,(car ci)))))
     map))
 
 (defun fuel-debug-mode ()

diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el
index 0a459e43819459d6bc7989916653893a8ebc8d66..ea1d4b93ed0c196ddcebd387eaff22f6f4c89d81 100644 (file)
--- a/misc/fuel/fuel-mode.el
+++ b/misc/fuel/fuel-mode.el
@@ -49,10 +49,12 @@ With prefix argument, ask for the file to run."
          (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)))))
+        (message "Compiling %s ..." file)
+        (let ((r (fuel-debug--display-retort (fuel-eval--eval-string/context cmd)
+                                             (format "%s successfully compiled" file)
+                                             nil
+                                             file)))
+          (if r (message "Compiling %s ... OK!" file) (message "")))))))
 
 (defun fuel-eval-region (begin end &optional arg)
   "Sends region to Fuel's listener for evaluation.