Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
36dc48ab20
|
|
@ -17,13 +17,13 @@ SYMBOL: fuel-status-stack
|
|||
V{ } clone fuel-status-stack set-global
|
||||
|
||||
SYMBOL: fuel-eval-result
|
||||
f clone fuel-eval-result set-global
|
||||
f fuel-eval-result set-global
|
||||
|
||||
SYMBOL: fuel-eval-output
|
||||
f clone fuel-eval-result set-global
|
||||
f fuel-eval-result set-global
|
||||
|
||||
SYMBOL: fuel-eval-res-flag
|
||||
t clone fuel-eval-res-flag set-global
|
||||
t fuel-eval-res-flag set-global
|
||||
|
||||
: fuel-eval-restartable? ( -- ? )
|
||||
fuel-eval-res-flag get-global ; inline
|
||||
|
|
@ -105,12 +105,11 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
: 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-forget-status ( -- )
|
||||
fuel-forget-error fuel-forget-result fuel-forget-output ; inline
|
||||
|
||||
: (fuel-begin-eval) ( -- )
|
||||
fuel-push-status
|
||||
fuel-forget-error
|
||||
fuel-forget-result
|
||||
fuel-forget-output ;
|
||||
fuel-push-status fuel-forget-status ; inline
|
||||
|
||||
: (fuel-end-eval) ( output -- )
|
||||
fuel-eval-output set-global fuel-retort fuel-pop-status ; inline
|
||||
|
|
@ -136,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
|
||||
|
|
|
|||
|
|
@ -31,8 +31,9 @@
|
|||
:group 'fuel-autodoc
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
|
||||
;;; Autodoc mode:
|
||||
;;; Highlighting for autodoc messages:
|
||||
|
||||
(defvar fuel-autodoc--font-lock-buffer
|
||||
(let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
|
||||
|
|
@ -48,6 +49,11 @@
|
|||
(let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
|
||||
(buffer-string))
|
||||
|
||||
|
||||
;;; Eldoc function:
|
||||
|
||||
(defvar fuel-autodoc--timeout 200)
|
||||
|
||||
(defun fuel-autodoc--word-synopsis (&optional word)
|
||||
(let ((word (or word (fuel-syntax-symbol-at-point)))
|
||||
(fuel-log--inhibit-p t))
|
||||
|
|
@ -55,7 +61,7 @@
|
|||
(let* ((cmd (if (fuel-syntax--in-using)
|
||||
`(:fuel* (,word fuel-vocab-summary) :in t)
|
||||
`(:fuel* (((:quote ,word) synopsis :get)) :in)))
|
||||
(ret (fuel-eval--send/wait cmd 20))
|
||||
(ret (fuel-eval--send/wait cmd fuel-autodoc--timeout))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
|
||||
(if fuel-autodoc-minibuffer-font-lock
|
||||
|
|
@ -70,6 +76,9 @@
|
|||
(funcall fuel-autodoc--fallback-function))
|
||||
(fuel-autodoc--word-synopsis)))
|
||||
|
||||
|
||||
;;; Autodoc mode:
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-autodoc-mode-string " A"
|
||||
"Modeline indicator for fuel-autodoc-mode"))
|
||||
|
|
|
|||
|
|
@ -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,27 +93,15 @@
|
|||
(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)
|
||||
(fuel-syntax--usings)))
|
||||
(old (sort old 'string<))
|
||||
(sort (fuel-syntax--find-usings t) 'string<)))
|
||||
(new (sort uses 'string<)))
|
||||
(erase-buffer)
|
||||
(fuel-debug--uses-insert-title)
|
||||
|
|
@ -177,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)
|
||||
(bury-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)))
|
||||
|
|
@ -210,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 ..."
|
||||
|
|
|
|||
|
|
@ -31,6 +31,12 @@
|
|||
:group 'fuel-debug
|
||||
:type 'hook)
|
||||
|
||||
(defcustom fuel-debug-confirm-restarts-p t
|
||||
"Whether to ask for confimation before executing a restart in
|
||||
the debugger."
|
||||
:group 'fuel-debug
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom fuel-debug-show-short-help t
|
||||
"Whether to show short help on available keys in debugger."
|
||||
:group 'fuel-debug
|
||||
|
|
@ -43,7 +49,9 @@
|
|||
(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:
|
||||
|
|
@ -92,6 +100,9 @@
|
|||
(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)
|
||||
|
|
@ -114,6 +125,7 @@
|
|||
(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")
|
||||
|
|
@ -124,6 +136,46 @@
|
|||
(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))
|
||||
|
|
@ -149,7 +201,7 @@
|
|||
(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) "")
|
||||
|
|
@ -160,7 +212,8 @@
|
|||
(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)
|
||||
|
|
@ -229,6 +282,31 @@
|
|||
(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:
|
||||
|
||||
|
|
@ -239,9 +317,11 @@
|
|||
(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) (fuel-debug-exec-restart ,(1+ n) t))))
|
||||
`(lambda () (interactive)
|
||||
(fuel-debug-exec-restart ,(1+ n) fuel-debug-confirm-restarts-p))))
|
||||
(dolist (ci fuel-debug--compiler-info-alist)
|
||||
(define-key map (vector (cdr ci))
|
||||
`(lambda () (interactive) (fuel-debug-show--compiler-info ,(car ci)))))
|
||||
|
|
|
|||
|
|
@ -140,6 +140,7 @@
|
|||
"Notes"
|
||||
"Parent topics:"
|
||||
"See also"
|
||||
"Side effects"
|
||||
"Syntax"
|
||||
"Variable description"
|
||||
"Variable value"
|
||||
|
|
|
|||
|
|
@ -301,21 +301,9 @@
|
|||
(funcall fuel-syntax--current-vocab-function))
|
||||
|
||||
(defun fuel-syntax--find-in ()
|
||||
(let* ((vocab)
|
||||
(ip
|
||||
(save-excursion
|
||||
(when (re-search-backward fuel-syntax--current-vocab-regex nil t)
|
||||
(setq vocab (match-string-no-properties 1))
|
||||
(point)))))
|
||||
(when ip
|
||||
(let ((pp (save-excursion
|
||||
(when (re-search-backward fuel-syntax--sub-vocab-regex ip t)
|
||||
(point)))))
|
||||
(when (and pp (> pp ip))
|
||||
(let ((sub (match-string-no-properties 1)))
|
||||
(unless (save-excursion (search-backward (format "%s>" sub) pp t))
|
||||
(setq vocab (format "%s.%s" vocab (downcase sub))))))))
|
||||
vocab))
|
||||
(save-excursion
|
||||
(when (re-search-backward fuel-syntax--current-vocab-regex nil t)
|
||||
(match-string-no-properties 1))))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
|
||||
|
|
@ -323,13 +311,19 @@
|
|||
(defsubst fuel-syntax--usings ()
|
||||
(funcall fuel-syntax--usings-function))
|
||||
|
||||
(defun fuel-syntax--find-usings ()
|
||||
(defun fuel-syntax--find-usings (&optional no-private)
|
||||
(save-excursion
|
||||
(let ((usings))
|
||||
(goto-char (point-max))
|
||||
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
|
||||
(dolist (u (split-string (match-string-no-properties 1) nil t))
|
||||
(push u usings)))
|
||||
(goto-char (point-min))
|
||||
(when (and (not no-private)
|
||||
(re-search-forward "\\_<<PRIVATE\\_>" nil t)
|
||||
(re-search-forward "\\_<PRIVATE>\\_>" nil t))
|
||||
(goto-char (point-max))
|
||||
(push (concat (fuel-syntax--find-in) ".private") usings))
|
||||
usings)))
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue