steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Style improvements

db4
Alfredo Beaumont 2008-07-11 10:32:15 +02:00
parent b93342298f
commit cec5291ed4
1 changed files with 24 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
extra/ctags/etags/etags.factor
View File

@ -21,7 +21,9 @@ IN: ctags.etags
dup [ first , second second , ] { } make ; dup [ first , second second , ] { } make ;
: ctag-add ( ctag hash -- hash ) : ctag-add ( ctag hash -- hash )
[ ctag-hashvalue ] 2keep [ dup ctag-path [ ctag-value suffix ] dip ] dip [ set-at ] keep ; [ ctag-hashvalue ] 2keep [
dup ctag-path [ ctag-value suffix ] dip
] dip [ set-at ] keep ;
: ctag-hash ( seq -- hash ) : ctag-hash ( seq -- hash )
H{ } clone swap [ swap ctag-add ] each ; H{ } clone swap [ swap ctag-add ] each ;
@ -30,12 +32,16 @@ IN: ctags.etags
nth length 1+ ; nth length 1+ ;
: lines>bytes ( n seq -- bytes ) : lines>bytes ( n seq -- bytes )
over zero? [ line>bytes ] [ [ [ 1 - ] dip lines>bytes ] 2keep line>bytes + ] if ; over zero? [
line>bytes ] [
[
[ 1- ] dip lines>bytes
] 2keep line>bytes +
] if ;
: file>bytes ( n path -- bytes ) : file>bytes ( n path -- bytes )
ascii file-lines lines>bytes ; ascii file-lines lines>bytes ;
SYMBOL: resource
: etag ( path seq -- str ) : etag ( path seq -- str )
[ [
dup first ?word-name % dup first ?word-name %
@ -51,15 +57,28 @@ SYMBOL: resource
: vector-length ( vector -- n ) : vector-length ( vector -- n )
0 [ length + ] reduce ; 0 [ length + ] reduce ;
: etag-header ( n path -- str ) : <header> ( n path -- str )
[ [
% %
1 CHAR: , <string> % 1 CHAR: , <string> %
number>string % number>string %
] "" make ; ] "" make ;
: etag-header ( vec1 n resource -- vec2 )
normalize-path <header> prefix
1 HEX: 0c <string> prefix ;
SYMBOL: resource
: etag-strings ( alist -- seq ) : etag-strings ( alist -- seq )
{ } swap [ etag-entry resource [ second [ resource get swap etag ] map dup vector-length resource get normalize-path etag-header prefix 1 HEX: 0c <string> prefix ] with-variable append ] each ; { } swap [
etag-entry resource [
second [
resource get swap etag
] map dup vector-length
resource get
] with-variable
etag-header append
] each ;
: etags-write ( alist path -- ) : etags-write ( alist path -- )
[ etag-strings ] dip ascii set-file-lines ; [ etag-strings ] dip ascii set-file-lines ;