clisp/util.lisp

   1 ;;; util.lisp --- CLISP specific utilities
   2
   3 ;; Copyright (C) 2011 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
  26 ;;; Code:
  27
  28 (in-package :com.dvlsoft.clon)
  29 (in-readtable :com.dvlsoft.clon)
  30
  31
  32 (defun clisp/stream-line-width (stream)
  33   "CLISP specific version of STREAM-LINE-WIDTH.
  34 This function relies on CFFI."
  35   (multiple-value-bind (input-fd output-fd)
  36       (ext:stream-handles stream)
  37     (declare (ignore input-fd))
  38     (when output-fd
  39       (cffi:with-foreign-object (winsize 'winsize)
  40         (let ((result (cffi:foreign-funcall "ioctl"
  41                                             :int output-fd
  42                                             :int +tiocgwinsz+
  43                                             :pointer winsize
  44                                             :int)))
  45           (if (= result -1)
  46               (unless (= +errno+ +enotty+)
  47                 (values nil
  48                         (cffi:foreign-funcall "strerror"
  49                                               :int +errno+ :string)))
  50             (cffi:with-foreign-slots ((ws-col) winsize winsize)
  51               ws-col)))))))
  52
  53
  54 ;;; util.lisp ends here