From 7172a00f21bfe212aa3ece2a11e1c3447ecfc572 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Wed, 17 Dec 2008 00:08:05 +0100 Subject: [PATCH 1/2] FUEL: More robust listener/emacs protocol; small fixes to the help mode. --- extra/fuel/fuel.factor | 2 +- misc/fuel/README | 4 +-- misc/fuel/fuel-connection.el | 28 ++++++++++++++++++--- misc/fuel/fuel-eval.el | 1 - misc/fuel/fuel-help.el | 28 +++++++++++---------- misc/fuel/fuel-listener.el | 48 +++++++++++++++++------------------- 6 files changed, 64 insertions(+), 47 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index bf36969219..4535ac7fd6 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -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 diff --git a/misc/fuel/README b/misc/fuel/README index 9686124813..79c24ec69f 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -47,8 +47,8 @@ M-x customize-group fuel will show you how many. Quick key reference ------------------- -(Chords ending in a single letter accept also C- (e.g. C-cC-z is -the same as C-cz)). +(Triple chords ending in a single letter accept also C- (e.g. +C-cC-eC-r is the same as C-cC-er)). * In factor source files: diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index af793057ff..da621b3beb 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -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))))) diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index f14e4a922c..ca71012ec5 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -76,7 +76,6 @@ ((listp usings) `(:array ,@usings)) (t (error "Invalid 'usings' (%s)" usings)))) - ;;; Code sending: diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 8170b31a1b..1b9cd9b121 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -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))) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index f2dc760f94..c1e8d670cf 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -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)) From e13adc4db0e9347c3b399fa1470847fb47dfb59b Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Wed, 17 Dec 2008 01:12:15 +0100 Subject: [PATCH 2/2] FUEL: Edit word interactive command; completion in help prompt. --- misc/fuel/README | 3 ++- misc/fuel/fuel-completion.el | 17 +++++++++++++++++ misc/fuel/fuel-help.el | 9 ++++++--- misc/fuel/fuel-mode.el | 34 +++++++++++++++++++++------------- 4 files changed, 46 insertions(+), 17 deletions(-) diff --git a/misc/fuel/README b/misc/fuel/README index 79c24ec69f..cc938a60ff 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -57,7 +57,8 @@ C-cC-eC-r is the same as C-cC-er)). - M-. : edit word at point in Emacs - M-TAB : complete word at point - - C-cC-ev : edit vocabulary + - C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary) + - C-cC-ew : edit word (M-x fuel-edit-word) - C-cr, C-cC-er : eval region - C-M-r, C-cC-ee : eval region, extending it to definition boundaries diff --git a/misc/fuel/fuel-completion.el b/misc/fuel/fuel-completion.el index 6b89dbb008..8d2d779b31 100644 --- a/misc/fuel/fuel-completion.el +++ b/misc/fuel/fuel-completion.el @@ -143,6 +143,15 @@ terminates a current completion." (vs (and cv `("syntax" ,cv ,@(fuel-syntax--usings))))) (fuel-completion--words prefix vs))) +(defsubst fuel-completion--all-words-list (prefix) + (fuel-completion--words prefix nil)) + +(defvar fuel-completion--word-list-func + (completion-table-dynamic 'fuel-completion--word-list)) + +(defvar fuel-completion--all-words-list-func + (completion-table-dynamic 'fuel-completion--all-words-list)) + (defun fuel-completion--complete (prefix) (let* ((words (fuel-completion--word-list prefix)) (completions (all-completions prefix words)) @@ -150,6 +159,14 @@ terminates a current completion." (partial (if (eq partial t) prefix partial))) (cons completions partial))) +(defsubst fuel-completion--read-word (prompt &optional default history all) + (completing-read prompt + (if all fuel-completion--all-words-list-func + fuel-completion--word-list-func) + nil nil nil + history + (or default (fuel-syntax-symbol-at-point)))) + (defun fuel-completion--complete-symbol () "Complete the symbol at point. Perform completion similar to Emacs' complete-symbol." diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 1b9cd9b121..1b0890ef9b 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -14,9 +14,10 @@ ;;; Code: -(require 'fuel-base) -(require 'fuel-font-lock) (require 'fuel-eval) +(require 'fuel-completion) +(require 'fuel-font-lock) +(require 'fuel-base) ;;; Customization: @@ -149,7 +150,9 @@ displayed in the minibuffer." (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--prompt-history def) + (def (if ask (fuel-completion--read-word prompt + def + 'fuel-help--prompt-history) def)) (cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t))) (message "Looking up '%s' ..." def) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 0f8e600165..b931605183 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -114,18 +114,26 @@ buffer in case of errors." "Opens a new window visiting the definition of the word at point. With prefix, asks for the word to edit." (interactive "P") - (let* ((word (fuel-syntax-symbol-at-point)) - (ask (or arg (not word))) - (word (if ask - (read-string nil - (format "Edit word%s: " - (if word (format " (%s)" word) "")) - word) - word))) - (let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location)))) - (condition-case nil - (fuel--try-edit (fuel-eval--send/wait cmd)) - (error (fuel-edit-vocabulary nil word)))))) + (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point)) + (fuel-completion--read-word "Edit word: "))) + (cmd `(:fuel ((:quote ,word) fuel-get-edit-location)))) + (condition-case nil + (fuel--try-edit (fuel-eval--send/wait cmd)) + (error (fuel-edit-vocabulary nil word))))) + +(defvar fuel-mode--word-history nil) + +(defun fuel-edit-word (&optional arg) + "Asks for a word to edit, with completion. +With prefix, only words visible in the current vocabulary are +offered." + (interactive "P") + (let* ((word (fuel-completion--read-word "Edit word: " + nil + fuel-mode--word-history + arg)) + (cmd `(:fuel ((:quote ,word) fuel-get-edit-location)))) + (fuel--try-edit (fuel-eval--send/wait cmd)))) (defvar fuel--vocabs-prompt-history nil) @@ -195,7 +203,7 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?e ?e 'fuel-eval-extended-region) (fuel-mode--key ?e ?r 'fuel-eval-region) (fuel-mode--key ?e ?v 'fuel-edit-vocabulary) -(fuel-mode--key ?e ?w 'fuel-edit-word-at-point) +(fuel-mode--key ?e ?w 'fuel-edit-word) (fuel-mode--key ?e ?x 'fuel-eval-definition) (fuel-mode--key ?d ?a 'fuel-autodoc-mode)