extra/ctags/etags/etags.factor

   1 ! Copyright (C) 2008 Alfredo Beaumont
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 ! Emacs Etags generator
   5 ! Alfredo Beaumont <alfredo.beaumont@gmail.com>
   6 USING: kernel sequences sorting assocs words prettyprint ctags
   7 io.encodings.ascii io.files math math.parser namespaces make
   8 strings shuffle io.backend arrays present ;
   9 IN: ctags.etags
  10
  11 : etag-at ( key hash -- vector )
  12   at [ V{ } clone ] unless* ;
  13
  14 : etag-vector ( alist hash -- vector )
  15   [ ctag-path ] dip etag-at ;
  16
  17 : etag-pair ( ctag -- seq )
  18   dup [
  19     first ,
  20     second second ,
  21   ] { } make ;
  22
  23 : etag-add ( ctag hash -- )
  24   [ etag-vector ] 2keep [
  25     [ etag-pair ] [ ctag-path ] bi [ suffix ] dip
  26   ] dip set-at ;
  27
  28 : etag-hash ( seq -- hash )
  29   H{ } clone swap [ swap [ etag-add ] keep ] each ;
  30
  31 : lines>bytes ( seq n -- bytes )
  32   head 0 [ length 1 + + ] reduce ;
  33
  34 : file>lines ( path -- lines )
  35   ascii file-lines ;
  36
  37 : etag ( lines seq -- str )
  38   [
  39     dup first present %
  40     1 0x7f <string> %
  41     second dup number>string %
  42     1 CHAR: , <string> %
  43     1 - lines>bytes number>string %
  44   ] "" make ;
  45
  46 : etag-length ( vector -- n )
  47   0 [ length + ] reduce ;
  48
  49 : (etag-header) ( n path -- str )
  50   [
  51     %
  52     1 CHAR: , <string> %
  53     number>string %
  54   ] "" make ;
  55
  56 : etag-header ( vec1 n resource -- vec2 )
  57   normalize-path (etag-header) prefix
  58   1 0x0c <string> prefix ;
  59
  60 : etag-strings ( alist -- seq )
  61   { } swap [
  62     [
  63       [ first file>lines ]
  64       [ second ] bi
  65       [ etag ] with map
  66       dup etag-length
  67     ] keep first
  68     etag-header append
  69   ] each ;
  70
  71 : etags-write ( alist path -- )
  72   [ etag-strings ] dip ascii set-file-lines ;
  73
  74 : etags ( path -- )
  75   [ (ctags) sort-values etag-hash >alist ] dip etags-write ;