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

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

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 <x> accept also C-<x> (e.g. C-cC-z is
+(Triple chords ending in a single letter <x> accept also C-<x> (e.g.
-the same as C-cz)).
+C-cC-eC-r is the same as C-cC-er)).
 
 * In factor source files:
 
@@ -57,7 +57,8 @@ the same as C-cz)).
 
  - 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

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."

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)))))
 

misc/fuel/fuel-eval.el

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

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:
@@ -108,14 +109,15 @@ displayed in the minibuffer."
 ;;; Help browser history:
 
 (defvar fuel-help--history
-  (list nil
+  (list nil                                        ; current
-        (make-ring fuel-help-history-cache-size)
+        (make-ring fuel-help-history-cache-size)   ; previous
-        (make-ring fuel-help-history-cache-size)))
+        (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 +137,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)))
 
@@ -148,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)
@@ -157,7 +161,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 +171,15 @@ displayed in the minibuffer."
     (set-buffer hb)
     (erase-buffer)
     (insert str)
-    (goto-char (point-min))
+    (unless nopush
-    (when (re-search-forward (format "^%s" def) nil t)
+      (goto-char (point-min))
-      (beginning-of-line)
+      (when (re-search-forward (format "^%s" def) nil t)
-      (kill-region (point-min) (point))
+        (beginning-of-line)
-      (next-line)
+        (kill-region (point-min) (point))
-      (open-line 1))
+        (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)))

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))
+    (make-comint-in-buffer "fuel listener" (current-buffer) factor nil
-    (comint-send-string nil "USE: fuel \"FUEL loaded\\n\" write\n")
+                           "-run=listener" (format "-i=%s" image))
-    (fuel-listener--wait-for-prompt 30)
+    (fuel-listener--wait-for-prompt 10000)
-    (message "FUEL listener up and running!")))
+    (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)
 
-
+(defun fuel-listener--wait-for-prompt (timeout)
-;;; Prompt chasing
+  (let ((p (point)) (seen))
-
+    (while (and (not seen) (> timeout 0))
-(defun fuel-listener--wait-for-prompt (&optional timeout)
+      (sleep-for 0.1)
-  (let ((proc (get-buffer-process (fuel-listener--buffer)))
+      (setq timeout (- timeout 100))
-        (seen))
+      (goto-char p)
-    (with-current-buffer (fuel-listener--buffer)
+      (setq seen (re-search-forward comint-prompt-regexp nil t)))
-      (goto-char (or comint-last-input-end (point-max)))
+    (goto-char (point-max))
-      (while (and (not seen)
+    (unless seen (error "No prompt found!"))))
-                  (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!")))))
 
 
 ;;; 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))
 

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))
+  (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
-         (ask (or arg (not word)))
+                  (fuel-completion--read-word "Edit word: ")))
-         (word (if ask
+         (cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
-                   (read-string nil
+    (condition-case nil
-                                (format "Edit word%s: "
+        (fuel--try-edit (fuel-eval--send/wait cmd))
-                                        (if word (format " (%s)" word) ""))
+      (error (fuel-edit-vocabulary nil word)))))
-                                word)
+
-                 word)))
+(defvar fuel-mode--word-history nil)
-    (let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
+
-      (condition-case nil
+(defun fuel-edit-word (&optional arg)
-          (fuel--try-edit (fuel-eval--send/wait cmd))
+  "Asks for a word to edit, with completion.
-        (error (fuel-edit-vocabulary nil word))))))
+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)