steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor

db4
Slava Pestov 2008-12-12 19:25:11 -06:00
parent 5e6f94ef62 d3c279469c
commit f5395a9c1e
10 changed files with 439 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/fuel/fuel.factor
View File

@ -151,7 +151,8 @@ M: source-file fuel-pprint path>> fuel-pprint ;
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
: fuel-get-edit-location ( defspec -- )
where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ] when* ;
where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ]
when* ;
: fuel-run-file ( path -- ) run-file ; inline

9
misc/fuel/README
View File

@ -50,7 +50,7 @@ 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:
* In factor source files:
- C-cz : switch to listener
- C-co : cycle between code, tests and docs factor files
@ -70,6 +70,13 @@ the same as C-cz)).
- g : go to error
- <digit> : invoke nth restart
- w/e/l : invoke :warnings, :errors, :linkage
- q : bury buffer
* In the Help browser:
- RET : help for word at point
- f/b : next/previous page
- SPC/S-SPC : scroll up/down
- q: bury buffer

2
misc/fuel/fuel-base.el
View File

@ -59,5 +59,7 @@
" ")
len))
(defsubst empty-string-p (str) (equal str ""))
(provide 'fuel-base)
;;; fuel-base.el ends here

186
misc/fuel/fuel-connection.el Normal file
View File

@ -0,0 +1,186 @@
;;; fuel-connection.el -- asynchronous comms with the fuel listener
;; 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: Thu Dec 11, 2008 03:10
;;; Comentary:
;; Handling communications via a comint buffer running a factor
;; listener.
;;; Code:
;;; Default connection:
(make-variable-buffer-local
(defvar fuel-con--connection nil))
(defun fuel-con--get-connection (buffer/proc)
(if (processp buffer/proc)
(fuel-con--get-connection (process-buffer buffer/proc))
(with-current-buffer buffer/proc
(or fuel-con--connection
(setq fuel-con--connection
(fuel-con--setup-connection buffer/proc))))))
;;; Request and connection datatypes:
(defun fuel-con--connection-queue-request (c r)
(let ((reqs (assoc :requests c)))
(setcdr reqs (append (cdr reqs) (list r)))))
(defun fuel-con--make-request (str cont &optional sender-buffer)
(list :fuel-connection-request
(cons :id (random))
(cons :string str)
(cons :continuation cont)
(cons :buffer (or sender-buffer (current-buffer)))))
(defsubst fuel-con--request-p (req)
(and (listp req) (eq (car req) :fuel-connection-request)))
(defsubst fuel-con--request-id (req)
(cdr (assoc :id req)))
(defsubst fuel-con--request-string (req)
(cdr (assoc :string req)))
(defsubst fuel-con--request-continuation (req)
(cdr (assoc :continuation req)))
(defsubst fuel-con--request-buffer (req)
(cdr (assoc :buffer req)))
(defsubst fuel-con--request-deactivate (req)
(setcdr (assoc :continuation req) nil))
(defsubst fuel-con--request-deactivated-p (req)
(null (cdr (assoc :continuation req))))
(defsubst fuel-con--make-connection (buffer)
(list :fuel-connection
(list :requests)
(list :current)
(cons :completed (make-hash-table :weakness 'value))
(cons :buffer buffer)))
(defsubst fuel-con--connection-p (c)
(and (listp c) (eq (car c) :fuel-connection)))
(defsubst fuel-con--connection-requests (c)
(cdr (assoc :requests c)))
(defsubst fuel-con--connection-current-request (c)
(cdr (assoc :current c)))
(defun fuel-con--connection-clean-current-request (c)
(let* ((cell (assoc :current c))
(req (cdr cell)))
(when req
(puthash (fuel-con--request-id req) req (cdr (assoc :completed c)))
(setcdr cell nil))))
(defsubst fuel-con--connection-completed-p (c id)
(gethash id (cdr (assoc :completed c))))
(defsubst fuel-con--connection-buffer (c)
(cdr (assoc :buffer c)))
(defun fuel-con--connection-pop-request (c)
(let ((reqs (assoc :requests c))
(current (assoc :current c)))
(setcdr current (prog1 (cadr reqs) (setcdr reqs (cddr reqs))))
(if (and current (fuel-con--request-deactivated-p current))
(fuel-con--connection-pop-request c)
current)))
;;; Connection setup:
(defun fuel-con--setup-connection (buffer)
(set-buffer buffer)
(let ((conn (fuel-con--make-connection buffer)))
(fuel-con--setup-comint)
(setq fuel-con--connection conn)))
(defun fuel-con--setup-comint ()
(add-hook 'comint-redirect-filter-functions
'fuel-con--comint-redirect-filter t t))
;;; Requests handling:
(defun fuel-con--process-next (con)
(when (not (fuel-con--connection-current-request con))
(let* ((buffer (fuel-con--connection-buffer con))
(req (fuel-con--connection-pop-request con))
(str (and req (fuel-con--request-string req))))
(when (and buffer req str)
(set-buffer buffer)
(comint-redirect-send-command str
(get-buffer-create "*factor messages*")
nil
t)))))
(defun fuel-con--comint-redirect-filter (str)
(if (not fuel-con--connection)
(format "\nERROR: No connection in buffer (%s)\n" str)
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(if (not req) (format "\nERROR: No current request (%s)\n" str)
(let ((cont (fuel-con--request-continuation req))
(id (fuel-con--request-id req))
(rstr (fuel-con--request-string req))
(buffer (fuel-con--request-buffer req)))
(prog1
(if (not cont)
(format "\nWARNING: Droping result for request %s:%S (%s)\n"
id rstr str)
(condition-case cerr
(with-current-buffer (or buffer (current-buffer))
(funcall cont str)
(format "\nINFO: %s:%S processed\nINFO: %s\n" id rstr str))
(error (format "\nERROR: continuation failed %s:%S \nERROR: %s\n"
id rstr cerr))))
(fuel-con--connection-clean-current-request fuel-con--connection)))))))
;;; Message sending interface:
(defun fuel-con--send-string (buffer/proc str cont &optional sender-buffer)
(save-current-buffer
(let ((con (fuel-con--get-connection buffer/proc)))
(unless con
(error "FUEL: couldn't find connection"))
(let ((req (fuel-con--make-request str cont sender-buffer)))
(fuel-con--connection-queue-request con req)
(fuel-con--process-next con)
req))))
(defvar fuel-connection-timeout 30000
"Time limit, in msecs, blocking on synchronous evaluation requests")
(defun fuel-con--send-string/wait (buffer/proc str cont &optional timeout sbuf)
(save-current-buffer
(let* ((con (fuel-con--get-connection buffer/proc))
(req (fuel-con--send-string buffer/proc str cont sbuf))
(id (and req (fuel-con--request-id req)))
(time (or timeout fuel-connection-timeout))
(step 2))
(when id
(while (and (> time 0)
(not (fuel-con--connection-completed-p con id)))
(sleep-for 0 step)
(setq time (- time step)))
(or (> time 0)
(fuel-con--request-deactivate req)
nil)))))
(provide 'fuel-connection)
;;; fuel-connection.el ends here

5
misc/fuel/fuel-debug.el
View File

@ -214,7 +214,7 @@
(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))
(fuel-eval--send/wait (fuel-eval--cmd/string (format ":%s" n)))
(format "Restart %s (%s) successful" n (nth (1- n) rs))))))))
(defun fuel-debug-show--compiler-info (info)
@ -224,7 +224,8 @@
(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))
(fuel-eval--send/wait (fuel-eval--cmd/string info))
"" (fuel-debug--buffer-file))
(error "Sorry, no %s info available" info))))

154
misc/fuel/fuel-eval.el
View File

@ -1,4 +1,4 @@
;;; fuel-eval.el --- utilities for communication with fuel-listener
;;; fuel-eval.el --- evaluating Factor expressions
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
@ -9,46 +9,16 @@
;;; Commentary:
;; Protocols for handling communications via a comint buffer running a
;; factor listener.
;; Protocols for sending evaluations to the Factor listener.
;;; Code:
(require 'fuel-base)
(require 'fuel-syntax)
(require 'fuel-connection)
;;; Syncronous string sending:
(defvar fuel-eval-log-max-length 16000)
(defvar fuel-eval--default-proc-function nil)
(defsubst fuel-eval--default-proc ()
(and fuel-eval--default-proc-function
(funcall fuel-eval--default-proc-function)))
(defvar fuel-eval--proc nil)
(defvar fuel-eval--log t)
(defun fuel-eval--send-string (str)
(let ((proc (or fuel-eval--proc (fuel-eval--default-proc))))
(when proc
(with-current-buffer (get-buffer-create "*factor messages*")
(goto-char (point-max))
(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)))
(newline)
(let ((beg (point)))
(comint-redirect-send-command-to-process str (current-buffer) proc nil t)
(with-current-buffer (process-buffer proc)
(while (not comint-redirect-completed) (sleep-for 0 1)))
(goto-char beg)
(current-buffer))))))
;;; Evaluation protocol
;;; Retort and retort-error datatypes:
(defsubst fuel-eval--retort-make (err result &optional output)
(list err result output))
@ -60,57 +30,14 @@
(defsubst fuel-eval--retort-p (ret) (listp ret))
(defsubst fuel-eval--make-parse-error-retort (str)
(fuel-eval--retort-make 'parse-retort-error nil str))
(fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
(defun fuel-eval--parse-retort (buffer)
(defun fuel-eval--parse-retort (str)
(save-current-buffer
(set-buffer buffer)
(condition-case nil
(read (current-buffer))
(error (fuel-eval--make-parse-error-retort
(buffer-substring-no-properties (point) (point-max)))))))
(defsubst fuel-eval--send/retort (str)
(fuel-eval--parse-retort (fuel-eval--send-string str)))
(defsubst fuel-eval--eval-begin ()
(fuel-eval--send/retort "fuel-begin-eval"))
(defsubst fuel-eval--eval-end ()
(fuel-eval--send/retort "fuel-begin-eval"))
(defsubst fuel-eval--factor-array (strs)
(format "V{ %S }" (mapconcat 'identity 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 &optional no-restart)
(fuel-eval--eval-strings (list str) no-restart))
(defun fuel-eval--eval-strings/context (strs &optional no-restart)
(let ((usings (fuel-syntax--usings-update)))
(fuel-eval--send/retort
(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 &optional no-restart)
(fuel-eval--eval-strings/context (list str) no-restart))
(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 no-restart))))
;;; Error parsing
(let ((ret (car (read-from-string str))))
(if (fuel-eval--retort-p ret) ret (error)))
(error (fuel-eval--make-parse-error-retort str)))))
(defsubst fuel-eval--error-name (err) (car err))
@ -137,6 +64,69 @@
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
;;; String sending::
(defvar fuel-eval-log-max-length 16000)
(defvar fuel-eval--default-proc-function nil)
(defsubst fuel-eval--default-proc ()
(and fuel-eval--default-proc-function
(funcall fuel-eval--default-proc-function)))
(defvar fuel-eval--proc nil)
(defvar fuel-eval--log t)
(defvar fuel-eval--sync-retort nil)
(defun fuel-eval--send/wait (str &optional timeout buffer)
(setq fuel-eval--sync-retort nil)
(fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
str
'(lambda (s)
(setq fuel-eval--sync-retort
(fuel-eval--parse-retort s)))
timeout
buffer)
fuel-eval--sync-retort)
(defun fuel-eval--send (str cont &optional buffer)
(fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
str
`(lambda (s) (,cont (fuel-eval--parse-retort s)))
buffer))
;;; Evaluation protocol
(defsubst fuel-eval--factor-array (strs)
(format "V{ %S }" (mapconcat 'identity strs " ")))
(defun fuel-eval--cmd/lines (strs &optional no-rs in usings)
(unless (and in usings) (fuel-syntax--usings-update))
(let* ((in (cond ((not in) (or fuel-syntax--current-vocab "f"))
((eq in t) "fuel-scratchpad")
(in in)))
(usings (cond ((not usings) fuel-syntax--usings)
((eq usings t) nil)
(usings usings))))
(format "fuel-eval-%srestartable %s %S %s fuel-eval-in-context"
(if no-rs "non-" "")
(fuel-eval--factor-array strs)
in
(fuel-eval--factor-array usings))))
(defsubst fuel-eval--cmd/string (str &optional no-rs in usings)
(fuel-eval--cmd/lines (list str) no-rs in usings))
(defun fuel-eval--cmd/region (begin end &optional no-rs in usings)
(let ((lines (split-string (buffer-substring-no-properties begin end)
"[\f\n\r\v]+" t)))
(when (> (length lines) 0)
(fuel-eval--cmd/lines lines no-rs in usings))))
(provide 'fuel-eval)
;;; fuel-eval.el ends here

2
misc/fuel/fuel-font-lock.el
View File

@ -57,7 +57,7 @@
(,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
(,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
(2 'factor-font-lock-word))
(,fuel-syntax--parent-type-regex 1 'factor-font-lock-type)
(,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name)
(,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
(,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
(,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)

205
misc/fuel/fuel-help.el
View File

@ -45,6 +45,11 @@
:type 'hook
:group 'fuel-help)
(defcustom fuel-help-history-cache-size 50
"Maximum number of pages to keep in the help browser cache."
:type 'integer
:group 'fuel-help)
(defface fuel-help-font-lock-headlines '((t (:bold t :weight bold)))
"Face for headlines in help buffers."
:group 'fuel-help
@ -70,10 +75,10 @@
(let ((word (or word (fuel-syntax-symbol-at-point)))
(fuel-eval--log t))
(when word
(let ((ret (fuel-eval--eval-string/context
(format "\\ %s synopsis fuel-eval-set-result" word)
t)))
(when (not (fuel-eval--retort-error ret))
(let* ((str (format "\\ %s synopsis fuel-eval-set-result" word))
(cmd (fuel-eval--cmd/string str t t))
(ret (fuel-eval--send/wait cmd 20)))
(when (and ret (not (fuel-eval--retort-error ret)))
(if fuel-help-minibuffer-font-lock
(fuel-help--font-lock-str (fuel-eval--retort-result ret))
(fuel-eval--retort-result ret)))))))
@ -101,92 +106,83 @@ displayed in the minibuffer."
(message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
;;;; Factor help mode:
;;; Help browser history:
(defvar fuel-help-mode-map (make-sparse-keymap)
"Keymap for Factor help mode.")
(defvar fuel-help--history
(list nil
(make-ring fuel-help-history-cache-size)
(make-ring fuel-help-history-cache-size)))
(define-key fuel-help-mode-map [(return)] 'fuel-help)
(defvar fuel-help--history-idx 0)
(defconst fuel-help--headlines
(regexp-opt '("Class description"
"Definition"
"Examples"
"Generic word contract"
"Inputs and outputs"
"Methods"
"Notes"
"Parent topics:"
"See also"
"Syntax"
"Vocabulary"
"Warning"
"Word description")
t))
(defun fuel-help--history-push (term)
(when (car fuel-help--history)
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
(setcar fuel-help--history term))
(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
(defun fuel-help--history-next ()
(when (not (ring-empty-p (nth 2 fuel-help--history)))
(when (car fuel-help--history)
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
(setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
(defconst fuel-help--font-lock-keywords
`(,@fuel-font-lock--font-lock-keywords
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
(defun fuel-help--history-previous ()
(when (not (ring-empty-p (nth 1 fuel-help--history)))
(when (car fuel-help--history)
(ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
(setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
(defun fuel-help-mode ()
"Major mode for displaying Factor documentation.
\\{fuel-help-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map fuel-help-mode-map)
(setq mode-name "Factor Help")
(setq major-mode 'fuel-help-mode)
(fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
(set (make-local-variable 'view-no-disable-on-exit) t)
(view-mode)
(setq view-exit-action
(lambda (buffer)
;; Use `with-current-buffer' to make sure that `bury-buffer'
;; also removes BUFFER from the selected window.
(with-current-buffer buffer
(bury-buffer))))
(setq fuel-autodoc-mode-string "")
(fuel-autodoc-mode)
(run-mode-hooks 'fuel-help-mode-hook))
;;; Fuel help buffer and internals:
(defun fuel-help--help-buffer ()
(with-current-buffer (get-buffer-create "*fuel-help*")
(fuel-help-mode)
(current-buffer)))
(defvar fuel-help--history nil)
(defvar fuel-help--prompt-history nil)
(defun fuel-help--show-help (&optional see)
(let* ((def (fuel-syntax-symbol-at-point))
(defun fuel-help--show-help (&optional see word)
(let* ((def (or word (fuel-syntax-symbol-at-point)))
(prompt (format "See%s help on%s: " (if see " short" "")
(if def (format " (%s)" def) "")))
(ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
(not def)
fuel-help-always-ask))
(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 t))
(out (fuel-eval--retort-output ret)))
(def (if ask (read-string prompt nil 'fuel-help--prompt-history def)
def))
(cmd (format "\\ %s %s" def (if see "see" "help"))))
(message "Looking up '%s' ..." def)
(fuel-eval--send (fuel-eval--cmd/string cmd t t)
`(lambda (r) (fuel-help--show-help-cont ,def r)))))
(defun fuel-help--show-help-cont (def ret)
(let ((out (fuel-eval--retort-output ret)))
(if (or (fuel-eval--retort-error ret) (empty-string-p out))
(message "No help for '%s'" def)
(let ((hb (fuel-help--help-buffer))
(inhibit-read-only t)
(font-lock-verbose nil))
(set-buffer hb)
(erase-buffer)
(insert out)
(set-buffer-modified-p nil)
(pop-to-buffer hb)
(goto-char (point-min))))))
(fuel-help--insert-contents def out))))
(defun fuel-help--insert-contents (def str &optional nopush)
(let ((hb (fuel-help--help-buffer))
(inhibit-read-only t)
(font-lock-verbose nil))
(set-buffer hb)
(erase-buffer)
(insert str)
(goto-char (point-min))
(when (re-search-forward (format "^%s" def) nil t)
(beginning-of-line)
(kill-region (point-min) (point))
(next-line)
(open-line 1))
(set-buffer-modified-p nil)
(unless nopush (fuel-help--history-push (cons def str)))
(pop-to-buffer hb)
(goto-char (point-min))
(message "%s" def)))
;;; Interface: see/help commands
;;; Interactive help commands:
(defun fuel-help-short (&optional arg)
"See a help summary of symbol at point.
@ -204,6 +200,79 @@ buffer."
(interactive)
(fuel-help--show-help))
(defun fuel-help-next ()
"Go to next page in help browser."
(interactive)
(let ((item (fuel-help--history-next))
(fuel-help-always-ask nil))
(unless item
(error "No next page"))
(fuel-help--insert-contents (car item) (cdr item) t)))
(defun fuel-help-previous ()
"Go to next page in help browser."
(interactive)
(let ((item (fuel-help--history-previous))
(fuel-help-always-ask nil))
(unless item
(error "No previous page"))
(fuel-help--insert-contents (car item) (cdr item) t)))
;;;; Factor help mode:
(defvar fuel-help-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-m" 'fuel-help)
(define-key map "q" 'bury-buffer)
(define-key map "b" 'fuel-help-previous)
(define-key map "f" 'fuel-help-next)
(define-key map (kbd "SPC") 'scroll-up)
(define-key map (kbd "S-SPC") 'scroll-down)
map))
(defconst fuel-help--headlines
(regexp-opt '("Class description"
"Definition"
"Errors"
"Examples"
"Generic word contract"
"Inputs and outputs"
"Methods"
"Notes"
"Parent topics:"
"See also"
"Syntax"
"Variable description"
"Variable value"
"Vocabulary"
"Warning"
"Word description")
t))
(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
(defconst fuel-help--font-lock-keywords
`(,@fuel-font-lock--font-lock-keywords
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
(defun fuel-help-mode ()
"Major mode for browsing Factor documentation.
\\{fuel-help-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map fuel-help-mode-map)
(setq mode-name "Factor Help")
(setq major-mode 'fuel-help-mode)
(fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
(setq fuel-autodoc-mode-string "")
(fuel-autodoc-mode)
(run-mode-hooks 'fuel-help-mode-hook)
(toggle-read-only 1))
(provide 'fuel-help)
;;; fuel-help.el ends here

26
misc/fuel/fuel-listener.el
View File

@ -66,7 +66,7 @@ buffer."
(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")
(fuel-eval--send/wait "USE: fuel")
(message "FUEL listener up and running!"))))
(defun fuel-listener--process (&optional start)
@ -83,18 +83,18 @@ buffer."
;;; 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
(let ((proc (get-buffer-process fuel-listener-buffer)))
(with-current-buffer fuel-listener-buffer
(goto-char (or comint-last-input-end (point-min)))
(let ((seen (re-search-forward comint-prompt-regexp nil t)))
(while (and (not seen)
(accept-process-output proc (or timeout 10) nil t))
(sleep-for 0 1)
(goto-char comint-last-input-end)
(setq seen (re-search-forward comint-prompt-regexp nil t)))
(pop-to-buffer fuel-listener-buffer)
(error "No prompt found!"))))
(goto-char (point-max))
(unless seen (error "No prompt found!"))))))
;;; Interface: starting fuel listener
@ -124,6 +124,8 @@ buffer."
(set (make-local-variable 'comint-prompt-read-only) t)
(setq fuel-listener--compilation-begin nil))
(define-key fuel-listener-mode-map "\C-cz" 'run-factor)
(define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor)
(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)

23
misc/fuel/fuel-mode.el
View File

@ -45,16 +45,20 @@ With prefix argument, ask for the file to run."
(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)))
(buffer (find-file-noselect 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 "")))))))
(fuel-eval--send (fuel-eval--cmd/string (format "%S fuel-run-file" file))
`(lambda (r) (fuel--run-file-cont r ,file)))))))
(defun fuel--run-file-cont (ret file)
(if (fuel-debug--display-retort ret
(format "%s successfully compiled" file)
nil
file)
(message "Compiling %s ... OK!" file)
(message "")))
(defun fuel-eval-region (begin end &optional arg)
"Sends region to Fuel's listener for evaluation.
@ -62,7 +66,7 @@ Unless called with a prefix, switchs to the compilation results
buffer in case of errors."
(interactive "r\nP")
(fuel-debug--display-retort
(fuel-eval--eval-region/context begin end)
(fuel-eval--send/wait (fuel-eval--cmd/region begin end) 10000)
(format "%s%s"
(if fuel-syntax--current-vocab
(format "IN: %s " fuel-syntax--current-vocab)
@ -105,8 +109,9 @@ With prefix, asks for the word to edit."
(if word (format " (%s)" word) ""))
word)
word)))
(let* ((ret (fuel-eval--eval-string/context
(let* ((str (fuel-eval--cmd/string
(format "\\ %s fuel-get-edit-location" word)))
(ret (fuel-eval--send/wait str))
(err (fuel-eval--retort-error ret))
(loc (fuel-eval--retort-result ret)))
(when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))