Merge commit 'origin/master'

basis/formatting/formatting-tests.factor

@@ -85,13 +85,13 @@ IN: formatting.tests
 
 [ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test
 [ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test
-
 [ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test
 [ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test
-
+[ t ] [ "10/09/08" testtime "%m/%d/%y" strftime = ] unit-test
 [ t ] [ "Thu" testtime "%a" strftime = ] unit-test
 [ t ] [ "Thursday" testtime "%A" strftime = ] unit-test
-
 [ t ] [ "Oct" testtime "%b" strftime = ] unit-test
 [ t ] [ "October" testtime "%B" strftime = ] unit-test
+[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
+[ t ] [ "PM" testtime "%p" strftime = ] unit-test
 

basis/formatting/formatting.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license
 
 USING: accessors arrays ascii calendar combinators fry kernel 
-io io.encodings.ascii io.files io.streams.string
+generalizations io io.encodings.ascii io.files io.streams.string
 macros math math.functions math.parser peg.ebnf quotations
 sequences splitting strings unicode.case vectors ;
 
@@ -32,10 +32,7 @@ IN: formatting
     [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
 
 : max-digits ( n digits -- n' )
-    10 swap ^ [ * round ] keep / ;
+    10 swap ^ [ * round ] keep / ; inline
-
-: max-width ( string length -- string' ) 
-    short head ;
 
 : >exp ( x -- exp base )
     [ 
@@ -69,7 +66,7 @@ pad       = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 =
 
 sign      = ("+")?               => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]]
 
-width_    = "." ([0-9])*         => [[ second >digits '[ _ max-width ] ]]
+width_    = "." ([0-9])*         => [[ second >digits '[ _ short head ] ]]
 width     = (width_)?            => [[ [ ] or ]] 
 
 digits_   = "." ([0-9])*         => [[ second >digits ]]
@@ -113,23 +110,25 @@ MACRO: printf ( format-string -- )
 
 <PRIVATE
 
-: zero-pad ( str -- str' ) 2 CHAR: 0 pad-left ; inline
+: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-left ; inline
+
+: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline
 
 : >time ( timestamp -- string )
     [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array
-    [ number>string zero-pad ] map ":" join ; inline
+    [ pad-00 ] map ":" join ; inline
 
 : >date ( timestamp -- string )
     [ month>> ] [ day>> ] [ year>> ] tri 3array
-    [ number>string zero-pad ] map "/" join ; inline
+    [ pad-00 ] map "/" join ; inline
 
 : >datetime ( timestamp -- string )
     { [ day-of-week day-abbreviation3 ]
       [ month>> month-abbreviation ]
-      [ day>> number>string zero-pad ]
+      [ day>> pad-00 ]
       [ >time ]
       [ year>> number>string ]
-    } cleave 3array [ 2array ] dip append " " join ; inline
+    } cleave 5 narray " " join ; inline
 
 : (week-of-year) ( timestamp day -- n )
     [ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when
@@ -147,20 +146,20 @@ fmt-A     = "A"                  => [[ [ dup day-of-week day-name ] ]]
 fmt-b     = "b"                  => [[ [ dup month>> month-abbreviation ] ]]
 fmt-B     = "B"                  => [[ [ dup month>> month-name ] ]]
 fmt-c     = "c"                  => [[ [ dup >datetime ] ]]
-fmt-d     = "d"                  => [[ [ dup day>> number>string zero-pad ] ]]
+fmt-d     = "d"                  => [[ [ dup day>> pad-00 ] ]]
-fmt-H     = "H"                  => [[ [ dup hour>> number>string zero-pad ] ]]
+fmt-H     = "H"                  => [[ [ dup hour>> pad-00 ] ]]
-fmt-I     = "I"                  => [[ [ dup hour>> dup 12 > [ 12 - ] when number>string zero-pad ] ]]
+fmt-I     = "I"                  => [[ [ dup hour>> dup 12 > [ 12 - ] when pad-00 ] ]]
-fmt-j     = "j"                  => [[ [ dup day-of-year number>string ] ]]
+fmt-j     = "j"                  => [[ [ dup day-of-year pad-000 ] ]]
-fmt-m     = "m"                  => [[ [ dup month>> number>string zero-pad ] ]]
+fmt-m     = "m"                  => [[ [ dup month>> pad-00 ] ]]
-fmt-M     = "M"                  => [[ [ dup minute>> number>string zero-pad ] ]]
+fmt-M     = "M"                  => [[ [ dup minute>> pad-00 ] ]]
 fmt-p     = "p"                  => [[ [ dup hour>> 12 < "AM" "PM" ? ] ]]
-fmt-S     = "S"                  => [[ [ dup second>> round number>string zero-pad ] ]]
+fmt-S     = "S"                  => [[ [ dup second>> floor pad-00 ] ]]
-fmt-U     = "U"                  => [[ [ dup week-of-year-sunday ] ]]
+fmt-U     = "U"                  => [[ [ dup week-of-year-sunday pad-00 ] ]]
 fmt-w     = "w"                  => [[ [ dup day-of-week number>string ] ]]
-fmt-W     = "W"                  => [[ [ dup week-of-year-monday ] ]]
+fmt-W     = "W"                  => [[ [ dup week-of-year-monday pad-00 ] ]]
 fmt-x     = "x"                  => [[ [ dup >date ] ]]
 fmt-X     = "X"                  => [[ [ dup >time ] ]]
-fmt-y     = "y"                  => [[ [ dup year>> 100 mod number>string ] ]]
+fmt-y     = "y"                  => [[ [ dup year>> 100 mod pad-00 ] ]]
 fmt-Y     = "Y"                  => [[ [ dup year>> number>string ] ]]
 fmt-Z     = "Z"                  => [[ [ "Not yet implemented" throw ] ]]
 unknown   = (.)*                 => [[ "Unknown directive" throw ]]

basis/io/files/links/unix/unix-tests.factor

@@ -1,7 +1,7 @@
 USING: io.directories io.files.links tools.test sequences
 io.files.unique tools.files fry math kernel math.parser
 io.pathnames namespaces ;
-IN: io.files.links.tests
+IN: io.files.links.unix.tests
 
 : make-test-links ( n path -- )
     [ '[ [ 1+ ] keep [ number>string _ prepend ] bi@ make-link ] each ]

basis/logging/parser/parser-docs.factor

@@ -13,7 +13,7 @@ HELP: parse-log
 } ;
 
 ARTICLE: "logging.parser" "Log file parser"
-"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $link "logging.insomniac" } " to analyze logs."
+"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $vocab-link "logging.insomniac" } " to analyze logs."
 $nl
 "There is only one primary entry point:"
 { $subsection parse-log } ;

basis/tools/profiler/profiler-docs.factor

@@ -2,14 +2,18 @@ USING: tools.profiler.private tools.time help.markup help.syntax
 quotations io strings words definitions ;
 IN: tools.profiler
 
-ARTICLE: "profiling" "Profiling code" 
+ARTICLE: "profiler-limitations" "Profiler limitations"
-"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler. The profiler is completely accurate with words and methods which are compiled with the non-optimizing compiler. Some optimizations performed by the optimizing compiler can inhibit accurate call counting, however:"
+"Certain optimizations performed by the compiler can inhibit accurate call counting:"
 { $list
-    "The optimizing compiler open-codes certain primitives with inline machine code, and in some cases optimizes them out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations."
+    "Calls to open-coded intrinsics are not counted. Certain words are open-coded as inline machine code, and in some cases optimized out altogether; this includes stack shuffling operations, conditionals, and many object allocation operations."
-    { "Calls to " { $link POSTPONE: inline } " words are not counted.." }
+    { "Calls to " { $link POSTPONE: inline } " words are not counted." }
     { "Calls to methods which were inlined as a result of type inference are not counted." }
     "Tail-recursive loops will only count the initial invocation of the word, not every tail call."
-}
+} ;
+
+ARTICLE: "profiling" "Profiling code" 
+"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler."
+$nl
 "Quotations can be passed to a combinator which calls them with the profiler enabled:"
 { $subsection profile }
 "After a quotation has been profiled, call counts can be presented in various ways:"
@@ -17,7 +21,9 @@ ARTICLE: "profiling" "Profiling code"
 { $subsection vocab-profile. }
 { $subsection usage-profile. }
 { $subsection vocabs-profile. }
-{ $subsection method-profile. } ;
+{ $subsection method-profile. }
+{ $subsection "profiler-limitations" }
+{ $see-also "ui-profiler" } ;
 
 ABOUT: "profiling"
 

basis/uuid/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

basis/uuid/summary.txt

@@ -0,0 +1 @@
+Generates UUID's.

basis/uuid/uuid-docs.factor

@@ -0,0 +1,45 @@
+
+USING: help.syntax help.markup kernel prettyprint sequences strings ;
+
+IN: uuid
+
+HELP: uuid1
+{ $description 
+    "Generates a UUID (version 1) from the host ID, sequence number, "
+    "and current time."
+} ;
+
+HELP: uuid3
+{ $description 
+    "Generates a UUID (version 3) from the MD5 hash of a namespace "
+    "UUID and a name."
+} ;
+
+HELP: uuid4
+{ $description 
+    "Generates a UUID (version 4) from random bits." 
+} ;
+
+HELP: uuid5
+{ $description 
+    "Generates a UUID (version 5) from the SHA-1 hash of a namespace " 
+    "UUID and a name."
+} ;
+
+
+ARTICLE: "uuid" "UUID (Universally Unique Identifier)"
+"The " { $vocab-link "uuid" } " vocabulary is used to generate UUID's. "
+"The words uuid1, uuid3, uuid4, uuid5 can be used to generate version "
+"1, 3, 4, and 5 UUIDs as specified in RFC 4122.\n"
+"\n" 
+"If all you want is a unique ID, you should probably call uuid1 or uuid4."
+"\n"
+{ $subsection uuid1 }
+{ $subsection uuid3 }
+{ $subsection uuid4 }
+{ $subsection uuid5 }
+;
+
+ABOUT: "uuid"
+
+

basis/uuid/uuid-tests.factor

@@ -0,0 +1,18 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel uuid tools.test ;
+
+IN: uuid.tests
+
+[ t ] [ NAMESPACE_DNS  [ uuid-parse uuid-unparse ] keep = ] unit-test
+[ t ] [ NAMESPACE_URL  [ uuid-parse uuid-unparse ] keep = ] unit-test
+[ t ] [ NAMESPACE_OID  [ uuid-parse uuid-unparse ] keep = ] unit-test
+[ t ] [ NAMESPACE_X500 [ uuid-parse uuid-unparse ] keep = ] unit-test
+
+[ t ] [ NAMESPACE_URL "ABCD" uuid3 
+        "2e10e403-d7fa-3ffb-808f-ab834a46890e" = ] unit-test
+
+[ t ] [ NAMESPACE_URL "ABCD" uuid5 
+        "0aa883d6-7953-57e7-a8f0-66db29ce5a91" = ] unit-test
+

basis/uuid/uuid.factor

@@ -0,0 +1,94 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: byte-arrays checksums checksums.md5 checksums.sha1 
+kernel math math.parser math.ranges random unicode.case 
+sequences strings system ;
+
+IN: uuid 
+
+<PRIVATE
+
+: (timestamp) ( -- time_high time_mid time_low ) 
+    ! 0x01b21dd213814000L is the number of 100-ns intervals
+    ! between the UUID epoch 1582-10-15 00:00:00 and the 
+    ! Unix epoch 1970-01-01 00:00:00.
+    micros 10 * HEX: 01b21dd213814000 +
+    [ -48 shift HEX: 0fff bitand ] 
+    [ -32 shift HEX: ffff bitand ]
+    [ HEX: ffffffff bitand ] tri ;
+
+: (hardware) ( -- address ) 
+    ! Choose a random 48-bit number with eighth bit 
+    ! set to 1 (as recommended in RFC 4122)
+    48 random-bits HEX: 010000000000 bitor ;
+
+: (clock) ( -- clockseq ) 
+    ! Choose a random 14-bit number
+    14 random-bits ;
+
+: <uuid> ( address clockseq time_high time_mid time_low -- n )
+    96 shift 
+    [ 80 shift ] dip bitor 
+    [ 64 shift ] dip bitor
+    [ 48 shift ] dip bitor
+    bitor ;
+
+: (version) ( n version -- n' )
+    [ HEX: c000 48 shift bitnot bitand 
+      HEX: 8000 48 shift bitor 
+      HEX: f000 64 shift bitnot bitand
+    ] dip 76 shift bitor ;
+
+: uuid>string ( n -- string )
+    >hex 32 CHAR: 0 pad-left 
+    [ CHAR: - 20 ] dip insert-nth
+    [ CHAR: - 16 ] dip insert-nth 
+    [ CHAR: - 12 ] dip insert-nth 
+    [ CHAR: - 8 ] dip insert-nth ;
+ 
+: string>uuid ( string -- n )
+    [ CHAR: - = not ] filter 16 base> ;
+
+: uuid>byte-array ( n -- byte-array ) 
+    16 <byte-array> 15 -1 [a,b) [ 
+        [ dup HEX: ff bitand ] 2dip swap
+        [ set-nth -8 shift ] keep 
+    ] each nip ;
+
+: byte-array>uuid ( byte-array -- n )
+     0 swap [ [ 8 shift ] dip + ] each ;
+
+PRIVATE>
+
+: uuid-parse ( string -- byte-array ) 
+    string>uuid uuid>byte-array ;
+
+: uuid-unparse ( byte-array -- string ) 
+    byte-array>uuid uuid>string ;
+
+: uuid1 ( -- string )
+    (hardware) (clock) (timestamp) <uuid> 
+    1 (version) uuid>string ;
+
+: uuid3 ( namespace name -- string )
+    [ uuid-parse ] dip >byte-array append 
+    md5 checksum-bytes 16 short head byte-array>uuid 
+    3 (version) uuid>string ;
+
+: uuid4 ( -- string )
+    128 random-bits 
+    4 (version) uuid>string ;
+
+: uuid5 ( namespace name -- string )
+   [ uuid-parse ] dip >byte-array append 
+    sha1 checksum-bytes 16 short head byte-array>uuid 
+    5 (version) uuid>string ;
+
+
+: NAMESPACE_DNS  "6ba7b810-9dad-11d1-80b4-00c04fd430c8" ; inline
+: NAMESPACE_URL  "6ba7b811-9dad-11d1-80b4-00c04fd430c8" ; inline
+: NAMESPACE_OID  "6ba7b812-9dad-11d1-80b4-00c04fd430c8" ; inline
+: NAMESPACE_X500 "6ba7b814-9dad-11d1-80b4-00c04fd430c8" ; inline
+
+

core/compiler/errors/errors-docs.factor

@@ -3,18 +3,20 @@ USING: help.markup help.syntax vocabs.loader words io
 quotations words.symbol ;
 
 ARTICLE: "compiler-errors" "Compiler warnings and errors"
-"The compiler saves various notifications in a global variable:"
+"The compiler saves " { $link "inference-errors" } " in a global variable:"
 { $subsection compiler-errors }
 "These notifications can be viewed later:"
 { $subsection :errors }
 { $subsection :warnings }
 { $subsection :linkage }
 "Words such as " { $link require } " use a combinator which counts errors and prints a report at the end:"
-{ $link with-compiler-errors } ;
+{ $subsection with-compiler-errors } ;
 
 HELP: compiler-errors
 { $var-description "Global variable holding an assoc mapping words to compiler errors. This variable is set by " { $link with-compiler-errors } "." } ;
 
+ABOUT: "compiler-errors"
+
 HELP: compiler-error
 { $values { "error" "an error" } { "word" word } }
 { $description "If inside a " { $link with-compiler-errors } ", saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } ". If not inside a " { $link with-compiler-errors } ", ignores the error." } ;

core/kernel/kernel-tests.factor

@@ -1,7 +1,7 @@
 USING: arrays byte-arrays kernel kernel.private math memory
 namespaces sequences tools.test math.private quotations
 continuations prettyprint io.streams.string debugger assocs
-sequences.private accessors ;
+sequences.private accessors locals.backend ;
 IN: kernel.tests
 
 [ 0 ] [ f size ] unit-test
@@ -35,7 +35,7 @@ IN: kernel.tests
 
 [ ] [ [ :c ] with-string-writer drop ] unit-test
 
-: overflow-r 3 [ overflow-r ] dip ;
+: overflow-r 3 load-local overflow-r ;
 
 [ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with
 

extra/fuel/fuel.factor

@@ -122,8 +122,8 @@ M: source-file fuel-pprint path>> fuel-pprint ;
     fuel-forget-result
     fuel-forget-output ;
 
-: (fuel-end-eval) ( quot -- )
+: (fuel-end-eval) ( result -- )
-    with-string-writer fuel-eval-output set-global fuel-retort
+    fuel-eval-output set-global fuel-retort
     pop-fuel-status ; inline
 
 : (fuel-eval) ( lines -- )
@@ -141,39 +141,29 @@ M: source-file fuel-pprint path>> fuel-pprint ;
     [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
 
 : fuel-eval-in-context ( lines in usings -- )
-    (fuel-begin-eval) [
-        (fuel-eval-usings)
-        (fuel-eval-in)
-        (fuel-eval)
-    ] (fuel-end-eval) ;
-
-: fuel-begin-eval ( in -- )
     (fuel-begin-eval)
-    (fuel-eval-in)
+    [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
-    fuel-retort ;
+    (fuel-end-eval) ;
-
-: fuel-eval ( lines -- )
-    (fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
-
-: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
 
 : fuel-run-file ( path -- ) run-file ; inline
 
 ! Edit locations
 
-: fuel-get-edit-location ( defspec -- )
+: fuel-normalize-loc ( seq -- path line )
-    where [
+    dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
-       first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
-    ] when* ; inline
 
-: fuel-xref-desc ( word -- str )
+: fuel-get-edit-location ( defspec -- )
-    [ name>> ]
+    where fuel-normalize-loc 2array fuel-eval-set-result ; inline
-    [ vocabulary>> [ " (" prepend ")" append ] [ "" ] if* ] bi append ; inline
+
+: fuel-get-doc-location ( defspec -- )
+    props>> "help-loc" swap at
+    fuel-normalize-loc 2array fuel-eval-set-result ;
 
 : fuel-format-xrefs ( seq -- seq )
     [ word? ] filter [
-        [ fuel-xref-desc ]
+        [ name>> ]
-        [ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] bi 3array
+        [ vocabulary>> ]
+        [ where fuel-normalize-loc ] tri 4array
     ] map [ [ first ] dip first <=> ] sort ; inline
 
 : fuel-callers-xref ( word -- )

extra/google-tech-talk/google-tech-talk.factor

@@ -203,7 +203,7 @@ IN: google-tech-talk
         { $code "13 <circle> tell-me" }
         { $code "103 76 <rectangle> tell-me" }
         { $code "101 tell-me" }
-        { { $link integer } ", " { $link array } ", and others area built-in classes" }
+        { { $link integer } ", " { $link array } ", and others are built-in classes" }
     }
     { $slide "Object system"
         "Anyone can define new shapes..."

misc/fuel/README

@@ -58,7 +58,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 (M-x fuel-edit-vocabulary)
- - C-cC-ew : edit word (M-x fuel-edit-word)
+ - C-cC-ew : edit word (M-x fuel-edit-word-at-point)
+ - C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point)
 
  - C-cr, C-cC-er : eval region
  - C-M-r, C-cC-ee : eval region, extending it to definition boundaries
@@ -78,6 +79,7 @@ C-cC-eC-r is the same as C-cC-er)).
  - TAB : complete word at point
  - M-. : edit word at point in Emacs
  - C-ca : toggle autodoc mode
+ - C-cs : toggle stack mode
  - C-cv : edit vocabulary
  - C-ch : help for word at point
  - C-ck : run file
@@ -96,5 +98,10 @@ C-cC-eC-r is the same as C-cC-er)).
  - SPC/S-SPC : scroll up/down
  - TAB/S-TAB : next/previous headline
  - C-cz : switch to listener
- - q: bury buffer
+ - q : bury buffer
 
+* In crossref buffers
+
+ - TAB/BACKTAB : navigate links
+ - RET/mouse click : follow link
+ - q : bury buffer

misc/fuel/factor-mode.el

@@ -24,8 +24,9 @@
 ;;; Customization:
 
 (defgroup factor-mode nil
-  "Major mode for Factor source code"
+  "Major mode for Factor source code."
-  :group 'fuel)
+  :group 'fuel
+  :group 'languages)
 
 (defcustom factor-mode-use-fuel t
   "Whether to use the full FUEL facilities in factor mode.

misc/fuel/fuel-autodoc.el

@@ -22,7 +22,7 @@
 ;;; Customization:
 
 (defgroup fuel-autodoc nil
-  "Options controlling FUEL's autodoc system"
+  "Options controlling FUEL's autodoc system."
   :group 'fuel)
 
 (defcustom fuel-autodoc-minibuffer-font-lock t

misc/fuel/fuel-base.el

@@ -25,8 +25,8 @@
 
 ;;;###autoload
 (defgroup fuel nil
-  "Factor's Ultimate Emacs Library"
+  "Factor's Ultimate Emacs Library."
-  :group 'language)
+  :group 'languages)
 
 
 ;;; Emacs compatibility:
@@ -74,12 +74,14 @@
                      len))
 
 (defsubst fuel--region-to-string (begin &optional end)
+  (let ((end (or end (point))))
+    (if (< begin end)
         (mapconcat 'identity
-             (split-string (buffer-substring-no-properties begin
+                   (split-string (buffer-substring-no-properties begin end)
-                                                           (or end (point)))
                                  nil
                                  t)
-             " "))
+                   " ")
+      "")))
 
 (defsubst empty-string-p (str) (equal str ""))
 

misc/fuel/fuel-connection.el

@@ -134,7 +134,7 @@
 
 (defconst fuel-con--prompt-regex "( .+ ) ")
 (defconst fuel-con--eot-marker "<~FUEL~>")
-(defconst fuel-con--init-stanza "USE: fuel f fuel-eval")
+(defconst fuel-con--init-stanza "USE: fuel fuel-retort")
 
 (defconst fuel-con--comint-finished-regex
   (format "^%s$" fuel-con--eot-marker))

misc/fuel/fuel-debug.el

@@ -14,29 +14,30 @@
 
 ;;; Code:
 
-(require 'fuel-base)
 (require 'fuel-eval)
+(require 'fuel-popup)
 (require 'fuel-font-lock)
+(require 'fuel-base)
 
 
 ;;; Customization:
 
 (defgroup fuel-debug nil
-  "Major mode for interaction with the Factor debugger"
+  "Major mode for interaction with the Factor debugger."
   :group 'fuel)
 
 (defcustom fuel-debug-mode-hook nil
-  "Hook run after `fuel-debug-mode' activates"
+  "Hook run after `fuel-debug-mode' activates."
   :group 'fuel-debug
   :type 'hook)
 
 (defcustom fuel-debug-show-short-help t
-  "Whether to show short help on available keys in debugger"
+  "Whether to show short help on available keys in debugger."
   :group 'fuel-debug
   :type 'boolean)
 
 (fuel-font-lock--define-faces
- fuel-debug-font-lock font-lock fuel-debug
+ fuel-font-lock-debug font-lock fuel-debug
  ((error warning "highlighting errors")
   (line variable-name "line numbers in errors/warnings")
   (column variable-name "column numbers in errors/warnings")
@@ -66,14 +67,14 @@
 (defconst fuel-debug--restart-regex "^:\\([0-9]+\\) \\(.+\\)")
 
 (defconst fuel-debug--font-lock-keywords
-  `((,fuel-debug--error-file-regex . 'fuel-debug-font-lock-error)
+  `((,fuel-debug--error-file-regex . 'fuel-font-lock-debug-error)
-    (,fuel-debug--error-line-regex 1 'fuel-debug-font-lock-line)
+    (,fuel-debug--error-line-regex 1 'fuel-font-lock-debug-line)
-    (,fuel-debug--error-cont-regex 1 'fuel-debug-font-lock-column)
+    (,fuel-debug--error-cont-regex 1 'fuel-font-lock-debug-column)
-    (,fuel-debug--restart-regex (1 'fuel-debug-font-lock-restart-number)
+    (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
-                                (2 'fuel-debug-font-lock-restart-name))
+                                (2 'fuel-font-lock-debug-restart-name))
-    (,fuel-debug--compiler-info-regex 1 'fuel-debug-font-lock-restart-number)
+    (,fuel-debug--compiler-info-regex 1 'fuel-font-lock-debug-restart-number)
-    ("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-debug-font-lock-info)
+    ("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-font-lock-debug-info)
-    ("^Error: " . 'fuel-debug-font-lock-error)))
+    ("^Error: " . 'fuel-font-lock-debug-error)))
 
 (defun fuel-debug--font-lock-setup ()
   (set (make-local-variable 'font-lock-defaults)
@@ -82,7 +83,8 @@
 
 ;;; Debug buffer:
 
-(defvar fuel-debug--buffer nil)
+(fuel-popup--define fuel-debug--buffer
+  "*fuel debug*" 'fuel-debug-mode)
 
 (make-variable-buffer-local
  (defvar fuel-debug--last-ret nil))
@@ -90,13 +92,6 @@
 (make-variable-buffer-local
  (defvar fuel-debug--file nil))
 
-(defun fuel-debug--buffer ()
-  (or (and (buffer-live-p fuel-debug--buffer) fuel-debug--buffer)
-      (with-current-buffer
-          (setq fuel-debug--buffer (get-buffer-create "*fuel dbg*"))
-        (fuel-debug-mode)
-        (current-buffer))))
-
 (defun fuel-debug--display-retort (ret &optional success-msg no-pop file)
   (let ((err (fuel-eval--retort-error ret))
         (inhibit-read-only t))
@@ -111,16 +106,16 @@
       (when err
         (fuel-debug--display-restarts err)
         (delete-blank-lines)
-        (newline)
+        (newline))
       (let ((hstr (fuel-debug--help-string err file)))
         (if fuel-debug-show-short-help
             (insert "-----------\n" hstr "\n")
-            (message "%s" hstr))))
+          (message "%s" hstr)))
       (setq fuel-debug--last-ret ret)
       (setq fuel-debug--file file)
       (goto-char (point-max))
       (font-lock-fontify-buffer)
-      (when (and err (not no-pop)) (pop-to-buffer fuel-debug--buffer))
+      (when (and err (not no-pop)) (fuel-popup--display))
       (not err))))
 
 (defun fuel-debug--display-output (ret)
@@ -179,16 +174,16 @@
 
 (defun fuel-debug-goto-error ()
   (interactive)
-  (let* ((err (or (fuel-debug--buffer-error)
+  (let* ((err (fuel-debug--buffer-error))
-                  (error "No errors reported")))
          (file (or (fuel-debug--buffer-file)
-                   (error "No file associated with error")))
+                   (error "No file associated with compilation")))
-         (l/c (fuel-eval--error-line/column err))
+         (l/c (and err (fuel-eval--error-line/column err)))
          (line (or (car l/c) 1))
          (col (or (cdr l/c) 0)))
     (find-file-other-window file)
+    (when line
       (goto-line line)
-    (forward-char col)))
+      (when col (forward-char col)))))
 
 (defun fuel-debug--read-restart-no ()
   (let ((rs (fuel-debug--buffer-restarts)))
@@ -224,9 +219,11 @@
     (unless (re-search-forward (format "^%s" info) nil t)
       (error "%s information not available" info))
     (message "Retrieving %s info ..." info)
-    (unless (fuel-debug--display-retort
+    (unless (fuel-debug--display-retort (fuel-eval--send/wait
-             (fuel-eval--send/wait `(:fuel ((:factor ,info))))
+                                         `(:fuel ((:factor ,info))))
-             "" (fuel-debug--buffer-file))
+                                        ""
+                                        nil
+                                        (fuel-debug--buffer-file))
       (error "Sorry, no %s info available" info))))
 
 

misc/fuel/fuel-font-lock.el

@@ -21,13 +21,24 @@
 
 ;;; Faces:
 
-(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
+(defgroup fuel-faces nil
-  (let ((face (intern (format "%s-%s" prefix face)))
+  "Faces used by FUEL."
-        (def (intern (format "%s-%s-face" def-prefix def))))
+  :group 'fuel
+  :group 'faces)
+
+(defmacro fuel-font-lock--defface (face def group doc)
   `(defface ,face (face-default-spec ,def)
      ,(format "Face for %s." doc)
      :group ',group
-       :group 'faces)))
+     :group 'fuel-faces
+     :group 'faces))
+
+(put 'fuel-font-lock--defface 'lisp-indent-function 1)
+
+(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
+  (let ((face (intern (format "%s-%s" prefix face)))
+        (def (intern (format "%s-%s-face" def-prefix def))))
+    `(fuel-font-lock--defface ,face ,def ,group ,doc)))
 
 (defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
   (let ((setup (make-symbol (format "%s--faces-setup" prefix))))

misc/fuel/fuel-help.el

@@ -18,13 +18,14 @@
 (require 'fuel-autodoc)
 (require 'fuel-completion)
 (require 'fuel-font-lock)
+(require 'fuel-popup)
 (require 'fuel-base)
 
 
 ;;; Customization:
 
 (defgroup fuel-help nil
-  "Options controlling FUEL's help system"
+  "Options controlling FUEL's help system."
   :group 'fuel)
 
 (defcustom fuel-help-always-ask t
@@ -47,10 +48,8 @@
   :type 'integer
   :group 'fuel-help)
 
-(defface fuel-help-font-lock-headlines '((t (:bold t :weight bold)))
+(fuel-font-lock--defface fuel-font-lock-help-headlines
-  "Face for headlines in help buffers."
+  'bold fuel-hep "headlines in help buffers")
-  :group 'fuel-help
-  :group 'faces)
 
 
 ;;; Help browser history:
@@ -81,10 +80,9 @@
 
 ;;; Fuel help buffer and internals:
 
-(defun fuel-help--help-buffer ()
+(fuel-popup--define fuel-help--buffer
-  (with-current-buffer (get-buffer-create "*fuel help*")
+  "*fuel help*" 'fuel-help-mode)
-    (fuel-help-mode)
+
-    (current-buffer)))
 
 (defvar fuel-help--prompt-history nil)
 
@@ -111,7 +109,7 @@
       (fuel-help--insert-contents def out))))
 
 (defun fuel-help--insert-contents (def str &optional nopush)
-  (let ((hb (fuel-help--help-buffer))
+  (let ((hb (fuel-help--buffer))
         (inhibit-read-only t)
         (font-lock-verbose nil))
     (set-buffer hb)
@@ -124,7 +122,7 @@
         (kill-region (point-min) (point))
         (fuel-help--history-push (cons def (buffer-string)))))
     (set-buffer-modified-p nil)
-    (pop-to-buffer hb)
+    (fuel-popup--display)
     (goto-char (point-min))
     (message "%s" def)))
 
@@ -154,7 +152,7 @@
 
 (defconst fuel-help--font-lock-keywords
   `(,@fuel-font-lock--font-lock-keywords
-    (,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
+    (,fuel-help--headlines-regexp . 'fuel-font-lock-help-headlines)))
 
 
 
@@ -211,7 +209,6 @@ buffer."
   (let ((map (make-sparse-keymap)))
     (suppress-keymap map)
     (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 "l" 'fuel-help-previous)
@@ -222,6 +219,7 @@ buffer."
     (define-key map [(backtab)] 'fuel-help-previous-headline)
     (define-key map (kbd "SPC")  'scroll-up)
     (define-key map (kbd "S-SPC") 'scroll-down)
+    (define-key map "\M-." 'fuel-edit-word-at-point)
     (define-key map "\C-cz" 'run-factor)
     (define-key map "\C-c\C-z" 'run-factor)
     map))
@@ -245,6 +243,7 @@ buffer."
   (fuel-autodoc-mode)
 
   (run-mode-hooks 'fuel-help-mode-hook)
+
   (setq buffer-read-only t))
 
 

misc/fuel/fuel-listener.el

@@ -13,8 +13,9 @@
 
 ;;; Code:
 
-(require 'fuel-eval)
+(require 'fuel-stack)
 (require 'fuel-completion)
+(require 'fuel-eval)
 (require 'fuel-connection)
 (require 'fuel-syntax)
 (require 'fuel-base)
@@ -25,7 +26,7 @@
 ;;; Customization:
 
 (defgroup fuel-listener nil
-  "Interacting with a Factor listener inside Emacs"
+  "Interacting with a Factor listener inside Emacs."
   :group 'fuel)
 
 (defcustom fuel-listener-factor-binary "~/factor/factor"
@@ -102,16 +103,9 @@ buffer."
     (goto-char (point-max))
     (unless seen (error "No prompt found!"))))
 
-
+(defun fuel-listener-nuke ()
-;;; Completion support
+  (interactive)
-
+  (fuel-con--setup-connection fuel-listener--buffer))
-(defsubst fuel-listener--current-vocab () nil)
-(defsubst fuel-listener--usings () nil)
-
-(defun fuel-listener--setup-completion ()
-  (setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
-  (setq fuel-syntax--usings-function 'fuel-listener--usings)
-  (set-syntax-table fuel-syntax--syntax-table))
 
 
 ;;; Interface: starting fuel listener
@@ -128,6 +122,28 @@ buffer."
         (pop-to-buffer buf)
       (switch-to-buffer buf))))
 
+
+;;; Completion support
+
+(defsubst fuel-listener--current-vocab () nil)
+(defsubst fuel-listener--usings () nil)
+
+(defun fuel-listener--setup-completion ()
+  (setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
+  (setq fuel-syntax--usings-function 'fuel-listener--usings)
+  (set-syntax-table fuel-syntax--syntax-table))
+
+
+;;; Stack mode support
+
+(defun fuel-listener--stack-region ()
+  (fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth))
+                              (comint-line-beginning-position)
+                            (1+ (fuel-syntax--brackets-start)))))
+
+(defun fuel-listener--setup-stack-mode ()
+  (setq fuel-stack--region-function 'fuel-listener--stack-region))
+
 
 ;;; Fuel listener mode:
 
@@ -138,12 +154,15 @@ buffer."
   (set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
   (set (make-local-variable 'comint-use-prompt-regexp) t)
   (set (make-local-variable 'comint-prompt-read-only) t)
-  (fuel-listener--setup-completion))
+  (set-syntax-table fuel-syntax--syntax-table)
+  (fuel-listener--setup-completion)
+  (fuel-listener--setup-stack-mode))
 
 (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-ca" 'fuel-autodoc-mode)
 (define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
+(define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode)
 (define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
 (define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
 (define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)

misc/fuel/fuel-mode.el

@@ -136,11 +136,27 @@ With prefix, asks for the word to edit."
   (interactive "P")
   (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))))
+         (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)))))
 
+(defun fuel-edit-word-doc-at-point (&optional arg)
+  "Opens a new window visiting the documentation file for the word at point.
+With prefix, asks for the word to edit."
+  (interactive "P")
+  (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
+                   (fuel-completion--read-word "Edit word: ")))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
+    (condition-case nil
+        (fuel--try-edit (fuel-eval--send/wait cmd))
+      (error (when (y-or-n-p (concat "No documentation found. "
+                                     "Do you want to open the vocab's "
+                                     "doc file? "))
+               (find-file-other-window
+                (format "%s-docs.factor"
+                        (file-name-sans-extension (buffer-file-name)))))))))
+
 (defvar fuel-mode--word-history nil)
 
 (defun fuel-edit-word (&optional arg)
@@ -152,7 +168,7 @@ offered."
                                            nil
                                            fuel-mode--word-history
                                            arg))
-         (cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
     (fuel--try-edit (fuel-eval--send/wait cmd))))
 
 (defvar fuel--vocabs-prompt-history nil)
@@ -183,8 +199,7 @@ With prefix argument, ask for word."
                 (fuel-syntax-symbol-at-point))))
     (when word
       (message "Looking up %s's callers ..." word)
-      (fuel-xref--show-callers word)
+      (fuel-xref--show-callers word))))
-      (message ""))))
 
 (defun fuel-show-callees (&optional arg)
   "Show a list of callers of word at point.
@@ -196,8 +211,7 @@ With prefix argument, ask for word."
                 (fuel-syntax-symbol-at-point))))
     (when word
       (message "Looking up %s's callees ..." word)
-      (fuel-xref--show-callees word)
+      (fuel-xref--show-callees word))))
-      (message ""))))
 
 
 ;;; Minor mode definition:
@@ -252,6 +266,7 @@ interacting with a factor listener is at your disposal.
 (define-key fuel-mode-map "\C-c\M->" 'fuel-show-callees)
 (define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
 
+(fuel-mode--key ?e ?d 'fuel-edit-word-doc-at-point)
 (fuel-mode--key ?e ?e 'fuel-eval-extended-region)
 (fuel-mode--key ?e ?l 'fuel-run-file)
 (fuel-mode--key ?e ?r 'fuel-eval-region)

misc/fuel/fuel-popup.el

@@ -0,0 +1,60 @@
+;;; fuel-popup.el -- popup windows
+
+;; 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: Sun Dec 21, 2008 14:37
+
+;;; Comentary:
+
+;; A minor mode to pop up windows and restore configurations
+;; afterwards.
+
+;;; Code:
+
+(make-variable-buffer-local
+ (defvar fuel-popup--created-window nil))
+
+(make-variable-buffer-local
+ (defvar fuel-popup--selected-window nil))
+
+(defun fuel-popup--display (&optional buffer)
+  (when buffer (set-buffer buffer))
+  (let ((selected-window (selected-window))
+        (buffer (current-buffer)))
+    (unless (eq selected-window (get-buffer-window buffer))
+      (let ((windows))
+        (walk-windows (lambda (w) (push w windows)) nil t)
+        (prog1 (pop-to-buffer buffer)
+          (set (make-local-variable 'fuel-popup--created-window)
+               (unless (memq (selected-window) windows) (selected-window)))
+          (set (make-local-variable 'fuel-popup--selected-window)
+               selected-window))))))
+
+(defun fuel-popup--quit ()
+  (interactive)
+  (let ((selected fuel-popup--selected-window)
+        (created fuel-popup--created-window))
+    (bury-buffer)
+    (when (eq created (selected-window)) (delete-window created))
+    (when (window-live-p selected) (select-window selected))))
+
+(define-minor-mode fuel-popup-mode
+  "Mode for displaying read only stuff"
+  nil nil
+  '(("q" . fuel-popup--quit)))
+
+(defmacro fuel-popup--define (fun name mode)
+  `(defun ,fun ()
+     (or (get-buffer ,name)
+         (with-current-buffer (get-buffer-create ,name)
+           (funcall ,mode)
+           (fuel-popup-mode)
+           (current-buffer)))))
+
+(put 'fuel-popup--define 'lisp-indent-function 1)
+
+(provide 'fuel-popup)
+;;; fuel-popup.el ends here

misc/fuel/fuel-stack.el

@@ -17,21 +17,20 @@
 (require 'fuel-autodoc)
 (require 'fuel-syntax)
 (require 'fuel-eval)
+(require 'fuel-font-lock)
 (require 'fuel-base)
 
 
 ;;; Customization
 
 (defgroup fuel-stack nil
-  "Customization for FUEL's stack inference engine"
+  "Customization for FUEL's stack inference engine."
   :group 'fuel)
 
-(defface fuel-font-lock-stack-region (face-user-default-spec 'highlight)
+(fuel-font-lock--defface fuel-font-lock-stack-region
-  "Face used to highlight the region whose stack effect is shown"
+  'highlight fuel-stack "highlighting the stack effect region")
-  :group 'fuel-stack
-  :group 'faces)
 
-(defcustom fuel-stack-highlight-period 2
+(defcustom fuel-stack-highlight-period 2.0
   "Time, in seconds, the region is highlighted when showing its
 stack effect.
 
@@ -97,13 +96,20 @@ With prefix argument, use current region instead"
  (defvar fuel-stack-mode-string " S"
    "Modeline indicator for fuel-stack-mode"))
 
+(make-variable-buffer-local
+ (defvar fuel-stack--region-function
+   '(lambda ()
+      (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))))
+
 (defun fuel-stack--eldoc ()
   (when (looking-at-p " \\|$")
-    (let* ((r (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))
+    (let* ((r (funcall fuel-stack--region-function))
-           (e (fuel-stack--infer-effect/prop r)))
+           (e (and r
+                   (not (string-match "^ *$" r))
+                   (fuel-stack--infer-effect/prop r))))
       (when e
         (if fuel-stack-mode-show-sexp-p
-            (concat (fuel--shorten-str r 30) ": " e)
+            (concat (fuel--shorten-str r 30) " -> " e)
           e)))))
 
 (define-minor-mode fuel-stack-mode

misc/fuel/fuel-syntax.el

@@ -277,6 +277,11 @@
 (defsubst fuel-syntax--end-of-defun ()
   (re-search-forward fuel-syntax--end-of-def-regex nil t))
 
+(defsubst fuel-syntax--end-of-defun-pos ()
+  (save-excursion
+    (re-search-forward fuel-syntax--end-of-def-regex nil t)
+    (point)))
+
 (defconst fuel-syntax--defun-signature-regex
   (format "\\(%s\\|%s\\)"
           (format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex)

misc/fuel/fuel-xref.el

@@ -13,6 +13,10 @@
 
 ;;; Code:
 
+(require 'fuel-eval)
+(require 'fuel-syntax)
+(require 'fuel-popup)
+(require 'fuel-font-lock)
 (require 'fuel-base)
 
 (require 'button)
@@ -24,13 +28,25 @@
   "FUEL's cross-referencing engine."
   :group 'fuel)
 
+(defcustom fuel-xref-follow-link-to-word-p t
+  "Whether, when following a link to a caller, we position the
+cursor at the first ocurrence of the used word."
+  :group 'fuel-xref
+  :type 'boolean)
+
+(fuel-font-lock--defface fuel-font-lock-xref-link
+  'link fuel-xref "highlighting links in cross-reference buffers")
+
+(fuel-font-lock--defface fuel-font-lock-xref-vocab
+  'italic fuel-xref "vocabulary names in cross-reference buffers")
+
 
 ;;; Buttons:
 
 (define-button-type 'fuel-xref--button-type
   'action 'fuel-xref--follow-link
   'follow-link t
-  'face 'default)
+  'face 'fuel-font-lock-xref-link)
 
 (defun fuel-xref--follow-link (button)
   (let ((file (button-get button 'file))
@@ -39,60 +55,81 @@
       (error "No file for this ref"))
     (when (not (file-readable-p file))
       (error "File '%s' is not readable" file))
+    (let ((word fuel-xref--word))
       (find-file-other-window file)
-    (when (numberp line) (goto-line line))))
+      (when (numberp line) (goto-line line))
+      (when (and word fuel-xref-follow-link-to-word-p)
+        (and (search-forward word
+                             (fuel-syntax--end-of-defun-pos)
+                             t)
+             (goto-char (match-beginning 0)))))))
 
 
 ;;; The xref buffer:
 
-(defvar fuel-xref--buffer-name "*fuel xref*")
+(fuel-popup--define fuel-xref--buffer
+  "*fuel xref*" 'fuel-xref-mode)
 
-(defun fuel-xref--get-buffer ()
+(make-local-variable (defvar fuel-xref--word nil))
-  (let ((buffer (get-buffer fuel-xref--buffer-name)))
-    (or (and (buffer-live-p buffer) buffer)
-        (prog1
-            (set-buffer (get-buffer-create fuel-xref--buffer-name))
-          (fuel-xref-mode)))))
 
 (defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
 
-(defun fuel-xref--fill-buffer (title refs)
+(defun fuel-xref--title (word cc count)
-  (let ((inhibit-read-only t))
+  (let ((cc (if cc "using" "used by")))
-    (with-current-buffer (fuel-xref--get-buffer)
+    (put-text-property 0 (length word) 'font-lock-face 'bold word)
-      (erase-buffer)
+    (cond ((zerop count) (format "No known words %s %s" cc word))
-      (insert title "\n\n")
+          ((= 1 count) (format "1 word %s %s:" cc word))
-      (dolist (ref refs)
+          (t (format "%s words %s %s:" count cc word)))))
-        (when (and (first ref) (second ref) (numberp (third ref)))
+
+(defun fuel-xref--insert-ref (ref)
+  (when (and (stringp (first ref))
+             (stringp (third ref))
+             (numberp (fourth ref)))
     (insert "  ")
     (insert-text-button (first ref)
                         :type 'fuel-xref--button-type
                         'help-echo (format "File: %s (%s)"
-                                                 (second ref)
+                                           (third ref)
-                                                 (third ref))
+                                           (fourth ref))
-                              'file (second ref)
+                        'file (third ref)
-                              'line (third ref))
+                        'line (fourth ref))
-          (newline)))
+    (when (stringp (second ref))
-      (when refs
+      (insert (format " (in %s)" (second ref))))
-        (insert "\n\n" fuel-xref--help-string "\n"))
+    (newline)
-      (goto-char (point-min)))))
+    t))
+
+(defun fuel-xref--fill-buffer (word cc refs)
+  (let ((inhibit-read-only t)
+        (count 0))
+    (with-current-buffer (fuel-xref--buffer)
+      (erase-buffer)
+      (dolist (ref refs)
+        (when (fuel-xref--insert-ref ref) (setq count (1+ count))))
+      (goto-char (point-min))
+      (insert (fuel-xref--title word cc count) "\n\n")
+      (when (> count 0)
+        (setq fuel-xref--word (and cc word))
+        (goto-char (point-max))
+        (insert "\n" fuel-xref--help-string "\n"))
+      (goto-char (point-min))
+      count)))
+
+(defun fuel-xref--fill-and-display (word cc refs)
+  (let ((count (fuel-xref--fill-buffer word cc refs)))
+    (if (zerop count)
+        (error (fuel-xref--title word cc 0))
+      (message "")
+      (fuel-popup--display (fuel-xref--buffer)))))
 
 (defun fuel-xref--show-callers (word)
   (let* ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))
-         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
-         (title (format (if res "Callers of '%s':"
+    (fuel-xref--fill-and-display word t res)))
-                          "No callers found for '%s'")
-                        word)))
-    (fuel-xref--fill-buffer title res)
-    (pop-to-buffer (fuel-xref--get-buffer))))
 
 (defun fuel-xref--show-callees (word)
   (let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
-         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
-         (title (format (if res "Words called by '%s':"
+    (fuel-xref--fill-and-display word nil res)))
-                          "No callees found for '%s'")
-                        word)))
-    (fuel-xref--fill-buffer title res)
-    (pop-to-buffer (fuel-xref--get-buffer))))
 
 
 ;;; Xref mode:
@@ -113,7 +150,7 @@
   (use-local-map fuel-xref-mode-map)
   (setq mode-name "FUEL Xref")
   (setq major-mode 'fuel-xref-mode)
-  (fuel-font-lock--font-lock-setup)
+  (font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
   (setq buffer-read-only t))