termio/termio.lisp

   1 ;;; termio.lisp --- Terminal-related utilities
   2
   3 ;; Copyright (C) 2012 Didier Verna.
   4
   5 ;; Author:        Didier Verna <didier@lrde.epita.fr>
   6 ;; Maintainer:    Didier Verna <didier@lrde.epita.fr>
   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 ;; Basically, this whole stream manipulation stuff is a big non-standard mess.
  28 ;; Terminal streams are sometimes implemented on top of file streams,
  29 ;; sometimes not. Functions that retreive file descriptors sometimes just
  30 ;; return nil when it's not possible, or something else, or throw errors. It
  31 ;; is not always possible to know whether a stream has file descriptors or
  32 ;; not. Finally, there are cases where streams have an implicit hard-wired
  33 ;; file descriptor of 1, without any function to get it...
  34
  35 ;; Here's the information that I've gathered so far. This information is used
  36 ;; in the implementation of STREAM-IOCTL-OUTPUT-HANDLE below.
  37
  38 ;;    SBCL:  SB-SYS:FD-STREAM for both terminals and files.
  39 ;;    CMUCL: SYSTEM:FD-STREAM for both terminals and files.
  40 ;;    CCL:   CCL::BASIC-CHARACTER-[INPUT|OUTPUT]-STREAM for terminals,
  41 ;;           CCL::BASIC-FILE-CHARACTER-[INPUT|OUTPUT]-STREAM for files, with
  42 ;;           the above somewhere in the superclasses. I'm not sure if any
  43 ;;           class guarantees the existence of file descriptors, but it
  44 ;;           doesn't matter because CCL:STREAM-DEVICE returns nil if there are
  45 ;;           none, so we can safely use it on all classes.
  46 ;;    ECL:   FILE-STREAM for both terminals and files.
  47 ;;    CLISP: STREAM for terminals, FILE-STREAM for files. It is impossible (at
  48 ;;           the Lisp level) to detect whether a stream has file descriptors
  49 ;;           or not. The only workaround available right now is to catch a
  50 ;;           STREAM-ERROR potentially thrown by EXT:STREAM-HANDLES.
  51 ;;    ACL:   EXCL:TERMINAL-SIMPLE-STREAM for terminals,
  52 ;;           EXCL:FILE-SIMPLE-STREAM for files. I'm not sure if any class
  53 ;;           guarantees the existence of file descriptors, but it doesn't
  54 ;;           matter because EXCL::STREAM-[INPUT|OUTPUT]-HANDLE returns
  55 ;;           something which is not a number when there are none. The return
  56 ;;           value seems to be either NIL or some modified version of the
  57 ;;           original stream...
  58 ;;    LW:    SYSTEM::TERMINAL-STREAM for terminals, STREAM::[ENC]-FILE-STREAM
  59 ;;           for files. Terminal streams always have file descriptors 0
  60 ;;           (input) and 1 (output) hard wired. File streams are subclasses of
  61 ;;           STREAM::OS-FILE-HANDLE-STREAM on which we can retrieve file
  62 ;;           handles.
  63
  64
  65 ;;; Code:
  66
  67 (in-package :com.dvlsoft.clon)
  68 (in-readtable :com.dvlsoft.clon)
  69
  70
  71 ;; Preamble C code needed for ECL's FD-LINE-WIDTH function.
  72 #+ecl (ffi:clines "
  73 #include <stdio.h>
  74 #include <errno.h>
  75 #include <sys/ioctl.h>")
  76
  77
  78 (defgeneric stream-ioctl-output-handle (stream)
  79   (:documentation "Return STREAM's ioctl output handle or NIL.")
  80   ;; Standard canonicalization methods:
  81   (:method ((stream synonym-stream))
  82     (stream-ioctl-output-handle (symbol-value (synonym-stream-symbol stream))))
  83   (:method ((stream two-way-stream))
  84     (stream-ioctl-output-handle (two-way-stream-output-stream stream)))
  85   ;; #### PORTME.
  86   ;; Compiler-specific implementations:
  87   #+sbcl
  88   (:method ((stream sb-sys:fd-stream))
  89     ;; sb-posix's IOCTL function takes a stream directly
  90     stream)
  91   #+cmu
  92   (:method ((stream system:fd-stream))
  93     (system:fd-stream-fd stream))
  94   #+ecl
  95   (:method ((stream file-stream))
  96     (ext:file-stream-fd stream))
  97   #+lispworks
  98   (:method ((stream system::terminal-stream))
  99     1)
 100   #+lispworks
 101   (:method ((stream stream::os-file-handle-stream))
 102     (stream::os-file-handle-stream-file-handle stream))
 103   (:method (stream)
 104     #+ecl (declare (ignore stream))
 105     #+ccl
 106     (ccl:stream-device stream :output)
 107     #+clisp
 108     (multiple-value-bind (input-handle output-handle)
 109         (when (or (sys::built-in-stream-p stream)
 110                   (eq (type-of stream) 'socket:socket-server))
 111           (handler-case (ext:stream-handles stream)
 112             (stream-error ()
 113               nil)))
 114       (declare (ignore input-handle))
 115       output-handle)
 116     #+allegro
 117     (let ((handle (excl::stream-output-handle stream)))
 118       (when (numberp handle)
 119         handle))
 120     #-(or ccl clisp allegro)
 121     nil))
 122
 123 #+ecl
 124 (defun fd-line-width (fd)
 125   "Get the line width for FD (file descriptor).
 126 Return two values:
 127 - the line width, or -1 if it can't be computed
 128   (typically when FD does not denote a tty),
 129 - an error message if the operation failed."
 130   (ffi:c-inline (fd) (:int) (values :int :cstring) "{
 131     int fd = #0;
 132
 133     int cols = -1;
 134     char *msg = NULL;
 135
 136     struct winsize window;
 137     if (ioctl (fd, TIOCGWINSZ, &window) == -1)
 138       {
 139         if (errno != ENOTTY)
 140           msg = strerror (errno);
 141       }
 142     else
 143       cols = (int) window.ws_col;
 144
 145     @(return 0) = cols;
 146     @(return 1) = msg;
 147 }"))
 148
 149 ;; #### NOTE: ABCL doesn't appear below because this module (termio) is never
 150 ;; loaded with it.
 151 (defun stream-line-width
 152     (stream &aux (handle (stream-ioctl-output-handle stream)))
 153   "Get STREAM's line width.
 154 Return two values:
 155 - the stream's line width, or nil if it can't be computed
 156   (typically when the stream does not denote a tty),
 157 - an error message if the operation failed."
 158   (when handle
 159     ;; #### NOTE: doing a TIOCGWINSZ ioctl here is a convenient way to both
 160     ;; know whether we're connected to a tty, and getting the terminal width
 161     ;; at the same time. In case the ioctl fails, we need to distinguish
 162     ;; between and ENOTTY error, which simply means that we're not connected
 163     ;; to a terminal, and the other which are real errors and need to be
 164     ;; reported.
 165     ;; #### PORTME.
 166     #+sbcl
 167     (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
 168       (handler-case
 169           (with-winsize winsize ()
 170             (sb-posix:ioctl handle +tiocgwinsz+ winsize)
 171             (winsize-ws-col winsize))
 172         (sb-posix:syscall-error (error)
 173           (unless (= (sb-posix:syscall-errno error) sb-posix:enotty)
 174             (values nil error)))))
 175     #+cmu
 176     (locally (declare (optimize (ext:inhibit-warnings 3)))
 177       (alien:with-alien ((winsize (alien:struct unix:winsize)))
 178         (multiple-value-bind (success error-number)
 179             (unix:unix-ioctl handle unix:tiocgwinsz winsize)
 180           (if success
 181               (alien:slot winsize 'unix:ws-col)
 182             (unless (= error-number unix:enotty)
 183               (values nil (unix:get-unix-error-msg error-number)))))))
 184     #+ccl
 185     (ccl:rlet ((winsize :winsize))
 186       (let ((result (ccl::int-errno-call
 187                      (#_ioctl handle #$TIOCGWINSZ :address winsize))))
 188         (if (zerop result)
 189             (ccl:pref winsize :winsize.ws_col)
 190           (unless (= result (- #$ENOTTY))
 191             (values nil (ccl::%strerror (- result)))))))
 192     #+ecl
 193     (multiple-value-bind (cols msg)
 194         (fd-line-width handle)
 195       (values (unless (= cols -1) cols) msg))
 196     #+(or clisp allegro lispworks)
 197     (cffi:with-foreign-object (winsize 'winsize)
 198       (let ((result (cffi:foreign-funcall "ioctl"
 199                       :int handle
 200                       :int +tiocgwinsz+
 201                       :pointer winsize
 202                       :int)))
 203         (if (= result -1)
 204             (unless (= +errno+ +enotty+)
 205               (values nil
 206                       (cffi:foreign-funcall "strerror"
 207                         :int +errno+ :string)))
 208           (cffi:with-foreign-slots ((ws-col) winsize winsize)
 209             ws-col))))))
 210
 211 ;;; termio.lisp ends here