termio/termio.lisp

   1 ;;; termio.lisp --- Terminal-related utilities
   2
   3 ;; Copyright (C) 2012 Didier Verna.
   4
   5 ;; Author:        Didier Verna <didier.verna@gmail.com>
   6 ;; Maintainer:    Didier Verna <didier.verna@gmail.com>
   7
   8 ;; This file is part of Clon.
   9
  10 ;; Permission to use, copy, modify, and distribute this software for any
  11 ;; purpose with or without fee is hereby granted, provided that the above
  12 ;; copyright notice and this permission notice appear in all copies.
  13
  14 ;; THIS SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  15 ;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  16 ;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  17 ;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  18 ;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  19 ;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  20 ;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  21
  22
  23 ;;; Commentary:
  24
  25 ;; Contents management by FCM version 0.1.
  26
  27
  28 ;;; Code:
  29
  30 (in-package :com.dvlsoft.clon)
  31 (in-readtable :com.dvlsoft.clon)
  32
  33
  34 ;; Preamble C code needed for ECL's FD-LINE-WIDTH function.
  35 #+ecl (ffi:clines "
  36 #include <stdio.h>
  37 #include <errno.h>
  38 #include <sys/ioctl.h>")
  39
  40
  41 ;; Thanks Nikodemus!
  42 (defgeneric stream-file-stream (stream &optional direction)
  43   (:documentation "Convert STREAM to a file-stream.")
  44   (:method ((stream file-stream) &optional direction)
  45     (declare (ignore direction))
  46     stream)
  47   (:method ((stream synonym-stream) &optional direction)
  48     (declare (ignore direction))
  49     (stream-file-stream (symbol-value (synonym-stream-symbol stream))))
  50   (:method ((stream two-way-stream) &optional direction)
  51     (stream-file-stream
  52      (case direction
  53        (:input (two-way-stream-input-stream stream))
  54        (:output (two-way-stream-output-stream stream))
  55        (otherwise
  56         (error "Cannot extract file-stream from TWO-WAY-STREAM ~A:
  57 invalid direction: ~S"
  58                stream direction)))
  59      direction)))
  60
  61 #+ecl
  62 (defun fd-line-width (fd)
  63   "Get the line width for FD (file descriptor).
  64 Return two values:
  65 - the line width, or -1 if it can't be computed
  66   (typically when FD does not denote a tty),
  67 - an error message if the operation failed."
  68   (ffi:c-inline (fd) (:int) (values :int :cstring) "{
  69     int fd = #0;
  70
  71     int cols = -1;
  72     char *msg = NULL;
  73
  74     struct winsize window;
  75     if (ioctl (fd, TIOCGWINSZ, &window) == -1)
  76       {
  77         if (errno != ENOTTY)
  78           msg = strerror (errno);
  79       }
  80     else
  81       cols = (int) window.ws_col;
  82
  83     @(return 0) = cols;
  84     @(return 1) = msg;
  85 }"))
  86
  87 ;; #### NOTE: ABCL doesn't appear below because this module (termio) is never
  88 ;; loaded with it.
  89 (defun stream-line-width (stream)
  90   "Get STREAM's line width.
  91 Return two values:
  92 - the stream's line width, or nil if it can't be computed
  93   (typically when the stream does not denote a tty),
  94 - an error message if the operation failed."
  95   ;; #### NOTE: doing a TIOCGWINSZ ioctl here is a convenient way to both know
  96   ;; whether we're connected to a tty, and getting the terminal width at the
  97   ;; same time. In case the ioctl fails, we need to distinguish between and
  98   ;; ENOTTY error, which simply means that we're not connected to a terminal,
  99   ;; and the other which are real errors and need to be reported.
 100   ;; #### PORTME.
 101   #+sbcl
 102   (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
 103     (handler-case
 104         (with-winsize winsize ()
 105           (sb-posix:ioctl (stream-file-stream stream :output)
 106                           +tiocgwinsz+
 107                           winsize)
 108           (winsize-ws-col winsize))
 109       (sb-posix:syscall-error (error)
 110         (unless (= (sb-posix:syscall-errno error) sb-posix:enotty)
 111           (values nil error)))))
 112   #+cmu
 113   (locally (declare (optimize (ext:inhibit-warnings 3)))
 114     (alien:with-alien ((winsize (alien:struct unix:winsize)))
 115       (multiple-value-bind (success error-number)
 116           (unix:unix-ioctl
 117            (system:fd-stream-fd (stream-file-stream stream :output))
 118            unix:tiocgwinsz
 119            winsize)
 120         (if success
 121             (alien:slot winsize 'unix:ws-col)
 122           (unless (= error-number unix:enotty)
 123             (values nil (unix:get-unix-error-msg error-number)))))))
 124   #+ccl
 125   (ccl:rlet ((winsize :winsize))
 126     (let ((result
 127             (ccl::int-errno-call
 128              (#_ioctl (ccl::stream-device stream :output)
 129                       #$TIOCGWINSZ
 130                       :address winsize))))
 131       (if (zerop result)
 132           (ccl:pref winsize :winsize.ws_col)
 133         (unless (= result (- #$ENOTTY))
 134           (values nil (ccl::%strerror (- result)))))))
 135   #+ecl
 136   (multiple-value-bind (cols msg)
 137       (fd-line-width (ext:file-stream-fd stream))
 138     (values (unless (= cols -1) cols) msg))
 139   #+clisp
 140   (multiple-value-bind (input-fd output-fd)
 141       (ext:stream-handles stream)
 142     (declare (ignore input-fd))
 143     (when output-fd
 144       (cffi:with-foreign-object (winsize 'winsize)
 145         (let ((result (cffi:foreign-funcall "ioctl"
 146                         :int output-fd
 147                         :int +tiocgwinsz+
 148                         :pointer winsize
 149                         :int)))
 150           (if (= result -1)
 151               (unless (= +errno+ +enotty+)
 152                 (values nil
 153                         (cffi:foreign-funcall "strerror"
 154                           :int +errno+ :string)))
 155             (cffi:with-foreign-slots ((ws-col) winsize winsize)
 156               ws-col)))))))
 157
 158 ;;; termio.lisp ends here