: 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
(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
- 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
" ")
len))
+(defsubst empty-string-p (str) (equal str ""))
+
(provide 'fuel-base)
;;; fuel-base.el ends here
--- /dev/null
+;;; 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:
+
+\f
+;;; 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))))))
+
+\f
+;;; 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)))
+
+\f
+;;; 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))
+
+\f
+;;; 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)))))))
+
+\f
+;;; 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)))))
+
+\f
+(provide 'fuel-connection)
+;;; fuel-connection.el ends here
(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)
(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))))
\f
-;;; 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.
;;; 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)
\f
-;;; 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))))))
-
-\f
-;;; Evaluation protocol
+;;; Retort and retort-error datatypes:
(defsubst fuel-eval--retort-make (err result &optional output)
(list err result output))
(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))))
-
-\f
-;;; 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))
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
+\f
+;;; 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))
+
+\f
+;;; 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))))
+
+
\f
(provide 'fuel-eval)
;;; fuel-eval.el ends here
(,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)
: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
(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)))))))
(message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
\f
-;;;; Factor help mode:
-
-(defvar fuel-help-mode-map (make-sparse-keymap)
- "Keymap for Factor help mode.")
-
-(define-key fuel-help-mode-map [(return)] 'fuel-help)
-
-(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))
+;;; Help browser history:
-(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
+(defvar fuel-help--history
+ (list nil
+ (make-ring fuel-help-history-cache-size)
+ (make-ring fuel-help-history-cache-size)))
-(defconst fuel-help--font-lock-keywords
- `(,@fuel-font-lock--font-lock-keywords
- (,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
+(defvar fuel-help--history-idx 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)
+(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))
- (fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
+(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))))
- (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))))
+(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))))
- (setq fuel-autodoc-mode-string "")
- (fuel-autodoc-mode)
- (run-mode-hooks 'fuel-help-mode-hook))
+\f
+;;; 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)))
\f
-;;; Interface: see/help commands
+;;; Interactive help commands:
(defun fuel-help-short (&optional arg)
"See a help summary of symbol at point.
(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)))
+
+\f
+;;;; 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))
+
\f
(provide 'fuel-help)
;;; fuel-help.el ends here
(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)
;;; 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!"))))))
\f
;;; Interface: starting fuel listener
(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)
(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.
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)
(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))))
projects / factor.git / commitdiff