Merge branch 'master' into new_ui

extra/fuel/fuel.factor

@@ -4,9 +4,9 @@
 USING: accessors arrays assocs classes.tuple combinators
 compiler.units continuations debugger definitions help help.crossref
 help.markup help.topics io io.pathnames io.streams.string kernel lexer
-make math math.order memoize namespaces parser prettyprint sequences
+make math math.order memoize namespaces parser quotations prettyprint
-sets sorting source-files strings summary tools.crossref tools.vocabs
+sequences sets sorting source-files strings summary tools.crossref
-vectors vocabs vocabs.parser words ;
+tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser words ;
 
 IN: fuel
 
@@ -74,6 +74,8 @@ M: sequence fuel-pprint
 
 M: tuple fuel-pprint tuple>array fuel-pprint ; inline
 
+M: quotation fuel-pprint pprint ; inline
+
 M: continuation fuel-pprint drop ":continuation" write ; inline
 
 M: restart fuel-pprint name>> fuel-pprint ; inline
@@ -163,18 +165,22 @@ SYMBOL: :uses
 ! Edit locations
 
 : fuel-normalize-loc ( seq -- path line )
-    dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
+    [ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
+    [ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
 
-: fuel-get-edit-location ( defspec -- )
+: fuel-get-edit-location ( word -- )
     where fuel-normalize-loc 2array fuel-eval-set-result ; inline
 
 : fuel-get-vocab-location ( vocab -- )
     >vocab-link fuel-get-edit-location ; inline
 
-: fuel-get-doc-location ( defspec -- )
+: fuel-get-doc-location ( word -- )
     props>> "help-loc" swap at
     fuel-normalize-loc 2array fuel-eval-set-result ;
 
+: fuel-get-article-location ( name -- )
+    article loc>> fuel-normalize-loc 2array fuel-eval-set-result ;
+
 ! Cross-references
 
 : fuel-word>xref ( word -- xref )
@@ -292,16 +298,49 @@ MEMO: fuel-find-word ( name -- word/f )
     fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
     fuel-eval-set-result ; inline
 
+: fuel-vocab-help-row ( vocab -- element )
+    [ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
+
+: fuel-vocab-help-root-heading ( root -- element )
+    [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
+
+SYMBOL: vocab-list
+
+: fuel-vocab-help-table ( vocabs -- element )
+    [ fuel-vocab-help-row ] map vocab-list prefix ;
+
+: fuel-vocab-list ( assoc -- seq )
+    [
+        [ drop f ] [
+            [ fuel-vocab-help-root-heading ]
+            [ fuel-vocab-help-table ] bi*
+            [ 2array ] [ drop f ] if*
+        ] if-empty
+    ] { } assoc>map [  ] filter ;
+
+: fuel-vocab-children-help ( name -- element )
+    all-child-vocabs fuel-vocab-list ; inline
+
+: fuel-vocab-describe-words ( name -- element )
+    [ describe-words ] with-string-writer \ describe-words swap 2array ; inline
+
 : (fuel-vocab-help) ( name -- element )
     \ article swap dup >vocab-link
     [
-        [ summary [ , ] [ "No summary available" , ] if* ]
+        {
+            [ vocab-authors [ \ $authors prefix , ] when* ]
+            [ vocab-tags [ \ $tags prefix , ] when* ]
+            [ summary [ { $heading "Summary" } swap 2array , ] when* ]
             [ drop \ $nl , ]
-        [ vocab-help article [ content>> % ] when* ] tri
+            [ vocab-help [ article content>> % ] when* ]
+            [ name>> fuel-vocab-describe-words , ]
+            [ name>> fuel-vocab-children-help % ]
+        } cleave
     ] { } make 3array ;
 
 : fuel-vocab-help ( name -- )
-    (fuel-vocab-help) fuel-eval-set-result ; inline
+    dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
+    fuel-eval-set-result ; inline
 
 : (fuel-index) ( seq -- seq )
     [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
@@ -309,6 +348,21 @@ MEMO: fuel-find-word ( name -- word/f )
 : fuel-index ( quot: ( -- seq ) -- )
     call (fuel-index) fuel-eval-set-result ; inline
 
+MEMO: (fuel-get-vocabs/author) ( author -- element )
+    [ "Vocabularies by " prepend \ $heading swap 2array ]
+    [ authored fuel-vocab-list ] bi 2array ;
+
+: fuel-get-vocabs/author ( author -- )
+    (fuel-get-vocabs/author) fuel-eval-set-result ;
+
+MEMO: (fuel-get-vocabs/tag ( tag -- element )
+    [ "Vocabularies tagged " prepend \ $heading swap 2array ]
+    [ tagged fuel-vocab-list ] bi 2array ;
+
+: fuel-get-vocabs/tag ( tag -- )
+    (fuel-get-vocabs/tag fuel-eval-set-result ;
+
+
 ! -run=fuel support
 
 : fuel-startup ( -- ) "listener" run-file ; inline

extra/inverse/inverse.factor

@@ -63,16 +63,20 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
 
 : enough? ( stack word -- ? )
     dup deferred? [ 2drop f ] [
-        [ [ length ] dip 1quotation infer in>> >= ]
+        [ [ length ] [ 1quotation infer in>> ] bi* >= ]
         [ 3drop f ] recover
     ] if ;
 
 : fold-word ( stack word -- stack )
     2dup enough?
-    [ 1quotation with-datastack ] [ [ % ] dip , { } ] if ;
+    [ 1quotation with-datastack ] [ [ % ] [ , ] bi* { } ] if ;
 
 : fold ( quot -- folded-quot )
-    [ { } swap [ fold-word ] each % ] [ ] make ; 
+    [ { } [ fold-word ] reduce % ] [ ] make ; 
+
+ERROR: no-recursive-inverse ;
+
+SYMBOL: visited
 
 : flattenable? ( object -- ? )
     { [ word? ] [ primitive? not ] [
@@ -80,18 +84,18 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
         [ word-prop ] with contains? not
     ] } 1&& ; 
 
-: (flatten) ( quot -- )
-    [ dup flattenable? [ def>> (flatten) ] [ , ] if ] each ;
-
- : retain-stack-overflow? ( error -- ? )
-    { "kernel-error" 14 f f } = ;
-
 : flatten ( quot -- expanded )
-    [ [ (flatten) ] [ ] make ] [
+    [
-        dup retain-stack-overflow?
+        visited [ over suffix ] change
-        [ drop "No inverse defined on recursive word" ] when
+        [
-        throw
+            dup flattenable? [
-    ] recover ;
+                def>>
+                [ visited get memq? [ no-recursive-inverse ] when ]
+                [ flatten ]
+                bi
+            ] [ 1quotation ] if
+        ] map concat
+    ] with-scope ;
 
 ERROR: undefined-inverse ;
 

misc/fuel/README

@@ -95,13 +95,17 @@ beast.
 *** In the help browser:
 
     - h : help for word at point
+    - v : help for a vocabulary
     - a : find words containing given substring (M-x fuel-apropos)
+    - e : edit current article
     - ba : bookmark current page
     - bb : display bookmarks
     - bd : delete bookmark at point
     - n/p : next/previous page
+    - l : previous page
     - SPC/S-SPC : scroll up/down
     - TAB/S-TAB : next/previous link
+    - k : kill current page and go to previous or next
     - r : refresh page
     - c : clean browsing history
     - M-. : edit word at point in Emacs
@@ -112,4 +116,5 @@ beast.
 
     - TAB/BACKTAB : navigate links
     - RET/mouse click : follow link
+    - h : show help for word at point
     - q : bury buffer

misc/fuel/fuel-connection.el

@@ -1,6 +1,6 @@
 ;;; fuel-connection.el -- asynchronous comms with the fuel listener
 
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -193,7 +193,7 @@
       (condition-case cerr
           (with-current-buffer (or buffer (current-buffer))
             (funcall cont (fuel-con--comint-buffer-form))
-            (fuel-log--info "<%s>: processed\n\t%s" id req))
+            (fuel-log--info "<%s>: processed" id))
         (error (fuel-log--error
                 "<%s>: continuation failed %S \n\t%s" id rstr cerr))))))
 

misc/fuel/fuel-edit.el

@@ -0,0 +1,104 @@
+;;; fuel-edit.el -- utilities for file editing
+
+;; Copyright (C) 2009 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: Mon Jan 05, 2009 21:16
+
+;;; Comentary:
+
+;; Locating and opening factor source and documentation files.
+
+;;; Code:
+
+(require 'fuel-completion)
+(require 'fuel-eval)
+(require 'fuel-base)
+
+
+;;; Auxiliar functions:
+
+(defun fuel-edit--try-edit (ret)
+  (let* ((err (fuel-eval--retort-error ret))
+         (loc (fuel-eval--retort-result ret)))
+    (when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
+      (error "Couldn't find edit location"))
+    (unless (file-readable-p (car loc))
+      (error "Couldn't open '%s' for read" (car loc)))
+    (find-file-other-window (car loc))
+    (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
+
+(defun fuel-edit--read-vocabulary-name (refresh)
+  (let* ((vocabs (fuel-completion--vocabs refresh))
+         (prompt "Vocabulary name: "))
+    (if vocabs
+        (completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
+      (read-string prompt nil fuel-edit--vocab-history))))
+
+(defun fuel-edit--edit-article (name)
+  (let ((cmd `(:fuel* (,name fuel-get-article-location) "fuel" t)))
+    (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
+
+
+;;; Editing commands:
+
+(defvar fuel-edit--word-history nil)
+(defvar fuel-edit--vocab-history nil)
+
+(defun fuel-edit-vocabulary (&optional refresh vocab)
+  "Visits vocabulary file in Emacs.
+When called interactively, asks for vocabulary with completion.
+With prefix argument, refreshes cached vocabulary list."
+  (interactive "P")
+  (let* ((vocab (or vocab (fuel-edit--read-vocabulary-name refresh)))
+         (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
+    (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
+
+(defun fuel-edit-word (&optional arg)
+  "Asks for a word to edit, with completion.
+With prefix, only words visible in the current vocabulary are
+offered."
+  (interactive "P")
+  (let* ((word (fuel-completion--read-word "Edit word: "
+                                           nil
+                                           fuel-edit--word-history
+                                           arg))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
+    (fuel-edit--try-edit (fuel-eval--send/wait cmd))))
+
+(defun fuel-edit-word-at-point (&optional arg)
+  "Opens a new window visiting the definition of 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-edit-location))))
+    (condition-case nil
+        (fuel-edit--try-edit (fuel-eval--send/wait cmd))
+      (error (fuel-edit-vocabulary nil word)))))
+
+(defun fuel-edit-word-doc-at-point (&optional arg word)
+  "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 word
+                   (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-edit--try-edit (fuel-eval--send/wait cmd))
+      (error
+       (message "Documentation for '%s' not found" word)
+       (when (and (eq major-mode 'factor-mode)
+                  (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)))))))))
+
+
+(provide 'fuel-edit)
+;;; fuel-edit.el ends here

misc/fuel/fuel-eval.el

@@ -1,6 +1,6 @@
 ;;; fuel-eval.el --- evaluating Factor expressions
 
-;; Copyright (C) 2008  Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009  Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -13,9 +13,10 @@
 
 ;;; Code:
 
-(require 'fuel-base)
 (require 'fuel-syntax)
 (require 'fuel-connection)
+(require 'fuel-log)
+(require 'fuel-base)
 
 (eval-when-compile (require 'cl))
 
@@ -125,6 +126,7 @@
   (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
 
 (defun fuel-eval--parse-retort (ret)
+  (fuel-log--info "RETORT: %S" ret)
   (if (fuel-eval--retort-p ret) ret
     (fuel-eval--make-parse-error-retort ret)))
 

misc/fuel/fuel-help.el

@@ -14,11 +14,12 @@
 
 ;;; Code:
 
+(require 'fuel-edit)
 (require 'fuel-eval)
 (require 'fuel-markup)
 (require 'fuel-autodoc)
-(require 'fuel-xref)
 (require 'fuel-completion)
+(require 'fuel-syntax)
 (require 'fuel-font-lock)
 (require 'fuel-popup)
 (require 'fuel-base)
@@ -67,15 +68,15 @@
         (setcar fuel-help--history link))))
   link)
 
-(defun fuel-help--history-next ()
+(defun fuel-help--history-next (&optional forget-current)
   (when (not (ring-empty-p (nth 2 fuel-help--history)))
-    (when (car fuel-help--history)
+    (when (and (car fuel-help--history) (not forget-current))
       (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
     (setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
 
-(defun fuel-help--history-previous ()
+(defun fuel-help--history-previous (&optional forget-current)
   (when (not (ring-empty-p (nth 1 fuel-help--history)))
-    (when (car fuel-help--history)
+    (when (and (car fuel-help--history) (not forget-current))
       (ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
     (setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
 
@@ -114,10 +115,9 @@
   (let* ((def (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)))
+         (ask (or (not def) fuel-help-always-ask)))
-                  (not def)
+    (if ask
-                  fuel-help-always-ask)))
+        (fuel-completion--read-word prompt
-    (if ask (fuel-completion--read-word prompt
                                         def
                                         'fuel-help--prompt-history
                                         t)
@@ -129,7 +129,7 @@
       (let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help))
                           "fuel" t)))
         (message "Looking up '%s' ..." def)
-        (let* ((ret (fuel-eval--send/wait cmd 2000))
+        (let* ((ret (fuel-eval--send/wait cmd))
                (res (fuel-eval--retort-result ret)))
           (if (not res)
               (message "No help for '%s'" def)
@@ -138,7 +138,7 @@
 (defun fuel-help--get-article (name label)
   (message "Retrieving article ...")
   (let* ((cmd `(:fuel* ((,name fuel-get-article)) "fuel" t))
-         (ret (fuel-eval--send/wait cmd 2000))
+         (ret (fuel-eval--send/wait cmd))
          (res (fuel-eval--retort-result ret)))
     (if (not res)
         (message "Article '%s' not found" label)
@@ -146,15 +146,35 @@
       (message ""))))
 
 (defun fuel-help--get-vocab (name)
-  (message "Retrieving vocabulary help ...")
+  (message "Retrieving help vocabulary for vocabulary '%s' ..." name)
   (let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name)))
-         (ret (fuel-eval--send/wait cmd 2000))
+         (ret (fuel-eval--send/wait cmd))
          (res (fuel-eval--retort-result ret)))
     (if (not res)
         (message "No help available for vocabulary '%s'" name)
       (fuel-help--insert-contents (list name name 'vocab) res)
       (message ""))))
 
+(defun fuel-help--get-vocab/author (author)
+  (message "Retrieving vocabularies by %s ..." author)
+  (let* ((cmd `(:fuel* ((,author fuel-get-vocabs/author)) "fuel" t))
+         (ret (fuel-eval--send/wait cmd))
+         (res (fuel-eval--retort-result ret)))
+    (if (not res)
+        (message "No vocabularies by %s" author)
+      (fuel-help--insert-contents (list author author 'author) res)
+      (message ""))))
+
+(defun fuel-help--get-vocab/tag (tag)
+  (message "Retrieving vocabularies tagged '%s' ..." tag)
+  (let* ((cmd `(:fuel* ((,tag fuel-get-vocabs/tag)) "fuel" t))
+         (ret (fuel-eval--send/wait cmd))
+         (res (fuel-eval--retort-result ret)))
+    (if (not res)
+        (message "No vocabularies tagged '%s'" tag)
+      (fuel-help--insert-contents (list tag tag 'tag) res)
+      (message ""))))
+
 (defun fuel-help--follow-link (link label type &optional no-cache)
   (let* ((llink (list link label type))
          (cached (and (not no-cache) (fuel-help--cache-get llink))))
@@ -163,6 +183,8 @@
           (cond ((eq type 'word) (fuel-help--word-help nil link))
                 ((eq type 'article) (fuel-help--get-article link label))
                 ((eq type 'vocab) (fuel-help--get-vocab link))
+                ((eq type 'author) (fuel-help--get-vocab/author label))
+                ((eq type 'tag) (fuel-help--get-vocab/tag label))
                 ((eq type 'bookmarks) (fuel-help-display-bookmarks))
                 (t (error "Links of type %s not yet implemented" type))))
       (fuel-help--insert-contents llink cached))))
@@ -177,6 +199,7 @@
         (insert content)
       (fuel-markup--print content)
       (fuel-markup--insert-newline)
+      (delete-blank-lines)
       (fuel-help--cache-insert key (buffer-string)))
     (fuel-help--history-push key)
     (setq fuel-help--buffer-link key)
@@ -231,20 +254,34 @@ buffer."
   (interactive)
   (fuel-help--word-help))
 
-(defun fuel-help-next ()
+(defun fuel-help-vocab (vocab)
-  "Go to next page in help browser."
+  "Ask for a vocabulary name and show its help page."
-  (interactive)
+  (interactive (list (fuel-edit--read-vocabulary-name nil)))
-  (let ((item (fuel-help--history-next)))
+  (fuel-help--get-vocab vocab))
+
+(defun fuel-help-next (&optional forget-current)
+  "Go to next page in help browser.
+With prefix, the current page is deleted from history."
+  (interactive "P")
+  (let ((item (fuel-help--history-next forget-current)))
     (unless item (error "No next page"))
     (apply 'fuel-help--follow-link item)))
 
-(defun fuel-help-previous ()
+(defun fuel-help-previous (&optional forget-current)
-  "Go to previous page in help browser."
+  "Go to previous page in help browser.
-  (interactive)
+With prefix, the current page is deleted from history."
-  (let ((item (fuel-help--history-previous)))
+  (interactive "P")
+  (let ((item (fuel-help--history-previous forget-current)))
     (unless item (error "No previous page"))
     (apply 'fuel-help--follow-link item)))
 
+(defun fuel-help-kill-page ()
+  "Kill current page if a previous or next one exists."
+  (interactive)
+  (condition-case nil
+      (fuel-help-previous t)
+    (error (fuel-help-next t))))
+
 (defun fuel-help-refresh ()
   "Refresh the contents of current page."
   (interactive)
@@ -260,6 +297,15 @@ buffer."
     (fuel-help-refresh))
   (message ""))
 
+(defun fuel-help-edit ()
+  "Edit the current article or word help."
+  (interactive)
+  (let ((link (car fuel-help--buffer-link))
+        (type (nth 2 fuel-help--buffer-link)))
+    (cond ((eq type 'word) (fuel-edit-word-doc-at-point nil link))
+          ((member type '(article vocab)) (fuel-edit--edit-article link))
+          (t (error "No document associated with this page")))))
+
 
 ;;;; Help mode map:
 
@@ -272,10 +318,14 @@ buffer."
     (define-key map "bb" 'fuel-help-display-bookmarks)
     (define-key map "bd" 'fuel-help-delete-bookmark)
     (define-key map "c" 'fuel-help-clean-history)
+    (define-key map "e" 'fuel-help-edit)
     (define-key map "h" 'fuel-help)
+    (define-key map "k" 'fuel-help-kill-page)
     (define-key map "n" 'fuel-help-next)
+    (define-key map "l" 'fuel-help-previous)
     (define-key map "p" 'fuel-help-previous)
     (define-key map "r" 'fuel-help-refresh)
+    (define-key map "v" 'fuel-help-vocab)
     (define-key map (kbd "SPC")  'scroll-up)
     (define-key map (kbd "S-SPC") 'scroll-down)
     (define-key map "\M-." 'fuel-edit-word-at-point)
@@ -283,6 +333,16 @@ buffer."
     (define-key map "\C-c\C-z" 'run-factor)
     map))
 
+
+;;; IN: support
+
+(defun fuel-help--find-in ()
+  (save-excursion
+    (or (fuel-syntax--find-in)
+        (and (goto-char (point-min))
+             (re-search-forward "Vocabulary: \\(.+\\)$" nil t)
+             (match-string-no-properties 1)))))
+
 
 ;;; Help mode definition:
 
@@ -296,6 +356,7 @@ buffer."
   (set-syntax-table fuel-syntax--syntax-table)
   (setq mode-name "FUEL Help")
   (setq major-mode 'fuel-help-mode)
+  (setq fuel-syntax--current-vocab-function 'fuel-help--find-in)
   (setq fuel-markup--follow-link-function 'fuel-help--follow-link)
   (setq buffer-read-only t))
 

misc/fuel/fuel-markup.el

@@ -16,9 +16,9 @@
 (require 'fuel-eval)
 (require 'fuel-font-lock)
 (require 'fuel-base)
+(require 'fuel-table)
 
 (require 'button)
-(require 'table)
 
 
 ;;; Customization:
@@ -84,12 +84,18 @@
 ;;; Markup printers:
 
 (defconst fuel-markup--printers
-  '(($class-description . fuel-markup--class-description)
+  '(($all-tags . fuel-markup--all-tags)
+    ($all-authors . fuel-markup--all-authors)
+    ($author . fuel-markup--author)
+    ($authors . fuel-markup--authors)
+    ($class-description . fuel-markup--class-description)
     ($code . fuel-markup--code)
     ($command . fuel-markup--command)
+    ($command-map . fuel-markup--null)
     ($contract . fuel-markup--contract)
     ($curious . fuel-markup--curious)
     ($definition . fuel-markup--definition)
+    ($describe-vocab . fuel-markup--describe-vocab)
     ($description . fuel-markup--description)
     ($doc-path . fuel-markup--doc-path)
     ($emphasis . fuel-markup--emphasis)
@@ -110,6 +116,7 @@
     ($methods . fuel-markup--methods)
     ($nl . fuel-markup--newline)
     ($notes . fuel-markup--notes)
+    ($operation . fuel-markup--link)
     ($parsing-note . fuel-markup--parsing-note)
     ($predicate . fuel-markup--predicate)
     ($prettyprinting-note . fuel-markup--prettyprinting-note)
@@ -128,6 +135,8 @@
     ($synopsis . fuel-markup--synopsis)
     ($syntax . fuel-markup--syntax)
     ($table . fuel-markup--table)
+    ($tag . fuel-markup--tag)
+    ($tags . fuel-markup--tags)
     ($unchecked-example . fuel-markup--example)
     ($value . fuel-markup--value)
     ($values . fuel-markup--values)
@@ -138,7 +147,9 @@
     ($vocab-subsection . fuel-markup--vocab-subsection)
     ($vocabulary . fuel-markup--vocabulary)
     ($warning . fuel-markup--warning)
-    (article . fuel-markup--article)))
+    (article . fuel-markup--article)
+    (describe-words . fuel-markup--describe-words)
+    (vocab-list . fuel-markup--vocab-list)))
 
 (make-variable-buffer-local
  (defvar fuel-markup--maybe-nl nil))
@@ -164,10 +175,11 @@
 (defun fuel-markup--maybe-nl ()
   (setq fuel-markup--maybe-nl (point)))
 
-(defun fuel-markup--insert-newline (&optional justification)
+(defun fuel-markup--insert-newline (&optional justification nosqueeze)
   (fill-region (save-excursion (beginning-of-line) (point))
                (point)
-               (or justification 'left))
+               (or justification 'left)
+               nosqueeze)
   (newline))
 
 (defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
@@ -180,6 +192,7 @@
 
 (defun fuel-markup--insert-heading (txt &optional no-nl)
   (fuel-markup--insert-nl-if-nb)
+  (delete-blank-lines)
   (unless (bobp) (newline))
   (fuel-markup--put-face txt 'fuel-font-lock-markup-heading)
   (fuel-markup--insert-string txt)
@@ -239,7 +252,7 @@
     (insert (cadr e))))
 
 (defun fuel-markup--snippet (e)
-  (let ((snip (format "%s" (cdr e))))
+  (let ((snip (format "%s" (cadr e))))
     (insert (fuel-font-lock--factor-str snip))))
 
 (defun fuel-markup--code (e)
@@ -260,17 +273,15 @@
   (fuel-markup--print (cons '$code (cdr e)))
   (newline))
 
-(defun fuel-markup--examples (e)
+(defun fuel-markup--example (e)
-  (fuel-markup--insert-heading "Examples")
+  (fuel-markup--insert-newline)
-  (dolist (ex (cdr e))
+  (dolist (s (cdr e))
-    (fuel-markup--print ex)
+    (fuel-markup--snippet (list '$snippet s))
     (newline)))
 
-(defun fuel-markup--example (e)
-  (fuel-markup--snippet (list '$snippet (cadr e))))
-
 (defun fuel-markup--markup-example (e)
-  (fuel-markup--snippet (cons '$snippet (cadr e))))
+  (fuel-markup--insert-newline)
+  (fuel-markup--snippet (cons '$snippet (cdr e))))
 
 (defun fuel-markup--link (e)
   (let* ((link (nth 1 e))
@@ -301,7 +312,10 @@
                         "classes.intersection" "classes.predicate")))
          (subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
     (when subs
-      (fuel-markup--print subs))))
+      (let ((start (point))
+            (sort-fold-case nil))
+        (fuel-markup--print subs)
+        (sort-lines nil start (point))))))
 
 (defun fuel-markup--vocab-link (e)
   (fuel-markup--insert-button (cadr e) (cadr e) 'vocab))
@@ -312,11 +326,119 @@
     (fuel-markup--vocab-link (list '$vocab-link link))
     (insert " ")))
 
+(defun fuel-markup--vocab-list (e)
+  (let ((rows (mapcar '(lambda (elem)
+                         (list (car elem)
+                               (list '$vocab-link (cadr elem))
+                               (caddr elem)))
+                      (cdr e))))
+    (fuel-markup--table (cons '$table rows))))
+
+(defun fuel-markup--describe-vocab (e)
+  (fuel-markup--insert-nl-if-nb)
+  (let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (when res (fuel-markup--print res))))
+
 (defun fuel-markup--vocabulary (e)
   (fuel-markup--insert-heading "Vocabulary: " t)
   (fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
   (newline))
 
+(defun fuel-markup--parse-classes ()
+  (let ((elems))
+    (while (looking-at ".+ classes$")
+      (let ((heading `($heading ,(match-string-no-properties 0)))
+            (rows))
+        (forward-line)
+        (when (looking-at "Class *.+$")
+          (push (split-string (match-string-no-properties 0) nil t) rows)
+          (forward-line))
+        (while (not (looking-at "$"))
+          (let* ((objs (split-string (thing-at-point 'line) nil t))
+                 (class (list '$link (car objs) (car objs) 'word))
+                 (super (and (cadr objs)
+                             (list (list '$link (cadr objs) (cadr objs) 'word))))
+                 (slots (when (cddr objs)
+                          (list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
+            (push `(,class ,@super ,@slots) rows))
+          (forward-line))
+        (push `(,heading ($table ,@(reverse rows))) elems))
+      (forward-line))
+    (reverse elems)))
+
+(defun fuel-markup--parse-words ()
+  (let ((elems))
+    (while (looking-at ".+ words\\|Primitives$")
+      (let ((heading `($heading ,(match-string-no-properties 0)))
+            (rows))
+        (forward-line)
+        (when (looking-at "Word *Stack effect$")
+          (push '("Word" "Stack effect") rows)
+          (forward-line))
+        (while (looking-at "\\(.+?\\)\\( +\\(( .*\\)\\)?$")
+          (let ((word `($link ,(match-string-no-properties 1)
+                              ,(match-string-no-properties 1)
+                              word))
+                (se (and (match-string-no-properties 3)
+                         `(($snippet ,(match-string-no-properties 3))))))
+            (push `(,word ,@se) rows))
+          (forward-line))
+        (push `(,heading ($table ,@(reverse rows))) elems))
+      (forward-line))
+    (reverse elems)))
+
+(defun fuel-markup--parse-words-desc (desc)
+  (with-temp-buffer
+    (insert desc)
+    (goto-char (point-min))
+    (when (re-search-forward "^Words$" nil t)
+      (forward-line 2)
+      (let ((elems '(($heading "Words"))))
+        (push (fuel-markup--parse-classes) elems)
+        (push (fuel-markup--parse-words) elems)
+        (reverse elems)))))
+
+(defun fuel-markup--describe-words (e)
+  (when (cadr e)
+    (fuel-markup--print (fuel-markup--parse-words-desc (cadr e)))))
+
+(defun fuel-markup--tag (e)
+  (fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
+
+(defun fuel-markup--tags (e)
+  (when (cdr e)
+    (fuel-markup--insert-heading "Tags: " t)
+    (dolist (tag (cdr e))
+      (fuel-markup--tag (list '$tag tag))
+      (insert ", "))
+    (delete-backward-char 2)
+    (fuel-markup--insert-newline)))
+
+(defun fuel-markup--all-tags (e)
+  (let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
+         (tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (fuel-markup--list
+     (cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
+
+(defun fuel-markup--author (e)
+  (fuel-markup--link (list '$link (cadr e) (cadr e) 'author)))
+
+(defun fuel-markup--authors (e)
+  (when (cdr e)
+    (fuel-markup--insert-heading "Authors: " t)
+    (dolist (a (cdr e))
+      (fuel-markup--author (list '$author a))
+      (insert ", "))
+    (delete-backward-char 2)
+    (fuel-markup--insert-newline)))
+
+(defun fuel-markup--all-authors (e)
+  (let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
+         (authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+    (fuel-markup--list
+     (cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
+
 (defun fuel-markup--list (e)
   (fuel-markup--insert-nl-if-nb)
   (dolist (elt (cdr e))
@@ -326,19 +448,10 @@
 
 (defun fuel-markup--table (e)
   (fuel-markup--insert-newline)
+  (delete-blank-lines)
   (newline)
-  (let ((start (point))
+  (fuel-table--insert
-        (col-delim "<~end-of-col~>")
+   (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
-        (col-no (length (cadr e))))
-    (dolist (row (cdr e))
-      (dolist (col row)
-        (fuel-markup--print col)
-        (insert col-delim)))
-    (table-capture start (point)
-                   col-delim nil nil
-                   (/ (- (window-width) 10) col-no) col-no))
-  (goto-char (point-max))
-  (table-recognize -1)
   (newline))
 
 (defun fuel-markup--instance (e)
@@ -459,6 +572,9 @@
 (defun fuel-markup--errors (e)
   (fuel-markup--elem-with-heading e "Errors"))
 
+(defun fuel-markup--examples (e)
+  (fuel-markup--elem-with-heading e "Examples"))
+
 (defun fuel-markup--notes (e)
   (fuel-markup--elem-with-heading e "Notes"))
 
@@ -471,6 +587,8 @@
         (fuel-markup--code (list '$code res))
       (fuel-markup--snippet (list '$snippet word)))))
 
+(defun fuel-markup--null (e))
+
 (defun fuel-markup--synopsis (e)
   (insert (format " %S " e)))
 

misc/fuel/fuel-mode.el

@@ -24,6 +24,7 @@
 (require 'fuel-stack)
 (require 'fuel-autodoc)
 (require 'fuel-font-lock)
+(require 'fuel-edit)
 (require 'fuel-syntax)
 (require 'fuel-base)
 
@@ -80,7 +81,6 @@ With prefix argument, ask for the file to run."
       (message "Compiling %s ... OK!" file)
     (message "")))
 
-
 (defun fuel-eval-region (begin end &optional arg)
   "Sends region to Fuel's listener for evaluation.
 Unless called with a prefix, switches to the compilation results
@@ -131,75 +131,8 @@ With prefix argument, ask for the file name."
   (let ((file (car (fuel-mode--read-file arg))))
     (when file (fuel-debug--uses-for-file file))))
 
-(defun fuel--try-edit (ret)
-  (let* ((err (fuel-eval--retort-error ret))
-         (loc (fuel-eval--retort-result ret)))
-    (when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
-      (error "Couldn't find edit location for '%s'" word))
-    (unless (file-readable-p (car loc))
-      (error "Couldn't open '%s' for read" (car loc)))
-    (find-file-other-window (car loc))
-    (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
-
-(defun fuel-edit-word-at-point (&optional arg)
-  "Opens a new window visiting the definition of 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-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)
-  "Asks for a word to edit, with completion.
-With prefix, only words visible in the current vocabulary are
-offered."
-  (interactive "P")
-  (let* ((word (fuel-completion--read-word "Edit word: "
-                                           nil
-                                           fuel-mode--word-history
-                                           arg))
-         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
-    (fuel--try-edit (fuel-eval--send/wait cmd))))
-
-(defvar fuel--vocabs-prompt-history nil)
-
-(defun fuel--read-vocabulary-name (refresh)
-  (let* ((vocabs (fuel-completion--vocabs refresh))
-         (prompt "Vocabulary name: "))
-    (if vocabs
-        (completing-read prompt vocabs nil t nil fuel--vocabs-prompt-history)
-      (read-string prompt nil fuel--vocabs-prompt-history))))
-
-(defun fuel-edit-vocabulary (&optional refresh vocab)
-  "Visits vocabulary file in Emacs.
-When called interactively, asks for vocabulary with completion.
-With prefix argument, refreshes cached vocabulary list."
-  (interactive "P")
-  (let* ((vocab (or vocab (fuel--read-vocabulary-name refresh)))
-         (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
-    (fuel--try-edit (fuel-eval--send/wait cmd))))
-
 (defun fuel-show-callers (&optional arg)
   "Show a list of callers of word at point.
 With prefix argument, ask for word."

misc/fuel/fuel-syntax.el

@@ -1,6 +1,6 @@
 ;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
 
-;; Copyright (C) 2008  Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009  Jose Antonio Ortega Ruiz
 ;; See http://factorcode.org/license.txt for BSD license.
 
 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -48,7 +48,7 @@
     "DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
     "GENERIC#" "GENERIC:" "HEX:" "HOOK:"
     "IN:" "INSTANCE:" "INTERSECTION:"
-    "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "METHOD:" "MIXIN:"
+    "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
     "OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
     "REQUIRE:"  "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
     "TUPLE:" "t" "t?" "TYPEDEF:"
@@ -103,7 +103,8 @@
 (defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
 
 (defconst fuel-syntax--definition-starters-regex
-  (regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "METHOD" ":" "")))
+  (regexp-opt
+   '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD" ":" "")))
 
 (defconst fuel-syntax--definition-start-regex
   (format "^\\(%s:\\) " fuel-syntax--definition-starters-regex))

misc/fuel/fuel-table.el

@@ -0,0 +1,93 @@
+;;; fuel-table.el -- table creation
+
+;; Copyright (C) 2009 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: Tue Jan 06, 2009 13:44
+
+;;; Comentary:
+
+;; Utilities to insert ascii tables.
+
+;;; Code:
+
+(defun fuel-table--col-widths (rows)
+  (let* ((col-no (length (car rows)))
+         (available (- (window-width) 2 (* 2 col-no)))
+         (widths)
+         (c 0))
+    (while (< c col-no)
+      (let ((width 0)
+            (av-width (- available (* 5 (- col-no c)))))
+        (dolist (row rows)
+          (setq width
+                (min av-width
+                     (max width (length (nth c row))))))
+        (push width widths)
+        (setq available (- available width)))
+      (setq c (1+ c)))
+    (reverse widths)))
+
+(defun fuel-table--pad-str (str width)
+  (let ((len (length str)))
+    (cond ((= len width) str)
+          ((> len width) (concat (substring str 0 (- width 3)) "..."))
+          (t (concat str (make-string (- width (length str)) ?\ ))))))
+
+(defun fuel-table--str-lines (str width)
+  (if (<= (length str) width)
+      (list (fuel-table--pad-str str width))
+    (with-temp-buffer
+      (let ((fill-column width))
+        (insert str)
+        (fill-region (point-min) (point-max))
+        (mapcar '(lambda (s) (fuel-table--pad-str s width))
+                (split-string (buffer-string) "\n"))))))
+
+(defun fuel-table--pad-row (row)
+  (let* ((max-ln (apply 'max (mapcar 'length row)))
+         (result))
+    (dolist (lines row)
+      (let ((ln (length lines)))
+        (if (= ln max-ln) (push lines result)
+          (let ((lines (reverse lines))
+                (l 0)
+                (blank (make-string (length (car lines)) ?\ )))
+            (while (< l ln)
+              (push blank lines)
+              (setq l (1+ l)))
+            (push (reverse lines) result)))))
+    (reverse result)))
+
+(defun fuel-table--format-rows (rows widths)
+  (let ((col-no (length (car rows)))
+        (frows))
+    (dolist (row rows)
+      (let ((c 0) (frow))
+        (while (< c col-no)
+          (push (fuel-table--str-lines (nth c row) (nth c widths)) frow)
+          (setq c (1+ c)))
+        (push (fuel-table--pad-row (reverse frow)) frows)))
+    (reverse frows)))
+
+(defun fuel-table--insert (rows)
+  (let* ((widths (fuel-table--col-widths rows))
+         (rows (fuel-table--format-rows rows widths))
+         (ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+")))
+    (insert ls "\n")
+    (dolist (r rows)
+      (let ((ln (length (car r)))
+            (l 0))
+        (while (< l ln)
+          (insert (concat "|" (mapconcat 'identity
+                                         (mapcar `(lambda (x) (nth ,l x)) r)
+                                         " |")
+                          " |\n"))
+          (setq l (1+ l))))
+      (insert ls "\n"))))
+
+
+(provide 'fuel-table)
+;;; fuel-table.el ends here

misc/fuel/fuel-xref.el

@@ -13,6 +13,7 @@
 
 ;;; Code:
 
+(require 'fuel-help)
 (require 'fuel-eval)
 (require 'fuel-syntax)
 (require 'fuel-popup)
@@ -72,7 +73,8 @@ cursor at the first ocurrence of the used word."
 
 (make-local-variable (defvar fuel-xref--word nil))
 
-(defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
+(defvar fuel-xref--help-string
+  "(Press RET or click to follow crossrefs, or h for help on word at point)")
 
 (defun fuel-xref--title (word cc count)
   (put-text-property 0 (length word) 'font-lock-face 'bold word)
@@ -138,10 +140,16 @@ cursor at the first ocurrence of the used word."
 
 ;;; Xref mode:
 
+(defun fuel-xref-show-help ()
+  (interactive)
+  (let ((fuel-help-always-ask nil))
+    (fuel-help)))
+
 (defvar fuel-xref-mode-map
   (let ((map (make-sparse-keymap)))
     (suppress-keymap map)
     (set-keymap-parent map button-buffer-map)
+    (define-key map "h" 'fuel-xref-show-help)
     map))
 
 (defun fuel-xref-mode ()