From e626431a7e032bc464dc8a0ea361a5782dd146e9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 4 Jan 2009 11:38:25 -0600 Subject: [PATCH 01/28] Refactor html.parser.utils a bit --- extra/html/parser/utils/utils.factor | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/extra/html/parser/utils/utils.factor b/extra/html/parser/utils/utils.factor index 2f414d2aa5..c2a9d73af8 100644 --- a/extra/html/parser/utils/utils.factor +++ b/extra/html/parser/utils/utils.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: assocs circular combinators continuations hashtables hashtables.private io kernel math namespaces prettyprint -quotations sequences splitting state-parser strings ; +quotations sequences splitting state-parser strings +combinators.short-circuit ; IN: html.parser.utils : string-parse-end? ( -- ? ) get-next not ; @@ -13,26 +14,26 @@ IN: html.parser.utils dup length rot length 1- - head next* ; : trim1 ( seq ch -- newseq ) - [ ?head drop ] [ ?tail drop ] bi ; + [ [ ?head-slice drop ] [ ?tail-slice drop ] bi ] 2keep drop like ; -: single-quote ( str -- newstr ) - "'" dup surround ; +: quote? ( ch -- ? ) "'\"" member? ; -: double-quote ( str -- newstr ) - "\"" dup surround ; +: single-quote ( str -- newstr ) "'" dup surround ; + +: double-quote ( str -- newstr ) "\"" dup surround ; : quote ( str -- newstr ) CHAR: ' over member? [ double-quote ] [ single-quote ] if ; : quoted? ( str -- ? ) - [ f ] - [ [ first ] [ peek ] bi [ = ] keep "'\"" member? and ] if-empty ; + { + [ length 1 > ] + [ first quote? ] + [ [ first ] [ peek ] bi = ] + } 1&& ; -: ?quote ( str -- newstr ) - dup quoted? [ quote ] unless ; +: ?quote ( str -- newstr ) dup quoted? [ quote ] unless ; : unquote ( str -- newstr ) dup quoted? [ but-last-slice rest-slice >string ] when ; - -: quote? ( ch -- ? ) "'\"" member? ; From ffe0aac3101888f02ee134b01f242d8b51bc6557 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 4 Jan 2009 11:44:49 -0600 Subject: [PATCH 02/28] Fix a couple bugs in unix.users and add unit tests --- basis/unix/users/users-docs.factor | 2 +- basis/unix/users/users-tests.factor | 4 ++++ basis/unix/users/users.factor | 7 ++++--- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/basis/unix/users/users-docs.factor b/basis/unix/users/users-docs.factor index 83e7e99481..0740561cc1 100644 --- a/basis/unix/users/users-docs.factor +++ b/basis/unix/users/users-docs.factor @@ -50,7 +50,7 @@ HELP: set-real-user HELP: user-passwd { $values { "obj" object } - { "passwd" passwd } } + { "passwd/f" "passwd or f" } } { $description "Returns the passwd tuple given a username string or user id." } ; HELP: username diff --git a/basis/unix/users/users-tests.factor b/basis/unix/users/users-tests.factor index 1113383635..5a4639c856 100644 --- a/basis/unix/users/users-tests.factor +++ b/basis/unix/users/users-tests.factor @@ -24,3 +24,7 @@ IN: unix.users.tests [ ] [ effective-user-id [ ] with-effective-user ] unit-test [ ] [ [ ] with-user-cache ] unit-test + +[ "9999999999999999999" ] [ 9999999999999999999 username ] unit-test + +[ f ] [ 89898989898989898989898989898 user-passwd ] unit-test diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index 78417c66bf..21538080c9 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -47,17 +47,18 @@ SYMBOL: user-cache : with-user-cache ( quot -- ) [ user-cache ] dip with-variable ; inline -GENERIC: user-passwd ( obj -- passwd ) +GENERIC: user-passwd ( obj -- passwd/f ) M: integer user-passwd ( id -- passwd/f ) user-cache get - [ at ] [ getpwuid passwd>new-passwd ] if* ; + [ at ] [ getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ; M: string user-passwd ( string -- passwd/f ) getpwnam dup [ passwd>new-passwd ] when ; : username ( id -- string ) - user-passwd username>> ; + dup user-passwd + [ nip username>> ] [ number>string ] if* ; : user-id ( string -- id ) user-passwd uid>> ; From a0f3a44aa064fd3cc99f71069b8700a73397060f Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Mon, 5 Jan 2009 06:22:36 +0100 Subject: [PATCH 03/28] 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 @@ -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 @@ -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" Date: Mon, 5 Jan 2009 07:08:45 +0100 Subject: [PATCH 04/28] 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" Date: Mon, 5 Jan 2009 14:58:38 +0100 Subject: [PATCH 05/28] 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" Date: Mon, 5 Jan 2009 15:30:07 +0100 Subject: [PATCH 06/28] 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" Date: Mon, 5 Jan 2009 22:06:43 +0100 Subject: [PATCH 07/28] 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 +;; 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" Date: Mon, 5 Jan 2009 22:09:18 +0100 Subject: [PATCH 08/28] 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" Date: Mon, 5 Jan 2009 23:29:26 +0100 Subject: [PATCH 09/28] 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 @@ -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" Date: Tue, 6 Jan 2009 02:23:38 +0100 Subject: [PATCH 10/28] 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 d815c0c048fe9e5a4cb2976b2de0cead25259c0b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 5 Jan 2009 23:39:29 -0600 Subject: [PATCH 11/28] Fix Farkup link escaping --- basis/farkup/farkup-tests.factor | 12 +++++++++++- basis/farkup/farkup.factor | 2 +- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor index 27911a8d13..aa9345e1d0 100644 --- a/basis/farkup/farkup-tests.factor +++ b/basis/farkup/farkup-tests.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: farkup kernel peg peg.ebnf tools.test namespaces ; +USING: farkup kernel peg peg.ebnf tools.test namespaces xml +urls.encoding assocs xml.utilities ; IN: farkup.tests relative-link-prefix off @@ -157,3 +158,12 @@ link-no-follow? off [ "

hello_world how are you today?\n

  • hello_world how are you today?

" ] [ "hello_world how are you today?\n- hello_world how are you today?" convert-farkup ] unit-test + +: check-link-escaping ( string -- link ) + convert-farkup string>xml-chunk + "a" deep-tag-named "href" swap at url-decode ; + +[ "Trader Joe's" ] [ "[[Trader Joe's]]" check-link-escaping ] unit-test +[ "" ] [ "[[]]" check-link-escaping ] unit-test +[ "&blah;" ] [ "[[&blah;]]" check-link-escaping ] unit-test +[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test \ No newline at end of file diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 284d5758a3..1bfd420dd3 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -167,7 +167,7 @@ stand-alone } cond ; : escape-link ( href text -- href-esc text-esc ) - [ check-url escape-quoted-string ] dip escape-string ; + [ check-url ] dip escape-string ; : write-link ( href text -- ) escape-link From 956492447c97e56430b0adaf8ebfc8262b6cadb4 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 6 Jan 2009 07:05:42 +0100 Subject: [PATCH 12/28] 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" Date: Tue, 6 Jan 2009 16:28:10 +0100 Subject: [PATCH 13/28] 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 +;; 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" Date: Tue, 6 Jan 2009 23:08:33 +0100 Subject: [PATCH 14/28] 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" Date: Wed, 7 Jan 2009 01:44:45 +0100 Subject: [PATCH 15/28] 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" Date: Wed, 7 Jan 2009 01:59:15 +0100 Subject: [PATCH 16/28] 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" Date: Wed, 7 Jan 2009 02:47:44 +0100 Subject: [PATCH 17/28] 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" Date: Wed, 7 Jan 2009 03:03:20 +0100 Subject: [PATCH 18/28] 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" Date: Wed, 7 Jan 2009 04:08:36 +0100 Subject: [PATCH 19/28] 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 Date: Tue, 6 Jan 2009 21:14:22 -0600 Subject: [PATCH 20/28] 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 ; From 78fbeda1056858d9dd1e6b872bf5de051246be02 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 09:58:46 +0100 Subject: [PATCH 21/28] Refactor prime factors decomposition module and add more tests --- .../math/primes/factors/factors-tests.factor | 2 ++ extra/math/primes/factors/factors.factor | 29 +++++++++---------- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/extra/math/primes/factors/factors-tests.factor b/extra/math/primes/factors/factors-tests.factor index 70b905f4ab..f247683c1c 100644 --- a/extra/math/primes/factors/factors-tests.factor +++ b/extra/math/primes/factors/factors-tests.factor @@ -1,6 +1,8 @@ USING: math.primes.factors tools.test ; { { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test +{ { } } [ -5 factors ] unit-test { { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test { { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test { 999967000236000612 } [ 999969000187000867 totient ] unit-test +{ 0 } [ 1 totient ] unit-test diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor index 80c93f2ae0..282c46c82e 100644 --- a/extra/math/primes/factors/factors.factor +++ b/extra/math/primes/factors/factors.factor @@ -1,39 +1,36 @@ -! Copyright (C) 2007 Samuel Tardieu. +! Copyright (C) 2007-2009 Samuel Tardieu. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel lists make math math.primes sequences ; IN: math.primes.factors [ swap uncons swap [ pick call ] dip swap (factors) - ] [ 3drop ] if ; + ] [ 3drop ] if ; inline recursive -: (decompose) ( n quot -- seq ) - [ lprimes rot (factors) ] { } make ; +: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline PRIVATE> -: factors ( n -- seq ) - [ (factor) ] (decompose) ; foldable +: factors ( n -- seq ) [ (factor) ] decompose ; flushable -: group-factors ( n -- seq ) - [ (count) ] (decompose) ; foldable +: group-factors ( n -- seq ) [ (count) ] decompose ; flushable -: unique-factors ( n -- seq ) - [ (unique) ] (decompose) ; foldable +: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable : totient ( n -- t ) dup 2 < [ From 5d988b04fa08e00719dcab29bd2a9ba0591b1acb Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 10:18:00 +0100 Subject: [PATCH 22/28] Add missing files in math.primes.erato and add copyright notice --- extra/math/primes/erato/authors.txt | 1 + extra/math/primes/erato/erato.factor | 2 ++ extra/math/primes/erato/summary.txt | 1 + 3 files changed, 4 insertions(+) create mode 100644 extra/math/primes/erato/authors.txt create mode 100644 extra/math/primes/erato/summary.txt diff --git a/extra/math/primes/erato/authors.txt b/extra/math/primes/erato/authors.txt new file mode 100644 index 0000000000..f3b0233f74 --- /dev/null +++ b/extra/math/primes/erato/authors.txt @@ -0,0 +1 @@ +Samuel Tardieu diff --git a/extra/math/primes/erato/erato.factor b/extra/math/primes/erato/erato.factor index effcd7b135..70a9c10ff5 100644 --- a/extra/math/primes/erato/erato.factor +++ b/extra/math/primes/erato/erato.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2009 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. USING: bit-arrays kernel math math.functions math.ranges sequences ; IN: math.primes.erato diff --git a/extra/math/primes/erato/summary.txt b/extra/math/primes/erato/summary.txt new file mode 100644 index 0000000000..6ecb893cd5 --- /dev/null +++ b/extra/math/primes/erato/summary.txt @@ -0,0 +1 @@ +Eratosthene sieve From 2638db02d1ce0006ae063b9e31b4aca73a9a4a1f Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 10:32:26 +0100 Subject: [PATCH 23/28] Use the largest source file to benchmark checksums "extra/math/primes/list.factor" is very small. Replace it with the largest factor source file in benchmarks. --- extra/benchmark/crc32/crc32.factor | 6 +++--- extra/benchmark/md5/md5.factor | 6 +++--- extra/benchmark/sha1/sha1.factor | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/extra/benchmark/crc32/crc32.factor b/extra/benchmark/crc32/crc32.factor index 0e5482da30..2fea4eb1f1 100755 --- a/extra/benchmark/crc32/crc32.factor +++ b/extra/benchmark/crc32/crc32.factor @@ -1,10 +1,10 @@ USING: checksums checksums.crc32 io.encodings.ascii io.files kernel math ; IN: benchmark.crc32 -: crc32-primes-list ( -- ) +: crc32-file ( -- ) 10 [ - "resource:extra/math/primes/list/list.factor" + "resource:basis/mime/multipart/multipart-tests.factor" crc32 checksum-file drop ] times ; -MAIN: crc32-primes-list +MAIN: crc32-file diff --git a/extra/benchmark/md5/md5.factor b/extra/benchmark/md5/md5.factor index 8a259c1217..24578ec677 100644 --- a/extra/benchmark/md5/md5.factor +++ b/extra/benchmark/md5/md5.factor @@ -1,7 +1,7 @@ USING: checksums checksums.md5 io.files kernel ; IN: benchmark.md5 -: md5-primes-list ( -- ) - "resource:extra/math/primes/list/list.factor" md5 checksum-file drop ; +: md5-file ( -- ) + "resource:basis/mime/multipart/multipart-tests.factor" md5 checksum-file drop ; -MAIN: md5-primes-list +MAIN: md5-file diff --git a/extra/benchmark/sha1/sha1.factor b/extra/benchmark/sha1/sha1.factor index d5ff5673c2..585368e836 100644 --- a/extra/benchmark/sha1/sha1.factor +++ b/extra/benchmark/sha1/sha1.factor @@ -1,7 +1,7 @@ USING: checksums checksums.sha1 io.files kernel ; IN: benchmark.sha1 -: sha1-primes-list ( -- ) - "resource:extra/math/primes/list/list.factor" sha1 checksum-file drop ; +: sha1-file ( -- ) + "resource:basis/mime/multipart/multipart-tests.factor" sha1 checksum-file drop ; -MAIN: sha1-primes-list +MAIN: sha1-file From c8be645eb1bc7eb2fba91fbbf275d2fc85e1a16e Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 10:34:07 +0100 Subject: [PATCH 24/28] Remove "primes-under-million" list In the past, this was a static list used to optimize prime factors computation. Now that the dependency has been reversed, there is no point in keeping this list which can be obtained by "1000000 primes-upto" as easily. --- extra/benchmark/binary-search/binary-search.factor | 12 ++++++++---- extra/math/primes/list/authors.txt | 1 - extra/math/primes/list/list.factor | 4 ---- 3 files changed, 8 insertions(+), 9 deletions(-) delete mode 100644 extra/math/primes/list/authors.txt delete mode 100644 extra/math/primes/list/list.factor diff --git a/extra/benchmark/binary-search/binary-search.factor b/extra/benchmark/binary-search/binary-search.factor index e5c81a954d..5883836b7d 100644 --- a/extra/benchmark/binary-search/binary-search.factor +++ b/extra/benchmark/binary-search/binary-search.factor @@ -1,13 +1,17 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: binary-search kernel math.primes.list math.ranges sequences -prettyprint ; +USING: binary-search compiler.units kernel math.primes math.ranges +memoize prettyprint sequences ; IN: benchmark.binary-search -: binary-search-benchmark ( -- ) - 1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ; +[ + MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ; +] with-compilation-unit ! Force computation of the primes list before benchmarking the binary search primes-under-million drop +: binary-search-benchmark ( -- ) + 1 1000000 [a,b] [ primes-under-million sorted-member? ] map length . ; + MAIN: binary-search-benchmark diff --git a/extra/math/primes/list/authors.txt b/extra/math/primes/list/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/extra/math/primes/list/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/math/primes/list/list.factor b/extra/math/primes/list/list.factor deleted file mode 100644 index 7467d126d0..0000000000 --- a/extra/math/primes/list/list.factor +++ /dev/null @@ -1,4 +0,0 @@ -USING: math.primes memoize ; -IN: math.primes.list - -MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ; From b96d2cca48630d47e7b3d830bbc6fa4bfc54a1ea Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Wed, 7 Jan 2009 13:37:17 +0100 Subject: [PATCH 25/28] Add test for project Euler 157 --- extra/project-euler/057/057-tests.factor | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 extra/project-euler/057/057-tests.factor diff --git a/extra/project-euler/057/057-tests.factor b/extra/project-euler/057/057-tests.factor new file mode 100644 index 0000000000..e10274ce25 --- /dev/null +++ b/extra/project-euler/057/057-tests.factor @@ -0,0 +1,3 @@ +USING: project-euler.057 tools.test ; + +{ 153 } [ euler057 ] unit-test From 7f218dde57c34397457cf7ecbece3ec9613bee55 Mon Sep 17 00:00:00 2001 From: "U-C4\\Administrator" Date: Wed, 7 Jan 2009 11:05:53 -0600 Subject: [PATCH 26/28] fix typo in grouping docs, add more examples --- basis/grouping/grouping-docs.factor | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index e68c0ede1a..19560dfde2 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -29,8 +29,7 @@ ABOUT: "grouping" HELP: groups { $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively." $nl -"New groups are created by calling " { $link } " and " { $link } "." } -{ $see-also group } ; +"New groups are created by calling " { $link } " and " { $link } "." } ; HELP: group { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } } @@ -48,11 +47,16 @@ HELP: "USING: arrays kernel prettyprint sequences grouping ;" "9 >array 3 dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }" } + { $example + "USING: kernel prettyprint sequences grouping ;" + "{ 1 2 3 4 5 6 } 3 0 swap nth ." + "{ 1 2 3 }" + } } ; HELP: { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } } -{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." } +{ $description "Outputs a virtual sequence whose elements are slices of disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." } { $examples { $example "USING: arrays kernel prettyprint sequences grouping ;" @@ -60,6 +64,11 @@ HELP: "dup [ reverse-here ] each concat >array ." "{ 2 1 0 5 4 3 8 7 6 }" } + { $example + "USING: kernel prettyprint sequences grouping ;" + "{ 1 2 3 4 5 6 } 3 1 swap nth ." + "T{ slice { from 3 } { to 6 } { seq { 1 2 3 4 5 6 } } }" + } } ; HELP: clumps @@ -89,11 +98,23 @@ HELP: "share-price 4 [ [ sum ] [ length ] bi / ] map ." "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }" } + { $example + "USING: kernel sequences grouping prettyprint ;" + "{ 1 2 3 4 5 6 } 3 1 swap nth ." + "{ 2 3 4 }" + } } ; HELP: { $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } } -{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ; +{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } +{ $examples + { $example + "USING: kernel sequences grouping prettyprint ;" + "{ 1 2 3 4 5 6 } 3 1 swap nth ." + "T{ slice { from 1 } { to 4 } { seq { 1 2 3 4 5 6 } } }" + } +} ; { clumps groups } related-words From e83713d557da63d7b08e25e00a4b408ba093c237 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 7 Jan 2009 11:20:05 -0600 Subject: [PATCH 27/28] Fix typo in each-file stack effect, document io.directories.search --- .../io/directories/search/search-docs.factor | 66 +++++++++++++++++++ basis/io/directories/search/search.factor | 23 ++++--- 2 files changed, 79 insertions(+), 10 deletions(-) create mode 100644 basis/io/directories/search/search-docs.factor diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor new file mode 100644 index 0000000000..359f1796bb --- /dev/null +++ b/basis/io/directories/search/search-docs.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations ; +IN: io.directories.search + +HELP: each-file +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } +} +{ $description "Performs a directory traversal, breadth-first or depth-first, and calls the quotation on the full pathname of each file." } +{ $examples + { $unchecked-example "USING: sequences io.directories.search ;" + "\"resource:misc\" t [ . ] each-file" + "! Recursive directory listing prints here" + } +} ; + +HELP: recursive-directory +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } + { "paths" "a sequence of pathname strings" } +} +{ $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ; + +HELP: find-file +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "path/f" "a pathname string or f" } +} +{ $description "Finds the first file in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +HELP: find-in-directories +{ $values + { "directories" "a sequence of pathnames" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "path'" "a pathname string" } +} +{ $description "Finds the first file in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +HELP: find-all-files +{ $values + { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "paths" "a sequence of pathname strings" } +} +{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +HELP: find-all-in-directories +{ $values + { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation } + { "paths" "a sequence of pathname strings" } +} +{ $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ; + +{ find-file find-all-files find-in-directories find-all-in-directories } related-words + +ARTICLE: "io.directories.search" "io.directories.search" +"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl +"Traversing directories:" +{ $subsection recursive-directory } +{ $subsection each-file } +"Finding files:" +{ $subsection find-file } +{ $subsection find-all-files } +{ $subsection find-in-directories } +{ $subsection find-all-in-directories } ; + +ABOUT: "io.directories.search" diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 137e919412..d1fdff34f9 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -5,10 +5,10 @@ io.directories io.files io.files.info io.pathnames kernel sequences system vocabs.loader ; IN: io.directories.search -TUPLE: directory-iterator path bfs queue ; - +: each-file ( path bfs? quot: ( obj -- ) -- ) + [ ] dip + [ f ] compose iterate-directory drop ; inline + +: recursive-directory ( path bfs? -- paths ) + [ ] accumulator [ each-file ] dip ; + : find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) [ ] dip [ keep and ] curry iterate-directory ; inline -: each-file ( path bfs? quot: ( obj -- ? ) -- ) - [ ] dip - [ f ] compose iterate-directory drop ; inline - : find-all-files ( path bfs? quot: ( obj -- ? ) -- paths ) [ ] dip pusher [ [ f ] compose iterate-directory drop ] dip ; inline -: recursive-directory ( path bfs? -- paths ) - [ ] accumulator [ each-file ] dip ; +: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path' ) + '[ _ _ find-file ] attempt-all ; -: find-in-directories ( directories bfs? quot -- path' ) - '[ _ _ find-file ] attempt-all ; inline +: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths ) + '[ _ _ find-all-files ] map concat ; os windows? [ "io.directories.search.windows" require ] when From e90c3879c061f2418b0a1414566a4ce16af37c19 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 7 Jan 2009 12:20:10 -0600 Subject: [PATCH 28/28] Fix typo in example --- basis/grouping/grouping-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index 19560dfde2..1eff4820dd 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -100,7 +100,7 @@ HELP: } { $example "USING: kernel sequences grouping prettyprint ;" - "{ 1 2 3 4 5 6 } 3 1 swap nth ." + "{ 1 2 3 4 5 6 } 3 second ." "{ 2 3 4 }" } } ; @@ -111,7 +111,7 @@ HELP: { $examples { $example "USING: kernel sequences grouping prettyprint ;" - "{ 1 2 3 4 5 6 } 3 1 swap nth ." + "{ 1 2 3 4 5 6 } 3 second ." "T{ slice { from 1 } { to 4 } { seq { 1 2 3 4 5 6 } } }" } } ;