diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index d8a363ca71..d9db83b5e3 100644 --- a/extra/fuel/fuel.factor +++ b/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 -definitions eval io io.files io.streams.string kernel listener listener.private -make math namespaces parser prettyprint quotations sequences strings -vectors vocabs.loader ; +USING: accessors arrays classes classes.tuple compiler.units +combinators continuations debugger definitions eval help +io io.files io.streams.string kernel lexer listener listener.private +make math namespaces parser prettyprint prettyprint.config +quotations sequences strings source-files vectors vocabs.loader ; IN: fuel -! > 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 @@ -66,33 +104,34 @@ M: continuation fuel-pprint drop "~continuation~" write ; fuel-eval-output get-global 3array fuel-pprint ; -: fuel-forget-error ( -- ) - f error set-global ; +: 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-forget-result + fuel-forget-output ; : (fuel-end-eval) ( quot -- ) with-string-writer fuel-eval-output set-global - fuel-retort - pop-fuel-status ; + fuel-retort pop-fuel-status ; inline : (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-each) fuel-forget-error fuel-forget-output ; : (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 +146,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 ( -- ) [ ] (fuel-end-eval) ; inline : fuel-get-edit-location ( defspec -- ) where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ] when* ; -: fuel-startup ( -- ) - "listener" run ; +: fuel-run-file ( path -- ) run-file ; inline + +: fuel-startup ( -- ) "listener" run ; inline MAIN: fuel-startup diff --git a/misc/fuel/README b/misc/fuel/README index 078490abfd..18f6fa1e94 100644 --- a/misc/fuel/README +++ b/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 accept also C- (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 accept also C- (e.g. C-cC-z is -the same as C-cz). +* In the debugger (it pops up upon eval/compilation errors): + + - g : go to error + - : invoke nth restart + - q : bury buffer + + diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index d79930bb22..b3952074f5 100644 --- a/misc/fuel/factor-mode.el +++ b/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 ()") + (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: diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el new file mode 100644 index 0000000000..b3aad7f3dc --- /dev/null +++ b/misc/fuel/fuel-debug.el @@ -0,0 +1,266 @@ +;;; 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 +;; 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"))) + + +;;; 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))) + + +;;; Debug 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) + (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) + (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)) + (not err)))) + +(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)) + (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 "Restarts:\n\n") + (dotimes (n rsn) + (insert (format ":%s %s\n" (1+ n) (nth n rs)))) + (newline)))) + +(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 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) + (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))) + + +;;; Buffer navigation: + +(defun fuel-debug-goto-error () + (interactive) + (let* ((err (or (fuel-debug--buffer-error) + (error "No errors reported"))) + (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)) + (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)))))))) + +(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)))) + + +;;; 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 "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 () + "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 diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index bef7171f6f..62001cc48c 100644 --- a/misc/fuel/fuel-eval.el +++ b/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) - (let ((str (format "%s fuel-eval" (fuel-eval--factor-array strs)))) +(defsubst fuel-eval--eval-strings (strs &optional no-restart) + (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) - (fuel-eval--eval-strings (list str))) +(defsubst fuel-eval--eval-string (str &optional no-restart) + (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) - (fuel-eval--eval-strings/context (list str))) +(defsubst fuel-eval--eval-string/context (str &optional no-restart) + (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) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index c8673f742b..4c710635ba 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -21,30 +21,23 @@ ;;; Faces: -(defmacro fuel-font-lock--face (face def doc) - (let ((face (intern (format "factor-font-lock-%s" (symbol-name face)))) - (def (intern (format "font-lock-%s-face" (symbol-name def))))) +(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc) + (let ((face (intern (format "%s-%s" prefix face))) + (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 () - (cons 'progn - (mapcar (lambda (f) (cons 'fuel-font-lock--face f)) - '((comment comment "comments") - (constructor type "constructors ()") - (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"))))) - -(fuel-font-lock--faces-setup) +(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces) + (let ((setup (make-symbol (format "%s--faces-setup" prefix)))) + `(progn + (defmacro ,setup () + (cons 'progn + (mapcar (lambda (f) (append '(fuel-font-lock--make-face + ,prefix ,def-prefix ,group) f)) + ',faces))) + (,setup)))) ;;; Font lock: diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index dcf17d2716..1db9b25d69 100644 --- a/misc/fuel/fuel-help.el +++ b/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) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index c741a77a5d..9fa330993c 100644 --- a/misc/fuel/fuel-listener.el +++ b/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 - (make-comint "fuel listener" factor nil "-run=fuel" (format "-i=%s" image))) + (setq fuel-listener-buffer (get-buffer-create "*fuel listener*")) (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-k" 'comint-kill-whole-line) +(define-key fuel-listener-mode-map "\C-ch" 'fuel-help) +(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) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index bd9b127c7d..ea1d4b93ed 100644 --- a/misc/fuel/fuel-mode.el +++ b/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,60 @@ ;;; 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 + (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. -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)) - (err (fuel-eval--retort-error ret))) - (message "%s" (or err (fuel--shorten-region begin end 70)))) - (when arg (pop-to-buffer fuel-listener-buffer))) + (fuel-debug--display-retort + (fuel-eval--eval-region/context begin end) + (format "%s%s" + (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 -listener's buffer afterwards." +to Fuel's listener for evaluation. +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 +156,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)