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 #ifdef HAVE_STRING_H
  47 #include <string.h>
  48 #endif
  49 \f
  50
  51
  52 #ifdef __STDC__
  53 static void
  54 scm_putc (int c, SCM port)
  55 #else
  56 static void
  57 scm_putc (c, port)
  58      int c;
  59      SCM port;
  60 #endif
  61 {
  62   scm_sizet i = SCM_PTOBNUM (port);
  63   SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port)));
  64 }
  65
  66
  67 #ifdef __STDC__
  68 static void
  69 scm_puts (char *s, SCM port)
  70 #else
  71 static void
  72 scm_puts (s, port)
  73      char *s;
  74      SCM port;
  75 #endif
  76 {
  77   scm_sizet i = SCM_PTOBNUM (port);
  78   SCM_SYSCALL ((scm_ptobs[i].fputs) (s, SCM_STREAM (port)));
  79 #ifdef TRANSCRIPT_SUPPORT
  80   if (scm_trans && (port == def_outp || port == cur_errp))
  81     SCM_SYSCALL (fputs (s, scm_trans));
  82 #endif
  83 }
  84
  85
  86 #ifdef __STDC__
  87 static int
  88 scm_lfwrite (char *ptr, scm_sizet size, scm_sizet nitems, SCM port)
  89 #else
  90 static int
  91 scm_lfwrite (ptr, size, nitems, port)
  92      char *ptr;
  93      scm_sizet size;
  94      scm_sizet nitems;
  95      SCM port;
  96 #endif
  97 {
  98   int ret;
  99   scm_sizet i = SCM_PTOBNUM (port);
 100   SCM_SYSCALL (ret = (scm_ptobs[i].fwrite(ptr, size, nitems, SCM_STREAM (port))));
 101 #ifdef TRANSCRIPT_SUPPORT
 102   if (scm_trans && (port == def_outp || port == cur_errp))
 103     SCM_SYSCALL (fwrite (ptr, size, nitems, scm_trans));
 104 #endif
 105   return ret;
 106 }
 107
 108
 109 \f
 110
 111 #ifdef __STDC__
 112 void
 113 scm_gen_putc (int c, SCM port)
 114 #else
 115 void
 116 scm_gen_putc (c, port)
 117      int c;
 118      SCM port;
 119 #endif
 120 {
 121   switch (SCM_PORT_REPRESENTATION (port))
 122     {
 123     case scm_regular_port:
 124       {
 125         /* Nothing good to do with extended chars here...
 126          * just truncate them.
 127          */
 128         scm_putc ((unsigned char)c, port);
 129         break;
 130       }
 131
 132     case scm_mb_port:
 133       {
 134         char buf[256];
 135         int len;
 136
 137         SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_MAKICHR (c),
 138                 "huge translation", "scm_gen_putc");
 139
 140         len = xwctomb (buf, c);
 141
 142         SCM_ASSERT ((len >= 0), SCM_MAKICHR (c), "bogus character", "scm_gen_putc");
 143
 144         if (len == 0)
 145           scm_putc (0, port);
 146         else
 147           {
 148             int x;
 149             for (x = 0; x < len; ++x)
 150               scm_putc (buf[x], port);
 151           }
 152         break;
 153       }
 154
 155     case scm_wchar_port:
 156       {
 157         scm_putc (((unsigned char)(c >> 8) & 0xff), port);
 158         scm_putc ((unsigned char)(c & 0xff), port);
 159         break;
 160       }
 161     }
 162 }
 163
 164
 165 \f
 166
 167
 168 #ifdef __STDC__
 169 void
 170 scm_gen_puts (enum scm_string_representation_type rep,
 171               char *str_data,
 172               SCM port)
 173 #else
 174 void
 175 scm_gen_puts (rep, str_data, port)
 176      enum scm_string_representation_type rep;
 177      unsigned char *str_data;
 178      SCM port;
 179 #endif
 180 {
 181   switch (rep)
 182     {
 183
 184     case scm_regular_string:
 185       switch (SCM_PORT_REPRESENTATION (port))
 186         {
 187         case scm_regular_port:
 188         case scm_mb_port:
 189           scm_puts (str_data, port);
 190           return;
 191         case scm_wchar_port:
 192           {
 193             while (*str_data)
 194               {
 195                 scm_putc (0, port);
 196                 scm_putc (*str_data, port);
 197                 ++str_data;
 198               }
 199             return;
 200           }
 201         }
 202
 203     case scm_mb_string:
 204       switch (SCM_PORT_REPRESENTATION (port))
 205         {
 206         case scm_regular_port:
 207         case scm_mb_port:
 208           scm_puts (str_data, port);
 209           return;
 210         case scm_wchar_port:
 211           {
 212             xwchar_t output;
 213             int len;
 214             int size;
 215
 216             size = strlen (str_data);
 217             while (size)
 218               {
 219                 len = xmbtowc (&output, str_data, size);
 220                 SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
 221                 scm_putc ((output >> 8) & 0xff, port);
 222                 scm_putc (output & 0xff, port);
 223                 size -= len;
 224                 str_data += len;
 225               }
 226             return;
 227           }
 228         }
 229
 230     case scm_wchar_string:
 231       {
 232         xwchar_t * wstr_data;
 233
 234         wstr_data = (xwchar_t *)wstr_data;
 235         switch (SCM_PORT_REPRESENTATION (port))
 236           {
 237           case scm_regular_port:
 238             while (*wstr_data)
 239               {
 240                 scm_putc ((unsigned char) *wstr_data, port);
 241                 ++wstr_data;
 242               }
 243             return;
 244
 245           case scm_mb_port:
 246             {
 247               char buf[256];
 248               SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
 249                       "huge translation", "scm_gen_puts");
 250
 251               while (*wstr_data)
 252                 {
 253                   int len;
 254
 255                   len = xwctomb (buf, *wstr_data);
 256
 257                   SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
 258
 259                   {
 260                     int x;
 261                     for (x = 0; x < len; ++x)
 262                       scm_putc (buf[x], port);
 263                   }
 264                   ++wstr_data;
 265                 }
 266               return;
 267             }
 268
 269           case scm_wchar_port:
 270             {
 271               int len;
 272               for (len = 0; wstr_data[len]; ++len)
 273                 ;
 274               scm_lfwrite (str_data, sizeof (xwchar_t), len, port);
 275               return;
 276             }
 277           }
 278       }
 279     }
 280 }
 281
 282
 283 \f
 284
 285 #ifdef __STDC__
 286 void
 287 scm_gen_write (enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port)
 288 #else
 289 void
 290 scm_gen_write (rep, str_data, nitems, port)
 291      enum scm_string_representation_type rep;
 292      char *str_data;
 293      scm_sizet nitems;
 294      SCM port;
 295 #endif
 296 {
 297   /* is nitems bytes or characters in the mb_string case? */
 298
 299   switch (rep)
 300     {
 301     case scm_regular_string:
 302       switch (SCM_PORT_REPRESENTATION (port))
 303         {
 304         case scm_regular_port:
 305         case scm_mb_port:
 306           scm_lfwrite (str_data, 1, nitems, port);
 307           return;
 308         case scm_wchar_port:
 309           {
 310             while (nitems)
 311               {
 312                 scm_putc (0, port);
 313                 scm_putc (*str_data, port);
 314                 ++str_data;
 315                 --nitems;
 316               }
 317             return;
 318           }
 319         }
 320
 321     case scm_mb_string:
 322       switch (SCM_PORT_REPRESENTATION (port))
 323         {
 324         case scm_regular_port:
 325         case scm_mb_port:
 326           scm_lfwrite (str_data, 1, nitems, port);
 327           return;
 328
 329         case scm_wchar_port:
 330           {
 331             xwchar_t output;
 332             int len;
 333
 334             while (nitems)
 335               {
 336                 len = xmbtowc (&output, str_data, nitems);
 337                 SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
 338                 scm_putc ((output >> 8) & 0xff, port);
 339                 scm_putc (output & 0xff, port);
 340                 nitems -= len;
 341                 str_data += len;
 342               }
 343             return;
 344           }
 345         }
 346
 347     case scm_wchar_string:
 348       {
 349         xwchar_t * wstr_data;
 350
 351         wstr_data = (xwchar_t *)wstr_data;
 352         switch (SCM_PORT_REPRESENTATION (port))
 353           {
 354           case scm_regular_port:
 355             while (nitems)
 356               {
 357                 scm_putc ((unsigned char) *wstr_data, port);
 358                 ++wstr_data;
 359                 --nitems;
 360               }
 361             return;
 362
 363           case scm_mb_port:
 364             {
 365               char buf[256];
 366               SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
 367                       "huge translation", "scm_gen_puts");
 368
 369               while (nitems)
 370                 {
 371                   int len;
 372
 373                   len = xwctomb (buf, *wstr_data);
 374
 375                   SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
 376
 377                   {
 378                     int x;
 379                     for (x = 0; x < len; ++x)
 380                       scm_putc (buf[x], port);
 381                   }
 382                   ++wstr_data;
 383                   --nitems;
 384                 }
 385               return;
 386             }
 387
 388           case scm_wchar_port:
 389             {
 390               scm_lfwrite (str_data, sizeof (xwchar_t), nitems, port);
 391               return;
 392             }
 393           }
 394       }
 395     }
 396 }
 397
 398 \f
 399
 400
 401 #ifdef __STDC__
 402 static int
 403 scm_getc (SCM port)
 404 #else
 405 static int
 406 scm_getc (port)
 407      SCM port;
 408 #endif
 409 {
 410   FILE *f;
 411   int c;
 412   scm_sizet i;
 413
 414   f = (FILE *)SCM_STREAM (port);
 415   i = SCM_PTOBNUM (port);
 416   SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
 417   return c;
 418 }
 419
 420 #ifdef __STDC__
 421 int
 422 scm_gen_getc (SCM port)
 423 #else
 424 int
 425 scm_gen_getc (port)
 426      SCM port;
 427 #endif
 428 {
 429   int c;
 430
 431   /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
 432   if (SCM_CRDYP (port))
 433     {
 434       c = SCM_CGETUN (port);
 435       SCM_CLRDY (port);         /* Clear ungetted char */
 436
 437     return_c:
 438       if (c == '\n')
 439         {
 440           SCM_INCLINE (port);
 441         }
 442       else if (c == '\t')
 443         {
 444           SCM_TABCOL (port);
 445         }
 446       else
 447         {
 448           SCM_INCCOL (port);
 449         }
 450       return c;
 451     }
 452
 453
 454   switch (SCM_PORT_REPRESENTATION (port))
 455     {
 456     case scm_regular_port:
 457       c = scm_getc (port);
 458       goto return_c;
 459
 460     case scm_mb_port:
 461       {
 462         int x;
 463         unsigned char buf[256];
 464         int c;
 465
 466         SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
 467                 "huge translation", "scm_gen_puts");
 468
 469         x = 0;
 470         while (1)
 471           {
 472             xwchar_t out;
 473             c = scm_getc (port);
 474
 475             if (c == EOF)
 476               return EOF;
 477
 478             buf[x] = c;
 479
 480             if (xmbtowc (&out, buf, x + 1) > 0)
 481               {
 482                 c = out;
 483                 goto return_c;
 484               }
 485
 486             SCM_ASSERT (x < sizeof (buf), SCM_BOOL_F,
 487                     "huge translation", "scm_gen_getc");
 488             ++x;
 489           }
 490       }
 491
 492
 493     case scm_wchar_port:
 494       {
 495         int hi;
 496         int lo;
 497         hi = scm_getc (port);
 498         lo = (hi == EOF
 499               ? EOF
 500               : scm_getc (port));
 501         c = ((hi == EOF)
 502              ? EOF
 503              : ((hi << 8) | lo));
 504         goto return_c;
 505       }
 506
 507
 508     default:
 509       return EOF;
 510     }
 511 }
 512
 513 #ifdef __STDC__
 514 void
 515 scm_gen_ungetc (int c, SCM port)
 516 #else
 517 void
 518 scm_gen_ungetc (c, port)
 519      int c;
 520      SCM port;
 521 #endif
 522 {
 523 /*      SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_gen_ungetc");*/
 524   SCM_CUNGET (c, port);
 525   if (c == '\n')
 526     {
 527       /* What should col be in this case?
 528        * We'll leave it at -1.
 529        */
 530       SCM_LINUM (port) -= 1;
 531     }
 532   else
 533     SCM_COL(port) -= 1;
 534 }
 535
 536