! Copyright (C) 2013 John Benediktsson. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs combinators formatting fry grouping hashtables io io.binary io.directories io.encodings.binary io.files kernel math math.parser memoize pack sequences sequences.generalizations splitting strings system ; IN: terminfo ! Reads compiled terminfo files ! typically located in /usr/share/terminfo terminfo-header : read-header ( -- header ) 12 read "ssssss" unpack-le unclip check-magic 5 firstn ; : read-names ( header -- names ) names-bytes>> read but-last "|" split [ >string ] map ; : read-booleans ( header -- booleans ) boolean-bytes>> read [ 1 = ] { } map-as ; : read-shorts ( n -- seq' ) 2 * read 2 [ signed-le> dup 0 < [ drop f ] when ] map ; : align-even-bytes ( header -- ) [ names-bytes>> ] [ boolean-bytes>> ] bi + odd? [ read1 drop ] when ; : read-numbers ( header -- numbers ) [ align-even-bytes ] [ #numbers>> read-shorts ] bi ; : string-offset ( from seq -- str ) 0 2over index-from swap subseq >string ; : read-strings ( header -- strings ) [ #strings>> read-shorts ] [ string-bytes>> read ] bi '[ [ _ string-offset ] [ f ] if* ] map ; TUPLE: terminfo names booleans numbers strings ; C: terminfo : read-terminfo ( -- terminfo ) read-header { [ read-names ] [ read-booleans ] [ read-numbers ] [ read-strings ] } cleave ; PRIVATE> : file>terminfo ( path -- terminfo ) binary [ read-terminfo ] with-file-reader ; HOOK: terminfo-path os ( name -- path ) M: macosx terminfo-path ( name -- path ) [ first >hex ] keep "/usr/share/terminfo/%s/%s" sprintf ; M: linux terminfo-path ( name -- path ) [ first ] keep "/usr/share/terminfo/%c/%s" sprintf ; MEMO: terminfo-names ( -- names ) "/usr/share/terminfo" [ [ directory-files ] map concat ] with-directory-files ; append zip ; PRIVATE> : term-capabilities ( name -- assoc ) terminfo-path file>terminfo { [ booleans>> boolean-names zip-names ] [ numbers>> number-names zip-names ] [ strings>> string-names zip-names ] } cleave 3append >hashtable ;