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

FUEL: More robust listener/emacs protocol; small fixes to the help mode.

db4
Jose A. Ortega Ruiz 2008-12-17 00:08:05 +01:00
parent 6c7bd04e14
commit 7172a00f21
6 changed files with 64 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/fuel/fuel.factor
View File

@ -112,7 +112,7 @@ M: source-file fuel-pprint path>> fuel-pprint ;
error get
fuel-eval-result get-global
fuel-eval-output get-global
3array fuel-pprint ;
3array fuel-pprint flush nl "EOT:" write ;
: fuel-forget-error ( -- ) f error set-global ; inline
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline

4
misc/fuel/README
View File

@ -47,8 +47,8 @@ M-x customize-group fuel will show you how many.
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)).
(Triple chords ending in a single letter <x> accept also C-<x> (e.g.
C-cC-eC-r is the same as C-cC-er)).
* In factor source files:

28
misc/fuel/fuel-connection.el
View File

@ -14,8 +14,11 @@
;;; Code:
(require 'fuel-base)
(require 'fuel-log)
(require 'fuel-base)
(require 'comint)
(require 'advice)
;;; Default connection:
@ -123,19 +126,34 @@
;;; Connection setup:
(defun fuel-con--cleanup-connection (c)
(fuel-con--connection-cancel-timer c))
(defun fuel-con--setup-connection (buffer)
(set-buffer buffer)
(fuel-con--cleanup-connection fuel-con--connection)
(let ((conn (fuel-con--make-connection buffer)))
(fuel-con--setup-comint)
(prog1
(setq fuel-con--connection conn)
(fuel-con--connection-start-timer conn))))
(defconst fuel-con--prompt-regex "( .+ ) ")
(defconst fuel-con--eot-marker "EOT:")
(defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker))
(defconst fuel-con--comint-finished-regex
(format "%s%s" fuel-con--eot-marker fuel-con--prompt-regex))
(defun fuel-con--setup-comint ()
(comint-redirect-cleanup)
(add-hook 'comint-redirect-filter-functions
'fuel-con--comint-redirect-filter t t)
(add-hook 'comint-redirect-hook
'fuel-con--comint-redirect-hook))
'fuel-con--comint-redirect-hook nil t))
(defadvice comint-redirect-setup (after fuel-con--advice activate)
(setq comint-redirect-finished-regexp fuel-con--comint-finished-regex))
;;; Requests handling:
@ -169,6 +187,8 @@
(error (fuel-log--error "<%s>: continuation failed %S \n\t%s"
id rstr cerr))))))
(defvar fuel-con--debug-comint-p nil)
(defun fuel-con--comint-redirect-filter (str)
(if (not fuel-con--connection)
(fuel-log--error "No connection in buffer (%s)" str)
@ -176,13 +196,13 @@
(if (not req) (fuel-log--error "No current request (%s)" str)
(fuel-con--request-output req str)
(fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
(fuel--shorten-str str 70))
(if fuel-con--debug-comint-p (fuel--shorten-str str 256) ""))
(defun fuel-con--comint-redirect-hook ()
(if (not fuel-con--connection)
(fuel-log--error "No connection in buffer")
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(if (not req) (fuel-log--error "No current request (%s)" str)
(if (not req) (fuel-log--error "No current request")
(fuel-con--process-completed-request req)
(fuel-con--connection-clean-current-request fuel-con--connection)))))

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

@ -76,7 +76,6 @@
((listp usings) `(:array ,@usings))
(t (error "Invalid 'usings' (%s)" usings))))
;;; Code sending:

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

@ -108,14 +108,15 @@ displayed in the minibuffer."
;;; Help browser history:
(defvar fuel-help--history
(list nil
(make-ring fuel-help-history-cache-size)
(make-ring fuel-help-history-cache-size)))
(list nil ; current
(make-ring fuel-help-history-cache-size) ; previous
(make-ring fuel-help-history-cache-size))) ; next
(defvar fuel-help--history-idx 0)
(defun fuel-help--history-push (term)
(when (car fuel-help--history)
(when (and (car fuel-help--history)
(not (string= (caar fuel-help--history) (car term))))
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
(setcar fuel-help--history term))
@ -135,7 +136,7 @@ displayed in the minibuffer."
;;; Fuel help buffer and internals:
(defun fuel-help--help-buffer ()
(with-current-buffer (get-buffer-create "*fuel-help*")
(with-current-buffer (get-buffer-create "*fuel help*")
(fuel-help-mode)
(current-buffer)))
@ -157,7 +158,7 @@ displayed in the minibuffer."
(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'" ret)
(message "No help for '%s'" def)
(fuel-help--insert-contents def out))))
(defun fuel-help--insert-contents (def str &optional nopush)
@ -167,14 +168,15 @@ displayed in the minibuffer."
(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))
(unless nopush
(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)
(fuel-help--history-push (cons def (buffer-string)))))
(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)))

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

@ -14,9 +14,11 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-base)
(require 'fuel-completion)
(require 'fuel-connection)
(require 'fuel-syntax)
(require 'fuel-base)
(require 'comint)
@ -63,19 +65,21 @@ buffer."
(defun fuel-listener--start-process ()
(let ((factor (expand-file-name fuel-listener-factor-binary))
(image (expand-file-name fuel-listener-factor-image)))
(image (expand-file-name fuel-listener-factor-image))
(comint-redirect-perform-sanity-check nil))
(unless (file-executable-p factor)
(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))
(message "Starting FUEL listener ...")
(comint-exec (fuel-listener--buffer) "factor"
factor nil `("-run=listener" ,(format "-i=%s" image)))
(pop-to-buffer (fuel-listener--buffer))
(goto-char (point-max))
(comint-send-string nil "USE: fuel \"FUEL loaded\\n\" write\n")
(fuel-listener--wait-for-prompt 30)
(message "FUEL listener up and running!")))
(make-comint-in-buffer "fuel listener" (current-buffer) factor nil
"-run=listener" (format "-i=%s" image))
(fuel-listener--wait-for-prompt 10000)
(fuel-con--send-string/wait (current-buffer)
fuel-con--init-stanza
'(lambda (s) (message "FUEL listener up and running!"))
20000)))
(defun fuel-listener--process (&optional start)
(or (and (buffer-live-p (fuel-listener--buffer))
@ -87,21 +91,15 @@ 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)
(goto-char (or comint-last-input-end (point-max)))
(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)))
(goto-char (point-max))
(unless seen (error "No prompt found!")))))
(defun fuel-listener--wait-for-prompt (timeout)
(let ((p (point)) (seen))
(while (and (not seen) (> timeout 0))
(sleep-for 0.1)
(setq timeout (- timeout 100))
(goto-char p)
(setq seen (re-search-forward comint-prompt-regexp nil t)))
(goto-char (point-max))
(unless seen (error "No prompt found!"))))
;;; Completion support
@ -132,12 +130,10 @@ buffer."
;;; Fuel listener mode:
(defconst fuel-listener--prompt-regex ".* ) ")
(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-regexp) fuel-con--prompt-regex)
(set (make-local-variable 'comint-prompt-read-only) t)
(fuel-listener--setup-completion))