! 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
-! <PRIVATE
+! Evaluation status:
-TUPLE: fuel-status in use ds? ;
+TUPLE: fuel-status in use ds? restarts ;
SYMBOL: fuel-status-stack
V{ } clone fuel-status-stack set-global
+SYMBOL: fuel-eval-result
+f clone fuel-eval-result set-global
+
+SYMBOL: fuel-eval-output
+f clone fuel-eval-result set-global
+
+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
+ 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 ] tri
+ 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 ;
-SYMBOL: fuel-eval-result
-f clone fuel-eval-result set-global
-SYMBOL: fuel-eval-output
-f clone fuel-eval-result set-global
-
-! PRIVATE>
+! 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 ] [
")" 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 ; inline
+
+M: restart fuel-pprint name>> fuel-pprint ; inline
+
+SYMBOL: :restarts
-M: continuation fuel-pprint drop "~continuation~" write ;
+: 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
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) [
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
Quick key reference
-------------------
+(Chords ending in a single letter <x> accept also C-<x> (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 <x> accept also C-<x> (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
+ - <digit> : invoke nth restart
+ - q : bury buffer
+
+
:type 'hook
:group 'factor-mode)
+\f
+;;; Faces:
+
+(fuel-font-lock--define-faces
+ factor-font-lock font-lock factor-mode
+ ((comment comment "comments")
+ (constructor type "constructors (<foo>)")
+ (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")))
+
\f
;;; Syntax table:
--- /dev/null
+;;; 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 <jao@gnu.org>
+;; 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)
+
+\f
+;;; 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")))
+
+\f
+;;; 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)
+
+(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)))
+
+\f
+;;; 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))))
+
+\f
+;;; 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))
+
+\f
+(provide 'fuel-debug)
+;;; fuel-debug.el ends here
(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)
(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))
(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))))
+
+\f
+;;; 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)))
\f
(provide 'fuel-eval)
\f
;;; 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 (<foo>)")
- (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))))
\f
;;; Font lock:
(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))
(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)
(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)
(setq fuel-eval--default-proc-function 'fuel-listener--process)
+\f
+;;; 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!"))))
+
\f
;;; Interface: starting fuel listener
(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)
\f
(provide 'fuel-listener)
(require 'fuel-base)
(require 'fuel-syntax)
(require 'fuel-font-lock)
+(require 'fuel-debug)
(require 'fuel-help)
(require 'fuel-eval)
(require 'fuel-listener)
\f
;;; 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.
(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)
projects / factor.git / commitdiff