libguile/genio.c

   1 /*      Copyright (C) 1995,1996 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16  *
  17  * As a special exception, the Free Software Foundation gives permission
  18  * for additional uses of the text contained in its release of GUILE.
  19  *
  20  * The exception is that, if you link the GUILE library with other files
  21  * to produce an executable, this does not by itself cause the
  22  * resulting executable to be covered by the GNU General Public License.
  23  * Your use of that executable is in no way restricted on account of
  24  * linking the GUILE library code into it.
  25  *
  26  * This exception does not however invalidate any other reasons why
  27  * the executable file might be covered by the GNU General Public License.
  28  *
  29  * This exception applies only to the code released by the
  30  * Free Software Foundation under the name GUILE.  If you copy
  31  * code from other Free Software Foundation releases into a copy of
  32  * GUILE, as the General Public License permits, the exception does
  33  * not apply to the code that you add in this way.  To avoid misleading
  34  * anyone as to the status of such modified files, you must delete
  35  * this exception notice from them.
  36  *
  37  * If you write modifications of your own for GUILE, it is your choice
  38  * whether to permit this exception to apply to your modifications.
  39  * If you do not wish that, delete this exception notice.
  40  */
  41 \f
  42 #include "extchrs.h"
  43 #include <stdio.h>
  44 #include "_scm.h"
  45
  46 \f
  47
  48
  49 #ifdef __STDC__
  50 static void
  51 scm_putc (int c, SCM port)
  52 #else
  53 static void
  54 scm_putc (c, port)
  55      int c;
  56      SCM port;
  57 #endif
  58 {
  59   scm_sizet i = SCM_PTOBNUM (port);
  60   SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port)));
  61 }
  62
  63
  64 #ifdef __STDC__
  65 static void
  66 scm_puts (char *s, SCM port)
  67 #else
  68 static void
  69 scm_puts (s, port)
  70      char *s;
  71      SCM port;
  72 #endif
  73 {
  74   scm_sizet i = SCM_PTOBNUM (port);
  75   SCM_SYSCALL ((scm_ptobs[i].fputs) (s, SCM_STREAM (port)));
  76 #ifdef TRANSCRIPT_SUPPORT
  77   if (scm_trans && (port == def_outp || port == cur_errp))
  78     SCM_SYSCALL (fputs (s, scm_trans));
  79 #endif
  80 }
  81
  82
  83 #ifdef __STDC__
  84 static int
  85 scm_lfwrite (char *ptr, scm_sizet size, scm_sizet nitems, SCM port)
  86 #else
  87 static int
  88 scm_lfwrite (ptr, size, nitems, port)
  89      char *ptr;
  90      scm_sizet size;
  91      scm_sizet nitems;
  92      SCM port;
  93 #endif
  94 {
  95   int ret;
  96   scm_sizet i = SCM_PTOBNUM (port);
  97   SCM_SYSCALL (ret = (scm_ptobs[i].fwrite(ptr, size, nitems, SCM_STREAM (port))));
  98 #ifdef TRANSCRIPT_SUPPORT
  99   if (scm_trans && (port == def_outp || port == cur_errp))
 100     SCM_SYSCALL (fwrite (ptr, size, nitems, scm_trans));
 101 #endif
 102   return ret;
 103 }
 104
 105
 106 \f
 107
 108 #ifdef __STDC__
 109 void
 110 scm_gen_putc (int c, SCM port)
 111 #else
 112 void
 113 scm_gen_putc (c, port)
 114      int c;
 115      SCM port;
 116 #endif
 117 {
 118   switch (SCM_PORT_REPRESENTATION (port))
 119     {
 120     case scm_regular_port:
 121       {
 122         /* Nothing good to do with extended chars here...
 123          * just truncate them.
 124          */
 125         scm_putc ((unsigned char)c, port);
 126         break;
 127       }
 128
 129     case scm_mb_port:
 130       {
 131         char buf[256];
 132         int len;
 133
 134         SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_MAKICHR (c),
 135                 "huge translation", "scm_gen_putc");
 136
 137         len = xwctomb (buf, c);
 138
 139         SCM_ASSERT ((len >= 0), SCM_MAKICHR (c), "bogus character", "scm_gen_putc");
 140
 141         if (len == 0)
 142           scm_putc (0, port);
 143         else
 144           {
 145             int x;
 146             for (x = 0; x < len; ++x)
 147               scm_putc (buf[x], port);
 148           }
 149         break;
 150       }
 151
 152     case scm_wchar_port:
 153       {
 154         scm_putc (((unsigned char)(c >> 8) & 0xff), port);
 155         scm_putc ((unsigned char)(c & 0xff), port);
 156         break;
 157       }
 158     }
 159 }
 160
 161
 162 \f
 163
 164
 165 #ifdef __STDC__
 166 void
 167 scm_gen_puts (enum scm_string_representation_type rep,
 168               char *str_data,
 169               SCM port)
 170 #else
 171 void
 172 scm_gen_puts (rep, str_data, port)
 173      enum scm_string_representation_type rep;
 174      unsigned char *str_data;
 175      SCM port;
 176 #endif
 177 {
 178   switch (rep)
 179     {
 180
 181     case scm_regular_string:
 182       switch (SCM_PORT_REPRESENTATION (port))
 183         {
 184         case scm_regular_port:
 185         case scm_mb_port:
 186           scm_puts (str_data, port);
 187           return;
 188         case scm_wchar_port:
 189           {
 190             while (*str_data)
 191               {
 192                 scm_putc (0, port);
 193                 scm_putc (*str_data, port);
 194                 ++str_data;
 195               }
 196             return;
 197           }
 198         }
 199
 200     case scm_mb_string:
 201       switch (SCM_PORT_REPRESENTATION (port))
 202         {
 203         case scm_regular_port:
 204         case scm_mb_port:
 205           scm_puts (str_data, port);
 206           return;
 207         case scm_wchar_port:
 208           {
 209             xwchar_t output;
 210             int len;
 211             int size;
 212
 213             size = strlen (str_data);
 214             while (size)
 215               {
 216                 len = xmbtowc (&output, str_data, size);
 217                 SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
 218                 scm_putc ((output >> 8) & 0xff, port);
 219                 scm_putc (output & 0xff, port);
 220                 size -= len;
 221                 str_data += len;
 222               }
 223             return;
 224           }
 225         }
 226
 227     case scm_wchar_string:
 228       {
 229         xwchar_t * wstr_data;
 230
 231         wstr_data = (xwchar_t *)wstr_data;
 232         switch (SCM_PORT_REPRESENTATION (port))
 233           {
 234           case scm_regular_port:
 235             while (*wstr_data)
 236               {
 237                 scm_putc ((unsigned char) *wstr_data, port);
 238                 ++wstr_data;
 239               }
 240             return;
 241
 242           case scm_mb_port:
 243             {
 244               char buf[256];
 245               SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
 246                       "huge translation", "scm_gen_puts");
 247
 248               while (*wstr_data)
 249                 {
 250                   int len;
 251
 252                   len = xwctomb (buf, *wstr_data);
 253
 254                   SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
 255
 256                   {
 257                     int x;
 258                     for (x = 0; x < len; ++x)
 259                       scm_putc (buf[x], port);
 260                   }
 261                   ++wstr_data;
 262                 }
 263               return;
 264             }
 265
 266           case scm_wchar_port:
 267             {
 268               int len;
 269               for (len = 0; wstr_data[len]; ++len)
 270                 ;
 271               scm_lfwrite (str_data, sizeof (xwchar_t), len, port);
 272               return;
 273             }
 274           }
 275       }
 276     }
 277 }
 278
 279
 280 \f
 281
 282 #ifdef __STDC__
 283 void
 284 scm_gen_write (enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port)
 285 #else
 286 void
 287 scm_gen_write (rep, str_data, nitems, port)
 288      enum scm_string_representation_type rep;
 289      char *str_data;
 290      scm_sizet nitems;
 291      SCM port;
 292 #endif
 293 {
 294   /* is nitems bytes or characters in the mb_string case? */
 295
 296   switch (rep)
 297     {
 298     case scm_regular_string:
 299       switch (SCM_PORT_REPRESENTATION (port))
 300         {
 301         case scm_regular_port:
 302         case scm_mb_port:
 303           scm_lfwrite (str_data, 1, nitems, port);
 304           return;
 305         case scm_wchar_port:
 306           {
 307             while (nitems)
 308               {
 309                 scm_putc (0, port);
 310                 scm_putc (*str_data, port);
 311                 ++str_data;
 312                 --nitems;
 313               }
 314             return;
 315           }
 316         }
 317
 318     case scm_mb_string:
 319       switch (SCM_PORT_REPRESENTATION (port))
 320         {
 321         case scm_regular_port:
 322         case scm_mb_port:
 323           scm_lfwrite (str_data, 1, nitems, port);
 324           return;
 325
 326         case scm_wchar_port:
 327           {
 328             xwchar_t output;
 329             int len;
 330
 331             while (nitems)
 332               {
 333                 len = xmbtowc (&output, str_data, nitems);
 334                 SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
 335                 scm_putc ((output >> 8) & 0xff, port);
 336                 scm_putc (output & 0xff, port);
 337                 nitems -= len;
 338                 str_data += len;
 339               }
 340             return;
 341           }
 342         }
 343
 344     case scm_wchar_string:
 345       {
 346         xwchar_t * wstr_data;
 347
 348         wstr_data = (xwchar_t *)wstr_data;
 349         switch (SCM_PORT_REPRESENTATION (port))
 350           {
 351           case scm_regular_port:
 352             while (nitems)
 353               {
 354                 scm_putc ((unsigned char) *wstr_data, port);
 355                 ++wstr_data;
 356                 --nitems;
 357               }
 358             return;
 359
 360           case scm_mb_port:
 361             {
 362               char buf[256];
 363               SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
 364                       "huge translation", "scm_gen_puts");
 365
 366               while (nitems)
 367                 {
 368                   int len;
 369
 370                   len = xwctomb (buf, *wstr_data);
 371
 372                   SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
 373
 374                   {
 375                     int x;
 376                     for (x = 0; x < len; ++x)
 377                       scm_putc (buf[x], port);
 378                   }
 379                   ++wstr_data;
 380                   --nitems;
 381                 }
 382               return;
 383             }
 384
 385           case scm_wchar_port:
 386             {
 387               scm_lfwrite (str_data, sizeof (xwchar_t), nitems, port);
 388               return;
 389             }
 390           }
 391       }
 392     }
 393 }
 394
 395 \f
 396
 397
 398 #ifdef __STDC__
 399 static int
 400 scm_getc (SCM port)
 401 #else
 402 static int
 403 scm_getc (port)
 404      SCM port;
 405 #endif
 406 {
 407   FILE *f;
 408   int c;
 409   scm_sizet i;
 410
 411   f = (FILE *)SCM_STREAM (port);
 412   i = SCM_PTOBNUM (port);
 413   SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
 414   return c;
 415 }
 416
 417 #ifdef __STDC__
 418 int
 419 scm_gen_getc (SCM port)
 420 #else
 421 int
 422 scm_gen_getc (port)
 423      SCM port;
 424 #endif
 425 {
 426   int c;
 427
 428   /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
 429   if (SCM_CRDYP (port))
 430     {
 431       c = SCM_CGETUN (port);
 432       SCM_CLRDY (port);         /* Clear ungetted char */
 433
 434     return_c:
 435       if (c == '\n')
 436         {
 437           SCM_INCLINE (port);
 438         }
 439       else if (c == '\t')
 440         {
 441           SCM_TABCOL (port);
 442         }
 443       else
 444         {
 445           SCM_INCCOL (port);
 446         }
 447       return c;
 448     }
 449
 450
 451   switch (SCM_PORT_REPRESENTATION (port))
 452     {
 453     case scm_regular_port:
 454       c = scm_getc (port);
 455       goto return_c;
 456
 457     case scm_mb_port:
 458       {
 459         int x;
 460         unsigned char buf[256];
 461         int c;
 462
 463         SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
 464                 "huge translation", "scm_gen_puts");
 465
 466         x = 0;
 467         while (1)
 468           {
 469             xwchar_t out;
 470             c = scm_getc (port);
 471
 472             if (c == EOF)
 473               return EOF;
 474
 475             buf[x] = c;
 476
 477             if (xmbtowc (&out, buf, x + 1) > 0)
 478               {
 479                 c = out;
 480                 goto return_c;
 481               }
 482
 483             SCM_ASSERT (x < sizeof (buf), SCM_BOOL_F,
 484                     "huge translation", "scm_gen_getc");
 485             ++x;
 486           }
 487       }
 488
 489
 490     case scm_wchar_port:
 491       {
 492         int hi;
 493         int lo;
 494         hi = scm_getc (port);
 495         lo = (hi == EOF
 496               ? EOF
 497               : scm_getc (port));
 498         c = ((hi == EOF)
 499              ? EOF
 500              : ((hi << 8) | lo));
 501         goto return_c;
 502       }
 503
 504
 505     default:
 506       return EOF;
 507     }
 508 }
 509
 510 #ifdef __STDC__
 511 void
 512 scm_gen_ungetc (int c, SCM port)
 513 #else
 514 void
 515 scm_gen_ungetc (c, port)
 516      int c;
 517      SCM port;
 518 #endif
 519 {
 520 /*      SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_gen_ungetc");*/
 521   SCM_CUNGET (c, port);
 522   if (c == '\n')
 523     {
 524       /* What should col be in this case?
 525        * We'll leave it at -1.
 526        */
 527       SCM_LINUM (port) -= 1;
 528     }
 529   else
 530     SCM_COL(port) -= 1;
 531 }
 532
 533