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-header) ( n path -- str )
  47   [
  48     %
  49     1 CHAR: , <string> %
  50     number>string %
  51   ] "" make ;
  52
  53 : etag-header ( vec1 n resource -- vec2 )
  54   normalize-path (etag-header) prefix
  55   1 0x0c <string> prefix ;
  56
  57 : etag-strings ( alist -- seq )
  58   { } swap [
  59     [
  60       [ first file>lines ]
  61       [ second ] bi
  62       [ etag ] with map
  63       dup sum-lengths
  64     ] keep first
  65     etag-header append
  66   ] each ;
  67
  68 : etags-write ( alist path -- )
  69   [ etag-strings ] dip ascii set-file-lines ;
  70
  71 : etags ( path -- )
  72   [ (ctags) sort-values etag-hash >alist ] dip etags-write ;