From 7b36938e8c67db929b1a34b4ac6d7771fe442b18 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 16:07:16 -0600 Subject: [PATCH 01/37] use unix.stat to fix bootstrap --- basis/unix/statfs/freebsd/freebsd.factor | 2 +- basis/unix/statfs/linux/linux.factor | 2 +- basis/unix/statfs/openbsd/openbsd.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/unix/statfs/freebsd/freebsd.factor b/basis/unix/statfs/freebsd/freebsd.factor index efd12b7d6c..70e2d5e561 100644 --- a/basis/unix/statfs/freebsd/freebsd.factor +++ b/basis/unix/statfs/freebsd/freebsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax unix.types ; +USING: alien.syntax unix.types unix.stat ; IN: unix.statfs.freebsd CONSTANT: MFSNAMELEN 16 ! length of type name including null */ diff --git a/basis/unix/statfs/linux/linux.factor b/basis/unix/statfs/linux/linux.factor index 20688680fb..c0db5ced1d 100644 --- a/basis/unix/statfs/linux/linux.factor +++ b/basis/unix/statfs/linux/linux.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax unix.types ; +USING: alien.syntax unix.types unix.stat ; IN: unix.statfs.linux C-STRUCT: statfs64 diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor index 456883514a..60590be4ea 100644 --- a/basis/unix/statfs/openbsd/openbsd.factor +++ b/basis/unix/statfs/openbsd/openbsd.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax unix.types ; +USING: alien.syntax unix.types unix.stat ; IN: unix.statfs.openbsd CONSTANT: MFSNAMELEN 16 From e61acc5eee7f59d1b58746bc2b2624da773b3df7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 16:34:31 -0600 Subject: [PATCH 02/37] username -> user-name in a couple of places --- basis/io/files/unix/unix-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor index 48a128d862..003cb40621 100644 --- a/basis/io/files/unix/unix-tests.factor +++ b/basis/io/files/unix/unix-tests.factor @@ -117,12 +117,12 @@ prepare-test-file [ ] [ test-file f f 2array set-file-times ] unit-test -[ ] [ test-file real-username set-file-user ] unit-test +[ ] [ test-file real-user-name set-file-user ] unit-test [ ] [ test-file real-user-id set-file-user ] unit-test [ ] [ test-file real-group-name set-file-group ] unit-test [ ] [ test-file real-group-id set-file-group ] unit-test -[ t ] [ test-file file-username real-username = ] unit-test +[ t ] [ test-file file-user-name real-user-name = ] unit-test [ t ] [ test-file file-group-name real-group-name = ] unit-test [ ] From 2714de3b85c570e252226f7344081deb0c76a78c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 16:35:28 -0600 Subject: [PATCH 03/37] fix help-lint for values -- IN: scratchpad in an example --- basis/values/values-docs.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/values/values-docs.factor b/basis/values/values-docs.factor index 59bf77da3a..df38869fbf 100644 --- a/basis/values/values-docs.factor +++ b/basis/values/values-docs.factor @@ -19,6 +19,7 @@ HELP: VALUE: { $examples { $example "USING: values math prettyprint ;" + "IN: scratchpad" "VALUE: x" "2 2 + to: x" "x ." From 56808874f1a32dc20f10b90201386cc44d6bd9b5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 15:28:10 -0600 Subject: [PATCH 04/37] fix group-name on netbsd --- basis/unix/groups/groups-docs.factor | 6 +++--- basis/unix/groups/groups-tests.factor | 2 ++ basis/unix/groups/groups.factor | 20 ++++++++++++-------- 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/basis/unix/groups/groups-docs.factor b/basis/unix/groups/groups-docs.factor index 18c2e2384a..07911bc96b 100644 --- a/basis/unix/groups/groups-docs.factor +++ b/basis/unix/groups/groups-docs.factor @@ -24,8 +24,8 @@ HELP: group-cache HELP: group-id { $values { "string" string } - { "id" integer } } -{ $description "Returns the group id given a group name." } ; + { "id/f" "an integer or f" } } +{ $description "Returns the group id given a group name. Returns " { $link f } " if the group does not exist." } ; HELP: group-name { $values @@ -36,7 +36,7 @@ HELP: group-name HELP: group-struct { $values { "obj" object } - { "group" "a group struct" } } + { "group/f" "a group struct or f" } } { $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ; HELP: real-group-id diff --git a/basis/unix/groups/groups-tests.factor b/basis/unix/groups/groups-tests.factor index 75f5d64b5f..2e989b32c0 100644 --- a/basis/unix/groups/groups-tests.factor +++ b/basis/unix/groups/groups-tests.factor @@ -27,3 +27,5 @@ IN: unix.groups.tests [ ] [ real-group-id group-name drop ] unit-test [ "888888888888888" ] [ 888888888888888 group-name ] unit-test +[ f ] +[ "please-oh-please-don't-have-a-group-named-this123lalala" group-struct ] unit-test diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 164afa46fb..371bec9a70 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -13,7 +13,7 @@ TUPLE: group id name passwd members ; SYMBOL: group-cache -GENERIC: group-struct ( obj -- group ) +GENERIC: group-struct ( obj -- group/f ) tuck 4096 [ ] keep f ; -M: integer group-struct ( id -- group ) - (group-struct) getgrgid_r io-error ; +: check-group-struct ( group-struct ptr -- group-struct/f ) + *void* [ drop f ] unless ; -M: string group-struct ( string -- group ) - (group-struct) getgrnam_r 0 = [ (io-error) ] unless ; +M: integer group-struct ( id -- group/f ) + (group-struct) [ getgrgid_r io-error ] keep check-group-struct ; + +M: string group-struct ( string -- group/f ) + (group-struct) [ getgrnam_r io-error ] keep check-group-struct ; : group-struct>group ( group-struct -- group ) [ \ group new ] dip @@ -43,14 +46,15 @@ PRIVATE> : group-name ( id -- string ) dup group-cache get [ + "yo" print dupd at* [ name>> nip ] [ drop number>string ] if ] [ - group-struct group-gr_name + group-struct [ group-gr_name ] [ f ] if* ] if* [ nip ] [ number>string ] if* ; -: group-id ( string -- id ) - group-struct group-gr_gid ; +: group-id ( string -- id/f ) + group-struct [ group-gr_gid ] [ f ] if* ; Date: Fri, 9 Jan 2009 15:34:46 -0600 Subject: [PATCH 05/37] display available-space for file-systems. --- basis/tools/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index e6ca02d5f9..9066f3a219 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -65,7 +65,7 @@ percent-used percent-free ; [ [ unparse ] map ] bi prefix simple-table. ; : file-systems. ( -- ) - { device-name free-space used-space total-space percent-used mount-point } + { device-name available-space free-space used-space total-space percent-used mount-point } print-file-systems ; { From b08e1a02053aa82562db62b059362a27750c280b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 17:44:21 -0600 Subject: [PATCH 06/37] remove debug line --- basis/unix/groups/groups.factor | 1 - 1 file changed, 1 deletion(-) diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 371bec9a70..f4d91df245 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -46,7 +46,6 @@ PRIVATE> : group-name ( id -- string ) dup group-cache get [ - "yo" print dupd at* [ name>> nip ] [ drop number>string ] if ] [ group-struct [ group-gr_name ] [ f ] if* From b149a012482623dc3f7b11c886ef2ec25c924abf Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 10 Jan 2009 00:55:39 +0100 Subject: [PATCH 07/37] FUEL: Better syntax highlighting. --- misc/fuel/fuel-font-lock.el | 11 +++-- misc/fuel/fuel-syntax.el | 80 +++++++++++++++++++++++++++---------- 2 files changed, 68 insertions(+), 23 deletions(-) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index d4ce88cf20..45fd0758d5 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -54,6 +54,7 @@ factor-font-lock font-lock factor-mode ((comment comment "comments") (constructor type "constructors ()") + (constant constant "constants and literal values") (declaration keyword "declaration words") (parsing-word keyword "parsing words") (setter-word function-name "setter words (>>foo)") @@ -73,17 +74,21 @@ (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word) ("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word) (,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect) + (,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name) (,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration) (,fuel-syntax--word-definition-regex 2 'factor-font-lock-word) + (,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-word)) + (,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant) + (,fuel-syntax--number-regex . 'factor-font-lock-constant) (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name) (,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) - (,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name) + (,fuel-syntax--parent-type-regex 2 'factor-font-lock-type-name) (,fuel-syntax--constructor-regex . 'factor-font-lock-constructor) (,fuel-syntax--setter-regex . 'factor-font-lock-setter-word) (,fuel-syntax--getter-regex . 'factor-font-lock-getter-word) - (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol) - (,fuel-syntax--use-line-regex 1 'factor-font-lock-vocabulary-name)) + (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)) "Font lock keywords definition for Factor mode.") (defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index e1981eff47..49e7788b2f 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -44,16 +44,24 @@ (defconst fuel-syntax--parsing-words '(":" "::" ";" "<<" ">" - "B" "BIN:" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" - "DEFER:" "ERROR:" "EXCLUDE:" "FORGET:" - "GENERIC#" "GENERIC:" "HEX:" "HOOK:" - "IN:" "INSTANCE:" "INTERSECTION:" + "ALIAS:" + "B" "BIN:" + "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method" + "DEFER:" + "ERROR:" "EXCLUDE:" + "f" "FORGET:" "FROM:" + "GENERIC#" "GENERIC:" + "HEX:" "HOOK:" + "IN:" "initial:" "INSTANCE:" "INTERSECTION:" "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:" - "OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" - "REQUIRE:" "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:" + "OCT:" + "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:" + "QUALIFIED-WITH:" "QUALIFIED:" + "read-only" "RENAME:" "REQUIRE:" "REQUIRES:" + "SINGLETON:" "SINGLETONS:" "SLOT:" "SYMBOL:" "SYMBOLS:" "TUPLE:" "t" "t?" "TYPEDEF:" - "UNION:" "USE:" "USING:" "VARS:" - "call-next-method" "delimiter" "f" "initial:" "read-only")) + "UNION:" "USE:" "USING:" + "VARS:")) (defconst fuel-syntax--bracers '("B" "BV" "C" "CS" "H" "T" "V" "W")) @@ -65,7 +73,7 @@ (format "%s{" (regexp-opt fuel-syntax--bracers t))) (defconst fuel-syntax--declaration-words - '("flushable" "foldable" "inline" "parsing" "recursive")) + '("flushable" "foldable" "inline" "parsing" "recursive" "delimiter")) (defconst fuel-syntax--declaration-words-regex (regexp-opt fuel-syntax--declaration-words 'words)) @@ -76,13 +84,29 @@ (defconst fuel-syntax--method-definition-regex "^M: +\\([^ ]+\\) +\\([^ ]+\\)") +(defconst fuel-syntax--number-regex + "\\(\\+\\|-\\)?\\([0-9]+\\.?[0-9]*\\|\\.[0-9]+\\)\\([eE]\\(\\+\\|-\\)?[0-9]+\\)?") + (defconst fuel-syntax--word-definition-regex - (fuel-syntax--second-word-regex '(":" "::" "GENERIC:"))) + (fuel-syntax--second-word-regex + '(":" "::" "GENERIC:" "DEFER:" "HOOK:" "MAIN:" "MATH:" "POSTPONE:" + "SYMBOL:" "RENAME:"))) + +(defconst fuel-syntax--alias-definition-regex + "^ALIAS: +\\(\\_<.+?\\_>\\) +\\(\\_<.+?\\_>\\)") + +(defconst fuel-syntax--vocab-ref-regexp + (fuel-syntax--second-word-regex + '("IN:" "USE:" "FROM:" "EXCLUDE:" "QUALIFIED:" "QUALIFIED-WITH:"))) + +(defconst fuel-syntax--int-constant-def-regex + (fuel-syntax--second-word-regex '("CHAR:" "BIN:" "HEX:" "OCT:"))) (defconst fuel-syntax--type-definition-regex - (fuel-syntax--second-word-regex '("TUPLE:" "SINGLETON:"))) + (fuel-syntax--second-word-regex '("MIXIN:" "TUPLE:" "SINGLETON:" "UNION:"))) -(defconst fuel-syntax--parent-type-regex "^TUPLE: +[^ ]+ +< +\\([^ ]+\\)") +(defconst fuel-syntax--parent-type-regex + "^\\(TUPLE\\|PREDICTE\\): +[^ ]+ +< +\\([^ ]+\\)") (defconst fuel-syntax--constructor-regex "<[^ >]+>") @@ -102,21 +126,37 @@ (defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$") -(defconst fuel-syntax--definition-starters-regex - (regexp-opt - '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD" ":" ""))) - (defconst fuel-syntax--definition-start-regex - (format "^\\(%s:\\) " fuel-syntax--definition-starters-regex)) + (format "^\\(%s:\\) " (regexp-opt '("" ":" + "FROM" + "INTERSECTION:" + "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD" + "PREDICATE" "PRIMITIVE" + "SINGLETONS" "SYMBOLS" + "TUPLE" + "UNION" + "VARS")))) (defconst fuel-syntax--definition-end-regex (format "\\(\\(^\\| +\\);\\( *%s\\)*\\($\\| +\\)\\)" fuel-syntax--declaration-words-regex)) (defconst fuel-syntax--single-liner-regex - (format "^%s" (regexp-opt '("C:" "DEFER:" "GENERIC:" "IN:" - "PRIVATE>" "" " Date: Sat, 10 Jan 2009 01:05:51 +0100 Subject: [PATCH 08/37] FUEL: Fix for word extraction in top level forms. --- misc/fuel/fuel-refactor.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el index a414f17795..4bb83c06c8 100644 --- a/misc/fuel/fuel-refactor.el +++ b/misc/fuel/fuel-refactor.el @@ -32,7 +32,13 @@ (insert word) (indent-region begin (point)) (set-mark (point)) - (fuel-syntax--beginning-of-defun) + (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point))) + (end (save-excursion + (re-search-backward fuel-syntax--end-of-def-regex nil t) + (forward-line 1) + (skip-syntax-forward "-") + (point)))) + (goto-char (max beg end))) (open-line 1) (let ((start (point))) (insert ": " word " " stack-effect "\n" code " ;\n") From 86604af6826780d6cdfa6e90006133dacc5af6f2 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 10 Jan 2009 01:15:57 +0100 Subject: [PATCH 09/37] FUEL: Display of parsing words lists in help browser fixed. --- 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 69d1de8814..9e5e1c8af2 100644 --- a/misc/fuel/fuel-markup.el +++ b/misc/fuel/fuel-markup.el @@ -373,10 +373,10 @@ (let ((heading `($heading ,(match-string-no-properties 0))) (rows)) (forward-line) - (when (looking-at "Word *Stack effect$") - (push '("Word" "Stack effect") rows) + (when (looking-at "Word *\\(Stack effect\\|Syntax\\)$") + (push (list "Word" (match-string-no-properties 1)) rows) (forward-line)) - (while (looking-at "\\(.+?\\)\\( +\\(( .*\\)\\)?$") + (while (looking-at "\\(.+?\\)\\( +\\(.+\\)\\)?$") (let ((word `($link ,(match-string-no-properties 1) ,(match-string-no-properties 1) word)) From ea4f8867c762e40680a50dae92f3215658714f9b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 19:04:10 -0600 Subject: [PATCH 10/37] make monotonic-slice compile --- .../splitting/monotonic/monotonic-tests.factor | 2 ++ basis/splitting/monotonic/monotonic.factor | 18 ++++++++++-------- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/basis/splitting/monotonic/monotonic-tests.factor b/basis/splitting/monotonic/monotonic-tests.factor index 7bf9a38e8a..2b44f42394 100644 --- a/basis/splitting/monotonic/monotonic-tests.factor +++ b/basis/splitting/monotonic/monotonic-tests.factor @@ -15,6 +15,8 @@ USING: tools.test math arrays kernel sequences ; [ { { 1 } } ] [ { 1 } [ = ] slice monotonic-slice [ >array ] map ] unit-test +[ { 1 } [ = ] slice monotonic-slice ] must-infer + [ t ] [ { 1 1 1 2 2 3 3 4 } [ = ] slice monotonic-slice [ slice? ] all? ] unit-test diff --git a/basis/splitting/monotonic/monotonic.factor b/basis/splitting/monotonic/monotonic.factor index e39bba25ab..2e2ac74e30 100644 --- a/basis/splitting/monotonic/monotonic.factor +++ b/basis/splitting/monotonic/monotonic.factor @@ -24,13 +24,15 @@ PRIVATE> 1 over change-circular-start ] tri - [ @ not [ , ] [ drop ] if ] 3each - ] { } make - dup empty? [ over length 1- prefix ] when -1 prefix 2 clump - [ first2 [ 1+ ] bi@ rot roll boa ] with with map ; inline + [ + dupd '[ + [ length ] [ ] [ 1 over change-circular-start ] tri + [ @ not [ , ] [ drop ] if ] 3each + ] { } make + dup empty? [ over length 1- prefix ] when -1 prefix 2 clump + swap + ] dip + '[ first2 [ 1+ ] bi@ _ _ boa ] map ; inline PRIVATE> @@ -39,7 +41,7 @@ PRIVATE> { 0 [ 2drop ] } { 1 [ nip [ 0 1 rot ] dip boa 1array ] } [ drop (monotonic-slice) ] - } case ; + } case ; inline TUPLE: downward-slice < slice ; TUPLE: stable-slice < slice ; From 8e6be0ccefe7b2e22ded906f263161a6c29675fe Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 10 Jan 2009 02:09:25 +0100 Subject: [PATCH 11/37] FUEL: Numeric literals' font-lock fixed. --- misc/fuel/fuel-syntax.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 49e7788b2f..0d85cf897e 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -85,7 +85,7 @@ "^M: +\\([^ ]+\\) +\\([^ ]+\\)") (defconst fuel-syntax--number-regex - "\\(\\+\\|-\\)?\\([0-9]+\\.?[0-9]*\\|\\.[0-9]+\\)\\([eE]\\(\\+\\|-\\)?[0-9]+\\)?") + "\\_<\\(\\+\\|-\\)?\\([0-9]+\\.?[0-9]*\\|\\.[0-9]+\\)\\([eE]\\(\\+\\|-\\)?[0-9]+\\)?\\_>") (defconst fuel-syntax--word-definition-regex (fuel-syntax--second-word-regex From f3c7a870650af971c755f53797430559ade4fbaf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 19:12:49 -0600 Subject: [PATCH 12/37] clarify how sort works --- core/sorting/sorting-docs.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor index 6ea1485425..290ca1470c 100644 --- a/core/sorting/sorting-docs.factor +++ b/core/sorting/sorting-docs.factor @@ -20,7 +20,8 @@ ABOUT: "sequences-sorting" HELP: sort { $values { "seq" "a sequence" } { "quot" { $quotation "( obj1 obj2 -- <=> )" } } { "sortedseq" "a new sorted sequence" } } -{ $description "Sorts the elements into a new array." } ; +{ $description "Sorts the elements into a new array using a stable sort." } +{ $notes "The algorithm used is the merge sort." } ; HELP: sort-keys { $values { "seq" "an alist" } { "sortedseq" "a new sorted sequence" } } From 5ae9c7fe2fbac48b8167db13bb853dc99afb1de0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 9 Jan 2009 20:35:01 -0600 Subject: [PATCH 13/37] document 3each, 3map, 3map-as --- core/sequences/sequences-docs.factor | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 9f18fd4e66..eb621b3225 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -338,6 +338,10 @@ HELP: 2each { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- )" } } } { $description "Applies the quotation to pairs of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ; +HELP: 3each +{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- )" } } } +{ $description "Applies the quotation to triples of elements from " { $snippet "seq1" } ", " { $snippet "seq2" } " and " { $snippet "seq3" } "." } ; + HELP: 2reduce { $values { "seq1" sequence } { "seq2" sequence } @@ -350,10 +354,18 @@ HELP: 2map { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "newseq" "a new sequence" } } { $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ; +HELP: 3map +{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "newseq" "a new sequence" } } +{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "seq1" } "." } ; + HELP: 2map-as { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } } { $description "Applies the quotation to each pair of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ; +HELP: 3map-as +{ $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "quot" { $quotation "( elt1 elt2 elt3 -- new )" } } { "exemplar" sequence } { "newseq" "a new sequence" } } +{ $description "Applies the quotation to each triple of elements in turn, yielding new elements which are collected into a new sequence having the same class as " { $snippet "exemplar" } "." } ; + HELP: 2all? { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation "( elt1 elt2 -- ? )" } } { "?" "a boolean" } } { $description "Tests the predicate pairwise against elements of " { $snippet "seq1" } " and " { $snippet "seq2" } "." } ; @@ -1422,16 +1434,23 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection all? } "Testing how elements are related:" { $subsection monotonic? } -{ $subsection "sequence-2combinators" } ; +{ $subsection "sequence-2combinators" } +{ $subsection "sequence-3combinators" } ; ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators" -"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, than only the prefix having the length of the minimum of the two is examined." +"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined." { $subsection 2each } { $subsection 2reduce } { $subsection 2map } { $subsection 2map-as } { $subsection 2all? } ; +ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators" +"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined." +{ $subsection 3each } +{ $subsection 3map } +{ $subsection 3map-as } ; + ARTICLE: "sequences-tests" "Testing sequences" "Testing for an empty sequence:" { $subsection empty? } From a977691d82e06033d04d5c7e4afe3f95572dde20 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 9 Jan 2009 21:35:49 -0600 Subject: [PATCH 14/37] Add iota virtual sequence which will eventually replace integers-as-sequences --- core/sequences/sequences-docs.factor | 11 +++++++++++ core/sequences/sequences.factor | 10 ++++++++++ 2 files changed, 21 insertions(+) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 9f18fd4e66..f3a12d9209 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1262,6 +1262,17 @@ HELP: shorten "V{ 1 2 3 }" } } ; +HELP: iota +{ $values { "n" integer } { "iota" iota } } +{ $description "Creates an immutable virtual sequence containing the integers from 0 to " { $snippet "n-1" } "." } +{ $examples + { $example + "USING: math.parser sequences ;" + "3 iota [ sq ] map ." + "{ \"0\" \"1\" \"2\" }" + } +} ; + ARTICLE: "sequences-unsafe" "Unsafe sequence operations" "The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance." $nl diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 91c9d52404..2a499845bd 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -101,6 +101,16 @@ M: integer nth-unsafe drop ; INSTANCE: integer immutable-sequence +! In the future, this will replace integer sequences +TUPLE: iota { n read-only } ; + +: iota ( n -- iota ) \ iota boa ; inline + +M: iota length n>> ; +M: iota nth-unsafe drop ; + +INSTANCE: iota immutable-sequence + : first-unsafe ( seq -- first ) 0 swap nth-unsafe ; inline From 36dcb21857fbab76e4026311d334e762f11f17b4 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 10 Jan 2009 06:40:01 +0100 Subject: [PATCH 15/37] FUEL: Font lock for integers, floats and ratios. --- misc/fuel/fuel-font-lock.el | 6 +++++- misc/fuel/fuel-syntax.el | 10 ++++++++-- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 45fd0758d5..bcddf82d18 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -55,6 +55,8 @@ ((comment comment "comments") (constructor type "constructors ()") (constant constant "constants and literal values") + (number constant "integers and floats") + (ratio constant "ratios") (declaration keyword "declaration words") (parsing-word keyword "parsing words") (setter-word function-name "setter words (>>foo)") @@ -80,7 +82,9 @@ (,fuel-syntax--alias-definition-regex (1 'factor-font-lock-word) (2 'factor-font-lock-word)) (,fuel-syntax--int-constant-def-regex 2 'factor-font-lock-constant) - (,fuel-syntax--number-regex . 'factor-font-lock-constant) + (,fuel-syntax--integer-regex . 'factor-font-lock-number) + (,fuel-syntax--float-regex . 'factor-font-lock-number) + (,fuel-syntax--ratio-regex . 'factor-font-lock-ratio) (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name) (,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 0d85cf897e..93274c5160 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -84,8 +84,14 @@ (defconst fuel-syntax--method-definition-regex "^M: +\\([^ ]+\\) +\\([^ ]+\\)") -(defconst fuel-syntax--number-regex - "\\_<\\(\\+\\|-\\)?\\([0-9]+\\.?[0-9]*\\|\\.[0-9]+\\)\\([eE]\\(\\+\\|-\\)?[0-9]+\\)?\\_>") +(defconst fuel-syntax--integer-regex + "\\_<-?[0-9]+\\_>") + +(defconst fuel-syntax--ratio-regex + "\\_<-?\\([0-9]+\\+\\)?[0-9]+/-?[0-9]+\\_>") + +(defconst fuel-syntax--float-regex + "\\_<-?[0-9]+\\.[0-9]*\\([eE]-?[0-9]+\\)?\\_>") (defconst fuel-syntax--word-definition-regex (fuel-syntax--second-word-regex From 65e6a6ca848fc2eadd96165480829c3f0a6b589c Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 10 Jan 2009 15:44:03 +0100 Subject: [PATCH 16/37] FUEL: Bug in quotation pprint fixed. --- extra/fuel/fuel.factor | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 50f02f1a1a..07454a73f0 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -69,13 +69,15 @@ M: integer fuel-pprint pprint ; inline M: string fuel-pprint pprint ; inline -M: sequence fuel-pprint - "(" write [ " " write ] [ fuel-pprint ] interleave ")" write ; inline +: fuel-pprint-sequence ( seq open close -- ) + [ write ] dip swap [ " " write ] [ fuel-pprint ] interleave write ; inline + +M: sequence fuel-pprint "(" ")" fuel-pprint-sequence ; inline + +M: quotation fuel-pprint "[" "]" fuel-pprint-sequence ; inline 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 From f4cffe8a1b2e6a002c5895d498c6183b40437b1d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 10 Jan 2009 13:05:25 -0600 Subject: [PATCH 17/37] move iota to sequences, fix example, add unit tests, make iota's slot integers only --- core/sequences/sequences-docs.factor | 4 ++-- core/sequences/sequences-tests.factor | 6 +++++- core/sequences/sequences.factor | 6 +++++- 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 957b33198e..651c8e8a14 100644 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1279,9 +1279,9 @@ HELP: iota { $description "Creates an immutable virtual sequence containing the integers from 0 to " { $snippet "n-1" } "." } { $examples { $example - "USING: math.parser sequences ;" + "USING: math sequences prettyprint ;" "3 iota [ sq ] map ." - "{ \"0\" \"1\" \"2\" }" + "{ 0 1 4 }" } } ; diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 80352faf72..9adc6bc602 100644 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -276,4 +276,8 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ; { 3 0 } [ [ 3drop ] 3each ] must-infer-as -[ V{ 0 3 } ] [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test \ No newline at end of file +[ V{ 0 3 } ] [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test + +[ "asdf" iota ] must-fail +[ T{ iota { n 10 } } ] [ 10 iota ] unit-test +[ 0 ] [ 10 iota first ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 2a499845bd..5a92dcaf2d 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -101,11 +101,15 @@ M: integer nth-unsafe drop ; INSTANCE: integer immutable-sequence +PRIVATE> + ! In the future, this will replace integer sequences -TUPLE: iota { n read-only } ; +TUPLE: iota { n integer read-only } ; : iota ( n -- iota ) \ iota boa ; inline +> ; M: iota nth-unsafe drop ; From da20ea83af71df9cdb0a70db90a753f1361c325f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 10 Jan 2009 18:13:16 -0600 Subject: [PATCH 18/37] Minor parser docs fix --- core/parser/parser-docs.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 625c1e9c43..4da76468e8 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -34,6 +34,7 @@ ARTICLE: "defining-words" "Defining words" { $see POSTPONE: SYMBOL: } "The key factor in the definition of " { $link POSTPONE: SYMBOL: } " is " { $link CREATE } ", which reads a token from the input and creates a word with that name. This word is then passed to " { $link define-symbol } "." { $subsection CREATE } +{ $subsection CREATE-WORD } "Colon definitions are defined in a more elaborate way:" { $subsection POSTPONE: : } "The " { $link POSTPONE: : } " word first calls " { $link CREATE } ", and then reads input until reaching " { $link POSTPONE: ; } " using a utility word:" From eaa920bc19d04e664d1483a1357b48686c4f8323 Mon Sep 17 00:00:00 2001 From: Tim Allen Date: Sun, 11 Jan 2009 13:12:52 +1100 Subject: [PATCH 19/37] Make line-numbering more reliable in gvim. --- basis/editors/gvim/gvim.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/editors/gvim/gvim.factor b/basis/editors/gvim/gvim.factor index ad6fb65cfb..8fb4d6b23d 100644 --- a/basis/editors/gvim/gvim.factor +++ b/basis/editors/gvim/gvim.factor @@ -8,7 +8,7 @@ SINGLETON: gvim HOOK: gvim-path io-backend ( -- path ) M: gvim vim-command ( file line -- string ) - [ gvim-path , swap , "+" swap number>string append , ] { } make ; + [ gvim-path , "+" swap number>string append , , ] { } make ; gvim vim-editor set-global From 8e273b671317fc80e6cb621c435dd497e23cda4e Mon Sep 17 00:00:00 2001 From: Tim Allen Date: Sun, 11 Jan 2009 13:13:31 +1100 Subject: [PATCH 20/37] Fix USING: in editors.vim.generate-syntax --- basis/editors/vim/generate-syntax/generate-syntax.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/editors/vim/generate-syntax/generate-syntax.factor b/basis/editors/vim/generate-syntax/generate-syntax.factor index 325a451a0b..74b04c346f 100644 --- a/basis/editors/vim/generate-syntax/generate-syntax.factor +++ b/basis/editors/vim/generate-syntax/generate-syntax.factor @@ -1,6 +1,5 @@ ! Generate a new factor.vim file for syntax highlighting -USING: http.server.templating http.server.templating.fhtml -io.files ; +USING: html.templates html.templates.fhtml io.files io.pathnames ; IN: editors.vim.generate-syntax : generate-vim-syntax ( -- ) From 342e459ebedbd1b79351ca9986dcd47447e2b491 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 10 Jan 2009 23:41:50 -0600 Subject: [PATCH 21/37] Add ui-tools link to tools article --- basis/help/handbook/handbook.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 69c2046834..f63bb35f65 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -209,7 +209,8 @@ ARTICLE: "tools" "Developer tools" { $subsection "timing" } { $subsection "tools.disassembler" } "Deployment tools:" -{ $subsection "tools.deploy" } ; +{ $subsection "tools.deploy" } +{ $see-also "ui-tools" } ; ARTICLE: "article-index" "Article index" { $index [ articles get keys ] } ; From bb7c82a9aacf4fe2018e6f7e332813570210cba3 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 11 Jan 2009 14:15:26 +0100 Subject: [PATCH 22/37] FUEL: Fix for float highlight (+ en exp) and small tweaks. --- extra/fuel/fuel.factor | 9 +++++---- misc/fuel/factor-mode.el | 2 +- misc/fuel/fuel-eval.el | 4 ++-- misc/fuel/fuel-syntax.el | 2 +- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 07454a73f0..67ddc8fcd9 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -6,7 +6,8 @@ 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 tools.vocabs.browser vectors vocabs vocabs.parser words ; +tools.vocabs tools.vocabs.browser vectors vocabs vocabs.parser +vocabs.loader words ; IN: fuel @@ -330,7 +331,7 @@ SYMBOL: vocab-list [ describe-words ] with-string-writer \ describe-words swap 2array ; inline : (fuel-vocab-help) ( name -- element ) - \ article swap dup >vocab-link + dup require \ article swap dup >vocab-link [ { [ vocab-authors [ \ $authors prefix , ] when* ] @@ -360,12 +361,12 @@ MEMO: (fuel-get-vocabs/author) ( author -- element ) : fuel-get-vocabs/author ( author -- ) (fuel-get-vocabs/author) fuel-eval-set-result ; -MEMO: (fuel-get-vocabs/tag ( tag -- element ) +MEMO: (fuel-get-vocabs/tag) ( tag -- element ) [ "Vocabularies tagged " prepend \ $heading swap 2array ] [ tagged fuel-vocab-list ] bi 2array ; : fuel-get-vocabs/tag ( tag -- ) - (fuel-get-vocabs/tag fuel-eval-set-result ; + (fuel-get-vocabs/tag) fuel-eval-set-result ; ! -run=fuel support diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index d3a633910c..d862b71da0 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -239,7 +239,7 @@ code in the buffer." ;;; Keymap: (defun factor-mode-insert-and-indent (n) - (interactive "p") + (interactive "*p") (self-insert-command n) (indent-according-to-mode)) diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 149e608964..543d23bd3f 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -42,7 +42,7 @@ (factor (case sexp (:rs 'fuel-eval-restartable) (:nrs 'fuel-eval-non-restartable) - (:in (fuel-syntax--current-vocab)) + (:in (or (fuel-syntax--current-vocab) "fuel")) (:usings `(:array ,@(fuel-syntax--usings))) (:get 'fuel-eval-set-result) (:end '\;) @@ -70,7 +70,7 @@ (defsubst factor--fuel-in (in) (cond ((or (eq in :in) (null in)) :in) ((eq in 'f) 'f) - ((eq in 't) "fuel-scratchpad") + ((eq in 't) "fuel") ((stringp in) in) (t (error "Invalid 'in' (%s)" in)))) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 93274c5160..384838af12 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -91,7 +91,7 @@ "\\_<-?\\([0-9]+\\+\\)?[0-9]+/-?[0-9]+\\_>") (defconst fuel-syntax--float-regex - "\\_<-?[0-9]+\\.[0-9]*\\([eE]-?[0-9]+\\)?\\_>") + "\\_<-?[0-9]+\\.[0-9]*\\([eE][+-]?[0-9]+\\)?\\_>") (defconst fuel-syntax--word-definition-regex (fuel-syntax--second-word-regex From 732c525eaa6dda2f0b16159973414c8ee2c81ee7 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 11 Jan 2009 14:29:55 +0100 Subject: [PATCH 23/37] FUEL: Fix for indentation after brace-words. --- misc/fuel/fuel-syntax.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 384838af12..e8c5d296ad 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -63,12 +63,12 @@ "UNION:" "USE:" "USING:" "VARS:")) -(defconst fuel-syntax--bracers - '("B" "BV" "C" "CS" "H" "T" "V" "W")) - (defconst fuel-syntax--parsing-words-regex (regexp-opt fuel-syntax--parsing-words 'words)) +(defconst fuel-syntax--bracers + '("B" "BV" "C" "CS" "H" "T" "V" "W")) + (defconst fuel-syntax--brace-words-regex (format "%s{" (regexp-opt fuel-syntax--bracers t))) @@ -216,8 +216,7 @@ (" \\(|\\) " (1 "(|")) (" \\(|\\)$" (1 ")")) ;; Opening brace words: - (,(format "\\_<%s\\({\\)\\_>" (regexp-opt fuel-syntax--bracers)) (1 "(}")) - ("\\_<\\({\\)\\_>" (1 "(}")) + ("\\_<\\w*\\({\\)\\_>" (1 "(}")) ("\\_<\\(}\\)\\_>" (1 "){")) ;; Parenthesis: ("\\_<\\((\\)\\_>" (1 "()")) From 608352f3134d6ddb8547eb28838ae17ad95fb989 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 11 Jan 2009 16:28:02 +0100 Subject: [PATCH 24/37] FUEL: Workaround for comint mode hang up. --- misc/fuel/fuel-listener.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index d4fa5aed1f..c6835ede6b 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -102,6 +102,8 @@ buffer." (defun fuel-listener-nuke () (interactive) + (goto-char (point-max)) + (comint-kill-region comint-last-input-start (point)) (comint-redirect-cleanup) (fuel-con--setup-connection fuel-listener--buffer)) From 9efc31186ec8987282a43ccdb36876805eeba1fb Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 11 Jan 2009 10:54:49 -0600 Subject: [PATCH 25/37] L-system: Call 'set-color' in 'restore-turtle' --- extra/L-system/L-system.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor index 5bc7ce1db6..0dbf94b1c6 100644 --- a/extra/L-system/L-system.factor +++ b/extra/L-system/L-system.factor @@ -207,7 +207,8 @@ DEFER: default-L-parser-values ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : save-turtle ( turtle -- turtle ) dup clone over saved>> push ; -: restore-turtle ( turtle -- turtle ) saved>> pop ; + +: restore-turtle ( turtle -- turtle ) saved>> pop dup color>> set-color ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 4543590ca9e6b6d07bc77c03ceec5bdcccfe19ef Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 11 Jan 2009 18:01:52 +0100 Subject: [PATCH 26/37] FUEL: Electric indentation for ] and } fixed. --- misc/fuel/factor-mode.el | 12 +++++++----- misc/fuel/fuel-font-lock.el | 1 - misc/fuel/fuel-syntax.el | 2 +- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index d862b71da0..4164e14c5e 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -111,7 +111,7 @@ code in the buffer." (= (- be (point)) (current-indentation)) (= ln (line-number-at-pos be))) (fuel-syntax--indentation-at bs)) - ((or (fuel-syntax--is-eol bs) + ((or (fuel-syntax--is-last-char bs) (not (eq ?\ (char-after (1+ bs))))) (fuel-syntax--increased-indentation (fuel-syntax--indentation-at bs))) @@ -238,15 +238,17 @@ code in the buffer." ;;; Keymap: -(defun factor-mode-insert-and-indent (n) +(defun factor-mode--insert-and-indent (n) (interactive "*p") - (self-insert-command n) + (let ((start (point))) + (self-insert-command n) + (save-excursion (font-lock-fontify-region start (point)))) (indent-according-to-mode)) (defvar factor-mode-map (let ((map (make-sparse-keymap))) - (define-key map [?\]] 'factor-mode-insert-and-indent) - (define-key map [?}] 'factor-mode-insert-and-indent) + (define-key map [?\]] 'factor-mode--insert-and-indent) + (define-key map [?}] 'factor-mode--insert-and-indent) (define-key map "\C-m" 'newline-and-indent) (define-key map "\C-co" 'factor-mode-visit-other-file) (define-key map "\C-c\C-o" 'factor-mode-visit-other-file) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index bcddf82d18..b12be1eac7 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -107,7 +107,6 @@ (list (cons 'font-lock-syntactic-keywords fuel-syntax--syntactic-keywords)))))) - ;;; Fontify strings as Factor code: diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index e8c5d296ad..8bb7a6d6ef 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -260,7 +260,7 @@ (defsubst fuel-syntax--looking-at-emptiness () (looking-at "^[ ]*$\\|$")) -(defsubst fuel-syntax--is-eol (pos) +(defsubst fuel-syntax--is-last-char (pos) (save-excursion (goto-char (1+ pos)) (fuel-syntax--looking-at-emptiness))) From 421c11d7a93367067d9a2b8040f523d39aabc953 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 11 Jan 2009 11:02:48 -0600 Subject: [PATCH 27/37] Add L-system.models.tree-5 --- extra/L-system/models/tree-5/tree-5.factor | 37 ++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 extra/L-system/models/tree-5/tree-5.factor diff --git a/extra/L-system/models/tree-5/tree-5.factor b/extra/L-system/models/tree-5/tree-5.factor new file mode 100644 index 0000000000..2647698351 --- /dev/null +++ b/extra/L-system/models/tree-5/tree-5.factor @@ -0,0 +1,37 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.tree-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: tree-5 ( -- ) + + L-parser-dialect >>commands + + [ 5 >>angle ] >>turtle-values + + "c(4)FFS" >>axiom + + { + { "S" "FFR>(60)R>(60)R>(60)R>(60)R>(60)R>(30)S" } + { "R" "[Ba]" } + { "a" "$tF[Cx]Fb" } + { "b" "$tF[Dy]Fa" } + { "B" "&B" } + { "C" "+C" } + { "D" "-D" } + + { "x" "a" } + { "y" "b" } + + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system tree-5 "L-system" open-window ] with-ui ; + +MAIN: main + \ No newline at end of file From 09aeeadded9de0fe485115f73b744b4ce03f3b45 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 11 Jan 2009 11:03:42 -0600 Subject: [PATCH 28/37] Initial checkin of 'git-tool' --- extra/git-tool/git-tool.factor | 440 +++++++++++++++++++++++++++++++++ 1 file changed, 440 insertions(+) create mode 100644 extra/git-tool/git-tool.factor diff --git a/extra/git-tool/git-tool.factor b/extra/git-tool/git-tool.factor new file mode 100644 index 0000000000..2b692f0963 --- /dev/null +++ b/extra/git-tool/git-tool.factor @@ -0,0 +1,440 @@ + +USING: accessors combinators.cleave combinators.short-circuit +concurrency.combinators destructors fry io io.directories +io.encodings io.encodings.utf8 io.launcher io.pathnames +io.pipes io.ports kernel locals math namespaces sequences +splitting strings ui ui.gadgets ui.gadgets.buttons +ui.gadgets.editors ui.gadgets.labels ui.gadgets.packs +ui.gadgets.tracks ; + +IN: git-status + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: head** ( seq obj -- seq/f ) dup number? [ head ] [ dupd find drop head ] if ; + +: tail** ( seq obj -- seq/f ) + dup number? + [ tail ] + [ dupd find drop [ tail ] [ drop f ] if* ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: ( DESC -- process stream stream ) + [ + [let | STDOUT-PIPE [ (pipe) |dispose ] + STDERR-PIPE [ (pipe) |dispose ] | + + [let | PROCESS [ DESC >process ] | + + PROCESS + [ STDOUT-PIPE out>> or ] change-stdout + [ STDERR-PIPE out>> or ] change-stderr + run-detached + + STDOUT-PIPE out>> dispose + STDERR-PIPE out>> dispose + + STDOUT-PIPE in>> utf8 + STDERR-PIPE in>> utf8 ] ] + ] + with-destructors ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: run-process/result ( desc -- process ) + + { + [ contents [ string-lines ] [ f ] if* ] + [ contents [ string-lines ] [ f ] if* ] + } + parallel-spread + [ >>stdout ] [ >>stderr ] bi* + dup wait-for-process >>status ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! process popup windows +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: popup-window ( title contents -- ) + dup string? [ ] [ "\n" join ] if + tuck set-editor-string swap open-window ; + +: popup-process-window ( process -- ) + [ stdout>> [ "output" swap popup-window ] when* ] + [ stderr>> [ "error" swap popup-window ] when* ] + [ + [ stdout>> ] [ stderr>> ] bi or not + [ "Process" "NO OUTPUT" popup-window ] + when + ] + tri ; + +: popup-if-error ( process -- ) + { [ status>> 0 = not ] [ popup-process-window t ] } 1&& drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: git-process ( REPO DESC -- process ) + REPO [ DESC run-process/result ] with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: git-status-section ( lines section -- lines/f ) + '[ _ = ] tail** + [ + [ "#\t" head? ] tail** + [ "#\t" head? not ] head** + [ 2 tail ] map + ] + [ f ] + if* ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: colon ( -- ch ) CHAR: : ; +: space ( -- ch ) 32 ; + +: git-status-line-file ( line -- file ) + { [ colon = ] 1 [ space = not ] } [ tail** ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: + repository + to-commit-new + to-commit-modified + to-commit-deleted + modified + deleted + untracked ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: check-empty ( seq -- seq/f ) dup empty? [ drop f ] when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: refresh-git-status ( GIT-STATUS -- GIT-STATUS ) + + [let | LINES [ GIT-STATUS repository>> "git-status" git-process stdout>> ] | + + GIT-STATUS + + LINES "# Changes to be committed:" git-status-section + [ "new file:" head? ] filter + [ git-status-line-file ] map + check-empty + >>to-commit-new + + LINES "# Changes to be committed:" git-status-section + [ "modified:" head? ] filter + [ git-status-line-file ] map + check-empty + >>to-commit-modified + + LINES "# Changes to be committed:" git-status-section + [ "deleted:" head? ] filter + [ git-status-line-file ] map + check-empty + >>to-commit-deleted + + LINES "# Changed but not updated:" git-status-section + [ "modified:" head? ] filter + [ git-status-line-file ] map + check-empty + >>modified + + LINES "# Changed but not updated:" git-status-section + [ "deleted:" head? ] filter + [ git-status-line-file ] map + check-empty + >>deleted + + LINES "# Untracked files:" git-status-section >>untracked ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: git-status ( REPO -- ) + + new REPO >>repository refresh-git-status ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: factor-git-status ( -- ) "resource:" git-status ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! git-tool +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: to-commit ( -- seq ) + { to-commit-new>> to-commit-modified>> to-commit-deleted>> } 1arr concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: refresh-status-pile ( STATUS PILE -- ) + + STATUS refresh-git-status drop + + PILE clear-gadget + + PILE + + ! Commit section + + [wlet | add-commit-path-button [| TEXT PATH | + + { 1 0 } + + TEXT