Changeset 7189 in project


Ignore:
Timestamp:
12/23/07 01:05:41 (12 years ago)
Author:
felix winkelmann
Message:

terminal-size procedure and chicken-setup egg list improvements by Shawn Wagner

Location:
chicken/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken-setup.scm

    r7180 r7189  
    11811181        (string-append str pad) ) ) )
    11821182
     1183(define get-terminal-width
     1184  (let ((default-width 78)) ; Standard default terminal width
     1185    (lambda ()
     1186      (let ((cop (current-output-port)))
     1187        (if (terminal-port? cop)
     1188            (with-exception-handler
     1189             (lambda (_)
     1190               default-width)
     1191             (lambda ()
     1192               (call-with-values
     1193                   (lambda () (terminal-size cop))
     1194                   (lambda (_ cols) cols))))
     1195             default-width)))))
     1196
    11831197(define (list-installed)
    1184   (for-each
    1185    (lambda (f)
    1186      (and-let* ((info (extension-information f)))
    1187        (print (format-string (->string f) 32)
    1188               " "
    1189               (format-string
    1190                (or (and-let* ((v (assq 'version info)))
    1191                      (sprintf "Version: ~A" (cadr v)) )
    1192                    "")
    1193                32 #t)
    1194               (or (and-let* ((r (assq 'release info)))
    1195                     (sprintf " (Release ~a)" (cadr r)) )
    1196                   "") ) ) )
    1197    (sort (delete-duplicates
    1198           (grep "^[^.].*\\.*$" (map pathname-file (directory (repository-path)))) string=?)
    1199          string<?) ) )
     1198  (let* ((line-width (get-terminal-width))
     1199         (eggs (sort (delete-duplicates
     1200                      (grep "^[^.].*\\.*$"
     1201                            (map pathname-file
     1202                                 (directory (repository-path)))) string=?)
     1203                     string<?))
     1204         (version-number-width
     1205          (fold
     1206           (lambda (egg maxlen)
     1207             (max maxlen
     1208                  (or (and-let* ((info (extension-information egg))
     1209                                 (v (assq 'version info)))
     1210                                (string-length (->string (cadr v))))
     1211                      0))) 0 eggs))
     1212         (version-width (fx+ version-number-width 9))
     1213         (release-width 22)
     1214         (name-width (fxmax (- line-width version-width release-width 3) 12)))
     1215    (for-each
     1216     (lambda (f)
     1217       (and-let* ((info (extension-information f)))
     1218                 (print (format-string (->string f) name-width)
     1219                        " "
     1220                        (format-string
     1221                         (or (and-let*
     1222                              ((v (assq 'version info)))
     1223                              (sprintf "Version: ~A"
     1224                                       (format-string (->string (cadr v))
     1225                                                      version-number-width #t)))
     1226                             "")
     1227                         version-width #t)
     1228                        " "
     1229                        (or (and-let* ((r (assq 'release info)))
     1230                                      (sprintf "(Release ~a)" (cadr r)) )
     1231                            "") ) ) )
     1232     eggs)))
    12001233
    12011234
  • chicken/trunk/posixunix.scm

    r6707 r7189  
    3939  (disable-interrupts)
    4040  (usual-integrations)
    41   (hide ##sys#stat group-member _get-groups _ensure-groups posix-error)
     41  (hide ##sys#stat group-member _get-groups _ensure-groups posix-error
     42        ##sys#terminal-check)
    4243  (foreign-declare #<<EOF
    4344#include <signal.h>
     
    5657#include <sys/utsname.h>
    5758#include <sys/stat.h>
     59#include <sys/ioctl.h>
    5860#include <fcntl.h>
    5961#include <dirent.h>
     
    360362#define C_set_gid(n, id)  (C_groups[ C_unfix(n) ] = C_unfix(id), C_SCHEME_UNDEFINED)
    361363#define C_set_groups(n)   C_fix(setgroups(C_unfix(n), C_groups))
     364
     365static int get_tty_size(int p, int *rows, int *cols)
     366{
     367 struct winsize tty_size;
     368 int r;
     369
     370 memset(&tty_size, 0, sizeof tty_size);
     371
     372 r = ioctl(p, TIOCGWINSZ, &tty_size);
     373 if (r == 0) {
     374    *rows = tty_size.ws_row;
     375    *cols = tty_size.ws_col;
     376 }
     377 return r;
     378}
     379
    362380EOF
    363381) )
     
    17931811    (and (not (eq? fp 0)) (##core#inline "C_tty_portp" port) ) ) )
    17941812
     1813(define (##sys#terminal-check caller port)
     1814  (##sys#check-port port caller)
     1815  (unless (and (eq? 'stream (##sys#slot port 7))
     1816               (##core#inline "C_tty_portp" port))
     1817          (##sys#error caller "port is not connected to a terminal" port)))
     1818
    17951819(define terminal-name
    17961820  (let ([ttyname (foreign-lambda nonnull-c-string "ttyname" int)] )
    17971821    (lambda (port)
    1798       (##sys#check-port port 'terminal-name)
    1799       (unless (and (eq? 'stream (##sys#slot port 7))
    1800                    (##core#inline "C_tty_portp" port) )
    1801       (##sys#error 'terminal-name "port is not connected to a terminal" port) )
     1822      (##sys#terminal-check 'terminal-name port)
    18021823      (ttyname (##core#inline "C_C_fileno" port) ) ) ) )
    18031824
     1825(define terminal-size
     1826  (let ((ttysize (foreign-lambda int "get_tty_size" int
     1827                                 (nonnull-c-pointer int)
     1828                                 (nonnull-c-pointer int))))
     1829    (lambda (port)
     1830      (##sys#terminal-check 'terminal-size port)
     1831      (let-location ((columns int)
     1832                     (rows int))
     1833                    (if (fx= 0
     1834                             (ttysize (##core#inline "C_C_fileno" port)
     1835                                      (location columns)
     1836                                      (location rows)))
     1837                        (values columns rows)
     1838                        (posix-error #:error 'terminal-size
     1839                                     "Unable to get size of terminal" port))))))
     1840 
    18041841(define get-host-name
    18051842  (let ([getit
  • chicken/trunk/posixwin.scm

    r6385 r7189  
    19771977(define-unimplemented terminal-name)
    19781978(define-unimplemented terminal-port?)
     1979(define-unimplemented terminal-size)
    19791980(define-unimplemented unmap-file-from-memory)
    19801981(define-unimplemented user-information)
Note: See TracChangeset for help on using the changeset viewer.