Merge branch 'master' of git://factorcode.org/git/factor
Daniel Ehrenberg
commit
a860ae82f1
|
|
@ -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
|
|||
|
||||
[ "<p>hello_world how are you today?\n<ul><li> hello_world how are you today?</li></ul></p>" ]
|
||||
[ "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
|
||||
[ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test
|
||||
[ "&blah;" ] [ "[[&blah;]]" check-link-escaping ] unit-test
|
||||
[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <groups> } " and " { $link <sliced-groups> } "." }
|
||||
{ $see-also group } ;
|
||||
"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." } ;
|
||||
|
||||
HELP: group
|
||||
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
|
||||
|
|
@ -48,11 +47,16 @@ HELP: <groups>
|
|||
"USING: arrays kernel prettyprint sequences grouping ;"
|
||||
"9 >array 3 <groups> 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 <groups> 0 swap nth ."
|
||||
"{ 1 2 3 }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: <sliced-groups>
|
||||
{ $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: <sliced-groups>
|
|||
"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 <sliced-groups> 1 swap nth ."
|
||||
"T{ slice { from 3 } { to 6 } { seq { 1 2 3 4 5 6 } } }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: clumps
|
||||
|
|
@ -89,11 +98,23 @@ HELP: <clumps>
|
|||
"share-price 4 <clumps> [ [ 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 <clumps> second ."
|
||||
"{ 2 3 4 }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: <sliced-clumps>
|
||||
{ $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 <sliced-clumps> second ."
|
||||
"T{ slice { from 1 } { to 4 } { seq { 1 2 3 4 5 6 } } }"
|
||||
}
|
||||
} ;
|
||||
|
||||
{ clumps groups } related-words
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
@ -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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: directory-iterator path bfs queue ;
|
||||
|
||||
: qualified-directory ( path -- seq )
|
||||
dup directory-files [ append-path ] with map ;
|
||||
|
||||
|
|
@ -38,22 +38,25 @@ TUPLE: directory-iterator path bfs queue ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: each-file ( path bfs? quot: ( obj -- ) -- )
|
||||
[ <directory-iterator> ] dip
|
||||
[ f ] compose iterate-directory drop ; inline
|
||||
|
||||
: recursive-directory ( path bfs? -- paths )
|
||||
[ ] accumulator [ each-file ] dip ;
|
||||
|
||||
: find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
|
||||
[ <directory-iterator> ] dip
|
||||
[ keep and ] curry iterate-directory ; inline
|
||||
|
||||
: each-file ( path bfs? quot: ( obj -- ? ) -- )
|
||||
[ <directory-iterator> ] dip
|
||||
[ f ] compose iterate-directory drop ; inline
|
||||
|
||||
: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths )
|
||||
[ <directory-iterator> ] 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -47,17 +47,18 @@ SYMBOL: user-cache
|
|||
: with-user-cache ( quot -- )
|
||||
[ <user-cache> 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>> ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 tools.vocabs.browser vectors vocabs vocabs.parser words ;
|
||||
|
||||
IN: fuel
|
||||
|
||||
|
|
@ -74,6 +74,8 @@ M: sequence fuel-pprint
|
|||
|
||||
M: tuple fuel-pprint tuple>array fuel-pprint ; inline
|
||||
|
||||
M: quotation fuel-pprint pprint ; inline
|
||||
|
||||
M: continuation fuel-pprint drop ":continuation" write ; inline
|
||||
|
||||
M: restart fuel-pprint name>> fuel-pprint ; inline
|
||||
|
|
@ -163,18 +165,22 @@ SYMBOL: :uses
|
|||
! Edit locations
|
||||
|
||||
: fuel-normalize-loc ( seq -- path line )
|
||||
dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
|
||||
[ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
|
||||
[ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
|
||||
|
||||
: fuel-get-edit-location ( defspec -- )
|
||||
: fuel-get-edit-location ( word -- )
|
||||
where fuel-normalize-loc 2array fuel-eval-set-result ; inline
|
||||
|
||||
: fuel-get-vocab-location ( vocab -- )
|
||||
>vocab-link fuel-get-edit-location ; inline
|
||||
|
||||
: fuel-get-doc-location ( defspec -- )
|
||||
: fuel-get-doc-location ( word -- )
|
||||
props>> "help-loc" swap at
|
||||
fuel-normalize-loc 2array fuel-eval-set-result ;
|
||||
|
||||
: fuel-get-article-location ( name -- )
|
||||
article loc>> fuel-normalize-loc 2array fuel-eval-set-result ;
|
||||
|
||||
! Cross-references
|
||||
|
||||
: fuel-word>xref ( word -- xref )
|
||||
|
|
@ -292,16 +298,49 @@ MEMO: fuel-find-word ( name -- word/f )
|
|||
fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
|
||||
fuel-eval-set-result ; inline
|
||||
|
||||
: fuel-vocab-help-row ( vocab -- element )
|
||||
[ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
|
||||
|
||||
: fuel-vocab-help-root-heading ( root -- element )
|
||||
[ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
|
||||
|
||||
SYMBOL: vocab-list
|
||||
|
||||
: fuel-vocab-help-table ( vocabs -- element )
|
||||
[ fuel-vocab-help-row ] map vocab-list prefix ;
|
||||
|
||||
: fuel-vocab-list ( assoc -- seq )
|
||||
[
|
||||
[ drop f ] [
|
||||
[ fuel-vocab-help-root-heading ]
|
||||
[ fuel-vocab-help-table ] bi*
|
||||
[ 2array ] [ drop f ] if*
|
||||
] if-empty
|
||||
] { } assoc>map [ ] filter ;
|
||||
|
||||
: fuel-vocab-children-help ( name -- element )
|
||||
all-child-vocabs fuel-vocab-list ; inline
|
||||
|
||||
: fuel-vocab-describe-words ( name -- element )
|
||||
[ describe-words ] with-string-writer \ describe-words swap 2array ; inline
|
||||
|
||||
: (fuel-vocab-help) ( name -- element )
|
||||
\ article swap dup >vocab-link
|
||||
[
|
||||
[ summary [ , ] [ "No summary available" , ] if* ]
|
||||
[ drop \ $nl , ]
|
||||
[ vocab-help article [ content>> % ] when* ] tri
|
||||
{
|
||||
[ 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-describe-words , ]
|
||||
[ name>> fuel-vocab-children-help % ]
|
||||
} cleave
|
||||
] { } make 3array ;
|
||||
|
||||
: fuel-vocab-help ( name -- )
|
||||
(fuel-vocab-help) fuel-eval-set-result ; inline
|
||||
dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
|
||||
fuel-eval-set-result ; inline
|
||||
|
||||
: (fuel-index) ( seq -- seq )
|
||||
[ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
|
||||
|
|
@ -309,6 +348,21 @@ MEMO: fuel-find-word ( name -- word/f )
|
|||
: fuel-index ( quot: ( -- seq ) -- )
|
||||
call (fuel-index) fuel-eval-set-result ; inline
|
||||
|
||||
MEMO: (fuel-get-vocabs/author) ( author -- element )
|
||||
[ "Vocabularies by " prepend \ $heading swap 2array ]
|
||||
[ authored fuel-vocab-list ] bi 2array ;
|
||||
|
||||
: fuel-get-vocabs/author ( author -- )
|
||||
(fuel-get-vocabs/author) fuel-eval-set-result ;
|
||||
|
||||
MEMO: (fuel-get-vocabs/tag ( tag -- element )
|
||||
[ "Vocabularies tagged " prepend \ $heading swap 2array ]
|
||||
[ tagged fuel-vocab-list ] bi 2array ;
|
||||
|
||||
: fuel-get-vocabs/tag ( tag -- )
|
||||
(fuel-get-vocabs/tag fuel-eval-set-result ;
|
||||
|
||||
|
||||
! -run=fuel support
|
||||
|
||||
: fuel-startup ( -- ) "listener" run-file ; inline
|
||||
|
|
|
|||
|
|
@ -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? ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Samuel Tardieu
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Eratosthene sieve
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (factor) ( n d -- n' )
|
||||
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
|
||||
: count-factor ( n d -- n' c )
|
||||
0 [ [ 2dup mod zero? ] dip swap ] [ [ [ / ] keep ] dip 1+ ] [ ] while nip ;
|
||||
|
||||
: (factor) ( n d -- n' ) dup [ , ] curry [ count-factor ] dip times ;
|
||||
|
||||
: (count) ( n d -- n' )
|
||||
[ (factor) ] { } make
|
||||
[ [ first ] [ length ] bi 2array , ] unless-empty ;
|
||||
dup [ swap 2array , ] curry
|
||||
[ count-factor dup zero? [ drop ] ] dip if ;
|
||||
|
||||
: (unique) ( n d -- n' )
|
||||
[ (factor) ] { } make
|
||||
[ first , ] unless-empty ;
|
||||
dup [ , ] curry [ count-factor zero? ] dip unless ;
|
||||
|
||||
: (factors) ( quot list n -- )
|
||||
dup 1 > [
|
||||
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 < [
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
USING: math.primes memoize ;
|
||||
IN: math.primes.list
|
||||
|
||||
MEMO: primes-under-million ( -- seq ) 1000000 primes-upto ;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
USING: project-euler.057 tools.test ;
|
||||
|
||||
{ 153 } [ euler057 ] unit-test
|
||||
|
|
@ -95,13 +95,17 @@ beast.
|
|||
*** In the help browser:
|
||||
|
||||
- h : help for word at point
|
||||
- v : help for a vocabulary
|
||||
- a : find words containing given substring (M-x fuel-apropos)
|
||||
- e : edit current article
|
||||
- ba : bookmark current page
|
||||
- bb : display bookmarks
|
||||
- bd : delete bookmark at point
|
||||
- n/p : next/previous page
|
||||
- l : previous page
|
||||
- SPC/S-SPC : scroll up/down
|
||||
- TAB/S-TAB : next/previous link
|
||||
- k : kill current page and go to previous or next
|
||||
- r : refresh page
|
||||
- c : clean browsing history
|
||||
- M-. : edit word at point in Emacs
|
||||
|
|
@ -112,4 +116,5 @@ beast.
|
|||
|
||||
- TAB/BACKTAB : navigate links
|
||||
- RET/mouse click : follow link
|
||||
- h : show help for word at point
|
||||
- q : bury buffer
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; fuel-connection.el -- asynchronous comms with the fuel listener
|
||||
|
||||
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
|
||||
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||||
|
|
@ -193,7 +193,7 @@
|
|||
(condition-case cerr
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(funcall cont (fuel-con--comint-buffer-form))
|
||||
(fuel-log--info "<%s>: processed\n\t%s" id req))
|
||||
(fuel-log--info "<%s>: processed" id))
|
||||
(error (fuel-log--error
|
||||
"<%s>: continuation failed %S \n\t%s" id rstr cerr))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,104 @@
|
|||
;;; fuel-edit.el -- utilities for file editing
|
||||
|
||||
;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||||
;; Keywords: languages, fuel, factor
|
||||
;; Start date: Mon Jan 05, 2009 21:16
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Locating and opening factor source and documentation files.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Auxiliar functions:
|
||||
|
||||
(defun fuel-edit--try-edit (ret)
|
||||
(let* ((err (fuel-eval--retort-error ret))
|
||||
(loc (fuel-eval--retort-result ret)))
|
||||
(when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
|
||||
(error "Couldn't find edit location"))
|
||||
(unless (file-readable-p (car loc))
|
||||
(error "Couldn't open '%s' for read" (car loc)))
|
||||
(find-file-other-window (car loc))
|
||||
(goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
|
||||
|
||||
(defun fuel-edit--read-vocabulary-name (refresh)
|
||||
(let* ((vocabs (fuel-completion--vocabs refresh))
|
||||
(prompt "Vocabulary name: "))
|
||||
(if vocabs
|
||||
(completing-read prompt vocabs nil nil nil fuel-edit--vocab-history)
|
||||
(read-string prompt nil fuel-edit--vocab-history))))
|
||||
|
||||
(defun fuel-edit--edit-article (name)
|
||||
(let ((cmd `(:fuel* (,name fuel-get-article-location) "fuel" t)))
|
||||
(fuel-edit--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
|
||||
;;; Editing commands:
|
||||
|
||||
(defvar fuel-edit--word-history nil)
|
||||
(defvar fuel-edit--vocab-history nil)
|
||||
|
||||
(defun fuel-edit-vocabulary (&optional refresh vocab)
|
||||
"Visits vocabulary file in Emacs.
|
||||
When called interactively, asks for vocabulary with completion.
|
||||
With prefix argument, refreshes cached vocabulary list."
|
||||
(interactive "P")
|
||||
(let* ((vocab (or vocab (fuel-edit--read-vocabulary-name refresh)))
|
||||
(cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
|
||||
(fuel-edit--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
(defun fuel-edit-word (&optional arg)
|
||||
"Asks for a word to edit, with completion.
|
||||
With prefix, only words visible in the current vocabulary are
|
||||
offered."
|
||||
(interactive "P")
|
||||
(let* ((word (fuel-completion--read-word "Edit word: "
|
||||
nil
|
||||
fuel-edit--word-history
|
||||
arg))
|
||||
(cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
|
||||
(fuel-edit--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
(defun fuel-edit-word-at-point (&optional arg)
|
||||
"Opens a new window visiting the definition of the word at point.
|
||||
With prefix, asks for the word to edit."
|
||||
(interactive "P")
|
||||
(let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
|
||||
(fuel-completion--read-word "Edit word: ")))
|
||||
(cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
|
||||
(condition-case nil
|
||||
(fuel-edit--try-edit (fuel-eval--send/wait cmd))
|
||||
(error (fuel-edit-vocabulary nil word)))))
|
||||
|
||||
(defun fuel-edit-word-doc-at-point (&optional arg word)
|
||||
"Opens a new window visiting the documentation file for the word at point.
|
||||
With prefix, asks for the word to edit."
|
||||
(interactive "P")
|
||||
(let* ((word (or word
|
||||
(and (not arg) (fuel-syntax-symbol-at-point))
|
||||
(fuel-completion--read-word "Edit word: ")))
|
||||
(cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
|
||||
(condition-case nil
|
||||
(fuel-edit--try-edit (fuel-eval--send/wait cmd))
|
||||
(error
|
||||
(message "Documentation for '%s' not found" word)
|
||||
(when (and (eq major-mode 'factor-mode)
|
||||
(y-or-n-p (concat "No documentation found. "
|
||||
"Do you want to open the vocab's "
|
||||
"doc file? ")))
|
||||
(find-file-other-window
|
||||
(format "%s-docs.factor"
|
||||
(file-name-sans-extension (buffer-file-name)))))))))
|
||||
|
||||
|
||||
(provide 'fuel-edit)
|
||||
;;; fuel-edit.el ends here
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;;; fuel-eval.el --- evaluating Factor expressions
|
||||
|
||||
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
|
||||
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||||
|
|
@ -13,9 +13,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-connection)
|
||||
(require 'fuel-log)
|
||||
(require 'fuel-base)
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
|
|
@ -125,6 +126,7 @@
|
|||
(fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
|
||||
|
||||
(defun fuel-eval--parse-retort (ret)
|
||||
(fuel-log--info "RETORT: %S" ret)
|
||||
(if (fuel-eval--retort-p ret) ret
|
||||
(fuel-eval--make-parse-error-retort ret)))
|
||||
|
||||
|
|
|
|||
|
|
@ -14,11 +14,12 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-edit)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-markup)
|
||||
(require 'fuel-autodoc)
|
||||
(require 'fuel-xref)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-popup)
|
||||
(require 'fuel-base)
|
||||
|
|
@ -67,15 +68,15 @@
|
|||
(setcar fuel-help--history link))))
|
||||
link)
|
||||
|
||||
(defun fuel-help--history-next ()
|
||||
(defun fuel-help--history-next (&optional forget-current)
|
||||
(when (not (ring-empty-p (nth 2 fuel-help--history)))
|
||||
(when (car fuel-help--history)
|
||||
(when (and (car fuel-help--history) (not forget-current))
|
||||
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
|
||||
(setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
|
||||
|
||||
(defun fuel-help--history-previous ()
|
||||
(defun fuel-help--history-previous (&optional forget-current)
|
||||
(when (not (ring-empty-p (nth 1 fuel-help--history)))
|
||||
(when (car fuel-help--history)
|
||||
(when (and (car fuel-help--history) (not forget-current))
|
||||
(ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
|
||||
(setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
|
||||
|
||||
|
|
@ -114,10 +115,9 @@
|
|||
(let* ((def (fuel-syntax-symbol-at-point))
|
||||
(prompt (format "See%s help on%s: " (if see " short" "")
|
||||
(if def (format " (%s)" def) "")))
|
||||
(ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
|
||||
(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)
|
||||
|
|
@ -129,7 +129,7 @@
|
|||
(let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help))
|
||||
"fuel" t)))
|
||||
(message "Looking up '%s' ..." def)
|
||||
(let* ((ret (fuel-eval--send/wait cmd 2000))
|
||||
(let* ((ret (fuel-eval--send/wait cmd))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(if (not res)
|
||||
(message "No help for '%s'" def)
|
||||
|
|
@ -138,7 +138,7 @@
|
|||
(defun fuel-help--get-article (name label)
|
||||
(message "Retrieving article ...")
|
||||
(let* ((cmd `(:fuel* ((,name fuel-get-article)) "fuel" t))
|
||||
(ret (fuel-eval--send/wait cmd 2000))
|
||||
(ret (fuel-eval--send/wait cmd))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(if (not res)
|
||||
(message "Article '%s' not found" label)
|
||||
|
|
@ -146,15 +146,35 @@
|
|||
(message ""))))
|
||||
|
||||
(defun fuel-help--get-vocab (name)
|
||||
(message "Retrieving vocabulary help ...")
|
||||
(message "Retrieving help vocabulary for vocabulary '%s' ..." name)
|
||||
(let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name)))
|
||||
(ret (fuel-eval--send/wait cmd 2000))
|
||||
(ret (fuel-eval--send/wait cmd))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(if (not res)
|
||||
(message "No help available for vocabulary '%s'" name)
|
||||
(fuel-help--insert-contents (list name name 'vocab) res)
|
||||
(message ""))))
|
||||
|
||||
(defun fuel-help--get-vocab/author (author)
|
||||
(message "Retrieving vocabularies by %s ..." author)
|
||||
(let* ((cmd `(:fuel* ((,author fuel-get-vocabs/author)) "fuel" t))
|
||||
(ret (fuel-eval--send/wait cmd))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(if (not res)
|
||||
(message "No vocabularies by %s" author)
|
||||
(fuel-help--insert-contents (list author author 'author) res)
|
||||
(message ""))))
|
||||
|
||||
(defun fuel-help--get-vocab/tag (tag)
|
||||
(message "Retrieving vocabularies tagged '%s' ..." tag)
|
||||
(let* ((cmd `(:fuel* ((,tag fuel-get-vocabs/tag)) "fuel" t))
|
||||
(ret (fuel-eval--send/wait cmd))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(if (not res)
|
||||
(message "No vocabularies tagged '%s'" tag)
|
||||
(fuel-help--insert-contents (list tag tag 'tag) res)
|
||||
(message ""))))
|
||||
|
||||
(defun fuel-help--follow-link (link label type &optional no-cache)
|
||||
(let* ((llink (list link label type))
|
||||
(cached (and (not no-cache) (fuel-help--cache-get llink))))
|
||||
|
|
@ -163,6 +183,8 @@
|
|||
(cond ((eq type 'word) (fuel-help--word-help nil link))
|
||||
((eq type 'article) (fuel-help--get-article link label))
|
||||
((eq type 'vocab) (fuel-help--get-vocab link))
|
||||
((eq type 'author) (fuel-help--get-vocab/author label))
|
||||
((eq type 'tag) (fuel-help--get-vocab/tag label))
|
||||
((eq type 'bookmarks) (fuel-help-display-bookmarks))
|
||||
(t (error "Links of type %s not yet implemented" type))))
|
||||
(fuel-help--insert-contents llink cached))))
|
||||
|
|
@ -177,6 +199,7 @@
|
|||
(insert content)
|
||||
(fuel-markup--print content)
|
||||
(fuel-markup--insert-newline)
|
||||
(delete-blank-lines)
|
||||
(fuel-help--cache-insert key (buffer-string)))
|
||||
(fuel-help--history-push key)
|
||||
(setq fuel-help--buffer-link key)
|
||||
|
|
@ -231,20 +254,34 @@ buffer."
|
|||
(interactive)
|
||||
(fuel-help--word-help))
|
||||
|
||||
(defun fuel-help-next ()
|
||||
"Go to next page in help browser."
|
||||
(interactive)
|
||||
(let ((item (fuel-help--history-next)))
|
||||
(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."
|
||||
(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)
|
||||
|
|
@ -260,6 +297,15 @@ buffer."
|
|||
(fuel-help-refresh))
|
||||
(message ""))
|
||||
|
||||
(defun fuel-help-edit ()
|
||||
"Edit the current article or word help."
|
||||
(interactive)
|
||||
(let ((link (car fuel-help--buffer-link))
|
||||
(type (nth 2 fuel-help--buffer-link)))
|
||||
(cond ((eq type 'word) (fuel-edit-word-doc-at-point nil link))
|
||||
((member type '(article vocab)) (fuel-edit--edit-article link))
|
||||
(t (error "No document associated with this page")))))
|
||||
|
||||
|
||||
;;;; Help mode map:
|
||||
|
||||
|
|
@ -272,10 +318,14 @@ buffer."
|
|||
(define-key map "bb" 'fuel-help-display-bookmarks)
|
||||
(define-key map "bd" 'fuel-help-delete-bookmark)
|
||||
(define-key map "c" 'fuel-help-clean-history)
|
||||
(define-key map "e" 'fuel-help-edit)
|
||||
(define-key map "h" 'fuel-help)
|
||||
(define-key map "k" 'fuel-help-kill-page)
|
||||
(define-key map "n" 'fuel-help-next)
|
||||
(define-key map "l" 'fuel-help-previous)
|
||||
(define-key map "p" 'fuel-help-previous)
|
||||
(define-key map "r" 'fuel-help-refresh)
|
||||
(define-key map "v" 'fuel-help-vocab)
|
||||
(define-key map (kbd "SPC") 'scroll-up)
|
||||
(define-key map (kbd "S-SPC") 'scroll-down)
|
||||
(define-key map "\M-." 'fuel-edit-word-at-point)
|
||||
|
|
@ -283,6 +333,16 @@ buffer."
|
|||
(define-key map "\C-c\C-z" 'run-factor)
|
||||
map))
|
||||
|
||||
|
||||
;;; IN: support
|
||||
|
||||
(defun fuel-help--find-in ()
|
||||
(save-excursion
|
||||
(or (fuel-syntax--find-in)
|
||||
(and (goto-char (point-min))
|
||||
(re-search-forward "Vocabulary: \\(.+\\)$" nil t)
|
||||
(match-string-no-properties 1)))))
|
||||
|
||||
|
||||
;;; Help mode definition:
|
||||
|
||||
|
|
@ -296,6 +356,7 @@ buffer."
|
|||
(set-syntax-table fuel-syntax--syntax-table)
|
||||
(setq mode-name "FUEL Help")
|
||||
(setq major-mode 'fuel-help-mode)
|
||||
(setq fuel-syntax--current-vocab-function 'fuel-help--find-in)
|
||||
(setq fuel-markup--follow-link-function 'fuel-help--follow-link)
|
||||
(setq buffer-read-only t))
|
||||
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@
|
|||
(require 'fuel-eval)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-table)
|
||||
|
||||
(require 'button)
|
||||
(require 'table)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
|
@ -84,12 +84,18 @@
|
|||
;;; Markup printers:
|
||||
|
||||
(defconst fuel-markup--printers
|
||||
'(($class-description . fuel-markup--class-description)
|
||||
'(($all-tags . fuel-markup--all-tags)
|
||||
($all-authors . fuel-markup--all-authors)
|
||||
($author . fuel-markup--author)
|
||||
($authors . fuel-markup--authors)
|
||||
($class-description . fuel-markup--class-description)
|
||||
($code . fuel-markup--code)
|
||||
($command . fuel-markup--command)
|
||||
($command-map . fuel-markup--null)
|
||||
($contract . fuel-markup--contract)
|
||||
($curious . fuel-markup--curious)
|
||||
($definition . fuel-markup--definition)
|
||||
($describe-vocab . fuel-markup--describe-vocab)
|
||||
($description . fuel-markup--description)
|
||||
($doc-path . fuel-markup--doc-path)
|
||||
($emphasis . fuel-markup--emphasis)
|
||||
|
|
@ -110,6 +116,7 @@
|
|||
($methods . fuel-markup--methods)
|
||||
($nl . fuel-markup--newline)
|
||||
($notes . fuel-markup--notes)
|
||||
($operation . fuel-markup--link)
|
||||
($parsing-note . fuel-markup--parsing-note)
|
||||
($predicate . fuel-markup--predicate)
|
||||
($prettyprinting-note . fuel-markup--prettyprinting-note)
|
||||
|
|
@ -128,6 +135,8 @@
|
|||
($synopsis . fuel-markup--synopsis)
|
||||
($syntax . fuel-markup--syntax)
|
||||
($table . fuel-markup--table)
|
||||
($tag . fuel-markup--tag)
|
||||
($tags . fuel-markup--tags)
|
||||
($unchecked-example . fuel-markup--example)
|
||||
($value . fuel-markup--value)
|
||||
($values . fuel-markup--values)
|
||||
|
|
@ -138,7 +147,9 @@
|
|||
($vocab-subsection . fuel-markup--vocab-subsection)
|
||||
($vocabulary . fuel-markup--vocabulary)
|
||||
($warning . fuel-markup--warning)
|
||||
(article . fuel-markup--article)))
|
||||
(article . fuel-markup--article)
|
||||
(describe-words . fuel-markup--describe-words)
|
||||
(vocab-list . fuel-markup--vocab-list)))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-markup--maybe-nl nil))
|
||||
|
|
@ -164,10 +175,11 @@
|
|||
(defun fuel-markup--maybe-nl ()
|
||||
(setq fuel-markup--maybe-nl (point)))
|
||||
|
||||
(defun fuel-markup--insert-newline (&optional justification)
|
||||
(defun fuel-markup--insert-newline (&optional justification nosqueeze)
|
||||
(fill-region (save-excursion (beginning-of-line) (point))
|
||||
(point)
|
||||
(or justification 'left))
|
||||
(or justification 'left)
|
||||
nosqueeze)
|
||||
(newline))
|
||||
|
||||
(defsubst fuel-markup--insert-nl-if-nb (&optional no-fill)
|
||||
|
|
@ -180,6 +192,7 @@
|
|||
|
||||
(defun fuel-markup--insert-heading (txt &optional no-nl)
|
||||
(fuel-markup--insert-nl-if-nb)
|
||||
(delete-blank-lines)
|
||||
(unless (bobp) (newline))
|
||||
(fuel-markup--put-face txt 'fuel-font-lock-markup-heading)
|
||||
(fuel-markup--insert-string txt)
|
||||
|
|
@ -239,7 +252,7 @@
|
|||
(insert (cadr e))))
|
||||
|
||||
(defun fuel-markup--snippet (e)
|
||||
(let ((snip (format "%s" (cdr e))))
|
||||
(let ((snip (format "%s" (cadr e))))
|
||||
(insert (fuel-font-lock--factor-str snip))))
|
||||
|
||||
(defun fuel-markup--code (e)
|
||||
|
|
@ -260,17 +273,15 @@
|
|||
(fuel-markup--print (cons '$code (cdr e)))
|
||||
(newline))
|
||||
|
||||
(defun fuel-markup--examples (e)
|
||||
(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 +312,10 @@
|
|||
"classes.intersection" "classes.predicate")))
|
||||
(subs (fuel-eval--retort-result (fuel-eval--send/wait cmd 200))))
|
||||
(when subs
|
||||
(fuel-markup--print subs))))
|
||||
(let ((start (point))
|
||||
(sort-fold-case nil))
|
||||
(fuel-markup--print subs)
|
||||
(sort-lines nil start (point))))))
|
||||
|
||||
(defun fuel-markup--vocab-link (e)
|
||||
(fuel-markup--insert-button (cadr e) (cadr e) 'vocab))
|
||||
|
|
@ -312,11 +326,119 @@
|
|||
(fuel-markup--vocab-link (list '$vocab-link link))
|
||||
(insert " ")))
|
||||
|
||||
(defun fuel-markup--vocab-list (e)
|
||||
(let ((rows (mapcar '(lambda (elem)
|
||||
(list (car elem)
|
||||
(list '$vocab-link (cadr elem))
|
||||
(caddr elem)))
|
||||
(cdr e))))
|
||||
(fuel-markup--table (cons '$table rows))))
|
||||
|
||||
(defun fuel-markup--describe-vocab (e)
|
||||
(fuel-markup--insert-nl-if-nb)
|
||||
(let* ((cmd `(:fuel* ((,(cadr e) fuel-vocab-help)) "fuel" t))
|
||||
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(when res (fuel-markup--print res))))
|
||||
|
||||
(defun fuel-markup--vocabulary (e)
|
||||
(fuel-markup--insert-heading "Vocabulary: " t)
|
||||
(fuel-markup--vocab-link (cons '$vocab-link (cdr e)))
|
||||
(newline))
|
||||
|
||||
(defun fuel-markup--parse-classes ()
|
||||
(let ((elems))
|
||||
(while (looking-at ".+ classes$")
|
||||
(let ((heading `($heading ,(match-string-no-properties 0)))
|
||||
(rows))
|
||||
(forward-line)
|
||||
(when (looking-at "Class *.+$")
|
||||
(push (split-string (match-string-no-properties 0) nil t) rows)
|
||||
(forward-line))
|
||||
(while (not (looking-at "$"))
|
||||
(let* ((objs (split-string (thing-at-point 'line) nil t))
|
||||
(class (list '$link (car objs) (car objs) 'word))
|
||||
(super (and (cadr objs)
|
||||
(list (list '$link (cadr objs) (cadr objs) 'word))))
|
||||
(slots (when (cddr objs)
|
||||
(list (mapcar '(lambda (s) (list s " ")) (cddr objs))))))
|
||||
(push `(,class ,@super ,@slots) rows))
|
||||
(forward-line))
|
||||
(push `(,heading ($table ,@(reverse rows))) elems))
|
||||
(forward-line))
|
||||
(reverse elems)))
|
||||
|
||||
(defun fuel-markup--parse-words ()
|
||||
(let ((elems))
|
||||
(while (looking-at ".+ words\\|Primitives$")
|
||||
(let ((heading `($heading ,(match-string-no-properties 0)))
|
||||
(rows))
|
||||
(forward-line)
|
||||
(when (looking-at "Word *Stack effect$")
|
||||
(push '("Word" "Stack effect") rows)
|
||||
(forward-line))
|
||||
(while (looking-at "\\(.+?\\)\\( +\\(( .*\\)\\)?$")
|
||||
(let ((word `($link ,(match-string-no-properties 1)
|
||||
,(match-string-no-properties 1)
|
||||
word))
|
||||
(se (and (match-string-no-properties 3)
|
||||
`(($snippet ,(match-string-no-properties 3))))))
|
||||
(push `(,word ,@se) rows))
|
||||
(forward-line))
|
||||
(push `(,heading ($table ,@(reverse rows))) elems))
|
||||
(forward-line))
|
||||
(reverse elems)))
|
||||
|
||||
(defun fuel-markup--parse-words-desc (desc)
|
||||
(with-temp-buffer
|
||||
(insert desc)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "^Words$" nil t)
|
||||
(forward-line 2)
|
||||
(let ((elems '(($heading "Words"))))
|
||||
(push (fuel-markup--parse-classes) elems)
|
||||
(push (fuel-markup--parse-words) elems)
|
||||
(reverse elems)))))
|
||||
|
||||
(defun fuel-markup--describe-words (e)
|
||||
(when (cadr e)
|
||||
(fuel-markup--print (fuel-markup--parse-words-desc (cadr e)))))
|
||||
|
||||
(defun fuel-markup--tag (e)
|
||||
(fuel-markup--link (list '$link (cadr e) (cadr e) 'tag)))
|
||||
|
||||
(defun fuel-markup--tags (e)
|
||||
(when (cdr e)
|
||||
(fuel-markup--insert-heading "Tags: " t)
|
||||
(dolist (tag (cdr e))
|
||||
(fuel-markup--tag (list '$tag tag))
|
||||
(insert ", "))
|
||||
(delete-backward-char 2)
|
||||
(fuel-markup--insert-newline)))
|
||||
|
||||
(defun fuel-markup--all-tags (e)
|
||||
(let* ((cmd `(:fuel* (all-tags :get) "fuel" t))
|
||||
(tags (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(fuel-markup--list
|
||||
(cons '$list (mapcar (lambda (tag) (list '$link tag tag 'tag)) tags)))))
|
||||
|
||||
(defun fuel-markup--author (e)
|
||||
(fuel-markup--link (list '$link (cadr e) (cadr e) 'author)))
|
||||
|
||||
(defun fuel-markup--authors (e)
|
||||
(when (cdr e)
|
||||
(fuel-markup--insert-heading "Authors: " t)
|
||||
(dolist (a (cdr e))
|
||||
(fuel-markup--author (list '$author a))
|
||||
(insert ", "))
|
||||
(delete-backward-char 2)
|
||||
(fuel-markup--insert-newline)))
|
||||
|
||||
(defun fuel-markup--all-authors (e)
|
||||
(let* ((cmd `(:fuel* (all-authors :get) "fuel" t))
|
||||
(authors (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
|
||||
(fuel-markup--list
|
||||
(cons '$list (mapcar (lambda (a) (list '$link a a 'author)) authors)))))
|
||||
|
||||
(defun fuel-markup--list (e)
|
||||
(fuel-markup--insert-nl-if-nb)
|
||||
(dolist (elt (cdr e))
|
||||
|
|
@ -326,19 +448,10 @@
|
|||
|
||||
(defun fuel-markup--table (e)
|
||||
(fuel-markup--insert-newline)
|
||||
(delete-blank-lines)
|
||||
(newline)
|
||||
(let ((start (point))
|
||||
(col-delim "<~end-of-col~>")
|
||||
(col-no (length (cadr e))))
|
||||
(dolist (row (cdr e))
|
||||
(dolist (col row)
|
||||
(fuel-markup--print col)
|
||||
(insert col-delim)))
|
||||
(table-capture start (point)
|
||||
col-delim nil nil
|
||||
(/ (- (window-width) 10) col-no) col-no))
|
||||
(goto-char (point-max))
|
||||
(table-recognize -1)
|
||||
(fuel-table--insert
|
||||
(mapcar '(lambda (row) (mapcar 'fuel-markup--print-str row)) (cdr e)))
|
||||
(newline))
|
||||
|
||||
(defun fuel-markup--instance (e)
|
||||
|
|
@ -459,6 +572,9 @@
|
|||
(defun fuel-markup--errors (e)
|
||||
(fuel-markup--elem-with-heading e "Errors"))
|
||||
|
||||
(defun fuel-markup--examples (e)
|
||||
(fuel-markup--elem-with-heading e "Examples"))
|
||||
|
||||
(defun fuel-markup--notes (e)
|
||||
(fuel-markup--elem-with-heading e "Notes"))
|
||||
|
||||
|
|
@ -471,6 +587,8 @@
|
|||
(fuel-markup--code (list '$code res))
|
||||
(fuel-markup--snippet (list '$snippet word)))))
|
||||
|
||||
(defun fuel-markup--null (e))
|
||||
|
||||
(defun fuel-markup--synopsis (e)
|
||||
(insert (format " %S " e)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; fuel-syntax.el --- auxiliar definitions for factor code navigation.
|
||||
|
||||
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
|
||||
;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||||
|
|
@ -48,7 +48,7 @@
|
|||
"DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
|
||||
"GENERIC#" "GENERIC:" "HEX:" "HOOK:"
|
||||
"IN:" "INSTANCE:" "INTERSECTION:"
|
||||
"M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "METHOD:" "MIXIN:"
|
||||
"M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "MEMO:" "METHOD:" "MIXIN:"
|
||||
"OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
|
||||
"REQUIRE:" "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
|
||||
"TUPLE:" "t" "t?" "TYPEDEF:"
|
||||
|
|
@ -103,7 +103,8 @@
|
|||
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
|
||||
|
||||
(defconst fuel-syntax--definition-starters-regex
|
||||
(regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "METHOD" ":" "")))
|
||||
(regexp-opt
|
||||
'("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "MEMO:" "METHOD" ":" "")))
|
||||
|
||||
(defconst fuel-syntax--definition-start-regex
|
||||
(format "^\\(%s:\\) " fuel-syntax--definition-starters-regex))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,93 @@
|
|||
;;; fuel-table.el -- table creation
|
||||
|
||||
;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
|
||||
;; Keywords: languages, fuel, factor
|
||||
;; Start date: Tue Jan 06, 2009 13:44
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Utilities to insert ascii tables.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun fuel-table--col-widths (rows)
|
||||
(let* ((col-no (length (car rows)))
|
||||
(available (- (window-width) 2 (* 2 col-no)))
|
||||
(widths)
|
||||
(c 0))
|
||||
(while (< c col-no)
|
||||
(let ((width 0)
|
||||
(av-width (- available (* 5 (- col-no c)))))
|
||||
(dolist (row rows)
|
||||
(setq width
|
||||
(min av-width
|
||||
(max width (length (nth c row))))))
|
||||
(push width widths)
|
||||
(setq available (- available width)))
|
||||
(setq c (1+ c)))
|
||||
(reverse widths)))
|
||||
|
||||
(defun fuel-table--pad-str (str width)
|
||||
(let ((len (length str)))
|
||||
(cond ((= len width) str)
|
||||
((> len width) (concat (substring str 0 (- width 3)) "..."))
|
||||
(t (concat str (make-string (- width (length str)) ?\ ))))))
|
||||
|
||||
(defun fuel-table--str-lines (str width)
|
||||
(if (<= (length str) width)
|
||||
(list (fuel-table--pad-str str width))
|
||||
(with-temp-buffer
|
||||
(let ((fill-column width))
|
||||
(insert str)
|
||||
(fill-region (point-min) (point-max))
|
||||
(mapcar '(lambda (s) (fuel-table--pad-str s width))
|
||||
(split-string (buffer-string) "\n"))))))
|
||||
|
||||
(defun fuel-table--pad-row (row)
|
||||
(let* ((max-ln (apply 'max (mapcar 'length row)))
|
||||
(result))
|
||||
(dolist (lines row)
|
||||
(let ((ln (length lines)))
|
||||
(if (= ln max-ln) (push lines result)
|
||||
(let ((lines (reverse lines))
|
||||
(l 0)
|
||||
(blank (make-string (length (car lines)) ?\ )))
|
||||
(while (< l ln)
|
||||
(push blank lines)
|
||||
(setq l (1+ l)))
|
||||
(push (reverse lines) result)))))
|
||||
(reverse result)))
|
||||
|
||||
(defun fuel-table--format-rows (rows widths)
|
||||
(let ((col-no (length (car rows)))
|
||||
(frows))
|
||||
(dolist (row rows)
|
||||
(let ((c 0) (frow))
|
||||
(while (< c col-no)
|
||||
(push (fuel-table--str-lines (nth c row) (nth c widths)) frow)
|
||||
(setq c (1+ c)))
|
||||
(push (fuel-table--pad-row (reverse frow)) frows)))
|
||||
(reverse frows)))
|
||||
|
||||
(defun fuel-table--insert (rows)
|
||||
(let* ((widths (fuel-table--col-widths rows))
|
||||
(rows (fuel-table--format-rows rows widths))
|
||||
(ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+")))
|
||||
(insert ls "\n")
|
||||
(dolist (r rows)
|
||||
(let ((ln (length (car r)))
|
||||
(l 0))
|
||||
(while (< l ln)
|
||||
(insert (concat "|" (mapconcat 'identity
|
||||
(mapcar `(lambda (x) (nth ,l x)) r)
|
||||
" |")
|
||||
" |\n"))
|
||||
(setq l (1+ l))))
|
||||
(insert ls "\n"))))
|
||||
|
||||
|
||||
(provide 'fuel-table)
|
||||
;;; fuel-table.el ends here
|
||||
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue