FUEL: More simplifications and small speed-ups in listener/emacs communications.

db4
Jose A. Ortega Ruiz 2008-12-17 21:44:41 +01:00
parent 3da35fe529
commit 416f46db7c
5 changed files with 51 additions and 36 deletions

View File

@ -61,6 +61,11 @@
(defsubst empty-string-p (str) (equal str ""))
(defun fuel--string-prefix-p (prefix str)
(and (>= (length str) (length prefix))
(string= (substring-no-properties 0 (length prefix) str)
(substring-no-properties prefix))))
(defun fuel--respecting-message (format &rest format-args)
"Display TEXT as a message, without hiding any minibuffer contents."
(let ((text (format " [%s]" (apply #'format format format-args))))

View File

@ -32,11 +32,24 @@
(fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
fuel-completion--vocabs)
(defvar fuel-completion--words-last (cons nil nil))
(defsubst fuel-completion--forget-words ()
(setq fuel-completion--words-last (cons nil nil)))
(defun fuel-completion--words (prefix vocabs)
(let ((vs (if vocabs (cons :array vocabs) 'f))
(us (or vocabs 't)))
(fuel-eval--retort-result
(fuel-eval--send/wait `(:fuel* (,prefix ,vs fuel-get-words) t ,us)))))
(if (and (car fuel-completion--words-last)
(cdr fuel-completion--words-last)
(equal (caar fuel-completion--words-last) vs)
(fuel--string-prefix-p (cdar fuel-completion--words-last) prefix))
(cdr fuel-completion--words-last)
(setcar fuel-completion--words-last (cons vocabs prefix))
(setcdr fuel-completion--words-last
(fuel-eval--retort-result
(fuel-eval--send/wait
`(:fuel* (,prefix ,vs fuel-get-words) t ,us)))))))
;;; Completions window handling, heavily inspired in slime's:
@ -159,7 +172,8 @@ terminates a current completion."
(partial (if (eq partial t) prefix partial)))
(cons completions partial)))
(defsubst fuel-completion--read-word (prompt &optional default history all)
(defun fuel-completion--read-word (prompt &optional default history all)
(fuel-completion--forget-words)
(completing-read prompt
(if all fuel-completion--all-words-list-func
fuel-completion--word-list-func)
@ -171,6 +185,7 @@ terminates a current completion."
"Complete the symbol at point.
Perform completion similar to Emacs' complete-symbol."
(interactive)
(fuel-completion--forget-words)
(let* ((end (point))
(beg (fuel-syntax--symbol-start))
(prefix (buffer-substring-no-properties beg end))

View File

@ -143,12 +143,11 @@
(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))
(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)
(set (make-local-variable 'comint-redirect-insert-matching-regexp) t)
(add-hook 'comint-redirect-hook
'fuel-con--comint-redirect-hook nil t))
@ -158,45 +157,45 @@
;;; Requests handling:
(defsubst fuel-con--comint-buffer ()
(get-buffer-create " *fuel connection retort*"))
(defsubst fuel-con--comint-buffer-form ()
(with-current-buffer (fuel-con--comint-buffer)
(goto-char (point-min))
(condition-case nil
(read (current-buffer))
(error (list 'fuel-con-error (buffer-string))))))
(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))))
(str (and req (fuel-con--request-string req)))
(cbuf (with-current-buffer (fuel-con--comint-buffer)
(erase-buffer)
(current-buffer))))
(if (not (buffer-live-p buffer))
(fuel-con--connection-cancel-timer con)
(when (and buffer req str)
(set-buffer buffer)
(fuel-log--info "<%s>: %s" (fuel-con--request-id req) str)
(comint-redirect-send-command (format "%s" str)
(fuel-log--buffer) nil t))))))
(comint-redirect-send-command (format "%s" str) cbuf nil t))))))
(defun fuel-con--process-completed-request (req)
(let ((str (fuel-con--request-output req))
(cont (fuel-con--request-continuation req))
(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)))
(if (not cont)
(fuel-log--warn "<%s> Droping result for request %S (%s)"
id rstr str)
id rstr req)
(condition-case cerr
(with-current-buffer (or buffer (current-buffer))
(funcall cont str)
(fuel-log--info "<%s>: processed\n\t%s" id str))
(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)
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(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)))))
(if fuel-con--debug-comint-p (fuel--shorten-str str 256) ""))
(funcall cont (fuel-con--comint-buffer-form))
(fuel-log--info "<%s>: processed\n\t%s" id req))
(error (fuel-log--error
"<%s>: continuation failed %S \n\t%s" id rstr cerr))))))
(defun fuel-con--comint-redirect-hook ()
(if (not fuel-con--connection)

View File

@ -115,17 +115,15 @@
(defsubst fuel-eval--retort-result (ret) (nth 1 ret))
(defsubst fuel-eval--retort-output (ret) (nth 2 ret))
(defsubst fuel-eval--retort-p (ret) (listp ret))
(defsubst fuel-eval--retort-p (ret)
(and (listp ret) (= 3 (length ret))))
(defsubst fuel-eval--make-parse-error-retort (str)
(fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
(defun fuel-eval--parse-retort (str)
(save-current-buffer
(condition-case nil
(let ((ret (car (read-from-string str))))
(if (fuel-eval--retort-p ret) ret (error)))
(error (fuel-eval--make-parse-error-retort str)))))
(defun fuel-eval--parse-retort (ret)
(if (fuel-eval--retort-p ret) ret
(fuel-eval--make-parse-error-retort ret)))
(defsubst fuel-eval--error-name (err) (car err))

View File

@ -176,8 +176,6 @@ displayed in the minibuffer."
(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)
(pop-to-buffer hb)