\r
+ listener/plugin:\r
\r
+- use decl wrong\r
- faster completion\r
- sidekick: still parsing too much\r
- errors don't always disappear\r
IN: timesheet
USE: errors
-USE: format
USE: kernel
USE: lists
USE: math
! Printing the timesheet.
: hh ( duration -- str ) 60 /i ;
-: mm ( duration -- str ) 60 mod unparse 2 digits ;
+: mm ( duration -- str ) 60 mod unparse 2 "0" pad ;
: hh:mm ( millis -- str ) [ dup hh , ":" , mm , ] make-list ;
: print-entry ( duration description -- )
"/library/syntax/parse-stream.factor"\r
"/library/bootstrap/init.factor"\r
\r
- "/library/format.factor"\r
"/library/syntax/unparser.factor"\r
"/library/io/presentation.factor"\r
"/library/io/vocabulary-style.factor"\r
: here-as ( tag -- pointer )
here swap bitor ;
-: pad ( -- )
+: align-here ( -- )
here 8 mod 4 = [ 0 emit ] when ;
( Remember what objects we've compiled )
[ 0 | [ 1 0 ] ]
[ -1 | [ 2 1 1 ] ]
[ 1 | [ 2 0 1 ] ]
- ] assoc [ emit ] each pad r> ;
+ ] assoc [ emit ] each align-here r> ;
( Special objects )
dup str-length emit
dup hashcode emit
pack-string
- pad ;
+ align-here ;
M: string ' ( string -- pointer )
#! We pool strings so that each string is only written once
array-type >header emit
dup length emit
( elements -- ) [ emit ] each
- pad r> ;
+ align-here r> ;
M: vector ' ( vector -- pointer )
dup vector>list emit-array swap vector-length
vector-type >header emit
emit ( length )
emit ( array ptr )
- pad r> ;
+ align-here r> ;
( End of the image )
#!
#! Arguments containing = are handled differently; they
#! set the object path.
- "=" split1 dup [
+ "=" split1 [
cli-var-param
] [
- drop dup "no-" str-head? dup [
- f put drop
- ] [
- drop t put
- ] ifte
- ] ifte ;
+ "no-" ?str-head not put
+ ] ifte* ;
: cli-arg ( argument -- argument )
#! Handle a command-line argument. If the argument was
#! consumed, returns f. Otherwise returns the argument.
- dup f-or-"" [
- dup "-" str-head? dup [
- cli-param drop f
- ] [
- drop
- ] ifte
- ] unless ;
+ dup f-or-"" [ "-" ?str-head [ cli-param f ] when ] unless ;
: parse-switches ( args -- args )
[ cli-arg ] map ;
+++ /dev/null
-! :folding=indent:collapseFolds=0:
-
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-!
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-!
-! 1. Redistributions of source code must retain the above copyright notice,
-! this list of conditions and the following disclaimer.
-!
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-! this list of conditions and the following disclaimer in the documentation
-! and/or other materials provided with the distribution.
-!
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-IN: format
-USE: kernel
-USE: math
-USE: namespaces
-USE: strings
-
-: decimal-split ( string -- string string )
- #! Split a string before and after the decimal point.
- dup "." index-of dup -1 = [ drop f ] [ str// ] ifte ;
-
-: decimal-tail ( count str -- string )
- #! Given a decimal, trims all but a count of decimal places.
- [ str-length min ] keep str-head ;
-
-: decimal-cat ( before after -- string )
- #! If after is of zero length, return before, otherwise
- #! return "before.after".
- dup str-length 0 = [
- drop
- ] [
- "." swap cat3
- ] ifte ;
-
-: decimal-places ( num count -- string )
- #! Trims the number to a count of decimal places.
- >r decimal-split dup [
- r> swap decimal-tail decimal-cat
- ] [
- r> 2drop
- ] ifte ;
-
-: digits ( string count -- string )
- #! Make sure string has at least count digits, padding it
- #! with zeroes on the left if needed.
- over str-length - dup 0 <= [
- drop
- ] [
- "0" fill swap cat2
- ] ifte ;
-
-: pad-string ( len str -- str )
- str-length - " " fill ;
\ dup , "predicate" word-property , , , \ ifte ,
] make-list ;
-: (predicate-method) ( vtable definition class type# -- )
+: predicate-method ( vtable definition class type# -- )
>r rot r> swap [
vector-nth
( vtable definition class existing )
( vtable definition class -- )
dup builtin-supertypes [
( vtable definition class type# )
- >r 3dup r> (predicate-method)
+ >r 3dup r> predicate-method
] each 3drop
] "add-method" set-word-property
USE: unparser
: serving-path ( filename -- filename )
- f>"" "doc-root" get swap cat2 ;
+ [ "" ] unless* "doc-root" get swap cat2 ;
: file-response ( mime-type length -- )
[
IN: html
USE: strings
USE: lists
-USE: format
USE: kernel
USE: stdio
USE: namespaces
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: html
-USE: format
USE: lists
USE: kernel
USE: namespaces
[ dup html-entities assoc dup rot ? ] str-map ;
: >hex-color ( triplet -- hex )
- [ >hex 2 digits ] map "#" swons cat ;
+ [ >hex 2 "0" pad ] map "#" swons cat ;
: fg-css, ( color -- )
"color: " , >hex-color , "; " , ;
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: httpd
-USE: format
USE: kernel
USE: lists
USE: logging
USE: errors
USE: kernel
USE: lists
-USE: format
USE: math
USE: parser
USE: strings
: url-encode ( str -- str )
[
- dup url-quotable? [ "%" swap >hex 2 digits cat2 ] unless
+ dup url-quotable? [
+ "%" swap >hex 2 "0" pad cat2
+ ] unless
] str-map ;
: catch-hex> ( str -- n )
IN: ansi
USE: lists
USE: kernel
-USE: format
USE: namespaces
USE: stdio
USE: streams
#! repeated.
[ swap [ dup , ] times drop ] make-string ;
+: pad ( string count char -- string )
+ >r over str-length - dup 0 <= [
+ r> 2drop
+ ] [
+ r> fill swap cat2
+ ] ifte ;
+
: str-map ( str code -- str )
#! Apply a quotation to each character in the string, and
#! push a new string constructed from return values.
: f-or-"" ( obj -- ? )
dup not swap "" = or ;
-: f>"" ( str/f -- str )
- [ "" ] unless* ;
-
: str-length< ( str str -- boolean )
#! Compare string lengths.
swap str-length swap str-length < ;
#! index.
[ swap str-head ] 2keep succ swap str-tail ;
-: str-headcut ( str begin -- str str )
- str-length str/ ;
-
-: =? ( x y z -- z/f )
- #! Push z if x = y, otherwise f.
- >r = r> f ? ;
-
-: str-head? ( str begin -- str )
- #! If the string starts with begin, return the rest of the
- #! string after begin. Otherwise, return f.
- 2dup str-length< [ 2drop f ] [ tuck str-headcut =? ] ifte ;
+: str-head? ( str begin -- ? )
+ 2dup str-length< [
+ 2drop f
+ ] [
+ dup str-length rot str-head =
+ ] ifte ;
: ?str-head ( str begin -- str ? )
- dupd str-head? dup [ nip t ] [ drop f ] ifte ;
-
-: str-tailcut ( str end -- str str )
- str-length >r dup str-length r> - str/ swap ;
+ 2dup str-head? [
+ str-length swap str-tail t
+ ] [
+ drop f
+ ] ifte ;
-: str-tail? ( str end -- str )
- #! If the string ends with end, return the start of the
- #! string before end. Otherwise, return f.
- 2dup str-length< [ 2drop f ] [ tuck str-tailcut =? ] ifte ;
+: str-tail? ( str end -- ? )
+ 2dup str-length< [
+ 2drop f
+ ] [
+ dup str-length pick str-length swap - rot str-tail =
+ ] ifte ;
-: ?str-tail ( str end -- str ? )
- dupd str-tail? dup [ nip t ] [ drop f ] ifte ;
+: ?str-tail ( str end -- ? )
+ 2dup str-tail? [
+ str-length swap [ str-length swap - ] keep str-head t
+ ] [
+ drop f
+ ] ifte ;
: split1 ( string split -- before after )
2dup index-of dup -1 = [
rot str-head swap
] ifte ;
-: max-str-length ( list -- len )
- #! Returns the length of the longest string in the given
- #! list.
- 0 swap [ str-length max ] each ;
-
: str-each ( str [ code ] -- )
#! Execute the code, with each character of the string
#! pushed onto the stack.
IN: prettyprint
USE: errors
-USE: format
USE: generic
USE: kernel
USE: lists
IN: unparser
USE: generic
USE: kernel
-USE: format
USE: lists
USE: math
USE: namespaces
] assoc ;
: ch>unicode-escape ( ch -- esc )
- >hex 4 digits "\\u" swap cat2 ;
+ >hex 4 "0" pad "\\u" swap cat2 ;
: unparse-ch ( ch -- ch/str )
dup quotable? [
+++ /dev/null
-IN: scratchpad
-USE: format
-USE: test
-
-[ "123" ] [ 4 "123" decimal-tail ] unit-test
-[ "12" ] [ 2 "123" decimal-tail ] unit-test
-[ "123" ] [ "123" 2 decimal-places ] unit-test
-[ "123.12" ] [ "123.12" 2 decimal-places ] unit-test
-[ "123.123" ] [ "123.123" 5 decimal-places ] unit-test
-[ "123" ] [ "123.123" 0 decimal-places ] unit-test
-[ "05" ] [ "5" 2 digits ] unit-test
-[ "666" ] [ "666" 2 digits ] unit-test
[ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
[ "" "" ] [ "great" "great" split1 ] unit-test
-[ "and end" ] [ "Beginning and end" "Beginning " str-head? ] unit-test
-[ f ] [ "Beginning and end" "Beginning x" str-head? ] unit-test
-[ f ] [ "Beginning and end" "eginning " str-head? ] unit-test
+[ "and end" t ] [ "Beginning and end" "Beginning " ?str-head ] unit-test
+[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-head ] unit-test
+[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?str-head ] unit-test
-[ "Beginning" ] [ "Beginning and end" " and end" str-tail? ] unit-test
-[ f ] [ "Beginning and end" "Beginning x" str-tail? ] unit-test
-[ f ] [ "Beginning and end" "eginning " str-tail? ] unit-test
+[ "Beginning" t ] [ "Beginning and end" " and end" ?str-tail ] unit-test
+[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?str-tail ] unit-test
+[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?str-tail ] unit-test
[ [ "This" "is" "a" "split" "sentence" ] ]
[ "This is a split sentence" " " split ]
[ [ "a" "b" "c" "d" "e" "f" ] ]
[ "aXXbXXcXXdXXeXXf" "XX" split ] unit-test
-[ 6 ]
-[
- [ "One" "Two" "Little" "Piggy" "Went" "To" "The" "Market" ]
- max-str-length
-] unit-test
-
-[ "Hello world" ] [ "Hello world\n" "\n" str-tail? ] unit-test
-[ f ] [ "Hello world" "\n" str-tail? ] unit-test
-[ "" ] [ "\n" "\n" str-tail? ] unit-test
-[ f ] [ "" "\n" str-tail? ] unit-test
+[ "Hello world" t ] [ "Hello world\n" "\n" ?str-tail ] unit-test
+[ "Hello world" f ] [ "Hello world" "\n" ?str-tail ] unit-test
+[ "" t ] [ "\n" "\n" ?str-tail ] unit-test
+[ "" f ] [ "" "\n" ?str-tail ] unit-test
[ t ] [ CHAR: a letter? ] unit-test
[ f ] [ CHAR: A letter? ] unit-test
[ dup CHAR: \s = [ drop CHAR: + ] when ] str-map
]
unit-test
+
+[ "05" ] [ "5" 2 "0" pad ] unit-test
+[ "666" ] [ "666" 2 "0" pad ] unit-test
"namespaces"
"generic"
"files"
- "format"
"parser"
"parse-number"
"prettyprint"
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: inspector
-USE: format
USE: kernel
USE: hashtables
USE: lists
USE: prettyprint
USE: unparser
USE: vectors
+USE: math
: relative>absolute-object-path ( string -- string )
"object-path" get [ "'" rot cat3 ] when* ;
3list
default-style append ;
+: pad-string ( len str -- str )
+ str-length - " " fill ;
+
: var-name. ( max name -- )
tuck unparse pad-string write dup link-style
swap unparse swap write-attr ;
: value. ( max name value -- )
>r var-name. ": " write r> . ;
+: max-str-length ( list -- len )
+ #! Returns the length of the longest string in the given
+ #! list.
+ 0 swap [ str-length max ] each ;
+
: name-padding ( alist -- col )
[ car unparse ] map max-str-length ;
: word-file ( path -- dir file )
dup [
- dup "resource:/" str-head? dup [
- nip resource-path swap
+ "resource:/" ?str-head [
+ resource-path swap
] [
- swap ( f file )
+ f swap
] ifte
] [
f
: vocab-completions ( substring vocab -- list )
#! Used by jEdit plugin. Like vocab-apropos, but only
#! matches at the start of a word name are considered.
- words [ word-name over str-head? ] subset nip ;
+ words [ word-name over ?str-head nip ] subset nip ;
: apropos. ( substring -- )
#! List all words that contain a string.
projects / factor.git / commitdiff