Merge branch 'master' of git://factorcode.org/git/factor

basis/bootstrap/stage2.factor

@@ -102,6 +102,8 @@ SYMBOL: bootstrap-time
     ] if
 ] [
     drop
-    load-help? off
+    [
-    "resource:basis/bootstrap/bootstrap-error.factor" run-file
+        load-help? off
+        "resource:basis/bootstrap/bootstrap-error.factor" run-file
+    ] with-scope
 ] recover

basis/core-foundation/core-foundation.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax destructors accessors kernel ;
+USING: alien.syntax destructors accessors kernel calendar ;
 IN: core-foundation
 
 TYPEDEF: void* CFTypeRef
@@ -30,3 +30,10 @@ M: CFRelease-destructor dispose* alien>> CFRelease ;
 
 : |CFRelease ( alien -- alien )
     dup f CFRelease-destructor boa |dispose drop ; inline
+
+: >CFTimeInterval ( duration -- interval )
+    duration>seconds ; inline
+
+: >CFAbsoluteTime ( timestamp -- time )
+    T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
+    duration>seconds ; inline

basis/core-foundation/run-loop/run-loop.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel namespaces core-foundation
+USING: accessors alien alien.syntax kernel math namespaces
-core-foundation.strings core-foundation.file-descriptors
+sequences destructors combinators threads heaps deques calendar
-core-foundation.timers ;
+core-foundation core-foundation.strings
+core-foundation.file-descriptors core-foundation.timers ;
 IN: core-foundation.run-loop
 
 : kCFRunLoopRunFinished 1 ; inline
@@ -59,3 +60,80 @@ FUNCTION: void CFRunLoopRemoveTimer (
         "kCFRunLoopDefaultMode" <CFString>
         dup \ CFRunLoopDefaultMode set-global
     ] when ;
+
+TUPLE: run-loop fds sources timers ;
+
+: <run-loop> ( -- run-loop )
+    V{ } clone V{ } clone V{ } clone \ run-loop boa ;
+
+SYMBOL: expiry-check
+
+: run-loop ( -- run-loop )
+    \ run-loop get-global not expiry-check get expired? or
+    [
+        31337 <alien> expiry-check set-global
+        <run-loop> dup \ run-loop set-global
+    ] [ \ run-loop get-global ] if ;
+
+: add-source-to-run-loop ( source -- )
+    [ run-loop sources>> push ]
+    [
+        CFRunLoopGetMain
+        swap CFRunLoopDefaultMode
+        CFRunLoopAddSource
+    ] bi ;
+
+: create-fd-source ( CFFileDescriptor -- source )
+    f swap 0 CFFileDescriptorCreateRunLoopSource ;
+
+: add-fd-to-run-loop ( fd callback -- )
+    [
+        <CFFileDescriptor> |CFRelease
+        [ run-loop fds>> push ]
+        [ create-fd-source |CFRelease add-source-to-run-loop ]
+        bi
+    ] with-destructors ;
+
+: add-timer-to-run-loop ( timer -- )
+    [ run-loop timers>> push ]
+    [
+        CFRunLoopGetMain
+        swap CFRunLoopDefaultMode
+        CFRunLoopAddTimer
+    ] bi ;
+
+<PRIVATE
+
+: ((reset-timer)) ( timer counter timestamp -- )
+    nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
+
+: (reset-timer) ( timer counter -- )
+    yield {
+        { [ dup 0 = ] [ now ((reset-timer)) ] }
+        { [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
+        { [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
+        [ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
+    } cond ;
+
+: reset-timer ( timer -- )
+    10 (reset-timer) ;
+
+PRIVATE>
+
+: reset-run-loop ( -- )
+    run-loop
+    [ timers>> [ reset-timer ] each ]
+    [ fds>> [ enable-all-callbacks ] each ] bi ;
+
+: timer-callback ( -- callback )
+    "void" { "CFRunLoopTimerRef" "void*" } "cdecl"
+    [ 2drop reset-run-loop yield ] alien-callback ;
+
+: init-thread-timer ( -- )
+    timer-callback <CFTimer> add-timer-to-run-loop ;
+
+: run-one-iteration ( us -- handled? )
+    reset-run-loop
+    CFRunLoopDefaultMode
+    swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
+    t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;

basis/core-foundation/timers/timers.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system math kernel core-foundation ;
+USING: alien.syntax system math kernel core-foundation calendar ;
 IN: core-foundation.timers
 
 TYPEDEF: void* CFRunLoopTimerRef
@@ -18,12 +18,16 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
 ) ;
 
 : <CFTimer> ( callback -- timer )
-    [ f millis 1000 /f 60 0 0 ] dip f CFRunLoopTimerCreate ;
+    [ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
 
 FUNCTION: void CFRunLoopTimerInvalidate (
    CFRunLoopTimerRef timer
 ) ;
 
+FUNCTION: Boolean CFRunLoopTimerIsValid (
+   CFRunLoopTimerRef timer
+) ;
+
 FUNCTION: void CFRunLoopTimerSetNextFireDate (
    CFRunLoopTimerRef timer,
    CFAbsoluteTime fireDate

basis/io/thread/thread.factor

@@ -1,14 +1,20 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: threads io.backend namespaces init math kernel ;
 IN: io.thread
-USING: threads io.backend namespaces init math ;
+
+! The Cocoa UI backend stops the I/O thread and takes over
+! completely.
+SYMBOL: io-thread-running?
 
 : io-thread ( -- )
     sleep-time io-multiplex yield ;
 
 : start-io-thread ( -- )
-    [ io-thread t ]
+    [ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]
-    "I/O wait" spawn-server
+    "I/O wait" spawn drop ;
-    \ io-thread set-global ;
 
-[ start-io-thread ] "io.thread" add-init-hook
+[
+    t io-thread-running? set-global
+    start-io-thread
+] "io.thread" add-init-hook

basis/io/unix/multiplexers/run-loop/run-loop-tests.factor

@@ -1,5 +0,0 @@
-USING: io.unix.multiplexers.run-loop tools.test
-destructors ;
-IN: io.unix.multiplexers.run-loop.tests
-
-[ ] [ <run-loop-mx> dispose ] unit-test

basis/io/unix/multiplexers/run-loop/run-loop.factor

@@ -1,50 +1,27 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces math accessors threads alien locals
+USING: kernel arrays namespaces math accessors alien locals
-destructors combinators io.unix.multiplexers
+destructors system threads io.unix.multiplexers
 io.unix.multiplexers.kqueue core-foundation
-core-foundation.run-loop core-foundation.file-descriptors ;
+core-foundation.run-loop ;
 IN: io.unix.multiplexers.run-loop
 
-TUPLE: run-loop-mx kqueue-mx fd source ;
+TUPLE: run-loop-mx kqueue-mx ;
 
-: kqueue-callback ( -- callback )
+: file-descriptor-callback ( -- callback )
     "void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
     "cdecl" [
         3drop
         0 mx get kqueue-mx>> wait-for-events
-        mx get fd>> enable-all-callbacks
+        reset-run-loop
         yield
-    ]
+    ] alien-callback ;
-    alien-callback ;
-
-SYMBOL: kqueue-run-loop-source
-
-: create-kqueue-source ( fd -- source )
-    f swap 0 CFFileDescriptorCreateRunLoopSource ;
-
-: add-kqueue-to-run-loop ( mx -- )
-    CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopAddSource ;
-
-: remove-kqueue-from-run-loop ( source -- )
-    CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopRemoveSource ;
 
 : <run-loop-mx> ( -- mx )
     [
         <kqueue-mx> |dispose
-        dup fd>> kqueue-callback <CFFileDescriptor> |dispose
+        dup fd>> file-descriptor-callback add-fd-to-run-loop
-        dup create-kqueue-source run-loop-mx boa
+        run-loop-mx boa
-        dup add-kqueue-to-run-loop
-    ] with-destructors ;
-
-M: run-loop-mx dispose
-    [
-        {
-            [ fd>> &dispose drop ]
-            [ source>> &dispose drop ]
-            [ remove-kqueue-from-run-loop ]
-            [ kqueue-mx>> &dispose drop ]
-        } cleave
     ] with-destructors ;
 
 M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ;
@@ -52,7 +29,5 @@ M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ;
 M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ;
 M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ;
 
-M:: run-loop-mx wait-for-events ( us mx -- )
+M: run-loop-mx wait-for-events ( us mx -- )
-    mx fd>> enable-all-callbacks
+    swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ;
-    CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode
-    kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ;

basis/stack-checker/alien/alien.factor

@@ -61,12 +61,6 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     ! Quotation which coerces return value to required type
     return-prep-quot infer-quot-here ;
 
-! Callbacks are registered in a global hashtable. If you clear
-! this hashtable, they will all be blown away by code GC, beware
-SYMBOL: callbacks
-
-[ H{ } clone callbacks set-global ] "alien.compiler" add-init-hook
-
 : register-callback ( word -- ) callbacks get conjoin ;
 
 : callback-bottom ( params -- )

basis/tools/deploy/deploy-tests.factor

@@ -107,3 +107,8 @@ M: quit-responder call-responder*
     "tools.deploy.test.8" shake-and-bake
     run-temp-image
 ] unit-test
+
+[ ] [
+    "tools.deploy.test.9" shake-and-bake
+    run-temp-image
+] unit-test

basis/tools/deploy/test/3/deploy.factor

@@ -1,14 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-threads? t }
+    { deploy-unicode? f }
-    { deploy-c-types? f }
-    { deploy-ui? f }
-    { deploy-word-props? f }
-    { deploy-word-defs? f }
-    { deploy-math? t }
-    { deploy-io 3 }
     { deploy-name "tools.deploy.test.3" }
-    { deploy-compiler? t }
+    { deploy-ui? f }
-    { deploy-reflection 1 }
     { "stop-after-last-window?" t }
+    { deploy-word-defs? f }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-threads? t }
+    { deploy-io 3 }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
 }

basis/tools/deploy/test/9/9.factor

@@ -0,0 +1,10 @@
+USING: alien kernel math ;
+IN: tools.deploy.test.9
+
+: callback-test ( -- callback )
+    "int" { "int" } "cdecl" [ 1 + ] alien-callback ;
+
+: indirect-test ( -- )
+    10 callback-test "int" { "int" } "cdecl" alien-indirect 11 assert= ;
+
+MAIN: indirect-test

basis/tools/deploy/test/9/deploy.factor

@@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-unicode? f }
+    { deploy-name "tools.deploy.test.9" }
+    { deploy-ui? f }
+    { "stop-after-last-window?" t }
+    { deploy-word-defs? f }
+    { deploy-reflection 1 }
+    { deploy-compiler? t }
+    { deploy-threads? f }
+    { deploy-io 1 }
+    { deploy-math? t }
+    { deploy-word-props? f }
+    { deploy-c-types? f }
+}

basis/tools/disassembler/disassembler.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tr arrays sequences io words generic system combinators
-vocabs.loader ;
+vocabs.loader kernel ;
 IN: tools.disassembler
 
 GENERIC: disassemble ( obj -- )
@@ -18,8 +18,7 @@ M: word disassemble word-xt 2array disassemble ;
 
 M: method-spec disassemble first2 method disassemble ;
 
-cpu {
+cpu x86? os unix? and
-    { x86.32 [ "tools.disassembler.udis" ] }
+"tools.disassembler.udis"
-    { x86.64 [ "tools.disassembler.udis" ] }
+"tools.disassembler.gdb" ?
-    { ppc [ "tools.disassembler.gdb" ] }
+require
-} case require

basis/ui/backend/backend.factor

@@ -5,8 +5,6 @@ IN: ui.backend
 
 SYMBOL: ui-backend
 
-HOOK: do-events ui-backend ( -- )
-
 HOOK: set-title ui-backend ( string world -- )
 
 HOOK: set-fullscreen* ui-backend ( ? world -- )

basis/ui/cocoa/cocoa.factor

@@ -3,10 +3,11 @@
 USING: accessors math arrays assocs cocoa cocoa.application
 command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
-cocoa.windows cocoa.classes cocoa.nibs sequences system
+cocoa.windows cocoa.classes cocoa.nibs sequences system ui
-ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
+ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.cocoa.views core-foundation threads math.geometry.rect fry
+ui.cocoa.views core-foundation core-foundation.run-loop threads
-libc generalizations alien.c-types cocoa.views combinators ;
+math.geometry.rect fry libc generalizations alien.c-types
+cocoa.views combinators io.thread ;
 IN: ui.cocoa
 
 TUPLE: handle ;
@@ -18,9 +19,6 @@ C: <offscreen-handle> offscreen-handle
 
 SINGLETON: cocoa-ui-backend
 
-M: cocoa-ui-backend do-events ( -- )
-    [ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
-
 TUPLE: pasteboard handle ;
 
 C: <pasteboard> pasteboard
@@ -134,8 +132,8 @@ CLASS: {
     { +name+ "FactorApplicationDelegate" }
 }
 
-{ "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" }
+{  "applicationDidUpdate:" "void" { "id" "SEL" "id" }
-    [ 3drop event-loop ]
+    [ 3drop reset-run-loop ]
 } ;
 
 : install-app-delegate ( -- )
@@ -153,6 +151,9 @@ M: cocoa-ui-backend ui
             init-clipboard
             cocoa-init-hook get call
             start-ui
+            f io-thread-running? set-global
+            init-thread-timer
+            reset-run-loop
             NSApp -> run
         ] ui-running
     ] with-cocoa ;

basis/ui/event-loop/event-loop.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: ui.backend kernel namespaces sequences deques calendar
+threads ;
+IN: ui.event-loop
+
+: event-loop? ( -- ? )
+    {
+        { [ stop-after-last-window? get not ] [ t ] }
+        { [ graft-queue deque-empty? not ] [ t ] }
+        { [ windows get-global empty? not ] [ t ] }
+        [ f ]
+    } cond ;
+
+HOOK: do-events ui-backend ( -- )
+
+: event-loop ( quot -- ) [ event-loop? ] [ do-events ] [ ] while ;
+
+: ui-wait ( -- ) 10 milliseconds sleep ;

basis/ui/ui-docs.factor

@@ -143,9 +143,7 @@ ARTICLE: "ui-backend-init" "UI initialization and the event loop"
 }
 "The above word must call the following:"
 { $subsection start-ui }
-"The " { $link ui } " word must not return until the event loop has stopped and the UI has been shut down."
+"The " { $link ui } " word must not return until the event loop has stopped and the UI has been shut down." ;
-$nl
-"The event loop must not block, since otherwise other Factor threads and I/O will not run. Instead, it should poll for pending events, then call " { $link ui-wait } "." ;
 
 ARTICLE: "ui-backend-windows" "UI backend window management"
 "The high-level " { $link open-window } " word eventually calls a low-level word which you must implement:"

basis/ui/ui.factor

@@ -12,16 +12,6 @@ SYMBOL: windows
 
 SYMBOL: stop-after-last-window?
 
-: event-loop? ( -- ? )
-    {
-        { [ stop-after-last-window? get not ] [ t ] }
-        { [ graft-queue deque-empty? not ] [ t ] }
-        { [ windows get-global empty? not ] [ t ] }
-        [ f ]
-    } cond ;
-
-: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
-
 : window ( handle -- world ) windows get-global at ;
 
 : window-focus ( handle -- gadget ) window world-focus ;
@@ -155,9 +145,6 @@ SYMBOL: ui-hook
         ] assert-depth
     ] [ ui-error ] recover ;
 
-: ui-wait ( -- )
-    10 milliseconds sleep ;
-
 SYMBOL: ui-thread
 
 : ui-running ( quot -- )

basis/ui/windows/windows.factor

@@ -3,14 +3,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings arrays assocs ui
 ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
-ui.gestures io kernel math math.vectors namespaces make
+ui.gestures ui.event-loop io kernel math math.vectors namespaces
-sequences strings vectors words windows.kernel32 windows.gdi32
+make sequences strings vectors words windows.kernel32
-windows.user32 windows.opengl32 windows.messages windows.types
+windows.gdi32 windows.user32 windows.opengl32 windows.messages
-windows.nt windows threads libc combinators fry
+windows.types windows.nt windows threads libc combinators fry
 combinators.short-circuit continuations command-line shuffle
 opengl ui.render ascii math.bitwise locals symbols accessors
-math.geometry.rect math.order ascii calendar
+math.geometry.rect math.order ascii calendar io.encodings.utf16n
-io.encodings.utf16n ;
+;
 IN: ui.windows
 
 SINGLETON: windows-ui-backend

basis/ui/x11/x11.factor

@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types arrays ui ui.gadgets
 ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
-assocs kernel math namespaces opengl sequences strings x11.xlib
+ui.event-loop assocs kernel math namespaces opengl sequences
-x11.events x11.xim x11.glx x11.clipboard x11.constants
+strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
-x11.windows io.encodings.string io.encodings.ascii
+x11.constants x11.windows io.encodings.string io.encodings.ascii
 io.encodings.utf8 combinators command-line qualified
 math.vectors classes.tuple opengl.gl threads math.geometry.rect
 environment ascii ;

core/alien/alien.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel math namespaces sequences system
-kernel.private byte-arrays arrays ;
+kernel.private byte-arrays arrays init ;
 IN: alien
 
 ! Some predicate classes used by the compiler for optimization
@@ -72,3 +72,9 @@ ERROR: alien-invoke-error library symbol ;
 
 : alien-invoke ( ... return library function parameters -- ... )
     2over alien-invoke-error ;
+
+! Callbacks are registered in a global hashtable. If you clear
+! this hashtable, they will all be blown away by code GC, beware.
+SYMBOL: callbacks
+
+[ H{ } clone callbacks set-global ] "alien" add-init-hook

core/io/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init kernel system namespaces io io.encodings
-io.encodings.utf8 init assocs splitting ;
+io.encodings.utf8 init assocs splitting alien ;
 IN: io.backend
 
 SYMBOL: io-backend
@@ -32,5 +32,7 @@ M: object normalize-directory normalize-path ;
     io-backend set-global init-io init-stdio
     "io.files" init-hooks get at call ;
 
+! Note that we have 'alien' in our using list so that the alien
+! init hook runs before this one.
 [ init-io embedded? [ init-stdio ] unless ]
 "io.backend" add-init-hook

extra/fuel/fuel.factor

@@ -151,7 +151,8 @@ M: source-file fuel-pprint path>> fuel-pprint ;
 : 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
 

extra/iokit/iokit.factor

@@ -1,5 +1,6 @@
-USING: alien.syntax alien.c-types core-foundation system
+USING: alien.syntax alien.c-types core-foundation
-combinators kernel sequences debugger io accessors ;
+core-foundation.bundles system combinators kernel sequences
+debugger io accessors ;
 IN: iokit
 
 <<

misc/fuel/README

@@ -50,7 +50,7 @@ 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)).
 
-* In factor files:
+* In factor source files:
 
  - C-cz : switch to listener
  - C-co : cycle between code, tests and docs factor files
@@ -70,6 +70,13 @@ the same as C-cz)).
 
  - 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
 

misc/fuel/fuel-base.el

@@ -59,5 +59,7 @@
                                 " ")
                      len))
 
+(defsubst empty-string-p (str) (equal str ""))
+
 (provide 'fuel-base)
 ;;; fuel-base.el ends here

misc/fuel/fuel-connection.el

@@ -0,0 +1,186 @@
+;;; 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:
+
+
+;;; 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))))))
+
+
+;;; 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)))
+
+
+;;; 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))
+
+
+;;; 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)))))))
+
+
+;;; 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)))))
+
+
+(provide 'fuel-connection)
+;;; fuel-connection.el ends here

misc/fuel/fuel-debug.el

@@ -214,7 +214,7 @@
              (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)
@@ -224,7 +224,8 @@
       (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))))
 
 

misc/fuel/fuel-eval.el

@@ -1,4 +1,4 @@
-;;; 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.
@@ -9,46 +9,16 @@
 
 ;;; Commentary:
 
-;; Protocols for handling communications via a comint buffer running a
+;; Protocols for sending evaluations to the Factor listener.
-;; factor listener.
 
 ;;; Code:
 
 (require 'fuel-base)
 (require 'fuel-syntax)
+(require 'fuel-connection)
 
 
-;;; Syncronous string sending:
+;;; Retort and retort-error datatypes:
-
-(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))))))
-
-
-;;; Evaluation protocol
 
 (defsubst fuel-eval--retort-make (err result &optional output)
   (list err result output))
@@ -60,57 +30,14 @@
 (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))
+        (let ((ret (car (read-from-string str))))
-      (error (fuel-eval--make-parse-error-retort
+          (if (fuel-eval--retort-p ret) ret (error)))
-              (buffer-substring-no-properties (point) (point-max)))))))
+      (error (fuel-eval--make-parse-error-retort str)))))
-
-(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))))
-
-
-;;; Error parsing
 
 (defsubst fuel-eval--error-name (err) (car err))
 
@@ -137,6 +64,69 @@
 (defsubst fuel-eval--error-line-text (err)
   (nth 3 (fuel-eval--error-lexer-p err)))
 
+
+;;; 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))
+
+
+;;; 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))))
+
+
 
 (provide 'fuel-eval)
 ;;; fuel-eval.el ends here

misc/fuel/fuel-font-lock.el

@@ -57,7 +57,7 @@
     (,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)

misc/fuel/fuel-help.el

@@ -45,6 +45,11 @@
   :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
@@ -70,10 +75,10 @@
   (let ((word (or word (fuel-syntax-symbol-at-point)))
         (fuel-eval--log t))
     (when word
-      (let ((ret (fuel-eval--eval-string/context
+      (let* ((str (format "\\ %s synopsis fuel-eval-set-result" word))
-                  (format "\\ %s synopsis fuel-eval-set-result" word)
+             (cmd (fuel-eval--cmd/string str t t))
-                  t)))
+             (ret (fuel-eval--send/wait cmd 20)))
-        (when (not (fuel-eval--retort-error ret))
+        (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)))))))
@@ -101,92 +106,83 @@ displayed in the minibuffer."
   (message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
 
 
-;;;; Factor help mode:
+;;; Help browser history:
 
-(defvar fuel-help-mode-map (make-sparse-keymap)
+(defvar fuel-help--history
-  "Keymap for Factor help mode.")
+  (list nil
+        (make-ring fuel-help-history-cache-size)
+        (make-ring fuel-help-history-cache-size)))
 
-(define-key fuel-help-mode-map [(return)] 'fuel-help)
+(defvar fuel-help--history-idx 0)
 
-(defconst fuel-help--headlines
+(defun fuel-help--history-push (term)
-  (regexp-opt '("Class description"
+  (when (car fuel-help--history)
-                "Definition"
+    (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
-                "Examples"
+  (setcar fuel-help--history term))
-                "Generic word contract"
-                "Inputs and outputs"
-                "Methods"
-                "Notes"
-                "Parent topics:"
-                "See also"
-                "Syntax"
-                "Vocabulary"
-                "Warning"
-                "Word description")
-              t))
 
-(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
+(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))))
 
-(defconst fuel-help--font-lock-keywords
+(defun fuel-help--history-previous ()
-  `(,@fuel-font-lock--font-lock-keywords
+  (when (not (ring-empty-p (nth 1 fuel-help--history)))
-    (,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
+    (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))))
 
-(defun fuel-help-mode ()
+
-  "Major mode for displaying Factor documentation.
+;;; Fuel help buffer and internals:
-\\{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)
-
-  (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))))
-
-  (setq fuel-autodoc-mode-string "")
-  (fuel-autodoc-mode)
-  (run-mode-hooks 'fuel-help-mode-hook))
 
 (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)
+(defun fuel-help--show-help (&optional see word)
-  (let* ((def (fuel-syntax-symbol-at-point))
+  (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))
+         (def (if ask (read-string prompt nil 'fuel-help--prompt-history def)
-         (cmd (format "\\ %s %s" def (if see "see" "help")))
+                def))
-         (fuel-eval--log nil)
+         (cmd (format "\\ %s %s" def (if see "see" "help"))))
-         (ret (fuel-eval--eval-string/context cmd t))
+    (message "Looking up '%s' ..." def)
-         (out (fuel-eval--retort-output ret)))
+    (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))
+      (fuel-help--insert-contents def out))))
-            (inhibit-read-only t)
+
-            (font-lock-verbose nil))
+(defun fuel-help--insert-contents (def str &optional nopush)
-        (set-buffer hb)
+  (let ((hb (fuel-help--help-buffer))
-        (erase-buffer)
+        (inhibit-read-only t)
-        (insert out)
+        (font-lock-verbose nil))
-        (set-buffer-modified-p nil)
+    (set-buffer hb)
-        (pop-to-buffer hb)
+    (erase-buffer)
-        (goto-char (point-min))))))
+    (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)))
 
 
-;;; Interface: see/help commands
+;;; Interactive help commands:
 
 (defun fuel-help-short (&optional arg)
   "See a help summary of symbol at point.
@@ -204,6 +200,79 @@ buffer."
   (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)))
+
+
+;;;; 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))
+
 
 (provide 'fuel-help)
 ;;; fuel-help.el ends here

misc/fuel/fuel-listener.el

@@ -66,7 +66,7 @@ buffer."
       (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)
@@ -83,18 +83,18 @@ buffer."
 ;;; Prompt chasing
 
 (defun fuel-listener--wait-for-prompt (&optional timeout)
-    (let ((proc (get-buffer-process fuel-listener-buffer))
+  (let ((proc (get-buffer-process fuel-listener-buffer)))
-          (seen))
+    (with-current-buffer fuel-listener-buffer
-      (with-current-buffer fuel-listener-buffer
+      (goto-char (or comint-last-input-end (point-min)))
-        (while (progn (goto-char comint-last-input-end)
+      (let ((seen (re-search-forward comint-prompt-regexp nil t)))
-                      (not (or seen
+        (while (and (not seen)
-                               (setq seen
+                    (accept-process-output proc (or timeout 10) nil t))
-                                     (re-search-forward comint-prompt-regexp nil t))
+          (sleep-for 0 1)
-                               (not (accept-process-output proc timeout))))))
+          (goto-char comint-last-input-end)
-        (goto-char (point-max)))
+          (setq seen (re-search-forward comint-prompt-regexp nil t)))
-      (unless seen
         (pop-to-buffer fuel-listener-buffer)
-        (error "No prompt found!"))))
+        (goto-char (point-max))
+        (unless seen (error "No prompt found!"))))))
 
 
 ;;; Interface: starting fuel listener
@@ -124,6 +124,8 @@ buffer."
   (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)

misc/fuel/fuel-mode.el

@@ -45,16 +45,20 @@ With prefix argument, ask for the file to run."
   (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))
+         (buffer (find-file-noselect file)))
-         (cmd (format "%S fuel-run-file" file)))
     (when buffer
       (with-current-buffer buffer
         (message "Compiling %s ..." file)
-        (let ((r (fuel-debug--display-retort (fuel-eval--eval-string/context cmd)
+        (fuel-eval--send (fuel-eval--cmd/string (format "%S fuel-run-file" file))
-                                             (format "%s successfully compiled" file)
+                         `(lambda (r) (fuel--run-file-cont r ,file)))))))
-                                             nil
+
-                                             file)))
+(defun fuel--run-file-cont (ret file)
-          (if r (message "Compiling %s ... OK!" file) (message "")))))))
+  (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.
@@ -62,7 +66,7 @@ Unless called with a prefix, switchs to the compilation results
 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)
@@ -105,8 +109,9 @@ With prefix, asks for the word to edit."
                                         (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))))