FUEL: Offer a command to add missing vocabs after run-file.

diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 00d9983b46102264858ab0b50d64979abcde2dca..c1d90ebbccda77c13ae52c74aefdae8136bd98b5 100644 (file)
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -135,14 +135,17 @@ M: source-file fuel-pprint path>> fuel-pprint ;
 
 ! Loading files
 
-: fuel-run-file ( path -- ) run-file ; inline
+SYMBOL: :uses
+
+: fuel-set-use-hook ( -- )
+    [ amended-use get clone :uses prefix fuel-eval-set-result ]
+    print-use-hook set ;
+
+: fuel-run-file ( path -- )
+    [ fuel-set-use-hook run-file ] curry with-scope ; inline
 
 : fuel-with-autouse ( quot -- )
-    [
-        auto-use? on
-        [ amended-use get clone fuel-eval-set-result ] print-use-hook set
-        call
-    ] curry with-scope ;
+    [ auto-use? on fuel-set-use-hook call ] curry with-scope ;
 
 : (fuel-get-uses) ( lines -- )
     [ parse-fresh drop ] curry with-compilation-unit ; inline

diff --git a/misc/fuel/fuel-debug-uses.el b/misc/fuel/fuel-debug-uses.el
index 2e94258c287c4e56ac6fed6bc8c61a3962a02db1..7b90093c21faa7dce14ddd6e03bb46ed6eb65a8d 100644 (file)
--- a/misc/fuel/fuel-debug-uses.el
+++ b/misc/fuel/fuel-debug-uses.el
@@ -23,12 +23,6 @@
 \f
 ;;; Customization:
 
-(fuel-font-lock--defface fuel-font-lock-debug-missing-vocab
-  'font-lock-warning-face fuel-debug "missing vocabulary names")
-
-(fuel-font-lock--defface fuel-font-lock-debug-unneeded-vocab
-  'font-lock-warning-face fuel-debug "unneeded vocabulary names")
-
 (fuel-font-lock--defface fuel-font-lock-debug-uses-header
   'bold fuel-debug "headers in Uses buffers")
 
@@ -53,26 +47,6 @@
             (forward-line))
           (reverse lines))))))
 
-(defun fuel-debug--highlight-names (names ref face)
-  (dolist (n names)
-    (when (not (member n ref))
-      (put-text-property 0 (length n) 'font-lock-face face n))))
-
-(defun fuel-debug--uses-new-uses (file uses)
-  (pop-to-buffer (find-file-noselect file))
-  (goto-char (point-min))
-  (if (re-search-forward "^USING: " nil t)
-      (let ((begin (point))
-            (end (or (and (re-search-forward "\\_<;\\_>") (point)) (point))))
-        (kill-region begin end))
-    (re-search-forward "^IN: " nil t)
-    (beginning-of-line)
-    (open-line 2)
-    (insert "USING: "))
-  (let ((start (point)))
-    (insert (mapconcat 'substring-no-properties uses " ") " ;")
-    (fill-region start (point) nil)))
-
 (defun fuel-debug--uses-filter (restarts)
   (let ((result) (i 1) (rn 0))
     (dolist (r restarts (reverse result))
@@ -87,9 +61,6 @@
 (fuel-popup--define fuel-debug--uses-buffer
   "*fuel uses*" 'fuel-debug-uses-mode)
 
-(make-variable-buffer-local
- (defvar fuel-debug--uses nil))
-
 (make-variable-buffer-local
  (defvar fuel-debug--uses-file nil))
 
@@ -122,22 +93,11 @@
     (fuel-popup--display (fuel-debug--uses-buffer))))
 
 (defun fuel-debug--uses-cont (retort)
-  (let ((uses (fuel-eval--retort-result retort))
+  (let ((uses (fuel-debug--uses retort))
         (err (fuel-eval--retort-error retort)))
     (if uses (fuel-debug--uses-display uses)
       (fuel-debug--uses-display-err retort))))
 
-(defun fuel-debug--insert-vlist (title vlist)
-  (goto-char (point-max))
-  (insert title "\n\n  ")
-  (let ((i 0) (step 5))
-    (dolist (v vlist)
-      (setq i (1+ i))
-      (insert v)
-      (insert (if (zerop (mod i step)) "\n  " " ")))
-    (unless (zerop (mod i step)) (newline))
-    (newline)))
-
 (defun fuel-debug--uses-display (uses)
   (let* ((inhibit-read-only t)
          (old (with-current-buffer (find-file-noselect fuel-debug--uses-file)
@@ -176,14 +136,15 @@
 
 (defun fuel-debug--uses-update-usings ()
   (interactive)
-  (let ((inhibit-read-only t))
-    (when (and fuel-debug--uses-file fuel-debug--uses)
-      (fuel-debug--uses-new-uses fuel-debug--uses-file fuel-debug--uses)
-      (message "USING: updated!")
-      (with-current-buffer (fuel-debug--uses-buffer)
-        (insert "\nDone!")
-        (fuel-debug--uses-clean)
-        (kill-buffer (current-buffer))))))
+  (let ((inhibit-read-only t)
+        (file fuel-debug--uses-file)
+        (uses fuel-debug--uses))
+    (when (and uses file)
+      (insert "\nDone!")
+      (fuel-debug--uses-clean)
+      (fuel-popup--quit)
+      (fuel-debug--replace-usings file uses)
+      (message "USING: updated!"))))
 
 (defun fuel-debug--uses-restart (n)
   (when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
@@ -209,11 +170,11 @@
 
 (defconst fuel-debug--uses-header-regex
   (format "^%s.*$" (regexp-opt '("Infering USING: stanza for "
-                              "Current USING: is already fine!"
-                              "Current vocabulary list:"
-                              "Correct vocabulary list:"
-                              "Sorry, couldn't infer the vocabulary list."
-                              "Done!"))))
+                                 "Current USING: is already fine!"
+                                 "Current vocabulary list:"
+                                 "Correct vocabulary list:"
+                                 "Sorry, couldn't infer the vocabulary list."
+                                 "Done!"))))
 
 (defconst fuel-debug--uses-prompt-regex
   (format "^%s" (regexp-opt '("Asking Factor. Please, wait ..."

diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el
index 7643d5714466f8c6036e9e5db34b855e46da7fe1..4d84ad5141344ce9a121ec803c05b9beb9c138b7 100644 (file)
--- a/misc/fuel/fuel-debug.el
+++ b/misc/fuel/fuel-debug.el
@@ -49,7 +49,9 @@ the debugger."
   (column variable-name "column numbers in errors/warnings")
   (info comment "information headers")
   (restart-number warning "restart numbers")
-  (restart-name function-name "restart names")))
+  (restart-name function-name "restart names")
+  (missing-vocab warning"missing vocabulary names")
+  (unneeded-vocab warning "unneeded vocabulary names")))
 
 \f
 ;;; Font lock and other pattern matching:
@@ -98,6 +100,9 @@ the debugger."
 (make-variable-buffer-local
  (defvar fuel-debug--file nil))
 
+(make-variable-buffer-local
+ (defvar fuel-debug--uses nil))
+
 (defun fuel-debug--prepare-compilation (file msg)
   (let ((inhibit-read-only t))
     (with-current-buffer (fuel-debug--buffer)
@@ -120,6 +125,7 @@ the debugger."
         (fuel-debug--display-restarts err)
         (delete-blank-lines)
         (newline))
+      (fuel-debug--display-uses ret)
       (let ((hstr (fuel-debug--help-string err fuel-debug--file)))
         (if fuel-debug-show-short-help
             (insert "-----------\n" hstr "\n")
@@ -130,6 +136,46 @@ the debugger."
       (when (and err (not no-pop)) (fuel-popup--display))
       (not err))))
 
+(defun fuel-debug--uses (ret)
+  (let ((uses (fuel-eval--retort-result ret)))
+    (and (eq :uses (car uses))
+         (cdr uses))))
+
+(defun fuel-debug--insert-vlist (title vlist)
+  (goto-char (point-max))
+  (insert title "\n\n  ")
+  (let ((i 0) (step 5))
+    (dolist (v vlist)
+      (setq i (1+ i))
+      (insert v)
+      (insert (if (zerop (mod i step)) "\n  " " ")))
+    (unless (zerop (mod i step)) (newline))
+    (newline)))
+
+(defun fuel-debug--highlight-names (names ref face)
+  (dolist (n names)
+    (when (not (member n ref))
+      (put-text-property 0 (length n) 'font-lock-face face n))))
+
+(defun fuel-debug--insert-uses (uses)
+  (let* ((file (or file fuel-debug--file))
+         (old (with-current-buffer (find-file-noselect file)
+                (sort (fuel-syntax--find-usings t) 'string<)))
+         (new (sort uses 'string<)))
+    (when (not (equalp old new))
+      (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
+      (newline)
+      (fuel-debug--insert-vlist "Correct vocabulary list:" new)
+      new)))
+
+(defun fuel-debug--display-uses (ret)
+  (when (setq fuel-debug--uses (fuel-debug--uses ret))
+    (newline)
+    (fuel-debug--highlight-names fuel-debug--uses
+                                 nil 'fuel-font-lock-debug-missing-vocab)
+    (fuel-debug--insert-vlist "Missing vocabularies:" fuel-debug--uses)
+    (newline)))
+
 (defun fuel-debug--display-output (ret)
   (let* ((last (fuel-eval--retort-output fuel-debug--last-ret))
          (current (fuel-eval--retort-output ret))
@@ -155,7 +201,7 @@ the debugger."
       (newline))))
 
 (defun fuel-debug--help-string (err &optional file)
-  (format "Press %s%s%sq bury buffer"
+  (format "Press %s%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) "")
@@ -166,7 +212,8 @@ the debugger."
               (save-excursion
                 (goto-char (point-min))
                 (when (search-forward (car ci) nil t)
-                  (setq str (format "%c %s, %s" (cdr ci) (car ci) str))))))))
+                  (setq str (format "%c %s, %s" (cdr ci) (car ci) str))))))
+          (if (and (not err) fuel-debug--uses) "u to update USING:, " "")))
 
 (defun fuel-debug--buffer-file ()
   (with-current-buffer (fuel-debug--buffer)
@@ -235,6 +282,31 @@ the debugger."
              (fuel-eval--send/wait `(:fuel ((:factor ,info)))) "")
       (error "Sorry, no %s info available" info))))
 
+(defun fuel-debug--replace-usings (file uses)
+  (pop-to-buffer (find-file-noselect file))
+  (goto-char (point-min))
+  (if (re-search-forward "^USING: " nil t)
+      (let ((begin (point))
+            (end (or (and (re-search-forward "\\_<;\\_>") (point)) (point))))
+        (kill-region begin end))
+    (re-search-forward "^IN: " nil t)
+    (beginning-of-line)
+    (open-line 2)
+    (insert "USING: "))
+  (let ((start (point)))
+    (insert (mapconcat 'substring-no-properties uses " ") " ;")
+    (fill-region start (point) nil)))
+
+(defun fuel-debug-update-usings ()
+  (interactive)
+  (when (and fuel-debug--file fuel-debug--uses)
+    (let* ((file fuel-debug--file)
+           (old (with-current-buffer (find-file-noselect file)
+                  (fuel-syntax--find-usings t)))
+           (uses (sort (append fuel-debug--uses old) 'string<)))
+      (fuel-popup--quit)
+      (fuel-debug--replace-usings file uses))))
+
 \f
 ;;; Fuel Debug mode:
 
@@ -245,6 +317,7 @@ the debugger."
     (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 "u" 'fuel-debug-update-usings)
     (dotimes (n 9)
       (define-key map (vector (+ ?1 n))
         `(lambda () (interactive)