FUEL: Offer a command to add missing vocabs after run-file.
Jose A. Ortega Ruiz
parent
a89b5d6a8a
commit
303735db5a
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -23,12 +23,6 @@
|
|||
|
||||
;;; 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 ..."
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
||||
|
||||
;;; 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))))
|
||||
|
||||
|
||||
;;; 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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue