From a0f3a44aa064fd3cc99f71069b8700a73397060f Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 06:22:36 +0100
Subject: [PATCH 01/17] FUEL: New command fuel-help-kill-page (bound to 'k' in
help browser).
---
extra/fuel/fuel.factor | 8 +++++---
misc/fuel/README | 1 +
misc/fuel/fuel-connection.el | 4 ++--
misc/fuel/fuel-eval.el | 6 ++++--
misc/fuel/fuel-help.el | 34 ++++++++++++++++++++++------------
5 files changed, 34 insertions(+), 19 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 80d8cde654..03896029f1 100644
--- a/extra/fuel/fuel.factor
+++ b/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
-sets sorting source-files strings summary tools.crossref tools.vocabs
-vectors vocabs vocabs.parser words ;
+make math math.order memoize namespaces parser quotations prettyprint
+sequences sets sorting source-files strings summary tools.crossref
+tools.vocabs 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
diff --git a/misc/fuel/README b/misc/fuel/README
index 6c03c7aa01..7c746ff305 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -102,6 +102,7 @@ beast.
- n/p : next/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
diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el
index 05ddad4b1e..09d1ddfb51 100644
--- a/misc/fuel/fuel-connection.el
+++ b/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))))))
diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el
index 078a7005f8..149e608964 100644
--- a/misc/fuel/fuel-eval.el
+++ b/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)))
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index 12091ea399..4b8d1e4e16 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -67,15 +67,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))))
@@ -231,20 +231,29 @@ buffer."
(interactive)
(fuel-help--word-help))
-(defun fuel-help-next ()
- "Go to next page in help browser."
- (interactive)
- (let ((item (fuel-help--history-next)))
+(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 ()
- "Go to previous page in help browser."
- (interactive)
- (let ((item (fuel-help--history-previous)))
+(defun fuel-help-previous (&optional forget-current)
+ "Go to previous page in help browser.
+With prefix, the current page is deleted from history."
+ (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)
@@ -273,6 +282,7 @@ buffer."
(define-key map "bd" 'fuel-help-delete-bookmark)
(define-key map "c" 'fuel-help-clean-history)
(define-key map "h" 'fuel-help)
+ (define-key map "k" 'fuel-help-kill-page)
(define-key map "n" 'fuel-help-next)
(define-key map "p" 'fuel-help-previous)
(define-key map "r" 'fuel-help-refresh)
From fd35c362ef91b9e5f1ad840dbe34d26169863065 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 07:08:45 +0100
Subject: [PATCH 02/17] FUEL: 'h' for help on word at point in xref buffers.
---
misc/fuel/README | 2 ++
misc/fuel/fuel-help.el | 21 ++++++++++++++++-----
misc/fuel/fuel-xref.el | 10 +++++++++-
3 files changed, 27 insertions(+), 6 deletions(-)
diff --git a/misc/fuel/README b/misc/fuel/README
index 7c746ff305..700996ba4f 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -100,6 +100,7 @@ beast.
- 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
@@ -113,4 +114,5 @@ beast.
- TAB/BACKTAB : navigate links
- RET/mouse click : follow link
+ - h : show help for word at point
- q : bury buffer
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index 4b8d1e4e16..7c165e5de7 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -17,8 +17,8 @@
(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)
@@ -114,10 +114,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)))
- (not def)
- fuel-help-always-ask)))
- (if ask (fuel-completion--read-word prompt
+ (ask (or (not def) fuel-help-always-ask)))
+ (if ask
+ (fuel-completion--read-word prompt
def
'fuel-help--prompt-history
t)
@@ -284,6 +283,7 @@ With prefix, the current page is deleted from history."
(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-last)
(define-key map "p" 'fuel-help-previous)
(define-key map "r" 'fuel-help-refresh)
(define-key map (kbd "SPC") 'scroll-up)
@@ -293,6 +293,16 @@ With prefix, the current page is deleted from history."
(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:
@@ -306,6 +316,7 @@ With prefix, the current page is deleted from history."
(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))
diff --git a/misc/fuel/fuel-xref.el b/misc/fuel/fuel-xref.el
index 31f8bcb69b..470c2a8762 100644
--- a/misc/fuel/fuel-xref.el
+++ b/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 ()
From a59271139c6c6bd043885c2e6ab84d741f484fba Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 14:58:38 +0100
Subject: [PATCH 03/17] FUEL: Index entries sorted and some improvements in
other tags in help browser.
---
misc/fuel/fuel-help.el | 1 +
misc/fuel/fuel-markup.el | 25 +++++++++++++++----------
2 files changed, 16 insertions(+), 10 deletions(-)
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index 7c165e5de7..ba3ff2b57d 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -176,6 +176,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)
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index a2c94d4f4a..319fb23b5a 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -180,6 +180,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 +240,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 +261,15 @@
(fuel-markup--print (cons '$code (cdr e)))
(newline))
-(defun fuel-markup--examples (e)
- (fuel-markup--insert-heading "Examples")
- (dolist (ex (cdr e))
- (fuel-markup--print ex)
+(defun fuel-markup--example (e)
+ (fuel-markup--insert-newline)
+ (dolist (s (cdr e))
+ (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 +300,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))
@@ -459,6 +461,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"))
From 9ca81aed93bd6c89b6cde5bb1ad7fcbc8c5a24bb Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 15:30:07 +0100
Subject: [PATCH 04/17] FUEL: bogus key binding fixed
---
misc/fuel/fuel-help.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index ba3ff2b57d..bb191eaa74 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -284,7 +284,7 @@ With prefix, the current page is deleted from history."
(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-last)
+ (define-key map "l" 'fuel-help-previous)
(define-key map "p" 'fuel-help-previous)
(define-key map "r" 'fuel-help-refresh)
(define-key map (kbd "SPC") 'scroll-up)
From ca0f944e04fa013860412848fe29702aeb9ce019 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 22:06:43 +0100
Subject: [PATCH 05/17] FUEL: Edit article command in help buffers.
---
extra/fuel/fuel.factor | 10 ++--
misc/fuel/fuel-edit.el | 104 +++++++++++++++++++++++++++++++++++++++++
misc/fuel/fuel-help.el | 11 +++++
misc/fuel/fuel-mode.el | 69 +--------------------------
4 files changed, 123 insertions(+), 71 deletions(-)
create mode 100644 misc/fuel/fuel-edit.el
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 03896029f1..b5fc84dcf7 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -165,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 )
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
new file mode 100644
index 0000000000..ab81f46684
--- /dev/null
+++ b/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 t 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
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index bb191eaa74..d5f3181450 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -14,6 +14,7 @@
;;; Code:
+(require 'fuel-edit)
(require 'fuel-eval)
(require 'fuel-markup)
(require 'fuel-autodoc)
@@ -269,6 +270,15 @@ With prefix, the current page is deleted from history."
(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:
@@ -281,6 +291,7 @@ With prefix, the current page is deleted from history."
(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)
diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el
index df06584fab..651cc323d0 100644
--- a/misc/fuel/fuel-mode.el
+++ b/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."
From f623c46314614140585c9d8dda1611076d62d3d5 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 22:09:18 +0100
Subject: [PATCH 06/17] FUEL: Document edit command.
---
misc/fuel/README | 1 +
1 file changed, 1 insertion(+)
diff --git a/misc/fuel/README b/misc/fuel/README
index 700996ba4f..396e83a009 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -96,6 +96,7 @@ beast.
- h : help for word at point
- 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
From bb774d61c80204f6dea9dd15e98f0efeb327e3b0 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Mon, 5 Jan 2009 23:29:26 +0100
Subject: [PATCH 07/17] FUEL: MEMO:: recognised in factor syntax.
---
misc/fuel/fuel-syntax.el | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el
index 036ac7cbd0..2c3de32d4f 100644
--- a/misc/fuel/fuel-syntax.el
+++ b/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))
From 76dcfc6c2bb4eb290b5076574f010922ce1c42b3 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Tue, 6 Jan 2009 02:23:38 +0100
Subject: [PATCH 08/17] FUEL: New command fuel-help-vocab (v in help browser).
---
misc/fuel/README | 1 +
misc/fuel/fuel-help.el | 6 ++++++
2 files changed, 7 insertions(+)
diff --git a/misc/fuel/README b/misc/fuel/README
index 396e83a009..14a9ca8b5d 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -95,6 +95,7 @@ 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
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index d5f3181450..4d16ca3cba 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -232,6 +232,11 @@ buffer."
(interactive)
(fuel-help--word-help))
+(defun fuel-help-vocab (vocab)
+ "Ask for a vocabulary name and show its help page."
+ (interactive (list (fuel-edit--read-vocabulary-name nil)))
+ (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."
@@ -298,6 +303,7 @@ With prefix, the current page is deleted from history."
(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)
From 956492447c97e56430b0adaf8ebfc8262b6cadb4 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Tue, 6 Jan 2009 07:05:42 +0100
Subject: [PATCH 09/17] FUEL: $describe-vocab and child vocab lists
implemented.
---
extra/fuel/fuel.factor | 39 +++++++++++++++++++++++++++----
misc/fuel/fuel-edit.el | 2 +-
misc/fuel/fuel-markup.el | 50 +++++++++++++++++++++++++++++-----------
3 files changed, 72 insertions(+), 19 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index b5fc84dcf7..1770f320eb 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -6,7 +6,7 @@ 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 quotations prettyprint
sequences sets sorting source-files strings summary tools.crossref
-tools.vocabs vectors vocabs vocabs.parser words ;
+tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser words ;
IN: fuel
@@ -298,16 +298,45 @@ 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-name ]
+ [ dup summary " " append swap vocab-status-string append ]
+ bi 2array ;
+
+: fuel-vocab-help-root-heading ( root -- element )
+ [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
+
+SYMBOL: vocab-list
+
+: fuel-vocab-children-table ( vocabs -- element )
+ [ fuel-vocab-help-row ] map vocab-list prefix ;
+
+: fuel-vocab-children ( assoc -- seq )
+ [
+ [ drop f ] [
+ [ fuel-vocab-help-root-heading ]
+ [ fuel-vocab-children-table ] bi*
+ [ 2array ] [ drop f ] if*
+ ] if-empty
+ ] { } assoc>map [ ] filter ;
+
+: fuel-vocab-children-help ( name -- element )
+ all-child-vocabs fuel-vocab-children ;
+
: (fuel-vocab-help) ( name -- element )
\ article swap dup >vocab-link
[
- [ summary [ , ] [ "No summary available" , ] if* ]
- [ drop \ $nl , ]
- [ vocab-help article [ content>> % ] when* ] tri
+ {
+ [ summary [ , ] [ "No summary available" , ] if* ]
+ [ drop \ $nl , ]
+ [ vocab-help [ article content>> % ] when* ]
+ [ 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 ;
diff --git a/misc/fuel/fuel-edit.el b/misc/fuel/fuel-edit.el
index ab81f46684..e5988d1392 100644
--- a/misc/fuel/fuel-edit.el
+++ b/misc/fuel/fuel-edit.el
@@ -34,7 +34,7 @@
(let* ((vocabs (fuel-completion--vocabs refresh))
(prompt "Vocabulary name: "))
(if vocabs
- (completing-read prompt vocabs nil t nil fuel-edit--vocab-history)
+ (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)
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index 319fb23b5a..a251f35ddd 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -90,6 +90,7 @@
($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)
@@ -138,7 +139,8 @@
($vocab-subsection . fuel-markup--vocab-subsection)
($vocabulary . fuel-markup--vocabulary)
($warning . fuel-markup--warning)
- (article . fuel-markup--article)))
+ (article . fuel-markup--article)
+ (vocab-list . fuel-markup--vocab-list)))
(make-variable-buffer-local
(defvar fuel-markup--maybe-nl nil))
@@ -164,10 +166,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)
@@ -314,6 +317,18 @@
(fuel-markup--vocab-link (list '$vocab-link link))
(insert " ")))
+(defun fuel-markup--vocab-list (e)
+ (let ((rows (mapcar '(lambda (elem)
+ (list (list '$vocab-link (car elem)) (cadr 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)))
@@ -328,20 +343,29 @@
(defun fuel-markup--table (e)
(fuel-markup--insert-newline)
+ (delete-blank-lines)
(newline)
- (let ((start (point))
- (col-delim "<~end-of-col~>")
- (col-no (length (cadr e))))
+ (let* ((table-time-before-update 0)
+ (table-time-before-reformat 0)
+ (start (point))
+ (col-delim "<~end-of-col~>")
+ (col-no (length (cadr e)))
+ (width (/ (- (window-width) 10) col-no))
+ (step 100)
+ (count 0)
+ (inst '(lambda ()
+ (table-capture start (point) col-delim nil nil width col-no)
+ (goto-char (point-max))
+ (table-recognize -1)
+ (newline)
+ (setq start (point)))))
(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))
+ (insert col-delim)
+ (setq count (1+ count))
+ (when (zerop (mod count step)) (funcall inst))))
+ (unless (zerop (mod count step)) (funcall inst))))
(defun fuel-markup--instance (e)
(insert " an instance of ")
From af7844383278c7677c44ad39e8a83679854b4241 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Tue, 6 Jan 2009 16:28:10 +0100
Subject: [PATCH 10/17] FUEL: Much faster and nicer table rendering.
---
extra/fuel/fuel.factor | 4 +-
misc/fuel/fuel-markup.el | 30 ++++---------
misc/fuel/fuel-table.el | 91 ++++++++++++++++++++++++++++++++++++++++
3 files changed, 99 insertions(+), 26 deletions(-)
create mode 100644 misc/fuel/fuel-table.el
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 1770f320eb..e5397e8f0a 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -299,9 +299,7 @@ MEMO: fuel-find-word ( name -- word/f )
fuel-eval-set-result ; inline
: fuel-vocab-help-row ( vocab -- element )
- [ vocab-name ]
- [ dup summary " " append swap vocab-status-string append ]
- bi 2array ;
+ [ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
: fuel-vocab-help-root-heading ( root -- element )
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index a251f35ddd..067aac4c17 100644
--- a/misc/fuel/fuel-markup.el
+++ b/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:
@@ -319,7 +319,9 @@
(defun fuel-markup--vocab-list (e)
(let ((rows (mapcar '(lambda (elem)
- (list (list '$vocab-link (car elem)) (cadr elem)))
+ (list (car elem)
+ (list '$vocab-link (cadr elem))
+ (caddr elem)))
(cdr e))))
(fuel-markup--table (cons '$table rows))))
@@ -345,27 +347,9 @@
(fuel-markup--insert-newline)
(delete-blank-lines)
(newline)
- (let* ((table-time-before-update 0)
- (table-time-before-reformat 0)
- (start (point))
- (col-delim "<~end-of-col~>")
- (col-no (length (cadr e)))
- (width (/ (- (window-width) 10) col-no))
- (step 100)
- (count 0)
- (inst '(lambda ()
- (table-capture start (point) col-delim nil nil width col-no)
- (goto-char (point-max))
- (table-recognize -1)
- (newline)
- (setq start (point)))))
- (dolist (row (cdr e))
- (dolist (col row)
- (fuel-markup--print col)
- (insert col-delim)
- (setq count (1+ count))
- (when (zerop (mod count step)) (funcall inst))))
- (unless (zerop (mod count step)) (funcall inst))))
+ (fuel-table--insert
+ (mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
+ (newline))
(defun fuel-markup--instance (e)
(insert " an instance of ")
diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el
new file mode 100644
index 0000000000..6972851e51
--- /dev/null
+++ b/misc/fuel/fuel-table.el
@@ -0,0 +1,91 @@
+;;; 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) 10 (* 2 col-no)))
+ (widths)
+ (c 0))
+ (while (< c col-no)
+ (let ((width 0)
+ (av-width (/ available (- 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)))
+
+(defsubst fuel-table--pad-str (str width)
+ (if (>= (length str) width)
+ str
+ (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
From efcd8cb194be705dd8691a1be21fd2361978d9e3 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Tue, 6 Jan 2009 23:08:33 +0100
Subject: [PATCH 11/17] FUEL: Tags and authors support in help browser.
---
extra/fuel/fuel.factor | 21 +++++++++++++++++--
misc/fuel/fuel-help.el | 24 +++++++++++++++++++++-
misc/fuel/fuel-markup.el | 44 +++++++++++++++++++++++++++++++++++++++-
3 files changed, 85 insertions(+), 4 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index e5397e8f0a..0cb19ad0eb 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -319,13 +319,15 @@ SYMBOL: vocab-list
] { } assoc>map [ ] filter ;
: fuel-vocab-children-help ( name -- element )
- all-child-vocabs fuel-vocab-children ;
+ all-child-vocabs fuel-vocab-children ; 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* ]
[ name>> fuel-vocab-children-help % ]
@@ -342,6 +344,21 @@ SYMBOL: vocab-list
: 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-children ] 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-children ] bi 2array ;
+
+: fuel-get-vocabs/tag ( tag -- )
+ (fuel-get-vocabs/tag fuel-eval-set-result ;
+
+
! -run=fuel support
: fuel-startup ( -- ) "listener" run-file ; inline
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index 4d16ca3cba..d9e983d737 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -146,7 +146,7 @@
(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))
(res (fuel-eval--retort-result ret)))
@@ -155,6 +155,26 @@
(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))))
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index 067aac4c17..8a32bf8cf1 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -84,7 +84,11 @@
;;; 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)
($contract . fuel-markup--contract)
@@ -129,6 +133,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)
@@ -336,6 +342,42 @@
(fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
(newline))
+(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))
From b8793abeeaf471234ef6d52e2afa3390fb9d64f0 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 7 Jan 2009 01:44:45 +0100
Subject: [PATCH 12/17] FUEL: Vocab word lists in help browser.
---
extra/fuel/fuel.factor | 17 ++++++-----
misc/fuel/fuel-markup.el | 62 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 72 insertions(+), 7 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 0cb19ad0eb..add0941807 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -306,20 +306,23 @@ MEMO: fuel-find-word ( name -- word/f )
SYMBOL: vocab-list
-: fuel-vocab-children-table ( vocabs -- element )
+: fuel-vocab-help-table ( vocabs -- element )
[ fuel-vocab-help-row ] map vocab-list prefix ;
-: fuel-vocab-children ( assoc -- seq )
+: fuel-vocab-list ( assoc -- seq )
[
[ drop f ] [
[ fuel-vocab-help-root-heading ]
- [ fuel-vocab-children-table ] bi*
+ [ 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-children ; inline
+ 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
@@ -328,7 +331,7 @@ SYMBOL: vocab-list
[ vocab-authors [ \ $authors prefix , ] when* ]
[ vocab-tags [ \ $tags prefix , ] when* ]
[ summary [ { $heading "Summary" } swap 2array , ] when* ]
- [ drop \ $nl , ]
+ [ name>> fuel-vocab-describe-words , ]
[ vocab-help [ article content>> % ] when* ]
[ name>> fuel-vocab-children-help % ]
} cleave
@@ -346,14 +349,14 @@ SYMBOL: vocab-list
MEMO: (fuel-get-vocabs/author) ( author -- element )
[ "Vocabularies by " prepend \ $heading swap 2array ]
- [ authored fuel-vocab-children ] bi 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-children ] bi 2array ;
+ [ tagged fuel-vocab-list ] bi 2array ;
: fuel-get-vocabs/tag ( tag -- )
(fuel-get-vocabs/tag fuel-eval-set-result ;
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index 8a32bf8cf1..b06fb6a77f 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -91,6 +91,7 @@
($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)
@@ -146,6 +147,7 @@
($vocabulary . fuel-markup--vocabulary)
($warning . fuel-markup--warning)
(article . fuel-markup--article)
+ (describe-words . fuel-markup--describe-words)
(vocab-list . fuel-markup--vocab-list)))
(make-variable-buffer-local
@@ -342,6 +344,64 @@
(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 2)
+ `(($snippet ,(match-string-no-properties 2))))))
+ (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)))
@@ -526,6 +586,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)))
From 03455ab7708168e750e18078acd90b929b9fd4b6 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 7 Jan 2009 01:59:15 +0100
Subject: [PATCH 13/17] FUEL: $operation.
---
misc/fuel/fuel-markup.el | 1 +
1 file changed, 1 insertion(+)
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index b06fb6a77f..f60f363061 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -116,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)
From 3ee5772c883026a5a1a1a329351b2ffcb9b1ac0d Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 7 Jan 2009 02:47:44 +0100
Subject: [PATCH 14/17] FUEL: Shorten very long words in tables to keep delims
aligned.
---
misc/fuel/fuel-table.el | 18 ++++++++++--------
1 file changed, 10 insertions(+), 8 deletions(-)
diff --git a/misc/fuel/fuel-table.el b/misc/fuel/fuel-table.el
index 6972851e51..a00b21bf2f 100644
--- a/misc/fuel/fuel-table.el
+++ b/misc/fuel/fuel-table.el
@@ -15,24 +15,26 @@
(defun fuel-table--col-widths (rows)
(let* ((col-no (length (car rows)))
- (available (- (window-width) 10 (* 2 col-no)))
+ (available (- (window-width) 2 (* 2 col-no)))
(widths)
(c 0))
(while (< c col-no)
(let ((width 0)
- (av-width (/ available (- col-no c))))
+ (av-width (- available (* 5 (- col-no c)))))
(dolist (row rows)
- (setq width (min av-width
- (max width (length (nth c row))))))
+ (setq width
+ (min av-width
+ (max width (length (nth c row))))))
(push width widths)
(setq available (- available width)))
(setq c (1+ c)))
(reverse widths)))
-(defsubst fuel-table--pad-str (str width)
- (if (>= (length str) width)
- str
- (concat str (make-string (- width (length str)) ?\ ))))
+(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)
From 37760a0852d89185c687b75e5b0919b235400d4a Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 7 Jan 2009 03:03:20 +0100
Subject: [PATCH 15/17] FUEL: Fix for symbol words display in vocab help pages.
---
misc/fuel/fuel-markup.el | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index f60f363061..69d1de8814 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -376,12 +376,12 @@
(when (looking-at "Word *Stack effect$")
(push '("Word" "Stack effect") rows)
(forward-line))
- (while (looking-at "\\(.+?\\) +\\(( .*\\)?$")
+ (while (looking-at "\\(.+?\\)\\( +\\(( .*\\)\\)?$")
(let ((word `($link ,(match-string-no-properties 1)
,(match-string-no-properties 1)
word))
- (se (and (match-string-no-properties 2)
- `(($snippet ,(match-string-no-properties 2))))))
+ (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))
From 1a384e5e01db6792b4a52c196c25d1945a246b9d Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Wed, 7 Jan 2009 04:08:36 +0100
Subject: [PATCH 16/17] FUEL: Tidbits.
---
extra/fuel/fuel.factor | 3 ++-
misc/fuel/fuel-help.el | 6 +++---
2 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index add0941807..60420b3c39 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -331,8 +331,9 @@ SYMBOL: vocab-list
[ vocab-authors [ \ $authors prefix , ] when* ]
[ vocab-tags [ \ $tags prefix , ] when* ]
[ summary [ { $heading "Summary" } swap 2array , ] when* ]
- [ name>> fuel-vocab-describe-words , ]
+ [ drop \ $nl , ]
[ vocab-help [ article content>> % ] when* ]
+ [ name>> fuel-vocab-describe-words , ]
[ name>> fuel-vocab-children-help % ]
} cleave
] { } make 3array ;
diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el
index d9e983d737..705d1469a2 100644
--- a/misc/fuel/fuel-help.el
+++ b/misc/fuel/fuel-help.el
@@ -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)
@@ -148,7 +148,7 @@
(defun fuel-help--get-vocab (name)
(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)
From 70b6e1808c678adca033716569d9516574cfb690 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 6 Jan 2009 21:14:22 -0600
Subject: [PATCH 17/17] Clean up inverse a bit
---
extra/inverse/inverse.factor | 32 ++++++++++++++++++--------------
1 file changed, 18 insertions(+), 14 deletions(-)
diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index f1ca394e80..2feea39169 100755
--- a/extra/inverse/inverse.factor
+++ b/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?
- [ drop "No inverse defined on recursive word" ] when
- throw
- ] recover ;
+ [
+ visited [ over suffix ] change
+ [
+ dup flattenable? [
+ def>>
+ [ visited get memq? [ no-recursive-inverse ] when ]
+ [ flatten ]
+ bi
+ ] [ 1quotation ] if
+ ] map concat
+ ] with-scope ;
ERROR: undefined-inverse ;