Changeset 35181 in project


Ignore:
Timestamp:
02/23/18 01:20:18 (4 months ago)
Author:
kon
Message:

add terminal info api

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/posix-utils/trunk/posix-utils.scm

    r35170 r35181  
    1010(;export
    1111  ;
     12  terminal-info
     13  get-terminal-size
     14  get-terminal-width get-terminal-height
     15  output-port-width output-port-height
     16  ;
    1217  string-trim-eol software-eol-string
    1318  ;
     
    3237(import scheme chicken)
    3338(use
    34   (only (srfi 1) member)
    35   (only data-structures conc string-intersperse o identity ->string)
    36   (only posix process process-wait)
     39  (only (srfi 1)
     40    member every first second)
     41  (only data-structures
     42    conc string-intersperse o identity ->string)
     43  (only posix
     44    terminal-port? terminal-name terminal-size
     45    process process-wait)
     46  (only fx-utils
     47    fxnegative? fxzero?)
    3748  (only utils qs read-all)
    3849  (only (srfi 13) string-trim-both string-index string-take string-null? string-downcase)
    3950  (only (srfi 14) list->char-set)
    40   (only check-errors check-string) )
     51  (only type-checks
     52    define-check+error-type
     53    check-string check-output-port) )
     54
     55;;
     56
     57;
     58
     59(define-type alist (or null (list-of (pair * *))))
     60
     61(define-type terminal-length fixnum)
     62
     63(define-type terminal-size (list terminal-length terminal-length))
     64
     65;
     66
     67(define (natural-fixnum? obj)
     68  (and (fixnum? obj) (not (fxnegative? obj))) )
     69
     70(define (terminal-size? obj)
     71  (and
     72    (list? obj)
     73    (fx= 2 (length obj))
     74    (natural-fixnum? (first obj))
     75    (natural-fixnum? (second obj))) )
     76
     77(define-check+error-type terminal-size)
     78
     79(define (check-terminal-port? loc obj)
     80  (and
     81    (terminal-port? (check-output-port loc obj))
     82    obj) )
     83
     84;
     85
     86(define-constant TERMINAL-WIDTH 80)
     87(define-constant TERMINAL-HEIGHT 25)
     88
     89;;
     90
     91(: terminal-info (#!optional output-port --> alist))
     92;
     93(define (terminal-info #!optional (port (current-output-port)))
     94  (if (not (check-terminal-port? 'terminal-info port))
     95    '()
     96    `((name . ,(terminal-name port))
     97      (size . ,(receive rect (terminal-size port) rect))) ) )
     98
     99(: get-terminal-size (#!optional output-port --> (or boolean terminal-size)))
     100;
     101(define (get-terminal-size #!optional (port (current-output-port)))
     102  (and-let* ((port (check-terminal-port? 'get-terminal-size port)))
     103    (receive rect (terminal-size port) rect) ) )
     104
     105(: get-terminal-width (#!optional output-port --> (or boolean terminal-length)))
     106;
     107(define (get-terminal-width #!optional (port (current-output-port)))
     108  (and-let* (((check-terminal-port? 'get-terminal-width port)))
     109    (*output-port-width port) ) )
     110
     111(: get-terminal-height (#!optional output-port --> (or boolean terminal-length)))
     112;
     113(define (get-terminal-height #!optional (port (current-output-port)))
     114  (and-let* (((check-terminal-port? 'get-terminal-height port)))
     115    (*output-port-height port) ) )
     116
     117(: output-port-width ((or boolean output-port) #!optional terminal-length --> terminal-length))
     118;
     119(define (output-port-width port #!optional (def TERMINAL-WIDTH))
     120  (if (not port)
     121    def
     122    (*output-port-width (check-terminal-port? 'output-port-width port) def) ) )
     123
     124(: output-port-height ((or boolean output-port) #!optional terminal-length --> terminal-length))
     125;
     126(define (output-port-height port #!optional (def TERMINAL-HEIGHT))
     127  (if (not port)
     128    def
     129    (*output-port-height (check-terminal-port? 'output-port-height port) def) ) )
     130
     131(: *output-port-width ((or boolean output-port) #!optional  terminal-length --> terminal-length))
     132;
     133(define (*output-port-width port #!optional (def TERMINAL-WIDTH))
     134  (let-values (((w _) (terminal-size port)))
     135    (if (fxzero? w) def w) ) )
     136
     137(: *output-port-height (output-port #!optional terminal-length --> terminal-length))
     138;
     139(define (*output-port-height port #!optional (def TERMINAL-HEIGHT))
     140  (let-values (((_ h) (terminal-size port)))
     141    (if (fxzero? h) def h) ) )
    41142
    42143;;
     
    50151
    51152(: shell-value-bound? ((or boolean string) -> (or boolean string)))
     153;
    52154(define (shell-value-bound? varval)
    53155  (and-let* (
     
    57159
    58160(: shell-value-true? ((or boolean string) (or boolean (list-of string)) -> boolean))
     161;
    59162(define (shell-value-true? varval truedat)
    60163  (and-let* ((str varval))
     
    66169
    67170(: register-shell-value-feature! ((or boolean string) procedure -> (or boolean symbol)))
     171;
    68172(define (register-shell-value-feature! varval filter)
    69173  (and-let* (
Note: See TracChangeset for help on using the changeset viewer.